diff --git a/.github/workflows/coq-action.yml b/.github/workflows/coq-action.yml
index 8e0729dde5..a669d19fc5 100644
--- a/.github/workflows/coq-action.yml
+++ b/.github/workflows/coq-action.yml
@@ -53,6 +53,7 @@ jobs:
               opam install -y ${{ matrix.coq_version == 'dev' && 'coq-flocq' || matrix.bit_size == 32 && 'coq-compcert-32.3.13.1' || 'coq-compcert.3.13.1' }}
               # Required by test2
               opam install -y coq-ext-lib
+              opam install -y coq-iris.4.3.0
             endGroup
           # See https://github.com/coq-community/docker-coq-action/tree/v1#permissions
           before_script: |
@@ -112,6 +113,11 @@ jobs:
             make_target: test4
           - bit_size: 32
             make_target: test5
+          # avoid Coq issue https://github.com/coq/coq/issues/18126
+#          - coq_version: 8.18
+#            make_target: test
+#          - coq_version: 8.18
+#            make_target: test4
 
     steps:
       - name: 'Download archive'
diff --git a/.gitignore b/.gitignore
index 3886153ca2..5023ee9e40 100644
--- a/.gitignore
+++ b/.gitignore
@@ -76,6 +76,7 @@ compcert/test/
 version.v
 coqide
 *.cache
+*.timing
 *~
 *#
 .#*
@@ -84,6 +85,7 @@ doc/html/
 /_CoqProject
 .loadpath-export
 _CoqProject-export
+progs/VSUpile/_CoqProject
 wand_demo/vfa/*.ml
 wand_demo/vfa/*.mli
 wand/vfa/*.ml
@@ -103,3 +105,5 @@ lib/proof/SC_atomics_extern.v
 zlist/.Makefile.coq.d
 zlist/Makefile.coq
 zlist/Makefile.coq.conf
+
+_build/
\ No newline at end of file
diff --git a/Makefile b/Makefile
index 2c31f6df91..f60230af6f 100644
--- a/Makefile
+++ b/Makefile
@@ -21,7 +21,7 @@ COQLIB=$(shell $(COQC) -where | tr -d '\r' | tr '\\' '/')
 
 # Check Coq version
 
-COQVERSION= 8.19.1 or-else 8.19.2 or-else 8.20.0
+COQVERSION= 8.19.1 or-else 8.19.2 or-else 8.20.0 or-else 8.20.1
 
 COQV=$(shell $(COQC) -v)
 ifneq ($(IGNORECOQVERSION),true)
@@ -65,10 +65,10 @@ endif
 # CLIGHTGEN=$(my_local_bin_path)/clightgen
 
 # # User settable variables #
-COMPCERT ?= platform
+COMPCERT ?= bundled
 ZLIST ?= bundled
 ARCH ?= 
-BITSIZE ?=
+BITSIZE ?= 64
 
 # # Internal variables #
 # Set to true if the bundled CompCert is used
@@ -268,9 +268,9 @@ endif
 # ########## Flags ##########
 
 ifeq ($(ZLIST),platform)
-  VSTDIRS= msl sepcomp veric floyd $(PROGSDIR) concurrency ccc26x86 atomics
+  VSTDIRS= shared msl sepcomp veric floyd $(PROGSDIR) concurrency ccc26x86 atomics
 else
-  VSTDIRS= msl sepcomp veric zlist floyd $(PROGSDIR) concurrency ccc26x86 atomics
+  VSTDIRS= shared msl sepcomp veric zlist floyd $(PROGSDIR) concurrency ccc26x86 atomics
 endif
 OTHERDIRS= wand_demo sha hmacfcf tweetnacl20140427 hmacdrbg aes mailbox boringssl_fips_20180730
 DIRS = $(VSTDIRS) $(OTHERDIRS)
@@ -325,6 +325,11 @@ ifdef MATHCOMP
 EXTFLAGS:=$(EXTFLAGS) -R $(MATHCOMP) mathcomp
 endif
 
+# ##### refinedVST Flags #####
+EXTFLAGS:=$(EXTFLAGS) -Q refinedVST/lithium VST.lithium -Q refinedVST/typing VST.typing
+
+EXTFLAGS:=$(EXTFLAGS) $(REFINEDVSTFLAGS)
+
 # ##### Flag summary #####
 
 COQFLAGS=$(foreach d, $(VSTDIRS), $(if $(wildcard $(d)), -Q $(d) VST.$(d))) $(foreach d, $(OTHERDIRS), $(if $(wildcard $(d)), -Q $(d) $(d))) $(EXTFLAGS) $(SHIM) # -Q ../stdpp/theories stdpp -Q ../iris/iris iris -Q ../InteractionTrees/theories ITree -Q ../paco/src Paco -Q ../coq-ext-lib/theories ExtLib -Q ../fcf/src/fcf FCF
@@ -388,25 +393,10 @@ $(info =================================)
 # ########## File Lists ##########
 
 MSL_FILES = \
-  Axioms.v Extensionality.v base.v eq_dec.v sig_isomorphism.v \
-  ageable.v sepalg.v psepalg.v age_sepalg.v \
-  sepalg_generators.v functors.v sepalg_functors.v combiner_sa.v \
-  cross_split.v join_hom_lemmas.v cjoins.v \
+  Axioms.v Extensionality.v base.v eq_dec.v \
+  sepalg.v sepalg_generators.v psepalg.v \
   boolean_alg.v tree_shares.v shares.v pshares.v \
-  knot.v knot_prop.v \
-  knot_lemmas.v knot_unique.v \
-  knot_hered.v \
-  knot_full.v knot_full_variant.v knot_shims.v knot_full_sa.v \
-  corable.v corable_direct.v \
-  predicates_hered.v predicates_sl.v subtypes.v subtypes_sl.v \
-  contractive.v predicates_rec.v \
-  msl_direct.v msl_standard.v msl_classical.v \
-  predicates_sa.v \
-  normalize.v \
-  env.v corec.v Coqlib2.v sepalg_list.v op_classes.v \
-  simple_CCC.v seplog.v alg_seplog.v alg_seplog_direct.v log_normalize.v \
-  ghost.v ghost_seplog.v \
-  iter_sepcon.v ramification_lemmas.v wand_frame.v wandQ_frame.v #age_to.v
+  Coqlib2.v sepalg_list.v
 
 SEPCOMP_FILES = \
   Address.v \
@@ -501,18 +491,18 @@ LINKING_FILES= \
   finfun.v
 
 VERIC_FILES= \
-  base.v Clight_base.v val_lemmas.v Memory.v shares.v splice.v compspecs.v rmaps.v rmaps_lemmas.v compcert_rmaps.v Cop2.v juicy_base.v type_induction.v composite_compute.v align_mem.v change_compspecs.v \
+  base.v Clight_base.v val_lemmas.v Memory.v shares.v compspecs.v juicy_base.v type_induction.v composite_compute.v align_mem.v change_compspecs.v \
   tycontext.v lift.v expr.v expr2.v environ_lemmas.v \
   binop_lemmas.v binop_lemmas2.v binop_lemmas3.v binop_lemmas4.v binop_lemmas5.v binop_lemmas6.v \
   expr_lemmas.v expr_lemmas2.v expr_lemmas3.v expr_lemmas4.v \
   extend_tc.v \
   Clight_lemmas.v Clight_core.v  \
-  slice.v res_predicates.v own.v seplog.v Clight_seplog.v mapsto_memory_block.v Clight_mapsto_memory_block.v assert_lemmas.v Clight_assert_lemmas.v \
-  juicy_mem.v juicy_mem_lemmas.v local.v juicy_mem_ops.v juicy_safety.v juicy_extspec.v \
+  slice.v res_predicates.v seplog.v Clight_seplog.v mapsto_memory_block.v Clight_mapsto_memory_block.v assert_lemmas.v Clight_assert_lemmas.v \
+  juicy_mem.v juicy_mem_lemmas.v local.v juicy_extspec.v \
   semax.v semax_lemmas.v semax_conseq.v semax_call.v semax_straight.v semax_loop.v semax_switch.v \
   initial_world.v Clight_initial_world.v initialize.v semax_prog.v semax_ext.v SeparationLogic.v SeparationLogicSoundness.v  \
-  NullExtension.v SequentialClight.v SequentialClight2.v tcb.v superprecise.v jstep.v address_conflict.v valid_pointer.v coqlib4.v \
-  semax_ext_oracle.v mem_lessdef.v Clight_mem_lessdef.v age_to_resource_at.v aging_lemmas.v Clight_aging_lemmas.v ghost_PCM.v mpred.v ghosts.v invariants.v
+  NullExtension.v SequentialClight.v tcb.v jstep.v address_conflict.v valid_pointer.v coqlib4.v \
+  mem_lessdef.v Clight_mem_lessdef.v mpred.v
 
 ZLIST_FILES= \
   sublist.v Zlength_solver.v list_solver.v
@@ -526,7 +516,7 @@ FLOYD_FILES= \
    client_lemmas.v canon.v canonicalize.v closed_lemmas.v jmeq_lemmas.v \
    compare_lemmas.v sc_set_load_store.v \
    loadstore_mapsto.v loadstore_field_at.v field_compat.v nested_loadstore.v \
-   call_lemmas.v extcall_lemmas.v forward_lemmas.v funspec_old.v forward.v \
+   call_lemmas.v extcall_lemmas.v forward_lemmas.v forward.v \
    entailer.v globals_lemmas.v \
    local2ptree_denote.v local2ptree_eval.v local2ptree_typecheck.v \
    fieldlist.v mapsto_memory_block.v\
@@ -536,7 +526,9 @@ FLOYD_FILES= \
    freezer.v deadvars.v Clightnotations.v unfold_data_at.v hints.v reassoc_seq.v \
    SeparationLogicAsLogicSoundness.v SeparationLogicAsLogic.v SeparationLogicFacts.v \
    subsume_funspec.v linking.v data_at_lemmas.v Funspec_old_Notation.v assoclists.v VSU.v quickprogram.v PTops.v Component.v QPcomposite.v \
-   data_at_list_solver.v step.v fastforward.v finish.v
+   data_at_list_solver.v step.v fastforward.v finish.v \
+   compat.v
+#  VSU_DrySafe.v \   # does not yet work in VST 3.x 
 #real_forward.v
 
 
@@ -713,11 +705,6 @@ INSTALL_FILES_SRC=$(shell COMPCERT=$(COMPCERT) COMPCERT_INST_DIR=$(COMPCERT_INST
 INSTALL_FILES_VO=$(patsubst %.v,%.vo,$(INSTALL_FILES_SRC))
 INSTALL_FILES=$(sort $(INSTALL_FILES_SRC) $(INSTALL_FILES_VO))
 
-IRIS_INSTALL_FILES_BASE=$(shell COMPCERT=$(COMPCERT) COMPCERT_INST_DIR=$(COMPCERT_INST_DIR) ZLIST=$(ZLIST) BITSIZE=$(BITSIZE) ARCH=$(ARCH) IGNORECOQVERSION=$(IGNORECOQVERSION) IGNORECOMPCERTVERSION=$(IGNORECOMPCERTVERSION) MAKE=$(MAKE) util/calc_install_files atomics)
-IRIS_INSTALL_FILES_SRC=$(filter-out $(INSTALL_FILES_SRC),$(IRIS_INSTALL_FILES_BASE))
-IRIS_INSTALL_FILES_VO=$(patsubst %.v,%.vo,$(IRIS_INSTALL_FILES_SRC))
-IRIS_INSTALL_FILES=$(sort $(IRIS_INSTALL_FILES_SRC) $(IRIS_INSTALL_FILES_VO))
-
 # ########## Rules ##########
 
 %_stripped.v: %.v
@@ -784,7 +771,7 @@ files: _CoqProject $(FILES:.v=.vo)
 #
 # Add conclib_coqlib, conclib_sublist, and conclib_veric to the targets
 #
-simpleconc: concurrency/conclib.vo concurrency/ghosts.vo atomics/verif_lock.vo
+simpleconc: concurrency/conclib.vo atomics/verif_lock.vo
 msl:     _CoqProject $(MSL_FILES:%.v=msl/%.vo)
 sepcomp: _CoqProject $(CC_TARGET) $(SEPCOMP_FILES:%.v=sepcomp/%.vo)
 concurrency: _CoqProject $(CC_TARGET) $(SEPCOMP_FILES:%.v=sepcomp/%.vo) $(CONCUR_FILES:%.v=concurrency/%.vo)
@@ -830,20 +817,12 @@ VST.config:
 # Note: doc files are installed into the coq destination folder.
 # This is not ideal but otherwise it gets tricky to handle variants
 install: VST.config
+	install -d "$(INSTALLDIR)"
 	install -d "$(INSTALLDIR)"
 	for d in $(sort $(dir $(INSTALL_FILES) $(EXTRA_INSTALL_FILES))); do install -d "$(INSTALLDIR)/$$d"; done
 	for f in $(INSTALL_FILES); do install -m 0644 $$f "$(INSTALLDIR)/$$(dirname $$f)"; done
 	for f in $(EXTRA_INSTALL_FILES); do install -m 0644 $$f "$(INSTALLDIR)/$$(dirname $$f)"; done
 
-build-iris: _CoqProject
-	$(COQC) $(COQFLAGS) $(PROGSDIR)/incr.v
-	for f in $(IRIS_INSTALL_FILES_SRC); do if [ "$${f##*.}" = "v" ]; then echo COQC $$f; $(COQC) $(COQFLAGS) $$f; fi; done
-
-install-iris: VST.config
-	install -d "$(INSTALLDIR)"
-	for d in $(sort $(dir $(IRIS_INSTALL_FILES))); do install -d "$(INSTALLDIR)/$$d"; done
-	for f in $(IRIS_INSTALL_FILES); do install -m 0644 $$f "$(INSTALLDIR)/$$(dirname $$f)"; done
-
 dochtml:
 	mkdir -p doc/html
 	$(COQDOC) $(MSL_FILES:%=msl/%) $(VERIC_FILES:%=veric/%) $(FLOYD_FILES:%=floyd/%) $(SEPCOMP_FILES:%=sepcomp/%)
@@ -910,11 +889,11 @@ floyd/floyd.coq: floyd/proofauto.vo
 	@echo 'coqdep ... >.depend'
 ifeq ($(COMPCERT_NEW),true)
 	# DEPENDENCIES VARIANT COMPCERT_NEW
-	$(COQDEP) $(DEPFLAGS) 2>&1 >.depend `find $(filter $(wildcard *), $(DIRS) concurrency/common concurrency/compiler concurrency/juicy concurrency/util paco concurrency/sc_drf) -name "*.v"` | grep -v 'Warning:.*found in the loadpath' || true
+	$(COQDEP) $(DEPFLAGS) 2>&1 >.depend `find $(filter $(wildcard *), $(DIRS) refinedVST concurrency/common concurrency/compiler concurrency/juicy concurrency/util paco concurrency/sc_drf) -name "*.v"` | grep -v 'Warning:.*found in the loadpath' || true
 	@echo "" >>.depend
 else
 	# DEPENDENCIES DEFAULT
-	$(COQDEP) $(DEPFLAGS) 2>&1 >.depend `find $(filter $(wildcard *), $(DIRS)) -name "*.v"` | grep -v 'Warning:.*found in the loadpath' || true
+	$(COQDEP) $(DEPFLAGS) 2>&1 >.depend `find $(filter $(wildcard *), $(DIRS) refinedVST) -name "*.v"` | grep -v 'Warning:.*found in the loadpath' || true
 endif
 ifeq ($(COMPCERT_BUILD_FROM_SRC),true)
 	# DEPENDENCIES TO BUILD COMPCERT FROM SOURCE
@@ -951,6 +930,10 @@ clean-concur:
 clean-linking:
 	rm -f $(LINKING_FILES:%.v=linking/%.vo) $(LINKING_FILES:%.v=linking/%.glob)
 
+clean-refinedVST-frontend:
+	rm -fr refinedVST/typing/frontend_stuff/_build
+	rm -fr refinedVST/typing/frontend_stuff/examples/proofs
+
 count:
 	wc $(FILES)
 
diff --git a/Makefile.bundled b/Makefile.bundled
index cc9bb784ce..f014116dc1 100644
--- a/Makefile.bundled
+++ b/Makefile.bundled
@@ -122,13 +122,13 @@ else
 endif
 COMPCERTDIRS=lib common $(ARCHDIRS) cfrontend export
 COMPCERT_FLAGS= $(foreach d, $(COMPCERTDIRS), -Q $(COMPCERT_INST_DIR)/$(d) compcert.$(d))
-VST_DIRS= msl sepcomp veric zlist floyd 
+VST_DIRS= msl shared sepcomp veric zlist floyd 
 else
 COMPCERTFLAGS=
 VST_DIRS=
 endif
 
-VSTFLAGS= $(COMPCERT_FLAGS) $(foreach d, $(VST_DIRS), -Q $(VST_LOC)/$(d) VST.$(d)) -R . pile
+VSTFLAGS= $(COMPCERT_FLAGS) -Q $(VST_LOC)/ora/theories iris_ora $(foreach d, $(VST_DIRS), -Q $(VST_LOC)/$(d) VST.$(d)) -R . pile
 
 ifdef CLIGHTGEN
 VERSION1= $(lastword $(shell $(CLIGHTGEN) --version))
@@ -143,5 +143,4 @@ all:  # need this so that _CoqProject does not become the default target
 _CoqProject: Makefile
 	@echo $(VSTFLAGS) > _CoqProject
 
-FLOYD= $(VST_LOC)/floyd/proofauto.vo $(VST_LOC)/floyd/VSU.vo
-
+FLOYD= $(VST_LOC)/floyd/proofauto.vo $(VST_LOC)/floyd/compat.vo $(VST_LOC)/floyd/VSU.vo
diff --git a/PORTING.md b/PORTING.md
new file mode 100644
index 0000000000..6f2eb7bf21
--- /dev/null
+++ b/PORTING.md
@@ -0,0 +1,80 @@
+# Porting VST developments from VST 2.x to VST 3.x
+
+VST 3.0 has quite a few changes from VST 2.x: the separation logic uses Iris-style notations, and predicates such as `data_at` and `semax` have different implicit arguments.
+
+The *simplest* method to port is called "naive oracle-monomorphic", and you start by,
+
+```
+Require Import VST.floyd.compat.  Import NoOracle.
+```
+
+Even in compatibility mode, there are a few things that cannot be made backwards-compatible. Here are some tips on making the minimum necessary changes to port your proofs to 3.0.
+
+* The scope `logic` no longer exists, and has been replaced by the Iris scope `I`, which is open by default. Remove `Open Scope logic` and `%logic` throughout.
+* The implicit arguments of almost every definition have changed, so references to `@data_at`, `@semax`, etc. will break. We strongly recommend naming implicit arguments explicitly instead (e.g., `data_at(cs := cs)` instead of `@data_at cs`).
+* `semax` also takes an extra explicit argument, an invariant mask `E`. This is automatically instantiated by `semax_body`, but it will affect the statement of lemmas that are stated directly on `semax`. For almost all purposes, you can use the default value `⊤`.
+* Assertions with explicit type annotations of `environ -> mpred` should be changed to `assert`. More generally, the transition between `assert`s and `mpred`s is not as automatic as in VST 2.x, and you may run into trouble with proofs that rely heavily on automatic lifting.
+* The `Espec`/`OracleKind` mechanism has been refactored. `Existing Instance NullExtension.Espec` is no longer necessary to state `semax_prog` lemmas, and should be removed.
+* `mpred`s are not extensional by default: i.e., you cannot prove `P = Q` by proving `P |-- Q` and `Q |-- P`. You can, however, prove `P ⊣⊢ Q`, which can be given to `rewrite` and generally functions the same as equality in most cases. If you really want equality rather than equivalence, you can prove it by rewriting with equalities, and many useful lemmas hav already been proved as equalities.
+* Proofs that rely on rewriting with `sepcon_assoc` and `sepcon_comm` may break, for several reasons: most notably, `*` is now right-associative instead of left-associative, and several tactics now associate this way by default. The best way to handle these proofs is to use Iris Proof Mode, which you can still use in compatibility mode. It should also still be possible to do these proofs with rewrites, but you may have to adjust their order and direction.
+* Coq sometimes has trouble inferring the type of `funspec`s. You can fix this by adding a type annotation as appropriate (`: funspec`, `: ident * funspec`, etc.).
+* When a postcondition has multiple existentials, the order in which `normalize` and `entailer` rearrange them is sometimes different from 2.x. You may find that you need to swap the order of two successive `Exists` tactics.
+* `Funspec_old_Notation` is no longer supported. We strongly recommend updating to the new, more convenient funspec notation (using `PARAMS` instead of `LOCAL` in the function precondition). You can uncomment the contents of `floyd/Funspec_old_Notation.v` if you really want to use it, but do so at your own risk: in the worst case, functions declared with it may cause `start_function` to run forever.
+
+If you encounter a porting problem you're unsure how to solve, or a bug in the new version, please contact [mansky1@uic.edu](mailto:mansky1@uic.edu).
+
+## Oracle polymorphism
+
+A *more sophisticated* method is to omit the `Import NoOracle`.
+
+`Require Import VST.floyd.compat.`  `(*` ~~Import NoOracle.~~ `*)`
+
+Predicates and judgments such as `data_at`, `semax`, and others have an implicit argument `Σ: gFunctors`, along with other implicit arguments about properties of Σ.  These are generally instantiated by typeclass resolution.  This argument represents the "ghost world" or "external environment" or "oracle", the things that your C program might touch that are _outside_ the ordinary memory filled with structs and arrays.  In different verifications, you may use different types of ghost world, which is why we need a parameter Σ.
+
+But many functions you write can be proved correct without any reference to the ghost world.  These verifications should work no matter what kind of oracle there is.  We call these functions "oracle-polymorphic".  If your function doesn't do I/O and doesn't syncronize on locks or atomics, then probably it can be oracle-polymorphic.
+
+The "naive oracle-monomorphic" method described above, when you `Import NoOracle`, makes visible a typeclass that provides an instance of Σ that has a trivial (unit-value) oracle.  This works for proving these "simple in-memory" functions.  But the problem arises when you call such a function from a place that is oracle-relevant.  That is, if your function that does concurrent synchronization or I/O (and needs a particular type Σ) calls your simple in-memory function, that you have proved correct with the default Σ, then you will have a type mismatch.
+
+The solution is to make your entire specification and verification, of those functions that don't care about the type of Σ, actually polymorphic in Σ.  You can do this as follows:
+
+```
+Section GFUNCTORS.
+Context `{VSTGS_OK: !VSTGS OK_ty Σ}.
+(* . . . funspecs and semax_body proofs for oracle-polymorphic functions *)
+Definition f1_spec := DECLARE ... WITH ... PRE ... POST.
+Definition f2_spec := DECLARE ... WITH ... PRE ... POST.
+Definition Gprog_poly : funspecs := [f1_spec; f2_spec].
+
+Lemma body_f1: semax_body Vprog Gprog_poly f_f1 f1_spec.
+Proof. ... Qed.
+Lemma body_f2: semax_body Vprog Gprog_poly f_f2 f2_spec.
+Proof. ... Qed.
+
+End GFUNCTORS.
+```
+
+### Verifying `main` with `main_pre`
+
+Even if most of your program is oracle-polymorphic, the `main` function is not quite.  VST's default precondition for `main`, called `main_pre`, requires you to specify an initial value for the oracle.  In a typical simple verification, where the oracle type is `unit`, then the initial value is simply `tt`.  For that to work, you have to use some
+Σ whose `OK_ty` is unit.
+
+The solution is to `Import NoOracle`; what that does is exactly to make available a `VST_default` typeclass with a `VSTΣ` whose oracle-type is unit.  In order to limit the use of this Import to those places where you really want it---to avoid polluting your namespace when reasoning about oracle-polymorphic functions---you might put the Import into a Section that limits its scope:
+
+```
+Section LimitImport. Import NoOracle.
+ Definition main_spec :=
+   DECLARE _main
+   WITH gv : globals
+   PRE  [] main_pre prog tt gv
+   POST [ tint ] main_post prog gv.
+End LimitImport.
+```
+You have to be careful not to put `main_spec` into your `Gprog_poly` that's used for the `semax_body` proofs of your oracle-polymorphic functions.
+
+The example program `progs64/verif_revarray.v` in the VST repo illustrates this method.  
+But really, if you are being sophisticated about abstraction and modularity in this way, keeping track of which Gprog you use for each semax_body proof,
+then you should be using the [VSU](https://softwarefoundations.cis.upenn.edu/vc-current/VSU_intro.html) system.
+
+
+
+
diff --git a/README.md b/README.md
index d000837210..65e6b7f2c1 100644
--- a/README.md
+++ b/README.md
@@ -17,7 +17,7 @@ The [LICENSE](LICENSE) file has information about copyright, licensing, and perm
 
 ## How to install:
 
-[See here for instructions](BUILD_ORGANIZATION.md#install-method-1-use-the-coq-platform).
+[See here for instructions](./ivst.md).
 
 ## Documentation:
 
diff --git a/RefinedVST.md b/RefinedVST.md
new file mode 100644
index 0000000000..378ccf97dc
--- /dev/null
+++ b/RefinedVST.md
@@ -0,0 +1,36 @@
+# RefinedVST
+The refinedVST project is adapted from [RefinedC](https://gitlab.mpi-sws.org/iris/refinedc).
+
+This is still work in progress.
+
+## Build Instruction
+We will need VST, Cerberus, and CompCert 3.15 to generate the frontend. We assume the dependency of VST is installed and an opam switch is set up.
+
+TODO fix VST build instruction
+
+### VST
+The interface of the backend of RefinedVST is refinedVST/typing/typing.v:
+```
+make refinedVST/typing/typing.vo -j <jobs>
+```
+
+### Cerberus
+You can either install Cerberus by installing [RefinedC](https://gitlab.mpi-sws.org/iris/refinedc), or by following the Cerberus-specific lines of RefinedC's installation instructions, namely:
+```
+opam pin add -n -y cerberus-lib "git+https://github.com/rems-project/cerberus.git#57c0e80af140651aad72e3514133229425aeb102"
+opam pin add -n -y cerberus "git+https://github.com/rems-project/cerberus.git#57c0e80af140651aad72e3514133229425aeb102"
+```
+
+## Running the frontend
+The entry point for the frontend is in [./refinedVST/typing/frontend_stuff/Makefile](./refinedVST/typing/frontend_stuff/Makefile), adapted from the RefinedC frontend.
+
+However the best way to use the frontend is to use the script [RefinedVST.sh](RefinedVST.sh):
+```
+./RefinedVST.sh
+```
+ The script checks [./refinedVST/typing/frontend_stuff/examples/test_f_temps.c](./refinedVST/typing/frontend_stuff/examples/test_f_temps.c) and generates proofs in [./refinedVST/typing/frontend_stuff/examples/proofs](./refinedVST/typing/frontend_stuff/examples/proofs).
+
+To delete generated files:
+```
+make clean-refinedVST-frontend
+```
diff --git a/RefinedVST.sh b/RefinedVST.sh
new file mode 100755
index 0000000000..ed9bcd0d08
--- /dev/null
+++ b/RefinedVST.sh
@@ -0,0 +1,44 @@
+#!/usr/bin/env bash
+
+# Usage: ./RefinedVST.sh
+# Assume path is root of VST
+# Change input path here; path is relevant path to ./refinedVST/typing/frontend_stuff, where the frontend is located
+c_file="examples/test_f_temps.c"
+
+pushd ./refinedVST/typing/frontend_stuff || exit
+basename=$(basename -- "$c_file" .${c_file##*.})
+dirname=$(dirname -- "$c_file")
+absolute_dir=$(realpath "$dirname")
+stripped_file="${dirname}/${basename}_stripped.c"
+generated_dir="${absolute_dir}/proofs/${basename}"
+
+# generates the clight AST
+dune exec -- refinedc check "$c_file"
+sed 's/\[\[rc::[^]]*\]\]//g' "$c_file" > "$stripped_file"
+# compcert must be < 3.15
+clightgen -normalize "$stripped_file" -o "${generated_dir}/generated_code_vst_clight.v"
+popd || exit
+
+# compile stuff
+REFINEDVSTFLAGS="-R ${generated_dir} VST.typing.examples.${basename}"
+# make .depend -B REFINEDVSTFLAGS="${REFINEDVSTFLAGS}"
+
+make "${generated_dir}/generated_code_vst_clight.vo"   -j  REFINEDVSTFLAGS="${REFINEDVSTFLAGS}"
+make "${generated_dir}/generated_code_vst.vo"          -j  REFINEDVSTFLAGS="${REFINEDVSTFLAGS}"
+make "${generated_dir}/generated_spec_vst.vo"          -j  REFINEDVSTFLAGS="${REFINEDVSTFLAGS}"
+
+# find all files that starts with the name "generated_proof" in ${generated_dir}
+proofs=$(find "${generated_dir}" -name "generated_proof*.v")
+proofs_compiled=()
+for proof in $proofs; do
+    make "${proof}o" -j  REFINEDVSTFLAGS="${REFINEDVSTFLAGS}"; proofs_compiled+=("${proofs}") || perror "Failed to compile ${proof}"
+done
+
+make _CoqProject -B REFINEDVSTFLAGS="${REFINEDVSTFLAGS}"
+
+# set colour to green
+echo -e "\033[0;32m"
+for proof_compiled in $proofs_compiled; do
+    echo "Successfully checked: ${proof_compiled}"
+done
+echo -e "\033[0m"
\ No newline at end of file
diff --git a/VERSION b/VERSION
index e3d0696453..a1ea40f83f 100644
--- a/VERSION
+++ b/VERSION
@@ -1 +1 @@
-2.15
+3.1beta
diff --git a/aes/api_specs.v b/aes/api_specs.v
index d131a74a55..ea24cd9068 100644
--- a/aes/api_specs.v
+++ b/aes/api_specs.v
@@ -1,4 +1,5 @@
 Require Export VST.floyd.proofauto.
+Require Export VST.floyd.compat. Export NoOracle.
 Require Export VST.floyd.reassoc_seq.
 Require Export aes.aes.
 Require Export aes.GF_ops_LL.
@@ -7,10 +8,6 @@ Require Export aes.spec_utils_LL.
 Require Export aes.list_utils.
 Require Export aes.spec_encryption_LL.
 
-Open Scope logic.
-Local Open Scope Z.
-
-Require Import VST.floyd.Funspec_old_Notation.
 #[export] Instance CompSpecs : compspecs.
 Proof. make_compspecs prog. Defined.
 Definition Vprog : varspecs.  mk_varspecs prog. Defined.
@@ -35,7 +32,8 @@ Definition gen_tables_spec :=
     WITH gv: globals
     PRE [  ]
       PROP ()
-      LOCAL (gvars gv)
+      PARAMS ()
+      GLOBALS (gv)
       SEP (tables_uninitialized (gv _tables))
     POST [ tvoid ]
       PROP ()
@@ -120,12 +118,12 @@ Definition key_expansion_spec :=
   DECLARE _mbedtls_aes_setkey_enc
     WITH ctx : val, key : val, ctx_sh : share, key_sh : share, key_chars : list Z,
          init_done : Z, ish: share, gv: globals
-    PRE [ _ctx OF (tptr t_struct_aesctx), _key OF (tptr tuchar), _keybits OF tuint  ]
+    PRE [ tptr t_struct_aesctx, tptr tuchar, tuint ]
       PROP (writable_share ctx_sh; readable_share key_sh; readable_share ish;
             Zlength key_chars = 32;
             init_done = 1 (*TODO also prove case where init_done=0*))
-      LOCAL (temp _ctx ctx; temp _key key; temp _keybits (Vint (Int.repr 256)); 
-             gvars gv)
+      PARAMS (ctx; key; Vint (Int.repr 256))
+      GLOBALS (gv)
       SEP (data_at ctx_sh t_struct_aesctx 
                    (Vint Int.zero,
                    (nullval, 
@@ -134,8 +132,8 @@ Definition key_expansion_spec :=
            (*if init_done ?= 1 then tables_initialized tables else tables_uninitialized tables*)
            data_at ish tint (Vint (Int.repr init_done)) (gv _aes_init_done);
            tables_initialized (gv _tables))
-    POST [  tint ]
-      PROP () 
+    POST [ tint ]
+      PROP ()
       LOCAL (temp ret_temp (Vint Int.zero))
       SEP (data_at key_sh (tarray tuchar (4*8)) (map Vint (map Int.repr key_chars)) key;
            data_at ctx_sh t_struct_aesctx 
@@ -154,10 +152,11 @@ Definition encryption_spec_ll :=
        plaintext : list Z, (* 16 chars *)
        exp_key : list Z, (* expanded key, 4*(Nr+1)=60 32-bit integers *)
        gv: globals (* global var *)
-  PRE [ _ctx OF (tptr t_struct_aesctx), _input OF (tptr tuchar), _output OF (tptr tuchar) ]
+  PRE [ tptr t_struct_aesctx, tptr tuchar, tptr tuchar ]
     PROP (Zlength plaintext = 16; Zlength exp_key = 60;
           readable_share ctx_sh; readable_share in_sh; writable_share out_sh)
-    LOCAL (temp _ctx ctx; temp _input input; temp _output output; gvars gv)
+    PARAMS (ctx; input; output)
+    GLOBALS (gv)
     SEP (data_at ctx_sh (t_struct_aesctx) (
           (Vint (Int.repr Nr)),
           ((field_address t_struct_aesctx [StructField _buf] ctx),
diff --git a/aes/verif_encryption_LL.v b/aes/verif_encryption_LL.v
index 346bd00a92..4813f80d31 100644
--- a/aes/verif_encryption_LL.v
+++ b/aes/verif_encryption_LL.v
@@ -4,7 +4,6 @@ Require Import aes.encryption_LL_round_step_eqs.
 Require Import aes.verif_encryption_LL_loop_body.
 Require Import aes.verif_encryption_LL_after_loop.
 Open Scope Z.
-Require Import VST.floyd.Funspec_old_Notation.
 
 Lemma body_aes_encrypt: semax_body Vprog Gprog f_mbedtls_aes_encrypt encryption_spec_ll.
 Proof.
diff --git a/aes/verif_encryption_LL_after_loop.v b/aes/verif_encryption_LL_after_loop.v
index 86c0d1360d..2ff3120f2a 100644
--- a/aes/verif_encryption_LL_after_loop.v
+++ b/aes/verif_encryption_LL_after_loop.v
@@ -24,12 +24,12 @@ lazymatch goal with
     remember_temp_Vints ((temp Id (Vint V0)) :: done)
   | _ => remember_temp_Vints (T :: done)
   end
-| |- semax _ (PROPx _ (LOCALx done (SEPx _))) _ _ => idtac
+| |- semax _ _ (PROPx _ (LOCALx done (SEPx _))) _ _ => idtac
 | _ => fail 100 "assertion failure: did not find" done
 end.
 
 Lemma encryption_after_loop_proof:
-forall (Espec : OracleKind) (ctx input output : val)
+forall Espec E (ctx input output : val)
   (ctx_sh in_sh out_sh : share) (plaintext (*exp_key*) : list Z) (gv: globals)
  (H: Zlength plaintext = 16)
  (SH: readable_share ctx_sh)
@@ -48,7 +48,7 @@ forall (Espec : OracleKind) (ctx input output : val)
   let S0 := mbed_tls_initial_add_round_key plaintext buf in
    forall (S12 : four_ints)
    (HeqS12: S12 = mbed_tls_enc_rounds 12 S0 buf 4),
-semax (func_tycontext f_mbedtls_aes_encrypt Vprog Gprog nil)
+semax(OK_spec := Espec) E (func_tycontext f_mbedtls_aes_encrypt Vprog Gprog nil)
   (PROP ( )
    LOCAL (temp _RK
             (field_address t_struct_aesctx [ArraySubsc 52; StructField _buf]
@@ -65,8 +65,7 @@ semax (func_tycontext f_mbedtls_aes_encrypt Vprog Gprog nil)
            ctx))
   encryption_after_loop
   (normal_ret_assert
-    (@sepcon (environ->mpred) _ _
-     (PROP ( )
+    (bi_sep (PROP ( )
       LOCAL ()
       SEP (data_at ctx_sh t_struct_aesctx
              (Vint (Int.repr spec_utils_LL.Nr),
@@ -77,7 +76,7 @@ semax (func_tycontext f_mbedtls_aes_encrypt Vprog Gprog nil)
         (map Vint (map Int.repr plaintext)) input;
       data_at out_sh (tarray tuchar 16)
         (map Vint (mbed_tls_aes_enc plaintext buf)) output;
-      tables_initialized (gv _tables))) 
+      tables_initialized (gv _tables)))
       (stackframe_of f_mbedtls_aes_encrypt))).
 Proof.
 intros.
diff --git a/aes/verif_encryption_LL_loop_body.v b/aes/verif_encryption_LL_loop_body.v
index 266627ed8e..45ac52344e 100644
--- a/aes/verif_encryption_LL_loop_body.v
+++ b/aes/verif_encryption_LL_loop_body.v
@@ -1,7 +1,6 @@
 Require Import aes.api_specs.
 Require Import aes.spec_encryption_LL.
 Require Import aes.bitfiddling.
-Local Open Scope Z.
 
 Definition encryption_loop_body : statement :=
    ltac:(find_statement_in_body
@@ -17,7 +16,7 @@ Definition encryption_loop_body : statement :=
 
 Definition encryption_loop_body_proof_statement :=
  forall
-  (Espec : OracleKind)
+  Espec E
   (ctx input output : val)
   (ctx_sh in_sh out_sh : share)
   (plaintext exp_key : list Z)
@@ -43,7 +42,7 @@ Definition encryption_loop_body_proof_statement :=
   (HeqS12 : S12 = mbed_tls_enc_rounds 12 S0 buf 4)
   (i : Z)
   (H1 : 0 < i <= 6),
-semax (func_tycontext f_mbedtls_aes_encrypt Vprog Gprog nil)
+semax(OK_spec := Espec) E (func_tycontext f_mbedtls_aes_encrypt Vprog Gprog nil)
   (PROP ( )
    LOCAL (temp _i (Vint (Int.repr i));
    temp _RK
diff --git a/aes/verif_gen_tables_LL.v b/aes/verif_gen_tables_LL.v
index 88b23c5a26..ac56663ede 100644
--- a/aes/verif_gen_tables_LL.v
+++ b/aes/verif_gen_tables_LL.v
@@ -1,7 +1,6 @@
 Require Import aes.api_specs.
 Require Import aes.partially_filled.
 Require Import aes.bitfiddling.
-Open Scope Z.
 Require Import VST.floyd.Funspec_old_Notation.
 
 (* Note: x must be non-zero, y is allowed to be zero (because x is a constant in all usages, its
@@ -54,7 +53,7 @@ Qed.
 (* QQQ TODO does this already exist? Add to library? *)
 Ltac forward_if_diff add := match add with
 | (PROPx ?P2 (LOCALx ?Q2 (SEPx ?R2))) => match goal with
-  | |- semax ?Delta (PROPx ?P1 (LOCALx ?Q1 (SEPx ?R1))) _ _ =>
+  | |- semax _ ?Delta (PROPx ?P1 (LOCALx ?Q1 (SEPx ?R1))) _ _ =>
     let P3 := fresh "P3" in let Q3 := fresh "Q3" in let R3 := fresh "R3" in
     pose (P3 := P1 ++ P2); pose (Q3 := Q1 ++ Q2); pose (R3 := R1 ++ R2);
     simpl in P3, Q3, R3;
@@ -72,7 +71,7 @@ Proof.
   intros. rewrite H. apply derives_refl.
 Qed.
 
-Definition rcon_loop_inv00(i: Z)(v_pow v_log: val)(gv: globals)(frozen: list mpred) : environ -> mpred :=
+Definition rcon_loop_inv00(i: Z)(v_pow v_log: val)(gv: globals)(frozen: list mpred) : assert :=
      PROP ( 0 <= i) (* note: the upper bound is added by the tactic, but the lower isn't! *)
      LOCAL (temp _x (Vint (pow2 i));
             lvar _log (tarray tint 256) v_log;
@@ -259,8 +258,8 @@ Proof.
         forward.
         entailer!!.
         { f_equal. unfold pow3. rewrite repeat_op_step by lia. reflexivity. }
-        { Exists (upd_Znth i pow (Vint (pow3 i))).
-          Exists (upd_Znth (Int.unsigned (pow3 i)) log (Vint (Int.repr i))).
+        { Exists (upd_Znth (Int.unsigned (pow3 i)) log (Vint (Int.repr i))).
+          Exists (upd_Znth i pow (Vint (pow3 i))).
           entailer!. assert (0 <= i < 256) by lia. repeat split.
           - rewrite upd_Znth_diff.
               + assumption.
@@ -390,8 +389,8 @@ Proof.
   { (* loop invariant holds initially: *)
     unfold gen_sbox_inv00.
     entailer!!.
-    Exists (upd_Znth 99 Vundef256 (Vint (Int.repr 0))).
     Exists (upd_Znth 0 Vundef256 (Vint (Int.repr 99))).
+    Exists (upd_Znth 99 Vundef256 (Vint (Int.repr 0))).
     entailer!!.
     intros. assert (j = 0) by lia. subst j. rewrite upd_Znth_same.
       * reflexivity.
@@ -431,7 +430,7 @@ Proof.
     - (* postcondition implies loop invariant *)
       entailer!!.
         match goal with
-        | |- (field_at _ _ _ ?fsb' _ * field_at _ _ _ ?rsb' _)%logic |-- _ => Exists rsb'; Exists fsb'
+        | |- (field_at _ _ _ ?fsb' _ * field_at _ _ _ ?rsb' _) |-- _ => Exists fsb'; Exists rsb'
         end.
         entailer!!. repeat split.
         + rewrite upd_Znth_diff; (lia || auto).
@@ -846,10 +845,8 @@ Proof.
   forget RT2 as RT2'.
   forget RT3 as RT3'.
   repeat (let j := fresh "j" in set (j := field_at _ _ _ _ _); clearbody j).
-  go_lowerx. cancel.
   unfold stackframe_of.
-  simpl.
-  rewrite sepcon_emp.
+  go_lowerx. cancel.
   apply sepcon_derives;
     sep_apply data_at_data_at_; eapply var_block_lvar0; eauto; reflexivity.
 } }
diff --git a/aes/verif_setkey_enc_LL.v b/aes/verif_setkey_enc_LL.v
index 41150bda29..bc7573d28f 100644
--- a/aes/verif_setkey_enc_LL.v
+++ b/aes/verif_setkey_enc_LL.v
@@ -2,15 +2,13 @@ Require Import aes.api_specs.
 Require Import aes.partially_filled.
 Require Import aes.bitfiddling.
 Require Import aes.verif_setkey_enc_LL_loop_body.
-Local Open Scope logic.
-Open Scope Z.
 Require Import VST.floyd.Funspec_old_Notation.
 
 (* Calls forward_if with the current precondition to which the provided conditions are added *)
 (* QQQ TODO does this already exist? Add to library? *)
 Ltac forward_if_diff add := match add with
 | (PROPx ?P2 (LOCALx ?Q2 (SEPx ?R2))) => match goal with
-  | |- semax ?Delta (PROPx ?P1 (LOCALx ?Q1 (SEPx ?R1))) _ _ =>
+  | |- semax _ ?Delta (PROPx ?P1 (LOCALx ?Q1 (SEPx ?R1))) _ _ =>
     let P3 := fresh "P3" in let Q3 := fresh "Q3" in let R3 := fresh "R3" in
     pose (P3 := P1 ++ P2); pose (Q3 := Q1 ++ Q2); pose (R3 := R1 ++ R2);
     simpl in P3, Q3, R3;
@@ -87,7 +85,7 @@ Proof.
   start_function.
   forward.
   match goal with
-  | |- semax ?Delta (PROPx ?P1 (LOCALx ?Q1 (SEPx ?R1))) _ _ =>
+  | |- semax _ ?Delta (PROPx ?P1 (LOCALx ?Q1 (SEPx ?R1))) _ _ =>
     forward_if (PROPx P1 (LOCALx Q1 (SEPx R1)))
   end.
   congruence. (* then-branch: contradiction *)
@@ -190,10 +188,10 @@ Proof.
   set (R:=(KeyExpansion2 (key_bytes_to_key_words key_chars))).
   forward.
   rewrite Vundef_is_Vint. cancel.
-  unfold_data_at (1%nat). rewrite <- sepcon_assoc.
-  apply sepcon_derives. cancel.
-  apply derives_refl'. subst R. Time (simpl; reflexivity). (*45s*)
-
+  unfold_data_at (1%nat).
+  f_equiv. f_equiv. subst R.
+  match goal with |-field_at _ _ _ ?a _ ⊢ field_at _ _ _ ?b _ => replace b with a; [auto|] end.
+  Time (simpl; reflexivity). (*45s*)
 
   Fail idtac.  (* make sure there are no subgoals *)
 (* Time Qed. takes forever, many minutes on a fast machine, then I gave up.  Appel, March 2018, Coq 8.7.2 *)
diff --git a/aes/verif_setkey_enc_LL_loop_body.v b/aes/verif_setkey_enc_LL_loop_body.v
index 603eec7b24..9df0338e0b 100644
--- a/aes/verif_setkey_enc_LL_loop_body.v
+++ b/aes/verif_setkey_enc_LL_loop_body.v
@@ -1,8 +1,6 @@
 Require Import aes.api_specs.
 Require Import aes.partially_filled.
 Require Import aes.bitfiddling.
-Open Scope Z.
-Local Open Scope logic.
 
 (* Calls forward_if with the current precondition to which the provided conditions are added *)
 (* QQQ TODO does this already exist? Add to library? *)
@@ -483,13 +481,13 @@ Definition setkey_enc_loop_body :=
                                                                     (tptr tuint)))))))))))))))))))))))))))))))))))).
 
 Lemma setkey_enc_loop_body_lemma:
-forall 
- (Espec : OracleKind) (ctx key : val) (ctx_sh key_sh : share) 
+forall
+ Espec M (ctx key : val) (ctx_sh key_sh : share) 
  (key_chars : list Z) (init_done : Z) (ish : share) (gv: globals)
  (SH : writable_share ctx_sh) (SH0 : readable_share key_sh) (SH1 : readable_share ish)
  (H : Zlength key_chars = 32) (H0 : init_done = 1) (i : Z)
  (H1 : 0 <= i < 7),
-semax (func_tycontext f_mbedtls_aes_setkey_enc Vprog Gprog [])
+semax(OK_spec := Espec) M (func_tycontext f_mbedtls_aes_setkey_enc Vprog Gprog [])
   (PROP ( )
    LOCAL (temp _i (Vint (Int.repr i));
    temp _RK
@@ -553,8 +551,8 @@ clearbody Delta_specs.
     Ltac RK_load :=
       let A := fresh "A" in let E2 := fresh "E" in
       match goal with 
-        E: forall j, 0 <= j < 16 -> force_val _ = _ |- 
-        semax _ _ (Ssequence (Sset _ (Ederef (Ebinop _ _ (Econst_int (Int.repr ?j) _) _) _)) _) _
+        E: forall j, 0 <= j < 16 -> force_val _ = _ |-
+        semax _ _ _ (Ssequence (Sset _ (Ederef (Ebinop _ _ (Econst_int (Int.repr ?j) _) _) _)) _) _
        =>
         assert (0 <= j < 16) as A by computable;
         pose proof (E _ A) as E2; clear A
@@ -598,7 +596,7 @@ clearbody Delta_specs.
       let A := fresh "A" in let E2 := fresh "E" in
       match goal with
          E: forall j, 0 <= j < 16 -> force_val _ = _
-        |- semax _ _ (Ssequence (Sassign (Ederef (Ebinop _ _ (Econst_int (Int.repr ?j) _) _) _) _) _) _ 
+        |- semax _ _ _ (Ssequence (Sassign (Ederef (Ebinop _ _ (Econst_int (Int.repr ?j) _) _) _) _) _) _ 
         =>
           assert (0 <= j < 16) as A by computable;
          pose proof (E _ A) as E2; clear A
@@ -659,18 +657,17 @@ clearbody Delta_specs.
     RK_load.
     RK_store.
 
-    forward. 
+    forward.
     destruct ctx; inv P.
-    thaw FR1. 
+    thaw FR1.
     entailer!.
     - clear. f_equal. simpl. lia. 
     - clear.
       subst PFUN ROT KE2.
       repeat match goal with A := _ |- _ => fold A end.
-      apply derives_refl'.
-      f_equal.
+      f_equiv.
       match goal with |- _ = ?b => set (B:=b) end.
       rewrite ?update_partially_expanded_key by lia.
-      subst B. clear. 
+      subst B. clear.
       f_equal. f_equal. f_equal. f_equal. lia. f_equal. lia.
 Time Qed.
diff --git a/atomics/SC_atomics.v b/atomics/SC_atomics.v
index cda056952c..9a61467159 100644
--- a/atomics/SC_atomics.v
+++ b/atomics/SC_atomics.v
@@ -1,24 +1,32 @@
-Require Import stdpp.coPset.
-Require Import VST.veric.rmaps.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.concurrency.ghosts.
+(* Hoare rules for SC atomics *)
 Require Import VST.concurrency.conclib.
-Require Import VST.concurrency.fupd.
-Require Export VST.atomics.general_atomics.
-Require Import VST.atomics.SC_atomics_base.
 Require Import VST.floyd.library.
 Require Import VST.zlist.sublist.
 
-Opaque eq_dec.
-
 (* Warning: it is UNSOUND to use both this file and acq_rel_atomics.v in the same proof! There is
    not yet an operational model that can validate the use of both SC and RA atomics. *)
 
-(* At present, due to complexities in the specifications of the C11 atomics (generics, _Atomic types, etc.), these are specs for wrapper functions for common cases. *)
+(* At present, due to complexities in the specifications of the C11 atomics (generics, _Atomic types, etc.), these are specs for wrapper functions for common cases.
+   There's probably a more systematic approach possible. *)
 
 Section SC_atomics.
 
-Context {CS : compspecs}  {AI : atomic_int_impl} {AP : atomic_ptr_impl}.
+Context `{!VSTGS OK_ty Σ}.
+
+Class atomic_int_impl (atomic_int : type) := { atomic_int_at : share -> val -> val -> mpred;
+  atomic_int_at__ : forall sh v p, atomic_int_at sh v p ⊢ atomic_int_at sh Vundef p;
+  atomic_int_conflict : forall sh v v' p, sepalg.nonidentity sh -> atomic_int_at sh v p ∗ atomic_int_at sh v' p ⊢ False;
+  atomic_int_isptr : forall sh v p, atomic_int_at sh v p ⊢ ⌜isptr p⌝;
+  atomic_int_timeless sh v p :: Timeless (atomic_int_at sh v p)
+ }.
+
+Class atomic_ptr_impl := { atomic_ptr : type; atomic_ptr_at : share -> val -> val -> mpred;
+  atomic_ptr_conflict : forall sh v v' p, sepalg.nonidentity sh -> atomic_ptr_at sh v p ∗ atomic_ptr_at sh v' p ⊢ False;
+  atomic_ptr_isptr : forall sh v p, atomic_ptr_at sh v p ⊢ ⌜isptr p⌝;
+  atomic_ptr_timeless sh v p :: Timeless (atomic_ptr_at sh v p)
+ }.
+
+Context {CS : compspecs} `{AI : atomic_int_impl} {AP : atomic_ptr_impl}.
 
 Definition make_atomic_spec :=
   WITH v : val
@@ -27,7 +35,7 @@ Definition make_atomic_spec :=
     PARAMS (v)
     SEP ()
   POST [ tptr atomic_int ]
-   EX p : val,
+   ∃ p : val,
     PROP ()
     RETURN (p)
     SEP (atomic_int_at Ews v p).
@@ -39,7 +47,7 @@ Definition make_atomic_ptr_spec :=
     PARAMS (v)
     SEP ()
   POST [ tptr atomic_ptr ]
-   EX p : val,
+   ∃ p : val,
     PROP (is_pointer_or_null p)
     RETURN (p)
     SEP (atomic_ptr_at Ews v p).
@@ -49,7 +57,7 @@ Definition free_atomic_ptr_spec :=
   PRE [ tptr atomic_ptr ]
     PROP (is_pointer_or_null p)
     PARAMS (p)
-    SEP (EX v : val, atomic_ptr_at Ews v p)
+    SEP (∃ v : val, atomic_ptr_at Ews v p)
   POST[ tvoid ]
     PROP ()
     LOCAL ()
@@ -60,7 +68,7 @@ Definition free_atomic_int_spec :=
   PRE [ tptr atomic_int ]
     PROP (is_pointer_or_null p)
     PARAMS (p)
-    SEP (EX v : val, atomic_int_at Ews v p)
+    SEP (∃ v : val, atomic_int_at Ews v p)
   POST[ tvoid ]
     PROP ()
     LOCAL ()
@@ -68,37 +76,28 @@ Definition free_atomic_int_spec :=
 
 Definition AL_type := ProdType (ProdType (ProdType (ConstType val)
   (ConstType coPset)) (ConstType coPset))
-  (ArrowType (ConstType val) Mpred).
+  (DiscreteFunType val Mpred).
 
 Program Definition atomic_load_spec := TYPE AL_type
   WITH p : val, Eo : coPset, Ei : coPset, Q : val -> mpred
   PRE [ tptr atomic_int ]
    PROP (subseteq Ei Eo)
    PARAMS (p)
-   SEP (|={Eo,Ei}=> EX sh : share, EX v : val, !!(readable_share sh) &&
-              atomic_int_at sh v p * (atomic_int_at sh v p -* |={Ei,Eo}=> Q v))%I
+   SEP (|={Eo,Ei}=> ∃ sh : share, ∃ v : val, ⌜readable_share sh⌝ ∧
+              atomic_int_at sh v p ∗ (atomic_int_at sh v p -∗ |={Ei,Eo}=> Q v))
   POST [ tint ]
-   EX v : val,
+   ∃ v : val,
    PROP ()
    RETURN (v)
    SEP (Q v).
 Next Obligation.
 Proof.
-  repeat intro.
-  unfold PROPx, PARAMSx, SEPx; simpl; rewrite !approx_andp; f_equal;
-    f_equal; rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  setoid_rewrite fupd_nonexpansive; do 3 f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality sh.
-  rewrite !approx_exp; apply f_equal; extensionality v.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite fview_shift_nonexpansive; rewrite approx_idem; auto.
+  intros ? (((?, ?), ?), ?) (((?, ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  repeat f_equiv.
 Qed.
 Next Obligation.
-Proof.
-  repeat intro.
-  rewrite !approx_exp; apply f_equal; extensionality v.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 apply f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem; auto.
+  intros ? (((?, ?), ?), ?) (((?, ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  repeat f_equiv.
 Qed.
 
 Definition AS_type := ProdType (ProdType (ProdType (ConstType (val * val))
@@ -109,152 +108,117 @@ Program Definition atomic_store_spec := TYPE AS_type
   PRE [ tptr atomic_int, tint ]
    PROP (subseteq Ei Eo)
    PARAMS (p; v)
-   SEP (|={Eo,Ei}=> EX sh : share, !!(writable_share sh) && atomic_int_at sh Vundef p *
-      (atomic_int_at sh v p -* |={Ei,Eo}=> Q))%I
+   SEP (|={Eo,Ei}=> ∃ sh : share, ⌜writable_share sh⌝ ∧ atomic_int_at sh Vundef p ∗
+      (atomic_int_at sh v p -∗ |={Ei,Eo}=> Q))
   POST [ tvoid ]
    PROP ()
    LOCAL ()
    SEP (Q).
 Next Obligation.
 Proof.
-  repeat intro.
-  unfold PROPx, PARAMSx, SEPx; simpl; rewrite !approx_andp; f_equal;
-    f_equal; rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  setoid_rewrite fupd_nonexpansive; do 3 f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality sh.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite fview_shift_nonexpansive; rewrite approx_idem; auto.
+  intros ? ((((?, ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 Next Obligation.
-Proof.
-  repeat intro.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 apply f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem; auto.
+  intros ? ((((?, ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 
 Definition ACAS_type := ProdType (ProdType (ProdType (ConstType (val * share * val * val * val))
   (ConstType coPset)) (ConstType coPset))
-  (ArrowType (ConstType val) Mpred).
+  (DiscreteFunType val Mpred).
 
 Program Definition atomic_CAS_spec := TYPE ACAS_type
   WITH p : val, shc : share, pc : val, c : val, v : val, Eo : coPset, Ei : coPset, Q : val -> mpred
   PRE [ tptr atomic_int, tptr tint, tint ]
    PROP (readable_share shc; subseteq Ei Eo)
    PARAMS (p; pc; v)
-   SEP (data_at shc tint c pc; |={Eo,Ei}=> EX sh : share, EX v0 : val,
-      !!(writable_share sh) && atomic_int_at sh v0 p *
-           (atomic_int_at sh (if eq_dec v0 c then v else v0) p -* |={Ei,Eo}=> Q v0))%I
+   SEP (data_at shc tint c pc; |={Eo,Ei}=> ∃ sh : share, ∃ v0 : val,
+      ⌜writable_share sh⌝ ∧ atomic_int_at sh v0 p ∗
+           (atomic_int_at sh (if eq_dec v0 c then v else v0) p -∗ |={Ei,Eo}=> Q v0))
   POST [ tint ]
-   EX v' : val,
+   ∃ v' : val,
    PROP ()
    LOCAL (temp ret_temp (vint (if eq_dec v' c then 1 else 0)))
    SEP (data_at shc tint v' pc; Q v').
 Next Obligation.
 Proof.
-  repeat intro.
-  unfold PROPx, PARAMSx, SEPx; simpl; rewrite !approx_andp; f_equal;
-    f_equal; rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  unfold argsassert2assert; rewrite !approx_sepcon; do 2 f_equal.
-  setoid_rewrite fupd_nonexpansive; do 2 f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality sh.
-  rewrite !approx_exp; apply f_equal; extensionality v2.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite fview_shift_nonexpansive; rewrite approx_idem; auto.
+  intros ? (((((((?, ?), ?), ?), ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 Next Obligation.
-Proof.
-  repeat intro.
-  rewrite !approx_exp; apply f_equal; extensionality vr.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 apply f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem; auto.
+  intros ? (((((((?, ?), ?), ?), ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 
 Definition AEX_type := ProdType (ProdType (ProdType (ConstType (val * val))
   (ConstType coPset)) (ConstType coPset))
-  (ArrowType (ConstType val) Mpred).
+  (DiscreteFunType val Mpred).
 
 Program Definition atomic_exchange_spec := TYPE AEX_type
   WITH p : val, v : val, Eo : coPset, Ei : coPset, Q : val -> mpred
-  PRE [ tptr tint, tint ]
+  PRE [ tptr atomic_int, tint ]
    PROP (subseteq Ei Eo)
    PARAMS (p; v)
-   SEP (|={Eo,Ei}=> EX sh : share, EX v0 : val, !!(writable_share sh) &&
-              data_at sh tint v0 p *
-        (data_at sh tint v p -* |={Ei,Eo}=> Q v0))%I
+   SEP (|={Eo,Ei}=> ∃ sh : share, ∃ v0 : val, ⌜writable_share sh⌝ ∧
+              atomic_int_at sh v0 p ∗
+        (atomic_int_at sh v p -∗ |={Ei,Eo}=> Q v0))
   POST [ tint ]
-   EX v' : val,
+   ∃ v' : int,
    PROP ()
-   LOCAL (temp ret_temp v')
-   SEP (Q v').
+   LOCAL (temp ret_temp (Vint v'))
+   SEP (Q (Vint v')).
 Next Obligation.
 Proof.
-  repeat intro.
-  unfold PROPx, PARAMSx, SEPx; simpl; rewrite !approx_andp; f_equal;
-    f_equal; rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  unfold argsassert2assert; f_equal.
-  setoid_rewrite fupd_nonexpansive; do 2 f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality sh.
-  rewrite !approx_exp; apply f_equal; extensionality v0.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite fview_shift_nonexpansive; rewrite approx_idem; auto.
+  intros ? ((((?, ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 Next Obligation.
-Proof.
-  repeat intro.
-  rewrite !approx_exp; apply f_equal; extensionality vr.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 apply f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem; auto.
+  intros ? ((((?, ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 
 (* subspecs for integer operations *)
 Definition ALI_type := ProdType (ProdType (ProdType (ConstType val)
   (ConstType coPset)) (ConstType coPset))
-  (ArrowType (ConstType Z) Mpred).
+  (DiscreteFunType Z Mpred).
 
 Program Definition atomic_load_int_spec := TYPE ALI_type
   WITH p : val, Eo : coPset, Ei : coPset, Q : Z -> mpred
   PRE [ tptr atomic_int ]
    PROP (subseteq Ei Eo)
    PARAMS (p)
-   SEP (|={Eo,Ei}=> EX sh : share, EX v : Z, !!(readable_share sh /\ repable_signed v) &&
-              atomic_int_at sh (vint v) p * (atomic_int_at sh (vint v) p -* |={Ei,Eo}=> Q v))%I
+   SEP (|={Eo,Ei}=> ∃ sh : share, ∃ v : Z, ⌜readable_share sh /\ repable_signed v⌝ ∧
+              atomic_int_at sh (vint v) p ∗ (atomic_int_at sh (vint v) p -∗ |={Ei,Eo}=> Q v))
   POST [ tint ]
-   EX v : Z,
+   ∃ v : Z,
    PROP (repable_signed v)
    LOCAL (temp ret_temp (vint v))
    SEP (Q v).
 Next Obligation.
 Proof.
-  repeat intro.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; f_equal;
-    f_equal; rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  setoid_rewrite fupd_nonexpansive; do 3 f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality sh.
-  rewrite !approx_exp; apply f_equal; extensionality v.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite fview_shift_nonexpansive; rewrite approx_idem; auto.
+  intros ? (((?, ?), ?), ?) (((?, ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 Next Obligation.
-Proof.
-  repeat intro.
-  rewrite !approx_exp; apply f_equal; extensionality v.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 apply f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem; auto.
+  intros ? (((?, ?), ?), ?) (((?, ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 
 Lemma atomic_load_int : funspec_sub atomic_load_spec atomic_load_int_spec.
 Proof.
-  apply prove_funspec_sub.
-  split; auto; intros; simpl in *.
+  split; first done; intros; simpl in *.
   destruct x2 as (((p, Eo), Ei), Q).
   intros; iIntros "[_ H] !>".
-  iExists nil, (p, Eo, Ei, fun v => match v with Vint i => Q (Int.signed i) | _ => FF end), emp.
-  rewrite emp_sepcon; iSplit.
-  - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl.
+  iExists (p, Eo, Ei, fun v => match v with Vint i => Q (Int.signed i) | _ => False end), emp.
+  iSplit; first done.
+  iSplit.
+  - iSplit; first done.
+    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl.
+    monPred.unseal.
     iDestruct "H" as "($ & $ & $ & H & $)".
     iMod "H"; iModIntro.
-    iDestruct "H" as (sh v) "[[% H1] H2]".
-    destruct H.
+    iDestruct "H" as (sh v) "((% & %) & ? & ?)".
     iExists sh, (vint v); iFrame.
     rewrite Int.signed_repr; auto.
   - iPureIntro.
@@ -265,9 +229,8 @@ Proof.
     iExists (Int.signed i); iSplit; auto.
     { iPureIntro; split; auto.
       apply Int.signed_range. }
-    iSplit; [iSplit; auto|].
-    { rewrite Int.repr_signed; auto. }
-    rewrite sepcon_emp; auto.
+    iSplit; [iSplit|]; auto.
+    rewrite Int.repr_signed; auto.
 Qed.
 
 Definition ASI_type := ProdType (ProdType (ProdType (ConstType (val * Z))
@@ -278,38 +241,32 @@ Program Definition atomic_store_int_spec := TYPE ASI_type
   PRE [ tptr atomic_int, tint ]
    PROP (repable_signed v; subseteq Ei Eo)
    PARAMS (p; vint v)
-   SEP (|={Eo,Ei}=> EX sh : share, !!(writable_share sh) && atomic_int_at sh Vundef p *
-      (atomic_int_at sh (vint v) p -* |={Ei,Eo}=> Q))%I
+   SEP (|={Eo,Ei}=> ∃ sh : share, ⌜writable_share sh⌝ ∧ atomic_int_at sh Vundef p ∗
+      (atomic_int_at sh (vint v) p -∗ |={Ei,Eo}=> Q))
   POST [ tvoid ]
    PROP ()
    LOCAL ()
    SEP (Q).
 Next Obligation.
 Proof.
-  repeat intro.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; f_equal;
-    f_equal; rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  setoid_rewrite fupd_nonexpansive; do 3 f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality sh.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite fview_shift_nonexpansive; rewrite approx_idem; auto.
+  intros ? ((((?, ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 Next Obligation.
-Proof.
-  repeat intro.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 apply f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem; auto.
+  intros ? ((((?, ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 
 Lemma atomic_store_int : funspec_sub atomic_store_spec atomic_store_int_spec.
 Proof.
-  apply prove_funspec_sub.
-  split; auto; intros; simpl in *.
+  split; first done; intros; simpl in *.
   destruct x2 as ((((p, v), Eo), Ei), Q).
   intros; iIntros "[_ H] !>".
-  iExists nil, (p, vint v, Eo, Ei, Q), emp.
-  rewrite emp_sepcon; iSplit.
+  iExists (p, vint v, Eo, Ei, Q), emp.
+  iSplit; first done.
+  iSplit.
   - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx; simpl.
+    monPred.unseal.
     iDestruct "H" as "(% & $ & $ & H & $)".
     destruct H; auto.
   - iPureIntro.
@@ -318,55 +275,44 @@ Qed.
 
 Definition ACASI_type := ProdType (ProdType (ProdType (ConstType (val * share * val * Z * Z))
   (ConstType coPset)) (ConstType coPset))
-  (ArrowType (ConstType Z) Mpred).
+  (DiscreteFunType Z Mpred).
 
 Program Definition atomic_CAS_int_spec := TYPE ACASI_type
   WITH p : val, shc : share, pc : val, c : Z, v : Z, Eo : coPset, Ei : coPset, Q : Z -> mpred
   PRE [ tptr atomic_int, tptr tint, tint ]
    PROP (repable_signed c; repable_signed v; readable_share shc; subseteq Ei Eo)
    PARAMS (p; pc; vint v)
-   SEP (data_at shc tint (vint c) pc; |={Eo,Ei}=> EX sh : share, EX v0 : Z,
-      !!(writable_share sh /\ repable_signed v0) && atomic_int_at sh (vint v0) p *
-           (atomic_int_at sh (vint (if eq_dec v0 c then v else v0)) p -* |={Ei,Eo}=> Q v0))%I
+   SEP (data_at shc tint (vint c) pc; |={Eo,Ei}=> ∃ sh : share, ∃ v0 : Z,
+      ⌜writable_share sh /\ repable_signed v0⌝ ∧ atomic_int_at sh (vint v0) p ∗
+           (atomic_int_at sh (vint (if eq_dec v0 c then v else v0)) p -∗ |={Ei,Eo}=> Q v0))
   POST [ tint ]
-   EX v' : Z,
+   ∃ v' : Z,
    PROP (repable_signed v')
    LOCAL (temp ret_temp (vint (if eq_dec v' c then 1 else 0)))
    SEP (data_at shc tint (vint v') pc; Q v').
 Next Obligation.
 Proof.
-  repeat intro.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; f_equal;
-    f_equal; rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  unfold argsassert2assert; rewrite !approx_sepcon; do 2 f_equal.
-  setoid_rewrite fupd_nonexpansive; do 2 f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality sh.
-  rewrite !approx_exp; apply f_equal; extensionality v2.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite fview_shift_nonexpansive; rewrite approx_idem; auto.
+  intros ? (((((((?, ?), ?), ?), ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 Next Obligation.
-Proof.
-  repeat intro.
-  rewrite !approx_exp; apply f_equal; extensionality vr.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 apply f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem; auto.
+  intros ? (((((((?, ?), ?), ?), ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 
 Lemma atomic_CAS_int : funspec_sub atomic_CAS_spec atomic_CAS_int_spec.
 Proof.
-  apply prove_funspec_sub.
-  split; auto; intros; simpl in *.
+  split; first done; intros; simpl in *.
   destruct x2 as (((((((p, shc), pc), c), v), Eo), Ei), Q).
   intros; iIntros "[_ H] !>".
-  iExists nil, (p, shc, pc, vint c, vint v, Eo, Ei, fun v => match v with Vint i => Q (Int.signed i) | _ => FF end), emp.
-  rewrite emp_sepcon; iSplit.
-  - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx; simpl.
+  iExists (p, shc, pc, vint c, vint v, Eo, Ei, fun v => match v with Vint i => Q (Int.signed i) | _ => False end), emp.
+  iSplit; first done.
+  iSplit.
+  - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx; simpl; monPred.unseal.
     iDestruct "H" as "(% & $ & $ & $ & H & $)".
     destruct H as (? & ? & ?); iSplit; auto.
     iMod "H"; iModIntro.
-    iDestruct "H" as (sh v0) "[[% H1] H2]".
-    destruct H2.
+    iDestruct "H" as (sh v0) "((% & %) & ? & ?)".
     iExists sh, (vint v0); iFrame.
     rewrite -> Int.signed_repr by auto.
     iSplit; first done.
@@ -389,112 +335,93 @@ Proof.
       + rewrite Int.repr_signed in H2; contradiction.
       + apply Vint_inj in H2; subst.
         rewrite -> Int.signed_repr in H1 by auto; contradiction. }
-    rewrite Int.repr_signed sepcon_emp; iFrame.
+    rewrite Int.repr_signed; iFrame.
 Qed.
 
 Definition AEXI_type := ProdType (ProdType (ProdType (ConstType (val * Z))
   (ConstType coPset)) (ConstType coPset))
-  (ArrowType (ConstType Z) Mpred).
+  (DiscreteFunType Z Mpred).
 
 Program Definition atomic_exchange_int_spec := TYPE AEXI_type
   WITH p : val, v : Z, Eo : coPset, Ei : coPset, Q : Z -> mpred
-  PRE [ tptr tint, tint ]
+  PRE [ tptr atomic_int, tint ]
    PROP (repable_signed v; subseteq Ei Eo)
    PARAMS (p; vint v)
-   SEP (|={Eo,Ei}=> EX sh : share, EX v0 : Z, !!(writable_share sh /\ repable_signed v0) &&
-              data_at sh tint (vint v0) p *
-        (data_at sh tint (vint v) p -* |={Ei,Eo}=> Q v0))%I
+   SEP (|={Eo,Ei}=> ∃ sh : share, ∃ v0 : Z, ⌜writable_share sh /\ repable_signed v0⌝ ∧
+              atomic_int_at sh (vint v0) p ∗
+        (atomic_int_at sh (vint v) p -∗ |={Ei,Eo}=> Q v0))
   POST [ tint ]
-   EX v' : Z,
+   ∃ v' : Z,
    PROP (repable_signed v')
    LOCAL (temp ret_temp (vint v'))
    SEP (Q v').
 Next Obligation.
 Proof.
-  repeat intro.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; f_equal;
-    f_equal; rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  setoid_rewrite fupd_nonexpansive; do 3 f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality sh.
-  rewrite !approx_exp; apply f_equal; extensionality v0.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite fview_shift_nonexpansive; rewrite approx_idem; auto.
+  intros ? ((((?, ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 Next Obligation.
-Proof.
-  repeat intro.
-  rewrite !approx_exp; apply f_equal; extensionality vr.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 apply f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem; auto.
+  intros ? ((((?, ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 
 Lemma atomic_exchange_int : funspec_sub atomic_exchange_spec atomic_exchange_int_spec.
 Proof.
-  apply prove_funspec_sub.
-  split; auto; intros; simpl in *.
+  split; first done; intros; simpl in *.
   destruct x2 as ((((p, v), Eo), Ei), Q).
   intros; iIntros "[_ H] !>".
-  iExists nil, (p, vint v, Eo, Ei, fun v => match v with Vint i => Q (Int.signed i) | _ => FF end), emp.
-  rewrite emp_sepcon; iSplit.
-  - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx; simpl.
+  iExists (p, vint v, Eo, Ei, fun v => match v with Vint i => Q (Int.signed i) | _ => False end), emp.
+  iSplit; first done.
+  iSplit.
+  - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx; simpl; monPred.unseal.
     iDestruct "H" as "(% & $ & $ & H & $)".
     destruct H; iSplit; auto.
     iMod "H"; iModIntro.
-    iDestruct "H" as (sh v0) "[[% H1] H2]".
-    destruct H1.
+    iDestruct "H" as (sh v0) "((% & %) & ? & ?)".
     iExists sh, (vint v0); iFrame.
     rewrite -> Int.signed_repr; auto.
   - unfold PROPx, LOCALx, SEPx; simpl.
     iPureIntro.
     iIntros (?) "(_ & _ & H)".
     iDestruct "H" as (r) "(_ & % & Q & _)".
-    destruct H, r; try done.
-    iExists (Int.signed i); iSplit; auto.
+    destruct H; try done.
+    monPred.unseal.
+    iExists (Int.signed r); iSplit; auto.
     { iPureIntro; split; auto.
       apply Int.signed_range. }
     iSplit; [iSplit; auto|].
     { rewrite Int.repr_signed; auto. }
-    rewrite sepcon_emp; iFrame.
+    iFrame.
 Qed.
 
 (* specs for pointer operations *)
 
 Definition ALI_ptr_type := ProdType (ProdType (ProdType (ConstType val)
   (ConstType coPset)) (ConstType coPset))
-  (ArrowType (ConstType val) Mpred).
+  (DiscreteFunType val Mpred).
 
 Program Definition atomic_load_ptr_spec := TYPE ALI_ptr_type
   WITH p : val, Eo : coPset, Ei : coPset, Q : val -> mpred
   PRE [ tptr atomic_ptr ]
    PROP (subseteq Ei Eo)
    PARAMS (p)
-   SEP (|={Eo,Ei}=> EX sh : share, EX v : val, !!(readable_share sh ) &&
-              atomic_ptr_at sh v p * (atomic_ptr_at sh v p -* |={Ei,Eo}=> Q v))%I
+   SEP (|={Eo,Ei}=> ∃ sh : share, ∃ v : val, ⌜readable_share sh⌝ ∧
+              atomic_ptr_at sh v p ∗ (atomic_ptr_at sh v p -∗ |={Ei,Eo}=> Q v))
   POST [ tptr Tvoid ]
-   EX v : val,
+   ∃ v : val,
    PROP ()
    LOCAL (temp ret_temp v)
    SEP (Q v).
 Next Obligation.
 Proof.
-  repeat intro.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; f_equal;
-    f_equal; rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  setoid_rewrite fupd_nonexpansive; do 3 f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality sh.
-  rewrite !approx_exp; apply f_equal; extensionality v.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite fview_shift_nonexpansive; rewrite approx_idem; auto.
+  intros ? (((?, ?), ?), ?) (((?, ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 Next Obligation.
-Proof.
-  repeat intro.
-  rewrite !approx_exp; apply f_equal; extensionality v.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 apply f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem; auto.
+  intros ? (((?, ?), ?), ?) (((?, ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 
-
 Definition ASI_ptr_type := ProdType (ProdType (ProdType (ConstType (val * val))
   (ConstType coPset)) (ConstType coPset)) Mpred.
 
@@ -503,102 +430,74 @@ Program Definition atomic_store_ptr_spec := TYPE ASI_ptr_type
   PRE [ tptr atomic_ptr, tptr Tvoid ]
    PROP (subseteq Ei Eo)
    PARAMS (p; v)
-   SEP (|={Eo,Ei}=> EX sh : share, !!(writable_share sh) && atomic_ptr_at sh Vundef p *
-      (atomic_ptr_at sh v p -* |={Ei,Eo}=> Q))%I
+   SEP (|={Eo,Ei}=> ∃ sh : share, ⌜writable_share sh⌝ ∧ atomic_ptr_at sh Vundef p ∗
+      (atomic_ptr_at sh v p -∗ |={Ei,Eo}=> Q))
   POST [ tvoid ]
    PROP ()
    LOCAL ()
    SEP (Q).
 Next Obligation.
 Proof.
-  repeat intro.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; f_equal;
-    f_equal; rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  setoid_rewrite fupd_nonexpansive; do 3 f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality sh.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite fview_shift_nonexpansive; rewrite approx_idem; auto.
+  intros ? ((((?, ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 Next Obligation.
-Proof.
-  repeat intro.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 apply f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem; auto.
+  intros ? ((((?, ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 
-
 Definition ACASI_ptr_type := ProdType (ProdType (ProdType (ConstType (val * share * val * val * val))
   (ConstType coPset)) (ConstType coPset))
-  (ArrowType (ConstType val) Mpred).
+  (DiscreteFunType val Mpred).
 
 Program Definition atomic_CAS_ptr_spec := TYPE ACASI_ptr_type
   WITH p : val, shc : share, pc : val, c : val, v : val, Eo : coPset, Ei : coPset, Q : val -> mpred
   PRE [ tptr atomic_ptr, tptr (tptr Tvoid), tptr Tvoid ]
    PROP (readable_share shc; subseteq Ei Eo)
    PARAMS (p; pc; v)
-   SEP (data_at shc (tptr Tvoid) c pc; |={Eo,Ei}=> EX sh : share, EX v0 : val,
-      !!(writable_share sh ) && atomic_ptr_at sh v0 p *
-           (atomic_ptr_at sh (if eq_dec v0 c then v else v0) p -* |={Ei,Eo}=> Q v0))%I
+   SEP (data_at shc (tptr Tvoid) c pc; |={Eo,Ei}=> ∃ sh : share, ∃ v0 : val,
+      ⌜writable_share sh⌝ ∧ atomic_ptr_at sh v0 p ∗
+           (atomic_ptr_at sh (if eq_dec v0 c then v else v0) p -∗ |={Ei,Eo}=> Q v0))
   POST [ tint ]
-   EX v' : val,
+   ∃ v' : val,
    PROP ()
    LOCAL (temp ret_temp (vint (if eq_dec v' c then 1 else 0)))
    SEP (data_at shc (tptr Tvoid) c pc; Q v').
 Next Obligation.
 Proof.
-  repeat intro.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; f_equal;
-    f_equal; rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  unfold argsassert2assert; rewrite !approx_sepcon; f_equal.
-  setoid_rewrite fupd_nonexpansive; do 3 f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality sh.
-  rewrite !approx_exp; apply f_equal; extensionality v2.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite fview_shift_nonexpansive; rewrite approx_idem; auto.
+  intros ? (((((((?, ?), ?), ?), ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 Next Obligation.
-Proof.
-  repeat intro.
-  rewrite !approx_exp; apply f_equal; extensionality vr.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 apply f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem; auto.
+  intros ? (((((((?, ?), ?), ?), ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 
-
 Definition AEXI_ptr_type := ProdType (ProdType (ProdType (ConstType (val * val))
   (ConstType coPset)) (ConstType coPset))
-  (ArrowType (ConstType val) Mpred).
+  (DiscreteFunType val Mpred).
 
 Program Definition atomic_exchange_ptr_spec := TYPE AEXI_ptr_type
   WITH p : val, v : val, Eo : coPset, Ei : coPset, Q : val -> mpred
   PRE [ tptr atomic_ptr, tptr Tvoid ]
    PROP (subseteq Ei Eo)
    PARAMS (p; v)
-   SEP (|={Eo,Ei}=> EX sh : share, EX v0 : val, !!(writable_share sh ) &&
-              atomic_ptr_at sh v0 p *
-        (atomic_ptr_at sh v p -* |={Ei,Eo}=> Q v0))%I
+   SEP (|={Eo,Ei}=> ∃ sh : share, ∃ v0 : val, ⌜writable_share sh⌝ ∧
+              atomic_ptr_at sh v0 p ∗
+        (atomic_ptr_at sh v p -∗ |={Ei,Eo}=> Q v0))
   POST [ tint ]
-   EX v' : val,
+   ∃ v' : val,
    PROP ()
    LOCAL (temp ret_temp v')
    SEP (Q v').
 Next Obligation.
 Proof.
-  repeat intro.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; f_equal;
-    f_equal; rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  setoid_rewrite fupd_nonexpansive; do 3 f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality sh.
-  rewrite !approx_exp; apply f_equal; extensionality v0.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite fview_shift_nonexpansive; rewrite approx_idem; auto.
+  intros ? ((((?, ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 Next Obligation.
-Proof.
-  repeat intro.
-  rewrite !approx_exp; apply f_equal; extensionality vr.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 apply f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem; auto.
+  intros ? ((((?, ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 
 End SC_atomics.
diff --git a/atomics/SC_atomics_base.v b/atomics/SC_atomics_base.v
deleted file mode 100644
index 9fa58eb41b..0000000000
--- a/atomics/SC_atomics_base.v
+++ /dev/null
@@ -1,377 +0,0 @@
-(* SC atomics without importing Iris *)
-
-Require Import Ensembles.
-Require Import VST.veric.rmaps.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.concurrency.ghosts.
-Require Import VST.concurrency.conclib.
-Require Import VST.floyd.library.
-Require Import VST.zlist.sublist.
-
-(* Warning: it is UNSOUND to use both this file and acq_rel_atomics.v in the same proof! There is
-   not yet an operational model that can validate the use of both SC and RA atomics. *)
-
-(* At present, due to complexities in the specifications of the C11 atomics (generics, _Atomic types, etc.), these are specs for wrapper functions for common cases.
-   There's probably a more systematic approach possible. *)
-
-Class atomic_int_impl := { atomic_int : type; atomic_int_at : share -> val -> val -> mpred;
-  atomic_int_at__ : forall sh v p, atomic_int_at sh v p |-- atomic_int_at sh Vundef p;
-  atomic_int_conflict : forall sh v v' p, sepalg.nonidentity sh -> atomic_int_at sh v p * atomic_int_at sh v' p |-- FF }.
-
-Class atomic_ptr_impl := { atomic_ptr : type; atomic_ptr_at : share -> val -> val -> mpred;
-  atomic_ptr_conflict : forall sh v v' p, sepalg.nonidentity sh -> atomic_ptr_at sh v p * atomic_ptr_at sh v' p |-- FF }.
-
-Section SC_atomics.
-
-Context {CS : compspecs} {AI : atomic_int_impl} {AP : atomic_ptr_impl}.
-
-Definition make_atomic_spec :=
-  WITH v : val
-  PRE [ tint ]
-    PROP ()
-    PARAMS (v)
-    SEP ()
-  POST [ tptr atomic_int ]
-   EX p : val,
-    PROP ()
-    RETURN (p)
-    SEP (atomic_int_at Ews v p).
-
-Definition make_atomic_ptr_spec :=
-  WITH v : val
-  PRE [ tptr Tvoid ]
-    PROP ()
-    PARAMS (v)
-    SEP ()
-  POST [ tptr atomic_ptr ]
-   EX p : val,
-    PROP (is_pointer_or_null p)
-    RETURN (p)
-    SEP (atomic_ptr_at Ews v p).
-
-Definition free_atomic_ptr_spec :=
-  WITH p : val
-  PRE [ tptr atomic_ptr ]
-    PROP (is_pointer_or_null p)
-    PARAMS (p)
-    SEP (EX v : val, atomic_ptr_at Ews v p)
-  POST[ tvoid ]
-    PROP ()
-    LOCAL ()
-    SEP ().
-
-Definition free_atomic_int_spec :=
-  WITH p : val
-  PRE [ tptr atomic_int ]
-    PROP (is_pointer_or_null p)
-    PARAMS (p)
-    SEP (EX v : val, atomic_int_at Ews v p)
-  POST[ tvoid ]
-    PROP ()
-    LOCAL ()
-    SEP ().
-
-Definition AL_type := ProdType (ConstType (val * Ensemble nat * Ensemble nat)) (ArrowType (ConstType val) Mpred).
-
-Program Definition atomic_load_spec := TYPE AL_type
-  WITH p : val, Eo : Ensemble nat, Ei : Ensemble nat, Q : val -> mpred
-  PRE [ tptr atomic_int ]
-   PROP (Included Ei Eo)
-   PARAMS (p)
-   SEP (|={Eo,Ei}=> EX sh : share, EX v : val, !!(readable_share sh) &&
-              atomic_int_at sh v p * (atomic_int_at sh v p -* |={Ei,Eo}=> Q v))
-  POST [ tint ]
-   EX v : val,
-   PROP ()
-   RETURN (v)
-   SEP (Q v).
-Next Obligation.
-Proof.
-  repeat intro.
-  destruct x as (((?, ?), ?), ?).
-  unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; f_equal;
-    f_equal; f_equal; rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  setoid_rewrite fupd_nonexpansive; do 2 f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality.
-  rewrite !approx_exp; apply f_equal; extensionality.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite wand_nonexpansive_r; f_equal; f_equal.
-  apply fupd_nonexpansive.
-Qed.
-Next Obligation.
-Proof.
-  repeat intro.
-  destruct x as (((?, ?), ?), ?); simpl.
-  rewrite !approx_exp; apply f_equal; extensionality.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 apply f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem; auto.
-Qed.
-
-Definition AS_type := ProdType (ConstType (val * val * Ensemble nat * Ensemble nat)) Mpred.
-
-Program Definition atomic_store_spec := TYPE AS_type
-  WITH p : val, v : val, Eo : Ensemble nat, Ei : Ensemble nat, Q : mpred
-  PRE [ tptr atomic_int, tint ]
-   PROP (Included Ei Eo)
-   PARAMS (p; v)
-   SEP (|={Eo,Ei}=> EX sh : share, !!(writable_share sh) && atomic_int_at sh Vundef p *
-      (atomic_int_at sh v p -* |={Ei,Eo}=> Q))
-  POST [ tvoid ]
-   PROP ()
-   LOCAL ()
-   SEP (Q).
-Next Obligation.
-Proof.
-  repeat intro.
-  destruct x as ((((?, ?), ?), ?), ?).
-  unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; f_equal;
-    f_equal; f_equal; rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  setoid_rewrite fupd_nonexpansive; do 2 f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality sh.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite wand_nonexpansive_r; f_equal; f_equal.
-  apply fupd_nonexpansive.
-Qed.
-Next Obligation.
-Proof.
-  repeat intro.
-  destruct x as ((((?, ?), ?), ?), ?); simpl.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 apply f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem; auto.
-Qed.
-
-Definition ACAS_type := ProdType (ProdType (ProdType (ConstType (val * share * val * val * val))
-  (ConstType (Ensemble nat))) (ConstType (Ensemble nat)))
-  (ArrowType (ConstType val) Mpred).
-
-Program Definition atomic_CAS_spec := TYPE ACAS_type
-  WITH p : val, shc : share, pc : val, c : val, v : val, Eo : Ensemble nat, Ei : Ensemble nat, Q : val -> mpred
-  PRE [ tptr atomic_int, tptr tint, tint ]
-   PROP (readable_share shc; Included Ei Eo)
-   PARAMS (p; pc; v)
-   SEP (data_at shc tint c pc; |={Eo,Ei}=> EX sh : share, EX v0 : val,
-      !!(writable_share sh) && atomic_int_at sh v0 p *
-           (atomic_int_at sh (if eq_dec v0 c then v else v0) p -* |={Ei,Eo}=> Q v0))
-  POST [ tint ]
-   EX v' : val,
-   PROP ()
-   LOCAL (temp ret_temp (vint (if eq_dec v' c then 1 else 0)))
-   SEP (data_at shc tint v' pc; Q v').
-Next Obligation.
-Proof.
-  repeat intro.
-  destruct x as (((((((?, ?), ?), ?), ?), ?), ?), ?).
-  unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; f_equal;
-    f_equal; f_equal; rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  f_equal.
-  setoid_rewrite fupd_nonexpansive; do 2 f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality sh.
-  rewrite !approx_exp; apply f_equal; extensionality.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite wand_nonexpansive_r; f_equal; f_equal.
-  apply fupd_nonexpansive.
-Qed.
-Next Obligation.
-Proof.
-  repeat intro.
-  destruct x as (((((((?, ?), ?), ?), ?), ?), ?), ?); simpl.
-  rewrite !approx_exp; apply f_equal; extensionality vr.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 apply f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem; auto.
-Qed.
-
-Definition AEX_type := ProdType (ProdType (ProdType (ConstType (val * val))
-  (ConstType (Ensemble nat))) (ConstType (Ensemble nat)))
-  (ArrowType (ConstType val) Mpred).
-
-Program Definition atomic_exchange_spec := TYPE AEX_type
-  WITH p : val, v : val, Eo : Ensemble nat, Ei : Ensemble nat, Q : val -> mpred
-  PRE [ tptr tint, tint ]
-   PROP (Included Ei Eo)
-   PARAMS (p; v)
-   SEP (|={Eo,Ei}=> EX sh : share, EX v0 : val, !!(writable_share sh) &&
-              data_at sh tint v0 p *
-        (data_at sh tint v p -* |={Ei,Eo}=> Q v0))
-  POST [ tint ]
-   EX v' : val,
-   PROP ()
-   LOCAL (temp ret_temp v')
-   SEP (Q v').
-Next Obligation.
-Proof.
-  repeat intro.
-  destruct x as ((((?, ?), ?), ?), ?).
-  unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; f_equal;
-    f_equal; f_equal; rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  setoid_rewrite fupd_nonexpansive; do 2 f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality sh.
-  rewrite !approx_exp; apply f_equal; extensionality.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite wand_nonexpansive_r; f_equal; f_equal.
-  apply fupd_nonexpansive.
-Qed.
-Next Obligation.
-Proof.
-  repeat intro.
-  destruct x as ((((?, ?), ?), ?), ?); simpl.
-  rewrite !approx_exp; apply f_equal; extensionality vr.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 apply f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem; auto.
-Qed.
-
-(* specs for pointer operations *)
-
-Definition ALI_ptr_type := ProdType (ProdType (ProdType (ConstType val)
-  (ConstType (Ensemble nat))) (ConstType (Ensemble nat)))
-  (ArrowType (ConstType val) Mpred).
-
-Program Definition atomic_load_ptr_spec := TYPE ALI_ptr_type
-  WITH p : val, Eo : (Ensemble nat), Ei : (Ensemble nat), Q : val -> mpred
-  PRE [ tptr atomic_ptr ]
-   PROP (Included Ei Eo)
-   PARAMS (p)
-   SEP (|={Eo,Ei}=> EX sh : share, EX v : val, !!(readable_share sh) &&
-              atomic_ptr_at sh v p * (atomic_ptr_at sh v p -* |={Ei,Eo}=> Q v))
-  POST [ tptr Tvoid ]
-   EX v : val,
-   PROP ()
-   LOCAL (temp ret_temp v)
-   SEP (Q v).
-Next Obligation.
-Proof.
-  repeat intro.
-  destruct x as (((?, ?), ?), ?); simpl.
-  unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; f_equal;
-    f_equal; f_equal; rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  setoid_rewrite fupd_nonexpansive; do 2 f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality sh.
-  rewrite !approx_exp; apply f_equal; extensionality v.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite ghosts.wand_nonexpansive_r; do 2 f_equal.
-  apply fupd_nonexpansive.
-Qed.
-Next Obligation.
-Proof.
-  repeat intro.
-  destruct x as (((?, ?), ?), ?); simpl.
-  rewrite !approx_exp; apply f_equal; extensionality v.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 apply f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem; auto.
-Qed.
-
-
-Definition ASI_ptr_type := ProdType (ProdType (ProdType (ConstType (val * val))
-  (ConstType (Ensemble nat))) (ConstType (Ensemble nat))) Mpred.
-
-Program Definition atomic_store_ptr_spec := TYPE ASI_ptr_type
-  WITH p : val, v : val, Eo : (Ensemble nat), Ei : (Ensemble nat), Q : mpred
-  PRE [ tptr atomic_ptr, tptr Tvoid ]
-   PROP (Included Ei Eo)
-   PARAMS (p; v)
-   SEP (|={Eo,Ei}=> EX sh : share, !!(writable_share sh) && atomic_ptr_at sh Vundef p *
-      (atomic_ptr_at sh v p -* |={Ei,Eo}=> Q))
-  POST [ tvoid ]
-   PROP ()
-   LOCAL ()
-   SEP (Q).
-Next Obligation.
-Proof.
-  repeat intro.
-  destruct x as ((((?, ?), ?), ?), ?); simpl.
-  unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; f_equal;
-    f_equal; f_equal; rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  setoid_rewrite fupd_nonexpansive; do 2 f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality sh.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite ghosts.wand_nonexpansive_r; do 2 f_equal.
-  apply fupd_nonexpansive.
-Qed.
-Next Obligation.
-Proof.
-  repeat intro.
-  destruct x as ((((?, ?), ?), ?), ?); simpl.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 apply f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem; auto.
-Qed.
-
-
-Definition ACASI_ptr_type := ProdType (ProdType (ProdType (ConstType (val * share * val * val * val))
-  (ConstType (Ensemble nat))) (ConstType (Ensemble nat)))
-  (ArrowType (ConstType val) Mpred).
-
-Program Definition atomic_CAS_ptr_spec := TYPE ACASI_ptr_type
-  WITH p : val, shc : share, pc : val, c : val, v : val, Eo : (Ensemble nat), Ei : (Ensemble nat), Q : val -> mpred
-  PRE [ tptr atomic_ptr, tptr (tptr Tvoid), tptr Tvoid ]
-   PROP (readable_share shc; Included Ei Eo)
-   PARAMS (p; pc; v)
-   SEP (data_at shc (tptr Tvoid) c pc; |={Eo,Ei}=> EX sh : share, EX v0 : val,
-      !!(writable_share sh ) && atomic_ptr_at sh v0 p *
-           (atomic_ptr_at sh (if eq_dec v0 c then v else v0) p -* |={Ei,Eo}=> Q v0))
-  POST [ tint ]
-   EX v' : val,
-   PROP ()
-   LOCAL (temp ret_temp (vint (if eq_dec v' c then 1 else 0)))
-   SEP (data_at shc (tptr Tvoid) c pc; Q v').
-Next Obligation.
-Proof.
-  repeat intro.
-  destruct x as (((((((?, ?), ?), ?), ?), ?), ?), ?); simpl.
-  unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; f_equal;
-    f_equal; f_equal; rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  setoid_rewrite fupd_nonexpansive; do 3 f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality sh.
-  rewrite !approx_exp; apply f_equal; extensionality v'.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite ghosts.wand_nonexpansive_r; do 2 f_equal.
-  apply fupd_nonexpansive.
-Qed.
-Next Obligation.
-Proof.
-  repeat intro.
-  destruct x as (((((((?, ?), ?), ?), ?), ?), ?), ?); simpl.
-  rewrite !approx_exp; apply f_equal; extensionality vr.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 apply f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem; auto.
-Qed.
-
-
-Definition AEXI_ptr_type := ProdType (ProdType (ProdType (ConstType (val * val))
-  (ConstType (Ensemble nat))) (ConstType (Ensemble nat)))
-  (ArrowType (ConstType val) Mpred).
-
-Program Definition atomic_exchange_ptr_spec := TYPE AEXI_ptr_type
-  WITH p : val, v : val, Eo : (Ensemble nat), Ei : (Ensemble nat), Q : val -> mpred
-  PRE [ tptr atomic_ptr, tptr Tvoid ]
-   PROP (Included Ei Eo)
-   PARAMS (p; v)
-   SEP (|={Eo,Ei}=> EX sh : share, EX v0 : val, !!(writable_share sh ) &&
-              atomic_ptr_at sh v0 p *
-        (atomic_ptr_at sh v p -* |={Ei,Eo}=> Q v0))
-  POST [ tint ]
-   EX v' : val,
-   PROP ()
-   LOCAL (temp ret_temp v')
-   SEP (Q v').
-Next Obligation.
-Proof.
-  repeat intro.
-  destruct x as ((((?, ?), ?), ?), ?); simpl.
-  unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; f_equal;
-    f_equal; f_equal; rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  setoid_rewrite fupd_nonexpansive; do 2 f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality sh.
-  rewrite !approx_exp; apply f_equal; extensionality v'.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite ghosts.wand_nonexpansive_r; do 2 f_equal.
-  apply fupd_nonexpansive.
-Qed.
-Next Obligation.
-Proof.
-  repeat intro.
-  destruct x as ((((?, ?), ?), ?), ?); simpl.
-  rewrite !approx_exp; apply f_equal; extensionality vr.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 apply f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem; auto.
-Qed.
-
-End SC_atomics.
diff --git a/atomics/general_atomics.v b/atomics/general_atomics.v
index d9e31feaaa..20897e830a 100644
--- a/atomics/general_atomics.v
+++ b/atomics/general_atomics.v
@@ -1,7 +1,5 @@
-From VST.veric Require Import rmaps compcert_rmaps.
-Require Export iris.bi.lib.atomic.
-Require Export VST.veric.bi.
-From VST.concurrency Require Export ghosts conclib invariants fupd.
+Require Export iris.algebra.list iris.bi.lib.atomic.
+From VST.concurrency Require Export conclib.
 Require Import VST.floyd.library.
 Require Export VST.zlist.sublist.
 Require Import Program.Equality.
@@ -16,24 +14,26 @@ Definition tele_unwrap {A} (x : tele_arg (TeleS (fun _ : A => TeleO))) :=
   | TeleArgCons x _ => x
   end.
 
-Definition atomic_shift {A B} (a : A -> mpred) Eo Ei (b : A -> B -> mpred) (Q : B -> mpred) : mpred :=
-  @atomic_update mpredI _ [tele _ : A] [tele _ : B] Eo Ei (λ.. x, a (tele_unwrap x)) (λ.. x y, b (tele_unwrap x) (tele_unwrap y)) (λ.. x y, Q (tele_unwrap y)).
+Context `{!heapGS Σ}.
+
+Definition atomic_shift {A B} (a : A -d> mpred) Eo Ei (b : A -d> B -d> mpred) (Q : B -d> mpred) : mpred :=
+  atomic_update(TA := [tele _ : A]) (TB := [tele _ : B]) Eo Ei (λ.. x, a (tele_unwrap x)) (λ.. x y, b (tele_unwrap x) (tele_unwrap y)) (λ.. x y, Q (tele_unwrap y)).
 
 Lemma atomic_commit_fupd : forall {A B} (a : A -> mpred) Eo Ei (b : A -> B -> mpred) (Q : B -> mpred) R R',
-  (forall x, R * a x |-- |==> (EX y, b x y * R' y)) ->
-  atomic_shift a Eo Ei b Q * R |-- |={Eo}=> (EX y, Q y * R' y).
+  (forall x, R ∗ a x ⊢ |==> (∃ y, b x y ∗ R' y)) ->
+  atomic_shift a Eo Ei b Q ∗ R ⊢ |={Eo}=> (∃ y, Q y ∗ R' y).
 Proof.
   intros.
   iIntros "[AS R]".
-  unfold atomic_shift. 
+  unfold atomic_shift.
   iMod "AS" as (x) "[a [_ commit]]"; simpl.
   iMod (H with "[$R $a]") as (y) "[b Q]".
   iExists y; iMod ("commit" with "b") as "$"; auto.
 Qed.
 
 Lemma atomic_rollback_fupd : forall {A B} (a : A -> mpred) Eo Ei (b : A -> B -> mpred) (Q : B -> mpred) R R',
-  (forall x, R * a x |-- |==> a x * R') ->
-  atomic_shift a Eo Ei b Q * R |-- |={Eo}=> atomic_shift a Eo Ei b Q * R'.
+  (forall x, R ∗ a x ⊢ |==> a x ∗ R') ->
+  atomic_shift a Eo Ei b Q ∗ R ⊢ |={Eo}=> atomic_shift a Eo Ei b Q ∗ R'.
 Proof.
   intros.
   iIntros "[AS R]".
@@ -45,18 +45,18 @@ Qed.
 
 Lemma atomic_shift_mask_weaken {A B} Eo1 Eo2 Ei a (b : A -> B -> mpred) Q :
   Eo1 ⊆ Eo2 ->
-  atomic_shift a Eo1 Ei b Q |-- atomic_shift a Eo2 Ei b Q.
+  atomic_shift a Eo1 Ei b Q ⊢ atomic_shift a Eo2 Ei b Q.
 Proof.
   intros; unfold atomic_shift.
-  apply atomic_update_mask_weaken; auto.
+  iApply atomic_update_mask_weaken; auto.
 Qed.
 
 (* use iInv instead of applying this lemma *)
 Lemma inv_atomic_shift : forall {A B} a Eo Ei (b : A -> B -> mpred) Q N R P
   (Hi : ↑N ⊆ Eo) (Hio : Ei ⊆ Eo ∖ ↑N)
-  (Ha1 : (inv N R * |>R |-- |={Eo ∖ ↑N}=> EX x, a x * ((a x -* |={Ei}=> |>R) &&
-    (ALL y, |> P * b x y -* |={Ei}=> |>R * Q y)))),
-  inv N R * |> P |-- atomic_shift a Eo Ei b Q.
+  (Ha1 : (inv N R ∗ ▷R ⊢ |={Eo ∖ ↑N}=> ∃ x, a x ∗ ((a x -∗ |={Ei}=> ▷R) ∧
+    (∀ y, ▷ P ∗ b x y -∗ |={Ei}=> ▷R ∗ Q y)))),
+  inv N R ∗ ▷ P ⊢ atomic_shift a Eo Ei b Q.
 Proof.
   intros; unfold atomic_shift.
   iIntros "[#I P]". iAuIntro.
@@ -73,27 +73,19 @@ Proof.
     iMod "Hclose'"; iMod ("Hclose" with "R"); auto.
 Qed.
 
-Lemma atomic_shift_nonexpansive : forall {A B} n a Eo Ei (b : A -> B -> mpred) Q,
-  approx n (atomic_shift a Eo Ei b Q) =
-  approx n (atomic_shift (fun x => approx n (a x)) Eo Ei (fun x y => approx n (b x y)) (fun y => approx n (Q y))).
+#[global] Instance atomic_shift_nonexpansive : forall {A B} n,
+  Proper (dist n ==> eq ==> eq ==> dist n ==> dist n ==> dist n) (@atomic_shift A B).
 Proof.
-  intros; unfold atomic_shift.
-  destruct n as [|n].
-  { rewrite !approx_0; auto. }
-  unshelve eapply (atomic_update_ne(TA := TeleS (fun _ => TeleO)) _ _ n (λ.. x : [tele _ : A], a (tele_unwrap x))).
-  { intros [? []]; hnf; simpl.
-    rewrite approx_idem; auto. }
-  { intros [? []] [? []]; hnf; simpl.
-    rewrite approx_idem; auto. }
-  { intros [? []] [? []]; hnf; simpl.
-    rewrite approx_idem; auto. }
+  repeat intro.
+  rewrite /atomic_shift /=.
+  subst; apply atomic_update_ne; intros []; solve_proper.
 Qed.
 
 Lemma atomic_shift_derives_frame : forall {A A' B B'} (a : A -> mpred) (a' : A' -> mpred) Eo Ei
   (b : A -> B -> mpred) (b' : A' -> B' -> mpred) (Q : B -> mpred) (Q' : B' -> mpred) R
-  (Ha : (forall x, a x * |>R |-- |={Ei}=> EX x' : A', a' x' *
-    ((a' x' -* |={Ei}=> a x * |>R) && ALL y' : _, b' x' y' -* (|={Ei}=> EX y : _, b x y * (Q y -* |={Eo}=> Q' y'))))),
-  atomic_shift a Eo Ei b Q * |>R |-- atomic_shift a' Eo Ei b' Q'.
+  (Ha : (forall x, a x ∗ ▷R ⊢ |={Ei}=> ∃ x' : A', a' x' ∗
+    ((a' x' -∗ |={Ei}=> a x ∗ ▷R) ∧ ∀ y' : _, b' x' y' -∗ (|={Ei}=> ∃ y : _, b x y ∗ (Q y -∗ |={Eo}=> Q' y'))))),
+  atomic_shift a Eo Ei b Q ∗ ▷R ⊢ atomic_shift a' Eo Ei b' Q'.
 Proof.
   intros; unfold atomic_shift.
   iIntros "[AU P]". iAuIntro.
@@ -112,9 +104,9 @@ Qed.
 
 Lemma atomic_shift_derives : forall {A A' B B'} (a : A -> mpred) (a' : A' -> mpred) Eo Ei
   (b : A -> B -> mpred) (b' : A' -> B' -> mpred) (Q : B -> mpred) (Q' : B' -> mpred)
-  (Ha : (forall x, a x  |-- |={Ei}=> EX x' : A', a' x' *
-    ((a' x' -* |={Ei}=> a x) && ALL y' : _, b' x' y' -* (|={Ei}=> EX y : _, b x y * (Q y -* |={Eo}=> Q' y'))))),
-  atomic_shift a Eo Ei b Q |-- atomic_shift a' Eo Ei b' Q'.
+  (Ha : (forall x, a x  ⊢ |={Ei}=> ∃ x' : A', a' x' ∗
+    ((a' x' -∗ |={Ei}=> a x) ∧ ∀ y' : _, b' x' y' -∗ (|={Ei}=> ∃ y : _, b x y ∗ (Q y -∗ |={Eo}=> Q' y'))))),
+  atomic_shift a Eo Ei b Q ⊢ atomic_shift a' Eo Ei b' Q'.
 Proof.
   intros; unfold atomic_shift.
   iIntros "AU". iAuIntro.
@@ -129,9 +121,9 @@ Qed.
 
 Lemma atomic_shift_derives' : forall {A A' B} (a : A -> mpred) (a' : A' -> mpred) Eo Ei
   (b : A -> B -> mpred) (b' : A' -> B -> mpred) (Q : B -> mpred)
-  (Ha : (forall x, a x |-- |={Ei}=> EX x' : A', a' x' *
-    ((a' x' -* |={Ei}=> a x) && ALL y : _, b' x' y -* |={Ei}=> b x y))),
-  atomic_shift a Eo Ei b Q |-- atomic_shift a' Eo Ei b' Q.
+  (Ha : (forall x, a x ⊢ |={Ei}=> ∃ x' : A', a' x' ∗
+    ((a' x' -∗ |={Ei}=> a x) ∧ ∀ y : _, b' x' y -∗ |={Ei}=> b x y))),
+  atomic_shift a Eo Ei b Q ⊢ atomic_shift a' Eo Ei b' Q.
 Proof.
   intros; apply atomic_shift_derives.
   iIntros (x) "a"; iMod (Ha with "a") as (x') "[a H]".
@@ -145,10 +137,10 @@ Proof.
 Qed.
 
 Lemma atomic_shift_derives_simple : forall {A B} (a a' : A -> mpred) Eo Ei (b b' : A -> B -> mpred) (Q : B -> mpred)
-  (Ha1 : forall x, a x |-- |={Ei}=> a' x)
-  (Ha2 : forall x, a' x |-- |={Ei}=> a x)
-  (Hb : forall x y, b' x y |-- |={Ei}=> b x y),
-  atomic_shift a Eo Ei b Q |-- atomic_shift a' Eo Ei b' Q.
+  (Ha1 : forall x, a x ⊢ |={Ei}=> a' x)
+  (Ha2 : forall x, a' x ⊢ |={Ei}=> a x)
+  (Hb : forall x y, b' x y ⊢ |={Ei}=> b x y),
+  atomic_shift a Eo Ei b Q ⊢ atomic_shift a' Eo Ei b' Q.
 Proof.
   intros; apply atomic_shift_derives'; intros.
   iIntros "a"; iExists x; iMod (Ha1 with "a") as "$".
@@ -158,7 +150,7 @@ Proof.
 Qed.
 
 Lemma atomic_shift_exists : forall {A B} a Eo Ei (b : A -> B -> mpred) Q,
-  atomic_shift (fun (_ : unit) => EX x : A, a x) Eo Ei (fun (_ : unit) => EX x : A, b x) Q |-- atomic_shift a Eo Ei b Q.
+  atomic_shift (fun (_ : unit) => ∃ x : A, a x) Eo Ei (fun (_ : unit) y => ∃ x : A, b x y) Q ⊢ atomic_shift a Eo Ei b Q.
 Proof.
   intros; unfold atomic_shift.
   iIntros "AU". iAuIntro.
@@ -169,352 +161,123 @@ Proof.
   iIntros "!>"; iSplit.
   - iIntros "a !>".
     iSplitR ""; auto.
-    iExists x; auto.
   - iIntros (y) "b !>".
     iRight; iExists y.
     iSplitR ""; auto.
-    iExists x; auto.
 Qed.
 
 End atomicity.
 
 Global Hint Resolve empty_subseteq : core.
 
-Definition atomic_spec_type W T := ProdType W (ArrowType (ConstType T) Mpred).
-
-Definition super_non_expansive_a {A W} (a : forall ts : list Type, functors.MixVariantFunctor._functor
-  (dependent_type_functor_rec ts W) (predicates_hered.pred rmap) -> A ts -> predicates_hered.pred rmap) :=
-  forall n ts w x, approx n (a ts w x) =
-  approx n (a ts (functors.MixVariantFunctor.fmap (dependent_type_functor_rec ts W) (approx n) (approx n) w) x).
-
-Definition super_non_expansive_E {W} (E : forall ts : list Type, dependent_type_functor_rec ts W (predicates_hered.pred rmap) -> coPset) :=
-  forall n ts w, E ts w = E ts (functors.MixVariantFunctor.fmap (dependent_type_functor_rec ts W) (approx n) (approx n) w).
-
-Definition super_non_expansive_b {A B W} (b : forall ts : list Type, functors.MixVariantFunctor._functor
-  (dependent_type_functor_rec ts W) (predicates_hered.pred rmap) -> A ts -> B ts -> predicates_hered.pred rmap) :=
-  forall n ts w x y, approx n (b ts w x y) =
-  approx n (b ts (functors.MixVariantFunctor.fmap (dependent_type_functor_rec ts W) (approx n) (approx n) w) x y).
-
-Definition super_non_expansive_la {W} la := @super_non_expansive_list W (fun ts w rho => map (fun l => !! (locald_denote l rho)) (la ts w)).
-
-Definition super_non_expansive_lb {B W} lb := forall v : B, @super_non_expansive_list W (fun ts w rho => map (fun l => !! (locald_denote l rho)) (lb ts w v)).
-
-Import List.
-
-(* A is the type of the abstract data. T is the type quantified over in the postcondition.
-   W is the TypeTree of the witness for the rest of the function. *)
-(*Notation atomic_spec1 T W args tz la P a t lb b E :=
-  (mk_funspec (pair args tz) cc_default (atomic_spec_type W T)
-   (fun (ts: list Type) '(w, Q) =>
-     PROP ()
-     (LOCALx (map (fun l => l ts w) la)
-     (SEP (atomic_shift (a ts w) (⊤ ∖ E) ∅ (b ts w) Q; P ts w))))
-   (fun (ts: list Type) '(w, Q) => EX v : T,
-     PROP () (LOCALx (map (fun l => l ts w v) lb)
-     (SEP (Q v)))) _ _).*)
-
-Lemma atomic_spec_nonexpansive_pre' : forall {A T} {t : Inhabitant T} W P L G R S2 E SQ
-  (HP : @super_non_expansive_list W (fun ts a _ => map prop (P ts a)))
-  (HL: forall n ts x, L ts x = L ts (functors.MixVariantFunctor.fmap _ (compcert_rmaps.RML.R.approx n) (compcert_rmaps.RML.R.approx n) x))
-  (HG: @super_non_expansive_list W (fun ts a rho => map (fun Q0 => prop (locald_denote (gvars Q0) rho)) (G ts a)))
-  (HR : @super_non_expansive_list W (fun ts a _ => R ts a)),
-  super_non_expansive_a S2 ->
-  super_non_expansive_E E ->
-  super_non_expansive_b SQ ->
-  @args_super_non_expansive (atomic_spec_type W T)
-  (fun ts (_a : functors.MixVariantFunctor._functor (dependent_type_functor_rec ts W) mpred * (T -> mpred)) =>
-    let '(w, Q) := _a in
-    PROPx (P ts w) (PARAMSx (L ts w) (GLOBALSx (G ts w)
-     (SEPx (atomic_shift(A := A ts) (S2 ts w) (⊤ ∖ E ts w) ∅ (SQ ts w) Q :: R ts w))))).
-Proof.
-  intros.
-  hnf; intros.
-  etransitivity; [|etransitivity; [
-    apply (PROP_PARAMS_GLOBALS_SEP_args_super_non_expansive' (atomic_spec_type W T) (fun ts x => P ts (fst x)) (fun ts x => L ts (fst x)) (fun ts x => G ts (fst x)) (fun ts '(w, Q) => atomic_shift(A := A ts) (S2 ts w) (⊤ ∖ E ts w) ∅ (SQ ts w) Q :: R ts w))|]].
-  - instantiate (9 := x). destruct x. reflexivity.
-  - intros ? ? (?, ?) ?; apply HP; auto.
-  - intros ? ? (?, ?); apply HL; auto.
-  - intros ? ? (?, ?); apply HG; auto.
-  - intros ? ? (?, ?) ?; constructor; [|apply HR; auto].
-    rewrite -> atomic_shift_nonexpansive by auto; setoid_rewrite atomic_shift_nonexpansive at 2; auto.
-    f_equal; f_equal; repeat extensionality; simpl.
-    + apply H.
-    + erewrite H0; reflexivity.
-    + apply H1.
-    + rewrite approx_idem; auto.
-  - destruct x as (?, ?); reflexivity.
-Qed.
-
+Definition atomic_spec_type W T := ProdType W (DiscreteFunType T Mpred).
 Definition atomic_spec_type0 W := ProdType W Mpred.
 
-Lemma atomic_spec_nonexpansive_pre0 : forall {A} W P L G R S2 E SQ
-  (HP : super_non_expansive_list (fun ts w _ => map prop (P ts w)))
-  (HL: forall n ts x, L ts x = L ts (functors.MixVariantFunctor.fmap _ (compcert_rmaps.RML.R.approx n) (compcert_rmaps.RML.R.approx n) x))
-  (HG: @super_non_expansive_list W (fun ts a rho => map (fun Q0 => prop (locald_denote (gvars Q0) rho)) (G ts a)))
-  (HR : super_non_expansive_list (fun ts w _ => R ts w)),
-  super_non_expansive_a S2 ->
-  super_non_expansive_E E ->
-  super_non_expansive_b SQ ->
-  @args_super_non_expansive (atomic_spec_type0 W)
-  (fun ts (_a : functors.MixVariantFunctor._functor (dependent_type_functor_rec ts W) mpred * mpred) =>
-    let '(w, Q) := _a in
-    PROPx (P ts w) (PARAMSx (L ts w) (GLOBALSx (G ts w)
-     (SEPx (atomic_shift(A := A ts)(B := unit) (S2 ts w) (⊤ ∖ E ts w) ∅ (SQ ts w) (fun _ => Q) :: R ts w))))).
-Proof.
-  intros.
-  hnf; intros.
-  etransitivity; [|etransitivity; [
-    apply (PROP_PARAMS_GLOBALS_SEP_args_super_non_expansive' (atomic_spec_type0 W) (fun ts x => P ts (fst x)) (fun ts x => L ts (fst x)) (fun ts x => G ts (fst x)) (fun ts '(w, Q) => atomic_shift(A := A ts) (S2 ts w) (⊤ ∖ E ts w) ∅ (SQ ts w) (fun _ => Q) :: R ts w))|]].
-  - instantiate (9 := x). destruct x. reflexivity.
-  - intros ? ? (?, ?) ?; apply HP; auto.
-  - intros ? ? (?, ?); apply HL; auto.
-  - intros ? ? (?, ?); apply HG; auto.
-  - intros ? ? (?, ?) ?; constructor; [|apply HR; auto].
-    rewrite -> atomic_shift_nonexpansive by auto; setoid_rewrite atomic_shift_nonexpansive at 2; auto.
-    f_equal; f_equal; repeat extensionality; simpl.
-    + apply H.
-    + erewrite H0; reflexivity.
-    + apply H1.
-    + rewrite approx_idem; auto.
-  - destruct x as (?, ?); reflexivity.
-Qed.
-
-Lemma atomic_spec_nonexpansive_pre : forall {A T} {t : Inhabitant T} W P L G R S2 E SQ Pre
-  (Heq : (forall ts (_a : functors.MixVariantFunctor._functor (dependent_type_functor_rec ts W) mpred * (T -> mpred)),
-   Pre ts _a = let '(w, Q) := _a in
-    PROPx (P ts w) (PARAMSx (L ts w) (GLOBALSx (G ts w)
-     (SEPx (atomic_shift(A := A ts) (S2 ts w) (⊤ ∖ E ts w) ∅ (SQ ts w) Q :: R ts w))))))
-  (HP : super_non_expansive_list (fun ts w _ => map prop (P ts w)))
-  (HL: forall n ts x, L ts x = L ts (functors.MixVariantFunctor.fmap _ (compcert_rmaps.RML.R.approx n) (compcert_rmaps.RML.R.approx n) x))
-  (HG: @super_non_expansive_list W (fun ts a rho => map (fun Q0 => prop (locald_denote (gvars Q0) rho)) (G ts a)))
-  (HR : super_non_expansive_list (fun ts w _ => R ts w)),
-  super_non_expansive_a S2 ->
-  super_non_expansive_E E ->
-  super_non_expansive_b SQ ->
-  @args_super_non_expansive (atomic_spec_type W T) Pre.
+Program Definition atomic_spec_pre' `{!heapGS Σ} {A T} W
+  (P : dtfr W -n> _) (L : dtfr W -n> _) (G : dtfr W -n> leibnizO (list globals)) (R : dtfr W -n> _) (S2 : dtfr W -n> _)
+  (E : dtfr W -n> leibnizO coPset) (SQ : dtfr W -n> _) :
+  (prodO (@dtfr Σ W) (T -d> mpred)) -n> argsEnviron -d> mpred :=
+  λne '(w, Q),
+    PROPx (P w) (PARAMSx (L w) (GLOBALSx (G w)
+     (SEPx (atomic_shift(A := A) (S2 w) (⊤ ∖ E w) ∅ (SQ w) Q :: R w)))).
+Next Obligation.
 Proof.
   intros.
-  evar (Pre' : forall ts : list Type, functors.MixVariantFunctor._functor (dependent_type_functor_rec ts W) mpred * (T -> mpred) -> argsEnviron -> mpred).
-  replace Pre with Pre'; subst Pre'; [apply (atomic_spec_nonexpansive_pre'(A := A)); eauto|].
-  extensionality ts x; auto.
+  intros (w1, ?) (w2, ?) (Hw & ?) ?; simpl in *.
+  do 2 f_equiv.
+  { rewrite Hw //. }
+  f_equiv.
+  { apply leibniz_equiv, (discrete_iff n); [apply _ | rewrite Hw //]. }
+  rewrite Hw H //.
 Qed.
 
-Lemma atomic_spec_nonexpansive_post' : forall {T} W L R
-  (HL : forall v, super_non_expansive_list (fun ts w rho => map (fun l => !! (locald_denote l rho)) (L ts w v)))
-  (HR : forall v, super_non_expansive_list ((fun ts w _ => R ts w v))),
-  @super_non_expansive (atomic_spec_type W T)
-  (fun ts (_a : functors.MixVariantFunctor._functor (dependent_type_functor_rec ts W) mpred * (T -> mpred)) =>
-    let '(w, Q) := _a in
-    EX v : T,
-    PROP () (LOCALx (L ts w v) (SEPx (Q v :: R ts w v)))).
+Program Definition atomic_spec_pre0 `{!heapGS Σ} {A} W
+  (P : dtfr W -n> _) (L : dtfr W -n> _) (G : dtfr W -n> leibnizO (list globals)) (R : dtfr W -n> _) (S2 : dtfr W -n> _)
+  (E : dtfr W -n> leibnizO coPset) (SQ : dtfr W -n> _) :
+  (prodO (@dtfr Σ W) mpred) -n> argsEnviron -d> mpred :=
+  λne '(w, Q),
+    PROPx (P w) (PARAMSx (L w) (GLOBALSx (G w)
+     (SEPx (atomic_shift(A := A)(B := unit) (S2 w) (⊤ ∖ E w) ∅ (SQ w) (fun _ => Q) :: R w)))).
+Next Obligation.
 Proof.
   intros.
-  hnf; intros.
-  destruct x as (w, Q).
-  rewrite !approx_exp; f_equal; extensionality v.
-  etransitivity; [|etransitivity; [
-    apply (PROP_LOCAL_SEP_super_non_expansive' (atomic_spec_type W T) (fun ts '(w, _) => []) (fun ts '(w, _) => L ts w v) (fun ts '(w, Q) => Q v :: R ts w v))|]].
-  - instantiate (1 := rho); instantiate (1 := ts); instantiate (1 := (w, Q)); reflexivity.
-  - intros ? ? (?, ?) ?; constructor.
-  - intros ? ? (?, ?) ?; apply HL; auto.
-  - intros ? ? (?, ?) ?; constructor; [|apply HR; auto].
-    simpl; rewrite approx_idem; auto.
-  - reflexivity.
+  intros (w1, ?) (w2, ?) (Hw & ?) ?; simpl in *.
+  do 2 f_equiv.
+  { rewrite Hw //. }
+  f_equiv.
+  { apply leibniz_equiv, (discrete_iff n); [apply _ | rewrite Hw //]. }
+  rewrite Hw; repeat f_equiv; solve_proper.
 Qed.
 
-Lemma atomic_spec_nonexpansive_post0 : forall W L R
-  (HL : super_non_expansive_list (fun ts w rho => map (fun l => !! (locald_denote l rho)) (L ts w)))
-  (HR : super_non_expansive_list ((fun ts w _ => R ts w))),
-  @super_non_expansive (atomic_spec_type0 W)
-  (fun ts (_a : functors.MixVariantFunctor._functor (dependent_type_functor_rec ts W) mpred * mpred) =>
-    let '(w, Q) := _a in
-    PROP () (LOCALx (L ts w) (SEPx (Q :: R ts w)))).
+Program Definition atomic_spec_post' `{!heapGS Σ} {T} W
+  (L : dtfr W -n> _ -d> leibnizO _) (R : dtfr W -n> _ -d> _) :
+  (prodO (@dtfr Σ W) (T -d> mpred)) -n> environ -d> mpred :=
+    λne '(w, Q),
+      ∃ v : T, PROP () (LOCALx (L w v) (SEPx (Q v :: R w v))).
+Next Obligation.
 Proof.
   intros.
-  hnf; intros.
-  etransitivity; [|etransitivity; [
-    apply (PROP_LOCAL_SEP_super_non_expansive' (atomic_spec_type0 W) (fun ts '(w, _) => []) (fun ts '(w, _) => L ts w) (fun ts '(w, Q) => Q :: R ts w))|]].
-  - instantiate (1 := rho); instantiate (1 := ts); instantiate (1 := x); destruct x as (?, ?); reflexivity.
-  - intros ? ? (?, ?) ?; constructor.
-  - intros ? ? (?, ?) ?; apply HL; auto.
-  - intros ? ? (?, ?) ?; constructor; [|apply HR; auto].
-    simpl; rewrite approx_idem; auto.
-  - reflexivity.
+  intros (w1, ?) (w2, ?) (Hw & ?) ?; simpl in *.
+  do 5 f_equiv.
+  { apply (leibniz_equiv(H := equivL)). unshelve rewrite -> (ofe_mor_ne _ _ L n); done. }
+  do 2 f_equiv; first done.
+  unshelve rewrite -> (ofe_mor_ne _ _ R n); done.
 Qed.
 
-Lemma atomic_spec_nonexpansive_post : forall {T} W L R Post
-  (Heq : (forall ts (_a : functors.MixVariantFunctor._functor (dependent_type_functor_rec ts W) mpred * (T -> mpred)),
-  Post ts _a = let '(w, Q) := _a in
-    EX v : T,
-    PROP () (LOCALx (L ts w v) (SEPx (Q v :: R ts w v)))))
-  (HL : forall v, super_non_expansive_list (fun ts w rho => map (fun l => !! (locald_denote l rho)) (L ts w v)))
-  (HR : forall v, super_non_expansive_list ((fun ts w _ => R ts w v))),
-  @super_non_expansive (atomic_spec_type W T) Post.
+Program Definition atomic_spec_post0 `{!heapGS Σ} W
+  (L : dtfr W -n> leibnizO _) (R : dtfr W -n> _) :
+  (prodO (@dtfr Σ W) mpred) -n> environ -d> mpred :=
+    λne '(w, Q),
+      PROP () (LOCALx (L w) (SEPx (Q :: R w))).
+Next Obligation.
 Proof.
   intros.
-  evar (Post' : forall ts : list Type, functors.MixVariantFunctor._functor (dependent_type_functor_rec ts W) mpred * (T -> mpred) -> environ -> mpred).
-  replace Post with Post'; subst Post'; [apply atomic_spec_nonexpansive_post'; eauto|].
-  extensionality ts x; auto.
+  intros (w1, ?) (w2, ?) (Hw & ?)? ; simpl in *.
+  do 3 f_equiv.
+  { apply (leibniz_equiv(H := equivL)). rewrite Hw //. }
+  rewrite H Hw //.
 Qed.
 
 (* A is the type of the abstract data. T is the type quantified over in the postcondition.
    W is the TypeTree of the witness for the rest of the function. *)
-Program Definition atomic_spec {A T} {t : Inhabitant T} W args tz la P G Qp a lb
-        b E
-   (HP : super_non_expansive' P) (HQp : forall v:T, super_non_expansive' (Qp v))
+Program Definition atomic_spec `{!heapGS Σ} {A T} {t : Inhabitant T} W args (tz : type)
+  (la : dtfr W -n> list.listO (leibnizO val)) (P : dtfr W -n> mpred) (G : dtfr W -n> leibnizO (list globals))
+  (Qp : T -> dtfr W -n> mpred) (a : dtfr W -n> _) (lb : dtfr W -n> T -d> leibnizO (list localdef))
+        (b : dtfr W -n> _) (E : dtfr W -n> leibnizO coPset)
+   (*(HP : super_non_expansive' P) (HQp : forall v:T, super_non_expansive' (Qp v))
   (Ha : super_non_expansive_a(A := A) a) (Hla: forall n ts x, la ts x = la ts (functors.MixVariantFunctor.fmap _ (compcert_rmaps.RML.R.approx n) (compcert_rmaps.RML.R.approx n) x))
   (HG: @super_non_expansive_list W (fun ts a rho => map (fun Q0 => prop (locald_denote (gvars Q0) rho)) (G ts a)))
   (HE: super_non_expansive_E E)
-  (Hlb : super_non_expansive_lb lb) (Hb : super_non_expansive_b b) :=
-  mk_funspec (pair args tz) cc_default (atomic_spec_type W T)
-  (fun (ts: list Type) '(w, Q) =>
+  (Hlb : super_non_expansive_lb lb) (Hb : super_non_expansive_b b)*) :=
+  mk_funspec(PROP1 := iProp Σ) (pair args tz) cc_default (atomic_spec_type W T) (λne _, ⊤)
+  (λne '(w, Q),
     PROP ()
-    (PARAMSx (la ts w) (GLOBALSx (G ts w) (
-    (SEP (atomic_shift (a ts w) (⊤ ∖ E ts w) ∅ (b ts w) Q; P ts w))%assert5))))
-  (fun (ts: list Type) '(w, Q) => EX v : T,
-    PROP () (LOCALx (lb ts w v)
-    (SEP (Q v; Qp v ts w))%assert5)) _ _.
+    (PARAMSx (la w) (GLOBALSx (G w) (
+    (SEP (atomic_shift(A := A) (a w) (⊤ ∖ E w) ∅ (b w) Q; P w))%assert5))))
+  (λne '(w, Q), ∃ v : T,
+    PROP () (LOCALx (lb w v)
+    (SEP (Q v; Qp v w))%assert5)).
 Next Obligation.
 Proof.
-  intros; eapply atomic_spec_nonexpansive_pre; try eassumption.
-  { intros ? (?, ?). reflexivity. }
-  all: auto.
-  - constructor.
-  - repeat constructor; repeat intro; auto.
+  intros; intros (w1 & Q1) (w2 & Q2) (Hw & HQ) ?; simpl in *.
+  assert (la w1 = la w2) as ->.
+  { apply leibniz_equiv, (discrete_iff n); rewrite ?Hw //. apply _. }
+  assert (G w1 = G w2) as ->.
+  { apply leibniz_equiv, (discrete_iff n); rewrite ?Hw //. apply _. }
+  assert (E w1 = E w2) as ->.
+  { apply leibniz_equiv, (discrete_iff n); rewrite ?Hw //. apply _. }
+  solve_proper.
 Qed.
 Next Obligation.
 Proof.
-  intros; eapply atomic_spec_nonexpansive_post.
-  { intros ? (?, ?); reflexivity. }
-  - auto.
-  - repeat constructor.
-    unfold super_non_expansive, super_non_expansive' in *.
-    intros; apply HQp.
+  intros; intros (w1 & Q1) (w2 & Q2) (Hw & HQ) ?; simpl in *.
+  do 2 f_equiv.
+  intros v.
+  assert (lb w1 v = lb w2 v) as ->.
+  { assert (lb w1 ≡{n}≡ lb w2) as H by rewrite Hw //; apply H. }
+  solve_proper.
 Qed.
 
-(*Definition stable_spec_type W := ProdType (ProdType W
-  (ArrowType (DependentType 0) (ArrowType (DependentType 1) Mpred))) (ArrowType (DependentType 1) Mpred).
-
-Lemma stabilize : forall T W args tz P1 P2 Q1 Q2 neP1 neP2 neQ1 neQ2
-  PP la P a lb b Eo Ei Q'
-  (Hpre1 : forall ts w Q, P1 ts (w, Q) =
-     PROP (PP ts w)
-     (LOCALx (map (fun l => l ts w) la)
-     (SEP (atomic_shift (a ts w) Eo Ei (b ts w) Q; P ts w))))
-  (Hpost1 : forall ts w Q inv_names, Q1 ts (w, Q) =
-     EX v : T, PROP () (LOCALx (map (fun l => l ts w v) lb) (SEP (Q v))))
-  (Hpre2 : forall ts w b' Q, P2 ts (w, b', Q) =
-     PROP (PP ts w)
-     (LOCALx (map (fun l => l ts w) la)
-     (SEP (atomic_shift (a ts w) Eo Ei b' Q; P ts w))))
-  (Hpost2 : forall ts w b' Q, Q2 ts (w, b', Q) =
-    EX v1 : _, EX v2 : _,
-     PROP () (LOCALx (map (fun l => l ts w v2) lb)
-     (SEP (atomic_shift (a ts w) Eo Ei b' Q; Q' ts w v1 v2))))
-  (Hb : forall ts w v1 v2, b ts w v1 v2 |-- a ts w v1 * Q' ts w v1 v2),
-  funspec_sub (mk_funspec (pair args tz) cc_default (atomic_spec_type W T) P1 Q1 neP1 neQ1)
-    (mk_funspec (pair args tz) cc_default (stable_spec_type W) P2 Q2 neP2 neQ2).
-Proof.
-  intros; apply subsume_subsume.
-  unfold funspec_sub'; repeat (split; auto); intros.
-  destruct x2 as ((w, b'), Q).
-  simpl funsig_of_funspec.
-  rewrite Hpre2.
-  set (AS := atomic_shift _ _ _ _ _).
-  eapply derives_trans, ghost_seplog.bupd_intro.
-  Exists ts2 (w, (fun v2 => AS * EX v1 : _, Q' ts2 w v1 v2)) emp.
-  simpl in *; intro.
-  unfold liftx; simpl.
-  unfold lift.
-  rewrite emp_sepcon.
-  apply andp_right.
-  - apply andp_left2.
-    rewrite Hpre1.
-    unfold PROPx, LOCALx, SEPx; simpl.
-    do 2 (apply andp_derives; auto).
-    unfold AS, atomic_shift; Intros P'; Exists P'; cancel.
-    sep_apply cored_dup_cored.
-    apply andp_derives; auto.
-    iIntros "[H AS] P"; iMod ("H" with "P") as (v1) "[a H]".
-    iExists v1; iFrame.
-    iIntros "!>"; iSplit.
-    + iIntros "a".
-      iDestruct "AS" as "[_ e]"; iMod (cored_emp with "e") as "_".
-      iApply "H"; auto.
-    + iIntros (y) "b".
-      iDestruct (Hb with "b") as "[a Q]".
-      iMod ("H" with "a").
-      iIntros "!>"; iSplitR "Q".
-      * iExists P'; iFrame.
-      * iExists v1; auto.
-  - apply prop_right; intros.
-    apply andp_left2; rewrite emp_sepcon; auto.
-    rewrite Hpost1 Hpost2.
-    unfold PROPx, LOCALx, SEPx; simpl.
-    eapply derives_trans, ghost_seplog.bupd_intro.
-    Intros v2 v1; Exists v1 v2; rewrite sepcon_assoc; unfold AS; auto.
-Qed.
-
-Lemma stabilize0 : forall W args tz P1 P2 Q1 Q2 neP1 neP2 neQ1 neQ2
-  PP la P a lb b Eo Ei Q'
-  (Hpre1 : forall ts w Q, P1 ts (w, Q) =
-    PROP (PP ts w)
-     (LOCALx (map (fun l => l ts w) la)
-     (SEP (atomic_shift(B := unit) (a ts w) Eo Ei (b ts w) (fun _ => Q); P ts w))))
-  (Hpost1 : forall ts w Q, Q1 ts (w, Q) =
-     PROP () (LOCALx (map (fun l => l ts w) lb) ((SEPx (Q :: cons SPx%logic .. (cons SPy%logic nil) ..)))))
-  (Hpre2 : forall ts w b' Q, P2 ts (w, b', Q) =
-     PROP (PP ts w)
-     (LOCALx (map (fun l => l ts w) la)
-     (SEP (atomic_shift (a ts w) Eo Ei b' Q; P ts w))))
-  (Hpost2 : forall ts w b' Q inv_names, Q2 ts (w, b', Q) =
-    EX v1 : _,
-     PROP () (LOCALx (map (fun l => l ts w) lb)
-     (SEP (atomic_shift (a ts w) Eo Ei b' Q; Q' ts w v1))))
-  (Hb : forall ts w v1, b ts w v1 tt |-- a ts w v1 * Q' ts w v1),
-  funspec_sub (mk_funspec (pair args tz) cc_default (atomic_spec_type0 W) P1 Q1 neP1 neQ1)
-    (mk_funspec (pair args tz) cc_default (stable_spec_type W) P2 Q2 neP2 neQ2).
-Proof.
-  intros; apply subsume_subsume.
-  unfold funspec_sub'; repeat (split; auto); intros.
-  destruct x2 as ((w, b'), Q).
-  simpl funsig_of_funspec.
-  rewrite Hpre2.
-  set (AS := atomic_shift _ _ _ _ _).
-  eapply derives_trans, ghost_seplog.bupd_intro.
-  Exists ts2 (w, (AS * EX v1 : _, Q' ts2 w v1)) emp.
-  simpl in *; intro.
-  unfold liftx; simpl.
-  unfold lift.
-  rewrite emp_sepcon.
-  apply andp_right.
-  - apply andp_left2.
-    rewrite Hpre1.
-    unfold PROPx, LOCALx, SEPx; simpl.
-    do 2 (apply andp_derives; auto).
-    unfold AS, atomic_shift; Intros P'; Exists P'; cancel.
-    sep_apply cored_dup_cored.
-    apply andp_derives; auto.
-    iIntros "[H AS] P"; iMod ("H" with "P") as (v1) "[a H]".
-    iExists v1; iFrame.
-    iIntros "!>"; iSplit.
-    + iIntros "a".
-      iDestruct "AS" as "[_ e]"; iMod (cored_emp with "e") as "_".
-      iApply "H"; auto.
-    + iIntros ([]) "b".
-      iDestruct (Hb with "b") as "[a Q]".
-      iMod ("H" with "a").
-      iIntros "!>"; iSplitR "Q".
-      * iExists P'; iFrame.
-      * iExists v1; auto.
-  - apply prop_right; intros.
-    apply andp_left2; rewrite emp_sepcon; auto.
-    rewrite Hpost1 Hpost2.
-    unfold PROPx, LOCALx, SEPx; simpl.
-    eapply derives_trans, ghost_seplog.bupd_intro.
-    Intros v1; Exists v1; rewrite sepcon_assoc; unfold AS; auto.
-Qed.*)
-
 Require Import stdpp.hlist.
 
 (* Adapted from personal correspondence with Jason Gross, this lets us manipulate tuple types like they were lists. *)
@@ -556,680 +319,495 @@ Definition rev_curry {A B} (f : tuple_type A -> B) : tuple_type_rev A -> B
   := fun v => f (tcurry_rev _ v).
 
 (* There must be a way to simplify this. *)
-Notation "'ATOMIC' 'TYPE' W 'OBJ' x : A 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' ( Lx ; .. ; Ly ) 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'EX' r : T , 'PROP' () 'LOCAL' ( LQx ; .. ; LQy ) 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type W T)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : T -> mpred) (_ : tuple_type tnil) =>
-     PROPx (cons Px%type .. (cons Py%type nil) ..)
-     (PARAMSx (cons Lx%type .. (cons Ly%type nil) ..) (GLOBALSx (cons Gx .. (cons Gy nil) ..)
-     (SEPx (cons (atomic_shift (fun x => S2) (⊤ ∖ E) ∅ (fun x r => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) Q) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : T -> mpred) (_ : tuple_type tnil) =>
-    @exp (environ -> mpred) _ T (fun r =>
-     PROP () (LOCALx (cons LQx .. (cons LQy nil) ..) ((SEPx (Q r :: cons SPx .. (cons SPy nil) ..)))))))) ..)))
-   (@atomic_spec_nonexpansive_pre' (fun _ => A) T _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x r => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post' W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons LQx%assert3 .. (cons LQy%assert3 nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons SPx%assert3 .. (cons SPy%assert3 nil) ..))) ..))) _ _))
+Notation "'ATOMIC' 'TYPE' W 'OBJ' x : A 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' ( Lx ; .. ; Ly ) 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] '∃' r : T , 'PROP' () 'LOCAL' ( LQx ; .. ; LQy ) 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
+  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type W T) (λne _, ⊤)
+   (atomic_spec_pre'(A := A)(T := T) W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x r => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+   (atomic_spec_post'(T := T) W
+      (OfeMor (A := dtfr W) (B := _ -d> leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons LQx%assert3 .. (cons LQy%assert3 nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := _ -d> listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons SPx%assert3 .. (cons SPy%assert3 nil) ..))) ..))))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0, r at level 0, T at level 0).
 
-Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' ( Lx ; .. ; Ly ) 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'EX' r : T , 'PROP' () 'LOCAL' ( LQx ; .. ; LQy ) 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type W T)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : T -> mpred) (_ : tuple_type tnil) =>
-     PROPx (cons Px%type .. (cons Py%type nil) ..)
-     (PARAMSx (cons Lx%type .. (cons Ly%type nil) ..) (GLOBALSx (cons Gx .. (cons Gy nil) ..)
-     (SEPx (cons (atomic_shift (fun x => S2) (⊤ ∖ E) ∅ (fun x r => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) Q) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : T -> mpred) (_ : tuple_type tnil) =>
-    @exp (environ -> mpred) _ T (fun r =>
-     PROP () (LOCALx (cons LQx .. (cons LQy nil) ..) ((SEPx (Q r :: cons SPx .. (cons SPy nil) ..)))))))) ..)))
-   (@atomic_spec_nonexpansive_pre' _ T _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))       (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x r => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post' W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons LQx%assert3 .. (cons LQy%assert3 nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons SPx%assert3 .. (cons SPy%assert3 nil) ..))) ..))) _ _))
+Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' ( Lx ; .. ; Ly ) 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] '∃' r : T , 'PROP' () 'LOCAL' ( LQx ; .. ; LQy ) 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
+  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type W T) (λne _, ⊤)
+   (atomic_spec_pre'(T := T) W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x r => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+   (atomic_spec_post' W
+      (OfeMor (A := dtfr W) (B := _ -d> leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons LQx%assert3 .. (cons LQy%assert3 nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := _ -d> listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons SPx%assert3 .. (cons SPy%assert3 nil) ..))) ..))))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0, r at level 0, T at level 0).
 
-Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' ( Lx ; .. ; Ly ) 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'EX' r : T , 'PROP' () 'LOCAL' () 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type W T)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : T -> mpred) (_ : tuple_type tnil) =>
-     PROPx (cons Px%type .. (cons Py%type nil) ..)
-     (PARAMSx (cons Lx%type .. (cons Ly%type nil) ..) (GLOBALSx (cons Gx .. (cons Gy nil) ..)
-     (SEPx (cons (atomic_shift (fun x => S2) (⊤ ∖ E) ∅ (fun x r => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) Q) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : T -> mpred) (_ : tuple_type tnil) =>
-    @exp (environ -> mpred) _ T (fun r =>
-     PROP () (LOCAL () (SEPx (Q r :: cons SPx .. (cons SPy nil) ..))))))) ..)))
-   (@atomic_spec_nonexpansive_pre' _ T _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))       (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x r => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post' W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..))) ..))) _ _))
+Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' ( Lx ; .. ; Ly ) 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] '∃' r : T , 'PROP' () 'LOCAL' () 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
+  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type W T) (λne _, ⊤)
+   (atomic_spec_pre'(T := T) W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x r => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+   (atomic_spec_post' W
+      (OfeMor (A := dtfr W) (B := _ -d> leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := _ -d> listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..))) ..))))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0, r at level 0, T at level 0).
 
 Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' ( Lx ; .. ; Ly ) 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'PROP' () 'LOCAL' ( LQx ; .. ; LQy ) 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROPx (cons Px%type .. (cons Py%type nil) ..)
-     (PARAMSx (cons Lx%type .. (cons Ly%type nil) ..) (GLOBALSx (cons Gx .. (cons Gy nil) ..)
-     (SEPx (cons (atomic_shift(B := unit) (fun x => S2) (⊤ ∖ E) ∅ (fun x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) (fun _ => Q)) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROP () (LOCALx (cons LQx .. (cons LQy nil) ..) (SEPx (Q :: cons SPx .. (cons SPy nil) ..)))))) ..)))
-   (@atomic_spec_nonexpansive_pre0 _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))       (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post0 W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons LQx%assert3 .. (cons LQy%assert3 nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons SPx%assert3 .. (cons SPy%assert3 nil) ..))) ..))) _ _))
+  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W) (λne _, ⊤)
+   (atomic_spec_pre0 W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post0 W
+      (OfeMor (A := dtfr W) (B := leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons LQx%assert3 .. (cons LQy%assert3 nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons SPx%assert3 .. (cons SPy%assert3 nil) ..))) ..))))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0).
 
 Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' ( Lx ; .. ; Ly ) 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'PROP' () 'LOCAL' () 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROPx (cons Px%type .. (cons Py%type nil) ..)
-     (PARAMSx (cons Lx%type .. (cons Ly%type nil) ..) (GLOBALSx (cons Gx .. (cons Gy nil) ..)
-     (SEPx (cons (atomic_shift(B := unit) (fun x => S2) (⊤ ∖ E) ∅ (fun x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) (fun _ => Q)) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROP () LOCAL () (SEPx (Q :: cons SPx .. (cons SPy nil) ..))))) ..)))
-   (@atomic_spec_nonexpansive_pre0 _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))       (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post0 W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..))) ..))) _ _))
+  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W) (λne _, ⊤)
+   (atomic_spec_pre0 W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post0 W
+      (OfeMor (A := dtfr W) (B := leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..))) ..))))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0).
 
 Notation "'ATOMIC' 'TYPE' W 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' () 'PARAMS' ( Lx ; .. ; Ly ) 'SEP' () '|' S2 'POST' [ tz ] 'PROP' () 'LOCAL' () 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROPx nil
-     (PARAMSx (cons Lx%type .. (cons Ly%type nil) ..) (GLOBALSx nil
-     (SEPx (cons (atomic_shift(B := unit) (fun _ : unit => S2) (⊤ ∖ E) ∅ (fun (_ : unit) _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) (fun _ => Q)) nil))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROP () LOCAL () (SEPx (Q :: cons SPx .. (cons SPy nil) ..))))) ..)))
-   (@atomic_spec_nonexpansive_pre0 _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) (_ : unit) => S2)) ..)))       (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) (_ : unit) _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post0 W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..))) ..))) _ _))
+  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W) (λne _, ⊤)
+   (atomic_spec_pre0 W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) (_ : unit) => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) (_ : unit) _ => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post0 W
+      (OfeMor (A := dtfr W) (B := leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..))) ..))))))
   (at level 200, x1 closed binder, xn closed binder, E at level 0, S2 at level 0).
 
 Notation "'ATOMIC' 'TYPE' W 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' () 'PARAMS' ( Lx ; .. ; Ly ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'PROP' () 'LOCAL' () 'SEP' () '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROPx nil
-     (PARAMSx (cons Lx%type .. (cons Ly%type nil) ..) (GLOBALSx nil
-     (SEPx (cons (atomic_shift(B := unit) (fun (_ : unit) => S2) (⊤ ∖ E) ∅ (fun x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) (fun _ => Q)) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROP () LOCAL () (SEPx (Q :: nil))))) ..)))
-   (@atomic_spec_nonexpansive_pre0 _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) (_ : unit) => S2)) ..)))       (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) (_ : unit) _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post0 W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))) _ _))
+  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W) (λne _, ⊤)
+   (atomic_spec_pre0 W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) (_ : unit) => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) (_ : unit) _ => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post0 W
+      (OfeMor (A := dtfr W) (B := leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))))
   (at level 200, x1 closed binder, xn closed binder, E at level 0, S2 at level 0).
 
-Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' ( Lx ; .. ; Ly ) 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'EX' r : T , 'PROP' () 'LOCAL' ( LQx ; .. ; LQy ) 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair nil tz) cc_default (atomic_spec_type W T)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : T -> mpred) (_ : tuple_type tnil) =>
-     PROPx (cons Px%type .. (cons Py%type nil) ..)
-     (PARAMSx (cons Lx%type .. (cons Ly%type nil) ..) (GLOBALSx (cons Gx .. (cons Gy nil) ..)
-     (SEPx (cons (atomic_shift (fun x => S2) (⊤ ∖ E) ∅ (fun x r => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) Q) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : T -> mpred) (_ : tuple_type tnil) =>
-    @exp (environ -> mpred) _ T (fun r =>
-     PROP () (LOCALx (cons LQx .. (cons LQy nil) ..) ((SEPx (Q r :: cons SPx .. (cons SPy nil) ..)))))))) ..)))
-   (@atomic_spec_nonexpansive_pre' _ T _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))       (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x r => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post' W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons LQx%assert3 .. (cons LQy%assert3 nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons SPx%assert3 .. (cons SPy%assert3 nil) ..))) ..))) _ _))
+Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' ( Lx ; .. ; Ly ) 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] '∃' r : T , 'PROP' () 'LOCAL' ( LQx ; .. ; LQy ) 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
+  (mk_funspec (pair nil tz) cc_default (atomic_spec_type W T) (λne _, ⊤)
+   (atomic_spec_pre'(T := T) W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x r => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post' W
+      (OfeMor (A := dtfr W) (B := _ -d> leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons LQx%assert3 .. (cons LQy%assert3 nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := _ -d> listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons SPx%assert3 .. (cons SPy%assert3 nil) ..))) ..))))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0, r at level 0, T at level 0).
 
-Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' ( Lx ; .. ; Ly ) 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'EX' r : T , 'PROP' () 'LOCAL' () 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair nil tz) cc_default (atomic_spec_type W T)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : T -> mpred) (_ : tuple_type tnil) =>
-     PROPx (cons Px%type .. (cons Py%type nil) ..)
-     (PARAMSx (cons Lx%type .. (cons Ly%type nil) ..) (GLOBALSx (cons Gx .. (cons Gy nil) ..)
-     (SEPx (cons (atomic_shift (fun x => S2) (⊤ ∖ E) ∅ (fun x r => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) Q) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : T -> mpred) (_ : tuple_type tnil) =>
-    @exp (environ -> mpred) _ T (fun r =>
-     PROP () (LOCAL () (SEPx (Q r :: cons SPx .. (cons SPy nil) ..))))))) ..)))
-   (@atomic_spec_nonexpansive_pre' _ T _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))       (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x r => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post' W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..))) ..))) _ _))
+Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' ( Lx ; .. ; Ly ) 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] '∃' r : T , 'PROP' () 'LOCAL' () 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
+  (mk_funspec (pair nil tz) cc_default (atomic_spec_type W T) (λne _, ⊤)
+   (atomic_spec_pre'(T := T) W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x r => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post' W
+      (OfeMor (A := dtfr W) (B := _ -d> leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := _ -d> listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..))) ..))))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0, r at level 0, T at level 0).
 
 Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ ] 'PROP' ( Px ; .. ; Py ) 'PARAMS ( Lx ; .. ; Ly ) 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'PROP' () 'LOCAL' ( LQx ; .. ; LQy ) 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair nil tz) cc_default (atomic_spec_type0 W)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROPx (cons Px%type .. (cons Py%type nil) ..)
-     (PARAMSx (cons Lx%type .. (cons Ly%type nil) ..) (GLOBALSx (cons Gx .. (cons Gy nil) ..)
-     (SEPx (cons (atomic_shift(B := unit) (fun x => S2) (⊤ ∖ E) ∅ (fun x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) (fun _ => Q)) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROP () (LOCALx (cons LQx .. (cons LQy nil) ..) (SEPx (Q :: cons SPx .. (cons SPy nil) ..)))))) ..)))
-   (@atomic_spec_nonexpansive_pre0 _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))       (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post0 W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons LQx%assert3 .. (cons LQy%assert3 nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons SPx%assert3 .. (cons SPy%assert3 nil) ..))) ..))) _ _))
+  (mk_funspec (pair nil tz) cc_default (atomic_spec_type0 W) (λne _, ⊤)
+   (atomic_spec_pre0 W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post0 W
+      (OfeMor (A := dtfr W) (B := leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons LQx%assert3 .. (cons LQy%assert3 nil) ..))) ..))))
+      (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons SPx%assert3 .. (cons SPy%assert3 nil) ..))) ..)))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0).
 
 Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' ( Lx ; .. ; Ly ) 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'PROP' () 'LOCAL' () 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair nil tz) cc_default (atomic_spec_type0 W)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROPx (cons Px%type .. (cons Py%type nil) ..)
-     (PARAMSx (cons Lx%type .. (cons Ly%type nil) ..) (GLOBALSx (cons Gx .. (cons Gy nil) ..)
-     (SEPx (cons (atomic_shift(B := unit) (fun x => S2) (⊤ ∖ E) ∅ (fun x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) (fun _ => Q)) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROP () LOCAL () (SEPx (Q :: cons SPx .. (cons SPy nil) ..))))) ..)))
-   (@atomic_spec_nonexpansive_pre0 _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))       (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post0 W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..))) ..))) _ _))
+  (mk_funspec (pair nil tz) cc_default (atomic_spec_type0 W) (λne _, ⊤)
+   (atomic_spec_pre0 W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post0 W
+      (OfeMor (A := dtfr W) (B := leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..))) ..))))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0).
 
-Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' () 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'EX' r : T , 'PROP' () 'LOCAL' ( LQx ; .. ; LQy ) 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type W T)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : T -> mpred) (_ : tuple_type tnil) =>
-     PROPx (cons Px%type .. (cons Py%type nil) ..)
-     (PARAMSx nil (GLOBALSx (cons Gx .. (cons Gy nil) ..)
-     (SEPx (cons (atomic_shift (fun x => S2) (⊤ ∖ E) ∅ (fun x r => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) Q) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : T -> mpred) (_ : tuple_type tnil) =>
-    @exp (environ -> mpred) _ T (fun r =>
-     PROP () (LOCALx (cons LQx .. (cons LQy nil) ..) ((SEPx (Q r :: cons SPx .. (cons SPy nil) ..)))))))) ..)))
-   (@atomic_spec_nonexpansive_pre' _ T _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))       (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x r => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post' W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons LQx%assert3 .. (cons LQy%assert3 nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons SPx%assert3 .. (cons SPy%assert3 nil) ..))) ..))) _ _))
+Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' () 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] '∃' r : T , 'PROP' () 'LOCAL' ( LQx ; .. ; LQy ) 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
+  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type W T) (λne _, ⊤)
+   (atomic_spec_pre'(T := T) W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x r => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post' W
+      (OfeMor (A := dtfr W) (B := _ -d> leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons LQx%assert3 .. (cons LQy%assert3 nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := _ -d> listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons SPx%assert3 .. (cons SPy%assert3 nil) ..))) ..))))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0, r at level 0, T at level 0).
 
-Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' () 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'EX' r : T , 'PROP' () 'LOCAL' () 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type W T)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : T -> mpred) (_ : tuple_type tnil) =>
-     PROPx (cons Px%type .. (cons Py%type nil) ..)
-     (PARAMSx nil (GLOBALSx (cons Gx .. (cons Gy nil) ..)
-     (SEPx (cons (atomic_shift (fun x => S2) (⊤ ∖ E) ∅ (fun x r => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) Q) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : T -> mpred) (_ : tuple_type tnil) =>
-    @exp (environ -> mpred) _ T (fun r =>
-     PROP () (LOCAL () (SEPx (Q r :: cons SPx .. (cons SPy nil) ..))))))) ..)))
-   (@atomic_spec_nonexpansive_pre' _ T _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))       (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x r => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post' W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..))) ..))) _ _))
+Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' () 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] '∃' r : T , 'PROP' () 'LOCAL' () 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
+  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type W T) (λne _, ⊤)
+   (atomic_spec_pre'(T := T) W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x r => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post' W
+      (OfeMor (A := dtfr W) (B := _ -d> leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := _ -d> listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..))) ..))))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0, r at level 0, T at level 0).
 
 Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' () 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'PROP' () 'LOCAL' ( LQx ; .. ; LQy ) 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROPx (cons Px%type .. (cons Py%type nil) ..)
-     (PARAMSx nil (GLOBALSx (cons Gx .. (cons Gy nil) ..)
-     (SEPx (cons (atomic_shift(B := unit) (fun x => S2) (⊤ ∖ E) ∅ (fun x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) (fun _ => Q)) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROP () (LOCALx (cons LQx .. (cons LQy nil) ..) (SEPx (Q :: cons SPx .. (cons SPy nil) ..)))))) ..)))
-   (@atomic_spec_nonexpansive_pre0 _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))       (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post0 W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons LQx%assert3 .. (cons LQy%assert3 nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons SPx%assert3 .. (cons SPy%assert3 nil) ..))) ..))) _ _))
+  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W) (λne _, ⊤)
+   (atomic_spec_pre0 W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post0 W
+      (OfeMor (A := dtfr W) (B := leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons LQx%assert3 .. (cons LQy%assert3 nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons SPx%assert3 .. (cons SPy%assert3 nil) ..))) ..))))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0).
 
 Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' () 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'PROP' () 'LOCAL' () 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROPx (cons Px%type .. (cons Py%type nil) ..)
-     (PARAMSx nil (GLOBALSx (cons Gx .. (cons Gy nil) ..)
-     (SEPx (cons (atomic_shift(B := unit) (fun x => S2) (⊤ ∖ E) ∅ (fun x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) (fun _ => Q)) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROP () LOCAL () (SEPx (Q :: cons SPx .. (cons SPy nil) ..))))) ..)))
-   (@atomic_spec_nonexpansive_pre0 _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))       (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post0 W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..))) ..))) _ _))
+  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W) (λne _, ⊤)
+   (atomic_spec_pre0 W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post0 W
+      (OfeMor (A := dtfr W) (B := leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..))) ..))))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0).
 
-Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' () 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'EX' r : T , 'PROP' () 'LOCAL' ( LQx ; .. ; LQy ) 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair nil tz) cc_default (atomic_spec_type W T)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : T -> mpred) (_ : tuple_type tnil) =>
-     PROPx (cons Px%type .. (cons Py%type nil) ..)
-     (PARAMSx nil (GLOBALSx (cons Gx .. (cons Gy nil) ..)
-     (SEPx (cons (atomic_shift (fun x => S2) (⊤ ∖ E) ∅ (fun x r => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) Q) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : T -> mpred) (_ : tuple_type tnil) =>
-    @exp (environ -> mpred) _ T (fun r =>
-     PROP () (LOCALx (cons LQx .. (cons LQy nil) ..) ((SEPx (Q r :: cons SPx .. (cons SPy nil) ..)))))))) ..)))
-   (@atomic_spec_nonexpansive_pre' _ T _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))       (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x r => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post' W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons LQx%assert3 .. (cons LQy%assert3 nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons SPx%assert3 .. (cons SPy%assert3 nil) ..))) ..))) _ _))
+Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' () 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] '∃' r : T , 'PROP' () 'LOCAL' ( LQx ; .. ; LQy ) 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
+  (mk_funspec (pair nil tz) cc_default (atomic_spec_type W T) (λne _, ⊤)
+   (atomic_spec_pre' (T := T) W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x r => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post' W
+      (OfeMor (A := dtfr W) (B := _ -d> leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons LQx%assert3 .. (cons LQy%assert3 nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := _ -d> listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons SPx%assert3 .. (cons SPy%assert3 nil) ..))) ..))))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0, r at level 0, T at level 0).
 
-Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ ] 'PROP' () 'PARAMS' () 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' () '|' S2 'POST' [ tz ] 'EX' r : T , 'PROP' () 'LOCAL' ( LQx ; .. ; LQy ) 'SEP' () '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair nil tz) cc_default (atomic_spec_type W T)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : T -> mpred) (_ : tuple_type tnil) =>
-     PROPx nil
-     (PARAMSx nil (GLOBALSx (cons Gx .. (cons Gy nil) ..)
-     (SEPx (cons (atomic_shift (fun x => S2) (⊤ ∖ E) ∅ (fun x r => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) Q) nil))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : T -> mpred) (_ : tuple_type tnil) =>
-    @exp (environ -> mpred) _ T (fun r =>
-     PROP () (LOCALx (cons LQx .. (cons LQy nil) ..) ((SEPx (Q r :: nil)))))))) ..)))
-   (@atomic_spec_nonexpansive_pre' _ T _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))       (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x r => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post' W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons LQx%assert3 .. (cons LQy%assert3 nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => nil)) ..))) _ _))
+Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ ] 'PROP' () 'PARAMS' () 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' () '|' S2 'POST' [ tz ] '∃' r : T , 'PROP' () 'LOCAL' ( LQx ; .. ; LQy ) 'SEP' () '|' ( SQx ; .. ; SQy )" :=
+  (mk_funspec (pair nil tz) cc_default (atomic_spec_type W T) (λne _, ⊤)
+   (atomic_spec_pre' (T := T) W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x r => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post' W
+      (OfeMor (A := dtfr W) (B := _ -d> leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons LQx%assert3 .. (cons LQy%assert3 nil) ..))) ..))))
+      (OfeMor(ofe_mor_ne := _)(B := _ -d> list mpred) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => nil)) ..))))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0, r at level 0, T at level 0).
 
-Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' () 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'EX' r : T , 'PROP' () 'LOCAL' () 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair nil tz) cc_default (atomic_spec_type W T)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : T -> mpred) (_ : tuple_type tnil) =>
-     PROPx (cons Px%type .. (cons Py%type nil) ..)
-     (PARAMSx nil (GLOBALSx (cons Gx .. (cons Gy nil) ..)
-     (SEPx (cons (atomic_shift (fun x => S2) (⊤ ∖ E) ∅ (fun x r => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) Q) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : T -> mpred) (_ : tuple_type tnil) =>
-    @exp (environ -> mpred) _ T (fun r =>
-     PROP () (LOCAL () (SEPx (Q r :: cons SPx .. (cons SPy nil) ..))))))) ..)))
-   (@atomic_spec_nonexpansive_pre' _ T _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))       (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x r => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post' W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..))) ..))) _ _))
+Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' () 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] '∃' r : T , 'PROP' () 'LOCAL' () 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
+  (mk_funspec (pair nil tz) cc_default (atomic_spec_type W T) (λne _, ⊤)
+   (atomic_spec_pre' (T := T) W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x r => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post' W
+      (OfeMor (A := dtfr W) (B := _ -d> leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := _ -d> listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) r => (cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..))) ..))))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0, r at level 0, T at level 0).
 
 Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' () 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'PROP' () 'LOCAL' ( LQx ; .. ; LQy ) 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair nil tz) cc_default (atomic_spec_type0 W)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROPx (cons Px%type .. (cons Py%type nil) ..)
-     (PARAMSx nil (GLOBALSx (cons Gx .. (cons Gy nil) ..)
-     (SEPx (cons (atomic_shift(B := unit) (fun x => S2) (⊤ ∖ E) ∅ (fun x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) (fun _ => Q)) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROP () (LOCALx (cons LQx .. (cons LQy nil) ..) (SEPx (Q :: cons SPx .. (cons SPy nil) ..)))))) ..)))
-   (@atomic_spec_nonexpansive_pre0 _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))       (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post0 W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons LQx%assert3 .. (cons LQy%assert3 nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons SPx%assert3 .. (cons SPy%assert3 nil) ..))) ..))) _ _))
+  (mk_funspec (pair nil tz) cc_default (atomic_spec_type0 W) (λne _, ⊤)
+   (atomic_spec_pre0 W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post0 W
+      (OfeMor (A := dtfr W) (B := leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons LQx%assert3 .. (cons LQy%assert3 nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons SPx%assert3 .. (cons SPy%assert3 nil) ..))) ..))))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0).
 
 Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' () 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'PROP' () 'LOCAL' () 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair nil tz) cc_default (atomic_spec_type0 W)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROPx (cons Px%type .. (cons Py%type nil) ..)
-     (PARAMSx nil (GLOBALSx (cons Gx .. (cons Gy nil) ..)
-     (SEPx (cons (atomic_shift(B := unit) (fun x => S2) (⊤ ∖ E) ∅ (fun x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) (fun _ => Q)) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROP () LOCAL () (SEPx (Q :: cons SPx .. (cons SPy nil) ..))))) ..)))
-   (@atomic_spec_nonexpansive_pre0 _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))       (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post0 W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..))) ..))) _ _))
+  (mk_funspec (pair nil tz) cc_default (atomic_spec_type0 W) (λne _, ⊤)
+   (atomic_spec_pre0 W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post0 W
+      (OfeMor (A := dtfr W) (B := leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..))) ..))))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0).
 
 Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ ] 'PROP' () 'PARAMS' () 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' () '|' S2 'POST' [ tz ] 'PROP' () 'LOCAL' ( LQx ; .. ; LQy ) 'SEP' () '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair nil tz) cc_default (atomic_spec_type0 W)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROPx nil
-     (PARAMSx nil (GLOBALSx (cons Gx .. (cons Gy nil) ..)
-     (SEPx (cons (atomic_shift(B := unit) (fun x => S2) (⊤ ∖ E) ∅ (fun x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) (fun _ => Q)) nil))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROP () (LOCALx (cons LQx .. (cons LQy nil) ..) (SEPx (Q :: nil)))))) ..)))
-   (@atomic_spec_nonexpansive_pre0 _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))       (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post0 W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons LQx%assert3 .. (cons LQy%assert3 nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))) _ _))
+  (mk_funspec (pair nil tz) cc_default (atomic_spec_type0 W) (λne _, ⊤)
+   (atomic_spec_pre0 W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post0 W
+      (OfeMor (A := dtfr W) (B := leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons LQx%assert3 .. (cons LQy%assert3 nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0).
 
 Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ ] 'PROP' () 'PARAMS' () 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' () '|' S2 'POST' [ tz ] 'PROP' () 'LOCAL' () 'SEP' () '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair nil tz) cc_default (atomic_spec_type0 W)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROPx nil
-     (PARAMSx nil (GLOBALSx (cons Gx .. (cons Gy nil) ..)
-     (SEPx (cons (atomic_shift(B := unit) (fun x => S2) (⊤ ∖ E) ∅ (fun x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) (fun _ => Q)) nil))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROP () LOCAL () (SEPx (Q :: nil))))) ..)))
-   (@atomic_spec_nonexpansive_pre0 _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))       (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post0 W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))) _ _))
+  (mk_funspec (pair nil tz) cc_default (atomic_spec_type0 W) (λne _, ⊤)
+   (atomic_spec_pre0 W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post0 W
+      (OfeMor (A := dtfr W) (B := leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0).
 
 Notation "'ATOMIC' 'TYPE' W 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' () 'PARAMS' ( Lx ; .. ; Ly ) 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'PROP' () 'LOCAL' () 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROPx nil
-     (PARAMSx (cons Lx%type .. (cons Ly%type nil) ..) (GLOBALSx (cons Gx .. (cons Gy nil) ..)
-     (SEPx (cons (atomic_shift(B := unit) (fun _ : unit => S2) (⊤ ∖ E) ∅ (fun _ _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) (fun _ => Q)) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROP () LOCAL () (SEPx (Q :: cons SPx .. (cons SPy nil) ..))))) ..)))
-   (@atomic_spec_nonexpansive_pre0 _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) (_:unit) => S2)) ..)))       (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) _ _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post0 W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..))) ..))) _ _))
+  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W) (λne _, ⊤)
+   (atomic_spec_pre0 W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) (_:unit) => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) _ _ => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post0 W
+      (OfeMor (A := dtfr W) (B := leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..))) ..))))))
   (at level 200, x1 closed binder, xn closed binder, E at level 0, S2 at level 0).
 
 Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' () 'PARAMS' ( Lx ; .. ; Ly ) 'GLOBALS' ( Gx ; .. ; Gy ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'PROP' () 'LOCAL' () 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROPx nil
-     (PARAMSx (cons Lx%type .. (cons Ly%type nil) ..) (GLOBALSx (cons Gx .. (cons Gy nil) ..)
-     (SEPx (cons (atomic_shift(B := unit) (fun x => S2) (⊤ ∖ E) ∅ (fun x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) (fun _ => Q)) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROP () LOCAL () (SEPx (Q :: cons SPx .. (cons SPy nil) ..))))) ..)))
-   (@atomic_spec_nonexpansive_pre0 _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))       (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post0 W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..))) ..))) _ _))
+  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W) (λne _, ⊤)
+   (atomic_spec_pre0 W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Gx .. (cons Gy nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post0 W
+      (OfeMor (A := dtfr W) (B := leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..))) ..))))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0).
 
 Notation "'ATOMIC' 'TYPE' W 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' () 'PARAMS' ( Lx ; .. ; Ly ) 'SEP' () '|' S2 'POST' [ tz ] 'PROP' () 'LOCAL' () 'SEP' () '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROPx nil
-     (PARAMSx (cons Lx%type .. (cons Ly%type nil) ..) (GLOBALSx nil
-     (SEPx (cons (atomic_shift(B := unit) (fun _ : unit => S2) (⊤ ∖ E) ∅ (fun _ _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) (fun _ => Q)) nil))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROP () LOCAL () (SEPx (Q :: nil))))) ..)))
-   (@atomic_spec_nonexpansive_pre0 _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) (_:unit) => S2)) ..)))       (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) _ _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post0 W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))) _ _))
+  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W) (λne _, ⊤)
+   (atomic_spec_pre0 W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) (_:unit) => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) _ _ => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post0 W
+      (OfeMor (A := dtfr W) (B := leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))))
   (at level 200, x1 closed binder, xn closed binder, E at level 0, S2 at level 0).
 
 Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' () 'PARAMS' ( Lx ; .. ; Ly ) 'SEP' () '|' S2 'POST' [ tz ] 'PROP' () 'LOCAL' () 'SEP' () '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROPx nil
-     (PARAMSx (cons Lx%type .. (cons Ly%type nil) ..) (GLOBALSx nil
-     (SEPx (cons (atomic_shift(B := unit) (fun x => S2) (⊤ ∖ E) ∅ (fun x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) (fun _ => Q)) nil))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROP () LOCAL () (SEPx (Q :: nil))))) ..)))
-   (@atomic_spec_nonexpansive_pre0 _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post0 W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))) _ _))
+  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W) (λne _, ⊤)
+   (atomic_spec_pre0 W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post0 W
+      (OfeMor (A := dtfr W) (B := leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0).
 
 Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' () 'PARAMS' ( Lx ; .. ; Ly ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'PROP' () 'LOCAL' () 'SEP' () '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROPx nil
-     (PARAMSx (cons Lx%type .. (cons Ly%type nil) ..) (GLOBALSx nil
-     (SEPx (cons (atomic_shift(B := unit) (fun x => S2) (⊤ ∖ E) ∅ (fun x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) (fun _ => Q)) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROP () LOCAL () (SEPx (Q :: nil))))) ..)))
-   (@atomic_spec_nonexpansive_pre0 _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post0 W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))) _ _))
+  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W) (λne _, ⊤)
+   (atomic_spec_pre0 W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post0 W
+      (OfeMor (A := dtfr W) (B := leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0).
 
 Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' () 'PARAMS' ( Lx ; .. ; Ly ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'PROP' () 'LOCAL' () 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROPx nil
-     (PARAMSx (cons Lx%type .. (cons Ly%type nil) ..) (GLOBALSx nil
-     (SEPx (cons (atomic_shift(B := unit) (fun x => S2) (⊤ ∖ E) ∅ (fun x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) (fun _ => Q)) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROP () LOCAL () (SEPx (Q :: cons SPx .. (cons SPy nil) ..))))) ..)))
-   (@atomic_spec_nonexpansive_pre0 _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post0 W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..)) ..))) _ _))
+  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W) (λne _, ⊤)
+   (atomic_spec_pre0 W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post0 W
+      (OfeMor (A := dtfr W) (B := leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..)) ..))))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0).
 
 Notation "'ATOMIC' 'TYPE' W 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' () 'PARAMS' ( Lx ; .. ; Ly ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'PROP' () 'LOCAL' () 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROPx nil
-     (PARAMSx (cons Lx%type .. (cons Ly%type nil) ..) (GLOBALSx nil
-     (SEPx (cons (atomic_shift(B := unit) (fun (_ : unit) => S2) (⊤ ∖ E) ∅ (fun (_ : unit) _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) (fun _ => Q)) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROP () LOCAL () (SEPx (Q :: cons SPx .. (cons SPy nil) ..))))) ..)))
-   (@atomic_spec_nonexpansive_pre0 _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) (_ : unit) => S2)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) (_ : unit) _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post0 W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..)) ..))) _ _))
+  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W) (λne _, ⊤)
+   (atomic_spec_pre0 W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) (_ : unit) => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) (_ : unit) _ => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post0 W
+      (OfeMor (A := dtfr W) (B := leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..)) ..))))))
   (at level 200, x1 closed binder, xn closed binder, E at level 0, S2 at level 0).
 
 Notation "'ATOMIC' 'TYPE' W 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' ( Lx ; .. ; Ly ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'PROP' () 'LOCAL' () 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROPx (cons Px%type .. (cons Py%type nil) ..)
-     (PARAMSx (cons Lx%type .. (cons Ly%type nil) ..) (GLOBALSx nil
-     (SEPx (cons (atomic_shift(B := unit) (fun (_ : unit) => S2) (⊤ ∖ E) ∅ (fun (_ : unit) _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) (fun _ => Q)) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROP () LOCAL () (SEPx (Q :: cons SPx .. (cons SPy nil) ..))))) ..)))
-   (@atomic_spec_nonexpansive_pre0 _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => cons Px%type .. (cons Py%type nil) ..)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) (_ : unit) => S2)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) (_ : unit) _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post0 W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..)) ..))) _ _))
+  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W) (λne _, ⊤)
+   (atomic_spec_pre0 W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => cons Px%type .. (cons Py%type nil) ..)) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) (_ : unit) => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) (_ : unit) _ => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post0 W
+      (OfeMor (A := dtfr W) (B := leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..)) ..))))))
   (at level 200, x1 closed binder, xn closed binder, E at level 0, S2 at level 0).
 
 Notation "'ATOMIC' 'TYPE' W 'OBJ' x 'INVS' E 'WITH' x1 , .. , xn 'PRE'  [ u , .. , v ] 'PROP' ( Px ; .. ; Py ) 'PARAMS' ( Lx ; .. ; Ly ) 'SEP' ( S1x ; .. ; S1y ) '|' S2 'POST' [ tz ] 'PROP' () 'LOCAL' () 'SEP' ( SPx ; .. ; SPy ) '|' ( SQx ; .. ; SQy )" :=
-  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W)
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROPx (cons Px%type .. (cons Py%type nil) ..)
-     (PARAMSx (cons Lx%type .. (cons Ly%type nil) ..) (GLOBALSx nil
-     (SEPx (cons (atomic_shift(B := unit) (fun x => S2) (⊤ ∖ E) ∅ (fun x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..)) (fun _ => Q)) (cons S1x%logic .. (cons S1y%logic nil) ..)))))))) ..)))
-   (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn => tcurry (fun (Q : mpred) (_ : tuple_type tnil) =>
-     PROP () LOCAL () (SEPx (Q :: cons SPx .. (cons SPy nil) ..))))) ..)))
-   (@atomic_spec_nonexpansive_pre0 _ W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%logic .. (cons S1y%logic nil) ..))) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%logic .. (cons SQy%logic nil) ..))) ..)))
-     _ _ _ _ _ _ _)
-  (atomic_spec_nonexpansive_post0 W
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..)))
-      (fun (ts: list Type) => rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..)) ..))) _ _))
+  (mk_funspec (pair (cons u%type .. (cons v%type nil) ..) tz) cc_default (atomic_spec_type0 W) (λne _, ⊤)
+   (atomic_spec_pre0 W
+      (OfeMor (A := dtfr W) (B := listO PropO) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Px%type .. (cons Py%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := listO valC) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons Lx%type .. (cons Ly%type nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO (list globals)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => (cons S1x%I .. (cons S1y%I nil) ..))) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x => S2)) ..))))
+      (OfeMor (A := dtfr W) (B := leibnizO coPset) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => E)) ..))))
+      (OfeMor (A := dtfr W) (B := (_ -d> _ -d> mpred)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) x _ => fold_right_sepcon (cons SQx%I .. (cons SQy%I nil) ..))) ..)))))
+  (atomic_spec_post0 W
+      (OfeMor (A := dtfr W) (B := leibnizO (list localdef)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => nil)) ..))))
+      (OfeMor (A := dtfr W) (B := listO (iPropO _)) (ofe_mor_ne := _) (rev_curry (tcurry (fun x1 => .. (tcurry (fun xn (_ : tuple_type tnil) => cons SPx%assert5%assert3 .. (cons SPy%assert5%assert3 nil) ..)) ..))))))
   (at level 200, x1 closed binder, xn closed binder, x at level 0, E at level 0, S2 at level 0).
 
-
-Ltac atomic_nonexpansive_tac := try (let x := fresh "x" in intros ?? x;
-  try match type of x with list Type => (let ts := fresh "ts" in rename x into ts; intros x) end;
-  repeat destruct x as [x ?]; unfold rev_curry, tcurry; simpl; auto); repeat constructor.
-
-Global Obligation Tactic := atomic_nonexpansive_tac.
+Ltac atomic_nonexpansive_tac := try (let x := fresh "x" in let y := fresh "y" in let H := fresh "Hdist" in intros ? x y H;
+  repeat (destruct x as [x ?]; try destruct y as [y ?]; try destruct H as [H ?];
+    try (hnf in H; simpl in H; match type of H with _ = ?b => subst b end)); unfold rev_curry, tcurry; simpl; auto); try solve_proper.
+
+#[export] Obligation Tactic := atomic_nonexpansive_tac.
+
+(* We might want to make atomic_spec_post transparent/simplify it when we define
+   funspecs, but for now, patching match_postcondition instead. *)
+Ltac match_postcondition ::=
+unfold atomic_spec_post', atomic_spec_post0, rev_curry, tcurry, tcurry_rev, tcurry_rev';
+fix_up_simplified_postcondition;
+cbv beta iota zeta; unfold_post;
+constructor; let rho := fresh "rho" in intro rho; cbn [monPred_at assert_of ofe_mor_car];
+   repeat rewrite exp_uncurry;
+   try rewrite no_post_exists; repeat rewrite monPred_at_exist;
+tryif apply bi.exist_proper
+ then (intros ?vret;
+          generalize rho; rewrite -local_assert; apply PROP_LOCAL_SEP_ext';
+          [reflexivity | | reflexivity];
+          (reflexivity || fail "The funspec of the function has a POSTcondition
+that is ill-formed.  The LOCALS part of the postcondition
+should be (temp ret_temp ...), but it is not"))
+ else fail "The funspec of the function should have a POSTcondition that starts
+with an existential, that is,  ∃ _:_, PROP...LOCAL...SEP".
 
 (* change start_function to handle curried arguments -- also thanks to Jason *)
 Ltac read_names term :=
@@ -1260,69 +838,98 @@ Ltac destruct_args t i :=
 
 Ltac start_function1 ::=
  leaf_function;
- lazymatch goal with |- semax_body ?V ?G ?F ?spec =>
-    check_normalized F;
-    function_body_unsupported_features F;
-    let s := fresh "spec" in
-    pose (s:=spec); hnf in s; cbn zeta in s; (* dependent specs defined with Program Definition often have extra lets *)
-   repeat lazymatch goal with
-    | s := (_, NDmk_funspec _ _ _ _ _) |- _ => fail
-    | s := (_, mk_funspec _ _ _ _ _ _ _) |- _ => fail
-    | s := (_, ?a _ _ _ _) |- _ => unfold a in s
-    | s := (_, ?a _ _ _) |- _ => unfold a in s
-    | s := (_, ?a _ _) |- _ => unfold a in s
-    | s := (_, ?a _) |- _ => unfold a in s
-    | s := (_, ?a) |- _ => unfold a in s
-    end;
-    lazymatch goal with
-    | s :=  (_,  WITH _: globals
-               PRE  [] main_pre _ _ _
-               POST [ tint ] _) |- _ => idtac
-    | s := ?spec' |- _ => check_canonical_funspec spec'
-   end;
-   change (semax_body V G F s); subst s;
-   unfold NDmk_funspec'
- end;
- let DependedTypeList := fresh "DependedTypeList" in
- unfold NDmk_funspec;
- match goal with |- semax_body _ _ _ (pair _ (mk_funspec _ _ _ ?Pre _ _ _)) =>
-
-   split3; [check_parameter_types' | check_return_type | ];
-    match Pre with
-   | (fun _ => rev_curry ?t) => let i := fresh in let x := read_names t in intros Espec DependedTypeList i; destruct_args x i; unfold rev_curry, tcurry; simpl tcurry_rev; cbn match (* added line *)
-   | (fun _ => convertPre _ _ (fun i => _)) =>  intros Espec DependedTypeList i
-   | (fun _ x => match _ with (a,b) => _ end) => intros Espec DependedTypeList [a b]
-   | (fun _ i => _) => intros Espec DependedTypeList i
+   lazymatch goal with
+   | |- semax_body ?V ?G ?F ?spec =>
+         check_normalized F; function_body_unsupported_features F;
+          (let s := fresh "spec" in
+           pose (s := spec); hnf in s; cbn zeta in s;
+            repeat
+             lazymatch goal with
+             | s:=(_, NDmk_funspec _ _ _ _ _):_ |- _ => fail
+             | s:=(_, mk_funspec _ _ _ _ _ _):_ |- _ => fail
+             | s:=(_, ?a _ _ _ _):_ |- _ => unfold a in s
+             | s:=(_, ?a _ _ _):_ |- _ => unfold a in s
+             | s:=(_, ?a _ _):_ |- _ => unfold a in s
+             | s:=(_, ?a _):_ |- _ => unfold a in s
+             | s:=(_, ?a):_ |- _ => unfold a in s
+             end;
+            lazymatch goal with
+            | s:=(_, WITH _ : globals PRE [ ] main_pre _ _ _ POST [tint] _):_
+              |- _ => idtac
+            | s:=?spec':_ |- _ => check_canonical_funspec spec'
+            end; change (semax_body V G F s); subst s)
    end;
-   simpl fn_body; simpl fn_params; simpl fn_return
- end;
- try match goal with |- semax _ (fun rho => ?A rho * ?B rho)%logic _ _ =>
-     change (fun rho => ?A rho * ?B rho)%logic with (A * B)%logic
-  end;
- simpl functors.MixVariantFunctor._functor in *;
- simpl rmaps.dependent_type_functor_rec;
- clear DependedTypeList;
- rewrite_old_main_pre;
- repeat match goal with
- | |- @semax _ _ _ (match ?p with (a,b) => _ end * _)%logic _ _ =>
-             destruct p as [a b]
- | |- @semax _ _ _ (close_precondition _ match ?p with (a,b) => _ end * _) _ _ =>
-             destruct p as [a b]
- | |- @semax _ _ _ ((match ?p with (a,b) => _ end) eq_refl * _)%logic _ _ =>
-             destruct p as [a b]
- | |- @semax _ _ _ (close_precondition _ ((match ?p with (a,b) => _ end) eq_refl) * _) _ _ =>
-             destruct p as [a b]
- | |- semax _ (close_precondition _
-                                                (fun ae => !! (Datatypes.length (snd ae) = ?A) && ?B
-                                                      (make_args ?C (snd ae) (mkEnviron (fst ae) _ _))) * _)%logic _ _ =>
-          match B with match ?p with (a,b) => _ end => destruct p as [a b] end
-       end;
-(* this speeds things up, but only in the very rare case where it applies,
-   so maybe not worth it ...
-  repeat match goal with H: reptype _ |- _ => progress hnf in H; simpl in H; idtac "reduced a reptype" end;
-*)
- rewrite ?difference_empty_L; (* added line *)
- try start_func_convert_precondition.
+   (let gv := fresh "gv" in
+    match goal with
+    | |- semax_body _ _ _ (_, mk_funspec _ _ _ _ ?Pre _) =>
+          split3; [ check_parameter_types' | check_return_type |  ];
+           match Pre with
+           | atomic_spec_pre' _ _ _ _ _ (OfeMor(ofe_mor_ne := _) (rev_curry ?t)) _ _ =>
+               let i := fresh in let x := read_names t in intros Espec i; destruct i as [i Q]; destruct_args x i; unfold atomic_spec_pre', atomic_spec_post', ofe_mor_car, rev_curry, tcurry; cbn [tcurry_rev tcurry_rev']; cbn match (* added line *)
+           | atomic_spec_pre0 _ _ _ _ _ (OfeMor(ofe_mor_ne := _) (rev_curry ?t)) _ _ =>
+               let i := fresh in let x := read_names t in intros Espec i; destruct i as [i Q]; destruct_args x i; unfold atomic_spec_pre0, atomic_spec_post0, ofe_mor_car, rev_curry, tcurry; cbn [tcurry_rev tcurry_rev']; cbn match (* added line *)
+           | monPred_at (convertPre _ _ (λ i, _)) =>
+               intros Espec i
+           | λne x, monPred_at match _ with
+                               | (a, b) => _
+                               end => intros Espec [a b]
+           | λne i, _ => intros Espec i
+           end
+    | |- semax_body _ _ _ (pair _ (NDmk_funspec _ _ _ ?Pre _)) =>
+          split3; [check_parameter_types' | check_return_type | ];
+           match Pre with
+           | (convertPre _ _ (fun i => _)) =>  intros Espec (*DependedTypeList*) i
+           | (fun x => match _ with (a,b) => _ end) => intros Espec (*DependedTypeList*) [a b]
+           | (fun i => _) => intros Espec (*DependedTypeList*) i (* this seems to be named "a" no matter what *)
+           end
+    end; simpl fn_body; simpl fn_params; simpl fn_return;
+     cbv[dtfr dependent_type_functor_rec constOF idOF prodOF discrete_funOF ofe_morOF
+        sigTOF listOF oFunctor_car ofe_car] in *; cbv[ofe_mor_car];
+     rewrite_old_main_pre; rewrite ?argsassert_of_at ?assert_of_at;
+     repeat
+      match goal with
+      | |- semax _ _ (match ?p with
+                      | (a, b) => _
+                      end ∗ _) _ _ => destruct p as [a b]
+      | |- semax _ _ (close_precondition _ match ?p with
+                                           | (a, b) => _
+                                           end ∗ _) _ _ => 
+        destruct p as [a b]
+      | |-
+        semax _ _
+          (close_precondition _ (argsassert_of match ?p with
+                                               | (a, b) => _
+                                               end) ∗ _) _ _ => 
+        destruct p as [a b]
+      | |- semax _ _ (match ?p with
+                      | (a, b) => _
+                      end eq_refl ∗ _) _ _ => destruct p as [a b]
+      | |-
+        semax _ _
+          (close_precondition _ (match ?p with
+                                 | (a, b) => _
+                                 end eq_refl) ∗ _) _ _ => 
+        destruct p as [a b]
+      | |-
+        semax _ _
+          (close_precondition _
+             (argsassert_of (match ?p with
+                             | (a, b) => _
+                             end eq_refl)) ∗ _) _ _ => destruct p as [a b]
+      | |-
+        semax _ _
+          (close_precondition _
+             (λ ae,
+                ⌜Datatypes.length ae.2 = ?A⌝
+                ∧ ?B (make_args ?C ae.2 (mkEnviron ae.1 _ _))) ∗ _) _ _ =>
+            match B with
+            | match ?p with
+              | (a, b) => _
+              end => destruct p as [a b]
+            end
+      end; rewrite ?argsassert_of_at ?assert_of_at;
+     rewrite ?difference_empty_L; (* added line *)
+     try start_func_convert_precondition).
 
 (* can we not do this? *)
 Ltac start_function2 ::=
diff --git a/atomics/general_locks.v b/atomics/general_locks.v
index dae32586e7..8291ed40c6 100644
--- a/atomics/general_locks.v
+++ b/atomics/general_locks.v
@@ -1,62 +1,72 @@
 (* Specifications for locks for use with general invariants, in the style of the atomic syncer *)
-From VST.veric Require Import rmaps compcert_rmaps.
-From VST.concurrency Require Import ghosts conclib lock_specs.
-From VST.concurrency Require Export invariants fupd.
+From VST.concurrency Require Import conclib lock_specs.
 From VST.atomics Require Export general_atomics.
+From iris_ora.algebra Require Import frac_auth.
 
 Section locks.
 
-Context {P : Ghost}.
+Context {A : cmra}.
 
-Definition my_half g sh (a : G) := ghost_part(P := P) sh a g.
-Definition public_half g (a : G) := ghost_reference(P := P) a g.
-Definition both_halves (a : G) g := ghost_part_ref(P := P) Tsh a a g.
+Context `{!inG Σ (frac_authR A)}.
 
-Lemma my_half_join : forall sh1 sh2 sh a1 a2 a g, sepalg.join sh1 sh2 sh -> sepalg.join a1 a2 a -> sh1 <> Share.bot -> sh2 <> Share.bot ->
-  my_half g sh1 a1 * my_half g sh2 a2 = my_half g sh a.
+Definition my_half g sh (a : A) := own g (frac_auth_frag(A := A) sh a : frac_authR A).
+Definition public_half g (a : A) := own g (frac_auth_auth(A := A) a : frac_authR A).
+Definition both_halves (a : A) g := own g (frac_auth_auth(A := A) a ⋅ frac_auth_frag(A := A) 1 a : frac_authR A).
+
+Lemma my_half_join : forall sh1 sh2 a1 a2 g,
+  my_half g sh1 a1 ∗ my_half g sh2 a2 ⊣⊢ my_half g (sh1 ⋅ sh2) (a1 ⋅ a2).
+Proof.
+  intros; rewrite /my_half -own_op //.
+Qed.
+
+Lemma both_halves_join : forall g (a : A), my_half g 1 a ∗ public_half g a ⊣⊢ both_halves a g.
 Proof.
-  exact ghost_part_join.
+  intros; rewrite /my_half /public_half -own_op //.
 Qed.
 
-Lemma both_halves_join : forall g (a : G), my_half g Tsh a * public_half g a = both_halves a g.
+Lemma public_agree : forall g (a b: A), my_half g 1 a ∗ public_half g b ⊢ a ≡ b.
 Proof.
   intros.
-  apply (ghost_part_ref_join(P := P)).
+  iIntros "(a & b)"; iPoseProof (own_valid_2 with "a b") as "H".
+  rewrite frac_auth_agree_fullI internal_eq_sym //.
 Qed.
 
-Lemma public_agree : forall g (a b: G), my_half g Tsh a * public_half g b |-- !!(a = b).
+Lemma public_part_agree : forall g sh (a b: A), my_half g sh a ∗ public_half g b ⊢ if decide (sh = 1%Qp) then a ≡ b else ∃ c, b ≡ a ⋅ c.
 Proof.
-  intros. unfold my_half, public_half. eapply derives_trans; [apply ref_sub|].
-  apply prop_left; intro; apply prop_right.
-  rewrite if_true in H; auto.
+  intros.
+  iIntros "(a & b)"; iPoseProof (own_valid_2 with "a b") as "H".
+  rewrite frac_auth_agreeI; if_tac; try done.
+  by iApply internal_eq_sym.
 Qed.
 
-Lemma public_update : forall g (a b a' : G),
-  my_half g Tsh a * public_half g b |-- !!(b = a) && (|==> my_half g Tsh a' * public_half g a')%I.
+Lemma public_update : forall g (a b a' : A), ✓ a' ->
+  my_half g 1 a ∗ public_half g b ⊢ b ≡ a ∧ (|==> my_half g 1 a' ∗ public_half g a')%I.
 Proof.
   intros.
   iIntros "H".
-  iPoseProof (ref_sub(P := P) with "H") as "%".
-  rewrite eq_dec_refl in H; subst.
-  iSplit; auto.
-  rewrite !ghost_part_ref_join.
-  iApply (ref_update(P := P)); eauto.
+  iSplit. { by iApply internal_eq_sym; iApply public_agree. }
+  rewrite !(bi.sep_comm (my_half _ _ _)).
+  rewrite /my_half /public_half -!own_op.
+  iApply (own_update with "H").
+  by apply @frac_auth_update_1.
 Qed.
 
-Lemma public_part_update : forall g sh (a b a' b' : G) (Ha' : forall c, sepalg.join a c b -> sepalg.join a' c b' /\ (a = b -> a' = b')),
-  my_half g sh a * public_half g b |-- !!(if eq_dec sh Tsh then a = b else exists x, sepalg.join a x b) && (|==> my_half g sh a' * public_half g b')%I.
+Lemma public_part_update : forall g sh (a b a' b' : A) (Ha' : local_update(A := A) (b, a) (b', a')),
+  my_half g sh a ∗ public_half g b ⊢ (if decide (sh = 1%Qp) then a ≡ b else ∃ c, b ≡ a ⋅ c) ∧ (|==> my_half g sh a' ∗ public_half g b')%I.
 Proof.
   intros.
   iIntros "H".
-  iSplit; [iApply (ref_sub with "H")|].
-  rewrite !ghost_part_ref_join.
-  iApply (part_ref_update(P := P) with "H"); auto.
+  iSplit.
+  - by iApply public_part_agree.
+  - rewrite /my_half /public_half -!own_op.
+    iApply (own_update with "H").
+    by apply @frac_auth_update.
 Qed.
 
-(* lock_inv with share implies TaDA lock specs with share *)
+(*(* lock_inv with share implies TaDA lock specs with share *)
 Context {LI : lock_impl}.
 
-Definition lock_state g (b : bool) := ghost_var (if b then Tsh else gsh2) tt g.
+Definition lock_state g (b : bool) := ghost_var (if b then 1 else gsh2) tt g.
 Definition lock_ref sh p g := lock_inv sh p (ghost_var gsh1 tt g).
 
   Program Definition release_spec :=
@@ -81,18 +91,18 @@ Definition lock_ref sh p g := lock_inv sh p (ghost_var gsh1 tt g).
     POST [ tvoid ]
        PROP ()
        LOCAL ()
-       SEP (lock_ref sh p g) | (!!(l = false) && lock_state g true).
+       SEP (lock_ref sh p g) | (⌜l = false⌝ ∧ lock_state g true).
 (* it's inelegant but seems inevitable that we need the lock_inv locally here. This seems
    to be a consequence of baking share ownership into the lock_inv assertion. *)
 
 Lemma acquire_tada : funspec_sub lock_specs.acquire_spec acquire_spec.
 Proof.
     apply prove_funspec_sub.
-    split; auto. intros. simpl in *. Intros.
+    split; auto. intros. simpl in ∗. Intros.
     unfold rev_curry, tcurry; simpl. iIntros "H !>". destruct x2 as (((sh, h), g), Q).
     set (AS := atomic_shift _ _ _ _ _). iExists nil, (sh, h, ghost_var gsh1 tt g), AS.
     iSplit.
-    - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl.
+    - unfold PROPx, PARAMSx, ALOBALSx, LOCALx, SEPx, argsassert2assert; simpl.
       iDestruct "H" as "(% & % & % & $ & $ & _)"; auto.
     - iPureIntro. intros. Intros. (* need fupd in postcondition *)
 Admitted.
@@ -100,9 +110,9 @@ Admitted.
 Lemma release_tada : funspec_sub lock_specs.release_spec release_spec.
 Proof.
     apply prove_funspec_sub.
-    split; auto. intros. simpl in *. Intros.
+    split; auto. intros. simpl in ∗. Intros.
     unfold rev_curry, tcurry; simpl. iIntros "H". destruct x2 as (((sh, h), g), Q).
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl.
+    unfold PROPx, PARAMSx, ALOBALSx, LOCALx, SEPx, argsassert2assert; simpl.
     iDestruct "H" as "([% _] & % & % & AS & l & _)".
     iMod "AS" as (_) "[lock Hclose]".
     unfold lock_state at 1.
@@ -118,12 +128,12 @@ Proof.
       rewrite ghost_var_share_join_gen; Intros sh'.
       apply join_self, identity_share_bot in H4; contradiction.
     - iPureIntro. intros. entailer!.
-Qed.
+Qed.*)
 
 
-Definition sync_inv g sh R := EX a : G, R g a * my_half g sh a.
+Definition sync_inv g sh R := ∃ a : A, R g a ∗ my_half g sh a.
 
-Lemma sync_inv_exclusive : forall g sh (R : gname -> G -> mpred), exclusive_mpred (sync_inv g sh R).
+(*Lemma sync_inv_exclusive : forall g sh (R : gname -> A -> mpred), exclusive_mpred (sync_inv g sh R).
 Proof.
   intros; unfold exclusive_mpred, sync_inv.
   iIntros "[g1 g2]".
@@ -132,168 +142,179 @@ Proof.
   iPoseProof (own_valid_2(RA := ref_PCM P) with "[$g1 $g2]") as "%".
   hnf in H.
   destruct H as ((b, ?) & J & _).
-  inv J; simpl in *.
+  inv J; simpl in ∗.
   destruct b as [[]|]; auto.
   destruct H as (? & ? & J & ?).
   pose proof (join_self' J); subst.
   contradiction H; apply share_self_join_bot; auto.
+Qed.*)
+
+Context `{!heapGS Σ}.
+
+Lemma sync_commit_simple : forall Eo Ei (Q : mpred) g (x0 x' : A), ✓ x' ->
+  (atomic_shift(B := unit) (fun x => public_half g x) Eo Ei (fun x _ => x ≡ x0 ∧ public_half g x') (fun _ => Q) ∗ my_half g 1 x0 ⊢ |={Eo}=> Q ∗ my_half g 1 x')%I.
+Proof.
+  intros.
+  rewrite atomic_commit_fupd.
+  - iIntros ">(% & $ & H) !>".
+    iApply "H".
+  - intros; rewrite public_update //.
+    by iIntros "($ & >($ & $))".
 Qed.
 
-Lemma sync_commit_simple : forall Eo Ei (Q : mpred) g (x0 x' : G),
-  (atomic_shift(B := unit) (fun x => public_half g x) Eo Ei (fun x _ => !!(x = x0) && public_half g x') (fun _ => Q) * my_half g Tsh x0 |-- |={Eo}=> Q * my_half g Tsh x')%I.
+#[global] Instance sub_persistent sh (a b : A) : Persistent (if decide (sh = 1%Qp) then a ≡ b else ∃ c, b ≡ a ⋅ c : mpred)%I.
 Proof.
-  intros; eapply derives_trans; [apply atomic_commit_fupd with (R' := fun _ => my_half g Tsh x')|].
-  - intros.
-    eapply derives_trans; [apply public_update|].
-    Intros; apply bupd_mono.
-    iIntros "[$ ?]".
-    iExists tt; iSplit; auto.
-  - iIntros ">Q !>"; iDestruct "Q" as (_) "$".
+  if_tac; apply _.
 Qed.
 
-Lemma sync_rollback : forall {A B} a Eo Ei (b : A -> B -> mpred) (Q : B -> mpred) R R' g sh (x0 : G)
-  (Ha : forall x, R * a x |-- (|==> EX x1, public_half g x1 * (!!(if eq_dec sh Tsh then x0 = x1 else exists x, sepalg.join x0 x x1) --> (public_half g x1 -* |==> R' * a x)))%I),
-  (atomic_shift a Eo Ei b Q * my_half g sh x0 * R |-- |={Eo}=> atomic_shift a Eo Ei b Q * my_half g sh x0 * R')%I.
+Lemma sync_rollback : forall {B} a Eo Ei (b : A -> B -> mpred) (Q : B -> mpred) R R' g sh (x0 : A)
+  (Ha : forall x, R ∗ a x ⊢ (|==> ∃ x1, public_half g x1 ∗ ((if decide (sh = 1%Qp) then x0 ≡ x1 else ∃ x, x1 ≡ x0 ⋅ x) -∗ (public_half g x1 -∗ |==> R' ∗ a x))%I)),
+  (atomic_shift a Eo Ei b Q ∗ my_half g sh x0 ∗ R ⊢ |={Eo}=> atomic_shift a Eo Ei b Q ∗ my_half g sh x0 ∗ R')%I.
 Proof.
-  intros; rewrite !sepcon_assoc; apply atomic_rollback_fupd.
+  intros; apply atomic_rollback_fupd.
   intros; iIntros "((my & R) & a)".
   iMod (Ha with "[$]") as (?) "[public a']".
-  iPoseProof (ref_sub with "[$my $public]") as "%"; iFrame "my".
-  rewrite bi.sep_comm; iApply ("a'" with "[%]"); auto.
+  iDestruct (public_part_agree with "[$my $public]") as "#sub"; iFrame "my".
+  rewrite bi.sep_comm; iApply ("a'" with "sub"); auto.
 Qed.
 
-Lemma sync_commit_gen : forall {A B} a Eo Ei (b : A -> B -> mpred) Q R R' g sh (x0 : G)
-  (Ha : forall x, R * a x |-- (|==> EX x1, public_half g x1 * (!!(if eq_dec sh Tsh then x0 = x1 else exists x, sepalg.join x0 x x1) -->
-    |==> (EX x0' x1' : G, !!(forall b, sepalg.join x0 b x1 -> sepalg.join x0' b x1' /\ (x0 = x1 -> x0' = x1')) && (my_half g sh x0' * public_half g x1' -* |==> (EX y, b x y * R' y))))%I)%I),
-  (atomic_shift a Eo Ei b Q * my_half g sh x0 * R |-- |={Eo}=> EX y, Q y * R' y)%I.
+Lemma sync_commit_gen : forall {B} a Eo Ei (b : A -> B -> mpred) Q R R' g sh (x0 : A)
+  (Ha : forall x, R ∗ a x ⊢ (|==> ∃ x1, public_half g x1 ∗ ((if decide (sh = 1%Qp) then x0 ≡ x1 else ∃ x, x1 ≡ x0 ⋅ x) -∗
+    |==> (∃ x0' x1' : A, ⌜local_update(A := A) (x1, x0) (x1', x0')⌝ ∧ (my_half g sh x0' ∗ public_half g x1' -∗ |==> (∃ y, b x y ∗ R' y))))%I)%I),
+  (atomic_shift a Eo Ei b Q ∗ my_half g sh x0 ∗ R ⊢ |={Eo}=> ∃ y, Q y ∗ R' y)%I.
 Proof.
-  intros; rewrite sepcon_assoc.
+  intros.
   apply @atomic_commit_fupd with (R' := fun y => R' y).
   intros; iIntros "((my & R) & a)".
   iMod (Ha with "[$]") as (?) "[public a']".
-  iPoseProof (ref_sub(P := P) with "[$my $public]") as "%".
-  iMod ("a'" with "[%]") as (x0' x1') "[% H]"; first done.
-  iDestruct (public_part_update with "[$my $public]") as "[% >[my public]]"; eauto.
+  iDestruct (public_part_agree with "[$my $public]") as "#sub".
+  iMod ("a'" with "sub") as (x0' x1') "[% H]".
+  iDestruct (public_part_update with "[$my $public]") as "[#? >[my public]]"; eauto.
   iApply ("H" with "[$my $public]").
 Qed.
 
-Lemma sync_commit_same : forall {A B} a Eo Ei (b : A -> B -> mpred) Q R R' g sh (x0 : G)
-  (Ha : forall x, R * a x |-- (|==> EX x1, public_half g x1 * (!!(if eq_dec sh Tsh then x0 = x1 else exists x, sepalg.join x0 x x1) -->
-    |==> (my_half g sh x0 * public_half g x1 -* |==> (EX y, b x y * R' y)))%I)%I),
-  (atomic_shift a Eo Ei b Q * my_half g sh x0 * R |-- |={Eo}=> EX y, Q y * R' y)%I.
+Lemma sync_commit_same : forall {B} a Eo Ei (b : A -> B -> mpred) Q R R' g sh (x0 : A)
+  (Ha : forall x, R ∗ a x ⊢ (|==> ∃ x1, public_half g x1 ∗ ((if decide (sh = 1%Qp) then x0 ≡ x1 else ∃ x, x1 ≡ x0 ⋅ x) -∗
+    |==> (my_half g sh x0 ∗ public_half g x1 -∗ |==> (∃ y, b x y ∗ R' y)))%I)%I),
+  (atomic_shift a Eo Ei b Q ∗ my_half g sh x0 ∗ R ⊢ |={Eo}=> ∃ y, Q y ∗ R' y)%I.
 Proof.
-  intros; rewrite sepcon_assoc.
+  intros.
   apply @atomic_commit_fupd with (R' := fun y => R' y).
   intros; iIntros "((my & R) & a)".
   iMod (Ha with "[$]") as (?) "[public a']".
-  iPoseProof (ref_sub(P := P) with "[$my $public]") as "%".
-  iMod ("a'" with "[%]") as "H"; first done.
+  iDestruct (public_part_agree with "[$my $public]") as "#sub".
+  iMod ("a'" with "sub") as "H".
   iApply "H"; iFrame.
 Qed.
 
-Lemma sync_commit_gen1 : forall {A B} a Eo Ei (b : A -> B -> mpred) Q R R' g sh (x0 : G)
-  (Ha : forall x, R * a x |-- (|==> EX x1, public_half g x1 * (!!(if eq_dec sh Tsh then x0 = x1 else exists x, sepalg.join x0 x x1) -->
-    |==> (EX x0' x1' : G, !!(forall b, sepalg.join x0 b x1 -> sepalg.join x0' b x1' /\ (x0 = x1 -> x0' = x1')) && (my_half g sh x0' * public_half g x1' -* |==> (EX y, b x y) * R')))%I)%I),
-  (atomic_shift a Eo Ei b (fun _ => Q) * my_half g sh x0 * R |-- |={Eo}=> Q * R')%I.
+Lemma sync_commit_gen1 : forall {B} a Eo Ei (b : A -> B -> mpred) Q R R' g sh (x0 : A)
+  (Ha : forall x, R ∗ a x ⊢ (|==> ∃ x1, public_half g x1 ∗ ((if decide (sh = 1%Qp) then x0 ≡ x1 else ∃ x, x1 ≡ x0 ⋅ x) -∗
+    |==> (∃ x0' x1' : A, ⌜local_update(A := A) (x1, x0) (x1', x0')⌝ ∧ (my_half g sh x0' ∗ public_half g x1' -∗ |==> (∃ y, b x y) ∗ R')))%I)%I),
+  (atomic_shift a Eo Ei b (fun _ => Q) ∗ my_half g sh x0 ∗ R ⊢ |={Eo}=> Q ∗ R')%I.
 Proof.
-  intros; rewrite sepcon_assoc; eapply derives_trans; [apply @atomic_commit_fupd with
-      (R' := fun _ => R')|].
+  intros.
+  rewrite (atomic_commit_fupd _ _ _ _ _ _ (fun _ => R')).
+  - iIntros ">Q !>"; iDestruct "Q" as (?) "[$ $]".
   - intros; iIntros "((my & R) & a)".
     iMod (Ha with "[$]") as (?) "[public a']".
-    iPoseProof (ref_sub(P := P) with "[$my $public]") as "%".
-    iMod ("a'" with "[%]") as (x0' x1') "[% H]"; first done.
-    iDestruct (public_part_update with "[$my $public]") as "[% >[my public]]"; eauto.
-    rewrite exp_sepcon1; iApply ("H" with "[$my $public]").
-  - iIntros ">Q !>"; iDestruct "Q" as (?) "[$ $]".
+    iDestruct (public_part_agree with "[$my $public]") as "#sub".
+    iMod ("a'" with "sub") as (x0' x1') "[% H]".
+    iDestruct (public_part_update with "[$my $public]") as "[#? >[my public]]"; eauto.
+    rewrite -bi.sep_exist_r; iApply ("H" with "[$my $public]").
 Qed.
 
-Lemma sync_commit_same1 : forall {A B} a Eo Ei (b : A -> B -> mpred) Q R R' g sh (x0 : G)
-  (Ha : forall x, R * a x |-- (|==> EX x1, public_half g x1 * (!!(if eq_dec sh Tsh then x0 = x1 else exists x, sepalg.join x0 x x1) -->
-    |==> (my_half g sh x0 * public_half g x1 -* |==> (EX y, b x y * R')))%I)%I),
-  (atomic_shift a Eo Ei b (fun _ => Q) * my_half g sh x0 * R |-- |={Eo}=> Q * R')%I.
+Lemma sync_commit_same1 : forall {B} a Eo Ei (b : A -> B -> mpred) Q R R' g sh (x0 : A)
+  (Ha : forall x, R ∗ a x ⊢ (|==> ∃ x1, public_half g x1 ∗ ((if decide (sh = 1%Qp) then x0 ≡ x1 else ∃ x, x1 ≡ x0 ⋅ x) -∗
+    |==> (my_half g sh x0 ∗ public_half g x1 -∗ |==> (∃ y, b x y ∗ R')))%I)%I),
+  (atomic_shift a Eo Ei b (fun _ => Q) ∗ my_half g sh x0 ∗ R ⊢ |={Eo}=> Q ∗ R')%I.
 Proof.
-  intros; rewrite sepcon_assoc; eapply derives_trans; [apply @atomic_commit_fupd with
-      (R' := fun _ => R')|].
+  intros.
+  rewrite (atomic_commit_fupd _ _ _ _ _ _ (fun _ => R')).
+  { iIntros ">Q !>"; iDestruct "Q" as (?) "[$ $]". }
   intros; iIntros "((my & R) & a)".
   iMod (Ha with "[$]") as (?) "[public a']".
-  iPoseProof (ref_sub(P := P) with "[$my $public]") as "%".
-  iMod ("a'" with "[%]") as "H"; first done.
+  iDestruct (public_part_agree with "[$my $public]") as "#sub".
+  iMod ("a'" with "sub") as "H".
   iApply "H"; iFrame.
-  { iIntros ">Q !>"; iDestruct "Q" as (?) "[$ $]". }
 Qed.
 
 (* These are useful when the shared resource matches the lock invariant exactly. *)
-Lemma sync_commit1 : forall Eo Ei (b : G -> unit -> mpred) Q g (x0 x' : G)
-  (Hb : public_half g x' |-- (|==> b x0 tt)%I),
-  (atomic_shift (fun x => public_half g x) Eo Ei b (fun _ => Q) * my_half g Tsh x0 |-- |={Eo}=> Q * my_half g Tsh x')%I.
+Lemma sync_commit1 : forall Eo Ei (b : A -n> unit -d> mpred) Q g (x0 x' : A) (Hx' : ✓ x')
+  (Hb : public_half g x' ⊢ (|==> b x0 tt)%I),
+  (atomic_shift (fun x => public_half g x) Eo Ei b (fun _ => Q) ∗ my_half g 1 x0 ⊢ |={Eo}=> Q ∗ my_half g 1 x')%I.
 Proof.
-  intros; eapply derives_trans, sync_commit_simple.
-  apply sepcon_derives, derives_refl.
-  apply atomic_shift_derives_simple; intros; try solve [by iIntros].
+  intros; rewrite -sync_commit_simple //.
+  iIntros "(A & $)".
+  iApply (atomic_shift_derives_simple with "A"); try solve [by iIntros].
   destruct y.
-  iIntros "[% H]"; subst; iMod (Hb with "H"); auto.
+  iIntros "[Heq H]".
+  iMod (Hb with "H") as "Hb".
+  iIntros "!>"; iStopProof.
+  rewrite -bi.persistent_and_affinely_sep_l internal_eq_sym; rewrite -> (internal_eq_rewrite _ _ (fun a => b a ())).
+  apply bi.impl_elim_l.
+  { intros ? x1 x2 Hdist. assert (b x1 ≡{n}≡ b x2) by rewrite Hdist //; auto. }
 Qed.
 
-Lemma sync_commit2 : forall Eo Ei (b : G -> G -> mpred) Q g (x0 x' : G)
-  (Hb : public_half g x' |-- (|==> b x0 x0)%I),
-  (atomic_shift (fun x => public_half g x) Eo Ei b Q * my_half g Tsh x0 |-- |={Eo}=> Q x0 * my_half g Tsh x')%I.
+Lemma sync_commit2 : forall Eo Ei (b : A -n> A -d> mpred) Q g (x0 x' : A) (Hx' : ✓ x')
+  (Hb : public_half g x' ⊢ (|==> b x0 x0)%I),
+  (atomic_shift (fun x => public_half g x) Eo Ei b Q ∗ my_half g 1 x0 ⊢ |={Eo}=> Q x0 ∗ my_half g 1 x')%I.
 Proof.
-  intros; eapply derives_trans, sync_commit_simple.
-  apply sepcon_derives, derives_refl.
-  apply atomic_shift_derives; intros.
+  intros; rewrite -sync_commit_simple //.
+  iIntros "(A & $)".
+  iApply (atomic_shift_derives with "A"); intros.
   iIntros "a".
   iExists x; iFrame.
   iIntros "!>"; iSplit.
   - iIntros "g"; auto.
-  - iIntros (_) "[% g]"; subst.
+  - iIntros (_) "[Heq g]".
     iMod (Hb with "[$g]") as "b".
     iExists x0; iFrame.
-    iIntros "!> ?"; auto.
+    iIntros "!>"; iSplitR ""; last by auto.
+    iStopProof.
+    rewrite -bi.persistent_and_affinely_sep_l internal_eq_sym; rewrite -> (internal_eq_rewrite _ _ (fun a => b a x0)).
+    apply bi.impl_elim_l.
+    { intros ? x1 x2 Hdist. assert (b x1 ≡{n}≡ b x2) by rewrite Hdist //; auto. }
 Qed.
 
 (* sync_commit for holding two locks simultaneously *)
-Lemma two_sync_commit : forall {A B} a Eo Ei (b : A -> B -> mpred) Q R R' g1 g2 sh1 sh2 (x1 x2 : G)
-  (Ha : forall x, R * a x |-- (|==> EX y1 y2, public_half g1 y1 * public_half g2 y2 *
-    (!!((if eq_dec sh1 Tsh then x1 = y1 else exists z, sepalg.join x1 z y1) /\ (if eq_dec sh2 Tsh then x2 = y2 else exists z, sepalg.join x2 z y2)) -->
-    |==> (EX x1' x2' y1' y2' : G, !!((forall z, sepalg.join x1 z y1 -> sepalg.join x1' z y1' /\ (x1 = y1 -> x1' = y1')) /\ (forall z, sepalg.join x2 z y2 -> sepalg.join x2' z y2' /\ (x2 = y2 -> x2' = y2'))) &&
-      (my_half g1 sh1 x1' * public_half g1 y1' * my_half g2 sh2 x2' * public_half g2 y2' -* |==> (EX y, b x y * R' y))))%I)%I),
-  (atomic_shift a Eo Ei b Q * my_half g1 sh1 x1 * my_half g2 sh2 x2 * R |-- |={Eo}=> EX y, Q y * R' y)%I.
+Lemma two_sync_commit : forall {B} a Eo Ei (b : A -> B -> mpred) Q R R' g1 g2 sh1 sh2 (x1 x2 : A)
+  (Ha : forall x, R ∗ a x ⊢ (|==> ∃ y1 y2, public_half g1 y1 ∗ public_half g2 y2 ∗
+    ((if decide (sh1 = 1%Qp) then x1 ≡ y1 else ∃ x, y1 ≡ x1 ⋅ x) -∗ (if decide (sh2 = 1%Qp) then x2 ≡ y2 else ∃ x, y2 ≡ x2 ⋅ x) -∗
+    |==> (∃ x1' x2' y1' y2' : A, ⌜local_update(A := A) (y1, x1) (y1', x1') /\ local_update(A := A) (y2, x2) (y2', x2')⌝ ∧
+      (my_half g1 sh1 x1' ∗ public_half g1 y1' ∗ my_half g2 sh2 x2' ∗ public_half g2 y2' -∗ |==> (∃ y, b x y ∗ R' y))))%I)%I),
+  (atomic_shift a Eo Ei b Q ∗ my_half g1 sh1 x1 ∗ my_half g2 sh2 x2 ∗ R ⊢ |={Eo}=> ∃ y, Q y ∗ R' y)%I.
 Proof.
-  intros; rewrite -> 2sepcon_assoc.
+  intros.
   apply @atomic_commit_fupd with (R' := fun y => R' y).
   intros; iIntros "((my1 & my2 & R) & a)".
-  iMod (Ha with "[$]") as (??) "((public1 & public2) &  a')".
-  iPoseProof (ref_sub(P := P) with "[$my1 $public1]") as "%".
-  iPoseProof (ref_sub(P := P) with "[$my2 $public2]") as "%".
-  iMod ("a'" with "[%]") as (????) "[Hsub H]"; first done.
-  iDestruct "Hsub" as %[? ?].
-  iDestruct (public_part_update with "[$my1 $public1]") as "[% >[my1 public1]]"; eauto.
-  iDestruct (public_part_update with "[$my2 $public2]") as "[% >[my2 public2]]"; eauto.
+  iMod (Ha with "[$]") as (??) "(public1 & public2 & a')".
+  iDestruct (public_part_agree with "[$my1 $public1]") as "#sub1".
+  iDestruct (public_part_agree with "[$my2 $public2]") as "#sub2".
+  iMod ("a'" with "sub1 sub2") as (????) "[(% & %) H]".
+  iDestruct (public_part_update with "[$my1 $public1]") as "[? >[my1 public1]]"; eauto.
+  iDestruct (public_part_update with "[$my2 $public2]") as "[? >[my2 public2]]"; eauto.
   iApply "H"; iFrame.
 Qed.
 
-Lemma two_sync_commit1 : forall {A B} a Eo Ei (b : A -> B -> mpred) Q R R' g1 g2 sh1 sh2 (x1 x2 : G)
-  (Ha : forall x, R * a x |-- (|==> EX y1 y2, public_half g1 y1 * public_half g2 y2 *
-    (!!((if eq_dec sh1 Tsh then x1 = y1 else exists z, sepalg.join x1 z y1) /\ (if eq_dec sh2 Tsh then x2 = y2 else exists z, sepalg.join x2 z y2)) -->
-    |==> (EX x1' x2' y1' y2' : G, !!((forall z, sepalg.join x1 z y1 -> sepalg.join x1' z y1' /\ (x1 = y1 -> x1' = y1')) /\ (forall z, sepalg.join x2 z y2 -> sepalg.join x2' z y2' /\ (x2 = y2 -> x2' = y2'))) &&
-      (my_half g1 sh1 x1' * public_half g1 y1' * my_half g2 sh2 x2' * public_half g2 y2' -* |==> ((EX y, b x y) * R'))))%I)%I),
-  (atomic_shift a Eo Ei b (fun _ => Q) * my_half g1 sh1 x1 * my_half g2 sh2 x2 * R |-- |={Eo}=> Q * R')%I.
+Lemma two_sync_commit1 : forall {B} a Eo Ei (b : A -> B -> mpred) Q R R' g1 g2 sh1 sh2 (x1 x2 : A)
+  (Ha : forall x, R ∗ a x ⊢ (|==> ∃ y1 y2, public_half g1 y1 ∗ public_half g2 y2 ∗
+    ((if decide (sh1 = 1%Qp) then x1 ≡ y1 else ∃ x, y1 ≡ x1 ⋅ x) -∗ (if decide (sh2 = 1%Qp) then x2 ≡ y2 else ∃ x, y2 ≡ x2 ⋅ x) -∗
+    |==> (∃ x1' x2' y1' y2' : A, ⌜local_update(A := A) (y1, x1) (y1', x1') /\ local_update(A := A) (y2, x2) (y2', x2')⌝ ∧
+      (my_half g1 sh1 x1' ∗ public_half g1 y1' ∗ my_half g2 sh2 x2' ∗ public_half g2 y2' -∗ |==> ((∃ y, b x y) ∗ R'))))%I)),
+  (atomic_shift a Eo Ei b (fun _ => Q) ∗ my_half g1 sh1 x1 ∗ my_half g2 sh2 x2 ∗ R ⊢ |={Eo}=> Q ∗ R')%I.
 Proof.
-  intros; rewrite -> 2sepcon_assoc.
-  eapply derives_trans; [apply @atomic_commit_fupd with (R' := fun _ => R')|].
+  intros.
+  rewrite (atomic_commit_fupd _ _ _ _ _ _ (fun _ => R')).
+  { iIntros ">Q !>"; iDestruct "Q" as (?) "[$ $]". }
   intros; iIntros "((my1 & my2 & R) & a)".
-  iMod (Ha with "[$]") as (??) "((public1 & public2) &  a')".
-  iPoseProof (ref_sub(P := P) with "[$my1 $public1]") as "%".
-  iPoseProof (ref_sub(P := P) with "[$my2 $public2]") as "%".
-  iMod ("a'" with "[%]") as (????) "[Hsub H]"; first done.
-  iDestruct "Hsub" as %[? ?].
-  iDestruct (public_part_update with "[$my1 $public1]") as "[% >[my1 public1]]"; eauto.
-  iDestruct (public_part_update with "[$my2 $public2]") as "[% >[my2 public2]]"; eauto.
-  rewrite -exp_sepcon1.
+  iMod (Ha with "[$]") as (??) "(public1 & public2 & a')".
+  iDestruct (public_part_agree with "[$my1 $public1]") as "#sub1".
+  iDestruct (public_part_agree with "[$my2 $public2]") as "#sub2".
+  iMod ("a'" with "sub1 sub2") as (????) "[(% & %) H]".
+  iDestruct (public_part_update with "[$my1 $public1]") as "[? >[my1 public1]]"; eauto.
+  iDestruct (public_part_update with "[$my2 $public2]") as "[? >[my2 public2]]"; eauto.
+  rewrite -bi.sep_exist_r.
   iApply "H"; iFrame.
-  { iIntros ">Q !>"; iDestruct "Q" as (?) "[$ $]". }
 Qed.
 
 End locks.
-
-#[export] Hint Resolve sync_inv_exclusive : core.
diff --git a/atomics/hashtable.v b/atomics/hashtable.v
index 0f6e34f81d..31d26783f1 100644
--- a/atomics/hashtable.v
+++ b/atomics/hashtable.v
@@ -1,7 +1,7 @@
 Require Import VST.concurrency.conclib.
 Require Import VST.zlist.sublist.
 
-Set Bullet Behavior "Strict Subproofs".
+Local Unset SsrRewrite.
 
 Opaque eq_dec.
 
@@ -436,11 +436,14 @@ Qed.
 
 End Hashtable.
 
-Lemma sepcon_rebase : forall {B} f (l : list B) m, 0 <= m <= Zlength l ->
-  iter_sepcon f l = iter_sepcon f (rebase l m).
+Set SsrRewrite.
+
+Lemma sepcon_rebase : forall {Σ} {B} (f : B -> iProp Σ) (l : list B) m, 0 <= m <= Zlength l ->
+  ([∗ list] x ∈ l, f x) ⊣⊢ [∗ list] x ∈ (rebase l m), f x.
 Proof.
   intros; unfold rebase, rotate.
-  rewrite iter_sepcon_app, subsub1, sepcon_comm, <- iter_sepcon_app, sublist_rejoin, sublist_same by lia; auto.
+  rewrite big_sepL_app subsub1 bi.sep_comm -big_sepL_app sublist_rejoin; [|lia..].
+  rewrite sublist_same //.
 Qed.
 
 Lemma rebase_map : forall {A B} (f : A -> B) l m, rebase (map f l) m = map f (rebase l m).
diff --git a/atomics/hashtable_atomic.v b/atomics/hashtable_atomic.v
index 793a0f525e..2d1f25c23c 100644
--- a/atomics/hashtable_atomic.v
+++ b/atomics/hashtable_atomic.v
@@ -6,7 +6,7 @@ Local Open Scope string_scope.
 Local Open Scope clight_scope.
 
 Module Info.
-  Definition version := "3.10".
+  Definition version := "3.15".
   Definition build_number := "".
   Definition build_tag := "".
   Definition build_branch := "".
@@ -16,9 +16,10 @@ Module Info.
   Definition bitsize := 64.
   Definition big_endian := false.
   Definition source_file := "atomics/hashtable_atomic.c".
-  Definition normalized := true.
+  Definition normalized := false.
 End Info.
 
+Definition ___builtin_ais_annot : ident := $"__builtin_ais_annot".
 Definition ___builtin_annot : ident := $"__builtin_annot".
 Definition ___builtin_annot_intval : ident := $"__builtin_annot_intval".
 Definition ___builtin_bswap : ident := $"__builtin_bswap".
@@ -74,24 +75,17 @@ Definition ___compcert_va_composite : ident := $"__compcert_va_composite".
 Definition ___compcert_va_float64 : ident := $"__compcert_va_float64".
 Definition ___compcert_va_int32 : ident := $"__compcert_va_int32".
 Definition ___compcert_va_int64 : ident := $"__compcert_va_int64".
-Definition ___dummy : ident := $"__dummy".
-Definition ___pthread_t : ident := $"__pthread_t".
 Definition _acquire : ident := $"acquire".
 Definition _add_item : ident := $"add_item".
 Definition _arg : ident := $"arg".
-Definition _args : ident := $"args".
 Definition _atom_CAS : ident := $"atom_CAS".
 Definition _atom_int : ident := $"atom_int".
 Definition _atom_load : ident := $"atom_load".
 Definition _atom_store : ident := $"atom_store".
-Definition _b : ident := $"b".
 Definition _entry : ident := $"entry".
 Definition _exit : ident := $"exit".
-Definition _exit_thread : ident := $"exit_thread".
-Definition _expected : ident := $"expected".
 Definition _f : ident := $"f".
 Definition _free : ident := $"free".
-Definition _free_atomic : ident := $"free_atomic".
 Definition _freelock : ident := $"freelock".
 Definition _get_item : ident := $"get_item".
 Definition _i : ident := $"i".
@@ -104,7 +98,6 @@ Definition _integer_hash : ident := $"integer_hash".
 Definition _key : ident := $"key".
 Definition _l : ident := $"l".
 Definition _l__1 : ident := $"l__1".
-Definition _lock : ident := $"lock".
 Definition _m_entries : ident := $"m_entries".
 Definition _main : ident := $"main".
 Definition _make_atomic : ident := $"make_atomic".
@@ -123,8 +116,6 @@ Definition _set_item : ident := $"set_item".
 Definition _spawn : ident := $"spawn".
 Definition _surely_malloc : ident := $"surely_malloc".
 Definition _t : ident := $"t".
-Definition _thrd_create : ident := $"thrd_create".
-Definition _thrd_exit : ident := $"thrd_exit".
 Definition _thread_locks : ident := $"thread_locks".
 Definition _total : ident := $"total".
 Definition _value : ident := $"value".
@@ -132,7 +123,6 @@ Definition _t'1 : ident := 128%positive.
 Definition _t'2 : ident := 129%positive.
 Definition _t'3 : ident := 130%positive.
 Definition _t'4 : ident := 131%positive.
-Definition _t'5 : ident := 132%positive.
 
 Definition v_m_entries := {|
   gvar_info := (tarray (Tstruct _entry noattr) 16384);
@@ -142,7 +132,7 @@ Definition v_m_entries := {|
 |}.
 
 Definition v_thread_locks := {|
-  gvar_info := (tarray (tptr (Tstruct _atom_int noattr)) 3);
+  gvar_info := (tarray (tptr (tptr (Tstruct _atom_int noattr))) 3);
   gvar_init := (Init_space 24 :: nil);
   gvar_readonly := false;
   gvar_volatile := false
@@ -165,12 +155,12 @@ Definition f_surely_malloc := {|
 (Ssequence
   (Ssequence
     (Scall (Some _t'1)
-      (Evar _malloc (Tfunction (Tcons tulong Tnil) (tptr tvoid) cc_default))
+      (Evar _malloc (Tfunction (tulong :: nil) (tptr tvoid) cc_default))
       ((Etempvar _n tulong) :: nil))
     (Sset _p (Etempvar _t'1 (tptr tvoid))))
   (Ssequence
     (Sifthenelse (Eunop Onotbool (Etempvar _p (tptr tvoid)) tint)
-      (Scall None (Evar _exit (Tfunction (Tcons tint Tnil) tvoid cc_default))
+      (Scall None (Evar _exit (Tfunction (tint :: nil) tvoid cc_default))
         ((Econst_int (Int.repr 1) tint) :: nil))
       Sskip)
     (Sreturn (Some (Etempvar _p (tptr tvoid))))))
@@ -194,12 +184,12 @@ Definition f_set_item := {|
   fn_vars := ((_ref, tint) :: nil);
   fn_temps := ((_idx, tint) :: (_i, (tptr (Tstruct _atom_int noattr))) ::
                (_probed_key, tint) :: (_result, tint) :: (_t'3, tint) ::
-               (_t'2, tint) :: (_t'1, tint) :: (_t'4, tint) :: nil);
+               (_t'2, tint) :: (_t'1, tint) :: nil);
   fn_body :=
 (Ssequence
   (Ssequence
     (Scall (Some _t'1)
-      (Evar _integer_hash (Tfunction (Tcons tint Tnil) tint cc_default))
+      (Evar _integer_hash (Tfunction (tint :: nil) tint cc_default))
       ((Etempvar _key tint) :: nil))
     (Sset _idx (Etempvar _t'1 tint)))
   (Sloop
@@ -225,8 +215,8 @@ Definition f_set_item := {|
               (Ssequence
                 (Scall (Some _t'2)
                   (Evar _atom_load (Tfunction
-                                     (Tcons (tptr (Tstruct _atom_int noattr))
-                                       Tnil) tint cc_default))
+                                     ((tptr (Tstruct _atom_int noattr)) ::
+                                      nil) tint cc_default))
                   ((Etempvar _i (tptr (Tstruct _atom_int noattr))) :: nil))
                 (Sset _probed_key (Etempvar _t'2 tint)))
               (Ssequence
@@ -241,10 +231,8 @@ Definition f_set_item := {|
                       (Ssequence
                         (Scall (Some _t'3)
                           (Evar _atom_CAS (Tfunction
-                                            (Tcons
-                                              (tptr (Tstruct _atom_int noattr))
-                                              (Tcons (tptr tint)
-                                                (Tcons tint Tnil))) tint
+                                            ((tptr (Tstruct _atom_int noattr)) ::
+                                             (tptr tint) :: tint :: nil) tint
                                             cc_default))
                           ((Etempvar _i (tptr (Tstruct _atom_int noattr))) ::
                            (Eaddrof (Evar _ref tint) (tptr tint)) ::
@@ -252,12 +240,10 @@ Definition f_set_item := {|
                         (Sset _result (Etempvar _t'3 tint)))
                       (Sifthenelse (Eunop Onotbool (Etempvar _result tint)
                                      tint)
-                        (Ssequence
-                          (Sset _t'4 (Evar _ref tint))
-                          (Sifthenelse (Ebinop One (Etempvar _t'4 tint)
-                                         (Etempvar _key tint) tint)
-                            Scontinue
-                            Sskip))
+                        (Sifthenelse (Ebinop One (Evar _ref tint)
+                                       (Etempvar _key tint) tint)
+                          Scontinue
+                          Sskip)
                         Sskip)))
                   Sskip)
                 (Ssequence
@@ -273,10 +259,8 @@ Definition f_set_item := {|
                   (Ssequence
                     (Scall None
                       (Evar _atom_store (Tfunction
-                                          (Tcons
-                                            (tptr (Tstruct _atom_int noattr))
-                                            (Tcons tint Tnil)) tvoid
-                                          cc_default))
+                                          ((tptr (Tstruct _atom_int noattr)) ::
+                                           tint :: nil) tvoid cc_default))
                       ((Etempvar _i (tptr (Tstruct _atom_int noattr))) ::
                        (Etempvar _value tint) :: nil))
                     (Sreturn None)))))))))
@@ -296,7 +280,7 @@ Definition f_get_item := {|
 (Ssequence
   (Ssequence
     (Scall (Some _t'1)
-      (Evar _integer_hash (Tfunction (Tcons tint Tnil) tint cc_default))
+      (Evar _integer_hash (Tfunction (tint :: nil) tint cc_default))
       ((Etempvar _key tint) :: nil))
     (Sset _idx (Etempvar _t'1 tint)))
   (Sloop
@@ -320,8 +304,8 @@ Definition f_get_item := {|
             (Ssequence
               (Scall (Some _t'2)
                 (Evar _atom_load (Tfunction
-                                   (Tcons (tptr (Tstruct _atom_int noattr))
-                                     Tnil) tint cc_default))
+                                   ((tptr (Tstruct _atom_int noattr)) :: nil)
+                                   tint cc_default))
                 ((Etempvar _i (tptr (Tstruct _atom_int noattr))) :: nil))
               (Sset _probed_key (Etempvar _t'2 tint)))
             (Ssequence
@@ -340,9 +324,8 @@ Definition f_get_item := {|
                   (Ssequence
                     (Scall (Some _t'3)
                       (Evar _atom_load (Tfunction
-                                         (Tcons
-                                           (tptr (Tstruct _atom_int noattr))
-                                           Tnil) tint cc_default))
+                                         ((tptr (Tstruct _atom_int noattr)) ::
+                                          nil) tint cc_default))
                       ((Etempvar _i (tptr (Tstruct _atom_int noattr))) ::
                        nil))
                     (Sreturn (Some (Etempvar _t'3 tint)))))
@@ -362,13 +345,12 @@ Definition f_add_item := {|
   fn_vars := ((_ref, tint) :: nil);
   fn_temps := ((_idx, tint) :: (_i, (tptr (Tstruct _atom_int noattr))) ::
                (_probed_key, tint) :: (_result, tint) :: (_t'4, tint) ::
-               (_t'3, tint) :: (_t'2, tint) :: (_t'1, tint) ::
-               (_t'5, tint) :: nil);
+               (_t'3, tint) :: (_t'2, tint) :: (_t'1, tint) :: nil);
   fn_body :=
 (Ssequence
   (Ssequence
     (Scall (Some _t'1)
-      (Evar _integer_hash (Tfunction (Tcons tint Tnil) tint cc_default))
+      (Evar _integer_hash (Tfunction (tint :: nil) tint cc_default))
       ((Etempvar _key tint) :: nil))
     (Sset _idx (Etempvar _t'1 tint)))
   (Sloop
@@ -394,8 +376,8 @@ Definition f_add_item := {|
               (Ssequence
                 (Scall (Some _t'2)
                   (Evar _atom_load (Tfunction
-                                     (Tcons (tptr (Tstruct _atom_int noattr))
-                                       Tnil) tint cc_default))
+                                     ((tptr (Tstruct _atom_int noattr)) ::
+                                      nil) tint cc_default))
                   ((Etempvar _i (tptr (Tstruct _atom_int noattr))) :: nil))
                 (Sset _probed_key (Etempvar _t'2 tint)))
               (Ssequence
@@ -410,10 +392,8 @@ Definition f_add_item := {|
                       (Ssequence
                         (Scall (Some _t'3)
                           (Evar _atom_CAS (Tfunction
-                                            (Tcons
-                                              (tptr (Tstruct _atom_int noattr))
-                                              (Tcons (tptr tint)
-                                                (Tcons tint Tnil))) tint
+                                            ((tptr (Tstruct _atom_int noattr)) ::
+                                             (tptr tint) :: tint :: nil) tint
                                             cc_default))
                           ((Etempvar _i (tptr (Tstruct _atom_int noattr))) ::
                            (Eaddrof (Evar _ref tint) (tptr tint)) ::
@@ -421,12 +401,10 @@ Definition f_add_item := {|
                         (Sset _result (Etempvar _t'3 tint)))
                       (Sifthenelse (Eunop Onotbool (Etempvar _result tint)
                                      tint)
-                        (Ssequence
-                          (Sset _t'5 (Evar _ref tint))
-                          (Sifthenelse (Ebinop One (Etempvar _t'5 tint)
-                                         (Etempvar _key tint) tint)
-                            Scontinue
-                            Sskip))
+                        (Sifthenelse (Ebinop One (Evar _ref tint)
+                                       (Etempvar _key tint) tint)
+                          Scontinue
+                          Sskip)
                         Sskip)))
                   Sskip)
                 (Ssequence
@@ -444,10 +422,8 @@ Definition f_add_item := {|
                     (Ssequence
                       (Scall (Some _t'4)
                         (Evar _atom_CAS (Tfunction
-                                          (Tcons
-                                            (tptr (Tstruct _atom_int noattr))
-                                            (Tcons (tptr tint)
-                                              (Tcons tint Tnil))) tint
+                                          ((tptr (Tstruct _atom_int noattr)) ::
+                                           (tptr tint) :: tint :: nil) tint
                                           cc_default))
                         ((Etempvar _i (tptr (Tstruct _atom_int noattr))) ::
                          (Eaddrof (Evar _ref tint) (tptr tint)) ::
@@ -476,7 +452,7 @@ Definition f_init_table := {|
       (Ssequence
         (Ssequence
           (Scall (Some _t'1)
-            (Evar _make_atomic (Tfunction (Tcons tint Tnil)
+            (Evar _make_atomic (Tfunction (tint :: nil)
                                  (tptr (Tstruct _atom_int noattr))
                                  cc_default))
             ((Econst_int (Int.repr 0) tint) :: nil))
@@ -491,7 +467,7 @@ Definition f_init_table := {|
             (Etempvar _t'1 (tptr (Tstruct _atom_int noattr)))))
         (Ssequence
           (Scall (Some _t'2)
-            (Evar _make_atomic (Tfunction (Tcons tint Tnil)
+            (Evar _make_atomic (Tfunction (tint :: nil)
                                  (tptr (Tstruct _atom_int noattr))
                                  cc_default))
             ((Econst_int (Int.repr 0) tint) :: nil))
@@ -513,7 +489,8 @@ Definition f_f := {|
   fn_callconv := cc_default;
   fn_params := ((_arg, (tptr tvoid)) :: nil);
   fn_vars := nil;
-  fn_temps := ((_t, tint) :: (_l, (tptr (Tstruct _atom_int noattr))) ::
+  fn_temps := ((_t, tint) ::
+               (_l, (tptr (tptr (Tstruct _atom_int noattr)))) ::
                (_res, (tptr tint)) :: (_total, tint) :: (_i, tint) ::
                (_r, tint) :: (_t'1, tint) :: nil);
   fn_body :=
@@ -523,9 +500,9 @@ Definition f_f := {|
     (Sset _l
       (Ederef
         (Ebinop Oadd
-          (Evar _thread_locks (tarray (tptr (Tstruct _atom_int noattr)) 3))
-          (Etempvar _t tint) (tptr (tptr (Tstruct _atom_int noattr))))
-        (tptr (Tstruct _atom_int noattr))))
+          (Evar _thread_locks (tarray (tptr (tptr (Tstruct _atom_int noattr))) 3))
+          (Etempvar _t tint) (tptr (tptr (tptr (Tstruct _atom_int noattr)))))
+        (tptr (tptr (Tstruct _atom_int noattr)))))
     (Ssequence
       (Sset _res
         (Ederef
@@ -535,8 +512,8 @@ Definition f_f := {|
         (Sset _total (Econst_int (Int.repr 0) tint))
         (Ssequence
           (Scall None
-            (Evar _free (Tfunction (Tcons (tptr tvoid) Tnil) tvoid
-                          cc_default)) ((Etempvar _arg (tptr tvoid)) :: nil))
+            (Evar _free (Tfunction ((tptr tvoid) :: nil) tvoid cc_default))
+            ((Etempvar _arg (tptr tvoid)) :: nil))
           (Ssequence
             (Ssequence
               (Sset _i (Econst_int (Int.repr 0) tint))
@@ -549,8 +526,7 @@ Definition f_f := {|
                   (Ssequence
                     (Ssequence
                       (Scall (Some _t'1)
-                        (Evar _add_item (Tfunction
-                                          (Tcons tint (Tcons tint Tnil)) tint
+                        (Evar _add_item (Tfunction (tint :: tint :: nil) tint
                                           cc_default))
                         ((Ebinop Oadd (Etempvar _i tint)
                            (Econst_int (Int.repr 1) tint) tint) ::
@@ -570,9 +546,10 @@ Definition f_f := {|
               (Ssequence
                 (Scall None
                   (Evar _release (Tfunction
-                                   (Tcons (tptr (Tstruct _atom_int noattr))
-                                     Tnil) tvoid cc_default))
-                  ((Etempvar _l (tptr (Tstruct _atom_int noattr))) :: nil))
+                                   ((tptr (Tstruct _atom_int noattr)) :: nil)
+                                   tvoid cc_default))
+                  ((Etempvar _l (tptr (tptr (Tstruct _atom_int noattr)))) ::
+                   nil))
                 (Sreturn (Some (Econst_int (Int.repr 0) tint)))))))))))
 |}.
 
@@ -582,9 +559,9 @@ Definition f_main := {|
   fn_params := nil;
   fn_vars := nil;
   fn_temps := ((_total, tint) :: (_i, tint) ::
-               (_l, (tptr (Tstruct _atom_int noattr))) :: (_i__1, tint) ::
-               (_t, (tptr tint)) :: (_i__2, tint) ::
-               (_l__1, (tptr (Tstruct _atom_int noattr))) ::
+               (_l, (tptr (tptr (Tstruct _atom_int noattr)))) ::
+               (_i__1, tint) :: (_t, (tptr tint)) :: (_i__2, tint) ::
+               (_l__1, (tptr (tptr (Tstruct _atom_int noattr)))) ::
                (_r, (tptr tint)) :: (_i__3, tint) :: (_t'3, (tptr tvoid)) ::
                (_t'2, (tptr (Tstruct _atom_int noattr))) ::
                (_t'1, (tptr tvoid)) :: nil);
@@ -593,7 +570,7 @@ Definition f_main := {|
   (Ssequence
     (Sset _total (Econst_int (Int.repr 0) tint))
     (Ssequence
-      (Scall None (Evar _init_table (Tfunction Tnil tvoid cc_default)) nil)
+      (Scall None (Evar _init_table (Tfunction nil tvoid cc_default)) nil)
       (Ssequence
         (Ssequence
           (Sset _i (Econst_int (Int.repr 0) tint))
@@ -606,7 +583,7 @@ Definition f_main := {|
               (Ssequence
                 (Ssequence
                   (Scall (Some _t'1)
-                    (Evar _surely_malloc (Tfunction (Tcons tulong Tnil)
+                    (Evar _surely_malloc (Tfunction (tulong :: nil)
                                            (tptr tvoid) cc_default))
                     ((Esizeof tint tulong) :: nil))
                   (Sassign
@@ -617,7 +594,7 @@ Definition f_main := {|
                 (Ssequence
                   (Ssequence
                     (Scall (Some _t'2)
-                      (Evar _makelock (Tfunction Tnil
+                      (Evar _makelock (Tfunction nil
                                         (tptr (Tstruct _atom_int noattr))
                                         cc_default)) nil)
                     (Sset _l
@@ -625,11 +602,11 @@ Definition f_main := {|
                   (Sassign
                     (Ederef
                       (Ebinop Oadd
-                        (Evar _thread_locks (tarray (tptr (Tstruct _atom_int noattr)) 3))
+                        (Evar _thread_locks (tarray (tptr (tptr (Tstruct _atom_int noattr))) 3))
                         (Etempvar _i tint)
-                        (tptr (tptr (Tstruct _atom_int noattr))))
-                      (tptr (Tstruct _atom_int noattr)))
-                    (Etempvar _l (tptr (Tstruct _atom_int noattr)))))))
+                        (tptr (tptr (tptr (Tstruct _atom_int noattr)))))
+                      (tptr (tptr (Tstruct _atom_int noattr))))
+                    (Etempvar _l (tptr (tptr (Tstruct _atom_int noattr))))))))
             (Sset _i
               (Ebinop Oadd (Etempvar _i tint) (Econst_int (Int.repr 1) tint)
                 tint))))
@@ -645,7 +622,7 @@ Definition f_main := {|
                 (Ssequence
                   (Ssequence
                     (Scall (Some _t'3)
-                      (Evar _surely_malloc (Tfunction (Tcons tulong Tnil)
+                      (Evar _surely_malloc (Tfunction (tulong :: nil)
                                              (tptr tvoid) cc_default))
                       ((Esizeof tint tulong) :: nil))
                     (Sset _t
@@ -655,17 +632,14 @@ Definition f_main := {|
                       (Etempvar _i__1 tint))
                     (Scall None
                       (Evar _spawn (Tfunction
-                                     (Tcons
-                                       (tptr (Tfunction
-                                               (Tcons (tptr tvoid) Tnil) tint
-                                               cc_default))
-                                       (Tcons (tptr tvoid) Tnil)) tvoid
-                                     cc_default))
+                                     ((tptr (Tfunction ((tptr tvoid) :: nil)
+                                              tint cc_default)) ::
+                                      (tptr tvoid) :: nil) tvoid cc_default))
                       ((Ecast
                          (Eaddrof
-                           (Evar _f (Tfunction (Tcons (tptr tvoid) Tnil) tint
+                           (Evar _f (Tfunction ((tptr tvoid) :: nil) tint
                                       cc_default))
-                           (tptr (Tfunction (Tcons (tptr tvoid) Tnil) tint
+                           (tptr (Tfunction ((tptr tvoid) :: nil) tint
                                    cc_default))) (tptr tvoid)) ::
                        (Ecast (Etempvar _t (tptr tint)) (tptr tvoid)) :: nil)))))
               (Sset _i__1
@@ -683,25 +657,23 @@ Definition f_main := {|
                   (Sset _l__1
                     (Ederef
                       (Ebinop Oadd
-                        (Evar _thread_locks (tarray (tptr (Tstruct _atom_int noattr)) 3))
+                        (Evar _thread_locks (tarray (tptr (tptr (Tstruct _atom_int noattr))) 3))
                         (Etempvar _i__2 tint)
-                        (tptr (tptr (Tstruct _atom_int noattr))))
-                      (tptr (Tstruct _atom_int noattr))))
+                        (tptr (tptr (tptr (Tstruct _atom_int noattr)))))
+                      (tptr (tptr (Tstruct _atom_int noattr)))))
                   (Ssequence
                     (Scall None
                       (Evar _acquire (Tfunction
-                                       (Tcons
-                                         (tptr (Tstruct _atom_int noattr))
-                                         Tnil) tvoid cc_default))
-                      ((Etempvar _l__1 (tptr (Tstruct _atom_int noattr))) ::
+                                       ((tptr (Tstruct _atom_int noattr)) ::
+                                        nil) tvoid cc_default))
+                      ((Etempvar _l__1 (tptr (tptr (Tstruct _atom_int noattr)))) ::
                        nil))
                     (Ssequence
                       (Scall None
                         (Evar _freelock (Tfunction
-                                          (Tcons
-                                            (tptr (Tstruct _atom_int noattr))
-                                            Tnil) tvoid cc_default))
-                        ((Etempvar _l__1 (tptr (Tstruct _atom_int noattr))) ::
+                                          ((tptr (Tstruct _atom_int noattr)) ::
+                                           nil) tvoid cc_default))
+                        ((Etempvar _l__1 (tptr (tptr (Tstruct _atom_int noattr)))) ::
                          nil))
                       (Ssequence
                         (Sset _r
@@ -715,9 +687,8 @@ Definition f_main := {|
                             (Ederef (Etempvar _r (tptr tint)) tint))
                           (Ssequence
                             (Scall None
-                              (Evar _free (Tfunction
-                                            (Tcons (tptr tvoid) Tnil) tvoid
-                                            cc_default))
+                              (Evar _free (Tfunction ((tptr tvoid) :: nil)
+                                            tvoid cc_default))
                               ((Etempvar _r (tptr tint)) :: nil))
                             (Sset _total
                               (Ebinop Oadd (Etempvar _total tint)
@@ -737,314 +708,307 @@ Definition composites : list composite_definition :=
 Definition global_definitions : list (ident * globdef fundef type) :=
 ((___compcert_va_int32,
    Gfun(External (EF_runtime "__compcert_va_int32"
-                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
-     (Tcons (tptr tvoid) Tnil) tuint cc_default)) ::
+                   (mksignature (AST.Xptr :: nil) AST.Xint cc_default))
+     ((tptr tvoid) :: nil) tuint cc_default)) ::
  (___compcert_va_int64,
    Gfun(External (EF_runtime "__compcert_va_int64"
-                   (mksignature (AST.Tlong :: nil) AST.Tlong cc_default))
-     (Tcons (tptr tvoid) Tnil) tulong cc_default)) ::
+                   (mksignature (AST.Xptr :: nil) AST.Xlong cc_default))
+     ((tptr tvoid) :: nil) tulong cc_default)) ::
  (___compcert_va_float64,
    Gfun(External (EF_runtime "__compcert_va_float64"
-                   (mksignature (AST.Tlong :: nil) AST.Tfloat cc_default))
-     (Tcons (tptr tvoid) Tnil) tdouble cc_default)) ::
+                   (mksignature (AST.Xptr :: nil) AST.Xfloat cc_default))
+     ((tptr tvoid) :: nil) tdouble cc_default)) ::
  (___compcert_va_composite,
    Gfun(External (EF_runtime "__compcert_va_composite"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
-                     cc_default)) (Tcons (tptr tvoid) (Tcons tulong Tnil))
+                   (mksignature (AST.Xptr :: AST.Xlong :: nil) AST.Xptr
+                     cc_default)) ((tptr tvoid) :: tulong :: nil)
      (tptr tvoid) cc_default)) ::
  (___compcert_i64_dtos,
    Gfun(External (EF_runtime "__compcert_i64_dtos"
-                   (mksignature (AST.Tfloat :: nil) AST.Tlong cc_default))
-     (Tcons tdouble Tnil) tlong cc_default)) ::
+                   (mksignature (AST.Xfloat :: nil) AST.Xlong cc_default))
+     (tdouble :: nil) tlong cc_default)) ::
  (___compcert_i64_dtou,
    Gfun(External (EF_runtime "__compcert_i64_dtou"
-                   (mksignature (AST.Tfloat :: nil) AST.Tlong cc_default))
-     (Tcons tdouble Tnil) tulong cc_default)) ::
+                   (mksignature (AST.Xfloat :: nil) AST.Xlong cc_default))
+     (tdouble :: nil) tulong cc_default)) ::
  (___compcert_i64_stod,
    Gfun(External (EF_runtime "__compcert_i64_stod"
-                   (mksignature (AST.Tlong :: nil) AST.Tfloat cc_default))
-     (Tcons tlong Tnil) tdouble cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xfloat cc_default))
+     (tlong :: nil) tdouble cc_default)) ::
  (___compcert_i64_utod,
    Gfun(External (EF_runtime "__compcert_i64_utod"
-                   (mksignature (AST.Tlong :: nil) AST.Tfloat cc_default))
-     (Tcons tulong Tnil) tdouble cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xfloat cc_default))
+     (tulong :: nil) tdouble cc_default)) ::
  (___compcert_i64_stof,
    Gfun(External (EF_runtime "__compcert_i64_stof"
-                   (mksignature (AST.Tlong :: nil) AST.Tsingle cc_default))
-     (Tcons tlong Tnil) tfloat cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xsingle cc_default))
+     (tlong :: nil) tfloat cc_default)) ::
  (___compcert_i64_utof,
    Gfun(External (EF_runtime "__compcert_i64_utof"
-                   (mksignature (AST.Tlong :: nil) AST.Tsingle cc_default))
-     (Tcons tulong Tnil) tfloat cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xsingle cc_default))
+     (tulong :: nil) tfloat cc_default)) ::
  (___compcert_i64_sdiv,
    Gfun(External (EF_runtime "__compcert_i64_sdiv"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
-                     cc_default)) (Tcons tlong (Tcons tlong Tnil)) tlong
-     cc_default)) ::
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tlong :: tlong :: nil) tlong cc_default)) ::
  (___compcert_i64_udiv,
    Gfun(External (EF_runtime "__compcert_i64_udiv"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
-                     cc_default)) (Tcons tulong (Tcons tulong Tnil)) tulong
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tulong :: tulong :: nil) tulong
      cc_default)) ::
  (___compcert_i64_smod,
    Gfun(External (EF_runtime "__compcert_i64_smod"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
-                     cc_default)) (Tcons tlong (Tcons tlong Tnil)) tlong
-     cc_default)) ::
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tlong :: tlong :: nil) tlong cc_default)) ::
  (___compcert_i64_umod,
    Gfun(External (EF_runtime "__compcert_i64_umod"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
-                     cc_default)) (Tcons tulong (Tcons tulong Tnil)) tulong
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tulong :: tulong :: nil) tulong
      cc_default)) ::
  (___compcert_i64_shl,
    Gfun(External (EF_runtime "__compcert_i64_shl"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tlong
-                     cc_default)) (Tcons tlong (Tcons tint Tnil)) tlong
-     cc_default)) ::
+                   (mksignature (AST.Xlong :: AST.Xint :: nil) AST.Xlong
+                     cc_default)) (tlong :: tint :: nil) tlong cc_default)) ::
  (___compcert_i64_shr,
    Gfun(External (EF_runtime "__compcert_i64_shr"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tlong
-                     cc_default)) (Tcons tulong (Tcons tint Tnil)) tulong
-     cc_default)) ::
+                   (mksignature (AST.Xlong :: AST.Xint :: nil) AST.Xlong
+                     cc_default)) (tulong :: tint :: nil) tulong cc_default)) ::
  (___compcert_i64_sar,
    Gfun(External (EF_runtime "__compcert_i64_sar"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tlong
-                     cc_default)) (Tcons tlong (Tcons tint Tnil)) tlong
-     cc_default)) ::
+                   (mksignature (AST.Xlong :: AST.Xint :: nil) AST.Xlong
+                     cc_default)) (tlong :: tint :: nil) tlong cc_default)) ::
  (___compcert_i64_smulh,
    Gfun(External (EF_runtime "__compcert_i64_smulh"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
-                     cc_default)) (Tcons tlong (Tcons tlong Tnil)) tlong
-     cc_default)) ::
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tlong :: tlong :: nil) tlong cc_default)) ::
  (___compcert_i64_umulh,
    Gfun(External (EF_runtime "__compcert_i64_umulh"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
-                     cc_default)) (Tcons tulong (Tcons tulong Tnil)) tulong
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tulong :: tulong :: nil) tulong
      cc_default)) ::
+ (___builtin_ais_annot,
+   Gfun(External (EF_builtin "__builtin_ais_annot"
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid
+                     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
+     ((tptr tschar) :: nil) tvoid
+     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
  (___builtin_bswap64,
    Gfun(External (EF_builtin "__builtin_bswap64"
-                   (mksignature (AST.Tlong :: nil) AST.Tlong cc_default))
-     (Tcons tulong Tnil) tulong cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xlong cc_default))
+     (tulong :: nil) tulong cc_default)) ::
  (___builtin_bswap,
    Gfun(External (EF_builtin "__builtin_bswap"
-                   (mksignature (AST.Tint :: nil) AST.Tint cc_default))
-     (Tcons tuint Tnil) tuint cc_default)) ::
+                   (mksignature (AST.Xint :: nil) AST.Xint cc_default))
+     (tuint :: nil) tuint cc_default)) ::
  (___builtin_bswap32,
    Gfun(External (EF_builtin "__builtin_bswap32"
-                   (mksignature (AST.Tint :: nil) AST.Tint cc_default))
-     (Tcons tuint Tnil) tuint cc_default)) ::
+                   (mksignature (AST.Xint :: nil) AST.Xint cc_default))
+     (tuint :: nil) tuint cc_default)) ::
  (___builtin_bswap16,
    Gfun(External (EF_builtin "__builtin_bswap16"
-                   (mksignature (AST.Tint :: nil) AST.Tint16unsigned
-                     cc_default)) (Tcons tushort Tnil) tushort cc_default)) ::
+                   (mksignature (AST.Xint16unsigned :: nil)
+                     AST.Xint16unsigned cc_default)) (tushort :: nil) tushort
+     cc_default)) ::
  (___builtin_clz,
    Gfun(External (EF_builtin "__builtin_clz"
-                   (mksignature (AST.Tint :: nil) AST.Tint cc_default))
-     (Tcons tuint Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xint :: nil) AST.Xint cc_default))
+     (tuint :: nil) tint cc_default)) ::
  (___builtin_clzl,
    Gfun(External (EF_builtin "__builtin_clzl"
-                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
-     (Tcons tulong Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xint cc_default))
+     (tulong :: nil) tint cc_default)) ::
  (___builtin_clzll,
    Gfun(External (EF_builtin "__builtin_clzll"
-                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
-     (Tcons tulong Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xint cc_default))
+     (tulong :: nil) tint cc_default)) ::
  (___builtin_ctz,
    Gfun(External (EF_builtin "__builtin_ctz"
-                   (mksignature (AST.Tint :: nil) AST.Tint cc_default))
-     (Tcons tuint Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xint :: nil) AST.Xint cc_default))
+     (tuint :: nil) tint cc_default)) ::
  (___builtin_ctzl,
    Gfun(External (EF_builtin "__builtin_ctzl"
-                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
-     (Tcons tulong Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xint cc_default))
+     (tulong :: nil) tint cc_default)) ::
  (___builtin_ctzll,
    Gfun(External (EF_builtin "__builtin_ctzll"
-                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
-     (Tcons tulong Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xint cc_default))
+     (tulong :: nil) tint cc_default)) ::
  (___builtin_fabs,
    Gfun(External (EF_builtin "__builtin_fabs"
-                   (mksignature (AST.Tfloat :: nil) AST.Tfloat cc_default))
-     (Tcons tdouble Tnil) tdouble cc_default)) ::
+                   (mksignature (AST.Xfloat :: nil) AST.Xfloat cc_default))
+     (tdouble :: nil) tdouble cc_default)) ::
  (___builtin_fabsf,
    Gfun(External (EF_builtin "__builtin_fabsf"
-                   (mksignature (AST.Tsingle :: nil) AST.Tsingle cc_default))
-     (Tcons tfloat Tnil) tfloat cc_default)) ::
+                   (mksignature (AST.Xsingle :: nil) AST.Xsingle cc_default))
+     (tfloat :: nil) tfloat cc_default)) ::
  (___builtin_fsqrt,
    Gfun(External (EF_builtin "__builtin_fsqrt"
-                   (mksignature (AST.Tfloat :: nil) AST.Tfloat cc_default))
-     (Tcons tdouble Tnil) tdouble cc_default)) ::
+                   (mksignature (AST.Xfloat :: nil) AST.Xfloat cc_default))
+     (tdouble :: nil) tdouble cc_default)) ::
  (___builtin_sqrt,
    Gfun(External (EF_builtin "__builtin_sqrt"
-                   (mksignature (AST.Tfloat :: nil) AST.Tfloat cc_default))
-     (Tcons tdouble Tnil) tdouble cc_default)) ::
+                   (mksignature (AST.Xfloat :: nil) AST.Xfloat cc_default))
+     (tdouble :: nil) tdouble cc_default)) ::
  (___builtin_memcpy_aligned,
    Gfun(External (EF_builtin "__builtin_memcpy_aligned"
                    (mksignature
-                     (AST.Tlong :: AST.Tlong :: AST.Tlong :: AST.Tlong ::
-                      nil) AST.Tvoid cc_default))
-     (Tcons (tptr tvoid)
-       (Tcons (tptr tvoid) (Tcons tulong (Tcons tulong Tnil)))) tvoid
+                     (AST.Xptr :: AST.Xptr :: AST.Xlong :: AST.Xlong :: nil)
+                     AST.Xvoid cc_default))
+     ((tptr tvoid) :: (tptr tvoid) :: tulong :: tulong :: nil) tvoid
      cc_default)) ::
  (___builtin_sel,
    Gfun(External (EF_builtin "__builtin_sel"
-                   (mksignature (AST.Tint :: nil) AST.Tvoid
+                   (mksignature (AST.Xbool :: nil) AST.Xvoid
                      {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
-     (Tcons tbool Tnil) tvoid
+     (tbool :: nil) tvoid
      {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
  (___builtin_annot,
    Gfun(External (EF_builtin "__builtin_annot"
-                   (mksignature (AST.Tlong :: nil) AST.Tvoid
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid
                      {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
-     (Tcons (tptr tschar) Tnil) tvoid
+     ((tptr tschar) :: nil) tvoid
      {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
  (___builtin_annot_intval,
    Gfun(External (EF_builtin "__builtin_annot_intval"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tint
-                     cc_default)) (Tcons (tptr tschar) (Tcons tint Tnil))
-     tint cc_default)) ::
+                   (mksignature (AST.Xptr :: AST.Xint :: nil) AST.Xint
+                     cc_default)) ((tptr tschar) :: tint :: nil) tint
+     cc_default)) ::
  (___builtin_membar,
    Gfun(External (EF_builtin "__builtin_membar"
-                   (mksignature nil AST.Tvoid cc_default)) Tnil tvoid
+                   (mksignature nil AST.Xvoid cc_default)) nil tvoid
      cc_default)) ::
  (___builtin_va_start,
    Gfun(External (EF_builtin "__builtin_va_start"
-                   (mksignature (AST.Tlong :: nil) AST.Tvoid cc_default))
-     (Tcons (tptr tvoid) Tnil) tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid cc_default))
+     ((tptr tvoid) :: nil) tvoid cc_default)) ::
  (___builtin_va_arg,
    Gfun(External (EF_builtin "__builtin_va_arg"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tvoid
-                     cc_default)) (Tcons (tptr tvoid) (Tcons tuint Tnil))
-     tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: AST.Xint :: nil) AST.Xvoid
+                     cc_default)) ((tptr tvoid) :: tuint :: nil) tvoid
+     cc_default)) ::
  (___builtin_va_copy,
    Gfun(External (EF_builtin "__builtin_va_copy"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tvoid
-                     cc_default))
-     (Tcons (tptr tvoid) (Tcons (tptr tvoid) Tnil)) tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: AST.Xptr :: nil) AST.Xvoid
+                     cc_default)) ((tptr tvoid) :: (tptr tvoid) :: nil) tvoid
+     cc_default)) ::
  (___builtin_va_end,
    Gfun(External (EF_builtin "__builtin_va_end"
-                   (mksignature (AST.Tlong :: nil) AST.Tvoid cc_default))
-     (Tcons (tptr tvoid) Tnil) tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid cc_default))
+     ((tptr tvoid) :: nil) tvoid cc_default)) ::
  (___builtin_unreachable,
    Gfun(External (EF_builtin "__builtin_unreachable"
-                   (mksignature nil AST.Tvoid cc_default)) Tnil tvoid
+                   (mksignature nil AST.Xvoid cc_default)) nil tvoid
      cc_default)) ::
  (___builtin_expect,
    Gfun(External (EF_builtin "__builtin_expect"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
-                     cc_default)) (Tcons tlong (Tcons tlong Tnil)) tlong
-     cc_default)) ::
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tlong :: tlong :: nil) tlong cc_default)) ::
  (___builtin_fmax,
    Gfun(External (EF_builtin "__builtin_fmax"
-                   (mksignature (AST.Tfloat :: AST.Tfloat :: nil) AST.Tfloat
-                     cc_default)) (Tcons tdouble (Tcons tdouble Tnil))
-     tdouble cc_default)) ::
+                   (mksignature (AST.Xfloat :: AST.Xfloat :: nil) AST.Xfloat
+                     cc_default)) (tdouble :: tdouble :: nil) tdouble
+     cc_default)) ::
  (___builtin_fmin,
    Gfun(External (EF_builtin "__builtin_fmin"
-                   (mksignature (AST.Tfloat :: AST.Tfloat :: nil) AST.Tfloat
-                     cc_default)) (Tcons tdouble (Tcons tdouble Tnil))
-     tdouble cc_default)) ::
+                   (mksignature (AST.Xfloat :: AST.Xfloat :: nil) AST.Xfloat
+                     cc_default)) (tdouble :: tdouble :: nil) tdouble
+     cc_default)) ::
  (___builtin_fmadd,
    Gfun(External (EF_builtin "__builtin_fmadd"
                    (mksignature
-                     (AST.Tfloat :: AST.Tfloat :: AST.Tfloat :: nil)
-                     AST.Tfloat cc_default))
-     (Tcons tdouble (Tcons tdouble (Tcons tdouble Tnil))) tdouble
-     cc_default)) ::
+                     (AST.Xfloat :: AST.Xfloat :: AST.Xfloat :: nil)
+                     AST.Xfloat cc_default))
+     (tdouble :: tdouble :: tdouble :: nil) tdouble cc_default)) ::
  (___builtin_fmsub,
    Gfun(External (EF_builtin "__builtin_fmsub"
                    (mksignature
-                     (AST.Tfloat :: AST.Tfloat :: AST.Tfloat :: nil)
-                     AST.Tfloat cc_default))
-     (Tcons tdouble (Tcons tdouble (Tcons tdouble Tnil))) tdouble
-     cc_default)) ::
+                     (AST.Xfloat :: AST.Xfloat :: AST.Xfloat :: nil)
+                     AST.Xfloat cc_default))
+     (tdouble :: tdouble :: tdouble :: nil) tdouble cc_default)) ::
  (___builtin_fnmadd,
    Gfun(External (EF_builtin "__builtin_fnmadd"
                    (mksignature
-                     (AST.Tfloat :: AST.Tfloat :: AST.Tfloat :: nil)
-                     AST.Tfloat cc_default))
-     (Tcons tdouble (Tcons tdouble (Tcons tdouble Tnil))) tdouble
-     cc_default)) ::
+                     (AST.Xfloat :: AST.Xfloat :: AST.Xfloat :: nil)
+                     AST.Xfloat cc_default))
+     (tdouble :: tdouble :: tdouble :: nil) tdouble cc_default)) ::
  (___builtin_fnmsub,
    Gfun(External (EF_builtin "__builtin_fnmsub"
                    (mksignature
-                     (AST.Tfloat :: AST.Tfloat :: AST.Tfloat :: nil)
-                     AST.Tfloat cc_default))
-     (Tcons tdouble (Tcons tdouble (Tcons tdouble Tnil))) tdouble
-     cc_default)) ::
+                     (AST.Xfloat :: AST.Xfloat :: AST.Xfloat :: nil)
+                     AST.Xfloat cc_default))
+     (tdouble :: tdouble :: tdouble :: nil) tdouble cc_default)) ::
  (___builtin_read16_reversed,
    Gfun(External (EF_builtin "__builtin_read16_reversed"
-                   (mksignature (AST.Tlong :: nil) AST.Tint16unsigned
-                     cc_default)) (Tcons (tptr tushort) Tnil) tushort
+                   (mksignature (AST.Xptr :: nil) AST.Xint16unsigned
+                     cc_default)) ((tptr tushort) :: nil) tushort
      cc_default)) ::
  (___builtin_read32_reversed,
    Gfun(External (EF_builtin "__builtin_read32_reversed"
-                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
-     (Tcons (tptr tuint) Tnil) tuint cc_default)) ::
+                   (mksignature (AST.Xptr :: nil) AST.Xint cc_default))
+     ((tptr tuint) :: nil) tuint cc_default)) ::
  (___builtin_write16_reversed,
    Gfun(External (EF_builtin "__builtin_write16_reversed"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tvoid
-                     cc_default)) (Tcons (tptr tushort) (Tcons tushort Tnil))
-     tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: AST.Xint16unsigned :: nil)
+                     AST.Xvoid cc_default))
+     ((tptr tushort) :: tushort :: nil) tvoid cc_default)) ::
  (___builtin_write32_reversed,
    Gfun(External (EF_builtin "__builtin_write32_reversed"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tvoid
-                     cc_default)) (Tcons (tptr tuint) (Tcons tuint Tnil))
-     tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: AST.Xint :: nil) AST.Xvoid
+                     cc_default)) ((tptr tuint) :: tuint :: nil) tvoid
+     cc_default)) ::
  (___builtin_debug,
    Gfun(External (EF_external "__builtin_debug"
-                   (mksignature (AST.Tint :: nil) AST.Tvoid
+                   (mksignature (AST.Xint :: nil) AST.Xvoid
                      {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
-     (Tcons tint Tnil) tvoid
+     (tint :: nil) tvoid
      {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
+ (_malloc, Gfun(External EF_malloc (tulong :: nil) (tptr tvoid) cc_default)) ::
+ (_free, Gfun(External EF_free ((tptr tvoid) :: nil) tvoid cc_default)) ::
  (_exit,
    Gfun(External (EF_external "exit"
-                   (mksignature (AST.Tint :: nil) AST.Tvoid cc_default))
-     (Tcons tint Tnil) tvoid cc_default)) ::
- (_free, Gfun(External EF_free (Tcons (tptr tvoid) Tnil) tvoid cc_default)) ::
- (_malloc,
-   Gfun(External EF_malloc (Tcons tulong Tnil) (tptr tvoid) cc_default)) ::
+                   (mksignature (AST.Xint :: nil) AST.Xvoid cc_default))
+     (tint :: nil) tvoid cc_default)) ::
  (_make_atomic,
    Gfun(External (EF_external "make_atomic"
-                   (mksignature (AST.Tint :: nil) AST.Tlong cc_default))
-     (Tcons tint Tnil) (tptr (Tstruct _atom_int noattr)) cc_default)) ::
+                   (mksignature (AST.Xint :: nil) AST.Xptr cc_default))
+     (tint :: nil) (tptr (Tstruct _atom_int noattr)) cc_default)) ::
  (_atom_load,
    Gfun(External (EF_external "atom_load"
-                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
-     (Tcons (tptr (Tstruct _atom_int noattr)) Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xptr :: nil) AST.Xint cc_default))
+     ((tptr (Tstruct _atom_int noattr)) :: nil) tint cc_default)) ::
  (_atom_store,
    Gfun(External (EF_external "atom_store"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tvoid
+                   (mksignature (AST.Xptr :: AST.Xint :: nil) AST.Xvoid
                      cc_default))
-     (Tcons (tptr (Tstruct _atom_int noattr)) (Tcons tint Tnil)) tvoid
-     cc_default)) ::
+     ((tptr (Tstruct _atom_int noattr)) :: tint :: nil) tvoid cc_default)) ::
  (_atom_CAS,
    Gfun(External (EF_external "atom_CAS"
-                   (mksignature (AST.Tlong :: AST.Tlong :: AST.Tint :: nil)
-                     AST.Tint cc_default))
-     (Tcons (tptr (Tstruct _atom_int noattr))
-       (Tcons (tptr tint) (Tcons tint Tnil))) tint cc_default)) ::
+                   (mksignature (AST.Xptr :: AST.Xptr :: AST.Xint :: nil)
+                     AST.Xint cc_default))
+     ((tptr (Tstruct _atom_int noattr)) :: (tptr tint) :: tint :: nil) tint
+     cc_default)) ::
  (_makelock,
    Gfun(External (EF_external "makelock"
-                   (mksignature nil AST.Tlong cc_default)) Tnil
+                   (mksignature nil AST.Xptr cc_default)) nil
      (tptr (Tstruct _atom_int noattr)) cc_default)) ::
  (_freelock,
    Gfun(External (EF_external "freelock"
-                   (mksignature (AST.Tlong :: nil) AST.Tvoid cc_default))
-     (Tcons (tptr (Tstruct _atom_int noattr)) Tnil) tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid cc_default))
+     ((tptr (Tstruct _atom_int noattr)) :: nil) tvoid cc_default)) ::
  (_acquire,
    Gfun(External (EF_external "acquire"
-                   (mksignature (AST.Tlong :: nil) AST.Tvoid cc_default))
-     (Tcons (tptr (Tstruct _atom_int noattr)) Tnil) tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid cc_default))
+     ((tptr (Tstruct _atom_int noattr)) :: nil) tvoid cc_default)) ::
  (_release,
    Gfun(External (EF_external "release"
-                   (mksignature (AST.Tlong :: nil) AST.Tvoid cc_default))
-     (Tcons (tptr (Tstruct _atom_int noattr)) Tnil) tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid cc_default))
+     ((tptr (Tstruct _atom_int noattr)) :: nil) tvoid cc_default)) ::
  (_spawn,
    Gfun(External (EF_external "spawn"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tvoid
+                   (mksignature (AST.Xptr :: AST.Xptr :: nil) AST.Xvoid
                      cc_default))
-     (Tcons (tptr (Tfunction (Tcons (tptr tvoid) Tnil) tint cc_default))
-       (Tcons (tptr tvoid) Tnil)) tvoid cc_default)) ::
+     ((tptr (Tfunction ((tptr tvoid) :: nil) tint cc_default)) ::
+      (tptr tvoid) :: nil) tvoid cc_default)) ::
  (_m_entries, Gvar v_m_entries) :: (_thread_locks, Gvar v_thread_locks) ::
  (_results, Gvar v_results) ::
  (_surely_malloc, Gfun(Internal f_surely_malloc)) ::
@@ -1059,8 +1023,8 @@ Definition public_idents : list ident :=
 (_main :: _f :: _init_table :: _add_item :: _get_item :: _set_item ::
  _integer_hash :: _surely_malloc :: _results :: _thread_locks ::
  _m_entries :: _spawn :: _release :: _acquire :: _freelock :: _makelock ::
- _atom_CAS :: _atom_store :: _atom_load :: _make_atomic :: _malloc ::
- _free :: _exit :: ___builtin_debug :: ___builtin_write32_reversed ::
+ _atom_CAS :: _atom_store :: _atom_load :: _make_atomic :: _exit :: _free ::
+ _malloc :: ___builtin_debug :: ___builtin_write32_reversed ::
  ___builtin_write16_reversed :: ___builtin_read32_reversed ::
  ___builtin_read16_reversed :: ___builtin_fnmsub :: ___builtin_fnmadd ::
  ___builtin_fmsub :: ___builtin_fmadd :: ___builtin_fmin ::
@@ -1072,12 +1036,12 @@ Definition public_idents : list ident :=
  ___builtin_fabs :: ___builtin_ctzll :: ___builtin_ctzl :: ___builtin_ctz ::
  ___builtin_clzll :: ___builtin_clzl :: ___builtin_clz ::
  ___builtin_bswap16 :: ___builtin_bswap32 :: ___builtin_bswap ::
- ___builtin_bswap64 :: ___compcert_i64_umulh :: ___compcert_i64_smulh ::
- ___compcert_i64_sar :: ___compcert_i64_shr :: ___compcert_i64_shl ::
- ___compcert_i64_umod :: ___compcert_i64_smod :: ___compcert_i64_udiv ::
- ___compcert_i64_sdiv :: ___compcert_i64_utof :: ___compcert_i64_stof ::
- ___compcert_i64_utod :: ___compcert_i64_stod :: ___compcert_i64_dtou ::
- ___compcert_i64_dtos :: ___compcert_va_composite ::
+ ___builtin_bswap64 :: ___builtin_ais_annot :: ___compcert_i64_umulh ::
+ ___compcert_i64_smulh :: ___compcert_i64_sar :: ___compcert_i64_shr ::
+ ___compcert_i64_shl :: ___compcert_i64_umod :: ___compcert_i64_smod ::
+ ___compcert_i64_udiv :: ___compcert_i64_sdiv :: ___compcert_i64_utof ::
+ ___compcert_i64_stof :: ___compcert_i64_utod :: ___compcert_i64_stod ::
+ ___compcert_i64_dtou :: ___compcert_i64_dtos :: ___compcert_va_composite ::
  ___compcert_va_float64 :: ___compcert_va_int64 :: ___compcert_va_int32 ::
  nil).
 
diff --git a/atomics/verif_hashtable_atomic.v b/atomics/verif_hashtable_atomic.v
index 8f73886314..f5a02f61d3 100644
--- a/atomics/verif_hashtable_atomic.v
+++ b/atomics/verif_hashtable_atomic.v
@@ -1,4 +1,3 @@
-Require Import VST.veric.rmaps.
 Require Import VST.concurrency.conclib.
 Require Import VST.atomics.SC_atomics.
 Require Import VST.atomics.verif_lock_atomic.
@@ -10,6 +9,12 @@ Import List.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
+Section mpred.
+
+(* box up concurrentGS? *)
+Context `{!VSTGS unit Σ, !cinvG Σ, !inG Σ (excl_authR natO), !atomic_int_impl (Tstruct _atom_int noattr)}.
+#[local] Instance concurrent_ext_spec : ext_spec unit := concurrent_ext_spec _ (ext_link_prog prog).
+
 Definition spawn_spec := DECLARE _spawn spawn_spec.
 Definition atom_load_spec := DECLARE _atom_load atomic_load_spec.
 Definition atom_store_spec := DECLARE _atom_store atomic_store_spec.
@@ -24,10 +29,10 @@ Definition surely_malloc_spec :=
                 natural_aligned natural_alignment t = true)
        PARAMS (Vptrofs (Ptrofs.repr (sizeof t))) GLOBALS (gv)
        SEP (mem_mgr gv)
-    POST [ tptr tvoid ] EX p:_,
+    POST [ tptr tvoid ] ∃ p:_,
        PROP ()
        RETURN (p)
-       SEP (mem_mgr gv; malloc_token Ews t p * data_at_ Ews t p).
+       SEP (mem_mgr gv; malloc_token Ews t p ∗ data_at_ Ews t p).
 
 Definition integer_hash_spec :=
  DECLARE _integer_hash
@@ -131,7 +136,7 @@ Definition hashtable_entry T lg entries i :=
 
 Definition wf_table (T : list (Z * Z)) := forall k i, k <> 0 -> fst (Znth i T) = k -> lookup T k = Some i.
 
-Definition hashtable H g lg entries := EX T : list (Z * Z),
+Definition hashtable H g lg entries := ∃ T : list (Z * Z),
   !!(Zlength T = size /\ wf_table T /\ forall k v, H k = Some v <-> In (k, v) T /\ v <> 0) &&
   excl g H * iter_sepcon (hashtable_entry T lg entries) (upto (Z.to_nat size)).
 
@@ -159,7 +164,7 @@ Program Definition get_item_spec := DECLARE _get_item
     PARAMS (vint k) GLOBALS (gv)
     SEP (data_at sh (tarray tentry size) entries (gv _m_entries)) | (hashtable H g lg entries)
   POST [ tint ]
-   EX v : Z,
+   ∃ v : Z,
     PROP ()
     LOCAL (temp ret_temp (vint v))
     SEP (data_at sh (tarray tentry size) entries (gv _m_entries)) | (!!(if eq_dec v 0 then H k = None else H k = Some v) && hashtable H g lg entries).
@@ -173,7 +178,7 @@ Program Definition add_item_spec := DECLARE _add_item
     PARAMS (vint k; vint v) GLOBALS (gv)
     SEP (data_at sh (tarray tentry size) entries (gv _m_entries)) | (hashtable H g lg entries)
   POST [ tint ]
-   EX b : bool,
+   ∃ b : bool,
     PROP ()
     LOCAL (temp ret_temp (Val.of_bool b))
     SEP (data_at sh (tarray tentry size) entries (gv _m_entries)) |
@@ -187,7 +192,7 @@ Definition init_table_spec :=
    PARAMS () GLOBALS (gv)
    SEP (mem_mgr gv; data_at_ Ews (tarray tentry size) (gv _m_entries))
   POST [ tvoid ]
-   EX entries : list (val * val), EX g : gname, EX lg : list gname,
+   ∃ entries : list (val * val), ∃ g : gname, ∃ lg : list gname,
    PROP (Forall (fun '(pk, pv) => isptr pk /\ isptr pv) entries; Zlength lg = size)
    LOCAL ()
    SEP (mem_mgr gv; data_at Ews (tarray tentry size) entries (gv _m_entries);
@@ -208,11 +213,11 @@ Fixpoint apply_hist H h :=
                         | Some _ => if r then None else apply_hist H h' end
   end.
 
-Definition hashtable_inv gh g lg entries := EX H : _, hashtable H g lg entries *
-  EX hr : _, !!(apply_hist empty_map hr = Some H) && ghost_ref hr gh.
+Definition hashtable_inv gh g lg entries := ∃ H : _, hashtable H g lg entries *
+  ∃ hr : _, !!(apply_hist empty_map hr = Some H) && ghost_ref hr gh.
 
 Definition f_lock_inv sh gsh entries gh p t locksp lockt resultsp res gv :=
-  EX b1 : bool, EX b2 : bool, EX b3 : bool, EX h : _,
+  ∃ b1 : bool, ∃ b2 : bool, ∃ b3 : bool, ∃ h : _,
     !!(add_events empty_map [HAdd 1 1 b1; HAdd 2 1 b2; HAdd 3 1 b3] h) && ghost_hist gsh h gh *
     data_at sh (tarray tentry size) entries p *
     data_at sh (tarray (tptr t_lock) 3) (upd_Znth t (repeat Vundef 3) lockt) locksp *
@@ -390,14 +395,14 @@ Proof.
   set (AS := atomic_shift _ _ _ _ _).
   forward_call k.
   pose proof size_pos as Hsize; pose proof size_signed as Hsigned.
-  forward_loop (EX i : Z, EX i1 : Z, EX keys : list Z,
+  forward_loop (∃ i : Z, ∃ i1 : Z, ∃ keys : list Z,
     PROP (i1 mod size = (i + hash k) mod size; 0 <= i < size; Zlength keys = size;
           Forall (fun z => z <> 0 /\ z <> k) (sublist 0 i (rebase keys (hash k))))
     LOCAL (temp _idx (vint i1); lvar _ref tint v_ref; temp _key (vint k); temp _value (vint v); gvars gv)
     SEP (AS; data_at_ Tsh tint v_ref; @data_at CompSpecs sh (tarray tentry size) entries (gv _m_entries);
          iter_sepcon (fun i => ghost_snap (Znth ((i + hash k) mod size) keys)
            (Znth ((i + hash k) mod size) lg)) (upto (Z.to_nat i))))%assert
-    continue: (EX i : Z, EX i1 : Z, EX keys : list Z,
+    continue: (∃ i : Z, ∃ i1 : Z, ∃ keys : list Z,
     PROP (Int.min_signed <= Int.signed (Int.repr i1) < Int.max_signed; i1 mod size = (i + hash k) mod size;
           0 <= i < size; Zlength keys = size;
           Forall (fun z => z <> 0 /\ z <> k) (sublist 0 (i + 1) (rebase keys (hash k))))
@@ -655,14 +660,14 @@ Proof.
   set (AS := atomic_shift _ _ _ _ _).
   forward_call k.
   pose proof size_pos as Hsize; pose proof size_signed as Hsigned.
-  forward_loop (EX i : Z, EX i1 : Z, EX keys : list Z,
+  forward_loop (∃ i : Z, ∃ i1 : Z, ∃ keys : list Z,
     PROP (i1 mod size = (i + hash k) mod size; 0 <= i < size; Zlength keys = size;
           Forall (fun z => z <> 0 /\ z <> k) (sublist 0 i (rebase keys (hash k))))
     LOCAL (temp _idx (vint i1); temp _key (vint k); gvars gv)
     SEP (AS; @data_at CompSpecs sh (tarray tentry size) entries (gv _m_entries);
          iter_sepcon (fun i => ghost_snap (Znth ((i + hash k) mod size) keys)
            (Znth ((i + hash k) mod size) lg)) (upto (Z.to_nat i))))%assert
-    continue: (EX i : Z, EX i1 : Z, EX keys : list Z,
+    continue: (∃ i : Z, ∃ i1 : Z, ∃ keys : list Z,
     PROP (Int.min_signed <= Int.signed (Int.repr i1) < Int.max_signed;
           i1 mod size = (i + hash k) mod size; 0 <= i < size; Zlength keys = size;
           Forall (fun z => z <> 0 /\ z <> k) (sublist 0 (i + 1) (rebase keys (hash k))))
@@ -853,14 +858,14 @@ Proof.
   set (AS := atomic_shift _ _ _ _ _).
   forward_call k.
   pose proof size_pos as Hsize; pose proof size_signed as Hsigned.
-  forward_loop (EX i : Z, EX i1 : Z, EX keys : list Z,
+  forward_loop (∃ i : Z, ∃ i1 : Z, ∃ keys : list Z,
     PROP (i1 mod size = (i + hash k) mod size; 0 <= i < size; Zlength keys = size;
           Forall (fun z => z <> 0 /\ z <> k) (sublist 0 i (rebase keys (hash k))))
     LOCAL (temp _idx (vint i1); lvar _ref tint v_ref; temp _key (vint k); temp _value (vint v); gvars gv)
     SEP (AS; data_at_ Tsh tint v_ref; @data_at CompSpecs sh (tarray tentry size) entries (gv _m_entries);
          iter_sepcon (fun i => ghost_snap (Znth ((i + hash k) mod size) keys)
            (Znth ((i + hash k) mod size) lg)) (upto (Z.to_nat i))))%assert
-    continue: (EX i : Z, EX i1 : Z, EX keys : list Z,
+    continue: (∃ i : Z, ∃ i1 : Z, ∃ keys : list Z,
     PROP (Int.min_signed <= Int.signed (Int.repr i1) < Int.max_signed;
           i1 mod size = (i + hash k) mod size; 0 <= i < size; Zlength keys = size;
           Forall (fun z => z <> 0 /\ z <> k) (sublist 0 (i + 1) (rebase keys (hash k))))
@@ -1138,11 +1143,11 @@ Proof.
   start_function.
   ghost_alloc (fun g => excl g (@empty_map Z Z)).
   Intro g.
-  forward_for_simple_bound size (EX i : Z, EX entries : list (val * val),
+  forward_for_simple_bound size (∃ i : Z, ∃ entries : list (val * val),
     PROP (Forall (fun '(pk, pv) => isptr pk /\ isptr pv) entries; Zlength entries = i)
     LOCAL (gvars gv)
     SEP (excl g (@empty_map Z Z); mem_mgr gv; @data_at CompSpecs Ews (tarray tentry size) (entries ++ repeat (Vundef, Vundef) (Z.to_nat (size - i))) (gv _m_entries);
-         EX lg : list gname, !!(Zlength lg = i) && iter_sepcon (fun j =>
+         ∃ lg : list gname, !!(Zlength lg = i) && iter_sepcon (fun j =>
            hashtable_entry (repeat (0, 0) (Z.to_nat size)) lg entries j) (upto (Z.to_nat i)))).
   { setoid_rewrite (proj2_sig has_size); reflexivity. }
   { pose proof size_pos; lia. }
@@ -1249,7 +1254,7 @@ Proof.
   { rewrite if_false.
     cancel.
     { destruct tid; auto; discriminate. } }
-  forward_for_simple_bound 3 (EX j : Z, EX ls : list bool, EX h : _,
+  forward_for_simple_bound 3 (∃ j : Z, ∃ ls : list bool, ∃ h : _,
     PROP (Zlength ls = j; add_events empty_map (map (fun j => HAdd (j + 1) 1 (Znth j ls)) (upto (Z.to_nat j))) h)
     LOCAL (temp _total (vint (Zlength (List.filter id ls))); temp _res res; temp _l (ptr_of lockt); temp _t (vint t);
            temp _arg tid; gvars gv)
@@ -1265,7 +1270,7 @@ Proof.
   - rewrite invariant_dup; Intros.
     gather_SEP (inv _ _) (ghost_hist _ _ _).
     forward_call (i0 + 1, 1, gv, sh, entries, g, lg,
-      fun b => EX h' : _, !!(add_events h [HAdd (i0 + 1) 1 b] h') && ghost_hist gsh h' gh).
+      fun b => ∃ h' : _, !!(add_events h [HAdd (i0 + 1) 1 b] h') && ghost_hist gsh h' gh).
     { rewrite -> 5sepcon_assoc; apply sepcon_derives; [|cancel].
       iIntros "[#inv hist]"; unfold atomic_shift; iAuIntro.
       rewrite /atomic_acc /=.
@@ -1613,7 +1618,7 @@ Proof.
   set (f_lock j l r := f_lock_pred gsh2 (Znth j shs) (Znth j shs') entries gh (gv _m_entries)
                                          j (gv _thread_locks) l (gv _results) r gv).
   set (Nt := nroot .@ "t").
-  forward_for_simple_bound 3 (EX i : Z, EX res : list val, EX locks : list lock_handle,
+  forward_for_simple_bound 3 (∃ i : Z, ∃ res : list val, ∃ locks : list lock_handle,
     PROP (Zlength res = i; Zlength locks = i)
     LOCAL (temp _total (vint 0); gvars gv)
     SEP (mem_mgr gv; @data_at CompSpecs Ews (tarray tentry size) entries (gv _m_entries);
@@ -1665,7 +1670,7 @@ Proof.
   rewrite <- seq_assoc.
   assert (forall i, 0 <= i < 3 -> Znth i (map ptr_of locks) = ptr_of (Znth i locks)) as Hi.
   { intros; apply Znth_map; lia. }
-  forward_for_simple_bound 3 (EX i : Z, EX sh : share, EX sh' : share,
+  forward_for_simple_bound 3 (∃ i : Z, ∃ sh : share, ∃ sh' : share,
     PROP (sepalg_list.list_join sh0 (sublist i 3 shs) sh; sepalg_list.list_join sh0' (sublist i 3 shs') sh')
     LOCAL (temp _total (vint 0); gvars gv)
     SEP (mem_mgr gv; @data_at CompSpecs sh (tarray tentry size) entries (gv _m_entries);
@@ -1747,7 +1752,7 @@ Proof.
   rewrite sublist_nil.
   repeat match goal with H : sepalg_list.list_join _ (sublist 3 3 _) _ |- _ =>
     rewrite sublist_nil in H; inv H end.
-  forward_for_simple_bound 3 (EX i : Z, EX x : (share * (list (hist * list bool))), EX sh' : share,
+  forward_for_simple_bound 3 (∃ i : Z, ∃ x : (share * (list (hist * list bool))), ∃ sh' : share,
     PROP (readable_share (fst x); sepalg_list.list_join (fst x) (sublist i 3 shs) Ews; Zlength (snd x) = i;
           Forall (fun p => let '(h, ls) := p in add_events empty_map
             [HAdd 1 1 (Znth 0 ls); HAdd 2 1 (Znth 1 ls); HAdd 3 1 (Znth 2 ls)] h) (snd x);
@@ -1868,3 +1873,5 @@ Proof.
   Intros. (* We have the pure fact that 3 adds succeeded! *)
   forward.
 Qed.
+
+End mpred.
diff --git a/atomics/verif_lock.v b/atomics/verif_lock.v
index db282683bf..740ac83e44 100644
--- a/atomics/verif_lock.v
+++ b/atomics/verif_lock.v
@@ -1,20 +1,13 @@
-Require Import VST.veric.rmaps.
+Require Export iris_ora.logic.cancelable_invariants.
 Require Import VST.concurrency.conclib.
-Require Import VST.concurrency.ghosts.
-Require Import VST.concurrency.cancelable_invariants.
 Require Import VST.floyd.library.
-Require Import VST.atomics.SC_atomics_base.
+Require Import VST.atomics.SC_atomics.
 Require Import VST.concurrency.lock_specs.
 Require Import VST.concurrency.threads.
 
-#[export] Program Instance atom_impl : atomic_int_impl := { atomic_int := Tstruct _atom_int noattr }.
-Next Obligation. Admitted.
-Next Obligation. Admitted.
-Next Obligation. Admitted.
-Axiom atomic_int_isptr : forall sh v p, atomic_int_at sh v p |-- !! isptr p.
-#[export] Hint Resolve atomic_int_isptr : saturate_local.
-Axiom atomic_int_timeless : forall sh v p, fupd.timeless' (atomic_int_at sh v p).
-#[export] Hint Resolve atomic_int_timeless : core.
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ, !cinvG Σ, atom_impl : !atomic_int_impl (Tstruct _atom_int noattr)}.
 
 #[global] Opaque atomic_int_at.
 
@@ -28,74 +21,51 @@ Section PROOFS.
   Definition atom_store_spec := DECLARE _atom_store atomic_store_spec.
   Definition atom_CAS_spec := DECLARE _atom_CAS atomic_CAS_spec.
 
-  Definition inv_for_lock v R := EX b, atomic_int_at Ews (Val.of_bool b) v * if b then emp else R.
+  Definition inv_for_lock v R := ∃ b, atomic_int_at Ews (Val.of_bool b) v ∗ if b then emp else R.
 
-  Lemma inv_for_lock_nonexpansive : forall v, nonexpansive (inv_for_lock v).
-  Proof.
-    intros.
-    apply @exists_nonexpansive; intros.
-    apply sepcon_nonexpansive; [apply const_nonexpansive|].
-    destruct x; [apply const_nonexpansive | apply identity_nonexpansive].
-  Qed.
+  #[global] Instance inv_for_lock_nonexpansive : forall v, NonExpansive (inv_for_lock v).
+  Proof. solve_proper. Qed.
 
-  Definition atomic_lock_inv sh h R := let '(v, i, g) := h in !!(sh <> Share.bot /\ isptr v) && cinvariant i g (inv_for_lock v R) * cinv_own g sh.
+  Definition atomic_lock_inv sh h R := let '(v, i, g) := h in ⌜isptr v⌝ ∧ cinv i g (inv_for_lock v R) ∗ cinv_own g sh.
 
-  #[export] Program Instance atomic_impl : lock_impl := { t_lock := Tstruct _atom_int noattr; lock_handle := val * invariants.iname * ghosts.gname;
+  #[export] Program Instance atomic_impl : lock_impl := { t_lock := Tstruct _atom_int noattr; lock_handle := val * namespace * gname;
     ptr_of h := let '(v, i, g) := h in v; lock_inv := atomic_lock_inv }.
   Next Obligation.
   Proof.
-    unfold atomic_lock_inv.
-    apply sepcon_nonexpansive, const_nonexpansive.
-    apply @conj_nonexpansive; [apply const_nonexpansive|].
-    apply cinvariant_nonexpansive2, inv_for_lock_nonexpansive.
+    solve_proper.
   Qed.
   Next Obligation.
   Proof.
     unfold atomic_lock_inv.
-    destruct (isptr_dec v).
-    rewrite !prop_true_andp; auto.
-    rewrite <- !sepcon_assoc, (sepcon_comm (_ * cinv_own _ _)), !sepcon_assoc.
-    unfold cinv_own at 1 2; erewrite <- own_op by eauto.
-    rewrite <- sepcon_assoc; f_equal.
-    symmetry; apply cinvariant_dup.
-    { split; auto; intros ?; subst. apply join_Bot in H1 as []; contradiction. }
-    { rewrite prop_false_andp, !FF_sepcon, prop_false_andp, FF_sepcon; auto; intros []; contradiction. }
-  Qed.
-  Next Obligation.
-  Proof.
-    unfold exclusive_mpred, atomic_lock_inv; Intros.
-    unfold cinv_own; sep_apply own_op'.
-    Intros ?; Intros.
-    apply sepalg.join_self, identity_share_bot in H0; contradiction.
+    intros ?? ((?, ?), ?) ?.
+    rewrite /cinv_own own_op; iSplit.
+    - iIntros "(($ & $ & $) & (_ & _ & $))".
+    - iIntros "(#$ & #$ & $ & $)".
   Qed.
   Next Obligation.
   Proof.
+    intros ? ((?, ?), ?) ?.
     unfold atomic_lock_inv; entailer!.
   Qed.
 
-  (* We can use self_part sh h * R instead of selflock sh h R. *)
+  (* We can use self_part sh h ∗ R instead of selflock sh h R. *)
   Definition self_part sh (h : lock_handle) := let '(v, i, g) := h in cinv_own g sh.
 
-  Lemma self_part_exclusive : forall sh h, sh <> Share.bot -> exclusive_mpred (self_part sh h).
+(*  Lemma self_part_exclusive : forall sh h, sh <> Share.bot -> exclusive_mpred (self_part sh h).
   Proof.
     intros; unfold exclusive_mpred, self_part; destruct h as ((?, ?), ?).
     unfold cinv_own; rewrite own_op'; Intros ?.
     apply sepalg.join_self, identity_share_bot in H0; contradiction.
-  Qed.
+  Qed.*)
 
-  Lemma self_part_eq : forall sh1 sh2 h R, sh2 <> Share.bot -> lock_inv sh1 h (self_part sh2 h * R) * self_part sh2 h =
-    lock_inv sh1 h (self_part sh2 h * R) * lock_inv sh2 h (self_part sh2 h * R).
+  Lemma self_part_eq : forall sh1 sh2 h R, lock_inv sh1 h (self_part sh2 h ∗ R) ∗ self_part sh2 h ⊣⊢
+    lock_inv sh1 h (self_part sh2 h ∗ R) ∗ lock_inv sh2 h (self_part sh2 h ∗ R).
   Proof.
     intros.
     simpl; unfold atomic_lock_inv; destruct h as ((?, ?), ?).
-    destruct (eq_dec sh1 Share.bot).
-    { rewrite prop_false_andp, !FF_sepcon; auto; intros []; contradiction. }
-    destruct (isptr_dec v).
-    rewrite !prop_true_andp by auto.
-    unfold self_part at 2; rewrite cinvariant_dup at 1.
-    rewrite <- !sepcon_assoc; f_equal.
-    rewrite (sepcon_comm (_ * _) (cinvariant _ _ _)), <- sepcon_assoc; reflexivity.
-    { rewrite prop_false_andp, !FF_sepcon; auto; intros []; contradiction. }
+    iSplit.
+    - iIntros "((#$ & #$ & $) & $)".
+    - iIntros "(($ & $ & $) & (_ & _ & $))".
   Qed.
 
   Definition makelock_spec := DECLARE _makelock makelock_spec.
@@ -113,187 +83,127 @@ Section PROOFS.
     start_function.
     forward_call (vint 1).
     Intros p.
-    viewshift_SEP 0 (EX i g, lock_inv Tsh (p, i, g) (R (p, i, g))).
-    { go_lower; simpl.
-      entailer!.
-      eapply derives_trans, fupd_mono; [|apply exp_derives; intros; apply exp_derives; intros; apply sepcon_derives, derives_refl; apply andp_right, derives_refl; entailer!].
-      eapply derives_trans, cinv_alloc_dep.
-      unfold inv_for_lock.
-      do 2 (apply allp_right; intros).
-      eapply derives_trans, now_later.
-      Exists true; simpl; cancel. apply derives_refl. }
-    simpl.
+    viewshift_SEP 0 (∃ i g, lock_inv 1 (p, i, g) (R (p, i, g))).
+    { go_lowerx.
+      iIntros "(? & _)".
+      iDestruct (atomic_int_isptr with "[$]") as "#$".
+      iMod (cinv_alloc_strong (λ _, True%type) _ (nroot .@ "lock")) as (?) "(_ & ? & inv)".
+      { apply pred_infinite_True. }
+      iExists _, _; iFrame; iApply "inv".
+      rewrite /inv_for_lock.
+      iExists true; auto. }
     forward.
-    simpl; Exists (p, i, g); unfold atomic_lock_inv; entailer!.
+    unfold lock_inv; simpl.
+    Exists (p, i, g); unfold atomic_lock_inv; entailer!.
   Qed.
 
-  #[local] Hint Resolve Ensembles.Full_intro : core.
-
   Lemma body_freelock: semax_body Vprog Gprog f_freelock freelock_spec.
   Proof.
     start_function.
     destruct h as ((p, i), g); simpl; Intros.
-    gather_SEP (cinvariant _ _ _) (cinv_own _ _); viewshift_SEP 0 (cinvariant i g (inv_for_lock p R) * |> inv_for_lock p R).
-    { go_lower; simpl; Intros.
-      rewrite cinvariant_dup at 1; unfold cinvariant at 1; sep_apply (inv_open Ensembles.Full_set); auto.
-      eapply derives_trans, fupd_elim; [apply fupd_frame_r|].
-      rewrite later_orp, !distrib_orp_sepcon; apply orp_left.
-      - sep_apply (modus_ponens_wand' (cinv_own g Tsh)).
-        { apply orp_right2, now_later. }
-        sep_apply fupd_frame_r; rewrite emp_sepcon.
-        sep_apply fupd_frame_r; rewrite sepcon_comm; apply derives_refl.
-      - eapply derives_trans, except_0_fupd.
-        apply orp_right1.
-        rewrite sepcon_assoc; eapply derives_trans; [apply sepcon_derives, now_later; apply derives_refl|].
-        rewrite <- later_sepcon; apply later_derives.
-        sep_apply cinv_own_excl.
-        rewrite FF_sepcon; auto. }
+    gather_SEP (cinv _ _ _) (cinv_own _ _); viewshift_SEP 0 (cinv i g (inv_for_lock p R) ∗ ▷ inv_for_lock p R).
+    { go_lowerx.
+      iIntros "((#$ & ?) & _)".
+      iMod (cinv_cancel with "[$] [$]") as "$"; done. }
     unfold inv_for_lock at 2.
-    rewrite (later_exp' _ true); Intros b.
+    rewrite bi.later_exist; Intros b.
     destruct b.
-    - assert_PROP (is_pointer_or_null p) by entailer!.
-      forward_call (p).
+    - forward_call (p).
       { Exists (Val.of_bool true); cancel. }
       entailer!.
-      rewrite <- emp_sepcon; apply sepcon_derives, andp_left2, derives_refl.
-      apply inv_dealloc.
+      by iIntros "(_ & _)".
     - gather_SEP 0 1 2 3.
-      viewshift_SEP 0 FF.
-      go_lower.
-      rewrite cinvariant_dup at 1.
-      unfold cinvariant at 1; sep_apply (inv_open Ensembles.Full_set); auto.
-      eapply derives_trans, fupd_elim; [apply fupd_frame_r|].
-      rewrite <- !sepcon_assoc, (sepcon_comm _ (|> _)), <- !sepcon_assoc.
-      rewrite 3sepcon_assoc; eapply derives_trans; [apply sepcon_derives, derives_refl|].
-      { rewrite <- later_sepcon; apply later_derives.
-        rewrite distrib_orp_sepcon2; apply orp_left, derives_refl.
-        unfold inv_for_lock; Intros b.
-        sep_apply atomic_int_conflict; auto.
-        rewrite FF_sepcon; apply FF_left. }
-      rewrite <- !sepcon_assoc, (sepcon_comm _ (_ -* _)).
-      rewrite !later_sepcon, <- !sepcon_assoc, 4sepcon_assoc.
-      eapply derives_trans; [apply sepcon_derives; [apply derives_refl|]|].
-      rewrite <- !sepcon_assoc; eapply derives_trans, modus_ponens_wand.
-      eapply sepcon_derives, derives_trans; [|apply now_later | rewrite later_andp, later_wand; apply andp_left1, derives_refl].
-      rewrite !later_sepcon; entailer!.
-      { rewrite sepcon_assoc, <- later_sepcon, sepcon_FF.
-        eapply derives_trans; [apply sepcon_derives, derives_refl; apply now_later|].
-        rewrite <- later_sepcon, sepcon_FF.
-        eapply derives_trans, except_0_fupd; apply orp_right1; auto. }
-      { eapply semax_pre, semax_ff; entailer!. }
+      viewshift_SEP 0 (False : mpred).
+      go_lowerx.
+      iIntros "((#I & (p & R) & P & HR) & _)".
+      rewrite {1}/cinv.
+      iInv "I" as "[(% & p' & ?) | Hown]".
+      { iAssert (▷False) with "[p p']" as ">[]".
+        iApply atomic_int_conflict; last iFrame; auto. }
+      iAssert (▷ False) with "[-]" as ">[]".
+      iNext; rewrite bi.affinely_elim; iDestruct ("HR" with "[$P $R $Hown]") as "[]"; done.
+      { eapply semax_pre, semax_ff; go_lower; done. }
   Qed.
 
   Lemma body_release: semax_body Vprog Gprog f_release release_spec.
   Proof.
     start_function.
-    forward_call (ptr_of h, vint 0, @Ensembles.Full_set invariants.iname, @Ensembles.Empty_set invariants.iname, Q).
-    - simpl; unfold atomic_lock_inv; destruct h as ((p, i), g); Intros.
+    forward_call (ptr_of h, vint 0, ⊤ : coPset, ∅ : coPset, Q).
+    - destruct h as ((p, i), g); simpl; Intros.
       subst Frame; instantiate (1 := []); simpl; cancel.
-      rewrite cinvariant_dup at 1.
-      sep_apply (cinv_open Ensembles.Full_set); auto.
-      repeat sep_apply fupd_frame_r; apply fupd_elim.
-      rewrite prop_true_andp by auto.
-      sep_apply (modus_ponens_wand (cinvariant i g (inv_for_lock p R) * cinv_own g sh * P)).
-      unfold inv_for_lock at 1.
-      rewrite (later_exp' _ true); Intros b; destruct b.
-      + rewrite sepcon_emp, !sepcon_assoc; sep_eapply fupd_timeless; auto; repeat sep_eapply fupd_frame_r; apply fupd_elim.
-        sep_apply atomic_int_at__.
-        eapply derives_trans, fupd_mask_intro_all; rewrite <- wand_sepcon_adjoint.
-        Exists Ews; simpl; entailer!.
-        rewrite <- wand_sepcon_adjoint.
-        sep_apply fupd_frame_l; repeat sep_apply fupd_frame_r; apply fupd_elim.
-        unfold ptr_of; sep_apply (modus_ponens_wand' (R * atomic_int_at Ews (vint 0) p)).
-        { unfold inv_for_lock.
-          eapply derives_trans, now_later.
-          Exists false; cancel. }
-        repeat sep_apply fupd_frame_r; apply fupd_mono; cancel.
-        apply andp_left2; auto.
-      + eapply derives_trans, except_0_fupd; apply orp_right1.
-        rewrite sepcon_comm, !sepcon_assoc; eapply derives_trans; [apply sepcon_derives, now_later; apply derives_refl|].
-        rewrite <- later_sepcon; apply later_derives.
-        sep_apply weak_exclusive_conflict.
-        rewrite FF_sepcon; auto.
-    - hnf; inversion 1.
+      iIntros "(HR & #I & ? & P & HQ)".
+      iInv i as "((% & >p & ?) & Hown)" "Hclose".
+      destruct b.
+      + iExists Ews; rewrite (bi.pure_True (writable_share _)) //.
+        rewrite atomic_int_at__; iFrame.
+        iApply fupd_mask_intro; first set_solver.
+        iIntros "Hmask p".
+        iDestruct ("HQ" with "[$Hown $P]") as "($ & ?)"; first auto.
+        iMod "Hmask"; iApply "Hclose".
+        iExists false; iFrame.
+      + iDestruct ("HQ" with "[$Hown $P]") as "(? & ?)"; first auto.
+        iAssert (▷ False) with "[-]" as ">[]".
+        rewrite bi.affinely_elim; iNext; iApply ("HR" with "[$]").
     - entailer!.
   Qed.
 
   Lemma body_acquire: semax_body Vprog Gprog f_acquire acquire_spec.
   Proof.
-    start_function; simpl.
+    start_function.
     forward.
     forward_loop (PROP ( )
                        LOCAL (temp _b (vint 0); lvar _expected tint v_expected;
                               temp _lock (ptr_of h))
                        SEP (data_at_ Tsh tint v_expected; atomic_lock_inv sh h R)).
-    { entailer!. }
+    { unfold lock_inv; simpl; entailer!. }
     forward.
     forward_call
-      (ptr_of h, Tsh, v_expected, (vint 0), (vint 1), @Ensembles.Full_set invariants.iname, @Ensembles.Empty_set invariants.iname,
+      (ptr_of h, Tsh, v_expected, (vint 0), (vint 1), ⊤ : coPset, ∅ : coPset,
             fun v':val =>
-              atomic_lock_inv sh h R * if (eq_dec v' (vint 0)) then |> R else emp).
+              atomic_lock_inv sh h R ∗ if (eq_dec v' (vint 0)) then ▷ R else emp).
     - unfold atomic_lock_inv; destruct h as ((p, i), g); Intros.
       subst Frame; instantiate (1 := []); simpl fold_right_sepcon; cancel.
-      rewrite cinvariant_dup at 1.
-      sep_apply (cinv_open Ensembles.Full_set); auto.
-      repeat sep_apply fupd_frame_r; apply fupd_elim.
-      unfold inv_for_lock at 1.
-      rewrite (later_exp' _ true); Intros b.
-      rewrite later_sepcon; sep_eapply fupd_timeless; auto; repeat sep_eapply fupd_frame_r; apply fupd_elim.
-      eapply derives_trans, fupd_mask_intro_all; rewrite <- wand_sepcon_adjoint.
-      Exists Ews (Val.of_bool b); simpl; entailer!.
-      rewrite <- wand_sepcon_adjoint.
-      sep_apply fupd_frame_l; repeat sep_apply fupd_frame_r; apply fupd_elim.
-      destruct b; simpl eq_dec.
-      + rewrite !if_false by discriminate.
-        sep_eapply fupd_timeless; [apply fupd.emp_timeless|]; repeat sep_eapply fupd_frame_r; apply fupd_elim.
-        rewrite emp_sepcon.
-        sep_apply (modus_ponens_wand' (atomic_int_at Ews (Val.of_bool true) p)).
-        { unfold inv_for_lock.
-          eapply derives_trans, now_later.
-          Exists true; cancel. }
-        repeat sep_apply fupd_frame_r; apply fupd_mono; cancel.
-      + rewrite !if_true by auto.
-        sep_apply (modus_ponens_wand' (atomic_int_at Ews (vint 1) p)).
-        { unfold inv_for_lock.
-          eapply derives_trans, now_later.
-          Exists true; cancel. }
-        repeat sep_apply fupd_frame_r; apply fupd_mono; cancel.
-    - hnf; inversion 1.
+      iIntros "(#I & ?)".
+      iInv "I" as "((% & >? & ?) & ?)" "Hclose".
+      iExists Ews, (Val.of_bool b); rewrite (bi.pure_True (writable_share _)) //.
+      iFrame.
+      iApply fupd_mask_intro; first set_solver.
+      iIntros "Hmask p"; iMod "Hmask" as "_".
+      destruct b; simpl.
+      + iMod ("Hclose" with "[-]"); last auto.
+        iExists true; iFrame.
+      + iMod ("Hclose" with "[p]"); last by iFrame; auto.
+        iExists true; iFrame; auto.
     - Intros r. if_tac; forward_if; try discriminate; try contradiction.
-      + forward. simpl lock_specs.lock_inv; entailer!.
-      + forward. simpl lock_specs.lock_inv; entailer!.
+      + forward. simpl lock_inv; entailer!.
+      + forward. simpl lock_inv; entailer!.
   Qed.
 
 End PROOFS.
 
+Opaque lock_inv.
+
 (* freelock and release specialized for self_part *)
 Program Definition freelock_spec_self :=
   TYPE (ProdType (ConstType _) Mpred)
   WITH sh1 : _, sh2 : _, h : _, R : _
   PRE [ tptr t_lock ]
-     PROP (sh2 <> Share.bot; sepalg.join sh1 sh2 Tsh)
+     PROP (sh1 ⋅ sh2 = 1%Qp)
      PARAMS (ptr_of h)
-     SEP (lock_inv sh1 h (self_part sh2 h * R); self_part sh2 h)
+     SEP (lock_inv sh1 h (self_part sh2 h ∗ R); self_part sh2 h)
   POST [ tvoid ]
      PROP ()
      LOCAL ()
      SEP ().
 Next Obligation.
 Proof.
-  repeat intro.
-  destruct x as (((?, ?), ?), ?); simpl.
-  unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; do 3 f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  f_equal.
-  setoid_rewrite (@lock_inv_super_non_expansive atomic_impl); do 2 f_equal.
-  rewrite !approx_sepcon, approx_idem; auto.
+  intros ? (((?, ?), ?), ?) (((?, ?), ?), ?) ([=] & HR) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 Next Obligation.
 Proof.
-  repeat intro.
-  destruct x as (((?, ?), ?), ?); simpl.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
+  intros ? (((?, ?), ?), ?) (((?, ?), ?), ?) ([=] & HR) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 
 Program Definition release_spec_self :=
@@ -302,73 +212,70 @@ Program Definition release_spec_self :=
   PRE [ tptr t_lock ]
      PROP ()
      PARAMS (ptr_of h)
-     SEP (lock_inv sh h (self_part sh h * R); R)
+     SEP (<affine> (R ∗ R -∗ False); lock_inv sh h (self_part sh h ∗ R); R)
   POST [ tvoid ]
      PROP ()
      LOCAL ()
      SEP ().
 Next Obligation.
 Proof.
-  repeat intro.
-  destruct x as ((?, ?), ?); simpl.
-  unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; do 3 f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  f_equal.
-  setoid_rewrite (@lock_inv_super_non_expansive atomic_impl); do 2 f_equal.
-  rewrite !approx_sepcon, approx_idem; auto.
+  intros ? ((?, ?), ?) ((?, ?), ?) ([=] & HR) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 Next Obligation.
 Proof.
-  repeat intro.
-  destruct x as ((?, ?), ?); simpl.
-  reflexivity.
+  intros ? ((?, ?), ?) ((?, ?), ?) ([=] & HR) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 
-#[export] Hint Resolve self_part_exclusive : core.
+Transparent lock_inv.
 
 Lemma release_self : funspec_sub lock_specs.release_spec release_spec_self.
 Proof.
   unfold funspec_sub; simpl.
-  split; auto; intros ? ((sh, h), R) ?; Intros.
-  eapply derives_trans, fupd_intro.
-  Exists (nil : list Type) (sh, h, self_part sh h * R, R, emp) emp; entailer!.
-  { intros; unfold PROPx, LOCALx, SEPx; simpl; entailer!. }
-  unfold atomic_lock_inv; destruct h as ((?, ?), ?).
-  unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; entailer!.
-  lock_props.
-  { fold (self_part sh (v, i, g)); apply exclusive_sepcon1; auto. }
-  rewrite <- sepcon_emp at 1; apply sepcon_derives; [apply now_later|].
-  rewrite <- wand_sepcon_adjoint, emp_sepcon; cancel.
-  apply inv_dealloc.
+  split; first done; intros ((sh, h), R) ?; Intros.
+  iIntros "(? & ? & H) !>"; iExists (sh, h, self_part sh h ∗ R, R, emp), emp.
+  iSplit; first done.
+  iSplit.
+  - repeat (iSplit; first done).
+    rewrite /SEPx /= /LOCALx /argsassert2assert /=; monPred.unseal.
+    repeat (iSplit; first done).
+    iDestruct "H" as "(? & HR & ? & ? & _)"; iFrame.
+    iSplitL "HR".
+    + iIntros "!> ((? & ?) & (? & ?))".
+      rewrite bi.affinely_elim; iApply ("HR" with "[$]").
+    + iSplit; first done; iSplit; last done.
+      destruct h as ((?, ?), ?); iIntros "((% & (? & $)) & $)".
+  - iPureIntro; intros.
+    unfold PROPx, LOCALx, SEPx; simpl; entailer!.
 Qed.
 
-Lemma lock_inv_share : forall sh h R, lock_inv sh h R |-- !!(sh <> Share.bot /\ isptr (ptr_of h)).
-Proof.
-  intros; destruct h as ((?, ?), ?); simpl; Intros; entailer!.
-Qed.
-
-#[export] Hint Resolve lock_inv_share : saturate_local.
-
 Lemma freelock_self : funspec_sub lock_specs.freelock_spec freelock_spec_self.
 Proof.
   unfold funspec_sub; simpl.
-  split; auto; intros ? (((sh1, sh2), h), R) ?; Intros.
-  eapply derives_trans, fupd_intro.
-  Exists (nil : list Type) (h, self_part sh2 h * R, emp) emp; entailer!.
-  { intros; unfold PROPx, LOCALx, SEPx; simpl; entailer!. }
-  unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl.
-  set (P := _ * _); entailer!; subst P.
-  rewrite sepcon_emp; setoid_rewrite self_part_eq; auto.
-  saturate_local.
-  erewrite lock_inv_share_join by eauto; simpl; cancel.
-  apply andp_right; auto.
-  rewrite <- wand_sepcon_adjoint, emp_sepcon.
-  destruct h as ((p, i), g); simpl; Intros.
-  sep_apply cinv_own_excl.
-  rewrite FF_sepcon; auto.
+  split; first done; intros (((sh1, sh2), h), R) ?; Intros.
+  iIntros "((%Hsh & _) & ? & H) !>"; iExists (h, self_part sh2 h ∗ R, emp), emp.
+  iSplit; first done.
+  iSplit.
+  - repeat (iSplit; first done).
+    rewrite /SEPx /= /LOCALx /argsassert2assert /=; monPred.unseal.
+    repeat (iSplit; first done).
+    iDestruct "H" as "(? & p & self & _)"; iFrame.
+    iCombine "p self" as "p"; rewrite self_part_eq lock_inv_share_join Hsh; iFrame.
+    iSplit; first done; iSplit; last done.
+    iIntros "!> (_ & p & self & ?)".
+    iCombine "p self" as "p"; rewrite self_part_eq lock_inv_share_join.
+    destruct h as ((?, ?), ?); simpl.
+    iDestruct "p" as "(_ & _ & ? & ?)"; iApply (cinv_own_1_l with "[$] [$]").
+  - iPureIntro; intros.
+    unfold PROPx, LOCALx, SEPx; simpl; entailer!.
 Qed.
 
-Definition selflock R sh h := self_part sh h * R.
+Definition selflock R sh h := self_part sh h ∗ R.
+
+End mpred.
+
+#[export] Hint Resolve atomic_int_isptr : saturate_local.
 
 Opaque t_lock.
 Opaque lock_handle.
diff --git a/atomics/verif_lock_atomic.v b/atomics/verif_lock_atomic.v
index a148776d87..8cfefa92ab 100644
--- a/atomics/verif_lock_atomic.v
+++ b/atomics/verif_lock_atomic.v
@@ -1,12 +1,9 @@
-Require Import VST.veric.rmaps.
 Require Import VST.concurrency.conclib.
-Require Import VST.concurrency.ghosts.
-Require Import VST.concurrency.cancelable_invariants.
 Require Export VST.concurrency.lock_specs.
 Require Import VST.floyd.library.
-Require Export VST.atomics.SC_atomics_base.
 Require Export VST.atomics.verif_lock.
 Require Export VST.atomics.SC_atomics.
+Require Export VST.atomics.general_atomics.
 Require Import VST.concurrency.threads.
 
 Section PROOFS.
@@ -14,6 +11,8 @@ Section PROOFS.
   #[local] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
   Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
+  Context `{!VSTGS OK_ty Σ, !cinvG Σ, atom_impl : !atomic_int_impl (Tstruct _atom_int noattr)}.
+
   Definition make_atomic_spec :=
     DECLARE _make_atomic make_atomic_spec.
   Definition free_atomic_spec :=
@@ -30,7 +29,7 @@ Section PROOFS.
        PROP ()
        PARAMS () GLOBALS (gv)
        SEP (mem_mgr gv)
-    POST [ tptr t_lock ] EX p,
+    POST [ tptr t_lock ] ∃ p,
        PROP ()
        RETURN (p)
        SEP (mem_mgr gv; atomic_int_at Ews (vint 1) p).
@@ -41,7 +40,7 @@ Section PROOFS.
     PRE [ tptr t_lock ]
      PROP ()
      PARAMS (p)
-     SEP (EX v : val, atomic_int_at Ews v p)
+     SEP (∃ v : val, atomic_int_at Ews v p)
    POST[ tvoid ]
      PROP ()
      LOCAL ()
@@ -49,7 +48,7 @@ Section PROOFS.
 
   Program Definition release_spec :=
     DECLARE _release
-    ATOMIC TYPE (rmaps.ConstType val) INVS empty
+    ATOMIC TYPE (ConstType val) INVS empty
     WITH p
     PRE [ tptr t_lock ]
        PROP ()
@@ -62,7 +61,7 @@ Section PROOFS.
 
   Program Definition acquire_spec :=
     DECLARE _acquire
-    ATOMIC TYPE (rmaps.ConstType _) OBJ l INVS empty
+    ATOMIC TYPE (ConstType val) OBJ l INVS empty
     WITH p
     PRE [ tptr t_lock ]
        PROP ()
@@ -71,7 +70,7 @@ Section PROOFS.
     POST [ tvoid ]
        PROP ()
        LOCAL ()
-       SEP () | (!!(l = false) && atomic_int_at Ews (vint 1) p).
+       SEP () | (⌜l = false⌝ ∧ atomic_int_at Ews (vint 1) p).
 
   Definition Gprog : funspecs :=
     ltac:(with_library prog [make_atomic_spec; atom_store_spec; atom_CAS_spec;
@@ -93,7 +92,7 @@ Section PROOFS.
     start_function.
     Intros v.
     assert_PROP (is_pointer_or_null p) by entailer.
-    forward_call (p).
+    forward_call.
     - Exists v. cancel.
     - entailer!.
   Qed.
@@ -106,14 +105,11 @@ Section PROOFS.
       simpl fold_right_sepcon. cancel.
       iIntros ">AS".
       iDestruct "AS" as (x) "[a [_ H]]".
-      iExists Ews. iModIntro. iSplitL "a".
-      + iSplit.
-        * iPureIntro. apply writable_Ews.
-        * iApply atomic_int_at__. iAssumption.
+      iExists Ews. iModIntro. iSplit; first done. iSplitL "a".
+      + iApply atomic_int_at__. iAssumption.
       + iIntros "AA".
-        iPoseProof (sepcon_emp (atomic_int_at Ews (vint 0) p)) as "HA".
-        iSpecialize ("HA" with "AA"). iMod ("H" $! tt with "HA"). auto.
-    - entailer !.
+        iApply ("H" $! tt); iFrame.
+    - entailer!.
   Qed.
 
   Lemma body_acquire: semax_body Vprog Gprog f_acquire acquire_spec.
@@ -139,8 +135,8 @@ Section PROOFS.
         * iApply "H"; auto.
         * iDestruct "H" as "[_ H]"; iApply ("H" $! tt); iFrame; auto.
       + Intros r. destruct (eq_dec r (vint 0)).
+        * forward_if; try discriminate. forward. simpl. entailer!.
         * forward_if; try contradiction. forward. entailer!.
-        * forward_if; try discriminate. forward. entailer!.
   Qed.
 
   Program Definition release_spec_nonatomic :=
@@ -154,33 +150,26 @@ Section PROOFS.
        LOCAL ()
        SEP (atomic_int_at Ews (vint 0) p).
 
-  #[global] Instance atomic_int_timeless sh v p : Timeless (atomic_int_at sh v p).
-  Proof.
-    apply timeless'_timeless; auto.
-  Qed.
-
-  #[global] Instance inv_for_lock_timeless v R {H : Timeless R} : Timeless (inv_for_lock v R).
-  Proof.
-    unfold inv_for_lock.
-    apply bi.exist_timeless; intros []; apply _.
-  Qed.
-
   Lemma release_nonatomic: funspec_sub (snd release_spec) release_spec_nonatomic.
   Proof.
-    apply prove_funspec_sub.
-    split; auto. intros. simpl in *. Intros.
-    unfold rev_curry, tcurry; simpl. iIntros "H !>". iExists nil, (x2, atomic_int_at Ews (vint 0) x2), emp.
-    rewrite emp_sepcon. iSplit.
-    - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl.
+    split; first done. intros p ?. simpl in *. Intros.
+    unfold rev_curry, tcurry; simpl. iIntros "H !>". iExists (p, atomic_int_at Ews (vint 0) p), emp.
+    rewrite bi.emp_sep. iSplit; first done. iSplit.
+    - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; monPred.unseal.
       iDestruct "H" as "(% & % & _ & H & _)".
       do 4 (iSplit; auto).
       unfold atomic_shift; iAuIntro; unfold atomic_acc; simpl.
       iExists tt; iFrame "H".
       iApply fupd_mask_intro; first done; iIntros "Hclose".
       iSplit; [iIntros "$" | iIntros (_) "[$ _]"]; auto.
-    - iPureIntro. intros. Intros. rewrite emp_sepcon. auto.
+    - iPureIntro. intros. Intros. rewrite bi.emp_sep //.
   Qed.
 
+  #[global] Instance inv_for_lock_timeless v R {H : Timeless R} : Timeless (inv_for_lock v R).
+  Proof.
+    unfold inv_for_lock.
+    apply bi.exist_timeless; intros []; rewrite ?bi.sep_emp; apply _.
+  Qed.
 
 
   (* Asymmetric consequence means we can't prove the specs from lock_specs directly,
@@ -188,169 +177,84 @@ Section PROOFS.
      we would be able to prove lock_specs directly (without using funspec_sub), but
      that conflicts with the "one spec in Gprog" approach. *)
 
-  #[local] Obligation Tactic := intros.
-
-  #[export] Program Instance atomic_impl : lock_impl := { t_lock := Tstruct _atom_int noattr; lock_handle := val * namespace * ghosts.gname;
-    ptr_of h := let '(v, _, _) := h in v; lock_inv sh h R := let '(v, N, g) := h in !!(sh <> Share.bot /\ isptr v) && cinv N g (inv_for_lock v R) * cinv_own g sh }.
-  Next Obligation.
-  Proof.
-    destruct h as ((?, ?), ?).
-    apply sepcon_nonexpansive, const_nonexpansive.
-    apply @conj_nonexpansive; [apply const_nonexpansive|].
-    apply cinv_nonexpansive2, inv_for_lock_nonexpansive.
-  Qed.
-  Next Obligation.
-  Proof.
-    destruct h as ((?, ?), ?); simpl.
-    destruct (isptr_dec v).
-    rewrite !prop_true_andp; auto.
-    rewrite <- !sepcon_assoc, (sepcon_comm (_ * cinv_own _ _)), !sepcon_assoc.
-    unfold cinv_own at 1 2; erewrite <- own_op by eauto.
-    rewrite <- sepcon_assoc; f_equal.
-    rewrite {3}(bi.persistent_sep_dup (cinv n g _)); auto.
-    { split; auto; intros ?; subst. apply join_Bot in H1 as []; contradiction. }
-    { rewrite -> prop_false_andp, !FF_sepcon, prop_false_andp, FF_sepcon; auto; intros []; contradiction. }
-  Qed.
-  Next Obligation.
-  Proof.
-    unfold exclusive_mpred; destruct h as ((?, ?), ?); Intros.
-    unfold cinv_own; sep_apply own_op'.
-    Intros ?; Intros.
-    apply sepalg.join_self, identity_share_bot in H0; contradiction.
-  Qed.
-  Next Obligation.
-  Proof.
-    destruct h as ((?, ?), ?); simpl; entailer!.
-  Qed.
-
-  Definition name_of (h : lock_handle) := let '(_, N, _) := h in N.
-  Definition ghost_of (h : lock_handle) := let '(_, _, g) := h in g.
-  #[global] Instance lock_handle_inhabited : Inhabitant lock_handle := (Vundef, nroot, O).
-
-  (* Since a lock's namespace is known, the ghost name is the only part that needs to be existentially quantified. *)
-  Definition self_part sh h := cinv_own (ghost_of h) sh.
-
-  Lemma self_part_exclusive : forall sh h, sh <> Share.bot -> exclusive_mpred (self_part sh h).
-  Proof.
-    intros; unfold exclusive_mpred, self_part.
-    unfold cinv_own; rewrite own_op'; Intros ?.
-    apply sepalg.join_self, identity_share_bot in H0; contradiction.
-  Qed.
-
-  Lemma self_part_eq : forall sh1 sh2 h R, sh2 <> Share.bot -> lock_inv sh1 h (self_part sh2 h * R) * self_part sh2 h =
-    lock_inv sh1 h (self_part sh2 h * R) * lock_inv sh2 h (self_part sh2 h * R).
-  Proof.
-    intros; unfold lock_inv; destruct h as ((v, N), g); simpl.
-    destruct (eq_dec sh1 Share.bot).
-    { rewrite -> prop_false_andp, !FF_sepcon; auto; intros []; contradiction. }
-    destruct (isptr_dec v).
-    rewrite -> !prop_true_andp by auto.
-    unfold self_part at 2; rewrite {1}(bi.persistent_sep_dup (cinv N g _)).
-    rewrite <- !sepcon_assoc; f_equal.
-    rewrite -> (sepcon_comm (_ * _) (cinv _ _ _)), <- sepcon_assoc; reflexivity.
-    { rewrite -> prop_false_andp, !FF_sepcon; auto; intros []; contradiction. }
-  Qed.
+  Definition name_of (h : lock_handle) := let '(v, i, g) := h in i.
 
   (* caller can request the lock's namespace *)
   Program Definition makelock_spec_inv :=
-    TYPE (ProdType (ConstType (globals * namespace)) (ArrowType (ConstType lock_handle) Mpred)) WITH gv: _, N : _, R : _
+    TYPE (ProdType (ConstType (globals * namespace)) (DiscreteFunType lock_handle Mpred)) WITH gv: _, N : _, R : _
     PRE [ ]
        PROP ()
        PARAMS () GLOBALS (gv)
        SEP (mem_mgr gv)
-    POST [ tptr t_lock ] (* asymmetric consequence makes this messy *) EX v,
+    POST [ tptr t_lock ] (* asymmetric consequence makes this messy *) ∃ v,
        PROP ()
        RETURN (v)
-       SEP (mem_mgr gv; |={⊤}=> EX h, !!(ptr_of h = v /\ name_of h = N) && lock_inv Tsh h (R h)).
-  Next Obligation.
-  Proof.
-    repeat intro.
-    destruct x as ((?, ?), ?); simpl.
-    reflexivity.
-  Qed.
+       SEP (mem_mgr gv; |={⊤}=> ∃ h, ⌜ptr_of h = v /\ name_of h = N⌝ ∧ lock_inv 1 h (R h)).
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x as ((?, ?), ?); simpl.
-    rewrite -> 2approx_exp; apply f_equal; extensionality.
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite -> !approx_andp; do 2 apply f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    apply f_equal. setoid_rewrite fupd_nonexpansive; do 2 apply f_equal.
-    rewrite !approx_exp; apply f_equal; extensionality.
-    rewrite !approx_andp; f_equal.
-    apply lock_inv_super_non_expansive.
-  Qed.
+    intros ?.
+    by repeat f_equiv.
+  Qed. (* not sure why solve_proper doesn't do this *)
 
   (* These lemmas can be used to attach an invariant to an existing lock. *)
-  Lemma make_lock_inv_1 : forall v N (R : lock_handle -> mpred), atomic_int_at Ews (vint 1) v |-- (*|={⊤}=>*) @fupd mpred (bi_fupd_fupd(BiFUpd := mpred_bi_fupd)) ⊤ ⊤ (EX h, !!(ptr_of h = v /\ name_of h = N) && lock_inv Tsh h (R h)).
+  Lemma make_lock_inv_1 : forall v N (R : lock_handle -> mpred), atomic_int_at Ews (vint 1) v ⊢ |={⊤}=> (∃ h, ⌜ptr_of h = v /\ name_of h = N⌝ ∧ lock_inv 1 h (R h)).
   Proof.
     intros.
     iIntros "a".
     iDestruct (atomic_int_isptr with "a") as %Ha.
-    iMod (cinv_alloc_dep with "[a]") as (g) "[Hi Hg]";
-      [| iExists (v, N, g); unfold lock_inv; simpl; iFrame "Hi Hg"; auto].
-    iIntros (?) "!>"; unfold inv_for_lock.
-    iExists true; iFrame.
+    iMod cinv_alloc_strong as (g) "(_ & Hg & Hi)"; first apply pred_infinite_True.
+    iExists (v, N, g); unfold lock_inv; simpl; iFrame.
+    iMod ("Hi" $! (inv_for_lock v (R (v, N, g))) with "[-]").
+    { iExists true; iFrame; done. }
+    iFrame; done.
   Qed.
 
-  Lemma make_lock_inv_0_self : forall v N R sh1 sh2, sh1 <> Share.bot -> sepalg.join sh1 sh2 Tsh ->
-    (atomic_int_at Ews (vint 0) v * R) |-- @fupd mpred (bi_fupd_fupd(BiFUpd := mpred_bi_fupd)) ⊤ ⊤ (EX h, !!(ptr_of h = v /\ name_of h = N) && lock_inv sh1 h (R * self_part sh2 h)).
+  Lemma make_lock_inv_0_self : forall v N R sh1 sh2, sh1 ⋅ sh2 = 1%Qp ->
+    (atomic_int_at Ews (vint 0) v ∗ R) ⊢ |={⊤}=> (∃ h, ⌜ptr_of h = v /\ name_of h = N⌝ ∧ lock_inv sh1 h (R ∗ self_part sh2 h)).
   Proof.
     intros.
     iIntros "[a R]".
     iDestruct (atomic_int_isptr with "a") as %Ha.
-    iMod (own_alloc(RA := share_ghost) with "[$]") as (g) "g"; first done.
-    setoid_rewrite (own_op(RA := share_ghost) _ _ _ _ _ H0); iDestruct "g" as "[g1 g2]".
-    iMod (inv_alloc with "[a R g2]") as "I";
-      [| iExists (v, N, g); unfold lock_inv; simpl; iFrame; auto].
-    iIntros "!>"; unfold inv_for_lock.
-    iLeft; iExists false; iFrame; auto.
+    iMod cinv_alloc_strong as (g) "(_ & Hg & Hi)"; first apply pred_infinite_True.
+    iExists (v, N, g); unfold lock_inv; simpl.
+    rewrite -H; iDestruct "Hg" as "($ & Hg)".
+    iMod ("Hi" $! (inv_for_lock v (R ∗ cinv_own g sh2)) with "[-]").
+    { iExists false; iFrame; done. }
+    iFrame; done.
   Qed.
 
-  Lemma make_lock_inv_0' : forall v N (R : lock_handle -> mpred), (atomic_int_at Ews (vint 0) v * ALL g, R g) |-- @fupd mpred (bi_fupd_fupd(BiFUpd := mpred_bi_fupd)) ⊤ ⊤ (EX h, !!(ptr_of h = v /\ name_of h = N) && lock_inv Tsh h (R h)).
+  Lemma make_lock_inv_0' : forall v N (R : lock_handle -> mpred), (atomic_int_at Ews (vint 0) v ∗ ∀ g, R g) ⊢ |={⊤}=> (∃ h, ⌜ptr_of h = v /\ name_of h = N⌝ ∧ lock_inv 1 h (R h)).
   Proof.
     intros.
     iIntros "[a R]".
     iDestruct (atomic_int_isptr with "a") as %Ha.
-    iMod (cinv_alloc_dep with "[a R]") as (g) "[Hi Hg]";
-      [| iExists (v, N, g); unfold lock_inv; simpl; iFrame "Hi Hg"; auto].
-    iIntros (?) "!>"; unfold inv_for_lock.
-    iExists false; iFrame; auto.
+    iMod cinv_alloc_strong as (g) "(_ & Hg & Hi)"; first apply pred_infinite_True.
+    iExists (v, N, g); unfold lock_inv; simpl; iFrame.
+    iMod ("Hi" $! (inv_for_lock v (R (v, N, g))) with "[-]").
+    { iExists false; iFrame; done. }
+    iFrame; done.
   Qed.
 
-  Lemma make_lock_inv_0 : forall v N R, atomic_int_at Ews (vint 0) v * R |-- @fupd mpred (bi_fupd_fupd(BiFUpd := mpred_bi_fupd)) ⊤ ⊤ (EX h, !!(ptr_of h = v /\ name_of h = N) && lock_inv Tsh h R).
+  Lemma make_lock_inv_0 : forall v N R, atomic_int_at Ews (vint 0) v ∗ R ⊢ |={⊤}=> (∃ h, ⌜ptr_of h = v /\ name_of h = N⌝ ∧ lock_inv 1 h R).
   Proof.
     intros.
-    eapply derives_trans, make_lock_inv_0'.
-    cancel.
-    apply allp_right; intros; auto.
+    rewrite -make_lock_inv_0'.
+    by iIntros "($ & $)".
   Qed.
 
   Lemma makelock_inv: funspec_sub (snd makelock_spec) makelock_spec_inv.
   Proof.
-    apply prove_funspec_sub.
-    split; auto. intros. simpl in *. destruct x2 as [[gv N] R]. Intros.
-    iIntros "H !>". iExists nil, gv, emp. rewrite emp_sepcon. iSplit; auto.
-    iPureIntro. intros. Intros. rewrite emp_sepcon. Intros x; Exists x.
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx; simpl. Intros.
-    apply andp_right; [apply andp_left1, derives_refl | apply andp_left2].
-    cancel.
-    apply make_lock_inv_1.
+    split; first done. intros ((gv, N), R) ?; simpl in *. Intros.
+    iIntros "H !>". iExists gv, emp. rewrite bi.emp_sep. iSplit; first done; iSplit; auto.
+    iPureIntro. intros. Intros. rewrite bi.emp_sep. monPred.unseal. Intros x; Exists x.
+    iIntros "(? & $ & $ & ? & _)".
+    iSplit; first done.
+    rewrite bi.sep_emp; by iApply make_lock_inv_1.
   Qed.
 
-  #[local] Obligation Tactic := atomic_nonexpansive_tac.
-
-  Lemma inv_for_lock_super_non_expansive : forall p R n,
-    compcert_rmaps.RML.R.approx n (inv_for_lock p R) =
-    compcert_rmaps.RML.R.approx n (inv_for_lock p (compcert_rmaps.RML.R.approx n R)).
-  Proof.
-    intros; apply nonexpansive_super_non_expansive, inv_for_lock_nonexpansive.
-  Qed.
-  #[local] Hint Resolve inv_for_lock_super_non_expansive : core.
-
   (* Yet another variant: we only learn the lock invariant after a successful acquire. *)
   Program Definition acquire_spec_inv_atomic1 :=
-    ATOMIC TYPE (ConstType _) OBJ R INVS empty
+    ATOMIC TYPE (ConstType val) OBJ R INVS empty
     WITH p
     PRE [ tptr t_lock ]
        PROP ()
@@ -359,16 +263,15 @@ Section PROOFS.
     POST [ tvoid ]
        PROP ()
        LOCAL ()
-       SEP () | (inv_for_lock p R * R).
+       SEP () | (inv_for_lock p R ∗ R).
 
   Lemma acquire_inv_atomic: funspec_sub (snd acquire_spec) acquire_spec_inv_atomic1.
   Proof.
-    apply prove_funspec_sub.
-    split; auto. intros. simpl in *. destruct x2 as (p, Q). Intros.
-    unfold rev_curry, tcurry; simpl. iIntros "H !>". iExists nil.
+    split; first done. intros (p, Q) ?; simpl in *. Intros.
+    unfold rev_curry, tcurry; simpl. iIntros "H !>".
     iExists (p, Q), emp; simpl.
-    rewrite emp_sepcon. iSplit.
-    - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl.
+    rewrite bi.emp_sep. iSplit; first done; iSplit.
+    - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; monPred.unseal.
       iDestruct "H" as "(% & % & _ & H & _)".
       do 4 (iSplit; auto).
       unfold atomic_shift; iAuIntro; unfold atomic_acc; simpl.
@@ -380,13 +283,13 @@ Section PROOFS.
         iExists b; iFrame.
       + iIntros (_) "[[% H1] _]"; subst.
         iDestruct "Hclose" as "[_ Hclose]"; iApply ("Hclose" $! tt).
-        rewrite sepcon_emp; iFrame "R"; iExists true; iFrame.
+        rewrite bi.sep_emp; iFrame "R"; iExists true; iFrame.
     - iPureIntro. iIntros (rho') "[% [_ H]]".
       unfold PROPx, LOCALx, SEPx; simpl; auto.
   Qed.
 
   Program Definition acquire_spec_inv_atomic :=
-    ATOMIC TYPE (ProdType (ConstType _) Mpred) INVS empty
+    ATOMIC TYPE (ProdType (ConstType val) Mpred) INVS empty
     WITH p, R
     PRE [ tptr t_lock ]
        PROP ()
@@ -396,23 +299,14 @@ Section PROOFS.
        PROP ()
        LOCAL ()
        SEP (R) | (inv_for_lock p R).
-  Next Obligation.
-  Proof.
-    intros; rewrite !approx_sepcon; f_equal; auto.
-  Qed.
-  Next Obligation.
-  Proof.
-    rewrite approx_idem; auto.
-  Qed.
 
   Lemma acquire_inv: funspec_sub (snd acquire_spec) acquire_spec_inv_atomic.
   Proof.
-    apply prove_funspec_sub.
-    split; auto. intros. simpl in *. destruct x2 as ((p, R), Q). Intros.
-    unfold rev_curry, tcurry; simpl. iIntros "H !>". iExists nil.
-    iExists (p, Q * R), emp; simpl.
-    rewrite emp_sepcon. iSplit.
-    - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl.
+    split; first done. intros. simpl in *. destruct x2 as ((p, R), Q). Intros.
+    unfold rev_curry, tcurry; simpl. iIntros "H !>".
+    iExists (p, Q ∗ R), emp; simpl.
+    rewrite bi.emp_sep. iSplit; first done; iSplit.
+    - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; monPred.unseal.
       iDestruct "H" as "(% & % & _ & H & _)".
       do 4 (iSplit; auto).
       unfold atomic_shift; iAuIntro; unfold atomic_acc; simpl.
@@ -425,12 +319,12 @@ Section PROOFS.
       + iIntros (_) "[[% H1] _]"; subst.
         iFrame "R".
         iDestruct "Hclose" as "[_ Hclose]"; iApply ("Hclose" $! tt).
-        rewrite sepcon_emp; iExists true; iFrame.
+        rewrite bi.sep_emp; iExists true; iFrame.
     - iPureIntro. iIntros (rho') "[% [_ H]]".
-      unfold PROPx, LOCALx, SEPx; simpl. rewrite <- sepcon_assoc; auto.
+      unfold PROPx, LOCALx, SEPx; simpl. rewrite bi.sep_assoc //.
   Qed.
 
-  (* "lock variant" version where the lock has a parameter held in the global state *)
+(*  (* "lock variant" version where the lock has a parameter held in the global state *)
   Program Definition acquire_spec_inv_variant :=
     ATOMIC TYPE (ProdType (ConstType _) (ArrowType (DependentType 0) Mpred)) OBJ x INVS empty
     WITH p, R
@@ -454,7 +348,7 @@ Section PROOFS.
     split; auto. intros. simpl in *. destruct x2 as ((p, R), Q). Intros.
     unfold rev_curry, tcurry; simpl. iIntros "H !>". iExists nil.
     iExists (p, Q), emp; simpl.
-    rewrite emp_sepcon. iSplit.
+    rewrite bi.emp_sep. iSplit.
     - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl.
       iDestruct "H" as "(% & % & _ & H & _)".
       do 4 (iSplit; auto).
@@ -467,46 +361,30 @@ Section PROOFS.
         iExists b; iFrame.
       + iIntros (_) "[[% H1] _]"; subst.
         iDestruct "Hclose" as "[_ Hclose]"; iApply ("Hclose" $! tt).
-        rewrite sepcon_emp; iFrame "R"; iExists true; iFrame.
+        rewrite bi.sep_emp; iFrame "R"; iExists true; iFrame.
     - iPureIntro. iIntros (rho') "[% [_ H]]".
       unfold PROPx, LOCALx, SEPx; simpl; auto.
-  Qed.
+  Qed.*)
 
   Program Definition release_spec_inv_atomic :=
-    ATOMIC TYPE (ProdType (ConstType _) Mpred) INVS empty
+    ATOMIC TYPE (ProdType (ConstType val) Mpred) INVS empty
     WITH p, R
     PRE [ tptr t_lock ]
        PROP ()
        PARAMS (p)
-       SEP (weak_exclusive_mpred R && emp) | (R * inv_for_lock p R)
+       SEP (<affine> (R ∗ R -∗ False)) | (R ∗ inv_for_lock p R)
     POST [ tvoid ]
        PROP ()
        LOCAL ()
        SEP () | (inv_for_lock p R).
-  Next Obligation.
-  Proof.
-    rewrite !approx_andp; f_equal.
-    apply nonexpansive_super_non_expansive, exclusive_mpred_nonexpansive.
-  Qed.
-  Next Obligation.
-  Proof.
-    intros; rewrite !approx_sepcon approx_idem; f_equal.
-    apply inv_for_lock_super_non_expansive.
-  Qed.
-  Next Obligation.
-  Proof.
-    intros; rewrite !approx_sepcon; f_equal.
-    apply inv_for_lock_super_non_expansive.
-  Qed.
 
   Lemma release_inv: funspec_sub (snd release_spec) release_spec_inv_atomic.
   Proof.
-    apply prove_funspec_sub.
-    split; auto. intros. simpl in *. destruct x2 as ((p, R), Q). Intros.
-    unfold rev_curry, tcurry; simpl. iIntros "H !>". iExists nil.
+    split; first done. intros ((p, R), Q) ?. simpl in *. Intros.
+    unfold rev_curry, tcurry; simpl. iIntros "H !>".
     iExists (p, Q), emp; simpl.
-    rewrite emp_sepcon. iSplit.
-    - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl.
+    rewrite bi.emp_sep. iSplit; first done; iSplit.
+    - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; monPred.unseal.
       iDestruct "H" as "(% & % & _ & H & excl & _)".
       do 4 (iSplit; auto).
       unfold atomic_shift; iAuIntro; unfold atomic_acc; simpl.
@@ -520,83 +398,60 @@ Section PROOFS.
         * iIntros (_) "[H1 _]".
           iDestruct "excl" as "_".
           iDestruct "Hclose" as "[_ Hclose]"; iApply ("Hclose" $! tt).
-          rewrite sepcon_emp; iExists false; iFrame.
-      + iAssert (|> FF) with "[excl R R1]" as ">[]".
-        iNext. iApply weak_exclusive_conflict; iFrame; iFrame.
+          rewrite bi.sep_emp; iExists false; iFrame.
+      + iAssert (▷ False) with "[excl R R1]" as ">[]".
+        rewrite bi.affinely_elim; iApply "excl"; by iFrame.
     - iPureIntro. iIntros (rho') "[% [_ H]]".
       unfold PROPx, LOCALx, SEPx; simpl; auto.
   Qed.
 
-  Definition exclusive_mpred' {A} (P : A -> mpred) := forall x y, P x * P y |-- FF.
-
-  Definition weak_exclusive_mpred' {A} (P : A -> mpred) := unfash (fash (ALL x y, P x * P y --> FF)).
-
-  Lemma approx_unfash_fash : forall n P, compcert_rmaps.RML.R.approx n (unfash (fash P)) = unfash (fash (compcert_rmaps.RML.R.approx n P)).
-  Proof.
-    intros; change unfash with subtypes.unfash; change fash with subtypes.fash; apply predicates_hered.pred_ext; intros ??.
-    - destruct H; intros ??; split; [lia | apply H0; auto].
-    - destruct (H a); auto; split; auto.
-      intros ??; apply H; auto.
-  Qed.
-
-  Lemma exclusive_mpred'_super_non_expansive:
-    forall {A} (R : A -> mpred) n, compcert_rmaps.RML.R.approx n (weak_exclusive_mpred' R) =
-      compcert_rmaps.RML.R.approx n (weak_exclusive_mpred' (fun a => compcert_rmaps.RML.R.approx n (R a))).
-  Proof.
-    intros; unfold weak_exclusive_mpred'.
-    rewrite !approx_unfash_fash; do 2 f_equal.
-    setoid_rewrite allp_nonexpansive; do 2 f_equal; extensionality.
-    setoid_rewrite allp_nonexpansive; do 2 f_equal; extensionality.
-    rewrite approx_imp; do 2 f_equal.
-    - apply approx_sepcon.
-    - apply approx_FF.
-  Qed.
-
-  Lemma fash_allp : forall {B} (F : B -> mpred), fash (allp F) = ALL x, fash (F x).
-  Proof.
-    intros; apply (subtypes.fash_allp B F).
-  Qed.
-
-  Lemma exclusive_weak_exclusive1' : forall {A} (R : A -> mpred) P,
-    exclusive_mpred' R ->
-    P |-- weak_exclusive_mpred' R.
-  Proof.
-    intros; unfold weak_exclusive_mpred'; unfold exclusive_mpred' in H.
-    rewrite fash_allp unfash_allp; apply allp_right; intros x.
-    rewrite fash_allp unfash_allp; apply allp_right; intros y.
-    specialize (H x y).
-    unseal_derives; apply derives_unfash_fash; auto.
-  Qed.
-
-  Lemma exclusive_weak_exclusive' : forall {A} (R : A -> mpred),
-    exclusive_mpred' R ->
-    seplog.emp |-- weak_exclusive_mpred' R && emp.
-  Proof.
-    intros; apply andp_right, derives_refl; apply exclusive_weak_exclusive1'; auto.
-  Qed.
-
-  Lemma corable_weak_exclusive' : forall {A} (R : A -> mpred), corable (weak_exclusive_mpred' R).
-  Proof.
-    intros; apply assert_lemmas.corable_unfash, _.
-  Qed.
+  Program Definition release_spec_inv_atomic1 :=
+    ATOMIC TYPE (ConstType val) OBJ R INVS empty
+    WITH p
+    PRE [ tptr t_lock ]
+       PROP ()
+       PARAMS (p)
+       SEP () | (<affine> (R ∗ R -∗ False) ∗ R ∗ inv_for_lock p R)
+    POST [ tvoid ]
+       PROP ()
+       LOCAL ()
+       SEP () | (inv_for_lock p R).
 
-  Lemma weak_exclusive'_conflict : forall {A} P (x y : A),
-    (weak_exclusive_mpred' P && emp) * P x * P y |-- FF.
+  Lemma release_inv_atomic: funspec_sub (snd release_spec) release_spec_inv_atomic1.
   Proof.
-    intros.
-    rewrite sepcon_assoc -andp_left_corable; last by (apply corable_weak_exclusive').
-    unseal_derives; intros ? [].
-    unfold weak_exclusive_mpred in H; specialize (H a ltac:(lia) x y _ _ (ageable.necR_refl _) (predicates_hered.ext_refl _)).
-    apply H; auto.
+    split; first done. intros (p, Q) ?. simpl in *. Intros.
+    unfold rev_curry, tcurry; simpl. iIntros "H !>".
+    iExists (p, Q), emp; simpl.
+    rewrite bi.emp_sep. iSplit; first done; iSplit.
+    - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; monPred.unseal.
+      iDestruct "H" as "(% & % & _ & H & _)".
+      do 4 (iSplit; auto).
+      unfold atomic_shift; iAuIntro; unfold atomic_acc; simpl.
+      iMod "H" as (R) "[H Hclose]".
+      unfold inv_for_lock at 1.
+      iDestruct "H" as "(excl & R & H1)"; iExists tt.
+      iDestruct "H1" as (b) "[H1 R1]".
+      destruct b.
+      iFrame "H1".
+      iModIntro; iSplit.
+      + iIntros "H1"; iApply "Hclose".
+        iFrame "excl R"; iExists true; iFrame.
+      + iIntros (_) "[H1 _]".
+        iDestruct "Hclose" as "[_ Hclose]"; iApply ("Hclose" $! tt).
+        rewrite bi.sep_emp; iExists false; iFrame.
+      + iAssert (▷ False) with "[excl R R1]" as ">[]".
+        rewrite bi.affinely_elim; iApply "excl"; by iFrame.
+    - iPureIntro. iIntros (rho') "[% [_ H]]".
+      unfold PROPx, LOCALx, SEPx; simpl; auto.
   Qed.
 
-  Program Definition release_spec_inv_variant :=
+(*  Program Definition release_spec_inv_variant :=
     ATOMIC TYPE (ProdType (ProdType (ConstType _) (ArrowType (DependentType 0) Mpred)) (DependentType 0)) OBJ y INVS empty
     WITH p, R, x
     PRE [ tptr t_lock ]
        PROP ()
        PARAMS (p)
-       SEP (weak_exclusive_mpred' R && emp) | (R x * inv_for_lock p (R y))
+       SEP (<affine> (R ∗ R -∗ False)) | (R x ∗ inv_for_lock p (R y))
     POST [ tvoid ]
        PROP ()
        LOCAL ()
@@ -623,7 +478,7 @@ Section PROOFS.
     split; auto. intros. simpl in *. destruct x2 as (((p, R), x), Q). Intros.
     unfold rev_curry, tcurry; simpl. iIntros "H !>". iExists nil.
     iExists (p, Q), emp; simpl.
-    rewrite emp_sepcon. iSplit.
+    rewrite bi.emp_sep. iSplit.
     - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl.
       iDestruct "H" as "(% & % & _ & H & excl & _)".
       do 4 (iSplit; auto).
@@ -638,17 +493,15 @@ Section PROOFS.
         * iIntros (_) "[H1 _]".
           iDestruct "excl" as "_".
           iDestruct "Hclose" as "[_ Hclose]"; iApply ("Hclose" $! tt).
-          rewrite sepcon_emp; iExists false; iFrame.
-      + iAssert (|> FF) with "[excl R R1]" as ">[]".
+          rewrite bi.sep_emp; iExists false; iFrame.
+      + iAssert (▷ False) with "[excl R R1]" as ">[]".
         iNext. iApply weak_exclusive'_conflict; iFrame; iFrame.
     - iPureIntro. iIntros (rho') "[% [_ H]]".
       unfold PROPx, LOCALx, SEPx; simpl; auto.
-  Qed.
-
-  #[local] Obligation Tactic := intros.
+  Qed.*)
 
   Program Definition acquire_spec_inv :=
-    TYPE (ProdType (ConstType _) Mpred)
+    TYPE (ProdType (ConstType (Qp * lock_handle)) Mpred)
     WITH sh : _, h : _, R : _
     PRE [ tptr t_lock ]
        PROP ()
@@ -657,55 +510,34 @@ Section PROOFS.
     POST [ tvoid ]
        PROP ()
        LOCAL ()
-       SEP (lock_inv sh h R; |> R).
-  Next Obligation.
-  Proof.
-    repeat intro.
-    destruct x as ((?, ?), ?); simpl.
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; do 3 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    apply lock_inv_super_non_expansive.
-  Qed.
-  Next Obligation.
-  Proof.
-    repeat intro.
-    destruct x as ((?, ?), ?); simpl.
-    unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    f_equal. apply lock_inv_super_non_expansive.
-    setoid_rewrite later_nonexpansive; rewrite approx_idem; auto.
-  Qed.
+       SEP (lock_inv sh h R; ▷ R).
 
   Lemma acquire_inv_simple: funspec_sub (snd acquire_spec) acquire_spec_inv.
   Proof.
-    apply prove_funspec_sub.
-    split; auto. intros. simpl in *. destruct x2 as ((sh, h), R). Intros.
-    unfold rev_curry, tcurry. iIntros "H !>". iExists nil.
-    iExists (@ptr_of atomic_impl h, @lock_inv atomic_impl sh h R * |> R), emp; simpl.
-    rewrite emp_sepcon. iSplit.
-    - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx; simpl.
+    split; first done. intros ((sh, h), R) ?. simpl in *. Intros.
+    unfold rev_curry, tcurry. iIntros "H !>".
+    iExists (ptr_of(lock_impl := atomic_impl) h, lock_inv(lock_impl := atomic_impl) sh h R ∗ ▷ R), emp; simpl.
+    rewrite bi.emp_sep. iSplit; first done; iSplit.
+    - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx; simpl; monPred.unseal.
       iDestruct "H" as "(_ & % & _ & H & _)".
       do 4 (iSplit; auto).
       unfold lock_inv; simpl; destruct h as ((v, i), g).
-      iDestruct "H" as "(([% %] & #H) & H2)".
+      iDestruct "H" as "(% & #H & H2)".
       unfold atomic_shift. iAuIntro. unfold atomic_acc; simpl.
-      iInv "H" as "inv" "Hclose".
-      iDestruct "inv" as "[inv | >inv]".
+      iInv "H" as "(inv & H2)" "Hclose".
       iDestruct "inv" as (b) "[>H1 R]".
       iApply fupd_mask_intro; try set_solver. iIntros "Hclose'".
       iExists b; iFrame "H1"; iSplit.
       + iIntros "H1"; iFrame "H2".
         iMod "Hclose'"; iApply "Hclose".
-        iLeft; iExists b; iFrame.
+        iExists b; iFrame.
       + iIntros (_) "[[% H1] _]"; subst.
         rewrite -> prop_true_andp by auto.
         iFrame "H H2 R".
         iMod "Hclose'"; iApply "Hclose".
-        iLeft; iExists true; iFrame; auto.
-      + iDestruct (own_valid_2 with "[$H2 $inv]") as %(? & J & ?).
-        apply sepalg.join_comm, join_Tsh in J as []; contradiction.
+        iExists true; iFrame; auto.
     - iPureIntro. iIntros (rho') "[% [_ H]]".
-      unfold PROPx, LOCALx, SEPx; simpl. rewrite <- sepcon_assoc; auto.
+      unfold PROPx, LOCALx, SEPx; simpl. rewrite bi.sep_assoc //.
   Qed.
 
   Program Definition release_spec_inv :=
@@ -714,200 +546,135 @@ Section PROOFS.
     PRE [ tptr t_lock ]
        PROP ()
        PARAMS (ptr_of h)
-       SEP (weak_exclusive_mpred R && emp; lock_inv sh h R; P; lock_inv sh h R * P -* Q * R)
+       SEP (<affine> (R ∗ R -∗ False); lock_inv sh h R; P; lock_inv sh h R ∗ P -∗ Q ∗ R)
     POST [ tvoid ]
        PROP ()
        LOCAL ()
-       SEP (|> Q).
-  Next Obligation.
-  Proof.
-    repeat intro.
-    destruct x as ((((?, ?), ?), ?), ?); simpl.
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; do 3 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    f_equal.
-    { rewrite !approx_andp; f_equal.
-      apply exclusive_mpred_super_non_expansive. }
-    f_equal.
-    { apply lock_inv_super_non_expansive. }
-    f_equal.
-    setoid_rewrite wand_nonexpansive; rewrite !approx_sepcon; do 2 f_equal; rewrite !approx_idem; f_equal.
-    apply lock_inv_super_non_expansive.
-  Qed.
-  Next Obligation.
-  Proof.
-    repeat intro.
-    destruct x as ((((?, ?), ?), ?), ?); simpl.
-    unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    setoid_rewrite later_nonexpansive; rewrite approx_idem; auto.
-  Qed.
+       SEP (▷ Q).
 
   Lemma release_inv_simple: funspec_sub (snd release_spec) release_spec_inv.
   Proof.
-    apply prove_funspec_sub.
-    split; auto. intros. simpl in *. destruct x2 as ((((sh, h), R), P), Q). Intros.
-    unfold rev_curry, tcurry. iIntros "H !>". iExists nil.
-    iExists (@ptr_of atomic_impl h, |> Q), emp. simpl in *.
-    rewrite emp_sepcon. iSplit.
-    - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl.
+    split; first done. intros ((((sh, h), R), P), Q) ?. simpl in *. Intros.
+    unfold rev_curry, tcurry. iIntros "H !>".
+    iExists (ptr_of(lock_impl := atomic_impl) h, ▷ Q), emp. simpl in *.
+    rewrite bi.emp_sep. iSplit; first done; iSplit.
+    - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; monPred.unseal.
       iDestruct "H" as "(_ & % & _ & H)".
       do 4 (iSplit; auto).
       iDestruct "H" as "(H5 & H2 & H3 & H4 & _)".
       unfold lock_inv; simpl; unfold atomic_lock_inv; destruct h as ((v, i), g).
-      iDestruct "H2" as "(([% %] & #H) & H2)".
+      iDestruct "H2" as "(% & #H & H2)".
       rewrite -> prop_true_andp by auto.
       unfold atomic_shift. iAuIntro. unfold atomic_acc; simpl.
       iInv "H" as "inv" "Hclose".
-      iDestruct "inv" as "[inv | >inv]".
+      iDestruct "inv" as "(inv & H2)".
       unfold inv_for_lock at 3.
       iDestruct "inv" as (b) "[>H1 R]".
       iExists tt.
       destruct b.
-      + iApply fupd_mask_intro; try set_solver. iIntros "Hclose'".
+      + iApply fupd_mask_intro; first by set_solver. iIntros "Hclose'".
         iFrame "H1"; iSplit.
         * iIntros "H1". iFrame. iMod "Hclose'"; iApply "Hclose".
-          iLeft; unfold inv_for_lock; iExists true; iFrame; auto.
+          unfold inv_for_lock; iExists true; iFrame; auto.
         * iIntros (_) "[H1 _]". iDestruct "H5" as "_". iPoseProof ("H4" with "[$H2 $H3]") as "[$ HR]"; auto.
           iMod "Hclose'"; iMod ("Hclose" with "[-]"); last done.
-          iLeft; unfold inv_for_lock; iExists false; iFrame; auto.
+          unfold inv_for_lock; iExists false; iFrame; auto.
       + iPoseProof ("H4" with "[$H2 $H3]") as "[$ HR]"; auto.
-        iAssert (|>FF) with "[H5 R HR]" as ">[]".
-        iNext; iApply weak_exclusive_conflict; iFrame; iFrame.
-      + iDestruct (own_valid_2 with "[$H2 $inv]") as %(? & J & ?).
-        apply sepalg.join_comm, join_Tsh in J as []; contradiction.
+        iAssert (▷False) with "[H5 R HR]" as ">[]".
+        rewrite bi.affinely_elim; iApply "H5"; iFrame.
     - iPureIntro. iIntros (rho') "[% [_ H]]".
       unfold PROPx, LOCALx, SEPx; simpl; auto.
   Qed.
 
   Lemma release_simple : funspec_sub (snd release_spec) release_spec_simple.
   Proof.
-    apply prove_funspec_sub.
-    split; auto. intros. simpl in *. destruct x2 as ((sh, h), R). Intros.
-    unfold rev_curry, tcurry. iIntros "H !>". iExists nil.
-    iExists (@ptr_of atomic_impl h, @lock_inv atomic_impl sh h R), emp. simpl in *.
-    rewrite emp_sepcon. iSplit.
-    - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl.
-      iDestruct "H" as "([% _] & % & _ & H)".
+    split; first done. intros ((sh, h), R) ?. simpl in *. Intros.
+    unfold rev_curry, tcurry. iIntros "H !>".
+    iExists (ptr_of(lock_impl := atomic_impl) h, lock_inv(lock_impl := atomic_impl) sh h R), emp. simpl in *.
+    rewrite bi.emp_sep. iSplit; first done; iSplit.
+    - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; monPred.unseal.
+      iDestruct "H" as "(% & % & _ & H)".
       do 4 (iSplit; auto).
       iDestruct "H" as "(H5 & H2 & H3 & _)".
       unfold lock_inv; simpl; unfold atomic_lock_inv; destruct h as ((v, i), g).
-      iDestruct "H2" as "(([_ %] & #H) & H2)".
-      rewrite -> prop_true_andp by auto.
+      iDestruct "H2" as "(% & #H & H2)".
       unfold atomic_shift. iAuIntro. unfold atomic_acc; simpl.
       iInv "H" as "inv" "Hclose".
-      iDestruct "inv" as "[inv | >inv]".
+      iDestruct "inv" as "(inv & H2)".
       unfold inv_for_lock at 3.
       iDestruct "inv" as (b) "[>H1 R]".
       iExists tt.
       destruct b.
-      + iApply fupd_mask_intro; try set_solver. iIntros "Hclose'".
+      + iApply fupd_mask_intro; first by set_solver. iIntros "Hclose'".
         iFrame "H1"; iSplit.
         * iIntros "H1". iFrame. iMod "Hclose'"; iApply "Hclose".
-          iLeft; unfold inv_for_lock; iExists true; iFrame; auto.
-        * iIntros (_) "[H1 _]". iDestruct "H5" as "_". iDestruct "R" as ">_". iFrame "H H2".
+          unfold inv_for_lock; iExists true; iFrame; auto.
+        * iIntros (_) "[H1 _]". iDestruct "H5" as "_". rewrite -> prop_true_andp by done. iFrame "H H2".
           iMod "Hclose'"; iApply "Hclose".
-          iLeft; unfold inv_for_lock; iExists false; iFrame; auto.
-      + iAssert (|>FF) with "[H5 R H3]" as ">[]".
-        iNext; iApply weak_exclusive_conflict; iFrame; iFrame.
-      + iDestruct (own_valid_2 with "[$H2 $inv]") as %(? & J & ?).
-        apply sepalg.join_comm, join_Tsh in J as []; contradiction.
+          unfold inv_for_lock; iExists false; iFrame; auto.
+      + iAssert (▷False) with "[H5 R H3]" as ">[]".
+        rewrite bi.affinely_elim; iApply "H5"; iFrame.
     - iPureIntro. iIntros (rho') "[% [_ H]]".
       unfold PROPx, LOCALx, SEPx; simpl; auto.
   Qed.
 
-  Program Definition release_spec_self :=
-    TYPE (ProdType (ConstType _) Mpred)
-    WITH sh : _, h : _, R : _
-    PRE [ tptr t_lock ]
-       PROP ()
-       PARAMS (ptr_of h)
-       SEP (lock_inv sh h (self_part sh h * R); R)
-    POST [ tvoid ]
-       PROP ()
-       LOCAL ()
-       SEP ().
-  Next Obligation.
-  Proof.
-    repeat intro.
-    destruct x as ((?, ?), ?); simpl.
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; do 3 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    f_equal.
-    setoid_rewrite (@lock_inv_super_non_expansive atomic_impl); do 2 f_equal.
-    rewrite !approx_sepcon approx_idem; auto.
-  Qed.
-  Next Obligation.
-  Proof.
-    repeat intro.
-    destruct x as ((?, ?), ?); simpl.
-    reflexivity.
-  Qed.
-
-  #[local] Hint Resolve self_part_exclusive : core.
-
   Lemma release_self : funspec_sub (snd release_spec) release_spec_self.
   Proof.
-    apply prove_funspec_sub.
-    split; auto. intros. simpl in *. destruct x2 as ((sh, h), R). Intros.
-    unfold rev_curry, tcurry. iIntros "H !>". iExists nil.
+    split; first done. intros ((sh, h), R) ?. simpl in *. Intros.
+    unfold rev_curry, tcurry. iIntros "H !>".
     destruct h as ((v, N), g).
     iExists (v, emp), emp. simpl in *.
-    rewrite emp_sepcon. iSplit.
-    - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl.
+    rewrite bi.emp_sep. iSplit; first done; iSplit.
+    - unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; monPred.unseal.
       iDestruct "H" as "(_ & % & _ & H)".
       do 4 (iSplit; auto).
-      iDestruct "H" as "(H & R & _)".
+      iDestruct "H" as "(Hexcl & H & R & _)".
       unfold lock_inv; simpl.
-      iDestruct "H" as "(([% %] & #H) & H2)".
+      iDestruct "H" as "(% & #H & H2)".
       unfold atomic_shift. iAuIntro. unfold atomic_acc; simpl.
       iInv "H" as "inv" "Hclose".
-      iDestruct "inv" as "[inv | >inv]".
+      iDestruct "inv" as "(inv & H2)".
       unfold inv_for_lock at 2.
       iDestruct "inv" as (b) "[>H1 HR]".
       iExists tt.
       destruct b.
-      + iApply fupd_mask_intro; try set_solver. iIntros "Hclose'".
+      + iApply fupd_mask_intro; first by set_solver. iIntros "Hclose'".
         iFrame "H1"; iSplit.
         * iIntros "H1". iFrame. iMod "Hclose'"; iApply "Hclose".
-          iLeft; unfold inv_for_lock; iExists true; iFrame; auto.
+          unfold inv_for_lock; iExists true; iFrame; auto.
         * iIntros (_) "[H1 _]".
           iMod "Hclose'"; iApply "Hclose".
-          iLeft; unfold inv_for_lock; iExists false; iFrame; auto.
-      + iDestruct "HR" as "[>Hg ?]".
-        iDestruct (own_valid_2 with "[$H2 $Hg]") as %(? & J & ?).
-        apply sepalg.join_self, identity_share_bot in J; contradiction.
-      + iDestruct (own_valid_2 with "[$H2 $inv]") as %(? & J & ?).
-        apply sepalg.join_comm, join_Tsh in J as []; contradiction.
+          unfold inv_for_lock; iExists false; iFrame; auto.
+      + iDestruct "HR" as "[>Hg R']".
+        iAssert (▷False) with "[Hexcl R R']" as ">[]".
+        rewrite bi.affinely_elim; iApply "Hexcl"; by iFrame.
     - iPureIntro. iIntros (rho') "[% [_ H]]".
-      unfold PROPx, LOCALx, SEPx; simpl; auto.
+      unfold PROPx, LOCALx, SEPx; simpl. rewrite bi.sep_emp //.
   Qed.
 
   Lemma freelock_inv: funspec_sub (snd freelock_spec) lock_specs.freelock_spec.
   Proof.
-    apply prove_funspec_sub.
-    split; auto. intros. simpl in *. destruct x2 as ((h, R), P). Intros.
-    iIntros "H". iExists nil, (@ptr_of atomic_impl h), P.
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl.
-    rewrite !sepcon_emp. iDestruct "H" as "(_ & % & % & H1 & HP & R)".
+    split; first done. intros ((h, R), P) ?. simpl in *. Intros.
+    iIntros "H". iExists (ptr_of(lock_impl := atomic_impl) h), P.
+    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; monPred.unseal.
+    rewrite !bi.sep_emp. iDestruct "H" as "(_ & % & % & H1 & HP & R)".
     unfold lock_inv; simpl; unfold atomic_lock_inv; destruct h as ((v, i), g).
-    iDestruct "H1" as "(([% %] & #H) & H2)".
-    iInv "H" as "[inv | inv]" "Hclose".
+    iDestruct "H1" as "(% & #H & H2)".
+    iMod (cinv_acc_strong with "H H2") as "(inv & H2 & Hclose)"; first done.
     iDestruct "inv" as (b) "[>a HR]".
     destruct b.
-    iMod "HR" as "_"; iDestruct "R" as "_".
+    iDestruct "R" as "_".
     iMod ("Hclose" with "[H2]") as "_".
-    { iRight; auto. }
-    iFrame "HP"; iModIntro; iSplit.
+    { by iRight. }
+    rewrite -(union_difference_L (↑i) ⊤) //.
+    iFrame "HP"; iModIntro; iSplit; first done; iSplit.
     - do 3 (iSplit; auto).
-      iExists _; iApply "a".
+      iExists _; iFrame. admit. (* emp not timeless *)
     - iPureIntro; intros; Intros; cancel.
-      apply andp_left2; auto.
-    - iAssert (|>FF) with "[R HP HR H2]" as ">[]".
-      iNext; iApply "R"; iFrame; iSplit; auto.
-    - iAssert (|>FF) with "[H2 inv]" as ">[]".
-      iNext; iApply cinv_own_excl; [|iFrame]; auto.
-  Qed.
+      iIntros "($ & $)".
+    - iAssert (▷False) with "[R HP HR H2]" as ">[]".
+      iNext; rewrite bi.affinely_elim; iApply "R"; iFrame; iSplit; auto.
+  Admitted.
 
   Lemma freelock_simple: funspec_sub (snd freelock_spec) freelock_spec_simple.
   Proof.
@@ -918,68 +685,49 @@ Section PROOFS.
     TYPE (ProdType (ConstType _) Mpred)
     WITH sh1 : _, sh2 : _, h : _, R : _
     PRE [ tptr t_lock ]
-       PROP (sh2 <> Share.bot; sepalg.join sh1 sh2 Tsh)
+       PROP (sh1 ⋅ sh2 = 1%Qp)
        PARAMS (ptr_of h)
-       SEP (lock_inv sh1 h (self_part sh2 h * R); self_part sh2 h)
+       SEP (lock_inv sh1 h (self_part sh2 h ∗ R); self_part sh2 h)
     POST [ tvoid ]
        PROP ()
        LOCAL ()
        SEP ().
-  Next Obligation.
-  Proof.
-    repeat intro.
-    destruct x as (((?, ?), ?), ?); simpl.
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; do 3 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    f_equal.
-    setoid_rewrite (@lock_inv_super_non_expansive atomic_impl); do 2 f_equal.
-    rewrite !approx_sepcon approx_idem; auto.
-  Qed.
-  Next Obligation.
-  Proof.
-    repeat intro.
-    destruct x as (((?, ?), ?), ?); simpl.
-    unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  Qed.
-
-  Lemma lock_inv_share : forall sh h R, lock_inv sh h R |-- !!(sh <> Share.bot /\ isptr (ptr_of h)).
-  Proof.
-    intros; destruct h as ((?, ?), ?); unfold lock_inv; simpl; Intros; entailer!.
-  Qed.
 
   Lemma freelock_self : funspec_sub (snd freelock_spec) freelock_spec_self.
   Proof.
     eapply funspec_sub_trans; [apply freelock_inv|].
-    apply prove_funspec_sub.
-    split; auto; intros ? (((sh1, sh2), h), R) ?; Intros; simpl.
+    split; first done; intros (((sh1, sh2), h), R) ?; Intros; simpl.
     iIntros "H !>".
-    iExists nil, (h, self_part sh2 h * R, emp), emp.
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl.
-    rewrite !emp_sepcon !sepcon_emp.
-    iDestruct "H" as "((% & % & _) & % & % & H)".
-    iSplit; [do 3 (iSplit; [auto|])|].
-    - iAssert (⌜sh1 <> Share.bot⌝) with "[H]" as %?.
-      { iDestruct "H" as "[l _]"; iDestruct (lock_inv_share with "l") as %[]; auto. }
-      erewrite -> self_part_eq, lock_inv_share_join by eauto; iFrame.
-      iSplit; auto; iIntros "H".
-      rewrite <- sepcon_assoc, self_part_eq by auto.
+    iExists (h, self_part sh2 h ∗ R, emp), emp.
+    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; monPred.unseal.
+    iDestruct "H" as "((% & _) & % & % & H)".
+    iSplit; first done; iSplit; [do 4 (iSplit; [auto|])|].
+    - erewrite !bi.sep_emp, !bi.emp_sep, -> self_part_eq, lock_inv_share_join, H0 by eauto; iFrame.
+      iIntros "!> H".
+      rewrite assoc self_part_eq.
       destruct h as ((p, i), g); unfold lock_inv; simpl.
-      iDestruct "H" as "[[[_ g1] [_ g2]] _]".
-      iApply (cinv_own_excl with "[$g1 $g2]"); auto.
+      iDestruct "H" as "[[(_ & _ & g1) (_ & _ & g2)] _]".
+      iApply (cinv_own_1_l with "g1 g2").
     - iPureIntro; intros; Intros.
-      rewrite emp_sepcon; apply andp_left2; auto.
+      rewrite bi.emp_sep bi.sep_emp; auto.
   Qed.
 
-End PROOFS.
+(* export atomic lock specs *)
+Definition concurrent_specs (cs : compspecs) (ext_link : string -> ident) :=
+  (ext_link "spawn"%string, spawn_spec) ::
+  (makelock_spec) ::
+  (freelock_spec) ::
+  (acquire_spec) ::
+  (release_spec) ::
+  nil.
 
-Notation selflock R sh h := (self_part sh h * R).
+#[export] Instance concurrent_ext_spec (cs : compspecs) (ext_link : string -> ident) : ext_spec OK_ty :=
+  add_funspecs_rec OK_ty
+    ext_link
+    (void_spec OK_ty)
+    (concurrent_specs cs ext_link).
 
-#[export] Hint Resolve self_part_exclusive : core.
-#[export] Hint Resolve lock_inv_share : saturate_local.
-
-Ltac lock_props ::= match goal with |-context[weak_exclusive_mpred ?P && _] => sep_apply (exclusive_weak_exclusive P); [auto with share | try timeout 20 cancel]
-  | |-context[weak_exclusive_mpred' ?P && _] => sep_apply (exclusive_weak_exclusive' P); [auto with share | try timeout 20 cancel] end.
+End PROOFS.
 
 (* when interacting with atomic updates, we need to unfold the definition of lock_inv and split its pieces *)
 Ltac unfold_lock_inv := match goal with |-context[lock_inv _ ?h _] =>
diff --git a/coq-vst.opam b/builddep/coq-vst-on-iris-builddep.opam
similarity index 77%
rename from coq-vst.opam
rename to builddep/coq-vst-on-iris-builddep.opam
index e16b2d7534..360a84d028 100644
--- a/coq-vst.opam
+++ b/builddep/coq-vst-on-iris-builddep.opam
@@ -1,4 +1,5 @@
 opam-version: "2.0"
+name: "coq-vst-on-iris-builddep"
 version: "dev"
 synopsis: "Verified Software Toolchain"
 description: "The software toolchain includes static analyzers to check assertions about your program; optimizing compilers to translate your program to machine language; operating systems and libraries to supply context for your program. The Verified Software Toolchain project assures with machine-checked proofs that the assertions claimed at the top of the toolchain really hold in the machine-language program, running in the operating-system context."
@@ -23,21 +24,9 @@ dev-repo: "git+https://github.com/PrincetonUniversity/VST.git"
 bug-reports: "https://github.com/PrincetonUniversity/VST/issues"
 license: "https://raw.githubusercontent.com/PrincetonUniversity/VST/master/LICENSE"
 
-build: [
-  [make "-j%{jobs}%" "vst" "IGNORECOQVERSION=true" "ZLIST=platform" "BITSIZE=64"]
-]
-install: [
-  [make "install" "IGNORECOQVERSION=true" "ZLIST=platform" "BITSIZE=64"]
-]
-run-test: [
-  [make "-j%{jobs}%" "test" "IGNORECOQVERSION=true" "ZLIST=platform" "BITSIZE=64"]
-]
 depends: [
   "coq" {>= "8.14" & < "8.17~"}
   "coq-compcert" {>= "3.11"}
   "coq-vst-zlist" {>= "2.11"}
   "coq-flocq" {>= "4.1.0"}
 ]
-url {
-  src: "git+https://github.com/PrincetonUniversity/VST.git#master"
-}
diff --git a/concurrency/cancelable_invariants.v b/concurrency/cancelable_invariants.v
deleted file mode 100644
index fe77a0c81d..0000000000
--- a/concurrency/cancelable_invariants.v
+++ /dev/null
@@ -1,112 +0,0 @@
-(* recapitulate iris/base_logic/lib/cancelable_invariants.v *)
-Require Import Ensembles.
-Require Import VST.msl.shares.
-Require Import VST.veric.shares.
-Require Import VST.msl.ghost.
-Require Import VST.msl.ghost_seplog.
-Require Import VST.veric.invariants.
-Require Import VST.veric.fupd.
-Require Import VST.concurrency.conclib.
-
-#[export] Program Instance share_ghost : Ghost := { G := share; valid _ := True }.
-
-Definition cinv_own g sh := own(RA := share_ghost) g sh compcert_rmaps.RML.R.NoneP.
-
-Definition cinvariant i g P := invariant i (P || cinv_own g Tsh).
-
-Lemma cinvariant_dup : forall i g P, cinvariant i g P = cinvariant i g P * cinvariant i g P.
-Proof.
-  intros; apply invariant_dup.
-Qed.
-
-Lemma cinv_alloc_dep : forall E P, (ALL i g, |> P i g) |-- |={E}=> EX i : _, EX g : _, cinvariant i g (P i g) * cinv_own g Tsh.
-Proof.
-  intros.
-  rewrite <- emp_sepcon at 1.
-  sep_eapply (own_alloc(RA := share_ghost)).
-  sep_apply bupd_frame_r.
-  eapply derives_trans, fupd_trans.
-  eapply derives_trans, bupd_fupd; apply bupd_mono.
-  Intros g.
-  eapply derives_trans; [eapply sepcon_derives, derives_trans, inv_alloc_dep; [apply derives_refl|]|].
-  2: { sep_eapply fupd_frame_l; apply fupd_mono.
-       Intros i; Exists i g.
-       rewrite sepcon_comm; apply derives_refl. }
-  apply allp_derives; intros.
-  apply allp_left with g.
-  apply later_derives, orp_right1, derives_refl.
-Qed.
-
-Lemma cinv_alloc : forall E P, |> P |-- |={E}=> EX i : _, EX g : _, cinvariant i g P * cinv_own g Tsh.
-Proof.
-  intros; eapply derives_trans, cinv_alloc_dep.
-  do 2 (apply allp_right; intros); auto.
-Qed.
-
-Lemma cinv_own_excl : forall g sh, sh <> Share.bot -> cinv_own g Tsh * cinv_own g sh |-- FF.
-Proof.
-  intros; unfold cinv_own; sep_apply own_valid_2; Intros.
-  destruct H0 as (? & J & ?).
-  apply join_Tsh in J as []; contradiction.
-Qed.
-
-Lemma cinv_cancel : forall E i g P, Ensembles.In E i -> cinvariant i g P * cinv_own g Tsh |-- |={E}=> |> P.
-Proof.
-  intros.
-  unfold cinvariant.
-  sep_apply (inv_open E).
-  sep_apply fupd_frame_r; apply fupd_elim.
-  rewrite later_orp, !distrib_orp_sepcon; apply orp_left.
-  - sep_apply (modus_ponens_wand' (cinv_own g Tsh)).
-    { apply orp_right2, now_later. }
-    sep_apply fupd_frame_r; rewrite emp_sepcon; auto.
-  - eapply derives_trans, except_0_fupd.
-    apply orp_right1.
-    rewrite sepcon_assoc; eapply derives_trans; [apply sepcon_derives, now_later; apply derives_refl|].
-    rewrite <- later_sepcon; apply later_derives.
-    sep_apply cinv_own_excl; auto with share.
-    rewrite FF_sepcon; auto.
-Qed.
-
-Lemma cinv_open : forall E sh i g P, sh <> Share.bot -> Ensembles.In E i ->
-  cinvariant i g P * cinv_own g sh |-- |={E, Ensembles.Subtract E i}=> |> P * cinv_own g sh * (|> P -* |={Ensembles.Subtract E i, E}=> emp).
-Proof.
-  intros.
-  unfold cinvariant.
-  sep_apply (inv_open E).
-  sep_apply fupd_frame_r; apply fupd_elim.
-  rewrite later_orp, !distrib_orp_sepcon; apply orp_left.
-  - eapply derives_trans, fupd_intro; cancel.
-    apply wand_derives; auto.
-    apply orp_right1; auto.
-  - eapply derives_trans, except_0_fupd.
-    apply orp_right1.
-    rewrite sepcon_assoc; eapply derives_trans; [apply sepcon_derives, now_later; apply derives_refl|].
-    rewrite <- later_sepcon; apply later_derives.
-    rewrite (sepcon_comm _ (cinv_own g sh)), <- sepcon_assoc.
-    sep_apply cinv_own_excl.
-    rewrite FF_sepcon; auto.
-Qed.
-
-Lemma cinvariant_nonexpansive : forall i g, nonexpansive (cinvariant i g).
-Proof.
-  intros; apply invariant_nonexpansive2.
-  apply @disj_nonexpansive, const_nonexpansive.
-  apply identity_nonexpansive.
-Qed.
-
-Lemma cinvariant_nonexpansive2 : forall i g f, nonexpansive f ->
-  nonexpansive (fun a => cinvariant i g (f a)).
-Proof.
-  intros; apply invariant_nonexpansive2.
-  apply @disj_nonexpansive, const_nonexpansive; auto.
-Qed.
-
-Lemma cinvariant_super_non_expansive : forall i g R n, compcert_rmaps.RML.R.approx n (cinvariant i g R) =
-  compcert_rmaps.RML.R.approx n (cinvariant i g (compcert_rmaps.RML.R.approx n R)).
-Proof.
-  intros; unfold cinvariant.
-  rewrite invariant_super_non_expansive; setoid_rewrite invariant_super_non_expansive at 2; do 2 f_equal.
-  rewrite !approx_orp; f_equal.
-  rewrite approx_idem; auto.
-Qed.
diff --git a/concurrency/common/ClightSemanticsForMachines.v b/concurrency/common/ClightSemanticsForMachines.v
index 5eaf0c9a93..c146de3d9d 100644
--- a/concurrency/common/ClightSemanticsForMachines.v
+++ b/concurrency/common/ClightSemanticsForMachines.v
@@ -8,8 +8,6 @@
 *)
 
 Require Import compcert.common.Memory.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.juicy_mem.
 Require Import VST.veric.res_predicates.
 
 (*IM using proof irrelevance!*)
@@ -18,12 +16,15 @@ Require Import ProofIrrelevance.
 Require Import List. Import ListNotations.
 
 (* The concurrent machinery*)
-Require Import VST.concurrency.common.core_semantics.
+(*Require Import VST.concurrency.common.core_semantics.*)
+Require Import VST.sepcomp.mem_lemmas.
+Require Import VST.concurrency.memsem_lemmas.
 Require Import VST.concurrency.common.scheduler.
 Require Import VST.concurrency.common.HybridMachineSig.
 Require Import VST.concurrency.common.semantics.
 Require Import VST.concurrency.common.lksize.
 Require Import VST.concurrency.common.permissions.
+Require Import VST.concurrency.common.dry_machine_lemmas.
 
 Import Ctypes. 
 Require Import compcert.cfrontend.Clight.
@@ -32,621 +33,25 @@ Arguments sizeof {env} !t / .
 
 (*Semantics*)
 Require Import VST.veric.Clight_core.
-Require Import VST.veric.Clightcore_coop. 
+Require Import VST.veric.Clightcore_coop.
 Require Import VST.sepcomp.event_semantics.
+Require Import VST.veric.Clight_evsem.
 
 Set Bullet Behavior "Strict Subproofs".
 
-Lemma extcall_malloc_sem_inv: forall g v m t res m2 (E:Events.extcall_malloc_sem g v m t res m2),
-  exists m1 b (sz : ptrofs), v=[Vptrofs sz] /\ t= Events.E0 /\ res=Vptr b Ptrofs.zero /\
-                           Mem.alloc m (- size_chunk Mptr) (Ptrofs.unsigned sz) = (m1, b) /\
-                           Mem.store Mptr m1 b (- size_chunk Mptr) (Vptrofs sz) = Some m2. 
-Proof. intros.  inv E. exists m', b, sz. intuition. Qed.
+Lemma at_external_SEM_eq:
+   forall ge c m, semantics.at_external (CLC_evsem ge) c m =
+   match c with
+   | Callstate (External ef _ _ _) args _ => 
+       if ef_inline ef then None else Some (ef, args)
+   | _ => None
+ end.
+Proof. auto. Qed.
 
+#[export] Instance ClightSem ge : Semantics :=
+  { semG := G; semC := C; semSem := CLC_evsem ge; the_ge := ge }.
 
-Inductive deref_locT (ty : type) (m : mem) (b : block) (ofs : ptrofs) : val -> list mem_event -> Prop :=
-    deref_locT_value : forall (chunk : memory_chunk) bytes,
-                      access_mode ty = By_value chunk ->
-                      (align_chunk chunk | (Ptrofs.unsigned ofs)) ->
-                      Mem.loadbytes m b (Ptrofs.unsigned ofs) (size_chunk chunk) = Some bytes ->
-(*                      Mem.load chunk m b (Ptrofs.unsigned ofs) = Some (decode_val chunk bytes) ->*)
-                      deref_locT ty m b ofs (decode_val chunk bytes) (Read b (Ptrofs.unsigned ofs) (size_chunk chunk) bytes :: nil)
-  | deref_locT_reference : access_mode ty = By_reference -> deref_locT ty m b ofs (Vptr b ofs) nil
-  | deref_locT_copy : access_mode ty = By_copy -> deref_locT ty m b ofs (Vptr b ofs) nil.
-
-Lemma deref_locT_ax1 a m loc ofs v T (D:deref_locT (typeof a) m loc ofs v T):
-      deref_loc (typeof a) m loc ofs v.
-Proof. 
-  inv D.
-  + eapply deref_loc_value; eauto. eapply Mem.loadbytes_load; eauto.
-  + apply deref_loc_reference; trivial.
-  + apply deref_loc_copy; trivial.
-Qed.
-
-Lemma deref_locT_ax2 a m loc ofs v (D:deref_loc (typeof a) m loc ofs v):
-      exists T, deref_locT (typeof a) m loc ofs v T.
-Proof. 
-  inv D.
-  + exploit Mem.load_valid_access; eauto. intros [_ ALGN].
-    exploit Mem.load_loadbytes; eauto. intros [bytes [LD V]]; subst v.
-    eexists; eapply deref_locT_value; eauto. 
-  + eexists; apply deref_locT_reference; trivial.
-  + eexists; apply deref_locT_copy; trivial.
-Qed.
-
-Lemma deref_locT_fun a m loc ofs v1 T1 (D1:deref_locT (typeof a) m loc ofs v1 T1)
-      v2 T2 (D2:deref_locT (typeof a) m loc ofs v2 T2): (v1,T1)=(v2,T2). 
-Proof. inv D1; inv D2; try congruence. Qed.
-
-Lemma deref_locT_elim  a m b ofs v T (D:deref_locT (typeof a) m b ofs v T):
-       ev_elim m T m /\
-       (forall mm mm' (E:ev_elim mm T mm'),
-           mm'=mm /\ deref_locT (typeof a) mm b ofs v T).
-Proof.
-  inv D; simpl.
-  { intuition. subst. eapply deref_locT_value; trivial. }
-  { intuition. subst. eapply deref_locT_reference; trivial. }
-  { intuition. subst. eapply deref_locT_copy; trivial. }
-Qed. 
-
-Inductive alloc_variablesT (g: genv): PTree.t (block * type) -> mem -> list (ident * type) ->
-                                      PTree.t (block * type) -> mem -> (list mem_event) -> Prop :=
-    alloc_variablesT_nil : forall e m, alloc_variablesT g e m nil e m nil
-  | alloc_variablesT_cons :
-      forall e m id ty vars m1 b1 m2 e2 T,
-        Mem.alloc m 0 (@sizeof g ty) = (m1, b1) ->
-        alloc_variablesT g (PTree.set id (b1, ty) e) m1 vars e2 m2 T ->
-        alloc_variablesT g e m ((id, ty) :: vars) e2 m2 (Alloc b1 0 (@sizeof g ty) :: T).
-
-Lemma alloc_variablesT_ax1 g: forall e m l e' m' T (A:alloc_variablesT g e m l e' m' T),
-    alloc_variables g e m l e' m'.
-Proof. intros. induction A. constructor. econstructor; eauto. Qed. 
-
-Lemma alloc_variablesT_ax2 g: forall e m l e' m' (A:alloc_variables g e m l e' m'),
-    exists T, alloc_variablesT g e m l e' m' T.
-Proof. intros. induction A. exists nil. constructor.
-       destruct IHA. eexists. econstructor; eauto.
-Qed. 
-    
-Lemma alloc_variablesT_fun g: forall e m l e' m' T' (A:alloc_variablesT g e m l e' m' T')
-                                     e2 m2 T2 (A2:alloc_variablesT g e m l e2 m2 T2),
-     (e',m',T') = (e2,m2,T2).
-Proof. intros until T'. intros A; induction A; intros.
-       + inv A2. trivial.
-       + inv A2. rewrite H8 in H; inv H. apply IHA in H9; inv H9. trivial.
-Qed. 
-   
-Lemma alloc_variablesT_elim g:
-  forall e m l e' m' T (A:alloc_variablesT g e m l e' m' T),
-       ev_elim m T m' /\
-       (forall mm mm' (E:ev_elim mm T mm'),
-           (*exists e',*) alloc_variablesT g e mm l e' mm' T).
-Proof.
-  intros. induction A; simpl.
-  { split; [ trivial | intros; subst]. econstructor. }
-  { destruct IHA; split.
-    { eexists; split; [ eassumption | trivial]. }
-    { intros. destruct E as [mm'' [AA EE]].
-      specialize (H1 _ _ EE). econstructor; eassumption. } }
-Qed.
-
-Section EXPR_T.
-(** Extends Clight.eval_expr etc with event traces. *)
-
-Variable g: genv.
-Variable e: env.
-Variable le: temp_env.
-Variable m: mem.
-
-Inductive eval_exprT: expr -> val -> list mem_event-> Prop :=
-  | evalT_Econst_int:   forall i ty,
-      eval_exprT (Econst_int i ty) (Vint i) nil
-  | evalT_Econst_float:   forall f ty,
-      eval_exprT (Econst_float f ty) (Vfloat f) nil
-  | evalT_Econst_single:   forall f ty,
-      eval_exprT (Econst_single f ty) (Vsingle f) nil
-  | evalT_Econst_long:   forall i ty,
-      eval_exprT (Econst_long i ty) (Vlong i) nil
-  | evalT_Etempvar:  forall id ty v,
-      le!id = Some v ->
-      eval_exprT (Etempvar id ty) v nil
-  | evalT_Eaddrof: forall a ty loc ofs T,
-      eval_lvalueT a loc ofs T ->
-      eval_exprT (Eaddrof a ty) (Vptr loc ofs) T
-  | evalT_Eunop:  forall op a ty v1 v T,
-      eval_exprT a v1 T ->
-      sem_unary_operation op v1 (typeof a) m = Some v ->
-      (*unops at most check weak_valid_ptr, so don't create a trace event*)
-      eval_exprT (Eunop op a ty) v T
-  | evalT_Ebinop: forall op a1 a2 ty v1 v2 v T1 T2,
-      eval_exprT a1 v1 T1 ->
-      eval_exprT a2 v2 T2 ->
-      sem_binary_operation g op v1 (typeof a1) v2 (typeof a2) m = Some v ->
-      (*binops at most check weak_valid_ptr or cast, so don't create a trace event*)
-      eval_exprT (Ebinop op a1 a2 ty) v (T1++T2)
-  | evalT_Ecast:   forall a ty v1 v T,
-      eval_exprT a v1 T ->
-      sem_cast v1 (typeof a) ty m = Some v ->
-      eval_exprT (Ecast a ty) v T
-  | evalT_Esizeof: forall ty1 ty,
-      eval_exprT (Esizeof ty1 ty) (Vptrofs (Ptrofs.repr (@sizeof g ty1))) nil
-  | evalT_Ealignof: forall ty1 ty,
-      eval_exprT (Ealignof ty1 ty) (Vptrofs (Ptrofs.repr (@alignof g ty1))) nil
-  | evalT_Elvalue: forall a loc ofs v T1 T2 T,
-      eval_lvalueT a loc ofs T1 ->
-      deref_locT (typeof a) m loc ofs v T2 -> T=(T1 ++ T2) ->
-      eval_exprT a v T
-
-with eval_lvalueT: expr -> block -> ptrofs -> list mem_event-> Prop :=
-  | evalT_Evar_local:   forall id l ty,
-      e!id = Some(l, ty) ->
-      eval_lvalueT (Evar id ty) l Ptrofs.zero nil
-  | evalT_Evar_global: forall id l ty,
-      e!id = None ->
-      Genv.find_symbol g id = Some l ->
-      eval_lvalueT (Evar id ty) l Ptrofs.zero nil
-  | evalT_Ederef: forall a ty l ofs T,
-      eval_exprT a (Vptr l ofs) T ->
-      eval_lvalueT (Ederef a ty) l ofs T
- | evalT_Efield_struct:   forall a i ty l ofs id co att delta T,
-      eval_exprT a (Vptr l ofs) T ->
-      typeof a = Tstruct id att ->
-      g.(genv_cenv)!id = Some co ->
-      field_offset g i (co_members co) = Errors.OK delta ->
-      eval_lvalueT (Efield a i ty) l (Ptrofs.add ofs (Ptrofs.repr delta)) T
- | evalT_Efield_union:   forall a i ty l ofs id co att T,
-      eval_exprT a (Vptr l ofs) T ->
-      typeof a = Tunion id att ->
-      g.(genv_cenv)!id = Some co ->
-      eval_lvalueT (Efield a i ty) l ofs T.
-
-Scheme eval_exprT_ind2 := Minimality for eval_exprT Sort Prop
-  with eval_lvalueT_ind2 := Minimality for eval_lvalueT Sort Prop.
-Combined Scheme eval_exprT_lvalue_ind from eval_exprT_ind2, eval_lvalueT_ind2.
-
-Inductive eval_exprTlist: list expr -> typelist -> list val -> list mem_event-> Prop :=
-  | eval_ETnil:
-      eval_exprTlist nil Tnil nil nil
-  | eval_ETcons:   forall a bl ty tyl v1 v2 vl T1 T2,
-      eval_exprT a v1 T1 ->
-      sem_cast v1 (typeof a) ty m = Some v2 ->
-      eval_exprTlist bl tyl vl T2 ->
-      eval_exprTlist (a :: bl) (Tcons ty tyl) (v2 :: vl) (T1++T2).
-
-Lemma eval_exprT_ax1: forall a v T, eval_exprT a v T -> eval_expr g e le m a v
-with eval_lvalueT_ax1: forall a b z T, eval_lvalueT a b z T -> eval_lvalue g e le m a b z.           
-Proof.
-  + induction 1; econstructor; eauto. eapply deref_locT_ax1; eauto.
-  + induction 1; try solve [econstructor; eauto].
-Qed.
-
-Lemma eval_exprT_ax2: forall a v, eval_expr g e le m a v -> exists T, eval_exprT a v T
-with eval_lvalueT_ax2: forall a b z, eval_lvalue g e le m a b z -> exists T, eval_lvalueT a b z T.
-Proof.
-  + induction 1; try solve [eexists; econstructor; eauto].
-  - apply eval_lvalueT_ax2 in H; destruct H. eexists; eapply evalT_Eaddrof; eauto.
-  - destruct IHeval_expr. eexists; eapply evalT_Eunop; eauto.
-  - destruct IHeval_expr1. destruct IHeval_expr2. eexists; eapply evalT_Ebinop; eauto.
-  - destruct IHeval_expr. eexists; eapply evalT_Ecast; eauto.
-  - apply eval_lvalueT_ax2 in H; destruct H.
-    apply deref_locT_ax2 in H0. destruct H0. eexists; eapply evalT_Elvalue; eauto.
-  + induction 1; try solve [eexists; econstructor; eauto].
-  - apply eval_exprT_ax2 in H; destruct H as [T H]. eexists; eapply evalT_Ederef; eauto.
-  - apply eval_exprT_ax2 in H; destruct H as [T H]. eexists; eapply evalT_Efield_struct; eauto.
-  - apply eval_exprT_ax2 in H; destruct H as [T H]. eexists; eapply evalT_Efield_union; eauto.
-Qed.
-
-  Lemma eval_exprT_lvalueT_fun:
-    (forall a v1 T1 v2 T2, eval_exprT a v1 T1 -> eval_exprT a v2 T2 -> (v1,T1)=(v2,T2)) /\
-    (forall a b1 b2 i1 i2 T1 T2, eval_lvalueT a b1 i1 T1 -> eval_lvalueT a b2 i2 T2 ->
-                               (b1,i1,T1)=(b2,i2,T2)).
-Proof.
- destruct (eval_exprT_lvalue_ind
-   (fun a v T =>  forall v' T', eval_exprT a v' T' -> (v,T)=(v',T'))
-   (fun a b i T => forall b' i' T', eval_lvalueT a b' i' T' -> (b,i,T)=(b',i',T')));
-   simpl; intros.
- 
- { inv H. trivial. inv H0. }
- { inv H. trivial. inv H0. }
- { inv H. trivial. inv H0. }
- { inv H. trivial. inv H0. }
- { inv H. inv H0. congruence. inv H. }
- { inv H1. { apply H0 in H6; congruence. }
-           { inv H2. } }
- { inv H2. { apply H0 in H8; congruence. } 
-           { inv H3. } }
- { inv H4. { apply H0 in H11; inv H11. apply H2 in H12; congruence. }
-           { inv H5. } }
- { inv H2. { apply H0 in H5; congruence. } 
-           { inv H3.  } }
- { inv H. trivial. inv H0. }
- { inv H. trivial. inv H0. }
- { inv H. { inv H3. apply H0 in H; inv H. exploit deref_locT_fun. apply H1. apply H2. intros X; inv X; trivial. }
-          { inv H3. apply H0 in H; inv H. exploit deref_locT_fun. apply H1. apply H2. intros X; inv X; trivial. }
-          { inv H3. apply H0 in H; inv H. exploit deref_locT_fun. apply H1. apply H2. intros X; inv X; trivial. }
-          { inv H3. apply H0 in H; inv H. exploit deref_locT_fun. apply H1. apply H2. intros X; inv X; trivial. }
-          { inv H3. apply H0 in H; inv H. exploit deref_locT_fun. apply H1. apply H2. intros X; inv X; trivial. } }
- { inv H0; congruence. }
- { inv H1; congruence. }
- { inv H1. apply H0 in H7; congruence. }
- { inv H4. { apply H0 in H8; congruence. }
-           { congruence. } }
- { inv H3. { congruence. }
-           { apply H0 in H7; congruence. } }
-
- split; intros. apply (H _ _ _ H1 _ _ H2). apply (H0 _ _ _ _ H1 _ _ _ H2).
-Qed.
-
-Lemma eval_exprT_fun a v1 T1 v2 T2: eval_exprT a v1 T1 -> eval_exprT a v2 T2 -> (v1,T1)=(v2,T2).
-Proof. apply eval_exprT_lvalueT_fun. Qed.
-
-Lemma eval_lvalueT_fun a b1 b2 i1 i2 T1 T2: eval_lvalueT a b1 i1 T1 -> eval_lvalueT a b2 i2 T2 ->
-                               (b1,i1,T1)=(b2,i2,T2).
-Proof. apply eval_exprT_lvalueT_fun. Qed.
-
-Lemma eval_exprTlist_ax1: forall es ts vs T (E:eval_exprTlist es ts vs T),
-      eval_exprlist g e le m es ts vs.
-Proof.
-  intros; induction E; simpl; intros. econstructor.
-  apply eval_exprT_ax1 in H. econstructor; eauto.
-Qed.
-
-Lemma eval_exprTlist_ax2: forall es ts vs (E:eval_exprlist g e le m es ts vs),
-      exists T, eval_exprTlist es ts vs T.
-Proof.
-  intros; induction E; simpl; intros. eexists; econstructor.
-  apply eval_exprT_ax2 in H. destruct H as [T1 H]. destruct IHE as [T2 K].
-  eexists. econstructor; eauto.
-Qed.
-
-Lemma eval_exprTlist_fun: forall es ts vs1 T1 (E1:eval_exprTlist es ts vs1 T1)
-                          vs2 T2 (E2:eval_exprTlist es ts vs2 T2), (vs1,T1)=(vs2,T2).
-Proof.
-  intros es ts vs1 T1 E; induction E; simpl; intros; inv E2; trivial.
-  exploit eval_exprT_fun. apply H. apply H5. intros X; inv X. rewrite H8 in H0; inv H0.
-  apply IHE in H9; congruence. 
-Qed.
-
-End EXPR_T.
-
-
-Lemma eval_exprT_elim g e le:
-  forall m a v T (E:eval_exprT g e le m a v T), ev_elim m T m
-  with eval_lvalueT_elim g e le:
-         forall m a b z T (E:eval_lvalueT g e le m a b z T),
-           ev_elim m T m.
-Proof.
-  + clear eval_exprT_elim; induction 1; try solve [econstructor]; eauto.
-    { eapply ev_elim_app; eassumption. }
-    { subst. specialize (eval_lvalueT_elim _ _ _ _ _ _ _ _ H). 
-      exploit deref_locT_elim; eauto. intros [E2 EE2].
-      eapply ev_elim_app; eauto. }
-  + clear eval_lvalueT_elim; induction 1; try solve [econstructor]; eauto.
-Qed.
-
-Lemma eval_exprTlist_elim g e le : forall m es ts vs T
-                                  (E:eval_exprTlist g e le m es ts vs T),
-    ev_elim m T m.
-Proof.
-  induction 1; try solve [constructor].
-  exploit eval_exprT_elim. apply H. intros E1. 
-    eapply ev_elim_app; eassumption.
-Qed.
-
-Inductive assign_locT (ce : composite_env) (ty : type) (m : mem) (b : block) (ofs : ptrofs)
-  : val -> mem -> list mem_event -> Prop :=
-    assign_locT_value : forall (v : val) (chunk : memory_chunk) (m' : mem),
-                       access_mode ty = By_value chunk ->
-                       Mem.storev chunk m (Vptr b ofs) v = Some m' ->
-                       assign_locT ce ty m b ofs v m' (Write b (Ptrofs.unsigned ofs) (encode_val chunk v) ::nil)
-  | assign_locT_copy : forall (b' : block) (ofs' : ptrofs) (bytes : list memval) (m' : mem),
-                      access_mode ty = By_copy ->
-                      (@sizeof ce ty > 0 -> (alignof_blockcopy ce ty | Ptrofs.unsigned ofs')) ->
-                      (@sizeof ce ty > 0 -> (alignof_blockcopy ce ty | Ptrofs.unsigned ofs)) ->
-                      b' <> b \/
-                      Ptrofs.unsigned ofs' = Ptrofs.unsigned ofs \/
-                      Ptrofs.unsigned ofs' + @sizeof ce ty <= Ptrofs.unsigned ofs \/
-                      Ptrofs.unsigned ofs + @sizeof ce ty <= Ptrofs.unsigned ofs' ->
-                      Mem.loadbytes m b' (Ptrofs.unsigned ofs') (@sizeof ce ty) = Some bytes ->
-                      Mem.storebytes m b (Ptrofs.unsigned ofs) bytes = Some m' ->
-                      assign_locT ce ty m b ofs (Vptr b' ofs') m'
-                                  (Read b' (Ptrofs.unsigned ofs') (@sizeof ce ty) bytes ::
-                                   Write b (Ptrofs.unsigned ofs) bytes :: nil).
-
-Lemma assign_locT_ax1 ce ty m b ofs v m' T (A:assign_locT ce ty m b ofs v m' T):
-    assign_loc ce ty m b ofs v m'. 
-Proof.
-  destruct A; [eapply assign_loc_value; eauto | eapply assign_loc_copy; eauto].
-Qed.
-
-Lemma assign_locT_ax2 ce ty m b ofs v m' (A:assign_loc ce ty m b ofs v m'):
-    exists T, assign_locT ce ty m b ofs v m' T. 
-Proof.
-  destruct A; eexists; [eapply assign_locT_value; eauto | eapply assign_locT_copy; eauto].
-Qed.
-
-Lemma assign_locT_fun ce ty m b ofs v m1 T1
-      (A1:assign_locT ce ty m b ofs v m1 T1) m2 T2 (A2:assign_locT ce ty m b ofs v m2 T2):
-      (m1,T1)=(m2,T2).
-Proof. inv A1; inv A2; congruence. Qed.
-
-Lemma assign_locT_elim ce ty m b ofs v m1 T (A:assign_locT ce ty m b ofs v m1 T):
-  ev_elim m T m1 /\
-  forall mm mm1 (E: ev_elim mm T mm1),
-    assign_locT ce ty mm b ofs v mm1 T.
-Proof.
-  inv A; simpl.
-  { exploit Mem.store_valid_access_3; eauto. intros [_ A].
-    apply Mem.store_storebytes in H0.
-    split. { exists m1; split; trivial. }
-    intros. destruct E as [? [? ?]]; subst. econstructor; eauto.
-    apply Mem.storebytes_store; eassumption. }
-  { split. { split; [trivial | exists m1; split; trivial]. }
-    intros. destruct E as [LD [? [? ?]]]; subst.
-    constructor; eassumption. }
-Qed. 
-
-Section CLC_SEM.
-  Definition F: Type := fundef.
-  Definition V: Type := type.
-  Definition G := genv.
-  Definition C := CC_core.
-  Definition getEnv (g:G): Genv.t F V := genv_genv g.
-  (* We might want to define this properly or
-     factor the machines so we don't need events here. *)
-(** Transition relation *)
-Inductive cl_evstep (ge: Clight.genv): forall (q: CC_core) (m: mem) (T:list mem_event) (q': CC_core) (m': mem), Prop :=
-
-  | evstep_assign:   forall f a1 a2 k e le m loc ofs v2 v m' T1 T2 T3,
-(*     type_is_volatile (typeof a1) = false ->*)
-      eval_lvalueT ge e le m a1 loc ofs T1 ->
-      eval_exprT ge e le m a2 v2 T2 ->
-      sem_cast v2 (typeof a2) (typeof a1) m = Some v ->
-      assign_locT ge (typeof a1) m loc ofs v m' T3 ->
-      cl_evstep ge (State f (Sassign a1 a2) k e le) m (T1++T2++T3) 
-                  (State f Sskip k e le) m'
-
-  | evstep_set:   forall f id a k e le m v T,
-      eval_exprT ge e le m a v T ->
-      cl_evstep ge (State f (Sset id a) k e le) m T
-              (State f Sskip k e (PTree.set id v le)) m
-
-  | evstep_call:   forall f optid a al k e le m tyargs tyres cconv vf vargs fd T1 T2,
-      classify_fun (typeof a) = fun_case_f tyargs tyres cconv ->
-      eval_exprT ge e le m a vf T1 ->
-      eval_exprTlist ge e le m al tyargs vargs T2 ->
-      Genv.find_funct ge vf = Some fd ->
-      type_of_fundef fd = Tfunction tyargs tyres cconv ->
-      cl_evstep ge (State f (Scall optid a al) k e le) m (T1++T2)
-                  (Callstate fd vargs (Kcall optid f e le k)) m
-
-  | evstep_seq:  forall f s1 s2 k e le m,
-      cl_evstep ge (State f (Ssequence s1 s2) k e le) m nil
-                 (State f s1 (Kseq s2 k) e le) m
-
-  | evstep_skip_seq: forall f s k e le m,
-      cl_evstep ge (State f Sskip (Kseq s k) e le) m nil
-              (State f s k e le) m
-
-  | evstep_continue_seq: forall f s k e le m,
-      cl_evstep ge (State f Scontinue (Kseq s k) e le) m nil
-             (State f Scontinue k e le) m
-
-  | evstep_break_seq: forall f s k e le m,
-      cl_evstep ge (State f Sbreak (Kseq s k) e le) m nil
-            (State f Sbreak k e le) m
-
-  | evstep_ifthenelse:  forall f a s1 s2 k e le m v1 b T,
-      eval_exprT ge e le m a v1 T ->
-      bool_val v1 (typeof a) m = Some b ->
-      cl_evstep ge (State f (Sifthenelse a s1 s2) k e le) m T
-            (State f (if b then s1 else s2) k e le) m
-
-  | evstep_loop: forall f s1 s2 k e le m,
-      cl_evstep ge (State f (Sloop s1 s2) k e le) m nil
-            (State f s1 (Kloop1 s1 s2 k) e le) m
-
-  | evstep_skip_or_continue_loop1:  forall f s1 s2 k e le m x,
-      x = Sskip \/ x = Scontinue ->
-      cl_evstep ge (State f x (Kloop1 s1 s2 k) e le) m nil
-            (State f s2 (Kloop2 s1 s2 k) e le) m
-
-  | evstep_break_loop1:  forall f s1 s2 k e le m,
-      cl_evstep ge (State f Sbreak (Kloop1 s1 s2 k) e le) m nil
-             (State f Sskip k e le) m
-
-  | evstep_skip_loop2: forall f s1 s2 k e le m,
-      cl_evstep ge (State f Sskip (Kloop2 s1 s2 k) e le) m nil
-             (State f (Sloop s1 s2) k e le) m
-
-  | evstep_break_loop2: forall f s1 s2 k e le m,
-      cl_evstep ge (State f Sbreak (Kloop2 s1 s2 k) e le) m nil
-            (State f Sskip k e le) m
-
-  | evstep_return_0: forall f k e le m m',
-      Mem.free_list m (blocks_of_env ge e) = Some m' ->
-      cl_evstep ge (State f (Sreturn None) k e le) m
-            (Free (Clight.blocks_of_env ge e)::nil)
-            (Returnstate Vundef (call_cont k)) m'
-
-  | evstep_return_1: forall f a k e le m v v' m' T,
-      eval_exprT ge e le m a v T ->
-      sem_cast v (typeof a) f.(fn_return) m = Some v' ->
-      Mem.free_list m (blocks_of_env ge e) = Some m' ->
-      cl_evstep ge (State f (Sreturn (Some a)) k e le) m
-            (T ++ Free (Clight.blocks_of_env ge e)::nil)
-           (Returnstate v' (call_cont k)) m'
-
-  | evstep_skip_call: forall f k e le m m',
-      is_call_cont k ->
-      Mem.free_list m (blocks_of_env ge e) = Some m' ->
-      cl_evstep ge (State f Sskip k e le) m
-              (Free (Clight.blocks_of_env ge e)::nil)
-              (Returnstate Vundef k) m'
-
-  | evstep_switch: forall f a sl k e le m v n T,
-      eval_exprT ge e le m a v T ->
-      sem_switch_arg v (typeof a) = Some n ->
-      cl_evstep ge (State f (Sswitch a sl) k e le) m T
-            (State f (seq_of_labeled_statement (select_switch n sl)) (Kswitch k) e le) m
-
-  | evstep_skip_break_switch: forall f x k e le m,
-      x = Sskip \/ x = Sbreak ->
-      cl_evstep ge (State f x (Kswitch k) e le) m nil
-             (State f Sskip k e le) m
-  | evstep_continue_switch: forall f k e le m,
-      cl_evstep ge (State f Scontinue (Kswitch k) e le) m nil
-             (State f Scontinue k e le) m
-
-  | evstep_label: forall f lbl s k e le m,
-      cl_evstep ge (State f (Slabel lbl s) k e le) m nil
-             (State f s k e le) m
-
-  | evstep_goto: forall f lbl k e le m s' k',
-      find_label lbl f.(fn_body) (call_cont k) = Some (s', k') ->
-      cl_evstep ge (State f (Sgoto lbl) k e le) m nil
-             (State f s' k' e le) m
-
-  | evstep_internal_function: forall f vargs k m e le m1 T,
-       list_norepet (var_names (fn_params f)) ->
-       list_disjoint (var_names (fn_params f)) (var_names (fn_temps f)) ->
-      forall (NRV: list_norepet (var_names f.(fn_vars))),
-      alloc_variablesT ge empty_env m (f.(fn_vars)) e m1 T ->
-      bind_parameter_temps f.(fn_params) vargs (create_undef_temps f.(fn_temps)) = Some
-le ->
-      cl_evstep ge (Callstate (Internal f) vargs k) m T
-            (State f f.(fn_body) k e le) m1
-
-  | evstep_external_function: forall ef targs tres cconv vargs k m t vres m' T
-          (EFI: ef_inline ef = true)
-          (EC: Events.external_call ef ge vargs m t vres m'),
-      T = proj1_sig (inline_external_call_mem_events _ _ _ _ _ _ _ EFI EC) ->
-      cl_evstep ge (Callstate (External ef targs tres cconv) vargs k) m T
-          (Returnstate vres k) m'
-
-  | evstep_returnstate: forall v optid f e le k m,
-      cl_evstep ge (Returnstate v (Kcall optid f e le k)) m nil
-           (State f Sskip k e (set_opttemp optid v le)) m.
-
-  Lemma CLC_evstep_ax1 ge : forall c m T c' m' (H: cl_evstep ge c m T c' m' ),
-    corestep (CLC_memsem ge) c m c' m'.
-  Proof.
-    induction 1; try solve [econstructor; eassumption].
-    +  apply eval_lvalueT_ax1 in H. apply eval_exprT_ax1 in H0.
-         apply assign_locT_ax1 in H2. econstructor; eauto.
-    +  apply eval_exprT_ax1 in H. econstructor; eauto.
-    + apply eval_exprT_ax1 in H0.
-      apply eval_exprTlist_ax1 in H1. econstructor; eauto.
-    +  apply eval_exprT_ax1 in H. econstructor; eauto.
-    +  apply eval_exprT_ax1 in H. econstructor; eauto.
-    +  apply eval_exprT_ax1 in H. econstructor; eauto.
-    +  apply alloc_variablesT_ax1 in H1. econstructor; eauto.
-         econstructor; eauto.
-  Qed.   
-  
-  Lemma CLC_evstep_ax2 ge : forall c m c' m' (H:corestep (CLC_memsem ge) c m c' m'),
-      exists T : list mem_event, cl_evstep ge c m T c' m'.
-  Proof.
-    induction 1; try solve [ destruct IHcl_step as [T HT]; eexists; econstructor; eauto];
-      try solve [eexists; econstructor; eauto]. 
-  + apply eval_lvalueT_ax2 in H. destruct H as [T1 A1].
-      apply eval_exprT_ax2 in H0. destruct H0 as [T2 A2].
-      apply assign_locT_ax2 in H2. destruct H2 as [T3 A3].
-      eexists; econstructor; eauto.
-  + apply eval_exprT_ax2 in H; destruct H as [T H].
-      eexists; econstructor; eauto.
-  + apply eval_exprT_ax2 in H0. destruct H0 as [T1 K1].
-      apply eval_exprTlist_ax2 in H1. destruct H1 as [T2 K2].
-      eexists; econstructor; eauto.
-  + apply eval_exprT_ax2 in H; destruct H as [T H].
-      eexists; econstructor; eauto.
-  + apply eval_exprT_ax2 in H; destruct H as [T H].
-      eexists; econstructor; eauto.
-  + apply eval_exprT_ax2 in H; destruct H as [T H].
-      eexists; econstructor; eauto.
-  + inv H. apply alloc_variablesT_ax2 in H3. destruct H3 as [T3 K3].
-      eexists; econstructor; eauto.
-Unshelve.
-3: eassumption.
-auto.
-Qed.
-
-  Lemma CLC_evstep_fun ge : forall c m T' c' m' T'' c'' m''
-                                   (K: cl_evstep ge c m T' c' m') (K': cl_evstep ge c m T'' c'' m''), T' = T''.
-  Proof. intros. generalize dependent m''. generalize dependent c''. generalize dependent T''.
-         induction K; simpl; intros; try solve [ inv K'; eauto ].
- - inv K'. exploit eval_exprT_fun. apply H14. apply H0. intros X; inv X.
-    exploit eval_lvalueT_fun. apply H13. apply H. intros X; inv X.
-    rewrite H15 in H1; inv H1.
-    exploit assign_locT_fun. apply H16. apply H2. intros X; inv X; trivial.
-   destruct H12; discriminate.
-   destruct H12; discriminate.
- - inv K'. exploit eval_exprT_fun. apply H10. apply H. intros X; inv X. trivial.
-    destruct H9; discriminate.
-    destruct H9; discriminate.
- - inv K'.
-    + rewrite H15 in H; inv H.
-      exploit eval_exprT_fun. eassumption. apply H0. intros X; inv X.
-      exploit eval_exprTlist_fun. eassumption. apply H1. intros X; inv X.
-      rewrite H18 in H2; inv H2.
-      rewrite H19 in H3; inv H3. auto.
-    + destruct H13; discriminate.
-    + destruct H13; discriminate.
- - inv K'; auto. contradiction.
- - inv K'. exploit eval_exprT_fun. eassumption. eapply H. intros X; inv X. auto.
-    destruct H10; discriminate.
-    destruct H10; discriminate.
- - destruct H; subst x; inv K'; auto. contradiction.
- - inv K'; auto; contradiction.
- - inv K'; try solve [destruct H9; discriminate]. inversion2 H H8. auto.
- - inv K'; try solve [destruct H11; discriminate].
-    exploit eval_exprT_fun. eassumption. eapply H. intros X; inv X. auto.
- - inv K'; try contradiction. auto.
- - inv K'; try solve [destruct H10; discriminate].
-    exploit eval_exprT_fun. eassumption. eapply H. intros X; inv X. auto.
- - destruct H; subst x; inv K'; auto. contradiction.
- - inv K'. 
-      exploit alloc_variablesT_fun. eassumption. apply H1. intros X; inv X. auto.
- - inv K'. simpl.
-Abort.
-
-  Lemma CLC_evstep_elim ge : forall c m T c' m' (K: cl_evstep ge c m T c' m'),
-        ev_elim m T m'.
-  Proof.
-    induction 1; try solve [constructor];
-      try solve [ apply eval_exprT_elim in H; trivial]; trivial.
-  + eapply assign_locT_elim in H2. destruct H2 as [EV3 _ ].
-      eapply eval_lvalueT_elim in H.
-      eapply eval_exprT_elim in H0.
-      eapply ev_elim_app; eauto. eapply ev_elim_app; eauto.
-  + apply eval_exprT_elim in H0.
-      apply eval_exprTlist_elim in H1.
-      eapply ev_elim_app; eauto.
-  + eexists; split; eauto. reflexivity.
-  + apply eval_exprT_elim in H.
-      eapply ev_elim_app; eauto.
-      eexists; split; eauto. reflexivity.
-  + eexists; split; eauto. reflexivity.
-  + apply alloc_variablesT_elim in H1.
-      destruct H1; auto.
-  + destruct  (inline_external_call_mem_events ef ge vargs m t
-         vres m' EFI EC). simpl in H. subst x. auto.
-  Qed.
-  
-  (** *Event semantics for Clight_new*)
-   (* This should be a version of CLN_memsem annotated with memory events.*)
-  
-  Program Definition CLC_evsem ge : @EvSem C := {| msem := CLC_memsem ge; ev_step := cl_evstep ge |}.
-  Next Obligation. apply CLC_evstep_ax1. Qed.
-  Next Obligation. apply CLC_evstep_ax2. Qed.
-(*  Next Obligation. apply CLC_evstep_fun. Qed. *)
-  Next Obligation. apply CLC_evstep_elim. Qed.  
-
-  Lemma CLC_msem : forall ge, msem (CLC_evsem ge) = CLC_memsem ge.
-  Proof. auto. Qed.
-End CLC_SEM.
-
-  Lemma CLC_step_decay: forall g c m tr c' m',
+Lemma CLC_step_decay: forall g c m tr c' m',
       event_semantics.ev_step (CLC_evsem g) c m tr c' m' ->
       decay m m'.
 Proof.
@@ -658,171 +63,54 @@ apply CLC_evstep_ax1 in H.
 auto.
 Qed.
 
-  Lemma at_external_SEM_eq:
-     forall ge c m, semantics.at_external (CLC_evsem ge) c m =
-     match c with
-     | Callstate (External ef _ _ _) args _ => 
-         if ef_inline ef then None else Some (ef, args)
-     | _ => None
-   end.
-  Proof. auto. Qed.
-
-  Instance ClightSem ge : Semantics :=
-    { semG := G; semC := C; semSem := CLC_evsem ge; the_ge := ge }.
-
-  Inductive builtin_event: external_function -> mem -> list val -> list mem_event -> Prop :=
-  BE_malloc: forall m n m'' b m'
-         (ALLOC: Mem.alloc m (-size_chunk Mptr) (Ptrofs.unsigned n) = (m'', b))
-         (ALGN : (align_chunk Mptr | (-size_chunk Mptr)))
-         (ST: Mem.storebytes m'' b (-size_chunk Mptr) (encode_val Mptr (Vptrofs n)) = Some m'),
-         builtin_event EF_malloc m [Vptrofs n]
-               [Alloc b (-size_chunk Mptr) (Ptrofs.unsigned n);
-                Write b (-size_chunk Mptr) (encode_val Mptr (Vptrofs n))]
-| BE_free: forall m b lo bytes sz m'
-        (POS: Ptrofs.unsigned sz > 0)
-        (LB : Mem.loadbytes m b (Ptrofs.unsigned lo - size_chunk Mptr) (size_chunk Mptr) = Some bytes)
-        (FR: Mem.free m b (Ptrofs.unsigned lo - size_chunk Mptr) (Ptrofs.unsigned lo + Ptrofs.unsigned sz) = Some m')
-        (ALGN : (align_chunk Mptr | Ptrofs.unsigned lo - size_chunk Mptr))
-        (SZ : Vptrofs sz = decode_val Mptr bytes),
-        builtin_event EF_free m [Vptr b lo]
-              [Read b (Ptrofs.unsigned lo - size_chunk Mptr) (size_chunk Mptr) bytes;
-               Free [(b,Ptrofs.unsigned lo - size_chunk Mptr, Ptrofs.unsigned lo + Ptrofs.unsigned sz)]]
-| BE_memcpy: forall m al bsrc bdst sz bytes osrc odst m'
-        (AL: al = 1 \/ al = 2 \/ al = 4 \/ al = 8)
-        (POS : sz >= 0)
-        (DIV : (al | sz))
-        (OSRC : sz > 0 -> (al | Ptrofs.unsigned osrc))
-        (ODST: sz > 0 -> (al | Ptrofs.unsigned odst))
-        (RNG: bsrc <> bdst \/
-                Ptrofs.unsigned osrc = Ptrofs.unsigned odst \/
-                Ptrofs.unsigned osrc + sz <= Ptrofs.unsigned odst \/ Ptrofs.unsigned odst + sz <= Ptrofs.unsigned osrc)
-        (LB: Mem.loadbytes m bsrc (Ptrofs.unsigned osrc) sz = Some bytes)
-        (ST: Mem.storebytes m bdst (Ptrofs.unsigned odst) bytes = Some m'),
-        builtin_event (EF_memcpy sz al) m [Vptr bdst odst; Vptr bsrc osrc]
-              [Read bsrc (Ptrofs.unsigned osrc) sz bytes;
-               Write bdst (Ptrofs.unsigned odst) bytes]
-(*| BE_EFexternal: forall name sg m vargs,
-(*        I64Helpers.is_I64_helperS name sg ->*)
-         builtin_event (EF_external name sg) m vargs []
-| BE_EFbuiltin: forall name sg m vargs, (*is_I64_builtinS name sg ->*)
-         builtin_event (EF_builtin name sg) m vargs []*)
-| BE_other: forall ef m vargs,
-  match ef with EF_malloc | EF_free | EF_memcpy _ _ => False | _ => True end ->
-  builtin_event ef m vargs [].
-
-Lemma Vptrofs_inj : forall o1 o2, Vptrofs o1 = Vptrofs o2 ->
-  Ptrofs.unsigned o1 = Ptrofs.unsigned o2.
-Proof.
-  unfold Vptrofs; intros.
-  pose proof (Ptrofs.unsigned_range o1); pose proof (Ptrofs.unsigned_range o2).
-  destruct Archi.ptr64 eqn: H64.
-  - assert (Int64.unsigned (Ptrofs.to_int64 o1) = Int64.unsigned (Ptrofs.to_int64 o2)) by congruence.
-    unfold Ptrofs.to_int64 in *.
-    rewrite Ptrofs.modulus_eq64 in * by auto.
-    rewrite !Int64.unsigned_repr in * by (unfold Int64.max_unsigned; omega); auto.
-  - assert (Int.unsigned (Ptrofs.to_int o1) = Int.unsigned (Ptrofs.to_int o2)) by congruence.
-    unfold Ptrofs.to_int in *.
-    rewrite Ptrofs.modulus_eq32 in * by auto.
-    rewrite !Int.unsigned_repr in * by (unfold Int.max_unsigned; omega); auto.
-Qed.
-
-Lemma builtin_event_determ ef m vargs T1 (BE1: builtin_event ef m vargs T1) T2 (BE2: builtin_event ef m vargs T2): T1=T2.
-inversion BE1; inv BE2; try discriminate; try contradiction; simpl in *; trivial.
-+ assert (Vptrofs n0 = Vptrofs n) as H by congruence.
-  rewrite H; rewrite (Vptrofs_inj _ _ H) in *.
-  rewrite ALLOC0 in ALLOC; inv ALLOC; trivial.
-+ inv H5.
-  rewrite LB0 in LB; inv LB. rewrite <- SZ in SZ0. rewrite (Vptrofs_inj _ _ SZ0); trivial.
-+ inv H3; inv H5.
-  rewrite LB0 in LB; inv LB; trivial.
+#[export] Instance ClightAxioms ge : @CoreLanguage.SemAxioms (ClightSem ge).
+Proof.
+  constructor.
+  - intros.
+    apply mem_step_obeys_cur_write; auto.
+    eapply corestep_mem; eauto.
+  - intros.
+    apply ev_step_ax2 in H as [].
+    eapply CLC_step_decay; simpl in *; eauto.
+  - intros.
+    apply mem_forward_nextblock, mem_step_forward.
+    eapply corestep_mem; eauto.
+  - intros; simpl.
+    destruct q; auto.
+  - intros.
+    destruct Hstep as (? & ->); done. (* Do we need initial_core to allocate the arguments? *)
+(*    inv Hstep.
+    inv H; simpl.
+    apply mem_step_obeys_cur_write; auto.
+  (* apply memsem_lemmas.mem_step_refl. *)
+    eapply mem_step_alloc; eauto. *)
+  - intros.
+    destruct H as (? & ->).
+    apply strong_decay_refl.
+(*    inv H.
+    inv H0; simpl.
+    split; intros.
+    + (*contradiction. *)
+      eapply juicy_mem.fullempty_after_alloc in H8.
+      admit. 
+      (* destruct H8; [right|left].
+     
+       should be able to prove that 
+                1. b = Mem.nextblock m
+                which satisfies the goal at all offsets.
+              *)
+        
+    + auto. inv H8.
+      simpl.
+      Transparent Mem.alloc.
+      unfold Mem.alloc; simpl.
+      admit.
+      
+  - intros.
+    inv H.
+    inv H0; simpl.
+    erewrite (Mem.nextblock_alloc _ _ _ _ _ H8).
+    xomega.*)
+  - intros.
+    destruct H as (? & ->); done.
 Qed.
-
-  (* extending Clight_sim to event semantics *)
-Inductive ev_star ge: state -> mem -> _ -> state -> mem -> Prop :=
-  | ev_star_refl: forall s m,
-      ev_star ge s m nil s m
-  | ev_star_step: forall s1 m1 ev1 s2 m2 ev2 s3 m3,
-      ev_step (CLC_evsem ge) s1 m1 ev1 s2 m2 -> ev_star ge s2 m2 ev2 s3 m3 ->
-      ev_star ge s1 m1 (ev1 ++ ev2) s3 m3.
-
-Lemma ev_star_one:
-  forall ge s1 m1 ev s2 m2, ev_step (CLC_evsem ge) s1 m1 ev s2 m2 -> ev_star ge s1 m1 ev s2 m2.
-Proof.
-  intros. rewrite <- (app_nil_r ev). eapply ev_star_step; eauto. apply ev_star_refl.
-Qed.
-
-Lemma ev_star_two:
-  forall ge s1 m1 ev1 s2 m2 ev2 s3 m3,
-  ev_step (CLC_evsem ge) s1 m1 ev1 s2 m2 -> ev_step (CLC_evsem ge) s2 m2 ev2 s3 m3 ->
-  ev_star ge s1 m1 (ev1 ++ ev2) s3 m3.
-Proof.
-  intros. eapply ev_star_step; eauto. apply ev_star_one; auto.
-Qed.
-
-Lemma ev_star_trans:
-  forall ge {s1 m1 ev1 s2 m2}, ev_star ge s1 m1 ev1 s2 m2 ->
-  forall {ev2 s3 m3}, ev_star ge s2 m2 ev2 s3 m3 -> ev_star ge s1 m1 (ev1 ++ ev2) s3 m3.
-Proof.
-  induction 1; intros; auto.
-  rewrite <- app_assoc.
-  eapply ev_star_step; eauto.
-Qed.
-
-
-Inductive ev_plus ge: state -> mem -> _ -> state -> mem -> Prop :=
-  | ev_plus_left: forall s1 m1 ev1 s2 m2 ev2 s3 m3,
-      ev_step (CLC_evsem ge) s1 m1 ev1 s2 m2 -> ev_star ge s2 m2 ev2 s3 m3 ->
-      ev_plus ge s1 m1 (ev1 ++ ev2) s3 m3.
-
-Lemma ev_plus_one:
-  forall ge s1 m1 ev s2 m2, ev_step (CLC_evsem ge) s1 m1 ev s2 m2 -> ev_plus ge s1 m1 ev s2 m2.
-Proof.
-  intros. rewrite <- (app_nil_r ev). eapply ev_plus_left; eauto. apply ev_star_refl.
-Qed.
-
-Lemma ev_plus_two:
-  forall ge s1 m1 ev1 s2 m2 ev2 s3 m3,
-  ev_step (CLC_evsem ge) s1 m1 ev1 s2 m2 -> ev_step (CLC_evsem ge) s2 m2 ev2 s3 m3 ->
-  ev_plus ge s1 m1 (ev1 ++ ev2) s3 m3.
-Proof.
-  intros. eapply ev_plus_left; eauto. apply ev_star_one; auto.
-Qed.
-
-Lemma ev_plus_star: forall ge s1 m1 ev s2 m2, ev_plus ge s1 m1 ev s2 m2 -> ev_star ge s1 m1 ev s2 m2.
-Proof.
-  intros. inv H. eapply ev_star_step; eauto.
-Qed.
-
-Lemma ev_plus_trans:
-  forall ge {s1 m1 ev1 s2 m2}, ev_plus ge s1 m1 ev1 s2 m2 ->
-  forall {ev2 s3 m3}, ev_plus ge s2 m2 ev2 s3 m3 -> ev_plus ge s1 m1 (ev1 ++ ev2) s3 m3.
-Proof.
-  intros.
-  inv H.
-  rewrite <- app_assoc.
-  eapply ev_plus_left. eauto.
-  eapply ev_star_trans; eauto.
-  apply ev_plus_star. auto.
-Qed.
-
-Lemma ev_star_plus_trans:
-  forall ge {s1 m1 ev1 s2 m2}, ev_star ge s1 m1 ev1 s2 m2 ->
-  forall {ev2 s3 m3}, ev_plus ge s2 m2 ev2 s3 m3 -> ev_plus ge s1 m1 (ev1 ++ ev2) s3 m3.
-Proof.
-  intros. inv H. auto.
-  rewrite <- app_assoc.
-  eapply ev_plus_left; eauto.
-  eapply ev_star_trans; eauto. apply ev_plus_star; auto.
-Qed.
-
-Lemma ev_plus_star_trans:
-  forall ge {s1 m1 ev1 s2 m2}, ev_plus ge s1 m1 ev1 s2 m2 ->
-  forall {ev2 s3 m3}, ev_star ge s2 m2 ev2 s3 m3 -> ev_plus ge s1 m1 (ev1 ++ ev2) s3 m3.
-Proof.
-  intros.
-  inv H.
-  rewrite <- app_assoc.
-  eapply ev_plus_left; eauto. eapply ev_star_trans; eauto.
-Qed.
-
-
diff --git a/concurrency/common/Clight_bounds.v b/concurrency/common/Clight_bounds.v
index 4608edc7af..0019172b73 100644
--- a/concurrency/common/Clight_bounds.v
+++ b/concurrency/common/Clight_bounds.v
@@ -15,18 +15,18 @@ Require Import VST.concurrency.common.permissions.
 
 Require Import VST.sepcomp.semantics_lemmas.
 Require Import compcert.lib.Coqlib.
-Require Import VST.veric.Clight_new.
-Require Import VST.veric.Clightnew_coop.
+Require Import VST.veric.Clight_core.
+Require Import VST.veric.Clightcore_coop.
 
 Require Import Coq.Logic.FunctionalExtensionality.
 
-Lemma CLight_Deterministic: forall ge c m c1 m1 c2 m2,
-    veric.Clight_new.cl_step ge c m c2 m2 ->
-    veric.Clight_new.cl_step ge c m c1 m1 ->
+(* Lemma CLight_Deterministic: forall ge c m c1 m1 c2 m2,
+    cl_step ge c m c2 m2 ->
+    cl_step ge c m c1 m1 ->
     c1 = c2 /\ m1 = m2.
 Proof. intros.
        specialize (cl_corestep_fun _ _ _ _ _ _ _ H H0); intros X; inversion X; subst. split; trivial.
-Qed.
+Qed.*)
 
 Definition bnd_from_init m := bounded_maps.bounded_map (snd (getMaxPerm m)) /\ (Mem.mem_access m).1 = fun z k => None.
 
@@ -62,8 +62,8 @@ Proof.
     destruct (peq p (Mem.nextblock m)); subst.
     { inversion H1; clear H1; subst. clear H0 H. red.
       exists hi, lo; split; intros.
-      { destruct (zle lo p); destruct (zlt p hi); simpl; trivial; omega. }
-      { destruct (zle lo p); destruct (zlt p hi); simpl; trivial; omega. } }
+      { destruct (zle lo p); destruct (zlt p hi); simpl; trivial; lia. }
+      { destruct (zle lo p); destruct (zlt p hi); simpl; trivial; lia. } }
     { apply (H p); clear H0. rewrite PTree.gmap1. apply H1. } }
 Qed.
 
@@ -93,7 +93,7 @@ Proof.
       { destruct (zle lo p); destruct (zlt p hi); simpl; trivial; eauto. } }
     { clear H. unfold getMaxPerm in Heqg.
       destruct (zlt lo hi).
-      { assert (A: lo <= lo < hi) by omega. specialize (r _ A).
+      { assert (A: lo <= lo < hi) by lia. specialize (r _ A).
         apply Mem.perm_max in r. unfold Mem.perm, PMap.get in r.
         rewrite PTree.gmap1 in Heqg. unfold option_map in Heqg.
         remember (((Mem.mem_access m).2) ! b) as q. destruct q; simpl in *. discriminate.
@@ -137,22 +137,22 @@ Proof.
       exists  (Z.max HI hi), (Z.min LO lo); split; intros.
       { destruct (zle lo p); destruct (zlt p hi); simpl; trivial; eauto.
         - move : H=> /Z.gt_lt_iff /Z.max_lub_lt_iff [] ? ?.
-          xomega.
+          lia.
         - move : H=> /Z.gt_lt_iff /Z.max_lub_lt_iff [] /Z.gt_lt_iff /HHi //.
         - move : H=> /Z.gt_lt_iff /Z.max_lub_lt_iff [] /Z.gt_lt_iff /HHi //.
         - move : H=> /Z.gt_lt_iff /Z.max_lub_lt_iff [] /Z.gt_lt_iff /HHi //.
       }
       { destruct (zle lo p); destruct (zlt p hi); simpl; trivial; eauto.
         - move : H=> /Z.min_glb_lt_iff [] ? ?.
-          xomega.
+          lia.
         - move : H=> /Z.min_glb_lt_iff [] ? ?.
-          omega.
+          lia.
         - move : H=> /Z.min_glb_lt_iff [] /HLo //.
         - move : H=> /Z.min_glb_lt_iff [] /HLo //.
       } }
     { clear H. unfold getMaxPerm in Heqg.
       destruct (zlt lo hi).
-      { assert (A: lo <= lo < hi) by omega. specialize (r _ A).
+      { assert (A: lo <= lo < hi) by lia. specialize (r _ A).
         apply Mem.perm_max in r. unfold Mem.perm, PMap.get in r.
         rewrite PTree.gmap1 in Heqg. unfold option_map in Heqg.
         remember (((Mem.mem_access m).2) ! b) as q. destruct q; simpl in *. discriminate.
@@ -161,8 +161,8 @@ Proof.
         remember (((Mem.mem_access m).2) ! b) as w. destruct w; try discriminate. clear Heqg.
         rewrite INI.
         exists lo, lo; split; intros.
-        { destruct (zle lo p); destruct (zlt p hi); simpl; trivial. xomega. }
-        { destruct (zle lo p); destruct (zlt p hi); simpl; trivial. xomega.  } } } }
+        { destruct (zle lo p); destruct (zlt p hi); simpl; trivial. lia. }
+        { destruct (zle lo p); destruct (zlt p hi); simpl; trivial. lia.  } } } }
   { apply (H p). unfold getMaxPerm in *; simpl in *.
     rewrite PTree.gmap1 in F. rewrite PTree.gmap1. unfold option_map in *.
     rewrite PTree.gso in F; trivial. }
@@ -196,31 +196,10 @@ Proof.
 Qed.
 
 Lemma CLight_step_mem_bound' ge c m c' m':
-  veric.Clight_new.cl_step ge c m c' m' -> bnd_from_init m -> bnd_from_init m'.
+  cl_step ge c m c' m' -> bnd_from_init m -> bnd_from_init m'.
 Proof.
   intros.
-  apply (memsem_preserves (CLN_memsem ge) _ preserve_bnd _ _ _ _ H H0).
-Qed.
-
-(*This proof is already in juicy_machine.
- * move it to a more general position.*)
-Lemma Mem_canonical_useful: forall m loc k,
-    fst (Mem.mem_access m) loc k = None.
-Proof. intros. destruct m; simpl in *.
-       unfold PMap.get in nextblock_noaccess.
-       pose (b:= Pos.max (TreeMaxIndex (snd mem_access) + 1 )  nextblock).
-       assert (H1:  ~ Plt b nextblock).
-       { intros H. assert (HH:= Pos.le_max_r (TreeMaxIndex (snd mem_access) + 1) nextblock).
-         clear - H HH. unfold Pos.le in HH. unfold Plt in H.
-         apply HH. eapply Pos.compare_gt_iff.
-         auto. }
-       assert (H2 :( b > (TreeMaxIndex (snd mem_access)))%positive ).
-       { assert (HH:= Pos.le_max_l (TreeMaxIndex (snd mem_access) + 1) nextblock).
-         apply Pos.lt_gt. eapply Pos.lt_le_trans; eauto.
-         xomega. }
-       specialize (nextblock_noaccess b loc k H1).
-       apply max_works in H2. rewrite H2 in nextblock_noaccess.
-       assumption.
+  apply (memsem_preserves (CLC_memsem ge) _ preserve_bnd _ _ _ _ H H0).
 Qed.
 
 Lemma mem_bound_init_mem_bound:
@@ -236,7 +215,7 @@ Proof.
 Qed.
 
 Lemma CLight_step_mem_bound ge c m c' m':
-  veric.Clight_new.cl_step ge c m c' m' ->
+  cl_step ge c m c' m' ->
   bounded_maps.bounded_map (snd (getMaxPerm m)) ->
   bounded_maps.bounded_map (snd (getMaxPerm m')).
 Proof.
@@ -344,7 +323,7 @@ Proof.
     rewrite AA in H0; inversion H0; subst; auto.
   - assert (exists n, Z.of_nat n = a).
     { exists (Z.to_nat a).
-      apply Z2Nat.id. omega. }
+      apply Z2Nat.id. lia. }
     destruct H1 as [n H1].
     subst a.
     clear g AA.
@@ -353,7 +332,7 @@ Proof.
     + intros.
       rewrite Globalenvs.store_zeros_equation in H0.
       rewrite Nat2Z.inj_0 in H0.
-      destruct (zle 0 0); try omega.
+      destruct (zle 0 0); try lia.
       inversion H0; subst; assumption.
     + intros.
       rewrite Globalenvs.store_zeros_equation in H0.
@@ -361,11 +340,11 @@ Proof.
       { rewrite Nat2Z.inj_succ in l.
         assert (HH:=coqlib4.Z_of_nat_ge_O n).
         clear - l HH.
-        xomega.
+        lia.
       }
       destruct ( Mem.store AST.Mint8unsigned m b ofs Values.Vzero) eqn:STORE';
         try solve[inversion H0].
-      replace (Z.of_nat n.+1 - 1) with (Z.of_nat n) in H0 by xomega.
+      replace (Z.of_nat n.+1 - 1) with (Z.of_nat n) in H0 by lia.
       eapply IHn; try eapply H0.
       eapply store_bounded; eauto.
 Qed.
diff --git a/concurrency/common/HybridMachine.v b/concurrency/common/HybridMachine.v
index 82cc3ed670..acd8f9a8e8 100644
--- a/concurrency/common/HybridMachine.v
+++ b/concurrency/common/HybridMachine.v
@@ -9,7 +9,7 @@ Require Import compcert.lib.Integers.
 
 Require Import VST.msl.Axioms.
 Require Import Coq.ZArith.ZArith.
-Require Import VST.concurrency.common.core_semantics.
+(*Require Import VST.concurrency.common.core_semantics.*)
 Require Import VST.sepcomp.event_semantics.
 Require Export VST.concurrency.common.semantics.
 Require Export VST.concurrency.common.lksize.
@@ -30,12 +30,13 @@ Require Import VST.concurrency.common.coinductive_safety.*)
 
 Require Import VST.concurrency.common.HybridMachineSig.
 (* Require Import VST.concurrency.CoreSemantics_sum. *)
+Import Maps.
 
 
 Module DryHybridMachine.
   Import Events ThreadPool.
 
-  Instance dryResources: Resources:=
+  #[export] Instance dryResources: Resources:=
     {| res := access_map * access_map;
        lock_info := access_map * access_map |}.
 
@@ -186,7 +187,7 @@ Module DryHybridMachine.
             (** To acquire the lock the thread must have [Readable] permission on it*)
             (Haccess: Mem.range_perm m0 b (Ptrofs.intval ofs) ((Ptrofs.intval ofs) + LKSIZE) Cur Readable)
             (** check if the lock is free*)
-            (Hload: Mem.load Mint32 m0 b (Ptrofs.intval ofs) = Some (Vint Int.one))
+            (Hload: Mem.load Mptr m0 b (Ptrofs.intval ofs) = Some (Vptrofs Ptrofs.one))
             (** set the permissions on the lock location equal to the max permissions on the memory*)
             (Hset_perm: setPermBlock (Some Writable)
                                      b (Ptrofs.intval ofs) ((getThreadR cnt0).2) LKSIZE_nat = pmap_tid')
@@ -197,7 +198,7 @@ Module DryHybridMachine.
                      else True )
             (Hrestrict_pmap: restrPermMap Hlt' = m1)
             (** acquire the lock*)
-            (Hstore: Mem.store Mint32 m1 b (Ptrofs.intval ofs) (Vint Int.zero) = Some m')
+            (Hstore: Mem.store Mptr m1 b (Ptrofs.intval ofs) (Vptrofs Ptrofs.zero) = Some m')
             (HisLock: lockRes tp (b, Ptrofs.intval ofs) = Some pmap)
             (Hangel1: permMapJoin pmap.1 (getThreadR cnt0).1 newThreadPerm.1)
             (Hangel2: permMapJoin pmap.2 (getThreadR cnt0).2 newThreadPerm.2)
@@ -235,14 +236,14 @@ Module DryHybridMachine.
             (Hrestrict_pmap0: restrPermMap (Hcompat tid0 cnt0).2 = m0)
             (** To release the lock the thread must have [Readable] permission on it*)
             (Haccess: Mem.range_perm m0 b (Ptrofs.intval ofs) ((Ptrofs.intval ofs) + LKSIZE) Cur Readable)
-            (Hload: Mem.load Mint32 m0 b (Ptrofs.intval ofs) = Some (Vint Int.zero))
+            (Hload: Mem.load Mptr m0 b (Ptrofs.intval ofs) = Some (Vptrofs Ptrofs.zero))
             (** set the permissions on the lock location equal to [Writable]*)
             (Hset_perm: setPermBlock (Some Writable)
                                      b (Ptrofs.intval ofs) ((getThreadR cnt0).2) LKSIZE_nat = pmap_tid')
             (Hlt': permMapLt pmap_tid' (getMaxPerm m))
             (Hrestrict_pmap: restrPermMap Hlt' = m1)
             (** release the lock *)
-            (Hstore: Mem.store Mint32 m1 b (Ptrofs.intval ofs) (Vint Int.one) = Some m')
+            (Hstore: Mem.store Mptr m1 b (Ptrofs.intval ofs) (Vptrofs Ptrofs.one) = Some m')
             (HisLock: lockRes tp (b, Ptrofs.intval ofs) = Some rmap)
             (Hrmap: forall b ofs, rmap.1 !! b ofs = None /\ rmap.2 !! b ofs = None)
             (Hangel1: permMapJoin newThreadPerm.1 virtueLP.1 (getThreadR cnt0).1)
@@ -276,7 +277,7 @@ Module DryHybridMachine.
             (* To check if the machine is at an external step and load its arguments install the thread data permissions*)
             (Hrestrict_pmap_arg: restrPermMap (Hcompat tid0 cnt0).1 = marg)
             (Hat_external: semantics.at_external semSem c marg = Some (CREATE, Vptr b ofs::arg::nil))
-            (Harg: Val.inject (Mem.flat_inj (Mem.nextblock m)) arg arg)
+(*            (Harg: Val.inject (Mem.flat_inj (Mem.nextblock m)) arg arg) *)
             (** we do not need to enforce the almost empty predicate on thread
            spawn as long as it's considered a synchronizing operation *)
             (Hangel1: permMapJoin newThreadPerm.1 threadPerm'.1 (getThreadR cnt0).1)
@@ -303,7 +304,7 @@ Module DryHybridMachine.
             (** To create the lock the thread must have [Writable] permission on it*)
             (Hfreeable: Mem.range_perm m1 b (Ptrofs.intval ofs) ((Ptrofs.intval ofs) + LKSIZE) Cur Writable)
             (** lock is created in acquired state*)
-            (Hstore: Mem.store Mint32 m1 b (Ptrofs.intval ofs) (Vint Int.zero) = Some m')
+            (Hstore: Mem.store Mptr m1 b (Ptrofs.intval ofs) (Vptrofs Ptrofs.zero) = Some m')
             (** The thread's data permissions are set to Nonempty*)
             (Hdata_perm: setPermBlock
                            (Some Nonempty)
@@ -380,7 +381,7 @@ Module DryHybridMachine.
            (** To acquire the lock the thread must have [Readable] permission on it*)
            (Haccess: Mem.range_perm m1 b (Ptrofs.intval ofs) ((Ptrofs.intval ofs) + LKSIZE) Cur Readable)
            (** Lock is already acquired.*)
-           (Hload: Mem.load Mint32 m1 b (Ptrofs.intval ofs) = Some (Vint Int.zero)),
+           (Hload: Mem.load Mptr m1 b (Ptrofs.intval ofs) = Some (Vptrofs Ptrofs.zero)),
           ext_step cnt0 Hcompat tp m (failacq (b, Ptrofs.intval ofs)).
 
     Definition threadStep: forall {tid0 ms m},
@@ -421,7 +422,7 @@ Module DryHybridMachine.
       - intros [cntj' [ q' running]].
         inversion H; subst.
         assert (cntj:=cntj').
-        eapply cntUpdate' with(c0:=Krun c')(p:=(getCurPerm m', (getThreadR cnt)#2)) in cntj; eauto.
+        eapply cntUpdate' with(c:=Krun c')(p:=(getCurPerm m', (getThreadR cnt)#2)) in cntj; eauto.
         exists cntj.
         destruct (NatTID.eq_tid_dec i j).
         + subst j; exists c.
@@ -513,7 +514,7 @@ Module DryHybridMachine.
               discriminate. }
           { (*remove lock*)
             pose proof (cntUpdate' _ _ cnt (cntRemoveL' _ cntj)) as cnti.
-            erewrite  gRemLockSetCode with (cnti0 := cntRemoveL' _ cntj) in running.
+            erewrite  gRemLockSetCode with (cnti := cntRemoveL' _ cntj) in running.
             rewrite gssThreadCode in running.
             discriminate. }
           { (*acquire lock*)
@@ -548,7 +549,7 @@ Module DryHybridMachine.
             * pose proof (cntUpdate' _ _ _ HH) as cntj0.
               exists cntj0, q.
               rewrite <- running.
-              erewrite gsoAddCode with (cntj1 := HH).
+              erewrite gsoAddCode with (cntj := HH).
               rewrite gsoThreadCode;
                 now eauto.
             * exfalso.
@@ -575,7 +576,7 @@ Module DryHybridMachine.
              reflexivity.
           - do 2 eexists;
               now eauto.
-            Grab Existential Variables.
+            Unshelve.
             apply cntUpdate;
               now eauto.
     Qed.
@@ -595,13 +596,12 @@ Module DryHybridMachine.
     Qed.
 
 
-    Definition initial_machine pmap c := mkPool (Krun c) (pmap, empty_map).
+    Definition initial_machine pmap c := mkPool (Krun c) (pmap, empty_map) (* (empty_map, empty_map) *).
 
     Definition init_mach (pmap : option res) (m: mem)
                (ms:thread_pool) (m' : mem) (v:val) (args:list val) : Prop :=
       exists c, semantics.initial_core semSem 0 m c m' v args /\
-           ms = mkPool (Krun c) (getCurPerm m', empty_map).
-    Set Printing All.
+           ms = mkPool (Krun c) (getCurPerm m', empty_map) (* (empty_map, empty_map) *).
 
 
 
@@ -669,28 +669,22 @@ Module DryHybridMachine.
       (** *Invariant Lemmas*)
 
       (** ** Updating the machine state**)
-      (* Many invaraint lemmas were removed from here. *)
-      
-    
+      (* Many invariant lemmas were removed from here. *)
+
+
     Notation thread_perms st i cnt:= (fst (@getThreadR _ _ _ st i cnt)).
     Notation lock_perms st i cnt:= (snd (@getThreadR  _ _ _ st i cnt)).
     Record thread_compat st i
            (cnt:containsThread st i) m:=
       { th_comp: permMapLt (thread_perms _ _ cnt) (getMaxPerm m);
         lock_comp: permMapLt (lock_perms _ _ cnt) (getMaxPerm m)}.
-    Instance thread_compat_proper st i:
+    #[export] Instance thread_compat_proper st i:
         Proper (Logic.eq ==> Max_equiv ==> iff) (@thread_compat st i).
-      Proof. setoid_help.proper_iff;
-               setoid_help.proper_intros; subst.
-             constructor.
-             - eapply permMapLt_equiv.
-               reflexivity.
-               symmetry; apply H0.
-               eapply H1.
-             - eapply permMapLt_equiv.
-               reflexivity.
-               symmetry; apply H0.
-               eapply H1.
+      Proof.
+        intros ?? <- ???.
+        split; intros [H0 H1]; constructor;
+          try (eapply permMapLt_equiv; last apply H0; done);
+          try (eapply permMapLt_equiv; last apply H1; done).
       Qed.
     Lemma mem_compatible_thread_compat:
       forall (st1 : ThreadPool.t) (m1 : mem) (tid : nat)
diff --git a/concurrency/common/HybridMachineSig.v b/concurrency/common/HybridMachineSig.v
index e09c25a912..7927938abe 100644
--- a/concurrency/common/HybridMachineSig.v
+++ b/concurrency/common/HybridMachineSig.v
@@ -32,6 +32,7 @@
 
 Require Import Strings.String.
 Require Import Coq.ZArith.ZArith.
+Require Import Lia.
 
 From mathcomp.ssreflect Require Import ssreflect seq ssrbool.
 Require Import compcert.common.Memory.
@@ -41,7 +42,7 @@ Require Import compcert.common.Values. (*for val*)
 Require Import compcert.common.Globalenvs.
 Require Import compcert.lib.Integers.
 
-Require Import VST.concurrency.common.core_semantics.
+(*Require Import VST.concurrency.common.core_semantics.*)
 Require Import VST.sepcomp.event_semantics.
 Require Export VST.concurrency.common.semantics.
 Require Import VST.concurrency.common.threadPool.
@@ -55,17 +56,21 @@ Require Import Coq.Program.Program.
 (*Require Import VST.concurrency.safety.
 Require Import VST.concurrency.coinductive_safety.*)
 
+Import Address.
+
+Set Bullet Behavior "Strict Subproofs".
+
 Notation EXIT :=
-  (EF_external "EXIT" (mksignature (AST.Tint::nil) None)).
-Notation CREATE_SIG := (mksignature (AST.Tint::AST.Tint::nil) None cc_default).
+  (EF_external "EXIT" (mksignature (AST.Tint::nil) Tvoid)).
+Notation CREATE_SIG := (mksignature (AST.Tptr::AST.Tptr::nil) Tvoid cc_default).
 Notation CREATE := (EF_external "spawn" CREATE_SIG).
 Notation MKLOCK :=
-  (EF_external "makelock" (mksignature (AST.Tptr::nil) None cc_default)).
+  (EF_external "makelock" (mksignature (AST.Tptr::nil) Tvoid cc_default)).
 Notation FREE_LOCK :=
-  (EF_external "freelock" (mksignature (AST.Tptr::nil) None cc_default)).
-Notation LOCK_SIG := (mksignature (AST.Tptr::nil) None cc_default).
+  (EF_external "freelock" (mksignature (AST.Tptr::nil) Tvoid cc_default)).
+Notation LOCK_SIG := (mksignature (AST.Tptr::nil) Tvoid cc_default).
 Notation LOCK := (EF_external "acquire" LOCK_SIG).
-Notation UNLOCK_SIG := (mksignature (AST.Tptr::nil) None cc_default).
+Notation UNLOCK_SIG := (mksignature (AST.Tptr::nil) Tvoid cc_default).
 Notation UNLOCK := (EF_external "release" UNLOCK_SIG).
 
 Module Events.
@@ -309,6 +314,17 @@ Module HybridMachineSig.
   Definition suspend_thread: forall (m: mem) {tid0 ms},
       containsThread ms tid0 -> machine_state -> Prop:=
     @suspend_thread'.
+
+  Inductive halted_thread': forall {tid0} {ms:machine_state},
+      containsThread ms tid0 -> int -> Prop:=
+  | HaltedThread: forall tid0 ms c i (ctn: containsThread ms tid0)
+                     (Hcode: getThreadC ctn = Krun c)
+                     (Hhalt: halted semSem c i),
+      halted_thread' ctn i.
+  Definition halted_thread: forall {tid0 ms},
+      containsThread ms tid0 -> int -> Prop:=
+    @halted_thread'.
+
     (** Provides control over scheduling. For example,
         for FineMach this is schedSkip, for CoarseMach this is just id *)
   Class Scheduler :=
@@ -354,6 +370,15 @@ Module HybridMachineSig.
           (Hcmpt: mem_compatible ms m)
           (Htstep: syncStep isCoarse Htid Hcmpt ms' m' ev),
           machine_step U tr ms m U' (tr ++ [:: external tid ev]) ms' m'
+    | halted_step:
+        forall tid U U' ms m tr i
+          (HschedN: schedPeek U = Some tid)
+          (Htid: containsThread ms tid)
+          (Hhalt: halted_thread Htid i)
+          (Hinv: invariant ms)
+          (Hcmpt: mem_compatible ms m)
+          (HschedS: schedSkip U = U'),        (*Schedule Forward*)
+          machine_step U tr ms m U' tr ms m
     | schedfail :
         forall tid U U' ms m tr
           (HschedN: schedPeek U = Some tid)
@@ -403,13 +428,13 @@ Module HybridMachineSig.
     intros. inversion H; subst; rewrite HschedN; intro Hcontra; discriminate.
     Defined.
 
-    Definition make_init_machine c r:= 
-        mkPool (Krun c) r.
+    Definition make_init_machine c r (* ex *) :=
+        mkPool (Krun c) r (* ex *).
     Definition init_machine' (the_ge : semG) m
-               c m' (f : val) (args : list val) 
+               c m' (f : val) (args : list val) (* ex *)
       : option res -> Prop := fun op_r =>
-                            if op_r is Some r then 
-                              init_mach op_r m (make_init_machine c r) m' f args
+                            if op_r is Some r then
+                              init_mach op_r m (make_init_machine c r (* ex *)) m' f args
                             else False.
     Definition init_machine'' (op_m: option mem)(op_r : option res)(m: mem)
                (tp : thread_pool) (m': mem) (f : val) (args : list val)
@@ -418,7 +443,7 @@ Module HybridMachineSig.
       if op_r is Some r then 
         init_mach op_r m tp m' f args
       else False.
-    
+
     Definition unique_Krun tp i :=
       forall j cnti q, 
         @getThreadC _ _ _ j tp cnti = Krun q ->
@@ -473,6 +498,15 @@ Module HybridMachineSig.
             (Hcmpt: mem_compatible ms m)
             (Htstep: syncStep isCoarse Htid Hcmpt ms' m' ev),
             external_step U tr ms m  U' (tr ++ [:: external tid ev]) ms' m'
+      | halted_step':
+          forall tid U U' ms m tr i
+            (HschedN: schedPeek U = Some tid)
+            (Htid: containsThread ms tid)
+            (Hhalt: halted_thread Htid i)
+            (Hinv: invariant ms)
+            (Hcmpt: mem_compatible ms m)
+            (HschedS: schedSkip U = U'),        (*Schedule Forward*)
+            external_step U tr ms m U' tr ms m
       | schedfail':
           forall tid U U' ms m tr
             (HschedN: schedPeek U = Some tid)
@@ -513,10 +547,10 @@ Module HybridMachineSig.
                  solve[econstructor 2 ; eauto]|
                  solve[econstructor 4 ; eauto]|
                  solve[econstructor 5 ; eauto]|
-                 solve[econstructor 6 ; eauto]].
+                 solve[econstructor 6 ; eauto]|
+                 solve[econstructor 7 ; eauto]].
       Qed.
 
-      Set Printing Implicit.
       Program Definition new_MachineSemantics (op_m:option Mem.mem):
         @ConcurSemantics G nat schedule event_trace machine_state mem res (*@semC Sem*).
       apply (@Build_ConcurSemantics _ nat schedule event_trace machine_state _ _ (*_*)
@@ -562,12 +596,9 @@ Module HybridMachineSig.
               {ThreadPool : ThreadPool.ThreadPool}
               {machineSig: MachineSig}.
 
-      Instance DilMem : DiluteMem :=
+      Program Instance DilMem : DiluteMem :=
         {| diluteMem := fun x => x |}.
-      intros.
-      split; auto.
-      Defined.
-      
+
       Instance scheduler : Scheduler :=
         {| isCoarse := true;
            yield := fun x => x |}.
@@ -628,14 +659,14 @@ Module HybridMachineSig.
       Proof.
         intros until 1; revert m.
         induction H; intros.
-        - assert (m0 = 0) by omega; subst; constructor.
+        - assert (m0 = 0) by lia; subst; constructor.
         - apply HaltedSafe; auto.
         - destruct m0; [constructor|].
           eapply CoreSafe; eauto.
-          apply IHcsafe; omega.
+          apply IHcsafe; lia.
         - destruct m0; [constructor|].
           eapply AngelSafe; eauto.
-          intro; apply H; omega.
+          intro; apply H; lia.
       Qed.
 
       Lemma schedSkip_id: forall U, schedSkip U = U -> U = nil.
@@ -673,6 +704,10 @@ Module HybridMachineSig.
           eapply suspend_step; eauto.
         - eapply AngelSafe; eauto.
           eapply sync_step; eauto.
+        - subst.
+          eapply AngelSafe; [|intro; eapply IHn0; eauto].
+          erewrite cats0.
+          eapply halted_step; eauto.
         - subst.
           eapply AngelSafe; [|intro; eapply IHn0; eauto].
           erewrite cats0.
@@ -682,7 +717,7 @@ Module HybridMachineSig.
       Lemma csafe_concur_safe: forall U tr tp m n, csafe (U, tr, tp) m n -> concur_safe U tp m n.
       Proof.
         intros.
-        remember (U, tr, tp) as st; revert dependent tp; revert U tr.
+        remember (U, tr, tp) as st; generalize dependent tp; revert U tr.
         induction H; intros; subst; simpl in *.
         - constructor.
         - constructor; auto.
@@ -721,6 +756,8 @@ Module HybridMachineSig.
           + setoid_rewrite List.app_nil_r.
             eapply suspend_step; eauto.
           + eapply sync_step; eauto.
+          + setoid_rewrite List.app_nil_r.
+            eapply halted_step; eauto.
           + setoid_rewrite List.app_nil_r.
             eapply schedfail; eauto.
       Qed.
diff --git a/concurrency/common/addressFiniteMap.v b/concurrency/common/addressFiniteMap.v
index 8a2a9f2619..8186b0e5c9 100644
--- a/concurrency/common/addressFiniteMap.v
+++ b/concurrency/common/addressFiniteMap.v
@@ -12,7 +12,6 @@ Require Import VST.msl.Coqlib2.
 Require Import VST.concurrency.common.sepcomp. Import SepComp.
 Require Import VST.concurrency.common.permissions.
 Require Import VST.concurrency.common.lksize.
-Set Bullet Behavior "Strict Subproofs".
 
   Module MiniAddressOrdered <: MiniOrderedType.
 
@@ -35,7 +34,7 @@ Set Bullet Behavior "Strict Subproofs".
            destruct (peq b b0), (peq b0 b1), (peq b b1),
            (plt b b0), (plt b0 b1), (plt b b1),
            (zlt z0 z1), (zlt z1 z), (zlt z0 z); subst;
-             simpl; intros; auto; try omega; (*Solves most*)
+             simpl; intros; auto; try lia; (*Solves most*)
              exfalso;
            (* solves al Plt x y /\ Plt y x *)
            try match goal with
@@ -59,7 +58,7 @@ Set Bullet Behavior "Strict Subproofs".
            unfold not; intros.
            inversion H0; subst.
            rewrite peq_true in H.
-           assert (HH: z0 >= z0) by omega.
+           assert (HH: z0 >= z0) by lia.
            destruct zlt as [a|b]; auto.
     Qed.
    Lemma compare : forall x y : t, Compare lt eq x y.
@@ -71,13 +70,13 @@ Set Bullet Behavior "Strict Subproofs".
               unfold lt, lt'.
               rewrite H0; simpl.
               unfold is_true.
-              destruct (zlt x2 y2); auto; omega.
+              destruct (zlt x2 y2); auto; lia.
             + constructor 3.
               unfold lt, lt'.
               destruct (peq x1 y1); try solve[inversion H0]; subst.
               destruct (peq y1 y1); simpl. clear e e0 H0.
-              destruct (zlt y2 x2); auto; omega.
-              destruct (zlt x2 y2); auto; omega.
+              destruct (zlt y2 x2); auto; lia.
+              destruct (zlt x2 y2); auto; lia.
             + constructor 2.
               subst; reflexivity.
           - destruct (plt x1 y1).
@@ -414,8 +413,8 @@ Proof.
   intros; if_tac; simpl in H.
   - destruct H; subst; apply setPermBlock_same; auto.
   - destruct (peq b b'); [|apply setPermBlock_other_2; auto].
-    subst; destruct (zle o o'); [|apply setPermBlock_other_1; omega].
-    destruct (zlt o' (o + Z.of_nat n)); [tauto | apply setPermBlock_other_1; omega].
+    subst; destruct (zle o o'); [|apply setPermBlock_other_1; lia].
+    destruct (zlt o' (o + Z.of_nat n)); [tauto | apply setPermBlock_other_1; lia].
 Qed.
 
 Lemma A2P_congr A e e' a : PMap_eq e e' -> PMap_eq (A2P e a) (@A2P A e' a).
diff --git a/concurrency/common/bounded_maps.v b/concurrency/common/bounded_maps.v
index c81cb91305..204998d6a3 100644
--- a/concurrency/common/bounded_maps.v
+++ b/concurrency/common/bounded_maps.v
@@ -13,9 +13,10 @@ Require Import VST.concurrency.common.lksize.
 Require Import VST.concurrency.common.permjoin_def.
 Require Import Coq.Program.Program.
 From mathcomp.ssreflect Require Import ssreflect ssrbool ssrnat ssrfun eqtype seq fintype finfun.
+Require Import Lia.
 Set Implicit Arguments.
 
-Require Import VST.concurrency.common.ssromega. (*omega in ssrnat *)
+Require Import VST.concurrency.common.ssromega. (*lia in ssrnat *)
 
 Require Import Coq.ZArith.ZArith.
 
@@ -93,26 +94,27 @@ Definition bounded_func {A} (f: Z -> option A): Prop :=
 Definition bounded_map {A} (m: PTree.t (Z -> option A)):=
   forall p f, m ! p = Some f -> bounded_func f.
 
-Fixpoint strong_tree_leq {A B}
+(*Fixpoint strong_tree_leq {A B}
          (t1: PTree.t A) (t2: PTree.t B)
          (leq: option A -> option B -> Prop):=
   match t1, t2 with
-  | PTree.Leaf, PTree.Leaf => True
-  | PTree.Node l1 o1 r1, PTree.Node l2 o2 r2 =>
+  | PTree.Empty, PTree.Empty => True
+  | PTree.Nodes l1 o1 r1, PTree.Node l2 o2 r2 =>
     leq o1 o2 /\
     strong_tree_leq l1 l2 leq /\
     strong_tree_leq r1 r2 leq
   | _, _ => False
   end.
 
+(* This is an atrocity. Trying to see if we can do without it. *)
 Definition same_shape {A B} (m1: PTree.t (Z -> option A))(m2: PTree.t (Z -> option B)):=
-  strong_tree_leq m1 m2 option_eq.
+  strong_tree_leq m1 m2 option_eq.*)
 
-Definition sub_map' {A B} (m1: PTree.t (Z -> option A))(m2: PTree.t (Z -> option B)):=
+Definition sub_map {A B} (m1: PTree.t (Z -> option A))(m2: PTree.t (Z -> option B)):=
   forall p f1, m1 ! p = Some f1 ->
           exists f2, m2 ! p = Some f2 /\ fun_leq' f1 f2.
 
-Definition sub_map {A B} (m1: PTree.t (Z -> option A))(m2: PTree.t (Z -> option B)):=
+(*Definition sub_map {A B} (m1: PTree.t (Z -> option A))(m2: PTree.t (Z -> option B)):=
   strong_tree_leq m1 m2 fun_leq.
 
 Lemma sub_map_and_shape:
@@ -144,7 +146,7 @@ Proof.
       eapply IHm1_2; eauto.
       move => b f HH.
       move: H0 => /(_  (b~1)%positive f HH) //.
-Qed.
+Qed.*)
 
 Definition nat_to_perm (i:nat) :=
   (match i with
@@ -241,7 +243,7 @@ Proof.
      extensionality b.
      symmetry.
      apply H.
-     apply /leP. omega.
+     apply /leP. lia.
 
    - destruct IHhi as [N [FN H]].
      exists (6*N)%nat.
@@ -259,17 +261,17 @@ Proof.
        * simpl; eapply HH.
          move: pphi=> /leP pphi.
          apply /ltP.
-         omega.
+         lia.
 
      + exists ((6 * i) + (perm_to_nat (f hi))).
        split.
        * replace (6 * N) with
          (6 * (N - 1) + 6 ).
-         { eapply (NPeano.Nat.lt_le_trans _ (6 * i  + 6)).
+         { eapply (Nat.lt_le_trans _ (6 * i  + 6)).
            - apply /leP.
              rewrite ltn_add2l.
              destruct (f hi) as [p|];
-               [destruct p; try destruct p|]; simpl; apply /leP; try omega.
+               [destruct p; try destruct p|]; simpl; apply /leP; try lia.
            - apply /leP.
              rewrite leq_add2r.
              rewrite leq_pmul2l.
@@ -279,21 +281,21 @@ Proof.
                by rewrite - ltnS; apply /leP.
                rewrite -addn1.
                apply subnK.
-               destruct N; apply /ltP; try omega.
+               destruct N; apply /ltP; try lia.
              + compute; auto.
          }
          rewrite - mulnSr.
          replace (N -1).+1 with N; auto.
          rewrite -addn1.
          symmetry; apply subnK.
-         destruct N; apply /ltP; try omega.
+         destruct N; apply /ltP; try lia.
        * { extensionality i0.
            destruct (Nat.eq_dec i0 hi).
            - subst.
              rewrite addnC.
              rewrite mulnC.
-             rewrite NPeano.Nat.mod_add; try omega.
-             rewrite NPeano.Nat.mod_small;
+             rewrite Nat.mod_add; try lia.
+             rewrite Nat.mod_small;
                try (apply /ltP; eapply perm_to_nat_bound).
              rewrite nat_to_perm_perm_to_nat.
              reflexivity.
@@ -304,7 +306,7 @@ Proof.
                destruct (Nat.eq_dec i0 hi);
                  try solve [exfalso; apply n; auto].
                reflexivity.
-             + eapply NPeano.Nat.div_unique;
+             + eapply Nat.div_unique;
                try (apply /ltP; eapply perm_to_nat_bound).
                reflexivity.
          }
@@ -329,7 +331,7 @@ Proof.
      extensionality b.
      symmetry.
      apply H.
-     apply /leP. omega.
+     apply /leP. lia.
 
    - destruct IHhi as [N [FN H]].
      exists (5*N)%nat.
@@ -347,16 +349,16 @@ Proof.
        * simpl; eapply HH.
          move: pphi=> /leP pphi.
          apply /ltP.
-         omega.
+         lia.
 
      + exists ((5 * i) + (perm_to_nat_simpl (f hi))).
        split.
        * replace (5 * N) with
          (5 * (N - 1) + 5 ).
-         { eapply (NPeano.Nat.lt_le_trans _ (5 * i  + 5)).
+         { eapply (Nat.lt_le_trans _ (5 * i  + 5)).
            - apply /leP.
              rewrite ltn_add2l.
-             destruct (f hi) as [p|]; [destruct p|]; simpl; apply /leP; try omega.
+             destruct (f hi) as [p|]; [destruct p|]; simpl; apply /leP; try lia.
            - apply /leP.
              rewrite leq_add2r.
              rewrite leq_pmul2l.
@@ -366,21 +368,21 @@ Proof.
                by rewrite - ltnS; apply /leP.
                rewrite -addn1.
                apply subnK.
-               destruct N; apply /ltP; try omega.
+               destruct N; apply /ltP; try lia.
              + compute; auto.
          }
          rewrite - mulnSr.
          replace (N -1).+1 with N; auto.
          rewrite -addn1.
          symmetry; apply subnK.
-         destruct N; apply /ltP; try omega.
+         destruct N; apply /ltP; try lia.
        * { extensionality i0.
            destruct (Nat.eq_dec i0 hi).
            - subst.
              rewrite addnC.
              rewrite mulnC.
-             rewrite NPeano.Nat.mod_add; try omega.
-             rewrite NPeano.Nat.mod_small;
+             rewrite Nat.mod_add; try lia.
+             rewrite Nat.mod_small;
                try (apply /ltP; eapply perm_to_nat_bound_simpl).
              rewrite nat_to_perm_perm_to_nat_simpl.
              reflexivity.
@@ -391,7 +393,7 @@ Proof.
                destruct (Nat.eq_dec i0 hi);
                  try solve [exfalso; apply n; auto].
                reflexivity.
-             + eapply NPeano.Nat.div_unique;
+             + eapply Nat.div_unique;
                try (apply /ltP; eapply perm_to_nat_bound_simpl).
                reflexivity.
          }
@@ -446,7 +448,7 @@ Proof.
     + eapply H2.
       eapply Z.le_lt_trans; eauto.
     + eapply H1; assumption.
-  - assert (0 <= hi - lo)%Z by omega.
+  - assert (0 <= hi - lo)%Z by lia.
     pose (n:= Z.to_nat (hi - lo)).
     destruct (finite_bounded_nat_func n) as [N [FN HN]].
     exists N.
@@ -461,7 +463,7 @@ Proof.
       eapply BOUND1.
       unfold n in ineq.
       cut (Z.of_nat b > hi - lo)%Z.
-      omega.
+      lia.
       move: ineq => /ltP /inj_lt /Z.gt_lt_iff.
       rewrite Z2Nat.id => //.
     }
@@ -477,8 +479,8 @@ Proof.
         by apply BOUND2.
     + simpl.
       rewrite Z2Nat.id.
-      * f_equal; omega.
-      * omega.
+      * f_equal; lia.
+      * lia.
 Qed.
 
 
@@ -500,7 +502,7 @@ Proof.
     + eapply H2.
       eapply Z.le_lt_trans; eauto.
     + eapply H1; assumption.
-  - assert (0 <= hi - lo)%Z by omega.
+  - assert (0 <= hi - lo)%Z by lia.
     pose (n:= Z.to_nat (hi - lo)).
     destruct (finite_bounded_nat_func_simpl n) as [N [FN HN]].
     exists N.
@@ -515,7 +517,7 @@ Proof.
       eapply BOUND1.
       unfold n in ineq.
       cut (Z.of_nat b > hi - lo)%Z.
-      omega.
+      lia.
       move: ineq => /ltP /inj_lt /Z.gt_lt_iff.
       rewrite Z2Nat.id => //.
     }
@@ -531,8 +533,8 @@ Proof.
         by apply BOUND2.
     + simpl.
       rewrite Z2Nat.id.
-      * f_equal; omega.
-      * omega.
+      * f_equal; lia.
+      * lia.
 Qed.
 
 Lemma finite_bounded_op_func_simpl:
@@ -550,12 +552,13 @@ Proof.
   destruct f.
   - move: FN_spec => /(_ _ H) [] i [] ineqi speci.
     exists (S i); split.
-    + omega.
+    + lia.
     + rewrite - speci.
       simpl; repeat f_equal.
       rewrite - addn1 - addnBA=> //.
+      ssromega.
   - exists 0; split; auto.
-    + omega.
+    + lia.
 Qed.
 
 Lemma finite_bounded_op_func:
@@ -573,15 +576,16 @@ Proof.
   destruct f.
   - move: FN_spec => /(_ _ H) [] i [] ineqi speci.
     exists (S i); split.
-    + omega.
+    + lia.
     + rewrite - speci.
       simpl; repeat f_equal.
       rewrite - addn1 - addnBA=> //.
+      ssromega.
   - exists 0; split; auto.
-    + omega.
+    + lia.
 Qed.
 
-Lemma finite_sub_maps:
+(*Lemma finite_sub_maps:
   forall m2,
     @bounded_map permission m2 ->
     konig.finite
@@ -637,7 +641,7 @@ Proof.
       intros x spec.
       destruct x.
       * exists 0%nat; split; auto.
-        omega.
+        lia.
       * move: spec .
         rewrite /sub_map /= => [] [] FUN_lq [] tree1 tree2.
         assert (bounded_func_op o hi lo).
@@ -690,7 +694,7 @@ Proof.
                 rewrite -mulnDl.
                 rewrite mulnC.
                 apply /leP.
-                rewrite leq_pmul2l; try (apply /ltP; omega).
+                rewrite leq_pmul2l; try (apply /ltP; lia).
                 apply /leP.
                 eapply lt_n_Sm_le.
                 rewrite - addn1.
@@ -698,7 +702,7 @@ Proof.
                 2:
                   rewrite muln_gt0;
                   apply /andP; split;
-                  try (apply /ltP; omega).
+                  try (apply /ltP; lia).
                 eapply (NPeano.Nat.lt_le_trans).
                 -- instantiate (1:= N2 + i * N2).
                    apply /ltP.
@@ -710,7 +714,7 @@ Proof.
                    rewrite leq_pmul2l.
                    rewrite add1n.
                    apply /ltP; auto.
-                   apply /ltP; omega.
+                   apply /ltP; lia.
                    rewrite mulnDr.
                    rewrite mulnC.
                    f_equal.
@@ -727,7 +731,7 @@ Proof.
               2:
                 rewrite muln_gt0;
                 apply /andP; split;
-                try (apply /ltP; omega).
+                try (apply /ltP; lia).
               rewrite -mulnA.
               rewrite mulnA.
               rewrite mulnC; auto.
@@ -738,9 +742,9 @@ Proof.
          ++ rewrite - fi1.
             f_equal.
             rewrite -addn1.
-            rewrite -addnBA. 2: ssromega.
+            rewrite -addnBA. 2: ssrlia.
             replace (i1 + i2 * N1 + i * N1 * N2 + (1 - 1)) with
-            (i1 + i2 * N1 + i * N1 * N2) by ssromega.
+            (i1 + i2 * N1 + i * N1 * N2) by ssrlia.
             replace (i1 + i2 * N1 + i * N1 * N2) with
             (i1 + (i2  + i *  N2) * N1).
             2:
@@ -748,13 +752,13 @@ Proof.
             do 2 rewrite -mulnA; f_equal; rewrite mulnC; auto.
             rewrite NPeano.Nat.mod_add.
             apply NPeano.Nat.mod_small; auto.
-            destruct N1; omega.
+            destruct N1; lia.
          ++ rewrite - fi.
             f_equal.
             rewrite -addn1.
-            rewrite -addnBA. 2: ssromega.
+            rewrite -addnBA. 2: ssrlia.
             replace (i1 + i2 * N1 + i * N1 * N2 + (1 - 1)) with
-            (i1 + i2 * N1 + i * N1 * N2) by ssromega.
+            (i1 + i2 * N1 + i * N1 * N2) by ssrlia.
             assert (i1 + i2 * N1 + i * N1 * N2 =
                     ((N1 * N2) * i) + (i1 + i2 * N1)).
             { rewrite addnC. f_equal.
@@ -769,16 +773,16 @@ Proof.
                rewrite mulnC.
                apply /leP; rewrite leq_pmul2l.
                apply /ltP; auto.
-               destruct N1; ssromega.
+               destruct N1; ssrlia.
                rewrite mulnDl; f_equal.
-               ssromega.
+               ssrlia.
 
          ++ rewrite - fi2.
             f_equal.
             rewrite -addn1.
-            rewrite -addnBA. 2: ssromega.
+            rewrite -addnBA. 2: ssrlia.
             replace (i1 + i2 * N1 + i * N1 * N2 + (1 - 1)) with
-            (i1 + i2 * N1 + i * N1 * N2) by ssromega.
+            (i1 + i2 * N1 + i * N1 * N2) by ssrlia.
             assert (i1 + i2 * N1 + i * N1 * N2 =
                     (N1 * (i2 + i * N2)) + i1).
             { rewrite -addnA.
@@ -792,7 +796,7 @@ Proof.
             rewrite - H0.
             rewrite NPeano.Nat.mod_add.
             apply NPeano.Nat.mod_small; auto.
-            destruct N2; omega.
+            destruct N2; lia.
     + exists (S( N1 * N2)).
       exists (fun n => if n == 0
                then PTree.Leaf
@@ -804,7 +808,7 @@ Proof.
       intros x spec.
       destruct x.
       * exists 0%nat; split; auto.
-        omega.
+        lia.
       * move: spec .
         rewrite /sub_map /= => [] [] FUN_lq [] tree1 tree2.
         move : spec_F1 => /(_ _ tree1) [] i1 [] ineq1 fi1.
@@ -823,19 +827,19 @@ Proof.
               apply /leP.
               rewrite mulnC.
               apply /leP.
-              rewrite leq_pmul2l; try (apply /ltP; omega).
+              rewrite leq_pmul2l; try (apply /ltP; lia).
               apply /leP.
               eapply lt_n_Sm_le.
               rewrite - addn1.
               rewrite subnK; auto.
-              destruct N2; ssromega.
+              destruct N2; ssrlia.
 
           - replace (N1 + N1 * (N2 - 1))
             with (N1 * 1 + N1 * (N2 - 1)).
             + rewrite -mulnDr.
               rewrite addnC.
               rewrite subnK.
-              2: ssromega.
+              2: ssrlia.
               rewrite mulnC; auto.
             + f_equal.
               rewrite mulnC.
@@ -844,19 +848,19 @@ Proof.
          ++ rewrite - fi1.
             f_equal.
             rewrite -addn1.
-            rewrite -addnBA. 2: ssromega.
+            rewrite -addnBA. 2: ssrlia.
             replace (i1 + i2 * N1 + (1 - 1)) with
-            (i1 + i2 * N1) by ssromega.
+            (i1 + i2 * N1) by ssrlia.
             rewrite NPeano.Nat.mod_add.
             apply NPeano.Nat.mod_small; auto.
-            destruct N1; omega.
+            destruct N1; lia.
          ++ destruct o; auto; inversion FUN_lq.
          ++ rewrite - fi2.
             f_equal.
             rewrite -addn1.
-            rewrite -addnBA. 2: ssromega.
+            rewrite -addnBA. 2: ssrlia.
             replace (i1 + i2 * N1 + (1 - 1)) with
-            (i1 + i2 * N1 ) by ssromega.
+            (i1 + i2 * N1 ) by ssrlia.
             assert (i1 + i2 * N1 =
                     (N1 * (i2) + i1)).
             { rewrite mulnC addnC; auto. }
@@ -922,7 +926,7 @@ Proof.
       intros x spec.
       destruct x.
       * exists 0%nat; split; auto.
-        omega.
+        lia.
       * move: spec .
         rewrite /sub_map /= => [] [] FUN_lq [] tree1 tree2.
         assert (bounded_func_op o hi lo).
@@ -975,7 +979,7 @@ Proof.
                 rewrite -mulnDl.
                 rewrite mulnC.
                 apply /leP.
-                rewrite leq_pmul2l; try (apply /ltP; omega).
+                rewrite leq_pmul2l; try (apply /ltP; lia).
                 apply /leP.
                 eapply lt_n_Sm_le.
                 rewrite - addn1.
@@ -983,7 +987,7 @@ Proof.
                 2:
                   rewrite muln_gt0;
                   apply /andP; split;
-                  try (apply /ltP; omega).
+                  try (apply /ltP; lia).
                 eapply (NPeano.Nat.lt_le_trans).
                 -- instantiate (1:= N2 + i * N2).
                    apply /ltP.
@@ -995,7 +999,7 @@ Proof.
                    rewrite leq_pmul2l.
                    rewrite add1n.
                    apply /ltP; auto.
-                   apply /ltP; omega.
+                   apply /ltP; lia.
                    rewrite mulnDr.
                    rewrite mulnC.
                    f_equal.
@@ -1012,7 +1016,7 @@ Proof.
               2:
                 rewrite muln_gt0;
                 apply /andP; split;
-                try (apply /ltP; omega).
+                try (apply /ltP; lia).
               rewrite -mulnA.
               rewrite mulnA.
               rewrite mulnC; auto.
@@ -1023,9 +1027,9 @@ Proof.
          ++ rewrite - fi1.
             f_equal.
             rewrite -addn1.
-            rewrite -addnBA. 2: ssromega.
+            rewrite -addnBA. 2: ssrlia.
             replace (i1 + i2 * N1 + i * N1 * N2 + (1 - 1)) with
-            (i1 + i2 * N1 + i * N1 * N2) by ssromega.
+            (i1 + i2 * N1 + i * N1 * N2) by ssrlia.
             replace (i1 + i2 * N1 + i * N1 * N2) with
             (i1 + (i2  + i *  N2) * N1).
             2:
@@ -1033,13 +1037,13 @@ Proof.
             do 2 rewrite -mulnA; f_equal; rewrite mulnC; auto.
             rewrite NPeano.Nat.mod_add.
             apply NPeano.Nat.mod_small; auto.
-            destruct N1; omega.
+            destruct N1; lia.
          ++ rewrite - fi.
             f_equal.
             rewrite -addn1.
-            rewrite -addnBA. 2: ssromega.
+            rewrite -addnBA. 2: ssrlia.
             replace (i1 + i2 * N1 + i * N1 * N2 + (1 - 1)) with
-            (i1 + i2 * N1 + i * N1 * N2) by ssromega.
+            (i1 + i2 * N1 + i * N1 * N2) by ssrlia.
             assert (i1 + i2 * N1 + i * N1 * N2 =
                     ((N1 * N2) * i) + (i1 + i2 * N1)).
             { rewrite addnC. f_equal.
@@ -1054,16 +1058,16 @@ Proof.
                rewrite mulnC.
                apply /leP; rewrite leq_pmul2l.
                apply /ltP; auto.
-               destruct N1; ssromega.
+               destruct N1; ssrlia.
                rewrite mulnDl; f_equal.
-               ssromega.
+               ssrlia.
 
          ++ rewrite - fi2.
             f_equal.
             rewrite -addn1.
-            rewrite -addnBA. 2: ssromega.
+            rewrite -addnBA. 2: ssrlia.
             replace (i1 + i2 * N1 + i * N1 * N2 + (1 - 1)) with
-            (i1 + i2 * N1 + i * N1 * N2) by ssromega.
+            (i1 + i2 * N1 + i * N1 * N2) by ssrlia.
             assert (i1 + i2 * N1 + i * N1 * N2 =
                     (N1 * (i2 + i * N2)) + i1).
             { rewrite -addnA.
@@ -1077,7 +1081,7 @@ Proof.
             rewrite - H0.
             rewrite NPeano.Nat.mod_add.
             apply NPeano.Nat.mod_small; auto.
-            destruct N2; omega.
+            destruct N2; lia.
     + exists (S( N1 * N2)).
       exists (fun n => if n == 0
                then PTree.Leaf
@@ -1089,7 +1093,7 @@ Proof.
       intros x spec.
       destruct x.
       * exists 0%nat; split; auto.
-        omega.
+        lia.
       * move: spec .
         rewrite /sub_map /= => [] [] FUN_lq [] tree1 tree2.
         move : spec_F1 => /(_ _ tree1) [] i1 [] ineq1 fi1.
@@ -1108,19 +1112,19 @@ Proof.
               apply /leP.
               rewrite mulnC.
               apply /leP.
-              rewrite leq_pmul2l; try (apply /ltP; omega).
+              rewrite leq_pmul2l; try (apply /ltP; lia).
               apply /leP.
               eapply lt_n_Sm_le.
               rewrite - addn1.
               rewrite subnK; auto.
-              destruct N2; ssromega.
+              destruct N2; ssrlia.
 
           - replace (N1 + N1 * (N2 - 1))
             with (N1 * 1 + N1 * (N2 - 1)).
             + rewrite -mulnDr.
               rewrite addnC.
               rewrite subnK.
-              2: ssromega.
+              2: ssrlia.
               rewrite mulnC; auto.
             + f_equal.
               rewrite mulnC.
@@ -1129,26 +1133,26 @@ Proof.
          ++ rewrite - fi1.
             f_equal.
             rewrite -addn1.
-            rewrite -addnBA. 2: ssromega.
+            rewrite -addnBA. 2: ssrlia.
             replace (i1 + i2 * N1 + (1 - 1)) with
-            (i1 + i2 * N1) by ssromega.
+            (i1 + i2 * N1) by ssrlia.
             rewrite NPeano.Nat.mod_add.
             apply NPeano.Nat.mod_small; auto.
-            destruct N1; omega.
+            destruct N1; lia.
          ++ destruct o; auto; inversion FUN_lq.
          ++ rewrite - fi2.
             f_equal.
             rewrite -addn1.
-            rewrite -addnBA. 2: ssromega.
+            rewrite -addnBA. 2: ssrlia.
             replace (i1 + i2 * N1 + (1 - 1)) with
-            (i1 + i2 * N1 ) by ssromega.
+            (i1 + i2 * N1 ) by ssrlia.
             assert (i1 + i2 * N1 =
                     (N1 * (i2) + i1)).
             { rewrite mulnC addnC; auto. }
             eapply NPeano.Nat.div_unique in H0; auto.
             rewrite - H0.
             apply NPeano.Nat.mod_small; auto.
-Qed.
+Qed.*)
 
 Lemma fun_leq_trans: forall {A B C} f1 f2 f3, @fun_leq A B f1 f2 -> @fun_leq B C f2 f3 ->
   @fun_leq A C f1 f3.
@@ -1156,7 +1160,7 @@ Proof.
   unfold fun_leq, fun_leq'; destruct f1, f2, f3; auto.
 Qed.
 
-Lemma sub_map_trans: forall {A B C} m1 m2 m3, @sub_map A B m1 m2 -> @sub_map B C m2 m3 ->
+(*Lemma sub_map_trans: forall {A B C} m1 m2 m3, @sub_map A B m1 m2 -> @sub_map B C m2 m3 ->
   @sub_map A C m1 m3.
 Proof.
   unfold sub_map; induction m1; destruct m2; intros; inversion H; destruct m3; inversion H0;
@@ -1257,3 +1261,4 @@ Proof.
   intros. eapply strong_tree_leq_spec; try constructor.
   eapply H.
 Qed.
+*)
diff --git a/concurrency/common/dry_context.v b/concurrency/common/dry_context.v
index 4b2f88868d..f3e9012c8a 100644
--- a/concurrency/common/dry_context.v
+++ b/concurrency/common/dry_context.v
@@ -27,11 +27,10 @@ Module AsmContext.
     Existing Instance DryHybridMachine.DryHybridMachineSig.
 
     (** Instantiating the Dry Fine Concurrency Machine *)
-    Instance FineDilMem : DiluteMem :=
+    Program Instance FineDilMem : DiluteMem :=
       {| diluteMem := setMaxPerm |}.
-    intros.
-    split; auto.
-    Defined.
+    Next Obligation.
+    Proof. intuition. Qed.
     Instance dryFineMach : @HybridMachine _ _ _ _ _ _ :=
       HybridFineMachine.HybridFineMachine.
 
@@ -44,11 +43,10 @@ Module AsmContext.
     (** Instatiating the Bare Concurrency Machine *)
     Existing Instance BareMachine.resources.
 
-    Instance BareDilMem : DiluteMem :=
+    Program Instance BareDilMem : DiluteMem :=
       {| diluteMem := erasePerm |}.
-    intros.
-    split; auto.
-    Defined.
+    Next Obligation.
+    Proof. intuition. Qed.
     Instance bareMach : @HybridMachine BareMachine.resources _ OrdinalPool.OrdinalThreadPool _ _ _ :=
       @HybridFineMachine.HybridFineMachine BareMachine.resources _ _ BareMachine.BareMachineSig BareDilMem.
 
@@ -70,4 +68,3 @@ Module AsmContext.
   End AsmContext.
 End AsmContext.
 
-
diff --git a/concurrency/common/dry_machine_lemmas.v b/concurrency/common/dry_machine_lemmas.v
index 204bc097c3..5459ddf2d1 100644
--- a/concurrency/common/dry_machine_lemmas.v
+++ b/concurrency/common/dry_machine_lemmas.v
@@ -1,4 +1,5 @@
 (** * Lemmas about the Dry Machine*)
+Require Export Lia.
 Require Import compcert.lib.Axioms.
 
 Require Import VST.concurrency.common.sepcomp. Import SepComp.
@@ -28,6 +29,8 @@ Require Import VST.concurrency.common.threadPool.
 Require Import VST.concurrency.common.semantics.
 Require Import VST.concurrency.common.tactics.
 
+Set Bullet Behavior "Strict Subproofs".
+
 Global Notation "a # b" := (Maps.PMap.get b a) (at level 1).
 
 (** This file holds various results about the dry machine*)
@@ -37,13 +40,13 @@ Module ThreadPoolWF.
   Import HybridMachine ThreadPool DryHybridMachine HybridMachineSig.
   Section ThreadPoolWF.
     Context {Sem : Semantics}.
-    
+
     Existing Instance DryHybridMachine.dryResources.
-    Existing Instance OrdinalPool.OrdinalThreadPool.   
+    Existing Instance OrdinalPool.OrdinalThreadPool.
     (** Take an instance of the Dry Machine *)
     Existing Instance DryHybridMachine.DryHybridMachineSig.
 
-    
+
   Lemma unlift_m_inv :
     forall tp tid (Htid : tid < (OrdinalPool.num_threads tp).+1) ord
       (Hunlift: unlift (ordinal_pos_incr (OrdinalPool.num_threads tp))
@@ -132,10 +135,10 @@ Module ThreadPoolWF.
   Defined. *)
 
   Lemma initial_invariant0: forall pmap c,
-      DryHybridMachine.invariant (mkPool c (pmap, empty_map)).
+      DryHybridMachine.invariant (mkPool c (pmap, empty_map) (* (empty_map, empty_map) *)).
   Proof.
     intros pmap c.
-    pose (IM:=mkPool c (pmap,empty_map)); fold IM.
+    pose (IM:=mkPool c (pmap,empty_map) (* (empty_map, empty_map) *)); fold IM.
     assert (isZ: forall i, OrdinalPool.containsThread IM i -> (i = 0)%N).
     { rewrite /containsThread /IM /=.
       move => i; destruct i; first[reflexivity | intros HH; inversion HH].
@@ -172,6 +175,32 @@ Module ThreadPoolWF.
       rewrite / IM /= //.
   Qed.
 
+  Lemma initial_mem_compatible: forall c m,
+      mem_compatible (mkPool c (getCurPerm m, empty_map) (* (empty_map, empty_map) *)) m.
+  Proof.
+    intros c m.
+    pose (IM:=mkPool c (getCurPerm m,empty_map) (* (empty_map, empty_map) *)); fold IM.
+    assert (isZ: forall i, OrdinalPool.containsThread IM i -> (i = 0)%N).
+    { rewrite /containsThread /IM /=.
+      move => i; destruct i; first[reflexivity | intros HH; inversion HH].
+    }
+    assert (noLock: forall l rm,
+               OrdinalPool.lockRes IM l = Some rm -> False).
+    { rewrite /OrdinalPool.lockRes /IM /=.
+      move => l rm.
+      rewrite /lockRes
+              /OrdinalPool.mkPool
+              /OrdinalPool.empty_lset /= OrdinalPool.find_empty => HH.
+      inversion HH.
+    }
+
+    constructor; try done.
+    intros ??.
+    pose proof (isZ _ cnt); subst.
+    subst IM; simpl.
+    split; [apply cur_lt_max | apply empty_LT].
+  Qed.
+
   Lemma updThread_inv: forall ds i (cnt: containsThread ds i) c pmap,
       invariant ds ->
       (forall j (cnt: containsThread ds j),
@@ -495,7 +524,7 @@ Module ThreadPoolWF.
         erewrite gsolockResUpdLock.
         apply Hvalid1 || apply Hvalid2; auto.
         intros Hcontra; inversion Hcontra; subst.
-        now omega.
+        now lia.
       + rewrite gsolockResUpdLock; auto.
         specialize (lockRes_valid0 b' ofs').
         destruct (lockRes tp (b', ofs')) eqn:Hres;
@@ -696,10 +725,10 @@ Module ThreadPoolWF.
   Lemma invariant_freeable_empty_threads:
     forall tp i (cnti: containsThread tp i) b ofs
       (Hinv: invariant tp)
-      (Hfreeable: (getThreadR cnti).1 !! b ofs = Some Freeable),
+      (Hfreeable: (getThreadR cnti).1 # b ofs = Some Freeable),
     forall j (cntj: containsThread tp j),
-      (getThreadR cntj).2 !! b ofs = None /\
-      (i <> j -> (getThreadR cntj).1 !! b ofs = None).
+      (getThreadR cntj).2 # b ofs = None /\
+      (i <> j -> (getThreadR cntj).1 # b ofs = None).
   Proof.
     intros.
     pose proof ((thread_data_lock_coh _ Hinv _ cntj).1 _ cnti b ofs) as Hcoh.
@@ -707,7 +736,7 @@ Module ThreadPoolWF.
     simpl in Hcoh.
     split.
     simpl.
-    destruct ((OrdinalPool.getThreadR cntj).2 !! b ofs); auto; now exfalso.
+    destruct ((OrdinalPool.getThreadR cntj).2 # b ofs); auto; now exfalso.
     intros Hneq.
     pose proof ((no_race_thr _ Hinv _ _ cnti cntj Hneq).1 b ofs).
     rewrite Hfreeable in H.
@@ -719,11 +748,11 @@ Module ThreadPoolWF.
   Lemma invariant_freeable_empty_locks:
     forall tp i (cnti: containsThread tp i) b ofs
       (Hinv: invariant tp)
-      (Hfreeable: (getThreadR cnti).1 !! b ofs = Some Freeable),
+      (Hfreeable: (getThreadR cnti).1 # b ofs = Some Freeable),
     forall laddr rmap,
       lockRes tp laddr = Some rmap ->
-      rmap.1 !! b ofs = None /\
-      rmap.2 !! b ofs = None.
+      rmap.1 # b ofs = None /\
+      rmap.2 # b ofs = None.
   Proof.
     intros.
     pose proof ((locks_data_lock_coh _ Hinv _ _ H).1 _ cnti b ofs) as Hcoh.
@@ -734,7 +763,7 @@ Module ThreadPoolWF.
     inversion Hdisjoint;
       now auto.
     simpl in Hcoh;
-      destruct (rmap.2 !! b ofs); eauto; by exfalso.
+      destruct (rmap.2 # b ofs); eauto; by exfalso.
   Qed.
 
   Lemma mem_compatible_invalid_block:
@@ -742,12 +771,12 @@ Module ThreadPoolWF.
       (Hcomp: mem_compatible tp m)
       (Hinvalid: ~ Mem.valid_block m b),
       (forall i (cnti: containsThread tp i),
-          (getThreadR cnti).1 !! b ofs = None /\
-          (getThreadR cnti).2 !! b ofs = None) /\
+          (getThreadR cnti).1 # b ofs = None /\
+          (getThreadR cnti).2 # b ofs = None) /\
       (forall laddr rmap,
           lockRes tp laddr = Some rmap ->
-          rmap.1 !! b ofs = None /\
-          rmap.2 !! b ofs = None).
+          rmap.1 # b ofs = None /\
+          rmap.2 # b ofs = None).
   Proof.
     intros.
     destruct Hcomp.
@@ -782,7 +811,7 @@ Module ThreadPoolWF.
     unfold OrdinalPool.mkPool in *. simpl in *.
     unfold OrdinalPool.containsThread in *. simpl in *.
     clear - H.
-    ssromega.
+    ssrlia.
   Qed.
 
   (** [getThreadR] on the initial thread returns the [access_map] that was used
@@ -880,7 +909,7 @@ Module CoreLanguage.
               (Hvalid: Mem.valid_block m b)
               (Hstable: ~ Mem.perm m b ofs Cur Writable),
               Maps.ZMap.get ofs (Maps.PMap.get b (Mem.mem_contents m)) =
-              Maps.ZMap.get ofs (Maps.PMap.get b (Mem.mem_contents m'));          
+              Maps.ZMap.get ofs (Maps.PMap.get b (Mem.mem_contents m'));
           (** Memories between thread steps are related by [decay] of permissions*)
           corestep_decay:
             forall c c' m m',
@@ -936,8 +965,7 @@ Module CoreLanguage.
         intros.
         eapply corestep_nextblock in H.
         unfold Mem.valid_block, Coqlib.Plt in *.
-        zify;
-          by omega.
+        lia.
       Qed.
 
       Lemma initial_core_validblock:
@@ -949,8 +977,7 @@ Module CoreLanguage.
         intros.
         eapply initial_core_nextblock in H.
         unfold Mem.valid_block, Coqlib.Plt in *.
-        zify;
-          by omega.
+        lia.
       Qed.
 
       Definition ev_step_det:
@@ -1013,8 +1040,7 @@ Module CoreLanguage.
         eapply ev_step_ax1 in H.
         eapply corestep_nextblock in H.
         unfold Mem.valid_block, Coqlib.Plt in *.
-        zify;
-          by omega.
+        lia.
       Qed.
 
     End CoreLanguage.
@@ -1083,8 +1109,8 @@ Module CoreLanguageDry.
       (* and it's resources are below the maximum permissions on the memory*)
       destruct (DryHybridMachine.compat_th _ _ Hcompatible cnt0) as [Hlt1 Hlt2].
       (* let's prove a slightly different statement that will reduce proof duplication*)
-      assert (Hhelper: forall b ofs, Mem.perm_order'' ((getMaxPerm m') !! b ofs) ((getThreadR cnt).1 !! b ofs)  /\
-                                Mem.perm_order''  ((getMaxPerm m') !! b ofs) ((getThreadR cnt).2 !! b ofs)).
+      assert (Hhelper: forall b ofs, Mem.perm_order'' ((getMaxPerm m') # b ofs) ((getThreadR cnt).1 # b ofs)  /\
+                                Mem.perm_order''  ((getMaxPerm m') # b ofs) ((getThreadR cnt).2 # b ofs)).
       { intros b ofs.
         (* we proceed by case analysis on whether the block was a valid one or not*)
         destruct (valid_block_dec (restrPermMap (DryHybridMachine.compat_th _ _ Hcompatible pf).1) b)
@@ -1097,7 +1123,7 @@ Module CoreLanguageDry.
             (* since the data of thread tid have a Freeable permission on (b,
                  ofs) it must be that no lock permission exists in the threadpool and
                  hence on thread tid as well*)
-            assert (Hlock_empty: (getThreadR cnt)#2 !! b ofs = None).
+            assert (Hlock_empty: (getThreadR cnt)#2 # b ofs = None).
             { destruct (DryHybridMachine.thread_data_lock_coh _ Hinv _ cnt0) as [Hcoh _].
               specialize (Hcoh _ pf b ofs).
               assert (Hp := restrPermMap_Cur (DryHybridMachine.compat_th _ _ Hcompatible pf).1 b ofs).
@@ -1199,8 +1225,8 @@ Module CoreLanguageDry.
       (* the resources in the lockpool did not change*)
       rewrite OrdinalPool.gsoThreadLPool in Hres.
       (* proving something more convenient*)
-      assert (Hgoal: forall b ofs, Mem.perm_order'' ((getMaxPerm m') !! b ofs) (pmaps.1 !! b ofs) /\
-                              Mem.perm_order'' ((getMaxPerm m') !! b ofs) (pmaps.2 !! b ofs)).
+      assert (Hgoal: forall b ofs, Mem.perm_order'' ((getMaxPerm m') # b ofs) (pmaps.1 # b ofs) /\
+                              Mem.perm_order'' ((getMaxPerm m') # b ofs) (pmaps.2 # b ofs)).
       {
         (* the resources on the lp are below the maximum permissions on the memory*)
         destruct (DryHybridMachine.compat_lp _ _ Hcompatible l _ Hres) as [Hlt1 Hlt2].
@@ -1215,7 +1241,7 @@ Module CoreLanguageDry.
             (* since the data of thread tid have a Freeable permission on (b,
                  ofs) it must be that no lock permission exists in the threadpool and
                  hence on pmaps as well*)
-            assert (HemptyL: pmaps.2 !! b ofs = None).
+            assert (HemptyL: pmaps.2 # b ofs = None).
             { (*for lock permissions this is derived by coherency between data and locks*)
               destruct (DryHybridMachine.locks_data_lock_coh _ Hinv l _ Hres) as [Hcoh _].
               specialize (Hcoh _ pf b ofs).
@@ -1227,7 +1253,7 @@ Module CoreLanguageDry.
                        first by exfalso.
               reflexivity.
             }
-            assert (HemptyD: pmaps.1 !! b ofs = None).
+            assert (HemptyD: pmaps.1 # b ofs = None).
             { (*for data permissions this is derived by the disjointness invariant *)
               assert (Hp := restrPermMap_Cur (DryHybridMachine.compat_th _ _ Hcompatible pf).1 b ofs).
               unfold permission_at in Hp. rewrite Hp in HFree.
@@ -1556,7 +1582,7 @@ Module CoreLanguageDry.
     }
   Qed.
   
- (** [invariant] is preserved by a corestep *)
+ (** [invariant] is preserved by initial_core *)
   Lemma initial_core_invariant:
     forall (tp : t)  (m : mem) (i : nat) n
       (pf : containsThread tp i) c m1 m' vf arg
diff --git a/concurrency/common/dry_machine_step_lemmas.v b/concurrency/common/dry_machine_step_lemmas.v
index 654ccd734f..17bd242735 100644
--- a/concurrency/common/dry_machine_step_lemmas.v
+++ b/concurrency/common/dry_machine_step_lemmas.v
@@ -23,13 +23,15 @@ Require Import VST.concurrency.common.permissions.
 Require Import VST.concurrency.common.threadPool.
 Require Import VST.concurrency.common.HybridMachineSig.
 Require Import VST.concurrency.common.dry_context.
-Require Import VST.concurrency.common.semantics. 
+Require Import VST.concurrency.common.semantics.
 Require Import VST.concurrency.common.dry_machine_lemmas.
 Require Import VST.concurrency.common.tactics.
 Import threadPool.
 
 Require Import Coq.Logic.FunctionalExtensionality.
 
+Set Bullet Behavior "Strict Subproofs".
+
 Global Notation "a # b" := (Maps.PMap.get b a) (at level 1).
 
 (** This file holds various results about the dry machine*)
@@ -205,7 +207,7 @@ Module StepLemmas.
       repeat match goal with
              | [H: permMapLt _ _ |- _] =>
                specialize (H b ofs)
-             | [H: context[(getMaxPerm _) !! _ _] |- _] =>
+             | [H: context[(getMaxPerm _) # _ _] |- _] =>
                rewrite getMaxPerm_correct in H
              end;
       unfold permission_at in *;
@@ -238,8 +240,7 @@ Module StepLemmas.
   Proof.
     intros.
     inversion Hstep; simpl in *; subst;
-      try (inversion Htstep; eauto).
-    now eauto.
+      try (inversion Htstep; eauto); eauto.
   Qed.
 
   Lemma step_containsThread :
@@ -360,6 +361,7 @@ Module StepLemmas.
     exists U1'; econstructor 4; simpl; eauto.
     exists U1'; econstructor 5; simpl; eauto.
     exists U1'; econstructor 6; simpl; eauto.
+    exists U1'; econstructor 7; simpl; eauto.
   Qed.
 
   End StepLemmas.
@@ -784,7 +786,7 @@ Module StepLemmas.
     (** The [lockRes] is preserved by [internal_execution]*)
     Lemma gsoLockPool_execution :
       forall (tp : t) (m : mem) (tp' : t)
-        (m' : mem) (i : nat) (xs : seq nat_eqType)
+        (m' : mem) (i : nat) (xs : seq nat)
         (Hexec: internal_execution [seq x <- xs | x == i] tp m tp' m')
         addr,
         lockRes tp addr = lockRes tp' addr.
@@ -2045,7 +2047,7 @@ Module StepType.
       (Hcomp: mem_compatible tp m)
       (Hstep_internal: internal_step cnt Hcomp tp' m'),
       let mrestr := restrPermMap (((compat_th _ _ Hcomp) cnt).1) in
-      cnt$mrestr @ I.
+      cnt $ mrestr @ I.
   Proof.
     intros.
     unfold getStepType, ctlType.
@@ -2070,7 +2072,7 @@ Module StepType.
       (Hcomp': mem_compatible tp' m')
       (Hinternal: internal_step cnti Hcomp tp' m'),
       let mrestr := restrPermMap (((compat_th _ _ Hcomp') cnti').1) in
-      ~ (cnti'$mrestr @ E).
+      ~ (cnti' $ mrestr @ E).
   Proof.
     intros. intro Hcontra.
     destruct Hinternal as [[? Htstep] | [[Htstep ?] | Htstep]]; subst;
@@ -2089,7 +2091,7 @@ Module StepType.
       (Hcomp': mem_compatible tp' m')
       (Hexec: internal_execution [seq x <- xs | x == i] tp m tp' m'),
       let mrestr := restrPermMap (((compat_th _ _ Hcomp') cnti').1) in
-      ~ (cnti'$mrestr @ E).
+      ~ (cnti' $ mrestr @ E).
   Proof.
     intros.
     generalize dependent m.
@@ -2153,7 +2155,7 @@ Module StepType.
       (Hcomp: mem_compatible tp m),
       let mrestr := restrPermMap (((compat_th _ _ Hcomp) cnti).1) in
       forall
-        (Hinternal: cnti$mrestr @ I)
+        (Hinternal: cnti $ mrestr @ I)
         (Hstep: fmachine_step (i :: U, tr, tp) m (U, tr', tp') m'),
         containsThread tp j.
   Proof.
@@ -2165,7 +2167,7 @@ Module StepType.
     forall (tp tp' : t) m m' (i : nat) (pf : containsThread tp i) U tr tr'
       (Hcomp: mem_compatible tp m),
       let mrestr := restrPermMap (((compat_th _ _ Hcomp) pf).1) in
-      forall (Hinternal: pf$mrestr @ I)
+      forall (Hinternal: pf $ mrestr @ I)
         (Hstep: fmachine_step (i :: U, tr, tp) m (U, tr', tp') m'),
         invariant tp'.
   Proof.
@@ -2179,13 +2181,14 @@ Module StepType.
     - eapply ev_step_ax1 in Hcorestep.
       eapply corestep_invariant; simpl; eauto.
     - now apply updThreadC_invariant.
+    - done.
   Qed.
 
   Lemma fmachine_step_compatible:
     forall (tp tp' : t) m m' (i : nat) (pf : containsThread tp i) U tr tr'
       (Hcomp: mem_compatible tp m),
       let mrestr := restrPermMap (((compat_th _ _ Hcomp) pf).1) in
-      forall (Hinternal: pf$mrestr @ I)
+      forall (Hinternal: pf $ mrestr @ I)
         (Hstep: fmachine_step (i :: U,tr, tp) m (U, tr',tp') m'),
         mem_compatible tp' m'.
   Proof.
@@ -2209,7 +2212,7 @@ Module StepType.
       (pfi: containsThread tp i)
       (Hcomp: mem_compatible tp m),
       let mrestr := restrPermMap (((compat_th _ _ Hcomp) pfi).1) in
-      forall (Hinternal: pfi$mrestr @ I)
+      forall (Hinternal: pfi $ mrestr @ I)
         (Hstep: fmachine_step (i :: U, tr, tp) m (U, tr', tp') m')
         (Hneq: i <> j),
       getThreadC pfj = getThreadC pfj'.
@@ -2228,7 +2231,7 @@ Module StepType.
       (pfi: containsThread tp i)
       (Hcomp: mem_compatible tp m),
       let mrestr := restrPermMap (((compat_th _ _ Hcomp) pfi).1) in
-      forall (Hinternal: pfi$mrestr @ I)
+      forall (Hinternal: pfi $ mrestr @ I)
         (Hstep: fmachine_step (i :: U, tr, tp) m (U, tr', tp') m'),
         lockSet tp = lockSet tp'.
   Proof.
@@ -2237,8 +2240,8 @@ Module StepType.
       try (apply initial_core_nomem in Hinitial; subst om; simpl machine_semantics.option_proj);
       try (erewrite gsoThreadCLock;
              by eauto);
-    try (erewrite gsoThreadLock;
-           by eauto).
+      try (erewrite gsoThreadLock;
+           by eauto); done.
   Qed.
 
   Opaque lockRes.
@@ -2247,7 +2250,7 @@ Module StepType.
       U (pfi : containsThread tp i)
       (Hcomp: mem_compatible tp m),
       let mrestr := restrPermMap (((compat_th _ _ Hcomp) pfi).1) in
-      forall (Hinternal: pfi$mrestr @ I)
+      forall (Hinternal: pfi $ mrestr @ I)
       (Hstep: fmachine_step (i :: U,tr, tp) m (U, tr', tp') m'),
       lockRes tp' = lockRes tp.
   Proof.
@@ -2256,7 +2259,7 @@ Module StepType.
       try (apply initial_core_nomem in Hinitial; subst om; simpl machine_semantics.option_proj);
      extensionality addr;
       try (by rewrite gsoThreadCLPool);
-      try (by rewrite gsoThreadLPool).
+      try (by rewrite gsoThreadLPool); done.
   Qed.
 
   Lemma fmachine_step_disjoint_val :
@@ -2268,7 +2271,7 @@ Module StepType.
       (Hcomp: mem_compatible tp m)
       (Hcomp': mem_compatible tp' m'),
       let mrestr := restrPermMap (((compat_th _ _ Hcomp) pfi).1) in
-      forall (Hinternal: pfi$mrestr @ I)
+      forall (Hinternal: pfi $ mrestr @ I)
         (Hstep: fmachine_step (i :: U, tr, tp) m (U,tr', tp') m') b ofs
         (Hreadable:
            Mem.perm (restrPermMap (Hcomp _ pfj).1) b ofs Cur Readable \/
@@ -2286,7 +2289,7 @@ Module StepType.
       eapply corestep_disjoint_val;
         by (simpl; eauto).
   Qed.
-  
+
   Lemma fstep_valid_block:
     forall tpf tpf' mf mf' i U b tr tr'
       (Hvalid: Mem.valid_block mf b)
diff --git a/concurrency/common/erased_machine.v b/concurrency/common/erased_machine.v
index ef28a493b6..d1f93495c0 100644
--- a/concurrency/common/erased_machine.v
+++ b/concurrency/common/erased_machine.v
@@ -163,7 +163,7 @@ Module BareMachine.
       - intros [cntj' [ q' running]].
         inversion H; subst.
         assert (cntj:=cntj').
-        eapply cntUpdateC' with (c0:=Krun c') in cntj; eauto.
+        eapply cntUpdateC' with (c:=Krun c') in cntj; eauto.
         exists cntj.
         destruct (NatTID.eq_tid_dec i j).
         + subst j; exists c.
@@ -235,7 +235,7 @@ Module BareMachine.
             ** pose proof (cntUpdateC' _ _ HH) as cntj0.
               exists cntj0, q.
               rewrite <- running.
-              erewrite gsoAddCode with (cntj1 := HH).
+              erewrite gsoAddCode with (cntj := HH).
               erewrite <- gsoThreadCC;
                 now eauto.
             ** exfalso.
@@ -263,7 +263,7 @@ Module BareMachine.
     
     Definition init_mach (_ : option unit) (m: mem)
                (tp:thread_pool)(m':mem)(v:val)(args:list val) : Prop :=
-      exists c, initial_core semSem 0 m c m' v args /\ tp = mkPool (Krun c) tt.
+      exists c, initial_core semSem 0 m c m' v args /\ tp = mkPool (Krun c) tt (* tt *).
 
     Definition install_perm tp m tid (Hcmpt: mem_compatible tp m) (Hcnt: containsThread tp tid) m' :=
       m = m'.
@@ -289,6 +289,6 @@ Module BareMachine.
       ).
 
   End BareMachine.
-  Set Printing All.
+
 End BareMachine.
 
diff --git a/concurrency/common/konig.v b/concurrency/common/konig.v
index 972fe2fd63..72cbd6f850 100644
--- a/concurrency/common/konig.v
+++ b/concurrency/common/konig.v
@@ -1,5 +1,5 @@
 Require Import Coq.Logic.ChoiceFacts.
-Require Import Coq.omega.Omega.
+Require Import Arith Lia.
 
 Tactic Notation "assert_specialize" hyp(H) :=
   match type of H with
@@ -37,12 +37,12 @@ Proof.
   intros y.
   destruct (ia (x + y)) as (a' & La' & Ha').
   exists a'; split.
-  - omega.
+  - lia.
   - split. auto.
     apply DN; intros nB.
     apply Nex.
     exists a'; split.
-    + omega.
+    + lia.
     + split; auto.
 Qed.
 
@@ -85,7 +85,7 @@ Proof.
         destruct bound as (i & Li & E).
         exists i; split; auto.
         rewrite <-E in N'x.
-        cut (i <> n); [ omega | ]. intros ->.
+        cut (i <> n); [ lia | ]. intros ->.
         unfold image in N'x.
         destruct N'x as (x' & N'x'& Efx').
         compute in *; tauto.
@@ -135,28 +135,28 @@ Qed.
 
 Lemma zip_1 {X} f1 f2 n : @zip X f1 f2 (2 * n) = f1 n.
 Proof.
-  replace (f1 n) with (f1 (0 + n)) by (f_equal; omega).
+  replace (f1 n) with (f1 (0 + n)) by (f_equal; lia).
   transitivity (zip (fun n => f1 (0 + n)) (fun n => f2 (0 + n)) (2 * n)).
   - apply zip_ext; intros; auto.
   - generalize 0 at 1 2 4 as k; induction n; auto; intros k.
-    replace (2 * S n) with (S (S (2 * n))) by omega.
+    replace (2 * S n) with (S (S (2 * n))) by lia.
     unfold zip; fold (@zip X).
-    replace (k + S n) with (S k + n) by omega.
+    replace (k + S n) with (S k + n) by lia.
     rewrite <-IHn.
-    apply zip_ext; intros; f_equal; omega.
+    apply zip_ext; intros; f_equal; lia.
 Qed.
 
 Lemma zip_2 {X} f1 f2 n : @zip X f1 f2 (1 + 2 * n) = f2 n.
 Proof.
-  replace (f2 n) with (f2 (0 + n)) by (f_equal; omega).
+  replace (f2 n) with (f2 (0 + n)) by (f_equal; lia).
   transitivity (zip (fun n => f1 (0 + n)) (fun n => f2 (0 + n)) (1 + 2 * n)).
   - apply zip_ext; intros; auto.
   - generalize 0 at 1 2 5 as k; induction n; auto; intros k.
-    replace (1 + 2 * S n) with (S (S (1 + 2 * n))) by omega.
+    replace (1 + 2 * S n) with (S (S (1 + 2 * n))) by lia.
     unfold zip; fold (@zip X).
-    replace (k + S n) with (S k + n) by omega.
+    replace (k + S n) with (S k + n) by lia.
     rewrite <-IHn.
-    apply zip_ext; intros; f_equal; omega.
+    apply zip_ext; intros; f_equal; lia.
 Qed.
 
 Lemma finite_union_intersection {X Y} (A1 A2 : X -> Prop) (P : Y -> X -> Prop) :
@@ -169,9 +169,9 @@ Proof.
   exists (2 * n1 + 1 + 2 * n2), (zip f1 f2).
   intros n (x & ([a1 | a2], Pnx)).
   - destruct (H1 n) as (i & ln & <-); eauto.
-    exists (2 * i); split. omega. apply zip_1.
+    exists (2 * i); split. lia. apply zip_1.
   - destruct (H2 n) as (i & ln & <-); eauto.
-    exists (1 + 2 * i); split. omega. apply zip_2.
+    exists (1 + 2 * i); split. lia. apply zip_2.
 Qed.
 
 Lemma finite_product:
@@ -191,29 +191,25 @@ Proof.
   exists (ia + ib * NA); split.
   - replace (NB * NA) with (( 1 + ( NB - 1)) * NA).
 
-    Focus 2.  f_equal.
-    symmetry. apply le_plus_minus.
-    apply lt_le_S.
-    eapply Nat.le_lt_trans; eauto. omega.
+    2: { f_equal. lia. }
 
+    rewrite PeanoNat.Nat.mul_add_distr_r.
+    apply Nat.add_lt_le_mono. lia.
+    apply Nat.lt_le_pred in ineqb.
+    assert (ib <= (NB - 1)). lia.
+    apply Nat.mul_le_mono_pos_r. lia. auto.
 
-    rewrite Nat.mul_add_distr_r.
-    apply plus_lt_le_compat.
-    omega.
-
-    eapply mult_le_compat_r.
-    omega.
   - f_equal.
     + rewrite Nat.mod_add.
       eapply Nat.mod_small_iff in ineqa.
       rewrite ineqa; auto.
-      omega.
-      omega.
+      lia.
+      lia.
     + rewrite Nat.div_add.
       eapply Nat.div_small_iff in ineqa.
       rewrite ineqa; auto.
-      omega.
-      omega.
+      lia.
+      lia.
 Qed.
 
 (* We have a simpler characterization of finite for subsets of nat  *)
@@ -224,9 +220,9 @@ Proof.
     pose (sumf := fix sum n := match n with O => O | S n => f n + sum n end).
     exists (1 + sumf c).
     intros x Ax; destruct (Hf x Ax) as (i & Hi & <-).
-    replace c with (c - S i + S i) by omega.
+    replace c with (c - S i + S i) by lia.
     clear. generalize (c - S i); intros k.
-    induction k; simpl; omega.
+    induction k; simpl; lia.
   - intros (b, Hb). exists b, id; intros x Ax; specialize (Hb x Ax); eauto.
 Qed.
 
@@ -238,7 +234,7 @@ Lemma finite_union_intersection_nat {X} (A1 A2 : X -> Prop) (P : nat -> X -> Pro
 Proof.
   repeat rewrite finite_nat_bound.
   intros (n1 & H1) (n2 & H2); exists (n1 + n2); intros a (x & m & p).
-  cut (a < n1 \/ a < n2); [omega|].
+  cut (a < n1 \/ a < n2); [lia|].
   destruct m; eauto.
 Qed.
 
@@ -254,12 +250,12 @@ Proof.
       apply nfin. exists b; intros a. apply ABS; auto.
     + apply ninf; intros b. destruct (nfin' b) as (a, Ha).
       exists a; split.
-      * cut (~ a < b); auto. omega.
+      * cut (~ a < b); auto. lia.
       * apply ABS; tauto.
   - intros fin inf; apply finite_nat_bound in fin.
     destruct fin as (b & Hb).
     destruct (inf b) as (x & lx & Ax).
-    specialize (Hb x Ax). omega.
+    specialize (Hb x Ax). lia.
 Qed.
 
 Lemma ramsey_inf_bin {X} (A1 A2 : X -> Prop) (P : nat -> X -> Prop) :
@@ -292,7 +288,7 @@ Proof.
   assert (HA : forall x, A x <-> Or b x). {
     intros x; split.
     - intros Ax; destruct (bound x Ax) as (i & li & <-).
-      replace b with (1 + (b - i - 1) + i) by omega.
+      replace b with (1 + (b - i - 1) + i) by lia.
       generalize (b - i - 1) as k; intros k.
       induction k.
       + compute; tauto.
@@ -434,7 +430,7 @@ Section Safety.
 
   Lemma safeN_le n n' x : n <= n' -> safeN n' x -> safeN n x.
   Proof.
-    intros l; replace n' with ((n' - n) + n) by omega.
+    intros l; replace n' with ((n' - n) + n) by lia.
     generalize (n' - n) as k; clear l; induction k; auto.
     intros H; apply IHk. apply safeN_S; auto.
   Qed.
diff --git a/concurrency/common/lksize.v b/concurrency/common/lksize.v
index 6bdf4825d0..05667f6a42 100644
--- a/concurrency/common/lksize.v
+++ b/concurrency/common/lksize.v
@@ -1,6 +1,7 @@
 Require Import compcert.common.AST.
 Require Import compcert.common.Memdata.
 Require Import Coq.ZArith.ZArith.
+Require Import Lia.
 
 (* LKSIZE should match sizeof(semax_conc.tlock).  *)
 Definition LKSIZE:= (2 * size_chunk Mptr)%Z.
@@ -9,13 +10,19 @@ Definition LKSIZE_nat:= Z.to_nat LKSIZE.
 Lemma LKSIZE_pos : (0 < LKSIZE)%Z.
 Proof.
   unfold LKSIZE.
-  pose proof (size_chunk_pos Mptr); omega.
+  pose proof (size_chunk_pos Mptr); lia.
 Qed.
 
 Lemma LKSIZE_int : (size_chunk Mint32 < LKSIZE)%Z.
 Proof.
   unfold LKSIZE; simpl.
-  rewrite size_chunk_Mptr; destruct Archi.ptr64; omega.
+  rewrite size_chunk_Mptr; destruct Archi.ptr64; lia.
 Qed.
 
-Ltac lkomega := pose proof LKSIZE_pos; pose proof LKSIZE_int; simpl in *; try omega.
+Lemma LKSIZE_long : (size_chunk Mint64 <= LKSIZE)%Z.
+Proof.
+  unfold LKSIZE; simpl.
+  rewrite size_chunk_Mptr; destruct Archi.ptr64; lia.
+Qed.
+
+Ltac lkomega := pose proof LKSIZE_pos; pose proof LKSIZE_int; pose proof LKSIZE_long; simpl in *; lia.
diff --git a/concurrency/common/permissions.v b/concurrency/common/permissions.v
index 48f304ca5c..b82b1e384b 100644
--- a/concurrency/common/permissions.v
+++ b/concurrency/common/permissions.v
@@ -13,17 +13,16 @@ Require Import compcert.common.Memory.
 Require Import VST.concurrency.lib.Coqlib3.
 Require Import compcert.common.Values. (*for val*)
 Require Import compcert.lib.Integers.
-Require Export compcert.lib.Maps.
+Require Import compcert.lib.Maps.
 Require Import Coq.ZArith.ZArith.
 From VST.veric Require Import shares juicy_mem juicy_mem_lemmas.
 Require Import VST.msl.msl_standard.
 Require Import FunInd.
-Import cjoins.
 
 (*IM using proof irrelevance!*)
 Require Import ProofIrrelevance.
 
-Set Nested Proofs Allowed.
+Set Bullet Behavior "Strict Subproofs".
 
 Lemma po_refl: forall p, Mem.perm_order'' p p.
 Proof.
@@ -60,13 +59,13 @@ Definition dmap_get' (dm:delta_map) b ofs:=
 
 Definition dmap_get (dm:delta_map) b ofs:=
   (fun _ => None, dm) !! b ofs.
-Hint Transparent dmap_get.
+#[export] Hint Transparent dmap_get : core.
 (* go back in time 
    It is to go back to the previous definition.
    only to help transitioning. Hopefully one day we get rid of this.
  *)
 Lemma dmap_get_bit':
-  forall dm b ofs, dmap_get dm b ofs  = dmap_get' dm b ofs.
+  forall dm b ofs, dmap_get dm b ofs = dmap_get' dm b ofs.
 Proof.
   unfold dmap_get, dmap_get', PMap.get.
   intros; simpl.
@@ -180,19 +179,20 @@ Section permMapDefs.
     intros ??%perm_of_sh_Freeable_top%glb_Rsh_not_top; auto.
   Qed.
 
+  #[local] Hint Resolve perm_coh_empty_1 : core.
+
   Lemma perm_coh_self: forall res,
       perm_coh (perm_of_res res)
                (perm_of_res_lock res).
-        destruct res; simpl; auto.
-        - apply perm_coh_empty_1.
-        - destruct k; try apply perm_coh_empty_1; simpl.
-            destruct (perm_of_sh (Share.glb Share.Rsh sh)) eqn: ?; auto.
-            destruct p0; auto.
-            eapply perm_of_glb_not_Freeable; eauto.
+        destruct res as (?, [r|]); first destruct r; simpl; auto.
+        destruct d; simpl; auto.
+        destruct s; auto.
+        destruct (perm_of_sh (Share.glb Share.Rsh sh)) eqn: ?; auto.
+        if_tac; destruct p; simpl; auto; eapply perm_of_glb_not_Freeable; eauto.
   Qed.
 
 
-  Lemma perm_coh_joins:
+(*  Lemma perm_coh_joins:
     forall a b, joins a b ->
            perm_coh (perm_of_res a) (perm_of_res_lock b).
   Proof.
@@ -240,7 +240,7 @@ Section permMapDefs.
       apply juicy_mem_lemmas.po_join_sub_sh; eexists;
         eapply compcert_rmaps.join_glb_Rsh; eassumption.
     
-Qed.
+Qed.*)
 
 
   Definition permMapCoherence (pmap1 pmap2 : access_map) :=
@@ -267,11 +267,12 @@ Qed.
     forall r,
       Mem.perm_order'' (Some Writable) (perm_of_res_lock r).
   Proof.
-    destruct r; try constructor; destruct k ; simpl; auto.
+    destruct r as (k, [r|]); first destruct r; try constructor; destruct k; simpl; auto; try constructor.
+    destruct s; auto.
     - destruct (perm_of_sh (Share.glb Share.Rsh sh)) eqn:HH; auto.
-      destruct p0; try constructor.
+      destruct p; try constructor.
       apply perm_of_sh_Freeable_top in HH; inversion HH.
-          exfalso; eapply glb_Rsh_not_top; eauto.
+      exfalso; eapply glb_Rsh_not_top; eauto.
   Qed.
 
   (* Some None represents the empty permission. None is used for
@@ -514,9 +515,9 @@ Qed.
         - destruct c; inversion H1.
           exists (Some p0); reflexivity.
         - destruct c; inversion H1.
-          destruct p; inversion H0.
-          exists (Some Readable); reflexivity.
-        - exists (Some Readable); reflexivity.
+          + destruct p; inversion H0.
+            exists (Some Readable); reflexivity.
+          + exists (Some Readable); reflexivity.
         - destruct c; inversion H1;
           try solve[exists (Some Nonempty); reflexivity].
           destruct p; inversion H0; try(destruct p0; inversion H3);
@@ -599,12 +600,6 @@ Qed.
            end.
 
   Ltac permDisj_solve:= eexists; simpl; reflexivity.
-  
-  Lemma join_sh_permDisjoint:
-        forall sh1 sh2,
-          joins sh1 sh2 ->
-          permDisjoint (perm_of_sh sh1) (perm_of_sh sh2).
-  
 
   Lemma writable0_not_join_readable:
     forall sh1 sh2,
@@ -649,6 +644,11 @@ Qed.
              | [ H: joins ?sh1 ?sh2 |- _ ] =>
                eapply joins_comm in H
              end; joins_sh_contradiction_onside].
+
+  Lemma join_sh_permDisjoint:
+        forall sh1 sh2,
+          joins sh1 sh2 ->
+          permDisjoint (perm_of_sh sh1) (perm_of_sh sh2).
   Proof.
     (*intros.
         unfold perm_of_sh.
@@ -675,9 +675,9 @@ Qed.
       functional induction (perm_of_sh sh2) using perm_of_sh_ind;
       try permDisj_solve;
       joins_sh_contradiction.
-    Qed.
+  Qed.
  
-  (*HERE*)
+(*  (*HERE*)
   Lemma joins_permDisjoint: forall r1 r2,
       joins r1 r2 ->
       permDisjoint (perm_of_res r1) (perm_of_res r2).
@@ -819,7 +819,7 @@ Qed.
               try permDisj_solve;
           inversion H; inversion H0; subst;
             try glb_contradictions.
-  Qed.
+  Qed.*)
   
   (*Lemma permDisjoint_sub: forall r1 r2 p,
       join_sub r2 r1 ->
@@ -867,7 +867,6 @@ Proof.*)
       unfold permMapsDisjoint.
       unfold empty_map; intros; simpl.
       unfold Maps.PMap.get; simpl.
-      rewrite Maps.PTree.gempty; simpl.
       exists None; reflexivity.
   Qed.
 
@@ -983,42 +982,39 @@ Proof.*)
     contradict GET. apply Pos.gt_lt; assumption.
   Qed.
 
+(*This proof is already in juicy_machine.
+ * move it to a more general position.*)
+  Lemma Mem_canonical_useful: forall m loc k,
+    fst (Mem.mem_access m) loc k = None.
+  Proof. intros. destruct m; simpl in *.
+       unfold PMap.get in nextblock_noaccess.
+       pose (b:= Pos.max (TreeMaxIndex (snd mem_access) + 1 )  nextblock).
+       assert (H1:  ~ Coqlib.Plt b nextblock).
+       { intros H. assert (HH:= Pos.le_max_r (TreeMaxIndex (snd mem_access) + 1) nextblock).
+         clear - H HH. unfold Pos.le in HH. unfold Coqlib.Plt in H.
+         apply HH. eapply Pos.compare_gt_iff.
+         auto. }
+       assert (H2 :( b > (TreeMaxIndex (snd mem_access)))%positive ).
+       { assert (HH:= Pos.le_max_l (TreeMaxIndex (snd mem_access) + 1) nextblock).
+         apply Pos.lt_gt. eapply Pos.lt_le_trans; eauto.
+         lia. }
+       specialize (nextblock_noaccess b loc k H1).
+       apply max_works in H2. rewrite H2 in nextblock_noaccess.
+       assumption.
+  Qed.
+
   Lemma Cur_isCanonical: forall m, isCanonical (getCurPerm m).
-        unfold isCanonical. intros.
-        pose (BigNumber:= Pos.max (Pos.succ( TreeMaxIndex (getCurPerm m).2) ) (Mem.nextblock m)).
-        assert (HH: (BigNumber >= (Pos.succ ( TreeMaxIndex (getCurPerm m).2)))%positive )
-          by (unfold BigNumber; apply Pos.le_ge; apply Pos.le_max_l).
-        apply Pos.ge_le in HH; apply Pos.le_succ_l in HH.
-        apply Pos.lt_gt in HH; eapply max_works in HH.
-        extensionality x.
-        pose (property:= Mem.nextblock_noaccess m BigNumber x Cur).
-        rewrite <- property.
-        - replace ((Mem.mem_access m) !! BigNumber x Cur) with
-          (permission_at m BigNumber x Cur); try reflexivity.
-          rewrite <- getCurPerm_correct.
-          unfold PMap.get.
-          rewrite HH.
-          reflexivity.
-        - apply Pos.le_nlt. unfold BigNumber. apply Pos.le_max_r.
+  Proof.
+    unfold isCanonical, getCurPerm; intros.
+    extensionality; simpl.
+    apply Mem_canonical_useful.
   Qed.
 
   Lemma Max_isCanonical: forall m, isCanonical (getMaxPerm m).
-        unfold isCanonical. intros.
-        pose (BigNumber:= Pos.max (Pos.succ( TreeMaxIndex (getMaxPerm m).2) ) (Mem.nextblock m)).
-        assert (HH: (BigNumber >= (Pos.succ ( TreeMaxIndex (getMaxPerm m).2)))%positive )
-          by (unfold BigNumber; apply Pos.le_ge; apply Pos.le_max_l).
-        apply Pos.ge_le in HH; apply Pos.le_succ_l in HH.
-        apply Pos.lt_gt in HH; eapply max_works in HH.
-        extensionality x.
-        pose (property:= Mem.nextblock_noaccess m BigNumber x Max).
-        rewrite <- property.
-        - replace ((Mem.mem_access m) !! BigNumber x Max) with
-          (permission_at m BigNumber x Max); try reflexivity.
-          rewrite <- getMaxPerm_correct.
-          unfold PMap.get.
-          rewrite HH.
-          reflexivity.
-        - apply Pos.le_nlt. unfold BigNumber. apply Pos.le_max_r.
+  Proof.
+    unfold isCanonical, getMaxPerm; intros.
+    extensionality; simpl.
+    apply Mem_canonical_useful.
   Qed.
 
   Definition permMapLt (pmap1 pmap2 : access_map) : Prop :=
@@ -1093,6 +1089,13 @@ Proof.*)
     destruct (pmap !! b ofs); [by exfalso | reflexivity].
   Qed.
 
+  Global Instance permMapLt_preorder : PreOrder permMapLt.
+  Proof.
+    split.
+    - intros ???; apply po_refl.
+    - intros ???????; eapply po_trans; eauto.
+  Qed.
+
   Definition setPerm (p : option permission) (b : block)
              (ofs : Z) (pmap : access_map) : access_map :=
     Maps.PMap.set b (fun ofs' => if compcert.lib.Coqlib.zeq ofs ofs' then
@@ -1101,6 +1104,8 @@ Proof.*)
                                 Maps.PMap.get b pmap ofs')
                   pmap.
 
+   Open Scope nat.
+
    Fixpoint setPermBlock (p : option permission) (b : block)
            (ofs : Z) (pmap : access_map) (length: nat): access_map :=
     match length with
@@ -1117,7 +1122,7 @@ Proof.*)
          generalize dependent ofs'.
          induction sz; simpl in *; intros.
          - unfold setPerm.
-           exfalso. destruct Hofs. omega.
+           exfalso. destruct Hofs. lia.
          - unfold setPerm.
            rewrite PMap.gss.
            destruct (compcert.lib.Coqlib.zeq (ofs + Z.of_nat sz) ofs');
@@ -1127,7 +1132,7 @@ Proof.*)
            destruct Hofs.
            split; auto.
            clear - H0 n.
-           zify. omega.
+           zify. lia.
   Qed.
 
   Lemma setPermBlock_other_1:
@@ -1142,11 +1147,11 @@ Proof.*)
          - rewrite Maps.PMap.gss.
            destruct (compcert.lib.Coqlib.zeq (ofs + Z.of_nat sz) ofs') as [Hcontra | ?].
            subst. exfalso.
-           destruct Hofs; zify; omega.
+           destruct Hofs; zify; lia.
            simpl. eapply IHsz.
            destruct Hofs; auto.
            right.
-           zify. omega.
+           zify. lia.
   Qed.
 
   Lemma setPermBlock_other_2:
@@ -1221,11 +1226,11 @@ Proof.*)
     - rewrite Maps.PMap.gss.
       destruct (compcert.lib.Coqlib.zeq (ofs + Z.of_nat sz) ofs') as [Hcontra | ?].
       subst. exfalso.
-      destruct Hofs; zify; omega.
+      destruct Hofs; zify; lia.
       simpl. eapply IHsz.
       destruct Hofs; auto.
       right.
-      zify. omega.
+      zify. lia.
   Qed.
 
   Lemma setPermBlock_var_same:
@@ -1238,20 +1243,15 @@ Proof.*)
     generalize dependent ofs'.
     induction sz; simpl in *; intros.
     - unfold setPerm.
-      exfalso. destruct Hofs. omega.
+      exfalso. destruct Hofs. lia.
     - unfold setPerm.
       rewrite PMap.gss.
       destruct (compcert.lib.Coqlib.zeq (ofs + Z.of_nat sz) ofs'); simpl.
       + f_equal. rewrite -e.
         replace (ofs + Z.of_nat sz - ofs +1 )%Z with
-            (Z.of_nat sz + 1)%Z; try omega.
-        rewrite <- (coqlib4.nat_of_Z_eq sz.+1); f_equal.
-        apply Nat2Z.inj_succ.
-        apply IHsz; simpl. 
-        rewrite Zpos_P_of_succ_nat in Hofs.
-        replace (ofs + Z.succ (Z.of_nat sz))%Z with
-            (Z.succ (ofs + Z.of_nat sz))%Z in Hofs;
-          omega.
+            (Z.of_nat sz + 1)%Z; try lia.
+      + apply IHsz; simpl.
+        lia.
   Qed.
 
   Lemma setPermBlock_setPermBlock_var:
@@ -1337,7 +1337,7 @@ Proof.*)
       + destruct sz_nat; first by (simpl; eauto).
         erewrite setPermBlock_other_1
           by (eapply Intv.range_notin in n;
-              simpl; eauto; zify; omega).
+              simpl; eauto; zify; lia).
         assumption.
     - erewrite setPermBlock_other_2 by eauto.
       assumption.
@@ -1361,7 +1361,7 @@ Proof.*)
     generalize dependent ofs'.
     induction sz; simpl in *; intros.
     - unfold setPerm.
-      exfalso. destruct Hofs. omega.
+      exfalso. destruct Hofs. lia.
     - unfold setPerm.
       rewrite PMap.gss.
       destruct (compcert.lib.Coqlib.zeq (ofs + Z.of_nat sz) ofs');
@@ -1371,7 +1371,7 @@ Proof.*)
       destruct Hofs.
       split; auto.
       clear - H0 n.
-      zify. omega.
+      zify. lia.
   Qed.
 
   Lemma setPermBlockFunc_other_1:
@@ -1387,11 +1387,11 @@ Proof.*)
     - rewrite Maps.PMap.gss.
       destruct (compcert.lib.Coqlib.zeq (ofs + Z.of_nat sz) ofs') as [Hcontra | ?].
       subst. exfalso.
-      destruct Hofs; zify; omega.
+      destruct Hofs; zify; lia.
       simpl. eapply IHsz.
       destruct Hofs; auto.
       right.
-      zify. omega.
+      zify. lia.
   Qed.
 
   Lemma setPermBlockFunc_other_2:
@@ -1429,7 +1429,7 @@ Proof.*)
         erewrite setPermBlock_other_1.
         assumption.
         apply Intv.range_notin in n; eauto.
-        simpl. rewrite Zpos_P_of_succ_nat. omega.
+        simpl. lia.
     - erewrite setPermBlock_other_2 by eauto.
       assumption.
   Qed.
@@ -1763,7 +1763,7 @@ Proof.*)
         auto.
     - unfold canonicalPMap in HGet. simpl in HGet.
       apply canonicalPTree_get_sound in HGet.
-      destruct n. exfalso. auto. destruct n. exfalso. ssromega.
+      destruct n. exfalso. auto. destruct n. exfalso. ssrlia.
       exfalso. apply HGet. apply mkBlockList_include; auto.
       assumption. clear HGet.
       eapply leq_ltn_trans; eauto.
@@ -1777,9 +1777,9 @@ Proof.*)
     intro. induction n; intros. unfold canonicalPMap. simpl.
     unfold PMap.get.
     rewrite PTree.gempty. reflexivity.
-    assert (Hkn': n <= k) by ssromega.
+    assert (Hkn': n <= k) by ssrlia.
     unfold canonicalPMap.
-    destruct n. simpl. unfold PMap.get. simpl. rewrite PTree.gempty. reflexivity.
+    destruct n. simpl. unfold PMap.get. simpl. reflexivity.
     unfold PMap.get.
     rewrite <- mkBlockList_unfold'. rewrite <- PList_cons.
     unfold canonicalPTree.
@@ -1787,7 +1787,7 @@ Proof.*)
     specialize (IHn _ m fn Hkn').
     unfold canonicalPMap, PMap.get, snd in IHn.
     destruct ((canonicalPTree (PList fn (mkBlockList n.+1) m)) ! (Pos.of_nat k)); auto.
-    unfold fst. intros HContra. apply Nat2Pos.inj_iff in HContra; subst; ssromega.
+    unfold fst. intros HContra. apply Nat2Pos.inj_iff in HContra; subst; ssrlia.
   Qed.
 
   Definition setMaxPerm (m : mem) : mem.
@@ -1805,7 +1805,7 @@ Proof.*)
           | [|- match ?Expr with _ => _ end] => destruct Expr
           end; constructor.
           apply/ltP/Pos2Nat.is_pos.
-          ssromega. }
+          ssrlia. }
       { intros b ofs k H.
         replace b with (Pos.of_nat (Pos.to_nat b)) by (rewrite Pos2Nat.id; done).
         erewrite canonicalPMap_default. reflexivity.
@@ -1831,15 +1831,15 @@ Proof.*)
       rewrite Hb.
       rewrite <- canonicalPMap_sound.
       reflexivity.
-      assert (H := Pos2Nat.is_pos b). ssromega.
-      apply Pos2Nat.inj_lt in Hvalid. ssromega.
+      assert (H := Pos2Nat.is_pos b). ssrlia.
+      apply Pos2Nat.inj_lt in Hvalid. ssrlia.
     }
     { intros Hinvalid.
       unfold permission_at, setMaxPerm. simpl.
       rewrite Hb.
       rewrite canonicalPMap_default. reflexivity.
       apply Pos.le_nlt in Hinvalid.
-      apply Pos2Nat.inj_le in Hinvalid. ssromega.
+      apply Pos2Nat.inj_le in Hinvalid. ssrlia.
     }
   Qed.
 
@@ -1873,14 +1873,14 @@ Proof.*)
     rewrite Hb.
     destruct (compcert.lib.Coqlib.plt b (Mem.nextblock m)) as [Hvalid | Hinvalid].
     rewrite <- canonicalPMap_sound. reflexivity.
-    assert (H := Pos2Nat.is_pos b). ssromega.
-    apply Pos2Nat.inj_lt in Hvalid. ssromega.
+    assert (H := Pos2Nat.is_pos b). ssrlia.
+    apply Pos2Nat.inj_lt in Hvalid. ssrlia.
     rewrite canonicalPMap_default.
     apply Mem.nextblock_noaccess with (ofs := ofs) (k := Cur) in Hinvalid.
     rewrite <- Hb.
     rewrite Hinvalid. reflexivity.
     apply Pos.le_nlt in Hinvalid.
-    apply Pos2Nat.inj_le in Hinvalid. ssromega.
+    apply Pos2Nat.inj_le in Hinvalid. ssrlia.
   Qed.
 
   Definition makeCurMax_map (mem_access:PMap.t (Z -> perm_kind -> option permission)):
@@ -1959,7 +1959,7 @@ Proof.*)
         rewrite Heq in Hlt. auto.
       + unfold Mem.perm_order''. by destruct ((Mem.mem_access m).1 ofs Max).
     - intros b ofs k Hnext.
-    - unfold permMapLt in Hlt.
+      unfold permMapLt in Hlt.
       assert (Heq: forall b ofs, Maps.PMap.get b (getMaxPerm m) ofs =
                             Maps.PMap.get b (Mem.mem_access m) ofs Max).
       { unfold getMaxPerm. intros.
@@ -1986,7 +1986,7 @@ Proof.*)
       rewrite H; auto. destruct k; auto.
   Defined.
 
-Lemma restrPermMap_irr:
+    Lemma restrPermMap_irr:
       forall p1 p2 m1 m2
         (P1: permMapLt p1 (getMaxPerm m1))
         (P2: permMapLt p2 (getMaxPerm m2)),
@@ -2192,6 +2192,22 @@ Lemma restrPermMap_irr:
     auto.
   Defined.
 
+  Lemma restrPermMap_eq : forall m (Hlt : permMapLt (getCurPerm m) (getMaxPerm m)), restrPermMap Hlt = m.
+  Proof.
+    intros.
+    pose proof (Mem_canonical_useful m) as Hcanon.
+    destruct m; simpl; apply Mem.mkmem_ext; simpl in *; try done.
+    destruct mem_access; simpl.
+    apply f_equal_prod.
+    - extensionality; extensionality k.
+      destruct k; done.
+    - apply trivial_ptree_map; intros.
+      extensionality; extensionality k.
+      destruct k; try done.
+      rewrite getCurPerm_correct /permission_at /PMap.get /=.
+      rewrite H //.
+  Qed.
+
   Definition erasePerm (m : mem) : mem.
   Proof.
     refine (Mem.mkmem (Mem.mem_contents m)
@@ -2205,7 +2221,7 @@ Lemma restrPermMap_irr:
           erewrite <- canonicalPMap_sound. simpl.
           constructor.
           apply/ltP/Pos2Nat.is_pos.
-          ssromega. }
+          ssrlia. }
       { intros b ofs k H.
         replace b with (Pos.of_nat (Pos.to_nat b)) by (rewrite Pos2Nat.id; done).
         erewrite canonicalPMap_default. reflexivity.
@@ -2231,15 +2247,15 @@ Lemma restrPermMap_irr:
       rewrite Hb.
       rewrite <- canonicalPMap_sound.
       reflexivity.
-      assert (H := Pos2Nat.is_pos b). ssromega.
-      apply Pos2Nat.inj_lt in Hvalid. ssromega.
+      assert (H := Pos2Nat.is_pos b). ssrlia.
+      apply Pos2Nat.inj_lt in Hvalid. ssrlia.
     }
     { intros Hinvalid.
       unfold permission_at, setMaxPerm. simpl.
       rewrite Hb.
       rewrite canonicalPMap_default. reflexivity.
       apply Pos.le_nlt in Hinvalid.
-      apply Pos2Nat.inj_le in Hinvalid. ssromega.
+      apply Pos2Nat.inj_le in Hinvalid. ssrlia.
     }
   Qed.
 
@@ -2284,6 +2300,15 @@ Lemma restrPermMap_irr:
        (forall k, Maps.PMap.get b (Mem.mem_access m_before) ofs k =
              Maps.PMap.get b (Mem.mem_access m_after) ofs k)).
 
+  Lemma strong_decay_refl:
+    forall m,
+      strong_decay m m.
+  Proof.
+    intros m b ofs.
+    split; intros; first by exfalso.
+    auto.
+  Qed.
+
    Lemma strong_decay_implies_decay:
      forall m m',
        strong_decay m m' ->
@@ -2425,7 +2450,8 @@ Ltac unfold_getPerm:=
   try unfold_getMaxPerm;
   try unfold_getCurPerm.
 
-Require Import VST.concurrency.common.core_semantics.
+(*Require Import VST.concurrency.common.core_semantics.*)
+Require Export VST.sepcomp.semantics.
 Require Import compcert.lib.Coqlib.
 
 Lemma storebytes_decay:
@@ -2455,14 +2481,14 @@ Transparent Mem.alloc.
 unfold Mem.alloc in H.
 inv H.
 simpl. rewrite PMap.gss.
-destruct (zle lo ofs); try omega.
-destruct (zlt ofs hi); try omega; auto.
+destruct (zle lo ofs); try lia.
+destruct (zlt ofs hi); try lia; auto.
 right.
 intros.
 inv H; simpl.
 rewrite PMap.gss.
-destruct (zle lo ofs); try omega;
-destruct (zlt ofs hi); try omega; auto.
+destruct (zle lo ofs); try lia;
+destruct (zlt ofs hi); try lia; auto.
 contradiction H0.
 pose proof (Mem.valid_block_alloc_inv _ _ _ _ _ H b H1).
 destruct H2. subst. contradiction n; auto.
@@ -2506,14 +2532,14 @@ rewrite H2 in H1.
 destruct ((Mem.mem_access m) !! b ofs Max); inv H1; auto.
 simpl.
 rewrite PMap.gss.
-destruct (zle lo ofs); try omega.
-destruct (zlt ofs hi); try omega.
+destruct (zle lo ofs); try lia.
+destruct (zlt ofs hi); try lia.
 simpl. auto.
 right.
 intros.
 simpl.
 rewrite PMap.gss.
-destruct (zle lo ofs); destruct (zlt ofs hi); try omega; auto.
+destruct (zle lo ofs); destruct (zlt ofs hi); try lia; auto.
 split.
 intros.
 contradiction H0.
@@ -2584,24 +2610,23 @@ Proof.
   { induction m.
     - intros ?. simpl; right.
       unfold Intv.In; simpl. clear.
-      intros ?; omega.
+      intros ?; lia.
     -  intros ?.
        specialize (Hno_overlap
                      _ _ _ _ _ _
                      ofs0 (ofs+Z.of_nat m)%Z
                      Hneq Hinj1 Hinj2).
        apply Hno_overlap in Hperm1.
-       2: { eapply Hrange_perm2. omega.     }
+       2: { eapply Hrange_perm2. lia.     }
        destruct Hperm1 as [Hperm1|Hperm1]; auto.
-       specialize (IHm ltac:(omega)).
+       specialize (IHm ltac:(lia)).
        destruct IHm as [IHm|IHm]; auto.
        right; clear - IHm Hperm1.
        intros [? ?]; eapply IHm.
        split; auto.
        unfold Intv.In; simpl in *.
        clear IHm H.
-       rewrite Zpos_P_of_succ_nat in H0.
-       omega. }
+       lia. }
 
   specialize (H _ ltac:(reflexivity)).
   destruct H; auto.
@@ -2646,7 +2671,7 @@ Proof.
   eapply H in H1.
   rewrite mem_lemmas.po_oo.
   rewrite mem_lemmas.po_oo in H1.
-  eapply juicy_mem.perm_order''_trans; eauto.
+  eapply perm_order''_trans; eauto.
 Qed.
 
 Lemma perm_order''_trans:
@@ -2719,10 +2744,9 @@ Qed.
 
 
       (* cann be used to expose the implicit arguemtns. *)
-      Definition restrPermMap' a b H:= @restrPermMap a b H.
+      Definition restrPermMap' a b H := @restrPermMap a b H.
       Lemma RPM: restrPermMap = restrPermMap'. Proof. reflexivity. Qed.
-      Arguments restrPermMap' a b H.
-      
+
       Lemma restr_proof_irr':
         forall (perm1 perm2 : access_map) (m1 m2 : mem)
                (Hlt1 : permMapLt perm1 (getMaxPerm m1))
@@ -2751,18 +2775,40 @@ Qed.
       Qed.
       Lemma restr_Max_eq:
         forall p m Hlt,
-          getMaxPerm (@restrPermMap p m Hlt) = getMaxPerm m.  
+          getMaxPerm (@restrPermMap p m Hlt) = getMaxPerm m.
       Proof.
         intros.
         unfold getMaxPerm, restrPermMap.
         simpl. unfold PMap.map; simpl.
         f_equal.
         repeat rewrite map_map1; simpl.
-        unfold PTree.map.
-        rewrite xmap_compose.
-        reflexivity.
+        apply PTree.extensionality; intros.
+        rewrite !PTree.gmap; unfold option_map.
+        destruct PTree.get; reflexivity.
       Qed.
-      
+
+  Lemma permMapLt_restr: forall p m (Hlt : permMapLt p (getMaxPerm m)) p', permMapLt p' (getMaxPerm (restrPermMap Hlt)) ->
+    permMapLt p' (getMaxPerm m).
+  Proof. intros ????; rewrite restr_Max_eq //. Qed.
+
+  Lemma PTree_map_map : forall {A B C} (f : positive -> A -> B) (g : positive -> B -> C) t,
+    PTree.map g (PTree.map f t) = PTree.map (fun p a => g p (f p a)) t.
+  Proof.
+    intros; apply PTree.extensionality; intros.
+    rewrite !PTree.gmap /option_map.
+    destruct (t ! i); done.
+  Qed.
+
+  Lemma restrPermMap_idem : forall m p (Hlt : permMapLt p (getMaxPerm m)) p' (Hlt' : permMapLt p' (getMaxPerm (restrPermMap Hlt))),
+    restrPermMap Hlt' = @restrPermMap p' m (permMapLt_restr Hlt').
+  Proof.
+    intros; apply Mem.mkmem_ext; try done.
+    f_equal; simpl.
+    - extensionality; extensionality k.
+      destruct k; done.
+    - rewrite PTree_map_map //.
+  Qed.
+
       Lemma setPermBlock_setPermBlock_var':
         forall v, setPermBlock v = setPermBlock_var (fun _ : nat => v).
       Proof.
@@ -2788,4 +2834,4 @@ Lemma mem_max_lt_max:
 Proof.
  intros.
  intros ? ?. apply po_refl.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/concurrency/common/permjoin.v b/concurrency/common/permjoin.v
index d62e34703a..94149e5200 100644
--- a/concurrency/common/permjoin.v
+++ b/concurrency/common/permjoin.v
@@ -5,7 +5,6 @@ Require Import VST.msl.pshares.
 Require Import VST.veric.coqlib4.
 Require Import VST.veric.shares.
 Require Import VST.veric.juicy_mem.
-Require Import VST.veric.juicy_mem_ops.
 Require Import VST.concurrency.common.permjoin_def.
 Require Import FunInd.
 Import Memtype.
@@ -157,7 +156,7 @@ unfold Share.Lsh, Share.Rsh, Tsh.
 destruct (Share.split Share.top) eqn:?. simpl.
 apply split_join; auto.
 Qed.
-Hint Resolve writable0_share_top.
+#[export] Hint Resolve writable0_share_top : core.
 
 Ltac common_contradictions:=
   match goal with
@@ -215,7 +214,7 @@ Ltac common_contradictions:=
       apply join_comm in H; join_share_contradictions_oneside
     end; try contradiction.
 
-Lemma join_permjoin r1 r2 r3 :
+(*Lemma join_permjoin r1 r2 r3 :
   join r1 r2 r3 ->
   permjoin (perm_of_res r1) (perm_of_res r2) (perm_of_res r3).
 Proof.
@@ -296,4 +295,4 @@ Proof.
   try contradiction (join_readable_unreadable RJ _x _x2).
   apply join_unit1_e in RJ; auto; subst; contradiction.
   contradiction (join_readable_unreadable (join_comm RJ) _x2 _x0).
-Qed.
+Qed.*)
diff --git a/concurrency/common/pos.v b/concurrency/common/pos.v
index 40e85b6d0e..2e7df02749 100644
--- a/concurrency/common/pos.v
+++ b/concurrency/common/pos.v
@@ -10,9 +10,9 @@ Proof. by case: p=> m pf; apply/ltP. Qed.
 
 Definition i0 (p : pos) : 'I_p := Ordinal (is_pos p).
 
-Require Import Omega.
+Require Import Lia.
 Lemma is_pos_incr (n : nat) : (0 < n.+1)%coq_nat.
-Proof. omega. Qed.
+Proof. lia. Qed.
 
 Definition pos_incr (p : pos) : pos := mkPos (is_pos_incr p).
 
@@ -37,11 +37,11 @@ case Heq: (n0 == n1).
    by move: Heq; rewrite Heq1; move/eqP; apply.
 }
 Qed.
-
+(*
 Definition pos_eqMixin := EqMixin pos_eqP.
 Canonical pos_eqType := Eval hnf in EqType pos pos_eqMixin.
 
 Lemma pos_eqE : pos_eq = eq_op :> rel _. Proof. by []. Qed.
-
+*)
 End PosEqType.
 
diff --git a/concurrency/common/semantics.v b/concurrency/common/semantics.v
index b522cf4f0e..8f67198c68 100644
--- a/concurrency/common/semantics.v
+++ b/concurrency/common/semantics.v
@@ -1,5 +1,6 @@
 From mathcomp.ssreflect Require Import ssreflect seq ssrbool.
-Require Import VST.concurrency.common.core_semantics.
+(*Require Import VST.concurrency.common.core_semantics.*)
+Require Export VST.sepcomp.semantics.
 Require Import VST.sepcomp.event_semantics.
 
 Require Import VST.concurrency.common.machine_semantics.
diff --git a/concurrency/common/sepcomp.v b/concurrency/common/sepcomp.v
index 657d0a6f7b..df1ee7296b 100644
--- a/concurrency/common/sepcomp.v
+++ b/concurrency/common/sepcomp.v
@@ -1,11 +1,11 @@
-Require  VST.concurrency.common.core_semantics.
+(*Require  VST.concurrency.common.core_semantics.*)
 Require  VST.sepcomp.mem_lemmas.
 Require  VST.sepcomp.structured_injections.
 Require  VST.sepcomp.effect_semantics.
 Require  VST.sepcomp.extspec.
 Require  VST.sepcomp.Address.
 Module SepComp.
- Export VST.concurrency.common.core_semantics.
+(* Export VST.concurrency.common.core_semantics.*)
  Export VST.sepcomp.mem_lemmas.
  Export VST.sepcomp.structured_injections.
  Export VST.sepcomp.effect_semantics.
diff --git a/concurrency/common/ssromega.v b/concurrency/common/ssromega.v
index ec23f526b1..a29754559f 100644
--- a/concurrency/common/ssromega.v
+++ b/concurrency/common/ssromega.v
@@ -1,9 +1,9 @@
 From mathcomp.ssreflect Require Import ssreflect ssrbool ssrnat eqtype seq.
 Require Import Coq.ZArith.ZArith.
-Require Import PreOmega.
+Require Import Lia.
 Set Implicit Arguments.
 
-(* tactics to support Omega for ssrnats*)
+(* tactics to support lia for ssrnats*)
 Ltac arith_hypo_ssrnat2coqnat :=
   match goal with
     | H : context [andb _ _] |- _ => let H0 := fresh in case/andP: H => H H0
@@ -28,4 +28,4 @@ Ltac arith_goal_ssrnat2coqnat :=
 Ltac ssromega :=
   repeat arith_hypo_ssrnat2coqnat;
   arith_goal_ssrnat2coqnat; simpl;
-  omega.
+  lia.
diff --git a/concurrency/common/threadPool.v b/concurrency/common/threadPool.v
index 1f718d6e83..7a012d8371 100644
--- a/concurrency/common/threadPool.v
+++ b/concurrency/common/threadPool.v
@@ -1,6 +1,7 @@
 
 From mathcomp.ssreflect Require Import ssreflect ssrbool ssrnat ssrfun eqtype seq fintype finfun.
 
+Require Import Lia.
 Require Import compcert.common.Memory.
 Require Import compcert.common.Values. (*for val*)
 Require Import VST.concurrency.common.scheduler.
@@ -16,6 +17,8 @@ Require Import VST.msl.Coqlib2.
 
 Require Import VST.concurrency.common.lksize.
 
+Import Address.
+
 Set Implicit Arguments.
 
 
@@ -40,10 +43,11 @@ Module ThreadPool.
     Local Notation ctl := (@ctl semC).
 
     Notation tid:= nat.
-    
+
+    (* !! TODO: remove extraRes? remove lockGuts, lockSet? *)
     Class ThreadPool :=
       { t : Type;
-        mkPool : ctl -> res -> t;
+        mkPool : ctl -> res -> (*res ->*) t;
         containsThread : t -> tid -> Prop;
         getThreadC : forall {tid tp}, containsThread tp tid -> ctl;
         getThreadR : forall {tid tp}, containsThread tp tid -> res;
@@ -51,16 +55,17 @@ Module ThreadPool.
         lockGuts : t -> AMap.t lock_info;  (* Gets the set of locks + their info    *)
         lockSet : t -> access_map;         (* Gets the permissions for the lock set *)
         lockRes : t -> address -> option lock_info;
+(*         extraRes : t -> res; (* extra resources not held by any thread or lock *) *)
         addThread : t -> val -> val -> res -> t;
         updThreadC : forall {tid tp}, containsThread tp tid -> ctl -> t;
         updThreadR : forall {tid tp}, containsThread tp tid -> res -> t;
         updThread : forall {tid tp}, containsThread tp tid -> ctl -> res -> t;
         updLockSet : t -> address -> lock_info -> t;
         remLockSet : t -> address -> t;
+(*         updExtraRes : t -> res -> t; *)
         latestThread : t -> tid;
         lr_valid : (address -> option lock_info) -> Prop;
-        (*Find the first thread i, that satisfiList
-es (filter i) *)
+        (*Find the first thread i that satisfies (filter i) *)
         find_thread_: t -> (ctl -> bool) -> option tid
         ; resourceList_spec: forall i tp
             (cnti: containsThread tp i),
@@ -139,6 +144,10 @@ es (filter i) *)
              forall {j tp} add,
                containsThread (remLockSet tp add) j ->
                containsThread tp j
+(*         ;  cntUpdateExtra:
+             forall {j tp} res,
+               containsThread tp j ->
+               containsThread (updExtraRes tp res) j *)
 
         (*;  gssLockPool:
     forall tp ls,
@@ -319,7 +328,37 @@ es (filter i) *)
                lr_valid (lockRes tp) ->
                lr_valid (lockRes (updThread cnti c' m'))
 
-        (*New Axioms, to avoid breaking the modularity *)
+(*        (* extraRes properties *)
+
+        ; gssExtraRes : forall tp res, extraRes (updExtraRes tp res) = res
+
+        ; gsoAddExtra : forall tp vf arg p, extraRes (addThread tp vf arg p) = extraRes tp
+
+        ; gsoThreadCExtra : forall {i tp} c (cnti: containsThread tp i), extraRes (updThreadC cnti c) = extraRes tp
+
+        ; gsoThreadRExtra : forall {i tp} r (cnti: containsThread tp i), extraRes (updThreadR cnti r) = extraRes tp
+
+        ; gsoThreadExtra : forall {i tp} c r (cnti: containsThread tp i), extraRes (updThread cnti c r) = extraRes tp
+
+        ; gsoLockSetExtra : forall tp addr res, extraRes (updLockSet tp addr res) = extraRes tp
+
+        ; gsoRemLockExtra : forall tp addr, extraRes (remLockSet tp addr) = extraRes tp
+
+        ; gExtraResCode : forall {i tp} res (cnti: containsThread tp i)
+               (cnti': containsThread (updExtraRes tp res) i),
+               getThreadC cnti' = getThreadC cnti
+
+        ; gExtraResRes : forall {i tp} res (cnti: containsThread tp i)
+               (cnti': containsThread (updExtraRes tp res) i),
+               getThreadR cnti' = getThreadR cnti
+
+        ; gsoExtraLPool : forall tp res addr,
+               lockRes (updExtraRes tp res) addr = lockRes tp addr
+
+        ; gsoExtraLock : forall tp res,
+               lockSet (updExtraRes tp res) = lockSet tp *)
+
+        (*New axioms, to avoid breaking the modularity *)
         ; lockSet_spec_2 :
             forall (js : t) (b : block) (ofs ofs' : Z),
               Intv.In ofs' (ofs, (ofs + Z.of_nat lksize.LKSIZE_nat)%Z) ->
@@ -444,15 +483,17 @@ Module OrdinalPool.
                     ; pool :> 'I_num_threads -> ctl
                     ; perm_maps : 'I_num_threads -> res
                     ; lset : AMap.t lock_info
+(*                     ; extra : res *)
                   }.
 
-    Definition one_pos : pos.pos := pos.mkPos NPeano.Nat.lt_0_1.
+    Definition one_pos : pos.pos := pos.mkPos Nat.lt_0_1.
     
-    Definition mkPool c res :=
+    Definition mkPool c res (* extra *) :=
       mk one_pos
         (fun _ =>  c)
-        (fun _ => res) (*initially there are no locks*)
-        empty_lset.
+        (fun _ => res)
+        empty_lset (* initially there are no locks *)
+        (* extra *). (* no obvious initial value for extra *)
     
     Definition lockGuts := lset.
     Definition lockSet (tp:t) := A2PMap (lset tp).
@@ -460,6 +501,8 @@ Module OrdinalPool.
     Definition lockRes t : address -> option lock_info:=
       AMap.find (elt:=lock_info)^~ (lockGuts t).
 
+(*     Definition extraRes := extra. *)
+
     Definition lr_valid (lr: address -> option lock_info):=
       forall b ofs,
         match lr (b,ofs) with
@@ -468,11 +511,11 @@ Module OrdinalPool.
         end.
 
     Lemma is_pos: forall n, (0 < S n)%coq_nat.
-    Proof. move=> n; omega. Qed.
+    Proof. move=> n; lia. Qed.
     Definition mk_pos_S (n:nat):= mkPos (is_pos n).
     Lemma lt_decr: forall n m: nat, S n < m -> n < m.
     Proof. move=> m n /ltP LE.
-           assert (m < n )%coq_nat by omega.
+           assert (m < n )%coq_nat by lia.
              by move: H => /ltP. Qed.
     Program Fixpoint find_thread' {st:t}{filter:ctl -> bool} n (P: n < num_threads st) {struct n}:=
       if filter (@pool st (@Ordinal (num_threads st) n P))
@@ -481,7 +524,6 @@ Module OrdinalPool.
            | S n' =>  find_thread' n' (lt_decr  n' _ P)
            | O => None
            end.
-    
     Next Obligation.
       intros; exact st.
     Defined.
@@ -492,7 +534,7 @@ Module OrdinalPool.
       intros. subst; reflexivity.
     Defined.
     Definition pos_pred (n:pos): nat.
-    Proof. destruct n. destruct n eqn:AA; [omega|].
+    Proof. destruct n. destruct n eqn:AA; [lia|].
            exact n0.
     Defined.
 
@@ -501,7 +543,7 @@ Module OrdinalPool.
     Next Obligation.
       rewrite /pos_pred /= => st filter.
       elim (num_threads st) => n N_pos /=.
-      destruct n; try omega; eauto.
+      destruct n; try lia; eauto.
     Qed.
 
     Import Coqlib.
@@ -565,7 +607,7 @@ Module OrdinalPool.
       intros.
       eapply lockSet_spec_2; eauto.
       unfold Intv.In.
-      simpl. pose proof LKSIZE_pos; rewrite Z2Nat.id; omega.
+      simpl. pose proof LKSIZE_pos; rewrite Z2Nat.id; lia.
     Qed.
 
     Open Scope nat_scope.
@@ -630,32 +672,36 @@ Module OrdinalPool.
             | None => pmap
             | Some n' => (perm_maps tp) n'
             end)
-         (lset tp).
+         (lset tp) (* (extra tp) *).
 
     Definition updLockSet tp (add:address) (lf:lock_info) : t :=
       mk (num_threads tp)
          (pool tp)
          (perm_maps tp)
-         (AMap.add add lf (lockGuts tp)).
+         (AMap.add add lf (lockGuts tp))
+         (* (extra tp) *).
 
     Definition remLockSet tp  (add:address) : t :=
       mk (num_threads tp)
          (pool tp)
          (perm_maps tp)
-         (AMap.remove add (lockGuts tp)).
+         (AMap.remove add (lockGuts tp))
+         (* (extra tp) *).
 
     Definition updThreadC {tid tp} (cnt: containsThread tp tid) (c' : ctl) : t :=
       mk (num_threads tp)
          (fun n => if n == (Ordinal cnt) then c' else (pool tp)  n)
          (perm_maps tp)
-         (lset tp).
+         (lset tp)
+         (* (extra tp) *).
 
     Definition updThreadR {tid tp} (cnt: containsThread tp tid)
                (pmap' : res) : t :=
       mk (num_threads tp) (pool tp)
          (fun n =>
             if n == (Ordinal cnt) then pmap' else (perm_maps tp) n)
-         (lset tp).
+         (lset tp)
+         (* (extra tp) *).
 
     Definition updThread {tid tp} (cnt: containsThread tp tid) (c' : ctl)
                (pmap : res) : t :=
@@ -664,7 +710,15 @@ Module OrdinalPool.
             if n == (Ordinal cnt) then c' else tp n)
          (fun n =>
             if n == (Ordinal cnt) then pmap else (perm_maps tp) n)
-         (lset tp).
+         (lset tp)
+         (* (extra tp) *).
+
+(*     Definition updExtraRes tp res : t :=
+      mk (num_threads tp)
+         (pool tp)
+         (perm_maps tp)
+         (lset tp)
+         res. *)
 
     (*TODO: see if typeclasses can automate these proofs, probably not thanks dep types*)
 
@@ -782,6 +836,14 @@ Module OrdinalPool.
                 simpl in *; by assumption.
     Qed.
 
+(*     Lemma cntUpdateExtra:
+             forall {j tp} res,
+               containsThread tp j ->
+               containsThread (updExtraRes tp res) j.
+    Proof.
+      intros. unfold containsThread in *; simpl in *; by assumption.
+    Qed. *)
+
     Lemma cntAdd:
       forall {j tp} vf arg p,
         containsThread tp j ->
@@ -814,14 +876,14 @@ Module OrdinalPool.
       destruct (j < (num_threads tp)) eqn:Hlt.
       left.
       split;
-        by [auto | ssromega].
+        by [auto | ssrlia].
       right.
       rewrite ltnS in H.
       rewrite leq_eqVlt in H.
       move/orP:H=> [H | H];
                     first by move/eqP:H.
       exfalso.
-        by ssromega.
+        by ssrlia.
     Qed.
 
     Lemma contains_add_latest: forall ds p a r,
@@ -829,7 +891,7 @@ Module OrdinalPool.
                        (latestThread ds).
     Proof. intros.
            simpl. unfold containsThread, latestThread.
-           simpl. ssromega.
+           simpl. ssrlia.
     Qed.
 
     Lemma updLock_updThread_comm:
@@ -866,9 +928,6 @@ Module OrdinalPool.
     (* TODO: most of these proofs are similar, automate them*)
     (** Getters and Setters Properties*)
 
-    Set Bullet Behavior "None".
-    Set Bullet Behavior "Strict Subproofs".
-
     Lemma gsslockResUpdLock: forall js a res,
         lockRes (updLockSet js a res) a =
         Some res.
@@ -879,11 +938,10 @@ Module OrdinalPool.
       forget (AMap.this (lockGuts js)) as el.
       unfold AMap.find; simpl.
       induction el.
-      *
-        simpl.
+      * simpl.
         destruct (@AMap.Raw.PX.MO.elim_compare_eq a a); auto. rewrite H. auto.
-      *
-        rewrite AMap.Raw.add_equation. destruct a0.
+      * simpl.
+        destruct a0.
         destruct (AddressOrdered.compare a a0).
         simpl.
         destruct (@AMap.Raw.PX.MO.elim_compare_eq a a); auto. rewrite H. auto.
@@ -974,23 +1032,8 @@ Module OrdinalPool.
         lockRes js a.
     Proof.
       intros.
-      unfold lockRes, remLockSet; simpl. unfold AMap.find, AMap.remove; simpl.
-      destruct js; simpl. destruct lset0; simpl.
-      rename this into el.
-      induction sorted; simpl; auto.
-      destruct a0 as [b ?].
-      destruct (AddressOrdered.compare loc b); simpl; address_ordered_auto;
-        destruct (AddressOrdered.compare a b); simpl; address_ordered_auto.
-      assert (forall (y: address * lock_info), SetoidList.InA (@AMap.Raw.PX.eqk _) y l -> AMap.Raw.PX.ltk (b,l0) y).
-      apply SetoidList.InfA_alt; auto with typeclass_instances.
-      specialize (H1 (a,l0)).
-      assert (~SetoidList.InA (AMap.Raw.PX.eqk (elt:=lock_info)) (a, l0) l ).
-      intro. specialize (H1 H2).
-      change (AddressOrdered.lt b a) in H1. address_ordered_auto.
-      clear - H2.
-      induction l as [| [b ?]]; simpl in *; auto.
-      destruct (AddressOrdered.compare a b); simpl; address_ordered_auto.
-      contradiction H2. left; auto.
+      unfold lockRes, remLockSet; simpl.
+      rewrite AMap_find_remove if_false; auto.
     Qed.
 
 
@@ -1041,20 +1084,20 @@ Module OrdinalPool.
         { (exists z, z <= ofs < z+LKSIZE /\ lockRes tp (b,z) )%Z  } + {(forall z, z <= ofs < z+LKSIZE -> lockRes tp (b,z) = None)%Z }.
     Proof.
       intros tp b ofs.
-      assert (H : (0 <= LKSIZE)%Z) by (pose proof LKSIZE_pos; omega).
+      assert (H : (0 <= LKSIZE)%Z) by (pose proof LKSIZE_pos; lia).
       destruct (@RiemannInt_SF.IZN_var _ H) as (n, ->).
       induction n.
-      - right. simpl. intros. omega.
+      - right. simpl. intros. lia.
       - destruct IHn as [IHn | IHn].
         + left; destruct IHn as (z & r & Hz).
-          exists z; split; auto. zify. omega.
+          exists z; split; auto. zify. lia.
         + destruct (lockRes tp (b, (ofs - Z.of_nat n)%Z)) eqn:Ez.
           * left. exists (ofs - Z.of_nat n)%Z; split. 2:rewrite Ez; auto.
-            zify; omega.
+            zify; lia.
           * right; intros z r.
             destruct (zeq ofs (z + Z.of_nat n)%Z).
-            -- subst; auto. rewrite <-Ez; do 2 f_equal. omega.
-            -- apply IHn. zify. omega.
+            -- subst; auto. rewrite <-Ez; do 2 f_equal. lia.
+            -- apply IHn. zify. lia.
     Qed.
 
     Lemma lockSet_spec_3:
@@ -1115,13 +1158,13 @@ Module OrdinalPool.
       * hnf in H.
         destruct (lockRes ds (b,z)) eqn:?; inv H1.
       + destruct (lockRes ds (b,ofs)) eqn:?; inv H4.
-        assert (z <= ofs < z+2 * size_chunk AST.Mptr \/ ofs <= z <= ofs+2 * size_chunk AST.Mptr)%Z by omega.
+        assert (z <= ofs < z+2 * size_chunk AST.Mptr \/ ofs <= z <= ofs+2 * size_chunk AST.Mptr)%Z by lia.
         destruct H1.
       - specialize (H b z). rewrite Heqo in H. unfold LKSIZE in H.
-        specialize (H ofs). spec H; [omega|]. congruence.
+        specialize (H ofs). spec H; [lia|]. congruence.
       - specialize (H b ofs). rewrite Heqo0 in H. specialize (H z).
         unfold LKSIZE in H.
-        spec H; [omega|]. congruence.
+        spec H; [lia|]. congruence.
         + unfold lockRes, remLockSet.  simpl.
           assert (H8 := @AMap.remove_3 _ (lockGuts ds) (b,ofs) (b,z)).
           destruct (AMap.find (b, z) (AMap.remove (b, ofs) (lockGuts ds))) eqn:?; auto.
@@ -1167,7 +1210,7 @@ Module OrdinalPool.
         assert (ofs <> z).
         { intros AA. inversion AA.
           apply H0. hnf.
-          simpl; omega. }
+          simpl; lia. }
         erewrite lockSet_spec_2.
         erewrite lockSet_spec_2; auto.
         + hnf; simpl; eauto.
@@ -1195,21 +1238,18 @@ Module OrdinalPool.
     Lemma eq_op_false: forall A i j, i <>j -> @eq_op A i j = false.
     Proof.
       intros.
-      unfold eq_op; simpl.
-      unfold Equality.op. destruct A eqn:?. simpl.
-      unfold Equality.sort in *.
-      destruct m; simpl in *.
-      generalize (a i j); intros. inv H0; auto. contradiction H;auto.
+      apply (@negbRL _ true).
+      eapply contraFneq; last done.
+      intros. easy.
     Qed.
-
+    
     Lemma gsoThreadCode:
       forall {i j tp} (Hneq: i <> j) (cnti: containsThread tp i)
         (cntj: containsThread tp j) c' p'
         (cntj': containsThread (updThread cnti c' p') j),
         getThreadC cntj' = getThreadC cntj.
     Proof.
-      intros.
-      simpl.
+      intros. simpl.
       unfold eq_op. simpl.
       rewrite eq_op_false; auto.
       unfold updThread in cntj'. unfold containsThread in *. simpl in *.
@@ -1354,7 +1394,7 @@ Module OrdinalPool.
       destruct o.
       simpl in *.
       subst. exfalso;
-               ssromega.
+               ssrlia.
       rewrite H. by reflexivity.
     Qed.
 
@@ -1380,7 +1420,7 @@ Module OrdinalPool.
                          != (Ordinal (n:=(num_threads tp).+1) (m:=j) cntj')).
       { apply/eqP. intros Hcontra.
         unfold ordinal_pos_incr in Hcontra.
-        inversion Hcontra; auto. subst. by ssromega.
+        inversion Hcontra; auto. subst. by ssrlia.
       }
       apply unlift_some in Hcontra. rewrite Hunlift in Hcontra.
       destruct Hcontra; by discriminate.
@@ -1401,7 +1441,7 @@ Module OrdinalPool.
       apply unlift_m_inv in H.
       destruct o. simpl in *.
       subst. exfalso;
-               ssromega.
+               ssrlia.
       rewrite H.
         by reflexivity.
     Qed.
@@ -1431,7 +1471,7 @@ Module OrdinalPool.
       { apply/eqP. intros Hcontra.
         unfold ordinal_pos_incr in Hcontra.
         inversion Hcontra; auto. subst.
-          by ssromega.
+          by ssrlia.
       }
       apply unlift_some in Hcontra. rewrite Hunlift in Hcontra.
       destruct Hcontra;
@@ -1480,7 +1520,7 @@ Module OrdinalPool.
             unfold containsThread in *; simpl in *.
             unfold ordinal_pos_incr in Hcontra.
             inversion Hcontra. subst.
-              by ssromega.
+              by ssrlia.
           }
           apply unlift_some in Hcontra. simpl in Hcontra.
           rewrite Hunlift in Hcontra.
@@ -1534,7 +1574,7 @@ Module OrdinalPool.
             unfold containsThread in *; simpl in *.
             unfold ordinal_pos_incr in Hcontra.
             inversion Hcontra. subst.
-              by ssromega.
+              by ssrlia.
           }
           apply unlift_some in Hcontra. simpl in Hcontra.
           rewrite Hunlift in Hcontra.
@@ -1839,7 +1879,7 @@ Module OrdinalPool.
         (Maps.PMap.get b (lockSet tp)) ofs'.
     Proof.
       intros.
-      apply gsoLockSet_12. intros [? ?]. unfold LKSIZE_nat in *; rewrite Z2Nat.id in Hofs; simpl in *; omega.
+      apply gsoLockSet_12. intros [? ?]. unfold LKSIZE_nat in *; rewrite Z2Nat.id in Hofs; simpl in *; lia.
     Qed.
 
     Lemma gsoLockSet_2 :
@@ -1872,6 +1912,71 @@ Module OrdinalPool.
       rewrite gsoThreadLPool; apply H.
     Qed.
 
+(*     Lemma gssExtraRes : forall tp res, extraRes (updExtraRes tp res) = res.
+    Proof.
+      reflexivity.
+    Qed.
+
+    Lemma gsoAddExtra : forall tp vf arg p, extraRes (addThread tp vf arg p) = extraRes tp.
+    Proof.
+      reflexivity.
+    Qed.
+
+    Lemma gsoThreadCExtra : forall {i tp} c (cnti: containsThread tp i), extraRes (updThreadC cnti c) = extraRes tp.
+    Proof.
+      reflexivity.
+    Qed.
+
+    Lemma gsoThreadRExtra : forall {i tp} r (cnti: containsThread tp i), extraRes (updThreadR cnti r) = extraRes tp.
+    Proof.
+      reflexivity.
+    Qed.
+
+    Lemma gsoThreadExtra : forall {i tp} c r (cnti: containsThread tp i), extraRes (updThread cnti c r) = extraRes tp.
+    Proof.
+      reflexivity.
+    Qed.
+
+    Lemma gsoLockSetExtra : forall tp addr res, extraRes (updLockSet tp addr res) = extraRes tp.
+    Proof.
+      reflexivity.
+    Qed.
+
+    Lemma gsoRemLockExtra : forall tp addr, extraRes (remLockSet tp addr) = extraRes tp.
+    Proof.
+      reflexivity.
+    Qed.
+
+    Lemma gExtraResCode : forall {i tp} res (cnti: containsThread tp i)
+               (cnti': containsThread (updExtraRes tp res) i),
+               getThreadC cnti' = getThreadC cnti.
+    Proof.
+      destruct tp; simpl.
+      intros; do 2 f_equal.
+      apply cnt_irr.
+    Qed.
+
+    Lemma gExtraResRes : forall {i tp} res (cnti: containsThread tp i)
+               (cnti': containsThread (updExtraRes tp res) i),
+               getThreadR cnti' = getThreadR cnti.
+    Proof.
+      destruct tp; simpl.
+      intros; do 2 f_equal.
+      apply cnt_irr.
+    Qed.
+
+    Lemma gsoExtraLPool : forall tp res addr,
+               lockRes (updExtraRes tp res) addr = lockRes tp addr.
+    Proof.
+      reflexivity.
+    Qed.
+
+    Lemma gsoExtraLock : forall tp res,
+               lockSet (updExtraRes tp res) = lockSet tp.
+    Proof.
+      reflexivity.
+    Qed. *)
+
     Lemma contains_iff_num:
       forall tp tp'
         (Hcnt: forall i, containsThread tp i <-> containsThread tp' i),
@@ -1889,83 +1994,85 @@ Module OrdinalPool.
       destruct n0; auto.
       destruct (Hcnt 0).
       exfalso.
-      specialize (H0 ltac:(ssromega));
-        by ssromega.
+      specialize (H0 ltac:(ssrlia));
+        by ssrlia.
       destruct n0.
       exfalso.
       destruct (Hcnt 0).
-      specialize (H ltac:(ssromega));
-        by ssromega.
+      specialize (H ltac:(ssrlia));
+        by ssrlia.
       erewrite IHn; eauto.
       intros; split; intro H.
-      assert (i.+1 < n.+1) by ssromega.
+      assert (i.+1 < n.+1) by ssrlia.
       specialize (fst (Hcnt (i.+1)) H0).
       intros.
       clear -H1;
-        by ssromega.
-      assert (i.+1 < n0.+1) by ssromega.
+        by ssrlia.
+      assert (i.+1 < n0.+1) by ssrlia.
       specialize (snd (Hcnt (i.+1)) H0).
       intros.
       clear -H1;
-        by ssromega.
+        by ssrlia.
       subst.
         by erewrite proof_irr with (a1 := N_pos) (a2 := N_pos0).
     Qed.
 
+    (* !! *)
+
     Lemma leq_stepdown:
       forall {m n},
         S n <= m -> n <= m.
-    Proof. intros; ssromega. Qed.
+    Proof. intros; ssrlia. Qed.
     
     Lemma lt_sub:
       forall {m n},
         S n <= m ->
         m - (S n) <  m.
-    Proof. intros; ssromega. Qed.
+    Proof. intros; ssrlia. Qed.
 
     
     Fixpoint containsList_upto_n (n m:nat): n <= m -> seq.seq (sigT (fun i => i < m)):=
       match n with
       | O => fun _ => nil
       | S n' => fun (H: S n' <= m) =>
-                 (existT (fun i => i < m) (m-(S n')) (lt_sub H)) ::
-                 (containsList_upto_n n' m) (leq_stepdown H)                                  
+                 (existT (P := fun i => i < m) (m-(S n')) (lt_sub H)) ::
+                 (containsList_upto_n n' m) (leq_stepdown H)
       end.
 
     Lemma containsList_upto_n_spec:
       forall m n (H: n <= m)
         i (cnti:  (fun i => i < m) (m - n + i)),
         i < n ->
-        nth_error (containsList_upto_n n m H) i = Some (existT _ (m - n + i) (cnti)). 
+        nth_error (containsList_upto_n n m H) i = Some (existT (m - n + i) (cnti)). 
     Proof.
       intros.
       remember (n - i) as k.
-      assert (HH: n = i + k) by ssromega.
+      assert (HH: n = i + k) by ssrlia.
       clear Heqk.
       revert m n H cnti H0 HH.
       induction i.
       intros.
-      - destruct n; try (exfalso; ssromega).
+      - destruct n; try (exfalso; ssrlia).
         simpl. f_equal.
         eapply ProofIrrelevance.ProofIrrelevanceTheory.subsetT_eq_compat.
-        ssromega.
+        ssrlia.
       - intros.
-        assert (n = (n - 1).+1) by ssromega.
+        assert (n = (n - 1).+1) by ssrlia.
         revert H cnti .
         dependent rewrite H1.
         intros H cnti.
         simpl.
         rewrite IHi.
-        + ssromega.
+        + ssrlia.
         + intros. f_equal.
           eapply ProofIrrelevance.ProofIrrelevanceTheory.subsetT_eq_compat.
           clear - H.
-          ssromega.
-        + ssromega.
-        + ssromega.
+          ssrlia.
+        + ssrlia.
+        + ssrlia.
     Qed.
       
-    Lemma leq_refl: forall n, n <= n. Proof. intros; ssromega. Qed.
+    Lemma leq_refl: forall n, n <= n. Proof. intros; ssrlia. Qed.
     
     Definition containsList' (n:nat): seq.seq (sigT (fun i => i < n)):=
       containsList_upto_n n n (leq_refl n).
@@ -1973,29 +2080,29 @@ Module OrdinalPool.
     Definition contains_from_ineq (tp:t):
         {i : tid & i < num_threads tp } -> {i : tid & containsThread tp i}:=
        fun (H : {i : tid & i < num_threads tp}) =>
-         let (x, i) := H in existT (containsThread tp) x i.
+         let (x, i) := H in existT x i.
 
     Definition containsList (tp:t): seq.seq (sigT (containsThread tp)):=
       map (contains_from_ineq tp) (containsList' (num_threads tp)).
 
     Lemma containsList'_spec: forall i n
             (cnti: (fun i => i < n) i),
-            List.nth_error (containsList' n) i = Some (existT _ i (cnti)).
+            List.nth_error (containsList' n) i = Some (existT i (cnti)).
     Proof.
       intros.
       unfold containsList'.
       - rewrite containsList_upto_n_spec.
-        + simpl in cnti; ssromega.
+        + simpl in cnti; ssrlia.
         + intros. f_equal.
           eapply ProofIrrelevance.ProofIrrelevanceTheory.subsetT_eq_compat.
-          simpl in cnti; ssromega.
+          simpl in cnti; ssrlia.
         + assumption.
     Qed.
 
       
     Lemma containsList_spec: forall i tp
             (cnti: containsThread tp i),
-            List.nth_error (containsList tp) i = Some (existT _ i cnti).
+            List.nth_error (containsList tp) i = Some (existT i cnti).
     Proof.
       intros.
       unfold containsList. 
@@ -2010,8 +2117,6 @@ Module OrdinalPool.
       map (@indexed_contains tp)
           (containsList tp).
 
-      
-
     Lemma resourceList_spec: forall i tp
             (cnti: containsThread tp i),
             List.nth_error (resourceList tp) i = Some (getThreadR cnti).
@@ -2023,7 +2128,7 @@ Module OrdinalPool.
       unfold getThreadR; simpl.
       simpl in *.
       induction n.
-      - exfalso. ssromega.
+      - exfalso. ssrlia.
       - unfold resourceList.
         rewrite list_map_nth.
         rewrite containsList_spec.
@@ -2035,19 +2140,21 @@ Module OrdinalPool.
                                     t
                                     mkPool
                                     containsThread
-                                    (@getThreadC) 
-                                    (@getThreadR) 
+                                    (@getThreadC)
+                                    (@getThreadR)
                                     resourceList
                                     lockGuts
                                     lockSet
-                                    (@lockRes) 
+                                    (@lockRes)
+                                    (* extraRes *)
                                     addThread
-                                    (@updThreadC) 
+                                    (@updThreadC)
                                     (@updThreadR)
-                                    (@updThread) 
-                                    updLockSet 
-                                    remLockSet 
-                                    latestThread 
+                                    (@updThread)
+                                    updLockSet
+                                    remLockSet
+                                    (* updExtraRes *)
+                                    latestThread
                                     lr_valid 
                                     (*Find the first thread i, that satisfies (filter i) *)
                                     find_thread
@@ -2068,6 +2175,7 @@ Module OrdinalPool.
                                     (@cntRemoveL)
                                     (@cntUpdateL')
                                     (@cntRemoveL')
+                                    (* (@cntUpdateExtra) *)
                                     (@gsoThreadLock)
                                     (@gsoThreadCLock)
                                     (@gsoThreadRLock)
@@ -2100,6 +2208,17 @@ Module OrdinalPool.
                                     add_updateC_comm
                                     add_update_comm
                                     updThread_lr_valid
+(*                                     gssExtraRes
+                                    gsoAddExtra
+                                    (@gsoThreadCExtra)
+                                    (@gsoThreadRExtra)
+                                    (@gsoThreadExtra)
+                                    gsoLockSetExtra
+                                    gsoRemLockExtra
+                                    (@gExtraResCode)
+                                    (@gExtraResRes)
+                                    gsoExtraLPool
+                                    gsoExtraLock *)
                                     lockSet_spec_2
                                     lockSet_spec_3
                                     gsslockSet_rem
@@ -2109,7 +2228,7 @@ Module OrdinalPool.
                                     gsolockResUpdLock
                                     gsslockResRemLock
                                     gsolockResRemLock
-                                    (@ gRemLockSetCode)
+                                    (@gRemLockSetCode)
                                     (@gRemLockSetRes)
                                     (@gsoAddCode)
                                     (@gssAddCode)
diff --git a/concurrency/common/threads_lemmas.v b/concurrency/common/threads_lemmas.v
index 57faace620..4fd577d830 100644
--- a/concurrency/common/threads_lemmas.v
+++ b/concurrency/common/threads_lemmas.v
@@ -3,7 +3,7 @@ Require Import compcert.lib.Axioms.
 From mathcomp.ssreflect Require Import ssreflect ssrbool ssrnat eqtype seq.
 Require Import Lists.List.
 Require Import Coq.ZArith.ZArith.
-Require Import PreOmega.
+Require Import Lia.
 Set Implicit Arguments.
 Import Axioms.
 (* tactics to support Omega for ssrnats*)
@@ -28,10 +28,10 @@ Ltac arith_goal_ssrnat2coqnat :=
            | |- is_true (_ < _) => try apply/ltP
          end.
 
-Ltac ssromega :=
+Ltac ssrlia :=
   repeat arith_hypo_ssrnat2coqnat;
   arith_goal_ssrnat2coqnat; simpl;
-  omega.
+  lia.
 
 Class monad (mon : Type -> Type) :=
   {
@@ -145,7 +145,7 @@ Lemma lt_succ_neq:
     (x <= y < x + z)%Z.
 Proof.
   intros.
-  omega.
+  lia.
 Qed.
 
 
@@ -157,9 +157,9 @@ Lemma le_sub:
 Proof.
   intros x y z H H0.
   zify.
-  rewrite <-Pos2Z.add_pos_neg.
+  rewrite <-Pos2Z.add_pos_neg in H2.
   assert (x < z)%positive by auto.
-  rewrite Z2Pos.id; zify; omega.
+  zify; lia.
 Qed.
 
 Lemma lt_sub_bound:
@@ -169,8 +169,8 @@ Lemma lt_sub_bound:
 Proof.
   intros x y H.
   zify.
-  rewrite <-Pos2Z.add_pos_neg.
-  rewrite Z2Pos.id; zify; omega.
+  rewrite <-Pos2Z.add_pos_neg in H1.
+  zify; lia.
 Qed.
 
 Lemma lt_lt_sub:
@@ -180,7 +180,7 @@ Lemma lt_lt_sub:
     (b - a < c)%positive.
 Proof.
   intros a b c H H0.
-  zify; omega.
+  zify; lia.
 Qed.
 
 Lemma prod_fun :
@@ -264,14 +264,13 @@ Module BlockList.
     intros n.
     induction n;
       intros.
-    simpl. ssromega.
-    destruct n. ssromega.
+    simpl. ssrlia.
+    destruct n. ssrlia.
     rewrite <- mkBlockList_unfold'. simpl. simpl in IHn.
-    destruct (beq_nat k (S n)) eqn:?. apply beq_nat_true in Heqb. subst.
-    now left.
+    destruct (k =? (S n)) eqn: ?. apply Nat.eqb_eq in Heqb. now left.
     right. apply IHn; auto;  clear IHn.
-    apply beq_nat_false in Heqb. ssromega.
-    apply beq_nat_false in Heqb. ssromega.
+    apply Nat.eqb_neq in Heqb. ssrlia.
+    apply Nat.eqb_neq in Heqb. ssrlia.
   Qed.
 
   Lemma mkBlockList_not_in : forall n m
@@ -328,7 +327,7 @@ Module SeqLemmas.
     intros T s. induction s; intros.
     destruct n; simpl in Hdrop; rewrite <- Hdrop; auto.
     simpl in *. destruct n. rewrite <- Hdrop. auto.
-    eapply IHs in Hdrop. ssromega.
+    eapply IHs in Hdrop. ssrlia.
   Defined.
   Lemma subSeq_det : forall {T:eqType} (s s' s'' : seq T) (Hsize: size s' = size s'')
                        (Hsub': subSeq s' s) (Hsub'': subSeq s'' s),
@@ -343,8 +342,8 @@ Module SeqLemmas.
       reflexivity.
       apply IHs. assumption.
       unfold subSeq.
-        by replace n with (size s - size s') in Hsub' by ssromega.
-          by replace n with (size s - size s'') in Hsub'' by ssromega.
+        by replace n with (size s - size s') in Hsub' by ssrlia.
+          by replace n with (size s - size s'') in Hsub'' by ssrlia.
   Defined.
 
   Lemma in_rcons : forall {T:Type} x y (s : seq T) (HIn: List.In x (rcons s y)),
diff --git a/concurrency/compiler/mem_equiv.v b/concurrency/compiler/mem_equiv.v
index 1a81a34853..230865f546 100644
--- a/concurrency/compiler/mem_equiv.v
+++ b/concurrency/compiler/mem_equiv.v
@@ -1,10 +1,11 @@
-Require Import Omega.
+Require Import Lia.
 
 Require Import Coq.Classes.Morphisms.
 Require Import Relation_Definitions.
 
 Require Import compcert.common.Values.
 Require Import compcert.common.Memory.
+Require Import compcert.lib.Maps.
 
 Require Import VST.concurrency.lib.setoid_help.
 Require Import VST.concurrency.common.permissions. Import permissions.
@@ -33,10 +34,10 @@ Lemma part_reflexive_proper_proxy {A P} {R: relation A}
       `(PartReflexive A P R) (x : A) : P x -> ProperProxy R x.
   intros. eapply H; auto.
 Qed.
-(* This ensures that when ProperProxy is ebing resolved,
+(* This ensures that when ProperProxy is being resolved,
    partial reflexivity is considered
  *)
-Hint Extern 3 (ProperProxy ?R _) => 
+#[export] Hint Extern 3 (ProperProxy ?R _) => 
 not_evar R; class_apply @part_reflexive_proper_proxy;
   try typeclasses eauto; eauto
                          : typeclass_instances.
@@ -45,8 +46,8 @@ not_evar R; class_apply @part_reflexive_proper_proxy;
 (* We present two more relations that help take advantage of the above.*)
 Inductive trieq {A : Type} (x : A) : A -> A -> Prop :=
 | triew_refl: trieq x x x.
-Hint Resolve (triew_refl).
-Instance trieq_PartReflexive: forall A (x:A), PartReflexive (eq x) (trieq x).
+#[export] Hint Constructors trieq : core.
+#[export] Instance trieq_PartReflexive: forall A (x:A), PartReflexive (eq x) (trieq x).
 Proof. constructor; intros; subst; constructor. Qed.
 Global Instance Symmetric_trieq:
   forall {A} (x:A), Symmetric (trieq x).
@@ -61,7 +62,7 @@ Qed.
 
 Definition eq_P {A : Type} (P:A -> Prop) (x y: A) : Prop := 
   (x = y) /\ P x.
-Instance eq_P_PartReflexive: forall {A P}, PartReflexive P (@eq_P A P).
+#[export] Instance eq_P_PartReflexive: forall {A P}, PartReflexive P (@eq_P A P).
 Proof. constructor; intros; subst; constructor; auto. Qed.
 Global Instance Symmetric_eq_P:
   forall {A P}, Symmetric (@eq_P A P).
@@ -78,7 +79,6 @@ Qed.
 
 
 
-
 Ltac rewrite_getPerm_goal:=
   match goal with
   | [|- context[(?f ?m) !! ?b ?ofs ?k] ] =>
@@ -105,13 +105,21 @@ Ltac rewrite_getPerm := first [rewrite_getPerm_goal|rewrite_getPerm_hyp].
 
 Definition access_map_equiv (a1 a2: access_map): Prop :=
   forall b, a1 !! b =  a2 !! b.
-Instance access_map_equiv_Equivalence: Equivalence access_map_equiv.
+#[export] Instance access_map_equiv_Equivalence: Equivalence access_map_equiv.
 Proof.
   constructor; try constructor; intros ?; intros.
   - unfold access_map_equiv in *; auto.
   - unfold access_map_equiv in *; etransitivity; auto.
 Qed.
 
+Global Instance permMapLt_order : PartialOrder access_map_equiv permMapLt.
+Proof.
+  split.
+  - intros H; split; intros ??; rewrite H; apply po_refl.
+  - intros [H1 H2] ?.
+    extensionality o.
+    apply perm_order_antisym; auto.
+Qed.
 
 Ltac destruct_address_range b ofs b0 ofs0 n:=
   let Hrange:= fresh "Hrange" in
@@ -124,7 +132,7 @@ Ltac destruct_address_range b ofs b0 ofs0 n:=
   | ].
 
 
-Instance setPermBlock_access_map_equiv:
+#[export] Instance setPermBlock_access_map_equiv:
   Proper (eq ==> eq ==> eq ==>
              access_map_equiv ==> eq_P (lt 0) ==>  access_map_equiv)
          (setPermBlock ).
@@ -134,7 +142,7 @@ Proof.
   destruct_address_range y0 y1 b ofs y3.
   - unfold Intv.In in *; simpl in *.
     repeat rewrite setPermBlock_same; auto.
-  - eapply Intv.range_notin in Hrange; simpl; try omega.
+  - eapply Intv.range_notin in Hrange; simpl; try lia.
     repeat rewrite setPermBlock_other_1; auto.
     rewrite H2; auto.
   - subst.
@@ -208,7 +216,7 @@ Proof.
     econstructor; etransitivity; eauto.
 Qed.
 
-Instance Proper_perm_max:
+#[export] Instance Proper_perm_max:
   Proper (Max_equiv ==> eq ==> eq ==> (trieq Max) ==> eq ==> iff) Mem.perm.
 Proof.
   proper_iff; proper_intros; subst.
@@ -218,7 +226,7 @@ Proof.
     repeat rewrite_getPerm.
   rewrite <- H; auto.
 Qed.
-Instance Proper_perm_cur:
+#[export] Instance Proper_perm_cur:
   Proper (Cur_equiv ==> eq ==> eq ==> (trieq Cur) ==> eq ==> iff) Mem.perm.
 Proof.
   proper_iff; proper_intros; subst.
@@ -229,14 +237,14 @@ Proof.
   - rewrite <- H; auto.
 Qed.
 
-Instance Proper_perm:
+#[export] Instance Proper_perm:
   Proper (mem_equiv ==> eq ==> eq ==> eq ==> eq ==> iff) Mem.perm.
 Proof.
   proper_iff; proper_intros; subst.
   destruct y2; [rewrite <- (max_eqv _ _ H)| erewrite <- (cur_eqv _ _ H)];
     assumption.
 Qed.
-Instance Proper_perm_Max:
+#[export] Instance Proper_perm_Max:
   Proper (Max_equiv ==> eq ==> eq ==> trieq Max ==> eq ==> iff) Mem.perm.
 Proof.
   proper_iff; unfold Mem.perm; proper_intros; subst.
@@ -245,14 +253,14 @@ Proof.
   rewrite <- H; assumption.
 Qed.
 
-Instance range_perm_mem_equiv:
+#[export] Instance range_perm_mem_equiv:
   Proper (mem_equiv ==> eq ==>  eq ==>  eq ==>  eq ==>  eq ==> iff) Mem.range_perm.
 Proof.
   proper_iff; proper_intros; subst.
   unfold Mem.range_perm in *; intros.
   rewrite <- H. eapply H5; auto.
 Qed.
-Instance range_perm_mem_equiv_Max:
+#[export] Instance range_perm_mem_equiv_Max:
   Proper (Max_equiv ==> eq ==>  eq ==>  eq ==>  trieq Max  ==>  eq ==> iff) Mem.range_perm.
 Proof.
   proper_iff; proper_intros; subst.
@@ -260,7 +268,7 @@ Proof.
   unfold Mem.range_perm in *; intros.
   rewrite <- H. eapply H5; auto.
 Qed.
-Instance range_perm_mem_equiv_Cur:
+#[export] Instance range_perm_mem_equiv_Cur:
   Proper (Cur_equiv ==> eq ==>  eq ==>  eq ==>  trieq Cur  ==>  eq ==> iff) Mem.range_perm.
 Proof.
   proper_iff; proper_intros; subst.
@@ -269,7 +277,7 @@ Proof.
   rewrite <- H. eapply H5; auto.
 Qed.
 
-Instance mem_inj_equiv:
+#[export] Instance mem_inj_equiv:
   Proper ( eq ==> mem_equiv ==> mem_equiv ==> iff) Mem.mem_inj.
 Proof.
   proper_iff. proper_intros; subst.
@@ -287,11 +295,11 @@ Proof.
     eapply H2; eauto.
 Qed.
 
-Instance Proper_nextblock:
+#[export] Instance Proper_nextblock:
   Proper (mem_equiv ==> Logic.eq) Mem.nextblock.
 Proof. intros ???. erewrite nextblock_eqv; auto. Qed.
 
-Instance Proper_valid_block:
+#[export] Instance Proper_valid_block:
   Proper (mem_equiv ==> Logic.eq ==> Logic.eq) Mem.valid_block.
 Proof.
   intros ??????.
@@ -300,7 +308,7 @@ Proof.
 Qed.
 
 
-Instance Proper_no_overlap_max_equiv:
+#[export] Instance Proper_no_overlap_max_equiv:
   Proper (Logic.eq ==> Max_equiv ==> iff)
          Mem.meminj_no_overlap.
 Proof.
@@ -314,7 +322,7 @@ Proof.
 Qed.
 
 
-Instance Proper_no_overlap_mem_equiv:
+#[export] Instance Proper_no_overlap_mem_equiv:
   Proper (eq ==> mem_equiv ==> iff) Mem.meminj_no_overlap.
 Proof.
   proper_iff. proper_intros; subst.
@@ -322,7 +330,7 @@ Proof.
   symmetry; apply H0.
 Qed.
 
-Instance mem_inject_equiv:
+#[export] Instance mem_inject_equiv:
   Proper  ( eq ==> mem_equiv ==> mem_equiv ==> iff) Mem.inject.
 Proof.
   proper_iff.
@@ -342,7 +350,7 @@ Proof.
     apply Hinj; auto.
 Qed.
 
-Instance permMapLt_equiv:
+#[export] Instance permMapLt_equiv:
   Proper (access_map_equiv ==> access_map_equiv ==> iff)
          permMapLt.
 Proof. proper_iff. intros ?????? HH ??; rewrite <- H, <- H0; auto. Qed.
@@ -367,7 +375,7 @@ Proof.
       unfold permission_at in Hlt.
     unfold PMap.get in Hlt.
     rewrite HH in Hlt.
-    rewrite Clight_bounds.Mem_canonical_useful in Hlt.
+    rewrite Mem_canonical_useful in Hlt.
     simpl in Hlt.
     destruct ( (snd perm) ! b).
     + destruct (o ofs); first [contradiction | auto].
@@ -435,7 +443,7 @@ Lemma restr_proof_irr_equiv:
 Qed.
 
 
-Instance valid_access_Proper:
+#[export] Instance valid_access_Proper:
   Proper (mem_equiv  ==> Logic.eq ==> Logic.eq  ==>
                      Logic.eq ==> Logic.eq ==> iff) Mem.valid_access.
 Proof.
@@ -443,7 +451,7 @@ Proof.
   setoid_help.proper_iff; setoid_help.proper_intros; subst.
   rewrite <- H; auto.
 Qed.
-Instance load_Proper:
+#[export] Instance load_Proper:
   Proper (Logic.eq ==> mem_equiv ==> Logic.eq ==> Logic.eq  ==> Logic.eq) Mem.load.
 Proof.
   setoid_help.proper_intros; subst.
@@ -462,7 +470,7 @@ Proof.
   - reflexivity.
 Qed.
 
-Instance loadv_Proper:
+#[export] Instance loadv_Proper:
   Proper (Logic.eq ==> mem_equiv ==> Logic.eq  ==> Logic.eq) Mem.loadv.
 Proof. intros ??? ??? ???; subst.
        destruct y1; auto.
@@ -528,4 +536,4 @@ Lemma store_max_equiv:
 Proof.
   intros. intros ?.
   erewrite store_max_eq; eauto.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/concurrency/conclib.v b/concurrency/conclib.v
index 512501978a..32748343a8 100644
--- a/concurrency/conclib.v
+++ b/concurrency/conclib.v
@@ -1,111 +1,34 @@
-Require Import VST.msl.predicates_hered.
-Require Import VST.veric.ghosts.
-Require Import VST.veric.invariants.
-Require Import VST.veric.fupd.
 Require Export VST.veric.slice.
-Require Export VST.msl.iter_sepcon.
-Require Import VST.msl.ageable.
-Require Import VST.msl.age_sepalg.
 Require Export VST.concurrency.semax_conc_pred.
 Require Export VST.concurrency.semax_conc.
 Require Export VST.floyd.proofauto.
 Require Export VST.zlist.sublist.
-
-Import FashNotation.
 Import LiftNotation.
-Import compcert.lib.Maps.
+Import -(notations) compcert.lib.Maps.
 
 (* Require Export VST.concurrency.conclib_veric. *)
 
 Notation vint z := (Vint (Int.repr z)).
 Notation vptrofs z := (Vptrofs (Ptrofs.repr z)).
 
-Open Scope logic.
-
-Lemma wsat_fupd : forall E P Q, (wsat * P |-- |==> wsat * Q) -> P |-- fupd.fupd E E Q.
-Proof.
-  intros; unfold fupd.
-  unseal_derives.
-  rewrite <- predicates_sl.wand_sepcon_adjoint.
-  rewrite <- predicates_sl.sepcon_assoc; eapply predicates_hered.derives_trans.
-  { apply predicates_sl.sepcon_derives, predicates_hered.derives_refl.
-    rewrite predicates_sl.sepcon_comm; apply H. }
-  eapply predicates_hered.derives_trans; [apply own.bupd_frame_r | apply own.bupd_mono].
-  apply predicates_hered.orp_right2.
-  setoid_rewrite (predicates_sl.sepcon_comm _ Q).
-  rewrite <- predicates_sl.sepcon_assoc; apply predicates_hered.derives_refl.
-Qed.
-
-Lemma wsat_alloc_dep : forall P, (wsat * ALL i, |> P i) |-- |==> wsat * EX i : _, invariant i (P i).
-Proof.
-  intros; unseal_derives; apply wsat_alloc_dep.
-Qed.
-
-Lemma wsat_alloc : forall P, wsat * |> P |-- |==> wsat * EX i : _, invariant i P.
-Proof.
-  intros; unseal_derives; apply wsat_alloc.
-Qed.
+Section mpred.
 
-Lemma wsat_alloc_strong : forall P Pi (Hfresh : forall n, exists i, (n <= i)%nat /\ Pi i),
-  (wsat * |> P) |-- |==> wsat * EX i : _, !!(Pi i) && invariant i P.
-Proof.
-  intros; unseal_derives; apply wsat_alloc_strong; auto.
-Qed.
+Context `{!VSTGS OK_ty Σ}.
 
-Lemma inv_alloc_dep : forall E P, ALL i, |> P i |-- |={E}=> EX i : _, invariant i (P i).
+Lemma big_sep_map : forall {B : bi} {A} (P Q : A -> B) (l : list A),
+  [∗] map (fun a => P a ∗ Q a) l ⊣⊢ [∗] map P l ∗ [∗] map Q l.
 Proof.
-  intros.
-  apply wsat_fupd, wsat_alloc_dep.
+  induction l; simpl.
+  - symmetry; apply bi.sep_emp.
+  - rewrite IHl; iSplit; iIntros "H"; iStopProof; cancel.
 Qed.
 
-Lemma inv_alloc : forall E P, |> P |-- |={E}=> EX i : _, invariant i P.
-Proof.
-  intros.
-  apply wsat_fupd, wsat_alloc.
-Qed.
-
-Lemma inv_alloc_strong : forall E P Pi (Hfresh : forall n, exists i, (n <= i)%nat /\ Pi i),
-  |> P |-- |={E}=> EX i : _, !!(Pi i) && invariant i P.
-Proof.
-  intros.
-  apply wsat_fupd, wsat_alloc_strong; auto.
-Qed.
-
-Lemma inv_open : forall E i P, Ensembles.In E i ->
-  invariant i P |-- |={E, Ensembles.Subtract E i}=> |> P * (|>P -* |={Ensembles.Subtract E i, E}=> emp).
-Proof.
-  intros; unseal_derives; apply inv_open; auto.
-Qed.
-
-Lemma inv_dealloc : forall i P, invariant i P |-- emp.
-Proof.
-  intros; unseal_derives; apply invariant_dealloc.
-Qed.
-
-Lemma fupd_timeless : forall E (P : mpred), timeless' P -> |> P |-- |={E}=> P.
-Proof.
-  intros; unseal_derives; apply fupd_timeless; auto.
-Qed.
-
-Ltac join_sub := repeat (eapply sepalg.join_sub_trans;
-  [eexists; first [eassumption | simple eapply sepalg.join_comm; eassumption]|]); eassumption.
-
-Ltac join_inj := repeat match goal with H1 : sepalg.join ?a ?b ?c, H2 : sepalg.join ?a ?b ?d |- _ =>
-    pose proof (sepalg.join_eq H1 H2); clear H1 H2; subst; auto end.
-
-Ltac fast_cancel := rewrite ?sepcon_emp, ?emp_sepcon; rewrite ?sepcon_assoc;
-  repeat match goal with
-    | |- ?P |-- ?P => apply derives_refl
-    | |- ?P * _ |-- ?P * _ => apply sepcon_derives; [apply derives_refl|]
-    | |- _ |-- ?P * _ => rewrite <- !sepcon_assoc, (sepcon_comm _ P), !sepcon_assoc end;
-  try cancel_frame.
-
 (*Ltac forward_malloc t n := forward_call (sizeof t); [simpl; try computable |
   Intros n; rewrite malloc_compat by (auto; reflexivity); Intros;
   rewrite memory_block_data_at_ by auto].
 *)
 
-Lemma semax_fun_id'' id f gv Espec {cs} Delta P Q R Post c :
+(*Lemma semax_fun_id'' id f gv Espec {cs} Delta P Q R Post c :
   (var_types Delta) ! id = None ->
   (glob_specs Delta) ! id = Some f ->
   (glob_types Delta) ! id = Some (type_of_funspec f) ->
@@ -146,164 +69,72 @@ eapply (semax_fun_id'' _f); try reflexivity.
 (* legacy *)
 Ltac start_dep_function := start_function.
 
-(* automation for dependent funspecs moved to call_lemmas and forward.v*)
+(* automation for dependent funspecs moved to call_lemmas and forward.v*)*)
 
-Lemma PROP_into_SEP : forall P Q R, PROPx P (LOCALx Q (SEPx R)) =
-  PROPx [] (LOCALx Q (SEPx (!!fold_right and True P && emp :: R))).
+Lemma PROP_into_SEP : forall P Q (R : list mpred), PROPx P (LOCALx Q (SEPx R)) ⊣⊢
+  PROPx [] (LOCALx Q (SEPx ((⌜fold_right and True P⌝ ∧ emp) :: R))).
 Proof.
-  intros; unfold PROPx, LOCALx, SEPx; extensionality; simpl.
-  rewrite <- andp_assoc, (andp_comm _ (fold_right_sepcon R)), <- andp_assoc.
-  rewrite prop_true_andp by auto.
-  rewrite andp_comm; f_equal.
-  rewrite andp_comm.
-  rewrite sepcon_andp_prop', emp_sepcon; auto.
+  intros; unfold PROPx, LOCALx, SEPx; split => rho; monPred.unseal.
+  iSplit.
+  - iIntros "($ & $ & $)".
+  - iIntros "(_ & $ & ($ & _) & $)".
 Qed.
 
-Lemma PROP_into_SEP_LAMBDA : forall P U Q R, PROPx P (LAMBDAx U Q (SEPx R)) =
-  PROPx [] (LAMBDAx U Q (SEPx (!!fold_right and True P && emp :: R))).
+Lemma PROP_into_SEP_LAMBDA : forall P U Q (R : list mpred), PROPx P (LAMBDAx U Q (SEPx R)) ⊣⊢
+  PROPx [] (LAMBDAx U Q (SEPx ((⌜fold_right and True P⌝ ∧ emp) :: R))).
 Proof.
   intros; unfold PROPx, LAMBDAx, GLOBALSx, LOCALx, SEPx, argsassert2assert;
-  extensionality; simpl.
-  apply pred_ext; entailer!; apply derives_refl.
-Qed.
-
-Ltac cancel_for_forward_spawn :=
-  eapply symbolic_cancel_setup;
-   [ construct_fold_right_sepcon
-   | construct_fold_right_sepcon
-   | fold_abnormal_mpred
-   | cbv beta iota delta [before_symbol_cancel]; cancel_for_forward_call].
-
-Ltac forward_spawn id arg wit :=
-  match goal with gv : globals |- _ =>
-  make_func_ptr id; let f := fresh "f_" in set (f := gv id);
-  match goal with |- context[func_ptr' (NDmk_funspec _ _ (val * ?A) ?Pre _) f] =>
-    let Q := fresh "Q" in let R := fresh "R" in
-
-    evar (Q : A -> globals); evar (R : A -> val -> mpred);
-    replace Pre with (fun '(a, w) => PROPx [] (PARAMSx (a::nil)
-                                                       (GLOBALSx ((Q w) :: nil) (SEPx [R w a]))));
-    [ | let x := fresh "x" in extensionality x; destruct x as (?, x);
-        instantiate (1 := fun w a => _ w) in (value of R);
-        repeat (destruct x as (x, ?);
-        instantiate (1 := fun '(a, b) => _ a) in (value of Q);
-        instantiate (1 := fun '(a, b) => _ a) in (value of R));
-        etransitivity; [|symmetry; apply PROP_into_SEP_LAMBDA]; f_equal; f_equal; f_equal;
-        [ instantiate (1 := fun _ => _) in (value of Q); subst Q; f_equal; simpl; reflexivity
-        | unfold SEPx; extensionality; simpl; rewrite sepcon_emp;
-          unfold R; instantiate (1 := fun _ => _);
-          reflexivity]
-  ];
-  forward_call [A] funspec_sub_refl (f, arg, Q, wit, R); subst Q R;
-           [ .. | subst f]; try (subst f; simpl; cancel_for_forward_spawn)
-  end end.
-
-#[export] Hint Resolve unreadable_bot : core.
-
-(* The following lemma is used in atomics/verif_ptr_atomics.v which is
-   not in the Makefile any more. So I comment out the
-   lemma. Furthermore, it should be replaced by
-   valid_pointer_is_pointer_or_null. *)
-
-(* Lemma valid_pointer_isptr : forall v, valid_pointer v |-- !!(is_pointer_or_null v). *)
-(* Proof. *)
-(* Transparent mpred. *)
-(* Transparent predicates_hered.pred. *)
-(*   destruct v; simpl; try apply derives_refl. *)
-(*   apply prop_right; auto. *)
-(* Opaque mpred. Opaque predicates_hered.pred. *)
-(* Qed. *)
-
-(* #[export] Hint Resolve valid_pointer_isptr : saturate_local. *)
-
-Definition exclusive_mpred P := P * P |-- FF.
-
-Program Definition weak_exclusive_mpred (P: mpred): mpred :=
-  unfash (fash ((P * P) --> FF)).
-
-Lemma corable_weak_exclusive R : seplog.corable (weak_exclusive_mpred R).
-Proof.
-  apply assert_lemmas.corable_unfash, _.
+    split => rho; monPred.unseal.
+  iSplit.
+  - iIntros "($ & $ & $)".
+  - iIntros "(_ & $ & $ & ($ & _) & $)".
 Qed.
 
-Lemma exclusive_mpred_nonexpansive : nonexpansive weak_exclusive_mpred.
-Proof.
-  unfold weak_exclusive_mpred, nonexpansive; intros.
-  apply @subtypes.eqp_unfash, @subtypes.eqp_subp_subp, eqp_refl.
-  apply eqp_sepcon; apply predicates_hered.derives_refl.
-Qed.
 
-Lemma exclusive_mpred_super_non_expansive:
-  forall R n, compcert_rmaps.RML.R.approx n (weak_exclusive_mpred R) =
-    compcert_rmaps.RML.R.approx n (weak_exclusive_mpred (compcert_rmaps.RML.R.approx n R)).
-Proof.
-  apply nonexpansive_super_non_expansive, exclusive_mpred_nonexpansive.
-Qed.
+Definition exclusive_mpred (P : mpred) := P ∗ P ⊢ False.
 
-Lemma exclusive_weak_exclusive1: forall R P,
-  exclusive_mpred R ->
-  P |-- weak_exclusive_mpred R.
+Lemma exclusive_weak_exclusive : forall P, exclusive_mpred P -> ⊢ P ∗ P -∗ False.
 Proof.
-  intros; unfold weak_exclusive_mpred; unfold exclusive_mpred in H.
-  unseal_derives; apply derives_unfash_fash; auto.
+  unfold exclusive_mpred; intros ? ->; auto.
 Qed.
 
-Lemma exclusive_weak_exclusive: forall R,
-  exclusive_mpred R ->
-  emp |-- weak_exclusive_mpred R && emp.
-Proof.
-  intros; apply andp_right; auto; apply exclusive_weak_exclusive1; auto.
-Qed.
-
-Lemma weak_exclusive_conflict : forall P,
-  (weak_exclusive_mpred P && emp) * P * P |-- FF.
-Proof.
-  intros.
-  rewrite sepcon_assoc, <- andp_left_corable by (apply corable_weak_exclusive).
-  unseal_derives; intros ? [].
-  unfold weak_exclusive_mpred in H; specialize (H a ltac:(lia) _ _ (ageable.necR_refl _) (predicates_hered.ext_refl _)).
-  apply H; auto.
-Qed.
-
-Lemma exclusive_sepcon1 : forall P Q (HP : exclusive_mpred P), exclusive_mpred (P * Q).
+Lemma exclusive_sepcon1 : forall P Q (HP : exclusive_mpred P), exclusive_mpred (P ∗ Q).
 Proof.
   unfold exclusive_mpred; intros.
-  eapply derives_trans, sepcon_FF_derives' with (P := Q * Q), HP; cancel; apply derives_refl.
+  iIntros "((? & ?) & (? & ?))"; iDestruct (HP with "[$]") as "[]".
 Qed.
 
-Lemma exclusive_sepcon2 : forall P Q (HP : exclusive_mpred Q), exclusive_mpred (P * Q).
+Lemma exclusive_sepcon2 : forall P Q (HP : exclusive_mpred Q), exclusive_mpred (P ∗ Q).
 Proof.
-  intros; rewrite sepcon_comm; apply exclusive_sepcon1; auto.
+  intros; rewrite /exclusive_mpred comm; apply exclusive_sepcon1; auto.
 Qed.
 
-Lemma exclusive_andp1 : forall P Q (HP : exclusive_mpred P), exclusive_mpred (P && Q).
+Lemma exclusive_andp1 : forall P Q (HP : exclusive_mpred P), exclusive_mpred (P ∧ Q).
 Proof.
   unfold exclusive_mpred; intros.
-  eapply derives_trans, HP.
-  apply sepcon_derives; apply andp_left1; auto.
+  iIntros "((? & _) & (? & _))"; iDestruct (HP with "[$]") as "[]".
 Qed.
 
-Lemma exclusive_andp2 : forall P Q (HQ : exclusive_mpred Q), exclusive_mpred (P && Q).
+Lemma exclusive_andp2 : forall P Q (HQ : exclusive_mpred Q), exclusive_mpred (P ∧ Q).
 Proof.
-  intros; rewrite andp_comm; apply exclusive_andp1; auto.
+  intros; rewrite /exclusive_mpred comm; apply exclusive_andp1; auto.
 Qed.
 
-Lemma exclusive_FF : exclusive_mpred FF.
+Lemma exclusive_False : exclusive_mpred False.
 Proof.
   unfold exclusive_mpred.
-  rewrite FF_sepcon; auto.
+  iIntros "([] & _)".
 Qed.
 
-Lemma derives_exclusive : forall P Q (Hderives : P |-- Q) (HQ : exclusive_mpred Q),
+Lemma derives_exclusive : forall P Q (Hderives : P ⊢ Q) (HQ : exclusive_mpred Q),
   exclusive_mpred P.
 Proof.
   unfold exclusive_mpred; intros.
-  eapply derives_trans, HQ.
-  apply sepcon_derives; auto.
+  rewrite Hderives //.
 Qed.
 
-Lemma mapsto_exclusive : forall (sh : Share.t) (t : type) (v : val),
-  sepalg.nonunit sh -> exclusive_mpred (EX v2 : _, mapsto sh t v v2).
+Lemma mapsto_exclusive : forall {cs : compspecs} (sh : Share.t) (t : type) (v : val),
+  sh ≠ Share.bot -> exclusive_mpred (∃ v2 : _, mapsto sh t v v2).
 Proof.
   intros; unfold exclusive_mpred.
   Intros v1 v2; apply mapsto_conflict; auto.
@@ -318,7 +149,7 @@ Qed.
 
 Lemma ex_field_at_exclusive : forall (cs : compspecs) (sh : Share.t) (t : type) (fld : list gfield) (p : val),
   sepalg.nonidentity sh ->
-  0 < sizeof (nested_field_type t fld) -> exclusive_mpred (EX v : _, field_at sh t fld v p).
+  0 < sizeof (nested_field_type t fld) -> exclusive_mpred (∃ v : _, field_at sh t fld v p).
 Proof.
   intros; unfold exclusive_mpred.
   Intros v v'; apply field_at_conflict; auto.
@@ -328,11 +159,10 @@ Corollary field_at_exclusive : forall (cs : compspecs) (sh : Share.t) (t : type)
   sepalg.nonidentity sh -> 0 < sizeof (nested_field_type t fld) -> exclusive_mpred (field_at sh t fld v p).
 Proof.
   intros; eapply derives_exclusive, ex_field_at_exclusive; eauto.
-  Exists v; apply derives_refl.
 Qed.
 
 Lemma ex_data_at_exclusive : forall (cs : compspecs) (sh : Share.t) (t : type) (p : val),
-  sepalg.nonidentity sh -> 0 < sizeof t -> exclusive_mpred (EX v : _, data_at sh t v p).
+  sepalg.nonidentity sh -> 0 < sizeof t -> exclusive_mpred (∃ v : _, data_at sh t v p).
 Proof.
   intros; unfold exclusive_mpred.
   Intros v v'; apply data_at_conflict; auto.
@@ -342,14 +172,64 @@ Corollary data_at_exclusive : forall (cs : compspecs) (sh : Share.t) (t : type)
   sepalg.nonidentity sh -> 0 < sizeof t -> exclusive_mpred (data_at sh t v p).
 Proof.
   intros; eapply derives_exclusive, ex_data_at_exclusive; eauto.
-  Exists v; apply derives_refl.
 Qed.
 
 Corollary data_at__exclusive : forall (cs : compspecs) (sh : Share.t) (t : type) (p : val),
   sepalg.nonidentity sh -> 0 < sizeof t -> exclusive_mpred (data_at_ sh t p).
 Proof.
   intros; eapply derives_exclusive, data_at_exclusive; eauto.
-  apply data_at__data_at; eauto.
 Qed.
 
 
+Lemma func_ptr_pre : forall sig cc A P1 P2 Q p, (forall a, P1 a ≡ P2 a) ->
+  func_ptr (NDmk_funspec sig cc A P1 Q) p ⊢ func_ptr (NDmk_funspec sig cc A P2 Q) p.
+Proof.
+  intros; apply func_ptr_mono.
+  split; first done; intros; simpl.
+  rewrite -H -fupd_intro.
+  Exists x2 (emp : mpred); entailer!.
+Qed.
+
+End mpred.
+
+#[export] Hint Resolve unreadable_bot : core.
+#[export] Hint Resolve excl_auth_valid : init. (* doesn't currently seem to work *)
+
+Ltac ghost_alloc G :=
+  lazymatch goal with |-semax _ _ (PROPx _ (LOCALx _ (SEPx (?R1 :: _)))) _ _ =>
+    rewrite -{1}(bi.emp_sep R1); Intros; viewshift_SEP 0 (∃ g : _, G g);
+  [go_lowerx; iIntros "_"; iApply own_alloc; auto; simpl; auto with init share|] end.
+
+(*Ltac cancel_for_forward_spawn :=
+  eapply symbolic_cancel_setup;
+   [ construct_fold_right_sepcon
+   | construct_fold_right_sepcon
+   | fold_abnormal_mpred
+   | cbv beta iota delta [before_symbol_cancel]; cancel_for_forward_call].*)
+
+Ltac go_lower1 := rewrite ENTAIL_refl; apply remove_PROP_LOCAL_left';
+  split => rho; rewrite !monPred_at_embed.
+
+Ltac forward_spawn id arg wit :=
+  lazymatch goal with gv : globals |- _ =>
+  make_func_ptr id; let f := fresh "f_" in set (f := gv id);
+  lazymatch goal with |- context[func_ptr (NDmk_funspec ?sig ?cc (val * ?A) ?Pre ?Post) f] =>
+    let Q := fresh "Q" in let R := fresh "R" in
+    evar (Q : A -> globals); evar (R : A -> val -> mpred);
+    gather_SEP (func_ptr _ f); replace_SEP 0 (func_ptr (NDmk_funspec sig cc (val * A)
+      (fun '(a, w) => PROPx [] (PARAMSx (a::nil) (GLOBALSx ((Q w) :: nil) (SEPx [R w a])))) Post) f);
+    [ go_lower1; apply func_ptr_pre; let x := fresh "x" in intros (?, x);
+        instantiate (1 := fun w a => _ w) in (value of R);
+        repeat (destruct x as (x, ?);
+        instantiate (1 := fun '(a, b) => _ a) in (value of Q);
+        instantiate (1 := fun '(a, b) => _ a) in (value of R));
+        rewrite PROP_into_SEP_LAMBDA; do 3 f_equiv;
+        [ instantiate (1 := fun _ => _) in (value of Q); subst Q; f_equiv; simpl; reflexivity
+        | unfold SEPx; f_equiv; simpl; rewrite !bi.sep_emp;
+          unfold R; instantiate (1 := fun _ => _); simpl;
+          reflexivity]
+     |];
+  forward_call (f, arg, existT(P := fun T => (T -> globals) * T * (T -> val -> mpred))%type A (Q, wit, R)); subst Q R;
+           [ .. | subst f];
+    [try (subst f; rewrite <- ?bi.sep_assoc; apply bi.sep_mono; [apply derives_refl|]).. |]
+  end end.
diff --git a/concurrency/fupd.v b/concurrency/fupd.v
deleted file mode 100644
index 22c2edf666..0000000000
--- a/concurrency/fupd.v
+++ /dev/null
@@ -1,377 +0,0 @@
-From stdpp Require Export namespaces coPset.
-From VST.veric Require Import compcert_rmaps fupd.
-From VST.msl Require Import ghost ghost_seplog sepalg_generators.
-From VST.concurrency Require Import ghosts conclib invariants cancelable_invariants.
-Require Export VST.veric.bi.
-Import FashNotation.
-
-Lemma timeless'_timeless : forall (P : mpred), timeless' P -> Timeless P.
-Proof.
-  intros; unfold Timeless.
-  constructor.
-  apply timeless'_except_0; auto.
-Qed.
-
-#[export] Instance own_timeless : forall {P : Ghost} g (a : G), Timeless (own g a NoneP).
-Proof.
-  intros; apply timeless'_timeless, own_timeless.
-Qed.
-
-Lemma address_mapsto_timeless : forall m v sh p, Timeless (res_predicates.address_mapsto m v sh p : mpred).
-Proof.
-  intros; apply timeless'_timeless, address_mapsto_timeless.
-Qed.
-
-#[export] Instance timeless_FF : Timeless FF.
-Proof.
-  unfold Timeless; intros.
-  iIntros ">?"; auto.
-Qed.
-
-Lemma nonlock_permission_bytes_timeless : forall sh l z,
-  Timeless (res_predicates.nonlock_permission_bytes sh l z : mpred).
-Proof.
-  intros; apply timeless'_timeless, nonlock_permission_bytes_timeless.
-Qed.
-
-Lemma mapsto_timeless : forall sh t v p, Timeless (mapsto sh t p v).
-Proof.
-  intros; unfold mapsto.
-  destruct (access_mode t); try apply timeless_FF.
-  destruct (type_is_volatile); try apply timeless_FF.
-  destruct p; try apply timeless_FF.
-  if_tac.
-  - apply (@bi.or_timeless mpredI).
-    + apply (@bi.and_timeless mpredI); [apply (@bi.pure_timeless mpredI) | apply address_mapsto_timeless].
-    + apply (@bi.and_timeless mpredI); [apply (@bi.pure_timeless mpredI)|].
-      apply (@bi.exist_timeless mpredI); intro; apply address_mapsto_timeless.
-  - apply (@bi.and_timeless mpredI); [apply (@bi.pure_timeless mpredI) | apply nonlock_permission_bytes_timeless].
-Qed.
-
-#[export] Instance emp_timeless : (@Timeless mpredI) emp.
-Proof.
-  apply timeless'_timeless, emp_timeless.
-Qed.
-
-Lemma memory_block'_timeless : forall sh n b z,
-  Timeless (mapsto_memory_block.memory_block' sh n b z).
-Proof.
-  induction n; simpl; intros.
-  - apply emp_timeless.
-  - apply (@bi.sep_timeless), IHn.
-    apply mapsto_timeless.
-Qed.
-
-Lemma memory_block_timeless : forall sh n p,
-  Timeless (memory_block sh n p).
-Proof.
-  intros.
-  destruct p; try apply timeless_FF.
-  apply (@bi.and_timeless mpredI); [apply (@bi.pure_timeless mpredI) | apply memory_block'_timeless].
-Qed.
-
-Lemma struct_pred_timeless : forall {CS : compspecs} sh m f t off
-  (IH : Forall (fun it : _ =>
-        forall (v : reptype (t it)) (p : val),
-        Timeless (data_at_rec sh (t it) v p)) m) v p,
-  Timeless (struct_pred m (fun (it : _) v =>
-      withspacer sh (f it + sizeof (t it)) (off it)
-        (at_offset (data_at_rec sh (t it) v) (f it))) v p).
-Proof.
-  induction m; intros.
-  - apply emp_timeless.
-  - inv IH. destruct m.
-    + unfold withspacer, at_offset; simpl.
-      if_tac; auto.
-      apply (@bi.sep_timeless mpredI); auto.
-      unfold spacer.
-      if_tac.
-      * apply emp_timeless.
-      * unfold at_offset; apply memory_block_timeless.
-    + rewrite struct_pred_cons2.
-      apply (@bi.sep_timeless mpredI); auto.
-      unfold withspacer, at_offset; simpl.
-      if_tac; auto.
-      apply (@bi.sep_timeless mpredI); auto.
-      unfold spacer.
-      if_tac.
-      * apply emp_timeless.
-      * unfold at_offset; apply memory_block_timeless.
-Qed.
-
-Lemma union_pred_timeless : forall {CS : compspecs} sh m t off
-  (IH : Forall (fun it : _ =>
-        forall (v : reptype (t it)) (p : val),
-        Timeless (data_at_rec sh (t it) v p)) m) v p,
-  Timeless (union_pred m (fun (it : _) v =>
-      withspacer sh (sizeof (t it)) (off it)
-        (data_at_rec sh (t it) v)) v p).
-Proof.
-  induction m; intros.
-  - apply emp_timeless.
-  - inv IH. destruct m.
-    + unfold withspacer, at_offset; simpl.
-      if_tac; auto.
-      apply (@bi.sep_timeless mpredI); auto.
-      unfold spacer.
-      if_tac.
-      * apply emp_timeless.
-      * unfold at_offset; apply memory_block_timeless.
-    + rewrite union_pred_cons2.
-      destruct v; auto.
-      unfold withspacer, at_offset; simpl.
-      if_tac; auto.
-      apply (@bi.sep_timeless mpredI); auto.
-      unfold spacer.
-      if_tac.
-      * apply emp_timeless.
-      * unfold at_offset; apply memory_block_timeless.
-Qed.
-
-Lemma data_at_rec_timeless : forall {CS : compspecs} sh t v p,
-  Timeless (data_at_rec sh t v p).
-Proof.
-  intros ???.
-  type_induction.type_induction t; intros; rewrite data_at_rec_eq; try apply timeless_FF.
-  - simple_if_tac; [apply memory_block_timeless | apply mapsto_timeless].
-  - simple_if_tac; [apply memory_block_timeless | apply mapsto_timeless].
-  - simple_if_tac; [apply memory_block_timeless | apply mapsto_timeless].
-  - simple_if_tac; [apply memory_block_timeless | apply mapsto_timeless].
-  - apply (@bi.and_timeless mpredI); [apply (@bi.pure_timeless mpredI)|].
-    rewrite Z.sub_0_r.
-    forget (Z.to_nat (Z.max 0 z)) as n.
-    set (lo := 0) at 1.
-    clearbody lo.
-    revert lo; induction n; simpl; intros.
-    + apply emp_timeless.
-    + apply (@bi.sep_timeless mpredI), IHn.
-      unfold at_offset; apply IH.
-  - apply struct_pred_timeless; auto.
-  - apply union_pred_timeless; auto.
-Qed.
-
-#[export] Instance field_at_timeless : forall {CS : compspecs} sh t gfs v p, Timeless (field_at sh t gfs v p).
-Proof.
-  intros; apply (@bi.and_timeless mpredI); [apply (@bi.pure_timeless mpredI) | apply data_at_rec_timeless].
-Qed.
-
-Definition funspec_sub' (f1 f2 : funspec): Prop :=
-match f1 with
-| mk_funspec tpsig1 cc1 A1 P1 Q1 _ _ =>
-    match f2 with
-    | mk_funspec tpsig2 cc2 A2 P2 Q2 _ _ =>
-        (tpsig1=tpsig2 /\ cc1=cc2) /\
-        forall ts2 x2 (gargs:argsEnviron),
-        ((!! (argsHaveTyps(snd gargs)(fst tpsig1)) && P2 ts2 x2 gargs)
-         |-- |={⊤}=> (EX ts1:_,  EX x1:_, EX F:_, 
-                           (F * (P1 ts1 x1 gargs)) &&
-                               (!! (forall rho',
-                                           ((!!(ve_of rho' = Map.empty (Values.block * type))) &&
-                                                 (F * (Q1 ts1 x1 rho')))
-                                         |-- (Q2 ts2 x2 rho')))))
-    end
-end.
-
-Lemma coPset_to_Ensemble_top : coPset_to_Ensemble ⊤ = Ensembles.Full_set.
-Proof.
-  unfold coPset_to_Ensemble; apply Ensembles.Extensionality_Ensembles; split; intros ? Hin; unfold Ensembles.In in *.
-  - constructor.
-  - set_solver.
-Qed.
-
-Lemma prove_funspec_sub : forall f1 f2, funspec_sub' f1 f2 -> funspec_sub f1 f2.
-Proof.
-  unfold funspec_sub', funspec_sub; intros.
-  destruct f1, f2.
-  destruct H as [? H]; split; auto; intros.
-  eapply derives_trans; [apply H|].
-  unfold fupd, bi_fupd_fupd; simpl.
-  rewrite coPset_to_Ensemble_top.
-  apply derives_refl.
-Qed.
-
-Lemma fupd_eq : ghost_seplog.fupd Ensembles.Full_set Ensembles.Full_set = fupd ⊤ ⊤.
-Proof.
-  unfold fupd, bi_fupd_fupd; simpl. rewrite coPset_to_Ensemble_top; auto.
-Qed.
-
-Section FancyUpdates.
-
-Local Open Scope logic_upd.
-
-Lemma fview_shift_nonexpansive : forall E1 E2 P Q n,
-  approx n (P -* |={E1,E2}=> Q) = approx n (approx n P -* |={E1,E2}=> approx n Q).
-Proof.
-  intros.
-  rewrite wand_nonexpansive; setoid_rewrite wand_nonexpansive at 3.
-  rewrite approx_idem; f_equal; f_equal.
-  apply fupd_nonexpansive.
-Qed.
-
-End FancyUpdates.
-
-Section Invariants.
-
-Lemma fupd_timeless' : forall E1 E2 P Q, Timeless P -> (P |-- |={E1,E2}=> Q) ->
-  |> P |-- |={E1,E2}=> Q.
-Proof.
-  intros.
-  iIntros ">P"; iApply H0; auto.
-Qed.
-
-Lemma bupd_except_0 : forall P, (|==> bi_except_0 P) |-- bi_except_0 (|==> P).
-Proof.
-  intros; constructor; change (predicates_hered.derives (own.bupd (bi_except_0 P)) (bi_except_0 (own.bupd P : mpred))).
-  intros ??; simpl in H.
-  destruct (level a) eqn: Hl.
-  + left.
-    change ((|> FF)%pred a).
-    intros ? Hl'%laterR_level.
-    rewrite Hl in Hl'; apply Nat.nlt_0_r in Hl'; contradiction Hl'.
-  + right.
-    rewrite <- Hl in *.
-    intros ? J; specialize (H _ J) as (? & ? & a' & ? & ? & ? & HP); subst.
-    do 2 eexists; eauto; do 2 eexists; eauto; repeat split; auto.
-    destruct HP as [Hfalse|]; auto.
-    destruct (levelS_age a' n) as (a'' & Hage & ?); [lia|].
-    exfalso; apply (Hfalse a'').
-    constructor; auto.
-Qed.
-
-(*Lemma fupd_prop' : forall E1 E2 E2' P Q, subseteq E1 E2 ->
-  ((Q |-- (|={E1,E2'}=> !!P)) ->
-  (|={E1, E2}=> Q) |-- |={E1}=> !!P && (|={E1, E2}=> Q))%I.
-Proof.
-  unfold updates.fupd, bi_fupd_fupd; simpl.
-  unfold fupd; intros ?????? HQ.
-  iIntros "H Hpre".
-  iMod ("H" with "Hpre") as ">(Hpre & Q)".
-  erewrite ghost_set_subset with (s' := coPset_to_Ensemble E1).
-  iDestruct "Hpre" as "(wsat & en1 & en2)".
-  iCombine ("wsat en1 Q") as "Q".
-  erewrite (add_andp (_ ∗ _ ∗ Q)%I (bi_except_0 (!! P))) at 1.
-  rewrite sepcon_andp_prop bi.except_0_and.
-  iModIntro; iSplit.
-  { iDestruct "Q" as "[? ?]"; auto. }
-  iDestruct "Q" as "[($ & $ & $) _]"; iFrame; auto.
-  { iIntros "(? & ? & Q)".
-    setoid_rewrite <- (own.bupd_prop P).
-    iApply bupd_except_0.
-    iMod (HQ with "Q [$]") as ">(? & ?)"; auto. }
-  { intro a; destruct (coPset_elem_of_dec (Pos.of_nat (S a)) E1); auto. }
-  { unfold coPset_to_Ensemble; intros ??; unfold In in *; auto. }
-Qed.
-
-Lemma fupd_prop : forall E1 E2 P Q, subseteq E1 E2 ->
-  (Q |-- !!P) ->
-  ((|={E1, E2}=> Q) |-- |={E1}=> !!P && (|={E1, E2}=> Q))%I.
-Proof.
-  intros; eapply fupd_prop'; auto.
-  eapply derives_trans; eauto.
-  apply fupd_intro.
-Qed.*)
-
-Global Opaque updates.fupd.
-
-Definition cinv (N : namespace) g (P : mpred) : mpred := inv N (P || cinv_own g Tsh).
-
-Lemma cinv_alloc_dep : forall N E P, (ALL g, |> P g) |-- |={E}=> EX g : _, cinv N g (P g) * cinv_own g Tsh.
-Proof.
-  intros; iIntros "HP".
-  iMod (own_alloc(RA := share_ghost) with "[$]") as (g) "?"; first done.
-  iExists g.
-  iMod (inv_alloc with "[HP]"); last by iFrame.
-  iNext; iLeft; auto.
-Qed.
-
-Lemma cinv_alloc : forall N E P, |> P |-- |={E}=> EX g : _, cinv N g P * cinv_own g Tsh.
-Proof.
-  intros; iIntros "HP".
-  iApply cinv_alloc_dep.
-  iIntros (_); auto.
-Qed.
-
-Lemma make_cinv : forall N E P Q, (P |-- Q) -> P |-- |={E}=> EX g : _, cinv N g Q * cinv_own g Tsh.
-Proof.
-  intros.
-  eapply derives_trans, cinv_alloc; auto.
-  eapply derives_trans, now_later; auto.
-Qed.
-
-Lemma cinv_cancel : forall N E g P,
-  ↑N ⊆ E -> cinv N g P * cinv_own g Tsh |-- |={E}=> (|> P).
-Proof.
-  intros; iIntros "[#I g]".
-  iInv "I" as "H" "Hclose".
-  iDestruct "H" as "[$ | >g']".
-  - iApply "Hclose"; iRight; auto.
-  - iDestruct (cinv_own_excl with "[$g $g']") as "[]"; auto with share.
-Qed.
-
-(* These seem reasonable, but for some reason cause iInv to hang if exported. *)
-#[local] Instance into_inv_cinv N g P : IntoInv (cinv N g P) N := {}.
-
-#[local] Instance into_acc_cinv E N g P p :
-  IntoAcc (X:=unit) (cinv N g P)
-          (↑N ⊆ E /\ p <> Share.bot) (cinv_own g p) (fupd E (E ∖ ↑N)) (fupd (E ∖ ↑N) E)
-          (λ _, ▷ P ∗ cinv_own g p)%I (λ _, ▷ P)%I (λ _, None)%I.
-Proof.
-  rewrite /IntoAcc /accessor; intros [].
-  iIntros "#I g".
-  iInv "I" as "H" "Hclose".
-  iDestruct "H" as "[$ | >g']".
-  - iFrame "g"; iExists tt; iIntros "!> HP".
-    iApply "Hclose"; iLeft; auto.
-  - iDestruct (cinv_own_excl with "[$g' $g]") as "[]"; auto.
-Qed.
-
-Lemma cinv_nonexpansive : forall N g, nonexpansive (cinv N g).
-Proof.
-  intros; apply inv_nonexpansive2.
-  apply @disj_nonexpansive, const_nonexpansive.
-  apply identity_nonexpansive.
-Qed.
-
-Lemma cinv_nonexpansive2 : forall N g f, nonexpansive f ->
-  nonexpansive (fun a => cinv N g (f a)).
-Proof.
-  intros; apply inv_nonexpansive2.
-  apply @disj_nonexpansive, const_nonexpansive; auto.
-Qed.
-
-End Invariants.
-
-(* avoids some fragility in tactics *)
-Definition except0 : mpred -> mpred := bi_except_0.
-
-Lemma replace_SEP'_fupd:
- forall n R' Espec {cs: compspecs} Delta P Q Rs c Post,
- ENTAIL Delta, PROPx P (LOCALx Q (SEPx (canon.my_nth n Rs TT ::  nil))) |-- liftx (|={⊤}=> R') ->
- @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx (canon.replace_nth n Rs R')))) c Post ->
- @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx Rs))) c Post.
-Proof.
-intros; eapply replace_SEP'_fupd; eauto.
-rewrite fupd_eq; auto.
-Qed.
-
-Tactic Notation "viewshift_SEP" constr(n) constr(R) :=
-  first [apply (replace_SEP'_fupd (Z.to_nat n) R) | apply (replace_SEP''_fupd (Z.to_nat n) R)];
-  unfold canon.my_nth,canon.replace_nth; simpl Z.to_nat;
-   repeat simpl_nat_of_P; cbv beta iota; cbv beta iota.
-
-Tactic Notation "viewshift_SEP" constr(n) constr(R) "by" tactic1(t):=
-  first [apply (replace_SEP'_fupd (Z.to_nat n) R) | apply (replace_SEP''_fupd (Z.to_nat n) R)];
-  unfold canon.my_nth,canon.replace_nth; simpl Z.to_nat;
-   repeat simpl_nat_of_P; cbv beta iota; cbv beta iota; [ now t | ].
-
-Ltac ghost_alloc G ::=
-  match goal with |-semax _ (PROPx _ (LOCALx _ (SEPx (?R1 :: _)))) _ _ =>
-    rewrite <- (emp_sepcon R1) at 1; Intros; viewshift_SEP 0 (EX g : _, G g);
-  [go_lowerx; eapply derives_trans, bupd_fupd; rewrite ?emp_sepcon;
-   apply own_alloc; auto; simpl; auto with init share ghost|] end.
-
-Ltac ghosts_alloc G n ::=
-  match goal with |-semax _ (PROPx _ (LOCALx _ (SEPx (?R1 :: _)))) _ _ =>
-    rewrite <- (emp_sepcon R1) at 1; Intros; viewshift_SEP 0 (EX lg : _, !!(Zlength lg = n) && iter_sepcon G lg);
-  [go_lowerx; eapply derives_trans, bupd_fupd; rewrite ?emp_sepcon;
-   apply own_list_alloc'; auto; simpl; auto with init share ghost|] end.
diff --git a/concurrency/ghosts.v b/concurrency/ghosts.v
deleted file mode 100644
index 5152e2e17f..0000000000
--- a/concurrency/ghosts.v
+++ /dev/null
@@ -1,1735 +0,0 @@
-Require Export VST.msl.ghost.
-Require Export VST.veric.ghosts.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.concurrency.conclib.
-Import List.
-
-(* Lemmas about ghost state and common instances, part 2 *)
-
-#[export] Hint Resolve Share.nontrivial : core.
-
-Opaque eq_dec.
-
-Definition gname := own.gname.
-
-#[export] Instance Inhabitant_preds : Inhabitant preds := NoneP.
-
-Section ghost.
-
-Context {RA: Ghost}.
-
-Lemma own_op' : forall g a1 a2 pp,
-  own g a1 pp * own g a2 pp = EX a3 : _, !!(join a1 a2 a3 /\ valid a3) && own g a3 pp.
-Proof.
-  exact own_op'.
-Qed.
-
-Lemma own_op_gen : forall g a1 a2 a3 pp, (valid_2 a1 a2 -> join a1 a2 a3) ->
-  own g a1 pp * own g a2 pp = !!(valid_2 a1 a2) && own g a3 pp.
-Proof.
-  exact own_op_gen.
-Qed.
-
-Lemma own_alloc : forall (a : G) (pp : preds), valid a -> emp |-- |==> EX g : own.gname, own g a pp.
-Proof.
-  exact own_alloc.
-Qed.
-
-Lemma own_dealloc : forall g (a : G) (pp : preds), own g a pp |-- emp.
-Proof.
-  exact own_dealloc.
-Qed.
-
-Lemma own_update : forall g a b pp, fp_update a b -> own g a pp |-- |==> own g b pp.
-Proof.
-  exact own_update.
-Qed.
-
-Lemma own_update_ND : forall g a B pp, fp_update_ND a B -> own g a pp |-- |==> EX b : G, !! B b && own g b pp.
-Proof.
-  exact own_update_ND.
-Qed.
-
-Lemma own_list_alloc : forall la lp, Forall valid la -> length lp = length la ->
-  emp |-- |==> (EX lg : _, !!(Zlength lg = Zlength la) &&
-    iter_sepcon (fun '(g, a, p) => own g a p) (combine (combine lg la) lp)).
-Proof.
-  intros until 1; revert lp; induction H; intros.
-  - eapply derives_trans, bupd_intro.
-    Exists (@nil own.gname). simpl. entailer!.
-  - destruct lp; inv H1.
-    rewrite <- emp_sepcon at 1.
-    eapply derives_trans; [apply sepcon_derives; [apply IHForall; eauto | apply own_alloc; eauto]|].
-    eapply derives_trans; [apply bupd_sepcon|].
-    apply bupd_mono.
-    Intros lg g.
-    Exists (g :: lg); rewrite !Zlength_cons; simpl.
-    rewrite sepcon_comm; entailer!.
-    apply derives_refl.
-Qed.
-
-Corollary own_list_alloc' : forall a pp i, 0 <= i -> valid a ->
-  emp |-- |==> (EX lg : _, !!(Zlength lg = i) && iter_sepcon (fun g => own g a pp) lg).
-Proof.
-  intros.
-  eapply derives_trans;
-    [apply own_list_alloc with (la := repeat a (Z.to_nat i))(lp := repeat pp (Z.to_nat i))|].
-  { apply Forall_repeat; auto. }
-  { rewrite !repeat_length; auto. }
-  apply bupd_mono; Intros lg; Exists lg.
-  rewrite coqlib4.Zlength_repeat, Z2Nat.id in H1 by lia.
-  rewrite !combine_const1 by (rewrite ?Zlength_combine, ?coqlib4.Zlength_repeat, ?Z2Nat.id, ?Z.min_r; lia).
-  entailer!.
-  clear H; induction lg; simpl; entailer!.
-Qed.
-
-Lemma own_list_dealloc : forall {A} f (l : list A),
-  (forall b, exists g a pp, f b |-- own g a pp) ->
-  iter_sepcon f l |-- emp.
-Proof.
-  intros; induction l; simpl; auto.
-  eapply derives_trans; [apply sepcon_derives, IHl | rewrite emp_sepcon; auto].
-  destruct (H a) as (? & ? & ? & Hf).
-  eapply derives_trans; [apply Hf | apply own_dealloc].
-Qed.
-
-Lemma own_list_dealloc' : forall {A} g a p (l : list A),
-  iter_sepcon (fun x => own (g x) (a x) (p x)) l |-- emp.
-Proof.
-  intros; apply own_list_dealloc.
-  do 3 eexists; apply derives_refl.
-Qed.
-
-End ghost.
-
-Definition excl {A} g a := own(RA := exclusive_PCM A) g (Some a) NoneP.
-
-Lemma exclusive_update : forall {A} (v v' : A) p, excl p v |-- |==> excl p v'.
-Proof.
-  intros; apply own_update.
-  intros ? (? & ? & _).
-  exists (Some v'); split; simpl; auto; inv H; constructor.
-  inv H1.
-Qed.
-
-(* lift from veric.invariants *)
-#[export] Instance set_PCM : Ghost := invariants.set_PCM.
-
-Definition ghost_set g s := own(RA := set_PCM) g s NoneP.
-
-Lemma ghost_set_join : forall g s1 s2,
-  ghost_set g s1 * ghost_set g s2 = !!(Ensembles.Disjoint s1 s2) && ghost_set g (Ensembles.Union s1 s2).
-Proof.
-  apply invariants.ghost_set_join.
-Qed.
-
-Lemma ghost_set_subset : forall g s s' (Hdec : forall a, Ensembles.In s' a \/ ~Ensembles.In s' a),
-  Ensembles.Included s' s -> ghost_set g s = ghost_set g s' * ghost_set g (Ensembles.Setminus s s').
-Proof.
-  apply invariants.ghost_set_subset.
-Qed.
-
-Corollary ghost_set_remove : forall g a s,
-  Ensembles.In s a -> ghost_set g s = ghost_set g (Ensembles.Singleton a) * ghost_set g (Ensembles.Subtract s a).
-Proof.
-  apply invariants.ghost_set_remove.
-Qed.
-
-Section Snapshot.
-
-Context `{ORD : PCM_order}.
-
-Definition ghost_snap (a : @G P) p := own(RA := snap_PCM) p (Share.bot, a) NoneP.
-
-Lemma ghost_snap_join : forall v1 v2 p v, join v1 v2 v ->
-  ghost_snap v1 p * ghost_snap v2 p = ghost_snap v p.
-Proof.
-  intros; symmetry; apply own_op.
-  split; simpl; rewrite ?eq_dec_refl; auto.
-Qed.
-
-Lemma ghost_snap_conflict : forall v1 v2 p, ghost_snap v1 p * ghost_snap v2 p |-- !!(joins v1 v2).
-Proof.
-  intros; eapply derives_trans; [apply own_valid_2|].
-  apply prop_left; intros ((?, a) & (? & Hj) & _); simpl in Hj.
-  rewrite !eq_dec_refl in Hj.
-  apply prop_right; exists a; auto.
-Qed.
-
-Lemma ghost_snap_join' : forall v1 v2 p,
-  ghost_snap v1 p * ghost_snap v2 p = EX v : _, !!(join v1 v2 v) && ghost_snap v p.
-Proof.
-  intros; apply pred_ext.
-  - assert_PROP (joins v1 v2) as H by apply ghost_snap_conflict.
-    destruct H as [v]; Exists v; entailer!.
-    erewrite ghost_snap_join; eauto.  apply derives_refl.
-  - Intros v; erewrite ghost_snap_join; eauto.  apply derives_refl.
-Qed.
-
-Definition ghost_master sh (a : @G P) p := own(RA := snap_PCM) p (sh, a) NoneP.
-
-Lemma snap_master_join : forall v1 sh v2 p, sh <> Share.bot ->
-  ghost_snap v1 p * ghost_master sh v2 p = !!(ord v1 v2) && ghost_master sh v2 p.
-Proof.
-  intros; setoid_rewrite own_op'.
-  apply pred_ext.
-  - Intros a3.
-    destruct a3 as (sh', ?), H0 as [Hsh Hj]; simpl in *.
-    apply bot_identity in Hsh; subst sh'.
-    rewrite eq_dec_refl in Hj.
-    destruct (eq_dec sh Share.bot); [contradiction|].
-    destruct Hj; subst; entailer!.
-  - Intros; Exists (sh, v2); entailer!.
-    split; simpl; rewrite ?eq_dec_refl.
-    + apply bot_join_eq.
-    + if_tac; auto; contradiction.
-    + apply derives_refl.
-Qed.
-
-Corollary snaps_master_join : forall lv sh v2 p, sh <> Share.bot ->
-  fold_right sepcon emp (map (fun v => ghost_snap v p) lv) * ghost_master sh v2 p =
-  !!(Forall (fun v1 => ord v1 v2) lv) && ghost_master sh v2 p.
-Proof.
-  induction lv; simpl; intros.
-  - rewrite emp_sepcon, prop_true_andp; auto.
-  - rewrite sepcon_comm, <-sepcon_assoc, (sepcon_comm (ghost_master _ _ _)), snap_master_join; auto.
-    apply pred_ext.
-    + Intros; rewrite sepcon_comm, IHlv; auto; entailer!.
-    + Intros.
-      match goal with H : Forall _ _ |- _ => inv H end.
-      rewrite prop_true_andp; auto.
-      rewrite sepcon_comm, IHlv; auto; entailer!.
-Qed.
-
-Lemma master_update : forall v v' p, ord v v' -> ghost_master Tsh v p |-- |==> ghost_master Tsh v' p.
-Proof.
-  intros; apply own_update.
-  intros ? (x & Hj & _); simpl in Hj.
-  exists (Tsh, v'); simpl; split; auto.
-  destruct Hj as [Hsh Hj]; simpl in *.
-  apply join_Tsh in Hsh as []; destruct c, x; simpl in *; subst.
-  split; auto; simpl.
-  fold share in *; destruct (eq_dec Tsh Share.bot); [contradiction Share.nontrivial|].
-  destruct Hj as [? Hc']; subst.
-  rewrite !eq_dec_refl in Hc' |- *; split; auto.
-  etransitivity; eauto.
-Qed.
-
-Lemma master_init : forall (a : @G P), exists g', joins (Tsh, a) g'.
-Proof.
-  intros; exists (Share.bot, a), (Tsh, a); simpl.
-  split; auto; simpl.
-  apply join_refl.
-Qed.
-
-#[local] Hint Resolve bupd_intro : ghost.
-
-Lemma make_snap : forall (sh : share) v p, ghost_master sh v p |-- |==> ghost_snap v p * ghost_master sh v p.
-Proof.
-  intros.
-  destruct (eq_dec sh Share.bot).
-  - subst; setoid_rewrite ghost_snap_join; [|apply join_refl]; auto with ghost.
-  - rewrite snap_master_join; auto; entailer!; auto with ghost.
-Qed.
-
-Lemma ghost_snap_forget : forall v1 v2 p, ord v1 v2 -> ghost_snap v2 p |-- |==> ghost_snap v1 p.
-Proof.
-  intros; apply own_update.
-  intros (shc, c) [(shx, x) [[? Hj] _]]; simpl in *.
-  rewrite eq_dec_refl in Hj.
-  assert (shx = shc) by (eapply sepalg.join_eq; eauto); subst.
-  unfold share in Hj; destruct (eq_dec shc Share.bot); subst.
-  - destruct (join_compat _ _ _ _ Hj H) as [x' []].
-    exists (Share.bot, x'); simpl; split; auto; split; auto; simpl.
-    rewrite !eq_dec_refl; auto.
-  - destruct Hj; subst.
-    exists (shc, c); simpl; split; auto; split; auto; simpl.
-    rewrite eq_dec_refl; if_tac; [contradiction|].
-    split; auto.
-    etransitivity; eauto.
-Qed.
-
-Lemma ghost_snap_choose : forall v1 v2 p, ghost_snap v1 p * ghost_snap v2 p |-- |==> ghost_snap v1 p.
-Proof.
-  intros.
-  setoid_rewrite own_op'.
-  Intros v'.
-  destruct v', H as [Hsh Hj]; apply bot_identity in Hsh; simpl in *; subst.
-  rewrite !eq_dec_refl in Hj.
-  apply ghost_snap_forget.
-  rewrite join_ord_eq; eauto.
-Qed.
-
-Lemma master_share_join : forall sh1 sh2 sh v p, sepalg.join sh1 sh2 sh ->
-  ghost_master sh1 v p * ghost_master sh2 v p = ghost_master sh v p.
-Proof.
-  intros; symmetry; apply own_op; split; auto; simpl.
-  if_tac; if_tac; try split; auto; try reflexivity; apply join_refl.
-Qed.
-
-Lemma master_inj : forall sh1 sh2 v1 v2 p, readable_share sh1 -> readable_share sh2 ->
-  ghost_master sh1 v1 p * ghost_master sh2 v2 p |-- !!(v1 = v2).
-Proof.
-  intros.
-  eapply derives_trans; [apply own_valid_2|].
-  apply prop_left; intros ((?, ?) & [[? Hj] _]); simpl in Hj.
-  fold share in *.
-  destruct (eq_dec sh1 Share.bot); [subst; contradiction unreadable_bot|].
-  destruct (eq_dec sh2 Share.bot); [subst; contradiction unreadable_bot|].
-  destruct Hj; subst; apply prop_right; auto.
-Qed.
-
-Lemma master_share_join' : forall sh1 sh2 sh v1 v2 p, readable_share sh1 -> readable_share sh2 ->
-  sepalg.join sh1 sh2 sh ->
-  ghost_master sh1 v1 p * ghost_master sh2 v2 p = !!(v1 = v2) && ghost_master sh v2 p.
-Proof.
-  intros; apply pred_ext.
-  - assert_PROP (v1 = v2) by (apply master_inj; auto).
-    subst; erewrite master_share_join; eauto; entailer!.
-  - Intros; subst.
-    erewrite master_share_join; eauto.  apply derives_refl.
-Qed.
-
-(* useful when we only want to deal with full masters *)
-Definition ghost_master1 a p := ghost_master Tsh a p.
-
-Lemma snap_master_join1 : forall v1 v2 p,
-  ghost_snap v1 p * ghost_master1 v2 p = !!(ord v1 v2) && ghost_master1 v2 p.
-Proof.
-  intros; apply snap_master_join, Share.nontrivial.
-Qed.
-
-Lemma snap_master_update1 : forall v1 v2 p v', ord v2 v' ->
-  ghost_snap v1 p * ghost_master1 v2 p |-- |==> ghost_snap v' p * ghost_master1 v' p.
-Proof.
-  intros; rewrite !snap_master_join1.
-  Intros; entailer!.
-  apply master_update; auto.
-Qed.
-
-End Snapshot.
-
-#[global] Hint Resolve bupd_intro : ghost.
-
-Section Reference.
-
-Context {P : Ghost}.
-
-Definition ghost_reference a g := own(RA := ref_PCM P) g (None, Some a) NoneP.
-Definition ghost_part sh a g := own(RA := ref_PCM P) g (Some (sh, a), None) NoneP.
-Definition ghost_part_ref sh a r g :=
-  own(RA := ref_PCM P) g (Some (sh, a), Some r) NoneP.
-
-Lemma ghost_part_join : forall sh1 sh2 sh a1 a2 a g, join sh1 sh2 sh -> join a1 a2 a ->
-  sh1 <> Share.bot -> sh2 <> Share.bot ->
-  ghost_part sh1 a1 g * ghost_part sh2 a2 g = ghost_part sh a g.
-Proof.
-  intros.
-  symmetry; apply own_op.
-  hnf; simpl.
-  split; auto; constructor.
-Qed.
-
-Lemma ghost_part_ref_join : forall g (sh : share) a b,
-  ghost_part sh a g * ghost_reference b g = ghost_part_ref sh a b g.
-Proof.
-  intros.
-  symmetry; apply own_op.
-  hnf; simpl.
-  split; auto; constructor.
-Qed.
-
-Lemma ref_sub_gen : forall g sh a b pp,
-  own(RA := ref_PCM P) g (Some (sh, a), None) pp * own(RA := ref_PCM P) g (None, Some b) pp |--
-    !!(if eq_dec sh Tsh then a = b else exists x, join a x b).
-Proof.
-  intros.
-  eapply derives_trans; [apply own_valid_2|].
-  apply prop_left; intros (c & [Hsh Hj] & ?); simpl in *.
-  apply prop_right.
-  destruct (fst c); [subst | contradiction].
-  inv Hj.
-  rewrite <- H0 in H.
-  destruct H as (? & c' & Hsub).
-  destruct c' as [(?, ?)|].
-  - destruct Hsub as (? & ? & Hsh & ?).
-    if_tac; eauto; subst.
-    apply join_Tsh in Hsh; tauto.
-  - inv Hsub.
-    rewrite eq_dec_refl; auto.
-Qed.
-
-Lemma ref_sub : forall g sh a b,
-  ghost_part sh a g * ghost_reference b g |--
-    !!(if eq_dec sh Tsh then a = b else exists x, join a x b).
-Proof.
-  intros; apply ref_sub_gen.
-Qed.
-
-Lemma self_completable : forall a, completable (Some (Tsh, a)) a.
-Proof.
-  intros; unfold completable.
-  exists None; constructor.
-Qed.
-
-Lemma part_ref_valid : forall a, valid(Ghost := ref_PCM P) (Some (Tsh, a), Some a).
-Proof.
-  intros; hnf; simpl.
-  split; auto with share.
-  apply self_completable.
-Qed.
-
-Lemma ref_update_gen : forall g a r a' pp,
-  own(RA := ref_PCM P) g (Some (Tsh, a), Some r) pp |-- |==>
-  own(RA := ref_PCM P) g (Some (Tsh, a'), Some a') pp.
-Proof.
-  intros; apply own_update.
-  intros (c, ?) ((x, ?) & [J1 J2] & [? Hvalid]); simpl in *.
-  inv J2; [|contradiction].
-  destruct c as [(?, c)|], x as [(shx, x)|]; try contradiction.
-  - destruct J1 as (? & ? & J & Hx).
-    apply join_Tsh in J as []; contradiction.
-  - inv J1.
-    exists (Some (Tsh, a'), Some a'); repeat split; simpl; auto; try constructor.
-    apply self_completable.
-Qed.
-
-Lemma ref_update : forall g a r a',
-  ghost_part_ref Tsh a r g |-- |==> ghost_part_ref Tsh a' a' g.
-Proof.
-  intros; apply ref_update_gen.
-Qed.
-
-Lemma part_ref_update : forall g sh a r a' r'
-  (Ha' : forall b, join a b r -> join a' b r' /\ (a = r -> a' = r')),
-  ghost_part_ref sh a r g |-- |==> ghost_part_ref sh a' r' g.
-Proof.
-  intros; apply own_update.
-  intros (c, ?) ((x, ?) & [J1 J2] & [? Hvalid]); simpl in *.
-  inv J2; [|contradiction].
-  destruct c as [(?, c)|], x as [(shx, x)|]; try contradiction.
-  - destruct J1 as (? & ? & ? & Hx).
-    assert (join_sub x r) as [f J].
-    { destruct Hvalid as [[(?, ?)|] Hvalid]; hnf in Hvalid.
-      + destruct Hvalid as (? & ? & ? & ?); eexists; eauto.
-      + inv Hvalid; apply join_sub_refl. }
-    destruct (join_assoc Hx J) as (b & Jc & Jb%Ha').
-    destruct Jb as [Jb Heq].
-    destruct (join_assoc (join_comm Jc) (join_comm Jb)) as (x' & Hx' & Hr').
-    exists (Some (shx, x'), Some r'); repeat (split; auto); try constructor; simpl.
-    + destruct Hvalid as (d & Hvalid); hnf in Hvalid.
-      destruct d as [(shd, d)|].
-      * exists (Some (shd, f)); destruct Hvalid as (? & ? & ? & Hd); repeat (split; auto).
-      * exists None; hnf.
-        inv Hvalid; f_equal.
-        eapply join_eq; [apply Ha'|]; eauto.
-  - inv J1.
-    exists (Some (sh, a'), Some r'); repeat split; simpl; auto; try constructor.
-    unfold completable in *.
-    destruct Hvalid as (d & Hvalid); hnf in Hvalid.
-    exists d; destruct d as [(shd, d)|]; hnf.
-    + destruct Hvalid as (? & ? & ? & Hd); repeat (split; auto).
-      eapply Ha'; auto.
-    + inv Hvalid. f_equal.
-      symmetry; eapply Ha'; auto.
-      apply join_comm, core_unit.
-Qed.
-
-Corollary ref_add : forall g sh a r b a' r'
-  (Ha : join a b a') (Hr : join r b r'),
-  ghost_part_ref sh a r g |-- |==> ghost_part_ref sh a' r' g.
-Proof.
-  intros; apply part_ref_update; intros c J.
-  destruct (join_assoc (join_comm J) Hr) as (? & ? & ?).
-  eapply join_eq in Ha; eauto; subst; auto.
-  split; auto; intros; subst.
-  eapply join_eq; eauto.
-Qed.
-
-End Reference.
-
-#[export] Hint Resolve part_ref_valid : init.
-
-#[export] Hint Resolve self_completable : init.
-
-Section GVar.
-
-Context {A : Type}.
-
-Notation ghost_var_PCM A := (@pos_PCM (discrete_PCM A)).
-
-Definition ghost_var (sh : share) (v : A) g :=
-  own(RA := @pos_PCM (discrete_PCM A)) g (Some (sh, v)) NoneP.
-
-Lemma ghost_var_share_join : forall sh1 sh2 sh v p, sepalg.join sh1 sh2 sh ->
-  sh1 <> Share.bot -> sh2 <> Share.bot ->
-  ghost_var sh1 v p * ghost_var sh2 v p = ghost_var sh v p.
-Proof.
-  intros; symmetry; apply own_op.
-  repeat (split; auto).
-Qed.
-
-Lemma ghost_var_share_join_gen : forall sh1 sh2 v1 v2 p,
-  ghost_var sh1 v1 p * ghost_var sh2 v2 p = EX sh : _,
-  !!(v1 = v2 /\ sh1 <> Share.bot /\ sh2 <> Share.bot /\ sepalg.join sh1 sh2 sh) && ghost_var sh v1 p.
-Proof.
-  intros; setoid_rewrite own_op'.
-  apply pred_ext.
-  - Intros a.
-    destruct a as [(sh, v')|]; inv H.
-    destruct H2 as (? & ? & Hv); inv Hv.
-    Exists sh; entailer!.
-  - Intros sh; subst.
-    Exists (Some (sh, v2)); apply andp_right, derives_refl.
-    apply prop_right; repeat (split; auto); simpl.
-    intro; subst; apply join_Bot in H2 as []; contradiction.
-Qed.
-
-Lemma ghost_var_inj : forall sh1 sh2 v1 v2 p, sh1 <> Share.bot -> sh2 <> Share.bot ->
-  ghost_var sh1 v1 p * ghost_var sh2 v2 p |-- !!(v1 = v2).
-Proof.
-  intros; rewrite ghost_var_share_join_gen; Intros sh; entailer!.
-Qed.
-
-Lemma ghost_var_share_join' : forall sh1 sh2 sh v1 v2 p, sh1 <> Share.bot -> sh2 <> Share.bot ->
-  sepalg.join sh1 sh2 sh ->
-  ghost_var sh1 v1 p * ghost_var sh2 v2 p = !!(v1 = v2) && ghost_var sh v2 p.
-Proof.
-  intros; rewrite ghost_var_share_join_gen.
-  apply pred_ext.
-  - Intros sh'; entailer!.
-    eapply join_eq in H1; eauto; subst; auto.
-  - Intros; Exists sh; entailer!.
-Qed.
-
-Lemma ghost_var_update : forall v p v', ghost_var Tsh v p |-- |==> ghost_var Tsh v' p.
-Proof.
-  intros; apply own_update.
-  intros [[]|] ([[]|] & J & ?); inv J.
-  - destruct H1 as (? & ?%join_Tsh & ?); tauto.
-  - exists (Some (Tsh, v')); split; [constructor | auto].
-Qed.
-
-Lemma ghost_var_update' : forall g (v1 v2 v : A), ghost_var gsh1 v1 g * ghost_var gsh2 v2 g |--
-  |==> !!(v1 = v2) && (ghost_var gsh1 v g * ghost_var gsh2 v g).
-Proof.
-  intros; erewrite ghost_var_share_join' by eauto.
-  Intros; subst; erewrite ghost_var_share_join by eauto.
-  rewrite -> prop_true_andp by auto; apply ghost_var_update.
-Qed.
-
-Lemma ghost_var_exclusive : forall sh v p, sh <> Share.bot -> exclusive_mpred (ghost_var sh v p).
-Proof.
-  intros; unfold exclusive_mpred.
-  rewrite ghost_var_share_join_gen.
-  Intros sh'.
-  apply join_self, identity_share_bot in H1; contradiction.
-Qed.
-
-End GVar.
-
-#[export] Hint Resolve ghost_var_exclusive : exclusive.
-
-Section PVar.
-(* Like ghost variables, but the partial values may be out of date. *)
-
-Global Program Instance nat_PCM: Ghost := { valid a := True; Join_G a b c := c = Nat.max a b }.
-Next Obligation.
-  exists (id _); auto; intros.
-  - hnf. symmetry; apply Nat.max_id.
-  - eexists; eauto.
-Defined.
-Next Obligation.
-  constructor.
-  - unfold join; congruence.
-  - unfold join; eexists; split; eauto.
-    rewrite Nat.max_assoc; subst; auto.
-  - unfold join; intros.
-    rewrite Nat.max_comm; auto.
-  - unfold join; intros.
-    apply Nat.le_antisymm; [subst b | subst a]; apply Nat.le_max_l.
-Qed.
-
-Global Instance max_order : PCM_order Peano.le.
-Proof.
-  constructor; auto; intros.
-  - constructor; auto. intros ???; lia.
-  - eexists; unfold join; simpl; split; eauto.
-    apply Nat.max_lub; auto.
-  - hnf in H; subst.
-    split; [apply Nat.le_max_l | apply Nat.le_max_r].
-  - hnf.
-    rewrite Nat.max_l; auto.
-Qed.
-
-Lemma ghost_snap_join_N : forall v1 v2 p, ghost_snap v1 p * ghost_snap v2 p = ghost_snap (Nat.max v1 v2) p.
-Proof.
-  intros; apply ghost_snap_join; hnf; auto.
-Qed.
-
-Lemma snap_master_join' : forall v1 v2 p,
-  ghost_snap v1 p * ghost_master1 v2 p = !!(v1 <= v2)%nat && ghost_master1 v2 p.
-Proof.
-  intros; apply snap_master_join1.
-Qed.
-
-Lemma snap_master_update' : forall (v1 v2 : nat) p v', (v2 <= v')%nat ->
-  ghost_snap v1 p * ghost_master1 v2 p |-- |==> ghost_snap v' p * ghost_master1 v' p.
-Proof.
-  intros; apply snap_master_update1; auto.
-Qed.
-
-End PVar.
-
-Section Option.
-
-Context {P : Ghost}.
-
-Global Program Instance option_PCM : Ghost := { G := option G; valid a := True }.
-
-Context `{ORD : PCM_order(P := P)}.
-
-Definition option_ord (a b : G) : Prop :=
-  match a, b with
-  | None, _ => True
-  | Some a, Some b => ord a b
-  | _, _ => False
-  end.
-
-#[export] Instance option_ord_refl : Reflexive option_ord.
-Proof.
-  intros ?.
-  destruct x; simpl; auto.
-  reflexivity.
-Qed.
-
-Global Instance option_order : PCM_order option_ord.
-Proof.
-  constructor.
-  - constructor; [apply option_ord_refl|].
-    intros ???. destruct x; simpl in *; auto.
-      destruct y; [simpl in * | contradiction].
-      destruct z; [|contradiction].
-      etransitivity; eauto.
-  - intros.
-    destruct a; [destruct b|]; simpl in *.
-    + destruct c; [|contradiction].
-      destruct (ord_lub _ _ _ H H0) as (c' & ? & ?); exists (Some c'); split; auto.
-      constructor; auto.
-    + exists (Some g); split; auto; constructor.
-    + exists b; split; auto; constructor.
-  - inversion 1; subst; try solve [split; simpl; auto; reflexivity].
-    apply join_ord in H0 as []; auto.
-  - destruct b; simpl.
-    + destruct a; [|contradiction].
-      intros; constructor; apply ord_join; auto.
-    + destruct a; constructor.
-Qed.
-
-End Option.
-
-Section Maps.
-
-Context {A} {A_eq : EqDec A} {B : Type}.
-
-Implicit Types (k : A) (v : B) (m : A -> option B).
-
-Definition map_add m1 m2 k := match m1 k with Some v' => Some v' | None => m2 k end.
-
-Definition map_upd m k v k' := if eq_dec k' k then Some v else m k'.
-
-Lemma map_upd_triv : forall m k v, m k = Some v -> map_upd m k v = m.
-Proof.
-  intros; extensionality; unfold map_upd.
-  if_tac; subst; auto.
-Qed.
-
-Lemma map_upd_comm : forall m k1 v1 k2 v2, k1 <> k2 ->
-  map_upd (map_upd m k1 v1) k2 v2 = map_upd (map_upd m k2 v2) k1 v1.
-Proof.
-  intros; unfold map_upd.
-  extensionality; if_tac; if_tac; auto; subst; contradiction.
-Qed.
-
-Fixpoint map_upd_list m l :=
-  match l with
-  | [] => m
-  | (k, v) :: rest => map_upd_list (map_upd m k v) rest
-  end.
-
-Definition empty_map k : option B := None.
-
-Global Instance Inhabitant_map : Inhabitant (A -> option B) := empty_map.
-
-Definition singleton k v k1 := if eq_dec k1 k then Some v else None.
-
-Lemma map_add_empty : forall m, map_add m empty_map = m.
-Proof.
-  intros; extensionality; unfold map_add, empty_map.
-  destruct (m x); auto.
-Qed.
-
-Lemma map_add_single : forall m k v, map_add (singleton k v) m = map_upd m k v.
-Proof.
-  intros; extensionality; unfold map_add, singleton, map_upd; if_tac; auto.
-Qed.
-
-Lemma map_add_assoc : forall m1 m2 m3, map_add (map_add m1 m2) m3 = map_add m1 (map_add m2 m3).
-Proof.
-  intros; extensionality; unfold map_add.
-  destruct (m1 x); auto.
-Qed.
-
-Lemma map_add_upd : forall m1 m2 k v, map_upd (map_add m1 m2) k v = map_add (map_upd m1 k v) m2.
-Proof.
-  intros.
-  rewrite <- !map_add_single.
-  rewrite map_add_assoc; auto.
-Qed.
-
-End Maps.
-
-Section Maps1.
-
-Context {A} {A_eq : EqDec A} {P : Ghost}.
-
-Implicit Types (k : A) (v : G) (m : A -> option G).
-
-Global Instance map_join : Join (A -> option G) := fun a b c => forall k, join (a k) (b k) (c k).
-
-Global Program Instance map_PCM : Ghost := { valid a := True; Join_G := map_join }.
-
-Context `{ORD : PCM_order(P := P)}.
-
-Definition map_incl m1 m2 := forall k, option_ord(ord := ord) (m1 k) (m2 k).
-
-Global Instance map_incl_refl : Reflexive map_incl.
-Proof.
-  repeat intro; reflexivity.
-Qed.
-
-Global Instance map_incl_trans : Transitive map_incl.
-Proof.
-  repeat intro; etransitivity; eauto.
-Qed.
-
-#[export] Instance fmap_order : PCM_order map_incl.
-Proof.
-  constructor.
-  - split; [apply map_incl_refl | apply map_incl_trans].
-  - intros ??? Ha Hb. exists (fun k => proj1_sig (ord_lub _ _ _ (Ha k) (Hb k))); split;
-      intros k; destruct (ord_lub(ord := option_ord) (a k) (b k) (c k) (Ha k) (Hb k)) as (? & ? & ?); auto.
-  - split; repeat intro; specialize (H k); apply (join_ord(ord := option_ord)) in H as []; auto.
-  - intros ??? k.
-    specialize (H k); apply (ord_join(ord := option_ord)); auto.
-Qed.
-
-Lemma map_upd_single : forall m k v, m k = None -> join m (singleton k v) (map_upd m k v).
-Proof.
-  intros; intros k'.
-  unfold singleton, map_upd; if_tac; subst; [|constructor].
-  rewrite H; constructor.
-Qed.
-
-Lemma map_upd_list_app : forall l1 l2 m, map_upd_list m (l1 ++ l2) = map_upd_list (map_upd_list m l1) l2.
-Proof.
-  induction l1; auto; simpl; intros.
-  destruct a; auto.
-Qed.
-
-Lemma map_upd_list_out : forall l m k, m k = None -> ~In k (map fst l) -> map_upd_list m l k = None.
-Proof.
-  induction l; auto; simpl; intros.
-  destruct a; apply IHl.
-  - unfold map_upd; if_tac; auto.
-    subst; simpl in *; tauto.
-  - tauto.
-Qed.
-
-Lemma map_upd_incl : forall m1 m2 k v, map_incl m1 m2 ->
-  m2 k = Some v -> map_incl (map_upd m1 k v) m2.
-Proof.
-  unfold map_upd; repeat intro.
-  destruct (eq_dec k0 k); [|auto].
-  subst; rewrite H0; reflexivity.
-Qed.
-
-Lemma empty_map_incl : forall m, map_incl empty_map m.
-Proof.
-  repeat intro; constructor.
-Qed.
-
-Lemma map_upd2_incl : forall m1 m2 k v, map_incl m1 m2 -> map_incl (map_upd m1 k v) (map_upd m2 k v).
-Proof.
-  unfold map_upd; repeat intro.
-  if_tac; auto; reflexivity.
-Qed.
-
-End Maps1.
-
-Section MapsL.
-
-Context {A B : Type} {A_eq : EqDec A}.
-
-Implicit Types (k : A) (v : B) (m : A -> option B).
-
-Global Instance discrete_order : PCM_order(P := discrete_PCM B) eq.
-Proof.
-  constructor.
-  - constructor.
-    + constructor.
-    + intros ???; inversion 1; inversion 1; constructor.
-  - intros.
-    assert (a = c) by (inv H; auto).
-    assert (b = c) by (inv H0; auto).
-    subst; do 2 eexists; constructor; auto.
-  - inversion 1; subst; split; constructor.
-  - inversion 1; constructor; auto.
-Qed.
-
-Local Notation map_incl := (@map_incl A (discrete_PCM B) eq).
-
-Global Instance map_incl_antisym : Antisymmetric _ eq map_incl.
-Proof.
-  intros x y Hx Hy.
-  extensionality a.
-  specialize (Hx a); specialize (Hy a).
-  destruct (x a), (y a); simpl in *; auto; try contradiction.
-Qed.
-
-Lemma map_add_incl_compat : forall m1 m2 m3, map_incl m1 m2 -> map_incl (map_add m3 m1) (map_add m3 m2).
-Proof.
-  unfold map_add; repeat intro.
-  destruct (m3 k); auto; simpl.
-  constructor.
-Qed.
-
-Definition compatible m1 m2 := forall k v1 v2, m1 k = Some v1 -> m2 k = Some v2 -> v1 = v2.
-
-Global Instance compatible_refl : Reflexive compatible.
-Proof.
-  repeat intro.
-  congruence.
-Qed.
-
-Global Instance compatible_comm : Symmetric compatible.
-Proof.
-  repeat intro.
-  symmetry; eauto.
-Qed.
-
-Lemma map_add_comm : forall m1 m2, compatible m1 m2 -> map_add m1 m2 = map_add m2 m1.
-Proof.
-  intros; extensionality x; unfold map_add.
-  destruct (m1 x) eqn: Hm1, (m2 x) eqn: Hm2; eauto.
-Qed.
-
-Lemma compatible_add_assoc : forall m1 m2 m3, compatible m1 m2 ->
-  compatible (map_add m1 m2) m3 -> compatible m1 (map_add m2 m3).
-Proof.
-  unfold compatible, map_add; intros.
-  repeat match goal with H : forall _, _ |- _ => specialize (H k) end.
-  replace (m1 k) with (Some v1) in *.
-  destruct (m2 k); auto.
-Qed.
-
-Lemma map_incl_spec : forall m1 m2 k v, map_incl m1 m2 -> m1 k = Some v -> m2 k = Some v.
-Proof.
-  intros; specialize (H k).
-  rewrite H0 in H; simpl in H.
-  destruct (m2 k); auto; inv H; auto.
-Qed.
-
-Lemma compatible_incl : forall m1 m2 m (Hcompat : compatible m2 m) (Hincl : map_incl m1 m2), compatible m1 m.
-Proof.
-  repeat intro.
-  eapply Hcompat; eauto.
-  eapply map_incl_spec; eauto.
-Qed.
-
-Lemma map_incl_add : forall m1 m2, map_incl m1 (map_add m1 m2).
-Proof.
-  repeat intro; unfold map_add.
-  destruct (m1 k); simpl; auto.
-Qed.
-
-Lemma map_incl_compatible : forall m1 m2 m3 (Hincl1 : map_incl m1 m3) (Hincl2 : map_incl m2 m3),
-  compatible m1 m2.
-Proof.
-  intros; intros ??? Hk1 Hk2.
-  apply (map_incl_spec _ _ _ _ Hincl1) in Hk1; apply (map_incl_spec _ _ _ _ Hincl2) in Hk2.
-  rewrite Hk1 in Hk2; inv Hk2; auto.
-Qed.
-
-Lemma map_add_incl : forall m1 m2 m3, map_incl m1 m3 -> map_incl m2 m3 -> map_incl (map_add m1 m2) m3.
-Proof.
-  unfold map_add; intros.
-  intros k.
-  destruct (m1 k) eqn: Hk1; auto; simpl.
-  eapply map_incl_spec in Hk1 as ->; eauto; constructor.
-Qed.
-
-Local Notation map_join := (map_join(P := discrete_PCM B)).
-
-Lemma map_join_spec : forall m1 m2 m3, map_join m1 m2 m3 <-> compatible m1 m2 /\ m3 = map_add m1 m2.
-Proof.
-  unfold join, map_join; simpl; split; intros.
-  - split.
-    + repeat intro.
-      specialize (H k); rewrite H0, H1 in H; inv H.
-      inv H5; auto.
-    + extensionality x; unfold map_add.
-      specialize (H x); inv H; auto.
-      { destruct (m1 x); auto. }
-      inv H3; auto.
-  - destruct H as [Hcompat]; subst; unfold map_add.
-    destruct (m1 k) eqn: Hm1; simpl; try constructor.
-    destruct (m2 k) eqn: Hm2; constructor.
-    eapply Hcompat in Hm2; eauto; subst; constructor; auto.
-Qed.
-
-Lemma map_snap_join : forall m1 m2 p,
-  ghost_snap(ORD := fmap_order(P := discrete_PCM B)) m1 p * ghost_snap(ORD := fmap_order(P := discrete_PCM B)) m2 p = !!(compatible m1 m2) && ghost_snap(ORD := fmap_order(P := discrete_PCM B)) (map_add m1 m2) p.
-Proof.
-  intros; rewrite ghost_snap_join'.
-  apply pred_ext.
-  - Intros m.
-    apply map_join_spec in H as []; subst; entailer!.
-  - Intros; Exists (map_add m1 m2).
-    setoid_rewrite map_join_spec; entailer!.
-Qed.
-
-Lemma compatible_k : forall m1 m2 (Hcompat : compatible m1 m2) k v, m2 k = Some v -> map_add m1 m2 k = Some v.
-Proof.
-  unfold compatible; intros.
-  unfold map_add.
-  destruct (m1 k) eqn: Hk; eauto.
-Qed.
-
-Lemma map_join_incl_compat : forall m1 m2 m' m'' (Hincl : map_incl m1 m2) (Hjoin : map_join m2 m' m''),
-  exists m, map_join m1 m' m /\ map_incl m m''.
-Proof.
-  intros; apply (@join_comm _ _ (@Perm_G map_PCM)) in Hjoin.
-  apply map_join_spec in Hjoin as [Hjoin]; subst.
-  do 2 eexists; [|apply map_add_incl_compat; eauto].
-  symmetry in Hjoin; eapply compatible_incl in Hjoin; eauto.
-  rewrite map_join_spec; split; auto.
-  rewrite <- map_add_comm; auto.
-Qed.
-
-Lemma incl_compatible : forall m1 m2, map_incl m1 m2 -> compatible m1 m2.
-Proof.
-  intros; intros ??? Hk1 Hk2.
-  eapply map_incl_spec in Hk1; eauto; congruence.
-Qed.
-
-Lemma map_add_redundant : forall m1 m2, map_incl m1 m2 -> map_add m1 m2 = m2.
-Proof.
-  intros; unfold map_add; extensionality k.
-  destruct (m1 k) eqn: Hk; auto; symmetry; auto.
-  eapply map_incl_spec; eauto.
-Qed.
-
-Lemma compatible_upd : forall m1 m2 k v, compatible m1 m2 -> m2 k = None ->
-  compatible (map_upd m1 k v) m2.
-Proof.
-  unfold map_upd; repeat intro.
-  destruct (eq_dec k0 k); eauto; congruence.
-Qed.
-
-Notation maps_add l := (fold_right map_add empty_map l).
-
-Lemma in_maps_add : forall l (k : A) (v : B), maps_add l k = Some v -> exists m, In m l /\ m k = Some v.
-Proof.
-  induction l; [discriminate | simpl; intros].
-  unfold map_add at 1 in H.
-  destruct (a k) eqn: Ha.
-  - inv H; eauto.
-  - destruct (IHl _ _ H) as (? & ? & ?); eauto.
-Qed.
-
-Definition all_compatible (l : list (A -> option B)) := forall m1 m2, In m1 l -> In m2 l -> compatible m1 m2.
-
-Lemma all_compatible_cons : forall (m : A -> option B) l, all_compatible (m :: l) -> compatible m (maps_add l) /\ all_compatible l.
-Proof.
-  split; repeat intro.
-  - eapply in_maps_add in H1 as (m2 & ? & ?).
-    eapply (H m m2); simpl; eauto.
-  - eapply (H m1 m2); simpl; eauto.
-Qed.
-
-Lemma maps_add_in : forall l m (k : A) (v : B) (Hcompat : all_compatible l),
-  In m l -> m k = Some v -> maps_add l k = Some v.
-Proof.
-  induction l; [contradiction | simpl; intros].
-  destruct H.
-  - subst.
-    unfold map_add.
-    replace (m k) with (Some v); auto.
-  - apply all_compatible_cons in Hcompat as [].
-    rewrite map_add_comm; auto.
-    unfold map_add.
-    erewrite IHl; eauto.
-Qed.
-
-Lemma fold_right_maps_add : forall l (e : A -> option B), fold_right map_add e l = map_add (maps_add l) e.
-Proof.
-  induction l; auto; simpl; intros.
-  rewrite map_add_assoc, IHl; auto.
-Qed.
-
-Section Maps_Disjoint.
-(* This map instance requires that maps be disjoint, providing e.g. uniqueness of
-   timestamps for histories. *)
-
-Definition disjoint m1 m2 := forall k v1, m1 k = Some v1 -> m2 k = None.
-
-Global Instance disjoint_comm : Symmetric disjoint.
-Proof.
-  repeat intro.
-  destruct (x k) eqn: Hx; auto.
-  specialize (H _ _ Hx); congruence.
-Qed.
-
-Lemma disjoint_compatible : forall m1 m2, disjoint m1 m2 -> compatible m1 m2.
-Proof.
-  repeat intro.
-  specialize (H _ _ H0); congruence.
-Qed.
-
-Instance map_disj_join : Join (A -> option B) :=
-  fun a b c => forall k, match a k, b k with Some v, None | None, Some v => c k = Some v | None, None => c k = None | _, _ => False end.
-
-Lemma map_disj_join_spec : forall m1 m2 m3, join m1 m2 m3 <-> disjoint m1 m2 /\ m3 = map_add m1 m2.
-Proof.
-  unfold join, map_disj_join; simpl; split; intros.
-  - split.
-    + repeat intro.
-      specialize (H k); rewrite H0 in H.
-      destruct (m2 k); auto; contradiction.
-    + extensionality k; unfold map_add.
-      specialize (H k).
-      destruct (m1 k), (m2 k); auto; contradiction.
-  - destruct H as [Hdisj]; subst; unfold map_add.
-    specialize (Hdisj k).
-    destruct (m1 k); [specialize (Hdisj _ eq_refl) as ->; auto|].
-    destruct (m2 k); auto.
-Qed.
-
-Lemma disjoint_incl : forall m1 m2 m (Hcompat : disjoint m2 m) (Hincl : map_incl m1 m2), disjoint m1 m.
-Proof.
-  repeat intro; eauto.
-  eapply map_incl_spec in Hincl; eauto.
-Qed.
-
-Lemma disjoint_add : forall m1 m2 m3, disjoint m1 m2 -> disjoint m1 m3 -> disjoint m1 (map_add m2 m3).
-Proof.
-  unfold disjoint; intros.
-  unfold map_add.
-  specialize (H _ _ H1); specialize (H0 _ _ H1).
-  rewrite H, H0; auto.
-Qed.
-
-Global Program Instance map_disj_PCM : Ghost := { valid a := True; Join_G := map_disj_join }.
-Next Obligation.
-  exists (fun _ => empty_map); auto; repeat intro.
-  - simpl.
-    destruct (t k); auto.
-  - exists empty_map; hnf.
-    intros; simpl; auto.
-Defined.
-Next Obligation.
-  constructor.
-  - intros.
-    extensionality k.
-    specialize (H k); specialize (H0 k).
-    destruct (x k), (y k); try congruence; contradiction.
-  - intros.
-    apply map_disj_join_spec in H as []; apply map_disj_join_spec in H0 as []; subst.
-    rewrite map_add_assoc.
-    eexists; rewrite !map_disj_join_spec; repeat split.
-    + eapply disjoint_incl; eauto.
-      rewrite map_add_comm by (apply disjoint_compatible; auto); apply map_incl_add.
-    + apply disjoint_add; auto.
-      eapply disjoint_incl; eauto.
-      apply map_incl_add.
-  - intros ???; rewrite !map_disj_join_spec; intros []; subst.
-    split; [symmetry | apply map_add_comm, disjoint_compatible]; auto.
-  - intros.
-    extensionality k; specialize (H k); specialize (H0 k).
-    destruct (a k), (b k); auto.
-    + destruct (a' k); [contradiction | auto].
-    + destruct (a' k); [contradiction | auto].
-    + destruct (b' k); [contradiction | auto].
-Qed.
-
-Lemma disj_join_sub : forall m1 m2, map_incl m1 m2 -> exists m3, join m1 m3 m2.
-Proof.
-  intros; exists (fun x => match m2 x, m1 x with Some v, None => Some v | _, _ => None end).
-  intro k; specialize (H k).
-  destruct (m1 k); simpl in H.
-  - destruct (m2 k); [|contradiction].
-    inv H; auto.
-  - destruct (m2 k); auto.
-Qed.
-
-Definition all_disjoint (l : list (A -> option B)) := forall i j, 0 <= i < Zlength l -> 0 <= j < Zlength l ->
-  i <> j -> disjoint (Znth i l) (Znth j l).
-
-Lemma all_disjoint_compatible : forall l, all_disjoint l -> all_compatible l.
-Proof.
-  unfold all_disjoint, all_compatible; intros.
-  apply In_Znth in H0 as (i & ? & ?); apply In_Znth in H1 as (j & ? & ?); subst.
-  destruct (eq_dec i j); [subst; reflexivity|].
-  apply disjoint_compatible; auto.
-Qed.
-
-Lemma all_disjoint_nil : all_disjoint [].
-Proof.
-  repeat intro.
-  rewrite Zlength_nil in *; lia.
-Qed.
-
-Lemma all_disjoint_cons : forall (m : A -> option B) l, all_disjoint (m :: l) <-> disjoint m (maps_add l) /\ all_disjoint l.
-Proof.
-  split.
-  - split; repeat intro.
-    + destruct (maps_add l k) eqn: Hl; auto.
-      eapply in_maps_add in Hl as (m2 & ? & ?).
-      apply In_Znth in H1 as (j & ? & ?); subst.
-      specialize (H 0 (j + 1)).
-      rewrite Znth_0_cons, Znth_pos_cons, Z.add_simpl_r, Zlength_cons in H by lia.
-      erewrite H in H2; eauto; lia.
-    + specialize (H (i + 1) (j + 1)).
-      rewrite !Znth_pos_cons, !Z.add_simpl_r, Zlength_cons in H by lia.
-      eapply H; eauto; lia.
-  - intros []; repeat intro.
-    rewrite Zlength_cons in H1, H2.
-    destruct (eq_dec i 0), (eq_dec j 0); subst; try contradiction.
-    + rewrite Znth_0_cons in H4; rewrite Znth_pos_cons by lia.
-      specialize (H _ _ H4).
-      destruct (Znth _ _ _) eqn: Hj; auto.
-      apply maps_add_in with (l := l) in Hj; try congruence.
-      * apply all_disjoint_compatible; auto.
-      * apply Znth_In; lia.
-    + rewrite Znth_0_cons; rewrite Znth_pos_cons in H4 by lia.
-      destruct (m k) eqn: Hm; auto.
-      specialize (H _ _ Hm).
-      apply maps_add_in with (l := l) in H4; try congruence.
-      * apply all_disjoint_compatible; auto.
-      * apply Znth_In; lia.
-    + rewrite Znth_pos_cons in * by lia.
-      eapply (H0 (i - 1) (j - 1)); eauto; lia.
-Qed.
-
-Lemma all_disjoint_rev1 : forall l, all_disjoint l -> all_disjoint (rev l).
-Proof.
-  unfold all_disjoint; intros.
-  rewrite Zlength_rev in *.
-  rewrite !Znth_rev by auto.
-  apply H; lia.
-Qed.
-
-Lemma all_disjoint_rev : forall l, all_disjoint l <-> all_disjoint (rev l).
-Proof.
-  split; [apply all_disjoint_rev1|].
-  intros H; apply all_disjoint_rev1 in H.
-  rewrite rev_involutive in H; auto.
-Qed.
-
-Lemma  maps_add_rev : forall l, all_compatible l -> maps_add (rev l) = maps_add l.
-Proof.
-  induction l; auto; simpl; intros.
-  apply all_compatible_cons in H as [].
-  rewrite map_add_comm; auto.
-  rewrite fold_right_app; simpl.
-  rewrite map_add_empty.
-  rewrite (fold_right_maps_add _ a).
-  rewrite IHl; auto.
-Qed.
-
-Lemma all_disjoint_snoc : forall m l, all_disjoint (l ++ [m]) <-> disjoint m (maps_add l) /\ all_disjoint l.
-Proof.
-  intros.
-  replace (l ++ [m]) with (rev (m :: rev l)) by (simpl; rewrite rev_involutive; auto).
-  rewrite all_disjoint_rev, rev_involutive, all_disjoint_cons, <- all_disjoint_rev.
-  split; intros []; rewrite ?maps_add_rev in *; auto; apply all_disjoint_compatible; auto.
-Qed.
-
-Lemma empty_map_disjoint : forall m, disjoint empty_map m.
-Proof.
-  repeat intro; discriminate.
-Qed.
-
-Definition map_sub (m : A -> option B) k := fun x => if eq_dec x k then None else m x.
-
-Lemma map_upd_sub : forall m (k : A) (v : B), m k = Some v -> map_upd (map_sub m k) k v = m.
-Proof.
-  intros; unfold map_upd, map_sub.
-  extensionality x.
-  if_tac; subst; auto.
-Qed.
-
-Lemma map_sub_upd : forall m (k : A) (v : B), m k = None -> map_sub (map_upd m k v) k = m.
-Proof.
-  intros; unfold map_upd, map_sub.
-  extensionality x.
-  if_tac; subst; auto.
-Qed.
-
-Lemma disjoint_sub : forall (m1 m2 : A -> option B) k, disjoint m1 m2 ->
-  disjoint (map_sub m1 k) m2.
-Proof.
-  unfold map_sub, disjoint; intros.
-  destruct (eq_dec _ _); [discriminate | eauto].
-Qed.
-
-End Maps_Disjoint.
-
-End MapsL.
-
-Notation maps_add l := (fold_right map_add empty_map l).
-
-#[export] Hint Resolve empty_map_incl empty_map_disjoint all_disjoint_nil : core.
-
-Section GHist.
-
-(* Ghost histories in the style of Nanevsky *)
-Context {hist_el : Type}.
-
-Notation hist_part := (nat -> option hist_el).
-
-Local Notation map_incl := (@map_incl _ (discrete_PCM hist_el) eq).
-
-Definition hist_sub sh (h : hist_part) hr := sh <> Share.bot /\ if eq_dec sh Tsh then h = hr
-  else map_incl h hr.
-
-Lemma completable_alt : forall sh h hr, @completable map_disj_PCM (Some (sh, h)) hr <-> hist_sub sh h hr.
-Proof.
-  unfold completable, hist_sub; intros; simpl; split.
-  - intros ([(?, ?)|] & Hcase).
-    + destruct Hcase as (? & ? & Hsh & Hj); split; auto.
-      if_tac.
-      * subst; apply join_Tsh in Hsh; tauto.
-      * apply map_disj_join_spec in Hj as []; subst.
-        apply map_incl_add.
-    + hnf in Hcase.
-      inv Hcase.
-      rewrite eq_dec_refl; auto with share.
-  - if_tac.
-    + intros []; subst; exists None; split; auto.
-    + intros [? Hincl].
-      apply disj_join_sub in Hincl as (h' & ?).
-      exists (Some (Share.comp sh, h')).
-      split; auto.
-      split.
-      { intro Hbot; contradiction H.
-        rewrite <- Share.comp_inv at 1.
-        rewrite Hbot; apply comp_bot. }
-      split; [apply comp_join_top | auto].
-Qed.
-
-Lemma hist_sub_upd : forall sh h hr t' e (Hsub : hist_sub sh h hr),
-  hist_sub sh (map_upd h t' e) (map_upd hr t' e).
-Proof.
-  unfold hist_sub; intros.
-  destruct Hsub; split; auto.
-  if_tac; subst; auto.
-  eapply @map_upd2_incl; auto.
-  apply _.
-Qed.
-
-Definition ghost_hist (sh : share) (h : hist_part) g :=
-  own(RA := ref_PCM map_disj_PCM) g (Some (sh, h), None) NoneP.
-
-Lemma ghost_hist_join : forall sh1 sh2 sh h1 h2 p (Hsh : sepalg.join sh1 sh2 sh)
-  (Hsh1 : sh1 <> Share.bot) (Hsh2 : sh2 <> Share.bot),
-  ghost_hist sh1 h1 p * ghost_hist sh2 h2 p = !!(disjoint h1 h2) && ghost_hist sh (map_add h1 h2) p.
-Proof.
-  intros; unfold ghost_hist.
-  erewrite own_op_gen.
-  apply pred_ext; Intros; apply andp_right, derives_refl; apply prop_right.
-  - destruct H as (? & [] & ?); simpl in *.
-    destruct (fst x) as [[]|]; [|contradiction].
-    erewrite map_disj_join_spec in H; tauto.
-  - eexists (Some (sh, map_add h1 h2), None); split; [split|]; simpl.
-    + rewrite map_disj_join_spec; auto.
-    + constructor.
-    + split; auto.
-      intro; subst.
-      apply join_Bot in Hsh as []; auto.
-  - intros (? & [] & ?); simpl in *.
-    destruct (fst x) as [[]|]; [|contradiction].
-    split; [simpl | constructor].
-    erewrite map_disj_join_spec in *; tauto.
-Qed.
-
-Definition hist_incl (h : hist_part) l := forall t e, h t = Some e -> nth_error l t = Some e.
-
-Definition hist_list (h : hist_part) l := forall t e, h t = Some e <-> nth_error l t = Some e.
-
-Lemma hist_list_inj : forall h l1 l2 (Hl1 : hist_list h l1) (Hl2 : hist_list h l2), l1 = l2.
-Proof.
-  unfold hist_list; intros; apply list_nth_error_eq.
-  intro j; specialize (Hl1 j); specialize (Hl2 j).
-  destruct (nth_error l1 j).
-  - symmetry; rewrite <- Hl2, Hl1; auto.
-  - destruct (nth_error l2 j); auto.
-    specialize (Hl2 h0); erewrite Hl1 in Hl2; tauto.
-Qed.
-
-Lemma hist_list_nil_inv1 : forall l, hist_list empty_map l -> l = [].
-Proof.
-  unfold hist_list; intros.
-  destruct l; auto.
-  specialize (H O h); destruct H as [_ H]; specialize (H eq_refl); discriminate.
-Qed.
-
-Lemma hist_list_nil_inv2 : forall h, hist_list h [] -> h = empty_map.
-Proof.
-  unfold hist_list; intros.
-  extensionality t.
-  specialize (H t); destruct (h t); auto.
-  destruct (H h0) as [H' _].
-  specialize (H' eq_refl); rewrite nth_error_nil in H'; discriminate.
-Qed.
-
-Definition ghost_ref l g := EX hr : hist_part, !!(hist_list hr l) &&
-  own(RA := ref_PCM map_disj_PCM) g (None, Some hr) NoneP.
-
-Lemma hist_next : forall h l (Hlist : hist_list h l), h (length l) = None.
-Proof.
-  intros.
-  specialize (Hlist (length l)).
-  destruct (h (length l)); auto.
-  destruct (Hlist h0) as [H' _].
-  pose proof (nth_error_Some l (length l)) as (Hlt & _).
-  lapply Hlt; [lia|].
-  rewrite H' by auto; discriminate.
-Qed.
-
-Definition ghost_hist_ref sh (h r : hist_part) g :=
-  own(RA := ref_PCM map_disj_PCM) g (Some (sh, h), Some r) NoneP.
-
-Lemma hist_add : forall (sh : share) (h h' : hist_part) e p t' (Hfresh : h' t' = None),
-  ghost_hist_ref sh h h' p |-- |==> ghost_hist_ref sh (map_upd h t' e) (map_upd h' t' e) p.
-Proof.
-  intros.
-  erewrite (add_andp (ghost_hist_ref _ _ _ _)) by apply own_valid.
-  Intros.
-  destruct H as [? Hcomp]; simpl in *.
-  erewrite completable_alt in Hcomp; destruct Hcomp as [_ Hcomp].
-  apply (ref_add(P := map_disj_PCM)) with (b := fun k => if eq_dec k t' then Some e else None).
-  - repeat intro.
-    unfold map_upd.
-    if_tac; [|destruct (h k); auto].
-    subst; destruct (h t') eqn: Hh; auto.
-    if_tac in Hcomp; [congruence|].
-    eapply map_incl_spec in Hh; eauto; congruence.
-  - repeat intro.
-    unfold map_upd.
-    if_tac; [|destruct (h' k); auto].
-    subst; rewrite Hfresh; auto.
-Qed.
-
-Lemma hist_incl_nil : forall h, hist_incl empty_map h.
-Proof.
-  repeat intro; discriminate.
-Qed.
-
-Lemma hist_list_nil : hist_list empty_map [].
-Proof.
-  split; [discriminate|].
-  rewrite nth_error_nil; discriminate.
-Qed.
-
-Lemma hist_list_snoc : forall h l e, hist_list h l ->
-  hist_list (map_upd h (length l) e) (l ++ [e]).
-Proof.
-  unfold hist_list, map_upd; split.
-  - if_tac.
-    + intro X; inv X.
-      erewrite nth_error_app2, Nat.sub_diag; auto.
-    + rewrite H.
-      intro X; rewrite nth_error_app1; auto.
-      rewrite <- nth_error_Some, X; discriminate.
-  - if_tac.
-    + subst; rewrite nth_error_app2, Nat.sub_diag; auto.
-    + intro X; apply H; rewrite nth_error_app1 in X; auto.
-      assert (t < length (l ++ [e]))%nat; [|rewrite app_length in *; simpl in *; lia].
-      rewrite <- nth_error_Some, X; discriminate.
-Qed.
-
-Lemma hist_sub_list_incl : forall sh h h' l (Hsub : hist_sub sh h h') (Hlist : hist_list h' l),
-  hist_incl h l.
-Proof.
-  unfold hist_list, hist_incl; intros.
-  apply Hlist.
-  destruct Hsub.
-  destruct (eq_dec sh Tsh); subst; auto.
-  eapply map_incl_spec; eauto.
-Qed.
-
-Lemma hist_sub_Tsh : forall h h', hist_sub Tsh h h' <-> (h = h').
-Proof.
-  intros; unfold hist_sub; rewrite eq_dec_refl; repeat split; auto with share; tauto.
-Qed.
-
-Lemma hist_ref_join : forall sh h l p, sh <> Share.bot ->
-  ghost_hist sh h p * ghost_ref l p =
-  EX h' : hist_part, !!(hist_list h' l /\ hist_sub sh h h') && ghost_hist_ref sh h h' p.
-Proof.
-  unfold ghost_hist, ghost_ref; intros; apply pred_ext.
-  - Intros hr; Exists hr.
-    erewrite own_op_gen.
-    + Intros; apply andp_right, derives_refl; apply prop_right.
-      split; auto.
-      destruct H1 as ([g] & [H1 H2] & [? Hcompat]); simpl in *.
-      destruct g as [[]|]; [|contradiction].
-      inv H1; inv H2.
-      apply completable_alt; auto.
-    + split; simpl; auto; constructor.
-  - Intros h'; Exists h'; entailer!.
-    erewrite <- own_op; [apply derives_refl|].
-    split; simpl; auto; constructor.
-Qed.
-
-Corollary hist_ref_join_nil : forall sh p, sh <> Share.bot ->
-  ghost_hist sh empty_map p * ghost_ref [] p = ghost_hist_ref sh empty_map empty_map p.
-Proof.
-  intros; erewrite hist_ref_join by auto.
-  apply pred_ext; entailer!.
-  - apply hist_list_nil_inv2 in H0; subst; auto.
-  - Exists (fun _ : nat => @None hist_el); apply andp_right, derives_refl.
-    apply prop_right; split; [apply hist_list_nil|].
-    split; auto.
-    if_tac; [auto|].
-    reflexivity.
-Qed.
-
-Lemma hist_ref_incl : forall sh h h' p, sh <> Share.bot ->
-  ghost_hist sh h p * ghost_ref h' p |-- !!hist_incl h h'.
-Proof.
-  intros; erewrite hist_ref_join by auto.
-  Intros l; eapply prop_right, hist_sub_list_incl; eauto.
-Qed.
-
-Lemma hist_add' : forall sh h h' e p, sh <> Share.bot ->
-  ghost_hist sh h p * ghost_ref h' p |-- |==>
-  ghost_hist sh (map_upd h (length h') e) p * ghost_ref (h' ++ [e]) p.
-Proof.
-  intros; erewrite !hist_ref_join by auto.
-  Intros hr.
-  eapply derives_trans; [apply hist_add|].
-  { apply hist_next; eauto. }
-  apply bupd_mono.
-  Exists (map_upd hr (length h') e); apply andp_right, derives_refl.
-  apply prop_right; split; [apply hist_list_snoc | apply hist_sub_upd]; auto.
-Qed.
-
-Definition newer (l : hist_part) t := forall t', l t' <> None -> (t' < t)%nat.
-
-Lemma newer_trans : forall l t1 t2, newer l t1 -> (t1 <= t2)%nat -> newer l t2.
-Proof.
-  repeat intro.
-  specialize (H _ H1); lia.
-Qed.
-
-Corollary newer_upd : forall l t1 e t2, newer l t1 -> (t1 < t2)%nat ->
-  newer (map_upd l t1 e) t2.
-Proof.
-  unfold newer, map_upd; intros.
-  destruct (eq_dec t' t1); [lia|].
-  eapply newer_trans; eauto; lia.
-Qed.
-
-Lemma newer_over : forall h t t', newer h t -> (t <= t')%nat -> h t' = None.
-Proof.
-  intros.
-  specialize (H t').
-  destruct (h t'); auto.
-  lapply H; [lia | discriminate].
-Qed.
-
-Corollary newer_out : forall h t, newer h t -> h t = None.
-Proof.
-  intros; eapply newer_over; eauto.
-Qed.
-
-Lemma add_new_inj : forall h h' t t' v v' (Ht : newer h t) (Ht' : newer h' t'),
-  map_upd h t v = map_upd h' t' v' -> h = h' /\ t = t' /\ v = v'.
-Proof.
-  intros.
-  pose proof (equal_f H t) as Hh.
-  pose proof (equal_f H t') as Hh'.
-  pose proof (newer_out _ _ Ht) as Hout.
-  pose proof (newer_out _ _ Ht') as Hout'.
-  unfold map_upd in Hh, Hh'.
-  rewrite !eq_dec_refl in Hh, Hh'.
-  if_tac in Hh.
-  - inv Hh; clear Hh'.
-    repeat split; auto.
-    erewrite <- (map_sub_upd h) by (eapply newer_out; eauto).
-    erewrite H, map_sub_upd; auto.
-  - erewrite if_false in Hh' by auto.
-    lapply (Ht t'); [|rewrite Hh'; discriminate].
-    lapply (Ht' t); [|rewrite <- Hh; discriminate].
-    lia.
-Qed.
-
-Lemma hist_incl_lt : forall h l, hist_incl h l -> newer h (length l).
-Proof.
-  unfold hist_incl; repeat intro.
-  specialize (H t').
-  destruct (h t'); [|contradiction].
-  specialize (H _ eq_refl).
-  rewrite <- nth_error_Some, H; discriminate.
-Qed.
-
-Corollary hist_list_lt : forall h l, hist_list h l -> newer h (length l).
-Proof.
-  intros; apply hist_incl_lt; repeat intro; apply H; auto.
-Qed.
-
-(* We want to be able to remove irrelevant operations from a history, leading to a slightly weaker
-   correspondence between history and list of operations. *)
-Inductive hist_list' : hist_part -> list hist_el -> Prop :=
-| hist_list'_nil : hist_list' empty_map []
-| hist_list'_snoc : forall h l t e (Hlast : newer h t) (Hrest : hist_list' h l),
-    hist_list' (map_upd h t e) (l ++ [e]).
-Local Hint Resolve hist_list'_nil : core.
-
-Lemma hist_list'_in : forall h l (Hl : hist_list' h l) e, (exists t, h t = Some e) <-> In e l.
-Proof.
-  induction 1.
-  - split; [intros (? & ?); discriminate | contradiction].
-  - intro; subst; split.
-    + unfold map_upd; intros (? & Hin); erewrite in_app in *.
-      destruct (eq_dec x t); [inv Hin; simpl; auto|].
-      rewrite <- IHHl; eauto.
-    + rewrite in_app; intros [Hin | [Heq | ?]]; [| inv Heq | contradiction].
-      * rewrite <- IHHl in Hin; destruct Hin as (? & ?).
-        apply newer_out in Hlast.
-        unfold map_upd; exists x; if_tac; auto; congruence.
-      * unfold map_upd; eexists; apply eq_dec_refl.
-Qed.
-
-Lemma hist_list_weak : forall l h (Hl : hist_list h l), hist_list' h l.
-Proof.
-  induction l using rev_ind; intros.
-  - apply hist_list_nil_inv2 in Hl; subst; auto.
-  - destruct (Hl (length l) x) as (_ & H); exploit H.
-    { rewrite nth_error_app2, Nat.sub_diag by lia; auto. }
-    intro Hx.
-    set (h0 := fun k => if eq_dec k (length l) then None else h k).
-    replace h with (map_upd h0 (length l) x).
-    constructor.
-    + pose proof (hist_list_lt _ _ Hl) as Hn.
-      intro t; specialize (Hn t).
-      subst h0; simpl; if_tac; [contradiction|].
-      intro X; specialize (Hn X); rewrite app_length in Hn; simpl in Hn; lia.
-    + apply IHl.
-      intros t e; specialize (Hl t e).
-      subst h0; simpl; if_tac.
-      * split; [discriminate|].
-        intro X; assert (t < length l)%nat by (rewrite <- nth_error_Some, X; discriminate); lia.
-      * rewrite Hl; destruct (lt_dec t (length l)).
-        { erewrite nth_error_app1 by auto; reflexivity. }
-        split; intro X.
-        -- assert (t < length (l ++ [x]))%nat by (rewrite <- nth_error_Some, X; discriminate);
-             rewrite app_length in *; simpl in *; lia.
-        -- assert (t < length l)%nat by (rewrite <- nth_error_Some, X; discriminate); contradiction.
-    + unfold map_upd; subst h0; simpl.
-      extensionality k'; if_tac; subst; auto.
-Qed.
-
-Lemma hist_list'_add : forall h1 h2 (l : list hist_el) (Hdisj : disjoint h1 h2), hist_list' (map_add h1 h2) l ->
-  exists l1 l2, Permutation l (l1 ++ l2) /\ hist_list' h1 l1 /\ hist_list' h2 l2.
-Proof.
-  intros.
-  remember (map_add h1 h2) as h.
-  generalize dependent h2; revert h1; induction H; intros.
-  - exists [], []; split; [reflexivity|].
-    assert (h1 = empty_map /\ h2 = empty_map) as [].
-    { split; extensionality k; apply equal_f with (x := k) in Heqh; unfold map_add in Heqh;
-        destruct (h1 k); auto; discriminate. }
-    subst; split; constructor.
-  - pose proof (equal_f Heqh t) as Ht.
-    unfold map_upd, map_add in Ht.
-    erewrite eq_dec_refl in Ht by auto.
-    destruct (h1 t) eqn: Hh1.
-    + inv Ht.
-      destruct (IHhist_list' (map_sub h1 t) h2) as (l1 & l2 & ? & ? & ?).
-      { apply disjoint_sub; auto. }
-      { extensionality k.
-        apply equal_f with (x := k) in Heqh.
-        unfold map_upd, map_sub, map_add in *.
-        if_tac; auto; subst.
-        apply newer_out in Hlast.
-        apply Hdisj in Hh1; congruence. }
-      exists (l1 ++ [h0]), l2; repeat split; auto.
-      * etransitivity; [|apply Permutation_app_comm].
-        rewrite app_assoc; apply Permutation_app_tail.
-        etransitivity; eauto.
-        apply Permutation_app_comm.
-      * erewrite <- (map_upd_sub h1 t) by eauto.
-        constructor; auto.
-        repeat intro.
-        unfold map_sub in *.
-        apply equal_f with (x := t') in Heqh.
-        unfold map_upd, map_add in Heqh.
-        apply Hlast.
-        destruct (eq_dec _ _); [contradiction|].
-        destruct (h1 t'); [congruence | contradiction].
-    + destruct (IHhist_list' h1 (map_sub h2 t)) as (l1 & l2 & ? & ? & ?).
-      { symmetry; apply disjoint_sub; symmetry; auto. }
-      { extensionality k.
-        apply equal_f with (x := k) in Heqh.
-        unfold map_upd, map_sub, map_add in *.
-        if_tac; auto; subst.
-        apply newer_out in Hlast.
-        rewrite Hh1; auto. }
-      exists l1, (l2 ++ [e]); repeat split; auto.
-      * rewrite app_assoc; apply Permutation_app_tail; auto.
-      * erewrite <- (map_upd_sub h2 t) by eauto.
-        constructor; auto.
-        repeat intro.
-        unfold map_sub in *.
-        apply equal_f with (x := t') in Heqh.
-        unfold map_upd, map_add in Heqh.
-        apply Hlast.
-        destruct (eq_dec _ _); [contradiction|].
-        destruct (h1 t'); congruence.
-Qed.
-
-Lemma ghost_hist_init : @valid (ref_PCM (@map_disj_PCM nat hist_el)) (Some (Tsh, empty_map), Some empty_map).
-Proof.
-  split; simpl; auto with share.
-  rewrite completable_alt; split; auto with share.
-  rewrite eq_dec_refl; auto.
-Qed.
-
-Inductive add_events h : list hist_el -> hist_part -> Prop :=
-| add_events_nil : add_events h [] h
-| add_events_snoc : forall le h' t e (Hh' : add_events h le h') (Ht : newer h' t),
-    add_events h (le ++ [e]) (map_upd h' t e).
-Local Hint Resolve add_events_nil : core.
-
-Lemma add_events_1 : forall h t e (Ht : newer h t), add_events h [e] (map_upd h t e).
-Proof.
-  intros; apply (add_events_snoc _ []); auto.
-Qed.
-
-Lemma add_events_trans : forall h le h' le' h'' (H1 : add_events h le h') (H2 : add_events h' le' h''),
-  add_events h (le ++ le') h''.
-Proof.
-  induction 2.
-  - rewrite app_nil_r; auto.
-  - rewrite app_assoc; constructor; auto.
-Qed.
-
-Lemma add_events_add : forall h le h', add_events h le h' ->
-  exists h2, h' = map_add h h2 /\ forall t e, h2 t = Some e -> newer h t /\ In e le.
-Proof.
-  induction 1.
-  - eexists; erewrite map_add_empty; split; auto; discriminate.
-  - destruct IHadd_events as (h2 & ? & Hh2); subst.
-    assert (compatible h h2).
-    { repeat intro.
-      destruct (Hh2 _ _ H1) as [Hk _].
-      specialize (Hk k); lapply Hk; [lia | congruence]. }
-    assert (newer h t).
-    { repeat intro; apply Ht.
-      unfold map_add.
-      destruct (h t'); auto. }
-    erewrite map_add_comm, map_add_upd, map_add_comm; auto.
-    eexists; split; eauto; intros.
-    unfold map_upd in *.
-    rewrite in_app; simpl.
-    destruct (eq_dec t0 t); [inv H2; auto|].
-    destruct (Hh2 _ _ H2); auto.
-    { apply compatible_upd; [symmetry; auto|].
-      specialize (H1 t).
-      destruct (h t); auto.
-      lapply H1; [lia | discriminate]. }
-Qed.
-
-Corollary add_events_dom : forall h le h' t e, add_events h le h' -> h' t = Some e ->
-  h t = Some e \/ In e le.
-Proof.
-  intros; apply add_events_add in H as (? & ? & Hh2); subst.
-  unfold map_add in H0.
-  destruct (h t); [inv H0; auto|].
-  destruct (Hh2 _ _ H0); auto.
-Qed.
-
-Corollary add_events_incl : forall h le h', add_events h le h' -> map_incl h h'.
-Proof.
-  intros; apply add_events_add in H as (? & ? & ?); subst.
-  apply map_incl_add.
-Qed.
-
-Corollary add_events_newer : forall h le h' t, add_events h le h' -> newer h' t -> newer h t.
-Proof.
-  repeat intro.
-  apply H0.
-  destruct (h t') eqn: Ht'; [|contradiction].
-  eapply map_incl_spec in Ht' as ->; eauto.
-  eapply add_events_incl; eauto.
-Qed.
-
-Lemma add_events_in : forall h le h' e, add_events h le h' -> In e le ->
-  exists t, newer h t /\ h' t = Some e.
-Proof.
-  induction 1; [contradiction|].
-  rewrite in_app; intros [? | [? | ?]]; try contradiction.
-  - destruct IHadd_events as (? & ? & ?); auto.
-    do 2 eexists; eauto.
-    unfold map_upd; if_tac; auto; subst.
-    specialize (Ht t); rewrite H2 in Ht; lapply Ht; [lia | discriminate].
-  - subst; unfold map_upd; do 2 eexists; [|apply eq_dec_refl].
-    eapply add_events_newer; eauto.
-Qed.
-
-End GHist.
-
-#[export] Hint Resolve hist_incl_nil hist_list_nil hist_list'_nil add_events_nil : core.
-(*#[export] Hint Resolve ghost_var_precise ghost_var_precise'.*)
-#[export] Hint Resolve (*ghost_var_init*) master_init (*ghost_map_init*) ghost_hist_init : init.
-
-Lemma wand_nonexpansive_l: forall P Q n,
-  approx n (P -* Q)%logic = approx n (approx n P  -* Q)%logic.
-Proof.
-  apply wand_nonexpansive_l.
-Qed.
-
-Lemma wand_nonexpansive_r: forall P Q n,
-  approx n (P -* Q)%logic = approx n (P  -* approx n Q)%logic.
-Proof.
-  apply wand_nonexpansive_r.
-Qed.
-
-Lemma wand_nonexpansive: forall P Q n,
-  approx n (P -* Q)%logic = approx n (approx n P  -* approx n Q)%logic.
-Proof.
-  apply wand_nonexpansive.
-Qed.
-
-Corollary view_shift_nonexpansive : forall P Q n,
-  approx n (P -* |==> Q)%logic = approx n (approx n P  -* |==> approx n Q)%logic.
-Proof.
-  intros.
-  rewrite wand_nonexpansive, approx_bupd; reflexivity.
-Qed.
-
-Ltac ghost_alloc G :=
-  match goal with |-semax _ (PROPx _ (LOCALx _ (SEPx (?R1 :: _)))) _ _ =>
-    rewrite <- (emp_sepcon R1) at 1; Intros; viewshift_SEP 0 (EX g : _, G g);
-  [go_lowerx; eapply derives_trans; [|unseal_derives; apply fupd.bupd_fupd]; rewrite ?emp_sepcon;
-   apply own_alloc; auto; simpl; auto with init share ghost|] end.
-
-Ltac ghosts_alloc G n :=
-  match goal with |-semax _ (PROPx _ (LOCALx _ (SEPx (?R1 :: _)))) _ _ =>
-    rewrite <- (emp_sepcon R1) at 1; Intros; viewshift_SEP 0 (EX lg : _, !!(Zlength lg = n) && iter_sepcon G lg);
-  [go_lowerx; eapply derives_trans; [|unseal_derives; apply fupd.bupd_fupd]; rewrite ?emp_sepcon;
-   apply own_list_alloc'; auto; simpl; auto with init share ghost|] end.
diff --git a/concurrency/ghostsI.v b/concurrency/ghostsI.v
deleted file mode 100644
index 5daa0825d1..0000000000
--- a/concurrency/ghostsI.v
+++ /dev/null
@@ -1,321 +0,0 @@
-Require Import VST.veric.compcert_rmaps.
-Require Export VST.concurrency.ghosts.
-Require Import VST.concurrency.conclib.
-Require Import VST.veric.bi.
-Require Import VST.msl.sepalg.
-Import List.
-
-(* Lemmas about ghost state, proved with Iris bupd *)
-
-#[export] Instance unfash_persistent P : Persistent (alg_seplog.unfash P).
-Proof.
-  change unfash with (@subtypes.unfash rmap _ _).
-  constructor; intros ??; hnf.
-  unfold bi_persistently; simpl.
-  unfold unfash in *; simpl in *.
-  rewrite level_core; auto.
-Qed.
-
-Section ghost.
-
-Context {RA: Ghost}.
-
-Lemma own_alloc_strong : forall P (a : G) (pp : preds), ghost_seplog.pred_infinite P -> valid a ->
-  emp |-- (|==> EX g : own.gname, !!(P g) && own g a pp)%I.
-Proof.
-  exact own_alloc_strong.
-Qed.
-
-Lemma own_alloc : forall (a : G) (pp : preds), valid a -> emp%I |-- (|==> EX g : own.gname, own g a pp)%I.
-Proof.
-  exact own_alloc.
-Qed.
-
-Global Instance own_dealloc g a pp : Affine (own g a pp).
-Proof.
-  unfold Affine.
-  apply own_dealloc.
-Qed.
-
-Lemma own_update : forall g a b pp, fp_update a b -> own g a pp |-- (|==> own g b pp)%I.
-Proof.
-  exact own_update.
-Qed.
-
-Lemma own_update_ND : forall g a B pp, fp_update_ND a B -> own g a pp |-- (|==> EX b : G, !! B b && own g b pp)%I.
-Proof.
-  exact own_update_ND.
-Qed.
-
-Lemma own_list_alloc : forall la lp, Forall valid la -> length lp = length la ->
-  emp |-- (|==> (EX lg : _, !!(Zlength lg = Zlength la) &&
-    iter_sepcon (fun '(g, a, p) => own g a p) (combine (combine lg la) lp)))%I.
-Proof.
-  exact own_list_alloc.
-Qed.
-
-Corollary own_list_alloc' : forall a pp i, 0 <= i -> valid a ->
-  emp |-- (|==> (EX lg : _, !!(Zlength lg = i) && iter_sepcon (fun g => own g a pp) lg))%I.
-Proof.
-  exact own_list_alloc'.
-Qed.
-
-Lemma own_list_dealloc : forall {A} f (l : list A),
-  (forall b, exists g a pp, f b |-- own g a pp) ->
-  iter_sepcon f l |-- (emp)%I.
-Proof.
-  intros; apply own_list_dealloc; auto.
-Qed.
-
-Lemma own_list_dealloc' : forall {A} g a p (l : list A),
-  iter_sepcon (fun x => own (g x) (a x) (p x)) l |-- (emp)%I.
-Proof.
-  intros; apply own_list_dealloc'.
-Qed.
-
-Lemma core_persistent : forall g a p, a = core a -> Persistent (own g a p).
-Proof.
-  intros; unfold Persistent.
-  constructor.
-  intros ??; unfold bi_persistently; simpl.
-  apply own.own_core; auto.
-Qed.
-
-End ghost.
-
-Lemma exclusive_update : forall {A} (v v' : A) p, excl p v |-- (|==> excl p v')%I.
-Proof.
-  intros; apply exclusive_update.
-Qed.
-
-Section Snapshot.
-
-Context `{ORD : PCM_order}.
-
-Lemma master_update : forall v v' p, ord v v' -> ghost_master Tsh v p |-- (|==> ghost_master Tsh v' p)%I.
-Proof.
-  exact master_update.
-Qed.
-
-Lemma make_snap : forall (sh : share) v p, ghost_master sh v p |-- (|==> ghost_snap v p * ghost_master sh v p)%I.
-Proof.
-  exact make_snap.
-Qed.
-
-Lemma ghost_snap_forget : forall v1 v2 p, ord v1 v2 -> ghost_snap v2 p |-- (|==> ghost_snap v1 p)%I.
-Proof.
-  exact ghost_snap_forget.
-Qed.
-
-Lemma ghost_snap_choose : forall v1 v2 p, ghost_snap v1 p * ghost_snap v2 p |-- (|==> ghost_snap v1 p)%I.
-Proof.
-  exact ghost_snap_choose.
-Qed.
-
-Lemma snap_master_update1 : forall v1 v2 p v', ord v2 v' ->
-  ghost_snap v1 p * ghost_master1 v2 p |-- (|==> ghost_snap v' p * ghost_master1 v' p)%I.
-Proof.
-  exact snap_master_update1.
-Qed.
-
-Global Instance snap_persistent v p : Persistent (ghost_snap v p).
-Proof.
-  apply core_persistent; auto.
-Qed.
-
-End Snapshot.
-
-Section Reference.
-
-Context {P : Ghost}.
-
-Lemma part_ref_update : forall g sh a r a' r'
-  (Ha' : forall b, join a b r -> join a' b r' /\ (a = r -> a' = r')),
-  ghost_part_ref sh a r g |-- (|==> ghost_part_ref sh a' r' g).
-Proof.
-  exact part_ref_update.
-Qed.
-
-Lemma ref_add : forall g sh a r b a' r'
-  (Ha : join a b a') (Hr : join r b r'),
-  ghost_part_ref sh a r g |-- (|==> ghost_part_ref sh a' r' g)%I.
-Proof.
-  exact ref_add.
-Qed.
-
-End Reference.
-
-Section GVar.
-
-Context {A : Type}.
-
-Notation ghost_var := (@ghost_var A).
-
-Lemma ghost_var_update : forall v p v', ghost_var Tsh v p |-- (|==> ghost_var Tsh v' p)%I.
-Proof.
-  exact ghost_var_update.
-Qed.
-
-Lemma ghost_var_update' : forall g (v1 v2 v : A), ghost_var gsh1 v1 g * ghost_var gsh2 v2 g |--
-  |==> !!(v1 = v2) && (ghost_var gsh1 v g * ghost_var gsh2 v g).
-Proof.
-  exact ghost_var_update'.
-Qed.
-
-End GVar.
-
-Section PVar.
-
-Lemma snap_master_update' : forall (v1 v2 : nat) p v', (v2 <= v')%nat ->
-  ghost_snap v1 p * ghost_master1 v2 p |-- (|==> ghost_snap v' p * ghost_master1 v' p)%I.
-Proof.
-  intros; apply snap_master_update1; auto.
-Qed.
-
-End PVar.
-
-Section Reference.
-
-Context {P : Ghost}.
-
-Lemma ref_update : forall g a r a',
-  ghost_part_ref Tsh a r g |-- (|==> ghost_part_ref Tsh a' a' g)%I.
-Proof.
-  exact ref_update.
-Qed.
-
-End Reference.
-
-Section GHist.
-
-(* Ghost histories in the style of Nanevsky *)
-Context {hist_el : Type}.
-
-Notation hist_part := (nat -> option hist_el).
-
-Lemma hist_add : forall (sh : share) (h h' : hist_part) e p t' (Hfresh : h' t' = None),
-  ghost_hist_ref sh h h' p |-- (|==> ghost_hist_ref sh (map_upd h t' e) (map_upd h' t' e) p)%I.
-Proof.
-  exact hist_add.
-Qed.
-
-Notation ghost_hist := (@ghost_hist hist_el).
-
-Lemma hist_add' : forall sh h h' e p, sh <> Share.bot ->
-  ghost_hist sh h p * ghost_ref h' p |-- (|==>
-  ghost_hist sh (map_upd h (length h') e) p * ghost_ref (h' ++ [e]) p)%I.
-Proof.
-  exact hist_add'.
-Qed.
-
-End GHist.
-
-(* speed up destructs of the form [% H] *)
-#[export] Existing Instance class_instances.into_sep_and_persistent_l.
-
-Require Import iris.algebra.gmap.
-
-(* universe inconsistency, reflecting a real difference in expressive power
-#[local] Program Instance RA_ghost (A : cmra) : Ghost := { G := cmra_car A; Join_G a b c := cmra_op A a b = c }.
-*)
-
-Section gmap_ghost.
-
-Context {K} `{Countable K} {A : Ghost}.
-
-Program Instance gmap_ghost : Ghost := { G := gmap K G; Join_G a b c := forall k, sepalg.join (a !! k) (b !! k) (c !! k);
-  valid a := True%type }.
-Next Obligation.
-Proof.
-  exists (fun m => gmap_fmap _ _ sepalg.core m); intros.
-  - intros k.
-    rewrite lookup_fmap.
-    destruct (t !! k); constructor.
-    apply core_unit.
-  - exists (gmap_fmap _ _ sepalg.core c); intros k.
-    rewrite !lookup_fmap.
-    specialize (H0 k); inv H0; try constructor.
-    + destruct (a !! k); constructor.
-      apply core_duplicable.
-    + eapply core_sub_join, join_core_sub, H4.
-  - apply map_eq; intros k.
-    rewrite !lookup_fmap.
-    destruct (a !! k); auto; simpl.
-    rewrite core_idem; auto.
-Defined.
-Next Obligation.
-Proof.
-  constructor; intros.
-  - apply map_eq; intros k.
-    specialize (H0 k); specialize (H1 k).
-    inv H0; inv H1; auto; try congruence.
-    rewrite <- H2 in H0; inv H0.
-    rewrite <- H3 in H6; inv H6.
-    f_equal; eapply join_eq; eauto.
-  - exists (map_imap (fun k _ => projT1 (join_assoc (H0 k) (H1 k))) (b ∪ c)).
-    split; intros k; pose proof (H0 k) as Hj1; pose proof (H1 k) as Hj2;
-      rewrite map_lookup_imap lookup_union; destruct (join_assoc (H0 k) (H1 k)) as (? & ? & ?);
-      destruct (b !! k) eqn: Hb; simpl; auto.
-    + inv j; constructor; auto.
-    + inv j; [|constructor].
-      destruct (c !! k); constructor.
-    + inv j; auto.
-    + inv j; auto.
-      destruct (c !! k); auto.
-  - intros k; specialize (H0 k).
-    apply sepalg.join_comm; auto.
-  - apply map_eq; intros k.
-    specialize (H0 k); specialize (H1 k).
-    inv H0; inv H1; try congruence.
-    rewrite <- H2 in H7; inv H7.
-    rewrite <- H0 in H4; inv H4.
-    f_equal; eapply join_positivity; eauto.
-Qed.
-Next Obligation.
-Proof.
-  auto.
-Qed.
-
-Context `{A_order : PCM_order(P := A)}.
-
-Lemma map_included_option_ord : forall (a b : gmap K G), map_included ord a b -> forall k, option_ord(ord := ord) (a !! k) (b !! k).
-Proof.
-  intros.
-  specialize (H0 k); destruct (a !! k), (b !! k); simpl; auto.
-Qed.
-
-#[export] Instance gmap_order : PCM_order (map_included ord).
-Proof.
-  constructor.
-  - apply (map_included_preorder(M := gmap K)), _.
-  - intros.
-    pose proof (map_included_option_ord _ _ H0) as Ha.
-    pose proof (map_included_option_ord _ _ H1) as Hb.
-    exists (map_imap (fun k _ => proj1_sig (ord_lub(PCM_order := option_order(ORD := A_order)) _ _ _ (Ha k) (Hb k))) (map_union a b)).
-    split; intros k; pose proof (H0 k) as Hj1; pose proof (H1 k) as Hj2;
-      rewrite map_lookup_imap lookup_union; destruct (ord_lub _ _ _ (Ha k) (Hb k)) as (? & ? & ?); simpl;
-      destruct (a !! k) eqn: Ha1; rewrite Ha1 in j |- *; simpl; auto.
-    + destruct (b !! k) eqn: Hb1; rewrite Hb1 in j |- *; simpl; auto.
-    + destruct (b !! k) eqn: Hb1; rewrite Hb1 in j |- *; simpl; auto; constructor.
-    + destruct (b !! k) eqn: Hb1; rewrite Hb1 in j |- *;
-        destruct x, (c !! k) eqn: Hc; rewrite Hc in o |- *; simpl; auto.
-    + destruct (b !! k) eqn: Hb1; rewrite Hb1 in j |- *;
-        destruct x, (c !! k) eqn: Hc; rewrite Hc in o |- *; simpl; auto.
-  - split; intros k; specialize (H0 k); inv H0; simpl; auto.
-    + destruct (b !! k) eqn: Hb; rewrite Hb; auto.
-    + destruct (a !! k) eqn: Ha; rewrite Ha; simpl; auto.
-      reflexivity.
-    + apply join_ord in H4 as []; auto.
-    + destruct (b !! k) eqn: Hb; rewrite Hb; simpl; auto.
-      reflexivity.
-    + destruct (a !! k) eqn: Ha; rewrite Ha; auto.
-    + apply join_ord in H4 as []; auto.
-  - intros ??? k.
-    specialize (H0 k).
-    destruct (b !! k) eqn: Hb; rewrite Hb in H0 |- *; [|constructor].
-    destruct (a !! k) eqn: Ha; rewrite Ha in H0 |- *; [|contradiction].
-    constructor; apply ord_join; auto.
-Qed.
-
-
-End gmap_ghost.
diff --git a/concurrency/invariants.v b/concurrency/invariants.v
deleted file mode 100644
index 39cd96c7ad..0000000000
--- a/concurrency/invariants.v
+++ /dev/null
@@ -1,211 +0,0 @@
-Require Import stdpp.namespaces.
-Require Import VST.veric.invariants.
-Require Import VST.msl.ghost_seplog.
-Require Import VST.msl.sepalg_generators.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.concurrency.conclib.
-Require Export VST.concurrency.ghostsI.
-Require Import VST.veric.bi.
-Require Import VST.msl.sepalg.
-Require Import List.
-Import Ensembles.
-
-#[export] Notation iname := iname.
-
-Lemma coPset_to_Ensemble_minus : forall E1 E2, coPset_to_Ensemble (E1 ∖ E2) = Setminus (coPset_to_Ensemble E1) (coPset_to_Ensemble E2).
-Proof.
-  intros; unfold coPset_to_Ensemble.
-  apply Extensionality_Ensembles; split; intros ? Hin; unfold In in *.
-  - apply elem_of_difference in Hin as []; constructor; auto.
-  - inv Hin. apply elem_of_difference; auto.
-Qed.
-
-Lemma coPset_to_Ensemble_single : forall x, coPset_to_Ensemble {[Pos.of_nat (S x)]} = Singleton x.
-Proof.
-  intros; unfold coPset_to_Ensemble.
-  apply Extensionality_Ensembles; split; intros ? Hin; unfold In in *.
-  - apply elem_of_singleton in Hin.
-    apply (f_equal Pos.to_nat) in Hin.
-    rewrite -> !Nat2Pos.id in Hin by auto; inv Hin; constructor.
-  - inv Hin.
-    apply elem_of_singleton; auto.
-Qed.
-
-(* recapitulating Iris "semantic invariants" so we can use custom namespaces. *)
-Definition inv (N : namespace) (P : mpred) : mpred := 
-  □ ∀ E, ⌜↑N ⊆ E⌝ → |={E,E ∖ ↑N}=> ▷ P ∗ (▷ P ={E ∖ ↑N,E}=∗ emp).
-
-Definition own_inv (N : namespace) (P : mpred) :=
-    ∃ i, ⌜Pos.of_nat (S i) ∈ (↑N:coPset)⌝ ∧ invariant i P.
-
-Lemma own_inv_acc E N P :
-  ↑N ⊆ E → own_inv N P |-- |={E,E∖↑N}=> ▷ P ∗ (▷ P ={E∖↑N,E}=∗ emp).
-Proof.
-  intros.
-  iDestruct 1 as (i) "[% HiP]".
-  iPoseProof (inv_open (coPset_to_Ensemble E) with "HiP") as "H".
-  { unfold Ensembles.In, coPset_to_Ensemble; set_solver. }
-  iAssert (|={E,E ∖ {[Pos.of_nat (S i)]}}=> |> P * (|> P -* |={E ∖ {[Pos.of_nat (S i)]},E}=> emp)) with "[H]" as "H".
-  { unfold fupd, bi_fupd_fupd; simpl.
-    rewrite coPset_to_Ensemble_minus coPset_to_Ensemble_single; auto. }
-  iMod "H"; iApply fupd_mask_intro; first by set_solver.
-  iIntros "mask".
-  iDestruct "H" as "[$ H]"; iIntros "?".
-  iMod "mask"; iMod ("H" with "[$]"); auto.
-Qed.
-
-Lemma fresh_inv_name n N : ∃ i, (n <= i)%nat /\ Pos.of_nat (S i) ∈ (↑N:coPset).
-Proof.
-  pose proof (coPpick_elem_of (↑ N ∖ gset_to_coPset (list_to_set (map (fun i => Z.to_pos (i + 1)) (upto n))))).
-  rewrite elem_of_difference in H; destruct H as [HN H].
-  { apply coPset_infinite_finite, difference_infinite, gset_to_coPset_finite.
-    apply coPset_infinite_finite, nclose_infinite. }
-  exists (Pos.to_nat (coPpick (↑ N ∖ gset_to_coPset (list_to_set (map (fun i => Z.to_pos (i + 1)) (upto n))))) - 1)%nat; split.
-  - match goal with |-(?a <= ?b)%nat => destruct (le_lt_dec a b); auto; exfalso end.
-    apply H, elem_of_gset_to_coPset, elem_of_list_to_set, elem_of_list_In, in_map_iff.
-    apply Nat2Z.inj_lt in l.
-    setoid_rewrite In_upto; eexists; split; [|split; [|apply l]]; lia.
-  - destruct (eq_dec (coPpick (↑N ∖ gset_to_coPset (list_to_set (map (λ i : Z, Z.to_pos (i + 1)) (upto n))))) 1%positive).
-    + rewrite e in HN |- *; auto.
-    + rewrite -> Nat2Pos.inj_succ, Nat2Pos.inj_sub, Pos2Nat.id, Positive_as_OT.sub_1_r, Pos.succ_pred; auto; lia.
-Qed.
-
-Lemma own_inv_alloc N E P : ▷ P |-- |={E}=> own_inv N P.
-Proof.
-  iIntros "HP".
-  iPoseProof (inv_alloc_strong _ _ (fun i => Pos.of_nat (S i) ∈ (↑N : coPset)) with "HP") as "H";
-    auto using fresh_inv_name.
-Qed.
-
-Global Instance agree_persistent g P : Persistent (agree g P : mpred).
-Proof.
-  apply core_persistent; auto.
-Qed.
-
-Lemma own_inv_to_inv M P: own_inv M P |-- inv M P.
-Proof.
-  iIntros "#I !>". iIntros (E H).
-  iPoseProof (own_inv_acc with "I") as "H"; eauto.
-Qed.
-
-Global Instance inv_persistent N P : Persistent (inv N P).
-Proof.
-  apply _.
-Qed.
-
-Global Instance inv_affine N P : Affine (inv N P).
-Proof.
-  apply _.
-Qed.
-
-Lemma invariant_dup : forall N P, inv N P = (inv N P * inv N P)%logic.
-Proof.
-  intros; apply pred_ext; rewrite <- (bi.persistent_sep_dup (inv N P)); auto.
-Qed.
-
-Lemma agree_join : forall g P1 P2, agree g P1 * agree g P2 |-- (|> P1 -* |> P2) * agree g P1.
-Proof.
-  constructor; apply agree_join.
-Qed.
-
-Lemma agree_join2 : forall g P1 P2, agree g P1 * agree g P2 |-- (|> P1 -* |> P2) * agree g P2.
-Proof.
-  constructor; apply agree_join2.
-Qed.
-
-Lemma inv_alloc : forall N E P, |> P |-- |={E}=> inv N P.
-Proof.
-  intros; iIntros "?"; iApply own_inv_to_inv; iApply own_inv_alloc; auto.
-Qed.
-
-Lemma make_inv : forall N E P Q, (P |-- Q) -> P |-- |={E}=> inv N Q.
-Proof.
-  intros.
-  eapply derives_trans, inv_alloc; auto.
-  eapply derives_trans, now_later; auto.
-Qed.
-
-Global Instance into_inv_inv N P : IntoInv (inv N P) N := {}.
-
-#[export] Instance into_acc_inv N P E:
-  IntoAcc (X := unit) (inv N P)
-          (↑N ⊆ E) emp (updates.fupd E (E ∖ ↑N)) (updates.fupd (E ∖ ↑N) E)
-          (λ _ : (), (▷ P)%I) (λ _ : (), (▷ P)%I) (λ _ : (), None).
-Proof.
-  rewrite /inv /IntoAcc /accessor bi.exist_unit.
-  intros; iIntros "#I _".
-  iMod ("I" with "[%]"); auto.
-Qed.
-
-(* up *)
-Lemma persistently_nonexpansive : nonexpansive persistently.
-Proof.
-  intros; unfold nonexpansive, persistently.
-  intros; split; intros ?????; simpl in *; eapply (H (core a'')); eauto;
-    rewrite level_core; apply necR_level in H1; apply ext_level in H2; lia.
-Qed.
-
-Lemma persistently_nonexpansive2 : forall f, nonexpansive f ->
-  nonexpansive (fun a => persistently (f a)).
-Proof.
-  intros; unfold nonexpansive.
-  intros; eapply predicates_hered.derives_trans; [apply H|].
-  apply persistently_nonexpansive.
-Qed.
-
-Lemma bupd_nonexpansive : nonexpansive own.bupd.
-Proof.
-  unfold nonexpansive, own.bupd; split; simpl; intros;
-    apply H3 in H4 as (? & ? & ? & ? & ? & ? & ?); do 2 eexists; eauto; do 2 eexists; eauto;
-    repeat (split; auto); eapply (H x0); eauto; apply necR_level in H1; apply ext_level in H2; lia.
-Qed.
-
-Lemma bupd_nonexpansive2 : forall f, nonexpansive f ->
-  nonexpansive (fun a => own.bupd (f a)).
-Proof.
-  intros; unfold nonexpansive.
-  intros; eapply predicates_hered.derives_trans; [apply H|].
-  apply bupd_nonexpansive.
-Qed.
-
-Lemma fupd_nonexpansive1 : forall E1 E2, nonexpansive (fupd.fupd E1 E2).
-Proof.
-  unfold fupd.fupd, nonexpansive; intros.
-  apply (contractive.wand_nonexpansive (fun _ => wsat * ghost_set g_en E1)%pred
-    (fun P => (|==> |> predicates_hered.FF || wsat * ghost_set g_en E2 * P)%pred)
-    (const_nonexpansive _)).
-  apply bupd_nonexpansive2, @disj_nonexpansive, sepcon_nonexpansive, identity_nonexpansive; apply const_nonexpansive.
-Qed.
-
-Lemma fupd_nonexpansive2 : forall E1 E2 f, nonexpansive f ->
-  nonexpansive (fun a => fupd.fupd E1 E2 (f a)).
-Proof.
-  intros; unfold nonexpansive.
-  intros; eapply predicates_hered.derives_trans; [apply H|].
-  apply fupd_nonexpansive1.
-Qed.
-
-Lemma later_nonexpansive1 : nonexpansive (box laterM).
-Proof.
-  apply contractive_nonexpansive, later_contractive, identity_nonexpansive.
-Qed.
-
-Lemma inv_nonexpansive : forall N, nonexpansive (inv N).
-Proof.
-  intros; unfold inv.
-  unfold bi_intuitionistically, bi_affinely, bi_persistently; simpl.
-  apply @conj_nonexpansive, persistently_nonexpansive2, @forall_nonexpansive; intros.
-  { apply const_nonexpansive. }
-  apply @impl_nonexpansive, fupd_nonexpansive2, sepcon_nonexpansive, contractive.wand_nonexpansive, fupd_nonexpansive2;
-    try apply later_nonexpansive1; apply const_nonexpansive.
-Qed.
-
-Lemma inv_nonexpansive2 : forall N f, nonexpansive f ->
-  nonexpansive (fun a => inv N (f a)).
-Proof.
-  intros; unfold nonexpansive.
-  intros; eapply predicates_hered.derives_trans; [apply H|].
-  apply inv_nonexpansive.
-Qed.
-
-Global Opaque inv.
diff --git a/concurrency/juicy/Clight_mem_ok.v b/concurrency/juicy/Clight_mem_ok.v
index b0666d6d1d..01e2f60d68 100644
--- a/concurrency/juicy/Clight_mem_ok.v
+++ b/concurrency/juicy/Clight_mem_ok.v
@@ -28,8 +28,6 @@ Require Import BinNums.
 Require Import List. Import ListNotations.
 Require Import VST.msl.Coqlib2.
 
-Set Bullet Behavior "Strict Subproofs".
-
 
 Section GE.
 Variable ge: Clight.genv.
diff --git a/concurrency/juicy/Clight_safety.v b/concurrency/juicy/Clight_safety.v
index ed39879d9d..31f5d4fb00 100644
--- a/concurrency/juicy/Clight_safety.v
+++ b/concurrency/juicy/Clight_safety.v
@@ -34,7 +34,6 @@ Import ListNotations.
 Import ThreadPool.
 Import event_semantics.
 
-Set Bullet Behavior "Strict Subproofs".
 Set Nested Proofs Allowed.
 
 Section Clight_safety_equivalence.
@@ -503,55 +502,6 @@ Proof.
   destruct 1; constructor; auto.
 Qed.
 
-Instance ClightAxioms : @CoreLanguage.SemAxioms (ClightSem ge).
-Proof.
-  constructor.
-  - intros.
-    apply memsem_lemmas.mem_step_obeys_cur_write; auto.
-    eapply corestep_mem; eauto.
-  - intros.
-    apply ev_step_ax2 in H as [].
-    eapply CLC_step_decay; simpl in *; eauto.
-  - intros.
-    apply mem_forward_nextblock, memsem_lemmas.mem_step_forward.
-    eapply corestep_mem; eauto.
-  - intros; simpl.
-    destruct q; auto.
-    right; repeat intro.
-    inv H.
-  - intros.
-    inv Hstep.
-    inv H; simpl.
-    apply memsem_lemmas.mem_step_obeys_cur_write; auto.
-  (* apply memsem_lemmas.mem_step_refl. *)
-    eapply mem_step_alloc; eauto.
-  - intros.
-    inv H.
-    inv H0; simpl.
-    split; intros.
-    + (*contradiction. *)
-      eapply juicy_mem.fullempty_after_alloc in H8.
-      admit. 
-      (* destruct H8; [right|left].
-     
-       should be able to prove that 
-                1. b = Mem.nextblock m
-                which satisfies the goal at all offsets.
-              *)
-        
-    + auto. inv H8.
-      simpl.
-      Transparent Mem.alloc.
-      unfold Mem.alloc; simpl.
-      admit.
-      
-  - intros.
-    inv H.
-    inv H0; simpl.
-    erewrite (Mem.nextblock_alloc _ _ _ _ _ H8).
-    xomega.
-Admitted.
-
 Lemma CoreSafe_star: forall n U tr tp m tid (c : @semC (ClightSem ge)) c' tp' m' ev
   (HschedN: schedPeek U = Some tid)
   (Htid: containsThread tp tid)
diff --git a/concurrency/juicy/JuicyMachineModule.v b/concurrency/juicy/JuicyMachineModule.v
index 138113d0ec..cfa923f307 100644
--- a/concurrency/juicy/JuicyMachineModule.v
+++ b/concurrency/juicy/JuicyMachineModule.v
@@ -1,7 +1,5 @@
 Require Import compcert.common.Memory.
 
-
-Require Import VST.veric.compcert_rmaps.
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.res_predicates.
 
@@ -13,7 +11,7 @@ Require Export VST.concurrency.common.threadPool.
 Require Import VST.concurrency.common.scheduler.
 Require Import VST.concurrency.common.HybridMachineSig.
 Require Import VST.concurrency.juicy.juicy_machine. Import Concur.
-Require Import VST.concurrency.common.HybridMachine. Import Concur.
+(*Require Import VST.concurrency.common.HybridMachine. Import Concur. *)
 Require Import VST.concurrency.common.lksize.
 Require Import VST.concurrency.common.permissions.
 
@@ -31,22 +29,20 @@ Module THE_JUICY_MACHINE.
 
   Context {ge : Clight.genv}.
   Instance JSem : Semantics := ClightSem ge.
-  Definition JMachineSem := MachineSemantics(HybridMachine := HybridCoarseMachine.HybridCoarseMachine(machineSig:=JuicyMachineShell)).
+  Context {Σ : gFunctors}.
+  Definition JMachineSem := MachineSemantics(HybridMachine := HybridCoarseMachine.HybridCoarseMachine(machineSig:=JuicyMachineShell(Σ := Σ))).
   Definition jstate := ThreadPool.t(resources := LocksAndResources)(ThreadPool := OrdinalPool.OrdinalThreadPool).
   Definition jmachine_state := MachState(resources := LocksAndResources)(ThreadPool := OrdinalPool.OrdinalThreadPool).
 
   Import threadPool.ThreadPool.
 
-  (* safety with ghost updates *)
-  Definition tp_update (tp : jstate) phi tp' phi' :=
-    level phi' = level phi /\ resource_at phi' = resource_at phi /\
+  (* safety with ghost updates? *)
+  Definition tp_update (tp : jstate) (phi : rmap) tp' phi' :=
     join_all tp' phi' /\
     exists (Hiff : forall t, containsThread tp' t <-> containsThread tp t),
-      (forall t (cnt : containsThread tp t), getThreadC cnt = getThreadC (proj2 (Hiff _) cnt) /\
-         level (getThreadR cnt) = level (getThreadR (proj2 (Hiff _) cnt)) /\
-         resource_at (getThreadR cnt) = resource_at (getThreadR (proj2 (Hiff _) cnt))) /\
+      (forall t (cnt : containsThread tp t), getThreadC cnt = getThreadC (proj2 (Hiff _) cnt)) /\
       lockGuts tp' = lockGuts tp /\ lockSet tp' = lockSet tp /\
-      lockRes tp' = lockRes tp /\ latestThread tp'= latestThread tp.
+      lockRes tp' = lockRes tp /\ latestThread tp'= latestThread tp /\ extraRes tp' = extraRes tp.
 
   Lemma tp_update_refl : forall tp phi, join_all tp phi -> tp_update tp phi tp phi.
   Proof.
@@ -56,17 +52,54 @@ Module THE_JUICY_MACHINE.
     replace (proj2 _ _) with cnt by apply proof_irr; auto.
   Qed.
 
+  Print bupd.
   Definition tp_bupd P (tp : jstate) :=
   (* Without this initial condition, a thread pool could be vacuously safe by being inconsistent
      with itself or the external environment. Since we want juicy safety to imply dry safety,
      we need to rule out the vacuous case. *)
-  (exists phi, join_all tp phi /\ joins (ghost_of phi) (Some (ghost_PCM.ext_ref tt, NoneP) :: nil)) /\
+  (exists phi, join_all tp phi) /\
+  (* should we provide a level? *)
   forall phi, join_all tp phi ->
-    forall c : ghost, join_sub (Some (ghost_PCM.ext_ref tt, NoneP) :: nil) c ->
-     joins (ghost_of phi) (ghost_fmap (approx (level phi)) (approx (level phi)) c) ->
-     exists b : ghost,
-       joins b (ghost_fmap (approx (level phi)) (approx (level phi)) c) /\
-       exists phi' tp', tp_update tp phi tp' phi' /\ ghost_of phi' = b /\ P tp'.
+    forall c, valid(A := resource_map.rmapUR _ _) (phi ⋅ c) ->
+     exists phi', valid(A := resource_map.rmapUR _ _) (phi' ⋅ c) /\
+       exists tp', tp_update tp phi tp' phi' /\ P tp'.
+
+(*  Definition tp_update_weak (tp tp' : jstate) :=
+    exists (Hiff : forall t, containsThread tp' t <-> containsThread tp t),
+      (forall t (cnt : containsThread tp t), getThreadC cnt = getThreadC (proj2 (Hiff _) cnt) /\
+         level (getThreadR cnt) = level (getThreadR (proj2 (Hiff _) cnt))) /\
+      lockGuts tp' = lockGuts tp /\ lockSet tp' = lockSet tp /\
+      lockRes tp' = lockRes tp /\ latestThread tp'= latestThread tp.
+
+  Lemma tp_update_weak_refl : forall tp, tp_update_weak tp tp.
+  Proof.
+    unshelve eexists; [reflexivity|].
+    split; auto; intros.
+    replace (proj2 _ _) with cnt by apply proof_irr; auto.
+  Qed.
+
+  (* This is the intuitive definition, but it's dubious from a DRF perspective, since it allows
+     threads to transfer writable permissions without a synchronization operation.
+     We might instead need to treat each thread as already holding whatever resources it's going
+     to extract from invariants. Not sure how that will work. *)
+(*  Definition tp_fupd P (tp : jstate) := app_pred invariants.wsat (extraRes tp) /\
+    (tp_level_is 0 tp \/
+     tp_bupd (fun tp1 => exists phi tp2, join_all tp1 phi /\ join_all tp2 phi /\
+       tp_update_weak tp1 tp2 /\ app_pred invariants.wsat (extraRes tp2) /\ P tp2) tp). *)
+
+  (* Try 2: each thread holds the resources it's going to use from the wsat, while extraRes holds the
+     shared ghost state. So a fupd really is just a kind of bupd. *)
+Definition tp_fupd P (tp : jstate) := exists i (cnti : containsThread tp i),
+  exists m r w, join m r (getThreadR cnti) /\ join r (extraRes tp) w /\
+    app_pred (invariants.wsat * invariants.ghost_set invariants.g_en Ensembles.Full_set)%pred w /\
+    (tp_level_is 0 tp \/
+     tp_bupd (fun tp2 => exists (cnti2 : containsThread tp2 i) m2 r2 w2, join m2 r2 (getThreadR cnti2) /\
+       join r2 (extraRes tp2) w2 /\ app_pred (invariants.wsat * invariants.ghost_set invariants.g_en Ensembles.Full_set)%pred w2 /\ P tp2) tp).
+
+  (* Try 3: actually, getThreadR gives the resources the current assertion holds on, so we'd need
+     an extraRes for each thread. But this doesn't solve the fundamental problem: how do we know
+     how to distribute the contents of invariants? *)
+*)
 
   Existing Instance JuicyMachineShell.
   Existing Instance HybridMachineSig.HybridCoarseMachine.DilMem.
diff --git a/concurrency/juicy/cl_step_lemmas.v b/concurrency/juicy/cl_step_lemmas.v
index b7549bf0c9..9438916319 100644
--- a/concurrency/juicy/cl_step_lemmas.v
+++ b/concurrency/juicy/cl_step_lemmas.v
@@ -14,7 +14,7 @@ Require Import compcert.common.Values.
 Require Import VST.msl.Coqlib2.
 Require Import VST.msl.eq_dec.
 Require Import VST.msl.seplog.
-Require Import VST.veric.Clight_new.
+Require Import VST.veric.Clight_core.
 Require Import VST.veric.coqlib4.
 Require Import VST.sepcomp.Address.
 Require Import VST.sepcomp.mem_lemmas.
@@ -26,127 +26,8 @@ Set Bullet Behavior "Strict Subproofs".
 
 Lemma cl_step_decay ge c m c' m' : @cl_step ge c m c' m' -> @decay m m'.
 Proof.
-  intros step.
-  induction step
-    as [ ve te k m a1 a2 b ofs v2 v m' H H0 H1 H2 ASS | |
-         ve te k m optid a al tyagrs tyres cc vf vargs f m'  ve' le' H H0 H1 H2 H3 H4 NRV ALLOC H6
-         | | | | | | | | | f ve te optexp optid k m v' m' ve' te'' k' H H0 FREE H2 H3 | | | ];
-    try apply decay_refl || apply IHstep.
-
-  - (* assign: no change in permission *)
-    intros b' ofs'.
-    split.
-    + inversion ASS as [v0 chunk m'0 H3 BAD H5 H6 | b'0 ofs'0 bytes m'0 H3 H4 H5 H6 H7 BAD H9 H10]; subst.
-      -- pose proof storev_valid_block_2 _ _ _ _ _ BAD b'. tauto.
-      -- pose proof Mem.storebytes_valid_block_2 _ _ _ _ _ BAD b'. tauto.
-    + intros V; right; intros kind.
-      (* destruct m as [c acc nb max no def]. simpl in *. *)
-      inversion ASS as [v0 chunk m'0 H3 STO H5 H6 | b'0 ofs'0 bytes m'0 H3 H4 H5 H6 H7 STO H9 H10]; subst.
-      -- simpl in *.
-         Transparent Mem.store.
-         unfold Mem.store in *; simpl in *.
-         destruct (Mem.valid_access_dec m chunk b (Ptrofs.unsigned ofs) Writable).
-         2:discriminate.
-         injection STO as <-. simpl.
-         reflexivity.
-      -- Transparent Mem.storebytes.
-         unfold Mem.storebytes in *.
-         destruct (Mem.range_perm_dec
-                     m b (Ptrofs.unsigned ofs)
-                     (Ptrofs.unsigned ofs + Z.of_nat (Datatypes.length bytes)) Cur Writable).
-         2:discriminate.
-         injection STO as <-. simpl.
-         reflexivity.
-
-  - (* internal call : allocations *)
-    clear -ALLOC.
-    induction ALLOC. now apply decay_refl.
-    apply decay_trans with m1. 3:apply IHALLOC.
-
-    + clear -H.
-      Transparent Mem.alloc.
-      unfold Mem.alloc in *.
-      injection H as <- <-.
-      intros b V.
-      unfold Mem.valid_block in *. simpl.
-      apply Coqlib.Plt_trans_succ, V.
-
-    + clear -H.
-      unfold Mem.alloc in *.
-      injection H as E <-.
-      intros b ofs.
-      split.
-      * intros N V.
-        subst m1.
-        simpl in *.
-        rewrite PMap.gsspec.
-        unfold Mem.valid_block in *; simpl in *.
-        if_tac; subst; auto.
-        -- simple_if_tac; auto.
-        -- destruct N.
-           apply Coqlib.Plt_succ_inv in V.
-           tauto.
-      * intros V.
-        right.
-        intros k.
-        subst.
-        simpl.
-        rewrite PMap.gsspec.
-        if_tac.
-        -- subst b. inversion V. rewrite Pos.compare_lt_iff in *. edestruct Pos.lt_irrefl; eauto.
-        -- reflexivity.
-
-  - (* return: free_list *)
-    revert FREE; clear.
-    generalize (blocks_of_env ge ve); intros l.
-    revert m m'; induction l as [| [[b o] o'] l IHl]; intros m m'' E.
-    + simpl. injection E as <- ; apply decay_refl.
-    + simpl in E.
-      destruct (Mem.free m b o o') as [m' |] eqn:F.
-      2:discriminate.
-      specialize (IHl _ _ E).
-      Transparent Mem.free.
-      unfold Mem.free in *.
-      if_tac in F. rename H into G.
-      2:discriminate.
-      apply decay_trans with m'. 3:now apply IHl.
-      * injection F as <-.
-        intros.
-        unfold Mem.unchecked_free, Mem.valid_block in *.
-        simpl in *.
-        assumption.
-
-      * injection F as <-.
-        clear -G.
-        unfold Mem.unchecked_free in *.
-        intros b' ofs; simpl. unfold Mem.valid_block; simpl.
-        split.
-        tauto.
-        intros V.
-        rewrite PMap.gsspec.
-        if_tac; auto. subst b'.
-        hnf in G.
-        destruct (Coqlib.proj_sumbool (Coqlib.zle o ofs)&&Coqlib.proj_sumbool (Coqlib.zlt ofs o'))%bool eqn:E.
-        2: now auto.
-        left. split; auto.
-        destruct m as [co acc nb max noa def] eqn:Em; simpl in *.
-        unfold Mem.perm in G; simpl in *.
-        specialize (G ofs).
-        cut (acc !! b ofs Cur = Some Freeable). {
-          destruct k; auto.
-          pose proof Mem.access_max m b ofs as M.
-          subst m; simpl in M.
-          intros A; rewrite A in M.
-          destruct (acc !! b ofs Max) as [ [] | ]; inversion M; auto.
-        }
-        assert (R: (o <= ofs < o')%Z). {
-          rewrite andb_true_iff in *. destruct E as [E F].
-          apply Coqlib.proj_sumbool_true in E.
-          apply Coqlib.proj_sumbool_true in F.
-          auto.
-        }
-        autospec G.
-        destruct (acc !! b ofs Cur) as [ [] | ]; inversion G; auto.
+  intros.
+  eapply (msem_decay (CLC_memsem ge)), H.
 Qed.
 
 Lemma cl_step_unchanged_on ge c m c' m' b ofs :
@@ -156,108 +37,7 @@ Lemma cl_step_unchanged_on ge c m c' m' b ofs :
   Maps.ZMap.get ofs (Maps.PMap.get b (Mem.mem_contents m)) =
   Maps.ZMap.get ofs (Maps.PMap.get b (Mem.mem_contents m')).
 Proof.
-  intros step.
-  induction step
-    as [ ve te k m a1 a2 b0 ofs0 v2 v m' H H0 H1 H2 ASS | |
-         ve te k m optid a al tyagrs tyres cc vf vargs f m'  ve' le' H H0 H1 H2 H3 H4 NRV ALLOC H6
-         | | | | | | | | | f ve te optexp optid k m v' m' ve' te'' k' H H0 FREE H2 H3 | | | ];
-    intros V NW; auto.
-
-  - (* assign: some things are updated, but not the chunk in non-writable permission *)
-    inversion ASS; subst.
-    + inversion H4.
-      unfold Mem.store in *.
-      destruct (Mem.valid_access_dec m chunk b0 (Ptrofs.unsigned ofs0) Writable); [|discriminate].
-      injection H6 as <- ; clear ASS H4.
-      simpl.
-      destruct (eq_dec b b0) as [e|n]; swap 1 2.
-      * rewrite PMap.gso; auto.
-      * subst b0. rewrite PMap.gss.
-        generalize ((Mem.mem_contents m) !! b); intros t.
-        destruct v0 as [v0 align].
-        specialize (v0 ofs).
-        {
-          destruct (adr_range_dec (b, Ptrofs.unsigned ofs0) (size_chunk chunk) (b, ofs)) as [a|a].
-          - simpl in a; destruct a as [_ a].
-            autospec v0.
-            tauto.
-          - simpl in a.
-            symmetry.
-            apply Mem.setN_outside.
-            rewrite encode_val_length.
-            replace (Z_of_nat (size_chunk_nat chunk)) with (size_chunk chunk); swap 1 2.
-            { unfold size_chunk_nat in *. rewrite Z2Nat.id; auto. destruct chunk; simpl; omega. }
-            assert (a' : ~ (Ptrofs.unsigned ofs0 <= ofs < Ptrofs.unsigned ofs0 + size_chunk chunk)%Z) by intuition.
-            revert a'; clear.
-            generalize (Ptrofs.unsigned ofs0).
-            generalize (size_chunk chunk).
-            intros.
-            omega.
-        }
-
-    + (* still the case of assignment (copying) *)
-      unfold Mem.storebytes in *.
-      destruct (Mem.range_perm_dec m b0 (Ptrofs.unsigned ofs0) (Ptrofs.unsigned ofs0 + Z.of_nat (Datatypes.length bytes)) Cur Writable); [ | discriminate ].
-      injection H8 as <-; clear ASS; simpl.
-      destruct (eq_dec b b0) as [e|n]; swap 1 2.
-      * rewrite PMap.gso; auto.
-      * subst b0. rewrite PMap.gss.
-        generalize ((Mem.mem_contents m) !! b); intros t.
-        specialize (r ofs).
-        {
-          destruct (adr_range_dec (b, Ptrofs.unsigned ofs0) (Z.of_nat (Datatypes.length bytes)) (b, ofs)) as [a|a].
-          - simpl in a; destruct a as [_ a].
-            autospec r.
-            tauto.
-          - simpl in a.
-            symmetry.
-            apply Mem.setN_outside.
-            assert (a' : ~ (Ptrofs.unsigned ofs0 <= ofs < Ptrofs.unsigned ofs0 + Z.of_nat (Datatypes.length bytes))%Z) by intuition.
-            revert a'; clear.
-            generalize (Ptrofs.unsigned ofs0).
-            intros.
-            omega.
-        }
-
-  - (* internal call : things are allocated -- each time in a new block *)
-    clear -V ALLOC.
-    induction ALLOC. easy.
-    rewrite <-IHALLOC; swap 1 2.
-    + unfold Mem.alloc in *.
-      injection H as <- <-.
-      unfold Mem.valid_block in *.
-      simpl.
-      apply Plt_trans_succ.
-      auto.
-    + clear IHALLOC.
-      unfold Mem.alloc in *.
-      injection H as <- <- . simpl.
-      f_equal.
-      rewrite PMap.gso. auto.
-      unfold Mem.valid_block in *.
-      auto with *.
-
-  - (* return: free_list *)
-    revert FREE NW V; clear.
-    generalize (blocks_of_env ge ve); intros l.
-    revert m m'; induction l as [| [[b' o] o'] l IHl]; intros m m'' E NW V.
-    + simpl. injection E as <- . easy.
-    + simpl in E.
-      destruct (Mem.free m b' o o') as [m' |] eqn:F.
-      2:discriminate.
-      specialize (IHl _ _ E).
-      unfold Mem.free in *.
-      if_tac in F. 2:discriminate.
-      injection F as <- .
-      rewrite <-IHl. easy.
-      * unfold Mem.perm in *.
-        unfold Mem.unchecked_free.
-        simpl.
-        rewrite PMap.gsspec.
-        if_tac; [ | easy ].
-        subst.
-        unfold Mem.range_perm in *.
-        destruct (zle o ofs); auto.
-        destruct (zlt ofs o'); simpl; auto.
-      * unfold Mem.unchecked_free, Mem.valid_block; simpl. auto.
+  intros.
+  apply (semantics.corestep_mem (CLC_memsem ge)) in H.
+  apply semantics_lemmas.mem_step_obeys_cur_write; auto.
 Qed.
diff --git a/concurrency/juicy/erasure_proof.v b/concurrency/juicy/erasure_proof.v
index bc5976bc14..1221be0efd 100644
--- a/concurrency/juicy/erasure_proof.v
+++ b/concurrency/juicy/erasure_proof.v
@@ -17,7 +17,6 @@ Require Import ProofIrrelevance.
 Require Import compcert.common.Memory.
 
 (* VST imports *)
-Require Import VST.veric.compcert_rmaps.
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.res_predicates.
 
@@ -40,11 +39,10 @@ Require Import VST.concurrency.juicy.erasure_signature.
 (*SSReflect*)
 From mathcomp.ssreflect Require Import ssreflect ssrfun ssrbool ssrnat eqtype seq.
 Require Import Coq.ZArith.ZArith.
-Require Import PreOmega.
+Require Import Lia.
 Require Import VST.concurrency.common.ssromega. (*omega in ssrnat *)
 From mathcomp.ssreflect Require Import ssreflect seq.
 
-Set Bullet Behavior "Strict Subproofs".
 Set Nested Proofs Allowed.
 
 Module Parching <: ErasureSig.
diff --git a/concurrency/juicy/join_lemmas.v b/concurrency/juicy/join_lemmas.v
index c459c31c16..51b71b6fe5 100644
--- a/concurrency/juicy/join_lemmas.v
+++ b/concurrency/juicy/join_lemmas.v
@@ -1,4 +1,4 @@
-Require Import Coq.omega.Omega.
+Require Import Lia.
 Require Import Coq.Setoids.Setoid.
 Require Import Coq.Classes.Morphisms.
 Require Import Coq.Lists.List.
@@ -7,139 +7,11 @@ Require Import Coq.Sorting.Permutation.
 Require Import compcert.lib.Coqlib.
 
 Require Import VST.msl.Coqlib2.
-Require Import VST.msl.seplog.
-Require Import VST.msl.sepalg.
-Require Import VST.msl.age_to.
 Require Import VST.veric.coqlib4.
 Require Import VST.concurrency.common.threadPool.
 
 Set Bullet Behavior "Strict Subproofs".
 
-(** * Results on joining lists and the necessary algebras *)
-
-Fixpoint joinlist {A} {JA : Join A} (l : list A) (x : A) :=
-  match l with
-  | nil => identity x
-  | h :: l => exists y, joinlist l y /\ join h y x
-  end.
-
-(* joinlist is injective (for non-empty lists) *)
-Lemma joinlist_inj {A} {JA : Join A} {PA : Perm_alg A} l r1 r2 :
-  l <> nil ->
-  joinlist l r1 ->
-  joinlist l r2 ->
-  r1 = r2.
-Proof.
-  revert r1 r2; induction l; intros r1 r2 n j1 j2. tauto. clear n.
-  destruct j1 as (r1' & j1 & h1).
-  destruct j2 as (r2' & j2 & h2).
-  destruct l; simpl in *.
-  - apply join_comm in h1; apply join_comm in h2.
-    pose proof join_unit1_e _ _ j1 h1.
-    pose proof join_unit1_e _ _ j2 h2.
-    congruence.
-  - cut (r1' = r2').
-    + intros <-.
-      eapply join_eq; eauto.
-    + eapply IHl; eauto.
-      congruence.
-Qed.
-
-Lemma joinlist_permutation {A} {JA : Join A} {PA : Perm_alg A} l1 l2 r :
-  Permutation l1 l2 ->
-  joinlist l1 r ->
-  joinlist l2 r.
-Proof.
-  intros p; revert r; induction p; intros r; auto.
-  - intros (r' & jl & j).
-    exists r'; split; auto.
-  - simpl.
-    intros (a & (b & jb & ja) & jr).
-    apply join_comm in jr.
-    destruct (join_assoc ja jr) as (d & jd & jr').
-    eauto.
-Qed.
-
-Instance Permutation_length' A {JA : Join A} {PA : Perm_alg A} :
-  Proper (@Permutation A ==> @eq A ==> Logic.iff) joinlist | 10.
-Proof.
-  intros l1 l2 p x y <-; split; apply joinlist_permutation; auto.
-  apply Permutation_sym, p.
-Qed.
-
-Lemma joinlist_app {A} {JA : Join A} {PA : Perm_alg A} l1 l2 x1 x2 x :
-  joinlist l1 x1 ->
-  joinlist l2 x2 ->
-  join x1 x2 x ->
-  joinlist (l1 ++ l2) x.
-Proof.
-  revert l2 x1 x2 x; induction l1; intros l2 x1 x2 x j1 j2 j; simpl in *.
-  - erewrite <-join_unit1_e; eauto.
-  - destruct j1 as (x1' & jl & jx1).
-    destruct (join_assoc jx1 j) as (r & ? & ?).
-    exists r; split; eauto.
-Qed.
-
-Lemma app_joinlist {A} {JA : Join A} {SA : Sep_alg A} {PA : Perm_alg A} l1 l2 x :
-  joinlist (l1 ++ l2) x ->
-  exists x1 x2,
-    joinlist l1 x1 /\
-    joinlist l2 x2 /\
-    join x1 x2 x.
-Proof.
-  revert l2 x; induction l1; intros l2 x j; simpl in *.
-  - exists (core x), x; split.
-    + apply core_identity.
-    + split; auto. apply core_unit.
-  - destruct j as (y & h & ayx).
-    destruct (IHl1 _ _ h) as (x1 & x2 & h1 & h2 & j).
-    apply join_comm in j.
-    apply join_comm in ayx.
-    destruct (join_assoc j ayx) as (r & ? & ?).
-    exists r, x2. eauto.
-Qed.
-
-Lemma joinlist_merge {A} {JA : Join A} {PA : Perm_alg A} (a b c x : A) l :
-  join a b c -> joinlist (a :: b :: l) x <-> joinlist (c :: l) x.
-Proof.
-  intros j; split; intros h; swap 1 2.
-  - destruct h as (rl & hl & jx).
-    destruct (join_assoc j jx) as (bl & jbl & jabx).
-    simpl. eauto.
-  - rename c into ab, x into abc, j into a_b.
-    destruct h as (bc & hl & a_bc).
-    destruct hl as (c & hl & b_c).
-    exists c; split; auto.
-    clear hl l.
-    apply join_comm in b_c.
-    apply join_comm in a_bc.
-    destruct (join_assoc b_c a_bc) as (ab' & a_b' & ab_c).
-    apply join_comm in ab_c.
-    exact_eq ab_c; f_equal.
-    eapply join_eq; eauto.
-Qed.
-
-Lemma joinlist_swap {A} {JA : Join A} {PA : Perm_alg A} (a b x : A) l :
-  joinlist (a :: b :: l) x =
-  joinlist (b :: a :: l) x.
-Proof.
-  apply prop_ext; split; apply joinlist_permutation; constructor.
-Qed.
-
-Lemma joinlist_join_sub {A} {JA : Join A} {PA : Perm_alg A} (x phi : A) l :
-  joinlist l phi ->
-  In x l -> join_sub x phi.
-Proof.
-  revert x phi; induction l; simpl. tauto.
-  intros x phi (b & jb & ab) [-> | i].
-  - exists b; auto.
-  - specialize (IHl _ _ jb i); auto.
-    destruct IHl as (c, xc).
-    apply sepalg.join_comm in ab.
-    destruct (sepalg.join_assoc xc ab) as (d, H).
-    exists d; intuition.
-Qed.
-
 (** * Other list functions *)
 
 Fixpoint listoption_inv {A} (l : list (option A)) : list A :=
@@ -171,7 +43,7 @@ Lemma all_but_app {A} i (l l' : list A) :
 Proof.
   revert l l'; induction i; intros [ | x l ] l' len; simpl; auto.
   all: try solve [inversion len].
-  f_equal. apply IHi. simpl in *; omega.
+  f_equal. apply IHi. simpl in *; lia.
 Qed.
 
 Lemma all_but_map {A B} (f : A -> B) i l :
@@ -231,7 +103,7 @@ Proof.
       transitivity (lt i (List.length l)).
       * rewrite <- IHl; clear IHl.
         simpl. destruct (upd i x l); split; congruence.
-      * simpl; split; omega.
+      * simpl; split; lia.
 Qed.
 
 Lemma upd_app_Some {A} i x (l1 l1' l2 : list A) :
@@ -254,7 +126,7 @@ Lemma upd_app_None {A} i x (l1 l2 : list A) :
   option_map (app l1) (upd (i - List.length l1) x l2).
 Proof.
   revert i; induction l1; intros i.
-  - simpl. intros _. replace (i - 0)%nat with i by omega.
+  - simpl. intros _. replace (i - 0)%nat with i by lia.
     destruct (upd i x l2); auto.
   - destruct i; simpl; intros E. discriminate.
     destruct (upd i x l1) as [o|] eqn:Eo. discriminate.
@@ -267,8 +139,8 @@ Lemma upd_last {A} i l (a x : A) :
   upd i x (l ++ a :: nil) = Some (l ++ x :: nil).
 Proof.
   revert l a x; induction i; intros l a x.
-  - destruct l. reflexivity. simpl. omega.
-  - destruct l. simpl; omega. simpl.
+  - destruct l. reflexivity. simpl. lia.
+  - destruct l. simpl; lia. simpl.
     injection 1 as ->. rewrite IHi; auto.
 Qed.
 
@@ -280,153 +152,25 @@ Proof.
   - destruct i; auto.
   - simpl rev; simpl List.length.
     destruct (eq_dec i (List.length l)).
-    + subst i. simpl. replace (List.length l - 0 - List.length l)%nat with O by omega.
+    + subst i. simpl. replace (List.length l - 0 - List.length l)%nat with O by lia.
       simpl.
       apply upd_last. symmetry. apply List.rev_length.
     + simpl in li.
-      assert (U : (i < List.length l)%nat) by omega.
+      assert (U : (i < List.length l)%nat) by lia.
       pose proof U as Hi.
       rewrite <- List.rev_length in U.
       rewrite <-(upd_lt _ x) in U.
       destruct (upd i x (rev l)) as [o|] eqn:Eo. 2:tauto. clear U.
       specialize (IHl i Hi).
       rewrite Eo in IHl.
-      replace (S (List.length l) - 1 - i)%nat with (S (List.length l - 1 - i)) by omega.
+      replace (S (List.length l) - 1 - i)%nat with (S (List.length l - 1 - i)) by lia.
       simpl.
       destruct (upd (List.length l - 1 - i) x l) as [o'|] eqn:Eo'. 2: discriminate.
       simpl in *.
       apply upd_app_Some. congruence.
 Qed.
 
-Require Import VST.msl.ageable.
-Require Import VST.msl.age_sepalg.
-
-Lemma age_by_overflow {A} {_ : ageable A} {JA: Join A} (x : A) n : le (level x) n -> age_by n x = age_by (level x) x.
-Proof.
-  intros l.
-  replace n with ((n - level x) + level x)%nat by omega.
-  generalize (n - level x)%nat; intros k. clear n l.
-  revert x; induction k; intros x. reflexivity.
-  simpl. rewrite IHk.
-  unfold age1' in *.
-  destruct (age1 (age_by (level x) x)) eqn:E. 2:reflexivity. exfalso.
-  eapply age1_level0_absurd. eauto.
-  rewrite level_age_by. omega.
-Qed.
-
-Lemma age_by_minusminus {A} {_ : ageable A} {JA: Join A} (x : A) n : age_by (level x - (level x - n)) x = age_by n x.
-Proof.
-  assert (D : le (level x) n \/ lt n (level x)). omega.
-  destruct D as [D|D].
-  - replace (level x - (level x - n))%nat with (level x) by omega.
-    symmetry; apply age_by_overflow, D.
-  - f_equal; omega.
-Qed.
-
-Lemma age_by_join {A} {JA: Join A} {PA: Perm_alg A} {agA: ageable A} {AgeA: Age_alg A} :
-  forall k x1 x2 x3,
-    join x1 x2 x3 ->
-    join (age_by k x1) (age_by k x2) (age_by k x3).
-Proof.
-  intros k x1 x2 x3 H.
-  pose proof age_to_join_eq (level x3 - k) x1 x2 x3 H ltac:(omega) as G.
-  pose proof join_level _ _ _ H as [e1 e2].
-  exact_eq G; f_equal; unfold age_to.
-  - rewrite <-e1; apply age_by_minusminus.
-  - rewrite <-e2; apply age_by_minusminus.
-  - apply age_by_minusminus.
-Qed.
-
-(* this generalizes [age_to_join_eq], but we do use [age_to_join_eq] inside this proof *)
-Lemma age_to_join {A} {JA: Join A} {PA: Perm_alg A} {agA: ageable A} {AgeA: Age_alg A} :
-  forall k x1 x2 x3,
-    join x1 x2 x3 ->
-    join (age_to k x1) (age_to k x2) (age_to k x3).
-Proof.
-  intros k x1 x2 x3 J.
-  unfold age_to in *.
-  pose proof age_by_join ((level x1 - k)%nat) _ _ _ J as G.
-  exact_eq G; do 3 f_equal.
-  all: apply join_level in J; destruct J; congruence.
-Qed.
-
-Lemma age_by_joins {A} {JA: Join A} {PA: Perm_alg A} {agA: ageable A} {AgeA: Age_alg A} :
-  forall k x1 x2,
-    joins x1 x2 ->
-    joins (age_by k x1) (age_by k x2).
-Proof.
-  intros k x1 x2 [].
-  eexists; apply age_by_join; eauto.
-Qed.
-
-Lemma age_to_joins {A} {JA: Join A} {PA: Perm_alg A} {agA: ageable A} {AgeA: Age_alg A} :
-  forall k x1 x2,
-    joins x1 x2 ->
-    joins (age_to k x1) (age_to k x2).
-Proof.
-  intros k x1 x2 [].
-  eexists; apply age_to_join; eauto.
-Qed.
-
-Lemma age_to_join_sub {A} {JA: Join A} {PA: Perm_alg A} {agA: ageable A} {AgeA: Age_alg A} :
-  forall k x1 x2,
-    join_sub x1 x2 ->
-    join_sub (age_to k x1) (age_to k x2).
-Proof.
-  intros k x1 x3 [].
-  eexists; apply age_to_join; eauto.
-Qed.
-
-Lemma joinlist_level {A} `{agA : ageable A} {J : Join A} {_ : Perm_alg A} {_ : Age_alg A} (x : A) l Phi :
-  joinlist l Phi ->
-  In x l -> level x = level Phi.
-Proof.
-  intros j i.
-  destruct (joinlist_join_sub x Phi l j i) as (y, Hy).
-  apply join_level in Hy. apply Hy.
-Qed.
-
-Lemma joinlist_age1' {A} `{agA : ageable A} {J : Join A} {_ : Age_alg A} {_ : Perm_alg A} (l : list A) (x : A) :
-  joinlist l x ->
-  joinlist (map age1' l) (age1' x).
-Proof.
-  revert x; induction l; intros x h.
-  - simpl in *. unfold age1'.
-    destruct (age1 x) eqn:E; auto.
-    eapply age_identity. apply E. apply h.
-  - destruct h as (y & h & j).
-    exists (age1' y); split. auto.
-    unfold age1'.
-    destruct (age1 a) eqn:Ea.
-    + destruct (age1_join _ j Ea) as (y' & z' & j' & -> & ->). auto.
-    + rewrite age1_level0 in Ea.
-      pose proof (join_level _ _ _ j).
-      assert (Ex : age1 x = None). apply age1_level0. intuition; congruence.
-      assert (Ey : age1 y = None). apply age1_level0. intuition; congruence.
-      rewrite Ex, Ey. auto.
-Qed.
-
-Lemma joinlist_age_to {A} `{agA : ageable A} {J : Join A} {_ : Age_alg A} {_ : Perm_alg A} n (l : list A) (x : A) :
-  joinlist l x ->
-  joinlist (map (age_to n) l) (age_to n x).
-Proof.
-  intros h.
-  unfold age_to at 2.
-  replace (map (age_to n) l) with (map (age_by (level x - n)) l).
-  - generalize (level x - n)%nat; clear n; intros n; induction n.
-    + exact_eq h; f_equal.
-      induction l; auto. rewrite IHl at 1. reflexivity.
-    + apply joinlist_age1' in IHn.
-      exact_eq IHn; f_equal. clear.
-      induction l; simpl; auto. f_equal; auto.
-  - revert x h; induction l; auto; intros y (x & h & j); simpl.
-    apply join_level in j.
-    f_equal.
-    + unfold age_to. do 2 f_equal. intuition.
-    + rewrite <-IHl with x; auto. do 3 f_equal. intuition.
-Qed.
-
-Require Import VST.veric.compcert_rmaps.
+Require Import VST.veric.res_predicates.
 Require Import VST.concurrency.common.enums_equality.
 Require Import VST.concurrency.juicy.juicy_machine.
 Require Import VST.concurrency.common.HybridMachineSig.
@@ -446,14 +190,14 @@ Set Bullet Behavior "Strict Subproofs".
 
 Section Machine.
 
-Context {ge : Clight.genv}.
+Context {ge : Clight.genv} {Σ : gFunctors}.
 
 Definition getLocksR (tp : jstate ge) := listoption_inv (map snd (AMap.elements (lset tp))).
 
-Definition maps tp := (getThreadsR tp ++ getLocksR tp)%list.
+Definition maps tp := (getThreadsR tp ++ getLocksR tp ++ (extraRes tp :: nil))%list.
 
 Lemma all_but_maps i tp (cnti : containsThread tp i) :
-  all_but i (maps tp) = all_but i (getThreadsR tp) ++ getLocksR tp.
+  all_but i (maps tp) = all_but i (getThreadsR tp) ++ getLocksR tp ++ (extraRes tp :: nil).
 Proof.
   unfold maps. generalize (getLocksR tp); intros l.
   apply all_but_app.
@@ -469,107 +213,6 @@ Proof.
   inversion H; auto.
 Qed.
 
-Lemma join_list_joinlist : join_list = joinlist.
-Proof.
-  extensionality l; induction l; extensionality phi; simpl; auto.
-  f_equal. extensionality r. apply prop_ext.
-  split; intros []; split; auto; simpl in *; congruence.
-Qed.
-
-Lemma join_list'_None l : join_list' l None <-> listoption_inv l = nil.
-Proof.
-  induction l. simpl. split; auto.
-  simpl.
-  split; destruct a as [r|].
-  - intros (r' & j & h). inversion j.
-  - intros (r' & j & h). inversion j; subst; tauto.
-  - congruence.
-  - rewrite <-IHl. intro. exists None; split; auto. constructor.
-Qed.
-
-Lemma join_list'_Some l phi : join_list' l (Some phi) -> joinlist (listoption_inv l) phi.
-Proof.
-  revert phi; induction l; intros phi. simpl. congruence.
-  intros (r & j & h).
-  simpl.
-  destruct a.
-  - inversion j; subst.
-    + apply join_list'_None in h.
-      simpl in *; rewrite h.
-      simpl.
-      exists (core phi).
-      split.
-      * apply core_identity.
-      * apply join_comm, core_unit.
-    + inversion j; subst; simpl; eauto.
-  - inversion j; subst; simpl; eauto.
-Qed.
-
-Lemma join_list'_Some' l phi : listoption_inv l <> nil -> joinlist (listoption_inv l) phi -> join_list' l (Some phi).
-Proof.
-  revert phi; induction l; intros phi. simpl; congruence.
-  destruct a as [r|]; simpl.
-  - intros _ (y & h & j).
-    simpl in *.
-    assert (D:forall l:list rmap, l = nil \/ l <> nil)
-      by (intros []; [left|right]; congruence).
-    destruct (D (listoption_inv l)) as [E|E].
-    + rewrite E in *.
-      rewrite <-join_list'_None in E.
-      exists None; split; auto.
-      simpl in h.
-      pose proof join_unit2_e _ _ h j. subst.
-      constructor.
-    + exists (Some y). split; auto.
-      constructor; auto.
-  - intros n j; specialize (IHl _ n j).
-    exists (Some phi); split; eauto. constructor.
-Qed.
-
-Lemma join_all_joinlist tp : join_all tp = joinlist (maps tp).
-Proof.
-  extensionality phi. apply prop_ext. split.
-  - intros J. inversion J as [? rt rl ? jt jl j]; subst.
-    destruct rl as [rl|].
-    + inversion j; subst.
-      apply joinlist_app with (x1 := rt) (x2 := rl); auto.
-      * rewrite <-join_list_joinlist.
-        apply jt.
-      * apply join_list'_Some.
-        apply jl.
-    + inversion j; subst.
-      rewrite <-join_list_joinlist.
-      apply join_list'_None in jl.
-      unfold maps.
-      cut (join_list (getThreadsR tp ++ nil) phi).
-      { intro H; exact_eq H. f_equal. f_equal. symmetry. apply jl. }
-      rewrite app_nil_r.
-      apply jt.
-  - intros j.
-    unfold maps in j.
-    apply app_joinlist in j.
-    destruct j as (rt & rl & jt & jl & j).
-    set (l' := getLocksR tp).
-    assert (D:l' = nil \/ l' <> nil)
-      by (destruct l'; [left|right]; congruence).
-    destruct D as [D|D].
-    + exists rt None; unfold l' in *; simpl in *.
-      * hnf. rewrite join_list_joinlist. apply jt.
-      * hnf. unfold l' in D.
-        rewrite join_list'_None.
-        simpl in *.
-        rewrite <-D.
-        reflexivity.
-      * rewrite D in jl.
-        simpl in jl.
-        pose proof join_unit2_e _ _ jl j. subst.
-        constructor.
-    + exists rt (Some rl).
-      * hnf. rewrite join_list_joinlist. apply jt.
-      * hnf. apply join_list'_Some'; auto.
-      * constructor; auto.
-Qed.
-
 (** * Results about handling threads' rmaps *)
 
 Lemma seq_pmap_decent {A B} (f : A -> option B) l :
@@ -581,7 +224,7 @@ Qed.
 
 Lemma minus_plus a b c : a - (b + c) = a - b - c.
 Proof.
-  omega.
+  lia.
 Qed.
 
 Lemma nth_error_enum_from n m i Hn Hi :
@@ -594,8 +237,8 @@ Proof.
     + f_equal.
       simpl minus in *.
       revert Hi.
-      rewrite <-minus_n_O in *.
-      rewrite <-minus_n_O in *.
+      rewrite -> Nat.sub_0_r in *.
+      rewrite -> Nat.sub_0_r in *.
       intros Hi.
       simpl.
       f_equal.
@@ -603,7 +246,7 @@ Proof.
       apply proof_irr.
     + simpl minus in *.
       revert Hi.
-      rewrite <-minus_n_O in *.
+      rewrite -> Nat.sub_0_r in *.
       intros Hi.
       simpl.
       unshelve erewrite IHn.
@@ -615,8 +258,10 @@ Proof.
         reflexivity.
       * f_equal.
         rewrite <- Nat.sub_add_distr.
-        reflexivity.
-      * omega.
+        simpl.
+        f_equal.
+        apply proof_irr.
+      * lia.
 Qed.
 
 Lemma nth_error_enum n i pr :
@@ -631,22 +276,22 @@ Proof.
     + pose proof pr as H.
       exact_eq H. do 2 f_equal.
       pose proof (ssrbool.elimT ssrnat.leP pr).
-      omega.
+      lia.
     + match goal with
         |- Some (fintype.Ordinal (n:=n) (m:=n - 1 - (n - i - 1)) ?H) = _ =>
         generalize H
       end.
       pose proof (ssrbool.elimT ssrnat.leP pr).
-      assert (R : (n - 1 - (n - i - 1) = i)%nat) by omega.
-      rewrite R in *.
+      assert (R : (n - 1 - (n - i - 1) = i)%nat) by lia.
+      rewrite -> R in *.
       intros pr'.
       do 2 f_equal.
       apply proof_irr.
     + pose proof (ssrbool.elimT ssrnat.leP pr).
-      omega.
+      lia.
 Qed.
 
-Instance JSem : Semantics := ClightSemanticsForMachines.Clight_newSem ge.
+Instance JSem : Semantics := ClightSemanticsForMachines.ClightSem ge.
 
 Lemma getThreadR_nth i tp cnti :
   nth_error (getThreadsR tp) i = Some (@getThreadR _ _ _ i tp cnti).
@@ -728,59 +373,57 @@ Proof.
     apply (ssrbool.elimT ssrnat.leP cnti).
   }
   rewrite upd_rev; auto.
-  2:now rewrite map_length, length_enum_from; auto.
-  rewrite List.map_length, length_enum_from.
+  2:now rewrite map_length length_enum_from; auto.
+  rewrite List.map_length length_enum_from.
   match goal with
     |- _ = Some (?a ?x) =>
     change (Some (a x)) with (option_map a (Some x))
   end.
   f_equal.
-  Set Printing Implicit.
   generalize (Nat.le_refl n) as pr.
   rename n into m.
   assert (Ei : (i = (m - 1 - (m - 1 - i)))%nat). {
     pose proof (ssrbool.elimT ssrnat.leP cnti).
     rewrite <- !Nat.sub_add_distr, Nat.add_comm, Nat.sub_add_distr.
-    replace (m - (m - (1 + i)))%nat with (S i); omega.
+    replace (m - (m - (1 + i)))%nat with (S i); lia.
   }
   assert (cnti' : is_true (ssrnat.leq (S (m - 1 - (m - 1 - i))) m))
     by congruence.
   replace (@fintype.Ordinal m i cnti)
   with (@fintype.Ordinal m (m - 1 - (m - 1 - i)) cnti')
     by (revert cnti'; rewrite <-Ei; intros; f_equal; apply proof_irr).
-  assert (li' : (m - 1 - i < m)%nat) by (clear -li; omega).
+  assert (li' : (m - 1 - i < m)%nat) by (clear -li; lia).
   clear cnti Ei. revert li' cnti'.
   generalize (m - 1 - i)%nat; clear i li; intros i.
   generalize m at 1 2 4 7 13 14; intros n; revert i.
   induction n; intros i li cnti Hnm. now inversion li.
   match goal with |- _ = Some (map ?F _) => set (f := F) end.
-  Unset Printing Implicit.
   destruct i.
   - simpl.
     f_equal.
     f_equal.
     + unfold f; simpl.
-      rewrite eqtype_refl'. reflexivity. omega.
+      rewrite eqtype_refl'. reflexivity. lia.
     + clear.
       unfold f; clear f. simpl in cnti.
       simpl.
-      revert cnti; replace (n - 0 - 0)%nat with n by omega; intros cnti.
+      revert cnti; replace (n - 0 - 0)%nat with n by lia; intros cnti.
       revert cnti; assert (H : le n n) by auto; revert H.
       generalize n at 2 3 9; intros a la cnta.
       induction n. auto.
       simpl; f_equal.
-      * rewrite eqtype_neq. 2:omega.
+      * rewrite eqtype_neq. 2:lia.
         auto.
-      * unshelve erewrite IHn. 2:omega.
+      * unshelve erewrite IHn. 2:lia.
         auto.
   - simpl.
     erewrite IHn.
-    2:omega.
+    2:lia.
     f_equal.
     f_equal.
     + unfold f.
       simpl.
-      rewrite eqtype_neq. 2:omega.
+      rewrite eqtype_neq. 2:lia.
       reflexivity.
     + unfold f.
       f_equal.
@@ -789,12 +432,12 @@ Proof.
       destruct (eq_dec j (n - 1 - i)%nat).
       * rewrite eqtype_refl'; auto.
         rewrite eqtype_refl'; auto.
-        omega.
+        lia.
       * rewrite eqtype_neq; auto.
         rewrite eqtype_neq; auto.
-        omega.
+        lia.
   Unshelve. (* unshelving at "erewrite IHn." above makes the proof fail *)
-  clear -cnti. exact_eq cnti; do 3 f_equal. omega.
+  clear -cnti. exact_eq cnti; do 3 f_equal. lia.
 Qed.
 
 Lemma updThread_but i tp cnti c phi :
@@ -889,9 +532,8 @@ Lemma maps_getthread i tp cnti :
               (@getThreadR _ _ _ i tp cnti :: all_but i (maps tp)).
 Proof.
   rewrite all_but_maps; auto.
-  transitivity
-    ((getThreadR cnti :: all_but i (getThreadsR tp)) ++ getLocksR tp); auto.
-  rewrite <-getThreadsR_but. reflexivity.
+  match goal with |-context[?a :: ?b ++ ?c] => change (a :: b ++ c) with ((a :: b) ++ c) end.
+  rewrite <- getThreadsR_but; reflexivity.
 Qed.
 
 Lemma maps_updthread i tp cnti c phi :
@@ -915,7 +557,7 @@ Qed.
 Lemma maps_updlock1 (tp : jstate ge) addr :
   maps (updLockSet tp addr None) = maps (remLockSet tp addr).
 Proof.
-  unfold maps; f_equal.
+  unfold maps; do 2 f_equal.
   apply getLocksR_updLockSet_None.
 Qed.
 
@@ -960,28 +602,13 @@ Lemma maps_addthread tp v1 v2 phi :
               (phi :: maps tp).
 Proof.
   unfold maps.
-  change (phi :: getThreadsR tp ++ getLocksR tp)
-  with ((phi :: getThreadsR tp) ++ getLocksR tp).
+  match goal with |-context[?a :: ?b ++ ?c] => change (a :: b ++ c) with ((a :: b) ++ c) end.
   apply Permutation_app_tail.
   rewrite Permutation_cons_append.
   rewrite getThreadsR_addThread.
   apply Permutation_refl.
 Qed.
 
-Lemma maps_age_to i tp :
-  maps (age_tp_to i tp) = map (age_to i) (maps tp).
-Proof.
-  destruct tp as [n th ph ls]; simpl.
-  unfold maps, getThreadsR, getLocksR in *.
-  rewrite map_app.
-  f_equal.
-  - apply map_compose.
-  - unfold lset.
-    rewrite AMap_map.
-    rewrite map_listoption_inv.
-    reflexivity.
-Qed.
-
 Lemma maps_remLockSet_updThread i tp addr cnti c phi :
   maps (remLockSet (@updThread _ _ _ i tp cnti c phi) addr) =
   maps (@updThread _ _ _ i (remLockSet tp addr) cnti c phi).
@@ -989,26 +616,4 @@ Proof.
   reflexivity.
 Qed.
 
-Lemma getThread_level i tp cnti Phi :
-  join_all tp Phi ->
-  level (@getThreadR _ _ _ i tp cnti) = level Phi.
-Proof.
-  intros j.
-  apply juicy_mem.rmap_join_sub_eq_level, compatible_threadRes_sub, j.
-Qed.
-
-Lemma join_sub_level {A} `{JA : sepalg.Join A} `{_ : ageable A} {_ : Perm_alg A} {_ : Age_alg A} :
-  forall x y : A, join_sub x y -> level x = level y.
-Proof.
-  intros x y (z, j).
-  apply (join_level _ _ _ j).
-Qed.
-
-Lemma joins_level {A} `{JA : sepalg.Join A} `{_ : ageable A} {_ : Perm_alg A} {_ : Age_alg A} :
-  forall x y : A, joins x y -> level x = level y.
-Proof.
-  intros x y (z, j).
-  destruct (join_level _ _ _ j); congruence.
-Qed.
-
 End Machine.
diff --git a/concurrency/juicy/juicy_machine.v b/concurrency/juicy/juicy_machine.v
index 3b1ffbe957..826cc528ef 100644
--- a/concurrency/juicy/juicy_machine.v
+++ b/concurrency/juicy/juicy_machine.v
@@ -1,7 +1,8 @@
 Require Import compcert.lib.Axioms.
 
-Require Import VST.msl.age_to.
 Require Import VST.veric.base.
+Require Import VST.veric.shared.
+Require Import VST.veric.res_predicates.
 Require Import VST.concurrency.common.sepcomp. Import SepComp.
 Require Import VST.sepcomp.semantics_lemmas.
 
@@ -16,7 +17,7 @@ Require Import VST.concurrency.common.lksize.
 Require Import VST.concurrency.common.semantics.
 Require Import VST.concurrency.common.permjoin.
 Require Import Coq.Program.Program.
-From mathcomp.ssreflect Require Import ssreflect ssrbool ssrnat ssrfun eqtype seq fintype finfun.
+From mathcomp.ssreflect Require Import ssrbool.
 Set Implicit Arguments.
 
 (*NOTE: because of redefinition of [val], these imports must appear
@@ -31,13 +32,12 @@ Require Import compcert.lib.Coqlib.
 Require Import List.
 Require Import Coq.ZArith.ZArith.
 
-(*From msl get the juice! *)
-Require Import VST.veric.compcert_rmaps.
+Require Import iris.algebra.auth.
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.juicy_mem_lemmas.
+Require Import VST.veric.mpred.
 Require Import VST.veric.juicy_extspec.
 Require Import VST.veric.jstep.
-
 Set Bullet Behavior "Strict Subproofs".
 Set Nested Proofs Allowed.
 
@@ -47,19 +47,20 @@ Set Nested Proofs Allowed.
 Require Import (*compcert_linking*) VST.concurrency.common.permissions VST.concurrency.common.threadPool.
 Import OrdinalPool ThreadPool.
 
-(* There are some overlaping definition conflicting.
+Local Open Scope Z.
+
+(* There are some overlapping definitions conflicting.
    Here we fix that. But this is obviously ugly and
    the conflicts should be removed by renaming!     *)
 Notation "x <= y" := (x <= y)%nat.
 Notation "x < y" := (x < y)%nat.
 
+#[export] Instance LocksAndResources Σ : Resources := { res := iResUR Σ; lock_info := option (iResUR Σ) }.
 
-Instance LocksAndResources : Resources := { res := rmap; lock_info := option rmap }.
-
-Module ThreadPool.
+Module ThreadPool. 
   Section ThreadPool.
 
-  Context {Sem: Semantics}.
+  Context {Sem: Semantics} {Σ : gFunctors}.
 
   (** The Lock Resources Set *)
 
@@ -77,7 +78,7 @@ Module Concur.
     Import event_semantics Events.
 
 
-    Context {Sem: Semantics}.
+    Context {Sem: Semantics} `{!heapGS Σ}.
 
     Notation C:= (semC).
     Notation G:= (semG).
@@ -88,7 +89,7 @@ Module Concur.
     Notation SNone:= (Some None).
 
     (** Memories*)
-    Definition richMem: Type:= juicy_mem.
+    Definition richMem: Type:= @juicy_mem Σ.
     Definition dryMem: richMem -> mem:= m_dry.
 
     (** Environment and Threadwise semantics *)
@@ -102,29 +103,39 @@ Module Concur.
     Notation thread_pool := (@ThreadPool.t _ _ OrdinalThreadPool).
 
     (** Machine Variables*)
-    Definition lp_id : tid:= (0)%nat. (*lock pool thread id*)
+    Definition lp_id : tid := (0)%nat. (*lock pool thread id*)
 
     (** Invariants*)
     (** The state respects the memory*)
-    Definition access_cohere' m phi:= forall loc,
+    Definition contents_cohere m phi := forall loc, contents_cohere m loc (phi @ loc).
+    Definition access_cohere m phi := forall loc, access_cohere m loc (phi @ loc).
+    Definition access_cohere' m phi := forall loc,
         Mem.perm_order'' (max_access_at m loc) (perm_of_res (phi @ loc)).
+    Definition max_access_cohere m phi := forall loc, max_access_cohere m loc (phi @ loc).
+    Definition alloc_cohere m (phi : juicy_mem.rmap) := forall loc, (loc.1 >= Mem.nextblock m)%positive → phi !! loc = None.
 
     (* This is similar to the coherence of juicy memories, *
      * but for entire machines. It is slighly weaker in one way:
      * - acc_coh is looser and only talks about maxcoh.
-     * - alse acc_coh  might me redundant with max_coh IDK... x*)
-    Record mem_cohere' m phi :=
+     * - else acc_coh might be redundant with max_coh IDK... x*)
+    Record mem_cohere m phi :=
       { cont_coh: contents_cohere m phi;
         (*acc_coh: access_cohere m phi;*)
         (*acc_coh: access_cohere' m phi;*)
         max_coh: max_access_cohere m phi;
         all_coh: alloc_cohere m phi
       }.
-    Definition mem_thcohere (tp : thread_pool) m :=
-      forall tid (cnt: containsThread tp tid), mem_cohere' m (getThreadR cnt).
 
-    Definition mem_lock_cohere (ls:lockMap) m:=
-      forall loc rm, AMap.find loc ls = SSome rm -> mem_cohere' m rm.
+    Definition heap_frag phi : mpred := own(inG0 := resource_map.resource_map_inG(resource_mapG := gen_heapGpreS_heap(gen_heapGpreS := gen_heap_inG)))
+      (gen_heap_name _) (◯ phi).
+
+    Definition mem_cohere' n m r := ouPred_holds (∀ phi, heap_frag phi → ⌜mem_cohere m phi⌝) n r.
+
+    Definition mem_thcohere (n : nat) (tp : thread_pool) m :=
+      forall tid (cnt: containsThread tp tid), mem_cohere' n m (getThreadR cnt).
+
+    Definition mem_lock_cohere (n : nat) (ls:lockMap) m:=
+      forall loc rm, AMap.find loc ls = SSome rm -> mem_cohere' n m rm.
 
     Lemma length_enum_from n m pr : List.length (@enums_equality.enum_from n m pr) = n.
     Proof.
@@ -141,13 +152,13 @@ Module Concur.
     Qed.
 
     (*Join juice from all threads *)
-    Definition getThreadsR (tp : thread_pool):=
+    Definition getThreadsR (tp : thread_pool) :=
       map (perm_maps tp) (enums_equality.enum (num_threads tp)).
 
-    Fixpoint join_list (ls: seq.seq res) r:=
+(*    Fixpoint join_list (ls: seq.seq res) r:=
       if ls is phi::ls' then exists r', join phi r' r /\ join_list ls' r' else
-        app_pred emp r.  (*Or is is just [amp r]?*)
-    Definition join_threads (tp : thread_pool) r:= join_list (getThreadsR tp) r.
+        identity r.  (*Or is it just [emp r]?*) *)
+    Definition join_threads (tp : thread_pool) r := r ≡ [^op list] s ∈ getThreadsR tp, s.
 
     Lemma list_nth_error_eq : forall {A} (l1 l2 : list A)
       (Heq : forall j, nth_error l1 j = nth_error l2 j), l1 = l2.
@@ -158,21 +169,40 @@ Module Concur.
       - intro j; specialize (Heq (S j)); auto.
     Qed.
 
-    Lemma nth_error_enum : forall n m (H : (n <= m)%coq_nat) i, i < n ->
-      exists Hlt, nth_error (enum_from H) i = Some (@Ordinal m (n - 1 - i)%coq_nat Hlt).
+    Lemma nth_error_enum : forall n m (H : (n <= m)%nat) i, i < n ->
+      exists Hlt, nth_error (enum_from H) i = Some (@fintype.Ordinal m (n - 1 - i)%nat Hlt).
     Proof.
-      intros ??; induction n; simpl; intros; [ssromega|].
+      intros ??; induction n; simpl; intros; [ssrlia|].
       destruct i; simpl.
-      - replace (n.+1 - 1 - 0)%coq_nat with n by ssromega; eauto.
-      - replace (n.+1 - 1 - i.+1)%coq_nat with (n - 1 - i)%coq_nat by abstract ssromega; eauto.
+      - replace (n - 0 - 0)%nat with n by lia; eauto.
+      - replace (n - 0 - S i)%nat with (n - 1 - i)%nat by abstract ssrlia; eauto.
+        apply IHn; lia.
     Qed.
 
-    Lemma minus_comm : forall a b c, ((a - b)%coq_nat - c = (a - c)%coq_nat - b)%coq_nat.
+    Lemma minus_comm : forall a b c, ((a - b)%nat - c = (a - c)%nat - b)%nat.
     Proof.
       intros.
-      omega.
+      lia.
     Qed.
 
+(* up *)
+Lemma nth_error_rev:
+  forall T (vl: list T) (n: nat),
+   (n < length vl)%nat ->
+  nth_error (rev vl) n = nth_error vl (length vl - n - 1)%nat.
+Proof.
+  induction vl; simpl; intros. apply nth_error_nil.
+  replace (S (length vl) - n - 1)%nat with (length vl - n)%nat by lia.
+  destruct (eq_dec n (length vl)).
+  - subst.
+    rewrite nth_error_app2; rewrite rev_length //.
+    rewrite Nat.sub_diag //.
+  - rewrite nth_error_app1; last by rewrite rev_length; lia.
+    rewrite IHvl; last by lia.
+    destruct (length vl - n)%nat eqn: ?; first by lia.
+    rewrite /= Nat.sub_0_r //.
+Qed.
+
     Lemma getThreadsR_addThread tp v1 v2 phi :
       getThreadsR (addThread tp v1 v2 phi) = getThreadsR tp ++ phi :: nil.
     Proof.
@@ -182,116 +212,108 @@ Module Concur.
       - apply list_nth_error_eq; intro.
         rewrite !list_map_nth.
         destruct (lt_dec j (num_threads tp)).
-        erewrite !initial_world.nth_error_rev by (rewrite length_enum_from; auto).
+        erewrite !nth_error_rev by (rewrite length_enum_from; auto).
         rewrite !length_enum_from.
-        assert (((num_threads tp - j)%coq_nat - 1)%coq_nat < num_threads tp) by ssromega.
+        assert (((num_threads tp - j)%nat - 1)%nat < num_threads tp) by ssrlia.
         repeat match goal with |-context[nth_error (enum_from ?H) ?i] =>
-          destruct (nth_error_enum H i) as [? ->]; auto end; simpl.
-        match goal with |-context[unlift ?a ?b] => destruct (@unlift_some _ a b) as [[] ? Heq] end.
+          destruct (@nth_error_enum _ _ H i) as [? ->]; auto end; simpl.
+        match goal with |-context[fintype.unlift ?a ?b] => destruct (@fintype.unlift_some _ a b) as [[] ? Heq] end.
         { apply eq_true_not_negb.
           rewrite eq_op_false; [discriminate|].
           intro X; inv X.
-          rewrite (Nat.add_sub_eq_l _ _ j) in H1; try omega.
-          rewrite minus_comm Nat.sub_add; auto; omega. }
+          rewrite (Nat.add_sub_eq_l _ _ j) in H1; try lia. }
         rewrite Heq; simpl in *; f_equal; f_equal.
-        apply ord_inj.
+        apply fintype.ord_inj.
         apply unlift_m_inv in Heq; auto.
         { repeat match goal with |-context[nth_error ?l ?i] =>
             destruct (nth_error_None l i) as [_ H];
-            erewrite H by (rewrite rev_length length_enum_from; omega); clear H end; auto. }
+            erewrite H by (rewrite rev_length length_enum_from; lia); clear H end; auto. }
       - unfold ordinal_pos_incr; simpl.
-        replace (introT _ _) with (pos_incr_lt (num_threads tp)) by apply proof_irr.
-        rewrite unlift_none; auto.
+        replace (ssrbool.introT _ _) with (pos_incr_lt (num_threads tp)) by apply proof_irr.
+        rewrite fintype.unlift_none; auto.
     Qed.
 
     (*Join juice from all locks*)
-    Fixpoint join_list' (ls: seq.seq (option res)) (r:option res):=
-      if ls is phi::ls' then exists (r':option res),
-          @join _ (@Join_lower res _) phi r' r /\ join_list' ls' r' else r=None.
-    Definition join_locks tp r:= join_list' (map snd (AMap.elements (lset tp))) r.
+    Definition join_locks tp r := r ≡ [^op list] s ∈ map snd (AMap.elements (lset tp)), (s : optionUR (iResUR Σ)).
 
     (*Join all the juices*)
-    Inductive join_all: thread_pool -> res -> Prop:=
-      AllJuice tp r0 r1 r:
+    Inductive join_all: thread_pool -> res -> Prop :=
+      AllJuice tp r0 r1 r2 r:
         join_threads tp r0 ->
         join_locks tp r1 ->
-        join (Some r0) r1 (Some r) ->
+        (Some r0 : optionUR (iResUR Σ)) ⋅ r1 ≡ Some r2 ->
+        r2 ⋅ (extraRes tp) ≡ r ->
         join_all tp r.
 
-    Definition juicyLocks_in_lockSet (lset : lockMap) (juice: rmap):=
-      forall loc, 
-       (forall i, 0 <= i < LKSIZE -> exists sh psh P, juice @ (fst loc, snd loc + i) = YES sh psh (LK LKSIZE i) P)  ->  
-          AMap.find loc lset.
+    Definition juicyLocks_in_lockSet (n : nat) (lset : lockMap) r :=
+      ouPred_holds (∀ loc P sh, (<absorb> LKspec LKSIZE P sh loc) → ⌜AMap.find loc lset⌝) n r.
 
     (* I removed the NO case for two reasons:
      * - To ensure that lset is "valid" (lr_valid), it needs inherit it from the rmap
      * - there was no real reason to have a NO other than speculation of the future. *)
-    Definition lockSet_in_juicyLocks (lset : lockMap) (juice: rmap):=
-      forall loc, AMap.find loc lset ->
-	     (exists sh, 
-           forall i, 0 <= i < LKSIZE -> exists sh' psh' P, join_sub sh sh' /\ juice @ (fst loc, snd loc + i) = YES sh' psh' (LK LKSIZE i) P).
-
+    Definition lockSet_in_juicyLocks (n : nat) (lset : lockMap) r :=
+      ouPred_holds (∀ loc, ⌜AMap.find loc lset⌝ → <absorb> ∃ sh P, LKspec LKSIZE P sh loc) n r.
 
-    Definition lockSet_in_juicyLocks' (lset : lockMap) (juice: rmap):=
+(*    Definition lockSet_in_juicyLocks' (lset : lockMap) juice :=
       forall loc, AMap.find loc lset ->
-             Mem.perm_order'' (Some Nonempty) (perm_of_res (juice @ loc)).
-    Lemma lockSet_in_juic_weak: forall lset juice,
-        lockSet_in_juicyLocks lset juice -> lockSet_in_juicyLocks' lset juice.
+             Mem.perm_order'' (Some Nonempty) (perm_of_res (resource_at juice loc)).
+    Lemma lockSet_in_juic_weak: forall lset n juice,
+        lockSet_in_juicyLocks lset n juice -> lockSet_in_juicyLocks' lset juice.
     Proof.
       intros lset juice HH loc FIND.
       apply HH in FIND.
       destruct FIND as [sh FIND].
-       specialize (FIND 0). spec FIND. pose proof LKSIZE_pos. omega.
+       specialize (FIND 0). spec FIND. pose proof LKSIZE_pos. lia.
          replace (loc.1, loc.2+0) with loc in FIND.
-       destruct FIND as [sh' [psh' [P [? FIND]]]];   rewrite FIND; simpl.
-       constructor.
-      destruct loc; simpl; f_equal; auto; omega.
+       destruct FIND as [sh' [psh' [? FIND]]]; rewrite /resource_at FIND; simpl.
+       rewrite elem_of_to_agree; if_tac; constructor.
+      destruct loc; simpl; f_equal; auto; lia.
       (*- destruct (eq_dec sh0 Share.bot); constructor.*)
-    Qed.
+    Qed.*)
 
 
     Definition lockSet_Writable (lset : lockMap) m :=
       forall b ofs, AMap.find (b,ofs) lset ->
-               forall ofs0, Intv.In ofs0 (ofs, ofs + LKSIZE)%Z ->
-             Mem.perm_order'' ((Mem.mem_access m)!! b ofs0 Max) (Some Writable) .
-
-    (*This definition makes no sense. In fact if there is at least one lock in rmap,
-     *then the locks_writable is false (because perm_of_res(LK) = Some Nonempty). *)
-    Definition locks_writable (juice: rmap):=
-      forall loc sh psh P z i, juice @ loc = YES sh psh (LK z i) P  ->
-                    Mem.perm_order'' (perm_of_res (juice @ loc)) (Some Writable).
-
-    Record mem_compatible_with' (tp : thread_pool) m all_juice : Prop :=
-      {   juice_join : join_all tp all_juice
-        ; all_cohere : mem_cohere' m all_juice
+               forall ofs0, Intv.In ofs0 (ofs, ofs + LKSIZE) ->
+             Mem.perm_order'' (PMap.get b (Mem.mem_access m) ofs0 Max) (Some Writable) .
+
+    Record mem_compatible_with' (n : nat) (tp : thread_pool) m all_juice : Prop :=
+      {   juice_valid : ✓{n} all_juice
+        ; juice_join : join_all tp all_juice
+        ; all_cohere : mem_cohere' n m all_juice
         ; loc_writable : lockSet_Writable (lockGuts tp) m
-        ; jloc_in_set : juicyLocks_in_lockSet (lockGuts tp) all_juice
-        ; lset_in_juice: lockSet_in_juicyLocks  (lockGuts tp) all_juice
+        ; jloc_in_set : juicyLocks_in_lockSet n (lockGuts tp) all_juice
+        ; lset_in_juice: lockSet_in_juicyLocks n (lockGuts tp) all_juice
       }.
 
     Definition mem_compatible_with := mem_compatible_with'.
 
-    Definition mem_compatible tp m := ex (mem_compatible_with tp m).
+    Lemma mem_compatible_with_valid : forall n tp m phi, mem_compatible_with n tp m phi -> ✓{n} phi.
+    Proof.
+      intros; apply H.
+    Qed.
+
+    Definition mem_compatible n tp m := ex (mem_compatible_with n tp m).
 
     Lemma jlocinset_lr_valid: forall ls juice,
         lockSet_in_juicyLocks ls juice ->
-        lr_valid (AMap.find (elt:=lock_info)^~ (ls)).
+        lr_valid (fun l => AMap.find (elt:=lock_info) l ls).
     Proof.
       simpl; repeat intro.
       destruct (AMap.find (elt:=option rmap) (b, ofs) ls) eqn:MAP; auto.
       intros ofs0 ineq.
       destruct (AMap.find (elt:=option rmap) (b, ofs0) ls) eqn:MAP'; try reflexivity.
         assert (H':=H).
-        specialize (H (b,ofs) ltac:(rewrite MAP; auto)).
+        specialize (H (b,ofs) ltac:(rewrite MAP //)).
         destruct H as [sh H].
-        specialize (H' (b,ofs0) ltac:(rewrite MAP'; auto)).
+        specialize (H' (b,ofs0) ltac:(rewrite MAP' //)).
         destruct H' as [sh' H'].
         exfalso.
         clear - H ineq H'. simpl in *.
-        specialize (H (ofs0-ofs)). spec H. omega.
-        specialize (H' 0). spec H'. omega. replace (ofs0+0) with (ofs+(ofs0-ofs)) in H' by omega.
-         destruct H as [sh0 [psh [P [J H]]]]; destruct H' as [sh0' [psh' [P' [J' H']]]].
-        rewrite H' in H. inv H. omega.
+        specialize (H (ofs0 - ofs)). spec H. lia.
+        specialize (H' 0). spec H'. lia. replace (ofs0+0) with (ofs+(ofs0 - ofs)) in H' by lia.
+         destruct H as [sh0 [psh [J H]]]; destruct H' as [sh0' [psh' [J' H']]].
+        rewrite H' in H. inv H. lia.
     Qed.
 
     Lemma compat_lr_valid: forall js m,
@@ -313,20 +335,20 @@ Module Concur.
       rewrite getMaxPerm_correct.
       specialize (H b).
       (* manual induction *)
-      assert (forall n, (exists ofs0, Intv.In ofs (ofs0, (ofs0 + Z.of_nat n)%Z) /\ lockRes js (b, ofs0)) \/
+      assert (forall n, (exists ofs0, Intv.In ofs (ofs0, (ofs0 + Z.of_nat n)) /\ is_true (lockRes js (b, ofs0))) \/
         (forall ofs0, (ofs0 <= ofs < ofs0 + Z.of_nat n)%Z -> lockRes js (b, ofs0) = None)) as Hdec.
       { clear; induction n.
-        { right; simpl; intros; omega. }
+        { right; simpl; intros; lia. }
         destruct IHn; auto.
         - destruct H as (? & ? & ?); left; eexists; split; eauto.
-          unfold Intv.In, fst, snd in *; zify; omega.
+          unfold Intv.In, fst, snd in *; zify; lia.
         - destruct (lockRes js (b, (ofs - Z.of_nat n)%Z)) eqn: Hres.
-          + left; eexists; split; [|erewrite Hres; auto].
-            unfold Intv.In, fst, snd in *; zify; omega.
+          + left; eexists; split; [|erewrite Hres; done].
+            unfold Intv.In, fst, snd in *; zify; lia.
           + right; intro.
             destruct (eq_dec ofs0 (ofs - Z.of_nat n)%Z); [subst; auto|].
             intro; apply H.
-            zify; omega. }
+            zify; lia. }
       destruct (Hdec LKSIZE_nat) as [(ofs0 & ? & ?)|].
       - erewrite lockSet_spec_2 by eauto.
         simpl in *.
@@ -356,25 +378,25 @@ Module Concur.
     Lemma compat_lt_m: forall m js,
         mem_compatible js m ->
         forall b ofs,
-          Mem.perm_order'' ((getMaxPerm m) !! b ofs)
-                           ((lockSet js) !! b ofs).
+          Mem.perm_order'' (PMap.get b (getMaxPerm m) ofs)
+                           (PMap.get b (lockSet js) ofs).
     Proof. intros. eapply mem_compatible_locks_ltwritable; auto. Qed.
 
 
-    Lemma compatible_lockRes_join:
+(*    Lemma compatible_lockRes_join:
       forall (js : thread_pool) (m : mem),
         mem_compatible js m ->
         forall (l1 l2 : address) (phi1 phi2 : rmap),
           l1 <> l2 ->
           ThreadPool.lockRes js l1 = Some (Some phi1) ->
           ThreadPool.lockRes js l2 = Some (Some phi2) ->
-          joins phi1 phi2.
+          ✓ (phi1 ⋅ phi2).
     Proof. intros ? ? Hcompat; intros ? ? ? ? Hneq; intros.
            destruct Hcompat as [allj Hcompat].
            inversion Hcompat.
            inversion juice_join0; subst.
            unfold join_locks in H2.
-           clear - Hneq H2 H H0. unfold lockRes,lockGuts in H, H0.
+           clear - Hneq H2 H H0.
            apply AMap.find_2 in H. apply AMap.find_2 in H0.
   assert (forall x e, AMap.MapsTo x e (lset js) <->
                SetoidList.InA (@AMap.eq_key_elt lock_info) (x,e) (AMap.elements (lset js))). {
@@ -385,9 +407,10 @@ Module Concur.
   assert (SetoidList.InA (@AMap.eq_key_elt lock_info) (l2, Some phi2) el).
    apply H1; auto.
  clear - H2 H3 H4 Hneq.
+ 
  revert r1 H2 H3 H4; induction el; simpl; intros.
  inv H3.
- destruct H2 as [r2 [? ?]]. destruct a.
+ destruct a.
   assert (H8: joins (Some phi1) (Some phi2));
     [ | destruct H8 as [x H8]; destruct x; inv H8; eauto].
  inv H3; [ | inv H4].
@@ -442,7 +465,7 @@ Qed.
     Definition disjoint_lock_thread tp :=
       forall i loc r (cnti : containsThread tp i),
         lockRes tp loc = SSome r ->
-        joins (getThreadR cnti)r.
+        joins (getThreadR cnti)r.*)
 
     Variant invariant' (tp:t) := True. (* The invariant has been absorbed my mem_compat*)
      (* { no_race : disjoint_threads tp
@@ -457,8 +480,10 @@ Qed.
     (* What follows is the lemmas needed to construct a "personal" memory
        That is a memory with the juice and Cur of a particular thread. *)
 
+    Local Open Scope maps.
+
     Definition mapmap {A B} (def:B) (f:positive -> A -> B) (m:PMap.t A): PMap.t B:=
-      (def, PTree.map f m#2).
+      (def, PTree.map f m.2).
     (* You need the memory, to make a finite tree. *)
     Definition juice2Perm (phi:rmap)(m:mem): access_map:=
       mapmap (fun _ => None) (fun block _ => fun ofs => perm_of_res (phi @ (block, ofs)) ) (getMaxPerm m).
@@ -470,11 +495,11 @@ Qed.
           Proof. unfold isCanonical; reflexivity. Qed.
     Lemma juice2Perm_nogrow: forall phi m b ofs,
         Mem.perm_order'' (perm_of_res (phi @ (b, ofs)))
-                         ((juice2Perm phi m) !! b ofs).
+                         (PMap.get b (juice2Perm phi m) ofs).
     Proof.
       intros. unfold juice2Perm, mapmap, PMap.get.
       rewrite PTree.gmap.
-      destruct (((getMaxPerm m)#2) ! b) eqn: inBounds; simpl.
+      destruct (((getMaxPerm m).2) !! b) eqn: inBounds; simpl.
       - destruct ((perm_of_res (phi @ (b, ofs)))) eqn:AA; rewrite AA; simpl; try reflexivity.
         apply perm_refl.
       - unfold Mem.perm_order''.
@@ -482,11 +507,11 @@ Qed.
     Qed.
     Lemma juice2Perm_locks_nogrow: forall phi m b ofs,
         Mem.perm_order'' (perm_of_res_lock (phi @ (b, ofs)))
-                         ((juice2Perm_locks phi m) !! b ofs).
+                         (PMap.get b (juice2Perm_locks phi m) ofs).
     Proof.
       intros. unfold juice2Perm_locks, mapmap, PMap.get.
       rewrite PTree.gmap.
-      destruct (((getMaxPerm m)#2) ! b) eqn: inBounds; simpl.
+      destruct (((getMaxPerm m).2) !! b) eqn: inBounds; simpl.
       - destruct ((perm_of_res_lock (phi @ (b, ofs)))) eqn:AA; rewrite AA; simpl; try reflexivity.
         apply perm_refl.
       - unfold Mem.perm_order''.
@@ -517,68 +542,79 @@ Qed.
     Qed.
 
     Lemma Mem_canonical_useful: forall m loc k,
-        (Mem.mem_access m)#1 loc k = None.
+        (Mem.mem_access m).1 loc k = None.
     Proof. intros. destruct m; simpl in *.
            unfold PMap.get in nextblock_noaccess.
-           pose (b:= Pos.max (TreeMaxIndex (mem_access#2) + 1 )  nextblock).
-           assert (H1:  ~ Plt b nextblock).
-           { intros H. assert (HH:= Pos.le_max_r (TreeMaxIndex (mem_access#2) + 1) nextblock).
+           pose (b:= Pos.max (TreeMaxIndex (mem_access.2) + 1) nextblock).
+           assert (H1: ~ Plt b nextblock).
+           { intros H. assert (HH:= Pos.le_max_r (TreeMaxIndex (mem_access.2) + 1) nextblock).
              clear - H HH. unfold Pos.le in HH. unfold Plt in H.
              apply HH. eapply Pos.compare_gt_iff.
              auto. }
-           assert (H2 :( b > (TreeMaxIndex (mem_access#2)))%positive ).
-           { assert (HH:= Pos.le_max_l (TreeMaxIndex (mem_access#2) + 1) nextblock).
+           assert (H2 :( b > (TreeMaxIndex (mem_access.2)))%positive ).
+           { assert (HH:= Pos.le_max_l (TreeMaxIndex (mem_access.2) + 1) nextblock).
              apply Pos.lt_gt. eapply Pos.lt_le_trans; eauto.
-             xomega. }
+             lia. }
            specialize (nextblock_noaccess b loc k H1).
            apply max_works in H2. rewrite H2 in nextblock_noaccess.
            assumption.
     Qed.
 
+    Lemma big_opL_In : forall {M : ofe} o {HM : Monoid o} A (f : A -> M) l a, In a l -> exists l', ([^o list] x ∈ l, f x) ≡ o (f a) l'.
+    Proof.
+      induction l; simpl; intros; first done.
+      destruct H as [-> | H]; eauto.
+      edestruct IHl as (l' & Heq); first done.
+      exists (o (f a) l').
+      rewrite monoid_proper; last apply Heq; last done.
+      rewrite !monoid_assoc.
+      apply monoid_proper; last done.
+      apply monoid_comm.
+    Qed.
+
+    Lemma join_list_not_none : forall {A : ora} (a : A) (l : list (option A)), In (Some a) l -> ([^op list] x ∈ l, x) <> None.
+    Proof.
+      intros.
+      eapply (big_opL_In id l) in H as (? & H).
+      rewrite /= Some_op_opM in H.
+      inversion H as [??? Heq|]; rewrite -Heq //.
+    Qed.
+
     Lemma juic2Perm_locks_correct:
       forall r m b ofs,
         max_access_cohere m r ->
-        perm_of_res_lock (r @ (b,ofs)) = (juice2Perm_locks r m) !! b ofs.
+        perm_of_res_lock (r @ (b,ofs)) = PMap.get b (juice2Perm_locks r m) ofs.
     Proof.
         intros.
         unfold juice2Perm_locks, mapmap.
         unfold PMap.get; simpl.
         rewrite PTree.gmap.
         rewrite PTree.gmap1; simpl.
-        destruct ((snd (Mem.mem_access m)) ! b) eqn:search; simpl.
+        destruct ((snd (Mem.mem_access m)) !! b) eqn:search; simpl.
         - auto.
         - generalize (H (b, ofs)) => /po_trans.
           move =>  /(_ (perm_of_res_lock (r @ (b, ofs)))) /(_ (perm_of_res_op2 _)).
           unfold max_access_at. unfold access_at. unfold PMap.get; simpl.
           rewrite search. rewrite Mem_canonical_useful.
-          unfold perm_of_res_lock. destruct ( r @ (b, ofs)); auto.
-          destruct k; auto. simpl.
-          destruct (perm_of_sh (Share.glb Share.Rsh sh)) eqn: HH; auto.
-          intros; exfalso; assumption.
+          destruct (perm_of_res_lock (r @ (b, ofs))); done.
     Qed.
 
     Lemma juic2Perm_correct:
       forall r m b ofs,
         access_cohere' m r ->
-        perm_of_res (r @ (b,ofs)) = (juice2Perm r m) !! b ofs.
+        perm_of_res (r @ (b,ofs)) = PMap.get b (juice2Perm r m) ofs.
     Proof.
         intros.
         unfold juice2Perm, mapmap.
         unfold PMap.get; simpl.
         rewrite PTree.gmap.
         rewrite PTree.gmap1; simpl.
-        destruct ((snd (Mem.mem_access m)) ! b) eqn:search; simpl.
+        destruct ((snd (Mem.mem_access m)) !! b) eqn:search; simpl.
         - auto.
         - generalize (H (b, ofs)).
           unfold max_access_at. unfold access_at. unfold PMap.get; simpl.
           rewrite search. rewrite Mem_canonical_useful.
-          unfold perm_of_res. destruct ( r @ (b, ofs)).
-          destruct (eq_dec sh Share.bot); auto; simpl.
-          intros HH. contradiction HH.
-          destruct k;  try solve [intros HH;inversion HH].
-          destruct (perm_of_sh sh); auto.
-          intros HH;inversion HH.
-          intros HH;inversion HH.
+          destruct (perm_of_res (r @ (b, ofs))); done.
       Qed.
 
     Definition juicyRestrict {phi:rmap}{m:Mem.mem}(coh:access_cohere' m phi): Mem.mem:=
@@ -597,13 +633,13 @@ Qed.
     Lemma juicyRestrictContentCoh: forall phi m (coh:access_cohere' m phi) (ccoh:contents_cohere m phi),
         contents_cohere (juicyRestrict coh) phi.
     Proof.
-      unfold contents_cohere; intros. rewrite <- juicyRestrictContents.
+      unfold contents_cohere, juicy_mem.contents_cohere; intros. rewrite <- juicyRestrictContents.
       eapply ccoh; eauto.
     Qed.
     Lemma juicyRestrictMaxCoh: forall phi m (coh:access_cohere' m phi) (ccoh:max_access_cohere m phi),
         max_access_cohere (juicyRestrict coh) phi.
     Proof.
-      unfold max_access_cohere; intros.
+      unfold max_access_cohere, juicy_mem.max_access_cohere; intros.
       repeat rewrite <- juicyRestrictMax.
       repeat rewrite <- juicyRestrictNextblock.
       apply ccoh.
@@ -623,7 +659,7 @@ Qed.
     Proof.
       intros. unfold juicyRestrict.
       unfold access_at.
-      destruct (restrPermMap_correct (juice2Perm_cohere coh) loc#1 loc#2) as [MAX CUR].
+      destruct (restrPermMap_correct (juice2Perm_cohere coh) loc.1 loc.2) as [MAX CUR].
       unfold permission_at in *.
       rewrite CUR.
       unfold juice2Perm.
@@ -631,12 +667,12 @@ Qed.
       unfold PMap.get.
       rewrite PTree.gmap; simpl.
       destruct ((PTree.map1
-             (fun f : Z -> perm_kind -> option permission => f^~ Max)
-             (Mem.mem_access m)#2) ! (loc#1)) as [VALUE|]  eqn:THING.
+             (fun f ofs => f ofs Max)
+             (Mem.mem_access m).2) !! (loc.1)) as [VALUE|]  eqn:THING.
       - destruct loc; simpl.
         destruct ((perm_of_res (phi @ (b, z)))) eqn:HH; rewrite HH; reflexivity.
       - simpl. rewrite PTree.gmap1 in THING.
-        destruct (((Mem.mem_access m)#2) ! (loc#1)) eqn:HHH; simpl in THING; try solve[inversion THING].
+        destruct (((Mem.mem_access m).2) !! (loc.1)) eqn:HHH; simpl in THING; try solve[inversion THING].
         unfold access_cohere' in coh.
         unfold max_access_at, access_at in coh. unfold PMap.get in coh.
         generalize (coh loc).
@@ -650,24 +686,22 @@ Qed.
     Lemma juicyRestrictAccCoh: forall phi m (coh:access_cohere' m phi),
         access_cohere (juicyRestrict coh) phi.
     Proof.
-      unfold access_cohere; intros.
+      unfold access_cohere, juicy_mem.access_cohere; intros.
       rewrite juicyRestrictCurEq.
-      destruct ((perm_of_res (phi @ loc))) eqn:HH; try rewrite HH; simpl; reflexivity.
+      apply perm_order''_refl.
     Qed.
 
     Lemma po_perm_of_res: forall r,
-       Mem.perm_order''  (perm_of_res' r) (perm_of_res r).
+       Mem.perm_order'' (perm_of_res' r) (perm_of_res r).
     Proof.
-      rewrite /perm_of_res /perm_of_res' => r.
-      destruct r; try solve[ apply po_refl].
-      assert (Mem.perm_order'' (perm_of_sh sh) (Some Nonempty)).
-      { destruct (perm_of_sh sh) eqn:HH; try solve[constructor].
-        apply perm_of_empty_inv in HH; subst sh.
-        exfalso; apply shares.bot_unreadable; eauto. }
-      destruct k; first[ apply po_refl | assumption].
+      rewrite /perm_of_res'; intros (d, r).
+      destruct (perm_of_res_cases d r) as [(? & ? & ->) | (? & ->)]; first apply po_refl.
+      if_tac; first apply po_None.
+      if_tac; first apply po_None.
+      simpl; destruct (perm_of_dfrac d) eqn:HH; try solve [constructor].
+      apply perm_of_dfrac_None in HH as [-> | ->]; done.
     Qed.
 
-
     Lemma max_acc_coh_acc_coh: forall m phi,
         max_access_cohere m phi -> access_cohere' m phi.
     Proof.
@@ -683,215 +717,12 @@ Qed.
     Lemma juicyRestrictAccCoh': forall phi m (coh:max_access_cohere m phi),
         access_cohere (juicyRestrict' coh) phi.
     Proof.
-      unfold access_cohere; intros.
+      unfold access_cohere, juicy_mem.access_cohere; intros.
       rewrite juicyRestrictCurEq.
-      destruct ((perm_of_res (phi @ loc))) eqn:HH; try rewrite HH; simpl; reflexivity.
-    Qed.
-
-    (*Move this to veric.juicy_mem_lemmas.v *)
-    Lemma po_join_sub': forall r1 r2 : resource,
-        join_sub r2 r1 ->
-        Mem.perm_order'' (perm_of_res' r1) (perm_of_res' r2).
-
-      intros r1 r2[r J]; inversion J; subst; simpl.
-      - if_tac.
-        + subst.
-          if_tac.
-          * eauto with *.
-          * apply join_to_bot_l in RJ; subst;
-              congruence.
-        + if_tac; constructor.
-      - destruct k; try solve [constructor].
-        + apply po_join_sub_sh.
-          eexists; eauto.
-        + apply po_join_sub_sh.
-          * eexists; eauto.
-        + apply po_join_sub_sh.
-          * eexists; eauto.
-      - destruct k.
-        + if_tac.
-          * hnf. destruct (perm_of_sh _); apply I.
-          * apply perm_order''_trans with (perm_of_sh sh3).
-            -- apply po_join_sub_sh.
-               ++ eexists; eauto.
-            -- destruct  (perm_of_sh sh3) eqn:E.
-               ++ constructor.
-               ++ pose proof @perm_of_empty_inv _ E; subst.
-                  apply join_to_bot_l in RJ; subst; congruence.
-        + if_tac.
-          * hnf. destruct (perm_of_sh _); apply I.
-          * apply perm_order''_trans with (perm_of_sh sh1).
-            -- apply po_join_sub_sh.
-               ++ eexists; eauto.
-            -- destruct  (perm_of_sh sh1) eqn:E.
-               ++ constructor.
-               ++ pose proof @perm_of_empty_inv _ E; subst; congruence.
-        + if_tac.
-          * hnf. destruct (perm_of_sh _); apply I.
-          * apply perm_order''_trans with (perm_of_sh sh1).
-            -- apply po_join_sub_sh.
-               ++ eexists; eauto.
-            -- destruct  (perm_of_sh sh1) eqn:E.
-               ++ constructor.
-               ++ pose proof @perm_of_empty_inv _ E; subst; congruence.
-      - destruct k; try constructor.
-        + apply po_join_sub_sh; eexists; eauto.
-        + apply po_join_sub_sh; eexists; eauto.
-        + apply po_join_sub_sh; eexists; eauto.
-      - constructor.
-    Qed.
-
-    Lemma mem_access_coh_sub: forall phi1 phi2 m,
-        max_access_cohere m phi1 ->
-        join_sub phi2 phi1 ->
-        max_access_cohere m phi2.
-    Proof.
-      rewrite /max_access_cohere => phi1 phi2 m H H0 loc.
-      eapply po_trans; eauto.
-      eapply po_join_sub'.
-      apply resource_at_join_sub; assumption.
-    Qed.
-
-    Lemma mem_cohere_sub: forall phi1 phi2 m,
-        mem_cohere' m phi1 ->
-        join_sub phi2 phi1 ->
-        mem_cohere' m phi2.
-    Proof.
-      intros. constructor.
-      - unfold contents_cohere; intros.
-        eapply resource_at_join_sub with (l:= loc) in H0.
-        rewrite H1 in H0.
-        inversion H; clear - H0 cont_coh0.
-        destruct H0 as [X H0].
-        inversion H0; subst.
-        + symmetry in H. apply cont_coh0 in H; assumption.
-        + symmetry in H; apply cont_coh0 in H; assumption.
-      (* - intros loc.
-        eapply resource_at_join_sub with (l:= loc) in H0.
-        eapply po_join_sub  in H0.
-        eapply po_trans; eauto.
-        inversion H; auto. *)
-      - inversion H.
-        eapply mem_access_coh_sub; eauto.
-      - unfold alloc_cohere.
-        inversion H. clear - H0 all_coh0.
-        intros loc HH; apply all_coh0 in HH.
-        apply resource_at_join_sub with (l:= loc) in H0.
-        rewrite HH in H0.
-        destruct H0 as [X H0].
-        inversion H0; auto.
-        apply split_identity in RJ; auto.
-        apply identity_share_bot in RJ; subst; auto.
-        f_equal; apply proof_irr.
-    Qed.
-
-    
-    Lemma join_threads_sub:
-      forall js i (cnt:containsThread js i) r0
-        (H0:join_threads js r0),
-        join_sub (getThreadR cnt) r0.
-    Proof.
-      intros.
-      
-      unfold getThreadR. unfold join_threads in H0.
-      unfold getThreadsR in H0.
-      destruct js; simpl in *.
-      pose proof (mem_ord_enum (n:= n num_threads0)).
-
-      specialize (H (Ordinal (n:=n num_threads0) (m:=i) cnt)) .
-      unfold join_list in H0.
-
-      simpl in H0.
-
-
-      replace (enums_equality.enum num_threads0) with (ord_enum (n num_threads0)) in H0.
-      forget (ord_enum (n num_threads0)) as el.
-      forget ((Ordinal (n:=n num_threads0) (m:=i) cnt)) as j.
-      revert H H0; clear; revert r0; induction el; intros. inv H.
-      unfold in_mem in H. unfold pred_of_mem in H. simpl in H.
-      pose proof @orP.
-      specialize (H1 (j == a)(pred_of_eq_seq (T:=ordinal_eqType (n num_threads0)) el j)).
-      destruct ((j == a)
-                || pred_of_eq_seq (T:=ordinal_eqType (n num_threads0)) el j); inv H.
-      inv H1. destruct H.
-      pose proof (@eqP _ j a). destruct (j==a); inv H; inv H1.
-      simpl in H0. destruct H0 as [? [? ?]].
-      exists x; auto.
-      unfold pred_of_eq_seq in H.
-      destruct H0 as [? [? ?]].
-      apply (IHel x) in H; auto. apply join_sub_trans with x; auto. eexists; eauto.
-
-      (*   Lemma ord_enum_enum:
-      forall n,
-        ord_enum n = enum n.
-          Set Printing All.
-    Ad mitted.*)
-      apply ord_enum_enum.
+      apply po_refl.
     Qed.
 
-    Lemma compatible_threadRes_sub:
-      forall js i (cnt:containsThread js i),
-      forall all_juice,
-        join_all js all_juice ->
-        join_sub (getThreadR cnt) all_juice.
-    Proof.
-      intros. inv H.
-      assert (H9: join_sub (Some (getThreadR cnt)) (Some all_juice));
-        [ | destruct H9 as [x H9]; inv H9; [apply join_sub_refl | eexists; eauto]].
-      apply join_sub_trans with (Some r0); [ | eexists; eauto].
-      clear - H0.
-      assert (H9: join_sub (getThreadR cnt) r0) by (eapply join_threads_sub; eauto).
-      destruct H9 as [x H9]; exists (Some x); constructor; auto.
-    Qed.
-    
-    Lemma join_sub_souble_join:
-      forall (a1 b1 c1 a2 b2 c2: rmap),
-        join_sub a1 a2 ->
-        join_sub b1 b2 ->
-        sepalg.join a1 b1 c1 ->
-        sepalg.join a2 b2 c2 ->
-        join_sub c1 c2.
-    Proof.
-      intros.  
-      inv H. inv H0.
-      eapply sepalg.join_comm in H3.
-      pose proof (sepalg.join_assoc H3 H2) as X.
-      destruct X as (x1 & ? & ?).
-      eapply sepalg.join_comm in H.
-      eapply sepalg.join_comm in H0.
-      pose proof (sepalg.join_assoc H H0) as X.
-      destruct X as (x2 & ? & ?).
-      eapply sepalg.join_comm in H5.
-      eapply sepalg.join_comm in H4.
-      eapply sepalg.join_comm in H6.
-      pose proof (sepalg.join_assoc H6 H4) as X.
-      destruct X as (x3 & ? & ?).
-      exists x3.
-      replace c1 with x2; auto.
-      eapply sepalg.join_eq; auto.
-    Qed.
-    
-    Lemma join_list_not_none:
-      forall el l phi x,
-        join_list' (List.map snd el) x ->
-        SetoidList.InA (AMap.eq_key_elt (elt:=option rmap))
-                       (l, Some phi) el ->
-        exists s, x = Some s.
-    Proof.
-      induction el.
-      - intros. inv H0.
-      - intros. destruct H as (?&?&?).
-        inv H0.
-        + inv H3. simpl in *.
-          replace a.2 with (Some phi) in H;
-            inv H;
-            eexists; reflexivity.
-        + exploit IHel; eauto.
-          intros [s HH].
-          subst x0. inv H; eexists; reflexivity.
-    Qed.
-    
-    Lemma compatible_lockRes_sub:
+(*    Lemma compatible_lockRes_sub:
       forall js l (phi:rmap) all_juice,
         join_locks js (Some all_juice) ->
         lockRes(resources:=LocksAndResources) js l = Some (Some phi) ->
@@ -920,7 +751,7 @@ Qed.
           * eapply join_sub_trans.
             eapply IHel; eauto.
             eexists; eauto.
-    Qed.
+    Qed.*)
     Lemma lockres_join_locks_not_none:
       forall js a d_phi,
         lockRes(resources:=LocksAndResources)
@@ -930,26 +761,70 @@ Qed.
       intros.
       apply AMap.find_2 in H. unfold OrdinalPool.lockGuts in *.
       apply AMap.elements_1 in H. simpl in *.
-      intros HH. 
+      intros HH.
       unfold join_locks in HH.
-      exploit join_list_not_none; eauto.
-      intros [? ?]; discriminate.
+      symmetry in HH; rewrite None_equiv_eq in HH.
+      eapply join_list_not_none in HH; first done.
+      apply SetoidList.InA_alt in H as ((?, ?) & (? & ?) & ?); simpl in *; subst.
+      rewrite in_map_iff; eexists (_, _); simpl; eauto.
     Qed.
-    Lemma lock_thread_sub_all_juice:
-      forall js all_juice d_phi phi i Hi a,
-        join_all js all_juice ->
-        lockRes js a = Some (Some d_phi) ->
-        sepalg.join (@getThreadR _ _ _ i js Hi) d_phi phi ->
-        join_sub phi all_juice.
+
+    Lemma mem_cohere_sub: forall (phi1 phi2 : rmap) m, ✓ phi1 ->
+        mem_cohere' m phi1 ->
+        phi2 ≼ phi1 ->
+        mem_cohere' m phi2.
+    Proof.
+      intros ??? Hv [???] H; split.
+      - intros loc.
+        rewrite gmap.lookup_included in H; specialize (H loc).
+        eapply contents_cohere_mono, cont_coh0.
+        by apply resR_le.
+      - intros loc.
+        rewrite gmap.lookup_included in H; specialize (H loc).
+        assert (✓ (phi1 !! loc))%stdpp by done.
+        eapply max_access_cohere_mono, max_coh0; last by apply resR_le.
+        rewrite resR_to_resource_fst; destruct (phi1 !! loc)%stdpp eqn: Hl; rewrite Hl in H0 |- *; try done.
+        by apply dfrac_of'_valid.
+      - intros ? Hout; specialize (all_coh0 _ Hout).
+        rewrite gmap.lookup_included in H; specialize (H loc).
+        apply option_included in H as [? | (? & ? & H1 & ? & ?)]; try done.
+        rewrite all_coh0 // in H.
+    Qed.
+
+    Lemma join_threads_sub:
+      forall js i (cnt:containsThread js i) r0
+        (H0:join_threads js r0),
+        getThreadR cnt ≼ r0.
     Proof.
       intros.
-      inv H. inv H4.
-      - exfalso; eapply lockres_join_locks_not_none; eauto.
-      - eapply join_sub_souble_join; eauto.
-        eapply join_threads_sub; assumption.
-        eapply compatible_lockRes_sub; eassumption.
+      unfold getThreadR. unfold join_threads in H0.
+      unfold getThreadsR in H0.
+      destruct js; simpl in *.
+      pose proof (fintype.mem_ord_enum (n:= n num_threads0) (fintype.Ordinal (n:=n num_threads0) (m:=i) cnt)) as H.
+      rewrite -ord_enum_enum in H0.
+      eapply (cmra_included_proper(A := resource_map.rmapUR _ _)); [done | apply H0 |].
+      edestruct (big_opL_In id (map perm_maps0 (fintype.ord_enum (n num_threads0))) (perm_maps0 (fintype.Ordinal (n:=n num_threads0) (m:=i) cnt))) as (x & ->); last by eexists.
+      rewrite in_map_iff; eexists; split; first done.
+      clear - H.
+      forget (fintype.ord_enum (n num_threads0)) as el.
+      forget (fintype.Ordinal (n:=n num_threads0) (m:=i) cnt) as j.
+      clear - H; induction el; simpl in *; try done.
+      unfold in_mem in H. unfold pred_of_mem in H. simpl in H.
+      destruct (@eqtype.eqP (fintype.ordinal_eqType (n num_threads0)) j a); auto.
     Qed.
 
+    Lemma compatible_threadRes_sub:
+      forall js i (cnt:containsThread js i),
+      forall all_juice,
+        join_all js all_juice ->
+        (getThreadR cnt) ≼ all_juice.
+    Proof.
+      intros. inv H.
+      rewrite -(Some_included_total(A := resource_map.rmapUR _ _)).
+      rewrite -H3 Some_op -H2.
+      etrans; first by apply Some_included_2, join_threads_sub.
+      rewrite -assoc; by eexists.
+    Qed.
 
     Lemma mem_compat_thread_max_cohere {tp m} (compat: mem_compatible tp m):
       forall {i} cnti,
@@ -958,11 +833,17 @@ Qed.
       destruct compat as [x compat] => i cnti loc.
       apply po_trans with (b:= perm_of_res' (x @ loc)).
       - inversion compat. inversion all_cohere0. apply max_coh0.
-      - (*This comes from *)
-        apply po_join_sub'.
-        apply resource_at_join_sub.
-        eapply compatible_threadRes_sub.
-        inversion compat; inversion all_cohere0; assumption.
+      - pose proof (mem_compatible_with_valid compat) as Hv.
+        specialize (Hv loc).
+        apply perm_of_dfrac_mono.
+        { rewrite /resource_at resR_to_resource_fst.
+          destruct (_ !! _)%stdpp; last done.
+          by apply dfrac_of'_valid. }
+        inv compat.
+        apply (compatible_threadRes_sub cnti) in juice_join0.
+        rewrite gmap.lookup_included in juice_join0.
+        specialize (juice_join0 loc).
+        apply resR_le in juice_join0 as (? & ?); done.
     Qed.
 
     Lemma thread_mem_compatible: forall tp m,
@@ -971,30 +852,35 @@ Qed.
     Proof. intros. destruct H as [allj H].
            inversion H.
            unfold mem_thcohere; intros.
+           assert (✓ allj) by (inv juice_join0; done).
            eapply compatible_threadRes_sub  with (cnt:=cnt)in juice_join0.
            eapply mem_cohere_sub; eauto.
     Qed.
 
-    Lemma compatible_lockRes_sub_all: forall js l phi,
-        lockRes js l = Some (Some phi) ->
+    Lemma join_locks_sub: forall js l phi r0
+        (Hl : lockRes js l = Some (Some phi)) (H0 : join_locks js r0),
+        Some phi ≼ r0.
+    Proof.
+      intros.
+      eapply (cmra_included_proper(A := optionR _)); [done..|].
+      apply AMap.find_2 in Hl. unfold OrdinalPool.lockGuts in *.
+      apply AMap.elements_1 in Hl.
+      apply SetoidList.InA_alt in Hl as ((?, ?) & (? & ?) & ?); simpl in *; subst.
+      edestruct (big_opL_In(o := op(A := optionR _)) id (map snd (AMap.elements (elt:=option rmap) (lset js))) (Some phi)) as (x & ->); last by eexists.
+      rewrite in_map_iff; eexists (_, _); simpl; eauto.
+    Qed.
+
+    Lemma compatible_lockRes_sub_all: forall js l phi
+        (Hl : lockRes js l = Some (Some phi)),
         forall all_juice,
           join_all js all_juice ->
-          join_sub phi all_juice.
+          phi ≼ all_juice.
     Proof.
-     intros.
-     inv H0.
-     assert (H9: join_sub (Some phi) (Some all_juice));
-       [ | destruct H9 as [x H9]; inv H9; [apply join_sub_refl | eexists; eauto]].
-     apply join_sub_trans with (b:=r1); [ | eexists; eauto].
-     clear - H H2.
-     hnf in H2. simpl in H. simpl in *.
-     apply AMap.find_2 in H. unfold OrdinalPool.lockGuts in H.
-     apply AMap.elements_1 in H. simpl in *.
-     forget (AMap.elements (elt:= option rmap) (lset js)) as el.
-     revert r1 H2; induction el; simpl; intros. inv H.
-     destruct H2 as [? [? ?]]. destruct a; simpl in *. inv H. inv H3. simpl in *; subst.
-     exists x; auto. apply IHel in H1; auto.
-     apply join_sub_trans with x; auto. exists o; auto.
+     intros. inv H.
+     rewrite -(Some_included_total(A := resource_map.rmapUR _ _)).
+     rewrite -H3 Some_op -H2.
+     etrans; first by eapply join_locks_sub.
+     rewrite (cmra_comm(A := optionR _) _ r1) -assoc; by eexists.
    Qed.
 
     Lemma lock_mem_compatible: forall tp m,
@@ -1003,44 +889,41 @@ Qed.
     Proof. intros.  destruct H as [allj H].
            inversion H.
            unfold mem_thcohere; intros.
-          unfold mem_lock_cohere; intros.
-          eapply compatible_lockRes_sub_all in juice_join0; [|apply H0].
-          eapply mem_cohere_sub; eauto.
+           unfold mem_lock_cohere; intros.
+           assert (✓ allj) by (inv juice_join0; done).
+           eapply compatible_lockRes_sub_all in juice_join0; [|apply H0].
+           eapply mem_cohere_sub; eauto.
     Qed.
 
 
     (* PERSONAL MEM: Is the contents of the global memory,
-       with the juice of a single thread and the Cur that corresponds to that juice.*)
-    Definition acc_coh:= fun m phi pr => @max_acc_coh_acc_coh m phi (max_coh pr).
-    Definition personal_mem {m phi} (pr : mem_cohere' m phi) : juicy_mem:=
-      mkJuicyMem
-        (@juicyRestrict phi m (acc_coh pr))
-        phi
-        (juicyRestrictContentCoh (acc_coh pr) (cont_coh pr))
-        (juicyRestrictAccCoh (acc_coh pr))
-        (juicyRestrictMaxCoh (acc_coh pr) (max_coh pr))
-        (juicyRestrictAllocCoh (acc_coh pr) (all_coh pr)).
-
-    Definition juicy_sem := (FSem.F _ _ JuicyFSem.t) _ the_sem.
+       with the Cur permissions of one thread's rmap.*)
+    Definition acc_coh := fun m phi pr => @max_acc_coh_acc_coh m phi (max_coh pr).
+    Definition personal_mem {m phi} (pr : mem_cohere' m phi) : mem :=
+        (@juicyRestrict phi m (acc_coh pr)).
+
+    (*Definition juicy_sem := (FSem.F _ _ JuicyFSem.t) _ the_sem.*)
     (* Definition juicy_step := (FSem.step _ _ JuicyFSem.t) _ _ the_sem. *)
 
     Program Definition first_phi (tp : thread_pool) : rmap := (@getThreadR _ _ _ 0%nat tp _).
     Next Obligation.
-      unfold OrdinalPool.containsThread.
-      destruct num_threads.
-      simpl.
-      ssromega.
+      intros tp.
+      hnf.
+      destruct num_threads; simpl.
+      apply /ssrnat.leP; lia.
     Defined.
 
-    Program Definition level_tp (tp : thread_pool) := level (first_phi tp).
+(*    Program Definition level_tp (tp : thread_pool) := level (first_phi tp).
 
     Definition tp_level_is_above n tp :=
       (forall i (cnti : containsThread tp i), le n (level (getThreadR cnti))) /\
-      (forall i phi, lockRes(resources:=LocksAndResources) tp i = Some (Some phi) -> le n (level phi)).
+      (forall i phi, lockRes(resources:=LocksAndResources) tp i = Some (Some phi) -> le n (level phi)) /\
+      le n (level (extraRes tp)).
 
     Definition tp_level_is n tp :=
       (forall i (cnti : containsThread tp i), level (getThreadR cnti) = n) /\
-      (forall i phi, lockRes(resources:=LocksAndResources) tp i = Some (Some phi) -> level phi = n).
+      (forall i phi, lockRes(resources:=LocksAndResources) tp i = Some (Some phi) -> level phi = n) /\
+      n = level (extraRes tp).*)
 
     (*
     Lemma mem_compatible_same_level tp m :
@@ -1066,20 +949,20 @@ Qed.
         eapply (DLT _); eauto.
     Qed. *)
 
-    Definition cnt_from_ordinal tp : forall i : ordinal (pos.n (num_threads tp)), containsThread tp i.
+(*    Definition cnt_from_ordinal tp : forall i : fintype.ordinal (pos.n (num_threads tp)), OrdinalPool.containsThread tp i.
       intros [i pr]; apply pr. Defined.
 
     Definition age_tp_to (k : nat) (tp : thread_pool) : thread_pool :=
       match tp with
-        mk n pool maps lset =>
+        mk n pool maps lset ex =>
         mk n pool
            ((age_to k) oo maps)
-           (AMap.map (option_map (age_to k)) lset)
+           (AMap.map (option_map (age_to k)) lset) (age_to k ex)
       end.
 
     Lemma level_age_tp_to tp k : tp_level_is_above k tp -> tp_level_is k (age_tp_to k tp).
     Proof.
-      intros [T L]; split.
+      intros (T & L & R); split3.
       - intros i cnti.
         destruct tp.
         apply level_age_to.
@@ -1092,6 +975,8 @@ Qed.
         simpl in E. injection E as ->.
         apply level_age_to.
         eapply L, IN'.
+      - destruct tp; simpl in *.
+        rewrite level_age_to; auto.
     Qed.
 
     Lemma map_compose {A B C} (g : A -> B) (f : B -> C) l : map (f oo g) l = map f (map g l).
@@ -1104,8 +989,8 @@ Qed.
       join_list l Phi ->
       join_list (map (age_to k) l) (age_to k Phi).
     Proof.
-      revert Phi. induction l as [| phi l IHl]; intros Phi L; simpl.
-      - apply age_to_identy.
+      revert Phi. induction l as [| phi l IHl]; intros Phi L.
+      - unfold join_list, map. apply age_to_identy.
       - intros [a [aphi la]].
         apply IHl in la.
         + exists (age_to k a); split; auto.
@@ -1141,19 +1026,18 @@ Qed.
       join_all tp Phi ->
       join_all (age_tp_to k tp) (age_to k Phi).
     Proof.
-      intros L J. inversion J as [r rT rL r' JT JL JTL]; subst.
+      intros L J. inversion J as [r rT rL r' r'' JT JL JTL JJ]; subst.
       pose (rL' := option_map (age_to k) rL).
-      destruct tp as [N pool phis lset]; simpl in *.
-      eapply AllJuice with (age_to k rT) rL'.
+      destruct tp as [N pool phis lset ex]; simpl in *.
+      eapply AllJuice with (age_to k rT) rL' (age_to k r').
       - {
           hnf in *; simpl in *.
           unfold getThreadsR in *; simpl in *.
           rewrite map_compose.
           apply join_list_age_to; auto.
-          assert (E : level rT = level Phi). {
-            inversion JTL as [ | a H H0 H2 | a1 a2 a3 JJ H H1 H0]; subst. auto.
-            pose proof join_level _ _ _ JJ. intuition. }
-          rewrite E; auto.
+          apply join_level in JJ as [].
+          inv JTL; try ssrlia.
+          apply join_level in H4 as []; ssrlia.
         }
       - hnf.
         hnf in JL. simpl in JL.
@@ -1161,13 +1045,15 @@ Qed.
         rewrite AMap_map.
         apply join_list'_age_to.
         destruct rL as [rL|]; auto.
-        assert (E : level rL = level Phi). {
-          inversion JTL as [ | a H H0 H2 | a1 a2 a3 JJ H H1 H0]; subst. auto.
-          pose proof join_level _ _ _ JJ. intuition. }
-        rewrite E; auto.
+        apply join_level in JJ as [].
+        inv JTL.
+        apply join_level in H4 as []; ssrlia.
       - destruct rL as [rL | ]; unfold rL'.
         + constructor. apply age_to_join_eq; eauto. inversion JTL; eauto.
+          apply join_level in JJ as []; ssrlia.
         + inversion JTL. constructor.
+      - simpl.
+        apply age_to_join_eq; auto.
     Qed.
 
     Lemma perm_of_age rm age loc :
@@ -1200,7 +1086,7 @@ Qed.
       specialize (H loc).
       destruct (rm @ loc) eqn:res.
       - simpl (perm_of_res (NO sh n)).
-        destruct (eq_dec sh Share.bot); auto; constructor.
+        if_tac; auto; constructor.
       - destruct k;
           try (simpl; constructor).
         specialize (H sh r (VAL m) p ltac:(reflexivity) m).
@@ -1215,7 +1101,7 @@ Qed.
       destruct js; auto.
     Qed.
 
-    Lemma cnt_age' {js i age} :
+    Lemma {js i age} :
         containsThread js i ->
         containsThread (age_tp_to age js) i.
     Proof.
@@ -1230,25 +1116,23 @@ Qed.
       destruct tp; simpl.
       f_equal. f_equal.
       apply cnt_irr.
-    Qed.
+    Qed.*)
 
     Inductive juicy_step  {tid0 tp m} (cnt: containsThread tp tid0)
       (Hcompatible: mem_compatible tp m) : thread_pool -> mem -> list mem_event -> Prop :=
     | step_juicy :
-        forall (tp':thread_pool) c jm jm' m' (c' : C),
+        forall (tp':thread_pool) c m1 phi' m' (c' : C),
           forall (Hpersonal_perm:
-               personal_mem (thread_mem_compatible Hcompatible cnt) = jm)
+               personal_mem (thread_mem_compatible Hcompatible cnt) = m1)
             (Hinv : invariant tp)
             (Hthread: getThreadC cnt = Krun c)
-            (Hcorestep: corestep juicy_sem c jm c' jm')
-            (Htp': tp' = @updThread _ _ _ tid0 (age_tp_to (level jm') tp) (cnt_age' cnt) (Krun c') (m_phi jm'))
-            (Hm': m_dry jm' = m'),
-            juicy_step  cnt Hcompatible tp' m' [::].
+            (Hcorestep: corestep the_sem c m1 c' m')
+            (Htp': tp' = @updThread _ _ _ tid0 tp cnt (Krun c') phi') (* can we leave phi' unconstrained? *),
+            juicy_step  cnt Hcompatible tp' m' nil.
 
-    Definition pack_res_inv (R: pred rmap) := SomeP rmaps.Mpred (fun _ => R) .
-  
-    Definition lock_at_least sh R phi b ofs :=
-          forall i, 0 <= i < LKSIZE -> exists sh' rsh', join_sub sh sh' /\ phi@(b,ofs+i) = YES sh' rsh' (LK LKSIZE i) (pack_res_inv R).
+    (* Trying without tracking lock invariants. *)
+    Definition lock_at_least (sh : dfrac) (phi : rmap) b ofs :=
+          forall i, 0 <= i < LKSIZE -> exists sh', sh ≼ sh' /\ (phi @ (b,ofs+i))%stdpp = (sh', Some (LK LKSIZE i)).
 
 
     Notation Kblocked := (threadPool.Kblocked).
@@ -1257,21 +1141,20 @@ Qed.
               (cnt0:containsThread tp tid0)(Hcompat:mem_compatible tp m):
       thread_pool -> mem -> sync_event -> Prop :=
     | step_acquire :
-        forall (tp' tp'' tp''':thread_pool) c m0 m1 b ofs d_phi phi phi' m' pmap_tid',
+        forall (tp' tp'':thread_pool) c m0 m1 b ofs d_phi phi phi' m' pmap_tid',
           forall
             (Hinv : invariant tp)
             (Hthread: getThreadC cnt0 = Kblocked c)
             (Hat_external: at_external the_sem c m =
                            Some (LOCK, Vptr b ofs::nil))
-            (Hcompatible: mem_compatible tp m)
             (*Hpersonal_perm:
                personal_mem cnt0 Hcompatible = jm*)
             (Hpersonal_juice: getThreadR cnt0 = phi)
-            (sh:Share.t)(R:pred rmap)
-            (HJcanwrite: lock_at_least sh R phi b (Ptrofs.intval ofs))
+            sh
+            (HJcanwrite: lock_at_least sh phi b (Ptrofs.intval ofs))
             (Hrestrict_map0: juicyRestrict_locks
                               (mem_compat_thread_max_cohere Hcompat cnt0) = m0)
-            (Hload: Mem.load Mint32 m0 b (Ptrofs.intval ofs) = Some (Vint Int.one))
+            (Hload: Mem.load Mptr m0 b (Ptrofs.intval ofs) = Some (Vptrofs Ptrofs.one))
             (*Hrestrict_pmap:
                permissions.restrPermMap
                  (mem_compatible_locks_ltwritable Hcompatible)
@@ -1282,29 +1165,27 @@ Qed.
             (* This following condition is not needed:
                It should follow from the mem_compat statement... somehow... *)
             (Hrestrict_pmap: restrPermMap Hlt' = m1)
-            (Hstore: Mem.store Mint32 m1 b (Ptrofs.intval ofs) (Vint Int.zero) = Some m')
-            (His_unlocked: lockRes tp (b, Ptrofs.intval ofs) = SSome d_phi )
-            (Hadd_lock_res: join phi d_phi phi')
+            (Hstore: Mem.store Mptr m1 b (Ptrofs.intval ofs) (Vptrofs Ptrofs.zero) = Some m')
+            (His_unlocked: lockRes tp (b, Ptrofs.intval ofs) = SSome d_phi)
+            (Hadd_lock_res: phi' = phi ⋅ d_phi)
             (Htp': tp' = updThread cnt0 (Kresume c Vundef) phi')
-            (Htp'': tp'' = updLockSet tp' (b, Ptrofs.intval ofs) None )
-            (Htp''': tp''' = age_tp_to (level phi - 1)%coq_nat tp''),
-            syncStep' cnt0 Hcompat tp''' m' (acquire (b, Ptrofs.intval ofs) None)
+            (Htp'': tp'' = updLockSet tp' (b, Ptrofs.intval ofs) None),
+            syncStep' cnt0 Hcompat tp'' m' (acquire (b, Ptrofs.intval ofs) None)
     | step_release :
-        forall  (tp' tp'' tp''':thread_pool) c m0 m1 b ofs  (phi d_phi :rmap) (R: pred rmap) phi' m' pmap_tid',
+        forall  (tp' tp'':thread_pool) c m0 m1 b ofs  (phi d_phi :rmap) phi' m' pmap_tid',
           forall
             (Hinv : invariant tp)
             (Hthread: getThreadC cnt0 = Kblocked c)
             (Hat_external: at_external the_sem c m =
                            Some (UNLOCK, Vptr b ofs::nil))
-            (Hcompatible: mem_compatible tp m)
             (* Hpersonal_perm:
                personal_mem cnt0 Hcompatible = jm *)
             (Hpersonal_juice: getThreadR cnt0 = phi)
-            (sh:Share.t) 
-            (HJcanwrite: lock_at_least sh R phi b (Ptrofs.intval ofs))
+            sh 
+            (HJcanwrite: lock_at_least sh phi b (Ptrofs.intval ofs))
             (Hrestrict_map0: juicyRestrict_locks
                               (mem_compat_thread_max_cohere Hcompat cnt0) = m0)
-            (Hload: Mem.load Mint32 m0 b (Ptrofs.intval ofs) = Some (Vint Int.zero))
+            (Hload: Mem.load Mptr m0 b (Ptrofs.intval ofs) = Some (Vptrofs Ptrofs.zero))
             (*Hrestrict_pmap:
                permissions.restrPermMap
                  (mem_compatible_locks_ltwritable Hcompatible)
@@ -1315,92 +1196,77 @@ Qed.
             (* This following condition is not needed:
                It should follow from the mem_compat statement... somehow... *)
             (Hrestrict_pmap: restrPermMap Hlt' = m1)
-            (Hstore: Mem.store Mint32 m1 b (Ptrofs.intval ofs) (Vint Int.one) = Some m')
+            (Hstore: Mem.store Mptr m1 b (Ptrofs.intval ofs) (Vptrofs Ptrofs.one) = Some m')
             (His_locked: lockRes tp (b, Ptrofs.intval ofs) = SNone )
-            (Hsat_lock_inv: R (age_by 1 d_phi))
-            (Hrem_lock_res: join d_phi phi' phi)
+            (Hrem_lock_res: phi = d_phi ⋅ phi')
             (Htp': tp' = updThread cnt0 (Kresume c Vundef) phi')
             (Htp'': tp'' =
-                    updLockSet tp' (b, Ptrofs.intval ofs) (Some d_phi))
-            (Htp''': tp''' = age_tp_to (level phi - 1)%coq_nat tp''),
-            syncStep' cnt0 Hcompat tp''' m' (release (b, Ptrofs.intval ofs) None)
+                    updLockSet tp' (b, Ptrofs.intval ofs) (Some d_phi)),
+            syncStep' cnt0 Hcompat tp'' m' (release (b, Ptrofs.intval ofs) None)
     | step_create :
-        forall  (tp_upd tp':thread_pool) c vf arg jm (d_phi phi': rmap) b ofs (* P Q *),
+        forall  (tp_upd tp':thread_pool) c vf arg (d_phi phi': rmap) b ofs (* P Q *),
           forall
             (Hinv : invariant tp)
             (Hthread: getThreadC cnt0 = Kblocked c)
             (Hat_external: at_external the_sem c m =
                            Some (CREATE, vf::arg::nil))
-            (Harg: Val.inject (Mem.flat_inj (Mem.nextblock m)) arg arg)
+(*            (Harg: Val.inject (Mem.flat_inj (Mem.nextblock m)) arg arg) *)
             (Hfun_sepc: vf = Vptr b ofs)
-            (Hcompatible: mem_compatible tp m)
-            (Hpersonal_perm:
-               personal_mem (thread_mem_compatible Hcompatible cnt0) = jm)
-            (Hrem_fun_res: join d_phi phi' (m_phi jm))
+            (Hrem_fun_res: getThreadR cnt0 = d_phi ⋅ phi')
             (Htp': tp_upd = updThread cnt0 (Kresume c Vundef) phi')
-            (Htp'': tp' = age_tp_to (level (m_phi jm) - 1)%coq_nat (addThread tp_upd vf arg d_phi)),
+            (Htp'': tp' = addThread tp_upd vf arg d_phi),
             syncStep' cnt0 Hcompat tp' m (spawn (b, Ptrofs.intval ofs) None None)
     | step_mklock :
-        forall  (tp' tp'': thread_pool)  jm c b ofs R ,
-          let: phi := m_phi jm in
+        forall  (tp' tp'': thread_pool) m c b ofs,
           forall
             phi' m'
             (Hinv : invariant tp)
             (Hthread: getThreadC cnt0 = Kblocked c)
             (Hat_external: at_external the_sem c m =
                            Some (MKLOCK, Vptr b ofs::nil))
-            (Hcompatible: mem_compatible tp m)
             (*Hright_juice:  m = m_dry jm*)
             (Hpersonal_perm:
-               personal_mem (thread_mem_compatible Hcompatible cnt0) = jm)
-            (Hpersonal_juice: getThreadR cnt0 = phi)
+               personal_mem (thread_mem_compatible Hcompat cnt0) = m)
             (*Check I have the right permission to mklock and the right value (i.e. 0) *)
             (*Haccess: address_mapsto LKCHUNK (Vint Int.zero) sh Share.top (b, Ptrofs.intval ofs) phi*)
             (Hstore:
-               Mem.store Mint32 (m_dry jm) b (Ptrofs.intval ofs) (Vint Int.zero) = Some m')
+               Mem.store Mptr m b (Ptrofs.intval ofs) (Vptrofs Ptrofs.zero) = Some m')
             (* [Hrmap] replaced: [Hct], [Hlock], [Hj_forward] and [levphi'].
                This says that phi and phi' coincide everywhere except in adr_range,
                and specifies how phi and phi' should differ in adr_range
                (in particular, they have equal shares, pointwise) *)
-            (Hrmap : rmap_makelock phi phi' (b, Ptrofs.unsigned ofs) R LKSIZE)
+            (Hrmap : rmap_makelock (getThreadR cnt0) phi' (b, Ptrofs.unsigned ofs) LKSIZE)
             (Htp': tp' = updThread cnt0 (Kresume c Vundef) phi')
-            (Htp'': tp'' = age_tp_to (level phi - 1)%coq_nat
-                    (updLockSet tp' (b, Ptrofs.intval ofs) None )),
+            (Htp'': tp'' = updLockSet tp' (b, Ptrofs.intval ofs) None),
             syncStep' cnt0 Hcompat tp'' m' (mklock (b, Ptrofs.intval ofs))
     | step_freelock :
-        forall  (tp' tp'': thread_pool) c b ofs phi R phi',
+        forall  (tp' tp'': thread_pool) c b ofs phi phi',
           forall
             (Hinv : invariant tp)
             (Hthread: getThreadC cnt0 = Kblocked c)
             (Hat_external: at_external the_sem c m =
                            Some (FREE_LOCK, Vptr b ofs::nil))
-            (Hcompatible: mem_compatible tp m)
             (Hpersonal_juice: getThreadR cnt0 = phi)
             (*First check the lock is acquired:*)
             (His_acq: lockRes tp (b, (Ptrofs.intval ofs)) = SNone)
             (*Relation between rmaps:*)
-            (Hrmap : rmap_freelock phi phi' m (b, Ptrofs.unsigned ofs) R LKSIZE)
+            (Hrmap : rmap_freelock phi phi' m (b, Ptrofs.unsigned ofs) LKSIZE)
             (Htp': tp' = updThread cnt0 (Kresume c Vundef) phi')
-            (Htp'': tp'' = age_tp_to (level phi - 1)%coq_nat
-                    (remLockSet tp' (b, Ptrofs.intval ofs) )),
+            (Htp'': tp'' = remLockSet tp' (b, Ptrofs.intval ofs)),
             syncStep' cnt0 Hcompat  tp'' m (freelock (b, Ptrofs.intval ofs))
 
     | step_acqfail :
-        forall  c b ofs jm m1,
-          let: phi := m_phi jm in
+        forall c b ofs m1,
           forall
             (Hinv : invariant tp)
             (Hthread: getThreadC cnt0 = Kblocked c)
             (Hat_external: at_external the_sem c m =
                            Some (LOCK, Vptr b ofs::nil))
-            (Hcompatible: mem_compatible tp m)
-            (Hpersonal_perm:
-               personal_mem (thread_mem_compatible Hcompatible cnt0) = jm)
             (Hrestrict_map: juicyRestrict_locks
                               (mem_compat_thread_max_cohere Hcompat cnt0) = m1)
-            (sh:Share.t) (R:pred rmap)
-            (HJcanwrite: lock_at_least sh R phi b (Ptrofs.intval ofs))
-            (Hload: Mem.load Mint32 m1 b (Ptrofs.intval ofs) = Some (Vint Int.zero)),
+            sh
+            (HJcanwrite: lock_at_least sh (getThreadR cnt0) b (Ptrofs.intval ofs))
+            (Hload: Mem.load Mptr m1 b (Ptrofs.intval ofs) = Some (Vptrofs Ptrofs.zero)),
             syncStep' cnt0 Hcompat tp m (failacq (b,Ptrofs.intval ofs)).
 
     Definition threadStep : forall {tid0 ms m},
@@ -1430,23 +1296,17 @@ Qed.
       - intros [cntj [ q running]].
         inversion H; subst.
         assert (cntj':=cntj).
-        eapply cnt_age' in cntj'.
-        eapply (cntUpdate(resources := LocksAndResources) (Krun c') (m_phi jm') (cnt_age' cntj)) in cntj'.
+        eapply (cntUpdate(resources := LocksAndResources) (Krun c') phi' cntj) in cntj'.
         exists cntj'.
         destruct (NatTID.eq_tid_dec i j).
         + subst j; exists c'.
           rewrite gssThreadCode; reflexivity.
         + exists q.
           rewrite gsoThreadCode; auto.
-          generalize running; destruct tp; simpl.
-          intros RUN; rewrite <- RUN.
-          f_equal. f_equal.
-          apply cnt_irr.
       - intros [cntj' [ q' running]].
         inversion H; subst.
         assert (cntj:=cntj').
-        eapply cnt_age in cntj.
-        eapply cntUpdate' with(c0:=Krun c')(p:=m_phi jm') in cntj; eauto.
+        eapply cntUpdate' with(c:=Krun c')(p:=phi') in cntj; eauto.
         exists cntj.
         destruct (NatTID.eq_tid_dec i j).
         + subst j; exists c.
@@ -1455,10 +1315,6 @@ Qed.
           apply cnt_irr.
         + exists q'.
           rewrite gsoThreadCode in running; auto.
-          rewrite <- running.
-          destruct tp; simpl.
-          f_equal. f_equal.
-          apply cnt_irr.
     Qed.
 
     Definition syncStep (isCoarse:bool) :
@@ -1486,24 +1342,19 @@ Qed.
           end.
       + (*this should be easy to automate or shorten*)
         inversion H; subst.
-        * exists (cnt_age' (cntUpdateL _ _ (cntUpdate (Kresume c Vundef) phi' _ cntj))), q.
-          erewrite <- age_getThreadCode.
+        * exists ((cntUpdateL _ _ (cntUpdate (Kresume c Vundef) (getThreadR cnt ⋅ d_phi) _ cntj))), q.
           rewrite gLockSetCode.
           rewrite gsoThreadCode; assumption.
-        * exists (cnt_age' (cntUpdateL _ _ (cntUpdate(resources:=LocksAndResources) (Kresume c Vundef) phi' _ cntj))), q.
-          erewrite <- age_getThreadCode.
+        * exists ((cntUpdateL _ _ (cntUpdate(resources:=LocksAndResources) (Kresume c Vundef) phi' _ cntj))), q.
           rewrite gLockSetCode.
           rewrite gsoThreadCode; assumption.
-        * exists (cnt_age' (cntAdd _ _ _ (cntUpdate(resources:=LocksAndResources) (Kresume c Vundef) phi' _ cntj))), q.
-          erewrite <- age_getThreadCode.
+        * exists ((cntAdd _ _ _ (cntUpdate(resources:=LocksAndResources) (Kresume c Vundef) phi' _ cntj))), q.
           erewrite gsoAddCode . (*i? *)
           rewrite gsoThreadCode; assumption.
-        * exists (cnt_age' (cntUpdateL _ _ (cntUpdate(resources:=LocksAndResources) (Kresume c Vundef) phi' _ cntj))), q.
-          erewrite <- age_getThreadCode.
+        * exists ((cntUpdateL _ _ (cntUpdate(resources:=LocksAndResources) (Kresume c Vundef) phi' _ cntj))), q.
           rewrite gLockSetCode.
           rewrite gsoThreadCode; assumption.
-        * exists (cnt_age' (cntRemoveL _ (cntUpdate(resources:=LocksAndResources) (Kresume c Vundef) phi' _ cntj))), q.
-          erewrite <- age_getThreadCode.
+        * exists ((cntRemoveL _ (cntUpdate(resources:=LocksAndResources) (Kresume c Vundef) phi' _ cntj))), q.
           rewrite gRemLockSetCode.
           rewrite gsoThreadCode; assumption.
         * exists cntj, q; assumption.
@@ -1511,14 +1362,12 @@ Qed.
       destruct (NatTID.eq_tid_dec i j).
       + subst j. generalize running; clear running.
         inversion H; subst;
-        try erewrite <- age_getThreadCode;
           try rewrite gLockSetCode;
           try rewrite gRemLockSetCode;
           try rewrite gssThreadCode;
           try solve[intros HH; inversion HH].
         { (*addthread*)
           assert (cntj':=cntj).
-          eapply cnt_age in cntj'.
           eapply cntAdd' in cntj'. destruct cntj' as [ [HH HHH] | HH].
           * erewrite gsoAddCode; eauto.
             subst; rewrite gssThreadCode; intros AA; inversion AA.
@@ -1529,7 +1378,6 @@ Qed.
             rewrite Hthread; intros HH; inversion HH. }
       + generalize running; clear running.
         inversion H; subst;
-        try erewrite <- age_getThreadCode;
           try rewrite gLockSetCode;
           try rewrite gRemLockSetCode;
           try (rewrite gsoThreadCode; [|auto]);
@@ -1540,23 +1388,18 @@ Qed.
         end).
       (*Add thread case*)
         assert (cntj':=cntj).
-        eapply cnt_age in cntj'.
         eapply cntAdd' in cntj'; destruct cntj' as [ [HH HHH] | HH].
         * erewrite gsoAddCode; eauto.
           destruct (NatTID.eq_tid_dec i j);
             [subst; rewrite gssThreadCode; intros AA; inversion AA|].
           rewrite gsoThreadCode; auto.
           exists HH, q; assumption.
-        * erewrite gssAddCode . intros AA; inversion AA.
+        * erewrite gssAddCode. intros AA; inversion AA.
           assumption.
 
 
 
-          Grab Existential Variables.
-          eauto. eauto. eauto. eauto. eauto. eauto.
-          eauto. eauto. eauto. eauto. eauto. eauto.
-          eauto. eauto. eauto. apply cntAdd. eauto.
-          eauto. eauto.
+          Unshelve. all: eauto.
   Qed.
 
 
@@ -1580,7 +1423,7 @@ Qed.
        corresponding to global variables, arguments
        and function specs. *)
 
-    (*Lemma onePos: (0<1)%coq_nat. auto. Qed.*)
+    (*Lemma onePos: (0<1)%nat. auto. Qed.*)
     Definition initial_machine rmap c:=
       mk
         (mkPos (le_n 1))
@@ -1590,7 +1433,7 @@ Qed.
 
     Definition init_mach rmap (m:mem) (tp:thread_pool) (m':mem) (v:val) (args:list val) : Prop :=
       exists c, initial_core the_sem 0 m c m' v args /\
-        match rmap with Some rmap => tp = initial_machine rmap c | None => False end.
+        match rmap with Some rmap => tp = initial_machine rmap c (core rmap) | None => False end.
 
 
     Section JuicyMachineLemmas.
@@ -1601,19 +1444,26 @@ Qed.
         forall l r,
           ThreadPool.lockRes js l = Some (Some r) ->
           forall b ofs,
-            Mem.perm_order'' ((getMaxPerm m) !! b ofs) (perm_of_res' (r @ (b, ofs))).
+            Mem.perm_order'' (PMap.get b (getMaxPerm m) ofs) (perm_of_res' (r @ (b, ofs))).
       Proof.
         intros. destruct H as [allj H].
         inversion H.
         cut (Mem.perm_order'' (perm_of_res' (allj @ (b,ofs))) (perm_of_res' (r @ (b, ofs)))).
-      {intros AA. eapply po_trans; eauto.
-       inversion all_cohere0.
-       rewrite getMaxPerm_correct.
-       specialize (max_coh0 (b,ofs)).
-       eapply max_coh0. }
-      { apply po_join_sub'.
-        apply resource_at_join_sub.
-        eapply compatible_lockRes_sub_all; eauto; apply H0. }
+      { intros AA. eapply po_trans; eauto.
+        inversion all_cohere0.
+        rewrite getMaxPerm_correct.
+        specialize (max_coh0 (b,ofs)).
+        eapply max_coh0. }
+      { assert (✓ allj) as Hv by (by inv juice_join0).
+        specialize (Hv (b, ofs)).
+        apply perm_of_dfrac_mono; try done.
+        { rewrite /resource_at resR_to_resource_fst.
+          destruct (_ !! _)%stdpp; last done.
+          by apply dfrac_of'_valid. }
+        eapply compatible_lockRes_sub_all in juice_join0; last done.
+        rewrite gmap.lookup_included in juice_join0.
+        specialize (juice_join0 (b, ofs)).
+        apply resR_le in juice_join0 as (? & ?); done. }
       Qed.
 
 
@@ -1622,45 +1472,28 @@ Qed.
              forall l r,
              ThreadPool.lockRes js l = Some (Some r) ->
              forall b ofs,
-               Mem.perm_order'' ((getMaxPerm m) !! b ofs) (perm_of_res (r @ (b, ofs))).
+               Mem.perm_order'' (PMap.get b (getMaxPerm m) ofs) (perm_of_res (r @ (b, ofs))).
     Proof.
       intros. destruct H as [allj H].
       inversion H.
       cut (Mem.perm_order'' (perm_of_res (allj @ (b,ofs))) (perm_of_res (r @ (b, ofs)))).
-      {intros AA. eapply po_trans; eauto.
-       inversion all_cohere0.
-       rewrite getMaxPerm_correct.
-       eapply max_acc_coh_acc_coh in max_coh0.
-       specialize (max_coh0 (b,ofs)).
-       apply max_coh0. }
-      { apply po_join_sub.
-        apply resource_at_join_sub.
-        eapply compatible_lockRes_sub_all; eauto; apply H0. }
+      { intros AA. eapply po_trans; eauto.
+        inversion all_cohere0.
+        rewrite getMaxPerm_correct.
+        eapply max_acc_coh_acc_coh in max_coh0.
+        specialize (max_coh0 (b,ofs)).
+        apply max_coh0. }
+      { assert (✓ allj) as Hv by (by inv juice_join0).
+        specialize (Hv (b, ofs)).
+        eapply perm_of_res_mono', resR_le; try done.
+        { rewrite /resource_at resR_to_resource_fst.
+          destruct (_ !! _)%stdpp; last done.
+          by apply dfrac_of'_valid. }
+        eapply compatible_lockRes_sub_all in juice_join0; last done.
+        rewrite gmap.lookup_included in juice_join0; eauto. }
     Qed.
 
-    Lemma access_cohere_sub': forall phi1 phi2 m,
-        access_cohere' m phi1 ->
-        join_sub phi2 phi1 ->
-        access_cohere' m phi2.
-    Proof.
-      unfold access_cohere'; intros.
-      eapply po_trans.
-        - apply H.
-        - apply po_join_sub.
-          apply resource_at_join_sub; assumption.
-    Qed.
-
-
-
-      Lemma mem_cohere'_juicy_mem jm : mem_cohere' (m_dry jm) (m_phi jm).
-      Proof.
-        destruct jm as [m phi C A M L]; simpl.
-        constructor; auto.
-      Qed.
-
-
-
-      Lemma compatible_threadRes_join:
+(*      Lemma compatible_threadRes_join:
         forall js m,
           mem_compatible js m ->
           forall i (cnti: containsThread js i) j (cntj: containsThread js j),
@@ -1671,7 +1504,7 @@ Qed.
         simpl.
         unfold OrdinalPool.getThreadR.
        destruct H. destruct H as [JJ _ _ _ _].
-       inv JJ. clear H1 H2. unfold join_threads in H.
+       inv JJ. clear - H0 H. unfold join_threads in H.
        unfold getThreadsR in H.
        assert (H1 :=mem_ord_enum (n:= n (num_threads js))).
        generalize (H1 (Ordinal (n:=n (num_threads js)) (m:=j) cntj)); intro.
@@ -1755,6 +1588,7 @@ Qed.
        unfold OrdinalPool.getThreadR.
        destruct H. destruct H as [JJ _ _ _ _].
        inv JJ. unfold join_locks, join_threads in H1.
+       clear - H H0 H1 H2.
        simpl in H0.
        apply AMap.find_2 in H0. unfold OrdinalPool.lockGuts in H0.
        apply AMap.elements_1 in H0. simpl in H1.
@@ -1778,15 +1612,15 @@ Qed.
            revert H H0; clear; revert r0; induction el; intros. inv H.
             unfold in_mem in H. unfold pred_of_mem in H. simpl in H.
            pose proof @orP.
-           specialize (H1 (j == a)(pred_of_eq_seq (T:=ordinal_eqType (n (num_threads js))) el j)).
+           specialize (H1 (j == a)(mem_seq (T:=ordinal_eqType (n (num_threads js))) el j)).
         destruct ((j == a)
-       || pred_of_eq_seq (T:=ordinal_eqType (n (num_threads js))) el j); inv H.
+       || mem_seq (T:=ordinal_eqType (n (num_threads js))) el j); inv H.
     inv H1. destruct H.
     pose proof (@eqP _ j a). destruct (j==a); inv H; inv H1.
     simpl in H0.
  destruct H0 as [? [? ?]].
     exists x; auto.
-    unfold pred_of_eq_seq in H.
+    unfold mem_seq in H.
     destruct H0 as [? [? ?]].
     apply (IHel x) in H. apply join_sub_trans with x; auto. eexists; eauto.
     auto.
@@ -1798,17 +1632,18 @@ Qed.
            apply IHel in H1; auto. apply join_sub_trans with x; auto.
            eexists; eauto.
          }
-    Qed.
+    Qed.*)
 
       Lemma compatible_lockRes_cohere: forall js m l phi,
           lockRes js l = Some (Some phi) ->
           mem_compatible js m ->
-          mem_cohere' m phi .
+          mem_cohere' m phi.
       Proof.
         intros.
         inversion H0 as [all_juice M]; inversion M.
         apply (compatible_lockRes_sub_all _ H ) in juice_join0.
-        apply (mem_cohere_sub all_cohere0) in juice_join0.
+        assert (✓ all_juice) as Hv by (by destruct M as [[]]).
+        apply (mem_cohere_sub Hv all_cohere0) in juice_join0.
         assumption.
       Qed.
 
@@ -1820,134 +1655,11 @@ Qed.
         intros.
         inversion H as [all_juice M]; inversion M.
         eapply mem_cohere_sub.
+        - by destruct M as [[]].
         - eassumption.
         - apply compatible_threadRes_sub. assumption.
       Qed.
 
-      (** *Lemmas about aging*)
-      Lemma cnt_age_iff {js i n} :
-          containsThread js i <->
-          containsThread (age_tp_to n js) i.
-      Proof.
-        destruct js; split; auto.
-      Qed.
-
-      Lemma gtc_age : forall js i n,
-          forall (cnt: containsThread js i)
-            (cnt': containsThread (age_tp_to n js) i),
-            getThreadC cnt = getThreadC cnt'.
-      Proof.
-        intros []. intros; simpl.
-        repeat f_equal; apply proof_irr.
-      Qed.
-
-      Lemma getThreadR_age: forall js i age,
-          forall (cnt: containsThread js i)
-            (cnt': containsThread (age_tp_to age js) i),
-            age_to age (getThreadR cnt) = getThreadR cnt'.
-      Proof.
-        intros. unfold getThreadR; destruct js; simpl.
-        unfold containsThread in cnt, cnt'.
-        simpl in cnt, cnt'.
-        unfold "oo";
-          do 3 f_equal. apply proof_irrelevance.
-      Qed.
-
-      Lemma LockRes_age: forall js age a,
-          isSome (lockRes (age_tp_to age js) a) = isSome(lockRes js a).
-      Proof.
-        destruct js.
-        intros; simpl. unfold OrdinalPool.lockRes; simpl.
-        destruct (AMap.find (elt:=option rmap) a
-                            (AMap.map (option_map (age_to age)) lset0)) eqn:AA;
-          destruct (AMap.find (elt:=option rmap) a lset0) eqn:BB;
-          try (reflexivity).
-        - apply AMap_find_map_inv in AA. destruct AA as [x [BB' rest]].
-          rewrite BB' in BB; inversion BB.
-        - apply AMap_find_map with (f:=(option_map (age_to age))) in BB.
-          rewrite BB in AA; inversion AA.
-      Qed.
-
-      Lemma LockRes_age_content1: forall js age a,
-          lockRes (age_tp_to age js) a = Some None ->
-          lockRes js a = Some None.
-        intros js age a. simpl; unfold OrdinalPool.lockRes; destruct js.
-        simpl.
-        intros AA.
-            apply AMap_find_map_inv in AA. destruct AA as [x [map rest]].
-            rewrite map. f_equal.
-            destruct x; inversion rest; try reflexivity.
-      Qed.
-
-      Lemma LockRes_age_content2: forall js age a rm,
-          lockRes (age_tp_to age js) a = Some (Some rm) ->
-          exists r, lockRes js a = Some (Some r) /\ rm = age_to age r.
-      Proof.
-        intros js age a rm. simpl; unfold OrdinalPool.lockRes; destruct js.
-        simpl.
-        intros AA.
-        apply AMap_find_map_inv in AA. destruct AA as [x [map rest]].
-        destruct x; inversion rest.
-        exists r; rewrite map; auto.
-      Qed.
-
-      Lemma access_cohere'_age m : hereditary age (access_cohere' m).
-      Proof.
-        intros x y E B.
-        intros addr.
-        destruct (age1_levelS _ _ E) as [n L].
-        eapply (age_age_to n) in E; auto.
-        rewrite <-E.
-        rewrite perm_of_age.
-        apply B.
-      Qed.
-
-      Lemma access_cohere'_unage m : hereditary unage (access_cohere' m).
-      Proof.
-        intros x y E B.
-        intros addr.
-        destruct (age1_levelS _ _ E) as [n L].
-        eapply (age_age_to n) in E; auto.
-        rewrite <-E in B.
-        specialize (B addr).
-        rewrite perm_of_age in B.
-        apply B.
-      Qed.
-
-      Lemma mem_cohere'_age m : hereditary age (mem_cohere' m).
-      Proof.
-        intros x y E.
-        intros [A B C]; constructor.
-        - eapply contents_cohere_age; eauto.
-       (* - eapply access_cohere'_age; eauto.*)
-        - eapply max_access_cohere_age; eauto.
-        - eapply alloc_cohere_age; eauto.
-      Qed.
-
-      Lemma mem_cohere'_unage m : hereditary unage (mem_cohere' m).
-      Proof.
-        intros x y E.
-        intros [A B C]; constructor.
-        - eapply contents_cohere_unage; eauto.
-        - eapply max_access_cohere_unage; eauto.
-        - eapply alloc_cohere_unage; eauto.
-      Qed.
-
-      Lemma mem_cohere_age_to n m phi :
-        mem_cohere' m phi ->
-        mem_cohere' m (age_to n phi).
-      Proof.
-        apply age_to_ind, mem_cohere'_age.
-      Qed.
-
-      Lemma mem_cohere_age_to_opp n m phi :
-        mem_cohere' m (age_to n phi) ->
-        mem_cohere' m phi.
-      Proof.
-        apply age_by_ind_opp.
-        intros x y A. apply mem_cohere'_unage, A.
-      Qed.
-
     End JuicyMachineLemmas.
 
     Definition install_perm {tp m tid} (Hcompat : mem_compatible tp m) (cnt : containsThread tp tid) :=
@@ -1967,4 +1679,3 @@ Qed.
   End JuicyMachineShell.
 
 End Concur.
-
diff --git a/concurrency/juicy/resource_decay_join.v b/concurrency/juicy/resource_decay_join.v
index d75276e1ae..034001f204 100644
--- a/concurrency/juicy/resource_decay_join.v
+++ b/concurrency/juicy/resource_decay_join.v
@@ -6,7 +6,7 @@ Require Import VST.veric.aging_lemmas.
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.juicy_mem_lemmas.
 Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.Clight_new.
+Require Import VST.veric.Clight_core.
 Require Import VST.veric.semax.
 Require Import VST.veric.semax_ext.
 Require Import VST.veric.juicy_extspec.
@@ -17,6 +17,8 @@ Require Import VST.veric.age_to_resource_at.
 Require Import VST.concurrency.common.permjoin.
 Require Import VST.concurrency.juicy.sync_preds_defs.
 
+Set Bullet Behavior "Strict Subproofs".
+
 Lemma NO_ext: forall sh1 sh2 p1 p2, sh1=sh2 -> NO sh1 p1 = NO sh2 p2.
 Proof.
 intros.
@@ -56,7 +58,7 @@ Lemma resource_decay_aux_spec b phi1 phi2 :
   resource_decay b phi1 phi2 -> resource_decay_aux b phi1 phi2.
 Proof.
   intros [lev rd]; split; [ apply lev | clear lev]; intros loc; specialize (rd loc).
-  assert (D: {(fst loc >= b)%positive} + {(fst loc < b)%positive}) by (pose proof zlt; zify; eauto).
+  assert (D: {(fst loc >= b)%positive} + {(fst loc < b)%positive}) by (pose proof plt; eauto).
   split. apply rd. destruct rd as [nn rd].
   remember (phi1 @ loc) as r1.
   remember (phi2 @ loc) as r2.
@@ -238,7 +240,7 @@ Proof.
   {
     intros loc.
     specialize (rd loc).
-    assert (D: {(fst loc >= b)%positive} + {(fst loc < b)%positive}) by (pose proof zlt; zify; eauto).
+    assert (D: {(fst loc >= b)%positive} + {(fst loc < b)%positive}) by (pose proof plt; eauto).
     apply resource_at_join with (loc := loc) in J.
 
     unfold phi2'; clear phi2'; rewrite age_to_resource_at.
diff --git a/concurrency/juicy/resource_decay_lemmas.v b/concurrency/juicy/resource_decay_lemmas.v
index 969feabdfd..71d1a4e494 100644
--- a/concurrency/juicy/resource_decay_lemmas.v
+++ b/concurrency/juicy/resource_decay_lemmas.v
@@ -6,7 +6,7 @@ Require Import VST.veric.aging_lemmas.
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.juicy_mem_lemmas.
 Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.Clight_new.
+Require Import VST.veric.Clight_core.
 Require Import VST.veric.semax.
 Require Import VST.veric.semax_ext.
 Require Import VST.veric.juicy_extspec.
@@ -18,8 +18,6 @@ Require Import VST.veric.coqlib4.
 Require Import VST.concurrency.common.lksize.
 Require Import VST.concurrency.juicy.sync_preds_defs.
 
-Set Bullet Behavior "Strict Subproofs".
-
 Lemma resource_decay_LK {b phi phi'} :
   resource_decay b phi phi' ->
   forall  loc rsh sh n i pp,
diff --git a/concurrency/juicy/rmap_locking.v b/concurrency/juicy/rmap_locking.v
index b28875d3e8..0d09a03821 100644
--- a/concurrency/juicy/rmap_locking.v
+++ b/concurrency/juicy/rmap_locking.v
@@ -12,9 +12,8 @@ Require Import compcert.common.Values.
 
 Require Import VST.msl.Coqlib2.
 Require Import VST.msl.eq_dec.
-Require Import VST.msl.seplog.
 Require Import VST.veric.shares.
-Require Import VST.veric.compcert_rmaps.
+Require Import VST.veric.shared.
 Require Import VST.veric.semax.
 Require Import VST.veric.semax_ext.
 Require Import VST.veric.SeparationLogic.
@@ -28,21 +27,19 @@ Require Import VST.sepcomp.event_semantics.
 Require Import VST.veric.coqlib4.
 Require Import VST.floyd.type_induction.
 (*Require Import VST.concurrency.permjoin.*)
-Require Import VST.concurrency.juicy.sync_preds_defs.
+(*Require Import VST.concurrency.juicy.sync_preds_defs.*)
 Require Import VST.concurrency.juicy.semax_conc_pred.
 Require Import VST.concurrency.common.lksize.
 
 Require Import Setoid.
 
-Set Bullet Behavior "Strict Subproofs".
-
 Local Open Scope Z_scope.
 
-Lemma data_at_unfolding CS sh b ofs phi :
+(*Lemma data_at_unfolding CS sh b ofs phi :
   readable_share sh ->
-  app_pred (@data_at_ CS sh (Tarray (Tpointer Tvoid noattr) 4 noattr) (Vptr b ofs)) phi ->
+  app_pred (data_at_ sh (Tarray (Tpointer Ctypes.Tvoid noattr) 4 noattr) (Vptr b ofs)) phi ->
   forall loc,
-    adr_range (b, Ptrofs.intval ofs) 4%Z loc ->
+    adr_range (b, Ptrofs.intval ofs) 8%Z loc ->
     exists p v,
       phi @ loc =
       YES sh p
@@ -63,10 +60,10 @@ Proof.
   simpl in *.
   unfold SeparationLogic.mapsto in *.
   if_tac in s3. 2:tauto.
-  destruct s0 as [([], _) | (_, (v0, (vs0 & (C0 & D0) & G0)))].
-  destruct s1 as [([], _) | (_, (v1, (vs1 & (C1 & D1) & G1)))].
-  destruct s2 as [([], _) | (_, (v2, (vs2 & (C2 & D2) & G2)))].
-  destruct s3 as [([], _) | (_, (v3, (vs3 & (C3 & D3) & G3)))].
+  destruct s0 as [([], _) | (_, (v0, (vs0 & (C0 & D0))))].
+  destruct s1 as [([], _) | (_, (v1, (vs1 & (C1 & D1))))].
+  destruct s2 as [([], _) | (_, (v2, (vs2 & (C2 & D2))))].
+  destruct s3 as [([], _) | (_, (v3, (vs3 & (C3 & D3))))].
   rewrite reptype_lemmas.ptrofs_add_repr_0_r in *. simpl in *.
   intros (b', ofs').
   specialize (D0 (b', ofs')).
@@ -87,7 +84,7 @@ Proof.
     unfold Z.modulo in *; simpl in *;
     unfold Ptrofs.modulus, two_power_nat, Ptrofs.wordsize, Wordsize_Ptrofs.wordsize,
       size_chunk, Mptr in *;
-    destruct Archi.ptr64; simpl in *; omega.
+    destruct Archi.ptr64; simpl in *; lia.
   destruct (adr_range_dec _ _ _) as [(_, a1) | n1] in D1. t ofs (if Archi.ptr64 then 8 else 4).
   destruct (adr_range_dec _ _ _) as [(_, a2) | n2] in D2. t ofs (if Archi.ptr64 then 16 else 8).
   destruct (adr_range_dec _ _ _) as [(_, a3) | n3] in D3. t ofs (if Archi.ptr64 then 24 else 12).
@@ -112,7 +109,7 @@ Ltac app_pred_unfold :=
 
 Lemma mapsto_unfold sh z b ofs phi loc :
   readable_share sh ->
-  app_pred (mapsto sh (Tpointer Tvoid noattr) (offset_val (size_chunk Mptr * z) (Vptr b ofs)) Vundef) phi ->
+  app_pred (mapsto sh (Tpointer Ctypes.Tvoid noattr) (offset_val (size_chunk Mptr * z) (Vptr b ofs)) Vundef) phi ->
   if adr_range_dec (b, Ptrofs.unsigned (Ptrofs.add ofs (Ptrofs.repr (size_chunk Mptr * z)))) (size_chunk Mptr) loc then
     exists p v,
       phi @ loc =
@@ -126,7 +123,7 @@ Proof.
   simple_if_tac. now intros _ [].
   unfold offset_val.
   if_tac. 2:tauto.
-  intros _ [[[]] | [[] (v2 & bl & (wob & Sat) & _)]].
+  intros _ [[[]] | [[] (v2 & bl & (wob & Sat))]].
   specialize (Sat loc).
   unfold jam in *.
   app_pred_unfold.
@@ -146,7 +143,7 @@ Qed.
 
 Lemma data_at_unfold_readable CS sh b ofs phi length :
   readable_share sh ->
-  app_pred (@data_at_ CS sh (Tarray (Tpointer Tvoid noattr) (Z.of_nat length) noattr) (Vptr b ofs)) phi ->
+  app_pred (@data_at_ CS sh (Tarray (Tpointer Ctypes.Tvoid noattr) (Z.of_nat length) noattr) (Vptr b ofs)) phi ->
   forall loc,
     if adr_range_dec (b, Ptrofs.intval ofs) (size_chunk Mptr * Z.of_nat length)%Z loc then
       exists p v,
@@ -158,8 +155,7 @@ Lemma data_at_unfold_readable CS sh b ofs phi length :
 Proof.
   intros Readable.
   intros [(_ & _ & bound & align & _) [_ H]].
-  unfold size_compatible, sizeof in bound.
-  rewrite <- size_chunk_Mptr in bound.
+  unfold size_compatible, Ctypes.sizeof in bound; simpl in bound.
   simpl in H.
   unfold mapsto_memory_block.at_offset in *.
   unfold reptype_lemmas.unfold_reptype in *.
@@ -173,20 +169,20 @@ Proof.
   unfold nested_field_lemmas.nested_field_offset in *.
   simpl in H.
   rewrite <-Zminus_0_l_reverse in H.
-  rewrite Z.max_r in * by omega.
+  rewrite Z.max_r in * by lia.
   assert (H' :
             app_pred
               (aggregate_pred.rangespec
                  0 (Z.to_nat (Z.of_nat length))
                  (fun (i : Z) (v : val) =>
                     SeparationLogic.mapsto
-                      sh (Tpointer Tvoid noattr)
+                      sh (Tpointer Ctypes.Tvoid noattr)
                       (offset_val (size_chunk Mptr * i)%Z v)
                       Vundef) (Vptr b (Ptrofs.add ofs (Ptrofs.repr 0)))) phi).
   {
     exact_eq H. repeat (f_equal || extensionality).
     unfold sublist.Znth. if_tac; auto.
-    apply data_at_rec_lemmas.nth_list_repeat.
+    apply data_at_rec_lemmas.nth_repeat.
   }
 
   clear H. revert H'.
@@ -195,39 +191,40 @@ Proof.
   replace (Ptrofs.intval ofs) with (Ptrofs.intval (Ptrofs.add ofs (Ptrofs.repr (size_chunk Mptr * 0))))
     by (rewrite ptrofs_add_repr_0_r; reflexivity).
 
-  assert (bound3 : (Ptrofs.unsigned ofs + (size_chunk Mptr * 0) + size_chunk Mptr * Z.of_nat length <= Ptrofs.modulus)%Z) by omega.
+  assert (bound3 : (Ptrofs.unsigned ofs + (size_chunk Mptr * 0) + size_chunk Mptr * Z.of_nat length <= Ptrofs.modulus)%Z) by (simpl in *; lia).
 
-  remember 0%Z as z; assert (z0 : 0 <= z) by omega; clear Heqz.
-  assert (RR : forall z,
+  remember 0%Z as z; assert (z0 : 0 <= z) by lia; clear Heqz.
+(*  assert (RR : forall z,
              (match z with 0 => 0 | Z.pos y' => Z.pos y'~0~0 | Z.neg y' => Z.neg y'~0~0 end = size_chunk Mptr * z)%Z)
-    by reflexivity.
+    by reflexivity.*)
 
   assert (AA : forall P, (b = b /\ P) <-> P) by (intros; tauto).
   revert z z0 bound3 phi.
   induction length.
   - intros z z0 bound3 phi SAT (b', ofs'). simpl.
     if_tac.
-    + simpl in *. omega.
-    + apply resource_at_identity, SAT.
+    + simpl in *. lia.
+    + setoid_rewrite emp_no in SAT.
+      apply SAT.
   - rewrite Nat2Z.inj_succ in *.
     intros z z0 bound3 phi (phi1 & phi2 & j & SAT1 & SAT2) loc.
     inv align; try discriminate.
     rename H3 into align.
     pose proof (size_chunk_pos Mptr) as Hpos.
     spec IHlength.
-    { rewrite size_chunk_Mptr in *; simple_if_tac; omega. }
+    { rewrite size_chunk_Mptr in *; lia. }
     spec IHlength.
-    { constructor; intros; apply align; omega. }
+    { constructor; intros; apply align; lia. }
     specialize (IHlength (Z.succ z)).
-    specialize (IHlength ltac:(omega)).
+    specialize (IHlength ltac:(lia)).
     spec IHlength.
-    { rewrite size_chunk_Mptr in *; simple_if_tac; omega. }
+    { rewrite size_chunk_Mptr in *; simple_if_tac; lia. }
     specialize (IHlength phi2 SAT2 loc).
     assert (E4 : size_chunk Mptr * z mod Ptrofs.modulus = (size_chunk Mptr * z)). {
       apply Zmod_small.
-      split; [rewrite size_chunk_Mptr; simple_if_tac; omega|].
+      split; [rewrite size_chunk_Mptr; simple_if_tac; lia|].
       pose proof (Ptrofs.unsigned_range ofs).
-      rewrite size_chunk_Mptr in *; simple_if_tac; omega.
+      rewrite size_chunk_Mptr in *; simple_if_tac; lia.
     }
     if_tac.
     + if_tac in IHlength.
@@ -257,11 +254,11 @@ Proof.
         -- rewrite E in *.
            rewrite Ptrofs.unsigned_repr_eq in *.
            change (size_chunk Mptr mod Ptrofs.modulus)%Z with (size_chunk Mptr) in *.
-           omega.
+           lia.
         -- rewrite E in *.
            rewrite Ptrofs.unsigned_repr_eq in *.
            change (size_chunk Mptr mod Ptrofs.modulus)%Z with (size_chunk Mptr) in *.
-           pose proof (Ptrofs.unsigned_range ofs); omega.
+           pose proof (Ptrofs.unsigned_range ofs); simpl in *; lia.
       * apply resource_at_join with (loc := loc) in j.
         pose proof (join_unit2_e _ _ IHlength j) as E.
         rewrite <-E in *. clear SAT2 E j IHlength.
@@ -273,9 +270,9 @@ Proof.
         assert (b' = b) by intuition; subst b'.
         rewrite AA in *.
         replace (size_chunk Mptr * Z.of_nat (S length))%Z with (size_chunk Mptr + size_chunk Mptr * Z.of_nat length)%Z in *.
-        2:simpl (Z.of_nat); zify; unfold size_chunk, Mptr; simple_if_tac; omega.
+        2:simpl (Z.of_nat); zify; unfold size_chunk, Mptr; simple_if_tac; lia.
         replace (size_chunk Mptr * Z.succ z)%Z with (size_chunk Mptr + size_chunk Mptr * z)%Z in *.
-        2:zify; unfold size_chunk, Mptr; simple_if_tac; omega.
+        2:zify; unfold size_chunk, Mptr; simple_if_tac; lia.
         rewrite <-coqlib3.ptrofs_add_repr in *.
         rewrite <-Ptrofs.add_assoc in *.
         rewrite (Ptrofs.add_commut ofs) in H0.
@@ -289,7 +286,7 @@ Proof.
         remember (Ptrofs.unsigned a) as c(* ; clear Heqc a *).
         if_tac [If|If] in H0.
         -- change (Ptrofs.unsigned Ptrofs.zero) with 0%Z in *.
-           unfold size_chunk, Mptr in *; destruct Archi.ptr64; omega.
+           unfold size_chunk, Mptr in *; destruct Archi.ptr64; lia.
         -- subst c a.
            (* clear -If bound3. *)
            rewrite Ptrofs.unsigned_add_carry in *.
@@ -297,11 +294,11 @@ Proof.
            if_tac [If2|If2] in If.
            ++ change (Ptrofs.unsigned Ptrofs.zero) with 0%Z in *.
               rewrite Ptrofs.unsigned_repr_eq in *.
-              omega.
+              lia.
            ++ change (Ptrofs.unsigned Ptrofs.zero) with 0%Z in *.
               change (Ptrofs.unsigned Ptrofs.one) with 1%Z in *.
               rewrite Ptrofs.unsigned_repr_eq in *.
-              omega.
+              lia.
     + apply mapsto_unfold with (loc := loc) in SAT1; auto.
       if_tac in SAT1.
       * exfalso.
@@ -313,9 +310,9 @@ Proof.
         rewrite Ptrofs.unsigned_add_carry in *.
         unfold Ptrofs.add_carry in *.
         rewrite Ptrofs.unsigned_repr_eq, E4 in *.
-        assert (0 <= size_chunk Mptr * Z.of_nat length) by (apply Z.mul_nonneg_nonneg; omega).
+        assert (0 <= size_chunk Mptr * Z.of_nat length) by (apply Z.mul_nonneg_nonneg; lia).
         rewrite Z.mul_succ_r in *.
-        if_tac in H0; omega.
+        if_tac in H0; lia.
       * if_tac in IHlength.
         -- exfalso. clear SAT1 SAT2 phi phi1 phi2 IHlength j.
            destruct loc as (b', ofs').
@@ -323,7 +320,7 @@ Proof.
            assert (b' = b) by intuition; subst b'.
            rewrite AA in *.
            replace (size_chunk Mptr * Z.succ z)%Z with (size_chunk Mptr + size_chunk Mptr * z)%Z in *.
-           2:zify; unfold size_chunk, Mptr; simple_if_tac; omega.
+           2:zify; unfold size_chunk, Mptr; simple_if_tac; lia.
            rewrite <-coqlib3.ptrofs_add_repr in *.
            rewrite <-Ptrofs.add_assoc in *.
            rewrite (Ptrofs.add_commut ofs) in H1.
@@ -337,21 +334,21 @@ Proof.
            remember (Ptrofs.unsigned a) as c.
            if_tac [If|If] in H1.
            ++ change (Ptrofs.unsigned Ptrofs.zero) with 0%Z in *.
-              unfold size_chunk, Mptr in *; destruct Archi.ptr64; omega.
+              unfold size_chunk, Mptr in *; destruct Archi.ptr64; lia.
            ++ subst a c.
               rewrite Ptrofs.unsigned_add_carry in *.
               unfold Ptrofs.add_carry in *.
-              assert (0 <= size_chunk Mptr * Z.of_nat length) by (apply Z.mul_nonneg_nonneg; omega).
+              assert (0 <= size_chunk Mptr * Z.of_nat length) by (apply Z.mul_nonneg_nonneg; lia).
               rewrite Z.mul_succ_r in *.
               if_tac [If2|If2] in If.
               ** change (Ptrofs.unsigned Ptrofs.zero) with 0%Z in *.
                  change (Ptrofs.unsigned Ptrofs.one) with 1%Z in *.
                  rewrite Ptrofs.unsigned_repr_eq in *.
-                 omega.
+                 lia.
               ** change (Ptrofs.unsigned Ptrofs.zero) with 0%Z in *.
                  change (Ptrofs.unsigned Ptrofs.one) with 1%Z in *.
                  rewrite Ptrofs.unsigned_repr_eq in *.
-                 omega.
+                 lia.
         -- apply resource_at_join with (loc := loc) in j.
            generalize (join_unit1_e _ _ SAT1 j).
            intros <-; auto.
@@ -370,7 +367,7 @@ Qed.*)
 
 Lemma data_at_unfold CS sh b ofs phi length :
   forall (Hw: writable0_share sh),
-  app_pred (@data_at_ CS sh (Tarray (Tpointer Tvoid noattr) (Z.of_nat length) noattr) (Vptr b ofs)) phi ->
+  app_pred (@data_at_ CS sh (Tarray (Tpointer Ctypes.Tvoid noattr) (Z.of_nat length) noattr) (Vptr b ofs)) phi ->
   forall loc,
     if adr_range_dec (b, Ptrofs.intval ofs) (size_chunk Mptr * Z.of_nat length)%Z loc then
       exists v, phi @ loc = YES sh (writable0_readable Hw) (VAL v) NoneP
@@ -389,7 +386,7 @@ Qed.
 
 Lemma data_at_unfold_weak CS sh b ofs phi z z' loc :
   readable_share sh ->
-  app_pred (@data_at_ CS sh (Tarray (Tpointer Tvoid noattr) z noattr) (Vptr b ofs)) phi ->
+  app_pred (@data_at_ CS sh (Tarray (Tpointer Ctypes.Tvoid noattr) z noattr) (Vptr b ofs)) phi ->
   adr_range (b, Ptrofs.intval ofs) z' loc ->
   z' <= size_chunk Mptr * z ->
   exists p v,
@@ -402,15 +399,15 @@ Proof.
   pose proof data_at_unfold_readable CS sh b ofs phi (Z.to_nat z) R as H.
   assert (z0 : 0 <= z). {
     destruct loc; simpl in range.
-    assert (0 <= z') by omega.
+    assert (0 <= z') by lia.
     pose proof (size_chunk_pos Mptr).
     eapply Zmult_le_0_reg_r; eauto.
-    rewrite Z.mul_comm; omega.
+    rewrite Z.mul_comm; lia.
   }
   assert_specialize H. {
     intros.
     exact_eq AT; repeat f_equal.
-    rewrite Z2Nat.id; omega.
+    rewrite Z2Nat.id; lia.
   }
   specialize (H loc).
   if_tac [If|If] in H; auto.
@@ -420,56 +417,30 @@ Proof.
   destruct range as (<- & A & B).
   split; auto.
   split; auto.
-  rewrite Z2Nat.id; omega.
-Qed.
-
-Lemma data_at_noghost CS sh b ofs phi :
-  app_pred (@data_at_ CS sh (Tarray (Tpointer Tvoid noattr) 2 noattr) (Vptr b ofs)) phi ->
-  noghost phi.
-Proof.
-  intros Hw; simpl in *.
-  destruct Hw as (_ & _ & ? & ? & ? & ? & ? & ? & J2 & ? & Hemp).
-  apply join_comm, Hemp in J2; subst.
-  unfold mapsto_memory_block.at_offset in *; simpl in *.
-  unfold mapsto in *; simpl in *.
-  destruct (readable_share_dec sh).
-  - destruct H0 as [[]|[_ H0]], H1 as [[]|[_ H1]]; try contradiction.
-    destruct H0 as (_ & _ & _ & ?), H1 as (_ & _ & _ & ?); simpl in *.
-    apply ghost_of_join, H0 in H.
-    rewrite <- H; auto.
-  - destruct H0 as (_ & _ & ?), H1 as (_ & _ & ?).
-    apply ghost_of_join, H0 in H.
-    rewrite <- H; auto.
-Qed.
+  rewrite Z2Nat.id; lia.
+Qed.*)
 
-Definition rmap_makelock phi phi' loc R length :=
-  (level phi = level phi') /\
+Definition rmap_makelock phi phi' loc length :=
   (forall x, ~ adr_range loc length x -> phi @ x = phi' @ x) /\
   (forall x,
       adr_range loc length x ->
-      exists val sh Psh,
-        phi @ x = YES sh Psh (VAL val) NoneP /\
+      exists val sh,
+        phi @ x = (DfracOwn (Share sh), Some (VAL val)) /\
         writable0_share sh /\
-        phi' @ x =
-          YES sh Psh (LK length (snd x - snd loc)) (pack_res_inv (approx (level phi) R)))
-    /\  (ghost_of phi = ghost_of phi').
+        phi' @ x = (DfracOwn (Share sh), Some (LK length (snd x - snd loc)))).
 
 (* rmap_freelock phi phi' is ALMOST rmap_makelock phi' phi but we
 specify that the VAL will be the dry memory's *)
-Definition rmap_freelock phi phi' m loc R length :=
-  (level phi = level phi') /\
+Definition rmap_freelock phi phi' m loc length :=
   (forall x, ~ adr_range loc length x -> phi @ x = phi' @ x) /\
   (forall x,
       adr_range loc length x ->
-      exists sh Psh,
-        phi' @ x = YES sh Psh (VAL (contents_at m x)) NoneP /\
+      exists sh,
+        phi' @ x = (DfracOwn (Share sh), Some (VAL (contents_at m x))) /\
         writable0_share sh /\
-        phi @ x =
-  
-          YES sh Psh (LK length  (snd x - snd loc)) (pack_res_inv (approx (level phi) R))) /\
-  (ghost_of phi = ghost_of phi').
+        phi @ x = (DfracOwn (Share sh), Some (LK length  (snd x - snd loc)))).
 
-Definition makelock_f phi loc R length : address -> resource :=
+(*Definition makelock_f phi loc R length : address -> resource :=
   fun x =>
     if adr_range_dec loc length x then
       match phi @ x with
@@ -692,13 +663,13 @@ Definition LK_at R lksize sh :=
 Lemma data_at_rmap_makelock CS sh b ofs R phi length :
   0 < length ->
   writable0_share sh ->
-  app_pred (@data_at_ CS sh (Tarray (Tpointer Tvoid noattr) length noattr) (Vptr b ofs)) phi ->
+  app_pred (@data_at_ CS sh (Tarray (Tpointer Ctypes.Tvoid noattr) length noattr) (Vptr b ofs)) phi ->
   exists phi',
     rmap_makelock phi phi' (b, Ptrofs.unsigned ofs) R (size_chunk Mptr * length) /\
     LK_at R (size_chunk Mptr * length) sh (b, Ptrofs.unsigned ofs) phi'.
 Proof.
   intros Hpos Hwritable Hat.
-  destruct (Z_of_nat_complete length) as (n, Hn). omega.
+  destruct (Z_of_nat_complete length) as (n, Hn). lia.
   rewrite Hn in Hat.
   pose proof data_at_unfold _ _ _ _ _ _ Hwritable Hat as Hbefore.
   rewrite <-Hn in *. clear n Hn.
@@ -739,12 +710,14 @@ Proof.
       destruct Hbefore as (val & ->).
       exists val, sh, (writable0_readable Hwritable).
       repeat split; auto; reflexivity.
-  - intros x.
+  - unfold LK_at, LKspec_ext; simpl.
+    match goal with |-(app_pred (allp ?a) ?b) => change (app_pred (predicates_hered.allp a) b) end.
+    intros x.
     simpl.
     unfold Ptrofs.unsigned in *.
     specialize (Hbefore x).
     rewrite Ephi'. unfold makelock_f.
-    if_tac. 2:easy.
+    simpl in *. if_tac. 2:easy.
     destruct Hbefore as (v, ->).
      eexists.
       f_equal.
@@ -768,13 +741,13 @@ Lemma lock_inv_rmap_freelock CS sh b ofs R phi m :
   app_pred (@lock_inv sh (Vptr b ofs) R) phi ->
   exists phi',
     rmap_freelock phi phi' m (b, Ptrofs.unsigned ofs) R LKSIZE /\
-    app_pred (@data_at_ CS sh (Tarray (Tpointer Tvoid noattr) (LKSIZE/size_chunk Mptr) noattr) (Vptr b ofs)) phi'.
+    app_pred (@data_at_ CS sh (Tarray (Tpointer Ctypes.Tvoid noattr) (LKSIZE/size_chunk Mptr) noattr) (Vptr b ofs)) phi'.
 Proof.
   unfold LKSIZE at 3.
-  assert (size_chunk Mptr > 0) as Hpos by (rewrite size_chunk_Mptr; destruct Archi.ptr64; omega).
-  rewrite Z.div_mul by omega.
+  assert (size_chunk Mptr > 0) as Hpos by (rewrite size_chunk_Mptr; destruct Archi.ptr64; lia).
+  rewrite Z.div_mul by lia.
   intros Halign Hbound Hwritable Hli.
-  destruct Hli as (? & ? & E & Hli & Hg). injection E as <- <- .
+  destruct Hli as (? & ? & E & Hli). injection E as <- <- .
 
   pose proof make_rmap (freelock_f phi m (b, Ptrofs.unsigned ofs) LKSIZE) (ghost_of phi) as Hphi'.
   unfold LKSIZE in *.
@@ -812,8 +785,7 @@ Proof.
     split.
     + repeat split.
       * unfold size_compatible, sizeof.
-        rewrite size_chunk_Mptr in Hbound.
-        rewrite Z.max_r; omega.
+        rewrite size_chunk_Mptr in Hbound; simpl in *; auto.
       * constructor; econstructor; simpl; eauto.
         rewrite align_chunk_Mptr.
         apply Z.divide_add_r; auto.
@@ -823,15 +795,14 @@ Proof.
       rewrite mapsto_memory_block.memory_block'_eq;
         unfold mapsto_memory_block.memory_block'_alt; rewrite ?Z2Nat.id; try apply Z.ge_le, sizeof_pos.
       rewrite if_true by (apply writable0_readable; auto).
-      split; simpl; [|rewrite Hg'; auto].
+      simpl.
       rewrite Ephi'; unfold freelock_f.
       rewrite (Z.mul_comm 2) in *.
       intro b0; specialize (Hli b0); simpl in Hli.
-      rewrite <- size_chunk_Mptr; if_tac; auto.
+      simpl; if_tac; auto.
       destruct Hli as [? ->]; eauto.
       { apply Ptrofs.unsigned_range. }
-      { simpl.
-        rewrite <- size_chunk_Mptr; omega. }
+      { simpl in *. lia. }
 Qed.
 
 Lemma rmap_makelock_unique phi phi1 phi2 loc R len :
@@ -953,7 +924,8 @@ Next Obligation.
   destruct (phi @ _); simpl in *; auto.
 Qed.
 Next Obligation.
-  rewrite ghost_core; auto.
+  rewrite !core_ghost_of; replace (level phi) with (level (core phi)) by apply level_core;
+    apply ghost_of_approx.
 Qed.
 
 Lemma getYES_getNO_join phi : join (getYES phi) (getNO phi) phi.
@@ -1023,7 +995,7 @@ Proof.
     - destruct At. eexists. apply CUT; eauto. }
   clear v v' At. intros m v loc M.
   unfold address_mapsto in *.
-  destruct M as (bl & (I & M) & G); exists bl; split; [split; auto|].
+  destruct M as (bl & (I & M)); exists bl; split; auto.
   intros x; specialize (M x).
   simpl in *.
   if_tac.
@@ -1045,7 +1017,6 @@ Proof.
     destruct M as [-> | (k & pp & ->)].
     + apply NO_identity.
     + apply PURE_identity.
-  - simpl; unfold getYES; rewrite ghost_of_make_rmap; auto.
 Qed.
 
 Lemma memory_block_getYES sh z v phi :
@@ -1060,7 +1031,7 @@ Proof.
   unfold mapsto_memory_block.memory_block' in *.
 Abort.
 
-Lemma field_at_getYES CS sh t gfs v v' phi :
+(*Lemma field_at_getYES CS sh t gfs v v' phi :
   writable0_share sh ->
   app_pred (@field_at CS sh t gfs v v') phi ->
   app_pred (@field_at CS Share.Rsh t gfs v v') (getYES phi).
@@ -1073,6 +1044,7 @@ Proof.
   destruct (nested_field_lemmas.nested_field_type t gfs); simpl in *; repeat if_tac.
   all: try (eapply mapsto_getYES; eauto).
   all: try (eapply memory_block_getYES; eauto).
-Abort.
+Abort.*)
 
 End simpler_invariant_tentative.
+*)
\ No newline at end of file
diff --git a/concurrency/juicy/semax_conc.v b/concurrency/juicy/semax_conc.v
index 9d599c7610..97c253416a 100644
--- a/concurrency/juicy/semax_conc.v
+++ b/concurrency/juicy/semax_conc.v
@@ -1,110 +1,47 @@
-Require Import VST.msl.msl_standard.
-Require Import VST.msl.seplog.
-Require Import VST.veric.base.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.juicy_mem.
-Require Import VST.veric.juicy_mem_lemmas.
-Require Import VST.veric.juicy_mem_ops.
 Require Import VST.veric.juicy_extspec.
-Require Import VST.veric.tycontext.
-Require Import VST.veric.expr2.
-Require Import VST.veric.semax.
-Require Import VST.veric.semax_call.
-Require Import VST.veric.semax_ext.
-Require Import VST.veric.juicy_safety.
-Require Import VST.veric.Clight_new.
-Require Import VST.veric.res_predicates.
 Require Import VST.veric.SeparationLogic.
-Require Import VST.sepcomp.extspec.
-Require Import VST.floyd.reptype_lemmas.
-Require Import VST.floyd.field_at.
-Require Import VST.floyd.nested_field_lemmas.
-Require Import VST.floyd.client_lemmas.
-Require Import VST.floyd.jmeq_lemmas.
+Require Import compcert.cfrontend.Ctypes.
+Require Import VST.veric.expr.
 Require Import VST.concurrency.common.lksize.
 Require Import VST.concurrency.juicy.semax_conc_pred.
+Require Import VST.floyd.client_lemmas.
+Require Import VST.floyd.field_at.
+(*Require Import VST.concurrency.conclib.*)
 Import Clightdefs.
 Import String.
 
-Set Bullet Behavior "Strict Subproofs".
-
-(* Variables to be instantiated once the program is known. *)
-Definition _f := 1%positive.      (* alpha-convertible *)
-Definition _args := 2%positive.   (* alpha-convertible *)
-Definition _lock := 1%positive.   (* alpha-convertible *)
-Definition _cond := 2%positive.   (* alpha-convertible *)
-(*Definition _lock_t := 2%positive. (* 2 (* or sometimes 3 -WM *) is the number given by
-clightgen when threads.h is included first *)*)
-
 Definition voidstar_funtype := Tfunction (Tcons (tptr tvoid) Tnil) (tptr tvoid) cc_default.
 (* Definition tlock := Tstruct _lock_t noattr. *)
-Definition tlock := (Tarray (Tpointer Tvoid noattr) 2 noattr).
-(* Notation tlock := tuint (only parsing). *)
+Definition tlock := (Tarray (Tpointer Ctypes.Tvoid noattr) 2 noattr).
 
-Goal forall (cenv: composite_env), @sizeof cenv tlock = LKSIZE.
+Goal forall (cenv: compspecs), @sizeof cenv tlock = LKSIZE.
 Proof. reflexivity. Qed.
 
-Definition selflock_fun Q sh p : (unit -> mpred) -> (unit -> mpred) :=
-  fun R _ => (Q * |>lock_inv sh p (R tt))%logic.
+Section mpred.
 
-Definition selflock' Q sh p : unit -> mpred := HORec (selflock_fun Q sh p).
-Definition selflock Q sh p : mpred := selflock' Q sh p tt.
+Context `{!VSTGS OK_ty Σ}.
 
-Lemma nonexpansive_entail (F: pred rmap -> pred rmap) : nonexpansive F -> forall P Q, (P <=> Q |-- F P <=> F Q)%logic.
-Proof.
-  intros N P Q.
-  specialize (N P Q).
-  eapply derives_trans; [ eapply derives_trans | ]; [ | apply N | ];
-  apply derives_refl.
-Qed.
+Definition selflock_fun Q sh p : mpred -> mpred :=
+  fun R => (Q ∗ ▷lock_inv sh p R).
 
-Lemma HOnonexpansive_nonexpansive: forall F: mpred -> mpred, nonexpansive F <-> HOnonexpansive (fun P (_ : unit) => F (P tt)).
+#[export] Instance selflock_contractive Q sh p : Contractive (selflock_fun Q sh p).
 Proof.
-  intros.
-  split; intros; hnf in H |- *.
-  + intros P Q.
-    specialize (H (P tt) (Q tt)).
-    rewrite !allp_unit.
-    auto.
-  + intros P Q.
-    specialize (H (fun x => P) (fun x => Q)).
-    rewrite !allp_unit in H.
-    auto.
+  intros ????.
+  rewrite /selflock_fun.
+  f_equiv. (* f_contractive. *) apply later_contractive.
+  destruct n; first apply dist_later_0.
+  rewrite -!dist_later_S in H |- *.
+  f_equiv. done.
 Qed.
 
-Lemma selflock'_eq Q sh p : selflock' Q sh p =
-  selflock_fun Q sh p (selflock' Q sh p).
-Proof.
-  apply HORec_fold_unfold, prove_HOcontractive.
-  intros P1 P2 u.
-  apply subp_sepcon; [ apply subp_refl | ].
-  rewrite <- subp_later.
-  repeat intro.
-  match goal with |- app_pred (?P >=> ?Q)%logic ?a => change (subtypes.fash (P --> Q) a) end.
-  unfold lock_inv; repeat intro.
-  destruct H3 as (b & ofs & ? & Hl & ?); exists b, ofs; split; auto; split; auto.
-  intro l; specialize (Hl l); simpl in *.
-  if_tac; auto.
-  destruct Hl as [rsh Hl]; exists rsh; rewrite Hl; repeat f_equal.
-  extensionality.
-  specialize (H tt); rewrite <- eqp_later in H.
-  specialize (H _ H0).
-  apply necR_level in H2.
-  apply predicates_hered.pred_ext; intros ? []; split; auto.
-  - destruct (H a0) as [X _]; [omega|].
-    specialize (X _ (necR_refl _)); auto.
-  - destruct (H a0) as [_ X]; [omega|].
-    specialize (X _ (necR_refl _)); auto.
-Qed.
+Definition selflock Q sh p : mpred := fixpoint (selflock_fun Q sh p).
 
-Lemma selflock_eq Q sh p : selflock Q sh p = (Q * |>lock_inv sh p (selflock Q sh p))%logic.
+Lemma selflock_eq Q sh p : selflock Q sh p ⊣⊢ (Q ∗ ▷lock_inv sh p (selflock Q sh p)).
 Proof.
-  unfold selflock at 1.
-  rewrite selflock'_eq.
-  reflexivity.
+  rewrite {1}/selflock fixpoint_unfold //.
 Qed.
 
-(* In fact we need locks to two resources:
+(*(* In fact we need locks to two resources:
    1) the resource invariant, for passing the resources
    2) the join resource invariant, for returning all resources, including itself
    for this we need to define them in a mutually recursive fashion: *)
@@ -112,9 +49,9 @@ Qed.
 Definition res_invariants_fun Q sh1 p1 sh2 p2 : (bool -> mpred) -> (bool -> mpred) :=
   fun R b =>
     if b then
-      (Q * lock_inv sh2 p2 (|> R false))%logic
+      (Q * lock_inv sh2 p2 (▷ R false))
     else
-      (Q * lock_inv sh1 p1 (|> R true) * lock_inv sh2 p2 (|> R false))%logic.
+      (Q * lock_inv sh1 p1 (▷ R true) * lock_inv sh2 p2 (▷ R false)).
 
 Definition res_invariants Q sh1 p1 sh2 p2 : bool -> mpred := HORec (res_invariants_fun Q sh1 p1 sh2 p2).
 Definition res_invariant Q sh1 p1 sh2 p2 : mpred := res_invariants Q sh1 p1 sh2 p2 true.
@@ -130,26 +67,26 @@ Proof.
     apply subp_sepcon; try apply subp_refl.
     apply allp_left with false.
     eapply derives_trans.
-      apply nonexpansive_entail, nonexpansive_lock_inv.
+      apply semax_conc.nonexpansive_entail, nonexpansive_lock_inv.
       apply fash_derives, andp_left1, derives_refl.
 
     (* join resource invariant *)
     repeat apply subp_sepcon; try apply subp_refl.
       apply allp_left with true.
       eapply derives_trans.
-        apply nonexpansive_entail, nonexpansive_lock_inv.
+        apply semax_conc.nonexpansive_entail, nonexpansive_lock_inv.
         apply fash_derives, andp_left1, derives_refl.
 
       apply allp_left with false.
       eapply derives_trans.
-        apply nonexpansive_entail, nonexpansive_lock_inv.
+        apply semax_conc.nonexpansive_entail, nonexpansive_lock_inv.
         apply fash_derives, andp_left1, derives_refl.
 Qed.
 
 Lemma res_invariant_eq Q sh1 p1 sh2 p2 :
   res_invariant Q sh1 p1 sh2 p2 =
   (Q *
-  lock_inv sh2 p2 (|> join_res_invariant Q sh1 p1 sh2 p2))%logic.
+  lock_inv sh2 p2 (▷ join_res_invariant Q sh1 p1 sh2 p2)).
 Proof.
   unfold res_invariant at 1.
   rewrite res_invariants_eq.
@@ -159,450 +96,164 @@ Qed.
 Lemma join_res_invariant_eq Q sh1 p1 sh2 p2 :
   join_res_invariant Q sh1 p1 sh2 p2 =
   (Q *
-  lock_inv sh1 p1 (|> res_invariant Q sh1 p1 sh2 p2) *
-  lock_inv sh2 p2 (|> join_res_invariant Q sh1 p1 sh2 p2))%logic.
+  lock_inv sh1 p1 (▷ res_invariant Q sh1 p1 sh2 p2) *
+  lock_inv sh2 p2 (▷ join_res_invariant Q sh1 p1 sh2 p2)).
 Proof.
   unfold join_res_invariant at 1.
   rewrite res_invariants_eq.
   reflexivity.
-Qed.
-
-(* Condition variables *)
-(*Definition _cond_t := 4%positive.*)
-Definition tcond := tint.
-
-(* Does this need to be anything special? *)
-Definition cond_var {cs} sh v := @data_at_ cs sh tcond v.
+Qed.*)
 
 (*+ Specification of each concurrent primitive *)
 
-Lemma approx_eq_i':
-  forall (P Q : pred rmap) n,
-  (|> (P <=> Q))%pred n -> approx n P = approx n Q.
-Proof.
-  intros.
-apply pred_ext'; extensionality m'.
-unfold approx.
-apply and_ext'; auto; intros.
-specialize (H (level m')); spec H; [simpl; apply later_nat; auto |].
-specialize (H m').
-spec H; [omega |].
-destruct H.
-specialize (H m').
-specialize (H1 m').
-apply prop_ext; split; auto.
-Qed.
-
-Lemma fash_equiv_approx: forall n (R: pred rmap),
-  (|> (R <=> approx n R))%pred n.
-Proof.
-  intros.
-  intros m ? x ?; split; intros y ? ?.
-  + apply approx_lt; auto.
-    apply necR_level in H1.
-    apply later_nat in H; omega.
-  + eapply approx_p; eauto.
-Qed.
-
-Lemma nonexpansive_super_non_expansive: forall (F: mpred -> mpred),
-  nonexpansive F ->
-  forall R n,
-  approx n (F R) = approx n (F (approx n R)).
-Proof.
-  intros.
-  apply approx_eq_i'.
-  intros m ?.
-  pose proof nonexpansive_entail _ H R (approx n R) m.
-  apply H1.
-  clear - H0.
-  apply (fash_equiv_approx n R m); auto.
-Qed.
+Definition acquire_arg_type: TypeTree := ProdType (ConstType (val * share)) Mpred.
 
-Lemma nonexpansive2_super_non_expansive: forall (F: mpred -> mpred -> mpred),
-  (forall P, nonexpansive (fun Q => F P Q)) ->
-  (forall Q, nonexpansive (fun P => F P Q)) ->
-  forall P Q n,
-  approx n (F P Q) = approx n (F (approx n P) (approx n Q)).
-Proof.
-  intros.
-  apply approx_eq_i'.
-  intros m ?.
-  pose proof nonexpansive_entail _ (H P) Q (approx n Q) m; cbv beta in H2.
-  spec H2; [apply (fash_equiv_approx n Q m); auto |].
-  pose proof nonexpansive_entail _ (H0 (approx n Q)) P (approx n P) m; cbv beta in H3.
-  spec H3; [apply (fash_equiv_approx n P m); auto |].
-  remember (F P Q) as X1.
-  remember (F P (approx n Q)) as X2.
-  remember (F (approx n P) (approx n Q)) as X3.
-  clear - H2 H3.
-  change ((X1 <=> X2)%pred m) in H2.
-  change ((X2 <=> X3)%pred m) in H3.
-  intros y H; specialize (H2 y H); specialize (H3 y H).
-  destruct H2 as [H2A H2B], H3 as [H3A H3B].
-  split; intros z H0.
-  + specialize (H2A z H0); specialize (H3A z H0); auto.
-  + specialize (H2B z H0); specialize (H3B z H0); auto.
-Qed.
+(* up *)
+#[export] Instance monPred_at_ne : NonExpansive (@monPred_at environ_index mpred : _ -> _ -d> _).
+Proof. solve_proper. Qed.
 
-(*
-Lemma nonexpansive_2super_non_expansive: forall {A B: Type} (F: (A -> B -> mpred) -> mpred),
-  (forall a b, nonexpansive (fun Q => F P Q)) ->
-  (forall Q, nonexpansive (fun P => F P Q)) ->
-  forall P Q n,
-  approx n (F P Q) = approx n (F (approx n P) (approx n Q)).
-*)
-Definition acquire_arg_type: rmaps.TypeTree := rmaps.ProdType (rmaps.ConstType (val * share)) rmaps.Mpred.
+#[export] Instance monPred_at_args_ne : NonExpansive (@monPred_at argsEnviron_index mpred : _ -> _ -d> _).
+Proof. solve_proper. Qed.
 
-Definition acquire_pre: val * share * mpred -> environ -> mpred :=
-  fun args =>
-  match args with
-  | (v, sh, R) =>
+Program Definition acquire_spec :=
+  TYPE acquire_arg_type WITH v : _, sh : _, R : _
+  PRE [ tptr tvoid ]
      PROP (readable_share sh)
-     LOCAL (temp _lock v)
+     PARAMS (v)
      SEP (lock_inv sh v R)
-  end.
-
-Notation acquire_post :=
-  (fun args =>
-  match args with
-  | (v, sh, R) =>
+  POST [ tvoid ]
      PROP ()
      LOCAL ()
-     SEP (lock_inv sh v R; R)
-  end).
-
-Lemma NP_acquire_pre: @super_non_expansive acquire_arg_type (fun _ => acquire_pre).
+     SEP (lock_inv sh v R; R).
+Next Obligation.
 Proof.
-  hnf.
-  intros.
-  destruct x as [[v sh] R]; simpl in *.
-  apply (nonexpansive_super_non_expansive
-   (fun R => (PROP (readable_share sh)  LOCAL (temp _lock v)  SEP (lock_inv sh v R)) rho)).
-  apply (PROP_LOCAL_SEP_nonexpansive
-          ((fun _ => readable_share sh) :: nil)
-          ((temp _lock v) :: nil)
-          ((fun R => lock_inv sh v R) :: nil));
-  repeat apply Forall_cons; try apply Forall_nil.
-  + unfold compose. apply const_nonexpansive.
-  + apply nonexpansive_lock_inv.
+  intros ? ((v, sh), R) ((?, ?), ?) ([=] & HR); simpl in *; subst.
+  rewrite HR //.
 Qed.
-
-Lemma NP_acquire_post: @super_non_expansive acquire_arg_type (fun _ => acquire_post).
+Next Obligation.
 Proof.
-  hnf.
-  intros.
-  destruct x as [[v sh] R]; simpl in *.
-  apply (nonexpansive_super_non_expansive
-   (fun R => (PROP ()  LOCAL ()  SEP (lock_inv sh v R; R)) rho)).
-  apply (PROP_LOCAL_SEP_nonexpansive
-          nil
-          nil
-          ((fun R => lock_inv sh v R) :: (fun R => R) :: nil));
-  repeat apply Forall_cons; try apply Forall_nil.
-  + apply nonexpansive_lock_inv.
-  + apply identity_nonexpansive.
+  intros ? ((v, sh), R) ((?, ?), ?) ([=] & HR); simpl in *; subst.
+  rewrite HR //.
 Qed.
 
-Definition acquire_spec: funspec := mk_funspec
-  ((_lock OF tptr Tvoid)%formals :: nil, tvoid)
-  cc_default
-  acquire_arg_type
-  (fun _ => acquire_pre)
-  (fun _ => acquire_post)
-  NP_acquire_pre
-  NP_acquire_post
-.
-
-Definition release_arg_type: rmaps.TypeTree := rmaps.ProdType (rmaps.ConstType (val * share)) rmaps.Mpred.
+Definition release_arg_type: TypeTree := ProdType (ConstType (val * share)) Mpred.
 
-Definition release_pre: val * share * mpred -> environ -> mpred :=
-  fun args =>
-  match args with
-  | (v, sh, R) =>
+Program Definition release_spec :=
+  TYPE release_arg_type WITH v : _, sh : _, R : _
+  PRE [ tptr tvoid ]
      PROP (readable_share sh)
-     LOCAL (temp _lock v)
-     SEP (weak_exclusive_mpred R && emp; lock_inv sh v R; R)
-  end.
-
-Notation release_post :=
-  (fun args =>
-  match args with
-  | (v, sh, R) =>
+     PARAMS (v)
+     SEP (<affine> exclusive_mpred R; lock_inv sh v R; R)
+  POST [ tvoid ]
      PROP ()
      LOCAL ()
-     SEP (lock_inv sh v R)
-  end).
-
-Lemma NP_release_pre: @super_non_expansive release_arg_type (fun _ => release_pre).
+     SEP (lock_inv sh v R).
+Next Obligation.
 Proof.
-  hnf.
-  intros.
-  destruct x as [[v sh] R]; simpl in *.
-  apply (nonexpansive_super_non_expansive
-   (fun R => (PROP (readable_share sh)  LOCAL (temp _lock v)  SEP (weak_exclusive_mpred R && emp; lock_inv sh v R; R)) rho)).
-  apply (PROP_LOCAL_SEP_nonexpansive
-          ((fun _ => readable_share sh) :: nil)
-          ((temp _lock v) :: nil)
-          ((fun R => weak_exclusive_mpred R && emp)%logic :: (fun R => lock_inv sh v R) :: (fun R => R) :: nil));
-  repeat apply Forall_cons; try apply Forall_nil.
-  + apply const_nonexpansive.
-  + apply (conj_nonexpansive (fun R => weak_exclusive_mpred R)%logic).
-    - apply exclusive_mpred_nonexpansive.
-    - apply const_nonexpansive.
-  + apply nonexpansive_lock_inv.
-  + apply identity_nonexpansive.
+  intros ? ((v, sh), R) ((?, ?), ?) ([=] & HR); simpl in *; subst.
+  rewrite /exclusive_mpred HR //.
 Qed.
-
-Lemma NP_release_post: @super_non_expansive release_arg_type (fun _ => release_post).
+Next Obligation.
 Proof.
-  hnf.
-  intros.
-  destruct x as [[v sh] R]; simpl in *.
-  apply (nonexpansive_super_non_expansive
-   (fun R => (PROP ()  LOCAL ()  SEP (lock_inv sh v R)) rho)).
-  apply (PROP_LOCAL_SEP_nonexpansive
-          nil
-          nil
-          ((fun R => lock_inv sh v R) :: nil));
-  repeat apply Forall_cons; try apply Forall_nil.
-  apply nonexpansive_lock_inv.
-Qed.
-
-Definition release_spec: funspec := mk_funspec
-  ((_lock OF tptr Tvoid)%formals :: nil, tvoid)
-  cc_default
-  release_arg_type
-  (fun _ => release_pre)
-  (fun _ => release_post)
-  NP_release_pre
-  NP_release_post
-.
-
-Program Definition makelock_spec cs: funspec := mk_funspec
-  ((_lock OF tptr Tvoid)%formals :: nil, tvoid)
-  cc_default
-  (rmaps.ProdType (rmaps.ConstType (val * share)) rmaps.Mpred)
-  (fun _ x =>
-   match x with
-   | (v, sh, R) =>
-     PROP (writable_share sh)
-     LOCAL (temp _lock v)
-     SEP (@data_at_ cs sh tlock v)
-   end)
-  (fun _ x =>
-   match x with
-   | (v, sh, R) =>
-     PROP ()
-     LOCAL ()
-     SEP (lock_inv sh v R)
-   end)
-  _
-  _
-.
+  intros ? ((v, sh), R) ((?, ?), ?) ([=] & HR); simpl in *; subst.
+  rewrite /exclusive_mpred HR //.
+Qed.
+
+Program Definition makelock_spec (cs : compspecs) : funspec :=
+  TYPE ProdType (ConstType (val * share)) Mpred WITH v : _, sh : _, R : _
+  PRE [ tptr tvoid ]
+    PROP (writable_share sh)
+    PARAMS (v)
+    SEP (data_at_ sh tlock v)
+  POST [ tvoid ]
+    PROP ()
+    LOCAL ()
+    SEP (lock_inv sh v R).
 Next Obligation.
-  intros cs; hnf.
-  intros.
-  destruct x as [[v sh] R]; simpl in *.
-  auto.
+Proof.
+  intros ?? ((v, sh), R) ((?, ?), ?) ([=] & HR); simpl in *; subst.
+  reflexivity.
 Qed.
 Next Obligation.
-  intro cs; hnf.
-  intros.
-  destruct x as [[v sh] R]; simpl in *.
-  apply (nonexpansive_super_non_expansive
-   (fun R => (PROP ()  LOCAL ()  SEP (lock_inv sh v R)) rho)).
-  apply (PROP_LOCAL_SEP_nonexpansive
-          nil
-          nil
-          ((fun R => lock_inv sh v R) :: nil));
-  repeat apply Forall_cons; try apply Forall_nil.
-  apply nonexpansive_lock_inv.
-Qed.
-
-Program Definition freelock_spec cs: funspec := mk_funspec
-  ((_lock OF tptr Tvoid)%formals :: nil, tvoid)
-  cc_default
-  (rmaps.ProdType (rmaps.ConstType (val * share)) rmaps.Mpred)
-  (fun _ x =>
-   match x with
-   | (v, sh, R) =>
-     PROP (writable_share sh)
-     LOCAL (temp _lock v)
-     SEP (weak_exclusive_mpred R && emp; lock_inv sh v R; R)
-   end)
-  (fun _ x =>
-   match x with
-   | (v, sh, R) =>
-     PROP ()
-     LOCAL ()
-     SEP (@data_at_ cs sh tlock v; R)
-   end)
-  _
-  _
-.
+  intros ?? ((v, sh), R) ((?, ?), ?) ([=] & HR); simpl in *; subst.
+  rewrite HR //.
+Qed.
+
+Program Definition freelock_spec (cs : compspecs) : funspec :=
+  TYPE ProdType (ConstType (val * share)) Mpred WITH v : _, sh : _, R : _
+  PRE [ tptr tvoid ]
+    PROP (writable_share sh)
+    PARAMS (v)
+    SEP (exclusive_mpred R; lock_inv sh v R; R)
+  POST [ tvoid ]
+    PROP ()
+    LOCAL ()
+    SEP (data_at_ sh tlock v; R).
 Next Obligation.
-  intro cs; hnf.
-  intros.
-  destruct x as [[v sh] R]; simpl in *.
-  apply (nonexpansive_super_non_expansive
-   (fun R => (PROP (writable_share sh)
-    LOCAL (temp _lock v)
-    SEP (weak_exclusive_mpred R && emp; lock_inv sh v R; R)) rho)).
-  apply (PROP_LOCAL_SEP_nonexpansive
-          ((fun _ => writable_share sh) :: nil)
-          (temp _lock v :: nil)
-          ((fun R => weak_exclusive_mpred R && emp)%logic :: (fun R => lock_inv sh v R) :: (fun R => R) :: nil));
-  repeat apply Forall_cons; try apply Forall_nil.
-  + apply const_nonexpansive.
-  + apply (conj_nonexpansive weak_exclusive_mpred).
-    - apply exclusive_mpred_nonexpansive.
-    - apply const_nonexpansive.
-  + apply nonexpansive_lock_inv.
-  + apply identity_nonexpansive.
+Proof.
+  intros ?? ((v, sh), R) ((?, ?), ?) ([=] & HR); simpl in *; subst.
+  rewrite /exclusive_mpred HR //.
 Qed.
 Next Obligation.
-  intro cs; hnf.
-  intros.
-  destruct x as [[v sh] R]; simpl in *.
-  apply (nonexpansive_super_non_expansive
-   (fun R => (PROP ()  LOCAL ()  SEP (data_at_ sh tlock v; R)) rho)).
-  apply (PROP_LOCAL_SEP_nonexpansive
-          nil
-          nil
-          ((fun _ => data_at_ sh tlock v) :: (fun R => R) :: nil));
-  repeat apply Forall_cons; try apply Forall_nil.
-  + apply const_nonexpansive.
-  + apply identity_nonexpansive.
+Proof.
+  intros ?? ((v, sh), R) ((?, ?), ?) ([=] & HR); simpl in *; subst.
+  rewrite HR //.
 Qed.
 
 (* versions that give away all their resources *)
 
-Lemma selflock_rec : forall sh v R, rec_inv sh v R (selflock R sh v).
+Lemma selflock_rec : forall sh v R, ⊢rec_inv sh v R (selflock R sh v).
 Proof.
   intros; unfold rec_inv.
-  apply selflock_eq.
-Qed.
-
-Program Definition freelock2_spec cs: funspec := mk_funspec
-  ((_lock OF tptr Tvoid)%formals :: nil, tvoid)
-  cc_default
-  (rmaps.ProdType (rmaps.ProdType (rmaps.ConstType (val * share * share)) rmaps.Mpred) rmaps.Mpred)
-  (fun _ x =>
-   match x with
-   | (v, sh, sh', Q, R) =>
-     PROP (writable_share sh)
-     LOCAL (temp _lock v)
-     SEP (weak_exclusive_mpred R && weak_rec_inv sh' v Q R && emp; lock_inv sh v R)
-   end)
-  (fun _ x =>
-   match x with
-   | (v, sh, sh', Q, R) =>
-     PROP ()
-     LOCAL ()
-     SEP (@data_at_ cs sh tlock v)
-   end)
-  _
-  _
-.
+  rewrite {1} selflock_eq.
+  apply bi.wand_iff_refl.
+Qed.
+
+Program Definition freelock2_spec (cs : compspecs) : funspec :=
+  TYPE ProdType (ProdType (ConstType (val * share * share)) Mpred) Mpred
+  WITH v : _, sh : _, sh' : _, Q : _, R : _
+  PRE [ tptr tvoid ]
+    PROP (writable_share sh)
+    PARAMS (v)
+    SEP (exclusive_mpred R; rec_inv sh' v Q R; lock_inv sh v R)
+  POST [ tvoid ]
+    PROP ()
+    LOCAL ()
+    SEP (data_at_ sh tlock v).
 Next Obligation.
-  intro cs; hnf.
-  intros.
-  destruct x as [[[[v sh] sh'] Q] R]; simpl in *.
-  apply (nonexpansive2_super_non_expansive
-   (fun Q R => (PROP (writable_share sh)
-     LOCAL (temp _lock v)
-     SEP (weak_exclusive_mpred R && weak_rec_inv sh' v Q R && emp; lock_inv sh v R)) rho));
-  [ clear Q R; intros Q;
-    apply (PROP_LOCAL_SEP_nonexpansive
-            ((fun _ => writable_share sh) :: nil)
-            (temp _lock v :: nil)
-            ((fun R => weak_exclusive_mpred R && weak_rec_inv sh' v Q R && emp)%logic :: (fun R => lock_inv sh v R) :: nil))
-  | clear Q R; intros R;
-    apply (PROP_LOCAL_SEP_nonexpansive
-            ((fun _ => writable_share sh) :: nil)
-            (temp _lock v :: nil)
-            ((fun Q => weak_exclusive_mpred R && weak_rec_inv sh' v Q R && emp)%logic :: (fun _ => lock_inv sh v R) :: nil))];
-  repeat apply Forall_cons; try apply Forall_nil.
-  + apply const_nonexpansive.
-  + apply (conj_nonexpansive (fun R => weak_exclusive_mpred R && weak_rec_inv sh' v Q R)%logic); [apply (conj_nonexpansive weak_exclusive_mpred) |].
-    - apply exclusive_mpred_nonexpansive.
-    - apply rec_inv1_nonexpansive.
-    - apply const_nonexpansive.
-  + apply nonexpansive_lock_inv.
-  + apply const_nonexpansive.
-  + apply (conj_nonexpansive (fun Q => weak_exclusive_mpred R && weak_rec_inv sh' v Q R)%logic); [apply (conj_nonexpansive (fun _ => weak_exclusive_mpred R)) |].
-    - apply const_nonexpansive.
-    - apply rec_inv2_nonexpansive.
-    - apply const_nonexpansive.
-  + apply const_nonexpansive.
+Proof.
+  intros ?? ((((v, sh), sh'), Q), R) ((((?, ?), ?), ?), ?) (([=] & HQ) & HR); simpl in *; subst.
+  rewrite /exclusive_mpred /rec_inv HQ HR //.
 Qed.
 Next Obligation.
-  intro cs; hnf.
-  intros.
-  destruct x as [[[[v sh] sh'] Q] R]; simpl in *.
-  auto.
+Proof.
+  intros ?? ((((v, sh), sh'), Q), R) ((((?, ?), ?), ?), ?) (([=] & HQ) & HR); simpl in *; subst.
+  reflexivity.
 Qed.
 
-Program Definition release2_spec: funspec := mk_funspec
-  ((_lock OF tptr Tvoid)%formals :: nil, tvoid)
-  cc_default
-  (rmaps.ProdType (rmaps.ProdType (rmaps.ConstType (val * share)) rmaps.Mpred) rmaps.Mpred)
-  (fun _ x =>
-   match x with
-   | (v, sh, Q, R) =>
-     PROP (readable_share sh)
-     LOCAL (temp _lock v)
-     SEP (weak_exclusive_mpred R && weak_rec_inv sh v Q R && emp; R)
-   end)
-  (fun _ x =>
-   match x with
-   | (v, sh, Q, R) =>
-     PROP ()
-     LOCAL ()
-     SEP (emp)
-   end)
-  _
-  _
-.
+Program Definition release2_spec: funspec :=
+  TYPE ProdType (ProdType (ConstType (val * share)) Mpred) Mpred
+  WITH v : _, sh : _, Q : _, R : _
+  PRE [ tptr tvoid ]
+    PROP (readable_share sh)
+    PARAMS (v)
+    SEP (exclusive_mpred R; rec_inv sh v Q R; R)
+  POST [ tvoid ]
+    PROP ()
+    LOCAL ()
+    SEP ().
 Next Obligation.
-  intro cs; hnf.
-  intros.
-  destruct x as [[[v sh] Q] R]; simpl in *.
-  apply (nonexpansive2_super_non_expansive
-   (fun Q R => (PROP (readable_share sh)
-     LOCAL (temp _lock v)
-     SEP (weak_exclusive_mpred R && weak_rec_inv sh v Q R && emp; R)) rho));
-  [ clear Q R; intros Q;
-    apply (PROP_LOCAL_SEP_nonexpansive
-            ((fun _ => readable_share sh) :: nil)
-            (temp _lock v :: nil)
-            ((fun R => weak_exclusive_mpred R && weak_rec_inv sh v Q R && emp)%logic :: (fun R => R) :: nil))
-  | clear Q R; intros R;
-    apply (PROP_LOCAL_SEP_nonexpansive
-            ((fun _ => readable_share sh) :: nil)
-            (temp _lock v :: nil)
-            ((fun Q => weak_exclusive_mpred R && weak_rec_inv sh v Q R && emp)%logic :: (fun _ => R) :: nil))];
-  repeat apply Forall_cons; try apply Forall_nil.
-  + apply const_nonexpansive.
-  + apply (conj_nonexpansive (fun R => weak_exclusive_mpred R && weak_rec_inv sh v Q R)%logic); [apply (conj_nonexpansive (fun R => weak_exclusive_mpred R)%logic) |].
-    - apply exclusive_mpred_nonexpansive.
-    - apply rec_inv1_nonexpansive.
-    - apply const_nonexpansive.
-  + apply identity_nonexpansive.
-  + apply const_nonexpansive.
-  + apply (conj_nonexpansive (fun Q => weak_exclusive_mpred R && weak_rec_inv sh v Q R)%logic); [apply (conj_nonexpansive (fun Q => weak_exclusive_mpred R)%logic) |].
-    - apply const_nonexpansive.
-    - apply rec_inv2_nonexpansive.
-    - apply const_nonexpansive.
-  + apply const_nonexpansive.
+Proof.
+  intros ? (((v, sh), Q), R) (((?, ?), ?), ?) (([=] & HQ) & HR); simpl in *; subst.
+  rewrite /exclusive_mpred /rec_inv HQ HR //.
 Qed.
 Next Obligation.
-  intro cs; hnf.
-  intros.
-  destruct x as [[[v sh] Q] R]; simpl in *.
-  auto.
+Proof.
+  intros ? (((v, sh), Q), R) (((?, ?), ?), ?) (([=] & HQ) & HR); simpl in *; subst.
+  reflexivity.
 Qed.
 
+(*
 (* condition variables *)
 Definition makecond_spec cs :=
    WITH v : val, sh : share
@@ -629,7 +280,7 @@ Definition freecond_spec cs :=
 Program Definition wait_spec cs: funspec := mk_funspec
   ((_cond OF tptr tcond)%formals :: (_lock OF tptr Tvoid)%formals :: nil, tvoid)
   cc_default
-  (rmaps.ProdType (rmaps.ConstType (val * val * share * share)) rmaps.Mpred)
+  (ProdType (ConstType (val * val * share * share)) Mpred)
   (fun _ x =>
    match x with
    | (c, l, shc, shl, R) =>
@@ -686,7 +337,7 @@ Qed.
 Program Definition wait2_spec cs: funspec := mk_funspec
   ((_cond OF tptr tcond)%formals :: (_lock OF tptr Tvoid)%formals :: nil, tvoid)
   cc_default
-  (rmaps.ProdType (rmaps.ConstType (val * val * share * share)) rmaps.Mpred)
+  (ProdType (ConstType (val * val * share * share)) Mpred)
   (fun _ x =>
    match x with
    | (c, l, shc, shl, R) =>
@@ -715,11 +366,11 @@ Next Obligation.
   apply (PROP_LOCAL_SEP_nonexpansive
           ((fun _ => readable_share shc) :: nil)
           (temp _cond c :: temp _lock l :: nil)
-          ((fun R => lock_inv shl l R) :: (fun R => R && (@cond_var cs shc c * TT))%logic :: nil));
+          ((fun R => lock_inv shl l R) :: (fun R => R && (@cond_var cs shc c * TT)) :: nil));
   repeat apply Forall_cons; try apply Forall_nil.
   + apply const_nonexpansive.
   + apply nonexpansive_lock_inv.
-  + apply (conj_nonexpansive (fun R => R) (fun _ => (cond_var shc c * TT)%logic)).
+  + apply (conj_nonexpansive (fun R => R) (fun _ => (cond_var shc c * TT))).
     - apply identity_nonexpansive.
     - apply const_nonexpansive.
 Qed.
@@ -750,7 +401,7 @@ Definition signal_spec cs :=
      PROP ()
      LOCAL ()
      SEP (@cond_var cs shc c).
-
+*)
 
 
 (* Notes about spawn_thread:
@@ -775,128 +426,78 @@ using the oracle, as [acquire] is.  The postcondition would be [match
 PrePost with existT ty (w, pre, post) => thread th (post w b)
 end] *)
 
-Local Open Scope logic.
-
 (* @Qinxiang: it would be great to complete the annotation *)
 
-Definition spawn_arg_type := rmaps.ProdType (rmaps.ProdType (rmaps.ProdType (rmaps.ConstType (val * val))
-  (rmaps.ArrowType (rmaps.DependentType 0) (rmaps.ConstType globals))) (rmaps.DependentType 0))
-  (rmaps.ArrowType (rmaps.DependentType 0) (rmaps.ArrowType (rmaps.ConstType val) rmaps.Mpred)).
-
-Definition spawn_pre :=
-  (fun (ts: list Type) (x: val * val * (nth 0 ts unit -> globals) * nth 0 ts unit *
-                           (nth 0 ts unit -> val -> mpred)) =>
-   match x with
-   | (f, b, gv, w, pre) =>
-     PROP (tc_val (tptr Tvoid) b)
-     (LOCALx (temp _f f :: temp _args b :: gvars (gv w) :: nil)
-     (SEP (
-       EX _y : ident,
-         (func_ptr'
-           (WITH y : val, x : nth 0 ts unit
-             PRE [ _y OF tptr tvoid ]
+Definition spawn_arg_type := ProdType (ConstType (val * val)) (SigType Type (fun A => ProdType (ProdType
+  (ArrowType (ConstType A) (ConstType globals)) (ConstType A))
+  (ArrowType (ConstType A) (ArrowType (ConstType val) Mpred)))).
+
+Program Definition spawn_spec :=
+  TYPE spawn_arg_type WITH f : _, b : _, fs : _
+  PRE [ tptr voidstar_funtype, tptr tvoid ]
+    PROP (tc_val (tptr Tvoid) b)
+    PARAMS (f; b)
+    GLOBALS (let 'existT _ ((gv, w), _) := fs in gv w)
+    SEP (let 'existT _ ((gv, w), pre) := fs in
+         (func_ptr
+           (WITH y : val, x : _
+             PRE [ tptr tvoid ]
                PROP ()
-               (LOCALx (temp _y y :: gvars (gv x) :: nil)
-               (SEP   (pre x y)))
-             POST [tptr tvoid]
+               PARAMS (y)
+               GLOBALS (gv w)
+               SEP (pre x y)
+             POST [ tptr tvoid ]
                PROP  ()
                LOCAL ()
                SEP   ())
            f);
-         valid_pointer b && pre w b)))
-   end).
-
-Definition spawn_post :=
-  (fun (ts: list Type) (x: val * val * (nth 0 ts unit -> globals) * nth 0 ts unit *
-                           (nth 0 ts unit -> val -> mpred)) =>
-   match x with
-   | (f, b, w, pre) =>
-     PROP ()
-     LOCAL ()
-     SEP ()
-   end).
-
-Lemma approx_idem : forall n P, compcert_rmaps.R.approx n (compcert_rmaps.R.approx n P) =
-  compcert_rmaps.R.approx n P.
-Proof.
-  intros.
-  transitivity (base.compose (compcert_rmaps.R.approx n) (compcert_rmaps.R.approx n) P); auto.
-  rewrite compcert_rmaps.RML.approx_oo_approx; auto.
-Qed.
-
-Lemma spawn_pre_nonexpansive: @super_non_expansive spawn_arg_type spawn_pre.
+         let 'existT _ ((gv, w), pre) := fs in valid_pointer b ∧ pre w b) (* Do we need the valid_pointer here? *)
+  POST [ tvoid ]
+    PROP ()
+    LOCAL ()
+    SEP ().
+Next Obligation.
 Proof.
-  repeat intro.
-  destruct x as ((((?, ?), ?), ?), ?); simpl.
-  unfold PROPx; simpl; rewrite !approx_andp; f_equal.
-  unfold LOCALx; simpl; rewrite !approx_andp; f_equal.
-  unfold SEPx; simpl; rewrite !sepcon_emp, !approx_sepcon, !approx_andp, ?approx_idem; f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality y.
-  rewrite approx_func_ptr'.
-  setoid_rewrite approx_func_ptr' at 2.
-  do 3 f_equal.
-  extensionality a rho'; destruct a.
-  rewrite !approx_andp, !approx_sepcon, approx_idem; auto.
+  intros ? ((f, b), (?, ((gv, w), pre))) ((?, ?), (?, ((?, ?), ?))) ([=] & ? & Hfs); simpl in *; subst; simpl in *.
+  destruct Hfs as ((Hgv & [=]) & Hpre); simpl in *; subst.
+  rewrite Hgv.
+  do 5 f_equiv.
+  constructor; last constructor; last done.
+  - apply func_ptr_si_nonexpansive; last done.
+    split3; [done..|].
+    exists eq_refl; simpl.
+    split; first done.
+    split; intros (?, ?); simpl; last done.
+    rewrite (Hpre _ _) //.
+  - rewrite (Hpre _ _) //.
 Qed.
-
-Lemma spawn_post_nonexpansive: @super_non_expansive spawn_arg_type spawn_post.
+Next Obligation.
 Proof.
-  hnf; intros.
-  destruct x as [[[]] pre]; auto.
+  intros ? ((f, b), ?) ((?, ?), ?) ?.
+  reflexivity.
 Qed.
 
-Definition spawn_spec := mk_funspec
-  ((_f OF tptr voidstar_funtype)%formals :: (_args OF tptr tvoid)%formals :: nil, tvoid)
-  cc_default
-  spawn_arg_type
-  spawn_pre
-  spawn_post
-  spawn_pre_nonexpansive
-  spawn_post_nonexpansive.
 
 (*+ Adding the specifications to a void ext_spec *)
 
-(*! The void ext_spec *)
-Definition void_spec T : external_specification juicy_mem external_function T :=
-    Build_external_specification
-      juicy_mem external_function T
-      (fun ef => False)
-      (fun ef Hef ge tys vl m z => False)
-      (fun ef Hef ge ty vl m z => False)
-      (fun rv m z => False).
-
-Definition ok_void_spec (T : Type) : OracleKind.
- refine (Build_OracleKind T (Build_juicy_ext_spec _ (void_spec T) _ _ _)).
-Proof.
-  simpl; intros; contradiction.
-  simpl; intros; contradiction.
-  simpl; intros; intros ? ? ? ?; contradiction.
-Defined.
+Context (Z : Type) `{!externalGS Z Σ}.
 
 Definition concurrent_simple_specs (cs : compspecs) (ext_link : string -> ident) :=
   (ext_link "acquire"%string, acquire_spec) ::
   (ext_link "release"%string, release_spec) ::
   nil.
 
-Definition concurrent_simple_ext_spec Z (cs : compspecs) (ext_link : string -> ident) :=
-  add_funspecs_rec
+#[local] Instance concurrent_simple_ext_spec (cs : compspecs) (ext_link : string -> ident) : ext_spec OK_ty :=
+  add_funspecs_rec OK_ty
     ext_link
-    (ok_void_spec Z).(@OK_ty)
-    (ok_void_spec Z).(@OK_spec)
+    (void_spec OK_ty)
     (concurrent_simple_specs cs ext_link).
 
-Definition Concurrent_Simple_Espec Z cs ext_link :=
-  Build_OracleKind
-    Z
-    (concurrent_simple_ext_spec Z cs ext_link).
-
 Lemma strong_nat_ind (P : nat -> Prop) (IH : forall n, (forall i, lt i n -> P i) -> P n) n : P n.
 Proof.
   apply IH; induction n; intros i li; inversion li; eauto.
 Qed.
 
-Set Printing Implicit.
-
 Definition concurrent_specs (cs : compspecs) (ext_link : string -> ident) :=
   (ext_link "acquire"%string, acquire_spec) ::
   (ext_link "release"%string, release_spec) ::
@@ -905,14 +506,10 @@ Definition concurrent_specs (cs : compspecs) (ext_link : string -> ident) :=
   (ext_link "spawn"%string, spawn_spec) ::
   nil.
 
-Definition concurrent_ext_spec Z (cs : compspecs) (ext_link : string -> ident) :=
-  add_funspecs_rec
+#[export] Instance concurrent_ext_spec (cs : compspecs) (ext_link : string -> ident) : ext_spec OK_ty :=
+  add_funspecs_rec OK_ty
     ext_link
-    (ok_void_spec Z).(@OK_ty)
-    (ok_void_spec Z).(@OK_spec)
+    (void_spec OK_ty)
     (concurrent_specs cs ext_link).
 
-Definition Concurrent_Espec Z cs ext_link :=
-  Build_OracleKind
-    Z
-    (concurrent_ext_spec Z cs ext_link).
+End mpred.
diff --git a/concurrency/juicy/semax_conc_pred.v b/concurrency/juicy/semax_conc_pred.v
index 8cdf0cb57b..9556c2adfb 100644
--- a/concurrency/juicy/semax_conc_pred.v
+++ b/concurrency/juicy/semax_conc_pred.v
@@ -1,364 +1,33 @@
-Require Import VST.msl.msl_standard.
-Require Import VST.msl.seplog.
-Require Import VST.veric.base.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.juicy_mem.
-Require Import VST.veric.juicy_mem_lemmas.
-Require Import VST.veric.juicy_mem_ops.
-Require Import VST.veric.juicy_extspec.
-Require Import VST.veric.tycontext.
-Require Import VST.veric.expr2.
-Require Import VST.veric.semax.
-Require Import VST.veric.semax_call.
-Require Import VST.veric.semax_ext.
-Require Import VST.veric.semax_ext_oracle.
-Require Import VST.veric.juicy_safety.
-Require Import VST.veric.Clight_new.
-Require Import VST.veric.res_predicates.
 Require Import VST.veric.SeparationLogic.
-Require Import VST.sepcomp.extspec.
-Require Import VST.floyd.reptype_lemmas.
-Require Import VST.floyd.field_at.
-Require Import VST.floyd.nested_field_lemmas.
-Require Import VST.floyd.client_lemmas.
-Require Import VST.floyd.jmeq_lemmas.
 Require Import VST.concurrency.common.lksize.
 
-Lemma approx_derives_ge : forall n m P, (n <= m)%nat -> approx n P |-- approx m P.
-Proof.
-  intros; change (predicates_hered.derives (approx n P) (approx m P)).
-  intros ? []; split; auto; omega.
-Qed.
-
-Lemma approx_derives : forall P n, approx n P |-- P.
-Proof.
-  exact approx_p.
-Qed.
+Section mpred.
 
-Definition exclusive_mpred (R : mpred) :=
-  (R * R |-- FF)%logic.
+Context `{heapGS Σ}.
 
-Program Definition weak_exclusive_mpred (P: mpred): mpred :=
-  fun w => exclusive_mpred (approx (S (level w)) P).
-Next Obligation.
-  intros; hnf; intros.
-  unfold exclusive_mpred in *.
-  apply age_level in H.
-  eapply derives_trans, H0.
-  apply sepcon_derives; apply approx_derives_ge; omega.
-Defined.
+Definition exclusive_mpred R : mpred := ((R ∗ R) -∗ False)%I.
 
-Lemma corable_weak_exclusive R : seplog.corable (weak_exclusive_mpred R).
-Proof.
-  change (corable.corable (weak_exclusive_mpred R)).
-  intro; simpl.
-  rewrite level_core; auto.
-Qed.
-
-Lemma exclusive_mpred_nonexpansive:
-  nonexpansive weak_exclusive_mpred.
-Proof.
-  hnf; intros.
-  intros n ?.
-  simpl in H |- *.
-  assert (forall y, (n >= level y)%nat -> (P y <-> Q y)).
-  {
-    intros; specialize (H y H0).
-    destruct H.
-    specialize (H y). spec H; [auto |].
-    specialize (H1 y). spec H1; [auto |].
-    tauto.
-  }
-  clear H.
-  intros; split; intros.
-  + unfold exclusive_mpred in *.
-    eapply derives_trans, H2.
-    match goal with |- ?P |-- ?Q => change (predicates_hered.derives P Q) end.
-    intros ? (? & ? & J & [] & []).
-    pose proof (join_level _ _ _ J) as [].
-    apply necR_level in H1.
-    do 3 eexists; eauto; split; split; try omega; apply H0; auto; omega.
-  + unfold exclusive_mpred in *.
-    eapply derives_trans, H2.
-    match goal with |- ?P |-- ?Q => change (predicates_hered.derives P Q) end.
-    intros ? (? & ? & J & [] & []).
-    pose proof (join_level _ _ _ J) as [].
-    apply necR_level in H1.
-    do 3 eexists; eauto; split; split; try omega; apply H0; auto; omega.
-Qed.
+Definition LKN := nroot .@ "LK".
 
 Definition lock_inv : share -> val -> mpred -> mpred :=
   fun sh v R =>
-    (EX b : block, EX ofs : _,
-      !!(v = Vptr b ofs) &&
-      LKspec LKSIZE
-        R sh (b, Ptrofs.unsigned ofs))%logic.
-
-Definition rec_inv sh v (Q R: mpred): Prop :=
-  (R = Q * |>lock_inv sh v R)%logic.
-
-Definition weak_rec_inv sh v (Q R: mpred): mpred :=
-  (! (R <=> Q * |>lock_inv sh v R))%pred.
-
-Lemma lockinv_isptr sh v R : lock_inv sh v R = (!! isptr v && lock_inv sh v R)%logic.
-Proof.
-  assert (D : isptr v \/ ~isptr v) by (destruct v; simpl; auto).
-  destruct D.
-  - rewrite prop_true_andp; auto.
-  - rewrite prop_false_andp; auto.
-    apply pred_ext.
-    + unfold lock_inv. Transparent mpred. Intros b ofs. Opaque mpred. subst; simpl in *; tauto.
-    + apply FF_left.
-Qed.
-
-Lemma unfash_fash_equiv: forall P Q: mpred,
-  (P <=> Q |--
-  (subtypes.unfash (subtypes.fash P): mpred) <=> (subtypes.unfash (subtypes.fash Q): mpred))%pred.
-Proof.
-  intros.
-  hnf; intros.
-  assert (forall y: rmap, (a >= level y)%nat -> (app_pred P y <-> app_pred Q y)).
-  {
-    intros; specialize (H y H0).
-    destruct H.
-    specialize (H y). spec H; [auto |].
-    specialize (H1 y). spec H1; [auto |].
-    tauto.
-  }
-  hnf; intros.
-  split; simpl; hnf; intros.
-  + apply necR_level in H2.
-    rewrite <- H0 by omega.
-    auto.
-  + apply necR_level in H2.
-    rewrite H0 by omega.
-    auto.
-Qed.
+    (∃ b : block, ∃ ofs : _, ⌜v = Vptr b ofs⌝ ∧
+      inv LKN (∃ st, LKspec LKSIZE st sh (b, Ptrofs.unsigned ofs) ∗ if st then emp else R)).
 
-Lemma iffp_equiv: forall P1 Q1 P2 Q2: mpred,
-  ((P1 <=> Q1) && (P2 <=> Q2) |-- (P1 <--> P2) <=> (Q1 <--> Q2))%pred.
-Proof.
-  intros.
-  hnf; intros.
-  destruct H.
-  assert (forall y: rmap, (a >= level y)%nat -> (app_pred P1 y <-> app_pred Q1 y)).
-  {
-    intros; specialize (H y H1).
-    destruct H.
-    specialize (H y). spec H; [auto |].
-    specialize (H2 y). spec H2; [auto |].
-    tauto.
-  }
-  assert (forall y: rmap, (a >= level y)%nat -> (app_pred P2 y <-> app_pred Q2 y)).
-  {
-    intros; specialize (H0 y H2).
-    destruct H0.
-    specialize (H0 y). spec H0; [auto |].
-    specialize (H3 y). spec H3; [auto |].
-    tauto.
-  }
-  split; intros; hnf; intros.
-  + split; [destruct H5 as [? _] | destruct H5 as [_ ?]]; intros ? HH; specialize (H5 _ HH).
-    - apply necR_level in H4.
-      apply necR_level in HH.
-      rewrite <- H1, <- H2 by omega.
-      auto.
-    - apply necR_level in H4.
-      apply necR_level in HH.
-      rewrite <- H1, <- H2 by omega.
-      auto.
-  + split; [destruct H5 as [? _] | destruct H5 as [_ ?]]; intros ? HH; specialize (H5 _ HH).
-    - apply necR_level in H4.
-      apply necR_level in HH.
-      rewrite H1, H2 by omega.
-      auto.
-    - apply necR_level in H4.
-      apply necR_level in HH.
-      rewrite H1, H2 by omega.
-      auto.
-Qed.
-
-Lemma sepcon_equiv: forall P1 Q1 P2 Q2: mpred,
-  ((P1 <=> Q1) && (P2 <=> Q2) |-- (P1 * P2) <=> (Q1 * Q2))%pred.
-Proof.
-  intros.
-  hnf; intros.
-  destruct H.
-  assert (forall y: rmap, (a >= level y)%nat -> (app_pred P1 y <-> app_pred Q1 y)).
-  {
-    intros; specialize (H y H1).
-    destruct H.
-    specialize (H y). spec H; [auto |].
-    specialize (H2 y). spec H2; [auto |].
-    tauto.
-  }
-  assert (forall y: rmap, (a >= level y)%nat -> (app_pred P2 y <-> app_pred Q2 y)).
-  {
-    intros; specialize (H0 y H2).
-    destruct H0.
-    specialize (H0 y). spec H0; [auto |].
-    specialize (H3 y). spec H3; [auto |].
-    tauto.
-  }
-  split; intros; hnf; intros.
-  + destruct H5 as [w1 [w2 [? [? ?]]]].
-    exists w1, w2; split; [| split]; auto.
-    - apply necR_level in H4.
-      apply join_level in H5.
-      rewrite <- H1 by omega; auto.
-    - apply necR_level in H4.
-      apply join_level in H5.
-      rewrite <- H2 by omega; auto.
-  + destruct H5 as [w1 [w2 [? [? ?]]]].
-    exists w1, w2; split; [| split]; auto.
-    - apply necR_level in H4.
-      apply join_level in H5.
-      rewrite H1 by omega; auto.
-    - apply necR_level in H4.
-      apply join_level in H5.
-      rewrite H2 by omega; auto.
-Qed.
-
-Lemma later_equiv: forall P Q: mpred,
-  (P <=> Q |-- |> P <=> |> Q)%pred.
-Proof.
-  intros.
-  hnf; intros.
-  assert (forall y: rmap, (a >= level y)%nat -> (app_pred P y <-> app_pred Q y)).
-  {
-    intros; specialize (H y H0).
-    destruct H.
-    specialize (H y). spec H; [auto |].
-    specialize (H1 y). spec H1; [auto |].
-    tauto.
-  }
-  hnf; intros.
-  split; hnf; intros; simpl in *; intros.
-  + specialize (H3 _ H4).
-    apply necR_level in H2.
-    apply laterR_level in H4.
-    rewrite <- H0 by omega.
-    auto.
-  + specialize (H3 _ H4).
-    apply necR_level in H2.
-    apply laterR_level in H4.
-    rewrite H0 by omega.
-    auto.
-Qed.
-
-Lemma nonexpansive_lock_inv : forall sh p, nonexpansive (lock_inv sh p).
-Proof.
-  intros.
-  unfold lock_inv.
-  apply @exists_nonexpansive.
-  intros b.
-  apply @exists_nonexpansive.
-  intros y.
-  apply @conj_nonexpansive.
-  apply @const_nonexpansive.
-
-  unfold LKspec.
-  apply conj_nonexpansive, const_nonexpansive.
-  apply forall_nonexpansive; intros.
-  hnf; intros.
-  intros n ?.
-  assert (forall y: rmap, (n >= level y)%nat -> (app_pred P y <-> app_pred Q y)).
-  {
-    clear - H.
-    intros; specialize (H y H0).
-    destruct H.
-    specialize (H y). spec H; [auto |].
-    specialize (H1 y). spec H1; [auto |].
-    tauto.
-  }
-  simpl; split; intros.
-  + if_tac; auto.
-    destruct H3 as [p0 ?].
-    exists p0.
-    rewrite H3; f_equal.
-    f_equal.
-    extensionality ts; clear ts.
-    clear H3 H4 p0.
-    apply predicates_hered.pred_ext; hnf; intros ? [? ?]; split; auto.
-    - apply necR_level in H2.
-      rewrite <- H0 by omega; auto.
-    - apply necR_level in H2.
-      rewrite H0 by omega; auto.
-  + if_tac; auto.
-    destruct H3 as [p0 ?].
-    exists p0.
-    rewrite H3; f_equal.
-    f_equal.
-    extensionality ts; clear ts.
-    clear H3 H4 p0.
-    apply predicates_hered.pred_ext; hnf; intros ? [? ?]; split; auto.
-    - apply necR_level in H2.
-      rewrite H0 by omega; auto.
-    - apply necR_level in H2.
-      rewrite <- H0 by omega; auto.
-Qed.
+Definition rec_inv sh v (Q R: mpred): mpred := (R ∗-∗ Q ∗ ▷ lock_inv sh v R)%I.
 
-Lemma rec_inv1_nonexpansive: forall sh v Q,
-  nonexpansive (weak_rec_inv sh v Q).
+Lemma lockinv_isptr sh v R : lock_inv sh v R ⊣⊢ (⌜isptr v⌝ ∧ lock_inv sh v R).
 Proof.
-  intros.
-  unfold weak_rec_inv.
-  intros P1 P2.
-  eapply predicates_hered.derives_trans; [| apply unfash_fash_equiv].
-  eapply predicates_hered.derives_trans; [| apply iffp_equiv].
-  apply predicates_hered.andp_right; auto.
-  eapply predicates_hered.derives_trans; [| apply sepcon_equiv].
-  apply predicates_hered.andp_right.
-  {
-    intros n ?.
-    split; intros; hnf; intros; auto.
-  }
-  rewrite <- subtypes.eqp_later.
-  eapply predicates_hered.derives_trans, predicates_hered.now_later.
-  apply nonexpansive_lock_inv.
+  rewrite comm; apply add_andp.
+  by iIntros "(% & % & -> & ?)".
 Qed.
 
-Lemma rec_inv2_nonexpansive: forall sh v R,
-  nonexpansive (fun Q => weak_rec_inv sh v Q R).
+#[global] Instance lock_inv_nonexpansive sh v : NonExpansive (lock_inv sh v).
 Proof.
-  intros.
-  unfold weak_rec_inv.
-  intros P1 P2.
-  eapply predicates_hered.derives_trans; [| apply unfash_fash_equiv].
-  eapply predicates_hered.derives_trans; [| apply iffp_equiv].
-  apply predicates_hered.andp_right.
-  {
-    intros n ?.
-    split; intros; hnf; intros; auto.
-  }
-  eapply predicates_hered.derives_trans; [| apply sepcon_equiv].
-  apply predicates_hered.andp_right; auto.
-
-  intros n ?.
-  split; intros; hnf; intros; auto.
+  rewrite /lock_inv /LKspec; intros ??? Heq.
+  do 9 f_equiv.
+  simple_if_tac; first done.
+  rewrite Heq //.
 Qed.
 
-Lemma exclusive_weak_exclusive: forall R,
-  exclusive_mpred R ->
-  TT |-- weak_exclusive_mpred R.
-Proof.
-  intros.
-  change (predicates_hered.derives TT (weak_exclusive_mpred R)).
-  intros w _.
-  simpl.
-  eapply derives_trans, H.
-  apply sepcon_derives; apply approx_derives.
-Qed.
-
-Lemma rec_inv_weak_rec_inv: forall sh v Q R,
-  rec_inv sh v Q R ->
-  TT |-- weak_rec_inv sh v Q R.
-Proof.
-  intros.
-  change (predicates_hered.derives TT (weak_rec_inv sh v Q R)).
-  intros w _.
-  hnf in H |- *.
-  intros.
-  rewrite H at 1 4.
-  split; intros; hnf; intros; auto.
-Qed.
+End mpred.
diff --git a/concurrency/juicy/semax_initial.v b/concurrency/juicy/semax_initial.v
index cf18c86063..69104fdc53 100644
--- a/concurrency/juicy/semax_initial.v
+++ b/concurrency/juicy/semax_initial.v
@@ -10,17 +10,12 @@ Require Import compcert.common.Values.
 
 Require Import VST.msl.Coqlib2.
 Require Import VST.msl.eq_dec.
-Require Import VST.msl.seplog.
-Require Import VST.msl.age_to.
-Require Import VST.veric.initial_world.
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.juicy_mem_lemmas.
 Require Import VST.veric.semax_prog.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.Clight_new.
-Require Import VST.veric.Clightnew_coop.
+Require Import VST.veric.Clight_core.
+Require Import VST.veric.Clightcore_coop.
 Require Import VST.veric.semax.
-Require Import VST.veric.semax_ext.
 Require Import VST.veric.juicy_extspec.
 Require Import VST.veric.initial_world.
 Require Import VST.veric.juicy_extspec.
@@ -36,6 +31,7 @@ Require Import VST.sepcomp.event_semantics.
 Require Import VST.concurrency.juicy.semax_conc_pred.
 Require Import VST.concurrency.juicy.semax_conc.
 Require Import VST.concurrency.juicy.juicy_machine.
+Require Import VST.concurrency.compiler.mem_equiv.
 Require Import VST.concurrency.common.HybridMachineSig.
 Require Import VST.concurrency.common.scheduler.
 Require Import VST.concurrency.common.addressFiniteMap.
@@ -55,36 +51,100 @@ Lemma initmem_maxedmem:
 Proof.
 intros.
 unfold Genv.init_mem in H.
-assert (mem_equiv.mem_equiv (maxedmem Mem.empty) Mem.empty) 
-  by admit.
+assert (mem_equiv.mem_equiv (maxedmem Mem.empty) Mem.empty).
+{ constructor; auto; intros ?; reflexivity. }
 forget Mem.empty as m0.
 revert m0 m H H0; induction (AST.prog_defs prog); intros.
-simpl in H. inv H.
-auto.
+{ simpl in H. inv H; auto. }
 simpl in H.
 destruct (Genv.alloc_global (Genv.globalenv prog) m0 a) eqn:?H; try discriminate.
 apply IHl in H; auto.
 clear - H1 H0.
 destruct a.
-destruct g.
-simpl in H1.
-destruct (Mem.alloc m0 0 1) eqn:?H.
-admit.
-simpl in H1.
-destruct (Mem.alloc m0 0 (init_data_list_size (gvar_init v))) eqn:?H.
-destruct (store_zeros m b 0 (init_data_list_size (gvar_init v))) eqn:?H; try discriminate.
-destruct (Genv.store_init_data_list (Genv.globalenv prog) m2 b 0 (gvar_init v)) eqn:?H; try discriminate.
-apply initialize.store_init_data_list_access in H3.
-apply store_zeros_access in H2.
-rewrite H2 in H3; clear dependent m2.
-admit.
-Admitted. 
+destruct g; simpl in H1.
+- destruct (Mem.alloc m0 0 1) eqn:?H.
+  constructor; auto; intros ?; try reflexivity.
+  + extensionality o.
+    rewrite !getCurPerm_correct.
+    unfold maxedmem.
+    rewrite restrPermMap_Cur, getMaxPerm_correct.
+    destruct (adr_range_dec (b, 0) 1 (b0, o)).
+    * destruct a; subst.
+      pose proof (access_drop_1 _ _ _ _ _ _ H1 _ H3) as Hm1.
+      pose proof (Hm1 Cur) as [? Hm1c]; pose proof (Hm1 Max) as [? Hm1m].
+      unfold access_at in *; unfold permission_at; simpl in *.
+      rewrite Hm1c, Hm1m; auto.
+    * pose proof (access_drop_3 _ _ _ _ _ _ H1 b0 o) as Hm1.
+      pose proof (Hm1 Cur) as Hm1c; pose proof (Hm1 Max) as Hm1m.
+      unfold adr_range in *; spec Hm1c; [lia|]; spec Hm1m; [lia|].
+      unfold access_at in *; unfold permission_at; simpl in *.
+      rewrite <- Hm1c, <- Hm1m.
+      pose proof (alloc_access_other _ _ _ _ _ H b0 o) as Hm.
+      pose proof (Hm Cur) as Hmc; pose proof (Hm Max) as Hmm.
+      unfold adr_range in *; spec Hmc; [lia|]; spec Hmm; [lia|].
+      unfold access_at in *; simpl in *.
+      rewrite <- Hmc, <- Hmm.
+      destruct H0.
+      specialize (cur_eqv b0).
+      apply equal_f with o in cur_eqv.
+      rewrite !getCurPerm_correct in cur_eqv.
+      unfold maxedmem in cur_eqv.
+      rewrite restrPermMap_Cur, getMaxPerm_correct in cur_eqv.
+      auto.
+  + extensionality o.
+    rewrite !getMaxPerm_correct.
+    unfold maxedmem.
+    rewrite restrPermMap_Max, getMaxPerm_correct.
+    auto.
+- destruct (Mem.alloc m0 0 (init_data_list_size (gvar_init v))) eqn:?H.
+  destruct (store_zeros m b 0 (init_data_list_size (gvar_init v))) eqn:?H; try discriminate.
+  destruct (Genv.store_init_data_list (Genv.globalenv prog) m2 b 0 (gvar_init v)) eqn:?H; try discriminate.
+  apply initialize.store_init_data_list_access in H3.
+  apply store_zeros_access in H2.
+  rewrite H2 in H3; clear dependent m2.
+  constructor; auto; intros ?; try reflexivity.
+  + extensionality o.
+    rewrite !getCurPerm_correct.
+    unfold maxedmem.
+    rewrite restrPermMap_Cur, getMaxPerm_correct.
+    destruct (adr_range_dec (b, 0) (init_data_list_size (gvar_init v)) (b0, o)).
+    * destruct a; subst.
+      pose proof (access_drop_1 _ _ _ _ _ _ H1 _ H4) as Hm1.
+      pose proof (Hm1 Cur) as [? Hm1c]; pose proof (Hm1 Max) as [? Hm1m].
+      unfold access_at in *; unfold permission_at; simpl in *.
+      rewrite Hm1c, Hm1m; auto.
+    * pose proof (access_drop_3 _ _ _ _ _ _ H1 b0 o) as Hm1.
+      pose proof (Hm1 Cur) as Hm1c; pose proof (Hm1 Max) as Hm1m.
+      unfold adr_range in *; spec Hm1c; [lia|]; spec Hm1m; [lia|].
+      unfold access_at in *; unfold permission_at; simpl in *.
+      rewrite <- Hm1c, <- Hm1m.
+      apply equal_f with (b0, o) in H3.
+      pose proof (equal_f H3 Cur) as Hm3c; pose proof (equal_f H3 Max) as Hm3m; simpl in *.
+      rewrite <- Hm3c, <- Hm3m.
+      pose proof (alloc_access_other _ _ _ _ _ H b0 o) as Hm.
+      pose proof (Hm Cur) as Hmc; pose proof (Hm Max) as Hmm.
+      unfold adr_range in *; spec Hmc; [lia|]; spec Hmm; [lia|].
+      unfold access_at in *; simpl in *.
+      rewrite <- Hmc, <- Hmm.
+      destruct H0.
+      specialize (cur_eqv b0).
+      apply equal_f with o in cur_eqv.
+      rewrite !getCurPerm_correct in cur_eqv.
+      unfold maxedmem in cur_eqv.
+      rewrite restrPermMap_Cur, getMaxPerm_correct in cur_eqv.
+      auto.
+  + extensionality o.
+    rewrite !getMaxPerm_correct.
+    unfold maxedmem.
+    rewrite restrPermMap_Max, getMaxPerm_correct.
+    auto.
+Qed.
 
 Section Initial_State.
   Variables
     (CS : compspecs) (V : varspecs) (G : funspecs)
     (ext_link : string -> ident) (prog : Clight.program)
-    (all_safe : semax_prog.semax_prog (Concurrent_Espec unit CS ext_link) prog V G)
+    (all_safe : semax_prog.semax_prog (Concurrent_Espec unit CS ext_link) prog tt V G)
     (init_mem_not_none : Genv.init_mem prog <> None).
 
   Definition Jspec := @OK_spec (Concurrent_Espec unit CS ext_link).
@@ -98,17 +158,18 @@ Section Initial_State.
   Definition initial_state (n : nat) (sch : schedule) : cm_state :=
     (proj1_sig init_m,
      (nil, sch,
-      let spr := semax_prog_rule'
+      let spr := semax_prog_rule
                    (Concurrent_Espec unit CS ext_link) V G prog
-                   (proj1_sig init_m) 0 all_safe (proj2_sig init_m) in
-      let q : corestate := projT1 (projT2 spr) in
-      let jm : juicy_mem := proj1_sig (snd (projT2 (projT2 spr)) n tt) in
-      @OrdinalPool.mk LocksAndResources (ClightSemanticsForMachines.Clight_newSem (globalenv prog))
+                   (proj1_sig init_m) 0 tt (allows_exit ext_link) all_safe (proj2_sig init_m) in
+      let q := projT1 (projT2 spr) in
+      let jm : juicy_mem := proj1_sig (snd (projT2 (projT2 spr)) n) in
+      @OrdinalPool.mk LocksAndResources (ClightSemanticsForMachines.ClightSem (globalenv prog))
         (pos.mkPos (le_n 1))
         (* (fun _ => Kresume q Vundef) *)
         (fun _ => Krun q)
         (fun _ => m_phi jm)
         (addressFiniteMap.AMap.empty _)
+        (wsat_rmap (m_phi jm))
      )
     ).
 
@@ -130,98 +191,79 @@ Section Initial_State.
   Proof.
     unfold initial_state.
     destruct init_m as [m Hm]; simpl proj1_sig; simpl proj2_sig.
-    set (spr := semax_prog_rule' (Concurrent_Espec unit CS ext_link) V G prog m 0 all_safe Hm).
+    set (spr := semax_prog_rule (Concurrent_Espec unit CS ext_link) V G prog m 0 tt (allows_exit ext_link) all_safe Hm).
     set (q := projT1 (projT2 spr)).
-    set (jm := proj1_sig (snd (projT2 (projT2 spr)) n tt)).
+    destruct (snd (projT2 (projT2 spr))) as (jm & D & H & E & (z & W & Hdry & Hext) & A & NL & MFS & FA).
     match goal with |- _ _ _ (_, (_, ?TP)) => set (tp := TP) end.
 
     (*! compatibility of memories *)
-    assert (compat : mem_compatible_with tp m (m_phi jm)).
+    assert (compat : mem_compatible_with tp m (m_phi z)).
     {
       constructor.
-      + apply AllJuice with (m_phi jm) None.
-        * change (proj1_sig (snd (projT2 (projT2 spr)) n tt)) with jm.
-          unfold join_threads.
-          unfold getThreadsR.
-
-          match goal with |- _ ?l _ => replace l with (m_phi jm :: nil) end; swap 1 2. {
-            simpl.
-            set (a := m_phi jm).
-            match goal with |- context [m_phi ?jm] => set (b := m_phi jm) end.
-            replace b with a by reflexivity. clear. clearbody a.
-            reflexivity.
-            (* unfold fintype.ord_enum, eqtype.insub, seq.iota in *.
-            simpl.
-            destruct ssrbool.idP as [F|F]. reflexivity. exfalso. auto. *)
-          }
-          exists (core (m_phi jm)). {
+      + apply AllJuice with (m_phi jm) None (m_phi jm).
+        * unfold join_threads.
+          unfold getThreadsR; simpl.
+          exists (id_core (m_phi jm)). {
             split.
             - apply join_comm.
-              apply core_unit.
-            - apply core_identity.
+              apply id_core_unit.
+            - apply id_core_identity.
           }
-
         * reflexivity.
         * constructor.
-      + destruct (snd (projT2 (projT2 spr))) as [jm' [D H]]; unfold jm; clear jm; simpl.
-        subst m.
+        * apply W.
+      + subst m.
+        rewrite Hdry.
         apply mem_cohere'_juicy_mem.
       + intros b ofs.
-        match goal with |- context [ssrbool.isSome ?x] => destruct x as [ phi | ] eqn:Ephi end; swap 1 2.
-        { unfold is_true. simpl. congruence. } intros _.
+        match goal with |- context [ssrbool.isSome ?x] => destruct x as [ phi | ] eqn:Ephi end.
+        intros _.
         unfold tp in Ephi; simpl in Ephi.
         discriminate.
+        { unfold is_true. simpl. congruence. }
       + intros loc L. (* sh psh P z *)
-        destruct (snd (projT2 (projT2 spr))) as (jm' & D & H & E & A & NL & MFS).
-        unfold jm in *; clear jm; simpl in L |- *.
         pose proof (NL loc) as NL'.
-        specialize (L 0). spec L. pose proof lksize.LKSIZE_pos; omega. destruct L as [sh [psh [P L]]].
+        specialize (L 0). spec L. pose proof lksize.LKSIZE_pos; lia. destruct L as [sh [psh [P L]]].
         specialize (NL' sh psh lksize.LKSIZE 0 P). rewrite fst_snd0 in L.
-        rewrite L in NL'. contradiction NL'; auto.
+        simpl in *.
+        apply rmap_order in Hext as (? & Hr & _); rewrite Hr in *; contradiction.
       + hnf.
         simpl.
         intros ? F.
         inversion F.
     } (* end of mcompat *)
 
-    assert (En : level (m_phi jm) = n). {
-      unfold jm; clear.
-      match goal with
-        |- context [proj1_sig ?x] => destruct x as (jm' & jmm & lev & S & nolocks)
-      end; simpl.
-      rewrite level_juice_level_phi in *.
-      auto.
+    assert (En : level (m_phi z) = n). {
+      clear dependent tp. rewrite level_juice_level_phi in *; apply join_level in W as []; congruence.
     }
 
-    apply state_invariant_c with (PHI := m_phi jm) (mcompat := compat).
+    apply state_invariant_c with (mcompat := compat).
     - (*! level *)
       auto.
 
     - (*! env_coherence *)
-      destruct (snd (projT2 (projT2 spr))) as (jm' & D & H & E & A & NL & MFS & FA).
-      simpl in jm. unfold jm.
       split.
-      + apply MFS.
-      + exists prog, CS, V. auto.
-    - clear - Hm.
+      + eapply pred_upclosed, MFS; auto.
+      + exists prog, tt, CS, V; split3; auto.
+        eapply pred_upclosed; eauto.
+(*    - clear - Hm.
       split.
       pose proof ( Genv.initmem_inject _ Hm).
       apply initmem_maxedmem in Hm.
       red. rewrite Hm. apply H.
       apply Genv.init_mem_genv_next in Hm. rewrite <- Hm.
-     unfold globalenv. simpl. apply Ple_refl.
+     unfold globalenv. simpl. apply Ple_refl. *)
     - (*! external coherence *)
-      destruct (snd (projT2 (projT2 spr))) as (jm' & D & H & E & A & NL & MFS & FA).
-      simpl in jm. unfold jm.
-      subst jm tp; clear - E.
-      assert (@ghost.valid (ghost_PCM.ext_PCM unit) (Some (Tsh, Some tt), Some (Some tt))).
-      { simpl; split; [apply Share.nontrivial|].
-        eexists; apply join_comm, core_unit. }
-      eexists; apply join_comm, own.singleton_join_gen with (k := O).
-      erewrite nth_error_nth in E by (apply nth_error_Some; rewrite E; discriminate).
-      inversion E as [Heq]; rewrite Heq.
-      instantiate (1 := (_, _)); constructor; constructor; simpl; [|repeat constructor].
-      unshelve constructor; [| apply H | repeat constructor].
+      subst tp; clear - W E.
+      apply ghost_of_join in W.
+      unfold wsat_rmap in W; rewrite ghost_of_make_rmap in W.
+      inv W.
+      { rewrite <- H0 in E; discriminate. }
+      assert (a3 = a1) by (inv H3; auto); subst.
+      rewrite <- H in E; inv E.
+      unfold ext_compat; rewrite <- H2; eexists; constructor; constructor.
+      instantiate (1 := (_, _)).
+      split; simpl; [apply ext_ref_join | split; eauto].
 
     - (*! lock sparsity (no locks at first) *)
       intros l1 l2.
@@ -231,42 +273,39 @@ Section Initial_State.
     - (*! lock coherence (no locks at first) *)
       intros lock.
       rewrite find_empty.
-      (* split; *) intros (sh & sh' & z & P & E); revert E; unfold jm;
-      match goal with
-        |- context [proj1_sig ?x] => destruct x as (jm' & jmm & lev & S & nolocks)
-      end; simpl; apply nolocks.
+      clear - Hext NL.
+      apply rmap_order in Hext as (_ & <- & _).
+      intros (? & ? & ? & ? & ?); eapply NL; eauto.
 
     - (*! safety of the only thread *)
       intros i cnti ora.
       destruct (getThreadC cnti) as [c|c|c v|v1 v2] eqn:Ec; try discriminate; [].
-      destruct i as [ | [ | i ]]. 2: now inversion cnti. 2:now inversion cnti.
+      destruct i as [ | [ | i ]]; [| now inversion cnti | now inversion cnti].
       (* the initial juicy has got to be the same as the one given in initial_mem *)
       assert (Ejm: jm = jm_ cnti compat).
       {
-        apply juicy_mem_ext; swap 1 2.
-        - reflexivity.
+        apply juicy_mem_ext; [|reflexivity].
         - unfold jm_.
-          symmetry.
-          unfold jm.
-          destruct spr as (b' & q' & Hb & JS); simpl proj1_sig in *; simpl proj2_sig in *.
-          destruct (JS n) as (jm' & jmm & lev & S & notlock); simpl projT1 in *; simpl projT2 in *.
-          subst m.
-          setoid_rewrite personal_mem_of_same_jm; eauto.
+          subst; symmetry; apply personal_mem_of_same_jm; auto.
       }
-      subst jm. rewrite <-Ejm.
+      rewrite <-Ejm.
       simpl in Ec. replace c with q in * by congruence.
-      destruct spr as (b' & q' & Hb & JS); simpl proj1_sig in *; simpl proj2_sig in *.
-      destruct (JS n tt) as (jm' & jmm & lev & ? & Safe & notlock); simpl projT1 in *; simpl projT2 in *.
-      subst q.
-      simpl proj1_sig in *; simpl proj2_sig in *. subst n.
-      destruct ora; apply Safe.
+      destruct ora; apply A.
 
     - (* well-formedness *)
       intros i cnti.
       constructor.
 
     - (* only one thread running *)
-      intros F; exfalso. simpl in F. omega.
+      intros F; exfalso. simpl in F. lia.
+
+    - (* inv_compatible (wsat is set up) *)
+      exists (id_core (m_phi jm)), (wsat_rmap (m_phi jm)).
+      split; [eexists; apply id_core_unit|].
+      split; [|apply wsat_rmap_wsat].
+      destruct (join_assoc (join_comm (id_core_unit (m_phi jm))) W) as (? & ? & ?).
+      apply identity_unit; eauto.
+      apply id_core_identity.
   Qed.
 
 End Initial_State.
diff --git a/concurrency/juicy/semax_invariant.v b/concurrency/juicy/semax_invariant.v
index ce8ee583d6..8d158a6440 100644
--- a/concurrency/juicy/semax_invariant.v
+++ b/concurrency/juicy/semax_invariant.v
@@ -10,16 +10,13 @@ Require Import compcert.common.Values.
 
 Require Import VST.msl.Coqlib2.
 Require Import VST.msl.eq_dec.
-Require Import VST.msl.age_to.
-Require Import VST.veric.initial_world.
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.juicy_mem_lemmas.
+Require Import VST.veric.external_state.
 Require Import VST.veric.semax_prog.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.Clight_new.
-Require Import VST.veric.Clightnew_coop.
+Require Import VST.veric.Clight_core.
+Require Import VST.veric.Clightcore_coop.
 Require Import VST.veric.semax.
-Require Import VST.veric.semax_ext.
 Require Import VST.veric.juicy_extspec.
 Require Import VST.veric.initial_world.
 Require Import VST.veric.juicy_extspec.
@@ -33,6 +30,7 @@ Require Import VST.sepcomp.event_semantics.
 Require Import VST.concurrency.juicy.semax_conc_pred.
 Require Import VST.concurrency.juicy.semax_conc.
 Require Import VST.concurrency.juicy.juicy_machine.
+Require Import VST.concurrency.common.threads_lemmas.
 Require Import VST.concurrency.common.HybridMachineSig.
 Require Import VST.concurrency.common.semantics.
 Require Import VST.concurrency.common.scheduler.
@@ -40,7 +38,7 @@ Require Import VST.concurrency.common.addressFiniteMap.
 Require Import VST.concurrency.common.permissions.
 Require Import VST.concurrency.common.ClightSemanticsForMachines.
 Require Import VST.concurrency.juicy.JuicyMachineModule.
-Require Import VST.concurrency.juicy.sync_preds_defs.
+(*Require Import VST.concurrency.juicy.sync_preds_defs.*)
 Require Import VST.concurrency.juicy.join_lemmas.
 Require Import VST.concurrency.common.lksize.
 Import threadPool Events.
@@ -58,23 +56,17 @@ Ltac cleanup :=
   unfold OrdinalPool.lockGuts in *; unfold OrdinalPool.lockSet in *;
   simpl lock_info in *; simpl res in *.
 
-Ltac join_level_tac :=
-  try
-    match goal with
-      cnti : containsThread ?tp _,
-             compat : mem_compatible_with ?tp ?m ?Phi |- _ =>
-      assert (join_sub (getThreadR cnti) Phi) by (apply compatible_threadRes_sub, compat)
-    end;
-  repeat match goal with H : join_sub _ _ |- _ => apply join_sub_level in H end;
-  repeat match goal with H : join _ _ _ |- _ => apply join_level in H; destruct H end;
-  cleanup;
-  try congruence.
-
 Notation event_trace := (seq.seq machine_event).
 
+Lemma allows_exit `{!heapGS Σ} `{!externalGS unit Σ} {CS} ext_link : @postcondition_allows_exit _ (Concurrent_Espec unit CS ext_link) Ctypesdefs.tint.
+Proof.
+  by constructor.
+Qed.
+
 Section Machine.
 
-Context {ZT : Type} (Jspec : juicy_ext_spec ZT) {ge : genv}.
+Context {ZT : Type} `{!heapGS Σ} `{!externalGS ZT Σ} (Jspec : juicy_ext_spec(Σ := Σ) ZT) {ge : genv}.
+Definition Espec := {| OK_ty := ZT; OK_spec := Jspec |}.
 
 (*+ Description of the invariant *)
 Definition cm_state := (Mem.mem * (event_trace * schedule * jstate ge))%type.
@@ -85,7 +77,7 @@ Inductive state_step : cm_state -> cm_state -> Prop :=
       (m, (tr, nil, jstate))
       (m, (tr, nil, jstate))
 | state_step_c m m' tr tr' sch sch' jstate jstate':
-    @JuicyMachine.machine_step _ (Clight_newSem ge) _ HybridCoarseMachine.DilMem JuicyMachineShell HybridMachineSig.HybridCoarseMachine.scheduler sch tr jstate m sch' tr' jstate' m' ->
+    @JuicyMachine.machine_step _ (ClightSem ge) _ HybridCoarseMachine.DilMem (JuicyMachineShell(Σ := Σ)) HybridMachineSig.HybridCoarseMachine.scheduler sch tr jstate m sch' tr' jstate' m' ->
     state_step
       (m, (tr, sch, jstate))
       (m',(tr', sch', jstate')).
@@ -93,7 +85,7 @@ Inductive state_step : cm_state -> cm_state -> Prop :=
 
 (*! Coherence between locks in dry/wet memories and lock pool *)
 
-Inductive cohere_res_lock : forall (resv : option (option rmap)) (wetv : resource) (dryv : memval), Prop :=
+(*Inductive cohere_res_lock : forall (resv : option (option rmap)) (wetv : resource) (dryv : memval), Prop :=
 | cohere_notlock wetv dryv:
     (forall sh sh' z P, wetv <> YES sh sh' (LK z 0) P) ->
     cohere_res_lock None wetv dryv
@@ -105,7 +97,7 @@ Inductive cohere_res_lock : forall (resv : option (option rmap)) (wetv : resourc
     R phi ->
     cohere_res_lock (Some (Some phi)) wetv (Byte (Integers.Byte.one)).
 
-Definition load_at m loc := Mem.load Mint32 m (fst loc) (snd loc).
+Definition load_at m loc := Mem.load Mptr m (fst loc) (snd loc).
 
 Definition lock_coherence (lset : AMap.t (option rmap)) (phi : rmap) (m : mem) : Prop :=
   forall loc : address,
@@ -116,15 +108,15 @@ Definition lock_coherence (lset : AMap.t (option rmap)) (phi : rmap) (m : mem) :
 
     (* locked lock *)
     | Some None =>
-      load_at m loc = Some (Vint Int.zero) /\
-      (4 | snd loc) /\
+      load_at m loc = Some (Vptrofs Ptrofs.zero) /\
+      (size_chunk Mptr | snd loc) /\
       (snd loc + LKSIZE < Ptrofs.modulus)%Z /\
       exists R, lkat R loc phi
 
     (* unlocked lock *)
     | Some (Some lockphi) =>
-      load_at m loc = Some (Vint Int.one) /\
-      (4 | snd loc) /\
+      load_at m loc = Some (Vptrofs Ptrofs.one) /\
+      (size_chunk Mptr | snd loc) /\
       (snd loc + LKSIZE < Ptrofs.modulus)%Z /\
       exists (R : mpred),
         lkat R loc phi /\
@@ -134,7 +126,7 @@ Definition lock_coherence (lset : AMap.t (option rmap)) (phi : rmap) (m : mem) :
         | Some p => app_pred R p
         | None => Logic.True
         end*)
-    end.
+    end.*)
 
 Definition far (ofs1 ofs2 : Z) := (Z.abs (ofs1 - ofs2) >= LKSIZE)%Z.
 
@@ -146,7 +138,7 @@ Proof.
   unfold far; simpl.
   intros H1 H2.
   zify.
-  omega.
+  lia.
 Qed.
 
 Definition lock_sparsity {A} (lset : AMap.t A) : Prop :=
@@ -157,20 +149,6 @@ Definition lock_sparsity {A} (lset : AMap.t A) : Prop :=
     fst loc1 <> fst loc2 \/
     (fst loc1 = fst loc2 /\ far (snd loc1) (snd loc2)).
 
-Lemma lock_sparsity_age_to (tp : jstate ge) n :
-  lock_sparsity (lset tp) ->
-  lock_sparsity (lset (age_tp_to n tp)).
-Proof.
-  destruct tp as [A B C lset0]; simpl.
-  intros S l1 l2 E1 E2; apply (S l1 l2).
-  - rewrite AMap_find_map_option_map in E1.
-    cleanup.
-    destruct (AMap.find (elt:=option rmap) l1 lset0); congruence || tauto.
-  - rewrite AMap_find_map_option_map in E2.
-    cleanup.
-    destruct (AMap.find (elt:=option rmap) l2 lset0); congruence || tauto.
-Qed.
-
 Definition lset_same_support {A} (lset1 lset2 : AMap.t A) :=
   forall loc,
     AMap.find loc lset1 = None <->
@@ -236,7 +214,7 @@ Definition jm_
   {tp m PHI i}
   (cnti : containsThread tp i)
   (mcompat : mem_compatible_with tp m PHI)
-  : juicy_mem :=
+  : mem :=
   personal_mem (thread_mem_compatible (mem_compatible_forget mcompat) cnti).
 
 Lemma personal_mem_ext m phi phi' pr pr' :
@@ -249,44 +227,34 @@ Qed.
 
 (*! Invariant (= above properties + safety + uniqueness of Krun) *)
 
+(* Could we move more of this into the logic? *)
+(* Since we're moving towards a machine without ghost state, we erase all of the state except
+   the rmap, and then nondeterministically reconstruct the rest of the state at each step.
+   Will this work? *)
 Definition jsafe_phi ge n ora c phi :=
-  forall jm,
-    m_phi jm = phi ->
-    @semax.jsafeN ZT Jspec ge n ora c jm.
-
-Definition jsafe_phi_bupd ge n ora c phi :=
-  forall jm,
-    m_phi jm = phi ->
-    jm_bupd ora (@semax.jsafeN ZT Jspec ge n ora c) jm.
-
-Lemma jsafe_phi_jsafeN n ora c i (tp : jstate ge) m (cnti : containsThread tp i) Phi compat :
-  @jsafe_phi ge n ora c (getThreadR cnti) ->
-  @semax.jsafeN ZT Jspec ge n ora c (@jm_ tp m Phi i cnti compat).
-Proof.
-  intros S; apply S, eq_refl.
-Qed.
+    ouPred_holds (semax.jsafeN Espec ge ⊤ ora c) n phi.
 
 Definition threads_safety m (tp : jstate ge) PHI (mcompat : mem_compatible_with tp m PHI) n :=
   forall i (cnti : containsThread tp i) (ora : ZT),
     match getThreadC cnti with
-    | Krun c => semax.jsafeN Jspec ge n ora c (jm_ cnti mcompat)
+    | Krun c => jsafe_phi ge n ora c (getThreadR cnti)
     | Kblocked c =>
       (* The dry memory will change, so when we prove safety after an
       external we must only inspect the rmap m_phi part of the juicy
       memory.  This means more proof for each of the synchronisation
       primitives. *)
-      jsafe_phi ge n ora c (getThreadR cnti)
+      jsafe_phi ge ora c (getThreadR cnti)
     | Kresume c v =>
       forall c',
         (* [v] is not used here. The problem is probably coming from
            the definition of JuicyMachine.resume_thread'. *)
         cl_after_external None c = Some c' ->
         (* same quantification as in Kblocked *)
-        jsafe_phi_bupd ge n ora c' (getThreadR cnti)
+        jsafe_phi ge n ora c' (getThreadR cnti)
     | Kinit v1 v2 =>
-      val_inject (Mem.flat_inj (Mem.nextblock m)) v2 v2 /\
+(*      Val.inject (Mem.flat_inj (Mem.nextblock m)) v2 v2 /\ *)
       exists q_new,
-      cl_initial_core ge v1 (v2 :: nil) q_new /\
+      cl_initial_core ge v1 (v2 :: nil) = Some q_new /\
       jsafe_phi ge n ora q_new (getThreadR cnti)
     end.
 
@@ -299,11 +267,8 @@ Definition threads_wellformed (tp : jstate ge) :=
     | Kinit _ _ => Logic.True
     end.
 
-(* Havent' move this, but it's already defined in the concurrent_machien...
- * Probably in the wrong part...
- * SC: I had to change unique_Krun to include ~ Halted. Because halted
- * threads are still in Krun. (Although, ass you know right now there are no Hatled
- * threads...)  *)
+(* Haven't move this, but it's already defined in the concurrent_machine...
+ * Probably in the wrong part... *)
 Definition unique_Krun (tp : jstate ge) sch :=
   (lt 1 tp.(num_threads).(pos.n) -> forall i cnti q,
       @getThreadC _ _ _ i tp cnti = Krun q ->
@@ -405,7 +370,7 @@ Proof.
   remember (pos.n n) as k; clear Heqk n.
   apply ssr_leP_inv in cnti.
   apply ssr_leP_inv in cntj.
-  omega.
+  lia.
 Qed.
 
 Lemma unique_Krun_no_Krun tp i sch cnti :
@@ -472,11 +437,11 @@ Import ghost_PCM.
 
 Definition env_coherence {Z} Jspec (ge : genv) (Gamma : funspecs) PHI :=
   matchfunspecs ge Gamma PHI /\
-  exists prog CS V,
-    @semax_prog {|OK_ty := Z; OK_spec := Jspec|} CS prog V Gamma /\
+  exists prog ora CS V,
+    @semax_prog {|OK_ty := Z; OK_spec := Jspec|} CS prog ora V Gamma /\
     ge = globalenv prog /\
     app_pred
-      (funassert (Delta_types V Gamma (Tpointer Tvoid noattr :: nil))
+      (funassert (make_tycontext ((*Tpointer Ctypes.Tvoid noattr ::*) nil) nil nil Ctypes.Tvoid V Gamma nil)
                  (empty_environ ge)) PHI.
 
 Definition maxedmem (m: mem) :=
@@ -493,34 +458,47 @@ Lemma maxedmem_neutral:
 Proof.
 intros.
 unfold Mem.inject_neutral in *.
-inv H. 
+inv H.
 constructor; intros; simpl in *.
-unfold Mem.flat_inj in H.
+- unfold Mem.flat_inj in H.
 if_tac in H; try discriminate.
 inv H.
 rewrite Z.add_0_r. auto.
-eapply mi_align; eauto.
+- eapply mi_align; eauto.
 intros ? ?.
 unfold maxedmem.
-rewrite mem_equiv.restr_Max_equiv. eauto.
-apply mi_memval; auto.
+unfold Mem.perm; setoid_rewrite restrPermMap_Max; rewrite getMaxPerm_correct.
+eauto.
+specialize (H0 _ H1).
+apply H0.
+- apply mi_memval; auto.
 clear - H0.
-unfold maxedmem.
-Admitted.  (* Santiago will finish this one *)
+unfold maxedmem, Mem.perm in *.
+setoid_rewrite restrPermMap_Cur.
+unfold getMaxPerm.
+rewrite PMap.gmap.
+eapply perm_order_trans211; eauto.
+apply (access_cur_max _ (_, _)).
+Qed.
+
+Definition inv_compatible (tp : jstate ge) := forall i (cnti : containsThread tp i), exists r w,
+  join_sub r (getThreadR cnti) /\ join r (extraRes tp) w /\
+  app_pred (invariants.wsat * invariants.ghost_set invariants.g_en Ensembles.Full_set)%pred w.
 
 Inductive state_invariant Gamma (n : nat) : cm_state -> Prop :=
   | state_invariant_c
       (m : mem) (tr : event_trace) (sch : schedule) (tp : jstate ge) (PHI : rmap)
       (lev : level PHI = n)
       (envcoh : env_coherence Jspec ge Gamma PHI)
-      (mwellformed: mem_wellformed m)
+(*      (mwellformed: mem_wellformed m) *)
       (mcompat : mem_compatible_with tp m PHI)
-      (extcompat : joins (ghost_of PHI) (Some (ext_ref tt, NoneP) :: nil))
+      (extcompat : ext_compat tt PHI)
       (lock_sparse : lock_sparsity (lset tp))
       (lock_coh : lock_coherence' tp PHI m mcompat)
-      (safety : threads_safety m tp PHI mcompat n)
+      (safety : threads_safety m tp PHI mcompat)
       (wellformed : threads_wellformed tp)
       (uniqkrun :  unique_Krun tp sch)
+      (invcompat : inv_compatible tp)
     : state_invariant Gamma n (m, (tr, sch, tp)).
 
 (* Schedule irrelevance of the invariant *)
@@ -529,9 +507,9 @@ Lemma state_invariant_sch_irr Gamma n m i tr sch sch' tp :
   state_invariant Gamma n (m, (tr, i :: sch', tp)).
 Proof.
   intros INV.
-  inversion INV as [m0 tr0 sch0 tp0 PHI lev envcoh mwellformed compat extcompat sparse lock_coh safety wellformed uniqkrun H0];
+  inversion INV as [m0 tr0 sch0 tp0 PHI lev envcoh (*mwellformed*) compat extcompat sparse lock_coh safety wellformed uniqkrun invcompat H0];
     subst m0 tr0 sch0 tp0.
-  refine (state_invariant_c Gamma n m tr (i :: sch') tp PHI lev envcoh mwellformed compat extcompat sparse lock_coh safety wellformed _).
+  refine (state_invariant_c Gamma n m tr (i :: sch') tp PHI lev envcoh (*mwellformed*) compat extcompat sparse lock_coh safety wellformed _ invcompat ).
   clear -uniqkrun.
   intros H i0 cnti q H0.
   destruct (uniqkrun H i0 cnti q H0) as [sch'' E].
@@ -551,15 +529,22 @@ Definition blocked_at_external (state : cm_state) (ef : external_function) :=
 Definition state_bupd P (state : cm_state) := let '(m, (tr, sch, tp)) := state in
   tp_bupd (fun tp' => P (m, (tr, sch, tp'))) tp.
 
-Lemma state_bupd_intro : forall (P : _ -> Prop) m tr sch tp phi, join_all tp phi ->
-  joins (ghost_of phi) (Some (ext_ref tt, NoneP) :: nil) ->
-  P (m, (tr, sch, tp)) -> state_bupd P (m, (tr, sch, tp)).
+Lemma tp_bupd_intro : forall (P : _ -> Prop) (tp : jstate ge) phi, join_all tp phi ->
+  ext_compat tt phi -> P tp -> tp_bupd P tp.
 Proof.
-  intros; split; eauto; intros.
+  unfold tp_bupd; intros.
+  split; eauto; intros.
   eexists; split; eauto.
   eexists _, _; split; [apply tp_update_refl|]; auto.
 Qed.
 
+Lemma state_bupd_intro : forall (P : _ -> Prop) m tr sch tp phi, join_all tp phi ->
+  ext_compat tt phi ->
+  P (m, (tr, sch, tp)) -> state_bupd P (m, (tr, sch, tp)).
+Proof.
+  intros; eapply tp_bupd_intro; eauto.
+Qed.
+
 Lemma state_bupd_intro' : forall Gamma n s,
   state_invariant Gamma n s ->
   state_bupd (state_invariant Gamma n) s.
@@ -569,6 +554,36 @@ Proof.
   apply mcompat.
 Qed.
 
+Definition state_fupd P (state : cm_state) := let '(m, (tr, sch, tp)) := state in
+  tp_fupd (fun tp' => P (m, (tr, sch, tp'))) tp.
+
+Lemma cnt0 (tp : jstate ge) : containsThread tp O.
+Proof.
+  hnf.
+  destruct (@ssrnat.leP 1 (pos.n (num_threads tp))); auto.
+  destruct num_threads; simpl in *; lia.
+Qed.
+
+Lemma state_fupd_intro : forall (P : _ -> Prop) m tr sch tp phi, join_all tp phi ->
+  ext_compat tt phi -> inv_compatible tp -> 
+  P (m, (tr, sch, tp)) -> state_fupd P (m, (tr, sch, tp)).
+Proof.
+  intros; unfold state_fupd, tp_fupd.
+  destruct (H1 _ (cnt0 _)) as (r & w & [m0 ?] & ? & ?).
+  exists O, (cnt0 _), m0, r, w; repeat (split; auto).
+  right; eapply tp_bupd_intro; eauto.
+  exists (cnt0 _), m0, r, w; auto.
+Qed.
+
+Lemma state_fupd_intro' : forall Gamma n s,
+  state_invariant Gamma n s ->
+  state_fupd (state_invariant Gamma n) s.
+Proof.
+  inversion 1; subst.
+  eapply state_fupd_intro; eauto.
+  apply mcompat.
+Qed.
+
 Lemma mem_compatible_upd : forall tp m phi tp' phi', mem_compatible_with tp m phi ->
   tp_update(ge := ge) tp phi tp' phi' -> mem_compatible_with tp' m phi'.
 Proof.
@@ -587,20 +602,41 @@ Proof.
 Qed.
 
 Lemma join_all_eq : forall (tp : jstate ge) phi phi', join_all tp phi -> join_all tp phi' ->
-  (getThreadsR tp = nil /\ getLocksR tp = nil /\ identity phi /\ identity phi') \/ phi = phi'.
+  phi = phi'.
 Proof.
   intros ???; rewrite join_all_joinlist.
   unfold maps.
-  destruct (getThreadsR tp); [|intros; right; eapply joinlist_inj; eauto; discriminate].
-  destruct (getLocksR tp); [auto | intros; right; eapply joinlist_inj; eauto; discriminate].
+  destruct (getThreadsR tp); [|intros; eapply joinlist_inj; eauto; discriminate].
+  destruct (getLocksR tp); [auto | intros; eapply joinlist_inj; eauto; discriminate].
+  simpl.
+  intros (? & Hid1 & ?%join_comm%Hid1) (? & Hid2 & ?%join_comm%Hid2); subst; auto.
+Qed.
+
+Lemma funspec_sub_si_fash : forall a b, funspec_sub_si a b |-- !#funspec_sub_si a b.
+Proof.
+  intros; unfold funspec_sub_si.
+  destruct a, b; repeat intro.
+  destruct H; split; auto.
+  intros ??.
+  destruct (level a) eqn: Hl.
+  { apply laterR_level in H2; lia. }
+  symmetry in Hl; apply levelS_age in Hl as (a1 & ? & ?); subst.
+  specialize (H1 a1); spec H1.
+  { constructor; auto. }
+  match goal with |-context[allp ?a] => remember (allp a) as pred end.
+  simpl in *.
+  eapply pred_nec_hereditary, H1.
+  apply nec_nat.
+  apply laterR_level in H2; lia.
 Qed.
 
 (* Ghost update only affects safety; the rest of the invariant is preserved. *)
-Lemma state_inv_upd : forall Gamma (n : nat)
+(* Is this relevant anymore? *)
+(*Lemma state_inv_bupd : forall Gamma (n : nat)
   (m : mem) (tr : event_trace) (sch : schedule) (tp : jstate ge) (PHI : rmap)
       (lev : level PHI = n)
       (envcoh : env_coherence Jspec ge Gamma PHI)
-      (mwellformed: mem_wellformed m)
+(*      (mwellformed: mem_wellformed m) *)
       (mcompat : mem_compatible_with tp m PHI)
       (extcompat : joins (ghost_of PHI) (Some (ext_ref tt, NoneP) :: nil))
       (lock_sparse : lock_sparsity (lset tp))
@@ -609,7 +645,7 @@ Lemma state_inv_upd : forall Gamma (n : nat)
         joins (ghost_of PHI) (ghost_fmap (approx (level PHI)) (approx (level PHI)) C) ->
         exists tp' PHI' (Hupd : tp_update tp PHI tp' PHI'),
         joins (ghost_of PHI') (ghost_fmap (approx (level PHI)) (approx (level PHI)) C) /\
-        threads_safety m tp' PHI' (mem_compatible_upd _ _ _ _ _ mcompat Hupd) n)
+        threads_safety m tp' PHI' (mem_compatible_upd _ _ _ _ _ mcompat Hupd))
       (wellformed : threads_wellformed tp)
       (uniqkrun :  unique_Krun tp sch),
   state_bupd (state_invariant Gamma n) (m, (tr, sch, tp)).
@@ -620,9 +656,9 @@ Proof.
   assert (join_all tp PHI) as HPHI by (clear - mcompat; inv mcompat; auto).
   destruct (join_all_eq _ _ _ H HPHI) as [(Ht & ? & ? & ?)|].
   { exists nil; split.
-    { eexists; erewrite <- ghost_core; apply core_unit. }
+    { eexists; constructor. }
     exists phi, tp; split; [apply tp_update_refl; auto|].
-    split; [erewrite <- ghost_core; apply identity_core, ghost_of_identity; auto|].
+    split; [apply ghost_identity, ghost_of_identity; auto|].
     apply state_invariant_c with (mcompat := mcompat); auto.
     repeat intro.
     generalize (getThreadR_nth _ _ cnti); setoid_rewrite Ht; rewrite nth_error_nil; discriminate. }
@@ -635,10 +671,21 @@ Proof.
   - auto.
   - destruct envcoh as [mtch coh]; split.
     + repeat intro.
-      simpl in H0.
-      rewrite Hl, Hr in H0; rewrite Hl; auto.
-    + destruct coh as (? & ? & ? & ? & ? & Happ).
-      do 4 eexists; eauto; split; auto.
+      destruct (necR_same_level _ _ _ H0 Hl) as (PHIa & Hnec & Hla).
+      destruct (mtch b b0 _ _ Hnec (ext_refl _)) as (? & ? & ? & ?).
+      * destruct b0; simpl in *.
+        pose proof (necR_level _ _ Hnec). pose proof (necR_level _ _ H0).
+        apply necR_age_to in Hnec; rewrite Hnec, age_to_resource_at.age_to_resource_at.
+        rewrite <- Hla, <- Hr.
+        apply rmap_order in H1 as (Hl1 & Hr1 & _).
+        rewrite <- Hl1, <- Hr1 in H2.
+        apply necR_age_to in H0; rewrite H0, age_to_resource_at.age_to_resource_at in H2; rewrite H2.
+        rewrite !level_age_to; auto; lia.
+      * do 3 eexists; simpl in *; eauto.
+        eapply funspec_sub_si_fash; eauto.
+        apply rmap_order in H1 as (? & ? & ?); lia.
+    + destruct coh as (? & ? & ? & ? & ? & ? & Happ).
+      do 5 eexists; eauto; split; auto.
       eapply semax_lemmas.funassert_resource, Happ; auto.
   - auto.
   - eapply joins_comm, join_sub_joins_trans, joins_comm, J'.
@@ -673,10 +720,214 @@ Proof.
     rewrite <- HC in *.
     replace (num_threads tp') with (num_threads tp) in *; eauto.
     symmetry; apply contains_iff_num; auto.
-Qed.
+Qed.*)
+
+(*(* Is this provable? *)
+Lemma state_inv_fupd : forall Gamma (n : nat)
+  (m : mem) (tr : event_trace) (sch : schedule) (tp : jstate ge) (PHI : rmap)
+      (lev : level PHI = n)
+      (envcoh : env_coherence Jspec ge Gamma PHI)
+      (mwellformed: mem_wellformed m)
+      (mcompat : mem_compatible_with tp m PHI)
+      (extcompat : joins (ghost_of PHI) (Some (ext_ref tt, NoneP) :: nil))
+      (lock_sparse : lock_sparsity (lset tp))
+      (lock_coh : lock_coherence' tp PHI m mcompat)
+      (safety : forall C, join_sub (Some (ext_ref tt, NoneP) :: nil) C ->
+        joins (ghost_of PHI) (ghost_fmap (approx (level PHI)) (approx (level PHI)) C) ->
+        exists tp' PHI' (Hupd : tp_update tp PHI tp' PHI'),
+        joins (ghost_of PHI') (ghost_fmap (approx (level PHI)) (approx (level PHI)) C) /\
+        threads_safety m tp' PHI' (mem_compatible_upd _ _ _ _ _ mcompat Hupd))
+      (wellformed : threads_wellformed tp)
+      (uniqkrun :  unique_Krun tp sch),
+  state_fupd (state_invariant Gamma n) (m, (tr, sch, tp)).
+Proof.
+  intros.
+  split; [eexists; split; eauto; apply mcompat|].
+  intros ??? Hc J.
+  assert (join_all tp PHI) as HPHI by (clear - mcompat; inv mcompat; auto).
+  destruct (join_all_eq _ _ _ H HPHI) as [(Ht & ? & ? & ?)|].
+  { exists nil; split.
+    { eexists; constructor. }
+    exists phi, tp; split; [apply tp_update_refl; auto|].
+    split; [apply ghost_identity, ghost_of_identity; auto|].
+    apply state_invariant_c with (mcompat := mcompat); auto.
+    repeat intro.
+    generalize (getThreadR_nth _ _ cnti); setoid_rewrite Ht; rewrite nth_error_nil; discriminate. }
+  subst.
+  specialize (safety _ Hc J) as (tp' & PHI' & Hupd & J' & safety).
+  eexists; split; eauto; do 2 eexists; split; eauto; split; auto.
+  pose proof (mem_compatible_upd _ _ _ _ _ mcompat Hupd) as mcompat'.
+  destruct Hupd as (Hl & Hr & Hj & Hiff & Hthreads & Hguts & Hlset & Hres & Hlatest).
+  apply state_invariant_c with (mcompat := mcompat').
+  - auto.
+  - destruct envcoh as [mtch coh]; split.
+    + repeat intro.
+      destruct (necR_same_level _ _ _ H0 Hl) as (PHIa & Hnec & Hla).
+      destruct (mtch b b0 _ _ Hnec (ext_refl _)) as (? & ? & ? & ?).
+      * destruct b0; simpl in *.
+        pose proof (necR_level _ _ Hnec). pose proof (necR_level _ _ H0).
+        apply necR_age_to in Hnec; rewrite Hnec, age_to_resource_at.age_to_resource_at.
+        rewrite <- Hla, <- Hr.
+        apply rmap_order in H1 as (Hl1 & Hr1 & _).
+        rewrite <- Hl1, <- Hr1 in H2.
+        apply necR_age_to in H0; rewrite H0, age_to_resource_at.age_to_resource_at in H2; rewrite H2.
+        rewrite !level_age_to; auto; lia.
+      * do 3 eexists; simpl in *; eauto.
+        eapply funspec_sub_si_fash; eauto.
+        apply rmap_order in H1 as (? & ? & ?); lia.
+    + destruct coh as (? & ? & ? & ? & ? & ? & Happ).
+      do 5 eexists; eauto; split; auto.
+      eapply semax_lemmas.funassert_resource, Happ; auto.
+  - auto.
+  - eapply joins_comm, join_sub_joins_trans, joins_comm, J'.
+    destruct Hc as [? Hc].
+    eapply ghost_fmap_join in Hc; eexists; eauto.
+  - repeat intro.
+    setoid_rewrite Hguts in H0; setoid_rewrite Hguts in H1; auto.
+  - repeat intro.
+    specialize (lock_coh loc).
+    simpl in Hguts.
+    unfold OrdinalPool.lockGuts in Hguts.
+    rewrite Hguts, Hl, Hr.
+    destruct (AMap.find _ _); auto.
+    assert (forall R, lkat R loc PHI -> lkat R loc PHI').
+    { repeat intro; rewrite Hl, Hr; auto. }
+    replace (load_at (restrPermMap (mem_compatible_locks_ltwritable (mem_compatible_forget mcompat'))) loc)
+      with (load_at (restrPermMap (mem_compatible_locks_ltwritable (mem_compatible_forget mcompat))) loc).
+    destruct o; repeat (split; try tauto).
+    + destruct lock_coh as (? & ? & ? & ? & ? & ?); eauto.
+    + destruct lock_coh as (? & ? & ? & ? & ?); eauto.
+    + erewrite restrPermMap_irr'; [reflexivity | auto].
+  - erewrite (proof_irr mcompat'); eauto.
+  - repeat intro.
+    pose proof (proj1 (Hiff _) cnti) as cnti0.
+    destruct (Hthreads _ cnti0) as (HC & _).
+    replace (proj2 (Hiff i) cnti0) with cnti in HC by (apply proof_irr).
+    rewrite <- HC; apply wellformed.
+  - repeat intro.
+    pose proof (proj1 (Hiff _) cnti) as cnti0.
+    destruct (Hthreads _ cnti0) as (HC & _).
+    replace (proj2 (Hiff i) cnti0) with cnti in HC by (apply proof_irr).
+    rewrite <- HC in *.
+    replace (num_threads tp') with (num_threads tp) in *; eauto.
+    symmetry; apply contains_iff_num; auto.
+Qed.*)
 
 End Machine.
 
+Lemma restr_restr : forall m p Hlt p' Hlt', exists Hlt'',
+  @restrPermMap p' (@restrPermMap p m Hlt) Hlt' = @restrPermMap p' m Hlt''.
+Proof.
+  intros.
+  unshelve eexists.
+  { rewrite restr_Max_eq in Hlt'; auto. }
+  apply mem_lessdef.mem_ext; auto; simpl.
+  f_equal.
+  - extensionality o k; destruct k; auto.
+  - apply PTree.extensionality; intros.
+    rewrite !PTree.gmap.
+    destruct (_ ! _); auto.
+Qed.
+
+Lemma maxedmem_restr : forall m p Hlt, maxedmem (@restrPermMap p m Hlt) = maxedmem m.
+Proof.
+  intros; unfold maxedmem.
+  edestruct (restr_restr _ _ Hlt) as [? ->].
+  apply restrPermMap_irr; auto.
+  apply restr_Max_eq.
+Qed.
+
+Lemma mem_wellformed_restr : forall {ge} m p Hlt, @mem_wellformed ge m -> @mem_wellformed ge (@restrPermMap p m Hlt).
+Proof.
+  intros ???? []; unfold mem_wellformed; simpl.
+  split; auto.
+  rewrite maxedmem_restr; auto.
+Qed.
+
+Lemma maxedmem_storebytes : forall m b o v m', Mem.storebytes m b o v = Some m' -> Mem.storebytes (maxedmem m) b o v = Some (maxedmem m').
+Proof.
+  intros.
+  edestruct (Mem.range_perm_storebytes (maxedmem m)).
+  { apply Mem.storebytes_range_perm in H.
+    intros ? Hrange; specialize (H _ Hrange).
+    unfold Mem.perm, maxedmem in *.
+    setoid_rewrite restrPermMap_Cur.
+    rewrite getMaxPerm_correct; unfold permission_at.
+    eapply perm_order_trans211, H.
+    apply Mem.access_max. }
+  rewrite e; f_equal.
+  apply mem_lessdef.mem_ext; simpl.
+  - erewrite Mem.storebytes_mem_contents, (Mem.storebytes_mem_contents _ _ _ _ m') by eauto; auto.
+  - erewrite Mem.storebytes_access, (Mem.storebytes_access _ _ _ _ m') by eauto; simpl.
+    f_equal.
+    apply PTree.extensionality; intros.
+    rewrite !PTree.gmap.
+    destruct (_ ! _); auto; simpl.
+    f_equal; extensionality ofs k.
+    destruct k; auto.
+    rewrite !getMaxPerm_correct; unfold permission_at.
+    erewrite (Mem.storebytes_access _ _ _ _ m') by eauto; auto.
+  - erewrite Mem.nextblock_storebytes, (Mem.nextblock_storebytes _ _ _ _ m') by eauto; auto.
+Qed.
+
+Lemma maxedmem_store : forall m c b o v m', Mem.store c m b o v = Some m' -> Mem.store c (maxedmem m) b o v = Some (maxedmem m').
+Proof.
+  intros.
+  pose proof (Mem.store_valid_access_3 _ _ _ _ _ _ H) as Hvalid.
+  apply Mem.store_storebytes, maxedmem_storebytes in H.
+  apply Mem.storebytes_store; auto.
+  apply Hvalid.
+Qed.
+
+(*Lemma mem_wellformed_storebytes : forall {ge} m b o v m', list_forall2 (memval_inject (Mem.flat_inj (Mem.nextblock m))) v v ->
+  Mem.storebytes m b o v = Some m' -> @mem_wellformed ge m -> @mem_wellformed ge m'.
+Proof.
+  intros ???????? []; unfold mem_wellformed.
+  erewrite Mem.nextblock_storebytes by eauto.
+  split; [|auto].
+  apply maxedmem_storebytes in H0.
+  eapply Mem.store_inject_neutral; eauto.
+  apply Mem.storebytes_range_perm in H0.
+  specialize (H0 o); spec H0.
+  { rewrite encode_val_length. destruct (size_chunk_nat_pos c). lia. }
+  pose proof (Mem.nextblock_noaccess (maxedmem m) b o Cur) as Haccess.
+  unfold Mem.perm, maxedmem in *.
+  pose proof (restrPermMap_Cur (mem_max_lt_max m) b o) as Hperm; unfold permission_at in *; rewrite Hperm, getMaxPerm_correct in *.
+  destruct (plt b (Mem.nextblock m)); auto.
+  autospec Haccess.
+  rewrite Haccess in H0; inv H0.
+Qed.*)
+
+Lemma mem_wellformed_store : forall {ge} m c b o v m', Val.inject (Mem.flat_inj (Mem.nextblock m)) v v ->
+  Mem.store c m b o v = Some m' -> @mem_wellformed ge m -> @mem_wellformed ge m'.
+Proof.
+  intros ????????? []; unfold mem_wellformed.
+  erewrite Mem.nextblock_store by eauto.
+  split; [|auto].
+  apply maxedmem_store in H0.
+  eapply Mem.store_inject_neutral; eauto.
+  apply Mem.store_storebytes, Mem.storebytes_range_perm in H0.
+  specialize (H0 o); spec H0.
+  { rewrite encode_val_length. destruct (size_chunk_nat_pos c). lia. }
+  pose proof (Mem.nextblock_noaccess (maxedmem m) b o Cur) as Haccess.
+  unfold Mem.perm, maxedmem in *.
+  pose proof (restrPermMap_Cur (mem_max_lt_max m) b o) as Hperm; unfold permission_at in *; rewrite Hperm, getMaxPerm_correct in *.
+  destruct (plt b (Mem.nextblock m)); auto.
+  autospec Haccess.
+  rewrite Haccess in H0; inv H0.
+Qed.
+
+Lemma mem_wellformed_step : forall {ge} m m', mem_step m m' -> @mem_wellformed ge m -> @mem_wellformed ge m'.
+Proof.
+(* not true in general, because mem_step doesn't rule out storing invalid pointers *)
+Abort.
+
+(*Lemma mem_wellformed_step : forall {ge} m m' c c', cl_step ge c m c' m' -> @mem_wellformed ge m -> @mem_wellformed ge m'.
+Proof.
+  induction 1; auto; intros []; unfold mem_wellformed.
+  - Search expr.valid_pointer.
+Abort.*)
+
 Ltac fixsafe H :=
   unshelve eapply jsafe_phi_jsafeN in H; eauto.
 
@@ -699,7 +950,7 @@ Ltac absurd_ext_link_naming :=
   end.
 
 Ltac funspec_destruct s :=
-  simpl (ext_spec_pre _); simpl (ext_spec_type _); simpl (ext_spec_post _);
+  simpl (extspec.ext_spec_pre _); simpl (extspec.ext_spec_type _); simpl (extspec.ext_spec_post _);
   unfold funspec2pre, funspec2post;
   let Heq_name := fresh "Heq_name" in
   destruct (oi_eq_dec (Some (_ s, _)) (ef_id_sig _ (EF_external _ _)))
diff --git a/concurrency/juicy/semax_preservation.v b/concurrency/juicy/semax_preservation.v
index 66bc879607..d9448f6f49 100644
--- a/concurrency/juicy/semax_preservation.v
+++ b/concurrency/juicy/semax_preservation.v
@@ -11,20 +11,12 @@ Require Import compcert.common.Values.
 
 Require Import VST.msl.Coqlib2.
 Require Import VST.msl.eq_dec.
-Require Import VST.msl.seplog.
-Require Import VST.msl.age_to.
-Require Import VST.veric.aging_lemmas.
-Require Import VST.veric.initial_world.
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.juicy_mem_lemmas.
 Require Import VST.veric.semax_prog.
-        
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.Clight_new.
-Require Import VST.veric.Clightnew_coop.
+Require Import VST.veric.Clight_core.
+Require Import VST.veric.Clightcore_coop.
 Require Import VST.veric.semax.
-Require Import VST.veric.semax_ext.
-Require Import VST.veric.juicy_extspec.
 Require Import VST.veric.juicy_safety.
 Require Import VST.veric.initial_world.
 Require Import VST.veric.juicy_extspec.
@@ -32,7 +24,6 @@ Require Import VST.veric.tycontext.
 Require Import VST.veric.semax_ext.
 Require Import VST.veric.res_predicates.
 Require Import VST.veric.mem_lessdef.
-Require Import VST.veric.age_to_resource_at.
 Require Import VST.floyd.coqlib3.
 Require Import VST.sepcomp.step_lemmas.
 Require Import VST.sepcomp.event_semantics.
@@ -48,11 +39,10 @@ Require Import VST.concurrency.common.permissions.
 Require Import VST.concurrency.juicy.JuicyMachineModule.
 Require Import VST.concurrency.common.lksize.
 Require Import VST.concurrency.juicy.sync_preds_defs.
-Require Import VST.concurrency.juicy.sync_preds.
 Require Import VST.concurrency.juicy.join_lemmas.
 Require Import VST.concurrency.juicy.cl_step_lemmas.
-Require Import VST.concurrency.juicy.resource_decay_lemmas.
-Require Import VST.concurrency.juicy.resource_decay_join.
+(*Require Import VST.concurrency.juicy.resource_decay_lemmas.
+Require Import VST.concurrency.juicy.resource_decay_join.*)
 Require Import VST.concurrency.juicy.sync_preds.
 Require Import VST.concurrency.juicy.semax_invariant.
 Require Import VST.concurrency.juicy.semax_simlemmas.
@@ -209,19 +199,19 @@ Lemma valid_block0 m b : ~valid_block m b <-> (b >= nextblock m)%positive.
 Proof.
   unfold valid_block in *.
   unfold Plt in *.
-  split; zify; omega.
+  split; zify; lia.
 Qed.
 
 Lemma valid_block1 m b : valid_block m b <-> (b < nextblock m)%positive.
 Proof.
   unfold valid_block in *.
   unfold Plt in *.
-  split; zify; omega.
+  split; zify; lia.
 Qed.
 
 Lemma not_Pge_Plt a b : ~ Pos.ge a b -> Plt a b.
 Proof.
-  unfold Plt. zify. omega.
+  unfold Plt. zify. lia.
 Qed.
 
 (*Lemma mem_cohere_age_to_inv n m phi :
@@ -250,11 +240,11 @@ Proof.
     Abort.
 Abort.*)
 
-           Lemma perm_of_res'_resource_fmap f g r :
-             perm_of_res' (resource_fmap f g r) = perm_of_res' r.
-           Proof.
-             destruct r; simpl; auto.
-           Qed.
+Lemma perm_of_res'_resource_fmap f g r :
+  perm_of_res' (resource_fmap f g r) = perm_of_res' r.
+Proof.
+  destruct r; simpl; auto.
+Qed.
 
 Lemma mem_cohere_step c c' jm jm' Phi (X : rmap) ge :
   mem_cohere' (m_dry jm) Phi ->
@@ -504,38 +494,16 @@ Proof.
   apply (proj2_sig R).
 Qed.
 
-Ltac jmstep_inv :=
-  match goal with
-  | H : JuicyMachine.start_thread _ _ _ _  |- _ => inversion H
-  | H : JuicyMachine.resume_thread _ _ _   |- _ => inversion H
-  | H : JuicyMachine.threadStep _ _ _ _ _           |- _ => inversion H
-  | H : JuicyMachine.suspend_thread _ _ _ |- _ => inversion H
-  | H : JuicyMachine.syncStep _ _ _ _ _ _           |- _ => inversion H
-(*  | H : JuicyMachine.threadHalted _                   |- _ => inversion H*)
-  | H : JuicyMachine.schedfail _         |- _ => inversion H
-  end; try subst.
-
-Ltac getThread_inv :=
-  match goal with
-  | [ H : getThreadC ?i _ _ = _ ,
-          H2 : getThreadC ?i _ _ = _ |- _ ] =>
-    pose proof (getThreadC_fun _ _ _ _ _ _ _ H H2)
-  | [ H : getThreadR ?i _ _ = _ ,
-          H2 : getThreadR ?i _ _ = _ |- _ ] =>
-    pose proof (getThreadR_fun _ _ _ _ _ _ _ H H2)
-  end.
-
 Ltac substwith x y := assert (x = y) by apply proof_irr; subst x.
 
 Lemma load_restrPermMap ge m (tp : jstate ge) Phi b ofs m_any
   (compat : mem_compatible_with tp m Phi) :
   lock_coherence (lset tp) Phi m_any ->
   AMap.find (elt:=option rmap) (b, ofs) (lset tp) <> None ->
-  Mem.load
-    Mint32
+  Mem.load Mptr
     (restrPermMap (mem_compatible_locks_ltwritable (mem_compatible_forget compat)))
     b ofs =
-  Some (decode_val Mint32 (Mem.getN (size_chunk_nat Mint32) ofs (Mem.mem_contents m) !! b)).
+  Some (decode_val Mptr (Mem.getN (size_chunk_nat Mint32) ofs (Mem.mem_contents m) !! b)).
 Proof.
   intros lc e.
   Transparent Mem.load.
@@ -556,7 +524,7 @@ Proof.
   intros loc find.
   specialize (coh loc).
   destruct (AMap.find (elt:=option rmap) loc (lset tp)) as [o|]; [ | inversion find ].
-  match goal with |- (?a < ?b)%positive => assert (D : (a >= b \/ a < b)%positive) by (zify; omega) end.
+  match goal with |- (?a < ?b)%positive => assert (D : (a >= b \/ a < b)%positive) by (zify; lia) end.
   destruct D as [D|D]; auto. exfalso.
   assert (AT : exists (R : pred rmap), (lkat R loc) Phi). {
     destruct o.
@@ -627,58 +595,6 @@ Proof.
     + symmetry; apply identity_core, ghost_of_identity; auto.
 Qed.
 
-Lemma mem_cohere'_store ge m (tp : jstate ge) m' b ofs j i Phi (cnti : containsThread tp i):
-  forall (Hcmpt : mem_compatible tp m)
-    (lock : lockRes tp (b, Ptrofs.intval ofs) <> None)
-    (Hlt' : permMapLt
-           (setPermBlock (Some Writable) b (Ptrofs.intval ofs) (juice2Perm_locks (getThreadR i tp cnti) m)
-              LKSIZE_nat) (getMaxPerm m))
-    (Hstore : Mem.store Mint32 (restrPermMap Hlt') b (Ptrofs.intval ofs) (Vint j) = Some m'),
-    mem_compatible_with tp m Phi (* redundant with Hcmpt, but easier *) ->
-    (exists phi, join_sub phi Phi /\ exists sh R, LKspec LKSIZE sh R (b, Ptrofs.intval ofs) phi) ->
-    mem_cohere' m' Phi.
-Proof.
-  intros Hcmpt lock Hlt' Hstore compat HLKspec.
-  pose proof store_outside' _ _ _ _ _ _ Hstore as SO.
-  destruct compat as [J MC LW JL LJ].
-  destruct MC as [Co Ac Ma].
-  split.
-  - intros sh sh' v (b', ofs') pp E.
-    specialize (Co sh sh' v (b', ofs') pp E).
-    destruct Co as [<- ->]. split; auto.
-    destruct SO as (Co1 & A1 & N1).
-    specialize (Co1 b' ofs').
-    destruct Co1 as [In|Out].
-    + exfalso (* because there is no lock at (b', ofs') *).
-      destruct HLKspec as (? & J' & ? & ? & HLKspec & ?).
-      apply (resource_at_join_sub _ _ (b', ofs')) in J' as [? J'].
-      rewrite E in J'.
-      specialize (HLKspec (b', ofs')); simpl in HLKspec.
-      rewrite if_true in HLKspec.
-      destruct HLKspec as [? HLK]; rewrite HLK in J'; inv J'.
-      { destruct In; pose proof LKSIZE_int; split; auto; omega. }
-
-    + rewrite <-Out.
-      unfold juicyRestrict_locks in *.
-      rewrite restrPermMap_contents.
-      auto.
-
-  - intros loc.
-    replace (max_access_at m' loc)
-    with (max_access_at (restrPermMap Hlt') loc)
-    ; swap 1 2.
-    { unfold max_access_at in *.
-      unfold juicyRestrict_locks in *.
-      destruct SO as (_ & -> & _). reflexivity. }
-    clear SO.
-    unfold juicyRestrict_locks in *.
-    rewrite restrPermMap_max.
-    apply Ac.
-
-  - unfold alloc_cohere in *.
-    destruct SO as (_ & _ & <-). auto.
-Qed.
-
 Lemma access_at_fold m b ofs k :
   (mem_access m) !! b ofs k = access_at m (b, ofs) k.
 Proof.
@@ -728,7 +644,7 @@ Proof.
     + simpl.
       destruct n as [ | n | ]; auto.
       assert (Z.pos n = Z.of_nat (Z.to_nat (Z.pos n))) as R.
-      { rewrite Z2Nat.id; auto. zify. omega. }
+      { rewrite Z2Nat.id; auto. zify. lia. }
       rewrite R in R1, R2. remember (Z.to_nat (Z.pos n)) as k.
       clear Heqk R n.
       revert ofs R1 R2; induction k; intros ofs R1 R2; auto.
@@ -737,7 +653,7 @@ Proof.
       * clear IHk.
         specialize (Econt (b, ofs)).
         apply Econt.
-        specialize (R1 ofs ltac:(zify;omega)).
+        specialize (R1 ofs ltac:(zify;lia)).
         pose proof @juicyRestrictCurEq phi m ltac:(apply acc_coh, pr) (b, ofs) as R.
         unfold access_at in R.
         simpl fst in R; simpl snd in R.
@@ -747,8 +663,8 @@ Proof.
         simpl in R1. if_tac in R1; inversion R1.
       * match goal with |- ?x = ?y => cut (Some x = Some y); [injection 1; auto | ] end.
         apply IHk.
-        -- intros ofs' int; apply (R1 ofs' ltac:(zify; omega)).
-        -- intros ofs' int; apply (R2 ofs' ltac:(zify; omega)).
+        -- intros ofs' int; apply (R1 ofs' ltac:(zify; lia)).
+        -- intros ofs' int; apply (R2 ofs' ltac:(zify; lia)).
     + exfalso.
       apply R2; clear R2.
       intros ofs' int; specialize (R1 ofs' int).
@@ -797,68 +713,6 @@ Proof.
     repeat f_equal. apply proof_irr.
 Qed.
 
-Lemma lockSet_Writable_updLockSet_updThread ge m m' i (tp : jstate ge)
-      cnti b ofs ophi ophi' c' phi' z
-      (Hcmpt : mem_compatible tp m)
-      (His_unlocked : AMap.find (elt:=option rmap) (b, Ptrofs.intval ofs) (lset tp) = Some ophi)
-      (Hlt' : permMapLt
-           (setPermBlock (Some Writable) b (Ptrofs.intval ofs) (juice2Perm_locks (getThreadR i tp cnti) m)
-              LKSIZE_nat) (getMaxPerm m))
-      (Hstore : Mem.store Mint32 (restrPermMap Hlt') b (Ptrofs.intval ofs) (Vint z) = Some m') :
-  lockSet_Writable (lset (updLockSet (updThread i tp cnti c' phi') (b, Ptrofs.intval ofs) ophi')) m'.
-Proof.
-  destruct Hcmpt as (Phi, compat).
-  pose proof (loc_writable compat) as lw.
-  intros b' ofs' is; specialize (lw b' ofs').
-  destruct (eq_dec (b, Ptrofs.intval ofs) (b', ofs')).
-  + injection e as <- <- .
-    intros ofs0 int0.
-    rewrite (Mem.store_access _ _ _ _ _ _ Hstore).
-    pose proof restrPermMap_Max as RR.
-    unfold juicyRestrict_locks in *.
-    unfold permission_at in RR.
-    rewrite RR; clear RR.
-    clear is.
-    assert_specialize lw. {
-      clear lw.
-      cleanup.
-      rewrite His_unlocked.
-      reflexivity.
-    }
-    specialize (lw ofs0).
-    autospec lw.
-    exact_eq lw; f_equal.
-    unfold getMaxPerm in *.
-    rewrite PMap.gmap.
-    reflexivity.
-  + assert_specialize lw. {
-      simpl in is.
-      rewrite AMap_find_add in is.
-      if_tac in is. tauto.
-      exact_eq is.
-      unfold ssrbool.isSome in *.
-      cleanup.
-      destruct (AMap.find (elt:=option rmap) (b', ofs') (lset tp));
-        reflexivity.
-    }
-    intros ofs0 inter.
-    specialize (lw ofs0 inter).
-    exact_eq lw. f_equal.
-    unfold juicyRestrict_locks in *.
-    set (m_ := restrPermMap _) in Hstore.
-    change (max_access_at m (b', ofs0) = max_access_at m' (b', ofs0)).
-    transitivity (max_access_at m_ (b', ofs0)).
-    * unfold m_.
-      rewrite restrPermMap_max.
-      reflexivity.
-    * pose proof store_outside' _ _ _ _ _ _ Hstore as SO.
-      unfold access_at in *.
-      destruct SO as (_ & SO & _).
-      apply equal_f with (x := (b', ofs0)) in SO.
-      apply equal_f with (x := Max) in SO.
-      apply SO.
-Qed.
-
 Lemma lockSet_Writable_updThread_updLockSet ge m m' i (tp : jstate ge)
       b ofs ophi ophi' c' phi' z cnti
       (Hcmpt : mem_compatible tp m)
@@ -866,7 +720,7 @@ Lemma lockSet_Writable_updThread_updLockSet ge m m' i (tp : jstate ge)
       (Hlt' : permMapLt
            (setPermBlock (Some Writable) b (Ptrofs.intval ofs) (juice2Perm_locks (getThreadR i tp cnti) m)
               LKSIZE_nat) (getMaxPerm m))
-      (Hstore : Mem.store Mint32 (restrPermMap Hlt') b (Ptrofs.intval ofs) (Vint z) = Some m') :
+      (Hstore : Mem.store Mptr (restrPermMap Hlt') b (Ptrofs.intval ofs) (Vptrofs z) = Some m') :
   lockSet_Writable (lset (updThread i (updLockSet tp (b, Ptrofs.intval ofs) ophi') cnti c' phi')) m'.
 Proof.
   destruct Hcmpt as (Phi, compat).
@@ -1017,11 +871,11 @@ Section Preservation.
   (sch : list nat)
   sch'
   (tp tp' : jstate ge)
-  (jmstep : @JuicyMachine.machine_step _ (ClightSemanticsForMachines.Clight_newSem ge) _ HybridCoarseMachine.DilMem JuicyMachineShell HybridMachineSig.HybridCoarseMachine.scheduler (i :: sch) tr tp m sch'
+  (jmstep : @JuicyMachine.machine_step _ (ClightSemanticsForMachines.ClightSem ge) _ HybridCoarseMachine.DilMem JuicyMachineShell HybridMachineSig.HybridCoarseMachine.scheduler (i :: sch) tr tp m sch'
              tr' tp' m')
   (INV : @state_invariant (@OK_ty (Concurrent_Espec unit CS ext_link)) Jspec' _ Gamma (S n) (m, (tr, i :: sch, tp)))
   (Phi : rmap)
-  (mwellformed: @mem_wellformed ge m)
+(*  (mwellformed: @mem_wellformed ge m) *)
   (compat : mem_compatible_with tp m Phi)
   (extcompat : joins (ghost_of Phi) (Some (ghost_PCM.ext_ref tt, NoneP) :: nil))
   (lev : @level rmap ag_rmap Phi = S n)
@@ -1074,15 +928,13 @@ Section Preservation.
       assert (B : rmap_bound (Mem.nextblock m) Phi) by apply compat.
       right.  (* ? *)
       apply state_invariant_c with (mcompat := Hcmpt'); auto.
-      - red. clear - Hperm mwellformed H0ab.
+(*      - red. clear - Hperm (*mwellformed*).
           red in Hperm. simpl in Hperm. subst.
           unfold install_perm; simpl.
-          (* NOTE from Andrew to Santiago:  H0ab seems to be useless here. *)
-          clear H0ab.
           destruct (thread_mem_compatible Hcmpt cnti). simpl.
           destruct mwellformed. split; auto.
           clear - H.
-          admit. (* Santiago *)
+          admit. (* Santiago *) *)
       - intro; simpl.
         pose proof (lock_coh loc) as lock_coh'.
         destruct (AMap.find _ _) eqn: Hloc; auto.
@@ -1160,7 +1012,7 @@ Section Preservation.
   jmstep_inv; getThread_inv; congruence.*)
 *
   contradiction Htid.
-Admitted. (* Lemma preservation_Kinit *)
+Qed. (* Lemma preservation_Kinit *)
 
   (* We prove preservation for most states of the machine, including
   Kblocked at acquire, but preservation does not hold for
@@ -1175,15 +1027,15 @@ Admitted. (* Lemma preservation_Kinit *)
     ~ blocked_at_external state UNLOCK ->
     state_step state state' ->
     state_invariant Jspec' Gamma (S n) state ->
-    state_bupd(ge := ge) (state_invariant Jspec' Gamma n) state' \/
-    state_bupd(ge := ge) (state_invariant Jspec' Gamma (S n)) state'.
+    state_fupd(ge := ge) (state_invariant Jspec' Gamma n) state' \/
+    state_fupd(ge := ge) (state_invariant Jspec' Gamma (S n)) state'.
   Proof.
     intros not_spawn not_makelock not_freelock not_release STEP.
     inversion STEP as [ | m m' tr tr' sch sch' tp tp' jmstep E E']. right. assert (exists PHI, mem_compatible_with jstate0 m PHI) as [? HPHI] by (inv H1; eauto). now apply state_bupd_intro'.
     (* apply state_invariant_S *)
     subst state state'; clear STEP.
     intros INV.
-    inversion INV as [m0 tr0 sch0 tp0 Phi lev envcoh mwellformed compat extcompat sparse lock_coh safety wellformed unique E].
+    inversion INV as [m0 tr0 sch0 tp0 Phi lev envcoh (*mwellformed*) compat extcompat sparse lock_coh safety wellformed unique E].
     subst m0 sch0 tp0.
 
     destruct sch as [ | i sch ].
@@ -1369,7 +1221,7 @@ Admitted. (* Lemma preservation_Kinit *)
             - apply LJ.
           }
 
-          eapply (state_bupd_intro' _ _ _ (_, (_, _, _))), state_invariant_c with (PHI := Phi) (mcompat := compat').
+          eapply (state_fupd_intro' _ _ _ (_, (_, _, _))), state_invariant_c with (PHI := Phi) (mcompat := compat').
           + assumption.
 
           + (* env_coherence *)
@@ -1473,13 +1325,12 @@ Admitted. (* Lemma preservation_Kinit *)
 
       simpl schedSkip in *.
       clear HschedN.
-      (* left (* TO BE CHANGED *). *)
       (* left (* we need aging, because we're using the safety of the call *). *)
       assert (Htid = cnti) by apply proof_irr. subst Htid.
       assert (Ephi : 0 = 0 -> level (getThreadR _ _ cnti) = S n). {
         rewrite getThread_level with (Phi0 := Phi). auto. apply compat.
       }
-      assert (El : (0 = 0 -> level (getThreadR _ _ cnti) - 1 = n)%nat) by omega.
+      assert (El : (0 = 0 -> level (getThreadR _ _ cnti) - 1 = n)%nat) by lia.
 
       pose proof mem_compatible_with_age _ compat (n := n) as compat_aged.
 
@@ -1653,7 +1504,7 @@ Admitted. (* Lemma preservation_Kinit *)
 
     (* thread[i] is in Kinit *)
     {
-      edestruct preservation_Kinit; eauto; [left | right]; apply state_bupd_intro'; auto.
+      edestruct preservation_Kinit; eauto; [left | right]; apply state_fupd_intro'; auto.
     }
   Qed.
 
diff --git a/concurrency/juicy/semax_preservation_acquire.v b/concurrency/juicy/semax_preservation_acquire.v
index 9b2e76840e..7db7a3ce04 100644
--- a/concurrency/juicy/semax_preservation_acquire.v
+++ b/concurrency/juicy/semax_preservation_acquire.v
@@ -10,18 +10,12 @@ Require Import compcert.common.Values.
 
 Require Import VST.msl.Coqlib2.
 Require Import VST.msl.eq_dec.
-Require Import VST.msl.seplog.
-Require Import VST.msl.age_to.
-Require Import VST.veric.aging_lemmas.
-Require Import VST.veric.initial_world.
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.juicy_mem_lemmas.
 Require Import VST.veric.semax_prog.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.Clight_new.
-Require Import VST.veric.Clightnew_coop.
+Require Import VST.veric.Clight_core.
+Require Import VST.veric.Clightcore_coop.
 Require Import VST.veric.semax.
-Require Import VST.veric.semax_ext.
 Require Import VST.veric.juicy_extspec.
 Require Import VST.veric.juicy_safety.
 Require Import VST.veric.initial_world.
@@ -30,8 +24,6 @@ Require Import VST.veric.tycontext.
 Require Import VST.veric.semax_ext.
 Require Import VST.veric.res_predicates.
 Require Import VST.veric.mem_lessdef.
-Require Import VST.veric.age_to_resource_at.
-Require Import VST.veric.ghost_PCM.
 Require Import VST.floyd.coqlib3.
 Require Import VST.sepcomp.step_lemmas.
 Require Import VST.sepcomp.event_semantics.
@@ -46,11 +38,7 @@ Require Import VST.concurrency.common.addressFiniteMap.
 Require Import VST.concurrency.common.permissions.
 Require Import VST.concurrency.juicy.JuicyMachineModule.
 Require Import VST.concurrency.juicy.sync_preds_defs.
-Require Import VST.concurrency.juicy.sync_preds.
 Require Import VST.concurrency.juicy.join_lemmas.
-(*Require Import VST.concurrency.cl_step_lemmas.
-Require Import VST.concurrency.resource_decay_lemmas.
-Require Import VST.concurrency.resource_decay_join.*)
 Require Import VST.concurrency.juicy.semax_invariant.
 Require Import VST.concurrency.juicy.semax_simlemmas.
 Require Import VST.concurrency.juicy.sync_preds.
@@ -84,7 +72,7 @@ Proof.
   intros ?? H%AMap.find_2%AMap.elements_1.
   apply SetoidList.InA_alt in H as ((?,?) & [] & ?); simpl in *; subst.
   apply listoption_inv_In, in_map_iff.
-  do 2 eexists; eauto; auto.
+  eexists; split; eauto; auto.
 Qed.
 
 (* to make the proof faster, we avoid unfolding of those definitions *)
@@ -99,13 +87,13 @@ Lemma preservation_acquire
      : forall ge (m m' : Memory.mem) (i : nat) (tp : jstate ge),
        forall (cnti : containsThread tp i) (b : block) (ofs : ptrofs) (ophi : option rmap)
          (ophi' : lock_info) (c' : ctl) (phi' : res)
-         (z : int) (Hcmpt : mem_compatible tp m)
+         z (Hcmpt : mem_compatible tp m)
          (Hcmpt : mem_compatible tp m)
          (His_unlocked : AMap.find (elt:=option rmap) (b, Ptrofs.intval ofs) (lset tp) = Some ophi)
          (Hlt' : permMapLt
               (setPermBlock (Some Writable) b (Ptrofs.intval ofs) (juice2Perm_locks (getThreadR i tp cnti) m)
                  LKSIZE_nat) (getMaxPerm m))
-         (Hstore : Mem.store Mint32 (restrPermMap Hlt') b (Ptrofs.intval ofs) (Vint z) = Some m'),
+         (Hstore : Mem.store Mptr (restrPermMap Hlt') b (Ptrofs.intval ofs) (Vptrofs z) = Some m'),
        lockSet_Writable (lset (updLockSet (updThread i tp cnti c' phi') (b, Ptrofs.intval ofs) ophi')) m')
   (mem_cohere'_store : forall ge m (tp : jstate ge) m' b ofs j i Phi (cnti : containsThread tp i)
     (Hcmpt : mem_compatible tp m)
@@ -113,7 +101,7 @@ Lemma preservation_acquire
     (Hlt' : permMapLt
            (setPermBlock (Some Writable) b (Ptrofs.intval ofs) (juice2Perm_locks (getThreadR i tp cnti) m)
               LKSIZE_nat) (getMaxPerm m))
-    (Hstore : Mem.store Mint32 (restrPermMap Hlt') b (Ptrofs.intval ofs) (Vint j) = Some m'),
+    (Hstore : Mem.store Mptr (restrPermMap Hlt') b (Ptrofs.intval ofs) (Vptrofs j) = Some m'),
     mem_compatible_with tp m Phi ->
     (exists phi, join_sub phi Phi /\ exists sh R, LKspec LKSIZE sh R (b, Ptrofs.intval ofs) phi) ->
     mem_cohere' m' Phi)
@@ -145,7 +133,7 @@ Lemma preservation_acquire
   (extcompat : joins (ghost_of Phi) (Some (ext_ref tt, NoneP) :: nil))
   (sparse : lock_sparsity (lset tp))
   (lock_coh : lock_coherence' tp Phi m compat)
-  (safety : threads_safety Jspec' m tp Phi compat (S n))
+  (safety : threads_safety Jspec' m tp Phi compat)
   (wellformed : threads_wellformed tp)
   (unique : unique_Krun tp (i :: sch))
   (Ei cnti : containsThread tp i)
@@ -163,24 +151,22 @@ Lemma preservation_acquire
   (psh : shares.readable_share sh)
   (R : pred rmap)
   (Hthread : getThreadC i tp cnti = Kblocked c)
-  (Hat_external : at_external (ClightSemanticsForMachines.CLN_evsem ge) c m = Some (LOCK, Vptr b ofs :: nil))
+  (Hat_external : at_external (Clight_evsem.CLC_evsem ge) c m = Some (LOCK, Vptr b ofs :: nil))
   (His_unlocked : lockRes tp (b, Ptrofs.intval ofs) = Some (Some d_phi))
-  (Hload : Mem.load Mint32 (juicyRestrict_locks (mem_compat_thread_max_cohere Hcmpt cnti))
+  (Hload : Mem.load Mptr (juicyRestrict_locks (mem_compat_thread_max_cohere Hcmpt cnti))
                     b (Ptrofs.intval ofs) =
-          Some (Vint Int.one))
+          Some (Vptrofs Ptrofs.one))
   (Hlt' : permMapLt
            (setPermBlock (Some Writable) b (Ptrofs.intval ofs) (juice2Perm_locks (getThreadR i tp cnti) m)
               LKSIZE_nat) (getMaxPerm m))
-  (Hstore : Mem.store Mint32 (restrPermMap Hlt') b (Ptrofs.intval ofs) (Vint Int.zero) = Some m')
-  (* (Hstore : Mem.store Mint32 (juicyRestrict_locks (mem_compat_thread_max_cohere Hcmpt cnti)) *)
-  (*                     b (Ptrofs.intval ofs) (Vint Int.zero) = Some m') *)
+  (Hstore : Mem.store Mptr (restrPermMap Hlt') b (Ptrofs.intval ofs) (Vptrofs Ptrofs.zero) = Some m')
 (*  (HJcanwrite : lock_at_least sh R (getThreadR i tp cnti) b (Ptrofs.intval ofs)) *)
 (* forall j, 0 <= j < LKSIZE -> getThreadR i tp cnti @ (b, Ptrofs.intval ofs+j) = YES sh psh (LK LKSIZE j) (pack_res_inv R)) *)
   (Hadd_lock_res : join (getThreadR i tp cnti) d_phi phi')
-  (jmstep : @JuicyMachine.machine_step _ (ClightSemanticsForMachines.Clight_newSem ge) _ HybridCoarseMachine.DilMem JuicyMachineShell HybridMachineSig.HybridCoarseMachine.scheduler (i :: sch) tr tp m sch (seq.cat tr (external i (acquire (b, Ptrofs.intval ofs) None) :: nil))
+  (jmstep : @JuicyMachine.machine_step _ (ClightSemanticsForMachines.ClightSem ge) _ HybridCoarseMachine.DilMem JuicyMachineShell HybridMachineSig.HybridCoarseMachine.scheduler (i :: sch) tr tp m sch (seq.cat tr (external i (acquire (b, Ptrofs.intval ofs) None) :: nil))
              (age_tp_to n
                 (updLockSet (updThread i tp cnti (Kresume c Vundef) phi') (b, Ptrofs.intval ofs) None)) m')
-  (Htstep : @syncStep (ClightSemanticsForMachines.Clight_newSem ge) true _ _ _ cnti Hcmpt
+  (Htstep : @syncStep (ClightSemanticsForMachines.ClightSem ge) true _ _ _ cnti Hcmpt
              (age_tp_to n
                 (updLockSet (updThread i tp cnti (Kresume c Vundef) phi') (b, Ptrofs.intval ofs) None)) m'
              (Events.acquire (b, Ptrofs.intval ofs) None)) :
@@ -208,7 +194,7 @@ Proof.
       simpl map.
       assert (pr:containsThread (remLockSet tp (b, Ptrofs.intval ofs)) i) by auto.
       rewrite (maps_getthread i _ pr) in J.
-      rewrite gRemLockSetRes with (cnti0 := cnti) in J. clear pr.
+      rewrite gRemLockSetRes with (cnti := cnti) in J. clear pr.
       revert Hadd_lock_res J.
       generalize (getThreadR _ _ cnti) d_phi phi'.
       generalize (all_but i (maps (remLockSet tp (b, Ptrofs.intval ofs)))).
@@ -220,7 +206,7 @@ Proof.
     - (* mem_cohere' *)
       pose proof juice_join compat as J.
       pose proof all_cohere compat as MC.
-      eapply (mem_cohere'_store _ _ tp _ _ _ (Int.zero) _ _ cnti Hcmpt).
+      eapply (mem_cohere'_store _ _ tp _ _ _ (Ptrofs.zero) _ _ cnti Hcmpt).
       + cleanup.
         rewrite His_unlocked. simpl. congruence.
       + (* there is this hcmpt which is redundant, we can prove they're equal or think more to factorize it *)
@@ -229,7 +215,8 @@ Proof.
       + specialize (safety _ cnti tt).
         rewrite Hthread in safety.
         unshelve eapply jsafe_phi_jsafeN in safety; try apply compat.
-        inversion safety as [ | ?????? step | ??????? ae Pre Post Safe | ????? Ha].
+        inversion safety as [ | ????? step | ?????? ae Pre Post Safe | ???? Ha].
+        * rewrite level_jm_ in H; setoid_rewrite H in lev; discriminate.
         * (* not corestep *)
           exfalso.
           clear -Hat_external step.
@@ -247,43 +234,33 @@ Proof.
             congruence. }
           subst e.
           revert x Pre Post.
-          funspec_destruct "acquire"; swap 1 2.
-          { exfalso. unfold ef_id_sig, ef_sig in *.
-            unfold funsig2signature in Heq_name; simpl in Heq_name.
-            contradiction Heq_name; auto. }
+          funspec_destruct "acquire".
           intros (? & ? & [] & ? & ?) (Hargsty, Pre) Post.
           destruct Pre as (phi0 & phi1 & j & Pre & H88).
           simpl in Pre.
-          destruct Pre as [_ [[[Hv _] _] Hlk]]; simpl in Hv, Hlk.
-          unfold canon.SEPx in Hlk; simpl in Hlk.
+          destruct Pre as [_ [Hv [_ Hlk]]].
+          unfold canon.SEPx, SeparationLogic.argsassert2assert in Hlk; simpl in Hlk.
           rewrite seplog.sepcon_emp in Hlk.
           assert (args = Vptr b ofs :: nil). {
             revert Hat_external ae; clear.
-            rewrite ClightSemanticsForMachines.CLN_msem. simpl.
+            rewrite Clight_evsem.CLC_msem. simpl.
             intros. unfold cl_at_external in *.
             congruence.
           }
           subst args.
           assert (v = Vptr b ofs). {
-            rewrite Hv.
-            clear.
-            unfold mpred.eval_id in *.
-            unfold val_lemmas.force_val in *.
-            unfold make_ext_args in *.
-            unfold te_of in *.
-            unfold filter_genv in *.
-            unfold Genv.find_symbol in *.
-            unfold mpred.env_set in *.
-            rewrite Map.gss.
-            auto.
+            inv Hv; auto.
           }
           subst v.
           destruct Hlk as (? & ? & Heq & ?); inv Heq.
           exists phi0; split; eauto.
           eapply join_sub_trans; [eexists; eauto|].
           apply compatible_threadRes_sub; auto.
+          { exfalso. unfold ef_id_sig, ef_sig in *.
+            unfold funsig2signature in Heq_name; simpl in Heq_name.
+            contradiction Heq_name; auto. }
         * (* not halted *)
-          contradiction.
+          destruct c; try discriminate. contradiction.
 
     - (* lockSet_Writable *)
       eapply lockSet_Writable_updLockSet_updThread; eauto.
@@ -302,10 +279,7 @@ Proof.
       intros loc; specialize (lj loc).
       simpl.
       rewrite AMap_find_add.
-      if_tac; swap 1 2.
-      + cleanup.
-        intros is; specialize (lj is).
-        destruct lj as (sh' & E). exists sh'. auto.
+      if_tac.
       + intros _. subst loc.
         assert_specialize lj. {
           cleanup.
@@ -313,6 +287,9 @@ Proof.
           reflexivity.
         }
         destruct lj as (sh' & E). exists sh'; auto.
+      + cleanup.
+        intros is; specialize (lj is).
+        destruct lj as (sh' & E). exists sh'. auto.
   }
 
   pose proof mem_compatible_with_age _ compat'' (n := n) as compat'.
@@ -320,14 +297,14 @@ Proof.
 
   apply state_invariant_c with (mcompat := compat').
   + (* level *)
-    apply level_age_to. cleanup. omega.
+    apply level_age_to. cleanup. lia.
 
   + (* env_coherence *)
     apply env_coherence_age_to. auto.
-  + inv INV. clear -mwellformed Hstore.
-      simpl in Hlt'.
-      admit. (* Santiago *)
-  + rewrite age_to_ghost_of.
+(*  + inv INV. clear -mwellformed Hstore.
+    eapply mem_wellformed_store; [.. | apply Hstore |]; auto.
+    apply mem_wellformed_restr; auto. *)
+  + unfold ext_compat; rewrite age_to_ghost_of.
     destruct extcompat as [? J]; eapply ghost_fmap_join in J; eexists; eauto.
 
   + (* lock sparsity *)
@@ -352,17 +329,7 @@ Proof.
 
     * (* current lock is acquired: load is indeed 0 *)
       { subst loc.
-        split; swap 1 2.
-        - (* the rmap is unchanged (but we lose the SAT information) *)
-          cut ((4 | Ptrofs.intval ofs) /\  (Ptrofs.intval ofs + LKSIZE < Ptrofs.modulus)%Z /\
-               exists R0, (lkat R0 (b, Ptrofs.intval ofs)) Phi).
-          { intros (align & bound & R0 & AP). repeat (split; auto).
-            exists R0. revert AP. apply age_to_ind, lkat_hered. }
-          cleanup.
-          rewrite His_unlocked in lock_coh.
-          destruct lock_coh as (H & (* ? & *) ? & align & bound & lk & _).
-          eauto.
-
+        split.
         - (* in dry : it is 0 *)
           unfold load_at.
           clear (* lock_coh *) Htstep Hload.
@@ -386,15 +353,20 @@ Proof.
             * rewrite LockRes_age_content1.
               rewrite gssLockRes. simpl. congruence.
             * congruence.
+
+        - (* the rmap is unchanged (but we lose the SAT information) *)
+          cut ((size_chunk Mptr | Ptrofs.intval ofs) /\  (Ptrofs.intval ofs + LKSIZE < Ptrofs.modulus)%Z /\
+               exists R0, (lkat R0 (b, Ptrofs.intval ofs)) Phi).
+          { intros (align & bound & R0 & AP). repeat (split; auto).
+            exists R0. revert AP. apply age_to_ind, lkat_hered. }
+          cleanup.
+          rewrite His_unlocked in lock_coh.
+          destruct lock_coh as (H & (* ? & *) ? & align & bound & lk & _).
+          eauto.
       }
 
     * (* not the current lock *)
-      destruct (AMap.find (elt:=option rmap) loc (lset tp)) as [o|] eqn:Eo; swap 1 2.
-      {
-        simpl.
-        clear -lock_coh.
-        rewrite isLK_age_to(* , isCT_age_to *). auto.
-      }
+      destruct (AMap.find (elt:=option rmap) loc (lset tp)) as [o|] eqn:Eo; [|rewrite isLK_age_to; auto].
       set (u := load_at _ _).
       set (v := load_at _ _) in lock_coh.
       assert (L : forall val, v = Some val -> u = Some val); unfold u, v in *.
@@ -412,28 +384,25 @@ Proof.
         unfold Mem.load in *.
         if_tac [V|V]; [ | congruence].
         if_tac [V'|V'].
-        - do 2 rewrite restrPermMap_mem_contents.
+        - rewrite !restrPermMap_mem_contents.
           intros G; exact_eq G.
           f_equal.
           f_equal.
           f_equal.
-          simpl.
 
           pose proof store_outside' _ _ _ _ _ _ Hstore as OUT.
           destruct OUT as (OUT, _).
           cut (forall z,
-                  (0 <= z < 4)%Z ->
+                  (0 <= z < size_chunk Mptr)%Z ->
                   ZMap.get (ofs' + z)%Z (Mem.mem_contents m) !! b' =
                   ZMap.get (ofs' + z)%Z (Mem.mem_contents m') !! b').
           {
-            intros G.
+            intros G; simpl.
             repeat rewrite <- Z.add_assoc.
             f_equal.
-            - specialize (G 0%Z ltac:(omega)).
+            - specialize (G 0%Z ltac:(simpl; lia)).
               exact_eq G. repeat f_equal; auto with zarith.
-            - f_equal; [apply G; omega | ].
-              f_equal; [apply G; omega | ].
-              f_equal; apply G; omega.
+            - repeat (f_equal; [apply G; simpl; lia | ]); f_equal; apply G; simpl; lia.
           }
           intros z Iz.
           specialize (OUT b' (ofs' + z)%Z).
@@ -445,9 +414,9 @@ Proof.
             * instantiate (1 := z).
               unfold size_chunk in *.
               unfold LKSIZE in *.
-              rewrite size_chunk_Mptr; simple_if_tac; omega.
+              destruct Mptr; simpl in *; lia.
             * unfold LKSIZE in *.
-              rewrite size_chunk_Mptr; simple_if_tac; omega.
+              destruct Mptr; simpl in *; lia.
           + unfold contents_at in *.
             simpl in OUT.
             apply OUT.
@@ -455,7 +424,7 @@ Proof.
         - exfalso.
           apply V'; clear V'.
           unfold Mem.valid_access in *.
-          split. 2:apply V. destruct V as [V _].
+          split; [|apply V]. destruct V as [V _].
           unfold Mem.range_perm in *.
           intros ofs0 int0; specialize (V ofs0 int0).
           unfold Mem.perm in *.
@@ -470,19 +439,18 @@ Proof.
           destruct SPA as [bOUT | [<- ofsOUT]].
           + rewrite OrdinalPool.gsoLockSet_2; auto.
             apply OrdinalPool.lockSet_spec_2 with ofs'.
-            * hnf; simpl. eauto. clear - int0; simpl in *; unfold LKSIZE_nat; rewrite Z2Nat.id by (pose proof LKSIZE_pos; omega); unfold LKSIZE; rewrite size_chunk_Mptr; simple_if_tac; omega.
+            * hnf; simpl. eauto. lkomega.
             * cleanup. rewrite Eo. reflexivity.
           + rewrite OrdinalPool.gsoLockSet_1; auto.
             * apply OrdinalPool.lockSet_spec_2 with ofs'.
-              -- hnf; simpl. eauto. clear - int0; simpl in *; unfold LKSIZE_nat; rewrite Z2Nat.id by (pose proof LKSIZE_pos; omega); unfold LKSIZE; rewrite size_chunk_Mptr; simple_if_tac; omega.
+              -- hnf; simpl. eauto. lkomega.
               -- cleanup. rewrite Eo. reflexivity.
             * unfold far in *.
               simpl in *.
               clear - int0 ofsOUT H.
               pose proof LKSIZE_pos.
-              unfold LKSIZE_nat; rewrite Z2Nat.id by omega.
               zify.
-              unfold LKSIZE in *; rewrite size_chunk_Mptr in *; simple_if_tac; omega.
+              unfold LKSIZE in *; simpl in *; lia.
       }
       destruct o; destruct lock_coh as (Load & align & bound & R' & lks); split.
       -- now intuition.
@@ -496,7 +464,7 @@ Proof.
                unfold age_to in *.
                rewrite age_by_age_by.
                apply age_by_age_by_pred.
-               omega.
+               lia.
             ** congruence.
       -- now intuition.
       -- repeat (split; auto).
@@ -522,8 +490,9 @@ Proof.
         rewrite Hthread in wellformed.
         intros c' Ec'.
 
-        eapply jsafe_phi_jsafeN with (compat0 := compat) in safety.
-        inversion safety as [ | ?????? step | ??????? ae Pre Post Safe | ????? Ha]; swap 2 3.
+        eapply jsafe_phi_jsafeN with (compat := compat) in safety.
+        inversion safety as [ | ????? step | ?????? ae Pre Post Safe | ???? Ha]; last (destruct c; try discriminate; contradiction).
+        - rewrite level_jm_ in H; setoid_rewrite H in lev; discriminate.
         - (* not corestep *)
           exfalso.
           clear -Hat_external step.
@@ -536,16 +505,13 @@ Proof.
          }
           congruence.
 
-        - (* not halted *)
-          contradiction.
-
         - (* at_external : we can now use safety *)
           subst z c0 m0.
           intros jm' Ejm'.
           destruct Post with
           (ret := @None val)
             (m' := jm')
-            (z' := ora) (n' := n) as (c'' & Ec'' & Safe').
+            (z' := ora) as (c'' & Ec'' & Safe').
 
           + assert (e = LOCK).
             { simpl in ae.
@@ -557,8 +523,7 @@ Proof.
               clear - ae Hat_external. rewrite ClightSemanticsForMachines.at_external_SEM_eq in Hat_external.
               unfold j_at_external in ae. unfold cl_at_external in ae.
               congruence. }
-            subst e args; simpl.
-            unfold Tptr; simple_if_tac; auto.
+            subst e args; simpl; auto.
 
           + assert (e = LOCK).
             { simpl in ae.
@@ -568,8 +533,6 @@ Proof.
             subst e.
             apply Logic.I.
 
-          + auto.
-
           + (* proving Hrel *)
             hnf.
             assert (n = level jm'). {
@@ -579,21 +542,19 @@ Proof.
               REWR.
               REWR.
               rewrite level_age_to; auto.
-              replace (level phi') with (level Phi). omega.
+              replace (level phi') with (level Phi). lia.
               transitivity (level (getThreadR i tp cnti)); join_level_tac.
-              setoid_rewrite getThread_level with (Phi0 := Phi). auto. apply compat.
+              setoid_rewrite getThread_level with (Phi := Phi). auto. apply compat.
             }
             assert (level phi' = S n). {
               transitivity (level (getThreadR i tp cnti)); join_level_tac.
-              setoid_rewrite getThread_level with (Phi0 := Phi). auto. apply compat.
+              setoid_rewrite getThread_level with (Phi := Phi). auto. apply compat.
             }
 
-            split; [ | split].
-            * auto.
-            * rewr (level jm'). rewrite level_jm_. cleanup. omega.
-            * simpl. rewrite Ejm'. do 3 REWR.
-              eapply pures_same_eq_l.
-              2:apply pures_eq_age_to; omega.
+            split.
+            * rewr (level jm'). rewrite level_jm_. cleanup. lia.
+            * simpl. rewrite Ejm'. REWR. REWR. REWR.
+              eapply pures_same_eq_l, pures_eq_age_to; [|lia].
               apply pures_same_sym.
               apply join_sub_pures_same. exists d_phi. assumption.
 
@@ -605,10 +566,7 @@ Proof.
               congruence. }
             subst e.
             revert x Pre Post.
-            funspec_destruct "acquire"; swap 1 2.
-            { exfalso. unfold ef_id_sig, ef_sig in *.
-              unfold funsig2signature in Heq_name; simpl in Heq_name.
-              contradiction Heq_name; auto. }
+            funspec_destruct "acquire".
             intros x (Hargsty, Pre) Post.
             simpl.
             destruct Pre as (phi0 & phi1 & j & Pre).
@@ -626,12 +584,9 @@ Proof.
                 simpl (fst _) in *; simpl (snd _) in *; simpl (projT2 _) in *.
               clear ts.
               cbv iota beta in Pre.
-              Unset Printing Implicit.
-              destruct Pre as [[[A B] [[C _] D]] E].
-Opaque age_tp_to.
-              simpl in *.
-              split3. 2:eapply necR_trans; [ | apply  age_to_necR ]; auto.
-              2: destruct E; auto.
+              destruct Pre as (([A _] & B & _ & D) & E & F).
+Opaque age_tp_to. Opaque LKSIZE_nat.
+              split; [|eapply necR_trans; [ | apply  age_to_necR ]; auto].
               split. now auto.
               split. now auto.
               unfold canon.SEPx in *.
@@ -644,28 +599,11 @@ Opaque age_tp_to.
                  cleanup.
                  rewrite His_unlocked in lock_coh.
                  destruct lock_coh as [_ (align & bound & R' & lkat & sat)].
-                 destruct sat as [sat | ?]. 2:congruence.
+                 destruct sat as [sat | ?]; [|congruence].
                  pose proof predat6 lkat as ER'.
-                 assert (args = Vptr b ofs :: nil). {
-                   revert Hat_external ae; clear.
-                   intros. unfold cl_at_external in *.
-                   congruence.
-                 }
+                 assert (args = vx :: nil) by auto.
                  subst args.
-                 assert (vx = Vptr b ofs). {
-                   destruct C as [-> _].
-                   clear.
-                   unfold eval_id in *.
-                   unfold val_lemmas.force_val in *.
-                   unfold make_ext_args in *.
-                   unfold te_of in *.
-                   unfold filter_genv in *.
-                   unfold Genv.find_symbol in *.
-                   unfold env_set in *.
-                   rewrite Map.gss.
-                   auto.
-                 }
-                 subst vx.
+                 rewrite Hat_external in ae; inversion ae; subst vx.
                  pose proof predat4 D as ERx.
                  assert (join_sub phi0 Phi).
                  { join_sub_tac.
@@ -675,15 +613,12 @@ Opaque age_tp_to.
                  apply (@predat_join_sub _ Phi) in ERx; auto.
                  unfold Ptrofs.unsigned in *.
                  pose proof predat_inj ER' ERx as ER.
-                 replace (age_by 1 d_phi) with (age_to n d_phi) in sat; swap 1 2.
+                 assert (age_by 1 d_phi = age_to n d_phi) as Heq; [|setoid_rewrite Heq in sat].
                  {
                    unfold age_to in *. f_equal.
-                   replace (level d_phi) with (level Phi); swap 1 2.
-                   {
-                     pose proof @compatible_lockRes_sub_all _ _ _ _ His_unlocked Phi ltac:(apply compat).
-                     join_level_tac.
-                   }
-                   omega.
+                   replace (level d_phi) with (level Phi). lia.
+                   pose proof @compatible_lockRes_sub_all _ _ _ _ His_unlocked Phi ltac:(apply compat).
+                   join_level_tac.
                  }
                  replace (level phi0) with (level Phi) in * by join_level_tac.
                  rewrite lev in *.
@@ -691,30 +626,10 @@ Opaque age_tp_to.
                  apply approx_eq_app_pred with (S n); auto.
                  rewrite level_age_to. auto.
                  replace (level d_phi) with (level Phi) in * by join_level_tac.
-                 omega.
-              -- unshelve setoid_rewrite <- getThreadR_age; auto.
-                   rewrite age_to_ghost_of.
-                   unshelve setoid_rewrite OrdinalPool.gLockSetRes; auto.
-                   rewrite OrdinalPool.gssThreadRes.
-                   destruct E as [_ E].
-                   apply ext_join_approx.
-                   pose proof (juice_join compat) as H; inv H.
-                   destruct ora.
-                   eapply join_sub_joins_trans, extcompat.
-                   apply lockRes_thread in His_unlocked.
-                   inv H2.
-                   { apply join_list'_None in H1; setoid_rewrite H1 in His_unlocked; contradiction. }
-                   apply join_list'_Some in H1.
-                   eapply joinlist_join_sub in H1; eauto.
-                   unfold join_threads in H0.
-                   rewrite join_list_joinlist in H0.
-                   eapply joinlist_join_sub in H0; [|eapply nth_error_In, (getThreadR_nth _ _ cnti)].
-                   destruct H0 as (x1 & J1), H1 as (x2 & J2).
-                   destruct (join_assoc (join_comm J1) H5) as (? & J1' & Ja).
-                   destruct (join_assoc (join_comm J2) (join_comm J1')) as (? & J & Jb).
-                   pose proof (join_eq (join_comm J) Hadd_lock_res); subst.
-                   destruct (join_assoc (join_comm Jb) (join_comm Ja)) as (? & ? & ?).
-                   eexists; apply ghost_of_join; eauto.
+                 lia.
+            * exfalso. unfold ef_id_sig, ef_sig in *.
+              unfold funsig2signature in Heq_name; simpl in Heq_name.
+              contradiction Heq_name; auto.
 
           + exact_eq Safe'.
             unfold jsafeN in *.
@@ -728,13 +643,11 @@ Opaque age_tp_to.
     * repeat REWR.
       destruct (getThreadC j tp lj) eqn:Ej.
       -- edestruct (unique_Krun_neq(ge := ge) i j); eauto.
-      -- apply jsafe_phi_age_to; auto. apply jsafe_phi_downward. assumption.
-      -- intros c' Ec'; specialize (safety c' Ec'). apply jsafe_phi_bupd_age_to; auto.
-         apply jsafe_phi_bupd_downward. assumption.
-      -- destruct safety as (? & q_new & Einit & safety).
-         split; [erewrite Mem.nextblock_store by eauto; auto|].
+      -- apply jsafe_phi_age_to; auto.
+      -- intros c' Ec'; specialize (safety c' Ec'). apply jsafe_phi_fupd_age_to; auto.
+      -- destruct safety as (q_new & Einit & safety).
          exists q_new; split; auto.
-         apply jsafe_phi_age_to; auto. apply jsafe_phi_downward, safety.
+         apply jsafe_phi_fupd_age_to; auto.
 
   + (* well_formedness *)
     intros j lj.
@@ -757,4 +670,4 @@ Opaque age_tp_to.
     eapply unique_Krun_no_Krun. eassumption.
     instantiate (1 := cnti). rewrite Hthread.
     congruence.
-Admitted. (* preservation_acquire *)
+Qed. (* preservation_acquire *)
diff --git a/concurrency/juicy/semax_preservation_jspec.v b/concurrency/juicy/semax_preservation_jspec.v
index 9f99723344..120222e586 100644
--- a/concurrency/juicy/semax_preservation_jspec.v
+++ b/concurrency/juicy/semax_preservation_jspec.v
@@ -10,18 +10,12 @@ Require Import compcert.common.Values.
 
 Require Import VST.msl.Coqlib2.
 Require Import VST.msl.eq_dec.
-Require Import VST.msl.seplog.
-Require Import VST.veric.aging_lemmas.
-Require Import VST.veric.initial_world.
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.juicy_mem_lemmas.
 Require Import VST.veric.semax_prog.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.Clight_new.
-Require Import VST.veric.Clightnew_coop.
+Require Import VST.veric.Clight_core.
+Require Import VST.veric.Clightcore_coop.
 Require Import VST.veric.semax.
-Require Import VST.veric.semax_ext.
-Require Import VST.veric.juicy_extspec.
 Require Import VST.veric.juicy_safety.
 Require Import VST.veric.initial_world.
 Require Import VST.veric.juicy_extspec.
@@ -53,19 +47,7 @@ Section Jspec'_properties.
 
   Lemma is_EF_external ef : ext_spec_type Jspec' ef -> exists name sg, ef = EF_external name sg.
   Proof.
-    destruct ef as [name sg | | | | | | | | | | | ].
-    - now eauto.
-    - simpl; do 5 (if_tac; [ now breakhyps | ]); now intros [].
-    - simpl; do 5 (if_tac; [ now breakhyps | ]); now intros [].
-    - simpl; do 5 (if_tac; [ now breakhyps | ]); now intros [].
-    - simpl; do 5 (if_tac; [ now breakhyps | ]); now intros [].
-    - simpl; do 5 (if_tac; [ now breakhyps | ]); now intros [].
-    - simpl; do 5 (if_tac; [ now breakhyps | ]); now intros [].
-    - simpl; do 5 (if_tac; [ now breakhyps | ]); now intros [].
-    - simpl; do 5 (if_tac; [ now breakhyps | ]); now intros [].
-    - simpl; do 5 (if_tac; [ now breakhyps | ]); now intros [].
-    - simpl; do 5 (if_tac; [ now breakhyps | ]); now intros [].
-    - simpl; do 5 (if_tac; [ now breakhyps | ]); now intros [].
+    destruct ef as [name sg | | | | | | | | | | | ]; first (now eauto); simpl; repeat (if_tac; [ now breakhyps | ]); now intros [].
   Qed.
 
   Open Scope string_scope.
@@ -112,50 +94,24 @@ Section Jspec'_properties.
   Lemma Jspec'_hered : ext_spec_stable age (JE_spec _ Jspec').
   Proof.
     split; [ | easy ].
-    intros e x b tl vl z m1 m2 A.
-
-    unfold Jspec' in *.
-    destruct (is_EF_external e x) as (name & sg & ->).
-
-    apply age_jm_phi in A.
-    assert (joins (ghost_of (m_phi m1)) (Some (ghost_PCM.ext_ref z, NoneP) :: nil) ->
-       joins (ghost_of (m_phi m2)) (Some (ghost_PCM.ext_ref z, NoneP) :: nil)) as J.
-    { erewrite (age1_ghost_of _ _ A); apply ext_join_approx. }
-
-    (* dependent destruction *)
-    revert x.
-    1:funspec_destruct "acquire".
-    2:funspec_destruct "release".
-    3:funspec_destruct "makelock".
-    4:funspec_destruct "freelock".
-    5:funspec_destruct "spawn".
-
-    6: solve[intros[]].
-    all:intros x (Hargsty & H); split; [apply Hargsty | ].
-    all:breakhyps.
-    all:agejoinhyp.
-    all:breakhyps.
-    all:agehyps.
-    all:agehyps.
-    all:eauto 7.
+    apply JE_pre_hered.
   Qed.
 
-  Lemma Jspec'_jsafe_phi ge n ora c jm ext :
+  Lemma Jspec'_jsafe_phi ge ora c jm ext :
     cl_at_external c = Some ext ->
-    jsafeN Jspec' ge n ora c jm ->
-    jsafe_phi Jspec' ge n ora c (m_phi jm).
+    jsafeN Jspec' ge ora c jm ->
+    jsafe_phi Jspec' ge ora c (m_phi jm).
   Proof.
-    intros atex.
-    destruct n as [ | n]. intros; constructor.
-    intros safe.
-    inversion safe as [ | ? ? ? ? c' jm' step safe' H H2 H3 H4
-                        | ? ? ? ? ef args x atex' Pre Post | ]; subst.
+    intros atex safe.
+    inversion safe as [ | ? ? ? c' jm' step safe'
+                        | ? ? ? ef args x atex' Pre Post | ]; subst.
+    - intros jm_ Ejm_. constructor. rewrite level_juice_level_phi, Ejm_, <- level_juice_level_phi; auto.
     - (* corestep: not at external *)
       destruct step as [step rd].
       erewrite cl_corestep_not_at_external in atex. discriminate. apply step.
     - (* at_ex: interesting case *)
       intros jm_ Ejm_.
-      constructor 3 with (e := ef) (args := args) (x := x).
+      apply jsafeN_external with (e := ef) (args := args) (x := x).
       + auto.
 
       + (* precondition only cares about phi *)
@@ -163,13 +119,8 @@ Section Jspec'_properties.
         unfold Jspec' in *.
         destruct (is_EF_external ef x) as (name & sg & ->).
         revert x Pre.
-
-        1:funspec_destruct "acquire".
-        2:funspec_destruct "release".
-        3:funspec_destruct "makelock".
-        4:funspec_destruct "freelock".
-        5:funspec_destruct "spawn".
-        6: solve[intros[]].
+        funspec_destruct "acquire"; [|funspec_destruct "release"; [|funspec_destruct "makelock"; [|
+          funspec_destruct "freelock"; [|funspec_destruct "spawn"; [|solve[intros[]]]]]]].
 
         all: intros x Pre.
         all: exact_eq Pre.
@@ -180,21 +131,17 @@ Section Jspec'_properties.
         destruct (is_EF_external ef x) as (name & sg & ->).
         clear Pre.
         revert x Post.
-        1:funspec_destruct "acquire".
-        2:funspec_destruct "release".
-        3:funspec_destruct "makelock".
-        4:funspec_destruct "freelock".
-        5:funspec_destruct "spawn".
-        6: solve[intros[]].
+        funspec_destruct "acquire"; [|funspec_destruct "release"; [|funspec_destruct "makelock"; [|
+          funspec_destruct "freelock"; [|funspec_destruct "spawn"; [|solve[intros[]]]]]]].
 
         all: intros x Post.
         all: exact_eq Post.
         all: unfold Hrel in *.
-        all: do 2 rewrite level_juice_level_phi.
-        all: rewrite Ejm_; try reflexivity.
+        all: rewrite !level_juice_level_phi.
+        all: rewrite Ejm_; reflexivity.
 
     - (* halted *)
-      repeat intro; apply jsafeN_halted with (i0 := i); auto.
+      repeat intro; apply jsafeN_halted with (i := i); auto.
   Qed.
 
 End Jspec'_properties.
diff --git a/concurrency/juicy/semax_preservation_local.v b/concurrency/juicy/semax_preservation_local.v
index 6c899ccebc..985d5de100 100644
--- a/concurrency/juicy/semax_preservation_local.v
+++ b/concurrency/juicy/semax_preservation_local.v
@@ -10,18 +10,12 @@ Require Import compcert.common.Values.
 
 Require Import VST.msl.Coqlib2.
 Require Import VST.msl.eq_dec.
-Require Import VST.msl.seplog.
-Require Import VST.msl.age_to.
-Require Import VST.veric.aging_lemmas.
-Require Import VST.veric.initial_world.
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.juicy_mem_lemmas.
 Require Import VST.veric.semax_prog.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.Clight_new.
-Require Import VST.veric.Clightnew_coop.
+Require Import VST.veric.Clight_core.
+Require Import VST.veric.Clightcore_coop.
 Require Import VST.veric.semax.
-Require Import VST.veric.semax_ext.
 Require Import VST.veric.juicy_extspec.
 Require Import VST.veric.juicy_safety.
 Require Import VST.veric.initial_world.
@@ -30,9 +24,9 @@ Require Import VST.veric.tycontext.
 Require Import VST.veric.semax_ext.
 Require Import VST.veric.res_predicates.
 Require Import VST.veric.mem_lessdef.
-Require Import VST.veric.age_to_resource_at.
 Require Import VST.floyd.coqlib3.
 Require Import VST.sepcomp.step_lemmas.
+Require Import VST.sepcomp.mem_lemmas.
 Require Import VST.sepcomp.event_semantics.
 Require Import VST.sepcomp.semantics_lemmas.
 Require Import VST.concurrency.common.permjoin.
@@ -44,11 +38,10 @@ Require Import VST.concurrency.common.addressFiniteMap.
 Require Import VST.concurrency.common.permissions.
 Require Import VST.concurrency.juicy.JuicyMachineModule.
 Require Import VST.concurrency.juicy.sync_preds_defs.
-Require Import VST.concurrency.juicy.sync_preds.
 Require Import VST.concurrency.juicy.join_lemmas.
 Require Import VST.concurrency.juicy.cl_step_lemmas.
-Require Import VST.concurrency.juicy.resource_decay_lemmas.
-Require Import VST.concurrency.juicy.resource_decay_join.
+(*Require Import VST.concurrency.juicy.resource_decay_lemmas.
+Require Import VST.concurrency.juicy.resource_decay_join.*)
 Require Import VST.concurrency.juicy.semax_invariant.
 Require Import VST.concurrency.juicy.semax_simlemmas.
 Require Import VST.concurrency.juicy.sync_preds.
@@ -95,7 +88,7 @@ Lemma resource_decay_join_all ge {tp : jstate ge} {m Phi} c' {phi' i} {cnti : co
     ghost_of Phi' = own.ghost_approx Phi' (ghost_of Phi) /\
     level Phi = S (level Phi').
 Proof.
-  do 2 rewrite join_all_joinlist.
+  rewrite !join_all_joinlist.
   intros B (rd & lev & g) j.
   rewrite (maps_getthread _ _ cnti) in j.
   destruct (resource_decay_joinlist _ _ _ _ _ B rd g j) as (Phi' & j' & rd' & ?).
@@ -154,8 +147,8 @@ Proof.
       inv j'.
       reflexivity.
   - rewrite age_to_ghost_of.
-    rewrite (identity_core (ghost_of_identity _ i)), (identity_core (ghost_of_identity _ i')).
-    rewrite !ghost_core; auto.
+    rewrite (identity_id_core _ i), (identity_id_core _ i').
+    rewrite !id_core_ghost; reflexivity.
 Qed.
 
 Lemma same_except_cur_jm_ ge tp m phi i cnti compat :
@@ -215,24 +208,7 @@ Proof.
   rewrite AMap_find_map_option_map.
   destruct (AMap.find loc lset)
     as [[unlockedphi | ] | ] eqn:Efind;
-    simpl option_map; cbv iota beta; swap 1 3.
-  - (* rewrite <-isLKCT_rewrite. *)
-    (* rewrite <-isLKCT_rewrite in LC. *)
-    contradict LC.
-    destruct LC as [sh [rsh [z [pp ?]]]]. rewrite H in *.
-    destruct RD as [NN [R|[R|[[P [v R]]|R]]]].
-    + destruct (phi @ loc); inv R; hnf; eauto.
-    + destruct R as (sh'' & wsh & v & v' & E & E'). (* split; *) congruence.
-    + (* split; *) congruence.
-    + destruct R as (v & PP  & ? & ?). (* split; *) congruence.
-
-  - assert (fst loc < b)%positive.
-    { apply BOUND.
-      rewrite Efind.
-      constructor. }
-    destruct LC as (dry & align & bound (* & sh *) & R & lk); split; auto.
-    eapply resource_decay_lkat in lk; eauto.
-
+    simpl option_map; cbv iota beta.
   - assert (fst loc < b)%positive.
     { apply BOUND.
       rewrite Efind.
@@ -245,10 +221,10 @@ Proof.
       split.
       * rewrite level_age_by.
         rewrite level_age_to.
-        -- omega.
+        -- lia.
         -- apply SAMELEV in Efind.
            eauto with *.
-      * destruct sat as [sat | ?]; [ | omega ].
+      * destruct sat as [sat | ?]; [ | lia ].
         unfold age_to.
         rewrite age_by_age_by.
         rewrite plus_comm.
@@ -256,6 +232,23 @@ Proof.
         apply age_by_ind.
         { destruct R as [p h]. apply h. }
         apply sat.
+
+  - assert (fst loc < b)%positive.
+    { apply BOUND.
+      rewrite Efind.
+      constructor. }
+    destruct LC as (dry & align & bound (* & sh *) & R & lk); split; auto.
+    eapply resource_decay_lkat in lk; eauto.
+
+  - (* rewrite <-isLKCT_rewrite. *)
+    (* rewrite <-isLKCT_rewrite in LC. *)
+    contradict LC.
+    destruct LC as [sh [rsh [z [pp ?]]]]. rewrite H in *.
+    destruct RD as [NN [R|[R|[[P [v R]]|R]]]].
+    + destruct (phi @ loc); inv R; hnf; eauto.
+    + destruct R as (sh'' & wsh & v & v' & E & E'). (* split; *) congruence.
+    + (* split; *) congruence.
+    + destruct R as (v & PP  & ? & ?). (* split; *) congruence.
 Qed.
 
 Lemma personal_mem_rewrite m phi phi' pr pr' :
@@ -267,10 +260,10 @@ Qed.
 
 Lemma invariant_thread_step
  (mem_cohere_step
-     : forall (c c' : corestate) (jm jm' : juicy_mem) (Phi X : rmap) (ge : genv),
+     : forall (c c' : CC_core) (jm jm' : juicy_mem) (Phi X : rmap) (ge : genv),
        mem_cohere' (m_dry jm) Phi ->
        join (m_phi jm) X Phi ->
-       @corestep corestate juicy_mem (@juicy_core_sem corestate (cl_core_sem ge)) c jm c' jm' ->
+       @corestep _ juicy_mem (@juicy_core_sem _ (cl_core_sem ge)) c jm c' jm' ->
        exists Phi' : rmap,
          join (m_phi jm') (@age_to (@level rmap ag_rmap (m_phi jm')) rmap ag_rmap X) Phi' /\
          mem_cohere' (m_dry jm') Phi')
@@ -286,23 +279,24 @@ Lemma invariant_thread_step
   (Stable' : ext_spec_stable juicy_mem_equiv Jspec)
   (envcoh : env_coherence Jspec ge Gamma Phi)
   (extcompat : joins (ghost_of Phi) (Some (ghost_PCM.ext_ref tt, NoneP) :: nil))
-  (mwellformed: @mem_wellformed ge m)
+(*  (mwellformed: @mem_wellformed ge m) *)
   (compat : mem_compatible_with tp m Phi)
   (En : level Phi = S n)
   (lock_bound : lockSet_block_bound (lset tp) (Mem.nextblock m))
   (sparse : lock_sparsity (lset tp))
   (lock_coh : lock_coherence' tp Phi m compat)
-  (safety : threads_safety Jspec m tp Phi compat (S n))
+  (safety : threads_safety Jspec m tp Phi compat)
   (wellformed : threads_wellformed tp)
   (unique : unique_Krun tp (i :: sch))
+  (invcompat : inv_compatible tp)
   (cnti : containsThread tp i)
   (stepi : corestep (juicy_core_sem (cl_core_sem ge)) ci (jm_ cnti compat) ci' jmi')
-  (safei' : forall ora, jm_bupd ora (jsafeN Jspec ge n ora ci') jmi')
+  (safei' : forall ora, jm_fupd ora Ensembles.Full_set Ensembles.Full_set (jsafeN Jspec ge ora ci') jmi')
   (Eci : getThreadC i tp cnti = Krun ci)
   (tp' := age_tp_to (level jmi') tp)
   (tp'' := updThread i tp' (cnt_age' cnti) (Krun ci') (m_phi jmi') : jstate ge)
   (cm' := (m_dry jmi', (tr, i :: sch, tp''))) :
-  state_bupd (state_invariant Jspec Gamma n) cm'.
+  state_fupd (state_invariant Jspec Gamma n) cm'.
 Proof.
   (** * Two steps : [x] -> [x'] -> [x'']
           1. we age [x] to get [x'], the level decreasing
@@ -313,7 +307,7 @@ Proof.
   pose proof J as J_; move J_ before J.
   rewrite join_all_joinlist in J_.
   pose proof J_ as J__.
-  rewrite maps_getthread with (cnti0 := cnti) in J__.
+  rewrite maps_getthread with (cnti := cnti) in J__.
   destruct J__ as (ext & Hext & Jext).
   assert (Eni : level (jm_ cnti compat) = S n). {
     rewrite <-En, level_juice_level_phi.
@@ -333,10 +327,6 @@ Proof.
     destruct stepi as [_ [_ [<- _]]].
     apply Eni.
   }
-  pose proof eq_refl tp' as Etp'.
-  unfold tp' at 2 in Etp'.
-  move Etp' before tp'.
-  rewrite level_juice_level_phi, Eni'' in Etp'.
   assert (En'' : level Phi'' = n). {
     rewrite <-Eni''.
     symmetry; apply rmap_join_sub_eq_level.
@@ -348,7 +338,7 @@ Proof.
   (** * First, age the whole machine *)
   pose proof J_ as J'.
   unshelve eapply @joinlist_age_to with (n := n) in J'.
-  (* auto with *. (* TODO please report -- but hard to reproduce *) *)
+  auto with *.
   all: hnf.
   all: [> refine ag_rmap |  | refine Age_rmap | refine Perm_rmap ].
 
@@ -360,12 +350,7 @@ Proof.
   pose proof J'' as J''_. destruct J''_ as (ext'' & Hext'' & Jext'').
   rewrite Eni'' in *.
   assert (Eext'' : ext'' = age_to n ext). {
-    destruct (coqlib3.nil_or_non_nil (map (age_to n) (all_but i (maps tp)))) as [N|N]; swap 1 2.
-    - (* Uniqueness of [ext] : when the rest is not empty *)
-      eapply @joinlist_age_to with (n := n) in Hext.
-      all: [> | now apply Age_rmap | now apply Perm_rmap ].
-      unshelve eapply (joinlist_inj _ _ _ _ Hext'' Hext).
-      apply N.
+    destruct (coqlib3.nil_or_non_nil (map (age_to n) (all_but i (maps tp)))) as [N|N].
     - (* when the list is empty, we know that ext (and hence [age_to
         .. ext]) and ext' are identity, and they join with something
         that have the same PURE *)
@@ -380,6 +365,11 @@ Proof.
         revert N.
         destruct (maps tp) as [|? [|]]; destruct i; simpl; congruence || auto.
       + change (joinlist nil ext''). apply Hext''.
+    - (* Uniqueness of [ext] : when the rest is not empty *)
+      eapply @joinlist_age_to with (n := n) in Hext.
+      all: [> | now apply Age_rmap | now apply Perm_rmap ].
+      unshelve eapply (joinlist_inj _ _ _ _ Hext'' Hext).
+      apply N.
   }
   subst ext''.
 
@@ -603,16 +593,20 @@ Proof.
           changed.
    *)
 
+  (* We somehow need to track the fact that the thread already owns all the resources it would
+     need to take from invariants in safei'. *)
   apply state_inv_upd1 with (PHI := Phi'') (mcompat := compat'').
   - (* level *)
     assumption.
 
   - (* env_coherence *)
-    eapply env_coherence_resource_decay with _ Phi; eauto. setoid_rewrite En''; omega.
-  - destruct stepi as [? _].
+    eapply env_coherence_resource_decay with _ Phi; eauto. setoid_rewrite En''; lia.
+(*  - destruct stepi as [? _].
      forget (m_dry jmi') as m'. 
     clear - mwellformed H. simpl in H.
-     admit.   (* Santiago ... use memsem *)
+    apply (corestep_mem (CLC_memsem ge)) in H.
+    eapply mem_wellformed_step; eauto.
+    apply mem_wellformed_restr; auto. *)
   - rewrite G.
     destruct extcompat as [? Je]; eapply ghost_fmap_join in Je; eexists; eauto.
 
@@ -665,39 +659,30 @@ Proof.
       pose proof restrPermMap_contents W' as CW'.
       Transparent Mem.load.
       unfold Mem.load in *.
-      destruct (Mem.valid_access_dec (restrPermMap W) Mint32 b ofs Readable) as [r|n]; swap 1 2.
-
+      assert (Mem.valid_access (restrPermMap W) Mptr b ofs Readable).
       { (* can't be not readable *)
-        destruct n.
         apply Mem.valid_access_implies with Writable.
         - eapply lset_valid_access; eauto.
         - constructor.
       }
-
       rewrite if_true by auto.
-      destruct (Mem.valid_access_dec (restrPermMap W') Mint32 b ofs Readable) as [r'|n']; swap 1 2.
+      assert (Mem.valid_access (restrPermMap W') Mptr b ofs Readable).
       { (* can't be not readable *)
-        destruct n'.
         split.
         - apply Mem.range_perm_implies with Writable.
           + intros loc range.
             eapply lset_range_perm with (ofs := ofs); eauto.
-            (* if LKSIZE>4:
-              2:unfold size_chunk in *.
-              2:unfold LKSIZE in *.
-              2:omega.*)
             unfold tp''; simpl.
             unfold tp'; rewrite lset_age_tp_to.
             rewrite AMap_find_map_option_map.
             destruct (AMap.find (elt:=option rmap) (b, ofs) (lset tp)).
             * discriminate.
             * tauto.
-            * lkomega.
+            * unfold LKSIZE. lkomega.
           + constructor.
         - (* basic alignment *)
           eapply lock_coherence_align; eauto.
       }
-
       rewrite if_true by auto.
       f_equal.
       f_equal.
@@ -724,11 +709,7 @@ Proof.
         cut (Mem.perm_order'' (Some Nonempty) (perm_of_res (getThreadR _ _ cnti @ (b, ofs0)))).
         { destruct (perm_of_res (getThreadR _ _ cnti @ (b, ofs0))); intros A B.
           all: inversion A; subst; inversion B; subst. }
-        apply po_trans with (perm_of_res (Phi @ (b, ofs0))); swap 1 2.
-        + eapply po_join_sub.
-          apply resource_at_join_sub.
-          eapply compatible_threadRes_sub.
-          apply compat.
+        apply po_trans with (perm_of_res (Phi @ (b, ofs0))).
         + clear -lock_coh islock interval.
           (* todo make lemma out of this *)
           specialize (lock_coh (b, ofs)).
@@ -741,10 +722,14 @@ Proof.
           destruct lk as (R & lk).
           specialize (lk (b, ofs0)).
           simpl in lk.
-          assert (adr_range (b, ofs) 4%Z (b, ofs0))
+          assert (adr_range (b, ofs) (Z.of_nat (size_chunk_nat Mptr)) (b, ofs0))
             by apply interval_adr_range, interval.
-          spec lk. split; auto. clear - H; unfold LKSIZE; destruct H; rewrite size_chunk_Mptr; simple_if_tac; omega.
+          spec lk. split; auto. clear - H; destruct H. unfold LKSIZE; lkomega.
           destruct lk as (? & ? & ->). simpl. constructor.
+        + eapply po_join_sub.
+          apply resource_at_join_sub.
+          eapply compatible_threadRes_sub.
+          apply compat.
     }
     (* end of proof of: lock values couldn't change during a corestep *)
 
@@ -816,22 +801,14 @@ Proof.
         REWR.
         REWR.
         apply jsafe_phi_age_to; auto.
-        rewrite level_juice_level_phi.
-        omega.
-        apply jsafe_phi_downward.
-        assumption.
       * unfold tp'', tp'.
         REWR.
         REWR.
         intros c' Ec'; specialize (safej c' Ec').
-        apply jsafe_phi_bupd_age_to; auto.
-        rewrite level_juice_level_phi.
-        omega.
-        apply jsafe_phi_bupd_downward.
-        assumption.
+        apply jsafe_phi_fupd_age_to; auto.
       * destruct safej as (Harg & q_new & Einit & safej); split.
         { destruct stepi as (stepi & _).
-          apply (corestep_mem (msem (ClightSemanticsForMachines.CLN_evsem ge))), mem_step_nextblock'
+          apply (corestep_mem (msem (Clight_evsem.CLC_evsem ge))), mem_step_nextblock'
             in stepi; simpl in stepi.
           eapply val_inject_incr, Harg.
           apply flat_inj_incr; auto. }
@@ -840,10 +817,6 @@ Proof.
         REWR.
         REWR.
         apply jsafe_phi_age_to; auto.
-        rewrite level_juice_level_phi.
-        omega.
-        apply jsafe_phi_downward.
-        assumption.
 
   - (* wellformedness *)
     intros j cntj.
@@ -868,4 +841,4 @@ Proof.
       unfold tp'',  tp'.
       unshelve erewrite gsoThreadCode; auto.
       unshelve erewrite <-gtc_age; auto.
-Admitted.
+Qed.
diff --git a/concurrency/juicy/semax_progress.v b/concurrency/juicy/semax_progress.v
index 153fce7e31..60c3e2df84 100644
--- a/concurrency/juicy/semax_progress.v
+++ b/concurrency/juicy/semax_progress.v
@@ -10,28 +10,21 @@ Require Import compcert.common.Values.
 
 Require Import VST.msl.Coqlib2.
 Require Import VST.msl.eq_dec.
-Require Import VST.msl.seplog.
-Require Import VST.msl.age_to.
-Require Import VST.veric.aging_lemmas.
-Require Import VST.veric.initial_world.
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.juicy_mem_lemmas.
 Require Import VST.veric.semax_prog.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.Clight_new.
-Require Import VST.veric.Clightnew_coop.
+Require Import VST.veric.Clight_core.
+Require Import VST.veric.Clightcore_coop.
 Require Import VST.veric.semax.
-Require Import VST.veric.semax_ext.
-Require Import VST.veric.juicy_extspec.
 Require Import VST.veric.initial_world.
 Require Import VST.veric.juicy_extspec.
 Require Import VST.veric.tycontext.
 Require Import VST.veric.semax_ext.
 Require Import VST.veric.res_predicates.
 Require Import VST.veric.shares.
-Require Import VST.veric.age_to_resource_at.
 Require Import VST.floyd.coqlib3.
 Require Import VST.floyd.field_at.
+Require Import VST.sepcomp.extspec.
 Require Import VST.sepcomp.step_lemmas.
 Require Import VST.sepcomp.event_semantics.
 Require Import VST.concurrency.juicy.semax_conc_pred.
@@ -45,9 +38,6 @@ Require Import VST.concurrency.juicy.JuicyMachineModule.
 Require Import VST.concurrency.juicy.sync_preds_defs.
 Require Import VST.concurrency.juicy.sync_preds.
 Require Import VST.concurrency.juicy.join_lemmas.
-(*Require Import VST.concurrency.cl_step_lemmas.
-Require Import VST.concurrency.resource_decay_lemmas.
-Require Import VST.concurrency.resource_decay_join.*)
 Require Import VST.concurrency.juicy.semax_invariant.
 Require Import VST.concurrency.juicy.semax_simlemmas.
 Require Import VST.concurrency.juicy.rmap_locking.
@@ -63,8 +53,8 @@ Lemma load_at_phi_restrict ge i (tp : jstate ge) (cnti : containsThread tp i) m
   (LKspec LKSIZE R sh (b, ofs)) phi0 ->
   (* typically given by lock_coherence: *)
   AMap.find (elt:=option rmap) (b, ofs) (lset tp) = Some o ->
-  load Mint32 (restrPermMap (mem_compatible_locks_ltwritable compat)) b ofs = Some v ->
-  load Mint32 (@juicyRestrict_locks _ m (mem_compat_thread_max_cohere compat cnti)) b ofs = Some v.
+  load Mptr (restrPermMap (mem_compatible_locks_ltwritable compat)) b ofs = Some v ->
+  load Mptr (@juicyRestrict_locks _ m (mem_compat_thread_max_cohere compat cnti)) b ofs = Some v.
 Proof.
   intros (phi1, j) lk found.
   unfold juicyRestrict_locks in *.
@@ -106,7 +96,7 @@ Proof.
   match goal with |- ?P = ?Q => cut (P /\ Q) end.
   { intros (?, ?). apply prop_ext; split; auto. }
   split.
-  - setoid_rewrite A2PMap_found; eauto; try lkomega.
+  - setoid_rewrite A2PMap_found; eauto; try (unfold LKSIZE; lkomega).
     constructor.
   - unfold juice2Perm_locks in *.
     unfold mapmap in *.
@@ -118,10 +108,10 @@ Proof.
     rewrite PTree.gmap1.
     unfold option_map.
     simpl.
-    destruct ((snd (mem_access m)) ! b) eqn:E. 2:tauto. clear notnone.
+    destruct ((snd (mem_access m)) ! b) eqn:E; [|tauto]. clear notnone.
     unfold perm_of_res_lock in *.
-    destruct lk as [lk Hg]; specialize (lk (b, ofs')). simpl in lk.
-    if_tac [r'|nr] in lk. 2:now destruct nr; split; auto; lkomega.
+    specialize (lk (b, ofs')). simpl in lk.
+    if_tac [r'|nr] in lk; [|now destruct nr; split; auto; unfold LKSIZE; lkomega].
     apply resource_at_join with (loc := (b, ofs')) in j.
     + destruct lk as (p & E0). rewrite E0 in j. inv j.
       * unfold block in *.
@@ -143,21 +133,20 @@ Lemma valid_access_restrPermMap ge m i tp Phi b ofs ophi
   (lock_coh : lock_coherence'(ge := ge) tp Phi m compat)
   (cnti : containsThread tp i)
   (Efind : AMap.find (elt:=option rmap) (b, Ptrofs.unsigned ofs) (lset tp) = Some ophi)
-  (align : (4 | snd (b, Ptrofs.unsigned ofs)))
+  (align : (size_chunk Mptr | snd (b, Ptrofs.unsigned ofs)))
   (Hlt' : permMapLt
            (setPermBlock (Some Writable) b (Ptrofs.intval ofs) (juice2Perm_locks (getThreadR cnti) m) LKSIZE_nat)
            (getMaxPerm m)) :
-  valid_access (restrPermMap Hlt') Mint32 b (Ptrofs.intval ofs) Writable.
+  valid_access (restrPermMap Hlt') Mptr b (Ptrofs.intval ofs) Writable.
 Proof.
-  split. 2:exact align.
+  split; [|exact align].
   intros ofs' r.
   unfold perm in *.
   pose proof restrPermMap_Cur as RR.
   unfold permission_at in *.
   rewrite RR.
-  simpl.
   pose proof compat.(loc_writable) as LW.
-  specialize (LW b (Ptrofs.unsigned ofs)). cleanup. rewrite Efind in LW. autospec LW. specialize (LW ofs').
+  specialize (LW b (Ptrofs.unsigned ofs)). setoid_rewrite Efind in LW. autospec LW. specialize (LW ofs').
   rewrite setPermBlock_lookup.
   repeat (if_tac; [constructor |]).
   exfalso.
@@ -178,16 +167,15 @@ Lemma permMapLt_local_locks ge m i (tp : jstate ge) Phi b ofs ophi
                   (juice2Perm_locks (getThreadR cnti) m) LKSIZE_nat)
     (getMaxPerm m).
 Proof.
-  simpl.
   intros b' ofs'.
   assert (RR: (getMaxPerm m) !! b' ofs' = (mem_access m) !! b' ofs' Max)
     by (unfold getMaxPerm in *; rewrite PMap.gmap; reflexivity).
 
   pose proof compat.(loc_writable) as LW.
-  specialize (LW b (Ptrofs.unsigned ofs)). cleanup. rewrite Efind in LW. autospec LW. specialize (LW ofs').
+  specialize (LW b (Ptrofs.unsigned ofs)). setoid_rewrite Efind in LW. autospec LW. specialize (LW ofs').
   rewrite RR.
   rewrite setPermBlock_lookup; if_tac.
-  { unfold LKSIZE_nat in H; rewrite Z2Nat.id in H by (pose proof LKSIZE_pos; omega).
+  { unfold LKSIZE_nat in H; rewrite Z2Nat.id in H by lkomega.
     destruct H; subst; auto. }
   rewrite <-RR.
   apply juice2Perm_locks_cohere, mem_compat_thread_max_cohere.
@@ -224,7 +212,7 @@ Section Progress.
       state_step(ge := ge) state state'.
   Proof.
     intros not_spawn I.
-    inversion I as [m tr sch tp Phi En envcoh mwellformed compat extcompat sparse lock_coh safety wellformed unique E]. rewrite <-E in *.
+    inversion I as [m tr sch tp Phi En envcoh (*mwellformed*) compat extcompat sparse lock_coh safety wellformed unique invcompat E]. rewrite <-E in *.
     destruct sch as [ | i sch ].
 
     (* empty schedule: we loop in the same state *)
@@ -232,22 +220,7 @@ Section Progress.
       exists state. subst. constructor.
     }
 
-    destruct (ssrnat.leq (S i) tp.(num_threads).(pos.n)) eqn:Ei; swap 1 2.
-
-    (* bad schedule *)
-    {
-      eexists.
-      (* split. *)
-      (* -  *)constructor.
-        apply JuicyMachine.schedfail with i.
-        + reflexivity.
-        + simpl.
-          unfold OrdinalPool.containsThread.
-          now setoid_rewrite Ei; auto.
-        + constructor.
-        + eexists; eauto.
-        + reflexivity.
-    }
+    destruct (ssrnat.leq (S i) tp.(num_threads).(pos.n)) eqn:Ei.
 
     (* the schedule selected one thread *)
     assert (cnti : ThreadPool.containsThread tp i) by apply Ei.
@@ -265,39 +238,52 @@ Section Progress.
       (* pose (phii := m_phi jmi). *)
       (* pose (mi := m_dry jmi). *)
 
-      destruct ci as [ve te k | ef args lid ve te k] eqn:Heqc.
+      destruct (j_at_external (cl_core_sem ge) ci (jm_ cnti compat)) eqn: Hext.
+
+      (* thread[i] is running and about to call an external: Krun (at_ex c) -> Kblocked c *)
+      {
+        eexists.
+        (* taking the step *)
+        constructor.
+        eapply JuicyMachine.suspend_step.
+        + reflexivity.
+        + reflexivity.
+        + unshelve econstructor; try reflexivity; try eassumption.
+          eexists; eauto.
+      } (* end of Krun (at_ex c) -> Kblocked c *)
+
+      destruct (cl_halted ci) eqn: Hhalt.
+
+      (* thread[i] is halted *)
+      { eexists; constructor.
+        eapply halted_step with (i := Int.zero). (* Why doesn't cl_halted check the value? *)
+        + reflexivity.
+        + econstructor; eauto; simpl.
+          rewrite Hhalt; discriminate.
+        + reflexivity. }
 
       (* thread[i] is running and some internal step *)
       {
         (* get the next step of this particular thread (with safety for all oracles) *)
         assert (next: exists ci' jmi',
                    corestep (juicy_core_sem (cl_core_sem ge)) ci jmi ci' jmi'
-                   /\ forall ora, jm_bupd ora (jsafeN Jspec' ge n ora ci') jmi').
-        {
-          specialize (safety i cnti).
+                   (*/\ forall ora, jm_bupd ora (jsafeN Jspec' ge ora ci') jmi'*)).
+        { specialize (safety i cnti).
           pose proof (safety tt) as safei.
           rewrite Eci in *.
-          inversion safei as [ | ? ? ? ? c' m' step safe H H2 H3 H4 | | ]; subst.
-          2: now match goal with H : j_at_external _ _ _ = _ |- _ => inversion H end.
-          2: now match goal with H : halted _ _ _ |- _ => inversion H end.
-          exists c', m'. split; [ apply step | ].
-          revert step safety safe; clear.
-          generalize (jm_ cnti compat).
-          generalize (State ve te k).
-          unfold jsafeN.
-          intros c j step safety safe ora.
-          eapply semax_lemmas.jsafe_corestep_forward.
-          - apply step.
-          - apply safety.
+          inversion safei as [ | ? ? ? c' m' step | | ]; subst; try congruence.
+          { rewrite level_jm_ in H; setoid_rewrite H in En; discriminate. }
+          exists c', m'. apply step.
         }
 
-        destruct next as (ci' & jmi' & stepi & safei').
+        destruct next as (ci' & jmi' & stepi (*& safei'*)).
         pose (tp' := age_tp_to (level jmi') tp).
         pose (tp'' := @updThread _ _ _ i tp' (cnt_age' cnti) (Krun ci') (m_phi jmi')).
         pose (cm' := (m_dry jmi', (tr, i :: sch, tp''))).
         exists cm'.
         apply state_step_c; [].
-        rewrite <- (seq.cats0 tr) at 2.
+        match goal with |-@machine_step ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n =>
+          replace _ with (@machine_step a b c d e f g h i j k (seq.cat l nil) m n) by (rewrite seq.cats0; reflexivity) end.
         apply @JuicyMachine.thread_step with (DilMem := HybridCoarseMachine.DilMem)
         (tid := i)
           (ev := nil)
@@ -317,80 +303,44 @@ Section Progress.
             reflexivity.
         + reflexivity.
         + reflexivity.
-      }
-      (* end of internal step *)
-
-      (* thread[i] is running and about to call an external: Krun (at_ex c) -> Kblocked c *)
-      {
-        eexists.
-        (* taking the step *)
-        constructor.
-        eapply JuicyMachine.suspend_step.
-        + reflexivity.
-        + reflexivity.
-        + econstructor.
-          * eassumption.
-          * instantiate (2 := mem_compatible_forget compat); reflexivity.
-          * reflexivity.
-          * constructor.
-          * reflexivity.
-      } (* end of Krun (at_ex c) -> Kblocked c *)
+      } (* end of internal step *)
     } (* end of Krun *)
 
     (* thread[i] is in Kblocked *)
     {
       (* goes to Kresume ci' according to the rules of syncStep  *)
 
-      destruct ci as [ve te k | ef args lid ve te k] eqn:Heqc.
-
-      (* internal step: impossible, because in state Kblocked *)
-      {
-        exfalso.
-        pose proof (wellformed i cnti) as W.
-        rewrite Eci in W.
-        apply W; auto.
-      }
-      (* back to external step *)
-
-      (* paragraph below: ef has to be an EF_external *)
-      assert (Hef : match ef with EF_external _ _ => Logic.True | _ => False end).
-      {
-        pose proof (safety i cnti tt) as safe_i.
-        rewrite Eci in safe_i.
-        fixsafe safe_i.
-        inversion safe_i; subst; [ now inversion H0; inversion H | | now inversion H ].
-        inversion H0; subst; [].
-        match goal with x : ext_spec_type _ _  |- _ => clear -x end.
-        now destruct e eqn:Ee; [ apply I | .. ];
-          simpl in x;
-          repeat match goal with
-                   _ : context [ oi_eq_dec ?x ?y ] |- _ =>
-                   destruct (oi_eq_dec x y); try discriminate; try tauto
-                 end.
-      }
-      assert (Ex : exists name sig, ef = EF_external name sig) by (destruct ef; eauto; tauto).
-      destruct Ex as (name & sg & ->); clear Hef.
+      pose proof (wellformed i cnti) as W.
+      rewrite Eci in W.
+      destruct ci as [ | f ? k | ]; try contradiction; simpl in W.
+      destruct f as [| ef ?? cc]; try contradiction.
+      destruct (ef_inline ef) eqn: Hinline; [contradiction | clear W].
 
       (* paragraph below: ef has to be an EF_external with one of those 5 names *)
-      assert (which_primitive :
-                Some (ext_link "acquire", LOCK_SIG) = (ef_id_sig ext_link (EF_external name sg)) \/
+      assert (exists name sg, ef = EF_external name sg /\
+                (Some (ext_link "acquire", LOCK_SIG) = (ef_id_sig ext_link (EF_external name sg)) \/
                 Some (ext_link "release", UNLOCK_SIG) = (ef_id_sig ext_link (EF_external name sg)) \/
                 Some (ext_link "makelock", ef_sig MKLOCK) = (ef_id_sig ext_link (EF_external name sg)) \/
                 Some (ext_link "freelock", ef_sig FREE_LOCK) = (ef_id_sig ext_link (EF_external name sg)) \/
-                Some (ext_link "spawn", CREATE_SIG) = (ef_id_sig ext_link (EF_external name sg))).
+                Some (ext_link "spawn", CREATE_SIG) = (ef_id_sig ext_link (EF_external name sg)))) as (name & sg & -> & which_primitive).
       {
         pose proof (safety i cnti tt) as safe_i.
         rewrite Eci in safe_i.
         fixsafe safe_i.
-        inversion safe_i; subst; [ now inversion H0; inversion H | | now inversion H ].
-        inversion H0; subst; [].
-        match goal with H : ext_spec_type _ _  |- _ => clear -H end.
-        simpl in *.
-        repeat match goal with
-                 _ : context [ oi_eq_dec ?x ?y ] |- _ =>
-                 destruct (oi_eq_dec x y); try injection e; auto
-               end.
-        tauto.
+        inversion safe_i; subst.
+        * rewrite level_jm_ in H; setoid_rewrite H in En; discriminate.
+        * inv H. inv H1.
+          rewrite Hinline in *; discriminate.
+        * simpl in H.
+          rewrite Hinline in H; inv H.
+          match goal with x : ext_spec_type _ _  |- _ => clear -x; simpl in x end.
+          unfold ef_id_sig in x.
+          repeat match goal with
+                   _ : context [ oi_eq_dec ?x ?y ] |- _ =>
+                   destruct (oi_eq_dec x y); try (destruct e; inv e0; eexists; eexists; split; [reflexivity | rewrite H0; simpl; auto])
+                 end.
+          contradiction.
+        * contradiction.
       }
 
       (* Before going any further, one needs to provide the first
@@ -415,8 +365,9 @@ Section Progress.
         rewrite Eci in safei.
         fixsafe safei.
         inversion safei
-          as [ | ?????? bad | n0 z c m0 e args0 x at_ex Pre SafePost | ????? bad ];
-          [ now inversion bad; inversion H4 | subst | now inversion bad ].
+          as [ | ????? bad | nz c m0 e args0 x at_ex Pre SafePost | ???? bad ]; last contradiction.
+        { rewrite level_jm_ in H; setoid_rewrite H in En; discriminate. }
+        { inv bad. inv H3. rewrite Hinline in *; discriminate. }
         subst.
         simpl in at_ex. injection at_ex as <- <-.
         hnf in x.
@@ -435,9 +386,9 @@ Section Progress.
         intros Post.
 
         (* relate lset to val *)
-        destruct Precond as [PREA [[[PREB _] _] PREC]].
+        destruct Precond as [PREA [PREB [_ PREC]]].
         hnf in PREB.
-        unfold canon.SEPx in PREC.
+        unfold SeparationLogic.argsassert2assert, canon.SEPx in PREC.
         simpl in PREC.
         rewrite seplog.sepcon_emp in PREC.
         pose proof PREC as islock.
@@ -475,114 +426,12 @@ Section Progress.
              split the current rmap.
          *)
 
-
         (* next step depends on status of lock: *)
         pose proof (lock_coh (b, Ptrofs.unsigned ofs)) as lock_coh'.
         destruct (AMap.find (elt:=option rmap) (b, Ptrofs.unsigned ofs) (lset tp))
-          as [[unlockedphi|]|] eqn:Efind;
-          swap 1 3.
+          as [[unlockedphi|]|] eqn:Efind.
         (* inversion lock_coh' as [wetv dryv notlock H H1 H2 | R0 wetv isl' Elockset Ewet Edry | R0 phi wetv isl' SAT_R_Phi Elockset Ewet Edry]. *)
 
-        - (* None: that cannot be: there is no lock at that address *)
-          exfalso.
-          destruct isl as [x [? [? EPhi]]].
-          rewrite EPhi in lock_coh'.
-          apply lock_coh'. hnf. eauto.
-
-        - (* Some None: lock is locked, so [acquire] fails. *)
-          destruct lock_coh' as [LOAD ((* sh' & *) align & bound & R' & lk)].
-          destruct isl as [sh [psh [z Ewetv]]].
-          rewrite Ewetv in *.
-
-          (* rewrite Eat in Ewetv. *)
-          specialize (lk (b, Ptrofs.unsigned ofs)).
-          spec lk. pose proof LKSIZE_pos; split; auto; omega.
-
-          unfold lock_inv in PREC.
-          destruct PREC as (b0 & ofs0 & EQ & LKSPEC & HG).
-          injection EQ as <- <-.
-          exists (m, (seq.cat tr (Events.external i (Events.failacq (b, Ptrofs.intval ofs)) :: nil), sch, tp))(* ; split *).
-          + apply state_step_c.
-            apply JuicyMachine.sync_step with
-            (Htid := cnti)
-              (Hcmpt := mem_compatible_forget compat);
-              [ reflexivity (* schedPeek *)
-              | reflexivity (* schedSkip *)
-              | ].
-            (* factoring proofs out before the inversion/eapply *)
-            pose proof LKSPEC as LKSPEC'.
-            specialize (LKSPEC (b, Ptrofs.unsigned ofs)).
-            simpl in LKSPEC.
-            if_tac [r|nr] in LKSPEC; swap 1 2.
-            { destruct nr.
-              simpl.
-              split. reflexivity. pose proof LKSIZE_pos; omega. }
-            destruct LKSPEC as (p & E).
-            pose proof (resource_at_join _ _ _ (b, Ptrofs.unsigned ofs) Join) as J.
-            rewrite E in J.
-
-            assert (Ename : name = "acquire"). {
-              simpl in *.
-              injection H_acquire as Ee.
-              apply ext_link_inj in Ee; auto.
-            }
-
-            assert (Ez : z = LKSIZE). {
-              simpl in lk.
-              destruct lk as (psh' & rsh & EPhi).
-              rewrite EPhi in Ewetv.
-              injection Ewetv as _ <-.
-              reflexivity.
-            }
-
-            assert (Esg : sg = LOCK_SIG) by (unfold ef_id_sig in *; congruence).
-
-            assert (Eargs : args = Vptr b ofs :: nil). {
-              subst sg.
-              eapply shape_of_args; eauto.
-            }
-
-            assert (Ecall: EF_external name sg = LOCK) by congruence.
-
-            assert (Eae : at_external (@semSem (ClightSemanticsForMachines.Clight_newSem ge)) (ExtCall (EF_external name sg) args lid ve te k) m =
-                    Some (LOCK, Vptr b ofs :: nil)). {
-              simpl.
-              repeat f_equal; congruence.
-            }
-
-            unfold load_at in LOAD.
-            eapply load_at_phi_restrict with (phi0 := phi0) (cnti := cnti) in LOAD.
-            all: [ > | exists phi1; eassumption | split; eassumption | eassumption ].
-
-            inversion J; subst.
-
-            * eapply step_acqfail with (Hcompatible := mem_compatible_forget compat)
-                                       (R0 := approx (level phi0) Rx).
-              all: try solve [ constructor | eassumption | reflexivity ].
-                (* [ > idtac ]. *)
-              simpl.
-              unfold Ptrofs.unsigned in *.
-              intros. instantiate (1:=shx). hnf. intros.
-              apply (resource_at_join _ _ _ (b, Ptrofs.intval ofs+i0)) in Join.
-              specialize (LKSPEC' (b, Ptrofs.intval ofs+i0)).
-              rewrite jam_true in LKSPEC' by (split; auto; omega).
-              destruct LKSPEC' as [rsh8 LKSPEC']. simpl in LKSPEC'. rewrite LKSPEC' in Join.
-              inv Join; replace (Ptrofs.intval ofs + i0 - Ptrofs.intval ofs) with i0 in * by omega.
-              exists sh4, rsh2; split; auto. eexists; eassumption.
-              exists sh4, rsh4; split; auto. eexists; eassumption.              
-            * eapply step_acqfail with (Hcompatible := mem_compatible_forget compat)
-                                       (R0 := approx (level phi0) Rx).
-              all: try solve [ constructor | eassumption | reflexivity ].
-              simpl.
-              unfold Ptrofs.unsigned in *.
-              instantiate (1:=shx). hnf. intros.
-              apply (resource_at_join _ _ _ (b, Ptrofs.intval ofs+i0)) in Join.
-              specialize (LKSPEC' (b, Ptrofs.intval ofs+i0)).
-              rewrite jam_true in LKSPEC' by (split; auto; omega).
-              destruct LKSPEC' as [rsh8 LKSPEC']. simpl in LKSPEC'. rewrite LKSPEC' in Join.
-              inv Join; replace (Ptrofs.intval ofs + i0 - Ptrofs.intval ofs) with i0 in * by omega.
-              exists sh4, rsh4; split; auto. eexists; eassumption.
-              exists sh4, rsh5; split; auto. eexists; eassumption.    
         - (* acquire succeeds *)
           destruct isl as [sh [psh [z Ewetv]]].
           destruct lock_coh' as [LOAD ((* sh' &  *)align & bound & R' & lk & sat)].
@@ -593,8 +442,8 @@ Section Progress.
           injection EQ as <- <-.
 
           specialize (lk (b, Ptrofs.unsigned ofs)).
-          spec lk. hnf. pose proof LKSIZE_pos; split; auto; omega.
-          destruct sat as [sat | sat]; [ | omega ].
+          spec lk. hnf. pose proof LKSIZE_pos; split; auto; lia.
+          destruct sat as [sat | sat]; [ | lia ].
 
           assert (Ename : name = "acquire"). {
             simpl in *.
@@ -610,16 +459,13 @@ Section Progress.
             reflexivity.
           }
 
-          assert (Esg : sg = LOCK_SIG) by (unfold ef_id_sig in *; congruence).
+          assert (Eargs : l = Vptr b ofs :: nil) by auto.
 
-          assert (Eargs : args = Vptr b ofs :: nil). {
-            subst sg.
-            eapply shape_of_args; eauto.
-          }
+          assert (Esg : sg = LOCK_SIG) by (unfold ef_id_sig in *; congruence).
 
           assert (Ecall: EF_external name sg = LOCK) by congruence.
 
-          assert (Eae : at_external (@semSem (ClightSemanticsForMachines.Clight_newSem ge)) (ExtCall (EF_external name sg) args lid ve te k) m =
+          assert (Eae : at_external (@semSem (ClightSemanticsForMachines.ClightSem ge)) (Callstate (Ctypes.External (EF_external name sg) t0 t1 cc) l k) m =
                         Some (LOCK, Vptr b ofs :: nil)). {
             simpl.
             repeat f_equal; congruence.
@@ -635,10 +481,10 @@ Section Progress.
           }
 
           (* changing value of lock in dry mem *)
-          assert (Hm' : exists m', Mem.store Mint32 (restrPermMap Hlt') b (Ptrofs.intval ofs) (Vint Int.zero) = Some m'). {
+          assert (Hm' : exists m', Mem.store Mptr (restrPermMap Hlt') b (Ptrofs.intval ofs) (Vptrofs Ptrofs.zero) = Some m'). {
             Transparent Mem.store.
             unfold Mem.store in *.
-            destruct (Mem.valid_access_dec _ Mint32 b (Ptrofs.intval ofs) Writable) as [N|N].
+            destruct (Mem.valid_access_dec _ Mptr b (Ptrofs.intval ofs) Writable) as [N|N].
             now eauto.
             exfalso.
             apply N.
@@ -654,17 +500,16 @@ Section Progress.
 
           (* necessary to know that we have indeed a lock *)
           assert (ex: exists sh0 psh0, forall j, 0 <= j < LKSIZE -> phi0 @ (b, Ptrofs.intval ofs+j) = YES sh0 psh0 (LK LKSIZE j) (pack_res_inv (approx (level phi0) Rx))). {
-            clear -LKSPEC. 
-            destruct LKSPEC as [LKSPEC _]. simpl in LKSPEC.
+            clear -LKSPEC. simpl in LKSPEC.
             assert (rshx: readable_share shx). {
                  specialize (LKSPEC (b, Ptrofs.unsigned ofs)). rewrite if_true in LKSPEC.
-                  destruct LKSPEC. auto. split; auto. pose proof LKSIZE_pos; omega.
+                  destruct LKSPEC. auto. split; auto. pose proof LKSIZE_pos; lia.
             }
            exists shx, rshx. intros.
             specialize (LKSPEC (b, Ptrofs.intval ofs+j)).
             simpl in LKSPEC. rewrite if_true in LKSPEC. destruct LKSPEC as [rshx' ?].
-            rewrite H0. f_equal. proof_irr. reflexivity. f_equal. unfold Ptrofs.unsigned. omega.
-            split; auto. unfold Ptrofs.unsigned; omega.
+            rewrite H0. f_equal. proof_irr. reflexivity. f_equal. unfold Ptrofs.unsigned. lia.
+            split; auto. unfold Ptrofs.unsigned; lia.
           }
           destruct ex as (sh0 & psh0 & ex).
           pose proof (resource_at_join _ _ _ (b, Ptrofs.intval ofs) Join) as Join'.
@@ -679,7 +524,7 @@ Section Progress.
             ;
               [ reflexivity | reflexivity | ].
             eapply step_acquire
-            with (R0 := approx (level phi0) Rx)
+            with (R := approx (level phi0) Rx)
             (* with (sh := shx) *)
             .
             all: try match goal with |- _ = age_tp_to _ _ => reflexivity end.
@@ -689,7 +534,6 @@ Section Progress.
             * eassumption.
             * simpl.
               inv H_acquire; auto.
-            * apply (mem_compatible_forget compat).
             * reflexivity.
             * instantiate (1:=shx). hnf; intros.
               specialize (ex i0 H).
@@ -698,9 +542,8 @@ Section Progress.
               exists sh3, sh3'. split; auto. subst.
               clear - Join0 ex E3 LKSPEC H.
               rewrite ex in Join0. rewrite E3 in Join0.
-              destruct LKSPEC as [LKSPEC _]. specialize (LKSPEC (b, Ptrofs.intval ofs + i0)).
-              rewrite jam_true in LKSPEC.
-              2:{ split; auto. unfold Ptrofs.unsigned; omega. }
+              specialize (LKSPEC (b, Ptrofs.intval ofs + i0)).
+              rewrite jam_true in LKSPEC by (split; auto; unfold Ptrofs.unsigned; lia).
               destruct LKSPEC as [? LKSPEC]. simpl in LKSPEC. rewrite LKSPEC in ex; inv ex.
               inv Join0; exists sh2; auto.
             * reflexivity.
@@ -711,6 +554,102 @@ Section Progress.
             * apply Hm'.
             * apply Efind.
             * apply Jphi'.
+
+        - (* Some None: lock is locked, so [acquire] fails. *)
+          destruct lock_coh' as [LOAD ((* sh' & *) align & bound & R' & lk)].
+          destruct isl as [sh [psh [z Ewetv]]].
+          rewrite Ewetv in *.
+
+          (* rewrite Eat in Ewetv. *)
+          specialize (lk (b, Ptrofs.unsigned ofs)).
+          spec lk. pose proof LKSIZE_pos; split; auto; lia.
+
+          unfold lock_inv in PREC.
+          destruct PREC as (b0 & ofs0 & EQ & LKSPEC).
+          injection EQ as <- <-.
+          exists (m, (seq.cat tr (Events.external i (Events.failacq (b, Ptrofs.intval ofs)) :: nil), sch, tp))(* ; split *).
+          + apply state_step_c.
+            apply JuicyMachine.sync_step with
+            (Htid := cnti)
+              (Hcmpt := mem_compatible_forget compat);
+              [ reflexivity (* schedPeek *)
+              | reflexivity (* schedSkip *)
+              | ].
+            (* factoring proofs out before the inversion/eapply *)
+            pose proof LKSPEC as LKSPEC'.
+            specialize (LKSPEC (b, Ptrofs.unsigned ofs)).
+            simpl in LKSPEC.
+            if_tac [r|nr] in LKSPEC; [|destruct nr; split; auto; pose proof LKSIZE_pos; lia].
+            destruct LKSPEC as (p & E).
+            pose proof (resource_at_join _ _ _ (b, Ptrofs.unsigned ofs) Join) as J.
+            rewrite E in J.
+
+            assert (Ename : name = "acquire"). {
+              simpl in *.
+              injection H_acquire as Ee.
+              apply ext_link_inj in Ee; auto.
+            }
+
+            assert (Ez : z = LKSIZE). {
+              simpl in lk.
+              destruct lk as (psh' & rsh & EPhi).
+              rewrite EPhi in Ewetv.
+              injection Ewetv as _ <-.
+              reflexivity.
+            }
+
+            assert (Esg : sg = LOCK_SIG) by (unfold ef_id_sig in *; congruence).
+
+            assert (Eargs : l = Vptr b ofs :: nil) by auto.
+
+            assert (Ecall: EF_external name sg = LOCK) by congruence.
+
+            assert (Eae : at_external (@semSem (ClightSemanticsForMachines.ClightSem ge)) (Callstate (Ctypes.External (EF_external name sg) t0 t1 cc) l k) m =
+                    Some (LOCK, Vptr b ofs :: nil)). {
+              simpl.
+              repeat f_equal; congruence.
+            }
+
+            unfold load_at in LOAD.
+            eapply load_at_phi_restrict with (phi0 := phi0) (cnti := cnti) in LOAD.
+            all: [ > | exists phi1; eassumption | eassumption | eassumption ].
+
+            inversion J; subst.
+
+            * eapply step_acqfail with (Hcompat := mem_compatible_forget compat)
+                                       (R := approx (level phi0) Rx).
+              all: try solve [ constructor | eassumption | reflexivity ].
+                (* [ > idtac ]. *)
+              simpl.
+              unfold Ptrofs.unsigned in *.
+              intros. instantiate (1:=shx). hnf. intros.
+              apply (resource_at_join _ _ _ (b, Ptrofs.intval ofs+i0)) in Join.
+              specialize (LKSPEC' (b, Ptrofs.intval ofs+i0)).
+              rewrite jam_true in LKSPEC' by (split; auto; lia).
+              destruct LKSPEC' as [rsh8 LKSPEC']. simpl in LKSPEC'. rewrite LKSPEC' in Join.
+              inv Join; replace (Ptrofs.intval ofs + i0 - Ptrofs.intval ofs) with i0 in * by lia.
+              exists sh4, rsh2; split; auto. eexists; eassumption.
+              exists sh4, rsh4; split; auto. eexists; eassumption.              
+            * eapply step_acqfail with (Hcompat := mem_compatible_forget compat)
+                                       (R := approx (level phi0) Rx).
+              all: try solve [ constructor | eassumption | reflexivity ].
+              simpl.
+              unfold Ptrofs.unsigned in *.
+              instantiate (1:=shx). hnf. intros.
+              apply (resource_at_join _ _ _ (b, Ptrofs.intval ofs+i0)) in Join.
+              specialize (LKSPEC' (b, Ptrofs.intval ofs+i0)).
+              rewrite jam_true in LKSPEC' by (split; auto; lia).
+              destruct LKSPEC' as [rsh8 LKSPEC']. simpl in LKSPEC'. rewrite LKSPEC' in Join.
+              inv Join; replace (Ptrofs.intval ofs + i0 - Ptrofs.intval ofs) with i0 in * by lia.
+              exists sh4, rsh4; split; auto. eexists; eassumption.
+              exists sh4, rsh5; split; auto. eexists; eassumption.    
+
+        - (* None: that cannot be: there is no lock at that address *)
+          exfalso.
+          destruct isl as [x [? [? EPhi]]].
+          rewrite EPhi in lock_coh'.
+          apply lock_coh'. hnf. eauto.
+
       }
 
       { (* the case of release *)
@@ -720,8 +659,9 @@ Section Progress.
         rewrite Eci in safei.
         fixsafe safei.
         inversion safei
-          as [ | ?????? bad | n0 z c m0 e args0 x at_ex Pre SafePost | ????? bad ];
-          [ now inversion bad; inversion H4 | subst | now inversion bad ].
+          as [ | ????? bad | z c m0 e args0 x at_ex Pre SafePost | ???? bad ]; last contradiction.
+        { rewrite level_jm_ in H; setoid_rewrite H in En; discriminate. }
+        { inv bad. inv H3. rewrite Hinline in *; discriminate. }
         subst.
         simpl in at_ex. injection at_ex as <- <-.
         hnf in x.
@@ -739,14 +679,11 @@ Section Progress.
         intros Post.
 
         (* relate lset to val *)
-        destruct Precond as ((Hreadable & PreA2) & ([PreB1 _] & PreB2) & PreC).
-        change Logic.True in PreA2. clear PreA2.
-        change Logic.True in PreB2. clear PreB2.
-        unfold canon.SEPx in PreC.
+        destruct Precond as ((Hreadable & _) & PreB1 & _ & PreC).
+        unfold SeparationLogic.argsassert2assert, canon.SEPx in PreC.
         unfold base.fold_right_sepcon in *.
         rewrite seplog.sepcon_emp in PreC.
-        rewrite seplog.corable_andp_sepcon1 in PreC; swap 1 2.
-        { apply corable_weak_exclusive. }
+        rewrite seplog.corable_andp_sepcon1 in PreC by apply conclib.corable_weak_exclusive.
         rewrite seplog.sepcon_comm in PreC.
         rewrite seplog.sepcon_emp in PreC.
         destruct PreC as (Hexclusive, PreC).
@@ -766,14 +703,64 @@ Section Progress.
         (* next step depends on status of lock: *)
         pose proof (lock_coh (b, Ptrofs.unsigned ofs)) as lock_coh'.
         destruct (AMap.find (elt:=option rmap) (b, Ptrofs.unsigned ofs) (lset tp))
-          as [[unlockedphi|]|] eqn:Efind;
-          swap 1 3.
+          as [[unlockedphi|]|] eqn:Efind.
 
-        - (* None: that cannot be: there is no lock at that address *)
+        - (* Some Some: lock is unlocked, this should be impossible *)
+          destruct lock_coh' as [LOAD (align & bound & R' & lk & sat)].
+          destruct sat as [sat | ?]; [ | congruence ].
+          destruct isl as [sh [psh [z Ewetv]]].
+          rewrite Ewetv in *.
           exfalso.
-          destruct isl as [x [? [? EPhi]]].
-          rewrite EPhi in lock_coh'.
-          apply lock_coh'. do 4 eexists. reflexivity. 
+          clear Post.
+
+          (* sketch: *)
+          (* - [unlockedphi] satisfies R *)
+          (* - [phi_sat] satisfies R *)
+          (* - [unlockedphi] and [phi_sat] join *)
+          (* - but R is exclusive so that's impossible *)
+
+          pose proof predat6 lk as E1.
+          pose proof predat1 Ewetv as E2.
+          pose proof predat4 Hlockinv as E3.
+          apply (predat_join_sub SUB) in E3.
+          assert (level phi_lockinv = level Phi) by apply join_sub_level, SUB.
+          assert (level unlockedphi = level Phi).
+          { eapply join_sub_level, compatible_lockRes_sub_all; simpl;
+              eauto; apply compat. }
+          rewr (level phi_lockinv) in E3.
+          assert (join_sub phi_sat Phi). {
+            apply join_sub_trans with phi0. hnf; eauto.
+            apply join_sub_trans with (getThreadR cnti). hnf; eauto.
+            apply compatible_threadRes_sub. apply compat.
+          }
+          assert (level phi_sat = level Phi) by (apply join_sub_level; auto).
+
+          assert (joins (age_by 1 phi_sat) (age_by 1 unlockedphi)) as [phi' J%join_comm].
+          { apply age_by_joins.
+            eapply @join_sub_joins_trans with (c := phi0); auto. apply Perm_rmap.
+            * exists phi_lockinv. apply join_comm. auto.
+            * eapply @join_sub_joins_trans with (c := getThreadR cnti); auto. apply Perm_rmap.
+              -- exists phi1. auto.
+              -- eapply compatible_threadRes_lockRes_join. apply (mem_compatible_forget compat).
+                 apply Efind. }
+          specialize (Hexclusive phi').
+          spec Hexclusive.
+          { apply join_level in J as [].
+            apply join_level in jphi as [].
+            rewrite level_age_by in *; lia. }
+          specialize (Hexclusive _ _ (necR_refl _) (ext_refl _)); apply Hexclusive.
+          eexists; eexists; split; eauto; split.
+
+          + (* sat 1 *)
+            revert sat.
+            apply approx_eq_app_pred with (level Phi).
+            * rewrite level_age_by. rewr (level unlockedphi). lia.
+            * eapply predat_inj; eauto.
+
+          + (* sat 2 *)
+            revert SAT. apply age_by_ind.
+            apply pred_hereditary.
+
         - (* Some None: lock is locked, so [release] should succeed. *)
           destruct lock_coh' as [LOAD ((* sh' &  *)align & bound & R' & lk)].
           destruct isl as [sh [psh [z Ewetv]]].
@@ -799,35 +786,30 @@ Section Progress.
 
           assert (Esg : sg = LOCK_SIG) by (unfold ef_id_sig in *; congruence).
 
-          assert (Eargs : args = Vptr b ofs :: nil). {
-            subst sg.
-            hnf in PreB1.
-            eapply shape_of_args; eauto.
-          }
+          assert (Eargs : l = Vptr b ofs :: nil) by auto.
 
           assert (Ecall: EF_external name sg = UNLOCK) by congruence.
 
-          assert (Eae : at_external (@semSem (ClightSemanticsForMachines.Clight_newSem ge)) (ExtCall (EF_external name sg) args lid ve te k) m =
+          assert (Eae : at_external (@semSem (ClightSemanticsForMachines.ClightSem ge)) (Callstate (Ctypes.External (EF_external name sg) t0 t1 cc) l k) m =
                         Some (UNLOCK, Vptr b ofs :: nil)). {
             simpl.
             auto.
           }
           subst z.
           assert (E1: exists sh, lock_at_least sh (approx (level phi_lockinv) Rx) (getThreadR cnti) b (Ptrofs.intval ofs)).
-          { exists shx. hnf; intros. SearchAbout phi_lockinv.
+          { exists shx. hnf; intros.
             clear - Join jphi Hlockinv H.
             assert (join_sub phi_lockinv  (getThreadR cnti)).
             eapply join_sub_trans. eexists; apply jphi. eexists; eassumption.
             apply (resource_at_join_sub _ _ (b, Ptrofs.intval ofs + i0)) in H0.
             forget (getThreadR cnti @ (b, Ptrofs.intval ofs + i0)) as r.
             unfold lock_inv in  Hlockinv. destruct Hlockinv as [b' [ofs' [? ?]]].
-            inversion H1; subst b' ofs'. destruct H2. simpl in H2.
+            inversion H1; subst b' ofs'. simpl in H2.
             specialize (H2 (b, Ptrofs.intval ofs + i0)). clear H1.
-            rewrite if_true in H2.
-            2:{ split; auto. unfold Ptrofs.unsigned; omega. }
+            rewrite if_true in H2 by (split; auto; unfold Ptrofs.unsigned; lia).
             destruct H2 as [rsh H2]. rewrite H2 in H0. destruct H0 as [sh ?].
             simpl in *.
-            replace (Ptrofs.intval ofs + i0 - Ptrofs.unsigned ofs) with i0 in * by (unfold Ptrofs.unsigned; omega).
+            replace (Ptrofs.intval ofs + i0 - Ptrofs.unsigned ofs) with i0 in * by (unfold Ptrofs.unsigned; lia).
             inv H0.
             exists sh3, rsh3. split. exists sh2; auto. reflexivity.
             exists sh3, rsh3. split. exists sh2; auto. reflexivity.
@@ -845,10 +827,10 @@ Section Progress.
           }
 
           (* changing value of lock in dry mem *)
-          assert (Hm' : exists m', Mem.store Mint32 (restrPermMap Hlt') b (Ptrofs.intval ofs) (Vint Int.one) = Some m'). {
+          assert (Hm' : exists m', Mem.store Mptr (restrPermMap Hlt') b (Ptrofs.intval ofs) (Vptrofs Ptrofs.one) = Some m'). {
             Transparent Mem.store.
             unfold Mem.store in *.
-            destruct (Mem.valid_access_dec _ Mint32 b (Ptrofs.intval ofs) Writable) as [N|N].
+            destruct (Mem.valid_access_dec _ Mptr b (Ptrofs.intval ofs) Writable) as [N|N].
             now eauto.
             exfalso.
             apply N.
@@ -878,111 +860,31 @@ Section Progress.
             - rewrite level_age_by.
               replace (level phi_sat) with (level Phi) by join_level_tac.
               replace (level phi_lockinv) with (level Phi) by join_level_tac.
-              omega.
-            - hered. 2: apply pred_hered.
-              apply age_by_1. replace (level phi_sat) with (level Phi). omega. join_level_tac.
+              lia.
+            - hered.
+              apply age_by_1. replace (level phi_sat) with (level Phi). lia. join_level_tac.
+              apply pred_hered.
           }
 
           eexists (m', (seq.cat tr _, sch, _)).
           eapply state_step_c.
           eapply JuicyMachine.sync_step with (Htid := cnti); auto.
-          eapply step_release
-          with (c := (ExtCall (EF_external name sg) args lid ve te k))
-                 (Hcompat := mem_compatible_forget compat);
-              try apply Eci;
-            try apply Eae;
-            try apply Eci;
-            try apply Hm';
-            try apply E1;
-            try eapply join_comm, Join_with_sat;
-            try apply Wjm';
-            try apply Sat;
-            try apply Efind;
-            try reflexivity.
-          + apply (mem_compatible_forget compat).
-          + destruct Hlockinv as (b00 & ofs00 & E & WOB); injection E as <- <-.
-            eapply load_at_phi_restrict with (phi0 := phi_lockinv) (cnti := cnti) in LOAD.
-            all: [ > assumption | | | eassumption ].
-            * apply join_sub_trans with phi0. eexists; eauto.
-              eexists. eapply join_comm. eauto.
-            * eassumption.
+          destruct Hlockinv as (b00 & ofs00 & E & WOB); injection E as <- <-.
+          eapply load_at_phi_restrict with (phi0 := phi_lockinv) (cnti := cnti) in LOAD; try eassumption.
+          eapply step_release with (d_phi := phi_sat); try eassumption; try reflexivity.
           + clear - jphi SAT SUB En.
-              split; auto. rewrite level_age_by. apply join_level in jphi. destruct jphi. rewrite H0. rewrite H.
-              apply join_sub_level in SUB. rewrite <- SUB in En. rewrite H in En. rewrite En. omega.
+              split; auto. rewrite level_age_by. apply join_level in jphi as [H ->].
+              apply join_sub_level in SUB. lia.
               simpl. unfold age1'. destruct (age1 phi_sat) eqn:?; auto.
               eapply pred_nec_hereditary; try eassumption. constructor 1. auto.
-        - (* Some Some: lock is unlocked, this should be impossible *)
-          destruct lock_coh' as [LOAD (align & bound & R' & lk & sat)].
-          destruct sat as [sat | ?]; [ | congruence ].
-          destruct isl as [sh [psh [z Ewetv]]].
-          rewrite Ewetv in *.
+          + eauto.
+          + apply join_sub_trans with phi0. eexists; eauto.
+            eexists. eapply join_comm. eauto.
+        - (* None: that cannot be: there is no lock at that address *)
           exfalso.
-          clear Post.
-
-          (* sketch: *)
-          (* - [unlockedphi] satisfies R *)
-          (* - [phi_sat] satisfies R *)
-          (* - [unlockedphi] and [phi_sat] join *)
-          (* - but R is positive and precise so that's impossible *)
-
-          pose proof predat6 lk as E1.
-          pose proof predat1 Ewetv as E2.
-          pose proof predat4 Hlockinv as E3.
-          apply (predat_join_sub SUB) in E3.
-          assert (level phi_lockinv = level Phi) by apply join_sub_level, SUB.
-          assert (level unlockedphi = level Phi).
-          { eapply join_sub_level, compatible_lockRes_sub_all; simpl;
-              eauto; apply compat. }
-          rewr (level phi_lockinv) in E3.
-          assert (join_sub phi_sat Phi). {
-            apply join_sub_trans with phi0. hnf; eauto.
-            apply join_sub_trans with (getThreadR cnti). hnf; eauto.
-            apply compatible_threadRes_sub. apply compat.
-          }
-          assert (level phi_sat = level Phi) by (apply join_sub_level; auto).
-
-          pose proof (* weak_ *)exclusive_joins_false
-               (approx (level Phi) R) (age_by 1 unlockedphi) (age_by 1 phi_sat) (* phi0 *) as PP.
-          apply PP.
-          (* + (* level *) *)
-          (*   rewrite !level_age_by. f_equal. join_level_tac. *)
-
-          + (* exclusive *)
-            apply exclusive_approx with (n := level Phi) in Hexclusive.
-            replace (level phi0) with (level Phi) in Hexclusive. 2:join_level_tac.
-            exact_eq Hexclusive; f_equal.
-            eapply predat_inj; eauto.
-            setoid_rewrite approx_approx'. auto. omega.
-
-          + (* sat 1 *)
-            split.
-            * rewrite level_age_by. rewr (level unlockedphi). omega.
-            * revert sat.
-              apply approx_eq_app_pred with (level Phi).
-              -- rewrite level_age_by. rewr (level unlockedphi). omega.
-              -- eapply predat_inj; eauto.
-
-          + (* sat 2 *)
-            split.
-            -- rewrite level_age_by. rewr (level phi_sat). omega.
-            -- cut (app_pred Rx (age_by 1 phi_sat)).
-               ++ apply approx_eq_app_pred with (S n).
-                  ** rewrite level_age_by. rewr (level phi_sat). omega.
-                  ** pose proof (predat_inj E3 E2) as G.
-                     exact_eq G; do 2 f_equal; auto.
-               ++ revert SAT. apply age_by_ind.
-                  destruct Rx.
-                  auto.
-
-          + (* joins *)
-            apply age_by_joins.
-            apply joins_sym.
-            eapply @join_sub_joins_trans with (c := phi0); auto. apply Perm_rmap.
-            * exists phi_lockinv. apply join_comm. auto.
-            * eapply @join_sub_joins_trans with (c := getThreadR cnti); auto. apply Perm_rmap.
-              -- exists phi1. auto.
-              -- eapply compatible_threadRes_lockRes_join. apply (mem_compatible_forget compat).
-                 apply Efind.
+          destruct isl as [x [? [? EPhi]]].
+          rewrite EPhi in lock_coh'.
+          apply lock_coh'. repeat eexists.
       }
 
       { (* the case of makelock *)
@@ -992,8 +894,9 @@ Section Progress.
         rewrite Eci in safei.
         fixsafe safei.
         inversion safei
-          as [ | ?????? bad | n0 z c m0 e args0 x at_ex Pre SafePost | ????? bad ];
-          [ now inversion bad; inversion H4 | subst | now inversion bad ].
+          as [ | ????? bad | z c m0 e args0 x at_ex Pre SafePost | ???? bad ]; last contradiction.
+        { rewrite level_jm_ in H; setoid_rewrite H in En; discriminate. }
+        { inv bad. inv H3. rewrite Hinline in *; discriminate. }
         subst.
         simpl in at_ex. injection at_ex as <- <-.
         hnf in x.
@@ -1019,83 +922,62 @@ Section Progress.
 
         assert (Esg : sg = UNLOCK_SIG) by (unfold ef_id_sig, ef_sig in *; congruence).
 
-        destruct Precond as [[Hwritable _] [[[B1 _] _] AT]].
+        destruct Precond as [[Hwritable _] [B1 [_ AT]]].
         assert (Hreadable : readable_share shx) by (apply writable0_readable; auto).
 
         (* [data_at_] from the precondition *)
-        unfold canon.SEPx in *.
+        unfold SeparationLogic.argsassert2assert, canon.SEPx in *.
         simpl in AT.
         rewrite seplog.sepcon_emp in AT.
 
         (* value of [vx] *)
-        simpl in B1.
-        unfold lift, liftx in B1. simpl in B1.
-        unfold lift, liftx in B1. simpl in B1.
-        rewrite data_at__isptr in AT.
-        destruct AT as (IsPtr, AT).
-        destruct vx as [ | | | | | b ofs ]; try inversion IsPtr; [ clear IsPtr ].
-
-        assert (Eargs : args = Vptr b ofs :: nil). {
-          subst sg.
-          eapply shape_of_args; eauto.
-        }
+        assert (Eargs : l = vx :: nil) by auto.
 
         assert (Ecall: EF_external name sg = MKLOCK) by congruence.
 
-        assert (Eae : at_external (@semSem (ClightSemanticsForMachines.Clight_newSem ge)) (ExtCall (EF_external name sg) args lid ve te k) m =
-                      Some (MKLOCK, Vptr b ofs :: nil)). {
+        assert (Eae : at_external (@semSem (ClightSemanticsForMachines.ClightSem ge)) (Callstate (Ctypes.External (EF_external name sg) t0 t1 cc) l k) m =
+                      Some (MKLOCK, vx :: nil)). {
           simpl.
           repeat f_equal; congruence.
         }
 
-        assert (Hm' : exists m', Mem.store Mint32 (m_dry (personal_mem (thread_mem_compatible (mem_compatible_forget compat) cnti))) b (Ptrofs.intval ofs) (Vint Int.zero) = Some m'). {
+        assert (exists b ofs, vx = Vptr b ofs) as (b & ofs & ->).
+        { destruct AT as [[] _]. destruct vx; try contradiction; eauto. }
+
+        assert (Hm' : exists m', Mem.store Mptr (m_dry (personal_mem (thread_mem_compatible (mem_compatible_forget compat) cnti))) b (Ptrofs.intval ofs) (Vptrofs Ptrofs.zero) = Some m'). {
           clear -AT Join Hwritable.
-          unfold tlock in AT. 
-          destruct AT as (AT1, AT2). 
-          destruct AT2 as [A B].
-          clear A. (* it is 4 = 4 *)
+          unfold tlock in AT.
+          destruct AT as (AT1, [_ B]).
           simpl in B. unfold mapsto_memory_block.at_offset in B.
-          simpl in B. unfold nested_field_lemmas.nested_field_offset in B.
-          simpl in B. unfold nested_field_lemmas.nested_field_type in B.
-          simpl in B. unfold reptype_lemmas.default_val in B.
-          simpl in B. unfold sublist.Znth in B.
-          simpl in B. repeat rewrite Int.add_assoc in B.
-          unfold data_at_rec_lemmas.data_at_rec in *.
-          simpl in B.
-          repeat rewrite add_repr in B.
-          rewrite seplog.sepcon_emp in B. simpl in B.
+          rewrite seplog.sepcon_emp in B.
           (* if array size > 4:
           destruct B as (phi00 & phi01 & jphi0 & B & _).
           *)
           unfold SeparationLogic.mapsto in *.
           simpl in B.
-          destruct (readable_share_dec shx) as [n|n]. 2: now destruct n; apply writable0_readable; auto.
-          autorewrite with norm in B.
-          rewrite !FF_orp in B.
-          autorewrite with norm in B.
-          destruct B as [v1' B]. 
-          autorewrite with norm in B.
-          destruct B as [v2' B]. 
-          rewrite !TT_andp in B.
+          rewrite !Ptrofs.add_zero in B.
+          destruct (readable_share_dec shx) as [n|n]; [|now destruct n; apply writable0_readable; auto].
+          rewrite !(log_normalize.prop_false_andp False), !FF_orp in B by auto.
+          rewrite log_normalize.exp_andp2, log_normalize.exp_sepcon1 in B.
+          destruct B as [v2' B].
           apply mapsto_can_store with (v := v2') (sh := shx); try assumption.
           auto.
           simpl (m_phi _).
-          destruct B as [phi0a [phi0b [? [? ?]]]].
+          destruct B as [phi0a [phi0b [? [[] ?]]]].
           destruct (join_assoc H Join) as [f [? ?]].
           exists phi0a, f; repeat split; auto.
-          
         }
         destruct Hm' as (m', Hm').
 
         clear Post.
 
         unfold tlock in *.
-        match type of AT with context[Tarray _ ?n] => assert (Hpos : (0 < n)%Z) by omega end.
+        match type of AT with context[Tarray _ ?n] => assert (Hpos : (0 < n)%Z) by lia end.
         pose proof data_at_rmap_makelock CS as RL.
         specialize (RL shx b ofs Rx phi0 _ Hpos (writable_writable0 Hwritable) AT).
         destruct RL as (phi0' & RL0 & lkat).
 
-        match type of lkat with context[LK_at _ ?n] => assert (Hpos' : (0 < n)%Z) by (rewrite size_chunk_Mptr in *; destruct Archi.ptr64; omega) end.
+        match type of lkat with context[LK_at _ ?n] => assert (Hpos' : (0 < n)%Z) by (rewrite size_chunk_Mptr in *; destruct Archi.ptr64; lia) end.
         pose proof rmap_makelock_join _ _ _ _ _ _ _ Hpos' RL0 Join as RL.
         destruct RL as (phi' & RLphi & j').
         assert (ji : join_sub (getThreadR cnti) Phi) by (apply compatible_threadRes_sub, compat).
@@ -1106,16 +988,12 @@ Section Progress.
         eexists (m', (seq.cat tr _, sch, _)).
         constructor.
 
-        eapply JuicyMachine.sync_step
-        with (Htid := cnti); auto.
+        eapply JuicyMachine.sync_step with (Htid := cnti); auto.
 
-        eapply step_mklock
-        with (c := (ExtCall (EF_external name sg) args lid ve te k))
-               (Hcompatible := mem_compatible_forget compat)
-               (R := Rx)
-               (phi'0 := phi')
-        ; try eassumption; auto.
-        constructor.
+        eapply step_mklock; try eassumption; auto.
+        + constructor.
+        + apply Hm'.
+        + eassumption.
       }
 
       { (* the case of freelock *)
@@ -1125,8 +1003,9 @@ Section Progress.
         rewrite Eci in safei.
         fixsafe safei.
         inversion safei
-          as [ | ?????? bad | n0 z c m0 e args0 x at_ex Pre SafePost | ????? bad ];
-          [ now inversion bad; inversion H4 | subst | now inversion bad ].
+          as [ | ????? bad | z c m0 e args0 x at_ex Pre SafePost | ???? bad ]; last contradiction.
+        { rewrite level_jm_ in H; setoid_rewrite H in En; discriminate. }
+        { inv bad. inv H3. rewrite Hinline in *; discriminate. }
         subst.
         simpl in at_ex. injection at_ex as <- <-.
         hnf in x.
@@ -1153,14 +1032,11 @@ Section Progress.
 
         assert (Esg : sg = UNLOCK_SIG) by (unfold ef_id_sig, ef_sig in *; congruence).
 
-        destruct Precond as ((Hwritable & PreA2) & ([B1 _] & PreB2) & PreC).
-        change Logic.True in PreA2. clear PreA2.
-        change Logic.True in PreB2. clear PreB2.
-        unfold canon.SEPx in PreC.
+        destruct Precond as ([Hwritable _] & B1 & _ & PreC).
+        unfold SeparationLogic.argsassert2assert, canon.SEPx in PreC.
         unfold base.fold_right_sepcon in *.
         rewrite seplog.sepcon_emp in PreC.
-        rewrite seplog.corable_andp_sepcon1 in PreC; swap 1 2.
-        { apply corable_weak_exclusive. }
+        rewrite seplog.corable_andp_sepcon1 in PreC by (apply conclib.corable_weak_exclusive).
         rewrite seplog.sepcon_comm in PreC.
         rewrite seplog.sepcon_emp in PreC.
         destruct PreC as (Hexclusive, AT).
@@ -1170,25 +1046,19 @@ Section Progress.
 
         (* [data_at_] from the precondition *)
         unfold canon.SEPx in *.
-        simpl in AT.
 
         (* value of [vx] *)
         simpl in B1.
-        unfold lift, liftx in B1. simpl in B1.
-        unfold lift, liftx in B1. simpl in B1.
         rewrite lockinv_isptr in AT.
 
         destruct AT as (phi0lockinv & phi0sat & jphi0 & (IsPtr & Hlockinv) & Hsat).
         destruct vx as [ | | | | | b ofs ]; try inversion IsPtr; [ clear IsPtr ].
 
-        assert (Eargs : args = Vptr b ofs :: nil). {
-          subst sg.
-          eapply shape_of_args; eauto.
-        }
+        assert (Eargs : l = Vptr b ofs :: nil) by auto.
 
         assert (Ecall: EF_external name sg = FREE_LOCK) by congruence.
 
-        assert (Eae : at_external (@semSem (ClightSemanticsForMachines.Clight_newSem ge)) (ExtCall (EF_external name sg) args lid ve te k) m =
+        assert (Eae : at_external (@semSem (ClightSemanticsForMachines.ClightSem ge)) (Callstate (Ctypes.External (EF_external name sg) t0 t1 cc) l k) m =
                       Some (FREE_LOCK, Vptr b ofs :: nil)). {
           simpl.
           repeat f_equal; congruence.
@@ -1200,12 +1070,12 @@ Section Progress.
           specialize (lock_coh (b, Ptrofs.intval ofs)). cleanup.
           destruct (AMap.find _ _) as [|] eqn:Ephi_sat. congruence.
           unfold lock_inv in *.
-          destruct Hlockinv as (b_ & ofs_ & E_ & HH & HG).
+          destruct Hlockinv as (b_ & ofs_ & E_ & HH).
           specialize (HH (b, Ptrofs.intval ofs)).
           simpl in HH.
           change Ptrofs.intval with Ptrofs.unsigned in *.
           injection E_ as <- <- .
-          if_tac [r|nr] in HH. 2:range_tac.
+          if_tac [r|nr] in HH; [|range_tac].
           destruct HH as (p & HH).
           assert (j : join_sub phi0lockinv Phi). {
             apply join_sub_trans with phi0. eexists; eauto.
@@ -1216,25 +1086,19 @@ Section Progress.
           apply resource_at_join with (loc := (b, Ptrofs.unsigned ofs)) in j.
           rewrite HH in j.
           destruct lock_coh. clear - j. rewrite Z.sub_diag in j.
-          inv j; hnf; do 4 eexists; eauto.
+          inv j; hnf; repeat eexists; eauto.
         }
 
-        pose proof Hlockinv as COPY.
-        apply (lock_inv_rmap_freelock CS) with (m := m) in COPY; auto; try apply lock_coh; swap 1 2; swap 2 3.
-        {
-          specialize (lock_coh (b, Ptrofs.intval ofs)). cleanup.
-          remember (AMap.find (elt:=option rmap) _ _) as o in lock_coh.
-          rewrite <-Heqo in lock_not_none.
-          destruct o as [[phi_sat|]|]; [ | | ]; try solve [apply lock_coh].
-          tauto.
-        }
-        {
+        assert ((align_chunk Mptr | Ptrofs.unsigned ofs) /\ (Ptrofs.unsigned ofs + LKSIZE < Ptrofs.modulus)%Z) as [].
+        { 
           specialize (lock_coh (b, Ptrofs.intval ofs)). cleanup.
           remember (AMap.find (elt:=option rmap) _ _) as o in lock_coh.
           rewrite <-Heqo in lock_not_none.
-          destruct o as [[phi_sat|]|]; [ | | ]; try solve [apply lock_coh].
+          destruct o as [[phi_sat|]|]; [ | | ]; try solve [destruct lock_coh as (? & ? & ? & ?); auto].
           tauto.
         }
+        pose proof Hlockinv as COPY.
+        apply (lock_inv_rmap_freelock CS) with (m := m) in COPY; auto; try apply lock_coh.
 
         destruct COPY as (phi0lockinv' & Hrmap00 & Hlkat).
 
@@ -1251,8 +1115,8 @@ Section Progress.
         assert (locked : lockRes tp (b, Ptrofs.intval ofs) = Some None). {
           specialize (lock_coh (b, Ptrofs.intval ofs)). cleanup.
           destruct (AMap.find _ _) as [[phi_sat|]|] eqn:Ephi_sat; [ exfalso | reflexivity | exfalso ].
-          - (* positive and precise *)
-            destruct lock_coh as (_&_&_&R&lk&[sat|?]). 2:omega.
+          - (* exclusive *)
+            destruct lock_coh as (_&_&_&R&lk&[sat|?]); [|lia].
 
             assert (J0 : join_sub phi0 Phi). {
               apply join_sub_trans with (@getThreadR _ _ _ i tp cnti). eexists; eauto.
@@ -1277,52 +1141,45 @@ Section Progress.
             pose proof predat4 Hlockinv as E3.
             apply (predat_join_sub J01) in E3.
 
-            pose proof exclusive_joins_false
-                 (approx (level Phi) Rx) (age_by 1 phi_sat) (age_by 1 phi0sat) as PP.
-            apply PP.
-            + (* exclusive *)
-              apply exclusive_approx with (n := level Phi) in Hexclusive.
-              rewrite (compose_rewr (approx _) (approx _)) in Hexclusive.
-              rewrite approx_oo_approx' in Hexclusive. auto.
-              replace (level phi0) with (level Phi). 2:join_level_tac.
-              omega.
+            assert (joins (age_by 1 phi_sat) (age_by 1 phi0sat)) as [phis J].
+            { apply age_by_joins.
+              apply joins_comm.
+              eapply @join_sub_joins_trans with (c := phi0); auto. apply Perm_rmap.
+              * eexists. apply join_comm. eauto.
+              * eapply @join_sub_joins_trans with (c := OrdinalPool.getThreadR cnti); auto. apply Perm_rmap.
+                -- exists phi1. auto.
+                -- eapply compatible_threadRes_lockRes_join. apply (mem_compatible_forget compat).
+                   apply Ephi_sat. }
+            specialize (Hexclusive phis).
+            spec Hexclusive.
+            { apply join_level in J as [].
+              destruct J0 as [? J0]; apply join_level in J0 as [].
+              destruct Ja as [? Ja]; apply join_level in Ja as [].
+              rewrite level_age_by in *; lia. }
+            specialize (Hexclusive _ _ (necR_refl _) (ext_refl _)); apply Hexclusive.
+            eexists; eexists; split; eauto; split.
 
             + (* sat 1 *)
-              split.
-              * rewrite level_age_by. rewrite Ra. omega.
-              * revert sat.
-                apply approx_eq_app_pred with (level Phi).
-                -- rewrite level_age_by. rewr (level phi_sat). omega.
-                -- eapply predat_inj; eauto.
-                   apply predat6 in lk; eauto.
-                   exact_eq E3. f_equal. f_equal. auto.
+              revert sat.
+              apply approx_eq_app_pred with (level Phi).
+              * rewrite level_age_by. rewr (level phi_sat). lia.
+              * eapply predat_inj; eauto.
+                 apply predat6 in lk; eauto.
+                 exact_eq E3. f_equal. f_equal. auto.
 
             + (* sat 2 *)
-              split.
-              -- rewrite level_age_by. cut (level phi0sat = level Phi). omega. join_level_tac.
-              -- revert Hsat. apply age_by_ind.
-                 destruct Rx.
-                 auto.
-
-            + (* joins *)
-              apply age_by_joins.
-              apply joins_sym.
-              eapply @join_sub_joins_trans with (c := phi0); auto. apply Perm_rmap.
-              * exists phi0lockinv. apply join_comm. auto.
-              * eapply @join_sub_joins_trans with (c := @getThreadR _ _ _ i tp cnti); auto. apply Perm_rmap.
-                -- exists phi1. auto.
-                -- eapply compatible_threadRes_lockRes_join. apply (mem_compatible_forget compat).
-                   apply Ephi_sat.
+              revert Hsat. apply age_by_ind.
+              apply pred_hereditary.
 
           - (* not a lock: impossible *)
             simpl in Hlockinv.
             unfold lock_inv in *.
-            destruct Hlockinv as (b_ & ofs_ & E_ & HH & HG).
+            destruct Hlockinv as (b_ & ofs_ & E_ & HH).
             specialize (HH (b, Ptrofs.intval ofs)).
             simpl in HH.
             change Ptrofs.intval with Ptrofs.unsigned in *.
             injection E_ as <- <- .
-            if_tac [r|nr] in HH. 2:range_tac.
+            if_tac [r|nr] in HH; [|range_tac].
             destruct HH as (p & HH).
             assert (j : join_sub phi0lockinv Phi). {
               apply join_sub_trans with phi0. eexists; eauto.
@@ -1339,26 +1196,20 @@ Section Progress.
         eexists (m, (seq.cat tr _, sch, _)).
         constructor.
 
-        eapply JuicyMachine.sync_step
-        with (Htid := cnti); auto.
-
-        eapply step_freelock
-        with (c := (ExtCall (EF_external name sg) args lid ve te k))
-               (Hcompat := mem_compatible_forget compat)
-               (R := Rx)
-               (phi'0 := phi')
-        .
+        eapply JuicyMachine.sync_step with (Htid := cnti); auto.
+        eapply step_freelock.
 
         all: try match goal with |- invariant _ => now constructor end.
         all: try match goal with |- _ = age_tp_to _ _ => reflexivity end.
         all: try match goal with |- _ = updThread _ _ _ => reflexivity end.
         all: try match goal with |- personal_mem _ = _ => reflexivity end.
-        - assumption.
         - eassumption.
-        - exists Phi; apply compat.
+        - eassumption.
         - reflexivity.
         - assumption.
-        - assumption.
+        - eassumption.
+        Unshelve.
+        eexists; eauto.
       }
       { (* the case of spawn *)
 
@@ -1367,8 +1218,9 @@ Section Progress.
         rewrite Eci in safei.
         fixsafe safei.
         inversion safei
-          as [ | ?????? bad | n0 z c m0 e args0 x at_ex Pre SafePost | ????? bad ];
-          [ now inversion bad; inversion H4 | subst | now inversion bad ].
+          as [ | ????? bad | z c m0 e args0 x at_ex Pre SafePost | ???? bad ]; last contradiction.
+        { rewrite level_jm_ in H; setoid_rewrite H in En; discriminate. }
+        { inv bad. inv H3. rewrite Hinline in *; discriminate. }
         subst.
         simpl in at_ex. injection at_ex as <- <-.
         hnf in x.
@@ -1399,84 +1251,60 @@ Section Progress.
     (* thread[i] is in Kresume *)
     {
       (* goes to Krun ci' with after_ex ci = ci'  *)
-      destruct ci as [ve te k | ef args lid ve te k] eqn:Heqc.
-
-      - (* contradiction: has to be an extcall *)
-        specialize (wellformed i cnti).
-        rewrite Eci in wellformed.
-        simpl in wellformed.
-        tauto.
-
-      - (* extcall *)
-        pose (ci':=
-                match lid with
-                | Some id => State ve (Maps.PTree.set id Vundef te) k
-                | None => State ve te k
-                end).
-        exists (m, (tr, i :: sch, ThreadPool.updThreadC cnti (Krun ci')))(* ; split *).
-        + (* taking the step Kresume->Krun *)
-          constructor.
-          apply @JuicyMachine.resume_step with (tid := i) (Htid := cnti).
-          * reflexivity.
-          * eapply JuicyMachine.ResumeThread with (Hcmpt := mem_compatible_forget compat)
-              (c := ci) (c' := ci');
-              simpl in *; try rewrite ClightSemanticsForMachines.CLN_msem in *;
-              simpl.
-            -- reflexivity.
-            -- subst.
-               reflexivity.
-            -- subst.
-               destruct lid.
-               ++ specialize (wellformed i cnti). simpl in wellformed. rewrite Eci in wellformed. destruct wellformed.
-                  unfold ci'. reflexivity.
-               ++ reflexivity.
-            -- setoid_rewrite Eci.
-               subst ci.
-               f_equal.
-               specialize (wellformed i cnti).
-               simpl in wellformed. rewrite Eci in wellformed.
-               simpl in wellformed.
-               tauto.
-            -- constructor.
-            -- reflexivity.
+      specialize (wellformed i cnti).
+      rewrite Eci in wellformed.
+      destruct wellformed as [H ?]; subst.
+      destruct ci as [ | f | ] eqn: Hci; try contradiction; simpl in H.
+      destruct f; try contradiction.
+      destruct (ef_inline e) eqn: Hinline; try contradiction.
+      eexists; constructor.
+      apply @JuicyMachine.resume_step with (tid := i) (Htid := cnti).
+      { reflexivity. }
+      eapply JuicyMachine.ResumeThread with (Hcmpt := mem_compatible_forget compat)(c := ci);
+        simpl in *; try rewrite Clight_evsem.CLC_msem in *; simpl.
+      -- reflexivity.
+      -- rewrite Hci; simpl.
+         rewrite Hinline; reflexivity.
+      -- rewrite Hci; simpl; reflexivity.
+      -- setoid_rewrite Eci; rewrite Hci; reflexivity.
+      -- constructor.
+      -- reflexivity.
     }
     (* end of Kresume *)
 
     (* thread[i] is in Kinit *)
     {
       specialize (safety i cnti tt). rewrite Eci in safety.
-      destruct safety as (? & q_new & Einit & safety).
+      destruct safety as (q_new & Einit & safety).
       eexists(* ; split *).
       - constructor.
         apply JuicyMachine.start_step with (tid := i) (Htid := cnti).
         + reflexivity.
         + eapply JuicyMachine.StartThread with (c_new := q_new)(Hcmpt := mem_compatible_forget compat).
           * apply Eci.
-          * simpl; reflexivity.
-          * split3; eauto.
-            repeat constructor; auto.
-            split. reflexivity. simpl.
-            destruct mwellformed; split; auto.
-            clear - H0.
-             change (Mem.nextblock m) with 
-               (Mem.nextblock (@install_perm (ClightSemanticsForMachines.Clight_newSem ge) tp m
-              i (@mem_compatible_forget ge tp m Phi compat) cnti)).
-      apply  maxedmem_neutral.
-      simpl nextblock.
-      assert (mem_equiv.mem_equiv (maxedmem (@install_perm (ClightSemanticsForMachines.Clight_newSem ge) tp
-        m i (@mem_compatible_forget ge tp m Phi compat) cnti))
-                  (maxedmem m)). {
-         clear. simpl.
-         unfold install_perm. simpl.
-         admit.  (* for Santiago to do. *)
-         }
-         red. rewrite H. auto.
           * reflexivity.
+          * instantiate (1 := install_perm (mem_compatible_forget compat) cnti). (* weird that cl_initial_core lets threads start with arbitrary memory *)
+            auto.
+          * constructor.
           * reflexivity.
     }
     (* end of Kinit *)
-    Unshelve.
-     eexists; eauto.
-Admitted. (* Theorem progress *)
+
+    (* bad schedule *)
+    {
+      eexists.
+      (* split. *)
+      (* -  *)constructor.
+        apply JuicyMachine.schedfail with i.
+        + reflexivity.
+        + simpl.
+          unfold OrdinalPool.containsThread.
+          now setoid_rewrite Ei; auto.
+        + constructor.
+        + eexists; eauto.
+        + reflexivity.
+    }
+
+Qed. (* Theorem progress *)
 
 End Progress.
diff --git a/concurrency/juicy/semax_safety_freelock.v b/concurrency/juicy/semax_safety_freelock.v
index 8367ee7c9a..7ca6b0fa16 100644
--- a/concurrency/juicy/semax_safety_freelock.v
+++ b/concurrency/juicy/semax_safety_freelock.v
@@ -10,19 +10,12 @@ Require Import compcert.common.Values.
 
 Require Import VST.msl.Coqlib2.
 Require Import VST.msl.eq_dec.
-Require Import VST.msl.seplog.
-Require Import VST.msl.age_to.
-Require Import VST.veric.aging_lemmas.
-Require Import VST.veric.initial_world.
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.juicy_mem_lemmas.
 Require Import VST.veric.semax_prog.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.Clight_new.
-Require Import VST.veric.Clightnew_coop.
+Require Import VST.veric.Clight_core.
+Require Import VST.veric.Clightcore_coop.
 Require Import VST.veric.semax.
-Require Import VST.veric.semax_ext.
-Require Import VST.veric.juicy_extspec.
 Require Import VST.veric.juicy_safety.
 Require Import VST.veric.initial_world.
 Require Import VST.veric.juicy_extspec.
@@ -31,7 +24,6 @@ Require Import VST.veric.semax_ext.
 Require Import VST.veric.res_predicates.
 Require Import VST.veric.mem_lessdef.
 Require Import VST.veric.shares.
-Require Import VST.veric.age_to_resource_at.
 Require Import VST.floyd.coqlib3.
 Require Import VST.floyd.field_at.
 Require Import VST.sepcomp.step_lemmas.
@@ -46,11 +38,7 @@ Require Import VST.concurrency.common.addressFiniteMap.
 Require Import VST.concurrency.common.permissions.
 Require Import VST.concurrency.juicy.JuicyMachineModule.
 Require Import VST.concurrency.juicy.sync_preds_defs.
-Require Import VST.concurrency.juicy.sync_preds.
 Require Import VST.concurrency.juicy.join_lemmas.
-(*Require Import VST.concurrency.cl_step_lemmas.
-Require Import VST.concurrency.resource_decay_lemmas.
-Require Import VST.concurrency.resource_decay_join.*)
 Require Import VST.concurrency.juicy.semax_invariant.
 Require Import VST.concurrency.juicy.semax_simlemmas.
 Require Import VST.concurrency.juicy.sync_preds.
@@ -104,18 +92,19 @@ Proof.
   assert (Hpos : (0 < LKSIZE)%Z) by reflexivity.
   intros isfreelock.
   intros I.
-  inversion I as [m tr sch_ tp Phi En envcoh mwellformed compat extcompat sparse lock_coh safety wellformed unique E]. rewrite <-E in *.
+  inversion I as [m tr sch_ tp Phi En envcoh (*mwellformed*) compat extcompat sparse lock_coh safety wellformed unique E]. rewrite <-E in *.
   unfold blocked_at_external in *.
   destruct isfreelock as (i & cnti & sch & ci & args & -> & Eci & atex).
   pose proof (safety i cnti tt) as safei.
 
   rewrite Eci in safei.
   fixsafe safei.
+  destruct ci as [| ?? cont |]; try discriminate.
   inversion safei
-    as [ | ?????? bad | n0 z c m0 e args0 x at_ex Pre SafePost | ????? bad ].
+    as [ | ????? bad | z c m0 e args0 x at_ex Pre SafePost | ????? bad ]; last contradiction.
+  { rewrite level_jm_ in H; setoid_rewrite H in En; discriminate. }
   apply (corestep_not_at_external (juicy_core_sem _)) in bad. exfalso; subst; clear - bad atex.
    simpl in bad. unfold cl_at_external in *; simpl in *. rewrite atex in bad; inv bad.
-  2: inversion bad.
   subst.
   simpl in at_ex.
   unfold cl_at_external in atex, at_ex.
@@ -139,11 +128,11 @@ Proof.
   simpl (and _).
   intros Post.
 
-  destruct Precond as [[Hwritable _] [[[B1 _] _] AT]].
+  destruct Precond as [[Hwritable _] [B1 [_ AT]]].
   assert (Hreadable : readable_share shx) by (apply writable_readable; auto).
 
   (* [data_at_] from the precondition *)
-  unfold canon.SEPx in *.
+  unfold SeparationLogic.argsassert2assert, canon.SEPx in *.
   simpl in AT.
   rewrite seplog.sepcon_emp in AT.
 
@@ -153,23 +142,21 @@ Proof.
   unfold lift, liftx in B1. simpl in B1.
   rewrite lockinv_isptr in AT.
   rewrite log_normalize.sepcon_andp_prop' in AT.
-  rewrite seplog.corable_andp_sepcon1 in AT; swap 1 2.
-  { apply corable_weak_exclusive. }
+  rewrite seplog.corable_andp_sepcon1 in AT by (apply conclib.corable_weak_exclusive).
   destruct AT as (Hexclusive, AT).
   rewrite seplog.sepcon_comm in AT.
   rewrite seplog.sepcon_emp in AT.
   destruct AT as (IsPtr, AT).
   destruct vx as [ | | | | | b ofs ]; try inversion IsPtr; [ clear IsPtr ].
 
-  assert (Eargs : args = Vptr b ofs :: nil)
-    by (eapply shape_of_args; eauto).
+  assert (Eargs : args = Vptr b ofs :: nil) by auto.
 
   destruct AT as (phi0lockinv & phi0sat & jphi0 & Hlockinv & Hsat).
 
   assert (locked : lockRes tp (b, Ptrofs.intval ofs) = Some None). {
     specialize (lock_coh (b, Ptrofs.intval ofs)). cleanup.
     destruct (AMap.find _ _) as [[phi_sat|]|] eqn:Ephi_sat; [ exfalso | reflexivity | exfalso ].
-    - destruct lock_coh as (_&_&_&R&lk&[sat|?]). 2:omega.
+    - destruct lock_coh as (_&_&_&R&lk&[sat|?]); [|lia].
 
       assert (J0 : join_sub phi0 Phi). {
         apply join_sub_trans with (getThreadR i tp cnti). eexists; eauto.
@@ -194,59 +181,45 @@ Proof.
       pose proof predat4 Hlockinv as E3.
       apply (predat_join_sub J01) in E3.
 
-      pose proof exclusive_joins_false
-           (approx (level Phi) Rx) (age_by 1 phi_sat) (age_by 1 phi0sat) as PP.
-      apply PP.
-      + (* exclusive *)
-        apply exclusive_approx with (n := level Phi) in Hexclusive.
-        rewrite (compose_rewr (approx _) (approx _)) in Hexclusive.
-        replace (level phi0) with (level Phi) in Hexclusive. 2:join_level_tac.
-        exact_eq Hexclusive; f_equal.
-        rewrite approx_oo_approx'. auto. omega.
-
-      + (* sat 1 *)
-        split.
-        * rewrite level_age_by. rewrite Ra. omega.
-        * revert sat.
-          apply approx_eq_app_pred with (level Phi).
-          -- rewrite level_age_by. rewr (level phi_sat). omega.
-          -- eapply predat_inj; eauto.
-             apply predat6 in lk; eauto.
-             exact_eq E3. f_equal. f_equal. auto.
-
-      + (* sat 2 *)
-        split.
-        -- rewrite level_age_by. cut (level phi0sat = level Phi). omega. join_level_tac.
-        -- (* cut (app_pred (Interp Rx) (age_by 1 phi0sat)).
-           ++ apply approx_eq_app_pred with (S n).
-              ** rewrite level_age_by. rewrite Ra0. omega.
-              ** pose proof (predat_inj E1 E3) as G.
-                 exact_eq G; do 2 f_equal; auto.
-                 omega.
-           ++ *)
-           revert Hsat. apply age_by_ind.
-           destruct Rx.
-           auto.
-
-      + (* joins *)
-        apply age_by_joins.
+      assert (joins (age_by 1 phi_sat) (age_by 1 phi0sat)) as [phi' J].
+      { apply age_by_joins.
         apply joins_sym.
         eapply @join_sub_joins_trans with (c := phi0); auto. apply Perm_rmap.
         * exists phi0lockinv. apply join_comm. auto.
         * eapply @join_sub_joins_trans with (c := getThreadR i tp cnti); auto. apply Perm_rmap.
           -- exists phi1. auto.
           -- eapply compatible_threadRes_lockRes_join. apply (mem_compatible_forget compat).
-             apply Ephi_sat.
+             apply Ephi_sat. }
+      specialize (Hexclusive phi').
+      spec Hexclusive.
+      { apply join_level in J as [].
+        destruct J0 as [? J0]; apply join_level in J0 as [].
+        destruct Ja as [? Ja]; apply join_level in Ja as [].
+        rewrite level_age_by in *; lia. }
+      specialize (Hexclusive _ _ (necR_refl _) (ext_refl _)); apply Hexclusive.
+      eexists; eexists; split; eauto; split.
+
+      + (* sat 1 *)
+        revert sat.
+        apply approx_eq_app_pred with (level Phi).
+        -- rewrite level_age_by. rewr (level phi_sat). lia.
+        -- eapply predat_inj; eauto.
+           apply predat6 in lk; eauto.
+           exact_eq E3. f_equal. f_equal. auto.
+
+      + (* sat 2 *)
+        revert Hsat. apply age_by_ind.
+        apply pred_hereditary.
 
     - (* not a lock: impossible *)
       simpl in Hlockinv.
       unfold lock_inv in *.
-      destruct Hlockinv as (b_ & ofs_ & E_ & HH & _).
+      destruct Hlockinv as (b_ & ofs_ & E_ & HH).
       specialize (HH (b, Ptrofs.intval ofs)).
       simpl in HH.
       change Ptrofs.intval with Ptrofs.unsigned in *.
       injection E_ as <- <- .
-      if_tac [r|nr] in HH. 2:range_tac.
+      if_tac [r|nr] in HH; [|range_tac].
       destruct HH as (p & HH).
       assert (j : join_sub phi0lockinv Phi). {
         apply join_sub_trans with phi0. eexists; eauto.
@@ -288,20 +261,19 @@ Proof.
     with (Htid := cnti); auto.
 
     eapply step_freelock
-    with (c := ci) (Hcompat := mem_compatible_forget compat)
-                   (R := Rx) (phi'0 := phi').
+    with (Hcompat := mem_compatible_forget compat)
+                   (R := Rx) (phi' := phi').
     all: try reflexivity.
     all: try eassumption.
-    apply (mem_compatible_forget compat).
   }
 
   (* we move on to the preservation part *)
 
   simpl (m_phi _).
   assert (Ephi : level (getThreadR _ _ cnti) = S n). {
-    rewrite getThread_level with (Phi0 := Phi). auto. apply compat.
+    rewrite getThread_level with (Phi := Phi). auto. apply compat.
   }
-  assert (El : (level (getThreadR _ _ cnti) - 1 = n)%nat) by omega.
+  assert (El : (level (getThreadR _ _ cnti) - 1 = n)%nat) by lia.
   cleanup.
   rewrite El.
 
@@ -323,31 +295,31 @@ Proof.
     rewrite (age_resource_at APhi' (loc := loc)) in E''.
     destruct (Phi' @ loc); simpl in E''; try congruence.
     injection E''; intros <- <- <- ; eexists; split. apply YES_ext. reflexivity.
-    rewrite level_age_to. 2:omega. reflexivity.
+    rewrite level_age_to by lia. reflexivity.
   }
 
-  assert (mcompat' : mem_compatible_with' (age_tp_to n (remLockSet (updThread i tp cnti (Kresume ci Vundef) phi') (b, Ptrofs.intval ofs))) m (age_to n Phi')).
+  assert (mcompat' : mem_compatible_with' (age_tp_to n (remLockSet (updThread i tp cnti (Kresume (Callstate f l cont) Vundef) phi') (b, Ptrofs.intval ofs))) m (age_to n Phi')).
   {
     constructor.
     + (* join_all *)
       (* rewrite <-Hpersonal_juice. autospec El. cleanup. rewrite El. *)
-      apply join_all_age_to. cleanup. omega.
+      apply join_all_age_to. cleanup. lia.
       pose proof juice_join compat as j.
       rewrite join_all_joinlist.
       rewrite join_all_joinlist in j.
       rewrite maps_remLockSet_updThread.
       rewrite maps_updthread.
-      rewrite <-(maps_getlock2 _ (b, Ptrofs.unsigned ofs)) in j. 2:eassumption.
+      rewrite <-(maps_getlock2 _ (b, Ptrofs.unsigned ofs)) in j by eassumption.
       assert (cnti' : containsThread (remLockSet tp (b, Ptrofs.unsigned ofs)) i) by auto.
-      rewrite maps_getthread with (i0 := i) (cnti0 := cnti') in j.
+      rewrite maps_getthread with (i := i) (cnti := cnti') in j.
       change Ptrofs.intval with Ptrofs.unsigned.
       clear Post B1.
       eapply (joinlist_merge phi0' phi1). apply j'.
       apply join_comm in jphi0'.
       eapply (joinlist_merge _ phi0lockinv' phi0'). apply jphi0'.
       REWR in j.
-      rewrite <-joinlist_merge in j. 2: apply Join.
-      rewrite <-joinlist_merge in j. 2: apply jphi0.
+      rewrite <-joinlist_merge in j by apply Join.
+      rewrite <-joinlist_merge in j by apply jphi0.
       rewrite joinlist_swap.
       destruct j as (xi_ & jxi_ & jx1).
       pose proof rmap_freelock_join _ _ _ _ _ _ _ _ Hpos Hrmap00 jx1 as Hrmap1.
@@ -423,16 +395,16 @@ Proof.
       rewrite AMap_find_remove. if_tac [<- | ne].
       * exfalso.
         destruct Hrmap' as (_ & outside & inside & _).
-        specialize (inside (b, Ptrofs.intval ofs)). spec inside. now split; auto; unfold Ptrofs.unsigned; omega.
+        specialize (inside (b, Ptrofs.intval ofs)). spec inside. now split; auto; unfold Ptrofs.unsigned; lia.
         breakhyps.
         unfold Ptrofs.unsigned in *. rewrite Z.sub_diag in H7.
-        destruct (E'' 0) as [? [? [? E3]]]. pose proof LKSIZE_pos; omega.
+        destruct (E'' 0) as [? [? [? E3]]]. pose proof LKSIZE_pos; lia.
         rewrite age_to_resource_at in E3. simpl in E3. rewrite Z.add_0_r in E3.
         rewrite H5 in E3.
         discriminate.
       *
        apply (jloc_in_set compat loc).
-       intros.  
+       intros.
         destruct Hrmap' as (_ & outside & inside & _).
         rewrite outside.
         destruct (E'' _ H) as [? [? [? E3]]].
@@ -466,7 +438,7 @@ Proof.
              exfalso. destruct inside as [sh [psh [? [? inside]]]].
              specialize (J _ H0). destruct J as [? [? [? [? J]]]]. rewrite inside in J. inv J.
              destruct loc,a; subst. simpl in H5,H6.
-             apply H; simpl; f_equal. unfold Ptrofs.unsigned in *; omega.
+             apply H; simpl; f_equal. unfold Ptrofs.unsigned in *; lia.
         -- intros. specialize (J _ H0). destruct J as [sh2 [psh2 [P2 [? J]]]].
              exists sh2, psh2. eexists; split; auto. 
              rewrite outside in J.
@@ -476,22 +448,21 @@ Proof.
   left.
   unshelve eapply state_invariant_c with (PHI := age_to n Phi') (mcompat := mcompat').
   - (* level *)
-    apply level_age_to. omega.
+    apply level_age_to. lia.
 
   - (* env_coherence *)
     apply env_coherence_age_to.
-    apply env_coherence_pures_eq with Phi; auto. omega.
+    apply env_coherence_pures_eq with Phi; auto. lia.
     apply pures_same_pures_eq. auto.
     eapply rmap_freelock_pures_same; eauto.
-  - auto.
-  - rewrite age_to_ghost_of.
+  - unfold ext_compat; rewrite age_to_ghost_of.
     destruct Hrmap' as (? & ? & ? & <-).
     destruct extcompat as [? J]; eapply ghost_fmap_join in J; eexists; eauto.
 
   - (* lock sparsity *)
     apply lock_sparsity_age_to.
     clear -sparse.
-    intros loc1 loc2. cleanup. simpl. do 2 rewrite AMap_find_remove.
+    intros loc1 loc2. cleanup. simpl. rewrite !AMap_find_remove.
     specialize (sparse loc1 loc2).
     if_tac; if_tac; eauto.
 
@@ -504,7 +475,7 @@ Proof.
     if_tac; simpl.
     + destruct Hrmap' as (_ & _ & inside & _).
       specialize (inside loc). subst loc. rewrite isLK_age_to.
-      spec inside. split; auto; unfold Ptrofs.unsigned in *; omega.
+      spec inside. split; auto; unfold Ptrofs.unsigned in *; lia.
       unfold Ptrofs.unsigned in *.
       destruct inside as (sh & rsh & ? & wsh & ?). intros HH.
       unfold isLK in *. breakhyps.
@@ -531,7 +502,7 @@ Proof.
           zify.
           lkomega.
         }
-        destruct lock_coh_ as (LOAD & align & bound & R & lk & [sat | ?]). 2:omega.
+        destruct lock_coh_ as (LOAD & align & bound & R & lk & [sat | ?]); [|lia].
         split; [ | split; [ | split ]]; auto.
         -- (* use sparsity to prove the load_at is the same *)
            clear -LOAD SparseX locked sparse.
@@ -539,11 +510,11 @@ Proof.
            destruct loc as (b0, ofs0); simpl in LOAD |- *.
            Transparent Mem.load.
            unfold Mem.load in *.
-           if_tac [v1|nv1] in LOAD. 2:discriminate.
+           if_tac [v1|nv1] in LOAD; [|discriminate].
            if_tac [v2|nv2].
            ++ rewrite restrPermMap_mem_contents in *. auto.
            ++ destruct nv2. clear LOAD.
-              split. 2:apply v1. destruct v1 as [v1 _].
+              split; [|apply v1]. destruct v1 as [v1 _].
               intros ofs1 r1. specialize (v1 ofs1 r1).
               unfold Mem.perm in *.
               pose proof restrPermMap_Cur as RR.
@@ -559,12 +530,11 @@ Proof.
               specialize (SparseX (b0, ofs0)). spec SparseX. split; auto; lkomega.
               unfold Mem.valid_access in *.
               unfold Mem.range_perm in *.
-              erewrite AMap_Equal_PMap_eq in v1.
-              2: apply AMap_remove_add; eauto.
+              erewrite AMap_Equal_PMap_eq in v1 by (apply AMap_remove_add; eauto).
               rewrite A2PMap_add_outside in v1.
-              if_tac [r|nr] in v1. 2:assumption.
+              if_tac [r|nr] in v1; [|assumption].
               exfalso.
-              specialize (SparseX' (b0, ofs1)). spec SparseX'. split; auto; lkomega.
+              specialize (SparseX' (b0, ofs1)). spec SparseX'. split; auto; unfold LKSIZE; lkomega.
               destruct r; subst b0. simpl in sparse.
               destruct sparse. contradiction H; auto. destruct H as [_ sparse].
               red in sparse.
@@ -575,7 +545,7 @@ Proof.
               assert (~ (Ptrofs.unsigned ofs <= ofs1 < Ptrofs.unsigned ofs + LKSIZE)%Z)
                       by (contradict SparseX'; auto).
               clear - r1 H0 H H1 sparse.
-              omega.
+              lia.
         -- exists R; split.
            ++ (* sparsity again, if easier or just the rmap_freelock *)
               intros x r.
@@ -588,20 +558,20 @@ Proof.
               destruct sparse. contradiction H; auto. destruct H as [_ sparse].
               change Ptrofs.intval with Ptrofs.unsigned in *.
               red in sparse.
-              destruct (Zabs_dec (z - Ptrofs.unsigned ofs)); omega.
+              destruct (Zabs_dec (z - Ptrofs.unsigned ofs)); lia.
               rewrite age_to_resource_at.
               rewrite <-outside. clear outside.
               unfold sync_preds_defs.pack_res_inv in *.
               rewrite level_age_to.
               ** breakhyps.
                  all: rewr (Phi @ x); simpl; eauto.
-                 all: rewrite approx_approx'; eauto; omega.
-              ** omega.
+                 all: rewrite approx_approx'; eauto; lia.
+              ** lia.
            ++ left. unfold age_to.
-              replace (level uphi) with (level Phi); swap 1 2.
-              { symmetry. eapply join_all_level_lset. apply compat. eassumption. }
-              rewrite En. replace (S n - n)%nat with 1%nat by omega.
+              replace (level uphi) with (level Phi).
+              rewrite En. replace (S n - n)%nat with 1%nat by lia.
               apply pred_age1', sat.
+              { symmetry. eapply join_all_level_lset. apply compat. eassumption. }
 
       * (* Lock found, unlocked *)
         specialize (sparse loc (b, Ptrofs.intval ofs)). rewrite locked in sparse. rewrite Eo in sparse.
@@ -629,11 +599,11 @@ Proof.
            unfold load_at in *.
            destruct loc as (b0, ofs0); simpl in LOAD |- *.
            unfold Mem.load in *.
-           if_tac [v1|nv1] in LOAD. 2:discriminate.
+           if_tac [v1|nv1] in LOAD; [|discriminate].
            if_tac [v2|nv2].
            ++ rewrite restrPermMap_mem_contents in *. auto.
            ++ destruct nv2. clear LOAD.
-              split. 2:apply v1. destruct v1 as [v1 _].
+              split; [|apply v1]. destruct v1 as [v1 _].
               intros ofs1 r1. specialize (v1 ofs1 r1).
               unfold Mem.perm in *.
               pose proof restrPermMap_Cur as RR.
@@ -650,13 +620,12 @@ Proof.
               unfold Mem.valid_access in *.
               unfold Mem.range_perm in *.
               (* say that "lset = ADD (REMOVE lset)" and use result about ADD? *)
-              erewrite AMap_Equal_PMap_eq in v1.
-              2: apply AMap_remove_add; eauto.
+              erewrite AMap_Equal_PMap_eq in v1 by (apply AMap_remove_add; eauto).
               rewrite A2PMap_add_outside in v1.
-              if_tac [r|nr] in v1. 2:assumption.
+              if_tac [r|nr] in v1; [|assumption].
               exfalso.
-              specialize (SparseX' (b0, ofs1)). spec SparseX'. split; auto; lkomega.
-              simpl in sparse. 
+              specialize (SparseX' (b0, ofs1)). spec SparseX'. split; auto; unfold LKSIZE; lkomega.
+              simpl in sparse.
               destruct r; subst b0.
               clear - SparseX SparseX' H0 r1 sparse. simpl in *.
               destruct sparse. contradiction H; auto. destruct H as [_ sparse].
@@ -665,7 +634,7 @@ Proof.
                       by (contradict SparseX; auto).
               assert (~ (Ptrofs.unsigned ofs <= ofs1 < Ptrofs.unsigned ofs + LKSIZE)%Z)
                       by (contradict SparseX'; auto).
-              clear - r1 H0 H H1 sparse. omega.
+              clear - r1 H0 H H1 sparse. lia.
         -- exists R.
            (* sparsity again, if easier or just the rmap_freelock *)
            intros x r.
@@ -678,15 +647,15 @@ Proof.
               destruct sparse. contradiction H; auto. destruct H as [_ sparse].
               change Ptrofs.intval with Ptrofs.unsigned in *.
               red in sparse.
-              destruct (Zabs_dec (z - Ptrofs.unsigned ofs)); omega.
+              destruct (Zabs_dec (z - Ptrofs.unsigned ofs)); lia.
            rewrite age_to_resource_at.
            rewrite <-outside. clear outside.
            unfold sync_preds_defs.pack_res_inv in *.
            rewrite level_age_to.
            ++ breakhyps.
               all: rewr (Phi @ x); simpl; eauto.
-              all: rewrite approx_approx'; eauto; omega.
-           ++ omega.
+              all: rewrite approx_approx'; eauto; lia.
+           ++ lia.
 
       * (* Lock not found, unlocked *)
         rewrite age_to_resource_at.
@@ -721,15 +690,13 @@ Proof.
           destruct Post with
           (ret := @None val)
             (m' := jm')
-            (z' := ora) (n' := n) as (c'' & Ec'' & Safe').
+            (z' := ora) as (c'' & Ec'' & Safe').
 
           + auto.
 
           + simpl.
             apply Logic.I.
 
-          + auto.
-
           + (* proving Hrel *)
             hnf.
             assert (n = level jm'). {
@@ -739,19 +706,17 @@ Proof.
               REWR.
               REWR.
               rewrite level_age_to; auto.
-              replace (level phi') with (level Phi). omega.
+              replace (level phi') with (level Phi). lia.
               transitivity (level (getThreadR i tp cnti)); join_level_tac.
             }
             assert (level phi' = S n). {
-              cleanup. replace (level phi') with (S n). omega. join_level_tac.
+              cleanup. replace (level phi') with (S n). lia. join_level_tac.
             }
 
-            split; [ | split].
-            * auto.
-            * rewr (level jm'). rewrite level_jm_. cleanup. omega.
-            * simpl. rewrite Ejm'. do 3 REWR.
-              eapply pures_same_eq_l.
-              2:apply pures_eq_age_to; omega.
+            split.
+            * rewr (level jm'). rewrite level_jm_. cleanup. lia.
+            * simpl. rewrite Ejm'. REWR. REWR. REWR.
+              eapply pures_same_eq_l; [|apply pures_eq_age_to; lia].
               apply pures_same_trans with phi1.
               -- apply pures_same_sym. apply join_sub_pures_same. exists phi0'. apply join_comm. assumption.
               -- apply join_sub_pures_same. exists phi0. apply join_comm. assumption.
@@ -764,7 +729,7 @@ Proof.
               apply age_to_join.
               REWR.
               REWR.
-            * split3. 2: now eapply necR_trans; [ eassumption | apply age_to_necR ].
+            * split; [|now eapply necR_trans; [ eassumption | apply age_to_necR ]].
               split. now constructor.
               split. now constructor.
               simpl. rewrite seplog.sepcon_emp.
@@ -775,30 +740,19 @@ Proof.
               apply age_to_pred.
               assumption.
               apply age_to_pred. assumption.
-              unshelve setoid_rewrite <- getThreadR_age; auto.
-              rewrite age_to_ghost_of.
-              unshelve erewrite gRemLockSetRes; auto.
-              rewrite gssThreadRes.
-              apply ghost_of_join in Join; apply ghost_of_join in j'.
-              destruct Hrmap0 as (_ & _ & _ & Hg); rewrite Hg in Join.
-              eapply join_eq in Join; eauto.
-              destruct ora.
-              rewrite Join; apply ext_join_approx; auto.
-          + exact_eq Safe'.
-            unfold jsafeN.
-            f_equal.
-            congruence.
+          + simpl in Ec'.
+            destruct f; inv Ec'; inv Ec''.
+            apply Safe'.
       }
 
     * repeat REWR.
       destruct (getThreadC j tp lj) eqn:Ej.
       -- edestruct (unique_Krun_neq(ge := ge) i j); eauto.
-      -- apply jsafe_phi_age_to; auto. apply jsafe_phi_downward. assumption.
-      -- intros c' Ec'; specialize (safety c' Ec'). apply jsafe_phi_bupd_age_to; auto. apply jsafe_phi_bupd_downward. assumption.
-      -- destruct safety as (? & q_new & Einit & safety).
-         split; auto.
+      -- apply jsafe_phi_age_to; auto.
+      -- intros c' Ec'; specialize (safety c' Ec'). apply jsafe_phi_fupd_age_to; auto.
+      -- destruct safety as (q_new & Einit & safety).
          exists q_new; split; auto.
-         apply jsafe_phi_age_to; auto. apply jsafe_phi_downward, safety.
+         apply jsafe_phi_fupd_age_to; auto.
     }
 
   - (* threads_wellformed *)
@@ -808,10 +762,8 @@ Proof.
     unshelve erewrite gRemLockSetCode; auto.
     destruct (eq_dec i j).
     + subst j.
-      rewrite gssThreadCode.
-      replace lj with cnti in wellformed by apply proof_irr.
-      simpl in wellformed; rewrite Eci in wellformed.
-      destruct ci; auto.
+      rewrite gssThreadCode; simpl.
+      rewrite atex; split; auto; discriminate.
     + unshelve erewrite gsoThreadCode; auto.
 
   - (* unique_Krun *)
diff --git a/concurrency/juicy/semax_safety_makelock.v b/concurrency/juicy/semax_safety_makelock.v
index b51a3ef977..31a5f5f472 100644
--- a/concurrency/juicy/semax_safety_makelock.v
+++ b/concurrency/juicy/semax_safety_makelock.v
@@ -10,19 +10,12 @@ Require Import compcert.common.Values.
 
 Require Import VST.msl.Coqlib2.
 Require Import VST.msl.eq_dec.
-Require Import VST.msl.seplog.
-Require Import VST.msl.age_to.
-Require Import VST.veric.aging_lemmas.
-Require Import VST.veric.initial_world.
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.juicy_mem_lemmas.
 Require Import VST.veric.semax_prog.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.Clight_new.
-Require Import VST.veric.Clightnew_coop.
+Require Import VST.veric.Clight_core.
+Require Import VST.veric.Clightcore_coop.
 Require Import VST.veric.semax.
-Require Import VST.veric.semax_ext.
-Require Import VST.veric.juicy_extspec.
 Require Import VST.veric.juicy_safety.
 Require Import VST.veric.initial_world.
 Require Import VST.veric.juicy_extspec.
@@ -31,7 +24,6 @@ Require Import VST.veric.semax_ext.
 Require Import VST.veric.res_predicates.
 Require Import VST.veric.mem_lessdef.
 Require Import VST.veric.shares.
-Require Import VST.veric.age_to_resource_at.
 Require Import VST.floyd.coqlib3.
 Require Import VST.floyd.field_at.
 Require Import VST.sepcomp.step_lemmas.
@@ -47,11 +39,7 @@ Require Import VST.concurrency.common.addressFiniteMap.
 Require Import VST.concurrency.common.permissions.
 Require Import VST.concurrency.juicy.JuicyMachineModule.
 Require Import VST.concurrency.juicy.sync_preds_defs.
-Require Import VST.concurrency.juicy.sync_preds.
 Require Import VST.concurrency.juicy.join_lemmas.
-(*Require Import VST.concurrency.cl_step_lemmas.
-Require Import VST.concurrency.resource_decay_lemmas.
-Require Import VST.concurrency.resource_decay_join.*)
 Require Import VST.concurrency.juicy.semax_invariant.
 Require Import VST.concurrency.juicy.semax_simlemmas.
 Require Import VST.concurrency.juicy.sync_preds.
@@ -102,7 +90,7 @@ Proof.
   assert (Hpos : (0 < LKSIZE)%Z) by reflexivity.
   intros ismakelock.
   intros I.
-  inversion I as [m tr sch_ tp Phi En envcoh mwellformed compat extcompat sparse lock_coh safety wellformed unique E]. rewrite <-E in *.
+  inversion I as [m tr sch_ tp Phi En envcoh (*mwellformed*) compat extcompat sparse lock_coh safety wellformed unique invcompat E]. rewrite <-E in *.
   unfold blocked_at_external in *.
   destruct ismakelock as (i & cnti & sch & ci & args & -> & Eci & atex).
   pose proof (safety i cnti tt) as safei.
@@ -110,11 +98,12 @@ Proof.
   rewrite Eci in safei.
 
   fixsafe safei.
+  destruct ci as [| ?? k |]; try discriminate.
   inversion safei
-    as [ | ?????? bad | n0 z c m0 e args0 x at_ex Pre SafePost | ????? bad ].
+    as [ | ????? bad | z c m0 e args0 x at_ex Pre SafePost | ???? bad ]; last contradiction.
+  { rewrite level_jm_ in H; setoid_rewrite H in En; discriminate. }
   apply (corestep_not_at_external (juicy_core_sem _)) in bad. exfalso; subst; clear - bad atex.
    simpl in bad. unfold cl_at_external in *; simpl in *. rewrite atex in bad; inv bad.
-  2: inversion bad.
   subst.
   simpl in at_ex.
   unfold cl_at_external in atex, at_ex.
@@ -137,11 +126,11 @@ Proof.
   simpl (and _).
   intros Post.
 
-  destruct Precond as [[Hwritable _] [[[B1 _] _] AT]].
+  destruct Precond as [[Hwritable _] [B1 [_ AT]]].
   assert (Hreadable : readable_share shx) by (apply writable_readable; auto).
 
   (* [data_at_] from the precondition *)
-  unfold canon.SEPx in *.
+  unfold SeparationLogic.argsassert2assert, canon.SEPx in *.
   simpl in AT.
   rewrite seplog.sepcon_emp in AT.
 
@@ -153,10 +142,9 @@ Proof.
   destruct AT as (IsPtr, AT).
   destruct vx as [ | | | | | b ofs ]; try inversion IsPtr; [ clear IsPtr ].
 
-  assert (Eargs : args = Vptr b ofs :: nil)
-    by (eapply shape_of_args; eauto).
+  assert (Eargs : args = Vptr b ofs :: nil) by auto.
 
-  assert (Hm' : exists m', Mem.store Mint32 (m_dry (personal_mem _ _ (thread_mem_compatible (mem_compatible_forget compat) cnti))) b (Ptrofs.intval ofs) (Vint Int.zero) = Some m'). {
+  assert (Hm' : exists m', Mem.store Mptr (m_dry (personal_mem _ _ (thread_mem_compatible (mem_compatible_forget compat) cnti))) b (Ptrofs.intval ofs) (Vptrofs Ptrofs.zero) = Some m'). {
     clear -AT Join Hwritable.
     unfold tlock in AT.
     destruct AT as (AT1, AT2).
@@ -176,36 +164,33 @@ Proof.
      *)
     unfold SeparationLogic.mapsto in *.
     simpl in B.
-    destruct (readable_share_dec shx) as [n|n]. 2: now destruct n; apply writable_readable; auto.
-    autorewrite with norm in B.
-    rewrite !FF_orp in B.
-    autorewrite with norm in B.
-    destruct B as [v1' B]. 
-    autorewrite with norm in B.
-    destruct B as [v2' B]. 
-    rewrite !TT_andp in B.
-    apply mapsto_can_store with (v := v2') (sh := shx); try assumption.
+    destruct (readable_share_dec shx) as [n|n]; [|now destruct n; apply writable_readable; auto].
+    rewrite log_normalize.prop_false_andp, FF_orp, log_normalize.prop_true_andp, log_normalize.prop_false_andp, FF_orp, log_normalize.prop_true_andp in B by auto.
+    rewrite log_normalize.exp_sepcon1 in B; destruct B as [v1' B].
+    rewrite log_normalize.exp_sepcon2 in B; destruct B as [v2' B].
+    rewrite !reptype_lemmas.ptrofs_add_repr_0_r in B.
+    apply mapsto_can_store with (v := v1') (sh := shx); try assumption.
     auto.
     simpl (m_phi _).
     destruct B as [phi0a [phi0b [? [? ?]]]].
     destruct (join_assoc H Join) as [f [? ?]].
-    exists phi0a, f; split; auto.
+    exists phi0a, f; split; auto; split; auto.
   }
   destruct Hm' as (m', Hstore).
 
   unfold tlock in *.
-  match type of AT with context[Tarray _ ?n] => assert (Hpos' : (0 < n)%Z) by omega end.
+  match type of AT with context[Tarray _ ?n] => assert (Hpos' : (0 < n)%Z) by lia end.
   pose proof data_at_rmap_makelock CS as RL.
   specialize (RL shx b ofs Rx phi0 _ Hpos' (writable_writable0 Hwritable) AT).
   destruct RL as (phi0' & RL0 & Hlkat).
 
-  match type of Hlkat with context[LK_at _ ?n] => assert (Hpos'' : (0 < n)%Z) by (rewrite size_chunk_Mptr in *; destruct Archi.ptr64; omega) end.
+  match type of Hlkat with context[LK_at _ ?n] => assert (Hpos'' : (0 < n)%Z) by (rewrite size_chunk_Mptr in *; destruct Archi.ptr64; lia) end.
   pose proof rmap_makelock_join _ _ _ _ _ _ _ Hpos'' RL0 Join as Hrmap.
   pose proof Hrmap as Hrmap_.
   destruct Hrmap_ as (phi' & RLphi & j').
   pose proof juice_join compat as j.
   rewrite join_all_joinlist in j.
-  rewrite maps_getthread with (cnti0 := cnti) in j.
+  rewrite maps_getthread with (cnti := cnti) in j.
   destruct j as (psi & jpsi1 & jpsi).
   pose proof rmap_makelock_join _ _ _ _ _ _ _ Hpos'' RLphi jpsi as Hrmap'.
   destruct Hrmap' as (Phi' & Hrmap' & J').
@@ -220,9 +205,8 @@ Proof.
     eapply JuicyMachine.sync_step
     with (Htid := cnti) (Hcmpt := mem_compatible_forget compat); auto.
 
-    eapply step_mklock
-    with (c := ci) (Hcompatible := mem_compatible_forget compat)
-                   (R := Rx) (phi'0 := phi');
+    eapply step_mklock with (Hcompat := mem_compatible_forget compat)
+                   (R := Rx) (phi' := phi');
     try eassumption; try reflexivity.
     subst tpx; reflexivity.
   }
@@ -232,9 +216,9 @@ Proof.
 
   unfold personal_mem, m_phi.
   assert (Ephi : level (getThreadR _ _ cnti) = S n). {
-    rewrite getThread_level with (Phi0 := Phi). auto. apply compat.
+    rewrite getThread_level with (Phi := Phi). auto. apply compat.
   }
-  replace (level (getThreadR _ _ cnti) - 1)%nat with n by omega.
+  replace (level (getThreadR _ _ cnti) - 1)%nat with n by lia.
 
   (*
   assert (j : join_sub (getThreadR i tp cnti) Phi) by apply compatible_threadRes_sub, compat.
@@ -246,7 +230,7 @@ Proof.
 
   assert (notfound : lockRes tp (b, Ptrofs.intval ofs) = None). {
     specialize (lock_coh (b, Ptrofs.intval ofs)). cleanup.
-    destruct (AMap.find _ _) as [o|] eqn:Eo. 2:reflexivity. exfalso.
+    destruct (AMap.find _ _) as [o|] eqn:Eo; [|reflexivity]. exfalso.
     assert (C : exists (R : pred rmap), (lkat R (b, Ptrofs.intval ofs)) Phi)
       by (destruct o; breakhyps; eauto). clear lock_coh.
     destruct C as (R' & At).
@@ -269,7 +253,7 @@ Proof.
                pp' = preds_fmap (approx n) (approx n) pp).
   {
     destruct Hrmap.
-    intros sh psh k pp' loc nr E''.
+    intros sh psh ? pp' loc nr E''.
     destruct Hrmap' as (_ & E & _).
     rewrite E; eauto.
     rewrite (age_resource_at APhi' (loc := loc)) in E''.
@@ -277,20 +261,20 @@ Proof.
     injection E''; intros <- <- <-.
     apply YES_inj in E''. exists p; simpl.
     split. apply YES_ext; reflexivity.
-    rewrite level_age_to. 2:omega. reflexivity.
+    rewrite level_age_to by lia. reflexivity.
   }
 
-
+  set (ci := Callstate f l k).
   assert (mcompat' : mem_compatible_with' (age_tp_to n (updLockSet (updThread i tp cnti (Kresume ci Vundef) phi') (b, Ptrofs.intval ofs) None)) m' (age_to n Phi')). {
     constructor.
     + (* join_all *)
       (* rewrite <-Hpersonal_juice. autospec El. cleanup. rewrite El. *)
-      apply join_all_age_to. cleanup. omega.
+      apply join_all_age_to. cleanup. lia.
       rewrite join_all_joinlist.
       rewrite maps_updlock1.
       rewrite maps_remLockSet_updThread.
       rewrite maps_updthread.
-      rewrite maps_getlock1. 2:assumption.
+      rewrite maps_getlock1 by assumption.
       exists psi; auto.
 
     + (* mem_cohere' *)
@@ -311,7 +295,7 @@ Proof.
              specialize (outside b1 ofs1).
              destruct outside as [(->, r) | same].
              - exfalso. apply nr. split; auto.
-                change Ptrofs.unsigned with Ptrofs.intval; lkomega.
+                change Ptrofs.unsigned with Ptrofs.intval; unfold LKSIZE; lkomega.
              - rewrite <-same.
                unfold personal_mem.
                change (m_dry (mkJuicyMem ?m _ _ _ _ _)) with m.
@@ -324,24 +308,24 @@ Proof.
         intros loc; specialize (M loc).
         rewrite perm_of_res'_age_to.
         clear Post.
-        replace (max_access_at m' loc) with (max_access_at m loc); swap 1 2. {
-          evar (m1 : mem).
-          transitivity (max_access_at m1 loc); swap 1 2; subst m1.
-          - unfold max_access_at in *.
-            apply equal_f.
-            apply equal_f.
-            eapply store_access; eauto.
-          - apply juicyRestrictMax.
-        }
+        replace (max_access_at m' loc) with (max_access_at m loc).
         exact_eq M. f_equal.
         destruct Hrmap' as (_ & Same & Changed & _).
         specialize (Same loc). specialize (Changed loc).
-        destruct (adr_range_dec (b, Ptrofs.unsigned ofs) (4 * 2) loc) as [r|nr].
+        match goal with H : ~ adr_range ?a ?b ?c -> _ |- _ =>
+          destruct (adr_range_dec a b c) as [r|nr] end.
         -- autospec Changed.
            destruct Changed as (val & sh & rsh & ? & ? & ?).
            rewrite H; rewrite H1; reflexivity.
         -- autospec Same. rewrite <-Same.
            reflexivity.
+        -- evar (m1 : mem).
+           transitivity (max_access_at m1 loc); subst m1.
+           - apply juicyRestrictMax.
+           - unfold max_access_at in *.
+             apply equal_f.
+             apply equal_f.
+             eapply store_access, Hstore.
 
       * (* alloc_cohere *)
         pose proof all_coh ((all_cohere compat)) as A.
@@ -393,7 +377,7 @@ Proof.
         destruct inside as (val & sh & rsh & E & ? & ?).
         rewrite E in C.
         unfold max_access_at in *.
-        eapply po_trans. eassumption.
+        eapply mem_lemmas.po_trans. eassumption.
         unfold perm_of_res' in *.
         unfold perm_of_sh in *.
         repeat if_tac; try constructor; tauto.
@@ -412,16 +396,16 @@ Proof.
       destruct (rmap_unage_YES _ _ _ _ _ _ _ APhi' E'') as (pp, E').
       destruct Hrmap' as (_ & outside & inside & _).
       rewrite <- outside in E'. rewrite E'. eauto.
-      change (size_chunk Mptr * 2) with LKSIZE in *.
+      fold LKSIZE in *.
       clear - Hpos I compat sparse lock_coh AT HnecR RL0 Hlkat RLphi j' jpsi1 jpsi J' notfound APhi' ne H0 E'.
       specialize (Hlkat (fst loc, snd loc + i0)).
-      intro. rewrite if_true in Hlkat by apply H. destruct Hlkat as [?rsh Hlkat]. simpl in Hlkat.
+      intro. simpl in Hlkat. rewrite if_true in Hlkat by apply H. destruct Hlkat as [?rsh Hlkat]. simpl in Hlkat.
       assert (join_sub phi0' Phi') by (eapply join_sub_trans; eexists; eassumption).
       apply (resource_at_join_sub _ _ (fst loc, snd loc + i0)) in H1.
       rewrite Hlkat, E' in H1. inv H1.
       destruct loc as [b0 ofs0]. simpl in *. destruct H. subst b0. assert (Ptrofs.intval ofs <> ofs0) by congruence.
       unfold Ptrofs.unsigned in *.
-      inv H2. omega. omega.
+      inv H2. lia. lia.
     + (* lockSet_in_juicyLocks *)
       cleanup.
       pose proof lset_in_juice compat as J.
@@ -434,27 +418,25 @@ Proof.
       * intros []. subst loc. change Ptrofs.intval with Ptrofs.unsigned in *.
          exists Share.Rsh. intros. simpl.
         destruct Hrmap' as (_ & _ & inside & _). specialize (inside (b, Ptrofs.unsigned ofs + i0)). spec inside.
-        change (size_chunk Mptr * 2) with LKSIZE in *.
-        { split; auto; omega. }
+        { unfold LKSIZE in *; simpl in *; split; auto; lia. }
         simpl in inside|-*.
         destruct inside as [v [sh [rsh [? [? ?]]]]].
         exists sh, rsh.
-        assert (exists P, age_to n Phi' @ (b, Ptrofs.unsigned ofs + i0) = YES sh rsh (LK LKSIZE i0) P).
-        2:{ destruct H3 as [P ?]; exists P; split; auto. }
+        assert (exists P, age_to n Phi' @ (b, Ptrofs.unsigned ofs + i0) = YES sh rsh (LK LKSIZE i0) P) as [P ?]; [|exists P; split; auto].
         rewrite age_to_resource_at.
         breakhyps.
         rewr (Phi' @ (b, Ptrofs.unsigned ofs + i0)). simpl.
-        eexists. change (size_chunk Mptr * 2) with LKSIZE in *.
-        replace (Ptrofs.unsigned ofs + i0 - Ptrofs.unsigned ofs) with i0 by omega. reflexivity.
+        eexists. unfold LKSIZE; simpl.
+        replace (Ptrofs.unsigned ofs + i0 - Ptrofs.unsigned ofs) with i0 by lia. reflexivity.
       * intros tr0. specialize (J tr0). destruct J as [sh ?].
         destruct Hrmap' as (_ & outside & inside & _).
         exists sh. intros.
         specialize (outside (fst loc, snd loc + i0)).
         spec outside.
-        { intros r. destruct loc as [b0 ofs0]; simpl in *; change (size_chunk Mptr * 2) with LKSIZE in *.
+        { intros r. destruct loc as [b0 ofs0]; simpl in *.
            destruct r; subst b0. specialize (inside (b,ofs0+i0)). spec inside; auto.
             destruct inside as [v [sh' [rsh' [? _]]]].
-           specialize (H0 i0). destruct H0 as [sh8 [psh8 [P' [? ?]]]]. pose proof LKSIZE_pos; omega.
+           specialize (H0 i0). destruct H0 as [sh8 [psh8 [P' [? ?]]]]. pose proof LKSIZE_pos; lia.
            congruence.
        }
        destruct (H0 _ H1) as [sh' [psh' [P [? ?]]]]. rewrite outside in H3.
@@ -474,13 +456,13 @@ Proof.
                 loc = (b, Ptrofs.intval ofs) \/ fst loc <> b \/ fst loc = b /\ far (snd loc) (Ptrofs.intval ofs)). {
       clear -sparse.
       intros H loc1 loc2.
-      do 2 rewrite AMap_find_map_option_map. cleanup.
-      do 2 rewrite AMap_find_add.
+      rewrite !AMap_find_map_option_map. cleanup.
+      rewrite !AMap_find_add.
       if_tac [<- | ne1]; if_tac [<- | ne2]; simpl.
       - auto.
       - intros _ found2.
         specialize (H loc2). spec H. destruct (AMap.find loc2 _); auto; congruence.
-        breakhyps. right. right. split; auto. unfold far in *; auto. zify. omega.
+        breakhyps. right. right. split; auto. unfold far in *; auto. zify. lia.
       - intros found1 _.
         specialize (H loc1). spec H. destruct (AMap.find loc1 _); auto; congruence.
         auto.
@@ -491,7 +473,7 @@ Proof.
         auto.
     }
     intros loc found. right.
-    specialize (lock_coh loc). destruct (AMap.find loc _) as [o|] eqn:Eo. clear found. 2:congruence.
+    specialize (lock_coh loc). destruct (AMap.find loc _) as [o|] eqn:Eo; [|congruence]. clear found.
     assert (coh : exists (R : pred rmap), (lkat R loc) Phi)
       by (destruct o; breakhyps; eauto). clear lock_coh.
     destruct coh as (R' & AT').
@@ -513,26 +495,27 @@ Proof.
     destruct (adr_range_dec (b, ofs') LKSIZE (b, Ptrofs.intval ofs)) as [r|nr'].
     + autospec AT''. breakhyps.
     + clear -nr nr'. simpl in nr'. unfold LKSIZE in *.
-      do 2 match goal with H : ~(b = b /\ ?P) |- _ => assert (~P) by tauto; clear H end.
-      zify. omega.
+      repeat match goal with H : ~(b = b /\ ?P) |- _ => assert (~P) by tauto; clear H end.
+      zify. simpl in *; lia.
   }
   left.
   unshelve erewrite updLock_updThread_comm in mcompat', sparse' |- *; try (apply cntUpdateL; auto).
   unshelve erewrite age_to_updThread in mcompat', sparse' |- *; try (apply cnt_age', cntUpdateL; auto).
   apply state_invariant_c with (PHI := age_to n Phi') (mcompat := mcompat').
   - (* level *)
-    apply level_age_to. omega.
+    apply level_age_to. lia.
 
   - (* env_coherence *)
     apply env_coherence_age_to.
-    apply env_coherence_pures_eq with Phi; auto. omega.
+    apply env_coherence_pures_eq with Phi; auto. lia.
     apply pures_same_pures_eq. auto.
     eapply rmap_makelock_pures_same; eauto.
-  - clear -Hstore mwellformed.
+(*  - clear -Hstore mwellformed.
      unfold personal_mem in Hstore; simpl in Hstore.
      unfold juicyRestrict in Hstore; simpl in Hstore.
-     admit.  (* Santiago *)
-  - rewrite age_to_ghost_of.
+     eapply mem_wellformed_store; [.. | apply Hstore |]; auto.
+     apply mem_wellformed_restr; auto. *)
+  - unfold ext_compat; rewrite age_to_ghost_of.
     destruct Hrmap' as (? & ? & ? & <-).
     destruct extcompat as [? J]; eapply ghost_fmap_join in J; eexists; eauto.
 
@@ -557,26 +540,26 @@ Proof.
         apply Mem.load_store_same in Hstore.
         Transparent Mem.load.
         unfold Mem.load in *. simpl fst in *; simpl snd in *.
-        if_tac [va|nva];swap 1 2.
+        if_tac [va|nva].
+        rewrite restrPermMap_mem_contents.
+        if_tac in Hstore; [|discriminate].
+        auto.
         {
           destruct nva. simpl.
-          apply islock_valid_access. destruct AT as [(_ & _ & _ & AT & _) _]. inv AT; try discriminate. lapply (H3 0%Z); [|omega]. rewrite Z.mul_0_r, Z.add_0_r. intro X; inv X. inv H; auto.
-          2:congruence.
+          apply islock_valid_access; last congruence.
+          { destruct AT as [(_ & _ & _ & AT & _) _]. inv AT; try discriminate. lapply (H3 0%Z); [|lia]. rewrite Z.mul_0_r, Z.add_0_r. intro X; inv X. inv H; auto. }
           cleanup.
           setoid_rewrite AMap_find_map_option_map.
-          rewrite AMap_find_add. if_tac. 2:tauto.
+          rewrite AMap_find_add. if_tac; [|tauto].
           simpl; congruence.
         }
-        rewrite restrPermMap_mem_contents.
-        if_tac in Hstore. 2:discriminate.
-        auto.
 
       * (* LK_at *)
         subst loc. simpl.
-        split. destruct AT as [(_ & _ & _ & AT & _) _]. inv AT; try discriminate. lapply (H3 0%Z); [|omega]. rewrite Z.mul_0_r, Z.add_0_r. intro X; inv X. inv H; auto.
+        split. { destruct AT as [(_ & _ & _ & AT & _) _]. inv AT; try discriminate. lapply (H3 0%Z); [|lia]. rewrite Z.mul_0_r, Z.add_0_r. intro X; inv X. inv H; auto. }
         split.
         destruct AT as [(_ & _ & H5 & _) _]; simpl in H5.
-        unfold LKSIZE; rewrite size_chunk_Mptr; unfold Ptrofs.unsigned in *; omega.
+        unfold LKSIZE; rewrite size_chunk_Mptr; unfold Ptrofs.unsigned in *; simple_if_tac; lia.
         exists Rx.
         intros loc r.
         destruct Hrmap' as (_ & _ & inside & _). specialize (inside loc).
@@ -585,14 +568,14 @@ Proof.
         breakhyps.
         rewr (Phi' @ loc).
         unfold Ptrofs.unsigned in *.
-        change (size_chunk Mptr * 2) with LKSIZE in *.
-           unfold sync_preds_defs.pack_res_inv in *.
-           simpl.
-           eexists x0, x1.
-           f_equal. f_equal. extensionality Ts.
-           eauto.
-           rewrite level_age_to. 2:omega.
-           apply approx_approx'. omega.
+        fold LKSIZE in *.
+        unfold sync_preds_defs.pack_res_inv in *.
+        simpl.
+        eexists x0, x1.
+        f_equal. f_equal. extensionality Ts.
+        eauto.
+        rewrite level_age_to by lia.
+        apply approx_approx'. lia.
 
     + specialize (lock_coh loc).
       destruct (AMap.find loc _) as [o|] eqn:Eo.
@@ -600,10 +583,10 @@ Proof.
         assert (VAEQ :
                   Mem.valid_access
                     (restrPermMap (mem_compatible_locks_ltwritable (mem_compatible_forget compat)))
-                    Mint32 b' ofs' Readable =
+                    Mptr b' ofs' Readable =
                   Mem.valid_access
                     (restrPermMap (mem_compatible_locks_ltwritable (mem_compatible_forget mcompat')))
-                    Mint32 b' ofs' Readable).
+                    Mptr b' ofs' Readable).
         {
           unfold Mem.valid_access in *. f_equal.
           unfold Mem.range_perm in *.
@@ -621,44 +604,41 @@ Proof.
           symmetry.
           (* use lock sparsity again *)
           rewrite A2PMap_add_outside.
-          if_tac. 2:reflexivity.
+          if_tac; [|reflexivity].
           change (Some Writable = (lockSet tp) !! b' ofs0).
           symmetry. apply lockSet_spec_2 with ofs'.
-          unfold LKSIZE_nat; rewrite Z2Nat.id by (pose proof LKSIZE_pos; omega).
+          unfold LKSIZE_nat; rewrite Z2Nat.id by (pose proof LKSIZE_pos; lia).
           clear - r0; hnf; simpl in *; lkomega.
           cleanup. rewrite Eo. reflexivity.
         }
 
-        destruct o; unfold option_map; destruct lock_coh as (load & coh); split; swap 2 3.
+        destruct o; unfold option_map; destruct lock_coh as (load & coh); split.
         -- rewrite <-load.
            unfold load_at.
            unfold Mem.load. simpl fst; simpl snd.
            symmetry.
            if_tac [va|nva]; if_tac [va'|nva'].
-           ++ do 2 rewrite restrPermMap_mem_contents.
+           ++ rewrite !restrPermMap_mem_contents.
               simpl.
-              cut (forall z, (ofs' <= z < ofs' + 4)%Z ->
+              cut (forall z, (ofs' <= z < ofs' + size_chunk Mptr)%Z ->
                         ZMap.get z (Mem.mem_contents m) !! b' =
                         ZMap.get z (Mem.mem_contents m') !! b').
               { intros C. f_equal. f_equal.
-                f_equal. apply C. omega.
-                f_equal. apply C. omega.
-                f_equal. apply C. omega.
-                f_equal. apply C. omega. }
+                repeat (f_equal; [apply C; simpl; lia|]). f_equal; apply C; simpl; lia. }
               intros z rz.
               pose proof store_outside' _ _ _ _ _ _ Hstore as Hm'.
               destruct Hm' as (Hm', _).
               specialize (Hm' b' z).
               unfold contents_at in *.
               simpl in Hm'.
-              destruct Hm' as [r1 | a]. 2:exact a.
+              destruct Hm' as [r1 | a]; [|exact a].
               destruct r1 as [<- r1]. exfalso.
               specialize (sparse' (b, ofs') (b, Ptrofs.intval ofs)).
               simpl in sparse'. cleanup.
-              do 2 rewrite AMap_find_map_option_map in sparse'.
-              do 2 rewrite AMap_find_add in sparse'.
-              if_tac [e | _] in sparse'.  tauto.
-              if_tac [_ | ne] in sparse'. 2:tauto.
+              rewrite !AMap_find_map_option_map in sparse'.
+              rewrite !AMap_find_add in sparse'.
+              if_tac [e | _] in sparse'; [tauto|].
+              if_tac [_ | ne] in sparse'; [|tauto].
               spec sparse'. rewrite Eo. simpl. congruence.
               spec sparse'. simpl. congruence.
               destruct sparse' as [e | [ne | [_ Far]]]. congruence. tauto.
@@ -671,35 +651,53 @@ Proof.
            ++ rewrite VAEQ in nva. tauto.
            ++ reflexivity.
 
+        -- (* lkat *)
+           destruct coh as (align & bound & R & lk & sat).
+           split; auto.
+           split; auto.
+           exists R. split.
+           ++ apply age_to_ind. now apply lkat_hered.
+              destruct Hrmap' as (LPhi & outside & inside & _).
+              intros x rx. specialize (lk x rx).
+              specialize (outside x).
+              specialize (inside x).
+              spec outside.
+              { intros r2. specialize (inside r2). breakhyps. }
+              rewrite <-outside.
+              rewrite LPhi'.
+              eauto.
+           ++ destruct sat as [sat | ?]; [|lia]. left.
+              unfold age_to. assert (level r = level Phi) as ->.
+              { apply join_sub_level. eapply compatible_lockRes_sub_all; simpl; eauto. apply compat. }
+              rewr (level Phi). replace (S n - n)%nat with 1%nat by lia.
+              apply age_by_ind. destruct R as [x h]. apply h. apply sat.
+
         -- rewrite <-load.
            unfold load_at.
            unfold Mem.load. simpl fst; simpl snd.
            symmetry.
            if_tac [va|nva]; if_tac [va'|nva'].
-           ++ do 2 rewrite restrPermMap_mem_contents.
+           ++ rewrite !restrPermMap_mem_contents.
               simpl.
-              cut (forall z, (ofs' <= z < ofs' + 4)%Z ->
+              cut (forall z, (ofs' <= z < ofs' + size_chunk Mptr)%Z ->
                         ZMap.get z (Mem.mem_contents m) !! b' =
                         ZMap.get z (Mem.mem_contents m') !! b').
               { intros C. f_equal. f_equal.
-                f_equal. apply C. omega.
-                f_equal. apply C. omega.
-                f_equal. apply C. omega.
-                f_equal. apply C. omega. }
+                repeat (f_equal; [apply C; simpl; lia|]); f_equal; apply C; simpl; lia. }
               intros z rz.
               pose proof store_outside' _ _ _ _ _ _ Hstore as Hm'.
               destruct Hm' as (Hm', _).
               specialize (Hm' b' z).
               unfold contents_at in *.
               simpl in Hm'.
-              destruct Hm' as [r1 | a]. 2:exact a.
+              destruct Hm' as [r1 | a]; [|exact a].
               destruct r1 as [<- r1]. exfalso.
               specialize (sparse' (b, ofs') (b, Ptrofs.intval ofs)).
               simpl in sparse'. cleanup.
-              do 2 rewrite AMap_find_map_option_map in sparse'.
-              do 2 rewrite AMap_find_add in sparse'.
-              if_tac [e | _] in sparse'.  tauto.
-              if_tac [_ | ne] in sparse'. 2:tauto.
+              rewrite !AMap_find_map_option_map in sparse'.
+              rewrite !AMap_find_add in sparse'.
+              if_tac [e | _] in sparse'; [tauto|].
+              if_tac [_ | ne] in sparse'; [|tauto].
               spec sparse'. rewrite Eo. simpl. congruence.
               spec sparse'. simpl. congruence.
               destruct sparse' as [e | [ne | [_ Far]]]. congruence. tauto.
@@ -711,27 +709,6 @@ Proof.
            ++ rewrite VAEQ in nva. tauto.
            ++ reflexivity.
 
-        -- (* lkat *)
-           destruct coh as (align & bound & R & lk & sat).
-           split; auto.
-           split; auto.
-           exists R. split.
-           ++ apply age_to_ind. now apply lkat_hered.
-              destruct Hrmap' as (LPhi & outside & inside & _).
-              intros x rx. specialize (lk x rx).
-              specialize (outside x).
-              specialize (inside x).
-              spec outside.
-              { intros r2. specialize (inside r2). breakhyps. }
-              rewrite <-outside.
-              rewrite LPhi'.
-              eauto.
-           ++ destruct sat as [sat | ?]. 2:omega. left.
-              unfold age_to. replace (level r) with (level Phi); swap 1 2.
-              { symmetry. apply join_sub_level. eapply compatible_lockRes_sub_all; simpl; eauto. apply compat. }
-              rewr (level Phi). replace (S n - n)%nat with 1%nat by omega.
-              apply age_by_ind. destruct R as [x h]. apply h. apply sat.
-
         -- (* lkat *)
            destruct coh as (align & bound & R & lk). repeat (split; auto). exists R.
            apply age_to_ind. now apply lkat_hered.
@@ -753,14 +730,14 @@ Proof.
            destruct inside as [? [? [? [? [? inside]]]]].
            rewrite inside. intro. hnf in H2. destruct H2 as [? [? [? [? H2]]]]; inv H2.
            clear - H r H6. destruct loc; destruct r; simpl in *; subst. contradiction H.  f_equal.
-           unfold Ptrofs.unsigned in *; omega.
+           unfold Ptrofs.unsigned in *; lia.
         -- destruct Hrmap' as (_ & outside & _).
            rewrite age_to_resource_at.
            specialize (outside loc nr).
            rewrite <-outside.
            clear -lock_coh.
            contradict lock_coh. destruct lock_coh as [? [? [? [? ?]]]].
-           destruct (Phi @ loc); inv H. do 4 eexists; eauto.
+           destruct (Phi @ loc); inv H. repeat eexists; eauto.
 
   - (* safety *)
     {
@@ -769,44 +746,41 @@ Proof.
       destruct Post with
           (ret := @None val)
             (m' := jm)
-            (z' := tt) (n' := n) as (c'' & Ec'' & Safe'); auto.
+            (z' := tt) as (c'' & Ec'' & Safe'); auto.
       { apply Logic.I. }
       { unfold Hrel.
-        assert (level phi' = S n) as Hl' by (destruct (join_level _ _ _ J'); omega).
+        assert (level phi' = S n) as Hl' by (destruct (join_level _ _ _ J'); lia).
         rewrite level_jm_, m_phi_jm_, level_juice_level_phi, Hjm, level_age_to by (setoid_rewrite Hl'; auto).
-        split; auto; split; [setoid_rewrite En; auto|].
-        eapply pures_same_eq_l.
-        2:apply pures_eq_age_to; omega.
+        split; [setoid_rewrite En; auto|].
+        eapply pures_same_eq_l, pures_eq_age_to; [|lia].
         eapply pures_same_sym, rmap_makelock_pures_same; eauto. }
       { (* we must satisfy the post condition *)
         exists (age_to n phi0'), (age_to n phi1).
         rewrite Hjm.
         split.
         * apply age_to_join; auto.
-        * split3.
-          2: now eapply necR_trans; [ eassumption | apply age_to_necR ].
+        * split; [|now eapply necR_trans; [ eassumption | apply age_to_necR ]].
           split. now constructor.
           split. now constructor.
           simpl. rewrite seplog.sepcon_emp.
           unfold semax_conc_pred.lock_inv in *.
-          exists b, ofs; split. auto.
+          exists b, ofs; split. reflexivity.
           destruct RL0 as (Lphi0 & outside & inside & Hg).
-          split.
           intros loc. simpl.
-          pose proof data_at_unfold _ _ _ _ _ 2 (writable_writable0 Hwritable) AT as Hbefore.
+          pose proof data_at_unfold _ _ _ _ _ (S (S O)) (writable_writable0 Hwritable) AT as Hbefore.
           specialize (Hbefore loc).
           if_tac [r|nr].
           - exists ((writable_readable_share Hwritable)).
-            specialize (inside loc r).            
+            specialize (inside loc r).
             destruct inside as (val & sh & rsh & E & wsh & E').
-            if_tac in Hbefore. 2:tauto.
+            if_tac in Hbefore; [|tauto].
             rewrite age_to_resource_at.
             destruct Hbefore as (v, Hb). rewrite Hb in E.
             injection E as -> <-.
             rewrite E'. simpl.
             unfold pfullshare.
-            rewrite approx_approx'. 2: join_level_tac; omega.
-            rewrite level_age_to.  2: join_level_tac; omega.
+            rewrite approx_approx' by (join_level_tac; lia).
+            rewrite level_age_to by (join_level_tac; lia).
             apply YES_ext.
             reflexivity.
           - if_tac in Hbefore. tauto.
@@ -817,29 +791,18 @@ Proof.
             destruct Hbefore as [-> | (? & ? & ->)]; simpl.
             + apply NO_identity.
             + apply PURE_identity.
-          - simpl; rewrite age_to_ghost_of, <- Hg.
-            apply data_at_noghost in AT.
-            rewrite (identity_core AT), ghost_core; simpl.
-            rewrite <- (ghost_core (ghost_of phi0)); apply core_identity.
-         - rewrite age_to_ghost_of.
-            apply ghost_of_join in Join; apply ghost_of_join in j'.
-            destruct RL0 as (_ & _ & _ & Hg); rewrite Hg in Join.
-            eapply join_eq in Join; eauto.
-            destruct ora.
-            rewrite Join; apply ext_join_approx; auto.
       }
-      rewrite Hc' in Ec''; inv Ec''; destruct ora; auto.
+      simpl in Hc'; rewrite Hc' in Ec''; inv Ec''; destruct ora; auto.
     + unshelve erewrite gsoThreadCode, gsoThreadRes, <- gtc_age, gLockSetCode, <- getThreadR_age,
         gLockSetRes; auto.
       specialize (safety j cntj ora).
       destruct (getThreadC j tp cntj) eqn: Hget.
       * edestruct (unique_Krun_neq(ge := ge) i j); eauto.
-      * apply jsafe_phi_age_to; auto. apply jsafe_phi_downward. assumption.
-      * intros ? Hc'; apply jsafe_phi_bupd_age_to; auto. apply jsafe_phi_bupd_downward. auto.
-      * destruct safety as (? & q_new & Einit & safety).
-        split; [erewrite Mem.nextblock_store by eauto; auto|].
+      * apply jsafe_phi_age_to; auto.
+      * intros ? Hc'; apply jsafe_phi_fupd_age_to; auto.
+      * destruct safety as (q_new & Einit & safety).
         exists q_new; split; auto.
-        apply jsafe_phi_age_to; auto. apply jsafe_phi_downward, safety. }
+        apply jsafe_phi_fupd_age_to; auto. }
 
   - (* threads_wellformed *)
     intros j lj.
@@ -860,4 +823,15 @@ Proof.
     eapply unique_Krun_no_Krun. eassumption.
     instantiate (1 := cnti). rewr (getThreadC i tp cnti).
     congruence.
-Admitted.
+
+  - intros j lj; specialize (invcompat _ lj).
+    rewrite gsoThreadExtra; simpl extraRes.
+    destruct (eq_dec i j).
+    + subst; rewrite gssThreadRes.
+      (* The current phrasing doesn't capture the idea that the correctness proof must not have
+         used the hidden resources from the invariant. Shoudl we explicitly force the juicy steps
+         to restrict to or reestablish the available resources? How does this look in a corestep? *)
+    + erewrite (gsoThreadRes(i := i)(j := j)); eauto.
+admit.
+Search extraRes updThread.
+Qed.
diff --git a/concurrency/juicy/semax_safety_release.v b/concurrency/juicy/semax_safety_release.v
index 5f03ee73cb..6493a4b876 100644
--- a/concurrency/juicy/semax_safety_release.v
+++ b/concurrency/juicy/semax_safety_release.v
@@ -10,18 +10,12 @@ Require Import compcert.common.Values.
 
 Require Import VST.msl.Coqlib2.
 Require Import VST.msl.eq_dec.
-Require Import VST.msl.seplog.
-Require Import VST.msl.age_to.
-Require Import VST.veric.aging_lemmas.
-Require Import VST.veric.initial_world.
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.juicy_mem_lemmas.
 Require Import VST.veric.semax_prog.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.Clight_new.
-Require Import VST.veric.Clightnew_coop.
+Require Import VST.veric.Clight_core.
+Require Import VST.veric.Clightcore_coop.
 Require Import VST.veric.semax.
-Require Import VST.veric.semax_ext.
 Require Import VST.veric.juicy_extspec.
 Require Import VST.veric.juicy_safety.
 Require Import VST.veric.initial_world.
@@ -29,7 +23,6 @@ Require Import VST.veric.tycontext.
 Require Import VST.veric.semax_ext.
 Require Import VST.veric.res_predicates.
 Require Import VST.veric.mem_lessdef.
-Require Import VST.veric.age_to_resource_at.
 Require Import VST.floyd.coqlib3.
 Require Import VST.sepcomp.step_lemmas.
 Require Import VST.sepcomp.event_semantics.
@@ -47,15 +40,12 @@ Require Import VST.concurrency.juicy.JuicyMachineModule.
 Require Import VST.concurrency.juicy.sync_preds_defs.
 Require Import VST.concurrency.juicy.sync_preds.
 Require Import VST.concurrency.juicy.join_lemmas.
-(*Require Import VST.concurrency.cl_step_lemmas.
-Require Import VST.concurrency.resource_decay_lemmas.
-Require Import VST.concurrency.resource_decay_join.*)
 Require Import VST.concurrency.juicy.semax_invariant.
 Require Import VST.concurrency.juicy.semax_simlemmas.
 Require Import VST.concurrency.juicy.sync_preds.
 Require Import VST.concurrency.common.lksize.
 Require Import VST.concurrency.juicy.semax_progress.
-Require Import VST.concurrency.juicy.semax_preservation.
+(*Require Import VST.concurrency.juicy.semax_preservation.*)
 
 Local Arguments getThreadR {_} {_} {_} _ _ _.
 Local Arguments getThreadC {_} {_} {_} _ _ _.
@@ -69,7 +59,7 @@ Set Bullet Behavior "Strict Subproofs".
 
 Open Scope string_scope.
 
-(* to make the proof faster, we avoid unfolding of those definitions *)
+(* to make the proof faster, we avoid unfolding these definitions *)
 Definition Jspec'_juicy_mem_equiv_def CS ext_link :=
   ext_spec_stable juicy_mem_equiv (JE_spec _ ( @OK_spec (Concurrent_Espec unit CS ext_link))).
 
@@ -98,7 +88,7 @@ Lemma safety_induction_release ge Gamma n state
 Proof.
   intros isrelease.
   intros I.
-  inversion I as [m tr sch_ tp Phi En envcoh mwellformed compat extcompat sparse lock_coh safety wellformed unique E]. rewrite <-E in *.
+  inversion I as [m tr sch_ tp Phi En envcoh (*mwellformed*) compat extcompat sparse lock_coh safety wellformed unique E]. rewrite <-E in *.
   unfold blocked_at_external in *.
   destruct isrelease as (i & cnti & sch & ci & args & -> & Eci & atex).
   pose proof (safety i cnti tt) as safei.
@@ -107,10 +97,9 @@ Proof.
 
   fixsafe safei.
   inversion safei
-    as [ | ?????? bad | n0 z c m0 e args0 x at_ex Pre SafePost | ????? bad ];
-    [ now erewrite cl_corestep_not_at_external in atex; [ discriminate | eapply bad ]
-    | subst | now inversion bad ].
-  subst.
+    as [ | ????? bad | z c m0 e args0 x at_ex Pre SafePost | ???? bad ]; last (destruct ci; try discriminate; contradiction).
+  { rewrite level_jm_ in H; setoid_rewrite H in En; discriminate. }
+  { now erewrite cl_corestep_not_at_external in atex; [ discriminate | eapply bad ]. }
   simpl in at_ex. assert (args0 = args) by congruence; subst args0.
   assert (e = UNLOCK) by congruence; subst e.
   hnf in x.
@@ -134,15 +123,11 @@ Proof.
   rewrite m_phi_jm_ in j.
   simpl (and _).
   intros Post.
-  unfold release_pre in Pre.
-  destruct Pre as ((Hreadable & PreA2) & ([PreB1 _] & PreB2) & PreC).
-  change (Logic.True) in PreA2. clear PreA2.
-  change (Logic.True) in PreB2. clear PreB2.
-  unfold canon.SEPx in PreC.
+  destruct Pre as ((Hreadable & _) & PreB1 & _ & PreC).
+  unfold SeparationLogic.argsassert2assert, canon.SEPx in PreC.
   unfold base.fold_right_sepcon in *.
   rewrite seplog.sepcon_emp in PreC.
-  rewrite seplog.corable_andp_sepcon1 in PreC; swap 1 2.
-  { apply corable_weak_exclusive. }
+  rewrite seplog.corable_andp_sepcon1 in PreC by apply conclib.corable_weak_exclusive.
   rewrite seplog.sepcon_comm in PreC.
   rewrite seplog.sepcon_emp in PreC.
   destruct PreC as (Hexclusive, PreC).
@@ -154,7 +139,7 @@ Proof.
   (* use progress to get the parts that don't depend on choice of phi *)
   destruct (progress _ _ ext_link_inj _ _ _ _ Hnot_create I) as [? Hstep0].
   inv Hstep0.
-  inv H4; try inversion HschedN; subst tid;
+  inv H7; try inversion HschedN; subst tid;
       try contradiction; jmstep_inv; getThread_inv; try congruence;
       inv H; simpl in Hat_external;
       rewrite atex in Hat_external; inv Hat_external.
@@ -164,7 +149,7 @@ Proof.
   assert (Htid = cnti) by apply proof_irr; subst.
 
   assert (pack_res_inv R = pack_res_inv (approx (level phi0') Rx)) as HR.
-  { destruct Hlockinv as (bl & ofsl & Heq & Hlockinv & _); inv Heq.
+  { destruct Hlockinv as (bl & ofsl & Heq & Hlockinv); inv Heq.
     specialize (Hlockinv (bl, Ptrofs.unsigned ofsl)); simpl in Hlockinv.
     rewrite if_true in Hlockinv by (split; auto; lkomega).
     destruct Hlockinv as [? Hlock].
@@ -173,13 +158,13 @@ Proof.
     assert (join_sub phi0' (getThreadR i tp cnti)).
     apply join_sub_trans with phi0; eexists; eauto.
     apply (resource_at_join_sub _ _ (bl, Ptrofs.intval ofsl)) in H1. 
-    change (ClightSemanticsForMachines.Clight_newSem ge) with (@JSem ge) in *.
+    change (ClightSemanticsForMachines.ClightSem ge) with (@JSem ge) in *.
     rewrite H0,Hlock in H1.
     clear - H1; destruct H1 as [? H1].
     change  (SomeP rmaps.Mpred
              (fun _ : list Type => approx (@level rmap ag_rmap phi0') Rx))
          with (pack_res_inv (approx (@level rmap ag_rmap phi0') Rx))
-     in H1. 
+     in H1.
      forget (pack_res_inv (approx (@level rmap ag_rmap phi0') Rx)) as Rz.
     inv H1; auto.
   }
@@ -202,16 +187,16 @@ Proof.
       destruct (join_level _ _ _ jphi0) as [-> <-].
       assert (0 < level phi0d)%nat.
       { destruct (join_level _ _ _ Hrem_lock_res) as [->].
-        setoid_rewrite Hn; omega. }
-      split; [omega|].
+        setoid_rewrite Hn; lia. }
+      split; [lia|].
       eapply pred_hereditary; eauto.
-      apply age_by_1; omega.
+      apply age_by_1; lia.
     - subst tpx; reflexivity.
   }
   subst tpx.
 
   (* we move on to the preservation part *)
-  rename phi0d into d_phi. rename b0 into b. rename ofs0 into ofs. rename En into lev.
+  rename phi0d into d_phi. rename En into lev.
 
   assert (compat'' :
             mem_compatible_with
@@ -230,7 +215,7 @@ Proof.
       simpl map.
       assert (pr:containsThread (remLockSet tp (b, Ptrofs.intval ofs)) i) by auto.
       rewrite (maps_getthread i _ pr) in J.
-      rewrite gRemLockSetRes with (cnti0 := cnti) in J. clear pr.
+      rewrite gRemLockSetRes with (cnti := cnti) in J. clear pr.
       revert Hrem_lock_res J.
       generalize (getThreadR _ _ cnti) d_phi phi'.
       generalize (all_but i (maps (remLockSet tp (b, Ptrofs.intval ofs)))).
@@ -243,7 +228,7 @@ Proof.
       pose proof juice_join compat as J.
       pose proof all_cohere compat as MC.
       clear safety lock_coh.
-      eapply (mem_cohere'_store _ _ tp _ _ _ (Int.one) _ _ cnti Hcmpt).
+      eapply (mem_cohere'_store _ _ tp _ _ _ (Ptrofs.one) _ _ cnti Hcmpt).
       (* eapply mem_cohere'_store with *)
       (* (tp := tp) *)
       (*   (Hcmpt := Hcmpt) *)
@@ -261,6 +246,7 @@ Proof.
 
     - (* lockSet_Writable *)
       eapply lockSet_Writable_updLockSet_updThread; eauto.
+      eexists; eauto.
 
     - (* juicyLocks_in_lockSet *)
       pose proof jloc_in_set compat as jl.
@@ -278,9 +264,7 @@ Proof.
       intros loc; specialize (lj loc).
       simpl.
       rewrite AMap_find_add.
-      if_tac; swap 1 2.
-      + cleanup.
-        intros is; specialize (lj is). auto.
+      if_tac.
       + intros _. subst loc.
         assert_specialize lj. {
           cleanup.
@@ -288,25 +272,27 @@ Proof.
           reflexivity.
         }
         auto.
+      + cleanup.
+        intros is; specialize (lj is). auto.
   }
 
   pose proof mem_compatible_with_age _ compat'' (n := n) as compat'.
 
-  replace (level (getThreadR i tp cnti) - 1)%nat with n by omega.
-  assert (level (getThreadR i tp cnti) - 1 = n)%nat as El by omega.
+  replace (level (getThreadR i tp cnti) - 1)%nat with n by lia.
+  assert (level (getThreadR i tp cnti) - 1 = n)%nat as El by lia.
   replace (level (getThreadR i tp cnti) - 1)%nat with n; left; apply state_invariant_c with (mcompat := compat').
   + (* level *)
-    apply level_age_to. cleanup. omega.
+    apply level_age_to. cleanup. lia.
 
   + (* env_coherence *)
     apply env_coherence_age_to. auto.
-  
-  + (* mem_wellformed *)
+
+(*  + (* mem_wellformed *)
     clear - mwellformed Hstore.
     apply store_access in Hstore.
-    admit.  (* Santiago *)
+    admit.  (* Santiago *) *)
   + (* external coherence *)
-    rewrite age_to_ghost_of.
+    unfold ext_compat; rewrite age_to_ghost_of.
     destruct extcompat as [? J]; eapply ghost_fmap_join in J; eexists; eauto.
 
   + (* lock sparsity *)
@@ -331,9 +317,32 @@ Proof.
 
     * (* current lock is acquired: load is indeed 0 *)
       { subst loc.
-        split; swap 1 2.
+        split.
+        - (* in dry : it is 1 *)
+          unfold load_at.
+          clear (* lock_coh *) Hload.
+
+          Transparent Mem.load.
+          unfold Mem.load. simpl fst; simpl snd.
+          clear H. if_tac [H|H].
+          + rewrite restrPermMap_mem_contents.
+            apply Mem.load_store_same in Hstore.
+            unfold Mem.load in Hstore.
+            if_tac in Hstore; [ | discriminate ].
+            apply Hstore.
+          + exfalso.
+            apply H; clear H.
+            apply islock_valid_access.
+            * apply Mem.load_store_same in Hstore.
+              unfold Mem.load in Hstore.
+              if_tac [[H H']|H] in Hstore; [ | discriminate ].
+              apply H'.
+            * rewrite LockRes_age_content1.
+              rewrite gssLockRes. simpl. congruence.
+            * congruence.
+
         - (* the rmap is unchanged (but we have to prove the SAT information) *)
-          cut ((4 | snd (b, Ptrofs.intval ofs)) /\
+          cut ((size_chunk Mptr | snd (b, Ptrofs.intval ofs)) /\
                (snd (b, Ptrofs.intval ofs) + LKSIZE < Ptrofs.modulus)%Z /\
                exists (* sh0 *) R0,
                   (lkat R0 (* sh0 *) (b, Ptrofs.intval ofs)) Phi /\
@@ -357,61 +366,33 @@ Proof.
             specialize (HJcanwrite 0). spec HJcanwrite; [lkomega|].
             destruct HJcanwrite as [?[?[? HJcanwrite]]].
             apply predat1 in HJcanwrite.
-            apply @predat_join_sub with (phi2 := Phi) in HJcanwrite.
+            apply @predat_join_sub with (phi2 := Phi) in HJcanwrite; [|apply compatible_threadRes_sub, compat].
             rewrite Z.add_0_r in HJcanwrite.
-            2:apply compatible_threadRes_sub, compat.
             pose proof predat_inj HJcanwrite lk as ER.
-            replace (level (getThreadR i tp cnti)) with (level Phi) in ER.
-            2:symmetry; apply join_sub_level, compatible_threadRes_sub, compat.
+            replace (level (getThreadR i tp cnti)) with (level Phi) in ER
+              by (symmetry; apply join_sub_level, compatible_threadRes_sub, compat).
             cleanup.
             refine (@approx_eq_app_pred (approx (level phi0') Rx) R0 (age_by 1 (age_to n d_phi)) _ _ ER _).
             * rewrite level_age_by.
-              rewrite level_age_to. omega.
-              replace (level d_phi) with (level Phi). omega.
+              rewrite level_age_to. lia.
+              replace (level d_phi) with (level Phi). lia.
               symmetry. apply join_sub_level.
               apply join_sub_trans with (getThreadR i tp cnti).
               -- exists phi'. apply join_comm. auto.
               -- apply compatible_threadRes_sub. apply compat.
             * destruct (join_level _ _ _ jphi0).
               destruct (join_level _ _ _ Hrem_lock_res).
-              hnf. rewrite level_age_by, level_age_to by omega.
-              split; [omega|].
+              hnf. rewrite level_age_by, level_age_to by lia.
+              split; [lia|].
               unfold age_to.
               rewrite age_by_age_by.
               revert Hsat; apply age_by_ind.
-              destruct Rx; auto.
-
-        - (* in dry : it is 1 *)
-          unfold load_at.
-          clear (* lock_coh *) Hload.
-
-          Transparent Mem.load.
-          unfold Mem.load. simpl fst; simpl snd.
-          clear H. if_tac [H|H].
-          + rewrite restrPermMap_mem_contents.
-            apply Mem.load_store_same in Hstore.
-            unfold Mem.load in Hstore.
-            if_tac in Hstore; [ | discriminate ].
-            apply Hstore.
-          + exfalso.
-            apply H; clear H.
-            apply islock_valid_access.
-            * apply Mem.load_store_same in Hstore.
-              unfold Mem.load in Hstore.
-              if_tac [[H H']|H] in Hstore; [ | discriminate ].
-              apply H'.
-            * rewrite LockRes_age_content1.
-              rewrite gssLockRes. simpl. congruence.
-            * congruence.
+              apply pred_hereditary.
       }
 
     * (* not the current lock *)
-      destruct (AMap.find (elt:=option rmap) loc (lset tp)) as [o|] eqn:Eo; swap 1 2.
-      {
-        simpl.
-        clear -lock_coh.
-        rewrite isLK_age_to(* , isCT_age_to *). auto.
-      }
+      destruct (AMap.find (elt:=option rmap) loc (lset tp)) as [o|] eqn:Eo;
+        [|simpl; rewrite isLK_age_to(* , isCT_age_to *); auto].
       set (u := load_at _ _).
       set (v := load_at _ _) in lock_coh.
       assert (L : forall val, v = Some val -> u = Some val); unfold u, v in *.
@@ -429,7 +410,7 @@ Proof.
         unfold Mem.load in *.
         if_tac [V|V]; [ | congruence].
         if_tac [V'|V'].
-        - do 2 rewrite restrPermMap_mem_contents.
+        - rewrite !restrPermMap_mem_contents.
           intros G; exact_eq G.
           f_equal.
           f_equal.
@@ -439,18 +420,17 @@ Proof.
           pose proof store_outside' _ _ _ _ _ _ Hstore as OUT.
           destruct OUT as (OUT, _).
           cut (forall z,
-                  (0 <= z < 4)%Z ->
+                  (0 <= z < size_chunk Mptr)%Z ->
                   ZMap.get (ofs' + z)%Z (Mem.mem_contents m) !! b' =
                   ZMap.get (ofs' + z)%Z (Mem.mem_contents m') !! b').
           {
             intros G.
             repeat rewrite <- Z.add_assoc.
             f_equal.
-            - specialize (G 0%Z ltac:(omega)).
+            - specialize (G 0%Z).
+              spec G; [simpl; lia|].
               exact_eq G. repeat f_equal; auto with zarith.
-            - f_equal; [apply G; omega | ].
-              f_equal; [apply G; omega | ].
-              f_equal; apply G; omega.
+            - repeat (f_equal; [apply G; simpl; lia | ]); f_equal; apply G; simpl; lia.
           }
           intros z Iz.
           specialize (OUT b' (ofs' + z)%Z).
@@ -468,7 +448,7 @@ Proof.
         - exfalso.
           apply V'; clear V'.
           unfold Mem.valid_access in *.
-          split. 2:apply V. destruct V as [V _].
+          split; [|apply V]. destruct V as [V _].
           unfold Mem.range_perm in *.
           intros ofs0 int0; specialize (V ofs0 int0).
           unfold Mem.perm in *.
@@ -484,17 +464,17 @@ Proof.
           + rewrite OrdinalPool.gsoLockSet_2; auto.
             apply OrdinalPool.lockSet_spec_2 with ofs'.
             * hnf; simpl. eauto. clear -int0; simpl in *.
-              unfold LKSIZE_nat; rewrite Z2Nat.id; lkomega.
+              lkomega.
             * cleanup. rewrite Eo. reflexivity.
           + rewrite OrdinalPool.gsoLockSet_1; auto.
             * apply OrdinalPool.lockSet_spec_2 with ofs'.
               -- hnf; simpl. eauto.  clear -int0; simpl in *.
-                 unfold LKSIZE_nat; rewrite Z2Nat.id; lkomega.
+                 lkomega.
               -- cleanup. rewrite Eo. reflexivity.
             * unfold far in *.
               simpl in *.
               zify.
-              unfold LKSIZE_nat; rewrite Z2Nat.id; lkomega.
+              unfold LKSIZE in *; lkomega.
       }
       destruct o; destruct lock_coh as (Load (* & sh' *) & align & bound & R' & lks); split.
       -- now intuition.
@@ -507,7 +487,7 @@ Proof.
                unfold age_to in *.
                rewrite age_by_age_by.
                apply age_by_age_by_pred.
-               omega.
+               lia.
             ** congruence.
       -- now intuition.
       -- repeat (split; auto).
@@ -536,15 +516,13 @@ Proof.
           destruct Post with
           (ret := @None val)
             (m' := jm')
-            (z' := ora) (n' := n) as (c'' & Ec'' & Safe').
+            (z' := ora) as (c'' & Ec'' & Safe').
 
           + auto.
 
           + simpl.
             apply Logic.I.
 
-          + auto.
-
           + (* proving Hrel *)
             assert (n = level jm'). {
               rewrite <-level_m_phi.
@@ -553,19 +531,17 @@ Proof.
               REWR.
               REWR.
               rewrite level_age_to; auto.
-              replace (level phi') with (level Phi). omega.
+              replace (level phi') with (level Phi). lia.
               transitivity (level (getThreadR i tp cnti)); join_level_tac.
             }
             assert (level phi' = S n). {
-              cleanup. replace (level phi') with (S n). omega. join_level_tac.
+              cleanup. replace (level phi') with (S n). lia. join_level_tac.
             }
 
-            split; [ | split].
-            * auto.
-            * rewr (level jm'). rewrite level_jm_. cleanup. omega.
-            * simpl. rewrite Ejm'. do 3 REWR.
-              eapply pures_same_eq_l.
-              2:apply pures_eq_age_to; omega.
+            split.
+            * rewr (level jm'). rewrite level_jm_. cleanup. lia.
+            * simpl. rewrite Ejm'. REWR. REWR. REWR.
+              eapply pures_same_eq_l, pures_eq_age_to; [|lia].
               apply pures_same_trans with phi1.
               -- apply pures_same_sym. apply join_sub_pures_same. exists phi0'. apply join_comm. assumption.
               -- apply join_sub_pures_same. exists phi0. apply join_comm. assumption.
@@ -579,20 +555,12 @@ Proof.
               apply age_to_join.
               REWR.
               REWR.
-            * split3. 2: now eapply necR_trans; [ eassumption | apply age_to_necR ].
+            * split; [|now eapply necR_trans; [ eassumption | apply age_to_necR ]].
               split. now constructor.
               split. now constructor.
               unfold canon.SEPx.
               simpl. rewrite seplog.sepcon_emp.
               apply age_to_pred; auto.
-              unshelve setoid_rewrite <- getThreadR_age; auto.
-              rewrite age_to_ghost_of.
-              unshelve setoid_rewrite OrdinalPool.gLockSetRes; auto.
-              setoid_rewrite OrdinalPool.gssThreadRes.
-              destruct ora.
-              eapply join_sub_joins_trans, ext_join_approx, Hjoin.
-              eexists; apply ghost_fmap_join.
-              apply join_comm, ghost_of_join; eauto.
           + exact_eq Safe'.
             unfold jsafeN.
             f_equal.
@@ -601,12 +569,11 @@ Proof.
     * repeat REWR.
       destruct (getThreadC j tp lj) eqn:Ej.
       -- edestruct (unique_Krun_neq(ge := ge) i j); eauto.
-      -- apply jsafe_phi_age_to; auto. apply jsafe_phi_downward. assumption.
-      -- intros c' Ec'; specialize (safety c' Ec'). apply jsafe_phi_bupd_age_to; auto. apply jsafe_phi_bupd_downward. assumption.
-      -- destruct safety as (? & q_new & Einit & safety).
-         split; [erewrite Mem.nextblock_store by eauto; auto|].
+      -- apply jsafe_phi_age_to; auto.
+      -- intros c' Ec'; specialize (safety c' Ec'). apply jsafe_phi_fupd_age_to; auto.
+      -- destruct safety as (q_new & Einit & safety).
          exists q_new; split; auto.
-         apply jsafe_phi_age_to; auto. apply jsafe_phi_downward, safety.
+         apply jsafe_phi_fupd_age_to; auto.
 
   + (* well_formedness *)
     rename j into Hj. intros j lj.
@@ -629,4 +596,4 @@ Proof.
     eapply unique_Krun_no_Krun. eassumption.
     instantiate (1 := cnti). unfold JSem; rewrite Hthread.
     congruence.
-Admitted.
+Qed.
diff --git a/concurrency/juicy/semax_safety_spawn.v b/concurrency/juicy/semax_safety_spawn.v
index dee95e4d44..12be2aa7b5 100644
--- a/concurrency/juicy/semax_safety_spawn.v
+++ b/concurrency/juicy/semax_safety_spawn.v
@@ -10,18 +10,12 @@ Require Import compcert.common.Values.
 
 Require Import VST.msl.Coqlib2.
 Require Import VST.msl.eq_dec.
-Require Import VST.msl.seplog.
-Require Import VST.msl.age_to.
-Require Import VST.veric.aging_lemmas.
-Require Import VST.veric.initial_world.
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.juicy_mem_lemmas.
 Require Import VST.veric.semax_prog.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.Clight_new.
-Require Import VST.veric.Clightnew_coop.
+Require Import VST.veric.Clight_core.
+Require Import VST.veric.Clightcore_coop.
 Require Import VST.veric.semax.
-Require Import VST.veric.semax_ext.
 Require Import VST.veric.juicy_extspec.
 Require Import VST.veric.juicy_safety.
 Require Import VST.veric.initial_world.
@@ -30,7 +24,6 @@ Require Import VST.veric.tycontext.
 Require Import VST.veric.semax_ext.
 Require Import VST.veric.res_predicates.
 Require Import VST.veric.mem_lessdef.
-Require Import VST.veric.age_to_resource_at.
 Require Import VST.veric.seplog.
 Require Import VST.floyd.coqlib3.
 Require Import VST.sepcomp.step_lemmas.
@@ -45,11 +38,7 @@ Require Import VST.concurrency.common.addressFiniteMap.
 Require Import VST.concurrency.common.permissions.
 Require Import VST.concurrency.juicy.JuicyMachineModule.
 Require Import VST.concurrency.juicy.sync_preds_defs.
-Require Import VST.concurrency.juicy.sync_preds.
 Require Import VST.concurrency.juicy.join_lemmas.
-(*Require Import VST.concurrency.cl_step_lemmas.
-Require Import VST.concurrency.resource_decay_lemmas.
-Require Import VST.concurrency.resource_decay_join.*)
 Require Import VST.concurrency.juicy.semax_invariant.
 Require Import VST.concurrency.juicy.semax_simlemmas.
 Require Import VST.concurrency.juicy.sync_preds.
@@ -75,7 +64,7 @@ Definition Jspec'_juicy_mem_equiv_def CS ext_link :=
 Definition Jspec'_hered_def CS ext_link :=
    ext_spec_stable age (JE_spec _ ( @OK_spec (Concurrent_Espec unit CS ext_link))).
 
-Lemma shape_of_args2 (F V : Type) (args : list val) v (ge : Genv.t F V) :
+(*Lemma shape_of_args2 (F V : Type) (args : list val) v (ge : Genv.t F V) :
   Val.has_type_list args (sig_args (ef_sig CREATE)) ->
   v <> Vundef ->
   v =
@@ -119,7 +108,7 @@ Proof.
   + simpl in E. inversion E. eauto.
   + inversion E. f_equal.
     inversion L.
-Qed.
+Qed.*)
 
 Lemma lock_coherence_age_to ge n m (tp : jstate ge) Phi :
   lock_coherence (lset tp) Phi m ->
@@ -137,8 +126,8 @@ Proof.
       unfold age_to in *.
       rewrite age_by_age_by.
       apply age_by_age_by_pred.
-      omega.
-    * cut (level (age_to n Phi) <= 0)%nat. omega.
+      lia.
+    * cut (level (age_to n Phi) <= 0)%nat. lia.
       rewrite <-E. apply level_age_to_le.
   - destruct C as (A&B&C&R&D).
     repeat split; auto.
@@ -153,8 +142,8 @@ Proof.
   destruct fs; auto.
 Qed.
 
-Lemma cond_approx_eq_app n A P1 P2 phi :
-  cond_approx_eq n A P1 P2 ->
+Lemma args_cond_approx_eq_app n A P1 P2 phi :
+  args_cond_approx_eq n A P1 P2 ->
   (level phi < n)%nat ->
   forall ts y z,
     app_pred (P1 ts (fmap (rmaps.dependent_type_functor_rec ts A) (approx n) (approx n) y) z) phi ->
@@ -168,11 +157,21 @@ Proof.
   apply E.
 Qed.
 
-Lemma prop_app_pred {A} `{_ : ageable A} (P : Prop) (phi : A) : P -> app_pred (!! P) phi.
+Lemma prop_app_pred {A} `{_ : ageable A} {EO : Ext_ord A} (P : Prop) (phi : A) : P -> app_pred (!! P) phi.
 Proof.
   intro p. apply p.
 Qed.
 
+Lemma set_ghost_join : forall a c w1 w2 w (J : join w1 w2 w) H1 H,
+  join a (ghost_of w2) c ->
+  join (set_ghost w1 a H1) w2 (set_ghost w c H).
+Proof.
+  intros.
+  destruct (join_level _ _ _ J).
+  apply resource_at_join2; unfold set_ghost; intros; rewrite ?level_make_rmap, ?resource_at_make_rmap, ?ghost_of_make_rmap; auto.
+  apply resource_at_join; auto.
+Qed.
+
 Lemma safety_induction_spawn ge Gamma n state
   (CS : compspecs)
   (ext_link : string -> ident)
@@ -194,7 +193,7 @@ Lemma safety_induction_spawn ge Gamma n state
      state_invariant Jspec' Gamma (S n) state').
 Proof.
   intros isspawn I.
-  inversion I as [m tr sch_ tp Phi En envcoh mwellformed compat extcompat sparse lock_coh safety wellformed unique E]. rewrite <-E in *.
+  inversion I as [m tr sch_ tp Phi En envcoh (*mwellformed*) compat extcompat sparse lock_coh safety wellformed unique E]. rewrite <-E in *.
   unfold blocked_at_external in *.
   destruct isspawn as (i & cnti & sch & ci & args & -> & Eci & atex).
   pose proof (safety i cnti tt) as safei.
@@ -202,38 +201,39 @@ Proof.
   rewrite Eci in safei.
 
   fixsafe safei.
+  destruct ci as [| ?? k |]; try discriminate.
   inversion safei
-    as [ | ?????? bad | n0 z c m0 e args0 x at_ex Pre SafePost | ????? bad ].
+    as [ | ????? bad | z c m0 e args0 x at_ex Pre SafePost | ???? bad ]; last contradiction.
+  { rewrite level_jm_ in H; setoid_rewrite H in En; discriminate. }
   apply (corestep_not_at_external (juicy_core_sem _)) in bad. exfalso; subst; clear - bad atex.
    simpl in bad. unfold cl_at_external in *; simpl in *. rewrite atex in bad; inv bad.
-  2: inversion bad.
   subst.
   simpl in at_ex.
   unfold cl_at_external in atex, at_ex.
   assert (args0 = args) by congruence; subst args0.
   assert (e = CREATE) by congruence; subst e.
+  destruct f; [discriminate|].
+  destruct (ef_inline e); inv atex; clear at_ex.
   hnf in x.
   revert x Pre SafePost.
 
-  assert (H_spawn : Some (ext_link "spawn", ef_sig CREATE) = ef_id_sig ext_link CREATE). reflexivity.
+  assert (H_spawn : Some (ext_link "spawn", ef_sig CREATE) = ef_id_sig ext_link CREATE) by reflexivity.
 
   (* dependent destruction *)
-  funspec_destruct "acquire".
+(*  funspec_destruct "acquire".
   funspec_destruct "release".
   funspec_destruct "makelock".
-  funspec_destruct "freelock".
+  funspec_destruct "freelock".*)
   funspec_destruct "spawn".
   intros (phix, (ts, ((((f,b), globals), f_with_x) , f_with_Pre)))  (Hargsty, Pre) Post.
 (*  intros (phix, (ts, ((((xf, xarg), globals), f_with_x), f_with_Pre))) (Hargsty, Pre). *)
   simpl (and _) in Post.
   destruct Pre as (phi0 & phi1 & jphi & A). simpl in A.
-  destruct A as (((PreA & PreA') & (([PreB1 _] & [PreB2 _] & PreB3) & [phi00 [phi01 [jphi0 [[_y [Func Hphi00]] fPRE]]]])) & necr).
-  change Logic.True in PreA'. clear PreA'.
-(*destruct A as ((PreA & (PreB1 & PreB2 & PreB3) & phi00 & phi01 & jphi0 & (_y & Func) & fPRE) & necr).*)
-  simpl in fPRE.
-  rewrite seplog.sepcon_emp in fPRE.
-  hnf in PreB1,  PreB2.
-  clear Heq_name Heq_name0 Heq_name1 Heq_name2 Heq_name3.
+  destruct A as (((PreA & _) & (PreB1 & PreB2 & A)) & necr).
+  unfold SeparationLogic.argsassert2assert, canon.SEPx, client_lemmas.func_ptr' in A; simpl in A.
+  rewrite seplog.corable_andp_sepcon1, log_normalize.emp_sepcon, seplog.sepcon_emp in A by apply SeparationLogic.corable_func_ptr.
+  destruct A as [Func fPre].
+  clear Heq_name.
 
 
   assert (li : level (getThreadR i tp cnti) = S n).
@@ -242,36 +242,25 @@ Proof.
   { rewrite <-li. apply join_sub_level. eexists; eauto. }
   assert (l0 : level phi0 = S n).
   { rewrite <-li. apply join_sub_level. eexists; eauto. }
-  assert (l00 : level phi00 = S n).
-  { rewrite <-l0. apply join_sub_level. eexists; eauto. }
-  assert (l01 : level phi01 = S n).
-  { rewrite <-l0. apply join_sub_level. eexists; eauto. }
-Print Module SeparationLogicSoundness.VericSound.
-  Import SeparationLogic Clight_initial_world Clightdefs. 
+  Import SeparationLogic Clight_initial_world Clightdefs.
 (*  Import VericMinimumSeparationLogic.CSHL_Defs *)
 (*   Import SeparationLogicSoundness.VericSound.CSHL_Defs. *)
-  assert (phi01 = phi0). {
+(*  assert (phi01 = phi0). {
     eapply join_unit1_e; eauto.
     assumption.
-  }
-  pose proof func_ptr_isptr _ _ _ Func as isp.
+  }*)
+  epose proof func_ptr_isptr _ _ as [isp]; specialize (isp _ Func).
   unfold val_lemmas.isptr in *.
   destruct f as [ | | | | | f_b f_ofs]; try contradiction.
-(*  destruct b as [ | | | | | b_b b_ofs]; try contradiction. *)
   clear isp.
   destruct args as [ | args1 args]; [contradiction Hargsty | ].
   destruct args as [ | args2 args]; [destruct Hargsty; contradiction | ].
   destruct args as [ | args]; [ | destruct Hargsty as [_ [_ Hargsty]]; contradiction ].
 
-  apply shape_of_args3 in PreB1; auto. 2: congruence.
-  apply shape_of_args2 in PreB2; auto.
-   2: clear - PreA; hnf in PreA; destruct b; try contradiction; congruence.
-
-  destruct PreB1 as (arg1, Eargs). symmetry in Eargs; inv Eargs.
-  destruct PreB2 as [arg1 PreB2]. inv PreB2.
+  inv PreB1.
 
   destruct ((fun x => x) envcoh) as (gam, SP).
-  destruct SP as (prog & CS_ & V & semaxprog & Ege & FA).
+  destruct SP as (prog & ora & CS_ & V & semaxprog & Ege & FA).
 
   unfold SeparationLogic.NDmk_funspec in Func.
   match type of Func with
@@ -281,58 +270,36 @@ Print Module SeparationLogicSoundness.VericSound.
       set (NEP := NEP_); set (NEQ := NEQ_)
   end.
 
-  assert (gam0 : matchfunspecs ge Gamma phi00). {
+  assert (gam0 : matchfunspecs ge Gamma phi0). {
     revert gam. apply pures_same_matchfunspecs.
     join_level_tac.
     apply pures_same_sym, join_sub_pures_same.
-    apply join_sub_trans with phi0. eexists; eassumption.
     apply join_sub_trans with (getThreadR i tp cnti). exists phi1. auto.
     join_sub_tac.
   }
 
-  specialize (gam0 f_b ((_y, Tpointer Tvoid noattr) :: nil, tptr Tvoid) cc_default).
+  specialize (gam0 f_b).
 
   destruct Func as (b' & E' & FAT). injection E' as <- ->.
-
-  unfold SeparationLogic.NDmk_funspec in *.
-  (* before merge, FAT had the following type.
-     We will use that in the mean time.
-   *)
-  assert (FAT': (func_at
-           (mk_funspec ((_y, tptr tvoid) :: nil, tptr tvoid) cc_default
-              (rmaps.ConstType (val * nth 0 ts unit))
-              (fun (_ : list Type) (x0 : val * nth 0 ts unit) =>
-               let (y, x) := x0 in
-               canon.PROPx nil
-                 (canon.LOCALx (canon.temp _y y :: canon.gvars (globals x) :: nil)
-                    (canon.SEPx (f_with_Pre x y :: nil))))
-              (fun (_ : list Type) (x0 : val * nth 0 ts unit) =>
-               let (_, _) := x0 in canon.PROPx nil (canon.LOCALx nil (canon.SEPx nil)))
-              (const_super_non_expansive (val * nth 0 ts unit)
-                 (fun (_ : list Type) (x0 : val * nth 0 ts unit) =>
-                  let (y, x) := x0 in
-                  canon.PROPx nil
-                    (canon.LOCALx (canon.temp _y y :: canon.gvars (globals x) :: nil)
-                       (canon.SEPx (f_with_Pre x y :: nil)))))
-              (const_super_non_expansive (val * nth 0 ts unit)
-                 (fun (_ : list Type) (x0 : val * nth 0 ts unit) =>
-                  let (_, _) := x0 in canon.PROPx nil (canon.LOCALx nil (canon.SEPx nil))))) 
-           (f_b, 0)) phi00) by admit.
-  specialize (gam0 _ _ _ FAT').
-  destruct gam0 as (id_fun & P' & Q' & NEP' & NEQ' & Eb & Eid & Heq_P & Heq_Q).
-  unfold filter_genv in *.
+  destruct FAT as (gs & Hsub & FAT').
+  specialize (gam0 _ _ _ (necR_refl _) (ext_refl _) FAT').
+  destruct gam0 as (id_fun & fs0 & [? Eid] & Hsub0).
+  pose proof (funspec_sub_si_trans fs0 gs (mk_funspec fsig cc A P Q NEP NEQ) phi0) as Hsub1.
+  spec Hsub1. { split; auto. }
+  clear Hsub Hsub0.
+  destruct fs0 as [sig' cc' A' P' Q' NEP' NEQ'].
+  assert (sig' = fsig /\ cc' = cc) as []; subst.
+  { destruct gs; simpl in *.
+    destruct Hsub1 as [[] _]; subst; auto. }
 
   pose proof semax_prog_entry_point (Concurrent_Espec unit CS ext_link) V Gamma prog f_b
-       id_fun _y b A P' Q' NEP' NEQ' 0 semaxprog as HEP.
+       id_fun (tptr tvoid :: nil) (b :: nil) A' P' Q' NEP' NEQ' 0 ora (allows_exit ext_link) semaxprog as HEP.
 
-  subst ge.
   rewrite <-make_tycontext_s_find_id in HEP.
   spec HEP. auto.
 
   spec HEP. {
-    unfold A.
-    rewrite <-Eid.
-    apply make_tycontext_s_find_id.
+    rewrite make_tycontext_s_find_id; auto.
   }
 
   (*
@@ -347,7 +314,7 @@ Print Module SeparationLogicSoundness.VericSound.
     intros ts0 a rho phi ff. hnf.
     apply cond_approx_eq_sym in Heq_Q.
     pose proof @cond_approx_eq_app _ (rmaps.ConstType (val * nth 0 ts unit)) _ _ (age_to n phi) Heq_Q as HQ.
-    spec HQ. eapply le_lt_trans with n. 2:omega.
+    spec HQ. eapply le_lt_trans with n. 2:lia.
     { apply level_age_to_le'. }
     spec HQ ts0 a rho.
     spec HQ. now apply age_to_pred, ff.
@@ -361,35 +328,37 @@ Print Module SeparationLogicSoundness.VericSound.
   }
   *)
 
-  specialize (HEP PreA).
+  spec HEP.
+  { split; simpl; auto. }
   destruct HEP as (q_new & Initcore & Safety).
 (*  specialize (Initcore (jm_ cnti compat)). 
 clear - Initcore.
   change (initial_core (juicy_core_sem cl_core_sem) _) with cl_initial_core in Initcore.
 *)
 
-  apply join_comm in jphi0.
+(*  apply join_comm in jphi0.
   destruct (join_assoc jphi0 jphi) as (phi1' & jphi1' & jphi').
   assert (phi1 = phi1'). {
     eapply join_unit1_e; eauto.
     eassumption.
   }
-  subst phi1'.
+  subst phi1'.*)
 
-  assert (val_inject (Mem.flat_inj (Mem.nextblock m)) b b) as Hinj.
-  { destruct fPRE as [Hvalid _].
-    destruct b; try constructor; simpl in Hvalid.
+(*  assert (val_inject (Mem.flat_inj (Mem.nextblock m)) b b) as Hinj.
+  { (*destruct fPRE as [Hvalid _].*)
+    destruct b; try constructor.
     destruct (compatible_threadRes_cohere cnti (mem_compatible_forget compat)).
     destruct (plt b (Mem.nextblock m)).
     econstructor; [|symmetry; apply Ptrofs.add_zero].
     unfold Mem.flat_inj; rewrite if_true; auto.
-    { specialize (all_coh0 (b, Ptrofs.unsigned i0)); spec all_coh0; auto.
+    { Search b.
+specialize (all_coh0 (b, Ptrofs.unsigned i0)); spec all_coh0; auto.
       rewrite m_phi_jm_ in jphi.
       apply (resource_at_join _ _ _ (b, Ptrofs.unsigned i0)) in jphi.
       rewrite all_coh0 in jphi.
       rewrite Z.add_0_r in Hvalid; destruct (phi0 @ _) eqn: Hb; inv jphi.
       apply join_to_bot_l in RJ; subst.
-      contradiction Hvalid; apply bot_identity. } }
+      contradiction Hvalid; apply bot_identity. } }*)
   eexists.
   split.
   {
@@ -404,7 +373,6 @@ clear - Initcore.
     { reflexivity. }
 
     eapply step_create with
-      (Hcompatible := mem_compatible_forget compat)
       (phi' := phi1)
       (d_phi := phi0); try reflexivity; try eassumption; simpl; auto.
   }
@@ -414,33 +382,33 @@ clear - Initcore.
   of the spawner, but also for the safety of the spawned thread,
   because the precondition is stored in the current rmap *)
 
+  set (ci := Clight_core.Callstate _ _ _).
   assert (compat' :
             mem_compatible_with
               (addThread (updThread i tp cnti (Kresume ci Vundef) phi1)
                          (Vptr f_b Ptrofs.zero) b phi0) m Phi).
   {
     split; try apply compat.
-    clear -jphi compat. destruct compat as [jj jj']. simpl in jphi.
-    rewrite join_all_joinlist in *.
-    rewrite maps_addthread.
-    rewrite maps_updthread.
-    rewrite (maps_getthread _ _ cnti) in jj.
-    rewrite joinlist_merge; eauto.
+    * clear -jphi compat extcompat. destruct compat as [jj jj']. simpl in jphi.
+      rewrite join_all_joinlist in *.
+      rewrite maps_addthread.
+      rewrite maps_updthread.
+      rewrite (maps_getthread _ _ cnti) in jj.
+      rewrite joinlist_merge; eauto.
   }
 
   apply (@mem_compatible_with_age _ n) in compat'.
   replace (level _) with (S n) by (simpl; join_level_tac).
-  replace (S n - 1)%nat with n by omega.
+  replace (S n - 1)%nat with n by lia.
 
   apply state_invariant_c with (mcompat := compat').
 
   - (* level *)
-    apply level_age_to. cleanup. omega.
+    apply level_age_to. cleanup. lia.
 
   - (* env_coherence *)
     apply env_coherence_age_to; auto.
-  - auto.
-  - rewrite age_to_ghost_of.
+  - unfold ext_compat; rewrite age_to_ghost_of.
     destruct extcompat as [? J]; eapply ghost_fmap_join in J; eexists; eauto.
 
   - (* lock sparsity *)
@@ -460,189 +428,98 @@ clear - Initcore.
        - new thread #n+1 (spawned),
        - thread #i (after spawning),
        - other threads *)
-    intros j lj ora.
+    intros j lj [].
     destruct (eq_dec j tp.(num_threads).(pos.n)); [ | destruct (eq_dec i j)].
     + (* safety of new thread *)
       subst j.
       REWR.
-      rewrite gssAddCode. 2:reflexivity.
-      split; auto.
+      rewrite gssAddCode by reflexivity.
       exists q_new.
       split.
-{
-      destruct (Initcore (jm_ cnti compat)) as [? [? [? ?]]]; auto.
-      clear Initcore Post lj ora Safety FAT' Heq_P Heq_Q Eid Eb NEP' NEQ' P' Q' NEQ NEP P Q FA semaxprog.
-      clear jphi' jphi1' q_new id_fun A cc fsig CS_ V gam.
-      clear l1 l0 l00 l01 necr li fPRE FAT PreA PreB3.
-      clear Hargsty f_with_Pre f_with_x Hphi00 _y globals ts H_spawn unique wellformed at_ex En.
-      clear atex safei safety lock_coh.
-      simpl Mem.nextblock.
-      destruct mwellformed. split; auto.
-      clear - H.
-      change (Mem.nextblock m)
-       with (Mem.nextblock (m_dry (@jm_ (globalenv prog) tp m Phi i cnti compat))).
-      apply  maxedmem_neutral.
-      assert (mem_equiv.mem_equiv (maxedmem (m_dry (@jm_ (globalenv prog) tp m Phi i cnti compat)))
-                  (maxedmem m)). {
-         clear. simpl.
-         unfold maxedmem, juicyRestrict.
-     set (j := (juice2Perm
-           (@OrdinalPool.getThreadR LocksAndResources
-              (@JSem (globalenv prog)) i tp cnti) m)).
-     set (k := (@juice2Perm_cohere
-           (@OrdinalPool.getThreadR LocksAndResources
-              (@JSem (globalenv prog)) i tp cnti))).
-     set (q := (@acc_coh m
-              (@OrdinalPool.getThreadR LocksAndResources
-                 (@JSem (globalenv prog)) i tp cnti)
-              (@thread_mem_compatible (@JSem (globalenv prog)) tp m
-                 (@mem_compatible_forget (globalenv prog) tp m Phi
-                    compat) i cnti))).
-   clearbody q. clearbody k.
-   admit.  (* for Santiago to do. *)
-  }
-  red. simpl Mem.nextblock. rewrite H0. auto.
-}
-      intros jm. REWR. rewrite gssAddRes. 2:reflexivity.
-      specialize (Safety jm ts).
+      { destruct (Initcore (jm_ cnti compat)) as [? Hinit]; apply Hinit. }
+
+      intros jm. REWR. rewrite gssAddRes by reflexivity.
+(*      specialize (Safety jm ts). *)
       intros Ejm.
-      replace (level jm) with n in Safety; swap 1 2.
-      { rewrite <-level_m_phi, Ejm. symmetry. apply level_age_to.
-        cut (level phi0 = level Phi). cleanup. intros ->. omega.
-        apply join_sub_level.
-        apply join_sub_trans with (getThreadR _ _ cnti). exists phi1. auto.
-        apply compatible_threadRes_sub. apply compat. }
-
-      eapply Safety.
-      * rewrite Ejm.
-        eapply cond_approx_eq_app with (A := rmaps.ConstType (val * nth 0 ts unit)) (y := (b, f_with_x)).
-
-        (* cond_approx_eq *)
-        eauto.
-
-        (* level *)
-        rewrite level_age_to. omega. cleanup. omega.
-
-        (* PROP / LOCAL / SEP *)
-        simpl.
-        apply age_to_pred.
-        split.
-
-        (* nothing in PROP *)
-        now constructor.
-
-        split.
-        unfold SeparationLogic.local, lift1.
-
-        split.
-
-        -- (* LOCAL 1 : value of xarg *)
-        split.
-        simpl.
-        unfold liftx, lift. simpl.
-        unfold eval_id in *.
-        unfold val_lemmas.force_val in *.
-        unfold te_of in *.
-        unfold construct_rho in *.
-        unfold make_tenv in *.
-        unfold Map.get in *.
-        rewrite PTree.gss.
-        reflexivity.
-       do 8 red. intro Hx; subst; contradiction PreA.
-      
-
-       --  (* LOCAL 2 : locald_denote of global variables *)
-        split3. hnf.
-        clear - PreB3. destruct PreB3 as [PreB3 _].
-        hnf in PreB3. rewrite PreB3; clear PreB3.
-        unfold Map.get, make_ext_args. unfold env_set. 
-        unfold ge_of.
-        unfold filter_genv.
-        extensionality i. unfold Genv.find_symbol. simpl. auto.
-       
-
-        -- (* SEP: only precondition of spawned condition *)
-        unfold canon.SEPx in *.
-        simpl.
-        rewrite seplog.sepcon_emp.
-        destruct fPRE; assumption.
-      * (* funnassert *)
-        rewrite Ejm.
-        apply funassert_pures_eq with Phi.
-        { rewrite level_age_to. omega. cleanup. omega. }
-        { apply pures_same_eq_l with phi0. 2: now apply pures_eq_age_to; omega.
+      (* do a fupd to satisfy the spawned function's precondition *)
+      apply (semax_lemmas.assert_safe1_fupd (globalenv prog) _ q_new).
+      destruct Hsub1 as [_ Hsub1].
+      specialize (Hsub1 (age_to n phi0)); spec Hsub1.
+      { destruct (nec_refl_or_later _ _ (age_to_necR n phi0)) as [Heq | ]; auto.
+        apply (f_equal level) in Heq; rewrite level_age_to, l0 in Heq; lia. }
+      specialize (Hsub1 ts (b, f_with_x) (filter_genv (symb2genv (genv_symb_injective (globalenv prog))), b :: nil) _ (le_refl _) _ _ (necR_refl _) (ext_refl _)).
+      spec Hsub1.
+      { split.
+        * repeat constructor; simpl.
+          destruct b; try contradiction; simpl; auto.
+        * eapply pred_nec_hereditary; [apply age_to_necR|].
+          unfold P; rewrite sepcon_emp; split3; constructor; auto. }
+      assert (app_pred (fungassert (nofunc_tycontext V Gamma) (filter_genv (globalenv prog), b :: nil)) (age_to n phi0)) as Hfung.
+      { apply fungassert_pures_eq with Phi.
+        { rewrite level_age_to. lia. cleanup. lia. }
+        { apply pures_same_eq_l with phi0, pures_eq_age_to; [|lia].
           apply join_sub_pures_same. subst.
           apply join_sub_trans with (getThreadR i tp cnti). exists phi1; auto.
           apply compatible_threadRes_sub, compat. }
-        apply FA.
-      * rewrite Ejm; simpl.
-         rewrite age_to_ghost_of.
-         destruct ora.
-         eapply join_sub_joins_trans, ext_join_approx, extcompat.
-         destruct (compatible_threadRes_sub cnti (juice_join compat)).
-         eapply join_sub_trans.
-         -- eexists; apply ghost_fmap_join, ghost_of_join; eauto.
-         -- eexists; apply ghost_fmap_join, ghost_of_join; eauto.
+        apply FA. }
+      pose proof (conj Hfung Hsub1) as Hpre; eapply fupd.fupd_andp_corable in Hpre; [|apply corable_fungassert].
+      rewrite Ejm; eapply fupd.fupd_mono, Hpre.
+      intros ? (? & ? & ? & F & HP & _) [] ? Hext ??; subst.
+      rewrite predicates_sl.sepcon_comm in HP.
+      destruct ora; eapply jm_fupd_intro', Safety; auto.
+      eapply predicates_sl.sepcon_derives, HP; eauto.
 
     + (* safety of spawning thread *)
       subst j.
       REWR. unshelve erewrite (@gsoAddCode _ _ _ _ _ _ _ i); auto. REWR. REWR.
       unshelve erewrite (@gsoAddRes _ _ _ _ _ _ _ i); auto. REWR.
       intros c' afterex jm Ejm.
-      specialize (Post None jm ora n Hargsty Logic.I (le_refl _)).
+      specialize (Post None jm ora Hargsty Logic.I).
 
       spec Post. (* Hrel *)
-      { split. rewrite <-level_m_phi, Ejm. symmetry. apply level_age_to. cleanup; omega.
-        rewrite <-!level_m_phi. rewrite m_phi_jm_, Ejm. split.
-        rewrite level_age_to. cleanup; omega. cleanup; omega.
+      { unfold Hrel. rewrite <-!level_m_phi. rewrite m_phi_jm_, Ejm. split.
+        rewrite level_age_to. cleanup; lia. cleanup; lia.
         apply pures_same_eq_l with phi1. apply join_sub_pures_same. exists phi0. auto.
-        apply pures_eq_age_to. omega. }
+        apply pures_eq_age_to. lia. }
 
       spec Post. (* Postcondition *)
-      { exists (age_to n phi00), (age_to n phi1); split; [ | split3].
-        - rewrite Ejm. apply age_to_join. auto.
-        - split; auto. split; auto. split.
-          apply prop_app_pred; auto.
-          unfold canon.SEPx in *. simpl.
-          apply age_to_pred. auto.
+      { exists (core (age_to n phi1)), (age_to n phi1); split3.
+        - rewrite Ejm. apply core_unit.
+        - split; auto. split; auto. split; [constructor|].
+          setoid_rewrite emp_no; intros ?; apply resource_at_core_identity.
         - simpl.
           apply necR_trans with phi1; [ |apply age_to_necR].
           destruct necr; auto.
-        - destruct necr as [? JOINS].
-           rewrite Ejm, age_to_ghost_of.
-           destruct ora.
-           eapply join_sub_joins_trans; [|apply ext_join_approx, JOINS].
-           eexists; apply ghost_fmap_join, ghost_of_join; eauto.
       }
 
       destruct Post as (c'_ & afterex_ & safe').
       assert (c'_ = c').
       { cut (Some c'_ = Some c'). congruence. rewrite <-afterex, <-afterex_. reflexivity. }
       subst c'_.
-      apply safe'.
+      destruct ora; apply safe'.
 
     + assert (cntj : containsThread tp j).
       { apply cnt_age, cntAdd' in lj.
         destruct lj as [[lj ?] | lj ]. apply lj. simpl in lj. tauto. }
       specialize (safety j cntj ora).
+      destruct ora.
       REWR. REWR. REWR. REWR.
       destruct (getThreadC j tp cntj) eqn:Ej.
       -- edestruct (unique_Krun_neq(ge := globalenv prog) i j); eauto.
-      -- apply jsafe_phi_age_to; auto. apply jsafe_phi_downward.
+      -- apply jsafe_phi_age_to; auto.
          unshelve erewrite gsoAddRes; auto. REWR.
       -- intros c' Ec'; specialize (safety c' Ec').
-         apply jsafe_phi_bupd_age_to; auto. apply jsafe_phi_bupd_downward.
+         apply jsafe_phi_fupd_age_to; auto.
          unshelve erewrite gsoAddRes; auto. REWR.
-      -- destruct safety as (? & c_new & Einit & safety).
-         split; auto.
+      -- destruct safety as (c_new & Einit & safety).
          exists c_new; split; auto.
          unshelve erewrite gsoAddRes; auto. REWR.
-         apply jsafe_phi_age_to; auto. apply jsafe_phi_downward, safety.
+         apply jsafe_phi_fupd_age_to; auto.
 
   - (* wellformed *)
     intros j cntj.
     destruct (eq_dec j tp.(num_threads).(pos.n)); [ | destruct (eq_dec i j)].
-    + subst j. REWR. rewrite gssAddCode. 2:reflexivity. constructor.
+    + subst j. REWR. rewrite gssAddCode by reflexivity. constructor.
     + subst j. REWR. REWR. REWR.
        unfold cl_at_external; simpl. split; congruence.
     + assert (cntj' : containsThread tp j).
@@ -654,7 +531,7 @@ clear - Initcore.
     (* rewrite no_Krun_age_tp_to. *)
     intros j cntj q.
     destruct (eq_dec j tp.(num_threads).(pos.n)); [ | destruct (eq_dec i j)].
-    + subst j. REWR. rewrite gssAddCode. 2:reflexivity. clear; congruence.
+    + subst j. REWR. rewrite gssAddCode by reflexivity. clear; congruence.
     + subst j. REWR. REWR. REWR. clear; congruence.
     + assert (cntj' : containsThread tp j).
       { apply cnt_age, cntAdd' in cntj. destruct cntj as [[lj ?] | lj ]. apply lj. simpl in lj. tauto. }
@@ -662,4 +539,4 @@ clear - Initcore.
       eapply unique_Krun_no_Krun. eassumption.
       instantiate (1 := cnti). rewr (getThreadC i tp cnti).
       congruence.
-Admitted. (* safety_induction_spawn *)
+Qed. (* safety_induction_spawn *)
diff --git a/concurrency/juicy/semax_simlemmas.v b/concurrency/juicy/semax_simlemmas.v
index 12cf03b6f3..88a03391aa 100644
--- a/concurrency/juicy/semax_simlemmas.v
+++ b/concurrency/juicy/semax_simlemmas.v
@@ -10,19 +10,12 @@ Require Import compcert.common.Values.
 
 Require Import VST.msl.Coqlib2.
 Require Import VST.msl.eq_dec.
-Require Import VST.msl.seplog.
-Require Import VST.msl.age_to.
-Require Import VST.veric.aging_lemmas.
-Require Import VST.veric.initial_world.
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.juicy_mem_lemmas.
 Require Import VST.veric.semax_prog.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.Clight_new.
-Require Import VST.veric.Clightnew_coop.
+Require Import VST.veric.Clight_core.
+Require Import VST.veric.Clightcore_coop.
 Require Import VST.veric.semax.
-Require Import VST.veric.semax_ext.
-Require Import VST.veric.juicy_extspec.
 Require Import VST.veric.initial_world.
 Require Import VST.veric.juicy_extspec.
 Require Import VST.veric.juicy_safety.
@@ -30,7 +23,6 @@ Require Import VST.veric.tycontext.
 Require Import VST.veric.semax_ext.
 Require Import VST.veric.res_predicates.
 Require Import VST.veric.mem_lessdef.
-Require Import VST.veric.age_to_resource_at.
 Require Import VST.veric.seplog.
 Require Import VST.floyd.coqlib3.
 Require Import VST.sepcomp.step_lemmas.
@@ -49,16 +41,18 @@ Require Import VST.concurrency.juicy.sync_preds_defs.
 Require Import VST.concurrency.juicy.sync_preds.
 Require Import VST.concurrency.juicy.join_lemmas.
 Require Import VST.concurrency.common.lksize.
-(*Require Import VST.concurrency.cl_step_lemmas.*)
-Require Import VST.concurrency.juicy.resource_decay_lemmas.
-Require Import VST.concurrency.juicy.resource_decay_join.
+(*Require Import VST.concurrency.juicy.resource_decay_lemmas.
+Require Import VST.concurrency.juicy.resource_decay_join.*)
 Require Import VST.concurrency.juicy.semax_invariant.
-Require Import VST.veric.Clight_aging_lemmas.
 Import Clight_initial_world.
 Import Clight_seplog.
-Import ghost_PCM.
+
 Set Bullet Behavior "Strict Subproofs".
 
+(* why do we need this? *)
+#[global] Existing Instance SeparationLogic.Cveric.
+#[global] Existing Instance SeparationLogic.CSLveric.
+
 Lemma flat_inj_incr : forall b b', (b <= b')%positive ->
   inject_incr (Mem.flat_inj b) (Mem.flat_inj b').
 Proof.
@@ -73,7 +67,7 @@ Qed.
 Lemma lock_coherence_align lset Phi m b ofs :
   lock_coherence lset Phi m ->
   AMap.find (elt:=option rmap) (b, ofs) lset <> None ->
-  (align_chunk Mint32 | ofs).
+  (align_chunk Mptr | ofs).
 Proof.
   intros lock_coh find.
   specialize (lock_coh (b, ofs)).
@@ -99,7 +93,7 @@ Proof.
   intros C F.
   split.
   - intros ofs' r. eapply lset_range_perm; eauto.
-    unfold LKSIZE; omega. (* Andrew says: looks fishy *) (* Is this still fishy? -WM *)
+    unfold LKSIZE; lia.
   - eapply lock_coherence_align; eauto.
 Qed.
 
@@ -117,6 +111,68 @@ Proof.
   - apply lockSet_in_juicyLocks_age. easy.
 Qed.
 
+Lemma lockSet_Writable_updLockSet_updThread ge m m' i (tp : jstate ge)
+      (cnti : containsThread tp i)  b ofs ophi ophi' c' phi' z
+      (Hcmpt : mem_compatible tp m)
+      (His_unlocked : AMap.find (elt:=option rmap) (b, Ptrofs.intval ofs) (lset tp) = Some ophi)
+      (Hlt' : permMapLt
+           (setPermBlock (Some Writable) b (Ptrofs.intval ofs) (juice2Perm_locks (getThreadR cnti) m)
+              LKSIZE_nat) (getMaxPerm m))
+      (Hstore : Mem.store Mptr (restrPermMap Hlt') b (Ptrofs.intval ofs) (Vptrofs z) = Some m') :
+  lockSet_Writable (lset (updLockSet (updThread cnti c' phi') (b, Ptrofs.intval ofs) ophi')) m'.
+Proof.
+  destruct Hcmpt as (Phi, compat).
+  pose proof (loc_writable compat) as lw.
+  intros b' ofs' is; specialize (lw b' ofs').
+  destruct (eq_dec (b, Ptrofs.intval ofs) (b', ofs')).
+  + injection e as <- <- .
+    intros ofs0 int0.
+    rewrite (Mem.store_access _ _ _ _ _ _ Hstore).
+    pose proof restrPermMap_Max as RR.
+    unfold juicyRestrict_locks in *.
+    unfold permission_at in RR.
+    rewrite RR; clear RR.
+    clear is.
+    assert_specialize lw. {
+      clear lw.
+      cleanup.
+      rewrite His_unlocked.
+      reflexivity.
+    }
+    specialize (lw ofs0).
+    autospec lw.
+    exact_eq lw; f_equal.
+    unfold getMaxPerm in *.
+    rewrite PMap.gmap.
+    reflexivity.
+  + assert_specialize lw. {
+      simpl in is.
+      rewrite AMap_find_add in is.
+      if_tac in is. tauto.
+      exact_eq is.
+      unfold ssrbool.isSome in *.
+      cleanup.
+      destruct (AMap.find (elt:=option rmap) (b', ofs') (lset tp));
+        reflexivity.
+    }
+    intros ofs0 inter.
+    specialize (lw ofs0 inter).
+    exact_eq lw. f_equal.
+    unfold juicyRestrict_locks in *.
+    set (m_ := restrPermMap _) in Hstore.
+    change (max_access_at m (b', ofs0) = max_access_at m' (b', ofs0)).
+    transitivity (max_access_at m_ (b', ofs0)).
+    * unfold m_.
+      rewrite restrPermMap_max.
+      reflexivity.
+    * pose proof store_outside' _ _ _ _ _ _ Hstore as SO.
+      unfold access_at in *.
+      destruct SO as (_ & SO & _).
+      apply equal_f with (x := (b', ofs0)) in SO.
+      apply equal_f with (x := Max) in SO.
+      apply SO.
+Qed.
+
 Lemma after_alloc_0 : forall b phi H, after_alloc 0 0 b phi H = phi.
 Proof.
   intros; apply rmap_ext; unfold after_alloc.
@@ -124,7 +180,7 @@ Proof.
   - intro; rewrite resource_at_make_rmap.
     unfold after_alloc'.
     if_tac; auto.
-    destruct l, H0; omega.
+    destruct l, H0; lia.
   - rewrite ghost_of_make_rmap; auto.
 Qed.
 
@@ -141,6 +197,63 @@ Proof.
   congruence.
 Qed.
 
+Lemma pures_eq_func_at : forall Phi Phi' f a, (level Phi >= level Phi')%nat ->
+  pures_eq Phi Phi' -> func_at f a Phi -> func_at f a Phi'.
+Proof.
+  intros ???? Hl [PS SP] ?.
+  specialize (PS a); specialize (SP a).
+  destruct f; simpl in *.
+  rewrite H in PS; rewrite PS in *; simpl.
+  repeat f_equal.
+  extensionality w x y z.
+  rewrite fmap_app.
+  match goal with |-context[approx ?a (approx ?b ?c)] => change (approx a (approx b c)) with ((approx a oo approx b) c) end.
+  rewrite approx_oo_approx', approx'_oo_approx; auto.
+Qed.
+
+Lemma pures_eq_necR: forall a b, necR a b -> pures_eq a b.
+Proof.
+  induction 1.
+  - apply age_pures_eq; auto.
+  - apply pures_eq_refl.
+  - eapply pures_eq_trans, IHclos_refl_trans2; auto.
+    apply necR_level in H0; auto.
+Qed.
+
+Lemma pures_eq_ext : forall a b, ext_order a b -> pures_eq a b.
+Proof.
+  intros; apply rmap_order in H as (? & Hr & ?).
+  unfold pures_eq, pures_sub; rewrite Hr.
+  apply pures_eq_refl.
+Qed.
+
+Lemma pures_eq_comm : forall a b, (level b >= level a)%nat -> pures_eq a b -> pures_eq b a.
+Proof.
+  unfold pures_eq, pures_sub; intros ??? [PS SP].
+  split; intros; specialize (PS adr); specialize (SP adr).
+  - destruct (b @ adr); auto.
+    rewrite <- resource_at_approx.
+    destruct SP as [? Ha]; rewrite Ha in *.
+    inv PS; simpl.
+    rewrite preds_fmap_fmap.
+    rewrite approx_oo_approx', approx'_oo_approx; auto.
+  - destruct (a @ adr); eauto.
+Qed.
+
+Lemma age_to_pures_eq : forall a b x, (x <= level b)%nat -> pures_eq a b -> pures_eq (age_to x a) (age_to x b).
+Proof.
+  unfold pures_eq, pures_sub; intros ???? [PS SP].
+  split; intros adr; specialize (PS adr); specialize (SP adr); rewrite !age_to_resource_at.age_to_resource_at.
+  - destruct (a @ adr); auto.
+    rewrite PS in *; simpl.
+    rewrite !preds_fmap_fmap.
+    rewrite level_age_to by auto.
+    rewrite approx_oo_approx, approx_oo_approx', approx'_oo_approx; auto.
+  - destruct (b @ adr); auto.
+    destruct SP as [? Ha]; rewrite Ha in *.
+    inv PS; simpl; eauto.
+Qed.
+
 (* Most general lemma about preservation of matchfunspecs *)
 Lemma pures_eq_matchfunspecs e Gamma Phi Phi' :
   (level Phi' <= level Phi)%nat ->
@@ -148,66 +261,24 @@ Lemma pures_eq_matchfunspecs e Gamma Phi Phi' :
   matchfunspecs e Gamma Phi ->
   matchfunspecs e Gamma Phi'.
 Proof.
-  intros lev (PS, SP) MFS b fsig cc A P Q E.
-  simpl in E.
-  specialize (PS (b, Z0)). specialize (SP (b, Z0)). rewrite E in PS, SP.
-  specialize (MFS b fsig cc A).
-  simpl (func_at'' _ _ _ _ _ _ _) in MFS.
-  destruct SP as (pp, EPhi).
-  destruct pp as (A', pp').
-  pose proof resource_at_approx Phi (b, Z0) as RA. symmetry in RA. rewrite EPhi in RA.
-  rewrite EPhi in PS.
-  simpl in PS.
-  assert (A' = SpecTT A) by (injection PS; auto). subst A'.
-  apply PURE_SomeP_inj2 in PS.
-  simpl in RA. injection RA as RA. apply inj_pair2 in RA.
-
-  edestruct MFS with (P := fun i a e' => pp' i
-    (fmap (rmaps.dependent_type_functor_rec i A) (compcert_rmaps.R.approx (level Phi))
-          (compcert_rmaps.R.approx (level Phi)) a) true e')
-                       (Q := fun i a e' => pp' i
-    (fmap (rmaps.dependent_type_functor_rec i A) (compcert_rmaps.R.approx (level Phi))
-          (compcert_rmaps.R.approx (level Phi)) a) false e')
-    as (id & P' & Q' & P'_ne & Q'_ne & Ee & EG & EP' & EQ').
-  { rewrite EPhi.
-    f_equal. f_equal. rewrite RA. extensionality i a b' e'.
-    apply equal_f_dep with (x := i) in PS.
-    apply equal_f_dep with (x := (fmap (rmaps.dependent_type_functor_rec i A) (approx (level Phi)) (approx (level Phi)) a)) in PS.
-    apply equal_f_dep with (x := b') in PS.
-    apply equal_f_dep with (x := e') in PS.
-    destruct b'.
-    all:simpl.
-    all:change compcert_rmaps.R.approx with approx in *.
-    all:repeat rewrite (compose_rewr (fmap _ _ _) (fmap _ _ _)).
-    all:repeat rewrite fmap_comp.
-    all:rewrite (compose_rewr (approx _) (approx _)).
-    all:repeat rewrite approx_oo_approx.
-    all:rewrite (compose_rewr (fmap _ _ _) (fmap _ _ _)).
-    all:rewrite fmap_comp.
-    all:rewrite approx_oo_approx.
-    all:change compcert_rmaps.R.approx with approx in *.
-    all:reflexivity. }
-
-  exists id, P', Q', P'_ne, Q'_ne. split; auto. split; auto.
-  split.
-  all: eapply cond_approx_eq_trans; [ | eapply cond_approx_eq_weakening; eauto ].
-  all: intros ts.
-  all: extensionality a e'; simpl.
-  all: apply equal_f_dep with (x := ts) in PS.
-  all: apply equal_f_dep with (x := a) in PS.
-
-  1: apply equal_f_dep with (x := true) in PS.
-  2: apply equal_f_dep with (x := false) in PS.
-
-  all: apply equal_f_dep with (x := e') in PS.
-  all: simpl in PS.
-  all: change compcert_rmaps.R.approx with approx in *.
-  all: rewrite (compose_rewr (fmap _ _ _) (fmap _ _ _)), fmap_comp.
-  all: rewrite approx'_oo_approx; auto.
-  all: rewrite approx_oo_approx'; auto.
-  all: change compcert_rmaps.R.approx with approx in *.
-  all: rewrite PS.
-  all: rewrite level_age_to; auto.
+  intros lev PS MFS b fsig cc A P Q E.
+  destruct (MFS b fsig (age_to (level cc) Phi) _ (age_to_necR _ _) (ext_refl _)) as (? & ? & ? & ?).
+  - eapply pures_eq_func_at, E.
+    + apply rmap_order in Q as (? & ? & ?).
+      apply necR_level in P; rewrite level_age_to; lia.
+    + assert (level (age_to (level cc) Phi) = level cc).
+      { rewrite level_age_to; auto.
+        apply necR_level in P; lia. }
+      eapply pures_eq_trans; [| apply pures_eq_comm, pures_eq_ext, Q |]; try lia.
+      { apply rmap_order in Q as []; lia. }
+      apply necR_age_to in P; rewrite P at 1.
+      apply pures_eq_comm.
+      { rewrite H, <- P; auto. }
+      apply age_to_pures_eq; auto.
+      rewrite P; apply level_age_to_le.
+  - eexists; eexists; split; simpl in *; eauto.
+    eapply funspec_sub_si_fash; eauto.
+    apply necR_level in P; apply rmap_order in Q as (? & ? & ?); rewrite level_age_to; lia.
 Qed.
 
 Lemma pures_eq_age_to phi n :
@@ -215,7 +286,7 @@ Lemma pures_eq_age_to phi n :
   pures_eq phi (age_to n phi).
 Proof.
   split; intros loc; rewrite age_to_resource_at.
-  - destruct (phi @ loc); auto; simpl; do 3 f_equal; rewrite level_age_to; auto.
+  - destruct (phi @ loc); auto; simpl; repeat f_equal; rewrite level_age_to; auto.
   - destruct (phi @ loc); simpl; eauto.
 Qed.
 
@@ -230,7 +301,7 @@ Qed.
 
 Lemma age_pures_eq phi phi' : age phi phi' -> pures_eq phi phi'.
 Proof.
-  intros A. rewrite (necR_age_to phi phi'). apply pures_eq_age_to. apply age_level in A. omega.
+  intros A. rewrite (necR_age_to phi phi'). apply pures_eq_age_to. apply age_level in A. lia.
   constructor; auto.
 Qed.
 
@@ -238,7 +309,7 @@ Lemma matchfunspecs_hered e Gamma :
   hereditary age (matchfunspecs e Gamma).
 Proof.
   intros phi phi' A. apply pures_eq_matchfunspecs.
-  apply age_level in A. omega.
+  apply age_level in A. lia.
   apply age_pures_eq, A.
 Qed.
 
@@ -270,28 +341,42 @@ Lemma funassert_pures_eq G rho phi1 phi2 :
   app_pred (funassert G rho) phi1 ->
   app_pred (funassert G rho) phi2.
 Proof.
-  intros lev (PS, SP) (FA1, FA2); split.
-  - intros id fs phi2' necr Gid.
-    specialize (FA1 id fs phi1 (necR_refl phi1) Gid).
+  intros lev PS (FA1, FA2); split.
+  - intros id fs phi2' phi2'' necr ext Gid.
+    specialize (FA1 id fs phi1 _ (necR_refl phi1) (ext_refl _) Gid).
     destruct FA1 as (b & ? & FAT). exists b; split; auto.
+    eapply pred_upclosed; eauto.
     apply pred_nec_hereditary with phi2; auto.
-    clear -lev PS FAT. destruct fs; simpl in *.
-    specialize (PS (b, Z0)). rewrite FAT in PS.
-    exact_eq PS. f_equal. f_equal.
-    simpl. f_equal. extensionality i a b' a1.
-    rewrite (compose_rewr (fmap _ _ _) (fmap _ _ _)), fmap_comp.
-    rewrite !(compose_rewr (approx _) (approx _)).
-    rewrite approx_oo_approx'; auto.
-    rewrite approx'_oo_approx; auto.
-  - intros b fs cc phi2'  necr. destruct fs eqn:Efs. intros [pp pat].
-    specialize (FA2 b fs cc phi1 (necR_refl phi1)). subst fs.
-    spec FA2; [ | auto]. simpl. clear -pat necr SP.
-    simpl in pat. specialize (SP (b, Z0)).
+    eapply pures_eq_func_at; eauto.
+  - intros b fs cc phi2' phi2'' necr ext. destruct fs eqn:Efs. intros [pp pat].
+    specialize (FA2 b fs cc phi1 _ (necR_refl phi1) (ext_refl _)). subst fs.
+    spec FA2; [ | auto]. simpl. clear -pat necr ext PS.
+    simpl in pat. destruct PS as [_ SP]; specialize (SP (b, Z0)).
+    apply rmap_order in ext as (_ & Hr & _); rewrite <- Hr in *.
     destruct (necR_PURE' _ _ _ _ _ necr pat) as (pp', E).
     rewrite E in SP. destruct SP as (pp'', SP). exists pp''.
     rewrite <-resource_at_approx, SP. reflexivity.
 Qed.
 
+Lemma fungassert_funassert : forall G rho, fungassert G rho = funassert G (mkEnviron (fst rho) (Map.empty _) (Map.empty _)).
+Proof.
+  reflexivity.
+Qed.
+
+Lemma fungassert_pures_eq G rho phi1 phi2 :
+  (level phi1 >= level phi2)%nat ->
+  pures_eq phi1 phi2 ->
+  app_pred (fungassert G rho) phi1 ->
+  app_pred (fungassert G rho) phi2.
+Proof.
+  rewrite fungassert_funassert; apply funassert_pures_eq.
+Qed.
+
+Lemma corable_fungassert : forall G rho, corable (fungassert G rho).
+Proof.
+  intros; rewrite fungassert_funassert; apply Clight_assert_lemmas.corable_funassert.
+Qed.
+
 Lemma env_coherence_hered Z Jspec ge G :
   hereditary age (@env_coherence Z Jspec ge G).
 Proof.
@@ -302,6 +387,7 @@ Proof.
   sync C; eauto.
   sync C; eauto.
   sync C; eauto.
+  sync C; eauto.
   revert C. apply pred_hered, A.
 Qed.
 
@@ -326,6 +412,7 @@ Proof.
   sync C; eauto.
   sync C; eauto.
   sync C; eauto.
+  sync C; eauto.
   apply funassert_pures_eq with phi; auto.
 Qed.
 
@@ -356,15 +443,14 @@ Lemma islock_valid_access ge (tp : jstate ge) m b ofs p
     Mptr b ofs p.
 Proof.
   intros div islock NE.
-  eapply Mem.valid_access_implies with (p1 := Writable).
-  2:destruct p; constructor || tauto.
+  eapply Mem.valid_access_implies with (p1 := Writable); [|destruct p; constructor || tauto].
   pose proof lset_range_perm.
   do 7 autospec H.
   split; auto.
   intros loc range.
   apply H;
   unfold LKSIZE in *;
-  omega.
+  lia.
 Qed.
 
 Lemma LockRes_age_content1 ge (js : jstate ge) n a :
@@ -412,7 +498,7 @@ Proof.
   apply join_comm; auto.
 Qed.
 
-Lemma Ejuicy_sem : forall ge, (@juicy_sem (Clight_newSem ge)) = juicy_core_sem (cl_core_sem ge).
+Lemma Ejuicy_sem : forall ge, (@juicy_sem (ClightSem ge)) = juicy_core_sem (cl_core_sem ge).
 Proof.
   unfold juicy_sem; simpl.
   reflexivity.
@@ -505,66 +591,35 @@ Proof.
   symmetry; apply level_juice_level_phi.
 Qed.
 
-Lemma jsafeN_downward {Z} {Jspec : juicy_ext_spec Z} {ge n z c jm} :
-  jsafeN Jspec ge (S n) z c jm ->
-  jsafeN Jspec ge n z c jm.
-Proof.
-  apply jsafe_downward1.
-Qed.
-
-Lemma jsafe_phi_downward {Z} {Jspec : juicy_ext_spec Z} {ge n z c phi} :
-  jsafe_phi Jspec ge (S n) z c phi ->
-  jsafe_phi Jspec ge n z c phi.
-Proof.
-  intros S jm <-.
-  apply jsafe_downward1.
-  apply S, eq_refl.
-Qed.
-
-Lemma jsafe_phi_bupd_downward {Z} {Jspec : juicy_ext_spec Z} {ge n z c phi} :
-  jsafe_phi_bupd Jspec ge (S n) z c phi ->
-  jsafe_phi_bupd Jspec ge n z c phi.
-Proof.
-  intros S jm <- ? HC J.
-  specialize (S _ eq_refl _ HC J) as (? & ? & ? & ?%jsafe_downward1); eauto.
-Qed.
-
-Lemma jsafe_phi_age Z Jspec ge ora q n phi phiaged :
+Lemma jsafe_phi_age Z Jspec ge ora q phi phiaged :
   ext_spec_stable age (JE_spec _ Jspec) ->
   age phi phiaged ->
-  le n (level phiaged) ->
-  @jsafe_phi Z Jspec ge n ora q phi ->
-  @jsafe_phi Z Jspec ge n ora q phiaged.
+  @jsafe_phi Z Jspec ge ora q phi ->
+  @jsafe_phi Z Jspec ge ora q phiaged.
 Proof.
-  intros stable A l S jm' E.
+  intros stable A S jm' E.
   destruct (oracle_unage jm' phi) as (jm & Aj & <-). congruence.
   eapply jsafeN_age; eauto.
-  exact_eq l; f_equal.
-  rewrite level_juice_level_phi.
-  congruence.
 Qed.
 
-Lemma jsafe_phi_age_to Z Jspec ge ora q n l phi :
+Lemma jsafe_phi_age_to Z Jspec ge ora q l phi :
   ext_spec_stable age (JE_spec _ Jspec) ->
-  le n l ->
-  @jsafe_phi Z Jspec ge n ora q phi ->
-  @jsafe_phi Z Jspec ge n ora q (age_to l phi).
+  @jsafe_phi Z Jspec ge ora q phi ->
+  @jsafe_phi Z Jspec ge ora q (age_to l phi).
 Proof.
   intros Stable nl.
-  apply age_to_ind_refined.
+  apply age_to_ind_refined; auto.
   intros x y H L.
   apply jsafe_phi_age; auto.
-  omega.
 Qed.
 
-Lemma jsafe_phi_bupd_age Z Jspec ge ora q n phi phiaged :
+Lemma jsafe_phi_bupd_age Z Jspec ge ora q phi phiaged :
   ext_spec_stable age (JE_spec _ Jspec) ->
   age phi phiaged ->
-  le n (level phiaged) ->
-  @jsafe_phi_bupd Z Jspec ge n ora q phi ->
-  @jsafe_phi_bupd Z Jspec ge n ora q phiaged.
+  @jsafe_phi_bupd Z Jspec ge ora q phi ->
+  @jsafe_phi_bupd Z Jspec ge ora q phiaged.
 Proof.
-  intros stable A l S jm' E.
+  intros stable A S jm' E.
   destruct (oracle_unage jm' phi) as (jm & Aj & <-). congruence.
   intros ? HC J.
   rewrite (age1_ghost_of _ _ (age_jm_phi Aj)) in J.
@@ -580,23 +635,39 @@ Proof.
     apply Hc'.
     erewrite <- age_level by (eapply age_jm_phi; eauto); auto.
   - split; auto; eapply jsafeN_age; eauto.
-    destruct Hupd' as (_ & -> & _).
-    exact_eq l; f_equal.
-    rewrite level_juice_level_phi.
-    congruence.
 Qed.
 
-Lemma jsafe_phi_bupd_age_to Z Jspec ge ora q n l phi :
+Lemma jsafe_phi_bupd_age_to Z Jspec ge ora q l phi :
   ext_spec_stable age (JE_spec _ Jspec) ->
-  le n l ->
-  @jsafe_phi_bupd Z Jspec ge n ora q phi ->
-  @jsafe_phi_bupd Z Jspec ge n ora q (age_to l phi).
+  @jsafe_phi_bupd Z Jspec ge ora q phi ->
+  @jsafe_phi_bupd Z Jspec ge ora q (age_to l phi).
 Proof.
   intros Stable nl.
-  apply age_to_ind_refined.
+  apply age_to_ind_refined; auto.
   intros x y H L.
   apply jsafe_phi_bupd_age; auto.
-  omega.
+Qed.
+
+Lemma jsafe_phi_fupd_age Z Jspec ge ora q phi phiaged :
+  ext_spec_stable age (JE_spec _ Jspec) ->
+  age phi phiaged ->
+  @jsafe_phi_fupd Z Jspec ge ora q phi ->
+  @jsafe_phi_fupd Z Jspec ge ora q phiaged.
+Proof.
+  intros stable A S jm' E.
+  destruct (oracle_unage jm' phi) as (jm & Aj & <-). congruence.
+  eapply jm_fupd_age; eauto.
+Qed.
+
+Lemma jsafe_phi_fupd_age_to Z Jspec ge ora q l phi :
+  ext_spec_stable age (JE_spec _ Jspec) ->
+  @jsafe_phi_fupd Z Jspec ge ora q phi ->
+  @jsafe_phi_fupd Z Jspec ge ora q (age_to l phi).
+Proof.
+  intros Stable nl.
+  apply age_to_ind_refined; auto.
+  intros x y H L.
+  apply jsafe_phi_fupd_age; auto.
 Qed.
 
 Lemma m_phi_jm_ ge m (tp : jstate ge) phi i cnti compat :
@@ -641,11 +712,9 @@ Proof.
   unfold mapmap in *.
   unfold PMap.get.
   simpl.
-  do 2 rewrite PTree.gmap.
+  rewrite !PTree.gmap, PTree.gmap1.
   unfold option_map in *.
-  destruct (PTree.map1 _) as [|].
-  - destruct (PTree.Leaf ! _) as [|]; auto.
-  - destruct ((PTree.Node _ _ _) ! _) as [|]; auto.
+  destruct ((snd (Mem.mem_access m)) ! b); auto.
 Qed.
 
 Lemma m_dry_personal_mem_eq m phi phi' pr pr' :
@@ -698,7 +767,7 @@ Proof.
     }
     destruct Hy' as (y', Ay).
     assert (level x' = level y') by (apply age_level in A; apply age_level in Ay; congruence).
-    exists y'. split;[|split]. assumption. 2: constructor; assumption.
+    exists y'. split;[|split; [|constructor; assumption]]. assumption.
     intros l k pp.
     pose proof @age_resource_at _ _ l A as Hx.
     pose proof @age_resource_at _ _ l Ay as Hy.
@@ -758,7 +827,7 @@ Qed.
 Lemma approx_approx n x : approx n (approx n x) = approx n x.
 Proof.
   pose proof approx_oo_approx n as E.
-  apply equal_f with (x0 := x) in E.
+  apply equal_f with (x := x) in E.
   apply E.
 Qed.
 
@@ -766,7 +835,7 @@ Lemma approx'_approx n n' x : (n' <= n)%nat -> approx n (approx n' x) = approx n
 Proof.
   intros l.
   pose proof approx'_oo_approx _ _ l as E.
-  apply equal_f with (x0 := x) in E.
+  apply equal_f with (x := x) in E.
   apply E.
 Qed.
 
@@ -774,11 +843,11 @@ Lemma approx_approx' n n' x : (n' <= n)%nat -> approx n' (approx n x) = approx n
 Proof.
   intros l.
   pose proof approx_oo_approx' _ _ l as E.
-  apply equal_f with (x0 := x) in E.
+  apply equal_f with (x := x) in E.
   apply E.
 Qed.
 
-Lemma shape_of_args F V args b ofs ge :
+(*Lemma shape_of_args F V args b ofs ge _lock :
   Val.has_type_list args (AST.Tint :: nil) ->
   Vptr b ofs = mpred.eval_id _lock (make_ext_args (filter_genv (symb2genv (@genv_symb_injective F V ge))) (_lock :: nil) args) ->
   args = Vptr b ofs :: nil.
@@ -796,7 +865,7 @@ Proof.
   + simpl in E. inversion E. reflexivity.
   + inversion E. f_equal.
     inversion L.
-Qed.
+Qed.*)
 
 Lemma join_all_res : forall ge i (tp : jstate ge) (cnti : containsThread tp i) c Phi,
   join_all (updThread cnti (Krun c) (getThreadR cnti)) Phi <->
@@ -807,28 +876,28 @@ Proof.
   rewrite updThread_same; reflexivity.
 Qed.
 
-Definition thread_safety {Z} (Jspec : juicy_ext_spec Z) m ge (tp : jstate ge) PHI (mcompat : mem_compatible_with tp m PHI) n
+Definition thread_safety {Z} (Jspec : juicy_ext_spec Z) m ge (tp : jstate ge) PHI (mcompat : mem_compatible_with tp m PHI)
   i (cnti : containsThread tp i) := forall (ora : Z),
     match getThreadC cnti with
-    | Krun c => semax.jsafeN Jspec ge n ora c (jm_ cnti mcompat)
+    | Krun c => semax.jsafeN Jspec ge ora c (jm_ cnti mcompat)
     | Kblocked c =>
       (* The dry memory will change, so when we prove safety after an
       external we must only inspect the rmap m_phi part of the juicy
       memory.  This means more proof for each of the synchronisation
       primitives. *)
-      jsafe_phi Jspec ge n ora c (getThreadR cnti)
+      jsafe_phi Jspec ge ora c (getThreadR cnti)
     | Kresume c v =>
       forall c',
         (* [v] is not used here. The problem is probably coming from
            the definition of JuicyMachine.resume_thread'. *)
         cl_after_external None c = Some c' ->
         (* same quantification as in Kblocked *)
-        jsafe_phi_bupd Jspec ge n ora c' (getThreadR cnti)
+        jsafe_phi_bupd Jspec ge ora c' (getThreadR cnti)
     | Kinit v1 v2 =>
       val_inject (Mem.flat_inj (Mem.nextblock m)) v2 v2 /\
       exists q_new,
-      cl_initial_core ge v1 (v2 :: nil) q_new /\
-      jsafe_phi Jspec ge n ora q_new (getThreadR cnti)
+      cl_initial_core ge v1 (v2 :: nil) = Some q_new /\
+      jsafe_phi Jspec ge ora q_new (getThreadR cnti)
     end.
 
 Lemma mem_cohere'_res : forall m phi phi', mem_cohere' m phi ->
@@ -837,7 +906,57 @@ Proof.
   inversion 1; constructor; repeat intro; rewrite H0 in *; eauto.
 Qed.
 
-Lemma state_inv_upd1 : forall {Z} (Jspec : juicy_ext_spec Z) Gamma (n : nat)
+Lemma mem_cohere'_store ge m (tp : jstate ge) m' b ofs j i Phi (cnti : containsThread tp i):
+  forall (Hcmpt : mem_compatible tp m)
+    (lock : lockRes tp (b, Ptrofs.intval ofs) <> None)
+    (Hlt' : permMapLt
+           (setPermBlock (Some Writable) b (Ptrofs.intval ofs) (juice2Perm_locks (getThreadR cnti) m)
+              LKSIZE_nat) (getMaxPerm m))
+    (Hstore : Mem.store Mptr (restrPermMap Hlt') b (Ptrofs.intval ofs) (Vptrofs j) = Some m'),
+    mem_compatible_with tp m Phi (* redundant with Hcmpt, but easier *) ->
+    (exists phi, join_sub phi Phi /\ exists sh R, LKspec LKSIZE sh R (b, Ptrofs.intval ofs) phi) ->
+    mem_cohere' m' Phi.
+Proof.
+  intros Hcmpt lock Hlt' Hstore compat HLKspec.
+  pose proof store_outside' _ _ _ _ _ _ Hstore as SO.
+  destruct compat as [J MC LW JL LJ].
+  destruct MC as [Co Ac Ma].
+  split.
+  - intros sh sh' v (b', ofs') pp E.
+    specialize (Co sh sh' v (b', ofs') pp E).
+    destruct Co as [<- ->]. split; auto.
+    destruct SO as (Co1 & A1 & N1).
+    specialize (Co1 b' ofs').
+    destruct Co1 as [In|Out].
+    + exfalso (* because there is no lock at (b', ofs') *).
+      destruct HLKspec as (? & J' & ? & ? & HLKspec).
+      apply (resource_at_join_sub _ _ (b', ofs')) in J' as [? J'].
+      rewrite E in J'.
+      specialize (HLKspec (b', ofs')); simpl in HLKspec.
+      rewrite if_true in HLKspec.
+      destruct HLKspec as [? HLK]; rewrite HLK in J'; inv J'.
+      { destruct In; split; auto; lkomega. }
+
+    + rewrite <-Out.
+      unfold juicyRestrict_locks in *.
+      rewrite restrPermMap_contents.
+      auto.
+
+  - intros loc.
+    replace (max_access_at m' loc) with (max_access_at (restrPermMap Hlt') loc).
+    clear SO.
+    unfold juicyRestrict_locks in *.
+    rewrite restrPermMap_max.
+    apply Ac.
+    { unfold max_access_at in *.
+      unfold juicyRestrict_locks in *.
+      destruct SO as (_ & -> & _). reflexivity. }
+
+  - unfold alloc_cohere in *.
+    destruct SO as (_ & _ & <-). auto.
+Qed.
+
+(*Lemma state_inv_upd1 : forall {Z} (Jspec : juicy_ext_spec Z) Gamma (n : nat)
   (m : mem) (ge : genv) (tr : event_trace) (sch : schedule) (tp : ThreadPool.t) (PHI : rmap)
       (lev : level PHI = n)
       (envcoh : env_coherence Jspec ge Gamma PHI)
@@ -847,23 +966,17 @@ Lemma state_inv_upd1 : forall {Z} (Jspec : juicy_ext_spec Z) Gamma (n : nat)
       (lock_sparse : lock_sparsity (lset tp))
       (lock_coh : lock_coherence' tp PHI m mcompat)
       (safety : exists i (cnti : containsThread tp i), let phi := getThreadR cnti in
-       (exists k, getThreadC cnti = Krun k /\
-       forall c, join_sub (Some (ext_ref tt, NoneP) :: nil) c ->
-          joins (ghost_of phi) (ghost_fmap (approx (level phi)) (approx (level phi)) c) ->
-        exists b, joins b (ghost_fmap (approx (level phi)) (approx (level phi)) c) /\
-        exists phi' (Hr : resource_at phi' = resource_at phi), level phi' = level phi /\ ghost_of phi' = b /\
-        forall ora, jsafeN Jspec ge n ora k
-          (personal_mem (mem_cohere'_res _ _ _ (compatible_threadRes_cohere cnti (mem_compatible_forget mcompat)) Hr))) /\
-       forall j (cntj : containsThread tp j), j <> i -> thread_safety Jspec m ge tp PHI mcompat n j cntj)
+       (exists k, getThreadC cnti = Krun k /\ fupd (semax_lemmas.assert_safe1 ge k) phi) /\
+       forall j (cntj : containsThread tp j), j <> i -> thread_safety Jspec m ge tp PHI mcompat j cntj)
       (wellformed : threads_wellformed tp)
       (uniqkrun :  unique_Krun tp sch),
-  state_bupd (state_invariant Jspec Gamma n) (m, (tr, sch, tp)).
+  state_fupd (state_invariant Jspec Gamma n) (m, (tr, sch, tp)).
 Proof.
-  intros; apply state_inv_upd with (mcompat0 := mcompat); auto; intros.
+  intros; apply state_inv_upd with (mcompat := mcompat); auto; intros.
   destruct safety as (i & cnti & [(k & Hk & Hsafe) Hrest]).
   assert (join_all tp PHI) as Hj by (apply mcompat).
   rewrite join_all_joinlist in Hj.
-  eapply joinlist_permutation in Hj; [|apply maps_getthread with (cnti0 := cnti)].
+  eapply joinlist_permutation in Hj; [|apply maps_getthread with (cnti := cnti)].
   destruct Hj as (? & ? & Hphi).
   pose proof (ghost_of_join _ _ _ Hphi) as Hghost.
   destruct H0; destruct (join_assoc Hghost H0) as (c & HC & Hc).
@@ -892,7 +1005,7 @@ Proof.
       + rewrite HL'; auto.
       + rewrite Hr', HR'; intro; apply resource_at_join; auto.
       + apply join_comm; exact_eq Hg'; f_equal.
-        rewrite <- ghost_of_approx at 2; f_equal; rewrite Hl; auto.
+        rewrite Hl, <- H2, ghost_of_approx; auto.
     - assert (forall t, containsThread (updThreadR cnti phi') t <-> containsThread tp t) as Hiff.
       { split; [apply cntUpdateR' | apply cntUpdateR]. }
       exists Hiff; split; auto; intros.
@@ -903,7 +1016,7 @@ Proof.
         replace cnt with cnti by apply proof_irr; auto.
       + erewrite gsoThreadRR by eauto; split; reflexivity. }
   exists _, _, Hupd; split.
-  - replace (level (getThreadR cnti)) with (level PHI) in HC' by omega.
+  - replace (level (getThreadR cnti)) with (level PHI) in HC' by lia.
     rewrite ghost_fmap_fmap, approx_oo_approx in HC'; eauto.
   - intros j cntj ora.
     unshelve erewrite gThreadRC; auto.
@@ -926,13 +1039,7 @@ Proof.
       unfold jm_, personal_mem, m_dry, juicyRestrict.
       apply restrPermMap_irr'.
       rewrite Heq; auto.
-Qed.
-
-(*
-assert (cnti = Htid) by apply proof_irr; subst Htid).
-assert (ctn = cnti) by apply proof_irr; subst cnt).
-destruct (cntAdd' _ _ _ cnti) as [(cnti', ne) | Ei].
-*)
+Qed.*)
 
 Ltac join_sub_tac :=
   try
@@ -1042,20 +1149,33 @@ Lemma FF_orp:
  forall A (ND: NatDed A) (P: A), seplog.orp seplog.FF P = P.
 Proof.
 intros.
-unfold seplog.FF.
-apply seplog.pred_ext.
-apply seplog.orp_left; auto.
-apply prop_left; intro; contradiction.
-apply seplog.orp_right2; auto.
+apply log_normalize.FF_orp.
 Qed.
 
 Lemma TT_andp:
  forall A (ND: NatDed A) (P: A), seplog.andp seplog.TT P = P.
 Proof.
 intros.
-unfold seplog.TT.
-apply seplog.pred_ext.
-apply seplog.andp_left2; auto.
-apply seplog.andp_right; auto.
-apply prop_right; auto.
+apply log_normalize.TT_andp.
 Qed.
+
+Ltac jmstep_inv :=
+  match goal with
+  | H : JuicyMachine.start_thread _ _ _ _  |- _ => inversion H
+  | H : JuicyMachine.resume_thread _ _ _   |- _ => inversion H
+  | H : JuicyMachine.threadStep _ _ _ _ _           |- _ => inversion H
+  | H : JuicyMachine.suspend_thread _ _ _ |- _ => inversion H
+  | H : JuicyMachine.syncStep _ _ _ _ _ _           |- _ => inversion H
+  | H : JuicyMachine.halted_thread _ _                  |- _ => inversion H
+  | H : JuicyMachine.schedfail _         |- _ => inversion H
+  end; try subst.
+
+Ltac getThread_inv :=
+  match goal with
+  | [ H : @getThreadC _ _ _ ?i _ _ = _ ,
+          H2 : @getThreadC _ _ _ ?i _ _ = _ |- _ ] =>
+    pose proof (getThreadC_fun _ _ _ _ _ _ _ H H2)
+  | [ H : @getThreadR _ _ _ ?i _ _ = _ ,
+          H2 : @getThreadR _ _ _ ?i _ _ = _ |- _ ] =>
+    pose proof (getThreadR_fun _ _ _ _ _ _ _ H H2)
+  end.
diff --git a/concurrency/juicy/semax_to_dry_machine.v b/concurrency/juicy/semax_to_dry_machine.v
new file mode 100644
index 0000000000..7ae29e7b0f
--- /dev/null
+++ b/concurrency/juicy/semax_to_dry_machine.v
@@ -0,0 +1,733 @@
+(* Instead of deriving a juicy-machine execution from the CSL proof, we derive a dry-machine execution
+   directly, along the lines of the sequential adequacy proof (veric/SequentialClight). *)
+Require Import Coq.Strings.String.
+
+Require Import compcert.lib.Integers.
+Require Import compcert.common.AST.
+Require Import compcert.cfrontend.Clight.
+Require Import compcert.common.Globalenvs.
+Require Import compcert.common.Memory.
+Require Import compcert.common.Memdata.
+Require Import compcert.common.Values.
+
+Require Import VST.msl.Coqlib2.
+Require Import VST.msl.eq_dec.
+Require Import VST.veric.external_state.
+Require Import VST.veric.juicy_mem.
+Require Import VST.veric.juicy_mem_lemmas.
+Require Import VST.veric.semax_prog.
+Require Import VST.veric.Clight_core.
+Require Import VST.veric.Clightcore_coop.
+Require Import VST.veric.semax.
+Require Import VST.veric.semax_ext.
+Require Import VST.veric.semax_lemmas.
+Require Import VST.veric.juicy_extspec.
+Require Import VST.veric.initial_world.
+Require Import VST.veric.juicy_extspec.
+Require Import VST.veric.tycontext.
+Require Import VST.veric.res_predicates.
+Require Import VST.veric.SequentialClight.
+Require Import VST.floyd.coqlib3.
+Require Import VST.floyd.canon.
+Require Import VST.sepcomp.step_lemmas.
+Require Import VST.sepcomp.event_semantics.
+Require Import VST.sepcomp.extspec.
+Require Import VST.concurrency.juicy.semax_conc_pred.
+Require Import VST.concurrency.juicy.semax_conc.
+(*Require Import VST.concurrency.juicy.juicy_machine.*)
+Require Import VST.concurrency.common.threadPool.
+Require Import VST.concurrency.common.HybridMachineSig.
+Require Import VST.concurrency.common.HybridMachine.
+Require Import VST.concurrency.common.scheduler.
+Require Import VST.concurrency.common.addressFiniteMap.
+Require Import VST.concurrency.common.permissions.
+Require Import VST.concurrency.common.ClightSemanticsForMachines.
+(*Require Import VST.concurrency.juicy.JuicyMachineModule.
+Require Import VST.concurrency.juicy.sync_preds_defs.
+Require Import VST.concurrency.juicy.sync_preds.
+Require Import VST.concurrency.juicy.join_lemmas.
+Require Import VST.concurrency.juicy.semax_invariant.
+Require Import VST.concurrency.juicy.semax_initial.
+Require Import VST.concurrency.juicy.semax_progress.
+Require Import VST.concurrency.juicy.semax_preservation_jspec.
+Require Import VST.concurrency.juicy.semax_safety_makelock.
+Require Import VST.concurrency.juicy.semax_safety_spawn.
+Require Import VST.concurrency.juicy.semax_safety_release.
+Require Import VST.concurrency.juicy.semax_safety_freelock.
+Require Import VST.concurrency.juicy.semax_preservation.
+Require Import VST.concurrency.juicy.semax_simlemmas.*)
+Require Import VST.concurrency.common.dry_machine_lemmas.
+Require Import VST.concurrency.common.dry_machine_step_lemmas.
+Import ThreadPool.
+
+Set Bullet Behavior "Strict Subproofs".
+
+Ltac absurd_ext_link_naming :=
+  exfalso;
+  match goal with
+  | H : Some (_ _, _) = _ |- _ =>
+    rewrite <- ?H in *
+  end;
+  unfold funsig2signature in *;
+  match goal with
+  | H : Some (?ext_link ?a, ?b) <> Some (?ext_link ?a, ?b') |- _ =>
+    simpl in H; [contradiction || congruence]
+  | H : Some (?ext_link ?a, ?c) = Some (?ext_link ?b, ?d) |- _ =>
+    simpl in H;
+    match goal with
+    | ext_link_inj : forall s1 s2, ext_link s1 = ext_link s2 -> s1 = s2 |- _ =>
+      assert (a = b) by (apply ext_link_inj; congruence); congruence
+    end
+  end.
+
+Ltac funspec_destruct s :=
+  simpl (extspec.ext_spec_pre _); simpl (extspec.ext_spec_type _); simpl (extspec.ext_spec_post _);
+  unfold funspec2pre, funspec2post;
+  let Heq_name := fresh "Heq_name" in
+  destruct (oi_eq_dec (Some (_ s, _)) (ef_id_sig _ (EF_external _ _)))
+    as [Heq_name | Heq_name]; try absurd_ext_link_naming.
+
+(*+ Final instantiation *)
+
+Record CSL_proof := {
+  CSL_Σ : gFunctors;
+  CSL_prog : Clight.program;
+  CSL_CS: compspecs;
+  CSL_V : varspecs;
+  CSL_G : @funspecs CSL_Σ;
+  CSL_ext_link : string -> ident;
+  CSL_ext_link_inj : forall s1 s2, CSL_ext_link s1 = CSL_ext_link s2 -> s1 = s2;
+  CSL_all_safe : forall (HH : VSTGS unit CSL_Σ), @semax_prog _ _ HH (concurrent_ext_spec CSL_CS CSL_ext_link)
+    CSL_CS CSL_prog tt CSL_V CSL_G;
+  CSL_init_mem_not_none : Genv.init_mem CSL_prog <> None;
+                   }.
+
+(*
+Definition Clight_init_state (prog:Ctypes.program function) main_symb f_main init_mem :=
+  State Clight_safety.main_handler
+        (Scall None (Etempvar BinNums.xH (type_of_fundef f_main))
+               (List.map (fun x : AST.ident * Ctypes.type => Etempvar (fst x) (snd x))
+                         (Clight_new.params_of_types (BinNums.xO BinNums.xH)
+                                                     (Clight_new.params_of_fundef f_main))))
+        (Kseq (Sloop Sskip Sskip) Kstop) empty_env
+        (temp_bindings BinNums.xH (cons main_symb nil)) init_mem.
+*)
+
+Section Safety.
+  Variable CPROOF: CSL_proof.
+  Definition Σ := CPROOF.(CSL_Σ).
+  Definition CS :=   CPROOF.(CSL_CS).
+  Definition V :=   CPROOF.(CSL_V).
+  Definition G :=   CPROOF.(CSL_G).
+  Definition ext_link :=   CPROOF.(CSL_ext_link).
+  Definition ext_link_inj :=   CPROOF.(CSL_ext_link_inj).
+  Definition prog :=   CPROOF.(CSL_prog).
+  Definition all_safe :=   CPROOF.(CSL_all_safe).
+  Definition init_mem_not_none :=   CPROOF.(CSL_init_mem_not_none).
+  Definition ge := Clight.globalenv CPROOF.(CSL_prog).
+
+  Definition init_mem : {m : mem | Genv.init_mem (CSL_prog CPROOF) = Some m}.
+  Proof.
+    pose proof init_mem_not_none.
+    destruct (Genv.init_mem (CSL_prog CPROOF)); last done.
+    eauto.
+  Defined.
+
+(*   Local Instance CEspec (HH : heapGS Σ) (HE : externalGS unit Σ) (HL : lockGS Σ) : OracleKind :=
+    Concurrent_Espec unit CS ext_link. *)
+
+  Lemma CEspec_cases : forall `{!VSTGS unit Σ} e
+    (x : ext_spec_type (concurrent_ext_spec CS ext_link) e),
+    e = LOCK \/ e = UNLOCK \/ e = MKLOCK \/ e = FREE_LOCK \/ e = CREATE.
+  Proof.
+    intros.
+    simpl in x.
+    repeat (if_tac in x; [destruct e; try done; inversion H as [H1]; apply ext_link_inj in H1 as <-; auto
+      | clear H]); last done.
+  Qed.
+
+  (* funspecs_destruct isn't working well, so prove a spec lemma for each function *)
+  Ltac next_spec := subst; let Hspecs := fresh "Hspecs" in match goal with |-context[add_funspecs_rec _ _ _ ?l] =>
+    destruct l eqn: Hspecs; first done;
+    injection Hspecs; clear Hspecs; intros Hspecs <-; simpl;
+    unfold funspec2pre, funspec2post, ef_id_sig; simpl; if_tac end.
+
+  Ltac solve_spec x := intros; revert x;
+    unfold ext_spec_post, concurrent_ext_spec;
+    pose proof ext_link_inj as Hinj; fold ext_link in Hinj;
+    repeat (next_spec; first absurd_ext_link_naming); next_spec; last done;
+    intros; split; [|intros (? & Heq & ?)]; eauto;
+    inversion Heq as [Heq0 Heq']; apply inj_pair2 in Heq'; subst; auto.
+
+  Lemma CEspec_acquire_pre : forall `{!VSTGS unit Σ} x args z m,
+    ext_spec_pre (concurrent_ext_spec CS ext_link) LOCK x (genv_symb_injective ge) (sig_args (ef_sig LOCK)) args z m <->
+    match acquire_spec with mk_funspec _ _ A _ P _ => exists x'', JMeq.JMeq x x'' /\ funspec2pre' _ A P x'' (genv_symb_injective ge) (sig_args (ef_sig LOCK)) args z m end.
+  Proof.
+    solve_spec x.
+  Qed.
+
+  Lemma CEspec_acquire_post : forall `{!VSTGS unit Σ} x ret z m,
+    ext_spec_post (concurrent_ext_spec CS ext_link) LOCK x (genv_symb_injective ge) (sig_res (ef_sig LOCK)) ret z m <->
+    match acquire_spec with mk_funspec _ _ A _ _ Q => exists x'', JMeq.JMeq x x'' /\ funspec2post' _ A Q x'' (genv_symb_injective ge) (sig_res (ef_sig LOCK)) ret z m end.
+  Proof.
+    solve_spec x.
+  Qed.
+
+  Lemma CEspec_release_pre : forall `{!VSTGS unit Σ} x args z m,
+    ext_spec_pre (concurrent_ext_spec CS ext_link) UNLOCK x (genv_symb_injective ge) (sig_args (ef_sig UNLOCK)) args z m <->
+    match release_spec with mk_funspec _ _ A _ P _ => exists x'', JMeq.JMeq x x'' /\ funspec2pre' _ A P x'' (genv_symb_injective ge) (sig_args (ef_sig UNLOCK)) args z m end.
+  Proof.
+    solve_spec x.
+  Qed.
+
+  Lemma CEspec_release_post : forall `{!VSTGS unit Σ} x ret z m,
+    ext_spec_post (concurrent_ext_spec CS ext_link) UNLOCK x (genv_symb_injective ge) (sig_res (ef_sig UNLOCK)) ret z m <->
+    match release_spec with mk_funspec _ _ A _ _ Q => exists x'', JMeq.JMeq x x'' /\ funspec2post' _ A Q x'' (genv_symb_injective ge) (sig_res (ef_sig UNLOCK)) ret z m end.
+  Proof.
+    solve_spec x.
+  Qed.
+
+  Lemma CEspec_makelock_pre : forall `{!VSTGS unit Σ} x args z m,
+    ext_spec_pre (concurrent_ext_spec CS ext_link) MKLOCK x (genv_symb_injective ge) (sig_args (ef_sig MKLOCK)) args z m <->
+    match makelock_spec CS with mk_funspec _ _ A _ P _ => exists x'', JMeq.JMeq x x'' /\ funspec2pre' _ A P x'' (genv_symb_injective ge) (sig_args (ef_sig MKLOCK)) args z m end.
+  Proof.
+    solve_spec x.
+  Qed.
+
+  Lemma CEspec_makelock_post : forall `{!VSTGS unit Σ} x ret z m,
+    ext_spec_post (concurrent_ext_spec CS ext_link) MKLOCK x (genv_symb_injective ge) (sig_res (ef_sig MKLOCK)) ret z m <->
+    match makelock_spec CS with mk_funspec _ _ A _ _ Q => exists x'', JMeq.JMeq x x'' /\ funspec2post' _ A Q x'' (genv_symb_injective ge) (sig_res (ef_sig MKLOCK)) ret z m end.
+  Proof.
+    solve_spec x.
+  Qed.
+
+  Lemma CEspec_freelock_pre : forall `{!VSTGS unit Σ} x args z m,
+    ext_spec_pre (concurrent_ext_spec CS ext_link) FREE_LOCK x (genv_symb_injective ge) (sig_args (ef_sig FREE_LOCK)) args z m <->
+    match freelock_spec CS with mk_funspec _ _ A _ P _ => exists x'', JMeq.JMeq x x'' /\ funspec2pre' _ A P x'' (genv_symb_injective ge) (sig_args (ef_sig FREE_LOCK)) args z m end.
+  Proof.
+    solve_spec x.
+  Qed.
+
+  Lemma CEspec_freelock_post : forall `{!VSTGS unit Σ} x ret z m,
+    ext_spec_post (concurrent_ext_spec CS ext_link) FREE_LOCK x (genv_symb_injective ge) (sig_res (ef_sig FREE_LOCK)) ret z m <->
+    match freelock_spec CS with mk_funspec _ _ A _ _ Q => exists x'', JMeq.JMeq x x'' /\ funspec2post' _ A Q x'' (genv_symb_injective ge) (sig_res (ef_sig FREE_LOCK)) ret z m end.
+  Proof.
+    solve_spec x.
+  Qed.
+
+  Lemma CEspec_spawn_pre : forall `{!VSTGS unit Σ} x args z m,
+    ext_spec_pre (concurrent_ext_spec CS ext_link) CREATE x (genv_symb_injective ge) (sig_args (ef_sig CREATE)) args z m <->
+    match spawn_spec with mk_funspec _ _ A _ P _ => exists x'', JMeq.JMeq x x'' /\ funspec2pre' _ A P x'' (genv_symb_injective ge) (sig_args (ef_sig CREATE)) args z m end.
+  Proof.
+    solve_spec x.
+  Qed.
+
+  Lemma CEspec_spawn_post : forall `{!VSTGS unit Σ} x ret z m,
+    ext_spec_post (concurrent_ext_spec CS ext_link) CREATE x (genv_symb_injective ge) (sig_res (ef_sig CREATE)) ret z m <->
+    match spawn_spec with mk_funspec _ _ A _ _ Q => exists x'', JMeq.JMeq x x'' /\ funspec2post' _ A Q x'' (genv_symb_injective ge) (sig_res (ef_sig CREATE)) ret z m end.
+  Proof.
+    solve_spec x.
+  Qed.
+
+  Program Definition spr (HH : VSTGS unit Σ) :=
+    semax_prog_rule (concurrent_ext_spec CS ext_link) V G prog
+      (proj1_sig init_mem) 0 tt _ (all_safe HH) (proj2_sig init_mem).
+  Next Obligation.
+  Proof. intros ?????; apply I. Qed.
+
+  Instance Sem : Semantics := ClightSemanticsForMachines.ClightSem (Clight.globalenv CPROOF.(CSL_prog)).
+
+  Existing Instance HybridMachineSig.HybridCoarseMachine.DilMem.
+  Existing Instance HybridMachineSig.HybridCoarseMachine.scheduler.
+
+  (* If there are enough of these conditions, re-split out into semax_invariant. *)
+  Definition dtp := t(ThreadPool := @OrdinalPool.OrdinalThreadPool dryResources Sem).
+
+(*  (* We want to enforce additional coherence properties between the rmap and the memory, accounting
+     for the effects of locks (and other things?). *)
+  Definition lock_coherent_loc m loc (r : dfrac * option resource) : Prop :=
+    match r.2 with
+    | Some (LK _ _ b) => Mem.load Mptr m loc.1 loc.2 = Some (Vptrofs (if b then Ptrofs.zero else Ptrofs.one))
+    | _ => True
+    end.
+
+  Definition lock_coherent m σ := forall loc, lock_coherent_loc m loc (σ @ loc).
+
+  Definition mem_auth' `{!heapGS Σ} m := ∃ σ, ⌜coherent m σ ∧ lock_coherent m σ⌝ ∧ resource_map.resource_map_auth(H0 := gen_heapGpreS_heap(gen_heapGpreS := gen_heap_inG)) (gen_heap_name _) 1 σ.
+  Definition state_interp' {Z} `{!heapGS Σ} `{!externalGS Z Σ} m z := mem_auth' m ∗ ext_auth z.*)
+
+  (* Each thread needs to be safe given only its fragment (access_map) of the shared memory. We use
+     the starting max permissions as an upper bound on the max permissions of the state_interp. *)
+  Program Definition jsafe_perm_pre `{!VSTGS unit Σ} (max : access_map)
+    (jsafe : coPset -d> unit -d> CC_core -d> access_map -d> iPropO Σ) :
+    coPset -d> unit -d> CC_core -d> access_map -d> iPropO Σ := λ E z c p,
+    |={E}=> ∀ m (Hlt : permMapLt p (getMaxPerm m)), ⌜permMapLt (getMaxPerm m) max⌝ → state_interp(*'*) m z -∗
+        (∃ i, ⌜halted (cl_core_sem ge) c i ∧ ext_spec_exit (concurrent_ext_spec CS ext_link) (Some (Vint i)) z m⌝) ∨
+        (|={E}=> ∃ c' m', ⌜corestep (cl_core_sem ge) c (restrPermMap Hlt) c' m'⌝ ∧ (∃ p' (Hlt' : permMapLt p' (getMaxPerm m')), state_interp(*'*) (restrPermMap Hlt') z) (* ?? *) ∗ ▷ jsafe E z c' (getCurPerm m')) ∨
+        (∃ e args x, ⌜at_external (cl_core_sem ge) c (restrPermMap Hlt) = Some (e, args) ∧ ext_spec_pre (concurrent_ext_spec CS ext_link) e x (genv_symb_injective ge) (sig_args (ef_sig e)) args z (restrPermMap Hlt)⌝ ∧
+           ▷ (∀ ret m' z', ⌜Val.has_type_list args (sig_args (ef_sig e)) ∧ Builtins0.val_opt_has_rettype ret (sig_res (ef_sig e))⌝ →
+            ⌜ext_spec_post (concurrent_ext_spec CS ext_link) e x (genv_symb_injective ge) (sig_res (ef_sig e)) ret z' m'⌝ → |={E}=>
+            ∃ c', ⌜after_external (cl_core_sem ge) ret c m' = Some c'⌝ ∧ state_interp(*'*) m' z' ∗ jsafe E z' c' (getCurPerm m'))).
+
+  Local Instance jsafe_perm_pre_contractive `{!VSTGS unit Σ} max : Contractive (jsafe_perm_pre max).
+  Proof.
+    rewrite /jsafe_perm_pre => n jsafe jsafe' Hsafe E z c p.
+    do 16 f_equiv.
+    - f_contractive; repeat f_equiv. apply Hsafe.
+    - f_contractive; repeat f_equiv. apply Hsafe.
+  Qed.
+
+  Local Definition jsafe_perm_def `{!VSTGS unit Σ} max : coPset -> unit -> CC_core -> access_map -> mpred := fixpoint (jsafe_perm_pre max).
+  Local Definition jsafe_perm_aux `{!VSTGS unit Σ} : seal (jsafe_perm_def). Proof. by eexists. Qed.
+  Definition jsafe_perm  `{!VSTGS unit Σ} := jsafe_perm_aux.(unseal).
+  Local Lemma jsafe_perm_unseal  `{!VSTGS unit Σ} : jsafe_perm = jsafe_perm_def.
+  Proof. rewrite -jsafe_perm_aux.(seal_eq) //. Qed.
+
+  Lemma jsafe_perm_unfold `{!VSTGS unit Σ} max E z c p : jsafe_perm max E z c p ⊣⊢ jsafe_perm_pre max (jsafe_perm max) E z c p.
+  Proof. rewrite jsafe_perm_unseal. apply (fixpoint_unfold (@jsafe_perm_pre VSTGS0 max)). Qed.
+
+  Lemma jsafe_perm_mono : forall `{!VSTGS unit Σ} p1 p2 E z c p, permMapLt p2 p1 ->
+    jsafe_perm p1 E z c p ⊢ jsafe_perm p2 E z c p.
+  Proof.
+    intros.
+    iLöb as "IH" forall (p H z c).
+    rewrite !jsafe_perm_unfold /jsafe_perm_pre.
+    iIntros ">H !>" (?? Hmax) "S".
+    pose proof (PreOrder_Transitive _ _ _ Hmax H).
+    iDestruct ("H" with "[%] S") as "[H | [H | H]]"; first done.
+    - iLeft; done.
+    - iRight; iLeft.
+      iMod "H" as (???) "(? & ?)".
+      iIntros "!>"; iExists _, _; iSplit; first done; iFrame.
+      by iApply "IH".
+    - iRight; iRight.
+      iDestruct "H" as (????) "H".
+      iExists _, _, _; iSplit; first done.
+      iNext; iIntros (?????).
+      iMod ("H" with "[%] [%]") as (??) "(? & ?)"; [done..|].
+      iIntros "!>"; iExists _; iSplit; first done; iFrame.
+      by iApply "IH".
+  Qed.
+
+  Existing Instance mem_equiv.access_map_equiv_Equivalence.
+
+  Lemma jsafe_perm_equiv : forall `{!VSTGS unit Σ} p E z c p1 p2, mem_equiv.access_map_equiv p1 p2 ->
+     jsafe_perm p E z c p1 ⊢ jsafe_perm p E z c p2.
+  Proof.
+    intros.
+    iLöb as "IH" forall (p z c p1 p2 H).
+    rewrite !jsafe_perm_unfold /jsafe_perm_pre.
+    iIntros ">H !>" (?? Hmax) "S".
+    assert (permMapLt p1 (getMaxPerm m)) as Hlt1.
+    { eapply mem_equiv.permMapLt_equiv; done. }
+    iDestruct ("H" $! _ Hlt1 with "[%] S") as "[H | [H | H]]"; first done.
+    - iLeft; done.
+    - iRight; iLeft.
+      iMod "H" as (???) "(S & Hsafe)".
+      unshelve erewrite restrPermMap_ext in H0; try done.
+      iIntros "!>"; iExists _, _; iSplit; first done.
+      iSplitL "S".
+      + iDestruct "S" as (??) "S".
+        iFrame.
+      + iApply ("IH" with "[%] Hsafe").
+        by apply mem_equiv.cur_eqv.
+    - iRight; iRight.
+      iDestruct "H" as (????) "H".
+      iExists _, _, _; iSplit.
+      + pose proof (restrPermMap_ext Hlt1 Hlt H) as <-; try done.
+      + iNext; iIntros (?????).
+        iMod ("H" with "[%] [%]") as (??) "(? & ?)"; [done..|].
+        iIntros "!>". iExists _. iFrame.
+        iPureIntro. done.
+  Qed.
+
+  Lemma jsafe_jsafe_perm : forall `{!VSTGS unit Σ} max E z c p, p = max ->
+    jsafe(genv_symb := genv_symb_injective) (cl_core_sem ge) (concurrent_ext_spec CS ext_link) ge E z c ⊢ jsafe_perm max E z c p.
+  Proof.
+    intros.
+    iLöb as "IH" forall (p H z c).
+    rewrite jsafe_unfold jsafe_perm_unfold /jsafe_pre /jsafe_perm_pre.
+    iIntros ">H !>" (?? Hmax) "S".
+    subst; pose proof (partial_order_antisym mem_equiv.permMapLt_order _ _ Hlt Hmax) as Heq.
+(*    iDestruct "S" as "((% & (% & %Hlock) & Hm) & Hz)". *)
+    iDestruct ("H" with "S") as "[H | [H | H]]".
+    - by iLeft.
+    - iRight; iLeft.
+      iMod "H" as (???) "(S & Hsafe)".
+      (* do we need to bring back mem_sub for this? *)
+      assert (exists m'', corestep (cl_core_sem ge) c (restrPermMap Hlt) c' m'' /\ exists p' (Hlt' : permMapLt p' (getMaxPerm m')), m'' = restrPermMap Hlt') as (? & ? & ? & Hlt' & ->) by admit.
+      iIntros "!>"; iExists _, _; iSplit; first done.
+      iSplitL "S".
+      + assert (permMapLt (getCurPerm m') (getMaxPerm (restrPermMap Hlt'))) as Hltm'.
+        { rewrite restr_Max_eq; apply cur_lt_max. }
+        iExists _, Hltm'; rewrite restrPermMap_idem restrPermMap_eq //.
+      + iNext; iApply ("IH" with "[%] Hsafe").
+        admit. (* something about how perms being maxxed carries forward *)
+    - iRight; iRight.
+      iDestruct "H" as (??? (? & ?)) "H".
+      assert (ext_spec_pre (concurrent_ext_spec CS ext_link) e x (genv_symb_injective ge)
+       (sig_args (ef_sig e)) args z (restrPermMap Hlt)) by admit.
+      iExists _, _, _; iSplit; first done.
+      iIntros "!>" (?????).
+      iMod ("H" with "[%] [%]") as (??) "(S & Hsafe)"; [done..|].
+      iIntros "!>"; iExists _; iSplit; first done.
+      iFrame; iApply ("IH" with "[%] Hsafe").
+  Admitted.
+
+  Definition thread_safe `{!VSTGS unit Σ} max (tp : dtp) i :=
+    ∃ cnti : containsThread tp i,
+    match getThreadC cnti with
+    | Krun c | Kblocked c => jsafe_perm max ⊤ tt c (getThreadR cnti).1
+    | Kresume c v =>
+      ∀ c',
+        (* [v] is not used here. The problem is probably coming from
+           the definition of JuicyMachine.resume_thread'. *)
+        ⌜cl_after_external None c = Some c'⌝ →
+        jsafe_perm max ⊤ tt c' (getThreadR cnti).1
+    | Kinit v1 v2 =>
+      ∃ q_new,
+      ⌜cl_initial_core ge v1 (v2 :: nil) = Some q_new⌝ ∧
+      jsafe_perm max ⊤ tt q_new (getThreadR cnti).1
+    end%I.
+
+  Definition threads_safe `{!VSTGS unit Σ} max (tp : dtp) : mpred :=
+    [∗ list] i ∈ seq 0 (pos.n (OrdinalPool.num_threads tp)), thread_safe max tp i.
+
+  Definition threads_wellformed (tp : dtp) :=
+    forall i (cnti : containsThread(ThreadPool := OrdinalPool.OrdinalThreadPool) tp i),
+    match getThreadC cnti with
+    | Krun q => Logic.True
+    | Kblocked q => cl_at_external q <> None
+    | Kresume q v => cl_at_external q <> None /\ v = Vundef
+    | Kinit _ _ => Logic.True
+    end.
+
+  Definition locks_coherent `{!heapGS Σ} (tp : dtp) (m : mem) (ls : gmap address unit) :=
+    forall l, (l ∈ dom ls -> lockRes tp l <> None /\ (Mem.load Mptr m l.1 l.2 = Some (Vptrofs Ptrofs.zero) <-> lockRes tp l = Some (empty_map, empty_map))).
+
+  Existing Instance HybridMachine.DryHybridMachine.DryHybridMachineSig.
+
+  Definition other_threads_safe `{!VSTGS unit Σ} max tp i : mpred :=
+    ∀ Ψ, □ (∀ k j, ⌜seq 0 (pos.n (OrdinalPool.num_threads tp)) !! k = Some j⌝ → ⌜k ≠ i⌝ →
+        thread_safe max tp j -∗ Ψ k j) -∗
+      Ψ i i -∗ [∗ list] k↦y ∈ seq 0 (pos.n (OrdinalPool.num_threads tp)), Ψ k y.
+
+  Definition post_safe `{!VSTGS unit Σ} max sig x c args k : mpred :=
+    ∀ (ret : option val) (m' : mem) z',
+      ⌜Val.has_type_list args (sig_args sig) ∧ Builtins0.val_opt_has_rettype ret (sig_res sig)⌝ →
+      ⌜ext_spec_post (concurrent_ext_spec CS ext_link) LOCK x (genv_symb_injective ge) (sig_res sig) ret z' m'⌝ →
+      |={⊤}=> ∃ c' : CC_core, ⌜after_external (cl_core_sem ge) ret (Callstate c args k) m' = Some c'⌝ ∧
+        state_interp m' z' ∗ jsafe_perm max ⊤ z' c' (getCurPerm m').
+
+(*  (* these lemmas could be split off again into semax_acquire_safety, etc. *)
+  Lemma acquire_safe `{!VSTGS unit Σ} tp m ls i
+    (Htp_wf : threads_wellformed tp) (Hinvariant : invariant tp) (Hcompat : HybridMachineSig.mem_compatible tp m)
+    (cnti : containsThread tp i) argsty retty cc k args
+    (Hi : getThreadC cnti = Kblocked (Callstate (Ctypes.External LOCK argsty retty cc) args k))
+    p (Hmax : permMapLt p (getMaxPerm m)) (Hlt0 : permMapLt (getThreadR cnti).1 (getMaxPerm (restrPermMap Hmax)))
+    x (Hpre : ext_spec_pre (concurrent_ext_spec CS ext_link) LOCK x (genv_symb_injective ge) (sig_args (ef_sig LOCK)) args () (restrPermMap Hlt0)) :
+    ⊢ other_threads_safe (getMaxPerm m) tp i -∗
+      ▷ post_safe (getMaxPerm m) (ef_sig LOCK) x (Ctypes.External LOCK argsty retty cc) args k -∗
+      lock_set ls -∗
+      |={⊤}[∅]▷=> ∃ (tp' : t) (m' : mem) (ev : Events.sync_event),
+        ⌜threads_wellformed tp' ∧ invariant tp' ∧ mem_compatible tp' m' ∧ locks_coherent tp' m' ls ∧ syncStep true cnti Hcompat tp' m' ev⌝ ∧
+        threads_safe (getMaxPerm m') tp' ∗ (∃ (p0 : access_map) (Hlt : permMapLt p0 (getMaxPerm m')), state_interp (restrPermMap Hlt) ()) ∗ lock_set ls.
+  Proof.
+    iIntros "Hsafe Hpost locks".
+    apply CEspec_acquire_pre in Hpre as (x' & Heqx & Hpre).
+    destruct x' as ((n, phi), ((l, sh), R)); simpl in Hpre.
+    destruct Hpre as (Hvphi & Hty & Hpre).
+    set (c := Callstate (Ctypes.External LOCK argsty retty cc) args k).
+    destruct args as [|arg args]; simpl in Hty; first done.
+    destruct Hty as (Hty & Htys); destruct args; last done.
+    clear Htys.
+    assert (readable_share sh /\ val_lemmas.isptr arg) as (Hsh & Hisptr).
+    { revert Hpre; rewrite /PROPx /PARAMSx /GLOBALSx /LOCALx /SEPx; monPred.unseal; ouPred.unseal.
+      intros (? & ? & ? & _ & (? & _) & [=] & _ & ? & ? & ? & Hlock & _).
+      pose proof (lockinv_isptr sh l R) as [Heq].
+      apply Heq in Hlock.
+      revert Hlock; ouPred.unseal; intros (? & _); subst; done.
+      { eapply cmra_validN_op_l, ora_validN_orderN; last done.
+        eapply cmra_validN_op_r, ora_validN_orderN; done. } }
+    destruct arg as [| | | | | b ofs]; try done.
+    clear Hty Hisptr.
+    (* Does the ls ghost state actually work? We don't have that phi is true in the current state. *)
+    assert (ext_step cnti Hcompat (updLockSet (updThread cnti (Kresume c Vundef) newThreadPerm) (b, Ptrofs.intval ofs) (empty_map, empty_map)) m' (Events.acquire (b, Ptrofs.intval ofs) (Some (build_delta_content virtueThread.1 m')))) as Hstep.
+
+    iMod ("Hpost" with "[%] [%]").
+  Admitted. *)
+
+  Theorem dry_safety `{!VSTGpreS unit Σ} `{!inG Σ (gmap_view.gmap_viewR address unitR)} sch n : exists b c_init,
+    Genv.find_symbol (globalenv prog) (Ctypes.prog_main prog) = Some b /\
+    cl_initial_core (globalenv prog) (Vptr b Ptrofs.zero) [] = Some c_init /\
+    HybridMachineSig.HybridCoarseMachine.csafe
+       (ThreadPool:= threadPool.OrdinalPool.OrdinalThreadPool(Sem:=ClightSem ge))
+     (sch, [],
+      DryHybridMachine.initial_machine(Sem := Sem) (getCurPerm (proj1_sig init_mem))
+        c_init) (proj1_sig init_mem) n.
+  Proof.
+    eapply ouPred.pure_soundness, (step_fupdN_soundness_no_lc' _ (S n) O); [apply _..|].
+    simpl; intros; iIntros "_".
+    iMod (@init_VST _ _ VSTGpreS0) as "H".
+    iDestruct ("H" $! Hinv) as (?? HE) "(H & ?)".
+    iMod (own_alloc(A := gmap_view.gmap_viewR address unit) (gmap_view.gmap_view_auth (dfrac.DfracOwn 1) ∅)) as (γl) "locks".
+    { apply gmap_view.gmap_view_auth_valid. }
+    set (HH := Build_VSTGS _ _ (HeapGS _ _ _ _) HE).
+    destruct (spr HH) as (b & q & (? & ? & Hinit) & Hsafe); [| done..].
+    iMod (Hsafe with "H") as "(S & Hsafe)".
+    iAssert (|={⊤}[∅]▷=>^n ⌜HybridMachineSig.HybridCoarseMachine.csafe
+         (ThreadPool:= threadPool.OrdinalPool.OrdinalThreadPool(Sem:=ClightSem ge))
+       (sch, [],
+        DryHybridMachine.initial_machine(Sem := Sem) (getCurPerm (proj1_sig init_mem))
+          q) (proj1_sig init_mem) n⌝) with "[S Hsafe locks]" as "Hdry".
+    2: { iApply step_fupd_intro; first done.
+         iNext; iApply (step_fupdN_mono with "Hdry").
+         iPureIntro. intros.
+         eexists. eexists. split; first done; split; first apply Hinit; done. }
+    clear Hinit Hsafe.
+    rewrite bi.and_elim_l.
+    set (tp := initial_machine _ _).
+    assert (invariant tp) as Hinvariant by apply ThreadPoolWF.initial_invariant0.
+    assert (HybridMachineSig.mem_compatible tp (`init_mem)) as Hcompat by apply ThreadPoolWF.initial_mem_compatible.
+    assert (threads_wellformed tp) as Htp_wf by done.
+    iAssert (threads_safe(VSTGS0 := HH) (getMaxPerm (`init_mem)) tp) with "[Hsafe]" as "Hsafe".
+    { rewrite /threads_safe /=.
+      iSplit; last done.
+      unshelve iExists _; first done.
+      iApply (jsafe_jsafe_perm with "Hsafe").
+      admit. (* should be provable, but is this what we need? *) }
+    assert (locks_coherent tp (`init_mem) ∅) as Hlocks by done.
+    forget (proj1_sig init_mem) as m.
+    forget (@nil Events.machine_event) as tr.
+    clearbody tp.
+    set (ls := ∅) in Hlocks |- *.
+(*     iAssert (lock_set ls) with "locks" as "locks". *)
+    clearbody ls.
+    clear dependent b x q.
+    (* the machine semantics clobber the curPerm with the most recent thread's curPerm *)
+    iAssert (∃ p (Hlt : permMapLt p (getMaxPerm m)), state_interp (restrPermMap Hlt) tt) with "[S]" as "S".
+    { iExists _, (cur_lt_max m); rewrite restrPermMap_eq //. }
+    iLöb as "IH" forall (sch tr tp m n ls Htp_wf Hinvariant Hcompat Hlocks).
+    destruct n as [|n].
+    { iPureIntro. constructor. }
+    destruct sch as [|i sch].
+    { iApply step_fupdN_intro; first done; iPureIntro. constructor; done. }
+    simpl; destruct (lt_dec i (pos.n (OrdinalPool.num_threads tp))).
+    2: { iApply step_fupd_intro; first done; iNext.
+         iAssert (|={⊤}[∅]▷=>^n ∀ U'', ⌜HybridMachineSig.HybridCoarseMachine.csafe (U'', tr, tp) m n⌝) with "[-]" as "H".
+         { rewrite step_fupdN_plain_forall //.
+           iIntros.
+           iApply ("IH" with "[%] [%] [%] [%] locks Hsafe S"); try done.
+         }
+         iApply (step_fupdN_mono with "H"); iPureIntro.
+         intros Hsafe.
+         eapply HybridMachineSig.HybridCoarseMachine.AngelSafe
+           with (tr := []); simpl; rewrite seq.cats0; last apply Hsafe.
+         eapply HybridMachineSig.schedfail; eauto.
+         rewrite /containsThread /= /OrdinalPool.containsThread.
+         intros ?.
+         pose proof (@ssrnat.leP (S i) (pos.n (OrdinalPool.num_threads tp))) as Hle; inv Hle;
+           [lia | congruence]. }
+    rewrite {2}/threads_safe.
+    iPoseProof (big_sepL_lookup_acc_impl with "[$Hsafe]") as "Hsafe".
+    apply lookup_seq; eauto.
+    iDestruct "Hsafe" as "((% & Hsafei) & Hsafe)".
+    destruct (getThreadC cnti) eqn: Hi.
+    - (* Krun *)
+      destruct (cl_halted s) eqn: Hhalt; [|destruct (cl_at_external s) eqn: Hat_ext].
+      + (* halted *)
+        assert (HybridMachineSig.halted_thread cnti Int.zero) as Hhalt'.
+        { econstructor; eauto.
+          hnf; rewrite Hhalt //. }
+        iApply step_fupd_intro; first done; iNext.
+        iAssert (threads_safe (getMaxPerm m) tp) with "[Hsafei Hsafe]" as "Hsafe".
+        { iApply "Hsafe".
+          * iIntros "!>" (????) "H"; iApply "H".
+          * iExists cnti; rewrite Hi //. }
+        iAssert (|={⊤}[∅]▷=>^n ∀ U'', ⌜HybridMachineSig.HybridCoarseMachine.csafe (U'', tr, tp) m n⌝) with "[-]" as "H".
+        { rewrite step_fupdN_plain_forall //.
+          iIntros; iApply ("IH" with "[%] [%] [%] [%] locks Hsafe S"); done. }
+        iApply (step_fupdN_mono with "H"); iPureIntro.
+        intros Hsafe.
+        eapply HybridMachineSig.HybridCoarseMachine.AngelSafe with (tr := []); simpl; rewrite seq.cats0; last apply Hsafe.
+        eapply HybridMachineSig.halted_step; eauto.
+      + (* HybridMachineSig.suspend_step *)
+        assert (HybridMachineSig.suspend_thread m cnti (updThreadC cnti (Kblocked s))) as Hsuspend.
+        { eapply (HybridMachineSig.SuspendThread _ _ _ _ _ _ _ _ Hcompat); done. }
+        iApply step_fupd_intro; first done; iNext.
+        iAssert (|={⊤}[∅]▷=>^n ∀ U'', ⌜HybridMachineSig.HybridCoarseMachine.csafe (U'', tr, (updThreadC cnti (Kblocked s))) m n⌝) with "[-]" as "H".
+        { rewrite step_fupdN_plain_forall //.
+          iIntros; iApply ("IH" with "[%] [%] [%] [%] locks [Hsafe Hsafei]").
+          (*
+          
+          iIntros; iApply ("IH" with "[%] [%] [%] [%] locks S [Hsafei Hsafe]"). *)
+          + intros j cntj.
+            destruct (eq_dec j i).
+            * subst; rewrite gssThreadCC Hat_ext //.
+            * pose proof (cntUpdateC' _ cnti cntj) as cntj0.
+              rewrite -gsoThreadCC //; apply Htp_wf.
+          + by apply ThreadPoolWF.updThreadC_invariant.
+          + by apply StepLemmas.updThreadC_compatible.
+          + intros ?; rewrite gsoThreadCLPool; apply Hlocks.
+          + iApply "Hsafe".
+            * iIntros "!>" (?? (-> & ?)%lookup_seq ?) "(% & Hsafe)".
+              iExists (cntUpdateC _ _ _); rewrite -gsoThreadCC // gThreadCR //.
+            * iExists (cntUpdateC _ _ _); rewrite gssThreadCC gThreadCR.
+              by iApply "Hsafei".
+          + iFrame.
+        }
+        iApply (step_fupdN_mono with "H"); iPureIntro; intros Hsafe.
+        eapply HybridMachineSig.HybridCoarseMachine.AngelSafe with (tr := []); simpl; rewrite seq.cats0; last apply Hsafe.
+        eapply HybridMachineSig.suspend_step; eauto.
+      + (* corestep: HybridMachineSig.thread_step *)
+        rewrite jsafe_perm_unfold /jsafe_perm_pre.
+        iDestruct "S" as (? Hmax) "S".
+        assert (permMapLt (getThreadR cnti).1 (getMaxPerm (restrPermMap Hmax))) as Hlt0.
+        { rewrite restr_Max_eq. by apply compat_th. }
+        iMod ("Hsafei" $! _ Hlt0 with "[%] S") as "[Hhalt | [Hstep | Hext]]".
+        { rewrite restr_Max_eq //. }
+        { iDestruct "Hhalt" as %(? & Hhalt' & ?); done. }
+        2: { iDestruct "Hext" as (??? (Hext & ?)) "?".
+             simpl in Hext; congruence. }
+        iMod "Hstep" as (?? Hstep) "(S & Hsafei)".
+        rewrite restrPermMap_idem in Hstep.
+        assert (corestep (cl_core_sem ge) s (restrPermMap (ssrfun.pair_of_and (Hcompat i cnti)).1) c' m') as Hstep'.
+        { by erewrite restrPermMap_irr. }
+        iApply step_fupd_intro; first done; iNext.
+        apply (ev_step_ax2 (Clight_evsem.CLC_evsem ge)) in Hstep' as (? & Hstep').
+        iSpecialize ("IH" $! _ _ (updThread cnti (Krun c') (getCurPerm m', (getThreadR cnti).2)) with "[%] [%] [%] [%] locks [Hsafe Hsafei] ").
+        * intros j cntj.
+          destruct (eq_dec j i); first by subst; rewrite gssThreadCode.
+          pose proof (cntUpdate' _ _ cnti cntj).
+          rewrite gsoThreadCode //; apply Htp_wf.
+        * eapply (CoreLanguageDry.corestep_invariant(Sem := Sem)); try done.
+          by eapply ev_step_ax1.
+        * by eapply (CoreLanguageDry.corestep_compatible(Sem := Sem)).
+        * intros ?; rewrite gsoThreadLPool. (*eapply Hlocks. need to know that coresteps don't mess with locks *) admit.
+        * iApply "Hsafe".
+          -- iIntros "!>" (?? (-> & ?)%lookup_seq ?) "(% & Hsafe)".
+             iExists (cntUpdate _ _ cnti cnti0).
+             rewrite gsoThreadCode //.
+             rewrite gsoThreadRes //.
+             admit. (* need to know that any changes to getMaxPerm don't invalidate other threads! *)
+          -- iExists (cntUpdate _ _ cnti cnti).
+             rewrite gssThreadCode gssThreadRes.
+             simpl in *. 
+             admit.
+        * (* Work from here *)
+          iApply (step_fupdN_mono with "[IH]").
+          iIntros "_".
+          iPureIntro;
+          eapply HybridMachineSig.HybridCoarseMachine.CoreSafe.
+          rewrite /HybridMachineSig.MachStep /=.
+          change (i :: sch) with (HybridMachineSig.yield (i :: sch)) at 2.
+          change m' with (HybridMachineSig.diluteMem m') at 3.
+          eapply HybridMachineSig.thread_step; first done.
+          eapply step_dry.
+          simpl. repeat try done. done. done.
+          simpl in *. eauto. done. simpl in *.
+
+          (*
+          
+          iPureIntro; intros Hsafe.
+          eapply HybridMachineSig.HybridCoarseMachine.CoreSafe, Hsafe.
+          rewrite /HybridMachineSig.MachStep /=.
+          change (i :: sch) with (HybridMachineSig.yield (i :: sch)) at 2.
+          change m' with (HybridMachineSig.diluteMem m') at 3.
+          eapply HybridMachineSig.thread_step; first done.
+          by eapply step_dry. *) admit. admit.
+    - (* Kblocked: HybridMachineSig.sync_step *)
+      pose proof (Htp_wf _ cnti) as Hwfi; rewrite Hi in Hwfi.
+      rewrite jsafe_perm_unfold /jsafe_perm_pre.
+      iDestruct "S" as (? Hmax) "S".
+      assert (permMapLt (getThreadR cnti).1 (getMaxPerm (restrPermMap Hmax))) as Hlt0.
+      { rewrite restr_Max_eq. by apply compat_th. }
+      iMod ("Hsafei" $! _ Hlt0 with "[%] S") as "[Hhalt | [Hstep | Hext]]".
+      { rewrite restr_Max_eq //. }
+      { iDestruct "Hhalt" as %(? & Hhalt' & ?).
+        destruct s; done. }
+      { iMod "Hstep" as (?? Hstep) "?".
+        apply cl_corestep_not_at_external in Hstep; done. }
+      iDestruct "Hext" as (??? (Hat_ext & Hpre)) "Hpost".
+      iAssert (|={⊤}[∅]▷=> ∃ (tp' : t(ThreadPool := OrdinalPool.OrdinalThreadPool)) m' ev, ⌜threads_wellformed tp' ∧ invariant tp' ∧ mem_compatible tp' m' ∧
+        locks_coherent tp' m' ls ∧ syncStep true cnti Hcompat tp' m' ev⌝ ∧
+        threads_safe (getMaxPerm m') tp' ∗ (∃ p (Hlt : permMapLt p (getMaxPerm m')), state_interp (restrPermMap Hlt) tt) ∗ lock_set ls) with "[-]" as "Hsafe".
+      2: { iMod "Hsafe"; iIntros "!> !>"; iMod "Hsafe" as (??? (? & ? & ? & ? & ?)) "(Hsafe & S & locks)".
+           iAssert (|={⊤}[∅]▷=>^n ∀ U'', ⌜HybridMachineSig.HybridCoarseMachine.csafe (U'', tr ++ [Events.external i ev], tp') m' n⌝) with "[-]" as "H".
+           { rewrite step_fupdN_plain_forall //.
+             iIntros; iApply ("IH" with "[%] [%] [%] [%] Hsafe locks S"); done. }
+           iApply (step_fupdN_mono with "H"); iPureIntro.
+           intros Hsafe.
+           eapply HybridMachineSig.HybridCoarseMachine.AngelSafe; simpl; last apply Hsafe.
+           eapply HybridMachineSig.sync_step; eauto. }
+      (* consider each of the concurrency functions *)
+      clear Hwfi.
+      destruct s as [|f ? k|]; try done; simpl in Hat_ext.
+      destruct f as [|ext argsty retty cc]; try done.
+      destruct (ef_inline ext); inv Hat_ext.
+      destruct (CEspec_cases _ x) as [-> | [-> | [-> | [-> | ->]]]].
+      + (* acquire *)
+        iApply (acquire_safe with "Hsafe Hpost locks").
+      + (* release *)
+      + (* makelock *)
+      + (* freelock *)
+      + (* spawn *)
+    - (* Kresume: HybridMachineSig.resume_step *)
+      pose proof (Htp_wf _ cnti) as Hwfi; rewrite Hi in Hwfi; destruct Hwfi as (? & ->).
+      destruct s; try done.
+      destruct f; try done.
+      assert (HybridMachineSig.resume_thread m cnti (updThreadC cnti (Krun (Returnstate Vundef c)))) as Hresume.
+      { unfold cl_at_external in *; destruct (ef_inline e) eqn: Hinline; try done.
+        eapply (HybridMachineSig.ResumeThread _ _ _ _ _ _ _ _ _ Hcompat); try done; simpl; by rewrite ?Hinline. }
+      iApply step_fupd_intro; first done; iNext.
+      iSpecialize ("IH" $! _ _ (updThreadC cnti (Krun (Returnstate Vundef c))) with "[%] [%] [%] [Hsafei Hsafe] S").
+      + intros j cntj.
+        destruct (eq_dec j i).
+        * subst; rewrite gssThreadCC //.
+        * pose proof (cntUpdateC' _ cnti cntj) as cntj0.
+          rewrite -gsoThreadCC //; apply Htp_wf.
+      + by apply ThreadPoolWF.updThreadC_invariant.
+      + by apply StepLemmas.updThreadC_compatible.
+      + iApply "Hsafe".
+        * iIntros "!>" (?? (-> & ?)%lookup_seq ?) "(% & Hsafe)".
+          iExists (cntUpdateC _ _ _); rewrite -gsoThreadCC // gThreadCR //.
+        * iExists (cntUpdateC _ _ _); rewrite gssThreadCC gThreadCR.
+          by iApply "Hsafei".
+      + iApply (step_fupdN_mono with "IH"); iPureIntro; intros Hsafe.
+        eapply HybridMachineSig.HybridCoarseMachine.CoreSafe with (tr := []); simpl; rewrite seq.cats0; last apply Hsafe.
+        change (i :: sch) with (HybridMachineSig.yield (i :: sch)) at 2.
+        eapply HybridMachineSig.resume_step; eauto.
+    - (* Kinit: HybridMachineSig.start_step *)
+      iDestruct "Hsafei" as (? Hinit) "Hsafei".
+      set (m' := restrPermMap (ssrfun.pair_of_and (Hcompat i cnti)).1).
+      set (tp' := updThread cnti (Krun q_new) (HybridMachineSig.add_block Hcompat cnti m')).
+      assert (HybridMachineSig.start_thread m cnti tp' m').
+      { econstructor; done. }
+      iApply step_fupd_intro; first done; iNext.
+      iSpecialize ("IH" $! _ _ tp' m' with "[%] [%] [%] [Hsafei Hsafe] [S]").
+      + intros j cntj.
+        destruct (eq_dec j i).
+        * subst; rewrite gssThreadCode //.
+        * pose proof (cntUpdate' _ _ cnti cntj).
+          rewrite gsoThreadCode //; apply Htp_wf.
+      + by eapply (CoreLanguageDry.initial_core_invariant(Sem := Sem)).
+      + eapply InternalSteps.start_compatible; try done.
+      + iApply "Hsafe".
+        * iIntros "!>" (?? (-> & ?)%lookup_seq ?) "(% & Hsafe)".
+          iExists (cntUpdate _ _ cnti cnti0); rewrite gsoThreadCode // gsoThreadRes //.
+          subst m'; rewrite restr_Max_eq //.
+        * iExists (cntUpdate _ _ cnti cnti); rewrite gssThreadCode gssThreadRes.
+          rewrite restr_Max_eq /=.
+          iApply (jsafe_perm_equiv with "Hsafei").
+          symmetry; apply mem_equiv.getCur_restr.
+      + iDestruct "S" as (??) "S".
+        iExists _, (mem_equiv.useful_permMapLt_trans _ Hlt).
+        rewrite restrPermMap_idem. erewrite restrPermMap_irr; done.
+      + iApply (step_fupdN_mono with "IH"); iPureIntro; intros Hsafe.
+        eapply HybridMachineSig.HybridCoarseMachine.CoreSafe with (tr := []); simpl; rewrite seq.cats0; last apply Hsafe.
+        change (i :: sch) with (HybridMachineSig.yield (i :: sch)) at 2.
+        change m' with (HybridMachineSig.diluteMem m').
+        eapply HybridMachineSig.start_step; eauto.
+  Admitted.
+
+End Safety.
diff --git a/concurrency/juicy/semax_to_juicy_machine.v b/concurrency/juicy/semax_to_juicy_machine.v
index 1ccee0958a..ba297f5baa 100644
--- a/concurrency/juicy/semax_to_juicy_machine.v
+++ b/concurrency/juicy/semax_to_juicy_machine.v
@@ -10,15 +10,11 @@ Require Import compcert.common.Values.
 
 Require Import VST.msl.Coqlib2.
 Require Import VST.msl.eq_dec.
-Require Import VST.msl.seplog.
-Require Import VST.veric.aging_lemmas.
-Require Import VST.veric.initial_world.
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.juicy_mem_lemmas.
 Require Import VST.veric.semax_prog.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.Clight_new.
-Require Import VST.veric.Clightnew_coop.
+Require Import VST.veric.Clight_core.
+Require Import VST.veric.Clightcore_coop.
 Require Import VST.veric.semax.
 Require Import VST.veric.semax_ext.
 Require Import VST.veric.semax_lemmas.
@@ -41,9 +37,6 @@ Require Import VST.concurrency.juicy.JuicyMachineModule.
 Require Import VST.concurrency.juicy.sync_preds_defs.
 Require Import VST.concurrency.juicy.sync_preds.
 Require Import VST.concurrency.juicy.join_lemmas.
-(*Require Import VST.concurrency.cl_step_lemmas.
-Require Import VST.concurrency.resource_decay_lemmas.
-Require Import VST.concurrency.resource_decay_join.*)
 Require Import VST.concurrency.juicy.semax_invariant.
 Require Import VST.concurrency.juicy.semax_initial.
 Require Import VST.concurrency.juicy.semax_progress.
diff --git a/concurrency/juicy/sync_preds.v b/concurrency/juicy/sync_preds.v
index c2676c6e18..51bdf2f173 100644
--- a/concurrency/juicy/sync_preds.v
+++ b/concurrency/juicy/sync_preds.v
@@ -10,24 +10,17 @@ Require Import compcert.common.Values.
 
 Require Import VST.msl.Coqlib2.
 Require Import VST.msl.eq_dec.
-Require Import VST.msl.seplog.
-Require Import VST.msl.age_to.
-Require Import VST.veric.aging_lemmas.
 Require Import VST.veric.initial_world.
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.juicy_mem_lemmas.
 Require Import VST.veric.semax_prog.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.Clight_new.
-Require Import VST.veric.Clightnew_coop.
+Require Import VST.veric.Clight_core.
+Require Import VST.veric.Clightcore_coop.
 Require Import VST.veric.semax.
-Require Import VST.veric.semax_ext.
-Require Import VST.veric.juicy_extspec.
 Require Import VST.veric.juicy_extspec.
 Require Import VST.veric.tycontext.
 Require Import VST.veric.semax_ext.
 Require Import VST.veric.res_predicates.
-Require Import VST.veric.age_to_resource_at.
 Require Import VST.veric.coqlib4.
 Require Import VST.sepcomp.step_lemmas.
 Require Import VST.sepcomp.event_semantics.
@@ -46,7 +39,7 @@ Import threadPool.
 
 Set Bullet Behavior "Strict Subproofs".
 
-(** * Results related to resouce_decay *)
+(** * Results related to resource_decay *)
 
 (* todo: maybe remove one of those lemmas *)
 
@@ -60,13 +53,13 @@ Proof.
 Qed.
 
 Lemma interval_adr_range b start length i :
-  Intv.In i (start, start + length) <->
+  Intv.In i (start, start + length)%Z <->
   adr_range (b, start) length (b, i).
 Proof.
   compute; intuition.
 Qed.
 
-Lemma join_YES_l {r1 r2 r3 sh1 sh1' k pp} :
+(*Lemma join_YES_l {r1 r2 r3 sh1 sh1' k pp} :
   sepalg.join r1 r2 r3 ->
   r1 = YES sh1 sh1' k pp ->
   exists sh3 sh3',
@@ -75,7 +68,7 @@ Proof.
   intros J; inversion J; intros.
   all:try congruence.
   all:do 2 eexists; f_equal; try congruence.
-Qed.
+Qed.*)
 
 
 Local Open Scope nat_scope.
@@ -94,10 +87,10 @@ Lemma fst_snd0: forall loc: address,
    (fst loc, (snd loc + 0)%Z) = loc.
 Proof.
 intros.
- pose proof (LKSIZE_pos). destruct loc; simpl; f_equal; auto. omega.
+ pose proof (LKSIZE_pos). destruct loc; simpl; f_equal; auto. lia.
 Qed.
 
-
+(*
 Lemma same_locks_juicyLocks_in_lockSet phi phi' lset :
   same_locks phi phi' ->
   juicyLocks_in_lockSet lset phi ->
@@ -122,40 +115,14 @@ Proof.
   simpl in *.
   destruct (AMap.find (elt:=option rmap) (b, ofs) lset). 2:inversion IN.
   specialize (LW eq_refl).
-  cut (~ ~ (b < Mem.nextblock m)%positive). zify. omega. intros L.
+  cut (~ ~ (b < Mem.nextblock m)%positive). zify. lia. intros L.
   specialize (LW ofs).
   assert (Intv.In ofs (ofs, (ofs + LKSIZE)%Z)).
-  { split; simpl; pose proof LKSIZE_pos; omega. }
+  { split; simpl; pose proof LKSIZE_pos; lia. }
   autospec LW.
   rewrite (Mem.nextblock_noaccess _ _ ofs Max L) in LW.
   inversion LW.
-Qed.
-
-Lemma join_all_age_updThread_level (tp : jstate ge) i (cnti : ThreadPool.containsThread tp i) c phi Phi :
-  join_all (age_tp_to (level phi) (ThreadPool.updThread cnti c phi)) Phi ->
-  level Phi = level phi.
-Proof.
-  intros J; symmetry.
-  remember (level phi) as n.
-  rewrite <- (level_age_to n phi). 2:omega.
-  apply rmap_join_sub_eq_level.
-  assert (cnti' : containsThread (updThread cnti c phi) i) by eauto with *.
-  rewrite (cnt_age_iff (n := n)) in cnti'.
-  pose proof compatible_threadRes_sub cnti' J as H.
-  unshelve erewrite <-getThreadR_age in H; eauto with *.
-  rewrite gssThreadRes in H.
-  apply H.
-Qed.
-
-Lemma join_all_level_lset (tp : jstate ge) Phi l phi :
-  join_all tp Phi ->
-  AMap.find l (lset tp) = Some (Some phi) ->
-  level phi = level Phi.
-Proof.
-  intros J F.
-  apply rmap_join_sub_eq_level.
-  eapply compatible_lockRes_sub_all; eauto; simpl; eauto.
-Qed.
+Qed.*)
 
 Lemma lset_range_perm m (tp : jstate ge) b ofs
   (compat : mem_compatible tp m)
@@ -176,36 +143,12 @@ Proof.
   + simpl in *.
     unfold OrdinalPool.lockRes in *.
     unfold OrdinalPool.lockGuts in *.
-    simpl in *.
+    change lock_info with (option rmap).
     destruct (AMap.find (elt:=option rmap) (b, ofs) (lset tp)).
     * reflexivity.
     * tauto.
 Qed.
 
-Lemma age_to_updThread i (tp : jstate ge) n c phi cnti cnti' :
-  age_tp_to n (@updThread _ _ _ i tp cnti c phi) =
-  @updThread _ _ _ i (age_tp_to n tp) cnti' c (age_to n phi).
-Proof.
-  destruct tp; simpl.
-  unfold OrdinalPool.updThread in *; simpl.
-  f_equal. extensionality j.
-  unfold "oo".
-  do 2 match goal with
-         |- context [if ?a then _ else _] =>
-         let E := fresh "E" in
-         destruct a eqn:E
-       end.
-  all:auto.
-  all:cut (true = false); [ congruence | ].
-  all:rewrite <-E, <-E0; repeat f_equal; apply proof_irr.
-Qed.
-
-Lemma lset_age_tp_to n (tp : jstate ge) :
-  lset (age_tp_to n tp) = AMap.map (option_map (age_to n)) (lset tp).
-Proof.
-  destruct tp; reflexivity.
-Qed.
-
 Lemma getThreadC_fun i (tp : jstate ge) cnti cnti' x y :
   @getThreadC _ _ _ i tp cnti = x ->
   @getThreadC _ _ _ i tp cnti' = y ->
@@ -228,60 +171,6 @@ Proof.
   apply proof_irr.
 Qed.
 
-Lemma lockSet_Writable_age n (tp : jstate ge) m :
-  lockSet_Writable (lset tp) m ->
-  lockSet_Writable (lset (age_tp_to n tp)) m.
-Proof.
-  rewrite lset_age_tp_to.
-  intros L b ofs E ofs0 range.
-  refine(L b ofs _ ofs0 range).
-  exact_eq E; f_equal.
-  apply isSome_find_map.
-Qed.
-
-Lemma lockSet_age_to n (tp : jstate ge) :
-  lockSet (age_tp_to n tp) = lockSet tp.
-Proof.
-  destruct tp as [num thds phis lset].
-  unfold lockSet in *.
-  simpl.
-  apply A2PMap_option_map.
-Qed.
-
-Lemma juicyLocks_in_lockSet_age n (tp : jstate ge) phi :
-  juicyLocks_in_lockSet (lset tp) phi ->
-  juicyLocks_in_lockSet (lset (age_tp_to n tp)) (age_to n phi).
-Proof.
-  rewrite lset_age_tp_to.
-  intros L loc E.
-  specialize (L loc).
-  spec L. { intros. specialize (E _ H). destruct E as [sh [psh E]]. exists sh, psh.
-   pattern (age_to n phi) in E. apply age_to_ind_opp  in E. auto.
-   intros. 
-  eapply age1_YES'; eauto.
-  }
-  rewrite isSome_find_map; auto.
-Qed.
-
-Lemma lockSet_in_juicyLocks_age n (tp : jstate ge) phi :
-  lockSet_in_juicyLocks (lset tp) phi ->
-  lockSet_in_juicyLocks (lset (age_tp_to n tp)) (age_to n phi).
-Proof.
-  rewrite lset_age_tp_to.
-  intros L loc E.
-  rewrite isSome_find_map in E.
-  specialize (L loc E).
-  destruct L as (sh & L). exists sh.
-  pattern (age_to n phi).
-  apply age_to_ind; auto. clear L.
-  intros ? ? ? ? ? ?. specialize (H0 _ H1).
-  destruct H0 as [sh2 [psh2 H0]]. exists sh2, psh2.
-  assert (join_sub sh sh2 /\ exists P, x @ (fst loc, (snd loc + i)%Z) = YES sh2 psh2 (LK LKSIZE i) P).
-  destruct H0 as [P [? ?]]; split; eauto.  clear H0; destruct H2.
-  assert (H3: exists P, y @ (fst loc, (snd loc + i)%Z) = YES sh2 psh2 (LK LKSIZE i) P); [| destruct H3 as [P ?]; exists P; auto].
-  rewrite <- age1_YES'; eauto.
-Qed.
-
 Definition same_except_cur (m m' : Mem.mem) :=
   Mem.mem_contents m = Mem.mem_contents m' /\
   max_access_at m = max_access_at m' /\
@@ -294,9 +183,9 @@ Lemma mem_cohere_same_except_cur m m' phi :
 Proof.
   intros (ECo & EMa & EN) [Co Ma N]; constructor.
   - hnf in *.
-    unfold contents_at in *.
+    unfold juicy_mem.contents_cohere, contents_at in *.
     rewrite <-ECo. auto.
-  - unfold max_access_cohere in *. intros loc.
+  - unfold max_access_cohere, juicy_mem.max_access_cohere in *. intros loc.
     apply equal_f with (x := loc) in EMa.
     rewrite <-EMa.
     apply Ma.
@@ -322,24 +211,24 @@ Proof.
     auto.
 Qed.
 
-Lemma resource_at_joins phi1 phi2 loc :
+(*Lemma resource_at_joins phi1 phi2 loc :
   joins phi1 phi2 -> joins (phi1 @ loc) (phi2 @ loc).
 Proof.
   intros (phi3, j).
   apply resource_at_join with (loc := loc) in j.
   hnf; eauto.
-Qed.
+Qed.*)
 
 Lemma juicyRestrict_Max b ofs phi m (coh : access_cohere' m phi):
-  (Mem.mem_access (juicyRestrict coh)) !! b ofs Max =
-  (Mem.mem_access m) !! b ofs Max.
+  PMap.get b (Mem.mem_access (juicyRestrict coh)) ofs Max =
+  PMap.get b (Mem.mem_access m) ofs Max.
 Proof.
   symmetry.
   apply (juicyRestrictMax coh (b, ofs)).
 Qed.
 
 Lemma juicyRestrict_Cur b ofs phi m (coh : access_cohere' m phi):
-  (Mem.mem_access (juicyRestrict coh)) !! b ofs Cur =
+  PMap.get b (Mem.mem_access (juicyRestrict coh)) ofs Cur =
   perm_of_res (phi @ (b, ofs)).
 Proof.
   apply (juicyRestrictCurEq coh (b, ofs)).
@@ -359,7 +248,7 @@ Proof.
     unfold Mem.perm in *.
     unfold access_at in *.
     simpl.
-    destruct ((Mem.mem_access m1) !! b ofs k) as [[]|], ((Mem.mem_access m2) !! b ofs k) as [[]|].
+    destruct (PMap.get b (Mem.mem_access m1) ofs k) as [[]|], (PMap.get b (Mem.mem_access m2) ofs k) as [[]|].
     all: simpl in *.
     all: auto || exfalso.
     all: try specialize (L _ (perm_refl _)).
@@ -373,22 +262,6 @@ Proof.
     auto.
 Qed.
 
-Lemma PTree_xmap_ext (A B : Type) (f f' : positive -> A -> B) t :
-  (forall a, f a = f' a) ->
-  PTree.xmap f t = PTree.xmap f' t.
-Proof.
-  intros E.
-  induction t as [ | t1 IH1 [a|] t2 IH2 ].
-  - reflexivity.
-  - simpl.
-    extensionality p.
-    rewrite IH1, IH2, E.
-    reflexivity.
-  - simpl.
-    rewrite IH1, IH2.
-    reflexivity.
-Qed.
-
 Lemma juicyRestrictCur_ext m phi phi'
       (coh : access_cohere' m phi)
       (coh' : access_cohere' m phi')
@@ -399,51 +272,24 @@ Proof.
   unfold juicyRestrict in *.
   unfold restrPermMap in *; simpl.
   f_equal.
-  unfold PTree.map in *.
-  eapply equal_f.
-  apply PTree_xmap_ext.
-  intros b.
+  apply PTree.extensionality; intros.
+  rewrite !PTree.gmap; f_equal.
   extensionality f ofs k.
   destruct k; auto.
-  unfold juice2Perm in *.
-  unfold mapmap in *.
-  simpl.
-  unfold PTree.map in *.
-  eapply equal_f.
-  f_equal.
-  f_equal.
-  eapply equal_f.
-  apply PTree_xmap_ext.
-  intros.
-  extensionality c ofs0.
-  apply same.
-Qed.
-
-Lemma PTree_xmap_self A f (m : PTree.t A) i :
-  (forall p a, m ! p = Some a -> f (PTree.prev_append i p) a = a) ->
-  PTree.xmap f m i = m.
-Proof.
-  revert i.
-  induction m; intros i E.
-  - reflexivity.
-  - simpl.
-    f_equal.
-    + apply IHm1.
-      intros p a; specialize (E (xO p) a).
-      apply E.
-    + specialize (E xH).
-      destruct o eqn:Eo; auto.
-    + apply IHm2.
-      intros p a; specialize (E (xI p) a).
-      apply E.
+  unfold juice2Perm.
+  repeat f_equal.
+  extensionality b a o; auto.
 Qed.
 
 Lemma PTree_map_self (A : Type) (f : positive -> A -> A) t :
-  (forall b a, t ! b = Some a -> f b a = a) ->
+  (forall b a, t !! b = Some a -> f b a = a) ->
   PTree.map f t = t.
 Proof.
   intros H.
-  apply PTree_xmap_self, H.
+  apply PTree.extensionality; intros.
+  rewrite PTree.gmap.
+  specialize (H i); destruct (t !! i); auto; simpl.
+  rewrite H; auto.
 Qed.
 
 Lemma juicyRestrictCur_unchanged m phi
@@ -456,32 +302,21 @@ Proof.
   unfold access_at in *.
   destruct (Mem.mem_access m) as (a, t) eqn:Eat.
   simpl.
-  f_equal.
+  apply f_equal2.
   - extensionality ofs k.
     destruct k. auto.
     pose proof Mem_canonical_useful m as H.
     rewrite Eat in H.
     auto.
-  - apply PTree_xmap_self.
-    intros b f E.
-    extensionality ofs k.
-    destruct k; auto.
-    specialize (pres (b, ofs)).
-    unfold PMap.get in pres.
-    simpl in pres.
-    rewrite E in pres.
-    rewrite <-pres.
-    simpl.
-    unfold juice2Perm in *.
-    unfold mapmap in *.
-    unfold PMap.get.
-    simpl.
-    rewrite Eat; simpl.
+  - apply PTree.extensionality; intros.
     rewrite PTree.gmap.
-    rewrite PTree.gmap1.
-    rewrite E.
-    simpl.
-    reflexivity.
+    destruct (t !! i) eqn: Hi; auto; simpl.
+    f_equal; extensionality ofs k.
+    destruct k; auto.
+    rewrite <- juic2Perm_correct; auto.
+    rewrite pres; simpl.
+    unfold PMap.get; simpl.
+    rewrite Hi; auto.
 Qed.
 
 Lemma ZIndexed_index_surj p : { z : Z | ZIndexed.index z = p }.
@@ -492,7 +327,7 @@ Proof.
   exists Z0; reflexivity.
 Qed.
 
-Lemma self_join_pshare_false (psh psh' : pshare) : ~sepalg.join psh psh psh'.
+(*Lemma self_join_pshare_false (psh psh' : pshare) : ~sepalg.join psh psh psh'.
 Proof.
   intros j; inv j.
   destruct psh as (sh, n); simpl in *.
@@ -500,207 +335,13 @@ Proof.
   eapply share_joins_self.
   - exists sh'; auto. constructor; eauto.
   - auto.
-Qed.
-
-Lemma approx_eq_app_pred {P1 P2 : mpred} x n :
-  level x < n ->
-  @approx n P1 = approx n P2 ->
-  app_pred P1 x ->
-  app_pred P2 x.
-Proof.
-  intros l E s1.
-  apply approx_p with n; rewrite <-E.
-  split; auto.
-Qed.
+Qed.*)
 
-Lemma exclusive_approx R n : exclusive_mpred R -> exclusive_mpred (approx n R).
-Proof.
-  unfold exclusive_mpred; intros.
-  eapply seplog.derives_trans, H.
-  apply seplog.sepcon_derives; apply approx_derives.
-Qed.
-
-Import shares.
-
-Lemma exclusive_joins_false R phi1 phi2 :
-  exclusive_mpred R ->
-  app_pred R phi1 ->
-  app_pred R phi2 ->
-  joins phi1 phi2 ->
-  False.
-Proof.
-  unfold exclusive_mpred; intros.
-  change (predicates_hered.derives (R * R) FF) in H.
-  destruct H2.
-  eapply H.
-  do 3 eexists; eauto.
-Qed.
-
-Lemma weak_exclusive_joins_false R phi phi1 phi2 :
-  level phi = level phi1 ->
-  app_pred (weak_exclusive_mpred R) phi ->
-  app_pred R phi1 ->
-  app_pred R phi2 ->
-  joins phi1 phi2 ->
-  False.
-Proof.
-  intros.
-  simpl in H0.
-  change (predicates_hered.derives (approx (S (level phi)) R * approx (S (level phi)) R) FF) in H0.
-  destruct H3.
-  eapply H0.
-  do 3 eexists; eauto.
-  apply join_level in H3.
-  repeat split; auto; omega.
-Qed.
-
-(*
-Lemma isLKCT_rewrite r :
-  (forall sh sh' z P,
-      r <> YES sh sh' (LK z) P /\
-      r <> YES sh sh' (CT z) P)
-  <-> ~isLK r /\ ~isCT r.
-Proof.
-  unfold isLK, isCT; split.
-  - intros H; split; intros (sh & sh' & z & P & E); do 4 autospec H; intuition.
-  - intros (A & B). intros sh sh' z P; split; intros ->; eauto 40.
-Qed.
-*)
-
-(*
-Lemma isLK_rewrite r :
-  (forall (sh : Share.t) Psh (z : Z) (P : preds), r <> YES sh Psh (LK z) P)
-  <->
-  ~ isLK r.
-Proof.
-  destruct r as [t0 | t0 p [] p0 | k p]; simpl; unfold isLK in *; split.
-  all: try intros H ?; intros; breakhyps.
-  intros E; injection E; intros; subst.
-  apply H; eauto.
-Qed.
-*)
-
-Lemma isLK_age_to n phi loc : isLK (age_to n phi @ loc) = isLK (phi @ loc).
-Proof.
-  unfold isLK in *.
-  rewrite age_to_resource_at.
-  destruct (phi @ loc); simpl; auto.
-  - apply prop_ext; split;
-      intros (shi & shi' & zi & Pi & Ei);
-      injection Ei; intros; subst; eauto.
-  - repeat (f_equal; extensionality).
-    apply prop_ext; split; congruence.
-Qed.
-
-(*
-Lemma isCT_age_to n phi loc : isCT (age_to n phi @ loc) = isCT (phi @ loc).
-Proof.
-  unfold isCT in *.
-  rewrite age_to_resource_at.
-  destruct (phi @ loc); simpl; auto.
-  - apply prop_ext; split;
-      intros (shi & shi' & zi & Pi & Ei);
-      injection Ei; intros; subst; eauto.
-  - repeat (f_equal; extensionality).
-    apply prop_ext; split; congruence.
-Qed.
-*)
-
-Lemma predat_inj {phi loc R1 R2} :
-  predat phi loc R1 ->
-  predat phi loc R2 ->
-  R1 = R2.
-Proof.
-  unfold predat in *.
-  intros.
-  breakhyps.
-  rewr (phi @ loc) in H.
-  pose proof (YES_inj _ _ _ _ _ _ _ _ H).
-  assert (snd ((x, LK x1 0, SomeP rmaps.Mpred (fun _ : list Type => R2: pred rmap))) =
-          snd  (x2, LK x4 0, SomeP rmaps.Mpred (fun _ : list Type => R1))) by (f_equal; auto).
-  simpl in H2.
-  apply SomeP_inj in H2.
-  pose proof equal_f_dep H2 nil.
-  auto.
-Qed.
-
-Lemma predat1 {phi loc} {R: mpred} {z sh psh} :
-  phi @ loc = YES sh psh (LK z 0) (SomeP rmaps.Mpred (fun _ => R)) ->
-  predat phi loc (approx (level phi) R).
-Proof.
-  intro E; hnf; eauto.
-  pose proof resource_at_approx phi loc as M.
-  rewrite E in M at 1; simpl in M.
-  rewrite <-M. unfold "oo"; simpl.
-  eauto.
-Qed.
-
-Lemma predat2 {phi loc R sh } :
-  LKspec_ext R sh loc phi ->
-  predat phi loc (approx (level phi) R).
-Proof.
-  intros lk; specialize (lk loc); simpl in lk.
-  if_tac in lk. 2:range_tac.
-  hnf. unfold "oo" in *; simpl in *; destruct lk. 
-  exists sh, x, LKSIZE. rewrite Z.sub_diag in H0. auto.
-Qed.
-
-Lemma predat3 {phi loc R sh} :
-  LK_at R sh loc phi ->
-  predat phi loc (approx (level phi) R).
-Proof.
-  apply predat2.
-Qed.
-
-Lemma predat4 {phi b ofs sh R} :
-  app_pred (lock_inv sh (Vptr b ofs) R) phi ->
-  predat phi (b, Ptrofs.unsigned ofs) (approx (level phi) R).
-Proof.
-  unfold lock_inv in *.
-  intros (b' & ofs' & E & lk & _).
-  injection E as <- <-.
-  specialize (lk (b, Ptrofs.unsigned ofs)); simpl in lk.
-  if_tac in lk. 2:range_tac.
-  hnf. unfold "oo" in *; simpl in *; destruct lk; eauto.
-  exists sh, x, LKSIZE. rewrite Z.sub_diag in H0. auto.
-Qed.
-
-Lemma predat5 {phi loc R} :
-  islock_pred R (phi @ loc) ->
-  predat phi loc R.
-Proof.
-  intros H; apply H.
-Qed.
-
-Lemma predat6 {R loc phi} : lkat R loc phi -> predat phi loc (approx (level phi) R).
-Proof.
-  unfold predat in *.
-  unfold lkat in *.
-  intros H. specialize (H loc).
-  spec H.
-  { destruct loc. split; auto; pose proof LKSIZE_pos; omega. }
-  destruct H as (sh & rsh & ->).
-  do 3 eexists. rewrite Z.sub_diag; 
-  eauto.
-Qed.
-
-Lemma predat_join_sub {phi1 phi2 loc R} :
-  join_sub phi1 phi2 ->
-  predat phi1 loc R ->
-  predat phi2 loc R.
-Proof.
-  intros (phi3, j) (sh & sh' & z & E). pose proof j as J.
-  apply resource_at_join with (loc := loc) in j.
-  hnf.
-  apply join_level in J.
-  rewrite E in j; inv j; eauto.
-Qed.
-
-Lemma lock_inv_at sh v R phi :
+(*Lemma lock_inv_at sh v R phi :
   app_pred (lock_inv sh v R) phi ->
   exists b ofs, v = Vptr b ofs /\ exists R, islock_pred R (phi @ (b, Ptrofs.unsigned ofs)).
 Proof.
-  intros (b & ofs & Ev & lk & _).
+  intros (b & ofs & Ev & lk).
   exists b, ofs. split. now apply Ev.
   specialize (lk (b, Ptrofs.unsigned ofs)).
   exists (approx (level phi) R).
@@ -711,28 +352,13 @@ Proof.
     unfold adr_range in *.
     intuition.
     pose proof LKSIZE_pos.
-    omega.
+    lia.
   }
   destruct lk as [p lk].
   rewrite lk.
   do 3 eexists.
   rewrite Z.sub_diag.
   reflexivity.
-Qed.
-
-Lemma lkat_hered R loc : hereditary age (lkat R loc).
-Proof.
-  intros phi phi' A lk a r. specialize (lk a r).
-  destruct lk as (sh & rsh & E); exists sh, rsh.
-  erewrite age_resource_at; eauto.
-  rewrite E.
-  simpl; f_equal.
-  unfold sync_preds_defs.pack_res_inv in *.
-  f_equal. extensionality Ts.
-  pose proof approx_oo_approx' (level phi') (level phi) as RR.
-  spec RR. apply age_level in A. omega.
-  unfold "oo" in *.
-  apply (equal_f RR R).
-Qed.
+Qed.*)
 
 End Machine.
diff --git a/concurrency/juicy/sync_preds_defs.v b/concurrency/juicy/sync_preds_defs.v
index 28465b0d1a..f3dbeed052 100644
--- a/concurrency/juicy/sync_preds_defs.v
+++ b/concurrency/juicy/sync_preds_defs.v
@@ -2,18 +2,16 @@ Require Import VST.concurrency.common.lksize.
 Require Import VST.concurrency.common.addressFiniteMap.
 Require Import VST.msl.Coqlib2.
 Require Import VST.msl.eq_dec.
-Require Import VST.msl.seplog.
-Require Import VST.veric.compcert_rmaps.
 Require Import VST.veric.tycontext.
 Require Import VST.veric.res_predicates.
-
-Set Bullet Behavior "Strict Subproofs".
+Require Import VST.veric.shared.
+Require Import VST.veric.juicy_mem.
 
 (* Those were overwritten in structured_injections *)
 Notation join := sepalg.join.
 Notation join_assoc := sepalg.join_assoc.
 
-Definition islock_pred (R: pred rmap) r := 
+(*Definition islock_pred (R: mpred) r := 
  exists sh sh' z, r = YES sh sh' (LK z 0) (SomeP rmaps.Mpred (fun _ => R)).
 
 Lemma islock_pred_join_sub {r1 r2 R} : join_sub r1 r2 -> islock_pred R r1  -> islock_pred R r2.
@@ -22,7 +20,7 @@ Proof.
   inversion J; subst; eexists; eauto.
 Qed.
 
-Definition LKspec_ext (R: pred rmap) : spec :=
+Definition LKspec_ext (R: mpred) : spec :=
    fun (sh: Share.t) (l: AV.address)  =>
      allp
        (jam
@@ -38,7 +36,7 @@ the LK, CT, ... have the same share, which might not be true. The
 following definition has the same structure as rmap_makelock in
 rmap_locking *)
 
-Definition pack_res_inv (R: pred rmap) := SomeP rmaps.Mpred (fun _ => R).
+Definition pack_res_inv (R: mpred) := SomeP rmaps.Mpred (fun _ => R).
 
 Definition lkat (R : mpred) loc phi :=
   (forall x,
@@ -59,10 +57,10 @@ Definition same_locks phi1 phi2 :=
 Definition lockSet_block_bound lset b :=
   forall loc, isSome (AMap.find (elt:=option rmap) loc lset) -> (fst loc < b)%positive.
 
-Definition predat phi loc (R: pred rmap) :=
-  exists sh sh' z, phi @ loc = YES sh sh' (LK z 0) (SomeP rmaps.Mpred (fun _ => R)).
+Definition predat phi loc (R: mpred) :=
+  exists sh sh' z, phi @ loc = YES sh sh' (LK z 0) (SomeP rmaps.Mpred (fun _ => R)).*)
 
-Definition rmap_bound b phi :=
+(*Definition rmap_bound b phi :=
   (forall loc, (fst loc >= b)%positive -> phi @ loc = NO Share.bot shares.bot_unreadable).
 
 (* Constructive version of resource_decay (equivalent to the
@@ -81,7 +79,7 @@ Definition resource_decay_aux (nextb: block) (phi1 phi2: rmap) : Type :=
 
   + (fst l >= nextb)%positive * { v | phi2 @ l = YES Share.top shares.readable_share_top  (VAL v) NoneP }
 
-  + { v : _ & { pp : _ | phi1 @ l = YES Share.top shares.readable_share_top (VAL v) pp /\ phi2 @ l = NO Share.bot shares.bot_unreadable} })).
+  + { v : _ & { pp : _ | phi1 @ l = YES Share.top shares.readable_share_top (VAL v) pp /\ phi2 @ l = NO Share.bot shares.bot_unreadable} })).*)
 
 Ltac breakhyps :=
   repeat
@@ -114,7 +112,7 @@ Ltac sumsimpl :=
   | |- sumbool ?A ?B => check_false B; left
   end.
 
-Definition resource_decay_at (nextb: block) n (r1 r2 : resource) b :=
+(*Definition resource_decay_at (nextb: block) n (r1 r2 : resource) b :=
   ((b >= nextb)%positive -> r1 = NO Share.bot shares.bot_unreadable) /\
   (resource_fmap (approx (n)) (approx (n)) (r1) = (r2) \/
   (exists sh, exists Psh, exists v, exists v',
@@ -122,7 +120,7 @@ Definition resource_decay_at (nextb: block) n (r1 r2 : resource) b :=
        r2 = YES sh Psh (VAL v') NoneP /\
        shares.writable0_share sh)
   \/ ((b >= nextb)%positive /\ exists v, r2 = YES Share.top shares.readable_share_top  (VAL v) NoneP)
-  \/ (exists v, exists pp, r1 = YES Share.top shares.readable_share_top (VAL v) pp /\ r2 = NO Share.bot shares.bot_unreadable)).
+  \/ (exists v, exists pp, r1 = YES Share.top shares.readable_share_top (VAL v) pp /\ r2 = NO Share.bot shares.bot_unreadable)).*)
 
 Ltac range_tac :=
   match goal with
@@ -131,12 +129,12 @@ Ltac range_tac :=
     repeat split; auto;
     try unfold Ptrofs.unsigned;
     pose proof LKSIZE_pos;
-    omega
+    lia
   | H : ~ adr_range ?l _ ?l |- _ =>
     destruct l;
     exfalso; apply H;
     repeat split; auto;
     try unfold Ptrofs.unsigned;
     pose proof LKSIZE_pos;
-    omega
+    lia
   end.
\ No newline at end of file
diff --git a/concurrency/lib/Coqlib3.v b/concurrency/lib/Coqlib3.v
index b44186c0b2..625e2d105a 100644
--- a/concurrency/lib/Coqlib3.v
+++ b/concurrency/lib/Coqlib3.v
@@ -1,4 +1,3 @@
-Require Import Omega.
 Require Import compcert.lib.Coqlib.
 Require Import compcert.lib.Maps.
 Require Import VST.concurrency.lib.tactics.
@@ -13,21 +12,16 @@ Lemma trivial_map1:
   forall {A} (t : PTree.t A),
     PTree.map1 (fun (a : A) => a) t = t.
 Proof.
-  intros ? t; induction t; auto.
-  simpl; f_equal; eauto.
-  destruct o; reflexivity.
+  intros; apply PTree.extensionality; intros.
+  rewrite PTree.gmap1.
+  destruct (t ! i); auto.
 Qed.
 Lemma map_map1:
   forall {A B} f m,
     @PTree.map1 A B f m = PTree.map (fun _=> f) m.
 Proof.
-  intros. unfold PTree.map.
-  remember 1%positive as p eqn:Heq.
-  clear Heq; revert p.
-  induction m; try reflexivity.
-  intros; simpl; rewrite <- IHm1.
-  destruct o; simpl; (*2 goals*)
-    rewrite <- IHm2; auto.
+  intros; apply PTree.extensionality; intros.
+  rewrite PTree.gmap1, PTree.gmap; reflexivity.
 Qed.
 Lemma trivial_map:
   forall {A} (t : PTree.t A),
@@ -42,7 +36,7 @@ Definition merge_func {A} (f1 f2:Z -> option A):
   fun ofs => if f1 ofs then f1 ofs else f2 ofs.
 
 
-Lemma xmap_compose:
+(*Lemma xmap_compose:
   forall A B C t f1 f2 p,
     @PTree.xmap B C f2 (@PTree.xmap A B f1 t p) p =
     (@PTree.xmap A C (fun p x => f2 p (f1 p x)) t p).
@@ -67,50 +61,38 @@ Proof.
       rewrite IHt1; f_equal.
     + rewrite IHt2; symmetry.
       rewrite IHt2; f_equal.
-Qed.
+Qed.*)
 
 Lemma trivial_ptree_map:
   forall {A} t F,
     (forall b f, t ! b = Some f -> F b f = f) ->
     @PTree.map A A F t = t.
 Proof.
-  intros ? ?.
-  unfold PTree.map.
-  (* remember 1%positive as p eqn:HH; clear HH; revert p.*)
-  induction t; try reflexivity.
-  unfold PTree.map; simpl.
-  intros. f_equal.
-  - intros.
-    erewrite xmap_step.
-    erewrite <- IHt1 at 2.
-    reflexivity.
-    intros; simpl. rewrite H; auto.
-  - destruct o; eauto.
-  - f_equal. eapply H; eauto.
-  - intros. erewrite xmap_step.
-    erewrite <- IHt2 at 2.
-    reflexivity.
-    intros; simpl. rewrite H; auto.
+  intros; apply PTree.extensionality; intros.
+  rewrite PTree.gmap.
+  destruct (t ! i) eqn: Hi; [simpl | reflexivity].
+  rewrite H; auto.
 Qed.
 
+Lemma max_maximum : forall l, Forall (Pos.ge (fold_right Pos.max 1 l))%positive l.
+Proof.
+  induction l; auto.
+  constructor; simpl.
+  - lia.
+  - eapply Forall_impl, IHl; lia.
+Qed.
 
 Lemma finite_ptree:
   forall {A} (t:PTree.t A), exists b, forall b', (b < b')%positive -> (t ! b') = None.
 Proof.
-  intros ? t; induction t.
-  - exists xH; intros; simpl. eapply PTree.gleaf.
-  - normal_hyp.
-    exists (Pos.max (x0~0) (x~1)); intros.
-    destruct b'; simpl;
-      first [eapply H0| eapply H| idtac].
-    + cut (x~1 <  b'~1)%positive.
-      * unfold Pos.lt, Pos.compare in *; auto.
-      * eapply Pos.max_lub_lt_iff in H1 as [? ?].
-        auto.
-    + cut (x0~0 <  b'~0)%positive.
-      * unfold Pos.lt, Pos.compare in *; auto.
-      * eapply Pos.max_lub_lt_iff in H1 as [? ?]; auto.
-    + exfalso. eapply Pos.nlt_1_r; eassumption.
+  intros.
+  exists (fold_right Pos.max 1 (map fst (PTree.elements t)))%positive; intros.
+  destruct (t ! b') eqn: Hb'; [|auto].
+  apply PTree.elements_correct in Hb'.
+  pose proof (max_maximum (map fst (PTree.elements t))) as Hmax.
+  rewrite Forall_forall in Hmax; specialize (Hmax b').
+  lapply Hmax; [lia|].
+  rewrite in_map_iff; do 2 eexists; eauto; auto.
 Qed.
 
 Infix "++":= seq.cat.
\ No newline at end of file
diff --git a/concurrency/lock_specs.v b/concurrency/lock_specs.v
index 07e5b85af0..edc2a73ba7 100644
--- a/concurrency/lock_specs.v
+++ b/concurrency/lock_specs.v
@@ -1,63 +1,42 @@
-Require Import VST.veric.rmaps.
 Require Import VST.concurrency.conclib.
 Require Import VST.floyd.library.
-Import FashNotation.
-
-(* lock invariants should be exclusive *)
-Class lock_impl := { t_lock : type; lock_handle : Type; ptr_of : lock_handle -> val;
-  lock_inv : share -> lock_handle -> mpred -> mpred;
-  lock_inv_nonexpansive : forall sh h, nonexpansive (lock_inv sh h);
-  lock_inv_share_join : forall sh1 sh2 sh3 h R, sh1 <> Share.bot -> sh2 <> Share.bot ->
-    sepalg.join sh1 sh2 sh3 -> lock_inv sh1 h R * lock_inv sh2 h R = lock_inv sh3 h R;
-  lock_inv_exclusive : forall sh h R, exclusive_mpred (lock_inv sh h R);
-  lock_inv_isptr : forall sh h R, lock_inv sh h R |-- !! isptr (ptr_of h) }.
 
 Section lock_specs.
 
-  Context {LI : lock_impl}.
+Context `{!VSTGS OK_ty Σ}.
 
-  Lemma lock_inv_nonexpansive2 : forall {A} (P Q : A -> mpred) sh p x, (ALL x : _, |> (P x <=> Q x) |--
-    |> lock_inv sh p (P x) <=> |> lock_inv sh p (Q x))%logic.
-  Proof.
-    intros.
-    apply allp_left with x.
-    eapply derives_trans, eqp_later1; apply later_derives.
-    apply nonexpansive_entail; apply lock_inv_nonexpansive.
-  Qed.
+(* lock invariants should be exclusive *)
+Class lock_impl := { t_lock : type; lock_handle : Type; ptr_of : lock_handle -> val;
+  lock_inv : Qp -> lock_handle -> mpred -> mpred;
+  lock_inv_nonexpansive :: forall sh h, NonExpansive (lock_inv sh h);
+  lock_inv_share_join : forall sh1 sh2 h R,
+    lock_inv sh1 h R ∗ lock_inv sh2 h R ⊣⊢ lock_inv (sh1 ⋅ sh2) h R;
+(*  lock_inv_exclusive : forall sh h R, exclusive_mpred (lock_inv sh h R); *)
+  lock_inv_isptr : forall sh h R, lock_inv sh h R ⊢ ⌜isptr (ptr_of h)⌝ }.
 
-  Lemma lock_inv_super_non_expansive : forall sh h R n,
-    compcert_rmaps.RML.R.approx n (lock_inv sh h R) = compcert_rmaps.RML.R.approx n (lock_inv sh h (compcert_rmaps.RML.R.approx n R)).
-  Proof.
-    intros; apply nonexpansive_super_non_expansive, lock_inv_nonexpansive.
-  Qed.
+  Context {LI : lock_impl}.
 
   Notation InvType := Mpred.
 
   (* R should be able to take the lock_handle as an argument, with subspecs for plain and selflock *)
   Program Definition makelock_spec :=
-    TYPE (ProdType (ConstType globals) (ArrowType (ConstType lock_handle) InvType)) WITH gv: _, R : _
+    TYPE (ProdType (ConstType globals) (DiscreteFunType lock_handle InvType)) WITH gv: _, R : _
     PRE [ ]
        PROP ()
        PARAMS () GLOBALS (gv)
        SEP (mem_mgr gv)
-    POST [ tptr t_lock ] EX h,
+    POST [ tptr t_lock ] ∃ h,
        PROP ()
        RETURN (ptr_of h)
-       SEP (mem_mgr gv; lock_inv Tsh h (R h)).
+       SEP (mem_mgr gv; lock_inv 1 h (R h)).
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x; simpl.
-    reflexivity.
+    intros ? (?, ?) (?, ?) ([=] & HR) ?; simpl in *; subst; done.
   Qed.
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x; simpl.
-    rewrite !approx_exp; f_equal; extensionality.
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; do 2 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    f_equal; apply lock_inv_super_non_expansive.
+    intros ? (?, ?) (?, ?) ([=] & HR) ?; simpl in *; subst.
+    by repeat f_equiv.
   Qed.
 
   Program Definition freelock_spec :=
@@ -66,31 +45,20 @@ Section lock_specs.
     PRE [ tptr t_lock ]
      PROP ()
      PARAMS (ptr_of h)
-     SEP (lock_inv Tsh h R; P; (P * lock_inv Tsh h R * R -* FF) && emp)
+     SEP (lock_inv 1 h R; P; <affine> (P ∗ lock_inv 1 h R ∗ R -∗ False))
    POST[ tvoid ]
      PROP ()
      LOCAL ()
      SEP (P).
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x as ((?, ?), ?); simpl.
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; do 3 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    f_equal.
-    { apply lock_inv_super_non_expansive. }
-    f_equal.
-    rewrite !approx_andp; f_equal.
-    setoid_rewrite wand_nonexpansive; rewrite !approx_sepcon; do 2 f_equal; rewrite !approx_idem; auto.
-    do 2 f_equal; apply lock_inv_super_non_expansive.
+    intros ? ((?, ?), ?) ((?, ?), ?) (([=] & HR) & HP) ?; simpl in *; subst.
+    by repeat f_equiv.
   Qed.
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x as ((?, ?), ?); simpl.
-    unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    reflexivity.
+    intros ? ((?, ?), ?) ((?, ?), ?) (([=] & HR) & HP) ?; simpl in *; subst.
+    by repeat f_equiv.
   Qed.
 
   Program Definition freelock_spec_simple :=
@@ -99,48 +67,43 @@ Section lock_specs.
     PRE [ tptr t_lock ]
      PROP ()
      PARAMS (ptr_of h)
-     SEP (weak_exclusive_mpred R && emp; lock_inv Tsh h R; R)
+     SEP (<affine> (R ∗ R -∗ False); lock_inv 1 h R; R)
    POST[ tvoid ]
      PROP ()
      LOCAL ()
      SEP (R).
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x; simpl.
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; do 3 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    f_equal.
-    { rewrite !approx_andp; f_equal.
-      apply exclusive_mpred_super_non_expansive. }
-    f_equal. apply lock_inv_super_non_expansive.
+    intros ? (?, ?) (?, ?) ([=] & HR) ?; simpl in *; subst.
+    by repeat f_equiv.
   Qed.
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x; simpl.
-    unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    reflexivity.
+    intros ? (?, ?) (?, ?) ([=] & HR) ?; simpl in *; subst.
+    by repeat f_equiv.
   Qed.
 
   Lemma freelock_simple : funspec_sub freelock_spec freelock_spec_simple.
   Proof.
     unfold funspec_sub; simpl.
-    split; auto; intros ? (h, R) ?; Intros.
-    eapply derives_trans, fupd_intro.
-    Exists (nil : list Type) (h, R, R) emp; entailer!.
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; entailer!.
-    apply andp_right, andp_left2; auto.
-    rewrite <- wand_sepcon_adjoint; sep_apply weak_exclusive_conflict; auto.
-    rewrite FF_sepcon; auto.
+    split; first done; intros (h, R) ?; Intros.
+    iIntros "(? & ? & H) !>"; iExists (h, R, R), emp.
+    iSplit; first done.
+    iSplit; last by iPureIntro; entailer!.
+    repeat (iSplit; first done).
+    rewrite /SEPx /= /LOCALx /argsassert2assert /=; monPred.unseal.
+    repeat (iSplit; first done).
+    iDestruct "H" as "(? & HR & $ & $ & _)".
+    repeat (iSplit; last done).
+    iApply (bi.affinely_mono with "HR").
+    iIntros "HR (? & ? & ?)"; iApply ("HR" with "[$]").
   Qed.
 
   Program Definition acquire_spec :=
     TYPE (ProdType (ConstType _) InvType)
     WITH sh : _, h : _, R : _
     PRE [ tptr t_lock ]
-       PROP (sh <> Share.bot)
+       PROP ()
        PARAMS (ptr_of h)
        SEP (lock_inv sh h R)
     POST [ tvoid ]
@@ -149,102 +112,91 @@ Section lock_specs.
        SEP (lock_inv sh h R; R).
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x as ((?, ?), ?); simpl.
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; do 3 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    apply lock_inv_super_non_expansive.
+    intros ? ((?, ?), ?) ((?, ?), ?) ([=] & HR) ?; simpl in *; subst.
+    by repeat f_equiv.
   Qed.
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x as ((?, ?), ?); simpl.
-    unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    f_equal. apply lock_inv_super_non_expansive.
+    intros ? ((?, ?), ?) ((?, ?), ?) ([=] & HR) ?; simpl in *; subst.
+    by repeat f_equiv.
   Qed.
 
   Program Definition release_spec :=
     TYPE (ProdType (ProdType (ProdType (ConstType _) InvType) Mpred) Mpred)
     WITH sh : _, h : _, R : _, P : _, Q : _
     PRE [ tptr t_lock ]
-       PROP (sh <> Share.bot)
+       PROP ()
        PARAMS (ptr_of h)
-       SEP (weak_exclusive_mpred R && emp; |> lock_inv sh h R; P; lock_inv sh h R * P -* Q * R)
+       SEP (<affine> (R ∗ R -∗ False); ▷ lock_inv sh h R; P; lock_inv sh h R ∗ P -∗ Q ∗ R)
     POST [ tvoid ]
        PROP ()
        LOCAL ()
        SEP (Q).
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x as ((((?, ?), ?), ?), ?); simpl.
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; do 3 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    f_equal.
-    { rewrite !approx_andp; f_equal.
-      apply exclusive_mpred_super_non_expansive. }
-    f_equal.
-    { setoid_rewrite later_nonexpansive; do 2 f_equal.
-      apply lock_inv_super_non_expansive. }
-    f_equal.
-    setoid_rewrite wand_nonexpansive; rewrite !approx_sepcon; do 2 f_equal; rewrite !approx_idem; f_equal.
-    apply lock_inv_super_non_expansive.
+    intros ? ((((?, ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & HR) & HP) & HQ) ?; simpl in *; subst.
+    by repeat f_equiv.
   Qed.
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x as ((((?, ?), ?), ?), ?); simpl.
-    unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    reflexivity.
+    intros ? ((((?, ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & HR) & HP) & HQ) ?; simpl in *; subst.
+    by repeat f_equiv.
   Qed.
 
   Program Definition release_spec_simple :=
     TYPE (ProdType (ConstType _) InvType)
     WITH sh : _, h : _, R : _
     PRE [ tptr t_lock ]
-       PROP (sh <> Share.bot)
+       PROP ()
        PARAMS (ptr_of h)
-       SEP (weak_exclusive_mpred R && emp; lock_inv sh h R; R)
+       SEP (<affine> (R ∗ R -∗ False); lock_inv sh h R; R)
     POST [ tvoid ]
        PROP ()
        LOCAL ()
        SEP (lock_inv sh h R).
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x as ((?, ?), ?); simpl.
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; do 3 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    f_equal.
-    { rewrite !approx_andp; f_equal.
-      apply exclusive_mpred_super_non_expansive. }
-    f_equal.
-    apply lock_inv_super_non_expansive.
+    intros ? ((?, ?), ?) ((?, ?), ?) ([=] & HR) ?; simpl in *; subst.
+    by repeat f_equiv.
   Qed.
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x as ((?, ?), ?); simpl.
-    unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    apply lock_inv_super_non_expansive.
+    intros ? ((?, ?), ?) ((?, ?), ?) ([=] & HR) ?; simpl in *; subst.
+    by repeat f_equiv.
   Qed.
 
   Lemma release_simple : funspec_sub release_spec release_spec_simple.
   Proof.
     unfold funspec_sub; simpl.
-    split; auto; intros ? ((sh, h), R) ?; Intros.
-    eapply derives_trans, fupd_intro.
-    Exists (nil : list Type) (sh, h, R, R, lock_inv sh h R) emp; entailer!.
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; entailer!.
-    apply wand_refl_cancel_right.
-  Qed.
+    split; first done; intros ((sh, h), R) ?; Intros.
+    iIntros "(? & ? & H) !>"; iExists (sh, h, R, R, lock_inv sh h R), emp.
+    iSplit; first done.
+    iSplit; last by iPureIntro; entailer!.
+    repeat (iSplit; first done).
+    rewrite /SEPx /= /LOCALx /argsassert2assert /=; monPred.unseal.
+    repeat (iSplit; first done).
+    iDestruct "H" as "(? & HR & $ & $ & _)".
+    iFrame; auto.
+  Qed.
+
+  Definition concurrent_specs (cs : compspecs) (ext_link : string -> ident) :=
+    (ext_link "spawn"%string, spawn_spec) ::
+    (ext_link "makelock"%string, makelock_spec) ::
+    (ext_link "freelock"%string, freelock_spec) ::
+    (ext_link "acquire"%string, acquire_spec) ::
+    (ext_link "release"%string, release_spec) ::
+    nil.
+
+  #[export] Instance concurrent_ext_spec (cs : compspecs) (ext_link : string -> ident) : ext_spec OK_ty :=
+    add_funspecs_rec OK_ty
+      ext_link
+      (void_spec OK_ty)
+      (concurrent_specs cs ext_link).
 
 End lock_specs.
 
 #[export] Hint Resolve lock_inv_isptr : saturate_local.
-#[export] Hint Resolve lock_inv_exclusive data_at_exclusive data_at__exclusive field_at_exclusive field_at__exclusive : core.
+#[export] Hint Resolve data_at_exclusive data_at__exclusive field_at_exclusive field_at__exclusive : core.
 
-Ltac lock_props := match goal with |-context[weak_exclusive_mpred ?P && emp] => sep_apply (exclusive_weak_exclusive P); [auto with share | try timeout 20 cancel] end.
+Ltac lock_props := match goal with |-context[<affine> (?P ∗ ?P -∗ False)] => rewrite -(exclusive_weak_exclusive P);
+  [rewrite bi.affinely_emp ?bi.emp_sep ?bi.sep_emp | auto with share] end.
diff --git a/concurrency/main.v b/concurrency/main.v
index 2ae5bf1d9a..e9c0d7d2f5 100644
--- a/concurrency/main.v
+++ b/concurrency/main.v
@@ -77,7 +77,7 @@ Module MainTheorem
         CSL_init_setup C_program src_m src_cpm ->
         
         (*Correct entry point Clight (There is inconsistencies with CSL_init_Setup)*)
-        (* TODO: fix initial state inconsistenciees and unify. *)
+        (* TODO: fix initial state inconsistencies and unify. *)
         Clight.entry_point (Clight.globalenv C_program) src_m src_cpm (main_ptr C_program) nil ->
         
         (* ASM memory good. *)
diff --git a/concurrency/memsem_lemmas.v b/concurrency/memsem_lemmas.v
index 0b4fa3ffa2..66e1da3761 100644
--- a/concurrency/memsem_lemmas.v
+++ b/concurrency/memsem_lemmas.v
@@ -10,8 +10,9 @@ Require Import compcert.common.AST.
 Require Import compcert.common.Globalenvs.
 Require Import VST.msl.Extensionality.
 
+Require Export VST.sepcomp.semantics.
 Require Import VST.sepcomp.mem_lemmas.
-Require Import VST.concurrency.common.core_semantics.
+(*Require Import VST.concurrency.common.core_semantics.*)
 
 Require Import VST.msl.Coqlib2.
 
@@ -133,9 +134,9 @@ split; intros.
   destruct (eq_block b0 b); subst.
   - destruct (zle ofs ofs0).
       destruct (zlt ofs0 (ofs + Z.of_nat (length l))).
-        elim H. eapply Mem.perm_max. apply L. omega.
-      rewrite PMap.gss. apply Mem.setN_other. intros. omega.
-    rewrite PMap.gss. apply Mem.setN_other. intros. omega.
+        elim H. eapply Mem.perm_max. apply L. lia.
+      rewrite PMap.gss. apply Mem.setN_other. intros. lia.
+    rewrite PMap.gss. apply Mem.setN_other. intros. lia.
   - rewrite PMap.gso; trivial.
 Qed.
 
@@ -204,8 +205,8 @@ Proof. induction l; simpl; intros.
         split; intros. apply (Mem.perm_free_1 _ _ _ _ _ Heqw) in H0; eauto.
                        eapply Mem.perm_free_3; eassumption.
         split; intros.
-          eelim (Mem.perm_free_2 _ _ _ _ _ Heqw ofs Max Nonempty); clear Heqw; trivial. omega.
-        eelim (Mem.perm_free_2 _ _ _ _ _ Heqw ofs Max Nonempty); clear Heqw. omega.
+          eelim (Mem.perm_free_2 _ _ _ _ _ Heqw ofs Max Nonempty); clear Heqw; trivial. lia.
+        eelim (Mem.perm_free_2 _ _ _ _ _ Heqw ofs Max Nonempty); clear Heqw. lia.
           eapply Mem.perm_implies. eapply Mem.perm_max. eassumption. constructor.
     - split; intros.
       * eapply (Mem.perm_free_1 _ _ _ _ _ Heqw); trivial. intuition.
@@ -354,15 +355,15 @@ Qed.
 
 Lemma mem_step_nextblock:  memstep_preserve (fun m m' => Mem.nextblock m <= Mem.nextblock m')%positive.
 constructor.
-+ intros. xomega.
++ intros. lia.
 + induction 1.
  - apply Mem.nextblock_storebytes in H;
-   rewrite H; xomega.
+   rewrite H; lia.
  - apply Mem.nextblock_alloc in H.
-   rewrite H. clear. xomega.
+   rewrite H. clear. lia.
  - apply nextblock_freelist in H.
-   rewrite H; xomega.
- - xomega.
+   rewrite H; lia.
+ - lia.
 Qed.
 
 Lemma mem_step_nextblock':
@@ -412,7 +413,7 @@ induction E.
   destruct (peq b0 b); subst; simpl. 2: intuition.
   destruct (zle lo ofs); simpl. 2: intuition.
   destruct (zlt ofs hi); simpl. 2: intuition.
-  elim H. eapply Mem.perm_max. eapply Mem.perm_implies. apply r. omega. constructor.
+  elim H. eapply Mem.perm_max. eapply Mem.perm_implies. apply r. lia. constructor.
 + trivial.
 + eapply unch_on_loc_not_writable_trans; try eassumption. eapply estep_forward; eassumption.
 Qed.
@@ -432,12 +433,12 @@ Transparent Mem.loadbytes.
   red; intros. specialize (Mem.perm_drop_1 _ _ _ _ _ _ D ofs0 Cur); intros.
     destruct (eq_block b' b); subst.
       destruct H. eapply Mem.perm_drop_3. eassumption. left; trivial. apply r. trivial.
-      destruct (zlt ofs lo). eapply Mem.perm_drop_3. eassumption. right. omega. apply r. trivial.
-      destruct H. omega.
-      destruct (zle hi ofs). eapply Mem.perm_drop_3. eassumption. right. omega. apply r. trivial.
-      destruct H. omega.
-      eapply Mem.perm_implies. apply H1. omega. trivial.
-   eapply Mem.perm_drop_3. eassumption. left; trivial. apply r. omega.
+      destruct (zlt ofs lo). eapply Mem.perm_drop_3. eassumption. right. lia. apply r. trivial.
+      destruct H. lia.
+      destruct (zle hi ofs). eapply Mem.perm_drop_3. eassumption. right. lia. apply r. trivial.
+      destruct H. lia.
+      eapply Mem.perm_implies. apply H1. lia. trivial.
+   eapply Mem.perm_drop_3. eassumption. left; trivial. apply r. lia.
 
   destruct (Mem.range_perm_dec m' b' ofs (ofs + 1) Cur Readable); trivial.
   elim n; clear n. red; intros. eapply Mem.perm_drop_4. eassumption. apply r. trivial.
@@ -477,7 +478,7 @@ Opaque Mem.storebytes.
  destruct (peq b b0). subst b0.
  rewrite PMap.gss.
  destruct (zeq ofs0 ofs). subst.
- contradiction H0. apply r. simpl. omega.
+ contradiction H0. apply r. simpl. lia.
  rewrite ZMap.gso; auto.
  rewrite PMap.gso; auto.
  clear - H H1.
@@ -499,7 +500,7 @@ Opaque Mem.storebytes.
  intros [? ?]. subst b0. apply H0.
  apply Mem.free_range_perm in Heqo.
    specialize (Heqo ofs).
-   eapply Mem.perm_implies. apply Heqo. omega. constructor.
+   eapply Mem.perm_implies. apply Heqo. lia. constructor.
  clear - H Heqo.
  unfold Mem.valid_block in *.
  apply Mem.nextblock_free in Heqo. rewrite Heqo.
@@ -554,10 +555,10 @@ revert j H; induction n; intros; simpl; f_equal.
 apply perm_le_cont.
 apply (H j).
 rewrite inj_S.
-omega.
+lia.
 apply IHn.
 rewrite inj_S in H.
-intros ofs ?; apply H. omega.
+intros ofs ?; apply H. lia.
 clear - H perm_le_Cur.
 destruct H; split; auto.
 intros ? ?. specialize (H ofs H1).
@@ -592,19 +593,19 @@ forget (Ptrofs.unsigned i) as z.
 destruct (eq_block b0 b). subst.
 rewrite !PMap.gss.
 forget (encode_val ch v2) as vl.
-assert (z <= ofs < z + Z.of_nat (length vl) \/ ~ (z <= ofs < z + Z.of_nat (length vl))) by omega.
+assert (z <= ofs < z + Z.of_nat (length vl) \/ ~ (z <= ofs < z + Z.of_nat (length vl))) by lia.
 destruct H0.
 clear - H0.
 forget ((Mem.mem_contents m1) !! b) as mA.
 forget ((Mem.mem_contents m) !! b) as mB.
 revert z mA mB H0; induction vl; intros; simpl.
-simpl in H0; omega.
+simpl in H0; lia.
 simpl length in H0; rewrite inj_S in H0.
 destruct (zeq z ofs).
 subst ofs.
-rewrite !Mem.setN_outside by omega. rewrite !ZMap.gss; auto.
-apply IHvl; omega.
-rewrite !Mem.setN_outside by omega.
+rewrite !Mem.setN_outside by lia. rewrite !ZMap.gss; auto.
+apply IHvl; lia.
+rewrite !Mem.setN_outside by lia.
 apply perm_le_cont. auto.
 rewrite !PMap.gso by auto.
 apply perm_le_cont. auto.
@@ -646,7 +647,7 @@ destruct (peq b' b); subst.
   - left. split; trivial. destruct (zle lo ofs); simpl in *; try discriminate.
     split; trivial. destruct (zlt ofs hi); simpl in *; try discriminate.
     split; trivial.
-    assert (RP: Mem.perm m b ofs Cur Freeable). apply (Mem.free_range_perm _ _ _ _ _ FR ofs); omega.
+    assert (RP: Mem.perm m b ofs Cur Freeable). apply (Mem.free_range_perm _ _ _ _ _ FR ofs); lia.
     destruct k.
     * eapply Mem.perm_max in RP.
       unfold Mem.perm in RP. destruct ((Mem.mem_access m) !! b ofs Max); simpl in *; try discriminate.
@@ -654,7 +655,7 @@ destruct (peq b' b); subst.
     * unfold Mem.perm in RP. destruct ((Mem.mem_access m) !! b ofs Cur); simpl in *; try discriminate.
       destruct p; simpl in *; try inv RP; simpl; trivial. contradiction.
   - right; split; trivial. right.
-    destruct (zle lo ofs); destruct (zlt ofs hi); simpl in *; try discriminate; try omega.
+    destruct (zle lo ofs); destruct (zlt ofs hi); simpl in *; try discriminate; try lia.
 + right; split; trivial. left; trivial.
 Qed.
 
@@ -688,7 +689,7 @@ Proof. intros.
            rewrite (Mem.free_result _ _ _ _ _ FL) in *. simpl in *.
            rewrite PMap.gss in Heqw.
            remember (zle lo ofs&& zlt ofs hi ) as t; destruct t; simpl in *; try discriminate.
-           destruct (zle lo ofs); destruct (zlt ofs hi); simpl in *; try discriminate; omega.
+           destruct (zle lo ofs); destruct (zlt ofs hi); simpl in *; try discriminate; lia.
         ++ destruct H0 as [? ?]. rewrite H1 in *; simpl in *; contradiction.
   - specialize (perm_le_Max b0 ofs); clear perm_le_Cur perm_le_cont.
     remember ((Mem.mem_access mm) !! b0 ofs Max) as q; symmetry in Heqq.
@@ -705,7 +706,7 @@ Proof. intros.
            rewrite (Mem.free_result _ _ _ _ _ FL) in *. simpl in *.
            rewrite PMap.gss in Heqw.
            remember (zle lo ofs&& zlt ofs hi ) as t; destruct t; simpl in *; try discriminate.
-           destruct (zle lo ofs); destruct (zlt ofs hi); simpl in *; try discriminate; omega.
+           destruct (zle lo ofs); destruct (zlt ofs hi); simpl in *; try discriminate; lia.
         ++ destruct H0 as [? ?]. rewrite H1 in *; simpl in *; contradiction.
   - rewrite (Mem.free_result _ _ _ _ _ FL). rewrite (Mem.free_result _ _ _ _ _ MM).
     simpl. apply perm_le_cont. eapply Mem.perm_free_3; eassumption.
@@ -743,16 +744,16 @@ destruct (Mem.range_perm_dec m1 b ofs (ofs + Z.of_nat (length bytes)) Cur Writab
     * destruct (zlt ofs0 ofs).
       ++ rewrite Mem.setN_outside. 2: left; trivial.  rewrite Mem.setN_outside. 2: left; trivial.  apply perm_le_cont. apply H.
       ++ destruct (zle (ofs+Z.of_nat (length bytes)) ofs0).
-         rewrite Mem.setN_outside. 2: right; xomega.  rewrite Mem.setN_outside. 2: right; xomega.  apply perm_le_cont. apply H.
+         rewrite Mem.setN_outside. 2: right; lia.  rewrite Mem.setN_outside. 2: right; lia.  apply perm_le_cont. apply H.
          clear - g g0.
          remember ((Mem.mem_contents m1) !! b) as mA. clear HeqmA.
          remember ((Mem.mem_contents m) !! b) as mB. clear HeqmB.
          revert ofs mA mB g g0; induction bytes; intros; simpl.
-         -- simpl in *; omega.
+         -- simpl in *; lia.
          -- simpl length in g0; rewrite inj_S in g0.
             destruct (zeq ofs ofs0).
-            ** subst ofs0. rewrite !Mem.setN_outside by omega. rewrite !ZMap.gss; auto.
-            ** apply IHbytes; omega.
+            ** subst ofs0. rewrite !Mem.setN_outside by lia. rewrite !ZMap.gss; auto.
+            ** apply IHbytes; lia.
     * apply perm_le_cont. apply H.
   - assumption .
 + elim n; clear - PLE r. destruct PLE.
@@ -776,7 +777,7 @@ apply loadbytes_D in LD. destruct LD as [RP1 CONT].
 destruct PLE.
 destruct (Mem.range_perm_dec m1 b ofs (ofs + n) Cur Readable).
 + rewrite CONT; f_equal. eapply Mem.getN_exten.
-  intros. apply perm_le_cont. apply RP1. rewrite Z2Nat.id in H; omega.
+  intros. apply perm_le_cont. apply RP1. rewrite Z2Nat.id in H; lia.
 + elim n0; clear - RP1 perm_le_Cur.
   red; intros. specialize (RP1 _ H). specialize (perm_le_Cur b ofs0).
   unfold Mem.perm in *.
@@ -796,7 +797,7 @@ rewrite PMap.gsspec in P.
 destruct (peq b' (Mem.nextblock m)); subst; trivial.
 + left; split; trivial.
   remember (zle lo ofs && zlt ofs hi) as q. destruct q; inv P; trivial.
-  destruct (zle lo ofs); destruct (zlt ofs hi); simpl in *; try discriminate; omega.
+  destruct (zle lo ofs); destruct (zlt ofs hi); simpl in *; try discriminate; lia.
 + right; split; trivial.
 Qed.
 
@@ -806,7 +807,7 @@ Proof.
 Transparent Mem.alloc. unfold Mem.alloc in ALLOC. Opaque Mem.alloc. inv ALLOC; simpl in *.
 rewrite PMap.gsspec in P.
 destruct (peq b' (Mem.nextblock m)); subst; trivial.
-apply Mem.nextblock_noaccess. xomega.
+apply Mem.nextblock_noaccess. unfold Plt; lia.
 Qed.
 
 Lemma alloc_inc_perm: forall m lo hi m' b
diff --git a/concurrency/semax_conc.v b/concurrency/semax_conc.v
index 1e94fd9697..97d1e1e47f 100644
--- a/concurrency/semax_conc.v
+++ b/concurrency/semax_conc.v
@@ -1,392 +1,24 @@
-Require Import VST.msl.msl_standard.
-Require Import VST.msl.seplog.
-Require Import VST.veric.Clight_base.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.juicy_mem.
-Require Import VST.veric.juicy_mem_lemmas.
-Require Import VST.veric.juicy_mem_ops.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.juicy_extspec.
-Require Import VST.veric.tycontext.
-Require Import VST.veric.expr2.
-Require Import VST.veric.semax.
-Require Import VST.veric.semax_call.
-Require Import VST.veric.semax_ext.
-Require Import VST.veric.juicy_safety.
-Require Import VST.veric.res_predicates.
 Require Import VST.veric.SeparationLogic.
-Require Import VST.sepcomp.semantics.
-Require Import VST.sepcomp.extspec.
-Require Import VST.floyd.reptype_lemmas.
-Require Import VST.floyd.field_at.
-Require Import VST.floyd.nested_field_lemmas.
-Require Import VST.floyd.client_lemmas.
-Require Import VST.floyd.jmeq_lemmas.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
+Require Import compcert.cfrontend.Ctypes.
+Require Import VST.veric.expr.
 Require Import VST.concurrency.semax_conc_pred.
-Import FashNotation.
+Require Import VST.floyd.client_lemmas.
+Require Import VST.floyd.field_at.
+Import Clightdefs.
 Import String.
 Open Scope funspec_scope.
 
-Definition spawned_funtype := Tfunction (cons (tptr tvoid) nil) tint cc_default.
-
-Lemma nonexpansive_entail (F: pred rmap -> pred rmap) : nonexpansive F -> forall P Q, (P <=> Q |-- F P <=> F Q)%logic.
-Proof.
-  intros N P Q.
-  specialize (N P Q).
-  eapply derives_trans; [ eapply derives_trans | ]; [ | constructor; apply N | ];
-  apply derives_refl.
-Qed.
-
-Lemma HOnonexpansive_nonexpansive: forall F: mpred -> mpred, nonexpansive F <-> HOnonexpansive (fun P (_ : unit) => F (P tt)).
-Proof.
-  intros.
-  split; intros; hnf in H |- *.
-  + intros P Q.
-    specialize (H (P tt) (Q tt)).
-    rewrite !allp_unit.
-    constructor; auto.
-  + intros P Q.
-    specialize (H (fun x => P) (fun x => Q)).
-    rewrite !allp_unit in H.
-    inv H; auto.
-Qed.
-
-Lemma eqp_refl : forall (G : Triv) P, G |-- (P <=> P)%logic.
-Proof.
-  intros; rewrite andp_dup; apply subp_refl.
-Qed.
-
-Lemma eqp_sepcon : forall (G : Triv) (P P' Q Q' : mpred)
-  (HP : (G |-- P <=> P')%logic) (HQ : (G |-- Q <=> Q')%logic), (G |-- P * Q <=> P' * Q')%logic.
-Proof.
-  intros.
-  rewrite fash_andp in HP, HQ |- *.
-  inv HP; rename derivesI into HP.
-  inv HQ; rename derivesI into HQ.
-  apply andp_right; apply subp_sepcon; auto; constructor; intros ? Ha; destruct (HP _ Ha), (HQ _ Ha); auto.
-Qed.
-
-Lemma eqp_andp : forall (G : Triv) (P P' Q Q' : mpred)
-  (HP : (G |-- P <=> P')%logic) (HQ : (G |-- Q <=> Q')%logic), G |-- (P && Q <=> P' && Q')%logic.
-Proof.
-  intros.
-  rewrite fash_andp in HP, HQ |- *.
-  inv HP; rename derivesI into HP.
-  inv HQ; rename derivesI into HQ.
-  apply andp_right; apply subp_andp; auto; constructor; intros ? Ha; destruct (HP _ Ha), (HQ _ Ha); auto.
-Qed.
-
-Lemma eqp_exp : forall (A : Type) (NA : NatDed A) (IA : Indir A) (RecIndir : RecIndir A)
-    (G : Triv) (B : Type) (X Y : B -> A),
-  (forall x : B, (G |-- X x <=> Y x)%logic) ->
-  G |-- ((EX x : _, X x) <=> (EX x : _, Y x))%logic.
-Proof.
-  intros.
-  rewrite fash_andp; apply andp_right; apply subp_exp; intro x; specialize (H x); rewrite fash_andp in H;
-    inv H; rename derivesI into H; constructor; intros ? Ha; destruct (H _ Ha); auto.
-Qed.
-
-(*
+Definition spawned_funtype := Tfunction (tptr tvoid :: nil) tint cc_default.
 
-(* In fact we need locks to two resources:
-   1) the resource invariant, for passing the resources
-   2) the join resource invariant, for returning all resources, including itself
-   for this we need to define them in a mutually recursive fashion: *)
+Section mpred.
 
-Definition res_invariants_fun Q sh1 p1 sh2 p2 : (bool -> mpred) -> (bool -> mpred) :=
-  fun R b =>
-    if b then
-      (Q * lock_inv sh2 p2 (|> R false))%logic
-    else
-      (Q * lock_inv sh1 p1 (|> R true) * lock_inv sh2 p2 (|> R false))%logic.
-
-Definition res_invariants Q sh1 p1 sh2 p2 : bool -> mpred := HORec (res_invariants_fun Q sh1 p1 sh2 p2).
-Definition res_invariant Q sh1 p1 sh2 p2 : mpred := res_invariants Q sh1 p1 sh2 p2 true.
-Definition join_res_invariant Q sh1 p1 sh2 p2 : mpred := res_invariants Q sh1 p1 sh2 p2 false.
-
-Lemma res_invariants_eq Q sh1 p1 sh2 p2 : res_invariants Q sh1 p1 sh2 p2 =
-  res_invariants_fun Q sh1 p1 sh2 p2 (res_invariants Q sh1 p1 sh2 p2).
-Proof.
-  apply HORec_fold_unfold, prove_HOcontractive.
-  intros P1 P2 b.
-  destruct b.
-    (* resource invariant *)
-    apply subp_sepcon; try apply subp_refl.
-    apply allp_left with false.
-    eapply derives_trans.
-      apply nonexpansive_entail, nonexpansive_lock_inv.
-      apply fash_derives, andp_left1, derives_refl.
-
-    (* join resource invariant *)
-    repeat apply subp_sepcon; try apply subp_refl.
-      apply allp_left with true.
-      eapply derives_trans.
-        apply nonexpansive_entail, nonexpansive_lock_inv.
-        apply fash_derives, andp_left1, derives_refl.
-
-      apply allp_left with false.
-      eapply derives_trans.
-        apply nonexpansive_entail, nonexpansive_lock_inv.
-        apply fash_derives, andp_left1, derives_refl.
-Qed.
-
-Lemma res_invariant_eq Q sh1 p1 sh2 p2 :
-  res_invariant Q sh1 p1 sh2 p2 =
-  (Q *
-  lock_inv sh2 p2 (|> join_res_invariant Q sh1 p1 sh2 p2))%logic.
-Proof.
-  unfold res_invariant at 1.
-  rewrite res_invariants_eq.
-  reflexivity.
-Qed.
-
-Lemma join_res_invariant_eq Q sh1 p1 sh2 p2 :
-  join_res_invariant Q sh1 p1 sh2 p2 =
-  (Q *
-  lock_inv sh1 p1 (|> res_invariant Q sh1 p1 sh2 p2) *
-  lock_inv sh2 p2 (|> join_res_invariant Q sh1 p1 sh2 p2))%logic.
-Proof.
-  unfold join_res_invariant at 1.
-  rewrite res_invariants_eq.
-  reflexivity.
-Qed.*)
-
-(*(* Condition variables *)
-Definition tcond := tint.
-
-(* Does this need to be anything special? *)
-Definition cond_var {cs} sh v := @data_at_ cs sh tcond v.*)
+Context `{!VSTGS OK_ty Σ}.
 
 (*+ Specification of each concurrent primitive *)
 
-Lemma approx_eq_i':
-  forall (P Q : pred rmap) n,
-  (|> (P <=> Q))%pred n -> approx n P = approx n Q.
-Proof.
-  intros.
-apply pred_ext'; extensionality m'.
-unfold approx.
-apply and_ext'; auto; intros.
-specialize (H (level m')); spec H; [simpl; apply later_nat; auto |].
-specialize (H m').
-spec H; [lia |].
-destruct H.
-specialize (H m').
-specialize (H1 m').
-apply prop_ext; split; auto.
-Qed.
-
-Lemma fash_equiv_approx: forall n (R: pred rmap),
-  (|> (R <=> approx n R))%pred n.
-Proof.
-  intros.
-  intros m ? x ?; split; intros ? y ? ? ?.
-  + apply approx_lt; auto.
-    apply necR_level in H1. apply ext_level in H2.
-    apply later_nat in H; lia.
-  + eapply approx_p; eauto.
-Qed.
-
-Lemma nonexpansive_super_non_expansive: forall (F: mpred -> mpred),
-  nonexpansive F ->
-  forall R n,
-  approx n (F R) = approx n (F (approx n R)).
-Proof.
-  intros.
-  apply approx_eq_i'.
-  intros m ?.
-  apply nonexpansive_entail; auto.
-  clear - H0.
-  apply (fash_equiv_approx n R m); auto.
-Qed.
-
-Lemma nonexpansive2_super_non_expansive: forall (F: mpred -> mpred -> mpred),
-  (forall P, nonexpansive (fun Q => F P Q)) ->
-  (forall Q, nonexpansive (fun P => F P Q)) ->
-  forall P Q n,
-  approx n (F P Q) = approx n (F (approx n P) (approx n Q)).
-Proof.
-  intros.
-  apply approx_eq_i'.
-  intros m ?.
-  pose proof nonexpansive_entail _ (H P) Q (approx n Q) as H2.
-  inv H2; rename derivesI into H2. specialize (H2 m); cbv beta in H2.
-  spec H2; [apply (fash_equiv_approx n Q m); auto |].
-  pose proof nonexpansive_entail _ (H0 (approx n Q)) P (approx n P) as H3.
-  inv H3; rename derivesI into H3. specialize (H3 m); cbv beta in H3.
-  spec H3; [apply (fash_equiv_approx n P m); auto |].
-  remember (F P Q) as X1.
-  remember (F P (approx n Q)) as X2.
-  remember (F (approx n P) (approx n Q)) as X3.
-  clear - H2 H3.
-  change ((X1 <=> X2)%pred m) in H2.
-  change ((X2 <=> X3)%pred m) in H3.
-  intros y H; specialize (H2 y H); specialize (H3 y H).
-  destruct H2 as [H2A H2B], H3 as [H3A H3B].
-  split; intros z H0.
-  + specialize (H2A z H0); specialize (H3A z H0); auto.
-  + specialize (H2B z H0); specialize (H3B z H0); auto.
-Qed.
-
-(*
-Lemma nonexpansive_2super_non_expansive: forall {A B: Type} (F: (A -> B -> mpred) -> mpred),
-  (forall a b, nonexpansive (fun Q => F P Q)) ->
-  (forall Q, nonexpansive (fun P => F P Q)) ->
-  forall P Q n,
-  approx n (F P Q) = approx n (F (approx n P) (approx n Q)).
-*)
-
-(*(* condition variables *)
-Definition makecond_spec cs :=
-   WITH v : val, sh : share
-   PRE [ (*_cond OF*) tptr tcond ]
-     PROP (writable_share sh)
-     (*LOCAL (temp _cond v)*) PARAMS (v) GLOBALS ()
-     SEP (@data_at_ cs sh tcond v)
-   POST [ tvoid ]
-     PROP ()
-     LOCAL ()
-     SEP (cond_var sh v).
-
-Definition freecond_spec cs :=
-   WITH v : val, sh : share
-   PRE [ (*_cond OF*) tptr tcond ]
-     PROP (writable_share sh)
-     (*LOCAL (temp _cond v)*) PARAMS (v) GLOBALS ()
-     SEP (@cond_var cs sh v)
-   POST [ tvoid ]
-     PROP ()
-     LOCAL ()
-     SEP (@data_at_ cs sh tcond v).
-
-Program Definition wait_spec cs: funspec := mk_funspec
- (* ((_cond OF tptr tcond)%formals :: (_lock OF tptr Tvoid)%formals :: nil, tvoid)*)
-  ((tptr tcond) :: (tptr Ctypes.Tvoid) :: nil, tvoid)
-  cc_default
-  (rmaps.ProdType (rmaps.ConstType (val * val * share * share)) rmaps.Mpred)
-  (fun _ x =>
-   match x with
-   | (c, l, shc, shl, R) =>
-     PROP (readable_share shc)
-     PARAMS (c;l) GLOBALS ()
-     SEP (@cond_var cs shc c; lock_inv shl l R; R)
-   end)%argsassert
-  (fun _ x =>
-   match x with
-   | (c, l, shc, shl, R) =>
-     PROP ()
-     LOCAL ()
-     SEP (cond_var shc c; lock_inv shl l R; R)
-   end)
-  _
-  _
-.
-Next Obligation.
-  intros cs; hnf.
-  intros.
-  destruct x as [[[[c l] shc] shl] R]; simpl in *.
-  apply (nonexpansive_super_non_expansive
-   (fun R => (PROP (readable_share shc)
-    PARAMS (c;l) GLOBALS ()
-    SEP (cond_var shc c; lock_inv shl l R; R))%argsassert gargs)).
-  apply (PROP_PARAMS_GLOBALS_SEP_nonexpansive
-          ((fun _ => readable_share shc) :: nil)
-          (*(temp _cond c :: temp _lock l :: nil)*)(c::l :: nil) nil
-          ((fun R => cond_var shc c) :: (fun R => lock_inv shl l R) :: (fun R => R) :: nil));
-  repeat apply Forall_cons; try apply Forall_nil.
-  + apply const_nonexpansive.
-  + apply const_nonexpansive.
-  + apply nonexpansive_lock_inv.
-  + apply identity_nonexpansive.
-Qed.
-Next Obligation.
-  intros cs; hnf.
-  intros.
-  destruct x as [[[[c l] shc] shl] R]; simpl in *.
-  apply (nonexpansive_super_non_expansive
-   (fun R => (PROP ()
-    LOCAL ()
-    SEP (cond_var shc c; lock_inv shl l R; R)) rho)).
-  apply (PROP_LOCAL_SEP_nonexpansive
-          nil
-          nil
-          ((fun R => cond_var shc c) :: (fun R => lock_inv shl l R) :: (fun R => R) :: nil));
-  repeat apply Forall_cons; try apply Forall_nil.
-  + apply const_nonexpansive.
-  + apply nonexpansive_lock_inv.
-  + apply identity_nonexpansive.
-Qed.
-
-Program Definition wait2_spec cs: funspec := mk_funspec
-  (*((_cond OF tptr tcond)%formals :: (_lock OF tptr Tvoid)%formals :: nil, tvoid)*)
-  ((tptr tcond)%formals :: (tptr Ctypes.Tvoid)%formals :: nil, tvoid)
-  cc_default
-  (rmaps.ProdType (rmaps.ConstType (val * val * share * share)) rmaps.Mpred)
-  (fun _ x =>
-   match x with
-   | (c, l, shc, shl, R) =>
-     PROP (readable_share shc)
-     PARAMS (c;l) GLOBALS ()
-     SEP (lock_inv shl l R; R && (@cond_var cs shc c * TT))
-   end)%argsassert
-  (fun _ x =>
-   match x with
-   | (c, l, shc, shl, R) =>
-     PROP ()
-     LOCAL ()
-     SEP (lock_inv shl l R; R)
-   end)
-  _
-  _
-.
-Next Obligation.
-  intros cs; hnf.
-  intros.
-  destruct x as [[[[c l] shc] shl] R]; simpl in *.
-  apply (nonexpansive_super_non_expansive
-   (fun R => (PROP (readable_share shc)
-    PARAMS (c;l) GLOBALS ()
-    SEP (lock_inv shl l R; R && (@cond_var cs shc c * TT)))%argsassert gargs)).
-  apply (PROP_PARAMS_GLOBALS_SEP_nonexpansive
-          ((fun _ => readable_share shc) :: nil)
-          (c::l::nil) nil
-          ((fun R => lock_inv shl l R) :: (fun R => R && (@cond_var cs shc c * TT))%logic :: nil));
-  repeat apply Forall_cons; try apply Forall_nil.
-  + apply const_nonexpansive.
-  + apply nonexpansive_lock_inv.
-  + apply (conj_nonexpansive (fun R => R) (fun _ => (cond_var shc c * TT)%logic)).
-    - apply identity_nonexpansive.
-    - apply const_nonexpansive.
-Qed.
-Next Obligation.
-  intros cs; hnf.
-  intros.
-  destruct x as [[[[c l] shc] shl] R]; simpl in *.
-  apply (nonexpansive_super_non_expansive
-   (fun R => (PROP ()
-    LOCAL ()
-    SEP (lock_inv shl l R; R)) rho)).
-  apply (PROP_LOCAL_SEP_nonexpansive
-          nil
-          nil
-          ((fun R => lock_inv shl l R) :: (fun R => R) :: nil));
-  repeat apply Forall_cons; try apply Forall_nil.
-  + apply nonexpansive_lock_inv.
-  + apply identity_nonexpansive.
-Qed.
-
-Definition signal_spec cs :=
-   WITH c : val, shc : share
-   PRE [ (*_cond OF*) tptr tcond ]
-     PROP (readable_share shc)
-     (*LOCAL (temp _cond c)*)PARAMS (c) GLOBALS ()
-     SEP (@cond_var cs shc c)
-   POST [ tvoid ]
-     PROP ()
-     LOCAL ()
-     SEP (@cond_var cs shc c).
-*)
-
-
 (* To enable joinable threads, the postcondition would be [tptr tthread]
 with a type [tthread] related to the postcondition through a [thread]
 predicate in the logic.  The [join] would then also be implemented
@@ -394,143 +26,57 @@ using the oracle, as [acquire] is.  The postcondition would be [match
 PrePost with existT ty (w, pre, post) => thread th (post w b)
 end] *)
 
-Local Open Scope logic.
-
-(* @Qinxiang: it would be great to complete the annotation *)
-
-Definition spawn_arg_type := rmaps.ProdType (rmaps.ProdType (rmaps.ProdType (rmaps.ConstType (val * val))
-  (rmaps.ArrowType (rmaps.DependentType 0) (rmaps.ConstType globals))) (rmaps.DependentType 0))
-  (rmaps.ArrowType (rmaps.DependentType 0) (rmaps.ArrowType (rmaps.ConstType val) rmaps.Mpred)).
-
-Definition spawn_pre :=
-  (fun (ts: list Type) (x: val * val * (nth 0 ts unit -> globals) * nth 0 ts unit *
-                           (nth 0 ts unit -> val -> mpred)) =>
-   match x with
-   | (f, b, gv, w, pre) =>
-     PROP (tc_val (tptr Ctypes.Tvoid) b)
-     PARAMS (f;b) GLOBALS (gv w)
-     (SEP (
-         (func_ptr'
-           (WITH y : val, x : nth 0 ts unit
+(* If we want the spawned function to itself have a higher-order or dependent spec,
+   we probably need the DependentType machinery after all. *)
+Definition spawn_arg_type := ProdType (ConstType (val * val)) (SigType Type (fun A => ProdType (ProdType
+  (DiscreteFunType A (ConstType globals)) (ConstType A))
+  (DiscreteFunType A (DiscreteFunType val Mpred)))).
+
+Local Unset Program Cases.
+
+Program Definition spawn_pre : dtfr (ArgsTT spawn_arg_type) := λne x,
+  let '(f, b, fs) := x in
+  PROP (tc_val (tptr Tvoid) b)
+    PARAMS (f; b)
+    GLOBALS (let 'existT A ((gv, w), _) := fs in gv w)
+    SEP (let 'existT A ((gv, w), pre) := fs in
+         (func_ptr
+           (WITH y : val, x : A
              PRE [ tptr tvoid ]
                PROP ()
-               PARAMS (y) GLOBALS (gv x)
-               (SEP   (pre x y))
+               PARAMS (y)
+               GLOBALS (gv x)
+               SEP (pre x y)
              POST [ tint ]
                PROP  ()
                RETURN (Vint Int.zero) (* spawned functions must return 0 for now *)
                SEP   ())
            f);
-         pre w b))
-   end)%argsassert.
-
-Definition spawn_post :=
-  (fun (ts: list Type) (x: val * val * (nth 0 ts unit -> globals) * nth 0 ts unit *
-                           (nth 0 ts unit -> val -> mpred)) =>
-   match x with
-   | (f, b, w, pre) =>
-     PROP ()
-     LOCAL ()
-     SEP () (* here's where we'd put a join condition *)
-   end).
-
-Lemma approx_idem : forall n P, compcert_rmaps.R.approx n (compcert_rmaps.R.approx n P) =
-  compcert_rmaps.R.approx n P.
-Proof.
-  intros.
-  transitivity (base.compose (compcert_rmaps.R.approx n) (compcert_rmaps.R.approx n) P); auto.
-  rewrite compcert_rmaps.RML.approx_oo_approx; auto.
-Qed.
-
-Lemma approx_idem' : forall n P, approx n (approx n P) =
-  approx n P.
-Proof. intros. apply approx_idem. Qed.
-(*
-Lemma spawn_pre_nonexpansive: @super_non_expansive spawn_arg_type spawn_pre.
-Proof.
-  repeat intro.
-  destruct x as ((((?, ?), ?), ?), ?); simpl.
-  unfold PROPx; simpl; rewrite !approx_andp; f_equal.
-  unfold LOCALx; simpl; rewrite !approx_andp; f_equal.
-  unfold SEPx; simpl; rewrite !sepcon_emp, !approx_sepcon, ?approx_idem; f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality y.
-  rewrite approx_func_ptr'.
-  setoid_rewrite approx_func_ptr' at 2.
-  do 3 f_equal.
-  extensionality a rho'; destruct a.
-  rewrite !approx_andp, !approx_sepcon, approx_idem; auto.
-Qed.*)
-
-Lemma approx_derives_e {n P Q}: @derives mpred Nveric  P Q -> @derives mpred Nveric (approx n P) (approx n Q).
-Proof. intros. constructor. apply approx_hered_derives_e. apply H. Qed.
-
-Lemma funcptr_f_equal' fs fs' v v': fs=fs' -> v=v' -> func_ptr' fs v = func_ptr' fs' v'.
-Proof. intros; subst; trivial. Qed.
-
-Lemma approx_Sn_eq_weaken:
-  forall n a b, approx (S n) a = approx (S n) b -> approx n a = approx n b.
+         let 'existT A ((gv, w), pre) := fs in (*valid_pointer b ∧*) pre w b) (* Do we need the valid_pointer here? *).
+Next Obligation.
 Proof.
-intros.
-apply predicates_hered.pred_ext.
--
-intros ? ?.
-destruct H0.
-split; auto.
-assert (approx (S n) b a0).
-rewrite <- H.
-split; auto.
-apply H2.
--
-intros ? ?.
-destruct H0.
-split; auto.
-assert (approx (S n) a a0).
-rewrite H.
-split; auto.
-apply H2.
-Qed.
-
-Lemma spawn_pre_nonexpansive: @args_super_non_expansive spawn_arg_type spawn_pre.
-Proof. repeat intro.
-  destruct x as ((((?, ?), ?), ?), ?); simpl.
-  unfold PROPx; simpl; rewrite !approx_andp; f_equal.
-  unfold LAMBDAx. rewrite !approx_andp; f_equal.
-  unfold GLOBALSx, LOCALx; simpl. rewrite !approx_andp. f_equal.
-  unfold argsassert2assert. simpl.
-  unfold SEPx; simpl. rewrite !sepcon_emp.
-  rewrite !approx_sepcon. rewrite approx_idem.
-  apply pred_ext; apply sepcon_derives; trivial; apply derives_refl'.
-  (* f_equal.*)
-  + apply approx_Sn_eq_weaken.
-    rewrite approx_func_ptr'.
-    setoid_rewrite approx_func_ptr' at 2. apply f_equal.
-    apply funcptr_f_equal'; trivial. simpl.
-    apply semax_prog.funspec_eq; trivial.
-    extensionality tss a rho'; destruct a.
-    rewrite !approx_andp, !approx_sepcon, approx_idem; auto.
-  + apply approx_Sn_eq_weaken.
-    rewrite approx_func_ptr'.
-    setoid_rewrite approx_func_ptr' at 2. apply f_equal.
-    apply funcptr_f_equal'; trivial. simpl.
-    apply semax_prog.funspec_eq; trivial.
-    extensionality tss a rho'; destruct a.
-    rewrite !approx_andp, !approx_sepcon, approx_idem; auto.
-Qed.
-
-Lemma spawn_post_nonexpansive: @super_non_expansive spawn_arg_type spawn_post.
+  intros ? ((f, b), (?, ((gv, ?), pre))) ((?, ?), (?, ((?, w), ?))) ([=] & ? & Hfs) rho; simpl in *; subst; simpl in *.
+  destruct Hfs as ((Hgv & [=]) & Hpre); simpl in *; subst.
+  rewrite (Hgv _).
+  do 6 f_equiv.
+  - apply func_ptr_si_nonexpansive; last done.
+    split; last split; [done..|].
+    exists eq_refl; simpl.
+    split3; intros (?, ?); simpl; try done.
+    intros ?; rewrite Hgv (Hpre _ _) //.
+  - rewrite (Hpre _ _) //.
+Defined.
+
+Program Definition spawn_post : @dtfr Σ (AssertTT spawn_arg_type) := λne x,
+  let '(f, b, fs) := x in PROP () LOCAL () SEP ().
+Next Obligation.
 Proof.
-  hnf; intros.
-  destruct x as [[[]] pre]; auto.
+  intros ? ((f, b), ?) ((?, ?), ?) ?.
+  reflexivity.
 Qed.
 
-Definition spawn_spec := mk_funspec
-  ((tptr spawned_funtype) :: (tptr tvoid) :: nil, tvoid)
-  cc_default
-  spawn_arg_type
-  spawn_pre
-  spawn_post
-  spawn_pre_nonexpansive
-  spawn_post_nonexpansive.
+Definition spawn_spec := mk_funspec ([tptr spawned_funtype; tptr tvoid], tvoid) cc_default
+  spawn_arg_type (λne _, ⊤) spawn_pre spawn_post.
 
 (*+ Adding the specifications to a void ext_spec *)
 
@@ -551,23 +97,14 @@ Definition Concurrent_Simple_Espec Z cs ext_link :=
     Z
     (concurrent_simple_ext_spec Z cs ext_link).*)
 
-Lemma strong_nat_ind (P : nat -> Prop) (IH : forall n, (forall i, lt i n -> P i) -> P n) n : P n.
-Proof.
-  apply IH; induction n; intros i li; inversion li; eauto.
-Qed.
-
 Definition concurrent_specs (cs : compspecs) (ext_link : string -> ident) :=
   (ext_link "spawn"%string, spawn_spec) ::
   nil.
 
-Definition concurrent_ext_spec Z (cs : compspecs) (ext_link : string -> ident) :=
-  add_funspecs_rec
+#[export] Instance concurrent_ext_spec (cs : compspecs) (ext_link : string -> ident) : ext_spec OK_ty :=
+  add_funspecs_rec OK_ty
     ext_link
-    (ok_void_spec Z).(@OK_ty)
-    (ok_void_spec Z).(@OK_spec)
+    (void_spec OK_ty)
     (concurrent_specs cs ext_link).
 
-Definition Concurrent_Espec Z cs ext_link :=
-  Build_OracleKind
-    Z
-    (concurrent_ext_spec Z cs ext_link).
+End mpred.
diff --git a/concurrency/semax_conc_pred.v b/concurrency/semax_conc_pred.v
index 30073ab150..cdcf4952ea 100644
--- a/concurrency/semax_conc_pred.v
+++ b/concurrency/semax_conc_pred.v
@@ -1,40 +1,29 @@
 Require Import VST.msl.msl_standard.
-Require Import VST.msl.seplog.
 Require Import VST.veric.Clight_base.
-Require Import VST.veric.compcert_rmaps.
+Set Warnings "-custom-entry-overridden".
 Require Import VST.veric.juicy_mem.
+Set Warnings "custom-entry-overridden".
 Require Import VST.veric.juicy_mem_lemmas.
-Require Import VST.veric.juicy_mem_ops.
 Require Import VST.veric.juicy_extspec.
 Require Import VST.veric.tycontext.
 Require Import VST.veric.expr2.
 Require Import VST.veric.semax.
 Require Import VST.veric.semax_call.
 Require Import VST.veric.semax_ext.
-(*Require Import VST.veric.semax_ext_oracle.*)
 Require Import VST.veric.juicy_safety.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.res_predicates.
 Require Import VST.veric.SeparationLogic.
 Require Import VST.sepcomp.semantics.
 Require Import VST.sepcomp.extspec.
 Require Import VST.floyd.base VST.floyd.seplog_tactics.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.reptype_lemmas.
 Require Import VST.floyd.field_at.
 Require Import VST.floyd.nested_field_lemmas.
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.jmeq_lemmas.
 
-Lemma approx_derives_ge : forall n m P, (n <= m)%nat -> approx n P |-- approx m P.
-Proof.
-  intros; constructor. change (predicates_hered.derives (approx n P) (approx m P)).
-  intros ? []; split; auto; lia.
-Qed.
-
-Lemma approx_derives : forall P n, approx n P |-- P.
-Proof.
-  constructor; intro; apply approx_p.
-Qed.
-
 (*Lemma unfash_fash_equiv: forall P Q: mpred,
   (P <=> Q)%pred |--
   ((subtypes.unfash (subtypes.fash P): mpred) <=> (subtypes.unfash (subtypes.fash Q): mpred))%pred.
diff --git a/coq-vst-32.opam b/coq-vst-32.opam
deleted file mode 100644
index d66ba972fa..0000000000
--- a/coq-vst-32.opam
+++ /dev/null
@@ -1,43 +0,0 @@
-opam-version: "2.0"
-version: "dev"
-synopsis: "Verified Software Toolchain"
-description: "The software toolchain includes static analyzers to check assertions about your program; optimizing compilers to translate your program to machine language; operating systems and libraries to supply context for your program. The Verified Software Toolchain project assures with machine-checked proofs that the assertions claimed at the top of the toolchain really hold in the machine-language program, running in the operating-system context."
-authors: [
-  "Andrew W. Appel"
-  "Lennart Beringer"
-  "Josiah Dodds"
-  "Qinxiang Cao"
-  "Aquinas Hobor"
-  "Gordon Stewart"
-  "Qinshi Wang"
-  "Sandrine Blazy"
-  "Santiago Cuellar"
-  "Robert Dockins"
-  "Nick Giannarakis"
-  "Samuel Gruetter"
-  "Jean-Marie Madiot"
-]
-maintainer: "VST team"
-homepage: "http://vst.cs.princeton.edu/"
-dev-repo: "git+https://github.com/PrincetonUniversity/VST.git"
-bug-reports: "https://github.com/PrincetonUniversity/VST/issues"
-license: "https://raw.githubusercontent.com/PrincetonUniversity/VST/master/LICENSE"
-
-build: [
-  [make "-j%{jobs}%" "vst" "IGNORECOQVERSION=true" "ZLIST=platform" "BITSIZE=32"]
-]
-install: [
-  [make "install" "IGNORECOQVERSION=true" "ZLIST=platform" "BITSIZE=32"]
-]
-run-test: [
-  [make "-j%{jobs}%" "test" "IGNORECOQVERSION=true" "ZLIST=platform" "BITSIZE=32"]
-]
-depends: [
-  "coq" {>= "8.14" & < "8.17~"}
-  "coq-compcert-32" {>= "3.11"}
-  "coq-vst-zlist" {>= "2.11"}
-  "coq-flocq" {>= "4.1.0"}
-]
-url {
-  src: "git+https://github.com/PrincetonUniversity/VST.git#master"
-}
diff --git a/coq-vst-iris.opam b/coq-vst-iris.opam
deleted file mode 100644
index bb3e58b015..0000000000
--- a/coq-vst-iris.opam
+++ /dev/null
@@ -1,30 +0,0 @@
-opam-version: "2.0"
-version: "dev"
-synopsis: "Verified Software Toolchain with Iris"
-description: "VST with support for Iris tactics, definitions, and notation. Especially useful for reasoning about fine-grained concurrent programs and logical atomicity."
-authors: [
-  "William Mansky"
-  "Shengyi Wang"
-]
-maintainer: "VST team"
-homepage: "http://vst.cs.princeton.edu/"
-dev-repo: "git+https://github.com/PrincetonUniversity/VST.git"
-bug-reports: "https://github.com/PrincetonUniversity/VST/issues"
-license: "https://raw.githubusercontent.com/PrincetonUniversity/VST/master/LICENSE"
-
-build: [
-  [make "-j%{jobs}%" "build-iris" "IGNORECOQVERSION=true" "ZLIST=platform" "BITSIZE=64"]
-]
-install: [
-  [make "install-iris" "IGNORECOQVERSION=true" "ZLIST=platform" "BITSIZE=64"]
-]
-run-test: [
-  [make "-j%{jobs}%" "atomics" "IGNORECOQVERSION=true" "ZLIST=platform" "BITSIZE=64"]
-]
-depends: [
-  "coq-vst" { = version }
-  "coq-iris" {>= "4.0.0"}
-]
-url {
-  src: "git+https://github.com/PrincetonUniversity/VST.git#master"
-}
diff --git a/coq-vst-zlist.opam b/coq-vst-zlist.opam
deleted file mode 100644
index 085abcb83a..0000000000
--- a/coq-vst-zlist.opam
+++ /dev/null
@@ -1,24 +0,0 @@
-opam-version: "2.0"
-version: "dev"
-synopsis: "A list library indexed by Z type, with a powerful automatic solver"
-authors: [
-  "Qinshi Wang"
-  "Andrew W. Appel"
-]
-maintainer: "VST team"
-homepage: "http://vst.cs.princeton.edu/"
-dev-repo: "git+https://github.com/PrincetonUniversity/VST.git"
-bug-reports: "https://github.com/PrincetonUniversity/VST/issues"
-license: "https://raw.githubusercontent.com/PrincetonUniversity/VST/master/LICENSE"
-build: [
-  [make "-C" "zlist" "-j%{jobs}%"]
-]
-run-test: []
-install: [make "-C" "zlist" "install"]
-
-depends: [
-  "coq" {>= "8.11.0"}
-]
-url {
-  src: "git+https://github.com/PrincetonUniversity/VST.git#master"
-}
diff --git a/floyd/Component.v b/floyd/Component.v
index 62e3426d38..1c3218bc1b 100644
--- a/floyd/Component.v
+++ b/floyd/Component.v
@@ -1,29 +1,37 @@
+Set Warnings "-custom-entry-overridden".
 Require Import VST.floyd.proofauto.
+Set Warnings "custom-entry-overridden".
 Require Import VST.veric.Clight_initial_world.
 Require Import VST.floyd.assoclists.
 Require Import VST.floyd.PTops.
 Require Export VST.floyd.QPcomposite.
 Require Export VST.floyd.quickprogram.
-Import compcert.lib.Maps.
+Import -(notations) compcert.lib.Maps.
 
-Lemma semax_body_subsumespec {cs} V V' F F' f iphi (SB: @semax_body V F cs f iphi)
-  ( HVF : forall i : positive,
-      sub_option (make_tycontext_g V F) ! i (make_tycontext_g V' F') ! i)
+Local Unset SsrRewrite.
+
+Section semax.
+
+Context `{!VSTGS OK_ty Σ}.
+
+Lemma semax_body_subsumespec {cs : compspecs} V V' F F' f iphi (SB: semax_body V F f iphi)
+  (HVF : forall i : positive,
+      sub_option ((make_tycontext_g V F) !! i) ((make_tycontext_g V' F') !! i))
   (HF : forall i : ident, subsumespec (find_id i F) (find_id i F')):
-   @semax_body V' F' cs f iphi.
+   semax_body V' F' f iphi.
 Proof. eapply semax_body_subsumption. apply SB. clear SB.
     red; simpl. repeat split; trivial; intros i.
-    - destruct ((make_tycontext_t (fn_params f) (fn_temps f)) ! i); trivial.
+    - destruct ((make_tycontext_t (fn_params f) (fn_temps f)) !! i); trivial.
     - rewrite 2 make_tycontext_s_find_id; trivial.
 Qed.
 
 Lemma semax_body_binaryintersection':
   forall (V : varspecs) (G : funspecs) (cs : compspecs) (f : function) (sp1 sp2 : ident * funspec)
-    sg cc A1 P1 Q1 Pne1 Qne1 A2 P2 Q2 Pne2 Qne2,
+    sg cc A1 E1 P1 Q1 A2 E2 P2 Q2,
   semax_body V G f sp1 ->
   semax_body V G f sp2 -> forall
-  (W1: snd sp1 = mk_funspec sg cc A1 P1 Q1 Pne1 Qne1)
-  (W2: snd sp2 = mk_funspec sg cc A2 P2 Q2 Pne2 Qne2),
+  (W1: snd sp1 = mk_funspec sg cc A1 E1 P1 Q1)
+  (W2: snd sp2 = mk_funspec sg cc A2 E2 P2 Q2),
   semax_body V G f (fst sp1, binary_intersection' (snd sp1) (snd sp2) W1 W2).
 Proof. intros. eapply semax_body_binaryintersection. trivial. apply H0.
   apply binary_intersection'_sound.
@@ -31,14 +39,14 @@ Qed.
 
 Lemma semax_body_binaryintersection'':
   forall (V : varspecs) (G : funspecs) (cs : compspecs) (f : function) i (sp1 sp2 : funspec)
-    sg cc A1 P1 Q1 Pne1 Qne1 A2 P2 Q2 Pne2 Qne2,
+    sg cc A1 E1 P1 Q1 A2 E2 P2 Q2,
   semax_body V G f (i,sp1) ->
   semax_body V G f (i,sp2) -> forall
-  (W1: sp1 = mk_funspec sg cc A1 P1 Q1 Pne1 Qne1)
-  (W2: sp2 = mk_funspec sg cc A2 P2 Q2 Pne2 Qne2),
+  (W1: sp1 = mk_funspec sg cc A1 E1 P1 Q1)
+  (W2: sp2 = mk_funspec sg cc A2 E2 P2 Q2),
   semax_body V G f (i, binary_intersection' sp1 sp2 W1 W2).
 Proof. intros.
-apply (semax_body_binaryintersection' _ _ _ _ _ _ sg cc A1 P1 Q1 Pne1 Qne1 A2 P2 Q2 Pne2 Qne2 H H0 W1 W2).
+apply (semax_body_binaryintersection' _ _ _ _ _ _ sg cc A1 E1 P1 Q1 A2 E2 P2 Q2 H H0 W1 W2).
 Qed.
 
 Lemma semax_body_subsumespec_GprogNil (V : varspecs) F (cs:compspecs) f iphi:
@@ -55,92 +63,68 @@ Lemma semax_body_subsumespec_GprogNil (V : varspecs) F (cs:compspecs) f iphi:
   Qed.
 
 Lemma binary_intersection'_sub1:
-  forall (f : compcert_rmaps.typesig) (c : calling_convention) (A1 : rmaps.TypeTree)
-    (P1 : forall ts : list Type,
-          functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts (ArgsTT A1)) mpred)
-    (Q1 : forall ts : list Type,
-          functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts (AssertTT A1))
-            mpred) (P1_ne : args_super_non_expansive P1) (Q1_ne : super_non_expansive Q1)
-    (A2 : rmaps.TypeTree)
-    (P2 : forall ts : list Type,
-          functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts (ArgsTT A2)) mpred)
-    (Q2 : forall ts : list Type,
-          functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts (AssertTT A2))
-            mpred) (P2_ne : args_super_non_expansive P2) (Q2_ne : super_non_expansive Q2)
-    (phi psi : funspec) (Hphi : phi = mk_funspec f c A1 P1 Q1 P1_ne Q1_ne)
-    (Hpsi : psi = mk_funspec f c A2 P2 Q2 P2_ne Q2_ne),
+  forall (f : typesig) (c : calling_convention) (A1 : TypeTree)
+    (E1 : dtfr (MaskTT A1))
+    (P1 : dtfr (ArgsTT A1))
+    (Q1 : dtfr (AssertTT A1))
+    (A2 : TypeTree)
+    (E2 : dtfr (MaskTT A2))
+    (P2 : dtfr (ArgsTT A2))
+    (Q2 : dtfr (AssertTT A2))
+    (phi psi : funspec) (Hphi : phi = mk_funspec f c A1 E1 P1 Q1)
+    (Hpsi : psi = mk_funspec f c A2 E2 P2 Q2),
   seplog.funspec_sub (binary_intersection' phi psi Hphi Hpsi) phi.
-Proof. intros. apply binary_intersection'_sub. Qed. 
+Proof. intros. apply binary_intersection'_sub. Qed.
 
 Lemma binary_intersection'_sub2:
-  forall (f : compcert_rmaps.typesig) (c : calling_convention) (A1 : rmaps.TypeTree)
-    (P1 : forall ts : list Type,
-          functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts (ArgsTT A1)) mpred)
-    (Q1 : forall ts : list Type,
-          functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts (AssertTT A1))
-            mpred) (P1_ne : args_super_non_expansive P1) (Q1_ne : super_non_expansive Q1)
-    (A2 : rmaps.TypeTree)
-    (P2 : forall ts : list Type,
-          functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts (ArgsTT A2)) mpred)
-    (Q2 : forall ts : list Type,
-          functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts (AssertTT A2))
-            mpred) (P2_ne : args_super_non_expansive P2) (Q2_ne : super_non_expansive Q2)
-    (phi psi : funspec) (Hphi : phi = mk_funspec f c A1 P1 Q1 P1_ne Q1_ne)
-    (Hpsi : psi = mk_funspec f c A2 P2 Q2 P2_ne Q2_ne),
+  forall (f : typesig) (c : calling_convention) (A1 : TypeTree)
+    (E1 : dtfr (MaskTT A1))
+    (P1 : dtfr (ArgsTT A1))
+    (Q1 : dtfr (AssertTT A1))
+    (A2 : TypeTree)
+    (E2 : dtfr (MaskTT A2))
+    (P2 : dtfr (ArgsTT A2))
+    (Q2 : dtfr (AssertTT A2))
+    (phi psi : funspec) (Hphi : phi = mk_funspec f c A1 E1 P1 Q1)
+    (Hpsi : psi = mk_funspec f c A2 E2 P2 Q2),
   seplog.funspec_sub (binary_intersection' phi psi Hphi Hpsi) psi.
-Proof. intros. apply binary_intersection'_sub. Qed. 
+Proof. intros. apply binary_intersection'_sub. Qed.
 
-Lemma binary_intersection'_sub  {f c A1 P1 Q1 P1_ne Q1_ne A2 P2 Q2 P2_ne Q2_ne} (phi psi:funspec) Hphi Hpsi:
-  funspec_sub (@binary_intersection' f c A1 P1 Q1 P1_ne Q1_ne A2 P2 Q2 P2_ne Q2_ne phi psi Hphi Hpsi) phi /\
-  funspec_sub (@binary_intersection' f c A1 P1 Q1 P1_ne Q1_ne A2 P2 Q2 P2_ne Q2_ne phi psi Hphi Hpsi) psi.
-Proof. rewrite !funspec_sub_iff. apply binary_intersection'_sub. Qed.
+Lemma binary_intersection'_sub  {f c A1 E1 P1 Q1 A2 E2 P2 Q2} (phi psi:funspec) Hphi Hpsi:
+  funspec_sub (@binary_intersection' Σ _ f c A1 E1 P1 Q1 A2 E2 P2 Q2 phi psi Hphi Hpsi) phi /\
+  funspec_sub (@binary_intersection' Σ _ f c A1 E1 P1 Q1 A2 E2 P2 Q2 phi psi Hphi Hpsi) psi.
+Proof. apply binary_intersection'_sub. Qed.
 
-Lemma binary_intersection'_sub'  {f c A1 P1 Q1 P1_ne Q1_ne A2 P2 Q2 P2_ne Q2_ne} (phi psi:funspec) Hphi Hpsi tau
-  (X: tau = @binary_intersection' f c A1 P1 Q1 P1_ne Q1_ne A2 P2 Q2 P2_ne Q2_ne phi psi Hphi Hpsi):
+Lemma binary_intersection'_sub'  {f c A1 E1 P1 Q1 A2 E2 P2 Q2} (phi psi:funspec) Hphi Hpsi tau
+  (X: tau = @binary_intersection' Σ _ f c A1 E1 P1 Q1 A2 E2 P2 Q2 phi psi Hphi Hpsi):
   funspec_sub tau phi /\ funspec_sub tau psi.
 Proof. subst. apply binary_intersection'_sub. Qed.
 
-Lemma binary_intersection_sub1 (f : compcert_rmaps.typesig) (c : calling_convention) 
-         (A1 : rmaps.TypeTree)
-         (P1 : forall ts : list Type,
-               functors.MixVariantFunctor._functor
-                 (rmaps.dependent_type_functor_rec ts (ArgsTT A1)) mpred)
-         (Q1 : forall ts : list Type,
-               functors.MixVariantFunctor._functor
-                 (rmaps.dependent_type_functor_rec ts (AssertTT A1)) mpred)
-         (P1_ne : args_super_non_expansive P1) (Q1_ne : super_non_expansive Q1)
-         (A2 : rmaps.TypeTree)
-         (P2 : forall ts : list Type,
-               functors.MixVariantFunctor._functor
-                 (rmaps.dependent_type_functor_rec ts (ArgsTT A2)) mpred)
-         (Q2 : forall ts : list Type,
-               functors.MixVariantFunctor._functor
-                 (rmaps.dependent_type_functor_rec ts (AssertTT A2)) mpred)
-         (P2_ne : args_super_non_expansive P2) (Q2_ne : super_non_expansive Q2)
-         (phi psi : funspec) (Hphi : phi = mk_funspec f c A1 P1 Q1 P1_ne Q1_ne)
-         (Hpsi : psi = mk_funspec f c A2 P2 Q2 P2_ne Q2_ne):
+Lemma binary_intersection_sub1 (f : typesig) (c : calling_convention)
+         (A1 : TypeTree)
+         (E1 : dtfr (MaskTT A1))
+         (P1 : dtfr (ArgsTT A1))
+         (Q1 : dtfr (AssertTT A1))
+         (A2 : TypeTree)
+         (E2 : dtfr (MaskTT A2))
+         (P2 : dtfr (ArgsTT A2))
+         (Q2 : dtfr (AssertTT A2))
+         (phi psi : funspec) (Hphi : phi = mk_funspec f c A1 E1 P1 Q1)
+         (Hpsi : psi = mk_funspec f c A2 E2 P2 Q2):
        funspec_sub (binary_intersection' phi psi Hphi Hpsi) phi.
 Proof. apply binary_intersection'_sub. Qed.
 
-Lemma binary_intersection_sub2 (f : compcert_rmaps.typesig) (c : calling_convention) 
-         (A1 : rmaps.TypeTree)
-         (P1 : forall ts : list Type,
-               functors.MixVariantFunctor._functor
-                 (rmaps.dependent_type_functor_rec ts (ArgsTT A1)) mpred)
-         (Q1 : forall ts : list Type,
-               functors.MixVariantFunctor._functor
-                 (rmaps.dependent_type_functor_rec ts (AssertTT A1)) mpred)
-         (P1_ne : args_super_non_expansive P1) (Q1_ne : super_non_expansive Q1)
-         (A2 : rmaps.TypeTree)
-         (P2 : forall ts : list Type,
-               functors.MixVariantFunctor._functor
-                 (rmaps.dependent_type_functor_rec ts (ArgsTT A2)) mpred)
-         (Q2 : forall ts : list Type,
-               functors.MixVariantFunctor._functor
-                 (rmaps.dependent_type_functor_rec ts (AssertTT A2)) mpred)
-         (P2_ne : args_super_non_expansive P2) (Q2_ne : super_non_expansive Q2)
-         (phi psi : funspec) (Hphi : phi = mk_funspec f c A1 P1 Q1 P1_ne Q1_ne)
-         (Hpsi : psi = mk_funspec f c A2 P2 Q2 P2_ne Q2_ne):
+Lemma binary_intersection_sub2 (f : typesig) (c : calling_convention)
+         (A1 : TypeTree)
+         (E1 : dtfr (MaskTT A1))
+         (P1 : dtfr (ArgsTT A1))
+         (Q1 : dtfr (AssertTT A1))
+         (A2 : TypeTree)
+         (E2 : dtfr (MaskTT A2))
+         (P2 : dtfr (ArgsTT A2))
+         (Q2 : dtfr (AssertTT A2))
+         (phi psi : funspec) (Hphi : phi = mk_funspec f c A1 E1 P1 Q1)
+         (Hpsi : psi = mk_funspec f c A2 E2 P2 Q2):
        funspec_sub (binary_intersection' phi psi Hphi Hpsi) psi.
 Proof. apply binary_intersection'_sub. Qed.
 
@@ -149,13 +133,13 @@ Lemma mapsto_zeros_mapsto_nullval sh b z t:
    Z.divide (align_chunk Mptr) (Ptrofs.unsigned z) ->
    (mapsto_memory_block.mapsto_zeros 
             (size_chunk Mptr) sh (Vptr b z))
-   |-- (!! (and (Z.le Z0 (Ptrofs.unsigned z))
+   ⊢ ⌜and (Z.le Z0 (Ptrofs.unsigned z))
                   (Z.lt
                      (Z.add (size_chunk Mptr)
-                        (Ptrofs.unsigned z)) Ptrofs.modulus)))
-      && (mapsto sh 
+                        (Ptrofs.unsigned z)) Ptrofs.modulus)⌝
+      ∧ (mapsto sh
                (Tpointer t noattr) (Vptr b z) nullval).
-Proof. intros. constructor. apply mapsto_memory_block.mapsto_zeros_mapsto_nullval; trivial. Qed.
+Proof. intros. apply mapsto_memory_block.mapsto_zeros_mapsto_nullval; trivial. Qed.
 
 Definition genv_find_func (ge:Genv.t Clight.fundef type) i f :=
   exists b, Genv.find_symbol ge i = Some b /\
@@ -163,14 +147,14 @@ Definition genv_find_func (ge:Genv.t Clight.fundef type) i f :=
 
   Lemma progfunct_GFF {p i fd}: list_norepet (map fst (prog_defs p)) ->
         find_id i (prog_funct p) = Some fd -> genv_find_func (Genv.globalenv p) i fd.
-  Proof. intros. apply find_id_e in H0. 
+  Proof. intros. apply find_id_e in H0.
     apply semax_prog.find_funct_ptr_exists; trivial.
     apply (semax_prog.in_prog_funct_in_prog_defs _ _ _ H0). 
   Qed.
 
 Lemma funspec_sub_cc phi psi: funspec_sub phi psi ->
       callingconvention_of_funspec phi = callingconvention_of_funspec psi.
-Proof. destruct phi; destruct psi; simpl. intros [[_ ?] _]; trivial. Qed.
+Proof. destruct phi; destruct psi; simpl. intros [(_ & ?) _]; trivial. Qed.
 
 Definition semaxfunc_InternalInfo C V G (ge : Genv.t Clight.fundef type) id f phi := 
   (id_in_list id (map fst G) && semax_body_params_ok f)%bool = true /\
@@ -181,20 +165,20 @@ Definition semaxfunc_InternalInfo C V G (ge : Genv.t Clight.fundef type) id f ph
   genv_find_func ge id (Internal f).
 
 Definition semaxfunc_ExternalInfo Espec (ge : Genv.t Clight.fundef type) (id : ident)
-    (ef : external_function) (argsig : list type) (retsig : type) (cc : calling_convention) phi := 
-  match phi with mk_funspec (argsig', retsig') cc' A P Q NEP NEQ => 
+    (ef : external_function) (argsig : list type) (retsig : type) (cc : calling_convention) phi :=
+  match phi with mk_funspec (argsig', retsig') cc' A E P Q =>
   retsig = retsig' /\ cc=cc' /\
   argsig' = argsig /\
   ef_sig ef = mksignature (map argtype_of_type argsig) (rettype_of_type retsig) cc /\
-  (ef_inline ef = false \/ withtype_empty A) /\
-  (forall (gx : genviron) (ts : list Type) x (ret : option val),
-   Q ts x (make_ext_rval gx (rettype_of_type retsig) ret) && !! Builtins0.val_opt_has_rettype ret (rettype_of_type retsig) |-- !! tc_option_val retsig ret) /\
-  @semax_external Espec ef A P Q /\
+  (ef_inline ef = false \/ withtype_empty(Σ := Σ) A) /\
+  (forall (gx : genviron) x (ret : option val),
+   Q x (make_ext_rval gx (rettype_of_type retsig) ret) ∧ ⌜Builtins0.val_opt_has_rettype ret (rettype_of_type retsig)⌝ ⊢ ⌜tc_option_val retsig ret⌝) /\
+  (⊢semax_external(OK_spec := Espec) ef A E P Q) /\
   genv_find_func ge id (External ef argsig retsig cc)
   end.
 
 Lemma InternalInfo_subsumption {ge cs V V' F F' i f phi}
-  (HVF : forall i, (sub_option (make_tycontext_g V F) ! i) ((make_tycontext_g V' F') ! i))
+  (HVF : forall i, (sub_option ((make_tycontext_g V F) !! i)) ((make_tycontext_g V' F') !! i))
   (HF : forall i, subsumespec (find_id i F) (find_id i F'))
   (LNRF : list_norepet (map fst F))
   (H : semaxfunc_InternalInfo cs V F ge i f phi):
@@ -209,7 +193,7 @@ Proof.
     apply find_id_In_map_fst in PHI'; trivial.
   + eapply semax_body_subsumption. eassumption. clear - HF HVF.
     red; simpl. repeat split; trivial; intros i.
-    - destruct ((make_tycontext_t (fn_params f) (fn_temps f)) ! i); trivial.
+    - destruct ((make_tycontext_t (fn_params f) (fn_temps f)) !! i); trivial.
     - rewrite 2 make_tycontext_s_find_id; trivial.
 Qed.
 
@@ -248,23 +232,18 @@ Lemma ExternalInfo_envs_sub Espec ge ge'
   (FFunc: genv_find_func ge' i (External ef argsig retsig  cc)):
 semaxfunc_ExternalInfo Espec ge' i ef argsig retsig cc phi.
 Proof.
-  destruct phi. destruct t. simpl. 
+  destruct phi. destruct sig. simpl.
   destruct H as [Hb1 [Hb2 [Hb3 [Hb4 [Hb5 [Hb6 [Hb7 [Hb8 [Hb9 Hb10]]]]]]]]].
-  repeat split; trivial. apply Hb6.
+  done.
 Qed.
 
-(*
-Lemma TTL7: forall l l' (L:typelist_of_type_list l = typelist_of_type_list l'), l=l'.
-Proof. induction l; destruct l'; simpl; intros; trivial; inv L. f_equal. auto. Qed.
-*)
-
 Lemma InternalInfo_cc {cs V G ge i f phi} (SF: @semaxfunc_InternalInfo cs V G ge i f phi):
   fn_callconv f = callingconvention_of_funspec phi.
 Proof. destruct SF as [b [? [? [? [? [? ?]]]]]]; trivial. Qed.
 
 Lemma ExternalInfo_cc {Espec ge i ef tys rt cc phi} (SF: @semaxfunc_ExternalInfo Espec ge i ef tys rt cc phi):
   cc = callingconvention_of_funspec phi.
-Proof. destruct phi. destruct t. destruct SF as [? [? _]]; subst; trivial. Qed.
+Proof. destruct phi. destruct sig. destruct SF as [? [? _]]; subst; trivial. Qed.
 
 Lemma internalInfo_binary_intersection {cs V G ge i f phi1 phi2 phi}
       (F1_internal : semaxfunc_InternalInfo cs V G ge i f phi1)
@@ -282,11 +261,6 @@ Proof.
     apply (semax_body_binaryintersection _ (i,phi1) (i, phi2)); trivial.
 Qed.
 
-(*
-Lemma length_of_typelist2: forall l, length l = length (typlist_of_typelist l).
-Proof. induction l; simpl; trivial. rewrite IHl; trivial. Qed.
-*)
-
 Lemma externalInfo_binary_intersection {Espec ge i ef argsig retsig cc phi1 phi2 phi}
       (F1_external : semaxfunc_ExternalInfo Espec ge i ef argsig retsig cc phi1)
       (F2_external : semaxfunc_ExternalInfo Espec ge i ef argsig retsig cc phi2)
@@ -294,35 +268,34 @@ Lemma externalInfo_binary_intersection {Espec ge i ef argsig retsig cc phi1 phi2
   semaxfunc_ExternalInfo Espec ge i ef argsig retsig cc phi.
 Proof.
   destruct (callconv_of_binary_intersection BI) as [CC1 CC2].
-  destruct phi. destruct t as [params rt]. simpl in CC1, CC2. 
-  destruct phi1 as [[params1 rt1] c1 A1 P1 Q1 P1ne Q1ne]. simpl in CC1. subst c1.
+  destruct phi. destruct sig as [params rt]. simpl in CC1, CC2.
+  destruct phi1 as [[params1 rt1] c1 E1 A1 P1 Q1]. simpl in CC1. subst c1.
   destruct F1_external as [RT1 [C1 [PAR1 [Sig1 [EF1 [ENT1 [EXT1 GFF1]]]]]]].
-  destruct phi2 as [[params2 rt2] c2 A2 P2 Q2 P2ne Q2ne]. simpl in CC2. subst c2.
+  destruct phi2 as [[params2 rt2] c2 E2 A2 P2 Q2]. simpl in CC2. subst c2.
   destruct F2_external as [RT2 [C2 [PAR2 [Sig2 [EF2 [ENT2 [EXT2 GFF2]]]]]]].
   subst cc rt1 rt2. 
-  assert (FSM:= @binary_intersection_typesigs _ _ _ BI). simpl typesig_of_funspec in FSM.
+  assert (FSM:= binary_intersection_typesigs BI). simpl typesig_of_funspec in FSM.
   destruct FSM as [FSM1 FSM2].
   inversion FSM1; subst retsig params1; clear FSM1.
-  inversion FSM2; subst params2 params; clear FSM2 H1. 
+  inversion FSM2; subst params2 params; clear FSM2 H1.
 
   split3; trivial.
   split3; trivial.
-  split3. 
+  split3.
   + unfold binary_intersection in BI. rewrite 2 if_true in BI by trivial. inv BI.
-    apply inj_pair2 in H1; subst P. apply inj_pair2 in H2; subst Q. simpl.
     clear - EF1 EF2. destruct (ef_inline ef). 2: left; trivial.
-    destruct EF1; try congruence. 
+    destruct EF1; try congruence.
     destruct EF2; try congruence.
-    right. red; simpl; intros ? [x X]; destruct x. apply (H ts X). apply (H0 ts X).
-  + intros. unfold binary_intersection in BI. rewrite 2 if_true in BI by trivial. inv BI.
-    apply inj_pair2 in H1; subst P. apply inj_pair2 in H2; subst Q. simpl.
+    right. red; simpl; intros [x X]; destruct x. apply (H X). apply (H0 X).
+  + intros. unfold binary_intersection in BI. rewrite 2 if_true in BI by trivial.
+    apply Some_inj, mk_funspec_inj in BI as (_ & _ & ? & ? & <- & <-); subst; simpl in *.
     destruct x as [b BB]. destruct b; simpl.
-      * apply (ENT1 gx ts BB). 
-      * apply (ENT2 gx ts BB).
+      * apply (ENT1 gx BB).
+      * apply (ENT2 gx BB).
   + split; trivial.
     eapply semax_external_binaryintersection. apply EXT1. apply EXT2.
       apply BI.
-      rewrite Sig2; simpl. rewrite map_length. trivial. 
+      rewrite Sig2; simpl. rewrite map_length. trivial.
 Qed.
 
 Lemma find_funspec_sub: forall specs' specs 
@@ -345,7 +318,7 @@ Lemma subsumespec_app l1 l2 k1 k2 i
           (D:list_disjoint (map fst l2) (map fst k1)):
       subsumespec (find_id i (l1++l2)) (find_id i (k1++k2)).
 Proof.
-  red. rewrite ! find_id_app_char.
+  red. rewrite !find_id_app_char.
   remember (find_id i l1) as p1. destruct p1; simpl in *; symmetry in Heqp1.
 + destruct L1K1 as [phi [? ?]].
   rewrite H. exists phi; split; trivial.
@@ -359,7 +332,7 @@ Lemma subsumespec_app_right_left l k1 k2 i
           (LK: subsumespec (find_id i l) (find_id i k1)):
       subsumespec (find_id i l) (find_id i (k1++k2)).
 Proof.
-  red. rewrite ! find_id_app_char. destruct (find_id i l); trivial.
+  red. rewrite !find_id_app_char. destruct (find_id i l); trivial.
   destruct LK as [phi [? ?]]. rewrite H. exists phi; split; trivial.
 Qed.
  
@@ -368,7 +341,7 @@ Lemma subsumespec_app_right_right l k1 k2 i
           (Hi: find_id i k1= None):
       subsumespec (find_id i l) (find_id i (k1++k2)).
 Proof.
-  red. rewrite ! find_id_app_char, Hi. destruct (find_id i l); trivial.
+  red. rewrite !find_id_app_char, Hi. destruct (find_id i l); trivial.
 Qed.
 
 Lemma subsumespec_app_left l1 l2 k i
@@ -376,7 +349,7 @@ Lemma subsumespec_app_left l1 l2 k i
           (LK2: find_id i l1 = None -> subsumespec (find_id i l2) (find_id i k)):
       subsumespec (find_id i (l1++l2)) (find_id i k).
 Proof.
-  red. rewrite ! find_id_app_char. 
+  red. rewrite !find_id_app_char. 
   destruct (find_id i l1); trivial. simpl in *. specialize (LK2 (eq_refl _)).
   destruct (find_id i l2); trivial.
 Qed.
@@ -439,12 +412,12 @@ Definition Vardefs (p: QP.program Clight.function) :=
 Definition globs2pred (gv: globals) (x: ident * globdef (fundef function) type) : mpred :=
   match x with (i, d) => match d with
                            Gfun _ => emp
-                         | Gvar v => !!(headptr (gv i)) && globvar2pred gv (i,v)
+                         | Gvar v => ⌜headptr (gv i)⌝ ∧ globvar2pred gv (i,v)
                          end
   end.
 
 Definition InitGPred (V:list (ident * globdef (fundef function) type)) (gv: globals) :mpred := 
-   fold_right sepcon emp (map (globs2pred gv) V).
+   fold_right bi_sep emp (map (globs2pred gv) V).
 
 Definition globals_ok (gv: globals) := forall i, headptr (gv i) \/ gv i = Vundef.
 
@@ -455,7 +428,7 @@ Definition QPvarspecs (p: QP.program function) : varspecs :=
   as GFun(external ...) in Clight, but nevertheless should be in G (and hence 
   should be justified by a semaxfunc - in fact by a semax_func_extern. Since they are in G
   they may be in Exports, too. -*)
-Record Component {Espec:OracleKind} (V: varspecs)
+Record Component {Espec} (V: varspecs)
       (E Imports: funspecs) (p: QP.program Clight.function) (Exports: funspecs) (GP: globals -> mpred) (G: funspecs) := {
   Comp_prog_OK: QPprogram_OK p;
   Comp_Imports_external: forall i, In i (map fst Imports) -> 
@@ -480,7 +453,7 @@ Record Component {Espec:OracleKind} (V: varspecs)
   Comp_G_Exports: forall i phi (E: find_id i Exports = Some phi), 
                   exists phi', find_id i G = Some phi' /\ funspec_sub phi' phi;
 
-  Comp_MkInitPred: forall gv,   globals_ok gv -> InitGPred (Vardefs p) gv |-- GP gv
+  Comp_MkInitPred: forall gv,   globals_ok gv -> InitGPred (Vardefs p) gv ⊢ GP gv
 }.
 
 Definition Comp_prog {Espec V E Imports p Exports GP G} (c:@Component Espec V E Imports p Exports GP G):= p.
@@ -488,23 +461,25 @@ Definition Comp_G {Espec V E Imports p Exports GP G} (c:@Component Espec V E Imp
 
 Definition VSU {Espec} E Imports p Exports GP:=
   ex (@Component Espec (QPvarspecs p) E Imports p Exports GP).
-  
-
-Arguments Comp_Imports_external {Espec V E Imports p Exports GP G} / c.
-Arguments Comp_prog_OK {Espec V E Imports p Exports GP G} / c.
-Arguments Comp_cs {Espec V E Imports p Exports GP G} / c.
-Arguments Comp_LNR {Espec V E Imports p Exports GP G} / c.
-Arguments Comp_Externs_LNR {Espec V E Imports p Exports GP G} / c.
-Arguments Comp_Exports_LNR {Espec V E Imports p Exports GP G} / c.
-Arguments Comp_Externs {Espec V E Imports p Exports GP G} / c.
-Arguments Comp_G_dom {Espec V E Imports p Exports GP G} / c.
-Arguments Comp_G_justified {Espec V E Imports p Exports GP G} / c.
-Arguments Comp_G_Exports {Espec V E Imports p Exports GP G} / c.
-Arguments Comp_G_E {Espec V E Imports p Exports GP G} / c.
-Arguments Comp_MkInitPred {Espec V E Imports p Exports GP G} / c.
+
+
+Global Arguments Comp_Imports_external {Espec V E Imports p Exports GP G} / c.
+Global Arguments Comp_prog_OK {Espec V E Imports p Exports GP G} / c.
+Global Arguments Comp_cs {Espec V E Imports p Exports GP G} / c.
+Global Arguments Comp_LNR {Espec V E Imports p Exports GP G} / c.
+Global Arguments Comp_Externs_LNR {Espec V E Imports p Exports GP G} / c.
+Global Arguments Comp_Exports_LNR {Espec V E Imports p Exports GP G} / c.
+Global Arguments Comp_Externs {Espec V E Imports p Exports GP G} / c.
+Global Arguments Comp_G_dom {Espec V E Imports p Exports GP G} / c.
+Global Arguments Comp_G_justified {Espec V E Imports p Exports GP G} / c.
+Global Arguments Comp_G_Exports {Espec V E Imports p Exports GP G} / c.
+Global Arguments Comp_G_E {Espec V E Imports p Exports GP G} / c.
+Global Arguments Comp_MkInitPred {Espec V E Imports p Exports GP G} / c.
+
+Notation funspecs := (@funspecs Σ).
 
 Section Component.
-Variable Espec: OracleKind.
+Variable Espec: ext_spec OK_ty.
 Variable V: varspecs.
 Variable E Imports: funspecs.
 Variable p: QP.program Clight.function.
@@ -714,23 +689,23 @@ Lemma Comp_G_disjoint_from_Imports_find_id {i phi} (Hi: find_id i Imports = Some
       find_id i (Comp_G c) = None.
 Proof. apply (list_disjoint_map_fst_find_id1 Comp_G_disjoint_from_Imports _ _ Hi). Qed.
 
-Lemma Comp_entail {GP'} (H: forall gv, GP gv |-- GP' gv):
+Lemma Comp_entail {GP'} (H: forall gv, GP gv ⊢ GP' gv):
       @Component Espec V E Imports p Exports GP' G.
 Proof. intros. destruct c. econstructor; try assumption.
 apply Comp_G_justified0.
  intros; eapply derives_trans. apply Comp_MkInitPred0; auto. cancel.
 Qed.
 
-Lemma Comp_entail_starTT:
-      @Component Espec V E Imports p Exports (GP * TT)%logic G.
-Proof. intros. apply Comp_entail. intros; simpl; apply sepcon_TT. Qed.
+(*Lemma Comp_entail_starTT:
+      @Component Espec V E Imports p Exports (GP ∗ True) G.
+Proof. intros. apply Comp_entail. intros; simpl; apply sep_true. Qed.*)
 
 Lemma Comp_entail_TT:
-      @Component Espec V E Imports p Exports TT G.
+      @Component Espec V E Imports p Exports (fun _ => True) G.
 Proof. intros. eapply Comp_entail. intros; simpl. apply TT_right. Qed.
 
-Lemma Comp_entail_split {GP1 GP2} (H: forall gv, GP gv |-- (GP1 gv * GP2 gv)%logic):
-      @Component Espec V E Imports p Exports (fun gv => GP1 gv * TT)%logic G.
+Lemma Comp_entail_split {GP1 GP2} (H: forall gv, GP gv ⊢ (GP1 gv ∗ GP2 gv)):
+      @Component Espec V E Imports p Exports (fun gv => GP1 gv ∗ True) G.
 Proof. intros. eapply Comp_entail. intros; simpl.
   eapply derives_trans. apply H. cancel.
 Qed.
@@ -748,35 +723,32 @@ Proof.
       { clear - H HI1 HI2. symmetry in HI1. eapply find_funspec_sub; eassumption. }
       destruct H0 as [phi' [H' Sub]]. 
       rewrite find_id_app1 with (x:=phi'); trivial.
-      rewrite funspec_sub_iff in Sub.
       apply seplog.funspec_sub_sub_si in Sub.
       exists phi'; split; trivial.
-    + rewrite find_id_app2 with (x:=phi); trivial.
+    + rewrite (find_id_app2(A := funspec)) with (x:=phi); trivial.
       - exists phi; split; [ trivial | apply funspec_sub_si_refl; trivial ].
-      - specialize Comp_ctx_LNR. subst. rewrite ! map_app, HI1; trivial. }
-  assert (AUX2: forall V' i, sub_option ((make_tycontext_g V' (Imports ++ Comp_G c)) ! i)
-                                     ((make_tycontext_g V' (Imports' ++ Comp_G c)) ! i)).
+      - specialize Comp_ctx_LNR. subst. rewrite !map_app, HI1; trivial. }
+  assert (AUX2: forall V' i, sub_option ((make_tycontext_g V' (Imports ++ Comp_G c)) !! i)
+                                     ((make_tycontext_g V' (Imports' ++ Comp_G c)) !! i)).
   { intros. specialize (AUX1 i).
-    remember ((make_tycontext_g V' (Imports ++ Comp_G c)) ! i) as q; symmetry in Heqq; destruct q; simpl; trivial.
+    remember ((make_tycontext_g V' (Imports ++ Comp_G c)) !! i) as q; symmetry in Heqq; destruct q; simpl; trivial.
     remember (find_id i (Imports ++ Comp_G c)) as w; symmetry in Heqw; destruct w; simpl in *.
     + destruct AUX1 as [psi [X Y]]. 
       erewrite semax_prog.make_tycontext_s_g in Heqq. instantiate (1:=f) in Heqq.
       - rewrite <- Heqq; clear Heqq. 
-        erewrite semax_prog.make_tycontext_s_g. 
+        erewrite semax_prog.make_tycontext_s_g.
         2: rewrite make_tycontext_s_find_id; eassumption.
-        f_equal. specialize (Y (compcert_rmaps.RML.empty_rmap 0)). simpl in Y.
-        exploit Y; trivial. intros Q.
-        apply (seplog.type_of_funspec_sub_si _ _ _ Q).
+        f_equal. rewrite type_of_funspec_sub_si in Y. apply (ouPred.soundness _ O) in Y; auto.
       - rewrite make_tycontext_s_find_id. eassumption.
     + rewrite semax_prog.make_tycontext_g_G_None in Heqq by trivial.
       rewrite semax_prog.make_tycontext_g_G_None; trivial.
       apply find_id_None_iff. apply find_id_None_iff in Heqw. intros N; apply Heqw.
-      rewrite map_app in *. rewrite HI1 in N. trivial. } 
+      rewrite map_app in *. setoid_rewrite HI1 in N. trivial. }
   eapply Build_Component; subst; try solve [apply c].
-+ rewrite HI1; apply c. 
-+ rewrite map_app, HI1, <- map_app; apply c.
++ setoid_rewrite HI1; apply c.
++ rewrite map_app; setoid_rewrite HI1; rewrite <- map_app; apply c.
 + intros. specialize (Comp_G_justified c i _ _ H H0); intros. destruct fd.
-  -  eapply InternalInfo_subsumption. apply AUX2. apply AUX1. apply Comp_ctx_LNR. apply H1.
+  - eapply InternalInfo_subsumption. apply AUX2. apply AUX1. apply Comp_ctx_LNR. apply H1.
   - auto.
 + apply (Comp_MkInitPred c).
 Qed.
@@ -787,7 +759,7 @@ Lemma Comp_Exports_sub1 Exports' (HE1: map fst Exports' = map fst Exports)
       @Component Espec V E Imports p Exports' GP G.
 Proof.
   eapply Build_Component; try apply c.
-+ rewrite HE1; apply c. 
++ setoid_rewrite HE1; apply c.
 + intros i phi Hi. rename phi into phi'.
   assert (X: exists phi, find_id i Exports = Some phi /\ funspec_sub phi phi').
   { clear - HE1 HE2 Hi. eapply find_funspec_sub; eassumption. }
@@ -883,40 +855,40 @@ Qed.
 
 End Component.
 
-Arguments Comp_LNR {Espec V E Imports p Exports GP G} c.
-Arguments Comp_G_LNR {Espec V E Imports p Exports GP G} c.
-Arguments Comp_ctx_LNR {Espec V E Imports p Exports GP G} c.
-Arguments Comp_G_disjoint_from_Imports {Espec V E Imports p Exports GP G} c.
-Arguments Comp_G_disjoint_from_Imports_find_id {Espec V E Imports p Exports GP G} c.
-Arguments Comp_Interns_disjoint_from_Imports {Espec V E Imports p Exports GP G} c.
-Arguments Comp_Exports_in_progdefs {Espec V E Imports p Exports GP G} c.
-
-Arguments Comp_ExternsImports_LNR {Espec V E Imports p Exports GP G} c.
-Arguments Comp_Externs_LNR {Espec V E Imports p Exports GP G} c.
-Arguments Comp_Imports_in_Fundefs {Espec V E Imports p Exports GP G} c.
-Arguments Comp_Exports_in_Fundefs {Espec V E Imports p Exports GP G} c.
-Arguments Comp_Imports_in_progdefs {Espec V E Imports p Exports GP G} c.
-Arguments Comp_Exports_in_progdefs {Espec V E Imports p Exports GP G} c.
-
-Arguments Comp_G_intern {Espec V E Imports p Exports GP G} c.
-Arguments Comp_G_extern {Espec V E Imports p Exports GP G} c.
-
-Arguments Comp_Imports_LNR {Espec V E Imports p Exports GP G} c.
-Arguments LNR_Internals_Externs {Espec V E Imports p Exports GP G} c.
-Arguments Comp_G_in_Fundefs {Espec V E Imports p Exports GP G} c.
-Arguments Comp_G_in_Fundefs' {Espec V E Imports p Exports GP G} c.
-Arguments Comp_E_in_G {Espec V E Imports p Exports GP G} c.
-Arguments Comp_E_in_G_find {Espec V E Imports p Exports GP G} c.
-Arguments Comp_G_elim {Espec V E Imports p Exports GP G} c.
-Arguments Comp_G_in_progdefs {Espec V E Imports p Exports GP G} c.
-Arguments Comp_G_in_progdefs' {Espec V E Imports p Exports GP G} c.
-Arguments Comp_Imports_sub {Espec V E Imports p Exports GP G} c.
-Arguments Comp_Exports_sub {Espec V E Imports p Exports GP G} c.
-Arguments Comp_entail {Espec V E Imports p Exports GP G} c.
+Global Arguments Comp_LNR {Espec V E Imports p Exports GP G} c.
+Global Arguments Comp_G_LNR {Espec V E Imports p Exports GP G} c.
+Global Arguments Comp_ctx_LNR {Espec V E Imports p Exports GP G} c.
+Global Arguments Comp_G_disjoint_from_Imports {Espec V E Imports p Exports GP G} c.
+Global Arguments Comp_G_disjoint_from_Imports_find_id {Espec V E Imports p Exports GP G} c.
+Global Arguments Comp_Interns_disjoint_from_Imports {Espec V E Imports p Exports GP G} c.
+Global Arguments Comp_Exports_in_progdefs {Espec V E Imports p Exports GP G} c.
+
+Global Arguments Comp_ExternsImports_LNR {Espec V E Imports p Exports GP G} c.
+Global Arguments Comp_Externs_LNR {Espec V E Imports p Exports GP G} c.
+Global Arguments Comp_Imports_in_Fundefs {Espec V E Imports p Exports GP G} c.
+Global Arguments Comp_Exports_in_Fundefs {Espec V E Imports p Exports GP G} c.
+Global Arguments Comp_Imports_in_progdefs {Espec V E Imports p Exports GP G} c.
+Global Arguments Comp_Exports_in_progdefs {Espec V E Imports p Exports GP G} c.
+
+Global Arguments Comp_G_intern {Espec V E Imports p Exports GP G} c.
+Global Arguments Comp_G_extern {Espec V E Imports p Exports GP G} c.
+
+Global Arguments Comp_Imports_LNR {Espec V E Imports p Exports GP G} c.
+Global Arguments LNR_Internals_Externs {Espec V E Imports p Exports GP G} c.
+Global Arguments Comp_G_in_Fundefs {Espec V E Imports p Exports GP G} c.
+Global Arguments Comp_G_in_Fundefs' {Espec V E Imports p Exports GP G} c.
+Global Arguments Comp_E_in_G {Espec V E Imports p Exports GP G} c.
+Global Arguments Comp_E_in_G_find {Espec V E Imports p Exports GP G} c.
+Global Arguments Comp_G_elim {Espec V E Imports p Exports GP G} c.
+Global Arguments Comp_G_in_progdefs {Espec V E Imports p Exports GP G} c.
+Global Arguments Comp_G_in_progdefs' {Espec V E Imports p Exports GP G} c.
+Global Arguments Comp_Imports_sub {Espec V E Imports p Exports GP G} c.
+Global Arguments Comp_Exports_sub {Espec V E Imports p Exports GP G} c.
+Global Arguments Comp_entail {Espec V E Imports p Exports GP G} c.
 
 
 Section VSU_rules.
-Variable Espec: OracleKind.
+Variable Espec: ext_spec OK_ty.
 Variable E Imports: funspecs.
 Variable p : QP.program Clight.function.
 Variable Exports: funspecs.
@@ -938,7 +910,7 @@ Lemma VSU_Exports_sub Exports' (LNR: list_norepet (map fst Exports'))
       @VSU Espec E Imports p Exports' GP.
 Proof. destruct vsu as [G c]. exists G. eapply Comp_Exports_sub; eassumption. Qed.
 
-Lemma VSU_entail {GP'} : (forall gv, GP gv |-- GP' gv) -> 
+Lemma VSU_entail {GP'} : (forall gv, GP gv ⊢ GP' gv) -> 
       @VSU Espec E Imports p Exports GP'.
 Proof. intros. destruct vsu as [G C].
   exists G. apply (Comp_entail C _ H).
@@ -953,15 +925,15 @@ Definition VSU_prog {Espec E Imports p Exports GP} (v: @VSU Espec E Imports p Ex
 Definition VSU_Espec {Espec E Imports p Exports GP} (v: @VSU Espec E Imports p Exports GP) := Espec.
 Definition VSU_GP {Espec E Imports p Exports GP} (v: @VSU Espec E Imports p Exports GP) := GP.
 
-Arguments VSU_Externs {Espec E Imports p Exports GP} / _ .
-Arguments VSU_Exports {Espec E Imports p Exports GP} / _ .
-Arguments VSU_Imports {Espec E Imports p Exports GP} / _ .
-Arguments VSU_prog {Espec E Imports p Exports GP} / _ .
-Arguments VSU_Espec {Espec E Imports p Exports GP} / _ .
-Arguments VSU_GP {Espec E Imports p Exports GP} / _ .
+Global Arguments VSU_Externs {Espec E Imports p Exports GP} / _ .
+Global Arguments VSU_Exports {Espec E Imports p Exports GP} / _ .
+Global Arguments VSU_Imports {Espec E Imports p Exports GP} / _ .
+Global Arguments VSU_prog {Espec E Imports p Exports GP} / _ .
+Global Arguments VSU_Espec {Espec E Imports p Exports GP} / _ .
+Global Arguments VSU_GP {Espec E Imports p Exports GP} / _ .
 
 Definition merge_specs (phi1:funspec) (sp2: option funspec): funspec :=
-  match sp2 with 
+  match sp2 with
     Some phi2 => match binary_intersection phi1 phi2 with
                                   Some phi => phi
                                 | None => phi1
@@ -974,8 +946,8 @@ Lemma merge_specs_succeed {phi1 phi2}:
       callingconvention_of_funspec phi1 = callingconvention_of_funspec phi2 ->
   binary_intersection phi1 phi2 = Some (merge_specs phi1 (Some phi2)).
 Proof. intros.
-  simpl. destruct phi1; destruct phi2; simpl in *. rewrite H.  subst c0.
-  rewrite ! if_true; trivial.
+  simpl. destruct phi1; destruct phi2; simpl in *. subst.
+  rewrite !if_true; trivial.
 Qed.
 
 Definition G_merge_aux {f} (l1 l2 : list (ident * funspec)) : list (ident * funspec):=
@@ -1013,7 +985,7 @@ Lemma G_merge_aux_consR {f}: forall {l1 l2 i} (Hi:find_id i l1 = None) phi2,
 Proof. clear.
   induction l1; simpl; intros; trivial; destruct a; simpl in *. 
   destruct (Memory.EqDec_ident i0 i); subst; simpl in *. rewrite if_true in Hi; [ discriminate | trivial].
-  rewrite if_false in Hi. rewrite IHl1; trivial. intros ?; subst; contradiction.
+  rewrite if_false in Hi |- * by done. rewrite IHl1; trivial.
 Qed.
 
 Lemma G_merge_aux_length {f}: forall {l1 l2}, length (@G_merge_aux f l1 l2) = length l1.
@@ -1043,7 +1015,7 @@ Qed.
 Lemma G_merge_find_id_SomeNone {l1 l2 i phi1}:
       forall (Hi1: find_id i l1 = Some phi1) (Hi2: find_id i l2 = None),
       find_id i (G_merge l1 l2) = Some phi1.
-Proof. clear. intros. 
+Proof. clear. intros.
   unfold G_merge. rewrite find_id_app_char, (G_merge_aux_find_id1 Hi1), Hi2. reflexivity.
 Qed.
 
@@ -1161,11 +1133,11 @@ Proof.
   inv LNR. eexists; split. eassumption. unfold G_merge; simpl. rewrite H, Hi, filter_filter. f_equal.
   induction l1; simpl.
   + f_equal. extensionality x; destruct x as [j psi]; simpl.
-    destruct (ident_eq j i); subst; simpl.
-    - rewrite if_true; trivial. destruct (ident_eq i i); [ | elim n]; trivial.
-    - rewrite if_false by trivial. destruct (ident_eq i j); [ congruence | trivial].
+    destruct (eq_dec j i); subst; simpl.
+    - destruct (ident_eq i i); [ | elim n]; trivial.
+    - destruct (ident_eq i j); [ congruence | trivial].
   + destruct a as [j psi1]. simpl in *.  inv H3.
-    destruct (ident_eq j i); subst. { elim H2. left; trivial. }
+    destruct (eq_dec j i); subst. { elim H2. left; trivial. }
     remember (find_id i l1) as t; symmetry in Heqt; destruct t.
     { apply find_id_In_map_fst in Heqt. elim H2. right; trivial. } clear H2 H CC. 
     destruct (find_id_None_iff i l1) as [A1 A2]. specialize (IHl1 (A1 Heqt) H5).
@@ -1176,17 +1148,18 @@ Proof.
       destruct (ident_eq i j); [ congruence | reflexivity]. }
     rewrite <- X1; clear X1; f_equal.
     destruct (find_id_in_split Hi LNR2) as [la1 [l2b [Hl2 [Hi2a Hi2b]]]]; subst l2; clear Hi. 
-    rewrite ! filter_app; simpl in *. rewrite ! filter_app in X2; simpl in X2.
-    rewrite ! if_true, Heqt in * by trivial. unfold Memory.EqDec_ident.
-    destruct (ident_eq i j); [ congruence | simpl]; clear n0.
+    rewrite !filter_app; simpl in *. rewrite !filter_app in X2; simpl in X2.
+    rewrite !if_true, Heqt in * by trivial.
+    destruct (eq_dec i j); [ congruence | simpl]; clear n0.
     destruct (ident_eq i i); [ simpl in *; clear e | congruence].
     f_equal.
     * f_equal. extensionality x. destruct x as [ii phi]; simpl.
-      destruct (ident_eq ii i); subst.
+      destruct (eq_dec ii i); subst.
       - clear X2. rewrite Heqt, if_false; [ simpl | congruence]. destruct (ident_eq i i); [ reflexivity | congruence].
-      - destruct (ident_eq ii j); simpl; trivial. destruct (ident_eq i ii); [ congruence | simpl ]. rewrite andb_true_r; trivial.
+      - destruct (eq_dec ii j); simpl; trivial. destruct (ident_eq i ii); [ congruence | simpl ]. rewrite andb_true_r; trivial.
     * f_equal. extensionality x. destruct x as [ii phi]; simpl.
       rewrite negb_ident_eq_symm.
+      change (eq_dec ii i) with (ident_eq ii i).
       destruct (ident_eq ii i); subst.
       - rewrite Heqt, if_false; [ trivial | congruence].
       - simpl. rewrite andb_true_r; trivial.
@@ -1200,9 +1173,9 @@ Lemma subsumespec_G_merge_l l1 l2 i
 Proof.
   red. remember (find_id i l1) as q1; symmetry in Heqq1. remember (find_id i l2) as q2; symmetry in Heqq2.
   destruct q1 as [phi1 |]; destruct q2 as [phi2 |]; trivial.
-+ destruct (G_merge_find_id_SomeSome Heqq1 Heqq2) as [phi [BI Phi]]. apply SigsCC; trivial. apply SigsCC; trivial.
++ destruct (G_merge_find_id_SomeSome Heqq1 Heqq2) as [phi [BI Phi]]; [apply SigsCC; trivial..|].
   rewrite Phi.
-  eexists; split. trivial. apply funspec_sub_sub_si. apply binaryintersection_sub in BI. rewrite funspec_sub_iff. apply BI.
+  eexists; split. trivial. apply funspec_sub_sub_si. apply binaryintersection_sub in BI. apply BI.
 + rewrite (G_merge_find_id_SomeNone Heqq1 Heqq2).
   eexists; split. reflexivity. apply funspec_sub_si_refl.
 Qed.
@@ -1216,8 +1189,8 @@ Lemma subsumespec_G_merge_r l1 l2 i
 Proof.
   red. remember (find_id i l1) as q1; symmetry in Heqq1. remember (find_id i l2) as q2; symmetry in Heqq2.
   destruct q1 as [phi1 |]; destruct q2 as [phi2 |]; trivial.
-+ destruct (G_merge_find_id_SomeSome Heqq1 Heqq2) as [phi [BI Phi]]. apply SigsCC; trivial. apply SigsCC; trivial.
-  rewrite Phi. eexists; split. trivial. apply funspec_sub_sub_si. apply binaryintersection_sub in BI. rewrite funspec_sub_iff. apply BI.
++ destruct (G_merge_find_id_SomeSome Heqq1 Heqq2) as [phi [BI Phi]]; [apply SigsCC; trivial..|].
+  rewrite Phi. eexists; split. trivial. apply funspec_sub_sub_si. apply binaryintersection_sub in BI. apply BI.
 + rewrite (G_merge_find_id_NoneSome Heqq1 Heqq2) by trivial. eexists; split. reflexivity. apply funspec_sub_si_refl.
 Qed.  
 
@@ -1270,30 +1243,30 @@ Qed.
 Lemma G_merge_sqsub1 l1 l2
   (H: forall i phi1 phi2, find_id i l1 = Some phi1 -> find_id i l2 = Some phi2 ->
       typesig_of_funspec phi1 = typesig_of_funspec phi2 /\
-      callingconvention_of_funspec phi1 = callingconvention_of_funspec phi2): 
+      callingconvention_of_funspec phi1 = callingconvention_of_funspec phi2):
 funspecs_sqsub (G_merge l1 l2) l1.
 Proof.
   intros ? phi1 ?.
   remember (find_id i l2) as w; destruct w as [phi2 |]; symmetry in Heqw.
-+ destruct (H _ _ _ H0 Heqw); clear H.
++ destruct (H _ _ _ H0 Heqw) as (? & ?); clear H.
   destruct (G_merge_find_id_SomeSome H0 Heqw) as [phi [PHI Sub]]; trivial.
   apply binaryintersection_sub in PHI.
-  exists phi; split; trivial. rewrite funspec_sub_iff. apply PHI.
+  exists phi; split; trivial. apply PHI.
 + exists phi1; split. apply G_merge_find_id_SomeNone; trivial. apply funspec_sub_refl.
 Qed.
 
 Lemma G_merge_sqsub2 l1 l2 (LNR: list_norepet (map fst l2))
   (H: forall i phi1 phi2, find_id i l1 = Some phi1 -> find_id i l2 = Some phi2 ->
       typesig_of_funspec phi1 = typesig_of_funspec phi2 /\
-      callingconvention_of_funspec phi1 = callingconvention_of_funspec phi2): 
+      callingconvention_of_funspec phi1 = callingconvention_of_funspec phi2):
 funspecs_sqsub (G_merge l1 l2) l2.
 Proof.
   intros ? phi2 ?.
   remember (find_id i l1) as w; destruct w as [phi1 |]; symmetry in Heqw.
-+ destruct (H _ _ _ Heqw H0); clear H.
++ destruct (H _ _ _ Heqw H0) as (? & ?); clear H.
   destruct (G_merge_find_id_SomeSome Heqw H0) as [phi [PHI Sub]]; trivial.
   apply binaryintersection_sub in PHI.
-  exists phi; split; trivial. rewrite funspec_sub_iff. apply PHI.
+  exists phi; split; trivial. apply PHI.
 + exists phi2; split. apply G_merge_find_id_NoneSome; trivial. apply funspec_sub_refl.
 Qed.
 
@@ -1311,8 +1284,8 @@ Proof.
   remember (find_id i l2) as w2; symmetry in Heqw2; destruct w2 as [phi2 |].
   - destruct (H2 _ (eq_refl _)) as [psi2 [F2 Sub2]]; clear H2.
     rewrite F2 in F1. inv F1. exists psi1. split; trivial.
-    destruct (H phi1 phi2); trivial; clear H.
-    specialize (merge_specs_succeed H1 H2); intros BI. rewrite funspec_sub_iff in *.
+    destruct (H phi1 phi2) as (? & ?); trivial; clear H.
+    specialize (merge_specs_succeed H1 H2); intros BI.
     apply (BINARY_intersection_sub3 _ _ _ BI); trivial.
   - subst; simpl. exists psi1; split; trivial.
 + auto.
@@ -1333,10 +1306,9 @@ destruct fd.
   - destruct H as [omega [HH Sub]].
     erewrite 2 semax_prog.make_tycontext_s_g; try
       (rewrite semax_prog.find_id_maketycontext_s; eassumption).
-    simpl. 
-    specialize (Sub (compcert_rmaps.RML.empty_rmap 0)).
-    apply type_of_funspec_sub_si in Sub.
-    simpl in Sub; rewrite Sub; reflexivity. reflexivity.
+    simpl.
+    rewrite type_of_funspec_sub_si in Sub.
+    apply (ouPred.soundness _ O) in Sub as ->; reflexivity.
   - simpl in *. rewrite semax_prog.make_tycontext_g_G_None; trivial.
     remember (find_id j V) as p; destruct p; symmetry in Heqp; simpl; trivial.
     specialize (D t).
@@ -1352,7 +1324,7 @@ Qed.
 Lemma HContexts {Espec V1
       E1 Imports1 Exports1 V2 E2 Imports2 Exports2 p1 p2 p GP1 GP2 G1 G2}
       (c1: @Component Espec V1 E1 Imports1 p1 Exports1 GP1 G1)
-      (c2: @Component Espec V2 E2 Imports2 p2 Exports2 GP2  G2)
+      (c2: @Component Espec V2 E2 Imports2 p2 Exports2 GP2 G2)
       (Linked : QPlink_progs p1 p2 = Errors.OK p)
       (FM: Fundefs_match p1 p2 Imports1 Imports2):
       forall i phi1 phi2,
@@ -1377,8 +1349,8 @@ Proof. intros. specialize (FM i).
  destruct H2 as [fd [? _]].
   destruct fd1; destruct fd2.
 + (*II*) inv FM. 
-  destruct phi1 as [[? ?] ? ? ? ? ? ?].
-  destruct phi2 as [[? ?] ? ? ? ? ? ?].
+  destruct phi1 as [[? ?] ? ? ? ? ?].
+  destruct phi2 as [[? ?] ? ? ? ? ?].
   destruct SF1 as [? [? [? [? [[? [? _]] _]]]]].
   destruct SF2 as [? [? [? [? [[? [? _]] _]]]]].
   simpl in *.
@@ -1391,13 +1363,12 @@ Proof. intros. specialize (FM i).
 + destruct FM as [psi1 Psi1].
   apply (Comp_G_disjoint_from_Imports_find_id c1) in Psi1; unfold Comp_G in Psi1; congruence.
 + inv FM.
-  destruct phi1 as [[? ?] ? ? ? ? ? ?].
-  destruct phi2 as [[? ?] ? ? ? ? ? ?].
+  destruct phi1 as [[? ?] ? ? ? ? ?].
+  destruct phi2 as [[? ?] ? ? ? ? ?].
   destruct SF1 as [? [? [? _]]].
   destruct SF2 as [? [? [? _]]]. subst.
   unfold merge_globdef in H2.
-  destruct (fundef_eq 
-         (External e l0 t2 c3) (External e0 l1 t3 c4)) eqn:?H; inv H2.
+  destruct (fundef_eq _ _) eqn:?H; inv H2.
   apply fundef_eq_prop in H3. inv H3. auto.
 Qed.
 
@@ -1405,7 +1376,7 @@ Lemma find_id_elements:
   forall {A} i (m: PTree.t A), find_id i (PTree.elements m) = PTree.get i m.
 Proof.
  intros.
- destruct (m ! i) eqn:?H.
+ destruct (m !! i) eqn:?H.
  pose proof (PTree.elements_correct _ _ H).
  apply find_id_i; auto.
   apply PTree.elements_keys_norepet.
@@ -1418,8 +1389,8 @@ Qed.
 Lemma disjoint_varspecs_e:
   forall p1 p2 i v1 v2,
   list_disjoint (map fst (Vardefs p1)) (map fst (Vardefs p2)) ->
-  (QP.prog_defs p1) ! i = Some (Gvar v1) ->
-  (QP.prog_defs p2) ! i = Some (Gvar v2) ->
+  (QP.prog_defs p1) !! i = Some (Gvar v1) ->
+  (QP.prog_defs p2) !! i = Some (Gvar v2) ->
   False.
 Proof.
 intros.
@@ -1435,7 +1406,7 @@ clear - H1. induction e2; simpl in *; auto. destruct H1; subst; simpl; auto.
 destruct (isGvar a).  right; auto.  auto. 
 Qed.
 
-Definition is_var_in {F} i p :=
+Definition is_var_in {F} i p : Prop :=
      match PTree.get i (@QP.prog_defs F p) with
      | None => True
      | Some (Gvar _) => True
@@ -1468,7 +1439,7 @@ destruct H2; auto.
 Qed.
 
 Lemma find_id_QPvarspecs: forall p i t, find_id i (QPvarspecs p) = Some t <->
-   (exists g, (QP.prog_defs p) ! i = Some (Gvar g) /\ gvar_info g = t).
+   (exists g, (QP.prog_defs p) !! i = Some (Gvar g) /\ gvar_info g = t).
 Proof.
 intros.
 unfold QPvarspecs, QPprog_vars.
@@ -1492,10 +1463,10 @@ rewrite <- find_id_elements; auto.
 rewrite find_id_elements; auto.
 Qed.
 
-Lemma subsumespec_i: forall x y : option funspec, 
+Lemma subsumespec_i: forall x y : option funspec,
   match x with
   | Some hspec =>
-       exists gspec, y = Some gspec /\ TT |-- funspec_sub_si gspec hspec
+       exists gspec, y = Some gspec /\ (True ⊢ funspec_sub_si gspec hspec)
  | None => True
 end ->
   subsumespec x y.
@@ -1504,7 +1475,7 @@ intros.
 red.
 change seplog.funspec_sub_si with funspec_sub_si.
 destruct x; auto. destruct H as [gspec [? ?]].
-exists gspec. split; auto. apply H0.
+exists gspec. split; auto. rewrite <- H0; auto.
 Qed.
 
 Definition varspecsJoin (V1 V2 V: varspecs) :=
@@ -1516,7 +1487,7 @@ forall i, match find_id i V1, find_id i V2, find_id i V with
  end.
 
 Section ComponentJoin.
-Variable Espec: OracleKind.
+Variable Espec: ext_spec OK_ty.
 Variable V1 V2: varspecs.
 Variable E1 Imports1 Exports1 G1 E2 Imports2 Exports2 G2: funspecs.
 Variable p1 p2: QP.program Clight.function.
@@ -1597,7 +1568,7 @@ Variable SC2: forall i phiI,
 
 Variable HImports: forall i phi1 phi2, find_id i Imports1 = Some phi1 -> find_id i Imports2 = Some phi2 -> phi1=phi2.
 
-Definition JoinedImports := 
+Definition JoinedImports :=
           filter (fun x => negb (in_dec ident_eq (fst x) (map fst E2 ++ IntIDs p2))) Imports1 ++
           filter (fun x => negb (in_dec ident_eq (fst x) (map fst E1 ++ IntIDs p1 ++ map fst Imports1))) Imports2.
 
@@ -1629,7 +1600,7 @@ Proof. unfold Exports. subst. clear - c1 c2. rewrite G_merge_dom, map_app, list_
       apply find_id_i in X1. rewrite X1 in Y2. congruence. apply c1.
 Qed.
 
-Definition is_funct_in {F} i p :=
+Definition is_funct_in {F} i p : Prop :=
      match PTree.get i (@QP.prog_defs F p) with
      | None => False
      | Some (Gvar _) => False
@@ -1660,10 +1631,10 @@ callingconvention_of_funspec psi1 = callingconvention_of_funspec psi2.
 Proof. 
   clear - Linked Hpsi1 Hpsi2.
   unfold QPlink_progs in Linked.
-  destruct (  merge_builtins (QP.prog_builtins p1)
+  destruct (merge_builtins (QP.prog_builtins p1)
               (QP.prog_builtins p2)) eqn:?H; try discriminate;
   unfold Errors.bind at 1 in Linked.
-  destruct (merge_PTrees _ _ _) eqn:?H; try discriminate; 
+  destruct (merge_PTrees _ _ _) eqn:?H; try discriminate;
   unfold Errors.bind at 1 in Linked.
   clear - H0 Hpsi1 Hpsi2.
   apply (merge_PTrees_e i) in H0.
@@ -1733,29 +1704,44 @@ Lemma InitGPred_nilD gv: InitGPred nil gv = emp.
 Proof. clear. reflexivity. Qed.
 
 Lemma InitGPred_consD X a gv:
-      InitGPred (a :: X) gv = (globs2pred gv a * InitGPred X gv)%logic.
+      InitGPred (a :: X) gv = (globs2pred gv a ∗ InitGPred X gv).
 Proof. clear. reflexivity. Qed.
 
 Lemma InitGPred_middleD Y a gv: forall X,
-      InitGPred (Y ++ a :: X) gv = (globs2pred gv a * InitGPred Y gv * InitGPred X gv)%logic.
+      InitGPred (Y ++ a :: X) gv = ((globs2pred gv a ∗ InitGPred Y gv) ∗ InitGPred X gv).
 Proof. clear.
   induction Y; simpl; intros.
-+ rewrite InitGPred_consD, InitGPred_nilD, sepcon_emp; reflexivity.
-+ rewrite InitGPred_consD, IHY, InitGPred_consD. apply pred_ext; cancel.
++ rewrite InitGPred_consD, InitGPred_nilD, sep_emp; reflexivity.
++ rewrite InitGPred_consD, IHY, InitGPred_consD. rewrite !sep_assoc, (sep_comm (globs2pred _ _)); reflexivity.
 Qed.
 
 Lemma InitGPred_app gv: forall X Y, 
-      InitGPred (X ++ Y) gv = (InitGPred X gv * InitGPred Y gv)%logic.
+      InitGPred (X ++ Y) gv = (InitGPred X gv ∗ InitGPred Y gv).
 Proof. clear.
-  induction X; simpl; intros. rewrite InitGPred_nilD, emp_sepcon; trivial.
-  rewrite ! InitGPred_consD, IHX, sepcon_assoc; trivial.
+  induction X; simpl; intros. rewrite InitGPred_nilD, emp_sep; trivial.
+  rewrite !InitGPred_consD, IHX, sep_assoc; trivial.
+Qed.
+
+(* up? *)
+Lemma exist_eq {A} x Q (P : A -> mpred) (HQ : forall a, Q a -> a = x) : (∃ a, ⌜Q a⌝ ∧ P a) = (⌜Q x⌝ ∧ P x).
+Proof.
+  destruct (P x) eqn: HP; ouPred.unseal; apply IProp_eq; extensionality n m; apply prop_ext.
+  split.
+  - intros (? & HQ' & HP').
+    specialize (HQ _ HQ'); subst.
+    rewrite HP in HP'; auto.
+  - intros (? & ?); exists x.
+    split; auto.
+    rewrite HP; auto.
 Qed.
 
 Lemma globs2predD_true a gv: true = isGvar a ->
-      globs2pred gv a = EX i v, !! (a=(i,Gvar v) /\ headptr (gv i)) && globvar2pred gv (i, v).
+      globs2pred gv a = ∃ i v, ⌜a=(i,Gvar v) /\ headptr (gv i)⌝ ∧ globvar2pred gv (i, v).
 Proof. clear. unfold globs2pred. destruct a. unfold isGvar; simpl. destruct g; intros. discriminate.
- apply pred_ext. Intros. Exists i v. entailer!.
- Intros ii vv. inv H0. entailer!.
+ erewrite log_normalize.exp_uncurry, exist_eq.
+ 2: intros (?, ?); simpl; intros ([=] & _); subst; reflexivity.
+ simpl.
+ rewrite pure_and, (prop_true_andp (_ = _)); auto.
 Qed.
 
 Lemma globs2predD_false a gv: false = isGvar a ->
@@ -1763,7 +1749,7 @@ Lemma globs2predD_false a gv: false = isGvar a ->
 Proof. clear. unfold globs2pred. destruct a. unfold isGvar; simpl. destruct g; trivial. discriminate.
 Qed.
 
-Lemma list_disjoint_app_inv {A} (l1 l2 l: list A): 
+Lemma list_disjoint_app_inv {A} (l1 l2 l: list A):
       list_disjoint (l1++l2) l -> list_disjoint l1 l /\ list_disjoint l2 l.
 Proof. clear; intros.
   split; intros x y X Y.
@@ -1826,7 +1812,7 @@ induction l; simpl; intros. trivial.
 rewrite H. 2: left; trivial. rewrite IHl; trivial. intros. apply H. right; trivial.
 Qed.
 
-Definition Functions_preserved (p1 p2 p: QP.program Clight.function) i:=
+Definition Functions_preserved (p1 p2 p: QP.program Clight.function) i : Prop :=
          match PTree.get i (QP.prog_defs p1), PTree.get i (QP.prog_defs p2) with
          | Some (Gfun (Internal f1)), Some (Gfun (Internal f2)) => 
                        PTree.get i (QP.prog_defs p) = Some (Gfun (Internal f1)) /\
@@ -1874,8 +1860,9 @@ intros.
                (QP.prog_main p2)); inv Linked.
   apply (merge_PTrees_e i) in H0.
  hnf; intros. simpl QP.prog_defs.
-  destruct ((QP.prog_defs p1) ! i) eqn:J1, ((QP.prog_defs p2) ! i) eqn:J2.
-- destruct H0 as [h [H8 H0]]; rewrite ?H0.
+  destruct ((QP.prog_defs p1) !! i) eqn:J1, ((QP.prog_defs p2) !! i) eqn:J2.
+-
+  destruct H0 as [h [H8 H0]]; rewrite ?H0.
   destruct g0,g; unfold merge_globdef in H8.
   + destruct f,f0; inv H8;
     match type of H2 with  (if ?A then _ else _) = _ => destruct A eqn:?H; inv H2 end; auto.
@@ -1903,15 +1890,13 @@ intros.
     * destruct gvar_init; inv H1.
       right; split; auto.
       destruct (linking.isnil gvar_init0) eqn:?H; inv H4; auto.
-      -- destruct gvar_init0; inv H3. trivial. trivial.
-      -- destruct gvar_init0; inv H3. trivial. trivial. 
+      -- destruct gvar_init0; inv H3. trivial.
+      -- destruct gvar_init0; inv H3. trivial.
     * destruct (linking.isnil gvar_init0) eqn:?H; inv H4; auto.
       -- destruct gvar_init0; inv H5.
          ++ left; split; trivial.
-         ++ inv H2.
       -- destruct gvar_init0; inv H5.
-         ++ left; split; trivial. 
-         ++ destruct gvar_init; inv H4. right; split; trivial. 
+         ++ destruct gvar_init; inv H4.
 - destruct g; auto. destruct f; auto.
 - destruct g; auto. destruct f; auto.
 - rewrite H0; auto.
@@ -1959,7 +1944,7 @@ Lemma InitGPred_join {gv}:
   forall  (p1 p2 p : QP.program function)
   (H : globals_ok gv)
   (Linked : QPlink_progs p1 p2 = Errors.OK p),
-  InitGPred (Vardefs p) gv |-- InitGPred (Vardefs p1) gv * InitGPred (Vardefs p2) gv.
+  InitGPred (Vardefs p) gv ⊢ InitGPred (Vardefs p1) gv ∗ InitGPred (Vardefs p2) gv.
 Proof.
 clear.
 intros.
@@ -2049,8 +2034,8 @@ revert al1 al2 Merge H1 H2 (*F1 F2*); induction al as [|[i [g|g]]].
   { destruct al1 as [|[i g]]; auto. destruct (Merge i) as [Hx _]; simpl in Hx; rewrite if_true in Hx by auto; inv Hx. }
   assert (al2=nil).
   { destruct al2 as [|[i g]]; auto. destruct (Merge i) as [_ Hx]; simpl in Hx; rewrite if_true in Hx by auto; inv Hx. }
-  subst. simpl. rewrite sepcon_emp; auto.
-- simpl; intros. rewrite emp_sepcon.
+  subst. simpl. rewrite sep_emp; auto.
+- simpl; intros. rewrite emp_sep.
   inv H0.
   simpl fst in *.
   apply IHal; clear IHal; auto.
@@ -2066,15 +2051,15 @@ revert al1 al2 Merge H1 H2 (*F1 F2*); induction al as [|[i [g|g]]].
   + (*Case find_id i al1 = Some g1*) 
     destruct g1; [ contradiction | ]. 
     destruct (find_id_in_split Heqz1 H1) as [l1 [l2 [L [Hl1 Hl2]]]]; subst.
-    rewrite map_app, sepcon_app. simpl. entailer!.
+    rewrite map_app. setoid_rewrite sepcon_app. simpl. entailer!.
     remember (find_id i al2) as z2; symmetry in Heqz2; destruct z2 as [g2 |].
     * (*Case find_id i al2 = Some g2*)
       destruct g2; [ contradiction | ].
       destruct (find_id_in_split Heqz2 H2) as [m1 [m2 [M [Hm1 Hm2]]]]; subst.
-      rewrite ! map_app, ! sepcon_app. simpl. entailer!.
+      rewrite ! map_app. setoid_rewrite sepcon_app. simpl. entailer!.
       rewrite map_app in H2. apply list_norepet_elim_middle in H2.
       rewrite map_app in H1. apply list_norepet_elim_middle in H1.
-      specialize (IHal (l1++l2) (m1++m2)). rewrite ! map_app, ! sepcon_app in IHal.
+      specialize (IHal (l1++l2) (m1++m2)). rewrite ! map_app in IHal. setoid_rewrite sepcon_app in IHal.
       sep_apply IHal; clear IHal; trivial.
       -- intros j. specialize (Merge j); simpl in Merge. destruct (Memory.EqDec_ident j i).
          ++ subst j. apply find_id_None_iff in H4; rewrite H4, ! find_id_app_char, Hl1, Hl2, Hm1, Hm2. split; trivial.
@@ -2087,22 +2072,22 @@ revert al1 al2 Merge H1 H2 (*F1 F2*); induction al as [|[i [g|g]]].
     * (*Case find_id i al2 = None*) 
       subst; cancel.
       rewrite map_app in H1. apply list_norepet_elim_middle in H1.
-      specialize (IHal (l1++l2) al2). rewrite ! map_app, sepcon_app in IHal.
-      apply IHal; clear IHal; trivial.
-      intros j. specialize (Merge j); simpl in Merge. destruct (Memory.EqDec_ident j i).
+      specialize (IHal (l1++l2) al2). rewrite ! map_app in IHal. setoid_rewrite sepcon_app in IHal.
+      rewrite sep_assoc; apply IHal; clear IHal; trivial.
+      intros j. specialize (Merge j); simpl in Merge. destruct (eq_dec j i).
       -- subst j. apply find_id_None_iff in H4; rewrite H4, find_id_app_char, Hl1, Hl2. split; trivial.
-      -- rewrite find_id_app_char in *. simpl in Merge. rewrite if_false in Merge by trivial. trivial.
+      -- rewrite find_id_app_char in *. simpl in Merge. rewrite if_false in Merge by trivial. apply Merge.
   + (*Case find_id i al1 = None*)
     remember (find_id i al2) as z2; symmetry in Heqz2; destruct z2 as [g2 |]; [ | contradiction].
     destruct g2; [ contradiction | ]. 
     destruct (find_id_in_split Heqz2 H2) as [l1 [l2 [L [Hl1 Hl2]]]]; subst.
-    rewrite map_app, sepcon_app. simpl. cancel. 
+    rewrite map_app. setoid_rewrite sepcon_app. simpl. cancel. 
     rewrite map_app in H2. apply list_norepet_elim_middle in H2.
-    specialize (IHal al1 (l1++l2)). rewrite ! map_app, sepcon_app in IHal.
-    rewrite sepcon_assoc. apply IHal; clear IHal; trivial.
-    intros j. specialize (Merge j); simpl in Merge. destruct (Memory.EqDec_ident j i).
+    specialize (IHal al1 (l1++l2)). rewrite ! map_app in IHal. setoid_rewrite sepcon_app in IHal.
+    apply IHal; clear IHal; trivial.
+    intros j. specialize (Merge j); simpl in Merge. destruct (eq_dec j i).
     -- subst j. apply find_id_None_iff in H4; rewrite H4, find_id_app_char, Hl1, Hl2. split; trivial.
-    -- rewrite find_id_app_char in *. simpl in Merge. rewrite if_false in Merge by trivial. trivial.
+    -- rewrite find_id_app_char in *. simpl in Merge. rewrite if_false in Merge by trivial. apply Merge.
 Qed.
 
 Lemma compspecs_eq: forall cs1 cs2: compspecs,
@@ -2173,7 +2158,8 @@ Proof.
      assert (~In i (map fst Imports2)). { contradict H1; clear - H1; rewrite !in_app; tauto. }
      rewrite (Comp_G_dom c2 i) in H. clear H1.
      rewrite map_app in H2. rewrite in_app in H2.
-     apply Classical_Prop.not_or_and in H2; destruct H2.
+     destruct (in_dec eq_dec i (map fst G1)); first tauto.
+     destruct (in_dec eq_dec i (map fst Imports1)); first tauto.
      rewrite map_app, in_app in H0.
      destruct H0.
      * apply G_merge_InDom in H0; [ | apply (Comp_G_LNR c1)].
@@ -2192,7 +2178,8 @@ Proof.
      assert (~In i (map fst Imports1)). { contradict H1; clear - H1; rewrite !in_app; tauto. }
      rewrite (Comp_G_dom c1 i) in H. clear H1.
      rewrite map_app in H2. rewrite in_app in H2.
-     apply Classical_Prop.not_or_and in H2; destruct H2.
+     destruct (in_dec eq_dec i (map fst G2)); first tauto.
+     destruct (in_dec eq_dec i (map fst Imports2)); first tauto.
      rewrite map_app, in_app in H0.
      destruct H0.
      * apply G_merge_InDom in H0; [ | apply (Comp_G_LNR c1)].
@@ -2230,7 +2217,7 @@ unfold JoinedImports; clear - c1 c2 Linked. intros. rewrite map_app in H. apply
     destruct (Comp_Imports_external c1 i) as [ef [ts [t [cc FND]]]].
     { apply (in_map fst) in J1. apply J1. }
      assert (FP := Linked_Functions_preserved _ _ _ Linked i). hnf in FP. rewrite FND in FP.
-     destruct ((QP.prog_defs p2) ! i) eqn:Hequ.
+     destruct ((QP.prog_defs p2) !! i) eqn:Hequ.
     * destruct g; eauto. destruct f; eauto.
        destruct (in_dec ident_eq i (map fst E2 ++ IntIDs p2)). inv J2. 
          elim n. apply in_or_app. right. apply in_map_iff.
@@ -2248,7 +2235,7 @@ unfold JoinedImports; clear - c1 c2 Linked. intros. rewrite map_app in H. apply
     { apply (in_map fst) in J1. apply J1. }
     
     hnf in FP. rewrite FND in FP.
-    remember ((QP.prog_defs p1) ! i) as u; symmetry in Hequ; destruct u.
+    remember ((QP.prog_defs p1) !! i) as u; symmetry in Hequ; destruct u.
     * destruct g; eauto. 
       destruct f; eauto.
       destruct (in_dec ident_eq i (map fst E1 ++ IntIDs p1 ++ map fst Imports1)). inv J2. 
@@ -2264,13 +2251,13 @@ Local Lemma Condition2:
  forall i : ident, In i (map fst E) ->
         exists ef ts t cc, PTree.get i (QP.prog_defs p) = Some (Gfun (External ef ts t cc)).
 Proof.
-  intros; unfold E. 
+  intros; unfold E.
     assert (FP := Linked_Functions_preserved _ _ _ Linked i). hnf in FP.
     apply G_merge_InDom in H. destruct H as [Hi | [NE Hi]].
   - destruct (Comp_Externs c1 _ Hi) as [ef [tys [rt [cc P1i]]]]. exists ef, tys, rt, cc.
     clear - P1i Hi FP Externs1_Hyp c2.
     hnf in FP; rewrite P1i in FP.
-    remember ((QP.prog_defs p2) ! i) as u; symmetry in Hequ; destruct u.
+    remember ((QP.prog_defs p2) !! i) as u; symmetry in Hequ; destruct u.
     * destruct g; eauto. destruct f; eauto.
          apply IntIDs_i in Hequ.
          elim (Externs1_Hyp i i); trivial. destruct FP; auto. contradiction.
@@ -2279,7 +2266,7 @@ Proof.
     clear - P2i Hi FP Externs2_Hyp Externs1_Hyp c2 c1 FundefsMatch.
     specialize (FundefsMatch i).
     rewrite P2i in *. 
-    remember ((QP.prog_defs p1) ! i) as u; symmetry in Hequ; destruct u.
+    remember ((QP.prog_defs p1) !! i) as u; symmetry in Hequ; destruct u.
     * destruct g; eauto. destruct f.
        ++ clear - Hequ Externs2_Hyp Hi. apply IntIDs_i in Hequ.
          elim (Externs2_Hyp i i); trivial.
@@ -2300,55 +2287,54 @@ Proof.
   assert (CC := @Calling_conventions_match i).
   clear - c1 c2 CC HCi Externs2_Hyp Externs1_Hyp SC1 SC2 JUST1 JUST2.
    apply subsumespec_app_left; intros; apply subsumespec_i.
-  - rewrite ! find_id_app_char. 
-             remember (find_id i Imports1) as q1; symmetry in Heqq1; destruct q1 as [phi1 |]; simpl; trivial.
+  - rewrite !find_id_app_char.
+             remember (@find_id funspec i Imports1) as q1; symmetry in Heqq1; destruct q1 as [phi1 |]; simpl; trivial.
              specialize (list_disjoint_map_fst_find_id1 (Comp_G_disjoint_from_Imports c1) _ _ Heqq1); intros.
              rewrite G_merge_None_l; trivial. 2: apply (Comp_G_LNR c2).
              rewrite find_id_filter_char, Heqq1 by apply (Comp_Imports_LNR c1); simpl.
              destruct (in_dec ident_eq i (map fst E2 ++ IntIDs p2)); simpl.
-             2: exists phi1; split; [ reflexivity | apply funspec_sub_si_refl; trivial].
+             2: exists phi1; split; [ reflexivity | iIntros "?"; iApply funspec_sub_si_refl].
              rewrite find_id_filter_char by apply (Comp_Imports_LNR c2); simpl.
              destruct (in_dec ident_eq i (map fst E1 ++ IntIDs p1 ++ map fst Imports1)); simpl.
              + apply find_id_None_iff in H.
                remember (find_id i (Comp_G c2)) as w2; symmetry in Heqw2; destruct w2 as [psi2 |].
-               * exists psi2; split. destruct (find_id i Imports2); trivial.
+               * exists psi2; split. destruct (@find_id funspec i Imports2); trivial.
                  destruct (SC2 _ _ Heqq1 i0) as [tau2 [Tau2 SubTau]].
-                 apply funspec_sub_sub_si. apply @funspec_sub_trans with tau2; trivial.
+                 iIntros "?"; iApply funspec_sub_sub_si. apply @funspec_sub_trans with tau2; trivial.
                  destruct (Comp_G_Exports c2 _ _ Tau2) as [omega [Omega SubOM]].
-                 rewrite funspec_sub_iff in *.
                  unfold Comp_G in Heqw2; rewrite Heqw2 in Omega; inv Omega; trivial.
-               * destruct (SC2 _ _ Heqq1 i0) as [tau2 [TAU Tau]]. 
+               * destruct (SC2 _ _ Heqq1 i0) as [tau2 [TAU Tau]].
                  destruct (Comp_G_Exports c2 _ _ TAU) as [omega [Omega OM]].
                  clear - Heqw2 Omega. unfold Comp_G in Heqw2; congruence.
-             + destruct (SC2 _ _ Heqq1 i0) as [tau2 [TAU Tau]]. 
-               destruct (Comp_G_Exports c2 _ _ TAU) as [omega [Omega OM]]; unfold Comp_G; rewrite Omega.
+             + destruct (SC2 _ _ Heqq1 i0) as [tau2 [TAU Tau]].
+               destruct (Comp_G_Exports c2 _ _ TAU) as [omega [Omega OM]]. unfold Comp_G. replace (@find_id funspec i G2) with (Some omega).
                specialize (Comp_G_disjoint_from_Imports c2); intros.
-               rewrite (list_disjoint_map_fst_find_id2 (Comp_G_disjoint_from_Imports c2) _ _ Omega).
-               exists omega; split; trivial. apply funspec_sub_sub_si. apply @funspec_sub_trans with tau2; trivial.
+               setoid_rewrite (list_disjoint_map_fst_find_id2 (Comp_G_disjoint_from_Imports c2) _ _ Omega).
+               exists omega; split; trivial. iIntros; iApply funspec_sub_sub_si. apply @funspec_sub_trans with tau2; trivial.
   -
-      remember (find_id i (Comp_G c1)) as d; symmetry in Heqd; destruct d as [phi1 |]; simpl; trivial.
-               rewrite!  find_id_app_char, find_id_filter_None_I; [ | trivial | apply (Comp_Imports_LNR c1) ].
+      remember (@find_id funspec i (Comp_G c1)) as d; symmetry in Heqd; destruct d as [phi1 |]; simpl; trivial.
+               rewrite !find_id_app_char, find_id_filter_None_I; [ | trivial | apply (Comp_Imports_LNR c1) ].
                rewrite find_id_filter_char by apply (Comp_Imports_LNR c2); simpl.
-               remember (find_id i Imports2) as w2; symmetry in Heqw2; destruct w2 as [psi2 |]; simpl.
+               remember (@find_id funspec i Imports2) as w2; symmetry in Heqw2; destruct w2 as [psi2 |]; simpl.
                + destruct (in_dec ident_eq i (map fst E1 ++ IntIDs p1 ++ map fst Imports1)); simpl.
                  * rewrite (G_merge_find_id_SomeNone Heqd (list_disjoint_map_fst_find_id1 (Comp_G_disjoint_from_Imports c2) _ _ Heqw2)).
-                   eexists; split. reflexivity. apply funspec_sub_si_refl; trivial.
+                   eexists; split. reflexivity. iIntros; iApply funspec_sub_si_refl.
                  * apply find_id_In_map_fst in Heqd. apply (Comp_G_dom c1) in Heqd.
                    elim n; clear - Heqd. rewrite app_assoc. apply in_or_app. left; apply in_app_or in Heqd; apply in_or_app. destruct Heqd; auto.
                + remember (find_id i (Comp_G c2)) as q2; destruct q2 as [phi2 |]; symmetry in Heqq2; simpl; trivial.
                  * destruct (G_merge_find_id_SomeSome Heqd Heqq2) as [phi [BI PHI]].
                    { apply HCi; trivial. }
-                   { auto. } 
-                   rewrite PHI. exists phi; split; trivial. apply binaryintersection_sub in BI. apply funspec_sub_sub_si.
-                   rewrite funspec_sub_iff. apply BI. 
-                 * rewrite G_merge_None_r, Heqd; trivial. exists phi1. split; trivial. apply funspec_sub_si_refl; trivial.
-                   apply (Comp_G_LNR c2). 
+                   { auto. }
+                   rewrite PHI. exists phi; split; trivial. apply binaryintersection_sub in BI. iIntros; iApply funspec_sub_sub_si.
+                   apply BI.
+                 * rewrite G_merge_None_r, Heqd; trivial. exists phi1. split; trivial. iIntros; iApply funspec_sub_si_refl.
+                   apply (Comp_G_LNR c2).
 Qed.
 
 Local Lemma SUBSUME2 : forall i : ident,
            subsumespec (find_id i (Imports2 ++ Comp_G c2))
              (find_id i (JoinedImports ++ G)).
-Proof. 
+Proof.
   assert (JUST2 := Comp_G_justified c2).
   assert (JUST1 := Comp_G_justified c1).
   intros i. 
@@ -2357,38 +2343,38 @@ Proof.
   apply subsumespec_i.
   remember (find_id i (Imports2 ++ Comp_G c2)) as u; symmetry in Hequ; destruct u as [phi2 |]; [| simpl; trivial].
   rewrite find_id_app_char in Hequ.
-  unfold JoinedImports. rewrite <- app_assoc, ! find_id_app_char, ! find_id_filter_char; try apply (Comp_Imports_LNR c2) ; try apply (Comp_Imports_LNR c1).
+  unfold JoinedImports. rewrite <- app_assoc, !find_id_app_char, !find_id_filter_char; try apply (Comp_Imports_LNR c2) ; try apply (Comp_Imports_LNR c1).
   simpl. remember (find_id i Imports2) as q; symmetry in Heqq; destruct q as [phi2' |].
    + subst G. inv Hequ. clear - i  Heqq SC1 HImports.
          specialize (list_disjoint_map_fst_find_id1 (Comp_G_disjoint_from_Imports c2) _ _ Heqq); intros.
-        rewrite G_merge_None_r; trivial. 2: apply (Comp_G_LNR c2).
+        exploit (G_merge_None_r (Comp_G c1) (Comp_G c2) i); [trivial | apply (Comp_G_LNR c2) |].
+        intros Hmerge; unfold funspec, mpred in Hmerge; simpl in Hmerge.
         destruct (in_dec ident_eq i (map fst E2 ++ IntIDs p2)); simpl.
         - apply find_id_None_iff in H; elim H.
           apply (Comp_G_dom c2 i). apply in_or_app. apply in_app_or in i0. destruct i0; auto.
         - remember (find_id i Imports1) as w1; symmetry in Heqw1; destruct w1 as [ph1 |].
           * specialize (HImports _ _ _ Heqw1 Heqq); subst.
-            eexists; split. reflexivity. apply funspec_sub_si_refl; trivial.
+            eexists; split. reflexivity. iIntros "?"; iApply funspec_sub_si_refl.
           * destruct (in_dec ident_eq i (map fst E1 ++ IntIDs p1 ++ map fst Imports1)); simpl.
             ++ rewrite app_assoc in i0; apply in_app_or in i0; destruct i0.
                -- destruct (SC1 _ _ Heqq H0) as [phi1 [EXP1 Sub]].
                   destruct (Comp_G_Exports c1 _ _ EXP1) as [psi1 [G1i Psi1]].
-                  eexists; split. eassumption. apply funspec_sub_sub_si.
+                  eexists; split. etransitivity; eassumption. iIntros; iApply funspec_sub_sub_si.
                   apply @funspec_sub_trans with phi1; trivial.
                -- apply find_id_None_iff in Heqw1. contradiction.
-            ++ eexists; split. reflexivity. apply funspec_sub_si_refl; trivial.
+            ++ eexists; split. reflexivity. iIntros; iApply funspec_sub_si_refl.
       + destruct (in_dec ident_eq i (map fst E2 ++ IntIDs p2)); simpl.
         - subst G.
           remember (find_id i (Comp_G c1)) as q1; symmetry in Heqq1; destruct q1 as [phi1 |].
           * destruct (G_merge_find_id_SomeSome Heqq1 Hequ) as [phi [BI Sub]].
             { apply HCi; trivial. }
-            { auto. } 
+            { auto. }
              exists phi; split.
              -- destruct (find_id i Imports1); trivial.
-             -- apply funspec_sub_sub_si. rewrite funspec_sub_iff.
+             -- iIntros; iApply funspec_sub_sub_si.
                 eapply (binaryintersection_sub). apply BI.
-          * rewrite (G_merge_find_id_NoneSome Heqq1 Hequ).
-            exists phi2; split. destruct (find_id i Imports1); trivial. apply funspec_sub_si_refl; trivial.
-            apply (Comp_G_LNR c2).
+          * exists phi2; split. destruct (find_id i Imports1); apply (G_merge_find_id_NoneSome Heqq1 Hequ), (Comp_G_LNR c2).
+            iIntros; iApply funspec_sub_si_refl.
         - elim n. apply find_id_In_map_fst in Hequ. rewrite <- (Comp_G_dom c2) in Hequ. elim n; apply in_or_app.
           apply in_app_or in Hequ; destruct Hequ; auto.
 Qed.
@@ -2405,22 +2391,24 @@ Proof.
     pose proof (list_disjoint_notin _ Disj_V1p2 H1); clear Disj_V1p2 H1.
     clear - H2 H3 H4.
     rewrite map_app, in_app in H3.
-    apply Classical_Prop.not_or_and in H3; destruct H3.
-    rewrite in_app in H4; apply Classical_Prop.not_or_and in H4; destruct H4.
-    rewrite in_app in H3; apply Classical_Prop.not_or_and in H3; destruct H3.
+    destruct (in_dec eq_dec i (map fst G1)); first tauto.
+    destruct (in_dec eq_dec i (map fst Imports1)); first tauto.
+    rewrite !in_app in H4.
+    destruct (in_dec eq_dec i (map fst E2)); first tauto.
+    destruct (in_dec eq_dec i (map fst Imports2)); first tauto.
+    destruct (in_dec eq_dec i (IntIDs p2)); first tauto.
     assert (~In i (map fst G2)). {
       rewrite <- (Comp_G_dom c2 i).
      rewrite in_app. tauto.
    }
-   clear H4 H1.
    rewrite map_app, in_app in H2; destruct H2.
  -
-    unfold JoinedImports in H1.
-    rewrite map_app, in_app in H1; destruct H1.
-    apply In_map_fst_filter3 in H1. contradiction.
-    apply In_map_fst_filter3 in H1. contradiction.
- - apply G_merge_InDom in H1; [ | apply (Comp_G_LNR c1)].
-    destruct H1 as [? | [_ ?]]; try contradiction.
+    unfold JoinedImports in H0.
+    rewrite map_app, in_app in H0; destruct H0.
+    apply In_map_fst_filter3 in H0. contradiction.
+    apply In_map_fst_filter3 in H0. contradiction.
+ - apply G_merge_InDom in H0; [ | apply (Comp_G_LNR c1)].
+    destruct H0 as [? | [_ ?]]; try contradiction.
 Qed.
 
 Local Lemma LNR4_V2 : list_norepet (map fst V2 ++ map fst (JoinedImports ++ G)).
@@ -2435,38 +2423,40 @@ Proof.
     pose proof (list_disjoint_notin _ Disj_V2p1 H1); clear Disj_V2p1 H1.
     clear - H2 H3 H4.
     rewrite map_app, in_app in H3.
-    apply Classical_Prop.not_or_and in H3; destruct H3.
-    rewrite in_app in H4; apply Classical_Prop.not_or_and in H4; destruct H4.
-    rewrite in_app in H3; apply Classical_Prop.not_or_and in H3; destruct H3.
+    destruct (in_dec eq_dec i (map fst G2)); first tauto.
+    destruct (in_dec eq_dec i (map fst Imports2)); first tauto.
+    rewrite !in_app in H4.
+    destruct (in_dec eq_dec i (map fst E1)); first tauto.
+    destruct (in_dec eq_dec i (map fst Imports1)); first tauto.
+    destruct (in_dec eq_dec i (IntIDs p1)); first tauto.
     assert (~In i (map fst G1)). {
       rewrite <- (Comp_G_dom c1 i).
      rewrite in_app. tauto.
    }
-   clear H4 H1.
    rewrite map_app, in_app in H2; destruct H2.
  -
-    unfold JoinedImports in H1.
-    rewrite map_app, in_app in H1; destruct H1.
-    apply In_map_fst_filter3 in H1. contradiction.
-    apply In_map_fst_filter3 in H1. contradiction.
- - apply G_merge_InDom in H1; [ | apply (Comp_G_LNR c1)].
-    destruct H1 as [? | [_ ?]]; try contradiction.
+    unfold JoinedImports in H0.
+    rewrite map_app, in_app in H0; destruct H0.
+    apply In_map_fst_filter3 in H0. contradiction.
+    apply In_map_fst_filter3 in H0. contradiction.
+ - apply G_merge_InDom in H0; [ | apply (Comp_G_LNR c1)].
+    destruct H0 as [? | [_ ?]]; try contradiction.
 Qed.
 
 Local Lemma G_dom:
 forall i : ident, In i (IntIDs p ++ map fst E) <-> In i (map fst G).
   clear - Linked Externs2_Hyp.
-   intros. subst G; unfold E. split; intros. 
+   intros. subst G; unfold E. split; intros.
   - apply G_merge_InDom; [ apply (Comp_G_LNR c1) | apply in_app_or in H; destruct H].
     * destruct (in_dec ident_eq i (map fst (Comp_G c1))). left; trivial. right; split; trivial.
       apply c2. 
      assert (FP := Linked_Functions_preserved _ _ _ Linked i). hnf in FP.
-      destruct ((QP.prog_defs p1) ! i ) as [ [ [|] |] | ] eqn:?.
+      destruct ((QP.prog_defs p1) !! i ) as [ [ [|] |] | ] eqn:?.
       ++ clear - Heqo FP H n.
             elim n. apply c1. apply in_or_app; left. 
             apply IntIDs_i in Heqo; trivial.
       ++ clear - Heqo FP H n c2. 
-            destruct ((QP.prog_defs p2) ! i) as [[[|]|]|] eqn:Heqq2.
+            destruct ((QP.prog_defs p2) !! i) as [[[|]|]|] eqn:Heqq2.
             apply in_or_app; left.
             apply IntIDs_i in Heqq2; trivial.
             destruct FP as [FP FP']. inversion2 FP FP'.
@@ -2479,11 +2469,11 @@ forall i : ident, In i (IntIDs p ++ map fst E) <-> In i (map fst G).
             apply IntIDs_e in H; destruct H.  congruence.
        ++ clear - Heqo FP H n c2.
             apply IntIDs_e in H. destruct H as [f ?]. rewrite H in FP.
-             destruct ((QP.prog_defs p2) ! i) as [[[|]|]|] eqn:Heqq2; try contradiction.
+             destruct ((QP.prog_defs p2) !! i) as [[[|]|]|] eqn:Heqq2; try contradiction.
              destruct FP as [_ [[_ ?] | [_ ?]]]; discriminate. discriminate.
 
        ++ clear - Heqo FP H n c2.
-            destruct ((QP.prog_defs p2) ! i) as [[[|]|]|] eqn:Heqq2; try contradiction.
+            destruct ((QP.prog_defs p2) !! i) as [[[|]|]|] eqn:Heqq2; try contradiction.
             apply in_or_app; left.
             apply IntIDs_i in Heqq2; trivial.
             apply In_map_fst_find_id in H. destruct H. 
@@ -2504,10 +2494,10 @@ forall i : ident, In i (IntIDs p ++ map fst E) <-> In i (map fst G).
          clear - c1 FP Hfd. 
          rewrite find_id_filter_char in Hfd; [ | apply PTree.elements_keys_norepet].
          rewrite find_id_elements in Hfd.
-         destruct ((QP.prog_defs p1) ! i); try discriminate.
+         destruct ((QP.prog_defs p1) !! i); try discriminate.
          destruct g; [ simpl in Hfd | discriminate].
          destruct f; inv Hfd.
-         destruct  ((QP.prog_defs p2) ! i) as [ [ [|] | ] | ]; try contradiction.
+         destruct  ((QP.prog_defs p2) !! i) as [ [ [|] | ] | ]; try contradiction.
          destruct FP as [FP _]; apply IntIDs_i in FP; trivial.
          apply IntIDs_i in FP; trivial.
          apply IntIDs_i in FP; trivial.
@@ -2516,7 +2506,7 @@ forall i : ident, In i (IntIDs p ++ map fst E) <-> In i (map fst G).
       ++ right. apply G_merge_InDom.  apply (Comp_Externs_LNR c1). 
          right; split; trivial. intros N. apply HE. apply Comp_E_in_G. apply N.
       ++ rewrite FI in FP. 
-             left; destruct  ((QP.prog_defs p1) ! i) as [ [ [|] | ] | ];
+             left; destruct  ((QP.prog_defs p1) !! i) as [ [ [|] | ] | ];
                   try apply IntIDs_i in FP; trivial.
               destruct FP as [FP _]; apply IntIDs_i in FP; trivial. contradiction.
 Qed.
@@ -2527,11 +2517,11 @@ Local Lemma G_E:
 Proof.
 subst G; unfold E; intros. assert (FP := Linked_Functions_preserved _ _ _ Linked i); hnf in FP.
   destruct (In_map_fst_find_id H) as [phi Phi]. apply G_merge_LNR. apply (Comp_Externs_LNR c1).  apply (Comp_Externs_LNR c2). 
-  symmetry; rewrite Phi. apply G_merge_find_id_Some in Phi. remember (find_id i E1) as q1; symmetry in Heqq1; destruct q1 as [phi1 |]. 
+  symmetry; rewrite Phi. apply G_merge_find_id_Some in Phi. remember (@find_id funspec i E1) as q1; symmetry in Heqq1; destruct q1 as [phi1 |]. 
   - specialize (Comp_E_in_G_find c1 _ _ Heqq1); intros.
-    remember (find_id i E2) as q2; symmetry in Heqq2; destruct q2 as [phi2 |].
+    remember (@find_id funspec i E2) as q2; symmetry in Heqq2; destruct q2 as [phi2 |].
     * specialize (Comp_E_in_G_find c2 _ _ Heqq2); intros.
-      unfold G_merge. apply find_id_app1. erewrite  G_merge_aux_find_id1. 2: eassumption. rewrite H1, Phi; trivial.
+      unfold G_merge. apply find_id_app1. erewrite  G_merge_aux_find_id1. 2: eassumption. setoid_rewrite H1; rewrite Phi; trivial.
     * simpl in Phi. subst phi1. rewrite (G_merge_find_id_SomeNone H0); trivial.
       remember (find_id i (Comp_G c2)) as u; symmetry in Hequ; destruct u as [psi2 |]; trivial.
       apply find_id_In_map_fst in Hequ. apply Comp_G_elim in Hequ. destruct Hequ as [[HH _] | [_ [? ]]].
@@ -2615,28 +2605,28 @@ Qed.
 
 Local Lemma G_justified:
   forall (i : positive) (phi : funspec) (fd : fundef function),
-    (QP.prog_defs p) ! i = Some (Gfun fd) ->
-     find_id i G = Some phi -> 
+    (QP.prog_defs p) !! i = Some (Gfun fd) ->
+     find_id i G = Some phi ->
       @SF Espec cs V (QPglobalenv p) (JoinedImports ++ G) i fd phi.
 Proof.
   assert (JUST2 := Comp_G_justified c2).
   assert (JUST1 := Comp_G_justified c1).
-  assert (SUBSUME1 := SUBSUME1). 
-  assert (SUBSUME2 := SUBSUME2). 
-  assert (LNR4_V1 := LNR4_V1). 
-  assert (LNR4_V2 := LNR4_V2). 
+  assert (SUBSUME1 := SUBSUME1).
+  assert (SUBSUME2 := SUBSUME2).
+  assert (LNR4_V1 := LNR4_V1).
+  assert (LNR4_V2 := LNR4_V2).
  subst G. intros.
   assert (HCi := HC i).
   assert (FP := Linked_Functions_preserved _ _ _ Linked i). hnf in FP. specialize (FundefsMatch i).
   apply G_merge_find_id_Some in H0. 2: apply (Comp_G_LNR c2).
-  remember (find_id i (Comp_G c1)) as q1; symmetry in Heqq1; destruct q1 as [phi1 |].
-  - subst phi; 
+  remember (@find_id funspec i (Comp_G c1)) as q1; symmetry in Heqq1; destruct q1 as [phi1 |].
+  - subst phi;
     exploit (Comp_G_in_Fundefs' c1). apply Heqq1. intros [fd1 FD1].
     specialize (JUST1 _ _ _ FD1 Heqq1).
     specialize (SF_subsumespec JUST1 _ V SUBSUME1 HV1
                           (@list_norepet_find_id_app_exclusive1 _ _ _ _ LNR4_V1)
                   (Comp_ctx_LNR c1)); clear JUST1 SUBSUME1; intros SF1.
-    remember (find_id i (Comp_G c2)) as q2; symmetry in Heqq2; destruct q2 as [phi2 |].
+    remember (@find_id funspec i (Comp_G c2)) as q2; symmetry in Heqq2; destruct q2 as [phi2 |].
     * exploit (Comp_G_in_Fundefs' c2). apply Heqq2. intros [fd2 FD2].
       specialize (JUST2 _ _ _ FD2 Heqq2).
       specialize (SF_subsumespec JUST2 _  V SUBSUME2 HV2 
@@ -2644,15 +2634,14 @@ Proof.
       rewrite FD1, FD2, H in *. specialize (FundefsMatch _ _ (eq_refl _) (eq_refl _)). simpl.
       destruct fd1; destruct fd2.
       ++ (*Internal/Internal*)
-         destruct FP as [FP FP']; inv FP. inv FP'.
+         destruct FP as [FP FP']; inv FP.
          assert (BI : binary_intersection phi1 phi2 = Some (merge_specs phi1 (Some phi2))).
          { apply merge_specs_succeed. apply HCi; auto.
            apply InternalInfo_cc in SF1. rewrite <- SF1.
-           apply InternalInfo_cc in SF2.  trivial. }
+           apply InternalInfo_cc in SF2. trivial. }
          simpl.
          eapply internalInfo_binary_intersection; [ | | apply BI].
-         --
-            apply (InternalInfo_envs_sub CS1 (QPglobalenv p1)); [ apply SF1 | clear - H OKp].
+         -- apply (InternalInfo_envs_sub CS1 (QPglobalenv p1)); [ apply SF1 | clear - H OKp].
             apply QPfind_funct_ptr_exists; auto.
          -- apply (InternalInfo_envs_sub CS2 (QPglobalenv p2)); [ apply SF2 | clear - H OKp].
             apply QPfind_funct_ptr_exists; auto.
@@ -2669,7 +2658,7 @@ Proof.
               apply IntIDs_i in FD2; trivial. 
          -- destruct H0 as [? [? ?]]. congruence.
       ++ (*ExternalExternal*)
-         destruct FP as [FP FP']; inv FP. inv FP'.
+         destruct FP as [FP FP']; inv FP.
          assert (BI : binary_intersection phi1 phi2 = Some (merge_specs phi1 (Some phi2))).
          { apply merge_specs_succeed. apply HCi; auto.
            apply ExternalInfo_cc in SF1. rewrite <- SF1. 
@@ -2684,7 +2673,7 @@ Proof.
       rewrite FD1 in *. destruct Heqq1 as [[HE EF1] | [HE [INT1 IF1]]].
       ++ destruct EF1 as [ef [tys [rt [cc EF1]]]].
           inv EF1.
-         destruct ((QP.prog_defs p2) ! i) as [ [[|]|] | ] eqn:Heqw2.
+         destruct ((QP.prog_defs p2) !! i) as [ [[|]|] | ] eqn:Heqw2.
          -- clear - c2 HE Externs1_Hyp Heqw2. elim (list_disjoint_notin i Externs1_Hyp HE).
               apply IntIDs_i in Heqw2; trivial.
          -- specialize (FundefsMatch _ _ (eq_refl _) (eq_refl _)). simpl in FundefsMatch. inv FundefsMatch.
@@ -2697,15 +2686,14 @@ Proof.
                eapply ExternalInfo_envs_sub; [ apply SF1 | clear - OKp FP].
                apply QPfind_funct_ptr_exists; auto. 
       ++ destruct IF1 as [f IF1]. inv IF1.
-             destruct ((QP.prog_defs p2) ! i) as [ [[|]|] | ] eqn:Heqw2.
+             destruct ((QP.prog_defs p2) !! i) as [ [[|]|] | ] eqn:Heqw2.
          -- specialize (FundefsMatch _ _ (eq_refl _) (eq_refl _)). simpl in FundefsMatch. inv FundefsMatch. 
                destruct FP as [FP FP']. inversion2 FP FP'.
-               rewrite FP in H. inv H. 
+               rewrite FP in H. inv H.
                apply (InternalInfo_envs_sub CS1 (QPglobalenv p1)); [ apply SF1 | clear - OKp FP].
                apply QPfind_funct_ptr_exists; auto.
-         -- specialize (FundefsMatch _ _ (eq_refl _) (eq_refl _)). simpl in FundefsMatch. inv FundefsMatch. 
-               rewrite FP in H. inv H. 
-               apply (InternalInfo_envs_sub CS1 (QPglobalenv p1)); [ apply SF1 | clear - OKp FP].
+         -- specialize (FundefsMatch _ _ (eq_refl _) (eq_refl _)). simpl in FundefsMatch. inv FundefsMatch.
+               apply (InternalInfo_envs_sub CS1 (QPglobalenv p1)); [ apply SF1 | clear - OKp H].
                apply QPfind_funct_ptr_exists; auto.
          -- clear FundefsMatch Heqw2.  contradiction FP.
          -- clear FundefsMatch Heqw2.
@@ -2713,11 +2701,11 @@ Proof.
              apply (InternalInfo_envs_sub CS1 (QPglobalenv p1)); [ apply SF1 | clear - OKp FP].
                apply QPfind_funct_ptr_exists; auto.
    - (*i in G2 but not in G1 -- symmetric*) 
-      specialize (JUST2 i phi). specialize (JUST1 i). rewrite <- H0 in JUST2.
+      specialize (JUST2 i phi). specialize (JUST1 i). setoid_rewrite <- H0 in JUST2.
       apply find_id_In_map_fst in H0. apply Comp_G_elim in H0.
       destruct H0 as [[HE EF2] | [HE [INT2 IF2]]].
       ++ destruct EF2 as [ef [tys [rt [cc EF2]]]]. specialize (JUST2 _ EF2 (eq_refl _)).
-             destruct ((QP.prog_defs p1) ! i) as [ [[|]|] | ] eqn:Heqw1.
+             destruct ((QP.prog_defs p1) !! i) as [ [[|]|] | ] eqn:Heqw1.
          --  clear - c1 HE Externs2_Hyp Heqw1. elim (list_disjoint_notin i Externs2_Hyp HE). 
                apply IntIDs_i in Heqw1; trivial.
          -- rewrite EF2 in FundefsMatch, FP. 
@@ -2733,7 +2721,7 @@ Proof.
       ++ destruct IF2 as [f IF2]. rewrite IF2 in *.
          specialize (JUST2 _ (eq_refl _) (eq_refl _)).
          specialize (SF_subsumespec JUST2 _ _ SUBSUME2 HV2 (@list_norepet_find_id_app_exclusive1 _ _ _ _ LNR4_V2) (Comp_ctx_LNR c2)); clear JUST2 SUBSUME2; intros SF2.
-         destruct ((QP.prog_defs p1) ! i) as [ [[|]|] | ] eqn:Heqw1.
+         destruct ((QP.prog_defs p1) !! i) as [ [[|]|] | ] eqn:Heqw1.
          -- specialize (FundefsMatch _ _ (eq_refl _) (eq_refl _)). simpl in FundefsMatch. inv FundefsMatch.
                destruct FP as [FP FP']. inversion2 FP FP'.
                rewrite FP in H. inv H.
@@ -2765,7 +2753,7 @@ Proof.
   hnf in FP.
   remember (find_id i (Comp_G c1)) as u1; symmetry in Hequ1; destruct u1 as [phi1 |].
   - remember (find_id i (Comp_G c2)) as u2; symmetry in Hequ2; destruct u2 as [phi2 |]. 
-    * 
+    *
       assert (SigsPhi:typesig_of_funspec phi1 = typesig_of_funspec phi2).
       { apply (HCi phi1 phi2); trivial. }
       specialize (Calling_conventions_match Hequ1 Hequ2); intros CCPhi.
@@ -2774,12 +2762,12 @@ Proof.
       rewrite PHI'. exists phi'; split. trivial. clear PHI'.
       apply binaryintersection_sub in BI'.
       destruct BI' as [Phi1' Phi2'].
-      remember (find_id i Exports1) as q1; symmetry in Heqq1; destruct q1 as [psi1 |].
+      remember (@find_id funspec i Exports1) as q1; symmetry in Heqq1; destruct q1 as [psi1 |].
       ++ subst phi. destruct (Comp_G_Exports c1 _ _ Heqq1) as [tau1 [Tau1 TAU1]].
          unfold Comp_G in Hequ1; rewrite Hequ1 in Tau1; inv Tau1.
-         remember (find_id i Exports2) as q2; symmetry in Heqq2; destruct q2 as [psi2 |].
+         remember (@find_id funspec i Exports2) as q2; symmetry in Heqq2; destruct q2 as [psi2 |].
 
-         2: rewrite <- funspec_sub_iff in *; solve [simpl; apply @funspec_sub_trans with tau1; trivial ].
+         2: solve [simpl; apply @funspec_sub_trans with tau1; trivial ].
 
          destruct (Comp_G_Exports c2 _ _ Heqq2) as [tau2 [Tau2 TAU2]].
          unfold Comp_G in Hequ2; rewrite Hequ2 in Tau2; inv Tau2.
@@ -2794,28 +2782,25 @@ Proof.
            rewrite <- TAU1, <- TAU2; trivial. }
          destruct (G_merge_find_id_SomeSome Heqq1 Heqq2 SigsPsi CCPsi) as [tau' [BI TAU']].
          simpl. rewrite BI. clear - BI Phi1' Phi2' TAU1 TAU2.
-         rewrite funspec_sub_iff.
-         apply (BINARY_intersection_sub3 _ _ _ BI); clear BI;
-           rewrite <- funspec_sub_iff in *.
+         apply (BINARY_intersection_sub3 _ _ _ BI); clear BI.
          apply @funspec_sub_trans with tau1; trivial.
          apply @funspec_sub_trans with tau2; trivial.
       ++ destruct (Comp_G_Exports c2 _ _ Hi) as [tau2 [Tau2 TAU2]].
          unfold Comp_G in Hequ2; rewrite Hequ2 in Tau2; inv Tau2.
-         rewrite <- funspec_sub_iff in *.
          apply @funspec_sub_trans with tau2; trivial.
     * rewrite (G_merge_find_id_SomeNone Hequ1 Hequ2).
-      remember (find_id i Exports1) as q1; symmetry in Heqq1; destruct q1 as [psi1 |].
+      remember (@find_id funspec i Exports1) as q1; symmetry in Heqq1; destruct q1 as [psi1 |].
       ++ subst. eexists; split. reflexivity.
          destruct (Comp_G_Exports c1 _ _ Heqq1) as [psi [Psi PSI]]. unfold Comp_G in Hequ1; rewrite Hequ1 in Psi. inv Psi.
          eapply funspec_sub_trans. apply PSI.
          apply type_of_funspec_sub in PSI.
-         clear - Heqq1 Hequ2 c2 PSI. remember (find_id i Exports2) as w; symmetry in Heqw; destruct w as [psi2 |].
+         clear - Heqq1 Hequ2 c2 PSI. remember (@find_id funspec i Exports2) as w; symmetry in Heqw; destruct w as [psi2 |].
          -- destruct (Comp_G_Exports c2 _ _ Heqw) as [phi2 [? ?]].
             unfold Comp_G in Hequ2; congruence.
          -- simpl. apply funspec_sub_refl; trivial.
       ++ eexists; split. reflexivity.
          apply (Comp_G_Exports c2) in Hi. destruct Hi as [? [? _]]. unfold Comp_G in Hequ2; congruence. 
-  - remember (find_id i Exports1) as q1; symmetry in Heqq1; destruct q1 as [psi1 |].
+  - remember (@find_id funspec i Exports1) as q1; symmetry in Heqq1; destruct q1 as [psi1 |].
     * destruct (Comp_G_Exports c1 _ _ Heqq1) as [psi [Psi PSI]].  unfold Comp_G in Hequ1; congruence.
     * destruct (Comp_G_Exports c2 _ _ Hi) as [psi2 [Psi2 PSI2]]. unfold Comp_G in *.
       rewrite (G_merge_find_id_NoneSome Hequ1 Psi2).
@@ -2823,11 +2808,11 @@ Proof.
 Qed.
 
 Local Lemma MkInitPred:
-   forall gv : globals, globals_ok gv -> InitGPred (Vardefs p) gv |-- GP1 gv * GP2 gv.
+   forall gv : globals, globals_ok gv -> InitGPred (Vardefs p) gv ⊢ GP1 gv ∗ GP2 gv.
 Proof.
     intros.
-  eapply derives_trans. 
-  2: apply sepcon_derives; [ apply (Comp_MkInitPred c1 gv) | apply (Comp_MkInitPred c2 gv)]; auto.
+  eapply derives_trans.
+  2: apply bi.sep_mono; [ apply (Comp_MkInitPred c1 gv) | apply (Comp_MkInitPred c2 gv)]; auto.
   apply InitGPred_join; auto.
 Qed.
 
@@ -2839,7 +2824,7 @@ apply (Comp_Externs_LNR c2).
 Qed.
 
 Lemma ComponentJoin:
-   @Component Espec V E JoinedImports p Exports ((fun gv => GP1 gv * GP2 gv)%logic) G.
+   @Component Espec V E JoinedImports p Exports ((fun gv => GP1 gv ∗ GP2 gv)) G.
 Proof.
 apply Build_Component with OKp; trivial.
 + apply Condition1.
@@ -2865,8 +2850,8 @@ Definition VSULink_Imports'
 
 Definition VSULink_Imports_aux (Imports1 Imports2: funspecs) 
    (kill1 kill2: PTree.t unit) :=
-  filter (fun x => isNone (kill1 ! (fst x))) Imports1 ++
-  filter (fun x => isNone (kill2 ! (fst x))) Imports2.
+  filter (fun x => isNone (kill1 !! fst x)) Imports1 ++
+  filter (fun x => isNone (kill2 !! fst x)) Imports2.
 
 Definition VSULink_Imports
  {Espec E1 Imports1 p1 Exports1 GP1 E2 Imports2 p2 Exports2 GP2}
@@ -2881,9 +2866,9 @@ Lemma VSULink_Imports_eq:
 Proof.
 assert (forall i al,
   isNone
-    (fold_left
+    ((fold_left
        (fun (m : PTree.t unit) (i0 : positive) => PTree.set i0 tt m)
-       al (PTree.empty unit)) ! i =
+       al (PTree.empty unit)) !! i) =
    negb (proj_sumbool (in_dec ident_eq i al))). {
 intros.
 replace (fold_left
@@ -2957,7 +2942,7 @@ Proof.
          spec HH. eexists; split; reflexivity. congruence.
   - symmetry. apply find_id_QPvarspecs.
     specialize (find_id_QPvarspecs p2 i); intros Hp2.
-    destruct ((QP.prog_defs p2) ! i).
+    destruct ((QP.prog_defs p2) !! i).
     ++ destruct H as [gg [Mrg Hgg]]. rewrite Hgg.
        unfold merge_globdef in Mrg. destruct g. discriminate.
        apply Errors.bind_inversion in Mrg. destruct Mrg as [a [A Ha]]. inv Ha.
@@ -2965,11 +2950,11 @@ Proof.
        rewrite HH in H2. discriminate. exists v; split; trivial.
     ++ exists x. split; trivial.
 + specialize (find_id_QPvarspecs p1 i); intros Hp1.
-  remember ((QP.prog_defs p1) ! i) as q1; symmetry in Heqq1; destruct q1 as [h1 |].
+  remember ((QP.prog_defs p1) !! i) as q1; symmetry in Heqq1; destruct q1 as [h1 |].
   { destruct h1. 2:{ destruct (Hp1 (gvar_info v)) as [_ HH].
                      rewrite HH in H0. discriminate. exists v; split; trivial. }
     specialize (find_id_QPvarspecs p2 i); intros Hp2.
-    remember ((QP.prog_defs p2) ! i) as q2; symmetry in Heqq2; destruct q2 as [h2 |]. 
+    remember ((QP.prog_defs p2) !! i) as q2; symmetry in Heqq2; destruct q2 as [h2 |]. 
     - destruct H as [h [HH Hpi]].
       destruct (find_id i (QPvarspecs p2)). 
       + destruct (Hp2 t) as [X _]; clear Hp2. destruct (X (eq_refl _ )) as [x [Hx XX]]; inv Hx.
@@ -2983,10 +2968,9 @@ Proof.
         inv Hx.
         destruct f; destruct f0; simpl in HH.
         * destruct (function_eq f f0); inv HH.
-        * destruct ((eqb_list eqb_xtype
-          (map argtype_of_type (map snd (fn_params f))) (map argtype_of_type l) &&
-            eqb_xtype (rettype_of_type (fn_return f)) (rettype_of_type t) &&
-            eqb_calling_convention (fn_callconv f) c)%bool); inv HH.
+        * destruct ((eqb_list eqb_xtype (map argtype_of_type (map snd (fn_params f))) (map argtype_of_type l) &&
+                     eqb_xtype (rettype_of_type (fn_return f)) (rettype_of_type t) &&
+                     eqb_calling_convention (fn_callconv f) c)%bool); inv HH.
         * destruct ((eqb_list eqb_xtype (map argtype_of_type l) (map argtype_of_type (map snd (fn_params f))) &&
                      eqb_xtype (rettype_of_type t) (rettype_of_type (fn_return f)) &&
                      eqb_calling_convention c (fn_callconv f))%bool); inv HH.
@@ -3003,7 +2987,7 @@ Proof.
     + destruct (Hp2 t) as [X _]; clear Hp2. destruct X as [x [Hx XX]]; trivial.
       rewrite Hx in *.
       symmetry. apply (find_id_QPvarspecs p i); rewrite H. exists x; split; trivial.
-    + destruct ((QP.prog_defs p2) ! i).
+    + destruct ((QP.prog_defs p2) !! i).
       - specialize (find_id_QPvarspecs p i); intros Hp.
         destruct (find_id i (QPvarspecs p)); trivial.
         destruct (Hp t) as [X _]; clear Hp.
@@ -3016,7 +3000,7 @@ Proof.
         destruct (X (eq_refl _)) as [x [Hx XX]]; clear X. rewrite Hx in H; inv H. }
 Qed.
 
-Lemma VSULink 
+Lemma VSULink
  {Espec E1 Imports1 p1 Exports1 GP1 E2 Imports2 p2 Exports2 GP2}
   (vsu1: @VSU Espec E1 Imports1 p1 Exports1 GP1)
   (vsu2: @VSU Espec E2 Imports2 p2 Exports2 GP2) 
@@ -3033,7 +3017,7 @@ Lemma VSULink
  (SC2: forall i phiI, find_id i Imports1 = Some phiI -> In i (map fst E2 ++ IntIDs p2) ->
                           exists phiE, find_id i Exports2 = Some phiE /\ funspec_sub phiE phiI)
  (HImports: forall i phi1 phi2, find_id i Imports1 = Some phi1 -> find_id i Imports2 = Some phi2 -> phi1=phi2) :
- @VSU Espec (G_merge E1 E2) (VSULink_Imports vsu1 vsu2) p (G_merge Exports1 Exports2) (GP1 * GP2)%logic.
+ @VSU Espec (G_merge E1 E2) (VSULink_Imports vsu1 vsu2) p (G_merge Exports1 Exports2) (fun gv => GP1 gv ∗ GP2 gv).
 Proof. 
   destruct vsu1 as [G1 comp1].
   destruct vsu2 as [G2 comp2].
@@ -3054,7 +3038,7 @@ Proof.
   apply find_id_QPvarspecs in H. destruct H as [? [? ?]]. subst x.
   pose proof (merge_PTrees_e i _ _ _ _ (QPlink_progs_globdefs _ _ _ Linked)).
   rewrite H in H1.
-  assert (exists f, (QP.prog_defs p2) ! i = Some (Gfun f)). {
+  assert (exists f, (QP.prog_defs p2) !! i = Some (Gfun f)). {
   rewrite !in_app in H0; destruct H0 as [?|[?|?]].
   apply (Comp_Externs comp2) in H0. destruct H0 as [? [? [? [? ?]]]]. eauto.
   apply (Comp_Imports_external comp2) in H0. destruct H0 as [? [? [? [? ?]]]]. eauto.
@@ -3068,7 +3052,7 @@ Proof.
   apply find_id_QPvarspecs in H. destruct H as [? [? ?]]. subst x.
   pose proof (merge_PTrees_e i _ _ _ _ (QPlink_progs_globdefs _ _ _ Linked)).
   rewrite H in H1.
-  assert (exists f, (QP.prog_defs p1) ! i = Some (Gfun f)). {
+  assert (exists f, (QP.prog_defs p1) !! i = Some (Gfun f)). {
   rewrite !in_app in H0; destruct H0 as [?|[?|?]].
   apply (Comp_Externs comp1) in H0. destruct H0 as [? [? [? [? ?]]]]. eauto.
   apply (Comp_Imports_external comp1) in H0. destruct H0 as [? [? [? [? ?]]]]. eauto.
@@ -3077,3 +3061,5 @@ Proof.
  }
   destruct H2. rewrite H2 in H1. destruct H1 as [? [? ?]]. inv H1. destruct x; inv H5.
 Qed.
+
+End semax.
diff --git a/floyd/Funspec_old_Notation.v b/floyd/Funspec_old_Notation.v
index f217d960e6..cf132de92b 100644
--- a/floyd/Funspec_old_Notation.v
+++ b/floyd/Funspec_old_Notation.v
@@ -1,4 +1,7 @@
-Require Export VST.floyd.funspec_old.
+(* Warning! Old-style funspecs are not well supported in VST 3.x. If you really want to use
+   them, you can uncomment the lines below, but do so at your own risk -- calls to them may
+   fail, or they may cause start_function to run forever. *)
+(*Require Export VST.floyd.funspec_old.*)
 
-Global Close Scope funspec_scope.
-Global Open Scope old_funspec_scope.
+(*Global Close Scope funspec_scope.
+Global Open Scope old_funspec_scope.*)
diff --git a/floyd/QPcomposite.v b/floyd/QPcomposite.v
index a5e77302d5..aec7d6c414 100644
--- a/floyd/QPcomposite.v
+++ b/floyd/QPcomposite.v
@@ -1,6 +1,9 @@
+Set Warnings "-hiding-delimiting-key,-custom-entry-overridden,-notation-overridden".
 Require Import VST.floyd.base.
+Set Warnings "hiding-delimiting-key,custom-entry-overridden,notation-overridden".
 Require Import VST.floyd.PTops.
-Import compcert.lib.Maps.
+
+Local Unset SsrRewrite.
 
 Module QP.
 
@@ -15,13 +18,13 @@ Record composite : Type := {
   co_la: legal_alignas_obs
 }.
 
-Definition composite_env : Type := PTree.t composite.
+Definition composite_env : Type := Maps.PTree.t composite.
 
 Inductive builtin := mk_builtin: external_function -> list type -> type -> calling_convention -> builtin.
 
 Record program (F: Type) : Type := {
   prog_builtins: list (ident * builtin);
-  prog_defs: PTree.t (globdef (fundef F) type);
+  prog_defs: Maps.PTree.t (globdef (fundef F) type);
   prog_public: list ident;
   prog_main: ident;
   prog_comp_env: composite_env
@@ -67,7 +70,7 @@ Definition QPcomposite_bogus: QP.composite :=
  QP.Build_composite Struct nil noattr 0 0 0 0 true.
 
 Definition QPcomposite_env_of_composite_env :
-     composite_env -> PTree.t Z -> PTree.t legal_alignas_obs-> QP.composite_env :=
+     composite_env -> Maps.PTree.t Z -> Maps.PTree.t legal_alignas_obs-> QP.composite_env :=
  PTree_map3 QPcomposite_of_composite QPcomposite_bogus.
 
 Definition QPcomposite_env_OK: QP.composite_env -> Prop :=
@@ -94,8 +97,8 @@ red.
 rewrite <- PTree_Forall_get_eq.
 intro i.
 unfold QPcomposite_env_of_composite_env.
-rewrite PTree_gmap3 by auto.
-destruct ( ce ! i) eqn:?H; simpl; auto.
+rewrite -> PTree_gmap3 by auto.
+destruct (Maps.PTree.get i ce) eqn:?H; simpl; auto.
 +
   destruct (proj1 (PTree_domain_eq_e H _) (ex_intro _ _ H1)).
   rewrite H2.
@@ -103,8 +106,8 @@ destruct ( ce ! i) eqn:?H; simpl; auto.
   rewrite H3.
   apply QPcomposite_of_composite_OK.
 +
- destruct (ha_env ! i); auto.
- destruct (la_env ! i); auto. 
+ destruct (Maps.PTree.get i ha_env); auto.
+ destruct (Maps.PTree.get i la_env); auto.
 Qed.
 
 Fixpoint QP_list_helper 
@@ -137,20 +140,20 @@ Qed.
 Definition composite_env_of_QPcomposite_env'
    (ce: QP.composite_env)
    (H: QPcomposite_env_OK ce) : composite_env :=
- PTree_Properties.of_list
+ Maps.PTree_Properties.of_list
    (QP_list_helper _ (proj1 (PTree_Forall_elements _ _ _) H)).
 
 Fixpoint ce_of_QPce'
-   (ce: PTree.tree' QP.composite) :
-   PTree_Forall' QPcomposite_OK ce -> PTree.tree' composite := 
-match ce as t return (PTree_Forall' QPcomposite_OK t -> PTree.tree' composite) with
-| PTree.Node001 r => fun H => PTree.Node001 (ce_of_QPce' r H)
-| PTree.Node010 x => fun H => PTree.Node010 (composite_of_QPcomposite x H)
-| PTree.Node011 x r => fun H => PTree.Node011 (composite_of_QPcomposite x (proj1 H)) (ce_of_QPce' r (proj2 H))
-| PTree.Node100 l => fun H => PTree.Node100 (ce_of_QPce' l H)
-| PTree.Node101 l r => fun H => PTree.Node101 (ce_of_QPce' l (proj1 H)) (ce_of_QPce' r (proj2 H))
-| PTree.Node110 l x => fun H => PTree.Node110 (ce_of_QPce' l (proj1 H)) (composite_of_QPcomposite x (proj2 H))
-| PTree.Node111 l x r => fun H => PTree.Node111
+   (ce: Maps.PTree.tree' QP.composite) :
+   PTree_Forall' QPcomposite_OK ce -> Maps.PTree.tree' composite := 
+match ce as t return (PTree_Forall' QPcomposite_OK t -> Maps.PTree.tree' composite) with
+| Maps.PTree.Node001 r => fun H => Maps.PTree.Node001 (ce_of_QPce' r H)
+| Maps.PTree.Node010 x => fun H => Maps.PTree.Node010 (composite_of_QPcomposite x H)
+| Maps.PTree.Node011 x r => fun H => Maps.PTree.Node011 (composite_of_QPcomposite x (proj1 H)) (ce_of_QPce' r (proj2 H))
+| Maps.PTree.Node100 l => fun H => Maps.PTree.Node100 (ce_of_QPce' l H)
+| Maps.PTree.Node101 l r => fun H => Maps.PTree.Node101 (ce_of_QPce' l (proj1 H)) (ce_of_QPce' r (proj2 H))
+| Maps.PTree.Node110 l x => fun H => Maps.PTree.Node110 (ce_of_QPce' l (proj1 H)) (composite_of_QPcomposite x (proj2 H))
+| Maps.PTree.Node111 l x r => fun H => Maps.PTree.Node111
      (ce_of_QPce' l (proj1 H)) (composite_of_QPcomposite x (proj1 (proj2 H)))
             (ce_of_QPce' r (proj2 (proj2 H)))
 end.
@@ -162,35 +165,35 @@ match
   ce as t
   return
     (match t with
-     | PTree.Empty => True
-     | PTree.Nodes m' => PTree_Forall' QPcomposite_OK m'
+     | Maps.PTree.Empty => True
+     | Maps.PTree.Nodes m' => PTree_Forall' QPcomposite_OK m'
      end -> composite_env)
 with
-| PTree.Empty => fun _ : True => PTree.Empty
-| PTree.Nodes m =>
+| Maps.PTree.Empty => fun _ : True => Maps.PTree.Empty
+| Maps.PTree.Nodes m =>
     fun H0 : PTree_Forall' QPcomposite_OK m =>
-    PTree.Nodes (ce_of_QPce' m H0)
+    Maps.PTree.Nodes (ce_of_QPce' m H0)
 end H.
 
 Lemma composite_env_of_QPcomposite_env'_eq:
  forall ce H i,
-  PTree.get i (composite_env_of_QPcomposite_env' ce H) = 
-  PTree.get i (composite_env_of_QPcomposite_env ce H).
+  Maps.PTree.get i (composite_env_of_QPcomposite_env' ce H) = 
+  Maps.PTree.get i (composite_env_of_QPcomposite_env ce H).
 Proof.
 intros.
 unfold composite_env_of_QPcomposite_env'.
-destruct ((PTree_Properties.of_list
-   (QP_list_helper (PTree.elements ce)
+destruct (Maps.PTree.get i (Maps.PTree_Properties.of_list
+   (QP_list_helper (Maps.PTree.elements ce)
       (proj1 (PTree_Forall_elements QP.composite QPcomposite_OK ce)
-         H))) ! i) eqn:?H.
+         H)))) eqn:?H.
 -
-apply PTree_Properties.in_of_list in H0.
+apply  Maps.PTree_Properties.in_of_list in H0.
 assert (exists c' H', 
-  In (i,c') (PTree.elements ce) /\ c = composite_of_QPcomposite c' H'). {
- pose proof (PTree.elements_keys_norepet ce).
+  In (i,c') (Maps.PTree.elements ce) /\ c = composite_of_QPcomposite c' H'). {
+ pose proof (Maps.PTree.elements_keys_norepet ce).
  set (H2 := proj1 _ _) in H0.
  clearbody H2.
- revert H0 H1; induction (PTree.elements ce) as [|[??]]; intros.
+ revert H0 H1; induction (Maps.PTree.elements ce) as [|[??]]; intros.
  inv H0.
  specialize (IHl (Forall_inv_tail H2)).
  simpl in *.
@@ -207,10 +210,10 @@ set (H2 := proj1 _ _) in H0. clearbody H2.
 destruct H1 as [c' [? [? ?]]].
 subst.
 rename x into Hc'.
-pose proof (PTree.elements_complete _ _ _ H1).
+pose proof (Maps.PTree.elements_complete _ _ _ H1).
 clear - c' H3.
 destruct ce as [|ce]. inv H3.
-unfold PTree.get in *.
+unfold Maps.PTree.get in *.
 revert i H3; induction ce; destruct i; simpl; intros; try discriminate;
 try (apply IHce; auto);
 try (apply IHce2; auto);
@@ -220,23 +223,23 @@ try (inv H3; f_equal; f_equal; apply proof_irr).
 symmetry.
 set (H2 := proj1 _ _) in H0.
 clearbody H2.
-assert (ce ! i = None).
-destruct (ce ! i) eqn:?H; auto.
+assert (Maps.PTree.get i ce = None).
+destruct (Maps.PTree.get i ce) eqn:?H; auto.
 exfalso.
-apply PTree.elements_correct in H1.
-assert (In i (map fst  (QP_list_helper (PTree.elements ce) H2))). {
- clear - H1; induction (PTree.elements ce) as [|[??]].
+apply Maps.PTree.elements_correct in H1.
+assert (In i (map fst  (QP_list_helper (Maps.PTree.elements ce) H2))). {
+ clear - H1; induction (Maps.PTree.elements ce) as [|[??]].
  inv H1.
  specialize (IHl (Forall_inv_tail H2)).
  destruct H1. inv H. left; reflexivity.
  right; auto.
 }
-apply PTree_Properties.of_list_dom in H3.
+apply  Maps.PTree_Properties.of_list_dom in H3.
 destruct H3. congruence.
 clear - H1.
 hnf in H.
 destruct ce as [|ce]; simpl; auto.
-unfold PTree.get in *.
+unfold Maps.PTree.get in *.
 revert i H H1; induction ce; destruct i; simpl; intros; auto;
 try discriminate.
 Qed.
@@ -293,8 +296,8 @@ Lemma QPcomposite_env_of_composite_env_of_QPcomposite_env:
    (H : QPcomposite_env_OK ce),
    (QPcomposite_env_of_composite_env
     (composite_env_of_QPcomposite_env ce H)
-    (PTree.map1 QP.co_ha ce)
-    (PTree.map1 QP.co_la ce)) =
+    (Maps.PTree.map1 QP.co_ha ce)
+    (Maps.PTree.map1 QP.co_la ce)) =
   ce.
 Proof.
 destruct ce as [|ce]; simpl; intros; auto.
@@ -319,7 +322,7 @@ Proof. intros. inv H; auto. Qed.
 Lemma samedom_ha_composite_env_of_QPcomposite_env:
  forall ce OK, 
   PTree_samedom (composite_env_of_QPcomposite_env ce OK)
-     (PTree.map1 QP.co_ha ce).
+     (Maps.PTree.map1 QP.co_ha ce).
 Proof.
 intros.
 destruct ce as [|ce]. apply I.
@@ -331,7 +334,7 @@ Qed.
 Lemma samedom_la_composite_env_of_QPcomposite_env:
  forall ce OK, 
   PTree_samedom (composite_env_of_QPcomposite_env ce OK)
-     (PTree.map1 QP.co_la ce).
+     (Maps.PTree.map1 QP.co_la ce).
 Proof.
 intros.
 destruct ce as [|ce]. apply I.
@@ -342,32 +345,32 @@ Qed.
 
 Lemma get_composite_env_of_QPcomposite_env:
  forall ce OK i co,
-  (composite_env_of_QPcomposite_env ce OK) ! i = Some co 
-<-> exists ha, exists la, 
-  ce ! i = Some (QPcomposite_of_composite co ha la). 
+  Maps.PTree.get i (composite_env_of_QPcomposite_env ce OK) = Some co
+<-> exists ha, exists la,
+  Maps.PTree.get i ce = Some (QPcomposite_of_composite co ha la).
 Proof.
  intros.
  rewrite <- composite_env_of_QPcomposite_env'_eq.
  split; intro.
 -
- assert (H3: ce ! i <> None). {
+ assert (H3: Maps.PTree.get i ce <> None). {
  intro. unfold composite_env_of_QPcomposite_env' in H.
  set (H1 := proj1 _) in H. set (H2 := H1 OK) in H. clearbody H2; clear H1.
- apply PTree_Properties.in_of_list in H.
- assert (In i (map fst (PTree.elements ce))).
- revert H2 H; clear; induction (PTree.elements ce) as [|[??]]; simpl; intros; auto.
+ apply  Maps.PTree_Properties.in_of_list in H.
+ assert (In i (map fst (Maps.PTree.elements ce))).
+ revert H2 H; clear; induction (Maps.PTree.elements ce) as [|[??]]; simpl; intros; auto.
  destruct H. inv H. auto. right. apply (IHl (Forall_inv_tail H2)); auto.
  apply list_in_map_inv in H1. destruct H1 as [[??] [??]]; subst.
- simpl in H0. apply PTree.elements_complete in H3. congruence.
+ simpl in H0. apply Maps.PTree.elements_complete in H3. congruence.
  }
  pose proof (QPcomposite_env_of_composite_env_of_QPcomposite_env _ OK).
  rewrite <- H0.
- destruct (ce ! i) eqn:?H; try congruence; clear H3. clear H0.
+ destruct (Maps.PTree.get i ce) eqn:?H; try congruence; clear H3. clear H0.
  unfold QPcomposite_env_of_composite_env.
  rewrite PTree_gmap3.
- rewrite <- composite_env_of_QPcomposite_env'_eq. 
- rewrite H.  rewrite !PTree.gmap1. unfold option_map; rewrite H1.
- eauto. 
+ rewrite <- composite_env_of_QPcomposite_env'_eq.
+ rewrite H.  rewrite !Maps.PTree.gmap1. unfold option_map; rewrite H1.
+ eauto.
  apply samedom_ha_composite_env_of_QPcomposite_env.
  apply samedom_la_composite_env_of_QPcomposite_env.
 -
@@ -375,14 +378,14 @@ Proof.
  pose proof (QPcomposite_env_of_composite_env_of_QPcomposite_env _ OK).
  rewrite <- H0 in H; clear H0.
  unfold QPcomposite_env_of_composite_env in H.
- rewrite PTree_gmap3 in H; unfold option_map in H.
+ rewrite PTree_gmap3 in H.
  rewrite <- composite_env_of_QPcomposite_env'_eq in H.
- destruct ( (composite_env_of_QPcomposite_env' ce OK) ! i); try discriminate.
- destruct ((PTree.map1 QP.co_ha ce) ! i); try discriminate.
- destruct ((PTree.map1 QP.co_la ce) ! i); try discriminate.
+ destruct (Maps.PTree.get i (composite_env_of_QPcomposite_env' ce OK)); try discriminate.
+ destruct (Maps.PTree.get i (Maps.PTree.map1 QP.co_ha ce)); try discriminate.
+ destruct (Maps.PTree.get i(Maps.PTree.map1 QP.co_la ce)); try discriminate.
  apply Some_inj in H; apply QPcomposite_of_composite_inj in H; f_equal; tauto.
- destruct ((PTree.map1 QP.co_ha ce) ! i); try discriminate.
- destruct ((PTree.map1 QP.co_la ce) ! i); try discriminate.
+ destruct (Maps.PTree.get i(Maps.PTree.map1 QP.co_ha ce)); try discriminate.
+ destruct (Maps.PTree.get i(Maps.PTree.map1 QP.co_la ce)); try discriminate.
  apply samedom_ha_composite_env_of_QPcomposite_env.
  apply samedom_la_composite_env_of_QPcomposite_env.
 Qed.
@@ -390,8 +393,8 @@ Qed.
 Definition QPcompspecs_OK (ce: QP.composite_env) :=
   {H: QPcomposite_env_OK ce &
        let ce' := composite_env_of_QPcomposite_env ce H in
-       let ha' := (PTree.map1 QP.co_ha ce) in
-       let la' := (PTree.map1 QP.co_la ce) in
+       let ha' := (Maps.PTree.map1 QP.co_ha ce) in
+       let la' := (Maps.PTree.map1 QP.co_la ce) in
        composite_env_consistent ce' /\
        composite_env_legal_fieldlist ce' /\
        composite_env_complete_legal_cosu_type ce' /\
@@ -402,42 +405,42 @@ Definition QPcompspecs_OK (ce: QP.composite_env) :=
 
 Lemma hardware_alignof_env_completeQP:
  forall ce H, hardware_alignof_env_complete 
-                    (composite_env_of_QPcomposite_env ce H) (PTree.map1 QP.co_ha ce).
+                    (composite_env_of_QPcomposite_env ce H) (Maps.PTree.map1 QP.co_ha ce).
 Proof.
 intros.
 hnf; intros; split; intros [? ?].
 rewrite get_composite_env_of_QPcomposite_env in H0.
 destruct H0 as [? [? ?]].
-rewrite PTree.gmap1, H0. simpl. eauto.
-rewrite PTree.gmap1 in H0; unfold option_map in H0.
-destruct (ce ! i) eqn:?H; inv H0.
+rewrite Maps.PTree.gmap1, H0. simpl. eauto.
+rewrite Maps.PTree.gmap1 in H0; unfold option_map in H0.
+destruct (Maps.PTree.get i ce) eqn:?H; inv H0.
 pose proof H. red in H0. rewrite <- PTree_Forall_get_eq in H0.
 specialize (H0 i). rewrite H1 in H0.
 exists (composite_of_QPcomposite _ H0).
 rewrite get_composite_env_of_QPcomposite_env.
 do 2 eexists.
-rewrite QPcomposite_of_composite_of_QPcomposite.
+setoid_rewrite QPcomposite_of_composite_of_QPcomposite.
 assumption.
 Qed.
 
 
 Lemma legal_alignas_env_completeQP:
  forall ce H, legal_alignas_env_complete 
-                    (composite_env_of_QPcomposite_env ce H) (PTree.map1 QP.co_la ce).
+                    (composite_env_of_QPcomposite_env ce H) (Maps.PTree.map1 QP.co_la ce).
 Proof.
 intros.
 hnf; intros; split; intros [? ?].
 rewrite get_composite_env_of_QPcomposite_env in H0.
 destruct H0 as [? [? ?]].
-rewrite PTree.gmap1, H0. simpl. eauto.
-rewrite PTree.gmap1 in H0; unfold option_map in H0.
-destruct (ce ! i) eqn:?H; inv H0.
+rewrite Maps.PTree.gmap1, H0. simpl. eauto.
+rewrite Maps.PTree.gmap1 in H0; unfold option_map in H0.
+destruct (Maps.PTree.get i ce) eqn:?H; inv H0.
 pose proof H. red in H0. rewrite <- PTree_Forall_get_eq in H0.
 specialize (H0 i). rewrite H1 in H0.
 exists (composite_of_QPcomposite _ H0).
 rewrite get_composite_env_of_QPcomposite_env.
 do 2 eexists.
-rewrite QPcomposite_of_composite_of_QPcomposite.
+setoid_rewrite QPcomposite_of_composite_of_QPcomposite.
 assumption.
 Qed.
 
@@ -446,8 +449,8 @@ Definition compspecs_of_QPcomposite_env ce (H: QPcompspecs_OK ce) : compspecs
 match H with
 |  existT H0 (conj H1 (conj H3 (conj H5 (conj H7 (conj H9 H10))))) =>
     let ce' := composite_env_of_QPcomposite_env ce H0 in
-    let ha' := PTree.map1 QP.co_ha ce in
-    let la' := PTree.map1 QP.co_la ce in
+    let ha' := Maps.PTree.map1 QP.co_ha ce in
+    let la' := Maps.PTree.map1 QP.co_la ce in
     {|
     cenv_cs := ce';
     cenv_consistent := H1;
@@ -492,7 +495,7 @@ Qed.
 Lemma complete_legal_cosu_stable:
     forall env env' : composite_env,
        (forall (id : positive) (co : composite),
-        env ! id = Some co -> env' ! id = Some co) ->
+        Maps.PTree.get id env = Some co -> Maps.PTree.get id env' = Some co) ->
   forall m, composite_complete_legal_cosu_type env m = true ->
           composite_complete_legal_cosu_type env' m = true.
 Proof.
@@ -502,48 +505,48 @@ Proof.
   apply IHm in H2; clear IHm.
   rewrite andb_true_iff; split; auto.
   induction (type_member a); simpl in H1|-*; auto.
-  destruct (env ! i) eqn:?H; try discriminate; rewrite (H _ _ H0); auto.
-  destruct (env ! i) eqn:?H; try discriminate; rewrite (H _ _ H0); auto.
+  destruct (Maps.PTree.get i env) eqn:?H; try discriminate; rewrite (H _ _ H0); auto.
+  destruct (Maps.PTree.get i env) eqn:?H; try discriminate; rewrite (H _ _ H0); auto.
 Qed.
 
 Lemma sizeof_type_stable':
   forall env1 env t,
-     (forall id co,   env1 ! id = Some co -> env ! id = Some co) ->
+     (forall id co,   Maps.PTree.get id env1 = Some co -> Maps.PTree.get id env = Some co) ->
     @complete_legal_cosu_type env1 t = true ->
     @Ctypes.sizeof env1 t = @Ctypes.sizeof env t.
 Proof.
 induction t; simpl; intros; auto.
 f_equal; auto.
-destruct (env1 ! i) eqn:?H; try discriminate.
+destruct (Maps.PTree.get i env1) eqn:?H; try discriminate.
 rewrite (H _ _ H1). auto.
-destruct (env1 ! i) eqn:?H; try discriminate.
+destruct (Maps.PTree.get i env1) eqn:?H; try discriminate.
 rewrite (H _ _ H1). auto.
 Qed.
 
 Lemma hardware_alignof_type_stable': 
   forall  (env' env : composite_env)
-     (H:  forall id co,   env' ! id = Some co -> env ! id = Some co)
-     (ha_env ha_env' : PTree.t Z)
-     (H0: forall id  ofs,   ha_env' ! id = Some ofs -> ha_env ! id = Some ofs)
+     (H:  forall id co,   Maps.PTree.get id env' = Some co -> Maps.PTree.get id env = Some co)
+     (ha_env ha_env' : Maps.PTree.t Z)
+     (H0: forall id  ofs,   Maps.PTree.get id ha_env' = Some ofs -> Maps.PTree.get id ha_env = Some ofs)
      (H0: PTree_samedom env' ha_env'),
      forall t, complete_type env' t = true ->
        hardware_alignof ha_env' t = hardware_alignof ha_env t.
 Proof.
 induction t; simpl; intros; auto.
-destruct (env' ! i) eqn:?H; try discriminate.
+destruct (Maps.PTree.get i env') eqn:?H; try discriminate.
 destruct (proj1 (PTree_domain_eq_e H1 i)); eauto.
 rewrite H4. rewrite (H0 _ _ H4). auto.
-destruct (env' ! i) eqn:?H; try discriminate.
+destruct (Maps.PTree.get i env') eqn:?H; try discriminate.
 destruct (proj1 (PTree_domain_eq_e H1 i)); eauto.
 rewrite H4. rewrite (H0 _ _ H4). auto.
 Qed.
 
 Lemma field_offset_stable'':
-    forall (env1 env : PTree.t composite),
+    forall (env1 env : Maps.PTree.t composite),
        composite_env_consistent env1 ->
-       (forall id co, env1 ! id = Some co -> env ! id = Some co) ->
+       (forall id co, env1 !! id = Some co -> Maps.PTree.get id env = Some co) ->
        forall i co,
-       env1 ! i = Some co ->
+       env1 !! i = Some co ->
        forall j,
        field_offset env1 j (co_members co) = 
        field_offset env j (co_members co).
@@ -557,7 +560,7 @@ Lemma align_compatible_rec_stable':
  forall (env1 env: composite_env)
     (CONS: composite_env_consistent env1)
     (COSU: composite_env_complete_legal_cosu_type env1)
-    (S: forall id co, env1 ! id = Some co -> env ! id = Some co)
+    (S: forall id co, env1 !! id = Some co -> Maps.PTree.get id env = Some co)
    t ofs
    (H9a: @complete_legal_cosu_type env1 t = true) 
    (H: align_compatible_rec env1 t ofs),
@@ -618,17 +621,17 @@ Lemma hardware_alignof_composite_stable:
             (composite_env_of_QPcomposite_env ce1 OKce1))
     (HAce1 : hardware_alignof_env_consistent
           (composite_env_of_QPcomposite_env ce1 OKce1)
-          (PTree.map1 QP.co_ha ce1))
-    (ce : PTree.t QP.composite)
+          (Maps.PTree.map1 QP.co_ha ce1))
+    (ce : Maps.PTree.t QP.composite)
     (OKce : QPcomposite_env_OK ce)
     (HA1 : forall (i : positive) (ha : Z),
-      (PTree.map1 QP.co_ha ce1) ! i = Some ha ->
-      (PTree.map1 QP.co_ha ce) ! i = Some ha)
+      Maps.PTree.get i (Maps.PTree.map1 QP.co_ha ce1) = Some ha ->
+      Maps.PTree.get i (Maps.PTree.map1 QP.co_ha ce) = Some ha)
     i c
-  (H : (composite_env_of_QPcomposite_env ce OKce) ! i = Some c)
-  (H0 : (composite_env_of_QPcomposite_env ce1 OKce1) ! i = Some c),
-hardware_alignof_composite (PTree.map1 QP.co_ha ce1) (co_members c) =
-hardware_alignof_composite (PTree.map1 QP.co_ha ce) (co_members c).
+  (H : Maps.PTree.get i (composite_env_of_QPcomposite_env ce OKce) = Some c)
+  (H0 : Maps.PTree.get i (composite_env_of_QPcomposite_env ce1 OKce1) = Some c),
+hardware_alignof_composite (Maps.PTree.map1 QP.co_ha ce1) (co_members c) =
+hardware_alignof_composite (Maps.PTree.map1 QP.co_ha ce) (co_members c).
 Proof.
 intros.
   pose proof (co_consistent_complete _ _  (CONSce1 _ _ H0)).
@@ -640,59 +643,59 @@ intros.
   forget (type_member a) as t.
   type_induction.type_induction t (composite_env_of_QPcomposite_env ce1 OKce1) CONSce1; simpl; intros; auto.
   clear IH.
-  destruct ((composite_env_of_QPcomposite_env ce1 OKce1) ! id) eqn:?H; inv H1.
+  destruct (Maps.PTree.get id (composite_env_of_QPcomposite_env ce1 OKce1)) eqn:?H; inv H1.
   rewrite get_composite_env_of_QPcomposite_env in H. destruct H as [ha [la ?]].
   specialize (HA1 id ha).
-  rewrite !PTree.gmap1 in HA1|-*. unfold option_map in HA1|-*. rewrite H in *.
+  rewrite !Maps.PTree.gmap1 in HA1|-*. unfold option_map in HA1|-*. rewrite -> H in *.
   specialize (HA1 (eq_refl _)).
-  destruct (ce ! id) eqn:?H; inv HA1. reflexivity.
+  destruct (Maps.PTree.get id ce) eqn:?H; inv HA1. reflexivity.
   clear IH.
-  destruct ((composite_env_of_QPcomposite_env ce1 OKce1) ! id) eqn:?H; inv H1.
+  destruct (Maps.PTree.get id (composite_env_of_QPcomposite_env ce1 OKce1)) eqn:?H; inv H1.
   rewrite get_composite_env_of_QPcomposite_env in H. destruct H as [ha [la ?]].
   specialize (HA1 id ha).
-  rewrite !PTree.gmap1 in HA1|-*. unfold option_map in HA1|-*. rewrite H in *.
+  rewrite !Maps.PTree.gmap1 in HA1|-*. unfold option_map in HA1|-*. rewrite -> H in *.
   specialize (HA1 (eq_refl _)).
-  destruct (ce ! id) eqn:?H; inv HA1. reflexivity.
+  destruct (Maps.PTree.get id ce) eqn:?H; inv HA1. reflexivity.
 Qed.
 
 Lemma legal_alignas_type_stable:
  forall (ce1 : QP.composite_env)
     (OKce1 : QPcomposite_env_OK ce1)
    (CONSce1 : composite_env_consistent (composite_env_of_QPcomposite_env ce1 OKce1))
-   (ce : PTree.t QP.composite)
+   (ce : Maps.PTree.t QP.composite)
    (OKce : QPcomposite_env_OK ce)
    (SUB1 : forall (i : positive) (c : composite),
-       (composite_env_of_QPcomposite_env ce1 OKce1) ! i = Some c ->
-       (composite_env_of_QPcomposite_env ce OKce) ! i = Some c)
+       Maps.PTree.get i (composite_env_of_QPcomposite_env ce1 OKce1) = Some c ->
+       Maps.PTree.get i (composite_env_of_QPcomposite_env ce OKce) = Some c)
    (LA1 : forall (i : positive) (la : legal_alignas_obs),
-      (PTree.map1 QP.co_la ce1) ! i = Some la ->
-      (PTree.map1 QP.co_la ce) ! i = Some la)
+      Maps.PTree.get i (Maps.PTree.map1 QP.co_la ce1) = Some la ->
+      Maps.PTree.get i (Maps.PTree.map1 QP.co_la ce) = Some la)
    (t : type)
    (H1 : complete_type (composite_env_of_QPcomposite_env ce1 OKce1) t = true)
    (H4 : forall t : type,
      complete_type (composite_env_of_QPcomposite_env ce1 OKce1) t = true ->
-     hardware_alignof (PTree.map1 QP.co_ha ce1) t =
-     hardware_alignof (PTree.map1 QP.co_ha ce) t),
+     hardware_alignof (Maps.PTree.map1 QP.co_ha ce1) t =
+     hardware_alignof (Maps.PTree.map1 QP.co_ha ce) t),
 legal_alignas_type (composite_env_of_QPcomposite_env ce1 OKce1)
-  (PTree.map1 QP.co_ha ce1) (PTree.map1 QP.co_la ce1) t =
+  (Maps.PTree.map1 QP.co_ha ce1) (Maps.PTree.map1 QP.co_la ce1) t =
 legal_alignas_type (composite_env_of_QPcomposite_env ce OKce)
-  (PTree.map1 QP.co_ha ce) (PTree.map1 QP.co_la ce) t.
+  (Maps.PTree.map1 QP.co_ha ce) (Maps.PTree.map1 QP.co_la ce) t.
 Proof.
 intros.
  revert H1;
  type_induction.type_induction t (composite_env_of_QPcomposite_env ce1 OKce1) CONSce1; simpl; intros; auto.
- rewrite H4 by auto.
- rewrite IH by auto.
+ rewrite -> H4 by auto.
+ rewrite -> IH by auto.
   rewrite (sizeof_stable _ _ SUB1 _ H1).
  auto.
  clear IH.
  pose proof (proj1 (PTree_domain_eq_e (samedom_la_composite_env_of_QPcomposite_env ce1 OKce1) id)).
- destruct ((composite_env_of_QPcomposite_env ce1 OKce1) ! id) eqn:?H; inv H1.
+ destruct (Maps.PTree.get id (composite_env_of_QPcomposite_env ce1 OKce1)) eqn:?H; inv H1.
   spec H; [eauto |]. destruct H.
  unfold legal_alignas_obs in *;  rewrite H.
  rewrite (LA1 _ _ H). auto.
  pose proof (proj1 (PTree_domain_eq_e (samedom_la_composite_env_of_QPcomposite_env ce1 OKce1) id)).
- destruct ((composite_env_of_QPcomposite_env ce1 OKce1) ! id) eqn:?H; inv H1.
+ destruct (Maps.PTree.get id (composite_env_of_QPcomposite_env ce1 OKce1)) eqn:?H; inv H1.
  spec H; [eauto |]. destruct H.
  unfold legal_alignas_obs in *;  rewrite H.
  rewrite (LA1 _ _ H). auto.
@@ -706,25 +709,25 @@ Lemma legal_alignas_composite_stable:
             (composite_env_of_QPcomposite_env ce1 OKce1))
   (HAce1 : hardware_alignof_env_consistent
           (composite_env_of_QPcomposite_env ce1 OKce1)
-          (PTree.map1 QP.co_ha ce1))
-  (ce : PTree.t QP.composite)
+          (Maps.PTree.map1 QP.co_ha ce1))
+  (ce : Maps.PTree.t QP.composite)
   (OKce : QPcomposite_env_OK ce) 
   (SUB1 : forall (i : positive) (c : composite),
-       (composite_env_of_QPcomposite_env ce1 OKce1) ! i = Some c ->
-       (composite_env_of_QPcomposite_env ce OKce) ! i = Some c)
+       Maps.PTree.get i (composite_env_of_QPcomposite_env ce1 OKce1) = Some c ->
+       Maps.PTree.get i (composite_env_of_QPcomposite_env ce OKce) = Some c)
   (HA1 : forall (i : positive) (ha : Z),
-      (PTree.map1 QP.co_ha ce1) ! i = Some ha ->
-      (PTree.map1 QP.co_ha ce) ! i = Some ha)
+      Maps.PTree.get i (Maps.PTree.map1 QP.co_ha ce1) = Some ha ->
+      Maps.PTree.get i (Maps.PTree.map1 QP.co_ha ce) = Some ha)
   (LA1 : forall (i : positive) (la : legal_alignas_obs),
-      (PTree.map1 QP.co_la ce1) ! i = Some la ->
-      (PTree.map1 QP.co_la ce) ! i = Some la)
+      Maps.PTree.get i (Maps.PTree.map1 QP.co_la ce1) = Some la ->
+      Maps.PTree.get i (Maps.PTree.map1 QP.co_la ce) = Some la)
   i c
-  (H : (composite_env_of_QPcomposite_env ce OKce) ! i = Some c)
-  (H0 : (composite_env_of_QPcomposite_env ce1 OKce1) ! i = Some c),
+  (H : Maps.PTree.get i (composite_env_of_QPcomposite_env ce OKce) = Some c)
+  (H0 : Maps.PTree.get i (composite_env_of_QPcomposite_env ce1 OKce1) = Some c),
 legal_alignas_composite (composite_env_of_QPcomposite_env ce1 OKce1)
-  (PTree.map1 QP.co_ha ce1) (PTree.map1 QP.co_la ce1) c =
+  (Maps.PTree.map1 QP.co_ha ce1) (Maps.PTree.map1 QP.co_la ce1) c =
 legal_alignas_composite (composite_env_of_QPcomposite_env ce OKce)
-  (PTree.map1 QP.co_ha ce) (PTree.map1 QP.co_la ce) c.
+  (Maps.PTree.map1 QP.co_ha ce) (Maps.PTree.map1 QP.co_la ce) c.
 Proof.
 intros.
    unfold legal_alignas_composite.
@@ -736,12 +739,12 @@ intros.
   simpl in H1; rewrite andb_true_iff in H1; destruct H1.
   unfold legal_alignas_struct_members_rec.
   fold (legal_alignas_struct_members_rec (composite_env_of_QPcomposite_env ce1 OKce1)
-    (@PTree.map1 QP.composite Z QP.co_ha ce1)
-    (@PTree.map1 QP.composite legal_alignas_obs QP.co_la ce1)  m).
+    (@Maps.PTree.map1 QP.composite Z QP.co_ha ce1)
+    (@Maps.PTree.map1 QP.composite legal_alignas_obs QP.co_la ce1)  m).
  fold (legal_alignas_struct_members_rec (composite_env_of_QPcomposite_env _ OKce)
-    (@PTree.map1 QP.composite Z QP.co_ha ce)
-    (@PTree.map1 QP.composite legal_alignas_obs QP.co_la ce)  m).
-  rewrite IHm by auto; clear IHm.
+    (@Maps.PTree.map1 QP.composite Z QP.co_ha ce)
+    (@Maps.PTree.map1 QP.composite legal_alignas_obs QP.co_la ce)  m).
+  rewrite -> IHm by auto; clear IHm.
   pose proof (hardware_alignof_type_stable' _ _ SUB1 _ _ HA1).
   spec H4; [apply samedom_ha_composite_env_of_QPcomposite_env | ].
   rewrite !(next_field_stable _ _ SUB1 ofs _ H1).
@@ -749,18 +752,18 @@ intros.
    2:   eapply legal_alignas_type_stable; eauto.
   unfold legal_alignas_member.
   destruct a; auto.
-   rewrite !H4 by auto. f_equal. f_equal. unfold bitalignof. 
-  rewrite (alignof_stable _ _ SUB1) by auto. auto.
+   rewrite -> !H4 by auto. f_equal. f_equal. unfold bitalignof.
+  rewrite -> (alignof_stable _ _ SUB1) by auto. auto.
  *
   induction (co_members c); intros; auto.
   simpl in H1; rewrite andb_true_iff in H1; destruct H1.
   unfold legal_alignas_union_members_rec.
   fold (legal_alignas_union_members_rec (composite_env_of_QPcomposite_env ce1 OKce1)
-    (@PTree.map1 QP.composite Z QP.co_ha ce1)
-    (@PTree.map1 QP.composite legal_alignas_obs QP.co_la ce1)  m).
+    (@Maps.PTree.map1 QP.composite Z QP.co_ha ce1)
+    (@Maps.PTree.map1 QP.composite legal_alignas_obs QP.co_la ce1)  m).
  fold (legal_alignas_union_members_rec (composite_env_of_QPcomposite_env _ OKce)
-    (@PTree.map1 QP.composite Z QP.co_ha ce)
-    (@PTree.map1 QP.composite legal_alignas_obs QP.co_la ce)  m).
+    (@Maps.PTree.map1 QP.composite Z QP.co_ha ce)
+    (@Maps.PTree.map1 QP.composite legal_alignas_obs QP.co_la ce)  m).
  f_equal.
   eapply legal_alignas_type_stable; eauto.
   eapply hardware_alignof_type_stable'; eauto.
@@ -784,8 +787,8 @@ intros.
    unfold QPcomposite_env_OK in *; rewrite <- PTree_Forall_get_eq in *.
    intro i; apply (merge_PTrees_e i) in MERGE.
    specialize (OKce1 i). specialize (OKce2 i).
-   destruct (ce1 ! i) eqn:?H; auto;
-   destruct (ce2 ! i) eqn:?H; auto.
+   destruct (Maps.PTree.get i ce1) eqn:?H; auto;
+   destruct (Maps.PTree.get i ce2) eqn:?H; auto.
    destruct MERGE as [? [? ?]]. rewrite H2.
    destruct (QPcomposite_eq c c0) eqn:?H; inv H1; auto.
    rewrite MERGE; auto. 
@@ -794,67 +797,67 @@ intros.
  }
  red.
  exists OKce.
- assert (SUB1: forall i c, (composite_env_of_QPcomposite_env ce1 OKce1) ! i = Some c ->
-                      (composite_env_of_QPcomposite_env ce OKce) ! i = Some c). {
+ assert (SUB1: forall i c, Maps.PTree.get i (composite_env_of_QPcomposite_env ce1 OKce1) = Some c ->
+                      Maps.PTree.get i (composite_env_of_QPcomposite_env ce OKce) = Some c). {
  clear - MERGE. intros.
  apply (merge_PTrees_e i) in MERGE.
- rewrite get_composite_env_of_QPcomposite_env in H |- *.
+ rewrite !get_composite_env_of_QPcomposite_env in H |- *.
  destruct H as [? [? ?]]. rewrite H in MERGE.
- destruct (ce2 ! i) eqn:?H.
+ destruct (Maps.PTree.get i ce2) eqn:?H.
  destruct MERGE as [c' [? ?]].
  destruct (QPcomposite_eq _ _) eqn:?H in H1; inv H1. apply QPcomposite_eq_e in H3; subst. eauto.
  eauto.
 }
- assert (SUB2: forall i c, (composite_env_of_QPcomposite_env ce2 OKce2) ! i = Some c ->
-                      (composite_env_of_QPcomposite_env ce OKce) ! i = Some c). {
+ assert (SUB2: forall i c, Maps.PTree.get i (composite_env_of_QPcomposite_env ce2 OKce2) = Some c ->
+                      Maps.PTree.get i (composite_env_of_QPcomposite_env ce OKce) = Some c). {
  clear - MERGE. intros.
  apply (merge_PTrees_e i) in MERGE.
- rewrite get_composite_env_of_QPcomposite_env in H |- *.
+ rewrite !get_composite_env_of_QPcomposite_env in H |- *.
  destruct H as [? [? ?]]. rewrite H in MERGE.
- destruct (ce1 ! i) eqn:?H.
+ destruct (Maps.PTree.get i ce1) eqn:?H.
  destruct MERGE as [c' [? ?]].
  destruct (QPcomposite_eq _ _) eqn:?H in H1; inv H1. apply QPcomposite_eq_e in H3; subst. eauto.
  eauto.
 }
- assert (HA1: forall i ha, (PTree.map1 QP.co_ha ce1) ! i = Some ha ->
-                      (PTree.map1 QP.co_ha ce) ! i = Some ha). {
+ assert (HA1: forall i ha, Maps.PTree.get i (Maps.PTree.map1 QP.co_ha ce1) = Some ha ->
+                      Maps.PTree.get i (Maps.PTree.map1 QP.co_ha ce) = Some ha). {
  clear - MERGE. intros.
  apply (merge_PTrees_e i) in MERGE.
- rewrite PTree.gmap1 in H |- *; unfold option_map in *.
- destruct (ce1 ! i) eqn:?H; inv H.
- destruct (ce2 ! i) eqn:?H.
+ rewrite !Maps.PTree.gmap1 in H |- *; unfold option_map in *.
+ destruct (Maps.PTree.get i ce1) eqn:?H; inv H.
+ destruct (Maps.PTree.get i ce2) eqn:?H.
  destruct MERGE as [? [? ?]].
  destruct (QPcomposite_eq _ _) eqn:?H in H1; inv H1. rewrite H2; auto. rewrite MERGE; auto.
 }
- assert (HA2: forall i ha, (PTree.map1 QP.co_ha ce2) ! i = Some ha ->
-                      (PTree.map1 QP.co_ha ce) ! i = Some ha). {
+ assert (HA2: forall i ha, Maps.PTree.get i (Maps.PTree.map1 QP.co_ha ce2) = Some ha ->
+                      Maps.PTree.get i (Maps.PTree.map1 QP.co_ha ce) = Some ha). {
  clear - MERGE. intros.
  apply (merge_PTrees_e i) in MERGE.
- rewrite PTree.gmap1 in H |- *; unfold option_map in *.
- destruct (ce2 ! i) eqn:?H; inv H.
- destruct (ce1 ! i) eqn:?H.
+ rewrite !Maps.PTree.gmap1 in H |- *; unfold option_map in *.
+ destruct (Maps.PTree.get i ce2) eqn:?H; inv H.
+ destruct (Maps.PTree.get i ce1) eqn:?H.
  destruct MERGE as [? [? ?]].
  destruct (QPcomposite_eq c0 c) eqn:?H; inv H1.
  apply QPcomposite_eq_e in H3; subst. rewrite H2; auto.
   rewrite MERGE; auto.
 }
- assert (LA1: forall i la, (PTree.map1 QP.co_la ce1) ! i = Some la ->
-                      (PTree.map1 QP.co_la ce) ! i = Some la). {
+ assert (LA1: forall i la, Maps.PTree.get i (Maps.PTree.map1 QP.co_la ce1) = Some la ->
+                      Maps.PTree.get i (Maps.PTree.map1 QP.co_la ce) = Some la). {
  clear - MERGE. intros.
  apply (merge_PTrees_e i) in MERGE.
- rewrite PTree.gmap1 in H |- *; unfold option_map in *.
- destruct (ce1 ! i) eqn:?H; inv H.
- destruct (ce2 ! i) eqn:?H.
+ rewrite !Maps.PTree.gmap1 in H |- *; unfold option_map in *.
+ destruct (Maps.PTree.get i ce1) eqn:?H; inv H.
+ destruct (Maps.PTree.get i ce2) eqn:?H.
  destruct MERGE as [? [? ?]].
  destruct (QPcomposite_eq _ _) eqn:?H in H1; inv H1. rewrite H2; auto. rewrite MERGE; auto.
 }
- assert (LA2: forall i la, (PTree.map1 QP.co_la ce2) ! i = Some la ->
-                      (PTree.map1 QP.co_la ce) ! i = Some la). {
+ assert (LA2: forall i la, Maps.PTree.get i (Maps.PTree.map1 QP.co_la ce2) = Some la ->
+                      Maps.PTree.get i (Maps.PTree.map1 QP.co_la ce) = Some la). {
  clear - MERGE. intros.
  apply (merge_PTrees_e i) in MERGE.
- rewrite PTree.gmap1 in H |- *; unfold option_map in *.
- destruct (ce2 ! i) eqn:?H; inv H.
- destruct (ce1 ! i) eqn:?H.
+ rewrite !Maps.PTree.gmap1 in H |- *; unfold option_map in *.
+ destruct (Maps.PTree.get i ce2) eqn:?H; inv H.
+ destruct (Maps.PTree.get i ce1) eqn:?H.
  destruct MERGE as [? [? ?]].
  destruct (QPcomposite_eq c0 c) eqn:?H; inv H1.
  apply QPcomposite_eq_e in H3; subst. rewrite H2; auto.
@@ -869,9 +872,9 @@ intros.
  rewrite get_composite_env_of_QPcomposite_env in H1, H2.
  destruct H as [? [? ?]].
  rewrite H in MERGE.
- destruct (ce1 ! i) eqn:?H; destruct (ce2 ! i) eqn:?H.
+ destruct (Maps.PTree.get i ce1) eqn:?H; destruct (Maps.PTree.get i ce2) eqn:?H.
  destruct MERGE as [c' [? ?]].
- destruct (QPcomposite_eq c0 c1) eqn:?H in H4; inv H4. apply QPcomposite_eq_e in H6; subst c'. inv H5.
+ destruct (QPcomposite_eq c0 c1) eqn:?H in H4; inv H4. apply QPcomposite_eq_e in H6.
  eapply composite_consistent_stable. apply SUB1. apply H1; eauto.
  eapply composite_consistent_stable. apply SUB1. apply H1; eauto.
  eapply composite_consistent_stable. apply SUB2. apply H2; eauto.
@@ -884,9 +887,9 @@ intros.
  rewrite get_composite_env_of_QPcomposite_env in H1, H2.
  destruct H as [? [? ?]].
  rewrite H in MERGE.
- destruct (ce1 ! i) eqn:?H; destruct (ce2 ! i) eqn:?H.
+ destruct (Maps.PTree.get i ce1) eqn:?H; destruct (Maps.PTree.get i ce2) eqn:?H.
  destruct MERGE as [c' [? ?]].
- destruct (QPcomposite_eq c0 c1) eqn:?H in H4; inv H4. apply QPcomposite_eq_e in H6; subst c'. inv H5.
+ destruct (QPcomposite_eq c0 c1) eqn:?H in H4; inv H4. apply QPcomposite_eq_e in H6.
  eauto.
  eauto.
  eauto.
@@ -899,9 +902,9 @@ intros.
  rewrite get_composite_env_of_QPcomposite_env in H1, H2.
  destruct H as [? [? ?]].
  rewrite H in MERGE.
- destruct (ce1 ! i) eqn:?H; destruct (ce2 ! i) eqn:?H.
+ destruct (ce1 !! i) eqn:?H; destruct (ce2 !! i) eqn:?H.
  destruct MERGE as [c' [? ?]].
- destruct (QPcomposite_eq c0 c1) eqn:?H in H4; inv H4. apply QPcomposite_eq_e in H6; subst c'. inv H5.
+ destruct (QPcomposite_eq c0 c1) eqn:?H in H4; inv H4. apply QPcomposite_eq_e in H6.
  eapply complete_legal_cosu_stable. apply SUB1. apply H1; eauto.
  eapply complete_legal_cosu_stable. apply SUB1. apply H1; eauto.
  eapply complete_legal_cosu_stable. apply SUB2. apply H2; eauto.
@@ -910,20 +913,20 @@ intros.
  clear - HAce1 HAce2 MERGE HA1 HA2 SUB1 SUB2 CONSce1 CONSce2.
  intros i c ha ? H8; assert  (H1 := HAce1 i c ha); assert (H2 := HAce2 i c ha).
 (*   pose proof (co_consistent_complete _ _ CONSce1).*)
- assert ( (composite_env_of_QPcomposite_env _ OKce1) ! i = Some c /\ 
-              (PTree.map1 QP.co_ha ce1) ! i = Some ha 
-   \/ (composite_env_of_QPcomposite_env _ OKce2) ! i = Some c /\ 
-              (PTree.map1 QP.co_ha ce2) ! i = Some ha ). {
+ assert ( (composite_env_of_QPcomposite_env _ OKce1) !! i = Some c /\ 
+              Maps.PTree.get i (Maps.PTree.map1 QP.co_ha ce1) = Some ha 
+   \/ (composite_env_of_QPcomposite_env _ OKce2) !! i = Some c /\ 
+              Maps.PTree.get i (Maps.PTree.map1 QP.co_ha ce2) = Some ha ). {
    clear - MERGE H H8.
-   rewrite !PTree.gmap1 in *. unfold option_map in *.
+   rewrite !Maps.PTree.gmap1 in *. unfold option_map in *.
    apply (merge_PTrees_e i) in MERGE.
    rewrite get_composite_env_of_QPcomposite_env in H.
    rewrite !get_composite_env_of_QPcomposite_env.
    destruct H as [? [? ?]].
    rewrite H in MERGE.
-   assert (ce1 ! i = ce ! i \/ ce2 ! i = ce ! i). {
+   assert (ce1 !! i = ce !! i \/ ce2 !! i = ce !! i). {
      clear - MERGE H. 
-     destruct (ce1 ! i) eqn:?H; destruct (ce2 ! i) eqn:?H.
+     destruct (ce1 !! i) eqn:?H; destruct (ce2 !! i) eqn:?H.
      destruct MERGE as [c' [? ?]].
      destruct (QPcomposite_eq _ _) eqn:?H in H2; inv H2. apply QPcomposite_eq_e in H4; subst.
      left; congruence. left; congruence. right; congruence. inv MERGE.
@@ -942,20 +945,20 @@ intros.
 - (* legal_alignas_env_consistent *)
 (* clear - HAce1 HAce2 MERGE HA1 HA2 LA1 LA2 SUB1 SUB2 CONSce1 CONSce2. *)
   intros i c la ? H8.
- assert ( (composite_env_of_QPcomposite_env _ OKce1) ! i = Some c /\ 
-              (PTree.map1 QP.co_la ce1) ! i = Some la 
-   \/ (composite_env_of_QPcomposite_env _ OKce2) ! i = Some c /\ 
-              (PTree.map1 QP.co_la ce2) ! i = Some la ). {
+ assert ( (composite_env_of_QPcomposite_env _ OKce1) !! i = Some c /\ 
+              Maps.PTree.get i (Maps.PTree.map1 QP.co_la ce1) = Some la 
+   \/ (composite_env_of_QPcomposite_env _ OKce2) !! i = Some c /\ 
+              (Maps.PTree.map1 QP.co_la ce2) !! i = Some la ). {
    clear - MERGE H H8.
-   rewrite !PTree.gmap1 in *. unfold option_map in *.
+   rewrite !Maps.PTree.gmap1 in *. unfold option_map in *.
    apply (merge_PTrees_e i) in MERGE.
    rewrite get_composite_env_of_QPcomposite_env in H.
    rewrite !get_composite_env_of_QPcomposite_env.
    destruct H as [? [? ?]].
    rewrite H in MERGE.
-   assert (ce1 ! i = ce ! i \/ ce2 ! i = ce ! i). {
+   assert (ce1 !! i = ce !! i \/ ce2 !! i = ce !! i). {
      clear - MERGE H. 
-     destruct (ce1 ! i) eqn:?H; destruct (ce2 ! i) eqn:?H.
+     destruct (ce1 !! i) eqn:?H; destruct (ce2 !! i) eqn:?H.
      destruct MERGE as [c' [? ?]].
      destruct (QPcomposite_eq _ _) eqn:?H in H2; inv H2. apply QPcomposite_eq_e in H4; subst.
      left; congruence. left; congruence. right; congruence. inv MERGE.
@@ -975,13 +978,13 @@ intros.
  assert (H9:
   forall t ofs, 
   @complete_legal_cosu_type (composite_env_of_QPcomposite_env _ OKce) t = true -> 
-   is_aligned (composite_env_of_QPcomposite_env _ OKce) (PTree.map1 QP.co_ha ce) (PTree.map1 QP.co_la ce)
+   is_aligned (composite_env_of_QPcomposite_env _ OKce) (Maps.PTree.map1 QP.co_ha ce) (Maps.PTree.map1 QP.co_la ce)
       t ofs = true ->
   @complete_legal_cosu_type (composite_env_of_QPcomposite_env _ OKce1) t = true /\
-  is_aligned (composite_env_of_QPcomposite_env _ OKce1) (PTree.map1 QP.co_ha ce1) (PTree.map1 QP.co_la ce1) t ofs = true
+  is_aligned (composite_env_of_QPcomposite_env _ OKce1) (Maps.PTree.map1 QP.co_ha ce1) (Maps.PTree.map1 QP.co_la ce1) t ofs = true
  \/ 
 @complete_legal_cosu_type (composite_env_of_QPcomposite_env _ OKce2) t = true /\
-  is_aligned (composite_env_of_QPcomposite_env _ OKce2) (PTree.map1 QP.co_ha ce2) (PTree.map1 QP.co_la ce2) t ofs = true). {
+  is_aligned (composite_env_of_QPcomposite_env _ OKce2) (Maps.PTree.map1 QP.co_ha ce2) (Maps.PTree.map1 QP.co_la ce2) t ofs = true). {
  induction t; simpl; intros; auto.
  - 
     specialize (IHt ofs H).
@@ -1003,20 +1006,20 @@ intros.
     apply samedom_ha_composite_env_of_QPcomposite_env.
     apply complete_legal_cosu_type_complete_type; auto.
  -
-   destruct ((composite_env_of_QPcomposite_env ce OKce) ! i) eqn:?H; try discriminate H.
+   destruct (Maps.PTree.get i (composite_env_of_QPcomposite_env ce OKce)) eqn:?H; try discriminate H.
    destruct (co_su c) eqn:?H; try discriminate H.
    rename H into PLAIN.
- assert ( (composite_env_of_QPcomposite_env _ OKce1) ! i = Some c
-   \/ (composite_env_of_QPcomposite_env _ OKce2) ! i = Some c ). {
+ assert ( (composite_env_of_QPcomposite_env _ OKce1) !! i = Some c
+   \/ (composite_env_of_QPcomposite_env _ OKce2) !! i = Some c ). {
    clear - MERGE H1.
    apply (merge_PTrees_e i) in MERGE.
    rewrite get_composite_env_of_QPcomposite_env in H1.
    rewrite !get_composite_env_of_QPcomposite_env.
    destruct H1 as [? [? ?]].
    rewrite H in MERGE.
-   assert (ce1 ! i = ce ! i \/ ce2 ! i = ce ! i). {
+   assert (ce1 !! i = ce !! i \/ ce2 !! i = ce !! i). {
      clear - MERGE H. 
-     destruct (ce1 ! i) eqn:?H; destruct (ce2 ! i) eqn:?H.
+     destruct (ce1 !! i) eqn:?H; destruct (ce2 !! i) eqn:?H.
      destruct MERGE as [c' [? ?]].
      destruct (QPcomposite_eq _ _) eqn:?H in H2; inv H2. apply QPcomposite_eq_e in H4; subst.
      left; congruence. left; congruence. right; congruence. inv MERGE.
@@ -1030,43 +1033,43 @@ intros.
    rewrite get_composite_env_of_QPcomposite_env in *.
    destruct H1 as [ha [la ?]]. destruct H as [ha' [la' ?]].
    pose proof (HA1 i ha'). pose proof (LA1 i la').
-   rewrite !PTree.gmap1 in H0. 
-   rewrite !PTree.gmap1 in H3. 
-   rewrite !PTree.gmap1 in H4. 
-   rewrite !PTree.gmap1.
+   rewrite !Maps.PTree.gmap1 in H0. 
+   rewrite !Maps.PTree.gmap1 in H3. 
+   rewrite !Maps.PTree.gmap1 in H4. 
+   rewrite !Maps.PTree.gmap1.
    unfold option_map in *. rewrite H in *.  
    specialize (H3 (eq_refl _)).
    specialize (H4 (eq_refl _)).   
     simpl QP.co_ha in *; simpl QP.co_la  in *.
-   destruct  (ce ! i) eqn:?H; inv H3. inv H4. inv H1. simpl in H.  auto.
+   destruct  (Maps.PTree.get i ce) eqn:?H; inv H3. simpl in H. auto.
  +
    unfold is_aligned in *; simpl in *; unfold is_aligned_aux in *.
    rewrite get_composite_env_of_QPcomposite_env in *.
    destruct H1 as [ha [la ?]]. destruct H as [ha' [la' ?]].
    pose proof (HA2 i ha'). pose proof (LA2 i la').
-   rewrite !PTree.gmap1 in H0. 
-   rewrite !PTree.gmap1 in H3. 
-   rewrite !PTree.gmap1 in H4. 
-   rewrite !PTree.gmap1.
+   rewrite !Maps.PTree.gmap1 in H0. 
+   rewrite !Maps.PTree.gmap1 in H3. 
+   rewrite !Maps.PTree.gmap1 in H4. 
+   rewrite !Maps.PTree.gmap1.
    unfold option_map in *. rewrite H in *.  
    specialize (H3 (eq_refl _)).
    specialize (H4 (eq_refl _)).
     simpl.
-   destruct  (ce ! i) eqn:?H; inv H3. inv H4. inv H1. simpl in H.  auto.
+   destruct  (Maps.PTree.get i ce) eqn:?H; inv H3. simpl in H.  auto.
  -
- destruct ((composite_env_of_QPcomposite_env ce OKce) ! i) eqn:?H; inv H.
+ destruct (Maps.PTree.get i (composite_env_of_QPcomposite_env ce OKce)) eqn:?H; inv H.
  destruct (co_su c) eqn:?H; try discriminate.
- assert ( (composite_env_of_QPcomposite_env _ OKce1) ! i = Some c
-   \/ (composite_env_of_QPcomposite_env _ OKce2) ! i = Some c ). {
+ assert ( (composite_env_of_QPcomposite_env _ OKce1) !! i = Some c
+   \/ (composite_env_of_QPcomposite_env _ OKce2) !! i = Some c ). {
    clear - MERGE H1.
    apply (merge_PTrees_e i) in MERGE.
    rewrite get_composite_env_of_QPcomposite_env in H1.
    rewrite !get_composite_env_of_QPcomposite_env.
    destruct H1 as [? [? ?]].
    rewrite H in MERGE.
-   assert (ce1 ! i = ce ! i \/ ce2 ! i = ce ! i). {
+   assert (ce1 !! i = ce !! i \/ ce2 !! i = ce !! i). {
      clear - MERGE H. 
-     destruct (ce1 ! i) eqn:?H; destruct (ce2 ! i) eqn:?H.
+     destruct (ce1 !! i) eqn:?H; destruct (ce2 !! i) eqn:?H.
      destruct MERGE as [c' [? ?]].
      destruct (QPcomposite_eq _ _) eqn:?H in H2; inv H2. apply QPcomposite_eq_e in H4; subst.
      left; congruence. left; congruence. right; congruence. inv MERGE.
@@ -1080,27 +1083,27 @@ intros.
    rewrite get_composite_env_of_QPcomposite_env in *.
    destruct H1 as [ha [la ?]]. destruct H2 as [ha' [la' ?]].
    pose proof (HA1 i ha'). pose proof (LA1 i la').
-   rewrite !PTree.gmap1 in H0. 
-   rewrite !PTree.gmap1 in H4. 
-   rewrite !PTree.gmap1 in H5. 
-   rewrite !PTree.gmap1.
+   rewrite !Maps.PTree.gmap1 in H0. 
+   rewrite !Maps.PTree.gmap1 in H4. 
+   rewrite !Maps.PTree.gmap1 in H5. 
+   rewrite !Maps.PTree.gmap1.
    unfold option_map in *. rewrite H1,H2 in *.
    specialize (H4 (eq_refl _)).
    specialize (H5 (eq_refl _)).
-    simpl. inv H4; inv H5. simpl in H0. rewrite H3. auto.
+    simpl. inv H4. simpl in H0. rewrite H3. auto.
  +
    unfold is_aligned in *; simpl in *; unfold is_aligned_aux in *.
    rewrite get_composite_env_of_QPcomposite_env in *.
    destruct H1 as [ha [la ?]]. destruct H2 as [ha' [la' ?]].
    pose proof (HA2 i ha'). pose proof (LA2 i la').
-   rewrite !PTree.gmap1 in H0. 
-   rewrite !PTree.gmap1 in H4. 
-   rewrite !PTree.gmap1 in H5. 
-   rewrite !PTree.gmap1.
+   rewrite !Maps.PTree.gmap1 in H0. 
+   rewrite !Maps.PTree.gmap1 in H4. 
+   rewrite !Maps.PTree.gmap1 in H5. 
+   rewrite !Maps.PTree.gmap1.
    unfold option_map in *. rewrite H1,H2 in *.
    specialize (H4 (eq_refl _)).
    specialize (H5 (eq_refl _)).
-    simpl. inv H4; inv H5. simpl in H0. rewrite H3; auto.
+    simpl. inv H4. simpl in H0. rewrite H3; auto.
  }
   hnf; intros.
   destruct (H9 _ _ H H0) as [[??]|[??]]; clear H9.
@@ -1113,20 +1116,20 @@ intros.
 Qed.
 
 Lemma tree'_not_empty':
-  forall {A} (m: PTree.tree' A),
-   exists i, isSome (PTree.get' i m) = True.
+  forall {A} (m: Maps.PTree.tree' A),
+   exists i, isSome (Maps.PTree.get' i m) = True%type.
 Proof.
 intros.
-destruct (PTree.tree'_not_empty m) as [i ?].
+destruct (Maps.PTree.tree'_not_empty m) as [i ?].
 exists i.
-destruct (PTree.get' i m). reflexivity. congruence.
+destruct (Maps.PTree.get' i m). reflexivity. congruence.
 Qed. 
 
-Lemma PTree_samedom_i {A} {B} (m1: PTree.t A) (m2: PTree.t B):
- (forall i, isSome (m1 ! i) = isSome (m2 ! i)) ->
+Lemma PTree_samedom_i {A} {B} (m1: Maps.PTree.t A) (m2: Maps.PTree.t B):
+ (forall i, isSome (m1 !! i) = isSome (m2 !! i)) ->
  PTree_samedom m1 m2.
 Proof.
-destruct m1 as [|m1], m2 as [|m2]; simpl; intros; auto; unfold PTree.get in H.
+destruct m1 as [|m1], m2 as [|m2]; simpl; intros; auto; unfold Maps.PTree.get in H.
 destruct (tree'_not_empty' m2) as [i ?]. specialize (H i). rewrite H, H0; auto.
 destruct (tree'_not_empty' m1) as [i ?]. specialize (H i). rewrite <- H, H0; auto.
 revert m2 H; induction m1; destruct m2; simpl; intros;
@@ -1201,7 +1204,7 @@ Proof.
   intro cs.
   apply PTree_samedom_i. intro i.
   pose proof (@ha_env_cs_complete cs i).
-  destruct (cenv_cs ! i), (ha_env_cs ! i); auto.
+  destruct (cenv_cs !! i), (ha_env_cs !! i); auto.
   destruct H as [[? ?] _]; eauto. inv H.
   destruct H as [_ [? ?]]; eauto. inv H.
 Qed.
@@ -1211,7 +1214,7 @@ Proof.
   intro cs.
   apply PTree_samedom_i. intro i.
   pose proof (@la_env_cs_complete cs i).
-  destruct (cenv_cs ! i), (la_env_cs ! i); auto.
+  destruct (cenv_cs !! i), (la_env_cs !! i); auto.
   destruct H as [[? ?] _]; eauto. inv H.
   destruct H as [_ [? ?]]; eauto. inv H.
 Qed.
@@ -1257,15 +1260,15 @@ Lemma QPcompspecs_OK_e:
   (H: QPcompspecs_OK ce),
  let cs := compspecs_of_QPcomposite_env _ H in
     @cenv_cs cs = (composite_env_of_QPcomposite_env ce (projT1 H))
-  /\ @ha_env_cs cs = PTree.map1 QP.co_ha ce 
-  /\ @la_env_cs cs = PTree.map1 QP.co_la ce.
+  /\ @ha_env_cs cs = Maps.PTree.map1 QP.co_ha ce 
+  /\ @la_env_cs cs = Maps.PTree.map1 QP.co_la ce.
 Proof.
 intros.
 destruct H.
 simpl.
 set (ce' := composite_env_of_QPcomposite_env ce x) in *.
-set (ha' :=  PTree.map1 QP.co_ha ce) in *.
-set (la' := PTree.map1 QP.co_la ce) in *.
+set (ha' :=  Maps.PTree.map1 QP.co_ha ce) in *.
+set (la' := Maps.PTree.map1 QP.co_la ce) in *.
 destruct a as [? [? [? [? [? ?]]]]].
 pose proof (hardware_alignof_env_completeQP _ x).
 pose proof (legal_alignas_env_completeQP _ x).
@@ -1285,18 +1288,18 @@ destruct (QPcompspecs_OK_e _ OK2) as [?H [?H ?H]].
 simpl in *.
 split3; intros ?; specialize (H i); unfold sub_option, tycontext.sub_option in *.
 rewrite H0, H3.
-destruct ( (composite_env_of_QPcomposite_env ce1 (projT1 OK1)) ! i) eqn:?H; auto.
+destruct (Maps.PTree.get i  (composite_env_of_QPcomposite_env ce1 (projT1 OK1))) eqn:?H; auto.
 rewrite get_composite_env_of_QPcomposite_env in H6|-*.
 destruct H6 as [ha [la ?]]; exists ha, la.
 rewrite H6 in H. auto.
 rewrite H1, H4.
-rewrite !PTree.gmap1.
+rewrite !Maps.PTree.gmap1.
 unfold option_map.
-destruct (ce1 ! i) eqn:?H; auto. rewrite H; auto.
+destruct (Maps.PTree.get i ce1) eqn:?H; auto. rewrite H; auto.
 rewrite H2, H5.
-rewrite !PTree.gmap1.
+rewrite !Maps.PTree.gmap1.
 unfold option_map.
-destruct (ce1 ! i) eqn:?H; auto. rewrite H; auto.
+destruct (Maps.PTree.get i ce1) eqn:?H; auto. rewrite H; auto.
 Qed.
 
 Fixpoint put_at_nth (i: nat) (c: ident * QP.composite) (rl: list (list (ident * QP.composite))) : list (list (ident * QP.composite)) :=
@@ -1322,11 +1325,11 @@ Definition cenv_built_correctly_each
      (cd: composite_definition) (tr: Errors.res composite_env)  :=
                 Errors.bind tr (fun ce' => 
                 match cd with Composite i su mems att =>
-                 match PTree.get i ce' with 
+                 match Maps.PTree.get i ce' with 
                  | None => Errors.Error [Errors.MSG "Composite identifier duplicate or not found in composite_env:";
                                                        Errors.POS i]
                  | Some c =>
-                             let d := PTree.remove i ce' in
+                             let d := Maps.PTree.remove i ce' in
                              let m := c.(co_members) in 
                              if (eqb_su su c.(co_su)
                              && eqb_list eqb_member mems m
@@ -1336,13 +1339,13 @@ Definition cenv_built_correctly_each
                              && Z.eqb (align_attr att (alignof_composite d m)) c.(co_alignof)
                              && Nat.eqb (rank_members d m) c.(co_rank)
                               )%bool
-                              then Errors.OK (PTree.remove i ce')
+                              then Errors.OK (Maps.PTree.remove i ce')
                               else Errors.Error [Errors.MSG "Composite definition does not match:";
                                                           Errors.POS i]
                 end end).
 
 Definition cenv_built_correctly_finish (ce': composite_env) :=
-   let leftovers := PTree.elements ce' in
+   let leftovers := Maps.PTree.elements ce' in
    if Nat.eqb (List.length leftovers) O
    then Errors.OK tt
    else Errors.Error (Errors.MSG "Composite_env contains extra identifiers:" ::
@@ -1366,26 +1369,26 @@ unfold cenv_built_correctly in H.
 unfold Errors.bind in H.
 destruct (fold_right cenv_built_correctly_each (Errors.OK ce) comps) eqn:?H; [ | discriminate].
 unfold cenv_built_correctly_finish in H.
-destruct (PTree.elements c) eqn:?H; [ | inv H].
+destruct (Maps.PTree.elements c) eqn:?H; [ | inv H].
 clear H.
-assert (c = PTree.empty _). {
- apply PTree.extensionality.
- intro i. destruct (c ! i) eqn:?H; auto.
-  apply PTree.elements_correct in H. rewrite H1 in H; inv H.
+assert (c = Maps.PTree.empty _). {
+ apply Maps.PTree.extensionality.
+ intro i. destruct (Maps.PTree.get i c) eqn:?H; auto.
+  apply Maps.PTree.elements_correct in H. rewrite H1 in H; inv H.
 }
 subst c. clear H1.
-forget (PTree.empty composite) as d.
+forget (Maps.PTree.empty composite) as d.
 rename H0 into H.
 rename d into c.
 revert ce c H.
-forget (PTree.empty composite) as d.
+forget (Maps.PTree.empty composite) as d.
 induction comps; simpl; intros.
 auto.
 destruct a.
 destruct (fold_right cenv_built_correctly_each (Errors.OK ce) comps) eqn:?H;
   try discriminate.
 simpl in H.
-destruct (c0 ! id) eqn:?H; try discriminate.
+destruct (c0 !! id) eqn:?H; try discriminate.
 match type of H with ((if ?A then _ else _) = _) =>
   destruct A eqn:?H;  [ | discriminate H]
 end.
@@ -1401,12 +1404,12 @@ inv H.
 unfold Errors.bind.
 clear d. rename c0 into d.
 rewrite composite_of_def_eq; auto.
-replace  (PTree.set id c1 (PTree.remove id d)) with d.
+replace  (Maps.PTree.set id c1 (Maps.PTree.remove id d)) with d.
 auto.
-apply PTree.extensionality.
-intro i. destruct (ident_eq i id). subst. rewrite PTree.gss. auto. rewrite PTree.gso by auto. rewrite PTree.gro by auto; auto.
+apply Maps.PTree.extensionality.
+intro i. destruct (ident_eq i id). subst. rewrite Maps.PTree.gss. auto. rewrite Maps.PTree.gso by auto. rewrite Maps.PTree.gro by auto; auto.
 constructor; auto.
-rewrite PTree.grs.
+rewrite Maps.PTree.grs.
 auto.
 Qed.
 
@@ -1416,25 +1419,3 @@ Proof.
 destruct ce as [|ce]; simpl; auto. 
 induction ce; simpl; intros; auto.
 Qed.
-
-(*
-Lemma rebuild_composite_env:
-  forall (ce: QP.composite_env) (OK: QPcomposite_env_OK ce),
- build_composite_env
-    (map compdef_of_compenv_element (sort_rank (PTree.elements ce) nil)) =
-  Errors.OK (composite_env_of_QPcomposite_env ce OK).
-Proof.
-intros.
-apply cenv_built_correctly_e.
-
-apply test_PTree_canonical_e in CAN.
-unfold build_composite_env.
-assert (CAN' := @PTree_canonical_empty composite).
-pose proof (proj1 (PTree_Forall_elements _ _ _) OK).
-
-
-
-Admitted.  (* Probably true *)
-*)
-
-
diff --git a/floyd/SeparationLogicAsLogic.v b/floyd/SeparationLogicAsLogic.v
index bfa1216e31..e7a0d11f04 100644
--- a/floyd/SeparationLogicAsLogic.v
+++ b/floyd/SeparationLogicAsLogic.v
@@ -1,19 +1,19 @@
 From compcert Require Export Clightdefs.
 Require Export VST.veric.base.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Export VST.veric.SeparationLogic.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Export VST.msl.Extensionality.
 Require Export compcert.lib.Coqlib.
 Require Export VST.msl.Coqlib2 VST.veric.coqlib4 VST.floyd.coqlib3.
 Require Export VST.floyd.jmeq_lemmas.
 Require Export VST.floyd.find_nth_tactic.
 Require Export VST.veric.juicy_extspec.
-Require Import VST.veric.NullExtension.
 Require Import VST.floyd.val_lemmas VST.floyd.assert_lemmas.
 Require Import VST.floyd.SeparationLogicFacts.
-Import LiftNotation.
-Import compcert.lib.Maps.
 Import Ctypes LiftNotation.
-Local Open Scope logic.
+
+Open Scope maps.
 
 Fixpoint all_suf_of_labeled_statements (P: labeled_statements -> Prop) (L: labeled_statements): Prop :=
   match L with
@@ -135,159 +135,160 @@ Module AuxDefs.
 
 Section AuxDefs.
 
-Variable semax_external: forall {Hspec: OracleKind} (ef: external_function) (A : rmaps.TypeTree)
-       (P: forall ts : list Type, functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts (ArgsTT A)) mpred)
-       (Q: forall ts : list Type, functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts (AssertTT A)) mpred), Prop.
+Variable semax_external: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} (ef: external_function) (A : TypeTree)
+       (E: @dtfr Σ (MaskTT A))
+       (P: @dtfr Σ (ArgsTT A))
+       (Q: @dtfr Σ (AssertTT A)), mpred.
 
-Inductive semax {CS: compspecs} {Espec: OracleKind} (Delta: tycontext): (environ -> mpred) -> statement -> ret_assert -> Prop :=
+Inductive semax `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} (E: coPset) (Delta: tycontext): assert -> statement -> ret_assert -> Prop :=
 | semax_ifthenelse :
-   forall P (b: expr) c d R,
-     @semax CS Espec Delta (P && local (`(typed_true (typeof b)) (eval_expr b))) c R ->
-     @semax CS Espec Delta (P && local (`(typed_false (typeof b)) (eval_expr b))) d R ->
-     @semax CS Espec Delta (!! (bool_type (typeof b) = true) && |> (tc_expr Delta (Eunop Cop.Onotbool b (Tint I32 Signed noattr)) && P)) (Sifthenelse b c d) R
+   forall (P: assert) (b: expr) c d R,
+     semax E Delta (P ∧ local (`(typed_true (typeof b)) (eval_expr b))) c R ->
+     semax E Delta (P ∧ local (`(typed_false (typeof b)) (eval_expr b))) d R ->
+     semax E Delta (⌜bool_type (typeof b) = true⌝ ∧ ▷ (tc_expr Delta (Eunop Cop.Onotbool b (Tint I32 Signed noattr)) ∧ P)) (Sifthenelse b c d) R
 | semax_seq:
-  forall R P Q h t,
-    @semax CS Espec Delta P h (overridePost Q R) ->
-    @semax CS Espec Delta Q t R ->
-    @semax CS Espec Delta P (Ssequence h t) R
+  forall R (P Q: assert) h t,
+    semax E Delta P h (overridePost Q R) ->
+    semax E Delta Q t R ->
+    semax E Delta P (Ssequence h t) R
 | semax_break: forall Q,
-    @semax CS Espec Delta (RA_break Q) Sbreak Q
+    semax E Delta (RA_break Q) Sbreak Q
 | semax_continue: forall Q,
-    @semax CS Espec Delta (RA_continue Q) Scontinue Q
+    semax E Delta (RA_continue Q) Scontinue Q
 | semax_loop: forall Q Q' incr body R,
-     @semax CS Espec Delta  Q body (loop1_ret_assert Q' R) ->
-     @semax CS Espec Delta Q' incr (loop2_ret_assert Q R) ->
-     @semax CS Espec Delta Q (Sloop body incr) R
-| semax_switch: forall (Q: environ->mpred) a sl R,
-     (forall rho, Q rho |-- tc_expr Delta a rho) ->
+     semax E Delta  Q body (loop1_ret_assert Q' R) ->
+     semax E Delta Q' incr (loop2_ret_assert Q R) ->
+     semax E Delta Q (Sloop body incr) R
+| semax_switch: forall (Q: assert) a sl R,
+     (Q ⊢ tc_expr Delta a) ->
      (forall n,
-     @semax CS Espec Delta 
-               (local (`eq (eval_expr a) `(Vint n)) &&  Q)
+     semax E Delta 
+               (local (`eq (eval_expr a) `(Vint n)) ∧ Q)
                (seq_of_labeled_statement (select_switch (Int.unsigned n) sl))
                (switch_ret_assert R)) ->
-     @semax CS Espec Delta (!! (is_int_type (typeof a) = true) && Q) (Sswitch a sl) R
+     semax E Delta (⌜is_int_type (typeof a) = true⌝ ∧ Q) (Sswitch a sl) R
 (*| semax_call_backward: forall ret a bl R,
-     @semax CS Espec Delta
-         (EX argsig: _, EX retsig: _, EX cc: _,
-          EX A: _, EX P: _, EX Q: _, EX NEP: _, EX NEQ: _, EX ts: _, EX x: _,
-         !! (Cop.classify_fun (typeof a) =
+     semax E Delta
+         (∃ argsig: _, ∃ retsig: _, ∃ cc: _,
+          ∃ A: _, ∃ P: _, ∃ Q: _, ∃ NEP: _, ∃ NEQ: _, ∃ ts: _, ∃ x: _,
+         ⌜Cop.classify_fun (typeof a) =
              Cop.fun_case_f (type_of_params argsig) retsig cc /\
              (retsig = Tvoid -> ret = None) /\
-             tc_fn_return Delta ret retsig) &&
-          (|>((tc_expr Delta a) && (tc_exprlist Delta (snd (split argsig)) bl)))  &&
-         `(func_ptr (mk_funspec  (argsig,retsig) cc A P Q NEP NEQ)) (eval_expr a) &&
-          |>((`(P ts x: environ -> mpred) (make_args' (argsig,retsig) (eval_exprlist (snd (split argsig)) bl))) * oboxopt Delta ret (maybe_retval (Q ts x) retsig ret -* R)))
+             tc_fn_return Delta ret retsig) ∧
+          (▷((tc_expr Delta a) ∧ (tc_exprlist Delta (snd (split argsig)) bl)))  ∧
+         `(func_ptr (mk_funspec  (argsig,retsig) cc A P Q NEP NEQ)) (eval_expr a) ∧
+          ▷((`(P ts x: assert) (make_args' (argsig,retsig) (eval_exprlist (snd (split argsig)) bl))) * oboxopt Delta ret (maybe_retval (Q ts x) retsig ret -∗ R)))
          (Scall ret a bl)
          (normal_ret_assert R)*)
 | semax_call_backward: forall ret a bl R,
-     @semax CS Espec Delta
-         (EX argsig: _, EX retsig: _, EX cc: _,
-          EX A: _, EX P: _, EX Q: _, EX NEP: _, EX NEQ: _, EX ts: _, EX x: _,
-         !! (Cop.classify_fun (typeof a) =
+     semax E Delta
+         (∃ argsig: _, ∃ retsig: _, ∃ cc: _,
+          ∃ A: _, ∃ Ef : dtfr (MaskTT A), ∃ P: _, ∃ Q: _, ∃ x: _,
+         ⌜Ef x ⊆ E /\ Cop.classify_fun (typeof a) =
              Cop.fun_case_f argsig retsig cc /\
              (retsig = Tvoid -> ret = None) /\
-             tc_fn_return Delta ret retsig) &&
-          (((tc_expr Delta a) && (tc_exprlist Delta argsig bl)))  &&
-         `(func_ptr (mk_funspec  (argsig,retsig) cc A P Q NEP NEQ)) (eval_expr a) &&
-          |>((fun rho => P ts x (ge_of rho, eval_exprlist argsig bl rho)) * oboxopt Delta ret (maybe_retval (Q ts x) retsig ret -* R)))
+             tc_fn_return Delta ret retsig⌝ ∧
+          (((tc_expr Delta a) ∧ (tc_exprlist Delta argsig bl)))  ∧
+         assert_of (`(func_ptr (mk_funspec  (argsig,retsig) cc A Ef P Q)) (eval_expr a)) ∗
+          ▷(assert_of (fun rho => P x (ge_of rho, eval_exprlist argsig bl rho)) ∗ oboxopt Delta ret (maybe_retval (assert_of (Q x)) retsig ret -∗ R)))
          (Scall ret a bl)
          (normal_ret_assert R)
-| semax_return: forall (R: ret_assert) ret ,
-      @semax CS Espec Delta
-                ( (tc_expropt Delta ret (ret_type Delta)) &&
-                `(RA_return R : option val -> environ -> mpred) (cast_expropt ret (ret_type Delta)) (@id environ))
+| semax_return: forall (R: ret_assert) ret,
+      semax E Delta
+                ((tc_expropt Delta ret (ret_type Delta)) ∧
+                assert_of (`(RA_return R : option val -> environ -> mpred) (cast_expropt ret (ret_type Delta)) (@id environ)))
                 (Sreturn ret)
                 R
-| semax_set_ptr_compare_load_cast_load_backward: forall (P: environ->mpred) id e,
-    @semax CS Espec Delta
-       ((|> ( (tc_expr Delta e) &&
-             (tc_temp_id id (typeof e) Delta e) &&
-             subst id (eval_expr e) P)) ||
-        (EX cmp: Cop.binary_operation, EX e1: expr, EX e2: expr,
-         EX ty: type, EX sh1: share, EX sh2: share,
-          !! (e = Ebinop cmp e1 e2 ty /\
-              sepalg.nonidentity sh1 /\ sepalg.nonidentity sh2 /\
+| semax_set_ptr_compare_load_cast_load_backward: forall (P: assert) id e,
+    semax E Delta
+       ((((▷ ( (tc_expr Delta e) ∧
+             (tc_temp_id id (typeof e) Delta e) ∧
+             assert_of (subst id (eval_expr e) P))) ∨
+        (∃ cmp: Cop.binary_operation, ∃ e1: expr, ∃ e2: expr,
+         ∃ ty: type, ∃ sh1: share, ∃ sh2: share,
+          ⌜e = Ebinop cmp e1 e2 ty /\
+              sh1 ≠ Share.bot /\ sh2 ≠ Share.bot /\
               is_comparison cmp = true /\
               eqb_type (typeof e1) int_or_ptr_type = false /\
               eqb_type (typeof e2) int_or_ptr_type = false /\
-              typecheck_tid_ptr_compare Delta id = true) &&
-            ( |> ( (tc_expr Delta e1) &&
-              (tc_expr Delta e2)  &&
-          local (`(blocks_match cmp) (eval_expr e1) (eval_expr e2)) &&
-          (`(mapsto_ sh1 (typeof e1)) (eval_expr e1) * TT) &&
-          (`(mapsto_ sh2 (typeof e2)) (eval_expr e2) * TT) &&
-          subst id (eval_expr (Ebinop cmp e1 e2 ty)) P))) ||
-        (EX sh: share, EX t2: type, EX v2: val,
-              !! (typeof_temp Delta id = Some t2 /\
+              typecheck_tid_ptr_compare Delta id = true⌝ ∧
+            ( ▷ ( (tc_expr Delta e1) ∧
+              (tc_expr Delta e2)  ∧
+          local (`(blocks_match cmp) (eval_expr e1) (eval_expr e2)) ∧
+          (<absorb> assert_of (`(mapsto_ sh1 (typeof e1)) (eval_expr e1))) ∧
+          (<absorb> assert_of (`(mapsto_ sh2 (typeof e2)) (eval_expr e2))) ∧
+          assert_of (subst id (eval_expr (Ebinop cmp e1 e2 ty)) P))))) ∨
+        (∃ sh: share, ∃ t2: type, ∃ v2: val,
+              ⌜typeof_temp Delta id = Some t2 /\
                   is_neutral_cast (typeof e) t2 = true /\
-                  readable_share sh) &&
-         |> ( (tc_lvalue Delta e) &&
-              local (`(tc_val (typeof e) v2)) &&
-              (`(mapsto sh (typeof e)) (eval_lvalue e) (`v2) * TT) &&
-              subst id (`v2) P)) ||
-        (EX sh: share, EX e1: expr, EX t1: type, EX v2: val,
-              !! (e = Ecast e1 t1 /\
+                  readable_share sh⌝ ∧
+         ▷ ((tc_lvalue Delta e ∧
+              ⌜tc_val (typeof e) v2⌝ ∧
+              (<absorb> assert_of (`(mapsto sh (typeof e)) (eval_lvalue e) (`v2)))) ∧
+              assert_of (subst id (`v2) P)))) ∨
+        (∃ sh: share, ∃ e1: expr, ∃ t1: type, ∃ v2: val,
+              ⌜e = Ecast e1 t1 /\
                   typeof_temp Delta id = Some t1 /\
                   cast_pointer_to_bool (typeof e1) t1 = false /\
-                  readable_share sh) &&
-         |> ( (tc_lvalue Delta e1) &&
-              local (`(tc_val t1) (`(eval_cast (typeof e1) t1 v2))) &&
-              (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2) * TT) &&
-              subst id (`(force_val (sem_cast (typeof e1) t1 v2))) P)))
+                  readable_share sh⌝ ∧
+         ▷ ((tc_lvalue Delta e1) ∧
+              local (`(tc_val t1) (`(eval_cast (typeof e1) t1 v2))) ∧
+              (<absorb> assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2))) ∧
+              assert_of (subst id (`(force_val (sem_cast (typeof e1) t1 v2))) P))))
         (Sset id e) (normal_ret_assert P)
-| semax_store_store_union_hack_backward: forall (P: environ->mpred) e1 e2,
-    @semax CS Espec Delta
-       ((EX sh: share, !! writable_share sh &&
-             |> ( (tc_lvalue Delta e1) &&  (tc_expr Delta (Ecast e2 (typeof e1)))  &&
-             ((`(mapsto_ sh (typeof e1)) (eval_lvalue e1)) *
-              (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`force_val (`(sem_cast (typeof e2) (typeof e1)) (eval_expr e2))) -* P))))
-          || (EX (t2:type) (ch ch': memory_chunk) (sh: share),
-             !! ((numeric_type (typeof e1) && numeric_type t2)%bool = true /\
+| semax_store_store_union_hack_backward: forall (P: assert) e1 e2,
+    semax E Delta
+       ((∃ sh: share, ⌜writable_share sh⌝ ∧
+             ▷ ((tc_lvalue Delta e1 ∧ tc_expr Delta (Ecast e2 (typeof e1)))  ∧
+             (assert_of (`(mapsto_ sh (typeof e1)) (eval_lvalue e1)) ∗
+              (assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`force_val (`(sem_cast (typeof e2) (typeof e1)) (eval_expr e2)))) -∗ P))))
+          ∨ (∃ (t2:type) (ch ch': memory_chunk) (sh: share),
+             ⌜(numeric_type (typeof e1) && numeric_type t2)%bool = true /\
                  access_mode (typeof e1) = By_value ch /\
                  access_mode t2 = By_value ch' /\
                  decode_encode_val_ok ch ch' /\
-                 writable_share sh) &&
-             |> ( (tc_lvalue Delta e1) &&  (tc_expr Delta (Ecast e2 (typeof e1)))  &&
-             ((`(mapsto_ sh (typeof e1)) (eval_lvalue e1) 
-                      && `(mapsto_ sh t2) (eval_lvalue e1)) *
-              (ALL v': val,
-                 `(mapsto sh t2) (eval_lvalue e1) (`v') -*
-                    imp (local  ((`decode_encode_val )
-                         ((` force_val) ((`(sem_cast (typeof e2) (typeof e1))) (eval_expr e2))) (`ch) (`ch') (`v') ))
+                 writable_share sh⌝ ∧
+             ▷ (((tc_lvalue Delta e1) ∧ (tc_expr Delta (Ecast e2 (typeof e1))))  ∧
+             ((assert_of (`(mapsto_ sh (typeof e1)) (eval_lvalue e1))
+                      ∧ assert_of (`(mapsto_ sh t2) (eval_lvalue e1))) ∗
+              (∀ v': val,
+                 assert_of (`(mapsto sh t2) (eval_lvalue e1) (`v')) -∗
+                    (local  ((`decode_encode_val )
+                         ((` force_val) ((`(sem_cast (typeof e2) (typeof e1))) (eval_expr e2))) (`ch) (`ch') (`v') )) →
                       (P)))))
        )
         (Sassign e1 e2) (normal_ret_assert P)
-| semax_skip: forall P, @semax CS Espec Delta P Sskip (normal_ret_assert P)
-| semax_builtin: forall P opt ext tl el, @semax CS Espec Delta FF (Sbuiltin opt ext tl el) P
-| semax_label: forall (P:environ -> mpred) (c:statement) (Q:ret_assert) l,
-    @semax CS Espec Delta P c Q -> @semax CS Espec Delta P (Slabel l c) Q
-| semax_goto: forall P l, @semax CS Espec Delta FF (Sgoto l) P
-| semax_conseq: forall P' (R': ret_assert) P c (R: ret_assert) ,
-    (local (tc_environ Delta) && ((allp_fun_id Delta) && P) |-- (|={Ensembles.Full_set}=> P')) ->
-    (local (tc_environ Delta) && ((allp_fun_id Delta) && RA_normal R') |-- (|={Ensembles.Full_set}=> RA_normal R)) ->
-    (local (tc_environ Delta) && ((allp_fun_id Delta) && RA_break R') |-- (|={Ensembles.Full_set}=> RA_break R)) ->
-    (local (tc_environ Delta) && ((allp_fun_id Delta) && RA_continue R') |-- (|={Ensembles.Full_set}=> RA_continue R)) ->
-    (forall vl, local (tc_environ Delta) && ((allp_fun_id Delta) && RA_return R' vl) |-- (RA_return R vl)) ->
-    @semax CS Espec Delta P' c R' -> @semax CS Espec Delta P c R.
-
-Definition semax_body
+| semax_skip: forall P, semax E Delta P Sskip (normal_ret_assert P)
+| semax_builtin: forall P opt ext tl el, semax E Delta False (Sbuiltin opt ext tl el) P
+| semax_label: forall (P: assert) (c: statement) (Q: ret_assert) l,
+    semax E Delta P c Q -> semax E Delta P (Slabel l c) Q
+| semax_goto: forall P l, semax E Delta False (Sgoto l) P
+| semax_conseq: forall (P': assert) (R': ret_assert) (P: assert) c (R: ret_assert),
+    (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢ (|={E}=> P')) ->
+    (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ RA_normal R') ⊢ (|={E}=> RA_normal R)) ->
+    (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ RA_break R') ⊢ (|={E}=> RA_break R)) ->
+    (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ RA_continue R') ⊢ (|={E}=> RA_continue R)) ->
+    (forall vl, local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ RA_return R' vl) ⊢ (RA_return R vl)) ->
+    semax E Delta P' c R' -> semax E Delta P c R
+| semax_mask_mono: forall E' P c R, E' ⊆ E -> semax E' Delta P c R -> semax E Delta P c R.
+
+Definition semax_body `{!VSTGS OK_ty Σ}
    (V: varspecs) (G: funspecs) {C: compspecs} (f: function) (spec: ident * funspec): Prop :=
-match spec with (_, mk_funspec fsig cc A P Q _ _) => 
+match spec with (_, mk_funspec fsig cc A E P Q) => 
   fst fsig = map snd (fst (fn_funsig f)) /\ 
   snd fsig = snd (fn_funsig f) /\
-forall Espec ts x, 
-  @semax C Espec (func_tycontext f V G nil)
-      (fun rho => Clight_seplog.close_precondition (map fst f.(fn_params)) (P ts x) rho * stackframe_of f rho)
+forall OK_spec x,
+  semax(OK_spec := OK_spec) (E x) (func_tycontext f V G nil)
+      (Clight_seplog.close_precondition (map fst f.(fn_params)) (argsassert_of (P x)) ∗ stackframe_of f)
        f.(fn_body)
-      (frame_ret_assert (function_body_ret_assert (fn_return f) (Q ts x)) (stackframe_of f))
+      (frame_ret_assert (function_body_ret_assert (fn_return f) (assert_of (Q x))) (stackframe_of f))
 end.
 
-Inductive semax_func: forall {Espec: OracleKind} (V: varspecs) (G: funspecs) {C: compspecs} (ge: Genv.t Clight.fundef type)(fdecs: list (ident * Clight.fundef)) (G1: funspecs), Prop :=
-| semax_func_nil:   forall {Espec: OracleKind},
-    forall V G C ge, @semax_func Espec V G C ge nil nil
+Inductive semax_func `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} : forall (V: varspecs) (G: funspecs(Σ := Σ)) {C: compspecs} (ge: Genv.t Clight.fundef type) (fdecs: list (ident * Clight.fundef)) (G1: funspecs), Prop :=
+| semax_func_nil:
+    forall C V G ge, semax_func(C := C) V G ge nil nil
 | semax_func_cons:
-  forall {Espec: OracleKind},
-     forall fs id f fsig cc A P Q NEP NEQ (V: varspecs) (G G': funspecs) {C: compspecs} ge b,
+     forall {C: compspecs} fs id f fsig cc A E P Q (V: varspecs) (G G': funspecs) ge b,
       andb (id_in_list id (map (@fst _ _) G))
       (andb (negb (id_in_list id (map (@fst ident Clight.fundef) fs)))
         (semax_body_params_ok f)) = true ->
@@ -298,64 +299,63 @@ Inductive semax_func: forall {Espec: OracleKind} (V: varspecs) (G: funspecs) {C:
        var_sizes_ok (f.(fn_vars)) ->
        f.(fn_callconv) = cc ->
        Genv.find_symbol ge id = Some b -> Genv.find_funct_ptr ge b = Some (Internal f) -> 
-      semax_body V G f (id, mk_funspec fsig cc A P Q NEP NEQ)->
-      semax_func V G ge fs G' ->
+      semax_body V G f (id, mk_funspec fsig cc A E P Q)->
+      semax_func(C := C) V G ge fs G' ->
       semax_func V G ge ((id, Internal f)::fs)
-                 ((id, mk_funspec fsig cc A P Q NEP NEQ)  :: G')
+                 ((id, mk_funspec fsig cc A E P Q)  :: G')
 | semax_func_cons_ext:
-  forall {Espec: OracleKind},
-   forall (V: varspecs) (G: funspecs) {C: compspecs} ge fs id ef argsig retsig A P Q NEP NEQ
+   forall (V: varspecs) (G: funspecs) {C: compspecs} ge fs id ef argsig retsig A E P (Q : dtfr (AssertTT A))
           (G': funspecs) cc b,
   ef_sig ef = mksignature (map argtype_of_type argsig) (rettype_of_type retsig) cc ->
   id_in_list id (map (@fst _ _) fs) = false ->
-  (ef_inline ef = false \/ withtype_empty A) ->
-  (forall gx ts x (ret : option val),
-     (Q ts x (make_ext_rval gx (rettype_of_type retsig) ret)
-        && !!Builtins0.val_opt_has_rettype ret (rettype_of_type retsig)
-        |-- !!tc_option_val retsig ret)) ->
+  (ef_inline ef = false \/ @withtype_empty Σ A) ->
+  (forall gx x (ret : option val),
+     (Q x (make_ext_rval gx (rettype_of_type retsig) ret)
+        ∧ ⌜Builtins0.val_opt_has_rettype ret (rettype_of_type retsig)⌝
+        ⊢ ⌜tc_option_val retsig ret⌝)) ->
   Genv.find_symbol ge id = Some b -> Genv.find_funct_ptr ge b = Some (External ef argsig retsig cc) ->
-  @semax_external Espec ef A P Q ->
-  semax_func V G ge fs G' ->
+  (⊢ semax_external ef A E P Q) ->
+  semax_func(C := C) V G ge fs G' ->
   semax_func V G ge ((id, External ef argsig retsig cc)::fs)
-       ((id, mk_funspec (argsig, retsig) cc A P Q NEP NEQ)  :: G')
-| semax_func_mono: forall  {Espec CS CS'} (CSUB: cspecs_sub CS CS') ge ge'
+       ((id, mk_funspec (argsig, retsig) cc A E P Q) :: G')
+| semax_func_mono: forall  {CS CS'} (CSUB: cspecs_sub CS CS') ge ge'
   (Gfs: forall i,  sub_option (Genv.find_symbol ge i) (Genv.find_symbol ge' i))
   (Gffp: forall b, sub_option (Genv.find_funct_ptr ge b) (Genv.find_funct_ptr ge' b))
-  V G fdecs G1 (H: @semax_func Espec V G CS ge fdecs G1), @semax_func Espec V G CS' ge' fdecs G1
-                                                                      
+  V G fdecs G1 (H: semax_func V G (C := CS) ge fdecs G1), semax_func V G (C := CS') ge' fdecs G1
+
 | semax_func_app:
-  forall Espec ge cs V H funs1 funs2 G1 G2
-         (SF1: @semax_func Espec V H cs ge funs1 G1) (SF2: @semax_func Espec V H cs ge funs2 G2)
+  forall C ge V H funs1 funs2 G1 G2
+         (SF1: semax_func V H ge funs1 G1) (SF2: semax_func V H ge funs2 G2)
          (L:length funs1 = length G1),
-    @semax_func Espec V H cs ge (funs1 ++ funs2) (G1++G2)
-                
+    semax_func(C := C) V H ge (funs1 ++ funs2) (G1++G2)
+
 | semax_func_subsumption:
-  forall Espec ge cs V V' F F'
+  forall C ge V V' F F'
          (SUB: tycontext_sub (nofunc_tycontext V F) (nofunc_tycontext V F'))
-         (HV: forall id, sub_option (make_tycontext_g V F) ! id (make_tycontext_g V' F') ! id),
-  forall funs G (SF: @semax_func Espec V F cs ge funs G),  @semax_func Espec V' F' cs ge funs G
-                                                                       
+         (HV: forall id, sub_option ((make_tycontext_g V F) !! id) ((make_tycontext_g V' F') !! id)),
+  forall funs G (SF: semax_func(C := C) V F ge funs G),  semax_func V' F' ge funs G
+
 | semax_func_join:
-  forall {Espec cs ge V1 H1 V2 H2 V funs1 funs2 G1 G2 H}
-  (SF1: @semax_func Espec V1 H1 cs ge funs1 G1) (SF2: @semax_func Espec V2 H2 cs ge funs2 G2)
+  forall {C ge V1 H1 V2 H2 V funs1 funs2 G1 G2 H}
+  (SF1: semax_func V1 H1 ge funs1 G1) (SF2: semax_func V2 H2 ge funs2 G2)
 
-  (K1: forall i, sub_option ((make_tycontext_g V1 H1) ! i) ((make_tycontext_g V1 H) ! i))
-  (K2: forall i, subsumespec ((make_tycontext_s H1) ! i) ((make_tycontext_s H) ! i))
-  (K3: forall i, sub_option ((make_tycontext_g V1 H) ! i) ((make_tycontext_g V H) ! i))
+  (K1: forall i, sub_option ((make_tycontext_g V1 H1) !! i) ((make_tycontext_g V1 H) !! i))
+  (K2: forall i, subsumespec ((make_tycontext_s H1) !! i) ((make_tycontext_s H) !! i))
+  (K3: forall i, sub_option ((make_tycontext_g V1 H) !! i) ((make_tycontext_g V H) !! i))
 
-  (N1: forall i, sub_option ((make_tycontext_g V2 H2) ! i) ((make_tycontext_g V2 H) ! i))
-  (N2: forall i, subsumespec ((make_tycontext_s H2) ! i) ((make_tycontext_s H) ! i))
-  (N3: forall i, sub_option ((make_tycontext_g V2 H) ! i) ((make_tycontext_g V H) ! i)),
-  @semax_func Espec V H cs ge (funs1 ++ funs2) (G1++G2)
+  (N1: forall i, sub_option ((make_tycontext_g V2 H2) !! i) ((make_tycontext_g V2 H) !! i))
+  (N2: forall i, subsumespec ((make_tycontext_s H2) !! i) ((make_tycontext_s H) !! i))
+  (N3: forall i, sub_option ((make_tycontext_g V2 H) !! i) ((make_tycontext_g V H) !! i)),
+  semax_func(C := C) V H ge (funs1 ++ funs2) (G1++G2)
   
 | semax_func_firstn:
-  forall {Espec cs ge H V n funs G} (SF: @semax_func Espec V H cs ge funs G),
-    @semax_func Espec V H cs ge (firstn n funs) (firstn n G)
-                
+  forall {C ge H V n funs G} (SF: semax_func V H ge funs G),
+    semax_func(C := C) V H ge (firstn n funs) (firstn n G)
+
 | semax_func_skipn:
-  forall {Espec cs ge H V funs G} (HV:list_norepet (map fst funs))
-         (SF: @semax_func Espec V H cs ge funs G) n,
-    @semax_func Espec V H cs ge (skipn n funs) (skipn n G).
+  forall {C ge H V funs G} (HV:list_norepet (map fst funs))
+         (SF: semax_func V H ge funs G) n,
+    semax_func(C := C) V H ge (skipn n funs) (skipn n G).
 
 End AuxDefs.
 
@@ -395,9 +395,15 @@ Module ConseqFacts := GenConseqFacts (DeepEmbeddedDef) (Conseq).
 
 Import CConseq CConseqFacts Conseq ConseqFacts.
 
-Lemma semax_skip_inv: forall {CS: compspecs} {Espec: OracleKind} Delta P R,
-    @semax CS Espec Delta P Sskip R ->
-    local (tc_environ Delta) && (allp_fun_id Delta && P) |-- |={Ensembles.Full_set}=> RA_normal R.
+Arguments semax _ _ _ _ _ _ _ (_)%_I.
+
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} {CS: compspecs}.
+
+Lemma semax_skip_inv: forall E Delta P R,
+    semax E Delta P Sskip R ->
+    local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢ |={E}=> RA_normal R.
 Proof.
   intros.
   remember Sskip as c eqn:?H.
@@ -405,11 +411,13 @@ Proof.
   + apply derives_full_refl.
   + specialize (IHsemax H0).
     solve_derives_trans.
+  + rewrite IHsemax //.
+    by apply fupd_mask_mono.
 Qed.
 
-Lemma semax_break_inv: forall {CS: compspecs} {Espec: OracleKind} Delta P R,
-    @semax CS Espec Delta P Sbreak R ->
-    local (tc_environ Delta) && (allp_fun_id Delta && P) |-- |={Ensembles.Full_set}=> RA_break R.
+Lemma semax_break_inv: forall E Delta P R,
+    semax E Delta P Sbreak R ->
+    local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢ |={E}=> RA_break R.
 Proof.
   intros.
   remember Sbreak as c eqn:?H.
@@ -417,11 +425,13 @@ Proof.
   + apply derives_full_refl.
   + specialize (IHsemax H0).
     solve_derives_trans.
+  + rewrite IHsemax //.
+    by apply fupd_mask_mono.
 Qed.
 
-Lemma semax_continue_inv: forall {CS: compspecs} {Espec: OracleKind} Delta P R,
-    @semax CS Espec Delta P Scontinue R ->
-    local (tc_environ Delta) && (allp_fun_id Delta && P) |-- |={Ensembles.Full_set}=> RA_continue R.
+Lemma semax_continue_inv: forall E Delta P R,
+    semax E Delta P Scontinue R ->
+    local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢ |={E}=> RA_continue R.
 Proof.
   intros.
   remember Scontinue as c eqn:?H.
@@ -429,11 +439,13 @@ Proof.
   + apply derives_full_refl.
   + specialize (IHsemax H0).
     solve_derives_trans.
+  + rewrite IHsemax //.
+    by apply fupd_mask_mono.
 Qed.
 
-Lemma semax_return_inv: forall {CS: compspecs} {Espec: OracleKind} Delta P ret R,
-  @semax CS Espec Delta P (Sreturn ret) R ->
-  local (tc_environ Delta) && (allp_fun_id Delta && P) |-- |={Ensembles.Full_set}=> ((tc_expropt Delta ret (ret_type Delta)) && `(RA_return R : option val -> environ -> mpred) (cast_expropt ret (ret_type Delta)) (@id environ)).
+Lemma semax_return_inv: forall E Delta P ret R,
+  semax E Delta P (Sreturn ret) R ->
+  local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢ |={E}=> ((tc_expropt Delta ret (ret_type Delta)) ∧ assert_of (`(RA_return R : option val -> environ -> mpred) (cast_expropt ret (ret_type Delta)) (@id environ))).
 Proof.
   intros.
   remember (Sreturn ret) as c eqn:?H.
@@ -446,20 +458,21 @@ Proof.
   + derives_rewrite -> H; clear H.
     derives_rewrite -> (IHsemax H0); clear IHsemax.
     reduceR.
-    apply andp_ENTAILL; [solve_andp |].
+    apply andp_ENTAILL; [by iIntros "(_ & _ & $)"|].
     unfold_lift.
-    intro rho.
-    simpl.
+    split => rho; monPred.unseal.
     forget (cast_expropt ret (ret_type Delta) rho) as vl.
     revert rho.
-    change (local (tc_environ Delta) && (allp_fun_id Delta && (RA_return R' vl)) |-- RA_return R vl).
-    auto.
+    destruct (H4 vl) as [H].
+    revert H; monPred.unseal; eauto.
+  + rewrite IHsemax //.
+    by apply fupd_mask_mono.
 Qed.
 
-Lemma semax_seq_inv: forall {CS: compspecs} {Espec: OracleKind} Delta P R h t,
-    @semax CS Espec Delta P (Ssequence h t) R ->
-    exists Q, @semax CS Espec Delta P h (overridePost Q R) /\
-              @semax CS Espec Delta Q t R.
+Lemma semax_seq_inv: forall E Delta P R h t,
+    semax E Delta P (Ssequence h t) R ->
+    exists Q, semax E Delta P h (overridePost Q R) /\
+              semax E Delta Q t R.
 Proof.
   intros.
   remember (Ssequence h t) as c eqn:?H.
@@ -471,20 +484,22 @@ Proof.
     destruct H0 as [Q [? ?]].
     exists Q.
     split.
-    - apply (AuxDefs.semax_conseq _ P' (overridePost Q R')); auto.
+    - apply (AuxDefs.semax_conseq _ _ P' (overridePost Q R')); auto.
       * clear.
         destruct R, R'.
         apply derives_full_refl.
       * destruct R, R'; auto.
       * destruct R, R'; auto.
       * destruct R, R'; auto.
-    - eapply semax_conseq; eauto.
+    - eapply semax_conseq, H6; auto.
       apply derives_full_refl.
+  + destruct IHsemax as (? & ? & ?); first done.
+    eexists; split; eapply AuxDefs.semax_mask_mono; eauto.
 Qed.
 
-Lemma semax_seq_inv': forall {CS: compspecs} {Espec: OracleKind} Delta P R h t,
-    @semax CS Espec Delta P (Ssequence h t) R ->
-    @semax CS Espec Delta P h (overridePost (EX Q: environ -> mpred, !! (@semax CS Espec Delta Q t R) && Q) R).
+Lemma semax_seq_inv': forall E Delta P R h t,
+    semax E Delta P (Ssequence h t) R ->
+    semax E Delta P h (overridePost (∃ Q: assert, ⌜semax E Delta Q t R⌝ ∧ Q) R).
 Proof.
   intros.
   remember (Ssequence h t) as c eqn:?H.
@@ -493,11 +508,10 @@ Proof.
     clear IHsemax1 IHsemax2.
     eapply semax_post_simple; [.. | exact H].
     - destruct R; unfold overridePost, tycontext.RA_normal.
-      apply (exp_right Q).
-      apply andp_right; [apply prop_right |]; auto.
-    - destruct R; apply derives_refl.
-    - destruct R; apply derives_refl.
-    - intro; destruct R; apply derives_refl.
+      iIntros "?"; iExists Q; iFrame; auto.
+    - destruct R; done.
+    - destruct R; done.
+    - intro; destruct R; done.
   + subst c.
     pose proof IHsemax eq_refl. clear IHsemax.
     eapply AuxDefs.semax_conseq; [.. | exact H0]; auto.
@@ -505,39 +519,52 @@ Proof.
       destruct R' as [R'0 R'1 R'2 R'3] at 1; clear R'0 R'1 R'2 R'3.
       destruct R as [R0 R1 R2 R3] at 1; clear R0 R1 R2 R3.
       reduce2derives.
-      apply exp_derives.
+      apply bi.exist_mono.
       intros Q.
-      normalize.
-      apply andp_right; [apply prop_right | auto].
+      iIntros "(% & $)"; iPureIntro; split; last done.
       eapply semax_conseq; [.. | apply H6]; auto.
       apply derives_full_refl.
     - destruct R, R'; auto.
     - destruct R, R'; auto.
     - destruct R, R'; auto.
-Qed.
-
-Lemma semax_assign_inv: forall {CS: compspecs} {Espec: OracleKind} Delta e1 e2 P Q,
-  @semax CS Espec Delta P (Sassign e1 e2) Q ->
-  local (tc_environ Delta) && (allp_fun_id Delta && P) |--
-     |={Ensembles.Full_set}=>
-      ((EX sh: share, !! writable_share sh &&
-             |> ( (tc_lvalue Delta e1) &&  (tc_expr Delta (Ecast e2 (typeof e1)))  &&
-             ((`(mapsto_ sh (typeof e1)) (eval_lvalue e1)) *
-              (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`force_val (`(sem_cast (typeof e2) (typeof e1)) (eval_expr e2))) -* |={Ensembles.Full_set}=> RA_normal Q))))
-          || (EX (t2:type) (ch ch': memory_chunk) (sh: share),
-             !! ((numeric_type (typeof e1) && numeric_type t2)%bool = true /\
+  + eapply AuxDefs.semax_mask_mono; first done.
+    eapply AuxDefs.semax_conseq, IHsemax; last done.
+    - by iIntros "(_ & _ & $)".
+    - destruct R; simpl.
+      iIntros "(_ & _ & % & % & ?)".
+      iExists Q; iFrame; iPureIntro.
+      split; last done.
+      eapply AuxDefs.semax_mask_mono; eauto.
+    - destruct R; simpl.
+      by iIntros "(_ & _ & $)".
+    - destruct R; simpl.
+      by iIntros "(_ & _ & $)".
+    - destruct R; simpl.
+      by iIntros (?) "(_ & _ & $)".
+Qed.
+
+Lemma semax_assign_inv: forall E Delta e1 e2 P Q,
+  semax E Delta P (Sassign e1 e2) Q ->
+  local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢
+     |={E}=>
+      ((∃ sh: share, ⌜writable_share sh⌝ ∧
+             ▷ (((tc_lvalue Delta e1) ∧ (tc_expr Delta (Ecast e2 (typeof e1))))  ∧
+             (assert_of (`(mapsto_ sh (typeof e1)) (eval_lvalue e1)) ∗
+              (assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`force_val (`(sem_cast (typeof e2) (typeof e1)) (eval_expr e2)))) -∗ |={E}=> RA_normal Q))))
+          ∨ (∃ (t2:type) (ch ch': memory_chunk) (sh: share),
+             ⌜(numeric_type (typeof e1) && numeric_type t2)%bool = true /\
                  access_mode (typeof e1) = By_value ch /\
                  access_mode t2 = By_value ch' /\
                  decode_encode_val_ok ch ch' /\
-                 writable_share sh) &&
-             |> ( (tc_lvalue Delta e1) &&  (tc_expr Delta (Ecast e2 (typeof e1)))  &&
-             ((`(mapsto_ sh (typeof e1)) (eval_lvalue e1) 
-                      && `(mapsto_ sh t2) (eval_lvalue e1)) *
-              (ALL v': val,
-                 `(mapsto sh t2) (eval_lvalue e1) (`v') -*
-                    imp (local  ((`decode_encode_val )
-                         ((` force_val) ((`(sem_cast (typeof e2) (typeof e1))) (eval_expr e2))) (`ch) (`ch') (`v') ))
-                      (|={Ensembles.Full_set}=> RA_normal Q)))))
+                 writable_share sh⌝ ∧
+             ▷ ((tc_lvalue Delta e1 ∧ tc_expr Delta (Ecast e2 (typeof e1)))  ∧
+             ((assert_of (`(mapsto_ sh (typeof e1)) (eval_lvalue e1))
+                      ∧ assert_of (`(mapsto_ sh t2) (eval_lvalue e1))) ∗
+              (∀ v': val,
+                 assert_of (`(mapsto sh t2) (eval_lvalue e1) (`v')) -∗
+                      (local  ((`decode_encode_val )
+                         ((` force_val) ((`(sem_cast (typeof e2) (typeof e1))) (eval_expr e2))) (`ch) (`ch') (`v') )) →
+                      (|={E}=> RA_normal Q)))))
        ).
 Proof.
   intros.
@@ -545,26 +572,24 @@ Proof.
   induction H; try solve [inv H0].
   + inv H0.
     reduce2derives.
-    apply orp_derives.
-    - apply exp_derives; intro sh.
-      apply andp_derives; auto.
-      apply later_derives; auto.
-      apply andp_derives; auto.
-      apply sepcon_derives; auto.
-      apply wand_derives; auto.
-      apply fupd_intro.
-    - apply exp_derives; intro t2.
-      apply exp_derives; intro ch.
-      apply exp_derives; intro ch'.
-      apply exp_derives; intro sh.
-      apply andp_derives; auto.
-      apply later_derives; auto.
-      apply andp_derives; auto.
-      apply sepcon_derives; auto.
-      apply allp_derives; intros v'.
-      apply wand_derives; auto.
-      apply imp_derives; auto.
-      apply fupd_intro.
+    apply bi.or_mono.
+    - apply bi.exist_mono; intro sh.
+      apply bi.and_mono; auto.
+      apply bi.later_mono; auto.
+      apply bi.and_mono; auto.
+      apply bi.sep_mono; auto.
+      apply bi.wand_mono; auto.
+    - apply bi.exist_mono; intro t2.
+      apply bi.exist_mono; intro ch.
+      apply bi.exist_mono; intro ch'.
+      apply bi.exist_mono; intro sh.
+      apply bi.and_mono; auto.
+      apply bi.later_mono; auto.
+      apply bi.and_mono; auto.
+      apply bi.sep_mono; auto.
+      apply bi.forall_mono; intros v'.
+      apply bi.wand_mono; auto.
+      apply bi.impl_mono; auto.
   + subst c.
     derives_rewrite -> H.
     derives_rewrite -> (IHsemax eq_refl).
@@ -589,6 +614,17 @@ Proof.
       apply wand_ENTAILL; [reduceLL; apply ENTAIL_refl |].
       apply imp_ENTAILL; [reduceLL; apply ENTAIL_refl |].
       apply derives_full_fupd_left, H1.
+  + iIntros "H".
+    iMod (fupd_mask_subseteq E') as "Hmask"; first done.
+    iMod (IHsemax with "H") as "H"; first done.
+    iMod "Hmask" as "_"; iIntros "!>".
+    iDestruct "H" as "[(% & % & H) | (% & % & % & % & % & H)]"; [iLeft | iRight].
+    - iExists _; iSplit; first done.
+      rewrite fupd_mask_mono //.
+    - iExists _, _, _, _; iSplit; first done.
+      iNext; iApply (bi.and_mono with "H"); first done.
+      iIntros "($ & ?)" (?).
+      rewrite -(fupd_mask_mono E' E) //.
 Qed.
 
 Lemma tc_fn_return_temp_guard_opt: forall ret retsig Delta,
@@ -596,53 +632,52 @@ Lemma tc_fn_return_temp_guard_opt: forall ret retsig Delta,
   temp_guard_opt Delta ret.
 Proof.
   intros.
-  destruct ret; hnf in H |- *; [destruct ((temp_types Delta) ! i) |]; auto; congruence.
+  destruct ret; hnf in H |- *; [destruct ((temp_types Delta) !! i) |]; auto; congruence.
 Qed.
 
 Lemma oboxopt_ENTAILL: forall Delta ret retsig P Q,
   tc_fn_return Delta ret retsig ->
-  (local (tc_environ Delta) && (allp_fun_id Delta && P) |-- Q) ->
-  local (tc_environ Delta) && (allp_fun_id Delta && oboxopt Delta ret P) |-- oboxopt Delta ret Q.
+  (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢ Q) ->
+  local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ oboxopt Delta ret P) ⊢ oboxopt Delta ret Q.
 Proof.
   intros.
   apply oboxopt_left2'; auto.
   eapply tc_fn_return_temp_guard_opt; eauto.
 Qed.
 
-Lemma semax_call_inv: forall {CS: compspecs} {Espec: OracleKind} Delta ret a bl Pre Post,
-  @semax CS Espec Delta Pre (Scall ret a bl) Post ->
-  local (tc_environ Delta) && (allp_fun_id Delta && Pre) |-- |={Ensembles.Full_set}=>
-         (EX argsig: _, EX retsig: _, EX cc: _,
-          EX A: _, EX P: _, EX Q: _, EX NEP: _, EX NEQ: _, EX ts: _, EX x: _,
-         !! (Cop.classify_fun (typeof a) =
+Lemma semax_call_inv: forall E Delta ret a bl Pre Post,
+  semax E Delta Pre (Scall ret a bl) Post ->
+  local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ Pre) ⊢ |={E}=>
+         (∃ argsig: _, ∃ retsig: _, ∃ cc: _,
+          ∃ A: _, ∃ Ef : dtfr (MaskTT A), ∃ P: _, ∃ Q: _, ∃ x: _,
+         ⌜Ef x ⊆ E /\ Cop.classify_fun (typeof a) =
              Cop.fun_case_f argsig retsig cc /\
              (retsig = Tvoid -> ret = None) /\
-             tc_fn_return Delta ret retsig) &&
-          ((*|>*)((tc_expr Delta a) && (tc_exprlist Delta argsig bl)))  &&
-         `(func_ptr (mk_funspec  (argsig,retsig) cc A P Q NEP NEQ)) (eval_expr a) &&
-          |>((fun rho => P ts x (ge_of rho, eval_exprlist argsig bl rho)) * oboxopt Delta ret (maybe_retval (Q ts x) retsig ret -* |={Ensembles.Full_set}=> RA_normal Post))).
+             tc_fn_return Delta ret retsig⌝ ∧
+          ((*▷*)((tc_expr Delta a) ∧ (tc_exprlist Delta argsig bl)))  ∧
+         assert_of (`(func_ptr (mk_funspec (argsig,retsig) cc A Ef P Q)) (eval_expr a)) ∗
+          ▷(assert_of (fun rho => P x (ge_of rho, eval_exprlist argsig bl rho)) ∗ oboxopt Delta ret (maybe_retval (assert_of (Q x)) retsig ret -∗ |={E}=> RA_normal Post))).
 Proof.
   intros.
   remember (Scall ret a bl) as c eqn:?H.
   induction H; try solve [inv H0].
   + inv H0.
     reduce2derives.
-    apply exp_derives; intro argsig.
-    apply exp_derives; intro retsig.
-    apply exp_derives; intro cc.
-    apply exp_derives; intro A.
-    apply exp_derives; intro P.
-    apply exp_derives; intro Q.
-    apply exp_derives; intro NEP.
-    apply exp_derives; intro NEQ.
-    apply exp_derives; intro ts.
-    apply exp_derives; intro x.
-    apply andp_derives; auto.
-    apply later_derives; auto.
-    apply sepcon_derives; auto.
+    apply bi.exist_mono; intro argsig.
+    apply bi.exist_mono; intro retsig.
+    apply bi.exist_mono; intro cc.
+    apply bi.exist_mono; intro A.
+    apply bi.exist_mono; intro Ef.
+    apply bi.exist_mono; intro P.
+    apply bi.exist_mono; intro Q.
+    apply bi.exist_mono; intro x.
+    apply bi.and_mono; auto.
+    apply bi.and_mono; auto.
+    apply bi.sep_mono; auto.
+    apply bi.later_mono; auto.
+    apply bi.sep_mono; auto.
     apply oboxopt_K; auto.
-    apply wand_derives; auto.
-    apply fupd_intro.
+    apply bi.wand_mono; auto.
   + subst c.
     rename P into Pre, R into Post.
     derives_rewrite -> H.
@@ -651,97 +686,112 @@ Proof.
     apply exp_ENTAILL; intro argsig.
     apply exp_ENTAILL; intro retsig.
     apply exp_ENTAILL; intro cc.
+    apply exp_ENTAILL; intro Ef.
     apply exp_ENTAILL; intro A.
     apply exp_ENTAILL; intro P.
     apply exp_ENTAILL; intro Q.
-    apply exp_ENTAILL; intro NEP.
-    apply exp_ENTAILL; intro NEQ.
-    apply exp_ENTAILL; intro ts.
     apply exp_ENTAILL; intro x.
-    normalize. 
-    destruct H0 as [? [? ?]].
-    apply andp_ENTAILL; [reduceLL; apply ENTAIL_refl |].
-    apply later_ENTAILL.
-    apply sepcon_ENTAILL; [reduceLL; apply ENTAIL_refl |].
-    eapply oboxopt_ENTAILL; eauto.
+    iIntros "(#? & #? & (% & % & % & %) & H)"; iSplit; first done.
+    iSplit; first rewrite bi.and_elim_l //; rewrite bi.and_elim_r.
+    iDestruct "H" as "($ & H)".
+    iNext; iDestruct "H" as "($ & H)".
+    iApply oboxopt_ENTAILL; first done; last by iFrame; iSplit.
     apply wand_ENTAILL; [reduceLL; apply ENTAIL_refl |].
     apply derives_full_fupd_left, H1.
-Qed.
-
-Lemma semax_Sset_inv: forall {CS: compspecs} {Espec: OracleKind} Delta P R id e,
-  @semax CS Espec Delta P (Sset id e) R ->
-  local (tc_environ Delta) && (allp_fun_id Delta && P) |-- |={Ensembles.Full_set}=>
-    ( (|> ( (tc_expr Delta e) &&
-             (tc_temp_id id (typeof e) Delta e) &&
-             subst id (eval_expr e) (|={Ensembles.Full_set}=> RA_normal R))) ||
-      (EX cmp: Cop.binary_operation, EX e1: expr, EX e2: expr,
-         EX ty: type, EX sh1: share, EX sh2: share,
-          !! (e = Ebinop cmp e1 e2 ty /\
-              sepalg.nonidentity sh1 /\ sepalg.nonidentity sh2 /\
+  + iIntros "H".
+    iMod (fupd_mask_subseteq E') as "Hmask"; first done.
+    iMod (IHsemax with "H") as (????????) "((% & %) & H)"; first done.
+    iMod "Hmask" as "_"; iIntros "!>".
+    iExists _, _, _, _, Ef, _, _, _; iSplit; last by rewrite oboxopt_K // fupd_mask_mono //.
+    iPureIntro; split; [set_solver | done].
+Qed.
+
+Lemma typecheck_expr_sound' : forall Delta e, local (typecheck_environ Delta) ∧ tc_expr Delta e ⊢ local ((`(tc_val (typeof e))) (eval_expr e)).
+Proof.
+  intros; split => rho; monPred.unseal.
+  iIntros "(% & ?)"; by iApply typecheck_expr_sound.
+Qed.
+
+Lemma semax_Sset_inv: forall E Delta P R id e,
+  semax E Delta P (Sset id e) R ->
+  local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢ |={E}=>
+    ((((▷ ((tc_expr Delta e) ∧
+             (tc_temp_id id (typeof e) Delta e) ∧
+             assert_of (subst id (eval_expr e) (|={E}=> RA_normal R)))) ∨
+      (∃ cmp: Cop.binary_operation, ∃ e1: expr, ∃ e2: expr,
+         ∃ ty: type, ∃ sh1: share, ∃ sh2: share,
+          ⌜e = Ebinop cmp e1 e2 ty /\
+              sh1 ≠ Share.bot /\ sh2 ≠ Share.bot /\
               is_comparison cmp = true /\
               eqb_type (typeof e1) int_or_ptr_type = false /\
               eqb_type (typeof e2) int_or_ptr_type = false /\
-              typecheck_tid_ptr_compare Delta id = true) &&
-            ( |> ( (tc_expr Delta e1) &&
-              (tc_expr Delta e2)  &&
-          local (`(blocks_match cmp) (eval_expr e1) (eval_expr e2)) &&
-          (`(mapsto_ sh1 (typeof e1)) (eval_expr e1) * TT) &&
-          (`(mapsto_ sh2 (typeof e2)) (eval_expr e2) * TT) &&
-          subst id (eval_expr (Ebinop cmp e1 e2 ty)) (|={Ensembles.Full_set}=> RA_normal R)))) ||
-      (EX sh: share, EX t2: type, EX v2: val,
-              !! (typeof_temp Delta id = Some t2 /\
+              typecheck_tid_ptr_compare Delta id = true⌝ ∧
+            ( ▷ ((tc_expr Delta e1) ∧
+              (tc_expr Delta e2)  ∧
+          local (`(blocks_match cmp) (eval_expr e1) (eval_expr e2)) ∧
+          (<absorb> assert_of (`(mapsto_ sh1 (typeof e1)) (eval_expr e1))) ∧
+          (<absorb> assert_of (`(mapsto_ sh2 (typeof e2)) (eval_expr e2))) ∧
+          assert_of (subst id (eval_expr (Ebinop cmp e1 e2 ty)) (|={E}=> RA_normal R)))))) ∨
+      (∃ sh: share, ∃ t2: type, ∃ v2: val,
+              ⌜typeof_temp Delta id = Some t2 /\
                   is_neutral_cast (typeof e) t2 = true /\
-                  readable_share sh) &&
-         |> ( (tc_lvalue Delta e) &&
-              local (`(tc_val (typeof e) v2)) &&
-              (`(mapsto sh (typeof e)) (eval_lvalue e) (`v2) * TT) &&
-              subst id (`v2) (|={Ensembles.Full_set}=> RA_normal R))) ||
-      (EX sh: share, EX e1: expr, EX t1: type, EX v2: val,
-              !! (e = Ecast e1 t1 /\
+                  readable_share sh⌝ ∧
+         ▷ (( (tc_lvalue Delta e) ∧
+              ⌜tc_val (typeof e) v2⌝ ∧
+              (<absorb> assert_of (`(mapsto sh (typeof e)) (eval_lvalue e) (`v2)))) ∧
+              assert_of (subst id (`v2) (|={E}=> RA_normal R)))))) ∨
+      (∃ sh: share, ∃ e1: expr, ∃ t1: type, ∃ v2: val,
+              ⌜e = Ecast e1 t1 /\
                   typeof_temp Delta id = Some t1 /\
                   cast_pointer_to_bool (typeof e1) t1 = false /\
-                  readable_share sh) &&
-         |> ( (tc_lvalue Delta e1) &&
-              local (`(tc_val t1) (`(eval_cast (typeof e1) t1 v2))) &&
-              (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2) * TT) &&
-              subst id (`(force_val (sem_cast (typeof e1) t1 v2))) (|={Ensembles.Full_set}=> RA_normal R)))).
+                  readable_share sh⌝ ∧
+         ▷ ( (tc_lvalue Delta e1) ∧
+              local (`(tc_val t1) (`(eval_cast (typeof e1) t1 v2))) ∧
+              (<absorb> assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2))) ∧
+              assert_of (subst id (`(force_val (sem_cast (typeof e1) t1 v2))) (|={E}=> RA_normal R)))).
 Proof.
   intros.
   remember (Sset id e) as c eqn:?H.
   induction H; try solve [inv H0].
   + inv H0.
     reduce2derives.
-    apply orp_derives; [apply orp_derives; [apply orp_derives |] |].
-    - apply later_derives.
-      apply andp_derives; auto.
+    apply bi.or_mono; [apply bi.or_mono; [apply bi.or_mono |] |].
+    - apply bi.later_mono.
+      apply bi.and_mono; auto.
+      apply bi.and_mono; auto.
       apply subst_derives.
       apply fupd_intro.
-    - apply exp_derives; intros cmp.
-      apply exp_derives; intros e1.
-      apply exp_derives; intros e2.
-      apply exp_derives; intros ty.
-      apply exp_derives; intros sh1.
-      apply exp_derives; intros sh2.
-      apply andp_derives; auto.
-      apply later_derives; auto.
-      apply andp_derives; auto.
+    - apply bi.exist_mono; intros cmp.
+      apply bi.exist_mono; intros e1.
+      apply bi.exist_mono; intros e2.
+      apply bi.exist_mono; intros ty.
+      apply bi.exist_mono; intros sh1.
+      apply bi.exist_mono; intros sh2.
+      apply bi.and_mono; auto.
+      apply bi.later_mono; auto.
+      apply bi.and_mono; auto.
+      apply bi.and_mono; auto.
+      apply bi.and_mono; auto.
+      apply bi.and_mono; auto.
+      apply bi.and_mono; auto.
       apply subst_derives.
       apply fupd_intro.
-    - apply exp_derives; intros sh.
-      apply exp_derives; intros t2.
-      apply exp_derives; intros v2.
-      apply andp_derives; auto.
-      apply later_derives.
-      apply andp_derives; auto.
+    - apply bi.exist_mono; intros sh.
+      apply bi.exist_mono; intros t2.
+      apply bi.exist_mono; intros v2.
+      apply bi.and_mono; auto.
+      apply bi.later_mono, bi.and_mono; auto.
       apply subst_derives.
       apply fupd_intro.
-    - apply exp_derives; intros sh.
-      apply exp_derives; intros e1.
-      apply exp_derives; intros t1.
-      apply exp_derives; intros v2.
-      apply andp_derives; auto.
-      apply later_derives.
-      apply andp_derives; auto.
+    - apply bi.exist_mono; intros sh.
+      apply bi.exist_mono; intros e1.
+      apply bi.exist_mono; intros t1.
+      apply bi.exist_mono; intros v2.
+      apply bi.and_mono; auto.
+      apply bi.later_mono.
+      apply bi.and_mono; auto.
+      apply bi.and_mono; auto.
+      apply bi.and_mono; auto.
       apply subst_derives.
       apply fupd_intro.
   + subst c.
@@ -752,16 +802,14 @@ Proof.
     apply orp_ENTAILL; [apply orp_ENTAILL; [apply orp_ENTAILL |] |].
     - apply later_ENTAILL.
       unfold tc_temp_id, typecheck_temp_id.
-      destruct ((temp_types Delta) ! id) eqn:?H; [| normalize].
+      destruct ((temp_types Delta) !! id) eqn:Hid; last by rewrite denote_tc_assert_False; iIntros "(? & ? & _ & [] & _)".
+      rewrite !bi.and_assoc.
       eapply andp_subst_ENTAILL; [eauto | | reduceLL; apply ENTAIL_refl |].
-      * destruct (is_neutral_cast (implicit_deref (typeof e)) t) eqn:?H; [| normalize].
-        intro rho; unfold_lift; unfold local, lift1; simpl.
-        normalize.
-        apply andp_left2, andp_left1.
-        eapply derives_trans; [apply typecheck_expr_sound; auto |].
-        normalize.
-        intros _.
-        eapply expr2.neutral_cast_subsumption'; eauto.
+      * destruct (is_neutral_cast (implicit_deref (typeof e)) t) eqn:Ht; [|normalize; iIntros "(_ & _ & _ & [])"].
+        split => rho; rewrite /local /lift1; monPred.unseal; unfold_lift.
+        iIntros "(% & _ & H & _)".
+        iPoseProof (typecheck_expr_sound with "H") as "%"; first done; iPureIntro.
+        eapply tc_val_tc_val', expr2.neutral_cast_subsumption'; eauto.
       * apply derives_full_fupd_left.
         auto.
     - apply exp_ENTAILL; intro cmp.
@@ -770,74 +818,69 @@ Proof.
       apply exp_ENTAILL; intro ty.
       apply exp_ENTAILL; intro sh1.
       apply exp_ENTAILL; intro sh2.
-      normalize.
-      destruct H0 as [He [? [? [? [? [? ?]]]]]].
-      apply later_ENTAILL.
-      unfold typecheck_tid_ptr_compare in H10.
-      destruct ((temp_types Delta) ! id) eqn:?H; [| inv H10].
-      eapply andp_subst_ENTAILL; [eauto | | reduceLL; apply ENTAIL_refl |].
-      * unfold_lift; unfold local, lift1; intro rho.
-        rewrite <- He; simpl.
-        normalize.
-        apply andp_left2, andp_left1, andp_left1.
-        eapply derives_trans; [apply andp_derives; [| apply derives_refl]; apply andp_derives; apply typecheck_expr_sound; auto |].
-        normalize.
-        subst e.
-        simpl.
-        unfold_lift.
+      iIntros "(? & ? & (%He & % & % & % & % & % & %Ht) & H)"; iSplit; first done.
+      iNext; iStopProof.
+      unfold typecheck_tid_ptr_compare in Ht.
+      destruct ((temp_types Delta) !! id) eqn:Hid; last done.
+      rewrite -bi.persistent_and_affinely_sep_l !assoc; eapply andp_subst_ENTAILL; first done.
+      * split => rho; rewrite /local /lift1; monPred.unseal; unfold_lift; apply bi.pure_intro.
         replace (sem_binary_operation' cmp) with (sem_cmp (expr.op_to_cmp cmp)); [| destruct cmp; inv H7; auto].
         apply binop_lemmas2.tc_val'_sem_cmp; auto.
-      * apply derives_full_fupd_left.
-        auto.
+      * iIntros "(_ & _ & $)".
+      * iIntros "(? & ? & >?)"; iApply H1; iFrame.
     - apply exp_ENTAILL; intro sh.
       apply exp_ENTAILL; intro t2.
       apply exp_ENTAILL; intro v2.
-      normalize.
-      destruct H0 as [? [? ?]].
-      apply later_ENTAILL.
-      unfold typeof_temp in H0.
-      destruct ((temp_types Delta) ! id) eqn:?H; inv H0.
-      eapply andp_subst_ENTAILL; [eauto | | reduceLL; apply ENTAIL_refl |].
-      * reduceL.
-        apply andp_left1.
-        apply andp_left2.
-        unfold_lift; unfold local, lift1; intro rho; simpl; normalize.
-        intros _; eapply expr2.neutral_cast_subsumption; eauto.
-      * apply derives_full_fupd_left.
-        auto.
+      iIntros "(? & ? & (%Ht & % & %) & H)"; iSplit; first done.
+      iNext; iStopProof.
+      unfold typeof_temp in Ht.
+      destruct ((temp_types Delta) !! id) eqn:Hid; inv Ht.
+      rewrite -bi.persistent_and_affinely_sep_l !assoc; eapply andp_subst_ENTAILL; first done.
+      * split => rho; rewrite /local /lift1; monPred.unseal; unfold_lift.
+        iIntros "(% & _ & (_ & %) & _)"; iPureIntro.
+        eapply tc_val_tc_val', neutral_cast_subsumption; eauto.
+      * iIntros "(_ & _ & $)".
+      * iIntros "(? & ? & >?)"; iApply H1; iFrame.
     - apply exp_ENTAILL; intro sh.
       apply exp_ENTAILL; intro e1.
       apply exp_ENTAILL; intro t1.
       apply exp_ENTAILL; intro t2.
-      normalize.
-      destruct H0 as [He [? [? ?]]].
-      apply later_ENTAILL.
-      unfold typeof_temp in H0.
-      destruct ((temp_types Delta) ! id) eqn:?H; inv H0.
-      eapply andp_subst_ENTAILL; [eauto | | reduceLL; apply ENTAIL_refl |].
-      * reduceL.
-        apply andp_left1.
-        apply andp_left2.
-        unfold_lift; unfold local, lift1; intro rho; simpl; normalize.
-        intros _; auto.
-      * apply derives_full_fupd_left.
-        auto.
-Qed.
-
-Lemma semax_Sbuiltin_inv: forall {CS: compspecs} {Espec: OracleKind} Delta P R opt ext tl el,
-  @semax CS Espec Delta P (Sbuiltin opt ext tl el) R -> local (tc_environ Delta) && (allp_fun_id Delta && P) |-- |={Ensembles.Full_set}=> FF.
+      iIntros "(? & ? & (%He & %Ht & %) & H)"; iSplit; first done.
+      iNext; iStopProof.
+      unfold typeof_temp in Ht.
+      destruct ((temp_types Delta) !! id) eqn:Hid; inv Ht.
+      rewrite -bi.persistent_and_affinely_sep_l !assoc; eapply andp_subst_ENTAILL; first done.
+      * split => rho; rewrite /local /lift1; monPred.unseal; unfold_lift.
+        iIntros "(% & _ & (_ & %) & _)"; iPureIntro.
+        apply tc_val_tc_val'; auto.
+      * iIntros "(_ & _ & $)".
+      * iIntros "(? & ? & >?)"; iApply H1; iFrame.
+  + iIntros "H".
+    iMod (fupd_mask_subseteq E') as "Hmask"; first done.
+    iMod (IHsemax with "H") as "H"; first done.
+    iMod "Hmask" as "_"; iIntros "!>".
+    iDestruct "H" as "[[[H | H] | H] | H]"; [iLeft; iLeft; iLeft | iLeft; iLeft; iRight | iLeft; iRight | iRight].
+    - rewrite subst_extens // fupd_mask_mono //.
+    - iDestruct "H" as (??????) "H"; iExists _, _, _, _, _, _; rewrite subst_extens // fupd_mask_mono //.
+    - iDestruct "H" as (???) "H"; iExists _, _, _; rewrite subst_extens // fupd_mask_mono //.
+    - iDestruct "H" as (????) "H"; iExists _, _, _, _; rewrite subst_extens // fupd_mask_mono //.
+Qed.
+
+Lemma semax_Sbuiltin_inv: forall E Delta P R opt ext tl el,
+  semax E Delta P (Sbuiltin opt ext tl el) R -> local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢ |={E}=> False.
 Proof.
   intros.
   remember (Sbuiltin opt ext tl el) as c eqn:?H.
   induction H; try solve [inv H0].
-  + reduceL; apply FF_left.
+  + reduceL; apply False_left.
   + derives_rewrite -> H.
     derives_rewrite -> (IHsemax H0).
-    reduceL; apply FF_left.
+    reduceL; apply False_left.
+  + rewrite -fupd_mask_mono //; auto.
 Qed.
 
-Lemma semax_Slabel_inv: forall {CS: compspecs} {Espec: OracleKind} Delta P R l c,
-  @semax CS Espec Delta P (Slabel l c) R -> @semax CS Espec Delta P c R.
+Lemma semax_Slabel_inv: forall E Delta P R l c,
+  semax E Delta P (Slabel l c) R -> semax E Delta P c R.
 Proof.
   intros.
   remember (Slabel l c) as c0 eqn:?H.
@@ -846,27 +889,30 @@ Proof.
     apply H.
   + specialize (IHsemax H0).
     eapply semax_conseq; eauto.
+  + eapply AuxDefs.semax_mask_mono; eauto.
+    by apply IHsemax.
 Qed.
 
-Lemma semax_Sgoto_inv: forall {CS: compspecs} {Espec: OracleKind} Delta P R l,
-  @semax CS Espec Delta P (Sgoto l) R -> local (tc_environ Delta) && (allp_fun_id Delta && P) |-- |={Ensembles.Full_set}=> FF.
+Lemma semax_Sgoto_inv: forall E Delta P R l,
+  semax E Delta P (Sgoto l) R -> local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢ |={E}=> False.
 Proof.
   intros.
   remember (Sgoto l) as c eqn:?H.
   induction H; try solve [inv H0].
-  + reduceL; apply FF_left.
+  + reduceL; apply False_left.
   + derives_rewrite -> H.
     derives_rewrite -> (IHsemax H0).
-    reduceL; apply FF_left.
+    reduceL; apply False_left.
+  + rewrite -fupd_mask_mono //; auto.
 Qed.
 
-Lemma semax_ifthenelse_inv: forall {CS: compspecs} {Espec: OracleKind} Delta P R b c1 c2,
-  @semax CS Espec Delta P (Sifthenelse b c1 c2) R ->
-  local (tc_environ Delta) && (allp_fun_id Delta && P) |--
-  |={Ensembles.Full_set}=> (!! (bool_type (typeof b) = true) && |> (tc_expr Delta (Eunop Cop.Onotbool b (Tint I32 Signed noattr)) &&
-  (EX P': environ -> mpred,
-  !! (@semax CS Espec Delta (P' && local (`(typed_true (typeof b)) (eval_expr b))) c1 R /\
-      @semax CS Espec Delta (P' && local (`(typed_false (typeof b)) (eval_expr b))) c2 R) &&
+Lemma semax_ifthenelse_inv: forall E Delta P R b c1 c2,
+  semax E Delta P (Sifthenelse b c1 c2) R ->
+  local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢
+  |={E}=> (⌜bool_type (typeof b) = true⌝ ∧ ▷ (tc_expr Delta (Eunop Cop.Onotbool b (Tint I32 Signed noattr)) ∧
+  (∃ P': assert,
+  ⌜semax E Delta (P' ∧ local (`(typed_true (typeof b)) (eval_expr b))) c1 R /\
+      semax E Delta (P' ∧ local (`(typed_false (typeof b)) (eval_expr b))) c2 R⌝ ∧
   P'))).
 Proof.
   intros.
@@ -874,33 +920,34 @@ Proof.
   induction H; try solve [inv H0].
   + inv H0; clear IHsemax1 IHsemax2.
     reduce2derives.
-    apply andp_derives; auto.
-    apply later_derives.
-    apply andp_derives; auto.
-    apply (exp_right P).
-    apply andp_right; [apply prop_right; auto |].
-    auto.
+    apply bi.and_mono; auto.
+    apply bi.later_mono.
+    apply bi.and_mono; auto.
   + derives_rewrite -> H.
     derives_rewrite -> (IHsemax H0); clear IHsemax.
     reduce2derives.
-    apply andp_derives; auto.
-    apply later_derives.
-    apply andp_derives; auto.
-    apply exp_derives; intros P''.
-    normalize.
-    apply andp_right; auto.
-    apply prop_right.
-    destruct H6; split.
-    - eapply semax_conseq; eauto. apply derives_full_refl.
-    - eapply semax_conseq; eauto. apply derives_full_refl.
-Qed.
-
-Lemma semax_loop_inv: forall {CS: compspecs} {Espec: OracleKind} Delta P R body incr,
-  @semax CS Espec Delta P (Sloop body incr) R ->
-  local (tc_environ Delta) && (allp_fun_id Delta && P) |--
-  |={Ensembles.Full_set}=> EX Q: environ -> mpred, EX Q': environ -> mpred,
-  !! (@semax CS Espec Delta Q body (loop1_ret_assert Q' R) /\
-      @semax CS Espec Delta Q' incr (loop2_ret_assert Q R)) &&
+    apply bi.and_mono; auto.
+    apply bi.later_mono.
+    apply bi.and_mono; auto.
+    apply bi.exist_mono; intros P''.
+    iIntros "((%Htrue & %Hfalse) & $)"; iPureIntro; split; last done.
+    split; [eapply semax_conseq, Htrue | eapply semax_conseq, Hfalse]; eauto; apply derives_full_refl.
+  + iIntros "H".
+    iMod (fupd_mask_subseteq E') as "Hmask"; first done.
+    iMod (IHsemax with "H") as "(% & H)"; first done.
+    iMod "Hmask" as "_"; iIntros "!>"; iSplit; first done.
+    iNext; iApply (bi.and_mono with "H"); first done.
+    iIntros "H"; iDestruct "H" as (?) "((% & %) & H)".
+    iExists P'; iSplit; last done.
+    iPureIntro; split; eapply AuxDefs.semax_mask_mono; eauto.
+Qed.
+
+Lemma semax_loop_inv: forall E Delta P R body incr,
+  semax E Delta P (Sloop body incr) R ->
+  local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢
+  |={E}=> ∃ Q: assert, ∃ Q': assert,
+  ⌜semax E Delta Q body (loop1_ret_assert Q' R) /\
+      semax E Delta Q' incr (loop2_ret_assert Q R)⌝ ∧
   Q.
 Proof.
   intros.
@@ -908,20 +955,15 @@ Proof.
   induction H; try solve [inv H0].
   + inv H0; clear IHsemax1 IHsemax2.
     reduce2derives.
-    apply (exp_right Q).
-    apply (exp_right Q').
-    apply andp_right; [apply prop_right; auto |].
-    auto.
+    iIntros "Q"; iExists Q, Q'; iFrame; auto.
   + derives_rewrite -> H.
     derives_rewrite -> (IHsemax H0); clear IHsemax.
     reduce2derives.
-    apply exp_derives; intros Q.
-    apply exp_derives; intros Q'.
-    normalize.
-    apply andp_right; [apply prop_right |]; auto.
-    destruct H6.
+    apply bi.exist_mono; intros Q.
+    apply bi.exist_mono; intros Q'.
+    iIntros "((%Hs1 & %Hs2) & $)"; iPureIntro; split; last done.
     split.
-    - destruct R as [nR bR cR rR], R' as [nR' bR' cR' rR']; simpl in H6, H7 |- *.
+    - destruct R as [nR bR cR rR], R' as [nR' bR' cR' rR']; simpl in Hs1, Hs2 |- *.
       simpl RA_normal in H1; simpl RA_break in H2; simpl RA_continue in H3; simpl RA_return in H4.
       eapply semax_conseq; [.. | eassumption]; unfold loop1_ret_assert.
       * apply derives_full_refl.
@@ -933,7 +975,7 @@ Proof.
         apply derives_full_refl.
       * simpl RA_return.
         auto.
-    - destruct R as [nR bR cR rR], R' as [nR' bR' cR' rR']; simpl in H6, H7 |- *.
+    - destruct R as [nR bR cR rR], R' as [nR' bR' cR' rR']; simpl in Hs1, Hs2 |- *.
       simpl RA_normal in H1; simpl RA_break in H2; simpl RA_continue in H3; simpl RA_return in H4.
       eapply semax_conseq; [.. | eassumption]; unfold loop1_ret_assert.
       * apply derives_full_refl.
@@ -945,281 +987,244 @@ Proof.
         apply derives_full_refl.
       * simpl RA_return.
         auto.
-Qed.
-
-Lemma semax_switch_inv: forall {CS: compspecs} {Espec: OracleKind} Delta P R a sl,
-  @semax CS Espec Delta P (Sswitch a sl) R ->
-  local (tc_environ Delta) && (allp_fun_id Delta && P) |--
-        |={Ensembles.Full_set}=> !! (is_int_type (typeof a) = true) && (tc_expr Delta a) &&
-        EX P': environ -> mpred,
-  !! (forall n,
-     @semax CS Espec Delta 
-               (local (`eq (eval_expr a) `(Vint n)) && P')
+  + iIntros "H".
+    iMod (fupd_mask_subseteq E') as "Hmask"; first done.
+    iMod (IHsemax with "H") as (??) "((% & %) & H)"; first done.
+    iMod "Hmask" as "_"; iIntros "!>".
+    iExists Q, Q'; iSplit; last done.
+    iPureIntro; split; eapply AuxDefs.semax_mask_mono; eauto.
+Qed.
+
+Lemma semax_switch_inv: forall E Delta P R a sl,
+  semax E Delta P (Sswitch a sl) R ->
+  local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢
+        |={E}=> ⌜is_int_type (typeof a) = true⌝ ∧ (tc_expr Delta a) ∧
+        ∃ P': assert,
+  ⌜forall n,
+     semax E Delta 
+               (local ((liftx eq) (eval_expr a) `(Vint n)) ∧ P')
                (seq_of_labeled_statement (select_switch (Int.unsigned n) sl))
-               (switch_ret_assert R)) && P'.
+               (switch_ret_assert R)⌝ ∧ P'.
 Proof.
   intros.
   remember (Sswitch a sl) as c eqn:?H.
   induction H; try solve [inv H0].
   + inv H0.
     reduce2derives.
-    rewrite andp_assoc.
-    apply andp_derives; auto.
-    apply andp_right; auto.
-    apply (exp_right Q).
-    apply andp_right; [apply prop_right; auto |].
-    auto.
+    apply bi.and_mono; auto.
+    apply bi.and_intro; first done.
+    iIntros "?"; iExists Q; iFrame; auto.
   + derives_rewrite -> H.
     derives_rewrite -> (IHsemax H0); clear IHsemax.
     reduce2derives.
-    apply andp_derives; auto.
-    apply exp_derives; intros P''.
-    apply andp_derives; auto.
-    apply prop_derives; intro.
+    apply bi.and_mono; auto.
+    apply bi.and_mono; auto.
+    apply bi.exist_mono; intros P''.
+    iIntros "(% & $)"; iPureIntro; split; last done.
     intro n; specialize (H6 n).
     eapply semax_conseq; [.. | exact H6].
     - apply derives_full_refl.
     - destruct R as [nR bR cR rR], R' as [nR' bR' cR' rR'].
-      reduce2derives; apply FF_left.
+      reduce2derives; apply False_left.
     - destruct R as [nR bR cR rR], R' as [nR' bR' cR' rR'].
       exact H1.
     - destruct R as [nR bR cR rR], R' as [nR' bR' cR' rR'].
       exact H3.
     - destruct R as [nR bR cR rR], R' as [nR' bR' cR' rR'].
       exact H4.
+  + iIntros "H".
+    iMod (fupd_mask_subseteq E') as "Hmask"; first done.
+    iMod (IHsemax with "H") as "(% & H)"; first done.
+    iMod "Hmask" as "_"; iIntros "!>"; iSplit; first done.
+    iApply (bi.and_mono with "H"); first done.
+    iIntros "H"; iDestruct "H" as (?) "(%HE' & ?)".
+    iExists P'; iSplit; last done.
+    iPureIntro; intros; eapply AuxDefs.semax_mask_mono, HE'; auto.
 Qed.
 
+End mpred.
+
 Module Extr: CLIGHT_SEPARATION_HOARE_LOGIC_EXTRACTION with Module CSHL_Def := CSHL_Def.
 
 Module CSHL_Def := CSHL_Def.
 Import CSHL_Def.
 
-Arguments semax {_} {_} _ _ _ _.
-
 Lemma semax_extract_exists:
-  forall {CS: compspecs} {Espec: OracleKind},
-  forall (A : Type)  (P : A -> environ->mpred) c (Delta: tycontext) (R: ret_assert),
-  (forall x, @semax CS Espec Delta (P x) c R) ->
-   @semax CS Espec Delta (EX x:A, P x) c R.
+  forall `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} {CS: compspecs},
+  forall (A : Type) (P : A -> assert) c E (Delta: tycontext) (R: ret_assert),
+  (forall x, semax E Delta (P x) c R) ->
+   semax E Delta (∃ x:A, P x) c R.
 Proof.
   intros.
   revert A P R H; induction_stmt c; intros.
-  + pose proof (fun x => semax_skip_inv _ _ _ (H x)).
-    eapply semax_conseq.
-    - rewrite !exp_andp2; apply exp_left.
-      intro x.
-      apply H0.
+  + pose proof (fun x => semax_skip_inv _ _ _ _ (H x)).
+    eapply (semax_conseq _ _ (RA_normal R)).
+    - iIntros "(? & ? & % & ?)"; iApply H0; iFrame.
     - apply derives_full_refl.
     - apply derives_full_refl.
     - apply derives_full_refl.
-    - intros; apply andp_left2, andp_left2, derives_refl.
+    - intros; iIntros "(_ & _ & $)".
     - eapply semax_post''; [.. | apply AuxDefs.semax_skip].
       apply ENTAIL_refl.
-  + pose proof (fun x => semax_assign_inv _ _ _ _ _ (H x)).
+  + pose proof (fun x => semax_assign_inv _ _ _ _ _ _ (H x)).
     clear H.
-    apply exp_left in H0.
-    rewrite <- !(exp_andp2 A) in H0.
+    apply bi.exist_elim in H0.
+    rewrite -bi.and_exist_l -bi.sep_exist_l in H0.
     eapply semax_conseq; [exact H0 | intros; try apply derives_full_refl .. | clear H0 ].
-    { apply andp_left2, andp_left2, derives_refl. }
+    { iIntros "(_ & _ & $)". }
     eapply semax_conseq; [apply derives_full_refl | .. | apply AuxDefs.semax_store_store_union_hack_backward].
-    - reduceL. apply derives_refl.
-    - reduceL. apply FF_left.
-    - reduceL. apply FF_left.
-    - intros; reduceL. apply FF_left.
-  + pose proof (fun x => semax_Sset_inv _ _ _ _ _ (H x)).
+    - reduceL. done.
+    - reduceL. apply False_left.
+    - reduceL. apply False_left.
+    - intros; reduceL. apply False_left.
+  + pose proof (fun x => semax_Sset_inv _ _ _ _ _ _ (H x)).
     clear H.
-    apply exp_left in H0.
-    rewrite <- !(exp_andp2 A) in H0.
+    apply bi.exist_elim in H0.
+    rewrite -bi.and_exist_l -bi.sep_exist_l in H0.
     eapply semax_conseq; [exact H0 | intros; try apply derives_full_refl .. | clear H0 ].
-    { apply andp_left2, andp_left2, derives_refl. }
+    { iIntros "(_ & _ & $)". }
     eapply semax_conseq; [apply derives_full_refl | .. | apply AuxDefs.semax_set_ptr_compare_load_cast_load_backward].
-    - reduceL. apply derives_refl.
-    - reduceL. apply FF_left.
-    - reduceL. apply FF_left.
-    - intros; reduceL. apply FF_left.
-  + pose proof (fun x => semax_call_inv _ _ _ _ _ _ (H x)).
+    - reduceL. done.
+    - reduceL. apply False_left.
+    - reduceL. apply False_left.
+    - intros; reduceL. apply False_left.
+  + pose proof (fun x => semax_call_inv _ _ _ _ _ _ _ (H x)).
     clear H.
-    apply exp_left in H0.
-    rewrite <- !(exp_andp2 A) in H0.
+    apply bi.exist_elim in H0.
+    rewrite -bi.and_exist_l -bi.sep_exist_l in H0.
     eapply semax_conseq; [exact H0 | intros; try apply derives_full_refl .. | clear H0 ].
-    { apply andp_left2, andp_left2, derives_refl. }
+    { iIntros "(_ & _ & $)". }
     eapply semax_conseq; [apply derives_full_refl | .. | apply AuxDefs.semax_call_backward].
-    - reduceL. apply derives_refl.
-    - reduceL. apply FF_left.
-    - reduceL. apply FF_left.
-    - intros; reduceL. apply FF_left.
-  + pose proof (fun x => semax_Sbuiltin_inv _ _ _ _ _ _ _ (H x)).
+    - reduceL. done.
+    - reduceL. apply False_left.
+    - reduceL. apply False_left.
+    - intros; reduceL. apply False_left.
+  + pose proof (fun x => semax_Sbuiltin_inv _ _ _ _ _ _ _ _ (H x)).
     eapply semax_conseq; [| intros; try apply derives_full_refl .. | apply AuxDefs.semax_builtin].
-    rewrite !exp_andp2.
-    apply exp_left; intros x; specialize (H0 x).
+    rewrite bi.sep_exist_l bi.and_exist_l.
+    apply bi.exist_elim; intros x; specialize (H0 x).
     auto.
-    { apply andp_left2, andp_left2, derives_refl. }
-  + apply AuxDefs.semax_seq with (EX Q: environ -> mpred, !! (semax Delta Q c2 R) && Q).
+    { iIntros "(_ & _ & $)". }
+  + apply AuxDefs.semax_seq with (∃ Q: assert, ⌜semax E Delta Q c2 R⌝ ∧ Q).
     - apply IHc1.
       intro x.
       apply semax_seq_inv'; auto.
     - apply IHc2.
       intros Q.
-      apply semax_pre with (EX H0: semax Delta Q c2 R, Q).
-      * apply andp_left2.
-        apply derives_extract_prop; intros.
-        apply (exp_right H0).
-        auto.
-      * apply IHc2.
-        intro H0.
-        auto.
-  + eapply semax_conseq; [| intros; try apply derives_full_refl .. | apply (AuxDefs.semax_ifthenelse _ (EX P': environ -> mpred, !! (semax Delta (P' && local (`(typed_true (typeof e)) (eval_expr e))) c1 R /\ semax Delta (P' && local (`(typed_false (typeof e)) (eval_expr e))) c2 R) && P'))].
-    - pose proof (fun x => semax_ifthenelse_inv _ _ _ _ _ _ (H x)).
+      apply semax_pre with (∃ H0: semax E Delta Q c2 R, Q).
+      * iIntros "(_ & % & ?)".
+        iExists H0; auto.
+      * apply IHc2; auto.
+  + eapply semax_conseq; [| intros; try apply derives_full_refl .. | apply (AuxDefs.semax_ifthenelse _ _ (∃ P': assert, ⌜semax E Delta (P' ∧ local (`(typed_true (typeof e)) (eval_expr e)))%I c1 R /\ semax E Delta (P' ∧ local (`(typed_false (typeof e)) (eval_expr e)))%I c2 R⌝ ∧ P'))].
+    - pose proof (fun x => semax_ifthenelse_inv _ _ _ _ _ _ _ (H x)).
       clear H.
-      apply exp_left in H0.
-      rewrite <- !(exp_andp2 A) in H0.
+      apply bi.exist_elim in H0.
+      rewrite -bi.and_exist_l -bi.sep_exist_l in H0.
       exact H0.
-    - apply andp_left2, andp_left2, derives_refl.
-    - rewrite exp_andp1.
-      apply IHc1.
-      intro P'.
-      apply semax_pre with (EX H0: semax Delta (P' && local ((` (typed_true (typeof e))) (eval_expr e))) c1 R, P' && local ((` (typed_true (typeof e))) (eval_expr e))).
-      * apply andp_left2.
-        rewrite !andp_assoc.
-        apply derives_extract_prop; intros.
-        apply (exp_right (proj1 H0)).
-        solve_andp.
-      * apply IHc1.
-        intro H0.
-        auto.
-    - rewrite exp_andp1.
-      apply IHc2.
-      intro P'.
-      apply semax_pre with (EX H0: semax Delta (P' && local ((` (typed_false (typeof e))) (eval_expr e))) c2 R, P' && local ((` (typed_false (typeof e))) (eval_expr e))).
-      * apply andp_left2.
-        rewrite !andp_assoc.
-        apply derives_extract_prop; intros.
-        apply (exp_right (proj2 H0)).
-        solve_andp.
-      * apply IHc2.
-        intro H0.
-        auto.
-  + pose proof (fun x => semax_loop_inv _ _ _ _ _ (H x)).
-    eapply (AuxDefs.semax_conseq _ 
-      (EX Q : environ -> mpred, EX Q' : environ -> mpred,
-         EX H: semax Delta Q c1 (loop1_ret_assert Q' R),
-           EX H0: semax Delta Q' c2 (loop2_ret_assert Q R), Q));
+    - iIntros "(_ & _ & $)".
+    - apply semax_pre with (∃ P': assert, ∃ H0: semax E Delta (P' ∧ local ((` (typed_true (typeof e))) (eval_expr e))) c1 R, P' ∧ local ((` (typed_true (typeof e))) (eval_expr e))).
+      * rewrite bi.and_elim_r bi.and_exist_r; apply bi.exist_mono; intros.
+        rewrite -assoc; iIntros "((% & %) & $)"; eauto.
+      * auto.
+    - apply semax_pre with (∃ P': assert, ∃ H0: semax E Delta (P' ∧ local ((` (typed_false (typeof e))) (eval_expr e))) c2 R, P' ∧ local ((` (typed_false (typeof e))) (eval_expr e))).
+      * rewrite bi.and_elim_r bi.and_exist_r; apply bi.exist_mono; intros.
+        rewrite -assoc; iIntros "((% & %) & $)"; eauto.
+      * auto.
+  + pose proof (fun x => semax_loop_inv _ _ _ _ _ _ (H x)).
+    eapply (AuxDefs.semax_conseq _ _
+      (∃ Q : assert, ∃ Q' : assert,
+         ∃ H: semax E Delta Q c1 (loop1_ret_assert Q' R),
+           ∃ H0: semax E Delta Q' c2 (loop2_ret_assert Q R), Q));
     [| intros; try apply derives_full_refl .. |].
-    {
-      rewrite !exp_andp2.
-      apply exp_left.
-      intros x.
+    { rewrite bi.sep_exist_l bi.and_exist_l.
+      apply bi.exist_elim; intros x.
       derives_rewrite -> (H0 x).
       reduce2derives.
-      apply exp_derives; intros Q.
-      apply exp_derives; intros Q'.
-      apply derives_extract_prop; intros [? ?].
-      apply (exp_right H1).
-      apply (exp_right H2).
-      auto.
-    }
-    { apply andp_left2, andp_left2, derives_refl. }
-    apply (AuxDefs.semax_loop _ _
-      (EX Q : environ -> mpred, EX Q' : environ -> mpred,
-         EX H: semax Delta Q c1 (loop1_ret_assert Q' R),
-           EX H0: semax Delta Q' c2 (loop2_ret_assert Q R), Q')).
+      apply bi.exist_mono; intros Q.
+      apply bi.exist_mono; intros Q'.
+      iIntros "((% & %) & $)"; eauto. }
+    { iIntros "(_ & _ & $)". }
+    apply (AuxDefs.semax_loop _ _ _
+      (∃ Q : assert, ∃ Q' : assert,
+         ∃ H: semax E Delta Q c1 (loop1_ret_assert Q' R),
+           ∃ H0: semax E Delta Q' c2 (loop2_ret_assert Q R), Q')).
     - apply IHc1.
       intros Q.
       apply IHc1.
       intros Q'.
       apply IHc1.
-      intros ?H.
+      intros H1.
       apply IHc1.
-      intros ?H.
+      intros H2.
       eapply semax_post_simple; [.. | exact H1].
       * destruct R as [nR bR cR rR].
-        unfold loop1_ret_assert.
-        apply (exp_right Q), (exp_right Q'), (exp_right H1), (exp_right H2).
-        apply derives_refl.
-      * destruct R as [nR bR cR rR].
-        apply derives_refl.
+        iIntros; iExists Q, Q', H1, H2; done.
+      * destruct R as [nR bR cR rR]; done.
       * destruct R as [nR bR cR rR].
-        unfold loop1_ret_assert.
-        apply (exp_right Q), (exp_right Q'), (exp_right H1), (exp_right H2).
-        apply derives_refl.
+        iIntros; iExists Q, Q', H1, H2; done.
       * intros.
-        destruct R as [nR bR cR rR].
-        apply derives_refl.
+        destruct R as [nR bR cR rR]; done.
     - apply IHc2.
       intros Q.
       apply IHc2.
       intros Q'.
       apply IHc2.
-      intros ?H.
+      intros H1.
       apply IHc2.
-      intros ?H.
+      intros H2.
       eapply semax_post_simple; [.. | exact H2].
       * destruct R as [nR bR cR rR].
-        unfold loop1_ret_assert.
-        apply (exp_right Q), (exp_right Q'), (exp_right H1), (exp_right H2).
-        apply derives_refl.
-      * destruct R as [nR bR cR rR].
-        apply derives_refl.
-      * destruct R as [nR bR cR rR].
-        apply derives_refl.
+        iIntros; iExists Q, Q', H1, H2; done.
+      * destruct R as [nR bR cR rR]; done.
+      * destruct R as [nR bR cR rR]; done.
       * intros.
-        destruct R as [nR bR cR rR].
-        apply derives_refl.
-  + pose proof (fun x => semax_break_inv _ _ _ (H x)).
+        destruct R as [nR bR cR rR]; done.
+  + pose proof (fun x => semax_break_inv _ _ _ _ (H x)).
     eapply semax_conseq; [| intros; try apply derives_full_refl .. |].
-    - rewrite !exp_andp2; apply exp_left.
+    - rewrite bi.sep_exist_l bi.and_exist_l; apply bi.exist_elim.
       intro x; apply H0.
-    - apply andp_left2, andp_left2, derives_refl.
+    - iIntros "(_ & _ & $)".
     - apply AuxDefs.semax_break.
-  + pose proof (fun x => semax_continue_inv _ _ _ (H x)).
+  + pose proof (fun x => semax_continue_inv _ _ _ _ (H x)).
     eapply semax_conseq; [| intros; try apply derives_full_refl .. |].
-    - rewrite !exp_andp2; apply exp_left.
+    - rewrite bi.sep_exist_l bi.and_exist_l; apply bi.exist_elim.
       intro x; apply H0.
-    - apply andp_left2, andp_left2, derives_refl.
+    - iIntros "(_ & _ & $)".
     - apply AuxDefs.semax_continue.
-  + pose proof (fun x => semax_return_inv _ _ _ _ (H x)).
-    eapply (semax_conseq _ _ {| RA_normal := _; RA_break := _; RA_continue := _; RA_return := RA_return R |}); [.. | apply AuxDefs.semax_return].
-    - rewrite !exp_andp2.
-      apply exp_left; intros x.
+  + pose proof (fun x => semax_return_inv _ _ _ _ _ (H x)).
+    eapply (semax_conseq _ _ _ {| RA_normal := _; RA_break := _; RA_continue := _; RA_return := RA_return R |} ); [.. | apply AuxDefs.semax_return].
+    - rewrite bi.sep_exist_l bi.and_exist_l.
+      apply bi.exist_elim; intros x.
       derives_rewrite -> (H0 x).
       apply derives_full_refl.
     - apply derives_full_refl.
     - apply derives_full_refl.
     - apply derives_full_refl.
-    - intros; unfold RA_return at 1. apply andp_left2, andp_left2, derives_refl.
-  + pose proof (fun x => semax_switch_inv _ _ _ _ _ (H x)).
+    - intros; unfold RA_return at 1. iIntros "(_ & _ & $)".
+  + pose proof (fun x => semax_switch_inv _ _ _ _ _ _ (H x)).
     eapply semax_conseq; [| intros; try apply derives_full_refl .. |].
-    - rewrite !exp_andp2; apply exp_left.
+    - rewrite bi.sep_exist_l bi.and_exist_l; apply bi.exist_elim.
       intro x; apply H0.
-    - apply andp_left2, andp_left2, derives_refl.
-    - rewrite andp_assoc.
-      apply AuxDefs.semax_switch; [intros; simpl; solve_andp |].
+    - iIntros "(_ & _ & $)".
+    - apply AuxDefs.semax_switch; [intros; simpl; solve_andp |].
       intros.
       specialize (IH (Int.unsigned n)).
-      rewrite !exp_andp2.
-      apply IH.
-      intros P'.
-      apply semax_pre with (EX H: forall n0 : int,
-           semax Delta (local ((` eq) (eval_expr e) (` (Vint n0))) && P')
+      apply semax_pre with (∃ P': assert, ∃ H: forall n0 : int,
+           semax E Delta (local ((` eq) (eval_expr e) (` (Vint n0))) ∧ P')
              (seq_of_labeled_statement (select_switch (Int.unsigned n0) l))
-             (switch_ret_assert R), local ((` eq) (eval_expr e) (` (Vint n))) && P').
-      * rewrite (andp_comm (prop _)), <- !andp_assoc, <- (andp_comm (prop _)).
-        apply derives_extract_prop; intros.
-        apply (exp_right H1).
-        solve_andp.
-      * apply IH.
-        intros ?H.
-        auto.
-  + pose proof (fun x => semax_Slabel_inv _ _ _ _ _ (H x)).
+             (switch_ret_assert R), local ((` eq) (eval_expr e) (` (Vint n))) ∧ P').
+      * iIntros "(_ & #? & _ & % & %H1 & ?)"; iExists P', H1; eauto.
+      * auto.
+  + pose proof (fun x => semax_Slabel_inv _ _ _ _ _ _ (H x)).
     apply AuxDefs.semax_label.
     apply IHc.
     auto.
-  + pose proof (fun x => semax_Sgoto_inv _ _ _ _ (H x)).
+  + pose proof (fun x => semax_Sgoto_inv _ _ _ _ _ (H x)).
     eapply semax_conseq; [| intros; try apply derives_full_refl .. | apply AuxDefs.semax_goto].
-    rewrite !exp_andp2.
-    apply exp_left; intros x; specialize (H0 x).
+    rewrite bi.sep_exist_l bi.and_exist_l.
+    apply bi.exist_elim; intros x; specialize (H0 x).
     auto.
-    { apply andp_left2, andp_left2, derives_refl. }
+    { iIntros "(_ & _ & $)". }
 Qed.
 
 End Extr.
@@ -1235,6 +1240,12 @@ Module CSHL_Def := DeepEmbeddedDef.
 
 Module CSHL_Defs := DeepEmbeddedDefs.
 
+Lemma semax_mask_mono : forall `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} {CS : compspecs} E E' Delta P c R,
+  E ⊆ E' -> semax _ _ _ _ _ E Delta P c R -> semax _ _ _ _ _ E' Delta P c R.
+Proof.
+  intros; eapply AuxDefs.semax_mask_mono; eauto.
+Qed.
+
 Definition semax_extract_exists := @semax_extract_exists.
 
 Definition semax_func_nil := @AuxDefs.semax_func_nil (@Def.semax_external).
@@ -1242,19 +1253,20 @@ Definition semax_func_nil := @AuxDefs.semax_func_nil (@Def.semax_external).
 Definition semax_func_cons := @AuxDefs.semax_func_cons (@Def.semax_external).
 
 Definition semax_func_cons_ext := @AuxDefs.semax_func_cons_ext (@Def.semax_external).
-  
+
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} {CS: compspecs}.
+
 Theorem semax_ifthenelse :
-  forall {CS: compspecs} {Espec: OracleKind},
-   forall Delta P (b: expr) c d R,
+   forall E Delta P (b: expr) c d R,
       bool_type (typeof b) = true ->
-     @semax CS Espec Delta (P && local (`(typed_true (typeof b)) (eval_expr b))) c R ->
-     @semax CS Espec Delta (P && local (`(typed_false (typeof b)) (eval_expr b))) d R ->
-     @semax CS Espec Delta (|> (tc_expr Delta (Eunop Cop.Onotbool b (Tint I32 Signed noattr)) && P)) (Sifthenelse b c d) R.
+     semax _ _ _ _ _ E Delta (P ∧ local (`(typed_true (typeof b)) (eval_expr b))) c R ->
+     semax _ _ _ _ _ E Delta (P ∧ local (`(typed_false (typeof b)) (eval_expr b))) d R ->
+     semax _ _ _ _ _ E Delta (▷ (tc_expr Delta (Eunop Cop.Onotbool b (Tint I32 Signed noattr)) ∧ P)) (Sifthenelse b c d) R.
 Proof.
   intros.
-  pose proof @AuxDefs.semax_ifthenelse _ _ _ _ _ _ _ _ H0 H1.
-  eapply semax_pre_simple; [| exact H2].
-  normalize.
+  eapply semax_pre_simple, @AuxDefs.semax_ifthenelse; eauto.
 Qed.
 
 Definition semax_seq := @AuxDefs.semax_seq.
@@ -1266,21 +1278,22 @@ Definition semax_continue := @AuxDefs.semax_continue.
 Definition semax_loop := @AuxDefs.semax_loop.
 
 Theorem semax_switch: 
-  forall {CS: compspecs} Espec Delta (Q: environ -> mpred) a sl R,
+  forall E Delta (Q: assert) a sl R,
      is_int_type (typeof a) = true ->
-     (forall rho, Q rho |-- tc_expr Delta a rho) ->
+     (Q ⊢ tc_expr Delta a) ->
      (forall n,
-     @semax CS Espec Delta (fun rho => andp (prop (eval_expr a rho = Vint n)) (Q rho))
+     semax _ _ _ _ _ E Delta (local ((` eq) (eval_expr a) `( Vint n)) ∧ Q)
                (seq_of_labeled_statement (select_switch (Int.unsigned n) sl))
                (switch_ret_assert R)) ->
-     @semax CS Espec Delta Q (Sswitch a sl) R.
+     semax _ _ _ _ _ E Delta Q (Sswitch a sl) R.
 Proof.
   intros.
-  pose proof AuxDefs.semax_switch _ _ _ _ _ H0 H1.
-  eapply semax_pre_simple; [| exact H2].
+  eapply semax_pre_simple, @AuxDefs.semax_switch; eauto.
   normalize.
 Qed.
 
+End mpred.
+
 Module CallB: CLIGHT_SEPARATION_HOARE_LOGIC_CALL_BACKWARD with Module CSHL_Def := DeepEmbeddedDef.
 
 Module CSHL_Def := DeepEmbeddedDef.
@@ -1358,60 +1371,51 @@ Definition semax_ext := @MinimumLogic.semax_ext.
 Definition semax_external_FF := @MinimumLogic.semax_external_FF.
 Definition semax_external_funspec_sub := @MinimumLogic.semax_external_funspec_sub.
 Definition semax_external_binaryintersection := @MinimumLogic.semax_external_binaryintersection.
-
 Definition general_intersection_funspec_subIJ:= @MinimumLogic.general_intersection_funspec_subIJ.
 
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ}.
+
 Definition semax_body_binaryintersection:
-forall {V G cs} f sp1 sp2 phi
-  (SB1: @semax_body V G cs f sp1) (SB2: @semax_body V G cs f sp2)
+forall {CS: compspecs} {V G} f sp1 sp2 phi
+  (SB1: semax_body V G f sp1) (SB2: semax_body V G f sp2)
   (BI: binary_intersection (snd sp1) (snd sp2) = Some phi),
-  @semax_body V G cs f (fst sp1, phi).
+  semax_body V G f (fst sp1, phi).
 Proof. intros.
-  destruct sp1 as [i phi1]. destruct phi1 as [sig1 cc1 A1 P1 Q1 P1_ne Q1_ne]. 
-  destruct sp2 as [i2 phi2]. destruct phi2 as [sig2 cc2 A2 P2 Q2 P2_ne Q2_ne]. 
-  destruct phi as [sig cc A P Q P_ne Q_ne]. simpl snd in BI.
+  destruct sp1 as [i phi1]. destruct phi1 as [sig1 cc1 A1 E1 P1 Q1].
+  destruct sp2 as [i2 phi2]. destruct phi2 as [sig2 cc2 A2 E2 P2 Q2].
+  destruct phi as [sig cc A E P Q]. simpl snd in BI.
   simpl in BI.
-  if_tac in BI; [inv BI | discriminate]. if_tac in H1; inv H1.
-  apply Classical_Prop.EqdepTheory.inj_pair2 in H6.
-  apply Classical_Prop.EqdepTheory.inj_pair2 in H5. subst. simpl fst; clear - SB1 SB2.
-  destruct SB1 as [X [Y SB1]]. destruct SB2 as [_ [_ SB2]].
-  split3; trivial. simpl in X; intros.
-  destruct x as [b Hb]; destruct b; [ apply SB1 | apply SB2].
+  if_tac in BI; [inv H | discriminate]. if_tac in BI; [| discriminate].
+  apply Some_inj, mk_funspec_inj in BI as ([=] & ? & ? & ? & ? & ?); subst.
+  clear - SB1 SB2.
+  destruct SB1 as [X [X1 SB1]]; destruct SB2 as [_ [X2 SB2]].
+  split3; [ apply X | trivial | simpl in X; intros ].
+  destruct x as [[|] ?]; [ apply SB1 | apply SB2].
 Qed.
 
 Definition semax_body_generalintersection {V G cs f iden I sig cc} {phi : I -> funspec}
         (H1: forall i : I, typesig_of_funspec (phi i) = sig)
-        (H2: forall i : I, callingconvention_of_funspec (phi i) = cc) (HI: inhabited I)
-  (H: forall i, semax_body V G f (iden, phi i)):
-  @semax_body V G cs f (iden, @general_intersection I sig cc phi H1 H2).
+        (H2: forall i : I, callingconvention_of_funspec (phi i) = cc)
+        (HI: inhabited I)
+  (H: forall i, semax_body(C := cs) V G f (iden, phi i)):
+  semax_body V G f (iden, @general_intersection _ _ I sig cc phi H1 H2).
 Proof. destruct HI. split3.
   { specialize (H X). specialize (H1 X); subst. destruct (phi X). simpl. apply H. }
   { specialize (H X). specialize (H1 X); subst. destruct (phi X). simpl. apply H. }
   intros. destruct x as [i Hi].
   specialize (H i).
-  assert (HH: fst sig = map snd (fst (fn_funsig f)) /\
+  assert (fst sig = map snd (fst (fn_funsig f)) /\
         snd sig = snd (fn_funsig f) /\
-        (forall (Espec : OracleKind) (ts : list Type)
-           (x : functors.MixVariantFunctor._functor
-                  ((fix dtfr (T : rmaps.TypeTree) : functors.MixVariantFunctor.functor :=
-                      match T with
-                      | rmaps.ConstType A0 => functors.MixVariantFunctorGenerator.fconst A0
-                      | rmaps.CompspecsType => functors.MixVariantFunctorGenerator.fconst compspecs
-                      | rmaps.Mpred => functors.MixVariantFunctorGenerator.fidentity
-                      | rmaps.DependentType n => functors.MixVariantFunctorGenerator.fconst (nth n ts unit)
-                      | rmaps.ProdType T1 T2 => functors.MixVariantFunctorGenerator.fpair (dtfr T1) (dtfr T2)
-                      | rmaps.ArrowType T1 T2 => functors.MixVariantFunctorGenerator.ffunc (dtfr T1) (dtfr T2)
-                      | rmaps.SigType I0 f => functors.MixVariantFunctorGenerator.fsig (fun i : I0 => dtfr (f i))
-                      | rmaps.PiType I0 f => functors.MixVariantFunctorGenerator.fpi (fun i : I0 => dtfr (f i))
-                      | rmaps.ListType T0 => functors.MixVariantFunctorGenerator.flist (dtfr T0)
-                      end) (WithType_of_funspec (phi i))) mpred),
-         semax (func_tycontext f V G nil)
-           (fun rho : environ => close_precondition (map fst (fn_params f)) (Pre_of_funspec (phi i) ts x) rho * stackframe_of f rho)
-           (fn_body f) (frame_ret_assert (function_body_ret_assert (fn_return f) ((Post_of_funspec (phi i) ts x))) (stackframe_of f)))).
+        (forall (x : dtfr ((WithType_of_funspec (phi i)))),
+         semax (mask_of_funspec (phi i) x) (func_tycontext f V G nil)
+           (close_precondition (map fst (fn_params f)) (argsassert_of ((Pre_of_funspec (phi i)) x)) ∗ stackframe_of f) 
+           (fn_body f) (frame_ret_assert (function_body_ret_assert (fn_return f) (assert_of ((Post_of_funspec (phi i)) x))) (stackframe_of f)))) as HH.
   { intros. specialize (H1 i); specialize (H2 i). subst. unfold semax_body in H.
-    destruct (phi i); subst. destruct H as [? [? ?]]. split3; auto. }
+    destruct (phi i); subst. destruct H as [? [? ?]]. split3; simpl; auto. }
   clear H H1 H2. destruct HH as [HH1 [HH2 HH3]].
-  apply (HH3 Espec ts Hi).
+  apply (HH3 Hi).
 Qed.
 
 Definition semax_func_mono := @AuxDefs.semax_func_mono (@Def.semax_external).
@@ -1434,7 +1438,7 @@ Proof.
   destruct ret; auto.
   destruct H as [? _].
   specialize (H i).
-  destruct ((temp_types Delta) ! i), ((temp_types Delta') ! i); auto.
+  destruct ((temp_types Delta) !! i), ((temp_types Delta') !! i); auto.
   + subst; auto.
   + tauto.
 Qed.
@@ -1444,14 +1448,14 @@ Lemma obox_sub:
     tycontext_sub Delta Delta' ->
     temp_guard Delta id ->
     tc_environ Delta rho ->
-    obox Delta id P rho |-- obox Delta' id P rho.
+    obox Delta id P rho ⊢ obox Delta' id P rho.
 Proof.
   intros.
   unfold obox.
   destruct H as [? _].
   specialize (H id).
   hnf in H0.
-  destruct ((temp_types Delta) ! id), ((temp_types Delta') ! id); auto.
+  destruct ((temp_types Delta) !! id), ((temp_types Delta') !! id); auto.
   + subst; auto.
   + tauto.
   + tauto.
@@ -1462,11 +1466,11 @@ Lemma oboxopt_sub:
     tycontext_sub Delta Delta' ->
     temp_guard_opt Delta id ->
     tc_environ Delta rho ->
-    oboxopt Delta id P rho |-- oboxopt Delta' id P rho.
+    oboxopt Delta id P rho ⊢ oboxopt Delta' id P rho.
 Proof.
   intros.
   destruct id.
-  + apply obox_sub; auto.
+  + eapply obox_sub; eauto.
   + simpl.
     auto.
 Qed.
@@ -1481,128 +1485,107 @@ Proof.
   destruct H as [? _].
   specialize (H id).
   hnf in H0.
-  destruct ((temp_types Delta) ! id), ((temp_types Delta') ! id); auto.
+  destruct ((temp_types Delta) !! id), ((temp_types Delta') !! id); auto.
   + subst; auto.
   + inv H0.
 Qed.
 
 Lemma allp_fun_id_sub: forall Delta Delta',
   tycontext_sub Delta Delta' ->
-  allp_fun_id Delta' |-- allp_fun_id Delta.
+  allp_fun_id Delta' ⊢ allp_fun_id Delta.
 Proof.
-  intros. intro.
-  unfold allp_fun_id.
-  unseal_derives.
+  intros.
+  split => rho.
   apply Clight_assert_lemmas.allp_fun_id_sub; auto.
 Qed.
 
-Theorem semax_Delta_subsumption:
-  forall {CS: compspecs} {Espec: OracleKind},
-  forall Delta Delta' P c R,
+Local Arguments typecheck_expr : simpl never.
+
+Theorem semax_Delta_subsumption {OK_spec: ext_spec OK_ty} {CS: compspecs}:
+  forall E Delta Delta' P c R,
        tycontext_sub Delta Delta' ->
-     @semax CS Espec Delta P c R -> @semax CS Espec Delta' P c R.
+     semax E Delta P c R -> semax E Delta' P c R.
 Proof.
   intros.
   induction H0.
-  + apply semax_pre with (!! (bool_type (typeof b) = true) && |> (tc_expr Delta' (Eunop Cop.Onotbool b (Tint I32 Signed noattr)) && P)); [| apply AuxDefs.semax_ifthenelse; auto].
+  + apply semax_pre with (⌜bool_type (typeof b) = true⌝ ∧ ▷ (tc_expr Delta' (Eunop Cop.Onotbool b (Tint I32 Signed noattr)) ∧ P)); [| apply AuxDefs.semax_ifthenelse; tauto].
     apply andp_ENTAIL; [apply ENTAIL_refl |].
-    rewrite !later_andp; apply andp_ENTAIL, ENTAIL_refl.
-    intro rho; simpl.
+    rewrite !bi.later_and; apply andp_ENTAIL, ENTAIL_refl.
     unfold local, lift1; normalize.
-    apply later_derives; constructor; apply Clight_assert_lemmas.tc_expr_sub; auto.
+    apply bi.later_mono; eapply Clight_assert_lemmas.tc_expr_sub; auto.
     eapply semax_lemmas.typecheck_environ_sub; eauto.
-  + eapply AuxDefs.semax_seq; eauto.
+  + eapply AuxDefs.semax_seq; intuition eauto.
   + eapply AuxDefs.semax_break; eauto.
   + eapply AuxDefs.semax_continue; eauto.
-  + eapply AuxDefs.semax_loop; eauto.
-  + eapply semax_pre with (!! (is_int_type (typeof a) = true) && (Q && local (tc_environ Delta'))); [solve_andp |].
+  + eapply AuxDefs.semax_loop; intuition eauto.
+  + eapply semax_pre with (⌜is_int_type (typeof a) = true⌝ ∧ (Q ∧ local (tc_environ Delta'))); first solve_andp.
     eapply AuxDefs.semax_switch.
-    - intros; simpl.
-      rewrite (add_andp _ _ (H0 _)).
+    - rewrite (add_andp _ _ H0).
       unfold local, lift1; normalize.
-      apply andp_left2.
-      constructor; apply Clight_assert_lemmas.tc_expr_sub; auto.
+      rewrite bi.and_elim_r.
+      eapply Clight_assert_lemmas.tc_expr_sub; eauto.
       eapply semax_lemmas.typecheck_environ_sub; eauto.
     - intros.
-      eapply semax_pre; [| apply H2].
+      eapply semax_pre; [| apply H2; auto].
       solve_andp.
   + eapply semax_pre; [| apply AuxDefs.semax_call_backward].
     apply exp_ENTAIL; intros argsig.
     apply exp_ENTAIL; intros retsig.
     apply exp_ENTAIL; intros cc.
+    apply exp_ENTAIL; intros Ef.
     apply exp_ENTAIL; intros A.
     apply exp_ENTAIL; intros P.
     apply exp_ENTAIL; intros Q.
-    apply exp_ENTAIL; intros NEP.
-    apply exp_ENTAIL; intros NEQ.
-    apply exp_ENTAIL; intros ts.
     apply exp_ENTAIL; intros x.
-    normalize.
-    apply andp_ENTAIL; [apply andp_ENTAIL; [apply andp_right; [apply andp_left1 |] |] |].
-    - intro rho; unfold local, lift1; normalize.
-      simpl; apply prop_right.
-      destruct H0; split; [auto |].
-      destruct H2; split; [auto |].
-      eapply tc_fn_return_sub; eauto.
-    - 
-      apply andp_right. 
-      * rewrite <- andp_assoc. apply andp_left1. intro rho; simpl; unfold local, lift1; normalize.
-        constructor; apply Clight_assert_lemmas.tc_expr_sub; auto.
-        eapply semax_lemmas.typecheck_environ_sub; eauto.
-      * rewrite (andp_comm (tc_expr Delta a)). rewrite <- andp_assoc. apply andp_left1.
-        intro rho; simpl; unfold local, lift1; normalize.
-        constructor; apply Clight_assert_lemmas.tc_exprlist_sub; auto.
+    iIntros "(? & (% & % & % & %) & H)"; iSplit.
+    { iPureIntro; split3; last split; [done.. |].
+      eapply tc_fn_return_sub; eauto. }
+    iSplit; [rewrite bi.and_elim_l | rewrite bi.and_elim_r].
+    { iSplit; [rewrite bi.and_elim_l | rewrite bi.and_elim_r].
+      * iStopProof; split => rho; monPred.unseal; rewrite monPred_at_affinely; iIntros "(% & ?)".
+        iApply Clight_assert_lemmas.tc_expr_sub; try done.
         eapply semax_lemmas.typecheck_environ_sub; eauto.
-        
-    - apply ENTAIL_refl.
-    - apply later_ENTAIL.
-      apply sepcon_ENTAIL; [apply ENTAIL_refl |].
-      destruct H0 as [_ [_ ?]].
-      intro rho; simpl.
-      unfold local, lift1; normalize.
-      apply oboxopt_sub; auto.
-      * eapply tc_fn_return_temp_guard_opt; eauto.
-      * eapply semax_lemmas.typecheck_environ_sub; eauto.
+      * iStopProof; split => rho; monPred.unseal; rewrite monPred_at_affinely; iIntros "(% & ?)".
+        iApply Clight_assert_lemmas.tc_exprlist_sub; try done.
+        eapply semax_lemmas.typecheck_environ_sub; eauto. }
+    iDestruct "H" as "($ & H)".
+    iNext; iDestruct "H" as "($ & H)".
+    iStopProof; split => rho; monPred.unseal; rewrite monPred_at_affinely; iIntros "(% & ?)".
+    iApply oboxopt_sub; auto; first done.
+    * eapply tc_fn_return_temp_guard_opt; eauto.
+    * eapply semax_lemmas.typecheck_environ_sub; eauto.
   + eapply semax_pre; [| apply AuxDefs.semax_return].
     assert (ret_type Delta = ret_type Delta') by (unfold tycontext_sub in *; tauto).
     rewrite H0.
     apply andp_ENTAIL; [| apply ENTAIL_refl].
-    intro rho; simpl.
     unfold local, lift1; normalize.
     destruct ret.
-    - constructor; apply Clight_assert_lemmas.tc_expr_sub; auto.
+    - eapply Clight_assert_lemmas.tc_expr_sub; eauto.
       eapply semax_lemmas.typecheck_environ_sub; eauto.
     - simpl; auto.
   + eapply semax_pre; [| apply AuxDefs.semax_set_ptr_compare_load_cast_load_backward].
     apply orp_ENTAIL; [apply orp_ENTAIL; [apply orp_ENTAIL |] |].
     - apply later_ENTAIL.
-      apply andp_ENTAIL; [| apply ENTAIL_refl].
-      apply andp_ENTAIL.
-      * unfold local, lift1; intro rho; simpl; normalize.
-        constructor; apply Clight_assert_lemmas.tc_expr_sub; auto.
+      apply andp_ENTAIL, andp_ENTAIL; last apply ENTAIL_refl.
+      * unfold local, lift1; normalize.
+        eapply Clight_assert_lemmas.tc_expr_sub; eauto.
         eapply semax_lemmas.typecheck_environ_sub; eauto.
-      * unfold local, lift1; intro rho; simpl; normalize.
-        constructor; apply Clight_assert_lemmas.tc_temp_id_sub; auto.
+      * unfold local, lift1; normalize.
+        eapply Clight_assert_lemmas.tc_temp_id_sub; eauto.
     - apply exp_ENTAIL; intro cmp.
       apply exp_ENTAIL; intro e1.
       apply exp_ENTAIL; intro e2.
       apply exp_ENTAIL; intro ty.
       apply exp_ENTAIL; intro sh1.
       apply exp_ENTAIL; intro sh2.
-      apply andp_ENTAIL; [| apply later_ENTAIL, andp_ENTAIL; [apply andp_ENTAIL; [apply andp_ENTAIL; [apply andp_ENTAIL; [apply andp_ENTAIL |] |] |] |]].
-      * unfold local, lift1; intro rho; simpl; normalize.
-        destruct H1; split; auto.
-        destruct H2; split; auto.
-        destruct H3; split; auto.
-        destruct H4; split; auto.
-        destruct H5; split; auto.
-        destruct H6; split; auto.
+      apply andp_ENTAIL; [| apply later_ENTAIL, andp_ENTAIL; [|apply andp_ENTAIL; [|apply andp_ENTAIL; [|apply andp_ENTAIL; [|apply andp_ENTAIL] ] ] ]].
+      * iIntros "(_ & % & % & % & % & % & % & %)"; iPureIntro; repeat split; auto.
         eapply typecheck_tid_ptr_compare_sub; eauto.
-      * unfold local, lift1; intro rho; simpl; normalize.
-        constructor; apply Clight_assert_lemmas.tc_expr_sub; auto.
+      * unfold local, lift1; normalize.
+        eapply Clight_assert_lemmas.tc_expr_sub; eauto.
         eapply semax_lemmas.typecheck_environ_sub; eauto.
-      * unfold local, lift1; intro rho; simpl; normalize.
-        constructor; apply Clight_assert_lemmas.tc_expr_sub; auto.
+      * unfold local, lift1; normalize.
+        eapply Clight_assert_lemmas.tc_expr_sub; eauto.
         eapply semax_lemmas.typecheck_environ_sub; eauto.
       * apply ENTAIL_refl.
       * apply ENTAIL_refl.
@@ -1611,12 +1594,11 @@ Proof.
     - apply exp_ENTAIL; intro sh.
       apply exp_ENTAIL; intro t2.
       apply exp_ENTAIL; intro v2.
-      apply andp_ENTAIL; [| apply later_ENTAIL, andp_ENTAIL; [apply andp_ENTAIL; [apply andp_ENTAIL |] |] ].
-      * unfold local, lift1; intro rho; simpl; normalize.
-        destruct H1; split; auto.
+      apply andp_ENTAIL; [| apply later_ENTAIL, andp_ENTAIL; [apply andp_ENTAIL; [|apply andp_ENTAIL ] |] ].
+      * iIntros "(_ & % & % & %)"; iPureIntro; repeat split; auto.
         eapply Clight_assert_lemmas.typeof_temp_sub; eauto.
-      * unfold local, lift1; intro rho; simpl; normalize.
-        constructor; apply Clight_assert_lemmas.tc_lvalue_sub; auto.
+      * unfold local, lift1; normalize.
+        eapply Clight_assert_lemmas.tc_lvalue_sub; eauto.
         eapply semax_lemmas.typecheck_environ_sub; eauto.
       * apply ENTAIL_refl.
       * apply ENTAIL_refl.
@@ -1625,13 +1607,11 @@ Proof.
       apply exp_ENTAIL; intro e1.
       apply exp_ENTAIL; intro t1.
       apply exp_ENTAIL; intro v2.
-      apply andp_ENTAIL; [| apply later_ENTAIL, andp_ENTAIL; [apply andp_ENTAIL; [apply andp_ENTAIL |] |] ].
-      * unfold local, lift1; intro rho; simpl; normalize.
-        destruct H1; split; auto.
-        destruct H2; split; auto.
+      apply andp_ENTAIL; [| apply later_ENTAIL, andp_ENTAIL; [|apply andp_ENTAIL; [|apply andp_ENTAIL ] ] ].
+      * iIntros "(_ & % & % & % & %)"; iPureIntro; repeat split; auto.
         eapply Clight_assert_lemmas.typeof_temp_sub; eauto.
-      * unfold local, lift1; intro rho; simpl; normalize.
-        constructor; apply Clight_assert_lemmas.tc_lvalue_sub; auto.
+      * unfold local, lift1; normalize.
+        eapply Clight_assert_lemmas.tc_lvalue_sub; eauto.
         eapply semax_lemmas.typecheck_environ_sub; eauto.
       * apply ENTAIL_refl.
       * apply ENTAIL_refl.
@@ -1643,11 +1623,11 @@ Proof.
       apply later_ENTAIL.
       apply andp_ENTAIL; [| apply ENTAIL_refl].
       apply andp_ENTAIL.
-      * unfold local, lift1; intro rho; simpl; normalize.
-        constructor. apply Clight_assert_lemmas.tc_lvalue_sub; auto.
+      * unfold local, lift1; normalize.
+        eapply Clight_assert_lemmas.tc_lvalue_sub; eauto.
         eapply semax_lemmas.typecheck_environ_sub; eauto.
-      * unfold local, lift1; intro rho; simpl; normalize.
-        constructor. apply Clight_assert_lemmas.tc_expr_sub; auto.
+      * unfold local, lift1; normalize.
+        eapply Clight_assert_lemmas.tc_expr_sub; eauto.
         eapply semax_lemmas.typecheck_environ_sub; eauto.
     - apply exp_ENTAIL; intro t2.
       apply exp_ENTAIL; intro ch.
@@ -1657,454 +1637,352 @@ Proof.
       apply later_ENTAIL.
       apply andp_ENTAIL; [| apply ENTAIL_refl].
       apply andp_ENTAIL.
-      * unfold local, lift1; intro rho; simpl; normalize.
-        constructor. apply Clight_assert_lemmas.tc_lvalue_sub; auto.
+      * unfold local, lift1; normalize.
+        eapply Clight_assert_lemmas.tc_lvalue_sub; eauto.
         eapply semax_lemmas.typecheck_environ_sub; eauto.
-      * unfold local, lift1; intro rho; simpl; normalize.
-        constructor. apply Clight_assert_lemmas.tc_expr_sub; auto.
+      * unfold local, lift1; normalize.
+        eapply Clight_assert_lemmas.tc_expr_sub; eauto.
         eapply semax_lemmas.typecheck_environ_sub; eauto.
   + apply AuxDefs.semax_skip.
   + apply AuxDefs.semax_builtin.
-  + apply AuxDefs.semax_label; auto.
+  + apply AuxDefs.semax_label; intuition auto.
   + apply AuxDefs.semax_goto.
-  + eapply semax_conseq; [.. | exact IHsemax].
-    - eapply derives_trans; [| exact H0].
-      apply andp_derives; [| apply andp_derives]; auto.
-      * unfold local, lift1; intro rho; simpl; normalize.
+  + eapply semax_conseq; [.. | by apply IHsemax].
+    - rewrite -H0.
+      apply bi.and_mono; [| apply bi.sep_mono]; auto.
+      * split => rho; apply bi.pure_mono.
         eapply semax_lemmas.typecheck_environ_sub; eauto.
-      * apply allp_fun_id_sub; auto.
-    - eapply derives_trans; [| exact H1].
-      apply andp_derives; [| apply andp_derives]; auto.
-      * unfold local, lift1; intro rho; simpl; normalize.
+      * apply bi.affinely_mono, allp_fun_id_sub; auto.
+    - rewrite -H1.
+      apply bi.and_mono; [| apply bi.sep_mono]; auto.
+      * split => rho; apply bi.pure_mono.
         eapply semax_lemmas.typecheck_environ_sub; eauto.
-      * apply allp_fun_id_sub; auto.
-    - eapply derives_trans; [| exact H2].
-      apply andp_derives; [| apply andp_derives]; auto.
-      * unfold local, lift1; intro rho; simpl; normalize.
+      * apply bi.affinely_mono, allp_fun_id_sub; auto.
+    - rewrite -H2.
+      apply bi.and_mono; [| apply bi.sep_mono]; auto.
+      * split => rho; apply bi.pure_mono.
         eapply semax_lemmas.typecheck_environ_sub; eauto.
-      * apply allp_fun_id_sub; auto.
-    - eapply derives_trans; [| exact H3].
-      apply andp_derives; [| apply andp_derives]; auto.
-      * unfold local, lift1; intro rho; simpl; normalize.
+      * apply bi.affinely_mono, allp_fun_id_sub; auto.
+    - rewrite -H3.
+      apply bi.and_mono; [| apply bi.sep_mono]; auto.
+      * split => rho; apply bi.pure_mono.
         eapply semax_lemmas.typecheck_environ_sub; eauto.
-      * apply allp_fun_id_sub; auto.
+      * apply bi.affinely_mono, allp_fun_id_sub; auto.
     - intros.
-      eapply derives_trans; [| apply H4].
-      apply andp_derives; [| apply andp_derives]; auto.
-      * unfold local, lift1; intro rho; simpl; normalize.
+      rewrite -H4.
+      apply bi.and_mono; [| apply bi.sep_mono]; auto.
+      * split => rho; apply bi.pure_mono.
         eapply semax_lemmas.typecheck_environ_sub; eauto.
-      * apply allp_fun_id_sub; auto.
+      * apply bi.affinely_mono, allp_fun_id_sub; auto.
+  + eapply AuxDefs.semax_mask_mono; intuition eauto.
 Qed.
 
 Lemma rvalue_cenv_sub: forall {CS CS'} (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS')) Delta e rho,
   tc_environ Delta rho ->
-  @tc_expr CS Delta e rho |-- !! (@eval_expr CS e rho = @eval_expr CS' e rho).
+  tc_expr (CS := CS) Delta e rho ⊢ ⌜@eval_expr CS e rho = @eval_expr CS' e rho⌝.
 Proof.
-  intros. apply derives_trans with (!! tc_val (typeof e) (@eval_expr CS e rho) && @tc_expr CS Delta e rho).
-  { apply andp_right; trivial. apply typecheck_expr_sound; trivial. }
-  normalize. rewrite (expr_lemmas.eval_expr_cenv_sub_eq CSUB). normalize.
+  intros. rewrite typecheck_expr_sound //; apply bi.pure_mono; intros.
+  apply (expr_lemmas.eval_expr_cenv_sub_eq CSUB).
   intros N; rewrite N in H0; clear N. apply tc_val_Vundef in H0; trivial.
 Qed.
-Lemma rvalue_cspecs_sub: forall {CS CS'} (CSUB: cspecs_sub  CS CS') Delta e rho,
+Lemma rvalue_cspecs_sub: forall {CS CS'} (CSUB: cspecs_sub CS CS') Delta e rho,
   tc_environ Delta rho ->
-  @tc_expr CS Delta e rho |-- !! (@eval_expr CS e rho = @eval_expr CS' e rho).
+  tc_expr (CS := CS) Delta e rho ⊢ ⌜@eval_expr CS e rho = @eval_expr CS' e rho⌝.
 Proof. intros. destruct CSUB as [CSUB _]. apply (rvalue_cenv_sub CSUB); trivial. Qed. 
 
 Lemma lvalue_cenv_sub: forall {CS CS'} (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS')) Delta e rho,
   tc_environ Delta rho ->
-  @tc_lvalue CS Delta e rho |-- !! (@eval_lvalue CS e rho = @eval_lvalue CS' e rho).
+  tc_lvalue (CS := CS) Delta e rho ⊢ ⌜@eval_lvalue CS e rho = @eval_lvalue CS' e rho⌝.
 Proof. 
-  intros. apply derives_trans with (!! is_pointer_or_null (@eval_lvalue CS e rho) && @tc_lvalue CS Delta e rho).
-  { apply andp_right; trivial. apply typecheck_lvalue_sound; trivial. }
-  normalize. rewrite (expr_lemmas.eval_lvalue_cenv_sub_eq CSUB). normalize.
+  intros. rewrite typecheck_lvalue_sound //; apply bi.pure_mono; intros.
+  apply (expr_lemmas.eval_lvalue_cenv_sub_eq CSUB).
   intros N; rewrite N in H0; clear N. apply H0.
 Qed.
 Lemma lvalue_cspecs_sub: forall {CS CS'} (CSUB: cspecs_sub  CS CS') Delta e rho,
   tc_environ Delta rho ->
-  @tc_lvalue CS Delta e rho |-- !! (@eval_lvalue CS e rho = @eval_lvalue CS' e rho).
+  tc_lvalue (CS := CS) Delta e rho ⊢ ⌜@eval_lvalue CS e rho = @eval_lvalue CS' e rho⌝.
 Proof. intros. destruct CSUB as [CSUB _]. apply (lvalue_cenv_sub CSUB); trivial. Qed.  
 
-Lemma denote_tc_bool_CSCS' {CS CS'} v e: @denote_tc_assert CS (tc_bool v e) = @denote_tc_assert CS' (tc_bool v e).
+Lemma denote_tc_bool_CSCS' {CS CS'} v e: denote_tc_assert (CS := CS) (tc_bool v e) = denote_tc_assert (CS := CS') (tc_bool v e).
 Proof. destruct v; simpl; trivial. Qed.
 
 Lemma tc_expr_NoVundef {CS} Delta rho e (TE: typecheck_environ Delta rho):
-  @tc_expr CS Delta e rho |-- !! (tc_val (typeof e) (@eval_expr CS e rho) /\ (@eval_expr CS e rho)<>Vundef).
+  tc_expr(CS := CS) Delta e rho ⊢ ⌜tc_val (typeof e) (eval_expr e rho) /\ (eval_expr e rho)<>Vundef⌝.
 Proof.
-  eapply derives_trans. apply typecheck_expr_sound; trivial.
-  normalize. split; trivial. intros N. rewrite N in H; clear N. apply tc_val_Vundef in H; trivial.
+  rewrite typecheck_expr_sound //; apply bi.pure_mono.
+  split; trivial. intros N. rewrite N in H; clear N. apply tc_val_Vundef in H; trivial.
 Qed. 
 
-Definition SETpre CS Delta id e P :=
-  |> (@tc_expr CS Delta e && @tc_temp_id id (typeof e) CS Delta e && @subst mpred id (@eval_expr CS e) P)
-  || (EX cmp : Cop.binary_operation,
-      EX e1 : expr,
-      EX e2 : expr,
-      EX ty : type,
-      EX sh1 : share,
-      EX sh2 : share,
-      !! (e = Ebinop cmp e1 e2 ty /\
+Definition SETpre (CS: compspecs) Delta id e P :=
+  ▷ (tc_expr Delta e ∧ tc_temp_id id (typeof e) Delta e ∧ assert_of (@subst mpred id (eval_expr e) P))
+  ∨ (∃ cmp : Cop.binary_operation,
+      ∃ e1 : expr,
+      ∃ e2 : expr,
+      ∃ ty : type,
+      ∃ sh1 : share,
+      ∃ sh2 : share,
+      ⌜e = Ebinop cmp e1 e2 ty /\
           @sepalg.nonidentity share Share.Join_ba pa_share sh1 /\
           @sepalg.nonidentity share Share.Join_ba pa_share sh2 /\
           is_comparison cmp = true /\
-          eqb_type (typeof e1) int_or_ptr_type = false /\ eqb_type (typeof e2) int_or_ptr_type = false /\ typecheck_tid_ptr_compare Delta id = true) &&
-      |> (@tc_expr CS Delta e1 && @tc_expr CS Delta e2 && local ((` (blocks_match cmp)) (@eval_expr CS e1) (@eval_expr CS e2)) &&
-          ((` (mapsto_ sh1 (typeof e1))) (@eval_expr CS e1) * @TT (LiftEnviron mpred) (@LiftNatDed' mpred Nveric)) &&
-          ((` (mapsto_ sh2 (typeof e2))) (@eval_expr CS e2) * @TT (LiftEnviron mpred) (@LiftNatDed' mpred Nveric)) &&
-          @subst mpred id (@eval_expr CS (Ebinop cmp e1 e2 ty)) P))
-  || (EX sh : share,
-      EX t2 : type,
-      EX v2 : val,
-      !! (typeof_temp Delta id = @Some type t2 /\ is_neutral_cast (typeof e) t2 = true /\ readable_share sh) &&
-      |> (@tc_lvalue CS Delta e && local (` (tc_val (typeof e) v2)) &&
-          ((` (mapsto sh (typeof e))) (@eval_lvalue CS e) (` v2) * @TT (LiftEnviron mpred) (@LiftNatDed' mpred Nveric)) && @subst mpred id (` v2) P))
-  || (EX sh : share,
-      EX e1 : expr,
-      EX t1 : type,
-      EX v2 : val,
-      !! (e = Ecast e1 t1 /\ typeof_temp Delta id = @Some type t1 /\ cast_pointer_to_bool (typeof e1) t1 = false /\ readable_share sh) &&
-      |> (@tc_lvalue CS Delta e1 && local ((` (tc_val t1)) (` (eval_cast (typeof e1) t1 v2))) &&
-          ((` (mapsto sh (typeof e1))) (@eval_lvalue CS e1) (` v2) * @TT (LiftEnviron mpred) (@LiftNatDed' mpred Nveric)) &&
-          @subst mpred id (` (force_val (sem_cast (typeof e1) t1 v2))) P)).
-
-Definition ASSIGNpre (CS: compspecs) Delta e1 e2 P: environ -> mpred :=
-  (EX sh : share,
-           !! writable_share sh &&
-           |> (tc_lvalue Delta e1 && tc_expr Delta (Ecast e2 (typeof e1)) &&
-               ((` (mapsto_ sh (typeof e1))) (eval_lvalue e1) *
-                ((` (mapsto sh (typeof e1))) (eval_lvalue e1)
+          eqb_type (typeof e1) int_or_ptr_type = false /\ eqb_type (typeof e2) int_or_ptr_type = false /\ typecheck_tid_ptr_compare Delta id = true⌝ ∧
+      ▷ (tc_expr Delta e1 ∧ tc_expr Delta e2 ∧ local ((` (blocks_match cmp)) (eval_expr e1) (eval_expr e2)) ∧
+          <absorb> assert_of ((` (mapsto_ sh1 (typeof e1))) (eval_expr e1)) ∧
+          <absorb> assert_of ((` (mapsto_ sh2 (typeof e2))) (eval_expr e2)) ∧
+          assert_of (@subst mpred id (@eval_expr CS (Ebinop cmp e1 e2 ty)) P)))
+  ∨ (∃ sh : share,
+      ∃ t2 : type,
+      ∃ v2 : val,
+      ⌜typeof_temp Delta id = @Some type t2 /\ is_neutral_cast (typeof e) t2 = true /\ readable_share sh⌝ ∧
+      ▷ (tc_lvalue Delta e ∧ local (` (tc_val (typeof e) v2)) ∧
+          <absorb> assert_of ((` (mapsto sh (typeof e))) (@eval_lvalue CS e) (` v2)) ∧ assert_of (@subst mpred id (` v2) P)))
+  ∨ (∃ sh : share,
+      ∃ e1 : expr,
+      ∃ t1 : type,
+      ∃ v2 : val,
+      ⌜e = Ecast e1 t1 /\ typeof_temp Delta id = @Some type t1 /\ cast_pointer_to_bool (typeof e1) t1 = false /\ readable_share sh⌝ ∧
+      ▷ (tc_lvalue Delta e1 ∧ local ((` (tc_val t1)) (` (eval_cast (typeof e1) t1 v2))) ∧
+          <absorb> assert_of ((` (mapsto sh (typeof e1))) (@eval_lvalue CS e1) (` v2)) ∧
+          assert_of (@subst mpred id (` (force_val (sem_cast (typeof e1) t1 v2))) P))).
+
+Definition ASSIGNpre (CS: compspecs) Delta e1 e2 P: assert :=
+  (∃ sh : share,
+           ⌜writable_share sh⌝ ∧
+           ▷ (tc_lvalue Delta e1 ∧ tc_expr Delta (Ecast e2 (typeof e1)) ∧
+               (assert_of ((` (mapsto_ sh (typeof e1))) (eval_lvalue e1)) ∗
+                (assert_of ((` (mapsto sh (typeof e1))) (eval_lvalue e1)
                    ((` force_val)
-                      ((` (sem_cast (typeof e2) (typeof e1))) (eval_expr e2))) -* P))))
-          || (EX (t2 : type) (ch ch' : memory_chunk) (sh : share),
-              !! ((numeric_type (typeof e1) && numeric_type t2)%bool = true /\
+                      ((` (sem_cast (typeof e2) (typeof e1))) (eval_expr e2)))) -∗ P))))
+          ∨ (∃ (t2 : type) (ch ch' : memory_chunk) (sh : share),
+              ⌜(numeric_type (typeof e1) ∧ numeric_type t2)%bool = true /\
                   access_mode (typeof e1) = By_value ch /\
                   access_mode t2 = By_value ch' /\
-                  decode_encode_val_ok ch ch' /\ writable_share sh) &&
-              |> (tc_lvalue Delta e1 && tc_expr Delta (Ecast e2 (typeof e1)) &&
-                  ((` (mapsto_ sh (typeof e1))) (eval_lvalue e1) &&
-                   (` (mapsto_ sh t2)) (eval_lvalue e1) *
-                   (ALL v' : val,
-                    (` (mapsto sh t2)) (eval_lvalue e1) (` v') -*
-                    imp (local
+                  decode_encode_val_ok ch ch' /\ writable_share sh⌝ ∧
+              ▷ (tc_lvalue Delta e1 ∧ tc_expr Delta (Ecast e2 (typeof e1)) ∧
+                  (assert_of ((` (mapsto_ sh (typeof e1))) (eval_lvalue e1)) ∧
+                   assert_of ((` (mapsto_ sh t2)) (eval_lvalue e1)) ∗
+                   (∀ v' : val,
+                    assert_of ((` (mapsto sh t2)) (eval_lvalue e1) (` v')) -∗
+                    (local
                       ((` decode_encode_val)
                          ((` force_val)
                             ((` (sem_cast (typeof e2) (typeof e1))) (eval_expr e2)))
-                         (` ch) (` ch') (` v'))) P)))) .
-
-Definition STOREpre CS Delta e1 e2 P := (EX sh : share,
-     !! writable_share sh &&
-     |> (@tc_lvalue CS Delta e1 && @tc_expr CS Delta (Ecast e2 (typeof e1)) &&
-         ((` (mapsto_ sh (typeof e1))) (@eval_lvalue CS e1) *
-          ((` (mapsto sh (typeof e1))) (@eval_lvalue CS e1) ((` force_val) ((` (sem_cast (typeof e2) (typeof e1))) (@eval_expr CS e2))) -* P)))).
-
-Definition CALLpre CS Delta ret a bl R :=
-     EX argsig : list type,
-     EX retsig : type,
-     EX cc : calling_convention,
-     EX A : rmaps.TypeTree,
-     EX P : forall ts : list Type, functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts (ArgsTT A)) mpred,
-     EX Q : forall ts : list Type, functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts (AssertTT A)) mpred,
-     EX NEP : @args_super_non_expansive A P,
-     EX NEQ : @super_non_expansive A Q,
-     EX ts : list Type,
-     EX x
-     : functors.MixVariantFunctor._functor
-         ((fix dtfr (T : rmaps.TypeTree) : functors.MixVariantFunctor.functor :=
-             match T with
-             | rmaps.ConstType A0 => functors.MixVariantFunctorGenerator.fconst A0
-             | rmaps.CompspecsType => functors.MixVariantFunctorGenerator.fconst compspecs
-             | rmaps.Mpred => functors.MixVariantFunctorGenerator.fidentity
-             | rmaps.DependentType n => functors.MixVariantFunctorGenerator.fconst (@nth Type n ts unit)
-             | rmaps.ProdType T1 T2 => functors.MixVariantFunctorGenerator.fpair (dtfr T1) (dtfr T2)
-             | rmaps.ArrowType T1 T2 => functors.MixVariantFunctorGenerator.ffunc (dtfr T1) (dtfr T2)
-             | rmaps.SigType A f => @functors.MixVariantFunctorGenerator.fsig A (fun a => dtfr (f a))
-             | rmaps.PiType I0 f => @functors.MixVariantFunctorGenerator.fpi I0 (fun i : I0 => dtfr (f i))
-             | rmaps.ListType T0 => functors.MixVariantFunctorGenerator.flist (dtfr T0)
-             end) A) mpred,
-     !! (Cop.classify_fun (typeof a) = Cop.fun_case_f argsig retsig cc /\
-         (retsig = Tvoid -> ret = @None ident) /\ tc_fn_return Delta ret retsig) &&
-     (@tc_expr CS Delta a && @tc_exprlist CS Delta argsig bl) &&
-     (` (func_ptr (mk_funspec (argsig, retsig) cc A P Q NEP NEQ))) (@eval_expr CS a) &&
-     |>  (@sepcon (lifted (LiftEnviron mpred)) (@LiftNatDed' mpred Nveric) (@LiftSepLog' mpred Nveric Sveric)
-                   (fun rho => P ts x (ge_of rho, @eval_exprlist CS argsig bl rho))
-                   (oboxopt Delta ret (maybe_retval (Q ts x) retsig ret -* R))).
-
-(*A variant where (CSUB: cspecs_sub  CS CS') is replaced by (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS')) may be provable once tc_expr lemmas (and maybe eval_expr lemmas, sem_binop etc have been modified to only take a composite_env rather than a compspecs*) 
-Lemma semax_cssub {CS CS'} (CSUB: cspecs_sub  CS CS') Espec Delta P c R:
-      @semax CS Espec Delta P c R -> @semax CS' Espec Delta P c R.
+                         (` ch) (` ch') (` v'))) → P)))) .
+
+Definition STOREpre (CS: compspecs) Delta e1 e2 P := (∃ sh : share,
+     ⌜writable_share sh⌝ ∧
+     ▷ (tc_lvalue Delta e1 ∧ tc_expr Delta (Ecast e2 (typeof e1)) ∧
+         (assert_of ((` (mapsto_ sh (typeof e1))) (@eval_lvalue CS e1)) ∗
+          (assert_of ((` (mapsto sh (typeof e1))) (@eval_lvalue CS e1) ((` force_val) ((` (sem_cast (typeof e2) (typeof e1))) (@eval_expr CS e2)))) -∗ P)))).
+
+Definition CALLpre (CS: compspecs) E Delta ret a bl R :=
+     ∃ argsig : list type,
+     ∃ retsig : type,
+     ∃ cc : calling_convention,
+     ∃ A : TypeTree,
+     ∃ Ef : dtfr (MaskTT A),
+     ∃ P : dtfr (ArgsTT A),
+     ∃ Q : dtfr (AssertTT A),
+     ∃ x : dtfr A,
+     ⌜Ef x ⊆ E /\ Cop.classify_fun (typeof a) = Cop.fun_case_f argsig retsig cc /\
+         (retsig = Tvoid -> ret = @None ident) /\ tc_fn_return Delta ret retsig⌝ ∧
+     (tc_expr Delta a ∧ tc_exprlist Delta argsig bl) ∧
+     assert_of ((` (func_ptr (mk_funspec (argsig, retsig) cc A Ef P Q))) (@eval_expr CS a)) ∧
+     ▷  (assert_of (fun rho => P x (ge_of rho, @eval_exprlist CS argsig bl rho)) ∗
+                   (oboxopt Delta ret (maybe_retval (assert_of (Q x)) retsig ret -∗ R))).
+
+(*A variant where (CSUB: cspecs_sub  CS CS') is replaced by (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS')) may be provable once tc_expr lemmas (and maybe eval_expr lemmas, sem_binop etc) have been modified to only take a composite_env rather than a compspecs*) 
+Lemma semax_cssub {OK_spec: ext_spec OK_ty} {CS: compspecs} {CS'} (CSUB: cspecs_sub  CS CS') E Delta P c R:
+      semax (C := CS) E Delta P c R -> semax (C := CS') E Delta P c R.
 Proof.
   intros.
   induction H.
-  + apply semax_pre with (!! (bool_type (typeof b) = true) && |> (@tc_expr CS' Delta (Eunop Cop.Onotbool b (Tint I32 Signed noattr)) && (@tc_expr CS Delta (Eunop Cop.Onotbool b (Tint I32 Signed noattr)) && P))); [| apply AuxDefs.semax_ifthenelse; auto].
-    {
-    apply andp_right. { apply andp_left2, andp_left1; auto. }
-    rewrite !later_andp; apply andp_right, andp_left2, andp_left2; auto.
-    rewrite <- 2andp_assoc.
-    apply andp_left1.
-    intro rho; simpl.
-    unfold local, lift1; normalize.
-    apply later_derives, tc_expr_cspecs_sub; auto.
-    }
-    {
-      eapply semax_pre; [| exact IHsemax1].
-      apply andp_right; [solve_andp |].
-      rewrite <- andp_assoc.
-      apply imp_andp_adjoint.
-      rewrite <- andp_assoc.
-      apply andp_left1.
-      apply derives_trans with (local (tc_environ Delta) && (@tc_expr CS Delta b)); [| apply derives_trans with ( local (fun rho => (@eval_expr CS b rho = @eval_expr CS' b rho)))].
-      + unfold tc_expr.
-        simpl denote_tc_assert.
-        rewrite denote_tc_assert_andp.
+  + apply semax_pre with (⌜bool_type (typeof b) = true⌝ ∧ ▷ (tc_expr (CS := CS') Delta (Eunop Cop.Onotbool b (Tint I32 Signed noattr)) ∧ (tc_expr (CS := CS) Delta (Eunop Cop.Onotbool b (Tint I32 Signed noattr)) ∧ P))); [| apply AuxDefs.semax_ifthenelse; auto].
+    { apply bi.and_intro. { rewrite bi.and_elim_r bi.and_elim_l; auto. }
+      rewrite !bi.later_and; apply bi.and_intro; last by rewrite bi.and_elim_r bi.and_elim_r.
+      unfold local, lift1; normalize.
+      rewrite bi.and_elim_l; apply bi.later_mono, tc_expr_cspecs_sub; auto. }
+    { eapply semax_pre; [| exact IHsemax1].
+      apply bi.and_intro; [solve_andp |].
+      rewrite /local /lift1; normalize.
+      rewrite bi.and_elim_l.
+      trans (tc_expr (CS := CS) Delta b rho); simpl.
+      + rewrite denote_tc_assert_andp.
         solve_andp.
-      + intro rho; simpl.
-        unfold local, lift1; normalize.
-        apply rvalue_cspecs_sub; auto.
-      + apply imp_andp_adjoint.
-        intro rho; simpl.
-        unfold local, lift1; normalize.
+      + setoid_rewrite rvalue_cspecs_sub; try done.
         unfold_lift.
-        rewrite H1; auto.
-    }
+        by iIntros "->". }
     { eapply semax_pre; [| exact IHsemax2].
-      apply andp_right; [solve_andp |].
-      rewrite <- andp_assoc.
-      apply imp_andp_adjoint.
-      rewrite <- andp_assoc.
-      apply andp_left1.
-      apply derives_trans with (local (tc_environ Delta) && (@tc_expr CS Delta b)); [| apply derives_trans with ( local (fun rho => (@eval_expr CS b rho = @eval_expr CS' b rho)))].
-      + unfold tc_expr.
-        simpl denote_tc_assert.
-        rewrite denote_tc_assert_andp.
+      apply bi.and_intro; [solve_andp |].
+      rewrite /local /lift1; normalize.
+      rewrite bi.and_elim_l.
+      trans (tc_expr (CS := CS) Delta b rho); simpl.
+      + rewrite denote_tc_assert_andp.
         solve_andp.
-      + intro rho; simpl.
-        unfold local, lift1; normalize.
-        apply rvalue_cspecs_sub; auto.
-      + apply imp_andp_adjoint.
-        intro rho; simpl.
-        unfold local, lift1; normalize.
+      + setoid_rewrite rvalue_cspecs_sub; try done.
         unfold_lift.
-        rewrite H1; auto.
-    }
+        by iIntros "->". }
   + eapply AuxDefs.semax_seq; eauto.
   + eapply AuxDefs.semax_break; eauto.
   + eapply AuxDefs.semax_continue; eauto.
   + eapply AuxDefs.semax_loop; eauto.
-  + eapply semax_pre with (!! (is_int_type (typeof a) = true) && (Q && local (tc_environ Delta))); [solve_andp |].
+  + eapply semax_pre with (⌜is_int_type (typeof a) = true⌝ ∧ (Q ∧ local (tc_environ Delta))); [solve_andp |].
     eapply AuxDefs.semax_switch.
-    - intros. specialize (H rho). simpl. eapply derives_trans. apply andp_derives. apply H. apply derives_refl.
-      simpl. unfold local, lift1; normalize. apply tc_expr_cspecs_sub; trivial.
+    - rewrite H.
+      rewrite /local /lift1; normalize.
+      apply tc_expr_cspecs_sub; trivial.
     - intros; simpl. specialize (H1 n); simpl in H1.
-      eapply semax_pre with (fun x : environ => local ((` (@eq val)) (@eval_expr CS a) (` (Vint n))) x &&  local ((` (@eq val)) (@eval_expr CS' a) (` (Vint n))) x && (Q x && local (tc_environ Delta) x)).
-      * simpl. intros rho.
-        apply andp_right; [| solve_andp].
-        rewrite <- andp_assoc.
-        unfold local, lift1; normalize. eapply derives_trans. apply H.
-        eapply derives_trans. apply (rvalue_cspecs_sub CSUB Delta a rho H2). 
-        unfold liftx, lift in H3. simpl in H3. unfold liftx, lift. simpl. normalize.
-        rewrite <- H3, H4. rewrite <- H3. normalize.
-      * eapply semax_pre; [simpl; intros rho | apply H1]. solve_andp. 
-  + apply semax_pre with (CALLpre CS Delta ret a bl R && CALLpre CS' Delta ret a bl R).
-    - simpl. intros rho.
-      apply derives_extract_prop; intros TC.
-      apply andp_right. apply derives_refl. unfold CALLpre; simpl.
-      apply exp_derives; intros argsig.
-      apply exp_derives; intros retsig.
-      apply exp_derives; intros cc.
-      apply exp_derives; intros A.
-      apply exp_derives; intros P.
-      apply exp_derives; intros Q.
-      apply exp_derives; intros NEP.
-      apply exp_derives; intros NEQ.
-      apply exp_derives; intros ts.
-      apply exp_derives; intros x. rewrite ! andp_assoc.
-      apply andp_derives. trivial. 
-      apply derives_trans with
-      ( ( (!!(@eval_expr CS a rho =  @eval_expr CS' a rho)) &&
-          (!!((@eval_exprlist CS argsig bl) rho = 
-              (@eval_exprlist CS' argsig bl) rho)))
-          && (@tc_expr CS Delta a rho &&
-              (@tc_exprlist CS Delta argsig bl rho &&
-                ((` (func_ptr (mk_funspec (argsig, retsig) cc A P Q NEP NEQ))) (@eval_expr CS a) rho &&
-                  |> ((fun tau => P ts x (ge_of rho, @eval_exprlist CS argsig bl tau)) rho *
-               oboxopt Delta ret (fun rho0 : environ => maybe_retval (Q ts x) retsig ret rho0 -* R rho0) rho))))).
-      { apply andp_right; [| trivial]. rewrite <- andp_assoc. apply andp_left1. apply andp_derives.
-        apply rvalue_cspecs_sub; trivial. apply eval_exprlist_cspecs_sub; trivial. }
-      normalize. unfold liftx, lift, make_args'; simpl. rewrite ! H; rewrite ! H0.
-      apply andp_derives; [ | apply andp_derives; [|trivial]].
-      eapply tc_expr_cspecs_sub; trivial. apply tc_exprlist_cspecs_sub; trivial. 
-    - eapply semax_pre; [| apply AuxDefs.semax_call_backward].
-      simpl. intros rho.
-      apply derives_extract_prop; intros TC.
-      apply andp_left2. unfold CALLpre; simpl.
-      apply exp_derives; intros argsig.
-      apply exp_derives; intros retsig.
-      apply exp_derives; intros cc.
-      apply exp_derives; intros A.
-      apply exp_derives; intros P.
-      apply exp_derives; intros Q.
-      apply exp_derives; intros NEP.
-      apply exp_derives; intros NEQ.
-      apply exp_derives; intros ts.
-      apply exp_derives; intros x. apply derives_refl.
-      
-  + apply semax_pre with
-      (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric)
-             (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric)
-                    (@tc_expropt CS Delta ret (ret_type Delta))
-                    (@liftx (Tarrow (option val) (Tarrow environ (LiftEnviron mpred))) (RA_return R) (@cast_expropt CS ret (ret_type Delta)) (@id environ)))
-             (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric)
-                    (@tc_expropt CS' Delta ret (ret_type Delta))
-                    (@liftx (Tarrow (option val) (Tarrow environ (LiftEnviron mpred))) (RA_return R) (@cast_expropt CS' ret (ret_type Delta)) (@id environ)))).
-    - apply andp_right; [ solve_andp |].
-      unfold local, lift1; normalize. simpl. intros rho. apply derives_extract_prop; intros TC.
-      apply andp_right. apply andp_left1. apply tc_expropt_cenv_sub; trivial.
-      unfold liftx, lift; simpl. apply (RA_return_cast_expropt_cspecs_sub CSUB); trivial.
-    - eapply semax_pre; [| apply AuxDefs.semax_return]. solve_andp. 
-  + apply semax_pre with  (andp (SETpre CS Delta id e P) (SETpre CS' Delta id e P)).
-    - simpl. intros rho. apply derives_extract_prop; intros TEDelta.
-      apply andp_right. apply derives_refl. unfold SETpre; simpl. apply orp_derives.
-      { apply orp_derives.
-        + apply orp_derives.
-          - apply later_derives. apply andp_right.
-            * apply andp_left1. apply andp_derives. apply tc_expr_cspecs_sub; trivial.
-              apply tc_temp_id_cspecs_sub; trivial.
-            * apply derives_trans with (((@tc_expr CS Delta e) && (@subst mpred id (@eval_expr CS e) P)) rho).
-              simpl. solve_andp.
-              simpl. apply imp_andp_adjoint.
-              eapply derives_trans. apply (rvalue_cspecs_sub CSUB Delta); trivial.
-              simpl. normalize. unfold subst. simpl. rewrite H. apply imp_andp_adjoint. apply andp_left2. trivial.
-          - apply exp_derives; intros op.
-            apply exp_derives; intros e1.
-            apply exp_derives; intros e2.
-            apply exp_derives; intros t.
-            apply exp_derives; intros sh1.
-            apply exp_derives; intros sh2. normalize. apply later_derives. rewrite ! andp_assoc.
-            apply derives_trans with ((!!( (@eval_expr CS e1 rho) = (@eval_expr CS' e1 rho)) && !!( (@eval_expr CS e2 rho) = (@eval_expr CS' e2 rho))) && (@tc_expr CS Delta e1 rho &&
-  (@tc_expr CS Delta e2 rho &&
-   (local ((` (blocks_match op)) (@eval_expr CS e1) (@eval_expr CS e2)) rho &&
-    ((` (mapsto_ sh1 (typeof e1))) (@eval_expr CS e1) rho * @TT mpred Nveric &&
-     ((` (mapsto_ sh2 (typeof e2))) (@eval_expr CS e2) rho * @TT mpred Nveric &&
-                                                                 @subst mpred id ((` (force_val2 (@sem_binary_operation' CS op (typeof e1) (typeof e2)))) (@eval_expr CS e1) (@eval_expr CS e2)) P rho)))))).
-            * apply andp_right; [apply andp_right | apply derives_refl].
-              apply andp_left1. apply (rvalue_cspecs_sub CSUB Delta); trivial.
-              apply andp_left2.  apply andp_left1. apply (rvalue_cspecs_sub CSUB Delta); trivial.
-            * normalize. unfold liftx, lift, local, lift1, subst; simpl. rewrite ! H0; rewrite ! H1. normalize.
-              apply andp_right. apply andp_left1. apply tc_expr_cspecs_sub; trivial.
-              apply andp_right. apply andp_left2; apply andp_left1. apply tc_expr_cspecs_sub; trivial.
-              apply andp_right. solve_andp.
-              apply andp_right. solve_andp.
-              apply andp_left2. apply andp_left2. apply andp_left2. apply andp_left2.
-              unfold sem_binary_operation'. destruct H as [? [_ [_ [? [? [? ?]]]]]]. 
-              destruct op; simpl; try solve [inv H3]; trivial. 
-        + apply exp_derives; intros sh.
-          apply exp_derives; intros t.
-          apply exp_derives; intros v. normalize.
-          apply later_derives. rewrite ! andp_assoc.
-          apply andp_right. apply andp_left1; apply tc_lvalue_cspecs_sub; trivial.
-          apply andp_right. solve_andp. 
-          apply andp_right.
-          eapply derives_trans.
-          { apply andp_right. apply andp_left1.
-            apply (lvalue_cspecs_sub CSUB Delta e rho TEDelta). apply derives_refl. }
-          normalize. unfold liftx, lift; simpl. rewrite H0. solve_andp. solve_andp. }
-      { apply exp_derives; intros sh.
-        apply exp_derives; intros e1.
-        apply exp_derives; intros t.
-        apply exp_derives; intros v. normalize. apply later_derives. rewrite ! andp_assoc.
-        apply derives_trans with (!!((@eval_lvalue CS e1 rho) = (@eval_lvalue CS' e1 rho)) && (@tc_lvalue CS Delta e1 rho &&
-  (local ((` (tc_val t)) (` (force_val (sem_cast (typeof e1) t v)))) rho &&
-         ((` (mapsto sh (typeof e1))) (@eval_lvalue CS e1) (` v) rho * @TT mpred Nveric && @subst mpred id (` (force_val (sem_cast (typeof e1) t v))) P rho)))).
-        + apply andp_right; [apply andp_left1 | solve_andp]. apply lvalue_cspecs_sub; trivial.
-        + normalize. apply andp_right. apply andp_left1. apply tc_lvalue_cspecs_sub; trivial.
-          unfold liftx, lift; simpl. rewrite H0. solve_andp. }
-    - eapply semax_pre;  [| apply AuxDefs.semax_set_ptr_compare_load_cast_load_backward].
-      apply andp_left2. apply andp_left2. apply derives_refl.
-  + apply semax_pre with (andp (ASSIGNpre CS Delta e1 e2 P) (ASSIGNpre CS' Delta e1 e2 P)).
-    - intros rho. simpl. apply derives_extract_prop; intros TEDelta.
-      apply andp_right. apply derives_refl. unfold ASSIGNpre; simpl.
-      apply orp_derives.
-      *
-        apply exp_derives; intros sh. normalize. apply later_derives.
-        apply andp_right.
-        { apply andp_left1. apply andp_derives. apply tc_lvalue_cspecs_sub; trivial. apply tc_expr_cspecs_sub; trivial. }
-        apply derives_trans with (((!!((@eval_lvalue CS e1 rho) = (@eval_lvalue CS' e1 rho))) &&
-                                          (!!((@eval_expr CS e2 rho) = (@eval_expr CS' e2 rho)))) &&
-                                          ((` (mapsto_ sh (typeof e1))) (@eval_lvalue CS e1) rho *
-                                            ((` (mapsto sh (typeof e1))) (@eval_lvalue CS e1)
-                                               ((` (force_val oo sem_cast (typeof e2) (typeof e1))) (@eval_expr CS e2)) rho -* P rho))).
-       ++ apply andp_derives; [ apply andp_derives| trivial].
-          apply lvalue_cspecs_sub; trivial. 
-          eapply derives_trans. 2: apply rvalue_cspecs_sub; eassumption.
-          unfold tc_expr. simpl. rewrite denote_tc_assert_andp. simpl. solve_andp.
-       ++ normalize. unfold liftx, lift; simpl. rewrite H0, H1; trivial.
-      * apply exp_derives; intros t2.
-        apply exp_derives; intros ch.
-        apply exp_derives; intros ch'.
-        apply exp_derives; intros sh.
-        normalize. apply later_derives.
-        apply andp_right.
-        { apply andp_left1. apply andp_derives. apply tc_lvalue_cspecs_sub; trivial. apply tc_expr_cspecs_sub; trivial. }
-        apply derives_trans with (((!!((@eval_lvalue CS e1 rho) = (@eval_lvalue CS' e1 rho))) &&
-                                          (!!((@eval_expr CS e2 rho) = (@eval_expr CS' e2 rho)))) &&
-                                          ((` (mapsto_ sh (typeof e1))) (@eval_lvalue CS e1) rho &&
-                                           (` (mapsto_ sh t2)) (@eval_lvalue CS e1) rho *
-                                          (ALL x : val,
-                                            (` (mapsto sh t2)) (@eval_lvalue CS e1) (` x) rho -*
-                                              local
-                                                ((` decode_encode_val)
-                                                   ((` (force_val oo sem_cast (typeof e2) (typeof e1))) (@eval_expr CS e2)) (` ch) (` ch') (` x)) rho --> P rho))).
-       ++ apply andp_derives; [ apply andp_derives| trivial].
-          apply lvalue_cspecs_sub; trivial. 
-          eapply derives_trans. 2: apply rvalue_cspecs_sub; eassumption.
-          unfold tc_expr. simpl. rewrite denote_tc_assert_andp. simpl. solve_andp.
-       ++ normalize. unfold local, lift1, liftx, lift; simpl. rewrite H0, H1; trivial.
-    - eapply semax_pre; [| apply AuxDefs.semax_store_store_union_hack_backward].
-      apply andp_left2. apply andp_left2. apply derives_refl. 
+      eapply semax_pre with (local ((` (@eq val)) (@eval_expr CS a) (` (Vint n))) ∧  local ((` (@eq val)) (@eval_expr CS' a) (` (Vint n))) ∧ (Q ∧ local (tc_environ Delta))).
+      * apply bi.and_intro; [| solve_andp].
+        unfold local, lift1; normalize.
+        rewrite H (rvalue_cspecs_sub CSUB Delta a rho H2).
+        unfold_lift.
+        by iIntros "->".
+      * eapply semax_pre, H1. solve_andp. 
+  + eapply semax_pre, AuxDefs.semax_call_backward.
+    split => rho; rewrite /local /lift1; monPred.unseal.
+    apply bi.pure_elim_l; intros TC.
+    apply bi.exist_mono; intros argsig.
+    apply bi.exist_mono; intros retsig.
+    apply bi.exist_mono; intros cc.
+    apply bi.exist_mono; intros Ef.
+    apply bi.exist_mono; intros A.
+    apply bi.exist_mono; intros P.
+    apply bi.exist_mono; intros Q.
+    apply bi.exist_mono; intros x.
+    apply bi.and_mono. trivial.
+    iIntros "H"; iAssert (⌜@eval_expr CS a rho = @eval_expr CS' a rho⌝ ∧ ⌜@eval_exprlist CS argsig bl rho = @eval_exprlist CS' argsig bl rho⌝) as "(%Ha & %Hbl)".
+    { rewrite bi.and_elim_l. iApply (bi.and_mono with "H").
+      apply rvalue_cspecs_sub; trivial. apply eval_exprlist_cspecs_sub; trivial. }
+    unfold_lift; rewrite Ha Hbl.
+    iApply (bi.and_mono with "H"); last done.
+    apply bi.and_mono.
+    eapply tc_expr_cspecs_sub; trivial. apply tc_exprlist_cspecs_sub; trivial.
+  + eapply semax_pre, AuxDefs.semax_return.
+    unfold local, lift1; normalize.
+    apply bi.and_intro. rewrite bi.and_elim_l. destruct CSUB; apply tc_expropt_cenv_sub; trivial.
+    apply (RA_return_cast_expropt_cspecs_sub CSUB); trivial.
+  + eapply semax_pre, AuxDefs.semax_set_ptr_compare_load_cast_load_backward.
+    split => rho; monPred.unseal. apply bi.pure_elim_l; intros TEDelta.
+    apply bi.or_mono.
+    { apply bi.or_mono.
+      + apply bi.or_mono.
+        - apply bi.later_mono. apply bi.and_intro, bi.and_intro.
+          * rewrite bi.and_elim_l. apply tc_expr_cspecs_sub; trivial.
+          * rewrite bi.and_elim_r bi.and_elim_l. apply tc_temp_id_cspecs_sub; trivial.
+          * setoid_rewrite (rvalue_cspecs_sub CSUB Delta); last done.
+            rewrite /subst /=; by iIntros "(-> & _ & ?)".
+        - apply bi.exist_mono; intros op.
+          apply bi.exist_mono; intros e1.
+          apply bi.exist_mono; intros e2.
+          apply bi.exist_mono; intros t.
+          apply bi.exist_mono; intros sh1.
+          apply bi.exist_mono; intros sh2. normalize. apply bi.later_mono.
+          iIntros "H"; iAssert (⌜@eval_expr CS e1 rho = @eval_expr CS' e1 rho⌝ ∧ ⌜@eval_expr CS e2 rho = @eval_expr CS' e2 rho⌝) as "(%He1 & %He2)".
+          { rewrite assoc bi.and_elim_l. iApply (bi.and_mono with "H").
+            apply (rvalue_cspecs_sub CSUB Delta); trivial.
+            apply (rvalue_cspecs_sub CSUB Delta); trivial. }
+          rewrite /subst /lift1; unfold_lift; rewrite !monPred_at_absorbingly /= !He1 !He2.
+          iApply (bi.and_mono with "H"); first by apply @tc_expr_cspecs_sub.
+          apply bi.and_mono; first by apply @tc_expr_cspecs_sub.
+          apply bi.and_mono; first done.
+          apply bi.and_mono; first done.
+          apply bi.and_mono; first done.
+          rewrite /sem_binary_operation'. destruct H as [? [_ [_ [Hc [? [? ?]]]]]].
+          destruct op; simpl; try solve [inv Hc]; trivial.
+      + apply bi.exist_mono; intros sh.
+        apply bi.exist_mono; intros t.
+        apply bi.exist_mono; intros v. normalize.
+        apply bi.and_intro; first by apply bi.pure_intro.
+        apply bi.later_mono.
+        apply bi.pure_elim_l; intros.
+        rewrite -!assoc; apply bi.and_intro. rewrite !bi.and_elim_l; apply tc_lvalue_cspecs_sub; trivial.
+        apply bi.and_intro; first by apply bi.pure_intro.
+        setoid_rewrite lvalue_cspecs_sub; [| done..].
+        rewrite !monPred_at_absorbingly /=; unfold_lift; by iIntros "(-> & ?)". }
+    { apply bi.exist_mono; intros sh.
+      apply bi.exist_mono; intros e1.
+      apply bi.exist_mono; intros t.
+      apply bi.exist_mono; intros v. normalize. apply bi.later_mono.
+      iIntros "H"; iAssert ⌜@eval_lvalue CS e1 rho = @eval_lvalue CS' e1 rho⌝ as %He1.
+      { setoid_rewrite lvalue_cspecs_sub; [| done..]. iDestruct "H" as "($ & _)". }
+      iApply (bi.and_mono with "H"); first by apply @tc_lvalue_cspecs_sub.
+      rewrite /lift1 !monPred_at_absorbingly /=; unfold_lift; rewrite He1 //. }
+  + eapply semax_pre, AuxDefs.semax_store_store_union_hack_backward.
+    split => rho; monPred.unseal. apply bi.pure_elim_l; intros TEDelta.
+    apply bi.or_mono.
+    * apply bi.exist_mono; intros sh. apply bi.and_mono; first done. apply bi.later_mono.
+      apply bi.and_intro.
+      { rewrite bi.and_elim_l. apply bi.and_mono. apply tc_lvalue_cspecs_sub; trivial. apply tc_expr_cspecs_sub; trivial. }
+      iIntros "H"; iAssert (⌜@eval_lvalue CS e1 rho = @eval_lvalue CS' e1 rho⌝ ∧ ⌜@eval_expr CS e2 rho = @eval_expr CS' e2 rho⌝) as "(%He1 & %He2)".
+      { rewrite bi.and_elim_l. iApply (bi.and_mono with "H").
+        apply lvalue_cspecs_sub; trivial.
+        etrans; last by apply rvalue_cspecs_sub.
+        rewrite denote_tc_assert_andp. simpl. solve_andp. }
+      rewrite bi.and_elim_r.
+      unfold_lift; rewrite He1; iDestruct "H" as "($ & H)".
+      iIntros (? [=]) "?"; subst; iApply "H"; first done.
+      rewrite He1 He2 //.
+    * apply bi.exist_mono; intros t2.
+      apply bi.exist_mono; intros ch.
+      apply bi.exist_mono; intros ch'.
+      apply bi.exist_mono; intros sh.
+      apply bi.and_mono; first done. apply bi.later_mono.
+      apply bi.and_intro.
+      { rewrite bi.and_elim_l. apply bi.and_mono. apply tc_lvalue_cspecs_sub; trivial. apply tc_expr_cspecs_sub; trivial. }
+      iIntros "H"; iAssert (⌜@eval_lvalue CS e1 rho = @eval_lvalue CS' e1 rho⌝ ∧ ⌜@eval_expr CS e2 rho = @eval_expr CS' e2 rho⌝) as "(%He1 & %He2)".
+      { rewrite bi.and_elim_l. iApply (bi.and_mono with "H").
+        apply lvalue_cspecs_sub; trivial.
+        etrans; last by apply rvalue_cspecs_sub.
+        rewrite denote_tc_assert_andp. simpl. solve_andp. }
+      rewrite bi.and_elim_r.
+      unfold_lift; rewrite He1; iDestruct "H" as "($ & H)".
+      iIntros (?? [=]) "?"; iIntros (? [=] ?); subst. rewrite -He1; iApply ("H" with "[%] [$]"); try done.
+      rewrite /lift1 /= He2 //.
   + apply AuxDefs.semax_skip.
   + apply AuxDefs.semax_builtin.
   + apply AuxDefs.semax_label; auto.
   + apply AuxDefs.semax_goto.
   + eapply semax_conseq; [.. | exact IHsemax]; auto.
+  + eapply AuxDefs.semax_mask_mono; eauto.
 Qed.
 
-Lemma semax_body_subsumption: forall cs V V' F F' f spec
-      (SF: @semax_body V F cs f spec)
+Lemma semax_body_subsumption: forall {CS} V V' F F' f spec
+      (SF: semax_body V F f spec)
       (TS: tycontext_sub (func_tycontext f V F nil) (func_tycontext f V' F' nil)),
-    @semax_body V' F' cs f spec.
+    semax_body(C := CS) V' F' f spec.
 Proof.
   destruct spec. destruct f0. 
   intros [? [? SF]] ?. split3; auto.
   intros.
   eapply semax_Delta_subsumption. apply TS.
-  apply (SF Espec ts x).
+  apply (SF _ x).
 Qed.
 
 (*Should perhaps be called semax_body_cespecs_sub, also in the Module Type *)
 Lemma semax_body_cenv_sub {CS CS'} (CSUB: cspecs_sub CS CS') V G f spec
       (COMPLETE : Forall (fun it : ident * type => complete_type (@cenv_cs CS) (snd it) = true) (fn_vars f)):
-    @semax_body V G CS f spec -> @semax_body V G CS' f spec.
+    semax_body V G (C := CS) f spec -> semax_body V G (C := CS') f spec.
 Proof.
   destruct spec. destruct f0.
   intros [H' [H'' H]]; split3; auto.
-  intros.  specialize (H Espec ts x). 
+  intros.  specialize (H _ x).
   rewrite <- (semax_prog.stackframe_of_cspecs_sub CSUB); [apply (semax_cssub CSUB); apply H | trivial].
 Qed. 
 
 Lemma semax_extract_exists':
-  forall {CS: compspecs} {Espec: OracleKind},
-  forall (A : Type)  (P : A -> environ->mpred) c (Delta: tycontext) (R: ret_assert),
-  (forall x, @semax CS Espec Delta (P x) c R) ->
-   @semax CS Espec Delta (fun rho => EX x:A, P x rho) c R.
+  forall  {OK_spec: ext_spec OK_ty} {CS: compspecs} (A : Type) (P : A -> assert) c E (Delta: tycontext) (R: ret_assert),
+  (forall x, semax E Delta (P x) c R) ->
+   semax E Delta (∃ x:A, P x) c R.
 Proof. intros. apply semax_extract_exists in H. apply H. Qed.
 
 Lemma semax_extract_prop':
-  forall {CS: compspecs} {Espec: OracleKind},
-  forall Delta (PP: Prop) P c Q,
-           (PP -> @semax CS Espec Delta P c Q) ->
-           @semax CS Espec Delta (fun rho => !!PP && P rho) c Q.
+  forall {OK_spec: ext_spec OK_ty} {CS: compspecs} E Delta (PP: Prop) P c Q,
+           (PP -> semax E Delta P c Q) ->
+           semax E Delta (⌜PP⌝ ∧ P) c Q.
 Proof. intros. apply semax_extract_prop in H. apply H. Qed.
 
-Lemma modifiedvars_aux: forall id, (fun i => isSome (insert_idset id idset0) ! i) = eq id.
+Lemma modifiedvars_aux: forall id, (fun i => isSome ((insert_idset id idset0) !! i)) = eq id.
 Proof.
   intros.
   extensionality i.
@@ -2112,540 +1990,350 @@ Proof.
   unfold insert_idset.
   destruct (ident_eq i id).
   + subst.
-    rewrite PTree.gss.
+    setoid_rewrite Maps.PTree.gss.
     simpl; tauto.
-  + rewrite PTree.gso by auto.
+  + setoid_rewrite Maps.PTree.gso; auto.
     unfold idset0.
-    rewrite PTree.gempty.
+    rewrite Maps.PTree.gempty.
     simpl.
     split; [tauto | intro].
     congruence.
 Qed.
 
-Lemma sepcon_derives_full: forall Delta E P1 P2 Q1 Q2,
-  (local (tc_environ Delta) && (allp_fun_id Delta && P1) |-- (|={E}=> P2)) ->
-  (local (tc_environ Delta) && (allp_fun_id Delta && Q1) |-- (|={E}=> Q2)) ->
-  local (tc_environ Delta) && (allp_fun_id Delta && (P1 * Q1)) |-- (|={E}=> (P2 * Q2)).
+Lemma sep_mono_full: forall Delta E P1 P2 Q1 Q2,
+  (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P1) ⊢ (|={E}=> P2)) ->
+  (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ Q1) ⊢ (|={E}=> Q2)) ->
+  local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ (P1 ∗ Q1)) ⊢ (|={E}=> (P2 ∗ Q2)).
 Proof.
   intros.
-  pose proof sepcon_ENTAILL  _ _ _ _ _ H H0.
-  eapply derives_trans; [exact H1 |].
-  eapply derives_trans; [apply fupd_frame_r|].
-  eapply derives_trans, fupd_trans; apply fupd_mono.
-  apply fupd_frame_l.
+  rewrite sepcon_ENTAILL //.
+  by iIntros "(>$ & >$)".
 Qed.
 
 Lemma semax_frame:
-  forall {CS: compspecs} {Espec: OracleKind},
-  forall Delta P s R F,
+  forall {OK_spec: ext_spec OK_ty} {CS: compspecs} E Delta P s R F,
    closed_wrt_modvars s F ->
-  @semax CS Espec Delta P s R ->
-    @semax CS Espec Delta (P * F) s (frame_ret_assert R F).
+  semax E Delta P s R ->
+    semax E Delta (P ∗ F) s (frame_ret_assert R F).
 Proof.
   intros.
   induction H0.
-  + apply semax_pre with (!! (bool_type (typeof b) = true) && (|> (tc_expr Delta (Eunop Cop.Onotbool b (Tint I32 Signed noattr)) && (P * F)))).
-    - normalize.
-      eapply derives_trans; [apply andp_derives, sepcon_derives, now_later; apply derives_refl|].
-      apply andp_left2; rewrite <- later_sepcon; apply later_derives.
-      apply andp_right.
-      * eapply derives_trans; [apply sepcon_derives, derives_refl; apply andp_left1, derives_refl |].
-        intro rho.
-        constructor; apply (predicates_sl.extend_sepcon (extend_tc.extend_tc_expr Delta (Eunop Cop.Onotbool b (Tint I32 Signed noattr)) rho)).
-      * apply sepcon_derives; [apply andp_left2|]; auto.
+  + apply semax_pre with (⌜bool_type (typeof b) = true⌝ ∧ (▷ (tc_expr Delta (Eunop Cop.Onotbool b (Tint I32 Signed noattr)) ∧ (P ∗ F)))).
+    - by iIntros "(_ & ($ & ?) & $)".
     - rewrite semax_lemmas.closed_Sifthenelse in H; destruct H.
       apply AuxDefs.semax_ifthenelse.
       * eapply semax_pre; [| apply IHsemax1; auto].
-        apply andp_left2.
-        unfold_lift.
-        intro rho; unfold local, lift1; simpl.
-        normalize.
+        iIntros "(_ & ($ & $) & $)".
       * eapply semax_pre; [| apply IHsemax2; auto].
-        apply andp_left2.
-        unfold_lift.
-        intro rho; unfold local, lift1; simpl.
-        normalize.
+        iIntros "(_ & ($ & $) & $)".
   + rewrite semax_lemmas.closed_Ssequence in H; destruct H.
-    apply AuxDefs.semax_seq with (Q * F).
+    apply AuxDefs.semax_seq with (Q ∗ F).
     - destruct R; apply IHsemax1; auto.
     - destruct R; apply IHsemax2; auto.
-  + replace (RA_break Q * F) with (RA_break (frame_ret_assert Q F)) by (destruct Q; auto).
+  + replace (RA_break Q ∗ F) with (RA_break (frame_ret_assert Q F)) by (destruct Q; auto).
     apply AuxDefs.semax_break.
-  + replace (RA_continue Q * F) with (RA_continue (frame_ret_assert Q F)) by (destruct Q; auto).
+  + replace (RA_continue Q ∗ F) with (RA_continue (frame_ret_assert Q F)) by (destruct Q; auto).
     apply AuxDefs.semax_continue.
   + rewrite semax_lemmas.closed_Sloop in H; destruct H.
-    eapply AuxDefs.semax_loop with (Q' * F).
+    eapply AuxDefs.semax_loop with (Q' ∗ F).
     - destruct R; apply IHsemax1; auto.
-    - replace (loop2_ret_assert (Q * F) (frame_ret_assert R F))
-        with (frame_ret_assert (loop2_ret_assert Q R) F)
-        by (destruct R; simpl; f_equal; extensionality rho; apply pred_ext; normalize).
-      apply IHsemax2; auto.
-  + rewrite corable_andp_sepcon1 by (apply corable_prop).
-    eapply AuxDefs.semax_switch; auto.
-    - intro.
-      eapply derives_trans; [apply sepcon_derives; [apply H0 | apply derives_refl] |].
-      constructor; apply (predicates_sl.extend_sepcon (extend_tc.extend_tc_expr Delta a rho)).
-    - intros.
-      rewrite <- corable_andp_sepcon1 by (intro; apply corable_prop).
-      replace (switch_ret_assert (frame_ret_assert R F)) with
-        (frame_ret_assert (switch_ret_assert R) F)
-        by (destruct R; simpl; f_equal; extensionality rho; apply pred_ext; normalize).
-      apply (H2 n).
-      eapply semax_lemmas.closed_Sswitch; eauto.
-  + rewrite frame_normal.
-    eapply semax_pre; [.. | apply AuxDefs.semax_call_backward; auto].
-    - apply andp_left2.
-      rewrite exp_sepcon1. apply exp_derives; intros argsig.
-      rewrite exp_sepcon1. apply exp_derives; intros retsig.
-      rewrite exp_sepcon1. apply exp_derives; intros cc.
-      rewrite exp_sepcon1. apply exp_derives; intros A.
-      rewrite exp_sepcon1. apply exp_derives; intros P.
-      rewrite exp_sepcon1. apply exp_derives; intros Q.
-      rewrite exp_sepcon1. apply exp_derives; intros NEP.
-      rewrite exp_sepcon1. apply exp_derives; intros NEQ.
-      rewrite exp_sepcon1. apply exp_derives; intros ts.
-      rewrite exp_sepcon1. apply exp_derives; intros x.
-      normalize.
-      apply andp_right; [apply andp_right |].
-      * apply wand_sepcon_adjoint.
-        apply andp_left1.
-        apply andp_left1.
-        apply wand_sepcon_adjoint.
-        eapply derives_trans; [apply sepcon_derives; [apply derives_refl | apply now_later] |].
-        intro rho.
-        simpl. constructor.
-        apply (predicates_sl.extend_sepcon (extend_tc.extend_andp _ _ (extend_tc.extend_tc_expr Delta a rho) (extend_tc.extend_tc_exprlist Delta argsig bl rho))).
-      * apply wand_sepcon_adjoint.
-        apply andp_left1, andp_left2.
-        apply wand_sepcon_adjoint.
-        apply derives_left_sepcon_right_corable; auto.
-        intro.
-        apply corable_func_ptr.
-      * apply wand_sepcon_adjoint.
-        apply andp_left2.
-        apply wand_sepcon_adjoint.
-        eapply derives_trans; [apply sepcon_derives; [apply derives_refl | apply now_later] |].
-        rewrite <- later_sepcon.
-        apply later_derives.
-        rewrite sepcon_assoc; apply sepcon_derives; auto.
-
-        destruct H0 as [? [? ?]].
-        rewrite <- (oboxopt_closed Delta ret F) at 1 by (try eapply tc_fn_return_temp_guard_opt; eauto).
-        eapply derives_trans; [apply oboxopt_sepcon |].
-        apply oboxopt_K.
-        rewrite <- (sepcon_emp (maybe_retval _ _ _)) at 2.
-        eapply derives_trans; [| apply wand_frame_hor].
-        apply sepcon_derives; auto.
-        apply wand_sepcon_adjoint.
-        rewrite sepcon_emp; auto.
+    - eapply semax_post, IHsemax2; auto; destruct R; simpl; intros; rewrite bi.and_elim_r //.
+      rewrite bi.sep_False //.
+  + eapply semax_pre, (AuxDefs.semax_switch _ _ (Q ∗ F)).
+    - iIntros "(_ & ($ & $) & $)".
+    - rewrite H0; iIntros "($ & _)".
+    - intros; eapply semax_pre_post, H2; try solve [destruct R; simpl; intros; rewrite bi.and_elim_r //].
+      * iIntros "(_ & ? & $ & $)"; auto.
+      * destruct R; simpl; iIntros "(_ & [] & _)".
+      * eapply semax_lemmas.closed_Sswitch; eauto.
+  + eapply semax_pre_post; [.. | apply (AuxDefs.semax_call_backward _ _ _ _ _ (R ∗ F)); auto];
+      try solve [destruct R; simpl; intros; rewrite bi.and_elim_r //; iIntros "[]"].
+    rewrite bi.and_elim_r.
+    rewrite bi.sep_exist_r. apply bi.exist_mono; intros argsig.
+    rewrite bi.sep_exist_r. apply bi.exist_mono; intros retsig.
+    rewrite bi.sep_exist_r. apply bi.exist_mono; intros cc.
+    rewrite bi.sep_exist_r. apply bi.exist_mono; intros Ef.
+    rewrite bi.sep_exist_r. apply bi.exist_mono; intros A.
+    rewrite bi.sep_exist_r. apply bi.exist_mono; intros P.
+    rewrite bi.sep_exist_r. apply bi.exist_mono; intros Q.
+    rewrite bi.sep_exist_r. apply bi.exist_mono; intros x.
+    iIntros "(((% & % & % & %) & H) & F)"; iSplit; first done.
+    iSplit; first by rewrite bi.and_elim_l; iDestruct "F" as "_".
+    iDestruct "H" as "(_ & $ & H)".
+    iNext; iDestruct "H" as "($ & H)".
+    rewrite <- (oboxopt_closed Delta ret F) at 1 by (try eapply tc_fn_return_temp_guard_opt; eauto).
+    iCombine "H F" as "H"; rewrite oboxopt_sepcon.
+    iApply (oboxopt_K with "H").
+    iIntros "(H & $) ?"; iApply "H"; done.
   + eapply semax_pre; [| apply AuxDefs.semax_return].
-    apply andp_left2.
-    apply andp_right.
-    - intro rho; simpl.
-      eapply derives_trans; [apply sepcon_derives; [| apply derives_refl]; apply andp_left1, derives_refl |].
-      constructor; apply (predicates_sl.extend_sepcon (extend_tc.extend_tc_expropt Delta ret (ret_type Delta) rho)).
-    - intro rho; simpl.
-      eapply derives_trans; [apply sepcon_derives; [| apply derives_refl]; apply andp_left2, derives_refl |].
-      destruct R; simpl.
-      apply derives_refl.
-  + rewrite frame_normal.
-    eapply semax_pre; [| apply AuxDefs.semax_set_ptr_compare_load_cast_load_backward].
-    apply andp_left2.
-    rewrite !distrib_orp_sepcon.
-    repeat apply orp_derives.
-    - eapply derives_trans; [apply sepcon_derives; [apply derives_refl |]; apply now_later |].
-      rewrite <- later_sepcon.
-      apply later_derives.
-      apply andp_right.
-      * intro rho; simpl.
-        eapply derives_trans; [apply sepcon_derives; [| apply derives_refl]; apply andp_left1, derives_refl |].
-        constructor; apply (predicates_sl.extend_sepcon (extend_tc.extend_andp _ _ (extend_tc.extend_tc_expr Delta e rho) (extend_tc.extend_tc_temp_id id (typeof e) Delta e rho))).
-      * eapply derives_trans; [apply sepcon_derives; [| apply derives_refl]; apply andp_left2, derives_refl |].
-        rewrite subst_sepcon.
-        rewrite (closed_wrt_subst _ _ F); auto.
-        unfold closed_wrt_modvars in H.
-        rewrite <- modifiedvars_aux.
-        auto.
-    - rewrite exp_sepcon1; apply exp_derives; intros cmp.
-      rewrite exp_sepcon1; apply exp_derives; intros e1.
-      rewrite exp_sepcon1; apply exp_derives; intros e2.
-      rewrite exp_sepcon1; apply exp_derives; intros ty.
-      rewrite exp_sepcon1; apply exp_derives; intros sh1.
-      rewrite exp_sepcon1; apply exp_derives; intros sh2.
-      normalize.
-      eapply derives_trans; [apply sepcon_derives; [apply derives_refl |]; apply now_later |].
-      rewrite <- later_sepcon.
-      apply later_derives.
-      apply andp_right; [apply andp_right; [apply andp_right; [apply andp_right |] |] |].
-      * eapply derives_trans; [apply sepcon_derives; [| apply derives_refl]; apply andp_left1, andp_left1, andp_left1, andp_left1, derives_refl |].
-        intro rho; simpl.
-        constructor; apply (predicates_sl.extend_sepcon (extend_tc.extend_andp _ _ (extend_tc.extend_tc_expr Delta e1 rho) (extend_tc.extend_tc_expr Delta e2 rho))).
-      * unfold local, lift1; unfold_lift; intro rho; simpl.
-        eapply derives_trans; [apply sepcon_derives; [| apply derives_refl]; apply andp_left1, andp_left1, andp_left1, andp_left2, derives_refl |].
-        rewrite <- (andp_TT (prop _)) at 1.
-        normalize.
-      * eapply derives_trans; [apply sepcon_derives; [| apply derives_refl]; apply andp_left1, andp_left1, andp_left2, derives_refl |].
-        rewrite sepcon_assoc.
-        apply sepcon_derives; auto.
-      * eapply derives_trans; [apply sepcon_derives; [| apply derives_refl]; apply andp_left1, andp_left2, derives_refl |].
-        rewrite sepcon_assoc.
-        apply sepcon_derives; auto.
-      * eapply derives_trans; [apply sepcon_derives; [| apply derives_refl]; apply andp_left2, derives_refl |].
-        rewrite subst_sepcon.
-        rewrite (closed_wrt_subst _ _ F); auto.
-        unfold closed_wrt_modvars in H.
-        rewrite <- modifiedvars_aux.
-        auto.
-    - rewrite exp_sepcon1; apply exp_derives; intros sh.
-      rewrite exp_sepcon1; apply exp_derives; intros t2.
-      rewrite exp_sepcon1; apply exp_derives; intros v2.
-      normalize.
-      eapply derives_trans; [apply sepcon_derives; [apply derives_refl |]; apply now_later |].
-      rewrite <- later_sepcon.
-      apply later_derives.
-      apply andp_right; [apply andp_right; [apply andp_right |] |].
-      * eapply derives_trans; [apply sepcon_derives; [| apply derives_refl]; apply andp_left1, andp_left1, andp_left1, derives_refl |].
-        intro rho; simpl.
-        constructor; apply (predicates_sl.extend_sepcon (extend_tc.extend_tc_lvalue Delta e rho)).
-      * unfold local, lift1; unfold_lift; intro rho; simpl.
-        eapply derives_trans; [apply sepcon_derives; [| apply derives_refl]; apply andp_left1, andp_left1, andp_left2, derives_refl |].
-        rewrite <- (andp_TT (prop _)) at 1.
-        normalize.
-      * eapply derives_trans; [apply sepcon_derives; [| apply derives_refl]; apply andp_left1, andp_left2, derives_refl |].
-        rewrite sepcon_assoc.
-        apply sepcon_derives; auto.
-      * eapply derives_trans; [apply sepcon_derives; [| apply derives_refl]; apply andp_left2, derives_refl |].
-        rewrite subst_sepcon.
-        rewrite (closed_wrt_subst _ _ F); auto.
-        unfold closed_wrt_modvars in H.
-        rewrite <- modifiedvars_aux.
-        auto.
-    - rewrite exp_sepcon1; apply exp_derives; intros sh.
-      rewrite exp_sepcon1; apply exp_derives; intros e1.
-      rewrite exp_sepcon1; apply exp_derives; intros t1.
-      rewrite exp_sepcon1; apply exp_derives; intros v2.
-      normalize.
-      eapply derives_trans; [apply sepcon_derives; [apply derives_refl |]; apply now_later |].
-      rewrite <- later_sepcon.
-      apply later_derives.
-      apply andp_right; [apply andp_right; [apply andp_right |] |].
-      * eapply derives_trans; [apply sepcon_derives; [| apply derives_refl]; apply andp_left1, andp_left1, andp_left1, derives_refl |].
-        intro rho; simpl.
-        constructor; apply (predicates_sl.extend_sepcon (extend_tc.extend_tc_lvalue Delta e1 rho)).
-      * unfold local, lift1; unfold_lift; intro rho; simpl.
-        eapply derives_trans; [apply sepcon_derives; [| apply derives_refl]; apply andp_left1, andp_left1, andp_left2, derives_refl |].
-        rewrite <- (andp_TT (prop _)) at 1.
-        normalize.
-      * eapply derives_trans; [apply sepcon_derives; [| apply derives_refl]; apply andp_left1, andp_left2, derives_refl |].
-        rewrite sepcon_assoc.
-        apply sepcon_derives; auto.
-      * eapply derives_trans; [apply sepcon_derives; [| apply derives_refl]; apply andp_left2, derives_refl |].
-        rewrite subst_sepcon.
-        rewrite (closed_wrt_subst _ _ F); auto.
-        unfold closed_wrt_modvars in H.
-        rewrite <- modifiedvars_aux.
-        auto.
-  + rewrite frame_normal.
-    eapply semax_pre; [| apply AuxDefs.semax_store_store_union_hack_backward].
-    apply andp_left2.
-    rewrite distrib_orp_sepcon.
-    apply orp_derives.
-    - rewrite exp_sepcon1; apply exp_derives; intros sh.
-      normalize.
-      eapply derives_trans; [apply sepcon_derives; [apply derives_refl |]; apply now_later |].
-      rewrite <- later_sepcon.
-      apply later_derives.
-      apply andp_right.
-      * eapply derives_trans; [apply sepcon_derives; [| apply derives_refl]; apply andp_left1, derives_refl |].
-        intro rho; simpl. constructor.
-        apply (predicates_sl.extend_sepcon (extend_tc.extend_andp _ _ (extend_tc.extend_tc_lvalue Delta e1 rho) (extend_tc.extend_tc_expr Delta (Ecast e2 (typeof e1)) rho))).
-      * eapply derives_trans; [apply sepcon_derives; [| apply derives_refl]; apply andp_left2, derives_refl |].
-        rewrite sepcon_assoc; apply sepcon_derives; auto.
-        rewrite <- (sepcon_emp ((` (mapsto sh (typeof e1))) (eval_lvalue e1)
-                     ((` (force_val oo sem_cast (typeof e2) (typeof e1))) (eval_expr e2)))) at 2.
-        eapply derives_trans; [| apply wand_frame_hor].
-        apply sepcon_derives; [apply derives_refl |].
-        rewrite <- wand_sepcon_adjoint.
-        rewrite sepcon_emp; auto.
-    - rewrite exp_sepcon1; apply exp_derives; intros t2.
-      rewrite exp_sepcon1; apply exp_derives; intros ch.
-      rewrite exp_sepcon1; apply exp_derives; intros ch'.
-      rewrite exp_sepcon1; apply exp_derives; intros sh.
-      normalize.
-      eapply derives_trans; [apply sepcon_derives; [apply derives_refl |]; apply now_later |].
-      rewrite <- later_sepcon.
-      apply later_derives.
-      apply andp_right.
-      * eapply derives_trans; [apply sepcon_derives; [| apply derives_refl]; apply andp_left1, derives_refl |].
-        intro rho; simpl. constructor.
-        apply (predicates_sl.extend_sepcon (extend_tc.extend_andp _ _ (extend_tc.extend_tc_lvalue Delta e1 rho) (extend_tc.extend_tc_expr Delta (Ecast e2 (typeof e1)) rho))).
-      * eapply derives_trans; [apply sepcon_derives; [| apply derives_refl]; apply andp_left2, derives_refl |].
-        rewrite sepcon_assoc; apply sepcon_derives; auto.
-        apply allp_right; intros v'.
-        apply wand_sepcon_adjoint.
-        apply allp_left with v'.
-        apply wand_sepcon_adjoint.
-        rewrite <- (emp_wand F) at 1.
-        eapply derives_trans; [apply wand_frame_hor |].
-        apply wand_derives; [rewrite sepcon_emp; auto |].
-        apply imp_andp_adjoint.
-        rewrite andp_comm, <- corable_andp_sepcon2 by (intro; apply corable_prop).
-        apply sepcon_derives; auto.
-        apply imp_andp_adjoint.
-        auto.
-  + rewrite frame_normal.
-    apply AuxDefs.semax_skip.
-  + rewrite FF_sepcon.
-    apply AuxDefs.semax_builtin.
+    rewrite bi.and_elim_r.
+    apply bi.and_intro.
+    - iIntros "(($ & _) & _)".
+    - split => rho; destruct R; simpl; monPred.unseal; unfold_lift.
+      iIntros "((_ & $) & $)".
+  + eapply semax_pre_post, AuxDefs.semax_set_ptr_compare_load_cast_load_backward;
+      try solve [simpl; intros; rewrite bi.and_elim_r //; iIntros "[]"].
+    rewrite bi.and_elim_r.
+    rewrite !bi.sep_or_r.
+    repeat apply bi.or_mono.
+    - iIntros "H"; iNext.
+      iSplit; first by iDestruct "H" as "(($ & _) & _)".
+      iSplit; first by iDestruct "H" as "((_ & $ & _) & _)".
+      rewrite !bi.and_elim_r subst_sepcon.
+      iDestruct "H" as "($ & ?)".
+      rewrite closed_wrt_subst //.
+      rewrite -modifiedvars_aux //.
+    - rewrite bi.sep_exist_r; apply bi.exist_mono; intros cmp.
+      rewrite bi.sep_exist_r; apply bi.exist_mono; intros e1.
+      rewrite bi.sep_exist_r; apply bi.exist_mono; intros e2.
+      rewrite bi.sep_exist_r; apply bi.exist_mono; intros ty.
+      rewrite bi.sep_exist_r; apply bi.exist_mono; intros sh1.
+      rewrite bi.sep_exist_r; apply bi.exist_mono; intros sh2.
+      iIntros "(($ & H) & ?)".
+      iNext.
+      repeat (iSplit; first rewrite bi.and_elim_l //; rewrite bi.and_elim_r).
+      rewrite subst_sepcon; iFrame.
+      rewrite closed_wrt_subst //.
+      rewrite -modifiedvars_aux //.
+    - rewrite bi.sep_exist_r; apply bi.exist_mono; intros sh.
+      rewrite bi.sep_exist_r; apply bi.exist_mono; intros t2.
+      rewrite bi.sep_exist_r; apply bi.exist_mono; intros v2.
+      iIntros "(($ & H) & ?)".
+      iNext.
+      repeat (iSplit; first rewrite bi.and_elim_l //; rewrite bi.and_elim_r).
+      rewrite subst_sepcon; iFrame.
+      rewrite closed_wrt_subst //.
+      rewrite -modifiedvars_aux //.
+    - rewrite bi.sep_exist_r; apply bi.exist_mono; intros sh.
+      rewrite bi.sep_exist_r; apply bi.exist_mono; intros e1.
+      rewrite bi.sep_exist_r; apply bi.exist_mono; intros t1.
+      rewrite bi.sep_exist_r; apply bi.exist_mono; intros v2.
+      iIntros "(($ & H) & ?)".
+      iNext.
+      repeat (iSplit; first rewrite bi.and_elim_l //; rewrite bi.and_elim_r).
+      rewrite subst_sepcon; iFrame.
+      rewrite closed_wrt_subst //.
+      rewrite -modifiedvars_aux //.
+  + eapply semax_pre_post, AuxDefs.semax_store_store_union_hack_backward;
+      try solve [simpl; intros; rewrite bi.and_elim_r //; iIntros "[]"].
+    rewrite bi.and_elim_r.
+    rewrite bi.sep_or_r.
+    apply bi.or_mono.
+    - rewrite bi.sep_exist_r; apply bi.exist_mono; intros sh.
+      iIntros "(($ & H) & ?)".
+      iNext.
+      repeat (iSplit; first rewrite bi.and_elim_l //; rewrite bi.and_elim_r).
+      iDestruct "H" as "($ & H)"; iIntros "?".
+      iFrame; iApply "H"; done.
+    - rewrite bi.sep_exist_r; apply bi.exist_mono; intros t2.
+      rewrite bi.sep_exist_r; apply bi.exist_mono; intros ch.
+      rewrite bi.sep_exist_r; apply bi.exist_mono; intros ch'.
+      rewrite bi.sep_exist_r; apply bi.exist_mono; intros sh.
+      iIntros "(($ & H) & ?)".
+      iNext.
+      repeat (iSplit; first rewrite bi.and_elim_l //; rewrite bi.and_elim_r).
+      iDestruct "H" as "($ & H)"; iIntros (?) "??".
+      iFrame; iApply ("H" with "[$]"); auto.
+  + eapply semax_post, AuxDefs.semax_skip; try solve [simpl; intros; rewrite bi.and_elim_r //; iIntros "[]"].
+  + eapply semax_pre, AuxDefs.semax_builtin.
+    iIntros "(_ & [] & _)".
   + apply AuxDefs.semax_label.
     apply IHsemax; auto.
-  + rewrite FF_sepcon.
-    apply AuxDefs.semax_goto.
+  + eapply semax_pre, AuxDefs.semax_goto.
+    iIntros "(_ & [] & _)".
   + eapply semax_conseq; [.. | apply IHsemax; auto].
-    - apply sepcon_derives_full; [exact H0 |].
+    - apply sep_mono_full; [exact H0 |].
       reduce2derives.
       auto.
     - destruct R, R'.
-      apply sepcon_derives_full; [exact H1 |].
+      apply sep_mono_full; [exact H1 |].
       reduce2derives.
       auto.
     - destruct R, R'.
-      apply sepcon_derives_full; [exact H2 |].
+      apply sep_mono_full; [exact H2 |].
       reduce2derives.
       auto.
     - destruct R, R'.
-      apply sepcon_derives_full; [exact H3 |].
+      apply sep_mono_full; [exact H3 |].
       reduce2derives.
       auto.
     - intros; destruct R, R'.
       apply sepcon_ENTAILL; auto.
-      apply andp_left2, andp_left2, derives_refl.
-Qed.
-
-Lemma bupd_andp_prop:
-  forall P Q, bupd (!! P && Q) = !!P && bupd Q.
-Proof.
-  apply own.bupd_andp_prop.
-Qed.
-
-Lemma fupd_andp_prop:
-  forall E1 E2 P Q, !! P && (|={E1,E2}=> Q) |-- |={E1,E2}=> (!! P && Q).
-Proof.
-  intros; unseal_derives; apply fupd.fupd_andp_prop.
-Qed.
-
-Lemma semax_adapt_frame {cs Espec} Delta c (P P': assert) (Q Q' : ret_assert)
-   (H: forall rho,  derives (!!(typecheck_environ Delta rho) && (allp_fun_id Delta rho && P rho))
-                   (EX F: assert, (!!(closed_wrt_modvars c F) && (|={Ensembles.Full_set}=> (P' rho * F rho)) &&
-                         !!(forall rho, (local (tc_environ Delta) rho) && ((allp_fun_id Delta rho)) && RA_normal (frame_ret_assert Q' F) rho |-- |={Ensembles.Full_set}=> (RA_normal Q rho)) &&
-                         !!(forall rho, (local (tc_environ Delta) rho) && ((allp_fun_id Delta rho)) && RA_break (frame_ret_assert Q' F) rho |-- |={Ensembles.Full_set}=> (RA_break Q rho)) &&
-                         !!(forall rho, (local (tc_environ Delta) rho) && ((allp_fun_id Delta rho)) && RA_continue (frame_ret_assert Q' F) rho |-- |={Ensembles.Full_set}=> (RA_continue Q rho)) &&
-                         !!(forall vl rho, (local (tc_environ Delta) rho) && ((allp_fun_id Delta rho)) && RA_return (frame_ret_assert Q' F) vl rho |-- (RA_return Q vl rho)))))
-   (SEM: @semax cs Espec Delta P' c Q'):
-   @semax cs Espec Delta P c Q.
-Proof. intros. 
-apply (@semax_conseq cs Espec Delta (fun rho => EX F: assert, !!(closed_wrt_modvars c F) && ((|={Ensembles.Full_set}=> (sepcon (P' rho) (F rho))) &&
-                         (!!(forall rho, (local (tc_environ Delta) rho) && ((allp_fun_id Delta rho)) && RA_normal (frame_ret_assert Q' F) rho |-- |={Ensembles.Full_set}=> (RA_normal Q rho)) &&
-                         (!!(forall rho, (local (tc_environ Delta) rho) && ((allp_fun_id Delta rho)) && RA_break (frame_ret_assert Q' F) rho |-- |={Ensembles.Full_set}=> (RA_break Q rho)) &&
-                         (!!(forall rho, (local (tc_environ Delta) rho) && ((allp_fun_id Delta rho)) && RA_continue (frame_ret_assert Q' F) rho |-- |={Ensembles.Full_set}=> (RA_continue Q rho)) &&
-                         (!!(forall vl rho, (local (tc_environ Delta) rho) && ((allp_fun_id Delta rho)) && RA_return (frame_ret_assert Q' F) vl rho |-- (RA_return Q vl rho))))))))
-   Q).
-+ intros. simpl; intros.  eapply derives_trans. apply H. clear H.
-  change fupd with (ghost_seplog.fupd Ensembles.Full_set Ensembles.Full_set).
-  eapply derives_trans, fupd_intro.
-  apply exp_derives; intros F. rewrite !andp_assoc; auto.
-+ clear H. intros. eapply derives_trans, fupd_intro.
-  do 2 apply andp_left2; trivial.
-+ clear H. intros. eapply derives_trans, fupd_intro.
-  do 2 apply andp_left2; trivial.
-+ clear H. intros. eapply derives_trans, fupd_intro.
-  do 2 apply andp_left2; trivial.
-+ clear H. intros.
-  do 2 apply andp_left2; trivial.
-+ apply semax_extract_exists'. intros F. clear H.
-  apply semax_extract_prop'. intros.
-  eapply semax_pre_fupd. 2:{ do 4 (apply semax_extract_prop; intros). 
-    eapply semax_conseq. 6:{ apply semax_frame. exact H. apply SEM. }
-    2: { intros; eapply derives_trans; [ | apply fupd_mono; apply derives_refl]. 
-         exact H0. }
-  2: { intros; eapply derives_trans; [ | apply fupd_mono; apply derives_refl]. 
-       exact H1. }
-  2: { intros; eapply derives_trans; [ | apply fupd_mono; apply derives_refl].
-       exact H2. }
-  2: { intros.
-       revert vl. exact H3. }
-   intros; eapply derives_trans, fupd_intro.
-   apply andp_left2. apply andp_left2. apply derives_refl. }
-  intros. apply andp_left2. simpl; intros rho.
-  rewrite <- !prop_and, andp_comm.
-  eapply derives_trans; [apply fupd_andp_prop|].
-  change fupd with (ghost_seplog.fupd Ensembles.Full_set Ensembles.Full_set).
-  apply fupd_mono.
-  rewrite !prop_and.
-  rewrite !andp_assoc. repeat apply andp_derives; auto; apply prop_derives; intros; rewrite <- andp_assoc; auto.
-Qed.
-
-Lemma semax_adapt: forall {cs Espec} Delta c (P P': assert) (Q Q' : ret_assert)
-   (H: forall rho,  !!(typecheck_environ Delta rho) && (allp_fun_id Delta rho && P rho)
-                   |-- ((|={Ensembles.Full_set}=> (P' rho)) &&
-                        !!(forall rho, RA_normal Q' rho |-- |={Ensembles.Full_set}=> (RA_normal Q rho)) &&
-                        !!(forall rho, RA_break Q' rho |-- |={Ensembles.Full_set}=> (RA_break Q rho)) &&
-                        !!(forall rho, RA_continue Q' rho |-- |={Ensembles.Full_set}=> (RA_continue Q rho)) &&
-                        !!(forall vl rho, RA_return Q' vl rho |-- (RA_return Q vl rho))))
-   (SEM: @semax cs Espec Delta P' c Q'),
-   @semax cs Espec Delta P c Q.
-Proof.
-  intros. eapply semax_adapt_frame; eauto. intros. apply (exp_right (fun rho => emp)).
-  eapply derives_trans. apply H. clear H. rewrite !andp_assoc.
-  apply andp_right. apply prop_right. do 2 red; simpl; intros; trivial.
-  rewrite sepcon_emp.
-  repeat apply andp_derives; auto; apply prop_derives; intros; destruct Q'; simpl in *; rewrite sepcon_emp; apply andp_left2; auto.
+      iIntros "(_ & _ & $)".
+  + eapply AuxDefs.semax_mask_mono; intuition eauto.
+Qed.
+
+Lemma semax_adapt_frame {OK_spec: ext_spec OK_ty} {CS: compspecs} E Delta c (P P': assert) (Q Q' : ret_assert)
+   (H: (local (typecheck_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P)) ⊢
+                   (∃ F: assert, (⌜closed_wrt_modvars c F⌝ ∧ (|={E}=> (P' ∗ F) ∧
+                         ⌜local (tc_environ Delta) ∧ <affine> allp_fun_id Delta ∗ RA_normal (frame_ret_assert Q' F) ⊢ |={E}=> RA_normal Q⌝ ∧
+                         ⌜local (tc_environ Delta) ∧ <affine> allp_fun_id Delta ∗ RA_break (frame_ret_assert Q' F) ⊢ |={E}=> RA_break Q⌝ ∧
+                         ⌜local (tc_environ Delta) ∧ <affine> allp_fun_id Delta ∗ RA_continue (frame_ret_assert Q' F) ⊢ |={E}=> RA_continue Q⌝ ∧
+                         ⌜forall vl, local (tc_environ Delta) ∧ <affine> allp_fun_id Delta ∗ RA_return (frame_ret_assert Q' F) vl ⊢ RA_return Q vl⌝))))
+   (SEM: semax E Delta P' c Q'):
+   semax E Delta P c Q.
+Proof.
+  apply (semax_conseq _ _ _ _ _ E Delta (∃ F: assert, (⌜closed_wrt_modvars c F⌝ ∧ (|={E}=> (P' ∗ F) ∧
+                         ⌜(local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ RA_normal (frame_ret_assert Q' F)) ⊢ |={E}=> (RA_normal Q))⌝ ∧
+                         ⌜(local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ RA_break (frame_ret_assert Q' F)) ⊢ |={E}=> (RA_break Q))⌝ ∧
+                         ⌜(local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ RA_continue (frame_ret_assert Q' F)) ⊢ |={E}=> (RA_continue Q))⌝ ∧
+                         ⌜forall vl, ((local (tc_environ Delta)) ∧ (<affine> allp_fun_id Delta ∗ RA_return (frame_ret_assert Q' F) vl) ⊢ (RA_return Q vl))⌝)))
+    Q).
+  + rewrite H.
+    iIntros "(% & % & >(? & % & % & % & %))"; iExists F; iFrame; done.
+  + by iIntros "(_ & _ & $)".
+  + by iIntros "(_ & _ & $)".
+  + by iIntros "(_ & _ & $)".
+  + intros; by iIntros "(_ & _ & $)".
+  + apply semax_extract_exists'. intros F. clear H.
+    apply semax_extract_prop'. intros.
+    eapply semax_pre_fupd. 2:{ do 4 (apply semax_extract_prop; intros).
+      eapply semax_conseq. 6:{ apply semax_frame. exact H. apply SEM. }
+      2: { exact H0. }
+      2: { exact H1. }
+      2: { exact H2. }
+      2: { exact H3. }
+      rewrite bi.and_elim_r bi.affinely_elim_emp bi.emp_sep; apply fupd_intro. }
+    by iIntros "(? & >($ & % & % & % & %))".
+Qed.
+
+Lemma semax_adapt: forall {OK_spec: ext_spec OK_ty} {CS: compspecs} E Delta c (P P': assert) (Q Q' : ret_assert)
+   (H: (local (typecheck_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P)) ⊢
+      ((|={E}=> P' ∧
+                        ⌜RA_normal Q' ⊢ |={E}=> (RA_normal Q)⌝ ∧
+                        ⌜RA_break Q' ⊢ |={E}=> (RA_break Q)⌝ ∧
+                        ⌜RA_continue Q' ⊢ |={E}=> (RA_continue Q)⌝ ∧
+                        ⌜forall vl, RA_return Q' vl ⊢ (RA_return Q vl)⌝)))
+   (SEM: semax E Delta P' c Q'),
+   semax E Delta P c Q.
+Proof.
+  intros. eapply semax_adapt_frame; eauto.
+  rewrite H; iIntros "H"; iExists emp; iSplit.
+  { iPureIntro; intros ???; monPred.unseal; done. }
+  iDestruct "H" as ">($ & % & % & % & %)".
+  destruct Q'; simpl in *.
+  iPureIntro; split3; last split3; auto; intros; rewrite bi.sep_emp bi.and_elim_r bi.affinely_elim_emp bi.emp_sep //.
 Qed.
 
 Lemma typecheck_environ_globals_only t rho: typecheck_environ (xtype_tycontext t) (globals_only rho).
 Proof.
-  split3; red; simpl; intros. rewrite PTree.gempty in H. congruence.
-  split; intros. rewrite PTree.gempty in H. congruence. destruct H; inv H.
-  rewrite PTree.gempty in H. congruence.
+  split3; red; simpl; intros. setoid_rewrite Maps.PTree.gempty in H. congruence.
+  split; intros. setoid_rewrite Maps.PTree.gempty in H. congruence. destruct H; inv H.
+  setoid_rewrite Maps.PTree.gempty in H. congruence.
 Qed. 
 
 Lemma typecheck_environ_env_setglobals_only t rho x v: typecheck_environ (xtype_tycontext t) (env_set (globals_only rho) x v).
 Proof.
-  split3; red; simpl; intros. rewrite PTree.gempty in H. congruence.
-  split; intros. rewrite PTree.gempty in H. congruence. destruct H; inv H.
-  rewrite PTree.gempty in H. congruence.
+  split3; red; simpl; intros. setoid_rewrite Maps.PTree.gempty in H. congruence.
+  split; intros. setoid_rewrite Maps.PTree.gempty in H. congruence. destruct H; inv H.
+  setoid_rewrite Maps.PTree.gempty in H. congruence.
 Qed.
  
-(*This proof can now be cleanup up, by replacing
+(*This proof can now be cleaned up, by replacing
 use of tcvals in the argument to semax_adapt by hasType*)
-Lemma semax_body_funspec_sub {V G cs f i phi phi'} (SB: @semax_body V G cs f (i, phi))
+Lemma semax_body_funspec_sub {CS : compspecs} {V G f i phi phi'} (SB: semax_body V G f (i, phi))
   (Sub: funspec_sub phi phi')
   (LNR: list_norepet (map fst (fn_params f) ++ map fst (fn_temps f))):
-  @semax_body V G cs f (i, phi').
+  semax_body V G f (i, phi').
 Proof.
-destruct phi as [sig cc A P Q Pne Qne].
-destruct phi' as [sig' cc' A' P' Q' Pne' Qne'].
-destruct Sub as [[Tsigs CC] Sub]. subst cc' sig'. simpl in Sub.
+destruct phi as [sig cc A E P Q].
+destruct phi' as [sig' cc' A' E' P' Q'].
+destruct Sub as [(Tsigs & CC) Sub]. subst cc' sig'. simpl in Sub.
 destruct SB as [SB1 [SB2 SB3]].
 split3; trivial. intros.
-specialize (Sub ts x).
-eapply @semax_adapt
+specialize (Sub x).
+apply semax_adapt
  with
-  (Q':= frame_ret_assert (function_body_ret_assert (fn_return f) (Q' ts x))
+  (Q':= frame_ret_assert (function_body_ret_assert (fn_return f) (assert_of (Q' x)))
            (stackframe_of f))
-  (P' := EX vals:list val,
-    EX ts1:list Type, EX x1 : _,
-    EX FR: mpred, 
-    !!((tc_vals (map snd (fn_params f)) vals) /\
-       forall tau, @derives mpred Nveric
-       (@andp mpred Nveric
-          (@prop mpred Nveric
-             (seplog.tc_environ
-                (xtype_tycontext (@snd (list (prod ident type)) type (fn_funsig f))) tau))
-          (@sepcon mpred Nveric Sveric FR (Q ts1 x1 tau))) ((Q' ts x tau))) &&
-      (stackframe_of f * (fun tau => FR * P ts1 x1 (ge_of tau, vals)) &&
-                         (fun tau =>  !! (map (Map.get (te_of tau)) (map fst (fn_params f)) = map Some vals)))).
-  - intros rho. clear SB3. normalize. simpl. simpl in Sub.
-    apply andp_left2.
-    eapply derives_trans. apply sepcon_derives. apply close_precondition_e'. apply derives_refl.
-    normalize. destruct H0 as [Hvals VUNDEF].
-    specialize (semax_prog.typecheck_environ_eval_id LNR H); intros X.
-    specialize (Sub (ge_of rho,  map (fun i0 : ident => eval_id i0 rho) (map fst (fn_params f)))).
-    rewrite Hvals in X. apply semax_prog.map_Some_inv in X.  rewrite <- X in *.
-    eapply derives_trans. apply sepcon_derives. 2: apply derives_refl.
-    eapply derives_trans; [ clear Sub | apply Sub].
-    + simpl. apply andp_right; trivial.
-      apply prop_right. red. rewrite SB1 in *. subst vals.
-      clear - H VUNDEF LNR. destruct H as [TC1 [TC2 TC3]].
-        unfold fn_funsig. simpl. 
-        specialize (@tc_temp_environ_elim (fn_params f) (fn_temps f) _ LNR TC1).
-        clear -VUNDEF; intros TE.
-        forget (fn_params f) as params.
-        induction params; simpl; intros. constructor.
-        inv VUNDEF; constructor.
-        * clear IHparams H1. destruct (TE (fst a) (snd a)) as [w [W Tw]]; clear TE.
-           left; destruct a; trivial.
-           unfold eval_id. rewrite W; simpl.
-           intros. apply tc_val_has_type. apply (Tw H).
-        * apply IHparams; trivial.
-          intros. apply TE. right; trivial.
-    + change fupd with (ghost_seplog.fupd Ensembles.Full_set Ensembles.Full_set).
-      repeat (apply andp_right; [|apply prop_right; intros; try apply fupd_intro; auto]).
-      eapply derives_trans; [apply fupd_frame_r|]. apply fupd_mono.
-      apply (exp_right vals).
-      rewrite exp_sepcon1; apply exp_derives; intros ts1.
-      rewrite exp_sepcon1; apply exp_derives; intros x1.
-      rewrite exp_sepcon1; apply exp_derives; intros F.
-      normalize. rewrite (andp_comm (_ * _)), (prop_true_andp _ _ Hvals).
-      rewrite sepcon_comm. apply andp_right; trivial.
-      apply prop_right; split.
-      * subst vals; clear - Hvals VUNDEF H LNR.
-        destruct H as [TC _]. simpl in TC. red in TC.
-        forget (fn_params f) as params. induction params.
-        { constructor. }
-        inv LNR. inv VUNDEF. inv Hvals. constructor.
-        ++ clear IHparams. destruct (TC (fst a) (snd a)) as [u [U HU]]. apply PTree.gss.
-           unfold eval_id in *. rewrite U in *. simpl in *. apply HU; trivial.
-        ++ apply IHparams; clear IHparams; trivial.
-           intros. apply TC. simpl. rewrite PTree.gso; trivial.
-           intros ?; subst id. apply H1. apply (make_context_t_get H).
-      * intros. eapply derives_trans. 2: apply H0.
-        apply andp_derives; trivial. apply prop_derives.
-        intros; destruct tau; simpl in *. apply Map.ext.
-        clear - H1; intros y. destruct H1 as [_ [? _]]. simpl in H. red in H.
-        specialize (H y). destruct (Map.get ve y); trivial. 
-        destruct p. destruct (H t) as [_ ?].
-        exploit H0. exists b; trivial. rewrite PTree.gempty. congruence.
-  - clear Sub. normalize.
-    apply semax_extract_exists; intros vals.
-    apply semax_extract_exists; intros ts1.
-    apply semax_extract_exists; intros x1.
-    apply semax_extract_exists; intros FRM.
-    apply semax_extract_prop; intros [TCvals QPOST].
-    unfold fn_funsig in *. simpl in SB1, SB2.
-    apply (semax_frame (func_tycontext f V G nil)
-      (fun rho : environ =>
-            close_precondition (map fst (fn_params f)) (P ts1 x1) rho * 
-            stackframe_of f rho)
+  (P' :=
+    ∃ vals:list val,
+    ∃ x1 : dtfr A,
+    ∃ FR: _,
+    ⌜E x1 ⊆ E' x /\ forall rho' : environ,
+              ⌜tc_environ (xtype_tycontext (snd sig)) rho'⌝ ∧ (FR ∗ Q x1 rho') ⊢ (Q' x rho')⌝ ∧
+      ((stackframe_of f ∗ ⎡FR⎤ ∗ assert_of (fun tau => P x1 (ge_of tau, vals))) ∧
+            local (fun tau => map (Map.get (te_of tau)) (map fst (fn_params f)) = map Some vals /\ tc_vals (map snd (fn_params f)) vals))).
+ - split => rho. monPred.unseal; rewrite /bind_ret monPred_at_affinely.
+   iIntros "(%TC & #OM & (%vals & (%MAP & %VUNDEF) & HP') & M2)".
+   specialize (Sub (ge_of rho, vals)). iMod (Sub with "[$HP']") as "Sub". {
+     iPureIntro; split; trivial.
+     simpl.
+     rewrite SB1. simpl in TC. destruct TC as [TC1 [TC2 TC3]].
+     unfold fn_funsig. simpl. clear - TC1 MAP LNR VUNDEF.
+     specialize (@tc_temp_environ_elim (fn_params f) (fn_temps f) _ LNR TC1). simpl in TC1.  red in TC1. clear - MAP; intros TE.
+     forget (fn_params f) as params. generalize dependent vals.
+     induction params; simpl; intros.
+     + destruct vals; inv MAP. constructor.
+     + destruct vals; inv MAP. constructor.
+       * clear IHparams. intros. destruct (TE (fst a) (snd a)) as [w [W Tw]].
+         left; destruct a; trivial.
+         rewrite W in H0. inv H0.
+         apply tc_val_has_type; apply Tw; trivial.
+       * apply IHparams; simpl; trivial.
+         intros. apply TE. right; trivial. }
+   iIntros "!>"; iSplit; last iPureIntro.
+   clear Sub.
+   iDestruct "Sub" as (x1 FR1 HE1) "(A1 & %RetQ)".
+   iExists vals, x1, FR1.
+   iSplit; last iSplit.
+    + iPureIntro; split; first done; intros. rewrite -RetQ.
+      iIntros "(% & $)"; iPureIntro; split; last trivial.
+      simpl in H. clear - H. destruct H as [_ [Hve _]].
+      simpl in *. red in Hve. destruct rho'; simpl in *.
+      apply Map.ext; intros x. specialize (Hve x).
+      destruct (Map.get ve x); simpl.
+      * destruct p; simpl in *. destruct (Hve t) as [_ H]; clear Hve.
+        exploit H. exists b; trivial. rewrite Maps.PTree.gempty //.
+      * reflexivity.
+    + iFrame.
+    + iPureIntro; split; trivial. destruct TC as [TC1 _]. simpl in TC1. red in TC1.
+      clear - MAP VUNDEF TC1 LNR. forget (fn_params f) as params. forget (fn_temps f) as temps. forget (te_of rho) as tau.
+      clear f rho. generalize dependent vals. induction params; simpl; intros; destruct vals; inv MAP; trivial.
+      inv VUNDEF. inv LNR. destruct a; simpl in *.
+      assert (X: forall id ty, (make_tycontext_t params temps) !! id = Some ty ->
+                 exists v : val, Map.get tau id = Some v /\ tc_val' ty v).
+      { intros. apply TC1. simpl. setoid_rewrite Maps.PTree.gso; trivial.
+        apply make_context_t_get in H. intros ?; subst id. contradiction. }
+      split; [ clear IHparams | apply (IHparams H6 X _ H1 H4)].
+      destruct (TC1 i t) as [u [U TU]]; clear TC1. setoid_rewrite Maps.PTree.gss; trivial.
+      rewrite U in H0; inv H0. apply TU; trivial.
+    + split3; last split; intros; split => ?; monPred.unseal; auto.
+ - clear Sub.
+   apply semax_extract_exists; intros vals.
+   apply semax_extract_exists; intros x1.
+   apply semax_extract_exists; intros FRM.
+   apply semax_extract_prop; intros (HE & QPOST).
+   unfold fn_funsig in *. simpl in SB2; rewrite -> SB2 in *.
+   apply (semax_frame (E x1) (func_tycontext f V G nil)
+      (close_precondition (map fst (fn_params f)) (argsassert_of (P x1)) ∗
+         stackframe_of f)
       (fn_body f)
-      (frame_ret_assert (function_body_ret_assert (fn_return f) (Q ts1 x1)) (stackframe_of f))
-      (fun rho => FRM)) in SB3.
-    + eapply semax_pre_post_fupd.
+      (frame_ret_assert (function_body_ret_assert (fn_return f) (assert_of (Q x1))) (stackframe_of f))
+      ⎡FRM⎤) in SB3.
+    + eapply AuxDefs.semax_mask_mono; first done.
+      eapply semax_pre_post_fupd.
       6: apply SB3.
-      all: clear SB3; intros; simpl; try solve [normalize]; change fupd with (ghost_seplog.fupd Ensembles.Full_set Ensembles.Full_set).
-      * intros tau.
-        eapply derives_trans, fupd_intro.
-        unfold local, lift1; normalize.
-        destruct H as [TC1 _]. simpl in TC1. red in TC1.
-        rewrite <- sepcon_assoc, sepcon_comm, sepcon_assoc.
-        eapply derives_trans.
-        2:{ apply sepcon_derives; [ | apply derives_refl].
-            apply (close_argsassert f (P ts1 x1) tau vals LNR). }
-        apply sepcon_derives; trivial.
-        apply andp_right.
-        ++ apply prop_right. intuition.
-        ++ unfold argsassert2assert. 
-          specialize (semax_prog.typecheck_temp_environ_eval_id LNR TC1); intros X. 
-          rewrite X in H0.  apply semax_prog.map_Some_inv in H0. rewrite H0; trivial.
-      * clear - QPOST; intros tau.
-        destruct (fn_return f); normalize. simpl in QPOST. unfold local, tc_environ, lift1; normalize.
-        rewrite sepcon_comm, <- sepcon_assoc.
-        eapply derives_trans; [|apply fupd_frame_r].
-        apply sepcon_derives; trivial.
-        eapply derives_trans, fupd_intro. eapply derives_trans, QPOST.
-        apply andp_right. apply prop_right. red. apply typecheck_environ_globals_only.
-        apply derives_refl.
-      * clear - QPOST; intros tau. apply andp_left2. 
-        rewrite sepcon_comm, <- sepcon_assoc.
-        apply sepcon_derives; trivial.
-        destruct vl; simpl; normalize.
-        ++ eapply derives_trans; [ | apply QPOST]; apply andp_right; trivial.
-           apply prop_right. apply typecheck_environ_env_setglobals_only. apply derives_refl.
-        ++ destruct (fn_return f); normalize. 
-           eapply derives_trans; [ | apply QPOST]; apply andp_right; trivial.
-           apply prop_right. apply typecheck_environ_globals_only. apply derives_refl.
-    + clear. do 2 red; intros; trivial.
-Qed.
+      all: clear SB3; intros; simpl; try iIntros "(_ & ([] & ?) & _)".
+      * split => rho; monPred.unseal; iIntros "(%TC & (N1 & (? & N2)) & (%VALS & %TCVals)) !>"; iFrame.
+        iPureIntro; repeat (split; trivial).
+        apply (tc_vals_Vundef TCVals).
+      * split => rho; rewrite /bind_ret; monPred.unseal; destruct (fn_return f); try iIntros "(_ & ([] & _) & _)".
+        rewrite /= -QPOST; iIntros "(? & (? & ?) & ?)"; iFrame.
+        iPureIntro; split; last done.
+        apply tc_environ_xtype.
+      * split => rho; rewrite /bind_ret; monPred.unseal; iIntros "(% & (Q & $) & ?)".
+        destruct vl; simpl.
+        -- rewrite -QPOST.
+           iDestruct "Q" as "($ & $)"; iFrame; iPureIntro; split; last done.
+           apply tc_environ_xtype_env_set.
+        -- destruct (fn_return f); try iDestruct "Q" as "[]".
+           rewrite /= -QPOST; iFrame; iPureIntro; split; last done.
+           apply tc_environ_xtype.
+    + do 2 red; intros; monPred.unseal; trivial.
+Qed.
+
+End mpred.
 
 End DeepEmbeddedMinimumSeparationLogic.
 
@@ -2659,204 +2347,188 @@ Module CSHL_MinimumLogic := DeepEmbeddedMinimumSeparationLogic.
 
 Definition semax_set := @DeepEmbeddedMinimumSeparationLogic.SetB.semax_set_backward.
 
-Arguments semax {_} {_} _ _ _ _.
+Arguments semax {_} {_} {_} {_} {_}.
+
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} {CS: compspecs}.
 
 Lemma semax_loop_nocontinue:
-  forall {CS: compspecs} {Espec: OracleKind},
- forall Delta P body incr R,
- @semax CS Espec Delta P (Ssequence body incr) (loop_nocontinue_ret_assert P R) ->
- @semax CS Espec Delta P (Sloop body incr) R.
+ forall E Delta P body incr R,
+ semax E Delta P (Ssequence body incr) (loop_nocontinue_ret_assert P R) ->
+ semax E Delta P (Sloop body incr) R.
 Proof.
   intros.
   apply semax_seq_inv in H.
   destruct H as [Q [? ?]].
-  eapply (AuxDefs.semax_loop _ P Q).
+  eapply (AuxDefs.semax_loop _ _ P Q).
   + clear - H.
     unfold overridePost, loop_nocontinue_ret_assert, loop1_ret_assert in *.
-    eapply semax_post; [| | | | exact H].
-    - apply andp_left2.
-      destruct R.
-      apply derives_refl.
-    - apply andp_left2.
+    eapply semax_post, H.
+    - rewrite bi.and_elim_r.
+      destruct R; done.
+    - rewrite bi.and_elim_r.
+      destruct R; done.
+    - rewrite bi.and_elim_r.
       destruct R.
-      apply derives_refl.
-    - apply andp_left2.
-      destruct R.
-      apply FF_left.
+      apply False_left.
     - intro.
-      apply andp_left2.
-      destruct R.
-      apply derives_refl.
+      rewrite bi.and_elim_r.
+      destruct R; done.
   + clear - H0.
     unfold overridePost, loop_nocontinue_ret_assert, loop2_ret_assert in *.
     auto.
 Qed.
 
 Lemma semax_if_seq:
- forall {CS: compspecs} {Espec: OracleKind} Delta P e c1 c2 c Q,
- semax Delta P (Sifthenelse e (Ssequence c1 c) (Ssequence c2 c)) Q ->
- semax Delta P (Ssequence (Sifthenelse e c1 c2) c) Q.
+ forall E Delta P e c1 c2 c Q,
+ semax E Delta P (Sifthenelse e (Ssequence c1 c) (Ssequence c2 c)) Q ->
+ semax E Delta P (Ssequence (Sifthenelse e c1 c2) c) Q.
 Proof.
   intros.
   apply semax_ifthenelse_inv in H.
-  eapply semax_conseq; [exact H | intros; try apply derives_full_refl .. |].
-  { apply andp_left2, andp_left2, derives_refl. }
-  rewrite later_andp, (later_exp' _ (fun _ => emp)).
-  rewrite !exp_andp2.
-  apply semax_extract_exists.
-  intros P'.
-  rewrite later_andp.
-  rewrite andp_comm, andp_assoc, andp_comm, !andp_assoc.
-  apply semax_extract_later_prop; intros [? ?].
-  rewrite andp_comm.
-  apply semax_seq_inv in H0.
-  apply semax_seq_inv in H1.
-  destruct H0 as [Q1 [? ?]], H1 as [Q2 [? ?]].
-  rewrite andp_assoc, <- later_andp.
-  apply AuxDefs.semax_seq with (orp Q1 Q2); [apply AuxDefs.semax_ifthenelse |].
-  + eapply semax_post; [| | | | exact H0].
-    - destruct Q; apply andp_left2, orp_right1, derives_refl.
-    - destruct Q; apply andp_left2, derives_refl.
-    - destruct Q; apply andp_left2, derives_refl.
-    - intro; destruct Q; apply andp_left2, derives_refl.
-  + eapply semax_post; [| | | | exact H1].
-    - destruct Q; apply andp_left2, orp_right2, derives_refl.
-    - destruct Q; apply andp_left2, derives_refl.
-    - destruct Q; apply andp_left2, derives_refl.
-    - intro; destruct Q; apply andp_left2, derives_refl.
-  + rewrite orp_is_exp.
-    apply semax_extract_exists.
-    intro.
-    destruct x; auto.
+  eapply (semax_conseq _ _ (∃ P', ▷ (⌜semax E Delta (P' ∧ local (liftx (typed_true (typeof e)) (eval_expr e)))%I (Ssequence c1 c) Q
+               ∧ semax E Delta (P' ∧ local (liftx (typed_false (typeof e)) (eval_expr e)))%I (Ssequence c2 c) Q⌝) ∧ 
+           ⌜bool_type (typeof e) = true⌝ ∧ ▷ (tc_expr Delta (Eunop Onotbool e (Tint I32 Signed noattr)) ∧ P')
+            )); [| intros; try apply derives_full_refl .. |].
+  { rewrite H bi.and_exist_l bi.later_exist bi.and_exist_l.
+    iIntros ">(%P' & H) !>"; iExists P'.
+    iDestruct "H" as "($ & H)"; rewrite -bi.later_and; iNext.
+    iSplit; [iDestruct "H" as "(_ & $ & _)" | iSplit; [iDestruct "H" as "($ & _)" | iDestruct "H" as "(_ & _ & $)"]]. }
+  { iIntros "(_ & _ & $)". }
+  apply semax_extract_exists; intros P'.
+  apply semax_extract_later_prop; intros [Ht Hf].
+  apply semax_seq_inv in Ht.
+  apply semax_seq_inv in Hf.
+  destruct Ht as [Q1 [Ht ?]], Hf as [Q2 [Hf ?]].
+  apply AuxDefs.semax_seq with (Q1 ∨ Q2); [apply AuxDefs.semax_ifthenelse |].
+  + eapply semax_post, Ht.
+    - destruct Q; rewrite bi.and_elim_r; apply bi.or_intro_l.
+    - destruct Q; rewrite bi.and_elim_r //.
+    - destruct Q; rewrite bi.and_elim_r //.
+    - intro; destruct Q; rewrite bi.and_elim_r //.
+  + eapply semax_post, Hf.
+    - destruct Q; rewrite bi.and_elim_r; apply bi.or_intro_r.
+    - destruct Q; rewrite bi.and_elim_r //.
+    - destruct Q; rewrite bi.and_elim_r //.
+    - intro; destruct Q; rewrite bi.and_elim_r //.
+  + apply semax_orp; auto.
 Qed.
 
 Lemma semax_loop_unroll1:
-  forall {CS: compspecs} {Espec: OracleKind} Delta P P' Q body incr R,
-  @semax CS Espec Delta P body (loop1_ret_assert P' R) ->
-  @semax CS Espec Delta P' incr (loop2_ret_assert Q R) ->
-  @semax CS Espec Delta Q (Sloop body incr) R ->
-  @semax CS Espec Delta P (Sloop body incr) R.
+  forall E Delta P P' Q body incr R,
+  semax E Delta P body (loop1_ret_assert P' R) ->
+  semax E Delta P' incr (loop2_ret_assert Q R) ->
+  semax E Delta Q (Sloop body incr) R ->
+  semax E Delta P (Sloop body incr) R.
 Proof.
   intros.
   apply semax_loop_inv in H1.
-  apply semax_pre with (P || Q ||
-                  (EX Q : environ -> mpred,
-                    (EX Q' : environ -> mpred,
-                     !! (semax Delta Q body (loop1_ret_assert Q' R) /\
-                         semax Delta Q' incr (loop2_ret_assert Q R)) && Q))).
-  { apply andp_left2, orp_right1, orp_right1, derives_refl. }
-  apply AuxDefs.semax_loop with (P' ||
-                  (EX Q : environ -> mpred,
-                    (EX Q' : environ -> mpred,
-                     !! (semax Delta Q body (loop1_ret_assert Q' R) /\
-                         semax Delta Q' incr (loop2_ret_assert Q R)) && Q'))).
-  + apply semax_orp; [apply semax_orp |].
-    - eapply semax_post; [.. | exact H].
+  apply semax_pre with (P ∨ Q ∨
+                  (∃ Q : assert,
+                    (∃ Q' : assert,
+                     ⌜semax E Delta Q body (loop1_ret_assert Q' R) /\
+                         semax E Delta Q' incr (loop2_ret_assert Q R)⌝ ∧ Q))).
+  { rewrite bi.and_elim_r; apply bi.or_intro_l. }
+  apply AuxDefs.semax_loop with (P' ∨
+                  (∃ Q : assert,
+                    (∃ Q' : assert,
+                     ⌜semax E Delta Q body (loop1_ret_assert Q' R) /\
+                         semax E Delta Q' incr (loop2_ret_assert Q R)⌝ ∧ Q'))).
+  + apply semax_orp; [| apply semax_orp].
+    - eapply semax_post, H.
       * unfold loop1_ret_assert; destruct R.
-        apply andp_left2, orp_right1, derives_refl.
+        rewrite bi.and_elim_r; apply bi.or_intro_l.
       * unfold loop1_ret_assert; destruct R.
-        apply andp_left2, derives_refl.
+        rewrite bi.and_elim_r //.
       * unfold loop1_ret_assert; destruct R.
-        apply andp_left2, orp_right1, derives_refl.
+        rewrite bi.and_elim_r; apply bi.or_intro_l .
       * intros.
         unfold loop1_ret_assert; destruct R.
-        apply andp_left2, derives_refl.
+        rewrite bi.and_elim_r //.
     - eapply semax_conseq; [exact H1 | intros; try apply derives_full_refl .. |].
-      { apply andp_left2, andp_left2, derives_refl. }
+      { iIntros "(_ & _ & $)". }
       apply semax_extract_exists; intros Q'.
       apply semax_extract_exists; intros Q''.
       apply semax_extract_prop; intros [?H ?H].
       apply semax_post with (loop1_ret_assert Q'' R); auto.
+      * unfold loop1_ret_assert; destruct R; simpl in *.
+        iIntros "(_ & ?)"; iRight; iExists Q', Q''; iFrame; auto.
       * unfold loop1_ret_assert; destruct R.
-        apply andp_left2, orp_right2, (exp_right Q'), (exp_right Q'').
-        apply andp_right; [apply prop_right; auto | apply derives_refl].
+        rewrite bi.and_elim_r //.
       * unfold loop1_ret_assert; destruct R.
-        apply andp_left2, derives_refl.
-      * unfold loop1_ret_assert; destruct R.
-        apply andp_left2, orp_right2, (exp_right Q'), (exp_right Q'').
-        apply andp_right; [apply prop_right; auto | apply derives_refl].
+        iIntros "(_ & ?)"; iRight; iExists Q', Q''; iFrame; auto.
       * intros.
         unfold loop1_ret_assert; destruct R.
-        apply andp_left2, derives_refl.
+        rewrite bi.and_elim_r //.
     - apply semax_extract_exists; intros Q'.
       apply semax_extract_exists; intros Q''.
       apply semax_extract_prop; intros [?H ?H].
       apply semax_post with (loop1_ret_assert Q'' R); auto.
       * unfold loop1_ret_assert; destruct R.
-        apply andp_left2, orp_right2, (exp_right Q'), (exp_right Q'').
-        apply andp_right; [apply prop_right; auto | apply derives_refl].
+        iIntros "(_ & ?)"; iRight; iExists Q', Q''; iFrame; auto.
       * unfold loop1_ret_assert; destruct R.
-        apply andp_left2, derives_refl.
+        rewrite bi.and_elim_r //.
       * unfold loop1_ret_assert; destruct R.
-        apply andp_left2, orp_right2, (exp_right Q'), (exp_right Q'').
-        apply andp_right; [apply prop_right; auto | apply derives_refl].
+        iIntros "(_ & ?)"; iRight; iExists Q', Q''; iFrame; auto.
       * intros.
         unfold loop1_ret_assert; destruct R.
-        apply andp_left2, derives_refl.
+        rewrite bi.and_elim_r //.
   + apply semax_orp.
     - apply semax_post with (loop2_ret_assert Q R); auto.
+      * unfold loop2_ret_assert; destruct R; simpl.
+        iIntros "(_ & ?)"; iRight; iLeft; done.
       * unfold loop2_ret_assert; destruct R.
-        apply andp_left2, orp_right1, orp_right2, derives_refl.
-      * unfold loop2_ret_assert; destruct R.
-        apply andp_left2, derives_refl.
+        rewrite bi.and_elim_r //.
       * unfold loop2_ret_assert; destruct R.
-        apply andp_left2, derives_refl.
+        rewrite bi.and_elim_r //.
       * intros.
         unfold loop1_ret_assert; destruct R.
-        apply andp_left2, derives_refl.
+        rewrite bi.and_elim_r //.
     - apply semax_extract_exists; intros Q'.
       apply semax_extract_exists; intros Q''.
       apply semax_extract_prop; intros [?H ?H].
       apply semax_post with (loop2_ret_assert Q' R); auto.
+      * unfold loop1_ret_assert; destruct R; simpl.
+        iIntros "(_ & ?)"; iRight; iRight; iExists Q', Q''; iFrame; auto.
       * unfold loop1_ret_assert; destruct R.
-        apply andp_left2, orp_right2, (exp_right Q'), (exp_right Q'').
-        apply andp_right; [apply prop_right; auto | apply derives_refl].
-      * unfold loop1_ret_assert; destruct R.
-        apply andp_left2, derives_refl.
+        rewrite bi.and_elim_r //.
       * unfold loop1_ret_assert; destruct R.
-        apply andp_left2, derives_refl.
+        rewrite bi.and_elim_r //.
       * intros.
         unfold loop1_ret_assert; destruct R.
-        apply andp_left2, derives_refl.
+        rewrite bi.and_elim_r //.
 Qed.
 
 Theorem seq_assoc:
-  forall {CS: compspecs} {Espec: OracleKind},
-   forall Delta P s1 s2 s3 R,
-        @semax CS Espec Delta P (Ssequence s1 (Ssequence s2 s3)) R <->
-        @semax CS Espec Delta P (Ssequence (Ssequence s1 s2) s3) R.
+   forall E Delta P s1 s2 s3 R,
+        semax E Delta P (Ssequence s1 (Ssequence s2 s3)) R <->
+        semax E Delta P (Ssequence (Ssequence s1 s2) s3) R.
 Proof.
   intros.
   split; intros.
-  + apply semax_seq_inv in H.
-    destruct H as [? [? ?]].
-    apply semax_seq_inv in H0.
-    destruct H0 as [? [? ?]].
+  + apply semax_seq_inv in H as (? & ? & (? & ? & ?)%semax_seq_inv).
     eapply AuxDefs.semax_seq; eauto.
     eapply AuxDefs.semax_seq; eauto.
     destruct R; auto.
-  + apply semax_seq_inv in H.
-    destruct H as [? [? ?]].
-    apply semax_seq_inv in H.
-    destruct H as [? [? ?]].
-    eapply AuxDefs.semax_seq with x0; [destruct R; exact H |].
+  + apply semax_seq_inv in H as (? & (Q & ? & ?)%semax_seq_inv & ?).
+    eapply AuxDefs.semax_seq with Q; [destruct R; exact H |].
     eapply AuxDefs.semax_seq; eauto.
 Qed.
 
 Theorem semax_seq_skip:
-  forall {CS: compspecs} {Espec: OracleKind},
-  forall Delta P s Q,
-    @semax CS Espec Delta P s Q <-> @semax CS Espec Delta P (Ssequence s Sskip) Q.
+  forall E Delta P s Q,
+    semax E Delta P s Q <-> semax E Delta P (Ssequence s Sskip) Q.
 Proof.
   intros.
   split; intros.
   + apply AuxDefs.semax_seq with (RA_normal Q).
     - destruct Q; auto.
-    - eapply semax_post; [.. | apply AuxDefs.semax_skip].
+    - eapply semax_post, AuxDefs.semax_skip.
       * apply ENTAIL_refl.
-      * apply andp_left2, FF_left.
-      * apply andp_left2, FF_left.
-      * intros; apply andp_left2, FF_left.
+      * rewrite bi.and_elim_r; apply False_left.
+      * rewrite bi.and_elim_r; apply False_left.
+      * intros; rewrite bi.and_elim_r; apply False_left.
   + apply semax_seq_inv in H.
     destruct H as [? [? ?]].
     apply semax_skip_inv in H0.
@@ -2864,46 +2536,40 @@ Proof.
     - destruct Q; auto.
     - destruct Q; apply derives_full_refl.
     - destruct Q; apply derives_full_refl.
-    - intros; destruct Q; apply andp_left2, andp_left2, derives_refl.
+    - intros; destruct Q; iIntros "(_ & _ & $)".
 Qed.
 
 Theorem semax_skip_seq:
-  forall {CS: compspecs} {Espec: OracleKind},
-  forall Delta P s Q,
-    @semax CS Espec Delta P s Q <-> @semax CS Espec Delta P (Ssequence Sskip s) Q.
+  forall E Delta P s Q,
+    semax E Delta P s Q <-> semax E Delta P (Ssequence Sskip s) Q.
 Proof.
   intros.
   split; intros.
   + apply AuxDefs.semax_seq with P; auto.
-    eapply semax_post; [.. | apply AuxDefs.semax_skip].
+    eapply semax_post, AuxDefs.semax_skip.
     - destruct Q; apply ENTAIL_refl.
-    - apply andp_left2, FF_left.
-    - apply andp_left2, FF_left.
-    - intros; apply andp_left2, FF_left.
+    - rewrite bi.and_elim_r; apply False_left.
+    - rewrite bi.and_elim_r; apply False_left.
+    - intros; rewrite bi.and_elim_r; apply False_left.
   + apply semax_seq_inv in H.
     destruct H as [? [? ?]].
     apply semax_skip_inv in H.
     eapply semax_conseq; [| intros; try apply derives_full_refl .. | exact H0].
     destruct Q; auto.
-    { apply andp_left2, andp_left2, derives_refl. }
+    { iIntros "(_ & _ & $)". }
 Qed.
 
 Theorem semax_seq_Slabel:
-   forall {CS:compspecs} {Espec: OracleKind},
-     forall Delta (P:environ -> mpred) (c1 c2:statement) (Q:ret_assert) l,
-   @semax CS Espec Delta P (Ssequence (Slabel l c1) c2) Q <-> 
-   @semax CS Espec Delta P (Slabel l (Ssequence c1 c2)) Q.
+     forall E Delta (P:assert) (c1 c2:statement) (Q:ret_assert) l,
+   semax E Delta P (Ssequence (Slabel l c1) c2) Q <-> 
+   semax E Delta P (Slabel l (Ssequence c1 c2)) Q.
 Proof.
   intros.
   split; intros.
-  + apply semax_seq_inv in H.
-    destruct H as [? [? ?]].
-    apply semax_Slabel_inv in H.
+  + apply semax_seq_inv in H as (? & ?%semax_Slabel_inv & ?).
     apply AuxDefs.semax_label.
     eapply AuxDefs.semax_seq; eauto.
-  + apply semax_Slabel_inv in H.
-    apply semax_seq_inv in H.
-    destruct H as [? [? ?]].
+  + apply semax_Slabel_inv, semax_seq_inv in H as (? & ? & ?).
     eapply AuxDefs.semax_seq; eauto.
     apply AuxDefs.semax_label; auto.
 Qed.
@@ -2917,8 +2583,8 @@ Fixpoint fold_Ssequence lc :=
 
 Definition non_Sseq c :=
   match c with
-  | Ssequence _ _ => False
-  | _ => True
+  | Ssequence _ _ => False%type
+  | _ => True%type
   end.
 
 Inductive unfold_Sseq_rel: statement -> list statement -> Prop :=
@@ -2939,47 +2605,41 @@ Proof.
   + auto.
 Qed.
 
-Definition semax_equiv {CS: compspecs} {Espec: OracleKind} c1 c2: Prop := forall Delta P Q, semax Delta P c1 Q <-> semax Delta P c2 Q.
+Definition semax_equiv c1 c2: Prop := forall E Delta P Q, semax E Delta P c1 Q <-> semax E Delta P c2 Q.
 
-Lemma semax_equiv_seq: forall {CS: compspecs} {Espec: OracleKind} c1 c2 c3 c4,
+Lemma semax_equiv_seq: forall c1 c2 c3 c4,
   semax_equiv c1 c2 ->
   semax_equiv c3 c4 ->
   semax_equiv (Ssequence c1 c3) (Ssequence c2 c4).
 Proof.
   intros.
-  hnf; intros; split; intros.
-  + apply semax_seq_inv in H1.
-    destruct H1 as [? [? ?]].
-    rewrite (H Delta P _) in H1.
-    rewrite (H0 Delta _ _) in H2.
+  hnf; intros; split; intros Hs.
+  + apply semax_seq_inv in Hs as (? & H1 & H2).
+    rewrite H in H1.
+    rewrite H0 in H2.
     eapply AuxDefs.semax_seq; eauto.
-  + apply semax_seq_inv in H1.
-    destruct H1 as [? [? ?]].
-    rewrite <- (H Delta P _) in H1.
-    rewrite <- (H0 Delta _ _) in H2.
+  + apply semax_seq_inv in Hs as (? & H1 & H2).
+    rewrite <- (H E Delta P _) in H1.
+    rewrite <- (H0 E Delta _ _) in H2.
     eapply AuxDefs.semax_seq; eauto.
 Qed.
 
-Lemma semax_equiv_sym: forall {CS: compspecs} {Espec: OracleKind} c1 c2, semax_equiv c1 c2 -> semax_equiv c2 c1.
+Lemma semax_equiv_sym: forall c1 c2, semax_equiv c1 c2 -> semax_equiv c2 c1.
 Proof.
   intros.
   hnf in H |- *.
-  intros.
-  specialize (H Delta P Q).
-  tauto.
+  intros; symmetry; auto.
 Qed.
 
-Lemma semax_equiv_trans: forall {CS: compspecs} {Espec: OracleKind} c1 c2 c3, semax_equiv c1 c2 -> semax_equiv c2 c3 -> semax_equiv c1 c3.
+Lemma semax_equiv_trans: forall c1 c2 c3, semax_equiv c1 c2 -> semax_equiv c2 c3 -> semax_equiv c1 c3.
 Proof.
   intros.
   hnf in H, H0 |- *.
   intros.
-  specialize (H Delta P Q).
-  specialize (H0 Delta P Q).
-  tauto.
+  rewrite H //.
 Qed.
   
-Lemma unfold_Sseq_rel_sound: forall {CS: compspecs} {Espec: OracleKind} c lc,
+Lemma unfold_Sseq_rel_sound: forall c lc,
   unfold_Sseq_rel c lc -> semax_equiv (fold_Ssequence lc) c.
 Proof.
   intros.
@@ -3014,16 +2674,16 @@ Proof.
   apply IHc2.
 Qed.
 
-Lemma unfold_Ssequence_sound: forall {CS: compspecs} {Espec: OracleKind} c, semax_equiv (fold_Ssequence (unfold_Ssequence c)) c.
+Lemma unfold_Ssequence_sound: forall c, semax_equiv (fold_Ssequence (unfold_Ssequence c)) c.
 Proof.
   intros.
   apply unfold_Sseq_rel_sound.
   apply unfold_Ssequence_unfold_Sseq_rel.
 Qed.
 
-Lemma semax_unfold_Ssequence': forall {CS: compspecs} {Espec: OracleKind} c1 c2,
+Lemma semax_unfold_Ssequence': forall c1 c2,
   unfold_Ssequence c1 = unfold_Ssequence c2 ->
-  (forall P Q Delta, semax Delta P c1 Q <-> semax Delta P c2 Q).
+  (forall P Q E Delta, semax E Delta P c1 Q <-> semax E Delta P c2 Q).
 Proof.
   intros.
   eapply semax_equiv_trans.
@@ -3033,56 +2693,36 @@ Proof.
     apply unfold_Ssequence_sound.
 Qed.
 
-Lemma semax_unfold_Ssequence: forall {CS: compspecs} {Espec: OracleKind} c1 c2,
+Lemma semax_unfold_Ssequence: forall c1 c2,
   unfold_Ssequence c1 = unfold_Ssequence c2 ->
-  (forall P Q Delta, @semax CS Espec Delta P c1 Q -> @semax CS Espec Delta P c2 Q).
+  (forall P Q E Delta, semax E Delta P c1 Q -> semax E Delta P c2 Q).
 Proof.
   intros.
   pose proof semax_unfold_Ssequence' _ _ H.
   clear - H0 H1.
-  firstorder.
+  rewrite -H1 //.
 Qed.
 
 Lemma semax_fun_id:
-  forall {CS: compspecs} {Espec: OracleKind},
-      forall id f Delta P Q c,
-    (var_types Delta) ! id = None ->
-    (glob_specs Delta) ! id = Some f ->
-    (glob_types Delta) ! id = Some (type_of_funspec f) ->
-    @semax CS Espec Delta (P && `(func_ptr f) (eval_var id (type_of_funspec f)))
+      forall id f E Delta P Q c,
+    (var_types Delta) !! id = None ->
+    (glob_specs Delta) !! id = Some f ->
+    (glob_types Delta) !! id = Some (type_of_funspec f) ->
+    semax E Delta (P ∗ assert_of (`(func_ptr f) (eval_var id (type_of_funspec f))))
                   c Q ->
-    @semax CS Espec Delta P c Q.
+    semax E Delta P c Q.
 Proof.
   intros.
-  eapply semax_conseq; [| intros; try apply derives_full_refl .. | apply H2].
+  eapply semax_conseq; [| intros; by iIntros "(_ & _ & $)" .. | apply H2].
   reduceR.
-  apply andp_right; [solve_andp |].
-  rewrite andp_comm.
-  rewrite imp_andp_adjoint.
-  rewrite imp_andp_adjoint.
-  intros rho.
-  apply (allp_left _ id).
-  apply (allp_left _ f).
-  rewrite prop_imp by auto.
-  apply exp_left; intros b.
-  unfold local, lift1; unfold_lift; simpl. normalize.
-  rewrite <- imp_andp_adjoint.
-  rewrite <- imp_andp_adjoint. normalize. 
-  unfold derives. constructor.
-  apply predicates_hered.exp_right with (x:=b) (p := (func_ptr f (Vptr b Ptrofs.zero) && P rho)). eapply predicates_hered.prop_andp_right.
-  - unfold eval_var. rewrite H3.
-    destruct H4 as [_ [? _]].
-    specialize (H4 id).
-    rewrite H in H4.
-    destruct (Map.get (ve_of rho) id) as [[? ?] |]; [exfalso | auto].
-    specialize (H4 t).
-    destruct H4 as [_ ?].
-    specialize (H4 ltac:(eexists; eauto)). congruence.
-  - unfold func_ptr, seplog.func_ptr.
-    apply predicates_hered.andp_left1. 
-    apply predicates_hered.exp_left; intros bb.
-    apply normalize.derives_extract_prop; intros X; inv X. apply predicates_hered.derives_refl.
-  - apply andp_left2, andp_left2, derives_refl.
+  split => rho; monPred.unseal.
+  rewrite monPred_at_affinely /allp_fun_id /=; iIntros "(%TC & H & $)".
+  unfold_lift; rewrite /eval_var /=.
+  iDestruct ("H" with "[%]") as "(% & -> & ?)"; first done.
+  destruct TC as (? & Hve & ?).
+  specialize (Hve id); rewrite H in Hve.
+  destruct (Map.get (ve_of rho) id) as [(?, ?)|]; last done.
+  edestruct Hve as [_ Hid]; spec Hid; eauto; done.
 Qed.
 
 Lemma nocontinue_ls_spec: forall sl, nocontinue_ls sl = true -> nocontinue (seq_of_labeled_statement sl) = true.
@@ -3127,12 +2767,12 @@ Proof.
 Qed.
 
 Lemma semax_nocontinue_inv:
-  forall CS Espec Delta Pre s Post Post',
+  forall E Delta Pre s Post Post',
     nocontinue s = true ->
     RA_normal Post = RA_normal Post' ->
     RA_break Post = RA_break Post' ->
     RA_return Post = RA_return Post' ->
-    @semax CS Espec Delta Pre s Post -> @semax CS Espec Delta Pre s Post'.
+    semax E Delta Pre s Post -> semax E Delta Pre s Post'.
 Proof.
   intros.
   revert Post' H0 H1 H2.
@@ -3164,76 +2804,64 @@ Proof.
     specialize (H2 H).
     apply H2; destruct Post', R; simpl; auto.
   + eapply semax_post with (normal_ret_assert R);
-      [intros; apply andp_left2; try apply FF_left; rewrite H0; auto .. |].
+      [intros; rewrite bi.and_elim_r; try apply False_left; rewrite H0; auto .. |].
     apply AuxDefs.semax_call_backward.
   + rewrite H2.
     apply AuxDefs.semax_return.
   + eapply semax_post with (normal_ret_assert P);
-      [intros; apply andp_left2; try apply FF_left; rewrite H0; auto .. |].
+      [intros; rewrite bi.and_elim_r; try apply False_left; rewrite H0; auto .. |].
     apply AuxDefs.semax_set_ptr_compare_load_cast_load_backward.
   + eapply semax_post with (normal_ret_assert P);
-      [intros; apply andp_left2; try apply FF_left; rewrite H0; auto .. |].
+      [intros; rewrite bi.and_elim_r; try apply False_left; rewrite H0; auto .. |].
     apply AuxDefs.semax_store_store_union_hack_backward.
   + eapply semax_post with (normal_ret_assert P);
-      [intros; apply andp_left2; try apply FF_left; rewrite H0; auto .. |].
+      [intros; rewrite bi.and_elim_r; try apply False_left; rewrite H0; auto .. |].
     apply AuxDefs.semax_skip.
   + apply AuxDefs.semax_builtin.
   + specialize (IHsemax H _ H0 H1 H2).
     apply AuxDefs.semax_label; auto.
   + apply AuxDefs.semax_goto.
-  + apply (AuxDefs.semax_conseq _ P' (Build_ret_assert (RA_normal R') (RA_break R') (RA_continue Post') (RA_return R'))).
+  + apply (AuxDefs.semax_conseq _ _ P' (Build_ret_assert (RA_normal R') (RA_break R') (RA_continue Post') (RA_return R'))).
     - exact H0.
     - rewrite <- H6; exact H1.
     - rewrite <- H7; exact H2.
     - apply derives_full_refl.
     - intros. rewrite <- H8; exact (H4 vl).
     - apply IHsemax; auto.
+  + eapply AuxDefs.semax_mask_mono, IHsemax; auto.
 Qed.
 
 Lemma semax_loop_nocontinue1:
-  forall CS Espec Delta Pre s1 s2 s3 Post,
-  nocontinue s1 = true ->
-  nocontinue s2 = true ->
-  nocontinue s3 = true ->
-   @semax CS Espec Delta Pre (Sloop (Ssequence s1 (Ssequence s2 s3)) Sskip) Post ->
-    @semax CS Espec Delta Pre (Sloop (Ssequence s1 s2) s3) Post.
+  forall E Delta Pre s1 s2 s3 Post
+  (Hs1 : nocontinue s1 = true)
+  (Hs2 : nocontinue s2 = true)
+  (Hs3 : nocontinue s3 = true)
+  (H1 : semax E Delta Pre (Sloop (Ssequence s1 (Ssequence s2 s3)) Sskip) Post),
+  semax E Delta Pre (Sloop (Ssequence s1 s2) s3) Post.
 Proof.
-intros.
- rename H1 into Hs3. rename H2 into H1.
-apply semax_loop_inv in H1.
-eapply AuxDefs.semax_conseq.
-apply H1.
-instantiate (1:=Post).
-1,2,3,4: intros; do 2 apply andp_left2; (apply fupd_intro || apply derives_refl).
-apply semax_extract_exists; intro Q.
-apply semax_extract_exists; intro Q'.
-apply semax_extract_prop; intros [? ?].
-apply seq_assoc in H2.
-apply semax_seq_inv in H2.
-destruct H2 as [Q3 [? ?]].
-apply AuxDefs.semax_loop with Q3.
-*
-assert (nocontinue (Ssequence s1 s2) = true).
-simpl; rewrite H,H0; auto.
-forget (Ssequence s1 s2) as s.
-clear - H2 H5.
-revert H2.
-apply semax_nocontinue_inv; auto; destruct Post; try reflexivity.
-*
-clear - H4 H3 Hs3.
-apply semax_seq_skip.
-econstructor; eauto.
-clear - H4 Hs3.
-revert H4; apply semax_nocontinue_inv; auto; destruct Post; try reflexivity.
+  intros.
+  apply semax_loop_inv in H1.
+  eapply semax_conseq; [apply H1 | intros; by iIntros "(_ & _ & $)" .. |].
+  apply semax_extract_exists; intro Q.
+  apply semax_extract_exists; intro Q'.
+  apply semax_extract_prop; intros [H2 ?].
+  apply seq_assoc, semax_seq_inv in H2 as [Q3 [Hs' Hs3']].
+  apply AuxDefs.semax_loop with Q3.
+  * assert (nocontinue (Ssequence s1 s2) = true).
+    { rewrite /= Hs1 Hs2 //. }
+    revert Hs'; apply semax_nocontinue_inv; auto; destruct Post; try reflexivity.
+  * apply semax_seq_skip.
+    econstructor; eauto.
+    revert Hs3'; apply semax_nocontinue_inv; auto; destruct Post; try reflexivity.
 Qed.
 
 Lemma semax_convert_for_while':
- forall CS Espec Delta Pre s1 e2 s3 s4 s5 Post,
+ forall E Delta Pre s1 e2 s3 s4 s5 Post,
   nocontinue s4 = true ->
   nocontinue s3 = true -> 
-  @semax CS Espec Delta Pre 
+  semax E Delta Pre 
     (Ssequence s1 (Ssequence (Swhile e2 (Ssequence s4 s3)) s5)) Post ->
-  @semax CS Espec Delta Pre (Ssequence (Sfor s1 e2 s4 s3) s5) Post.
+  semax E Delta Pre (Ssequence (Sfor s1 e2 s4 s3) s5) Post.
 Proof.
 intros.
 rename H0 into H9. rename H1 into H0.
@@ -3261,7 +2889,8 @@ Definition semax_frame := @DeepEmbeddedMinimumSeparationLogic.semax_frame.
 Definition semax_adapt_frame := @DeepEmbeddedMinimumSeparationLogic.semax_adapt_frame.
 Definition semax_adapt := @DeepEmbeddedMinimumSeparationLogic.semax_adapt.
 
+End mpred.
+
 End DeepEmbeddedPracticalLogic.
 
 End DeepEmbedded.
-
diff --git a/floyd/SeparationLogicAsLogicSoundness.v b/floyd/SeparationLogicAsLogicSoundness.v
index aa75fe126d..438fd89a4c 100644
--- a/floyd/SeparationLogicAsLogicSoundness.v
+++ b/floyd/SeparationLogicAsLogicSoundness.v
@@ -1,12 +1,13 @@
 From compcert Require Export Clightdefs.
 Require Import VST.sepcomp.semantics.
-
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.juicy_base.
-Require Import VST.veric.juicy_mem VST.veric.juicy_mem_lemmas VST.veric.juicy_mem_ops.
+Require Import VST.veric.juicy_mem VST.veric.juicy_mem_lemmas.
 Require Import VST.veric.res_predicates.
 Require Import VST.veric.extend_tc.
 Require Import VST.veric.Clight_seplog.
 Require Import VST.veric.Clight_assert_lemmas.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.sepcomp.extspec.
 Require Import VST.sepcomp.step_lemmas.
 Require Import VST.veric.juicy_extspec.
@@ -23,12 +24,12 @@ Require Import VST.veric.semax_loop.
 Require Import VST.veric.semax_switch.
 Require Import VST.veric.semax_prog.
 Require Import VST.veric.semax_ext.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.SeparationLogic.
 Require Import VST.floyd.SeparationLogicFacts.
 Require Import VST.floyd.SeparationLogicAsLogic.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.SeparationLogicSoundness.
-Local Open Scope logic.
-Require Import VST.veric.ghost_PCM.
 
 Import Clight.
 
@@ -46,7 +47,7 @@ Module CSHL_Def := DeepEmbedded.DeepEmbeddedDef.
 
 Module CSHL_Defs := DeepEmbedded.DeepEmbeddedDefs.
 
-Arguments CSHL_Def.semax {_} {_} _ _ _ _.
+Arguments CSHL_Def.semax {_} {_} {_} {_} {_} _.
 
 Module Conseq := GenConseq (Def) (MinimumLogic).
 
@@ -130,9 +131,21 @@ Module Sset := ToSset (Def) (Conseq) (Extr) (SetB) (PtrCmpB) (LoadB) (CastLoadB)
 
 Module Sassign := ToSassign (Def) (Conseq) (Extr) (StoreB) (StoreUnionHackB).
 
-Theorem semax_sound: forall Espec CS Delta P c Q,
-  @DeepEmbedded.DeepEmbeddedDef.semax Espec CS Delta P c Q ->
-  @Def.semax Espec CS Delta P c Q.
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ}.
+
+Lemma semax_FF: forall {OK_spec: ext_spec OK_ty} {CS : compspecs} E Delta c Q, Def.semax E Delta False c Q.
+Proof.
+  intros.
+  apply ConseqFacts.semax_pre_simple with (False ∧ False).
+  { apply bi.False_elim. }
+  apply semax_extract_prop; contradiction.
+Qed.
+
+Theorem semax_sound: forall {OK_spec: ext_spec OK_ty} {CS : compspecs} E Delta P c Q,
+  DeepEmbedded.DeepEmbeddedDef.semax E Delta P c Q ->
+  Def.semax E Delta P c Q.
 Proof.
   intros.
   induction H.
@@ -151,21 +164,16 @@ Proof.
   + apply Sset.semax_set_ptr_compare_load_cast_load_backward.
   + apply Sassign.semax_store_store_union_hack_backward.
   + apply MinimumLogic.semax_skip.
-  + rewrite <- (log_normalize.andp_dup seplog.FF).
-    unfold seplog.FF at 1.
-    apply semax_extract_prop.
-    tauto.
+  + apply semax_FF.
   + apply MinimumLogic.semax_Slabel; auto.
-  + rewrite <- (log_normalize.andp_dup seplog.FF).
-    unfold seplog.FF at 1.
-    apply semax_extract_prop.
-    tauto.
+  + apply semax_FF.
   + eapply MinimumLogic.semax_conseq; eauto.
+  + eapply MinimumLogic.semax_mask_mono; eauto.
 Qed.
 
-Theorem semax_body_sound: forall Vspec Gspec CS f id,
-  @DeepEmbedded.DeepEmbeddedDefs.semax_body Vspec Gspec CS f id ->
-  @MinimumLogic.CSHL_Defs.semax_body Vspec Gspec CS f id.
+Theorem semax_body_sound: forall {CS : compspecs} Vspec Gspec f id,
+  DeepEmbedded.DeepEmbeddedDefs.semax_body Vspec Gspec f id ->
+  MinimumLogic.CSHL_Defs.semax_body Vspec Gspec f id.
 Proof.
   intros.
   unfold MinimumLogic.CSHL_Defs.semax_body, CSHL_Defs.semax_body in H |- *.
@@ -176,9 +184,9 @@ Proof.
   apply H.
 Qed.
 
-Theorem semax_func_sound: forall Espec Vspec Gspec CS ge ids fs,
-  @DeepEmbedded.DeepEmbeddedDef.semax_func Espec Vspec Gspec CS ge ids fs ->
-  @Def.semax_func Espec Vspec Gspec CS ge ids fs.
+Theorem semax_func_sound: forall {OK_spec: ext_spec OK_ty} {CS : compspecs} Vspec Gspec ge ids fs,
+  DeepEmbedded.DeepEmbeddedDef.semax_func _ _ _ _ Vspec Gspec CS ge ids fs ->
+  Def.semax_func(C := CS) Vspec Gspec ge ids fs.
 Proof.
   intros.
   induction H.
@@ -186,7 +194,7 @@ Proof.
   + eapply MinimumLogic.semax_func_cons; eauto.
     apply semax_body_sound; auto.
   + eapply MinimumLogic.semax_func_cons_ext; eauto.
-  + apply (@MinimumLogic.semax_func_mono Espec _ _ CSUB ge ge' Gfs Gffp); auto.
+  + apply (MinimumLogic.semax_func_mono CSUB ge ge' Gfs Gffp); auto.
   + apply MinimumLogic.semax_func_app; auto.
   + eapply MinimumLogic.semax_func_subsumption; eauto.
   + eapply MinimumLogic.semax_func_join; eauto.
@@ -194,50 +202,44 @@ Proof.
   + eapply MinimumLogic.semax_func_skipn; eauto.
 Qed.
 
-Theorem semax_prog_sound': forall Espec CS prog z Vspec Gspec,
-  @DeepEmbedded.DeepEmbeddedDefs.semax_prog Espec CS prog z Vspec Gspec ->
-  @MinimumLogic.CSHL_Defs.semax_prog Espec CS prog z Vspec Gspec.
+Theorem semax_prog_sound': forall {OK_spec: ext_spec OK_ty} {CS : compspecs} prog z Vspec Gspec,
+  DeepEmbedded.DeepEmbeddedDefs.semax_prog prog z Vspec Gspec ->
+  MinimumLogic.CSHL_Defs.semax_prog prog z Vspec Gspec.
 Proof.
   intros.
   hnf in H |- *.
-  pose proof semax_func_sound Espec Vspec Gspec CS (Genv.globalenv prog) (prog_funct prog) Gspec.
+  pose proof semax_func_sound Vspec Gspec (Genv.globalenv prog) (prog_funct prog) Gspec.
   tauto.
 Qed.
 
-Theorem semax_prog_sound: forall Espec CS prog z Vspec Gspec,
-  @DeepEmbedded.DeepEmbeddedDefs.semax_prog Espec CS prog z Vspec Gspec ->
-  @semax_prog.semax_prog Espec CS prog z Vspec Gspec.
+Theorem semax_prog_sound: forall {OK_spec: ext_spec OK_ty} {CS : compspecs} prog z Vspec Gspec,
+  DeepEmbedded.DeepEmbeddedDefs.semax_prog prog z Vspec Gspec ->
+  semax_prog.semax_prog OK_spec prog z Vspec Gspec.
 Proof.
   intros.
   apply Sound.semax_prog_sound, semax_prog_sound'; auto.
 Qed.
 
 Theorem semax_prog_rule :
-  forall {Espec: OracleKind}{CS: compspecs},
-  forall V G prog m h z,
-  postcondition_allows_exit Espec tint ->
-     @DeepEmbedded.DeepEmbeddedDefs.semax_prog Espec CS prog z V G ->
+  forall {OK_spec: ext_spec OK_ty} {CS : compspecs} V G prog m h z,
+     postcondition_allows_exit OK_spec tint ->
+     DeepEmbedded.DeepEmbeddedDefs.semax_prog prog z V G ->
      Genv.init_mem prog = Some m ->
-     { b : block & { q : Clight_core.state &
+     { b : Values.block & { q : CC_core &
        (Genv.find_symbol (globalenv prog) (prog_main prog) = Some b) *
-       (forall jm, m_dry jm = m -> exists jm', semantics.initial_core (juicy_core_sem (cl_core_sem (globalenv prog))) h
-                    jm q jm' (Vptr b Ptrofs.zero) nil) *
-       forall n,
-         { jm |
-           m_dry jm = m /\ level jm = n /\
-           nth_error (ghost_of (m_phi jm)) 0 = Some (Some (ext_ghost z, NoneP)) /\
-           (exists z, join (m_phi jm) (wsat_rmap (m_phi jm)) (m_phi z) /\ ext_order jm z) /\
-           jsafeN (@OK_spec Espec) (globalenv prog) z q jm /\
-           no_locks (m_phi jm) /\
-           matchfunspecs (globalenv prog) G (m_phi jm) /\
-           app_pred (funassert (nofunc_tycontext V G) (empty_environ (globalenv prog))) (m_phi jm)
-     } } }%type.
+       (exists m', semantics.initial_core (cl_core_sem (globalenv prog)) h
+                       m q m' (Vptr b Ptrofs.zero) nil) *
+       (state_interp Mem.empty z ∗ funspec_auth ∅ ∗ has_ext z ⊢ |==> state_interp m z ∗ jsafeN OK_spec (globalenv prog) ⊤ z q ∧
+           (*no_locks ∧*) matchfunspecs (globalenv prog) G (*∗ funassert (nofunc_tycontext V G) (empty_environ (globalenv prog))*))
+     } }%type.
 Proof.
   intros.
-  apply Sound.semax_prog_rule; eauto.
+  eapply Sound.semax_prog_rule; eauto.
   eapply semax_prog_sound'; eauto.
 Qed.
 
+End mpred.
+
 End DeepEmbeddedSoundness.
 
 (********************************************************)
diff --git a/floyd/SeparationLogicFacts.v b/floyd/SeparationLogicFacts.v
index 1df7103aef..f8436c4c21 100644
--- a/floyd/SeparationLogicFacts.v
+++ b/floyd/SeparationLogicFacts.v
@@ -1,4 +1,5 @@
 From compcert Require Export Clightdefs.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Export VST.veric.SeparationLogic.
 Require Export VST.msl.Extensionality.
 Require Export compcert.lib.Coqlib.
@@ -6,33 +7,25 @@ Require Export VST.msl.Coqlib2 VST.veric.coqlib4 VST.floyd.coqlib3.
 Require Export VST.floyd.jmeq_lemmas.
 Require Export VST.floyd.find_nth_tactic.
 Require Export VST.veric.juicy_extspec.
-Require Import VST.veric.NullExtension.
-
 Require Import VST.floyd.assert_lemmas.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Import LiftNotation.
-Import compcert.lib.Maps.
 
-Local Open Scope logic.
+Section mpred.
 
-(* TODO: move it *)
-Lemma exp_derives:
-       forall {A: Type}  {NA: NatDed A} (B: Type) (P Q: B -> A),
-               (forall x:B, P x |-- Q x) -> (exp P |-- exp Q).
-Proof.
-intros.
-apply exp_left; intro x; apply exp_right with x; auto.
-Qed.
+Context `{!VSTGS OK_ty Σ}.
 
 (* Closed and subst. copied from closed_lemmas.v. *)
 
 Lemma closed_wrt_subst:
-  forall {A} id e (P: environ -> A), closed_wrt_vars (eq id) P -> subst id e P = P.
+  forall id e (P : assert), closed_wrt_vars (eq id) P -> assert_of(Σ:=Σ) (subst id e P) ⊣⊢ P.
 Proof.
 intros.
 unfold subst, closed_wrt_vars in *.
-extensionality rho.
+split => rho /=.
 symmetry.
-apply H.
+unfold env_set.
+rewrite (H _ ((Map.set id (e rho) (te_of rho)))) //.
 intros.
 destruct (eq_dec id i); auto.
 right.
@@ -42,7 +35,7 @@ Qed.
 (* End of copied from closed_lemmas.v. *)
 
 Lemma subst_self: forall {A: Type} (P: environ -> A) t id v Delta rho,
-  (temp_types Delta) ! id = Some t ->
+  (temp_types Delta) !! id = Some t ->
   tc_environ Delta rho ->
   v rho = eval_id id rho ->
   subst id v P rho = P rho.
@@ -55,28 +48,30 @@ Proof.
   f_equal.
   unfold env_set, eval_id in *; destruct rho; simpl in *.
   f_equal.
-  rewrite H1, H0.
+  rewrite H1 H0.
   simpl.
   apply Map.ext; intros i.
   destruct (Pos.eq_dec id i).
   + subst.
     rewrite Map.gss; symmetry; auto.
-  + rewrite Map.gso by auto.
+  + rewrite -> Map.gso by auto.
     auto.
 Qed.
 
-Definition obox (Delta: tycontext) (i: ident) (P: environ -> mpred): environ -> mpred :=
-  ALL v: _,
-    match ((temp_types Delta) ! i) with
-    | Some t => !! (tc_val' t v) --> subst i (`v) P
-    | _ => TT
+Notation assert := (@assert Σ).
+
+Definition obox (Delta: tycontext) (i: ident) (P: assert): assert :=
+  ∀ v: _,
+    match (temp_types Delta) !! i with
+    | Some t => ⌜tc_val' t v⌝ → assert_of (subst i (`v) P)
+    | _ => True
     end.
 
-Definition odia (Delta: tycontext) (i: ident) (P: environ -> mpred): environ -> mpred :=
-  EX v: _,
-    match ((temp_types Delta) ! i) with
-    | Some t => !! (tc_val' t v) && subst i (`v) P
-    | _ => FF
+Definition odia (Delta: tycontext) (i: ident) (P: assert): assert :=
+  ∃ v: _,
+    match (temp_types Delta) !! i with
+    | Some t => ⌜tc_val' t v⌝ ∧ assert_of (subst i (`v) P)
+    | _ => False
     end.
 
 Lemma obox_closed_wrt: forall Delta id P, closed_wrt_vars (eq id) (obox Delta id P).
@@ -84,22 +79,20 @@ Proof.
   intros.
   hnf; intros.
   unfold obox; simpl.
-  apply allp_congr; intros.
-  unfold subst.
-  destruct ((temp_types Delta) ! id); auto.
-  f_equal.
-  f_equal.
-  unfold_lift.
-  unfold env_set.
-  f_equal.
-  simpl.
-  apply Map.ext; intros j.
-  destruct (ident_eq id j).
-  + subst.
-    rewrite !Map.gss; auto.
-  + rewrite !Map.gso by congruence.
-    destruct (H j); [congruence |].
-    auto.
+  monPred.unseal; simpl.
+  f_equiv; intros ?.
+  destruct ((temp_types Delta) !! id); auto.
+  rewrite /monpred.monPred_defs.monPred_impl_def /=.
+  assert ((Map.set id a (te_of rho)) = Map.set id a te') as Hrho.
+  { apply Map.ext; intros j.
+    destruct (ident_eq id j).
+    + subst.
+      rewrite !Map.gss; auto.
+    + rewrite !Map.gso //.
+      destruct (H j); [congruence |].
+      auto. }
+  iSplit; iIntros "H" (? <- ?); (iSpecialize ("H" with "[%] [%]"); [done.. |]);
+    unfold_lift; rewrite /subst /env_set /= Hrho //.
 Qed.
 
 Lemma odia_closed_wrt: forall Delta id P, closed_wrt_vars (eq id) (odia Delta id P).
@@ -107,33 +100,28 @@ Proof.
   intros.
   hnf; intros.
   unfold odia; simpl.
-  apply exp_congr; intros.
-  destruct ((temp_types Delta) ! id); auto.
-  f_equal.
-  unfold subst.
-  simpl.
-  f_equal.
-  unfold_lift.
-  unfold env_set.
-  f_equal.
-  simpl.
-  apply Map.ext; intros j.
+  monPred.unseal; simpl.
+  f_equiv; intros ?.
+  destruct ((temp_types Delta) !! id); auto.
+  simpl; f_equiv.
+  rewrite /subst /env_set /=; f_equiv.
+  f_equiv; apply Map.ext; intros j.
   destruct (ident_eq id j).
   + subst.
     rewrite !Map.gss; auto.
-  + rewrite !Map.gso by congruence.
+  + rewrite !Map.gso //.
     destruct (H j); [congruence |].
     auto.
 Qed.
 
-Lemma subst_obox: forall Delta id v (P: environ -> mpred), subst id (`v) (obox Delta id P) = obox Delta id P.
+Lemma subst_obox: forall Delta id v (P: assert), assert_of (subst id (`v) (obox Delta id P)) ⊣⊢ obox Delta id P.
 Proof.
   intros.
   apply closed_wrt_subst.
   apply obox_closed_wrt.
 Qed.
 
-Lemma subst_odia: forall Delta id v (P: environ -> mpred), subst id (`v) (odia Delta id P) = odia Delta id P.
+Lemma subst_odia: forall Delta id v (P: assert), assert_of (subst id (`v) (odia Delta id P)) ⊣⊢ odia Delta id P.
 Proof.
   intros.
   apply closed_wrt_subst.
@@ -141,221 +129,128 @@ Proof.
 Qed.
 
 Definition temp_guard (Delta : tycontext) (i: ident): Prop :=
-  (temp_types Delta) ! i <> None.
+  (temp_types Delta) !! i <> None.
 
-Lemma obox_closed: forall Delta i P, temp_guard Delta i -> closed_wrt_vars (eq i) P -> obox Delta i P = P.
+Lemma obox_closed: forall Delta i (P : assert), temp_guard Delta i -> closed_wrt_vars (eq i) P -> obox Delta i P ⊣⊢ P.
 Proof.
   intros.
   unfold obox.
   hnf in H.
-  destruct ((temp_types Delta) ! i); [| tauto].
-  apply pred_ext.
-  + apply (allp_left _ Vundef).
-    rewrite closed_wrt_subst by auto.
-    apply derives_refl'.
-    apply prop_imp, tc_val'_Vundef.
-  + apply allp_right; intros.
-    rewrite closed_wrt_subst by auto.
-    apply imp_right2.
+  destruct ((temp_types Delta) !! i); [| tauto].
+  iSplit.
+  + iIntros "H"; iSpecialize ("H" $! Vundef with "[%]"); first apply tc_val'_Vundef.
+    rewrite closed_wrt_subst //.
+  + iIntros "?" (??).
+    rewrite closed_wrt_subst //.
 Qed.
 
-Lemma obox_odia: forall Delta i P, temp_guard Delta i -> obox Delta i (odia Delta i P) = odia Delta i P.
+Lemma obox_odia: forall Delta i P, temp_guard Delta i -> obox Delta i (odia Delta i P) ⊣⊢ odia Delta i P.
 Proof.
   intros.
   apply obox_closed; auto.
   apply odia_closed_wrt.
 Qed.
 
-Lemma obox_K: forall Delta i P Q, (P |-- Q) -> obox Delta i P |-- obox Delta i Q.
+Lemma obox_K: forall Delta i P Q, (P ⊢ Q) -> obox Delta i P ⊢ obox Delta i Q.
 Proof.
   intros.
-  intro rho.
-  unfold obox, subst.
-  simpl; apply allp_derives; intros.
-  destruct ((temp_types Delta) ! i); auto.
-  apply imp_derives; auto.
+  rewrite /obox /subst.
+  destruct ((temp_types Delta) !! i); auto.
+  split => rho; monPred.unseal.
+  iIntros "H" (????); rewrite -H; by iApply "H".
 Qed.
 
-Lemma obox_T: forall Delta i (P: environ -> mpred),
+Lemma obox_T: forall Delta i (P: assert),
   temp_guard Delta i ->
-  local (tc_environ Delta) && obox Delta i P |-- P.
+  local (tc_environ Delta) ∧ obox Delta i P ⊢ P.
 Proof.
   intros.
-  intro rho; simpl.
-  unfold local, lift1.
-  normalize.
-  destruct H0 as [? _].
-  hnf in H, H0.
-  specialize (H0 i).
-  unfold obox; simpl.
-  destruct ((temp_types Delta) ! i); [| tauto].
-  specialize (H0 t eq_refl).
-  destruct H0 as [v [? ?]].
-  apply (allp_left _ v).
-  rewrite prop_imp by auto.
-  unfold subst.
-  apply derives_refl'.
-  f_equal.
-  unfold_lift.
-  destruct rho.
-  unfold env_set; simpl in *.
-  f_equal.
-  apply Map.ext; intro j.
-  destruct (ident_eq i j).
-  + subst.
-    rewrite Map.gss; auto.
-  + rewrite Map.gso by auto.
-    auto.
+  split => rho; rewrite /local /lift1 /obox /subst /env_set; monPred.unseal.
+  iIntros "((%TC & _) & H)".
+  unfold temp_guard, typecheck_temp_environ in *.
+  specialize (TC i); destruct (temp_types Delta !! i); last done.
+  edestruct TC as (? & ? & ?); first done.
+  iSpecialize ("H" with "[%] [%]"); [done.. | simpl].
+  destruct rho; rewrite Map.override_same //.
 Qed.
 
-Lemma odia_D: forall Delta i (P: environ -> mpred),
+Lemma odia_D: forall Delta i (P: assert),
   temp_guard Delta i ->
-  local (tc_environ Delta) && P |-- odia Delta i P.
+  local (tc_environ Delta) ∧ P ⊢ odia Delta i P.
 Proof.
   intros.
-  intro rho; simpl.
-  unfold local, lift1.
-  normalize.
-  destruct H0 as [? _].
-  hnf in H, H0.
-  specialize (H0 i).
-  unfold odia; simpl.
-  destruct ((temp_types Delta) ! i); [| tauto].
-  specialize (H0 t eq_refl).
-  destruct H0 as [v [? ?]].
-  apply (exp_right v).
-  rewrite prop_true_andp by auto.
-  unfold subst.
-  apply derives_refl'.
-  f_equal.
-  unfold_lift.
-  destruct rho.
-  unfold env_set; simpl in *.
-  f_equal.
-  apply Map.ext; intro j.
-  destruct (ident_eq i j).
-  + subst.
-    rewrite Map.gss; auto.
-  + rewrite Map.gso by auto.
-    auto.
+  split => rho; rewrite /local /lift1 /odia /subst /env_set; monPred.unseal.
+  iIntros "((%TC & _) & H)".
+  unfold temp_guard, typecheck_temp_environ in *.
+  specialize (TC i); destruct (temp_types Delta !! i); last done.
+  edestruct TC as (? & ? & ?); first done.
+  iExists _; iSplit; first done; simpl.
+  destruct rho; rewrite Map.override_same //.
 Qed.
 
 Lemma odia_derives_EX_subst: forall Delta i P,
-  odia Delta i P |-- EX v : val, subst i (` v) P.
+  odia Delta i P ⊢ ∃ v : val, assert_of (subst i (` v) P).
 Proof.
   intros.
   unfold odia.
-  apply exp_derives.
-  intros v.
-  destruct ((temp_types Delta) ! i); [| apply FF_left].
-  apply andp_left2; auto.
+  apply bi.exist_mono; intros.
+  iIntros "H"; destruct ((temp_types Delta) !! i); last done.
+  rewrite bi.and_elim_r //.
+Qed.
+
+Lemma tc_environ_set: forall Delta i t x rho (TC : tc_environ Delta rho),
+  temp_types Delta !! i = Some t -> tc_val' t x ->
+  tc_environ Delta (mkEnviron (ge_of rho) (ve_of rho) (Map.set i ((` x) rho) (te_of rho))).
+Proof.
+  intros.
+  destruct rho, TC as (TC & ? & ?); split3; auto; simpl in *.
+  intros j tj Hj; destruct (TC j tj Hj) as (v & ? & ?).
+  destruct (ident_eq i j).
+  + subst; eexists; rewrite Map.gss.
+    assert (tj = t) as -> by (rewrite Hj in H; inv H; done); eauto.
+  + exists v.
+    rewrite Map.gso //.
 Qed.
 
 Lemma obox_left2: forall Delta i P Q,
   temp_guard Delta i ->
-  (local (tc_environ Delta) && P |-- Q) ->  
-  local (tc_environ Delta) && obox Delta i P |-- obox Delta i Q.
+  (local (tc_environ Delta) ∧ P ⊢ Q) ->
+  local (tc_environ Delta) ∧ obox Delta i P ⊢ obox Delta i Q.
 Proof.
-  intros.
-  unfold local, lift1 in *.
-  intro rho; simpl.
-  normalize.
-  unfold obox; simpl.
-  apply allp_derives; intros x.
-  destruct ((temp_types Delta) ! i) eqn:?H; auto.
-  rewrite <- imp_andp_adjoint.
-  normalize.
-  unfold TT; rewrite prop_imp by auto.
-  unfold subst; unfold_lift.
-  specialize (H0 (env_set rho i x)).
-  simpl in H0.
-  assert (tc_environ Delta (env_set rho i x)).
-  {
-    clear H0.
-    destruct rho, H1 as [? [? ?]]; split; [| split]; simpl in *; auto.
-    clear H1 H4.
-    hnf in H0 |- *.
-    intros j tj H1; specialize (H0 j tj H1).
-    destruct H0 as [v [? ?]].
-    destruct (ident_eq i j).
-    + exists x.
-      subst.
-      rewrite H2 in H1; inv H1.
-      rewrite Map.gss.
-      split; auto.
-    + exists v.
-      rewrite Map.gso by auto.
-      split; auto.
-  }
-  normalize in H0.
+  intros ????? [H].
+  split => ?; revert H; rewrite /local /lift1 /obox /subst /env_set; monPred.unseal; intros.
+  iIntros "(%TC & H)".
+  destruct (temp_types Delta !! i) eqn: Ht; last done.
+  rewrite /monpred.monPred_defs.monPred_impl_def /=.
+  iIntros (x rho -> ?); iApply H; iSplit; last by iApply "H".
+  iPureIntro; eapply tc_environ_set; eauto.
 Qed.
 
 Lemma obox_left2': forall Delta i P Q,
   temp_guard Delta i ->
-  (local (tc_environ Delta) && (allp_fun_id Delta && P) |-- Q) ->  
-  local (tc_environ Delta) && (allp_fun_id Delta && obox Delta i P) |-- obox Delta i Q.
+  (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢ Q) ->
+  local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ obox Delta i P) ⊢ obox Delta i Q.
 Proof.
-  intros.
-  unfold local, lift1 in *.
-  intro rho; simpl.
-  normalize.
-  unfold obox; simpl.
-  apply allp_right; intros x.
-  rewrite andp_comm; apply imp_andp_adjoint.
-  apply (allp_left _ x).
-  apply imp_andp_adjoint; rewrite andp_comm.
-  destruct ((temp_types Delta) ! i) eqn:?H; [| apply prop_right; auto].
-  rewrite <- imp_andp_adjoint.
-  normalize.
-  unfold TT; rewrite prop_imp by auto.
-  unfold subst; unfold_lift.
-  specialize (H0 (env_set rho i x)).
-  simpl in H0.
-  assert (tc_environ Delta (env_set rho i x)).
-  {
-    clear H0.
-    destruct rho, H1 as [? [? ?]]; split; [| split]; simpl in *; auto.
-    clear H1 H4.
-    hnf in H0 |- *.
-    intros j tj H1; specialize (H0 j tj H1).
-    destruct H0 as [v [? ?]].
-    destruct (ident_eq i j).
-    + exists x.
-      subst.
-      rewrite H2 in H1; inv H1.
-      rewrite Map.gss.
-      split; auto.
-    + exists v.
-      rewrite Map.gso by auto.
-      split; auto.
-  }
-  normalize in H0.
+  intros ????? [H].
+  split => ?; revert H; rewrite /local /lift1 /obox /subst /env_set; monPred.unseal; intros.
+  iIntros "(%TC & Ha & H)".
+  destruct (temp_types Delta !! i) eqn: Ht; last done.
+  rewrite /monpred.monPred_defs.monPred_impl_def /=.
+  iIntros (x rho -> ?); iApply H; iSplit; last iSplitR "H"; last by iApply "H".
+  - iPureIntro; eapply tc_environ_set; eauto.
+  - rewrite !monPred_at_affinely //.
 Qed.
 
 Lemma obox_sepcon: forall Delta i P Q,
-  obox Delta i P * obox Delta i Q |-- obox Delta i (P * Q).
+  obox Delta i P ∗ obox Delta i Q ⊢ obox Delta i (P ∗ Q).
 Proof.
   intros.
-  unfold obox.
-  apply allp_right.
-  intros v.
-  apply wand_sepcon_adjoint.
-  apply (allp_left _ v).
-  apply wand_sepcon_adjoint.
-  rewrite sepcon_comm.
-  apply wand_sepcon_adjoint.
-  apply (allp_left _ v).
-  apply wand_sepcon_adjoint.
-  rewrite sepcon_comm.
-  destruct ((temp_types Delta) ! i); [| apply TT_right].
-  apply imp_andp_adjoint.
-  normalize.
-  unfold TT.
-  rewrite !prop_imp by auto.
-  rewrite subst_sepcon.
-  auto.
+  rewrite /obox.
+  iIntros "(HP & HQ)" (?).
+  destruct (temp_types Delta !! i); last done.
+  iIntros (?); rewrite subst_sepcon; iSplitL "HP"; [iApply "HP" | iApply "HQ"]; done.
 Qed.
-  
+
 Definition oboxopt Delta ret P :=
   match ret with
   | Some id => obox Delta id P
@@ -374,87 +269,85 @@ Definition temp_guard_opt (Delta : tycontext) (i: option ident): Prop :=
   | None => True
   end.
 
-Lemma substopt_oboxopt: forall Delta id v (P: environ -> mpred), substopt id (`v) (oboxopt Delta id P) = oboxopt Delta id P.
+Lemma substopt_oboxopt: forall Delta id v (P: assert), assert_of (substopt id (`v) (oboxopt Delta id P)) ⊣⊢ oboxopt Delta id P.
 Proof.
   intros.
-  destruct id; [| auto].
+  destruct id; [| done].
   apply subst_obox.
 Qed.
 
-Lemma oboxopt_closed: forall Delta i P,
+Lemma oboxopt_closed: forall Delta i (P : assert),
   temp_guard_opt Delta i ->
-  closed_wrt_vars (fun id => isSome (match i with Some i' => insert_idset i' idset0 | None => idset0 end) ! id) P ->
-  oboxopt Delta i P = P.
+  closed_wrt_vars (fun id => isSome ((match i with Some i' => insert_idset i' idset0 | None => idset0 end) !! id)) P ->
+  oboxopt Delta i P ⊣⊢ P.
 Proof.
   intros.
-  destruct i.
-  + simpl in H0 |- *.
-    apply obox_closed; auto.
-    replace (eq i) with ((fun id : ident => isSome (insert_idset i idset0) ! id)); auto.
-    extensionality id.
-    unfold insert_idset.
-    destruct (ident_eq id i).
-    - subst.
-      rewrite PTree.gss.
-      simpl.
-      apply prop_ext.
-      tauto.
-    - rewrite PTree.gso by auto.
-      unfold idset0.
-      rewrite PTree.gempty.
-      simpl.
-      assert (i <> id) by congruence.
-      apply prop_ext.
-      tauto.
-  + auto.
-Qed.
-
-Lemma oboxopt_T: forall Delta i (P: environ -> mpred),
+  destruct i; auto.
+  simpl in H0 |- *.
+  apply obox_closed; auto.
+  replace (eq i) with ((fun id : ident => isSome ((insert_idset i idset0) !! id))); auto.
+  extensionality id.
+  unfold insert_idset.
+  destruct (ident_eq id i).
+  - subst.
+    setoid_rewrite Maps.PTree.gss.
+    simpl.
+    apply prop_ext.
+    tauto.
+  - setoid_rewrite Maps.PTree.gso; last done.
+    unfold idset0.
+    rewrite Maps.PTree.gempty.
+    simpl.
+    assert (i <> id) by congruence.
+    apply prop_ext.
+    tauto.
+Qed.
+
+Lemma oboxopt_T: forall Delta i (P: assert),
   temp_guard_opt Delta i ->
-  local (tc_environ Delta) && oboxopt Delta i P |-- P.
+  local (tc_environ Delta) ∧ oboxopt Delta i P ⊢ P.
 Proof.
   intros.
-  destruct i; [| apply andp_left2, derives_refl].
+  destruct i; [|rewrite /= bi.and_elim_r //].
   apply obox_T; auto.
 Qed.
 
-Lemma odiaopt_D: forall Delta i (P: environ -> mpred),
+Lemma odiaopt_D: forall Delta i (P: assert),
   temp_guard_opt Delta i ->
-  local (tc_environ Delta) && P |-- odiaopt Delta i P.
+  local (tc_environ Delta) ∧ P ⊢ odiaopt Delta i P.
 Proof.
   intros.
-  destruct i; [| apply andp_left2, derives_refl].
+  destruct i; [|rewrite /= bi.and_elim_r //].
   apply odia_D; auto.
 Qed.
 
-Lemma oboxopt_odiaopt: forall Delta i P, temp_guard_opt Delta i -> oboxopt Delta i (odiaopt Delta i P) = odiaopt Delta i P.
+Lemma oboxopt_odiaopt: forall Delta i P, temp_guard_opt Delta i -> oboxopt Delta i (odiaopt Delta i P) ⊣⊢ odiaopt Delta i P.
 Proof.
   intros.
   destruct i; auto.
   apply obox_odia; auto.
 Qed.
 
-Lemma oboxopt_K: forall Delta i P Q, (P |-- Q) -> oboxopt Delta i P |-- oboxopt Delta i Q.
+Lemma oboxopt_K: forall Delta i P Q, (P ⊢ Q) -> oboxopt Delta i P ⊢ oboxopt Delta i Q.
 Proof.
   intros.
-  intro rho.
-  destruct i; auto.
+  destruct i; last done.
   apply obox_K; auto.
 Qed.
 
 Lemma odiaopt_derives_EX_substopt: forall Delta i P,
-  odiaopt Delta i P |-- EX v : val, substopt i (` v) P.
+  odiaopt Delta i P ⊢ ∃ v : val, assert_of (substopt i (` v) P).
 Proof.
   intros.
   destruct i; [apply odia_derives_EX_subst |].
-  simpl.
-  intros; apply (exp_right Vundef); auto.
+  split => rho; monPred.unseal.
+  by iIntros "H"; iExists Vundef.
 Qed.
 
 Lemma oboxopt_left2: forall Delta i P Q,
   temp_guard_opt Delta i ->
-  (local (tc_environ Delta) && P |-- Q) ->  
-  local (tc_environ Delta) && oboxopt Delta i P |-- oboxopt Delta i Q.
+  (local (tc_environ Delta) ∧ P ⊢ Q) ->  
+  local (tc_environ Delta) ∧ oboxopt Delta i P ⊢ oboxopt Delta i Q.
 Proof.
   intros.
   destruct i; [apply obox_left2; auto |].
@@ -463,8 +356,8 @@ Qed.
 
 Lemma oboxopt_left2': forall Delta i P Q,
   temp_guard_opt Delta i ->
-  (local (tc_environ Delta) && (allp_fun_id Delta && P) |-- Q) ->  
-  local (tc_environ Delta) && (allp_fun_id Delta && oboxopt Delta i P) |-- oboxopt Delta i Q.
+  (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢ Q) ->  
+  local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ oboxopt Delta i P) ⊢ oboxopt Delta i Q.
 Proof.
   intros.
   destruct i; [apply obox_left2'; auto |].
@@ -472,14 +365,15 @@ Proof.
 Qed.
 
 Lemma oboxopt_sepcon: forall Delta i P Q,
-  oboxopt Delta i P * oboxopt Delta i Q |-- oboxopt Delta i (P * Q).
+  oboxopt Delta i P ∗ oboxopt Delta i Q ⊢ oboxopt Delta i (P ∗ Q).
 Proof.
   intros.
-  destruct i.
-  + apply obox_sepcon.
-  + apply derives_refl.
+  destruct i; last done.
+  apply obox_sepcon.
 Qed.
 
+End mpred.
+
 Module Type CLIGHT_SEPARATION_HOARE_LOGIC_COMPLETE_CONSEQUENCE.
 
 Declare Module CSHL_Def: CLIGHT_SEPARATION_HOARE_LOGIC_DEF.
@@ -487,14 +381,14 @@ Declare Module CSHL_Def: CLIGHT_SEPARATION_HOARE_LOGIC_DEF.
 Import CSHL_Def.
 
 Axiom semax_conseq:
-  forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
-  forall P' (R': ret_assert) P c (R: ret_assert) ,
-    (local (tc_environ Delta) && ((allp_fun_id Delta) && P) |-- (|={Ensembles.Full_set}=> P')) ->
-    (local (tc_environ Delta) && ((allp_fun_id Delta) && RA_normal R') |-- (|={Ensembles.Full_set}=> RA_normal R)) ->
-    (local (tc_environ Delta) && ((allp_fun_id Delta) && RA_break R') |-- (|={Ensembles.Full_set}=> RA_break R)) ->
-    (local (tc_environ Delta) && ((allp_fun_id Delta) && RA_continue R') |-- (|={Ensembles.Full_set}=> RA_continue R)) ->
-    (forall vl, local (tc_environ Delta) && ((allp_fun_id Delta) && RA_return R' vl) |-- (RA_return R vl)) ->
-   @semax CS Espec Delta P' c R' -> @semax CS Espec Delta P c R.
+  forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
+  forall P' (R': ret_assert) P c (R: ret_assert),
+    (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢ (|={E}=> P')) ->
+    (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ RA_normal R') ⊢ (|={E}=> RA_normal R)) ->
+    (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ RA_break R') ⊢ (|={E}=> RA_break R)) ->
+    (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ RA_continue R') ⊢ (|={E}=> RA_continue R)) ->
+    (forall vl, local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ RA_return R' vl) ⊢ (RA_return R vl)) ->
+   semax E Delta P' c R' -> semax E Delta P c R.
 
 End CLIGHT_SEPARATION_HOARE_LOGIC_COMPLETE_CONSEQUENCE.
 
@@ -505,32 +399,33 @@ Module GenCConseqFacts
 Import Def.
 Import CConseq.
 
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs}.
+
 Lemma semax_pre_post_indexed_fupd:
-  forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
+  forall E (Delta: tycontext),
  forall P' (R': ret_assert) P c (R: ret_assert) ,
-    (local (tc_environ Delta) && P |-- (|={Ensembles.Full_set}=> P')) ->
-    (local (tc_environ Delta) && RA_normal R' |-- (|={Ensembles.Full_set}=> RA_normal R)) ->
-    (local (tc_environ Delta) && RA_break R' |-- (|={Ensembles.Full_set}=> RA_break R)) ->
-    (local (tc_environ Delta) && RA_continue R' |-- (|={Ensembles.Full_set}=> RA_continue R)) ->
-    (forall vl, local (tc_environ Delta) && RA_return R' vl |-- (RA_return R vl)) ->
-   @semax CS Espec Delta P' c R' -> @semax CS Espec Delta P c R.
+    (local (tc_environ Delta) ∧ P ⊢ (|={E}=> P')) ->
+    (local (tc_environ Delta) ∧ RA_normal R' ⊢ (|={E}=> RA_normal R)) ->
+    (local (tc_environ Delta) ∧ RA_break R' ⊢ (|={E}=> RA_break R)) ->
+    (local (tc_environ Delta) ∧ RA_continue R' ⊢ (|={E}=> RA_continue R)) ->
+    (forall vl, local (tc_environ Delta) ∧ RA_return R' vl ⊢ (RA_return R vl)) ->
+   semax E Delta P' c R' -> semax E Delta P c R.
 Proof.
   intros.
-  eapply semax_conseq; [.. | exact H4]; try intros;
-  match goal with
-  | |- ?A && (_ && ?B) |-- _ => apply derives_trans with (A && B); [solve_andp | auto]
-  end.
+  eapply semax_conseq; [.. | exact H4]; intros; rewrite bi.affinely_elim_emp left_id //.
 Qed.
 
 Lemma semax_pre_post_fupd:
-  forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
+  forall E (Delta: tycontext),
  forall P' (R': ret_assert) P c (R: ret_assert) ,
-    (local (tc_environ Delta) && P |-- (|={Ensembles.Full_set}=> P')) ->
-    (local (tc_environ Delta) && RA_normal R' |-- (|={Ensembles.Full_set}=> RA_normal R)) ->
-    (local (tc_environ Delta) && RA_break R' |-- (|={Ensembles.Full_set}=> RA_break R)) ->
-    (local (tc_environ Delta) && RA_continue R' |-- (|={Ensembles.Full_set}=> RA_continue R)) ->
-    (forall vl, local (tc_environ Delta) && RA_return R' vl |-- (RA_return R vl)) ->
-   @semax CS Espec Delta P' c R' -> @semax CS Espec Delta P c R.
+    (local (tc_environ Delta) ∧ P ⊢ (|={E}=> P')) ->
+    (local (tc_environ Delta) ∧ RA_normal R' ⊢ (|={E}=> RA_normal R)) ->
+    (local (tc_environ Delta) ∧ RA_break R' ⊢ (|={E}=> RA_break R)) ->
+    (local (tc_environ Delta) ∧ RA_continue R' ⊢ (|={E}=> RA_continue R)) ->
+    (forall vl, local (tc_environ Delta) ∧ RA_return R' vl ⊢ (RA_return R vl)) ->
+   semax E Delta P' c R' -> semax E Delta P c R.
 Proof.
   intros.
   eapply semax_pre_post_indexed_fupd; [.. | exact H4]; try intros;
@@ -538,100 +433,94 @@ Proof.
 Qed.
 
 Lemma semax_pre_indexed_fupd:
- forall P' Espec {cs: compspecs} Delta P c R,
-     (local (tc_environ Delta) && P |-- (|={Ensembles.Full_set}=> P')) ->
-     @semax cs Espec Delta P' c R  -> @semax cs Espec Delta P c R.
+ forall P' E Delta P c R,
+     (local (tc_environ Delta) ∧ P ⊢ (|={E}=> P')) ->
+     semax E Delta P' c R  -> semax E Delta P c R.
 Proof.
   intros; eapply semax_pre_post_indexed_fupd; eauto;
-  intros; reduce2derives; (apply fupd_intro || apply derives_refl).
+  intros; reduce2derives; done.
 Qed.
 
 Lemma semax_post_indexed_fupd:
- forall (R': ret_assert) Espec {cs: compspecs} Delta (R: ret_assert) P c,
-   (local (tc_environ Delta) && RA_normal R' |-- (|={Ensembles.Full_set}=> RA_normal R)) ->
-   (local (tc_environ Delta) && RA_break R' |-- (|={Ensembles.Full_set}=> RA_break R)) ->
-   (local (tc_environ Delta) && RA_continue R' |-- (|={Ensembles.Full_set}=> RA_continue R)) ->
-   (forall vl, local (tc_environ Delta) && RA_return R' vl |-- (RA_return R vl)) ->
-   @semax cs Espec Delta P c R' ->  @semax cs Espec Delta P c R.
+ forall (R': ret_assert) E Delta (R: ret_assert) P c,
+   (local (tc_environ Delta) ∧ RA_normal R' ⊢ (|={E}=> RA_normal R)) ->
+   (local (tc_environ Delta) ∧ RA_break R' ⊢ (|={E}=> RA_break R)) ->
+   (local (tc_environ Delta) ∧ RA_continue R' ⊢ (|={E}=> RA_continue R)) ->
+   (forall vl, local (tc_environ Delta) ∧ RA_return R' vl ⊢ (RA_return R vl)) ->
+   semax E Delta P c R' ->  semax E Delta P c R.
 Proof.
   intros; eapply semax_pre_post_indexed_fupd; try eassumption.
   apply derives_fupd_refl.
 Qed.
 
-Lemma semax_post''_indexed_fupd: forall R' Espec {cs: compspecs} Delta R P c,
-           (local (tc_environ Delta) && R' |-- (|={Ensembles.Full_set}=> RA_normal R)) ->
-      @semax cs Espec Delta P c (normal_ret_assert R') ->
-      @semax cs Espec Delta P c R.
-Proof. intros. eapply semax_post_indexed_fupd; eauto.
- simpl RA_normal; auto.
- simpl RA_break; normalize.
- simpl RA_continue; normalize.
- intro vl; simpl RA_return; normalize.
+Lemma semax_post''_indexed_fupd: forall R' E Delta R P c,
+           (local (tc_environ Delta) ∧ R' ⊢ (|={E}=> RA_normal R)) ->
+      semax E Delta P c (normal_ret_assert R') ->
+      semax E Delta P c R.
+Proof.
+ intros. eapply semax_post_indexed_fupd, H0; simpl; auto; intros; rewrite right_absorb; apply bi.False_elim.
 Qed.
 
 Lemma semax_pre_fupd:
- forall P' Espec {cs: compspecs} Delta P c R,
-     (local (tc_environ Delta) && P |-- (|={Ensembles.Full_set}=> P')) ->
-     @semax cs Espec Delta P' c R  -> @semax cs Espec Delta P c R.
+ forall P' E Delta P c R,
+     (local (tc_environ Delta) ∧ P ⊢ (|={E}=> P')) ->
+     semax E Delta P' c R  -> semax E Delta P c R.
 Proof.
-intros; eapply semax_pre_post_fupd; eauto;
-intros; apply andp_left2; try apply fupd_intro; auto.
+intros; eapply semax_pre_post_fupd; eauto; intros; rewrite bi.and_elim_r //; apply fupd_intro.
 Qed.
 
 Lemma semax_post_fupd:
- forall (R': ret_assert) Espec {cs: compspecs} Delta (R: ret_assert) P c,
-   (local (tc_environ Delta) && RA_normal R' |-- (|={Ensembles.Full_set}=> RA_normal R)) ->
-   (local (tc_environ Delta) && RA_break R' |-- (|={Ensembles.Full_set}=> RA_break R)) ->
-   (local (tc_environ Delta) && RA_continue R' |-- (|={Ensembles.Full_set}=> RA_continue R)) ->
-   (forall vl, local (tc_environ Delta) && RA_return R' vl |-- (RA_return R vl)) ->
-   @semax cs Espec Delta P c R' ->  @semax cs Espec Delta P c R.
+ forall (R': ret_assert) E Delta (R: ret_assert) P c,
+   (local (tc_environ Delta) ∧ RA_normal R' ⊢ (|={E}=> RA_normal R)) ->
+   (local (tc_environ Delta) ∧ RA_break R' ⊢ (|={E}=> RA_break R)) ->
+   (local (tc_environ Delta) ∧ RA_continue R' ⊢ (|={E}=> RA_continue R)) ->
+   (forall vl, local (tc_environ Delta) ∧ RA_return R' vl ⊢ (RA_return R vl)) ->
+   semax E Delta P c R' ->  semax E Delta P c R.
 Proof.
   intros; eapply semax_pre_post_fupd; try eassumption.
   apply derives_fupd_refl.
 Qed.
 
-Lemma semax_post'_fupd: forall R' Espec {cs: compspecs} Delta R P c,
-           (local (tc_environ Delta) && R' |-- (|={Ensembles.Full_set}=> R)) ->
-      @semax cs Espec Delta P c (normal_ret_assert R') ->
-      @semax cs Espec Delta P c (normal_ret_assert R).
-Proof. intros. eapply semax_post_fupd; eauto.
- simpl RA_normal; auto.
- simpl RA_break; normalize.
- simpl RA_continue; normalize.
- intro vl; simpl RA_return; normalize.
-Qed.
-
-Lemma semax_post''_fupd: forall R' Espec {cs: compspecs} Delta R P c,
-           (local (tc_environ Delta) && R' |-- (|={Ensembles.Full_set}=> RA_normal R)) ->
-      @semax cs Espec Delta P c (normal_ret_assert R') ->
-      @semax cs Espec Delta P c R.
-Proof. intros. eapply semax_post_fupd; eauto.
- simpl RA_normal; auto.
- simpl RA_break; normalize.
- simpl RA_continue; normalize.
- intro vl; simpl RA_return; normalize.
-Qed.
-
-Lemma semax_pre_post'_fupd: forall P' R' Espec {cs: compspecs} Delta R P c,
-      (local (tc_environ Delta) && P |-- (|={Ensembles.Full_set}=> P')) ->
-      (local (tc_environ Delta) && R' |-- (|={Ensembles.Full_set}=> R)) ->
-      @semax cs Espec Delta P' c (normal_ret_assert R') ->
-      @semax cs Espec Delta P c (normal_ret_assert R).
-Proof. intros.
+Lemma semax_post'_fupd: forall R' E Delta R P c,
+           (local (tc_environ Delta) ∧ R' ⊢ (|={E}=> R)) ->
+      semax E Delta P c (normal_ret_assert R') ->
+      semax E Delta P c (normal_ret_assert R).
+Proof.
+ intros. eapply semax_post_fupd; eauto; simpl; auto; intros; rewrite right_absorb //; apply fupd_intro.
+Qed.
+
+Lemma semax_post''_fupd: forall R' E Delta R P c,
+           (local (tc_environ Delta) ∧ R' ⊢ (|={E}=> RA_normal R)) ->
+      semax E Delta P c (normal_ret_assert R') ->
+      semax E Delta P c R.
+Proof.
+ intros. eapply semax_post_fupd; eauto; simpl; auto; intros; rewrite right_absorb //; apply bi.False_elim.
+Qed.
+
+Lemma semax_pre_post'_fupd: forall P' R' E Delta R P c,
+      (local (tc_environ Delta) ∧ P ⊢ (|={E}=> P')) ->
+      (local (tc_environ Delta) ∧ R' ⊢ (|={E}=> R)) ->
+      semax E Delta P' c (normal_ret_assert R') ->
+      semax E Delta P c (normal_ret_assert R).
+Proof.
+ intros.
  eapply semax_pre_fupd; eauto.
  eapply semax_post'_fupd; eauto.
 Qed.
 
-Lemma semax_pre_post''_fupd: forall P' R' Espec {cs: compspecs} Delta R P c,
-      (local (tc_environ Delta) && P |-- (|={Ensembles.Full_set}=> P')) ->
-      (local (tc_environ Delta) && R' |-- (|={Ensembles.Full_set}=> RA_normal R)) ->
-      @semax cs Espec Delta P' c (normal_ret_assert R') ->
-      @semax cs Espec Delta P c R.
-Proof. intros.
+Lemma semax_pre_post''_fupd: forall P' R' E Delta R P c,
+      (local (tc_environ Delta) ∧ P ⊢ (|={E}=> P')) ->
+      (local (tc_environ Delta) ∧ R' ⊢ (|={E}=> RA_normal R)) ->
+      semax E Delta P' c (normal_ret_assert R') ->
+      semax E Delta P c R.
+Proof.
+ intros.
  eapply semax_pre_fupd; eauto.
  eapply semax_post''_fupd; eauto.
 Qed.
 
+End mpred.
+
 End GenCConseqFacts.
 
 Module Type CLIGHT_SEPARATION_HOARE_LOGIC_CONSEQUENCE.
@@ -640,14 +529,14 @@ Declare Module CSHL_Def: CLIGHT_SEPARATION_HOARE_LOGIC_DEF.
 
 Import CSHL_Def.
 
-Axiom semax_pre_post : forall {Espec: OracleKind}{CS: compspecs},
- forall P' (R': ret_assert) Delta P c (R: ret_assert) ,
-    (local (tc_environ Delta) && P |-- P') ->
-    (local (tc_environ Delta) && RA_normal R' |-- RA_normal R) ->
-    (local (tc_environ Delta) && RA_break R' |-- RA_break R) ->
-    (local (tc_environ Delta) && RA_continue R' |-- RA_continue R) ->
-    (forall vl, local (tc_environ Delta) && RA_return R' vl |-- RA_return R vl) ->
-   @semax CS Espec Delta P' c R' -> @semax CS Espec Delta P c R.
+Axiom semax_pre_post : forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs},
+ forall P' (R': ret_assert) E Delta P c (R: ret_assert) ,
+    (local (tc_environ Delta) ∧ P ⊢ P') ->
+    (local (tc_environ Delta) ∧ RA_normal R' ⊢ RA_normal R) ->
+    (local (tc_environ Delta) ∧ RA_break R' ⊢ RA_break R) ->
+    (local (tc_environ Delta) ∧ RA_continue R' ⊢ RA_continue R) ->
+    (forall vl, local (tc_environ Delta) ∧ RA_return R' vl ⊢ RA_return R vl) ->
+   semax E Delta P' c R' -> semax E Delta P c R.
 
 End CLIGHT_SEPARATION_HOARE_LOGIC_CONSEQUENCE.
 
@@ -661,16 +550,16 @@ Import CSHL_Def.
 Import CConseq.
 Import CConseqFacts.
 
-Lemma semax_pre_post : forall {Espec: OracleKind}{CS: compspecs},
- forall P' (R': ret_assert) Delta P c (R: ret_assert) ,
-    (local (tc_environ Delta) && P |-- P') ->
-    (local (tc_environ Delta) && RA_normal R' |-- RA_normal R) ->
-    (local (tc_environ Delta) && RA_break R' |-- RA_break R) ->
-    (local (tc_environ Delta) && RA_continue R' |-- RA_continue R) ->
-    (forall vl, local (tc_environ Delta) && RA_return R' vl |-- RA_return R vl) ->
-   @semax CS Espec Delta P' c R' -> @semax CS Espec Delta P c R.
+Lemma semax_pre_post : forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs},
+ forall P' (R': ret_assert) E Delta P c (R: ret_assert) ,
+    (local (tc_environ Delta) ∧ P ⊢ P') ->
+    (local (tc_environ Delta) ∧ RA_normal R' ⊢ RA_normal R) ->
+    (local (tc_environ Delta) ∧ RA_break R' ⊢ RA_break R) ->
+    (local (tc_environ Delta) ∧ RA_continue R' ⊢ RA_continue R) ->
+    (forall vl, local (tc_environ Delta) ∧ RA_return R' vl ⊢ RA_return R vl) ->
+   semax E Delta P' c R' -> semax E Delta P c R.
 Proof.
-  intros; eapply semax_pre_post_fupd; eauto; intros; eapply derives_trans, fupd_intro; auto.
+  intros; eapply semax_pre_post_fupd, H4; rewrite ?H ?H0 ?H1 ?H2; auto.
 Qed.
 
 End GenConseq.
@@ -682,65 +571,66 @@ Module GenConseqFacts
 Import Def.
 Import Conseq.
 
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs}.
+
 (* Copied from canon.v *)
 
-Lemma semax_pre: forall {Espec: OracleKind}{cs: compspecs},
- forall P' Delta P c R,
-     (local (tc_environ Delta) && P |-- P') ->
-     @semax cs Espec Delta P' c R  -> @semax cs Espec Delta P c R.
+Lemma semax_pre: 
+ forall P' E Delta P c R,
+     (local (tc_environ Delta) ∧ P ⊢ P') ->
+     semax E Delta P' c R  -> semax E Delta P c R.
 Proof.
   intros; eapply semax_pre_post; eauto;
   intros; apply ENTAIL_refl.
 Qed.
 
-Lemma semax_pre_simple: forall {Espec: OracleKind}{cs: compspecs},
- forall P' Delta P c R,
-     (P |-- P') ->
-     @semax cs Espec Delta P' c R  -> @semax cs Espec Delta P c R.
+Lemma semax_pre_simple:
+ forall P' E Delta P c R,
+     (P ⊢ P') ->
+     semax E Delta P' c R  -> semax E Delta P c R.
 Proof.
 intros; eapply semax_pre; [| eauto].
-apply andp_left2; auto.
+rewrite bi.and_elim_r //.
 Qed.
 
 Lemma semax_post:
- forall (R': ret_assert) Espec {cs: compspecs} Delta (R: ret_assert) P c,
-   (local (tc_environ Delta) && RA_normal R' |-- RA_normal R) ->
-   (local (tc_environ Delta) && RA_break R' |-- RA_break R) ->
-   (local (tc_environ Delta) && RA_continue R' |-- RA_continue R) ->
-   (forall vl, local (tc_environ Delta) && RA_return R' vl |-- RA_return R vl) ->
-   @semax cs Espec Delta P c R' ->  @semax cs Espec Delta P c R.
+ forall (R': ret_assert) E Delta (R: ret_assert) P c,
+   (local (tc_environ Delta) ∧ RA_normal R' ⊢ RA_normal R) ->
+   (local (tc_environ Delta) ∧ RA_break R' ⊢ RA_break R) ->
+   (local (tc_environ Delta) ∧ RA_continue R' ⊢ RA_continue R) ->
+   (forall vl, local (tc_environ Delta) ∧ RA_return R' vl ⊢ RA_return R vl) ->
+   semax E Delta P c R' ->  semax E Delta P c R.
 Proof.
 intros; eapply semax_pre_post; try eassumption.
 apply ENTAIL_refl.
 Qed.
 
 Lemma semax_post_simple:
- forall (R': ret_assert) Espec {cs: compspecs} Delta (R: ret_assert) P c,
-   (RA_normal R' |-- RA_normal R) ->
-   (RA_break R' |-- RA_break R) ->
-   (RA_continue R' |-- RA_continue R) ->
-   (forall vl, RA_return R' vl |-- RA_return R vl) ->
-   @semax cs Espec Delta P c R' ->  @semax cs Espec Delta P c R.
+ forall (R': ret_assert) E Delta (R: ret_assert) P c,
+   (RA_normal R' ⊢ RA_normal R) ->
+   (RA_break R' ⊢ RA_break R) ->
+   (RA_continue R' ⊢ RA_continue R) ->
+   (forall vl, RA_return R' vl ⊢ RA_return R vl) ->
+   semax E Delta P c R' ->  semax E Delta P c R.
 Proof.
   intros; eapply semax_post; [.. | eauto]; intros; reduce2derives; auto.
 Qed.
 
-Lemma semax_post': forall R' Espec {cs: compspecs} Delta R P c,
-           (local (tc_environ Delta) && R' |-- R) ->
-      @semax cs Espec Delta P c (normal_ret_assert R') ->
-      @semax cs Espec Delta P c (normal_ret_assert R).
-Proof. intros. eapply semax_post; eauto.
- simpl RA_normal; auto.
- simpl RA_break; normalize.
- simpl RA_continue; normalize.
- intro vl; simpl RA_return; normalize.
+Lemma semax_post': forall R' E Delta R P c,
+           (local (tc_environ Delta) ∧ R' ⊢ R) ->
+      semax E Delta P c (normal_ret_assert R') ->
+      semax E Delta P c (normal_ret_assert R).
+Proof.
+ intros. eapply semax_post; eauto; simpl; auto; intros; rewrite bi.and_elim_r //.
 Qed.
 
-Lemma semax_pre_post': forall P' R' Espec {cs: compspecs} Delta R P c,
-      (local (tc_environ Delta) && P |-- P') ->
-      (local (tc_environ Delta) && R' |-- R) ->
-      @semax cs Espec Delta P' c (normal_ret_assert R') ->
-      @semax cs Espec Delta P c (normal_ret_assert R).
+Lemma semax_pre_post': forall P' R' E Delta R P c,
+      (local (tc_environ Delta) ∧ P ⊢ P') ->
+      (local (tc_environ Delta) ∧ R' ⊢ R) ->
+      semax E Delta P' c (normal_ret_assert R') ->
+      semax E Delta P c (normal_ret_assert R).
 Proof. intros.
  eapply semax_pre; eauto.
  eapply semax_post'; eauto.
@@ -748,27 +638,27 @@ Qed.
 
 (* Copied from canon.v end. *)
 
-Lemma semax_post'': forall R' Espec {cs: compspecs} Delta R P c,
-           (local (tc_environ Delta) && R' |-- RA_normal R) ->
-      @semax cs Espec Delta P c (normal_ret_assert R') ->
-      @semax cs Espec Delta P c R.
-Proof. intros. eapply semax_post; eauto.
- simpl RA_normal; auto.
- simpl RA_break; normalize.
- simpl RA_continue; normalize.
- intro vl; simpl RA_return; normalize.
-Qed.
-
-Lemma semax_pre_post'': forall P' R' Espec {cs: compspecs} Delta R P c,
-      (local (tc_environ Delta) && P |-- P') ->
-      (local (tc_environ Delta) && R' |-- RA_normal R) ->
-      @semax cs Espec Delta P' c (normal_ret_assert R') ->
-      @semax cs Espec Delta P c R.
-Proof. intros.
+Lemma semax_post'': forall R' E Delta R P c,
+           (local (tc_environ Delta) ∧ R' ⊢ RA_normal R) ->
+      semax E Delta P c (normal_ret_assert R') ->
+      semax E Delta P c R.
+Proof.
+ intros. eapply semax_post; eauto; simpl; auto; intros; rewrite bi.and_elim_r; apply bi.False_elim.
+Qed.
+
+Lemma semax_pre_post'': forall P' R' E Delta R P c,
+      (local (tc_environ Delta) ∧ P ⊢ P') ->
+      (local (tc_environ Delta) ∧ R' ⊢ RA_normal R) ->
+      semax E Delta P' c (normal_ret_assert R') ->
+      semax E Delta P c R.
+Proof.
+ intros.
  eapply semax_pre; eauto.
  eapply semax_post''; eauto.
 Qed.
 
+End mpred.
+
 End GenConseqFacts.
 
 Module Type CLIGHT_SEPARATION_HOARE_LOGIC_EXTRACTION.
@@ -778,10 +668,10 @@ Declare Module CSHL_Def: CLIGHT_SEPARATION_HOARE_LOGIC_DEF.
 Import CSHL_Def.
 
 Axiom semax_extract_exists:
-  forall {CS: compspecs} {Espec: OracleKind},
-  forall (A : Type)  (P : A -> environ->mpred) c (Delta: tycontext) (R: ret_assert),
-  (forall x, @semax CS Espec Delta (P x) c R) ->
-   @semax CS Espec Delta (EX x:A, P x) c R.
+  forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs},
+  forall (A : Type)  (P : A -> assert) c E (Delta: tycontext) (R: ret_assert),
+  (forall x, semax E Delta (P x) c R) ->
+   semax E Delta (∃ x:A, P x) c R.
 
 End CLIGHT_SEPARATION_HOARE_LOGIC_EXTRACTION.
 
@@ -796,38 +686,38 @@ Import Conseq.
 Import ConseqFacts.
 Import Extr.
 
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs}.
+
 Lemma semax_extract_prop:
-  forall {CS: compspecs} {Espec: OracleKind},
-  forall Delta (PP: Prop) P c Q,
-           (PP -> @semax CS Espec Delta P c Q) ->
-           @semax CS Espec Delta (!!PP && P) c Q.
+  forall E Delta (PP: Prop) P c Q,
+           (PP -> semax E Delta P c Q) ->
+           semax E Delta (⌜PP⌝ ∧ P) c Q.
 Proof.
   intros.
-  eapply semax_pre with (EX H: PP, P).
-  + apply andp_left2.
-    apply derives_extract_prop; intros.
-    apply (exp_right H0), derives_refl.
+  eapply semax_pre with (∃ H: PP, P).
+  + iIntros "(_ & %HP & ?)".
+    by iExists HP.
   + apply semax_extract_exists, H.
 Qed.
 
 Lemma semax_orp:
-  forall {CS: compspecs} {Espec: OracleKind},
-  forall Delta P1 P2 c Q,
-           @semax CS Espec Delta P1 c Q ->
-           @semax CS Espec Delta P2 c Q ->
-           @semax CS Espec Delta (P1 || P2) c Q.
+  forall E Delta P1 P2 c Q,
+           semax E Delta P1 c Q ->
+           semax E Delta P2 c Q ->
+           semax E Delta (P1 ∨ P2) c Q.
 Proof.
   intros.
-  eapply semax_pre with (EX b: bool, if b then P1 else P2).
-  + apply andp_left2.
-    apply orp_left.
-    - apply (exp_right true), derives_refl.
-    - apply (exp_right false), derives_refl.
+  eapply semax_pre with (∃ b: bool, if b then P1 else P2).
+  + by iIntros "(_ & [? | ?])"; [iExists true | iExists false].
   + apply semax_extract_exists.
     intros.
     destruct x; auto.
 Qed.
 
+End mpred.
+
 End GenExtrFacts.
 
 Module GenIExtrFacts
@@ -845,23 +735,19 @@ Import Extr.
 Import ExtrFacts.
 
 Lemma semax_extract_later_prop:
-  forall {CS: compspecs} {Espec: OracleKind},
-  forall Delta (PP: Prop) P c Q,
-           (PP -> @semax CS Espec Delta P c Q) ->
-           @semax CS Espec Delta ((|> !!PP) && P) c Q.
+  forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs},
+  forall E Delta (PP: Prop) P c Q,
+           (PP -> semax E Delta P c Q) ->
+           semax E Delta ((▷ ⌜PP⌝) ∧ P) c Q.
 Proof.
   intros.
   apply semax_extract_prop in H.
   eapply semax_pre_post_indexed_fupd; [.. | exact H].
-  + apply andp_left2.
-    eapply derives_trans, except_0_fupd.
-    eapply derives_trans; [apply andp_derives, orp_right1, derives_refl; apply later_prop|].
-    rewrite <- distrib_andp_orp.
-    rewrite orp_comm; apply orp_derives, fupd_intro; auto.
+  + by iIntros "(_ & >$ & $)".
   + apply derives_fupd_refl.
   + apply derives_fupd_refl.
   + apply derives_fupd_refl.
-  + intros; apply andp_left2; auto.
+  + intros; rewrite bi.and_elim_r //.
 Qed.
 
 End GenIExtrFacts.
@@ -873,15 +759,15 @@ Declare Module CSHL_Def: CLIGHT_SEPARATION_HOARE_LOGIC_DEF.
 Import CSHL_Def.
 
 Axiom semax_store_forward:
-  forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
+  forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
  forall e1 e2 sh P,
    writable_share sh ->
-   @semax CS Espec Delta
-          (|> ( (tc_lvalue Delta e1) &&  (tc_expr Delta (Ecast e2 (typeof e1)))  &&
-             (`(mapsto_ sh (typeof e1)) (eval_lvalue e1) * P)))
+   semax E Delta
+          (▷ ((tc_lvalue Delta e1 ∧ tc_expr Delta (Ecast e2 (typeof e1)))  ∧
+             (assert_of (`(mapsto_ sh (typeof e1)) (eval_lvalue e1)) ∗ P)))
           (Sassign e1 e2)
           (normal_ret_assert
-             (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`force_val (`(sem_cast (typeof e2) (typeof e1)) (eval_expr e2))) * P)).
+             (assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`force_val (`(sem_cast (typeof e2) (typeof e1)) (eval_expr e2)))) ∗ P)).
 
 End CLIGHT_SEPARATION_HOARE_LOGIC_STORE_FORWARD.
 
@@ -891,10 +777,10 @@ Declare Module CSHL_Def: CLIGHT_SEPARATION_HOARE_LOGIC_DEF.
 
 Import CSHL_Def.
 
-Axiom semax_store_backward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext) e1 e2 P,
-   @semax CS Espec Delta
-          (EX sh: share, !! writable_share sh && |> ( (tc_lvalue Delta e1) &&  (tc_expr Delta (Ecast e2 (typeof e1)))  &&
-             ((`(mapsto_ sh (typeof e1)) (eval_lvalue e1)) * (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`force_val (`(sem_cast (typeof e2) (typeof e1)) (eval_expr e2))) -* P))))
+Axiom semax_store_backward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext) e1 e2 P,
+   semax E Delta
+          (∃ sh: share, ⌜writable_share sh⌝ ∧ ▷ ((tc_lvalue Delta e1 ∧ tc_expr Delta (Ecast e2 (typeof e1)))  ∧
+             (assert_of (`(mapsto_ sh (typeof e1)) (eval_lvalue e1)) ∗ (assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`force_val (`(sem_cast (typeof e2) (typeof e1)) (eval_expr e2)))) -∗ P))))
           (Sassign e1 e2)
           (normal_ret_assert P).
 
@@ -917,22 +803,21 @@ Import Extr.
 Import ExtrFacts.
 Import StoreF.
 
-Theorem semax_store_backward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext) e1 e2 P,
-   @semax CS Espec Delta
-          (EX sh: share, !! writable_share sh && |> ( (tc_lvalue Delta e1) &&  (tc_expr Delta (Ecast e2 (typeof e1)))  &&
-             ((`(mapsto_ sh (typeof e1)) (eval_lvalue e1)) * (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`force_val (`(sem_cast (typeof e2) (typeof e1)) (eval_expr e2))) -* P))))
+Theorem semax_store_backward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext) e1 e2 P,
+   semax E Delta
+          (∃ sh: share, ⌜writable_share sh⌝ ∧ ▷ ((tc_lvalue Delta e1 ∧ tc_expr Delta (Ecast e2 (typeof e1)))  ∧
+             (assert_of (`(mapsto_ sh (typeof e1)) (eval_lvalue e1)) ∗ (assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`force_val (`(sem_cast (typeof e2) (typeof e1)) (eval_expr e2)))) -∗ P))))
           (Sassign e1 e2)
           (normal_ret_assert P).
 Proof.
   intros.
-  eapply semax_post'; [.. | eapply (semax_extract_exists _ _ _ _ (normal_ret_assert P))].
-  + apply andp_left2.
-    apply derives_refl.
+  eapply semax_post'; [.. | eapply (semax_extract_exists _ _ _ _ _ (normal_ret_assert P))].
+  + rewrite bi.and_elim_r //.
   + intros sh.
     apply semax_extract_prop; intro SH.
-    eapply semax_post'; [.. | eapply semax_store_forward; auto].
-    apply andp_left2.
-    apply modus_ponens_wand.
+    eapply semax_pre_post', semax_store_forward; eauto.
+    * rewrite bi.and_elim_r; apply bi.later_mono; rewrite -!assoc //.
+    * iIntros "(_ & ? & H)"; by iApply "H".
 Qed.
 
 End StoreF2B.
@@ -951,27 +836,21 @@ Import ConseqFacts.
 Import StoreB.
 
 Theorem semax_store_forward:
-  forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
- forall e1 e2 sh P,
+  forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext) e1 e2 sh P,
    writable_share sh ->
-   @semax CS Espec Delta
-          (|> ( (tc_lvalue Delta e1) &&  (tc_expr Delta (Ecast e2 (typeof e1)))  &&
-             (`(mapsto_ sh (typeof e1)) (eval_lvalue e1) * P)))
+   semax E Delta
+          (▷ ((tc_lvalue Delta e1 ∧ tc_expr Delta (Ecast e2 (typeof e1)))  ∧
+             (assert_of (`(mapsto_ sh (typeof e1)) (eval_lvalue e1)) ∗ P)))
           (Sassign e1 e2)
           (normal_ret_assert
-             (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`force_val (`(sem_cast (typeof e2) (typeof e1)) (eval_expr e2))) * P)).
+             (assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`force_val (`(sem_cast (typeof e2) (typeof e1)) (eval_expr e2)))) ∗ P)).
 Proof.
   intros.
   eapply semax_pre; [| apply semax_store_backward].
-  apply (exp_right sh).
-  normalize.
-  apply andp_left2.
-  apply later_derives.
-  apply andp_derives; auto.
-  apply sepcon_derives; auto.
-  apply wand_sepcon_adjoint.
-  rewrite sepcon_comm.
-  apply derives_refl.
+  iIntros "(_ & H)"; iExists sh; iSplit; first done.
+  iNext.
+  iApply (bi.and_mono with "H"); first done.
+  iIntros "($ & $) $".
 Qed.
 
 End StoreB2F.
@@ -983,24 +862,24 @@ Declare Module CSHL_Def: CLIGHT_SEPARATION_HOARE_LOGIC_DEF.
 Import CSHL_Def.
 
 Axiom semax_store_union_hack_forward:
-  forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
- forall (e1 e2 : expr) (t2: type) (ch ch' : memory_chunk) (sh : share) (P : LiftEnviron mpred),
+  forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
+ forall (e1 e2 : expr) (t2: type) (ch ch' : memory_chunk) (sh : share) (P : assert),
        (numeric_type (typeof e1) && numeric_type t2)%bool = true ->
        access_mode (typeof e1) = By_value ch ->
        access_mode t2 = By_value ch' ->
        decode_encode_val_ok ch ch' ->
        writable_share sh ->
-       semax Delta
-         (|> (tc_lvalue Delta e1 && tc_expr Delta (Ecast e2 (typeof e1)) &&
-              ((`(mapsto_ sh (typeof e1)) (eval_lvalue e1) 
-                && `(mapsto_ sh t2) (eval_lvalue e1))
-               * P)))
+       semax E Delta
+         (▷ ((tc_lvalue Delta e1 ∧ tc_expr Delta (Ecast e2 (typeof e1))) ∧
+              ((assert_of (`(mapsto_ sh (typeof e1)) (eval_lvalue e1))
+                ∧ assert_of (`(mapsto_ sh t2) (eval_lvalue e1)))
+               ∗ P)))
          (Sassign e1 e2)
          (normal_ret_assert
-            (EX v':val, 
-              andp (local  ((`decode_encode_val )
-                         ((` force_val) ((`(sem_cast (typeof e2) (typeof e1))) (eval_expr e2))) (`ch) (`ch') (`v') ))
-              ((` (mapsto sh t2)) (eval_lvalue e1) (`v') * P))).
+            (∃ v':val,
+              (local  ((`decode_encode_val )
+                         ((` force_val) ((`(sem_cast (typeof e2) (typeof e1))) (eval_expr e2))) (`ch) (`ch') (`v') )) ∧
+              (assert_of ((` (mapsto sh t2)) (eval_lvalue e1) (`v')) ∗ P))).
 
 End CLIGHT_SEPARATION_HOARE_LOGIC_STORE_UNION_HACK_FORWARD.
 
@@ -1011,21 +890,21 @@ Declare Module CSHL_Def: CLIGHT_SEPARATION_HOARE_LOGIC_DEF.
 Import CSHL_Def.
 
 Axiom semax_store_union_hack_backward:
- forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext) e1 e2 P,
-   @semax CS Espec Delta
-          (EX (t2:type) (ch ch': memory_chunk) (sh: share),
-             !! ((numeric_type (typeof e1) && numeric_type t2)%bool = true /\
+ forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext) e1 e2 P,
+   semax E Delta
+          (∃ (t2:type) (ch ch': memory_chunk) (sh: share),
+             ⌜(numeric_type (typeof e1) && numeric_type t2)%bool = true /\
                  access_mode (typeof e1) = By_value ch /\
                  access_mode t2 = By_value ch' /\
                  decode_encode_val_ok ch ch' /\
-                 writable_share sh) &&
-             |> ( (tc_lvalue Delta e1) &&  (tc_expr Delta (Ecast e2 (typeof e1)))  &&
-             ((`(mapsto_ sh (typeof e1)) (eval_lvalue e1) 
-                      && `(mapsto_ sh t2) (eval_lvalue e1)) *
-              (ALL v': val,
-                 `(mapsto sh t2) (eval_lvalue e1) (`v') -*
-                  imp (local  ((`decode_encode_val )
-                         ((` force_val) ((`(sem_cast (typeof e2) (typeof e1))) (eval_expr e2))) (`ch) (`ch') (`v') ))
+                 writable_share sh⌝ ∧
+             ▷ ((tc_lvalue Delta e1 ∧ tc_expr Delta (Ecast e2 (typeof e1))) ∧
+             ((assert_of (`(mapsto_ sh (typeof e1)) (eval_lvalue e1))
+                      ∧ assert_of (`(mapsto_ sh t2) (eval_lvalue e1))) ∗
+              (∀ v': val,
+                 assert_of (`(mapsto sh t2) (eval_lvalue e1) (`v')) -∗
+                  (local  ((`decode_encode_val )
+                         ((` force_val) ((`(sem_cast (typeof e2) (typeof e1))) (eval_expr e2))) (`ch) (`ch') (`v') )) →
                       (  P)))))
           (Sassign e1 e2)
           (normal_ret_assert P).
@@ -1050,44 +929,38 @@ Import ExtrFacts.
 Import StoreUnionHackF.
 
 Theorem semax_store_union_hack_backward:
- forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext) e1 e2 P,
-   @semax CS Espec Delta
-          (EX (t2:type) (ch ch': memory_chunk) (sh: share),
-             !! ((numeric_type (typeof e1) && numeric_type t2)%bool = true /\
+ forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext) e1 e2 P,
+   semax E Delta
+          (∃ (t2:type) (ch ch': memory_chunk) (sh: share),
+             ⌜(numeric_type (typeof e1) && numeric_type t2)%bool = true /\
                  access_mode (typeof e1) = By_value ch /\
                  access_mode t2 = By_value ch' /\
                  decode_encode_val_ok ch ch' /\
-                 writable_share sh) &&
-             |> ( (tc_lvalue Delta e1) &&  (tc_expr Delta (Ecast e2 (typeof e1)))  &&
-             ((`(mapsto_ sh (typeof e1)) (eval_lvalue e1) 
-                      && `(mapsto_ sh t2) (eval_lvalue e1)) *
-              (ALL v': val,
-                 `(mapsto sh t2) (eval_lvalue e1) (`v') -*
-                    imp (local  ((`decode_encode_val )
-                         ((` force_val) ((`(sem_cast (typeof e2) (typeof e1))) (eval_expr e2))) (`ch) (`ch') (`v') ))
-                      (P)))))
+                 writable_share sh⌝ ∧
+             ▷ ((tc_lvalue Delta e1 ∧ tc_expr Delta (Ecast e2 (typeof e1))) ∧
+             ((assert_of (`(mapsto_ sh (typeof e1)) (eval_lvalue e1))
+                      ∧ assert_of (`(mapsto_ sh t2) (eval_lvalue e1))) ∗
+              (∀ v': val,
+                 assert_of (`(mapsto sh t2) (eval_lvalue e1) (`v')) -∗
+                  (local  ((`decode_encode_val )
+                         ((` force_val) ((`(sem_cast (typeof e2) (typeof e1))) (eval_expr e2))) (`ch) (`ch') (`v') )) →
+                      (  P)))))
           (Sassign e1 e2)
           (normal_ret_assert P).
 Proof.
   intros.
-  eapply semax_post'; [.. | eapply (semax_extract_exists _ _ _ _ (normal_ret_assert P))];
-    [apply andp_left2; apply derives_refl | intro t2].
-  eapply semax_post'; [.. | eapply (semax_extract_exists _ _ _ _ (normal_ret_assert P))];
-    [apply andp_left2; apply derives_refl | intro ch].
-  eapply semax_post'; [.. | eapply (semax_extract_exists _ _ _ _ (normal_ret_assert P))];
-    [apply andp_left2; apply derives_refl | intro ch'].
-  eapply semax_post'; [.. | eapply (semax_extract_exists _ _ _ _ (normal_ret_assert P))];
-    [apply andp_left2; apply derives_refl | intro sh].
+  eapply semax_post'; [.. | eapply (semax_extract_exists _ _ _ _ _ (normal_ret_assert P))];
+    [rewrite bi.and_elim_r // | intro t2].
+  eapply semax_post'; [.. | eapply (semax_extract_exists _ _ _ _ _ (normal_ret_assert P))];
+    [rewrite bi.and_elim_r // | intro ch].
+  eapply semax_post'; [.. | eapply (semax_extract_exists _ _ _ _ _ (normal_ret_assert P))];
+    [rewrite bi.and_elim_r // | intro ch'].
+  eapply semax_post'; [.. | eapply (semax_extract_exists _ _ _ _ _ (normal_ret_assert P))];
+    [rewrite bi.and_elim_r // | intro sh].
   apply semax_extract_prop; intros [? [? [? [? SH]]]].
   eapply semax_post'; [.. | eapply semax_store_union_hack_forward; eauto].
-  apply andp_left2.
-  apply exp_left; intros v'.
-  rewrite andp_comm.
-  apply imp_andp_adjoint.
-  rewrite sepcon_comm.
-  apply wand_sepcon_adjoint.
-  apply allp_left with v'.
-  apply derives_refl.
+  iIntros "(_ & % & ? & ? & H)".
+  by iSpecialize ("H" with "[$]"); iApply "H".
 Qed.
 
 End StoreUnionHackF2B.
@@ -1106,43 +979,32 @@ Import ConseqFacts.
 Import StoreUnionHackB.
 
 Theorem semax_store_union_hack_forward:
-  forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
- forall (e1 e2 : expr) (t2: type) (ch ch' : memory_chunk) (sh : share) (P : LiftEnviron mpred),
+  forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
+ forall (e1 e2 : expr) (t2: type) (ch ch' : memory_chunk) (sh : share) (P : assert),
        (numeric_type (typeof e1) && numeric_type t2)%bool = true ->
        access_mode (typeof e1) = By_value ch ->
        access_mode t2 = By_value ch' ->
        decode_encode_val_ok ch ch' ->
        writable_share sh ->
-       semax Delta
-         (|> (tc_lvalue Delta e1 && tc_expr Delta (Ecast e2 (typeof e1)) &&
-              ((`(mapsto_ sh (typeof e1)) (eval_lvalue e1) 
-                && `(mapsto_ sh t2) (eval_lvalue e1))
-               * P)))
+       semax E Delta
+         (▷ ((tc_lvalue Delta e1 ∧ tc_expr Delta (Ecast e2 (typeof e1))) ∧
+              ((assert_of (`(mapsto_ sh (typeof e1)) (eval_lvalue e1))
+                ∧ assert_of (`(mapsto_ sh t2) (eval_lvalue e1)))
+               ∗ P)))
          (Sassign e1 e2)
          (normal_ret_assert
-            (EX v':val, 
-              andp (local  ((`decode_encode_val )
-                         ((` force_val) ((`(sem_cast (typeof e2) (typeof e1))) (eval_expr e2))) (`ch) (`ch') (`v') ))
-              ((` (mapsto sh t2)) (eval_lvalue e1) (`v') * P))).
+            (∃ v':val,
+              (local  ((`decode_encode_val )
+                         ((` force_val) ((`(sem_cast (typeof e2) (typeof e1))) (eval_expr e2))) (`ch) (`ch') (`v') )) ∧
+              (assert_of ((` (mapsto sh t2)) (eval_lvalue e1) (`v')) ∗ P))).
 Proof.
   intros.
   eapply semax_pre; [| apply semax_store_union_hack_backward].
-  apply (exp_right t2).
-  apply (exp_right ch).
-  apply (exp_right ch').
-  apply (exp_right sh).
-  apply andp_right; [apply prop_right; auto |].
-  apply andp_left2.
-  apply later_derives.
-  apply andp_derives; auto.
-  apply sepcon_derives; auto.
-  apply allp_right; intros v'.
-  apply wand_sepcon_adjoint.
-  rewrite sepcon_comm.
-  apply imp_andp_adjoint.
-  rewrite andp_comm.
-  apply (exp_right v').
-  apply derives_refl.
+  iIntros "(_ & H)"; iExists t2, ch, ch', sh.
+  iSplit; first done.
+  iNext.
+  iApply (bi.and_mono with "H"); first done.
+  iIntros "($ & ?)"; eauto with iFrame.
 Qed.
 
 End StoreUnionHackB2F.
@@ -1153,26 +1015,26 @@ Declare Module CSHL_Def: CLIGHT_SEPARATION_HOARE_LOGIC_DEF.
 
 Import CSHL_Def.
 
-Axiom semax_store_store_union_hack_backward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
-  forall (P: environ->mpred) e1 e2,
-    @semax CS Espec Delta
-       ((EX sh: share, !! writable_share sh &&
-             |> ( (tc_lvalue Delta e1) &&  (tc_expr Delta (Ecast e2 (typeof e1)))  &&
-             ((`(mapsto_ sh (typeof e1)) (eval_lvalue e1)) *
-              (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`force_val (`(sem_cast (typeof e2) (typeof e1)) (eval_expr e2))) -* P))))
-          || (EX (t2:type) (ch ch': memory_chunk) (sh: share),
-             !! ((numeric_type (typeof e1) && numeric_type t2)%bool = true /\
+Axiom semax_store_store_union_hack_backward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
+  forall (P: assert) e1 e2,
+    semax E Delta
+       ((∃ sh: share, ⌜writable_share sh⌝ ∧
+             ▷ ((tc_lvalue Delta e1 ∧ tc_expr Delta (Ecast e2 (typeof e1)))  ∧
+             (assert_of (`(mapsto_ sh (typeof e1)) (eval_lvalue e1)) ∗
+              (assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`force_val (`(sem_cast (typeof e2) (typeof e1)) (eval_expr e2)))) -∗ P))))
+          ∨ (∃ (t2:type) (ch ch': memory_chunk) (sh: share),
+             ⌜(numeric_type (typeof e1) && numeric_type t2)%bool = true /\
                  access_mode (typeof e1) = By_value ch /\
                  access_mode t2 = By_value ch' /\
                  decode_encode_val_ok ch ch' /\
-                 writable_share sh) &&
-             |> ( (tc_lvalue Delta e1) &&  (tc_expr Delta (Ecast e2 (typeof e1)))  &&
-             ((`(mapsto_ sh (typeof e1)) (eval_lvalue e1) 
-                      && `(mapsto_ sh t2) (eval_lvalue e1)) *
-              (ALL v': val,
-                 `(mapsto sh t2) (eval_lvalue e1) (`v') -*
-                    imp (local  ((`decode_encode_val )
-                         ((` force_val) ((`(sem_cast (typeof e2) (typeof e1))) (eval_expr e2))) (`ch) (`ch') (`v') ))
+                 writable_share sh⌝ ∧
+             ▷ ((tc_lvalue Delta e1 ∧ tc_expr Delta (Ecast e2 (typeof e1)))  ∧
+             ((assert_of (`(mapsto_ sh (typeof e1)) (eval_lvalue e1) )
+                      ∧ assert_of (`(mapsto_ sh t2) (eval_lvalue e1))) ∗
+              (∀ v': val,
+                 assert_of (`(mapsto sh t2) (eval_lvalue e1) (`v')) -∗
+                    (local  ((`decode_encode_val )
+                         ((` force_val) ((`(sem_cast (typeof e2) (typeof e1))) (eval_expr e2))) (`ch) (`ch') (`v') )) →
                       (P)))))
        )
         (Sassign e1 e2) (normal_ret_assert P).
@@ -1198,26 +1060,26 @@ Import StoreB.
 Import StoreUnionHackB.
 Import ExtrFacts.
 
-Theorem semax_store_store_union_hack_backward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
-  forall (P: environ->mpred) e1 e2,
-    @semax CS Espec Delta
-       ((EX sh: share, !! writable_share sh &&
-             |> ( (tc_lvalue Delta e1) &&  (tc_expr Delta (Ecast e2 (typeof e1)))  &&
-             ((`(mapsto_ sh (typeof e1)) (eval_lvalue e1)) *
-              (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`force_val (`(sem_cast (typeof e2) (typeof e1)) (eval_expr e2))) -* P))))
-          || (EX (t2:type) (ch ch': memory_chunk) (sh: share),
-             !! ((numeric_type (typeof e1) && numeric_type t2)%bool = true /\
+Theorem semax_store_store_union_hack_backward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
+  forall (P: assert) e1 e2,
+    semax E Delta
+       ((∃ sh: share, ⌜writable_share sh⌝ ∧
+             ▷ ((tc_lvalue Delta e1 ∧ tc_expr Delta (Ecast e2 (typeof e1)))  ∧
+             (assert_of (`(mapsto_ sh (typeof e1)) (eval_lvalue e1)) ∗
+              (assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`force_val (`(sem_cast (typeof e2) (typeof e1)) (eval_expr e2)))) -∗ P))))
+          ∨ (∃ (t2:type) (ch ch': memory_chunk) (sh: share),
+             ⌜(numeric_type (typeof e1) && numeric_type t2)%bool = true /\
                  access_mode (typeof e1) = By_value ch /\
                  access_mode t2 = By_value ch' /\
                  decode_encode_val_ok ch ch' /\
-                 writable_share sh) &&
-             |> ( (tc_lvalue Delta e1) &&  (tc_expr Delta (Ecast e2 (typeof e1)))  &&
-             ((`(mapsto_ sh (typeof e1)) (eval_lvalue e1) 
-                      && `(mapsto_ sh t2) (eval_lvalue e1)) *
-              (ALL v': val,
-                 `(mapsto sh t2) (eval_lvalue e1) (`v') -*
-                    imp (local  ((`decode_encode_val )
-                         ((` force_val) ((`(sem_cast (typeof e2) (typeof e1))) (eval_expr e2))) (`ch) (`ch') (`v') ))
+                 writable_share sh⌝ ∧
+             ▷ ((tc_lvalue Delta e1 ∧ tc_expr Delta (Ecast e2 (typeof e1)))  ∧
+             ((assert_of (`(mapsto_ sh (typeof e1)) (eval_lvalue e1) )
+                      ∧ assert_of (`(mapsto_ sh t2) (eval_lvalue e1))) ∗
+              (∀ v': val,
+                 assert_of (`(mapsto sh t2) (eval_lvalue e1) (`v')) -∗
+                    (local  ((`decode_encode_val )
+                         ((` force_val) ((`(sem_cast (typeof e2) (typeof e1))) (eval_expr e2))) (`ch) (`ch') (`v') )) →
                       (P)))))
        )
         (Sassign e1 e2) (normal_ret_assert P).
@@ -1244,16 +1106,16 @@ Import Conseq.
 Import ConseqFacts.
 Import Sassign.
 
-Theorem semax_store_backward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext) e1 e2 P,
-   @semax CS Espec Delta
-          (EX sh: share, !! writable_share sh && |> ( (tc_lvalue Delta e1) &&  (tc_expr Delta (Ecast e2 (typeof e1)))  &&
-             ((`(mapsto_ sh (typeof e1)) (eval_lvalue e1)) * (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`force_val (`(sem_cast (typeof e2) (typeof e1)) (eval_expr e2))) -* P))))
+Theorem semax_store_backward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext) e1 e2 P,
+   semax E Delta
+          (∃ sh: share, ⌜writable_share sh⌝ ∧ ▷ ((tc_lvalue Delta e1 ∧ tc_expr Delta (Ecast e2 (typeof e1)))  ∧
+             (assert_of (`(mapsto_ sh (typeof e1)) (eval_lvalue e1)) ∗ (assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`force_val (`(sem_cast (typeof e2) (typeof e1)) (eval_expr e2)))) -∗ P))))
           (Sassign e1 e2)
           (normal_ret_assert P).
 Proof.
   intros.
   eapply semax_pre_simple; [| apply semax_store_store_union_hack_backward].
-  apply orp_right1; auto.
+  apply bi.or_intro_l.
 Qed.
 
 End Sassign2Store.
@@ -1273,28 +1135,28 @@ Import ConseqFacts.
 Import Sassign.
 
 Theorem semax_store_union_hack_backward:
- forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext) e1 e2 P,
-   @semax CS Espec Delta
-          (EX (t2:type) (ch ch': memory_chunk) (sh: share),
-             !! ((numeric_type (typeof e1) && numeric_type t2)%bool = true /\
+ forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext) e1 e2 P,
+   semax E Delta
+          (∃ (t2:type) (ch ch': memory_chunk) (sh: share),
+             ⌜(numeric_type (typeof e1) && numeric_type t2)%bool = true /\
                  access_mode (typeof e1) = By_value ch /\
                  access_mode t2 = By_value ch' /\
                  decode_encode_val_ok ch ch' /\
-                 writable_share sh) &&
-             |> ( (tc_lvalue Delta e1) &&  (tc_expr Delta (Ecast e2 (typeof e1)))  &&
-             ((`(mapsto_ sh (typeof e1)) (eval_lvalue e1) 
-                      && `(mapsto_ sh t2) (eval_lvalue e1)) *
-              (ALL v': val,
-                 `(mapsto sh t2) (eval_lvalue e1) (`v') -*
-                    imp (local  ((`decode_encode_val )
-                         ((` force_val) ((`(sem_cast (typeof e2) (typeof e1))) (eval_expr e2))) (`ch) (`ch') (`v') ))
+                 writable_share sh⌝ ∧
+             ▷ ((tc_lvalue Delta e1 ∧ tc_expr Delta (Ecast e2 (typeof e1)))  ∧
+             ((assert_of (`(mapsto_ sh (typeof e1)) (eval_lvalue e1))
+                      ∧ assert_of (`(mapsto_ sh t2) (eval_lvalue e1))) ∗
+              (∀ v': val,
+                 assert_of (`(mapsto sh t2) (eval_lvalue e1) (`v')) -∗
+                    (local  ((`decode_encode_val )
+                         ((` force_val) ((`(sem_cast (typeof e2) (typeof e1))) (eval_expr e2))) (`ch) (`ch') (`v') )) →
                       (P)))))
           (Sassign e1 e2)
           (normal_ret_assert P).
 Proof.
   intros.
   eapply semax_pre_simple; [| apply semax_store_store_union_hack_backward].
-  apply orp_right2; auto.
+  apply bi.or_intro_r.
 Qed.
 
 End Sassign2StoreUnionHack.
@@ -1305,19 +1167,20 @@ Declare Module CSHL_Def: CLIGHT_SEPARATION_HOARE_LOGIC_DEF.
 
 Import CSHL_Def.
 
-Axiom semax_call_forward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
-    forall A P Q NEP NEQ ts x (F: environ -> mpred) ret argsig retsig cc a bl,
+Axiom semax_call_forward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
+    forall A (Ef : dtfr (MaskTT A)) P Q x (F: assert) ret argsig retsig cc a bl,
+           Ef x ⊆ E ->
            Cop.classify_fun (typeof a) =
            Cop.fun_case_f argsig retsig cc ->
            (retsig = Ctypes.Tvoid -> ret = None) ->
           tc_fn_return Delta ret retsig ->
-  @semax CS Espec Delta
-          (((*|>*)((tc_expr Delta a) && (tc_exprlist Delta argsig bl)))  &&
-         (`(func_ptr (mk_funspec  (argsig,retsig) cc A P Q NEP NEQ)) (eval_expr a) &&
-          (|> (F * (fun rho => P ts x (ge_of rho, eval_exprlist argsig bl rho))))))
+  semax E Delta
+          (((*▷*)((tc_expr Delta a) ∧ (tc_exprlist Delta argsig bl)))  ∧
+         (assert_of (`(func_ptr (mk_funspec (argsig,retsig) cc A Ef P Q)) (eval_expr a)) ∗
+          (▷ (F ∗ assert_of (fun rho => P x (ge_of rho, eval_exprlist argsig bl rho))))))
          (Scall ret a bl)
          (normal_ret_assert
-            (EX old:val, substopt ret (`old) F * maybe_retval (Q ts x) retsig ret)).
+            (∃ old:val, assert_of (substopt ret (`old) F) ∗ maybe_retval (assert_of (Q x)) retsig ret)).
 
 End CLIGHT_SEPARATION_HOARE_LOGIC_CALL_FORWARD.
 
@@ -1327,23 +1190,31 @@ Declare Module CSHL_Def: CLIGHT_SEPARATION_HOARE_LOGIC_DEF.
 
 Import CSHL_Def.
 
-Axiom semax_call_backward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
+Axiom semax_call_backward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
     forall ret a bl R,
-  @semax CS Espec Delta
-         (EX argsig: _, EX retsig: _, EX cc: _,
-          EX A: _, EX P: _, EX Q: _, EX NEP: _, EX NEQ: _, EX ts: _, EX x: _,
-         !! (Cop.classify_fun (typeof a) =
+  semax E Delta
+         (∃ argsig: _, ∃ retsig: _, ∃ cc: _,
+          ∃ A: _, ∃ Ef : dtfr (MaskTT A), ∃ P: _, ∃ Q: _, ∃ x: _,
+         ⌜Ef x ⊆ E /\ Cop.classify_fun (typeof a) =
              Cop.fun_case_f argsig retsig cc /\
              (retsig = Ctypes.Tvoid -> ret = None) /\
-             tc_fn_return Delta ret retsig) &&
-          ((*|>*)((tc_expr Delta a) && (tc_exprlist Delta argsig bl)))  &&
-         `(func_ptr (mk_funspec  (argsig,retsig) cc A P Q NEP NEQ)) (eval_expr a) &&
-          |>((fun rho => (P ts x (ge_of rho, eval_exprlist argsig bl rho))) * oboxopt Delta ret (maybe_retval (Q ts x) retsig ret -* R)))
+             tc_fn_return Delta ret retsig⌝ ∧
+          ((*▷*)((tc_expr Delta a) ∧ (tc_exprlist Delta argsig bl)))  ∧
+         assert_of (`(func_ptr (mk_funspec  (argsig,retsig) cc A Ef P Q)) (eval_expr a)) ∗
+          ▷(assert_of (fun rho => (P x (ge_of rho, eval_exprlist argsig bl rho))) ∗ oboxopt Delta ret (maybe_retval (assert_of (Q x)) retsig ret -∗ R)))
          (Scall ret a bl)
          (normal_ret_assert R).
 
 End CLIGHT_SEPARATION_HOARE_LOGIC_CALL_BACKWARD.
 
+Lemma fn_return_temp_guard : forall `{!VSTGS OK_ty Σ} Delta ret retsig, tc_fn_return Delta ret retsig ->
+  temp_guard_opt Delta ret.
+Proof.
+  destruct ret; auto; simpl.
+  rewrite /temp_guard.
+  destruct (_ !! _); done.
+Qed.
+
 Module CallF2B
        (Def: CLIGHT_SEPARATION_HOARE_LOGIC_DEF)
        (Conseq: CLIGHT_SEPARATION_HOARE_LOGIC_CONSEQUENCE with Module CSHL_Def := Def)
@@ -1361,18 +1232,18 @@ Import Extr.
 Import ExtrFacts.
 Import CallF.
   
-Theorem semax_call_backward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
+Theorem semax_call_backward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
     forall ret a bl R,
-  @semax CS Espec Delta
-         (EX argsig: _, EX retsig: _, EX cc: _,
-          EX A: _, EX P: _, EX Q: _, EX NEP: _, EX NEQ: _, EX ts: _, EX x: _,
-         !! (Cop.classify_fun (typeof a) =
+  semax E Delta
+         (∃ argsig: _, ∃ retsig: _, ∃ cc: _,
+          ∃ A: _, ∃ Ef : dtfr (MaskTT A), ∃ P: _, ∃ Q: _, ∃ x: _,
+         ⌜Ef x ⊆ E /\ Cop.classify_fun (typeof a) =
              Cop.fun_case_f argsig retsig cc /\
              (retsig = Ctypes.Tvoid -> ret = None) /\
-             tc_fn_return Delta ret retsig) &&
-          ((*|>*)((tc_expr Delta a) && (tc_exprlist Delta argsig bl)))  &&
-         `(func_ptr (mk_funspec  (argsig,retsig) cc A P Q NEP NEQ)) (eval_expr a) &&
-          |>((fun rho => P ts x (ge_of rho, eval_exprlist argsig bl rho)) * oboxopt Delta ret (maybe_retval (Q ts x) retsig ret -* R)))
+             tc_fn_return Delta ret retsig⌝ ∧
+          ((*▷*)((tc_expr Delta a) ∧ (tc_exprlist Delta argsig bl)))  ∧
+         assert_of (`(func_ptr (mk_funspec (argsig,retsig) cc A Ef P Q)) (eval_expr a)) ∗
+          ▷(assert_of (fun rho => P x (ge_of rho, eval_exprlist argsig bl rho)) ∗ oboxopt Delta ret (maybe_retval (assert_of (Q x)) retsig ret -∗ R)))
          (Scall ret a bl)
          (normal_ret_assert R).
 Proof.
@@ -1381,30 +1252,20 @@ Proof.
   apply semax_extract_exists; intro retsig.
   apply semax_extract_exists; intro cc.
   apply semax_extract_exists; intro A.
+  apply semax_extract_exists; intro Ef.
   apply semax_extract_exists; intro P.
   apply semax_extract_exists; intro Q.
-  apply semax_extract_exists; intro NEP.
-  apply semax_extract_exists; intro NEQ.
-  apply semax_extract_exists; intro ts.
   apply semax_extract_exists; intro x.
-  rewrite !andp_assoc.
-  apply semax_extract_prop; intros [? [? ?]].
-  eapply semax_pre_post'; [.. | apply semax_call_forward; auto].
-  + apply andp_left2. rewrite andp_assoc.
-    apply andp_derives; [apply derives_refl |].
-    apply andp_derives; [apply derives_refl |].
-    apply andp_derives; [apply derives_refl |].
-    apply later_derives.
-    rewrite sepcon_comm.
-    apply derives_refl.
-  + unfold RA_normal, normal_ret_assert.
-    rewrite <- exp_sepcon1.
-    rewrite <- corable_andp_sepcon1 by (intro; apply corable_prop).
-    rewrite wand_sepcon_adjoint.
-    rewrite exp_andp2; apply exp_left; intros old.
+  apply semax_extract_prop; intros (? & ? & ? & ?).
+  eapply semax_pre_post'; [.. | apply (semax_call_forward _ _ _ Ef); auto].
+  + rewrite bi.and_elim_r; apply bi.and_mono; first done; apply bi.sep_mono; first done.
+    apply bi.later_mono.
+    rewrite comm //.
+  + iIntros "(TC & % & H & ?)".
     rewrite substopt_oboxopt.
-    apply oboxopt_T.
-    destruct ret; hnf in H1 |- *; [destruct ((temp_types Delta) ! i) |]; auto; congruence.
+    iPoseProof (oboxopt_T with "[TC $H]") as "H"; auto; last by iApply "H".
+    by eapply fn_return_temp_guard.
+  + auto.
   + auto.
   + auto.
   + auto.
@@ -1425,19 +1286,19 @@ Import Conseq.
 Import ConseqFacts.
 Import CallB.
 (*
-Theorem semax_call_forward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
-    forall A P Q NEP NEQ ts x (F: environ -> mpred) ret argsig retsig cc a bl,
+Theorem semax_call_forward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
+    forall A P Q ts x (F: assert) ret argsig retsig cc a bl,
            Cop.classify_fun (typeof a) =
            Cop.fun_case_f (type_of_params argsig) retsig cc ->
            (retsig = Tvoid -> ret = None) ->
           tc_fn_return Delta ret retsig ->
-  @semax CS Espec Delta
-          ((|>((tc_expr Delta a) && (tc_exprlist Delta (snd (split argsig)) bl)))  &&
-         (`(func_ptr (mk_funspec  (argsig,retsig) cc A P Q NEP NEQ)) (eval_expr a) &&
-          |>(F * `(P ts x: environ -> mpred) (make_args' (argsig,retsig) (eval_exprlist (snd (split argsig)) bl)))))
+  semax E Delta
+          ((▷((tc_expr Delta a) ∧ (tc_exprlist Delta (snd (split argsig)) bl)))  ∧
+         (`(func_ptr E (mk_funspec  (argsig,retsig) cc A P Q)) (eval_expr a) ∧
+          ▷(F ∗ `(P ts x: assert) (make_args' (argsig,retsig) (eval_exprlist (snd (split argsig)) bl)))))
          (Scall ret a bl)
          (normal_ret_assert
-            (EX old:val, substopt ret (`old) F * maybe_retval (Q ts x) retsig ret)).
+            (∃ old:val, substopt ret (`old) F ∗ maybe_retval (Q ts x) retsig ret)).
 Proof.
   intros.
   eapply semax_pre; [| apply semax_call_backward].
@@ -1455,57 +1316,44 @@ Proof.
   rewrite sepcon_comm.
   apply sepcon_derives; auto.
   eapply derives_trans; [apply (odiaopt_D _ ret) |].
-    1: destruct ret; hnf in H1 |- *; [destruct ((temp_types Delta) ! i) |]; auto; congruence.
+    1: destruct ret; hnf in H1 |- *; [destruct ((temp_types Delta) !! i) |]; auto; congruence.
   rewrite <- oboxopt_odiaopt.
-    2: destruct ret; hnf in H1 |- *; [destruct ((temp_types Delta) ! i) |]; auto; congruence.
+    2: destruct ret; hnf in H1 |- *; [destruct ((temp_types Delta) !! i) |]; auto; congruence.
   apply oboxopt_K.
   rewrite <- wand_sepcon_adjoint.
   rewrite <- exp_sepcon1.
   apply sepcon_derives; auto.
-  apply odiaopt_derives_EX_substopt.
+  apply odiaopt_derives_∃_substopt.
 Qed.
 *)
-Theorem semax_call_forward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
-    forall A P Q NEP NEQ ts x (F: environ -> mpred) ret argsig retsig cc a bl,
+Theorem semax_call_forward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
+    forall A (Ef : dtfr (MaskTT A)) P Q x (F: assert) ret argsig retsig cc a bl,
+           Ef x ⊆ E ->
            Cop.classify_fun (typeof a) =
-             Cop.fun_case_f argsig retsig cc ->
+           Cop.fun_case_f argsig retsig cc ->
            (retsig = Ctypes.Tvoid -> ret = None) ->
           tc_fn_return Delta ret retsig ->
-  @semax CS Espec Delta
-          (((*|>*)((tc_expr Delta a) && (tc_exprlist Delta argsig bl)))  &&
-         (`(func_ptr (mk_funspec  (argsig,retsig) cc A P Q NEP NEQ)) (eval_expr a) &&
-          |>(F * (fun rho => P ts x (ge_of rho, eval_exprlist argsig bl rho))))) 
+  semax E Delta
+          (((*▷*)((tc_expr Delta a) ∧ (tc_exprlist Delta argsig bl)))  ∧
+         (assert_of (`(func_ptr (mk_funspec  (argsig,retsig) cc A Ef P Q)) (eval_expr a)) ∗
+          (▷ (F ∗ assert_of (fun rho => P x (ge_of rho, eval_exprlist argsig bl rho))))))
          (Scall ret a bl)
          (normal_ret_assert
-            (EX old:val, substopt ret (`old) F * maybe_retval (Q ts x) retsig ret)).
+            (∃ old:val, assert_of (substopt ret (`old) F) ∗ maybe_retval (assert_of (Q x)) retsig ret)).
 Proof.
   intros.
   eapply semax_pre; [| apply semax_call_backward].
-  apply (exp_right argsig), (exp_right retsig), (exp_right cc), (exp_right A), (exp_right P), (exp_right Q), (exp_right NEP), (exp_right NEQ), (exp_right ts), (exp_right x).
-  rewrite !andp_assoc.
-  apply andp_right; [apply prop_right; auto |].
-  apply andp_right; [solve_andp |].
-  apply andp_right; [solve_andp |]. 
-  rewrite andp_comm, imp_andp_adjoint.
-  apply andp_left2.
-  apply andp_left2.
-  rewrite <- imp_andp_adjoint, andp_comm.
-  apply andp_right. solve_andp. 
-  rewrite andp_comm, imp_andp_adjoint. apply andp_left2.
-  rewrite <- imp_andp_adjoint, andp_comm.
-  apply later_left2.
-  rewrite <- corable_andp_sepcon1 by (intro; apply corable_prop).
-  rewrite sepcon_comm.
-  apply sepcon_derives; auto.
-  eapply derives_trans; [apply (odiaopt_D _ ret) |].
-    1: destruct ret; hnf in H1 |- *; [destruct ((temp_types Delta) ! i) |]; auto; congruence.
-  rewrite <- oboxopt_odiaopt.
-    2: destruct ret; hnf in H1 |- *; [destruct ((temp_types Delta) ! i) |]; auto; congruence.
-  apply oboxopt_K.
-  rewrite <- wand_sepcon_adjoint.
-  rewrite <- exp_sepcon1.
-  apply sepcon_derives; auto.
-  apply odiaopt_derives_EX_substopt.
+  iIntros "(#? & H)"; iExists argsig, retsig, cc, A, Ef, P, Q, x.
+  iSplit; first done.
+  iSplit; first by rewrite bi.and_elim_l.
+  rewrite bi.and_elim_r; iDestruct "H" as "($ & H)".
+  iNext; iDestruct "H" as "(F & $)".
+  assert (temp_guard_opt Delta ret) by (eapply fn_return_temp_guard; done).
+  iPoseProof (odiaopt_D _ ret F with "[$F]") as "H"; first done; auto.
+  rewrite -oboxopt_odiaopt //.
+  iApply (oboxopt_K with "H").
+  iIntros "? $".
+  by iApply odiaopt_derives_EX_substopt.
 Qed.
 
 End CallB2F.
@@ -1516,16 +1364,16 @@ Declare Module CSHL_Def: CLIGHT_SEPARATION_HOARE_LOGIC_DEF.
 
 Import CSHL_Def.
 
-Axiom semax_set_forward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
-  forall (P: environ->mpred) id e,
-    @semax CS Espec Delta
-        (|> ( (tc_expr Delta e) &&
-             (tc_temp_id id (typeof e) Delta e) &&
+Axiom semax_set_forward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
+  forall (P: assert) id e,
+    semax E Delta
+        (▷ ( (tc_expr Delta e) ∧
+             (tc_temp_id id (typeof e) Delta e) ∧
           P))
           (Sset id e)
         (normal_ret_assert
-          (EX old:val, local (`eq (eval_id id) (subst id (`old) (eval_expr e))) &&
-                            subst id (`old) P)).
+          (∃ old:val, local (`eq (eval_id id) (subst id (`old) (eval_expr e))) ∧
+                            assert_of (subst id (`old) P))).
 
 End CLIGHT_SEPARATION_HOARE_LOGIC_SET_FORWARD.
 
@@ -1535,12 +1383,12 @@ Declare Module CSHL_Def: CLIGHT_SEPARATION_HOARE_LOGIC_DEF.
 
 Import CSHL_Def.
 
-Axiom semax_set_backward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
-  forall (P: environ->mpred) id e,
-    @semax CS Espec Delta
-        (|> ( (tc_expr Delta e) &&
-             (tc_temp_id id (typeof e) Delta e) &&
-             subst id (eval_expr e) P))
+Axiom semax_set_backward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
+  forall (P: assert) id e,
+    semax E Delta
+        (▷ ( (tc_expr Delta e) ∧
+             (tc_temp_id id (typeof e) Delta e) ∧
+             assert_of (subst id (eval_expr e) P)))
           (Sset id e) (normal_ret_assert P).
 
 End CLIGHT_SEPARATION_HOARE_LOGIC_SET_BACKWARD.
@@ -1551,19 +1399,19 @@ Declare Module CSHL_Def: CLIGHT_SEPARATION_HOARE_LOGIC_DEF.
 
 Import CSHL_Def.
 
-Axiom semax_load_forward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
+Axiom semax_load_forward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
   forall  sh id P e1 t2 (v2: val),
     typeof_temp Delta id = Some t2 ->
     is_neutral_cast (typeof e1) t2 = true ->
     readable_share sh ->
-    (local (tc_environ Delta) && P |-- `(mapsto sh (typeof e1)) (eval_lvalue e1) (` v2) * TT) ->
-    @semax CS Espec Delta
-       (|> ( (tc_lvalue Delta e1) &&
-       local (`(tc_val (typeof e1) v2)) &&
+    (local (tc_environ Delta) ∧ P ⊢ <absorb> assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (` v2))) ->
+    semax E Delta
+       (▷ (tc_lvalue Delta e1 ∧
+       ⌜tc_val (typeof e1) v2⌝ ∧
           P))
        (Sset id e1)
-       (normal_ret_assert (EX old:val, local (`eq (eval_id id) (` v2)) &&
-                                          (subst id (`old) P))).
+       (normal_ret_assert (∃ old:val, local (`eq (eval_id id) (` v2)) ∧
+                                          (assert_of (subst id (`old) P)))).
 
 End CLIGHT_SEPARATION_HOARE_LOGIC_LOAD_FORWARD.
 
@@ -1573,17 +1421,17 @@ Declare Module CSHL_Def: CLIGHT_SEPARATION_HOARE_LOGIC_DEF.
 
 Import CSHL_Def.
 
-Axiom semax_load_backward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
-  forall (P: environ->mpred) id e1,
-    @semax CS Espec Delta
-        (EX sh: share, EX t2: type, EX v2: val,
-              !! (typeof_temp Delta id = Some t2 /\
+Axiom semax_load_backward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
+  forall (P: assert) id e1,
+    semax E Delta
+        (∃ sh: share, ∃ t2: type, ∃ v2: val,
+              ⌜typeof_temp Delta id = Some t2 /\
                   is_neutral_cast (typeof e1) t2 = true /\
-                  readable_share sh) &&
-         |> ( (tc_lvalue Delta e1) &&
-              local (`(tc_val (typeof e1) v2)) &&
-              (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2) * TT) &&
-              subst id (`v2) P))
+                  readable_share sh⌝ ∧
+         ▷ ((tc_lvalue Delta e1 ∧
+              ⌜tc_val (typeof e1) v2⌝ ∧
+              (<absorb> assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2)))) ∧
+              assert_of (subst id (`v2) P)))
         (Sset id e1) (normal_ret_assert P).
 
 End CLIGHT_SEPARATION_HOARE_LOGIC_LOAD_BACKWARD.
@@ -1594,19 +1442,19 @@ Declare Module CSHL_Def: CLIGHT_SEPARATION_HOARE_LOGIC_DEF.
 
 Import CSHL_Def.
 
-Axiom semax_cast_load_forward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
+Axiom semax_cast_load_forward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
   forall sh id P e1 t1 (v2: val),
     typeof_temp Delta id = Some t1 ->
    cast_pointer_to_bool (typeof e1) t1 = false ->
     readable_share sh ->
-    (local (tc_environ Delta) && P |-- `(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2) * TT) ->
-    @semax CS Espec Delta
-       (|> ( (tc_lvalue Delta e1) &&
-       local (`(tc_val t1) (`(eval_cast (typeof e1) t1 v2))) &&
+    (local (tc_environ Delta) ∧ P ⊢ <absorb> assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2))) ->
+    semax E Delta
+       (▷ ( (tc_lvalue Delta e1) ∧
+       local (`(tc_val t1) (`(eval_cast (typeof e1) t1 v2))) ∧
           P))
        (Sset id (Ecast e1 t1))
-       (normal_ret_assert (EX old:val, local (`eq (eval_id id) (subst id (`old) (`(eval_cast (typeof e1) t1 v2)))) &&
-                                          (subst id (`old) P))).
+       (normal_ret_assert (∃ old:val, local (`eq (eval_id id) (subst id (`old) (`(eval_cast (typeof e1) t1 v2)))) ∧
+                                          (assert_of (subst id (`old) P)))).
 
 End CLIGHT_SEPARATION_HOARE_LOGIC_CAST_LOAD_FORWARD.
 
@@ -1616,18 +1464,18 @@ Declare Module CSHL_Def: CLIGHT_SEPARATION_HOARE_LOGIC_DEF.
 
 Import CSHL_Def.
 
-Axiom semax_cast_load_backward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
-  forall (P: environ->mpred) id e,
-    @semax CS Espec Delta
-        (EX sh: share, EX e1: expr, EX t1: type, EX v2: val,
-              !! (e = Ecast e1 t1 /\
+Axiom semax_cast_load_backward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
+  forall (P: assert) id e,
+    semax E Delta
+        (∃ sh: share, ∃ e1: expr, ∃ t1: type, ∃ v2: val,
+              ⌜e = Ecast e1 t1 /\
                   typeof_temp Delta id = Some t1 /\
                   cast_pointer_to_bool (typeof e1) t1 = false /\
-                  readable_share sh) &&
-         |> ( (tc_lvalue Delta e1) &&
-              local (`(tc_val t1) (`(eval_cast (typeof e1) t1 v2))) &&
-              (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2) * TT) &&
-              subst id (`(force_val (sem_cast (typeof e1) t1 v2))) P))
+                  readable_share sh⌝ ∧
+         ▷ ( (tc_lvalue Delta e1) ∧
+              local (`(tc_val t1) (`(eval_cast (typeof e1) t1 v2))) ∧
+              (<absorb> assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2))) ∧
+              assert_of (subst id (`(force_val (sem_cast (typeof e1) t1 v2))) P)))
         (Sset id e) (normal_ret_assert P).
 
 End CLIGHT_SEPARATION_HOARE_LOGIC_CAST_LOAD_BACKWARD.
@@ -1649,17 +1497,17 @@ Import Extr.
 Import ExtrFacts.
 Import LoadF.
 
-Theorem semax_load_backward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
-  forall (P: environ->mpred) id e1,
-    @semax CS Espec Delta
-        (EX sh: share, EX t2: type, EX v2: val,
-              !! (typeof_temp Delta id = Some t2 /\
+Theorem semax_load_backward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
+  forall (P: assert) id e1,
+    semax E Delta
+        (∃ sh: share, ∃ t2: type, ∃ v2: val,
+              ⌜typeof_temp Delta id = Some t2 /\
                   is_neutral_cast (typeof e1) t2 = true /\
-                  readable_share sh) &&
-         |> ( (tc_lvalue Delta e1) &&
-              local (`(tc_val (typeof e1) v2)) &&
-              (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2) * TT) &&
-              subst id (`v2) P))
+                  readable_share sh⌝ ∧
+         ▷ ((tc_lvalue Delta e1 ∧
+              ⌜tc_val (typeof e1) v2⌝ ∧
+              (<absorb> assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2)))) ∧
+              assert_of (subst id (`v2) P)))
         (Sset id e1) (normal_ret_assert P).
 Proof.
   intros.
@@ -1667,18 +1515,15 @@ Proof.
   apply semax_extract_exists; intro t2.
   apply semax_extract_exists; intro v2.
   apply semax_extract_prop; intros [? [? ?]].
-  rewrite (andp_assoc _ _ (subst _ _ _)).
-  eapply semax_post'; [.. | eapply semax_load_forward; eauto].
-  + rewrite exp_andp2.
-    apply exp_left; intros old.
-    autorewrite with subst.
-    apply derives_trans with (local (tc_environ Delta) && (local ((` eq) (eval_id id) (` v2))) && subst id (` v2) P); [solve_andp |].
-    intro rho; unfold local, lift1; unfold_lift; simpl.
-    unfold typeof_temp in H.
-    destruct ((temp_types Delta) ! id) eqn:?H; inv H.
-    normalize.
-    erewrite subst_self by eauto; auto.
-  + solve_andp.
+  eapply semax_pre_post', semax_load_forward; eauto.
+  + rewrite bi.and_elim_r -!assoc //.
+  + split => rho; rewrite /subst; monPred.unseal.
+    iIntros "(%TC & % & % & ?)"; super_unfold_lift; subst.
+    rewrite bi.and_elim_r.
+    unfold typeof_temp in H; destruct (_ !! _) eqn: Ht; last done.
+    erewrite <- (subst_self P _ _ _ _ rho); try done.
+    rewrite /subst env_set_env_set //.
+  + rewrite bi.and_elim_r bi.and_elim_l //.
 Qed.
 
 End LoadF2B.
@@ -1696,45 +1541,35 @@ Import Conseq.
 Import ConseqFacts.
 Import LoadB.
 
-Theorem semax_load_forward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
+Theorem semax_load_forward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
   forall  sh id P e1 t2 (v2: val),
     typeof_temp Delta id = Some t2 ->
     is_neutral_cast (typeof e1) t2 = true ->
     readable_share sh ->
-    (local (tc_environ Delta) && P |-- `(mapsto sh (typeof e1)) (eval_lvalue e1) (` v2) * TT) ->
-    @semax CS Espec Delta
-       (|> ( (tc_lvalue Delta e1) &&
-       local (`(tc_val (typeof e1) v2)) &&
+    (local (tc_environ Delta) ∧ P ⊢ <absorb> assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (` v2))) ->
+    semax E Delta
+       (▷ ( (tc_lvalue Delta e1) ∧
+       ⌜tc_val (typeof e1) v2⌝ ∧
           P))
        (Sset id e1)
-       (normal_ret_assert (EX old:val, local (`eq (eval_id id) (` v2)) &&
-                                          (subst id (`old) P))).
+       (normal_ret_assert (∃ old:val, local (`eq (eval_id id) (` v2)) ∧
+                                          (assert_of (subst id (`old) P)))).
 Proof.
   intros.
   eapply semax_pre; [| apply semax_load_backward].
-  apply (exp_right sh).
-  apply (exp_right t2).
-  apply (exp_right v2).
-  apply andp_right; [apply prop_right; auto |].
-  apply later_ENTAIL.
-  rewrite (andp_assoc _ _ (subst _ _ _)).
-  apply andp_ENTAIL; [apply ENTAIL_refl |].
-  apply andp_right; auto.
-  rewrite subst_exp.
-  intros rho.
-  change (local (tc_environ Delta) rho && P rho
-  |-- EX b : val,
-       subst id (` v2) (local ((` eq) (eval_id id) (` v2)) && subst id (` b) P) rho).
-  apply (exp_right (eval_id id rho)).
-  autorewrite with subst.
-  unfold local, lift1; unfold_lift; simpl.
-  unfold typeof_temp in H.
-  destruct ((temp_types Delta) ! id) eqn:?H; inv H.
-  normalize.
-  apply andp_right; [| erewrite subst_self by eauto; auto].
-  apply prop_right.
-  unfold subst.
-  apply eval_id_same.
+  iIntros "(#? & H)"; iExists sh, t2, v2.
+  iSplit; first done.
+  iNext.
+  rewrite -!assoc; iSplit; first rewrite bi.and_elim_l //; rewrite bi.and_elim_r.
+  iSplit; first rewrite bi.and_elim_l //; rewrite bi.and_elim_r.
+  iSplit; first (iApply H2; iFrame; auto).
+  iStopProof; split => rho; rewrite /subst /local; monPred.unseal.
+  rewrite monPred_at_intuitionistically.
+  iIntros "(% & ?)"; iExists (eval_id id rho).
+  iSplit; first by iPureIntro; apply eval_id_same.
+  unfold typeof_temp in H; destruct (_ !! _) eqn: Ht; last done.
+  erewrite <- (subst_self P _ _ _ _ rho); try done.
+  rewrite /subst env_set_env_set //.
 Qed.
 
 End LoadB2F.
@@ -1756,18 +1591,18 @@ Import Extr.
 Import ExtrFacts.
 Import CastLoadF.
 
-Theorem semax_cast_load_backward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
-  forall (P: environ->mpred) id e,
-    @semax CS Espec Delta
-        (EX sh: share, EX e1: expr, EX t1: type, EX v2: val,
-              !! (e = Ecast e1 t1 /\
+Theorem semax_cast_load_backward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
+  forall (P: assert) id e,
+    semax E Delta
+        (∃ sh: share, ∃ e1: expr, ∃ t1: type, ∃ v2: val,
+              ⌜e = Ecast e1 t1 /\
                   typeof_temp Delta id = Some t1 /\
                   cast_pointer_to_bool (typeof e1) t1 = false /\
-                  readable_share sh) &&
-         |> ( (tc_lvalue Delta e1) &&
-              local (`(tc_val t1) (`(eval_cast (typeof e1) t1 v2))) &&
-              (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2) * TT) &&
-              subst id (`(force_val (sem_cast (typeof e1) t1 v2))) P))
+                  readable_share sh⌝ ∧
+         ▷ ( (tc_lvalue Delta e1) ∧
+              local (`(tc_val t1) (`(eval_cast (typeof e1) t1 v2))) ∧
+              (<absorb> assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2))) ∧
+              assert_of (subst id (`(force_val (sem_cast (typeof e1) t1 v2))) P)))
         (Sset id e) (normal_ret_assert P).
 Proof.
   intros.
@@ -1777,18 +1612,14 @@ Proof.
   apply semax_extract_exists; intro v2.
   apply semax_extract_prop; intros [He [? [? ?]]].
   subst e.
-  rewrite (andp_assoc _ _ (subst _ _ _)).
   eapply semax_post'; [.. | eapply semax_cast_load_forward; eauto].
-  + rewrite exp_andp2.
-    apply exp_left; intros old.
-    autorewrite with subst.
-    apply derives_trans with (local (tc_environ Delta) && (local ((` eq) (eval_id id) (subst id (` old) ((` (eval_cast (typeof e1) t2)) (` v2))))) && subst id (`(force_val (sem_cast (typeof e1) t2 v2))) P); [solve_andp |].
-    intro rho; unfold local, lift1; unfold_lift; simpl.
-    unfold typeof_temp in H.
-    destruct ((temp_types Delta) ! id) eqn:?H; inv H.
-    normalize.
-    erewrite subst_self by eauto; auto.
-  + solve_andp.
+  + split => rho; rewrite /subst; monPred.unseal.
+    iIntros "(%TC & % & % & ?)"; super_unfold_lift; subst.
+    rewrite bi.and_elim_r.
+    unfold typeof_temp in H; destruct (_ !! _) eqn: Ht; last done.
+    erewrite <- (subst_self P _ _ _ _ rho); try done.
+    rewrite /subst env_set_env_set H2 //.
+  + rewrite bi.and_elim_r bi.and_elim_l //.
 Qed.
 
 End CastLoadF2B.
@@ -1806,50 +1637,44 @@ Import Conseq.
 Import ConseqFacts.
 Import CastLoadB.
 
-Theorem semax_cast_load_forward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
+Theorem semax_cast_load_forward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
   forall sh id P e1 t1 (v2: val),
     typeof_temp Delta id = Some t1 ->
    cast_pointer_to_bool (typeof e1) t1 = false ->
     readable_share sh ->
-    (local (tc_environ Delta) && P |-- `(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2) * TT) ->
-    @semax CS Espec Delta
-       (|> ( (tc_lvalue Delta e1) &&
-       local (`(tc_val t1) (`(eval_cast (typeof e1) t1 v2))) &&
+    (local (tc_environ Delta) ∧ P ⊢ <absorb> assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2))) ->
+    semax E Delta
+       (▷ ( (tc_lvalue Delta e1) ∧
+       local (`(tc_val t1) (`(eval_cast (typeof e1) t1 v2))) ∧
           P))
        (Sset id (Ecast e1 t1))
-       (normal_ret_assert (EX old:val, local (`eq (eval_id id) (subst id (`old) (`(eval_cast (typeof e1) t1 v2)))) &&
-                                          (subst id (`old) P))).
+       (normal_ret_assert (∃ old:val, local (`eq (eval_id id) (subst id (`old) (`(eval_cast (typeof e1) t1 v2)))) ∧
+                                          (assert_of (subst id (`old) P)))).
 Proof.
   intros.
   eapply semax_pre; [| apply semax_cast_load_backward].
-  apply (exp_right sh).
-  apply (exp_right e1).
-  apply (exp_right t1).
-  apply (exp_right v2).
-  apply andp_right; [apply prop_right; auto |].
-  apply later_ENTAIL.
-  rewrite (andp_assoc _ _ (subst _ _ _)).
-  apply andp_ENTAIL; [apply ENTAIL_refl |].
-  apply andp_right; auto.
-  rewrite subst_exp.
-  intros rho.
-  change (local (tc_environ Delta) rho && P rho
-  |-- EX b : val,
-       subst id (` (force_val (sem_cast (typeof e1) t1 v2))) (local ((` eq) (eval_id id) (subst id (` b) (` (eval_cast (typeof e1) t1 v2)))) && subst id (` b) P) rho).
-  apply (exp_right (eval_id id rho)).
-  autorewrite with subst.
-  unfold local, lift1; unfold_lift; simpl.
-  unfold typeof_temp in H.
-  destruct ((temp_types Delta) ! id) eqn:?H; inv H.
-  normalize.
-  apply andp_right; [| erewrite subst_self by eauto; auto].
-  apply prop_right.
-  unfold subst.
-  apply eval_id_same.
+  iIntros "(#? & ?)"; iExists sh, e1, t1, v2.
+  iSplit; first done.
+  iNext.
+  iSplit; first rewrite bi.and_elim_l //; rewrite bi.and_elim_r.
+  iSplit; first rewrite bi.and_elim_l //; rewrite bi.and_elim_r.
+  iSplit; first by iApply H2; iFrame; auto.
+  iStopProof; split => rho; rewrite /subst /local; monPred.unseal.
+  rewrite monPred_at_intuitionistically.
+  iIntros "(%TC & ?)"; super_unfold_lift; subst.
+  iExists (eval_id id rho); iSplit; first by rewrite eval_id_same.
+  rewrite env_set_env_set.
+  unfold typeof_temp in H; destruct (_ !! _) eqn: Ht; last done.
+  erewrite env_set_eval_id; done.
 Qed.
 
 End CastLoadB2F.
 
+Lemma denote_tc_assert_False: forall `{!heapGS Σ} {CS: compspecs} X, assert_of (denote_tc_assert (tc_FF X)) ⊣⊢ False.
+Proof.
+  intros; split => rho; monPred.unseal; done.
+Qed.
+
 Module SetF2B
        (Def: CLIGHT_SEPARATION_HOARE_LOGIC_DEF)
        (Conseq: CLIGHT_SEPARATION_HOARE_LOGIC_CONSEQUENCE with Module CSHL_Def := Def)
@@ -1867,42 +1692,28 @@ Import Extr.
 Import ExtrFacts.
 Import SetF.
 
-Theorem semax_set_backward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
-  forall (P: environ->mpred) id e,
-    @semax CS Espec Delta
-        (|> ( (tc_expr Delta e) &&
-             (tc_temp_id id (typeof e) Delta e) &&
-             subst id (eval_expr e) P))
+Theorem semax_set_backward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
+  forall (P: assert) id e,
+    semax E Delta
+        (▷ ( (tc_expr Delta e) ∧
+             (tc_temp_id id (typeof e) Delta e) ∧
+             assert_of (subst id (eval_expr e) P)))
           (Sset id e) (normal_ret_assert P).
 Proof.
   intros.
-  apply semax_pre with (|> (!! (exists t, ((temp_types Delta) ! id = Some t)) && (tc_expr Delta e && tc_temp_id id (typeof e) Delta e && subst id (eval_expr e) P))).
-  {
-    apply later_ENTAIL.
-    apply andp_right; [| solve_andp].
+  apply semax_pre with (▷ (⌜exists t, ((temp_types Delta) !! id = Some t)%maps⌝ ∧ (tc_expr Delta e ∧ tc_temp_id id (typeof e) Delta e ∧ assert_of (subst id (eval_expr e) P)))).
+  { apply later_ENTAIL.
+    iIntros "H"; iSplit; last rewrite bi.and_elim_r //.
     unfold tc_temp_id, typecheck_temp_id.
-    destruct ((temp_types Delta) ! id).
-    + apply prop_right; eauto.
-    + simpl denote_tc_assert.
-      normalize.
-  }
-  apply semax_pre with (|> (tc_expr Delta e && tc_temp_id id (typeof e) Delta e && (!! (exists t, ((temp_types Delta) ! id = Some t)) && subst id (eval_expr e) P))).
-  {
-    apply later_ENTAIL.
-    solve_andp.
-  }
+    destruct ((temp_types Delta) !! id); first eauto.
+    rewrite denote_tc_assert_False; iDestruct "H" as "(_ & _ & [] & _)". }
+  apply semax_pre with (▷ (tc_expr Delta e ∧ tc_temp_id id (typeof e) Delta e ∧ (⌜exists t, ((temp_types Delta) !! id = Some t)%maps⌝ ∧ assert_of (subst id (eval_expr e) P)))).
+  { apply later_ENTAIL.
+    iIntros "(_ & $ & $)". }
   eapply semax_post'; [.. | eapply semax_set_forward; eauto].
-  rewrite exp_andp2.
-  apply exp_left; intros old.
-  autorewrite with subst.
-  normalize.
-  destruct H as [t ?].
-  apply derives_trans with (local (tc_environ Delta) && (local ((` eq) (eval_id id) (subst id (` old) (eval_expr e)))) && subst id (` old) (subst id (eval_expr e) P)); [solve_andp |].
-  set (v := `old).
-  intro rho; unfold local, lift1; unfold_lift; simpl; subst v.
-  normalize.
-  rewrite resubst_full.
-  erewrite subst_self; eauto.
+  split => rho; rewrite /subst /local /lift1; monPred.unseal; unfold_lift.
+  iIntros "(% & % & <- & (% & %) & P)".
+  rewrite env_set_env_set; erewrite env_set_eval_id; done.
 Qed.
 
 End SetF2B.
@@ -1920,42 +1731,32 @@ Import Conseq.
 Import ConseqFacts.
 Import SetB.
 
-Theorem semax_set_forward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
-  forall (P: environ->mpred) id e,
-    @semax CS Espec Delta
-        (|> ( (tc_expr Delta e) &&
-             (tc_temp_id id (typeof e) Delta e) &&
+Theorem semax_set_forward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
+  forall (P: assert) id e,
+    semax E Delta
+        (▷ ( (tc_expr Delta e) ∧
+             (tc_temp_id id (typeof e) Delta e) ∧
           P))
           (Sset id e)
         (normal_ret_assert
-          (EX old:val, local (`eq (eval_id id) (subst id (`old) (eval_expr e))) &&
-                            subst id (`old) P)).
+          (∃ old:val, local (`eq (eval_id id) (subst id (`old) (eval_expr e))) ∧
+                            assert_of (subst id (`old) P))).
 Proof.
   intros.
   eapply semax_pre; [| apply semax_set_backward].
   apply later_ENTAIL.
-  apply andp_right; [solve_andp |].
-  rewrite subst_exp.
-  intro rho.
-  simpl.
-  apply (exp_right (eval_id id rho)).
-  unfold_lift; unfold local, lift1.
-  simpl.
-  unfold subst.
-  normalize.
-  rewrite !env_set_env_set.
-  assert (tc_temp_id id (typeof e) Delta e rho |-- !! (env_set rho id (eval_id id rho) = rho)).
-  + unfold tc_temp_id, typecheck_temp_id.
-    destruct ((temp_types Delta) ! id) eqn:?H; [| apply FF_left].
-    apply prop_right.
-    eapply env_set_eval_id; eauto.
-  + rewrite (add_andp _ _ H0).
-    rewrite !andp_assoc.
-    apply andp_left2.
-    apply andp_left2.
-    normalize.
-    rewrite H1.
-    normalize.
+  iIntros "(? & H)".
+  iSplit; first rewrite bi.and_elim_l //; rewrite bi.and_elim_r.
+  iSplit; first rewrite bi.and_elim_l //.
+  iStopProof.
+  split => rho; rewrite /subst /local /lift1; monPred.unseal.
+  rewrite monPred_at_affinely; iIntros "(% & H)".
+  iExists (eval_id id rho); unfold_lift.
+  rewrite env_set_env_set eval_id_same.
+  rewrite /typecheck_temp_id.
+  destruct (_ !! _) eqn: Ht; last by iDestruct "H" as "([] & _)".
+  erewrite env_set_eval_id; try done.
+  iDestruct "H" as "(_ & $)"; done.
 Qed.
 
 End SetB2F.
@@ -1966,27 +1767,27 @@ Declare Module CSHL_Def: CLIGHT_SEPARATION_HOARE_LOGIC_DEF.
 
 Import CSHL_Def.
 
-Axiom semax_ptr_compare_forward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
+Axiom semax_ptr_compare_forward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
   forall P id cmp e1 e2 ty sh1 sh2,
-    sepalg.nonidentity sh1 -> sepalg.nonidentity sh2 ->
+    sh1 ≠ Share.bot -> sh2 ≠ Share.bot ->
    is_comparison cmp = true  ->
    eqb_type (typeof e1) int_or_ptr_type = false ->
    eqb_type (typeof e2) int_or_ptr_type = false ->
    typecheck_tid_ptr_compare Delta id = true ->
-   @semax CS Espec Delta
-        ( |> ( (tc_expr Delta e1) &&
-              (tc_expr Delta e2)  &&
+   semax E Delta
+        ( ▷ ( (tc_expr Delta e1) ∧
+              (tc_expr Delta e2)  ∧
 
-          local (`(blocks_match cmp) (eval_expr e1) (eval_expr e2)) &&
-          (`(mapsto_ sh1 (typeof e1)) (eval_expr e1) * TT) &&
-          (`(mapsto_ sh2 (typeof e2)) (eval_expr e2) * TT) &&
+          local (`(blocks_match cmp) (eval_expr e1) (eval_expr e2)) ∧
+          (<absorb> assert_of (`(mapsto_ sh1 (typeof e1)) (eval_expr e1))) ∧
+          (<absorb> assert_of (`(mapsto_ sh2 (typeof e2)) (eval_expr e2))) ∧
           P))
           (Sset id (Ebinop cmp e1 e2 ty))
         (normal_ret_assert
-          (EX old:val,
+          (∃ old:val,
                  local (`eq (eval_id id)  (subst id `(old)
-                     (eval_expr (Ebinop cmp e1 e2 ty)))) &&
-                       subst id `(old) P)).
+                     (eval_expr (Ebinop cmp e1 e2 ty)))) ∧
+                       assert_of (subst id `(old) P))).
 
 End CLIGHT_SEPARATION_HOARE_LOGIC_PTR_CMP_FORWARD.
 
@@ -1996,23 +1797,23 @@ Declare Module CSHL_Def: CLIGHT_SEPARATION_HOARE_LOGIC_DEF.
 
 Import CSHL_Def.
 
-Axiom semax_ptr_compare_backward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
-  forall P id e,
-   @semax CS Espec Delta
-        (EX cmp: Cop.binary_operation, EX e1: expr, EX e2: expr,
-         EX ty: type, EX sh1: share, EX sh2: share,
-          !! (e = Ebinop cmp e1 e2 ty /\
-              sepalg.nonidentity sh1 /\ sepalg.nonidentity sh2 /\
+Axiom semax_ptr_compare_backward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
+  forall (P: assert) id e,
+   semax E Delta
+        (∃ cmp: Cop.binary_operation, ∃ e1: expr, ∃ e2: expr,
+         ∃ ty: type, ∃ sh1: share, ∃ sh2: share,
+          ⌜e = Ebinop cmp e1 e2 ty /\
+              sh1 ≠ Share.bot /\ sh2 ≠ Share.bot /\
               is_comparison cmp = true /\
               eqb_type (typeof e1) int_or_ptr_type = false /\
               eqb_type (typeof e2) int_or_ptr_type = false /\
-              typecheck_tid_ptr_compare Delta id = true) &&
-            ( |> ( (tc_expr Delta e1) &&
-              (tc_expr Delta e2)  &&
-          local (`(blocks_match cmp) (eval_expr e1) (eval_expr e2)) &&
-          (`(mapsto_ sh1 (typeof e1)) (eval_expr e1) * TT) &&
-          (`(mapsto_ sh2 (typeof e2)) (eval_expr e2) * TT) &&
-          subst id (eval_expr (Ebinop cmp e1 e2 ty)) P)))
+              typecheck_tid_ptr_compare Delta id = true⌝ ∧
+            ( ▷ ( (tc_expr Delta e1) ∧
+              (tc_expr Delta e2)  ∧
+          local (`(blocks_match cmp) (eval_expr e1) (eval_expr e2)) ∧
+          (<absorb> assert_of (`(mapsto_ sh1 (typeof e1)) (eval_expr e1))) ∧
+          (<absorb> assert_of (`(mapsto_ sh2 (typeof e2)) (eval_expr e2))) ∧
+          assert_of (subst id (eval_expr (Ebinop cmp e1 e2 ty)) P))))
           (Sset id e)
         (normal_ret_assert P).
 
@@ -2035,23 +1836,23 @@ Import Extr.
 Import ExtrFacts.
 Import PtrCmpF.
 
-Theorem semax_ptr_compare_backward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
-  forall P id e,
-   @semax CS Espec Delta
-        (EX cmp: Cop.binary_operation, EX e1: expr, EX e2: expr,
-         EX ty: type, EX sh1: share, EX sh2: share,
-          !! (e = Ebinop cmp e1 e2 ty /\
-              sepalg.nonidentity sh1 /\ sepalg.nonidentity sh2 /\
+Theorem semax_ptr_compare_backward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
+  forall (P: assert) id e,
+   semax E Delta
+        (∃ cmp: Cop.binary_operation, ∃ e1: expr, ∃ e2: expr,
+         ∃ ty: type, ∃ sh1: share, ∃ sh2: share,
+          ⌜e = Ebinop cmp e1 e2 ty /\
+              sh1 ≠ Share.bot /\ sh2 ≠ Share.bot /\
               is_comparison cmp = true /\
               eqb_type (typeof e1) int_or_ptr_type = false /\
               eqb_type (typeof e2) int_or_ptr_type = false /\
-              typecheck_tid_ptr_compare Delta id = true) &&
-            ( |> ( (tc_expr Delta e1) &&
-              (tc_expr Delta e2)  &&
-          local (`(blocks_match cmp) (eval_expr e1) (eval_expr e2)) &&
-          (`(mapsto_ sh1 (typeof e1)) (eval_expr e1) * TT) &&
-          (`(mapsto_ sh2 (typeof e2)) (eval_expr e2) * TT) &&
-          subst id (eval_expr (Ebinop cmp e1 e2 ty)) P)))
+              typecheck_tid_ptr_compare Delta id = true⌝ ∧
+            ( ▷ ( (tc_expr Delta e1) ∧
+              (tc_expr Delta e2)  ∧
+          local (`(blocks_match cmp) (eval_expr e1) (eval_expr e2)) ∧
+          (<absorb> assert_of (`(mapsto_ sh1 (typeof e1)) (eval_expr e1))) ∧
+          (<absorb> assert_of (`(mapsto_ sh2 (typeof e2)) (eval_expr e2))) ∧
+          assert_of (subst id (eval_expr (Ebinop cmp e1 e2 ty)) P))))
           (Sset id e)
           (normal_ret_assert P).
 Proof.
@@ -2065,16 +1866,12 @@ Proof.
   apply semax_extract_prop; intros [He [? [? [? [? [? ?]]]]]].
   subst e.
   eapply semax_post'; [.. | eapply semax_ptr_compare_forward; eauto].
-  rewrite exp_andp2.
-  apply exp_left; intros old.
-  autorewrite with subst.
-  rewrite resubst_full.
-  intro rho; unfold local, lift1; unfold_lift; simpl.
-  unfold typecheck_tid_ptr_compare in H4.
-  destruct ((temp_types Delta) ! id) eqn:?H; inv H4.
-  normalize.
-  erewrite subst_self by eauto.
-  auto.
+  split => rho; rewrite /local /subst /lift1; monPred.unseal; unfold_lift.
+  iIntros "(% & % & <- & H)".
+  rewrite env_set_env_set.
+  unfold typecheck_tid_ptr_compare in *.
+  destruct (_ !! _) eqn: Ht; last done.
+  erewrite env_set_eval_id; done.
 Qed.
 
 End PtrCmpF2B.
@@ -2092,62 +1889,43 @@ Import Conseq.
 Import ConseqFacts.
 Import PtrCmpB.
 
-Theorem semax_ptr_compare_forward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
+Theorem semax_ptr_compare_forward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
   forall P id cmp e1 e2 ty sh1 sh2,
-    sepalg.nonidentity sh1 -> sepalg.nonidentity sh2 ->
+    sh1 ≠ Share.bot -> sh2 ≠ Share.bot ->
    is_comparison cmp = true  ->
    eqb_type (typeof e1) int_or_ptr_type = false ->
    eqb_type (typeof e2) int_or_ptr_type = false ->
    typecheck_tid_ptr_compare Delta id = true ->
-   @semax CS Espec Delta
-        ( |> ( (tc_expr Delta e1) &&
-              (tc_expr Delta e2)  &&
+   semax E Delta
+        ( ▷ ( (tc_expr Delta e1) ∧
+              (tc_expr Delta e2)  ∧
 
-          local (`(blocks_match cmp) (eval_expr e1) (eval_expr e2)) &&
-          (`(mapsto_ sh1 (typeof e1)) (eval_expr e1) * TT) &&
-          (`(mapsto_ sh2 (typeof e2)) (eval_expr e2) * TT) &&
+          local (`(blocks_match cmp) (eval_expr e1) (eval_expr e2)) ∧
+          (<absorb> assert_of (`(mapsto_ sh1 (typeof e1)) (eval_expr e1))) ∧
+          (<absorb> assert_of (`(mapsto_ sh2 (typeof e2)) (eval_expr e2))) ∧
           P))
           (Sset id (Ebinop cmp e1 e2 ty))
         (normal_ret_assert
-          (EX old:val,
+          (∃ old:val,
                  local (`eq (eval_id id)  (subst id `(old)
-                     (eval_expr (Ebinop cmp e1 e2 ty)))) &&
-                       subst id `(old) P)).
+                     (eval_expr (Ebinop cmp e1 e2 ty)))) ∧
+                       assert_of (subst id `(old) P))).
 Proof.
   intros.
   eapply semax_pre; [| apply semax_ptr_compare_backward].
-  apply (exp_right cmp).
-  apply (exp_right e1).
-  apply (exp_right e2).
-  apply (exp_right ty).
-  apply (exp_right sh1).
-  apply (exp_right sh2).
-  apply andp_right; [apply prop_right; repeat split; auto |].
-  apply later_ENTAIL.
-  apply andp_ENTAIL; [apply ENTAIL_refl |].
-  rewrite subst_exp.
-  intros rho.
-  change (local (tc_environ Delta) rho && P rho
-  |-- EX b : val,
-       subst id (eval_expr (Ebinop cmp e1 e2 ty)) (local ((` eq) (eval_id id) (subst id (` b) (eval_expr (Ebinop cmp e1 e2 ty)))) && subst id (` b) P) rho).
-  apply (exp_right (eval_id id rho)).
-  autorewrite with subst.
-  unfold local, lift1; unfold_lift; simpl.
-  unfold typecheck_tid_ptr_compare in H4.
-  simpl in H4.
-  destruct ((temp_types Delta) ! id) eqn:?H; inv H4.
-  normalize.
-  apply andp_right.
-  + apply prop_right.
-    unfold subst.
-    unfold_lift.
-    rewrite env_set_env_set.
-    rewrite eval_id_same.
-    erewrite env_set_eval_id by eauto.
-    auto.
-  + unfold_lift.
-    rewrite resubst_full.
-    erewrite subst_self; eauto.
+  iIntros "(#? & H)"; iExists cmp, e1, e2, ty, sh1, sh2.
+  iSplit; first by iPureIntro.
+  iNext.
+  repeat (iSplit; first rewrite bi.and_elim_l //; rewrite bi.and_elim_r).
+  iStopProof.
+  split => rho; rewrite /local /subst /lift1; monPred.unseal; unfold_lift.
+  rewrite monPred_at_intuitionistically.
+  iIntros "(% & H)".
+  iExists (eval_id id rho).
+  rewrite env_set_env_set eval_id_same.
+  unfold typecheck_tid_ptr_compare in *.
+  destruct (_ !! _) eqn: Ht; last done.
+  erewrite env_set_eval_id; first iFrame; done.
 Qed.
 
 End PtrCmpB2F.
@@ -2158,43 +1936,43 @@ Declare Module CSHL_Def: CLIGHT_SEPARATION_HOARE_LOGIC_DEF.
 
 Import CSHL_Def.
 
-Axiom semax_set_ptr_compare_load_cast_load_backward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
-  forall (P: environ->mpred) id e,
-    @semax CS Espec Delta
-       ((|> ( (tc_expr Delta e) &&
-             (tc_temp_id id (typeof e) Delta e) &&
-             subst id (eval_expr e) P)) ||
-        (EX cmp: Cop.binary_operation, EX e1: expr, EX e2: expr,
-         EX ty: type, EX sh1: share, EX sh2: share,
-          !! (e = Ebinop cmp e1 e2 ty /\
-              sepalg.nonidentity sh1 /\ sepalg.nonidentity sh2 /\
+Axiom semax_set_ptr_compare_load_cast_load_backward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
+  forall (P: assert) id e,
+    semax E Delta
+       ((((▷ ( (tc_expr Delta e) ∧
+             (tc_temp_id id (typeof e) Delta e) ∧
+             assert_of (subst id (eval_expr e) P))) ∨
+        (∃ cmp: Cop.binary_operation, ∃ e1: expr, ∃ e2: expr,
+         ∃ ty: type, ∃ sh1: share, ∃ sh2: share,
+          ⌜e = Ebinop cmp e1 e2 ty /\
+              sh1 ≠ Share.bot /\ sh2 ≠ Share.bot /\
               is_comparison cmp = true /\
               eqb_type (typeof e1) int_or_ptr_type = false /\
               eqb_type (typeof e2) int_or_ptr_type = false /\
-              typecheck_tid_ptr_compare Delta id = true) &&
-            ( |> ( (tc_expr Delta e1) &&
-              (tc_expr Delta e2)  &&
-          local (`(blocks_match cmp) (eval_expr e1) (eval_expr e2)) &&
-          (`(mapsto_ sh1 (typeof e1)) (eval_expr e1) * TT) &&
-          (`(mapsto_ sh2 (typeof e2)) (eval_expr e2) * TT) &&
-          subst id (eval_expr (Ebinop cmp e1 e2 ty)) P))) ||
-        (EX sh: share, EX t2: type, EX v2: val,
-              !! (typeof_temp Delta id = Some t2 /\
+              typecheck_tid_ptr_compare Delta id = true⌝ ∧
+            ( ▷ ( (tc_expr Delta e1) ∧
+              (tc_expr Delta e2)  ∧
+          local (`(blocks_match cmp) (eval_expr e1) (eval_expr e2)) ∧
+          (<absorb> assert_of (`(mapsto_ sh1 (typeof e1)) (eval_expr e1))) ∧
+          (<absorb> assert_of (`(mapsto_ sh2 (typeof e2)) (eval_expr e2))) ∧
+          assert_of (subst id (eval_expr (Ebinop cmp e1 e2 ty)) P))))) ∨
+        (∃ sh: share, ∃ t2: type, ∃ v2: val,
+              ⌜typeof_temp Delta id = Some t2 /\
                   is_neutral_cast (typeof e) t2 = true /\
-                  readable_share sh) &&
-         |> ( (tc_lvalue Delta e) &&
-              local (`(tc_val (typeof e) v2)) &&
-              (`(mapsto sh (typeof e)) (eval_lvalue e) (`v2) * TT) &&
-              subst id (`v2) P)) ||
-        (EX sh: share, EX e1: expr, EX t1: type, EX v2: val,
-              !! (e = Ecast e1 t1 /\
+                  readable_share sh⌝ ∧
+         ▷ ((tc_lvalue Delta e ∧
+              ⌜tc_val (typeof e) v2⌝ ∧
+              (<absorb> assert_of (`(mapsto sh (typeof e)) (eval_lvalue e) (`v2)))) ∧
+              assert_of (subst id (`v2) P)))) ∨
+        (∃ sh: share, ∃ e1: expr, ∃ t1: type, ∃ v2: val,
+              ⌜e = Ecast e1 t1 /\
                   typeof_temp Delta id = Some t1 /\
                   cast_pointer_to_bool (typeof e1) t1 = false /\
-                  readable_share sh) &&
-         |> ( (tc_lvalue Delta e1) &&
-              local (`(tc_val t1) (`(eval_cast (typeof e1) t1 v2))) &&
-              (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2) * TT) &&
-              subst id (`(force_val (sem_cast (typeof e1) t1 v2))) P)))
+                  readable_share sh⌝ ∧
+         ▷ (tc_lvalue Delta e1 ∧
+              local (`(tc_val t1) (`(eval_cast (typeof e1) t1 v2))) ∧
+              (<absorb> assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2))) ∧
+              assert_of (subst id (`(force_val (sem_cast (typeof e1) t1 v2))) P))))
         (Sset id e) (normal_ret_assert P).
 
 End CLIGHT_SEPARATION_HOARE_LOGIC_SSET_BACKWARD.
@@ -2222,43 +2000,43 @@ Import LoadB.
 Import CastLoadB.
 Import ExtrFacts.
 
-Theorem semax_set_ptr_compare_load_cast_load_backward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
-  forall (P: environ->mpred) id e,
-    @semax CS Espec Delta
-       ((|> ( (tc_expr Delta e) &&
-             (tc_temp_id id (typeof e) Delta e) &&
-             subst id (eval_expr e) P)) ||
-        (EX cmp: Cop.binary_operation, EX e1: expr, EX e2: expr,
-         EX ty: type, EX sh1: share, EX sh2: share,
-          !! (e = Ebinop cmp e1 e2 ty /\
-              sepalg.nonidentity sh1 /\ sepalg.nonidentity sh2 /\
+Theorem semax_set_ptr_compare_load_cast_load_backward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
+  forall (P: assert) id e,
+    semax E Delta
+       ((((▷ ( (tc_expr Delta e) ∧
+             (tc_temp_id id (typeof e) Delta e) ∧
+             assert_of (subst id (eval_expr e) P))) ∨
+        (∃ cmp: Cop.binary_operation, ∃ e1: expr, ∃ e2: expr,
+         ∃ ty: type, ∃ sh1: share, ∃ sh2: share,
+          ⌜e = Ebinop cmp e1 e2 ty /\
+              sh1 ≠ Share.bot /\ sh2 ≠ Share.bot /\
               is_comparison cmp = true /\
               eqb_type (typeof e1) int_or_ptr_type = false /\
               eqb_type (typeof e2) int_or_ptr_type = false /\
-              typecheck_tid_ptr_compare Delta id = true) &&
-            ( |> ( (tc_expr Delta e1) &&
-              (tc_expr Delta e2)  &&
-          local (`(blocks_match cmp) (eval_expr e1) (eval_expr e2)) &&
-          (`(mapsto_ sh1 (typeof e1)) (eval_expr e1) * TT) &&
-          (`(mapsto_ sh2 (typeof e2)) (eval_expr e2) * TT) &&
-          subst id (eval_expr (Ebinop cmp e1 e2 ty)) P))) ||
-        (EX sh: share, EX t2: type, EX v2: val,
-              !! (typeof_temp Delta id = Some t2 /\
+              typecheck_tid_ptr_compare Delta id = true⌝ ∧
+            ( ▷ ( (tc_expr Delta e1) ∧
+              (tc_expr Delta e2)  ∧
+          local (`(blocks_match cmp) (eval_expr e1) (eval_expr e2)) ∧
+          (<absorb> assert_of (`(mapsto_ sh1 (typeof e1)) (eval_expr e1))) ∧
+          (<absorb> assert_of (`(mapsto_ sh2 (typeof e2)) (eval_expr e2))) ∧
+          assert_of (subst id (eval_expr (Ebinop cmp e1 e2 ty)) P))))) ∨
+        (∃ sh: share, ∃ t2: type, ∃ v2: val,
+              ⌜typeof_temp Delta id = Some t2 /\
                   is_neutral_cast (typeof e) t2 = true /\
-                  readable_share sh) &&
-         |> ( (tc_lvalue Delta e) &&
-              local (`(tc_val (typeof e) v2)) &&
-              (`(mapsto sh (typeof e)) (eval_lvalue e) (`v2) * TT) &&
-              subst id (`v2) P)) ||
-        (EX sh: share, EX e1: expr, EX t1: type, EX v2: val,
-              !! (e = Ecast e1 t1 /\
+                  readable_share sh⌝ ∧
+         ▷ ((tc_lvalue Delta e ∧
+              ⌜tc_val (typeof e) v2⌝ ∧
+              (<absorb> assert_of (`(mapsto sh (typeof e)) (eval_lvalue e) (`v2)))) ∧
+              assert_of (subst id (`v2) P)))) ∨
+        (∃ sh: share, ∃ e1: expr, ∃ t1: type, ∃ v2: val,
+              ⌜e = Ecast e1 t1 /\
                   typeof_temp Delta id = Some t1 /\
                   cast_pointer_to_bool (typeof e1) t1 = false /\
-                  readable_share sh) &&
-         |> ( (tc_lvalue Delta e1) &&
-              local (`(tc_val t1) (`(eval_cast (typeof e1) t1 v2))) &&
-              (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2) * TT) &&
-              subst id (`(force_val (sem_cast (typeof e1) t1 v2))) P)))
+                  readable_share sh⌝ ∧
+         ▷ ( (tc_lvalue Delta e1) ∧
+              local (`(tc_val t1) (`(eval_cast (typeof e1) t1 v2))) ∧
+              (<absorb> assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2))) ∧
+              assert_of (subst id (`(force_val (sem_cast (typeof e1) t1 v2))) P))))
         (Sset id e) (normal_ret_assert P).
 Proof.
   intros.
@@ -2285,17 +2063,17 @@ Import Conseq.
 Import ConseqFacts.
 Import Sset.
 
-Theorem semax_set_backward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
-  forall (P: environ->mpred) id e,
-    @semax CS Espec Delta
-        (|> ( (tc_expr Delta e) &&
-             (tc_temp_id id (typeof e) Delta e) &&
-             subst id (eval_expr e) P))
+Theorem semax_set_backward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
+  forall (P: assert) id e,
+    semax E Delta
+        (▷ ( (tc_expr Delta e) ∧
+             (tc_temp_id id (typeof e) Delta e) ∧
+             assert_of (subst id (eval_expr e) P)))
           (Sset id e) (normal_ret_assert P).
 Proof.
   intros.
   eapply semax_pre_simple; [| apply semax_set_ptr_compare_load_cast_load_backward].
-  apply orp_right1, orp_right1, orp_right1; auto.
+  iIntros; iLeft; iLeft; iLeft; done.
 Qed.
 
 End Sset2Set.
@@ -2314,29 +2092,29 @@ Import Conseq.
 Import ConseqFacts.
 Import Sset.
 
-Theorem semax_ptr_compare_backward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
-  forall P id e,
-   @semax CS Espec Delta
-        (EX cmp: Cop.binary_operation, EX e1: expr, EX e2: expr,
-         EX ty: type, EX sh1: share, EX sh2: share,
-          !! (e = Ebinop cmp e1 e2 ty /\
-              sepalg.nonidentity sh1 /\ sepalg.nonidentity sh2 /\
+Theorem semax_ptr_compare_backward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
+  forall (P: assert) id e,
+   semax E Delta
+        (∃ cmp: Cop.binary_operation, ∃ e1: expr, ∃ e2: expr,
+         ∃ ty: type, ∃ sh1: share, ∃ sh2: share,
+          ⌜e = Ebinop cmp e1 e2 ty /\
+              sh1 ≠ Share.bot /\ sh2 ≠ Share.bot /\
               is_comparison cmp = true /\
               eqb_type (typeof e1) int_or_ptr_type = false /\
               eqb_type (typeof e2) int_or_ptr_type = false /\
-              typecheck_tid_ptr_compare Delta id = true) &&
-            ( |> ( (tc_expr Delta e1) &&
-              (tc_expr Delta e2)  &&
-          local (`(blocks_match cmp) (eval_expr e1) (eval_expr e2)) &&
-          (`(mapsto_ sh1 (typeof e1)) (eval_expr e1) * TT) &&
-          (`(mapsto_ sh2 (typeof e2)) (eval_expr e2) * TT) &&
-          subst id (eval_expr (Ebinop cmp e1 e2 ty)) P)))
+              typecheck_tid_ptr_compare Delta id = true⌝ ∧
+            ( ▷ ( (tc_expr Delta e1) ∧
+              (tc_expr Delta e2)  ∧
+          local (`(blocks_match cmp) (eval_expr e1) (eval_expr e2)) ∧
+          (<absorb> assert_of (`(mapsto_ sh1 (typeof e1)) (eval_expr e1))) ∧
+          (<absorb> assert_of (`(mapsto_ sh2 (typeof e2)) (eval_expr e2))) ∧
+          assert_of (subst id (eval_expr (Ebinop cmp e1 e2 ty)) P))))
           (Sset id e)
         (normal_ret_assert P).
 Proof.
   intros.
   eapply semax_pre_simple; [| apply semax_set_ptr_compare_load_cast_load_backward].
-  apply orp_right1, orp_right1, orp_right2; auto.
+  iIntros; iLeft; iLeft; iRight; done.
 Qed.
 
 End Sset2PtrCmp.
@@ -2355,22 +2133,22 @@ Import Conseq.
 Import ConseqFacts.
 Import Sset.
 
-Theorem semax_load_backward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
-  forall (P: environ->mpred) id e1,
-    @semax CS Espec Delta
-        (EX sh: share, EX t2: type, EX v2: val,
-              !! (typeof_temp Delta id = Some t2 /\
+Theorem semax_load_backward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
+  forall (P: assert) id e1,
+    semax E Delta
+        (∃ sh: share, ∃ t2: type, ∃ v2: val,
+              ⌜typeof_temp Delta id = Some t2 /\
                   is_neutral_cast (typeof e1) t2 = true /\
-                  readable_share sh) &&
-         |> ( (tc_lvalue Delta e1) &&
-              local (`(tc_val (typeof e1) v2)) &&
-              (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2) * TT) &&
-              subst id (`v2) P))
+                  readable_share sh⌝ ∧
+         ▷ ((tc_lvalue Delta e1 ∧
+              ⌜tc_val (typeof e1) v2⌝ ∧
+              (<absorb> assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2)))) ∧
+              assert_of (subst id (`v2) P)))
         (Sset id e1) (normal_ret_assert P).
 Proof.
   intros.
   eapply semax_pre_simple; [| apply semax_set_ptr_compare_load_cast_load_backward].
-  apply orp_right1, orp_right2; auto.
+  iIntros; iLeft; iRight; done.
 Qed.
 
 End Sset2Load.
@@ -2389,24 +2167,23 @@ Import Conseq.
 Import ConseqFacts.
 Import Sset.
 
-Theorem semax_cast_load_backward: forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
-  forall (P: environ->mpred) id e,
-    @semax CS Espec Delta
-        (EX sh: share, EX e1: expr, EX t1: type, EX v2: val,
-              !! (e = Ecast e1 t1 /\
+Theorem semax_cast_load_backward: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} E (Delta: tycontext),
+  forall (P: assert) id e,
+    semax E Delta
+        (∃ sh: share, ∃ e1: expr, ∃ t1: type, ∃ v2: val,
+              ⌜e = Ecast e1 t1 /\
                   typeof_temp Delta id = Some t1 /\
                   cast_pointer_to_bool (typeof e1) t1 = false /\
-                  readable_share sh) &&
-         |> ( (tc_lvalue Delta e1) &&
-              local (`(tc_val t1) (`(eval_cast (typeof e1) t1 v2))) &&
-              (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2) * TT) &&
-              subst id (`(force_val (sem_cast (typeof e1) t1 v2))) P))
+                  readable_share sh⌝ ∧
+         ▷ ( (tc_lvalue Delta e1) ∧
+              local (`(tc_val t1) (`(eval_cast (typeof e1) t1 v2))) ∧
+              (<absorb> assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2))) ∧
+              assert_of (subst id (`(force_val (sem_cast (typeof e1) t1 v2))) P)))
         (Sset id e) (normal_ret_assert P).
 Proof.
   intros.
   eapply semax_pre_simple; [| apply semax_set_ptr_compare_load_cast_load_backward].
-  apply orp_right2; auto.
+  iIntros; iRight; done.
 Qed.
 
 End Sset2CastLoad.
-
diff --git a/floyd/VSU.v b/floyd/VSU.v
index f28d77b752..90768e9993 100644
--- a/floyd/VSU.v
+++ b/floyd/VSU.v
@@ -5,40 +5,46 @@ Require Export VST.floyd.PTops.
 Require Export VST.floyd.QPcomposite.
 Require Export VST.floyd.quickprogram.
 Require Export VST.floyd.Component.
-Import compcert.lib.Maps.
+Import -(notations) compcert.lib.Maps.
 
-Lemma valid_pointer_is_null_or_ptr p: valid_pointer p |-- !!( is_pointer_or_null p).
+Local Unset SsrRewrite.
+
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ}.
+
+Lemma valid_pointer_is_null_or_ptr p: valid_pointer p ⊢ ⌜is_pointer_or_null p⌝.
 Proof. constructor. apply valid_pointer_is_pointer_or_null. Qed.
 
 Lemma semax_body_subsumespec_VprogNil {cs V G f iphi}:
-       @semax_body [] G cs f iphi ->
+       semax_body [] G (C := cs) f iphi ->
        list_norepet (map fst V ++ map fst G) ->
-       @semax_body V G cs f iphi.
+       semax_body V G (C := cs) f iphi.
 Proof. intros. eapply Component.semax_body_subsumespec. apply H.
-+ intros i. red. 
++ intros i. red.
   rewrite 2 semax_prog.make_context_g_char; trivial.
-  destruct ((make_tycontext_s G) ! i); trivial. simpl; trivial.
+  destruct ((make_tycontext_s G) !! i); trivial. simpl; trivial.
   simpl. eapply list_norepet_append_right. apply H0.
 + intros. apply subsumespec_refl.
 Qed.
 
 Lemma semax_body_subsumespec_NilNil {cs V G f iphi}:
-       @semax_body [] [] cs f iphi ->
+       semax_body [] [] (C := cs) f iphi ->
        list_norepet (map fst V ++ map fst G) ->
-       @semax_body V G cs f iphi.
+       semax_body V G (C := cs) f iphi.
 Proof. intros. eapply semax_body_subsumespec_VprogNil; trivial. 
   eapply semax_body_subsumespec_GprogNil; trivial.
   simpl. eapply list_norepet_append_right. apply H0.
 Qed.
 
-Lemma init_data2pred_isptr {gv d sh v}:init_data2pred gv d sh v |-- !!(isptr v).
-Proof. 
+Lemma init_data2pred_isptr {gv d sh v}:init_data2pred gv d sh v ⊢ ⌜isptr v⌝.
+Proof.
   destruct d; simpl; entailer. apply mapsto_zeros_isptr.
   destruct (gv i); entailer!.
 Qed.
 
 Lemma globvar2pred_headptr gv i u (G: globals_ok gv) (U: @gvar_init type u <> nil) (UU: @gvar_volatile type u = false):
-      globvar2pred gv (i, u) |-- !! headptr (gv i).
+      globvar2pred gv (i, u) ⊢ ⌜headptr (gv i)⌝.
 Proof.
   destruct (G i). entailer!. rewrite H.
   unfold globvar2pred. simpl. rewrite UU, H.
@@ -47,31 +53,31 @@ Proof.
 Qed.
 
 Lemma SF_ctx_subsumption {Espec} V G ge i fd phi cs
-  (HSF:  @SF Espec cs V ge G i fd phi)
+  (HSF:  SF (Espec := Espec) (cs := cs) (V := V) (ge := ge) G i fd phi)
   (LNR_G: list_norepet (map fst G)) G' V' ge' cs'
   (SubCS: cspecs_sub cs cs')
   (FD: genv_find_func ge' i fd)
-  (SubFG: forall j, sub_option (make_tycontext_g V G) ! j (make_tycontext_g V' G') ! j)
+  (SubFG: forall j, sub_option ((make_tycontext_g V G) !! j) ((make_tycontext_g V' G') !! j))
   (SubG: forall j : ident, subsumespec (find_id j G) (find_id j G')):
-  @SF Espec cs' V' ge' G' i fd phi.
+  SF (Espec := Espec) (cs := cs') (V := V') (ge := ge') G' i fd phi.
 Proof.
   destruct fd; simpl.
  + eapply InternalInfo_subsumption.
-    4: eapply (@InternalInfo_envs_sub cs cs' SubCS); eassumption.
-    assumption. assumption. assumption. 
+    4: eapply (InternalInfo_envs_sub SubCS); eassumption.
+    assumption. assumption. assumption.
  + eapply ExternalInfo_envs_sub; eassumption.
 Qed.
 
-Lemma SF_ctx_extensional {Espec} V G ge i fd cs phi (HSF:  @SF Espec cs V ge G i fd phi)
+Lemma SF_ctx_extensional {Espec} V G ge i fd cs phi (HSF:  SF (Espec := Espec) (cs := cs) (V := V) (ge := ge) G i fd phi)
   (LNR_G: list_norepet (map fst G)) G'
   (GG': forall j, find_id j G = find_id j G'):
-  @SF Espec cs V ge G' i fd phi.
+  SF (Espec := Espec) (cs := cs) (V := V) (ge := ge) G' i fd phi.
 Proof.
   destruct fd; simpl; [ | apply HSF].
   eapply InternalInfo_subsumption; [ | | eassumption | eassumption].
-  + intros j; red. remember ((make_tycontext_g V G) ! j) as q; destruct q; simpl; trivial.
+  + intros j; red. remember ((make_tycontext_g V G) !! j) as q; destruct q; simpl; trivial.
     symmetry in Heqq. 
-    specialize (semax_prog.make_tycontext_s_g V G j). 
+    specialize (semax_prog.make_tycontext_s_g V G j).
     specialize (semax_prog.make_tycontext_s_g V G' j).
     rewrite 2 make_tycontext_s_find_id, GG'. intros.
     remember (find_id j G') as w; destruct w.
@@ -110,62 +116,21 @@ _SF_internal:
   SF_internal C V ge G id f phi.
 
 Lemma SF_internal_sound {Espec cs V} {ge : Genv.t Clight.fundef type} G i f phi:
-  SF_internal cs V ge G i f phi -> @SF Espec cs V ge G i (Internal f) phi.
+  SF_internal cs V ge G i f phi -> SF (Espec := Espec) (cs := cs) (V := V) (ge := ge) G i (Internal f) phi.
 Proof. simpl; intros. inv H. red. intuition. Qed.
 
-Ltac findentry := repeat try first [ left; reflexivity | right].
-
-Ltac finishComponent :=(*
-    intros i phi E; simpl in E;
-    repeat (if_tac in E;
-            [inv E; eexists; split; [ reflexivity
-                                    | try solve [apply funspec_sub_refl]]
-            | ]);
-    try solve [discriminate].*)
-    intros i phi E; simpl in E;
-    repeat (if_tac in E;
-       [  inv E; first [ solve [apply funspec_sub_refl]
-                    | eexists; split; [ reflexivity
-                                    | try solve [apply funspec_sub_refl]]]
-       | ]);
-    try solve [discriminate].
-
-Ltac lookup_tac := 
-    intros H;
-    repeat (destruct H; [ repeat ( first [ solve [left; trivial] | right]) | ]); try contradiction.
-
 Lemma semax_vacuous:
- forall cs Espec Delta pp frame c post,
-  @semax cs Espec Delta (fun rho => (close_precondition pp) FF rho * frame rho)%logic
+ forall cs Espec E Delta pp frame c post,
+  semax (C := cs) (OK_spec := Espec) E Delta (assert_of (fun rho => (close_precondition pp) False rho ∗ frame rho))
       c post.
 Proof.
 intros.
 eapply semax_pre; [ | apply semax_ff].
-apply andp_left2.
-intro rho.
-rewrite sepcon_comm.
-apply sepcon_FF_derives'.
-unfold close_precondition.
-apply exp_left; intro.
-apply andp_left2.
-unfold FF; simpl.
-auto.
+rewrite bi.and_elim_r.
+split => rho; monPred.unseal.
+iIntros "((% & ? & []) & ?)".
 Qed.
 
-Ltac SF_vacuous :=
- try change (fst (?a,?b)) with a; try change (snd (?a,?b)) with b;
- match goal with |- SF _ _ _ (vacuous_funspec _) => idtac end;
- match goal with H: @eq compspecs _ _ |- _ => rewrite <- H end;
-red; red; repeat simple apply conj;
-[ reflexivity (* id_in_list ... *)
-| repeat apply Forall_cons; (* Forall complete_type fn_vars *)
-  try apply Forall_nil; reflexivity
-| repeat constructor; simpl; rep_lia (* var_sizes_ok *)
-| reflexivity (* fn_callconv ... *)
-| split3; [reflexivity | reflexivity | intros; apply semax_vacuous] (* semax_body *)
-| eexists; split; compute; reflexivity (* genv_find_func *)
-].
-
 Lemma compspecs_ext:
  forall cs1 cs2 : compspecs,
  @cenv_cs cs1 = @cenv_cs cs2 ->
@@ -200,11 +165,11 @@ Proof.
 intros.
 apply PTree.extensionality.
 intro i.
-assert ((PTree.map1 getCompositeData ce1) ! i =
-            (PTree.map1 getCompositeData ce2) ! i) by congruence.
+assert ((PTree.map1 getCompositeData ce1) !! i =
+            (PTree.map1 getCompositeData ce2) !! i) by congruence.
 rewrite !PTree.gmap1 in H0.
 clear H.
-destruct (ce1 ! i), (ce2 ! i); auto; inv H0.
+destruct (ce1 !! i), (ce2 !! i); auto; inv H0.
 f_equal.
 destruct c,c0; inv H1; simpl in *; subst; f_equal; apply proof_irr.
 Qed.
@@ -264,78 +229,50 @@ subst.
 apply QPcompspecs_OK_i; auto.
 Qed.
 
-Ltac decompose_in_elements H :=
-match type of H with
- | (?i,_)=_ \/ _ => 
-   destruct H as [H|H];
-   [let j := eval compute in i in change i with j in H;
-                injection H; clear H; intros; subst 
-  | decompose_in_elements H ]
- | False => contradiction H
- | _ => idtac
- end.
-
 Fixpoint fold_ident {A} (i: positive) (al: list (ident * A)) : ident :=
  match al with
  | (j,_)::al' => if Pos.eqb i j then j else fold_ident i al'
  | nil => i
 end.
 
+Notation funspec := (@funspec Σ).
+Notation funspecs := (@funspecs Σ).
+
 Definition isSomeGfunExternal {F V} (d: option(globdef (fundef F) V)) : bool :=
  match d with Some(Gfun(External _ _ _ _)) => true | _ => false end.
 Definition Comp_Externs_OK (E: funspecs) (p: QP.program Clight.function) :=
-  Forall (fun i => isSomeGfunExternal ((QP.prog_defs p) ! i) = true) (map fst E).
+  Forall (fun i => (isSomeGfunExternal ((QP.prog_defs p) !! i)) = true) (map fst E).
 
 Lemma compute_Comp_Externs: forall (E: funspecs) (p: QP.program Clight.function),
 Comp_Externs_OK (E: funspecs) (p: QP.program Clight.function) ->
 (forall i : ident,
 In i (map fst E) ->
-exists f ts t cc, (QP.prog_defs p) ! i = Some (Gfun (External f ts t cc))).
+exists f ts t cc, (QP.prog_defs p) !! i = Some (Gfun (External f ts t cc))).
 Proof.
 intros.
 red in H.
 rewrite Forall_forall in H.
 apply  H in H0; clear H.
 unfold isSomeGfunExternal in H0.
-destruct ((QP.prog_defs p) ! i); try discriminate.
+destruct ((QP.prog_defs p) !! i); try discriminate.
 destruct g; try discriminate.
 destruct f; try discriminate.
 eauto.
 Qed.
 
 Definition compute_missing_Comp_Externs (E: funspecs) (p: QP.program Clight.function) : list ident :=
- filter (fun i => negb(isSomeGfunExternal ((QP.prog_defs p)!i))) (map fst E).
-
-Ltac check_Comp_Externs :=
- apply compute_Comp_Externs;
- (solve [repeat apply Forall_cons; try apply Forall_nil; reflexivity]
-  || match goal with |- Comp_Externs_OK ?E ?p =>
-      let ids := constr:(compute_missing_Comp_Externs E p) in
-      let ids := eval hnf in ids in let ids := eval simpl in ids in
-      fail "The following identifiers are proposed as 'Extern' funspecs, but the Clight program does not list them as Gfun(External _ _ _ _):"
-               ids
-      end).
-
-Ltac check_Comp_Imports_Exports :=
- apply compute_Comp_Externs;
- (solve [repeat apply Forall_cons; try apply Forall_nil; reflexivity]
-  || match goal with |- Comp_Externs_OK ?E ?p =>
-      let ids := constr:(compute_missing_Comp_Externs E p) in
-      let ids := eval hnf in ids in let ids := eval simpl in ids in
-      fail "The following identifiers are proposed as 'Imports' funspecs, but the Clight program does not list them as Gfun(External _ _ _ _):"
-               ids
-      end).
+ filter (fun i => negb(isSomeGfunExternal ((QP.prog_defs p)!!i))) (map fst E).
 
 Lemma forallb_isSomeGfunExternal_e:
   forall {F} (defs: PTree.t (globdef (fundef F) type)) (ids: list ident),
-   forallb (fun i => isSomeGfunExternal (defs ! i)) ids = true ->
+   forallb (fun i => isSomeGfunExternal (defs !! i)) ids = true ->
   forall i : ident,
   In i ids ->
-  exists f ts t cc, defs ! i = Some (Gfun (External f ts t cc)).
+  exists f ts t cc, defs !! i = Some (Gfun (External f ts t cc)).
 Proof.
 intros.
 rewrite forallb_forall in H.
-apply H in H0. destruct (defs ! i) as [[[]|]|]; inv H0.
+apply H in H0. destruct (defs !! i) as [[[]|]|]; inv H0.
 eauto.
 Qed. 
 
@@ -371,7 +308,7 @@ Qed.
 
 Lemma prove_G_justified:
  forall Espec cs V p Imports G,
- let SFF := @SF Espec cs V (QPglobalenv p) (Imports ++ G) in
+ let SFF := SF (Espec := Espec) (cs := cs) (V := V) (ge := QPglobalenv p) (Imports ++ G) in
  let obligations := filter_options (fun (ix: ident * funspec) =>
                match Maps.PTree.get (fst ix) (QP.prog_defs p) with
                | Some (Gfun fd) => Some (SFF (fst ix) fd (snd ix))
@@ -379,8 +316,8 @@ Lemma prove_G_justified:
                end) G in
  Forall (fun x => x) obligations ->
  (forall i phi fd, Maps.PTree.get i (QP.prog_defs p) = Some (Gfun fd) ->
-  initial_world.find_id i G = Some phi ->
-  @SF Espec cs V (QPglobalenv p) (Imports ++ G) i fd phi).
+  find_id i G = Some phi ->
+  SF (Espec := Espec) (cs := cs) (V := V) (ge := QPglobalenv p) (Imports ++ G) i fd phi).
 Proof.
 intros.
 subst SFF.
@@ -394,102 +331,6 @@ rewrite H0.
 auto.
 Qed.
 
-Ltac compute_list p :=
- let a := eval hnf in p in 
- match a with
- | nil => uconstr:(a)
- | ?h :: ?t  => 
-    let h := eval hnf in h in 
-    match h with (?i,?x) => let i := eval compute in i in
-       let t := compute_list t in
-       uconstr:((i,x)::t)
-     end
- end.
-
-Ltac compute_list' p :=
-  (* like compute_list but uses simpl instead of compute on the identifiers *)
- let a := eval hnf in p in 
- match a with
- | nil => uconstr:(a)
- | ?h :: ?t  => 
-    let h := eval hnf in h in 
-    match h with (?i,?x) => let i := eval simpl in i in
-       let t := compute_list' t in
-       uconstr:((i,x)::t)
-     end
- end.
-
-Ltac test_Component_prog_computed' :=
-lazymatch goal with
- | |- Component _ _ _ (QPprog _) _ _ _ => 
-       fail 1  "The QPprog of this component is of the form (QPprog _), which has not been calculated out to normal form.  Perhaps you meant   ltac:(QPprog _) instead of (QPprog _) in the theorem statement"
- | |- Component _ _ _ (@abbreviate _ {| QP.prog_builtins := _;
-         QP.prog_defs := _; QP.prog_public := _;
-       QP.prog_main := _;    QP.prog_comp_env := _ |}) _ _ _ =>
-    fail 0 "success"
- | |- Component _ _ _ abbreviate _ _ _ => 
-     fail 1 "The QPprog of this component is not in normal form"
- | |- Component _ _ _ ?p _ _ _ => 
-        tryif unfold p then test_Component_prog_computed'
-            else fail 1  "The QPprog of this component is not in normal form"
- | |- _ => fail 1 "The proof goal is not a Component"
- end.
-
-Ltac test_Component_prog_computed :=
- try test_Component_prog_computed'.
-
-Ltac lookup_tac_with_diagnosis := clear; intros; split; try solve [simpl in *; trivial; lookup_tac];
- match goal with |- In _ ?LEFT -> In _ ?RIGHT =>
-   simpl; intuition;
-   match goal with H: Maps.PTree.prev ?n = _ |- _ =>
-     let n' := constr:(string_of_ident (Maps.PTree.prev n)) in
-     let n' := eval compute in n' in 
-     fail 1 "Function" n' "is in the list" LEFT "but not in the list" RIGHT
-   end
- end.
-
-Ltac mkComponent prog :=
- hnf;
- match goal with |- Component _ _ ?IMPORTS _ _ _ _ =>
-     let i := compute_list' IMPORTS in change_no_check IMPORTS with i 
- end;
- test_Component_prog_computed;
- let p := fresh "p" in
- match goal with |- @Component _ _ _ _ ?pp _ _ _ => set (p:=pp) end;
- let HA := fresh "HA" in 
-   assert (HA: PTree_samedom cenv_cs ha_env_cs) by repeat constructor;
- let LA := fresh "LA" in 
-   assert (LA: PTree_samedom cenv_cs la_env_cs) by repeat constructor;
- let OK := fresh "OK" in
-  assert (OK: QPprogram_OK p)
-   by (split; [apply compute_list_norepet_e; reflexivity 
-           |  apply (QPcompspecs_OK_i HA LA) ]);
- (* Doing the  set(myenv...), instead of before proving the CSeq assertion,
-     prevents nontermination in some cases  *)
- pose (myenv:= (QP.prog_comp_env (QPprogram_of_program prog ha_env_cs la_env_cs)));
- assert (CSeq: _ = compspecs_of_QPcomposite_env myenv 
-                     (proj2 OK))
-   by (apply compspecs_eq_of_QPcomposite_env; reflexivity);
- subst myenv;
- change (QPprogram_of_program prog ha_env_cs la_env_cs) with p in CSeq;
- clear HA LA;
- exists OK;
-  [ check_Comp_Imports_Exports
-  | apply compute_list_norepet_e; reflexivity || fail "Duplicate funspec among the Externs++Imports"
-  | apply compute_list_norepet_e; reflexivity || fail "Duplicate funspec among the Exports"
-  | apply compute_list_norepet_e; reflexivity
-  | apply forallb_isSomeGfunExternal_e; reflexivity
-  | intros; simpl; split; trivial; try solve [lookup_tac]
-  | let i := fresh in let H := fresh in 
-    intros i H; first [ solve contradiction | simpl in H];
-    repeat (destruct H; [ subst; reflexivity |]); try contradiction
-  | apply prove_G_justified;
-    repeat apply Forall_cons; [ .. | apply Forall_nil];
-    try SF_vacuous
-  | finishComponent
-  | first [ solve [intros; apply derives_refl] | solve [intros; reflexivity] | solve [intros; simpl; cancel] | idtac]
-  ].
-
 Definition internalFunctions (p: QP.program function) : list (ident*function) :=
  let fix g (dl: list (ident * globdef (fundef function) Ctypes.type)) := 
     match dl with
@@ -499,21 +340,11 @@ Definition internalFunctions (p: QP.program function) : list (ident*function) :=
     end
   in g (Maps.PTree.elements (QP.prog_defs p)).
 
-Search (list _ -> bool) .
-
 Definition makeSomeVacuousFunspecs (p: QP.program function) (nonvacuousSpecs: funspecs) : funspecs :=
   let ids := map fst nonvacuousSpecs in 
   map (fun ix => (fst ix, vacuous_funspec (Internal (snd ix))))
     (filter (fun ix => negb (id_in_list (fst ix) ids)) (internalFunctions p)).
 
-Ltac mkVSU prog internal_specs := 
- lazymatch goal with
-  | |- VSU ?E ?Imports ?qprog ?ASI _ =>
-     let augmented_intspecs := 
-       constr:((*makeSomeVacuousFunspecs qprog internal_specs ++*) internal_specs)
-       in exists augmented_intspecs; mkComponent prog
-  | _ => fail "mkVSU must be applied to a VSU goal"
- end.
 
 
 Lemma prove_idlists_equiv: forall al bl : list ident,
@@ -555,74 +386,6 @@ match al, bl with
         else diff_ident_lists al' bl'
  end.
 
-Ltac ident_diff al bl F :=
-     let l := constr:(map string_of_ident 
-              (diff_ident_lists (linking.SortPos.sort al) 
-                   (linking.SortPos.sort bl))) in
-     let l := eval compute in l
-     in F l. 
-  
-Ltac prove_Comp_G_dom :=
-lazymatch goal with |- forall i, In i ?A <-> In i ?B =>
-  apply prove_idlists_equiv;
-  compute; 
-  try reflexivity; 
-  lazymatch goal with |- ?al = ?bl =>
-     ident_diff al bl ltac:(fun l =>
-     ident_diff bl al ltac:(fun r => 
-      fail "Identifier mismatch!
-Present only in" A ":" l "
-Present only in" B ":" r))
-  end
-end.
-
-
-Ltac mkComponent prog ::=
- hnf;
- match goal with |- Component _ _ ?IMPORTS _ _ _ _ =>
-     let i := compute_list IMPORTS in
-     let IMP := fresh "IMPORTS" in
-     pose (IMP := @abbreviate funspecs i);
-     change_no_check IMPORTS with IMP
- end;
- test_Component_prog_computed;
- let p := fresh "p" in
- match goal with |- @Component _ _ _ _ ?pp _ _ _ => set (p:=pp) end;
- let HA := fresh "HA" in 
-   assert (HA: PTree_samedom cenv_cs ha_env_cs) by repeat constructor;
- let LA := fresh "LA" in 
-   assert (LA: PTree_samedom cenv_cs la_env_cs) by repeat constructor;
- let OK := fresh "OK" in
-  assert (OK: QPprogram_OK p)
-   by (split; [apply compute_list_norepet_e; reflexivity 
-           |  apply (QPcompspecs_OK_i HA LA) ]);
- (* Doing the  set(myenv...), instead of before proving the CSeq assertion,
-     prevents nontermination in some cases  *)
- pose (myenv:= (QP.prog_comp_env (QPprogram_of_program prog ha_env_cs la_env_cs)));
- assert (CSeq: _ = compspecs_of_QPcomposite_env myenv 
-                     (proj2 OK))
-   by (apply compspecs_eq_of_QPcomposite_env; reflexivity);
- subst myenv;
- change (QPprogram_of_program prog ha_env_cs la_env_cs) with p in CSeq;
- clear HA LA;
- exists OK;
-  [ check_Comp_Imports_Exports
-  | apply compute_list_norepet_e; reflexivity || fail "Duplicate funspec among the Externs++Imports"
-  | apply compute_list_norepet_e; reflexivity || fail "Duplicate funspec among the Exports"
-  | apply compute_list_norepet_e; reflexivity
-  | apply forallb_isSomeGfunExternal_e; reflexivity
-  | prove_Comp_G_dom (*intros; simpl; split; trivial; try solve [lookup_tac]*)
-  | let i := fresh in let H := fresh in 
-    intros i H; first [ solve contradiction | simpl in H];
-    repeat (destruct H; [ subst; reflexivity |]); try contradiction
-  | apply prove_G_justified;
-    repeat apply Forall_cons; [ .. | apply Forall_nil];
-    try SF_vacuous
-  | finishComponent
-  | first [ solve [intros; apply derives_refl] | solve [intros; reflexivity] | solve [intros; simpl; cancel] | idtac]
-  ].
-
-
 Definition Vprog_equiv (V' V: varspecs) := 
   fold_right (fun v => Maps.PTree.set (fst v) (snd v)) (Maps.PTree.empty type) V = 
   fold_right (fun v => Maps.PTree.set (fst v) (snd v)) (Maps.PTree.empty type) V'.
@@ -642,98 +405,19 @@ f_equal.
 auto.
 Qed.
 
-Ltac Vprogs_domain_eq :=
- lazymatch goal with |- ?m = ?m' => 
-   let x := constr:(Maps.PTree.map1 (fun _ => tt) m = Maps.PTree.map1 (fun _ => tt) m') in
-   let x := eval compute in x in
-   reflexivity
- end.
+Fixpoint FDM_entries (funs1 funs2 : list (ident * fundef function)): option (list (ident * fundef function * fundef function)) :=
+  match funs1 with
+    nil => Some nil
+  | (i, fd1) :: funs => match find_id i funs2 with 
+                           None => FDM_entries funs funs2 
+                         | Some fd2 => match FDM_entries funs funs2 with
+                                         None => None
+                                       | Some l => Some ((i, fd1, fd2) :: l)
+                                       end
+                        end
+  end.
 
-Ltac apply_semax_body P :=
-lazymatch goal with |- semax_body ?V ?G ?F (?I, ?S) =>
-  lazymatch type of P with semax_body ?V' ?G' ?F' ?IS =>
-    let IS' := eval hnf in IS in 
-    let I' := constr:(fst IS') in 
-    let I' := eval red in I' in
-    let I := eval simpl in I in
-    (tryif unify I I' then idtac
-     else fail 1 "You have provided a semax_body proof for" I' " but required is a semax_body proof for" I);
-    (tryif change G with G' then idtac
-     else fail 1 "Lemma" P "has a Gprog argument of" G' "but you have provided" G);
-    (tryif change F with F' then idtac
-     else fail 1 "Lemma" P "has a fundef argument of" F' "but you have provided" F);
-    let S2 := constr:(snd IS) in 
-    (tryif change (I,S) with IS then idtac
-     else fail 1 "Lemma" P "has a funspec argument of" S "but you have provided" S);
-    (tryif constr_eq V V' then idtac
-     else ((apply (semax_body_permute_Vprog V V'); 
-               [ compute; Vprogs_domain_eq; reflexivity 
-               | ] ) 
-           || (let a := constr:(map fst V') in 
-            let b := constr:(map fst V) in
-            let a' := constr:(map string_of_ident a) in let a' := eval compute in a' in
-            let b' := constr:(map string_of_ident b) in let b' := eval compute in b' in
-            ident_diff a b ltac:(fun l => 
-            ident_diff b a ltac:(fun r =>
-            fail 1 "Lemma" P "has a Vprog argument of" V' "but you have provided" V "
-Present only in" V' ":" l "
-Present only in" V ":" r "
-(if those lists are both empty then the domains are the same but the types differ)")))));
-    exact P
-  end
-end.
-
-Ltac solve_SF_internal P :=
-  apply SF_internal_sound; eapply _SF_internal;
-   [  reflexivity 
-   | repeat apply Forall_cons; try apply Forall_nil; try computable; reflexivity
-   | unfold var_sizes_ok; repeat constructor; try (simpl; rep_lia)
-   | reflexivity
-   | match goal with OK: QPprogram_OK _, CSeq: @eq compspecs _ _ |- _ =>
-       rewrite <- CSeq;
-       clear CSeq OK
-     end;
-     apply_semax_body P
-   | eexists; split; 
-       [ fast_Qed_reflexivity || fail "Lookup for a function identifier in QPglobalenv failed"
-       | fast_Qed_reflexivity || fail "Lookup for a function pointer block in QPglobalenv failed"
-   ]    ].
-
-(* slower*)
-Ltac solve_SF_external_with_intuition B :=
-   first [simpl; split; intuition; [ try solve [entailer!] | try apply B | eexists; split; cbv; reflexivity ] | idtac].
-
-(*Slightly faster*)
-Ltac solve_SF_external B :=
-  first [ split3;
-            [ reflexivity 
-            | reflexivity 
-            | split3;
-                [ reflexivity
-                | reflexivity
-                | split3;
-                   [ left; trivial
-                   | clear; intros ? ? ? ?; try solve [entailer!];
-                     repeat match goal with |- (let (y, z) := ?x in _) _ && _ |--  _ =>
-                                     destruct x as [y z]
-                     end
-                    | split; [ try apply B | eexists; split; cbv; reflexivity ]
-            ] ] ]
-        | idtac ].
-
-Fixpoint FDM_entries (funs1 funs2 : list (ident * fundef function)): option (list (ident * fundef function * fundef function)) :=
-  match funs1 with
-    nil => Some nil
-  | (i, fd1) :: funs => match find_id i funs2 with 
-                           None => FDM_entries funs funs2 
-                         | Some fd2 => match FDM_entries funs funs2 with
-                                         None => None
-                                       | Some l => Some ((i, fd1, fd2) :: l)
-                                       end
-                        end
-  end.
-
-Definition check_FDM_entry (Imports1 Imports2:funspecs)  x :=
+Definition check_FDM_entry (Imports1 Imports2:funspecs) x : Prop :=
   match x with (i, fd1, fd2) =>
    match fd1, fd2 with
       Internal _, Internal _ => fd1 = fd2
@@ -763,7 +447,7 @@ Proof.
   clear p1 p2.
   revert d2 H2 entries H H0; induction d1 as [|[j [?|?]]]; simpl; intros.
   -
-   inv H. inv H1.
+   inv H.
   -
     simpl in H1.
     if_tac in H1.
@@ -794,12 +478,6 @@ Proof.
     eapply IHd1; eauto.
 Qed.
 
-Ltac prove_cspecs_sub := 
-   try solve [split3; intros ?i; apply sub_option_get; repeat constructor].
-
-Ltac solve_entry H H0:=
-     inv H; inv H0; first [ solve [ trivial ] | split; [ reflexivity | eexists; reflexivity] ].
-
 Definition list_disjoint_id (al bl: list ident) :=
   Forall (fun i => id_in_list i bl = false) al.
 
@@ -815,11 +493,6 @@ apply id_in_list_false in H.
 apply list_disjoint_cons_l; auto.
 Qed.
 
-Ltac LDI_tac := 
-   apply Forall_nil ||  (apply Forall_cons; [ reflexivity | LDI_tac ]).
-
-Ltac LNR_tac := apply compute_list_norepet_e; reflexivity.
-
 Definition compute_list_disjoint_id (al bl: list ident) :=
  let m := PTree_Properties.of_list (map (fun i => (i,tt)) al)
  in forallb (fun i => isNone (PTree.get i m)) bl.
@@ -841,11 +514,6 @@ simpl in H0.
 rewrite H0 in H1. inv H1.
 Qed.
 
-Ltac list_disjoint_tac := 
-  apply compute_list_disjoint_id_e; reflexivity.
-
-Ltac ExternsHyp_tac := first [ reflexivity | idtac ].
-
 Inductive Identifier_not_found: ident -> funspecs -> Prop := .
 Inductive Funspecs_must_match (i: ident) (f1 f2: funspec):  Prop := 
 mk_Funspecs_must_match: f1=f2 -> Funspecs_must_match i f1 f2.
@@ -892,8 +560,8 @@ Qed.
 Lemma VSULink': 
     forall Espec E1 Imports1 p1 Exports1 E2 Imports2 p2 Exports2
          GP1 GP2
-         (vsu1 : @VSU Espec E1 Imports1 p1 Exports1 GP1)
-         (vsu2 : @VSU Espec E2 Imports2 p2 Exports2 GP2)
+         (vsu1 : VSU (Espec := Espec) E1 Imports1 p1 Exports1 GP1)
+         (vsu2 : VSU (Espec := Espec) E2 Imports2 p2 Exports2 GP2)
          E Imports p Exports,
        E = G_merge E1 E2 ->
        Imports = VSULink_Imports vsu1 vsu2 ->
@@ -908,7 +576,7 @@ Lemma VSULink':
         initial_world.find_id i Imports1 = Some phi1 ->
         initial_world.find_id i Imports2 = Some phi2 ->
         phi1 = phi2) ->
-       VSU E Imports p Exports (GP1 * GP2)%logic.
+       VSU E Imports p Exports (fun gv => GP1 gv ∗ GP2 gv).
 Proof.
 intros.
 subst.
@@ -1023,8 +691,8 @@ Qed.
 Lemma VSULink'': 
     forall Espec E1 Imports1 p1 Exports1 E2 Imports2 p2 Exports2
          GP1 GP2
-         (vsu1 : @VSU Espec E1 Imports1 p1 Exports1 GP1)
-         (vsu2 : @VSU Espec E2 Imports2 p2 Exports2 GP2)
+         (vsu1 : VSU (Espec := Espec) E1 Imports1 p1 Exports1 GP1)
+         (vsu2 : VSU (Espec := Espec) E2 Imports2 p2 Exports2 GP2)
          E Imports p Exports,
        E = G_merge E1 E2 ->
        Imports = VSULink_Imports vsu1 vsu2 ->
@@ -1036,7 +704,7 @@ Lemma VSULink'':
        SC_test (map fst E1 ++ IntIDs p1) Imports2 Exports1 ->
        SC_test (map fst E2 ++ IntIDs p2) Imports1 Exports2 ->
        imports_agree Imports1 Imports2 ->
-       VSU E Imports p Exports (GP1 * GP2)%logic.
+       VSU E Imports p Exports (fun gv => GP1 gv ∗ GP2 gv).
 Proof.
 intros.
 subst.
@@ -1049,175 +717,11 @@ apply SC_lemma; auto.
 apply imports_agree_e; auto.
 Qed.
 
-Ltac HImports_tac' := clear; repeat apply Forall_cons; try apply Forall_nil; 
-     (reflexivity || match goal with |- imports_agree ?i _ _ =>
-                       fail "Imports disagree at identifier" i end).
-
-Ltac SC_tac :=
- match goal with |- SC_test ?ids _ _ =>
-  let a := eval compute in ids in change ids with a
- end;
- simpl SC_test;
- repeat (apply conj);
- lazymatch goal with
-         | |- Funspecs_must_match ?i _ _ =>
-                 try solve [constructor; unfold abbreviate; 
-                 repeat f_equal
-                 (*occasionally leaves a subgoal, typically because a
-                   change_compspecs needs to be inserted that could not
-                    be identified automatically*)]
-         | |- Identifier_not_found ?i ?fds2 =>
-                 fail "identifer" i "not found in funspecs" fds2
-         | |- True => trivial
-          end.
-(*Alternatives:
-Ltac SC_tac1 :=
- match goal with |- SC_test ?ids _ _ =>
-  let a := eval compute in ids in change ids with a
- end;
- simpl SC_test;
- repeat (apply conj);
- lazymatch goal with
-         | |- Funspecs_must_match ?i _ _ =>
-                 try solve [constructor; unfold abbreviate; 
-                 (*leads sometimes to nontermination: try simple apply eq_refl;*)
-                 repeat f_equal]
-         | |- Identifier_not_found ?i ?fds2 =>
-                 fail "identifer" i "not found in funspecs" fds2
-         | |- True => trivial
-          end.
-
-Ltac SC_tac2 :=
- match goal with |- SC_test ?ids _ _ =>
-  let a := eval compute in ids in change ids with a
- end;
- simpl SC_test;
- repeat (apply conj);
- lazymatch goal with
-         | |- Funspecs_must_match ?i _ _ =>
-                 constructor;
-                 apply mk_funspec_congr;
-                 [ try reflexivity 
-                 | try reflexivity 
-                 | try reflexivity
-                 | (*too aggressive here: try (apply eq_JMeq; trivial)*)
-                 | (*too aggressive here: try (apply eq_JMeq; trivial)*)]
-         | |- Identifier_not_found ?i ?fds2 =>
-                 fail "identifer" i "not found in funspecs" fds2
-         | |- True => trivial
-          end.
-*)
-
-Ltac HImports_tac := simpl;
-  let i := fresh "i" in 
-   intros i ? ? H1 H2;
-  repeat (if_tac in H1; subst; simpl in *; try discriminate);
-    (first [ congruence | inv H1; inv H2; reflexivity | fail "Imports disagree at identifier" i] ).
-
-Ltac ImportsDef_tac := first [ reflexivity | idtac ].
-Ltac ExportsDef_tac := first [ reflexivity | idtac ].
-Ltac domV_tac := compute; tauto.
-
-Ltac find_id_subset_tac := simpl; intros ? ? H;
-  repeat (if_tac in H; [ inv H; simpl; try reflexivity | ]); discriminate.
-
-Ltac ComponentMerge C1 C2 :=
-  eapply (ComponentJoin _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ C1 C2);
-[ list_disjoint_tac
-| list_disjoint_tac
-| list_disjoint_tac
-| list_disjoint_tac
-| LNR_tac
-| LNR_tac
-| prove_cspecs_sub
-| prove_cspecs_sub
-| first [ find_id_subset_tac | idtac]
-| first [ find_id_subset_tac | idtac]
-(*| FDM_tac *)
-(*| FunctionsPreserved_tac *)
-| apply list_disjoint_id_e; LDI_tac
-| apply list_disjoint_id_e; LDI_tac
-| ExternsHyp_tac
-| apply SC_lemma; SC_tac
-| apply SC_lemma; SC_tac
-| HImports_tac
-(*+  HContexts. This is the side condition we'd like to exliminate - it's also
-   why we need to define SubjectComponent/ObserverComponent using DEFINED
-  simpl; intros.
-  repeat (if_tac in H; [ inv H; inv H0 | ]). discriminate.*)
-| ImportsDef_tac
-| ExportsDef_tac
-| LNR_tac
-| LNR_tac
-| domV_tac
-| try (cbv; reflexivity)
-| try (cbv; reflexivity)
-| try (cbv; reflexivity) 
-| first [ find_id_subset_tac | idtac]
-| first [ find_id_subset_tac | idtac]
-].
-
 Lemma VSU_ext {Espec E Imp p Exp GP1 GP2}:
-      @VSU Espec E Imp p Exp GP1 -> GP1=GP2 ->
-      @VSU Espec E Imp p Exp GP2.
+      VSU (Espec := Espec) E Imp p Exp GP1 -> GP1=GP2 ->
+      VSU (Espec := Espec) E Imp p Exp GP2.
 Proof. intros; subst; trivial. Qed.
 
-Ltac compute_QPlink_progs := 
-match goal with |- ?A = _ => 
-  let p1 := eval hnf in A in
-  lazymatch p1 with
- | Errors.Error ?m => fail m
- | Errors.OK ?p' => instantiate (1:=@abbreviate _ p'); reflexivity
- | _ => fail "could not reduce QPlink_prog to hnf"
- end
-end.
-
-Ltac FDM_tac := 
-  try (apply compute_FDM_e;  reflexivity);
-  fail "FDM_tac failed".
-
-Ltac VSULink_tac := 
-eapply VSULink;
-[ compute_QPlink_progs
-| FDM_tac
-| list_disjoint_tac
-| list_disjoint_tac
-| apply SC_lemma; SC_tac
-| apply SC_lemma; SC_tac
-| HImports_tac].
-
-Ltac red_until_NDmk_funspec x :=
- lazymatch x with
- | NDmk_funspec _ _ _ _ _ => uconstr:(x)
- | mk_funspec _ _ _ _ _ _ _ => uconstr:(x)
- | merge_specs ?A ?B => 
-     let b := eval hnf in B in 
-     match b with None => uconstr:(A) | _ => uconstr:(merge_specs A b) end
- | _ => uconstr:(x)
- end.
-
-Ltac simplify_funspecs G :=
-  let x := eval hnf in G in 
- lazymatch x with
- | nil => constr:(x)
- | ?ia :: ?al => let al := simplify_funspecs al in
-                       let ia := eval hnf in ia in
-                       match ia with pair  ?i ?a =>
-                             let b := red_until_NDmk_funspec a in
-                              constr:( (i,@abbreviate _ b)::al )
-                       end
- end.
-
-Ltac compute_VSULink_Imports v1 v2 := 
-  let Imports := uconstr:(VSULink_Imports v1 v2) in
-  let x := eval cbv beta delta [VSULink_Imports] in Imports in
-  match x with VSULink_Imports_aux ?I1 ?I2 ?A ?B =>
-    let k1 := eval compute in A in
-    let k2 := eval compute in B in
-    let x := uconstr:(VSULink_Imports_aux I1 I2 k1 k2) in
-    simplify_funspecs x
- end.
-
 Definition privatize_ids (ids: list ident) (fs: funspecs) : funspecs :=
  filter (fun ix => negb (id_in_list (fst ix) ids)) fs.
 
@@ -1236,9 +740,9 @@ destruct H0; auto.
 Qed.
 
 Lemma privatizeExports
-   {Espec E Imports p Exports GP} (v: @VSU Espec E Imports p Exports GP)
+   {Espec E Imports p Exports GP} (v: VSU (Espec := Espec) E Imports p Exports GP)
    (ids: list ident)  :
-  @VSU Espec E Imports p (privatize_ids ids Exports) GP.
+  VSU (Espec := Espec) E Imports p (privatize_ids ids Exports) GP.
 Proof.
 destruct v as [G comp].
 exists G.
@@ -1250,11 +754,11 @@ apply (Comp_Exports_LNR comp).
 Qed.
 
 Definition restrictExports {Espec E Imports p Exports GP} 
-   (v: @VSU Espec E Imports p Exports GP)
+   (v: VSU (Espec := Espec) E Imports p Exports GP)
    (Exports': funspecs) :=
-   @VSU Espec E Imports p Exports' GP.
+   VSU (Espec := Espec) E Imports p Exports' GP.
 
-Definition funspec_sub_in (fs: funspecs) (ix: ident * funspec) :=
+Definition funspec_sub_in (fs: funspecs) (ix: ident * funspec) : Prop :=
   match find_id (fst ix) fs with
   | Some f => funspec_sub f (snd ix)
   | None => False
@@ -1262,7 +766,7 @@ Definition funspec_sub_in (fs: funspecs) (ix: ident * funspec) :=
 
 Lemma prove_restrictExports
    {Espec E Imports p Exports GP} 
-   (v: @VSU Espec E Imports p Exports GP)
+   (v: VSU (Espec := Espec) E Imports p Exports GP)
    (Exports': funspecs) :
    list_norepet (map fst Exports') ->
    Forall (funspec_sub_in Exports) Exports' ->
@@ -1271,7 +775,7 @@ Proof.
 intros.
 destruct v as [G c].
 exists G.
-apply (@Build_Component _ _ _ _ _ _ _ _ (Comp_prog_OK c)); try apply c; auto.
+apply (Build_Component _ _ _ _ _ _ _ _ (Comp_prog_OK c)); try apply c; auto.
 + intros.
   rewrite Forall_forall in H0.
   apply find_id_e in E0.
@@ -1288,20 +792,11 @@ apply (@Build_Component _ _ _ _ _ _ _ _ (Comp_prog_OK c)); try apply c; auto.
 + intros. apply (Comp_MkInitPred c); auto.
 Qed.
 
-Ltac prove_restrictExports :=
- simple apply prove_restrictExports; 
-   [apply compute_list_norepet_e; reflexivity || fail "Your restricted Export list has a duplicate function name"
-   | repeat apply Forall_cons; try simple apply Forall_nil;
-       red; simpl find_id; cbv beta iota;
-       change (@abbreviate funspec ?A) with A
-   ].
-
-
 (*A Variant of prove_restrictExports that uses "Forall2 funspec_sub"
   rather than Forall  "Forall (funspec_sub_in ..)"*)
 Lemma prove_restrictExports2
    {Espec E Imports p Exports GP} 
-   (v: @VSU Espec E Imports p Exports GP)
+   (v: VSU (Espec := Espec) E Imports p Exports GP)
    (Exports': funspecs) :
    map fst Exports' = map fst Exports ->
    Forall2 funspec_sub (map snd Exports) (map snd Exports') ->
@@ -1310,7 +805,7 @@ Proof.
 intros.
 destruct v as [G c].
 exists G.
-apply (@Build_Component _ _ _ _ _ _ _ _ (Comp_prog_OK c)); try apply c; auto.
+apply (Build_Component _ _ _ _ _ _ _ _ (Comp_prog_OK c)); try apply c; auto.
 + rewrite H. apply c.
 + intros. destruct (find_funspec_sub Exports' Exports H H0 _ _ E0) as [psi [Psi PSI]].
   apply (Comp_G_Exports c) in Psi.
@@ -1319,13 +814,6 @@ apply (@Build_Component _ _ _ _ _ _ _ _ (Comp_prog_OK c)); try apply c; auto.
 + apply (Comp_MkInitPred c).
 Qed.
 
-Ltac prove_restrictExports2 :=
- simple apply prove_restrictExports; 
-   [apply compute_list_norepet_e; reflexivity || fail "Your restricted Export list has a duplicate function name"
-   | 
-   ].
-
-
 Fixpoint replace_spec (specs:funspecs) p (phi:funspec):funspecs :=
   match specs with
      [] => nil
@@ -1341,12 +829,12 @@ Proof. induction specs; simpl; intros.
   + destruct a.
     remember (Pos.eqb p i0) as b; symmetry in Heqb; destruct b; simpl.
     - apply Peqb_true_eq in Heqb. subst i0.
-      remember (Memory.EqDec_ident i p) as b; symmetry in Heqb; destruct b; subst.
+      remember (eq_dec i p) as b; symmetry in Heqb; destruct b; subst.
       * rewrite Pos.eqb_refl; trivial.
       * remember (Pos.eqb i p) as w; symmetry in Heqw; destruct w; simpl in *; trivial.
         apply Pos.eqb_eq in Heqw. congruence.
     - rewrite IHspecs; clear IHspecs.
-      remember (Memory.EqDec_ident i i0) as w; destruct w; symmetry in Heqw; subst; simpl; trivial.
+      remember (eq_dec i i0) as w; destruct w; symmetry in Heqw; subst; simpl; trivial.
       rewrite Pos.eqb_sym, Heqb; trivial.
 Qed.
 
@@ -1369,12 +857,12 @@ Lemma replace_spec_Forall2_funspec_sub p phi: forall (l : funspecs)
   Forall2 funspec_sub (map snd l) (map snd (replace_spec l p phi)).
 Proof. induction l; simpl; intros. constructor. inv LNR; destruct a. specialize (IHl H2); simpl.
    remember ((p =? i)%positive) as b; destruct b; symmetry in Heqb; simpl.
-+ apply Pos.eqb_eq in Heqb; subst. destruct (Memory.EqDec_ident i i); [| contradiction].
++ apply Pos.eqb_eq in Heqb; subst. destruct (eq_dec i i); [| contradiction].
   constructor. trivial.
   simpl in H1. rewrite replace_spec_NotFound in IHl; trivial.
   apply assoclists.find_id_None_iff in H1; rewrite H1 in IHl.
   apply IHl; trivial.
-+ destruct (Memory.EqDec_ident p i); subst. apply Pos.eqb_neq in Heqb; contradiction.
++ destruct (eq_dec p i); subst. apply Pos.eqb_neq in Heqb; contradiction.
   constructor. apply funspec_sub_refl. apply (IHl Hp).
 Qed.
 
@@ -1417,7 +905,7 @@ Proof.
 Qed.
 
 Lemma weakenExports_condition: forall (l specs:funspecs)(LNRL: list_norepet (map fst l)) (LNRspecs: list_norepet (map fst specs)),
-      Forall2 (fun x phi => match x with None => False | Some psi => funspec_sub psi phi end) 
+      Forall2 (fun x phi => match x with None => False%type | Some psi => funspec_sub psi phi end) 
               (map (fun i => find_id i specs) (map fst l)) (map snd l) ->
       Forall2 funspec_sub (map snd specs) (map snd (replace_specs specs l)).
 Proof. induction l; simpl; intros. apply Forall2_funspec_sub_refl. 
@@ -1432,10 +920,10 @@ Qed.
 
 Lemma weakenExports
    {Espec E Imports p Exports GP} 
-   (v: @VSU Espec E Imports p Exports GP)
+   (v: VSU (Espec := Espec) E Imports p Exports GP)
    (newExports: funspecs)
    (L: list_norepet (map fst newExports))
-   (HH: Forall2 (fun x phi => match x with Some psi => funspec_sub psi phi | None => False end)
+   (HH: Forall2 (fun x phi => match x with Some psi => funspec_sub psi phi | None => False%type end)
                 (map (fun i : ident => find_id i Exports) (map fst newExports)) 
                 (map snd newExports)):
    restrictExports v (replace_specs Exports newExports).
@@ -1445,23 +933,17 @@ apply weakenExports_condition; trivial.
 destruct v as [G COMP]; apply COMP.
 Qed.
 
-Ltac weakenExports :=
- simple apply weakenExports; 
-   [apply compute_list_norepet_e; reflexivity || fail "Your restricted Export list has a duplicate function name"
-   | 
-   ].
-
-Lemma QPprogdefs_GFF {p i fd}:QPprogram_OK p ->  (QP.prog_defs p) ! i = Some (Gfun fd) -> genv_find_func (QPglobalenv p) i fd.
+Lemma QPprogdefs_GFF {p i fd}:QPprogram_OK p ->  (QP.prog_defs p) !! i = Some (Gfun fd) -> genv_find_func (QPglobalenv p) i fd.
 Proof. apply QPfind_funct_ptr_exists. Qed.
 
 Definition relaxImports {Espec E Imports p Exports GP} 
-   (v: @VSU Espec E Imports p Exports GP)
+   (v: VSU (Espec := Espec) E Imports p Exports GP)
    (Imports': funspecs) :=
-   @VSU Espec E Imports' p Exports GP.
+   VSU (Espec := Espec) E Imports' p Exports GP.
 
 Lemma prove_relaxImports2
    {Espec E Imports p Exports GP} 
-   (v: @VSU Espec E Imports p Exports GP)
+   (v: VSU (Espec := Espec) E Imports p Exports GP)
    (Imports': funspecs) :
    map fst Imports = map fst Imports' ->
    Forall2 funspec_sub (map snd Imports') (map snd Imports) ->
@@ -1472,7 +954,7 @@ destruct v as [G c].
 assert (LNR1: list_norepet (map fst (QPvarspecs p) ++ map fst (G ++ Imports'))).
 { rewrite map_app, <- H, <- map_app. apply c. }
 exists G.
-apply (@Build_Component _ _ _ _ _ _ _ _ (Comp_prog_OK c)); try apply c; auto.
+apply (Build_Component _ _ _ _ _ _ _ _ (Comp_prog_OK c)); try apply c; auto.
 + rewrite <- H. apply c.
 + intros.
   assert (LNR2: list_norepet (map fst (QPvarspecs p) ++ map fst (Imports' ++ G))).
@@ -1480,7 +962,7 @@ apply (@Build_Component _ _ _ _ _ _ _ _ (Comp_prog_OK c)); try apply c; auto.
     apply list_norepet_append; trivial.
     + rewrite map_app. apply (list_norepet_append_commut). rewrite <- map_app; trivial.
     + eapply list_disjoint_mono; eauto.
-      intros. rewrite map_app. rewrite map_app in H6.  apply in_or_app. apply in_app_or in H6. rewrite or_comm; trivial. }
+      intros. rewrite map_app. rewrite map_app in H6.  apply in_or_app. apply in_app_or in H6. apply or_comm; trivial. }
   eapply SF_ctx_subsumption.
   - eapply (Comp_G_justified c); eassumption.
   - apply (Comp_ctx_LNR c). 
@@ -1491,14 +973,14 @@ apply (@Build_Component _ _ _ _ _ _ _ _ (Comp_prog_OK c)); try apply c; auto.
     rewrite 2 make_tycontext_s_find_id, 2 find_id_app_char.
     remember (find_id j Imports) as w; destruct w; symmetry in Heqw.
     * destruct (find_funspec_sub Imports Imports' H H0 _ _ Heqw) as [psi [Psi PSI]].
-      apply type_of_funspec_sub in PSI; rewrite Psi, PSI; trivial.
+      apply type_of_funspec_sub in PSI; setoid_rewrite Psi; rewrite PSI; trivial.
     * apply find_id_None_iff in Heqw. rewrite H in Heqw. apply find_id_None_iff in Heqw. rewrite Heqw.
       destruct (find_id j G); trivial. destruct (find_id j (QPvarspecs p));  trivial.
   - intros. red. remember (find_id j (Imports ++ G) ) as w; destruct w; trivial; symmetry in Heqw. 
     rewrite find_id_app_char; rewrite find_id_app_char in Heqw.
     remember (find_id j Imports) as q; destruct q; symmetry in Heqq.
     * inv Heqw. destruct (find_funspec_sub _ _ H H0 _ _ Heqq) as [psi [Psi PSI]].
-      rewrite Psi. eexists; split. reflexivity. apply (funspec_sub_sub_si _ _ PSI).
+      setoid_rewrite Psi. eexists; split. reflexivity. apply (funspec_sub_sub_si _ _ PSI).
     * apply find_id_None_iff in Heqq. rewrite H in Heqq. apply find_id_None_iff in Heqq. rewrite Heqq, Heqw.
       eexists; split. reflexivity. apply funspec_sub_si_refl.
 + apply (Comp_MkInitPred c).
@@ -1510,12 +992,12 @@ Lemma replace_spec_Forall2_funspec_sub2 p phi: forall (l : funspecs)
   Forall2 funspec_sub (map snd (replace_spec l p phi)) (map snd l).
 Proof. induction l; simpl; intros. constructor. inv LNR; destruct a. specialize (IHl H2); simpl.
    remember ((p =? i)%positive) as b; destruct b; symmetry in Heqb; simpl.
-+ apply Pos.eqb_eq in Heqb; subst. destruct (Memory.EqDec_ident i i); [| contradiction].
++ apply Pos.eqb_eq in Heqb; subst. destruct (eq_dec i i); [| contradiction].
   constructor. trivial.
   simpl in H1. rewrite replace_spec_NotFound in IHl; trivial.
   apply assoclists.find_id_None_iff in H1; rewrite H1 in IHl.
   apply IHl; trivial.
-+ destruct (Memory.EqDec_ident p i); subst. apply Pos.eqb_neq in Heqb; contradiction.
++ destruct (eq_dec p i); subst. apply Pos.eqb_neq in Heqb; contradiction.
   constructor. apply funspec_sub_refl. apply (IHl Hp).
 Qed.
 
@@ -1526,7 +1008,7 @@ Lemma replace_specSome_funspec_sub2 p phi psi: forall (l : funspecs)
 Proof. intros. eapply replace_spec_Forall2_funspec_sub2. trivial. rewrite Hp; trivial. Qed.
 
 Lemma strengthenImports_condition: forall (l specs:funspecs)(LNRL: list_norepet (map fst l)) (LNRspecs: list_norepet (map fst specs)),
-      Forall2 (fun phi x => match x with None => False | Some psi => funspec_sub phi psi end) 
+      Forall2 (fun phi x => match x with None => False%type | Some psi => funspec_sub phi psi end) 
                (map snd l) (map (fun i => find_id i specs) (map fst l))->
       Forall2 funspec_sub (map snd (replace_specs specs l)) (map snd specs).
 Proof. induction l; simpl; intros. apply Forall2_funspec_sub_refl. 
@@ -1540,11 +1022,11 @@ Proof. induction l; simpl; intros. apply Forall2_funspec_sub_refl.
 Qed.
 Lemma strengthenImports
    {Espec E Imports p Exports GP} 
-   (v: @VSU Espec E Imports p Exports GP)
+   (v: VSU (Espec := Espec) E Imports p Exports GP)
    (newImports: funspecs)
    (L: list_norepet (map fst newImports))
    (IdentsEq: map fst newImports = map fst Imports)
-   (HH:Forall2 (fun phi x => match x with Some psi => funspec_sub phi psi | None => False end)
+   (HH:Forall2 (fun phi x => match x with Some psi => funspec_sub phi psi | None => False%type end)
                (map snd newImports)
                (map (fun i : ident => find_id i Imports) (map fst Imports))):
    relaxImports v (replace_specs Imports newImports).
@@ -1554,78 +1036,9 @@ eapply strengthenImports_condition; trivial. rewrite <- IdentsEq ; trivial.
 rewrite IdentsEq. trivial.
 Qed.
 
-Ltac strengthenImports :=
- simple apply strengthenImports; 
-   [apply compute_list_norepet_e; reflexivity || fail "Your restricted Export list has a duplicate function name"
-   | try reflexivity |
-   ].
-
-Ltac simplify_VSU_type t :=
- lazymatch t with
- | restrictExports _ _ => let t := eval red in t in simplify_VSU_type t
- | privatizeExports _ _ => let t := eval red in t in simplify_VSU_type t
- | relaxImports _ _ => let t := eval red in t in simplify_VSU_type t
- | VSU _ _ _ _ _ => t
- | _ => fail "The type of this supposed VSU is" t "which might be OK but we hesitate to reduce it for fear of blowup"
- end.
-
-Ltac VSULink_type v1 v2 :=
-lazymatch type of v1 with ?t1 => let t1 := simplify_VSU_type t1 in
-lazymatch t1 with 
-  | @VSU ?Espec ?E1 ?Imports1 ?p1 ?Exports1 ?GP1 =>
-lazymatch type of v2 with ?t2 => let t2 := simplify_VSU_type t2 in
-lazymatch t2 with 
-  | @VSU Espec ?E2 ?Imports2 ?p2 ?Exports2 ?GP2 =>
-          let GP := uconstr:((GP1 * GP2)%logic) in
-          let E := uconstr:((G_merge E1 E2)) in
-          let E := simplify_funspecs E in
-          let Imports := compute_VSULink_Imports v1 v2 in
-          let Exports := constr:((G_merge Exports1 Exports2)) in
-          let Exports := simplify_funspecs Exports in
-          let p' := uconstr:((QPlink_progs p1 p2)) in
-          let p'' := eval vm_compute in p' in
-          let p :=
-           lazymatch p'' with
-           | Errors.OK ?p =>
-               uconstr:(@abbreviate _ p)
-           | Errors.Error ?m => fail "QPlink_progs failed:" m
-           end
-          in
-          constr:((@VSU Espec E Imports p Exports GP))
-  | _ => fail "Especs of VSUs don't match"
-end end end end.
-
-Ltac linkVSUs v1 v2 :=
-  let t := VSULink_type v1 v2 in
- match t with @VSU ?Espec ?E ?Imports ?p ?Exports ?GP =>
-   apply (VSULink'' Espec _ _ _ _ _ _ _ _ _ _ v1 v2 E Imports p Exports)
-  end;
-  [ reflexivity | reflexivity | reflexivity | reflexivity
-  | reflexivity || fail "Fundefs_match failed"
-  | reflexivity || fail "Externs of vsu1 overlap with Internals of vsu2"
-  | reflexivity || fail "Externs of vsu2 overlap with Internals of vsu1"
-  | SC_tac
-  | SC_tac
-  | HImports_tac'
-  ].
-
-Ltac linkVSUs_Type v1 v2 := let t := VSULink_type v1 v2 in exact t.
-Ltac linkVSUs_Body v1 v2 :=
-apply (VSULink'' _ _ _ _ _ _ _ _ _ _ _ v1 v2);
-   [ reflexivity
-   | reflexivity
-   | reflexivity
-   | reflexivity
-   | reflexivity || fail "Fundefs_match failed"
-   | reflexivity || fail "Externs of vsu1 overlap with Internals of vsu2"
-   | reflexivity || fail "Externs of vsu2 overlap with Internals of vsu1"
-   | SC_tac
-   | SC_tac
-   | HImports_tac' ].
-
 Definition VSU_of_Component {Espec E Imports p Exports GP G}
-          (c: @Component Espec (QPvarspecs p) E Imports p Exports GP G) : 
-             @VSU Espec E Imports p Exports GP :=
+          (c: Component (Espec := Espec) (QPvarspecs p) E Imports p Exports GP G) : 
+             VSU (Espec := Espec) E Imports p Exports GP :=
   ex_intro _ G c.
 
 Lemma global_is_headptr g i: isptr (globals_of_env g i) -> headptr (globals_of_env g i).
@@ -1641,27 +1054,27 @@ Proof.
 + inv H. econstructor. reflexivity. simpl. apply Z.divide_0_r.
 Qed.
 
-Lemma semax_body_Gmerge1 {cs} V G1 G2 f iphi (SB: @semax_body V G1 cs f iphi)
+Lemma semax_body_Gmerge1 {cs} V G1 G2 f iphi (SB: semax_body V G1 (C := cs) f iphi)
   (G12: forall i phi1 phi2, find_id i G1 = Some phi1 -> find_id i G2 = Some phi2 ->
         typesig_of_funspec phi1 = typesig_of_funspec phi2 /\
         callingconvention_of_funspec phi1 = callingconvention_of_funspec phi2)
    (LNR: list_norepet (map fst V ++ map fst (G_merge G1 G2))):
-   @semax_body V (G_merge G1 G2) cs f iphi.
+   semax_body V (G_merge G1 G2) (C := cs) f iphi.
 Proof. 
 assert (LNR_VG1: list_norepet (map fst V ++ map fst G1)). 
 { clear - LNR. apply list_norepet_append_inv in LNR; destruct LNR as [? [? ?]].
   apply list_norepet_append; trivial.
-  + rewrite (@G_merge_dom G1 G2), map_app in H0.
+  + rewrite (G_merge_dom (l1 := G1) (l2 := G2)), map_app in H0.
     apply list_norepet_append_inv in H0; apply H0.
   + eapply list_disjoint_mono. apply H1. 2: trivial.
-    intros. rewrite (@G_merge_dom G1 G2), map_app. apply in_or_app. left; trivial. }
-assert (LNR_G1: list_norepet (map fst G1)). 
+    intros. rewrite (G_merge_dom (l1 := G1) (l2 := G2)), map_app. apply in_or_app. left; trivial. }
+assert (LNR_G1: list_norepet (map fst G1)).
 { clear - LNR_VG1. apply list_norepet_append_inv in LNR_VG1; apply LNR_VG1. }
 assert (D1: forall j t, find_id j V = Some t -> find_id j G1 = None).
 { clear - LNR. intros.
   apply (@list_norepet_find_id_app_exclusive1 _ _ _ _ LNR) in H.
   apply find_id_None_iff. apply find_id_None_iff in H. intros N; apply H; clear H.
-  rewrite (@G_merge_dom G1 G2), map_app. apply in_or_app. left; trivial. }
+  rewrite (G_merge_dom (l1 := G1) (l2 := G2)), map_app. apply in_or_app. left; trivial. }
 assert (D2: forall j t, find_id j V = Some t -> find_id j G2 = None).
 { clear - LNR LNR_G1. intros.
   apply (@list_norepet_find_id_app_exclusive1 _ _ _ _ LNR) in H.
@@ -1674,14 +1087,14 @@ intros. red. specialize (D1 i); specialize (D2 i).
 remember (find_id i V) as q; destruct q; symmetry in Heqq. 
 + erewrite 2 semax_prog.make_context_g_mk_findV_mk; try eassumption.
   trivial.
-+ remember ((make_tycontext_g V G1) ! i) as w; symmetry in Heqw; destruct w; trivial.
++ remember ((make_tycontext_g V G1) !! i) as w; symmetry in Heqw; destruct w; trivial.
   specialize (G12 i).
   remember (find_id i G1) as a; symmetry in Heqa; destruct a.
   - erewrite semax_prog.make_tycontext_s_g in Heqw.
     2:  rewrite make_tycontext_s_find_id; eassumption. 
     inv Heqw.
     remember (find_id i G2) as b; symmetry in Heqb; destruct b.
-    * destruct (G12 _ _ (eq_refl _) (eq_refl _)); clear G12.
+    * destruct (G12 _ _ (eq_refl _) (eq_refl _)) as (? & ?); clear G12.
       destruct (G_merge_find_id_SomeSome Heqa Heqb H H0) as [psi [Psi PSI]].
       apply funspectype_of_binary_intersection in Psi; destruct Psi.
       erewrite semax_prog.make_tycontext_s_g.
@@ -1694,13 +1107,13 @@ remember (find_id i V) as q; destruct q; symmetry in Heqq.
   - rewrite (semax_prog.make_tycontext_g_G_None _ _ _ Heqa) in Heqw; congruence.
 Qed.
 
-Lemma semax_body_Gmerge2 {cs} V G1 G2 f iphi (SB:@semax_body V G2 cs f iphi)
+Lemma semax_body_Gmerge2 {cs} V G1 G2 f iphi (SB:semax_body V G2 (C := cs) f iphi)
   (G12: forall i phi1 phi2, find_id i G1 = Some phi1 -> find_id i G2 = Some phi2 ->
         typesig_of_funspec phi1 = typesig_of_funspec phi2 /\
         callingconvention_of_funspec phi1 = callingconvention_of_funspec phi2)
-   (LNR_VG1: list_norepet (map fst V ++ map fst G1)) 
+   (LNR_VG1: list_norepet (map fst V ++ map fst G1))
    (LNR_VG2: list_norepet (map fst V ++ map fst G2)):
-   @semax_body V (G_merge G1 G2) cs f iphi.
+   semax_body V (G_merge G1 G2) (C := cs) f iphi.
 Proof.
 assert (LNR: list_norepet (map fst V ++ map fst (G_merge G1 G2))).
 { apply list_norepet_append_inv in LNR_VG1; destruct LNR_VG1 as [? [? ?]].
@@ -1715,7 +1128,7 @@ assert (D1: forall j t, find_id j V = Some t -> find_id j G1 = None).
 { clear - LNR. intros.
   apply (@list_norepet_find_id_app_exclusive1 _ _ _ _ LNR) in H.
   apply find_id_None_iff. apply find_id_None_iff in H. intros N; apply H; clear H.
-  rewrite (@G_merge_dom G1 G2), map_app. apply in_or_app. left; trivial. }
+  rewrite (G_merge_dom (l1 := G1) (l2 := G2)), map_app. apply in_or_app. left; trivial. }
 assert (D2: forall j t, find_id j V = Some t -> find_id j G2 = None).
 { clear - LNR LNR_G1. intros.
   apply (@list_norepet_find_id_app_exclusive1 _ _ _ _ LNR) in H.
@@ -1731,14 +1144,14 @@ intros. red. specialize (D1 i); specialize (D2 i).
 remember (find_id i V) as q; destruct q; symmetry in Heqq. 
 + erewrite 2 semax_prog.make_context_g_mk_findV_mk; try eassumption.
   trivial.
-+ remember ((make_tycontext_g V G2) ! i) as w; symmetry in Heqw; destruct w; trivial.
++ remember ((make_tycontext_g V G2) !! i) as w; symmetry in Heqw; destruct w; trivial.
   specialize (G12 i).
   remember (find_id i G2) as a; symmetry in Heqa; destruct a.
   - erewrite semax_prog.make_tycontext_s_g in Heqw.
     2:  rewrite make_tycontext_s_find_id; eassumption. 
     inv Heqw.
     remember (find_id i G1) as b; symmetry in Heqb; destruct b.
-    * destruct (G12 _ _ (eq_refl _) (eq_refl _)); clear G12.
+    * destruct (G12 _ _ (eq_refl _) (eq_refl _)) as (? & ?); clear G12.
       destruct (G_merge_find_id_SomeSome Heqb Heqa H H0) as [psi [Psi PSI]].
       apply funspectype_of_binary_intersection in Psi; destruct Psi.
       erewrite semax_prog.make_tycontext_s_g.
@@ -1755,7 +1168,7 @@ Lemma globs_to_globvars:
  forall prog rho, 
   Forall (fun ig => isptr (globals_of_env rho (fst ig))) (QPprog_vars prog) ->
  globvars2pred (globals_of_env rho) (QPprog_vars prog)
-  |-- InitGPred (Vardefs prog) (globals_of_env rho).
+  ⊢ InitGPred (Vardefs prog) (globals_of_env rho).
 Proof.
 intros.
 unfold globvars2pred.
@@ -1773,7 +1186,7 @@ apply IHl; auto.
 rewrite InitGPred_consD.
 simpl in H. inv H.
 simpl in H2.
-apply sepcon_derives; auto.
+apply bi.sep_mono; auto.
 clear IHl.
 unfold globs2pred, globvar2pred.
 simpl.
@@ -1788,37 +1201,37 @@ forget (readonly2share (gvar_readonly v)) as sh.
 revert g; induction (gvar_init v); intros; simpl; auto.
 Qed.
 
-Definition main_pre {Z: Type} (prog: QP.program function) (ora: Z) : globals -> argsEnviron -> mpred :=
- (fun gv rho => 
-  !! (gv = initialize.genviron2globals (fst rho) /\ snd rho = []) &&
-   (globvars2pred gv (QPprog_vars prog) * has_ext ora))%logic.
+Definition main_pre (prog: QP.program function) (ora: OK_ty) : globals -> argsassert :=
+ (fun gv => argsassert_of (fun rho =>
+  ⌜gv = initialize.genviron2globals (fst rho) /\ snd rho = []⌝ ∧
+   (globvars2pred gv (QPprog_vars prog) ∗ has_ext ora))).
 
-Definition main_pre_old {Z : Type} (prog : QP.program function) (ora : Z) 
+Definition main_pre_old (prog : QP.program function) (ora : OK_ty)
   (gv : globals) (rho : environ) :=
- !! (gv = globals_of_env rho) &&
-   (globvars2pred gv (QPprog_vars prog) * has_ext ora)%logic.
+ ⌜gv = globals_of_env rho⌝ ∧
+   (globvars2pred gv (QPprog_vars prog) ∗ has_ext ora).
 
 Lemma main_pre_InitGpred:
- forall globs (Espec: OracleKind) (cs: compspecs)  Delta prog1 prog2 Z (ext:Z) (gv: globals) R c Post
-  (H1: globals_ok gv -> InitGPred (Vardefs prog1) gv |-- globs)
+ forall globs (Espec: ext_spec OK_ty) (cs: compspecs) E Delta prog1 prog2 (ext:OK_ty) (gv: globals) R c Post
+  (H1: globals_ok gv -> InitGPred (Vardefs prog1) gv ⊢ globs)
   (H: Vardefs prog1 = Vardefs prog2)
-  (H0: Forall (fun ig : ident * _ => isSome ((glob_types Delta) ! (fst ig))) (QPprog_vars prog2))
-  (H2: semax Delta (sepcon (PROP ( )  LOCAL (gvars gv)  SEP (globs; has_ext ext)) R) c Post),
-  semax Delta (sepcon (close_precondition nil (@main_pre Z prog2 ext gv)) R) c Post.
+  (H0: Forall (fun ig : ident * _ => isSome ((glob_types Delta) !! (fst ig))) (QPprog_vars prog2))
+  (H2: semax E Delta (bi_sep (PROP ( )  LOCAL (gvars gv)  SEP (globs; has_ext ext)) R) c Post),
+  semax E Delta (bi_sep(close_precondition nil (main_pre prog2 ext gv)) R) c Post.
 Proof.
 intros.
 rewrite H in H1. clear H prog1. rename H1 into H.
 eapply semax_pre; [ | apply H2]; clear H2.
 unfold main_pre, PROPx, LOCALx, SEPx, local, lift1.
-intro rho.
+split => rho; monPred.unseal.
 unfold close_precondition.
 simpl. unfold_lift.
 normalize.
 clear H2 H3.
 rewrite prop_true_andp.
 2:{ split; auto. hnf. reflexivity. }
-apply sepcon_derives; auto.
-apply sepcon_derives; auto.
+apply bi.sep_mono; auto.
+apply bi.sep_mono; auto.
 eapply derives_trans; [ | apply H]; clear H.
 2:{
 clear. intro i.
@@ -1827,7 +1240,6 @@ destruct (Map.get (ge_of rho) i); auto.
 left; eexists; eauto.
 }
 unfold Vardefs, InitGPred.
-unfold SeparationLogic.prog_vars.
 clear - H0 H1.
 unfold QPprog_vars in *.
 induction (PTree.elements (QP.prog_defs prog2)); simpl.
@@ -1836,13 +1248,13 @@ destruct a.
 simpl in H0.
 destruct g; simpl; auto.
 inv H0.
-apply sepcon_derives; auto.
+apply bi.sep_mono; auto.
 rewrite prop_true_andp; auto.
 clear - H1 H3.
 destruct H1 as [_ [_ ?]].
 simpl in *.
 specialize (H p).
-destruct ((glob_types Delta) ! p); inv H3.
+destruct ((glob_types Delta) !! p); inv H3.
 specialize (H _ (eq_refl _)) as [b ?].
 unfold initialize.genviron2globals.
 rewrite H.
@@ -1852,57 +1264,13 @@ Qed.
 
 
 Lemma VSU_MkInitPred {Espec E Imports p Exports GP} 
-  (vsu: @VSU Espec E Imports p Exports GP) 
-  (gv: globals) : globals_ok gv -> InitGPred (Vardefs p) gv |-- (GP gv).
+  (vsu: VSU (Espec := Espec) E Imports p Exports GP) 
+  (gv: globals) : globals_ok gv -> InitGPred (Vardefs p) gv ⊢ (GP gv).
 Proof.
 intros. destruct vsu as [G comp].
 apply (Comp_MkInitPred comp); auto.
 Qed.
 
-Ltac report_failure :=
- match goal with |- ?G => fail 99 "expand_main_pre_new failed with goal" G end.
-
-Ltac unfold_all R :=
- match R with
- | sepcon ?a ?ar => let b := unfold_all a in
-                      let br := unfold_all ar in
-                      constr:(sepcon b br)
- | ?a => let x := eval unfold a in a in unfold_all x
- | ?a => constr:(a)
- end.
-
-Ltac expand_main_pre_VSU :=
-  lazymatch goal with
-  | vsu: VSU _ _ _ _ _ |- _ => 
-    (eapply main_pre_InitGpred || report_failure); 
-        [ try apply (VSU_MkInitPred vsu); report_failure
-        | try (unfold Vardefs; simpl; reflexivity); report_failure
-        | try solve [repeat constructor]; report_failure
-        |  ];
-     clear vsu;
-     match goal with
-      |- semax _ (PROPx _ (LOCALx _ (SEPx (?R _ :: _))) * _)%logic _ _ =>
-        let x := unfold_all R in change R with x
-     end;
-     repeat change ((sepcon ?A ?B) ?gv) with (sepcon (A gv) (B gv));
-     change (emp ?gv) with (@emp mpred _ _);
-     rewrite ?emp_sepcon, ?sepcon_emp;
-     repeat match goal with |- semax _ (sepcon ?PQR _) _ _ => flatten_in_SEP PQR end
-  | |- _ => expand_main_pre_old
-  end.
-
-Ltac expand_main_pre ::= 
-   expand_main_pre_VSU.
-
-Ltac start_function2 ::=
-  first [ erewrite compute_close_precondition_eq; [ | reflexivity | reflexivity]
-        | rewrite close_precondition_main
-        | match goal with |- semax (func_tycontext _ ?V ?G _) 
-              (close_precondition _ (main_pre _ _ _) * _)%logic _ _ =>
-                  let x := eval hnf in V in let x := eval simpl in x in change V with x 
-          end
-        ].
-
 Fixpoint vardefs_to_globvars (vdefs: list (ident * globdef (fundef function) type)) :
     list (ident * globvar type) :=
  match vdefs with
@@ -1921,56 +1289,53 @@ Definition vardefs_tycontext (vdefs: list (ident * globdef (fundef function) typ
 Lemma InitGPred_process_globvars:
   forall Delta al gv (R: globals -> mpred),
   Delta = vardefs_tycontext al ->
-  ENTAIL Delta, globvars_in_process gv nil emp (vardefs_to_globvars al) |-- lift0 (R gv) ->
+  ENTAIL Delta, globvars_in_process gv nil emp (vardefs_to_globvars al) ⊢ ⎡R gv⎤ ->
   globals_ok gv ->
-  InitGPred al gv |-- R gv.
+  InitGPred al gv ⊢ R gv.
 Proof.
 intros until 2. intro Hgv; intros.
 unfold globvars_in_process in H0.
 simpl fold_right_sepcon in H0.
-rewrite sepcon_emp, emp_sepcon in H0. 
-pose (rho := 
- mkEnviron 
+rewrite !emp_sep in H0.
+pose (rho :=
+ mkEnviron
   (fun i => match gv i with Vptr b _ => Some b | _ => None end)
   (Map.empty (block * type))
   (Map.empty val)).
-eapply derives_trans; [ | apply (H0 rho)].
+generalize (monPred_in_entails _ _ H0 rho); monPred.unseal; intros <-.
 clear R H0; subst Delta.
 unfold local, lift1.
-simpl.
 normalize.
 subst rho.
 unfold tc_environ, typecheck_environ.
 simpl.
-rewrite prop_and.
-rewrite <- and_assoc.
-rewrite prop_and.
+rewrite <- !and_assoc', and_assoc', pure_and.
 rewrite prop_true_andp.
 -
-apply andp_right.
+apply bi.and_intro.
 *
 apply derives_trans with
-(!! (Forall (fun x : (ident * globdef (fundef function) type) => let (i, d) := x in
-      match d with Gfun _ => True | Gvar v => headptr (gv i) end) al)).
+(⌜Forall (fun x : (ident * globdef (fundef function) type) => let (i, d) := x in
+      match d with Gfun _ => True | Gvar v => headptr (gv i) end) al⌝).
 +
-apply derives_trans with (TT * InitGPred al gv)%logic. cancel.
+apply derives_trans with (True ∗ InitGPred al gv). cancel.
 induction al.
-apply prop_right; constructor.
+apply bi.pure_intro; constructor.
 rewrite InitGPred_consD.
 unfold globs2pred.
 destruct a. destruct g.
-rewrite emp_sepcon; auto.
+rewrite emp_sep; auto.
 eapply derives_trans; [apply IHal |].
-apply prop_derives. intros. constructor; auto.
+apply bi.pure_mono. intros. constructor; auto.
 normalize.
-rewrite <- sepcon_assoc.
+rewrite sep_assoc.
 eapply derives_trans; [ eapply derives_trans; [ | apply IHal] | ].
 cancel.
 clear IHal.
-apply prop_derives.
+apply bi.pure_mono.
 intros. constructor; auto.
 +
-apply andp_right; apply prop_derives; intros.
+rewrite pure_and; apply bi.and_intro; apply bi.pure_mono; intros.
  --
 induction al; simpl.
 hnf; intros. rewrite PTree.gempty in H0; inv H0.
@@ -1992,7 +1357,7 @@ rewrite PTree.gso in H by auto.
 specialize (IHal H).
 destruct IHal as [b ?]; exists b.
 unfold Map.get in *.
-destruct (Memory.EqDec_ident i id); try congruence.
+destruct (eq_dec i id); try congruence.
  --
 unfold gvars_denote.
 simpl ge_of.
@@ -2005,13 +1370,11 @@ rewrite Hgv; auto.
 induction al; simpl. 
 rewrite InitGPred_nilD. auto.
 rewrite InitGPred_consD.
-rewrite fold_right_map in IHal.
-rewrite fold_right_map.
+rewrite IHal.
 destruct a. destruct g.
-simpl. rewrite emp_sepcon; auto.
+simpl. rewrite emp_sep; auto.
 simpl.
 normalize.
-apply sepcon_derives; auto.
 -
 split.
 hnf; intros. rewrite PTree.gempty in H; inv H.
@@ -2021,13 +1384,13 @@ destruct H. unfold Map.get, Map.empty in H.  inv H.
 Qed.
 
 Lemma finish_process_globvars' :
- forall gv (done: list mpred) (R: mpred), 
-  fold_right_sepcon done |-- R -> 
-globvars_in_process gv done emp nil |-- lift0 R.
+ forall gv (done: list mpred) (R: mpred),
+  (fold_right_sepcon done ⊢ R) -> 
+globvars_in_process gv done emp nil ⊢ ⎡R⎤.
 Proof.
 intros.
-intro rho.
-unfold globvars_in_process, globvars2pred, lift0. simpl.
+unfold globvars_in_process, globvars2pred.
+split => rho; monPred.unseal. unfold lift1.
 normalize.
 Qed.
 
@@ -2039,8 +1402,6 @@ destruct (H i); auto.
 rewrite H1 in H0; contradiction.
 Qed.
 
-#[export] Hint Resolve globals_ok_isptr_headptr: core.
-
 Lemma globals_ok_genviron2globals:
   forall g,  globals_ok (initialize.genviron2globals g).
 Proof.
@@ -2049,27 +1410,8 @@ destruct (Map.get g i); auto.
 left; eexists; eauto.
 Qed.
 
-#[export] Hint Resolve globals_ok_genviron2globals : core.
-
 Definition VSU_initializer {cs: compspecs} (prog: Clight.program) (Gpred: globals -> mpred) :=
- forall gv, globals_ok gv -> InitGPred (Vardefs (QPprog prog)) gv |-- Gpred gv.
-
-Ltac InitGPred_tac :=
-intros ? ?;
-eapply InitGPred_process_globvars; auto;
-let Delta := fresh "Delta" in let Delta' := fresh "Delta'" in 
-set (Delta' := vardefs_tycontext _);
-set (Delta := @abbreviate tycontext Delta');
-change Delta' with Delta;
-hnf in Delta'; simpl in Delta'; subst Delta';
-simpl vardefs_to_globvars;
-try match goal with |- context [PTree.prev ?A] =>
-  let a := constr:(PTree.prev A) in let a := eval compute in a in
-    change (PTree.prev A) with a end;
-eapply derives_trans; [process_globals | ];
-clear Delta;
-apply finish_process_globvars'; unfold fold_right_sepcon at 1;
-repeat change_mapsto_gvar_to_data_at.
+ forall gv, globals_ok gv -> InitGPred (Vardefs (QPprog prog)) gv ⊢ Gpred gv.
 
 Definition QPprog' {cs: compspecs} 
   {comps: list composite_definition}
@@ -2118,28 +1460,6 @@ apply extract_compEnv.
 apply cenv_built_correctly_e; auto.
 Qed.
 
-Ltac QPprog p :=
-  tryif (let p' := eval cbv delta [p] in p in
-          match p' with Clightdefs.mkprogram _ _ _ _ _ => idtac end)
-  then (let a := constr:(QPprog' p (eq_refl _)) in
-           (let q := constr:(a (eq_refl _)) in
-            let q := eval hnf in q in
-            let q := eval simpl in q in
-            exact (@abbreviate _ q))
-          || match type of a with ?e -> _ =>
-                 let e := eval hnf in e in
-                 let e :=eval simpl in e in
-                 lazymatch e with
-                 | Errors.OK _ => fail 0 "impossible error in QPprog'"
-                 | Errors.Error ?m => fail 0 m
-                 end
-                end)
-  else (idtac "Remark: QPprog alternate path!";
-         let q := constr:(QPprog p) in 
-         let q := eval hnf in q in
-         let q := eval simpl in q in
-         exact (@abbreviate _ q)).
-
 Lemma wholeprog_varspecsJoin:
  forall p1 p2 p, 
  QPlink_progs p1 p2 = Errors.OK p ->
@@ -2158,10 +1478,10 @@ destruct (find_id i (QPvarspecs p)) eqn:?H.
     subst t.
     rewrite H1 in H.
     split; auto.
-    destruct ((QP.prog_defs p1) ! i).
-    * destruct H as [? [? ?]]. destruct g; inv H. destruct f; inv  H4.
+    destruct ((QP.prog_defs p1) !! i).
+    * destruct H as [? [? ?]]. destruct g; inv H. destruct f; inv H4.
       apply Errors.bind_inversion in H4. destruct H4 as [g [MGg Hg]]; inv Hg.
-      inv H2. apply merge_globvar_elim in MGg. red in MGg.
+      apply merge_globvar_elim in MGg. red in MGg.
       destruct v; destruct x0. destruct MGg as [GV [[GVI G] | [GVI G]]]; subst.
       simpl; trivial.
       simpl; symmetry. apply GV.
@@ -2171,7 +1491,7 @@ destruct (find_id i (QPvarspecs p)) eqn:?H.
   apply find_id_QPvarspecs in H1. destruct H1 as [? [? ?]].
   subst t.
   rewrite H1 in *.
-  destruct ((QP.prog_defs p1) ! i) eqn:?H.
+  destruct ((QP.prog_defs p1) !! i) eqn:?H.
   - destruct H as [? [? ?]].
     destruct g as [[|]|]; inv H.
     (*destruct v,x; inv H5. admit.*)
@@ -2201,14 +1521,14 @@ auto.
 Qed.
 
 Definition Comp_GP {Espec V E Imports p Exports GP G} 
-  (c: @Component Espec V E Imports p Exports GP G) := GP.
+  (c: Component (Espec := Espec) V E Imports p Exports GP G) := GP.
 
 Lemma ComponentJoin':
  forall
   {Espec V1 E1 Imports1 p1 Exports1 GP1 G1} 
-     (c1: @Component Espec V1 E1 Imports1 p1 Exports1 GP1 G1)
+     (c1: Component (Espec := Espec) V1 E1 Imports1 p1 Exports1 GP1 G1)
   {V2 E2 Imports2 p2 Exports2 GP2 G2}
-     (c2: @Component Espec V2 E2 Imports2 p2 Exports2 GP2 G2)
+     (c2: Component (Espec := Espec) V2 E2 Imports2 p2 Exports2 GP2 G2)
   V E Imports p Exports GP G,
   QPlink_progs p1 p2 = Errors.OK p ->
        list_norepet (map fst V) ->
@@ -2239,26 +1559,17 @@ Lemma ComponentJoin':
      E = G_merge E1 E2 ->
      Imports = JoinedImports E1 Imports1 E2 Imports2 p1 p2 ->
      Exports = G_merge Exports1 Exports2 ->
-     GP = (GP1 * GP2)%logic ->
+     GP = (fun gv => GP1 gv ∗ GP2 gv) ->
      G = G_merge (Comp_G c1) (Comp_G c2) ->
-  @Component Espec V E Imports p Exports GP G.
+  Component (Espec := Espec) V E Imports p Exports GP G.
 Proof.
 intros.
 subst.
 apply ComponentJoin; auto.
 Qed.
 
-Ltac QPlink_progs p1 p2 :=
-  let p' :=  constr:(QPlink_progs  p1 p2) in
-  let p'' := eval vm_compute in p' in
-  let p := lazymatch p'' with
-               | Errors.OK ?p => constr:(@abbreviate _ p)
-               | Errors.Error ?m => fail "QPlink_progs failed:" m
-               end in
-  exact p.
-
 Definition matchImportExport (p: QP.program function) (ix: ident * funspec) : bool :=
-  match (QP.prog_defs p) ! (fst ix) with
+  match (QP.prog_defs p) !! (fst ix) with
   | Some (Gfun (External _ _ _ _)) => true
   | _ => false
   end.
@@ -2267,34 +1578,34 @@ Definition MainCompType
    (mainE: funspecs)
    (main_prog: QP.program function)
    {Espec coreE coreprog coreExports coreGP}
-   (coreVSU: @VSU Espec coreE nil coreprog coreExports coreGP)
+   (coreVSU: VSU (Espec := Espec) coreE nil coreprog coreExports coreGP)
    (whole_prog: QP.program function)
    (main_spec: funspec)
    GP :=
-   @Component Espec (QPvarspecs whole_prog) mainE 
+   Component (Espec := Espec) (QPvarspecs whole_prog) mainE 
              (filter (matchImportExport main_prog) (VSU_Exports coreVSU))
              main_prog [(QP.prog_main main_prog, main_spec)] GP [(QP.prog_main main_prog, main_spec)].
 (*
 Definition WholeCompType 
    {Espec coreE coreprog coreExports coreGP}
-   (coreVSU: @VSU Espec coreE nil coreprog coreExports coreGP)
+   (coreVSU: VSU (Espec := Espec) coreE nil coreprog coreExports coreGP)
    {mainE mainprog whole_prog main_spec mainGP} 
    (mainComponent: MainCompType mainE mainprog coreVSU whole_prog main_spec mainGP)
  := 
   exists G,
-  @Component Espec (QPvarspecs whole_prog) (G_merge mainE coreE) nil whole_prog [(QP.prog_main mainprog, main_spec)]
-    (mainGP * coreGP)%logic (G_merge [(QP.prog_main mainprog, main_spec)] G).
+  Component (Espec := Espec) (QPvarspecs whole_prog) (G_merge mainE coreE) nil whole_prog [(QP.prog_main mainprog, main_spec)]
+    (mainGP * coreGP) (G_merge [(QP.prog_main mainprog, main_spec)] G).
 *)
 Definition WholeCompType 
    {Espec coreE coreprog coreExports coreGP}
-   (coreVSU: @VSU Espec coreE nil coreprog coreExports coreGP)
+   (coreVSU: VSU (Espec := Espec) coreE nil coreprog coreExports coreGP)
    {mainE mainprog whole_prog main_spec mainGP} 
    (mainComponent: MainCompType mainE mainprog coreVSU whole_prog main_spec mainGP)
  := 
   exists G,
   find_id (QP.prog_main whole_prog) G = None /\
-  @Component Espec (QPvarspecs whole_prog) (G_merge mainE coreE) nil whole_prog [(QP.prog_main mainprog, main_spec)]
-    (mainGP * coreGP)%logic (G_merge [(QP.prog_main mainprog, main_spec)] G).
+  Component (Espec := Espec) (QPvarspecs whole_prog) (G_merge mainE coreE) nil whole_prog [(QP.prog_main mainprog, main_spec)]
+    (fun gv => mainGP gv ∗ coreGP gv) (G_merge [(QP.prog_main mainprog, main_spec)] G).
 
 Lemma QPlink_progs_main:
   forall p1 p2 p, QPlink_progs p1 p2 = Errors.OK p ->
@@ -2311,7 +1622,7 @@ Qed.
 
 Lemma WholeComponent
    {Espec coreE coreprog coreExports coreGP}
-   (coreVSU: @VSU Espec coreE nil coreprog coreExports coreGP)
+   (coreVSU: VSU (Espec := Espec) coreE nil coreprog coreExports coreGP)
    {mainE mainprog whole_prog main_spec mainGP} 
    (mainComponent: MainCompType mainE mainprog coreVSU whole_prog main_spec mainGP)
    (Linked: QPlink_progs mainprog coreprog = Errors.OK whole_prog)
@@ -2329,7 +1640,7 @@ destruct coreVSU as [coreG coreC].
 exists coreG.
 split. {
  rewrite find_id_None_iff.
- rewrite <- (Comp_G_dom coreC).
+ setoid_rewrite <- (Comp_G_dom coreC).
  apply id_in_list_false in Hmain.
  contradict Hmain. apply in_app; right; auto.
 }
@@ -2349,10 +1660,10 @@ eapply Comp_Exports_sub2;
    apply QPlink_progs_globdefs in Linked.
    apply (merge_PTrees_e i) in Linked.
    rewrite H1 in Linked. clear H1.
-   destruct ((QP.prog_defs mainprog) ! i) eqn:?H.
+   destruct ((QP.prog_defs mainprog) !! i) eqn:?H.
    destruct Linked as [? [? ?]]. destruct g as [[?|?]|?]; inv H1.
-   revert H4; simple_if_tac; intros; inv  H4. congruence.
-   revert H4; simple_if_tac; intros; inv  H4. congruence.
+   revert H4; simple_if_tac; intros; inv H4.
+   revert H4; simple_if_tac; intros; inv H4.
    congruence.
   +
    intros i j ? ? ?; subst j.
@@ -2365,13 +1676,12 @@ eapply Comp_Exports_sub2;
    apply find_id_i in H0; [ | apply QPvarspecs_norepet].
    apply find_id_QPvarspecs in H0. destruct H0 as [? [? ?]]; subst.
    rewrite H in Linked; clear H.
-   destruct ((QP.prog_defs mainprog) ! i) eqn:?H.
+   destruct ((QP.prog_defs mainprog) !! i) eqn:?H.
    destruct Linked as [? [? ?]]. destruct g as [[?|?]|?]; inv H1.
    simpl in H0.
-   revert H0; simple_if_tac; intros; inv  H0.
+   revert H0; simple_if_tac; intros; inv H0.
    simpl in H0.
-   revert H0; simple_if_tac; intros; inv  H0.
-   inv H0.
+   revert H0; simple_if_tac; intros; inv H0.
    inv Linked.
 - intros i j ? ? ?.
    apply (Disj1 i j); auto.
@@ -2450,8 +1760,8 @@ Definition QPall_initializers_aligned (p: QP.program Clight.function) : bool :=
     (init_data_list_size (gvar_init (snd idv)) <? Ptrofs.modulus))%bool)
   (QPprog_vars p).
 
-Definition QPmain_spec_ext' {Z} (prog: QP.program function) (ora: Z)
-(post: (ident->val) -> environ -> mpred): funspec :=
+Definition QPmain_spec_ext' (prog: QP.program function) (ora: OK_ty)
+(post: (ident->val) -> assert): funspec :=
 NDmk_funspec (nil, tint) cc_default (ident->val) (main_pre prog ora) post.
 
 Definition wholeprog_of_QPprog (p: QP.program function) 
@@ -2473,7 +1783,7 @@ Definition wholeprog_of_QPprog (p: QP.program function)
  |}.
 
 Lemma prog_funct'_app:
-  forall {F V} al bl, @prog_funct' F V al ++ SeparationLogic.prog_funct' bl = 
+  forall {F V} al bl, @prog_funct' F V al ++ prog_funct' bl = 
                   prog_funct' (al++bl).
 Proof.
 intros.
@@ -2500,7 +1810,7 @@ simpl. rewrite eqb_ident_false; auto. intro; subst; contradiction.
 destruct H.
 rewrite eqb_ident_true in H0. simpl in H0.
 rewrite filter_redundant in H0.
-destruct H. inv H; auto.  
+destruct H. inv H; auto.
 apply (in_map fst) in H. simpl in H. contradiction.
 intros [j ?] ?. simpl. rewrite eqb_ident_false; auto. intro; subst.
 apply (in_map fst) in H1. simpl in H1. contradiction.
@@ -2594,7 +1904,7 @@ Lemma augment_funspecs'_exists:
   (G_LNR : list_norepet (map fst G))
   (Gsub: forall i, In i (map fst G) -> In i (map fst fs)),
  exists G' : funspecs,
-  augment_funspecs'  (prog_funct' (map of_builtin builtins) ++  fs) G =
+  augment_funspecs'  (prog_funct' (map of_builtin builtins) ++ fs) G =
     Some G'.
 Proof.
 intros.
@@ -2702,11 +2012,11 @@ Proof.
 Qed.
 
 Definition unspecified_info (ge: Genv.t (fundef function) type)
-    (ix: ident * fundef function) :=
+    (ix: ident * fundef function) : Prop :=
  let (id, g) := ix in
         match g with
         | Internal f => True
-       | External ef argsig retsig cc =>  
+       | External ef argsig retsig cc =>
           exists b, 
           Genv.find_symbol ge id = Some b /\
           Genv.find_funct_ptr ge b = Some g /\
@@ -2717,7 +2027,7 @@ Definition unspecified_info (ge: Genv.t (fundef function) type)
  end. 
 
 Lemma SF_semax_func:
-  forall (Espec : OracleKind)
+  forall (Espec : ext_spec OK_ty)
      (V: varspecs)
      (cs : compspecs)
      (ge: Genv.t (fundef function) type)
@@ -2727,9 +2037,9 @@ Lemma SF_semax_func:
     (f : funspec)
      (G' G0 : funspecs)
     (H5 : ~ In i (map fst fds'))
-    (H7 : @SF Espec cs V ge G0 i fd f)
-    (H8 : @semax_func Espec V G0 cs ge fds' G'),
-  @semax_func Espec V G0 cs ge ((i, fd) :: fds') ((i, f) :: G').
+    (H7 : SF (Espec := Espec) (cs := cs) (V := V) (ge := ge) G0 i fd f)
+    (H8 : semax_func (OK_spec := Espec) V G0 (C := cs) ge fds' G'),
+  semax_func (OK_spec := Espec) V G0 (C := cs) ge ((i, fd) :: fds') ((i, f) :: G').
 Proof.
 intros.
  destruct fd.
@@ -2742,10 +2052,10 @@ intros.
    rewrite H.
    rewrite id_in_list_false_i; auto.
   *
-   destruct f, t0.
+   destruct f, sig.
    hnf in H7; decompose [and] H7; clear H7.
-   subst t0 c0 l.
-   destruct H10 as [b [? ?]].  
+   subst.
+   destruct H10 as [b [? ?]].
    apply semax_func_cons_ext with b; auto.
    apply id_in_list_false_i; auto.
 Qed.
@@ -2759,14 +2069,14 @@ Definition builtin_unspecified_OK (ge : Genv.t (fundef function) type)
    (ib: ident * QP.builtin) :=
  let (i,builtin) := ib in
   match Genv.find_symbol ge i with None => false
-  | Some loc => 
+  | Some loc =>
     match Genv.find_funct_ptr ge loc with None => false
-    | Some g => 
+    | Some g =>
       andb (fundef_eq (snd (of_builtin' ib)) g)
       match g with
      | Internal _ => true
-     | External ef argsig retsig cc =>  
-            eqb_signature (ef_sig ef) 
+     | External ef argsig retsig cc =>
+            eqb_signature (ef_sig ef)
               {|
              sig_args := map argtype_of_type argsig;
              sig_res := rettype_of_type retsig;
@@ -2790,7 +2100,7 @@ Definition funct_unspecified_OK (ge : Genv.t (fundef function) type)
               {|
              sig_args := map argtype_of_type argsig;
              sig_res := rettype_of_type retsig;
-             sig_cc := cc |})
+             sig_cc := cc |} )
       end
    end
   end.
@@ -2800,7 +2110,7 @@ Definition all_unspecified_OK (p: QP.program function) :=
           (forallb (funct_unspecified_OK (QPglobalenv p)) (QPprog_funct p)) = true.
 
 Lemma all_unspecified_OK_e:
-   forall p,     
+   forall p,
    all_unspecified_OK p ->
    forall i fd, In (i,fd) (map of_builtin' (QP.prog_builtins p) ++ QPprog_funct p) ->
       unspecified_info (QPglobalenv p) (i, fd).
@@ -2855,7 +2165,7 @@ exists b; split3; auto.
 Qed.
 
 Lemma augment_funspecs_semax_func:
-forall (Espec : OracleKind)
+forall (Espec : ext_spec OK_ty)
   (G : funspecs)
   (V : varspecs)
   (fds : list (ident * fundef function))
@@ -2866,7 +2176,7 @@ forall (Espec : OracleKind)
           find_id i fds = Some fd -> genv_find_func ge i fd)
   (cs : compspecs)
   (H : forall i phi, find_id i G = Some phi ->
-         exists fd : fundef function, In (i, fd) fds /\ @SF Espec cs V ge G i fd phi)
+         exists fd : fundef function, In (i, fd) fds /\ SF (Espec := Espec) (cs := cs) (V := V) (ge := ge) G i fd phi)
   (V_FDS_LNR : list_norepet (map fst V ++ map fst fds))
   (VG_LNR : list_norepet (map fst V ++ map fst G))
   (G' : funspecs)
@@ -2882,7 +2192,7 @@ pose (G0 := G').
 change G' with G0 at 1. 
 assert (forall i phi, find_id i G' = Some phi ->
           exists fd, In (i,fd) fds /\ 
-           (@SF Espec cs V ge G0 i fd phi
+           (SF (Espec := Espec) (cs := cs) (V := V) (ge := ge) G0 i fd phi
             \/ ~In i (map fst G) /\ 
                   ( unspecified_info ge (i,fd))
                     /\ phi = vacuous_funspec fd)). {
@@ -2897,7 +2207,7 @@ intros.
      destruct H.
      simpl in H0. if_tac in H0. inv H0.
      apply find_id_i in H; auto.
-     destruct (IHaugment_funspecs_rel); try clear IHaugment_funspecs_rel; 
+     destruct (IHaugment_funspecs_rel); try clear IHaugment_funspecs_rel;
        auto.
      intros; apply EXT_OK. right; auto.
     subst G1. apply list_norepet_map_fst_filter; auto.
@@ -2916,7 +2226,7 @@ intros.
   intros; apply EXT_OK. right; auto.
   destruct H4 as [? [? ?]]; right; simpl; eauto.
  -  inv H0.
- } 
+ }
  destruct H1.
 - apply H in H1.
  destruct H1 as [fd [? ?]]; exists fd; split; auto; left; auto.
@@ -2970,7 +2280,7 @@ assert (H0': forall (i : ident) (phi : funspec),
      find_id i G' = Some phi ->
      exists fd : fundef function,
        In (i, fd) fds /\
-       (@SF Espec cs V ge G0 i fd phi \/
+       (SF (Espec := Espec) (cs := cs) (V := V) (ge := ge) G0 i fd phi \/
         ~ In i (map fst G) /\
         (isInternal (Gfun fd) = false /\ unspecified_info ge (i, fd))
         /\  phi = vacuous_funspec fd)). {
@@ -2998,16 +2308,15 @@ induction H3; [ | | apply semax_func_nil]; rename IHaugment_funspecs_rel into IH
    rewrite list_norepet_app; split3; auto.
    apply list_disjoint_cons_right in DISJ; auto.
  }
- simpl in HfdsG'; inv HfdsG'.
- specialize (IH H4).
+ specialize (IH HfdsG').
  spec IH. {
    intros.
-   assert (i0<>i). {intro; subst i0. rewrite H4 in H5. apply H5.
+   assert (i0<>i). {intro; subst i0. rewrite HfdsG' in H5. apply H5.
       apply find_id_In_map_fst in H2; auto.
    }
    destruct (H0 i0 phi); clear H0.
    simpl. rewrite if_false by auto. auto.
-   destruct H9 as [? [ ? | [H99 [? ?]]]].
+   destruct H8 as [? [ ? | [H99 [? ?]]]].
    simpl in H0. destruct H0; [congruence | ].
    exists x; auto.
    exists x; split.  simpl in H0. destruct H0; auto; congruence. right; split3; auto.
@@ -3026,7 +2335,7 @@ induction H3; [ | | apply semax_func_nil]; rename IHaugment_funspecs_rel into IH
      rewrite list_norepet_app in V_FDS_LNR; destruct V_FDS_LNR as [? [??]].
      simpl in H5. inv H5.
      rewrite list_norepet_app; split3; auto.
-     apply list_disjoint_cons_right in H6; auto.   
+     apply list_disjoint_cons_right in H6; auto.
    }
    specialize (IH H4).
    spec IH. {
@@ -3034,7 +2343,7 @@ induction H3; [ | | apply semax_func_nil]; rename IHaugment_funspecs_rel into IH
        assert (i0<>i). {intro; subst i0.
        rewrite list_norepet_app in V_FDS_LNR; destruct V_FDS_LNR as [_ [? _]].
       simpl in H5; inv H5.
-      apply H8. rewrite H4.   
+      apply H8. rewrite H4.
       apply find_id_In_map_fst in H2; auto.
       }
      destruct (H0 i0 phi); clear H0.
@@ -3067,14 +2376,13 @@ induction H3; [ | | apply semax_func_nil]; rename IHaugment_funspecs_rel into IH
    destruct fd.
    inv H99.
    destruct H6 as [b [? [? ?]]].
-   eapply semax_func_cons_ext_vacuous; try eassumption. 
+   eapply semax_func_cons_ext_vacuous; try eassumption.
    rewrite list_norepet_app in V_FDS_LNR; destruct V_FDS_LNR as [_ [? _]].
-   destruct H6.
-   inv H9. apply id_in_list_false_i; auto.
+   inv H8. apply id_in_list_false_i; auto.
 Qed.
 
 Definition prog_of_component {Espec Externs p Exports GP G}
-  (c: @Component Espec (QPvarspecs p) Externs nil p Exports GP G)
+  (c: Component (Espec := Espec) (QPvarspecs p) Externs nil p Exports GP G)
   (H: cenv_built_correctly
          (map compdef_of_compenv_element
             (sort_rank (PTree.elements (QP.prog_comp_env p)) []))
@@ -3085,7 +2393,7 @@ Definition prog_of_component {Espec Externs p Exports GP G}
 
 Lemma WholeComponent_semax_func:
  forall {Espec Externs p Exports GP G}
-  (c: @Component Espec (QPvarspecs p) Externs nil p Exports GP G)
+  (c: Component (Espec := Espec) (QPvarspecs p) Externs nil p Exports GP G)
   (EXT_OK: all_unspecified_OK p)
   (DEFS_NOT_BUILTIN: forallb not_builtin (PTree.elements (QP.prog_defs p)) = true)
   (CBC: cenv_built_correctly
@@ -3094,10 +2402,10 @@ Lemma WholeComponent_semax_func:
          (composite_env_of_QPcomposite_env (QP.prog_comp_env p)
             (projT1 (proj2 (Comp_prog_OK c))))  =  Errors.OK tt),  (* should be part of QPprogram_OK *)
  let prog := prog_of_component c CBC in
-  @semax_func Espec
-  (QPvarspecs p) (augment_funspecs prog G) (Comp_cs c)
+  semax_func (OK_spec := Espec)
+  (QPvarspecs p) (augment_funspecs prog G) (C := Comp_cs c)
   (Genv.globalenv prog)
-  (SeparationLogic.prog_funct prog)
+  (prog_funct prog)
   (augment_funspecs prog G).
 Proof.
 intros.
@@ -3123,7 +2431,6 @@ assert (GFF: forall i fd,
  apply (semax_prog.in_prog_funct_in_prog_defs _ _ _ H).
 }  
 unfold augment_funspecs.
-change SeparationLogic.prog_funct with prog_funct in *.
 change (Genv.globalenv prog) with (QPglobalenv p) in *.
 rewrite (prog_funct_QP_prog_funct _ p (Comp_prog_OK c) 
    (cenv_built_correctly_e _ _ CBC)) by reflexivity.
@@ -3147,8 +2454,8 @@ assert  (Gsub: forall i, In i (map fst G) ->
 assert (forall i phi, 
     find_id i G = Some phi ->
    exists fd, In (i, fd) (prog_funct' (map of_builtin (QP.prog_builtins p)) ++ QPprog_funct' (PTree.elements (QP.prog_defs p))) /\
- @SF Espec (Comp_cs c) (QPvarspecs p)
-           (QPglobalenv p) G i fd phi). {
+ SF (Espec := Espec) (cs := Comp_cs c) (V := QPvarspecs p)
+           (ge := QPglobalenv p) G i fd phi). {
   intros.
   specialize (Gsub _ (find_id_In_map_fst _ _ _ H)).
   apply list_in_map_inv in Gsub. destruct Gsub as [[j f] [? ?]]. simpl in H0; subst j.
@@ -3244,216 +2551,909 @@ unfold QPprog_funct in GFF.
 rewrite <- QPprog_funct'_filter_isGfun in GFF.
 rewrite <- (QPprog_funct'_filter_isGfun (PTree.elements _))  in EXT_OK.
 
-assert (H20: forall i fd, In (i,fd) (prog_funct' (map of_builtin (QP.prog_builtins p)) ++
-                                 QPprog_funct' (filter isGfun (PTree.elements (QP.prog_defs p)))) ->
-                                  isInternal (Gfun fd)=true -> In i (map fst G)). {
-  intro i. pose proof (Comp_G_dom c i).
-  clear - H4.
-  intros.
-  rewrite in_app in H. destruct H.
-  induction (QP.prog_builtins p) as [|[j[]]]. inv H.
-  simpl in H; destruct H. inv H. inv H0.
-  auto.
-  rewrite <- H4. rewrite in_app; left.
-  destruct fd; inv H0.
-  apply @IntIDs_i with (f:=f).
-  apply PTree.elements_complete. 
-  induction (PTree.elements (QP.prog_defs p)) as [|[j[|]]]. inv H.
-  destruct H. inv H; simpl; auto.
-  right; auto. right; auto.
-}
+assert (H20: forall i fd, In (i,fd) (prog_funct' (map of_builtin (QP.prog_builtins p)) ++
+                                 QPprog_funct' (filter isGfun (PTree.elements (QP.prog_defs p)))) ->
+                                  isInternal (Gfun fd)=true -> In i (map fst G)). {
+  intro i. pose proof (Comp_G_dom c i).
+  clear - H4.
+  intros.
+  rewrite in_app in H. destruct H.
+  induction (QP.prog_builtins p) as [|[j[]]]. inv H.
+  simpl in H; destruct H. inv H. inv H0.
+  auto.
+  rewrite <- H4. rewrite in_app; left.
+  destruct fd; inv H0.
+  apply @IntIDs_i with (f:=f).
+  apply PTree.elements_complete. 
+  induction (PTree.elements (QP.prog_defs p)) as [|[j[|]]]. inv H.
+  destruct H. inv H; simpl; auto.
+  right; auto. right; auto.
+}
+
+assert (VG_LNR: list_norepet (map fst (QPvarspecs p) ++ map fst  G)). {
+  pose proof (Comp_LNR c). rewrite app_nil_r in H4.
+  auto.
+}
+forget (filter isGfun (PTree.elements (QP.prog_defs p))) as fs.
+forget (QP.prog_builtins p) as builtins.
+replace (@QPprog_funct' function) with (@prog_funct' (fundef function) type) in *
+  by (clear; extensionality al; induction al as [|[i[|]]]; simpl; auto; f_equal; auto).
+forget (prog_funct' (map of_builtin builtins) ++ prog_funct' fs) as fds.
+forget (QPvarspecs p) as V.
+forget (QPglobalenv p) as ge.
+forget (Comp_cs c) as cs.
+clear - H H3 V_FDS_LNR VG_LNR GFF EXT_OK H20.
+eapply augment_funspecs_semax_func; eassumption.
+Qed.
+
+Definition WholeProgSafeType  {Espec E p Exports GP mainspec}
+       (c: exists G, 
+             find_id (QP.prog_main p) G = None /\
+             Component (Espec := Espec) (QPvarspecs p) E nil p Exports GP 
+         (G_merge
+                 [(QP.prog_main p, mainspec)] G))
+             (z: OK_ty) :=
+ exists cs, exists OK, exists CBC, exists G,
+semax_prog (OK_spec := Espec) (cs := cs)
+   (wholeprog_of_QPprog p OK
+    (cenv_built_correctly_e
+         (map compdef_of_compenv_element
+            (sort_rank (PTree.elements (QP.prog_comp_env p)) []))
+         (composite_env_of_QPcomposite_env (QP.prog_comp_env p) (projT1 (proj2 OK)))
+         CBC))
+    z (QPvarspecs p) 
+      (G_merge [(QP.prog_main p, mainspec)] G).
+
+Lemma WholeComponent_semax_prog:
+ forall {Espec Externs p Exports GP mainspec}
+  (c: exists G, 
+    find_id (QP.prog_main p) G = None /\
+     Component (Espec := Espec) (QPvarspecs p) Externs nil p Exports GP (G_merge
+                 [(QP.prog_main p, mainspec)] G))
+  (z: OK_ty)
+  (MAIN: exists post, mainspec = QPmain_spec_ext' p z post)
+  (MAIN': isSome (PTree.get (QP.prog_main p) (QP.prog_defs p)))
+  (EXT_OK: all_unspecified_OK p)
+  (ALIGNED: QPall_initializers_aligned p = true) (* should be part of QPprogram_OK *)
+  (DEFS_NOT_BUILTIN: forallb not_builtin (PTree.elements (QP.prog_defs p)) = true)  (* should be part of QPprogram_OK *)
+  (CBC: forall H,
+    cenv_built_correctly
+        (map compdef_of_compenv_element
+           (sort_rank (PTree.elements (QP.prog_comp_env p)) []))
+         (composite_env_of_QPcomposite_env (QP.prog_comp_env p) H) 
+           = Errors.OK tt),
+  WholeProgSafeType c z.
+Proof.
+ intros ? ? ? ? ? mainspec; intros.
+ destruct c as [G [NO_MAIN c]].
+ pose (prog := prog_of_component c (CBC _)).
+ red.
+ exists (Comp_cs c).
+ exists (Comp_prog_OK c).
+ exists (CBC _).
+ exists G.
+ split3; [ | | split3; [ | | split]].
+ 4: change SeparationLogicAsLogicSoundness.MainTheorem.CSHL_MinimumLogic.CSHL_Def.semax_func
+  with semax_func.
+-
+ subst prog; simpl.
+ unfold prog_defs_names. simpl.
+ apply compute_list_norepet_i.
+ clear - c.
+ rewrite map_app.
+ destruct (Comp_prog_OK c).
+ rewrite map_map. 
+ replace (fun x : ident * QP.builtin => fst (of_builtin x)) with (@fst ident QP.builtin); auto.
+ extensionality x. destruct x,b; simpl; auto.
+-
+ red. unfold prog_vars;
+ subst prog; simpl.
+ clear - ALIGNED.
+ unfold QPall_initializers_aligned in *.
+ unfold QPprog_vars in ALIGNED.
+  replace  (prog_vars'
+     (map of_builtin (QP.prog_builtins p) ++ PTree.elements (QP.prog_defs p)))
+    with  (prog_vars'(PTree.elements (QP.prog_defs p)))
+       by (induction (QP.prog_builtins p) as [|[i ?]]; try destruct b; simpl; auto).
+ induction (PTree.elements (QP.prog_defs p)) as [|[i?]]; auto.
+ destruct g; auto.
+ simpl in ALIGNED|-*.
+ rewrite andb_true_iff in ALIGNED|-*; destruct ALIGNED; auto.
+-
+  f_equal.
+  apply (proj1 (QPcompspecs_OK_e _ (proj2 (Comp_prog_OK c)))).
+-
+ apply (@WholeComponent_semax_func _ _ _ _ _ _ c EXT_OK DEFS_NOT_BUILTIN).
+-
+  subst prog; simpl.
+  unfold QPvarspecs, QPprog_vars, prog_vars. simpl.
+  clear.
+  replace  (prog_vars'
+     (map of_builtin (QP.prog_builtins p) ++ PTree.elements (QP.prog_defs p)))
+    with  (prog_vars'(PTree.elements (QP.prog_defs p)))
+       by (induction (QP.prog_builtins p) as [|[i ?]]; try destruct b; simpl; auto).
+  induction (PTree.elements (QP.prog_defs p)) as [|[i?]].
+  simpl. auto.
+  simpl. destruct g; auto.
+  simpl.
+  rewrite eqb_ident_true by auto.
+  rewrite eqb_type_refl by auto.
+  simpl; auto.
+- simpl find_id.
+   unfold augment_funspecs.
+   erewrite prog_funct_QP_prog_funct; [ | reflexivity].
+  set (G1 := G_merge [(QP.prog_main p, mainspec)] G).
+   destruct (augment_funspecs'_exists G1 (QP.prog_builtins p) (QPprog_funct p)) 
+     as [G' ?]; auto.
+   * 
+   apply (list_norepet_append_left _ _ (proj1 (Comp_prog_OK c))).
+   *
+   pose proof (list_norepet_append_right _ _ (proj1 (Comp_prog_OK c))).
+   unfold QPprog_funct.
+   clear - H. forget (PTree.elements (QP.prog_defs p)) as al.
+   induction al as [|[i[|]]]; simpl in *; auto. inv H; constructor; auto.
+   contradict H2. clear - H2; induction al as [|[j[|]]]; simpl in *; auto. destruct H2; auto.
+   inv H; auto.
+   *
+   assert (H1 := proj1 (Comp_prog_OK c)).
+   rewrite list_norepet_app in H1; destruct H1 as [_ [_ H1]].
+   eapply assoclists.list_disjoint_mono; try apply H1; auto.
+   clear; intros. unfold QPprog_funct in H.
+   induction (PTree.elements (QP.prog_defs p)) as [|[i[|]]]; simpl in *; auto. destruct H; auto.
+   *
+   clear - DEFS_NOT_BUILTIN.
+   unfold QPprog_funct. induction (PTree.elements (QP.prog_defs p)) as [|[i[|]]]; simpl in *; auto.
+   rewrite andb_true_iff in *|-*. tauto.
+   *
+     apply (Comp_G_LNR c).
+   *
+   intros.
+   fold G1 in c.
+   rewrite <- (Comp_G_dom c) in H.
+   rewrite in_app in H; destruct H.
+   apply IntIDs_elim in H; destruct H.
+   unfold QPprog_funct.
+   clear - H. induction (PTree.elements (QP.prog_defs p)) as [|[j[|]]]; simpl in *; auto.
+   destruct H; auto. inv H; auto.   destruct H; auto. inv H; auto.
+   apply (Comp_Externs c i) in H.
+   destruct H as [? [? [? [? ?]]]].
+   apply PTree.elements_correct in H.
+   unfold QPprog_funct.
+   clear - H. induction (PTree.elements (QP.prog_defs p)) as [|[j[|]]]; simpl in *; auto.
+   destruct H; auto. inv H; auto.   destruct H; auto. inv H; auto.
+   *
+   change (G_merge _ _) with G1.
+   rewrite H.
+   apply augment_funspecs'_e in H.
+   destruct MAIN as [post MAIN].
+   change (prog_main prog) with (QP.prog_main p).
+   assert   (MAINx: find_id (QP.prog_main p) G1 = Some (QPmain_spec_ext' p z post)). {
+     apply G_merge_find_id_SomeNone.
+     simpl. rewrite if_true by auto. f_equal; auto. auto.
+   }
+   rewrite (augment_funspecs_find_id_Some _ _ _ H (Comp_G_LNR c) _ _ MAINx).
+   exists post.
+   unfold QPmain_spec_ext', main_spec_ext'.
+   f_equal.
+   subst prog. unfold main_pre, semax_prog.main_pre.
+   unfold prog_vars. simpl.
+   unfold QPprog_vars.
+   replace  (prog_vars'
+     (map of_builtin (QP.prog_builtins p) ++ PTree.elements (QP.prog_defs p)))
+    with  (prog_vars'(PTree.elements (QP.prog_defs p)))
+       by (clear; induction (QP.prog_builtins p) as [|[i ?]]; try destruct b; simpl; auto).
+   extensionality gv; f_equal; extensionality rho.
+   normalize. f_equal. f_equal. f_equal. f_equal.
+  clear.
+  induction (PTree.elements (QP.prog_defs p)) as [|[i?]]; auto.
+  simpl.
+  destruct g; auto.
+  f_equal; auto.
+Qed.
+
+Section binary_intersection'_funspec_sub_mono.
+
+Notation dtfr := (@dtfr Σ).
+
+Definition sigBool_left {A B} (x:dtfr A):
+  {i : bool & dtfr (if i then A else B)}.
+Proof. exists true; trivial. Defined.
+Definition sigBool_right {A B} (x:dtfr B):
+  {i : bool & dtfr (if i then A else B)}.
+Proof. exists false; trivial. Defined.
+
+Lemma binary_intersection'_funspec_sub_mono {f c A1 E1 P1 Q1 B1 F1 R1 S1 phi1 psi1 Phi1 Psi1
+             A2 E2 P2 Q2 B2 F2 R2 S2 phi2 psi2 Phi2 Psi2}
+(Hphi: funspec_sub phi1 phi2)
+(Hpsi: funspec_sub psi1 psi2):
+funspec_sub (@binary_intersection' Σ _ f c A1 E1 P1 Q1 B1 F1 R1 S1 phi1 psi1 Phi1 Psi1)
+            (@binary_intersection' Σ _ f c A2 E2 P2 Q2 B2 F2 R2 S2 phi2 psi2 Phi2 Psi2).
+Proof.
+split; [ split3; trivial | intros].
+subst.
+unfold binarySUMArgs. destruct x2; simpl. destruct x.
++ clear Hpsi. destruct Hphi as [_ Hphi].
+  eapply derives_trans. apply Hphi. clear Hphi. apply fupd_mono.
+  Intros x1 F. Exists (@sigBool_left A1 B1 x1) F; simpl.
+  entailer.
++ clear Hphi. destruct Hpsi as [_ Hpsi].
+  eapply derives_trans. apply Hpsi. clear Hpsi. apply fupd_mono.
+  Intros x1 F. Exists (@sigBool_right A1 B1 x1) F; simpl.
+  entailer.
+Qed.
+End binary_intersection'_funspec_sub_mono.
+
+End mpred.
+
+#[export] Hint Resolve globals_ok_isptr_headptr: core.
+#[export] Hint Resolve globals_ok_genviron2globals : core.
+
+Ltac findentry := repeat try first [ left; reflexivity | right].
+
+Ltac finishComponent_aux i E :=
+ match type of E with (if eq_dec ?i ?c then _ else _) = _ =>
+  let H := fresh in  
+  destruct (eq_dec i c) as [H|H];
+  [subst i; inv E;
+   first [ solve [apply funspec_sub_refl]
+         | eexists; split; 
+               [ reflexivity
+               | try solve [apply funspec_sub_refl]]]
+ | clear H]
+ end.
+
+Ltac finishComponent :=
+   intros i phi E; simpl in E;
+   repeat finishComponent_aux i E; 
+   try solve [discriminate E].
+
+Ltac lookup_tac := 
+    intros H;
+    repeat (destruct H; [ repeat ( first [ solve [left; trivial] | right]) | ]); try contradiction.
+
+Ltac SF_vacuous :=
+ try change (fst (?a,?b)) with a; try change (snd (?a,?b)) with b;
+ match goal with |- SF _ _ _ (vacuous_funspec _) => idtac end;
+ match goal with H: @eq compspecs _ _ |- _ => rewrite <- H end;
+red; red; repeat simple apply conj;
+[ reflexivity (* id_in_list ... *)
+| repeat apply Forall_cons; (* Forall complete_type fn_vars *)
+  try apply Forall_nil; reflexivity
+| repeat constructor; simpl; rep_lia (* var_sizes_ok *)
+| reflexivity (* fn_callconv ... *)
+| split3; [reflexivity | reflexivity | intros; apply semax_vacuous] (* semax_body *)
+| eexists; split; compute; reflexivity (* genv_find_func *)
+].
+
+Ltac decompose_in_elements H :=
+match type of H with
+ | (?i,_)=_ \/ _ => 
+   destruct H as [H|H];
+   [let j := eval compute in i in change i with j in H;
+                injection H; clear H; intros; subst 
+  | decompose_in_elements H ]
+ | False => contradiction H
+ | _ => idtac
+ end.
+
+Ltac check_Comp_Externs :=
+ apply compute_Comp_Externs;
+ (solve [repeat apply Forall_cons; try apply Forall_nil; reflexivity]
+  || match goal with |- Comp_Externs_OK ?E ?p =>
+      let ids := constr:(compute_missing_Comp_Externs E p) in
+      let ids := eval hnf in ids in let ids := eval simpl in ids in
+      fail "The following identifiers are proposed as 'Extern' funspecs, but the Clight program does not list them as Gfun(External _ _ _ _):"
+               ids
+      end).
+
+Ltac check_Comp_Imports_Exports :=
+ apply compute_Comp_Externs;
+ (solve [repeat apply Forall_cons; try apply Forall_nil; reflexivity]
+  || match goal with |- Comp_Externs_OK ?E ?p =>
+      let ids := constr:(compute_missing_Comp_Externs E p) in
+      let ids := eval hnf in ids in let ids := eval simpl in ids in
+      fail "The following identifiers are proposed as 'Imports' funspecs, but the Clight program does not list them as Gfun(External _ _ _ _):"
+               ids
+      end).
+
+Ltac compute_list p :=
+ let a := eval hnf in p in 
+ match a with
+ | nil => uconstr:(a)
+ | ?h :: ?t  => 
+    let h := eval hnf in h in 
+    match h with (?i,?x) => let i := eval compute in i in
+       let t := compute_list t in
+       uconstr:((i,x)::t)
+     end
+ end.
+
+Ltac compute_list' p :=
+  (* like compute_list but uses simpl instead of compute on the identifiers *)
+ let a := eval hnf in p in 
+ match a with
+ | nil => uconstr:(a)
+ | ?h :: ?t  => 
+    let h := eval hnf in h in 
+    match h with (?i,?x) => let i := eval simpl in i in
+       let t := compute_list' t in
+       uconstr:((i,x)::t)
+     end
+ end.
+
+Ltac test_Component_prog_computed' :=
+lazymatch goal with
+ | |- Component _ _ _ (QPprog _) _ _ _ => 
+       fail 1  "The QPprog of this component is of the form (QPprog _), which has not been calculated out to normal form.  Perhaps you meant   ltac:(QPprog _) instead of (QPprog _) in the theorem statement"
+ | |- Component _ _ _ (@abbreviate _ {| QP.prog_builtins := _;
+         QP.prog_defs := _; QP.prog_public := _;
+       QP.prog_main := _;    QP.prog_comp_env := _ |}) _ _ _ =>
+    fail 0 "success"
+ | |- Component _ _ _ abbreviate _ _ _ => 
+     fail 1 "The QPprog of this component is not in normal form"
+ | |- Component _ _ _ ?p _ _ _ => 
+        tryif unfold p then test_Component_prog_computed'
+            else fail 1  "The QPprog of this component is not in normal form"
+ | |- _ => fail 1 "The proof goal is not a Component"
+ end.
+
+Ltac test_Component_prog_computed :=
+ try test_Component_prog_computed'.
+
+Ltac lookup_tac_with_diagnosis := clear; intros; split; try solve [simpl in *; trivial; lookup_tac];
+ match goal with |- In _ ?LEFT -> In _ ?RIGHT =>
+   simpl; intuition;
+   match goal with H: Maps.PTree.prev ?n = _ |- _ =>
+     let n' := constr:(string_of_ident (Maps.PTree.prev n)) in
+     let n' := eval compute in n' in 
+     fail 1 "Function" n' "is in the list" LEFT "but not in the list" RIGHT
+   end
+ end.
+
+Ltac ident_diff al bl F :=
+     let l := constr:(map string_of_ident 
+              (diff_ident_lists (linking.SortPos.sort al) 
+                   (linking.SortPos.sort bl))) in
+     let l := eval compute in l
+     in F l.
+
+Ltac prove_Comp_G_dom :=
+lazymatch goal with |- forall i, In i ?A <-> In i ?B =>
+  apply prove_idlists_equiv;
+  compute; 
+  try reflexivity; 
+  lazymatch goal with |- ?al = ?bl =>
+     ident_diff al bl ltac:(fun l =>
+     ident_diff bl al ltac:(fun r => 
+      fail "Identifier mismatch!
+Present only in" A ":" l "
+Present only in" B ":" r))
+  end
+end.
+
+Ltac carefully_unroll_Forall := 
+match goal with |- Forall _ (_ _ ?L) => 
+     let z := constr:(L) in let z := eval hnf in z 
+     in lazymatch z with 
+         | (_ , _)::_ => change L with z
+         | ?u :: ?r => let u' := eval hnf in u in change L with (u'::r)
+         | _ => apply Forall_nil
+          end
+end;
+(cbv beta delta [filter_options] fix;
+ cbv match;
+ match goal with |- context [Maps.PTree.get ?i ?m] =>
+    let u := fresh "u" in set (u := Maps.PTree.get i m); hnf in u; subst u; 
+    cbv beta zeta match  delta [snd]
+ end;
+ match goal with |- Forall _ (?hx :: ?tx) => 
+    let h := fresh "h" in let t := fresh "t" in 
+     set (h := hx); set (t := tx); simple apply Forall_cons; subst h t
+ end; 
+  [ |  carefully_unroll_Forall]).
+
+Ltac mkComponent prog :=
+ hnf;
+ match goal with |- Component _ _ ?IMPORTS _ _ _ _ =>
+     let i := compute_list' IMPORTS in change_no_check IMPORTS with i 
+ end;
+ test_Component_prog_computed;
+ let p := fresh "p" in
+ match goal with |- @Component _ _ _ _ _ _ _ ?pp _ _ _ => set (p:=pp) end;
+ let HA := fresh "HA" in 
+   assert (HA: PTree_samedom cenv_cs ha_env_cs) by repeat constructor;
+ let LA := fresh "LA" in 
+   assert (LA: PTree_samedom cenv_cs la_env_cs) by repeat constructor;
+ let OK := fresh "OK" in
+  assert (OK: QPprogram_OK p)
+   by (split; [apply compute_list_norepet_e; reflexivity 
+           |  apply (QPcompspecs_OK_i HA LA) ]);
+ (* Doing the  set(myenv...), instead of before proving the CSeq assertion,
+     prevents nontermination in some cases  *)
+ pose (myenv:= (QP.prog_comp_env (QPprogram_of_program prog ha_env_cs la_env_cs)));
+ assert (CSeq: _ = compspecs_of_QPcomposite_env myenv 
+                     (proj2 OK))
+   by (apply compspecs_eq_of_QPcomposite_env; reflexivity);
+ subst myenv;
+ change (QPprogram_of_program prog ha_env_cs la_env_cs) with p in CSeq;
+ clear HA LA;
+ exists OK;
+  [ check_Comp_Imports_Exports
+  | apply compute_list_norepet_e; reflexivity || fail "Duplicate funspec among the Externs++Imports"
+  | apply compute_list_norepet_e; reflexivity || fail "Duplicate funspec among the Exports"
+  | apply compute_list_norepet_e; reflexivity
+  | apply forallb_isSomeGfunExternal_e; reflexivity
+  | intros; simpl; split; trivial; try solve [lookup_tac]
+  | let i := fresh in let H := fresh in 
+    intros i H; first [ solve contradiction | simpl in H];
+    repeat (destruct H; [ subst; reflexivity |]); try contradiction
+  | apply prove_G_justified; carefully_unroll_Forall;  try SF_vacuous
+  | finishComponent
+  | first [ solve [intros; apply derives_refl] | solve [intros; reflexivity] | solve [intros; simpl; cancel] | idtac]
+  ].
+
+Ltac mkVSU prog internal_specs := 
+ lazymatch goal with
+  | |- VSU ?E ?Imports ?qprog ?ASI _ =>
+     let augmented_intspecs :=
+       constr:((*makeSomeVacuousFunspecs qprog internal_specs ++*) internal_specs)
+       in exists augmented_intspecs; mkComponent prog
+  | _ => fail "mkVSU must be applied to a VSU goal"
+ end.
+
+Ltac Vprogs_domain_eq :=
+ lazymatch goal with |- ?m = ?m' => 
+   let x := constr:(Maps.PTree.map1 (fun _ => tt) m = Maps.PTree.map1 (fun _ => tt) m') in
+   let x := eval compute in x in
+   reflexivity
+ end.
+
+Ltac apply_semax_body P :=
+lazymatch goal with |- semax_body ?V ?G ?F (?I, ?S) =>
+  lazymatch type of P with semax_body ?V' ?G' ?F' ?IS =>
+    let IS' := eval hnf in IS in 
+    let I' := constr:(fst IS') in 
+    let I' := eval red in I' in
+    let I := eval simpl in I in
+    (tryif unify I I' then idtac
+     else fail 1 "You have provided a semax_body proof for" I' " but required is a semax_body proof for" I);
+    (tryif change G with G' then idtac
+     else fail 1 "Lemma" P "has a Gprog argument of" G' "but you have provided" G);
+    (tryif change F with F' then idtac
+     else fail 1 "Lemma" P "has a fundef argument of" F' "but you have provided" F);
+    let S2 := constr:(snd IS) in 
+    (tryif change (I,S) with IS then idtac
+     else fail 1 "Lemma" P "has a funspec argument of" S "but you have provided" S);
+    (tryif constr_eq V V' then idtac
+     else ((apply (semax_body_permute_Vprog V V'); 
+               [ compute; Vprogs_domain_eq; reflexivity 
+               | ] ) 
+           || (let a := constr:(map fst V') in 
+            let b := constr:(map fst V) in
+            let a' := constr:(map string_of_ident a) in let a' := eval compute in a' in
+            let b' := constr:(map string_of_ident b) in let b' := eval compute in b' in
+            ident_diff a b ltac:(fun l => 
+            ident_diff b a ltac:(fun r =>
+            fail 1 "Lemma" P "has a Vprog argument of" V' "but you have provided" V "
+Present only in" V' ":" l "
+Present only in" V ":" r "
+(if those lists are both empty then the domains are the same but the types differ)")))));
+    exact P
+  end
+end.
+
+
+Ltac solve_SF_internal P :=
+  apply SF_internal_sound; eapply _SF_internal;
+   [  reflexivity 
+   | repeat apply Forall_cons; try apply Forall_nil; try computable; reflexivity
+   | unfold var_sizes_ok; repeat constructor; try (simpl; rep_lia)
+   | reflexivity
+   | match goal with OK: QPprogram_OK _, CSeq: @eq compspecs _ _ |- _ =>
+       rewrite <- CSeq;
+       clear CSeq OK
+     end;
+     apply_semax_body P
+   | eexists; split; 
+       [ fast_Qed_reflexivity || fail "Lookup for a function identifier in QPglobalenv failed"
+       | fast_Qed_reflexivity || fail "Lookup for a function pointer block in QPglobalenv failed"
+   ]    ].
+
+(* slower*)
+Ltac solve_SF_external_with_intuition B :=
+   first [simpl; split; intuition; [ try solve [entailer!] | try apply B | eexists; split; cbv; reflexivity ] | idtac].
+
+(*Slightly faster*)
+Ltac solve_SF_external B :=
+  first [ split3;
+            [ reflexivity 
+            | reflexivity 
+            | split3;
+                [ reflexivity
+                | reflexivity
+                | split3;
+                   [ left; trivial
+                   | clear; intros ? ? ?; cbv [ofe_mor_car]; 
+                     try solve [entailer!]; try apply TT_right;
+                     repeat match goal with |- (let (y, z) := ?x in _) _ ∧ _ ⊢ _ =>
+                                     destruct x as [y z]
+                     end
+                    | split; [ try apply B | eexists; split; cbv; reflexivity ]
+            ] ] ]
+        | idtac ].
+
+Ltac prove_cspecs_sub := 
+   try solve [split3; intros ?i; apply sub_option_get; repeat constructor].
+
+Ltac solve_entry H H0:=
+     inv H; inv H0; first [ solve [ trivial ] | split; [ reflexivity | eexists; reflexivity] ].
+
+Ltac LDI_tac := 
+   apply Forall_nil ||  (apply Forall_cons; [ reflexivity | LDI_tac ]).
+
+Ltac LNR_tac := apply compute_list_norepet_e; reflexivity.
+
+Ltac list_disjoint_tac := 
+  apply compute_list_disjoint_id_e; reflexivity.
+
+Ltac ExternsHyp_tac := first [ reflexivity | idtac ].
+
+Ltac HImports_tac' := clear; repeat apply Forall_cons; try apply Forall_nil; 
+     (reflexivity || match goal with |- imports_agree ?i _ _ =>
+                       fail "Imports disagree at identifier" i end).
+
+Ltac SC_tac :=
+ match goal with |- SC_test ?ids _ _ =>
+  let a := eval compute in ids in change ids with a
+ end;
+ simpl SC_test;
+ repeat (apply conj);
+ lazymatch goal with
+         | |- Funspecs_must_match ?i _ _ =>
+                 try solve [constructor; unfold abbreviate; 
+                 repeat f_equal
+                 (*occasionally leaves a subgoal, typically because a
+                   change_compspecs needs to be inserted that could not
+                    be identified automatically*)]
+         | |- Identifier_not_found ?i ?fds2 =>
+                 fail "identifer" i "not found in funspecs" fds2
+         | |- True => trivial
+          end.
+(*Alternatives:
+Ltac SC_tac1 :=
+ match goal with |- SC_test ?ids _ _ =>
+  let a := eval compute in ids in change ids with a
+ end;
+ simpl SC_test;
+ repeat (apply conj);
+ lazymatch goal with
+         | |- Funspecs_must_match ?i _ _ =>
+                 try solve [constructor; unfold abbreviate; 
+                 (*leads sometimes to nontermination: try simple apply eq_refl;*)
+                 repeat f_equal]
+         | |- Identifier_not_found ?i ?fds2 =>
+                 fail "identifer" i "not found in funspecs" fds2
+         | |- True => trivial
+          end.
+
+Ltac SC_tac2 :=
+ match goal with |- SC_test ?ids _ _ =>
+  let a := eval compute in ids in change ids with a
+ end;
+ simpl SC_test;
+ repeat (apply conj);
+ lazymatch goal with
+         | |- Funspecs_must_match ?i _ _ =>
+                 constructor;
+                 apply mk_funspec_congr;
+                 [ try reflexivity 
+                 | try reflexivity 
+                 | try reflexivity
+                 | (*too aggressive here: try (apply eq_JMeq; trivial)*)
+                 | (*too aggressive here: try (apply eq_JMeq; trivial)*)]
+         | |- Identifier_not_found ?i ?fds2 =>
+                 fail "identifer" i "not found in funspecs" fds2
+         | |- True => trivial
+          end.
+*)
+
+Ltac HImports_tac := simpl;
+  let i := fresh "i" in
+   intros i ? ? H1 H2;
+  repeat (if_tac in H1; subst; simpl in *; try discriminate);
+    (first [ congruence | inv H1; inv H2; reflexivity | fail "Imports disagree at identifier" i] ).
+
+Ltac ImportsDef_tac := first [ reflexivity | idtac ].
+Ltac ExportsDef_tac := first [ reflexivity | idtac ].
+Ltac domV_tac := compute; tauto.
+
+Ltac find_id_subset_tac := simpl; intros ? ? H;
+  repeat (if_tac in H; [ inv H; simpl; try reflexivity | ]); discriminate.
+
+Ltac ComponentMerge C1 C2 :=
+  eapply (ComponentJoin _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ C1 C2);
+[ list_disjoint_tac
+| list_disjoint_tac
+| list_disjoint_tac
+| list_disjoint_tac
+| LNR_tac
+| LNR_tac
+| prove_cspecs_sub
+| prove_cspecs_sub
+| first [ find_id_subset_tac | idtac]
+| first [ find_id_subset_tac | idtac]
+(*| FDM_tac *)
+(*| FunctionsPreserved_tac *)
+| apply list_disjoint_id_e; LDI_tac
+| apply list_disjoint_id_e; LDI_tac
+| ExternsHyp_tac
+| apply SC_lemma; SC_tac
+| apply SC_lemma; SC_tac
+| HImports_tac
+(*+  HContexts. This is the side condition we'd like to exliminate - it's also
+   why we need to define SubjectComponent/ObserverComponent using DEFINED
+  simpl; intros.
+  repeat (if_tac in H; [ inv H; inv H0 | ]). discriminate.*)
+| ImportsDef_tac
+| ExportsDef_tac
+| LNR_tac
+| LNR_tac
+| domV_tac
+| try (cbv; reflexivity)
+| try (cbv; reflexivity)
+| try (cbv; reflexivity) 
+| first [ find_id_subset_tac | idtac]
+| first [ find_id_subset_tac | idtac]
+].
+
+Ltac compute_QPlink_progs :=
+match goal with |- ?A = _ =>
+  let p1 := eval hnf in A in
+  lazymatch p1 with
+ | Errors.Error ?m => fail m
+ | Errors.OK ?p' => instantiate (1:=@abbreviate _ p'); reflexivity
+ | _ => fail "could not reduce QPlink_prog to hnf"
+ end
+end.
+
+Ltac FDM_tac := 
+  try (apply compute_FDM_e;  reflexivity);
+  fail "FDM_tac failed".
+
+Ltac VSULink_tac := 
+eapply VSULink;
+[ compute_QPlink_progs
+| FDM_tac
+| list_disjoint_tac
+| list_disjoint_tac
+| apply SC_lemma; SC_tac
+| apply SC_lemma; SC_tac
+| HImports_tac].
+
+Ltac red_until_NDmk_funspec x :=
+ lazymatch x with
+ | NDmk_funspec _ _ _ _ _ => uconstr:(x)
+ | mk_funspec _ _ _ _ _ _ _ => uconstr:(x)
+ | merge_specs ?A ?B => 
+     let b := eval hnf in B in 
+     match b with None => uconstr:(A) | _ => uconstr:(merge_specs A b) end
+ | _ => uconstr:(x)
+ end.
+
+Ltac simplify_funspecs G :=
+  let x := eval hnf in G in 
+ lazymatch x with
+ | nil => constr:(x)
+ | ?ia :: ?al => let al := simplify_funspecs al in
+                       let ia := eval hnf in ia in
+                       match ia with pair  ?i ?a =>
+                             let b := red_until_NDmk_funspec a in
+                              constr:( (i,@abbreviate _ b)::al )
+                       end
+ end.
+
+Ltac compute_VSULink_Imports v1 v2 := 
+  let Imports := uconstr:(VSULink_Imports v1 v2) in
+  let x := eval cbv beta delta [VSULink_Imports] in Imports in
+  match x with VSULink_Imports_aux ?I1 ?I2 ?A ?B =>
+    let k1 := eval compute in A in
+    let k2 := eval compute in B in
+    let x := uconstr:(VSULink_Imports_aux I1 I2 k1 k2) in
+    simplify_funspecs x
+ end.
+
+Ltac prove_restrictExports :=
+ simple apply prove_restrictExports; 
+   [apply compute_list_norepet_e; reflexivity || fail "Your restricted Export list has a duplicate function name"
+   | repeat apply Forall_cons; try simple apply Forall_nil;
+       red; simpl find_id; cbv beta iota;
+       change (@abbreviate funspec ?A) with A
+   ].
+
+Ltac prove_restrictExports2 :=
+ simple apply prove_restrictExports; 
+   [apply compute_list_norepet_e; reflexivity || fail "Your restricted Export list has a duplicate function name"
+   | 
+   ].
+
+
+Ltac weakenExports :=
+ simple apply weakenExports; 
+   [apply compute_list_norepet_e; reflexivity || fail "Your restricted Export list has a duplicate function name"
+   | 
+   ].
+
+Ltac strengthenImports :=
+ simple apply strengthenImports; 
+   [apply compute_list_norepet_e; reflexivity || fail "Your restricted Export list has a duplicate function name"
+   | try reflexivity |
+   ].
+
+Ltac simplify_VSU_type t :=
+ lazymatch t with
+ | restrictExports _ _ => let t := eval red in t in simplify_VSU_type t
+ | privatizeExports _ _ => let t := eval red in t in simplify_VSU_type t
+ | relaxImports _ _ => let t := eval red in t in simplify_VSU_type t
+ | VSU _ _ _ _ _ => t
+ | _ => fail "The type of this supposed VSU is" t "which might be OK but we hesitate to reduce it for fear of blowup"
+ end.
+
+Ltac VSULink_type v1 v2 :=
+lazymatch type of v1 with ?t1 => let t1 := simplify_VSU_type t1 in
+lazymatch t1 with 
+  | VSU (Espec := ?Espec) ?E1 ?Imports1 ?p1 ?Exports1 ?GP1 =>
+lazymatch type of v2 with ?t2 => let t2 := simplify_VSU_type t2 in
+lazymatch t2 with 
+  | VSU (Espec := Espec) ?E2 ?Imports2 ?p2 ?Exports2 ?GP2 =>
+          let GP := uconstr:((fun gv => GP1 gv ∗ GP2 gv)) in
+          let E := uconstr:((G_merge E1 E2)) in
+          let E := simplify_funspecs E in
+          let Imports := compute_VSULink_Imports v1 v2 in
+          let Exports := constr:((G_merge Exports1 Exports2)) in
+          let Exports := simplify_funspecs Exports in
+          let p' := uconstr:((QPlink_progs p1 p2)) in
+          let p'' := eval vm_compute in p' in
+          let p :=
+           lazymatch p'' with
+           | Errors.OK ?p =>
+               uconstr:(@abbreviate _ p)
+           | Errors.Error ?m => fail "QPlink_progs failed:" m
+           end
+          in
+          constr:((VSU (Espec := Espec) E Imports p Exports GP))
+  | _ => fail "Especs of VSUs don't match"
+end end end end.
+
+Ltac linkVSUs v1 v2 :=
+  let t := VSULink_type v1 v2 in
+ match t with VSU (Espec := ?Espec) ?E ?Imports ?p ?Exports ?GP =>
+   apply (VSULink'' Espec _ _ _ _ _ _ _ _ _ _ v1 v2 E Imports p Exports)
+  end;
+  [ reflexivity | reflexivity | reflexivity | reflexivity
+  | reflexivity || fail "Fundefs_match failed"
+  | reflexivity || fail "Externs of vsu1 overlap with Internals of vsu2"
+  | reflexivity || fail "Externs of vsu2 overlap with Internals of vsu1"
+  | SC_tac
+  | SC_tac
+  | HImports_tac'
+  ].
+
+Ltac linkVSUs_Type v1 v2 := let t := VSULink_type v1 v2 in exact t.
+Ltac linkVSUs_Body v1 v2 :=
+apply (VSULink'' _ _ _ _ _ _ _ _ _ _ _ v1 v2);
+   [ reflexivity
+   | reflexivity
+   | reflexivity
+   | reflexivity
+   | reflexivity || fail "Fundefs_match failed"
+   | reflexivity || fail "Externs of vsu1 overlap with Internals of vsu2"
+   | reflexivity || fail "Externs of vsu2 overlap with Internals of vsu1"
+   | SC_tac
+   | SC_tac
+   | HImports_tac' ].
+
+Ltac report_failure :=
+ match goal with |- ?G => fail 99 "expand_main_pre_new failed with goal" G end.
+
+Ltac unfold_all R :=
+ match R with
+ | bi_sep ?a ?ar => let b := unfold_all a in
+                      let br := unfold_all ar in
+                      constr:(bi_sep b br)
+ | ?a => let x := eval unfold a in a in unfold_all x
+ | ?a => constr:(a)
+ end.
+
+Ltac expand_main_pre_VSU :=
+  lazymatch goal with
+  | vsu: VSU _ _ _ _ _ |- _ => 
+    (eapply main_pre_InitGpred || report_failure); 
+        [ try apply (VSU_MkInitPred vsu); report_failure
+        | try (unfold Vardefs; simpl; reflexivity); report_failure
+        | try solve [repeat constructor]; report_failure
+        |  ];
+     clear vsu;
+     match goal with
+      |- semax _ _ (PROPx _ (LOCALx _ (SEPx (?R _ :: _))) ∗ _) _ _ =>
+        let x := unfold_all R in change R with x
+     end;
+(*     repeat change ((bi_sep ?A ?B) ?gv) with (bi_sep (A gv) (B gv));
+     change (emp ?gv) with (@emp mpred _ _);*)
+     rewrite ?emp_sep, ?sep_emp;
+     repeat match goal with |- semax _ _ (bi_sep ?PQR _) _ _ => flatten_in_SEP PQR end
+  | |- _ => expand_main_pre_old
+  end.
+
+Ltac expand_main_pre ::=
+   expand_main_pre_VSU.
 
-assert (VG_LNR: list_norepet (map fst (QPvarspecs p) ++ map fst  G)). {
-  pose proof (Comp_LNR c). rewrite app_nil_r in H4.
-  auto.
-}
-forget (filter isGfun (PTree.elements (QP.prog_defs p))) as fs.
-forget (QP.prog_builtins p) as builtins.
-replace (@QPprog_funct' function) with (@prog_funct' (fundef function) type) in *
-  by (clear; extensionality al; induction al as [|[i[|]]]; simpl; auto; f_equal; auto).
-forget (prog_funct' (map of_builtin builtins) ++ prog_funct' fs) as fds.
-forget (QPvarspecs p) as V.
-forget (QPglobalenv p) as ge.
-forget (Comp_cs c) as cs.
-clear - H H3 V_FDS_LNR VG_LNR GFF EXT_OK H20.
-eapply augment_funspecs_semax_func; eassumption.
-Qed.
+Ltac start_function2 ::=
+  first [ erewrite compute_close_precondition_eq; [ | reflexivity | reflexivity]
+        | rewrite close_precondition_main
+        | match goal with |- semax _ (func_tycontext _ ?V ?G _)
+              (close_precondition _ (main_pre _ _ _) ∗ _) _ _ =>
+                  let x := eval hnf in V in let x := eval simpl in x in change V with x 
+          end
+        ].
 
-Definition WholeProgSafeType  {Espec E p Exports GP mainspec}
-       (c: exists G, 
-             find_id (QP.prog_main p) G = None /\
-             @Component Espec (QPvarspecs p) E nil p Exports GP 
-         (G_merge
-                 [(QP.prog_main p, mainspec)] G))
-             (z: @OK_ty Espec) :=
- exists cs, exists OK, exists CBC, exists G, 
-@semax_prog Espec cs
-   (wholeprog_of_QPprog p OK
-    (cenv_built_correctly_e
-         (map compdef_of_compenv_element
-            (sort_rank (PTree.elements (QP.prog_comp_env p)) []))
-         (composite_env_of_QPcomposite_env (QP.prog_comp_env p) (projT1 (proj2 OK)))
-         CBC))
-    z (QPvarspecs p) 
-      (G_merge [(QP.prog_main p, mainspec)] G).
+Ltac InitGPred_tac :=
+intros ? ?;
+eapply InitGPred_process_globvars; [auto | | auto];
+let Delta := fresh "Delta" in let Delta' := fresh "Delta'" in 
+set (Delta' := vardefs_tycontext _);
+set (Delta := @abbreviate tycontext Delta');
+change Delta' with Delta;
+hnf in Delta'; simpl in Delta'; subst Delta';
+simpl vardefs_to_globvars;
+try match goal with |- context [PTree.prev ?A] =>
+  let a := constr:(PTree.prev A) in let a := eval compute in a in
+    change (PTree.prev A) with a end;
+eapply derives_trans; [process_globals | ];
+clear Delta;
+apply finish_process_globvars'; unfold fold_right_sepcon at 1;
+repeat change_mapsto_gvar_to_data_at.
 
-Lemma WholeComponent_semax_prog:
- forall {Espec Externs p Exports GP mainspec}
-  (c: exists G, 
-    find_id (QP.prog_main p) G = None /\
-     @Component Espec (QPvarspecs p) Externs nil p Exports GP (G_merge
-                 [(QP.prog_main p, mainspec)] G))
-  (z: OK_ty)
-  (MAIN: exists post, mainspec = QPmain_spec_ext' p z post)
-  (MAIN': isSome (PTree.get (QP.prog_main p) (QP.prog_defs p)))
-  (EXT_OK: all_unspecified_OK p)
-  (ALIGNED: QPall_initializers_aligned p = true) (* should be part of QPprogram_OK *)
-  (DEFS_NOT_BUILTIN: forallb not_builtin (PTree.elements (QP.prog_defs p)) = true)  (* should be part of QPprogram_OK *)
-  (CBC: forall H,
-    cenv_built_correctly
-        (map compdef_of_compenv_element
-           (sort_rank (PTree.elements (QP.prog_comp_env p)) []))
-         (composite_env_of_QPcomposite_env (QP.prog_comp_env p) H) 
-           = Errors.OK tt),
-  WholeProgSafeType c z.
-Proof.
- intros ? ? ? ? ? mainspec; intros.
- destruct c as [G [NO_MAIN c]].
- pose (prog := prog_of_component c (CBC _)).
- red.
- exists (Comp_cs c).
- exists (Comp_prog_OK c).
- exists (CBC _).
- exists G.
- split3; [ | | split3; [ | | split]].
- 4: change SeparationLogicAsLogicSoundness.MainTheorem.CSHL_MinimumLogic.CSHL_Def.semax_func
-  with semax_func.
--
- subst prog; simpl.
- unfold prog_defs_names. simpl.
- apply compute_list_norepet_i.
- clear - c.
- rewrite map_app.
- destruct (Comp_prog_OK c).
- rewrite map_map. 
- replace (fun x : ident * QP.builtin => fst (of_builtin x)) with (@fst ident QP.builtin); auto.
- extensionality x. destruct x,b; simpl; auto.
--
- red. unfold SeparationLogic.prog_vars;
- subst prog; simpl.
- clear - ALIGNED.
- unfold QPall_initializers_aligned in *.
- unfold QPprog_vars in ALIGNED.
-  replace  (SeparationLogic.prog_vars'
-     (map of_builtin (QP.prog_builtins p) ++ PTree.elements (QP.prog_defs p)))
-    with  (SeparationLogic.prog_vars'(PTree.elements (QP.prog_defs p)))
-       by (induction (QP.prog_builtins p) as [|[i ?]]; try destruct b; simpl; auto).
- induction (PTree.elements (QP.prog_defs p)) as [|[i?]]; auto.
- destruct g; auto.
- simpl in ALIGNED|-*.
- rewrite andb_true_iff in ALIGNED|-*; destruct ALIGNED; auto.
--
-  f_equal.
-  apply (proj1 (QPcompspecs_OK_e _ (proj2 (Comp_prog_OK c)))).
--
- apply (@WholeComponent_semax_func _ _ _ _ _ _ c EXT_OK DEFS_NOT_BUILTIN).
--
-  subst prog; simpl.
-  unfold QPvarspecs, QPprog_vars, SeparationLogic.prog_vars. simpl.
-  clear.
-  replace  (SeparationLogic.prog_vars'
-     (map of_builtin (QP.prog_builtins p) ++ PTree.elements (QP.prog_defs p)))
-    with  (SeparationLogic.prog_vars'(PTree.elements (QP.prog_defs p)))
-       by (induction (QP.prog_builtins p) as [|[i ?]]; try destruct b; simpl; auto).
-  induction (PTree.elements (QP.prog_defs p)) as [|[i?]].
-  simpl. auto.
-  simpl. destruct g; auto.
-  simpl.
-  rewrite eqb_ident_true by auto.
-  rewrite eqb_type_refl by auto.
-  simpl; auto.
-- simpl find_id.
-   unfold augment_funspecs.
-   change SeparationLogic.prog_funct with prog_funct.
-   erewrite prog_funct_QP_prog_funct; [ | reflexivity].
-  set (G1 := G_merge [(QP.prog_main p, mainspec)] G).
-   destruct (augment_funspecs'_exists G1 (QP.prog_builtins p) (QPprog_funct p)) 
-     as [G' ?]; auto.
-   * 
-   apply (list_norepet_append_left _ _ (proj1 (Comp_prog_OK c))).
-   *
-   pose proof (list_norepet_append_right _ _ (proj1 (Comp_prog_OK c))).
-   unfold QPprog_funct.
-   clear - H. forget (PTree.elements (QP.prog_defs p)) as al.
-   induction al as [|[i[|]]]; simpl in *; auto. inv H; constructor; auto.
-   contradict H2. clear - H2; induction al as [|[j[|]]]; simpl in *; auto. destruct H2; auto.
-   inv H; auto.
-   *
-   assert (H1 := proj1 (Comp_prog_OK c)).
-   rewrite list_norepet_app in H1; destruct H1 as [_ [_ H1]].
-   eapply assoclists.list_disjoint_mono; try apply H1; auto.
-   clear; intros. unfold QPprog_funct in H.
-   induction (PTree.elements (QP.prog_defs p)) as [|[i[|]]]; simpl in *; auto. destruct H; auto.
-   *
-   clear - DEFS_NOT_BUILTIN.
-   unfold QPprog_funct. induction (PTree.elements (QP.prog_defs p)) as [|[i[|]]]; simpl in *; auto.
-   rewrite andb_true_iff in *|-*. tauto.
-   *
-     apply (Comp_G_LNR c).
-   *
-   intros.
-   fold G1 in c.
-   rewrite <- (Comp_G_dom c) in H.
-   rewrite in_app in H; destruct H.
-   apply IntIDs_elim in H; destruct H.
-   unfold QPprog_funct.
-   clear - H. induction (PTree.elements (QP.prog_defs p)) as [|[j[|]]]; simpl in *; auto.
-   destruct H; auto. inv H; auto.   destruct H; auto. inv H; auto.
-   apply (Comp_Externs c i) in H.
-   destruct H as [? [? [? [? ?]]]].
-   apply PTree.elements_correct in H.
-   unfold QPprog_funct.
-   clear - H. induction (PTree.elements (QP.prog_defs p)) as [|[j[|]]]; simpl in *; auto.
-   destruct H; auto. inv H; auto.   destruct H; auto. inv H; auto.
-   *
-   change (G_merge _ _) with G1.
-   rewrite H.
-   apply augment_funspecs'_e in H.
-   destruct MAIN as [post MAIN].
-   change (prog_main prog) with (QP.prog_main p).
-   assert   (MAINx: find_id (QP.prog_main p) G1 = Some (QPmain_spec_ext' p z post)). {
-     apply G_merge_find_id_SomeNone.
-     simpl. rewrite if_true by auto. f_equal; auto. auto.
-   }
-   rewrite (augment_funspecs_find_id_Some _ _ _ H (Comp_G_LNR c) _ _ MAINx).
-   exists post.
-   unfold QPmain_spec_ext', main_spec_ext'.
-   f_equal.
-   subst prog. unfold main_pre, SeparationLogic.main_pre.
-   unfold SeparationLogic.prog_vars. simpl.
-   unfold QPprog_vars.
-   replace  (SeparationLogic.prog_vars'
-     (map of_builtin (QP.prog_builtins p) ++ PTree.elements (QP.prog_defs p)))
-    with  (SeparationLogic.prog_vars'(PTree.elements (QP.prog_defs p)))
-       by (clear; induction (QP.prog_builtins p) as [|[i ?]]; try destruct b; simpl; auto).
-   extensionality gv rho.
-   normalize. f_equal. f_equal. f_equal. f_equal.
-  clear.
-  induction (PTree.elements (QP.prog_defs p)) as [|[i?]]; auto.
-  simpl.
-  destruct g; auto.
-  f_equal; auto.
-Qed.
+Ltac QPprog p :=
+  tryif (let p' := eval cbv delta [p] in p in
+          match p' with Clightdefs.mkprogram _ _ _ _ _ => idtac end)
+  then (let a := constr:(QPprog' p (eq_refl _)) in
+           (let q := constr:(a (eq_refl _)) in
+            let q := eval hnf in q in
+            let q := eval simpl in q in
+            exact (@abbreviate _ q))
+          || match type of a with ?e -> _ =>
+                 let e := eval hnf in e in
+                 let e :=eval simpl in e in
+                 lazymatch e with
+                 | Errors.OK _ => fail 0 "impossible error in QPprog'"
+                 | Errors.Error ?m => fail 0 m
+                 end
+                end)
+  else (idtac "Remark: QPprog alternate path!";
+         let q := constr:(QPprog p) in 
+         let q := eval hnf in q in
+         let q := eval simpl in q in
+         exact (@abbreviate _ q)).
+
+Ltac QPlink_progs p1 p2 :=
+  let p' :=  constr:(QPlink_progs  p1 p2) in
+  let p'' := eval vm_compute in p' in
+  let p := lazymatch p'' with
+               | Errors.OK ?p => constr:(@abbreviate _ p)
+               | Errors.Error ?m => fail "QPlink_progs failed:" m
+               end in
+  exact p.
 
 Section WholeComp_semaxprogConstructive.
-Variable Espec : OracleKind.
-Variable Externs : funspecs.
+Context `{!VSTGS OK_ty Σ}.
+Variable Espec : ext_spec OK_ty.
+Variable Externs : @funspecs Σ.
 Variable p : QP.program function.
-Variable Exports : funspecs.
+Variable Exports : @funspecs Σ.
 Variable GP : globals -> mpred.
 Variable mainspec : funspec.
 Variable G: list(ident * funspec).
-Variable c: @Component Espec (QPvarspecs p) Externs nil p Exports GP (G_merge
+Variable c: Component (Espec := Espec) (QPvarspecs p) Externs nil p Exports GP (G_merge
                  [(QP.prog_main p, mainspec)] G).
 
 Lemma WholeComponent_semax_progConstructive: forall
@@ -3471,7 +3471,7 @@ Lemma WholeComponent_semax_progConstructive: forall
          (composite_env_of_QPcomposite_env (QP.prog_comp_env p) H) 
            = Errors.OK tt),
 let CBC1 := CBC _ in
-@semax_prog Espec (Comp_cs c)
+semax_prog (OK_spec := Espec) (cs := Comp_cs c)
    (wholeprog_of_QPprog p (Comp_prog_OK c)
     (cenv_built_correctly_e
          (map compdef_of_compenv_element
@@ -3497,14 +3497,14 @@ Proof.
  replace (fun x : ident * QP.builtin => fst (of_builtin x)) with (@fst ident QP.builtin); auto.
  extensionality x. destruct x,b; simpl; auto.
 -
- red. unfold SeparationLogic.prog_vars;
+ red. unfold prog_vars;
  subst prog; simpl.
  clear - ALIGNED.
  unfold QPall_initializers_aligned in *.
  unfold QPprog_vars in ALIGNED.
-  replace  (SeparationLogic.prog_vars'
+  replace  (prog_vars'
      (map of_builtin (QP.prog_builtins p) ++ PTree.elements (QP.prog_defs p)))
-    with  (SeparationLogic.prog_vars'(PTree.elements (QP.prog_defs p)))
+    with  (prog_vars'(PTree.elements (QP.prog_defs p)))
        by (induction (QP.prog_builtins p) as [|[i ?]]; try destruct b; simpl; auto).
  induction (PTree.elements (QP.prog_defs p)) as [|[i?]]; auto.
  destruct g; auto.
@@ -3514,14 +3514,14 @@ Proof.
   f_equal.
   apply (proj1 (QPcompspecs_OK_e _ (proj2 (Comp_prog_OK c)))).
 -
- apply (@WholeComponent_semax_func _ _ _ _ _ _ c EXT_OK DEFS_NOT_BUILTIN).
+ apply (WholeComponent_semax_func c EXT_OK DEFS_NOT_BUILTIN).
 -
   subst prog; simpl.
-  unfold QPvarspecs, QPprog_vars, SeparationLogic.prog_vars. simpl.
+  unfold QPvarspecs, QPprog_vars, prog_vars. simpl.
   clear.
-  replace  (SeparationLogic.prog_vars'
+  replace  (prog_vars'
      (map of_builtin (QP.prog_builtins p) ++ PTree.elements (QP.prog_defs p)))
-    with  (SeparationLogic.prog_vars'(PTree.elements (QP.prog_defs p)))
+    with  (prog_vars'(PTree.elements (QP.prog_defs p)))
        by (induction (QP.prog_builtins p) as [|[i ?]]; try destruct b; simpl; auto).
   induction (PTree.elements (QP.prog_defs p)) as [|[i?]].
   simpl. auto.
@@ -3532,7 +3532,6 @@ Proof.
   simpl; auto.
 - simpl find_id.
    unfold augment_funspecs.
-   change SeparationLogic.prog_funct with prog_funct.
    erewrite prog_funct_QP_prog_funct; [ | reflexivity].
   set (G1 := G_merge [(QP.prog_main p, mainspec)] G).
    destruct (augment_funspecs'_exists G1 (QP.prog_builtins p) (QPprog_funct p)) 
@@ -3587,14 +3586,14 @@ Proof.
    exists post.
    unfold QPmain_spec_ext', main_spec_ext'.
    f_equal.
-   subst prog. unfold main_pre, SeparationLogic.main_pre.
-   unfold SeparationLogic.prog_vars. simpl.
+   subst prog. unfold main_pre, semax_prog.main_pre.
+   unfold prog_vars. simpl.
    unfold QPprog_vars.
-   replace  (SeparationLogic.prog_vars'
+   replace  (prog_vars'
      (map of_builtin (QP.prog_builtins p) ++ PTree.elements (QP.prog_defs p)))
-    with  (SeparationLogic.prog_vars'(PTree.elements (QP.prog_defs p)))
+    with  (prog_vars'(PTree.elements (QP.prog_defs p)))
        by (clear; induction (QP.prog_builtins p) as [|[i ?]]; try destruct b; simpl; auto).
-   extensionality gv rho.
+   extensionality gv. f_equal; extensionality rho.
    normalize. f_equal. f_equal. f_equal. f_equal.
   clear.
   induction (PTree.elements (QP.prog_defs p)) as [|[i?]]; auto.
@@ -3606,14 +3605,14 @@ Qed.
 End WholeComp_semaxprogConstructive.
 
 (*another variant, currently unused*)
-Definition WholeProgSafeType' {Espec E p Exports GP mainspec} G
+Definition WholeProgSafeType' `{!VSTGS OK_ty Σ} {Espec E p Exports GP mainspec} G
        (c: find_id (QP.prog_main p) G = None /\
-             @Component Espec (QPvarspecs p) E nil p Exports GP 
+             Component (Espec := Espec) (QPvarspecs p) E nil p Exports GP 
          (G_merge
                  [(QP.prog_main p, mainspec)] G))
-             (z: @OK_ty Espec) :=
+             (z: OK_ty) :=
  exists cs, exists OK, exists CBC, (*exists G, *)
-@semax_prog Espec cs
+semax_prog (OK_spec := Espec) (cs := cs)
    (wholeprog_of_QPprog p OK
     (cenv_built_correctly_e
          (map compdef_of_compenv_element
@@ -3624,10 +3623,10 @@ Definition WholeProgSafeType' {Espec E p Exports GP mainspec} G
       (G_merge [(QP.prog_main p, mainspec)] G).
 
 Lemma WholeComponent_semax_prog':
- forall {Espec Externs p Exports GP mainspec} G
+ forall `{!VSTGS OK_ty Σ} {Espec Externs p Exports GP mainspec} G
   (c:  
     find_id (QP.prog_main p) G = None /\
-     @Component Espec (QPvarspecs p) Externs nil p Exports GP (G_merge
+     Component (Espec := Espec) (QPvarspecs p) Externs nil p Exports GP (G_merge
                  [(QP.prog_main p, mainspec)] G))
   (NOMAIN:find_id (QP.prog_main p) G = None)
   (z: OK_ty)
@@ -3644,7 +3643,7 @@ Lemma WholeComponent_semax_prog':
            = Errors.OK tt),
   WholeProgSafeType' G c z.
 Proof.
- intros ? ? ? ? ? mainspec; intros.
+ intros ? ? ? ? ? ? ? ? mainspec; intros.
  destruct c as [NO_MAIN c].
  pose (prog := prog_of_component c (CBC _)).
  red.
@@ -3662,18 +3661,18 @@ Proof.
  clear - c.
  rewrite map_app.
  destruct (Comp_prog_OK c).
- rewrite map_map. 
+ rewrite map_map.
  replace (fun x : ident * QP.builtin => fst (of_builtin x)) with (@fst ident QP.builtin); auto.
  extensionality x. destruct x,b; simpl; auto.
 -
- red. unfold SeparationLogic.prog_vars;
+ red. unfold prog_vars;
  subst prog; simpl.
  clear - ALIGNED.
  unfold QPall_initializers_aligned in *.
  unfold QPprog_vars in ALIGNED.
-  replace  (SeparationLogic.prog_vars'
+  replace  (prog_vars'
      (map of_builtin (QP.prog_builtins p) ++ PTree.elements (QP.prog_defs p)))
-    with  (SeparationLogic.prog_vars'(PTree.elements (QP.prog_defs p)))
+    with  (prog_vars'(PTree.elements (QP.prog_defs p)))
        by (induction (QP.prog_builtins p) as [|[i ?]]; try destruct b; simpl; auto).
  induction (PTree.elements (QP.prog_defs p)) as [|[i?]]; auto.
  destruct g; auto.
@@ -3683,14 +3682,14 @@ Proof.
   f_equal.
   apply (proj1 (QPcompspecs_OK_e _ (proj2 (Comp_prog_OK c)))).
 -
- apply (@WholeComponent_semax_func _ _ _ _ _ _ c EXT_OK DEFS_NOT_BUILTIN).
+ apply (WholeComponent_semax_func c EXT_OK DEFS_NOT_BUILTIN).
 -
   subst prog; simpl.
-  unfold QPvarspecs, QPprog_vars, SeparationLogic.prog_vars. simpl.
+  unfold QPvarspecs, QPprog_vars, prog_vars. simpl.
   clear.
-  replace  (SeparationLogic.prog_vars'
+  replace  (prog_vars'
      (map of_builtin (QP.prog_builtins p) ++ PTree.elements (QP.prog_defs p)))
-    with  (SeparationLogic.prog_vars'(PTree.elements (QP.prog_defs p)))
+    with  (prog_vars'(PTree.elements (QP.prog_defs p)))
        by (induction (QP.prog_builtins p) as [|[i ?]]; try destruct b; simpl; auto).
   induction (PTree.elements (QP.prog_defs p)) as [|[i?]].
   simpl. auto.
@@ -3701,7 +3700,6 @@ Proof.
   simpl; auto.
 - simpl find_id.
    unfold augment_funspecs.
-   change SeparationLogic.prog_funct with prog_funct.
    erewrite prog_funct_QP_prog_funct; [ | reflexivity].
   set (G1 := G_merge [(QP.prog_main p, mainspec)] G).
    destruct (augment_funspecs'_exists G1 (QP.prog_builtins p) (QPprog_funct p)) 
@@ -3756,14 +3754,14 @@ Proof.
    exists post.
    unfold QPmain_spec_ext', main_spec_ext'.
    f_equal.
-   subst prog. unfold main_pre, SeparationLogic.main_pre.
-   unfold SeparationLogic.prog_vars. simpl.
+   subst prog. unfold main_pre, semax_prog.main_pre.
+   unfold prog_vars. simpl.
    unfold QPprog_vars.
-   replace  (SeparationLogic.prog_vars'
+   replace  (prog_vars'
      (map of_builtin (QP.prog_builtins p) ++ PTree.elements (QP.prog_defs p)))
-    with  (SeparationLogic.prog_vars'(PTree.elements (QP.prog_defs p)))
+    with  (prog_vars'(PTree.elements (QP.prog_defs p)))
        by (clear; induction (QP.prog_builtins p) as [|[i ?]]; try destruct b; simpl; auto).
-   extensionality gv rho.
+   extensionality gv; f_equal; extensionality rho.
    normalize. f_equal. f_equal. f_equal. f_equal.
   clear.
   induction (PTree.elements (QP.prog_defs p)) as [|[i?]]; auto.
@@ -3773,22 +3771,22 @@ Proof.
 Qed.
 
 (*another variant, currently unused*)
-Definition WholeProgSafeType'' {Espec E p Exports GP mainspec} G
+Definition WholeProgSafeType'' `{!VSTGS OK_ty Σ} {Espec E p Exports GP mainspec} G
        (NOMAIN:find_id (QP.prog_main p) G = None)
-        (COMP: @Component Espec (QPvarspecs p) E nil p Exports GP
+        (COMP: Component (Espec := Espec) (QPvarspecs p) E nil p Exports GP
          (G_merge
                  [(QP.prog_main p, mainspec)] G))
-             (z: @OK_ty Espec) :=
+             (z: OK_ty) :=
  exists cs, (*exists OK, *)exists CBC, (*exists G, *)
-@semax_prog Espec cs (prog_of_component COMP CBC)
+semax_prog (OK_spec := Espec) (cs := cs) (prog_of_component COMP CBC)
     z (QPvarspecs p) 
       (G_merge [(QP.prog_main p, mainspec)] G).
 
 Lemma WholeComponent_semax_prog'':
- forall {Espec Externs p Exports GP mainspec} G
+ forall `{!VSTGS OK_ty Σ} {Espec Externs p Exports GP mainspec} G
   (NOMAIN:
     find_id (QP.prog_main p) G = None )
-  (COMP: @Component Espec (QPvarspecs p) Externs nil p Exports GP (G_merge
+  (COMP: Component (Espec := Espec) (QPvarspecs p) Externs nil p Exports GP (G_merge
                  [(QP.prog_main p, mainspec)] G))
   (z: OK_ty)
   (MAIN: exists post, mainspec = QPmain_spec_ext' p z post)
@@ -3804,7 +3802,7 @@ Lemma WholeComponent_semax_prog'':
            = Errors.OK tt),
   WholeProgSafeType'' G NOMAIN COMP z.
 Proof.
- intros ? ? ? ? ? mainspec; intros.
+ intros ? ? ? ? ? ? ? ? mainspec; intros.
 (* destruct c as [NO_MAIN c].
  pose (prog := prog_of_component c (CBC _)).*)
  red.
@@ -3827,14 +3825,14 @@ Proof.
  replace (fun x : ident * QP.builtin => fst (of_builtin x)) with (@fst ident QP.builtin); auto.
  extensionality x. destruct x,b; simpl; auto.
 -
- red. unfold SeparationLogic.prog_vars;
+ red. unfold prog_vars;
  (*subst prog;*) simpl.
  clear - ALIGNED.
  unfold QPall_initializers_aligned in *.
  unfold QPprog_vars in ALIGNED.
-  replace  (SeparationLogic.prog_vars'
+  replace  (prog_vars'
      (map of_builtin (QP.prog_builtins p) ++ PTree.elements (QP.prog_defs p)))
-    with  (SeparationLogic.prog_vars'(PTree.elements (QP.prog_defs p)))
+    with  (prog_vars'(PTree.elements (QP.prog_defs p)))
        by (induction (QP.prog_builtins p) as [|[i ?]]; try destruct b; simpl; auto).
  induction (PTree.elements (QP.prog_defs p)) as [|[i?]]; auto.
  destruct g; auto.
@@ -3844,14 +3842,14 @@ Proof.
   f_equal.
   apply (proj1 (QPcompspecs_OK_e _ (proj2 (Comp_prog_OK c)))).
 -
- apply (@WholeComponent_semax_func _ _ _ _ _ _ c EXT_OK DEFS_NOT_BUILTIN).
+ apply (WholeComponent_semax_func c EXT_OK DEFS_NOT_BUILTIN).
 -
   (*subst prog;*) simpl.
-  unfold QPvarspecs, QPprog_vars, SeparationLogic.prog_vars. simpl.
+  unfold QPvarspecs, QPprog_vars, prog_vars. simpl.
   clear.
-  replace  (SeparationLogic.prog_vars'
+  replace  (prog_vars'
      (map of_builtin (QP.prog_builtins p) ++ PTree.elements (QP.prog_defs p)))
-    with  (SeparationLogic.prog_vars'(PTree.elements (QP.prog_defs p)))
+    with  (prog_vars'(PTree.elements (QP.prog_defs p)))
        by (induction (QP.prog_builtins p) as [|[i ?]]; try destruct b; simpl; auto).
   induction (PTree.elements (QP.prog_defs p)) as [|[i?]].
   simpl. auto.
@@ -3862,7 +3860,6 @@ Proof.
   simpl; auto.
 - simpl find_id.
    unfold augment_funspecs.
-   change SeparationLogic.prog_funct with prog_funct.
    erewrite prog_funct_QP_prog_funct; [ | reflexivity].
   set (G1 := G_merge [(QP.prog_main p, mainspec)] G).
    destruct (augment_funspecs'_exists G1 (QP.prog_builtins p) (QPprog_funct p)) 
@@ -3917,14 +3914,14 @@ Proof.
    exists post.
    unfold QPmain_spec_ext', main_spec_ext'.
    f_equal.
-   (*subst prog.*) unfold main_pre, SeparationLogic.main_pre.
-   unfold SeparationLogic.prog_vars. simpl.
+   (*subst prog.*) unfold main_pre, semax_prog.main_pre.
+   unfold prog_vars. simpl.
    unfold QPprog_vars.
-   replace  (SeparationLogic.prog_vars'
+   replace  (prog_vars'
      (map of_builtin (QP.prog_builtins p) ++ PTree.elements (QP.prog_defs p)))
-    with  (SeparationLogic.prog_vars'(PTree.elements (QP.prog_defs p)))
+    with  (prog_vars'(PTree.elements (QP.prog_defs p)))
        by (clear; induction (QP.prog_builtins p) as [|[i ?]]; try destruct b; simpl; auto).
-   extensionality gv rho.
+   extensionality gv; f_equal; extensionality rho.
    normalize. f_equal. f_equal. f_equal. f_equal.
   clear.
   induction (PTree.elements (QP.prog_defs p)) as [|[i?]]; auto.
@@ -3933,6 +3930,7 @@ Proof.
   f_equal; auto.
 Qed.
 
+
 Ltac QPlink_prog_tac p1 p2 :=
   let p' :=  uconstr:(QPlink_progs p1 p2) in
   let p'' := eval vm_compute in p' in
@@ -3941,15 +3939,15 @@ Ltac QPlink_prog_tac p1 p2 :=
   | Errors.Error ?m => fail "QPlink_progs failed:" m
    end.
 
-Ltac QPlink_prog_tac' := 
+Ltac QPlink_prog_tac' :=
  match goal with |- QPlink_progs ?p1 ?p2 = Errors.OK ?p =>
    let p' := QPlink_prog_tac p1 p2 in unify p p'; reflexivity
  end.
 
-Ltac proveWholeComponent := 
- match goal with |- @WholeCompType _ _ ?coreprog _ _ _ _ ?mainprog _ _ _ _ =>
+Ltac proveWholeComponent :=
+ match goal with |- WholeCompType (coreprog := ?coreprog) _ (mainprog := ?mainprog) _ =>
    let p := QPlink_prog_tac mainprog coreprog in
-    apply (@WholeComponent _ _ _ _ _ _ _ _ p)
+    apply (WholeComponent _ (whole_prog := p))
   end;
  [ reflexivity
  | list_disjoint_tac || fail "Varspecs of core-VSU overlap with funspecs of main-Component"
@@ -3971,82 +3969,3 @@ apply WholeComponent_semax_prog;
  | reflexivity || fail "Impossible: one of the QP.prog_defs is a builtin"
  | intro; reflexivity || fail "Surprising: cenv_built_correctly fails"].
 
-Section binary_intersection'_funspec_sub_mono.
-
-Definition sigBool_left {A B ts1} (x:functors.MixVariantFunctor._functor
-               ((fix dtfr (T : rmaps.TypeTree) : functors.MixVariantFunctor.functor :=
-                   match T with
-                   | rmaps.ConstType A => functors.MixVariantFunctorGenerator.fconst A
-                   | rmaps.CompspecsType => functors.MixVariantFunctorGenerator.fconst compspecs
-                   | rmaps.Mpred => functors.MixVariantFunctorGenerator.fidentity
-                   | rmaps.DependentType n => functors.MixVariantFunctorGenerator.fconst (@nth Type n ts1 unit)
-                   | rmaps.ProdType T1 T2 => functors.MixVariantFunctorGenerator.fpair (dtfr T1) (dtfr T2)
-                   | rmaps.ArrowType T1 T2 => functors.MixVariantFunctorGenerator.ffunc (dtfr T1) (dtfr T2)
-                   | rmaps.SigType I0 f0 => @functors.MixVariantFunctorGenerator.fsig I0 (fun i0 : I0 => dtfr (f0 i0))
-                   | rmaps.PiType I0 f0 => @functors.MixVariantFunctorGenerator.fpi I0 (fun i0 : I0 => dtfr (f0 i0))
-                   | rmaps.ListType T0 => functors.MixVariantFunctorGenerator.flist (dtfr T0)
-                   end) A) mpred):
-{i : bool &
-             functors.MixVariantFunctor._functor
-               ((fix dtfr (T : rmaps.TypeTree) : functors.MixVariantFunctor.functor :=
-                   match T with
-                   | rmaps.ConstType A => functors.MixVariantFunctorGenerator.fconst A
-                   | rmaps.CompspecsType => functors.MixVariantFunctorGenerator.fconst compspecs
-                   | rmaps.Mpred => functors.MixVariantFunctorGenerator.fidentity
-                   | rmaps.DependentType n => functors.MixVariantFunctorGenerator.fconst (@nth Type n ts1 unit)
-                   | rmaps.ProdType T1 T2 => functors.MixVariantFunctorGenerator.fpair (dtfr T1) (dtfr T2)
-                   | rmaps.ArrowType T1 T2 => functors.MixVariantFunctorGenerator.ffunc (dtfr T1) (dtfr T2)
-                   | rmaps.SigType I0 f0 => @functors.MixVariantFunctorGenerator.fsig I0 (fun i0 : I0 => dtfr (f0 i0))
-                   | rmaps.PiType I0 f0 => @functors.MixVariantFunctorGenerator.fpi I0 (fun i0 : I0 => dtfr (f0 i0))
-                   | rmaps.ListType T0 => functors.MixVariantFunctorGenerator.flist (dtfr T0)
-                   end) (if i then A else B)) mpred}.
-Proof. exists true; trivial. Defined.
-Definition sigBool_right {A B ts1} (x:functors.MixVariantFunctor._functor
-               ((fix dtfr (T : rmaps.TypeTree) : functors.MixVariantFunctor.functor :=
-                   match T with
-                   | rmaps.ConstType A => functors.MixVariantFunctorGenerator.fconst A
-                   | rmaps.CompspecsType => functors.MixVariantFunctorGenerator.fconst compspecs
-                   | rmaps.Mpred => functors.MixVariantFunctorGenerator.fidentity
-                   | rmaps.DependentType n => functors.MixVariantFunctorGenerator.fconst (@nth Type n ts1 unit)
-                   | rmaps.ProdType T1 T2 => functors.MixVariantFunctorGenerator.fpair (dtfr T1) (dtfr T2)
-                   | rmaps.ArrowType T1 T2 => functors.MixVariantFunctorGenerator.ffunc (dtfr T1) (dtfr T2)
-                   | rmaps.SigType I0 f0 => @functors.MixVariantFunctorGenerator.fsig I0 (fun i0 : I0 => dtfr (f0 i0))
-                   | rmaps.PiType I0 f0 => @functors.MixVariantFunctorGenerator.fpi I0 (fun i0 : I0 => dtfr (f0 i0))
-                   | rmaps.ListType T0 => functors.MixVariantFunctorGenerator.flist (dtfr T0)
-                   end) B) mpred):
-{i : bool &
-             functors.MixVariantFunctor._functor
-               ((fix dtfr (T : rmaps.TypeTree) : functors.MixVariantFunctor.functor :=
-                   match T with
-                   | rmaps.ConstType A => functors.MixVariantFunctorGenerator.fconst A
-                   | rmaps.CompspecsType => functors.MixVariantFunctorGenerator.fconst compspecs
-                   | rmaps.Mpred => functors.MixVariantFunctorGenerator.fidentity
-                   | rmaps.DependentType n => functors.MixVariantFunctorGenerator.fconst (@nth Type n ts1 unit)
-                   | rmaps.ProdType T1 T2 => functors.MixVariantFunctorGenerator.fpair (dtfr T1) (dtfr T2)
-                   | rmaps.ArrowType T1 T2 => functors.MixVariantFunctorGenerator.ffunc (dtfr T1) (dtfr T2)
-                   | rmaps.SigType I0 f0 => @functors.MixVariantFunctorGenerator.fsig I0 (fun i0 : I0 => dtfr (f0 i0))
-                   | rmaps.PiType I0 f0 => @functors.MixVariantFunctorGenerator.fpi I0 (fun i0 : I0 => dtfr (f0 i0))
-                   | rmaps.ListType T0 => functors.MixVariantFunctorGenerator.flist (dtfr T0)
-                   end) (if i then A else B)) mpred}.
-Proof. exists false; trivial. Defined.
-
-Lemma binary_intersection'_funspec_sub_mono {f c A1 P1 Q1 P1ne Q1ne B1 R1 S1 R1ne S1ne phi1 psi1 Phi1 Psi1 
-             A2 P2 Q2 P2ne Q2ne B2 R2 S2 R2ne S2ne phi2 psi2 Phi2 Psi2}
-(Hphi: funspec_sub phi1 phi2)
-(Hpsi: funspec_sub psi1 psi2):
-funspec_sub (@binary_intersection' f c A1 P1 Q1 P1ne Q1ne B1 R1 S1 R1ne S1ne phi1 psi1 Phi1 Psi1)
-            (@binary_intersection' f c A2 P2 Q2 P2ne Q2ne B2 R2 S2 R2ne S2ne phi2 psi2 Phi2 Psi2).
-Proof.
-split; [ split; trivial | intros].
-subst.
-unfold binarySUMArgs. destruct x2; simpl. destruct x.
-+ clear Hpsi. destruct Hphi as [_ Hphi].
-  eapply derives_trans. apply (Hphi ts2 _f gargs). clear Hphi. apply fupd_mono.
-  Intros ts1 x1 F. Exists ts1 (@sigBool_left A1 B1 ts1 x1) F; simpl.
-  entailer.
-+ clear Hphi. destruct Hpsi as [_ Hpsi].
-  eapply derives_trans. apply (Hpsi ts2 _f gargs). clear Hpsi. apply fupd_mono.
-  Intros ts1 x1 F. Exists ts1 (@sigBool_right A1 B1 ts1 x1) F; simpl.
-  entailer.
-Qed.
-End binary_intersection'_funspec_sub_mono.
diff --git a/floyd/VSU_DrySafe.v b/floyd/VSU_DrySafe.v
index d7bbcaa932..d48435cab8 100644
--- a/floyd/VSU_DrySafe.v
+++ b/floyd/VSU_DrySafe.v
@@ -5,7 +5,6 @@ Require Export VST.floyd.PTops.
 Require Export VST.floyd.QPcomposite.
 Require Export VST.floyd.quickprogram.
 Require Export VST.floyd.Component.
-Import compcert.lib.Maps.
 
 Require Import VST.floyd.SeparationLogicAsLogic. (*Soundness.*)
 Require Import VST.floyd.SeparationLogicAsLogicSoundness.
@@ -15,10 +14,16 @@ Require Import VST.veric.juicy_mem. (*for mem_sub*)
 Require Import VST.sepcomp.event_semantics. (*for mem_event*)
 Require Import VST.veric.Clight_core. (*for inline_external_call_mem_events*)
 Require Import VST.sepcomp.extspec. (*for ext_spec_type.*) 
-Require Import VST.veric.SequentialClight2. (*for extspec_frame *)
+Require Import VST.veric.SequentialClight. (*for extspec_frame *)
+
+Local Unset SsrRewrite.
+
+Section VST.
+
+Context `{!VSTGS OK_ty Σ}.
 
 Lemma prog_of_component_irr {Espec Externs p Exports GP G}
-      c X Y: @prog_of_component Espec Externs p Exports GP G c X = @prog_of_component Espec Externs p Exports GP G c Y.
+      c X Y: @prog_of_component _ _ _ Espec Externs p Exports GP G c X = @prog_of_component _ _ _ Espec Externs p Exports GP G c Y.
 Proof. unfold prog_of_component. destruct c. simpl. f_equal. f_equal. apply proof_irr. Qed.
 
 Lemma wholeprog_of_QPprog_irr p ok X Y: wholeprog_of_QPprog p ok X = wholeprog_of_QPprog p ok Y.
@@ -31,12 +36,6 @@ assert (ok = ok').
 subst ok'. apply wholeprog_of_QPprog_irr.
 Qed.
 
-Lemma prog_funct'_eq: @SeparationLogic.prog_funct' = @initial_world.prog_funct'.
-Proof. reflexivity. Qed.
-
-Lemma prog_funct_eq (p:Clight.program): @SeparationLogic.prog_funct p = Clight_initial_world.prog_funct p.
-Proof. reflexivity. Qed.
-
 Lemma prog_funct'_app {F V}: forall l1 l2,
       @prog_funct' F V (l1 ++ l2) = @prog_funct' F V l1 ++ @prog_funct' F V l2.
 Proof. induction l1; simpl; intros. trivial.
@@ -54,7 +53,7 @@ destruct (ident_eq i j); subst.
    subst. exists (S k); simpl; trivial.
 Qed.
 
-Lemma delete_id_Some_In_inv: forall (G:funspecs)
+Lemma delete_id_Some_In_inv: forall (G:@funspecs Σ)
       (HG : list_norepet (map fst G))
       i j (IJ: i <> j) phi GG,
       delete_id i G = Some (phi, GG) -> In j (map fst GG) -> In j (map fst G).
@@ -67,7 +66,7 @@ Proof. induction G; simpl in *; intros. inv H.
     - right. eauto.
 Qed.
 
-Lemma delete_id_Some_find_id_other_inv: forall (G:funspecs)
+Lemma delete_id_Some_find_id_other_inv: forall (G:@funspecs Σ)
       (HG: list_norepet (map fst G)) i phi GG 
       (Hi : delete_id i G = Some (phi, GG)) j
       (Hij : i <> j) psi
@@ -75,7 +74,7 @@ Lemma delete_id_Some_find_id_other_inv: forall (G:funspecs)
       find_id j G = Some psi.
 Proof. induction G; simpl; intros. inv Hi.
   destruct a. inv HG. specialize (IHG H2). 
-  destruct (Memory.EqDec_ident j i0).
+  if_tac.
 + subst i0. rewrite if_false in Hi by trivial.
   remember (delete_id i G) as d; symmetry in Heqd; destruct d; [ destruct p |]; inv Hi.
   simpl in J; rewrite if_true in J by trivial. inv J; trivial.
@@ -134,7 +133,7 @@ Lemma augment_funspecs_find_id_None i: forall p G,
       find_id i (prog_funct p) = None ->
       find_id i (augment_funspecs p G) = None.
 Proof.
-  intros p. unfold augment_funspecs; rewrite prog_funct_eq. forget (Clight_initial_world.prog_funct p) as l. clear p.
+  intros p. unfold augment_funspecs. forget (prog_funct p) as l. clear p.
   induction l; simpl; intros G.
 + intros. destruct G; simpl; intros; trivial.
 + destruct a as [j phi]; if_tac; subst; intros; try discriminate.
@@ -165,7 +164,7 @@ simpl in H1; subst i0.
 rewrite if_true by auto.
 specialize (IHfds G H2).
 destruct (augment_funspecs' fds G) as [G' | ] eqn:?H.
-2:{ destruct G; inv IHfds. destruct fds; inv H2. inv H. }
+2:{ destruct G; inv IHfds. destruct fds; inv H2. }
 subst; trivial.
 Qed.
 
@@ -185,7 +184,7 @@ simpl in H1; subst i0.
 rewrite if_true by auto.
 specialize (IHfds G H2).
 destruct (augment_funspecs' fds G) as [G' | ] eqn:?H.
-2:{ destruct G; inv IHfds. destruct fds; inv H2. inv H. }
+2:{ destruct G; inv IHfds. destruct fds; inv H2. }
 constructor.
 split; auto.
 simpl.
@@ -195,16 +194,19 @@ Qed.
 
 Axiom semaxfunc_AX:
       forall Espec V G cs ge fdecls GG,
-           @MainTheorem.CSHL_MinimumLogic.CSHL_Def.semax_func Espec V G cs ge fdecls GG ->
-           @SeparationLogicSoundness.VericMinimumSeparationLogic.CSHL_Def.semax_func Espec V G cs ge fdecls GG.
+           MainTheorem.CSHL_MinimumLogic.CSHL_Def.semax_func (OK_spec := Espec) V G (C := cs) ge fdecls GG ->
+           SeparationLogicSoundness.VericMinimumSeparationLogic.CSHL_Def.semax_func _ _ _ Espec V G cs ge fdecls GG.
+
+End VST.
 
 Lemma WholeComponent_DrySafe:
- forall {Espec Externs p Exports GP mainspec} G 
-  (NOMAIN: find_id (QP.prog_main p) G = None)
-   (c: @Component Espec (QPvarspecs p) Externs nil p Exports GP (G_merge
+ forall Σ `{!VSTGpreS OK_ty Σ} {Espec : forall `{VSTGS OK_ty Σ}, ext_spec OK_ty} {dryspec : ext_spec OK_ty} {Externs p Exports}
+  {GP : forall `{VSTGS OK_ty Σ}, globals -> mpred} (mainspec : forall `{VSTGS OK_ty Σ}, funspec) (G : forall `{VSTGS OK_ty Σ}, funspecs)
+  (NOMAIN: forall `{VSTGS OK_ty Σ}, find_id (QP.prog_main p) G = None)
+   (c: forall {HH : VSTGS OK_ty Σ}, Component (Espec := Espec) (QPvarspecs p) Externs nil p Exports GP (G_merge
                  [(QP.prog_main p, mainspec)] G))
   (z: OK_ty)
-  (MAIN: exists post, mainspec = QPmain_spec_ext' p z post)
+  (MAIN: forall {HH : VSTGS OK_ty Σ}, exists post, mainspec = QPmain_spec_ext' p z post)
   (MAIN': isSome (PTree.get (QP.prog_main p) (QP.prog_defs p)))
   (EXT_OK: all_unspecified_OK p)
   (ALIGNED: QPall_initializers_aligned p = true) (* should be part of QPprogram_OK *)
@@ -215,67 +217,43 @@ Lemma WholeComponent_DrySafe:
            (sort_rank (PTree.elements (QP.prog_comp_env p)) []))
          (composite_env_of_QPcomposite_env (QP.prog_comp_env p) H) 
            = Errors.OK tt)
+  (EXIT: forall {HH : VSTGS OK_ty Σ}, semax_prog.postcondition_allows_exit Espec tint)
+  (Hdry : forall {HH : VSTGS OK_ty Σ}, ext_spec_entails Espec dryspec)
 
-  (dryspec : extspec.ext_spec OK_ty)
-  (dessicate : forall ef : external_function,
-            juicy_mem ->
-            @ext_spec_type juicy_mem external_function
-              (@OK_ty Espec) (@OK_spec Espec) ef ->
-            @ext_spec_type mem external_function
-              (@OK_ty Espec) dryspec ef)
-  (Jsub: forall (ef : external_function) (se : Senv.t) (lv : list val) (m : mem) (t : Events.trace) 
-                (v : val) (m' : mem) (EFI : ef_inline ef = true) 
-                (m1 : Mem.mem') (EFC : Events.external_call ef se lv m t v m'),
-         mem_sub m m1 ->
-         exists (m1' : mem) (EFC1 : Events.external_call ef se lv m1 t v m1'),
-            mem_sub m' m1' /\
-           @proj1_sig (list mem_event) (fun trace : list mem_event => ev_elim m1 trace m1')
-                      (inline_external_call_mem_events ef se lv m1 t v m1' EFI EFC1) =
-           @proj1_sig (list mem_event) (fun trace : list mem_event => ev_elim m trace m')
-                      (inline_external_call_mem_events ef se lv m t v m' EFI EFC))
-  (Jframe : @extspec_frame (@OK_ty Espec) (@OK_spec Espec))
-  (JDE : juicy_dry_ext_spec (@OK_ty Espec) (@OK_spec Espec) dryspec dessicate)
-  (DME : ext_spec_mem_evolve (@OK_ty Espec) dryspec)
-  (PAE : semax_prog.postcondition_allows_exit Espec tint)
-  (Esub : forall (v : option val) (z : @OK_ty Espec)
-         (m : mem) (m' : Mem.mem'),
-       @ext_spec_exit mem external_function
-         (@OK_ty Espec) dryspec v z m ->
-       mem_sub m m' ->
-       @ext_spec_exit mem external_function
-         (@OK_ty Espec) dryspec v z m')
-  wholeprog X
-  (Hprog: wholeprog = wholeprog_of_QPprog p (Comp_prog_OK c) X)
+  wholeprog (X : forall {HH : VSTGS OK_ty Σ}, _)
+  (Hprog: forall {HH : VSTGS OK_ty Σ}, wholeprog = wholeprog_of_QPprog p (Comp_prog_OK c) X)
   m (Hm: Genv.init_mem wholeprog = Some m),
-exists (b : block) (q : CC_core) (m' : mem),
+exists (b : block) (q : CC_core),
    @Genv.find_symbol (Ctypes.fundef function) type
      (@Genv.globalenv (Ctypes.fundef function) type wholeprog)
-     (@prog_main (Ctypes.fundef function) type wholeprog) = @Some block b /\
-   @semantics.initial_core CC_core mem (cl_core_sem (globalenv wholeprog)) 0 m q m'
+     (prog_main wholeprog) = @Some block b /\
+   @semantics.initial_core CC_core mem (cl_core_sem (globalenv wholeprog)) 0 m q m
      (Vptr b Ptrofs.zero) [] /\
-   (forall n : nat, @step_lemmas.dry_safeN (Genv.t Clight.fundef type) CC_core mem 
-      (@OK_ty Espec) (@semax.genv_symb_injective Clight.fundef type)
+   (forall n : nat, @step_lemmas.dry_safeN (Genv.t Clight.fundef type) CC_core mem
+      (OK_ty) (@semax.genv_symb_injective Clight.fundef type)
       (cl_core_sem (globalenv wholeprog)) dryspec
       {| genv_genv := @Genv.globalenv (Ctypes.fundef function) type wholeprog;
-        genv_cenv := @prog_comp_env function wholeprog |} n z q m').
+        genv_cenv := @prog_comp_env function wholeprog |} n z q m).
 Proof.
   intros.
-  eapply (whole_program_sequential_safety z dryspec); trivial. eassumption.
-  instantiate (1:= augment_funspecs wholeprog (G_merge [(QP.prog_main p, mainspec)] G)).
+  eapply whole_program_sequential_safety_ext; trivial.
+  instantiate (1:= fun (HH : VSTGS OK_ty Σ) => augment_funspecs wholeprog (G_merge [(QP.prog_main p, mainspec HH)] (G HH))).
   instantiate (1:= (QPvarspecs p)).
-  assert (SP:=WholeComponent_semax_progConstructive _ _ _ _ _ _ _ c NOMAIN _ MAIN MAIN' EXT_OK ALIGNED DEFS_NOT_BUILTIN CBC).
-  clear - NOMAIN MAIN' SP.
+  intros.
+  assert (SP:=WholeComponent_semax_progConstructive _ _ _ _ _ _ _ (c HH) (NOMAIN HH) _ (MAIN HH) MAIN' EXT_OK ALIGNED DEFS_NOT_BUILTIN CBC).
+  clear - NOMAIN MAIN' SP Hprog.
+  specialize (Hprog HH).
   destruct SP as [Hnames [Halign [Hcenv [Hsemaxfunc [Hglobvars Hmainspec]]]]].
-  remember (wholeprog_of_QPprog p (Comp_prog_OK c)
+  remember (wholeprog_of_QPprog p (Comp_prog_OK (c HH))
                      (cenv_built_correctly_e
                         (map compdef_of_compenv_element
                            (sort_rank (PTree.elements (QP.prog_comp_env p)) []))
                         (composite_env_of_QPcomposite_env (QP.prog_comp_env p)
-                           (projT1 (proj2 (Comp_prog_OK c))))
-                        (CBC (projT1 (proj2 (Comp_prog_OK c)))))) as w.
+                           (projT1 (proj2 (Comp_prog_OK (c HH)))))
+                        (CBC (projT1 (proj2 (Comp_prog_OK (c HH))))))) as w.
   assert (WP: w = wholeprog) by (subst; apply wholeprog_of_QPprog_irr).
   clear Heqw; subst w.
-  red. intuition.
+  eexists. red. intuition.
   1: apply Hcenv.
   1: eapply semaxfunc_AX; apply Hsemaxfunc.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/floyd/VSU_addmain.v b/floyd/VSU_addmain.v
index e2294fdc31..993d067c33 100644
--- a/floyd/VSU_addmain.v
+++ b/floyd/VSU_addmain.v
@@ -278,7 +278,7 @@ Lemma semaxfunc_cons_ext_vacuous:
        (id_in_list id (map fst fs)) = false ->
        ef_sig ef =
        {|
-         sig_args := typlist_of_typelist argsig;
+         sig_args := typlist_of_list type argsig;
          sig_res := xtype_of_type retsig;
          sig_cc := cc_of_fundef (External ef argsig retsig cc) |} ->
        Genv.find_symbol ge id = Some b ->
@@ -290,7 +290,7 @@ Proof.
 intros.
 eapply (@semaxfunc_cons_ext Espec cs V G ge fs id ef argsig retsig); trivial.
 repeat split; trivial.
-* rewrite <-(typelist2list_arglist _ 1). reflexivity.
+* rewrite <-(list type2list_arglist _ 1). reflexivity.
 * right. clear. hnf. intros. simpl in X; inv X.
 * intros. simpl. apply andp_left1, FF_left.
 * apply semax_external_FF.
@@ -1298,7 +1298,7 @@ Variable MainE_vacuous: forall i phi, find_id i MainE = Some phi -> find_id i co
          exists ef argsig retsig cc, 
            phi = vacuous_funspec (External ef argsig retsig cc) /\ 
            find_id i (QPprog_funct p) = Some (External ef argsig retsig cc) /\
-           ef_sig ef = {| sig_args := typlist_of_typelist argsig;
+           ef_sig ef = {| sig_args := typlist_of_list type argsig;
                           sig_res := xtype_of_type retsig;
                           sig_cc := cc_of_fundef (External ef argsig retsig cc) |}.
 
@@ -1401,7 +1401,7 @@ simpl in H.
       destruct (MainE_vacuous _ _ H0 coreE_i) as [ef [tys [rt [cc [PHI [FDp EFsig]]]]]]; clear MainE_vacuous JUST.  rewrite FDp in H; inv H.
       apply find_id_In_map_fst in H0. clear HypME1.
       split3; trivial.
-      split3; [ apply typelist2list_arglist
+      split3; [ apply list type2list_arglist
               | apply EFsig |].
       split3; [ right; red; simpl; intros h H; inv H
               | simpl; intros gx l H; inv H |].
diff --git a/floyd/aggregate_pred.v b/floyd/aggregate_pred.v
index 8cbec0593e..19b196fb75 100644
--- a/floyd/aggregate_pred.v
+++ b/floyd/aggregate_pred.v
@@ -1,4 +1,6 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.type_induction.
 Require Import VST.floyd.compact_prod_sum.
@@ -11,7 +13,10 @@ Require Export VST.floyd.fieldlist.
 Require Export VST.floyd.aggregate_type.
 
 Open Scope Z.
-Open Scope logic.
+
+Section mpred.
+
+Context `{!heapGS Σ}.
 
 (******************************************
 
@@ -19,31 +24,31 @@ Definition and lemmas about rangespec
 
 ******************************************)
 
-Fixpoint rangespec (lo: Z) (n: nat) (P: Z -> val -> mpred): val -> mpred :=
+Fixpoint rangespec (lo: Z) (n: nat) (P: Z -> val -> mpred) (p: val) : mpred :=
   match n with
-  | O => fun _ => emp
-  | S n' => P lo * rangespec (Z.succ lo) n' P
+  | O => emp
+  | S n' => P lo p ∗ rangespec (Z.succ lo) n' P p
  end.
 
 Fixpoint fold_range' {A: Type} (f: Z -> A -> A) (zero: A) (lo: Z) (n: nat) : A :=
  match n with
   | O => zero
-  | S n' => f lo (fold_range' f  zero (Z.succ lo) n')
+  | S n' => f lo (fold_range' f zero (Z.succ lo) n')
  end.
 
 Definition fold_range {A: Type} (f: Z -> A -> A) (zero: A) (lo hi: Z) : A :=
   fold_range' f zero lo (Z.to_nat (hi-lo)).
 
 Lemma rangespec_shift_derives: forall lo lo' len P P' p p',
-  (forall i i', lo <= i < lo + Z_of_nat len -> i - lo = i' - lo' -> P i p |-- P' i' p') ->
-  rangespec lo len P p |-- rangespec lo' len P' p'.
+  (forall i i', lo <= i < lo + Z_of_nat len -> i - lo = i' - lo' -> P i p ⊢ P' i' p') ->
+  rangespec lo len P p ⊢ rangespec lo' len P' p'.
 Proof.
   intros.
   revert lo lo' H;
   induction len; intros.
   + simpl. auto.
   + simpl.
-    apply sepcon_derives.
+    apply bi.sep_mono.
     - apply H; [| lia].
       rewrite Nat2Z.inj_succ.
       rewrite <- Z.add_1_r.
@@ -57,8 +62,8 @@ Proof.
 Qed.
 
 Lemma rangespec_ext_derives: forall lo len P P' p,
-  (forall i, lo <= i < lo + Z_of_nat len -> P i p |-- P' i p) ->
-  rangespec lo len P p |-- rangespec lo len P' p.
+  (forall i, lo <= i < lo + Z_of_nat len -> P i p ⊢ P' i p) ->
+  rangespec lo len P p ⊢ rangespec lo len P' p.
 Proof.
   intros.
   apply rangespec_shift_derives.
@@ -73,55 +78,57 @@ Lemma rangespec_shift: forall lo lo' len P P' p p',
   (forall i i', lo <= i < lo + Z_of_nat len -> i - lo = i' - lo' -> P i p = P' i' p') ->
   rangespec lo len P p = rangespec lo' len P' p'.
 Proof.
-  intros; apply pred_ext; apply rangespec_shift_derives;
   intros.
-  + erewrite H; eauto. 
-      apply derives_refl.
-  + erewrite H; eauto.
-      apply derives_refl.
-    lia.
+  revert lo lo' H;
+  induction len; intros.
+  + simpl. auto.
+  + simpl.
+    f_equal.
+    - apply H; [| lia].
+      rewrite Nat2Z.inj_succ.
+      rewrite <- Z.add_1_r.
+      lia.
+    - apply IHlen. intros.
+      apply H; [| lia].
+      rewrite Nat2Z.inj_succ.
+      rewrite <- Z.add_1_r.
+      pose proof Zle_0_nat (S len).
+      lia.
 Qed.
 
 Lemma rangespec_ext: forall lo len P P' p,
   (forall i, lo <= i < lo + Z_of_nat len -> P i p = P' i p) ->
   rangespec lo len P p = rangespec lo len P' p.
 Proof.
-  intros; apply pred_ext; apply rangespec_ext_derives;
-  intros; rewrite H; auto.
+  intros; apply rangespec_shift; intros.
+  assert (i = i') as <- by lia; auto.
 Qed.
 
 Lemma rangespec_sepcon: forall lo len P Q p,
-  rangespec lo len P p * rangespec lo len Q p = rangespec lo len (P * Q) p.
+  (rangespec lo len P p ∗ rangespec lo len Q p) = rangespec lo len (fun z v => P z v ∗ Q z v) p.
 Proof.
   intros.
   revert lo; induction len; intros.
   + simpl.
-    rewrite sepcon_emp; auto.
+    rewrite sep_emp //.
   + simpl.
-    rewrite !sepcon_assoc.
-    f_equal.
-    rewrite <- sepcon_assoc, (sepcon_comm _ (Q lo p)), sepcon_assoc.
-    f_equal.
-    rewrite IHlen.
-    reflexivity.
+    rewrite -!sep_assoc; f_equal.
+    rewrite -IHlen !sep_assoc; f_equal.
+    apply sep_comm.
 Qed.
 
-Lemma rangespec_elim: forall lo len P i,
-  lo <= i < lo + Z_of_nat len -> rangespec lo len P |-- P i * TT.
+Lemma rangespec_elim: forall lo len P i p,
+  lo <= i < lo + Z_of_nat len -> rangespec lo len P p ⊢ <absorb> P i p.
 Proof.
   intros. revert lo i H; induction len; intros.
   + simpl in H. lia.
   + simpl. intros; destruct (Z.eq_dec i lo).
-    - subst. cancel.
-    - replace (P i x * !!True) with (TT * (P i x * TT)) by (apply pred_ext; cancel).
-      apply sepcon_derives; [cancel |].
-      apply IHlen.
-      rewrite Nat2Z.inj_succ in H.
-      rewrite <- Z.add_1_l in *.
+    - subst. rewrite /bi_absorbingly. cancel.
+    - iIntros "(_ & ?)"; iApply (IHlen with "[$]").
       lia.
 Qed.
 
-Inductive Forallz {A} (P: Z -> A->Prop) : Z -> list A -> Prop :=
+Inductive Forallz {A} (P: Z -> A -> Prop) : Z -> list A -> Prop :=
  | Forallz_nil : forall i, Forallz P i nil
  | Forallz_cons : forall i x l, P i x -> Forallz P (Z.succ i) l -> Forallz P i (x::l).
 
@@ -132,7 +139,7 @@ Definition of aggregate predicates.
 ******************************************)
 
 Definition array_pred {A: Type}{d: Inhabitant A}  (lo hi: Z) (P: Z -> A -> val -> mpred) (v: list A) (p: val) : mpred :=
-  !! (Zlength v = hi - lo) &&
+  ⌜Zlength v = hi - lo⌝ ∧
   rangespec lo (Z.to_nat (hi-lo)) (fun i => P i (Znth (i-lo) v)) p.
 
 Definition struct_pred (m: members) {A: member -> Type} (P: forall it, A it -> val -> mpred) (v: compact_prod (map A m)) (p: val): mpred.
@@ -142,7 +149,7 @@ Proof.
   + simpl in v.
     exact (P _ v p).
   + simpl in v.
-    exact ((P _ (fst v) p) * IHm _ (snd v)).
+    exact ((P _ (fst v) p) ∗ IHm _ (snd v)).
 Defined.
 
 (* when unfold, do cbv [struct_pred list_rect]. *)
@@ -165,7 +172,7 @@ Definition array_Prop {A: Type} (d:A) (lo hi: Z) (P: Z -> A -> Prop) (v: list A)
 Definition struct_Prop (m: members) {A: member -> Type}
                              (P: forall it, A it -> Prop) (v: compact_prod (map A m)) : Prop.
 Proof.
-  destruct m as [| a m]; [exact True | ].
+  destruct m as [| a m]; [exact True%type | ].
   revert a v; induction m as [| b m]; intros ? v.
   + simpl in v.
     exact (P _ v).
@@ -176,7 +183,7 @@ Defined.
 Definition union_Prop (m: members) {A: member -> Type}
                (P: forall it, A it -> Prop) (v: compact_sum (map A m)): Prop.
 Proof.
-  destruct m as [| a m]; [exact True |].
+  destruct m as [| a m]; [exact True%type |].
   revert a v; induction m as [| b m]; intros ? v.
   + simpl in v.
     exact (P _ v).
@@ -200,7 +207,7 @@ Proof.
   unfold array_pred.
   replace (Z.to_nat (hi - lo)) with 0%nat by (symmetry; apply Z_to_nat_neg; lia).
   simpl.
-  rewrite prop_true_andp by (unfold Zlength; simpl; lia).
+  rewrite -> prop_true_andp by (unfold Zlength; simpl; lia).
   reflexivity.
 Qed.
 
@@ -210,75 +217,66 @@ Proof.
   intros.
   unfold array_pred.
   replace (i + 1 - i) with 1 by lia.
-  simpl. rewrite sepcon_emp.
-  rewrite prop_true_andp by (unfold Zlength; simpl; lia).
-  unfold Znth. rewrite Z.sub_diag. rewrite if_false by lia. change (Z.to_nat 0) with 0%nat. auto.
+  simpl. rewrite sep_emp.
+  rewrite -> prop_true_andp by (unfold Zlength; simpl; lia).
+  unfold Znth. rewrite Z.sub_diag. rewrite -> if_false by lia. auto.
 Qed.
 
 Lemma split_array_pred: forall {A}{d: Inhabitant A} lo mid hi P (v: list A) p,
   lo <= mid <= hi ->
   Zlength v = hi - lo ->
   array_pred lo hi P v p =
-  array_pred lo mid P (sublist 0 (mid-lo) v) p *
-  array_pred mid hi P (sublist (mid-lo) (hi-lo) v) p.
+  (array_pred lo mid P (sublist 0 (mid-lo) v) p ∗
+   array_pred mid hi P (sublist (mid-lo) (hi-lo) v) p).
 Proof.
   intros.
   unfold array_pred.
   normalize.
-  rewrite prop_true_andp by (rewrite !Zlength_sublist by lia; lia).
+  rewrite -> prop_true_andp by (rewrite -> !Zlength_sublist by lia; lia).
   clear H0.
   remember (Z.to_nat (mid-lo)) as n.
   replace (Z.to_nat (hi-lo)) with (n + Z.to_nat (hi-mid))%nat in *
     by (subst n; rewrite <- Z2Nat.inj_add by lia; f_equal; lia).
   assert (lo = mid - Z.of_nat n)
-    by (rewrite Heqn; rewrite Z2Nat.id by lia; lia).
+    by (rewrite Heqn; rewrite -> Z2Nat.id by lia; lia).
   clear Heqn.
   revert lo v H H0; induction n; intros.
   + subst lo.
     change (Z.of_nat 0) with 0 in *.
-    simpl rangespec at 2. rewrite emp_sepcon.
-    rewrite Z.sub_0_r, Z.sub_diag, Nat.add_0_l.
+    simpl rangespec at 2. rewrite emp_sep.
+    rewrite Z.sub_0_r Z.sub_diag Nat.add_0_l.
     apply rangespec_ext; intros.
-    rewrite Z2Nat.id in H0 by lia.
+    rewrite -> Z2Nat.id in H0 by lia.
     f_equal.
-    rewrite Znth_sublist, Z.add_0_r by lia.
+    rewrite -> Znth_sublist, Z.add_0_r by lia.
     reflexivity.
   + simpl plus at 1.
     unfold rangespec; fold rangespec.
-    repeat match goal with |- context [(?A * ?B) p] => change ((A*B)p) with (A p * B p) end.
-    rewrite !sepcon_assoc.
-    f_equal.
-    - f_equal.
-      rewrite Z.sub_diag.
+    rewrite -sep_assoc; f_equal.
+    - rewrite Z.sub_diag.
       subst lo.
-      rewrite Znth_sublist by (try rewrite Nat2Z.inj_succ; lia).
+      rewrite -> Znth_sublist by (try rewrite Nat2Z.inj_succ; lia).
       reflexivity.
-    - replace (rangespec (Z.succ lo) (n + Z.to_nat (hi - mid))
-              (fun i : Z => P i (Znth (i - lo) v)) p)
-      with (rangespec (Z.succ lo) (n + Z.to_nat (hi - mid))
-              (fun i : Z => P i (Znth (i - Z.succ lo) (skipn 1 v))) p).
+    - erewrite rangespec_ext.
+      setoid_rewrite IHn; [|lia..].
       2:{
-        apply rangespec_ext; intros.
-        f_equal.
+        intros; simpl.
         rewrite <- Znth_succ by lia; auto.
       }
       rewrite Nat2Z.inj_succ in H0.
-      rewrite IHn by lia.
       f_equal.
       * apply rangespec_ext; intros.
-        f_equal.
-        rewrite Znth_sublist, Z.add_0_r by lia.
+        rewrite -> Znth_sublist, Z.add_0_r by lia.
         rewrite <- Znth_succ by lia; auto.
-        rewrite Znth_sublist, Z.add_0_r by lia.
+        rewrite -> Znth_sublist, Z.add_0_r by lia.
         reflexivity.
       * apply rangespec_ext; intros.
-        f_equal.
-        rewrite Z2Nat.id in H1 by lia.
-        rewrite Znth_sublist by lia.
-        rewrite Znth_sublist by lia.
+        rewrite -> Z2Nat.id in H1 by lia.
+        rewrite -> Znth_sublist by lia.
+        rewrite -> Znth_sublist by lia.
         replace (i - mid + (mid - Z.succ lo)) with (i - Z.succ lo) by lia.
         rewrite <- Znth_succ by lia; auto.
-         f_equal; lia.
+        f_equiv; f_equiv; lia.
 Qed.
 
 Lemma array_pred_shift: forall {A}{d: Inhabitant A} (lo hi lo' hi' mv : Z) P' P (v: list A) p,
@@ -289,13 +287,11 @@ Lemma array_pred_shift: forall {A}{d: Inhabitant A} (lo hi lo' hi' mv : Z) P' P
 Proof.
   intros.
   unfold array_pred.
-  apply andp_prop_ext; [lia | intros].
+  f_equal; first by f_equal; apply prop_ext; lia.
   replace (hi' - lo') with (hi - lo) by lia.
-  destruct (zlt hi lo). rewrite Z2Nat_neg by lia. reflexivity.
-  apply pred_ext; apply rangespec_shift_derives; intros.
-  rewrite H4; rewrite Z2Nat.id in H3 by lia.
-  rewrite H1; auto; lia.
-  rewrite <- H4; rewrite Z2Nat.id in H3 by lia.
+  destruct (zlt hi lo). rewrite -> Z2Nat_neg by lia. reflexivity.
+  apply rangespec_shift; intros.
+  rewrite H3; rewrite -> Z2Nat.id in H2 by lia.
   rewrite H1; auto; lia.
 Qed.
 
@@ -303,31 +299,49 @@ Lemma array_pred_ext_derives: forall {A B} (dA: Inhabitant A) (dB: Inhabitant B)
          lo hi P0 P1 (v0: list A) (v1: list B) p,
   (Zlength v0 = hi - lo -> Zlength v1 = hi - lo) ->
   (forall i, lo <= i < hi ->
-    P0 i (Znth (i-lo) v0) p |-- P1 i (Znth (i-lo) v1) p) ->
-  array_pred  lo hi P0 v0 p |-- array_pred lo hi P1 v1 p.
+    P0 i (Znth (i-lo) v0) p ⊢ P1 i (Znth (i-lo) v1) p) ->
+  array_pred  lo hi P0 v0 p ⊢ array_pred lo hi P1 v1 p.
 Proof.
   intros.
   unfold array_pred.
   normalize.
-  rewrite prop_true_andp by lia.
+  rewrite -> prop_true_andp by lia.
   apply rangespec_ext_derives.
   intros.
   destruct (zlt hi lo).
-  + rewrite Z2Nat_neg  in H2 by lia.
+  + rewrite -> Z2Nat_neg  in H2 by lia.
     change (Z.of_nat 0) with 0 in H2. lia.
-  + rewrite Z2Nat.id in H2 by lia.
+  + rewrite -> Z2Nat.id in H2 by lia.
     apply H0. lia.
 Qed.
 
 Lemma array_pred_ext: forall {A B} (dA: Inhabitant A) (dB: Inhabitant B) lo hi P0 P1 
         (v0: list A) (v1: list B) p,
   Zlength v0 = Zlength v1 ->
+  (forall i, lo <= i < hi ->
+    P0 i (Znth (i-lo) v0) p ⊣⊢ P1 i (Znth (i-lo) v1) p) ->
+  array_pred lo hi P0 v0 p ⊣⊢ array_pred lo hi P1 v1 p.
+Proof.
+  intros; iSplit; iApply array_pred_ext_derives; try rewrite H //; intros; rewrite H0 //.
+Qed.
+
+Lemma array_pred_eq: forall {A B} (dA: Inhabitant A) (dB: Inhabitant B) lo hi P0 P1 
+        (v0: list A) (v1: list B) p,
+  Zlength v0 = Zlength v1 ->
   (forall i, lo <= i < hi ->
     P0 i (Znth (i-lo) v0) p = P1 i (Znth (i-lo) v1) p) ->
   array_pred lo hi P0 v0 p = array_pred lo hi P1 v1 p.
 Proof.
-  intros; apply pred_ext; apply array_pred_ext_derives; intros; try lia;
-  rewrite H0; auto.
+  intros.
+  unfold array_pred.
+  rewrite H; f_equal.
+  apply rangespec_ext.
+  intros.
+  destruct (zlt hi lo).
+  + rewrite -> Z2Nat_neg  in H1 by lia.
+    change (Z.of_nat 0) with 0 in H1. lia.
+  + rewrite -> Z2Nat.id in H1 by lia.
+    apply H0. lia.
 Qed.
 
 Lemma at_offset_array_pred: forall  {A} {d: Inhabitant A} lo hi P (v: list A) ofs p,
@@ -345,12 +359,12 @@ Proof.
 Qed.
 
 Lemma array_pred_sepcon: forall  {A} {d: Inhabitant A} lo hi P Q (v: list A) p,
-  array_pred lo hi P v p * array_pred lo hi Q v p = array_pred lo hi (P * Q) v p.
+  (array_pred lo hi P v p ∗ array_pred lo hi Q v p) = array_pred lo hi (fun i a v => P i a v ∗ Q i a v) v p.
 Proof.
   intros.
   unfold array_pred.
   normalize.
-  apply andp_prop_ext; [lia | intros].
+  f_equal; first by f_equal; apply prop_ext; lia.
   rewrite rangespec_sepcon.
   auto.
 Qed.
@@ -370,8 +384,8 @@ Qed.
 Lemma struct_pred_ext_derives: forall m {A0 A1} (P0: forall it, A0 it -> val -> mpred) (P1: forall it, A1 it -> val -> mpred) v0 v1 p,
   members_no_replicate m = true ->
   (forall i d0 d1, in_members i m ->
-     P0 _ (proj_struct i m v0 d0) p |-- P1 _ (proj_struct i m v1 d1) p) ->
-  struct_pred m P0 v0 p |-- struct_pred m P1 v1 p.
+     P0 _ (proj_struct i m v0 d0) p ⊢ P1 _ (proj_struct i m v1 d1) p) ->
+  struct_pred m P0 v0 p ⊢ struct_pred m P1 v1 p.
 Proof.
   unfold proj_struct, field_type.
   intros.
@@ -387,10 +401,10 @@ Proof.
     simpl.
     exact H0.
   + change (struct_pred (a0:: a1 :: m) P0 v0 p) with
-      (P0 a0 (fst v0) p * struct_pred (a1 :: m) P0 (snd v0) p).
+      (P0 a0 (fst v0) p ∗ struct_pred (a1 :: m) P0 (snd v0) p).
     change (struct_pred (a0 :: a1 :: m) P1 v1 p) with
-      (P1 a0 (fst v1) p * struct_pred (a1 :: m) P1 (snd v1) p).
-    apply sepcon_derives.
+      (P1 a0 (fst v1) p ∗ struct_pred (a1 :: m) P1 (snd v1) p).
+    apply bi.sep_mono.
     - specialize (H0 (name_member a0)).
       simpl in H0.
       if_tac in H0; [| congruence].
@@ -421,12 +435,12 @@ Qed.
 Lemma struct_pred_ext: forall m {A0 A1} (P0: forall it, A0 it -> val -> mpred) (P1: forall it, A1 it -> val -> mpred) v0 v1 p,
   members_no_replicate m = true ->
   (forall i d0 d1, in_members i m ->
-     P0 _ (proj_struct i m v0 d0) p = P1 _ (proj_struct i m v1 d1) p) ->
-  struct_pred m P0 v0 p = struct_pred m P1 v1 p.
+     P0 _ (proj_struct i m v0 d0) p ⊣⊢ P1 _ (proj_struct i m v1 d1) p) ->
+  struct_pred m P0 v0 p ⊣⊢ struct_pred m P1 v1 p.
 Proof.
   intros.
-  apply pred_ext; eapply struct_pred_ext_derives; eauto;
-  intros; erewrite H0 by eauto; auto;      apply derives_refl.
+  iSplit; iApply struct_pred_ext_derives; eauto;
+    intros; erewrite H0 by eauto; auto.
 Qed.
 
 Lemma struct_pred_not_member: forall m {A} (P: forall it, A it -> val -> mpred) (i: ident) v p,
@@ -446,9 +460,9 @@ Proof.
     intros v.
     subst M.
     change (struct_pred (a0:: a1 :: m) P v p)
-      with (P _ (fst v) p * struct_pred (a1 :: m) P (snd v) p).
+      with (P _ (fst v) p ∗ struct_pred (a1 :: m) P (snd v) p).
     change (struct_pred (a0 :: a1 :: m) P' v p)
-      with (P' _ (fst v) p * struct_pred (a1 :: m) P' (snd v) p).
+      with (P' _ (fst v) p ∗ struct_pred (a1 :: m) P' (snd v) p).
     destruct (ident_eq i (name_member a0)).
     - subst P'; intros; subst.
       exfalso; apply H.
@@ -456,7 +470,7 @@ Proof.
     - intros.
       f_equal.
       * unfold P'.
-        rewrite if_false by auto.
+        rewrite -> if_false by auto.
         auto.
       * apply IHm.
         intro; apply H; right; auto.
@@ -466,7 +480,7 @@ Lemma struct_pred_proj: forall m {A} (P: forall it, A it -> val -> mpred) (i: id
   let P' it := if ident_eq i (name_member it) then fun _ _ => emp else P it in
   members_no_replicate m = true ->
   in_members i m ->
-  struct_pred m P v p = P _ (proj_struct i m v d) p * struct_pred m P' v p.
+  struct_pred m P v p = (P _ (proj_struct i m v d) p ∗ struct_pred m P' v p).
 Proof.
   intros.
   destruct m as [| a0 m]; [inv H0 |].
@@ -477,34 +491,34 @@ Proof.
     destruct (ident_eq _ _); [| congruence].
     destruct (member_dec a0 a0); [| congruence].
     unfold eq_rect_r; rewrite <- eq_rect_eq.
-    rewrite sepcon_emp; auto.
+    rewrite sep_emp; auto.
   + pose proof H.
     apply members_no_replicate_ind in H1; destruct H1.
     set (M := a1 :: m).
     simpl compact_prod in v |- *; simpl Ctypes.field_type in d |- *.
     subst M.
     change (struct_pred (a0 :: a1 :: m) P v p)
-      with (P _ (fst v) p * struct_pred (a1 :: m) P (snd v) p).
+      with (P _ (fst v) p ∗ struct_pred (a1 :: m) P (snd v) p).
     change (struct_pred (a0 :: a1 :: m) P' v p)
-      with (P' _ (fst v) p * struct_pred (a1 :: m) P' (snd v) p).
+      with (P' _ (fst v) p ∗ struct_pred (a1 :: m) P' (snd v) p).
     unfold get_member in d|-*; fold (get_member i (a1::m)) in d|-*.
      destruct (ident_eq i (name_member a0)).
     - f_equal.
       * simpl.
-         destruct (member_dec _ _) ; [ | congruence].
+        destruct (member_dec _ _) ; [ | congruence].
         unfold eq_rect_r; rewrite <- eq_rect_eq.
-        auto.
+        reflexivity.
       * erewrite struct_pred_not_member by eauto.
         unfold P' at 1.
-        rewrite if_true by auto.
-        rewrite emp_sepcon.
+        rewrite -> if_true by auto.
+        rewrite emp_sep.
         subst i. auto.
     - intros.
       destruct H0; [simpl in H0; congruence |].
-      rewrite <- sepcon_assoc, (sepcon_comm _ (P' _ _ _)), sepcon_assoc.
+      rewrite sep_assoc (sep_comm _ (P' _ _ _)) -sep_assoc.
       f_equal.
       * unfold P'.
-        rewrite if_false by (simpl; congruence).
+        rewrite -> if_false by (simpl; congruence).
         auto.
       * erewrite IHm by eauto.
         f_equal.
@@ -520,7 +534,7 @@ Lemma struct_pred_upd: forall m {A} (P: forall it, A it -> val -> mpred) (i: ide
   let P' it := if ident_eq i (name_member it) then fun _ _ => emp else P it in
   members_no_replicate m = true ->
   in_members i m ->
-  struct_pred m P (upd_struct i m v v0) p = P _ v0 p * struct_pred m P' v p.
+  struct_pred m P (upd_struct i m v v0) p = (P _ v0 p ∗ struct_pred m P' v p).
 Proof.
   intros.
   destruct m as [| a0 m]; [inv H0 |].
@@ -531,15 +545,15 @@ Proof.
     destruct (ident_eq _ _); [| congruence].
     destruct (member_dec a0 a0); [| congruence].
     unfold eq_rect_r; rewrite <- eq_rect_eq.
-    rewrite sepcon_emp; auto.
+    rewrite sep_emp; auto.
   + pose proof H.
     apply members_no_replicate_ind in H1; destruct H1.
     simpl compact_prod in v |- *; simpl Ctypes.field_type in v0 |- *.
     set (v' := (upd_struct i (a0 :: a1 :: m) v v0)).
     change (struct_pred (a0 :: a1 :: m) P v' p)
-      with (P _ (fst v') p * struct_pred (a1 :: m) P (snd v') p).
+      with (P _ (fst v') p ∗ struct_pred (a1 :: m) P (snd v') p).
     change (struct_pred (a0 :: a1 :: m) P' v p)
-      with (P' _ (fst v) p * struct_pred (a1 :: m) P' (snd v) p).
+      with (P' _ (fst v) p ∗ struct_pred (a1 :: m) P' (snd v) p).
     subst v'.
     unfold upd_struct.
     change (get_member i (a0::a1::m)) with
@@ -556,20 +570,20 @@ Proof.
       * simpl.
         unfold eq_rect_r; rewrite <- eq_rect_eq.
         change (snd (v0, snd v)) with (snd v).
-        change (struct_pred (a1 :: m) P (snd v) p = P' a0 (fst v) p * struct_pred (a1 :: m) P' (snd v) p).
+        change (struct_pred (a1 :: m) P (snd v) p = (P' a0 (fst v) p ∗ struct_pred (a1 :: m) P' (snd v) p)).
         erewrite struct_pred_not_member by eauto.
         unfold P' at 1.
-        rewrite if_true by auto.
-        rewrite emp_sepcon; auto.
+        rewrite -> if_true by auto.
+        rewrite emp_sep; auto.
     - destruct H0; [simpl in H0; congruence |].
-      rewrite <- sepcon_assoc, (sepcon_comm _ (P' _ _ _)), sepcon_assoc.
-      simpl. 
+      rewrite sep_assoc (sep_comm _ (P' _ _ _)) -sep_assoc.
+      simpl.
       destruct (member_dec _ _).
       change (get_member i (a1::m) = a0) in e.
       exfalso; clear - e H0 H1. subst. apply H1. rewrite name_member_get. auto.
       f_equal.
       * unfold P'; simpl.
-        rewrite if_false by (simpl; congruence).
+        rewrite -> if_false by (simpl; congruence).
         auto.
       * simpl snd.
         simpl in IHm |- *; erewrite IHm by auto.
@@ -579,19 +593,16 @@ Qed.
 Lemma struct_pred_ramif: forall m {A} (P: forall it, A it -> val -> mpred) (i: ident) v p d,
   in_members i m ->
   members_no_replicate m = true ->
-  struct_pred m P v p |--
-    P _ (proj_struct i m v d) p *
-     (ALL v0: _, P _ v0 p -* struct_pred m P (upd_struct i m v v0) p).
+  struct_pred m P v p ⊢
+    P _ (proj_struct i m v d) p ∗
+     (∀ v0: _, P _ v0 p -∗ struct_pred m P (upd_struct i m v v0) p).
 Proof.
   intros.
   set (P' it := if ident_eq i (name_member it) then fun _ _ => emp else P it).
-  apply RAMIF_Q.solve with (struct_pred m P' v p).
-  + apply derives_refl'.
-    apply struct_pred_proj; auto.
-  + intro v0.
-    apply derives_refl'.
-    symmetry; rewrite sepcon_comm.
-    apply struct_pred_upd; auto.
+  erewrite struct_pred_proj by done.
+  iIntros "($ & ?)" (?) "?".
+  rewrite struct_pred_upd //.
+  iFrame.
 Qed.
 
 Lemma at_offset_struct_pred: forall m {A} (P: forall it, A it -> val -> mpred) v p ofs,
@@ -602,19 +613,16 @@ Proof.
   destruct m as [| a0 m]; [auto |].
   revert a0 v; induction m as [| a1 m]; intros.
   + simpl.
-    rewrite at_offset_eq.
-    auto.
+    rewrite at_offset_eq //.
   + simpl.
-    rewrite at_offset_eq.
-    f_equal.
+    rewrite at_offset_eq //.
 Qed.
 
-Lemma corable_andp_struct_pred: forall m {A} (P: forall it, A it -> val -> mpred) v p Q,
-  corable Q ->
-  Q && struct_pred m P v p =
+Lemma corable_andp_struct_pred: forall m {A} (P: forall it, A it -> val -> mpred) v p Q {_ : Persistent Q} {_ : Absorbing Q},
+  Q ∧ struct_pred m P v p ⊣⊢
   match m with
-  | nil => Q && emp
-  | _ => struct_pred m (fun it v p => Q && P it v p) v p
+  | nil => Q ∧ emp
+  | _ => struct_pred m (fun it v p => Q ∧ P it v p) v p
   end.
 Proof.
   intros.
@@ -623,33 +631,32 @@ Proof.
   + simpl.
     auto.
   + change (struct_pred (a0::a1::m) P v p)
-      with (P a0 (fst v) p * struct_pred (a1 :: m) P (snd v) p).
-    pattern Q at 1; rewrite <- (andp_dup Q).
-    rewrite andp_assoc.
-    rewrite <- corable_sepcon_andp1 by auto.
-    rewrite IHm.
-    rewrite <- corable_andp_sepcon1 by auto.
-    reflexivity.
+      with (P a0 (fst v) p ∗ struct_pred (a1 :: m) P (snd v) p).
+    iSplit.
+    * iIntros "(#? & P & ?)".
+      iSplitL "P"; first by iSplit.
+      setoid_rewrite <- IHm; by iSplit.
+    * iIntros "((? & $) & ?)".
+      setoid_rewrite <- IHm; auto.
 Qed.
 
 Lemma struct_pred_sepcon: forall m {A} (P Q: forall it, A it -> val -> mpred) v p,
-  struct_pred m P v p * struct_pred m Q v p = struct_pred m (fun it => P it * Q it) v p.
+  (struct_pred m P v p ∗ struct_pred m Q v p) = struct_pred m (fun it a v => P it a v ∗ Q it a v) v p.
 Proof.
   intros.
   destruct m as [| a0 m]; [| revert a0 v; induction m as [| a1 m]; intros].
   + simpl.
-    rewrite emp_sepcon; auto.
+    rewrite emp_sep; auto.
   + simpl.
     auto.
   + change (struct_pred (a0 :: a1 :: m) P v p)
-      with (P a0 (fst v) p * struct_pred (a1 :: m) P (snd v) p).
+      with (P a0 (fst v) p ∗ struct_pred (a1 :: m) P (snd v) p).
     change (struct_pred (a0 :: a1 :: m) Q v p)
-      with (Q a0 (fst v) p * struct_pred (a1 :: m) Q (snd v) p).
-    change (struct_pred (a0 :: a1 :: m) (fun it => P it * Q it) v p)
-      with (P a0 (fst v) p * Q a0 (fst v) p * struct_pred (a1 :: m) (fun it => P it * Q it) (snd v) p).
-    rewrite !sepcon_assoc; f_equal.
-    rewrite <- sepcon_assoc, (sepcon_comm _ (Q _ _ _)), sepcon_assoc; f_equal.
-    apply IHm.
+      with (Q a0 (fst v) p ∗ struct_pred (a1 :: m) Q (snd v) p).
+    change (struct_pred (a0 :: a1 :: m) (fun it a v => P it a v ∗ Q it a v) v p)
+      with ((P a0 (fst v) p ∗ Q a0 (fst v) p) ∗ struct_pred (a1 :: m) (fun it a v => P it a v ∗ Q it a v) (snd v) p).
+    rewrite -!sep_assoc; f_equiv.
+    rewrite sep_assoc (sep_comm _ (Q _ _ _)) -sep_assoc; f_equal; first done.
 Qed.
 
 Lemma compact_sum_inj_eq_spec: forall {A} a0 a1 (l: list A) F0 F1 (v0: compact_sum (map F0 (a0 :: a1 :: l))) (v1: compact_sum (map F1 (a0 :: a1 :: l))) H,
@@ -664,8 +671,7 @@ Proof.
   intros.
   rename H0 into H_not_in.
   destruct v0, v1.
-  + simpl.
-    firstorder.
+  + done.
   + assert (~ (forall a : A,
       iff
         (@compact_sum_inj A F0 (@cons A a0 (@cons A a1 l))
@@ -708,8 +714,8 @@ Lemma union_pred_ext_derives: forall m {A0 A1} (P0: forall it, A0 it -> val -> m
   members_no_replicate m = true ->
   (forall it, members_union_inj v0 it <-> members_union_inj v1 it) ->
   (forall i (Hin: in_members i m) d0 d1, members_union_inj v0 (get_member i m) -> members_union_inj v1 (get_member i m) ->
-     P0 _ (proj_union i m v0 d0) p |-- P1 _ (proj_union i m v1 d1) p) ->
-  union_pred m P0 v0 p |-- union_pred m P1 v1 p.
+     P0 _ (proj_union i m v0 d0) p ⊢ P1 _ (proj_union i m v1 d1) p) ->
+  union_pred m P0 v0 p ⊢ union_pred m P1 v1 p.
 Proof.
   unfold members_union_inj, proj_union, field_type.
   intros.
@@ -770,21 +776,21 @@ Lemma union_pred_ext: forall m {A0 A1} (P0: forall it, A0 it -> val -> mpred) (P
   members_no_replicate m = true ->
   (forall it, members_union_inj v0 it <-> members_union_inj v1 it) ->
   (forall i (Hin: in_members i m) d0 d1, members_union_inj v0 (get_member i m) -> members_union_inj v1 (get_member i m) ->
-     P0 _ (proj_union i m v0 d0) p = P1 _ (proj_union i m v1 d1) p) ->
-  union_pred m P0 v0 p = union_pred m P1 v1 p.
+     P0 _ (proj_union i m v0 d0) p ⊣⊢ P1 _ (proj_union i m v1 d1) p) ->
+  union_pred m P0 v0 p ⊣⊢ union_pred m P1 v1 p.
 Proof.
   intros.
   assert (forall it, members_union_inj v1 it <-> members_union_inj v0 it)
     by (intro it; specialize (H0 it); tauto).
-  apply pred_ext; eapply union_pred_ext_derives; auto;
+  iSplit; iApply union_pred_ext_derives; auto;
   intros; erewrite H1 by eauto; apply derives_refl.
 Qed.
 
 Lemma union_pred_derives_const: forall m {A} (P: forall it, A it -> val -> mpred) p v R,
   members_no_replicate m = true ->
   m <> nil ->
-  (forall i (v: A (get_member i m)), in_members i m -> P _ v p |-- R) ->
-  union_pred m P v p |-- R.
+  (forall i (v: A (get_member i m)), in_members i m -> P _ v p ⊢ R) ->
+  union_pred m P v p ⊢ R.
 Proof.
   intros.
   destruct m as [| a0 m]; [congruence |].
@@ -814,8 +820,8 @@ Qed.
 Lemma union_pred_proj: forall m {A} (P: forall it, A it -> val -> mpred) (i: ident) v p d,
   members_no_replicate m = true ->
   in_members i m ->
-  (forall i' (v': A (get_member i' m)), in_members i' m -> P _ v' p |-- P _ d p) ->
-  union_pred m P v p |-- P _ (proj_union i m v d) p.
+  (forall i' (v': A (get_member i' m)), in_members i' m -> P _ v' p ⊢ P _ d p) ->
+  union_pred m P v p ⊢ P _ (proj_union i m v d) p.
 Proof.
   intros.
   destruct m as [| a0 m]; [inv H0 |].
@@ -847,12 +853,12 @@ Proof.
     - change (if ident_eq i (name_member a1) then a1 else get_member i m) with (get_member i (a1::m)) in *.
        destruct (member_dec _ _).
        exfalso; clear - n e. subst.
-       rewrite name_member_get in *. congruence.
+       rewrite -> name_member_get in *. congruence.
        destruct v.
        unfold union_pred. unfold list_rect.
        specialize (H1 (name_member a0)). 
         simpl get_member in H1.
-       rewrite if_true in H1 by auto. apply H1. left. auto.
+       rewrite -> if_true in H1 by auto. apply H1. left. auto.
       apply IHm; auto. destruct H0; auto.  congruence.
        intros.
         specialize (H1 i').
@@ -903,22 +909,17 @@ Proof.
 Qed.
 
 Lemma union_pred_ramif: forall m {A} (P: forall it, A it -> val -> mpred) (i: ident) v p d,
-  (forall i' (v': A (get_member i' m)), in_members i' m -> P _ v' p |-- P _ d p) ->
+  (forall i' (v': A (get_member i' m)), in_members i' m -> P _ v' p ⊢ P _ d p) ->
   in_members i m ->
   members_no_replicate m = true ->
-  union_pred m P v p |--
-    P _ (proj_union i m v d) p *
-     (ALL v0: _, P _ v0 p -* union_pred m P (upd_union i m v v0) p).
+  union_pred m P v p ⊢
+    P _ (proj_union i m v d) p ∗
+     (∀ v0: _, P _ v0 p -∗ union_pred m P (upd_union i m v v0) p).
 Proof.
   intros.
-  apply RAMIF_Q.solve with emp.
-  + rewrite sepcon_emp.
-    apply union_pred_proj; auto.
-  + intro v0.
-    rewrite emp_sepcon.
-    apply derives_refl'.
-    symmetry.
-    apply union_pred_upd; auto.
+  rewrite union_pred_proj //.
+  iIntros "$" (?) "?".
+  rewrite union_pred_upd //.
 Qed.
 
 Lemma at_offset_union_pred: forall m {A} (P: forall it, A it -> val -> mpred) v p ofs,
@@ -939,10 +940,10 @@ Proof.
 Qed.
 
 Lemma andp_union_pred: forall m {A} (P: forall it, A it -> val -> mpred) v p Q,
-  Q && union_pred m P v p =
+  (Q ∧ union_pred m P v p) =
   match m with
-  | nil => Q && emp
-  | _ => union_pred m (fun it v p => Q && P it v p) v p
+  | nil => Q ∧ emp
+  | _ => union_pred m (fun it v p => Q ∧ P it v p) v p
   end.
 Proof.
   intros.
@@ -958,12 +959,12 @@ Proof.
 Qed.
 
 Lemma union_pred_sepcon: forall m {A} (P Q: forall it, A it -> val -> mpred) v p,
-  union_pred m P v p * union_pred m Q v p = union_pred m (fun it => P it * Q it) v p.
+  (union_pred m P v p ∗ union_pred m Q v p) = union_pred m (fun it v p => P it v p ∗ Q it v p) v p.
 Proof.
   intros.
   destruct m as [| a0 m]; [| revert a0 v; induction m as [| a1 m]; intros].
   + simpl.
-    rewrite sepcon_emp; auto.
+    rewrite sep_emp //.
   + simpl.
     auto.
   + destruct v.
@@ -982,7 +983,7 @@ Proof.
   + simpl.
     specialize (H0 (name_member a0)).
     simpl in H0.
-    rewrite if_true in H0 by auto.
+    rewrite -> if_true in H0 by auto.
     apply H0; left; auto.
   + change (struct_Prop (a0 :: a1 :: m) P
              (compact_prod_gen f (a0 :: a1 :: m)))
@@ -991,7 +992,7 @@ Proof.
     split.
     - specialize (H0 (name_member a0)).
       simpl in H0.
-      rewrite if_true in H0 by auto.
+      rewrite -> if_true in H0 by auto.
       apply H0; left; auto.
     - rewrite members_no_replicate_ind in H; destruct H.
       apply (IHm a1); auto.
@@ -1045,12 +1046,12 @@ Proof.
   + simpl.
     specialize (H0 (name_member a0)).
     simpl in H0.
-    rewrite if_true in H0 by auto.
+    rewrite -> if_true in H0 by auto.
     apply H0; left; auto.
   + simpl.
     specialize (H0 (name_member a0)).
     simpl in H0.
-    rewrite if_true in H0 by auto.
+    rewrite -> if_true in H0 by auto.
     apply H0; left; auto.
 Qed.
 
@@ -1096,17 +1097,16 @@ Proof.
 Qed.
 
 Lemma array_pred_local_facts: forall {A}{d: Inhabitant A} lo hi P (v: list A) p Q,
-  (forall i x, lo <= i < hi -> P i x p |-- !! Q x) ->
-  array_pred lo hi P v p |-- !! (Zlength v = hi - lo /\ Forall Q v).
+  (forall i x, lo <= i < hi -> P i x p ⊢ ⌜Q x⌝) ->
+  array_pred lo hi P v p ⊢ ⌜Zlength v = hi - lo /\ Forall Q v⌝.
 Proof.
   intros.
   unfold array_pred.
-  normalize.
-  rewrite prop_and; apply andp_right; [normalize |].
+  iIntros "(% & H)"; iSplit; first done.
   pose proof ZtoNat_Zlength v.
   rewrite H0 in H1; symmetry in H1; clear H0.
-  revert hi lo H H1; induction v; intros.
-  + apply prop_right; constructor.
+  iInduction v as [|] "IH" forall (hi lo H H1); intros.
+  + done.
   + replace (hi - lo) with (Z.succ (hi - Z.succ lo)) in * by lia.
     assert (hi - Z.succ lo >= 0).
     {
@@ -1114,48 +1114,43 @@ Proof.
       assert (Z.succ (hi - Z.succ lo) <= 0) by lia.
       simpl length in H1.
       destruct (zeq (Z.succ (hi - Z.succ lo)) 0);
-       [rewrite e in H1 | rewrite Z2Nat_neg in H1 by lia]; inv H1.
+       [rewrite e in H1 | rewrite -> Z2Nat_neg in H1 by lia]; inv H1.
     }
-    rewrite Z2Nat.inj_succ in H1 |- * by lia.
+    rewrite  ->Z2Nat.inj_succ in H1 |- * by lia.
     inv H1.
     simpl rangespec.
-    replace (rangespec (Z.succ lo) (length v)
-              (fun i : Z => P i (Znth (i - lo) (a :: v))) p)
-    with (rangespec (Z.succ lo) (length v)
-            (fun i : Z => P i (Znth (i - Z.succ lo) v)) p).
+    erewrite rangespec_ext with (P' := fun i : Z => P i (Znth (i - Z.succ lo) v)).
     2:{
-      apply rangespec_ext; intros.
+      intros.
       change v with (skipn 1 (a :: v)) at 1.
-      rewrite <- Znth_succ by lia.
+      rewrite -> Znth_succ by lia.
       auto.
     }
-    rewrite H3.
-    eapply derives_trans; [apply sepcon_derives; [apply H | apply IHv; auto] |].
-    - lia.
+    iDestruct "H" as "(P & H)".
+    rewrite H3; iDestruct ("IH" with "[%] [%] H") as %?; try done.
     - intros; apply H; lia.
-    - rewrite sepcon_prop_prop.
-      apply prop_derives; intros.
-      rewrite Z.sub_diag in H1; cbv in H1.
-      constructor; tauto.
+    - rewrite H; last lia.
+      iDestruct "P" as %Ha; iPureIntro; constructor; auto.
+      rewrite Z.sub_diag // in Ha.
 Qed.
 
 Lemma struct_pred_local_facts: forall m {A} (P: forall it, A it -> val -> mpred)v p (R: forall it, A it -> Prop),
   members_no_replicate m = true ->
-  (forall i v0, in_members i m -> P (get_member i m) v0 p |-- !! R _ v0) ->
-  struct_pred m P v p |-- !! struct_Prop m R v.
+  (forall i v0, in_members i m -> P (get_member i m) v0 p ⊢ ⌜R _ v0⌝) ->
+  struct_pred m P v p ⊢ ⌜struct_Prop m R v⌝.
 Proof.
   intros.
-  destruct m as [| a0 m]; [simpl; apply prop_right; auto |].
+  destruct m as [| a0 m]; [by iIntros "_" |].
   revert a0 v H H0; induction m as [| a1 m]; intros.
   + simpl.
     specialize (H0 (name_member a0)).
     simpl in H0.
-    rewrite if_true in H0 by auto.
+    rewrite -> if_true in H0 by auto.
     apply H0; left; auto.
   + change (struct_Prop (a0 :: a1 :: m) R v)
       with (R a0 (fst v) /\ struct_Prop (a1 :: m) R (snd v)).
     change (struct_pred (a0 :: a1 :: m) P v p)
-      with (P a0 (fst v) p * struct_pred (a1 :: m) P (snd v) p).
+      with (P a0 (fst v) p ∗ struct_pred (a1 :: m) P (snd v) p).
     rewrite members_no_replicate_ind in H.
 
     pose proof H0 (name_member a0).
@@ -1166,27 +1161,27 @@ Proof.
 
     specialize (IHm a1 (snd v)).
     spec IHm; [tauto |].
-    eapply derives_trans; [apply sepcon_derives; [apply H1 | apply IHm] |].
+    rewrite H1 IHm.
+    - iIntros "(% & %)"; iPureIntro; constructor; auto.
     - intros.
       specialize (H0 i).
       simpl in H0.
       destruct (ident_eq i (name_member a0)); [subst; tauto |].
       apply H0; right; auto.
-    - rewrite sepcon_prop_prop; normalize.
 Qed.
 
 Lemma union_pred_local_facts: forall m {A} (P: forall it, A it -> val -> mpred)v p (R: forall it, A it -> Prop),
   members_no_replicate m = true ->
-  (forall i v0, in_members i m -> P (get_member i m) v0 p |-- !! R _ v0) ->
-  union_pred m P v p |-- !! union_Prop m R v.
+  (forall i v0, in_members i m -> P (get_member i m) v0 p ⊢ ⌜R _ v0⌝) ->
+  union_pred m P v p ⊢ ⌜union_Prop m R v⌝.
 Proof.
   intros.
-  destruct m as [| a0 m]; [simpl; apply prop_right; auto |].
+  destruct m as [| a0 m]; [by iIntros "_" |].
   revert a0 v H H0; induction m as [| a1 m]; intros.
   + simpl.
     specialize (H0 (name_member a0)).
     simpl in H0.
-    rewrite if_true in H0 by auto.
+    rewrite -> if_true in H0 by auto.
     apply H0; left; auto.
   + rewrite members_no_replicate_ind in H.
     destruct v.
@@ -1216,19 +1211,18 @@ Lemma memory_block_array_pred: forall  {A}{d: Inhabitant A} sh t lo hi (v: list
   Zlength v = hi - lo ->
   array_pred lo hi
     (fun i _ p => memory_block sh (sizeof t) (offset_val (sizeof t * i) p)) v
-    (Vptr b (Ptrofs.repr ofs)) =
+    (Vptr b (Ptrofs.repr ofs)) ⊣⊢
    memory_block sh (sizeof t * (hi - lo)) (Vptr b (Ptrofs.repr (ofs + sizeof t * lo))).
 Proof.
   intros.
   unfold array_pred.
-  rewrite prop_true_andp by auto; clear H1.
+  rewrite -> prop_true_andp by auto; clear H1.
   f_equal.
   remember (Z.to_nat (hi - lo)) as n eqn:HH.
   revert lo HH H H0 v; induction n; intros.
   + simpl.
     pose proof arith_aux00 _ _ (proj2 H0) HH.
-    rewrite H1, Z.mul_0_r, memory_block_zero_Vptr.
-    reflexivity.
+    rewrite H1 Z.mul_0_r memory_block_zero_Vptr //.
   + simpl.
     pose proof arith_aux01 _ _ _ HH.
     solve_mod_modulus.
@@ -1236,8 +1230,7 @@ Proof.
     rewrite IHn; [| apply arith_aux02; auto | lia | lia | exact v].
     replace (ofs + sizeof  t * Z.succ lo) with (ofs + sizeof t * lo + sizeof t) by lia.
     rewrite <- memory_block_split by (auto; lia).
-    f_equal.
-    lia.
+    f_equiv; hnf; lia.
 Qed.
 
 Lemma mapsto_zeros_zero_Vptr
@@ -1246,7 +1239,7 @@ Lemma mapsto_zeros_zero_Vptr
 Proof.
 intros.
 unfold mapsto_zeros. simpl.
-rewrite prop_true_andp. reflexivity.
+rewrite prop_true_andp //.
 rep_lia.
 Qed.
 
@@ -1255,16 +1248,16 @@ Lemma mapsto_zeros_split
        0 <= n ->
        0 <= m ->
        n + m <= n + m + ofs < Ptrofs.modulus ->
-       mapsto_zeros (n + m) sh (Vptr b (Ptrofs.repr ofs)) =
-       mapsto_zeros n sh (Vptr b (Ptrofs.repr ofs)) *
+       mapsto_zeros (n + m) sh (Vptr b (Ptrofs.repr ofs)) ⊣⊢
+       mapsto_zeros n sh (Vptr b (Ptrofs.repr ofs)) ∗
        mapsto_zeros m sh (Vptr b (Ptrofs.repr (ofs + n))).
 Proof.
 intros.
 unfold mapsto_zeros.
-rewrite !Ptrofs.unsigned_repr by rep_lia.
-rewrite !prop_true_andp by rep_lia.
+rewrite -> !Ptrofs.unsigned_repr by rep_lia.
+rewrite -> !prop_true_andp by rep_lia.
 rewrite !mapsto_memory_block.address_mapsto_zeros_eq.
-rewrite !Z2Nat.id by lia.
+rewrite -> !Z2Nat.id by lia.
 apply mapsto_memory_block.address_mapsto_zeros'_split; lia.
 Qed.
 
@@ -1272,7 +1265,7 @@ Lemma mapsto_zeros_array_pred: forall  {A}{d: Inhabitant A} sh t lo hi (v: list
   0 <= ofs + sizeof t * lo /\ ofs + sizeof t * hi < Ptrofs.modulus ->
   0 <= lo <= hi ->
   Zlength v = hi - lo ->
-   mapsto_zeros (sizeof t * (hi - lo)) sh (Vptr b (Ptrofs.repr (ofs + sizeof t * lo))) |--
+   mapsto_zeros (sizeof t * (hi - lo)) sh (Vptr b (Ptrofs.repr (ofs + sizeof t * lo))) ⊢
   array_pred lo hi
     (fun i _ p => mapsto_zeros (sizeof t) sh (offset_val (sizeof t * i) p)) v
     (Vptr b (Ptrofs.repr ofs)).
@@ -1280,24 +1273,21 @@ Proof.
   intros.
   unfold array_pred.
 Opaque mapsto_zeros.
-  rewrite prop_true_andp by auto; clear H1.
+  rewrite -> prop_true_andp by auto; clear H1.
   f_equal.
   remember (Z.to_nat (hi - lo)) as n eqn:HH.
   revert lo HH H H0 v; induction n; intros.
   +  simpl. 
     pose proof arith_aux00 _ _ (proj2 H0) HH.
-    rewrite H1, Z.mul_0_r, mapsto_zeros_zero_Vptr.
-    auto.
+    rewrite H1 Z.mul_0_r mapsto_zeros_zero_Vptr //.
   + simpl.
     pose proof arith_aux01 _ _ _ HH.
     solve_mod_modulus.
     pose_size_mult cs t (0 :: hi - Z.succ lo :: hi - lo :: nil).
-    eapply derives_trans; [ | apply sepcon_derives; [apply derives_refl | apply IHn; try lia; try exact v]].
+    rewrite -IHn //; [| lia..].
     replace (ofs + sizeof  t * Z.succ lo) with (ofs + sizeof t * lo + sizeof t) by lia.
     rewrite <- mapsto_zeros_split by (auto; lia).
-    apply derives_refl'.
-    f_equal.
-    lia.
+    apply bi.equiv_entails_1_1; f_equiv; hnf; lia.
 Transparent mapsto_zeros.
 Qed.
 
@@ -1308,21 +1298,21 @@ Lemma memory_block_array_pred': forall {A}{d: Inhabitant A} (a: A) sh t z b ofs,
      (fun i _ p =>
       memory_block sh (sizeof t) (offset_val (sizeof t * i) p))
              (Zrepeat a z)
-     (Vptr b (Ptrofs.repr ofs))  =
+     (Vptr b (Ptrofs.repr ofs)) ⊣⊢
   memory_block sh (sizeof t * z) (Vptr b (Ptrofs.repr ofs)).
 Proof.
   intros.
-  rewrite memory_block_array_pred.
-  f_equal. f_equal. lia. f_equal. f_equal. rewrite Z.mul_0_r. lia.
-  rewrite Z.mul_0_r. split; lia. lia.
-  rewrite Z.sub_0_r. auto. rewrite Zlength_Zrepeat by lia.
+  rewrite memory_block_array_pred //.
+  f_equiv; hnf; first lia. do 2 f_equal; lia.
   lia.
+  rewrite Z.sub_0_r. rewrite -> Zlength_Zrepeat by lia.
+  done.
 Qed.
 
 Lemma mapsto_zeros_array_pred': forall {A}{d: Inhabitant A} (a: A) sh t z b ofs,
   0 <= z ->
   0 <= ofs /\ ofs + sizeof t * z < Ptrofs.modulus ->
-  mapsto_zeros (sizeof t * z) sh (Vptr b (Ptrofs.repr ofs)) |--
+  mapsto_zeros (sizeof t * z) sh (Vptr b (Ptrofs.repr ofs)) ⊢
   array_pred 0 z
      (fun i _ p =>
       mapsto_zeros (sizeof t) sh(offset_val (sizeof t * i) p))
@@ -1330,10 +1320,9 @@ Lemma mapsto_zeros_array_pred': forall {A}{d: Inhabitant A} (a: A) sh t z b ofs,
      (Vptr b (Ptrofs.repr ofs)).
 Proof.
   intros.
-  eapply derives_trans; [ | apply mapsto_zeros_array_pred; try lia].
-  apply derives_refl'.
-  f_equal. lia. f_equal. f_equal. lia.
-  rewrite Zlength_Zrepeat by lia.
+  rewrite -mapsto_zeros_array_pred //; [|try lia..].
+  apply bi.equiv_entails_1_1; f_equiv; hnf; first lia. do 2 f_equal; lia.
+  rewrite -> Zlength_Zrepeat by lia.
   lia.
 Qed.
 
@@ -1346,13 +1335,13 @@ Lemma memory_block_struct_pred: forall sh m sz {A} (v: compact_prod (map A m)) b
   struct_pred m
    (fun it _ p =>
      (memory_block sh (field_offset_next cenv_cs (name_member it) m sz - field_offset cenv_cs (name_member it) m))
-     (offset_val (field_offset cenv_cs (name_member it) m) p)) v (Vptr b (Ptrofs.repr ofs)) =
+     (offset_val (field_offset cenv_cs (name_member it) m) p)) v (Vptr b (Ptrofs.repr ofs)) ⊣⊢
   memory_block sh sz (Vptr b (Ptrofs.repr ofs)).
 Proof.
   unfold field_offset, Ctypes.field_offset, field_offset_next.
   intros sh m sz A v b ofs NIL_CASE PLAIN NO_REPLI; intros.
   destruct m as [| a0 m].
-  1: rewrite (NIL_CASE eq_refl), memory_block_zero; simpl; normalize.
+  1: rewrite (NIL_CASE eq_refl) memory_block_zero; simpl; normalize.
   pose (t0 := type_member a0).
   assert (align 0 (alignof t0) = 0) by apply align_0, alignof_pos.
   revert H0; pattern ofs at 1 4; replace ofs with (ofs + align 0 (alignof t0)) by lia; intros.
@@ -1368,9 +1357,9 @@ Proof.
     solve_mod_modulus.
     reflexivity.
   + match goal with
-    | |- struct_pred (Member_plain i0 t0 :: a1 :: m) ?P v ?p = _ =>
+    | |- struct_pred (Member_plain i0 t0 :: a1 :: m) ?P v ?p ⊣⊢ _ =>
            change (struct_pred (Member_plain i0 t0 :: a1 :: m) P v p) with
-             (P (Member_plain i0 t0) (fst v) p * struct_pred (a1 :: m) P (snd v) p);
+             (P (Member_plain i0 t0) (fst v) p ∗ struct_pred (a1 :: m) P (snd v) p);
            simpl (P (Member_plain i0 t0) (fst v) p)
     end.
     if_tac; [| congruence].
@@ -1382,8 +1371,7 @@ Proof.
     simpl snd.
     fold (sizeof t0) in *. fold (alignof t0) in *.
     erewrite struct_pred_ext.
-    -
-     rewrite IHm;
+    - erewrite IHm;
         [| simpl in H |- *; 
           fold (sizeof t0) in *; fold (alignof t0) in *;
           fold (sizeof t1) in *; fold (alignof t1) in *;
@@ -1393,31 +1381,30 @@ Proof.
         (ofs + align z (alignof t0) +
          (align (align z (alignof t0) + sizeof t0) (alignof t1) -
           align z (alignof t0))) by lia.
-      rewrite <- memory_block_split by
-        (simpl in H; 
+      simpl; fold (alignof t1).
+      rewrite <- memory_block_split by (simpl in H;
           fold (sizeof t0) in *; fold (alignof t0) in *;
-          fold (sizeof t1) in *; fold (alignof t1) in *;revert H; pose_align_le; pose_sizeof_pos; intros; lia).
-      f_equal; lia.
-    - 
-      auto.
+          fold (sizeof t1) in *; fold (alignof t1) in *; revert H; pose_align_le; pose_sizeof_pos; intros; unfold align in *; lia).
+      f_equiv; hnf. lia.
+    - auto.
     - intros.
       solve_mod_modulus.
       unfold fst.
       rewrite !name_member_get.
       assert (i <> name_member (Member_plain i0 t0)).
       simpl. clear - H2 NOT_IN.  contradict NOT_IN. subst i0. simpl. auto.
-      rewrite (neq_field_offset_rec_cons cenv_cs i (Member_plain i0 t0)) by auto.
-      rewrite (neq_field_offset_next_rec_cons cenv_cs i (Member_plain i0 t0)) by  auto.
+      rewrite -> (neq_field_offset_rec_cons cenv_cs i (Member_plain i0 t0)) by auto.
+      rewrite -> (neq_field_offset_next_rec_cons cenv_cs i (Member_plain i0 t0)) by  auto.
       reflexivity.
 Qed.
 
 Lemma mapsto_zeros_zero: forall (sh : share) (p : val), 
-   mapsto_zeros 0 sh p = !! isptr p && emp.
+   mapsto_zeros 0 sh p = (⌜isptr p⌝ ∧ emp).
 Proof.
 intros.
-unfold mapsto_zeros; simpl. destruct p; simpl; normalize.
-rewrite prop_true_andp by rep_lia.
-reflexivity.
+unfold mapsto_zeros; simpl. destruct p; simpl; rewrite ?log_normalize.False_and //.
+rewrite -> prop_true_andp by rep_lia.
+rewrite log_normalize.True_and //.
 Qed.
 
 Lemma mapsto_zeros_struct_pred: forall sh m sz {A} (v: compact_prod (map A m)) b ofs,
@@ -1426,7 +1413,7 @@ Lemma mapsto_zeros_struct_pred: forall sh m sz {A} (v: compact_prod (map A m)) b
   members_no_replicate m = true ->
   sizeof_struct cenv_cs 0 m <= sz < Ptrofs.modulus ->
   0 <= ofs /\ ofs + sz < Ptrofs.modulus ->
-  mapsto_zeros sz sh (Vptr b (Ptrofs.repr ofs)) |--
+  mapsto_zeros sz sh (Vptr b (Ptrofs.repr ofs)) ⊢
   struct_pred m
    (fun it _ p =>
      (mapsto_zeros (field_offset_next cenv_cs (name_member it) m sz - field_offset cenv_cs (name_member it) m)) sh
@@ -1436,7 +1423,7 @@ Proof.
   unfold field_offset, Ctypes.field_offset, field_offset_next.
   intros sh m sz A v b ofs NIL_CASE PLAIN NO_REPLI; intros.
   destruct m as [| a0 m].
-  1: rewrite (NIL_CASE eq_refl), mapsto_zeros_zero; simpl; normalize.
+  1: rewrite (NIL_CASE eq_refl) mapsto_zeros_zero; simpl; normalize.
   pose (t0 := type_member a0).
   assert (align 0 (alignof t0) = 0) by apply align_0, alignof_pos.
   revert H0; pattern ofs at 1 3; replace ofs with (ofs + align 0 (alignof t0)) by lia; intros.
@@ -1456,9 +1443,9 @@ Proof.
     destruct a1 as [i1 t1|]; try discriminate.
    simpl in PLAIN.
  match goal with
-    | |- _ |-- struct_pred (Member_plain i0 t0 :: Member_plain i1 t1 :: m) ?P v ?p =>
+    | |- _ ⊢ struct_pred (Member_plain i0 t0 :: Member_plain i1 t1 :: m) ?P v ?p =>
            change (struct_pred (Member_plain i0 t0 :: Member_plain i1 t1 :: m) P v p) with
-             (P (Member_plain i0 t0) (fst v) p * struct_pred (Member_plain i1 t1 :: m) P (snd v) p);
+             (P (Member_plain i0 t0) (fst v) p ∗ struct_pred (Member_plain i1 t1 :: m) P (snd v) p);
            simpl (P (Member_plain i0 t0) (fst v) p)
     end.
     if_tac; [| congruence].
@@ -1471,9 +1458,7 @@ Proof.
     erewrite struct_pred_ext.
     fold (sizeof t0) in *. fold (alignof t0) in *.
     fold (sizeof t1) in *. fold (alignof t1) in *.
-     eapply derives_trans; [ | apply sepcon_derives; [apply derives_refl | 
-                       apply IHm]]; clear IHm;
-        [ |  simpl in H |- *; 
+    rewrite <- IHm; [ |  simpl in H |- *; 
           fold (sizeof t0) in *; fold (alignof t0) in *;
           fold (sizeof t1) in *; fold (alignof t1) in *;
           pose_align_le; pose_sizeof_pos; lia
@@ -1486,18 +1471,19 @@ Proof.
         (simpl in H; 
           fold (sizeof t0) in *; fold (alignof t0) in *;
           fold (sizeof t1) in *; fold (alignof t1) in *;revert H; pose_align_le; pose_sizeof_pos; intros; lia).
-     apply derives_refl';  f_equal; lia.
+     apply bi.equiv_entails_1_1; f_equiv; hnf; lia.
      auto.
      intros.
       solve_mod_modulus.
       rewrite !name_member_get.
       assert (i <> name_member (Member_plain i0 t0)).
       simpl. clear - H2 NOT_IN.  contradict NOT_IN. subst i0. simpl. auto.
-      rewrite (neq_field_offset_rec_cons cenv_cs i (Member_plain i0 t0)) by auto.
-      rewrite (neq_field_offset_next_rec_cons cenv_cs i (Member_plain i0 t0)) by  auto.
+      rewrite -> (neq_field_offset_rec_cons cenv_cs i (Member_plain i0 t0)) by auto.
+      rewrite -> (neq_field_offset_next_rec_cons cenv_cs i (Member_plain i0 t0)) by auto.
       reflexivity.
 Transparent mapsto_zeros.
 Qed.
+
 Lemma memory_block_union_pred: forall sh m sz {A} (v: compact_sum (map A m)) b ofs,
   (m = nil -> sz = 0) ->
   union_pred m (fun it _ => memory_block sh sz) v (Vptr b (Ptrofs.repr ofs)) =
@@ -1505,7 +1491,7 @@ Lemma memory_block_union_pred: forall sh m sz {A} (v: compact_sum (map A m)) b o
 Proof.
   intros sh m sz A v b ofs NIL_CASE; intros.
   destruct m as [| a0 m].
-  1: rewrite (NIL_CASE eq_refl), memory_block_zero; simpl; normalize.
+  1: rewrite (NIL_CASE eq_refl) memory_block_zero; simpl; normalize.
   clear NIL_CASE.
   revert a0 v; induction m as [| a1 m]; intros.
   + simpl; auto.
@@ -1516,12 +1502,12 @@ Qed.
 
 Lemma mapsto_zeros_union_pred: forall sh m sz {A} (v: compact_sum (map A m)) b ofs,
   (m = nil -> sz = 0) ->
-  mapsto_zeros sz sh (Vptr b (Ptrofs.repr ofs)) |--
+  mapsto_zeros sz sh (Vptr b (Ptrofs.repr ofs)) ⊢
   union_pred m (fun it _ => mapsto_zeros sz sh) v (Vptr b (Ptrofs.repr ofs)).
 Proof.
   intros sh m sz A v b ofs NIL_CASE; intros.
   destruct m as [| a0 m].
-  1: rewrite (NIL_CASE eq_refl), mapsto_zeros_zero; simpl; normalize.
+  1: rewrite (NIL_CASE eq_refl) mapsto_zeros_zero; simpl; normalize.
   clear NIL_CASE.
   revert a0 v; induction m as [| a1 m]; intros.
   + simpl; auto.
@@ -1532,18 +1518,19 @@ Qed.
 
 End MEMORY_BLOCK_AGGREGATE.
 
+End mpred.
+
 Module aggregate_pred.
 
 Open Scope Z.
-Open Scope logic.
 
 
-Definition array_pred: forall {A: Type}{d: Inhabitant A} (lo hi: Z) (P: Z -> A -> val -> mpred) (v: list A),
+Definition array_pred: forall `{!heapGS Σ}{A: Type}{d: Inhabitant A} (lo hi: Z) (P: Z -> A -> val -> mpred) (v: list A),
     val -> mpred := @array_pred.
 
-Definition struct_pred: forall (m: members) {A: member -> Type} (P: forall it, A it -> val -> mpred) (v: compact_prod (map A m)) (p: val), mpred := @struct_pred.
+Definition struct_pred: forall `{!heapGS Σ} (m: members) {A: member -> Type} (P: forall it, A it -> val -> mpred) (v: compact_prod (map A m)) (p: val), mpred := @struct_pred.
 
-Definition union_pred: forall (m: members) {A: member -> Type} (P: forall it, A it -> val -> mpred) (v: compact_sum (map A m)) (p: val), mpred := @union_pred.
+Definition union_pred: forall `{!heapGS Σ} (m: members) {A: member -> Type} (P: forall it, A it -> val -> mpred) (v: compact_sum (map A m)) (p: val), mpred := @union_pred.
 
 Definition array_Prop: forall {A: Type} (d:A) (lo hi: Z) (P: Z -> A -> Prop) (v: list A), Prop := @array_Prop.
 
@@ -1551,24 +1538,24 @@ Definition struct_Prop: forall (m: members) {A: member -> Type} (P: forall it, A
 
 Definition union_Prop: forall (m: members) {A: member -> Type} (P: forall it, A it -> Prop) (v: compact_sum (map A m)), Prop := union_Prop.
 
-Definition array_pred_len_0: forall {A}{d: Inhabitant A} lo hi P p,
+Definition array_pred_len_0: forall `{!heapGS Σ}{A}{d: Inhabitant A} lo hi P p,
   hi = lo ->
   array_pred lo hi P nil p = emp
 := @array_pred_len_0.
 
-Definition array_pred_len_1: forall {A}{d: Inhabitant A} i P v p,
-  array_pred i (i + 1) P (v :: nil) p =  P i v p
+Definition array_pred_len_1: forall `{!heapGS Σ} {A}{d: Inhabitant A} i (P : Z -> A -> _) v p,
+  array_pred i (i + 1) P (v :: nil) p = P i v p
 := @array_pred_len_1.
 
-Definition split_array_pred: forall  {A}{d: Inhabitant A} lo mid hi P v p,
+Definition split_array_pred: forall `{!heapGS Σ} {A} {d: Inhabitant A} lo mid hi P v p,
   lo <= mid <= hi ->
   Zlength v = (hi-lo) ->
   array_pred lo hi P v p =
-  array_pred lo mid P (sublist 0 (mid-lo) v) p *
-  array_pred mid hi P (sublist (mid-lo) (hi-lo) v) p
+  (array_pred lo mid P (sublist 0 (mid-lo) v) p ∗
+   array_pred mid hi P (sublist (mid-lo) (hi-lo) v) p)
 := @split_array_pred.
 
-Definition array_pred_shift: forall {A} {d: Inhabitant A} lo hi lo' hi' mv 
+Definition array_pred_shift: forall `{!heapGS Σ} {A} {d: Inhabitant A} lo hi lo' hi' mv 
               P' P v p,
   lo - lo' = mv ->
   hi - hi' = mv ->
@@ -1578,112 +1565,111 @@ Definition array_pred_shift: forall {A} {d: Inhabitant A} lo hi lo' hi' mv
 := @array_pred_shift.
 
 Definition array_pred_ext_derives:
-  forall {A B} {dA: Inhabitant A} {dB: Inhabitant B} lo hi P0 P1 
+  forall `{!heapGS Σ} {A B} {dA: Inhabitant A} {dB: Inhabitant B} lo hi P0 P1 
             (v0: list A) (v1: list B) p,
   (Zlength v0 = hi - lo -> Zlength v1 = hi - lo) ->
   (forall i, lo <= i < hi ->
-      P0 i (Znth (i-lo) v0) p |-- P1 i (Znth (i-lo) v1) p) ->
-  array_pred lo hi P0 v0 p |-- array_pred lo hi P1 v1 p
+      P0 i (Znth (i-lo) v0) p ⊢ P1 i (Znth (i-lo) v1) p) ->
+  array_pred lo hi P0 v0 p ⊢ array_pred lo hi P1 v1 p
 := @array_pred_ext_derives.
 
 Definition array_pred_ext:
-  forall {A B} {dA: Inhabitant A} {dB: Inhabitant B} lo hi P0 P1 (v0: list A) (v1: list B)  p,
+  forall `{!heapGS Σ} {A B} {dA: Inhabitant A} {dB: Inhabitant B} lo hi P0 P1 (v0: list A) (v1: list B)  p,
   Zlength v0 = Zlength v1 ->
   (forall i, lo <= i < hi ->
-     P0 i (Znth (i - lo) v0) p = P1 i (Znth (i - lo) v1) p) ->
-  array_pred lo hi P0 v0 p = array_pred lo hi P1 v1 p
+     P0 i (Znth (i - lo) v0) p ⊣⊢ P1 i (Znth (i - lo) v1) p) ->
+  array_pred lo hi P0 v0 p ⊣⊢ array_pred lo hi P1 v1 p
 := @array_pred_ext.
 
-Definition at_offset_array_pred: forall {A} {d: Inhabitant A} lo hi P v ofs p,
+Definition at_offset_array_pred: forall `{!heapGS Σ} {A} {d: Inhabitant A} lo hi P v ofs p,
   at_offset (array_pred lo hi P v) ofs p = array_pred lo hi (fun i v => at_offset (P i v) ofs) v p
 := @at_offset_array_pred.
 
-Definition array_pred_sepcon: forall  {A} {d: Inhabitant A} lo hi P Q (v: list A) p,
-  array_pred lo hi P v p * array_pred lo hi Q v p = array_pred lo hi (P * Q) v p
+Definition array_pred_sepcon: forall  `{!heapGS Σ} {A} {d: Inhabitant A} lo hi P Q (v: list A) p,
+  (array_pred lo hi P v p ∗ array_pred lo hi Q v p) = array_pred lo hi (fun i v p => P i v p ∗ Q i v p) v p
 := @array_pred_sepcon.
 
-Definition struct_pred_ramif: forall m {A} (P: forall it, A it -> val -> mpred) (i: ident) v p d,
+Definition struct_pred_ramif: forall `{!heapGS Σ} m {A} (P: forall it, A it -> val -> mpred) (i: ident) v p d,
   in_members i m ->
   members_no_replicate m = true ->
-  struct_pred m P v p |--
-    P _ (proj_struct i m v d) p *
-     allp ((fun v0: _ => P _ v0 p) -* (fun v0: _ => struct_pred m P (upd_struct i m v v0) p))
+  struct_pred m P v p ⊢
+    P _ (proj_struct i m v d) p ∗
+     (∀ v0, P _ v0 p -∗ struct_pred m P (upd_struct i m v v0) p)
 := @struct_pred_ramif.
 
 Definition struct_pred_ext_derives:
-  forall m {A0 A1} (P0: forall it, A0 it -> val -> mpred) (P1: forall it, A1 it -> val -> mpred) v0 v1 p,
+  forall `{!heapGS Σ} m {A0 A1} (P0: forall it, A0 it -> val -> mpred) (P1: forall it, A1 it -> val -> mpred) v0 v1 p,
   members_no_replicate m = true ->
   (forall i d0 d1, in_members i m ->
-     P0 _ (proj_struct i m v0 d0) p |-- P1 _ (proj_struct i m v1 d1) p) ->
-  struct_pred m P0 v0 p |-- struct_pred m P1 v1 p
+     P0 _ (proj_struct i m v0 d0) p ⊢ P1 _ (proj_struct i m v1 d1) p) ->
+  struct_pred m P0 v0 p ⊢ struct_pred m P1 v1 p
 := @struct_pred_ext_derives.
 
 Definition struct_pred_ext:
-  forall m {A0 A1} (P0: forall it, A0 it -> val -> mpred) (P1: forall it, A1 it -> val -> mpred) v0 v1 p,
+  forall `{!heapGS Σ} m {A0 A1} (P0: forall it, A0 it -> val -> mpred) (P1: forall it, A1 it -> val -> mpred) v0 v1 p,
   members_no_replicate m = true ->
   (forall i d0 d1, in_members i m ->
-     P0 _ (proj_struct i m v0 d0) p = P1 _ (proj_struct i m v1 d1) p) ->
-  struct_pred m P0 v0 p = struct_pred m P1 v1 p
+     P0 _ (proj_struct i m v0 d0) p ⊣⊢ P1 _ (proj_struct i m v1 d1) p) ->
+  struct_pred m P0 v0 p ⊣⊢ struct_pred m P1 v1 p
 := @struct_pred_ext.
 
-Definition at_offset_struct_pred: forall m {A} (P: forall it, A it -> val -> mpred) v p ofs,
+Definition at_offset_struct_pred: forall `{!heapGS Σ} m {A} (P: forall it, A it -> val -> mpred) v p ofs,
   at_offset (struct_pred m P v) ofs p = struct_pred m (fun it v => at_offset (P it v) ofs) v p
 := @at_offset_struct_pred.
 
-Definition andp_struct_pred: forall m {A} (P: forall it, A it -> val -> mpred) v p Q,
-  corable Q ->
-  Q && struct_pred m P v p =
+Definition andp_struct_pred: forall `{!heapGS Σ} m {A} (P: forall it, A it -> val -> mpred) v p Q {_ : Persistent Q} {_ : Absorbing Q},
+  Q ∧ struct_pred m P v p ⊣⊢
   match m with
-  | nil => Q && emp
-  | _ => struct_pred m (fun it v p => Q && P it v p) v p
+  | nil => Q ∧ emp
+  | _ => struct_pred m (fun it v p => Q ∧ P it v p) v p
   end
 := @corable_andp_struct_pred.
 
-Definition struct_pred_sepcon: forall m {A} (P Q: forall it, A it -> val -> mpred) v p,
-  struct_pred m P v p * struct_pred m Q v p = struct_pred m (fun it => P it * Q it) v p
+Definition struct_pred_sepcon: forall `{!heapGS Σ} m {A} (P Q: forall it, A it -> val -> mpred) v p,
+  (struct_pred m P v p ∗ struct_pred m Q v p) = struct_pred m (fun it v p => P it v p ∗ Q it v p) v p
 := @struct_pred_sepcon.
 
-Definition union_pred_ramif: forall m {A} (P: forall it, A it -> val -> mpred) (i: ident) v p d,
-  (forall i' (v': A (get_member i' m)), in_members i' m -> P _ v' p |-- P _ d p) ->
+Definition union_pred_ramif: forall `{!heapGS Σ} m {A} (P: forall it, A it -> val -> mpred) (i: ident) v p d,
+  (forall i' (v': A (get_member i' m)), in_members i' m -> P _ v' p ⊢ P _ d p) ->
   in_members i m ->
   members_no_replicate m = true ->
-  union_pred m P v p |--
-    P _ (proj_union i m v d) p *
-     allp ((fun v0: _ => P _ v0 p) -* (fun v0 =>union_pred m P (upd_union i m v v0) p))
+  union_pred m P v p ⊢
+    P _ (proj_union i m v d) p ∗
+     ∀ v0, P _ v0 p -∗ union_pred m P (upd_union i m v v0) p
 := @union_pred_ramif.
 
 Definition union_pred_ext_derives:
-  forall m {A0 A1} (P0: forall it, A0 it -> val -> mpred) (P1: forall it, A1 it -> val -> mpred) v0 v1 p,
+  forall `{!heapGS Σ} m {A0 A1} (P0: forall it, A0 it -> val -> mpred) (P1: forall it, A1 it -> val -> mpred) v0 v1 p,
   members_no_replicate m = true ->
   (forall it, members_union_inj v0 it <-> members_union_inj v1 it) ->
   (forall i (Hin: in_members i m) d0 d1, members_union_inj v0 (get_member i m) -> members_union_inj v1 (get_member i m) ->
-     P0 _ (proj_union i m v0 d0) p |-- P1 _ (proj_union i m v1 d1) p) ->
-  union_pred m P0 v0 p |-- union_pred m P1 v1 p
+     P0 _ (proj_union i m v0 d0) p ⊢ P1 _ (proj_union i m v1 d1) p) ->
+  union_pred m P0 v0 p ⊢ union_pred m P1 v1 p
 := @union_pred_ext_derives.
 
 Definition union_pred_ext:
-  forall m {A0 A1} (P0: forall it, A0 it -> val -> mpred) (P1: forall it, A1 it -> val -> mpred) v0 v1 p,
+  forall `{!heapGS Σ} m {A0 A1} (P0: forall it, A0 it -> val -> mpred) (P1: forall it, A1 it -> val -> mpred) v0 v1 p,
   members_no_replicate m = true ->
   (forall it, members_union_inj v0 it <-> members_union_inj v1 it) ->
   (forall i (Hin: in_members i m) d0 d1, members_union_inj v0 (get_member i m) -> members_union_inj v1 (get_member i m) ->
-     P0 _ (proj_union i m v0 d0) p = P1 _ (proj_union i m v1 d1) p) ->
-  union_pred m P0 v0 p = union_pred m P1 v1 p
+     P0 _ (proj_union i m v0 d0) p ⊣⊢ P1 _ (proj_union i m v1 d1) p) ->
+  union_pred m P0 v0 p ⊣⊢ union_pred m P1 v1 p
 := @union_pred_ext.
 
-Definition at_offset_union_pred: forall m {A} (P: forall it, A it -> val -> mpred) v p ofs,
+Definition at_offset_union_pred: forall `{!heapGS Σ} m {A} (P: forall it, A it -> val -> mpred) v p ofs,
   at_offset (union_pred m P v) ofs p = union_pred m (fun it v => at_offset (P it v) ofs) v p
-:= at_offset_union_pred.
+:= @at_offset_union_pred.
 
-Definition andp_union_pred: forall m {A} (P: forall it, A it -> val -> mpred) v p Q,
-  Q && union_pred m P v p =
+Definition andp_union_pred: forall `{!heapGS Σ} m {A} (P: forall it, A it -> val -> mpred) v p Q,
+  (Q ∧ union_pred m P v p) =
   match m with
-  | nil => Q && emp
-  | _ => union_pred m (fun it v p => Q && P it v p) v p
+  | nil => Q ∧ emp
+  | _ => union_pred m (fun it v p => Q ∧ P it v p) v p
   end
 := @andp_union_pred.
 
-Definition union_pred_sepcon: forall m {A} (P Q: forall it, A it -> val -> mpred) v p,
-  union_pred m P v p * union_pred m Q v p = union_pred m (fun it => P it * Q it) v p
+Definition union_pred_sepcon: forall `{!heapGS Σ} m {A} (P Q: forall it, A it -> val -> mpred) v p,
+  (union_pred m P v p ∗ union_pred m Q v p) = union_pred m (fun it v p => P it v p ∗ Q it v p) v p
 := @union_pred_sepcon.
 
 Definition struct_Prop_compact_prod_gen: forall m (F: member -> Type) (P: forall it, F it -> Prop) (f: forall it, F it),
@@ -1710,21 +1696,21 @@ Definition union_Prop_proj: forall m (F: member -> Type) (P: forall it, F it ->
   P (get_member i m) (proj_union i m v d)
 := @union_Prop_proj.
 
-Definition array_pred_local_facts: forall {A} {d: Inhabitant A} lo hi P v p Q,
-  (forall i x, lo <= i < hi -> P i x p |-- !! Q x) ->
-  array_pred lo hi P v p |-- !! (Zlength v = hi - lo /\ Forall Q v)
+Definition array_pred_local_facts: forall `{!heapGS Σ} {A} {d: Inhabitant A} lo hi P v p Q,
+  (forall i x, lo <= i < hi -> P i x p ⊢ ⌜Q x⌝) ->
+  array_pred lo hi P v p ⊢ ⌜Zlength v = hi - lo /\ Forall Q v⌝
 := @array_pred_local_facts.
 
-Definition struct_pred_local_facts: forall m {A} (P: forall it, A it -> val -> mpred)v p (R: forall it, A it -> Prop),
+Definition struct_pred_local_facts: forall `{!heapGS Σ} m {A} (P: forall it, A it -> val -> mpred)v p (R: forall it, A it -> Prop),
   members_no_replicate m = true ->
-  (forall i v0, in_members i m -> P (get_member i m) v0 p |-- !! R _ v0) ->
-  struct_pred m P v p |-- !! struct_Prop m R v
+  (forall i v0, in_members i m -> P (get_member i m) v0 p ⊢ ⌜R _ v0⌝) ->
+  struct_pred m P v p ⊢ ⌜struct_Prop m R v⌝
 := @struct_pred_local_facts.
 
-Definition union_pred_local_facts: forall m {A} (P: forall it, A it -> val -> mpred)v p (R: forall it, A it -> Prop),
+Definition union_pred_local_facts: forall `{!heapGS Σ} m {A} (P: forall it, A it -> val -> mpred)v p (R: forall it, A it -> Prop),
   members_no_replicate m = true ->
-  (forall i v0, in_members i m -> P (get_member i m) v0 p |-- !! R _ v0) ->
-  union_pred m P v p |-- !! union_Prop m R v
+  (forall i v0, in_members i m -> P (get_member i m) v0 p ⊢ ⌜R _ v0⌝) ->
+  union_pred m P v p ⊢ ⌜union_Prop m R v⌝
 := @union_pred_local_facts.
 
 End aggregate_pred.
@@ -1739,12 +1725,12 @@ Auxiliary predicates
 
 Section AUXILIARY_PRED.
 
-Context {cs: compspecs}.
+Context `{!heapGS Σ} {cs: compspecs}.
 
 Variable sh: share.
 
 Definition struct_data_at_rec_aux (m m0: members) (sz: Z) 
-       (P: ListType (map (fun it => reptype (field_type (name_member it) m0) -> (val -> mpred)) m))
+       (P: hlist (tmap (fun it => reptype (field_type (name_member it) m0) -> (val -> mpred)) m))
        (v: compact_prod (map (fun it => reptype (field_type (name_member it) m0)) m)) : (val -> mpred).
 Proof.
   destruct m as [| a0 m]; [exact (fun _ => emp) |].
@@ -1754,34 +1740,34 @@ Proof.
     exact (withspacer sh
             (field_offset cenv_cs (name_member a0) m0 + sizeof (field_type (name_member a0) m0))
             (field_offset_next cenv_cs (name_member a0) m0 sz)
-            (at_offset (a v) (field_offset cenv_cs (name_member a0) m0))).
+            (at_offset (X v) (field_offset cenv_cs (name_member a0) m0))).
   + simpl in v, P.
     inversion P; subst.
-    exact (withspacer sh
+    exact (fun v0 => withspacer sh
             (field_offset cenv_cs (name_member a1) m0 + sizeof (field_type (name_member a1) m0))
             (field_offset_next cenv_cs (name_member a1) m0 sz)
-            (at_offset (a (fst v)) (field_offset cenv_cs (name_member a1) m0)) * IHm a0 (snd v) b)%logic.
+            (at_offset (X (fst v)) (field_offset cenv_cs (name_member a1) m0)) v0 ∗ IHm a0 (snd v) X0 v0).
 Defined.
 
 Definition union_data_at_rec_aux (m m0: members) (sz: Z)
-      (P: ListType (map (fun it => reptype (field_type (name_member it) m0) -> (val -> mpred)) m))
+      (P: hlist (tmap (fun it => reptype (field_type (name_member it) m0) -> (val -> mpred)) m))
       (v: compact_sum (map (fun it => reptype (field_type (name_member it) m0)) m)) : (val -> mpred).
 Proof.
   destruct m as [| a0 m]; [exact (fun _ => emp) |].
   revert a0 v P; induction m as [| a0 m]; intros ? v P.
   + simpl in v, P.
     inversion P; subst.
-    exact (withspacer sh (sizeof (field_type (name_member a0) m0)) sz (a v)).
+    exact (withspacer sh (sizeof (field_type (name_member a0) m0)) sz (X v)).
   + simpl in v, P.
     inversion P; subst.
     destruct v as [v | v].
-    - exact (withspacer sh (sizeof (field_type (name_member a1) m0)) sz (a v)).
-    - exact (IHm a0 v b).
+    - exact (withspacer sh (sizeof (field_type (name_member a1) m0)) sz (X v)).
+    - exact (IHm a0 v X0).
 Defined.
 
 Lemma struct_data_at_rec_aux_spec: forall m m0 sz v P,
   struct_data_at_rec_aux m m0 sz
-   (ListTypeGen
+   (hmap
      (fun it => reptype (field_type (name_member it) m0) -> val -> mpred)
      P m) v =
   struct_pred m
@@ -1795,26 +1781,23 @@ Proof.
   destruct m as [| a0 m]; [reflexivity |].
   revert a0 v; induction m as [| a0 m]; intros.
   + simpl; reflexivity.
-  + replace
+  + change
      (struct_data_at_rec_aux (a1 :: a0 :: m) m0 sz
-     (ListTypeGen (fun it : member => reptype (field_type (name_member it) m0) -> val -> mpred)
+     (hmap (fun it : member => reptype (field_type (name_member it) m0) -> val -> mpred)
         P (a1 :: a0 :: m)) v) with
-     (withspacer sh
+     (fun v0 => withspacer sh
        (field_offset cenv_cs (name_member a1) m0 + sizeof (field_type (name_member a1) m0))
          (field_offset_next cenv_cs (name_member a1) m0 sz)
-           (at_offset (P a1 (fst v)) (field_offset cenv_cs (name_member a1) m0)) *
+           (at_offset (P a1 (fst v)) (field_offset cenv_cs (name_member a1) m0)) v0 ∗
       struct_data_at_rec_aux (a0 :: m) m0 sz
-     (ListTypeGen (fun it : member => reptype (field_type (name_member it) m0) -> val -> mpred)
-        P (a0 :: m)) (snd v))%logic.
-    - rewrite IHm.
-      reflexivity.
-    - simpl.
-      reflexivity.
+     (hmap (fun it : member => reptype (field_type (name_member it) m0) -> val -> mpred)
+        P (a0 :: m)) (snd v) v0).
+    rewrite IHm //.
 Qed.
 
 Lemma union_data_at_rec_aux_spec: forall m m0 sz v P,
   union_data_at_rec_aux m m0 sz
-   (ListTypeGen
+   (hmap
      (fun it => reptype (field_type (name_member it) m0) -> val -> mpred)
      P m) v =
   union_pred m
@@ -1827,48 +1810,48 @@ Proof.
   intros.
   destruct m as [| a0 m]; [reflexivity |].
   revert a0 v; induction m as [| a0 m]; intros.
-  + simpl. unfold union_pred. simpl. reflexivity.
+  + reflexivity.
   + destruct v as [v | v].
     - reflexivity.
     - match goal with
       | _ => apply IHm
-      | _ => simpl ; f_equal ; apply IHm
+      | _ => simpl; f_equal; apply IHm
       end.
 Qed.
 
 Definition struct_value_fits_aux (m m0: members)
-      (P: ListType (map (fun it => reptype (field_type (name_member it) m0) -> Prop) m))
+      (P: hlist (tmap (fun it => reptype (field_type (name_member it) m0) -> Prop) m))
       (v: compact_prod (map (fun it => reptype (field_type (name_member it) m0)) m)) : Prop.
 Proof.
-  destruct m as [| a0 m]; [exact True |].
+  destruct m as [| a0 m]; [exact True%type |].
   revert a0 v P; induction m as [| a0 m]; intros ? v P.
   + simpl in v, P.
     inversion P; subst.
-    apply (a v).
+    apply (X v).
   + simpl in v, P.
     inversion P; subst.
-    apply (a (fst v) /\ IHm a0 (snd v) b).
+    apply (X (fst v) /\ IHm a0 (snd v) X0).
 Defined.
 
 Definition union_value_fits_aux (m m0: members)
-      (P: ListType (map (fun it => reptype (field_type (name_member it) m0) -> Prop) m))
+      (P: hlist (tmap (fun it => reptype (field_type (name_member it) m0) -> Prop) m))
       (v: compact_sum (map (fun it => reptype (field_type (name_member it) m0)) m)) : Prop.
 Proof.
-  destruct m as [| a0 m]; [exact True |].
+  destruct m as [| a0 m]; [exact True%type |].
   revert a0 v P; induction m as [| a0 m]; intros ? v P.
   + simpl in v, P.
     inversion P; subst.
-    exact (a v).
+    exact (X v).
   + simpl in v, P.
     inversion P; subst.
     destruct v as [v | v].
-    - exact (a v).
-    - exact (IHm a0 v b).
+    - exact (X v).
+    - exact (IHm a0 v X0).
 Defined.
 
 Lemma struct_value_fits_aux_spec: forall m m0 v P,
   struct_value_fits_aux m m0
-   (ListTypeGen
+   (hmap
      (fun it => reptype (field_type (name_member it) m0) -> Prop)
      P m) v =
   struct_Prop m P v.
@@ -1877,22 +1860,19 @@ Proof.
   destruct m as [| a0 m]; [reflexivity |].
   revert a0 v; induction m as [| a0 m]; intros.
   + simpl; reflexivity.
-  + replace
+  + change
      (struct_value_fits_aux (a1 :: a0 :: m) m0
-     (ListTypeGen (fun it : member => reptype (field_type (name_member it) m0) -> Prop)
+     (hmap (fun it : member => reptype (field_type (name_member it) m0) -> Prop)
         P (a1 :: a0 :: m)) v) with
      (P a1 (fst v) /\  struct_value_fits_aux (a0 :: m) m0
-     (ListTypeGen (fun it : member => reptype (field_type (name_member it) m0) -> Prop)
+     (hmap (fun it : member => reptype (field_type (name_member it) m0) -> Prop)
         P (a0 :: m)) (snd v)).
-    - rewrite IHm.
-      reflexivity.
-    - simpl.
-      reflexivity.
+    rewrite IHm //.
 Qed.
 
 Lemma union_value_fits_aux_spec: forall m m0 v P,
   union_value_fits_aux m m0
-   (ListTypeGen
+   (hmap
      (fun it => reptype (field_type (name_member it) m0) -> Prop)
      P m) v =
   union_Prop m P v.
@@ -1900,12 +1880,12 @@ Proof.
   intros.
   destruct m as [| a0 m]; [reflexivity |].
   revert a0 v; induction m as [| a0 m]; intros.
-  + simpl. unfold union_Prop. simpl. reflexivity.
+  + reflexivity.
   + destruct v as [v | v].
     - reflexivity.
     - match goal with
       | _ => apply IHm
-      | _ => simpl ; f_equal ; apply IHm
+      | _ => simpl; f_equal; apply IHm
       end.
 Qed.
 
@@ -1916,20 +1896,20 @@ Module auxiliary_pred.
 Import aggregate_pred.
 
 Definition struct_data_at_rec_aux:
-   forall {cs: compspecs} (sh: share) (m m0: members) (sz: Z) 
-     (P: ListType (map (fun it => reptype (field_type (name_member it) m0) -> (val -> mpred)) m)) 
+   forall `{!heapGS Σ} {cs: compspecs} (sh: share) (m m0: members) (sz: Z) 
+     (P: hlist (tmap (fun it => reptype (field_type (name_member it) m0) -> (val -> mpred)) m)) 
      (v: compact_prod (map (fun it => reptype (field_type (name_member it) m0)) m)), (val -> mpred)
 := @struct_data_at_rec_aux.
 
 Definition union_data_at_rec_aux:
-  forall {cs: compspecs} (sh: share) (m m0: members) (sz: Z) 
-    (P: ListType (map (fun it => reptype (field_type (name_member it) m0) -> (val -> mpred)) m)) 
+  forall `{!heapGS Σ} {cs: compspecs} (sh: share) (m m0: members) (sz: Z) 
+    (P: hlist (tmap (fun it => reptype (field_type (name_member it) m0) -> (val -> mpred)) m)) 
     (v: compact_sum (map (fun it => reptype (field_type (name_member it) m0)) m)), (val -> mpred)
 := @union_data_at_rec_aux.
 
-Definition struct_data_at_rec_aux_spec: forall {cs: compspecs} (sh: share) m m0 sz v P,
+Definition struct_data_at_rec_aux_spec: forall `{!heapGS Σ} {cs: compspecs} (sh: share) m m0 sz v P,
   struct_data_at_rec_aux sh m m0 sz
-   (ListTypeGen
+   (hmap
      (fun it => reptype (field_type (name_member it) m0) -> val -> mpred)
      P m) v =
   struct_pred m
@@ -1940,9 +1920,9 @@ Definition struct_data_at_rec_aux_spec: forall {cs: compspecs} (sh: share) m m0
        (at_offset (P it v) (field_offset cenv_cs (name_member it) m0))) v
 := @struct_data_at_rec_aux_spec.
 
-Definition union_data_at_rec_aux_spec: forall {cs: compspecs} sh m m0 sz v P,
+Definition union_data_at_rec_aux_spec: forall `{!heapGS Σ} {cs: compspecs} sh m m0 sz v P,
   union_data_at_rec_aux sh m m0 sz
-   (ListTypeGen
+   (hmap
      (fun it => reptype (field_type (name_member it) m0) -> val -> mpred)
      P m) v =
   union_pred m
@@ -1955,19 +1935,19 @@ Definition union_data_at_rec_aux_spec: forall {cs: compspecs} sh m m0 sz v P,
 
 Definition struct_value_fits_aux:
   forall {cs: compspecs} (m m0: members)
-      (P: ListType (map (fun it => reptype (field_type (name_member it) m0) -> Prop) m))
+      (P: hlist (tmap (fun it => reptype (field_type (name_member it) m0) -> Prop) m))
       (v: compact_prod (map (fun it => reptype (field_type (name_member it) m0)) m)), Prop
 := @struct_value_fits_aux.
 
 Definition union_value_fits_aux:
   forall {cs: compspecs} (m m0: members)
-      (P: ListType (map (fun it => reptype (field_type (name_member it) m0) -> Prop) m))
+      (P: hlist (tmap (fun it => reptype (field_type (name_member it) m0) -> Prop) m))
       (v: compact_sum (map (fun it => reptype (field_type (name_member it) m0)) m)), Prop
 := @union_value_fits_aux.
 
 Definition struct_value_fits_aux_spec: forall {cs: compspecs} m m0 v P,
   struct_value_fits_aux m m0
-   (ListTypeGen
+   (hmap
      (fun it => reptype (field_type (name_member it) m0) -> Prop)
      P m) v =
   struct_Prop m P v
@@ -1975,29 +1955,29 @@ Definition struct_value_fits_aux_spec: forall {cs: compspecs} m m0 v P,
 
 Definition union_value_fits_aux_spec: forall {cs: compspecs} m m0 v P,
   union_value_fits_aux m m0
-   (ListTypeGen
+   (hmap
      (fun it => reptype (field_type (name_member it) m0) -> Prop)
      P m) v =
   union_Prop m P v
 := @union_value_fits_aux_spec.
 
 Definition memory_block_array_pred:
-  forall {cs: compspecs} {A : Type} {d : Inhabitant A} (a: A) sh t z b ofs,
+  forall `{!heapGS Σ} {cs: compspecs} {A : Type} {d : Inhabitant A} (a: A) sh t z b ofs,
   0 <= z ->
   0 <= ofs /\ ofs + sizeof t * z < Ptrofs.modulus ->
   array_pred 0 z
      (fun i _ p =>
       memory_block sh (sizeof t)
         (offset_val (sizeof t * i) p)) (Zrepeat a z)
-     (Vptr b (Ptrofs.repr ofs))  =
+     (Vptr b (Ptrofs.repr ofs)) ⊣⊢
   memory_block sh (sizeof t * z) (Vptr b (Ptrofs.repr ofs))
 := @memory_block_array_pred'.
 
 Definition mapsto_zeros_array_pred:
-  forall {cs: compspecs} {A : Type} {d : Inhabitant A} (a: A) sh t z b ofs,
+  forall `{!heapGS Σ} {cs: compspecs} {A : Type} {d : Inhabitant A} (a: A) sh t z b ofs,
   0 <= z ->
   0 <= ofs /\ ofs + sizeof t * z < Ptrofs.modulus ->
-  mapsto_zeros (sizeof t * z) sh (Vptr b (Ptrofs.repr ofs)) |--
+  mapsto_zeros (sizeof t * z) sh (Vptr b (Ptrofs.repr ofs)) ⊢
   array_pred 0 z
      (fun i _ p =>
       mapsto_zeros (sizeof t) sh
@@ -2006,7 +1986,7 @@ Definition mapsto_zeros_array_pred:
 := @mapsto_zeros_array_pred'.
 
 Definition memory_block_struct_pred:
-  forall {cs: compspecs} sh m sz {A} (v: compact_prod (map A m)) b ofs,
+  forall `{!heapGS Σ} {cs: compspecs} sh m sz {A} (v: compact_prod (map A m)) b ofs,
   (m = nil -> sz = 0) ->
   plain_members m = true ->
   members_no_replicate m = true ->
@@ -2015,18 +1995,18 @@ Definition memory_block_struct_pred:
   struct_pred m
    (fun it _ p =>
      (memory_block sh (field_offset_next cenv_cs (name_member it) m sz - field_offset cenv_cs (name_member it) m))
-     (offset_val (field_offset cenv_cs (name_member it) m) p)) v (Vptr b (Ptrofs.repr ofs)) =
+     (offset_val (field_offset cenv_cs (name_member it) m) p)) v (Vptr b (Ptrofs.repr ofs)) ⊣⊢
   memory_block sh sz (Vptr b (Ptrofs.repr ofs))
 := @memory_block_struct_pred.
 
 Definition mapsto_zeros_struct_pred:
-  forall {cs: compspecs} sh m sz {A} (v: compact_prod (map A m)) b ofs,
+  forall `{!heapGS Σ} {cs: compspecs} sh m sz {A} (v: compact_prod (map A m)) b ofs,
   (m = nil -> sz = 0) ->
   plain_members m = true ->
   members_no_replicate m = true ->
   sizeof_struct cenv_cs 0 m <= sz < Ptrofs.modulus ->
   0 <= ofs /\ ofs + sz < Ptrofs.modulus ->
-  mapsto_zeros sz sh (Vptr b (Ptrofs.repr ofs)) |--
+  mapsto_zeros sz sh (Vptr b (Ptrofs.repr ofs)) ⊢
   struct_pred m
    (fun it _ p =>
      (mapsto_zeros (field_offset_next cenv_cs (name_member it) m sz - field_offset cenv_cs (name_member it) m)) sh
@@ -2034,16 +2014,16 @@ Definition mapsto_zeros_struct_pred:
 := @mapsto_zeros_struct_pred.
 
 Definition memory_block_union_pred:
-  forall sh m sz {A} (v: compact_sum (map A m)) b ofs,
+  forall `{!heapGS Σ} sh m sz {A} (v: compact_sum (map A m)) b ofs,
   (m = nil -> sz = 0) ->
   union_pred m (fun it _ => memory_block sh sz) v (Vptr b (Ptrofs.repr ofs)) =
   memory_block sh sz (Vptr b (Ptrofs.repr ofs))
 := @memory_block_union_pred.
 
 Definition mapsto_zeros_union_pred:
-  forall sh m sz {A} (v: compact_sum (map A m)) b ofs,
+  forall `{!heapGS Σ} sh m sz {A} (v: compact_sum (map A m)) b ofs,
   (m = nil -> sz = 0) ->
-  mapsto_zeros sz sh (Vptr b (Ptrofs.repr ofs)) |--
+  mapsto_zeros sz sh (Vptr b (Ptrofs.repr ofs)) ⊢
   union_pred m (fun it _ => mapsto_zeros sz sh) v (Vptr b (Ptrofs.repr ofs))
 := @mapsto_zeros_union_pred.
 
diff --git a/floyd/aggregate_type.v b/floyd/aggregate_type.v
index f911f38ce6..a89957bc6b 100644
--- a/floyd/aggregate_type.v
+++ b/floyd/aggregate_type.v
@@ -1,11 +1,15 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
 Require Import VST.floyd.assert_lemmas.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.type_induction.
 Require Import VST.floyd.jmeq_lemmas.
 Require Export VST.floyd.fieldlist.
 Require Export VST.floyd.compact_prod_sum.
 Require Export VST.zlist.sublist.
 
+Local Unset SsrRewrite.
+
 Definition proj_struct (i : ident) (m : members) {A: member -> Type} (v: compact_prod (map A m)) 
     (d: A (get_member i m)): A (get_member i m) :=
   proj_compact_prod (get_member i m) m v d member_dec.
diff --git a/floyd/align_compatible_dec.v b/floyd/align_compatible_dec.v
index c809441a4f..fca57a4202 100644
--- a/floyd/align_compatible_dec.v
+++ b/floyd/align_compatible_dec.v
@@ -1,9 +1,10 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.fieldlist.
 Require Import VST.floyd.type_induction.
 Require Import VST.floyd.nested_pred_lemmas.
-Import compcert.lib.Maps.
 Open Scope Z.
 
 Module Type ACR_DEC.
@@ -20,31 +21,31 @@ Section align_compatible_rec_dec.
 
 Context {cs: compspecs}.
 
-Definition dec_type := sigT (fun P: Z -> Prop => forall z: Z, {P z} + {~ P z}).
+Definition dec_type := sigT (fun P: Z -> Prop => forall z: Z, {P z} + {~ P z} ).
 
 Definition dec_by_value (ch: memory_chunk): dec_type :=
-  existT (fun P: Z -> Prop => forall z: Z, {P z} + {~ P z}) 
+  existT (P := fun P: Z -> Prop => forall z: Z, {P z} + {~ P z} ) 
    (fun z => (Memdata.align_chunk ch | z))
    (fun z => Zdivide_dec (Memdata.align_chunk ch) z (*Memdata.align_chunk_pos _*)).
 
 Definition dec_False: dec_type :=
-  existT (fun P: Z -> Prop => forall z: Z, {P z} + {~ P z}) (fun z => False) (fun z => right (fun H => H)).
+  existT (P := fun P: Z -> Prop => forall z: Z, {P z} + {~ P z} ) (fun z => False%type) (fun z => right (fun H => H)).
 
 Definition dec_True: dec_type :=
-  existT (fun P: Z -> Prop => forall z: Z, {P z} + {~ P z}) (fun z => True) (fun z => left I).
+  existT (P := fun P: Z -> Prop => forall z: Z, {P z} + {~ P z} ) (fun z => True%type) (fun z => left I).
 
-Fixpoint cons_in_list {A} (a: A) (al' al: list A) (H: forall x, In x al' -> In x al) (bl: list {x:A| In x al'}) : list {x: A | In x al} :=
+Fixpoint cons_in_list {A} (a: A) (al' al: list A) (H: forall x, In x al' -> In x al) (bl: list {x:A| In x al'} ) : list {x: A | In x al} :=
   match bl with
   | nil => nil
   | exist x i :: bl0 =>exist _ x (H x i)  :: cons_in_list a al' al H bl0
   end.
 
 Fixpoint make_in_list {A} (al: list A) : list {x: A | In x al} := 
-  match al as ax return (al = ax -> list {x : A | In x ax}) with
+  match al as ax return (al = ax -> list {x : A | In x ax} ) with
            | nil => fun _ => nil
            | a::al' => fun H: al = a::al' =>
                       exist _ a (or_introl eq_refl) ::
-                         eq_rect al (fun l : list A => list {x : A | In x l}) 
+                         eq_rect al (fun l : list A => list {x : A | In x l} )
                           (cons_in_list a al' al (fun (x : A) (H0 : In x al') =>
                                  eq_ind_r (fun al0 : list A => In x al0) (in_cons _ _ _ H0) H)
                                (make_in_list al'))
@@ -129,16 +130,16 @@ eapply align_compatible_rec_Tarray_inv in H.
 apply H.
 split; try lia.
 * (* Tstruct *)
-destruct (cenv_cs ! i) eqn:?H;
- [ | right; intro H0; inv H0; [inv H1 | congruence]].
+destruct (cenv_cs !! i) eqn:?H;
+ [ | right; intro H0; inv H0].
 destruct (plain_members (co_members c)) eqn:?PLAIN;
-   [ | right; intro Hx; inv Hx; [ discriminate | congruence]].
+   [ | right; intro Hx; inv Hx; congruence].
 simpl in Hrank. rewrite H in Hrank.
 pose (FO id := match Ctypes.field_offset cenv_cs id (co_members c) with
                       | Errors.OK (z0, Full) => z0 | _ => 0 end).
 pose (D := fun x: {it: member | In it (co_members c)} =>
                 align_compatible_rec cenv_cs (type_member (proj1_sig x)) (z + FO (name_member (proj1_sig x)))).
-assert (H1: forall x, {D x} + {~ D x}). {
+assert (H1: forall x, {D x} + {~ D x} ). {
  subst D. intros. destruct x as [[id t0|] ?].
 2:{ exfalso. clear - i0 PLAIN. 
    induction (co_members c) as [|[|]]; simpl in *; try discriminate; auto. destruct i0; auto. discriminate.
@@ -182,7 +183,7 @@ destruct (Forall_dec D H1 (make_in_list (co_members c))) as [H2|H2]; clear H1; [
  apply id_in_list_false in Heqb.
  exfalso. apply Heqb. apply (in_map name_member) in H. apply H.
  apply IHm. auto.
- destruct i0. inv H0. contradiction. auto.
+ destruct i0. inv H0. auto.
  simpl in H1. destruct (id_in_list id0 (map name_member m)) eqn:?; try discriminate.
  auto.
  unfold FO; simpl.
@@ -190,14 +191,14 @@ destruct (Forall_dec D H1 (make_in_list (co_members c))) as [H2|H2]; clear H1; [
  assert (in_members id (co_members c)). unfold in_members. apply (in_map name_member) in i0; auto.
  pose proof (plain_members_field_offset _ PLAIN _ _ H). rewrite H0. auto.
 * (* Tunion *)
-destruct (cenv_cs ! i) eqn:?H;
- [ | right; intro H0; inv H0; [inv H1 | congruence]].
+destruct (cenv_cs !! i) eqn:?H;
+ [ | right; intro H0; inv H0; congruence].
 destruct (plain_members (co_members c)) eqn:?PLAIN;
-   [ | right; intro Hx; inv Hx; [ discriminate | congruence]].
+   [ | right; intro Hx; inv Hx; congruence].
 simpl in Hrank. rewrite H in Hrank.
 pose (D := fun x: {it: member | In it (co_members c)} =>
                 align_compatible_rec cenv_cs (type_member (proj1_sig x)) z).
-assert (H1: forall x, {D x} + {~ D x}). {
+assert (H1: forall x, {D x} + {~ D x} ). {
  subst D. intros. destruct x as [[id t0|] ?].
 2:{ exfalso. clear - i0 PLAIN. 
    induction (co_members c) as [|[|]]; simpl in *; try discriminate; auto. destruct i0; auto. discriminate.
@@ -231,13 +232,13 @@ destruct (Forall_dec D H1 (make_in_list (co_members c))) as [H2|H2]; clear H1; [
  unfold get_co in H1. rewrite H in H1. unfold members_no_replicate in H1.
  clear - i0 H1 PLAIN.
  induction (co_members c) as [|[|]]; [ | | discriminate]. inv i0. simpl.
- if_tac. subst. 
+ if_tac. subst.
  simpl in H1. destruct (id_in_list id0 (map name_member m)) eqn:?; try discriminate.
  destruct i0. inv H. auto.
  apply id_in_list_false in Heqb.
  exfalso. apply Heqb. apply (in_map name_member) in H. apply H.
  apply IHm; auto.  
- destruct i0. inv H0. contradiction. auto.
+ destruct i0. inv H0. auto.
  simpl in H1. destruct (id_in_list id0 (map name_member m)) eqn:?; try discriminate.
  auto.
 Qed.
@@ -259,4 +260,4 @@ Proof.
   destruct p; try solve [left; unfold align_compatible; simpl; tauto].
   simpl.
   apply align_compatible_rec_dec.align_compatible_rec_dec.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/floyd/assert_lemmas.v b/floyd/assert_lemmas.v
index cba0e154d5..5fbddb7afc 100644
--- a/floyd/assert_lemmas.v
+++ b/floyd/assert_lemmas.v
@@ -1,12 +1,14 @@
 From compcert Require Export Clightdefs.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Export VST.veric.SeparationLogic.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Export VST.msl.Extensionality.
 Require Export compcert.lib.Coqlib.
 Require Export VST.msl.Coqlib2 VST.veric.coqlib4 VST.floyd.coqlib3.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.val_lemmas.
-Local Open Scope logic.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Import LiftNotation.
-Import compcert.lib.Maps.
 
 Ltac _destruct_var_types i Heq_vt Heq_ve t b ::=
   let HH := fresh "H" in
@@ -85,40 +87,144 @@ Global Transparent Int.repr.
 Global Transparent Int64.repr.
 Global Transparent Ptrofs.repr.
 
-Definition loop1x_ret_assert (Inv : environ -> mpred) (R : ret_assert) :=
-  {| RA_normal := Inv; RA_break := FF; RA_continue := Inv; RA_return := R.(RA_return) |}.
+(* up? *)
+Lemma pure_and : forall {M} P Q, bi_pure(PROP := ouPredI M) (P /\ Q) = (⌜P⌝ ∧ ⌜Q⌝).
+Proof.
+  intros.
+  ouPred.unseal; apply IProp_eq; extensionality n x; apply prop_ext; tauto.
+Qed.
+
+(* up? *)
+Lemma monPred_eq : forall {I B} a1 a2 b1 b2, a1 = a2 -> @MonPred I B a1 b1 = MonPred a2 b2.
+Proof.
+  intros; subst; f_equal; apply proof_irr.
+Qed.
+
+Section monPred.
+
+Context {A : biIndex} {M : uora}.
+Implicit Types (P Q : monPred A (ouPredI M)).
+
+Lemma assert_ext : forall P Q, (forall rho, monPred_at P rho = monPred_at Q rho) -> P = Q.
+Proof.
+  intros.
+  destruct P, Q; apply monPred_eq.
+  extensionality; auto.
+Qed.
+
+Lemma False_sep' : forall P, (P ∗ False) = False.
+Proof.
+  intros; apply assert_ext; intros; monPred.unseal; apply False_sep.
+Qed.
+
+Lemma sep_False' : forall P, (False ∗ P) = False.
+Proof.
+  intros; apply assert_ext; intros; monPred.unseal; apply sep_False.
+Qed.
+
+Lemma True_and' : forall P, (True ∧ P) = P.
+Proof.
+  intros; apply assert_ext; intros; monPred.unseal; apply log_normalize.True_and.
+Qed.
+
+Lemma and_True' : forall P, (P ∧ True) = P.
+Proof.
+  intros; apply assert_ext; intros; monPred.unseal; apply log_normalize.and_True.
+Qed.
+
+Lemma emp_sep' : forall P, (emp ∗ P) = P.
+Proof.
+  intros; apply assert_ext; intros; monPred.unseal; apply emp_sep.
+Qed.
+
+Lemma sep_emp' : forall P, (P ∗ emp) = P.
+Proof.
+  intros; apply assert_ext; intros; monPred.unseal; apply sep_emp.
+Qed.
+
+Lemma and_comm' : forall P Q, (P ∧ Q) = (Q ∧ P).
+Proof.
+  intros; apply assert_ext; intros; monPred.unseal; apply log_normalize.and_comm.
+Qed.
+
+Lemma and_assoc' : forall P Q R, (P ∧ Q ∧ R) = ((P ∧ Q) ∧ R).
+Proof.
+  intros; apply assert_ext; intros; monPred.unseal; apply log_normalize.and_assoc.
+Qed.
+
+Lemma sep_comm' : forall P Q, (P ∗ Q) = (Q ∗ P).
+Proof.
+  intros; apply assert_ext; intros; monPred.unseal; apply sep_comm.
+Qed.
+
+Lemma sep_assoc' : forall P Q R, (P ∗ Q ∗ R) = ((P ∗ Q) ∗ R).
+Proof.
+  intros; apply assert_ext; intros; monPred.unseal; apply sep_assoc.
+Qed.
+
+Lemma pure_and' : forall (P Q : Prop), bi_pure(PROP := monPredI A (ouPredI M)) (P /\ Q) = (⌜P⌝ ∧ ⌜Q⌝).
+Proof.
+intros.
+  intros; apply assert_ext; intros; monPred.unseal; apply pure_and.
+Qed.
+
+Lemma and_exist_l' : forall {A} P (Q : A -> _), (P ∧ (∃ a : A, Q a)) = ∃ a, P ∧ Q a.
+Proof.
+  intros; apply assert_ext; intros; monPred.unseal; apply and_exist_l.
+Qed.
+
+Lemma and_exist_r' : forall {A} P (Q : A -> _), ((∃ a : A, Q a) ∧ P) = ∃ a, Q a ∧ P.
+Proof.
+  intros; apply assert_ext; intros; monPred.unseal; apply and_exist_r.
+Qed.
+
+Lemma sep_exist_l' : forall {A} P (Q : A -> _), (P ∗ (∃ a : A, Q a)) = ∃ a, P ∗ Q a.
+Proof.
+  intros; apply assert_ext; intros; monPred.unseal; apply sep_exist_l.
+Qed.
+
+Lemma sep_exist_r' : forall {A} P (Q : A -> _), ((∃ a : A, Q a) ∗ P) = ∃ a, Q a ∗ P.
+Proof.
+  intros; apply assert_ext; intros; monPred.unseal; apply sep_exist_r.
+Qed.
+
+End monPred.
+
+#[export] Hint Rewrite @False_sep' @sep_False' @True_and' @and_True' : norm.
+
+#[export] Hint Rewrite @sep_emp' @emp_sep'
+             @sep_exist_l' @sep_exist_r'
+               @and_exist_l' @and_exist_r'
+     using (solve [auto with typeclass_instances])
+        : norm.
+
+Section mpred.
+
+Context `{!heapGS Σ}.
+
+Local Notation assert := (@assert Σ).
+
+Implicit Types (P Q : assert).
+
+Definition loop1x_ret_assert (Inv : assert) (R : ret_assert) :=
+  {| RA_normal := Inv; RA_break := False; RA_continue := Inv; RA_return := R.(RA_return) |}.
 
 Lemma loop1x_ret_assert_EK_normal:
  forall Inv R, RA_normal (loop1x_ret_assert Inv R) = Inv.
 Proof. reflexivity. Qed.
-#[export] Hint Rewrite loop1x_ret_assert_EK_normal: ret_assert.
 
+Definition loop1y_ret_assert (Inv : assert) :=
+  {| RA_normal := Inv; RA_break := False; RA_continue := Inv; RA_return _ := False |}.
 
-Definition loop1y_ret_assert (Inv : environ -> mpred) :=
-  {| RA_normal := Inv; RA_break := FF; RA_continue := Inv; RA_return := FF |}.
-
-Definition for_ret_assert (I: environ->mpred) (Post: ret_assert) :=
+Definition for_ret_assert (I: assert) (Post: ret_assert) :=
  match Post with 
   {| RA_normal := _; RA_break := _; RA_continue := _; RA_return := r |} =>
-  {| RA_normal := I; RA_break := FF; RA_continue := I; RA_return := r |}
+  {| RA_normal := I; RA_break := False; RA_continue := I; RA_return := r |}
  end.
 
-Ltac simpl_ret_assert := 
- cbn [RA_normal RA_break RA_continue RA_return 
-      normal_ret_assert overridePost loop1_ret_assert
-      loop2_ret_assert function_body_ret_assert frame_ret_assert
-      switch_ret_assert loop1x_ret_assert loop1y_ret_assert
-      for_ret_assert loop_nocontinue_ret_assert];
-     try change (bind_ret None tvoid ?P) with P.
-
-Lemma RA_normal_loop2_ret_assert: (* MOVE TO assert_lemmas *)
+Lemma RA_normal_loop2_ret_assert:
   forall Inv R, RA_normal (loop2_ret_assert Inv R) = Inv.
 Proof. destruct R; reflexivity. Qed.
-#[export] Hint Rewrite RA_normal_loop2_ret_assert : ret_assert.
-
-Lemma liftTrue: forall rho, `True rho.
-Proof. intro. unfold_lift; apply Coq.Init.Logic.I. Qed.
-#[export] Hint Resolve liftTrue : core.
 
 Lemma overridePost_normal:
   forall P Q, overridePost P (normal_ret_assert Q) = normal_ret_assert P.
@@ -128,59 +234,50 @@ Qed.
 
 Lemma frame_normal:
   forall P F,
-   frame_ret_assert (normal_ret_assert P) F = normal_ret_assert (P * F).
+   frame_ret_assert (normal_ret_assert P) F = normal_ret_assert (P ∗ F).
 Proof.
 intros.
 unfold normal_ret_assert; simpl.
-f_equal; try solve [extensionality rho; normalize].
-extensionality vl rho; normalize.
+f_equal; last extensionality; apply sep_False'.
 Qed.
 
 Lemma frame_for1:
   forall Q R F,
    frame_ret_assert (loop1_ret_assert Q R) F =
-   loop1_ret_assert (Q * F) (frame_ret_assert R F).
+   loop1_ret_assert (Q ∗ F) (frame_ret_assert R F).
 Proof.
 intros.
-destruct R; simpl; normalize.
+destruct R; reflexivity.
 Qed.
 
 Lemma frame_loop1:
   forall Q R F,
    frame_ret_assert (loop2_ret_assert Q R) F =
-   loop2_ret_assert (Q * F) (frame_ret_assert R F).
+   loop2_ret_assert (Q ∗ F) (frame_ret_assert R F).
 Proof.
 intros.
-destruct R; simpl.
-f_equal; try solve [extensionality rho; normalize].
+destruct R; simpl; f_equal.
+apply sep_False'.
 Qed.
 
-
-#[export] Hint Rewrite frame_normal frame_for1 frame_loop1
-                 overridePost_normal: ret_assert.
-#[export] Hint Resolve TT_right : core.
-
 Lemma overridePost_overridePost:
  forall P Q R, overridePost P (overridePost Q R) = overridePost P R.
 Proof.
 intros.
 destruct R; reflexivity.
 Qed.
-#[export] Hint Rewrite overridePost_overridePost : ret_assert.
 
 Lemma overridePost_normal':
   forall P R, RA_normal (overridePost P R) = P.
 Proof.
  intros. destruct R; reflexivity. 
 Qed.
-#[export] Hint Rewrite overridePost_normal' : ret_assert.
 
 Lemma liftx_id:
     forall {T} e, @liftx (Tarrow T (LiftEnviron T)) (fun v => v) e = e.
 Proof.
  intros. extensionality rho; simpl; auto.
 Qed.
-#[export] Hint Rewrite @liftx_id : norm2.
 
 Lemma liftx3_liftx2:
  forall {A1 A2 A3 B} f (x: A1),
@@ -200,84 +297,85 @@ Lemma liftx1_liftx0:
   @liftx (LiftEnviron B) (f x).
 Proof. reflexivity. Qed.
 
-#[export] Hint Rewrite @liftx3_liftx2 @liftx2_liftx1 @liftx1_liftx0 : norm2.
-
 Lemma lift1_lift0:
  forall {A1 B} (f: A1 -> B) (x: A1), lift1 f (lift0 x) = lift0 (f x).
 Proof.
 intros. extensionality rho; reflexivity.
 Qed.
-#[export] Hint Rewrite @lift1_lift0 : norm2.
 
 Lemma const_liftx0:
   forall B (P: B), (fun _ : environ => P) = `P.
 Proof. reflexivity. Qed.
-#[export] Hint Rewrite const_liftx0 : norm2.
 
 Lemma lift_identity:
   forall A f, `(fun v: A => v) f = f.
 Proof. intros. reflexivity. Qed.
-#[export] Hint Rewrite lift_identity : norm2.
 
 Lemma tc_eval_gvar_zero:
   forall Delta t i rho, tc_environ Delta rho ->
-            (var_types Delta) ! i = None ->
-            (glob_types Delta) ! i = Some t ->
+            (var_types Delta) !! i = None ->
+            (glob_types Delta) !! i = Some t ->
             exists b, eval_var i t rho = Vptr b Ptrofs.zero.
 Proof.
  intros. unfold eval_var; simpl.
  destruct_var_types i.
  destruct_glob_types i.
- rewrite Heqo0, Heqo1.
+ rewrite Heqo0 ?Heqo1.
  eauto.
 Qed.
 
 Lemma tc_eval_gvar_i:
   forall Delta t i rho, tc_environ Delta rho ->
-            (var_types Delta) ! i = None ->
-            (glob_types Delta) ! i = Some t ->
+            (var_types Delta) !! i = None ->
+            (glob_types Delta) !! i = Some t ->
              tc_val (Tpointer t noattr) (eval_var i t rho).
 Proof.
  intros.
  red.
  destruct (tc_eval_gvar_zero _ _ _ _ H H0 H1) as [b ?].
- rewrite H2.  destruct (eqb_type _ _); apply Coq.Init.Logic.I.
+ rewrite H2. destruct (eqb_type _ _); apply Coq.Init.Logic.I.
 Qed.
 
-Lemma local_lift2_and: forall P Q, local (`and P Q) =
-        local P && local Q.
-Proof. intros; extensionality rho. unfold local; super_unfold_lift.
-simpl.
- apply pred_ext; normalize. destruct H; normalize.
+Lemma local_lift2_and: forall (P Q : environ -> Prop), (local (`and P Q) : assert) =
+        (local P ∧ local Q).
+Proof.
+  intros.
+  apply assert_ext; intros; monPred.unseal; super_unfold_lift.
+  rewrite pure_and //.
 Qed.
-#[export] Hint Rewrite local_lift2_and : norm2.
 
-Lemma subst_TT {A}{NA: NatDed A}: forall i v, subst i v TT = TT.
+Lemma subst_True : forall i v, assert_of (subst i v (True : assert)) = True.
 Proof.
-intros. extensionality rho; reflexivity.
+  intros.
+  apply assert_ext; intros; rewrite /subst /=; monPred.unseal; done.
 Qed.
 
-Lemma subst_FF {A}{NA: NatDed A}: forall i v, subst i v FF = FF.
+Lemma subst_False : forall i v, assert_of (subst i v (False : assert)) = False.
 Proof.
-intros. extensionality rho; reflexivity.
+  intros.
+  apply assert_ext; intros; rewrite /subst /=; monPred.unseal; done.
 Qed.
-#[export] Hint Rewrite @subst_TT @subst_FF: subst.
-#[export] Hint Rewrite (@subst_TT mpred Nveric) (@subst_FF mpred Nveric): subst.
 
-Lemma subst_sepcon: forall i v (P Q: environ->mpred),
-  subst i v (P * Q) = (subst i v P * subst i v Q).
-Proof. reflexivity. Qed.
-#[export] Hint Rewrite subst_sepcon : subst.
+Lemma subst_sepcon: forall i v P Q,
+  assert_of (subst i v (P ∗ Q)) = (assert_of (subst i v P) ∗ assert_of (subst i v Q)).
+Proof.
+  intros; rewrite /subst; apply assert_ext; intros; monPred.unseal; done.
+Qed.
 
-Lemma subst_wand: forall i v (P Q: environ->mpred),
-  subst i v (P -* Q) = (subst i v P -* subst i v Q).
-Proof. reflexivity. Qed.
-#[export] Hint Rewrite subst_wand : subst.
+Lemma subst_wand: forall i v P Q,
+  (assert_of (subst i v (P -∗ Q)%I)) = (assert_of (subst i v P) -∗ assert_of (subst i v Q))%I.
+Proof.
+  intros; rewrite /subst; apply assert_ext; intros; monPred.unseal.
+  ouPred.unseal; apply IProp_eq; extensionality n x; apply prop_ext.
+  split; intros ??????? [=]; subst; by apply H.
+Qed.
 
 Lemma subst_exp:
-  forall (A B: Type) (NA : NatDed A) (a : ident) (v : environ -> val) (P: B -> environ -> A),
-    subst a v (EX b: B, P b) = EX b: B, subst a v (P b).
-Proof. intros; reflexivity. Qed.
+  forall (B: Type) (a : ident) (v : environ -> val) (P: B -> assert),
+    assert_of (subst a v (∃ b: B, P b)) = ∃ b: B, assert_of (subst a v (P b)).
+Proof.
+  intros; rewrite /subst; apply assert_ext; intros; monPred.unseal; done.
+Qed.
 
 Lemma env_set_env_set: forall id v1 v2 rho, env_set (env_set rho id v1) id v2 = env_set rho id v2.
 Proof.
@@ -287,12 +385,12 @@ Proof.
   apply Map.ext. intro j.
   destruct (eq_dec id j). subst. repeat rewrite Map.gss. f_equal.
   simpl.
-  repeat rewrite Map.gso by auto. auto.
+  repeat rewrite -> Map.gso by auto. auto.
 Qed.
 
 Lemma env_set_eval_id: forall id rho Delta t,
   tc_environ Delta rho ->
-  (temp_types Delta) ! id = Some t ->
+  (temp_types Delta) !! id = Some t ->
   env_set rho id (eval_id id rho) = rho.
 Proof.
   intros.
@@ -320,11 +418,9 @@ Proof.
  apply Map.ext. intro j.
  destruct (eq_dec i j). subst. repeat rewrite Map.gss. f_equal.
  simpl.
- repeat rewrite Map.gso by auto. auto.
+ repeat rewrite -> Map.gso by auto. auto.
 Qed.
 
-#[export] Hint Rewrite @resubst : subst.
-
 Lemma resubst_full: forall {A} i (v: environ -> val) v1 (e: environ -> A), subst i v1 (subst i v e) = subst i (subst i v1 v) e.
 Proof.
   intros.
@@ -335,32 +431,34 @@ Proof.
  apply Map.ext. intro j.
  destruct (eq_dec i j). subst. repeat rewrite Map.gss. f_equal.
  simpl.
- repeat rewrite Map.gso by auto. auto.
+ repeat rewrite -> Map.gso by auto. auto.
 Qed.
 
-Lemma subst_ewand: forall i v (P Q: environ->mpred),
+(*Lemma subst_ewand: forall i v (P Q: environ->mpred),
   subst i v (ewand P Q) = ewand (subst i v P) (subst i v Q).
 Proof. reflexivity. Qed.
-#[export] Hint Rewrite subst_ewand : subst.
+#[export] Hint Rewrite subst_ewand : subst.*)
 
-Lemma subst_andp {A}{NA: NatDed A}:
-  forall id v (P Q: environ-> A), subst id v (P && Q) = subst id v P && subst id v Q.
+(* What's the best way to do this? *)
+Lemma subst_proper: forall i v (P Q : assert), P ⊣⊢ Q -> assert_of (subst i v P) ⊣⊢ assert_of (subst i v Q).
 Proof.
-intros.
-extensionality rho; unfold subst; simpl.
-auto.
+  intros; split => rho; rewrite /= /subst H //.
+Qed.
+
+Lemma subst_andp: forall id v P Q,
+  assert_of (subst id v (P ∧ Q)) = (assert_of (subst id v P) ∧ assert_of (subst id v Q)).
+Proof.
+  intros; rewrite /subst; apply assert_ext; intros; monPred.unseal; done.
 Qed.
 
-Lemma subst_prop {A}{NA: NatDed A}: forall i v P,
-    subst i v (prop P) = prop P.
+Lemma subst_prop: forall i v (P : Prop),
+    assert_of (subst i v (⌜P⌝ : assert)) = ⌜P⌝.
 Proof.
-intros; reflexivity.
+  intros; rewrite /subst; apply assert_ext; intros; monPred.unseal; done.
 Qed.
-#[export] Hint Rewrite @subst_andp subst_prop : subst.
 
 Lemma eval_expr_Econst_int: forall {cs: compspecs}  i t, eval_expr (Econst_int i t) = `(Vint i).
 Proof. reflexivity. Qed.
-#[export] Hint Rewrite @eval_expr_Econst_int : eval.
 
 Lemma subst_eval_var:
   forall id v id' t, subst id v (eval_var id' t) = eval_var id' t.
@@ -368,59 +466,60 @@ Proof.
 intros. unfold subst, eval_var. extensionality rho.
 simpl. auto.
 Qed.
-#[export] Hint Rewrite subst_eval_var : subst.
 
-Lemma subst_local: forall id v P,
+Lemma subst_local: forall id v (P : environ -> Prop),
   subst id v (local P) = local (subst id v P).
 Proof. reflexivity. Qed.
-#[export] Hint Rewrite subst_local : subst.
 
 Lemma eval_lvalue_Ederef:
   forall {cs: compspecs}  e t, eval_lvalue (Ederef e t) = eval_expr e.
 Proof. reflexivity. Qed.
-#[export] Hint Rewrite @eval_lvalue_Ederef : eval.
 
-Lemma local_lift0_True:     local (`True) = TT.
-Proof. reflexivity. Qed.
-#[export] Hint Rewrite local_lift0_True : norm2.
+Lemma local_lift0_True:     local (`True%type) = True.
+Proof.
+  rewrite /local; apply assert_ext; intros; monPred.unseal; done.
+Qed.
 
 Lemma overridePost_EK_return:
-  forall Q P, RA_return (overridePost Q P) = RA_return P.
+  forall Q (P : ret_assert), RA_return (overridePost Q P) = RA_return P.
 Proof.
  destruct P; reflexivity.
 Qed.
-#[export] Hint Rewrite overridePost_EK_return : ret_assert.
 
 Lemma frame_ret_assert_emp:
-  forall P, frame_ret_assert P emp = P.
+  forall (P : ret_assert), frame_ret_assert P emp = P.
 Proof. intros.
- destruct P; simpl; f_equal; extensionality; try extensionality; normalize.
+  destruct P; simpl; f_equal; last extensionality; apply sep_emp'.
 Qed.
 
 Lemma frame_ret_assert_EK_return:
- forall P Q vl, RA_return (frame_ret_assert P Q) vl =  RA_return P vl * Q.
+ forall (P : ret_assert) Q vl, RA_return (frame_ret_assert P Q) vl = (RA_return P vl ∗ Q).
 Proof.
  destruct P; simpl; reflexivity.
 Qed.
-#[export] Hint Rewrite frame_ret_assert_EK_return : ret_assert.
 
 Lemma function_body_ret_assert_EK_return:
   forall t P vl, RA_return (function_body_ret_assert t P) vl = bind_ret vl t P.
 Proof. reflexivity. Qed.
-#[export] Hint Rewrite function_body_ret_assert_EK_return : ret_assert.
+
+Lemma bind_ret0_unfold:
+  forall Q, bind_ret None tvoid Q = (assert_of (fun rho => Q (globals_only rho))).
+Proof.
+  intros; rewrite /bind_ret; apply assert_ext; intros; monPred.unseal; done.
+Qed.
 
 Lemma bind_ret1_unfold:
-  forall v t Q, bind_ret (Some v) t Q = !!tc_val t v && `Q (make_args (ret_temp :: nil)(v::nil)).
-Proof. reflexivity. Qed.
-#[export] Hint Rewrite bind_ret1_unfold : norm2.
+  forall v t Q, bind_ret (Some v) t Q = (⌜tc_val t v⌝ ∧ assert_of (fun rho => Q (make_args (ret_temp :: nil)(v::nil) rho))).
+Proof.
+  intros; rewrite /bind_ret; apply assert_ext; intros; monPred.unseal; done.
+Qed.
 
 Lemma bind_ret1_unfold':
   forall v t Q rho,
-  bind_ret (Some v) t Q rho = !!(tc_val t v) && Q (make_args (ret_temp::nil)(v::nil) rho).
+  bind_ret (Some v) t Q rho = (⌜tc_val t v⌝ ∧ Q (make_args (ret_temp::nil)(v::nil) rho)).
 Proof.
- intros. reflexivity.
+ intros. rewrite /bind_ret; monPred.unseal. reflexivity.
 Qed.
-#[export] Hint Rewrite bind_ret1_unfold' : norm2.  (* put this in AFTER the unprimed version, for higher priority *)
 
 Lemma normal_ret_assert_elim:
  forall P, RA_normal (normal_ret_assert P) = P.
@@ -429,35 +528,31 @@ reflexivity.
 Qed.
 
 Lemma overridePost_EK_break:
- forall P Q, RA_break (overridePost P Q) = RA_break Q.
+ forall P (Q : ret_assert), RA_break (overridePost P Q) = RA_break Q.
 Proof. destruct Q; reflexivity.
 Qed.
 
 Lemma loop1_ret_assert_EK_break:
- forall P Q, RA_break (loop1_ret_assert P Q) = RA_normal Q.
-Proof. destruct Q;   reflexivity.
+ forall P (Q : ret_assert), RA_break (loop1_ret_assert P Q) = RA_normal Q.
+Proof. destruct Q; reflexivity.
 Qed.
 
-#[export] Hint Rewrite overridePost_EK_break loop1_ret_assert_EK_break
-  normal_ret_assert_elim : ret_assert.
-
 Lemma loop1_ret_assert_normal:
-  forall P Q, RA_normal (loop1_ret_assert P Q) = P.
-Proof. 
+  forall P (Q : ret_assert), RA_normal (loop1_ret_assert P Q) = P.
+Proof.
   destruct Q; reflexivity.
 Qed.
-#[export] Hint Rewrite loop1_ret_assert_normal: ret_assert.
 
+Definition make_args' (fsig: funsig) args rho :=
+   make_args (map (@fst _ _) (fst fsig)) (args rho) rho.
 Lemma unfold_make_args': forall fsig args rho,
     make_args' fsig args rho = make_args (map (@fst _ _) (fst fsig)) (args rho) rho.
 Proof. reflexivity. Qed.
-#[export] Hint Rewrite unfold_make_args' : norm2.
 Lemma unfold_make_args_cons: forall i il v vl rho,
    make_args (i::il) (v::vl) rho = env_set (make_args il vl rho) i v.
 Proof. reflexivity. Qed.
 Lemma unfold_make_args_nil: make_args nil nil = globals_only.
 Proof. reflexivity. Qed.
-#[export] Hint Rewrite unfold_make_args_cons unfold_make_args_nil : norm2.
 
 Lemma clear_rhox:  (* replaces clear_make_args' *)
  forall (P: mpred) (f: environ -> environ),
@@ -465,7 +560,6 @@ Lemma clear_rhox:  (* replaces clear_make_args' *)
                     (@liftx (LiftEnviron mpred) P) f
        = `P.
 Proof. intros. reflexivity. Qed.
-#[export] Hint Rewrite clear_rhox: norm2.
 
 Lemma eval_make_args':
   forall (Q: val -> Prop) i fsig args,
@@ -474,7 +568,6 @@ Lemma eval_make_args':
    (make_args' fsig args) =
   `Q (`(eval_id i) (make_args' fsig args)).
 Proof. reflexivity. Qed.
-#[export] Hint Rewrite eval_make_args' : norm2.
 
 Lemma eval_make_args_same:
  forall {cs: compspecs}  i t fsig t0 tl (e: expr) el,
@@ -509,9 +602,6 @@ simpl.
 rewrite Map.gso; auto.
 Qed.
 
-#[export] Hint Rewrite @eval_make_args_same : norm2.
-#[export] Hint Rewrite @eval_make_args_other using (solve [clear; intro Hx; inversion Hx]) : norm.
-
 Infix "oo" := Basics.compose (at level 54, right associativity).
 Arguments Basics.compose {A B C} g f x / .
 
@@ -519,7 +609,6 @@ Lemma compose_backtick:
   forall A B C (F: B -> C) (G: A -> B) (J: environ -> A),
    `F (`G  J) = `(Basics.compose F G) J.
 Proof. reflexivity. Qed.
-#[export] Hint Rewrite compose_backtick : norm.
 
 Lemma compose_eval_make_args_same:
   forall {cs: compspecs}  (Q: val -> Prop) i t fsig t0 tl e el,
@@ -533,7 +622,7 @@ Proof.
 Qed.
 
 Lemma compose_eval_make_args_other:
-  forall {cs: compspecs}  Q i j fsig t0 t t' tl (e: expr) el,
+  forall {cs: compspecs}  (Q : val -> Prop) i j fsig t0 t t' tl (e: expr) el,
    i<>j ->
     @liftx (Tarrow environ (LiftEnviron Prop))
      (Q oo (eval_id i)) (make_args' ((j,t)::fsig, t0) (eval_exprlist (t'::tl) (e::el))) =
@@ -544,24 +633,19 @@ Proof.
   f_equal. apply eval_make_args_other; auto.
 Qed.
 
-#[export] Hint Rewrite @compose_eval_make_args_same : norm.
-#[export] Hint Rewrite @compose_eval_make_args_other using (solve [clear; intro Hx; inversion Hx]) : norm.
-
 Lemma substopt_unfold {A}: forall id v, @substopt A (Some id) v = @subst A id v.
 Proof. reflexivity. Qed.
 Lemma substopt_unfold_nil {A}: forall v (P:  environ -> A), substopt None v P = P.
 Proof. reflexivity. Qed.
-#[export] Hint Rewrite @substopt_unfold @substopt_unfold_nil : subst.
 
 Lemma get_result_unfold: forall id, get_result (Some id) = get_result1 id.
 Proof. reflexivity. Qed.
 Lemma get_result_None: get_result None = globals_only.
 Proof. reflexivity. Qed.
-#[export] Hint Rewrite get_result_unfold get_result_None : norm.
 
 Lemma elim_globals_only:
   forall Delta g i t rho,
-  tc_environ Delta rho /\ (var_types Delta) ! i = None /\ (glob_types Delta) ! i = Some g ->
+  tc_environ Delta rho /\ (var_types Delta) !! i = None /\ (glob_types Delta) !! i = Some g ->
   eval_var i t (globals_only rho) = eval_var i t rho.
 Proof.
 intros.
@@ -570,22 +654,19 @@ unfold eval_var, globals_only.
 simpl.
 destruct_var_types i.
 destruct_glob_types i.
-rewrite Heqo0, Heqo1.
-auto.
+rewrite Heqo0 Heqo1 //.
 Qed.
-#[export] Hint Rewrite elim_globals_only using (split3; [eassumption | reflexivity.. ]) : norm.
 
 Lemma elim_globals_only':
  forall a: mpred,
  (@liftx (Tarrow environ (LiftEnviron mpred)) (`a) globals_only) = `a.
 Proof. reflexivity. Qed.
-#[export] Hint Rewrite elim_globals_only' : norm.
 
 Lemma globvar_eval_var:
   forall Delta rho id t,
       tc_environ Delta rho ->
-     (var_types Delta) ! id = None ->
-     (glob_types Delta) ! id = Some  t ->
+     (var_types Delta) !! id = None ->
+     (glob_types Delta) !! id = Some  t ->
      exists b,  eval_var id t rho = Vptr b Ptrofs.zero
             /\ Map.get (ge_of rho) id = Some b.
 Proof.
@@ -593,22 +674,20 @@ intros.
 unfold eval_var; simpl.
 destruct_var_types id.
 destruct_glob_types id.
-rewrite Heqo0, Heqo1.
+rewrite Heqo0 Heqo1.
 eauto.
 Qed.
 
 Lemma globvars2pred_unfold: forall gv vl,
-    globvars2pred gv vl = fold_right sepcon emp (map (globvar2pred gv) vl).
+    globvars2pred gv vl = [∗] (map (globvar2pred gv) vl).
 Proof. easy. Qed.
-#[export] Hint Rewrite globvars2pred_unfold : norm.
-#[export] Hint Rewrite @exp_trivial : norm.
 
 Lemma eval_var_isptr:
   forall Delta t i rho,
             tc_environ Delta rho ->
-            ((var_types Delta) ! i = Some t \/
-             (var_types Delta)!i = None /\
-            (glob_types Delta) ! i = Some t) ->
+            ((var_types Delta) !! i = Some t \/
+             (var_types Delta) !! i = None /\
+            (glob_types Delta) !! i = Some t) ->
             isptr (eval_var i t rho).
 Proof.
  intros.
@@ -620,356 +699,351 @@ Proof.
    auto.
  + destruct_var_types i.
    destruct_glob_types i.
-   rewrite Heqo0, Heqo1.
-   auto.
+   rewrite Heqo0 Heqo1 //.
 Qed.
 
 Lemma ENTAIL_trans:
   forall Delta P Q R,
-  (local (tc_environ Delta) && P |-- Q) ->
-  (local (tc_environ Delta) && Q |-- R) ->
-  local (tc_environ Delta) && P |-- R.
+  (local (tc_environ Delta) ∧ P ⊢ Q) ->
+  (local (tc_environ Delta) ∧ Q ⊢ R) ->
+  local (tc_environ Delta) ∧ P ⊢ R.
 Proof.
-intros.
-eapply derives_trans.
-apply andp_right; [ | apply H].
-apply andp_left1; apply derives_refl.
-auto.
+intros ????? <-; rewrite -H.
+iIntros "(? & $)"; auto.
 Qed.
 
 Lemma ENTAIL_refl:
   forall Delta P,
-  local (tc_environ Delta) && P |-- P.
-Proof. intros. apply andp_left2, derives_refl. Qed.
-
-Lemma corable_andp_bupd: forall (P Q: environ -> mpred),
-  corable P ->
-  (P && |==> Q) |-- |==> P && Q.
+  local (tc_environ Delta) ∧ P ⊢ P.
 Proof.
-  intros.
-  rewrite !(andp_comm P).
-  apply bupd_andp2_corable; auto.
+  intros; apply bi.and_elim_r.
 Qed.
 
-Lemma corable_andp_fupd: forall E1 E2 (P Q: environ -> mpred),
-  corable P ->
-  (P && |={E1,E2}=> Q) |-- |={E1,E2}=> P && Q.
-Proof.
-  intros.
-  rewrite !(andp_comm P).
-  apply fupd_andp2_corable; auto.
-Qed.
-
-Lemma local_andp_fupd: forall E1 E2 P Q,
-  (local P && |={E1,E2}=> Q) |-- |={E1,E2}=> (local P && Q).
-Proof.
-  intros.
-  rewrite !(andp_comm (local P)).
-  apply fupd_andp2_corable.
-  intro; apply corable_prop.
-Qed.
-
-Lemma fupd_andp_local: forall E1 E2 P Q,
-  (|={E1,E2}=> P) && local Q |-- |={E1,E2}=> (P && local Q).
-Proof.
-  intros.
-  apply fupd_andp2_corable.
-  intro; apply corable_prop.
-Qed.
+Implicit Type (R : assert).
 
 Lemma derives_fupd_trans: forall TC E1 E2 E3 P Q R,
-  (local TC && P |-- (|={E1,E2}=> Q)) ->
-  (local TC && Q |-- (|={E2,E3}=> R)) ->
-  local TC && P |-- (|={E1,E3}=> R).
+  (local TC ∧ P ⊢ (|={E1,E2}=> Q)) ->
+  (local TC ∧ Q ⊢ (|={E2,E3}=> R)) ->
+  local TC ∧ P ⊢ (|={E1,E3}=> R).
 Proof.
   intros.
-  rewrite (add_andp _ _ H).
-  rewrite (andp_comm _ P), andp_assoc; apply andp_left2.
-  eapply derives_trans; [apply local_andp_fupd |].
-  rewrite (add_andp _ _ H0).
-  rewrite (andp_comm _ Q), andp_assoc; eapply derives_trans; [apply fupd_mono, andp_left2, derives_refl |].
-  eapply derives_trans; [apply fupd_mono,local_andp_fupd |].
-  eapply derives_trans; [apply fupd_trans|].
-  apply fupd_mono; solve_andp.
+  iIntros "(#? & ?)".
+  iMod (H with "[$]"); iApply H0; iFrame; auto.
 Qed.
 
 Lemma derives_fupd_refl: forall TC E P,
-  local TC && P |-- |={E}=> P.
-Proof. intros. apply andp_left2, fupd_intro. Qed.
+  local TC ∧ P ⊢ |={E}=> P.
+Proof. intros; by iIntros "(_ & $)". Qed.
 
 Lemma derives_full_refl: forall Delta E P,
-  local (tc_environ Delta) && (allp_fun_id Delta && P) |-- |={E}=> P.
-Proof. intros. refine (derives_trans _ _ _ _ (derives_fupd_refl (tc_environ Delta) _ P)). solve_andp. Qed.
+  local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢ |={E}=> P.
+Proof. intros; by iIntros "(_ & _ & $)". Qed.
 
 Lemma derives_full_trans: forall Delta E P Q R,
-  (local (tc_environ Delta) && (allp_fun_id Delta && P) |-- (|={E}=> (Q))) ->
-  (local (tc_environ Delta) && (allp_fun_id Delta && Q) |-- (|={E}=> (R))) ->
-  local (tc_environ Delta) && (allp_fun_id Delta && P) |-- (|={E}=> (R)).
+  (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢ (|={E}=> (Q))) ->
+  (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ Q) ⊢ (|={E}=> (R))) ->
+  local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢ (|={E}=> (R)).
 Proof.
   intros.
-  eapply derives_fupd_trans; [| exact H0].
-  rewrite (add_andp _ _ H).
-  apply derives_trans with ((|={E}=> Q) && allp_fun_id Delta); [solve_andp |].
-  eapply derives_trans; [apply fupd_andp2_corable; intro; apply corable_allp_fun_id |].
-  rewrite andp_comm; auto.
+  eapply derives_fupd_trans, H0.
+  iIntros "(? & #$ & ?)".
+  by iApply H; iFrame.
 Qed.
 
 Lemma derives_ENTAIL: forall TC P Q,
-  (P |-- Q) ->
-  local TC && P |-- Q.
-Proof. intros. apply andp_left2, H. Qed.
+  (P ⊢ Q) ->
+  local TC ∧ P ⊢ Q.
+Proof. intros ??? ->; apply bi.and_elim_r. Qed.
 
 Lemma ENTAIL_derives_fupd: forall TC E P Q,
-  (local TC && P |-- Q) ->
-  local TC && P |-- |={E}=> Q.
-Proof. intros. apply (derives_trans _ _ _ H), fupd_intro. Qed.
+  (local TC ∧ P ⊢ Q) ->
+  local TC ∧ P ⊢ |={E}=> Q.
+Proof. intros. rewrite H; apply fupd_intro. Qed.
 
 Lemma derives_fupd_derives_full: forall Delta E P Q,
-  (local (tc_environ Delta) && P |-- (|={E}=> Q)) ->
-  local (tc_environ Delta) && (allp_fun_id Delta && P) |-- (|={E}=> Q).
-Proof. intros. refine (derives_trans _ _ _ _ H). solve_andp. Qed.
+  (local (tc_environ Delta) ∧ P ⊢ (|={E}=> Q)) ->
+  local (tc_environ Delta) ∧ (allp_fun_id Delta ∧ P) ⊢ (|={E}=> Q).
+Proof.
+  intros. rewrite -H. iIntros "(? & _ & $)"; auto.
+Qed.
 
 Lemma andp_ENTAIL: forall TC P P' Q Q',
-  (local TC && P |-- P') ->
-  (local TC && Q |-- Q') ->
-  local TC && (P && Q) |-- P' && Q'.
+  (local TC ∧ P ⊢ P') ->
+  (local TC ∧ Q ⊢ Q') ->
+  local TC ∧ (P ∧ Q) ⊢ P' ∧ Q'.
 Proof.
-  intros.
-  eapply derives_trans; [| apply andp_derives; [exact H | exact H0]].
-  solve_andp.
+  intros ????? <- <-.
+  iIntros "(? & ?)"; iSplit; [rewrite bi.and_elim_l | rewrite bi.and_elim_r]; auto.
 Qed.
 
 Lemma orp_ENTAIL: forall TC P P' Q Q',
-  (local TC && P |-- P') ->
-  (local TC && Q |-- Q') ->
-  local TC && (P || Q) |-- P' || Q'.
+  (local TC ∧ P ⊢ P') ->
+  (local TC ∧ Q ⊢ Q') ->
+  local TC ∧ (P ∨ Q) ⊢ P' ∨ Q'.
 Proof.
-  intros.
-  rewrite andp_comm, distrib_orp_andp.
-  apply orp_derives; rewrite andp_comm; auto.
+  intros ????? <- <-.
+  iIntros "(? & [? | ?])"; auto.
 Qed.
 
 Lemma sepcon_ENTAIL: forall TC P P' Q Q',
-  (local TC && P |-- P') ->
-  (local TC && Q |-- Q') ->
-  local TC && (P * Q) |-- P' * Q'.
+  (local TC ∧ P ⊢ P') ->
+  (local TC ∧ Q ⊢ Q') ->
+  local TC ∧ (P ∗ Q) ⊢ P' ∗ Q'.
 Proof.
-  intros.
-  eapply derives_trans; [| apply sepcon_derives; [exact H | exact H0]].
-  rewrite corable_andp_sepcon1, corable_sepcon_andp1 by (intro; apply corable_prop).
-  solve_andp.
+  intros ????? <- <-.
+  iIntros "(? & $ & $)".
+  iSplit; first iModIntro; iSplit; done.
 Qed.
 
 Lemma wand_ENTAIL: forall TC P P' Q Q',
-  (local TC && P' |-- P) ->
-  (local TC && Q |-- Q') ->
-  local TC && (P -* Q) |-- P' -* Q'.
+  (local TC ∧ P' ⊢ P) ->
+  (local TC ∧ Q ⊢ Q') ->
+  local TC ∧ (P -∗ Q) ⊢ P' -∗ Q'.
 Proof.
-  intros.
-  rewrite <- wand_sepcon_adjoint.
-  eapply derives_trans; [| apply H0].
-  rewrite corable_andp_sepcon1 by (intro; apply corable_prop).
-  apply andp_right; [apply andp_left1, derives_refl |].
-  rewrite <- corable_sepcon_andp1 by (intro; apply corable_prop).
-  rewrite sepcon_comm, wand_sepcon_adjoint.
-  eapply derives_trans; [apply H |].
-  rewrite <- wand_sepcon_adjoint.
-  apply modus_ponens_wand.
+  intros ????? <- <-.
+  iIntros "(? & H) ?"; iSplit; first done.
+  iApply "H"; iFrame.
 Qed.
 
-Lemma exp_ENTAIL: forall Delta B (P Q: B -> environ -> mpred),
-  (forall x: B, local (tc_environ Delta) && P x |-- Q x) ->
-  local (tc_environ Delta) && exp P |-- exp Q.
+Lemma exp_ENTAIL: forall Delta B (P Q: B -> assert),
+  (forall x: B, local (tc_environ Delta) ∧ P x ⊢ Q x) ->
+  local (tc_environ Delta) ∧ (∃ y, P y) ⊢ ∃ y, Q y.
 Proof.
   intros.
-  rewrite exp_andp2.
-  apply exp_derives; auto.
+  iIntros "(? & %y & P)".
+  iExists y; rewrite -H; iFrame.
 Qed.
 
-Lemma allp_ENTAIL: forall Delta B (P Q: B -> environ -> mpred),
-  (forall x: B, local (tc_environ Delta) && P x |-- Q x) ->
-  local (tc_environ Delta) && allp P |-- allp Q.
+Lemma allp_ENTAIL: forall Delta B (P Q: B -> assert),
+  (forall x: B, local (tc_environ Delta) ∧ P x ⊢ Q x) ->
+  local (tc_environ Delta) ∧ (∀ y, P y) ⊢ ∀ y, Q y.
 Proof.
   intros.
-  apply allp_right; intro y.
-  rewrite andp_comm.
-  apply imp_andp_adjoint.
-  apply allp_left with y.
-  apply imp_andp_adjoint.
-  rewrite andp_comm.
-  apply H.
+  iIntros "H" (?); rewrite -H.
+  iApply (bi.and_mono with "H"); eauto.
 Qed.
 
 Lemma later_ENTAIL: forall Delta P Q,
-  (local (tc_environ Delta) && P |-- Q) ->
-  local (tc_environ Delta) && |> P |-- |> Q.
+  (local (tc_environ Delta) ∧ P ⊢ Q) ->
+  local (tc_environ Delta) ∧ ▷ P ⊢ ▷ Q.
 Proof.
   intros.
-  apply later_left2, H.
+  iIntros "? !>"; by iApply H.
 Qed.
 
 Lemma andp_ENTAILL: forall Delta P P' Q Q',
-  (local (tc_environ Delta) && (allp_fun_id Delta && P) |-- P') ->
-  (local (tc_environ Delta) && (allp_fun_id Delta && Q) |-- Q') ->
-  local (tc_environ Delta) && (allp_fun_id Delta && (P && Q)) |-- P' && Q'.
+  (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢ P') ->
+  (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ Q) ⊢ Q') ->
+  local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ (P ∧ Q)) ⊢ P' ∧ Q'.
 Proof.
-  intros.
-  eapply derives_trans; [| apply andp_derives; [exact H | exact H0]].
-  solve_andp.
+  intros ????? <- <-.
+  iIntros "(? & ? & ?)"; iSplit; [rewrite bi.and_elim_l | rewrite bi.and_elim_r]; auto.
 Qed.
 
 Lemma orp_ENTAILL: forall Delta P P' Q Q',
-  (local (tc_environ Delta) && (allp_fun_id Delta && P) |-- P') ->
-  (local (tc_environ Delta) && (allp_fun_id Delta && Q) |-- Q') ->
-  local (tc_environ Delta) && (allp_fun_id Delta && (P || Q)) |-- P' || Q'.
+  (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢ P') ->
+  (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ Q) ⊢ Q') ->
+  local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ (P ∨ Q)) ⊢ P' ∨ Q'.
 Proof.
-  intros.
-  rewrite <- andp_assoc in *.
-  rewrite andp_comm, distrib_orp_andp.
-  apply orp_derives; rewrite andp_comm; auto.
+  intros ????? <- <-.
+  iIntros "(? & ? & [? | ?])"; auto.
 Qed.
 
 Lemma imp_ENTAILL: forall Delta P P' Q Q',
-  local (tc_environ Delta) && (allp_fun_id Delta && P') |-- P ->
-  local (tc_environ Delta) && (allp_fun_id Delta && Q) |-- Q' ->
-  local (tc_environ Delta) && (allp_fun_id Delta && (P -->Q)) |-- P' --> Q'.
+  (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P') ⊢ P) ->
+  (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ Q) ⊢ Q') ->
+  local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ (P → Q)) ⊢ P' → Q'.
 Proof.
-  intros.
-  rewrite <- andp_assoc in *.
-  rewrite <- imp_andp_adjoint.
-  eapply derives_trans; [| apply H0].
-  apply andp_right; [apply andp_left1, andp_left1, derives_refl |].
-  rewrite !andp_assoc, (andp_comm _ P'), <- !andp_assoc.
-  apply imp_andp_adjoint.
-  eapply derives_trans; [apply H |].
-  apply imp_andp_adjoint.
-  apply modus_ponens.
+  intros ????? <- <-.
+  iIntros "H"; iApply bi.impl_intro_r; last iApply "H".
+  iIntros "H"; iSplit; first by iDestruct "H" as "((? & _ & _) & _)".
+  iSplit; first by iDestruct "H" as "((_ & $ & _) & _)".
+  iApply (bi.impl_elim with "H").
+  - iIntros "((_ & _ & $) & _)".
+  - rewrite -bi.and_assoc {1}(persistent (allp_fun_id _)).
+    rewrite -bi.persistently_and_intuitionistically_sep_l -bi.and_assoc.
+    iIntros "(? & ? & _ & $)"; iFrame.
+    by iApply bi.intuitionistically_affinely.
 Qed.
 
 Lemma sepcon_ENTAILL: forall Delta P P' Q Q',
-  (local (tc_environ Delta) && (allp_fun_id Delta && P) |-- P') ->
-  (local (tc_environ Delta) && (allp_fun_id Delta && Q) |-- Q') ->
-  local (tc_environ Delta) && (allp_fun_id Delta && (P * Q)) |-- P' * Q'.
+  (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢ P') ->
+  (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ Q) ⊢ Q') ->
+  local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ (P ∗ Q)) ⊢ P' ∗ Q'.
 Proof.
-  intros.
-  rewrite <- andp_assoc in *.
-  eapply derives_trans; [| apply sepcon_derives; [exact H | exact H0]].
-  rewrite corable_andp_sepcon1, corable_sepcon_andp1 by (intro; simpl; apply corable_andp; [apply corable_prop | apply corable_allp_fun_id]).
-  solve_andp.
+  intros ????? <- <-.
+  iIntros "(#? & #? & $ & $)"; auto.
 Qed.
 
 Lemma wand_ENTAILL: forall Delta P P' Q Q',
-  (local (tc_environ Delta) && (allp_fun_id Delta && P') |-- P) ->
-  (local (tc_environ Delta) && (allp_fun_id Delta && Q) |-- Q') ->
-  local (tc_environ Delta) && (allp_fun_id Delta && (P -* Q)) |-- P' -* Q'.
+  (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P') ⊢ P) ->
+  (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ Q) ⊢ Q') ->
+  local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ (P -∗ Q)) ⊢ P' -∗ Q'.
 Proof.
-  intros.
-  rewrite <- andp_assoc in *.
-  rewrite <- wand_sepcon_adjoint.
-  eapply derives_trans; [| apply H0].
-  rewrite corable_andp_sepcon1 by (intro; simpl; apply corable_andp; [apply corable_prop | apply corable_allp_fun_id]).
-  apply andp_right; [apply andp_left1, derives_refl |].
-  rewrite <- corable_sepcon_andp1 by (intro; simpl; apply corable_andp; [apply corable_prop | apply corable_allp_fun_id]).
-  rewrite sepcon_comm, wand_sepcon_adjoint.
-  eapply derives_trans; [apply H |].
-  rewrite <- wand_sepcon_adjoint.
-  apply modus_ponens_wand.
-Qed.
-
-Lemma exp_ENTAILL: forall Delta B (P Q: B -> environ -> mpred),
-  (forall x: B, local (tc_environ Delta) && (allp_fun_id Delta && P x) |-- Q x) ->
-  local (tc_environ Delta) && (allp_fun_id Delta && exp P) |-- exp Q.
+  intros ????? <- <-.
+  iIntros "(? & ? & H) ?"; iSplit; first done; iSplit; first done.
+  iApply "H"; iFrame.
+Qed.
+
+Lemma exp_ENTAILL: forall Delta B (P Q: B -> assert),
+  (forall x: B, local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P x) ⊢ Q x) ->
+  local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ ∃ y, P y) ⊢ ∃ y, Q y.
 Proof.
   intros.
-  rewrite !exp_andp2.
-  apply exp_derives; auto.
+  iIntros "(? & ? & %y & P)".
+  iExists y; rewrite -H; iFrame.
 Qed.
 
-Lemma allp_ENTAILL: forall Delta B (P Q: B -> environ -> mpred),
-  (forall x: B, local (tc_environ Delta) && (allp_fun_id Delta && P x) |-- Q x) ->
-  local (tc_environ Delta) && (allp_fun_id Delta && allp P) |-- allp Q.
+Lemma allp_ENTAILL: forall Delta B (P Q: B -> assert),
+  (forall x: B, local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P x) ⊢ Q x) ->
+  local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ ∀ y, P y) ⊢ ∀ y, Q y.
 Proof.
   intros.
-  apply allp_right; intro y.
-  rewrite <- andp_assoc, andp_comm.
-  apply imp_andp_adjoint.
-  apply allp_left with y.
-  apply imp_andp_adjoint.
-  rewrite andp_comm, andp_assoc.
-  apply H.
+  iIntros "H" (?); rewrite -H.
+  iApply (bi.and_mono with "H"); eauto.
+  iIntros "($ & ?)"; eauto.
 Qed.
 
 Lemma later_ENTAILL: forall Delta P Q,
-  (local (tc_environ Delta) && (allp_fun_id Delta && P) |-- Q) ->
-  local (tc_environ Delta) && (allp_fun_id Delta && |> P) |-- |> Q.
+  (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢ Q) ->
+  local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ ▷ P) ⊢ ▷ Q.
 Proof.
-  intros.
-  rewrite <- andp_assoc in *.
-  apply later_left2, H.
+  intros ??? <-.
+  by iIntros "? !>".
 Qed.
 
 Lemma andp_subst_ENTAILL: forall Delta P P' Q Q' i v t,
-  (temp_types Delta) ! i = Some t ->
-  (local (tc_environ Delta) && (allp_fun_id Delta && P') |-- local (`(tc_val' t) v)) ->
-  (local (tc_environ Delta) && (allp_fun_id Delta && P') |-- Q') ->
-  (local (tc_environ Delta) && (allp_fun_id Delta && P) |-- Q) ->
-  local (tc_environ Delta) && (allp_fun_id Delta && (P' && subst i v P)) |-- Q' && subst i v Q.
+  (temp_types Delta) !! i = Some t ->
+  (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P') ⊢ local (`(tc_val' t) v)) ->
+  (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P') ⊢ Q') ->
+  (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢ Q) ->
+  local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ (P' ∧ assert_of (subst i v P))) ⊢ Q' ∧ assert_of (subst i v Q).
 Proof.
-  intros.
-  apply (subst_derives i v) in H2.
-  autorewrite with subst in H2.
-  eapply derives_trans; [| apply andp_derives; eassumption].
-  repeat apply andp_right; try solve_andp.
-  rewrite <- !andp_assoc; apply andp_left1; rewrite andp_assoc.
-  rewrite (add_andp _ _ H0).
-  unfold local, lift1; unfold_lift.
-  intro rho; simpl; normalize; clear H0 H1 H2.
-  apply prop_right.
-  unfold subst, env_set.
-  destruct rho; simpl in *.
-  destruct H3; split; auto.
-  clear H1; simpl in *.
-  hnf; intros.
-  specialize (H0 _ _ H1).
-  destruct H0 as [? [? ?]].
-  destruct (Pos.eq_dec i id).
-  + subst.
-    rewrite Map.gss.
-    exists (v (mkEnviron ge ve te)); split; auto.
-    rewrite H in H1.
-    inv H1.
-    auto.
-  + exists x.
-    rewrite Map.gso by auto.
-    auto.
+  intros ?????????? <- ?.
+  iIntros "H".
+  iAssert (local (`(tc_val' t) v)) as "#Hty".
+  { iDestruct "H" as "(? & ? & ? & _)".
+    iApply (H0 with "[$]"). }
+  assert (local ((` (tc_val' t)) v) ∧ local (tc_environ Delta) ∧ <affine> allp_fun_id Delta ∗ assert_of (subst i v P) ⊢ assert_of (subst i v Q)) as <-.
+  2: { iDestruct "H" as "(? & ? & ?)"; iSplit; iSplit; auto.
+       * rewrite bi.and_elim_l; iFrame.
+       * rewrite bi.and_elim_r; iFrame. }
+  split => rho; rewrite /subst /= -H1; monPred.unseal.
+  rewrite !monPred_at_affinely.
+  iIntros "(% & %TC & $ & $)"; iPureIntro.
+  split; auto; unfold tc_environ, typecheck_environ in *.
+  destruct TC as (TC & ? & ?); split3; auto; simpl.
+  intros ?? Ht.
+  destruct (eq_dec id i).
+  + subst; rewrite Map.gss.
+    eexists; split; first done.
+    assert (t = ty) as -> by congruence.
+    apply TC in H as (? & ? & ?); eauto.
+  + rewrite Map.gso; eauto.
 Qed.
 
 Lemma derives_fupd_fupd_left: forall TC E P Q,
-  (local TC && P |-- (|={E}=> Q)) ->
-  (local TC && |={E}=> P) |-- |={E}=> Q.
+  (local TC ∧ P ⊢ (|={E}=> Q)) ->
+  (local TC ∧ |={E}=> P) ⊢ |={E}=> Q.
 Proof.
   intros.
-  eapply derives_trans; [apply local_andp_fupd |].
-  eapply derives_trans; [apply fupd_mono, H |].
-  apply fupd_trans.
+  iIntros "(? & >?)"; iApply H; iFrame.
 Qed.
 
 Lemma derives_full_fupd_left: forall Delta E P Q,
-  (local (tc_environ Delta) && (allp_fun_id Delta && P) |-- (|={E}=> Q)) ->
-  local (tc_environ Delta) && (allp_fun_id Delta && |={E}=> P) |-- |={E}=> Q.
+  (local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢ (|={E}=> Q)) ->
+  local (tc_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ |={E}=> P) ⊢ |={E}=> Q.
 Proof.
   intros.
-  rewrite <- andp_assoc in H |- *.
-  eapply derives_trans; [apply corable_andp_fupd; intro; simpl; apply corable_andp; [apply corable_prop | apply corable_allp_fun_id] |].
-  eapply derives_trans; [apply fupd_mono | apply fupd_trans]; auto.
+  iIntros "(? & ? & >?)"; iApply H; iFrame.
 Qed.
 
+Lemma aux2_reduceR: forall E P Q,
+  (P ⊢ Q) ->
+  P ⊢ |={E}=> Q.
+Proof.
+  intros ??? <-; apply fupd_intro.
+Qed.
+
+Lemma aux_reduceL: forall P Q R S,
+  (P ∧ R ⊢ S) ->
+  P ∧ (<affine> Q ∗ R) ⊢ S.
+Proof.
+  intros ???? <-.
+  iIntros "H"; iSplit; [iDestruct "H" as "($ & _)" | iDestruct "H" as "(_ & _ & $)"].
+Qed.
+
+End mpred.
+
+Infix "oo" := Basics.compose (at level 54, right associativity).
+Arguments Basics.compose {A B C} g f x / .
+
+#[export] Hint Rewrite @loop1x_ret_assert_EK_normal: ret_assert.
+Ltac simpl_ret_assert :=
+ cbn [RA_normal RA_break RA_continue RA_return 
+      normal_ret_assert overridePost loop1_ret_assert
+      loop2_ret_assert function_body_ret_assert frame_ret_assert
+      switch_ret_assert loop1x_ret_assert loop1y_ret_assert
+      for_ret_assert loop_nocontinue_ret_assert];
+  try (match goal with
+      | |- context[bind_ret None tvoid ?P] =>
+        let H:= fresh in
+          assert (bind_ret None tvoid P ⊣⊢ P) as -> by (raise_rho; try monPred.unseal; done)
+      end).
+
+#[export] Hint Rewrite @frame_normal @frame_for1 @frame_loop1
+                 @overridePost_normal: ret_assert.
+#[export] Hint Rewrite @RA_normal_loop2_ret_assert : ret_assert.
+#[export] Hint Rewrite @overridePost_overridePost : ret_assert.
+#[export] Hint Rewrite @overridePost_normal' : ret_assert.
+#[export] Hint Rewrite @liftx_id : norm2.
+#[export] Hint Rewrite @liftx3_liftx2 @liftx2_liftx1 @liftx1_liftx0 : norm2.
+#[export] Hint Rewrite @lift1_lift0 : norm2.
+#[export] Hint Rewrite const_liftx0 : norm2.
+#[export] Hint Rewrite lift_identity : norm2.
+#[export] Hint Rewrite @local_lift2_and : norm2.
+#[export] Hint Rewrite @subst_True @subst_False: subst.
+#[export] Hint Rewrite @subst_sepcon : subst.
+#[export] Hint Rewrite @subst_wand : subst.
+#[export] Hint Rewrite @resubst : subst.
+#[export] Hint Rewrite @subst_andp @subst_prop : subst.
+#[export] Hint Rewrite @eval_expr_Econst_int : eval.
+#[export] Hint Rewrite subst_eval_var : subst.
+#[export] Hint Rewrite @subst_local : subst.
+#[export] Hint Rewrite @eval_lvalue_Ederef : eval.
+#[export] Hint Rewrite @local_lift0_True : norm2.
+#[export] Hint Rewrite @overridePost_EK_return : ret_assert.
+#[export] Hint Rewrite @frame_ret_assert_EK_return : ret_assert.
+#[export] Hint Rewrite @function_body_ret_assert_EK_return : ret_assert.
+#[export] Hint Rewrite @bind_ret1_unfold : norm2.
+#[export] Hint Rewrite @bind_ret1_unfold' : norm2.  (* put this in AFTER the unprimed version, for higher priority *)
+#[export] Hint Rewrite @overridePost_EK_break @loop1_ret_assert_EK_break
+  @normal_ret_assert_elim : ret_assert.
+#[export] Hint Rewrite @loop1_ret_assert_normal: ret_assert.
+#[export] Hint Rewrite unfold_make_args' : norm2.
+#[export] Hint Rewrite unfold_make_args_cons unfold_make_args_nil : norm2.
+#[export] Hint Rewrite @clear_rhox: norm2.
+#[export] Hint Rewrite eval_make_args' : norm2.
+#[export] Hint Rewrite @eval_make_args_same : norm2.
+#[export] Hint Rewrite @eval_make_args_other using (solve [clear; intro Hx; inversion Hx]) : norm.
+
+#[export] Hint Rewrite compose_backtick : norm.
+#[export] Hint Rewrite @compose_eval_make_args_same : norm.
+#[export] Hint Rewrite @compose_eval_make_args_other using (solve [clear; intro Hx; inversion Hx]) : norm.
+#[export] Hint Rewrite @substopt_unfold @substopt_unfold_nil : subst.
+#[export] Hint Rewrite get_result_unfold get_result_None : norm.
+#[export] Hint Rewrite @elim_globals_only using (split3; [eassumption | reflexivity.. ]) : norm.
+#[export] Hint Rewrite @elim_globals_only' : norm.
+#[export] Hint Rewrite @globvars2pred_unfold : norm.
+#[export] Hint Rewrite @exp_trivial : norm.
+
+
 Ltac lifted_derives_L2R H :=
   eapply ENTAIL_trans; [apply H |].
 
 Ltac ENTAIL_L2R H :=
   match type of H with
-  | @derives (environ -> mpred) _ (local (tc_environ _) && _) _ =>
+  | (local (tc_environ _) ∧ _) ⊢ _ =>
       eapply ENTAIL_trans; [apply H |]
   | _ =>
       eapply ENTAIL_trans; [apply derives_ENTAIL, H |]
@@ -977,9 +1051,9 @@ Ltac ENTAIL_L2R H :=
 
 Ltac derives_fupd_L2R H :=
   match type of H with
-  | @derives (environ -> mpred) _ (local (tc_environ _) && _) (|={_,_}=> _) =>
+  | (local (tc_environ _) ∧ _) ⊢ (|={_,_}=> _) =>
       eapply derives_fupd_trans; [apply H |]
-  | @derives (environ -> mpred) _ (local (tc_environ _) && _) _ =>
+  | (local (tc_environ _) ∧ _) ⊢ _ =>
       eapply derives_fupd_trans; [apply ENTAIL_derives_fupd, H |]
   | _ =>
       eapply derives_fupd_trans; [apply ENTAIL_derives_fupd, derives_ENTAIL, H |]
@@ -987,11 +1061,11 @@ Ltac derives_fupd_L2R H :=
 
 Ltac derives_full_L2R H :=
   match type of H with
-  | @derives (environ -> mpred) _ (local (tc_environ ?Delta) && (allp_fun_id ?Delta && _)) (|={_,_}=> _) =>
+  | (local (tc_environ ?Delta) ∧ (<affine> allp_fun_id ?Delta ∗ _)) ⊢ (|={_,_}=> _) =>
       eapply derives_full_trans; [apply H |]
-  | @derives (environ -> mpred) _ (local (tc_environ _) && _) (|={_,_}=> _) =>
+  | (local (tc_environ _) ∧ _) ⊢ (|={_,_}=> _) =>
       eapply derives_full_trans; [apply derives_fupd_derives_full, H |]
-  | @derives (environ -> mpred) _ (local (tc_environ _) && _) _ =>
+  | (local (tc_environ _) ∧ _) ⊢ _ =>
       eapply derives_full_trans; [apply derives_fupd_derives_full, ENTAIL_derives_fupd, H |]
   | _ =>
       eapply derives_full_trans; [apply derives_fupd_derives_full, ENTAIL_derives_fupd, derives_ENTAIL, H |]
@@ -999,22 +1073,22 @@ Ltac derives_full_L2R H :=
 
 Tactic Notation "derives_rewrite" "->" constr(H) :=
   match goal with
-  | |- @derives (environ -> mpred) _ (local (tc_environ ?Delta) && (allp_fun_id ?Delta && _)) (|={_,_}=> _) =>
+  | |- (local (tc_environ ?Delta) ∧ (<affine> allp_fun_id ?Delta ∗ _)) ⊢ (|={_,_}=> _) =>
          derives_full_L2R H
-  | |- @derives (environ -> mpred) _ (local (tc_environ _) && _) (|={_,_}=> _) =>
+  | |- (local (tc_environ _) ∧ _) ⊢ (|={_,_}=> _) =>
          derives_fupd_L2R H
-  | |- @derives (environ -> mpred) _ (local (tc_environ _) && _) _ =>
+  | |- (local (tc_environ _) ∧ _) ⊢ _ =>
          ENTAIL_L2R H
   | |- _ =>
          lifted_derives_L2R H
   end.
 
 Ltac lifted_derives_R2L H :=
-  eapply derives_trans; [| apply H].
+  etrans; [| apply H].
 
 Ltac ENTAIL_R2L H :=
   match type of H with
-  | @derives (environ -> mpred) _ (local (tc_environ _) && _) _ =>
+  | (local (tc_environ _) ∧ _) ⊢ _ =>
       eapply ENTAIL_trans; [| apply H]
   | _ =>
       eapply ENTAIL_trans; [| apply derives_ENTAIL, H]
@@ -1022,9 +1096,9 @@ Ltac ENTAIL_R2L H :=
 
 Ltac derives_fupd_R2L H :=
   match type of H with
-  | @derives (environ -> mpred) _ (local (tc_environ _) && _) (|={_,_}=> _) =>
+  | (local (tc_environ _) ∧ _) ⊢ (|={_,_}=> _) =>
       eapply derives_fupd_trans; [| apply H]
-  | @derives (environ -> mpred) _ (local (tc_environ _) && _) _ =>
+  | (local (tc_environ _) ∧ _) ⊢ _ =>
       eapply derives_fupd_trans; [| apply ENTAIL_derives_fupd, H]
   | _ =>
       eapply derives_fupd_trans; [| apply ENTAIL_derives_fupd, derives_ENTAIL, H]
@@ -1032,11 +1106,11 @@ Ltac derives_fupd_R2L H :=
 
 Ltac derives_full_R2L H :=
   match type of H with
-  | @derives (environ -> mpred) _ (local (tc_environ ?Delta) && (allp_fun_id ?Delta && _)) (|={_,_}=> _) =>
+  | (local (tc_environ ?Delta) ∧ (<affine> allp_fun_id ?Delta ∗ _)) ⊢ (|={_,_}=> _) =>
       eapply derives_fupd_trans; [| apply H]
-  | @derives (environ -> mpred) _ (local (tc_environ _) && _) (|={_,_}=> _) =>
+  | (local (tc_environ _) ∧ _) ⊢ (|={_,_}=> _) =>
       eapply derives_fupd_trans; [| apply derives_fupd_derives_full, H]
-  | @derives (environ -> mpred) _ (local (tc_environ _) && _) _ =>
+  | (local (tc_environ _) ∧ _) ⊢ _ =>
       eapply derives_fupd_trans; [| apply derives_fupd_derives_full, ENTAIL_derives_fupd, H]
   | _ =>
       eapply derives_fupd_trans; [| apply derives_fupd_derives_full, ENTAIL_derives_fupd, derives_ENTAIL, H]
@@ -1044,11 +1118,11 @@ Ltac derives_full_R2L H :=
 
 Tactic Notation "derives_rewrite" "<-" constr(H) :=
   match goal with
-  | |- @derives (environ -> mpred) _ (local (tc_environ _) && _) (|={_,_}=> _) =>
+  | |- (local (tc_environ _) ∧ _) ⊢ (|={_,_}=> _) =>
          derives_fupd_R2L H
-  | |- @derives (environ -> mpred) _ (local (tc_environ _) && _) (|={_,_}=> _) =>
+  | |- (local (tc_environ _) ∧ _) ⊢ (|={_,_}=> _) =>
          derives_fupd_R2L H
-  | |- @derives (environ -> mpred) _ (local (tc_environ _) && _) _ =>
+  | |- (local (tc_environ _) ∧ _) ⊢ _ =>
          ENTAIL_R2L H
   | |- _ =>
          lifted_derives_R2L H
@@ -1058,8 +1132,8 @@ Ltac solve_derives_trans :=
   first [simple apply derives_full_refl | eapply derives_full_trans; [eassumption | solve_derives_trans]].
 
 (*Lemma aux1_reduceR: forall P Q: environ -> mpred,
-  (P |-- (|==> Q)) ->
-  P |-- |==> |> FF || Q.
+  (P ⊢ (|==> Q)) ->
+  P ⊢ |==> ▷ FF || Q.
 Proof.
   intros.
   eapply derives_trans; [exact H |].
@@ -1067,47 +1141,29 @@ Proof.
   apply orp_right2; auto.
 Qed.*)
 
-Lemma aux2_reduceR: forall E (P Q: environ -> mpred),
-  (P |-- Q) ->
-  P |-- |={E}=> Q.
-Proof.
-  intros.
-  eapply derives_trans; [exact H |].
-  apply fupd_intro.
-Qed.
-
 Ltac reduceR :=
 (*  match goal with
-  | |- _ |-- |==> |> FF || _ => apply aux1_reduceR
+  | |- _ ⊢ |==> ▷ FF || _ => apply aux1_reduceR
   | _ => idtac
   end;*)
   match goal with
-  | |- _ |-- |={_}=> _ => apply aux2_reduceR
+  | |- _ ⊢ |={_}=> _ => apply aux2_reduceR
   | _ => idtac
   end.
 
-Lemma aux_reduceL: forall P Q R S: environ -> mpred,
-  (P && R |-- S) ->
-  P && (Q && R) |-- S.
-Proof.
-  intros.
-  eapply derives_trans; [| exact H].
-  solve_andp.
-Qed.
-
 Ltac reduceLL :=
   match goal with
-  | |- local (tc_environ ?Delta) && (allp_fun_id ?Delta && _) |-- _ => apply aux_reduceL
+  | |- local (tc_environ ?Delta) ∧ (<affine> allp_fun_id ?Delta ∗ _) ⊢ _ => apply aux_reduceL
   | _ => idtac
   end.
 
 Ltac reduceL :=
   match goal with
-  | |- local (tc_environ ?Delta) && (allp_fun_id ?Delta && _) |-- _ => apply aux_reduceL
+  | |- local (tc_environ ?Delta) ∧ (<affine> allp_fun_id ?Delta ∗ _) ⊢ _ => apply aux_reduceL
   | _ => idtac
   end;
   match goal with
-  | |- local (tc_environ _) && _ |-- _ => apply derives_ENTAIL
+  | |- local (tc_environ _) ∧ _ ⊢ _ => apply derives_ENTAIL
   | _ => idtac
   end.
 
diff --git a/floyd/assoclists.v b/floyd/assoclists.v
index 1c1e7f3f9a..c9b5764230 100644
--- a/floyd/assoclists.v
+++ b/floyd/assoclists.v
@@ -1,5 +1,7 @@
 Require Import VST.veric.base.
+Set Warnings "-custom-entry-overridden".
 Require Import VST.veric.initial_world.
+Set Warnings "custom-entry-overridden".
 
 Lemma filter_filter {A f1 f2}: forall {l:list A}, 
       filter f1 (filter f2 l) = filter (fun x => andb (f1 x) (f2 x)) l.
diff --git a/floyd/base.v b/floyd/base.v
index 2ff4c1d3d7..c08cb15b67 100644
--- a/floyd/base.v
+++ b/floyd/base.v
@@ -1,15 +1,16 @@
 From compcert Require Export Clightdefs.
 Require Export VST.veric.base.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Export VST.veric.SeparationLogic.
 Require Export VST.msl.Extensionality.
 Require Export compcert.lib.Coqlib.
 Require Export VST.msl.Coqlib2 VST.veric.coqlib4 VST.floyd.coqlib3.
 Require Export VST.veric.juicy_extspec.
-Require Import VST.veric.NullExtension.
 Require Export VST.floyd.jmeq_lemmas.
 Require Export VST.floyd.find_nth_tactic.
 Require Export VST.floyd.val_lemmas.
 Require Export VST.floyd.assert_lemmas.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Export compcert.cfrontend.Ctypes.
 Require Export VST.veric.expr.
 Require VST.floyd.SeparationLogicAsLogicSoundness.
@@ -18,9 +19,8 @@ Export SeparationLogicAsLogicSoundness.MainTheorem.CSHL_PracticalLogic.
 Export SeparationLogicAsLogicSoundness.MainTheorem.CSHL_PracticalLogic.CSHL_MinimumLogic.
 Export SeparationLogicAsLogicSoundness.MainTheorem.CSHL_PracticalLogic.CSHL_MinimumLogic.CSHL_Def.
 Export SeparationLogicAsLogicSoundness.MainTheorem.CSHL_PracticalLogic.CSHL_MinimumLogic.CSHL_Defs.
-Import compcert.lib.Maps.
 
-Local Open Scope logic.
+Global Instance: Params (@semax) 7 := {}.
 
 Create HintDb gather_prop discriminated.
 Create HintDb gather_prop_core discriminated.
@@ -38,10 +38,10 @@ Lemma alignof_pos: forall {cs: compspecs} (t: type), alignof t > 0.
 Proof. intros. apply Ctypes.alignof_pos. Qed.
 
 Definition extract_exists_pre:
-  forall {CS: compspecs} {Espec: OracleKind},
-  forall (A : Type) (P : A -> environ->mpred) c (Delta: tycontext) (R: ret_assert),
-  (forall x, @semax CS Espec Delta (P x) c R) ->
-   @semax CS Espec Delta (EX x:A, P x) c R
+  forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs},
+  forall (A : Type) (P : A -> assert) c E (Delta: tycontext) (R: ret_assert),
+  (forall x, semax E Delta (P x) c R) ->
+   semax E Delta (∃ x:A, P x) c R
   := @semax_extract_exists.
 
 Arguments alignof_two_p {env} t.
@@ -68,7 +68,7 @@ Definition co_default (s: struct_or_union): composite.
 Defined.
 
 Definition get_co id :=
-  match cenv_cs ! id with
+  match cenv_cs !! id with
   | Some co => co
   | _ => co_default Struct
   end.
@@ -87,7 +87,7 @@ Lemma get_co_consistent: forall id, composite_consistent cenv_cs (get_co id).
 Proof.
   intros.
   unfold get_co.
-  destruct (cenv_cs ! id) as [co |] eqn:CO.
+  destruct (cenv_cs !! id) as [co |] eqn:CO.
   + exact (cenv_consistent id co CO).
   + apply co_default_consistent.
 Defined.
@@ -97,20 +97,20 @@ Lemma get_co_members_nil_sizeof_0: forall id,
 Proof.
   unfold get_co.
   intros.
-  destruct (cenv_cs ! id) as [co |] eqn:?H; [destruct (co_su co) eqn:?H |].
+  destruct (cenv_cs !! id) as [co |] eqn:?H; [destruct (co_su co) eqn:?H |].
   + pose proof co_consistent_sizeof cenv_cs co (cenv_consistent id co H0).
     unfold sizeof_composite in H2.
     rewrite H1 in H2; clear H1.
     rewrite H in H2; clear H.
     simpl in H2.
-    rewrite align_0 in H2 by apply co_alignof_pos.
+    rewrite -> align_0 in H2 by apply co_alignof_pos.
     auto.
   + pose proof co_consistent_sizeof cenv_cs co (cenv_consistent id co H0).
     unfold sizeof_composite in H2.
     rewrite H1 in H2; clear H1.
     rewrite H in H2; clear H.
     simpl in H2.
-    rewrite align_0 in H2 by apply co_alignof_pos.
+    rewrite -> align_0 in H2 by apply co_alignof_pos.
     auto.
   + reflexivity.
 Defined.
@@ -120,7 +120,7 @@ Lemma get_co_members_no_replicate: forall id,
 Proof.
   intros.
   unfold get_co.
-  destruct (cenv_cs ! id) as [co |] eqn:?H.
+  destruct (cenv_cs !! id) as [co |] eqn:?H.
   + exact (cenv_legal_fieldlist id co H).
   + reflexivity.
 Defined.
@@ -130,7 +130,7 @@ Lemma sizeof_Tstruct: forall id a,
 Proof.
   intros. unfold sizeof.
   simpl. unfold get_co.
-  destruct (cenv_cs ! id); auto.
+  destruct (Maps.PTree.get id cenv_cs); auto.
 Qed.
 
 Lemma sizeof_Tunion: forall id a,
@@ -138,41 +138,41 @@ Lemma sizeof_Tunion: forall id a,
 Proof.
   intros. unfold sizeof.
   simpl. unfold get_co.
-  destruct (cenv_cs ! id); auto.
+  destruct (Maps.PTree.get id cenv_cs); auto.
 Qed.
 
 End GET_CO.
 
 Lemma co_members_get_co_change_composite {cs_from cs_to} {CCE: change_composite_env cs_from cs_to}: forall id,
-  match (coeq cs_from cs_to) ! id with
+  match (coeq cs_from cs_to) !! id with
   | Some b => test_aux cs_from cs_to b id
   | None => false
   end = true ->
   co_members (@get_co cs_from id) = co_members (@get_co cs_to id).
 Proof.
   intros.
-  destruct ((@cenv_cs cs_to) ! id) eqn:?H.
+  destruct (Maps.PTree.get id (@cenv_cs cs_to)) eqn: H0.
   + pose proof proj1 (coeq_complete _ _ id) (ex_intro _ c H0) as [b ?].
-    rewrite H1 in H.
+    setoid_rewrite H1 in H.
     apply (coeq_consistent _ _ id _ _ H0) in H1.
     unfold test_aux in H.
     destruct b; [| inv H].
     rewrite !H0 in H.
-    destruct ((@cenv_cs cs_from) ! id) eqn:?H; [| inv H].
+    destruct (Maps.PTree.get id (@cenv_cs cs_from)) eqn:?H2; [| inv H].
     simpl in H.
     rewrite !andb_true_iff in H.
     destruct H as [[? _] _].
     apply eqb_list_spec in H; [| apply eqb_member_spec].
-    unfold get_co; rewrite H0, H2.
+    unfold get_co; setoid_rewrite H0; setoid_rewrite H2.
     auto.
-  + destruct ((coeq cs_from cs_to) ! id) eqn:?H.
+  + destruct ((coeq cs_from cs_to) !! id) eqn:?H.
     - pose proof proj2 (coeq_complete _ _ id) (ex_intro _ b H1) as [co ?].
       congruence.
     - inv H.
 Qed.
 
 Lemma co_sizeof_get_co_change_composite {cs_from cs_to} {CCE: change_composite_env cs_from cs_to}: forall id,
-  match (coeq cs_from cs_to) ! id with
+  match (coeq cs_from cs_to) !! id with
   | Some b => test_aux cs_from cs_to b id
   | None => false
   end = true ->
@@ -201,10 +201,10 @@ Definition member_dec: forall (it0 it1: member), {it0 = it1} + {it0 <> it1}.
     left; reflexivity.
 Defined.
 
-Fixpoint fold_right_sepcon (l: list mpred) : mpred :=
+Fixpoint fold_right_sepcon {PROP : bi} (l: list PROP) : PROP :=
  match l with
  | nil => emp
- | b::r => b * fold_right_sepcon r
+ | b::r => b ∗ fold_right_sepcon r
  end.
 
 Inductive LLRR : Type :=
@@ -243,7 +243,7 @@ Proof. reflexivity. Qed.
 
 Lemma Floyd_firstn_skipn: forall [A : Type] (n : nat) (l : list A),
        Floyd_firstn n l ++ Floyd_skipn n l = l.
-Proof. rewrite Floyd_firstn_eq, Floyd_skipn_eq; exact @firstn_skipn.
+Proof. rewrite Floyd_firstn_eq Floyd_skipn_eq; exact @firstn_skipn.
 Qed.
 
 Definition Floyd_app [A: Type] :=
@@ -256,3 +256,4 @@ fix app (l m : list A) {struct l} : list A :=
 Lemma Floyd_app_eq: @Floyd_app = @app.
 Proof. reflexivity. Qed.
 
+#[export] Hint Resolve Share.nontrivial : core.
diff --git a/floyd/base2.v b/floyd/base2.v
index f084bd3c38..729c46e055 100644
--- a/floyd/base2.v
+++ b/floyd/base2.v
@@ -1,12 +1,12 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Export VST.floyd.base.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Export VST.floyd.typecheck_lemmas.
 Require Export VST.floyd.functional_base.
 Require Export VST.floyd.seplog_tactics.
 Require Export VST.floyd.const_only_eval.
 Require Export VST.floyd.computable_functions.
 
-Import compcert.lib.Maps.
-
 Fixpoint delete_id {A: Type} i (al: list (ident*A)) : option (A * list (ident*A)) :=
  match al with
  | (j,x)::bl => if ident_eq i j then Some (x,bl)
@@ -32,16 +32,20 @@ Definition funsig_of_fundef (fd: Clight.fundef) : funsig :=
  | External _ t t0 _ => (arglist 1 t, t0)
  end.
 
+Section funspecs.
+
+Context `{!heapGS Σ}.
+
 Definition vacuous_funspec (fd: Clight.fundef): funspec :=
-   mk_funspec (compcert_rmaps.typesig_of_funsig (funsig_of_fundef fd)) (cc_of_fundef fd) 
-   (rmaps.ConstType Impossible) (fun _ _ => FF) (fun _ _ => FF) (args_const_super_non_expansive _ _) (const_super_non_expansive _ _).
+   NDmk_funspec (typesig_of_funsig (funsig_of_fundef fd)) (cc_of_fundef fd) 
+   (Impossible) (fun _ => False) (fun _ => False).
 
 
-Fixpoint augment_funspecs_new' (fds: list (ident * Clight.fundef)) (G: PTree.t funspec) : option funspecs :=
+Fixpoint augment_funspecs_new' (fds: list (ident * Clight.fundef)) (G: Maps.PTree.t funspec) : option funspecs :=
  match fds with
- | (i,fd)::fds' => match PTree.get i G with
+ | (i,fd)::fds' => match Maps.PTree.get i G with
                        | Some f =>
-                              match augment_funspecs_new' fds' (PTree.remove i G) with
+                              match augment_funspecs_new' fds' (Maps.PTree.remove i G) with
                                | Some G2 => Some ((i,f)::G2)
                                | None => None
                               end
@@ -51,11 +55,11 @@ Fixpoint augment_funspecs_new' (fds: list (ident * Clight.fundef)) (G: PTree.t f
                                | None => None
                               end
                         end
- | nil => match PTree.elements G with nil => Some nil | _::_ => None end
+ | nil => match Maps.PTree.elements G with nil => Some nil | _::_ => None end
  end.
 
 Definition augment_funspecs_new prog (G:funspecs) : funspecs :=
- let Gt :=  fold_left (fun t ia => PTree.set (fst ia) (snd ia) t) G (PTree.empty _) in
+ let Gt :=  fold_left (fun t ia => Maps.PTree.set (fst ia) (snd ia) t) G (Maps.PTree.empty _) in
  match augment_funspecs_new' (prog_funct prog) Gt with
  | Some G' => G'
  | None => nil
@@ -93,3 +97,5 @@ Qed.
 Lemma augment_funspecs_new_eq: forall prog G,
   augment_funspecs_new prog G = augment_funspecs prog G.
 Abort.  (* Very likely true *)
+
+End funspecs.
diff --git a/floyd/call_lemmas.v b/floyd/call_lemmas.v
index d7f13e3a33..ac3f95bf01 100644
--- a/floyd/call_lemmas.v
+++ b/floyd/call_lemmas.v
@@ -1,4 +1,6 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.closed_lemmas.
 Require Import VST.floyd.mapsto_memory_block.
@@ -6,8 +8,6 @@ Require Import VST.floyd.local2ptree_denote.
 Require Import VST.floyd.local2ptree_eval.
 Require Import VST.floyd.subsume_funspec.
 Import LiftNotation.
-Import compcert.lib.Maps.
-Local Open Scope logic.
 
 Fixpoint argtypes (al: list (ident * type)) : list type :=
  match al with (_,t)::al' => t :: argtypes al' | nil => nil end.
@@ -18,13 +18,17 @@ Proof.
  destruct (split al). simpl in *. subst; auto.
 Qed.
 
-Definition maybe_retval (Q: environ -> mpred) retty ret :=
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} {CS: compspecs}.
+
+Definition maybe_retval (Q: assert) retty ret : assert :=
  match ret with
- | Some id => fun rho => Q (get_result1 id rho)
+ | Some id => assert_of (fun rho => Q (get_result1 id rho))
  | None =>
     match retty with
-    | Tvoid => (fun rho => Q (globals_only rho))
-    | _ => fun rho => EX v: val, Q (make_args (ret_temp::nil) (v::nil) rho)
+    | Tvoid => assert_of (fun rho => Q (globals_only rho))
+    | _ => assert_of (fun rho => ∃ v: val, Q (make_args (ret_temp::nil) (v::nil) rho))
     end
  end.
 
@@ -34,7 +38,7 @@ Definition removeopt_localdef (ret: option ident) (l: list localdef) : list loca
    | None => l
    end.
 
-Lemma semax_call': forall Espec {cs: compspecs} Delta fs A Pre Post NEPre NEPost ts x ret argsig retsig cc a bl P Q R,
+Lemma semax_call': forall Delta fs A E Pre Post x ret argsig retsig cc a bl P Q R,
    Cop.classify_fun (typeof a) = Cop.fun_case_f argsig retsig cc ->
    match retsig, ret with
    | Tvoid, None => True
@@ -42,168 +46,119 @@ Lemma semax_call': forall Espec {cs: compspecs} Delta fs A Pre Post NEPre NEPost
    | _, _ => True
    end ->
    forall (Hret: tc_fn_return Delta ret retsig)
-   (Hsub: funspec_sub fs (mk_funspec (argsig,retsig) cc A Pre Post NEPre NEPost)),
-  @semax cs Espec Delta
-          ((tc_expr Delta a && tc_exprlist Delta argsig bl)
-           &&
-   (|> (fun rho => (Pre ts x (ge_of rho, eval_exprlist argsig bl rho))) *
-                      `(func_ptr' fs) (eval_expr a)
-     * |>PROPx P (LOCALx Q (SEPx R))))
+   (Hsub: funspec_sub fs (mk_funspec (argsig,retsig) cc A E Pre Post)),
+  semax (E x) Delta
+          ((tc_expr Delta a ∧ tc_exprlist Delta argsig bl)
+           ∧
+   (▷ assert_of (fun rho => (Pre x (ge_of rho, eval_exprlist argsig bl rho))) ∗
+                      assert_of (`(func_ptr fs) (eval_expr a))
+     ∗ ▷PROPx P (LOCALx Q (SEPx R))))
           (Scall ret a bl)
           (normal_ret_assert
-            (maybe_retval (Post ts x) retsig ret *
+            (maybe_retval (assert_of (Post x)) retsig ret ∗
                PROPx P (LOCALx (removeopt_localdef ret Q) (SEPx R)))).
 Proof.
   intros.
   eapply semax_pre_post'; [ | |
-    apply (semax_call_subsume fs A Pre Post NEPre NEPost argsig retsig cc
-    Hsub Delta ts x (PROPx P (LOCALx Q (SEPx R))) ret a bl H); auto].
+    apply (semax_call_subsume fs A E Pre Post argsig retsig cc
+    Hsub Delta x (PROPx P (LOCALx Q (SEPx R))) ret a bl H); auto].
   3:{
     clear - H0.
     destruct retsig; destruct ret; simpl in *; try contradiction;
     intros; congruence.
   }
   + clear Hret.
-    unfold_lift; unfold local, lift1. unfold func_ptr'. intro rho; simpl.
-    normalize;
-    progress (autorewrite with subst norm1 norm2; normalize).
-    apply andp_derives; auto.
-    rewrite sepcon_assoc, sepcon_comm.
-    rewrite !corable_andp_sepcon1 by apply corable_func_ptr.
-    rewrite sepcon_comm. rewrite emp_sepcon.
-    apply andp_derives; auto.
-    rewrite sepcon_comm, <- later_sepcon.
-    progress (autorewrite with subst norm1 norm2; normalize).
-  + intros.
-    autorewrite with ret_assert.
-    normalize.
-    destruct ret.
-    - eapply derives_trans; [| apply sepcon_derives; [apply derives_refl | apply remove_localdef_temp_PROP]].
-      normalize.
-      apply exp_right with old.
-      autorewrite with subst.
-      intro rho; simpl; normalize.
-      autorewrite with norm1 norm2; normalize.
-      rewrite sepcon_comm; auto.
-    - intro rho; simpl; normalize.
-      rewrite sepcon_comm; auto.
-      unfold substopt.
-      repeat rewrite list_map_identity.
-      normalize.
-      autorewrite with norm1 norm2; normalize.
-      apply sepcon_derives; trivial.
-      destruct retsig; trivial.
-      all: apply exp_derives; intros v; apply andp_left2; trivial.
+    rewrite bi.and_elim_r; apply bi.and_mono; first done.
+    iIntros "($ & $ & $)".
+  + rewrite bi.and_elim_r.
+    rewrite /semax_call.maybe_retval; destruct ret; simpl.
+    - iIntros "H"; iDestruct "H" as (?) "(H & ?)".
+      iSplitR "H".
+      * iStopProof; split => rho; simpl.
+        iIntros "(_ & $)".
+      * iApply remove_localdef_temp_PROP; eauto.
+    - split => rho; monPred.unseal.
+      iIntros "H"; iDestruct "H" as (?) "($ & ?)".
+      iStopProof.
+      destruct retsig; try done; simpl; apply bi.exist_mono; intros; iIntros "(_ & $)".
 Qed.
 
-Lemma semax_call1: forall Espec {cs: compspecs} Delta fs A Pre Post NEPre NEPost ts x id argsig retsig cc a bl P Q R
-   (Hsub: funspec_sub fs (mk_funspec (argsig,retsig) cc A Pre Post NEPre NEPost)),
+Lemma semax_call1: forall Delta fs A E Pre Post x id argsig retsig cc a bl P Q R
+   (Hsub: funspec_sub fs (mk_funspec (argsig,retsig) cc A E Pre Post)),
    Cop.classify_fun (typeof a) = Cop.fun_case_f argsig retsig cc  ->
    match retsig with
    | Tvoid => False
    | _ => True
    end ->
    tc_fn_return Delta (Some id) retsig ->
-  @semax cs Espec Delta
-         ((tc_expr Delta a && tc_exprlist Delta argsig bl)
-           && (|>(fun rho => Pre ts x (ge_of rho, eval_exprlist argsig bl rho)) *
-                 `(func_ptr' fs) (eval_expr a) *
-                  |>PROPx P (LOCALx Q (SEPx R))))
+  semax (E x) Delta
+         ((tc_expr Delta a ∧ tc_exprlist Delta argsig bl)
+           ∧ (▷assert_of (fun rho => Pre x (ge_of rho, eval_exprlist argsig bl rho)) ∗
+                 assert_of (`(func_ptr fs) (eval_expr a)) ∗
+                  ▷PROPx P (LOCALx Q (SEPx R))))
           (Scall (Some id) a bl)
           (normal_ret_assert
-            (`(Post ts x: environ -> mpred) (get_result1 id)
-               * PROPx P (LOCALx (remove_localdef_temp id Q) (SEPx R)))).
+            (assert_of (fun rho => Post x (get_result1 id rho))
+               ∗ PROPx P (LOCALx (remove_localdef_temp id Q) (SEPx R)))).
 Proof.
-intros.
-apply (@semax_call' Espec cs Delta fs A Pre Post NEPre NEPost ts x (Some id) argsig retsig cc a bl P Q R H H0 H1 Hsub).
+  intros.
+  eapply semax_pre_post', semax_call'; try done; rewrite bi.and_elim_r //.
 Qed.
 
 Definition ifvoid {T} t (A B: T) :=
  match t with Tvoid => A | _ => B end.
 
-Lemma semax_call0: forall Espec {cs: compspecs} Delta fs A Pre Post NEPre NEPost ts x
+Lemma semax_call0: forall Delta fs A E Pre Post x
       argsig retty cc a bl P Q R
-   (Hsub: funspec_sub fs (mk_funspec (argsig,retty) cc A Pre Post NEPre NEPost)),
+   (Hsub: funspec_sub fs (mk_funspec (argsig,retty) cc A E Pre Post)),
    Cop.classify_fun (typeof a) = Cop.fun_case_f argsig retty cc->
-  @semax cs Espec Delta
-         ((*|>*)(tc_expr Delta a && tc_exprlist Delta argsig bl)
-           && (|>(fun rho => Pre ts x (ge_of rho, eval_exprlist argsig bl rho))
-                 * `(func_ptr' fs) (eval_expr a)
-                 * |>PROPx P (LOCALx Q (SEPx R))))
+  semax (E x) Delta
+         ((*▷*)(tc_expr Delta a ∧ tc_exprlist Delta argsig bl)
+           ∧ (▷assert_of (fun rho => Pre x (ge_of rho, eval_exprlist argsig bl rho))
+                 ∗ assert_of (`(func_ptr fs) (eval_expr a))
+                 ∗ ▷PROPx P (LOCALx Q (SEPx R))))
           (Scall None a bl)
           (normal_ret_assert
-            (ifvoid retty (`(Post ts x: environ -> mpred) (make_args nil nil))
-                                                        (EX v:val, `(Post ts x: environ -> mpred) (make_args (ret_temp::nil) (v::nil)))
-            * PROPx P (LOCALx Q (SEPx R)))).
+            (ifvoid retty (assert_of (`(Post x: environ -> mpred) (make_args nil nil)))
+                                                        (∃ v:val, assert_of (`(Post x: environ -> mpred) (make_args (ret_temp::nil) (v::nil))))
+            ∗ PROPx P (LOCALx Q (SEPx R)))).
 Proof.
 intros.
 eapply semax_pre_post'; [ | |
-   apply (semax_call_subsume fs A Pre Post NEPre NEPost argsig retty cc Hsub
-               Delta ts x (PROPx P (LOCALx Q (SEPx R))) None a bl H)].
+   apply (semax_call_subsume fs A E Pre Post argsig retty cc Hsub
+               Delta x (PROPx P (LOCALx Q (SEPx R))) None a bl H)].
 3:{ split; intros; congruence. }
 3:{ apply Coq.Init.Logic.I. }
-+ intro rho; normalize.
-  autorewrite with norm1 norm2; normalize.
-  unfold func_ptr'.
-  rewrite !sepcon_assoc.
-  apply andp_derives; auto.
-  rewrite !corable_andp_sepcon1 by apply corable_func_ptr.
-  rewrite emp_sepcon, sepcon_comm.
-  rewrite !corable_andp_sepcon1 by apply corable_func_ptr.
-  apply andp_derives; auto.
-  rewrite later_sepcon; apply derives_refl.
-+ intros.
-  apply andp_left2.
-  normalize.
-  unfold SeparationLogic.maybe_retval.
-  autorewrite with subst norm ret_assert.
-  rewrite sepcon_comm. apply sepcon_derives; trivial.
-  unfold liftx, lift. simpl. destruct retty; simpl; intros; trivial.
-  all: apply exp_derives; intros u; apply andp_left2; trivial.
++ rewrite bi.and_elim_r; apply bi.and_mono; first done.
+  iIntros "($ & $ & $)".
++ rewrite /semax_call.maybe_retval /= bi.and_elim_r.
+  split => rho; monPred.unseal.
+  iIntros "H"; iDestruct "H" as (?) "($ & ?)".
+  iStopProof.
+  destruct retty; simpl; try done; apply bi.exist_mono; intros; iIntros "(_ & $)".
 Qed.
 
 Lemma semax_fun_id':
       forall id f TC
-              Espec {cs: compspecs} Delta (PQR: environ->mpred) PostCond c
-            (GLBL: (var_types Delta) ! id = None),
-       (glob_specs Delta) ! id = Some f ->
-       (glob_types Delta) ! id = Some (type_of_funspec f) ->
-       @semax cs Espec Delta
-        (TC && (local (tc_environ Delta) &&
-                     (`(func_ptr' f) (eval_var id (type_of_funspec f))
-                     * |>PQR)))
+              E Delta (PQR: assert) PostCond c
+            (GLBL: (var_types Delta) !! id = None),
+       (glob_specs Delta) !! id = Some f ->
+       (glob_types Delta) !! id = Some (type_of_funspec f) ->
+       semax E Delta
+        (TC ∧ (local (tc_environ Delta) ∧
+                     (assert_of (`(func_ptr f) (eval_var id (type_of_funspec f)))
+                     ∗ ▷PQR)))
                               c PostCond ->
-       @semax cs Espec Delta (TC && |> PQR) c PostCond.
+       semax E Delta (TC ∧ ▷ PQR) c PostCond.
 Proof.
-intros.
-apply (semax_fun_id id f Delta); auto.
-eapply semax_pre_post; try apply H1;
- try (apply andp_left2; apply derives_refl).
-+ apply andp_right. apply andp_left2. do 2 apply andp_left1; trivial.
-  rewrite <- !andp_assoc.
-  apply andp_right.
-        rewrite !andp_assoc; apply andp_left1; auto.
-  clear H1.
-  unfold_lift. unfold func_ptr'.
-  intro rho; simpl; normalize.
-  rewrite corable_andp_sepcon1 by apply corable_func_ptr.
-  rewrite andp_comm.
-  apply andp_derives; auto.
-  rewrite emp_sepcon; auto.
-  apply andp_left2; auto.
-+ intros.
-  apply andp_left2; auto.
-Qed.
-
-(*
-Lemma eqb_typelist_refl: forall tl, eqb_typelist tl tl = true.
-Proof.
-induction tl; simpl; auto.
-apply andb_true_iff.
-split; auto.
-apply eqb_type_refl.
+  intros.
+  apply (semax_fun_id id f E Delta); auto.
+  eapply semax_pre_post; try apply H1; intros; try by rewrite bi.and_elim_r.
+  iIntros "(? & ? & ?)"; iSplit.
+  { rewrite bi.and_elim_l; iFrame.
+    iStopProof; split => rho; monPred.unseal; auto. }
+  rewrite bi.and_elim_r; iFrame.
 Qed.
-*)
 
 Lemma eqb_typelist_refl: forall c, eqb_list eqb_type c c = true.
 Proof.
@@ -212,104 +167,66 @@ apply eqb_list_spec; auto.
 exact eqb_type_spec.
 Qed.
 
-(* TODO: Change argument order. ==> A Pre Post NEPre NEPost ts x *)
 Lemma semax_call_id0:
- forall Espec {cs: compspecs} Delta P Q R id bl fs argsig retty cc A ts x Pre Post NEPre NEPost
-   (Hsub: funspec_sub fs (mk_funspec (argsig,retty) cc A Pre Post NEPre NEPost))
-   (GLBL: (var_types Delta) ! id = None),
-       (glob_specs Delta) ! id = Some fs ->
-       (glob_types Delta) ! id = Some (type_of_funspec fs) ->
-  @semax cs Espec Delta ((*|>*) (tc_exprlist Delta argsig bl
-                  && |> ((fun rho => Pre ts x (ge_of rho, eval_exprlist argsig bl rho))
-                         * PROPx P (LOCALx Q (SEPx R)))))
+ forall Delta P Q R id bl fs argsig retty cc A E Pre Post x
+   (Hsub: funspec_sub fs (mk_funspec (argsig,retty) cc A E Pre Post))
+   (GLBL: (var_types Delta) !! id = None),
+       (glob_specs Delta) !! id = Some fs ->
+       (glob_types Delta) !! id = Some (type_of_funspec fs) ->
+  semax (E x) Delta ((*▷*) (tc_exprlist Delta argsig bl
+                  ∧ ▷ (assert_of (fun rho => Pre x (ge_of rho, eval_exprlist argsig bl rho))
+                         ∗ PROPx P (LOCALx Q (SEPx R)))))
     (Scall None (Evar id (Tfunction argsig retty cc)) bl)
     (normal_ret_assert
-       ((ifvoid retty (`(Post ts x: environ -> mpred) (make_args nil nil))
-                                                   (EX v:val, `(Post ts x: environ -> mpred) (make_args (ret_temp::nil) (v::nil))))
-         * PROPx P (LOCALx Q (SEPx R)))).
+       ((ifvoid retty (assert_of (`(Post x: environ -> mpred) (make_args nil nil)))
+                                                   (∃ v:val, assert_of (`(Post x: environ -> mpred) (make_args (ret_temp::nil) (v::nil)))))
+         ∗ PROPx P (LOCALx Q (SEPx R)))).
 Proof.
-intros.
-assert (Cop.classify_fun (typeof (Evar id (Tfunction argsig retty cc)))=
-               Cop.fun_case_f argsig retty cc).
-simpl. subst. reflexivity.
-apply (semax_fun_id' id fs (tc_exprlist Delta argsig bl) Espec Delta); auto.
-subst.
-
-eapply semax_pre_simple; [ | apply (@semax_call0 Espec cs Delta fs A Pre Post NEPre NEPost ts x argsig _ cc _ bl P Q R Hsub); auto].
-apply andp_right.
-{ rewrite <- andp_assoc. apply andp_left1.
-  apply andp_right.
-  * apply andp_left1. intro rho; unfold tc_expr; simpl.
-    subst.
-    norm_rewrite. apply prop_left; intro.
-    unfold get_var_type. rewrite GLBL. rewrite H0.
-    rewrite denote_tc_assert_bool; simpl. apply prop_right.
-    simpl.
-    rewrite (type_of_funspec_sub _ _ Hsub).
-    simpl; auto.
-    rewrite eqb_typelist_refl.
-    simpl. auto.
-    unfold_lift; auto.
-    rewrite eqb_type_refl. simpl.
-    apply eqb_calling_convention_refl.
-  * apply andp_left2; auto. }
-apply andp_left2, andp_left2, andp_left2.
-intro; simpl.
-rewrite later_sepcon, <- sepcon_assoc.
-apply sepcon_derives; auto.
-rewrite (type_of_funspec_sub _ _ Hsub).
-rewrite sepcon_comm; apply derives_refl.
+  intros.
+  apply (semax_fun_id' id fs (tc_exprlist Delta argsig bl) (E x) Delta); auto.
+  eapply semax_pre_simple; [ | apply (semax_call0 Delta fs A E Pre Post x argsig _ cc _ bl P Q R Hsub); auto].
+  rewrite bi.and_elim_r; apply bi.and_mono.
+  { apply bi.and_intro; last done.
+    rewrite /tc_expr /typecheck_expr /= /get_var_type GLBL H0 denote_tc_assert_bool.
+    apply bi.pure_intro.
+    rewrite (type_of_funspec_sub _ _ Hsub) /=.
+    rewrite eqb_typelist_refl eqb_type_refl eqb_calling_convention_refl //. }
+  iIntros "(_ & ? & $ & $)".
+  rewrite (type_of_funspec_sub _ _ Hsub) //.
 Qed.
 
 Lemma semax_call_id1:
- forall Espec {cs: compspecs} Delta P Q R ret id fs retty cc bl argsig A ts x Pre Post NEPre NEPost
-   (Hsub: funspec_sub fs (mk_funspec (argsig,retty) cc A Pre Post NEPre NEPost))
-   (GLBL: (var_types Delta) ! id = None),
-       (glob_specs Delta) ! id = Some fs ->
-       (glob_types Delta) ! id = Some (type_of_funspec fs) ->
-   match retty with
+ forall Delta P Q R ret id fs retty cc bl argsig A E Pre Post x
+   (Hsub: funspec_sub fs (mk_funspec (argsig,retty) cc A E Pre Post))
+   (GLBL: (var_types Delta) !! id = None)
+   (H: (glob_specs Delta) !! id = Some fs)
+   (Ht: (glob_types Delta) !! id = Some (type_of_funspec fs))
+   (H0: match retty with
    | Tvoid => False
    | _ => True
-   end ->
-   tc_fn_return Delta (Some ret) retty ->
-  @semax cs Espec Delta ((tc_exprlist Delta argsig bl &&
-                |>((fun rho => Pre ts x (ge_of rho, eval_exprlist argsig bl rho))
-                  * PROPx P (LOCALx Q (SEPx R)))))
+   end)
+   (Hret: tc_fn_return Delta (Some ret) retty),
+  semax (E x) Delta ((tc_exprlist Delta argsig bl ∧
+                ▷(assert_of (fun rho => Pre x (ge_of rho, eval_exprlist argsig bl rho))
+                  ∗ PROPx P (LOCALx Q (SEPx R)))))
     (Scall (Some ret)
              (Evar id (Tfunction argsig retty cc))
              bl)
     (normal_ret_assert
-       ((`(Post ts x: environ -> mpred) (get_result1 ret)
-           * PROPx P (LOCALx (remove_localdef_temp ret Q) (SEPx R))))).
+       ((assert_of (`(Post x: environ -> mpred) (get_result1 ret))
+           ∗ PROPx P (LOCALx (remove_localdef_temp ret Q) (SEPx R))))).
 Proof.
-intros. rename H0 into Ht. rename H1 into H0.
- rename H2 into Hret.
-assert (Cop.classify_fun (typeof (Evar id (Tfunction argsig retty cc)))=
-               Cop.fun_case_f argsig retty cc).
-subst; reflexivity.
-apply (semax_fun_id' id fs); auto.
-subst.
-eapply semax_pre_simple; [ | apply (semax_call1 Espec Delta fs A Pre Post NEPre NEPost ts x ret argsig retty cc _ bl P Q R Hsub H1 H0); auto].
-apply andp_right.
-{ rewrite <- andp_assoc. apply andp_left1. apply andp_right.
-  * intro rho; unfold tc_expr, local,lift1; simpl.
-    subst.
-    norm_rewrite.
-    unfold get_var_type. rewrite GLBL. rewrite Ht.
-    rewrite (type_of_funspec_sub _ _ Hsub).
-    rewrite denote_tc_assert_bool.
-    simpl.
-    rewrite eqb_typelist_refl, eqb_type_refl, eqb_calling_convention_refl.
-    apply prop_right; trivial.
-  * apply andp_left2; trivial. }
-apply andp_left2.
-apply andp_left2.
-apply andp_left2.
-rewrite later_sepcon, <- sepcon_assoc.
-apply sepcon_derives; auto.
-rewrite (type_of_funspec_sub _ _ Hsub).
-rewrite sepcon_comm.
-apply derives_refl.
+  intros.
+  apply (semax_fun_id' id fs); auto.
+  eapply semax_pre_simple; [ | apply (semax_call1 Delta fs A E Pre Post x ret argsig retty cc _ bl P Q R Hsub); auto].
+  rewrite bi.and_elim_r; apply bi.and_mono.
+  { apply bi.and_intro; last done.
+    rewrite /tc_expr /typecheck_expr /= /get_var_type GLBL Ht denote_tc_assert_bool.
+    apply bi.pure_intro.
+    rewrite (type_of_funspec_sub _ _ Hsub) /=.
+    rewrite eqb_typelist_refl eqb_type_refl eqb_calling_convention_refl //. }
+  iIntros "(_ & ? & $ & $)".
+  rewrite (type_of_funspec_sub _ _ Hsub) //.
 Qed.
 
 Inductive extract_trivial_liftx {A}: list (environ->A) -> list A -> Prop :=
@@ -320,28 +237,12 @@ Inductive extract_trivial_liftx {A}: list (environ->A) -> list A -> Prop :=
 
 Lemma fold_right_and_app_low:
   forall (Q1 Q2 : list Prop),
-  fold_right and True (Q1 ++ Q2)  =
-  (fold_right and True Q1  /\ fold_right and True Q2).
-Proof.
-induction Q1; intros; simpl; auto.
-apply prop_ext; tauto.
-rewrite IHQ1.
-apply prop_ext; tauto.
-Qed.
-
-Lemma fold_right_and_app_lifted:
-  forall (Q1 Q2: list (environ -> Prop)),
-  fold_right `(and) `(True) (Q1 ++ Q2)  =
-  `(and) (fold_right `(and) `(True) Q1) (fold_right `(and) `(True) Q2).
+  fold_right and True%type (Q1 ++ Q2) ≡
+  (fold_right and True%type Q1  /\ fold_right and True%type Q2).
 Proof.
-induction Q1; intros; simpl; auto.
-extensionality rho; apply prop_ext;intuition.
-split; auto.
-destruct H; auto.
-rewrite IHQ1.
-extensionality rho; apply prop_ext; intuition.
-destruct H. destruct H0. repeat split; auto.
-destruct H. destruct H. repeat split; auto.
+  induction Q1; intros; simpl; first by hnf; tauto.
+  rewrite IHQ1.
+  hnf; tauto.
 Qed.
 
 Definition check_gvars_spec (GV: option globals) (GV': option globals) : Prop :=
@@ -360,20 +261,20 @@ auto.
 f_equal; auto.
 Qed.
 
-Lemma isolate_LOCAL_lem1:
-  forall Q, PROPx nil (LOCALx Q (SEPx (TT::nil))) = local (fold_right `(and) `(True) (map locald_denote Q)).
+(*Lemma isolate_LOCAL_lem1:
+  forall Q, (PROPx(Σ := Σ)) nil (LOCALx Q (SEPx (True::nil))) = local (fold_right `(and) `(True%type) (map locald_denote Q)).
 Proof.
  intros.
  extensionality rho.
  unfold PROPx, LOCALx, SEPx.
  simpl fold_right_sepcon.
  normalize.
-Qed.
+Qed.*)
 
 Lemma Forall_ptree_elements_e:
   forall A (F: ident * A -> Prop) m i v,
    Forall F (PTree.elements m) ->
-   m ! i = Some v ->
+   m !! i = Some v ->
    F (i,v).
 Proof.
  intros.
@@ -386,7 +287,7 @@ Qed.
 Lemma pTree_from_elements_e1:
   forall rho fl vl i v,
     Forall (fun v => v <> Vundef) vl ->
-    (pTree_from_elements (combine fl vl)) ! i = Some v ->
+    (pTree_from_elements (combine fl vl)) !! i = Some v ->
     v = eval_id i (make_args fl vl rho) /\ v <> Vundef.
 Proof.
  intros.
@@ -406,10 +307,10 @@ Proof.
        rewrite unfold_make_args_cons.
        unfold eval_id.  simpl. rewrite Map.gss.
        split; [reflexivity | inv H; auto].
-     * rewrite PTree.gso in H0 by auto.
+     * rewrite -> PTree.gso in H0 by auto.
        apply IHfl in H0.
        rewrite unfold_make_args_cons.
-       unfold eval_id.  simpl. rewrite Map.gso by auto. apply H0.
+       unfold eval_id.  simpl. rewrite -> Map.gso by auto. apply H0.
        inv H; auto.
 Qed.
 
@@ -431,19 +332,17 @@ Qed.
 
 Lemma PROP_combine:
  forall P P' Q Q' R R',
-  PROPx P (LOCALx Q (SEPx R)) * PROPx P' (LOCALx Q' (SEPx R')) =
+  PROPx(Σ := Σ) P (LOCALx Q (SEPx R)) ∗ PROPx P' (LOCALx Q' (SEPx R')) ⊣⊢
   PROPx (P++P') (LOCALx (Q++Q') (SEPx (R++R'))).
 Proof.
-intros.
-unfold PROPx, LOCALx, SEPx, local, lift1.
-extensionality rho. simpl.
-normalize.
-f_equal. rewrite map_app.
-rewrite fold_right_and_app.
-rewrite fold_right_and_app_low.
-f_equal. apply prop_ext; tauto.
-rewrite fold_right_sepcon_app.
-auto.
+  intros.
+  unfold PROPx, LOCALx, SEPx, local, lift1.
+  split => rho; monPred.unseal.
+  normalize.
+  f_equiv.
+  - rewrite map_app fold_right_and_app_low fold_right_and_app.
+    f_equiv; tauto.
+  - rewrite fold_right_sepcon_app //.
 Qed.
 
 Inductive Parameter_types_in_funspec_different_from_call_statement : Prop := .
@@ -452,13 +351,13 @@ Inductive Result_type_in_funspec_different_from_call_statement : Prop := .
 Definition check_retty t :=
     match t with Tvoid => Result_type_in_funspec_different_from_call_statement
                       |  Tarray _ _ _ => Result_type_in_funspec_different_from_call_statement
-                       | _ => True
+                      | _ => True%type
     end.
 
-Lemma PROP_LOCAL_SEP_f:
+(*Lemma PROP_LOCAL_SEP_f:
   forall P Q R f, `(PROPx P (LOCALx Q (SEPx R))) f =
      local (fold_right `(and) `(True) (map (fun q : environ -> Prop => `q f) (map locald_denote Q)))
-     && PROPx P (LOCALx nil (SEPx R)).
+     ∧ PROPx P (LOCALx nil (SEPx R)).
 Proof. intros. extensionality rho.
 cbv delta [PROPx LOCALx SEPx local lift lift1 liftx]; simpl.
 normalize.
@@ -471,258 +370,243 @@ replace (fold_right (fun (x x0 : environ -> Prop) (x1 : environ) => x x1 /\ x0 x
       (map locald_denote Q)) rho);  [apply prop_ext; tauto | ].
 induction Q; simpl; auto. f_equal; auto.
 Qed.
-#[export] Hint Rewrite PROP_LOCAL_SEP_f: norm2.
+#[export] Hint Rewrite PROP_LOCAL_SEP_f: norm2.*)
 
-Definition global_funspec Delta id argsig retty cc A Pre Post NEPre NEPost :=
-   (var_types Delta) ! id = None /\
-   (glob_specs Delta) ! id = Some (mk_funspec (argsig,retty) cc A Pre Post NEPre NEPost) /\
-   (glob_types Delta) ! id = Some (type_of_funspec (mk_funspec (argsig,retty) cc A Pre Post NEPre NEPost)).
+Definition global_funspec Delta id argsig retty cc A E Pre Post :=
+   (var_types Delta) !! id = None /\
+   (glob_specs Delta) !! id = Some (mk_funspec (argsig,retty) cc A E Pre Post) /\
+   (glob_types Delta) !! id = Some (type_of_funspec (mk_funspec (argsig,retty) cc A E Pre Post)).
 
 Lemma lookup_funspec:
-  forall Delta id argsig retty cc A Pre Post NEPre NEPost,
-   (var_types Delta) ! id = None ->
-   (glob_specs Delta) ! id = Some (mk_funspec (argsig,retty) cc A Pre Post NEPre NEPost) ->
-   (glob_types Delta) ! id = Some (type_of_funspec (mk_funspec (argsig,retty) cc A Pre Post NEPre NEPost)) ->
-   global_funspec Delta id argsig retty cc A Pre Post NEPre NEPost.
+  forall Delta id argsig retty cc A E Pre Post,
+   (var_types Delta) !! id = None ->
+   (glob_specs Delta) !! id = Some (mk_funspec (argsig,retty) cc A E Pre Post) ->
+   (glob_types Delta) !! id = Some (type_of_funspec (mk_funspec (argsig,retty) cc A E Pre Post)) ->
+   global_funspec Delta id argsig retty cc A E Pre Post.
 Proof.
 intros.
 split3; auto.
 Qed.
 
 
-Lemma func_ptr'_func_ptr_lifted:
-forall (fs: funspec) (e: environ->val) (B: environ->mpred),
- `(func_ptr' fs) e * B = `(func_ptr fs) e && B.
-Proof.
-intros.
-extensionality rho.
-unfold_lift. unfold func_ptr'.
-simpl.
-rewrite corable_andp_sepcon1 by apply corable_func_ptr.
-rewrite emp_sepcon; auto.
-Qed.
-
-Definition can_assume_funcptr cs Delta P Q R a fs :=
- forall Espec c Post,
- @semax cs Espec Delta ((EX v: val, (lift0 (func_ptr fs v) && local (`(eq v) (eval_expr a)))) &&
+Definition can_assume_funcptr E Delta P Q R a fs :=
+ forall c Post,
+ semax E Delta ((∃ v: val, ⎡func_ptr fs v⎤ ∧ local (`(eq v) (eval_expr a))) ∗
                    PROPx P (LOCALx Q (SEPx R))) c Post ->
- @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R))) c Post.
+ semax E Delta (PROPx P (LOCALx Q (SEPx R))) c Post.
 
 Definition OLDcall_setup1
-  (cs: compspecs) Qtemp Qvar GV a Delta P Q R R'
-   fs argsig retty cc (A: rmaps.TypeTree)  Pre Post NEPre NEPost
+  E Qtemp Qvar GV a Delta P Q R R'
+   fs argsig retty cc (A: TypeTree) Ef Pre Post
   (bl: list expr) (vl : list val)
  :=
   local2ptree Q = (Qtemp, Qvar, nil, GV) /\
-  funspec_sub fs (mk_funspec (argsig,retty) cc A Pre Post NEPre NEPost) /\
+  funspec_sub fs (mk_funspec (argsig,retty) cc A Ef Pre Post) /\
 
-  can_assume_funcptr  cs Delta P Q R' a fs /\
-  (PROPx P (LOCALx Q (SEPx R')) |-- |> PROPx P (LOCALx Q (SEPx R))) /\
+  can_assume_funcptr E Delta P Q R' a fs /\
+  (PROPx P (LOCALx Q (SEPx R')) ⊢ ▷ PROPx P (LOCALx Q (SEPx R))) /\
 
   Cop.classify_fun (typeof a) = Cop.fun_case_f argsig retty cc /\
-  ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
-         |-- (tc_expr Delta a)  /\
-  ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
-          |--  (tc_exprlist Delta argsig bl) /\
+  (ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
+         ⊢ (tc_expr Delta a))  /\
+  (ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
+          ⊢  (tc_exprlist Delta argsig bl)) /\
   force_list (map (msubst_eval_expr Delta Qtemp Qvar GV)
                     (explicit_cast_exprlist argsig bl))
                 = Some vl.
 
 Definition call_setup1
-  (cs: compspecs) Qtemp Qvar GV a Delta P Q R (*R'*)
-   fs argsig retty cc (A: rmaps.TypeTree)  Pre Post NEPre NEPost
+  E Qtemp Qvar GV a Delta P Q R (*R'*)
+   fs argsig retty cc (A: TypeTree) Ef Pre Post
   (bl: list expr) (vl : list val)
  :=
   local2ptree Q = (Qtemp, Qvar, nil, GV) /\
-  funspec_sub fs (mk_funspec (argsig,retty) cc A Pre Post NEPre NEPost) /\
+  funspec_sub fs (mk_funspec (argsig,retty) cc A Ef Pre Post) /\
 
-  can_assume_funcptr  cs Delta P Q R a fs /\
+  can_assume_funcptr E Delta P Q R a fs /\
 
   Cop.classify_fun (typeof a) = Cop.fun_case_f argsig retty cc /\
-  ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
-         |-- (tc_expr Delta a)  /\
-  ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
-          |--  (tc_exprlist Delta argsig bl) /\
+  (ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
+         ⊢ (tc_expr Delta a) ) /\
+  (ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
+          ⊢  (tc_exprlist Delta argsig bl)) /\
   force_list (map (msubst_eval_expr Delta Qtemp Qvar GV)
                     (explicit_cast_exprlist argsig bl))
                 = Some vl.
 
 Lemma OLDcall_setup1_i:
- forall (cs: compspecs) Delta P Q R R' (a: expr) (bl: list expr)
+ forall E Delta P Q R R' (a: expr) (bl: list expr)
    Qtemp Qvar GV (v: val)
-   fs argsig retty cc (A: rmaps.TypeTree)  Pre Post NEPre NEPost
+   fs argsig retty cc (A: TypeTree) Ef Pre Post
   (vl : list val),
   local2ptree Q = (Qtemp, Qvar, nil, GV) ->
   msubst_eval_expr Delta Qtemp Qvar GV a = Some v ->
 
-  (fold_right_sepcon R' |--  func_ptr fs v) ->
+  (fold_right_sepcon R' ⊢ <absorb> func_ptr fs v) ->
 
-  funspec_sub fs (mk_funspec (argsig,retty) cc A Pre Post NEPre NEPost) ->
+  funspec_sub fs (mk_funspec (argsig,retty) cc A Ef Pre Post) ->
 
-  (fold_right_sepcon R' |-- |> fold_right_sepcon R) ->
+  (fold_right_sepcon R' ⊢ ▷ fold_right_sepcon R) ->
 
   Cop.classify_fun (typeof a) = Cop.fun_case_f argsig retty cc ->
   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
-         |-- (tc_expr Delta a)  ->
+         ⊢ (tc_expr Delta a)  ->
   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
-          |--  (tc_exprlist Delta argsig bl) ->
+          ⊢  (tc_exprlist Delta argsig bl) ->
   force_list (map (msubst_eval_expr Delta Qtemp Qvar GV)
                     (explicit_cast_exprlist argsig bl))
                 = Some vl ->
- OLDcall_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl (*Qactuals*).
-Proof. intros.
-assert (H18 := @msubst_eval_expr_eq cs Delta P Qtemp Qvar GV R' a v H0).
-assert (H19 := local2ptree_soundness P Q R' Qtemp Qvar nil GV H).
-split; repeat match goal with |- _ /\ _ => split end; auto.
-hnf; intros.
-eapply semax_pre; [ | eassumption].
-clear c Post0 H8.
-Exists v.
-apply andp_right; [ | apply andp_left2; auto].
-apply andp_right.
-repeat apply andp_left2.
-intro rho; unfold SEPx, lift0.
-apply H1.
-rewrite H19.
-simpl app.
-apply H18.
-unfold PROPx, LOCALx.
-rewrite <- !andp_assoc, later_andp; apply andp_derives; [apply now_later|].
-unfold SEPx; simpl; auto.
+ OLDcall_setup1 E Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Ef Pre Post bl vl (*Qactuals*).
+Proof.
+  intros.
+  assert (H18 := msubst_eval_expr_eq Delta P Qtemp Qvar GV R' a v H0).
+  assert (H19 := local2ptree_soundness P Q R' Qtemp Qvar nil GV H).
+  split; repeat match goal with |- _ /\ _ => split end; auto.
+  2: { iIntros "(? & ? & ?)"; rewrite /SEPx H3; repeat (iSplit; auto). }
+  hnf; intros.
+  eapply semax_pre; [ | eassumption].
+  clear c Post0 H8.
+  Exists v.
+  iIntros "(#? & H)"; iSplit; last done.
+  iAssert (local ((` (eq v)) (eval_expr a))) with "[-]" as "#?".
+  - rewrite -H18.
+    iSplit; first done.
+    by iApply H19.
+  - iDestruct "H" as "(_ & _ & H)".
+    rewrite /SEPx H1 embed_absorbingly.
+    rewrite bi.persistent_and_affinely_sep_r bi.absorbingly_sep; iFrame; auto.
 Qed.
 
 Lemma call_setup1_i:
- forall (cs: compspecs) Delta P Q R (a: expr) (bl: list expr)
+ forall E Delta P Q R (a: expr) (bl: list expr)
    Qtemp Qvar GV (v: val)
-   fs argsig retty cc (A: rmaps.TypeTree)  Pre Post NEPre NEPost
+   fs argsig retty cc (A: TypeTree) Ef Pre Post
   (vl : list val),
   local2ptree Q = (Qtemp, Qvar, nil, GV) ->
   msubst_eval_expr Delta Qtemp Qvar GV a = Some v ->
 
-  (fold_right_sepcon R |--  func_ptr fs v) ->
+  (fold_right_sepcon R ⊢ <absorb> func_ptr fs v) ->
 
-  funspec_sub fs (mk_funspec (argsig,retty) cc A Pre Post NEPre NEPost) ->
+  funspec_sub fs (mk_funspec (argsig,retty) cc A Ef Pre Post) ->
 
   Cop.classify_fun (typeof a) = Cop.fun_case_f argsig retty cc ->
   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
-         |-- (tc_expr Delta a)  ->
+         ⊢ (tc_expr Delta a)  ->
   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
-          |--  (tc_exprlist Delta argsig bl) ->
+          ⊢  (tc_exprlist Delta argsig bl) ->
   force_list (map (msubst_eval_expr Delta Qtemp Qvar GV)
                     (explicit_cast_exprlist argsig bl))
                 = Some vl ->
- call_setup1 cs Qtemp Qvar GV a Delta P Q R (*R'*) fs argsig retty cc A Pre Post NEPre NEPost bl vl (*Qactuals*).
-Proof. intros.
-assert (H18 := @msubst_eval_expr_eq cs Delta P Qtemp Qvar GV R a v H0).
-assert (H19 := local2ptree_soundness P Q R Qtemp Qvar nil GV H).
-split; repeat match goal with |- _ /\ _ => split end; auto.
-hnf; intros.
-eapply semax_pre; [ | eassumption].
-clear c Post0 H7.
-Exists v.
-apply andp_right; [ | apply andp_left2; auto].
-apply andp_right.
-repeat apply andp_left2.
-intro rho; unfold SEPx, lift0.
-apply H1.
-rewrite H19.
-simpl app.
-apply H18.
+ call_setup1 E Qtemp Qvar GV a Delta P Q R (*R'*) fs argsig retty cc A Ef Pre Post bl vl (*Qactuals*).
+Proof.
+  intros.
+  assert (H18 := msubst_eval_expr_eq Delta P Qtemp Qvar GV R a v H0).
+  assert (H19 := local2ptree_soundness P Q R Qtemp Qvar nil GV H).
+  split; repeat match goal with |- _ /\ _ => split end; auto.
+  hnf; intros.
+  eapply semax_pre; [ | eassumption].
+  clear c Post0 H7.
+  Exists v.
+  iIntros "(#? & H)"; iSplit; last done.
+  iAssert (local ((` (eq v)) (eval_expr a))) with "[-]" as "#?".
+  - rewrite -H18.
+    iSplit; first done.
+    by iApply H19.
+  - iDestruct "H" as "(_ & _ & H)".
+    rewrite /SEPx H1 embed_absorbingly.
+    rewrite bi.persistent_and_affinely_sep_r bi.absorbingly_sep; iFrame; auto.
 Qed.
 
 Lemma OLDcall_setup1_i2:
- forall (cs: compspecs) Delta P Q R R' (id: ident) (ty: type) (bl: list expr)
+ forall E Delta P Q R R' (id: ident) (ty: type) (bl: list expr)
    Qtemp Qvar GV
-   fs argsig retty cc (A: rmaps.TypeTree)  Pre Post NEPre NEPost
+   fs argsig retty cc (A: TypeTree) Ef Pre Post
   (vl : list val),
   local2ptree Q = (Qtemp, Qvar, nil, GV) ->
 
-  can_assume_funcptr  cs Delta P Q R' (Evar id ty) fs ->
+  can_assume_funcptr E Delta P Q R' (Evar id ty) fs ->
 
-  funspec_sub fs (mk_funspec (argsig,retty) cc A Pre Post NEPre NEPost) ->
+  funspec_sub fs (mk_funspec (argsig,retty) cc A Ef Pre Post) ->
 
-  (PROPx P (LOCALx Q (SEPx R')) |-- |> PROPx P (LOCALx Q (SEPx R))) ->
+  (PROPx P (LOCALx Q (SEPx R')) ⊢ ▷ PROPx P (LOCALx Q (SEPx R))) ->
 
   Cop.classify_fun ty = Cop.fun_case_f argsig retty cc ->
   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
-         |-- (tc_expr Delta (Evar id ty))  ->
+         ⊢ (tc_expr Delta (Evar id ty))  ->
   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
-          |--  (tc_exprlist Delta argsig bl) ->
+          ⊢  (tc_exprlist Delta argsig bl) ->
   force_list (map (msubst_eval_expr Delta Qtemp Qvar GV)
                     (explicit_cast_exprlist argsig bl))
                 = Some vl ->
- OLDcall_setup1 cs Qtemp Qvar GV (Evar id ty) Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl (*Qactuals*).
-Proof. intros.
-split; repeat match goal with |- _ /\ _ => split end; auto.
+ OLDcall_setup1 E Qtemp Qvar GV (Evar id ty) Delta P Q R R' fs argsig retty cc A Ef Pre Post bl vl (*Qactuals*).
+Proof.
+  intros.
+  split; repeat match goal with |- _ /\ _ => split end; auto.
 Qed.
 
 Lemma call_setup1_i2:
- forall (cs: compspecs) Delta P Q R  (id: ident) (ty: type) (bl: list expr)
+ forall E Delta P Q R  (id: ident) (ty: type) (bl: list expr)
    Qtemp Qvar GV
-   fs argsig retty cc (A: rmaps.TypeTree)  Pre Post NEPre NEPost
+   fs argsig retty cc (A: TypeTree) Ef Pre Post
   (vl : list val),
   local2ptree Q = (Qtemp, Qvar, nil, GV) ->
 
-  can_assume_funcptr  cs Delta P Q R (Evar id ty) fs ->
+  can_assume_funcptr E Delta P Q R (Evar id ty) fs ->
 
-  funspec_sub fs (mk_funspec (argsig,retty) cc A Pre Post NEPre NEPost) ->
+  funspec_sub fs (mk_funspec (argsig,retty) cc A Ef Pre Post) ->
 
   Cop.classify_fun ty = Cop.fun_case_f argsig retty cc ->
   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
-         |-- (tc_expr Delta (Evar id ty))  ->
+         ⊢ (tc_expr Delta (Evar id ty))  ->
   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
-          |--  (tc_exprlist Delta argsig bl) ->
+          ⊢  (tc_exprlist Delta argsig bl) ->
   force_list (map (msubst_eval_expr Delta Qtemp Qvar GV)
                     (explicit_cast_exprlist argsig bl))
                 = Some vl ->
- call_setup1 cs Qtemp Qvar GV (Evar id ty) Delta P Q R fs argsig retty cc A Pre Post NEPre NEPost bl vl (*Qactuals*).
-Proof. intros.
-split; repeat match goal with |- _ /\ _ => split end; auto.
+ call_setup1 E Qtemp Qvar GV (Evar id ty) Delta P Q R fs argsig retty cc A Ef Pre Post bl vl (*Qactuals*).
+Proof.
+  intros.
+  split; repeat match goal with |- _ /\ _ => split end; auto.
 Qed.
 
 Lemma can_assume_funcptr1:
-  forall  cs Delta P Q R a fs v Qtemp Qvar GV,
+  forall E Delta P Q R a fs v Qtemp Qvar GV,
   local2ptree Q = (Qtemp, Qvar, nil, GV) ->
   msubst_eval_expr Delta Qtemp Qvar GV a = Some v ->
-   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- lift0(func_ptr fs v) ->
-   can_assume_funcptr cs Delta P Q R a fs.
+   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢ <absorb> ⎡func_ptr fs v⎤ ->
+   can_assume_funcptr E Delta P Q R a fs.
 Proof.
-intros.
-unfold can_assume_funcptr; intros.
-eapply semax_pre; [ | eassumption].
-apply andp_right; [ | apply andp_left2; auto].
-Exists v.
-apply andp_right; auto.
-assert (H8 := @msubst_eval_expr_eq cs Delta P Qtemp Qvar GV R a v H0).
-eapply local2ptree_soundness' in H.
-simpl in H; rewrite <- H in H8.
-eapply derives_trans, H8.
-rewrite app_nil_r; auto.
+  intros.
+  unfold can_assume_funcptr; intros.
+  eapply semax_pre; [ | eassumption].
+  Exists v.
+  iIntros "(#? & H)"; iSplit; last done.
+  iAssert (local ((` (eq v)) (eval_expr a))) with "[-]" as "#?".
+  - assert (H8 := msubst_eval_expr_eq Delta P Qtemp Qvar GV R a v H0).
+    eapply local2ptree_soundness' in H.
+    simpl in H; rewrite <- H in H8.
+    rewrite -H8 app_nil_r; auto.
+  - rewrite bi.persistent_and_affinely_sep_r bi.absorbingly_sep; iSplit; auto.
+    iApply H1; auto.
 Qed.
 
 Lemma can_assume_funcptr2:
   forall id ty cs Delta P Q R fs ,
-   (var_types Delta) ! id = None ->
-   (glob_specs Delta) ! id = Some fs ->
-   (glob_types Delta) ! id = Some (type_of_funspec fs) ->
+   (var_types Delta) !! id = None ->
+   (glob_specs Delta) !! id = Some fs ->
+   (glob_types Delta) !! id = Some (type_of_funspec fs) ->
    ty = (type_of_funspec fs) ->
    can_assume_funcptr cs Delta P Q R (Evar id ty) fs.
 Proof.
-unfold can_assume_funcptr; intros.
-eapply (semax_fun_id id); try eassumption.
-eapply semax_pre; try apply H3. clear H3.
-apply andp_right; [ | apply andp_left2; apply andp_left1; auto].
-apply andp_left2.
-apply andp_left2.
-intro rho.
-unfold_lift.
-unfold local, lift0, lift1.
-simpl.
-Exists (eval_var id (type_of_funspec fs) rho).
-apply andp_right; auto.
-apply prop_right.
-subst ty.
-auto.
+  unfold can_assume_funcptr; intros.
+  eapply (semax_fun_id id); try eassumption.
+  eapply semax_pre; try apply H3. clear H3.
+  rewrite bi.and_elim_r.
+  split => rho; monPred.unseal.
+  rewrite comm; apply bi.sep_mono; last done.
+  Exists (eval_var id (type_of_funspec fs) rho).
+  iIntros "$"; iPureIntro.
+  subst ty; unfold_lift; auto.
 Qed.
 
 Lemma local2ptree_aux_gvarsSome: forall gs T1 T2 P a,
@@ -751,83 +635,85 @@ Proof.
 Qed.
 
 Definition call_setup2
-  (cs: compspecs) Qtemp Qvar GV a Delta P Q R R'
-   fs argsig retty cc ts (A: rmaps.TypeTree)  Pre Post NEPre NEPost
+  E Qtemp Qvar GV a Delta P Q R R'
+   fs argsig retty cc (A: TypeTree) Ef Pre Post
   (bl: list expr) (vl : list val)
-  (witness: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts A) mpred)
+  witness
   (Frame: list mpred)
   (Ppre: list Prop) (Rpre: list mpred)
   GV' gv args :=
- call_setup1 cs Qtemp Qvar GV a Delta P Q R' fs argsig retty cc A Pre Post NEPre NEPost bl vl (*Qactuals*) /\
- PROPx P (LOCALx Q (SEPx R')) |-- |> PROPx P (LOCALx Q (SEPx R)) /\
-  Pre ts witness = PROPx Ppre (LAMBDAx gv args (SEPx Rpre)) /\
+ call_setup1 E Qtemp Qvar GV a Delta P Q R' fs argsig retty cc A Ef Pre Post bl vl (*Qactuals*) /\
+  (PROPx P (LOCALx Q (SEPx R')) ⊢ ▷ PROPx P (LOCALx Q (SEPx R))) /\
+  Ef witness ⊆ E /\
+  Pre witness = PROPx Ppre (LAMBDAx gv args (SEPx Rpre)) /\
   local2ptree (map gvars gv) = (PTree.empty _, PTree.empty _, nil, GV') /\
-  ENTAIL Delta, PROPx P (LOCALx Q (SEPx R')) |-- !! (firstn (length argsig) vl=args) /\
+  (ENTAIL Delta, PROPx P (LOCALx Q (SEPx R')) ⊢ ⌜firstn (length argsig) vl=args⌝) /\
   check_gvars_spec GV GV' /\
-  (fold_right_sepcon R |-- fold_right_sepcon Rpre * fold_right_sepcon Frame).
+  (fold_right_sepcon R ⊢ fold_right_sepcon Rpre ∗ fold_right_sepcon Frame).
 
 Lemma call_setup2_i:
- forall  (cs: compspecs) Qtemp Qvar GV a Delta P Q R R'
-   fs argsig retty cc ts (A: rmaps.TypeTree) Pre Post NEPre NEPost
+ forall E Qtemp Qvar GV a Delta P Q R R'
+   fs argsig retty cc (A: TypeTree) Ef Pre Post
   (bl: list expr) (vl : list val)
-  (SETUP1: call_setup1 cs Qtemp Qvar GV a Delta P Q R' fs argsig retty cc A Pre Post NEPre NEPost bl vl (*Qactuals*))
-  (witness': functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts A) mpred)
+  (SETUP1: call_setup1 E Qtemp Qvar GV a Delta P Q R' fs argsig retty cc A Ef Pre Post bl vl (*Qactuals*))
+  witness'
   (Frame: list mpred)
   (Ppre: list Prop) (Rpre: list mpred)
   GV' gv args,
-  Pre ts witness' = PROPx Ppre (LAMBDAx gv args (SEPx Rpre)) ->
+  Ef witness' ⊆ E ->
+  Pre witness' = PROPx Ppre (LAMBDAx gv args (SEPx Rpre)) ->
   local2ptree (map gvars gv) = (PTree.empty _, PTree.empty _, nil, GV') ->
 
-  ENTAIL Delta, PROPx P (LOCALx Q (SEPx R')) |-- !! (firstn (length argsig) vl=args) ->
+  ENTAIL Delta, PROPx P (LOCALx Q (SEPx R')) ⊢ ⌜firstn (length argsig) vl=args⌝ ->
 
-  PROPx P (LOCALx Q (SEPx R')) |-- |> PROPx P (LOCALx Q (SEPx R)) ->
+  (PROPx P (LOCALx Q (SEPx R')) ⊢ ▷ PROPx P (LOCALx Q (SEPx R))) ->
   check_gvars_spec GV GV' ->
-  fold_right_sepcon R |-- fold_right_sepcon Rpre * fold_right_sepcon Frame ->
-  call_setup2 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl (*Qactuals*)
+  (fold_right_sepcon R ⊢ fold_right_sepcon Rpre ∗ fold_right_sepcon Frame) ->
+  call_setup2 E Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Ef Pre Post bl vl (*Qactuals*)
       witness' Frame Ppre Rpre GV' gv args.
 Proof.
- intros. split. auto. split; repeat match goal with |- _ /\ _ => split end; auto.
+  intros. split. auto. split; repeat match goal with |- _ /\ _ => split end; auto.
 Qed.
 
-Definition call_setup2_nil
-  (cs: compspecs) Qtemp Qvar GV a Delta P Q R R'
-   fs argsig retty cc (A: rmaps.TypeTree)  Pre Post NEPre NEPost
+(*Definition call_setup2_nil
+  E Qtemp Qvar GV a Delta P Q R R'
+   fs argsig retty cc (A: TypeTree)  Pre Post
   (bl: list expr) (vl : list val)
-  (witness: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec nil A) mpred)
+  witness
   (Frame: list mpred)
   (Ppre: list Prop) (Rpre: list mpred)
   GV' gv args:=
- call_setup1 cs Qtemp Qvar GV a Delta P Q R' fs argsig retty cc A Pre Post NEPre NEPost bl vl (*Qactuals*) /\
- PROPx P (LOCALx Q (SEPx R')) |-- |> PROPx P (LOCALx Q (SEPx R)) /\
-  Pre nil witness = PROPx Ppre (LAMBDAx gv args (SEPx Rpre)) /\
+ call_setup1 E Qtemp Qvar GV a Delta P Q R' fs argsig retty cc A Pre Post bl vl (*Qactuals*) /\
+  (PROPx P (LOCALx Q (SEPx R')) ⊢ ▷ PROPx P (LOCALx Q (SEPx R))) /\
+  Pre witness = PROPx Ppre (LAMBDAx gv args (SEPx Rpre)) /\
   local2ptree (map gvars gv) = (PTree.empty _, PTree.empty _, nil, GV') /\
 
-  ENTAIL Delta, PROPx P (LOCALx Q (SEPx R')) |-- !! (firstn (length argsig) vl=args) /\
+  ENTAIL Delta, PROPx P (LOCALx Q (SEPx R')) ⊢ ⌜firstn (length argsig) vl=args⌝ /\
 
   check_gvars_spec GV GV' /\
-  (fold_right_sepcon R |-- fold_right_sepcon Rpre * fold_right_sepcon Frame).
+  (fold_right_sepcon R ⊢ fold_right_sepcon Rpre ∗ fold_right_sepcon Frame).
 
 Lemma call_setup2_nil_equiv:
   forall (cs: compspecs) Qtemp Qvar GV a Delta P Q R R'
-   fs argsig retty cc (A: rmaps.TypeTree)  Pre Post NEPre NEPost
+   fs argsig retty cc (A: TypeTree)  Pre Post
   (bl: list expr) (vl : list val)
-  (witness: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec nil A) mpred)
+  witness
   (Frame: list mpred)
   (Ppre: list Prop) (Rpre: list mpred)
    GV' gv args,
     call_setup2_nil cs Qtemp Qvar GV a Delta P Q R R'
-                    fs argsig retty cc A Pre Post NEPre NEPost bl vl
+                    fs argsig retty cc A Pre Post bl vl
                     witness Frame Ppre Rpre GV' gv args =
     call_setup2 cs Qtemp Qvar GV a Delta P Q R R'
-                    fs argsig retty cc nil A Pre Post NEPre NEPost bl vl
+                    fs argsig retty cc nil A Pre Post bl vl
                     witness Frame Ppre Rpre GV' gv args.
 reflexivity. Qed.
 
 Lemma call_setup2_i_nil:
  forall  (cs: compspecs) Qtemp Qvar GV a Delta P Q R R'
-   fs argsig retty cc (A: rmaps.TypeTree)  Pre Post NEPre NEPost
+   fs argsig retty cc (A: TypeTree)  Pre Post
   (bl: list expr) (vl : list val)
-  (SETUP1: call_setup1 cs Qtemp Qvar GV a Delta P Q (*R*)R' fs argsig retty cc A Pre Post NEPre NEPost bl vl (*Qactuals*))
+  (SETUP1: call_setup1 cs Qtemp Qvar GV a Delta P Q (*R*)R' fs argsig retty cc A Pre Post bl vl (*Qactuals*))
   (witness': functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec nil A) mpred)
   (Frame: list mpred)
   (Ppre: list Prop) (Qpre : list localdef) (Rpre: list mpred)
@@ -835,16 +721,16 @@ Lemma call_setup2_i_nil:
   Pre nil witness' = PROPx Ppre (LAMBDAx gv args (SEPx Rpre)) ->
   local2ptree (map gvars gv) = (PTree.empty _, PTree.empty _, nil, GV')  ->
 
-  ENTAIL Delta, PROPx P (LOCALx Q (SEPx R')) |-- !! (firstn (length argsig) vl=args) ->
+  ENTAIL Delta, PROPx P (LOCALx Q (SEPx R')) ⊢ ⌜firstn (length argsig) vl=args⌝ ->
 
-  PROPx P (LOCALx Q (SEPx R')) |-- |> PROPx P (LOCALx Q (SEPx R)) ->
+  PROPx P (LOCALx Q (SEPx R')) ⊢ ▷ PROPx P (LOCALx Q (SEPx R)) ->
   check_gvars_spec GV GV' ->
-  fold_right_sepcon R |-- fold_right_sepcon Rpre * fold_right_sepcon Frame ->
-  call_setup2_nil cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl (*Qactuals*)
+  fold_right_sepcon R ⊢ fold_right_sepcon Rpre ∗ fold_right_sepcon Frame ->
+  call_setup2_nil cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post bl vl (*Qactuals*)
       witness' Frame Ppre Rpre GV' gv args.
 Proof.
  intros. split. auto. split; repeat match goal with |- _ /\ _ => split end; auto.
-Qed.
+Qed.*)
 
 Lemma actual_value_not_Vundef:
  forall (cs: compspecs) (Qtemp: PTree.t val) (Qvar: PTree.t (type * val))
@@ -852,45 +738,36 @@ Lemma actual_value_not_Vundef:
  (PTREE : local2ptree Q = (Qtemp, Qvar, nil, GV))
  (MSUBST : force_list (map (msubst_eval_expr Delta Qtemp Qvar GV)
                            (explicit_cast_exprlist tl bl)) = Some vl),
-   (tc_exprlist Delta tl bl) && local (tc_environ Delta) && |> PROPx P (LOCALx Q (SEPx R))
-   = (tc_exprlist Delta tl bl) && local (tc_environ Delta) && |> (PROPx P (LOCALx Q (SEPx R)) && !! Forall (fun v : val => v <> Vundef) vl).
+   (tc_exprlist Delta tl bl) ∧ local (tc_environ Delta) ∧ ▷ PROPx P (LOCALx Q (SEPx R))
+   ⊣⊢ (tc_exprlist Delta tl bl) ∧ local (tc_environ Delta) ∧ ▷ (PROPx P (LOCALx Q (SEPx R)) ∧ ⌜Forall (fun v : val => v <> Vundef) vl⌝).
 Proof.
   intros.
   eapply (msubst_eval_exprlist_eq Delta P Qtemp Qvar GV R) in MSUBST.
   apply (local2ptree_soundness P Q R) in PTREE; simpl app in PTREE.
   rewrite <- PTREE in MSUBST; clear PTREE; rename MSUBST into EVAL.
-  apply pred_ext; [| apply andp_derives; auto; apply later_derives; normalize].
-  rewrite later_andp, <- andp_assoc.
-  apply andp_right; auto.
-  apply later_left2.
-
-  rewrite andp_assoc. rewrite (add_andp _ _ EVAL); clear EVAL. rewrite andp_comm.
-
-  rewrite (andp_comm _ (PROPx _ _)), !andp_assoc.
-  apply andp_left2.
-  go_lowerx.
-  revert bl vl H0; induction tl; intros.
-  + destruct bl; simpl; [| apply FF_left].
-    apply prop_right.
-    subst; simpl; constructor.
-  + Opaque typecheck_expr. destruct bl; simpl; [apply FF_left |].
-    unfold tc_exprlist; simpl. rewrite denote_tc_assert_andp.
-    subst vl. simpl. Transparent typecheck_expr.
-    eapply derives_trans; [apply andp_derives; [apply typecheck_expr_sound; auto | apply IHtl; reflexivity] |].
-    normalize.
-    simpl in H0.
-    unfold_lift in H0; unfold_lift.
-    constructor; auto.
-    intro.
-    unfold force_val1 in H0; unfold Basics.compose in H2.
-    rewrite H2 in H0; clear H2.
-    apply tc_val_Vundef in H0; auto.
+  apply bi.equiv_entails_2.
+  2: { apply bi.and_mono, bi.and_mono; [done..|]; iIntros "($ & _)". }
+  rewrite assoc (bi.and_comm (tc_exprlist _ _ _) (local _)) -assoc.
+  iIntros "(#? & H)".
+  iSplit; first rewrite bi.and_elim_l //.
+  iSplit; first done.
+  iIntros "!>"; iSplit; first rewrite bi.and_elim_r //.
+  iPoseProof (EVAL with "[-]") as "#H1".
+  { rewrite bi.and_elim_r; auto. }
+  rewrite bi.and_elim_l.
+  iStopProof.
+  split => rho; monPred.unseal; rewrite monPred_at_intuitionistically.
+  unfold_lift; simpl.
+  iIntros "((% & ->) & ?)".
+  iPoseProof (tc_eval_exprlist with "[-]") as "%"; [done..|].
+  iPureIntro.
+  eapply tc_vals_Vundef; eauto.
 Qed.
 
 Lemma in_gvars_sub:
   forall rho G G', Forall (fun x : globals => In x G) G' ->
-  fold_right `(and) `(True) (map locald_denote (map gvars G)) rho ->
-  fold_right `(and) `(True) (map locald_denote (map gvars G')) rho.
+  fold_right `(and) `(True%type) (map locald_denote (map gvars G)) rho ->
+  fold_right `(and) `(True%type) (map locald_denote (map gvars G')) rho.
 Proof.
 intros.
 pose proof (proj1 (Forall_forall _ G') H).
@@ -912,144 +789,109 @@ Proof. induction l; simpl; trivial.
 intros. exfalso. eapply app_cons_not_nil. symmetry. apply H. Qed.
 
 Lemma local2ptree_aux_elim: forall Q rho
-(H: fold_right (` and) (` True) (map locald_denote Q) rho) T1 T2 P X Qtemp Qvar PP g
+(H: fold_right (` and) (` True%type) (map locald_denote Q) rho) T1 T2 P X Qtemp Qvar PP g
 (L: local2ptree_aux Q T1 T2 P X = (Qtemp, Qvar, PP, Some g))
 (HX: match X with
-      Some gg => (` and) (gvars_denote gg) (` True)
+      Some gg => (` and) (gvars_denote gg) (` True%type)
                  (mkEnviron (ge_of rho) (Map.empty (block * type)) (Map.empty val))
     | None => True
      end),
-(` and) (gvars_denote g) (` True)
+(` and) (gvars_denote g) (` True%type)
   (mkEnviron (ge_of rho) (Map.empty (block * type)) (Map.empty val)).
 Proof.
 intros ? ? ?.
 induction Q; intros.
 + simpl in L. inv L. trivial.
 + destruct H. destruct a; simpl in L.
-  * destruct (T1 ! i).
+  * destruct (T1 !! i).
     - apply IHQ in L; clear IHQ; trivial.
     - apply IHQ in L; clear IHQ; trivial.
-  * destruct (T2 ! i).
+  * destruct (T2 !! i).
     - destruct p; apply IHQ in L; clear IHQ; trivial.
     - apply IHQ in L; clear IHQ; trivial.
   * destruct X.
     - apply IHQ in L; clear IHQ; trivial.
     - apply IHQ in L; clear IHQ; trivial.
-      clear - H. unfold locald_denote in H. split. apply H. trivial.
+      clear - H. unfold locald_denote in H. split. apply H. unfold_lift; trivial.
 Qed.
 
 Lemma semax_call_aux55:
- forall (cs: compspecs) (Qtemp: PTree.t val) (Qvar: PTree.t (type * val)) GV (a: expr)
-     Delta P Q R R' fs argsig ts (A : rmaps.TypeTree)
-     (Pre : forall ts : list Type,
-              functors.MixVariantFunctor._functor
-                (rmaps.dependent_type_functor_rec ts (ArgsTT A)) mpred)
-     (Post : forall ts : list Type,
-              functors.MixVariantFunctor._functor
-                (rmaps.dependent_type_functor_rec ts (AssertTT A)) mpred)
+ forall (Qtemp: PTree.t val) (Qvar: PTree.t (type * val)) GV (a: expr)
+     Delta P Q R R' fs argsig (A : TypeTree)
+     (Pre : dtfr (ArgsTT A))
     witness Frame bl Ppre Rpre GV' vl gv args
  (PTREE : local2ptree Q = (Qtemp, Qvar, nil, GV))
  (MSUBST : force_list (map (msubst_eval_expr Delta Qtemp Qvar GV)
               (explicit_cast_exprlist argsig bl)) = Some vl)
 
- (PRE1: Pre ts witness = PROPx Ppre (LAMBDAx gv args (SEPx Rpre)))
+ (PRE1: Pre witness = PROPx Ppre (LAMBDAx gv args (SEPx Rpre)))
  (PTREE': local2ptree (map gvars gv) = (PTree.empty _, PTree.empty _, nil, GV'))
  (CHECKTEMP : firstn (length argsig) vl=args)
 
  (CHECKG: check_gvars_spec GV GV' )
- (HR': PROPx P (LOCALx Q (SEPx R')) |-- |> PROPx P (LOCALx Q (SEPx R)))
+ (HR': PROPx P (LOCALx Q (SEPx R')) ⊢ ▷ PROPx P (LOCALx Q (SEPx R)))
  (FRAME : fold_right_sepcon R
-           |-- fold_right_sepcon Rpre * fold_right_sepcon Frame)
+           ⊢ fold_right_sepcon Rpre ∗ fold_right_sepcon Frame)
  (PPRE : fold_right_and True Ppre)
  (LEN : length argsig = length bl),
-ENTAIL Delta, tc_expr Delta a && tc_exprlist Delta argsig bl &&
-(EX v : val,
- lift0 (func_ptr fs v) &&
- local (` (eq v) (eval_expr a))) && PROPx P (LOCALx Q (SEPx R'))
-|--(tc_expr Delta a && tc_exprlist Delta argsig bl) &&
-    (|> (fun rho => Pre ts witness (ge_of rho, eval_exprlist argsig bl rho)) *
-     ` (func_ptr' fs)
-       (eval_expr a) * |>PROPx P (LOCALx Q (SEPx Frame))).
+ENTAIL Delta, (tc_expr Delta a ∧ tc_exprlist Delta argsig bl ∧
+(∃ v : val,
+ ⎡func_ptr fs v⎤ ∧
+ local (` (eq v) (eval_expr a))) ∗ PROPx P (LOCALx Q (SEPx R')))
+⊢((tc_expr Delta a ∧ tc_exprlist Delta argsig bl) ∧
+    (▷ (assert_of (fun rho => Pre witness (ge_of rho, eval_exprlist argsig bl rho))) ∗
+     assert_of (` (func_ptr fs)
+       (eval_expr a)) ∗ ▷PROPx P (LOCALx Q (SEPx Frame)))).
 Proof.
-intros; subst args.
-pose proof actual_value_not_Vundef _ _ _ _ P _ R _ _ _ _ PTREE MSUBST as VUNDEF.
-rewrite <- ! andp_assoc.
-rewrite (andp_comm _ (EX v : val, lift0 (func_ptr fs v) && local ((` (eq v)) (eval_expr a)))%assert).
-rewrite ! andp_assoc.
-rewrite !exp_andp1. Intros v.
-repeat apply andp_right; auto; try solve [ solve_andp].
-rewrite andp_comm. rewrite andp_assoc.
-rewrite PRE1.
-match goal with |- _ |-- ?A * ?B * ?C => pull_right B end.
-rewrite sepcon_comm.
-rewrite func_ptr'_func_ptr_lifted.
-apply ENTAIL_trans with
- (`(func_ptr fs) (eval_expr a) && (tc_exprlist Delta argsig bl &&
-   |>PROPx P (LOCALx Q (SEPx R)))).
-{
-  apply andp_left2. rewrite <- andp_assoc.
-  apply andp_right.
-  + rewrite ! andp_assoc.  do 3 apply andp_left2.
-    intro rho; unfold_lift; unfold local, lift0, lift1; simpl. normalize.
-  + apply andp_right. solve_andp. do 2 apply andp_left1. do 2 apply andp_left2. trivial.  }
-apply andp_right.
-{ apply andp_left2; apply andp_left1; auto. }
-forget (tc_exprlist Delta argsig bl) as TCEXPRLIST.
-eapply derives_trans;[ apply andp_derives; [apply derives_refl | apply andp_left2; apply derives_refl] |].
-  apply derives_trans
-  with (TCEXPRLIST && local (tc_environ Delta) && |> PROPx P (LOCALx Q (SEPx R))).
-  { rewrite andp_comm. solve_andp. }
-  rewrite VUNDEF, <- later_sepcon.
-  apply later_left2. normalize.
-  rewrite <- andp_assoc. rewrite andp_comm.
-  apply derives_extract_prop. intro VL.
-  apply @msubst_eval_exprlist_eq with (P:=P)(R:=R)(GV:=GV) in MSUBST.
-
-clear - PTREE PTREE' FRAME PPRE LEN CHECKG MSUBST VL.
-rewrite andp_assoc. apply andp_left2.
-apply derives_trans with (local ((` (eq vl)) (eval_exprlist argsig bl)) &&
-    PROPx P (LOCALx Q (SEPx R))).
-{ apply (local2ptree_soundness P _ R) in PTREE. simpl app in PTREE.
-  rewrite PTREE. rewrite (add_andp _ _ MSUBST); solve_andp. }
-clear MSUBST. unfold local, liftx, lift1, lift; simpl. intros rho; normalize.
-
-unfold PROPx at 2; normalize.
-simpl. rewrite sepcon_andp_prop'.
-apply andp_right.
-{ apply prop_right; trivial.
-  clear - PPRE.
-  revert PPRE; induction Ppre; simpl; tauto. }
-unfold PARAMSx, GLOBALSx, PROPx, LOCALx, SEPx, argsassert2assert. simpl. normalize.
-unfold local, liftx, lift1, lift; simpl. normalize.
-eapply derives_trans; [ apply FRAME | clear FRAME].
-apply andp_right; [ apply prop_right | trivial].
-split; [|split3]; trivial.
--
-clear - LEN.
-revert bl LEN; induction argsig; destruct bl; simpl; intros; inv LEN; auto.
-unfold_lift. f_equal. auto.
--
-rewrite local2ptree_gvars in PTREE'.
-simpl.
-destruct gv; inv PTREE'.
-+ simpl; trivial.
-+ simpl in CHECKG; subst GV. apply rev_nil_elim in H2. apply map_eq_nil in H2.
-  subst. simpl.
-  apply (local2ptree_aux_elim _ _ H0 _ _ _ _ _ _ _ _ PTREE); trivial.
+  intros; subst args.
+  pose proof actual_value_not_Vundef _ _ _ _ P _ R _ _ _ _ PTREE MSUBST as VUNDEF.
+  Intros v.
+  apply bi.and_intro.
+  { rewrite bi.and_elim_r assoc bi.and_elim_l //. }
+  rewrite bi.sep_assoc (bi.sep_comm (▷ _)) -assoc -bi.later_sep.
+  iIntros "(#TC & _ & _ & #(FP & A) & H)"; iSplitL "".
+  - iClear "TC"; iStopProof; split => rho; monPred.unseal.
+    rewrite monPred_at_intuitionistically /= /lift1. unfold_lift. by iIntros "(#H & ->)".
+  - rewrite HR'; iNext.
+    iAssert (local ((` (eq vl)) (eval_exprlist argsig bl))) with "[-]" as "#?".
+    { apply (local2ptree_soundness P _ R) in PTREE. simpl app in PTREE.
+      apply @msubst_eval_exprlist_eq with (P:=P)(R:=R)(GV:=GV) in MSUBST.
+      iApply MSUBST; rewrite PTREE; auto. }
+    iClear "TC FP A".
+    iDestruct "H" as "(#? & #? & H)".
+    rewrite PRE1 /SEPx FRAME.
+    iDestruct "H" as "(Pre & Frame)"; iSplitL "Pre".
+    + iStopProof; split => rho; monPred.unseal.
+      rewrite monPred_at_intuitionistically /PROPx /PARAMSx /GLOBALSx /LOCALx /=; monPred.unseal.
+      unfold_lift.
+      iIntros "(#(-> & % & %) & H)".
+      iSplit.
+      { iPureIntro; clear - PPRE; induction Ppre; auto; simpl in *.
+        destruct PPRE; auto. }
+      rewrite LEN -(eval_exprlist_length argsig bl rho) // take_ge //.
+      iSplit; first done.
+      rewrite /lift1; iFrame; iPureIntro; split; last done.
+      rewrite local2ptree_gvars in PTREE'.
+      destruct gv; inv PTREE'.
+      * simpl; auto.
+      * simpl in CHECKG; subst. apply rev_nil_elim in H2. apply map_eq_nil in H2.
+        subst. simpl.
+        apply (local2ptree_aux_elim _ _ H0 _ _ _ _ _ _ _ _ PTREE); trivial.
+    + rewrite /PROPx /LOCALx; auto.
 Qed.
 
-Lemma semax_call_aux55_nil:
+(*Lemma semax_call_aux55_nil:
  forall (cs: compspecs) (Qtemp: PTree.t val) (Qvar: PTree.t (type * val)) GV (a: expr)
      Delta P Q R R' fs argsig
-    (A : rmaps.TypeTree)
+    (A : TypeTree)
          (Pre: forall ts : list Type,
               functors.MixVariantFunctor._functor
                 (rmaps.dependent_type_functor_rec
-                   ts (ArgsTT A)) mpred)
+                   ts (ArgsTrue A)) mpred)
           (Post : forall ts : list Type,
               functors.MixVariantFunctor._functor
                 (rmaps.dependent_type_functor_rec
-                   ts (AssertTT A)) mpred)
+                   ts (AssertTrue A)) mpred)
     witness Frame bl Ppre Rpre GV' vl gv args
  (PTREE : local2ptree Q = (Qtemp, Qvar, nil, GV))
  (MSUBST : force_list (map (msubst_eval_expr Delta Qtemp Qvar GV)
@@ -1059,282 +901,278 @@ Lemma semax_call_aux55_nil:
   (CHECKTEMP : firstn (length argsig) vl =args)
 
  (CHECKG: check_gvars_spec GV GV')
- (HR': PROPx P (LOCALx Q (SEPx R')) |-- |> PROPx P (LOCALx Q (SEPx R)))
+ (HR': PROPx P (LOCALx Q (SEPx R')) ⊢ ▷ PROPx P (LOCALx Q (SEPx R)))
  (FRAME : fold_right_sepcon R
-           |-- fold_right_sepcon Rpre * fold_right_sepcon Frame)
+           ⊢ fold_right_sepcon Rpre ∗ fold_right_sepcon Frame)
  (PPRE : fold_right_and True Ppre)
  (LEN : length argsig = length bl),
-ENTAIL Delta, tc_expr Delta a && tc_exprlist Delta argsig bl &&
-(EX v : val,
- lift0 (func_ptr fs v) &&
- local (` (eq v) (eval_expr a))) && PROPx P (LOCALx Q (SEPx R'))
-|-- (tc_expr Delta a && tc_exprlist Delta argsig bl) &&
-    (|> (fun rho => Pre nil witness (ge_of rho, eval_exprlist argsig bl rho)) *
-     ` (func_ptr' fs)
-       (eval_expr a) * |>PROPx P (LOCALx Q (SEPx Frame))).
-Proof. intros. eapply semax_call_aux55 with (ts:=nil); eassumption. Qed.
-
-Lemma tc_exprlist_len : forall {cs : compspecs} Delta argsig bl,
-  tc_exprlist Delta argsig bl |-- !!(length argsig = length bl).
+ENTAIL Delta, tc_expr Delta a ∧ tc_exprlist Delta argsig bl ∧
+(∃ v : val,
+ lift0 (func_ptr fs v) ∧
+ local (` (eq v) (eval_expr a))) ∧ PROPx P (LOCALx Q (SEPx R'))
+⊢ (tc_expr Delta a ∧ tc_exprlist Delta argsig bl) ∧
+    (▷ (fun rho => Pre nil witness (ge_of rho, eval_exprlist argsig bl rho)) ∗
+     ` (func_ptr fs)
+       (eval_expr a) ∗ ▷PROPx P (LOCALx Q (SEPx Frame))).
+Proof. intros. eapply semax_call_aux55 with (ts:=nil); eassumption. Qed.*)
+
+Lemma tc_exprlist_len : forall Delta argsig bl,
+  tc_exprlist Delta argsig bl ⊢ ⌜length argsig = length bl⌝.
 Proof.
  intros.
  go_lowerx.
  unfold tc_exprlist.
  revert bl; induction argsig; destruct bl;
-   simpl; try apply @FF_left.
- apply prop_right; auto.
- repeat rewrite denote_tc_assert_andp. simpl. apply andp_left2.
- eapply derives_trans; [ apply IHargsig | ]. normalize.
+   simpl; auto.
+ rewrite expr2.denote_tc_assert_andp bi.and_elim_r IHargsig; auto.
 Qed.
 
-Lemma semax_pre_setup2 {cs Espec} Delta fs a bl argsig P Q R' Post2 rv (vl args:list val)
-      (TC0 : ENTAIL Delta, PROPx P (LOCALx Q (SEPx R')) |-- tc_expr Delta a)
-      (TC1 : ENTAIL Delta, PROPx P (LOCALx Q (SEPx R')) |-- tc_exprlist Delta argsig bl)
+Lemma semax_pre_setup2 E Delta fs a bl argsig P Q R' Post2 rv (vl args:list val)
+      (TC0 : ENTAIL Delta, PROPx P (LOCALx Q (SEPx R')) ⊢ tc_expr Delta a)
+      (TC1 : ENTAIL Delta, PROPx P (LOCALx Q (SEPx R')) ⊢ tc_exprlist Delta argsig bl)
       (CHECKTEMP : ENTAIL Delta, PROPx P (LOCALx Q (SEPx R'))
-                                       |-- !! (firstn (length argsig) vl=args)):
-  @semax cs Espec Delta
-         (!! (Datatypes.length argsig = Datatypes.length bl) &&
-             !! (firstn (length argsig) vl=args) &&
-             PROPx P (LOCALx Q (SEPx R')) && (tc_expr Delta a && tc_exprlist Delta argsig bl) &&
-             (EX v : val, lift0 (func_ptr fs v) && local ((` (eq v)) (eval_expr a)))%assert)
+                                       ⊢ ⌜firstn (length argsig) vl=args⌝):
+  semax E Delta
+         (⌜Datatypes.length argsig = Datatypes.length bl⌝ ∧
+             ⌜firstn (length argsig) vl=args⌝ ∧
+             (PROPx P (LOCALx Q (SEPx R')) ∧ (tc_expr Delta a ∧ tc_exprlist Delta argsig bl)) ∗
+             (∃ v : val, ⎡func_ptr fs v⎤ ∧ local ((` (eq v)) (eval_expr a)))%assert)
          (Scall rv a bl) (normal_ret_assert Post2) ->
 
-  @semax cs Espec Delta
-         ((EX v : val, lift0 (func_ptr fs v) && local ((` (eq v)) (eval_expr a)))%assert &&
+  semax E Delta
+         ((∃ v : val, ⎡func_ptr fs v⎤ ∧ local ((` (eq v)) (eval_expr a)))%assert ∗
          PROPx P (LOCALx Q (SEPx R'))) (Scall rv a bl) (normal_ret_assert Post2).
 Proof.
   intros.
-  apply semax_pre
-  with  ((tc_expr Delta a && tc_exprlist Delta argsig bl) &&
-         ((EX v : val, lift0 (func_ptr fs v) && local ((` (eq v)) (eval_expr a)))%assert &&
-         (!!(Datatypes.length argsig = Datatypes.length bl) &&
-          !!(firstn (length argsig) vl=args) &&
-         PROPx P (LOCALx Q (SEPx R'))))).
-  { apply andp_right; [| apply andp_right; [apply andp_left2, andp_left1, derives_refl|]].
-    eapply derives_trans; [| apply andp_right; [ apply TC0 | apply TC1]].
-    apply andp_derives; [ | apply andp_left2]; trivial.
-    rewrite <- andp_assoc, andp_comm.
-    rewrite <- andp_assoc; apply andp_left1. apply andp_right. 2: solve_andp.
-    rewrite andp_comm.
-    apply andp_right; trivial.
-    eapply derives_trans; [ apply TC1 | apply tc_exprlist_len]. }
-  rewrite andp_comm, andp_assoc. rewrite <- andp_comm. trivial.
+  eapply semax_pre, H.
+  iIntros "(#? & $ & ?)".
+  iSplit.
+  { iApply tc_exprlist_len; iApply TC1; auto. }
+  iSplit.
+  { iApply CHECKTEMP; auto. }
+  iSplit; first done.
+  iSplit; [iApply TC0 | iApply TC1]; auto.
 Qed.
 
 Lemma semax_call_id00_wow:
- forall  {cs: compspecs} {Qtemp Qvar a GV Delta P Q R R'
-   fs argsig retty cc ts} {A: rmaps.TypeTree} {Pre Post NEPre NEPost}
-   {witness: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts A) mpred}
+ forall {E} {Qtemp Qvar a GV Delta P Q R R'
+   fs argsig retty cc} {A: TypeTree} {Ef: dtfr (MaskTT A)} {Pre: dtfr (ArgsTT A)} {Post: dtfr (AssertTT A)}
+   {witness}
    {Frame: list mpred}
    {bl: list expr}
    {Ppre: list Prop} {Rpre: list mpred} {GV' gv args}
    {vl : list val}
-   (SETUP: call_setup2 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl
+   (SETUP: call_setup2 E Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Ef Pre Post bl vl
       witness Frame Ppre Rpre GV' gv args)
-  Espec
-             (Post2: environ -> mpred)
+             (Post2: assert)
              (B: Type)
              (Ppost: B -> list Prop)
              (Rpost: B -> list mpred)
-   (RETTY: retty = Tvoid)
-   (POST1: Post ts witness = (EX vret:B, PROPx (Ppost vret) (LOCALx nil (SEPx (Rpost vret)))))
-   (POST2: Post2 = EX vret:B, PROPx (P++ Ppost vret ) (LOCALx Q
+   (RETrueY: retty = Tvoid)
+   (POST1: assert_of (Post witness) ⊣⊢ (∃ vret:B, PROPx (Ppost vret) (LOCALx nil (SEPx (Rpost vret)))))
+   (POST2: Post2 ⊣⊢ ∃ vret:B, PROPx (P ++ Ppost vret) (LOCALx Q
              (SEPx (Rpost vret ++ Frame))))
    (PPRE: fold_right_and True Ppre),
-   @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R')))
+   semax E Delta (PROPx P (LOCALx Q (SEPx R')))
     (Scall None a bl)
     (normal_ret_assert Post2).
 Proof.
-intros.
-destruct SETUP as [[PTREE [Hsub [SPEC [ATY [TC0 [TC1 MSUBST]]]]]]
-                            [HR' [PRE1 [PTREE' [CHECKTEMP [CHECKG FRAME]]]]]].
-apply SPEC. clear SPEC.
-eapply semax_pre_setup2; try eassumption.
-clear CHECKTEMP.
-remember (tc_expr Delta a && tc_exprlist Delta argsig bl) as TChecks.
-rewrite ! andp_assoc.
-apply semax_extract_prop; intros.
-apply semax_extract_prop; intros.
-rewrite andp_comm.
-eapply semax_pre_post'; [ | |
-   apply (@semax_call0 Espec cs Delta fs A Pre Post NEPre NEPost
-              ts witness argsig retty cc a bl P Q Frame Hsub)].
-*
-  subst TChecks. eapply semax_call_aux55; eauto.
-*
- subst.
- clear  TC1 PRE1 PPRE.
- intros. normalize.
- rewrite POST1; clear POST1.
- unfold ifvoid.
- go_lowerx. normalize.
- apply exp_right with x.
- rewrite fold_right_and_app_low.
- rewrite fold_right_sepcon_app.
- apply andp_right.
- apply prop_right.
- split; auto.
- normalize.
-*
-assumption.
+  intros.
+  destruct SETUP as [[PTREE [Hsub [SPEC [ATY [TC0 [TC1 MSUBST]]]]]]
+                            [HR' [HE [PRE1 [PTREE' [CHECKTEMP [CHECKG FRAME]]]]]]].
+  apply SPEC. clear SPEC.
+  eapply semax_pre_setup2; try eassumption.
+  clear CHECKTEMP.
+  remember (tc_expr Delta a ∧ tc_exprlist Delta argsig bl) as TChecks.
+  apply semax_extract_prop; intros.
+  apply semax_extract_prop; intros.
+  eapply semax_mask_mono; first done.
+  eapply semax_pre_post', (semax_call0 Delta fs A Ef Pre Post
+              witness argsig retty cc a bl P Q Frame Hsub).
+  * subst TChecks. rewrite -semax_call_aux55 //.
+    iIntros "(? & H)"; iSplit; auto.
+    iSplit.
+    { iDestruct "H" as "((_ & $ & _) & _)". }
+    iSplit.
+    { iDestruct "H" as "((_ & _ & $) & _)". }
+    rewrite bi.and_elim_l comm //.
+  * subst.
+    clear  TC1 PRE1 PPRE.
+    rewrite POST2.
+    go_lowerx.
+    eapply monPred_in_equiv in POST1.
+    simpl in POST1.
+    rewrite POST1; clear POST1.
+    unfold PROPx, LOCALx, SEPx, local, lift1; unfold_lift. monPred.unseal. normalize.
+    Exists x.
+    rewrite fold_right_and_app_low.
+    rewrite fold_right_sepcon_app.
+    normalize.
+  * assumption.
 Qed.
 
-Lemma semax_call_id00_wow_nil:
+(*Lemma semax_call_id00_wow_nil:
  forall {cs: compspecs} {Qtemp Qvar GV a Delta P Q R R'
-   fs argsig retty cc} {A: rmaps.TypeTree} {Pre Post NEPre NEPost}
+   fs argsig retty cc} {A: TypeTree} {Pre Post}
    {witness: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec nil A) mpred}
    {Frame: list mpred}
    {bl: list expr}
    {Ppre: list Prop} {Rpre: list mpred} {GV' gv args}
    {vl : list val}
-   (SETUP: call_setup2_nil cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl
+   (SETUP: call_setup2_nil cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post bl vl
       witness Frame Ppre Rpre GV' gv args)
   Espec
-             (Post2: environ -> mpred)
+             (Post2: assert)
              (B: Type)
              (Ppost: B -> list Prop)
              (Rpost: B -> list mpred)
-   (RETTY: retty = Tvoid)
-   (POST1: Post nil witness = (EX vret:B, PROPx (Ppost vret) (LOCALx nil (SEPx (Rpost vret)))))
-   (POST2: Post2 = EX vret:B, PROPx (P++ Ppost vret ) (LOCALx Q
+   (RETrueY: retty = Tvoid)
+   (POST1: Post nil witness = (∃ vret:B, PROPx (Ppost vret) (LOCALx nil (SEPx (Rpost vret)))))
+   (POST2: Post2 = ∃ vret:B, PROPx (P++ Ppost vret ) (LOCALx Q
              (SEPx (Rpost vret ++ Frame))))
    (PPRE: fold_right_and True Ppre),
-   @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R')))
+   semax E Delta (PROPx P (LOCALx Q (SEPx R')))
     (Scall None a bl)
     (normal_ret_assert Post2).
-Proof. intros. rewrite call_setup2_nil_equiv in SETUP. eapply semax_call_id00_wow; eassumption. Qed.
+Proof. intros. rewrite call_setup2_nil_equiv in SETUP. eapply semax_call_id00_wow; eassumption. Qed.*)
 
 Lemma semax_call_id1_wow:
- forall {cs: compspecs} {Qtemp Qvar GV a Delta P Q R R'
-   fs argsig retty cc ts} {A: rmaps.TypeTree} {Pre Post NEPre NEPost}
-   {witness: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts A) mpred}
+ forall {E} {Qtemp Qvar GV a Delta P Q R R'
+   fs argsig retty cc} {A: TypeTree} {Ef} {Pre Post}
+   {witness}
    {Frame: list mpred}
    {bl: list expr}
    {Ppre: list Prop} {Rpre: list mpred} {GV' gv args}
    {vl : list val}
-   (SETUP: call_setup2 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl
+   (SETUP: call_setup2 E Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Ef Pre Post bl vl
       witness Frame Ppre Rpre GV' gv args)
-   ret (Post2: environ -> mpred)  (Qnew: list localdef)
-    (B: Type) (Ppost: B -> list Prop) (F: B -> val) (Rpost: B -> list mpred) Espec
+   ret (Post2: assert)  (Qnew: list localdef)
+    (B: Type) (Ppost: B -> list Prop) (F: B -> val) (Rpost: B -> list mpred)
    (TYret: typeof_temp Delta ret = Some retty)
    (OKretty: check_retty retty)
-   (POST1: Post ts witness = EX vret:B, PROPx (Ppost vret)
+   (POST1: assert_of (Post witness) ⊣⊢ ∃ vret:B, PROPx (Ppost vret)
                               (LOCALx (temp ret_temp (F vret) :: nil)
                               (SEPx (Rpost vret))))
    (DELETE: remove_localdef_temp ret Q = Qnew)
-   (H0: Post2 = EX vret:B, PROPx (P++ Ppost vret) (LOCALx (temp ret (F vret) :: Qnew)
+   (H0: Post2 ⊣⊢ ∃ vret:B, PROPx (P++ Ppost vret) (LOCALx (temp ret (F vret) :: Qnew)
              (SEPx (Rpost vret ++ Frame))))
    (PPRE: fold_right_and True Ppre),
-   @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R')))
+   semax E Delta (PROPx P (LOCALx Q (SEPx R')))
     (Scall (Some ret) a bl)
     (normal_ret_assert Post2).
 Proof.
   intros.
   destruct SETUP as [[PTREE [Hsub [SPEC [ATY [TC0 [TC1 MSUBST ]]]]]]
-                       [HR' [PRE1 [PTREE' [CHECKTEMP [CHECKG FRAME]]]]]].
+                       [HR' [HE [PRE1 [PTREE' [CHECKTEMP [CHECKG FRAME]]]]]]].
   apply SPEC. clear SPEC.
   eapply semax_pre_setup2; try eassumption.
-  remember (tc_expr Delta a && tc_exprlist Delta argsig bl) as TChecks.
-  rewrite ! andp_assoc.
+  remember (tc_expr Delta a ∧ tc_exprlist Delta argsig bl) as TChecks.
   apply semax_extract_prop; intros.
   apply semax_extract_prop; intros.
-  rewrite andp_comm.
-
-  eapply semax_pre_post'; [ | |
-      apply (@semax_call1 Espec cs Delta fs A Pre Post NEPre NEPost
-             ts witness ret argsig retty cc a bl P Q Frame Hsub)];
-  [ |
+  eapply semax_mask_mono; first done.
+  eapply semax_pre_post', (semax_call1 Delta fs A Ef Pre Post
+              witness ret argsig retty cc a bl P Q Frame Hsub);
+    [ |
     | assumption
     | clear - OKretty; destruct retty; inv OKretty; apply I
     | hnf; clear - TYret; unfold typeof_temp in TYret;
-      destruct ((temp_types Delta) ! ret); inv TYret; auto
-  ].
-  *
-    subst TChecks; eapply semax_call_aux55; eauto.
-  *
-    subst.
-    clear CHECKTEMP TC1 PRE1 PPRE.
-    intros.
-    normalize.
+      destruct ((temp_types Delta) !! ret); inv TYret; auto
+    ].
+  * subst TChecks. rewrite -semax_call_aux55 //.
+    iIntros "(? & H)"; iSplit; auto; iSplit.
+    { iDestruct "H" as "((_ & $ & _) & _)". }
+    iSplit.
+    { iDestruct "H" as "((_ & _ & $) & _)". }
+    rewrite bi.and_elim_l comm //.
+  * subst.
+    clear  TC1 PRE1 PPRE.
+
+    rewrite H0.
+    go_lowerx.
+    eapply monPred_in_equiv in POST1.
+    simpl in POST1.
     rewrite POST1; clear POST1.
-    apply derives_trans with
-    (EX  vret : B,
-       `(PROPx (Ppost vret)
-         (LOCALx  (temp ret_temp (F vret)::nil)
-          (SEPx (Rpost vret))))%assert (get_result1 ret)
-            * (local (tc_environ Delta) && PROPx P (LOCALx (remove_localdef_temp ret Q) (SEPx Frame)))).
-    clear.
-    go_lowerx. normalize. apply exp_right with x; normalize.
-    apply exp_left; intro vret. apply exp_right with vret.
+    unfold ifvoid.
+    unfold PROPx, LOCALx, SEPx, local, lift1; unfold_lift. monPred.unseal.
+    unfold_lift. normalize.
+    Exists x.
+    rewrite fold_right_and_app_low.
+    rewrite fold_right_sepcon_app.
     normalize.
-    progress (autorewrite with norm1 norm2); normalize.
-    rewrite PROP_combine.
-    unfold fold_right.
-    go_lowerx.
-    repeat apply andp_right; try apply prop_right; auto.
-    rewrite !fold_right_and_app_low.
-    rewrite !fold_right_and_app_low in H3. destruct H3; split; auto.
 Qed.
 
-Lemma semax_call_id1_wow_nil:
+(*Lemma semax_call_id1_wow_nil:
  forall {cs: compspecs} {Qtemp Qvar GV a Delta P Q R R'
-   fs argsig retty cc} {A: rmaps.TypeTree} {Pre Post NEPre NEPost}
+   fs argsig retty cc} {A: TypeTree} {Pre Post}
    {witness: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec nil A) mpred}
    {Frame: list mpred}
    {bl: list expr}
    {Ppre: list Prop} {Rpre: list mpred} {GV' gv args}
    {vl : list val}
-   (SETUP: call_setup2_nil cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl
+   (SETUP: call_setup2_nil cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post bl vl
       witness Frame Ppre Rpre GV' gv args)
-   ret (Post2: environ -> mpred)  (Qnew: list localdef)
+   ret (Post2: assert)  (Qnew: list localdef)
     (B: Type) (Ppost: B -> list Prop) (F: B -> val) (Rpost: B -> list mpred) Espec
    (TYret: typeof_temp Delta ret = Some retty)
    (OKretty: check_retty retty)
-   (POST1: Post nil witness = EX vret:B, PROPx (Ppost vret)
+   (POST1: Post nil witness = ∃ vret:B, PROPx (Ppost vret)
                               (LOCALx (temp ret_temp (F vret) :: nil)
                               (SEPx (Rpost vret))))
    (DELETE: remove_localdef_temp ret Q = Qnew)
-   (H0: Post2 = EX vret:B, PROPx (P++ Ppost vret) (LOCALx (temp ret (F vret) :: Qnew)
+   (H0: Post2 = ∃ vret:B, PROPx (P++ Ppost vret) (LOCALx (temp ret (F vret) :: Qnew)
              (SEPx (Rpost vret ++ Frame))))
    (PPRE: fold_right_and True Ppre),
-   @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R')))
+   semax E Delta (PROPx P (LOCALx Q (SEPx R')))
     (Scall (Some ret) a bl)
     (normal_ret_assert Post2).
-Proof. intros. rewrite call_setup2_nil_equiv in SETUP. eapply semax_call_id1_wow; eassumption. Qed.
+Proof. intros. rewrite call_setup2_nil_equiv in SETUP. eapply semax_call_id1_wow; eassumption. Qed.*)
+
+(* up *)
+Global Instance subst_proper `{Equiv A} : Proper (eq ==> eq ==> pointwise_relation _ equiv ==> eq ==> equiv) (@subst A).
+Proof.
+  intros ?? -> ?? -> ????? ->.
+  rewrite /subst //.
+Qed.
+
+Global Instance assert_of_proper : Proper (pointwise_relation _ equiv ==> equiv) (assert_of).
+Proof.
+  intros ???.
+  apply bi.equiv_entails_2; split => rho; simpl; rewrite H //.
+Qed.
 
 Lemma semax_call_id1_x_wow:
- forall {cs: compspecs} {Qtemp Qvar GV a Delta P Q R R'
-   fs argsig retty' cc ts} {A: rmaps.TypeTree} {Pre Post NEPre NEPost}
-   {witness: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts A) mpred}
+ forall {E} {Qtemp Qvar GV a Delta P Q R R'
+   fs argsig retty' cc} {A: TypeTree} {Ef} {Pre Post}
+   {witness}
    {Frame: list mpred}
    {bl: list expr}
    {Ppre: list Prop} {Rpre: list mpred} {GV' gv args}
    {vl : list val}
-   (SETUP: call_setup2 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty' cc ts A Pre Post NEPre NEPost bl vl
+   (SETUP: call_setup2 E Qtemp Qvar GV a Delta P Q R R' fs argsig retty' cc A Ef Pre Post bl vl
       witness Frame Ppre Rpre GV' gv args)
-   retty  Espec ret ret'
-             (Post2: environ -> mpred)
+   retty ret ret'
+             (Post2: assert)
              (Qnew: list localdef)
              (B: Type)
              (Ppost: B -> list Prop)
              (F: B -> val)
              (Rpost: B -> list mpred)
    (TYret: typeof_temp Delta ret = Some retty)
-   (RETinit: (temp_types Delta) ! ret' = Some retty')
+   (RETinit: (temp_types Delta) !! ret' = Some retty')
    (OKretty: check_retty retty)
    (OKretty': check_retty retty')
    (NEUTRAL: is_neutral_cast retty' retty = true)
    (NEret: ret <> ret')
-   (POST1: Post ts witness = EX vret:B, PROPx (Ppost vret)
+   (POST1: assert_of (Post witness) ⊣⊢ ∃ vret:B, PROPx (Ppost vret)
                               (LOCALx (temp ret_temp (F vret) :: nil)
                               (SEPx (Rpost vret))))
    (DELETE: remove_localdef_temp ret Q = Qnew)
    (DELETE' : remove_localdef_temp ret' Q = Q)
-   (H0: Post2 = EX vret:B, PROPx (P++ Ppost vret)
+   (HPOST2: Post2 ⊣⊢ ∃ vret:B, PROPx (P++ Ppost vret)
                    (LOCALx (temp ret (F vret) :: Qnew)
                     (SEPx (Rpost vret ++ Frame))))
    (PPRE: fold_right_and True Ppre),
-   @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R')))
+   semax E Delta (PROPx P (LOCALx Q (SEPx R')))
    (Ssequence (Scall (Some ret') a bl)
       (Sset ret (Ecast (Etempvar ret' retty') retty)))
     (normal_ret_assert Post2).
@@ -1346,25 +1184,21 @@ Proof.
   apply extract_exists_pre; intro vret.
   eapply semax_pre_post';
     [ | | apply semax_set_forward].
-  + eapply derives_trans; [ | apply now_later ].
-    instantiate (1:= (PROPx (P ++ Ppost vret)
+  + instantiate (1 := (PROPx (P ++ Ppost vret)
       (LOCALx (temp ret' (F vret) :: Qnew) (SEPx (Rpost vret ++ Frame))))).
-    apply andp_right; [apply andp_right |].
-    - unfold tc_expr.
-      simpl typecheck_expr.
+    iIntros "(#? & H) !>"; iSplit; [|iSplit].
+    - rewrite /tc_expr /typecheck_expr.
       rewrite RETinit.
-      simpl @fst.
       replace ((is_neutral_cast retty' retty' || same_base_type retty' retty')%bool)
         with true
         by (clear- OKretty'; destruct retty' as [ | [ | | |] [| ]| [|] | [ | ] |  | | | | ]; try contradiction; unfold is_neutral_cast; rewrite ?eqb_type_refl; reflexivity).
       rewrite denote_tc_assert_andp.
-      apply andp_right; [| intros rho; apply neutral_isCastResultType; auto].
-      apply PQR_denote_tc_initialized; auto.
+      iSplit; last by iApply (neutral_isCastResultType with "H").
+      iApply PQR_denote_tc_initialized; eauto.
     - unfold tc_temp_id, typecheck_temp_id.
       unfold typeof_temp in TYret.
-      destruct ((temp_types Delta) ! ret); inversion TYret; clear TYret; try subst t.
-      go_lowerx.
-      repeat rewrite denote_tc_assert_andp; simpl.
+      destruct ((temp_types Delta) !! ret); inversion TYret; clear TYret; try subst t.
+      rewrite !denote_tc_assert_andp /=.
       rewrite denote_tc_assert_bool.
       assert (is_neutral_cast (implicit_deref retty) retty = true).
       {
@@ -1373,107 +1207,112 @@ Proof.
         try solve [inv NEUTRAL].
         unfold implicit_deref, is_neutral_cast. rewrite eqb_type_refl; reflexivity.
       }
-      simpl; apply andp_right. apply prop_right; auto.
-      apply neutral_isCastResultType; auto.
-    - rewrite <- !insert_local. apply andp_left2.
-      apply andp_derives; auto.
-      subst Qnew; apply derives_remove_localdef_PQR.
-  + intros. subst Post2.
-    normalize.
-    apply exp_right with vret; normalize.
-    rewrite <- !insert_local.
-    autorewrite with subst.
-    rewrite <- !andp_assoc.
-    apply andp_derives; [| subst Qnew; apply subst_remove_localdef_PQR].
-    go_lowerx.
-    unfold_lift.
-    normalize.
-    assert (eqb_ident ret ret' = false)
-    by (clear - NEret; pose proof (eqb_ident_spec ret ret');
-        destruct (eqb_ident ret ret'); auto;
-        contradiction NEret; tauto).
-    rewrite H3 in *. apply Pos.eqb_neq in H3.
-    unfold_lift in H0.
+      iSplit; first done.
+      iApply (neutral_isCastResultType with "H"); auto.
+    - rewrite <- !insert_local.
+      iDestruct "H" as "(? & H)"; iSplit; first done.
+      subst Qnew; by iApply derives_remove_localdef_PQR.
+  + intros.
+    rewrite HPOST2.
+    Exists vret.
+    iIntros "(#? & % & #? & H)".
+    iAssert (local (subst ret (`old) (locald_denote (temp ret' (F vret)))) ∧
+      assert_of (subst ret (`old) (PROPx (P ++ Ppost vret)
+                 (LOCALx (Qnew) (SEPx (Rpost vret ++ Frame)))))) with "[-]" as "H".
+    { rewrite !subst_PROP_LOCAL_SEP; simpl.
+      iDestruct "H" as "($ & #H & $)".
+      autorewrite with subst.
+      rewrite !local_lift2_and.
+      iDestruct "H" as "(($ & $) & $)". }
+    rewrite -insert_local.
+    iSplit; [|subst Qnew; rewrite subst_remove_localdef_PQR bi.and_elim_r //].
+    iDestruct "H" as "(? & _)".
+    iStopProof.
+    split => rho; monPred.unseal; rewrite monPred_at_intuitionistically.
+    rewrite /= /lift1; unfold_lift.
+    iIntros "((% & %) & %)"; iPureIntro.
+    unfold subst in *.
+    destruct H1; split; auto.
+    rewrite eval_id_other // in H0, H1.
     assert (tc_val retty' (eval_id ret' rho))
       by (eapply tc_eval'_id_i; try eassumption; congruence).
     assert (H7 := expr2.neutral_cast_lemma); unfold eval_cast in H7.
-    rewrite H7 in H0 by auto; clear H7.
-    split; congruence.
+    rewrite -> H7 in H0 by auto; congruence.
 Qed.
 
-Lemma semax_call_id1_x_wow_nil:
+(*Lemma semax_call_id1_x_wow_nil:
  forall {cs: compspecs} {Qtemp Qvar GV a Delta P Q R R'
-   fs argsig retty' cc} {A: rmaps.TypeTree} {Pre Post NEPre NEPost}
+   fs argsig retty' cc} {A: TypeTree} {Pre Post}
    {witness: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec nil A) mpred}
    {Frame: list mpred}
    {bl: list expr}
    {Ppre: list Prop} {Rpre: list mpred}
    {GV' gv args}
    {vl : list val}
-   (SETUP: call_setup2_nil cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty' cc A Pre Post NEPre NEPost bl vl
+   (SETUP: call_setup2_nil cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty' cc A Pre Post bl vl
       witness Frame Ppre Rpre GV' gv args)
    retty  Espec ret ret'
-             (Post2: environ -> mpred)
+             (Post2: assert)
              (Qnew: list localdef)
              (B: Type)
              (Ppost: B -> list Prop)
              (F: B -> val)
              (Rpost: B -> list mpred)
    (TYret: typeof_temp Delta ret = Some retty)
-   (RETinit: (temp_types Delta) ! ret' = Some retty')
+   (RETinit: (temp_types Delta) !! ret' = Some retty')
    (OKretty: check_retty retty)
    (OKretty': check_retty retty')
    (NEUTRAL: is_neutral_cast retty' retty = true)
    (NEret: ret <> ret')
-   (POST1: Post nil witness = EX vret:B, PROPx (Ppost vret)
+   (POST1: Post nil witness = ∃ vret:B, PROPx (Ppost vret)
                               (LOCALx (temp ret_temp (F vret) :: nil)
                               (SEPx (Rpost vret))))
    (DELETE: remove_localdef_temp ret Q = Qnew)
    (DELETE' : remove_localdef_temp ret' Q = Q)
-   (H0: Post2 = EX vret:B, PROPx (P++ Ppost vret)
+   (H0: Post2 = ∃ vret:B, PROPx (P++ Ppost vret)
                    (LOCALx (temp ret (F vret) :: Qnew)
                     (SEPx (Rpost vret ++ Frame))))
    (PPRE: fold_right_and True Ppre),
-   @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R')))
+   semax E Delta (PROPx P (LOCALx Q (SEPx R')))
    (Ssequence (Scall (Some ret') a bl)
       (Sset ret (Ecast (Etempvar ret' retty') retty)))
     (normal_ret_assert Post2).
-Proof. intros. rewrite call_setup2_nil_equiv in SETUP. eapply semax_call_id1_x_wow; eassumption. Qed.
+Proof. intros. rewrite call_setup2_nil_equiv in SETUP. eapply semax_call_id1_x_wow; eassumption. Qed.*)
 
 Lemma semax_call_id1_y_wow:
- forall {cs: compspecs} {Qtemp Qvar GV a Delta P Q R R'
-   fs argsig retty' cc ts} {A: rmaps.TypeTree} {Pre Post NEPre NEPost}
-   {witness: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts A) mpred}
+ forall {E} {Qtemp Qvar GV a Delta P Q R R'
+   fs argsig retty' cc} {A: TypeTree} {Ef} {Pre: dtfr (ArgsTT A)} {Post: dtfr (AssertTT A)}
+   {witness}
    {Frame: list mpred}
    {bl: list expr}
    {Ppre: list Prop} {Rpre: list mpred}
    {GV' gv args}
    {vl : list val}
-   (SETUP: call_setup2 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty' cc ts A Pre Post NEPre NEPost bl vl
+   (SETUP: call_setup2 E Qtemp Qvar GV a Delta P Q R R' fs argsig retty' cc A Ef Pre Post bl vl
       witness Frame Ppre Rpre GV' gv args)
-    Espec ret ret' (retty: type)
-             (Post2: environ -> mpred)
+    ret ret' (retty: type)
+             (Post2: assert)
              (Qnew: list localdef)
              (B: Type)
              (Ppost: B -> list Prop)
              (F: B -> val)
              (Rpost: B -> list mpred)
    (TYret: typeof_temp Delta ret = Some retty)
-   (RETinit: (temp_types Delta) ! ret' = Some retty')
+   (RETinit: (temp_types Delta) !! ret' = Some retty')
    (OKretty: check_retty retty)
    (OKretty': check_retty retty')
    (NEUTRAL: is_neutral_cast retty' retty = true)
    (NEret: ret <> ret')
-   (POST1: Post ts witness = EX vret:B, PROPx (Ppost vret)
+   (POST1: assert_of (Post witness) ⊣⊢ ∃ vret:B, PROPx (Ppost vret)
                               (LOCALx (temp ret_temp (F vret) :: nil)
                               (SEPx (Rpost vret))))
    (DELETE: remove_localdef_temp ret Q = Qnew)
    (DELETE' : remove_localdef_temp ret' Q = Q)
-   (H0: Post2 = EX vret:B, PROPx (P++ Ppost vret)
+   (HPOST2: Post2 ⊣⊢ ∃ vret:B, PROPx (P++ Ppost vret)
                    (LOCALx (temp ret (F vret) :: Qnew)
                     (SEPx (Rpost vret ++ Frame))))
    (PPRE: fold_right_and True Ppre),
-   @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R')))
+   semax E Delta (PROPx P (LOCALx Q (SEPx R')))
    (Ssequence (Scall (Some ret') a bl)
       (Sset ret (Etempvar ret' retty')))
     (normal_ret_assert Post2).
@@ -1485,220 +1324,200 @@ Proof.
   apply extract_exists_pre; intro vret.
   eapply semax_pre_post';
     [ | | apply semax_set_forward].
-  + eapply derives_trans; [ | apply now_later ].
-    instantiate (1:= (PROPx (P ++ Ppost vret)
+  + instantiate (1 := (PROPx (P ++ Ppost vret)
       (LOCALx (temp ret' (F vret) :: Qnew) (SEPx (Rpost vret ++ Frame))))).
-    apply andp_right; [apply andp_right |].
-    - unfold tc_expr.
-      match goal with |- _ |-- ?A =>
-        set (aa:=A); unfold denote_tc_assert in aa; simpl in aa; subst aa
-      end.
+    iIntros "(#? & H) !>"; iSplit; [|iSplit].
+    - rewrite /tc_expr /typecheck_expr.
       rewrite RETinit.
-      simpl @fst.
       replace ((is_neutral_cast retty' retty' || same_base_type retty' retty')%bool)
         with true
         by (clear- OKretty'; destruct retty' as [ | [ | | |] [| ]| [|] | [ | ] |  | | | | ]; try contradiction; unfold is_neutral_cast; rewrite ?eqb_type_refl; reflexivity).
-      simpl @snd. cbv iota.
-      apply PQR_denote_tc_initialized; auto.
+      iApply PQR_denote_tc_initialized; eauto.
     - unfold tc_temp_id, typecheck_temp_id.
       unfold typeof_temp in TYret.
-      destruct ((temp_types Delta) ! ret); inversion TYret; clear TYret; try subst t.
-      go_lowerx.
-      repeat rewrite denote_tc_assert_andp; simpl.
+      destruct ((temp_types Delta) !! ret); inversion TYret; clear TYret; try subst t.
+      rewrite !denote_tc_assert_andp /=.
       rewrite denote_tc_assert_bool.
       assert (is_neutral_cast (implicit_deref retty') retty = true).
-      * replace (implicit_deref retty') with retty'
+      {
+        replace (implicit_deref retty') with retty'
           by (destruct retty' as [ | [ | | |] [| ]| [|] | [ | ] |  | | | | ]; try contradiction; reflexivity).
         auto.
-      * simpl; apply andp_right. apply prop_right; auto.
-        apply neutral_isCastResultType; auto.
-    - rewrite <- !insert_local. apply andp_left2.
-      apply andp_derives; auto.
-      subst Qnew; apply derives_remove_localdef_PQR.
-  + intros. subst Post2.
-    unfold normal_ret_assert.
-    normalize.
-    apply exp_right with vret; normalize.
-    rewrite <- !insert_local.
-    autorewrite with subst.
-    rewrite <- !andp_assoc.
-    apply andp_derives; [| subst Qnew; apply subst_remove_localdef_PQR].
-    go_lowerx.
-    unfold_lift.
-    normalize.
-    assert (eqb_ident ret ret' = false)
-    by (clear - NEret; pose proof (eqb_ident_spec ret ret');
-        destruct (eqb_ident ret ret'); auto;
-        contradiction NEret; intuition).
-    rewrite H3 in *. apply Pos.eqb_neq in H3.
-    split; congruence.
+      }
+      iSplit; first done.
+      iApply (neutral_isCastResultType with "H"); auto.
+    - rewrite <- !insert_local.
+      iDestruct "H" as "(? & H)"; iSplit; first done.
+      subst Qnew; by iApply derives_remove_localdef_PQR.
+  + intros. rewrite HPOST2.
+    Exists vret.
+    iIntros "(#? & % & #? & H)".
+    iAssert (local (subst ret (`old) (locald_denote (temp ret' (F vret)))) ∧
+      assert_of (subst ret (`old) (PROPx (P ++ Ppost vret)
+                 (LOCALx (Qnew) (SEPx (Rpost vret ++ Frame)))))) with "[-]" as "H".
+    { rewrite !subst_PROP_LOCAL_SEP; simpl.
+      iDestruct "H" as "($ & #H & $)".
+      autorewrite with subst.
+      rewrite !local_lift2_and.
+      iDestruct "H" as "(($ & $) & $)". }
+    rewrite -insert_local.
+    iSplit; [|subst Qnew; rewrite subst_remove_localdef_PQR bi.and_elim_r //].
+    iDestruct "H" as "(? & _)".
+    iStopProof.
+    split => rho; monPred.unseal; rewrite monPred_at_intuitionistically.
+    rewrite /= /lift1; unfold_lift.
+    iIntros "((% & %) & %)"; iPureIntro.
+    unfold subst in *.
+    destruct H1; split; auto.
+    rewrite eval_id_other // in H0, H1.
+    congruence.
 Qed.
 
-Lemma semax_call_id1_y_wow_nil:
+(*Lemma semax_call_id1_y_wow_nil:
  forall {cs: compspecs} {Qtemp Qvar GV a Delta P Q R R'
-   fs argsig retty' cc} {A: rmaps.TypeTree} {Pre Post NEPre NEPost}
+   fs argsig retty' cc} {A: TypeTree} {Pre Post}
    {witness: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec nil A) mpred}
    {Frame: list mpred}
    {bl: list expr}
    {Ppre: list Prop} {Rpre: list mpred}
    {GV' gv args}
    {vl : list val}
-   (SETUP: call_setup2_nil cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty' cc A Pre Post NEPre NEPost bl vl
+   (SETUP: call_setup2_nil cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty' cc A Pre Post bl vl
       witness Frame Ppre Rpre GV' gv args)
     Espec ret ret' (retty: type)
-             (Post2: environ -> mpred)
+             (Post2: assert)
              (Qnew: list localdef)
              (B: Type)
              (Ppost: B -> list Prop)
              (F: B -> val)
              (Rpost: B -> list mpred)
    (TYret: typeof_temp Delta ret = Some retty)
-   (RETinit: (temp_types Delta) ! ret' = Some retty')
+   (RETinit: (temp_types Delta) !! ret' = Some retty')
    (OKretty: check_retty retty)
    (OKretty': check_retty retty')
    (NEUTRAL: is_neutral_cast retty' retty = true)
    (NEret: ret <> ret')
-   (POST1: Post nil witness = EX vret:B, PROPx (Ppost vret)
+   (POST1: Post nil witness = ∃ vret:B, PROPx (Ppost vret)
                               (LOCALx (temp ret_temp (F vret) :: nil)
                               (SEPx (Rpost vret))))
    (DELETE: remove_localdef_temp ret Q = Qnew)
    (DELETE' : remove_localdef_temp ret' Q = Q)
-   (H0: Post2 = EX vret:B, PROPx (P++ Ppost vret)
+   (H0: Post2 = ∃ vret:B, PROPx (P++ Ppost vret)
                    (LOCALx (temp ret (F vret) :: Qnew)
                     (SEPx (Rpost vret ++ Frame))))
    (PPRE: fold_right_and True Ppre),
-   @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R')))
+   semax E Delta (PROPx P (LOCALx Q (SEPx R')))
    (Ssequence (Scall (Some ret') a bl)
       (Sset ret (Etempvar ret' retty')))
     (normal_ret_assert Post2).
-Proof. intros. rewrite call_setup2_nil_equiv in SETUP. eapply semax_call_id1_y_wow; eassumption. Qed.
+Proof. intros. rewrite call_setup2_nil_equiv in SETUP. eapply semax_call_id1_y_wow; eassumption. Qed.*)
 
 Lemma semax_call_id01_wow:
- forall {cs: compspecs} {Qtemp Qvar GV a Delta P Q R R'
-   fs argsig retty cc ts} {A: rmaps.TypeTree} {Pre Post NEPre NEPost}
-   {witness: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts A) mpred}
+ forall {E} {Qtemp Qvar GV a Delta P Q R R'
+   fs argsig retty cc} {A: TypeTree} {Ef} {Pre Post}
+   {witness}
    {Frame: list mpred}
    {bl: list expr}
    {Ppre: list Prop} {Rpre: list mpred} {GV' gv args}
    {vl : list val}
-   (SETUP: call_setup2 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl
+   (SETUP: call_setup2 E Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Ef Pre Post bl vl
       witness Frame Ppre Rpre GV' gv args)
-   Espec
-             (Post2: environ -> mpred)
+             (Post2: assert)
              (B: Type)
              (Ppost: B -> list Prop)
              (F: B -> val)
              (Rpost: B -> list mpred)
    (_: check_retty retty)
          (* this hypothesis is not needed for soundness, just for selectivity *)
-   (POST1: Post ts witness = EX vret:B, PROPx (Ppost vret)
+   (POST1: assert_of (Post witness) ⊣⊢ ∃ vret:B, PROPx (Ppost vret)
                               (LOCALx (temp ret_temp (F vret) :: nil)
                               (SEPx (Rpost vret))))
-   (POST2: Post2 = EX vret:B, PROPx (P++ Ppost vret) (LOCALx Q
+   (POST2: Post2 ⊣⊢ ∃ vret:B, PROPx (P++ Ppost vret) (LOCALx Q
              (SEPx (Rpost vret ++ Frame))))
    (PPRE: fold_right_and True Ppre),
-   @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R')))
+   semax E Delta (PROPx P (LOCALx Q (SEPx R')))
     (Scall None a bl)
     (normal_ret_assert Post2).
 Proof.
   intros.
   destruct SETUP as [[PTREE [Hsub [SPEC [ATY [TC0 [TC1 MSUBST ]]]]]]
-                       [HR' [PRE1 [PTREE' [CHECKTEMP [CHECKG FRAME]]]]]].
+                       [HR' [HE [PRE1 [PTREE' [CHECKTEMP [CHECKG FRAME]]]]]]].
   apply SPEC. clear SPEC.
   eapply semax_pre_setup2; try eassumption.
-  remember (tc_expr Delta a && tc_exprlist Delta argsig bl) as TChecks.
-  rewrite ! andp_assoc.
+  remember (tc_expr Delta a ∧ tc_exprlist Delta argsig bl) as TChecks.
   apply semax_extract_prop; intros.
   apply semax_extract_prop; intros.
-  rewrite andp_comm.
-
-  eapply semax_pre_post';
-     [ |
-     | apply semax_call0 with (fs:=fs)(cc:=cc)(A:= A) (ts := ts)(x:=witness) (P:=P)(Q:=Q)(NEPre :=NEPre) (NEPost := NEPost)(R := Frame)
-     ];
+  eapply semax_mask_mono; first done.
+  eapply semax_pre_post', semax_call0 with (fs:=fs)(cc:=cc)(A:= A)(x:=witness) (P:=P)(Q:=Q)(R := Frame);
      try eassumption.
-  * subst TChecks. eapply semax_call_aux55; eauto.
-  *
-    subst.
+  * subst TChecks. rewrite -semax_call_aux55 //.
+    iIntros "(? & H)"; iSplit; auto; iSplit.
+    { iDestruct "H" as "((_ & $ & _) & _)". }
+    iSplit.
+    { iDestruct "H" as "((_ & _ & $) & _)". }
+    rewrite bi.and_elim_l comm //.
+  * subst.
     clear CHECKTEMP TC1 PRE1 PPRE.
-    intros.
-    normalize.
-    rewrite POST1; clear POST1.
     match goal with |- context [ifvoid retty ?A ?B] =>
           replace (ifvoid retty A B) with B
           by (destruct retty; try contradiction; auto)
     end.
-    go_lowerx. normalize. apply exp_right with x0; normalize.
-    apply andp_right; auto.
-    apply prop_right.
-    rewrite fold_right_and_app_low. split; auto.
-    rename x0 into vret.
-    clear.
-    rewrite fold_right_sepcon_app. auto.
+    go_lowerx; normalize.
+    eapply monPred_in_equiv in POST1.
+    simpl in POST1.
+    rewrite POST1 POST2; clear POST1 POST2.
+    unfold PROPx, LOCALx, SEPx, local, lift1; unfold_lift. monPred.unseal.
+    Intros a0; Exists a0.
+    rewrite fold_right_and_app_low.
+    rewrite fold_right_sepcon_app.
+    normalize.
 Qed.
 
-Lemma semax_call_id01_wow_nil:
+(*Lemma semax_call_id01_wow_nil:
  forall {cs: compspecs} {Qtemp Qvar GV a Delta P Q R R'
-   fs argsig retty cc} {A: rmaps.TypeTree} {Pre Post NEPre NEPost}
+   fs argsig retty cc} {A: TypeTree} {Pre Post}
    {witness: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec nil A) mpred}
    {Frame: list mpred}
    {bl: list expr}
    {Ppre: list Prop} {Rpre: list mpred}
    {GV' gv args}
    {vl : list val}
-   (SETUP: call_setup2_nil cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl
+   (SETUP: call_setup2_nil cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post bl vl
       witness Frame Ppre Rpre GV' gv args)
    Espec
-             (Post2: environ -> mpred)
+             (Post2: assert)
              (B: Type)
              (Ppost: B -> list Prop)
              (F: B -> val)
              (Rpost: B -> list mpred)
    (_: check_retty retty)
          (* this hypothesis is not needed for soundness, just for selectivity *)
-   (POST1: Post nil witness = EX vret:B, PROPx (Ppost vret)
+   (POST1: Post nil witness = ∃ vret:B, PROPx (Ppost vret)
                               (LOCALx (temp ret_temp (F vret) :: nil)
                               (SEPx (Rpost vret))))
-   (POST2: Post2 = EX vret:B, PROPx (P++ Ppost vret) (LOCALx Q
+   (POST2: Post2 = ∃ vret:B, PROPx (P++ Ppost vret) (LOCALx Q
              (SEPx (Rpost vret ++ Frame))))
    (PPRE: fold_right_and True Ppre),
-   @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R')))
+   semax E Delta (PROPx P (LOCALx Q (SEPx R')))
     (Scall None a bl)
     (normal_ret_assert Post2).
-Proof. intros. rewrite call_setup2_nil_equiv in SETUP. eapply semax_call_id01_wow; eassumption. Qed.
+Proof. intros. rewrite call_setup2_nil_equiv in SETUP. eapply semax_call_id01_wow; eassumption. Qed.*)
 
 Lemma match_funcptr'_funcptr:
  forall fs v B,
-  func_ptr' fs v * B |-- func_ptr fs v.
+  func_ptr fs v ∗ B ⊢ <absorb> func_ptr fs v.
 Proof.
-intros. unfold func_ptr'.
-rewrite corable_andp_sepcon1 by apply corable_func_ptr.
-apply andp_left1; auto.
+  intros; iIntros "($ & ?)".
 Qed.
 
 Lemma nomatch_funcptr'_funcptr:
   forall fs v A B,
-   (B |-- func_ptr fs v) ->
-  A * B |-- func_ptr fs v.
+   (B ⊢ <absorb> func_ptr fs v) ->
+  A ∗ B ⊢ <absorb> func_ptr fs v.
 Proof.
-intros.
-rewrite <- (corable_sepcon_TT _ (corable_func_ptr fs v)).
-rewrite sepcon_comm. apply sepcon_derives; auto.
+  intros ???? ->; iIntros "(? & $)".
 Qed.
 
-Ltac match_funcptr'_funcptr :=
- first [simple apply match_funcptr'_funcptr
-        | simple apply nomatch_funcptr'_funcptr; match_funcptr'_funcptr].
-
-Ltac prove_func_ptr :=
-    match goal with |- fold_right_sepcon ?A |-- func_ptr ?F ?V =>
-       match A with context [func_ptr' ?G V] =>
-         unify F G
-       end
-     end;
-   unfold fold_right_sepcon;
-   match_funcptr'_funcptr.
-
 Definition eq_no_post (x v: val) : Prop := x=v.
 (* The purpose of eq_no_post is to "mark" the proposition
   in forward_call_idxxx lemmas so that the after-the-call
@@ -1706,38 +1525,52 @@ Definition eq_no_post (x v: val) : Prop := x=v.
 
 Lemma no_post_exists:
  forall v P Q R,
-   PROPx P (LOCALx (temp ret_temp v :: Q) (SEPx R)) =
-   EX x:val, PROPx (eq_no_post x v :: P) (LOCALx (temp ret_temp x :: Q) (SEPx R)).
+   PROPx(Σ := Σ) P (LOCALx (temp ret_temp v :: Q) (SEPx R)) ⊣⊢
+   ∃ x:val, PROPx (eq_no_post x v :: P) (LOCALx (temp ret_temp x :: Q) (SEPx R)).
 Proof.
-intros. unfold eq_no_post.
-apply pred_ext.
-apply exp_right with v.
-apply andp_derives; auto.
-apply prop_derives.
-simpl. intuition.
-apply exp_left; intro.
-unfold PROPx.
-simpl fold_right.
-normalize.
+  intros. unfold eq_no_post.
+  apply bi.equiv_entails_2.
+  - rewrite -(bi.exist_intro v).
+    apply bi.and_mono; last done.
+    apply bi.pure_mono; simpl; auto.
+  - apply bi.exist_elim; intros.
+    rewrite /PROPx /=.
+    split => rho; monPred.unseal.
+    normalize.
 Qed.
 
 Lemma no_post_exists0:
  forall P Q R,
-   PROPx P (LOCALx Q (SEPx R)) =
-   EX x:unit, PROPx ((fun _ => P) x) (LOCALx Q (SEPx ((fun _ => R) x))).
+   PROPx(Σ := Σ) P (LOCALx Q (SEPx R)) ⊣⊢
+   ∃ x:unit, PROPx ((fun _ => P) x) (LOCALx Q (SEPx ((fun _ => R) x))).
 Proof.
-intros.
-apply pred_ext.
-apply exp_right with tt.
-apply andp_derives; auto.
-apply exp_left; auto.
+  intros.
+  apply bi.equiv_entails_2.
+  - rewrite -(bi.exist_intro tt) //.
+  - apply bi.exist_elim; intros; done.
 Qed.
 
 Import ListNotations.
 
-Lemma void_ret : ifvoid tvoid (` (PROP ( )  LOCAL ()  SEP ()) (make_args [] []))
-  (EX v : val, ` (PROP ( )  LOCAL ()  SEP ()) (make_args [ret_temp] [v])) = emp.
+Lemma void_ret : ifvoid tvoid (assert_of(Σ := Σ) (` (monPred_at (PROP ( )  LOCAL ()  SEP ())) (make_args [] [])))
+  (∃ v : val, assert_of (` (monPred_at (PROP ( )  LOCAL ()  SEP ())) (make_args [ret_temp] [v]))) ⊣⊢ emp.
 Proof.
-  extensionality; simpl.
-  unfold liftx, lift, PROPx, LOCALx, SEPx; simpl. autorewrite with norm. auto.
+  split => rho; unfold_lift; simpl.
+  rewrite /PROPx /LOCALx /SEPx /=; monPred.unseal.
+  iSplit; auto.
 Qed.
+
+End mpred.
+
+Ltac match_funcptr'_funcptr :=
+ first [simple apply match_funcptr'_funcptr
+        | simple apply nomatch_funcptr'_funcptr; match_funcptr'_funcptr].
+
+Ltac prove_func_ptr :=
+    match goal with |- fold_right_sepcon ?A ⊢ <absorb> func_ptr ?F ?V =>
+       match A with context [func_ptr ?G V] =>
+         unify F G
+       end
+     end;
+   unfold fold_right_sepcon;
+   match_funcptr'_funcptr.
diff --git a/floyd/canon.v b/floyd/canon.v
index c62eaab59d..50f331a491 100644
--- a/floyd/canon.v
+++ b/floyd/canon.v
@@ -1,33 +1,10 @@
 Require Export Coq.Sorting.Permutation.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.seplog.
+Require Export VST.veric.lifting_expr.
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Import LiftNotation.
-Import compcert.lib.Maps.
-
-Local Open Scope logic.
-
-Inductive localdef : Type :=
- | temp: ident -> val -> localdef
- | lvar: ident -> type -> val -> localdef   (* local variable *)
- | gvars: globals -> localdef.              (* global variables *)
-
-Arguments temp i%positive v.
-
-Definition lvar_denote (i: ident) (t: type) (v: val) rho :=
-     match Map.get (ve_of rho) i with
-         | Some (b, ty') => t=ty' /\ v = Vptr b Ptrofs.zero
-         | None => False
-         end.
-
-Definition gvars_denote (gv: globals) rho :=
-   gv = (fun i => match Map.get (ge_of rho) i with Some b => Vptr b Ptrofs.zero | None => Vundef end).
-
-Definition locald_denote (d: localdef) : environ -> Prop :=
- match d with
- | temp i v => `and (`(eq v) (eval_id i)) `(v <> Vundef)
- | lvar i t v => lvar_denote i t v
- | gvars gv => gvars_denote gv
- end.
 
 Fixpoint fold_right_andp rho (l: list (environ -> Prop)) : Prop :=
  match l with
@@ -49,8 +26,9 @@ Declare Scope assert3. Delimit Scope assert3 with assert3.
 Declare Scope assert4. Delimit Scope assert4 with assert4.
 Declare Scope assert5. Delimit Scope assert5 with assert5.
 
-Definition PROPx {A} (P: list Prop): forall (Q: A->mpred), A->mpred :=
-     andp (prop (fold_right and True P)).
+Definition PROPx {A Σ} (P: list Prop): monPred A (iPropI Σ) -d> monPred A (iPropI Σ) :=
+     bi_and ⌜fold_right and True P⌝.
+Global Instance: Params (@PROPx) 2 := {}. (* could be 3 to turn off setoid rewriting in PROP *)
 
 Notation "'PROP' ( x ; .. ; y )   z" := (PROPx (cons x%type .. (cons y%type nil) ..) z%assert3) (at level 10) : assert.
 Notation "'PROP' ()   z" :=   (PROPx nil z%assert3) (at level 10) : assert.
@@ -60,8 +38,10 @@ Notation "'PROP' ( x ; .. ; y )   z" := (PROPx (cons x%type .. (cons y%type nil)
 Notation "'PROP' ()   z" :=   (PROPx nil z%assert3) (at level 10).
 Notation "'PROP' ( )   z" :=   (PROPx nil z%assert3) (at level 10).
 
-Definition LOCALx (Q: list localdef) : forall (R: environ->mpred), environ->mpred :=
-                 andp (local (fold_right (`and) (`True) (map locald_denote Q))).
+Definition LOCALx `{!heapGS Σ} (Q: list localdef) : assert -d> assert :=
+                 bi_and (local (fold_right (`and) (`True%type) (map locald_denote Q))).
+Global Instance: Params (@LOCALx) 2 := {}.
+
 Notation " 'LOCAL' ( )   z" := (LOCALx nil z%assert5)  (at level 9) : assert3.
 Notation " 'LOCAL' ()   z" := (LOCALx nil z%assert5)  (at level 9) : assert3.
 
@@ -73,518 +53,219 @@ Notation " 'RETURN' () z" := (LOCALx nil z%assert5) (at level 9) : assert3.
 Notation " 'RETURN' ( ) z" := (LOCALx nil z%assert5) (at level 9) : assert3.
 Notation " 'RETURN' ( x ) z" := (LOCALx (temp ret_temp x :: nil) z%assert5) (at level 9) :assert3.
 
-Definition GLOBALSx (gs : list globals) (X : argsassert): argsassert :=
- fun (gvals : argsEnviron) =>
+Definition GLOBALSx `{!heapGS Σ} (gs : list globals) (X : argsassert): argsassert :=
+ argsassert_of (fun (gvals : argsEnviron) =>
            LOCALx (map gvars gs)
                   (argsassert2assert nil X)
-                  (Clight_seplog.mkEnv (fst gvals) nil nil).
-Arguments GLOBALSx gs _ : simpl never.
+                  (Clight_seplog.mkEnv (fst gvals) nil nil)).
+Arguments GLOBALSx {_ _} gs _ : simpl never.
+Global Instance: Params (@GLOBALSx) 2 := {}.
 
-Definition PARAMSx (vals:list val)(X : argsassert): argsassert :=
- fun (gvals : argsEnviron) => !! (snd gvals = vals) && X gvals.
-Arguments PARAMSx vals _ : simpl never.
+Definition PARAMSx `{!heapGS Σ} (vals:list val)(X : argsassert): argsassert :=
+ argsassert_of (fun (gvals : argsEnviron) => ⌜snd gvals = vals⌝ ∧ X gvals).
+Arguments PARAMSx {Σ _} vals _ : simpl never.
+Global Instance: Params (@PARAMSx) 2 := {}.
 
-Notation " 'PARAMS' ( x ; .. ; y )  z" := (PARAMSx (cons x%logic .. (cons y%logic nil) ..) z%assert4)
+Notation " 'PARAMS' ( x ; .. ; y )  z" := (PARAMSx (cons x%I .. (cons y%I nil) ..) z%assert4)
          (at level 9) : assert3.
 
 Notation " 'PARAMS' ( )  z" := (PARAMSx nil z%assert4) (at level 9) : assert3.
 Notation " 'PARAMS' ()  z" := (PARAMSx nil z%assert4) (at level 9) : assert3.
 
-Notation " 'GLOBALS' ( x ; .. ; y )  z" := (GLOBALSx (cons x%logic .. (cons y%logic nil) ..) z%assert5)
+Notation " 'GLOBALS' ( x ; .. ; y )  z" := (GLOBALSx (cons x%I .. (cons y%I nil) ..) z%assert5)
          (at level 9) : assert4.
 
 Notation " 'GLOBALS' ( )  z" := (GLOBALSx nil z%assert5) (at level 9) : assert4.
 Notation " 'GLOBALS' ()  z" := (GLOBALSx nil z%assert5) (at level 9) : assert4.
 
-Definition SEPx {A} (R: list mpred) : A->mpred :=
-    fun _ => (fold_right_sepcon R).
-Arguments SEPx A R _ : simpl never.
+Definition SEPx {A Σ} (R: list (iProp Σ)) : monPred A (iPropI Σ) :=
+    ⎡fold_right_sepcon R⎤.
+Arguments SEPx {A _} R : simpl never.
+Global Instance: Params (@SEPx) 2 := {}.
 
-Notation " 'SEP' ( x ; .. ; y )" := (GLOBALSx nil (SEPx (cons x%logic .. (cons y%logic nil) ..)))
+Notation " 'SEP' ( x ; .. ; y )" := (GLOBALSx nil (SEPx (cons x%I .. (cons y%I nil) ..)))
          (at level 8) : assert4.
 
 Notation " 'SEP' ( ) " := (GLOBALSx nil (SEPx nil)) (at level 8) : assert4.
 Notation " 'SEP' () " := (GLOBALSx nil (SEPx nil)) (at level 8) : assert4.
 
-Notation " 'SEP' ( x ; .. ; y )" := (SEPx (cons x%logic .. (cons y%logic nil) ..))
+Notation " 'SEP' ( x ; .. ; y )" := (SEPx (cons x%I .. (cons y%I nil) ..))
          (at level 8) : assert5.
 
 Notation " 'SEP' ( ) " := (SEPx nil) (at level 8) : assert5.
 Notation " 'SEP' () " := (SEPx nil) (at level 8) : assert5.
 
-Lemma PROPx_Permutation {A}: forall P Q,
-  Permutation P Q ->
-  @PROPx A P = PROPx Q.
-Proof.
-  intros.
-  unfold PROPx.
-  f_equal.
-  apply ND_prop_ext.
-  induction H.
-  + tauto.
-  + simpl; tauto.
-  + simpl; tauto.
-  + tauto.
-Qed.
+Notation " 'ENTAIL' d ',' P '⊢' Q " :=
+  (@bi_entails (monPredI environ_index (iPropI _)) (local (tc_environ d) ∧ P%assert) Q%assert) (at level 99, P at level 98, Q at level 98).
 
-Lemma LOCALx_Permutation: forall P Q,
-  Permutation P Q ->
-  LOCALx P = LOCALx Q.
-Proof.
-  intros.
-  unfold LOCALx.
-  f_equal.
-  unfold local, lift1; unfold_lift.
-  extensionality rho.
-  apply ND_prop_ext.
-  induction H.
-  + tauto.
-  + simpl; tauto.
-  + simpl; tauto.
-  + tauto.
-Qed.
+Arguments semax {_ _ _ _ _} E Delta Pre%_assert cmd Post%_assert.
 
-Lemma SEPx_Permutation {A}: forall P Q,
-  Permutation P Q ->
-  @SEPx A P = SEPx Q.
-Proof.
-  intros.
-  unfold SEPx.
-  extensionality rho.
-  induction H.
-  + auto.
-  + simpl; f_equal; auto.
-  + simpl.
-    rewrite <- !sepcon_assoc, (sepcon_comm x y).
-    auto.
-  + congruence.
-Qed.
+Module CConseqFacts :=
+  SeparationLogicFacts.GenCConseqFacts
+    (SeparationLogicAsLogicSoundness.MainTheorem.CSHL_PracticalLogic.CSHL_MinimumLogic.CSHL_Def)
+    (SeparationLogicAsLogicSoundness.MainTheorem.CSHL_PracticalLogic.CSHL_MinimumLogic).
 
-Lemma approx_sepcon: forall (P Q: mpred) n,
-  compcert_rmaps.RML.R.approx n (P * Q) =
-  compcert_rmaps.RML.R.approx n P *
-  compcert_rmaps.RML.R.approx n Q.
-Proof.
-  intros.
-  apply seplog.approx_sepcon.
-Qed.
+Module Conseq :=
+  SeparationLogicFacts.GenConseq
+    (SeparationLogicAsLogicSoundness.MainTheorem.CSHL_PracticalLogic.CSHL_MinimumLogic.CSHL_Def)
+    (SeparationLogicAsLogicSoundness.MainTheorem.CSHL_PracticalLogic.CSHL_MinimumLogic).
 
-Lemma approx_andp: forall (P Q: mpred) n,
-  compcert_rmaps.RML.R.approx n (P && Q) =
-  compcert_rmaps.RML.R.approx n P &&
-  compcert_rmaps.RML.R.approx n Q.
-Proof.
-  intros.
-  apply approx_andp.
-Qed.
+Module ConseqFacts :=
+  SeparationLogicFacts.GenConseqFacts
+    (SeparationLogicAsLogicSoundness.MainTheorem.CSHL_PracticalLogic.CSHL_MinimumLogic.CSHL_Def)
+    (Conseq).
 
-Lemma approx_orp: forall (P Q: mpred) n,
-  compcert_rmaps.RML.R.approx n (P || Q) =
-  compcert_rmaps.RML.R.approx n P ||
-  compcert_rmaps.RML.R.approx n Q.
-Proof.
-  intros.
-  apply approx_orp.
-Qed.
+Section mpred.
 
-Lemma approx_exp: forall A (P: A -> mpred) n,
-  compcert_rmaps.RML.R.approx n (exp P) =
-  EX a: A, compcert_rmaps.RML.R.approx n (P a).
-Proof.
-  intros.
-  apply seplog.approx_exp.
-Qed.
+Context `{!heapGS Σ}.
 
-Lemma approx_allp: forall A (P: A -> mpred) n,
-  A ->
-  compcert_rmaps.RML.R.approx n (allp P) =
-  ALL a: A, compcert_rmaps.RML.R.approx n (P a).
+#[global] Instance PROPx_proper {A} : Proper (equiv ==> equiv ==> equiv) (@PROPx A Σ).
 Proof.
-  intros.
-  eapply seplog.approx_allp; auto.
+  intros ??????.
+  rewrite /PROPx; f_equiv; last done.
+  f_equiv.
+  induction H; simpl; f_equiv; done.
 Qed.
 
-Lemma approx_jam {B: Type} {S': B -> Prop} (S: forall l, {S' l}+{~ S' l}) (P Q: B -> mpred) n (b : B) :
-  compcert_rmaps.RML.R.approx n (res_predicates.jam S P Q b) =
-  res_predicates.jam
-    S (base.compose (compcert_rmaps.RML.R.approx n) P)
-    (base.compose (compcert_rmaps.RML.R.approx n) Q) b.
+#[global] Instance LOCALx_proper : Proper (equiv(Equiv := list.list_equiv(H := equivL)) ==> equiv ==> equiv) (LOCALx).
 Proof.
-  intros.
-  eapply seplog.approx_jam; auto.
+  intros ??????.
+  rewrite /LOCALx; f_equiv; last done.
+  f_equiv.
+  induction H; simpl; f_equiv; try done.
+  by inv H.
 Qed.
-Opaque rmaps.dependent_type_functor_rec.
-(*
-Possible ??
- *)
 
-Lemma SEPx_args_super_non_expansive: forall A R ,
-  Forall (fun R0 => @args_super_non_expansive A (fun ts a _ => R0 ts a)) R ->
-  @args_super_non_expansive A (fun ts a ae => SEPx (map (fun R0 => R0 ts a) R) ae).
+#[global] Instance SEPx_proper {A} : Proper (equiv ==> equiv) (@SEPx A Σ).
 Proof.
-  intros.
-  hnf; intros.
-  unfold SEPx.
-  induction H.
-  + simpl; auto.
-  + simpl in *.
-    rewrite !approx_sepcon.
-    f_equal;
-    auto.
+  intros ???.
+  rewrite /SEPx; f_equiv.
+  induction H; simpl; f_equiv; done.
 Qed.
 
-Lemma SEPx_super_non_expansive: forall A R ,
-  Forall (fun R0 => @super_non_expansive A (fun ts a _ => R0 ts a)) R ->
-  @super_non_expansive A (fun ts a rho => SEPx (map (fun R0 => R0 ts a) R) rho).
+#[global] Instance PARAMSx_proper : Proper (eq ==> equiv ==> equiv) (PARAMSx).
 Proof.
-  intros.
-  hnf; intros.
-  unfold SEPx.
-  induction H.
-  + simpl; auto.
-  + simpl in *.
-    rewrite !approx_sepcon.
-    f_equal;
-    auto.
+  intros ?? -> ?? H.
+  rewrite /PARAMSx; constructor; intros; simpl.
+  rewrite H //.
 Qed.
 
-Lemma SEPx_super_non_expansive': forall A R,
-  @super_non_expansive_list A (fun ts a _ => R ts a) ->
-  @super_non_expansive A (fun ts a rho => SEPx (R ts a) rho).
+#[global] Instance GLOBALSx_proper : Proper (eq ==> equiv ==> equiv) (GLOBALSx).
 Proof.
-  intros.
-  hnf; intros.
-  unfold SEPx; unfold super_non_expansive_list in H.
-  specialize (H n ts x rho).
-  induction H.
-  + simpl; auto.
-  + simpl in *.
-    rewrite !approx_sepcon.
-    f_equal;
-    auto.
+  intros ?? -> ?? H.
+  rewrite /GLOBALSx /LOCALx; constructor; intros; simpl.
+  monPred.unseal.
+  rewrite H //.
 Qed.
 
-Lemma LOCALx_super_non_expansive: forall A Q R,
-  super_non_expansive R ->
-  Forall (fun Q0 => @super_non_expansive A (fun ts a rho => prop (locald_denote (Q0 ts a) rho))) Q ->
-  @super_non_expansive A (fun ts a rho => LOCALx (map (fun Q0 => Q0 ts a) Q) (R ts a) rho).
-Proof.
-  intros.
-  hnf; intros.
-  unfold LOCALx.
-  simpl.
-  rewrite !approx_andp.
-  f_equal; auto.
-  induction H0.
-  + auto.
-  + simpl.
-    unfold local, lift1.
-    unfold_lift.
-    rewrite !prop_and.
-    rewrite !approx_andp.
-    f_equal; auto.
-Qed.
+#[global] Existing Instance list.list_dist.
 
-Lemma PROPx_args_super_non_expansive: forall A P Q,
-  args_super_non_expansive Q ->
-  Forall (fun P0 => @args_super_non_expansive A (fun ts a ae => prop (P0 ts a))) P ->
-  @args_super_non_expansive A (fun ts a ae => PROPx (map (fun P0 => P0 ts a) P) (Q ts a) ae).
+#[global] Instance PROPx_ne {A} : NonExpansive2 (@PROPx A Σ).
 Proof.
-  intros.
-  hnf; intros.
-  unfold PROPx.
-  simpl.
-  rewrite !approx_andp.
-  f_equal; auto.
-  induction H0.
-  + auto.
-  + simpl.
-    rewrite !prop_and.
-    rewrite !approx_andp.
-    f_equal; auto.
+  rewrite /PROPx; repeat intro. f_equiv; last done. f_equiv.
+  induction H; try tauto; simpl.
+  rewrite H IHForall2 //.
 Qed.
 
-Lemma LOCALx_super_non_expansive': forall A Q R,
-  super_non_expansive R ->
-  @super_non_expansive_list A (fun ts a rho => map (fun Q0 => prop (locald_denote Q0 rho)) (Q ts a)) ->
-  @super_non_expansive A (fun ts a rho => LOCALx (Q ts a) (R ts a) rho).
-Proof.
-  intros.
-  hnf; intros.
-  unfold LOCALx.
-  simpl.
-  rewrite !approx_andp.
-  f_equal; auto.
-  specialize (H0 n ts x rho).
-  simpl in H0.
-  match goal with H : Forall2 _ _ (map _ ?l) |- _ => forget l as Q1 end.
-  generalize dependent Q1; induction (Q ts x); intros; inv H0; destruct Q1; try discriminate.
-  + auto.
-  + inv H3.
-    simpl.
-    unfold local, lift1 in IHl |- *.
-    unfold_lift in IHl; unfold_lift.
-    rewrite !prop_and.
-    rewrite !approx_andp.
-    f_equal; auto.
-Qed.
+#[global] Instance LOCALx_ne n : Proper (eq ==> dist n ==> dist n) (LOCALx).
+Proof. solve_proper. Qed.
 
-Lemma PROPx_super_non_expansive: forall A P Q,
-  super_non_expansive Q ->
-  Forall (fun P0 => @super_non_expansive A (fun ts a (rho: environ) => prop (P0 ts a))) P ->
-  @super_non_expansive A (fun ts a rho => PROPx (map (fun P0 => P0 ts a) P) (Q ts a) rho).
+#[global] Instance SEPx_ne {A} : NonExpansive (@SEPx A Σ).
 Proof.
-  intros.
-  hnf; intros.
-  unfold PROPx.
-  simpl.
-  rewrite !approx_andp.
-  f_equal; auto.
-  induction H0.
-  + auto.
-  + simpl.
-    rewrite !prop_and.
-    rewrite !approx_andp.
-    f_equal; auto.
+  intros ????.
+  rewrite /SEPx; f_equiv.
+  induction H; simpl; f_equiv; done.
 Qed.
 
-Lemma PROPx_super_non_expansive': forall A P Q,
-  super_non_expansive Q ->
-  @super_non_expansive_list A (fun ts a (rho: environ) => map prop (P ts a)) ->
-  @super_non_expansive A (fun ts a rho => PROPx (P ts a) (Q ts a) rho).
+#[global] Instance PARAMSx_ne n : Proper (eq ==> dist n ==> dist n) (PARAMSx).
 Proof.
-  intros.
-  hnf; intros.
-  unfold PROPx.
-  simpl.
-  rewrite !approx_andp.
-  f_equal; auto.
-  specialize (H0 n ts x rho).
-  simpl in H0.
-  match goal with H : Forall2 _ _ (map _ ?l) |- _ => forget l as P1 end.
-  generalize dependent P1; induction (P ts x); intros; inv H0; destruct P1; try discriminate.
-  + auto.
-  + inv H3.
-    simpl.
-    rewrite !prop_and.
-    rewrite !approx_andp.
-    f_equal; auto.
+  intros ????; subst.
+  rewrite /PARAMSx; constructor; intros; simpl.
+  rewrite H //.
 Qed.
 
-Lemma PROP_LOCAL_SEP_super_non_expansive: forall A P Q R,
-  Forall (fun P0 => @super_non_expansive A (fun ts a _ => prop (P0 ts a))) P ->
-  Forall (fun Q0 => @super_non_expansive A (fun ts a rho => prop (locald_denote (Q0 ts a) rho))) Q ->
-  Forall (fun R0 => @super_non_expansive A (fun ts a _ => R0 ts a)) R ->
-  @super_non_expansive A (fun ts a rho =>
-     PROPx (map (fun P0 => P0 ts a) P)
-      (LOCALx (map (fun Q0 => Q0 ts a) Q)
-        (SEPx (map (fun R0 => R0 ts a) R))) rho).
+#[global] Instance GLOBALSx_ne n : Proper (eq ==> dist n ==> dist n) (GLOBALSx).
 Proof.
-  intros.
-  apply PROPx_super_non_expansive; auto.
-  apply LOCALx_super_non_expansive; auto.
-  apply SEPx_super_non_expansive; auto.
+  intros ????; subst.
+  rewrite /GLOBALSx /LOCALx; constructor; intros; simpl.
+  monPred.unseal.
+  rewrite H //.
 Qed.
 
-Lemma PROP_LOCAL_SEP_super_non_expansive': forall A P Q R,
-  @super_non_expansive_list A (fun ts a (rho: environ) => map prop (P ts a)) ->
-  @super_non_expansive_list A (fun ts a rho => map (fun Q0 => prop (locald_denote Q0 rho)) (Q ts a)) ->
-  @super_non_expansive_list A (fun ts a _ => R ts a) ->
-  @super_non_expansive A (fun ts a rho =>
-     PROPx (P ts a)
-      (LOCALx (Q ts a)
-        (SEPx (R ts a))) rho).
+Lemma PROPx_Permutation {A}: forall P Q R,
+  Permutation P Q ->
+  @PROPx A Σ P R = PROPx Q R.
 Proof.
   intros.
-  apply PROPx_super_non_expansive'; auto.
-  apply LOCALx_super_non_expansive'; auto.
-  apply SEPx_super_non_expansive'; auto.
+  unfold PROPx.
+  f_equal; f_equal; apply prop_ext.
+  induction H; simpl; tauto.
 Qed.
 
-Lemma SEPx_nonexpansive {A}: forall R rho,
-  Forall (fun R0 => predicates_rec.nonexpansive R0) R ->
-  nonexpansive (fun S => @SEPx A (map (fun R0 => R0 S) R) rho).
-Proof.
-  intros.
-  unfold SEPx.
-  induction R.
-  + simpl.
-    apply const_nonexpansive.
-  + simpl.
-    apply sepcon_nonexpansive.
-    - inversion H; auto.
-    - apply IHR.
-      inversion H; auto.
-Qed.
+Local Notation LOCALx := (@LOCALx Σ).
 
-Lemma LOCALx_nonexpansive: forall Q R rho,
-  nonexpansive (fun S => R S rho) ->
-  nonexpansive (fun S => LOCALx Q (R S) rho).
+Lemma LOCALx_Permutation: forall P Q R,
+  Permutation P Q ->
+  LOCALx P R = LOCALx Q R.
 Proof.
   intros.
   unfold LOCALx.
-  apply (conj_nonexpansive (fun S => local (fold_right `(and) `(True) (map locald_denote Q)) rho) (fun S => R S rho)); [| auto].
-  apply const_nonexpansive.
-Qed.
-
-Lemma PARAMSx_nonexpansive: forall Q R rho,
-  nonexpansive (fun S => R S rho) ->
-  nonexpansive (fun S => PARAMSx Q (R S) rho).
-Proof.
-  intros.
-  unfold PARAMSx.
-  specialize (conj_nonexpansive (fun S => (!! (snd rho = Q)) rho) (fun S => R S rho)).
-  intros CN; apply CN; clear CN; trivial.
-   red; intros. red; intros. simpl in *; intros. destruct (H0 y H1); clear H0.
-   split; trivial.
-Qed.
-
-Lemma PROPx_nonexpansive {A}: forall P Q rho,
-  Forall (fun P0 => nonexpansive (fun S => prop (P0 S))) P ->
-  nonexpansive (fun S => Q S rho) ->
-  nonexpansive (fun S => @PROPx A (map (fun P0 => P0 S) P) (Q S) rho).
-Proof.
-  intros.
-  unfold PROPx.
-  apply (conj_nonexpansive (fun S => @prop mpred Nveric (fold_right and True
-         (map
-            (fun P0 : mpred -> Prop
-             => P0 S) P))) (fun S => Q S rho)); [| auto].
-  clear - H.
-  induction P.
-  + simpl.
-    apply const_nonexpansive.
-  + simpl.
-    replace
-      (fun P0 => (prop (a P0 /\ fold_right and True (map (fun P1 => P1 P0) P)))%logic)
-    with
-      (fun P0 => (prop (a P0) && prop (fold_right and True (map (fun P1 => P1 P0) P)))%logic).
-    2: {
-      extensionality S.
-      rewrite prop_and; auto.
-    }
-    apply (conj_nonexpansive (fun S => @prop mpred Nveric (a S)) _).
-    - inversion H; auto.
-    - apply IHP.
-      inversion H; auto.
-Qed.
-
-Lemma PROP_LOCAL_SEP_nonexpansive: forall P Q R rho,
-  Forall (fun P0 => nonexpansive (fun S => prop (P0 S))) P ->
-  Forall (fun R0 => nonexpansive R0) R ->
-  nonexpansive (fun S => PROPx (map (fun P0 => P0 S) P) (LOCALx Q (SEPx (map (fun R0 => R0 S) R))) rho).
-Proof.
-  intros.
-  apply PROPx_nonexpansive; auto.
-  apply LOCALx_nonexpansive.
-  apply SEPx_nonexpansive; auto.
+  f_equal.
+  unfold local, lift1; unfold_lift.
+  apply assert_ext; intros; simpl.
+  f_equal; apply prop_ext.
+  induction H; simpl; tauto.
 Qed.
 
-Lemma PROP_PARAMS_GLOBALS_SEP_nonexpansive: forall P U Q R rho,
-  Forall (fun P0 => nonexpansive (fun S => prop (P0 S))) P ->
-  Forall (fun R0 => nonexpansive R0) R ->
-  nonexpansive (fun S => PROPx (map (fun P0 => P0 S) P) (PARAMSx U (GLOBALSx Q (SEPx (map (fun R0 => R0 S) R)))) rho).
+Lemma SEPx_Permutation {A}: forall P Q,
+  Permutation P Q ->
+  @SEPx A Σ P = SEPx Q.
 Proof.
   intros.
-  apply PROPx_nonexpansive; auto.
-  apply PARAMSx_nonexpansive.
-  apply LOCALx_nonexpansive.
-  apply SEPx_nonexpansive; auto.
+  unfold SEPx.
+  f_equal.
+  induction H; simpl.
+  + auto.
+  + rewrite IHPermutation //.
+  + rewrite sep_assoc (sep_comm y x) -sep_assoc //.
+  + rewrite IHPermutation1 //.
 Qed.
 
-Notation "'EX' x .. y , P " :=
-  (@exp (environ->mpred) _ _ (fun x =>
-    ..
-    (@exp (environ->mpred) _ _ (fun y => P%assert))
-    ..
-    )) (at level 65, x binder, y binder, right associativity) : assert.
-
-Notation " 'ENTAIL' d ',' P '|--' Q " :=
-  (@derives (environ->mpred) _ (andp (local (tc_environ d)) P%assert) Q%assert) (at level 99, P at level 79, Q at level 79).
-
-Arguments semax {CS} {Espec} Delta Pre%assert cmd Post%assert.
-
-Lemma insert_prop : forall (P: Prop) PP QR, prop P && (PROPx PP QR) = PROPx (P::PP) QR.
+Lemma insert_prop : forall {A} (P: Prop) PP QR, (⌜P⌝ ∧ (@PROPx A Σ PP QR)) = PROPx (P::PP) QR.
 Proof.
-intros. unfold PROPx. simpl. extensionality rho.
-apply pred_ext. apply derives_extract_prop; intro.
-apply derives_extract_prop; intro.
-apply andp_right; auto. apply prop_right; auto.
-apply derives_extract_prop; intros [? ?].
-repeat apply andp_right; auto. apply prop_right; auto. apply prop_right; auto.
+  intros. apply assert_ext; intros.
+  unfold PROPx; monPred.unseal.
+  rewrite log_normalize.and_assoc pure_and //.
 Qed.
 
 Lemma insert_local': forall (Q1: localdef) P Q R,
-  local (locald_denote Q1) && (PROPx P (LOCALx Q R)) = (PROPx P (LOCALx (Q1 :: Q) R)).
+  (local (locald_denote Q1) ∧ (PROPx P (LOCALx Q R))) = (PROPx P (LOCALx (Q1 :: Q) R)).
 Proof.
-intros. extensionality rho.
-unfold PROPx, LOCALx, local; super_unfold_lift. simpl.
-apply pred_ext; gather_prop; normalize.
-repeat apply andp_right; auto.
-apply prop_right; repeat split; auto.
-apply andp_right; auto.
-apply prop_right; repeat split; auto.
+  intros.
+  rewrite /PROPx /LOCALx /= local_lift2_and !and_assoc' (and_comm' (⌜_⌝)) //.
 Qed.
 
 Lemma insert_local: forall Q1 P Q R,
-  local (locald_denote Q1) && (PROPx P (LOCALx Q (SEPx R))) = (PROPx P (LOCALx (Q1 :: Q) (SEPx R))).
+  (local (locald_denote Q1) ∧ (PROPx P (LOCALx Q (SEPx R)))) = (PROPx P (LOCALx (Q1 :: Q) (SEPx R))).
 Proof. intros. apply insert_local'. Qed.
 
-#[export] Hint Rewrite insert_local :  norm2.
-
 Lemma go_lower_lem20:
-  forall QR QR',
-    (QR |-- QR') ->
-    PROPx nil QR |-- QR'.
-Proof. unfold PROPx; intros; intro rho; normalize. Qed.
-
-Ltac go_lowerx' simpl_tac :=
-   unfold PROPx, LOCALx,SEPx, local, lift1; unfold_lift; intro rho; simpl_tac;
-   repeat rewrite andp_assoc;
-   repeat ((simple apply go_lower_lem1 || apply derives_extract_prop || apply derives_extract_prop'); intro);
-   try apply prop_left;
-   repeat rewrite prop_true_andp by assumption;
-   try apply derives_refl.
-
-Ltac go_lowerx := go_lowerx' simpl.
-
-Ltac go_lowerx_no_simpl := go_lowerx' idtac.
+  forall {A} QR QR',
+    (QR ⊢ QR') ->
+    @PROPx A Σ nil QR ⊢ QR'.
+Proof. unfold PROPx; intros; normalize. Qed.
 
 Lemma grab_nth_SEP:
    forall n P Q R,
     PROPx P (LOCALx Q (SEPx R)) = (PROPx P (LOCALx Q (SEPx (nth n R emp :: delete_nth n R)))).
 Proof.
-intros.
-f_equal. f_equal.
-extensionality rho; unfold SEPx.
-revert R; induction n; intros; destruct R.
-simpl. rewrite sepcon_emp; auto.
-simpl nth.
-unfold delete_nth.
-auto.
-simpl.
-rewrite sepcon_emp; auto.
-simpl.
-rewrite IHn.
-simpl.
-repeat rewrite <- sepcon_assoc.
-f_equal.
-apply sepcon_comm.
+  intros.
+  rewrite /PROPx /LOCALx /SEPx; do 3 f_equiv.
+  revert R; induction n; intros; destruct R; simpl; rewrite ?sep_emp //.
+  rewrite IHn /=.
+  rewrite !sep_assoc (sep_comm o) //.
 Qed.
 
-Ltac find_in_list A L :=
- match L with
-  | A :: _ => constr:(O)
-  | _ :: ?Y => let n := find_in_list A Y in constr:(S n)
-  | nil => fail
-  end.
-
-Ltac length_of R :=
- match R with
-  |  nil => constr:(O)
-  |  _:: ?R1 => let n := length_of R1 in constr:(S n)
- end.
-
 Fixpoint insert {A} (n: nat) (x: A) (ys: list A) {struct n} : list A :=
  match n with
  | O => x::ys
@@ -634,521 +315,303 @@ Eval compute in grab_indexes (1::6::4::nil) (a::b::c::d::e::f::g::h::i::j::nil).
 Lemma fold_right_nil: forall {A B} (f: A -> B -> B) (z: B),
    fold_right f z nil = z.
 Proof. reflexivity. Qed.
-#[export] Hint Rewrite @fold_right_nil : norm1.
-#[export] Hint Rewrite @fold_right_nil : subst.
 
 Lemma fold_right_cons: forall {A B} (f: A -> B -> B) (z: B) x y,
    fold_right f z (x::y) = f x (fold_right f z y).
 Proof. reflexivity. Qed.
-#[export] Hint Rewrite @fold_right_cons : norm1.
-#[export] Hint Rewrite @fold_right_cons : subst.
 
 Lemma fold_right_and_app:
   forall (Q1 Q2: list (environ -> Prop)) rho,
-   fold_right `(and) `(True) (Q1 ++ Q2) rho =
-   (fold_right `(and) `(True) Q1 rho /\  fold_right `(and) `(True) Q2 rho).
+   fold_right `(and) `(True%type) (Q1 ++ Q2) rho =
+   (fold_right `(and) `(True%type) Q1 rho /\ fold_right `(and) `(True%type) Q2 rho).
 Proof.
 intros.
 induction Q1; simpl; auto.
-apply prop_ext; intuition.
+unfold_lift; apply prop_ext; simpl; intuition auto.
 unfold_lift in IHQ1. unfold_lift.
 rewrite IHQ1.
 clear; apply prop_ext; tauto.
 Qed.
 
-Lemma fold_right_sepcon_app :
- forall P Q, fold_right_sepcon (P++Q) =
-        fold_right_sepcon P * fold_right_sepcon Q.
+Lemma fold_right_local_app:
+  forall (Q1 Q2: list (environ -> Prop)),
+   local (fold_right `(and) `(True%type) (Q1 ++ Q2)) =
+   (local (fold_right `(and) `(True%type) Q1) ∧ local (fold_right `(and) `(True%type) Q2)).
 Proof.
-intros; induction P; simpl.
-rewrite emp_sepcon; auto.
-rewrite sepcon_assoc;
-f_equal; auto.
+  intros; apply assert_ext; intros; rewrite /local; monPred.unseal.
+  rewrite /lift1 fold_right_and_app pure_and //.
 Qed.
 
-Lemma grab_indexes_SEP {A}:
-  forall (ns: list Z) xs, @SEPx A xs = SEPx (grab_indexes ns xs).
+Lemma fold_right_sepcon_app :
+ forall (P Q : list mpred), fold_right_sepcon (P++Q) =
+        (fold_right_sepcon P ∗ fold_right_sepcon Q).
 Proof.
-intros.
-unfold SEPx; extensionality rho.
-unfold grab_indexes. change @Floyd_app with  @app.
-forget (grab_calc 0 ns nil) as ks.
-revert xs; induction ks; intro.
-unfold grab_indexes'. simpl app. auto.
-destruct a.
-destruct xs. reflexivity.
-unfold grab_indexes'.
-fold @grab_indexes'.
-simpl fold_right_sepcon.
-specialize (IHks xs).
-case_eq (grab_indexes' ks xs); intros.
-rewrite H in IHks.
-rewrite fold_right_sepcon_app.
-rewrite IHks.
-rewrite fold_right_sepcon_app.
-forget (fold_right_sepcon l0) as P.
-rewrite <- sepcon_assoc. f_equal.
-clear.
-revert l; induction n; intro l. reflexivity.
-simpl. destruct l. simpl. auto.
-simpl. rewrite <- sepcon_assoc. rewrite (sepcon_comm m).
-rewrite sepcon_assoc. f_equal.
-specialize (IHn l). simpl in IHn.
-auto.
-destruct xs. reflexivity.
-unfold grab_indexes'.
-fold @grab_indexes'.
-simpl.
-specialize (IHks xs).
-case_eq (grab_indexes' ks xs); intros.
-rewrite H in IHks.
-simpl.
-simpl in IHks; rewrite IHks.
-clear.
-induction l; simpl; auto.
-rewrite <- IHl.
-clear IHl.
-repeat rewrite <- sepcon_assoc.
-f_equal.
-rewrite sepcon_comm; auto.
+  intros; induction P; simpl.
+  - rewrite emp_sep //.
+  - rewrite -sep_assoc IHP //.
 Qed.
 
-(* The simpl_nat_of_P tactic is a complete hack,
-  needed for compatibility between Coq 8.3/8.4,
-  because the name of the thing to unfold varies
-  between the two versions *)
-Ltac simpl_nat_of_P :=
-match goal with |- context [nat_of_P ?n] =>
-  match n with xI _ => idtac | xO _ => idtac | xH => idtac | _ => fail end;
-  let N := fresh "N" in
-  set (N:= nat_of_P n);
-  compute in N;
-  unfold N; clear N
-end.
-
-Ltac grab_indexes_SEP ns :=
-  rewrite (grab_indexes_SEP ns);
-    unfold grab_indexes; simpl grab_calc;
-   unfold grab_indexes', insert;
-   repeat simpl_nat_of_P; cbv beta iota;
-   unfold Floyd_app; fold @Floyd_app.
-
-Tactic Notation "focus_SEP" constr(a) :=
-  grab_indexes_SEP (a::nil).
-Tactic Notation "focus_SEP" constr(a) constr(b) :=
-  grab_indexes_SEP (a::b::nil).
-Tactic Notation "focus_SEP" constr(a) constr(b) constr(c) :=
-  grab_indexes_SEP (a::b::c::nil).
-Tactic Notation "focus_SEP" constr(a) constr(b) constr(c) constr(d) :=
-  grab_indexes_SEP (a::b::c::d::nil).
-Tactic Notation "focus_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) :=
-  grab_indexes_SEP (a::b::c::d::e::nil).
-Tactic Notation "focus_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) :=
-  grab_indexes_SEP (a::b::c::d::e::f::nil).
-Tactic Notation "focus_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) constr(g) :=
-  grab_indexes_SEP (a::b::c::d::e::f::g::nil).
-Tactic Notation "focus_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) constr(g) constr(h) :=
-  grab_indexes_SEP (a::b::c::d::e::f::g::h::nil).
-Tactic Notation "focus_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) constr(g) constr(h) constr(i) :=
-  grab_indexes_SEP (a::b::c::d::e::f::g::h::i::nil).
-Tactic Notation "focus_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) constr(g) constr(h) constr(i) constr(j) :=
-  grab_indexes_SEP (a::b::c::d::e::f::g::h::i::j::nil).
-
-(* TESTING
-Variables (a b c d e f g h i j : assert).
-Goal (SEP (a;b;c;d;e;f;g;h;i;j) = SEP (b;d;a;c;e;f;g;h;i;j)).
-focus_SEP 1 3.
-auto.
-Qed.
-Goal (SEP (a;b;c;d;e;f;g;h;i;j) = SEP (d;b;a;c;e;f;g;h;i;j)).
-focus_SEP 3 1.
-auto.
+Lemma grab_indexes_SEP {A}:
+  forall (ns: list Z) xs, @SEPx A Σ xs = SEPx (grab_indexes ns xs).
+Proof.
+  intros.
+  rewrite /SEPx; f_equal.
+  unfold grab_indexes. change @Floyd_app with @app.
+  forget (grab_calc 0 ns nil) as ks.
+  revert xs; induction ks; intro; auto.
+  destruct a.
+  - destruct xs. reflexivity.
+    unfold grab_indexes'; fold @grab_indexes'.
+    simpl fold_right_sepcon.
+    specialize (IHks xs).
+    case_eq (grab_indexes' ks xs); intros.
+    rewrite H in IHks.
+    rewrite fold_right_sepcon_app.
+    rewrite IHks.
+    rewrite fold_right_sepcon_app.
+    forget (fold_right_sepcon l0) as P.
+    rewrite sep_assoc. f_equal.
+    clear.
+    revert l; induction n; intro l. reflexivity.
+    simpl. destruct l; auto.
+    simpl. rewrite sep_assoc (sep_comm o) -sep_assoc IHn //.
+  - destruct xs. reflexivity.
+    unfold grab_indexes';  fold @grab_indexes'.
+    simpl.
+    specialize (IHks xs).
+    case_eq (grab_indexes' ks xs); intros.
+    rewrite H in IHks.
+    simpl.
+    simpl in IHks; rewrite IHks.
+    clear.
+    induction l; simpl; auto.
+    rewrite -IHl !sep_assoc (sep_comm o) //.
 Qed.
 
-*)
-
 (*
 Lemma semax_post0:
- forall (R': ret_assert) Espec {cs: compspecs} Delta (R: ret_assert) P c,
-   (R' |-- R) ->
-   @semax cs Espec Delta P c R' ->  @semax cs Espec Delta P c R.
+ forall (R': ret_assert) E Delta (R: ret_assert) P c,
+   (R' ⊢ R) ->
+   semax E Delta P c R' ->  semax E Delta P c R.
 Proof.
 intros; eapply semax_pre_post; try eassumption.
-apply andp_left2; auto.
-intros. apply andp_left2; auto.
+rewrite bi.and_elim_r; auto.
+intros. rewrite bi.and_elim_r; auto.
 apply H.
 Qed.
 *)
 
-Lemma local_unfold: forall P rho, local P rho = !! (P rho).
+(* monPred.unseal should take care of this
+Lemma local_unfold: forall P rho, @local Σ P rho = ⌜P rho⌝.
 Proof. reflexivity. Qed.
-#[export] Hint Rewrite local_unfold : norm2.
 
 Lemma lower_sepcon:
-  forall P Q rho, @sepcon (environ->mpred) _ _ P Q rho = sepcon (P rho) (Q rho).
+  forall P Q rho, @sepcon (assert) _ _ P Q rho = sepcon (P rho) (Q rho).
 Proof. reflexivity. Qed.
 Lemma lower_andp:
-  forall P Q rho, @andp (environ->mpred) _ P Q rho = andp (P rho) (Q rho).
+  forall P Q rho, @andp (assert) _ P Q rho = andp (P rho) (Q rho).
 Proof. reflexivity. Qed.
-#[export] Hint Rewrite lower_sepcon lower_andp : norm2.
 
 Lemma lift_prop_unfold:
-   forall P z,  @prop (environ->mpred) _ P z = @prop mpred Nveric P.
+   forall P z,  @prop (assert) _ P z = @prop mpred Nveric P.
 Proof.  reflexivity. Qed.
-#[export] Hint Rewrite lift_prop_unfold: norm2.
 
-Lemma andp_unfold: forall (P Q: environ->mpred) rho,
-  @andp (environ->mpred) _ P Q rho = @andp mpred Nveric (P rho) (Q rho).
+Lemma andp_unfold: forall (P Q: assert) rho,
+  @andp (assert) _ P Q rho = @andp mpred Nveric (P rho) (Q rho).
 Proof. reflexivity. Qed.
-#[export] Hint Rewrite andp_unfold: norm2.
 
 Lemma refold_andp:
-  forall (P Q: environ -> mpred),
-     (fun rho: environ => P rho && Q rho) = (P && Q).
+  forall (P Q: assert),
+     (fun rho: environ => P rho ∧ Q rho) = (P ∧ Q).
 Proof. reflexivity. Qed.
-#[export] Hint Rewrite refold_andp : norm2.
 
 Lemma exp_unfold : forall A P rho,
- @exp (environ->mpred) _ A P rho = @exp mpred Nveric A (fun x => P x rho).
+ @exp (assert) _ A P rho = @exp mpred Nveric A (fun x => P x rho).
 Proof.
 intros. reflexivity.
-Qed.
-#[export] Hint Rewrite exp_unfold: norm2.
+Qed.*)
 
-Module CConseqFacts :=
-  SeparationLogicFacts.GenCConseqFacts
-    (SeparationLogicAsLogicSoundness.MainTheorem.CSHL_PracticalLogic.CSHL_MinimumLogic.CSHL_Def)
-    (SeparationLogicAsLogicSoundness.MainTheorem.CSHL_PracticalLogic.CSHL_MinimumLogic).
+End mpred.
 
-Module Conseq :=
-  SeparationLogicFacts.GenConseq
-    (SeparationLogicAsLogicSoundness.MainTheorem.CSHL_PracticalLogic.CSHL_MinimumLogic.CSHL_Def)
-    (SeparationLogicAsLogicSoundness.MainTheorem.CSHL_PracticalLogic.CSHL_MinimumLogic).
+Section VST.
 
-Module ConseqFacts :=
-  SeparationLogicFacts.GenConseqFacts
-    (SeparationLogicAsLogicSoundness.MainTheorem.CSHL_PracticalLogic.CSHL_MinimumLogic.CSHL_Def)
-    (Conseq).
+Context `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs}.
 
-Lemma extract_exists_pre_later {CS: compspecs} {Espec: OracleKind}:
-  forall  (A : Type) (Q: assert) (P : A -> assert) c Delta (R: ret_assert),
-  (forall x, semax Delta (Q && |> P x) c R) ->
-  semax Delta (Q && |> exp P) c R.
+Lemma extract_exists_pre_later:
+  forall  (A : Type) (Q: assert) (P : A -> assert) c E Delta (R: ret_assert),
+  (forall x, semax E Delta (Q ∧ ▷ P x) c R) ->
+  semax E Delta (Q ∧ ▷ ∃x, P x) c R.
 Proof.
   intros.
   apply extract_exists_pre in H.
-  eapply semax_conseq; [.. | exact H].
-  + reduceL.
-    eapply derives_trans, except_0_fupd.
-    eapply derives_trans; [apply andp_derives, later_exp''; apply derives_refl|].
-    rewrite andp_comm, distrib_orp_andp.
-    apply orp_left.
-    - apply orp_right2.
-      eapply derives_trans, fupd_intro.
-      rewrite <- exp_andp2, andp_comm; apply derives_refl.
-    - apply orp_right1, andp_left1, derives_refl.
-  + reduce2derives; apply derives_refl.
-  + reduce2derives; apply derives_refl.
-  + reduce2derives; apply derives_refl.
-  + intros; reduce2derives; apply derives_refl.
-Qed.
-
-Lemma semax_pre_post_fupd:
-  forall {CS: compspecs} {Espec: OracleKind} (Delta: tycontext),
- forall P' (R': ret_assert) P c (R: ret_assert) ,
-    (local (tc_environ Delta) && P |-- (|={Ensembles.Full_set}=> P')) ->
-    (local (tc_environ Delta) && RA_normal R' |-- (|={Ensembles.Full_set}=> RA_normal R)) ->
-    (local (tc_environ Delta) && RA_break R' |-- (|={Ensembles.Full_set}=> RA_break R)) ->
-    (local (tc_environ Delta) && RA_continue R' |-- (|={Ensembles.Full_set}=> RA_continue R)) ->
-    (forall vl, local (tc_environ Delta) && RA_return R' vl |-- (RA_return R vl)) ->
-   @semax CS Espec Delta P' c R' -> @semax CS Espec Delta P c R.
-Proof. exact @CConseqFacts.semax_pre_post_fupd. Qed.
-
-Lemma semax_pre_fupd:
- forall P' Espec {cs: compspecs} Delta P c R,
-     ENTAIL Delta , P |-- (|={Ensembles.Full_set}=> P') ->
-     @semax cs Espec Delta P' c R  -> @semax cs Espec Delta P c R.
-Proof. exact @CConseqFacts.semax_pre_fupd. Qed.
-
-Lemma semax_pre:
- forall P' Espec {cs: compspecs} Delta P c R,
-     ENTAIL Delta , P |-- P' ->
-     @semax cs Espec Delta P' c R  -> @semax cs Espec Delta P c R.
-Proof. intros ? ? ?; apply ConseqFacts.semax_pre. Qed.
-
-Lemma semax_pre_simple:
- forall P' Espec {cs: compspecs} Delta P c R,
-     ENTAIL Delta , P |-- P' ->
-     @semax cs Espec Delta P' c R  -> @semax cs Espec Delta P c R.
-Proof. exact semax_pre. Qed.
+  eapply CConseqFacts.semax_pre_fupd, H.
+  iIntros "(_ & ?)".
+  rewrite -bi.and_exist_l.
+  iApply fupd_except_0; iIntros "!>".
+  iSplit; first rewrite bi.and_elim_l //; rewrite bi.and_elim_r.
+  by iApply bi.later_exist_except_0.
+Qed.
+
+Definition semax_pre_post_fupd := CConseqFacts.semax_pre_post_fupd.
+Definition semax_pre_fupd := CConseqFacts.semax_pre_fupd.
+Definition semax_pre := ConseqFacts.semax_pre.
+Definition semax_pre_simple := semax_pre.
 
 Lemma semax_pre0:
- forall P' Espec  {cs: compspecs} Delta P c R,
-     (P |-- P') ->
-     @semax cs Espec Delta P' c R  ->
-     @semax cs Espec Delta P c R.
+ forall P' E Delta P c R,
+     (P ⊢ P') ->
+     semax E Delta P' c R  ->
+     semax E Delta P c R.
 Proof.
-intros.
-eapply semax_pre_simple; try apply H0.
- apply andp_left2; auto.
+  intros.
+  eapply semax_pre_simple; try apply H0.
+  rewrite bi.and_elim_r //.
 Qed.
 
-Lemma semax_pre_post : forall {Espec: OracleKind}{CS: compspecs},
- forall P' (R': ret_assert) Delta P c (R: ret_assert) ,
-    (local (tc_environ Delta) && P |-- P') ->
-    (local (tc_environ Delta) && RA_normal R' |-- RA_normal R) ->
-    (local (tc_environ Delta) && RA_break R' |-- RA_break R) ->
-    (local (tc_environ Delta) && RA_continue R' |-- RA_continue R) ->
-    (forall vl, local (tc_environ Delta) && RA_return R' vl |-- RA_return R vl) ->
-   @semax CS Espec Delta P' c R' -> @semax CS Espec Delta P c R.
+Definition semax_pre_post := Conseq.semax_pre_post.
+
+#[global] Instance semax_proper E Delta : Proper (equiv ==> eq ==> equiv ==> iff) (semax E Delta).
 Proof.
-  intros; eapply semax_pre_post_fupd; eauto; intros; eapply derives_trans, fupd_intro; auto.
+  intros ?? Hpre ?? -> [????] [????] (Hpost1 & Hpost2 & Hpost3 & Hpost4); simpl in *.
+  split; eapply semax_pre_post; intros; rewrite ?Hpre /= ?Hpost1 ?Hpost2 ?Hpost3 ?Hpost4 bi.and_elim_r //.
 Qed.
 
 Lemma semax_frame_PQR:
-  forall Q2 R2 Espec {cs: compspecs} Delta R1 P Q P' Q' R1' c,
+  forall Q2 R2 E Delta R1 P Q P' Q' R1' c,
      closed_wrt_modvars c (LOCALx Q2 (SEPx R2)) ->
-     @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R1))) c
+     semax E Delta (PROPx P (LOCALx Q (SEPx R1))) c
                      (normal_ret_assert (PROPx P' (LOCALx Q' (SEPx R1')))) ->
-     @semax cs Espec Delta (PROPx P (LOCALx (Q++Q2) (SEPx (R1++R2)))) c
+     semax E Delta (PROPx P (LOCALx (Q++Q2) (SEPx (R1++R2)))) c
                      (normal_ret_assert (PROPx P' (LOCALx (Q'++Q2) (SEPx (R1'++R2))))).
 Proof.
-intros.
-replace (PROPx P (LOCALx (Q++Q2) (SEPx (R1 ++ R2))))
-   with (PROPx P (LOCALx Q (SEPx (R1))) * (LOCALx Q2 (SEPx R2))).
-eapply semax_pre_post; try (apply semax_frame; try eassumption).
-apply andp_left2; auto.
-apply andp_left2. intro rho; simpl; normalize.
- unfold PROPx, SEPx, LOCALx, local, lift1.
-normalize.
-rewrite fold_right_sepcon_app.
-normalize; autorewrite with norm1 norm2; normalize.
-rewrite prop_true_andp; auto.
-rewrite map_app. rewrite fold_right_and_app; split; auto.
-apply andp_left2; simpl; normalize.
-apply andp_left2; simpl; normalize.
-intro; apply andp_left2; simpl; normalize.
-clear.
-extensionality rho.
-simpl.
-unfold PROPx, LOCALx, local, lift1, SEPx.
-rewrite fold_right_sepcon_app.
-simpl. normalize.
-f_equal.
-rewrite map_app. rewrite fold_right_and_app.
-apply pred_ext; normalize.
+  intros.
+  assert (forall P Q R1, PROPx P (LOCALx (Q ++ Q2) (SEPx (R1 ++ R2))) ⊣⊢
+    PROPx P (LOCALx Q (SEPx (R1))) ∗ (LOCALx Q2 (SEPx R2))) as Hequiv.
+  { intros; rewrite /PROPx /LOCALx /SEPx map_app fold_right_local_app fold_right_sepcon_app embed_sep.
+    iSplit.
+    * iIntros "($ & L & $ & $)".
+      rewrite bi.affinely_and; iDestruct "L" as "($ & $)".
+    * iIntros "((? & ? & ?) & ? & $)"; auto. }
+  rewrite Hequiv.
+  eapply ConseqFacts.semax_post, semax_frame, H0; simpl; try done; intros; try by iIntros "(_ & [] & _)".
+  rewrite Hequiv bi.and_elim_r //.
 Qed.
 
 Lemma semax_frame1:
- forall {Espec: OracleKind} {cs: compspecs} QFrame Frame Delta Delta1
+ forall QFrame Frame E Delta Delta1
      P Q c R P1 Q1 R1 P2 Q2 R2,
-    semax Delta1 (PROPx P1 (LOCALx Q1 (SEPx R1))) c
+    semax E Delta1 (PROPx P1 (LOCALx Q1 (SEPx R1))) c
                       (normal_ret_assert (PROPx P2 (LOCALx Q2 (SEPx R2)))) ->
     Delta1 = Delta ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
     PROPx P1 (LOCALx (Q1++QFrame) (SEPx (R1 ++ Frame))) ->
     closed_wrt_modvars c (LOCALx QFrame (SEPx Frame)) ->
-    semax Delta (PROPx P (LOCALx Q (SEPx R))) c
+    semax E Delta (PROPx P (LOCALx Q (SEPx R))) c
                       (normal_ret_assert (PROPx P2 (LOCALx (Q2++QFrame) (SEPx (R2++Frame))))).
 Proof.
-intros. subst.
-eapply semax_pre.
-apply H1.
-apply semax_frame_PQR; auto.
-Qed.
-
-Lemma semax_post_fupd:
- forall (R': ret_assert) Espec {cs: compspecs} Delta (R: ret_assert) P c,
-   ENTAIL Delta, RA_normal R' |-- (|={Ensembles.Full_set}=> RA_normal R) ->
-   ENTAIL Delta, RA_break R' |-- (|={Ensembles.Full_set}=> RA_break R) ->
-   ENTAIL Delta, RA_continue R' |-- (|={Ensembles.Full_set}=> RA_continue R) ->
-   (forall vl, ENTAIL Delta, RA_return R' vl |-- (RA_return R vl)) ->
-   @semax cs Espec Delta P c R' ->  @semax cs Espec Delta P c R.
-Proof.
-intros; eapply semax_pre_post_fupd; try eassumption.
-apply andp_left2, fupd_intro; auto.
+  intros. subst.
+  eapply semax_pre.
+  apply H1.
+  apply semax_frame_PQR; auto.
 Qed.
 
-Lemma semax_post:
- forall (R': ret_assert) Espec {cs: compspecs} Delta (R: ret_assert) P c,
-   ENTAIL Delta, RA_normal R' |-- RA_normal R ->
-   ENTAIL Delta, RA_break R' |-- RA_break R ->
-   ENTAIL Delta, RA_continue R' |-- RA_continue R ->
-   (forall vl, ENTAIL Delta, RA_return R' vl |-- RA_return R vl) ->
-   @semax cs Espec Delta P c R' ->  @semax cs Espec Delta P c R.
-Proof.
-intros; eapply semax_pre_post; try eassumption.
-apply andp_left2; auto.
-Qed.
+Definition semax_post_fupd := CConseqFacts.semax_post_fupd.
+Definition semax_post := ConseqFacts.semax_post.
 
 Lemma semax_post_flipped:
-  forall (R' : ret_assert) Espec {cs: compspecs} (Delta : tycontext) (R : ret_assert)
-         (P : environ->mpred) (c : statement),
-   @semax cs Espec Delta P c R' ->
-   ENTAIL Delta, RA_normal R' |-- RA_normal R ->
-   ENTAIL Delta, RA_break R' |-- RA_break R ->
-   ENTAIL Delta, RA_continue R' |-- RA_continue R ->
-   (forall vl, ENTAIL Delta, RA_return R' vl |-- RA_return R vl) ->
-       @semax cs Espec Delta P c R.
+  forall (R' : ret_assert) E (Delta : tycontext) (R : ret_assert)
+         (P : assert) (c : statement),
+   semax E Delta P c R' ->
+   ENTAIL Delta, RA_normal R' ⊢ RA_normal R ->
+   ENTAIL Delta, RA_break R' ⊢ RA_break R ->
+   ENTAIL Delta, RA_continue R' ⊢ RA_continue R ->
+   (forall vl, ENTAIL Delta, RA_return R' vl ⊢ RA_return R vl) ->
+       semax E Delta P c R.
 Proof. intros; eapply semax_post; eassumption. Qed.
 
-
-Lemma semax_post': forall R' Espec {cs: compspecs} Delta R P c,
-           ENTAIL Delta, R' |-- R ->
-      @semax cs Espec Delta P c (normal_ret_assert R') ->
-      @semax cs Espec Delta P c (normal_ret_assert R).
-Proof. intros. eapply semax_post; eauto.
- simpl RA_normal; auto.
- simpl RA_break; normalize.
- simpl RA_continue; normalize.
- intro vl; simpl RA_return; normalize.
-Qed.
-
-Lemma semax_pre_post': forall P' R' Espec {cs: compspecs} Delta R P c,
-      ENTAIL Delta, P |-- P' ->
-      ENTAIL Delta, R' |-- R ->
-      @semax cs Espec Delta P' c (normal_ret_assert R') ->
-      @semax cs Espec Delta P c (normal_ret_assert R).
-Proof. intros.
- eapply semax_pre; eauto.
- eapply semax_post'; eauto.
-Qed.
+Definition semax_post' := ConseqFacts.semax_post'.
+Definition semax_pre_post' := ConseqFacts.semax_pre_post'.
 
 Lemma sequential:
-  forall Espec {cs: compspecs} Delta P c Q,
-        @semax cs Espec Delta P c (normal_ret_assert (RA_normal Q)) ->
-          @semax cs Espec Delta P c Q.
-intros.
- destruct Q as [?Q ?Q ?Q ?Q].
- eapply semax_post; eauto; intros; apply andp_left2; simpl; auto; normalize.
+  forall E Delta P c Q,
+        semax E Delta P c (normal_ret_assert (RA_normal Q)) ->
+          semax E Delta P c Q.
+Proof.
+  intros.
+  destruct Q as [?Q ?Q ?Q ?Q].
+  eapply semax_post; eauto; intros; rewrite bi.and_elim_r; simpl; auto; normalize.
 Qed.
 
 Lemma sequential':
-    forall Q Espec {cs: compspecs} Delta P c R,
-               @semax cs Espec Delta P c (normal_ret_assert Q) ->
-               @semax cs Espec Delta P c (overridePost Q R).
+    forall Q E Delta P c R,
+               semax E Delta P c (normal_ret_assert Q) ->
+               semax E Delta P c (overridePost Q R).
 Proof.
-intros.
-apply semax_post with (normal_ret_assert Q); auto; simpl; intros;
- apply andp_left2; simpl; normalize.
-destruct R; simpl; auto.
+  intros.
+  apply semax_post with (normal_ret_assert Q); auto; simpl; intros;
+    rewrite bi.and_elim_r; simpl; normalize.
+  destruct R; simpl; auto.
 Qed.
 
 Lemma semax_seq':
- forall Espec {cs: compspecs} Delta P c1 P' c2 Q,
-         @semax cs Espec Delta P c1 (normal_ret_assert P') ->
-         @semax cs Espec Delta P' c2 Q ->
-         @semax cs Espec Delta P (Ssequence c1 c2) Q.
+ forall E Delta P c1 P' c2 Q,
+         semax E Delta P c1 (normal_ret_assert P') ->
+         semax E Delta P' c2 Q ->
+         semax E Delta P (Ssequence c1 c2) Q.
 Proof.
- intros. apply semax_seq with P'; auto.
- apply sequential'. auto.
+  intros. apply semax_seq with P'; auto.
+  apply sequential'. auto.
 Qed.
 
 Lemma semax_frame_seq:
- forall {Espec: OracleKind} {cs: compspecs} QFrame Frame Delta
+ forall QFrame Frame E Delta
      P Q c1 c2 R P1 Q1 R1 P2 Q2 R2 R3,
-    semax Delta (PROPx P1 (LOCALx Q1 (SEPx R1))) c1
+    semax E Delta (PROPx P1 (LOCALx Q1 (SEPx R1))) c1
                       (normal_ret_assert (PROPx P2 (LOCALx Q2 (SEPx R2)))) ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
     PROPx P1 (LOCALx (Q1++QFrame) (SEPx (R1 ++ Frame))) ->
     closed_wrt_modvars c1 (LOCALx QFrame (SEPx Frame)) ->
-    semax Delta
+    semax E Delta
          (PROPx P2 (LOCALx (Q2++QFrame) (SEPx (R2 ++ Frame)))) c2 R3 ->
-    semax Delta (PROPx P (LOCALx Q (SEPx R))) (Ssequence c1 c2) R3.
+    semax E Delta (PROPx P (LOCALx Q (SEPx R))) (Ssequence c1 c2) R3.
 Proof.
-intros.
-eapply semax_seq'.
-eapply semax_pre.
-apply H0.
-apply semax_frame_PQR; auto.
-apply H.
-apply H2.
+  intros.
+  eapply semax_seq'.
+  eapply semax_pre.
+  apply H0.
+  apply semax_frame_PQR; auto.
+  apply H.
+  apply H2.
 Qed.
 
 Lemma derives_frame_PQR:
   forall R1 R2 Delta P Q P' Q' R1',
-  ENTAIL Delta, PROPx P (LOCALx Q (SEPx R1)) |-- PROPx P' (LOCALx Q' (SEPx R1')) ->
-  ENTAIL Delta, PROPx P (LOCALx Q (SEPx (R1++R2))) |-- PROPx P' (LOCALx Q' (SEPx (R1'++R2))).
+  ENTAIL Delta, PROPx P (LOCALx Q (SEPx R1)) ⊢ PROPx P' (LOCALx Q' (SEPx R1')) ->
+  ENTAIL Delta, PROPx P (LOCALx Q (SEPx (R1++R2))) ⊢ PROPx P' (LOCALx Q' (SEPx (R1'++R2))).
 Proof.
-intros.
-eapply derives_trans; [ | eapply derives_trans].
-2: apply sepcon_derives; [ apply H | apply (derives_refl  (fun _ => (fold_right sepcon emp R2)))].
-unfold PROPx, LOCALx, SEPx, local; super_unfold_lift; intros.
-rewrite fold_right_sepcon_app.
-intro rho; simpl; normalize.
-apply andp_right; auto.
-apply prop_right; auto.
-apply derives_refl.
-unfold PROPx, LOCALx, SEPx, local; super_unfold_lift; intros.
-rewrite fold_right_sepcon_app.
-intro rho; simpl; normalize.
-apply andp_right; auto.
-apply prop_right; auto.
-apply derives_refl.
+  intros.
+  rewrite /PROPx /LOCALx /SEPx !fold_right_sepcon_app !embed_sep.
+  rewrite !assoc; iIntros "(? & ? & $)".
+  rewrite -!assoc; iApply H.
+  rewrite /PROPx /LOCALx /SEPx; iFrame.
+  rewrite /bi_affinely comm -!assoc //.
 Qed.
 
-Ltac frame_SEP' L :=  (* this should be generalized to permit framing on LOCAL part too *)
- grab_indexes_SEP L;
- match goal with
- | |- @semax _ _ _ (PROPx _ (LOCALx ?Q (SEPx ?R))) _ _ =>
-  rewrite <- (Floyd_firstn_skipn (length L) R);
-  rewrite (app_nil_r Q);
-    simpl length; unfold Floyd_firstn, Floyd_skipn;
-    eapply (semax_frame_PQR);
-      [ unfold closed_wrt_modvars;  auto 50 with closed
-     | ]
- | |- ENTAIL _ , (PROPx _ (LOCALx ?Q (SEPx ?R))) |-- _ =>
-  rewrite <- (Floyd_firstn_skipn (length L) R);
-    simpl length; unfold Floyd_firstn, Floyd_skipn;
-    apply derives_frame_PQR
-end.
-
-Tactic Notation "frame_SEP" constr(a) :=
-  frame_SEP' (a::nil).
-Tactic Notation "frame_SEP" constr(a) constr(b) :=
-  frame_SEP' (a::b::nil).
-Tactic Notation "frame_SEP" constr(a) constr(b) constr(c) :=
-  frame_SEP' (a::b::c::nil).
-Tactic Notation "frame_SEP" constr(a) constr(b) constr(c) constr(d) :=
-  frame_SEP' (a::b::c::d::nil).
-Tactic Notation "frame_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) :=
-  frame_SEP' (a::b::c::d::e::nil).
-Tactic Notation "frame_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) :=
-  frame_SEP' (a::b::c::d::e::f::nil).
-Tactic Notation "frame_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) constr(g) :=
-  frame_SEP' (a::b::c::d::e::f::g::nil).
-Tactic Notation "frame_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) constr(g) constr(h) :=
-  frame_SEP' (a::b::c::d::e::f::g::h::nil).
-Tactic Notation "frame_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) constr(g) constr(h) constr(i) :=
-  frame_SEP' (a::b::c::d::e::f::g::h::i::nil).
-Tactic Notation "frame_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) constr(g) constr(h) constr(i) constr(j) :=
-  frame_SEP' (a::b::c::d::e::f::g::h::i::j::nil).
+Lemma fold_right_sepcon_eq {B : bi} (l : list B) : fold_right_sepcon l = fold_right bi_sep emp l.
+Proof.
+  induction l; auto; simpl.
+  rewrite IHl //.
+Qed.
 
 Lemma gather_SEP {A}:
   forall R1 R2,
-    @SEPx A (R1 ++ R2) = SEPx (fold_right sepcon emp R1 :: R2).
+    @SEPx A Σ (R1 ++ R2) = SEPx (fold_right bi_sep emp R1 :: R2).
 Proof.
-intros.
-unfold SEPx.
-extensionality rho.
-induction R1; simpl. rewrite emp_sepcon; auto.
-rewrite sepcon_assoc; f_equal; auto.
+  intros.
+  unfold SEPx.
+  rewrite fold_right_sepcon_app fold_right_sepcon_eq //.
 Qed.
 
-Ltac gather_SEP' L :=
-   grab_indexes_SEP L;
- match goal with |- context [SEPx ?R] =>
-    let r := fresh "R" in
-    set (r := (SEPx R));
-    revert r;
-     rewrite <- (Floyd_firstn_skipn (length L) R);
-      unfold length at 1 2;
-      unfold Floyd_firstn at 1; unfold Floyd_skipn at 1;
-      rewrite gather_SEP;
-   unfold fold_right at 1; try  rewrite sepcon_emp;
-   try (intro r; unfold r; clear r)
- end.
-
 Fixpoint replace_nth {A} (n: nat) (al: list A) (x: A) {struct n}: list A :=
  match n, al with
  | O , a::al => x::al
@@ -1186,7 +649,7 @@ Proof.
   + simpl. inversion H. reflexivity.
   + inversion H.
   + inversion H. simpl.
-    rewrite (IHn R) at 1; simpl; [reflexivity|exact H1].
+    rewrite -> (IHn R) at 1; simpl; [reflexivity|exact H1].
 Qed.
 
 Lemma nth_error_replace_nth: forall {A:Type} R n (Rn Rn':A),
@@ -1241,400 +704,241 @@ induction i; destruct j,R; intros; simpl; auto.
 contradiction H; auto.
 Qed.
 
-Lemma replace_SEP':
- forall n R' Espec {cs: compspecs} Delta P Q Rs c Post,
- ENTAIL Delta, PROPx P (LOCALx Q (SEPx (my_nth n Rs TT ::  nil))) |-- `R' ->
- @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx (replace_nth n Rs R')))) c Post ->
- @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx Rs))) c Post.
+Lemma PROP_LOCAL_sep1 : forall P Q R1 R, PROPx P (LOCALx Q (SEPx (R1 :: R))) = (PROPx P (LOCALx Q (SEPx [R1])) ∗ SEPx R).
 Proof.
-intros.
-eapply semax_pre; [ | apply H0].
-clear - H.
-unfold PROPx, LOCALx, SEPx in *; intro rho; specialize (H rho).
-unfold local, lift1 in *.
-simpl in *; unfold_lift; unfold_lift in H.
-normalize.
-rewrite !prop_true_andp in H by auto.
-rewrite sepcon_emp in H.
-apply andp_right; auto.
-apply prop_right; auto.
-revert Rs H; induction n; destruct Rs; simpl ; intros; auto;
-apply sepcon_derives; auto.
+  intros; rewrite /PROPx /LOCALx /SEPx /=.
+  apply assert_ext; intros; monPred.unseal; unfold lift1.
+  rewrite !log_normalize.and_assoc -!pure_and.
+  normalize.
+Qed.
+
+Lemma PROP_LOCAL_sep2 : forall P Q R1 R, PROPx P (LOCALx Q (SEPx (R1 :: R))) = (⎡R1⎤ ∗ PROPx P (LOCALx Q (SEPx R))).
+Proof.
+  intros; rewrite /PROPx /LOCALx /SEPx /=.
+  apply assert_ext; intros; monPred.unseal; unfold lift1.
+  rewrite !log_normalize.and_assoc -!pure_and.
+  normalize.
 Qed.
 
 Lemma replace_SEP'':
  forall n R' Delta P Q Rs Post,
- ENTAIL Delta, PROPx P (LOCALx Q (SEPx (my_nth n Rs TT ::  nil))) |-- `R' ->
- ENTAIL Delta, PROPx P (LOCALx Q (SEPx (replace_nth n Rs R'))) |-- Post ->
- ENTAIL Delta, PROPx P (LOCALx Q (SEPx Rs)) |-- Post.
+ ENTAIL Delta, PROPx P (LOCALx Q (SEPx (my_nth n Rs True ::  nil))) ⊢ ⎡R'⎤ ->
+ ENTAIL Delta, PROPx P (LOCALx Q (SEPx (replace_nth n Rs R'))) ⊢ Post ->
+ ENTAIL Delta, PROPx P (LOCALx Q (SEPx Rs)) ⊢ Post.
 Proof.
-intros.
-eapply derives_trans; [ | apply H0].
-clear - H.
-unfold PROPx, LOCALx, SEPx in *; intro rho; specialize (H rho).
-unfold local, lift1 in *.
-simpl in *; unfold_lift; unfold_lift in H.
-normalize.
-rewrite !prop_true_andp in H by auto.
-rewrite sepcon_emp in H.
-apply andp_right; auto.
-apply prop_right; auto.
-revert Rs H; induction n; destruct Rs; simpl ; intros; auto;
-apply sepcon_derives; auto.
+  intros.
+  rewrite -H0; clear - H.
+  apply bi.and_intro; first by iIntros "($ & _)".
+  apply bi.and_intro; first by iIntros "(_ & $ & _)".
+  apply bi.and_intro; first by iIntros "(_ & _ & $ & _)".
+  revert Rs H; induction n; destruct Rs; simpl; intros; try solve [iIntros "(_ & _ & _ & $)"].
+  - rewrite PROP_LOCAL_sep1 /= bi.persistent_and_sep_assoc H /SEPx /= embed_sep //.
+  - apply IHn in H.
+    rewrite PROP_LOCAL_sep2 /SEPx /= embed_sep.
+    rewrite -persistent_and_sep_assoc' H //.
 Qed.
 
-Tactic Notation "replace_SEP" constr(n) constr(R) :=
-  first [apply (replace_SEP' (Z.to_nat n) R) | apply (replace_SEP'' (Z.to_nat n) R)];
-  unfold my_nth,replace_nth; simpl Z.to_nat;
-   repeat simpl_nat_of_P; cbv beta iota; cbv beta iota.
-
-Tactic Notation "replace_SEP" constr(n) constr(R) "by" tactic1(t):=
-  first [apply (replace_SEP' (Z.to_nat n) R) | apply (replace_SEP'' (Z.to_nat n) R)];
-  unfold my_nth,replace_nth; simpl Z.to_nat;
-   repeat simpl_nat_of_P; cbv beta iota; cbv beta iota; [ now t | ].
-
-Lemma replace_SEP'_fupd:
- forall n R' Espec {cs: compspecs} Delta P Q Rs c Post,
- ENTAIL Delta, PROPx P (LOCALx Q (SEPx (my_nth n Rs TT ::  nil))) |-- `(|={Ensembles.Full_set}=> R') ->
- @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx (replace_nth n Rs R')))) c Post ->
- @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx Rs))) c Post.
+Lemma replace_SEP':
+ forall n R' E Delta P Q Rs c Post,
+ ENTAIL Delta, PROPx P (LOCALx Q (SEPx (my_nth n Rs True ::  nil))) ⊢ ⎡R'⎤ ->
+ semax E Delta (PROPx P (LOCALx Q (SEPx (replace_nth n Rs R')))) c Post ->
+ semax E Delta (PROPx P (LOCALx Q (SEPx Rs))) c Post.
 Proof.
-intros.
-eapply semax_pre_fupd; [ | apply H0].
-clear - H.
-unfold PROPx, LOCALx, SEPx in *; intro rho; specialize (H rho).
-unfold local, lift1 in *.
-simpl in *; unfold_lift; unfold_lift in H.
-normalize.
-rewrite !prop_true_andp in H by auto.
-rewrite sepcon_emp in H.
-rewrite prop_true_andp by auto.
-change fupd with (ghost_seplog.fupd Ensembles.Full_set Ensembles.Full_set).
-revert Rs H; induction n; destruct Rs; intros; auto; try solve [apply fupd_intro; auto].
-- eapply derives_trans, fupd_frame_r; apply sepcon_derives; auto.
-- eapply derives_trans, fupd_frame_l; apply sepcon_derives; auto.
+  intros.
+  eapply semax_pre, H0.
+  eapply replace_SEP''; eauto.
+  iIntros "(_ & $)".
 Qed.
 
 Lemma replace_SEP''_fupd:
- forall n R' Delta P Q Rs Post,
- ENTAIL Delta, PROPx P (LOCALx Q (SEPx (my_nth n Rs TT ::  nil))) |-- `(|={Ensembles.Full_set}=> R') ->
- ENTAIL Delta, PROPx P (LOCALx Q (SEPx (replace_nth n Rs R'))) |-- (|={Ensembles.Full_set}=> Post) ->
- ENTAIL Delta, PROPx P (LOCALx Q (SEPx Rs)) |-- (|={Ensembles.Full_set}=> Post).
+ forall n R' E Delta P Q Rs Post,
+ (ENTAIL Delta, PROPx P (LOCALx Q (SEPx (my_nth n Rs True ::  nil))) ⊢ |={E}=> ⎡R'⎤) ->
+ (ENTAIL Delta, PROPx P (LOCALx Q (SEPx (replace_nth n Rs R'))) ⊢ |={E}=> Post) ->
+ ENTAIL Delta, PROPx P (LOCALx Q (SEPx Rs)) ⊢ |={E}=> Post.
 Proof.
-intros.
-eapply derives_trans, fupd_trans.
-eapply derives_trans; [ | apply fupd_mono, H0].
-clear - H.
-unfold PROPx, LOCALx, SEPx in *; intro rho; specialize (H rho).
-unfold local, lift1 in *.
-simpl in *; unfold_lift; unfold_lift in H.
-normalize.
-rewrite !prop_true_andp in H by auto.
-rewrite sepcon_emp in H.
-rewrite !prop_true_andp by auto.
-change fupd with (ghost_seplog.fupd Ensembles.Full_set Ensembles.Full_set).
-revert Rs H; induction n; destruct Rs; intros; auto; try solve [apply fupd_intro; auto].
-- eapply derives_trans, fupd_frame_r; apply sepcon_derives; auto.
-- eapply derives_trans, fupd_frame_l; apply sepcon_derives; auto.
+  intros.
+  rewrite -(fupd_trans _ E) -H0.
+  clear - H.
+  iIntros "(#? & #? & #? & H)".
+  rewrite /SEPx.
+  iInduction n as [|] "IH" forall (Rs H); destruct Rs; simpl.
+  - iIntros "!>"; iFrame; auto.
+  - rewrite !embed_sep; iDestruct "H" as "(? & $)".
+    iMod (H with "[$]") as "$"; auto.
+  - iIntros "!>"; iFrame; auto.
+  - rewrite !embed_sep; iDestruct "H" as "($ & ?)".
+    by iApply "IH".
 Qed.
 
-Tactic Notation "viewshift_SEP" constr(n) constr(R) :=
-  first [apply (replace_SEP'_fupd (Z.to_nat n) R) | apply (replace_SEP''_fupd (Z.to_nat n) R)];
-  unfold my_nth,replace_nth; simpl Z.to_nat;
-   repeat simpl_nat_of_P; cbv beta iota; cbv beta iota.
-
-Tactic Notation "viewshift_SEP" constr(n) constr(R) "by" tactic1(t):=
-  first [apply (replace_SEP'_fupd (Z.to_nat n) R) | apply (replace_SEP''_fupd (Z.to_nat n) R)];
-  unfold my_nth,replace_nth; simpl Z.to_nat;
-   repeat simpl_nat_of_P; cbv beta iota; cbv beta iota; [ now t | ].
-
-Ltac replace_in_pre S S' :=
- match goal with |- @semax _ _ _ ?P _ _ =>
-  match P with context C[S] =>
-     let P' := context C[S'] in
-      apply semax_pre with P'; [ | ]
-  end
- end.
+Lemma replace_SEP'_fupd:
+ forall n R' E Delta P Q Rs c Post,
+ (ENTAIL Delta, PROPx P (LOCALx Q (SEPx (my_nth n Rs True :: nil))) ⊢ |={E}=> ⎡R'⎤) ->
+ semax E Delta (PROPx P (LOCALx Q (SEPx (replace_nth n Rs R')))) c Post ->
+ semax E Delta (PROPx P (LOCALx Q (SEPx Rs))) c Post.
+Proof.
+  intros.
+  eapply semax_pre_fupd, H0.
+  eapply replace_SEP''_fupd; eauto.
+  by iIntros "(_ & $)".
+Qed.
 
 Lemma semax_extract_PROP_True:
-  forall Espec {cs: compspecs} Delta (PP: Prop) P QR c Post,
+  forall E Delta (PP: Prop) P QR c Post,
         PP ->
-        @semax cs Espec Delta (PROPx P QR) c Post ->
-       @semax cs Espec Delta (PROPx (PP::P) QR) c Post.
+        semax E Delta (PROPx P QR) c Post ->
+       semax E Delta (PROPx (PP::P) QR) c Post.
 Proof.
-intros.
-apply semax_pre_simple with (PROPx P QR); auto.
-clear.
-intro rho; unfold PROPx in *; simpl. normalize.
-autorewrite with norm1 norm2; normalize.
+  intros.
+  eapply semax_pre_simple, H0.
+  rewrite /PROPx /= bi.pure_and.
+  iIntros "(_ & (_ & $) & $)".
 Qed.
 
 Lemma semax_extract_PROP:
-  forall Espec {cs: compspecs} Delta (PP: Prop) P QR c Post,
-       (PP -> @semax cs Espec Delta (PROPx P QR) c Post) ->
-       @semax cs Espec Delta (PROPx (PP::P) QR) c Post.
+  forall E Delta (PP: Prop) P QR c Post,
+       (PP -> semax E Delta (PROPx P QR) c Post) ->
+       semax E Delta (PROPx (PP::P) QR) c Post.
 Proof.
-intros.
-apply semax_pre_simple with (!!PP && PROPx P QR).
-intro rho; unfold PROPx in *; simpl; normalize.
-autorewrite with norm1 norm2; normalize.
-apply andp_right; auto.
-apply prop_right; auto.
-apply semax_extract_prop.
-auto.
+  intros.
+  apply semax_extract_prop in H.
+  eapply semax_pre_simple, H.
+  rewrite /PROPx /= bi.pure_and.
+  by iIntros "(_ & (% & $) & $)".
 Qed.
 
 Lemma PROP_later_derives:
- forall P QR QR', (QR |-- |>QR') ->
-    PROPx P QR |-- |> PROPx P QR'.
+ forall {A} P QR QR', (QR ⊢ ▷QR') ->
+    @PROPx A Σ P QR ⊢ ▷ PROPx P QR'.
 Proof.
-intros.
-unfold PROPx.
-normalize.
+  intros.
+  rewrite /PROPx H; iIntros "($ & $)".
 Qed.
 
 Lemma LOCAL_later_derives:
- forall Q R R', (R |-- |>R') -> LOCALx Q R |-- |> LOCALx Q R'.
+ forall Q R R', (R ⊢ ▷R') -> LOCALx Q R ⊢ ▷ LOCALx Q R'.
 Proof.
-unfold LOCALx; intros; normalize.
-rewrite later_andp.
-apply andp_derives; auto.
-apply now_later.
+  intros.
+  rewrite /LOCALx H; iIntros "(? & $)"; auto.
 Qed.
 
 Lemma SEP_later_derives:
-  forall P Q P' Q',
-      (P |-- |> P') ->
-      (SEPx Q |-- |> SEPx Q') ->
-      SEPx (P::Q) |-- |> SEPx (P'::Q').
+  forall {A} P Q P' Q',
+      (P ⊢ ▷ P') ->
+      (@SEPx A Σ Q ⊢ ▷ SEPx Q') ->
+      @SEPx A Σ (P::Q) ⊢ ▷ SEPx (P'::Q').
 Proof.
-unfold SEPx.
-intros.
-intro rho.
-specialize (H0 rho).
-intros; normalize.
-simpl.
-rewrite later_sepcon.
-apply sepcon_derives; auto.
+  unfold SEPx; intros.
+  rewrite /= !embed_sep H H0 embed_later.
+  iIntros "($ & $)".
 Qed.
-#[export] Hint Resolve PROP_later_derives LOCAL_later_derives SEP_later_derives : derives.
 
-Lemma local_lift0: forall P, local (lift0 P) = prop P.
+Lemma local_lift0: forall P, local (lift0 P) = ⌜P⌝.
 Proof.
-intros. extensionality rho. reflexivity.
+  intros. rewrite /local /lift0; apply assert_ext; intros; monPred.unseal; done.
 Qed.
-#[export] Hint Rewrite @local_lift0: norm2.
 
 Lemma extract_exists_post:
-  forall {Espec: OracleKind} {cs: compspecs} {A: Type} (x: A) Delta
-       (P: environ -> mpred) c (R: A -> environ -> mpred),
-  semax Delta P c (normal_ret_assert (R x)) ->
-  semax Delta P c (normal_ret_assert (exp R)).
+  forall {A: Type} (x: A) E Delta
+       (P: assert) c (R: A -> assert),
+  semax E Delta P c (normal_ret_assert (R x)) ->
+  semax E Delta P c (normal_ret_assert (∃ x, R x)).
 Proof.
-intros.
-eapply semax_pre_post; try apply H;
-intros; apply andp_left2; auto; try apply derives_refl.
-apply exp_right with x; normalize; apply derives_refl.
+  intros.
+  eapply semax_pre_post, H; intros; rewrite bi.and_elim_r // /=; eauto.
 Qed.
 
-Ltac repeat_extract_exists_pre :=
-   first [(apply extract_exists_pre;
-             let x := fresh "x" in intro x; normalize;
-                repeat_extract_exists_pre;
-                revert x)
-           | autorewrite with canon
-          ].
-
 Lemma extract_exists_in_SEP:
   forall {A} (R1: A -> mpred) P Q R,
-    PROPx P (LOCALx Q (SEPx (exp R1 :: R))) =
-    (EX x:A, PROPx P (LOCALx Q (SEPx (R1 x::R))))%assert.
+    PROPx P (LOCALx Q (SEPx ((∃ x, R1 x) :: R))) =
+    (∃ x:A, PROPx P (LOCALx Q (SEPx (R1 x::R))))%assert.
 Proof.
-intros.
-extensionality rho.
-unfold PROPx, LOCALx, SEPx; simpl.
-normalize.
+  intros.
+  rewrite /PROPx /LOCALx /SEPx; apply assert_ext; intros; monPred.unseal.
+  normalize.
 Qed.
 
-Ltac extract_exists_in_SEP :=
- match goal with |- @semax _ _ _ (PROPx _ (LOCALx _ (SEPx ?R))) _ _ =>
-   match R with context [ exp ?z :: _] =>
-        let n := find_in_list (exp z) R
-         in rewrite (grab_nth_SEP n); unfold nth, delete_nth; rewrite extract_exists_in_SEP;
-             repeat_extract_exists_pre
-  end
-end.
-
 Lemma flatten_sepcon_in_SEP:
   forall P Q R1 R2 R,
-           PROPx P (LOCALx Q (SEPx ((R1*R2) :: R))) =
+           PROPx P (LOCALx Q (SEPx ((R1∗R2) :: R))) =
            PROPx P (LOCALx Q (SEPx (R1 :: R2 :: R))).
 Proof.
-intros.
-f_equal. f_equal. extensionality rho.
-unfold SEPx.
-simpl. rewrite sepcon_assoc. auto.
+  intros.
+  rewrite /PROPx /LOCALx /SEPx /= -sep_assoc //.
 Qed.
 
 Lemma flatten_sepcon_in_SEP'':
   forall n P Q (R1 R2: mpred) (R: list mpred) R',
-   nth_error R n = Some ((R1 * R2)) ->
+   nth_error R n = Some ((R1 ∗ R2)) ->
    R' = Floyd_firstn n R ++ R1 :: R2 :: Floyd_skipn (S n) R ->
    PROPx P (LOCALx Q (SEPx R)) = PROPx P (LOCALx Q (SEPx R')).
 Proof.
-intros.
-f_equal.
-f_equal.
-unfold SEPx.
-extensionality rho.
-subst R'.
-revert R H.
-clear.
-induction n; destruct R; intros.
-inv H.
-simpl nth_error in H. inv H.
-unfold Floyd_firstn, Floyd_skipn, app.
-simpl.
-repeat rewrite <- sepcon_assoc.
-reflexivity.
-inv H.
-specialize (IHn _ H). clear H.
-simpl Floyd_firstn.
-change (m :: Floyd_firstn n R) with (app (m::nil) (Floyd_firstn n R)).
-rewrite <- app_assoc. unfold app at 1.
-simpl.
-f_equal.
-auto.
+  intros.
+  rewrite /PROPx /LOCALx /SEPx; do 3 f_equiv.
+  subst R'.
+  revert R H; clear; induction n; destruct R; intros; simpl in *; try done.
+  - inv H.
+    rewrite sep_assoc //.
+  - rewrite IHn //.
 Qed.
 
-Ltac flatten_in_SEP PQR :=
- match PQR with
- | PROPx ?P (LOCALx ?Q (SEPx (?R))) =>
-   match R with context [(?R1 * ?R2) :: ?R'] =>
-      let n := constr:((length R - Datatypes.S (length R'))%nat) in
-      let n' := eval lazy beta zeta iota delta in n in
-      erewrite(@flatten_sepcon_in_SEP'' n' P Q R1 R2 R _ (eq_refl _));
-      [ |
-        let RR := fresh "RR" in set (RR := R);
-        let RR1 := fresh "RR1" in set (RR1 := R1);
-        let RR2 := fresh "RR2" in set (RR2 := R2);
-        unfold Floyd_firstn, app, Floyd_skipn; subst RR RR1 RR2; cbv beta iota;
-        apply eq_refl
-      ]
-   end
- end.
-
-Ltac flatten_sepcon_in_SEP :=
-  match goal with
-  | |- semax _ ?PQR _ _ => flatten_in_SEP PQR
-  | |-  ENTAIL _, ?PQR |-- _ => flatten_in_SEP PQR
-end.
-
 Lemma semax_ff:
-  forall Espec {cs: compspecs} Delta c R,
-   @semax cs Espec Delta FF c R.
+  forall E Delta c R,
+   semax E Delta False c R.
 Proof.
-intros.
-apply semax_pre with (FF && FF).
-apply andp_left2. apply andp_right; auto.
-apply semax_extract_prop. intros; contradiction.
+  intros.
+  apply ConseqFacts.semax_pre_simple with (False ∧ False).
+  { apply bi.False_elim. }
+  apply semax_extract_prop; contradiction.
 Qed.
 
 Lemma extract_prop_in_SEP:
   forall n P1 Rn P Q R,
-   nth n R emp = prop P1 && Rn ->
+   nth n R emp = (⌜P1⌝ ∧ Rn) ->
    PROPx P (LOCALx Q (SEPx R)) = PROPx (P1::P) (LOCALx Q (SEPx (replace_nth n R Rn))).
 Proof.
-intros.
-extensionality rho.
-unfold PROPx,LOCALx,SEPx,local,lift1.
-simpl.
-apply pred_ext; normalize.
-* match goal with |- _ |-- !! ?PP && _ => replace PP with P1
-   by (apply prop_ext; tauto)
-  end.
-  clear - H.
+  intros.
+  rewrite /PROPx /LOCALx /SEPx /= pure_and'.
+  rewrite (and_comm' ⌜P1⌝) -and_assoc'; f_equal.
+  rewrite and_assoc' (and_comm' ⌜P1⌝) -and_assoc'; f_equiv.
+  apply assert_ext; intros; monPred.unseal.
   revert R H; induction n; destruct R; simpl; intros.
-  apply andp_right; auto.
-  rewrite H; apply andp_left1; auto.
-  rewrite H.
-  normalize.
-  apply andp_right; auto.
-  rewrite H; apply andp_left1; auto.
-  rewrite <- sepcon_andp_prop.
-  apply sepcon_derives; auto.
-*
-  rewrite prop_true_andp by auto.
- clear - H H0.
-  revert R H; induction n; destruct R; simpl; intros; auto.
-  subst m. rewrite prop_true_andp; auto.
-  apply sepcon_derives; auto.
+  - rewrite H log_normalize.and_assoc -pure_and (@prop_ext (P1 /\ P1) P1) //; tauto.
+  - rewrite H sepcon_andp_prop' //.
+  - rewrite H log_normalize.and_assoc -pure_and (@prop_ext (P1 /\ P1) P1) //; tauto.
+  - rewrite IHn //.
+    rewrite sepcon_andp_prop //.
 Qed.
 
 Lemma insert_SEP:
- forall R1 P Q R, `R1 * PROPx P (LOCALx Q (SEPx R)) = PROPx P (LOCALx Q (SEPx (R1::R))).
+ forall R1 P Q R, (⎡R1⎤ ∗ PROPx P (LOCALx Q (SEPx R))) = PROPx P (LOCALx Q (SEPx (R1::R))).
 Proof.
-intros.
-unfold PROPx,LOCALx,SEPx,local,lift1.
-extensionality rho; simpl.
-repeat rewrite sepcon_andp_prop. f_equal; auto.
+  intros; rewrite PROP_LOCAL_sep2 //.
 Qed.
 
 Lemma delete_emp_in_SEP {A}:
   forall n (R: list mpred),
     nth_error R n = Some emp ->
-    @SEPx A R = SEPx (firstn n R ++ list_drop (S n) R).
+    @SEPx A Σ R = SEPx (firstn n R ++ list_drop (S n) R).
 Proof.
-intros.
-unfold SEPx; extensionality rho.
-revert R H; induction n; destruct R; simpl; intros; auto.
-inv H. rewrite emp_sepcon; auto.
-f_equal.
-etransitivity.
-apply IHn; auto.
-reflexivity.
+  intros.
+  rewrite /SEPx.
+  f_equiv.
+  revert R H; induction n; destruct R; simpl; intros; auto.
+  - inv H; rewrite emp_sep //.
+  - rewrite IHn //.
 Qed.
 
-Ltac delete_emp_in_SEP :=
- repeat
- match goal with |- context [SEPx ?R] =>
-   match R with context [emp:: ?R'] =>
-     rewrite (delete_emp_in_SEP (length R - S (length R')) R) by reflexivity;
-     simpl length; simpl minus; unfold firstn, app, list_drop; fold app
-   end
- end.
-
-Ltac move_from_SEP :=
-  (* combines extract_exists_in_SEP, move_prop_from_SEP, (*move_local_from_SEP, *)
-                  flatten_sepcon_in_SEP *)
-match goal with |- context [PROPx _ (LOCALx _ (SEPx ?R))] =>
-  match R with
-  | context [(prop ?P1 && ?Rn) :: ?R'] =>
-      let n := length_of R in let n' := length_of R' in
-        rewrite (extract_prop_in_SEP (n-S n')%nat P1 Rn) by reflexivity;
-        simpl minus; unfold replace_nth
-  | context [ exp ?z :: _] =>
-        let n := find_in_list (exp z) R
-         in rewrite (grab_nth_SEP n); unfold nth, delete_nth; rewrite extract_exists_in_SEP;
-             repeat_extract_exists_pre
-  | context [ (sepcon ?x  ?y) :: ?R'] =>
-        let n := length_of R in let n' := length_of R' in
-         rewrite (grab_nth_SEP (n-S n')); simpl minus; unfold nth, delete_nth;
-         rewrite flatten_sepcon_in_SEP
- end
-end.
-
 Lemma nth_error_local:
   forall n Delta P Q R (Qn: localdef),
     nth_error Q n = Some Qn ->
-    ENTAIL Delta, PROPx P (LOCALx Q R) |-- local (locald_denote Qn).
+    ENTAIL Delta, PROPx P (LOCALx Q R) ⊢ local (locald_denote Qn).
 Proof.
-intros.
-apply andp_left2. apply andp_left2. apply andp_left1.
-go_lowerx. normalize.
-revert Q H H0; induction n; destruct Q; intros; inv H.
-destruct H0; auto.
-destruct H0. apply (IHn Q); auto.
+  intros.
+  rewrite /PROPx !bi.and_elim_r.
+  rewrite /LOCALx bi.and_elim_l.
+  revert Q H; induction n; destruct Q; intros; inv H; simpl.
+  - rewrite local_lift2_and bi.and_elim_l //.
+  - rewrite local_lift2_and bi.and_elim_r IHn //.
 Qed.
 
 Lemma in_nth_error: forall {A} (x: A) xs, In x xs -> exists n, nth_error xs n = Some x.
@@ -1652,7 +956,7 @@ Proof.
 Qed.
 
 Lemma in_local: forall Q0 Delta P Q R, In Q0 Q ->
-   ENTAIL Delta, PROPx P (LOCALx Q R) |-- local (locald_denote Q0).
+   ENTAIL Delta, PROPx P (LOCALx Q R) ⊢ local (locald_denote Q0).
 Proof.
   intros.
   destruct (in_nth_error _ _ H) as [?n ?H].
@@ -1662,245 +966,158 @@ Qed.
 
 Lemma lower_PROP_LOCAL_SEP:
   forall P Q R rho, PROPx P (LOCALx Q (SEPx R)) rho =
-     (!!fold_right and True P && (local (fold_right (`and) (`True) (map locald_denote Q)) && `(fold_right sepcon emp R))) rho.
-Proof. reflexivity. Qed.
-#[export] Hint Rewrite lower_PROP_LOCAL_SEP : norm2.
+     (⌜fold_right and True P⌝ ∧ (local (fold_right (`and) (`True%type) (map locald_denote Q)) ∧ ⎡fold_right bi_sep emp R⎤)) rho.
+Proof. intros; rewrite /PROPx /LOCALx /SEPx fold_right_sepcon_eq //. Qed.
 
-Lemma lower_TT: forall rho, @TT (environ->mpred) _ rho = @TT mpred Nveric.
+(*Lemma lower_TT: forall rho, @TT (assert) _ rho = @TT mpred Nveric.
 Proof. reflexivity. Qed.
 #[export] Hint Rewrite lower_TT : norm2.
 
-Lemma lower_FF: forall rho, @FF (environ->mpred) _ rho = @FF mpred Nveric.
+Lemma lower_FF: forall rho, @FF (assert) _ rho = @FF mpred Nveric.
 Proof. reflexivity. Qed.
-#[export] Hint Rewrite lower_FF : norm2.
+#[export] Hint Rewrite lower_FF : norm2.*)
 
 Lemma assert_PROP:
- forall P1 Espec {cs: compspecs} Delta PQR c Post,
-    ENTAIL Delta, PQR |-- !! P1 ->
-   (P1 -> @semax cs Espec Delta PQR c Post) ->
-   @semax cs Espec Delta PQR c Post.
+ forall P1 E Delta PQR c Post,
+    ENTAIL Delta, PQR ⊢ ⌜P1⌝ ->
+   (P1 -> semax E Delta PQR c Post) ->
+   semax E Delta PQR c Post.
 Proof.
-intros.
-eapply semax_pre.
-apply andp_right.
-apply H.
-apply andp_left2; apply derives_refl.
-apply semax_extract_prop.
-auto.
+  intros.
+  apply semax_extract_prop in H0.
+  eapply semax_pre, H0.
+  apply bi.and_intro; auto.
+  rewrite bi.and_elim_r //.
 Qed.
 
 Lemma semax_extract_later_prop1:
-  forall {cs: compspecs} {Espec: OracleKind} Delta (PP: Prop) P c Q,
-           (PP -> semax Delta (|> P) c Q) ->
-           semax Delta (|> (!!PP && P)) c Q.
+  forall E Delta (PP: Prop) P c Q,
+           (PP -> semax E Delta (▷ P) c Q) ->
+           semax E Delta (▷ (⌜PP⌝ ∧ P)) c Q.
 Proof.
   intros.
-  rewrite later_andp.
-  apply semax_extract_later_prop; auto.
+  apply semax_extract_later_prop in H.
+  eapply semax_pre, H.
+  rewrite bi.and_elim_r bi.later_and //.
 Qed.
 
 Lemma assert_later_PROP:
- forall P1 Espec {cs: compspecs} Delta PQR c Post,
-    ENTAIL Delta, PQR|-- !! P1 ->
-   (P1 -> @semax cs Espec Delta (|> PQR) c Post) ->
-   @semax cs Espec Delta (|> PQR) c Post.
+ forall P1 E Delta PQR c Post,
+    ENTAIL Delta, PQR ⊢ ⌜P1⌝ ->
+   (P1 -> semax E Delta (▷ PQR) c Post) ->
+   semax E Delta (▷ PQR) c Post.
 Proof.
-intros.
-eapply semax_pre_simple.
-apply later_left2.
-apply andp_right.
-apply H.
-apply andp_left2; apply derives_refl.
-apply semax_extract_later_prop1.
-auto.
+  intros.
+  apply semax_extract_later_prop1 in H0.
+  eapply semax_pre, H0.
+  iIntros "H"; iSplit.
+  - iApply H; iNext; done.
+  - iDestruct "H" as "(_ & $)".
 Qed.
 
-Lemma assert_PROP' {A}{NA: NatDed A}:
- forall P Pre (Post: A),
-   (Pre |-- !! P) ->
-   (P -> Pre |-- Post) ->
-   Pre |-- Post.
+Lemma assert_PROP' {B : bi}:
+ forall P Pre (Post : B),
+   (Pre ⊢ ⌜P⌝) ->
+   (P -> Pre ⊢ Post) ->
+   Pre ⊢ Post.
 Proof.
-intros.
-apply derives_trans with (!!P && Pre).
-apply andp_right; auto.
-apply derives_extract_prop. auto.
+  intros; iIntros "H".
+  iDestruct (H with "H") as %?.
+  by iApply H0.
 Qed.
 
 Lemma assert_later_PROP':
- forall P1 Espec {cs: compspecs} Delta PQR PQR' c Post,
-    ENTAIL Delta, PQR' |-- !! P1 ->
-    (PQR |-- |> PQR') ->
-   (P1 -> @semax cs Espec Delta PQR c Post) ->
-   @semax cs Espec Delta PQR c Post.
+ forall P1 E Delta PQR PQR' c Post,
+    ENTAIL Delta, PQR' ⊢ ⌜P1⌝ ->
+    (PQR ⊢ ▷ PQR') ->
+   (P1 -> semax E Delta PQR c Post) ->
+   semax E Delta PQR c Post.
 Proof.
-intros.
-apply semax_extract_later_prop in H1.
-eapply semax_pre_simple, H1.
-apply andp_right.
-+ eapply derives_trans, later_derives, H.
-  rewrite later_andp; apply andp_derives; auto.
-  apply now_later.
-+ apply andp_left2; trivial.
+  intros.
+  apply semax_extract_later_prop in H1.
+  eapply semax_pre_simple, H1.
+  iIntros "H"; iSplit.
+  - rewrite -H H0; iNext; done.
+  - rewrite bi.and_elim_r //.
 Qed.
 
 Lemma assert_LOCAL:
- forall Q1 Espec {cs: compspecs} Delta P Q R c Post,
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- local (locald_denote Q1) ->
-   @semax cs Espec Delta (PROPx P (LOCALx (Q1::Q) (SEPx R))) c Post ->
-   @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R))) c Post.
+ forall Q1 E Delta P Q R c Post,
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢ local (locald_denote Q1) ->
+   semax E Delta (PROPx P (LOCALx (Q1::Q) (SEPx R))) c Post ->
+   semax E Delta (PROPx P (LOCALx Q (SEPx R))) c Post.
 Proof.
-intros.
-eapply semax_pre; try apply H0.
-rewrite <- (insert_local Q1); apply andp_right; auto.
-apply andp_left2; auto.
+  intros.
+  eapply semax_pre, H0.
+  rewrite <- (insert_local Q1); apply bi.and_intro; auto.
+  rewrite bi.and_elim_r //.
 Qed.
 
-Tactic Notation "assert_LOCAL" constr(A) :=
-  apply (assert_LOCAL A).
-
-Tactic Notation "assert_LOCAL" constr(A) "by" tactic1(t) :=
-  apply (assert_LOCAL A); [ now t | ].
-
 Lemma drop_LOCAL'':
   forall (n: nat)  P Q R Post,
-   (PROPx P (LOCALx (delete_nth n Q) (SEPx R)) |-- Post) ->
-   PROPx P (LOCALx Q (SEPx R)) |-- Post.
+   (PROPx P (LOCALx (delete_nth n Q) (SEPx R)) ⊢ Post) ->
+   PROPx P (LOCALx Q (SEPx R)) ⊢ Post.
 Proof.
-intros.
-eapply derives_trans; try apply H.
-apply andp_derives; auto.
-apply andp_derives; auto.
-intro rho; unfold local, lift1; unfold_lift. apply prop_derives; simpl.
-clear.
-revert Q; induction n; destruct Q; simpl; intros; intuition.
+  intros.
+  rewrite -H.
+  apply bi.and_mono; first done.
+  apply bi.and_mono; last done.
+  clear; revert Q; induction n; destruct Q; simpl; intros; intuition auto.
+  - rewrite local_lift2_and bi.and_elim_r //.
+  - rewrite !local_lift2_and IHn //.
 Qed.
 
 Lemma drop_LOCAL':
   forall (n: nat)  Delta P Q R Post,
-   ENTAIL Delta, PROPx P (LOCALx (delete_nth n Q) (SEPx R)) |-- Post ->
-   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- Post.
+   ENTAIL Delta, PROPx P (LOCALx (delete_nth n Q) (SEPx R)) ⊢ Post ->
+   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢ Post.
 Proof.
-intros.
-eapply derives_trans; try apply H.
-apply andp_derives; auto.
-apply andp_derives; auto.
-apply andp_derives; auto.
-intro rho; unfold local, lift1; unfold_lift. apply prop_derives; simpl.
-clear.
-revert Q; induction n; destruct Q; simpl; intros; intuition.
+  intros.
+  rewrite -H.
+  apply bi.and_mono; first done.
+  apply bi.and_mono; first done.
+  apply bi.and_mono; last done.
+  clear; revert Q; induction n; destruct Q; simpl; intros; intuition auto.
+  - rewrite local_lift2_and bi.and_elim_r //.
+  - rewrite !local_lift2_and IHn //.
 Qed.
 
 Lemma drop_LOCAL:
-  forall (n: nat) Espec {cs: compspecs} Delta P Q R c Post,
-   @semax cs Espec Delta (PROPx P (LOCALx (delete_nth n Q) (SEPx R))) c Post ->
-   @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R))) c Post.
+  forall (n: nat) E Delta P Q R c Post,
+   semax E Delta (PROPx P (LOCALx (delete_nth n Q) (SEPx R))) c Post ->
+   semax E Delta (PROPx P (LOCALx Q (SEPx R))) c Post.
 Proof.
-intros.
-eapply semax_pre; try apply H.
-apply andp_left2.
-apply andp_derives; auto.
-apply andp_derives; auto.
-intro rho; unfold local, lift1; unfold_lift. apply prop_derives; simpl.
-clear.
-revert Q; induction n; destruct Q; simpl; intros; intuition.
+  intros.
+  eapply semax_pre, H.
+  rewrite bi.and_elim_r; eapply drop_LOCAL''; done.
 Qed.
 
-Ltac drop_LOCAL n :=
-   first [apply (drop_LOCAL n) | apply (drop_LOCAL' n) | apply (drop_LOCAL'' n)];
-    unfold delete_nth.
-
-Fixpoint find_LOCAL_index (name: ident) (current: nat) (l : list localdef) : option nat :=
-  match l with
-  | h :: t => match h with
-    | temp  i _   => if (i =? name)%positive then Some current else find_LOCAL_index name (S current) t
-    | lvar  i _ _ => if (i =? name)%positive then Some current else find_LOCAL_index name (S current) t
-    | gvars _ => find_LOCAL_index name (S current) t
-    end
-  | nil => None
-  end.
+Definition not_conj_notation (P: Prop) := True%type.
 
-Ltac drop_LOCAL_by_name name := match goal with
-  | |- semax _ (PROPx ?P (LOCALx ?Q (SEPx ?R))) _ _ =>
-    let r := eval hnf in (find_LOCAL_index name O Q) in match r with
-    | Some ?i => drop_LOCAL i
-    | None => fail 1 "No variable named" name "found"
-    end
-  end.
+Lemma split_first_PROP {A}:
+  forall P Q R S,
+  not_conj_notation (P/\Q) ->
+  @PROPx A Σ ((P/\Q)::R) S = PROPx (P::Q::R) S.
+Proof.
+  intros. unfold PROPx; simpl.
+  f_equal; f_equal; apply prop_ext; rewrite assoc //.
+Qed.
 
-Ltac drop_LOCALs l := match l with
-| ?h :: ?t => drop_LOCAL_by_name h; drop_LOCALs t
-| nil => idtac
-end.
-
-Ltac clean_up_app_carefully := (* useful after rewriting by SEP_PROP *)
- repeat
-  match goal with
-  | |- context [@app Prop (?a :: ?b) ?c] =>
-    change (app (a::b) c) with (a :: app b c)
-  | |- context [@app (environ->Prop) (?a :: ?b) ?c] =>
-    change (app (a::b) c) with (a :: app b c)
-  | |- context [@app (lifted (LiftEnviron Prop)) (?a :: ?b) ?c] =>
-    change (app (a::b) c) with (a :: app b c)
-  | |- context [@app (environ->mpred) (?a :: ?b) ?c] =>
-    change (app (a::b) c) with (a :: app b c)
-  | |- context [@app (lifted (LiftEnviron mpred)) (?a :: ?b) ?c] =>
-    change (app (a::b) c) with (a :: app b c)
-  | |- context [@app Prop nil ?c] =>
-     change (app nil c) with c
-  | |- context [@app (environ->Prop) nil ?c] =>
-     change (app nil c) with c
-  | |- context [@app (lifted (LiftEnviron Prop)) nil ?c] =>
-     change (app nil c) with c
-  | |- context [@app (lifted (environ->mpred)) nil ?c] =>
-     change (app nil c) with c
-  | |- context [@app (lifted (LiftEnviron mpred)) nil ?c] =>
-     change (app nil c) with c
- end.
-
-Definition not_conj_notation (P: Prop) := True.
-
-Ltac not_conj_notation :=
- match goal with
- | |- not_conj_notation (_ <= _ <= _)%Z => fail 1
- | |- not_conj_notation (_ <= _ < _)%Z => fail 1
- | |- not_conj_notation (_ < _ <= _)%Z => fail 1
- | |- not_conj_notation (_ <= _ <= _)%nat => fail 1
- | |- not_conj_notation (_ <= _ < _)%nat => fail 1
- | |- not_conj_notation (_ < _ <= _)%nat => fail 1
- | |- _ => apply Coq.Init.Logic.I
- end.
-
-Lemma split_first_PROP {A}:
-  forall P Q R S,
-  not_conj_notation (P/\Q) ->
-  @PROPx A ((P/\Q)::R) S = PROPx (P::Q::R) S.
-Proof.
-intros. unfold PROPx; simpl.
-extensionality rho.
-apply pred_ext; apply andp_derives; auto;
-  apply prop_derives; tauto.
-Qed.
-#[export] Hint Rewrite @split_first_PROP using not_conj_notation : norm1.
-
-Lemma perm_derives:
-  forall Delta P Q R P' Q' R',
-    Permutation P P' ->
-    Permutation Q Q' ->
-    Permutation R R' ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- PROPx P' (LOCALx Q' (SEPx R')).
-Proof.
-  intros.
-  erewrite PROPx_Permutation by eauto.
-  erewrite LOCALx_Permutation by eauto.
-  erewrite SEPx_Permutation by eauto.
-  apply andp_left2; auto.
-Qed.
+Lemma perm_derives:
+  forall Delta P Q R P' Q' R',
+    Permutation P P' ->
+    Permutation Q Q' ->
+    Permutation R R' ->
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢ PROPx P' (LOCALx Q' (SEPx R')).
+Proof.
+  intros.
+  erewrite bi.and_elim_r, PROPx_Permutation, LOCALx_Permutation, SEPx_Permutation; done.
+Qed.
 
 Lemma semax_frame_perm:
 forall (Qframe : list localdef)
          (Rframe : list mpred)
-         (Espec : OracleKind) {cs: compspecs}
+         E
          (Delta : tycontext)
          (P : list Prop) (Q : list localdef) (c : statement)
          (R : list mpred)
@@ -1910,133 +1127,92 @@ forall (Qframe : list localdef)
        closed_wrt_modvars c (LOCALx Qframe (SEPx Rframe)) ->
        Permutation (Qframe ++ Q1) Q ->
        Permutation (Rframe ++ R1)  R ->
-       semax Delta (PROPx P (LOCALx Q1 (SEPx R1))) c
+       semax E Delta (PROPx P (LOCALx Q1 (SEPx R1))) c
          (normal_ret_assert (PROPx P2 (LOCALx Q2 (SEPx R2)))) ->
-       semax Delta (PROPx P (LOCALx Q (SEPx R))) c
+       semax E Delta (PROPx P (LOCALx Q (SEPx R))) c
          (normal_ret_assert
             (PROPx P2 (LOCALx (Q2 ++ Qframe) (SEPx (R2 ++ Rframe))))).
 Proof.
- intros.
- eapply (semax_frame1 Qframe Rframe); try eassumption; auto.
- apply perm_derives.
- apply Permutation_refl.
- eapply perm_trans; [apply Permutation_sym; eassumption | apply Permutation_app_comm].
- eapply perm_trans; [apply Permutation_sym; eassumption | apply Permutation_app_comm].
+  intros.
+  eapply (semax_frame1 Qframe Rframe); try eassumption; auto.
+  apply perm_derives.
+  apply Permutation_refl.
+  eapply perm_trans; [apply Permutation_sym; eassumption | apply Permutation_app_comm].
+  eapply perm_trans; [apply Permutation_sym; eassumption | apply Permutation_app_comm].
 Qed.
 
 Lemma semax_post_flipped' :
-   forall (R': environ->mpred) Espec {cs: compspecs} (Delta: tycontext) (R P: environ->mpred) c,
-       @semax cs Espec Delta P c (normal_ret_assert R') ->
-       ENTAIL Delta, R' |-- R ->
-       @semax cs Espec Delta P c (normal_ret_assert R).
- Proof. intros; eapply semax_post_flipped; [ eassumption | .. ];
- auto;
- intros; apply andp_left2; simpl; normalize.
+   forall (R': assert) E (Delta: tycontext) (R P: assert) c,
+       semax E Delta P c (normal_ret_assert R') ->
+       ENTAIL Delta, R' ⊢ R ->
+       semax E Delta P c (normal_ret_assert R).
+Proof.
+  intros; eapply semax_post_flipped; [ eassumption | .. ]; auto;
+    intros; rewrite bi.and_elim_r; simpl; normalize.
 Qed.
 
-Tactic Notation "semax_frame" constr(Qframe) constr(Rframe) :=
- first
-    [ simple eapply (semax_frame_perm Qframe Rframe);
-          [auto 50 with closed | solve_perm | solve_perm | unfold app; fold @app ]
-    | eapply semax_post_flipped';
-      [simple eapply (semax_frame_perm Qframe Rframe);
-        [auto 50 with closed | solve_perm | solve_perm | unfold app; fold @app ]
-      | try solve [apply perm_derives; solve_perm]]
-  ].
-
-Tactic Notation "semax_frame" "[" "]" constr(Rframe) :=
- first
-    [ simple eapply (semax_frame_perm nil Rframe);
-          [auto 50 with closed | solve_perm | solve_perm | unfold app; fold @app ]
-    | eapply semax_post_flipped';
-      [simple eapply (semax_frame_perm nil Rframe);
-        [auto 50 with closed | solve_perm | solve_perm | unfold app; fold @app ]
-      | try solve [apply perm_derives; solve_perm]]
-  ].
-
 
 Lemma semax_pre_later:
- forall P' Espec {cs: compspecs} Delta P1 P2 P3 c R,
-     ENTAIL Delta, PROPx P1 (LOCALx P2 (SEPx P3)) |-- P' ->
-     @semax cs Espec Delta (|> P') c R  ->
-     @semax cs Espec Delta (|> (PROPx P1 (LOCALx P2 (SEPx P3)))) c R.
+ forall P' E Delta P1 P2 P3 c R,
+     ENTAIL Delta, PROPx P1 (LOCALx P2 (SEPx P3)) ⊢ P' ->
+     semax E Delta (▷ P') c R  ->
+     semax E Delta (▷ (PROPx P1 (LOCALx P2 (SEPx P3)))) c R.
 Proof.
-intros.
-eapply semax_pre_simple; try apply H0.
-eapply derives_trans; [ | apply later_derives; apply H ].
-eapply derives_trans.
-2: apply later_derives; apply derives_refl.
-rewrite later_andp; apply andp_derives; auto; apply now_later.
+  intros.
+  eapply semax_pre_simple, H0.
+  rewrite -H; iIntros "? !>"; done.
 Qed.
 
 Lemma PROP_LOCAL_SEP_cons: forall P1 P2 P3 F,
   PROPx P1 (LOCALx P2 (SEPx (F :: P3))) =
-  `F * PROPx P1 (LOCALx P2 (SEPx P3)).
+  (⎡F⎤ ∗ PROPx P1 (LOCALx P2 (SEPx P3))).
 Proof.
-  intros.
-  change (SEPx (F :: P3)) with (`F * SEPx P3).
-  unfold PROPx, LOCALx.
-  unfold_lift; extensionality rho.
-  unfold local, lift1.
-  simpl.
-  apply pred_ext.
-  + normalize.
-    apply andp_right; auto.
-    apply prop_right; auto.
-  + normalize.
-    apply andp_right; auto.
-    apply prop_right; auto.
-Qed.
-
-Lemma semax_frame': forall {Espec: OracleKind}{CS: compspecs},
-  forall Delta P1 P2 P3 s Q1 Q2 Q3 F,
-  @semax CS Espec Delta
+  intros; apply PROP_LOCAL_sep2.
+Qed.
+
+Lemma semax_frame':
+  forall E Delta P1 P2 P3 s Q1 Q2 Q3 F,
+  semax E Delta
     (PROPx P1 (LOCALx P2 (SEPx P3))) s
       (normal_ret_assert (PROPx Q1 (LOCALx Q2 (SEPx Q3)))) ->
-  @semax CS Espec Delta
+  semax E Delta
     (PROPx P1 (LOCALx P2 (SEPx (F :: P3)))) s
       (normal_ret_assert (PROPx Q1 (LOCALx Q2 (SEPx (F :: Q3))))).
 Proof.
   intros.
-  rewrite !PROP_LOCAL_SEP_cons.
-  replace (normal_ret_assert (` F * PROPx Q1 (LOCALx Q2 (SEPx Q3))))
-    with (frame_ret_assert (normal_ret_assert (PROPx Q1 (LOCALx Q2 (SEPx Q3)))) (`F)).
-  + rewrite sepcon_comm.
-    apply semax_frame; auto.
-    hnf. intros; auto.
-  +
-    rewrite frame_normal. f_equal. apply sepcon_comm.
+  eapply semax_proper, semax_frame, H; auto.
+  - rewrite PROP_LOCAL_SEP_cons comm //.
+  - split3; last split; simpl; intros; rewrite ?bi.sep_False //.
+    rewrite PROP_LOCAL_SEP_cons comm //.
+  - hnf; intros; monPred.unseal; done.
 Qed.
 
-Lemma semax_frame'': forall {Espec: OracleKind}{CS: compspecs},
-  forall Delta P1 P2 P3 s t Q1 Q2 Q3 F,
-  @semax CS Espec Delta
+Lemma semax_frame'':
+  forall E Delta P1 P2 P3 s t Q1 Q2 Q3 F,
+  semax E Delta
     (PROPx P1 (LOCALx P2 (SEPx P3))) s
       (frame_ret_assert
         (function_body_ret_assert t (PROPx Q1 (LOCALx Q2 (SEPx Q3)))) emp) ->
-  @semax CS Espec Delta
+  semax E Delta
     (PROPx P1 (LOCALx P2 (SEPx (F :: P3)))) s
       (frame_ret_assert
         (function_body_ret_assert t (PROPx Q1 (LOCALx Q2 (SEPx (F :: Q3))))) emp).
 Proof.
   intros.
-  rewrite !PROP_LOCAL_SEP_cons.
-  replace (frame_ret_assert (function_body_ret_assert t (` F * PROPx Q1 (LOCALx Q2 (SEPx Q3)))) emp)
-    with (frame_ret_assert (frame_ret_assert (function_body_ret_assert t (PROPx Q1 (LOCALx Q2 (SEPx Q3)))) emp) (`F)).
-  + rewrite sepcon_comm.
-    apply semax_frame; auto.
-    hnf. intros; auto.
-  +
-    simpl. f_equal; extensionality; try extensionality; normalize.
-    rewrite sepcon_comm.
-    unfold bind_ret; unfold_lift;
-    destruct x; simpl; normalize.
-    destruct t; simpl; normalize.
-    unfold bind_ret. destruct x;
-    unfold_lift; simpl; normalize.
-    rewrite sepcon_comm; auto.
-    destruct t; simpl; normalize.
-    apply sepcon_comm.
+  eapply semax_proper, semax_frame, H; auto.
+  - rewrite PROP_LOCAL_SEP_cons comm //.
+  - split3; last split; simpl; intros; rewrite ?bi.sep_False ?bi.sep_emp // /=.
+    + destruct t; [| rewrite bi.sep_False //..].
+      split => rho; monPred.unseal.
+      rewrite PROP_LOCAL_SEP_cons comm; monPred.unseal; done.
+    + destruct v; simpl.
+      * rewrite -bi.persistent_and_sep_assoc; f_equiv.
+        split => rho; monPred.unseal.
+        rewrite PROP_LOCAL_SEP_cons comm; monPred.unseal; done.
+      * destruct t; [| rewrite bi.sep_False //..].
+        split => rho; monPred.unseal.
+        rewrite PROP_LOCAL_SEP_cons comm; monPred.unseal; done.
+  - hnf; intros; monPred.unseal; done.
 Qed.
 
 Definition is_void_type (ty: type) : bool :=
@@ -2045,9 +1221,9 @@ Definition is_void_type (ty: type) : bool :=
 Definition ret_tycon (Delta: tycontext): tycontext :=
   mk_tycontext
     (if is_void_type (ret_type Delta)
-      then (PTree.empty _)
-      else (PTree.set ret_temp (ret_type Delta) (PTree.empty _)))
-     (PTree.empty _)
+      then (Maps.PTree.empty _)
+      else (Maps.PTree.set ret_temp (ret_type Delta) (Maps.PTree.empty _)))
+     (Maps.PTree.empty _)
      (ret_type Delta)
      (glob_types Delta)
      (glob_specs Delta)
@@ -2057,85 +1233,58 @@ Lemma tc_environ_Tvoid:
   forall Delta rho, tc_environ Delta rho -> ret_type Delta = Tvoid ->
    tc_environ (ret_tycon Delta) (globals_only rho).
 Proof.
-intros.
+  intros.
   unfold ret_tycon. rewrite H0. simpl is_void_type. cbv beta iota.
   destruct H as [? [? ?]]; split3; auto.
   unfold globals_only; simpl.
-  hnf; intros. rewrite PTree.gempty in H3; inv H3.
+  hnf; intros. setoid_rewrite Maps.PTree.gempty in H3; inv H3.
   simpl.
   clear - H1.
   unfold ret_tycon, var_types.
-  hnf; intros. rewrite PTree.gempty.
+  hnf; intros. setoid_rewrite (Maps.PTree.gempty _ id).
   split; intro. inv H. destruct H as [v ?].
-   unfold ve_of, globals_only, Map.get, Map.empty in H. inv H.
+  unfold ve_of, globals_only, Map.get, Map.empty in H. inv H.
 Qed.
 
 
-Lemma semax_post'': forall R' Espec {cs: compspecs} Delta R P c t,
+Lemma semax_post'': forall R' E Delta R P c t,
            t = ret_type Delta ->
-           ENTAIL ret_tycon Delta, R' |-- R ->
-      @semax cs Espec Delta P c (frame_ret_assert (function_body_ret_assert t R') emp) ->
-      @semax cs Espec Delta P c (frame_ret_assert (function_body_ret_assert t R) emp).
-Proof. intros. eapply semax_post; eauto. subst t. clear - H0. rename H0 into H.
-  intros.
-  all: try solve [intro rho; simpl; normalize].
-  simpl RA_normal.
-  destruct (ret_type Delta) eqn:?H; normalize.
-  simpl; intro rho; unfold_lift.
-  rewrite !sepcon_emp.
-  unfold local, lift1.
-  normalize.
-  pose proof (tc_environ_Tvoid _ _ H1 H0).
-  eapply derives_trans; [ | apply H]. clear H.
-  simpl.
-  normalize. apply andp_right; auto.
-  apply prop_right. auto.
-  intro vl.
-  intro rho; simpl in H0|-*; normalize.
-  clear H1.
-  unfold local, lift1 in *. normalize.
-  subst t. rename H0 into H. rename H1 into H0.
-  assert (H8: typecheck_var_environ (ve_of (globals_only rho))
-               (var_types (ret_tycon Delta))). {
-   clear - H0.
-  unfold ret_tycon, var_types.
-  hnf; intros. rewrite PTree.gempty.
-  split; intro. inv H. destruct H as [v ?].
-   unfold ve_of, globals_only, Map.get, Map.empty in H. inv H.
- }
-  unfold bind_ret.
-  destruct vl; autorewrite with norm1 norm2; normalize.
--
-  unfold_lift.  unfold make_args.
-  specialize (H (env_set (globals_only rho) ret_temp v)).
-  simpl in H.
-  rewrite prop_true_andp in H. auto.
-  clear H.
-  destruct H0 as [? [? ?]]; split3; auto.
-  + unfold te_of, env_set.
-    unfold temp_types, ret_tycon.
-    hnf; intros.
-    destruct (is_void_type (ret_type Delta)).
-    * rewrite PTree.gempty in H3; inv H3.
-    * destruct (ident_eq id ret_temp).
-      2: rewrite PTree.gso in H3 by auto; rewrite PTree.gempty in H3; inv H3.
-      subst id. rewrite PTree.gss in H3. inv H3.
-      rewrite Map.gss. exists v. split; auto.
-      apply tc_val_tc_val'; auto.
--
-  destruct (ret_type Delta) eqn:?; auto.
-  unfold_lift. simpl.
-  specialize (H (globals_only rho)).
-  simpl in H. rewrite prop_true_andp in H; auto.
-  apply tc_environ_Tvoid; auto.
+           ENTAIL ret_tycon Delta, R' ⊢ R ->
+      semax E Delta P c (frame_ret_assert (function_body_ret_assert t R') emp) ->
+      semax E Delta P c (frame_ret_assert (function_body_ret_assert t R) emp).
+Proof.
+  intros. eapply semax_post, H1; simpl; intros; rewrite ?bi.sep_False ?bi.sep_emp ?bi.and_False // /=.
+  + destruct t; [| rewrite bi.and_False //..].
+    split => rho; monPred.unseal.
+    rewrite -H0; monPred.unseal. apply bi.and_mono; last done.
+    apply bi.pure_mono; intros.
+    apply tc_environ_Tvoid; auto.
+  + destruct vl; simpl.
+    * split => rho; monPred.unseal.
+      rewrite -H0; monPred.unseal.
+      iIntros "((% & % & %) & % & $)"; iPureIntro.
+      split; first done; split; last done.
+      split3; simpl; auto.
+      simple_if_tac; intros ??; first done.
+      destruct (eq_dec id ret_temp); last by setoid_rewrite Maps.PTree.gso.
+      subst; setoid_rewrite Maps.PTree.gss; inversion 1; subst.
+      rewrite Map.gss; eexists; split; first done.
+      apply tc_val_tc_val'; done.
+      { split; first done.
+        intros (? & ?); done. }
+    * destruct t; [| rewrite bi.and_False //..].
+      split => rho; monPred.unseal.
+      rewrite -H0; monPred.unseal. apply bi.and_mono; last done.
+      apply bi.pure_mono; intros.
+      apply tc_environ_Tvoid; auto.
 Qed.
 
 Definition ret0_tycon (Delta: tycontext): tycontext :=
-  mk_tycontext (PTree.empty _) (PTree.empty _) (ret_type Delta) (glob_types Delta) (glob_specs Delta) (annotations Delta).
+  mk_tycontext (Maps.PTree.empty _) (Maps.PTree.empty _) (ret_type Delta) (glob_types Delta) (glob_specs Delta) (annotations Delta).
 
 Definition ret1_tycon (Delta: tycontext): tycontext :=
-  mk_tycontext (PTree.set ret_temp (ret_type Delta) (PTree.empty _))
-    (PTree.empty _) (ret_type Delta) (glob_types Delta) (glob_specs Delta) (annotations Delta).
+  mk_tycontext (Maps.PTree.set ret_temp (ret_type Delta) (Maps.PTree.empty _))
+    (Maps.PTree.empty _) (ret_type Delta) (glob_types Delta) (glob_specs Delta) (annotations Delta).
 
 Lemma make_args0_tc_environ: forall rho Delta,
   tc_environ Delta rho ->
@@ -2145,9 +1294,9 @@ Proof.
   destruct H as [? [? ?]].
   split; [| split]; simpl.
   + hnf; intros.
-    rewrite PTree.gempty in H2; inversion H2.
+    setoid_rewrite Maps.PTree.gempty in H2; inversion H2.
   + hnf; split; intros.
-    - rewrite PTree.gempty in H2; inversion H2.
+    - setoid_rewrite Maps.PTree.gempty in H2; inversion H2.
     - destruct H2 as [v ?].
       inversion H2.
   + auto.
@@ -2165,79 +1314,72 @@ Proof.
   split; [| split].
   + hnf; intros.
     unfold ret1_tycon, temp_types in H2.
-    rewrite PTree.gsspec in H2.
+    setoid_rewrite Maps.PTree.gsspec in H2.
     destruct (peq id ret_temp).
     - subst.
       inversion H2; subst.
       exists v; simpl.
       split; auto.
       apply tc_val_tc_val'; auto.
-    - rewrite PTree.gempty in H2; inversion H2.
+    - rewrite Maps.PTree.gempty in H2; inversion H2.
   + hnf; split; intros.
-    - rewrite PTree.gempty in H2; inversion H2.
+    - setoid_rewrite Maps.PTree.gempty in H2; inversion H2.
     - destruct H2 as [v' ?].
       inversion H2.
   + auto.
 Qed.
 
-Lemma semax_post_ret1: forall P' R' Espec {cs: compspecs} Delta P v R Pre c,
+Lemma semax_post_ret1: forall P' R' E Delta P v R Pre c,
   ret_type Delta <> Tvoid ->
   ENTAIL (ret1_tycon Delta),
-    PROPx P' (LOCALx (temp ret_temp v::nil) (SEPx R')) |-- PROPx P (LOCALx (temp ret_temp v::nil) (SEPx R)) ->
-  @semax cs Espec Delta Pre c
+    PROPx P' (LOCALx (temp ret_temp v::nil) (SEPx R')) ⊢ PROPx P (LOCALx (temp ret_temp v::nil) (SEPx R)) ->
+  semax E Delta Pre c
     (frame_ret_assert (function_body_ret_assert (ret_type Delta)
       (PROPx P' (LOCALx (temp ret_temp v::nil) (SEPx R')))) emp) ->
-  @semax cs Espec Delta Pre c
+  semax E Delta Pre c
     (frame_ret_assert (function_body_ret_assert (ret_type Delta)
       (PROPx P (LOCALx (temp ret_temp v::nil) (SEPx R)))) emp).
 Proof.
   intros.
-  eapply semax_post; eauto; try solve [intro rho; simpl; normalize].
-  simpl RA_normal.
-  destruct (ret_type Delta); try congruence; normalize.
-  intros vl rho; simpl. unfold local, lift1.
-  simpl; rewrite !sepcon_emp.
-  unfold bind_ret; unfold_lift; destruct vl; [| destruct (ret_type Delta) eqn:?H]; simpl; normalize ; try congruence.
-  eapply derives_trans; [| apply (H0 _)].
-    Opaque PTree.set. simpl; apply andp_right; auto. Transparent PTree.set.
-    apply prop_right.
-    apply make_args1_tc_environ; auto.
-Qed.
-
-Lemma semax_post_ret0: forall P' R' Espec {cs: compspecs} Delta P R Pre c,
+  eapply semax_post, H1; simpl; intros; rewrite ?bi.sep_emp; try solve [rewrite bi.and_elim_r //].
+  - destruct (ret_type Delta); [| rewrite bi.and_elim_r //..].
+    split => rho; monPred.unseal.
+    rewrite -H0; monPred.unseal; done.
+  - destruct vl; simpl.
+    + split => rho; monPred.unseal.
+      rewrite -H0; monPred.unseal.
+      iIntros "(% & % & $)"; iPureIntro.
+      split; first done; split; last done.
+      apply make_args1_tc_environ; auto.
+    + destruct (ret_type Delta); [done | rewrite bi.and_elim_r //..].
+Qed.
+
+Lemma semax_post_ret0: forall P' R' E Delta P R Pre c,
   ret_type Delta = Tvoid ->
   ENTAIL (ret0_tycon Delta),
-    PROPx P' (LOCALx nil (SEPx R')) |-- PROPx P (LOCALx nil (SEPx R)) ->
-  @semax cs Espec Delta Pre c
+    PROPx P' (LOCALx nil (SEPx R')) ⊢ PROPx P (LOCALx nil (SEPx R)) ->
+  semax E Delta Pre c
     (frame_ret_assert (function_body_ret_assert (ret_type Delta)
       (PROPx P' (LOCALx nil (SEPx R')))) emp) ->
-  @semax cs Espec Delta Pre c
+  semax E Delta Pre c
     (frame_ret_assert (function_body_ret_assert (ret_type Delta)
       (PROPx P (LOCALx nil (SEPx R)))) emp).
 Proof.
   intros.
-  eapply semax_post; eauto; try solve [intro rho; simpl; normalize].
-  intros.
-  intro rho; unfold frame_ret_assert, function_body_ret_assert; normalize.
-  simpl; rewrite ?sepcon_emp. unfold local, lift1.
-  rewrite H.
-  unfold_lift.
-  normalize.
-  eapply derives_trans; [ | apply H0].
-  simpl.
-  apply andp_right; auto.
-  apply prop_right.
-    apply make_args0_tc_environ; auto.
-  unfold bind_ret; unfold_lift; destruct vl; [| destruct (ret_type Delta) eqn:?H]; simpl; normalize.
-  + rewrite H in H2.
-    inversion H2.
-  + intro rho.
-      unfold_lift; simpl.
-     eapply derives_trans; [| apply (H0 _)].
-     simpl.
-     apply andp_derives; auto.
-    apply prop_derives; intros.
+  eapply semax_post, H1; simpl; intros; rewrite ?bi.sep_emp; try solve [rewrite bi.and_elim_r //].
+  - destruct (ret_type Delta); [| rewrite bi.and_elim_r //..].
+    split => rho; monPred.unseal.
+    rewrite -H0; monPred.unseal.
+    apply bi.and_mono; last done.
+    apply bi.pure_mono; intros.
     apply make_args0_tc_environ; auto.
+  - rewrite H; destruct vl; simpl.
+    + iIntros "(_ & [] & _)".
+    + split => rho; monPred.unseal.
+      rewrite -H0; monPred.unseal.
+      apply bi.and_mono; last done.
+      apply bi.pure_mono; intros.
+      apply make_args0_tc_environ; auto.
 Qed.
 
 Inductive return_outer_gen: ret_assert -> ret_assert -> Prop :=
@@ -2274,9 +1416,9 @@ Proof.
   destruct P3; auto.
 Qed.
 
-Inductive return_inner_gen (S: list mpred): option val -> (environ -> mpred) -> (environ -> mpred) -> Prop :=
+Inductive return_inner_gen (S: list mpred): option val -> (assert) -> (assert) -> Prop :=
 | return_inner_gen_main: forall ov_gen P u,
-    return_inner_gen S ov_gen (main_post P u) (PROPx nil (LOCALx nil (SEPx (TT :: S))))
+    return_inner_gen S ov_gen (main_post P u) (PROPx nil (LOCALx nil (SEPx (True :: S))))
 | return_inner_gen_canon_nil':
     forall ov_gen P R,
       return_inner_gen S ov_gen
@@ -2288,13 +1430,13 @@ Inductive return_inner_gen (S: list mpred): option val -> (environ -> mpred) ->
         (PROPx P (LOCALx (temp ret_temp v :: nil) (SEPx R)))
         (PROPx (P ++ (v_gen = v) :: nil) (LOCALx nil (SEPx (R ++ S))))
 | return_inner_gen_EX':
-    forall ov_gen (A: Type) (post1 post2: A -> environ -> mpred),
+    forall ov_gen (A: Type) (post1 post2: A -> assert),
       (forall a: A, return_inner_gen S ov_gen (post1 a) (post2 a)) ->
-      return_inner_gen S ov_gen (exp post1) (exp post2).
+      return_inner_gen S ov_gen (∃ x, post1 x) (∃ x, post2 x).
 
 Lemma return_inner_gen_EX: forall S ov_gen A post1 post2,
   (forall a: A, exists P, return_inner_gen S ov_gen (post1 a) P /\ post2 a = P) ->
-  return_inner_gen S ov_gen (exp post1) (exp post2).
+  return_inner_gen S ov_gen (∃ x, post1 x) (∃ x, post2 x).
 Proof.
   intros.
   apply return_inner_gen_EX'.
@@ -2323,304 +1465,219 @@ Qed.
 
 Lemma return_inner_gen_None_spec: forall S post1 post2,
   return_inner_gen S None post1 post2 ->
-  post2 |-- (fun rho => post1 (make_args nil nil rho)) * SEPx S.
+  post2 ⊢ assert_of (fun rho => post1 (make_args nil nil rho)) ∗ SEPx S.
 Proof.
   intros.
   remember None eqn:?H.
   revert H0; induction H; intros; subst.
   + unfold main_post.
-    go_lowerx.
-  + rewrite gather_SEP.
-    go_lowerx.
+    split => rho; rewrite /PROPx /LOCALx /SEPx; monPred.unseal; simpl.
+    rewrite !bi.and_elim_r //.
+  + rewrite /PROPx /LOCALx /SEPx fold_right_sepcon_app embed_sep.
+    split => rho; monPred.unseal.
+    iIntros "($ & $ & $ & $)".
   + inversion H0.
-  + apply exp_left; intro a.
-    apply (derives_trans _ _ _ (H0 a eq_refl)).
-    intro rho.
-    simpl.
-    apply sepcon_derives; auto.
-    apply (exp_right a); auto.
+  + iIntros "(%a & ?)".
+    iDestruct (H0 with "[$]") as "(? & $)"; first done.
+    iStopProof; split => rho; monPred.unseal; eauto.
 Qed.
 
 Lemma return_inner_gen_Some_spec: forall S v_gen post1 post2,
   v_gen <> Vundef ->
   return_inner_gen S (Some v_gen) post1 post2 ->
-  post2 |-- (fun rho => post1 (make_args (ret_temp :: nil) (v_gen :: nil) rho)) * SEPx S.
+  post2 ⊢ assert_of (fun rho => post1 (make_args (ret_temp :: nil) (v_gen :: nil) rho)) ∗ SEPx S.
 Proof.
   intros.
   remember (Some v_gen) eqn:?H.
   revert v_gen H H1; induction H0; intros; subst.
   + unfold main_post.
-    go_lowerx.
-  + rewrite gather_SEP.
-    go_lowerx.
+    split => rho; rewrite /PROPx /LOCALx /SEPx; monPred.unseal; simpl.
+    rewrite !bi.and_elim_r //.
+  + rewrite /PROPx /LOCALx /SEPx fold_right_sepcon_app embed_sep.
+    split => rho; monPred.unseal.
+    iIntros "($ & $ & $ & $)".
   + erewrite PROPx_Permutation by apply Permutation_app_comm.
-    rewrite gather_SEP.
-    go_lowerx.
-    unfold_lift.
-    apply sepcon_derives; auto.
-    apply andp_right; auto.
-    apply prop_right; split; auto.
-    subst.
-    inversion H1.
-    unfold globals_only, eval_id, env_set, te_of.
-    rewrite Map.gss; auto.
-    apply derives_refl.
-  + apply exp_left; intro a.
-    apply (derives_trans _ _ _ (H0 a _ H1 eq_refl)).
-    intro rho.
-    simpl.
-    apply sepcon_derives; auto.
-    apply (exp_right a); auto.
-Qed.
-
-Lemma semax_return_None: forall {cs Espec} Delta Ppre Qpre Rpre Post1 sf SEPsf post2 post3,
+    rewrite gather_SEP PROP_LOCAL_sep1; apply bi.sep_mono; last done.
+    rewrite /PROPx /LOCALx /SEPx; split => rho; monPred.unseal.
+    rewrite fold_right_sepcon_eq.
+    iIntros "((% & $) & _ & $ & _)"; inv H1.
+    iPureIntro; unfold_lift.
+    rewrite eval_id_same //.
+  + iIntros "(% & H)".
+    rewrite H0 //.
+    iDestruct "H" as "(? & $)"; iStopProof; split => rho; monPred.unseal; eauto.
+Qed.
+
+Lemma semax_return_None: forall E Delta Ppre Qpre Rpre Post1 sf SEPsf post2 post3,
   ret_type Delta = Tvoid ->
   return_outer_gen Post1 (frame_ret_assert (function_body_ret_assert (ret_type Delta) post2) sf) ->
-  ENTAIL Delta, PROPx Ppre (LOCALx Qpre (SEPx SEPsf)) |-- sf ->
+  ENTAIL Delta, PROPx Ppre (LOCALx Qpre (SEPx SEPsf)) ⊢ sf ->
   return_inner_gen SEPsf None post2 post3 ->
-  ENTAIL Delta, PROPx Ppre (LOCALx Qpre (SEPx Rpre)) |-- post3 ->
-  @semax cs Espec Delta (PROPx Ppre (LOCALx Qpre (SEPx Rpre))) (Sreturn None) Post1.
+  ENTAIL Delta, PROPx Ppre (LOCALx Qpre (SEPx Rpre)) ⊢ post3 ->
+  semax E Delta (PROPx Ppre (LOCALx Qpre (SEPx Rpre))) (Sreturn None) Post1.
 Proof.
   intros.
-  eapply semax_pre; [| apply semax_return].
+  eapply semax_pre, semax_return.
   apply return_outer_gen_spec in H0.
   rewrite H0; clear Post1 H0.
   apply return_inner_gen_None_spec in H2.
-  apply andp_right.
-  + unfold tc_expropt.
-    unfold_lift; intros rho; apply prop_right; auto.
-  + unfold cast_expropt, id.
-    apply (derives_trans _ _ _ H3) in H2; clear H3.
-    revert H1 H2; unfold PROPx, LOCALx, SEPx, local, lift1; unfold_lift.
-    simpl; intros ? ? rho.
-    specialize (H1 rho); specialize (H2 rho).
-    normalize.
-    normalize in H1.
-    normalize in H2.
-    eapply derives_trans; [exact H2 |].
-    eapply derives_trans; [apply sepcon_derives; [apply derives_refl | apply H1] |].
-    unfold frame_ret_assert, function_body_ret_assert, bind_ret, make_args.
-    rewrite H.
-    unfold_lift; simpl.
-    auto.
-Qed.
-
-Lemma semax_return_Some: forall {cs Espec} Delta Ppre Qpre Rpre Post1 sf SEPsf post2 post3 ret v_gen,
-  ENTAIL Delta, PROPx Ppre (LOCALx Qpre (SEPx Rpre)) |-- local (`(eq v_gen) (eval_expr (Ecast ret (ret_type Delta)))) ->
-  ENTAIL Delta, PROPx Ppre (LOCALx Qpre (SEPx Rpre)) |-- tc_expr Delta (Ecast ret (ret_type Delta)) ->
+  apply bi.and_intro; auto.
+  unfold cast_expropt, id; simpl.
+  iIntros "(#? & #? & #? & ?)".
+  iPoseProof (H3 with "[-]") as "H".
+  { rewrite /PROPx /LOCALx; iFrame; auto. }
+  rewrite H2.
+  iDestruct "H" as "(? & sf)".
+  iPoseProof (H1 with "[sf]") as "sf".
+  { rewrite /PROPx /LOCALx; iFrame; auto. }
+  rewrite /bind_ret H; unfold_lift.
+  iClear "#"; iStopProof; split => rho; monPred.unseal; done.
+Qed.
+
+Local Arguments typecheck_expr : simpl never.
+
+Lemma semax_return_Some: forall E Delta Ppre Qpre Rpre Post1 sf SEPsf post2 post3 ret v_gen,
+  ENTAIL Delta, PROPx Ppre (LOCALx Qpre (SEPx Rpre)) ⊢ local (`(eq v_gen) (eval_expr (Ecast ret (ret_type Delta)))) ->
+  ENTAIL Delta, PROPx Ppre (LOCALx Qpre (SEPx Rpre)) ⊢ tc_expr Delta (Ecast ret (ret_type Delta)) ->
   return_outer_gen Post1 (frame_ret_assert (function_body_ret_assert (ret_type Delta) post2) sf) ->
-  ENTAIL Delta, PROPx Ppre (LOCALx Qpre (SEPx SEPsf)) |-- sf ->
+  ENTAIL Delta, PROPx Ppre (LOCALx Qpre (SEPx SEPsf)) ⊢ sf ->
   return_inner_gen SEPsf (Some v_gen) post2 post3 ->
-  ENTAIL Delta, PROPx Ppre (LOCALx Qpre (SEPx Rpre)) |-- post3 ->
-  @semax cs Espec Delta (PROPx Ppre (LOCALx Qpre (SEPx Rpre))) (Sreturn (Some ret)) Post1.
+  ENTAIL Delta, PROPx Ppre (LOCALx Qpre (SEPx Rpre)) ⊢ post3 ->
+  semax E Delta (PROPx Ppre (LOCALx Qpre (SEPx Rpre))) (Sreturn (Some ret)) Post1.
 Proof.
   intros.
-  eapply semax_pre; [| apply semax_return].
+  eapply semax_pre, semax_return.
   apply return_outer_gen_spec in H1.
   rewrite H1; clear Post1 H1.
-  apply andp_right; [exact H0 |].
+  apply bi.and_intro; [exact H0 |].
+  eapply bi.pure_elim.
+  { rewrite (add_andp _ _ H) (add_andp _ _ H0).
+    split => rho; rewrite /local /lift1; monPred.unseal.
+    rewrite -!assoc; iIntros "(% & H)".
+    setoid_rewrite typecheck_expr_sound; simpl; last done.
+    unfold_lift.
+    iDestruct "H" as "(? & %Ht & %Hv)"; rewrite -Hv in Ht.
+    iPureIntro; exact Ht. }
+  intros Ht.
   destruct (Val.eq v_gen Vundef).
-  {
-    subst.
-    rewrite (add_andp _ _ H), (add_andp _ _ H0).
-    rewrite (andp_comm _ (PROPx _ _)), !andp_assoc.
-    apply andp_left2.
-    go_lowerx.
-    eapply derives_trans; [apply typecheck_expr_sound; auto |].
-    simpl.
-    rewrite <- H5.
-    apply (derives_trans _ FF); [| normalize].
-    apply prop_derives.
-    apply tc_val_Vundef.
-  }
+  { subst; apply tc_val_Vundef in Ht; done. }
   apply return_inner_gen_Some_spec in H3; [| auto].
-  assert (ENTAIL Delta, PROPx Ppre (LOCALx Qpre (SEPx Rpre))
-            |-- ` (RA_return (frame_ret_assert (function_body_ret_assert (ret_type Delta) post2) sf) (Some v_gen)) id).
-  + unfold frame_ret_assert, function_body_ret_assert, bind_ret, cast_expropt.
-    apply (derives_trans _ _ _ H4) in H3; clear H4.
-    revert H H0 H2 H3.
-    unfold PROPx, LOCALx, SEPx, local, lift1; unfold_lift.
-    simpl; intros ? ? ? ? rho.
-    specialize (H rho); specialize (H0 rho).
-    specialize (H2 rho); specialize (H3 rho).
-    normalize.
-    normalize in H.
-    normalize in H0.
-    normalize in H2.
-    normalize in H3.
-    rewrite (add_andp _ _ H); normalize; clear H.
-    apply andp_right.
-    - apply (derives_trans _ _ _ H0).
-      eapply derives_trans; [apply typecheck_expr_sound; auto |].
-      unfold_lift; apply derives_refl.
-    - apply (derives_trans _ _ _ H3).
-      eapply derives_trans; [apply sepcon_derives; [apply derives_refl | apply H2] |].
-      apply derives_refl.
-  + rewrite (add_andp _ _ H1), (add_andp _ _ H).
-    rewrite (andp_comm _ (PROPx _ _)), !andp_assoc.
-    apply andp_left2.
-    go_lowerx.
-    subst.
-    unfold id.
-    normalize.
-Qed.
-
-Lemma remove_PROP_LOCAL_left: forall P Q R S, (R |-- S) -> PROPx P (LOCALx Q R) |-- S.
-Proof.
-  intros.
-  go_lowerx.
-  normalize.
+  unfold frame_ret_assert, function_body_ret_assert, bind_ret, cast_expropt; simpl.
+  iIntros "(#? & #? & #? & ?)".
+  iPoseProof (H with "[-]") as "#?".
+  { rewrite /PROPx /LOCALx; iFrame; auto. }
+  iPoseProof (H4 with "[-]") as "H".
+  { rewrite /PROPx /LOCALx; iFrame; auto. }
+  rewrite H3.
+  iDestruct "H" as "(? & sf)".
+  iPoseProof (H2 with "[sf]") as "?".
+  { rewrite /PROPx /LOCALx; iFrame; auto. }
+  iStopProof; rewrite /local /lift1; split => rho; monPred.unseal. rewrite monPred_at_intuitionistically /=.
+  unfold_lift; simpl.
+  iIntros "((% & % & % & %) & ? & $)"; subst; iSplit; done.
+Qed.
+
+Lemma remove_PROP_LOCAL_left: forall P Q R S, (R ⊢ S) -> PROPx P (LOCALx Q R) ⊢ S.
+Proof.
+  intros.
+  rewrite /PROPx /LOCALx H !bi.and_elim_r //.
 Qed.
 
 Lemma remove_PROP_LOCAL_left':
-     forall P Q R S, (`R |-- S) ->
-     PROPx P (LOCALx Q (SEPx (R::nil))) |-- S.
+     forall P Q R S, (⎡R⎤ ⊢ S) ->
+     PROPx P (LOCALx Q (SEPx (R::nil))) ⊢ S.
 Proof.
   intros.
-  go_lowerx.
-  normalize. apply H.
+  rewrite /PROPx /LOCALx /SEPx /= bi.sep_emp H !bi.and_elim_r //.
+Qed.
+
+Lemma replace_nth_sepcon : forall n R (Rn : mpred), nth_error R n = Some Rn ->
+  fold_right_sepcon R = (Rn ∗ fold_right_sepcon (replace_nth n R emp)).
+Proof.
+  induction n; destruct R; simpl; try done.
+  - inversion 1; rewrite emp_sep //.
+  - intros; erewrite IHn by done.
+    rewrite !sep_assoc (sep_comm m) //.
 Qed.
 
 Lemma SEP_nth_isolate {A}:
   forall n R Rn, nth_error R n = Some Rn ->
-      @SEPx A R = SEPx (Rn :: replace_nth n R emp).
-Proof.
- unfold SEPx.
- intros. extensionality rho.
- revert R H;
- induction n; destruct R; intros; inv H.
- simpl; rewrite emp_sepcon; auto.
- unfold replace_nth; fold @replace_nth.
- transitivity (m * fold_right_sepcon R).
- reflexivity.
- rewrite (IHn R H1).
- simpl.
- rewrite <- sepcon_assoc.
- rewrite (sepcon_comm Rn).
- simpl.
- repeat rewrite sepcon_assoc.
- f_equal. rewrite sepcon_comm; reflexivity.
+      @SEPx A Σ R = SEPx (Rn :: replace_nth n R emp).
+Proof.
+  intros; unfold SEPx.
+  f_equiv; simpl.
+  apply replace_nth_sepcon; done.
 Qed.
 
 Lemma nth_error_SEP_sepcon_TT: forall P Q R n Rn S,
-  (PROPx P (LOCALx Q (SEPx (Rn :: nil))) |-- S) ->
+  (PROPx P (LOCALx Q (SEPx (Rn :: nil))) ⊢ S) ->
   nth_error R n = Some Rn ->
-  PROPx P (LOCALx Q (SEPx R)) |-- S * TT.
+  PROPx P (LOCALx Q (SEPx R)) ⊢ S ∗ True.
 Proof.
   intros.
   erewrite SEP_nth_isolate by eauto.
-  unfold PROPx, LOCALx, SEPx in *.
-  unfold local, lift1 in H |- *.
-  unfold_lift in H.
-  unfold_lift.
-  simpl in H |- *.
-  intros rho.
-  specialize (H rho).
-  rewrite <- !andp_assoc in H |- *.
-  rewrite <- !prop_and in H |- *.
-  rewrite sepcon_emp in H.
-  rewrite <- sepcon_andp_prop'.
-  apply sepcon_derives.
-  exact H.
-  apply prop_right.
-  auto.
+  rewrite PROP_LOCAL_sep1 H.
+  apply bi.sep_mono; auto.
 Qed.
 
 Lemma SEP_replace_nth_isolate {A}:
   forall n R Rn Rn',
        nth_error R n = Some Rn ->
-      @SEPx A (replace_nth n R Rn') = SEPx (Rn' :: replace_nth n R emp).
-Proof.
- unfold SEPx.
- intros.
- extensionality rho.
- revert R H.
- induction n; destruct R; intros; inv H; intros.
- simpl; rewrite emp_sepcon; auto.
- unfold replace_nth; fold @replace_nth.
- transitivity (m * fold_right_sepcon (replace_nth n R Rn')).
- reflexivity.
- rewrite (IHn R H1). clear IHn.
- simpl.
- repeat rewrite <- sepcon_assoc.
- rewrite (sepcon_comm Rn').
- rewrite sepcon_assoc.
- reflexivity.
+      @SEPx A Σ (replace_nth n R Rn') = SEPx (Rn' :: replace_nth n R emp).
+Proof.
+  intros; unfold SEPx.
+  f_equiv; simpl.
+  erewrite replace_nth_sepcon; last by eapply nth_error_replace_nth.
+  rewrite replace_nth_replace_nth //.
 Qed.
 
 Lemma local_andp_lemma:
-  forall P Q, (P |-- local Q) -> P = local Q && P.
+  forall P Q, (P ⊢ local Q) -> P ⊣⊢ (local Q ∧ P).
 Proof.
-intros.
-apply pred_ext.
-apply andp_right; auto.
-apply andp_left2; auto.
+  intros; rewrite comm; apply add_andp; done.
 Qed.
 
-Lemma SEP_TT_right:
-  forall R, R |-- SEPx(TT::nil).
-Proof. intros. go_lowerx. rewrite sepcon_emp. apply TT_right.
-Qed.
+Lemma SEP_TT_right {A}:
+  forall R, R ⊢ @SEPx A Σ (True::nil).
+Proof. intros; rewrite /SEPx /= bi.sep_emp embed_pure; auto. Qed.
 
-Lemma replace_nth_SEP: forall P Q R n Rn Rn', (Rn |-- Rn') -> PROPx P (LOCALx Q (SEPx (replace_nth n R Rn))) |-- PROPx P (LOCALx Q (SEPx (replace_nth n R Rn'))).
+Lemma replace_nth_SEP: forall P Q R n Rn Rn', (Rn ⊢ Rn') -> PROPx P (LOCALx Q (SEPx (replace_nth n R Rn))) ⊢ PROPx P (LOCALx Q (SEPx (replace_nth n R Rn'))).
 Proof.
-  simpl.
   intros.
-  normalize.
-  autorewrite with subst norm1 norm2; normalize.
-  apply andp_right; [apply prop_right; auto | auto].
-  unfold_lift.
-  revert R.
-  induction n.
-  + destruct R.
-    - simpl. auto.
-    - simpl. cancel.
-  + destruct R.
-    - simpl. cancel.
-    - intros. simpl in *. cancel.
+  apply bi.and_mono; first done.
+  apply bi.and_mono; first done.
+  rewrite /SEPx; apply embed_mono.
+  revert R; induction n; destruct R; simpl; auto.
+  - rewrite H //.
+  - rewrite IHn //.
 Qed.
 
 Lemma replace_nth_SEP':
-  forall A P Q R n Rn Rn', (local A && PROPx P (LOCALx Q (SEPx (Rn::nil))) |-- `Rn') ->
-  (local A && PROPx P (LOCALx Q (SEPx (replace_nth n R Rn)))) |-- (PROPx P (LOCALx Q (SEPx (replace_nth n R Rn')))).
-Proof.
-  simpl. unfold local, lift1.
-  intros.
-  specialize (H x).
-  normalize. rewrite prop_true_andp in H by auto. clear H0.
-      autorewrite with subst norm1 norm2; normalize.
-    autorewrite with subst norm1 norm2 in H; normalize in H.
-  apply andp_right; [apply prop_right; auto | auto].
-  unfold_lift.
-  revert R.
-  induction n.
-  + destruct R.
-    - simpl. cancel.
-    - simpl. cancel.
-  + destruct R.
-    - simpl. cancel.
-    - intros. simpl in *. cancel.
+  forall A P Q R n Rn Rn', (local A ∧ PROPx P (LOCALx Q (SEPx (Rn::nil))) ⊢ ⎡Rn'⎤) ->
+  (local A ∧ PROPx P (LOCALx Q (SEPx (replace_nth n R Rn)))) ⊢ (PROPx P (LOCALx Q (SEPx (replace_nth n R Rn')))).
+Proof.
+  intros.
+  iIntros "(#? & #? & #? & H)"; iSplit; first done; iSplit; first done.
+  rewrite /SEPx; iInduction n as [|] "IH" forall (R); destruct R; simpl; try done.
+  - rewrite !embed_sep.
+    iDestruct "H" as "(? & $)".
+    iApply H.
+    rewrite /SEPx /= bi.sep_emp; iFrame; auto.
+  - rewrite !embed_sep.
+    iDestruct "H" as "($ & ?)".
+    by iApply "IH".
 Qed.
 
 Lemma nth_error_SEP_prop:
   forall P Q R n (Rn: mpred) (Rn': Prop),
     nth_error R n = Some Rn ->
-    (Rn |-- !! Rn') ->
-    PROPx P (LOCALx Q (SEPx R)) |-- !! Rn'.
+    (Rn ⊢ ⌜Rn'⌝) ->
+    PROPx P (LOCALx Q (SEPx R)) ⊢ ⌜Rn'⌝.
 Proof.
   intros.
-  apply andp_left2.
-  apply andp_left2.
-  unfold SEPx.
-  hnf; simpl; intros _.
-  revert R H; induction n; intros; destruct R; inv H.
-  + simpl.
-    rewrite (add_andp _ _ H0).
-    normalize.
-  + apply IHn in H2.
-    simpl.
-    rewrite (add_andp _ _ H2).
-    normalize.
+  erewrite SEP_nth_isolate by done.
+  rewrite /PROPx /LOCALx /SEPx /= embed_sep H0 embed_pure.
+  iIntros "(_ & _ & $ & _)".
 Qed.
 
 Lemma LOCAL_2_hd: forall P Q R Q1 Q2,
@@ -2628,16 +1685,10 @@ Lemma LOCAL_2_hd: forall P Q R Q1 Q2,
   (PROPx P (LOCALx (Q2 :: Q1 :: Q) (SEPx R))).
 Proof.
   intros.
-  extensionality.
-  apply pred_ext; normalize;
-  autorewrite with subst norm1 norm2; normalize;
-  (apply andp_right; [apply prop_right; auto | auto]);
-  unfold_lift;
-  unfold_lift in H0;
-  split; simpl in *; tauto.
+  erewrite LOCALx_Permutation by constructor; done.
 Qed.
 
-Lemma lvar_eval_lvar {cs: compspecs}:
+Lemma lvar_eval_lvar:
   forall i t v rho, locald_denote (lvar i t v) rho -> eval_lvar i t rho = v.
 Proof.
 unfold eval_lvar; intros. hnf in H.
@@ -2655,7 +1706,7 @@ destruct H; subst. rewrite eqb_type_refl; auto.
 Qed.
 
 Lemma gvars_eval_var:
- forall Delta gv i rho t, tc_environ Delta rho -> (var_types Delta) ! i = None -> locald_denote (gvars gv) rho -> eval_var i t rho = gv i.
+ forall Delta gv i rho t, tc_environ Delta rho -> (var_types Delta) !! i = None -> locald_denote (gvars gv) rho -> eval_var i t rho = gv i.
 Proof.
 intros.
 unfold eval_var. hnf in H1. subst.
@@ -2674,7 +1725,7 @@ destruct H; subst; apply Coq.Init.Logic.I.
 Qed.
 
 Lemma gvars_isptr:
-  forall Delta gv i rho t, tc_environ Delta rho -> (glob_types Delta) ! i = Some t -> locald_denote (gvars gv) rho -> isptr (gv i).
+  forall Delta gv i rho t, tc_environ Delta rho -> (glob_types Delta) !! i = Some t -> locald_denote (gvars gv) rho -> isptr (gv i).
 Proof.
 intros. hnf in H1.
 subst.
@@ -2692,279 +1743,396 @@ erewrite lvar_eval_var; eauto.
 eapply lvar_isptr; eauto.
 Qed.
 
-Lemma PARAMSx_args_super_non_expansive: forall A Q R,
-  args_super_non_expansive R ->
-  (forall n ts x, Q ts x = Q ts (functors.MixVariantFunctor.fmap _ (compcert_rmaps.RML.R.approx n) (compcert_rmaps.RML.R.approx n) x)) ->
-  @args_super_non_expansive A (fun ts a ae => PARAMSx (Q ts a) (R ts a) ae).
-Proof. intros. simpl in *.
-  hnf; intros.
-  unfold PARAMSx.
-  simpl.
-  rewrite !approx_andp.
-  f_equal; auto.
-  f_equal; f_equal; f_equal.
-  apply H0.
-Qed.
-
-Lemma GLOBALSx_args_super_non_expansive: forall A G R,
-  args_super_non_expansive R ->
-  @super_non_expansive_list A (fun ts a rho => map (fun Q0 => prop (locald_denote (gvars Q0) rho)) (G ts a)) ->
-  @args_super_non_expansive A (fun ts a ae => GLOBALSx (G ts a) (R ts a) ae).
-Proof.
-  intros. simpl in *.
-  hnf; intros.
-  unfold GLOBALSx, LOCALx. simpl. rewrite ! approx_andp. f_equal; [|apply H].
-  specialize (H0 n ts x (Clight_seplog.mkEnv (fst gargs) nil nil)).
-  simpl in H0.
-  match goal with H : Forall2 _ _ (map _ ?l) |- _ => forget l as Q1 end.
-  generalize dependent Q1; induction (G ts x); intros; inv H0; destruct Q1; try discriminate.
-  + auto.
-  + inv H3.
-    simpl.
-    unfold local, lift1 in IHl |- *.
-    unfold_lift in IHl; unfold_lift.
-    rewrite !prop_and.
-    rewrite !approx_andp.
-    f_equal; auto.
-Qed.
-
-Lemma PROP_PARAMS_GLOBALS_SEP_args_super_non_expansive: forall A P Q G R
-  (HypP: Forall (fun P0 => @args_super_non_expansive A (fun ts a _ => prop (P0 ts a))) P)
-  (HypQ: forall n ts x, Q ts x = Q ts (functors.MixVariantFunctor.fmap _ (compcert_rmaps.RML.R.approx n) (compcert_rmaps.RML.R.approx n) x))
-  (HypG: @super_non_expansive_list A (fun ts a rho => map (fun Q0 => prop (locald_denote (gvars Q0) rho)) (G ts a)))
-  (HypR: Forall (fun R0 => @args_super_non_expansive A (fun ts a _ => R0 ts a)) R),
-  @args_super_non_expansive A (fun ts a =>
-    PROPx (map (fun P0 => P0 ts a) P)
-       (PARAMSx (Q ts a)
-         (GLOBALSx (G ts a) (SEPx (map (fun R0 => R0 ts a) R))))).
-Proof. intros. simpl.
- apply (PROPx_args_super_non_expansive A P) ; [ clear P HypP| apply HypP].
-  apply (PARAMSx_args_super_non_expansive A Q); [|apply HypQ].
-  apply (GLOBALSx_args_super_non_expansive A G); [|apply HypG].
-  apply (SEPx_args_super_non_expansive A R); apply HypR.
-Qed.
-
-Lemma super_non_expansive_args_super_non_expansive {A P}
-      (H: @super_non_expansive A (fun ts a _ => P ts a)):
-      @args_super_non_expansive A (fun ts a _ => P ts a).
-Proof. red; intros. apply H. apply any_environ. Qed.
-
-Lemma PROPx_args_super_non_expansive': forall A P Q,
-  args_super_non_expansive Q ->
-  @super_non_expansive_list A (fun ts a _ => map prop (P ts a)) ->
-  @args_super_non_expansive A (fun ts a => PROPx (P ts a) (Q ts a)).
-Proof.
-  intros.
-  hnf; intros.
-  unfold PROPx.
-  simpl.
-  rewrite !approx_andp.
-  f_equal; auto.
-  specialize (H0 n ts x any_environ).
-  simpl in H0.
-  match goal with H : Forall2 _ _ (map _ ?l) |- _ => forget l as P1 end.
-  generalize dependent P1; induction (P ts x); intros; inv H0; destruct P1; try discriminate.
-  + auto.
-  + inv H3.
-    simpl.
-    rewrite !prop_and.
-    rewrite !approx_andp.
-    f_equal; auto.
-Qed.
-
-Lemma SEPx_args_super_non_expansive': forall A R ,
-  @super_non_expansive_list A (fun ts a _ => R ts a) ->
-  @args_super_non_expansive A (fun ts a ae => SEPx (R ts a) ae).
-Proof.
-  intros.
-  hnf; intros.
-  unfold SEPx; unfold super_non_expansive_list in H.
-  specialize (H n ts x any_environ).
-  induction H.
-  + simpl; auto.
-  + simpl in *.
-    rewrite !approx_sepcon.
-    f_equal;
-    auto.
-Qed.
-
-Lemma PROP_PARAMS_GLOBALS_SEP_args_super_non_expansive': forall A P Q G R
-  (HypP: @super_non_expansive_list A (fun ts a _ => map prop (P ts a)))
-  (HypQ: forall n ts x, Q ts x = Q ts (functors.MixVariantFunctor.fmap _ (compcert_rmaps.RML.R.approx n) (compcert_rmaps.RML.R.approx n) x))
-  (HypG: @super_non_expansive_list A (fun ts a rho => map (fun Q0 => prop (locald_denote (gvars Q0) rho)) (G ts a)))
-  (HypR: @super_non_expansive_list A (fun ts a _ => R ts a)),
-  @args_super_non_expansive A (fun ts a =>
-    PROPx (P ts a)
-       (PARAMSx (Q ts a)
-         (GLOBALSx (G ts a) (SEPx (R ts a))))).
-Proof. intros.
-  apply PROPx_args_super_non_expansive'; [|auto].
-  apply PARAMSx_args_super_non_expansive; [|auto].
-  apply GLOBALSx_args_super_non_expansive; [|auto].
-  apply SEPx_args_super_non_expansive'; auto.
-Qed.
-
-Lemma PARAMSx_super_non_expansive: forall A Q R,
-  super_non_expansive R ->
-  @super_non_expansive A (fun ts a rho => PARAMSx Q (fun ae:argsEnviron => R ts a rho) (ge_of rho, nil)).
-Proof. intros. simpl in *.
-  hnf; intros.
-  unfold PARAMSx.
-  simpl.
-  rewrite !approx_andp.
-  f_equal; auto.
-Qed.
-
-Lemma GLOBALSx_super_non_expansive: forall A G R,
-  super_non_expansive R ->
-  @super_non_expansive A (fun ts a rho => GLOBALSx G (fun ae : argsEnviron => let (g, _) := ae in !! gvars_denote (initialize.globals_of_genv g) rho && R ts a rho)
-  (Map.empty block, nil)).
-Proof.
-  intros. simpl in *.
-  hnf; intros.
-  unfold GLOBALSx, LOCALx, argsassert2assert, Clight_seplog.mkEnv.
-  simpl. rewrite ! approx_andp. f_equal. f_equal. apply H.
-Qed.
-
-Lemma PROP_PARAMS_GLOBALS_SEP_super_non_expansive: forall A P (Q:list val)(G : list globals) R
-  (HypP: Forall (fun P0 => @super_non_expansive A (fun ts a _ => prop (P0 ts a))) P)
-  (HypR: Forall (fun R0 => @super_non_expansive A (fun ts a _ => R0 ts a)) R),
-  @super_non_expansive A (fun ts a rho =>
-    PROPx (map (fun P0 => P0 ts a) P)
-       (PARAMSx Q (fun _ : argsEnviron =>
-         GLOBALSx G (fun ae0 : argsEnviron =>
-            let (g, _) := ae0 in
-            !! gvars_denote (initialize.globals_of_genv g) rho
-            && SEPx (map (fun R0 => R0 ts a) R) rho) (Map.empty block, nil))) (ge_of rho, nil)).
-Proof. intros. simpl.
- apply (PROPx_super_non_expansive A P) ; [ clear P HypP| apply HypP].
-  apply (PARAMSx_super_non_expansive A Q).
-  apply (GLOBALSx_super_non_expansive A G).
-  apply (SEPx_super_non_expansive A R); apply HypR.
-Qed.
-
-#[export] Hint Extern 1 (isptr (eval_var _ _ _)) => (eapply lvar_isptr_eval_var; eassumption) : norm2.
-
 Lemma semax_extract_later_prop'':
-  forall {CS : compspecs} {Espec: OracleKind},
-    forall (Delta : tycontext) (PP : Prop) P Q R c post P1 P2,
-      (P2 |-- !!PP) ->
-      (PP -> semax Delta (PROPx P (LOCALx Q (SEPx (P1 && |>P2 :: R)))) c post) ->
-      semax Delta (PROPx P (LOCALx Q (SEPx (P1 && |>P2 :: R)))) c post.
+    forall E (Delta : tycontext) (PP : Prop) P Q R c post P1 P2,
+      (P2 ⊢ ⌜PP⌝) ->
+      (PP -> semax E Delta (PROPx P (LOCALx Q (SEPx ((P1 ∧ ▷P2) :: R)))) c post) ->
+      semax E Delta (PROPx P (LOCALx Q (SEPx ((P1 ∧ ▷P2) :: R)))) c post.
 Proof.
   intros.
   erewrite (add_andp P2) by eauto.
-  apply semax_pre0 with (P' := |>!!PP && PROPx P (LOCALx Q (SEPx (P1 && |>P2 :: R)))).
-  { go_lowerx.
-    rewrite later_andp, <- andp_assoc, andp_comm, corable_andp_sepcon1; auto.
-    apply corable_later; auto. }
+  apply semax_pre0 with (P' := ▷⌜PP⌝ ∧ PROPx P (LOCALx Q (SEPx ((P1 ∧ ▷P2) :: R)))).
+  { apply bi.and_intro.
+    - rewrite /SEPx /= embed_sep embed_and embed_later embed_and embed_pure; iIntros "(_ & _ & (_ & _ & $) & _)".
+    - iIntros "(? & ? & H)".
+      rewrite /SEPx /=.
+      rewrite (bi.and_elim_l P2); iFrame. }
   apply semax_extract_later_prop; auto.
 Qed.
 
-Lemma approx_imp : forall n P Q, compcert_rmaps.RML.R.approx n (predicates_hered.imp P Q) =
-  compcert_rmaps.RML.R.approx n (predicates_hered.imp (compcert_rmaps.RML.R.approx n P)
-    (compcert_rmaps.RML.R.approx n Q)).
+Lemma monPred_at_assert_of : forall P, monPred_at (assert_of P) = P.
 Proof.
-  intros; apply predicates_hered.pred_ext; intros ? (? & Himp); split; auto; intros ? ? Ha' Hext HP.
-  - destruct HP; split; eauto.
-  - eapply Himp; eauto; split; auto.
-    pose proof (ageable.necR_level _ _ Ha'); apply predicates_hered.ext_level in Hext; lia.
+  reflexivity.
 Qed.
 
-Definition super_non_expansive' {A} P := forall n ts x, compcert_rmaps.RML.R.approx n (P ts x) =
-  compcert_rmaps.RML.R.approx n (P ts (functors.MixVariantFunctor.fmap (rmaps.dependent_type_functor_rec ts A)
-        (compcert_rmaps.RML.R.approx n) (compcert_rmaps.RML.R.approx n) x)).
-
-Lemma approx_0 : forall P, compcert_rmaps.RML.R.approx 0 P = FF.
+Lemma monPred_at_argsassert_of : forall P, monPred_at (argsassert_of P) = P.
 Proof.
-  intros; apply predicates_hered.pred_ext.
-  - intros ? []; lia.
-  - intros ??; contradiction.
+  reflexivity.
 Qed.
 
-Require Import VST.msl.predicates_hered.
-Require Import VST.msl.ageable.
-Require Import VST.msl.iter_sepcon.
-Require Import VST.msl.age_sepalg.
-Import FashNotation.
-
-Lemma approx_eq : forall n (P : mpred) r, app_pred (compcert_rmaps.RML.R.approx n P) r = (if lt_dec (level r) n then app_pred P r else False).
+Lemma bind_ret_noret : forall P (R : list mpred), bind_ret None tvoid (PROPx P (LOCALx [] (SEPx R))) = PROPx P (LOCALx [] (SEPx R)).
 Proof.
-  intros; apply prop_ext; split.
-  - intros []; if_tac; auto.
-  - if_tac; split; auto; lia.
+  intros.
+  unfold bind_ret; simpl.
+  apply assert_ext; intros.
+  unfold PROPx, LOCALx, SEPx; monPred.unseal; reflexivity.
 Qed.
 
-Lemma approx_iter_sepcon' : forall {B} n f (lP : list B) P,
-  compcert_rmaps.RML.R.approx n (iter_sepcon f lP)  * compcert_rmaps.RML.R.approx n P =
-  iter_sepcon (compcert_rmaps.RML.R.approx n oo f) lP * compcert_rmaps.RML.R.approx n P.
+Lemma bind_ret_exist : forall {A} (P : A -> assert), bind_ret(Σ := Σ) None tvoid (∃ x : A, P x) = ∃ x : A, bind_ret None tvoid (P x).
 Proof.
-  induction lP; simpl; intros.
-  - apply predicates_hered.pred_ext; intros ? (? & ? & ? & ? & ?).
-    + destruct H0; do 3 eexists; eauto.
-    + do 3 eexists; eauto; split; auto; split; auto.
-      destruct H1; apply join_level in H as []; lia.
-  - rewrite approx_sepcon, !sepcon_assoc, IHlP; auto.
+  intros.
+  unfold bind_ret; simpl.
+  apply assert_ext; intros.
+  unfold PROPx, LOCALx, SEPx; monPred.unseal; reflexivity.
 Qed.
 
-Corollary approx_iter_sepcon: forall {B} n f (lP : list B), lP <> nil ->
-  compcert_rmaps.RML.R.approx n (iter_sepcon f lP) =
-  iter_sepcon (compcert_rmaps.RML.R.approx n oo f) lP.
-Proof.
-  destruct lP; [contradiction | simpl].
-  intros; rewrite approx_sepcon, !(sepcon_comm (compcert_rmaps.RML.R.approx n (f b))), approx_iter_sepcon'; auto.
-Qed.
+End VST.
 
-Lemma approx_FF : forall n, compcert_rmaps.RML.R.approx n FF = FF.
-Proof.
-  intro; apply predicates_hered.pred_ext; intros ??; try contradiction.
-  destruct H; contradiction.
-Qed.
+#[export] Hint Rewrite @insert_local :  norm2.
 
-Lemma later_nonexpansive' : nonexpansive (@later mpred _ _).
-Proof.
-  apply contractive_nonexpansive, later_contractive.
-  intros ??; auto.
-Qed.
+#[export] Hint Rewrite @fold_right_nil : norm1.
+#[export] Hint Rewrite @fold_right_nil : subst.
+#[export] Hint Rewrite @fold_right_cons : norm1.
+#[export] Hint Rewrite @fold_right_cons : subst.
 
-Lemma later_nonexpansive : forall n P, compcert_rmaps.RML.R.approx n (|> P)%pred =
-  compcert_rmaps.RML.R.approx n (|> compcert_rmaps.RML.R.approx n P)%pred.
-Proof.
-  intros.
-  intros; apply predicates_hered.pred_ext.
-  - intros ? []; split; auto.
-    intros ? Hlater; split; auto.
-    apply laterR_level in Hlater; lia.
-  - intros ? []; split; auto.
-    intros ? Hlater.
-    specialize (H0 _ Hlater) as []; auto.
-Qed.
+(*#[export] Hint Rewrite local_unfold : norm2.
+#[export] Hint Rewrite lower_sepcon lower_andp : norm2.
+#[export] Hint Rewrite lift_prop_unfold: norm2.
+#[export] Hint Rewrite andp_unfold: norm2.
+#[export] Hint Rewrite refold_andp : norm2.
+#[export] Hint Rewrite exp_unfold: norm2.*)
 
-Lemma allp_nonexpansive : forall {A} n P, compcert_rmaps.RML.R.approx n (ALL y : A, P y)%pred =
-  compcert_rmaps.RML.R.approx n (ALL y, compcert_rmaps.RML.R.approx n (P y))%pred.
-Proof.
-  intros.
-  apply predicates_hered.pred_ext; intros ? [? Hall]; split; auto; intro; simpl in *.
-  - split; auto.
-  - apply Hall.
-Qed.
+#[export] Hint Resolve PROP_later_derives LOCAL_later_derives SEP_later_derives : derives.
+#[export] Hint Rewrite @local_lift0: norm2.
+#[export] Hint Rewrite @lower_PROP_LOCAL_SEP : norm2.
 
-Lemma fold_right_sepcon_nonexpansive : forall lP1 lP2, Zlength lP1 = Zlength lP2 ->
-  ((ALL i : Z, Znth i lP1 <=> Znth i lP2) |--
-  fold_right sepcon emp lP1 <=> fold_right sepcon emp lP2).
-Proof.
-  induction lP1; intros.
-  - symmetry in H; apply Zlength_nil_inv in H; subst.
-    apply eqp_refl.
-  - destruct lP2; [apply Zlength_nil_inv in H; discriminate|].
-    rewrite !Zlength_cons in H.
-    simpl fold_right; apply eqp_sepcon.
-    + apply predicates_hered.allp_left with 0.
-      rewrite !Znth_0_cons; auto.
-    + eapply predicates_hered.derives_trans, IHlP1; [|lia].
-      apply predicates_hered.allp_right; intro i.
-      apply predicates_hered.allp_left with (i + 1).
-      destruct (zlt i 0).
-      { rewrite !(Znth_underflow _ _ l); apply eqp_refl. }
-      rewrite !Znth_pos_cons, Z.add_simpl_r by lia; auto.
+Ltac not_conj_notation :=
+ match goal with
+ | |- not_conj_notation (_ <= _ <= _)%Z => fail 1
+ | |- not_conj_notation (_ <= _ < _)%Z => fail 1
+ | |- not_conj_notation (_ < _ <= _)%Z => fail 1
+ | |- not_conj_notation (_ <= _ <= _)%nat => fail 1
+ | |- not_conj_notation (_ <= _ < _)%nat => fail 1
+ | |- not_conj_notation (_ < _ <= _)%nat => fail 1
+ | |- _ => apply Coq.Init.Logic.I
+ end.
+
+#[export] Hint Rewrite @split_first_PROP using not_conj_notation : norm1.
+
+#[export] Hint Extern 1 (isptr (eval_var _ _ _)) => (eapply lvar_isptr_eval_var; eassumption) : norm2.
+
+(* The simpl_nat_of_P tactic is a complete hack,
+  needed for compatibility between Coq 8.3/8.4,
+  because the name of the thing to unfold varies
+  between the two versions *)
+Ltac simpl_nat_of_P :=
+match goal with |- context [nat_of_P ?n] =>
+  match n with xI _ => idtac | xO _ => idtac | xH => idtac | _ => fail end;
+  let N := fresh "N" in
+  set (N:= nat_of_P n);
+  compute in N;
+  unfold N; clear N
+end.
+
+Ltac grab_indexes_SEP ns :=
+  rewrite (grab_indexes_SEP ns);
+    unfold grab_indexes; simpl grab_calc;
+   unfold grab_indexes', insert;
+   repeat simpl_nat_of_P; cbv beta iota;
+   unfold Floyd_app; fold @Floyd_app.
+
+Tactic Notation "focus_SEP" constr(a) :=
+  grab_indexes_SEP (a::nil).
+Tactic Notation "focus_SEP" constr(a) constr(b) :=
+  grab_indexes_SEP (a::b::nil).
+Tactic Notation "focus_SEP" constr(a) constr(b) constr(c) :=
+  grab_indexes_SEP (a::b::c::nil).
+Tactic Notation "focus_SEP" constr(a) constr(b) constr(c) constr(d) :=
+  grab_indexes_SEP (a::b::c::d::nil).
+Tactic Notation "focus_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) :=
+  grab_indexes_SEP (a::b::c::d::e::nil).
+Tactic Notation "focus_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) :=
+  grab_indexes_SEP (a::b::c::d::e::f::nil).
+Tactic Notation "focus_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) constr(g) :=
+  grab_indexes_SEP (a::b::c::d::e::f::g::nil).
+Tactic Notation "focus_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) constr(g) constr(h) :=
+  grab_indexes_SEP (a::b::c::d::e::f::g::h::nil).
+Tactic Notation "focus_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) constr(g) constr(h) constr(i) :=
+  grab_indexes_SEP (a::b::c::d::e::f::g::h::i::nil).
+Tactic Notation "focus_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) constr(g) constr(h) constr(i) constr(j) :=
+  grab_indexes_SEP (a::b::c::d::e::f::g::h::i::j::nil).
+
+(* TESTING
+Variables (a b c d e f g h i j : assert).
+Goal (SEP (a;b;c;d;e;f;g;h;i;j) = SEP (b;d;a;c;e;f;g;h;i;j)).
+focus_SEP 1 3.
+auto.
 Qed.
+Goal (SEP (a;b;c;d;e;f;g;h;i;j) = SEP (d;b;a;c;e;f;g;h;i;j)).
+focus_SEP 3 1.
+auto.
+Qed.
+
+*)
+
+Ltac go_lowerx' simpl_tac :=
+   unfold PROPx, LOCALx, SEPx, local, lift1; unfold_lift; split => rho; monPred.unseal; simpl_tac;
+   repeat rewrite <- and_assoc;
+   repeat ((simple apply go_lower_lem1 || apply bi.pure_elim_l || apply bi.pure_elim_r); intro);
+   try apply bi.pure_elim';
+   repeat rewrite -> prop_true_andp by assumption;
+   try apply entails_refl.
+
+Ltac go_lowerx := go_lowerx' simpl.
+
+Ltac go_lowerx_no_simpl := go_lowerx' idtac.
+
+Ltac find_in_list A L :=
+ match L with
+  | A :: _ => constr:(O)
+  | _ :: ?Y => let n := find_in_list A Y in constr:(S n)
+  | nil => fail
+  end.
+
+Ltac length_of R :=
+ match R with
+  |  nil => constr:(O)
+  |  _:: ?R1 => let n := length_of R1 in constr:(S n)
+ end.
+
+Ltac frame_SEP' L :=  (* this should be generalized to permit framing on LOCAL part too *)
+ grab_indexes_SEP L;
+ match goal with
+ | |- semax _ _ (PROPx _ (LOCALx ?Q (SEPx ?R))) _ _ =>
+  rewrite <- (Floyd_firstn_skipn (length L) R);
+  rewrite (app_nil_r Q);
+    simpl length; unfold Floyd_firstn, Floyd_skipn;
+    eapply (semax_frame_PQR);
+      [ unfold closed_wrt_modvars;  auto 50 with closed
+     | ]
+ | |- ENTAIL _ , (PROPx _ (LOCALx ?Q (SEPx ?R))) ⊢ _ =>
+  rewrite <- (Floyd_firstn_skipn (length L) R);
+    simpl length; unfold Floyd_firstn, Floyd_skipn;
+    apply derives_frame_PQR
+end.
+
+Tactic Notation "frame_SEP" constr(a) :=
+  frame_SEP' (a::nil).
+Tactic Notation "frame_SEP" constr(a) constr(b) :=
+  frame_SEP' (a::b::nil).
+Tactic Notation "frame_SEP" constr(a) constr(b) constr(c) :=
+  frame_SEP' (a::b::c::nil).
+Tactic Notation "frame_SEP" constr(a) constr(b) constr(c) constr(d) :=
+  frame_SEP' (a::b::c::d::nil).
+Tactic Notation "frame_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) :=
+  frame_SEP' (a::b::c::d::e::nil).
+Tactic Notation "frame_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) :=
+  frame_SEP' (a::b::c::d::e::f::nil).
+Tactic Notation "frame_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) constr(g) :=
+  frame_SEP' (a::b::c::d::e::f::g::nil).
+Tactic Notation "frame_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) constr(g) constr(h) :=
+  frame_SEP' (a::b::c::d::e::f::g::h::nil).
+Tactic Notation "frame_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) constr(g) constr(h) constr(i) :=
+  frame_SEP' (a::b::c::d::e::f::g::h::i::nil).
+Tactic Notation "frame_SEP" constr(a) constr(b) constr(c) constr(d) constr(e) constr(f) constr(g) constr(h) constr(i) constr(j) :=
+  frame_SEP' (a::b::c::d::e::f::g::h::i::j::nil).
+
+Ltac gather_SEP' L :=
+   grab_indexes_SEP L;
+ match goal with |- context [SEPx ?R] =>
+    let r := fresh "R" in
+    set (r := (SEPx R));
+    revert r;
+     rewrite <- (Floyd_firstn_skipn (length L) R);
+      unfold length at 1 2;
+      unfold Floyd_firstn at 1; unfold Floyd_skipn at 1;
+      rewrite gather_SEP;
+   unfold fold_right at 1; try  rewrite bi.sep_emp;
+   try (intro r; unfold r; clear r)
+ end.
+
+Tactic Notation "replace_SEP" constr(n) constr(R) :=
+  first [apply (replace_SEP' (Z.to_nat n) R) | apply (replace_SEP'' (Z.to_nat n) R)];
+  unfold my_nth,replace_nth; simpl Z.to_nat;
+   repeat simpl_nat_of_P; cbv beta iota; cbv beta iota.
+
+Tactic Notation "replace_SEP" constr(n) constr(R) "by" tactic1(t):=
+  first [apply (replace_SEP' (Z.to_nat n) R) | apply (replace_SEP'' (Z.to_nat n) R)];
+  unfold my_nth,replace_nth; simpl Z.to_nat;
+   repeat simpl_nat_of_P; cbv beta iota; cbv beta iota; [ now t | ].
+
+Tactic Notation "viewshift_SEP" constr(n) constr(R) :=
+  first [apply (replace_SEP'_fupd (Z.to_nat n) R) | apply (replace_SEP''_fupd (Z.to_nat n) R)];
+  unfold my_nth,replace_nth; simpl Z.to_nat;
+   repeat simpl_nat_of_P; cbv beta iota; cbv beta iota.
+
+Tactic Notation "viewshift_SEP" constr(n) constr(R) "by" tactic1(t):=
+  first [apply (replace_SEP'_fupd (Z.to_nat n) R) | apply (replace_SEP''_fupd (Z.to_nat n) R)];
+  unfold my_nth,replace_nth; simpl Z.to_nat;
+   repeat simpl_nat_of_P; cbv beta iota; cbv beta iota; [ now t | ].
+
+Ltac replace_in_pre S S' :=
+ match goal with |- semax _ _ ?P _ _ =>
+  match P with context C[S] =>
+     let P' := context C[S'] in
+      apply semax_pre with P'; [ | ]
+  end
+ end.
+
+Ltac repeat_extract_exists_pre :=
+   first [(apply extract_exists_pre;
+             let x := fresh "x" in intro x; normalize;
+                repeat_extract_exists_pre;
+                revert x)
+           | autorewrite with canon
+          ].
+
+Ltac extract_exists_in_SEP :=
+ match goal with |- semax _ _ (PROPx _ (LOCALx _ (SEPx ?R))) _ _ =>
+   match R with context [ bi_exist ?z :: _] =>
+        let n := find_in_list (bi_exist z) R
+         in rewrite (grab_nth_SEP n); unfold nth, delete_nth; rewrite extract_exists_in_SEP;
+             repeat_extract_exists_pre
+  end
+end.
+
+Ltac flatten_in_SEP PQR :=
+ match PQR with
+ | PROPx ?P (LOCALx ?Q (SEPx (?R))) =>
+   match R with context [(?R1 ∗ ?R2) :: ?R'] =>
+      let n := constr:((length R - Datatypes.S (length R'))%nat) in
+      let n' := eval lazy beta zeta iota delta in n in
+      erewrite(flatten_sepcon_in_SEP'' n' P Q R1 R2 R _ (eq_refl _));
+      [ |
+        let RR := fresh "RR" in set (RR := R);
+        let RR1 := fresh "RR1" in set (RR1 := R1);
+        let RR2 := fresh "RR2" in set (RR2 := R2);
+        unfold Floyd_firstn, app, Floyd_skipn; subst RR RR1 RR2; cbv beta iota;
+        apply eq_refl
+      ]
+   end
+ end.
+
+Ltac flatten_sepcon_in_SEP :=
+  match goal with
+  | |- semax _ _ ?PQR _ _ => flatten_in_SEP PQR
+  | |- ENTAIL _, ?PQR ⊢ _ => flatten_in_SEP PQR
+end.
+
+Ltac delete_emp_in_SEP :=
+ repeat
+ match goal with |- context [SEPx ?R] =>
+   match R with context [emp:: ?R'] =>
+     rewrite -> (delete_emp_in_SEP (length R - S (length R')) R) by reflexivity;
+     simpl length; simpl minus; unfold firstn, app, list_drop; fold app
+   end
+ end.
+
+Ltac move_from_SEP :=
+  (* combines extract_exists_in_SEP, move_prop_from_SEP, (*move_local_from_SEP, *)
+                  flatten_sepcon_in_SEP *)
+match goal with |- context [PROPx _ (LOCALx _ (SEPx ?R))] =>
+  match R with
+  | context [(⌜?P1⌝ ∧ ?Rn) :: ?R'] =>
+      let n := length_of R in let n' := length_of R' in
+        rewrite -> (extract_prop_in_SEP (n-S n')%nat P1 Rn) by reflexivity;
+        simpl minus; unfold replace_nth
+  | context [ ∃ x, ?z x :: _] =>
+        let n := find_in_list (∃ x, z x) R
+         in rewrite (grab_nth_SEP n); unfold nth, delete_nth; rewrite extract_exists_in_SEP;
+             repeat_extract_exists_pre
+  | context [ (?x ∗ ?y) :: ?R'] =>
+        let n := length_of R in let n' := length_of R' in
+         rewrite (grab_nth_SEP (n-S n')); simpl minus; unfold nth, delete_nth;
+         rewrite flatten_sepcon_in_SEP
+ end
+end.
+
+Tactic Notation "assert_LOCAL" constr(A) :=
+  apply (assert_LOCAL A).
+
+Tactic Notation "assert_LOCAL" constr(A) "by" tactic1(t) :=
+  apply (assert_LOCAL A); [ now t | ].
+
+Ltac drop_LOCAL n :=
+   first [apply (drop_LOCAL n) | apply (drop_LOCAL' n) | apply (drop_LOCAL'' n)];
+    unfold delete_nth.
+
+Fixpoint find_LOCAL_index (name: ident) (current: nat) (l : list localdef) : option nat :=
+  match l with
+  | h :: t => match h with
+    | temp  i _   => if (i =? name)%positive then Some current else find_LOCAL_index name (S current) t
+    | lvar  i _ _ => if (i =? name)%positive then Some current else find_LOCAL_index name (S current) t
+    | gvars _ => find_LOCAL_index name (S current) t
+    end
+  | nil => None
+  end.
+
+Ltac drop_LOCAL_by_name name := match goal with
+  | |- semax _ _ (PROPx ?P (LOCALx ?Q (SEPx ?R))) _ _ =>
+    let r := eval hnf in (find_LOCAL_index name O Q) in match r with
+    | Some ?i => drop_LOCAL i
+    | None => fail 1 "No variable named" name "found"
+    end
+  end.
+
+Ltac drop_LOCALs l := match l with
+| ?h :: ?t => drop_LOCAL_by_name h; drop_LOCALs t
+| nil => idtac
+end.
+
+Ltac clean_up_app_carefully := (* useful after rewriting by SEP_PROP *)
+ repeat
+  match goal with
+  | |- context [@app Prop (?a :: ?b) ?c] =>
+    change (app (a::b) c) with (a :: app b c)
+  | |- context [@app (environ->Prop) (?a :: ?b) ?c] =>
+    change (app (a::b) c) with (a :: app b c)
+  | |- context [@app (lifted (LiftEnviron Prop)) (?a :: ?b) ?c] =>
+    change (app (a::b) c) with (a :: app b c)
+  | |- context [@app (assert) (?a :: ?b) ?c] =>
+    change (app (a::b) c) with (a :: app b c)
+  | |- context [@app (lifted (LiftEnviron mpred)) (?a :: ?b) ?c] =>
+    change (app (a::b) c) with (a :: app b c)
+  | |- context [@app Prop nil ?c] =>
+     change (app nil c) with c
+  | |- context [@app (environ->Prop) nil ?c] =>
+     change (app nil c) with c
+  | |- context [@app (lifted (LiftEnviron Prop)) nil ?c] =>
+     change (app nil c) with c
+  | |- context [@app (lifted (assert)) nil ?c] =>
+     change (app nil c) with c
+  | |- context [@app (lifted (LiftEnviron mpred)) nil ?c] =>
+     change (app nil c) with c
+ end.
+
+Tactic Notation "semax_frame" constr(Qframe) constr(Rframe) :=
+ first
+    [ (*simple*) eapply (semax_frame_perm Qframe Rframe);
+          [auto 50 with closed | solve_perm | solve_perm | unfold app; fold @app ]
+    | eapply semax_post_flipped';
+      [(*simple*) eapply (semax_frame_perm Qframe Rframe);
+        [auto 50 with closed | solve_perm | solve_perm | unfold app; fold @app ]
+      | try solve [apply perm_derives; solve_perm]]
+  ].
+
+Tactic Notation "semax_frame" "[" "]" constr(Rframe) :=
+ first
+    [ (*simple*) eapply (semax_frame_perm nil Rframe);
+          [auto 50 with closed | solve_perm | solve_perm | unfold app; fold @app ]
+    | eapply semax_post_flipped';
+      [(*simple*) eapply (semax_frame_perm nil Rframe);
+        [auto 50 with closed | solve_perm | solve_perm | unfold app; fold @app ]
+      | try solve [apply perm_derives; solve_perm]]
+  ].
+
+Ltac simpl_ret_assert ::=
+ cbn [RA_normal RA_break RA_continue RA_return 
+      normal_ret_assert overridePost loop1_ret_assert
+      loop2_ret_assert function_body_ret_assert frame_ret_assert
+      switch_ret_assert loop1x_ret_assert loop1y_ret_assert
+      for_ret_assert loop_nocontinue_ret_assert];
+  try (match goal with
+      | |- context[bind_ret None tvoid ?P] =>
+        assert (bind_ret None tvoid P = P) as -> by (repeat (rewrite bind_ret_exist; f_equal; extensionality); apply bind_ret_noret)
+      end).
diff --git a/floyd/canonicalize.v b/floyd/canonicalize.v
index 460df2cb00..7b3d792e71 100644
--- a/floyd/canonicalize.v
+++ b/floyd/canonicalize.v
@@ -1,199 +1,198 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 
 Import LiftNotation.
-Local Open Scope logic.
+
+Section mpred.
+
+Context `{!heapGS Σ}.
 
 Lemma canon1: forall P1 B  P Q R,
-   do_canon (prop P1 && B) (PROPx P (LOCALx Q (SEPx R))) = do_canon B  (PROPx (P1::P) (LOCALx Q (SEPx R))).
+   do_canon (⌜P1⌝ ∧ B) (PROPx P (LOCALx Q (SEPx R))) = do_canon B  (PROPx (P1::P) (LOCALx Q (SEPx R))).
 Proof.
 unfold do_canon, PROPx, LOCALx, SEPx; intros.
-extensionality rho.
-simpl.
-normalize.
+apply assert_ext; intros; monPred.unseal; normalize.
 Qed.
 
 Lemma canon2: forall Q1 B P Q R,
-    do_canon (local (locald_denote Q1) && B) (PROPx P (LOCALx Q (SEPx R))) = do_canon B (PROPx (P) (LOCALx (Q1::Q) (SEPx R))).
+    do_canon (local (locald_denote Q1) ∧ B) (PROPx P (LOCALx Q (SEPx R))) = do_canon B (PROPx (P) (LOCALx (Q1::Q) (SEPx R))).
 Proof.
 unfold do_canon, PROPx, LOCALx, SEPx; intros.
-extensionality rho.
-simpl.
-normalize. autorewrite with norm1 norm2; normalize.
+rewrite /= local_lift2_and.
+apply assert_ext; intros; monPred.unseal; unfold lift1; normalize.
+f_equal; f_equal; apply prop_ext; tauto.
 Qed.
 
-Definition nonlocal (Q: environ->mpred) := True.
-
-Ltac check_nonlocal :=
-  match goal with
-  |  |- nonlocal (local _) => fail 1
-  |  |- nonlocal (prop _) => fail 1
-  |  |- nonlocal (andp _ _) => fail 1
-  |  |- nonlocal (sepcon _ _) => fail 1
-  | |- _ => apply I
- end.
+Definition nonlocal (Q: assert) : Prop := True.
 
 Lemma canon3: forall R1 B P Q R,
-    nonlocal `(R1) ->
-    do_canon (B * `(R1)) (PROPx P (LOCALx Q (SEPx R))) = do_canon B (PROPx (P) (LOCALx Q (SEPx (R1::R)))).
+    nonlocal ⎡R1⎤ ->
+    do_canon (B ∗ ⎡R1⎤) (PROPx P (LOCALx Q (SEPx R))) = do_canon B (PROPx (P) (LOCALx Q (SEPx (R1::R)))).
 Proof.
 unfold do_canon, PROPx, LOCALx, SEPx; intros.
-clear H.
-extensionality rho.
 simpl.
-rewrite sepcon_assoc.
-f_equal.
-rewrite sepcon_andp_prop.
-f_equal.
-normalize. autorewrite with norm1 norm2; normalize.
+apply assert_ext; intros; monPred.unseal; unfold lift1; normalize.
+rewrite sep_assoc //.
 Qed.
 
 Lemma canon3b: forall R1 B P Q R,
-    nonlocal `(R1) ->
-    do_canon (`(R1)* B) (PROPx P (LOCALx Q (SEPx R))) = do_canon B (PROPx (P) (LOCALx Q (SEPx (R1::R)))).
+    nonlocal ⎡R1⎤ ->
+    do_canon (⎡R1⎤ ∗ B) (PROPx P (LOCALx Q (SEPx R))) = do_canon B (PROPx (P) (LOCALx Q (SEPx (R1::R)))).
 Proof.
 unfold do_canon, PROPx, LOCALx, SEPx; intros.
-rewrite (sepcon_comm `(R1) B).
+rewrite (sep_comm' ⎡R1⎤ B).
 apply canon3. auto.
 Qed.
 
+(* up *)
+Lemma emp_sep' : forall (P : assert), (emp ∗ P) = P.
+Proof.
+  intros; rewrite sep_comm' sep_emp' //.
+Qed.
+
 Lemma canon4: forall P, do_canon emp P = P.
 Proof.
-apply emp_sepcon.
+apply emp_sep'.
 Qed.
 
 Lemma canon7: forall R1 P Q R,
-   nonlocal `(R1) ->
-   do_canon `(R1) (PROPx P (LOCALx Q (SEPx R))) = (PROPx P (LOCALx Q (SEPx (R1::R)))).
+   nonlocal ⎡R1⎤ ->
+   do_canon ⎡R1⎤ (PROPx P (LOCALx Q (SEPx R))) = (PROPx P (LOCALx Q (SEPx (R1::R)))).
 Proof.
-unfold do_canon, PROPx, LOCALx, SEPx; intros.
-extensionality rho.
-simpl.
-normalize. autorewrite with norm1 norm2; normalize.
+unfold do_canon, PROPx, LOCALx, SEPx; intros; simpl.
+apply assert_ext; intros; monPred.unseal; unfold lift1; normalize.
 Qed.
 
 Lemma canon8: forall R1 R2 R3 PQR,
-    do_canon ((R1 && R2) && R3) PQR = do_canon (R1 && (R2 && R3)) PQR.
-Proof. intros; rewrite andp_assoc; auto.
+    do_canon ((R1 ∧ R2) ∧ R3) PQR = do_canon (R1 ∧ (R2 ∧ R3)) PQR.
+Proof. intros; rewrite assert_lemmas.and_assoc'; auto.
 Qed.
 
-Lemma start_canon: forall P, P  = do_canon P (PROPx nil (LOCALx nil (SEPx nil ))).
+Lemma start_canon: forall P, P = do_canon P (PROPx nil (LOCALx nil (SEPx nil ))).
 Proof.
 unfold do_canon, PROPx, LOCALx, SEPx; intros.
-extensionality rho; simpl.
-normalize.
+apply assert_ext; intros; monPred.unseal; rewrite /lift1 /=; unfold_lift.
+rewrite !log_normalize.True_and sep_emp //.
 Qed.
 
-#[export] Hint Rewrite canon1 canon2 canon4 canon8 : canon.
-#[export] Hint Rewrite canon3 using check_nonlocal : canon.
-#[export] Hint Rewrite canon3b using check_nonlocal : canon.
-#[export] Hint Rewrite canon7 using check_nonlocal : canon.
-#[export] Hint Rewrite <- (@sepcon_assoc (environ->mpred) _) : canon.
-
 Lemma canon5: forall Q R S,
        nonlocal Q ->
-       Q && (local R && S) = local R && (Q && S).
+       (Q ∧ (local R ∧ S)) = (local R ∧ (Q ∧ S)).
 Proof.
 intros.
-rewrite andp_comm. rewrite andp_assoc. f_equal. apply andp_comm.
+rewrite assert_lemmas.and_assoc' (and_comm' Q) -assert_lemmas.and_assoc' //.
 Qed.
 
 Lemma canon5b: forall Q R S,
        nonlocal Q ->
-       Q && (S && local R) = local R && (Q && S).
+       (Q ∧ (S ∧ local R)) = (local R ∧ (Q ∧ S)).
 Proof.
 intros.
-symmetry.
-rewrite andp_comm. rewrite andp_assoc. auto.
+rewrite assert_lemmas.and_assoc' and_comm' //.
 Qed.
 
 Lemma canon5c: forall Q R,
        nonlocal Q ->
-       (Q && local R) = local R && Q.
+       (Q ∧ local R) = (local R ∧ Q).
 Proof.
 intros.
-apply andp_comm.
+apply and_comm'.
 Qed.
 
 Lemma canon6: forall Q R S,
        nonlocal Q ->
-       Q && (prop R && S) = prop R && (Q && S).
+       (Q ∧ (⌜R⌝ ∧ S)) = (⌜R⌝ ∧ (Q ∧ S)).
 Proof.
 intros.
-rewrite andp_comm. rewrite andp_assoc; f_equal. apply andp_comm.
+rewrite assert_lemmas.and_assoc' (and_comm' Q) -assert_lemmas.and_assoc' //.
 Qed.
 
 Lemma canon6b: forall Q R S,
        nonlocal Q ->
-       Q && (S && prop R) = prop R && (Q && S).
+       (Q ∧ (S ∧ ⌜R⌝)) = (⌜R⌝ ∧ (Q ∧ S)).
 Proof.
 intros.
-   symmetry; rewrite andp_comm. rewrite andp_assoc; f_equal.
+rewrite assert_lemmas.and_assoc' and_comm' //.
 Qed.
 
 Lemma canon6c: forall Q R,
        nonlocal Q ->
-       (Q && prop R) = prop R && Q.
+       (Q ∧ ⌜R⌝) = (⌜R⌝ ∧ Q).
 Proof.
 intros.
- apply andp_comm.
+apply and_comm'.
 Qed.
 
-#[export] Hint Rewrite canon5 using check_nonlocal : canon.
-#[export] Hint Rewrite canon5b using check_nonlocal : canon.
-#[export] Hint Rewrite canon5c using check_nonlocal : canon.
-#[export] Hint Rewrite canon6 using check_nonlocal : canon.
-#[export] Hint Rewrite canon6b using check_nonlocal : canon.
-#[export] Hint Rewrite canon6c using check_nonlocal : canon.
-
-Lemma canon17 : forall (P: Prop) PP QR, prop P && (PROPx PP QR) = PROPx (P::PP) QR.
+Lemma canon17 : forall (P: Prop) PP (QR : assert), (⌜P⌝ ∧ (PROPx PP QR)) = PROPx (P::PP) QR.
 Proof.
-intros. unfold PROPx. simpl. extensionality rho. apply pred_ext; normalize.
+intros. unfold PROPx. apply assert_ext; intros; monPred.unseal; normalize.
 Qed.
-#[export] Hint Rewrite canon17 : canon.
-
 
 Lemma finish_canon: forall R1 P Q R,
-   do_canon `(R1) (PROPx P (LOCALx Q (SEPx R))) = (PROPx P (LOCALx Q (SEPx (R1::R)))).
+   do_canon ⎡R1⎤ (PROPx P (LOCALx Q (SEPx R))) = (PROPx P (LOCALx Q (SEPx (R1::R)))).
 Proof.
 unfold do_canon, PROPx, LOCALx, SEPx; intros.
-extensionality rho.
-simpl.
-normalize. autorewrite with norm1 norm2; normalize.
+apply assert_ext; intros; monPred.unseal; unfold lift1; normalize.
 Qed.
 
-Ltac canonicalize_pre :=
-  match goal with |- semax _ ?P _ _ =>
-      rewrite (start_canon P); autorewrite with canon
-  end.
-
 Lemma restart_canon: forall P Q R, (PROPx P (LOCALx Q (SEPx R))) = do_canon emp (PROPx P (LOCALx Q (SEPx R))).
 Proof.
 intros.
-unfold do_canon. rewrite emp_sepcon. auto.
+unfold do_canon. rewrite emp_sep' //.
 Qed.
 
 Lemma exp_do_canon:
-   forall T (P: T -> environ->mpred) (Q: environ->mpred), do_canon (exp P) Q = EX x:_, do_canon (P x) Q.
-Proof. apply exp_sepcon1. Qed.
-#[export] Hint Rewrite exp_do_canon: canon.
-#[export] Hint Rewrite exp_do_canon: norm2.
+   forall T (P: T -> assert) (Q: assert), do_canon (bi_exist P) Q = ∃ x:_, do_canon (P x) Q.
+Proof. intros; apply sep_exist_r'. Qed.
 
 Lemma canon9: forall Q1 P Q R,
-       local (locald_denote Q1) && (PROPx P (LOCALx Q R)) =
+       (local (locald_denote Q1) ∧ (PROPx P (LOCALx Q R))) =
          PROPx P (LOCALx (Q1::Q) R).
 Proof.
 intros; unfold PROPx, LOCALx; simpl.
-extensionality rho.
-normalize.
-apply pred_ext; normalize; autorewrite with norm1 norm2; normalize.
+rewrite local_lift2_and.
+apply assert_ext; intros; monPred.unseal; unfold lift1; normalize.
+f_equal; f_equiv; apply prop_ext; tauto.
 Qed.
-#[export] Hint Rewrite canon9: canon.
-
 
 Lemma canon20: forall PQR, do_canon emp PQR = PQR.
 Proof.
-intros. apply emp_sepcon.
+intros. apply emp_sep'.
 Qed.
-#[export] Hint Rewrite canon20: canon.
 
+End mpred.
+
+Ltac check_nonlocal :=
+  match goal with
+  |  |- nonlocal (local _) => fail 1
+  |  |- nonlocal (⌜_⌝) => fail 1
+  |  |- nonlocal (bi_and _ _) => fail 1
+  |  |- nonlocal (bi_sep _ _) => fail 1
+  | |- _ => apply I
+ end.
+
+#[export] Hint Rewrite @canon1 @canon2 @canon4 @canon8 : canon.
+#[export] Hint Rewrite @canon3 using check_nonlocal : canon.
+#[export] Hint Rewrite @canon3b using check_nonlocal : canon.
+#[export] Hint Rewrite @canon7 using check_nonlocal : canon.
+#[export] Hint Rewrite <- @bi.sep_assoc : canon.
+
+#[export] Hint Rewrite @canon5 using check_nonlocal : canon.
+#[export] Hint Rewrite @canon5b using check_nonlocal : canon.
+#[export] Hint Rewrite @canon5c using check_nonlocal : canon.
+#[export] Hint Rewrite @canon6 using check_nonlocal : canon.
+#[export] Hint Rewrite @canon6b using check_nonlocal : canon.
+#[export] Hint Rewrite @canon6c using check_nonlocal : canon.
+#[export] Hint Rewrite @canon17 : canon.
+
+Ltac canonicalize_pre :=
+  match goal with |- semax _ _ ?P _ _ =>
+      rewrite (start_canon P); autorewrite with canon
+  end.
+
+#[export] Hint Rewrite @exp_do_canon: canon.
+#[export] Hint Rewrite @exp_do_canon: norm2.
+#[export] Hint Rewrite @canon9: canon.
+#[export] Hint Rewrite @canon20: canon.
diff --git a/floyd/client_lemmas.v b/floyd/client_lemmas.v
index 190bc5679b..7ab72b589b 100644
--- a/floyd/client_lemmas.v
+++ b/floyd/client_lemmas.v
@@ -1,107 +1,49 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Export VST.floyd.canon.
 Import LiftNotation.
-Import compcert.lib.Maps.
-Local Open Scope logic.
-
-Lemma SEP_entail:
- forall R' Delta P Q R,
-   (fold_right_sepcon R |-- fold_right_sepcon R') ->
-   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- PROPx P (LOCALx Q (SEPx R')).
-Proof.
-intros.
-apply andp_left2.
-apply andp_derives; auto.
-apply andp_derives; auto.
-intro rho.
-apply H.
-Qed.
 
 Ltac refold_right_sepcon R :=
  match R with
- | @sepcon mpred _ _ ?R1 ?R' => let S := refold_right_sepcon R' in constr: (R1 :: S )
+ | bi_sep ?R1 ?R' => let S := refold_right_sepcon R' in constr: (R1 :: S )
  | _ => constr:(R :: nil)
  end.
 
-Lemma SEP_entail':
- forall R' Delta P Q R,
-   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- ` (fold_right_sepcon R') ->
-   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- PROPx P (LOCALx Q (SEPx R')).
-Proof.
-intros.
-apply andp_right.
-apply andp_left2; apply andp_left1; auto.
-apply andp_right.
-do 2 apply andp_left2; apply andp_left1; auto.
-eapply derives_trans; [ apply H|].
-apply derives_refl.
-Qed.
+Section mpred.
 
-Lemma SEP_entail'_fupd:
+Context `{!heapGS Σ}.
+
+Lemma SEP_entail:
  forall R' Delta P Q R,
-   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- ` (|={Ensembles.Full_set}=> fold_right_sepcon R') ->
-   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- |={Ensembles.Full_set}=> PROPx P (LOCALx Q (SEPx R')).
+   (fold_right_sepcon R ⊢ fold_right_sepcon R') ->
+   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢ PROPx P (LOCALx Q (SEPx R')).
 Proof.
 intros.
-eapply derives_trans, corable_andp_fupd, corable_prop.
-apply andp_right.
-apply andp_left2; apply andp_left1; auto.
-eapply derives_trans, local_andp_fupd.
-apply andp_right.
-do 2 apply andp_left2; apply andp_left1; auto.
-eapply derives_trans; [ apply H|].
-apply derives_refl.
+rewrite bi.and_elim_r /PROPx /LOCALx /SEPx H //.
 Qed.
 
-Arguments sem_cmp c !t1 !t2 / v1 v2.
-
-(* The following lines should not be needed, and was not needed
- in Coq 8.3, but in Coq 8.4 they seem to be necessary. *)
-Definition ListClassicalSep_environ := @LiftClassicalSep environ.
-
-#[export] Hint Resolve ListClassicalSep_environ : typeclass_instances.
-
-Definition func_ptr' f v := func_ptr f v && emp.
-
-#[export] Hint Resolve func_ptr_isptr: saturate_local.
-#[export] Hint Resolve SeparationLogic.func_ptr_valid_pointer: valid_pointer.
-
-Lemma func_ptr'_isptr: forall f v, func_ptr' f v |-- !! isptr v.
+Lemma SEP_entail':
+ forall R' Delta P Q R,
+   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢ ⎡fold_right_sepcon R'⎤ ->
+   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢ PROPx P (LOCALx Q (SEPx R')).
 Proof.
 intros.
-unfold func_ptr'.
-apply andp_left1. apply func_ptr_isptr.
+apply bi.and_intro, bi.and_intro; [iIntros "(_ & $ & _)" | iIntros "(_ & _ & $ & _)" | apply H].
 Qed.
-#[export] Hint Resolve func_ptr'_isptr: saturate_local.
 
-Lemma func_ptr'_valid_pointer: forall spec f, func_ptr' spec f |-- valid_pointer f.
-Proof. intros. unfold func_ptr'.
-apply andp_left1. apply SeparationLogic.func_ptr_valid_pointer. Qed.
-#[export] Hint Resolve func_ptr'_valid_pointer : valid_pointer.
-
-Lemma split_func_ptr':
- forall fs p, func_ptr' fs p = func_ptr' fs p * func_ptr' fs p.
+Lemma SEP_entail'_fupd:
+ forall R' E Delta P Q R,
+   (ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢ |={E}=> ⎡fold_right_sepcon R'⎤) ->
+   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢ |={E}=> PROPx P (LOCALx Q (SEPx R')).
 Proof.
 intros.
-unfold func_ptr'.
-pose proof (corable_func_ptr fs p).
-rewrite  corable_andp_sepcon1 by auto.
-rewrite emp_sepcon.
-rewrite <- andp_assoc.
-f_equal.
-apply pred_ext. apply andp_right; auto. apply andp_left2; auto.
+iIntros "(#? & #? & #? & H)".
+iMod (H with "[H]") as "$"; auto.
+repeat (iSplit; auto).
 Qed.
 
-Lemma approx_func_ptr': forall (A: Type) fsig0 cc P (Q: A -> environ -> mpred) (v: val) (n: nat),
-  compcert_rmaps.RML.R.approx (S n) (func_ptr' (NDmk_funspec fsig0 cc A P Q) v) = compcert_rmaps.RML.R.approx (S n) (func_ptr' (NDmk_funspec fsig0 cc A (fun a rho => compcert_rmaps.RML.R.approx n (P a rho)) (fun a rho => compcert_rmaps.RML.R.approx n (Q a rho))) v).
-Proof.
-  intros.
-  unfold func_ptr'.
-  rewrite !approx_andp.
-  rewrite <- ! (andp_comm (_ _ emp)).
-  apply (@f_equal _ _ (andp (compcert_rmaps.RML.R.approx (S n) emp))).
-  apply (approx_func_ptr A fsig0 cc P Q).
-Qed.
+Arguments sem_cmp c !t1 !t2 / v1 v2.
 
 Lemma lift0_unfold: forall {A} (f: A)  rho,  lift0 f rho = f.
 Proof. reflexivity. Qed.
@@ -141,9 +83,6 @@ Lemma lift4_unfoldC: forall {A1 A2 A3 A4 B} (f: A1 -> A2 -> A3 -> A4 -> B) a1 a2
         `f a1 a2 a3 a4 rho = f (a1 rho) (a2 rho) (a3 rho) (a4 rho).
 Proof. reflexivity. Qed.
 
-#[export] Hint Rewrite @lift0_unfold @lift1_unfold @lift2_unfold @lift3_unfold @lift4_unfold : norm2.
-#[export] Hint Rewrite @lift0_unfoldC @lift1_unfoldC @lift2_unfoldC @lift3_unfoldC @lift4_unfoldC : norm2.
-
 Lemma alift0_unfold: forall {A} (f: A)  rho,  alift0 f rho = f.
 Proof. reflexivity. Qed.
 
@@ -163,8 +102,6 @@ Lemma alift4_unfold: forall {A1 A2 A3 A4 B} (f: A1 -> A2 -> A3 -> A4 -> B) a1 a2
         alift4 f a1 a2 a3 a4 rho = f (a1 rho) (a2 rho) (a3 rho) (a4 rho).
 Proof. reflexivity. Qed.
 
-#[export] Hint Rewrite @alift0_unfold @alift1_unfold @alift2_unfold @alift3_unfold @alift4_unfold : norm2.
-
 Lemma subst_lift0: forall {A} id v (f: A),
         subst id v (lift0 f) = lift0 f.
 Proof.
@@ -177,8 +114,6 @@ Proof.
 intros. extensionality rho; reflexivity.
 Qed.
 
-#[export] Hint Rewrite @subst_lift0' : subst.
-
 Lemma subst_lift0C:
   forall {B} id (v: environ -> val) (f: B) ,
           subst id v (`f) = `f.
@@ -186,8 +121,6 @@ Proof.
 intros. extensionality rho; reflexivity.
 Qed.
 
-#[export] Hint Rewrite @subst_lift0 @subst_lift0C : subst.
-
 Lemma subst_lift1:
   forall {A1 B} id v (f: A1 -> B) a,
           subst id v (lift1 f a) = lift1 f (subst id v a).
@@ -209,8 +142,6 @@ Proof.
 intros. extensionality rho; reflexivity.
 Qed.
 
-#[export] Hint Rewrite @subst_lift1 @subst_lift1C  : subst.
-
 Lemma subst_lift2:
   forall {A1 A2 B} id v (f: A1 -> A2 -> B) a b,
           subst id v (lift2 f a b) = lift2 f (subst id v a) (subst id v b).
@@ -232,8 +163,6 @@ Proof.
 intros. extensionality rho; reflexivity.
 Qed.
 
-#[export] Hint Rewrite @subst_lift2 @subst_lift2C : subst.
-
 Lemma subst_lift3:
   forall {A1 A2 A3 B} id v (f: A1 -> A2 -> A3 -> B) a1 a2 a3,
           subst id v (lift3 f a1 a2 a3) = lift3 f (subst id v a1) (subst id v a2) (subst id v a3).
@@ -257,8 +186,6 @@ Proof.
 intros. extensionality rho; reflexivity.
 Qed.
 
-#[export] Hint Rewrite @subst_lift3 @subst_lift3C : subst.
-
 Lemma subst_lift4:
   forall {A1 A2 A3 A4 B} id v (f: A1 -> A2 -> A3 -> A4 -> B) a1 a2 a3 a4,
           subst id v (lift4 f a1 a2 a3 a4) = lift4 f (subst id v a1) (subst id v a2) (subst id v a3) (subst id v a4).
@@ -282,26 +209,13 @@ Proof.
 intros. extensionality rho; reflexivity.
 Qed.
 
-#[export] Hint Rewrite @subst_lift4 @subst_lift4C : subst.
-
-
 Lemma bool_val_int_eq_e:
   forall i j m, Cop.bool_val (Val.of_bool (Int.eq i j)) type_bool m = Some true ->
     i=j.
 Proof.
  intros.
- unfold Cop.bool_val in H.
- destruct Archi.ptr64 eqn:Hp;
- revert H; case_eq (Val.of_bool (Int.eq i j)); simpl; intros; inv H0.
-+
- pose proof (Int.eq_spec i j).
- revert H H0; case_eq (Int.eq i j); intros; auto.
- simpl in H0; unfold Vfalse in H0. inv H0. rewrite Int.eq_true in H2. inv H2.
-+
- pose proof (Int.eq_spec i j).
- revert H H0; case_eq (Int.eq i j); intros; auto.
- simpl in H0; unfold Vfalse in H0. inv H0. inv H2.
-+ unfold Val.of_bool in H.  destruct (Int.eq i j); inv H.
+ unfold Cop.bool_val in H; simpl in H.
+ pose proof (Int.eq_spec i j); destruct (Int.eq i j) eqn: Hij; auto; inv H.
 Qed.
 
 Lemma bool_val_notbool_ptr:
@@ -314,30 +228,19 @@ Proof.
  destruct t; try contradiction. clear H.
  unfold Cop.sem_notbool, Cop.bool_val, Val.of_bool, Cop.classify_bool, nullval.
  destruct Archi.ptr64 eqn:Hp; simpl;
- apply prop_ext; split; intros.
--
- destruct v; simpl in H; try solve [inv H].
- destruct (Int64.eq i Int64.zero) eqn:?; inv H.
-  apply expr_lemmas.int64_eq_e in Heqb. subst; reflexivity.
- destruct (Memory.Mem.weak_valid_pointer m b (Ptrofs.unsigned i)) eqn:?;
-  simpl in H; inv H.
--
-  subst v; simpl. reflexivity.
--
- destruct v; simpl in H; try solve [inv H].
- destruct (Int.eq i Int.zero) eqn:?; inv H.
-  apply int_eq_e in Heqb. subst; reflexivity.
- destruct (Memory.Mem.weak_valid_pointer m b (Ptrofs.unsigned i)) eqn:?;
-  simpl in H; inv H.
--
-  subst v; simpl. reflexivity.
+ apply prop_ext.
+- destruct v; simpl; try (split; congruence).
+  + pose proof (Int64.eq_spec i Int64.zero); destruct (Int64.eq i Int64.zero); subst; simpl; first tauto.
+    split; inversion 1; auto.
+  + destruct (Memory.Mem.weak_valid_pointer m b (Ptrofs.unsigned i)) eqn:?; simpl; split; congruence.
+- destruct v; simpl; try (split; congruence).
+  + pose proof (Int.eq_spec i Int.zero); destruct (Int.eq i Int.zero); subst; simpl; first tauto.
+    split; inversion 1; auto.
+  + destruct (Memory.Mem.weak_valid_pointer m b (Ptrofs.unsigned i)) eqn:?; simpl; split; congruence.
 Qed.
 
 Definition retval : environ -> val := eval_id ret_temp.
 
-#[export] Hint Rewrite eval_id_same : norm.
-#[export] Hint Rewrite eval_id_other using solve [clear; intro Hx; inversion Hx] : norm.
-
 Lemma simpl_get_result1:
  forall (f: val -> Prop) i, @liftx (Tarrow environ (LiftEnviron Prop)) (@liftx (Tarrow val (LiftEnviron Prop))f retval) (get_result1 i) = `f (eval_id i).
 Proof.
@@ -345,14 +248,12 @@ intros; extensionality rho.
 unfold_lift; unfold retval, get_result1.
 f_equal.
 Qed.
-#[export] Hint Rewrite simpl_get_result1: norm.
 
 Lemma retval_get_result1:
    forall i rho, retval (get_result1 i rho) = (eval_id i rho).
 Proof. intros. unfold retval, get_result1. simpl.
  normalize.
 Qed.
-#[export] Hint Rewrite retval_get_result1 : norm.
 
 Lemma retval_ext_rval:
   forall ge t v, retval (make_ext_rval ge t v) = force_val v.
@@ -366,49 +267,42 @@ Lemma retval_lemma1:
 Proof.
  intros. unfold retval.  normalize.
 Qed.
-#[export] Hint Rewrite retval_lemma1 : norm.
 
 Lemma retval_make_args:
   forall v rho, retval (make_args (ret_temp::nil) (v::nil) rho) = v.
 Proof. intros.  unfold retval, eval_id; simpl. try rewrite Map.gss. reflexivity.
 Qed.
-#[export] Hint Rewrite retval_make_args: norm2.
 
-Lemma andp_makeargs:
-   forall (a b: environ -> mpred) d e,
-   `(a && b) (make_args d e) = `a (make_args d e) && `b (make_args d e).
+(*Lemma andp_makeargs:
+   forall (a b: assert) d e,
+   `(a ∧ b) (make_args d e) = `a (make_args d e) ∧ `b (make_args d e).
 Proof. intros. reflexivity. Qed.
-#[export] Hint Rewrite andp_makeargs: norm2.
 
 Lemma local_makeargs:
    forall (f: val -> Prop) v,
    `(local (`(f) retval)) (make_args (cons ret_temp nil) (cons v nil))
     = (local (`(f) `(v))).
 Proof. intros. reflexivity. Qed.
-#[export] Hint Rewrite local_makeargs: norm2.
 
 Lemma simpl_and_get_result1:
-  forall (Q R: environ->mpred) i,
-    `(Q && R) (get_result1 i) = `Q (get_result1 i) && `R (get_result1 i).
+  forall (Q R: assert) i,
+    `(Q ∧ R) (get_result1 i) = `Q (get_result1 i) ∧ `R (get_result1 i).
 Proof. intros. reflexivity. Qed.
-#[export] Hint Rewrite simpl_and_get_result1 : norm2.
 
 Lemma liftx_local_retval:
   forall (P: val -> Prop) i,
    `(local (`P retval)) (get_result1 i) = local (`P (eval_id i)).
-Proof. intros. reflexivity. Qed.
-#[export] Hint Rewrite liftx_local_retval : norm2.
-
-#[export] Hint Rewrite bool_val_notbool_ptr using apply Coq.Init.Logic.I : norm.
+Proof. intros. reflexivity. Qed.*)
 
-Lemma Vint_inj': forall i j,  (Vint i = Vint j) =  (i=j).
+Lemma Vint_inj': forall i j,  (Vint i = Vint j) = (i=j).
 Proof. intros; apply prop_ext; split; intro; congruence. Qed.
 
 Lemma overridePost_normal_right:
-  forall P Q R,
-   (P |-- Q) ->
-   P |-- RA_normal (overridePost Q R).
-Proof. intros.
+  forall (P Q : assert) R,
+   (P ⊢ Q) ->
+   P ⊢ RA_normal (overridePost Q R).
+Proof.
+  intros.
   destruct R; simpl; auto.
 Qed.
 
@@ -427,29 +321,26 @@ Fixpoint fold_right_and_True (l: list Prop) : Prop :=
 
 Definition fold_right_PROP_SEP (l1: list Prop) (l2: list mpred) : mpred :=
  match l1 with
- | nil => fold_right_sepcon l2
- | l => !! (fold_right_and_True l) && fold_right_sepcon l2
+ | nil => fold_right_sepconx l2
+ | l => ⌜fold_right_and_True l⌝ ∧ fold_right_sepconx l2
  end.
 
 Lemma fold_right_PROP_SEP_spec: forall l1 l2,
-  fold_right_PROP_SEP l1 l2 = !! (fold_right and True l1) && fold_right_sepcon l2.
+  fold_right_PROP_SEP l1 l2 = (⌜fold_right and True l1⌝ ∧ fold_right_sepconx l2).
 Proof.
   intros.
-  assert (fold_right_and_True l1 <-> fold_right and True l1).
-  {
+  assert (fold_right_and_True l1 = fold_right and True%type l1).
+  { apply prop_ext.
     destruct l1; [tauto |].
     revert P; induction l1; intros.
     - simpl; tauto.
-    - change (P /\ fold_right_and_True (a :: l1) <-> P /\ fold_right and True (a :: l1)).
+    - change (P /\ fold_right_and_True (a :: l1) <-> P /\ fold_right and True%type (a :: l1)).
       specialize (IHl1 a).
-      tauto.
-  }
+      tauto. }
   destruct l1.
-  + simpl.
-    normalize.
+  + rewrite /= log_normalize.True_and //.
   + unfold fold_right_PROP_SEP.
-    rewrite H.
-    auto.
+    rewrite H //.
 Qed.
 
 Lemma typed_true_isptr:
@@ -464,22 +355,10 @@ destruct x; try tauto; intuition (try congruence);
 revert H0; simple_if_tac; intro H0; inv H0.
 Qed.
 
-#[export] Hint Rewrite typed_true_isptr using apply Coq.Init.Logic.I : norm.
-
-Ltac super_unfold_lift_in H :=
-   cbv delta [liftx LiftEnviron Tarrow Tend lift_S lift_T
-    lift_prod lift_last lifted lift_uncurry_open lift_curry lift lift0
-    lift1 lift2 lift3] beta iota in H.
-
-Ltac super_unfold_lift' :=
-  cbv delta [liftx LiftEnviron Tarrow Tend lift_S lift_T
-    lift_prod lift_last lifted lift_uncurry_open lift_curry lift lift0
-    lift1 lift2 lift3] beta iota.
-
 Lemma tc_eval'_id_i:
   forall Delta t i rho,
                tc_environ Delta rho ->
-              (temp_types Delta)!i = Some t ->
+              (temp_types Delta)!!i = Some t ->
               tc_val' t (eval_id i rho).
 Proof.
 intros.
@@ -497,14 +376,11 @@ intros.
  destruct i,s,v; try inv H; simpl; eauto.
 Qed.
 
-Tactic Notation "name" ident(s) constr(id) :=
-    idtac "Warning: the 'name' tactic no loger does anything useful, and will be removed in future versions of VST".
-
 Definition reflect_temps_f (rho: environ) (b: Prop) (i: ident) (t: type) : Prop :=
   tc_val' t (eval_id i rho) /\ b.
 
 Definition reflect_temps (Delta: tycontext) (rho: environ) : Prop :=
-    PTree.fold (reflect_temps_f rho) (temp_types Delta) True.
+    Maps.PTree.fold (reflect_temps_f rho) (temp_types Delta) True%type.
 
 Lemma reflect_temps_valid:
   forall Delta rho,
@@ -512,10 +388,10 @@ Lemma reflect_temps_valid:
 Proof.
 intros.
 unfold reflect_temps.
-rewrite PTree.fold_spec.
-remember  (PTree.elements (temp_types Delta)) as el.
-assert (forall i v, In (i,v) el -> (temp_types Delta) ! i = Some v).
- intros. subst el. apply PTree.elements_complete; auto.
+rewrite Maps.PTree.fold_spec.
+remember  (Maps.PTree.elements (temp_types Delta)) as el.
+assert (forall i v, In (i,v) el -> (temp_types Delta) !! i = Some v).
+ intros. subst el. apply Maps.PTree.elements_complete; auto.
 clear Heqel.
 assert (forall b: Prop, b -> fold_left
   (fun (a : Prop) (p : positive * type) =>
@@ -531,31 +407,6 @@ eassumption.
 apply H0; auto.
 Qed.
 
-Definition abbreviate {A:Type} (x:A) := x.
-Arguments abbreviate {A} {x}.
-
-Ltac clear_Delta :=
-match goal with
-| Delta := @abbreviate tycontext ?G |- _ =>
-   try match goal with |- context [ret_type Delta] =>
-      let x := constr:(ret_type G) in let x := eval hnf in x
-       in change (ret_type Delta) with x in *
-   end;
-   try clear Delta
-| _ => idtac
-end;
-match goal with
- |  DS := @abbreviate (PTree.t funspec) _  |- _ =>
-   first [clear DS | clearbody DS]
- | |- _ => idtac
- end.
-
-Ltac clear_Delta_specs :=
- lazymatch goal with
- |  DS := @abbreviate (PTree.t funspec) _  |- _ => clearbody DS
- | |- _ => idtac
- end.
-
 Lemma is_true_negb:
  forall a, is_true (negb a) -> a=false.
 Proof.
@@ -564,16 +415,16 @@ Qed.
 
 Lemma sem_cast_pointer2':
   forall (v : val) (t1 t2: type),
-  match t1 with
+  (match t1 with
   | Tpointer _ _ => is_true (negb (eqb_type t1 int_or_ptr_type))
   | Tint I32 _ _ => if Archi.ptr64 then False else True
   | Tlong _ _ => if Archi.ptr64 then True else False
-  | _ => False end ->
-  match t2 with
+  | _ => False end)%type ->
+  (match t2 with
   | Tpointer _ _ => is_true (negb (eqb_type t2 int_or_ptr_type))
   | Tint I32 _ _ => if Archi.ptr64 then False else True
   | Tlong _ _ => if Archi.ptr64 then True else False
-  | _ => False end ->
+  | _ => False end)%type ->
   is_pointer_or_null v -> force_val (sem_cast t1 t2 v) = v.
 Proof.
 intros.
@@ -585,8 +436,6 @@ try rewrite (is_true_negb _ H); try rewrite (is_true_negb _ H0);
 destruct v; inv H1; auto.
 Qed.
 
-#[export] Hint Rewrite sem_cast_pointer2' using (try apply Coq.Init.Logic.I; try assumption; reflexivity) : norm.
-
 Lemma sem_cast_pointer2:
   forall v t1 t2 t3 t1' t2',
    t1' = Tpointer t1 noattr ->
@@ -600,19 +449,18 @@ reflexivity.
 Qed.
 
 Lemma force_eval_var_int_ptr :
-forall  {cs: compspecs}  Delta rho i t,
+forall {cs: compspecs} Delta rho i t,
 tc_environ Delta rho ->
-tc_lvalue Delta (Evar i t) rho |--
-        !! (force_val
+tc_lvalue Delta (Evar i t) rho ⊢
+        ⌜force_val
             match eval_var i t rho with
             | Vptr _ _ => Some (eval_var i t rho)
             | _ => None
-            end = eval_var i t rho).
+            end = eval_var i t rho⌝.
 Proof.
 intros.
-eapply derives_trans.
-apply typecheck_lvalue_sound; auto.
-simpl; normalize.
+rewrite typecheck_lvalue_sound //.
+apply bi.pure_mono; simpl; intros.
 unfold eval_var in *.
 destruct (Map.get (ve_of rho) i) as [[? ?] |].
 destruct (eqb_type t t0); try discriminate; reflexivity.
@@ -632,8 +480,6 @@ Lemma is_pointer_or_null_force_int_ptr:
 Proof.
 intros. destruct v; inv H; reflexivity.
 Qed.
-#[export] Hint Rewrite is_pointer_or_null_force_int_ptr using assumption : norm1.
-
 
 Lemma is_pointer_force_int_ptr:
    forall v, isptr v -> (force_val
@@ -646,8 +492,6 @@ Lemma is_pointer_force_int_ptr:
 Proof.
 intros. destruct v; inv H; reflexivity.
 Qed.
-#[export] Hint Rewrite is_pointer_force_int_ptr using assumption : norm1.
-
 
 Lemma is_pointer_or_null_match :
    forall v, is_pointer_or_null v ->
@@ -660,7 +504,6 @@ Lemma is_pointer_or_null_match :
 Proof.
 intros. destruct v; inv H; reflexivity.
 Qed.
-#[export] Hint Rewrite is_pointer_or_null_match using assumption : norm1.
 
 Lemma is_pointer_force_int_ptr2:
    forall v, isptr v ->
@@ -673,7 +516,6 @@ Lemma is_pointer_force_int_ptr2:
 Proof.
 intros. destruct v; inv H; reflexivity.
 Qed.
-#[export] Hint Rewrite is_pointer_force_int_ptr2 using assumption : norm1.
 
 Lemma is_pointer_or_null_force_int_ptr2:
    forall v, is_pointer_or_null (force_val
@@ -691,8 +533,6 @@ Proof.
 intros. destruct v; inv H; reflexivity.
 Qed.
 
-#[export] Hint Rewrite is_pointer_or_null_force_int_ptr2 using assumption : norm1.
-
 Lemma isptr_match : forall w0,
 is_pointer_or_null
          match
@@ -713,7 +553,6 @@ destruct Archi.ptr64 eqn:Hp;
 destruct w0; auto.
 Qed.
 
-#[export] Hint Rewrite isptr_match : norm1.
 
 Lemma eval_cast_neutral_tc_val:
    forall v, (exists t, tc_val t v /\ is_pointer_type t = true) ->
@@ -728,36 +567,28 @@ destruct (eqb_type t int_or_ptr_type);
 destruct t,v; inv H0; inv H; reflexivity.
 Qed.
 
-#[export] Hint Rewrite eval_cast_neutral_tc_val using solve [eauto] : norm.
-
 Lemma eval_cast_neutral_is_pointer_or_null:
    forall v, is_pointer_or_null v -> sem_cast_pointer v = Some v.
 Proof.
 intros. destruct v; inv H; reflexivity.
 Qed.
-#[export] Hint Rewrite eval_cast_neutral_is_pointer_or_null using assumption : norm.
 
 Lemma is_pointer_or_null_eval_cast_neutral:
   forall v, is_pointer_or_null (force_val (sem_cast_pointer v)) = is_pointer_or_null v.
 Proof. destruct v; reflexivity. Qed.
-#[export] Hint Rewrite is_pointer_or_null_eval_cast_neutral : norm.
 
 Lemma eval_cast_neutral_isptr:
    forall v, isptr v -> sem_cast_pointer v = Some v.
 Proof.
 intros. destruct v; inv H; reflexivity.
 Qed.
-#[export] Hint Rewrite eval_cast_neutral_isptr using assumption : norm.
 
-Arguments ret_type !Delta /.
-
-Arguments Datatypes.id {A} x / .
+Notation assert_of := (@assert_of Σ).
 
 Lemma raise_sepcon:
- forall A B : environ -> mpred ,
-    (fun rho: environ => A rho * B rho) = (A * B).
-Proof. reflexivity. Qed.
-#[export] Hint Rewrite raise_sepcon : norm1.
+ forall A B : assert,
+    assert_of (fun rho: environ => A rho ∗ B rho) = (A ∗ B).
+Proof. intros; apply assert_ext; intros; monPred.unseal; done. Qed.
 
 Lemma lift1_lift1_retval {A}: forall i (P: val -> A),
 lift1 (lift1 P retval) (get_result1 i) = lift1 P (eval_id i).
@@ -772,245 +603,696 @@ Lemma lift_lift_retval:
 Proof.
  reflexivity.
 Qed.
-#[export] Hint Rewrite lift_lift_retval: norm2.
 
 Lemma lift_lift_x:  (* generalizes lift_lift_val *)
   forall t t' P (v: t),
   (@liftx (Tarrow t (LiftEnviron t')) P (@liftx (LiftEnviron t) v)) =
   (@liftx (LiftEnviron t') (P v)).
 Proof. reflexivity. Qed.
-#[export] Hint Rewrite lift_lift_x : norm2.
 
-Lemma lift0_exp {A}{NA: NatDed A}:
-  forall (B: Type) (f: B -> A), lift0 (exp f) = EX x:B, lift0 (f x).
-Proof. intros; extensionality rho; unfold lift0. simpl.
-f_equal; extensionality b; auto.
+Lemma lift0_exp:
+  forall (B: Type) (f: B -> mpred), assert_of (lift0 (∃ x, f x)) = ∃ x:B, assert_of (lift0 (f x)).
+Proof.
+  intros; apply assert_ext; intros; rewrite /lift0; simpl; monPred.unseal; done.
 Qed.
 
-Lemma lift0C_exp {A}{NA: NatDed A}:
-  forall (B: Type) (f: B -> A), `(exp f) = EX x:B, `(f x).
+Lemma lift0C_exp:
+  forall (B: Type) (f: B -> mpred), assert_of (`(∃ x, f x)) = ∃ x:B, assert_of (`(f x)).
 Proof.
-intros. unfold_lift. simpl. extensionality rho. f_equal; extensionality x; auto.
+  intros; apply assert_ext; intros; unfold_lift; simpl; monPred.unseal; done.
 Qed.
-#[export] Hint Rewrite @lift0_exp : norm2.
-#[export] Hint Rewrite @lift0C_exp : norm2.
 
-Lemma lift0_andp {A}{NA: NatDed A}:
+Lemma lift0_andp:
  forall P Q,
-   lift0 (@andp A NA P Q) = andp (lift0 P) (lift0 Q).
+   assert_of (lift0 (P ∧ Q)) = (assert_of (lift0 P) ∧ assert_of (lift0 Q)).
 Proof.
-intros. extensionality rho. reflexivity.
+  intros; apply assert_ext; intros; monPred.unseal; done.
 Qed.
 
-Lemma lift0C_andp {A}{NA: NatDed A}:
- forall P Q: A,
-  `(@andp A NA P Q) =
-  andp (`P) (`Q).
+Lemma lift0C_andp:
+ forall P Q,
+  assert_of `(P ∧ Q) = (assert_of (`P) ∧ assert_of (`Q)).
 Proof.
-intros. extensionality rho. reflexivity.
+  intros; apply assert_ext; intros; monPred.unseal; done.
 Qed.
 
-Lemma lift0_prop {A}{NA: NatDed A}:
- forall P, lift0 (!! P) = !!P.
-Proof. intros. extensionality rho; reflexivity. Qed.
+Lemma lift0_prop:
+ forall P : Prop, assert_of (lift0 ⌜P⌝) = ⌜P⌝.
+Proof.
+  intros; apply assert_ext; intros; monPred.unseal; done.
+Qed.
 
-Lemma lift0C_prop {A}{NA: NatDed A}:
- forall P, @liftx (LiftEnviron A) (@prop A NA P) =
-                  @prop (environ -> A) _ P.
-Proof. reflexivity. Qed.
+Lemma lift0C_prop:
+ forall P : Prop, assert_of (`⌜P⌝) = ⌜P⌝.
+Proof.
+  intros; apply assert_ext; intros; monPred.unseal; done.
+Qed.
 
-Lemma lift0_sepcon {A}{NA: NatDed A}{SA: SepLog A}:
+Lemma lift0_sepcon:
  forall P Q,
-  lift0 (@sepcon A NA SA P Q) = sepcon (lift0 P) (lift0 Q).
+  assert_of (lift0 (P ∗ Q)) = (assert_of (lift0 P) ∗ assert_of (lift0 Q)).
 Proof.
-intros. extensionality rho. reflexivity.
+  intros; apply assert_ext; intros; monPred.unseal; done.
 Qed.
 
-Lemma lift0C_sepcon {A}{NA: NatDed A}{SA: SepLog A}:
- forall P Q N2 S2,
-  (@liftx (LiftEnviron A) (@sepcon A N2 S2 P Q)) =
-  (@sepcon (environ->A) _ _
-     (@liftx (LiftEnviron A) P)
-     (@liftx (LiftEnviron A) Q)).
-Proof. reflexivity. Qed.
-
-Lemma lift0_later {A}{NA: NatDed A}{IA: Indir A}:
-  forall P:A,
-   lift0 (@later A NA IA P) = later  (lift0 P).
-Proof. intros. reflexivity. Qed.
-
-Lemma lift0C_later {A}{NA: NatDed A}{IA: Indir A}:
-  forall P:A,
-   `(@later A NA IA P) = @later (environ->A) _ _ (`P).
-Proof. intros. reflexivity. Qed.
+Lemma lift0C_sepcon:
+ forall P Q,
+  assert_of (` (P ∗ Q)) = (assert_of (`P) ∗ assert_of (`Q)).
+Proof.
+  intros; apply assert_ext; intros; monPred.unseal; done.
+Qed.
 
-#[export] Hint Rewrite (@lift0C_sepcon mpred _ _) : norm.
-#[export] Hint Rewrite (@lift0C_andp mpred _) : norm.
-#[export] Hint Rewrite (@lift0C_exp mpred _) : norm.
-#[export] Hint Rewrite (@lift0C_later mpred _ _) : norm.
-#[export] Hint Rewrite (@lift0C_prop mpred _) : norm.
+Lemma lift0_later:
+  forall P,
+   assert_of (lift0 (▷ P)) = ▷ assert_of (lift0 P).
+Proof.
+  intros; apply assert_ext; intros; monPred.unseal; done.
+Qed.
 
-#[export] Hint Rewrite
-    @lift1_lift1_retval
-    @lift0_exp
-    @lift0_sepcon
-    @lift0_prop
-    @lift0_later
-    : norm2.
+Lemma lift0C_later:
+  forall P,
+   assert_of (`(▷ P)) = ▷ assert_of (`P).
+Proof.
+  intros; apply assert_ext; intros; monPred.unseal; done.
+Qed.
 
 Lemma fst_unfold: forall {A B} (x: A) (y: B), fst (x,y) = x.
 Proof. reflexivity. Qed.
 Lemma snd_unfold: forall {A B} (x: A) (y: B), snd (x,y) = y.
 Proof. reflexivity. Qed.
-#[export] Hint Rewrite @fst_unfold @snd_unfold : norm.
-
-Lemma eq_True:
-   forall (A: Prop), A -> (A=True).
-Proof.
-intros.
-apply prop_ext; intuition.
-Qed.
 
 Lemma derives_extract_PROP :
-  forall (P1: Prop) A P QR S,
-     (P1 -> A && PROPx P QR |-- S) ->
-     A && PROPx (P1::P) QR |-- S.
+  forall {B} (P1: Prop) (A : monPred B _) P QR S,
+     (P1 -> A ∧ PROPx P QR ⊢ S) ->
+     A ∧ PROPx(Σ := Σ) (P1 :: P) QR ⊢ S.
 Proof.
 unfold PROPx in *.
 intros.
 rewrite fold_right_cons.
+go_lowerx.
 normalize.
-eapply derives_trans; [ | apply H; auto].
+rewrite -H //.
+monPred.unseal.
 normalize.
 Qed.
 
-Lemma local_andp_prop:  forall P Q, local P && prop Q = prop Q && local P.
-Proof. intros. apply andp_comm. Qed.
-Lemma local_andp_prop1: forall P Q R, local P && (prop Q && R) = prop Q && (local P && R).
-Proof. intros. rewrite andp_comm. rewrite andp_assoc. f_equal. apply andp_comm. Qed.
-#[export] Hint Rewrite local_andp_prop local_andp_prop1 : norm2.
+Lemma local_andp_prop:  forall P Q, (local P ∧ ⌜Q⌝) = (⌜Q⌝ ∧ local P).
+Proof. intros. apply and_comm'. Qed.
+Lemma local_andp_prop1: forall P Q R, (local P ∧ (⌜Q⌝ ∧ R)) = (⌜Q⌝ ∧ (local P ∧ R)).
+Proof. intros. rewrite and_comm'. rewrite -and_assoc'. f_equiv. apply and_comm'. Qed.
 
 Lemma local_sepcon_assoc1:
-   forall P Q R, (local P && Q) * R = local P && (Q * R).
+   forall P Q R, ((local P ∧ Q) ∗ R) = (local P ∧ (Q ∗ R)).
 Proof.
-intros.
-extensionality rho; unfold local, lift1; simpl.
-apply pred_ext; normalize.
+  intros; rewrite local_and_sep_assoc //.
 Qed.
 Lemma local_sepcon_assoc2:
-   forall P Q R, R * (local P && Q) = local P && (R * Q).
+   forall P Q R, (R ∗ (local P ∧ Q)) = (local P ∧ (R ∗ Q)).
 Proof.
-intros.
-extensionality rho; unfold local, lift1; simpl.
-apply pred_ext; normalize.
+  intros; rewrite local_and_sep_assoc' //.
 Qed.
-#[export] Hint Rewrite local_sepcon_assoc1 local_sepcon_assoc2 : norm2.
-
-Definition do_canon (x y : environ->mpred) := (sepcon x y).
 
-Ltac strip1_later P cP :=
- lazymatch P with
- | do_canon ?L ?R =>
-     let cL := (fun L' =>
-          let cR := (fun R' => let P' := constr:(do_canon L' R') in cP P')
-           in  strip1_later R cR)
-      in strip1_later L cL
- | PROPx ?A ?QR =>
-           let cQR := (fun QR' => let P' := constr:(PROPx A QR') in cP P')
-            in strip1_later QR cQR
- | LOCALx ?Q ?R =>
-           let cR := (fun R' => let P' := constr:(LOCALx Q R') in cP P')
-            in strip1_later R cR
- | @SEPx environ ?R =>
-    let cR := fun R' => (let P' := constr:(@SEPx environ R') in cP P') in
-     strip1_later R cR
- | ?L :: ?R =>
-      let cL := (fun L' =>
-          let cR := (fun R' => let P' := constr:(L'::R') in cP P') in
-          strip1_later R cR)
-       in strip1_later L cL
- | ?L && ?R =>
-      let cL := (fun L' =>
-          let cR := (fun R' => let P' := constr:(L'&&R') in cP P') in
-          strip1_later R cR)
-       in strip1_later L cL
- | sepcon ?L ?R =>
-      let cL := (fun L' =>
-          let cR := (fun R' => let P' := constr:(sepcon L' R') in cP P') in
-          strip1_later R cR)
-       in strip1_later L cL
- | |> ?L => cP L
- | _ => cP P
-end.
+Definition do_canon (x y : assert) := x ∗ y.
 
-Lemma andp_later_derives {A} {NA: NatDed A}{IA: Indir A}:
-  forall P Q P' Q': A, (P |-- |> P') -> (Q |-- |> Q') -> P && Q |-- |> (P' && Q').
+Lemma andp_later_derives:
+  forall {B : bi} (P Q P' Q' : B), (P ⊢ ▷ P') -> (Q ⊢ ▷ Q') -> P ∧ Q ⊢ ▷ (P' ∧ Q').
 Proof.
-intros. rewrite later_andp. apply andp_derives; auto. Qed.
+  intros ????? -> ->; auto.
+Qed.
 
-Lemma sepcon_later_derives {A} {NA: NatDed A}{SL: SepLog A}{IA: Indir A}{SI: SepIndir A}:
-  forall P Q P' Q': A, (P |-- |> P') -> (Q |-- |> Q') -> P * Q |-- |> (P' * Q').
+Lemma sepcon_later_derives:
+  forall {B : bi} (P Q P' Q': B), (P ⊢ ▷ P') -> (Q ⊢ ▷ Q') -> P ∗ Q ⊢ ▷ (P' ∗ Q').
 Proof.
-intros. rewrite later_sepcon. apply sepcon_derives; auto. Qed.
-
-#[export] Hint Resolve andp_later_derives sepcon_later_derives sepcon_derives
-              andp_derives imp_derives now_later derives_refl: derives.
+  intros ????? -> ->; auto.
+Qed.
 
-(* Definitions of convertPre and NDmk_funspec' are to support
+(* Definitions of convertPre and mk_funspec' are to support
   compatibility with old-style funspecs (see funspec_old.v) *)
-Definition convertPre (f: funsig) A
-  (Pre: A -> environ -> mpred)  (w: A) (ae: argsEnviron) : mpred :=
- !! (length (snd ae) = length (fst f)) &&
+Definition convertPre' (f: funsig) A
+  (Pre: A -> assert)  (w: A) (ae: argsEnviron) : mpred :=
+ ⌜length (snd ae) = length (fst f)⌝ ∧
  Pre w (make_args (map fst (fst f)) (snd ae)
-    (mkEnviron (fst ae)   (Map.empty (block*type)) (Map.empty val))).
+    (mkEnviron (fst ae) (Map.empty (block*type)) (Map.empty val))).
 
-Definition NDmk_funspec' (f: funsig) (cc: calling_convention)
-  (A: Type) (Pre Post: A -> environ -> mpred): funspec :=
-  NDmk_funspec (compcert_rmaps.typesig_of_funsig f) cc
+Definition convertPre f A Pre w := argsassert_of (convertPre' f A Pre w).
+
+Definition mk_funspec' (f: funsig) (cc: calling_convention)
+  (A: Type) (Pre Post: A -> assert): funspec :=
+  NDmk_funspec (typesig_of_funsig f) cc
   A (convertPre f A Pre) Post.
 
-Declare Scope funspec_scope.
-Delimit Scope funspec_scope with funspec.
-Global Open Scope funspec_scope.
+Fixpoint split_as_gv_temps (l: list localdef) : option ((list globals) * (list (ident * val))) :=
+  match l with
+    nil => Some (nil, nil)
+  | temp i v :: l' => match split_as_gv_temps l' with
+                        None => None
+                      | Some (gvs, temps) => Some (gvs, (i,v)::temps)
+                      end
+  | lvar i t v :: l' => None
+  | gvars g :: l' =>  match split_as_gv_temps l' with
+                        None => None
+                      | Some (gvs, temps) => Some (g::gvs, temps)
+                      end
+end.
 
-Notation "'DECLARE' x s" := (x: ident, s: funspec)
-   (at level 160, x at level 0, s at level 150, only parsing).
+Definition ImpossibleFunspec :=
+   NDmk_funspec (nil,Tvoid) cc_default (Impossible)
+        (fun _ => False : argsassert) (fun _ => False : assert).
 
-Definition NDsemax_external {Hspec: OracleKind} (ef: external_function)
-  (A: Type) (P:A -> argsEnviron -> mpred) (Q: A -> environ -> mpred): Prop :=
-  @semax_external Hspec ef (rmaps.ConstType A) (fun _ => P) (fun _ => Q).
+Lemma prop_true_andp1 :
+  forall {B : bi} (P1 P2: Prop) (Q : B),
+    P1 -> (⌜P1 /\ P2⌝ ∧ Q) = (⌜P2⌝ ∧ Q).
+Proof.
+  intros; f_equal; f_equal; apply prop_ext; tauto.
+Qed.
 
-Notation "'WITH' x : tx 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default tx (fun x => P%argsassert) (fun x => Q%assert))
-            (at level 200, x at level 0, P at level 100, Q at level 100) : funspec_scope.
+Lemma and_assoc': forall A B C: Prop,
+  ((A /\ B) /\ C) = (A /\ (B /\ C)).
+Proof.
+intros. apply prop_ext; symmetry; apply and_assoc.
+Qed.
 
-Notation "'WITH' x : tx 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec (nil, tz) cc_default tx (fun x => P%argsassert) (fun x => Q%assert))
-            (at level 200, x at level 0, P at level 100, Q at level 100) : funspec_scope.
+Definition splittablex (A: Prop) := True%type.
 
-Notation "'WITH'  x1 : t1 , x2 : t2 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default (t1*t2)
-           (fun x => match x with (x1,x2) => P%argsassert end)
-           (fun x => match x with (x1,x2) => Q%assert end))
-            (at level 200, x1 at level 0, x2 at level 0, P at level 100, Q at level 100) : funspec_scope.
+Lemma and_assoc_splittablex: forall {BI : bi} (A B C: Prop),
+    splittablex (A /\ B) ->
+  (⌜(A /\ B) /\ C⌝ : BI) = ⌜A /\ (B /\ C)⌝.
+Proof.
+intros. rewrite and_assoc'; auto.
+Qed.
 
-Notation "'WITH'  x1 : t1 , x2 : t2 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec (nil, tz) cc_default (t1*t2)
-           (fun x => match x with (x1,x2) => P%argsassert end)
-           (fun x => match x with (x1,x2) => Q%assert end))
-            (at level 200, x1 at level 0, x2 at level 0, P at level 100, Q at level 100) : funspec_scope.
+Lemma and_assoc'': forall {BI : bi} (A B C: Prop),
+  (⌜(A /\ B) /\ C⌝ : BI) = ⌜A /\ (B /\ C)⌝.
+Proof.
+intros. rewrite and_assoc'; auto.
+Qed.
 
-Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default (t1*t2*t3)
-           (fun x => match x with (x1,x2,x3) => P%argsassert end)
-           (fun x => match x with (x1,x2,x3) => Q%assert end))
-            (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, P at level 100, Q at level 100) : funspec_scope.
+Lemma prop_and1:
+  forall {BI : bi} (P Q : Prop), P -> (⌜P /\ Q⌝ : BI) = ⌜Q⌝.
+Proof.
+ intros. f_equiv; apply prop_ext; tauto.
+Qed.
 
-Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec (nil, tz) cc_default (t1*t2*t3)
-           (fun x => match x with (x1,x2,x3) => P%argsassert end)
-           (fun x => match x with (x1,x2,x3) => Q%assert end))
-            (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, P at level 100, Q at level 100) : funspec_scope.
+Lemma subst_make_args':
+  forall  {cs: compspecs}  id v (P: assert) fsig tl el,
+  length tl = length el ->
+  length (fst fsig) = length el ->
+  assert_of (subst id v (fun rho => P (make_args' fsig (eval_exprlist tl el) rho))) =
+           assert_of (fun rho => P (make_args' fsig (subst id v (eval_exprlist tl el)) rho)).
+Proof.
+  intros; apply assert_ext; intros; rewrite /subst; simpl.
+  f_equiv. unfold make_args'.
+  revert tl el H H0; induction (fst fsig); destruct tl,el; simpl; intros; inv H.
+  reflexivity.
+  rewrite IHl //.
+Qed.
+
+Lemma map_cons: forall {A B} (f: A -> B) x y,
+   map f (x::y) = f x :: map f y.
+Proof. reflexivity. Qed.
+
+Lemma map_nil: forall {A B} (f: A -> B), map f nil = nil.
+Proof. reflexivity. Qed.
+
+
+Definition rlt_ident_eq := ident_eq.  (* for convenience in selectively simplifying *)
+
+Fixpoint remove_localdef_temp (i: ident) (l: list localdef) : list localdef :=
+  match l with
+  | nil => nil
+  | d :: l0 =>
+     let rest := remove_localdef_temp i l0 in
+     match d with
+     | temp j v =>
+       if rlt_ident_eq i j
+       then rest
+       else d :: rest
+     | _ => d :: rest
+     end
+  end.
+
+Lemma subst_stackframe_of:
+  forall {cs: compspecs} i v f, assert_of (subst i v (stackframe_of f)) = stackframe_of f.
+Proof.
+  unfold stackframe_of; simpl; intros.
+  unfold subst.
+  intros; apply assert_ext; intros; simpl.
+  induction (fn_vars f); simpl; [|revert IHl]; unfold var_block; monPred.unseal; first done; intros; simpl.
+  rewrite IHl.
+  rewrite /var_block; done.
+Qed.
+
+Lemma remove_localdef_temp_PROP: forall (i: ident) P Q R,
+  (∃ old: val, assert_of (subst i `(old) (PROPx P (LOCALx Q (SEPx R))))) ⊢
+  PROPx P (LOCALx (remove_localdef_temp i Q) (SEPx R)).
+Proof.
+  intros.
+  split => rho; rewrite /subst /PROPx /LOCALx /SEPx; monPred.unseal.
+  iIntros "(% & $ & H & $)".
+  iSplit; last done.
+  iApply (bi.pure_mono with "H").
+  induction Q; simpl fold_right.
+  + autorewrite with subst norm; auto.
+  + intros (? & ?%IHQ).
+    unfold locald_denote in H.
+    destruct a; [if_tac | ..];
+    autorewrite with subst norm; simpl; super_unfold_lift; auto.
+    split; auto.
+    rewrite eval_id_other // in H.
+Qed.
+
+Lemma eval_id_denote_tc_initialized: forall Delta i t v,
+  (temp_types Delta) !! i = Some t ->
+  local (tc_environ Delta) ∧ local (`and (`(eq v) (eval_id i)) `(v <> Vundef)) ⊢ assert_of (denote_tc_initialized i t).
+Proof.
+  intros.
+  split => rho; rewrite /local /lift1; monPred.unseal; unfold_lift.
+  iIntros "((%TC & % & %) & %Hv & %)"; iPureIntro.
+  destruct (TC _ _ H) as (? & Hi & Ht).
+  rewrite /eval_id Hi in Hv; simpl in *; subst; eauto.
+Qed.
+
+Lemma PQR_denote_tc_initialized: forall Delta i t v P Q R,
+  (temp_types Delta) !! i = Some t ->
+  local (tc_environ Delta) ∧ PROPx P (LOCALx (temp i v :: Q) R) ⊢ assert_of (denote_tc_initialized i t).
+Proof.
+  intros.
+  rewrite -eval_id_denote_tc_initialized //.
+  apply bi.and_mono; first done.
+  rewrite <- insert_local'.
+  rewrite bi.and_elim_l //.
+Qed.
+
+Notation LOCALx := (@LOCALx Σ).
+
+Lemma derives_remove_localdef_PQR: forall P Q R i,
+  PROPx P (LOCALx Q (SEPx R)) ⊢ PROPx P (LOCALx (remove_localdef_temp i Q) (SEPx R)).
+Proof.
+  intros.
+  go_lowerx.
+  apply bi.and_intro; auto.
+  apply bi.pure_intro.
+  clear H; rename H0 into H.
+  induction Q; simpl in *; auto.
+  destruct a; try now (destruct H; simpl in *; split; auto).
+  destruct H.
+  if_tac; simpl in *; auto.
+Qed.
+
+Lemma subst_PROP_LOCAL_SEP : forall P Q R i v,
+  assert_of (subst i v (PROPx P (LOCALx Q (SEPx R)))) ≡ PROPx P ((seplog.local (subst i v (foldr (` and) (` True%type) (map locald_denote Q)))) ∧ SEPx R).
+Proof.
+  intros; rewrite /subst /PROPx /LOCALx /SEPx.
+  split => rho; simpl; monPred.unseal; done.
+Qed.
+
+Lemma subst_remove_localdef_PQR: forall P Q R i v,
+  assert_of (subst i v (PROPx P (LOCALx (remove_localdef_temp i Q) (SEPx R)))) ⊢ PROPx P (LOCALx (remove_localdef_temp i Q) (SEPx R)).
+Proof.
+  intros.
+  rewrite subst_PROP_LOCAL_SEP.
+  apply bi.and_mono; first done.
+  apply bi.and_mono; last done.
+  split => rho; apply bi.pure_mono.
+  intros H.
+  induction Q; simpl in *; auto.
+  destruct a; try now (destruct H; simpl in *; split; auto).
+  if_tac; simpl in *; auto.
+  destruct H; split; auto.
+  unfold_lift in H.
+  destruct H; subst.
+  unfold_lift. rewrite -> eval_id_other in * by auto.
+  auto.
+Qed.
+
+Fixpoint iota_formals (i: ident) (tl: list type) :=
+ match tl with
+ | t :: tl' => (i,t) :: iota_formals (i+1)%positive tl'
+ | nil => nil
+ end.
+
+Lemma isptr_force_ptr'' : forall p Q,
+    (isptr p -> Q) ->
+    (isptr (force_ptr p) -> Q).
+Proof.
+intros.
+apply X.
+destruct p; inv H; apply Coq.Init.Logic.I.
+Qed.
+
+Lemma isptr_offset_val'': forall i p Q,
+    (isptr p -> Q) ->
+    (isptr (offset_val i p) -> Q).
+Proof.
+intros.
+apply X.
+destruct p; inv H; apply Coq.Init.Logic.I.
+Qed.
+
+Lemma ptr_eq_e': forall v1 v2 B,
+   (v1=v2 -> B) ->
+   (ptr_eq v1 v2 -> B).
+Proof.
+intuition. apply X. apply ptr_eq_e; auto.
+Qed.
+
+Lemma typed_false_of_bool':
+ forall x (P: Prop),
+    ((x=false) -> P) ->
+    (typed_false tint (bool2val x) -> P).
+Proof.
+intuition.
+apply H, typed_false_of_bool; auto.
+Qed.
+
+Lemma typed_true_of_bool':
+ forall x (P: Prop),
+    ((x=true) -> P) ->
+    (typed_true tint (bool2val x) -> P).
+Proof.
+intuition.
+apply H, typed_true_of_bool; auto.
+Qed.
+
+Lemma saturate_aux20:
+ forall (P Q: mpred) P' Q' ,
+    (P ⊢ ⌜P'⌝) ->
+    (Q ⊢ ⌜Q'⌝) ->
+    P ∗ Q ⊢ ⌜P' /\ Q'⌝.
+Proof.
+intros ???? -> ->; auto.
+Qed.
+
+Lemma saturate_aux21x:
+  forall (P Q S: mpred),
+   (P ⊢ S) ->
+   (S ∧ P ⊢ Q) -> P ⊢ Q.
+Proof.
+intros ???? <-; apply bi.and_intro; auto.
+Qed.
+
+Lemma prop_right_emp:
+ forall {BI : bi} (P: Prop), P -> (emp : BI) ⊢ ⌜P⌝.
+Proof. intros. auto. Qed.
+
+Lemma prop_and_right:
+ forall {BI : bi} (U: BI) (X Y: Prop),
+    X ->
+    (U ⊢ ⌜Y⌝) ->
+    U ⊢ ⌜X /\ Y⌝.
+Proof. intros ????? ->; auto. Qed.
+
+Lemma fold_right_sepcon_subst:
+ forall i e (R : list assert), fold_right bi_sep emp (map (fun r : assert => assert_of (subst i e r)) R) = assert_of (subst i e (fold_right bi_sep emp R)).
+Proof.
+ intros. induction R; simpl.
+ - apply assert_ext; intros; monPred.unseal; auto.
+ - autorewrite with subst. f_equiv; auto.
+Qed.
+
+Lemma unsigned_eq_eq: forall i j, Int.unsigned i = Int.unsigned j -> i = j.
+Proof.
+  intros.
+  rewrite <- (Int.repr_unsigned i), <- (Int.repr_unsigned j).
+  rewrite H.
+  reflexivity.
+Qed.
+
+Lemma wand_join:
+  forall {BI : bi} (x1 x2 y1 y2: BI),
+    (x1 -∗ y1) ∗ (x2 -∗ y2) ⊢ ((x1 ∗ x2) -∗ (y1 ∗ y2)).
+Proof.
+  intros; iIntros "(H1 & H2) (? & ?)".
+  iPoseProof ("H1" with "[$]") as "$".
+  iPoseProof ("H2" with "[$]") as "$".
+Qed.
+
+Lemma wand_sepcon:
+ forall {BI : bi} (P Q : BI),
+   (P -∗ Q ∗ P) ∗ P ⊣⊢ Q ∗ P.
+Proof.
+  intros; iSplit.
+  - by iIntros "(H & ?)"; iApply "H".
+  - iIntros "($ & ?)"; iSplitL ""; auto.
+Qed.
+
+Lemma wand_sepcon':
+ forall {BI : bi} (P Q : BI),
+   P ∗ (P -∗ Q ∗ P) ⊣⊢ P ∗ Q.
+Proof.
+  intros; rewrite comm wand_sepcon comm //.
+Qed.
+
+Lemma replace_nth_overflow: forall {A} n l (v : A), (~n < length l)%nat -> replace_nth n l v = l.
+Proof.
+  induction n; destruct l; simpl; auto; intros.
+  - lia.
+  - rewrite IHn //; lia.
+Qed.
+
+(* up *)
+Lemma embed_exist : forall {A} (P : A -> mpred), (⎡∃ x : A, P x⎤ : assert) = ∃ x, ⎡P x⎤.
+Proof.
+  intros; apply assert_ext; intros; monPred.unseal; auto.
+Qed.
+
+Lemma derives_extract_PROP' :
+  forall {A} (P1: Prop) P QR (S : monPred A _),
+     (P1 -> PROPx P QR ⊢ S) ->
+     PROPx(Σ := Σ) (P1::P) QR ⊢ S.
+Proof.
+  intros.
+  rewrite -(bi.True_and (PROPx _ _)).
+  apply derives_extract_PROP; intros; rewrite bi.and_elim_r; auto.
+Qed.
+
+End mpred.
+
+Section VST.
+
+Context `{!VSTGS OK_ty Σ}.
+
+Lemma semax_later_trivial: forall {OK_spec} {cs: compspecs} E Delta P c Q,
+  semax(C := cs)(OK_spec := OK_spec) E Delta (▷ P) c Q ->
+  semax E Delta P c Q.
+Proof.
+ intros until Q.
+ apply semax_pre0; auto.
+Qed.
+
+Lemma extract_nth_exists_in_SEP:
+  forall n P Q (R: list mpred)
+              {A} (S: A -> mpred),
+   nth n R emp = (∃ x, S x) ->
+   PROPx P (LOCALx Q (SEPx R)) =
+   ∃ x, PROPx P (LOCALx Q (SEPx (replace_nth n R (S x)))).
+Proof.
+  intros.
+  destruct (lt_dec n (length R)).
+  - eapply nth_error_nth in l; setoid_rewrite H in l.
+    erewrite SEP_nth_isolate, PROP_LOCAL_SEP_cons by done.
+    rewrite embed_exist //. rewrite sep_exist_r'.
+    f_equiv; extensionality.
+    setoid_rewrite <- PROP_LOCAL_SEP_cons.
+    erewrite <- SEP_replace_nth_isolate; done.
+  - rewrite nth_overflow in H; last lia.
+    apply assert_ext; intros; rewrite /PROPx /LOCALx /SEPx; monPred.unseal.
+    rewrite -!and_exist_l; f_equal; f_equal.
+    assert (exists x : A, True%type) as [a _].
+    { apply (ouPred.soundness(M := iResUR Σ) _ 0).
+      rewrite /bi_emp_valid H; iIntros "(% & ?)"; eauto. }
+    rewrite -(exp_trivial a (fold_right_sepcon R)); f_equal; extensionality.
+    rewrite replace_nth_overflow //.
+Qed.
+
+End VST.
+
+#[export] Hint Resolve func_ptr_isptr: saturate_local.
+#[export] Hint Resolve SeparationLogic.func_ptr_valid_pointer: valid_pointer.
+#[export] Hint Rewrite @lift0_unfold @lift1_unfold @lift2_unfold @lift3_unfold @lift4_unfold : norm2.
+#[export] Hint Rewrite @lift0_unfoldC @lift1_unfoldC @lift2_unfoldC @lift3_unfoldC @lift4_unfoldC : norm2.
+#[export] Hint Rewrite @alift0_unfold @alift1_unfold @alift2_unfold @alift3_unfold @alift4_unfold : norm2.
+#[export] Hint Rewrite @subst_lift0' : subst.
+#[export] Hint Rewrite @subst_lift0 @subst_lift0C : subst.
+#[export] Hint Rewrite @subst_lift1 @subst_lift1C  : subst.
+#[export] Hint Rewrite @subst_lift2 @subst_lift2C : subst.
+#[export] Hint Rewrite @subst_lift3 @subst_lift3C : subst.
+#[export] Hint Rewrite @subst_lift4 @subst_lift4C : subst.
+
+#[export] Hint Rewrite eval_id_same : norm.
+#[export] Hint Rewrite eval_id_other using solve [clear; intro Hx; inversion Hx] : norm.
+#[export] Hint Rewrite simpl_get_result1: norm.
+#[export] Hint Rewrite retval_get_result1 : norm.
+#[export] Hint Rewrite retval_lemma1 : norm.
+#[export] Hint Rewrite retval_make_args: norm2.
+(*#[export] Hint Rewrite andp_makeargs: norm2.
+#[export] Hint Rewrite local_makeargs: norm2.
+#[export] Hint Rewrite liftx_local_retval : norm2.*)
+#[export] Hint Rewrite bool_val_notbool_ptr using apply Coq.Init.Logic.I : norm.
+#[export] Hint Rewrite typed_true_isptr using apply Coq.Init.Logic.I : norm.
+
+Ltac super_unfold_lift_in H :=
+   cbv delta [liftx LiftEnviron Tarrow Tend lift_S lift_T
+    lift_prod lift_last lifted lift_uncurry_open lift_curry lift lift0
+    lift1 lift2 lift3] beta iota in H.
+
+Ltac super_unfold_lift' :=
+  cbv delta [liftx LiftEnviron Tarrow Tend lift_S lift_T
+    lift_prod lift_last lifted lift_uncurry_open lift_curry lift lift0
+    lift1 lift2 lift3] beta iota.
+
+Tactic Notation "name" ident(s) constr(id) :=
+    idtac "Warning: the 'name' tactic no loger does anything useful, and will be removed in future versions of VST".
+
+Definition abbreviate {A:Type} (x:A) := x.
+Arguments abbreviate {A} {x}.
+
+Ltac clear_Delta :=
+match goal with
+| Delta := @abbreviate tycontext ?G |- _ =>
+   try match goal with |- context [ret_type Delta] =>
+      let x := constr:(ret_type G) in let x := eval hnf in x
+       in change (ret_type Delta) with x in *
+   end;
+   try clear Delta
+| _ => idtac
+end;
+match goal with
+ |  DS := @abbreviate (Maps.PTree.t funspec) _  |- _ =>
+   first [clear DS | clearbody DS]
+ | |- _ => idtac
+ end.
+
+Ltac clear_Delta_specs :=
+ lazymatch goal with
+ |  DS := @abbreviate (Maps.PTree.t funspec) _  |- _ => clearbody DS
+ | |- _ => idtac
+ end.
+
+#[export] Hint Rewrite sem_cast_pointer2' using (try apply Coq.Init.Logic.I; try assumption; reflexivity) : norm.
+#[export] Hint Rewrite is_pointer_or_null_force_int_ptr using assumption : norm1.
+#[export] Hint Rewrite is_pointer_force_int_ptr using assumption : norm1.
+#[export] Hint Rewrite is_pointer_or_null_match using assumption : norm1.
+#[export] Hint Rewrite is_pointer_force_int_ptr2 using assumption : norm1.
+#[export] Hint Rewrite is_pointer_or_null_force_int_ptr2 using assumption : norm1.
+#[export] Hint Rewrite isptr_match : norm1.
+#[export] Hint Rewrite eval_cast_neutral_tc_val using solve [eauto] : norm.
+#[export] Hint Rewrite eval_cast_neutral_is_pointer_or_null using assumption : norm.
+#[export] Hint Rewrite is_pointer_or_null_eval_cast_neutral : norm.
+#[export] Hint Rewrite eval_cast_neutral_isptr using assumption : norm.
+(*#[export] Hint Rewrite simpl_and_get_result1 : norm2.*)
+
+Arguments ret_type {_ _} !Delta /.
+
+Arguments Datatypes.id {A} x / .
+
+#[export] Hint Rewrite @raise_sepcon : norm1.
+#[export] Hint Rewrite @lift_lift_retval: norm2.
+#[export] Hint Rewrite lift_lift_x : norm2.
+#[export] Hint Rewrite @lift0_exp : norm2.
+#[export] Hint Rewrite @lift0C_exp : norm2.
+#[export] Hint Rewrite @lift0C_sepcon : norm.
+#[export] Hint Rewrite @lift0C_andp : norm.
+#[export] Hint Rewrite @lift0C_exp : norm.
+#[export] Hint Rewrite @lift0C_later : norm.
+#[export] Hint Rewrite @lift0C_prop : norm.
+
+#[export] Hint Rewrite
+    @lift1_lift1_retval
+    @lift0_exp
+    @lift0_sepcon
+    @lift0_prop
+    @lift0_later
+    : norm2.
+
+Lemma derives_refl {BI : bi} (P : BI) : P ⊢ P.
+Proof. done. Qed.
+
+#[export] Hint Rewrite @fst_unfold @snd_unfold : norm.
+#[export] Hint Rewrite @local_andp_prop @local_andp_prop1 : norm2.
+#[export] Hint Rewrite @local_sepcon_assoc1 @local_sepcon_assoc2 : norm2.
+#[export] Hint Resolve andp_later_derives sepcon_later_derives bi.sep_mono
+              bi.and_mono bi.impl_mono bi.later_intro derives_refl: derives.
+#[export] Hint Rewrite @prop_true_andp1 using solve [auto 3 with typeclass_instances]: norm1.
+#[export] Hint Rewrite @prop_true_andp1 using assumption : norm.
+
+Ltac strip1_later P cP :=
+ lazymatch P with
+ | do_canon ?L ?R =>
+     let cL := (fun L' =>
+          let cR := (fun R' => let P' := constr:(do_canon L' R') in cP P')
+           in  strip1_later R cR)
+      in strip1_later L cL
+ | PROPx ?A ?QR =>
+           let cQR := (fun QR' => let P' := constr:(PROPx A QR') in cP P')
+            in strip1_later QR cQR
+ | LOCALx ?Q ?R =>
+           let cR := (fun R' => let P' := constr:(LOCALx Q R') in cP P')
+            in strip1_later R cR
+ | @SEPx ?A ?Σ ?R =>
+    let cR := fun R' => (let P' := constr:(@SEPx A Σ R') in cP P') in
+     strip1_later R cR
+ | ?L :: ?R =>
+      let cL := (fun L' =>
+          let cR := (fun R' => let P' := constr:(L'::R') in cP P') in
+          strip1_later R cR)
+       in strip1_later L cL
+ | ?L ∧ ?R =>
+      let cL := (fun L' =>
+          let cR := (fun R' => let P' := constr:(L'∧R') in cP P') in
+          strip1_later R cR)
+       in strip1_later L cL
+ | ?L ∗ ?R =>
+      let cL := (fun L' =>
+          let cR := (fun R' => let P' := constr:(L' ∗ R') in cP P') in
+          strip1_later R cR)
+       in strip1_later L cL
+ | ▷ ?L => cP L
+ | _ => cP P
+end.
+
+Declare Scope funspec_scope.
+Delimit Scope funspec_scope with funspec.
+Global Open Scope funspec_scope.
+
+Notation "'DECLARE' x s" := (x: ident, s: funspec)
+   (at level 160, x at level 0, s at level 150, only parsing).
+
+Definition NDsemax_external `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} (ef: external_function)
+  (A: Type) E (P:A -> argsassert) (Q: A -> assert): Prop :=
+  ⊢ semax_external ef (ConstType A) E (λne (x : leibnizO A), P x : _ -d> mpred) (λne (x : leibnizO A), Q x : _ -d> mpred).
+
+Notation "'WITH' x : tx 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
+     (NDmk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default tx (fun x => P%argsassert) (fun x => Q%assert))
+            (at level 200, x at level 0, P at level 100, Q at level 100) : funspec_scope.
+
+Notation "'WITH' x : tx 'PRE'  [ ] P 'POST' [ tz ] Q" :=
+     (NDmk_funspec (nil, tz) cc_default tx (fun x => P%argsassert) (fun x => Q%assert))
+            (at level 200, x at level 0, P at level 100, Q at level 100) : funspec_scope.
+
+Notation "'WITH'  x1 : t1 , x2 : t2 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
+     (NDmk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default (t1*t2)
+           (fun x => match x with (x1,x2) => P%argsassert end)
+           (fun x => match x with (x1,x2) => Q%assert end))
+            (at level 200, x1 at level 0, x2 at level 0, P at level 100, Q at level 100) : funspec_scope.
+
+Notation "'WITH'  x1 : t1 , x2 : t2 'PRE'  [ ] P 'POST' [ tz ] Q" :=
+     (NDmk_funspec (nil, tz) cc_default (t1*t2)
+           (fun x => match x with (x1,x2) => P%argsassert end)
+           (fun x => match x with (x1,x2) => Q%assert end))
+            (at level 200, x1 at level 0, x2 at level 0, P at level 100, Q at level 100) : funspec_scope.
+
+Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
+     (NDmk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default (t1*t2*t3)
+           (fun x => match x with (x1,x2,x3) => P%argsassert end)
+           (fun x => match x with (x1,x2,x3) => Q%assert end))
+            (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, P at level 100, Q at level 100) : funspec_scope.
+
+Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 'PRE'  [ ] P 'POST' [ tz ] Q" :=
+     (NDmk_funspec (nil, tz) cc_default (t1*t2*t3)
+           (fun x => match x with (x1,x2,x3) => P%argsassert end)
+           (fun x => match x with (x1,x2,x3) => Q%assert end))
+            (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, P at level 100, Q at level 100) : funspec_scope.
 
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
@@ -1362,200 +1644,165 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
 (* Notations for dependent funspecs *)
 
 Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (mk_funspec (nil, tz) cc_default A
-  (fun (ts: list Type) (x: t1*t2) =>
+     (mk_funspec (nil, tz) cc_default A (λne _, ⊤)
+  (λne (x: t1*t2),
      match x with (x1,x2) => P%argsassert end)
-  (fun (ts: list Type) (x: t1*t2) =>
-     match x with (x1,x2) => Q%assert end) _ _)
+  (λne (x: t1*t2),
+     match x with (x1,x2) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0,
              P at level 100, Q at level 100).
 
 Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A
-  (fun (ts: list Type) (x: t1*t2) =>
+     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A (λne _, ⊤)
+  (λne (x: t1*t2),
      match x with (x1,x2) => P%argsassert end)
-  (fun (ts: list Type) (x: t1*t2) =>
-     match x with (x1,x2) => Q%assert end) _ _)
+  (λne (x: t1*t2),
+     match x with (x1,x2) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0,
              P at level 100, Q at level 100).
 
 Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A
-  (fun (ts: list Type) (x: t1*t2*t3) =>
+     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A (λne _, ⊤)
+  (λne (x: t1*t2*t3),
      match x with (x1,x2,x3) => P%argsassert end)
-  (fun (ts: list Type) (x: t1*t2*t3) =>
-     match x with (x1,x2,x3) => Q%assert end) _ _)
+  (λne (x: t1*t2*t3),
+     match x with (x1,x2,x3) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0,
              P at level 100, Q at level 100).
 
 Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (mk_funspec (nil, tz) cc_default A
-  (fun (ts: list Type) (x: t1*t2*t3) =>
+     (mk_funspec (nil, tz) cc_default A (λne _, ⊤)
+  (λne (x: t1*t2*t3),
      match x with (x1,x2,x3) => P%argsassert end)
-  (fun (ts: list Type) (x: t1*t2*t3) =>
-     match x with (x1,x2,x3) => Q%assert end) _ _)
+  (λne (x: t1*t2*t3),
+     match x with (x1,x2,x3) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0,
              P at level 100, Q at level 100).
 
 Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A
-  (fun (ts: list Type) (x: t1*t2*t3*t4) =>
+     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A (λne _, ⊤)
+  (λne (x: t1*t2*t3*t4),
      match x with (x1,x2,x3,x4) => P%argsassert end)
-  (fun (ts: list Type) (x: t1*t2*t3*t4) =>
-     match x with (x1,x2,x3,x4) => Q%assert end) _ _)
+  (λne (x: t1*t2*t3*t4),
+     match x with (x1,x2,x3,x4) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
              P at level 100, Q at level 100).
 
 Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A
-  (fun (ts: list Type) (x: t1*t2*t3*t4*t5) =>
+     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A (λne _, ⊤)
+  (λne (x: t1*t2*t3*t4*t5),
      match x with (x1,x2,x3,x4,x5) => P%argsassert end)
-  (fun (ts: list Type) (x: t1*t2*t3*t4*t5) =>
-     match x with (x1,x2,x3,x4,x5) => Q%assert end) _ _)
+  (λne (x: t1*t2*t3*t4*t5),
+     match x with (x1,x2,x3,x4,x5) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
              x5 at level 0,
              P at level 100, Q at level 100).
 
 Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A
-  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6) =>
+     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A (λne _, ⊤)
+  (λne (x: t1*t2*t3*t4*t5*t6),
      match x with (x1,x2,x3,x4,x5,x6) => P%argsassert end)
-  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6) =>
-     match x with (x1,x2,x3,x4,x5,x6) => Q%assert end) _ _)
+  (λne (x: t1*t2*t3*t4*t5*t6),
+     match x with (x1,x2,x3,x4,x5,x6) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
              x5 at level 0, x6 at level 0,
              P at level 100, Q at level 100).
 
 Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A
-  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7) =>
+     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A (λne _, ⊤)
+  (λne (x: t1*t2*t3*t4*t5*t6*t7),
      match x with (x1,x2,x3,x4,x5,x6,x7) => P%argsassert end)
-  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7) =>
-     match x with (x1,x2,x3,x4,x5,x6,x7) => Q%assert end) _ _)
+  (λne (x: t1*t2*t3*t4*t5*t6*t7),
+     match x with (x1,x2,x3,x4,x5,x6,x7) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
              x5 at level 0, x6 at level 0, x7 at level 0,
              P at level 100, Q at level 100).
 
 Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A
-  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8) =>
+     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A (λne _, ⊤)
+  (λne (x: t1*t2*t3*t4*t5*t6*t7*t8),
      match x with (x1,x2,x3,x4,x5,x6,x7,x8) => P%argsassert end)
-  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8) =>
-     match x with (x1,x2,x3,x4,x5,x6,x7,x8) => Q%assert end) _ _)
+  (λne (x: t1*t2*t3*t4*t5*t6*t7*t8),
+     match x with (x1,x2,x3,x4,x5,x6,x7,x8) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
              x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0,
              P at level 100, Q at level 100).
 
 Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A
-  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9) =>
+     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A (λne _, ⊤)
+  (λne (x: t1*t2*t3*t4*t5*t6*t7*t8*t9),
      match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9) => P%argsassert end)
-  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9) =>
-     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9) => Q%assert end) _ _)
+  (λne (x: t1*t2*t3*t4*t5*t6*t7*t8*t9),
+     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
              x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, x9 at level 0,
              P at level 100, Q at level 100).
 
 Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A
-  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10) =>
+     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A (λne _, ⊤)
+  (fun (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10) =>
      match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) => P%argsassert end)
-  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10) =>
-     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) => Q%assert end) _ _)
+  (fun (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10) =>
+     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
              x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, x9 at level 0, x10 at level 0,
              P at level 100, Q at level 100).
 
 Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A
-  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10) =>
+     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A (λne _, ⊤)
+  (fun (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10) =>
      match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) => P%argsassert end)
-  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10) =>
-     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) => Q%assert end) _ _)
+  (fun (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10) =>
+     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
              x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, x9 at level 0, x10 at level 0,
              P at level 100, Q at level 100).
 
 Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A
-  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11) =>
+     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A (λne _, ⊤)
+  (fun (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11) =>
      match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11) => P%argsassert end)
-  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11) =>
-     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11) => Q%assert end) _ _)
+  (fun (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11) =>
+     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
              x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, x9 at level 0,
               x10 at level 0, x11 at level 0,
              P at level 100, Q at level 100).
 
 Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A
-  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12) =>
+     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A (λne _, ⊤)
+  (fun (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12) =>
      match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12) => P%argsassert end)
-  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12) =>
-     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12) => Q%assert end) _ _)
+  (fun (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12) =>
+     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
              x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, x9 at level 0,
               x10 at level 0, x11 at level 0, x12 at level 0,
              P at level 100, Q at level 100).
 
 Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A
-  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13) =>
+     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A (λne _, ⊤)
+  (fun (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13) =>
      match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13) => P%argsassert end)
-  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13) =>
-     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13) => Q%assert end) _ _)
+  (fun (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13) =>
+     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
              x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, x9 at level 0,
               x10 at level 0, x11 at level 0, x12 at level 0, x13 at level 0,
-             P at level 100, Q at level 100).
-
-Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 , x14 : t14 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A
-  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14) =>
-     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14) => P%argsassert end)
-  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14) =>
-     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14) => Q%assert end) _ _)
-            (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
-             x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, x9 at level 0,
-              x10 at level 0, x11 at level 0, x12 at level 0, x13 at level 0, x14 at level 0,
-             P at level 100, Q at level 100).
-
-Fixpoint split_as_gv_temps (l: list localdef) : option ((list globals) * (list (ident * val))) :=
-  match l with
-    nil => Some (nil, nil)
-  | temp i v :: l' => match split_as_gv_temps l' with
-                        None => None
-                      | Some (gvs, temps) => Some (gvs, (i,v)::temps)
-                      end
-  | lvar i t v :: l' => None
-  | gvars g :: l' =>  match split_as_gv_temps l' with
-                        None => None
-                      | Some (gvs, temps) => Some (g::gvs, temps)
-                      end
-end.
-
-Definition ImpossibleFunspec :=
-   mk_funspec (nil,Tvoid) cc_default (rmaps.ConstType Impossible)
-        (fun _ _ => FF) (fun _ _ => FF)
-        (args_const_super_non_expansive _ _)
-        (const_super_non_expansive _ _).
-
-Notation LAMBDAx gs vals X := (PARAMSx vals (GLOBALSx gs X)) (only parsing).
+             P at level 100, Q at level 100).
 
-Lemma prop_true_andp1 {A}{NA: NatDed A} :
-  forall (P1 P2: Prop) Q ,
-    P1 -> (!! (P1 /\ P2) && Q = !!P2 && Q).
-Proof.
-intros. f_equal; auto.  f_equal.  apply prop_ext; tauto.
-Qed.
-#[export] Hint Rewrite prop_true_andp1 using solve [auto 3 with typeclass_instances]: norm1.
-#[export] Hint Rewrite prop_true_andp1 using assumption : norm.
+Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 , x14 : t14 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
+     (mk_funspec ((cons u%type .. (cons v%type nil) ..), tz) cc_default A (λne _, ⊤)
+  (fun (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14) =>
+     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14) => P%argsassert end)
+  (fun (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14) =>
+     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14) => Q%assert end))
+            (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
+             x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, x9 at level 0,
+              x10 at level 0, x11 at level 0, x12 at level 0, x13 at level 0, x14 at level 0,
+             P at level 100, Q at level 100).
 
-Lemma and_assoc': forall A B C: Prop,
-  ((A /\ B) /\ C) = (A /\ (B /\ C)).
-Proof.
-intros. apply prop_ext; apply and_assoc.
-Qed.
+Notation LAMBDAx gs vals X := (PARAMSx vals (GLOBALSx gs X)) (only parsing).
 
 Ltac splittablex_tac A :=
  match A with
@@ -1567,32 +1814,24 @@ Ltac splittablex_tac A :=
  | _ /\ _ => apply Logic.I
  end.
 
-Definition splittablex (A: Prop) := True.
-
-Lemma and_assoc_splittablex {T}{NT: NatDed T}: forall A B C: Prop,
-    splittablex (A /\ B) ->
-  !! ((A /\ B) /\ C) = !! (A /\ (B /\ C)).
-Proof.
-intros. rewrite and_assoc'; auto.
-Qed.
-
-Lemma and_assoc'' {T}{NT: NatDed T}: forall A B C: Prop,
-  !! ((A /\ B) /\ C) = !! (A /\ (B /\ C)).
-Proof.
-intros. rewrite and_assoc'; auto.
-Qed.
-
-
-#[export] Hint Rewrite and_assoc_splittablex using
+#[export] Hint Rewrite @and_assoc_splittablex using
     match goal with |- splittablex ?A => splittablex_tac A end : normalize.
-#[export] Hint Rewrite and_assoc_splittablex using
+#[export] Hint Rewrite @and_assoc_splittablex using
     match goal with |- splittablex ?A => splittablex_tac A end : gather_prop.
+#[export] Hint Rewrite @prop_and1 using solve [auto 3 with typeclass_instances] : norm2.
+#[export] Hint Rewrite @subst_make_args' using (solve[reflexivity]) : subst.
+#[export] Hint Rewrite @map_cons : norm.
+#[export] Hint Rewrite @map_cons : subst.
+#[export] Hint Rewrite @map_nil : norm.
+#[export] Hint Rewrite @map_nil : subst.
+#[export] Hint Rewrite @subst_stackframe_of : subst.
+#[export] Hint Rewrite @wand_sepcon @wand_sepcon' : norm.
 
 Ltac hoist_later_left :=
    match goal with
-  | |- (?P |-- _) =>
+  | |- (?P ⊢ _) =>
         let cP := (fun P' =>
-                   apply derives_trans with (|>P');
+                   trans (▷P');
                     [ solve [ auto 50 with derives ] | ])
      in strip1_later P cP
   end.
@@ -1609,21 +1848,11 @@ Tactic Notation "assert_PROP" constr(A) "as" simple_intropattern(H)  :=
 
 Tactic Notation "assert_PROP" constr(A) "as" simple_intropattern(H) "by" tactic1(t) :=
   first [eapply (assert_later_PROP' A); [|hoist_later_left; apply derives_refl|] | apply (assert_PROP' A)]; [ now t | intro H ].
-
-Lemma semax_later_trivial: forall Espec  {cs: compspecs} Delta P c Q,
-  @semax cs Espec Delta (|> P) c Q ->
-  @semax cs Espec Delta P c Q.
-Proof.
- intros until Q.
- apply semax_pre0.
-  apply now_later.
-Qed.
-
 Ltac hoist_later_in_pre :=
-     match goal with |- semax _ ?P _ _ =>
+     match goal with |- semax _ _ ?P _ _ =>
        match P with
-       | context[@later] =>
-            let cP := (fun P' => apply semax_pre0 with (|> P'); [solve [auto 50 with derives] | ])
+       | context[bi_later] =>
+            let cP := (fun P' => apply semax_pre0 with (▷ P'); [solve [auto 50 with nocore derives] | ])
              in strip1_later P cP
        | _ => apply semax_later_trivial
        end
@@ -1639,227 +1868,12 @@ Ltac simpl_tc_expr :=
         simpl typecheck_expr; simpl denote_tc_assert
     end.
 
-Lemma prop_and1 {A}{NA: NatDed A}:
-  forall P Q : Prop, P -> !!(P /\ Q) = !!Q.
-Proof. intros. f_equal; apply prop_ext; tauto.
-Qed.
-#[export] Hint Rewrite prop_and1 using solve [auto 3 with typeclass_instances] : norm2.
-
-Lemma subst_make_args':
-  forall  {cs: compspecs}  id v (P: environ->mpred) fsig tl el,
-  length tl = length el ->
-  length (fst fsig) = length el ->
-  subst id v (`P (make_args' fsig (eval_exprlist tl el))) =
-           (`P (make_args' fsig (subst id v (eval_exprlist tl el)))).
-Proof.
-intros. unfold_lift. extensionality rho; unfold subst.
-f_equal. unfold make_args'.
-revert tl el H H0; induction (fst fsig); destruct tl,el; simpl; intros; inv H; inv H0.
-reflexivity.
-specialize (IHl _ _ H2 H1).
-unfold_lift; rewrite IHl. auto.
-Qed.
-#[export] Hint Rewrite @subst_make_args' using (solve[reflexivity]) : subst.
-
-Lemma map_cons: forall {A B} (f: A -> B) x y,
-   map f (x::y) = f x :: map f y.
-Proof. reflexivity. Qed.
-
-#[export] Hint Rewrite @map_cons : norm.
-#[export] Hint Rewrite @map_cons : subst.
-
-Lemma map_nil: forall {A B} (f: A -> B), map f nil = nil.
-Proof. reflexivity. Qed.
-
-#[export] Hint Rewrite @map_nil : norm.
-#[export] Hint Rewrite @map_nil : subst.
-
-Definition rlt_ident_eq := ident_eq.  (* for convenience in selectively simplifying *)
-
-Fixpoint remove_localdef_temp (i: ident) (l: list localdef) : list localdef :=
-  match l with
-  | nil => nil
-  | d :: l0 =>
-     let rest := remove_localdef_temp i l0 in
-     match d with
-     | temp j v =>
-       if rlt_ident_eq i j
-       then rest
-       else d :: rest
-     | _ => d :: rest
-     end
-  end.
-
-Lemma subst_stackframe_of:
-  forall {cs: compspecs} i v f, subst i v (stackframe_of f) = stackframe_of f.
-Proof.
-unfold stackframe_of; simpl; intros.
-unfold subst.
-extensionality rho.
-induction (fn_vars f). reflexivity.
-simpl map. repeat rewrite fold_right_cons.
-f_equal.
-apply IHl.
-Qed.
-#[export] Hint Rewrite @subst_stackframe_of : subst.
-
-Lemma remove_localdef_temp_PROP: forall (i: ident) P Q R,
-  EX old: val, subst i `(old) (PROPx P (LOCALx Q (SEPx R))) |--
-  PROPx P (LOCALx (remove_localdef_temp i Q) (SEPx R)).
-Proof.
-  intros.
-  apply exp_left; intro old.
-  unfold PROPx.
-  autorewrite with subst norm.
-  apply andp_derives. apply derives_refl.
-  unfold LOCALx.
-  autorewrite with subst norm.
-  apply andp_derives; auto; try apply derives_refl.
-  induction Q; simpl fold_right.
-  + autorewrite with subst norm; auto.
-  + destruct a; [if_tac | ..];
-    autorewrite with subst norm.
-    - eapply derives_trans; [| exact IHQ].
-      rewrite local_lift2_and.
-      apply andp_left2; apply derives_refl.
-    - rewrite !local_lift2_and.
-      apply andp_derives; [| exact IHQ].
-      unfold locald_denote.
-      autorewrite with subst norm.
-      unfold local, lift1; unfold_lift; intros ?.
-      apply prop_derives; simpl.
-      unfold subst; simpl; intros.
-      rewrite eval_id_other in H0 by auto; auto.
-    - rewrite !local_lift2_and.
-      apply andp_derives; [| exact IHQ].
-      unfold local, lift1; unfold_lift; intros rho.
-      unfold subst; simpl.
-      apply derives_refl.
-    - rewrite !local_lift2_and.
-      apply andp_derives; [| exact IHQ].
-      unfold local, lift1; unfold_lift; intros rho.
-      unfold subst; simpl.
-      apply derives_refl.
-Qed.
-
-Lemma eval_id_denote_tc_initialized: forall Delta i t v,
-  (temp_types Delta) ! i = Some t ->
-  local (tc_environ Delta) && local (`and (`(eq v) (eval_id i)) `(v <> Vundef)) |-- denote_tc_initialized i t.
-Proof.
-  intros.
-  intros rho.
-  unfold local, lift1; unfold_lift; simpl.
-  rewrite <- prop_and; apply prop_derives.
-  intros [? [? ?]].
-  destruct H0 as [? _].
-  specialize (H0 _ _ H).
-  destruct H0 as [v0 [? ?]].
-  unfold eval_id in H1.
-  rewrite H0 in *; clear H0; subst v; rename v0 into v.
-  simpl in H2.
-  specialize (H3 H2).
-  eauto.
-Qed.
-
-Lemma PQR_denote_tc_initialized: forall Delta i t v P Q R,
-  (temp_types Delta) ! i = Some t ->
-  local (tc_environ Delta) && PROPx P (LOCALx (temp i v :: Q) R) |-- denote_tc_initialized i t.
-Proof.
-  intros.
-  eapply derives_trans; [| apply eval_id_denote_tc_initialized; eauto].
-  apply andp_derives; [apply derives_refl |].
-  rewrite <- insert_local'.
-  apply andp_left1.
-  apply derives_refl.
-Qed.
-
-Lemma derives_remove_localdef_PQR: forall P Q R i,
-  PROPx P (LOCALx Q (SEPx R)) |-- PROPx P (LOCALx (remove_localdef_temp i Q) (SEPx R)).
-Proof.
-  intros.
-  go_lowerx.
-  apply andp_right; auto.
-  apply prop_right.
-  clear H; rename H0 into H.
-  induction Q; simpl in *; auto.
-  destruct a; try now (destruct H; simpl in *; split; auto).
-  destruct H.
-  if_tac; simpl in *; auto.
-Qed.
-
-Lemma subst_remove_localdef_PQR: forall P Q R i v,
-  subst i v (PROPx P (LOCALx (remove_localdef_temp i Q) (SEPx R))) |-- PROPx P (LOCALx (remove_localdef_temp i Q) (SEPx R)).
-Proof.
-  intros.
-  go_lowerx.
-  apply andp_right; auto.
-  apply prop_right.
-  clear H; rename H0 into H.
-  induction Q; simpl in *; auto.
-  destruct a; try now (destruct H; simpl in *; split; auto).
-  if_tac; simpl in *; auto.
-  destruct H; split; auto.
-  unfold_lift in H.
-  destruct H; subst.
-  unfold_lift. rewrite eval_id_other in * by auto.
-  auto.
-Qed.
-
-Fixpoint iota_formals (i: ident) (tl: list type) :=
- match tl with
- | t::tl' => (i,t) :: iota_formals (i+1)%positive tl'
- | nil => nil
- end.
-
 Ltac make_sequential :=
   match goal with
-  | |- @semax _ _ _ _ _ (normal_ret_assert _) => idtac
+  | |- @semax _ _ _ _ _ _ _ _ _ (normal_ret_assert _) => idtac
   | |- _ => apply sequential
   end.
 
-Lemma isptr_force_ptr'' : forall p Q,
-    (isptr p -> Q) ->
-    (isptr (force_ptr p) -> Q).
-Proof.
-intros.
-apply X.
-destruct p; inv H; apply Coq.Init.Logic.I.
-Qed.
-
-Lemma isptr_offset_val'': forall i p Q,
-    (isptr p -> Q) ->
-    (isptr (offset_val i p) -> Q).
-Proof.
-intros.
-apply X.
-destruct p; inv H; apply Coq.Init.Logic.I.
-Qed.
-
-Lemma ptr_eq_e': forall v1 v2 B,
-   (v1=v2 -> B) ->
-   (ptr_eq v1 v2 -> B).
-Proof.
-intuition. apply X. apply ptr_eq_e; auto.
-Qed.
-
-Lemma typed_false_of_bool':
- forall x (P: Prop),
-    ((x=false) -> P) ->
-    (typed_false tint (bool2val x) -> P).
-Proof.
-intuition.
-apply H, typed_false_of_bool; auto.
-Qed.
-
-Lemma typed_true_of_bool':
- forall x (P: Prop),
-    ((x=true) -> P) ->
-    (typed_true tint (bool2val x) -> P).
-Proof.
-intuition.
-apply H, typed_true_of_bool; auto.
-Qed.
-
 Ltac intro_if_new :=
  repeat match goal with
   | |- ?A -> _ => ((assert A by auto; fail 1) || fail 1) || intros _
@@ -1894,60 +1908,37 @@ Ltac intro_if_new :=
           intro
   end.
 
-Lemma saturate_aux20:
- forall (P Q: mpred) P' Q' ,
-    (P |-- !! P') ->
-    (Q |-- !! Q') ->
-    P * Q |-- !! (P' /\ Q').
-Proof.
-intros.
-eapply derives_trans; [apply sepcon_derives; eassumption | ].
-rewrite sepcon_prop_prop.
-auto.
-Qed.
-
-Lemma saturate_aux21x:
-  forall (P Q S: mpred),
-   (P |-- S) ->
-   (S && P |-- Q) -> P |-- Q.
-Proof.
-intros. subst.
-eapply derives_trans; [ | eassumption].
-apply andp_right; auto.
-Qed.
-
-
 Ltac already_saturated :=
-(match goal with |- ?P |-- ?Q =>
+(match goal with |- ?P ⊢ ?Q =>
     let H := fresh in
-     assert (H: P |-- Q) by auto with nocore saturate_local;
+     assert (H: P ⊢ Q) by auto with nocore saturate_local;
      cbv beta in H;
-     match type of H with _ |-- !! ?Q' =>
+     match type of H with _ ⊢ ⌜?Q'⌝ =>
      assert (Q') by (repeat simple apply conj; auto);
      fail 3
      end
 end || auto with nocore saturate_local)
- || simple apply prop_True_right.
+ || simple apply TT_right.
 
 Ltac check_mpreds2 R :=
  lazymatch R with
- | @sepcon mpred _ _ ?a ?b => check_mpreds2 a; check_mpreds2 b
+ | bi_sep ?a ?b => check_mpreds2 a; check_mpreds2 b
  | _ => match type of R with ?t =>
-                          first [constr_eq t mpred
+                          first [unify t (@iProp _)
                                  | fail 4 "The conjunct" R "has type" t "but should have type mpred; these two types may be convertible but they are not identical"]
                      end
  | nil => idtac
  end.
 
 Ltac saturate_local :=
- match goal with |- ?R |-- _ => check_mpreds2 R end;
- simple eapply saturate_aux21x;
+(* match goal with |- ?R ⊢ _ => check_mpreds2 R end; Do we need this? *)
+ eapply saturate_aux21x;
  [repeat simple apply saturate_aux20;
    (* use already_saturated if want to be fancy,
          otherwise the next lines *)
     auto with nocore saturate_local;
-     simple apply prop_True_right
- | simple apply derives_extract_prop;
+     (*simple*) apply TT_right
+ | (*simple*) apply bi.pure_elim_l;
    match goal with |- _ -> ?A =>
        let P := fresh "P" in set (P := A);
        fancy_intros true;
@@ -1957,54 +1948,13 @@ Ltac saturate_local :=
 
 (*********************************************************)
 
-Lemma prop_right_emp {A} {NA: NatDed A}:
- forall P: Prop, P -> emp |-- !! P.
-Proof. intros. normalize.
-Qed.
-
 Ltac prop_right_cautious :=
- try solve [simple apply prop_right; auto].
-
-(**********************************************************)
-(* testing
-Parameter f: nat -> Prop.
-Parameter g h : mpred.
-
-Goal ( !! f 1 && ((h && !! f 2) && h ) && (!! f 3 && (g && (!!f 4 && !! f 5) && !! f 6)) |-- FF).
-
-*)
-
-(*****************************************************************)
+ try solve [simple apply bi.pure_intro; auto].
 
 Ltac subst_any :=
  repeat match goal with
   | H: ?x = ?y |- _ => first [ subst x | subst y ]
  end.
-
-Lemma prop_and_right {A}{NA: NatDed A}:
- forall (U: A) (X Y: Prop),
-    X ->
-    (U |-- !! Y) ->
-    U |-- !! (X /\ Y).
-Proof. intros. apply derives_trans with (!!Y); auto.
-apply prop_derives; auto.
-Qed.
-
-Lemma fold_right_sepcon_subst:
- forall i e R, fold_right sepcon emp (map (subst i e) R) = subst i e (fold_right sepcon emp R).
-Proof.
- intros. induction R; auto.
- autorewrite with subst. f_equal; auto.
-Qed.
-
-Lemma unsigned_eq_eq: forall i j, Int.unsigned i = Int.unsigned j -> i = j.
-Proof.
-  intros.
-  rewrite <- (Int.repr_unsigned i), <- (Int.repr_unsigned j).
-  rewrite H.
-  reflexivity.
-Qed.
-
 Ltac solve_mod_eq :=
   unfold Int.add, Int.mul;
   repeat rewrite Int.unsigned_repr_eq;
@@ -2015,178 +1965,65 @@ Ltac solve_mod_eq :=
   repeat rewrite Zplus_mod_idemp_l;
   repeat rewrite Zplus_mod_idemp_r).
 
-
-Lemma prop_false_andp {A}{NA :NatDed A}:
- forall P Q, ~P -> !! P && Q = FF.
-Proof.
-intros.
-apply pred_ext; normalize.
-Qed.
-
-Lemma wand_join {A}{NA: NatDed A}{SA: SepLog A}:
-  forall x1 x2 y1 y2: A,
-    (x1 -* y1) * (x2 -* y2) |-- ((x1 * x2) -* (y1 * y2)).
-Proof.
-intros.
-rewrite <- wand_sepcon_adjoint.
-rewrite sepcon_assoc.
-rewrite <- (sepcon_assoc _ x1).
-rewrite <- (sepcon_comm x1).
-rewrite (sepcon_assoc x1).
-rewrite <- (sepcon_assoc _ x1).
-rewrite <- (sepcon_comm x1).
-rewrite <- (sepcon_comm x2).
-apply sepcon_derives.
-apply modus_ponens_wand.
-apply modus_ponens_wand.
-Qed.
-
-Lemma wand_sepcon:
- forall {A} {NA: NatDed A}{SA: SepLog A} P Q,
-   (P -* Q * P) * P = Q * P.
-Proof.
-intros.
-apply pred_ext.
-*
-rewrite sepcon_comm.
-apply modus_ponens_wand.
-*
-apply sepcon_derives; auto.
-apply -> wand_sepcon_adjoint; auto.
-Qed.
-
-Lemma wand_sepcon':
- forall {A} {NA: NatDed A}{SA: SepLog A} P Q,
-   P * (P -* Q * P) = P * Q.
-Proof.
-intros. rewrite (sepcon_comm P Q).
-rewrite sepcon_comm; apply wand_sepcon.
-Qed.
-
-
-#[export] Hint Rewrite wand_sepcon wand_sepcon' : norm.
-
-
-
-Lemma extract_nth_exists_in_SEP:
-  forall n P Q (R: list mpred)
-              {A} (S: A -> mpred),
-   nth n R emp = (exp S) ->
-   PROPx P (LOCALx Q (SEPx R)) =
-   exp (fun x => PROPx P (LOCALx Q (SEPx (replace_nth n R (S x))))).
-Proof.
-intros.
-transitivity (PROPx P (LOCALx Q (EX x:A, SEPx (replace_nth n R (S x))))).
-*
-f_equal. f_equal.
-unfold SEPx.
-simpl. extensionality rho.
-revert R H; induction n; destruct R; intros.
-unfold replace_nth, fold_right.
-simpl.
-unfold nth in H. rewrite H; clear H.
-apply pred_ext.
-apply exp_left; intro x. apply exp_right with x.
-apply exp_right with x.
-auto.
-apply exp_left; intro x. auto.
-unfold replace_nth, nth in *. subst m.
-unfold fold_right_sepcon.
-fold (fold_right_sepcon R).
-normalize.
-unfold nth in H. unfold replace_nth.
-simpl.
-rewrite H.
-simpl.
-apply pred_ext.
-apply exp_left; intro x. apply exp_right with x.
-apply exp_right with x.
-auto.
-apply exp_left; intro x. auto.
-unfold nth in H.
-fold (nth n R) in H.
-simpl.
-rewrite (IHn _ H). clear.
-normalize.
-*
-unfold PROPx, LOCALx.
-normalize.
-Qed.
-
 Ltac extract_exists_in_SEP' PQR :=
  match PQR with
  | PROPx ?P (LOCALx ?Q (SEPx (?R))) =>
-   match R with context [(@exp _ _ ?A ?S) :: ?R'] =>
+   match R with context [(@bi_exist _ ?A ?S) :: ?R'] =>
       let n := constr:((length R - Datatypes.S (length R'))%nat) in
       let n' := eval lazy beta zeta iota delta in n in
-      rewrite (@extract_nth_exists_in_SEP n' P Q R A S (eq_refl _));
+      rewrite (@extract_nth_exists_in_SEP _ _ _ n' P Q R A S (eq_refl _));
       unfold replace_nth at 1;
-      rewrite ?exp_andp2
+      rewrite ?bi.and_exist_l
    end
  end.
 
 Ltac extract_exists_from_SEP :=
 lazymatch goal with
-  | |- semax _ ?Pre _ _ =>
+  | |- semax _ _ ?Pre _ _ =>
     extract_exists_in_SEP' Pre; apply extract_exists_pre
-  | |- ENTAIL _, ?Pre |-- ?Post =>
+  | |- ENTAIL _, ?Pre ⊢ ?Post =>
      let P := fresh "POST" in set (P := Post);
-    extract_exists_in_SEP' Pre; subst P; apply exp_left
-  | |- ?Pre |-- ?Post => (* this case is obsolete, should probably be deleted *)
+    extract_exists_in_SEP' Pre; subst P; apply bi.exist_elim
+  | |- ?Pre ⊢ ?Post => (* this case is obsolete, should probably be deleted *)
      let P := fresh "POST" in set (P := Post);
-    extract_exists_in_SEP' Pre; subst P; apply exp_left
+    extract_exists_in_SEP' Pre; subst P; apply bi.exist_elim
 end.
 
 Ltac move_from_SEP' PQR :=
  match PQR with
  | PROPx ?P (LOCALx ?Q (SEPx (?R))) =>
-   match R with context [(prop ?P1 && ?S) :: ?R'] =>
+   match R with context [(⌜?P1⌝ ∧ ?S) :: ?R'] =>
       let n := constr:((length R - Datatypes.S (length R'))%nat) in
       let n' := eval lazy beta zeta iota delta in n in
-      rewrite(@extract_prop_in_SEP n' P1 S P Q R (eq_refl _));
+      rewrite (extract_prop_in_SEP n' P1 S P Q R (eq_refl _));
       unfold replace_nth at 1
    end
  end.
 
-Lemma derives_extract_PROP' :
-  forall (P1: Prop) P QR S,
-     (P1 -> PROPx P QR |-- S) ->
-     PROPx (P1::P) QR |-- S.
-Proof.
-unfold PROPx in *.
-intros.
-rewrite fold_right_cons.
-normalize.
-eapply derives_trans; [ | apply H; auto].
-normalize.
-Qed.
-
-
-
 Ltac test_for_Intro_prop R :=
  lazymatch R with
  | nil => fail
  | ?A :: ?B => first [test_for_Intro_prop A | test_for_Intro_prop B]
- | @exp _ _ _  => fail
- | (prop _) => idtac
- | andp ?A ?B => first [test_for_Intro_prop A | test_for_Intro_prop B]
- | sepcon ?A ?B =>  first [test_for_Intro_prop A | test_for_Intro_prop B]
+ | @bi_exist _ _ _  => fail
+ | ⌜_⌝ => idtac
+ | ?A ∧ ?B => first [test_for_Intro_prop A | test_for_Intro_prop B]
+ | ?A ∗ ?B =>  first [test_for_Intro_prop A | test_for_Intro_prop B]
  end.
 
 Ltac Intro_prop' :=
 lazymatch goal with
- | |- semax _ ?PQR _ _ =>
+ | |- semax _ _ ?PQR _ _ =>
      first [ move_from_SEP' PQR;
               simple apply semax_extract_PROP; fancy_intros false
             | flatten_in_SEP PQR
             ]
- | |- ENTAIL _, ?PQR |-- _ =>
+ | |- ENTAIL _, ?PQR ⊢ _ =>
      first [ move_from_SEP' PQR;
                simple apply derives_extract_PROP; fancy_intros false
             | flatten_in_SEP PQR
              ]
- | |- ?PQR |-- _ =>  (* this case is obsolete, should probably be deleted *)
-     first [ simple apply derives_extract_prop; fancy_intros false
+ | |- ?PQR ⊢ _ =>
+     first [ match PQR with ⌜_⌝ ∧ _ => apply bi.pure_elim_l; fancy_intros false end
             | move_from_SEP' PQR;
                simple apply derives_extract_PROP; fancy_intros false
             | flatten_in_SEP PQR
@@ -2198,19 +2035,19 @@ Ltac Intro_prop :=
     [autorewrite with gather_prop_core] which is expensive, and
    to avoid [autorewrite with gather_prop] which is even more expensive. *)
 lazymatch goal with
- | |- semax _ ?PQR _ _ => tryif is_evar PQR then fail else idtac
- | |- ENTAIL _, ?PQR |-- _ => tryif is_evar PQR then fail else idtac
- | |- ?PQR |-- _ => tryif is_evar PQR then fail else idtac
+ | |- semax _ _ ?PQR _ _ => tryif is_evar PQR then fail else idtac
+ | |- ENTAIL _, ?PQR ⊢ _ => tryif is_evar PQR then fail else idtac
+ | |- ?PQR ⊢ _ => tryif is_evar PQR then fail else idtac
 end;
 first
  [ simple apply semax_extract_PROP; fancy_intros false
  | simple apply derives_extract_PROP; fancy_intros false
  |
 lazymatch goal with
- | |- ENTAIL _, @exp _ _ _ |-- _ =>  fail
- | |- semax _ (@exp _ _ _) _ _ => fail
- | |- ENTAIL _, PROPx nil (LOCALx _ (SEPx ?R)) |-- _ => test_for_Intro_prop R
- | |- semax _ PROPx nil (LOCALx _ (SEPx ?R)) _ _ => test_for_Intro_prop R
+ | |- ENTAIL _, @bi_exist _ _ _ ⊢ _ =>  fail
+ | |- semax _ _ (@bi_exist _) _ _ => fail
+ | |- ENTAIL _, PROPx nil (LOCALx _ (SEPx ?R)) ⊢ _ => test_for_Intro_prop R
+ | |- semax _ _ PROPx nil (LOCALx _ (SEPx ?R)) _ _ => test_for_Intro_prop R
  | |- _ => idtac
  end;
  tryif Intro_prop' then idtac
@@ -2219,33 +2056,38 @@ lazymatch goal with
     else (progress gather_prop; Intro_prop')
  ].
 
+(* Would this be faster with pattern matching? *)
 Ltac Intro'' a :=
-  tryif simple apply extract_exists_pre then intro a
-  else tryif simple apply exp_left then intro a
+  tryif apply extract_exists_pre then intro a
+  else tryif apply bi.exist_elim then intro a
   else tryif extract_exists_from_SEP then intro a
-  else tryif rewrite exp_andp1 then Intro'' a
-  else tryif rewrite exp_andp2 then Intro'' a
-  else tryif rewrite exp_sepcon1 then Intro'' a
-  else tryif rewrite exp_sepcon2 then Intro'' a
+  else tryif rewrite and_exist_l' then Intro'' a
+  else tryif rewrite and_exist_r' then Intro'' a
+  else tryif rewrite sep_exist_l' then Intro'' a
+  else tryif rewrite sep_exist_r' then Intro'' a
+  else tryif rewrite and_exist_l then Intro'' a
+  else tryif rewrite and_exist_r then Intro'' a
+  else tryif rewrite sep_exist_l then Intro'' a
+  else tryif rewrite sep_exist_r then Intro'' a
   else fail.
 
 Ltac Intro a :=
   repeat Intro_prop;
   lazymatch goal with
-  | |- ?A |-- ?B =>
-     let z := fresh "z" in pose (z:=B); change (A|--z); Intro'' a; subst z
-  | |- semax _ _ _ _ =>
+  | |- ?A ⊢ ?B =>
+     let z := fresh "z" in pose (z:=B); change (A⊢z); Intro'' a; subst z
+  | |- semax _ _ _ _ _ =>
      Intro'' a
   end.
 
 Tactic Notation "Intro" "?" :=
   lazymatch goal with
-  | |- semax _ ?x _ _ =>
-    lazymatch x with context [EX ex1 : _, _] =>
+  | |- semax _ _ ?x _ _ =>
+    lazymatch x with context [∃ ex1 : _, _] =>
       let e1 := fresh ex1 in Intro e1
     end
-  | |- context [?Pre |-- _] =>
-    lazymatch Pre with context [EX ex1 : _, _] =>
+  | |- context [?Pre ⊢ _] =>
+    lazymatch Pre with context [∃ ex1 : _, _] =>
       let e1 := fresh ex1 in Intro e1
     end
   end.
@@ -2253,10 +2095,10 @@ Tactic Notation "Intro" "?" :=
 Ltac finish_Intros :=
 repeat Intro_prop;
 (* Do this next part for backwards compatibility *)
-lazymatch goal with
- | |- ?A _ => let x := fresh "x" in set(x:=A);
-        gather_prop; subst x
-end.
+(*lazymatch goal with
+ | |- ?A _ => let x := fresh "x" in set(x:=A);*)
+        gather_prop(*; subst x
+end*).
 
 Tactic Notation "Intros" := finish_Intros.
 
@@ -2359,23 +2201,28 @@ Tactic Notation "Intros" simple_intropattern(x0)
 
 Ltac extract_exists_from_SEP_right :=
 match goal with
-  | |- ?Pre |-- ?Post =>
+  | |- ?Pre ⊢ ?Post =>
      let P := fresh "PRE" in set (P := Pre);
     extract_exists_in_SEP' Post; subst P
 end.
 
+Lemma exp_right : forall {B : bi} {A} (a : A) P (Q : A -> B), (P ⊢ Q a) -> P ⊢ ∃ a, Q a.
+Proof.
+  intros; rewrite -bi.exist_intro //.
+Qed.
+
 Ltac Exists'' a :=
-  first [apply exp_right with a
-         | rewrite exp_andp1; Exists'' a
-         | rewrite exp_andp2; Exists'' a
-         | rewrite exp_sepcon1; Exists'' a
-         | rewrite exp_sepcon2; Exists'' a
-         | extract_exists_from_SEP_right; apply exp_right with a
+  first [apply (exp_right a)
+         | rewrite bi.and_exist_l; Exists'' a
+         | rewrite bi.and_exist_r; Exists'' a
+         | rewrite bi.sep_exist_l; Exists'' a
+         | rewrite bi.sep_exist_r; Exists'' a
+         | extract_exists_from_SEP_right; apply (exp_right a)
          ].
 
 Ltac Exists' a :=
-  match goal with |- ?A |-- ?B =>
-     let z := fresh "z" in pose (z:=A); change (z|--B); Exists'' a; subst z
+  match goal with |- ?A ⊢ ?B =>
+     let z := fresh "z" in pose (z:=A); change (z⊢B); Exists'' a; subst z
   end.
 
 Tactic Notation "Exists" constr(x0) :=
@@ -2383,8 +2230,8 @@ Tactic Notation "Exists" constr(x0) :=
 
 Tactic Notation "Exists" "?" :=
  lazymatch goal with
- | |- _ |-- ?Post =>
-  lazymatch Post with context [EX ex : _, _] => Exists' ex end
+ | |- _ ⊢ ?Post =>
+  lazymatch Post with context [∃ ex : _, _] => Exists' ex end
  end.
 
 Tactic Notation "Exists" constr(x0) constr(x1) :=
@@ -2475,21 +2322,21 @@ Ltac tuple_evar name T cb :=
 
 Ltac EExists'' :=
   let EExists_core :=
-    match goal with [ |- _ |-- EX x:?T, _ ] =>
-      tuple_evar x T ltac: (fun x => apply exp_right with x)
+    match goal with [ |- _ ⊢ ∃ x:?T, _ ] =>
+      tuple_evar x T ltac: (fun x => rewrite -(bi.exist_intro x))
     end; idtac
   in
   first [ EExists_core
-         | rewrite exp_andp1; EExists''
-         | rewrite exp_andp2; EExists''
-         | rewrite exp_sepcon1; EExists''
-         | rewrite exp_sepcon2; EExists''
+         | rewrite bi.and_exist_l; EExists''
+         | rewrite bi.and_exist_r; EExists''
+         | rewrite bi.sep_exist_l; EExists''
+         | rewrite bi.sep_exist_r; EExists''
          | extract_exists_from_SEP_right; EExists_core
          ].
 
 Ltac EExists' :=
-  match goal with |- ?A |-- ?B =>
-     let z := fresh "z" in pose (z:=A); change (z|--B); EExists''; unfold z at 1; clear z
+  match goal with |- ?A ⊢ ?B =>
+     let z := fresh "z" in pose (z:=A); change (z⊢B); EExists''; unfold z at 1; clear z
   end.
 
 Ltac EExists := EExists'.
diff --git a/floyd/closed_lemmas.v b/floyd/closed_lemmas.v
index 51e2beddd1..da3f2bdd9e 100644
--- a/floyd/closed_lemmas.v
+++ b/floyd/closed_lemmas.v
@@ -1,8 +1,9 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Import LiftNotation.
-Import compcert.lib.Maps.
-Local Open Scope logic.
+Import -(notations) compcert.lib.Maps.
 
 Ltac safe_auto_with_closed :=
    (* won't instantiate evars by accident *)
@@ -10,17 +11,21 @@ Ltac safe_auto_with_closed :=
           solve [first [has_evar A | auto 50 with closed]]
  end.
 
+(*Section CLOSED_LEMMAS.*)
+
+(*Context `{!heapGS Σ}.*)
+
+(* consider switching this to eq *)
 Lemma closed_env_set:
- forall {B} i v (P: environ -> B) rho,
+ forall `{Equiv B} i v (P: environ -> B) rho,
      closed_wrt_vars (eq i) P ->
-     P (env_set rho i v) = P rho.
+     P (env_set rho i v) ≡ P rho.
 Proof.
  intros. hnf in H.
- symmetry; destruct rho; apply H.
+ destruct rho; apply H0.
  intros; simpl; destruct (ident_eq i i0). left; auto.
  right; rewrite Map.gso; auto.
 Qed.
-#[export] Hint Rewrite @closed_env_set using safe_auto_with_closed : norm2.
 
 Lemma subst_eval_id_eq:
  forall id v, subst id v (eval_id id) = v.
@@ -35,9 +40,6 @@ Proof.
     unfold force_val, env_set; simpl. rewrite Map.gso; auto.
 Qed.
 
-#[export] Hint Rewrite subst_eval_id_eq : subst.
-#[export] Hint Rewrite subst_eval_id_neq using safe_auto_with_closed : subst.
-
 Fixpoint subst_eval_expr  {cs: compspecs}  (j: ident) (v: environ -> val) (e: expr) : environ -> val :=
  match e with
  | Econst_int i ty => `(Vint i)
@@ -107,15 +109,12 @@ rewrite <- IHe.
 f_equal.
 Qed.
 
-#[export] Hint Rewrite @subst_eval_expr_eq @subst_eval_lvalue_eq : subst.
-
-
 Lemma closed_wrt_subst:
-  forall {A} id e (P: environ -> A), closed_wrt_vars (eq id) P -> subst id e P = P.
+  forall id e `(P: environ -d> A), closed_wrt_vars (eq id) P -> @equiv _ discrete_fun_equiv (subst id e P) P.
 Proof.
 intros.
 unfold subst, closed_wrt_vars in *.
-extensionality rho.
+intro x.
 symmetry.
 apply H.
 intros.
@@ -125,133 +124,166 @@ rewrite Map.gso; auto.
 Qed.
 
 Lemma closed_wrt_map_subst:
-   forall {A: Type} id e (Q: list (environ -> A)),
+   forall id e `(Q: list (environ -d> A)),
          Forall (closed_wrt_vars (eq id)) Q ->
-         map (subst id e) Q = Q.
+          @equiv _ (list.list_equiv(H:=discrete_fun_equiv)) (map (subst id e) Q) Q.
 Proof.
 induction Q; intros.
-simpl; auto.
+simpl; constructor.
 inv H.
-simpl; f_equal; auto.
-apply closed_wrt_subst; auto.
+simpl.
+constructor; auto.
+rewrite closed_wrt_subst; auto.
 Qed.
-#[export] Hint Rewrite @closed_wrt_map_subst using safe_auto_with_closed : subst.
-#[export] Hint Rewrite @closed_wrt_subst using safe_auto_with_closed : subst.
 
-Lemma closed_wrt_map_subst':
-   forall {A: Type} id e (Q: list (environ -> A)),
+Lemma closed_wrt_map_subst' `{!heapGS Σ}:
+   forall id e (Q: list (environ -d> mpred)),
          Forall (closed_wrt_vars (eq id)) Q ->
-         @map (LiftEnviron A) _ (subst id e) Q = Q.
+          @equiv _ (list.list_equiv(H:=discrete_fun_equiv)) (map (subst id e) Q) Q.
 Proof.
-apply @closed_wrt_map_subst.
+intros.
+apply closed_wrt_map_subst. done.
 Qed.
 
-#[export] Hint Rewrite @closed_wrt_map_subst' using safe_auto_with_closed : subst.
+Set Warnings "-redundant-canonical-projection".
+Canonical Structure valC := @leibnizO val.
+Set Warnings "redundant-canonical-projection".
+Definition val_valC val : valC := val.
+
 Lemma closed_wrt_subst_eval_expr:
   forall {cs: compspecs} j v e,
-   closed_wrt_vars (eq j) (eval_expr e) ->
-   subst_eval_expr j v e = eval_expr e.
+   closed_wrt_vars (eq j) ((fun x => (val_valC (eval_expr e x)))) ->
+    @equiv _ discrete_fun_equiv (subst_eval_expr j v e) (eval_expr e). 
 Proof.
 intros; rewrite <- subst_eval_expr_eq.
 apply closed_wrt_subst; auto.
 Qed.
 Lemma closed_wrt_subst_eval_lvalue:
   forall {cs: compspecs} j v e,
-   closed_wrt_vars (eq j) (eval_lvalue e) ->
-   subst_eval_lvalue j v e = eval_lvalue e.
+   closed_wrt_vars (eq j) ((fun x => (val_valC (eval_lvalue e x)))) ->
+    @equiv _ discrete_fun_equiv (subst_eval_lvalue j v e) (eval_lvalue e).
 Proof.
 intros; rewrite <- subst_eval_lvalue_eq.
 apply closed_wrt_subst; auto.
 Qed.
-#[export] Hint Rewrite @closed_wrt_subst_eval_expr using solve [auto 50 with closed] : subst.
-#[export] Hint Rewrite @closed_wrt_subst_eval_lvalue using solve [auto 50 with closed] : subst.
-
-#[export] Hint Unfold closed_wrt_modvars : closed.
-
-Lemma closed_wrt_local: forall S P, closed_wrt_vars S P -> closed_wrt_vars S (local P).
+(*`{!heapGS Σ}
+Local Notation local := (local (Σ:=Σ)). 
+*)
+Lemma closed_wrt_local `{!heapGS Σ}: 
+  forall S P, closed_wrt_vars S P -> closed_wrt_vars S (local P).
 Proof.
 intros.
 hnf in H|-*; intros.
 specialize (H _ _ H0).
 unfold local, lift1.
-f_equal; auto.
+rewrite /= H //.
 Qed.
 
-Lemma closed_wrtl_local: forall S P, closed_wrt_lvars S P -> closed_wrt_lvars S (local P).
+Lemma closed_wrtl_local `{!heapGS Σ}: forall S P, closed_wrt_lvars S P -> closed_wrt_lvars S (local P).
 Proof.
 intros.
 hnf in H|-*; intros.
 specialize (H _ _ H0).
 unfold local, lift1.
-f_equal; auto.
+rewrite /= H //.
 Qed.
-#[export] Hint Resolve closed_wrt_local closed_wrtl_local : closed.
 
-Lemma closed_wrt_lift0: forall {A} S (Q: A), closed_wrt_vars S (lift0 Q).
+Lemma closed_wrt_lift0: forall {A:ofe} S (Q: A), closed_wrt_vars S (lift0 Q).
 Proof.
 intros.
 intros ? ? ?.
 unfold lift0; auto.
 Qed.
-Lemma closed_wrtl_lift0: forall {A} S (Q: A), closed_wrt_lvars S (lift0 Q).
+Lemma closed_wrtl_lift0: forall {A:ofe} S (Q: A), closed_wrt_lvars S (lift0 Q).
 Proof.
 intros.
 intros ? ? ?.
 unfold lift0; auto.
 Qed.
-#[export] Hint Resolve closed_wrt_lift0 closed_wrtl_lift0 : closed.
 
-Lemma closed_wrt_lift0C: forall {B} S (Q: B),
+Lemma closed_wrt_lift0C: forall {B:ofe} S (Q: B),
    closed_wrt_vars S (@liftx (LiftEnviron B) Q).
 Proof.
 intros.
 intros ? ? ?.
 unfold_lift; auto.
 Qed.
-Lemma closed_wrtl_lift0C: forall {B} S (Q: B),
+Lemma closed_wrtl_lift0C: forall {B:ofe} S (Q: B),
    closed_wrt_lvars S (@liftx (LiftEnviron B) Q).
 Proof.
 intros.
 intros ? ? ?.
 unfold_lift; auto.
 Qed.
-#[export] Hint Resolve closed_wrt_lift0C closed_wrtl_lift0C: closed.
 
-Lemma closed_wrt_lift1: forall {A}{B} S (f: A -> B) P,
-        closed_wrt_vars S P ->
+(*
+Local Notation assert := (@assert Σ).
+*)
+
+Lemma closed_wrt_embed {Σ: gFunctors} : forall S (Q : iProp Σ), 
+   closed_wrt_vars S (⎡Q⎤:  monPred environ_index (ouPredI (iResUR Σ))).
+Proof.
+intros.
+intros ? ? ?.
+by monPred.unseal.
+Qed.
+Lemma closed_wrtl_embed {Σ: gFunctors} : forall S (Q : iProp Σ), 
+   closed_wrt_lvars S (⎡Q⎤:  monPred environ_index (ouPredI (iResUR Σ))).
+Proof.
+intros.
+intros ? ? ?.
+by monPred.unseal.
+Qed.
+
+Lemma closed_wrt_lift1: forall  S `(f: A -d> B) P,
+        closed_wrt_vars(H:=eq) S P ->
         closed_wrt_vars S (lift1 f P).
 Proof.
 intros.
 intros ? ? ?. specialize (H _ _ H0).
-unfold lift1; f_equal; auto.
+unfold lift1. unfold equiv in H.  rewrite H //.
 Qed.
-Lemma closed_wrtl_lift1: forall {A}{B} S (f: A -> B) P,
-        closed_wrt_lvars S P ->
+Lemma closed_wrtl_lift1: forall S `(f: A -d> B) P,
+        closed_wrt_lvars(H:=eq) S P ->
         closed_wrt_lvars S (lift1 f P).
 Proof.
 intros.
 intros ? ? ?. specialize (H _ _ H0).
-unfold lift1; f_equal; auto.
+unfold lift1. unfold equiv in H. rewrite H //.
 Qed.
-#[export] Hint Resolve closed_wrt_lift1 closed_wrtl_lift1 : closed.
 
-Lemma closed_wrt_lift1C: forall {A}{B} S (f: A -> B) P,
-        closed_wrt_vars S P ->
+Lemma closed_wrt_lift1C: forall S `(f: A -d> B) P,
+        closed_wrt_vars(H:=eq) S P  ->
         closed_wrt_vars S (@liftx (Tarrow A (LiftEnviron B)) f P).
 Proof.
 intros.
 intros ? ? ?. specialize (H _ _ H0).
-unfold_lift; f_equal; auto.
+unfold_lift. unfold equiv in H. rewrite H //.
+Qed.
+
+Lemma closed_wrt_proper `{!Equiv B} `{!Equivalence ((≡) : relation B)} S : Proper (pointwise_relation _ equiv ==> iff) (@closed_wrt_vars B _ S).
+Proof.
+  intros ???.
+  split; intros ? rho ??; [rewrite -H | rewrite H]; auto.
 Qed.
-Lemma closed_wrtl_lift1C: forall {A}{B} S (f: A -> B) P,
+
+Lemma closed_wrtl_proper `{!Equiv B} `{!Equivalence ((≡) : relation B)} S : Proper (pointwise_relation _ equiv ==> iff) (@closed_wrt_lvars B _ S).
+Proof.
+  intros ???.
+  split; intros ? rho ??; [rewrite -H | rewrite H]; auto.
+Qed.
+
+(* FIXME fix the following section.
+         For now we make progs64/verif_reverse2.v work, which does not seem to depend on these. *)
+(*Lemma closed_wrtl_lift1C: forall `{EA : Equiv A} `{EB : Equiv B} S (f: A -> B) P,
         closed_wrt_lvars S P ->
         closed_wrt_lvars S (@liftx (Tarrow A (LiftEnviron B)) f P).
 Proof.
 intros.
 intros ? ? ?. specialize (H _ _ H0).
-unfold_lift; f_equal; auto.
+unfold_lift. rewrite H.
+unfold_lift; f_equiv; auto.
 Qed.
-#[export] Hint Resolve closed_wrt_lift1C closed_wrtl_lift1C : closed.
 
 Lemma closed_wrt_lift2: forall {A1 A2}{B} S (f: A1 -> A2 -> B) P1 P2,
         closed_wrt_vars S P1 ->
@@ -275,7 +307,6 @@ specialize (H _ _ H1).
 specialize (H0 _ _ H1).
 unfold lift2; f_equal; auto.
 Qed.
-#[export] Hint Resolve closed_wrt_lift2 closed_wrtl_lift2 : closed.
 
 Lemma closed_wrt_lift2C: forall {A1 A2}{B} S (f: A1 -> A2 -> B) P1 P2,
         closed_wrt_vars S P1 ->
@@ -299,7 +330,6 @@ specialize (H _ _ H1).
 specialize (H0 _ _ H1).
 unfold_lift; f_equal; auto.
 Qed.
-#[export] Hint Resolve closed_wrt_lift2C closed_wrtl_lift2C : closed.
 
 Lemma closed_wrt_lift3: forall {A1 A2 A3}{B} S (f: A1 -> A2 -> A3 -> B) P1 P2 P3,
         closed_wrt_vars S P1 ->
@@ -327,7 +357,6 @@ specialize (H0 _ _ H2).
 specialize (H1 _ _ H2).
 unfold lift3; f_equal; auto.
 Qed.
-#[export] Hint Resolve closed_wrt_lift3 closed_wrtl_lift3 : closed.
 
 Lemma closed_wrt_lift3C: forall {A1 A2 A3}{B} S (f: A1 -> A2 -> A3 -> B) P1 P2 P3,
         closed_wrt_vars S P1 ->
@@ -356,7 +385,6 @@ specialize (H0 _ _ H2).
 specialize (H1 _ _ H2).
 unfold_lift. f_equal; auto.
 Qed.
-#[export] Hint Resolve closed_wrt_lift3C closed_wrtl_lift3C : closed.
 
 Lemma closed_wrt_lift4: forall {A1 A2 A3 A4}{B} S (f: A1 -> A2 -> A3 -> A4 -> B)
        P1 P2 P3 P4,
@@ -390,7 +418,6 @@ specialize (H1 _ _ H3).
 specialize (H2 _ _ H3).
 unfold lift4; f_equal; auto.
 Qed.
-#[export] Hint Resolve closed_wrt_lift4  closed_wrtl_lift4 : closed.
 
 Lemma closed_wrt_lift4C: forall {A1 A2 A3 A4}{B} S (f: A1 -> A2 -> A3 -> A4 -> B) P1 P2 P3 P4,
         closed_wrt_vars S P1 ->
@@ -423,22 +450,18 @@ specialize (H1 _ _ H3).
 specialize (H2 _ _ H3).
 unfold liftx; simpl.
 unfold lift. f_equal; auto.
-Qed.
-#[export] Hint Resolve closed_wrt_lift4C closed_wrtl_lift4C : closed.
+Qed.*)
 
 Lemma closed_wrt_const:
- forall A (P: A) S, closed_wrt_vars S (fun rho: environ => P).
+ forall `{!Equiv A} `{@Equivalence A (≡)} (P: A) S, closed_wrt_vars S (fun rho: environ => P).
 Proof.
-intros. hnf; intros.
-simpl. auto.
+intros. hnf; intros; auto.
 Qed.
 Lemma closed_wrtl_const:
- forall A (P: A) S, closed_wrt_lvars S (fun rho: environ => P).
+ forall `{!Equiv A} `{@Equivalence A (≡)} (P: A) S, closed_wrt_lvars S (fun rho: environ => P).
 Proof.
-intros. hnf; intros.
-simpl. auto.
+intros. hnf; intros; auto.
 Qed.
-#[export] Hint Resolve closed_wrt_const closed_wrtl_const : closed.
 
 Lemma closed_wrt_eval_var:
   forall S id t, closed_wrt_vars S (eval_var id t).
@@ -447,7 +470,6 @@ unfold closed_wrt_vars, eval_var; intros.
 simpl.
 auto.
 Qed.
-#[export] Hint Resolve closed_wrt_eval_var : closed.
 Lemma closed_wrtl_eval_var:
   forall S id t, ~ S id -> closed_wrt_lvars S (eval_var id t).
 Proof.
@@ -456,7 +478,6 @@ simpl.
 destruct (H0 id); [contradiction | ].
 rewrite <- H1; auto.
 Qed.
-#[export] Hint Resolve closed_wrtl_eval_var : closed.
 
 Lemma closed_wrt_lvar:
   forall S id t v, closed_wrt_vars S (locald_denote (lvar id t v)).
@@ -465,7 +486,6 @@ intros.
 hnf; intros; simpl.
 destruct (Map.get (ve_of rho) id); auto.
 Qed.
-#[export] Hint Resolve closed_wrt_lvar : closed.
 
 Lemma closed_wrt_gvars:
   forall S gv, closed_wrt_vars S (locald_denote (gvars gv)).
@@ -473,7 +493,6 @@ Proof.
 intros.
 hnf; intros; simpl. reflexivity.
 Qed.
-#[export] Hint Resolve closed_wrt_gvars : closed.
 
 Lemma closed_wrtl_gvars:
   forall S gv, closed_wrt_lvars S (locald_denote (gvars gv)).
@@ -481,7 +500,6 @@ Proof.
 intros.
 hnf; intros; simpl. reflexivity.
 Qed.
-#[export] Hint Resolve closed_wrtl_gvars : closed.
 
 Lemma closed_wrtl_lvar:
  forall  {cs: compspecs} S id t v,
@@ -493,7 +511,6 @@ unfold lvar_denote.
 destruct (H0 id); try contradiction.
 rewrite H1; auto.
 Qed.
-#[export] Hint Resolve closed_wrtl_lvar : closed.
 
 Definition expr_closed_wrt_lvars (S: ident -> Prop) (e: expr) : Prop :=
   forall (cs: compspecs) rho ve',
@@ -505,7 +522,7 @@ Definition lvalue_closed_wrt_lvars (S: ident -> Prop) (e: expr) : Prop :=
      (forall i, S i \/ Map.get (ve_of rho) i = Map.get ve' i) ->
      eval_lvalue e rho = eval_lvalue e (mkEnviron (ge_of rho) ve'  (te_of rho)).
 
-Lemma closed_wrt_cmp_ptr : forall {cs: compspecs} S e1 e2 c,
+(*Lemma closed_wrt_cmp_ptr : forall {cs: compspecs} S e1 e2 c,
   expr_closed_wrt_vars S e1 ->
   expr_closed_wrt_vars S e2 ->
   closed_wrt_vars S (`(cmp_ptr_no_mem c) (eval_expr e1) (eval_expr e2)).
@@ -532,8 +549,7 @@ specialize (H cs rho ve' H1).
 specialize (H0 cs rho ve' H1).
 unfold cmp_ptr_no_mem. rewrite H0. rewrite H.
 reflexivity.
-Qed.
-#[export] Hint Resolve closed_wrt_cmp_ptr closed_wrtl_cmp_ptr: closed.
+Qed.*)
 
 Lemma closed_wrt_eval_id: forall S i,
     ~ S i -> closed_wrt_vars S (eval_id i).
@@ -554,7 +570,6 @@ intros ? ? ?.
 unfold eval_id, force_val.
 simpl. auto.
 Qed.
-#[export] Hint Resolve closed_wrt_eval_id closed_wrtl_eval_id : closed.
 
 Lemma closed_wrt_temp: forall S i v,
     ~ S i -> closed_wrt_vars S (locald_denote (temp i v)).
@@ -576,14 +591,15 @@ unfold locald_denote.
 hnf; intros. simpl.
 unfold eval_id; simpl. auto.
 Qed.
-#[export] Hint Resolve closed_wrt_temp closed_wrtl_temp : closed.
+
+Global Instance environ_equiv : Equiv environ := eq.
 
 Lemma closed_wrt_get_result1 :
   forall (S: ident -> Prop) i , ~ S i -> closed_wrt_vars S (get_result1 i).
 Proof.
 intros. unfold get_result1. simpl.
  hnf; intros.
- simpl. f_equal.
+ hnf. f_equal.
 apply (closed_wrt_eval_id _ _ H); auto.
 Qed.
 Lemma closed_wrtl_get_result1 :
@@ -591,137 +607,124 @@ Lemma closed_wrtl_get_result1 :
 Proof.
 intros. unfold get_result1. simpl.
  hnf; intros.
- simpl. f_equal.
+ hnf. f_equal.
 Qed.
-#[export] Hint Resolve closed_wrt_get_result1 closed_wrtl_get_result1 : closed.
 
-Lemma closed_wrt_tc_FF:
+Lemma closed_wrt_tc_FF `{!heapGS Σ}:
  forall {cs: compspecs} S e, closed_wrt_vars S (denote_tc_assert (tc_FF e)).
 Proof.
  intros. hnf; intros. reflexivity.
 Qed.
-Lemma closed_wrtl_tc_FF:
+Lemma closed_wrtl_tc_FF `{!heapGS Σ}:
  forall {cs: compspecs} S e, closed_wrt_lvars S (denote_tc_assert (tc_FF e)).
 Proof.
  intros. hnf; intros. reflexivity.
 Qed.
-#[export] Hint Resolve closed_wrt_tc_FF closed_wrtl_tc_FF : closed.
 
-Lemma closed_wrt_tc_TT:
+Lemma closed_wrt_tc_TT `{!heapGS Σ}:
  forall {cs: compspecs} S, closed_wrt_vars S (denote_tc_assert (tc_TT)).
 Proof.
  intros. hnf; intros. reflexivity.
 Qed.
-Lemma closed_wrtl_tc_TT:
+Lemma closed_wrtl_tc_TT `{!heapGS Σ}:
  forall {cs: compspecs} S, closed_wrt_lvars S (denote_tc_assert (tc_TT)).
 Proof.
  intros. hnf; intros. reflexivity.
 Qed.
-#[export] Hint Resolve closed_wrt_tc_TT closed_wrtl_tc_TT : closed.
 
-Lemma closed_wrt_andp: forall S (P Q: environ->mpred),
+Lemma closed_wrt_andp `{!heapGS Σ}: forall S (P Q: assert),
   closed_wrt_vars S P -> closed_wrt_vars S Q ->
-  closed_wrt_vars S (P && Q).
+  closed_wrt_vars S (P ∧ Q).
 Proof.
-intros; hnf in *; intros.
-simpl. f_equal; eauto.
+  intros; hnf in *; intros.
+  monPred.unseal; f_equiv; eauto.
 Qed.
-Lemma closed_wrtl_andp: forall S (P Q: environ->mpred),
+Lemma closed_wrtl_andp `{!heapGS Σ}: forall S (P Q: assert),
   closed_wrt_lvars S P -> closed_wrt_lvars S Q ->
-  closed_wrt_lvars S (P && Q).
+  closed_wrt_lvars S (P ∧ Q).
 Proof.
-intros; hnf in *; intros.
-simpl. f_equal; eauto.
+  intros; hnf in *; intros.
+  monPred.unseal; f_equiv; eauto.
 Qed.
-#[export] Hint Resolve closed_wrt_andp closed_wrtl_andp : closed.
 
-Lemma closed_wrt_exp: forall {A} S (P: A -> environ->mpred),
+Lemma closed_wrt_exp `{!heapGS Σ}: forall {A} S (P: A -> assert),
   (forall a, closed_wrt_vars S (P a)) ->
-  closed_wrt_vars S (exp P).
+  closed_wrt_vars S (∃ x, P x).
 Proof.
-intros; hnf in *; intros.
-simpl. apply exp_congr. intros a.
-specialize (H a).
-hnf in H.
-eauto.
+  repeat intro.
+  monPred.unseal.
+  f_equiv; intros a.
+  apply H; auto.
 Qed.
 
-Lemma closed_wrtl_exp: forall {A} S (P: A -> environ->mpred),
+Lemma closed_wrtl_exp `{!heapGS Σ}: forall {A} S (P: A -> assert),
   (forall a, closed_wrt_lvars S (P a)) ->
-  closed_wrt_lvars S (exp P).
+  closed_wrt_lvars S (∃ x, P x).
 Proof.
-intros; hnf in *; intros.
-simpl. apply exp_congr. intros a.
-specialize (H a).
-hnf in H.
-eauto.
+  repeat intro.
+  monPred.unseal.
+  f_equiv; intros a.
+  apply H; auto.
 Qed.
-#[export] Hint Resolve closed_wrt_exp closed_wrtl_exp : closed.
 
-Lemma closed_wrt_imp: forall S (P Q: environ->mpred),
+(*Lemma closed_wrt_imp: forall S (P Q: assert),
   closed_wrt_vars S P -> closed_wrt_vars S Q ->
-  closed_wrt_vars S (P --> Q).
-Proof.
-intros; hnf in *; intros.
+  closed_wrt_vars S (P → Q).
+Proof.
+  intros; hnf in *; intros.
+  monPred.unseal; f_equiv; intros ?.
+  iSplit; iIntros "?" (Heq); hnf in Heq; subst.
+  hnf in H2; subst.
+  f_equiv.
+  eauto.
 simpl. f_equal; eauto.
 Qed.
-Lemma closed_wrtl_imp: forall S (P Q: environ->mpred),
+Lemma closed_wrtl_imp: forall S (P Q: assert),
   closed_wrt_lvars S P -> closed_wrt_lvars S Q ->
-  closed_wrt_lvars S (P --> Q).
+  closed_wrt_lvars S (P → Q).
 Proof.
 intros; hnf in *; intros.
 simpl. f_equal; eauto.
-Qed.
-#[export] Hint Resolve closed_wrt_imp closed_wrtl_imp : closed.
+Qed.*)
 
-Lemma closed_wrt_sepcon: forall S (P Q: environ->mpred),
+Lemma closed_wrt_sepcon `{!heapGS Σ}: forall S (P Q: assert),
   closed_wrt_vars S P -> closed_wrt_vars S Q ->
-  closed_wrt_vars S (P * Q).
+  closed_wrt_vars S (P ∗ Q).
 Proof.
-intros; hnf in *; intros.
-simpl. f_equal; eauto.
+  intros; hnf in *; intros.
+  monPred.unseal; f_equiv; auto.
 Qed.
-Lemma closed_wrtl_sepcon: forall S (P Q: environ->mpred),
+Lemma closed_wrtl_sepcon `{!heapGS Σ}: forall S (P Q: assert),
   closed_wrt_lvars S P -> closed_wrt_lvars S Q ->
-  closed_wrt_lvars S (P * Q).
+  closed_wrt_lvars S (P ∗ Q).
 Proof.
-intros; hnf in *; intros.
-simpl. f_equal; eauto.
+  intros; hnf in *; intros.
+  monPred.unseal; f_equiv; auto.
 Qed.
-#[export] Hint Resolve closed_wrt_sepcon closed_wrtl_sepcon : closed.
-
-Lemma closed_wrt_emp {A} {ND: NatDed A} {SL: SepLog A}:
-  forall S, closed_wrt_vars S emp.
-Proof. repeat intro. reflexivity. Qed.
-Lemma closed_wrtl_emp {A} {ND: NatDed A} {SL: SepLog A}:
-  forall S, closed_wrt_lvars S emp.
-Proof. repeat intro. reflexivity. Qed.
 
-Definition closed_wrt_emp_mpred := @closed_wrt_emp mpred Nveric Sveric.
-Definition closed_wrtl_emp_mpred := @closed_wrtl_emp mpred Nveric Sveric.
-#[export] Hint Resolve closed_wrt_emp_mpred closed_wrtl_emp_mpred  : closed.
+Lemma closed_wrt_emp `{!heapGS Σ}: forall S, closed_wrt_vars S (emp : assert).
+Proof. repeat intro. monPred.unseal. reflexivity. Qed.
+Lemma closed_wrtl_emp `{!heapGS Σ}: forall S, closed_wrt_lvars S (emp : assert).
+Proof. repeat intro. monPred.unseal. reflexivity. Qed.
 
-Lemma closed_wrt_allp: forall A S P,
+Lemma closed_wrt_allp `{!heapGS Σ}: forall A S (P : A -> assert),
   (forall x: A, closed_wrt_vars S (P x)) ->
-  closed_wrt_vars S (allp P).
+  closed_wrt_vars S (∀ x, P x).
 Proof.
-intros; hnf in *; intros.
-simpl.
-apply pred_ext; apply allp_right; intro x; apply (allp_left _ x);
-specialize (H x rho te' H0);
-apply derives_refl'; congruence.
+  intros; hnf in *; intros.
+  monPred.unseal.
+  f_equiv; intros a.
+  apply H; auto.
 Qed.
-Lemma closed_wrtl_allp: forall A S P,
+Lemma closed_wrtl_allp `{!heapGS Σ}: forall A S (P : A -> assert),
   (forall x: A, closed_wrt_lvars S (P x)) ->
-  closed_wrt_lvars S (allp P).
+  closed_wrt_lvars S (∀ x, P x).
 Proof.
-intros; hnf in *; intros.
-simpl.
-apply pred_ext; apply allp_right; intro x; apply (allp_left _ x);
-specialize (H x rho ve' H0);
-apply derives_refl'; congruence.
+  intros; hnf in *; intros.
+  monPred.unseal.
+  f_equiv; intros a.
+  apply H; auto.
 Qed.
-#[export] Hint Resolve closed_wrt_allp closed_wrtl_allp : closed.
 
 Lemma closed_wrt_not1:
   forall (i j: ident),
@@ -732,33 +735,31 @@ intros.
 hnf.
 intros; subst; congruence.
 Qed.
-#[export] Hint Resolve closed_wrt_not1 : closed.
 
-Lemma closed_wrt_tc_andp:
+Lemma closed_wrt_tc_andp `{!heapGS Σ}:
   forall {cs: compspecs} S a b,
   closed_wrt_vars S (denote_tc_assert a) ->
   closed_wrt_vars S (denote_tc_assert b) ->
   closed_wrt_vars S (denote_tc_assert (tc_andp a b)).
 Proof.
- intros.
- hnf; intros.
- repeat rewrite denote_tc_assert_andp; simpl; f_equal; auto.
+  intros; hnf in *; intros.
+  rewrite !denote_tc_assert_andp.
+  monPred.unseal; f_equiv; eauto.
 Qed.
 
 
-Lemma closed_wrt_tc_orp:
+Lemma closed_wrt_tc_orp `{!heapGS Σ}:
   forall {cs: compspecs} S a b,
   closed_wrt_vars S (denote_tc_assert a) ->
   closed_wrt_vars S (denote_tc_assert b) ->
   closed_wrt_vars S (denote_tc_assert (tc_orp a b)).
 Proof.
- intros.
- hnf; intros.
- repeat rewrite denote_tc_assert_orp; simpl.
- f_equal; auto.
+  intros; hnf in *; intros.
+  rewrite !denote_tc_assert_orp.
+  monPred.unseal; f_equiv; eauto.
 Qed.
 
-Lemma closed_wrt_tc_bool:
+Lemma closed_wrt_tc_bool `{!heapGS Σ}:
   forall {cs: compspecs} S b e, closed_wrt_vars S (denote_tc_assert (tc_bool b e)).
 Proof.
  intros.
@@ -766,7 +767,7 @@ Proof.
  destruct b; simpl; auto.
 Qed.
 
-Lemma closed_wrt_tc_int_or_ptr_type:
+Lemma closed_wrt_tc_int_or_ptr_type `{!heapGS Σ}:
   forall {cs: compspecs} S t, 
   closed_wrt_vars S (denote_tc_assert (tc_int_or_ptr_type t)).
 Proof.
@@ -774,42 +775,38 @@ Proof.
  apply closed_wrt_tc_bool.
 Qed.
 
-#[export] Hint Resolve closed_wrt_tc_andp closed_wrt_tc_orp closed_wrt_tc_bool
-              closed_wrt_tc_int_or_ptr_type : closed.
 
-Lemma closed_wrtl_tc_andp:
+Lemma closed_wrtl_tc_andp `{!heapGS Σ}:
   forall {cs: compspecs} S a b,
   closed_wrt_lvars S (denote_tc_assert a) ->
   closed_wrt_lvars S (denote_tc_assert b) ->
   closed_wrt_lvars S (denote_tc_assert (tc_andp a b)).
 Proof.
- intros.
- hnf; intros.
- repeat rewrite denote_tc_assert_andp; simpl; f_equal; auto.
+  intros; hnf in *; intros.
+  rewrite !denote_tc_assert_andp.
+  monPred.unseal; f_equiv; eauto.
 Qed.
 
 
-Lemma closed_wrtl_tc_orp:
+Lemma closed_wrtl_tc_orp `{!heapGS Σ}:
   forall {cs: compspecs} S a b,
   closed_wrt_lvars S (denote_tc_assert a) ->
   closed_wrt_lvars S (denote_tc_assert b) ->
   closed_wrt_lvars S (denote_tc_assert (tc_orp a b)).
 Proof.
- intros.
- hnf; intros.
- repeat rewrite denote_tc_assert_orp; simpl.
- f_equal; auto.
+  intros; hnf in *; intros.
+  rewrite !denote_tc_assert_orp.
+  monPred.unseal; f_equiv; eauto.
 Qed.
-Lemma closed_wrtl_tc_bool:
+Lemma closed_wrtl_tc_bool `{!heapGS Σ}:
   forall {cs: compspecs} S b e, closed_wrt_lvars S (denote_tc_assert (tc_bool b e)).
 Proof.
  intros.
  hnf; intros.
  destruct b; simpl; auto.
 Qed.
-#[export] Hint Resolve closed_wrtl_tc_andp closed_wrtl_tc_orp closed_wrtl_tc_bool : closed.
 
-Lemma closed_wrt_tc_test_eq:
+Lemma closed_wrt_tc_test_eq `{!heapGS Σ}:
   forall {cs: compspecs} S e e',
           expr_closed_wrt_vars S e ->
           expr_closed_wrt_vars S e' ->
@@ -819,10 +816,10 @@ Lemma closed_wrt_tc_test_eq:
 Proof.
 intros.
 hnf; intros.
-rewrite !binop_lemmas2.denote_tc_assert_test_eq'.
-simpl. unfold_lift. rewrite H, H0; auto.
+rewrite !denote_tc_assert_test_eq'.
+simpl. unfold_lift. f_equiv; hnf; eauto.
 Qed.
-Lemma closed_wrtl_tc_test_eq:
+Lemma closed_wrtl_tc_test_eq `{!heapGS Σ}:
   forall {cs: compspecs} S e e',
           expr_closed_wrt_lvars S e ->
           expr_closed_wrt_lvars S e' ->
@@ -832,12 +829,11 @@ Lemma closed_wrtl_tc_test_eq:
 Proof.
 intros.
 hnf; intros.
-rewrite !binop_lemmas2.denote_tc_assert_test_eq'.
-simpl. unfold_lift. rewrite H, H0; auto.
+rewrite !denote_tc_assert_test_eq'.
+simpl. unfold_lift. f_equiv; hnf; eauto.
 Qed.
-#[export] Hint Resolve  closed_wrt_tc_test_eq  closed_wrtl_tc_test_eq : closed.
 
-Lemma closed_wrt_tc_test_order:
+Lemma closed_wrt_tc_test_order `{!heapGS Σ}:
   forall {cs: compspecs} S e e',
           expr_closed_wrt_vars S e ->
           expr_closed_wrt_vars S e' ->
@@ -847,10 +843,10 @@ Lemma closed_wrt_tc_test_order:
 Proof.
 intros.
 hnf; intros.
-rewrite !binop_lemmas2.denote_tc_assert_test_order'.
-simpl. unfold_lift. rewrite H, H0; auto.
+rewrite !denote_tc_assert_test_order'.
+simpl. unfold_lift. f_equiv; hnf; eauto.
 Qed.
-Lemma closed_wrtl_tc_test_order:
+Lemma closed_wrtl_tc_test_order `{!heapGS Σ}:
   forall {cs: compspecs} S e e',
           expr_closed_wrt_lvars S e ->
           expr_closed_wrt_lvars S e' ->
@@ -860,10 +856,9 @@ Lemma closed_wrtl_tc_test_order:
 Proof.
 intros.
 hnf; intros.
-rewrite !binop_lemmas2.denote_tc_assert_test_order'.
-simpl. unfold_lift. rewrite H, H0; auto.
+rewrite !denote_tc_assert_test_order'.
+simpl. unfold_lift. f_equiv; hnf; eauto.
 Qed.
-#[export] Hint Resolve  closed_wrt_tc_test_order  closed_wrtl_tc_test_order : closed.
 
 Lemma expr_closed_const_int:
   forall {cs: compspecs} S i t, expr_closed_wrt_vars S (Econst_int i t).
@@ -877,12 +872,11 @@ Proof.
 intros. unfold expr_closed_wrt_lvars. simpl; intros.
 super_unfold_lift. auto.
 Qed.
-#[export] Hint Resolve expr_closed_const_int expr_closedl_const_int : closed.
 
 
-Lemma closed_wrt_tc_iszero:
+Lemma closed_wrt_tc_iszero `{!heapGS Σ}:
   forall {cs: compspecs}  S e, expr_closed_wrt_vars S e ->
-    closed_wrt_vars S (expr2.denote_tc_assert (tc_iszero e)).
+    closed_wrt_vars S (denote_tc_assert (tc_iszero e)).
 Proof.
 intros.
 rewrite binop_lemmas2.denote_tc_assert_iszero'.
@@ -890,20 +884,18 @@ simpl.
 hnf; intros. hnf in H. specialize (H _ _ H0).
 unfold_lift. rewrite <- H. auto.
 Qed.
-#[export] Hint Resolve closed_wrt_tc_iszero : closed.
 
-Lemma closed_wrtl_tc_iszero:
+Lemma closed_wrtl_tc_iszero `{!heapGS Σ}:
   forall {cs: compspecs}  S e, expr_closed_wrt_lvars S e ->
-    closed_wrt_lvars S (expr2.denote_tc_assert (tc_iszero e)).
+    closed_wrt_lvars S (denote_tc_assert (tc_iszero e)).
 Proof.
 intros.
 rewrite binop_lemmas2.denote_tc_assert_iszero'.
 hnf; intros. specialize (H _ _ _ H0).
 simpl. unfold_lift; simpl. rewrite <- H; auto.
 Qed.
-#[export] Hint Resolve closed_wrtl_tc_iszero : closed.
 
-Lemma closed_wrt_tc_isptr:
+Lemma closed_wrt_tc_isptr `{!heapGS Σ}:
  forall {cs: compspecs} S e,
      expr_closed_wrt_vars S e ->
      closed_wrt_vars S (denote_tc_assert (tc_isptr e)).
@@ -911,11 +903,10 @@ Proof.
  intros.
  hnf; intros.
  specialize (H _ _ H0).
- simpl. unfold_lift. f_equal; auto.
+ simpl. unfold_lift. f_equiv; auto.
 Qed.
-#[export] Hint Resolve closed_wrt_tc_isptr : closed.
 
-Lemma closed_wrtl_tc_isptr:
+Lemma closed_wrtl_tc_isptr `{!heapGS Σ}:
  forall {cs: compspecs} S e,
      expr_closed_wrt_lvars S e ->
      closed_wrt_lvars S (denote_tc_assert (tc_isptr e)).
@@ -924,9 +915,8 @@ Proof.
  hnf; intros. specialize (H _ _ _ H0).
  simpl. unfold_lift; simpl. rewrite <- H; auto.
 Qed.
-#[export] Hint Resolve closed_wrtl_tc_isptr : closed.
 
-Lemma closed_wrt_tc_isint:
+Lemma closed_wrt_tc_isint `{!heapGS Σ}:
  forall {cs: compspecs} S e,
      expr_closed_wrt_vars S e ->
      closed_wrt_vars S (denote_tc_assert (tc_isint e)).
@@ -934,11 +924,10 @@ Proof.
  intros.
  hnf; intros.
  specialize (H _ _ H0).
- simpl. unfold_lift. f_equal; auto.
+ simpl. unfold_lift. f_equiv; auto.
 Qed.
-#[export] Hint Resolve closed_wrt_tc_isint : closed.
 
-Lemma closed_wrtl_tc_isint:
+Lemma closed_wrtl_tc_isint `{!heapGS Σ}:
  forall {cs: compspecs} S e,
      expr_closed_wrt_lvars S e ->
      closed_wrt_lvars S (denote_tc_assert (tc_isint e)).
@@ -946,11 +935,10 @@ Proof.
  intros.
  hnf; intros.
  specialize (H _ _ _ H0).
- simpl. unfold_lift. f_equal; auto.
+ simpl. unfold_lift. f_equiv; auto.
 Qed.
-#[export] Hint Resolve closed_wrtl_tc_isint : closed.
 
-Lemma closed_wrt_tc_islong:
+Lemma closed_wrt_tc_islong `{!heapGS Σ}:
  forall {cs: compspecs} S e,
      expr_closed_wrt_vars S e ->
      closed_wrt_vars S (denote_tc_assert (tc_islong e)).
@@ -958,11 +946,10 @@ Proof.
  intros.
  hnf; intros.
  specialize (H _ _ H0).
- simpl. unfold_lift. f_equal; auto.
+ simpl. unfold_lift. f_equiv; auto.
 Qed.
-#[export] Hint Resolve closed_wrt_tc_islong : closed.
 
-Lemma closed_wrtl_tc_islong:
+Lemma closed_wrtl_tc_islong `{!heapGS Σ}:
  forall {cs: compspecs} S e,
      expr_closed_wrt_lvars S e ->
      closed_wrt_lvars S (denote_tc_assert (tc_islong e)).
@@ -970,29 +957,10 @@ Proof.
  intros.
  hnf; intros.
  specialize (H _ _ _ H0).
- simpl. unfold_lift. f_equal; auto.
-Qed.
-#[export] Hint Resolve closed_wrtl_tc_islong : closed.
-
-Lemma closed_wrt_isCastResultType:
-  forall {cs: compspecs} S e t t0,
-          expr_closed_wrt_vars S e ->
-          closed_wrt_vars S
-                 (denote_tc_assert (isCastResultType (implicit_deref t) t0 e)).
-Proof.
- intros.
-rewrite expr_lemmas3.isCastR.
-destruct (classify_cast (implicit_deref t) t0) eqn:?;
-  simpl; auto with closed;
- try solve [destruct t0 as [ | [ | | | ] [|] | [|] | [ | ] |  | | | | ]; simpl;
-                auto with closed; try reflexivity];
-  auto with closed;
- repeat simple_if_tac; try destruct si2; simpl; auto with closed.
- apply closed_wrt_tc_test_eq; auto with closed.
- hnf; intros. reflexivity.
+ simpl. unfold_lift. f_equiv; auto.
 Qed.
 
-Lemma closed_wrtl_tc_Zge:
+Lemma closed_wrtl_tc_Zge `{!heapGS Σ}:
   forall  {cs: compspecs} S e i,
    expr_closed_wrt_lvars S e ->
    closed_wrt_lvars S  (denote_tc_assert (tc_Zge e i)).
@@ -1001,7 +969,7 @@ intros.
 hnf; intros. simpl. unfold_lift. rewrite (H _ _ _ H0). auto.
 Qed.
 
-Lemma closed_wrtl_tc_Zle:
+Lemma closed_wrtl_tc_Zle `{!heapGS Σ}:
   forall  {cs: compspecs} S e i,
    expr_closed_wrt_lvars S e ->
    closed_wrt_lvars S  (denote_tc_assert (tc_Zle e i)).
@@ -1009,31 +977,130 @@ Proof.
 intros.
 hnf; intros. simpl. unfold_lift. rewrite (H _ _ _ H0). auto.
 Qed.
+
+Lemma closed_wrt_tc_Zge `{!heapGS Σ}:
+  forall {cs: compspecs} S e n,
+    closed_wrt_vars S (eval_expr e) ->
+    closed_wrt_vars S (denote_tc_assert (tc_Zge e n)).
+Proof.
+ intros; hnf; intros.
+ simpl. unfold_lift; f_equiv; auto.
+Qed.
+
+Lemma closed_wrt_tc_Zle `{!heapGS Σ}:
+  forall {cs: compspecs} S e n,
+    closed_wrt_vars S (eval_expr e) ->
+    closed_wrt_vars S (denote_tc_assert (tc_Zle e n)).
+Proof.
+ intros; hnf; intros.
+ simpl. unfold_lift; f_equiv; auto.
+Qed.
+
+(*End CLOSED_LEMMAS. *)
+
+#[export] Hint Rewrite @closed_env_set using safe_auto_with_closed : norm2.
+#[export] Hint Rewrite subst_eval_id_eq : subst.
+#[export] Hint Rewrite subst_eval_id_neq using safe_auto_with_closed : subst.
+#[export] Hint Rewrite @subst_eval_expr_eq @subst_eval_lvalue_eq : subst.
+#[export] Hint Rewrite @closed_wrt_map_subst using safe_auto_with_closed : subst.
+#[export] Hint Rewrite @closed_wrt_subst using safe_auto_with_closed : subst.
+#[export] Hint Rewrite @closed_wrt_map_subst' using safe_auto_with_closed : subst.
+#[export] Hint Rewrite @closed_wrt_subst_eval_expr using solve [auto 50 with closed] : subst.
+#[export] Hint Rewrite @closed_wrt_subst_eval_lvalue using solve [auto 50 with closed] : subst.
+#[export] Hint Unfold closed_wrt_modvars : closed.
+#[export] Hint Resolve closed_wrt_local closed_wrtl_local : closed.
+#[export] Hint Resolve closed_wrt_lift0 closed_wrtl_lift0 : closed.
+#[export] Hint Resolve closed_wrt_lift0C closed_wrtl_lift0C: closed.
+#[export] Hint Resolve closed_wrt_embed closed_wrtl_embed : closed.
+#[export] Hint Resolve closed_wrt_lift1 closed_wrtl_lift1 : closed.
+(*#[export] Hint Resolve closed_wrt_lift1C closed_wrtl_lift1C : closed.
+#[export] Hint Resolve closed_wrt_lift2 closed_wrtl_lift2 : closed.
+#[export] Hint Resolve closed_wrt_lift2C closed_wrtl_lift2C : closed.
+#[export] Hint Resolve closed_wrt_lift3 closed_wrtl_lift3 : closed.
+#[export] Hint Resolve closed_wrt_lift3C closed_wrtl_lift3C : closed.
+#[export] Hint Resolve closed_wrt_lift4  closed_wrtl_lift4 : closed.
+#[export] Hint Resolve closed_wrt_lift4C closed_wrtl_lift4C : closed.*)
+#[export] Hint Resolve closed_wrt_const closed_wrtl_const : closed.
+#[export] Hint Resolve closed_wrt_eval_var : closed.
+#[export] Hint Resolve closed_wrtl_eval_var : closed.
+#[export] Hint Resolve closed_wrt_lvar : closed.
+#[export] Hint Resolve closed_wrt_gvars : closed.
+#[export] Hint Resolve closed_wrtl_gvars : closed.
+#[export] Hint Resolve closed_wrtl_lvar : closed.
+(*#[export] Hint Resolve closed_wrt_cmp_ptr closed_wrtl_cmp_ptr: closed.*)
+#[export] Hint Resolve closed_wrt_eval_id closed_wrtl_eval_id : closed.
+#[export] Hint Resolve closed_wrt_temp closed_wrtl_temp : closed.
+#[export] Hint Resolve closed_wrt_get_result1 closed_wrtl_get_result1 : closed.
+#[export] Hint Resolve closed_wrt_tc_FF closed_wrtl_tc_FF : closed.
+#[export] Hint Resolve closed_wrt_tc_TT closed_wrtl_tc_TT : closed.
+#[export] Hint Resolve closed_wrt_andp closed_wrtl_andp : closed.
+#[export] Hint Resolve closed_wrt_exp closed_wrtl_exp : closed.
+(*#[export] Hint Resolve closed_wrt_imp closed_wrtl_imp : closed.*)
+#[export] Hint Resolve closed_wrt_sepcon closed_wrtl_sepcon : closed.
+#[export] Hint Resolve closed_wrt_emp closed_wrtl_emp  : closed.
+#[export] Hint Resolve closed_wrt_allp closed_wrtl_allp : closed.
+#[export] Hint Resolve closed_wrt_not1 : closed.
+#[export] Hint Resolve closed_wrt_tc_andp closed_wrt_tc_orp closed_wrt_tc_bool
+              closed_wrt_tc_int_or_ptr_type : closed.
+#[export] Hint Resolve closed_wrtl_tc_andp closed_wrtl_tc_orp closed_wrtl_tc_bool : closed.
+#[export] Hint Resolve  closed_wrt_tc_test_eq  closed_wrtl_tc_test_eq : closed.
+#[export] Hint Resolve  closed_wrt_tc_test_order  closed_wrtl_tc_test_order : closed.
+#[export] Hint Resolve expr_closed_const_int expr_closedl_const_int : closed.
+#[export] Hint Resolve closed_wrt_tc_iszero : closed.
+#[export] Hint Resolve closed_wrtl_tc_iszero : closed.
+#[export] Hint Resolve closed_wrt_tc_isptr : closed.
+#[export] Hint Resolve closed_wrtl_tc_isptr : closed.
+#[export] Hint Resolve closed_wrt_tc_isint : closed.
+#[export] Hint Resolve closed_wrtl_tc_isint : closed.
+#[export] Hint Resolve closed_wrt_tc_islong : closed.
+#[export] Hint Resolve closed_wrtl_tc_islong : closed.
 #[export] Hint Resolve closed_wrtl_tc_Zge closed_wrtl_tc_Zle : closed.
+#[export] Hint Resolve closed_wrt_tc_Zge : closed.
+#[export] Hint Resolve closed_wrt_tc_Zle : closed.
+
+(*Section CLOSED_LEMMAS2.
+
+Context `{!heapGS Σ}.
+*)
+
+Lemma closed_wrt_isCastResultType `{!heapGS Σ}:
+  forall {cs: compspecs} S e t t0,
+          expr_closed_wrt_vars S e ->
+          closed_wrt_vars S
+                 (denote_tc_assert (isCastResultType (implicit_deref t) t0 e)).
+Proof.
+  intros.
+  rewrite expr_lemmas3.isCastR.
+  destruct (classify_cast (implicit_deref t) t0) eqn:?; auto;
+    try solve [destruct t0 as [ | [ | | | ] [|] | [|] | [ | ] |  | | | | ];
+                auto with closed; try reflexivity];
+    auto with closed;
+    repeat simple_if_tac; try destruct si2; auto with closed; simpl; auto with closed.
+  apply closed_wrt_tc_test_eq; auto with closed.
+  hnf; intros. reflexivity.
+Qed.
 
-Lemma closed_wrtl_isCastResultType:
+Lemma closed_wrtl_isCastResultType `{!heapGS Σ}:
   forall {cs: compspecs} S e t t0,
           expr_closed_wrt_lvars S e ->
           closed_wrt_lvars S
                  (denote_tc_assert (isCastResultType (implicit_deref t) t0 e)).
 Proof.
- intros.
-rewrite expr_lemmas3.isCastR.
-
-change expr2.denote_tc_assert with denote_tc_assert.
-destruct (classify_cast (implicit_deref t) t0) eqn:?;
-  auto with closed;
- try solve [destruct t0 as [ | [ | | | ] [|] | [|] | [ | ] |  | | | | ]; simpl;
+  intros.
+  rewrite expr_lemmas3.isCastR.
+  destruct (classify_cast (implicit_deref t) t0) eqn:?;
+    auto with closed;
+    try solve [destruct t0 as [ | [ | | | ] [|] | [|] | [ | ] |  | | | | ];
                 auto with closed; try reflexivity];
-repeat simple_if_tac;  auto with closed;
- try destruct si2; auto with closed.
- apply closed_wrtl_tc_test_eq; auto with closed.
- hnf; intros. reflexivity.
+    repeat simple_if_tac;  auto with closed;
+    try destruct si2; auto with closed; simpl; auto with closed.
+  apply closed_wrtl_tc_test_eq; auto with closed.
+  hnf; intros. reflexivity.
 Qed.
 
-#[export] Hint Resolve closed_wrt_isCastResultType closed_wrtl_isCastResultType : closed.
+#[local] Hint Resolve closed_wrt_isCastResultType closed_wrtl_isCastResultType : closed.
 
-Lemma closed_wrt_tc_temp_id :
+Lemma closed_wrt_tc_temp_id `{!heapGS Σ}:
   forall {cs: compspecs} Delta S e id t, expr_closed_wrt_vars S e ->
                          expr_closed_wrt_vars S (Etempvar id t) ->
              closed_wrt_vars S (tc_temp_id id t Delta e).
@@ -1041,10 +1108,10 @@ Proof.
 intros.
 unfold tc_temp_id.
 unfold typecheck_temp_id.
-destruct ( (temp_types Delta) ! id) eqn:?; try destruct p; simpl; auto with closed.
+destruct ( (temp_types Delta) !! id) eqn:?; try destruct p; auto with closed.
 Qed.
 
-Lemma closed_wrtl_tc_temp_id :
+Lemma closed_wrtl_tc_temp_id `{!heapGS Σ}:
   forall {cs: compspecs} Delta S e id t, expr_closed_wrt_lvars S e ->
                          expr_closed_wrt_lvars S (Etempvar id t) ->
              closed_wrt_lvars S (tc_temp_id id t Delta e).
@@ -1052,10 +1119,9 @@ Proof.
 intros.
 unfold tc_temp_id.
 unfold typecheck_temp_id.
-destruct ( (temp_types Delta) ! id) eqn:?; try destruct p; simpl; auto with closed.
+destruct ( (temp_types Delta) !! id) eqn:?; try destruct p; auto with closed.
 Qed.
 
-#[export] Hint Resolve closed_wrt_tc_temp_id closed_wrtl_tc_temp_id : closed.
 
 Lemma expr_closed_tempvar:
  forall {cs: compspecs} S i t, ~ S i -> expr_closed_wrt_vars S (Etempvar i t).
@@ -1073,9 +1139,6 @@ intros.
 hnf; intros.
 simpl. unfold eval_id. f_equal.
 Qed.
-#[export] Hint Resolve expr_closed_tempvar expr_closedl_tempvar : closed.
-
-#[export] Hint Extern 1 (not (@eq ident _ _)) => (let Hx := fresh in intro Hx; inversion Hx) : closed.
 
 Lemma expr_closed_cast: forall {cs: compspecs} S e t,
      expr_closed_wrt_vars S e ->
@@ -1095,7 +1158,6 @@ Proof.
  super_unfold_lift.
  destruct (H cs rho ve' H0); auto.
 Qed.
-#[export] Hint Resolve expr_closed_cast expr_closedl_cast : closed.
 
 Lemma expr_closed_field: forall {cs: compspecs} S e f t,
   lvalue_closed_wrt_vars S e ->
@@ -1117,7 +1179,6 @@ Proof.
  f_equal.
  apply H.  auto.
 Qed.
-#[export] Hint Resolve expr_closed_field expr_closedl_field : closed.
 
 Lemma expr_closed_binop: forall {cs: compspecs} S op e1 e2 t,
      expr_closed_wrt_vars S e1 ->
@@ -1137,7 +1198,6 @@ Proof.
  simpl.
  super_unfold_lift. f_equal; auto.
 Qed.
-#[export] Hint Resolve expr_closed_binop expr_closedl_binop : closed.
 
 Lemma expr_closed_unop: forall {cs: compspecs} S op e t,
      expr_closed_wrt_vars S e ->
@@ -1155,9 +1215,8 @@ Proof.
  simpl.
  super_unfold_lift. f_equal; auto.
 Qed.
-#[export] Hint Resolve expr_closed_unop expr_closedl_unop : closed.
 
-Lemma closed_wrt_stackframe_of:
+Lemma closed_wrt_stackframe_of `{!heapGS Σ}:
   forall {cs: compspecs} S f, closed_wrt_vars S (stackframe_of f).
 Proof.
 intros.
@@ -1166,28 +1225,28 @@ induction (fn_vars f); auto.
 apply closed_wrt_emp.
 apply closed_wrt_sepcon; [ | apply IHl].
 clear. destruct a; unfold var_block.
-hnf; intros. reflexivity.
+hnf; intros. by monPred.unseal.
 Qed.
-#[export] Hint Resolve closed_wrt_stackframe_of : closed.
 
 Definition included {U} (S S': U -> Prop) := forall x, S x -> S' x.
 
-Lemma closed_wrt_TT:
+(*Local Notation assert := (@assert Σ).*)
+
+Lemma closed_wrt_TT `{!heapGS Σ}:
  forall  (S: ident -> Prop),
-  closed_wrt_vars S (@TT (environ -> mpred) _).
+  closed_wrt_vars S (True : assert).
 Proof.
-intros. hnf; intros. reflexivity.
+intros. hnf; intros. by monPred.unseal.
 Qed.
-Lemma closed_wrtl_TT:
+Lemma closed_wrtl_TT `{!heapGS Σ}:
  forall  (S: ident -> Prop),
-  closed_wrt_lvars S (@TT (environ -> mpred) _).
+  closed_wrt_lvars S (True : assert).
 Proof.
-intros. hnf; intros. reflexivity.
+intros. hnf; intros. by monPred.unseal.
 Qed.
-#[export] Hint Resolve closed_wrt_TT closed_wrtl_TT : closed.
 
 Lemma closed_wrt_subset:
-  forall (S S': ident -> Prop) (H: included S' S) B (f: environ -> B),
+  forall (S S': ident -> Prop) (H: included S' S) `{!Equiv B} (f: environ -> B),
        closed_wrt_vars S f -> closed_wrt_vars S' f.
 Proof.
 intros. hnf. intros. specialize (H0 rho te').
@@ -1195,17 +1254,16 @@ apply H0.
 intro i; destruct (H1 i); auto.
 Qed.
 Lemma closed_wrtl_subset:
-  forall (S S': ident -> Prop) (H: included S' S) B (f: environ -> B),
+  forall (S S': ident -> Prop) (H: included S' S) `{!Equiv B} (f: environ -> B),
        closed_wrt_lvars S f -> closed_wrt_lvars S' f.
 Proof.
 intros. hnf. intros. specialize (H0 rho ve').
 apply H0.
 intro i; destruct (H1 i); auto.
 Qed.
-#[export] Hint Resolve closed_wrt_subset closed_wrtl_subset : closed.
 
 Lemma closed_wrt_Forall_subset:
-  forall S S' (H: included S' S) B (f: list (environ -> B)),
+  forall S S' (H: included S' S) `{!Equiv B} (f: list (environ -> B)),
  Forall (closed_wrt_vars S) f ->
  Forall (closed_wrt_vars S') f.
 Proof.
@@ -1217,7 +1275,7 @@ apply (closed_wrt_subset _ _ H). auto.
 auto.
 Qed.
 Lemma closed_wrtl_Forall_subset:
-  forall S S' (H: included S' S) B (f: list (environ -> B)),
+  forall S S' (H: included S' S) `{!Equiv B} (f: list (environ -> B)),
  Forall (closed_wrt_lvars S) f ->
  Forall (closed_wrt_lvars S') f.
 Proof.
@@ -1243,7 +1301,6 @@ simpl; intros.
 hnf; intros.
 simpl. reflexivity.
 Qed.
-#[export] Hint Resolve lvalue_closed_tempvar lvalue_closedl_tempvar : closed.
 
 Lemma expr_closed_addrof: forall {cs: compspecs} S e t,
      lvalue_closed_wrt_vars S e ->
@@ -1261,7 +1318,6 @@ Proof.
  simpl.
  super_unfold_lift. apply H.  auto.
 Qed.
-#[export] Hint Resolve expr_closed_addrof expr_closedl_addrof : closed.
 
 Lemma lvalue_closed_field: forall {cs: compspecs} S e f t,
   lvalue_closed_wrt_vars S e ->
@@ -1279,7 +1335,6 @@ Proof.
  simpl.
  super_unfold_lift. f_equal; apply H.  auto.
 Qed.
-#[export] Hint Resolve lvalue_closed_field lvalue_closedl_field : closed.
 
 Lemma lvalue_closed_deref: forall {cs: compspecs} S e t,
   expr_closed_wrt_vars S e ->
@@ -1297,7 +1352,39 @@ Proof.
  simpl.
  super_unfold_lift. apply H.  auto.
 Qed.
+
+Lemma expr_closed: forall {cs : compspecs} S e, closed_wrt_vars S (eval_expr e) -> expr_closed_wrt_vars S e.
+Proof. auto. Qed.
+
+Lemma closed_expr: forall {cs : compspecs} S e, expr_closed_wrt_vars S e -> closed_wrt_vars S (eval_expr e).
+Proof. auto. Qed.
+
+Lemma lvalue_closed: forall {cs : compspecs} S e, closed_wrt_vars S (eval_lvalue e) -> lvalue_closed_wrt_vars S e.
+Proof. auto. Qed.
+
+Lemma closed_lvalue: forall {cs : compspecs} S e, lvalue_closed_wrt_vars S e -> closed_wrt_vars S (eval_lvalue e).
+Proof. auto. Qed.
+
+(*End CLOSED_LEMMAS2. *)
+
+#[export] Hint Resolve closed_wrt_isCastResultType closed_wrtl_isCastResultType : closed.
+#[export] Hint Resolve closed_wrt_tc_temp_id closed_wrtl_tc_temp_id : closed.
+#[export] Hint Resolve expr_closed_tempvar expr_closedl_tempvar : closed.
+#[export] Hint Extern 1 (not (@eq ident _ _)) => (let Hx := fresh in intro Hx; inversion Hx) : closed.
+#[export] Hint Resolve expr_closed_cast expr_closedl_cast : closed.
+#[export] Hint Resolve expr_closed_field expr_closedl_field : closed.
+#[export] Hint Resolve expr_closed_binop expr_closedl_binop : closed.
+#[export] Hint Resolve expr_closed_unop expr_closedl_unop : closed.
+#[export] Hint Resolve closed_wrt_stackframe_of : closed.
+#[export] Hint Resolve closed_wrt_TT closed_wrtl_TT : closed.
+#[export] Hint Resolve closed_wrt_subset closed_wrtl_subset : closed.
+#[export] Hint Resolve lvalue_closed_tempvar lvalue_closedl_tempvar : closed.
+#[export] Hint Resolve expr_closed_addrof expr_closedl_addrof : closed.
+#[export] Hint Resolve lvalue_closed_field lvalue_closedl_field : closed.
 #[export] Hint Resolve lvalue_closed_deref lvalue_closedl_deref: closed.
+#[export] Hint Resolve expr_closed closed_expr lvalue_closed closed_lvalue: closed.
+
+(*Section EXPR_LEMMAS.*)
 
 Fixpoint closed_eval_expr (j: ident) (e: expr) : bool :=
  match e with
@@ -1330,18 +1417,13 @@ Lemma closed_eval_expr_e:
 with closed_eval_lvalue_e:
     forall {cs: compspecs} j e, closed_eval_lvalue j e = true -> closed_wrt_vars (eq j) (eval_lvalue e).
 Proof.
-intros cs j e; clear closed_eval_expr_e; induction e; intros; simpl; auto with closed.
-simpl in H. destruct (eqb_ident j i) eqn:?; inv H.
-apply Pos.eqb_neq in Heqb. auto with closed.
-simpl in H.
-rewrite andb_true_iff in H. destruct H.
-auto with closed.
-intros Delta j e; clear closed_eval_lvalue_e; induction e; intros; simpl; auto with closed.
+  intros cs j e; clear closed_eval_expr_e; induction e; intros; simpl in * |-; auto with closed; try solve [simpl; auto with closed]; try solve [apply IHe; auto with closed].
+  - destruct (eqb_ident j i) eqn:?; inv H.
+    apply Pos.eqb_neq in Heqb. simpl; auto with closed.
+  - rewrite andb_true_iff in H. destruct H. auto with closed.
+  - intros Delta j e; clear closed_eval_lvalue_e; induction e; intros; auto with closed; simpl; auto with closed.
 Qed.
 
-#[export] Hint Extern 2 (closed_wrt_vars (eq _) (@eval_expr _ _)) => (apply closed_eval_expr_e; reflexivity) : closed.
-#[export] Hint Extern 2 (closed_wrt_vars (eq _) (@eval_lvalue _ _)) => (apply closed_eval_lvalue_e; reflexivity) : closed.
-
 Lemma closed_wrt_eval_expr: forall {cs: compspecs} S e,
   expr_closed_wrt_vars S e ->
   closed_wrt_vars S (eval_expr e).
@@ -1362,15 +1444,17 @@ intros; specialize (H0 _ _ H1); clear H1; super_unfold_lift;
 auto.
 Qed.
 
-Lemma closed_wrt_ideq: forall {cs: compspecs} a b e,
+(*Context `{!heapGS Σ}. ) *)
+
+Lemma closed_wrt_ideq `{!heapGS Σ}: forall {cs: compspecs} a b e,
   a <> b ->
   closed_eval_expr a e = true ->
-  closed_wrt_vars (eq a) (fun rho => !! (eval_id b rho = eval_expr e rho)).
+  closed_wrt_vars (eq a) (fun rho => ⌜eval_id b rho = eval_expr e rho⌝ : mpred).
 Proof.
 intros.
 hnf; intros.
-simpl. f_equal.
-f_equal.
+simpl. f_equiv.
+f_equiv.
 specialize (H1 b).
 destruct H1; [contradiction | ].
 unfold eval_id; simpl. rewrite H1. auto.
@@ -1379,10 +1463,7 @@ eapply closed_eval_expr_e in H0.
 apply H0; auto.
 Qed.
 
-#[export] Hint Extern 2 (closed_wrt_vars (eq _) _) =>
-      (apply closed_wrt_ideq; [solve [let Hx := fresh in (intro Hx; inv Hx)] | reflexivity]) : closed.
-
-Lemma closed_wrt_tc_nonzero:
+Lemma closed_wrt_tc_nonzero `{!heapGS Σ}:
  forall {cs: compspecs} S e,
      closed_wrt_vars S (eval_expr e) ->
      closed_wrt_vars S (denote_tc_assert (tc_nonzero e)).
@@ -1390,74 +1471,50 @@ Proof.
  intros.
  hnf; intros.
  specialize (H _ _ H0).
- repeat rewrite binop_lemmas2.denote_tc_assert_nonzero.
+ simpl; repeat rewrite binop_lemmas2.denote_tc_assert_nonzero.
  rewrite <- H; auto.
 Qed.
-#[export] Hint Resolve closed_wrt_tc_nonzero : closed.
 
-Lemma closed_wrt_binarithType:
+Lemma closed_wrt_binarithType `{!heapGS Σ}:
   forall {cs: compspecs} S t1 t2 t a b,
   closed_wrt_vars S (denote_tc_assert (binarithType t1 t2 t a b)).
 Proof.
  intros.
  unfold binarithType.
- destruct (Cop.classify_binarith t1 t2); simpl; auto with closed.
+ destruct (Cop.classify_binarith t1 t2); auto with closed.
 Qed.
-#[export] Hint Resolve closed_wrt_binarithType : closed.
 
-Lemma closed_wrt_tc_samebase :
+Lemma closed_wrt_tc_samebase `{!heapGS Σ}:
  forall {cs: compspecs} S e1 e2,
  closed_wrt_vars S (eval_expr e1) ->
  closed_wrt_vars S (eval_expr e2) ->
  closed_wrt_vars S (denote_tc_assert (tc_samebase e1 e2)).
 Proof.
- intros;  hnf; intros. simpl. unfold_lift. f_equal; auto.
+ intros;  hnf; intros. simpl. unfold_lift. f_equiv; auto.
 Qed.
-#[export] Hint Resolve closed_wrt_tc_samebase : closed.
 
-Lemma closed_wrt_tc_ilt:
+Lemma closed_wrt_tc_ilt `{!heapGS Σ}:
   forall {cs: compspecs} S e n,
     closed_wrt_vars S (eval_expr e) ->
     closed_wrt_vars S (denote_tc_assert (tc_ilt e n)).
 Proof.
  intros; hnf; intros.
- repeat rewrite binop_lemmas2.denote_tc_assert_ilt'.
- simpl. unfold_lift. f_equal. auto.
+ simpl; repeat rewrite binop_lemmas2.denote_tc_assert_ilt'.
+ simpl. unfold_lift. f_equiv. auto.
 Qed.
-#[export] Hint Resolve closed_wrt_tc_ilt : closed.
 
-Lemma closed_wrt_tc_llt:
+Lemma closed_wrt_tc_llt `{!heapGS Σ}:
   forall {cs: compspecs} S e n,
     closed_wrt_vars S (eval_expr e) ->
     closed_wrt_vars S (denote_tc_assert (tc_llt e n)).
 Proof.
  intros; hnf; intros.
- repeat rewrite binop_lemmas2.denote_tc_assert_llt'.
- simpl. unfold_lift. f_equal. auto.
-Qed.
-#[export] Hint Resolve closed_wrt_tc_llt : closed.
-
-Lemma closed_wrt_tc_Zge:
-  forall {cs: compspecs} S e n,
-    closed_wrt_vars S (eval_expr e) ->
-    closed_wrt_vars S (denote_tc_assert (tc_Zge e n)).
-Proof.
- intros; hnf; intros.
- simpl. unfold_lift; f_equal; auto.
+ simpl; repeat rewrite binop_lemmas2.denote_tc_assert_llt'.
+ simpl. unfold_lift. f_equiv. auto.
 Qed.
-#[export] Hint Resolve closed_wrt_tc_Zge : closed.
-Lemma closed_wrt_tc_Zle:
-  forall {cs: compspecs} S e n,
-    closed_wrt_vars S (eval_expr e) ->
-    closed_wrt_vars S (denote_tc_assert (tc_Zle e n)).
-Proof.
- intros; hnf; intros.
- simpl. unfold_lift; f_equal; auto.
-Qed.
-#[export] Hint Resolve closed_wrt_tc_Zle : closed.
 
 Lemma closed_wrt_replace_nth:
-  forall {B} S n R (R1: environ -> B),
+  forall `{EB : Equiv B} S n R (R1: environ -> B),
     closed_wrt_vars S R1 ->
     Forall (closed_wrt_vars S) R ->
     Forall (closed_wrt_vars S) (replace_nth n R R1).
@@ -1466,21 +1523,19 @@ intros.
 revert R H0; induction n; destruct R; simpl; intros; auto with closed;
 inv H0; constructor; auto with closed.
 Qed.
-#[export] Hint Resolve closed_wrt_replace_nth : closed.
 
-Lemma closed_wrt_tc_nodivover :
+Lemma closed_wrt_tc_nodivover `{!heapGS Σ}:
  forall {cs: compspecs} S e1 e2,
  closed_wrt_vars S (eval_expr e1) ->
  closed_wrt_vars S (eval_expr e2) ->
  closed_wrt_vars S (denote_tc_assert (tc_nodivover e1 e2)).
 Proof.
  intros;  hnf; intros.
- repeat rewrite binop_lemmas2.denote_tc_assert_nodivover.
+ simpl; repeat rewrite binop_lemmas2.denote_tc_assert_nodivover.
  rewrite <- H0; auto. rewrite <- H; auto.
 Qed.
-#[export] Hint Resolve closed_wrt_tc_nodivover : closed.
 
-Lemma closed_wrt_tc_nosignedover:
+Lemma closed_wrt_tc_nosignedover `{!heapGS Σ}:
   forall op {CS: compspecs} S e1 e2,
   closed_wrt_vars S (eval_expr e1) ->
   closed_wrt_vars S (eval_expr e2) ->
@@ -1488,14 +1543,14 @@ Lemma closed_wrt_tc_nosignedover:
 Proof.
 intros; hnf; intros.
 simpl. unfold_lift.
-destruct (typeof e1)  as [ | _ [ | ] _ | | | | | | | ]; 
-destruct (typeof e2)  as [ | _ [ | ] _ | | | | | | | ]; 
-rewrite <- H; auto;
-rewrite <- H0; auto.
+destruct (typeof e1)  as [ | _ [ | ] _ | | | | | | | ];
+destruct (typeof e2)  as [ | _ [ | ] _ | | | | | | | ];
+rewrite <- (H _ _ H1), (H0 _ _ H1); done.
 Qed.
-#[export] Hint Resolve closed_wrt_tc_nosignedover : closed.
 
-Lemma closed_wrt_tc_nobinover:
+#[local] Hint Resolve closed_wrt_tc_nosignedover : closed.
+
+Lemma closed_wrt_tc_nobinover `{!heapGS Σ}:
   forall op {CS: compspecs} S e1 e2,
   closed_wrt_vars S (eval_expr e1) ->
   closed_wrt_vars S (eval_expr e2) ->
@@ -1513,35 +1568,52 @@ destruct (typeof e2); auto with closed;
 destruct s; auto with closed.
 Qed.
 
+(*End EXPR_LEMMAS.*)
+
+#[export] Hint Extern 2 (closed_wrt_vars (eq _) (@eval_expr _ _)) => (apply closed_eval_expr_e; reflexivity) : closed.
+#[export] Hint Extern 2 (closed_wrt_vars (eq _) (@eval_lvalue _ _)) => (apply closed_eval_lvalue_e; reflexivity) : closed.
+#[export] Hint Extern 2 (closed_wrt_vars (eq _) _) =>
+      (apply closed_wrt_ideq; [solve [let Hx := fresh in (intro Hx; inv Hx)] | reflexivity]) : closed.
+#[export] Hint Resolve closed_wrt_tc_nonzero : closed.
+#[export] Hint Resolve closed_wrt_binarithType : closed.
+#[export] Hint Resolve closed_wrt_tc_samebase : closed.
+#[export] Hint Resolve closed_wrt_tc_ilt : closed.
+#[export] Hint Resolve closed_wrt_tc_llt : closed.
+#[export] Hint Resolve closed_wrt_replace_nth : closed.
+#[export] Hint Resolve closed_wrt_tc_nodivover : closed.
+#[export] Hint Resolve closed_wrt_tc_nosignedover : closed.
 #[export] Hint Resolve closed_wrt_tc_nobinover : closed.
 
-Lemma closed_wrt_tc_expr:
+(*Section EXPR_LEMMAS2.*)
+
+(*Context `{!heapGS Σ}.*)
+
+Lemma closed_wrt_tc_expr `{!heapGS Σ}:
   forall {cs: compspecs} Delta j e, closed_eval_expr j e = true ->
              closed_wrt_vars (eq j) (tc_expr Delta e)
- with closed_wrt_tc_lvalue:
+ with closed_wrt_tc_lvalue `{!heapGS Σ}:
   forall {cs: compspecs} Delta j e, closed_eval_lvalue j e = true ->
              closed_wrt_vars (eq j) (tc_lvalue Delta e).
 Proof.
 * clear closed_wrt_tc_expr.
 unfold tc_expr.
-induction e; simpl; intros;
+induction e; intros; simpl in H; unfold typecheck_expr; fold typecheck_expr; fold typecheck_lvalue; auto with closed;
 try solve [destruct t  as [ | [ | | | ] [ | ] | | [ | ] | | | | | ]; simpl; auto with closed].
 +
-  destruct (access_mode t);  simpl; auto with closed;
-  destruct (get_var_type Delta i); simpl; auto with closed.
+  destruct (access_mode t);  auto with closed;
+  destruct (get_var_type Delta i); auto with closed.
 +
-  destruct ((temp_types Delta) ! i); simpl; auto with closed.
+  destruct ((temp_types Delta) !! i); simpl; auto with closed.
   destruct (is_neutral_cast t0 t || same_base_type t0 t)%bool; simpl; auto with closed.
   clear -  H.
   hnf; intros.
   specialize (H0 i).
-  pose proof (eqb_ident_spec j i).
+  pose proof (eqb_ident_spec j i); simpl in H.
   destruct (eqb_ident j i); inv H.
   destruct H0. apply H1 in H; inv H.
   unfold denote_tc_initialized;  simpl.
-  f_equal.
-  apply exists_ext; intro v.
-  f_equal. rewrite H; auto.
+  f_equiv; f_equiv; intros v.
+  f_equiv. rewrite H; auto.
 + destruct (access_mode t) eqn:?H; simpl; auto with closed.
   apply closed_wrt_tc_andp; auto with closed.
   apply closed_wrt_tc_isptr; auto with closed.
@@ -1556,8 +1628,9 @@ try solve [destruct t  as [ | [ | | | ] [ | ] | | [ | ] | | | | | ]; simpl; auto
  unfold isUnOpResultType.
  destruct u;
  destruct (typeof e) as   [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ];
-   simpl; repeat apply closed_wrt_tc_andp; auto 50 with closed;
-  rewrite binop_lemmas2.denote_tc_assert_test_eq';
+   simpl classify_notint; simpl classify_neg; cbv match;
+   repeat simple apply closed_wrt_tc_andp; auto 50 with nocore closed;
+  rewrite denote_tc_assert_test_eq';
   simpl; unfold_lift;
   hnf; intros ? ? H8; simpl;
   rewrite <- (H _ _ H8); auto.
@@ -1567,15 +1640,15 @@ try solve [destruct t  as [ | [ | | | ] [ | ] | | [ | ] | | | | | ]; simpl; auto
  apply closed_eval_expr_e in H; apply closed_eval_expr_e in H0.
  repeat apply closed_wrt_tc_andp; auto with closed.
  unfold isBinOpResultType.
- destruct b; auto 50 with closed;
+ destruct b; auto 50 with nocore closed;
  try solve [destruct (Cop.classify_binarith (typeof e1) (typeof e2));
-                try destruct s;  auto with closed];
+                try destruct s;  auto with nocore closed];
  try solve [destruct (Cop.classify_cmp (typeof e1) (typeof e2));
-                 simpl; auto 50 with closed].
- destruct (Cop.classify_add (typeof e1) (typeof e2)); auto 50 with closed.
- destruct (Cop.classify_sub (typeof e1) (typeof e2)); auto 50 with closed.
- destruct (Cop.classify_shift (typeof e1) (typeof e2)); auto 50 with closed.
- destruct (Cop.classify_shift (typeof e1) (typeof e2)); auto 50 with closed.
+                 simpl check_pp_int; auto 50 with nocore closed].
+ destruct (Cop.classify_add (typeof e1) (typeof e2)); auto 50 with nocore closed.
+ destruct (Cop.classify_sub (typeof e1) (typeof e2)); auto 50 with nocore closed.
+ destruct (Cop.classify_shift (typeof e1) (typeof e2)); auto 50 with nocore closed.
+ destruct (Cop.classify_shift (typeof e1) (typeof e2)); auto 50 with nocore closed.
 
 +
  apply closed_wrt_tc_andp; auto with closed.
@@ -1585,8 +1658,6 @@ try solve [destruct t  as [ | [ | | | ] [ | ] | | [ | ] | | | | | ]; simpl; auto
  destruct (classify_cast (typeof e) t); auto with closed;
    try solve [ destruct t as [ | [ | | | ] [ | ]| [ | ] | [ | ] | | | | | ]; auto with closed].
 all: repeat simple_if_tac; try destruct si2; auto with closed.
- apply closed_wrt_tc_test_eq; auto with closed.
- hnf; intros; reflexivity.
  hnf; intros; reflexivity.
 +
  clear IHe.
@@ -1594,17 +1665,17 @@ all: repeat simple_if_tac; try destruct si2; auto with closed.
  repeat apply closed_wrt_tc_andp; auto with closed.
  apply closed_wrt_tc_lvalue; auto.
  destruct (typeof e); simpl; auto with closed;
- destruct (cenv_cs ! i0); simpl; auto with closed.
+ destruct (cenv_cs !! i0); simpl; auto with closed.
  destruct (field_offset cenv_cs i (co_members c)) as [[? [|]]|]; simpl; auto with closed.
  destruct (union_field_offset cenv_cs i (co_members c)) as [[[ | | ] [|]]|]; simpl; auto with closed.
 *
  clear closed_wrt_tc_lvalue.
  unfold tc_lvalue.
- induction e; simpl; intros; auto with closed.
+ induction e; unfold typecheck_lvalue; fold typecheck_expr; fold typecheck_lvalue; intros; auto with closed.
  +
- destruct (get_var_type Delta i); simpl; auto with closed.
+ destruct (get_var_type Delta i); auto with closed.
  +
- specialize (closed_wrt_tc_expr cs Delta _ _ H).
+ specialize (closed_wrt_tc_expr _ _ cs Delta _ _ H).
  apply closed_eval_expr_e in H.
  auto 50 with closed.
  +
@@ -1612,26 +1683,21 @@ all: repeat simple_if_tac; try destruct si2; auto with closed.
  apply closed_eval_lvalue_e  in H.
  repeat apply closed_wrt_tc_andp; auto with closed.
  destruct (typeof e); simpl; auto with closed;
- destruct (cenv_cs ! i0); simpl; auto with closed.
+ destruct (cenv_cs !! i0); simpl; auto with closed.
  destruct (field_offset cenv_cs i (co_members c)) as [[? [|]]|]; simpl; auto with closed.
  destruct (union_field_offset cenv_cs i (co_members c)) as [[[ | | ] [|]]|]; simpl; auto with closed.
 Qed.
 
-#[export] Hint Resolve closed_wrt_tc_expr : closed.
-#[export] Hint Resolve closed_wrt_tc_lvalue : closed.
-
-
 Lemma closed_wrt_lift1':
-      forall (A B : Type) (S : ident -> Prop) (f : A -> B)
+      forall (S : ident -> Prop) `(f : A -d> B)
          (P : environ -> A),
-       closed_wrt_vars S P -> closed_wrt_vars S (`f P).
+       closed_wrt_vars(H := eq) S P -> closed_wrt_vars S (`(f : A -> B) P).
 Proof.
 intros.
 apply closed_wrt_lift1.
-hnf; intros. simpl. f_equal.
+hnf; intros. f_equiv.
 apply H. auto.
 Qed.
-#[export] Hint Resolve closed_wrt_lift1' : closed.
 
 Lemma closed_wrt_Econst_int:
   forall {cs: compspecs} S i t, closed_wrt_vars S (eval_expr (Econst_int i t)).
@@ -1639,74 +1705,76 @@ Proof.
 simpl; intros.
 auto with closed.
 Qed.
-#[export] Hint Resolve closed_wrt_Econst_int : closed.
 
-Lemma closed_wrt_PROPx:
- forall S P Q, closed_wrt_vars S Q -> closed_wrt_vars S (PROPx P Q).
+(*Local Notation assert := (@assert Σ).*)
+
+Lemma closed_wrt_PROPx `{!heapGS Σ}:
+ forall S P (Q : assert), closed_wrt_vars S Q -> closed_wrt_vars S (PROPx P Q).
 Proof.
 intros.
 apply closed_wrt_andp; auto.
-hnf; intros. reflexivity.
+hnf; intros. by monPred.unseal.
 Qed.
-Lemma closed_wrtl_PROPx:
- forall S P Q, closed_wrt_lvars S Q -> closed_wrt_lvars S (PROPx P Q).
+Lemma closed_wrtl_PROPx `{!heapGS Σ}:
+ forall S P (Q : assert), closed_wrt_lvars S Q -> closed_wrt_lvars S (PROPx P Q).
 Proof.
 intros.
 apply closed_wrtl_andp; auto.
-hnf; intros. reflexivity.
+hnf; intros. by monPred.unseal.
 Qed.
-#[export] Hint Resolve closed_wrt_PROPx closed_wrtl_PROPx: closed.
 
 
-Lemma closed_wrt_LOCALx:
- forall S Q R, Forall (closed_wrt_vars S) (map locald_denote Q) ->
+Lemma closed_wrt_LOCALx `{!heapGS Σ}:
+ forall S Q (R : assert), Forall (closed_wrt_vars S) (map locald_denote Q) ->
                     closed_wrt_vars S R ->
                     closed_wrt_vars S (LOCALx Q R).
 Proof.
 intros.
 apply closed_wrt_andp; auto.
 clear - H.
-induction Q; simpl; intros.
-auto with closed.
-normalize. autorewrite with norm1 norm2; normalize.
-inv H.
-apply closed_wrt_andp; auto with closed.
+induction Q; intros.
+- pose proof (@closed_wrt_TT Σ) as HT.
+  revert HT; by monPred.unseal.
+- inv H.
+  simpl foldr.
+  rewrite local_lift2_and.
+  apply closed_wrt_andp; auto with closed.
 Qed.
 
 
-Lemma closed_wrtl_LOCALx:
- forall S Q R, Forall (closed_wrt_lvars S) (map locald_denote Q) ->
+Lemma closed_wrtl_LOCALx `{!heapGS Σ}:
+ forall S Q (R : assert), Forall (closed_wrt_lvars S) (map locald_denote Q) ->
                     closed_wrt_lvars S R ->
                     closed_wrt_lvars S (LOCALx Q R).
 Proof.
 intros.
 apply closed_wrtl_andp; auto.
 clear - H.
-induction Q; simpl; intros.
-auto with closed.
-normalize. autorewrite with norm1 norm2; normalize.
-inv H.
-apply closed_wrtl_andp; auto with closed.
+induction Q; intros.
+- pose proof (@closed_wrt_TT Σ) as HT.
+  revert HT; by monPred.unseal.
+- inv H.
+  simpl foldr.
+  rewrite local_lift2_and.
+  apply closed_wrtl_andp; auto with closed.
 Qed.
 
-#[export] Hint Resolve closed_wrt_LOCALx closed_wrtl_LOCALx: closed.
 
-Lemma closed_wrt_SEPx: forall S P,
-     closed_wrt_vars S (SEPx P).
+Lemma closed_wrt_SEPx: forall {Σ: gFunctors} S P,
+     closed_wrt_vars S (SEPx P : monPred environ_index (iPropI Σ)).
 Proof.
 intros.
 unfold SEPx.
-auto with closed.
+apply closed_wrt_embed.
 Qed.
 
-Lemma closed_wrtl_SEPx: forall S P,
-     closed_wrt_lvars S (SEPx P).
+Lemma closed_wrtl_SEPx: forall {Σ: gFunctors} S P,
+     closed_wrt_lvars S (SEPx P : monPred environ_index (iPropI Σ)).
 Proof.
 intros.
 unfold SEPx.
-auto with closed.
+apply closed_wrtl_embed.
 Qed.
-#[export] Hint Resolve closed_wrt_SEPx closed_wrtl_SEPx: closed.
 
 Lemma not_not_a_param_i:
   forall (L: list (ident * type)) i,
@@ -1716,7 +1784,6 @@ Proof.
 intros.
 intro. apply H0; auto.
 Qed.
-#[export] Hint Resolve not_not_a_param_i : closed.
 
 Lemma in_map_fst1:
  forall (i: ident) (t: type) L,
@@ -1724,7 +1791,6 @@ Lemma in_map_fst1:
 Proof.
 intros. left. reflexivity.
 Qed.
-#[export] Hint Resolve in_map_fst1 : closed.
 
 Lemma in_map_fst2:
  forall (i: ident) a (L: list (ident*type)),
@@ -1733,7 +1799,6 @@ Lemma in_map_fst2:
 Proof.
 intros; right; auto.
 Qed.
-#[export] Hint Resolve in_map_fst2 : closed.
 
 Lemma Forall_map_cons:
   forall {A B} (F: A -> Prop) (g: B -> A) b bl,
@@ -1753,5 +1818,16 @@ simpl.
 intros.
 constructor; auto.
 Qed.
+
+#[export] Hint Resolve closed_wrt_tc_expr : closed.
+#[export] Hint Resolve closed_wrt_tc_lvalue : closed.
+#[export] Hint Resolve closed_wrt_lift1' : closed.
+#[export] Hint Resolve closed_wrt_Econst_int : closed.
+#[export] Hint Resolve closed_wrt_PROPx closed_wrtl_PROPx: closed.
+#[export] Hint Resolve closed_wrt_LOCALx closed_wrtl_LOCALx: closed.
+#[export] Hint Resolve closed_wrt_SEPx closed_wrtl_SEPx: closed.
+#[export] Hint Resolve not_not_a_param_i : closed.
+#[export] Hint Resolve in_map_fst1 : closed.
+#[export] Hint Resolve in_map_fst2 : closed.
 #[export] Hint Resolve Forall_map_cons Forall_map_nil : closed.
 #[export] Hint Resolve Forall_cons Forall_nil : closed.
diff --git a/floyd/compare_lemmas.v b/floyd/compare_lemmas.v
index b2c47177c5..71232b522c 100644
--- a/floyd/compare_lemmas.v
+++ b/floyd/compare_lemmas.v
@@ -1,8 +1,9 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 
 Import LiftNotation.
-Local Open Scope logic.
 
 Lemma typed_true_nullptr:
  forall v t0 t t',
@@ -10,7 +11,7 @@ Lemma typed_true_nullptr:
    v=nullval.
 Proof.
  intros.
- simpl in H. rewrite !andb_false_r in H. simpl in H.
+ rewrite /sem_cmp /= in H. rewrite !andb_false_r /= in H.
  unfold typed_true, force_val, sem_cmp_pp, strict_bool_val, nullval in *.
  destruct Archi.ptr64  eqn:Hp;
  destruct t0, v; inv H;
@@ -26,35 +27,39 @@ Lemma typed_true_nullptr':
     typed_true t0 (eval_binop Cop.Oeq (tptr t) (tptr t') v nullval) -> v=nullval.
 Proof.
  intros.
- simpl in H. unfold sem_binary_operation' in H.
+ rewrite /= /sem_cmp /sem_binary_operation' in H.
  unfold tptr, typed_true, force_val, sem_cmp, Cop.classify_cmp, sem_cmp_pp, 
    typeconv, remove_attributes, change_attributes, strict_bool_val, nullval, Val.of_bool in *.
-   rewrite (proj2 (eqb_type_false (Tpointer t noattr) int_or_ptr_type)) in H
+   rewrite -> (proj2 (eqb_type_false (Tpointer t noattr) int_or_ptr_type)) in H
      by (intro Hx; inv Hx).
-   rewrite (proj2 (eqb_type_false (Tpointer t' noattr) int_or_ptr_type)) in H
+   rewrite -> (proj2 (eqb_type_false (Tpointer t' noattr) int_or_ptr_type)) in H
      by (intro Hx; inv Hx).
    simpl in H.
  destruct Archi.ptr64  eqn:Hp;
- destruct t0, v; inv H;
- try solve [revert H1; simple_if_tac; intro H1; inv H1].
+ destruct t0, v; inversion H;
+ try solve [revert H1; simple_if_tac; intro H1; inversion H1].
  pose proof (Int64.eq_spec i0 Int64.zero);
  destruct (Int64.eq i0 Int64.zero); inv H1; auto.
  pose proof (Int.eq_spec i0 Int.zero);
  destruct (Int.eq i0 Int.zero); inv H1; auto.
 Qed.
 
+Section mpred.
+
+Context `{!heapGS Σ}.
+
+Notation local := (@local Σ).
+
 Lemma typed_true_Oeq_nullval:
  forall  {cs: compspecs}  v t t',
-   local (`(typed_true tint) (`(eval_binop Cop.Oeq (tptr t) (tptr t')) v `(nullval))) |--
+   local (`(typed_true tint) (`(eval_binop Cop.Oeq (tptr t) (tptr t')) v `(nullval))) ⊢
    local (`(eq nullval) v).
 Proof.
-intros.
- intro rho; unfold local, lift1; unfold_lift.
- apply prop_derives; intro.
- unfold tptr in H; simpl in H. unfold sem_binary_operation' in H.
- simpl in H. rewrite !andb_false_r in H.
- simpl in H.
- red in H.
+ intros.
+ unfold_lift; split => rho.
+ apply bi.pure_mono; intro.
+ rewrite /= /tptr /sem_cmp /= /sem_binary_operation' in H.
+ rewrite !andb_false_r /= in H.
  forget (v rho) as x. clear - H.
  unfold sem_cmp_pp, strict_bool_val, nullval in *; simpl in *.
  destruct Archi.ptr64; simpl in H;
@@ -82,8 +87,8 @@ Lemma typed_true_binop_int:
    binary_operation_to_comparison op = Some op' ->
    typeof e1 = tint ->
    typeof e2 = tint ->
-   (PROPx P (LOCALx (tc_env Delta :: Q) (SEPx R))) |--  tc_expr Delta e1 ->
-   (PROPx P (LOCALx (tc_env Delta :: Q) (SEPx R))) |-- tc_expr Delta e2 ->
+   (PROPx P (LOCALx (tc_env Delta :: Q) (SEPx R))) ⊢  tc_expr Delta e1 ->
+   (PROPx P (LOCALx (tc_env Delta :: Q) (SEPx R))) ⊢ tc_expr Delta e2 ->
   @semax cs Espec Delta (PROPx P (LOCALx
       (`op' (`force_signed_int (eval_expr e1)) (`force_signed_int (eval_expr e2))
           :: Q) (SEPx R))) c Post ->
@@ -159,8 +164,8 @@ Lemma typed_false_binop_int:
    binary_operation_to_opp_comparison op = Some op' ->
    typeof e1 = tint ->
    typeof e2 = tint ->
-   (PROPx P (LOCALx (tc_environ Delta :: Q) (SEPx R))) |-- (tc_expr Delta e1) ->
-   (PROPx P (LOCALx (tc_environ Delta :: Q) (SEPx R))) |-- (tc_expr Delta e2) ->
+   (PROPx P (LOCALx (tc_environ Delta :: Q) (SEPx R))) ⊢ (tc_expr Delta e1) ->
+   (PROPx P (LOCALx (tc_environ Delta :: Q) (SEPx R))) ⊢ (tc_expr Delta e2) ->
   @semax cs Espec Delta (PROPx P (LOCALx
       (`op' (`force_signed_int (eval_expr e1)) (`force_signed_int (eval_expr e2))
           :: Q) (SEPx R))) c Post ->
@@ -223,35 +228,33 @@ Qed.
 
 Lemma typed_false_One_nullval:
  forall  {cs: compspecs}  v t t',
-   local (`(typed_false tint) (`(eval_binop Cop.One (tptr t) (tptr t')) v `(nullval))) |--
+   local (`(typed_false tint) (`(eval_binop Cop.One (tptr t) (tptr t')) v `(nullval))) ⊢
     local (`(eq nullval) v).
 Proof.
-intros.
- intro rho; unfold local, lift1; unfold_lift.
- apply prop_derives; intro.
- simpl in H. unfold sem_binary_operation' in H.
- simpl in H. rewrite !andb_false_r in H.
+ intros.
+ unfold_lift; split => rho.
+ apply bi.pure_mono; intro.
+ rewrite /= /sem_cmp /= /sem_binary_operation' in H.
+ rewrite !andb_false_r in H.
  unfold sem_cmp_pp, nullval in *.
  destruct Archi.ptr64 eqn:Hp;
- destruct (v rho); inv H.
+ destruct (v rho); inversion H.
  pose proof (Int64.eq_spec i Int64.zero).
- destruct (Int64.eq i Int64.zero); inv H1.
- reflexivity.
+ destruct (Int64.eq i Int64.zero); inv H1; reflexivity.
  pose proof (Int.eq_spec i Int.zero).
- destruct (Int.eq i Int.zero); inv H1.
- reflexivity.
+ destruct (Int.eq i Int.zero); inv H1; reflexivity.
 Qed.
 
 Lemma typed_true_One_nullval:
  forall  {cs: compspecs}  v t t',
-   local (`(typed_true tint) (`(eval_binop Cop.One (tptr t) (tptr t')) v `(nullval))) |--
+   local (`(typed_true tint) (`(eval_binop Cop.One (tptr t) (tptr t')) v `(nullval))) ⊢
    local (`(ptr_neq nullval) v).
 Proof.
-intros.
- intro rho; unfold local, lift1; unfold_lift.
- apply prop_derives; intro.
- simpl in H. unfold sem_binary_operation' in H.
- simpl in H. rewrite !andb_false_r in H.
+ intros.
+ unfold_lift; split => rho.
+ apply bi.pure_mono; intro.
+ rewrite /= /sem_cmp /= /sem_binary_operation' in H.
+ rewrite !andb_false_r in H.
  unfold sem_cmp_pp, ptr_neq, ptr_eq, nullval in *; simpl; intro.
  destruct (v rho); try contradiction.
  simpl in *.
@@ -260,47 +263,46 @@ intros.
  destruct H0 as [? [? ?]].
  first [ pose proof (Int64.eq_spec Int64.zero i)
         | pose proof (Int.eq_spec Int.zero i)];
- rewrite H1 in H3; 
+ rewrite H1 in H3;
  subst; inv H.
 Qed.
 
 Lemma typed_false_Oeq_nullval:
  forall  {cs: compspecs} v t t',
-   local (`(typed_false tint) (`(eval_binop Cop.Oeq (tptr t) (tptr t')) v `(nullval))) |--
+   local (`(typed_false tint) (`(eval_binop Cop.Oeq (tptr t) (tptr t')) v `(nullval))) ⊢
    local (`(ptr_neq nullval) v).
 Proof.
-intros. subst.
- unfold_lift; intro rho.  unfold local, lift1; apply prop_derives; intro.
- simpl in H. unfold sem_binary_operation' in H.
- simpl in H. rewrite !andb_false_r in H.
+ intros.
+ unfold_lift; split => rho.
+ apply bi.pure_mono; intro.
+ rewrite /= /sem_cmp /= /sem_binary_operation' in H.
+ rewrite !andb_false_r in H.
  intro. apply ptr_eq_e in H0. rewrite <- H0 in H.
  inv H.
 Qed.
 
+Notation LOCALx := (@LOCALx Σ).
+
 Lemma local_entail_at:
-  forall n S T (H: local (locald_denote S) |-- local (locald_denote T))
+  forall n S T (H: local (locald_denote S) ⊢ local (locald_denote T))
     P Q R,
     nth_error Q n = Some S ->
-    PROPx P (LOCALx Q (SEPx R)) |--
+    PROPx P (LOCALx Q (SEPx R)) ⊢
     PROPx P (LOCALx (replace_nth n Q T) (SEPx R)).
 Proof.
  intros.
- unfold PROPx, LOCALx; simpl; intro rho;  apply andp_derives; auto.
- apply andp_derives; auto.
- unfold local, lift1.
- specialize (H rho). unfold local,lift1 in H.
+ unfold PROPx, LOCALx; simpl; apply bi.and_mono; auto.
+ apply bi.and_mono; auto.
  revert Q H0; induction n; destruct Q; simpl; intros; inv H0.
- unfold_lift; repeat rewrite prop_and.
- apply andp_derives; auto.
-  unfold_lift; repeat rewrite prop_and.
- apply andp_derives; auto.
+ - rewrite !local_lift2_and H //.
+ - rewrite !local_lift2_and IHn //.
 Qed.
 
 Lemma local_entail_at_semax_0:
-  forall Espec {cs: compspecs}Delta P Q1 Q1' Q R c Post,
-   (local (locald_denote Q1) |-- local (locald_denote Q1')) ->
-   @semax cs Espec Delta (PROPx P (LOCALx (Q1'::Q) (SEPx R))) c Post  ->
-   @semax cs Espec Delta (PROPx P (LOCALx (Q1::Q) (SEPx R))) c Post.
+  forall `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} {cs: compspecs} E Delta P Q1 Q1' Q R c Post,
+   (local (locald_denote Q1) ⊢ local (locald_denote Q1')) ->
+   semax E Delta (PROPx P (LOCALx (Q1'::Q) (SEPx R))) c Post  ->
+   semax E Delta (PROPx P (LOCALx (Q1::Q) (SEPx R))) c Post.
 Proof.
 intros.
 eapply semax_pre0.
@@ -338,27 +340,29 @@ clear.
 unfold sem_cmp_pp, compare_pp, Ptrofs.cmpu, Val.cmplu_bool.
 destruct Archi.ptr64 eqn:Hp.
 destruct op; simpl; auto.
-if_tac. if_tac. inv H0. rewrite Ptrofs.eq_true; reflexivity.
-rewrite Ptrofs.eq_false by congruence; reflexivity.
+if_tac. if_tac. inversion H0. rewrite Ptrofs.eq_true; reflexivity.
+rewrite -> Ptrofs.eq_false by congruence; reflexivity.
 if_tac. congruence. reflexivity.
-if_tac. if_tac. inv H0. rewrite Ptrofs.eq_true by auto. reflexivity.
-rewrite Ptrofs.eq_false by congruence; reflexivity.
-rewrite if_false by congruence. reflexivity.
+if_tac. if_tac. inversion H0. rewrite -> Ptrofs.eq_true by auto. reflexivity.
+rewrite -> Ptrofs.eq_false by congruence; reflexivity.
+rewrite -> if_false by congruence. reflexivity.
 if_tac; [destruct (Ptrofs.ltu i i0); reflexivity | reflexivity].
 if_tac; [destruct (Ptrofs.ltu i0 i); reflexivity | reflexivity].
 if_tac; [destruct (Ptrofs.ltu i0 i); reflexivity | reflexivity].
 if_tac; [destruct (Ptrofs.ltu i i0); reflexivity | reflexivity].
 destruct op; simpl; auto; rewrite Hp.
-if_tac. if_tac. inv H0. rewrite Ptrofs.eq_true; reflexivity.
-rewrite Ptrofs.eq_false by congruence; reflexivity.
+if_tac. if_tac. inversion H0; subst. rewrite -> Ptrofs.eq_true by auto. reflexivity.
+rewrite -> Ptrofs.eq_false by congruence; reflexivity.
 if_tac. congruence. reflexivity.
-if_tac. if_tac. inv H0. rewrite Ptrofs.eq_true by auto. reflexivity.
-rewrite Ptrofs.eq_false by congruence; reflexivity.
-rewrite if_false by congruence. reflexivity.
+if_tac. if_tac. inversion H0; subst. rewrite -> Ptrofs.eq_true by auto. reflexivity.
+rewrite -> Ptrofs.eq_false by congruence; reflexivity.
+rewrite -> if_false by congruence. reflexivity.
 if_tac; [destruct (Ptrofs.ltu i i0); reflexivity | reflexivity].
 if_tac; [destruct (Ptrofs.ltu i0 i); reflexivity | reflexivity].
 if_tac; [destruct (Ptrofs.ltu i0 i); reflexivity | reflexivity].
 if_tac; [destruct (Ptrofs.ltu i i0); reflexivity | reflexivity].
 Qed.
 
+End mpred.
+
 #[export] Hint Rewrite force_sem_cmp_pp using (now auto) : norm.
diff --git a/floyd/compat.v b/floyd/compat.v
new file mode 100644
index 0000000000..78a028f6ce
--- /dev/null
+++ b/floyd/compat.v
@@ -0,0 +1,196 @@
+Set Warnings "-custom-entry-overridden".
+Require Import VST.veric.SequentialClight.
+Require Import VST.floyd.proofauto.
+Set Warnings "custom-entry-overridden".
+
+#[export] Unset SsrRewrite.
+
+(*Section GFUNCTORS.
+Context `{Σ: gFunctors}.
+*)
+(*
+Notation assert := (@assert (VSTΣ unit)).
+Notation funspec := (@funspec (VSTΣ unit)).
+Notation funspecs := (@funspecs (VSTΣ unit)).
+*)
+
+#[export] Arguments VST_heapGS : simpl never.
+
+Module NoOracle.
+(* Concrete instance of the Iris typeclasses for no ghost state or external calls *)
+Definition default_pre : VSTGpreS unit (VSTΣ unit) := subG_VSTGpreS _.
+
+#[export] Program Instance VST_default : VSTGS unit (VSTΣ unit) := Build_VSTGS _ _ _ _.
+Next Obligation.
+Proof.
+  split.
+  - split; split; try apply _.
+    + exact 1%positive.
+    + exact 2%positive.
+    + exact 3%positive.
+    + apply lcGpreS_inG.
+    + exact 4%positive.
+  - split; try apply _.
+    + exact 5%positive.
+    + exact 6%positive.
+  - split; try apply _.
+    exact 7%positive.
+Defined.
+Next Obligation.
+Proof.
+  split; try apply _.
+  exact 8%positive.
+Defined.
+
+Opaque VST_default.
+#[export] Arguments VST_heapGS : simpl never.
+
+(* avoid unfolding typeclass instances in simplify_func_tycontext *)
+Ltac simplify_func_tycontext' DD ::=
+  match DD with context [(func_tycontext ?f ?V ?G ?A)] =>
+    let D1 := fresh "D1" in let Delta := fresh "Delta" in
+    pose (D1 := (func_tycontext f V G A));
+    pose (Delta := @abbreviate tycontext D1);
+    change (func_tycontext f V G A) with Delta;
+    unfold func_tycontext, make_tycontext in D1;
+    let DS := fresh "Delta_specs" in
+    let d := constr:(make_tycontext_s G) in
+    let d := make_ground_PTree d in 
+    pose (DS := @abbreviate (PTree.t funspec) d);
+    change (make_tycontext_s G) with DS in D1;
+    cbv beta iota zeta delta - [VSTΣ VST_default DS] in D1;
+    subst D1;
+    check_ground_Delta
+   end.
+
+
+(*#[export] Notation assert := (@assert (VSTΣ unit)).
+#[export] Notation funspec := (@funspec (VSTΣ unit)).*)
+#[export] Notation funspecs := (@funspecs (VSTΣ unit)).
+
+End NoOracle.
+
+Notation "P |-- Q" := (P ⊢ Q)
+  (at level 99, Q at level 200, right associativity, only parsing) : stdpp_scope.
+Notation " 'ENTAIL' d ',' P |-- Q " :=
+  (@bi_entails (monPredI environ_index (iPropI _)) (local (tc_environ d) ∧ P%assert) Q%assert) (at level 99, P at level 98, Q at level 98).
+Notation "'!!' φ" := (bi_pure φ%type%stdpp) (at level 15) : bi_scope.
+Notation "P && Q" := (P ∧ Q)%I (only parsing) : bi_scope.
+Notation "P || Q" := (P ∨ Q)%I (only parsing) : bi_scope.
+Notation "P --> Q" := (P → Q)%I (only parsing) : bi_scope.
+Notation "P * Q" := (P ∗ Q)%I
+  (at level 40, left associativity, only parsing) : bi_scope.
+Notation "P -* Q" := (P -∗ Q)%I
+  (at level 99, Q at level 200, right associativity, only parsing) : bi_scope.
+
+Notation "'ALL' x .. y , P " := (bi_forall (fun x => .. (bi_forall (fun y => P%I)) ..))
+  (at level 65, x binder, y binder, right associativity) : bi_scope.
+Notation "'EX' x .. y , P " := (bi_exist (fun x => .. (bi_exist (fun y => P%I)) ..))
+  (at level 65, x binder, y binder, right associativity) : bi_scope.
+
+Notation "|> P" := (▷ P)%I
+  (at level 20, right associativity, only parsing) : bi_scope.
+
+Notation "P <--> Q" := (P ↔ Q)%I
+  (at level 95, no associativity, only parsing) : bi_scope.
+
+Notation TT := (True)%I.
+Notation FF := (False)%I.
+
+Disable Notation "True" : bi_scope.
+Disable Notation "False" : bi_scope.
+
+
+Open Scope bi_scope.
+
+Definition prop_and: ∀ {M : uora} (P Q : Prop),  
+  (@bi_pure (ouPredI M) (and P Q))
+  = @bi_and (ouPredI M) (@bi_pure (ouPredI M) P) (@bi_pure (ouPredI M) Q)
+   := @pure_and.
+
+Lemma wand_sepcon_adjoint  : forall {B : bi} (P Q R: B),
+  ((P * Q) |-- R) = (P |-- (Q -* R)).
+Proof.
+intros.
+apply prop_ext; split.
+apply bi.wand_intro_r.
+apply bi.wand_elim_l'.
+Qed.
+
+Definition pred_ext := @bi.equiv_entails_2.
+Definition andp_right := @bi.and_intro.
+Definition prop_right := @bi.pure_intro.
+Definition sepcon_derives := @bi.sep_mono.
+Definition andp_derives := @bi.and_mono.
+Definition prop_derives := @bi.pure_mono.
+Definition orp_left := @bi.or_elim.
+Definition sepcon_emp := @sep_emp.
+Definition emp_sepcon := @emp_sep.
+Definition sepcon_comm := @sep_comm.
+Definition sepcon_assoc := @sep_assoc.
+Definition andp_comm := @log_normalize.and_comm.
+Definition andp_assoc := @log_normalize.and_assoc.
+Definition allp_right := @bi.forall_intro.
+Definition FF_left := @False_left.
+
+Lemma andp_left1 : forall {B : bi} (P Q R : B), (P ⊢ R) -> P ∧ Q ⊢ R.
+Proof. intros; rewrite bi.and_elim_l; auto. Qed.
+Lemma andp_left2 : forall {B : bi} (P Q R : B), (Q ⊢ R) -> P ∧ Q ⊢ R.
+Proof. intros; rewrite bi.and_elim_r; auto. Qed.
+
+Lemma derives_refl' : forall {B : bi} {P Q : B}, P = Q -> P ⊢ Q.
+Proof. intros; subst; auto. Qed.
+
+Section iter_sepcon2.
+(* progs/verif_tree relies on this playing well with Fixpoint, so we have to define it
+   in this particular way instead of using [∗ list]. *)
+
+Context {A : bi} {B1 B2} (p : B1 -> B2 -> A).
+
+Fixpoint iter_sepcon2 (l : list B1) : list B2 -> A :=
+    match l with
+    | nil => fun l2 =>
+       match l2 with
+       | nil => emp
+       | _ => FF
+       end
+    | x :: xl => fun l' =>
+       match l' with
+       | nil => FF
+       | y :: yl => p x y * iter_sepcon2 xl yl
+       end
+    end.
+
+Lemma iter_sepcon2_spec: forall l1 l2,
+  iter_sepcon2 l1 l2 ⊣⊢ EX l: list (B1 * B2), !! (l1 = map fst l /\ l2 = map snd l) && [∗ list] x ∈ l, uncurry p x.
+Proof.
+  intros.
+  apply pred_ext.
+  + revert l2; induction l1; intros; destruct l2.
+    - rewrite <- (bi.exist_intro nil).
+      simpl; auto.
+    - simpl.
+      apply FF_left.
+    - simpl.
+      apply FF_left.
+    - simpl.
+      specialize (IHl1 l2).
+      eapply derives_trans; [apply sepcon_derives; [apply derives_refl | apply IHl1] | clear IHl1].
+      rewrite bi.sep_exist_l; apply bi.exist_elim; intros l.
+      rewrite persistent_and_sep_assoc' by apply _; apply bi.pure_elim_l; intros (-> & ->).
+      apply (exp_right ((a, b) :: l)).
+      simpl.
+      apply andp_right; [apply prop_right; subst; auto |].
+      apply derives_refl.
+  + Intros l.
+    subst.
+    induction l.
+    - simpl. auto.
+    - simpl.
+      eapply derives_trans; [apply sepcon_derives; [apply derives_refl | apply IHl] | clear IHl].
+      destruct a; apply derives_refl.
+Qed.
+
+End iter_sepcon2.
+
+#[export] Tactic Notation "inv" ident(H):= Coqlib.inv H.
diff --git a/floyd/computable_functions.v b/floyd/computable_functions.v
index 2f7868bc20..2ea3e3ec2b 100644
--- a/floyd/computable_functions.v
+++ b/floyd/computable_functions.v
@@ -1,5 +1,8 @@
-Require Import VST.floyd.base.
-Import compcert.lib.Maps.
+Require Import VST.veric.Cop2.
+Set Warnings "-custom-entry-overridden".
+Require Import VST.veric.seplog.
+Set Warnings "custom-entry-overridden".
+Require Import compcert.lib.Maps.
 
 Ltac make_ground_PTree a :=
  let a := eval hnf in a in
diff --git a/floyd/const_only_eval.v b/floyd/const_only_eval.v
index bbbb97c13e..d318f021af 100644
--- a/floyd/const_only_eval.v
+++ b/floyd/const_only_eval.v
@@ -1,5 +1,7 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base.
 Require Import VST.floyd.val_lemmas.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.typecheck_lemmas.
 Require Import compcert.cfrontend.Ctypes.
 
@@ -134,68 +136,62 @@ Fixpoint const_only_eval_expr {cs: compspecs} (e: Clight.expr): option val :=
     else None
   end.
 
-Lemma const_only_isUnOpResultType_spec: forall {cs: compspecs} rho u e t P,
+Lemma TT_right' : forall `{heapGS Σ} P, P ⊢ assert_of (liftx True).
+Proof.
+  split => rho; simpl; unfold_lift; auto.
+Qed.
+#[global] Hint Resolve TT_right' : core.
+
+Section mpred.
+
+Context `{!heapGS Σ} {CS : compspecs}.
+
+Lemma denote_tc_assert_test_eq' : forall a b, denote_tc_assert (tc_test_eq a b) ⊣⊢ denote_tc_assert (tc_test_eq' a b).
+Proof.
+  intros; split => rho; apply binop_lemmas2.denote_tc_assert_test_eq'.
+Qed.
+
+Lemma denote_tc_assert_test_order' : forall a b, denote_tc_assert (tc_test_order a b) ⊣⊢ denote_tc_assert (tc_test_order' a b).
+Proof.
+  intros; split => rho; apply binop_lemmas2.denote_tc_assert_test_order'.
+Qed.
+
+Lemma const_only_isUnOpResultType_spec: forall rho u e t P,
   const_only_isUnOpResultType u (typeof e) (eval_expr e rho) t = true ->
-  P |-- denote_tc_assert (isUnOpResultType u e t) rho.
+  P ⊢ denote_tc_assert (isUnOpResultType u e t) rho.
 Proof.
   intros.
   unfold isUnOpResultType.
   unfold const_only_isUnOpResultType in H.
   destruct u.
   + destruct (typeof e);
-      try solve [inv H | rewrite H; exact (@prop_right mpred _ True _ I)].
+      try solve [inv H | rewrite /tc_bool H; apply bi.pure_intro; done].
     rewrite !denote_tc_assert_andp.
-    match goal with
-    | |- context [denote_tc_assert (tc_test_eq ?a ?b)] =>
-      change (denote_tc_assert (tc_test_eq a b)) with (expr2.denote_tc_assert (tc_test_eq a b))
-    end.
-    rewrite binop_lemmas2.denote_tc_assert_test_eq'.
+    rewrite denote_tc_assert_test_eq'.
     simpl expr2.denote_tc_assert.
-    unfold_lift. simpl.
+    unfold_lift. monPred.unseal.
     unfold tc_int_or_ptr_type.
-    destruct Archi.ptr64 eqn:HH.
-    - destruct (eval_expr e rho); try solve [inv H].
-      rewrite !andb_true_iff in H.
-      destruct H as [? [? ?]].
-      rewrite H, H0.
-      rewrite Z.eqb_eq in H1.
-      apply andp_right; [exact (@prop_right mpred _ True _ I) |].
-      apply andp_right; [exact (@prop_right mpred _ True _ I) |].
-      simpl.
-      rewrite HH.
-      change (P |-- (!! (i = Int64.zero)) && (!! (Int64.zero = Int64.zero)))%logic.
-      apply andp_right; apply prop_right; auto.
-      rewrite <- (Int64.repr_unsigned i), <- H1.
-      auto.
-    - destruct (eval_expr e rho); try solve [inv H].
-      rewrite !andb_true_iff in H.
-      destruct H as [? [? ?]].
-      rewrite H, H0.
-      rewrite Z.eqb_eq in H1.
-      apply andp_right; [exact (@prop_right mpred _ True _ I) |].
-      apply andp_right; [exact (@prop_right mpred _ True _ I) |].
-      simpl.
-      rewrite HH.
-      change (P |-- (!! (i = Int.zero)) && (!! (Int.zero = Int.zero)))%logic.
-      apply andp_right; apply prop_right; auto.
-      rewrite <- (Int.repr_unsigned i), <- H1.
-      auto.
+    destruct (eval_expr e rho) eqn: He; try solve [inv H].
+    rewrite !andb_true_iff in H.
+    destruct H as [-> [-> ?%Z.eqb_eq]].
+    rewrite /=.
+    (rewrite -(Int64.repr_unsigned i) || rewrite -(Int.repr_unsigned i)); rewrite -H; auto.
   + destruct (Cop.classify_notint (typeof e));
-      try solve [inv H | rewrite H; exact (@prop_right mpred _ True _ I)].
+      try solve [inv H | rewrite H; apply bi.True_intro].
   + destruct (Cop.classify_neg (typeof e));
-      try solve [inv H | rewrite H; exact (@prop_right mpred _ True _ I)].
+      try solve [inv H | rewrite H; apply bi.True_intro].
     rewrite !andb_true_iff in H.
     destruct H.
     rewrite H; simpl.
     destruct (typeof e) as [| ? [|] | [|] | | | | | |];
-      try solve [exact (@prop_right mpred _ True _ I)].
+      try solve [apply bi.True_intro].
     - simpl.
       unfold_lift.
       unfold denote_tc_nosignedover.
       destruct (eval_expr e rho); try solve [inv H0].
       rewrite negb_true_iff in H0.
       rewrite Z.eqb_neq in H0.
-      apply prop_right.
+      apply bi.pure_intro.
       change (Int.signed Int.zero) with 0.
       rep_lia.
     - simpl.
@@ -205,57 +201,57 @@ Proof.
       destruct (eval_expr e rho); try solve [inv H0];
       rewrite negb_true_iff in H0;
       rewrite Z.eqb_neq in H0;
-      apply prop_right;
+      apply bi.pure_intro;
       change (Int64.signed Int64.zero) with 0;
       rep_lia.
-  + destruct (Cop.classify_neg (typeof e)); try solve [inv H | rewrite H; exact (@prop_right mpred _ True _ I)].
+  + destruct (Cop.classify_neg (typeof e)); try solve [inv H | rewrite H; apply bi.True_intro].
 Qed.
 
 Lemma const_only_isBinOpResultType_spec: forall {cs: compspecs} rho b e1 e2 t P,
   const_only_isBinOpResultType b (typeof e1) (eval_expr e1 rho) (typeof e2) (eval_expr e2 rho) t = true ->
-  P |-- denote_tc_assert (isBinOpResultType b e1 e2 t) rho.
+  P ⊢ denote_tc_assert (isBinOpResultType b e1 e2 t) rho.
 Proof.
   intros.
   unfold isBinOpResultType.
   unfold const_only_isBinOpResultType in H.
-  destruct b.
+  destruct b; rewrite /assert_of /monPred_at.
   + destruct (Cop.classify_add (typeof e1) (typeof e2)).
-    - rewrite !denote_tc_assert_andp; simpl.
+    - rewrite !expr2.denote_tc_assert_andp; simpl.
       unfold_lift.
       unfold tc_int_or_ptr_type, denote_tc_isptr.
       destruct (eval_expr e1 rho); inv H.
       rewrite !andb_true_iff in H1.
       destruct H1 as [[? ?] ?].
-      rewrite H, H0, H1.
+      rewrite H H0 H1.
       simpl.
-      repeat apply andp_right; apply prop_right; auto.
-    - rewrite !denote_tc_assert_andp; simpl.
+      repeat apply bi.and_intro; apply bi.pure_intro; auto.
+    - rewrite !expr2.denote_tc_assert_andp; simpl.
       unfold_lift.
       unfold tc_int_or_ptr_type, denote_tc_isptr.
       destruct (eval_expr e1 rho); inv H.
       rewrite !andb_true_iff in H1.
       destruct H1 as [[? ?] ?].
-      rewrite H, H0, H1.
+      rewrite H H0 H1.
       simpl.
-      repeat apply andp_right; apply prop_right; auto.
-    - rewrite !denote_tc_assert_andp; simpl.
+      repeat apply bi.and_intro; apply bi.pure_intro; auto.
+    - rewrite !expr2.denote_tc_assert_andp; simpl.
       unfold_lift.
       unfold tc_int_or_ptr_type, denote_tc_isptr.
       destruct (eval_expr e2 rho); inv H.
       rewrite !andb_true_iff in H1.
       destruct H1 as [[? ?] ?].
-      rewrite H, H0, H1.
+      rewrite H H0 H1.
       simpl.
-      repeat apply andp_right; apply prop_right; auto.
-    - rewrite !denote_tc_assert_andp; simpl.
+      repeat apply bi.and_intro; apply bi.pure_intro; auto.
+    - rewrite !expr2.denote_tc_assert_andp; simpl.
       unfold_lift.
       unfold tc_int_or_ptr_type, denote_tc_isptr.
       destruct (eval_expr e2 rho); inv H.
       rewrite !andb_true_iff in H1.
       destruct H1 as [[? ?] ?].
-      rewrite H, H0, H1.
+      rewrite H H0 H1.
       simpl.
-      repeat apply andp_right; apply prop_right; auto.
+      repeat apply bi.and_intro; apply bi.pure_intro; auto.
     - inv H.
   + inv H.
   + inv H.
@@ -276,13 +272,13 @@ Qed.
 
 Lemma const_only_isCastResultType_spec: forall {cs: compspecs} rho e t P,
   const_only_isCastResultType (typeof e) t (eval_expr e rho) = true ->
-  P |-- denote_tc_assert (isCastResultType (typeof e) t e) rho.
+  P ⊢ denote_tc_assert (isCastResultType (typeof e) t e) rho.
 Proof.
   intros.
   unfold const_only_isCastResultType in H.
   rewrite orb_true_iff in H.
-  destruct H.
-  apply neutral_isCastResultType; auto.
+  destruct H; simpl.
+  apply expr2.neutral_isCastResultType; auto.
   destruct (typeof e); inv H.
   destruct t; inv H1.
   simpl. apply TT_right.
@@ -290,7 +286,7 @@ Qed.
 
 Lemma const_only_eval_expr_eq: forall {cs: compspecs} rho e v,
   const_only_eval_expr e = Some v ->
-  eval_expr e rho = v.  
+  eval_expr e rho = v.
 Proof.
   intros.
   revert v H; induction e; try solve [intros; inv H; auto].
@@ -323,7 +319,7 @@ Proof.
     specialize (IHe1 _ eq_refl).
     specialize (IHe2 _ eq_refl).
     unfold_lift.
-    rewrite IHe1, IHe2; auto.
+    rewrite IHe1 IHe2; auto.
   + intros.
     simpl in *.
     unfold option_map in H.
@@ -342,34 +338,33 @@ Proof.
     auto.
 Qed.
 
-Lemma const_only_eval_expr_tc: forall {cs: compspecs} Delta e v P,
+Lemma const_only_eval_expr_tc: forall Delta e v P,
   const_only_eval_expr e = Some v ->
-  P |-- tc_expr Delta e.
+  P ⊢ tc_expr Delta e.
 Proof.
   intros.
-  intro rho.
   revert v H; induction e; try solve [intros; inv H].
   + intros.
     inv H.
     destruct t as [| [| | |] | | | | | | |]; inv H1.
-    exact (@prop_right mpred _ True _ I).
+    rewrite /tc_expr /=; auto.
   + intros.
     inv H.
     destruct t as [| | | [|] | | | | |]; inv H1.
-    exact (@prop_right mpred _ True _ I).
+    rewrite /tc_expr /=; auto.
   + intros.
     inv H.
     destruct t as [| | | [|] | | | | |]; inv H1.
-    exact (@prop_right mpred _ True _ I).
+    rewrite /tc_expr /=; auto.
   + intros.
     unfold tc_expr in *.
     simpl in *.
     unfold option_map in H.
     destruct (const_only_eval_expr e) eqn:HH; inv H.
     specialize (IHe _ eq_refl).
-    unfold_lift.
-    rewrite denote_tc_assert_andp; simpl; apply andp_right; auto.
-    apply const_only_isUnOpResultType_spec.
+    unfold typecheck_expr; fold typecheck_expr.
+    rewrite denote_tc_assert_andp; simpl; apply bi.and_intro; auto.
+    split => rho; apply const_only_isUnOpResultType_spec.
     apply (const_only_eval_expr_eq rho) in HH.
     rewrite HH.
     destruct (const_only_isUnOpResultType u (typeof e) v0 t); inv H1; auto.
@@ -381,12 +376,12 @@ Proof.
     destruct (const_only_eval_expr e2) eqn:HH2; inv H1.
     specialize (IHe1 _ eq_refl).
     specialize (IHe2 _ eq_refl).
-    unfold_lift.
-    rewrite !denote_tc_assert_andp; simpl; repeat apply andp_right; auto.
-    apply const_only_isBinOpResultType_spec.
+    unfold typecheck_expr; fold typecheck_expr.
+    rewrite !denote_tc_assert_andp; simpl; repeat apply bi.and_intro; auto.
+    split => rho; apply const_only_isBinOpResultType_spec.
     apply (const_only_eval_expr_eq rho) in HH1.
     apply (const_only_eval_expr_eq rho) in HH2.
-    rewrite HH1, HH2.
+    rewrite HH1 HH2.
     destruct (const_only_isBinOpResultType b (typeof e1) v0 (typeof e2) v1 t); inv H0; auto.
   + intros.
     unfold tc_expr in *.
@@ -394,28 +389,26 @@ Proof.
     unfold option_map in H.
     destruct (const_only_eval_expr e) eqn:HH; inv H.
     destruct (const_only_isCastResultType (typeof e) t v0) eqn:?H; inv H1.
+    unfold typecheck_expr; fold typecheck_expr.
     rewrite denote_tc_assert_andp.
-    simpl.
-    apply andp_right; eauto.
-    apply const_only_isCastResultType_spec; auto.
+    apply bi.and_intro; eauto.
+    split => rho; apply const_only_isCastResultType_spec; auto.
   + intros.
     inv H.
     unfold tc_expr.
-    simpl typecheck_expr.
-    simpl.
+    unfold typecheck_expr; fold typecheck_expr.
     destruct (complete_type cenv_cs t && eqb_type t0 size_t) eqn:HH; inv H1.
     rewrite andb_true_iff in HH.
-    unfold tuint in HH; destruct HH.
-    rewrite H, H0.
-    exact (@prop_right mpred _ True _ I).
+    unfold tuint in HH; destruct HH as [-> ->].
+    simpl; auto.
   + intros.
     inv H.
     unfold tc_expr.
-    simpl typecheck_expr.
-    simpl.
+    unfold typecheck_expr; fold typecheck_expr.
     destruct (complete_type cenv_cs t && eqb_type t0 size_t) eqn:HH; inv H1.
     rewrite andb_true_iff in HH.
-    unfold tuint in HH; destruct HH.
-    rewrite H, H0.
-    exact (@prop_right mpred _ True _ I).
+    unfold tuint in HH; destruct HH as [-> ->].
+    simpl; auto.
 Qed.
+
+End mpred.
diff --git a/floyd/core_base.v b/floyd/core_base.v
new file mode 100644
index 0000000000..9d40660ea3
--- /dev/null
+++ b/floyd/core_base.v
@@ -0,0 +1,6 @@
+(* export some of the same files as SeparationLogic.v, without going through all of VeriC *)
+From compcert.cfrontend Require Export Ctypes.
+From VST.sepcomp Require Export extspec.
+From VST.veric Require Export Clight_base Cop2 Clight_Cop2 val_lemmas res_predicates mpred seplog tycontext lifting_expr lifting mapsto_memory_block.
+From VST.floyd Require Export functional_base canon client_lemmas nested_field_lemmas.
+Export Address.
diff --git a/floyd/data_at_lemmas.v b/floyd/data_at_lemmas.v
index 72e2a323b8..7dcb1af866 100644
--- a/floyd/data_at_lemmas.v
+++ b/floyd/data_at_lemmas.v
@@ -1,6 +1,8 @@
 From compcert Require Import common.AST cfrontend.Ctypes cfrontend.Clight.
 Import Cop.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.functional_base.
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.compare_lemmas.
@@ -21,6 +23,10 @@ Require Import VST.floyd.proj_reptype_lemmas.
 Require Import VST.floyd.replace_refill_reptype_lemmas.
 Require Import VST.floyd.unfold_data_at.
 Require Import VST.floyd.entailer.
+Require Import VST.floyd.go_lower.
+Import ListNotations.
+
+Local Unset SsrRewrite.
 
 Lemma 
   sbyte_ubyte_convert:
@@ -94,28 +100,30 @@ Qed.
 
 Module M.
 Import VST.veric.base.
-Import VST.msl.predicates_hered.
-Import VST.veric.res_predicates.
+
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ}.
 
 Lemma address_mapsto_any_sbyte_ubyte:
  forall sh b z,
- EX v2' : val, address_mapsto Mint8signed v2' sh (b, z) =
- EX v2' : val, address_mapsto Mint8unsigned v2' sh (b, z).
+ (∃ v2' : val, address_mapsto Mint8signed v2' sh (b, z)) ⊣⊢
+ (∃ v2' : val, address_mapsto Mint8unsigned v2' sh (b, z)).
 Proof.
 intros.
-apply pred_ext;
+apply bi.equiv_entails_2;
 [pose (f := Byte.unsigned) | pose (f := Byte.signed)];
-apply exp_left; intro v;
+apply bi.exist_elim; intro v;
 pose (v' := match v with Vint j => Vint (Int.repr (f (Byte.repr (Int.unsigned j))))
   | _ => Vundef
 end);
-apply exp_right with v';
+rewrite <- (bi.exist_intro v');
 unfold address_mapsto;
-apply exp_left; intro bl; 
-apply exp_right with bl;
-apply prop_andp_left; intros [? [? ?]];
+apply bi.exist_elim; intro bl;
+rewrite <- (bi.exist_intro bl);
+apply bi.pure_elim_l; intros [? [? ?]];
 destruct bl as [| ? [|]]; try solve [inv H];
-(rewrite prop_true_andp; [auto | 
+(rewrite <- prop_and_same_derives'; [auto | 
   split3; auto; unfold decode_val in *; destruct m; subst v v' f; simpl in *; auto;
    unfold decode_int; rewrite rev_if_be_singleton; simpl; rewrite Z.add_0_r;
    f_equal; clear
@@ -148,6 +156,9 @@ rewrite if_true by lia.
 rewrite Int.testbit_repr by lia.
 reflexivity.
 Qed.
+
+End mpred.
+
 End M.
 
 Arguments deref_noload ty v / .
@@ -159,17 +170,21 @@ Arguments Z.sub !m !n.
 Arguments Z.add !x !y.
 Global Transparent peq.
 
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ}.
+
 Lemma data_at_tarray_tschar_tuchar {cs: compspecs}:
   forall sh n bytes p,
-  data_at sh (tarray tschar n) (map Vbyte bytes) p = data_at sh (tarray tuchar n) (map Vubyte bytes) p.
+  data_at sh (tarray tschar n) (map Vbyte bytes) p ⊣⊢ data_at sh (tarray tuchar n) (map Vubyte bytes) p.
 Proof.
 intros.
 unfold data_at, field_at.
-f_equal.
-f_equal.
+f_equiv.
+f_equiv.
 unfold field_compatible.
 simpl.
-apply prop_ext; intuition; destruct p; auto;
+intuition; destruct p; auto;
 hnf in H2|-*;
 apply align_compatible_rec_Tarray; intros;
 apply align_compatible_rec_Tarray_inv with (i:=i0) in H2; auto;
@@ -197,13 +212,13 @@ unfold mapsto; simpl.
 if_tac; auto.
 -
 simpl.
-f_equal; auto; [f_equal; auto | ].
+f_equiv; auto; [f_equiv; auto | ].
 +
-f_equal.
+f_equiv.
 destruct (zlt i (Zlength bytes)).
 rewrite !Znth_map by lia.
 simpl.
-apply prop_ext; split; intro; 
+split; intro; 
 autorewrite with norm norm1 norm2; rep_lia.
 rewrite !Znth_overflow by (autorewrite with sublist; auto).
 reflexivity.
@@ -213,20 +228,18 @@ destruct (zlt i (Zlength bytes)).
 2:
  rewrite !Znth_overflow by (autorewrite with sublist; auto);
  unfold res_predicates.address_mapsto; simpl;
- f_equal;
- extensionality bl;
- f_equal; f_equal;
- apply prop_ext; intuition;
+ f_equiv; intros bl;
+ f_equiv; f_equiv;
+ intuition;
  destruct bl as [| ? [|]]; inv H3;
  destruct m; inv H; reflexivity.
 autorewrite with sublist.
 forget (Znth i bytes) as c.
 unfold res_predicates.address_mapsto; simpl.
-f_equal.
-extensionality bl.
-f_equal.
-f_equal.
- apply prop_ext; intuition;
+f_equiv; intros bl.
+f_equiv.
+f_equiv.
+intuition;
  destruct bl as [| ? [|]]; inv H3;
  destruct m; try solve [inv H];
  unfold decode_val, proj_bytes in *;
@@ -239,35 +252,31 @@ simpl in H|-*;
 rewrite Z.add_0_r in *;
 apply sbyte_ubyte_convert; auto.
 +
-f_equal; auto.
-f_equal.
+f_equiv; auto.
+f_equiv.
 repeat change (unfold_reptype ?A) with A.
 destruct (zlt i (Zlength bytes)).
 autorewrite with sublist.
-apply prop_ext; split; intro Hx; inv Hx.
+split; intro Hx; inv Hx.
 rewrite !Znth_overflow by (autorewrite with sublist; auto).
-apply prop_ext; split; intro; reflexivity.
+split; intro; reflexivity.
 clear.
 forget (Ptrofs.unsigned i0) as z.
 apply M.address_mapsto_any_sbyte_ubyte.
 -
-f_equal.
-f_equal.
-f_equal.
+f_equiv.
+f_equiv.
+f_equiv.
 unfold tc_val'.
 destruct (zlt i (Zlength bytes)).
 autorewrite with sublist.
-apply prop_ext; split; intros.
+split; intros.
 red. simpl. normalize. rep_lia.
 red. simpl. normalize. rep_lia.
 rewrite !Znth_overflow by (autorewrite with sublist; auto).
-apply prop_ext; split; intros; contradiction H2; auto.
+split; intros; contradiction H2; auto.
 Qed.
 
-Require Import VST.msl.iter_sepcon.
-Require Import VST.floyd.go_lower.
-Import ListNotations.
-
 Section ArrayPointer.
 
 Context {cs: compspecs}.
@@ -484,7 +493,7 @@ Qed.
 
 (*We can consider an instance of t at position p to be a valid array of length 1 at p*)
 Lemma data_at_array_len_1: forall sh t a p,
-data_at sh t a p |-- !! field_compatible (tarray t 1) [] p.
+data_at sh t a p ⊢ ⌜field_compatible (tarray t 1) [] p⌝.
 Proof.
   intros. erewrite <- data_at_singleton_array_eq. 2: reflexivity. entailer!.
 Qed.
@@ -563,14 +572,15 @@ Lemma data_at_2darray_concat : forall sh t n m (al : list (list (reptype t))) p,
   Forall (fun l => Zlength l = m) al ->
   complete_legal_cosu_type t = true ->
   data_at sh (tarray (tarray t m) n) al p
-    = data_at sh (tarray t (n * m)) (concat al) p.
+    ⊣⊢ data_at sh (tarray t (n * m)) (concat al) p.
 Proof.
   intros.
   generalize dependent n; generalize dependent p; induction al; intros.
-  - simpl. replace n with 0 by list_solve. rewrite Z.mul_0_l. 
-    apply pred_ext; entailer!; rewrite !data_at_zero_array_eq; auto.
+  - simpl. replace n with 0 by list_solve. rewrite Z.mul_0_l.
+    apply bi.equiv_entails_2; entailer!; rewrite ?data_at_zero_array_eq; auto;
+      apply isptr_field_compatible0_tarray; auto.
   - rewrite Zlength_cons in H. simpl. assert (Hmlen: Zlength a = m) by (inversion H0; subst; reflexivity).
-    apply pred_ext.
+    apply bi.equiv_entails_2.
     + (*We will need these later, when we have transformed the [data_at] predicates, so they are harder to prove*)
       assert_PROP (field_compatible (tarray (tarray t m) (Z.succ (Zlength al))) [] p). { entailer!. }
       assert_PROP (field_compatible0 (tarray (tarray t m) n) (SUB 1) p). { entailer!.
@@ -621,22 +631,29 @@ Qed.
   are described by contents - a 2D array with possibly different lengths.
   This definition applies to byte arrays (so we don't need to worry about offsets), but it
   could be extended. *)
-Definition iter_sepcon_arrays (ptrs : list val) (contents: list (list byte)) := 
-  iter_sepcon (fun (x: (list byte * val)) => let (l, ptr) := x in 
-            data_at Ews (tarray tuchar (Zlength l)) (map Vubyte l) ptr) (combine contents ptrs).
+Definition iter_sepcon_arrays (ptrs : list val) (contents: list (list byte)) :=
+  [∗ list] '(l, ptr) ∈ combine contents ptrs, data_at Ews (tarray tuchar (Zlength l)) (map Vubyte l) ptr.
+
+(* up? *)
+Lemma Znth_lookup : forall {A} {I : Inhabitant A} (l : list A) i, 0 <= i < Zlength l -> (l !! (Z.to_nat i))%stdpp = Some (Znth i l).
+Proof.
+  intros.
+  destruct (nth_lookup_or_length l (Z.to_nat i) default) as [-> |].
+  - rewrite nth_Znth', Z2Nat.id; tauto.
+  - rewrite Zlength_correct in *; lia.
+Qed.
 
 Lemma iter_sepcon_arrays_Znth: forall ptrs contents i,
   Zlength ptrs = Zlength contents ->
   0 <= i < Zlength contents ->
-  iter_sepcon_arrays ptrs contents |-- 
-    data_at Ews (tarray tuchar (Zlength (Znth i contents))) (map Vubyte (Znth i contents)) (Znth i ptrs) * TT.
+  iter_sepcon_arrays ptrs contents ⊢ 
+    data_at Ews (tarray tuchar (Zlength (Znth i contents))) (map Vubyte (Znth i contents)) (Znth i ptrs) ∗ True.
 Proof.
-  intros ptrs contents i Hlen Hi. unfold iter_sepcon_arrays. 
-  sep_apply (iter_sepcon_in_true (fun x : list byte * val => let (l, ptr) := x in 
-    data_at Ews (tarray tuchar (Zlength l)) (map Vubyte l) ptr) (combine contents ptrs) 
-    (Znth i contents, Znth i ptrs)); [|cancel].
-  rewrite In_Znth_iff. exists i. split. rewrite Zlength_combine; lia.
-  apply Znth_combine; lia.
+  intros ptrs contents i Hlen Hi. unfold iter_sepcon_arrays.
+  rewrite (big_sepL_lookup_acc _ _ (Z.to_nat i)).
+  2: { apply Znth_lookup; rewrite Zlength_combine; lia. }
+  rewrite Znth_combine by done.
+  cancel.
 Qed.
 
 Lemma remove_lead_eq: forall {A: Type} (P: Prop) (x: A),
@@ -646,25 +663,18 @@ Proof.
 Qed.
 
 Lemma iter_sepcon_arrays_local_facts: forall ptrs contents,
-  iter_sepcon_arrays ptrs contents |-- !! (Zlength ptrs = Zlength contents -> 
+  iter_sepcon_arrays ptrs contents ⊢ ⌜Zlength ptrs = Zlength contents -> 
         forall i, 0 <= i < Zlength contents ->
          field_compatible (tarray tuchar (Zlength (Znth i contents))) [] (Znth i ptrs) /\
-         Forall (value_fits tuchar) (map Vubyte (Znth i contents))).
+         Forall (value_fits tuchar) (map Vubyte (Znth i contents))⌝.
 Proof.
-  intros ptrs contents. 
-  assert (Zlength ptrs = Zlength contents \/ Zlength ptrs <> Zlength contents) as [Heq | Hneq] by lia; 
-  [ | entailer!]. rewrite Heq, remove_lead_eq. eapply derives_trans. 2:
-  apply (@allp_prop_left _ _ Z (fun (i: Z) => 0 <= i < Zlength contents ->
-        field_compatible (tarray tuchar (Zlength (Znth i contents))) [] (Znth i ptrs) /\
-        Forall (value_fits tuchar) (map Vubyte (Znth i contents)))).
-  apply allp_right. intros i.
-  (*This is not particularly elegant; is there a way to get an implication out directly?*)
-  assert (0 <= i < Zlength contents \/ ~ (0 <= i < Zlength contents)) as [Hlt | Hgt] by lia; [| entailer ].
-  sep_apply (iter_sepcon_arrays_Znth _ _ _ Heq Hlt).
-  assert (forall m (P : Type) Q, P -> (m |-- !! Q) -> (m |-- !! (P -> Q))). { intros. sep_apply H. entailer!. }
-  apply H. assumption. entailer!.
+  intros ptrs contents.
+  iIntros "?" (???).
+  rewrite iter_sepcon_arrays_Znth by done.
+  iStopProof. entailer!.
 Qed.
 
+(*
 (*We would also like another, more general fact. For [iter_sepcon] that gives an mpred 
   as well as [iter_sepcon_arrays]), we can remove
   the nth element and keep the rest*)
@@ -680,7 +690,7 @@ Proof.
   intros B Hinhab p l n Hn. unfold remove_nth. rewrite <- (sublist_same 0 (Zlength l) l) at 1 by auto.
   rewrite (sublist_split 0 n (Zlength l) l) by lia.
   rewrite (sublist_split n (n+1) (Zlength l) l) by lia. rewrite !iter_sepcon_app.
-  rewrite sublist_len_1 by lia. simpl. apply pred_ext; cancel.
+  rewrite sublist_len_1 by lia. simpl. apply bi.equiv_entails_2; cancel.
 Qed.
 
 Lemma combine_sublist: forall {A B: Type} `{Inhabitant A} `{Inhabitant B} (lo hi : Z) (l1 : list A) (l2: list B),
@@ -719,7 +729,7 @@ Proof.
   intros ptrs contents i Hlens Hi. unfold iter_sepcon_arrays. rewrite (iter_sepcon_remove_one _ _ i).
   rewrite Znth_combine by auto. f_equal. rewrite combine_remove_nth by lia. reflexivity.
   rewrite Zlength_combine; lia.
-Qed.
+Qed.*)
 
 End ArrayPointer.
 
@@ -730,20 +740,6 @@ Section DataAtNumeric.
 Context `{cs: compspecs}.
 
 (*Helper lemmas*)
-Lemma exp_equiv: forall {A} (f: A -> predicates_hered.pred compcert_rmaps.RML.R.rmap),
-  exp f = predicates_hered.exp f.
-Proof.
-  intros. reflexivity.
-Qed.
-
-Lemma andp_pull1:
-  forall P (A C: predicates_hered.pred compcert_rmaps.RML.R.rmap), predicates_hered.andp (predicates_hered.andp (predicates_hered.prop P) A) C =
-                 predicates_hered.andp (predicates_hered.prop P)  (predicates_hered.andp A C).
-Proof.
-intros.
-apply predicates_hered.andp_assoc.
-Qed.
-
 Lemma decode_int_single: forall (b: byte),
   decode_int [b] = Byte.unsigned b.
 Proof.
@@ -815,7 +811,7 @@ apply int_of_bytes_inj in H0; auto.
 Qed.
 
 (** Convert between 4 bytes and int *)
-Lemma address_mapsto_4bytes_aux: 
+(*Lemma address_mapsto_4bytes_aux: 
  forall (sh : Share.t)
    (b0 b1 b2 b3 : byte)
    (b : block) (i : ptrofs)
@@ -1088,7 +1084,7 @@ res_predicates.address_mapsto Mint32
 Proof.
 intros.
       unfold res_predicates.address_mapsto. rewrite <- !exp_equiv.
-      apply predicates_hered.pred_ext.
+      apply predicates_hered.bi.equiv_entails_2.
   - repeat change (exp ?A) with (predicates_hered.exp A).
       normalize.normalize.
       intros bl3 [A3 [B3 _]] bl2 bl1 bl0.
@@ -1105,7 +1101,7 @@ intros.
      destruct c2; try discriminate H2.
      destruct c3; try discriminate H3.
    apply decode_val_Vubyte_inj in H0,H1,H2,H3. subst.
-   apply (predicates_hered.exp_right [Byte b0; Byte b1; Byte b2; Byte b3]).
+   apply (predicates_hered.bi.exist_intro [Byte b0; Byte b1; Byte b2; Byte b3]).
      rewrite predicates_hered.prop_true_andp.
       2:{ split3. reflexivity. reflexivity. apply AL. }
   match goal with |- predicates_hered.derives ?A ?B => 
@@ -1130,13 +1126,13 @@ intros.
        apply repr_inj_unsigned in H0; try rep_lia.
         apply decode_int_inj in H0.
       clear H H2. inv H0.
-     apply predicates_hered.exp_right with [Byte b3].
+     apply predicates_hered.bi.exist_intro with [Byte b3].
       normalize.normalize.
-     apply predicates_hered.exp_right with [Byte b2].
+     apply predicates_hered.bi.exist_intro with [Byte b2].
       normalize.normalize.
-     apply predicates_hered.exp_right with [Byte b1].
+     apply predicates_hered.bi.exist_intro with [Byte b1].
       normalize.normalize.
-     apply predicates_hered.exp_right with [Byte b0].
+     apply predicates_hered.bi.exist_intro with [Byte b0].
      rewrite !predicates_hered.prop_true_andp by 
      (split3; [ reflexivity |  | apply Z.divide_1_l  ];
      unfold decode_val, Vubyte; simpl; f_equal;
@@ -1706,7 +1702,7 @@ predicates_sl.sepcon (res_predicates.address_mapsto Mint8unsigned (Vubyte b0) sh
                                                               (b, Ptrofs.unsigned i).
 Proof.
   intros. unfold res_predicates.address_mapsto. rewrite <- !exp_equiv.
-  apply predicates_hered.pred_ext.
+  apply predicates_hered.bi.equiv_entails_2.
   - repeat change (exp ?A) with (predicates_hered.exp A).
     normalize.normalize.
     intros bl1 [A1 [B1 _]] bl0.
@@ -1717,7 +1713,7 @@ Proof.
     destruct c0; try discriminate.
     destruct c1; try discriminate.
     apply decode_val_Vubyte_inj in H0,H1. subst.
-    apply (predicates_hered.exp_right [Byte b0; Byte b1]).
+    apply (predicates_hered.bi.exist_intro [Byte b0; Byte b1]).
     rewrite predicates_hered.prop_true_andp.
     2:{ split3. reflexivity. unfold decode_val. simpl.
         f_equal. apply zero_ext_16. 
@@ -1744,9 +1740,9 @@ Proof.
    apply repr_inj_unsigned in H0; try rep_lia.
     apply decode_int_inj in H0.
    clear H H2. inv H0.
-  apply predicates_hered.exp_right with [Byte b1].
+  apply predicates_hered.bi.exist_intro with [Byte b1].
   normalize.normalize.
-  apply predicates_hered.exp_right with [Byte b0].
+  apply predicates_hered.bi.exist_intro with [Byte b0].
   rewrite !predicates_hered.prop_true_andp by 
  (split3; [ reflexivity |  | apply Z.divide_1_l  ];
  unfold decode_val, Vubyte; simpl; f_equal;
@@ -1855,7 +1851,7 @@ Proof.
        rewrite !prop_true_andp.
       2 : split; auto; hnf; intros; apply tc_val_short.
       apply nonlock_permission_2bytes; auto.
-Qed.
+Qed.*)
 
 End DataAtNumeric.
 
@@ -1866,7 +1862,7 @@ Lemma field_at_values_cohere {cs:compspecs}:
        value_defined (nested_field_type t gfs) v1 ->
        value_defined (nested_field_type t gfs) v2 ->
     readable_share sh1 -> readable_share sh2 ->
-   field_at sh1 t gfs v1 p * field_at sh2 t gfs v2 p |-- !!(v1=v2).
+   field_at sh1 t gfs v1 p ∗ field_at sh2 t gfs v2 p ⊢ ⌜v1=v2⌝.
 Proof. intros.
   unfold field_at, at_offset; Intros.
   destruct H3 as [? _]. destruct p; try contradiction.
@@ -1880,24 +1876,24 @@ Lemma data_at_values_cohere {cs:compspecs}:
        value_defined t v1 ->
        value_defined t v2 ->
     readable_share sh1 -> readable_share sh2 ->
-   data_at sh1 t v1 p * data_at sh2 t v2 p |-- !!(v1=v2).
+   data_at sh1 t v1 p ∗ data_at sh2 t v2 p ⊢ ⌜v1=v2⌝.
 Proof. intros.
   apply field_at_values_cohere; auto.
 Qed.
 
-
 Import ListNotations.
+
 Definition cstring {CS : compspecs} sh (s: list byte) p := 
-  !!(~In Byte.zero s) &&
+  ⌜~In Byte.zero s⌝ ∧
   data_at sh (tarray tschar (Zlength s + 1)) (map Vbyte (s ++ [Byte.zero])) p.
 
-Lemma cstring_local_facts: forall {CS : compspecs} sh s p, 
-  cstring sh s p |-- !! (isptr p /\ Zlength s + 1 < Ptrofs.modulus).
+Lemma cstring_local_facts: forall {CS : compspecs} sh s p,
+  cstring sh s p ⊢ ⌜isptr p /\ Zlength s + 1 < Ptrofs.modulus⌝.
 Proof.
   intros; unfold cstring.
   Intros.
   saturate_local.
-  apply prop_right.
+  apply bi.pure_intro.
   destruct H0 as [? [_ [? _]]].
   destruct p; try contradiction.
   red in H3.
@@ -1910,11 +1906,9 @@ Proof.
   lia. 
 Qed.
 
-#[export] Hint Resolve cstring_local_facts : saturate_local.
-
 Lemma cstring_valid_pointer: forall {CS : compspecs} sh s p, 
-   nonempty_share sh -> 
-   cstring sh s p |-- valid_pointer p.
+   nonempty_share sh ->
+   cstring sh s p ⊢ valid_pointer p.
 Proof.
   intros; unfold cstring; Intros.
   apply data_at_valid_ptr; auto.
@@ -1923,9 +1917,8 @@ Proof.
   rewrite Z.max_r; lia.
 Qed.
 
-#[export] Hint Resolve cstring_valid_pointer : valid_pointer.
 Definition cstringn {CS : compspecs} sh (s: list byte) n p :=
-  !!(~In Byte.zero s) &&
+  ⌜~In Byte.zero s⌝ ∧
   data_at sh (tarray tschar n) (map Vbyte (s ++ [Byte.zero]) ++
     Zrepeat Vundef (n - (Zlength s + 1))) p.
 
@@ -1938,7 +1931,7 @@ Fixpoint no_zero_bytes (s: list byte) : bool :=
 Lemma data_at_to_cstring:
  forall {CS: compspecs} sh n s p,
   no_zero_bytes s = true ->
- data_at sh (tarray tschar n) (map Vbyte (s ++ [Byte.zero])) p |--
+ data_at sh (tarray tschar n) (map Vbyte (s ++ [Byte.zero])) p ⊢
  cstring sh s p.
 Proof.
 intros.
@@ -1951,8 +1944,8 @@ rewrite H2 in *.
 clear H0 H2.
 subst n.
 unfold cstring.
-apply andp_right; auto.
-apply prop_right.
+apply bi.and_intro; auto.
+apply bi.pure_intro.
 intro.
 induction s; simpl in *; auto.
 rewrite andb_true_iff in H.
@@ -1969,10 +1962,10 @@ Proof.
 Qed.
 
 Lemma cstringn_local_facts: forall {CS : compspecs} sh s n p, 
-   cstringn sh s n p |-- !! (isptr p /\ Zlength s + 1 <= n <= Ptrofs.max_unsigned).
+   cstringn sh s n p ⊢ ⌜isptr p /\ Zlength s + 1 <= n <= Ptrofs.max_unsigned⌝.
 Proof.
   intros; unfold cstringn.
-  Intros. saturate_local. apply prop_right.
+  Intros. saturate_local. apply bi.pure_intro.
   rewrite !Zlength_app, !Zlength_map, Zlength_app in H1.
   assert (H8 := Zlength_nonneg s).
   destruct (zlt n (Zlength s + 1)).
@@ -1989,11 +1982,10 @@ Proof.
   rep_lia.
 Qed.
 
-#[export] Hint Resolve cstringn_local_facts : saturate_local.
 
-Lemma cstringn_valid_pointer: forall {CS : compspecs} sh s n p, 
-     nonempty_share sh -> 
-     cstringn sh s n p |-- valid_pointer p.
+Lemma cstringn_valid_pointer: forall {CS : compspecs} sh s n p,
+     nonempty_share sh ->
+     cstringn sh s n p ⊢ valid_pointer p.
 Proof.
   intros.
   unfold cstringn. Intros.
@@ -2007,7 +1999,6 @@ Proof.
   rep_lia.
 Qed.
 
-#[export] Hint Resolve cstringn_valid_pointer : valid_pointer.
 
 
 Lemma Znth_zero_zero:
@@ -2018,6 +2009,13 @@ unfold Znth.
 if_tac; auto. destruct (Z.to_nat i). reflexivity. destruct n; reflexivity.
 Qed.
 
+End mpred.
+
+#[export] Hint Resolve cstring_local_facts : saturate_local.
+#[export] Hint Resolve cstring_valid_pointer : valid_pointer.
+#[export] Hint Resolve cstringn_local_facts : saturate_local.
+#[export] Hint Resolve cstringn_valid_pointer : valid_pointer.
+
 (* THIS TACTIC solves goals of the form,
     ~In 0 ls,  Znth i (ls++[0]) = 0 |-  (any lia consequence of)  i < Zlength ls
     ~In 0 ls,  Znth i (ls++[0]) <> 0 |-  (any lia consequence of)  i >= Zlength ls
@@ -2038,12 +2036,12 @@ Znth _ (_++[Byte.zero]) <> Byte.zero"
   apply Classical_Prop.NNPP; intro;
   match goal with
   | H: ~In Byte.zero ?ls, H1: Znth ?i (?ls' ++ [Byte.zero]) = Byte.zero |- _ =>
-     constr_eq ls ls'; apply H; rewrite <- H1;  
+     constr_eq ls ls'; apply H; rewrite <- H1;
     rewrite app_Znth1 by lia; apply Znth_In; lia
   | H: ~In Byte.zero ?ls, H1: Znth ?i (?ls' ++ [Byte.zero]) <> Byte.zero |- _ =>
      constr_eq ls ls'; apply H1;
-     rewrite app_Znth2 by lia; apply Znth_zero_zero
-  end) || 
+     rewrite -> app_Znth2 by lia; apply Znth_zero_zero
+  end) ||
   match goal with |- @eq ?t (?f1 _) (?f2 _) =>
        (unify t Z || unify t nat) ||
        (constr_eq f1 f2;
@@ -2063,6 +2061,5 @@ Ltac cstring1 :=
 match goal with 
 | H: 0 <= ?x < Zlength ?s + 1,
   H1: Znth ?x (?s ++ [Byte.zero]) = Byte.zero |- _ =>
-  is_var x; assert  (x = Zlength s) by cstring; subst x
+  is_var x; assert (x = Zlength s) by cstring; subst x
 end.
-
diff --git a/floyd/data_at_list_solver.v b/floyd/data_at_list_solver.v
index 797a3cadf5..2a08b009d0 100644
--- a/floyd/data_at_list_solver.v
+++ b/floyd/data_at_list_solver.v
@@ -1,4 +1,6 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Export VST.zlist.Zlength_solver.
 Require Export VST.zlist.list_solver.
 Require Import VST.floyd.reptype_lemmas.
@@ -7,13 +9,19 @@ Require Import VST.floyd.entailer.
 Require Import VST.floyd.field_compat.
 Require Import VST.floyd.canon.
 
+Local Unset SsrRewrite.
+
 (** * list extensionality *)
 (* To prove equality between two lists, a convenient way is to apply extensionality
   and prove their length are equal and each corresponding entries are equal.
   It is convenient because then we can use Znth_solve to solve it. *)
 
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ}.
+
 Definition data_subsume {cs : compspecs} (t : type) (x y : reptype t) : Prop :=
-  forall sh p, data_at sh t x p |-- data_at sh t y p.
+  forall sh p, data_at sh t x p ⊢ data_at sh t y p.
 
 Lemma data_subsume_refl : forall {cs : compspecs} (t : type) (x : reptype t),
   data_subsume t x x.
@@ -29,8 +37,6 @@ Lemma data_subsume_default : forall {cs : compspecs} (t : type) (x y : reptype t
   data_subsume t x y.
 Proof. unfold data_subsume. intros. subst y. apply data_at_data_at_. Qed.
 
-#[export] Hint Resolve data_subsume_refl data_subsume_refl' data_subsume_default : core.
-
 Lemma data_subsume_array_ext : forall {cs : compspecs} (t : type) (n : Z) (al bl : list (reptype t)),
   n = Zlength al ->
   n = Zlength bl ->
@@ -44,14 +50,14 @@ Proof.
     list_form; Zlength_simplify_in_all; try Zlength_solve;
     unfold data_subsume; intros.
   - (* al = [] /\ bl = [] *)
-    entailer!.
+    cancel.
   - (* al <> [] /\ bl <> [] *)
-    do 2 rewrite split2_data_at_Tarray_app with (mid := 1) by Zlength_solve.
-    apply sepcon_derives.
+    do 2 rewrite -> split2_data_at_Tarray_app with (mid := 1) by Zlength_solve.
+    apply bi.sep_mono.
     + specialize (H1 0 ltac:(Zlength_solve)).
       autorewrite with Znth in H1.
-      rewrite data_at_singleton_array_eq with (v := a) by auto.
-      rewrite data_at_singleton_array_eq with (v := b) by auto.
+      rewrite -> data_at_singleton_array_eq with (v := a) by auto.
+      rewrite -> data_at_singleton_array_eq with (v := b) by auto.
       apply H1.
     + apply IHal; try Zlength_solve.
       intros. specialize (H1 (i+1) ltac:(Zlength_solve)).
@@ -61,6 +67,10 @@ Proof.
       apply H1.
 Qed.
 
+End mpred.
+
+#[export] Hint Resolve data_subsume_refl data_subsume_refl' data_subsume_default : core.
+
 Ltac simpl_reptype :=
   repeat lazymatch goal with
   | |- context [reptype ?t] =>
@@ -75,7 +85,7 @@ Ltac simpl_reptype :=
   the lengths are the same and reduces the goal to relation between entries. *)
 Ltac apply_list_ext ::=
   lazymatch goal with
-  | |- _ |-- _ => 
+  | |- _ ⊢ _ => 
      apply data_subsume_array_ext; simpl_reptype;
        [ try Zlength_solve | try Zlength_solve | .. ]
   | |- data_subsume _ _ => 
@@ -124,4 +134,3 @@ Ltac list_simplify :=
    end;
   list_solver.list_simplify;
   cbv delta [hide_cons hide_nil]; cbv beta.
-
diff --git a/floyd/data_at_rec_lemmas.v b/floyd/data_at_rec_lemmas.v
index 569c29bd53..b7fc84a80d 100644
--- a/floyd/data_at_rec_lemmas.v
+++ b/floyd/data_at_rec_lemmas.v
@@ -1,4 +1,6 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.type_induction.
 Require Import VST.floyd.nested_pred_lemmas.
@@ -10,27 +12,38 @@ Require Import VST.floyd.jmeq_lemmas.
 Require Import VST.zlist.sublist.
 Require Export VST.floyd.fieldlist.
 Require Export VST.floyd.aggregate_type.
-Import compcert.lib.Maps.
 
-Opaque alignof.
+Local Unset SsrRewrite.
 
-Local Open Scope logic.
+Opaque alignof.
 
 Arguments align !n !amount / .
 Arguments Z.max !n !m / .
 
-Definition offset_in_range ofs p :=
+Definition offset_in_range ofs p : Prop :=
   match p with
   | Vptr b iofs => 0 <= Ptrofs.unsigned iofs + ofs <= Ptrofs.modulus
   | _ => True
   end.
 
-Definition offset_strict_in_range ofs p :=
+Definition offset_strict_in_range ofs p : Prop :=
   match p with
   | Vptr b iofs => 0 <= Ptrofs.unsigned iofs + ofs < Ptrofs.modulus
   | _ => True
   end.
 
+Ltac unknown_big_endian_hack :=
+  (* This is necessary on machines where Archi.big_endian is a Parameter 
+    rather than a Definition.  When Archi.big_endian is a constant true or false,
+   then it's much easier. *)
+ match goal with H1: (align_chunk _ | _) |- _ ⊢ res_predicates.address_mapsto ?ch ?v ?sh (?b, ?i) =>
+   replace v with (decode_val ch (repeat (Byte Byte.zero) (Z.to_nat (size_chunk ch))));
+   [ apply (mapsto_memory_block.address_mapsto_zeros'_address_mapsto sh ch b i H1) | ];
+    unfold decode_val, decode_int, rev_if_be;
+     destruct Archi.big_endian;
+     reflexivity
+ end.
+
 (************************************************
 
 Definition of data_at_rec
@@ -41,7 +54,7 @@ Always assume in arguments of data_at_rec has argument pos with alignment criter
 
 Section CENV.
 
-Context {cs: compspecs}.
+Context `{!heapGS Σ} {cs: compspecs}.
 
 Section WITH_SHARE.
 
@@ -61,7 +74,7 @@ Lemma data_at_rec_eq: forall t v,
   data_at_rec t v =
   match t return REPTYPE t -> val -> mpred with
   | Tvoid
-  | Tfunction _ _ _ => fun _ _ => FF
+  | Tfunction _ _ _ => fun _ _ => False
   | Tint _ _ _
   | Tfloat _ _
   | Tlong _ _
@@ -174,11 +187,11 @@ Lemma by_value_data_at_rec_default_val: forall sh t p,
   type_is_by_value t = true ->
   size_compatible t p ->
   align_compatible t p ->
-  data_at_rec sh t (default_val t) p = memory_block sh (sizeof t) p.
+  data_at_rec sh t (default_val t) p ⊣⊢ memory_block sh (sizeof t) p.
 Proof.
   intros.
   destruct (type_is_volatile t) eqn:?H.
-  + apply by_value_data_at_rec_volatile; auto.
+  + rewrite by_value_data_at_rec_volatile; auto.
   + rewrite data_at_rec_eq; destruct t; try solve [inversion H]; rewrite H2;
     symmetry;
     rewrite memory_block_mapsto_ by auto; unfold mapsto_;
@@ -221,32 +234,19 @@ intros.
     unfold eq_rect_r; rewrite <- eq_rect_eq; auto.
 Qed.
 
-Ltac unknown_big_endian_hack :=
-  (* This is necessary on machines where Archi.big_endian is a Parameter 
-    rather than a Definition.  When Archi.big_endian is a constant true or false,
-   then it's much easier. *)
- match goal with H1: (align_chunk _ | _) |- _ |-- res_predicates.address_mapsto ?ch ?v ?sh (?b, Ptrofs.unsigned ?i) =>
-   constructor;
-   replace v with (decode_val ch (repeat (Byte Byte.zero) (Z.to_nat (size_chunk ch))));
-   [ apply (mapsto_memory_block.address_mapsto_zeros'_address_mapsto sh ch b i H1) | ];
-    unfold decode_val, decode_int, rev_if_be;
-     destruct Archi.big_endian;
-     reflexivity
- end.
-
 Lemma by_value_data_at_rec_zero_val: forall sh t p,
   type_is_by_value t = true ->
   size_compatible t p ->
   align_compatible t p ->
   type_is_volatile t = false ->
-  mapsto_zeros (sizeof t) sh p |-- data_at_rec sh t (zero_val t) p.
+  mapsto_zeros (sizeof t) sh p ⊢ data_at_rec sh t (zero_val t) p.
 Proof.
   intros.
   rewrite data_at_rec_eq.
   pose proof (sizeof_pos t).
   destruct t; try destruct f; try solve [inversion H]; rewrite H2;
-  destruct p; try apply FF_left;
-  unfold mapsto_zeros; apply derives_extract_prop; intros [? ?];
+  destruct p; try apply False_left;
+  unfold mapsto_zeros; apply bi.pure_elim_l; intros [? ?];
   rewrite mapsto_memory_block.address_mapsto_zeros_eq;
   rewrite Z2Nat.id by lia;
   unfold mapsto; rewrite H2.
@@ -254,49 +254,46 @@ Proof.
    change (unfold_reptype ?A) with A.
     destruct i,s; simpl;
     (eapply align_compatible_rec_by_value_inv in H1; [ | reflexivity]);
-   rewrite prop_true_andp by (clear; compute; repeat split; try congruence; auto);
-   rewrite (prop_true_andp (_ /\ _)) 
-    by (split; auto; intros _; compute; repeat split; try congruence; auto);
-   (if_tac; [apply orp_right1 | ]).
-   all: try (constructor; apply mapsto_memory_block.address_mapsto_zeros'_nonlock_permission_bytes).
+   (if_tac; [rewrite prop_true_andp by (clear; compute; repeat split; try congruence; auto);
+      rewrite <- bi.or_intro_l |
+   rewrite (prop_true_andp (_ /\ _))
+    by (split; auto; intros _; compute; repeat split; try congruence; auto) ]).
+   all: try (apply mapsto_memory_block.address_mapsto_zeros'_nonlock_permission_bytes).
    all: try unknown_big_endian_hack.
 - rewrite zero_val_Tlong.
    change (unfold_reptype ?A) with A.
     destruct s; simpl;
     (eapply align_compatible_rec_by_value_inv in H1; [ | reflexivity]);
-   rewrite prop_true_andp by (clear; compute; repeat split; try congruence; auto);
-   rewrite (prop_true_andp (_ /\ _)) 
-    by (split; auto; intros _; compute; repeat split; try congruence; auto);
-   (if_tac; [apply orp_right1 | ]).
-   all: try (constructor; apply mapsto_memory_block.address_mapsto_zeros'_nonlock_permission_bytes; computable).
+   (if_tac; [rewrite prop_true_andp by (clear; compute; repeat split; try congruence; auto);
+      rewrite <- bi.or_intro_l |
+   rewrite (prop_true_andp (_ /\ _))
+    by (split; auto; intros _; compute; repeat split; try congruence; auto)]).
+   all: try (apply mapsto_memory_block.address_mapsto_zeros'_nonlock_permission_bytes; computable).
    all: try unknown_big_endian_hack.
 - rewrite zero_val_Tfloat32;
    change (unfold_reptype ?A) with A.
     (eapply align_compatible_rec_by_value_inv in H1; [ | reflexivity]).
-   simpl. rewrite prop_true_andp by auto.
-   rewrite (prop_true_andp (_ /\ _)) 
-    by (split; auto; intros _; compute; repeat split; try congruence; auto);
-   (if_tac; [apply orp_right1 | ]); constructor.
+   simpl. if_tac; [rewrite prop_true_andp by auto; rewrite <- bi.or_intro_l |
+   rewrite (prop_true_andp (_ /\ _))
+    by (split; auto; intros _; compute; repeat split; try congruence; auto)].
    all: try apply mapsto_memory_block.address_mapsto_zeros'_nonlock_permission_bytes.
    all: try apply (mapsto_memory_block.address_mapsto_zeros'_address_mapsto sh _ _ _ H1).
 - rewrite zero_val_Tfloat64;
    change (unfold_reptype ?A) with A.
     (eapply align_compatible_rec_by_value_inv in H1; [ | reflexivity]).
-   simpl. rewrite prop_true_andp by auto.
-   rewrite (prop_true_andp (_ /\ _)) 
-    by (split; auto; intros _; compute; repeat split; try congruence; auto);
-   (if_tac; [apply orp_right1 | ]).
+   simpl. if_tac; [rewrite prop_true_andp by auto; rewrite <- bi.or_intro_l |
+   rewrite (prop_true_andp (_ /\ _))
+    by (split; auto; intros _; compute; repeat split; try congruence; auto)].
    all: try (constructor; apply mapsto_memory_block.address_mapsto_zeros'_nonlock_permission_bytes).
    all: try unknown_big_endian_hack.
 - rewrite zero_val_Tpointer.
    change (unfold_reptype ?A) with A.
     (eapply align_compatible_rec_by_value_inv in H1; [ | reflexivity]).
    simpl access_mode; cbv beta iota.
-  rewrite prop_true_andp by apply mapsto_memory_block.tc_val_pointer_nullval'.
+  if_tac; [rewrite prop_true_andp by apply mapsto_memory_block.tc_val_pointer_nullval'; rewrite <- bi.or_intro_l |
    rewrite (prop_true_andp (_ /\ _))
-      by (split; auto; intro; apply mapsto_memory_block.tc_val_pointer_nullval'). 
-   (if_tac; [apply orp_right1 | ]).
-   all: try (constructor; apply mapsto_memory_block.address_mapsto_zeros'_nonlock_permission_bytes).
+      by (split; auto; intro; apply mapsto_memory_block.tc_val_pointer_nullval')].
+   all: try (apply mapsto_memory_block.address_mapsto_zeros'_nonlock_permission_bytes).
    all: try unknown_big_endian_hack.
 Qed.
 
@@ -306,11 +303,11 @@ Lemma by_value_data_at_rec_nonreachable: forall sh t p v,
   align_compatible t p ->
   ~ readable_share sh ->
   tc_val' t (repinject t v) ->
-  data_at_rec sh t v p = memory_block sh (sizeof t) p.
+  data_at_rec sh t v p ⊣⊢ memory_block sh (sizeof t) p.
 Proof.
   intros.
   destruct (type_is_volatile t) eqn:?H.
-  + apply by_value_data_at_rec_volatile; auto.
+  + rewrite by_value_data_at_rec_volatile; auto.
   + rewrite by_value_data_at_rec_nonvolatile by auto.
     symmetry;
     apply nonreadable_memory_block_mapsto; auto.
@@ -320,7 +317,7 @@ Lemma by_value_data_at_rec_default_val2: forall sh t b ofs,
   type_is_by_value t = true ->
   0 <= ofs /\ ofs + sizeof t < Ptrofs.modulus ->
   align_compatible_rec cenv_cs t ofs ->
-  data_at_rec sh t (default_val t) (Vptr b (Ptrofs.repr ofs)) =
+  data_at_rec sh t (default_val t) (Vptr b (Ptrofs.repr ofs)) ⊣⊢
   memory_block sh (sizeof t) (Vptr b (Ptrofs.repr ofs)).
 Proof.
   intros.
@@ -341,7 +338,7 @@ Lemma by_value_data_at_rec_zero_val2: forall sh t b ofs,
   0 <= ofs /\ ofs + sizeof t < Ptrofs.modulus ->
   align_compatible_rec cenv_cs t ofs ->
   type_is_volatile t = false ->
-  mapsto_zeros (sizeof t) sh (Vptr b (Ptrofs.repr ofs)) |-- 
+  mapsto_zeros (sizeof t) sh (Vptr b (Ptrofs.repr ofs)) ⊢ 
   data_at_rec sh t (zero_val t) (Vptr b (Ptrofs.repr ofs)).
 Proof.
   intros.
@@ -363,7 +360,7 @@ Lemma by_value_data_at_rec_nonreachable2: forall sh t b ofs v,
   align_compatible_rec cenv_cs t ofs ->
   ~ readable_share sh ->
   tc_val' t (repinject t v) ->
-  data_at_rec sh t v (Vptr b (Ptrofs.repr ofs)) = memory_block sh (sizeof t) (Vptr b (Ptrofs.repr ofs)).
+  data_at_rec sh t v (Vptr b (Ptrofs.repr ofs)) ⊣⊢ memory_block sh (sizeof t) (Vptr b (Ptrofs.repr ofs)).
 Proof.
   intros.
   apply by_value_data_at_rec_nonreachable; auto.
@@ -397,11 +394,6 @@ between field_at and data_at.
 
 ************************************************)
 
-Lemma lower_sepcon_val':
-  forall (P Q: val->mpred) v,
-  ((P*Q) v) = (P v * Q v).
-Proof. reflexivity. Qed.
-
 (*
 Lemma unsigned_add: forall i pos, 0 <= pos -> Int.unsigned (Int.add i (Int.repr pos)) = (Int.unsigned i + pos) mod Int.modulus.
 Proof.
@@ -552,7 +544,7 @@ Lemma memory_block_data_at_rec_default_val: forall sh t b ofs
   (LEGAL_COSU: complete_legal_cosu_type t = true),
   0 <= ofs /\ ofs + sizeof t < Ptrofs.modulus ->
   align_compatible_rec cenv_cs t ofs ->
-  data_at_rec sh t (default_val t) (Vptr b (Ptrofs.repr ofs)) =
+  data_at_rec sh t (default_val t) (Vptr b (Ptrofs.repr ofs)) ⊣⊢
     memory_block sh (sizeof t) (Vptr b (Ptrofs.repr ofs)).
 Proof.
   intros sh t.
@@ -623,9 +615,10 @@ Proof.
       rewrite name_member_get in *.
       spec IH; [apply in_get_member; auto |].
       rewrite IH; clear IH.
-      * rewrite Z.add_assoc, sepcon_comm.
+      * rewrite Z.add_assoc.
+        etrans; first apply bi.sep_comm.
          rewrite <- memory_block_split by (auto; pose_field; lia).
-        f_equal; lia.
+        f_equiv; hnf; lia.
       * apply complete_legal_cosu_type_field_type.
          eapply complete_Tstruct_plain; eauto.
         auto.
@@ -668,9 +661,9 @@ Proof.
         rewrite name_member_get in *.
         spec IH; [apply in_get_member; auto |].
         rewrite IH.
-        { 
-          rewrite sepcon_comm, <- memory_block_split by (pose_field; lia).
-          f_equal; f_equal; lia.
+        {
+          etrans; first apply bi.sep_comm. rewrite <- memory_block_split by (pose_field; lia).
+          f_equiv; hnf; f_equal; lia.
         } {
           apply complete_legal_cosu_type_field_type.
          eapply complete_Tunion_plain; eauto.
@@ -688,11 +681,11 @@ Fixpoint fully_nonvolatile {cs: compspecs} (rank: nat) (t: type) : bool :=
  | S r => negb (type_is_volatile t) &&
                match t with
                | Tarray t' _ _ => fully_nonvolatile r t'
-               | Tstruct id _ => match cenv_cs ! id with 
+               | Tstruct id _ => match cenv_cs !! id with 
                                           | Some co => forallb (fully_nonvolatile r) (map type_member (co_members co))
                                           | None => false
                                           end
-               | Tunion id _ => match cenv_cs ! id with 
+               | Tunion id _ => match cenv_cs !! id with 
                                           | Some co => forallb (fully_nonvolatile r) (map type_member (co_members co))
                                           | None => false
                                           end
@@ -709,7 +702,7 @@ rewrite andb_true_iff in H0; destruct H0; auto.
 rewrite andb_true_iff in H0|-*; destruct H0; split; auto.
 destruct t; auto.
 apply IHr; auto; lia.
-all: destruct (cenv_cs ! i); auto;
+all: destruct (cenv_cs !! i); auto;
 rewrite forallb_forall in H1|-*; intros; apply H1 in H2; apply IHr; auto; lia.
 Qed.
 
@@ -722,7 +715,7 @@ Lemma mapsto_zeros_data_at_rec_zero_val: forall sh
   0 <= ofs /\ ofs + sizeof t < Ptrofs.modulus ->
   align_compatible_rec cenv_cs t ofs ->
   fully_nonvolatile (rank_type cenv_cs t) t = true ->
-  mapsto_zeros (sizeof t) sh (Vptr b (Ptrofs.repr ofs)) |--
+  mapsto_zeros (sizeof t) sh (Vptr b (Ptrofs.repr ofs)) ⊢
     data_at_rec sh t (zero_val t) (Vptr b (Ptrofs.repr ofs)).
 Proof.
   intros sh ? t.
@@ -736,15 +729,14 @@ Proof.
   rewrite data_at_rec_eq.
  + rewrite (zero_val_eq (Tarray t z a)).
      rewrite unfold_fold_reptype.
-    eapply derives_trans; [ | 
-    apply array_pred_ext_derives with
+   rewrite <- array_pred_ext_derives with
      (P0 := fun i _ p => mapsto_zeros (sizeof t) sh
                           (offset_val (sizeof t * i) p))
-     (v0 := Zrepeat (zero_val t) (Z.max 0 z))];
+     (v0 := Zrepeat (zero_val t) (Z.max 0 z));
      auto.
     apply mapsto_zeros_array_pred; auto.
     - apply Z.le_max_l.
-    - unfold Zrepeat. 
+    - unfold Zrepeat.
       rewrite Z2Nat_max0; auto.
     - intros.
       change (unfold_reptype ?A) with A.
@@ -760,17 +752,16 @@ Proof.
       apply range_max0; auto.
   + rewrite zero_val_eq.
      rewrite unfold_fold_reptype.
-    eapply derives_trans; [ |
-    apply struct_pred_ext_derives with
+    rewrite <- struct_pred_ext_derives with
      (P0 := fun it _ p =>
               mapsto_zeros
                (field_offset_next cenv_cs (name_member it) (co_members (get_co id)) (co_sizeof (get_co id)) -
                   field_offset cenv_cs (name_member it) (co_members (get_co id))) sh
                (offset_val (field_offset cenv_cs (name_member it) (co_members (get_co id))) p))
-     (v0 := (struct_zero_val (co_members (get_co id))))];
+     (v0 := (struct_zero_val (co_members (get_co id))));
     [| apply get_co_members_no_replicate |].
     - change (sizeof ?A) with (expr.sizeof A) in *.
-       eapply derives_trans; [apply mapsto_zeros_struct_pred with (m := co_members (get_co id)) | ];
+      rewrite mapsto_zeros_struct_pred with (m := co_members (get_co id));
          rewrite ?sizeof_Tstruct; auto.
       * apply get_co_members_nil_sizeof_0.
       * eapply complete_Tstruct_plain; eauto.
@@ -786,7 +777,6 @@ Proof.
         lia.
       * rewrite sizeof_Tstruct in H.
         lia.
-      * apply derives_refl.
     - intros.
       pose proof get_co_members_no_replicate id as NO_REPLI.
       rewrite withspacer_spacer.
@@ -801,13 +791,12 @@ Proof.
       specialize (IH (get_member i (co_members (get_co id)))).
       rewrite name_member_get in *.
       spec IH; [apply in_get_member; auto |].
-      eapply derives_trans; [ | apply sepcon_derives; [apply derives_refl | apply IH]]; clear IH.
-      *
-      eapply derives_trans; [ | apply sepcon_derives; [apply mapsto_zeros_memory_block; auto | apply derives_refl ]].
-      simpl fst. 
-       rewrite Z.add_assoc. rewrite sepcon_comm.
-       rewrite <- aggregate_pred.mapsto_zeros_split by (pose_field; lia).
-       apply derives_refl'; f_equal; lia.
+      rewrite <- IH.
+      * rewrite <- mapsto_zeros_memory_block.
+        simpl fst.
+        rewrite Z.add_assoc. rewrite <- bi.sep_comm.
+        rewrite <- aggregate_pred.mapsto_zeros_split by (pose_field; lia).
+        apply bi.equiv_entails_1_1; f_equiv; hnf; lia.
       * apply complete_legal_cosu_type_field_type.
          eapply complete_Tstruct_plain; eauto.
         auto.
@@ -815,7 +804,7 @@ Proof.
       * eapply align_compatible_rec_Tstruct_inv'; eauto.
       * clear - LEGAL_COSU Hvol.
          unfold get_co. simpl in *.
-         destruct (cenv_cs ! id) eqn:?H; try discriminate.
+         destruct (cenv_cs !! id) eqn:?H; try discriminate.
          simpl in Hvol. rewrite H in Hvol.
          destruct (Ctypes.field_type i (co_members c)) eqn:?H; auto.
          destruct (co_su c); try discriminate.
@@ -837,12 +826,12 @@ Proof.
       rewrite H1 in *;
       intros.
       simpl.
-      normalize. apply derives_refl.
+      normalize.
     - rewrite zero_val_eq.
       rewrite unfold_fold_reptype.
-      eapply derives_trans; [ | apply union_pred_ext_derives with
+      rewrite <- union_pred_ext_derives with
        (P0 := fun it _ => mapsto_zeros(co_sizeof (get_co id)) sh)
-       (v0 := (union_zero_val (co_members (get_co id))))];
+       (v0 := (union_zero_val (co_members (get_co id))));
       [| apply get_co_members_no_replicate | reflexivity |].
       * rewrite sizeof_Tunion.
          apply mapsto_zeros_union_pred. (apply get_co_members_nil_sizeof_0).
@@ -862,42 +851,38 @@ Proof.
         specialize (IH (get_member i (co_members (get_co id)))).
       rewrite name_member_get in *.
       spec IH; [apply in_get_member; auto |].
-        eapply derives_trans; [ | apply sepcon_derives; [ apply derives_refl | apply IH]]; clear IH.
-        -- rewrite sepcon_comm. simpl fst.
-             eapply derives_trans; [ | apply sepcon_derives; [apply derives_refl | apply mapsto_zeros_memory_block; auto ]].
-            rewrite <- aggregate_pred.mapsto_zeros_split by (pose_field; lia).
-          apply derives_refl'.
-          f_equal; f_equal; lia.
-       --
-          apply complete_legal_cosu_type_field_type.
-          eapply complete_Tunion_plain; eauto.
-          auto.
-        --
-          pose_field; lia.
-        --
-           eapply align_compatible_rec_Tunion_inv'; eauto.
-       --clear - LEGAL_COSU Hvol.
-         unfold get_co. simpl in *.
-         destruct (cenv_cs ! id) eqn:?H; try discriminate.
-         destruct (co_su c); try discriminate.
-         simpl in Hvol. rewrite H in Hvol.
-         destruct (Ctypes.field_type i (co_members c)) eqn:?H; auto.
-         assert (In (Member_plain i t) (co_members c)). {
+        rewrite <- IH.
+        -- rewrite <- bi.sep_comm. simpl fst.
+           rewrite <- mapsto_zeros_memory_block.
+           rewrite <- aggregate_pred.mapsto_zeros_split by (pose_field; lia).
+           apply bi.equiv_entails_1_1; f_equiv; hnf; lia.
+        -- apply complete_legal_cosu_type_field_type.
+           eapply complete_Tunion_plain; eauto.
+           auto.
+        -- pose_field; lia.
+        -- eapply align_compatible_rec_Tunion_inv'; eauto.
+        -- clear - LEGAL_COSU Hvol.
+           unfold get_co. simpl in *.
+           destruct (cenv_cs !! id) eqn:?H; try discriminate.
+           destruct (co_su c); try discriminate.
+           simpl in Hvol. rewrite H in Hvol.
+           destruct (Ctypes.field_type i (co_members c)) eqn:?H; auto.
+           assert (In (Member_plain i t) (co_members c)). {
              clear - LEGAL_COSU H0. induction (co_members c) as [|[??|]]; simpl; [ | | discriminate]. 
              inv H0. simpl in H0. if_tac in H0. subst. inv H0; auto. right; auto.
-         }
-         rewrite forallb_forall in Hvol. specialize (Hvol  _ (in_map type_member _ _ H1)).
-         pose proof (cenv_legal_su _ _ H). apply (complete_legal_cosu_member _ i t) in H2; auto.
-         eapply fully_nonvolatile_stable; try eassumption.
-         rewrite (co_consistent_rank cenv_cs c (cenv_consistent _ _ H)).        
-         apply (rank_type_members cenv_cs (Member_plain i t) (co_members c)); auto.
+           }
+           rewrite forallb_forall in Hvol. specialize (Hvol  _ (in_map type_member _ _ H1)).
+           pose proof (cenv_legal_su _ _ H). apply (complete_legal_cosu_member _ i t) in H2; auto.
+           eapply fully_nonvolatile_stable; try eassumption.
+           rewrite (co_consistent_rank cenv_cs c (cenv_consistent _ _ H)).        
+           apply (rank_type_members cenv_cs (Member_plain i t) (co_members c)); auto.
 Qed.
 
 Lemma data_at_rec_data_at_rec_ : forall sh t v b ofs
   (LEGAL_COSU: complete_legal_cosu_type t = true),
   0 <= ofs /\ ofs + sizeof t < Ptrofs.modulus ->
   align_compatible_rec cenv_cs t ofs ->
-  data_at_rec sh t v (Vptr b (Ptrofs.repr ofs)) |-- data_at_rec sh t (default_val t) (Vptr b (Ptrofs.repr ofs)).
+  data_at_rec sh t v (Vptr b (Ptrofs.repr ofs)) ⊢ data_at_rec sh t (default_val t) (Vptr b (Ptrofs.repr ofs)).
 Proof.
   intros sh t.
   type_induction t; intros;
@@ -919,15 +904,14 @@ Proof.
     intros.
     rewrite !at_offset_eq3.
     rewrite @default_val_eq with (t := (Tarray t z a)), unfold_fold_reptype.
-    eapply derives_trans.
-    apply IH; auto.
+    rewrite IH; auto.
+    - apply bi.equiv_entails_1_1. f_equiv. unfold Znth, Zrepeat. rewrite if_false by lia.
+      rewrite nth_repeat'; auto.
+      apply Nat2Z.inj_lt. rewrite Z2Nat.id, Z2Nat_id' by lia. lia.
     - pose_size_mult cs t (0 :: i :: i + 1 :: Z.max 0 z :: nil).
        unfold sizeof in H; simpl in H; fold (sizeof t) in H; lia.
     - eapply align_compatible_rec_Tarray_inv; eauto.
       apply range_max0; auto.
-    - apply derives_refl'. f_equal. unfold Znth, Zrepeat. rewrite if_false by lia.
-      rewrite nth_repeat'; auto.
-      apply Nat2Z.inj_lt. rewrite Z2Nat.id, Z2Nat_id' by lia. lia.
   + rewrite !data_at_rec_eq.
     rewrite default_val_eq, unfold_fold_reptype.
     assert (members_no_replicate (co_members (get_co id)) = true) as NO_REPLI
@@ -936,7 +920,7 @@ Proof.
     intros.
     rewrite !withspacer_spacer.
     simpl @fst.
-    apply sepcon_derives; [auto |].
+    apply bi.sep_mono; [auto |].
     rewrite !at_offset_eq3.
     rewrite Forall_forall in IH.
     specialize (IH (get_member i (co_members (get_co id)))).
@@ -957,7 +941,7 @@ Proof.
       apply derives_refl.
     - rewrite data_at_rec_eq.
       rewrite memory_block_data_at_rec_default_val by auto.
-      eapply derives_trans.
+      etrans.
       * assert (members_no_replicate (co_members (get_co id)) = true) as NO_REPLI
           by apply get_co_members_no_replicate.
         apply union_pred_ext_derives with
@@ -973,9 +957,9 @@ Proof.
         pattern (co_sizeof (get_co id)) at 2;
         replace (co_sizeof (get_co id)) with (sizeof (field_type i' (co_members (get_co id))) +
           (co_sizeof (get_co id) - sizeof (field_type i' (co_members (get_co id))))) by lia.
-        rewrite sepcon_comm.
+        rewrite <- bi.sep_comm.
         rewrite memory_block_split by (subst i'; rewrite name_member_get; pose_field; lia).
-        apply sepcon_derives; [| rewrite spacer_memory_block by (simpl; auto);
+        apply bi.sep_mono; [| rewrite spacer_memory_block by (simpl; auto);
                                  unfold offset_val; solve_mod_modulus; auto ].
 
         rewrite <- memory_block_data_at_rec_default_val; auto.
@@ -1000,8 +984,7 @@ Proof.
           eapply align_compatible_rec_Tunion_inv'; eauto.
           subst i'; rewrite name_member_get; auto.    
         }
-      * 
-        rewrite sizeof_Tunion.
+      * rewrite sizeof_Tunion.
         rewrite memory_block_union_pred by (apply get_co_members_nil_sizeof_0).
         auto.
 Qed.
@@ -1009,7 +992,7 @@ Qed.
 Definition value_fits: forall t, reptype t -> Prop :=
   type_func (fun t => reptype t -> Prop)
     (fun t v =>
-       if type_is_volatile t then True else tc_val' t (repinject t v))
+       if type_is_volatile t then True%type else tc_val' t (repinject t v))
     (fun t n a P v => Zlength (unfold_reptype v) =  Z.max 0 n /\ Forall P (unfold_reptype v))
     (fun id a P v => struct_value_fits_aux (co_members (get_co id)) (co_members (get_co id)) P (unfold_reptype v))
     (fun id a P v => union_value_fits_aux (co_members (get_co id)) (co_members (get_co id)) P (unfold_reptype v)).
@@ -1034,7 +1017,7 @@ Lemma value_fits_eq:
         value_fits (field_type (name_member it) (co_members (get_co i)))) (unfold_reptype v0)
   | t0 => fun v0: reptype t0 =>
              (if type_is_volatile t0
-              then True
+              then True%type
               else tc_val' t0 (repinject t0 v0))
   end v.
 Proof.
@@ -1086,7 +1069,7 @@ Proof.
 Qed.
 
 Lemma data_at_rec_value_fits: forall sh t v p,
-  data_at_rec sh t v p |-- !! value_fits t v.
+  data_at_rec sh t v p ⊢ ⌜value_fits t v⌝.
 Proof.
   intros until p.
   revert v p; type_induction t; intros;
@@ -1094,15 +1077,13 @@ Proof.
   try solve [normalize];
   try solve [cbv zeta; simple_if_tac; [normalize | apply mapsto_tc_val']].
   + (* Tarray *)
-    eapply derives_trans; [apply array_pred_local_facts |].
-    - intros.
-      unfold at_offset.
-      instantiate (1 := fun x => value_fits t x); simpl.
-      apply IH.
-    - apply prop_derives.
-      intros [? ?]; split; auto.
+    rewrite array_pred_local_facts.
+    - apply bi.pure_mono.
+      intros [? ?]; split; eauto.
       rewrite Zlength_correct in *.
       lia.
+    - intros. unfold at_offset.
+      apply IH.
   + (* Tstruct *)
     apply struct_pred_local_facts; [apply get_co_members_no_replicate |].
     intros.
@@ -1112,8 +1093,8 @@ Proof.
     rewrite Forall_forall in IH.
     specialize (IH (get_member i (co_members (get_co id)))).
     spec IH; [apply in_get_member; auto |].
-    eapply derives_trans; [apply sepcon_derives; [apply derives_refl | apply IH] |].
-    rewrite sepcon_comm; apply derives_left_sepcon_right_corable; auto.
+    rewrite IH.
+    iIntros "(_ & $)".
   + (* Tunion *)
     apply union_pred_local_facts; [apply get_co_members_no_replicate |].
     intros.
@@ -1123,129 +1104,33 @@ Proof.
     rewrite Forall_forall in IH.
     specialize (IH (get_member i (co_members (get_co id)))).
     spec IH; [apply in_get_member; auto |].
-    eapply derives_trans; [apply sepcon_derives; [apply derives_refl | apply IH] |].
-    rewrite sepcon_comm; apply derives_left_sepcon_right_corable; auto.
-Qed. 
+    rewrite IH.
+    iIntros "(_ & $)".
+Qed.
 
 Lemma mapsto_values_cohere:
   forall sh1 sh2 t (R:type_is_by_value t = true) b ofs,
     type_is_volatile t = false ->
     readable_share sh1 -> readable_share sh2 -> 
   forall (v1 v2:val) (V1: ~ JMeq v1 Vundef) (V2: ~ JMeq v2 Vundef),
-    mapsto sh1 t (Vptr b ofs) v1 * mapsto sh2 t (Vptr b ofs) v2 |-- !!(v1=v2).
+    mapsto sh1 t (Vptr b ofs) v1 ∗ mapsto sh2 t (Vptr b ofs) v2 ⊢ ⌜v1=v2⌝.
 Proof.
-intros; destruct t; try discriminate R; unfold mapsto; simpl; simpl in *.
- + destruct i; destruct s; simpl; rewrite ! if_true by trivial; rewrite H.
-    - eapply derives_trans.
-      { apply sepcon_derives.
-        + apply orp_left; [ apply derives_refl |].
-          apply andp_left1. apply prop_left. intros; subst. elim V1. apply JMeq_refl.
-        + apply orp_left; [ apply derives_refl |].
-          apply andp_left1. apply prop_left. intros; subst. elim V2. apply JMeq_refl. }
-      normalize. rewrite derives_eq.
-      apply res_predicates.address_mapsto_value_cohere.
-    - eapply derives_trans.
-      { apply sepcon_derives.
-        + apply orp_left; [ apply derives_refl |].
-          apply andp_left1. apply prop_left. intros; subst. elim V1. apply JMeq_refl.
-        + apply orp_left; [ apply derives_refl |].
-          apply andp_left1. apply prop_left. intros; subst. elim V2. apply JMeq_refl. }
-      normalize. rewrite derives_eq.
-      apply res_predicates.address_mapsto_value_cohere.
-    - eapply derives_trans.
-      { apply sepcon_derives.
-        + apply orp_left; [ apply derives_refl |].
-          apply andp_left1. apply prop_left. intros; subst. elim V1. apply JMeq_refl.
-        + apply orp_left; [ apply derives_refl |].
-          apply andp_left1. apply prop_left. intros; subst. elim V2. apply JMeq_refl. }
-      normalize. rewrite derives_eq.
-      apply res_predicates.address_mapsto_value_cohere.
-    - eapply derives_trans.
-      { apply sepcon_derives.
-        + apply orp_left; [ apply derives_refl |].
-          apply andp_left1. apply prop_left. intros; subst. elim V1. apply JMeq_refl.
-        + apply orp_left; [ apply derives_refl |].
-          apply andp_left1. apply prop_left. intros; subst. elim V2. apply JMeq_refl. }
-      normalize. rewrite derives_eq.
-      apply res_predicates.address_mapsto_value_cohere.
-    - eapply derives_trans.
-      { apply sepcon_derives.
-        + apply orp_left; [ apply derives_refl |].
-          apply andp_left1. apply prop_left. intros; subst. elim V1. apply JMeq_refl.
-        + apply orp_left; [ apply derives_refl |].
-          apply andp_left1. apply prop_left. intros; subst. elim V2. apply JMeq_refl. }
-      normalize. rewrite derives_eq.
-      apply res_predicates.address_mapsto_value_cohere.
-    - eapply derives_trans.
-      { apply sepcon_derives.
-        + apply orp_left; [ apply derives_refl |].
-          apply andp_left1. apply prop_left. intros; subst. elim V1. apply JMeq_refl.
-        + apply orp_left; [ apply derives_refl |].
-          apply andp_left1. apply prop_left. intros; subst. elim V2. apply JMeq_refl. }
-      normalize. rewrite derives_eq.
-      apply res_predicates.address_mapsto_value_cohere.
-    - eapply derives_trans.
-      { apply sepcon_derives.
-        + apply orp_left; [ apply derives_refl |].
-          apply andp_left1. apply prop_left. intros; subst. elim V1. apply JMeq_refl.
-        + apply orp_left; [ apply derives_refl |].
-          apply andp_left1. apply prop_left. intros; subst. elim V2. apply JMeq_refl. }
-      normalize. rewrite derives_eq.
-      apply res_predicates.address_mapsto_value_cohere.
-    - eapply derives_trans.
-      { apply sepcon_derives.
-        + apply orp_left; [ apply derives_refl |].
-          apply andp_left1. apply prop_left. intros; subst. elim V1. apply JMeq_refl.
-        + apply orp_left; [ apply derives_refl |].
-          apply andp_left1. apply prop_left. intros; subst. elim V2. apply JMeq_refl. }
-      normalize. rewrite derives_eq.
-      apply res_predicates.address_mapsto_value_cohere.
-  + rewrite H; clear R. rewrite ! if_true by trivial.
-    - eapply derives_trans.
-      { apply sepcon_derives.
-        + apply orp_left; [ apply derives_refl |].
-          apply andp_left1. apply prop_left. intros; subst. elim V1. apply JMeq_refl.
-        + apply orp_left; [ apply derives_refl |].
-          apply andp_left1. apply prop_left. intros; subst. elim V2. apply JMeq_refl. }
-      normalize. rewrite derives_eq.
-      apply res_predicates.address_mapsto_value_cohere.
-  + rewrite H; clear R. destruct f; rewrite ! if_true by trivial.
-    - eapply derives_trans.
-      { apply sepcon_derives.
-        + apply orp_left; [ apply derives_refl |].
-          apply andp_left1. apply prop_left. intros; subst. elim V1. apply JMeq_refl.
-        + apply orp_left; [ apply derives_refl |].
-          apply andp_left1. apply prop_left. intros; subst. elim V2. apply JMeq_refl. }
-      normalize. rewrite derives_eq.
-      apply res_predicates.address_mapsto_value_cohere.
-    - eapply derives_trans.
-      { apply sepcon_derives.
-        + apply orp_left; [ apply derives_refl |].
-          apply andp_left1. apply prop_left. intros; subst. elim V1. apply JMeq_refl.
-        + apply orp_left; [ apply derives_refl |].
-          apply andp_left1. apply prop_left. intros; subst. elim V2. apply JMeq_refl. }
-      normalize. rewrite derives_eq.
-      apply res_predicates.address_mapsto_value_cohere.
-  + rewrite H; clear R. rewrite ! if_true by trivial.
-    - eapply derives_trans.
-      { apply sepcon_derives.
-        + apply orp_left; [ apply derives_refl |].
-          apply andp_left1. apply prop_left. intros; subst. elim V1. apply JMeq_refl.
-        + apply orp_left; [ apply derives_refl |].
-          apply andp_left1. apply prop_left. intros; subst. elim V2. apply JMeq_refl. }
-      normalize. rewrite derives_eq.
-      apply res_predicates.address_mapsto_value_cohere.
+  intros; unfold mapsto.
+  apply access_mode_by_value in R as (? & ->).
+  rewrite H, !if_true by trivial.
+  iIntros "([(_ & H1) | (-> & % & H1)] & [(_ & H2) | (-> & % & H2)])"; try solve [exfalso; pose proof (JMeq_refl Vundef); done];
+    iApply res_predicates.address_mapsto_value_cohere; iFrame.
 Qed.
 
-Definition value_defined_byvalue t v :=
-if type_is_volatile t then False else tc_val t (repinject t v).
+Definition value_defined_byvalue t v : Prop :=
+if type_is_volatile t then False%type else tc_val t (repinject t v).
 
 Definition value_defined : forall t, reptype t -> Prop :=
   type_func (fun t => reptype t -> Prop)
     value_defined_byvalue
     (fun t n a P v => Zlength (unfold_reptype v) =  Z.max 0 n /\ Forall P (unfold_reptype v))
     (fun id a P v => struct_value_fits_aux (co_members (get_co id)) (co_members (get_co id)) P (unfold_reptype v))
-    (fun id a P v => False). (* don't permit unions, for now ; otherwise: 
+    (fun id a P v => False%type). (* don't permit unions, for now ; otherwise: 
                  union_value_fits_aux (co_members (get_co id)) (co_members (get_co id)) P (unfold_reptype v))
 *)
 
@@ -1264,7 +1149,7 @@ Lemma value_defined_eq:
         value_defined (field_type (name_member it) (co_members (get_co i)))) (unfold_reptype v0)
 | Tunion i a =>
     fun v0 : reptype (Tunion i a) =>
-     False (*
+     False%type (*
      union_Prop (co_members (get_co i))
        (fun it : member =>
         value_defined (field_type (name_member it) (co_members (get_co i)))) (unfold_reptype v0)
@@ -1315,9 +1200,9 @@ Local Definition field_cohere sh1 sh2
         data_at_rec sh1
           (field_type (name_member it) m) v1
           (Vptr b ofs)
-          * data_at_rec sh2
+          ∗ data_at_rec sh2
               (field_type (name_member it) m) v2
-              (Vptr b ofs) |-- !! (v1 = v2).
+              (Vptr b ofs) ⊢ ⌜v1 = v2⌝.
 
 Lemma data_at_rec_values_cohere:
        forall (sh1 sh2 : share) (t : type),
@@ -1328,8 +1213,8 @@ Lemma data_at_rec_values_cohere:
        value_defined t v1 ->
        value_defined t v2 ->
        data_at_rec sh1 t v1 (Vptr b ofs)
-         * data_at_rec sh2 t v2 (Vptr b ofs) 
-        |-- !! (v1 = v2).
+         ∗ data_at_rec sh2 t v2 (Vptr b ofs) 
+        ⊢ ⌜v1 = v2⌝.
 Proof.
   intros *. pose proof I. intros.
   clear H. pose proof (value_defined_not_volatile _ _ H2).
@@ -1354,7 +1239,7 @@ change (Forall (value_defined t) (unfold_reptype v2)) in H5.
 unfold array_pred.
 destruct (zle z 0).
 rewrite Z.max_l in * by lia.
-apply prop_right.
+apply bi.pure_intro.
 rewrite Zlength_length in H2,H3 by lia.
 destruct v1; inv H2. destruct v2; inv H3. auto.
 rewrite Z.max_r in * by lia.
@@ -1375,7 +1260,7 @@ assert (type_is_volatile t = false). {
 clear g.
 change (list (reptype t)) in v1,v2.
 revert v1 v2 H5 H3 H4 H2; induction n; intros.
-apply prop_right.
+apply bi.pure_intro.
 clear - H3 H2.
 rewrite Zlength_length in H2,H3 by lia.
 destruct v1; inv H2. destruct v2; inv H3. auto.
@@ -1385,23 +1270,12 @@ rewrite !Z.sub_0_r.
 rewrite !(sublist_one (Z.of_nat n)) by lia.
 unfold Z.succ.
 rewrite !array_pred_len_1.
-match goal with |- (?a*?b)*(?c*?d) |-- _ =>
-    apply derives_trans with ((a*c)*(b*d)); [ cancel | ] end.
-apply derives_trans 
-  with (!! (sublist 0 (Z.of_nat n) v1 = sublist 0 (Z.of_nat n) v2) 
-           * !! (Znth (Z.of_nat n) v1 = Znth (Z.of_nat n) v2)).
-apply sepcon_derives.
-apply IHn.
-apply Forall_sublist; auto.
-Zlength_solve.
-apply Forall_sublist; auto.
-Zlength_solve.
+match goal with |- (?a∗?b)∗(?c∗?d) ⊢ _ =>
+    trans ((a∗c)∗(b∗d)); [ cancel | ] end.
+rewrite IHn; [| apply Forall_sublist; auto | Zlength_solve | apply Forall_sublist; auto | Zlength_solve].
 unfold at_offset.
-apply IH; auto.
-apply Forall_Znth; auto; lia.
-apply Forall_Znth; auto; lia.
-rewrite sepcon_prop_prop.
-apply prop_derives; intros [? ?].
+setoid_rewrite IH; auto; [| apply Forall_Znth; auto; lia..].
+iIntros "(%H6 & %H7)"; iPureIntro.
 replace v1 with (sublist 0 (Z.of_nat n) v1 ++ (Znth (Z.of_nat n) v1 :: nil)).
 replace v2 with (sublist 0 (Z.of_nat n) v2 ++ (Znth (Z.of_nat n) v2 :: nil)).
 rewrite H6,H7; auto.
@@ -1414,21 +1288,20 @@ apply sublist_same; lia.
 -
 cbv zeta in IH.
 clear H.
-change (type_func _ _ _ _ _ ) with value_defined in *.
+change (type_func _ _ _ _ _) with value_defined in *.
 unfold aggregate_pred.struct_pred.
 rewrite value_defined_eq in H2, H3.
 cbv zeta in IH.
 fold (field_atx sh1 (co_members (get_co id)) (co_sizeof (get_co id))).
 fold (field_atx sh2 (co_members (get_co id)) (co_sizeof (get_co id))).
 fold (field_cohere sh1 sh2 (co_members (get_co id)) b) in IH.
-eapply derives_trans with (!! (unfold_reptype v1 = unfold_reptype v2)).
-2:{  clear. 
-       apply prop_derives; intro.
-       unfold reptype, unfold_reptype in *.
-       unfold eq_rect in *.
-        destruct (reptype_eq (Tstruct id a)).
-         auto.
-}
+trans (⌜unfold_reptype v1 = unfold_reptype v2⌝ : mpred).
+2:{ clear.
+    apply bi.pure_mono; intro.
+    unfold reptype, unfold_reptype in *.
+    unfold eq_rect in *.
+    destruct (reptype_eq (Tstruct id a)).
+    auto. }
 set (u1 := unfold_reptype v1) in *.
 set (u2 := unfold_reptype v2) in *.
 clearbody u1. clearbody u2.
@@ -1461,12 +1334,12 @@ forall sh1 sh2 b m0 m
           | Errors.Error _ => Tvoid
           end) u2),
 struct_pred m (field_atx sh1 m0 sz) u1 (Vptr b ofs)
-  * struct_pred m (field_atx sh2 m0 sz) u2 (Vptr b ofs) |-- !! (u1 = u2)).
+  ∗ struct_pred m (field_atx sh2 m0 sz) u2 (Vptr b ofs) ⊢ ⌜u1 = u2⌝).
 2: eauto.
 clear.
 intros.
 destruct m as [ | a0 m].
-apply prop_right; destruct u1,u2; auto.
+apply bi.pure_intro; destruct u1,u2; auto.
 revert a0 IH u1 u2 H2 H3.
 induction m as [ | a1 m]; intros.
 +
@@ -1486,12 +1359,11 @@ specialize  (H1 u1 u2 ofs'
 clear - H1.
 set (y1 := data_at_rec sh1 _ _ _) in *.
 set (y2 := data_at_rec sh2 _ _ _) in *.
-apply derives_trans with ((y1*y2)*(x1*x2)). cancel.
-eapply derives_trans. apply sepcon_derives. apply H1. apply TT_right.
-rewrite prop_sepcon. Intros. apply prop_right; auto.
+trans ((y1∗y2)∗(x1∗x2)). cancel.
+rewrite H1. iIntros "($ & _)".
 +
 repeat change (struct_pred (a0 :: a1 :: m) ?P ?u ?p)
-      with (P a0 (fst u) p * struct_pred (a1 :: m) P (snd u) p).
+      with (P a0 (fst u) p ∗ struct_pred (a1 :: m) P (snd u) p).
 inv IH.
 specialize (IHm _ H4).
 destruct u1 as [v1 u1], u2 as [v2 u2].
@@ -1499,11 +1371,11 @@ destruct H2 as [H2v H2], H3 as [H3v H3].
 specialize (IHm u1 u2 H2 H3).
 clear H2 H3.
 unfold snd. unfold fst.
-match goal with |- ?a * ?b * (?c * ?d) |-- _ => 
-   apply derives_trans with ((a*c)*(b*d)); [cancel | ]
+match goal with |- (?a ∗ ?b) ∗ (?c ∗ ?d) ⊢ _ =>
+   trans ((a∗c)∗(b∗d)); [cancel | ]
 end.
-apply derives_trans with (!!(v1=v2) * !!(u1=u2)).
-apply sepcon_derives; auto.
+trans (⌜v1=v2⌝ ∗ ⌜u1=u2⌝ : mpred); last by iIntros "(-> & ->)".
+apply bi.sep_mono; auto.
 unfold field_atx.
 rewrite !withspacer_spacer.
 rewrite !spacer_memory_block by (simpl; auto).
@@ -1511,24 +1383,18 @@ set (x1 := memory_block sh1 _ _).
 set (x2 := memory_block sh2 _ _).
 clearbody x1 x2.
 unfold at_offset, offset_val.
-set (ofs' := Ptrofs.add _ _). clearbody ofs'. 
+set (ofs' := Ptrofs.add _ _). clearbody ofs'.
 specialize (H1 v1 v2 ofs').
-match goal with |- ?a * ?b * (?c * ?d) |-- _ => 
-   apply derives_trans with ((a*c)*(b*d)); [cancel | ]
+match goal with |- (?a ∗ ?b) ∗ (?c ∗ ?d) ⊢ _ => 
+   trans ((a∗c)∗(b∗d)); [cancel | ]
 end.
-apply derives_trans with (TT * !!(v1=v2)).
-apply sepcon_derives; auto.
-apply H1; auto.
+rewrite H1; auto.
+iIntros "(_ & $)".
 eapply value_defined_not_volatile; eauto.
-rewrite (sepcon_comm TT), prop_sepcon.
-normalize.
-rewrite prop_sepcon.
-rewrite (sepcon_comm TT), prop_sepcon.
-normalize.
 -
 cbv zeta in IH.
 clear H.
-change (type_func _ _ _ _ _ ) with value_defined in *.
+change (type_func _ _ _ _ _) with value_defined in *.
 unfold aggregate_pred.union_pred.
 rewrite value_defined_eq in H2, H3.
 contradiction.
@@ -1537,15 +1403,14 @@ Qed.
 Lemma data_at_rec_share_join:
   forall sh1 sh2 sh t v b ofs,
     sepalg.join sh1 sh2 sh ->
-   data_at_rec sh1 t v (Vptr b ofs) * data_at_rec sh2 t v (Vptr b ofs) = data_at_rec sh t v (Vptr b ofs).
+   data_at_rec sh1 t v (Vptr b ofs) ∗ data_at_rec sh2 t v (Vptr b ofs) ⊣⊢ data_at_rec sh t v (Vptr b ofs).
 Proof.
   intros.
   revert v ofs; pattern t; type_induction t; intros;
   rewrite !data_at_rec_eq;
     try solve [simple_if_tac;
         [ apply memory_block_share_join; auto
-        | apply mapsto_share_join; auto]];
-    try solve [normalize].
+        | apply mapsto_share_join; auto]]; try apply bi.sep_False.
   + (* Tarray *)
     rewrite array_pred_sepcon.
     apply array_pred_ext; auto.
@@ -1561,22 +1426,22 @@ Opaque field_type field_offset.
 Transparent field_type field_offset.
     rewrite !withspacer_spacer.
     rewrite !spacer_memory_block by (simpl; auto).
-    rewrite !sepcon_assoc, (sepcon_comm (at_offset _ _ _)), <- !sepcon_assoc.
+    match goal with |- (?a∗?b)∗(?c∗?d) ⊣⊢ _ =>
+      trans ((a∗c)∗(b∗d)); [ apply bi.equiv_entails_2; cancel | ] end.
     erewrite memory_block_share_join by eassumption.
-    rewrite sepcon_assoc; f_equal.
+    apply bi.sep_proper; first done.
     unfold at_offset.
     cbv zeta in IH.
     rewrite Forall_forall in IH.
-    pose proof H0.
-    rewrite sepcon_comm.
     etransitivity.
-   apply (IH (get_member i (co_members (get_co id)))).
-   apply in_get_member; auto.
-    f_equal.
+    apply (IH (get_member i (co_members (get_co id)))).
+    apply in_get_member; auto.
+    f_equiv; last done.
     apply JMeq_eq.
     apply (@proj_compact_prod_JMeq _ _ _ (fun it => reptype (field_type (name_member it) (co_members (get_co id)))) (fun it => reptype (field_type (name_member it) (co_members (get_co id))))); auto.
     apply in_get_member; auto.
-  + rewrite union_pred_sepcon.
+  + (* Tunion *)
+    rewrite union_pred_sepcon.
     apply union_pred_ext; [apply get_co_members_no_replicate | reflexivity | ].
     intros.
 Opaque field_type field_offset.
@@ -1584,20 +1449,20 @@ Opaque field_type field_offset.
 Transparent field_type field_offset.
     rewrite !withspacer_spacer.
     rewrite !spacer_memory_block by (simpl; auto).
-    rewrite !sepcon_assoc, (sepcon_comm (data_at_rec _ _ _ _)), <- !sepcon_assoc.
+    match goal with |- (?a∗?b)∗(?c∗?d) ⊣⊢ _ =>
+      trans ((a∗c)∗(b∗d)); [ apply bi.equiv_entails_2; cancel | ] end.
     erewrite memory_block_share_join by eassumption.
-    rewrite sepcon_assoc; f_equal.
+    apply bi.sep_proper; first done.
     unfold at_offset.
     cbv zeta in IH.
     rewrite Forall_forall in IH.
     apply compact_sum_inj_in in H1.
-    rewrite sepcon_comm.
-    etransitivity.
-   apply (IH (get_member i (co_members (get_co id)))); auto.
-    f_equal.
+    rewrite IH; auto.
+    f_equiv.
     apply JMeq_eq.
     apply (@proj_compact_sum_JMeq _ _ _ (fun it => reptype (field_type (name_member it) (co_members (get_co id)))) (fun it => reptype (field_type (name_member it) (co_members (get_co id))))); auto.
 Qed.
+
 Lemma nonreadable_memory_block_data_at_rec:
   forall sh t v b ofs
   (LEGAL_COSU: complete_legal_cosu_type t = true),
@@ -1605,7 +1470,7 @@ Lemma nonreadable_memory_block_data_at_rec:
   align_compatible_rec cenv_cs t ofs ->
   ~ readable_share sh ->
   value_fits t v ->
-  memory_block sh (sizeof t) (Vptr b (Ptrofs.repr ofs)) = data_at_rec sh t v (Vptr b (Ptrofs.repr ofs)).
+  memory_block sh (sizeof t) (Vptr b (Ptrofs.repr ofs)) ⊣⊢ data_at_rec sh t v (Vptr b (Ptrofs.repr ofs)).
 Proof.
   intros.
   symmetry.
@@ -1616,7 +1481,7 @@ Proof.
     try match type of H2 with
         | context [type_is_volatile ?t] =>
             destruct (type_is_volatile t) eqn:?;
-             [apply by_value_data_at_rec_volatile | apply by_value_data_at_rec_nonreachable2]; auto
+             [rewrite by_value_data_at_rec_volatile | apply by_value_data_at_rec_nonreachable2]; auto
         end;
     rewrite !data_at_rec_eq.
   + simpl in H, H0.
@@ -1687,18 +1552,17 @@ Proof.
       spec IH; [apply in_get_member; auto |].
       apply struct_Prop_proj with (i := i) (d:= d0) in H2; auto.
       rewrite IH; auto.
-      * 
-      rewrite name_member_get in *.
-       rewrite Z.add_assoc, sepcon_comm.
-       rewrite <- memory_block_split by (pose_field; lia).
-        f_equal; lia.
       * rewrite name_member_get in *.
-         apply complete_legal_cosu_type_field_type; auto.
-          eapply complete_Tstruct_plain; apply LEGAL_COSU. 
-      * rewrite name_member_get in *; 
-         simpl fst. pose_field; lia.
-      * rewrite name_member_get in *; 
-         eapply align_compatible_rec_Tstruct_inv'; eauto.
+        rewrite Z.add_assoc, <- bi.sep_comm.
+        rewrite <- memory_block_split by (pose_field; lia).
+        f_equiv; hnf; lia.
+      * rewrite name_member_get in *.
+        apply complete_legal_cosu_type_field_type; auto.
+         eapply complete_Tstruct_plain; apply LEGAL_COSU.
+      * rewrite name_member_get in *;
+          simpl fst. pose_field; lia.
+      * rewrite name_member_get in *;
+          eapply align_compatible_rec_Tstruct_inv'; eauto.
   + assert (co_members (get_co id) = nil \/ co_members (get_co id) <> nil)
       by (clear; destruct (co_members (get_co id)); [left | right]; congruence).
        clear H4. pose proof I.
@@ -1734,8 +1598,8 @@ Proof.
         spec IH; [apply in_get_member; auto |].
         apply union_Prop_proj with (i := i) (d := d0) in H2; auto.
         rewrite IH; auto; rewrite ?name_member_get in *.
-        { rewrite sepcon_comm, <- memory_block_split by (pose_field; lia).
-          f_equal; f_equal; lia.
+        { rewrite <- bi.sep_comm, <- memory_block_split by (pose_field; lia).
+          f_equiv; hnf; f_equal; lia.
         } {
           apply complete_legal_cosu_type_field_type; auto.
           eapply complete_Tunion_plain; apply LEGAL_COSU. 
@@ -1748,10 +1612,10 @@ Qed.
 
 End CENV.
 
-Lemma data_at_rec_change_composite {cs_from cs_to} {CCE: change_composite_env cs_from cs_to}: forall (sh: Share.t) (t: type) v1 v2,
+Lemma data_at_rec_change_composite `{!heapGS Σ} {cs_from cs_to} {CCE: change_composite_env cs_from cs_to}: forall (sh: Share.t) (t: type) v1 v2 p,
   JMeq v1 v2 ->
   cs_preserve_type cs_from cs_to (coeq _ _) t = true ->
-  @data_at_rec cs_from sh t v1 = @data_at_rec cs_to sh t v2.
+  data_at_rec (cs := cs_from) sh t v1 p ⊣⊢ data_at_rec (cs := cs_to) sh t v2 p.
 Proof.
   intros sh t.
   type_induction t; intros.
@@ -1774,7 +1638,6 @@ Proof.
     subst; auto.
   + (* Tarray *)
     rewrite !data_at_rec_eq.
-    extensionality p.
     assert (JMeq (unfold_reptype v1) (unfold_reptype v2)).
     {
       eapply JMeq_trans; [| eapply JMeq_trans; [exact H |]].
@@ -1784,20 +1647,19 @@ Proof.
     apply array_pred_ext.
     - apply list_func_JMeq; [apply reptype_change_composite; auto | auto].
     - intros.
+      unfold at_offset.
       rewrite (IH (Znth (i - 0) (unfold_reptype v1)) (Znth (i - 0) (unfold_reptype v2))); auto.
-      * f_equal.
-        f_equal.
+      * do 3 f_equiv.
         apply sizeof_change_composite; auto.
-      *
-        pose (Znthx (A: Type) (i: Z) (al: list A) (d: A) := @Znth A d i al).
+      * pose (Znthx (A: Type) (i: Z) (al: list A) (d: A) := @Znth A d i al).
         change  (@Znth (@reptype cs_from t) (@Inhabitant_reptype cs_from t) (i - 0)
                                      (@unfold_reptype cs_from (Tarray t z a) v1))
-       with (Znthx (@reptype cs_from t) (i-0) (@unfold_reptype cs_from (Tarray t z a) v1)(@Inhabitant_reptype cs_from t)).
+          with (Znthx (@reptype cs_from t) (i-0) (@unfold_reptype cs_from (Tarray t z a) v1)(@Inhabitant_reptype cs_from t)).
         change  (@Znth (@reptype cs_to t) (@Inhabitant_reptype cs_to t) (i - 0)
                                      (@unfold_reptype cs_to (Tarray t z a) v2))
-       with (Znthx (@reptype cs_to t) (i-0) (@unfold_reptype cs_to (Tarray t z a) v2)(@Inhabitant_reptype cs_to t)).
-       change (@Znthx (@reptype cs_from t) (i - 0)) 
-     with ((fun X: Type => @Znthx X (i - 0)) (@reptype cs_from t)).
+          with (Znthx (@reptype cs_to t) (i-0) (@unfold_reptype cs_to (Tarray t z a) v2)(@Inhabitant_reptype cs_to t)).
+        change (@Znthx (@reptype cs_from t) (i - 0)) 
+          with ((fun X: Type => @Znthx X (i - 0)) (@reptype cs_from t)).
         change (@Znthx (@reptype cs_to t) (i - 0)) 
           with ((fun X: Type => @Znthx X (i - 0)) (@reptype cs_to t)).
       apply @list_func_JMeq'; auto.
@@ -1806,7 +1668,6 @@ Proof.
     auto.
   + (* Tstruct *)
     rewrite !data_at_rec_eq.
-    extensionality p.
     assert (JMeq (unfold_reptype v1) (unfold_reptype v2)).
     {
       eapply JMeq_trans; [| eapply JMeq_trans; [exact H |]].
@@ -1830,25 +1691,25 @@ Proof.
     forget (co_members (@get_co cs_to id)) as m.
     apply struct_pred_ext; [assumption |].
     intros.
-    f_equal; [f_equal | | f_equal ]; auto.
+    f_equiv; [f_equiv | |]; try by hnf.
     - apply sizeof_change_composite; auto.
       rewrite Forall_forall in H0.
       apply H0. apply in_get_member; auto.
-    - clear HH0 HH1.
+    - rewrite HH0; clear HH0 HH1.
       pose proof in_get_member _ _ H.
       rewrite Forall_forall in IH, H0.
       specialize (IH _ H2); pose proof (H0 _ H2).
+      unfold at_offset; intros ?.
       apply IH; auto.
       apply (@proj_struct_JMeq i m
           (fun it : member => @reptype cs_from (field_type (name_member it) m)) 
           (fun it : member => @reptype cs_to (field_type (name_member it) m))); auto.
-      intros. 
+      intros.
       rewrite reptype_change_composite; [reflexivity |].
       apply H0.
        apply in_get_member; auto.
   + (* Tunion *)
     rewrite !data_at_rec_eq.
-    extensionality p.
     assert (JMeq (unfold_reptype v1) (unfold_reptype v2)).
     {
       eapply JMeq_trans; [| eapply JMeq_trans; [exact H |]].
@@ -1879,19 +1740,19 @@ Proof.
       apply H0; auto.
     }
     intros.
-    f_equal.
+    f_equiv.
     - apply sizeof_change_composite; auto.
       rewrite Forall_forall in H0.
       apply H0.
       apply compact_sum_inj_in in H.
       auto.
-    - auto. 
+    - auto.
     - unfold reptype_unionlist.
       apply compact_sum_inj_in in H2.
       rewrite Forall_forall in IH, H0.
       specialize (IH _ H2); pose proof (H0 _ H2).
-      apply IH; auto.
-      apply (@proj_union_JMeq i _ 
+      intros ?; apply IH; auto.
+      apply (@proj_union_JMeq i _
           (fun it : member => @reptype cs_from (field_type (name_member it) m)) 
           (fun it : member => @reptype cs_to (field_type (name_member it) m))); auto.
       intros.
@@ -1907,7 +1768,7 @@ Lemma value_fits_Tstruct:
   t = Tstruct i a ->
   m = co_members (get_co i)  ->
   JMeq (@unfold_reptype cs t v) v2 ->
-  r =struct_Prop m
+  r = struct_Prop m
           (fun it => value_fits (field_type (name_member it) m))  v2 ->
   value_fits t v = r.
 Proof.
@@ -1939,7 +1800,7 @@ Lemma value_fits_by_value_defined:
    type_is_by_value t = true ->
    repinject t v <> Vundef  ->
    t = t' ->
-   (r = if type_is_volatile t' then True
+   (r = if type_is_volatile t' then True%type
        else tc_val t' (repinject t v)) ->
    value_fits t v = r.
 Proof.
@@ -1954,7 +1815,7 @@ Lemma value_fits_by_value_Vundef:
   forall {cs: compspecs} t v,
    type_is_by_value t = true ->
    repinject t v = Vundef  ->
-   value_fits t v = True.
+   value_fits t v = True%type.
 Proof.
 intros.
 rewrite value_fits_eq.
@@ -1967,7 +1828,7 @@ Lemma value_fits_by_value:
   forall {cs: compspecs} t t' v r,
    type_is_by_value t = true ->
    t = t' ->
-   (r = if type_is_volatile t then True
+   (r = if type_is_volatile t then True%type
        else tc_val' t' (repinject t v)) ->
    value_fits t v = r.
 Proof.
@@ -1985,7 +1846,7 @@ Lemma value_fits_Tarray:
   JMeq (unfold_reptype v) v' ->
   n >= 0 ->
   r = (Zlength v' = n /\ Forall (value_fits t') v') ->
-  value_fits t v =r.
+  value_fits t v = r.
 Proof.
 intros.
 subst. rewrite value_fits_eq.
@@ -2067,4 +1928,3 @@ split; auto.
 subst.
 unfold unfold_reptype. simpl. rep_lia.
 Qed.
-
diff --git a/floyd/deadvars.v b/floyd/deadvars.v
index c9683e4973..328c60d966 100644
--- a/floyd/deadvars.v
+++ b/floyd/deadvars.v
@@ -1,4 +1,6 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.semax_tactics.
 Import ListNotations.
@@ -215,16 +217,16 @@ Ltac locals_of_assert P :=
  lazymatch P with
  | (PROPx _ (LOCALx ?Q _)) => constr:(temps_of_localdefs Q)
  | emp => constr:(@nil ident)
- | andp ?A ?B => let a := locals_of_assert A in
+ | bi_and ?A ?B => let a := locals_of_assert A in
                   let b := locals_of_assert B in
                   constr:(a++b)
- | sepcon ?A ?B => let a := locals_of_assert A in
+ | bi_sep ?A ?B => let a := locals_of_assert A in
                   let b := locals_of_assert B in
                   constr:(a++b)
- | @stackframe_of _ _ => constr:(@nil ident)
+ | @stackframe_of _ _ _ _ => constr:(@nil ident)
  | local (liftx (eq _) (eval_expr ?E)) =>
             let vl := constr:(expr_temps E nil) in vl
- | @exp _ _ ?T ?F =>
+ | @bi_exist _ ?T ?F =>
     let x := inhabited_value T in
      let d := constr:(F x) in
       let d := eval cbv beta in d in        let d := locals_of_assert d in
@@ -265,7 +267,7 @@ Ltac find_dead_vars P c Q :=
 Ltac deadvars :=
  lazymatch goal with
  | X := @abbreviate ret_assert ?Q |-
-    semax _ ?P ?c ?Y =>
+    semax _ _ ?P ?c ?Y =>
     check_POSTCONDITION;
     tryif constr_eq X Y then idtac else fail 99 "@abbreviate ret_assert above the line does not match postcondition";
     match find_dead_vars P c Q with
@@ -275,25 +277,25 @@ Ltac deadvars :=
  | |- semax _ _ _ _ => 
        check_POSTCONDITION;
        fail "deadvars: Postcondition must be an abbreviated local definition (POSTCONDITION); try abbreviate_semax first"
- | |- _ |-- _ => idtac
+ | |- _ ⊢ _ => idtac
  | |- _ => fail "deadvars: the proof goal should be a semax"
  end.
 
 Tactic Notation "deadvars" "!" :=
   lazymatch goal with
-  | |- semax _ _ _ _ => idtac
+  | |- semax _ _ _ _ _ => idtac
   | |- _ => fail "deadvars!: the proof goal should be a semax"
   end;
  lazymatch goal with
  | X := @abbreviate ret_assert ?Q |-
-    semax _ ?P ?c ?Y =>
+    semax _ _ ?P ?c ?Y =>
+   check_POSTCONDITION;
     tryif constr_eq X Y then idtac
     else fail "deadvars!: Postcondition must be an abbreviated local definition (POSTCONDITION); try abbreviate_semax first";
     lazymatch find_dead_vars P c Q with
     | nil => fail "deadvars!: Did not find any dead variables"
     | ?d =>  drop_LOCALs d
      end
- | |- semax _ _ _ _ => 
-       fail "deadvars!: Postcondition must be an abbreviated local definition (POSTCONDITION); try abbreviate_semax first"
+ | |- semax _ _ _ _ _ => 
+       fail 1 "deadvars!: Postcondition must be an abbreviated local definition (POSTCONDITION); try abbreviate_semax first"
  end.
-
diff --git a/floyd/diagnosis.v b/floyd/diagnosis.v
index 4bcb7a4662..380f033222 100644
--- a/floyd/diagnosis.v
+++ b/floyd/diagnosis.v
@@ -1,22 +1,24 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.reptype_lemmas.
-Import compcert.lib.Maps.
+Import -(notations) compcert.lib.Maps.
 
-Local Open Scope logic.
+Section DIAGNOSIS.
+Context `{!heapGS Σ}.
 
 Lemma no_post_exists_unit:
   forall P Q R,
-  PROPx P (LOCALx Q (SEPx R)) =
-   EX _:unit, PROPx P (LOCALx Q (SEPx R)).
+  PROPx P (LOCALx Q (SEPx R)) ⊣⊢
+   ∃ _:unit, PROPx P (LOCALx Q (SEPx R)).
 Proof.
-intros.
-apply pred_ext.
-apply exp_right with tt; auto.
-apply exp_left; auto.
+intros. iSplit; iIntros "H". iFrame. done.
+iApply bi.exist_elim. intros. apply derives_refl. done.
 Qed.
 
 Inductive Stuck : Prop := .
+End DIAGNOSIS.
 
 Ltac stuckwith p := cut Stuck; [intros []|]; fold p.
 
@@ -25,6 +27,8 @@ Ltac test_stuck :=
  | |- ?G => unify G Stuck
  end.
 
+Section DIAGNOSIS.
+Context `{!heapGS Σ}.
 Definition not_in_canonical_form := tt.
 Definition Error__Funspec (id: ident) (what: unit) (reason: unit) := Stuck.
 Definition Cannot_unfold_funspec (fs: ident*funspec) := Stuck.
@@ -35,6 +39,7 @@ Definition because_temp_out_of_scope (i: ident) := tt.
 Definition because_Precondition_not_canonical (R: environ->mpred) := tt.
 Definition because_Postcondition_not_canonical (R: environ->mpred) := tt.
 Definition WITH_clause_should_avoid_using_reptype_otherwise_Coq_is_way_too_slow := tt.
+End DIAGNOSIS.
 
 Ltac ccf_PROP id0 P := idtac.
 
@@ -91,10 +96,10 @@ Ltac ccf2 id0 argsig retsig A Pre Post :=
   exfalso;
   revert xPost; try rewrite no_post_exists_unit;
   repeat match goal with
-  |- let _ := (EX _:_, EX _:_, _) in _ => rewrite exp_uncurry
+  |- let _ := (∃ _:_, ∃ _:_, _) in _ => rewrite exp_uncurry
   end;
   match goal with
-  | |- let _ := @exp _ _ ?B ?p in _ =>
+  | |- let _ := @bi_exist _ _ ?B ?p in _ =>
     let w := fresh "w" in
     assert (w:B) by (exfalso; apply F);
     intro xPost; clear xPost;
@@ -157,7 +162,7 @@ Tactic Notation "errormsg" simple_intropattern(message) constr(arg) :=
 Ltac check_canonical_call' Delta c :=
 match c with
 | Scall _ (Evar ?id _) _ =>
-  let x := constr:((glob_specs Delta) ! id) in
+  let x := constr:((glob_specs Delta) !! id) in
     let y := (eval simpl in x) in
     match y with
     | Some ?fs => check_canonical_funspec fs
@@ -168,6 +173,6 @@ match c with
 end.
 
 Ltac check_canonical_call :=
-match goal with |- semax ?Delta _ ?c _ =>
+match goal with |- semax _ ?Delta _ ?c _ =>
    check_canonical_call' Delta c
 end.
diff --git a/floyd/efield_lemmas.v b/floyd/efield_lemmas.v
index 145ce4c753..40038cac1a 100644
--- a/floyd/efield_lemmas.v
+++ b/floyd/efield_lemmas.v
@@ -1,11 +1,13 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.nested_pred_lemmas.
 Require Import VST.floyd.nested_field_lemmas.
 Require Import VST.floyd.fieldlist.
 Import LiftNotation.
-Import compcert.lib.Maps.
-Local Open Scope logic.
+Import -(notations) compcert.lib.Maps.
+(* Local Open Scope logic. *)
 
 Inductive efield : Type :=
   | eArraySubsc: forall i: expr, efield
@@ -14,7 +16,7 @@ Inductive efield : Type :=
 
 Section CENV.
 
-Context {cs: compspecs}.
+Context `{!VSTGS OK_ty Σ} {cs: compspecs}.
 
 Fixpoint nested_efield (e: expr) (efs: list efield) (tts: list type) : expr :=
   match efs, tts with
@@ -73,7 +75,7 @@ Fixpoint typecheck_efield {cs: compspecs} (Delta: tycontext) (efs: list efield)
     typecheck_efield Delta efs'
   end.
 
-Definition tc_efield {cs: compspecs} (Delta: tycontext) (efs: list efield) : environ -> mpred := denote_tc_assert (typecheck_efield Delta efs).
+Definition tc_efield {cs: compspecs} (Delta: tycontext) (efs: list efield) := denote_tc_assert (typecheck_efield Delta efs).
 
 Definition typeconv' (ty: type): type :=
 match ty with
@@ -141,16 +143,16 @@ Proof.
   do 2 try match type of H with context [if ?A then _ else _] => destruct A end; congruence.
 Qed.
 
-Lemma tc_efield_ind: forall {cs: compspecs} (Delta: tycontext) (efs: list efield),
-  tc_efield Delta efs =
+Lemma tc_efield_ind: forall {cs: compspecs} (Delta: tycontext) (efs: list efield) (rho: environ),
+  tc_efield Delta efs rho  ⊣⊢
   match efs with
-  | nil => TT
+  | nil => True
   | eArraySubsc ei :: efs' =>
-    tc_expr Delta ei && tc_efield Delta efs'
-  | eStructField i :: efs' =>
-    tc_efield Delta efs'
+    tc_expr Delta ei rho ∧  tc_efield Delta efs' rho
+  | eStructField i :: efs'  =>
+    tc_efield Delta efs' rho
   | eUnionField i :: efs' =>
-    tc_efield Delta efs'
+    tc_efield Delta efs' rho
   end.
 Proof.
   intros.
@@ -158,9 +160,9 @@ Proof.
   destruct e; auto.
   unfold tc_efield.
   simpl typecheck_efield.
-  extensionality rho.
   rewrite denote_tc_assert_andp.
-  auto.
+  constructor; intros; monPred.unseal. (* FIXME is this necessary? *)
+  reflexivity.
 Qed.
 
 Lemma typeof_nested_efield': forall rho t_root e ef efs gf gfs t tts,
@@ -215,12 +217,13 @@ Qed.
 Lemma By_reference_eval_expr: forall Delta e rho,
   access_mode (typeof e) = By_reference ->
   tc_environ Delta rho ->
-  tc_lvalue Delta e rho |--
-  !! (eval_expr e rho = eval_lvalue e rho).
+  tc_lvalue Delta e rho ⊢
+  ⌜ (eval_expr e rho = eval_lvalue e rho) ⌝.
 Proof.
   intros.
-  eapply derives_trans. apply typecheck_lvalue_sound; auto.
-  normalize.
+  iIntros "H".
+  iPoseProof (typecheck_lvalue_sound with "[-]") as "%HH"; eauto.
+  iPureIntro.
   destruct e; try contradiction; simpl in *;
   reflexivity.
 Qed.
@@ -228,11 +231,12 @@ Qed.
 Lemma By_reference_tc_expr: forall Delta e rho,
   access_mode (typeof e) = By_reference ->
   tc_environ Delta rho ->
-  tc_lvalue Delta e rho |--  tc_expr Delta e rho.
+  tc_lvalue Delta e rho ⊢  tc_expr Delta e rho.
 Proof.
   intros.
   unfold tc_lvalue, tc_expr.
-  destruct e; simpl in *; try apply @FF_left; rewrite H; auto.
+  destruct e; ((iIntros (hyp); hnf in hyp; done) +
+               (constructor; intros; unfold typecheck_expr; rewrite H; done)).
 Qed.
 
 Definition LR_of_type (t: type) :=
@@ -514,16 +518,13 @@ Proof.
   unfold Vptrofs, Cop.ptrofs_of_int, Ptrofs.of_ints, Ptrofs.of_intu, Ptrofs.of_int.
   rewrite H.
   destruct Archi.ptr64 eqn:Hp.
-  f_equal. f_equal. f_equal. rewrite Ptrofs.of_int64_to_int64 by auto.
+  f_equal. f_equal. f_equal. rewrite Ptrofs.of_int64_to_int64 //.
   rewrite <- ptrofs_mul_repr;  f_equal.
   f_equal. f_equal. f_equal.
-  destruct si.
-  rewrite <- ptrofs_mul_repr;  f_equal.
-  rewrite ptrofs_to_int_repr.
-  rewrite Ptrofs_repr_Int_signed_special by auto. auto.
-  rewrite <- ptrofs_mul_repr;  f_equal.
-  rewrite ptrofs_to_int_repr.
-  rewrite Ptrofs_repr_Int_unsigned_special by auto. auto.
+  destruct si;
+  rewrite <- ?ptrofs_mul_repr;
+  rewrite ptrofs_to_int_repr;
+  rewrite ?Ptrofs_repr_Int_signed_special ?Ptrofs_repr_Int_unsigned_special //.
 Qed.
 
 Lemma sem_add_pl_ptr_special:
@@ -548,9 +549,8 @@ Proof.
   apply Int64.eqm_sym.
   apply Int64.eqm_unsigned_repr.
   destruct Archi.ptr64 eqn:Hp.
-  rewrite Ptrofs.modulus_eq64 by auto. apply Z.divide_refl.
-  rewrite Ptrofs.modulus_eq32 by auto.
-  exists Int.modulus. reflexivity.
+  rewrite Ptrofs.modulus_eq64 //.
+  rewrite Ptrofs.modulus_eq32 //; apply power_nat_divide; computable.
 Qed.
 
 
@@ -610,11 +610,12 @@ Proof.
   destruct p; try contradiction.
   unfold offset_val, Cop.sem_add_ptr_long.
   f_equal. f_equal. f_equal.
-  rewrite (Ptrofs.agree64_of_int_eq (Ptrofs.repr i))
-    by (apply Ptrofs.agree64_repr; auto).
+  rewrite (Ptrofs.agree64_of_int_eq (Ptrofs.repr i)); [| (apply Ptrofs.agree64_repr; auto)].
   rewrite ptrofs_mul_repr. auto.
 Qed.
 
+Tactic Notation "simpl!" := simpl; unfold typecheck_lvalue; unfold typecheck_expr; fold typecheck_lvalue; fold typecheck_expr; simpl.
+
 Lemma array_ind_step_long: forall Delta ei i rho t_root e efs gfs tts t n a t0 p,
   legal_nested_efield_rec t_root gfs tts = true ->
   type_almost_match e t_root (LR_of_type t_root) = true ->
@@ -624,28 +625,31 @@ Lemma array_ind_step_long: forall Delta ei i rho t_root e efs gfs tts t n a t0 p
   tc_environ Delta rho ->
   efield_denote efs gfs rho ->
   field_compatible t_root gfs p ->
-  tc_LR_strong Delta e (LR_of_type t_root) rho && tc_efield Delta efs rho
-  |-- !! (field_address t_root gfs p = eval_LR (nested_efield e efs tts) (LR_of_type (Tarray t0 n a)) rho) &&
-          tc_LR_strong Delta (nested_efield e efs tts) (LR_of_type (Tarray t0 n a)) rho ->
-  tc_LR_strong Delta e (LR_of_type t_root) rho &&
+  (tc_LR_strong Delta e (LR_of_type t_root) rho ∧ tc_efield Delta efs rho
+  ⊢ ⌜field_address t_root gfs p = eval_LR (nested_efield e efs tts) (LR_of_type (Tarray t0 n a)) rho⌝ ∧
+          tc_LR_strong Delta (nested_efield e efs tts) (LR_of_type (Tarray t0 n a)) rho) ->
+  (tc_LR_strong Delta e (LR_of_type t_root) rho ∧
   tc_efield Delta (eArraySubsc ei :: efs) rho
-  |-- !! (offset_val (gfield_offset (nested_field_type t_root gfs) (ArraySubsc i))
+  ⊢ ⌜offset_val (gfield_offset (nested_field_type t_root gfs) (ArraySubsc i))
           (field_address t_root gfs p) =
-          eval_lvalue (nested_efield e (eArraySubsc ei :: efs) (t :: tts)) rho) &&
-          tc_lvalue Delta (nested_efield e (eArraySubsc ei :: efs) (t :: tts)) rho.
+          eval_lvalue (nested_efield e (eArraySubsc ei :: efs) (t :: tts)) rho⌝ ∧
+          tc_lvalue Delta (nested_efield e (eArraySubsc ei :: efs) (t :: tts)) rho).
 Proof.
   intros ? ? ? ? ? ? ? ? ? ? ? ? ? ?
          LEGAL_NESTED_EFIELD_REC TYPE_MATCH ? ? NESTED_FIELD_TYPE TC_ENVIRON EFIELD_DENOTE FIELD_COMPATIBLE IH.
   destruct (array_op_facts_long _ _ _ _ _ _ _ _ _ _ t _ LEGAL_NESTED_EFIELD_REC TYPE_MATCH H NESTED_FIELD_TYPE FIELD_COMPATIBLE EFIELD_DENOTE) as [CLASSIFY_ADD ISBINOP].
   pose proof field_address_isptr _ _ _ FIELD_COMPATIBLE as ISPTR.
-  rewrite tc_efield_ind; simpl.
-  rewrite andp_comm, andp_assoc.
-  eapply derives_trans; [apply andp_derives; [apply derives_refl | rewrite andp_comm; exact IH] | ].
+  rewrite tc_efield_ind.
+  Opaque assert_of. simpl!. Transparent assert_of.
+  rewrite bi.and_comm. rewrite -bi.and_assoc.
+  iApply bi.wand_trans; iSplitL.
+  iApply bi.and_mono; [apply entails_refl | rewrite bi.and_comm; exact IH].
   rewrite (add_andp _ _ (typecheck_expr_sound _ _ _ TC_ENVIRON)).
   unfold_lift.
   normalize.
-  apply andp_right1; [apply prop_right | normalize].
-  +
+  iIntros "[[%H1 %H2] H]".
+  iApply (andp_right1 with "H").
+  +  apply bi.pure_intro.
      assert (H3: Vlong (Int64.repr i) = eval_expr ei rho). {
        clear - H1 H0 H.
        destruct (typeof ei); inv H.
@@ -666,20 +670,23 @@ Proof.
      apply complete_legal_cosu_type_complete_type; auto.
     }
     2: simpl in H2; rewrite <- H2; auto.
-    unfold gfield_offset; rewrite NESTED_FIELD_TYPE, H2.
+    unfold gfield_offset; rewrite NESTED_FIELD_TYPE H2.
     reflexivity.
-  + unfold tc_lvalue.
-    Opaque isBinOpResultType. simpl. Transparent isBinOpResultType.
+  + normalize.
+    unfold tc_lvalue.
+    Opaque isBinOpResultType. 
+    Opaque assert_of. simpl!. Transparent assert_of. (* To protect denote_tc_assert *)
+    Transparent isBinOpResultType.
     rewrite ISBINOP.
-    normalize.
-    rewrite !denote_tc_assert_andp; simpl.
-    repeat apply andp_right.
-    - apply prop_right.
+    rewrite !denote_tc_assert_andp.
+    rewrite !monPred_at_and.
+    repeat apply andp_right1.
+    - apply bi.pure_intro.
       simpl in H2; rewrite <- H2; auto.
     - solve_andp.
     - solve_andp.
-    - rewrite andb_false_r. simpl. apply prop_right; auto.
-    - apply prop_right.
+    - rewrite andb_false_r. simpl. apply bi.pure_intro; auto.
+    - apply bi.pure_intro.
       simpl; unfold_lift.
       rewrite <- H3.
       normalize.
@@ -695,40 +702,44 @@ Lemma array_ind_step_ptrofs: forall Delta ei i rho t_root e efs gfs tts t n a t0
   tc_environ Delta rho ->
   efield_denote efs gfs rho ->
   field_compatible t_root gfs p ->
-  (tc_LR_strong Delta e (LR_of_type t_root) rho && tc_efield Delta efs rho
-  |-- !! (field_address t_root gfs p = eval_LR (nested_efield e efs tts) (LR_of_type (Tarray t0 n a)) rho) &&
+  (tc_LR_strong Delta e (LR_of_type t_root) rho ∧ tc_efield Delta efs rho
+  ⊢ ⌜field_address t_root gfs p = eval_LR (nested_efield e efs tts) (LR_of_type (Tarray t0 n a)) rho⌝ ∧
           tc_LR_strong Delta (nested_efield e efs tts) (LR_of_type (Tarray t0 n a)) rho) ->
-  tc_LR_strong Delta e (LR_of_type t_root) rho &&
+  tc_LR_strong Delta e (LR_of_type t_root) rho ∧
   tc_efield Delta (eArraySubsc ei :: efs) rho
-  |-- !! (offset_val (gfield_offset (nested_field_type t_root gfs) (ArraySubsc i))
+  ⊢ ⌜offset_val (gfield_offset (nested_field_type t_root gfs) (ArraySubsc i))
           (field_address t_root gfs p) =
-          eval_lvalue (nested_efield e (eArraySubsc ei :: efs) (t :: tts)) rho) &&
+          eval_lvalue (nested_efield e (eArraySubsc ei :: efs) (t :: tts)) rho⌝ ∧
           tc_lvalue Delta (nested_efield e (eArraySubsc ei :: efs) (t :: tts)) rho.
 Proof.
   intros ? ? ? ? ? ? ? ? ? ? ? ? ? ?
          LEGAL_NESTED_EFIELD_REC TYPE_MATCH ? ? NESTED_FIELD_TYPE TC_ENVIRON EFIELD_DENOTE FIELD_COMPATIBLE IH.
   destruct (array_op_facts_ptrofs _ _ _ _ _ _ _ _ _ _ t _ LEGAL_NESTED_EFIELD_REC TYPE_MATCH H NESTED_FIELD_TYPE FIELD_COMPATIBLE EFIELD_DENOTE) as [CLASSIFY_ADD ISBINOP].
   pose proof field_address_isptr _ _ _ FIELD_COMPATIBLE as ISPTR.
-  rewrite tc_efield_ind; simpl.
-  rewrite andp_comm, andp_assoc.
-  eapply derives_trans; [apply andp_derives; [apply derives_refl | rewrite andp_comm; exact IH] | ].
+  rewrite tc_efield_ind.
+  Opaque assert_of. simpl!. Transparent assert_of.
+  rewrite bi.and_comm -bi.and_assoc.
+  iApply bi.wand_trans; iSplitL.
+  iApply bi.and_mono; [apply entails_refl | rewrite bi.and_comm; exact IH].
   rewrite (add_andp _ _ (typecheck_expr_sound _ _ _ TC_ENVIRON)).
-  unfold_lift.
+  iIntros; iStopProof.
   normalize.
-  apply andp_right1; [apply prop_right | normalize].
+  unfold_lift.
+  apply andp_right1; [apply bi.pure_intro | normalize].
   +
      assert (H3: Vptrofs (Ptrofs.repr i) = eval_expr ei rho). {
        clear - H1 H0 H.
        unfold is_ptrofs_type, Vptrofs in *.
        destruct Archi.ptr64 eqn:Hp.
-       destruct (typeof ei); inv H.
-       inv H0. rewrite <- H in H1; inv H1.
+       destruct (typeof ei); inversion H; clear H.
+       inversion H0; subst. rewrite <- H in H1; inv H1.
        rewrite <- H. f_equal.  apply Ptrofs.agree64_to_int_eq.
        apply Ptrofs.agree64_repr; auto.
-       destruct (typeof ei); inv H. destruct i0; inv H3.
-       inv H0. 2: rewrite <- H in H1; inv H1.
+       destruct (typeof ei); inversion H; clear H. destruct i0; inversion H3.
+       inversion H0. 2: rewrite <- H in H1; inv H1.
        rewrite <- H. f_equal. apply ptrofs_to_int_repr.
     }
+    unfold_lift.
     rewrite <- H3.
     unfold force_val2, force_val.
     unfold sem_add.
@@ -747,20 +758,23 @@ Proof.
      apply complete_legal_cosu_type_complete_type; auto.
     }
     2: simpl in H2; rewrite <- H2; auto.
-    unfold gfield_offset; rewrite NESTED_FIELD_TYPE, H2.
+    unfold gfield_offset; rewrite NESTED_FIELD_TYPE H2.
     reflexivity.
-  + unfold tc_lvalue.
-    Opaque isBinOpResultType. simpl. Transparent isBinOpResultType.
+  + normalize.
+    unfold tc_lvalue.
+    Opaque isBinOpResultType. 
+    Opaque assert_of. simpl!. Transparent assert_of.
+    Transparent isBinOpResultType.
     rewrite ISBINOP.
-    normalize.
-    rewrite !denote_tc_assert_andp; simpl.
-    repeat apply andp_right.
-    - apply prop_right.
+    rewrite !denote_tc_assert_andp.
+    rewrite !monPred_at_and.
+    repeat apply andp_right1.
+    - apply bi.pure_intro.
       simpl in H2; rewrite <- H2; auto.
     - solve_andp.
     - solve_andp.
-    - rewrite andb_false_r. simpl. apply prop_right; auto.
-    - apply prop_right.
+    - rewrite andb_false_r. simpl. apply bi.pure_intro; auto.
+    - apply bi.pure_intro.
       simpl; unfold_lift.
       rewrite <- H3.
       normalize.
@@ -779,14 +793,14 @@ Lemma array_ind_step: forall Delta ei i rho t_root e efs gfs tts t n a t0 p,
   tc_environ Delta rho ->
   efield_denote efs gfs rho ->
   field_compatible t_root gfs p ->
-  (tc_LR_strong Delta e (LR_of_type t_root) rho && tc_efield Delta efs rho
-  |-- !! (field_address t_root gfs p = eval_LR (nested_efield e efs tts) (LR_of_type (Tarray t0 n a)) rho) &&
+  (tc_LR_strong Delta e (LR_of_type t_root) rho ∧ tc_efield Delta efs rho
+  ⊢ ⌜field_address t_root gfs p = eval_LR (nested_efield e efs tts) (LR_of_type (Tarray t0 n a)) rho⌝ ∧
           tc_LR_strong Delta (nested_efield e efs tts) (LR_of_type (Tarray t0 n a)) rho) ->
-  tc_LR_strong Delta e (LR_of_type t_root) rho &&
+  tc_LR_strong Delta e (LR_of_type t_root) rho ∧
   tc_efield Delta (eArraySubsc ei :: efs) rho
-  |-- !! (offset_val (gfield_offset (nested_field_type t_root gfs) (ArraySubsc i))
+  ⊢ ⌜offset_val (gfield_offset (nested_field_type t_root gfs) (ArraySubsc i))
           (field_address t_root gfs p) =
-          eval_lvalue (nested_efield e (eArraySubsc ei :: efs) (t :: tts)) rho) &&
+          eval_lvalue (nested_efield e (eArraySubsc ei :: efs) (t :: tts)) rho⌝ ∧
           tc_lvalue Delta (nested_efield e (eArraySubsc ei :: efs) (t :: tts)) rho.
 Proof.
   intros ? ? ? ? ? ? ? ? ? ? ? ? ? ?
@@ -796,13 +810,16 @@ Proof.
      by (clear - H'; destruct (typeof ei) as [| | | [|] | | | | |]; try contradiction; auto).
   destruct (array_op_facts _ _ _ _ _ _ _ _ _ _ t _ LEGAL_NESTED_EFIELD_REC TYPE_MATCH H NESTED_FIELD_TYPE FIELD_COMPATIBLE EFIELD_DENOTE) as [CLASSIFY_ADD ISBINOP].
   pose proof field_address_isptr _ _ _ FIELD_COMPATIBLE as ISPTR.
-  rewrite tc_efield_ind; simpl.
-  rewrite andp_comm, andp_assoc.
-  eapply derives_trans; [apply andp_derives; [apply derives_refl | rewrite andp_comm; exact IH] | ].
+  rewrite tc_efield_ind.
+  Opaque assert_of. simpl!. Transparent assert_of.
+  rewrite bi.and_comm -bi.and_assoc.
+  iApply bi.wand_trans; iSplitL.
+  iApply bi.and_mono; [apply entails_refl | rewrite bi.and_comm; exact IH].
+  iIntros; iStopProof.
   rewrite (add_andp _ _ (typecheck_expr_sound _ _ _ TC_ENVIRON)).
   unfold_lift.
   normalize.
-  apply andp_right1; [apply prop_right | normalize].
+  apply andp_right1; [apply bi.pure_intro | normalize].
   + 
      assert (H3: Vint (Int.repr i) = eval_expr ei rho). {
        clear - H1 H0 H.
@@ -825,23 +842,26 @@ Proof.
      apply complete_legal_cosu_type_complete_type; auto.
     }
     2: simpl in H2; rewrite <- H2; auto.
-    unfold gfield_offset; rewrite NESTED_FIELD_TYPE, H2.
+    unfold gfield_offset; rewrite NESTED_FIELD_TYPE H2.
     reflexivity.
     clear - H' CLASSIFY_ADD.
     destruct  (typeof (nested_efield e efs tts)) as  [ | [ | | | ] [ | ]| [ | ] | [ | ] | | | | | ], 
                  (typeof ei) as  [ | [ | | | ] [ | ]| [ | ] | [ | ] | | | | | ]; inv CLASSIFY_ADD; try contradiction; auto.
-  + unfold tc_lvalue.
-    Opaque isBinOpResultType. simpl. Transparent isBinOpResultType.
+  + normalize.
+    unfold tc_lvalue.
+    Opaque isBinOpResultType. 
+    Opaque assert_of. simpl!. Transparent assert_of.
+    Transparent isBinOpResultType.
     rewrite ISBINOP.
-    normalize.
-    rewrite !denote_tc_assert_andp; simpl.
-    repeat apply andp_right.
-    - apply prop_right.
+    rewrite !denote_tc_assert_andp.
+    rewrite !monPred_at_and.
+    repeat apply andp_right1.
+    - apply bi.pure_intro.
       simpl in H2; rewrite <- H2; auto.
     - solve_andp.
     - solve_andp.
-    - rewrite andb_false_r. simpl. apply prop_right; auto.
-    - apply prop_right.
+    - rewrite andb_false_r. simpl. apply bi.pure_intro; auto.
+    - apply bi.pure_intro.
       simpl; unfold_lift.
       rewrite <- H3.
       normalize.
@@ -866,15 +886,15 @@ Proof.
   1: destruct i1; inv H7.
   1: match type of H7 with context [if ?A then _ else _] => destruct A end; inv H7.
   unfold tc_lvalue, eval_field.
-  simpl.
+  Opaque assert_of. simpl!. Transparent assert_of.
   rewrite H5.
   unfold field_offset, fieldlist.field_offset.
   unfold get_co in *.
-  destruct (cenv_cs ! i1); [| inv H1].
+  destruct (cenv_cs !! i1); [| inv H1].
   rewrite (plain_members_field_offset _ PLAIN _ _ H1).
   split; auto.
-  rewrite denote_tc_assert_andp; simpl.
-  apply add_andp, prop_right; auto.
+  rewrite tc_andp_TT2.
+  reflexivity.
 Qed.
 
 Lemma struct_ind_step: forall Delta t_root e gfs efs tts i a i0 t rho p
@@ -886,26 +906,26 @@ Lemma struct_ind_step: forall Delta t_root e gfs efs tts i a i0 t rho p
   tc_environ Delta rho ->
   efield_denote efs gfs rho ->
   field_compatible t_root gfs p ->
-  (tc_LR_strong Delta e (LR_of_type t_root) rho && tc_efield Delta efs rho
-  |-- !! (field_address t_root gfs (eval_LR e (LR_of_type t_root) rho) =
-          eval_LR (nested_efield e efs tts) (LR_of_type (Tstruct i0 a)) rho) &&
+  (tc_LR_strong Delta e (LR_of_type t_root) rho ∧ tc_efield Delta efs rho
+  ⊢ ⌜(field_address t_root gfs (eval_LR e (LR_of_type t_root) rho) =
+          eval_LR (nested_efield e efs tts) (LR_of_type (Tstruct i0 a)) rho)⌝ ∧
           tc_LR_strong Delta (nested_efield e efs tts) (LR_of_type (Tstruct i0 a)) rho) ->
-  tc_LR_strong Delta e (LR_of_type t_root) rho &&
+  tc_LR_strong Delta e (LR_of_type t_root) rho ∧
   tc_efield Delta (eStructField i :: efs) rho
-  |-- !! (offset_val (gfield_offset (nested_field_type t_root gfs) (StructField i))
+  ⊢ ⌜(offset_val (gfield_offset (nested_field_type t_root gfs) (StructField i))
             (field_address t_root gfs (eval_LR e (LR_of_type t_root) rho)) =
-          eval_lvalue (nested_efield e (eStructField i :: efs) (t :: tts)) rho) &&
+          eval_lvalue (nested_efield e (eStructField i :: efs) (t :: tts)) rho)⌝ ∧
       tc_lvalue Delta (nested_efield e (eStructField i :: efs) (t :: tts)) rho.
 Proof.
   intros ? ? ? ? ? ? ? ? ? ? ? ? PLAIN
          LEGAL_NESTED_EFIELD_REC TYPE_MATCH ? NESTED_FIELD_TYPE TC_ENVIRON EFIELD_DENOTE FIELD_COMPATIBLE IH.
   destruct (struct_op_facts Delta _ _ _ _ _ _ _ _ t _ PLAIN LEGAL_NESTED_EFIELD_REC TYPE_MATCH H NESTED_FIELD_TYPE EFIELD_DENOTE) as [TC EVAL].
   rewrite tc_efield_ind; simpl.
-  eapply derives_trans; [exact IH | ].
+  iApply bi.wand_trans; iSplitL;  [iApply IH | ]. iIntros; iStopProof.
   unfold_lift.
   normalize.
-  apply andp_right1; [apply prop_right | normalize].
-  + rewrite EVAL, H0, NESTED_FIELD_TYPE.
+  apply andp_right1; [apply bi.pure_intro | normalize].
+  + rewrite EVAL H0 NESTED_FIELD_TYPE.
     reflexivity.
   + simpl in TC; rewrite <- TC.
       apply derives_refl.
@@ -929,14 +949,14 @@ Proof.
   1: destruct i1; inv H7.
   1: match type of H7 with context [if ?A then _ else _] => destruct A end; inv H7.
   unfold tc_lvalue, eval_field.
-  simpl.
+  Opaque assert_of. simpl!. Transparent assert_of.
   rewrite H5.
   unfold get_co in *.
-  destruct (cenv_cs ! i1); [| inv H1].
+  destruct (cenv_cs !! i1); [| inv H1].
   rewrite (plain_members_union_field_offset _ PLAIN); auto.
   split; [| normalize; auto].
-  rewrite denote_tc_assert_andp; simpl.
-  apply add_andp, prop_right; auto.
+  rewrite tc_andp_TT2.
+  reflexivity.
 Qed.
 
 Lemma union_ind_step: forall Delta t_root e gfs efs tts i a i0 t rho p
@@ -948,26 +968,26 @@ Lemma union_ind_step: forall Delta t_root e gfs efs tts i a i0 t rho p
   tc_environ Delta rho ->
   efield_denote efs gfs rho ->
   field_compatible t_root gfs p ->
-  (tc_LR_strong Delta e (LR_of_type t_root) rho && tc_efield Delta efs rho
-  |-- !! (field_address t_root gfs (eval_LR e (LR_of_type t_root) rho) =
-          eval_LR (nested_efield e efs tts) (LR_of_type (Tstruct i0 a)) rho) &&
+  (tc_LR_strong Delta e (LR_of_type t_root) rho ∧ tc_efield Delta efs rho
+  ⊢ ⌜field_address t_root gfs (eval_LR e (LR_of_type t_root) rho) =
+          eval_LR (nested_efield e efs tts) (LR_of_type (Tstruct i0 a)) rho⌝ ∧
           tc_LR_strong Delta (nested_efield e efs tts) (LR_of_type (Tstruct i0 a)) rho) ->
-  tc_LR_strong Delta e (LR_of_type t_root) rho &&
+  tc_LR_strong Delta e (LR_of_type t_root) rho ∧
   tc_efield Delta (eUnionField i :: efs) rho
-  |-- !! (offset_val (gfield_offset (nested_field_type t_root gfs) (UnionField i))
+  ⊢ ⌜offset_val (gfield_offset (nested_field_type t_root gfs) (UnionField i))
             (field_address t_root gfs (eval_LR e (LR_of_type t_root) rho)) =
-          eval_lvalue (nested_efield e (eUnionField i :: efs) (t :: tts)) rho) &&
+          eval_lvalue (nested_efield e (eUnionField i :: efs) (t :: tts)) rho⌝ ∧
       tc_lvalue Delta (nested_efield e (eUnionField i :: efs) (t :: tts)) rho.
 Proof.
   intros ? ? ? ? ? ? ? ? ? ? ? ? PLAIN
          LEGAL_NESTED_EFIELD_REC TYPE_MATCH ? NESTED_FIELD_TYPE TC_ENVIRON EFIELD_DENOTE FIELD_COMPATIBLE IH.
   destruct (union_op_facts Delta _ _ _ _ _ _ _ _ t _ PLAIN LEGAL_NESTED_EFIELD_REC TYPE_MATCH H NESTED_FIELD_TYPE EFIELD_DENOTE) as [TC EVAL].
   rewrite tc_efield_ind; simpl.
-  eapply derives_trans; [exact IH | ].
+  iApply bi.wand_trans; iSplitL;  [iApply IH | ]. iIntros; iStopProof.
   unfold_lift.
   normalize.
-  apply andp_right1; [apply prop_right | normalize].
-  + rewrite EVAL, H0, NESTED_FIELD_TYPE.
+  apply andp_right1; [apply bi.pure_intro | normalize].
+  + rewrite EVAL H0 NESTED_FIELD_TYPE.
     reflexivity.
   + simpl in TC; rewrite <- TC.
       apply derives_refl.
@@ -976,58 +996,57 @@ Qed.
 Definition lvalue_LR_of_type: forall Delta rho P p t e,
   t = typeof e ->
   tc_environ Delta rho ->
-  (P |-- !! (p = eval_lvalue e rho) && tc_lvalue Delta e rho) ->
-  P |-- !! (p = eval_LR e (LR_of_type t) rho) && tc_LR_strong Delta e (LR_of_type t) rho.
+  (P ⊢ ⌜p = eval_lvalue e rho⌝ ∧ tc_lvalue Delta e rho) ->
+  P ⊢ ⌜p = eval_LR e (LR_of_type t) rho⌝ ∧ tc_LR_strong Delta e (LR_of_type t) rho.
 Proof.
   intros.
   destruct (LR_of_type t) eqn:?H.
   + exact H1.
   + rewrite (add_andp _ _ H1); clear H1.
-    simpl; normalize.
-    apply andp_left2.
+    normalize.
+    iIntros "[_ ?]".
     unfold LR_of_type in H2.
     subst.
     destruct (typeof e) eqn:?H; inv H2.
-    apply andp_right.
-    - eapply derives_trans; [apply By_reference_eval_expr |]; auto.
-      rewrite H; auto. normalize.
-    - apply By_reference_tc_expr; auto.
+    iSplit.
+    - iPoseProof (By_reference_eval_expr with "[-]") as "%HH"; try done.
+      rewrite H; auto.
+    - iApply By_reference_tc_expr; auto.
       rewrite H; auto.
 Qed.
 
-Lemma eval_lvalue_nested_efield_aux: forall Delta t_root e efs gfs tts p,
+ Lemma eval_lvalue_nested_efield_aux: forall Delta t_root e efs gfs tts p,
   field_compatible t_root gfs p ->
   legal_nested_efield t_root e gfs tts (LR_of_type t_root) = true ->
-  local (`(eq p) (eval_LR e (LR_of_type t_root))) &&
-  tc_LR Delta e (LR_of_type t_root) &&
-  local (tc_environ Delta) &&
-  tc_efield Delta efs &&
-  local (efield_denote efs gfs) |--
+  local (`(eq p) (eval_LR e (LR_of_type t_root))) ∧
+  tc_LR Delta e (LR_of_type t_root) ∧
+  local (tc_environ Delta) ∧
+  tc_efield Delta efs ∧
+  local (efield_denote efs gfs) ⊢
   local (`(eq (field_address t_root gfs p))
-   (eval_LR (nested_efield e efs tts) (LR_of_type (nested_field_type t_root gfs)))) &&
+   (eval_LR (nested_efield e efs tts) (LR_of_type (nested_field_type t_root gfs)))) ∧
   tc_LR_strong Delta (nested_efield e efs tts) (LR_of_type (nested_field_type t_root gfs)).
 Proof.
   (* Prepare *)
   intros Delta t_root e efs gfs tts p FIELD_COMPATIBLE LEGAL_NESTED_EFIELD.
-  unfold local, lift1; simpl; intro rho.
+  unfold local, lift1; split => rho; monPred.unseal.
   unfold_lift.
   normalize.
-  rename H into EFIELD_DENOTE, H0 into TC_ENVIRON.
-  apply derives_trans with (tc_LR_strong Delta e (LR_of_type t_root) rho && tc_efield Delta efs rho).
+  rename H0 into EFIELD_DENOTE, H into TC_ENVIRON.
+  trans (tc_LR_strong Delta e (LR_of_type t_root) rho ∧ tc_efield Delta efs rho).
   {
-    repeat (apply andp_derives; auto).
-    eapply derives_trans; [| apply tc_LR_tc_LR_strong].
-    rewrite andp_comm, prop_true_andp by auto.
+    repeat (apply bi.and_mono; auto).
+    rewrite -tc_LR_tc_LR_strong.
     auto.
   }
   pose proof legal_nested_efield_weaken _ _ _ _ LEGAL_NESTED_EFIELD as [LEGAL_NESTED_EFIELD_REC TYPE_ALMOST_MATCH].
-  rewrite field_compatible_field_address by auto.
+  rewrite -> field_compatible_field_address by auto.
   clear LEGAL_NESTED_EFIELD.
 
   (* Induction *)
   revert tts LEGAL_NESTED_EFIELD_REC; induction EFIELD_DENOTE; intros;
   destruct tts; try solve [inversion LEGAL_NESTED_EFIELD_REC];
-  [normalize; apply derives_refl | ..];
+  [normalize; rewrite bi.and_elim_l // | ..];
   pose proof FIELD_COMPATIBLE as FIELD_COMPATIBLE_CONS;
   apply field_compatible_cons in FIELD_COMPATIBLE;
   destruct (nested_field_type t_root gfs) eqn:NESTED_FIELD_TYPE; try solve [inv FIELD_COMPATIBLE];
@@ -1038,7 +1057,7 @@ Proof.
   specialize (IHEFIELD_DENOTE tts LEGAL_NESTED_EFIELD_REC);
   (apply lvalue_LR_of_type; [eapply typeof_nested_efield'; eauto; econstructor; eauto | eassumption |]);
   destruct FIELD_COMPATIBLE as [? FIELD_COMPATIBLE];
-  rewrite offset_val_nested_field_offset_ind by auto;
+  rewrite -> offset_val_nested_field_offset_ind by auto;
   rewrite <- field_compatible_field_address in IHEFIELD_DENOTE |- * by auto.
   + eapply array_ind_step; eauto.
   + eapply array_ind_step_long; eauto.
@@ -1048,14 +1067,14 @@ Proof.
      assert (H2 :=nested_field_type_complete_legal_cosu_type _ _ H0 H1).
      rewrite NESTED_FIELD_TYPE in H2. simpl in H2.
      unfold get_co.
-     destruct (cenv_cs ! i0); try discriminate.
+     destruct (cenv_cs !! i0); try discriminate.
      destruct (co_su c); try discriminate; auto.
   + eapply union_ind_step; eauto.
      destruct FIELD_COMPATIBLE as [_ [H0 [_ [_ H1]]]].
      assert (H2 :=nested_field_type_complete_legal_cosu_type _ _ H0 H1).
      rewrite NESTED_FIELD_TYPE in H2. simpl in H2.
      unfold get_co.
-     destruct (cenv_cs ! i0); try discriminate.
+     destruct (cenv_cs !! i0); try discriminate.
      destruct (co_su c); try discriminate; auto.
 Qed.
 
@@ -1064,39 +1083,39 @@ Lemma nested_efield_facts: forall Delta t_root e efs gfs tts lr p,
   LR_of_type t_root = lr ->
   legal_nested_efield t_root e gfs tts lr = true ->
   type_is_by_value (nested_field_type t_root gfs) = true ->
-  local (`(eq p) (eval_LR e (LR_of_type t_root))) &&
-  tc_LR Delta e (LR_of_type t_root) &&
-  local (tc_environ Delta) &&
-  tc_efield Delta efs &&
-  local (efield_denote efs gfs) |--
+  local (`(eq p) (eval_LR e (LR_of_type t_root))) ∧
+  tc_LR Delta e (LR_of_type t_root) ∧
+  local (tc_environ Delta) ∧
+  tc_efield Delta efs ∧
+  local (efield_denote efs gfs) ⊢
   local (`(eq (field_address t_root gfs p))
-   (eval_lvalue (nested_efield e efs tts))) &&
+   (eval_lvalue (nested_efield e efs tts))) ∧
   tc_lvalue Delta (nested_efield e efs tts).
 Proof.
   intros.
   subst lr.
-  eapply derives_trans; [apply eval_lvalue_nested_efield_aux; eauto |].
+  rewrite eval_lvalue_nested_efield_aux //.
   destruct (LR_of_type (nested_field_type t_root gfs)) eqn:?H; auto; try apply derives_refl.
   unfold LR_of_type in H0.
   destruct (nested_field_type t_root gfs) as [| [| | |] [|] | | [|] | | | | |]; inv H2; inv H0.
 Qed.
-  
+
 Lemma eval_lvalue_nested_efield: forall Delta t_root e efs gfs tts lr p,
   field_compatible t_root gfs p ->
   LR_of_type t_root = lr ->
   legal_nested_efield t_root e gfs tts lr = true ->
   type_is_by_value (nested_field_type t_root gfs) = true ->
-  local (`(eq p) (eval_LR e lr)) &&
-  tc_LR Delta e lr &&
-  local (tc_environ Delta) &&
-  tc_efield Delta efs &&
-  local (efield_denote efs gfs) |--
+  local (`(eq p) (eval_LR e lr)) ∧
+  tc_LR Delta e lr ∧
+  local (tc_environ Delta) ∧
+  tc_efield Delta efs ∧
+  local (efield_denote efs gfs) ⊢
   local (`(eq (field_address t_root gfs p)) (eval_lvalue (nested_efield e efs tts))).
 Proof.
   intros.
   subst lr.
-  eapply derives_trans; [apply eval_lvalue_nested_efield_aux; eauto |].
-  apply andp_left1.
+  rewrite eval_lvalue_nested_efield_aux //.
+  rewrite bi.and_elim_l.
   destruct (LR_of_type (nested_field_type t_root gfs)) eqn:?H; auto; try apply derives_refl.
   unfold LR_of_type in H0.
   destruct (nested_field_type t_root gfs) as [| [| | |] [|] | | [|] | | | | |]; inv H2; inv H0.
@@ -1107,17 +1126,17 @@ Lemma tc_lvalue_nested_efield: forall Delta t_root e efs gfs tts lr p,
   LR_of_type t_root = lr ->
   legal_nested_efield t_root e gfs tts lr = true ->
   type_is_by_value (nested_field_type t_root gfs) = true ->
-  local (`(eq p) (eval_LR e lr)) &&
-  tc_LR Delta e lr &&
-  local (tc_environ Delta) &&
-  tc_efield Delta efs &&
-  local (efield_denote efs gfs) |--
+  local (`(eq p) (eval_LR e lr)) ∧
+  tc_LR Delta e lr ∧
+  local (tc_environ Delta) ∧
+  tc_efield Delta efs ∧
+  local (efield_denote efs gfs) ⊢
   tc_lvalue Delta (nested_efield e efs tts).
 Proof.
   intros.
   subst lr.
-  eapply derives_trans; [apply eval_lvalue_nested_efield_aux; eauto |].
-  apply andp_left2.
+  rewrite eval_lvalue_nested_efield_aux //.
+  rewrite bi.and_elim_r.
   destruct (LR_of_type (nested_field_type t_root gfs)) eqn:?H; auto; try apply derives_refl.
   unfold LR_of_type in H0.
   destruct (nested_field_type t_root gfs) as [| [| | |] [|] | | [|] | | | | |]; inv H2; inv H0.
@@ -1213,8 +1232,6 @@ Proof.
   Opaque eqb_type.
   destruct (typeof e); inv H2; inv H3; inv H4; simpl;
   try rewrite eqb_type_spec; auto.
-  + inv H0.
-  + inv H0.
 Qed.
 
 Lemma compute_nested_efield_aux: forall e rho lr_default,
@@ -1322,7 +1339,7 @@ Proof.
       specialize (IH H1 H10).
       destruct IH as [IH1 [IH2 [IH3 [IH4 IH5]]]].
       simpl.
-      rewrite IH1, IH4.
+      rewrite IH1 IH4.
       simpl.
       rewrite eqb_type_spec.
       assert (nested_field_type t_root (gfs SUB i) = t0); auto.
@@ -1333,7 +1350,7 @@ Proof.
       specialize (IH H1 H10).
       destruct IH as [IH1 [IH2 [IH3 [IH4 IH5]]]].
       simpl.
-      rewrite IH1, IH4.
+      rewrite IH1 IH4.
       simpl.
       rewrite eqb_type_spec.
       assert (nested_field_type t_root (gfs SUB i) = t0); auto.
@@ -1344,7 +1361,7 @@ Proof.
       specialize (IH H1 H10).
       destruct IH as [IH1 [IH2 [IH3 [IH4 IH5]]]].
       simpl.
-      rewrite IH1, IH4.
+      rewrite IH1 IH4.
       simpl.
       rewrite eqb_type_spec.
       assert (nested_field_type t_root (gfs SUB i) = t0); auto.
@@ -1369,7 +1386,7 @@ Proof.
       specialize (IH H2 H8).
       destruct IH as [IH1 [IH2 [IH3 [IH4 IH5]]]].
       simpl.
-      rewrite IH1, IH4.
+      rewrite IH1 IH4.
       simpl.
       rewrite eqb_type_spec.
       assert (nested_field_type t_root (gfs DOT i) = t); auto.
@@ -1389,7 +1406,7 @@ Proof.
       specialize (IH H2 H8).
       destruct IH as [IH1 [IH2 [IH3 [IH4 IH5]]]].
       simpl.
-      rewrite IH1, IH4.
+      rewrite IH1 IH4.
       simpl.
       rewrite eqb_type_spec.
       assert (nested_field_type t_root (gfs UDOT i) = t); auto.
diff --git a/floyd/entailer.v b/floyd/entailer.v
index 8ac9fdd349..3305d16322 100644
--- a/floyd/entailer.v
+++ b/floyd/entailer.v
@@ -1,4 +1,6 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.functional_base.
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.go_lower.
@@ -6,9 +8,7 @@ Require Import VST.floyd.reptype_lemmas.
 Require Import VST.floyd.data_at_rec_lemmas.
 Require Import VST.floyd.field_at VST.floyd.nested_field_lemmas.
 
-Local Open Scope logic.
-
-Lemma ptrofs_of_ints_unfold: 
+Lemma ptrofs_of_ints_unfold:
   forall x, Ptrofs.of_ints x = Ptrofs.repr (Int.signed x).
 Proof. reflexivity. Qed.
 #[export] Hint Rewrite ptrofs_of_ints_unfold : norm.
@@ -25,9 +25,6 @@ intros. destruct p; try contradiction; apply I.
 Qed.
 #[export] Hint Resolve isptr_force_val_sem_cast_neutral : norm.
 
-Lemma FF_local_facts: forall {A}{NA: NatDed A}, (FF:A) |-- !!False.
-Proof. intros. apply FF_left. Qed.
-#[export] Hint Resolve FF_local_facts: saturate_local.
 
 Ltac simpl_compare :=
  match goal with
@@ -78,205 +75,185 @@ Ltac simpl_compare :=
  | |- _ => idtac
 end.
 
-Lemma prop_and_same_derives {A}{NA: NatDed A}:
-  forall P Q, (Q |-- !! P)   ->   Q |-- !!P && Q.
+Lemma prop_and_same_derives :
+  forall {prop:bi} (P:Prop) (Q:prop), (Q ⊢ ⌜P⌝)   ->   Q ⊢ (⌜P⌝ ∧ Q).
 Proof.
-intros. apply andp_right; auto.
+intros. apply bi.and_intro; auto.
 Qed.
 
-Arguments denote_tc_isptr v / .
-Arguments denote_tc_iszero !v .
-Arguments denote_tc_nonzero !v .
-Arguments denote_tc_igt i !v .
-Arguments denote_tc_Zge z !v .
-Arguments denote_tc_Zle z !v .
-Arguments denote_tc_samebase !v1 !v2 .
-Arguments denote_tc_nodivover !v1 !v2 .
-Arguments denote_tc_initialized id ty rho / .
-Arguments denote_tc_nosignedover op s v1 v2 / .
+Arguments denote_tc_isptr {_} {_} v / .
+Arguments denote_tc_iszero {_} {_} !v .
+Arguments denote_tc_nonzero {_} {_} !v .
+Arguments denote_tc_igt {_} {_} i !v .
+Arguments denote_tc_Zge {_} {_} z !v .
+Arguments denote_tc_Zle {_} {_} z !v .
+Arguments denote_tc_samebase {_} {_} !v1 !v2 .
+Arguments denote_tc_nodivover {_} {_} !v1 !v2 .
+Arguments denote_tc_initialized {_} {_} id ty rho / .
+Arguments denote_tc_nosignedover {_} {_} op s v1 v2 / .
+
+
+Local Notation "'False'" := (@bi_pure mpred (False%type)).
+
 Ltac simpl_denote_tc :=
- repeat change (denote_tc_isptr ?v) with (!! isptr v);
- repeat change (denote_tc_iszero (Vint ?i)) with (!! is_true (Int.eq i Int.zero));
- repeat change (denote_tc_iszero (Vlong ?i)) with (!! is_true (Int64.eq i Int64.zero));
- repeat change (denote_tc_iszero _) with (@FF mpred _);
- repeat change (denote_tc_nonzero (Vint ?i)) with (!! (i <> Int.zero));
- repeat change (denote_tc_nonzero (Vlong ?i)) with (!! (i <> Int64.zero));
- repeat change (denote_tc_nonzero _) with (@FF mpred _);
- repeat change (denote_tc_igt ?i (Vint ?i1)) with (!! (Int.unsigned i1 < Int.unsigned i));
+ repeat change (denote_tc_isptr ?v) with (@bi_pure mpred isptr v);
+ repeat change (denote_tc_iszero (Vint ?i)) with (@bi_pure mpred is_true (Int.eq i Int.zero));
+ repeat change (denote_tc_iszero (Vlong ?i)) with (@bi_pure mpred is_true (Int64.eq i Int64.zero));
+ repeat change (denote_tc_iszero _) with (False);
+ repeat change (denote_tc_nonzero (Vint ?i)) with (@bi_pure mpred (i <> Int.zero));
+ repeat change (denote_tc_nonzero (Vlong ?i)) with (@bi_pure mpred (i <> Int64.zero));
+ repeat change (denote_tc_nonzero _) with (False);
+ repeat change (denote_tc_igt ?i (Vint ?i1)) with (@bi_pure mpred (Int.unsigned i1 < Int.unsigned i));
  repeat change (denote_tc_Zge ?z (Vfloat ?f)) with 
-                     match Zoffloat f with Some n => !!(z>=n) | None => @FF mpred _ end;
+                     match Zoffloat f with Some n => @bi_pure mpred(z>=n) | None => False end;
  repeat change (denote_tc_Zge ?z (Vsingle ?f)) with 
-                     match Zofsingle f with Some n => !!(z<=n) | None => @FF mpred _ end;
- repeat change (denote_tc_Zge ?z _) with  (@FF mpred _);
+                     match Zofsingle f with Some n => @bi_pure mpred(z<=n) | None => False end;
+ repeat change (denote_tc_Zge ?z _) with  (False);
  repeat change (denote_tc_Zle ?z (Vfloat ?f)) with 
-                     match Zoffloat f with Some n => !!(z<=n) | None => @FF mpred _ end;
+                     match Zoffloat f with Some n => @bi_pure mpred(z<=n) | None => False end;
  repeat change (denote_tc_Zle ?z (Vsingle ?f)) with 
-                     match Zofsingle f with Some n => !!(z<=n) | None => @FF mpred _ end;
- repeat change (denote_tc_Zle ?z _) with  (@FF mpred _);
- repeat change (denote_tc_samebase ?v1 ?v2) with (!! is_true (sameblock v1 v2));
+                     match Zofsingle f with Some n => @bi_pure mpred(z<=n) | None => False end;
+ repeat change (denote_tc_Zle ?z _) with  (False);
+ repeat change (denote_tc_samebase ?v1 ?v2) with (@bi_pure mpred is_true (sameblock v1 v2));
  repeat change (denote_tc_nodivover (Vint ?n1) (Vint ?n2))
-            with (!! (~ (n1 = Int.repr Int.min_signed /\ n2 = Int.mone)));
+            with (@bi_pure mpred (~ (n1 = Int.repr Int.min_signed /\ n2 = Int.mone)));
  repeat change (denote_tc_nodivover (Vint ?n1) (Vlong _))
-            with (@TT mpred _);
+            with (@bi_pure mpred True);
  repeat change (denote_tc_nodivover (Vlong ?n1) (Vint ?n2))
-            with ( !! (~ (n1 = Int64.repr Int64.min_signed /\ n2 = Int.mone)));
+            with ( @bi_pure mpred (~ (n1 = Int64.repr Int64.min_signed /\ n2 = Int.mone)));
  repeat change (denote_tc_nodivover (Vlong ?n1) (Vlong ?n2))
-            with (!! (~ (n1 = Int64.repr Int64.min_signed /\ n2 = Int64.mone)));
+            with (@bi_pure mpred (~ (n1 = Int64.repr Int64.min_signed /\ n2 = Int64.mone)));
  repeat change (denote_tc_nodivover _ _)
-            with (@FF mpred _);
+            with (False);
  repeat change (denote_tc_nosignedover ?op (Vint ?n1) (Vint ?n2)) with
-          (!! (Int.min_signed <= op (Int.signed n1) (Int.signed n2) <= Int.max_signed));
+          (@bi_pure mpred (Int.min_signed <= op (Int.signed n1) (Int.signed n2) <= Int.max_signed));
  repeat change (denote_tc_nosignedover ?op (Vint ?n1) (Vlong ?n2)) with
-          (!! (Int64.min_signed <=
+          (@bi_pure mpred (Int64.min_signed <=
             op (Int.signed n1) (Int64.signed n2) <= Int64.max_signed));
  repeat change (denote_tc_nosignedover ?op (Vlong ?n1) (Vint ?n2)) with
-          (!! (Int64.min_signed <=
+          (@bi_pure mpred (Int64.min_signed <=
             op (Int64.signed n1) (Int.signed n2) <=
             Int64.max_signed));
  repeat change (denote_tc_nosignedover ?op (Vlong ?n1) (Vlong ?n2)) with
-          (!! (Int64.min_signed <=
+          (@bi_pure mpred (Int64.min_signed <=
             op (Int64.signed n1) (Int64.signed n2) <=
             Int64.max_signed));
- repeat change (denote_tc_nosignedover _ _)  with (@FF mpred _);
+ repeat change (denote_tc_nosignedover _ _) with (False);
  simpl denote_tc_initialized.
 
+Example simpl_denote_tc_test `{!heapGS Σ} : @bi_entails mpred False (denote_tc_iszero (Vint (Int.repr 1))).
+intros. by simpl_denote_tc; apply derives_refl. Qed.
+
+Section ENTAILER.
+
+Context `{!VSTGS OK_ty Σ}.
+
 Lemma denote_tc_test_eq_split:
   forall P x y,
-    (P |-- valid_pointer x) ->
-    (P |-- valid_pointer y) ->
-    P |-- denote_tc_test_eq x y.
+    (P ⊢ valid_pointer x) ->
+    (P ⊢ valid_pointer y) ->
+    P ⊢ denote_tc_test_eq x y.
 Proof.
  intros.
- eapply derives_trans with (valid_pointer x && valid_pointer y).
- apply andp_right; auto.
+ trans (valid_pointer x ∧ valid_pointer y).
+ apply bi.and_intro; auto.
  clear H H0.
  unfold denote_tc_test_eq, weak_valid_pointer.
-change predicates_hered.orp with orp.
- destruct x; try (apply andp_left1; apply @FF_left); try apply @TT_right;
- destruct y; try (apply andp_left2; apply @FF_left); try apply @TT_right.
- apply andp_derives; try apply derives_refl.
- apply andp_derives; try apply derives_refl.
- apply orp_right1. apply derives_refl.
- rewrite andp_comm.
- apply andp_derives; try apply derives_refl.
- apply orp_right1. apply derives_refl.
+ destruct x; try (iIntros "([] & _)"); try apply @bi.True_intro;
+ destruct y; try (iIntros "(_ & [])"); try apply @bi.True_intro.
+ apply bi.and_mono; try apply derives_refl.
+ apply bi.and_mono; try apply derives_refl.
+ apply bi.or_intro_l.
+ rewrite bi.and_comm.
+ apply bi.and_mono; try apply derives_refl. apply bi.or_intro_l.
  unfold test_eq_ptrs.
  destruct (sameblock _ _); auto.
- apply andp_derives; apply valid_pointer_weak.
+ apply bi.and_mono; apply valid_pointer_weak.
 Qed.
 
 Lemma valid_pointer_null:
-  forall P, P |-- valid_pointer nullval.
+  forall P, P ⊢ valid_pointer nullval.
 Proof.
   intros. unfold nullval, valid_pointer, valid_pointer'. 
   destruct Archi.ptr64 eqn:Hp; simpl;
- change predicates_hered.prop with prop;
  normalize.
 Qed.
 
 
 Lemma extend_valid_pointer:
-  forall p Q, valid_pointer p * Q |-- valid_pointer p.
+  forall p Q, valid_pointer p ∗ Q ⊢ valid_pointer p.
 Proof.
-intros.
- unfold valid_pointer.
- pose proof (extend_tc.extend_valid_pointer' p 0).
- pose proof (predicates_hered.boxy_e _ _ H).
- constructor; change (predicates_hered.derives (valid_pointer' p 0 * Q) (valid_pointer' p 0)).
- intros ? (w1 & w2 & Hj & Hp & ?).
- apply (H0 w1); auto.
- hnf; eauto.
+  intros. iIntros "[$ _]".
 Qed.
 
 Lemma extend_weak_valid_pointer:
-  forall p Q, weak_valid_pointer p * Q |-- weak_valid_pointer p.
+  forall p Q, weak_valid_pointer p ∗ Q ⊢ weak_valid_pointer p.
 Proof.
-  intros. unfold weak_valid_pointer.
-  pose proof (extend_tc.extend_valid_pointer' p 0).
-  pose proof (predicates_hered.boxy_e _ _ H). 
-  pose proof (extend_tc.extend_valid_pointer' p (-1)).
-  pose proof (predicates_hered.boxy_e _ _ H1).
-  constructor; change
-      (predicates_hered.derives
-         (predicates_hered.orp (valid_pointer' p 0) (valid_pointer' p (-1)) * Q)
-         (predicates_hered.orp (valid_pointer' p 0) (valid_pointer' p (-1)))).
-  intros ? (w1 & w2 & Hj & Hp & ?). simpl in Hp |- * .
-  destruct Hp; [left; apply (H0 w1) | right; apply (H2 w1)]; auto; hnf; eauto.
+  intros. iIntros "[$ _]".
 Qed.
 
 Lemma sepcon_valid_pointer1:
      forall (P Q: mpred) p,
-        (P |-- valid_pointer p) ->
-        P * Q |-- valid_pointer p.
+        (P ⊢ valid_pointer p) ->
+        P ∗ Q ⊢ valid_pointer p.
 Proof.
-intros.
- eapply derives_trans; [apply sepcon_derives; [eassumption | apply TT_right] |].
- clear H.
- apply extend_valid_pointer.
+  intros. rewrite H; iIntros "[$ _]".
 Qed.
 
  Lemma sepcon_valid_pointer2:
      forall (P Q: mpred) p,
-        (P |-- valid_pointer p) ->
-        Q * P |-- valid_pointer p.
+        (P ⊢ valid_pointer p) ->
+        Q ∗ P ⊢ valid_pointer p.
 Proof.
- intros. rewrite sepcon_comm; apply sepcon_valid_pointer1.
- auto.
+ intros. rewrite H; iIntros "[_ $]".
 Qed.
 
 Lemma sepcon_weak_valid_pointer1: 
  forall (P Q : mpred) (p : val),
-   (P |-- weak_valid_pointer p) -> P * Q |-- weak_valid_pointer p.
+   (P ⊢ weak_valid_pointer p) -> P ∗ Q ⊢ weak_valid_pointer p.
 Proof.
-  intros.
-  eapply derives_trans; [ | apply (extend_weak_valid_pointer p Q)].
-  apply sepcon_derives; auto.
+  intros. rewrite H; iIntros "[$ _]".
 Qed.
 
 Lemma sepcon_weak_valid_pointer2:
   forall (P Q : mpred) (p : val),
-    (P |-- weak_valid_pointer p) -> Q * P |-- weak_valid_pointer p.
+    (P ⊢ weak_valid_pointer p) -> Q ∗ P ⊢ weak_valid_pointer p.
 Proof.
-  intros. rewrite sepcon_comm.
-  apply sepcon_weak_valid_pointer1; auto.
+  intros. rewrite H; iIntros "[_ $]".
 Qed.
 
  Lemma andp_valid_pointer1:
      forall (P Q: mpred) p,
-        (P |-- valid_pointer p) ->
-        P && Q |-- valid_pointer p.
+        (P ⊢ valid_pointer p) ->
+        P ∧ Q ⊢ valid_pointer p.
 Proof.
-intros.
- apply andp_left1; auto.
+  intros. rewrite H; iIntros "[$ _]".
 Qed.
 
  Lemma andp_valid_pointer2:
      forall (P Q: mpred) p,
-        (P |-- valid_pointer p) ->
-        Q && P |-- valid_pointer p.
+        (P ⊢ valid_pointer p) ->
+        Q ∧ P ⊢ valid_pointer p.
 Proof.
-intros.
- apply andp_left2; auto.
+intros. rewrite H; iIntros "[_ $]".
 Qed.
 
 Lemma valid_pointer_zero32:
-  forall P, Archi.ptr64=false -> P |-- valid_pointer (Vint (Int.repr 0)).
+  forall P, Archi.ptr64=false -> P ⊢ valid_pointer (Vint (Int.repr 0)).
 Proof.
  intros.
  unfold valid_pointer, valid_pointer'. rewrite H.
- change predicates_hered.prop with prop;
  normalize.
 Qed.
 
 Lemma valid_pointer_zero64:
-  forall P, Archi.ptr64=true -> P |-- valid_pointer (Vlong (Int64.repr 0)).
+  forall P, Archi.ptr64=true -> P ⊢ valid_pointer (Vlong (Int64.repr 0)).
 Proof.
  intros.
  unfold valid_pointer, valid_pointer'. rewrite H.
- change predicates_hered.prop with prop;
  normalize.
 Qed.
-
+End ENTAILER.
 
 #[export] Hint Resolve sepcon_valid_pointer1 sepcon_valid_pointer2 : valid_pointer.
 #[export] Hint Resolve andp_valid_pointer1 andp_valid_pointer2 : valid_pointer.
@@ -290,33 +267,35 @@ Qed.
 (* TODO: test_order need to be added *)
 Ltac solve_valid_pointer :=
 match goal with
-| |- _ |-- denote_tc_test_eq _ _ && _ =>
-           apply andp_right;
+| |- _ ⊢ denote_tc_test_eq _ _ ∧ _ =>
+           apply bi.and_intro;
                [apply denote_tc_test_eq_split;
-                solve [auto 50 with valid_pointer] | ]
-| |- _ |-- valid_pointer _ && _ =>
-           apply andp_right; [ solve [auto 50 with valid_pointer] | ]
-| |- _ |-- weak_valid_pointer _ && _ =>
-           apply andp_right; [ solve [auto 50 with valid_pointer] | ]
-| |- _ |-- denote_tc_test_eq _ _ =>
-              auto 50 with valid_pointer
-| |- _ |-- valid_pointer _ =>
-              auto 50 with valid_pointer
-| |- _ |-- weak_valid_pointer _ =>
-              auto 50 with valid_pointer
+                solve [auto 50 with nocore valid_pointer] | ]
+| |- _ ⊢ valid_pointer _ ∧ _ =>
+           apply bi.and_intro; [ solve [auto 50 with nocore valid_pointer] | ]
+| |- _ ⊢ weak_valid_pointer _ ∧ _ =>
+           apply bi.and_intro; [ solve [auto 50 with nocore valid_pointer] | ]
+| |- _ ⊢ denote_tc_test_eq _ _ =>
+              auto 50 with nocore valid_pointer
+| |- _ ⊢ valid_pointer _ =>
+              auto 50 with nocore valid_pointer
+| |- _ ⊢ weak_valid_pointer _ =>
+              auto 50 with nocore valid_pointer
 end.
 
-#[export] Hint Rewrite (@TT_andp mpred _) : gather_prop.
-#[export] Hint Rewrite (@andp_TT mpred _) : gather_prop.
+#[export] Hint Rewrite @bi.True_and : gather_prop.
+#[export] Hint Rewrite @bi.and_True : gather_prop.
+
+Ltac pure_elim :=
+  match goal with
+  | |- ⌜_⌝ ∧ _ ⊢ _ => apply bi.pure_elim_l
+  | |- _ ∧ ⌜_⌝ ⊢ _ => apply bi.pure_elim_r
+  end.
 
 Ltac pull_out_props :=
-    repeat (( simple apply derives_extract_prop
-                || simple apply derives_extract_prop');
-                fancy_intros true);
+    repeat (pure_elim; fancy_intros true);
     gather_prop;
-    repeat (( simple apply derives_extract_prop
-                || simple apply derives_extract_prop');
-                fancy_intros true).
+    repeat (pure_elim; fancy_intros true).
 
 Ltac simplify_float2int :=
 match goal with
@@ -333,12 +312,10 @@ match goal with
 end.
 
 Ltac ent_iter :=
-    try simple apply prop_True_right;
+    try apply bi.True_intro;
     repeat simplify_float2int;
     gather_prop;
-    repeat (( simple apply derives_extract_prop
-                || simple apply derives_extract_prop');
-                fancy_intros true);
+    repeat (pure_elim; fancy_intros true);
    repeat erewrite unfold_reptype_elim in * by (apply JMeq_refl; reflexivity);
    simpl_compare;
    simpl_denote_tc;
@@ -347,25 +324,31 @@ Ltac ent_iter :=
    try solve_valid_pointer;
    repeat data_at_conflict_neq.
 
-Lemma and_False: forall x, (x /\ False) = False.
+Section ENTAILER.
+Context `{!heapGS Σ}.
+Implicit Type x:mpred.
+
+Lemma and_False: forall x, (x ∧ False) ⊣⊢ False.
 Proof.
-intros; apply prop_ext; tauto.
+  intros. rewrite bi.and_False. done.
 Qed.
 
-Lemma and_True: forall x, (x /\ True) = x.
+Lemma and_True: forall x, (x ∧ True) ⊣⊢ x.
 Proof.
-intros; apply prop_ext; tauto.
+  intros. rewrite bi.and_True. done.
 Qed.
 
-Lemma True_and: forall x, (True /\ x) = x.
+Lemma True_and: forall x, (True ∧ x) ⊣⊢ x.
 Proof.
-intros; apply prop_ext; tauto.
+  intros. rewrite bi.True_and //. 
 Qed.
 
-Lemma False_and: forall x, (False /\ x) = False.
+Lemma False_and: forall x, (False ∧ x) ⊣⊢ False.
 Proof.
-intros; apply prop_ext; tauto.
+  intros. rewrite bi.False_and. done.
 Qed.
+End ENTAILER.
+
 Ltac splittable :=
  match goal with
  | |- _ <= _ < _ => fail 1
@@ -402,8 +385,8 @@ Qed.
 #[export] Hint Resolve ptr_eq_nullval : prove_it_now.
 
 #[export] Hint Extern 4 (value_fits _ _ _) =>
-   (rewrite ?proj_sumbool_is_true by auto;
-    rewrite ?proj_sumbool_is_false by auto;
+   (rewrite ->?proj_sumbool_is_true by auto;
+    rewrite ->?proj_sumbool_is_false by auto;
     repeat simplify_value_fits; auto) : prove_it_now.
 
 Lemma intsigned_intrepr_bytesigned: forall i,
@@ -422,7 +405,7 @@ Ltac prove_it_now :=
  first [ splittable; fail 1
         | computable
         | apply Coq.Init.Logic.I
-        | reflexivity
+        | apply eq_refl
         | rewrite ?intsigned_intrepr_bytesigned; rep_lia
         | prove_signed_range
         | congruence
@@ -431,7 +414,7 @@ Ltac prove_it_now :=
                       | H: @value_fits _ _ _ |- _ => clear H  (* delete these because they can cause slowness in the 'auto' *)
                       end;
           auto with prove_it_now field_compatible;
-          autorewrite with norm entailer_rewrite; normalize;
+          autorewrite with (*norm*) entailer_rewrite; (*normalize*) try fancy_intro true; try safe_done;
           first [eapply field_compatible_nullval; eassumption
                  | eapply field_compatible_nullval1; eassumption
                  | eapply field_compatible_nullval2; eassumption
@@ -439,7 +422,7 @@ Ltac prove_it_now :=
          ].
 
 Ltac try_prove_it_now :=
- first [match goal with H := _ |- _ => instantiate (1:=True) in H; prove_it_now end
+ first [match goal with H := _ |- _ => instantiate (1:=True%type) in H; prove_it_now end
        | eassumption].
 
 (* try_conjuncts.  The purpose of this is to avoid splitting any
@@ -480,36 +463,35 @@ Ltac try_conjuncts :=
         | simple eapply try_conjuncts_lem;
             [intro; try_conjuncts | intro; try_conjuncts
             |match goal with H: conjuncts_marker _ |- _ => red in H; apply H end ]
-        | match goal with H: conjuncts_marker _ |- _ => instantiate (1:=True) in H;
+        | match goal with H: conjuncts_marker _ |- _ => instantiate (1:=True%type) in H;
                 try_conjuncts_solver
           end
         | match goal with H: conjuncts_marker _ |- _ => red in H; apply H end
         ].
 
 Lemma try_conjuncts_prop_and:
-  forall {A}{NA: NatDed A} (S: A) (P P': Prop) Q,
+  forall {A:bi} (S: A) (P P': Prop) Q,
       (conjuncts_marker P' -> P) ->
-      (S |-- !! P' && Q) ->
-      S |-- !! P && Q.
+      (S ⊢ ⌜P'⌝ ∧ Q) ->
+      S ⊢ ⌜P⌝ ∧ Q.
 Proof. intros.
- eapply derives_trans; [apply H0 |].
- apply andp_derives; auto.
- apply prop_derives; auto.
+ rewrite H0.
+ apply bi.and_mono; auto.
 Qed.
 
 
 Lemma try_conjuncts_prop:
-  forall {A}{NA: NatDed A} (S: A) (P P': Prop),
+  forall {A:bi} (S: A) (P P': Prop),
       (conjuncts_marker P' -> P) ->
-      (S |-- !! P') ->
-      S |-- !! P .
+      (S ⊢ ⌜P'⌝) ->
+      S ⊢ ⌜P⌝ .
 Proof. intros.
- eapply derives_trans; [apply H0 |].
- apply prop_derives; auto.
+ rewrite H0.
+ apply bi.pure_mono; done.
 Qed.
 
 Ltac prop_right_cautious :=
- try solve [simple apply prop_right; auto; prove_it_now].
+ try solve [apply bi.pure_intro; auto; prove_it_now].
 
 Ltac prune_conjuncts :=
  repeat rewrite and_assoc';
@@ -525,16 +507,15 @@ Ltac entailer' :=
  repeat (progress (ent_iter; normalize));
  try simple apply prop_and_same_derives;
  prune_conjuncts;
- try rewrite (prop_true_andp True) by apply Coq.Init.Logic.I;
+ try rewrite ->(prop_true_andp True) by apply Coq.Init.Logic.I;
  try solve_valid_pointer;
  try first [apply derives_refl
-              | simple apply FF_left
-              | simple apply TT_right].
+              | simple apply bi.False_elim
+              | simple apply bi.True_intro].
 
-Lemma empTrue:
- @derives mpred Nveric (@emp mpred Nveric Sveric) (@prop mpred Nveric True).
+Lemma empTrue `{!heapGS Σ}: @bi_emp_valid mpred True.
 Proof.
-apply prop_right; auto.
+apply bi.pure_intro; auto.
 Qed.
 
 Ltac clean_up_stackframe := idtac.
@@ -544,7 +525,7 @@ Lemma my_auto_lem:
 Proof. auto. Qed.
 
 Ltac my_auto_iter H :=
- first [instantiate (1:=True) in H;  prove_it_now
+ first [instantiate (1:=True%type) in H;  prove_it_now
        | splittable;
          eapply try_conjuncts_lem;
             [let H1 := fresh in intro H1; my_auto_iter H1
@@ -566,20 +547,21 @@ Ltac my_auto_reiter :=
 
 Ltac my_auto :=
  repeat match goal with |- ?P -> _ => match type of P with Prop => intro end end;
- rewrite ?isptr_force_ptr by auto;
+ rewrite ->?isptr_force_ptr by auto;
+ norm_rewrite;
  let H := fresh in eapply my_auto_lem; [intro H; my_auto_iter H | ];
  try all_True;
  (eapply my_auto_lem; [intro; my_auto_reiter | ]);
  normalize.
 
-Lemma prop_and_same_derives' {A}{NA: NatDed A}:
-  forall (P: Prop) Q,   P   ->   Q |-- !!P && Q.
+Lemma prop_and_same_derives' {prop:bi}:
+  forall (P: Prop) (Q:prop), P -> Q ⊢ ⌜P⌝ ∧ Q.
 Proof.
-intros. apply andp_right; auto. apply prop_right; auto.
+  intros. iIntros; iFrame. iPureIntro; done.
 Qed.
 
-Definition prop_and_same_derives_mpred := 
-  @prop_and_same_derives mpred _.
+Definition prop_and_same_derives_mpred `{heapGS0:!heapGS Σ} := 
+  @prop_and_same_derives (@mpred Σ heapGS0).
 
 Ltac entailer :=
  try match goal with POSTCONDITION := @abbreviate ret_assert _ |- _ =>
@@ -589,21 +571,20 @@ Ltac entailer :=
         clear MORE_COMMANDS
       end;
  lazymatch goal with
- | |- ?P |-- _ =>
+ | |- @bi_entails (monPredI environ_index (iPropI _)) _ _ => clean_up_stackframe; go_lower
+ | |- ?P ⊢ _ =>
     lazymatch type of P with
-    | ?T => tryif unify T (environ->mpred)
-                 then (clean_up_stackframe; go_lower)
-                 else tryif unify T mpred
-                    then (clear_Delta; pull_out_props)
-                    else fail "Unexpected type of entailment, neither mpred nor environ->mpred"
+    | ?T => tryif unify T mpred
+            then (clear_Delta; pull_out_props)
+            else fail "Unexpected type of entailment, neither mpred nor assert"
     end
- | |- _ => fail  "The entailer tactic works only on entailments   _ |-- _ "
+ | |- _ => fail  "The entailer tactic works only on entailments   _ ⊢ _ "
  end;
- try solve [simple apply prop_right; my_auto];
- try solve [simple apply prop_and_same_derives_mpred; my_auto];
+ try solve [apply bi.pure_intro; my_auto];
+ try solve [apply prop_and_same_derives_mpred; my_auto];
  saturate_local;
- entailer';
- rewrite <- ?sepcon_assoc.
+ entailer'(*;
+ rewrite ?bi.sep_assoc*).
 
 
 Ltac entbang :=
@@ -615,17 +596,17 @@ Ltac entbang :=
         clear MORE_COMMANDS
       end;
  lazymatch goal with
- | |- local _ && ?P |-- _ => clean_up_stackframe; go_lower;
-          rewrite ?TT_andp, ?andp_TT; try apply TT_right
- | |- ?P |-- _ =>
+ | |- local _ ∧ ?P ⊢ _ => clean_up_stackframe; go_lower;
+          rewrite ?bi.True_and ?bi.and_True; try apply bi.True_intro
+ | |- @bi_entails (monPredI environ_index (iPropI _)) _ _ =>
+        fail "entailer! found an assert entailment that is missing its 'local' left-hand-side part (that is, Delta)"
+ | |- ?P ⊢ _ =>
     lazymatch type of P with
-    | ?T => tryif unify T (environ->mpred)
-                 then fail "entailer! found an (environ->mpred) entailment that is missing its 'local' left-hand-side part (that is, Delta)"
-                 else tryif unify T mpred
-                    then (clear_Delta; pull_out_props)
-                    else fail "Unexpected type of entailment, neither mpred nor environ->mpred"
+    | ?T => tryif unify T mpred
+            then (clear_Delta; pull_out_props)
+            else fail "Unexpected type of entailment, neither mpred nor assert"
     end
- | |- _ => fail "The entailer tactic works only on entailments  _ |-- _ "
+ | |- _ => fail "The entailer tactic works only on entailments  _ ⊢ _ "
  end;
  repeat lazymatch goal with
         | |- context [force_val (sem_binary_operation' ?op ?t1 ?t2 ?v1 ?v2)] =>
@@ -646,14 +627,14 @@ Ltac entbang :=
  ent_iter;
  repeat change (mapsto_memory_block.spacer _ _ _ _) with emp;
  first [ contradiction
-        | simple apply prop_right; my_auto
-        | lazymatch goal with |- ?Q |-- !! _ && ?Q' => constr_eq  Q Q';
+        | simple apply bi.pure_intro; my_auto
+        | lazymatch goal with |- ?Q ⊢ ⌜_⌝ ∧ ?Q' => constr_eq Q Q';
                       simple apply prop_and_same_derives'; my_auto
           end
-        | simple apply andp_right;
-            [apply prop_right; my_auto 
-            | cancel; rewrite <- ?sepcon_assoc; autorewrite with norm ]
-        | normalize; cancel; rewrite <- ?sepcon_assoc
+        | simple apply bi.and_intro;
+            [apply bi.pure_intro; my_auto 
+            | cancel; autorewrite with norm ]
+        | normalize; cancel
         ].
 
 Tactic Notation "entailer" "!" := entbang.
@@ -715,7 +696,7 @@ Lemma offset_val_sizeof_hack:
  forall cenv t i p,
    isptr p ->
    i=0 ->
-   (offset_val (@sizeof cenv t * i) p = p) = True.
+   (offset_val (@sizeof cenv t * i) p = p) = (True%type).
 Proof.
 intros.
 subst.
@@ -730,7 +711,7 @@ Lemma offset_val_sizeof_hack2:
  forall cenv t i j p,
    isptr p ->
    i=j ->
-   (offset_val (@sizeof cenv t * i) p = offset_val (@sizeof cenv t * j) p) = True.
+   (offset_val (@sizeof cenv t * i) p = offset_val (@sizeof cenv t * j) p) = (True%type).
 Proof.
 intros.
 subst.
@@ -742,7 +723,7 @@ Lemma offset_val_sizeof_hack3:
  forall cenv t i p,
    isptr p ->
    i=1 ->
-   (offset_val (@sizeof cenv t * i) p = offset_val (@sizeof cenv t) p) = True.
+   (offset_val (@sizeof cenv t * i) p = offset_val (@sizeof cenv t) p) = (True%type).
 Proof.
 intros.
 subst.
@@ -765,8 +746,8 @@ Import ListNotations.
 
 Ltac progress_entailer :=
  lazymatch goal with
- | |- @derives mpred _ ?A ?B => 
-     entailer!; try match goal with |- @derives mpred _ A B => fail 2 end
+ | |- @bi_entails _ ?A ?B => 
+     entailer!; try match goal with |- @bi_entails _ A B => fail 2 end
  | |- _ => progress entailer!
  end.
 
diff --git a/floyd/extcall_lemmas.v b/floyd/extcall_lemmas.v
index bddf54e0ce..d7901bdaa9 100644
--- a/floyd/extcall_lemmas.v
+++ b/floyd/extcall_lemmas.v
@@ -1,8 +1,9 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
-Local Open Scope logic.
 
-Definition compute_funspecs_norepeat (l : list (ident*funspec)) :=
+Definition compute_funspecs_norepeat {Σ} (l : @funspecs Σ) :=
   compute_list_norepet (fst (split l)).
 
 Lemma not_in_funspecs_by_id_i {A B} i (l : list (A * B)) l0 l1 :
@@ -17,9 +18,9 @@ Proof.
   eapply IHl; eauto.
 Qed.
 
-Lemma compute_funspecs_norepeat_e l :
+Lemma compute_funspecs_norepeat_e {Σ:gFunctors} l :
   compute_funspecs_norepeat l = true ->
-  funspecs_norepeat l.
+  @funspecs_norepeat Σ l.
 Proof.
   intros H; hnf.
   rewrite <-semax_call.fst_split.
diff --git a/floyd/fastforward.v b/floyd/fastforward.v
index fc754da895..81e209f65a 100644
--- a/floyd/fastforward.v
+++ b/floyd/fastforward.v
@@ -1,6 +1,7 @@
 From Ltac2 Require Import Ltac2.
-
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.functional_base.
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.go_lower.
@@ -24,9 +25,9 @@ Ltac fastforward_semax_post_simpl := idtac.
 (* Performs a "single-step" for fastforward *)
 Ltac2 fastforward_ss () :=
   first
-  [ progress ltac1:(Intros *); ff_log "Intros *."
+  [ progress ltac1:(Intros * ); ff_log "Intros *."
   | progress (ltac1:(simpl_implicit)); ff_log "simpl_implicit."
-  | progress ltac1:(fold_Vbyte); ff_log "fold_Vbyte"
+  | progress ltac1:(fold_Vbyte); ff_log "fold_Vbyte."
   | progress ltac1:(fastforward_semax_pre_simpl)
   | ltac1:(forward); ff_log "forward."
   | ltac1:(forward_if); ff_log "forward_if."
@@ -40,7 +41,7 @@ Ltac2 fastforward_ss () :=
 
 Ltac2 fastforward_ss' () :=
   first
-  [ progress ltac1:(Intros *); ff_log "Intros *."
+  [ progress ltac1:(Intros * ); ff_log "Intros *."
   | progress ltac1:(simpl_implicit); ff_log "simpl_implicit."
   | progress ltac1:(fold_Vbyte); ff_log "fold_Vbyte"
   | progress ltac1:(fastforward_semax_pre_simpl)
@@ -56,12 +57,12 @@ Ltac2 fastforward_ss' () :=
 
 Ltac2 simplstep (agro : bool) := Control.enter (fun () =>
   lazy_match! goal with
-  | [ |- semax _ _ ?cmds _ ] =>
+  | [ |- semax _ _ _ ?cmds _ ] =>
     (fun ss =>
       repeat (
         Control.enter (fun () =>
           lazy_match! goal with
-          | [ |- semax _ _ ?cmds' _ ] =>
+          | [ |- semax _ _ _ ?cmds' _ ] =>
             match Constr.equal cmds cmds' with
             | true => ()
             | false => fail
@@ -82,7 +83,7 @@ Ltac2 simplstep (agro : bool) := Control.enter (fun () =>
 Ltac2 fastforward (agro : bool) := 
   progress (repeat (Control.enter(fun () =>
     lazy_match! goal with
-    | [ |- semax _ _ _ _ ] => simplstep agro
+    | [ |- semax _ _ _ _ _ ] => simplstep agro
     | [ |- _ ] => ltac1:(clear_MORE_POST)
     end))).
 
@@ -90,14 +91,14 @@ Ltac2 rec fastforward_n (agro : bool) (n : int) :=
   match Int.equal n 0 with
   | true => Control.enter (fun () =>
     lazy_match! goal with
-    | [ |- semax _ _ _ _ ] => ()
+    | [ |- semax _ _ _ _ _ ] => ()
     | [ |- _ ] => ltac1:(clear_MORE_POST)
     end)
   | false =>
     let f := { contents := false } in
     Control.enter(fun () =>
       lazy_match! goal with
-      | [ |- semax _ _ _ _ ] => simplstep agro; f.(contents) := true
+      | [ |- semax _ _ _ _ _ ] => simplstep agro; f.(contents) := true
       | [ |- _ ] => ()
       end
     );
@@ -113,7 +114,7 @@ Tactic Notation "fastforward" integer(n) :=
     let f := { contents := false } in
     Control.enter(fun () =>
       lazy_match! goal with
-      | [ |- semax _ _ _ _ ] => simplstep false; f.(contents) := true
+      | [ |- semax _ _ _ _ _ ] => simplstep false; f.(contents) := true
       | [ |- _ ] => ()
       end
     );
@@ -124,7 +125,7 @@ Tactic Notation "fastforward" integer(n) :=
   ) in 
   do n step;
   lazymatch goal with
-  | |- semax _ _ _ _ => idtac
+  | |- semax _ _ _ _ _ => idtac
   | |- _ => clear_MORE_POST
   end.
 
@@ -134,7 +135,7 @@ Tactic Notation "fastforward!" integer(n) :=
     let f := { contents := false } in
     Control.enter(fun () =>
       lazy_match! goal with
-      | [ |- semax _ _ _ _ ] => simplstep true; f.(contents) := true
+      | [ |- semax _ _ _ _ _ ] => simplstep true; f.(contents) := true
       | [ |- _ ] => ()
       end
     );
@@ -145,6 +146,6 @@ Tactic Notation "fastforward!" integer(n) :=
   ) in 
   do n step;
   lazymatch goal with
-  | |- semax _ _ _ _ => idtac
+  | |- semax _ _ _ _ _ => idtac
   | |- _ => clear_MORE_POST
   end.
diff --git a/floyd/field_at.v b/floyd/field_at.v
index efa7219cf1..32b6da3cd1 100644
--- a/floyd/field_at.v
+++ b/floyd/field_at.v
@@ -1,4 +1,6 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.type_induction.
 Require Import VST.floyd.nested_pred_lemmas.
@@ -9,9 +11,10 @@ Require VST.floyd.aggregate_pred. Import VST.floyd.aggregate_pred.aggregate_pred
 Require Import VST.floyd.data_at_rec_lemmas.
 Require Import VST.floyd.jmeq_lemmas.
 Require Import VST.zlist.sublist.
+Require Import VST.floyd.local2ptree_typecheck.
 Import LiftNotation.
 
-Local Open Scope logic.
+Local Unset SsrRewrite.
 
 (************************************************
 
@@ -21,7 +24,7 @@ Definition of nested_reptype_structlist, field_at, array_at, data_at, nested_sfi
 
 Section CENV.
 
-Context {cs: compspecs}.
+Context `{!VSTGS OK_ty Σ} {cs: compspecs}.
 
 Lemma struct_Prop_cons2:
   forall it it' m (A: member -> Type)
@@ -54,8 +57,7 @@ Proof.
     destruct (member_dec a0 a0); [ | congruence].
     unfold eq_rect_r in H0; rewrite <- !eq_rect_eq in H0.
     simpl. auto.
-  +
-    revert H1.
+  + revert H1.
     change (struct_Prop (a0 :: a1 :: m) P0 v0) with
       (P0 a0 (fst v0) /\ struct_Prop (a1 :: m) P0 (snd v0)).
     change (struct_Prop (a0 :: a1 :: m) P1 v1) with
@@ -74,7 +76,7 @@ Proof.
       unfold eq_rect_r; rewrite <- !eq_rect_eq.
       intros. apply (H0 (fst v0) (fst v1)); auto.
       hnf. left; reflexivity.
-    -  destruct H1 as [_ H1]; revert H1.
+    - destruct H1 as [_ H1]; revert H1.
       apply IHm; clear IHm.
       assert (name_member a0 <> name_member a1) by (contradict H; left; auto).
       intros.
@@ -122,9 +124,10 @@ Proof.
 Qed.
 
 Definition field_at (sh: Share.t) (t: type) (gfs: list gfield) (v: reptype (nested_field_type t gfs)) (p: val): mpred :=
- !! (field_compatible t gfs p) &&
+ ⌜field_compatible t gfs p⌝ ∧
  at_offset (data_at_rec sh (nested_field_type t gfs) v) (nested_field_offset t gfs) p.
 Arguments field_at sh t gfs v p : simpl never.
+Global Typeclasses Opaque field_at.
 
 Definition field_at_ (sh: Share.t) (t: type) (gfs: list gfield) (p: val): mpred :=
   field_at sh t gfs (default_val (nested_field_type t gfs)) p.
@@ -132,6 +135,7 @@ Definition field_at_ (sh: Share.t) (t: type) (gfs: list gfield) (p: val): mpred
 Arguments field_at_ sh t gfs p : simpl never.
 
 Definition data_at (sh: Share.t) (t: type) (v: reptype t) := field_at sh t nil v.
+Global Typeclasses Opaque data_at.
 
 Definition data_at_ (sh: Share.t) (t: type) := field_at_ sh t nil.
 
@@ -143,7 +147,7 @@ Definition nested_reptype_unionlist t gfs (m: members) :=
 
 Lemma map_members_ext: forall A (f f':member -> A) (m: list member),
   members_no_replicate m = true ->
-  (forall i, in_members i m -> f (get_member i m)= f' (get_member i m)) ->
+  (forall i, in_members i m -> f (get_member i m) = f' (get_member i m)) ->
   map f m = map f' m.
 Proof.
   intros.
@@ -196,7 +200,7 @@ Defined.
 
 Definition nested_sfieldlist_at sh t gfs m (v: nested_reptype_structlist t gfs m) p: mpred :=
   match m with
-  | nil => (!! field_compatible t gfs p) && emp
+  | nil => ⌜field_compatible t gfs p⌝ ∧ emp
   | _ => struct_pred m (fun it v p =>
            withspacer sh
             (nested_field_offset t gfs +
@@ -208,7 +212,7 @@ Definition nested_sfieldlist_at sh t gfs m (v: nested_reptype_structlist t gfs m
 
 Definition nested_ufieldlist_at sh t gfs m (v: nested_reptype_unionlist t gfs m) (p: val): mpred :=
   match m with
-  | nil => (!! field_compatible t gfs p) && emp
+  | nil => ⌜field_compatible t gfs p⌝ ∧ emp
   | _ => union_pred m (fun it v p =>
            withspacer sh
             (nested_field_offset t gfs + sizeof (field_type (name_member it) m))
@@ -218,8 +222,8 @@ Definition nested_ufieldlist_at sh t gfs m (v: nested_reptype_unionlist t gfs m)
 
 Definition array_at (sh: Share.t) (t: type) (gfs: list gfield) (lo hi: Z)
   (v: list (reptype (nested_field_type t (ArraySubsc 0 :: gfs)))) (p: val) : mpred :=
-  !! (field_compatible0 t (ArraySubsc lo :: gfs) p /\
-      field_compatible0 t (ArraySubsc hi :: gfs) p) &&
+  ⌜field_compatible0 t (ArraySubsc lo :: gfs) p /\
+   field_compatible0 t (ArraySubsc hi :: gfs) p⌝ ∧
   array_pred lo hi
     (fun i v => at_offset (data_at_rec sh (nested_field_type t (ArraySubsc 0 :: gfs)) v)
        (nested_field_offset t (ArraySubsc i :: gfs))) v p.
@@ -235,112 +239,104 @@ field_compatible, local_facts, isptr and offset_zero properties
 
 Lemma field_at_local_facts:
   forall sh t path v c,
-     field_at sh t path v c |-- !! (field_compatible t path c /\ value_fits (nested_field_type t path) v).
+     field_at sh t path v c ⊢ ⌜field_compatible t path c /\ value_fits (nested_field_type t path) v⌝.
 Proof.
   intros.
-  unfold field_at.
-  rewrite prop_and; apply andp_derives; auto.
-  unfold at_offset.
-  apply data_at_rec_value_fits.
+  unfold field_at, at_offset.
+  rewrite data_at_rec_value_fits.
+  by iIntros "(% & %)"; iPureIntro.
 Qed.
 
 Lemma field_at_compatible':
  forall sh t path v c,
      field_at sh t path v c =
-     !! field_compatible t path c && field_at sh t path v c.
+     (⌜field_compatible t path c⌝ ∧ field_at sh t path v c).
 Proof.
 intros.
-apply pred_ext.
-apply andp_right; auto.
-eapply derives_trans; [apply field_at_local_facts | normalize].
-normalize.
+unfold field_at; normalize.
+f_equal; f_equal; apply prop_ext; tauto.
 Qed.
 
 Lemma field_at__local_facts: forall sh t gfs p,
-  field_at_ sh t gfs p |-- !! field_compatible t gfs p.
+  field_at_ sh t gfs p ⊢ ⌜field_compatible t gfs p⌝.
 Proof.
   intros.
   unfold field_at_, field_at.
- normalize.
+  normalize.
 Qed.
 
 Lemma data_at_local_facts:
-   forall sh t v p, data_at sh t v p |-- !! (field_compatible t nil p /\ value_fits t v).
+   forall sh t v p, data_at sh t v p ⊢ ⌜field_compatible t nil p /\ value_fits t v⌝.
 Proof. intros. apply field_at_local_facts. Qed.
 
-Lemma data_at__local_facts: forall sh t p, data_at_ sh t p |-- !! field_compatible t nil p.
+Lemma data_at__local_facts: forall sh t p, data_at_ sh t p ⊢ ⌜field_compatible t nil p⌝.
 Proof. intros.
   apply field_at__local_facts.
 Qed.
 
 Lemma array_at_local_facts: forall sh t gfs lo hi v p,
-  array_at sh t gfs lo hi v p |--
-    !! (field_compatible0 t (ArraySubsc lo :: gfs) p
+  array_at sh t gfs lo hi v p ⊢
+    ⌜field_compatible0 t (ArraySubsc lo :: gfs) p
         /\ field_compatible0 t (ArraySubsc hi :: gfs) p
         /\ Zlength v = hi - lo
-        /\ Forall (value_fits (nested_field_type t (ArraySubsc 0 :: gfs))) v).
+        /\ Forall (value_fits (nested_field_type t (ArraySubsc 0 :: gfs))) v⌝.
 Proof.
   intros.
   unfold array_at.
-  rewrite !prop_and.
-  rewrite <- andp_assoc.
-  apply andp_derives; auto.
-  eapply derives_trans; [apply array_pred_local_facts |].
-  + intros.
-    unfold at_offset.
-    instantiate (1 := fun x => value_fits _ x).
-    apply data_at_rec_value_fits.
- + normalize.
+  rewrite array_pred_local_facts.
+  2: { intros.
+       unfold at_offset.
+       apply data_at_rec_value_fits. }
+  normalize.
 Qed.
 
 Lemma array_at__local_facts: forall sh t gfs lo hi p,
-  array_at_ sh t gfs lo hi p |--
-    !! (field_compatible0 t (ArraySubsc lo :: gfs) p
-        /\ field_compatible0 t (ArraySubsc hi :: gfs) p).
+  array_at_ sh t gfs lo hi p ⊢
+    ⌜field_compatible0 t (ArraySubsc lo :: gfs) p
+        /\ field_compatible0 t (ArraySubsc hi :: gfs) p⌝.
 Proof.
   intros.
   unfold array_at_.
-  eapply derives_trans; [apply array_at_local_facts; eauto | ].
-  apply prop_derives; intuition.
+  rewrite array_at_local_facts; eauto.
+  apply bi.pure_mono; intuition.
 Qed.
 
 Lemma field_at_isptr: forall sh t gfs v p,
-  field_at sh t gfs v p = (!! isptr p) && field_at sh t gfs v p.
-Proof. intros. eapply local_facts_isptr; [apply field_at_local_facts | intros [? ?]; auto]. Qed.
+  field_at sh t gfs v p = (⌜isptr p⌝ ∧ field_at sh t gfs v p).
+Proof.
+  intros. unfold field_at.
+  normalize.
+  do 2 f_equal; apply prop_ext; split; last tauto.
+  intros (? & ?); split3; auto.
+Qed.
 
 Lemma field_at_offset_zero: forall sh t gfs v p,
   field_at sh t gfs v p = field_at sh t gfs v (offset_val 0 p).
-Proof. intros. apply local_facts_offset_zero.
- intros. rewrite field_at_isptr; normalize.
+Proof.
+  intros. unfold field_at.
+  destruct p; try done; simpl.
+  rewrite Ptrofs.add_zero; auto.
 Qed.
 
 Lemma field_at__isptr: forall sh t gfs p,
-  field_at_ sh t gfs p = (!! isptr p) && field_at_ sh t gfs p.
-Proof. intros.
- intros. eapply local_facts_isptr; [apply field_at__local_facts | intros [? ?]; auto].
-Qed.
+  field_at_ sh t gfs p = (⌜isptr p⌝ ∧ field_at_ sh t gfs p).
+Proof. intros; apply field_at_isptr. Qed.
 
 Lemma field_at__offset_zero: forall sh t gfs p,
   field_at_ sh t gfs p = field_at_ sh t gfs (offset_val 0 p).
-Proof. intros. apply local_facts_offset_zero.
- intros. rewrite field_at__isptr; normalize.
-Qed.
+Proof. intros; apply field_at_offset_zero. Qed.
 
-Lemma data_at_isptr: forall sh t v p, data_at sh t v p = !!(isptr p) && data_at sh t v p.
-Proof. intros. eapply local_facts_isptr; [apply data_at_local_facts | intros [? ?]; auto].
-Qed.
+Lemma data_at_isptr: forall sh t v p, data_at sh t v p = (⌜isptr p⌝ ∧ data_at sh t v p).
+Proof. intros; apply field_at_isptr. Qed.
 
 Lemma data_at_offset_zero: forall sh t v p, data_at sh t v p = data_at sh t v (offset_val 0 p).
-Proof. intros. rewrite <- local_facts_offset_zero. reflexivity.
-    intros; rewrite data_at_isptr; normalize.
-Qed.
+Proof. intros; apply field_at_offset_zero. Qed.
 
-Lemma data_at__isptr: forall sh t p, data_at_ sh t p = !!(isptr p) && data_at_ sh t p.
-Proof. intros. eapply local_facts_isptr; [apply data_at__local_facts | intros [? ?]; auto].
-Qed.
+Lemma data_at__isptr: forall sh t p, data_at_ sh t p = (⌜isptr p⌝ ∧ data_at_ sh t p).
+Proof. intros; apply data_at_isptr. Qed.
 
 Lemma data_at__offset_zero: forall sh t p, data_at_ sh t p = data_at_ sh t (offset_val 0 p).
-Proof. intros. apply field_at__offset_zero. Qed.
+Proof. intros; apply field_at__offset_zero. Qed.
 
 (************************************************
 
@@ -354,9 +350,9 @@ Lemma array_at_ext_derives: forall sh t gfs lo hi v0 v1 p,
      lo <= i < hi ->
      JMeq u0 (Znth (i-lo) v0) ->
      JMeq u1 (Znth (i-lo) v1) ->
-     field_at sh t (ArraySubsc i :: gfs) u0 p |--
+     field_at sh t (ArraySubsc i :: gfs) u0 p ⊢
      field_at sh t (ArraySubsc i :: gfs) u1 p) ->
-  array_at sh t gfs lo hi v0 p |-- array_at sh t gfs lo hi v1 p.
+  array_at sh t gfs lo hi v0 p ⊢ array_at sh t gfs lo hi v1 p.
 Proof.
   intros until p. intro ZL; intros.
   unfold array_at, field_at.
@@ -376,6 +372,19 @@ Proof.
   auto.
 Qed.
 
+Lemma andp_prop_eq : forall P P' (Q Q' : mpred) (Hdec : {P} + {~P} ),
+  (P <-> P') -> (P -> Q = Q') -> (⌜P⌝ ∧ Q) = (⌜P'⌝ ∧ Q').
+Proof.
+  intros.
+  destruct Hdec; [rewrite !prop_true_andp by tauto | rewrite !prop_false_andp by tauto]; auto.
+Qed.
+
+Lemma andp_prop_eq1 : forall P (Q Q' : mpred) (Hdec : {P} + {~P} ), (P -> Q = Q') ->
+  (⌜P⌝ ∧ Q) = (⌜P⌝ ∧ Q').
+Proof.
+  intros; apply andp_prop_eq; auto.
+Qed.
+
 Lemma array_at_ext: forall sh t gfs lo hi v0 v1 p,
   Zlength v0 = Zlength v1 ->
   (forall i u0 u1,
@@ -387,9 +396,18 @@ Lemma array_at_ext: forall sh t gfs lo hi v0 v1 p,
   array_at sh t gfs lo hi v0 p = array_at sh t gfs lo hi v1 p.
 Proof.
   intros.
-  apply pred_ext; apply array_at_ext_derives; intros; auto.
-  erewrite H0 by eauto; auto.
-  erewrite <- H0 by eauto; auto.
+  unfold array_at.
+  apply andp_prop_eq1.
+  { destruct (field_compatible0_dec t (gfs SUB lo) p); [|right; tauto].
+    destruct (field_compatible0_dec t (gfs SUB hi) p); [left | right]; tauto. }
+  intros (? & ?).
+  apply aggregate_pred.array_pred_eq; auto.
+  intros.
+  specialize (H0 i).
+  unfold field_at in H0.
+  rewrite @nested_field_type_ArraySubsc with (i := i) in H0.
+  assert (field_compatible t (gfs SUB i) p) as Hcompat by (eapply (field_compatible_range _ lo hi); eauto).
+  setoid_rewrite <- (prop_true_andp _ _ Hcompat); auto.
 Qed.
 
 (************************************************
@@ -413,19 +431,20 @@ Proof.
   intros.
   rewrite data_at_rec_eq.
   rewrite at_offset_array_pred.
-  f_equal.
-  + apply ND_prop_ext.
-    rewrite !field_compatible0_cons, H0.
+  apply andp_prop_eq.
+  { apply field_compatible_dec. }
+  + rewrite !field_compatible0_cons, H0.
     assert (0 <= 0 <= n) by lia.
     assert (0 <= n <= n) by lia.
     tauto.
-  + apply (JMeq_trans (unfold_reptype_JMeq _ v1)) in H2.
+  + intros.
+    apply (JMeq_trans (unfold_reptype_JMeq _ v1)) in H2.
     forget (unfold_reptype v1) as v1'.
     clear v1.
     cbv iota beta in v1'.
     apply JMeq_eq in H2.
     rewrite Z.max_r by lia.
-    apply array_pred_ext.
+    apply aggregate_pred.array_pred_eq.
     - subst; auto.
     - intros.
       rewrite at_offset_eq.
@@ -434,21 +453,18 @@ Proof.
       rewrite (nested_field_offset_ind t (ArraySubsc i :: gfs))
         by (apply legal_nested_field0_field; simpl; unfold legal_field; rewrite H0; auto).
       rewrite H0.
-      f_equal.
       subst; auto.
 Qed.
 
-Lemma not_ptr_FF: forall A p, (A |-- !! isptr p) <-> (~ isptr p -> A = FF).
+Lemma not_ptr_False {prop:bi}: forall  (A : prop) p, (A ⊢ ⌜isptr p⌝) <-> (~ isptr p -> A ⊣⊢ False).
 Proof.
   intros.
   split; intros.
-  + apply pred_ext; [| apply FF_left].
-    eapply derives_trans; [eauto |].
-    apply prop_derives.
-    auto.
-  + destruct p; try solve [rewrite H by (simpl; congruence); apply FF_left].
-    simpl.
-    apply TT_right.
+  + iSplit; last by iIntros "[]".
+    rewrite H; iIntros (?); done.
+  + destruct (isptr_dec p); first by iIntros "_".
+    rewrite H; last done.
+    iIntros "[]".
 Qed.
 
 Ltac solve_ptr_derives :=
@@ -456,40 +472,40 @@ Ltac solve_ptr_derives :=
   apply derives_refl.
 
 Lemma field_at_isptr':
-  forall sh t path v c, field_at sh t path v c |-- !! isptr c.
+  forall sh t path v c, field_at sh t path v c ⊢ ⌜isptr c⌝.
 Proof.
 intros.
-eapply derives_trans; [apply field_at_local_facts | ].
-apply prop_derives; intros [? _]; auto.
+rewrite field_at_local_facts.
+iIntros "(($ & _) & _)".
 Qed.
 
 Ltac solve_nptr p A :=
   let H := fresh "H" in
   match A with
-  | (?B * ?C) % logic =>
-     try solve [assert (~ isptr p -> B = FF) as H by solve_nptr p B;
-                intro; rewrite H by auto ; apply FF_sepcon];
-     try solve [assert (~ isptr p -> C = FF) as H by solve_nptr p C;
-                intro; rewrite H by auto; apply sepcon_FF]
-  | (?B && ?C) % logic =>
-     try solve [assert (~ isptr p -> B = FF) as H by solve_nptr p B;
-                intro; rewrite H by auto ; apply FF_andp];
-     try solve [assert (~ isptr p -> C = FF) as H by solve_nptr p C;
-                intro; rewrite H by auto; apply andp_FF]
-  | _ => apply (proj1 (not_ptr_FF A p)); solve_ptr p A
+  | (?B ∗ ?C) =>
+     try solve [assert (~ isptr p -> B ⊣⊢ False) as H by solve_nptr p B;
+                intro; rewrite H by auto; apply bi.False_sep];
+     try solve [assert (~ isptr p -> C ⊣⊢ False) as H by solve_nptr p C;
+                intro; rewrite H by auto; apply bi.sep_False]
+  | (?B ∧ ?C) =>
+     try solve [assert (~ isptr p -> B ⊣⊢ False) as H by solve_nptr p B;
+                intro; rewrite H by auto; apply bi.False_and];
+     try solve [assert (~ isptr p -> C ⊣⊢ False) as H by solve_nptr p C;
+                intro; rewrite H by auto; apply bi.and_False]
+  | _ => apply (proj1 (not_ptr_False A p)); solve_ptr p A
   end
 with solve_ptr p A :=
   let p0 := fresh "p" in
   match A with
-  | (_ * _) % logic => apply (proj2 (not_ptr_FF A p)); solve_nptr p A
-  | (_ && _) % logic => apply (proj2 (not_ptr_FF A p)); solve_nptr p A
-  | (!! _ /\ _)%logic => destruct A as [_ A]; solve_ptr p A
-  | (!! field_compatible _ _ ?q) => apply (derives_trans _ _ _ (prop_derives _ _ (field_compatible_isptr _ _ _))); solve_ptr_derives
-  | (!! field_compatible0 _ _ ?q) => apply (derives_trans _ _ _ (prop_derives _ _ (field_compatible0_isptr _ _ _))); solve_ptr_derives
-  | (memory_block _ _ ?q) => apply (derives_trans _ _ _ (memory_block_local_facts _ _ _)); solve_ptr_derives
+  | (_ ∗ _) => apply (proj2 (not_ptr_False A p)); solve_nptr p A
+  | (_ ∧ _) => apply (proj2 (not_ptr_False A p)); solve_nptr p A
+  | ⌜_ /\ _⌝ => destruct A as [_ A]; solve_ptr p A
+  | ⌜field_compatible _ _ ?q⌝ => etrans; first apply (bi.pure_mono _ _ (field_compatible_isptr _ _ _)); solve_ptr_derives
+  | ⌜field_compatible0 _ _ ?q⌝ => etrans; first apply (bi.pure_mono _ _ (field_compatible0_isptr _ _ _)); solve_ptr_derives
+  | (memory_block _ _ ?q) => etrans; first apply (memory_block_local_facts _ _ _); solve_ptr_derives
   | (withspacer _ _ _ ?P p) => apply withspacer_preserve_local_facts;
                                      intro p0; solve_ptr p0 (P p0)
-  | (at_offset ?P _ ?q) => apply (derives_trans _ (!! isptr q));
+  | (at_offset ?P _ ?q) => trans ⌜isptr q⌝;
                            [apply at_offset_preserve_local_facts; intro p0; solve_ptr p0 (P p0) |
                             solve_ptr_derives]
   | (field_at _ _ _ _ p) => apply field_at_isptr'
@@ -499,18 +515,18 @@ Ltac destruct_ptr p :=
   let b := fresh "b" in
   let ofs := fresh "OFS" in
   match goal with
-  | |- (@eq mpred) ?A ?B =>
+  | |- ?A ⊣⊢ ?B =>
        let H := fresh "H" in
        let H0 := fresh "H" in
-       assert (~ isptr p -> A = FF) as H by solve_nptr p A;
-       assert (~ isptr p -> B = FF) as H0 by solve_nptr p B;
+       assert (~ isptr p -> A ⊣⊢ False) as H by solve_nptr p A;
+       assert (~ isptr p -> B ⊣⊢ False) as H0 by solve_nptr p B;
        destruct p as [| | | | | b ofs]; try (rewrite H, H0 by (simpl; congruence); reflexivity);
        clear H H0;
        inv_int ofs
-  | |- (?A |-- _) =>
+  | |- (?A ⊢ _) =>
        let H := fresh "H" in
-       assert (~ isptr p -> A = FF) as H by solve_nptr p A;
-       destruct p as [| | | | | b ofs]; try (rewrite H by (simpl; congruence); apply FF_left);
+       assert (~ isptr p -> A ⊣⊢ False) as H by solve_nptr p A;
+       destruct p as [| | | | | b ofs]; try (rewrite H by (simpl; congruence); apply bi.False_elim);
        clear H;
        inv_int ofs
   end.
@@ -518,14 +534,14 @@ Ltac destruct_ptr p :=
 Lemma field_at_Tstruct: forall sh t gfs id a v1 v2 p,
   nested_field_type t gfs = Tstruct id a ->
   JMeq v1 v2 ->
-  field_at sh t gfs v1 p = nested_sfieldlist_at sh t gfs (co_members (get_co id)) v2 p.
+  field_at sh t gfs v1 p ⊣⊢ nested_sfieldlist_at sh t gfs (co_members (get_co id)) v2 p.
 Proof.
   intros.
   unfold field_at, nested_sfieldlist_at.
   revert v1 H0; rewrite H; intros.
   rewrite data_at_rec_eq.
   rewrite at_offset_struct_pred.
-  rewrite andp_struct_pred by apply corable_prop.
+  rewrite andp_struct_pred; [| apply _..].
   generalize (co_members (get_co id)) at 1 10; intro m; destruct m; [auto |].
   apply struct_pred_ext; [apply get_co_members_no_replicate |].
 
@@ -546,14 +562,14 @@ Proof.
     by (clear - n H H1; unfold field_compatible; simpl in *; rewrite H in *; simpl in *; tauto).
     rewrite !prop_false_andp by auto; auto.
   }
-  f_equal.
+  f_equiv.
   {
-   f_equal.
+   f_equiv.
    unfold field_compatible.
-   f_equal. f_equal. f_equal. f_equal.
-   simpl. apply prop_ext.
+   do 4 f_equiv.
+   simpl.
    split; intro; try tauto. split; auto.
-    rewrite H. simpl. rewrite name_member_get. auto.
+   rewrite H. simpl. rewrite name_member_get. auto.
   }
   replace  (field_offset cenv_cs (name_member (get_member i (co_members (get_co id)))))
    with  (field_offset cenv_cs i)
@@ -561,24 +577,23 @@ Proof.
   replace  (field_offset_next cenv_cs (name_member (get_member i (co_members (get_co id)))))
    with  (field_offset_next cenv_cs i)
     by (rewrite name_member_get; auto).
-  f_equal.
-  f_equal.
+  apply bi.sep_proper.
+  f_equiv.
   rewrite name_member_get.
   change (sizeof ?A) with (expr.sizeof A) in *.
-  rewrite sizeof_Tstruct. lia.
-  f_equal. f_equal.
+  rewrite sizeof_Tstruct. hnf; lia.
+  hnf; f_equal. f_equal.
   rewrite name_member_get.  lia.
-  match goal with |- data_at_rec _ _ _ ?A = data_at_rec _ _ _ ?B => replace B with A end.
- 2:{ f_equal. f_equal.
+  match goal with |- data_at_rec _ _ _ ?A ⊣⊢ data_at_rec _ _ _ ?B => replace B with A end.
+  2:{ f_equal. f_equal.
   rewrite name_member_get.
   rewrite @nested_field_offset_ind with (gfs := StructField i :: gfs) by auto.
   unfold gfield_offset; rewrite H. lia.
   }
-  apply equal_f.
-  apply data_at_rec_type_changable.
-  rewrite nested_field_type_ind.
-      simpl; rewrite H.
-      auto.
+  erewrite data_at_rec_type_changable; first done.
+  { rewrite nested_field_type_ind.
+    simpl; rewrite H.
+    auto. }
   apply (proj_compact_prod_JMeq _ (get_member i _) (co_members (get_co id)) _ _ (unfold_reptype v1) v2); auto.
       * intros.
         rewrite nested_field_type_ind, H.
@@ -593,14 +608,14 @@ Qed.
 Lemma field_at_Tunion: forall sh t gfs id a v1 v2 p,
   nested_field_type t gfs = Tunion id a ->
   JMeq v1 v2 ->
-  field_at sh t gfs v1 p = nested_ufieldlist_at sh t gfs (co_members (get_co id)) v2 p.
+  field_at sh t gfs v1 p ⊣⊢ nested_ufieldlist_at sh t gfs (co_members (get_co id)) v2 p.
 Proof.
   intros.
   unfold field_at, nested_ufieldlist_at.
   revert v1 H0; rewrite H; intros.
   rewrite data_at_rec_eq.
   rewrite at_offset_union_pred.
-  rewrite andp_union_pred by apply corable_prop.
+  rewrite andp_union_pred; [| apply _..].
   generalize (eq_refl (co_members (get_co id))).
   generalize (co_members (get_co id)) at 2 3 9; intro m; destruct m; [auto |].
   intro HH; assert (co_members (get_co id) <> nil) by congruence; clear HH.
@@ -621,29 +636,28 @@ Proof.
   normalize.
   destruct (legal_nested_field_dec t (UnionField i :: gfs)).
   2:{
-    replace (!!field_compatible t (UnionField (name_member (get_member i (co_members (get_co id)))) :: gfs) (Vptr b (Ptrofs.repr ofs)) : mpred) with (FF: mpred)
-     by (rewrite name_member_get; apply ND_prop_ext; unfold field_compatible; tauto).
+    rewrite (bi.pure_False (field_compatible t (UnionField _ :: _) _))
+      by (rewrite name_member_get; unfold field_compatible; tauto).
     simpl in n.
     rewrite H in n.
     simpl in n.
-    replace (!!field_compatible t gfs (Vptr b (Ptrofs.repr ofs)) : mpred) with (FF: mpred)
-      by (apply ND_prop_ext; unfold field_compatible; tauto).
-    normalize.
+    rewrite bi.pure_False by (unfold field_compatible; tauto).
+    iSplit; iIntros "([] & ?)".
   }
-  f_equal.
-  apply ND_prop_ext.
+  f_equiv.
+  apply bi.pure_iff.
   rewrite name_member_get, field_compatible_cons, H; tauto.
-  f_equal. rewrite name_member_get.
-  f_equal. rewrite sizeof_Tunion. lia.
-  f_equal. f_equal. lia.
-  match goal with |- data_at_rec _ _ _ ?A = data_at_rec _ _ _ ?B => replace B with A end.
- 2:{ f_equal. f_equal.
+  apply bi.sep_proper.
+  rewrite name_member_get.
+  f_equiv. rewrite sizeof_Tunion. hnf; lia.
+  hnf; f_equal. f_equal. lia.
+  match goal with |- data_at_rec _ _ _ ?A ⊣⊢ data_at_rec _ _ _ ?B => replace B with A end.
+  2:{ f_equal. f_equal.
   rewrite name_member_get.
   rewrite @nested_field_offset_ind with (gfs := UnionField i :: gfs) by auto.
   unfold gfield_offset; rewrite H. lia.
   }
-  apply equal_f.
-  apply data_at_rec_type_changable.
+  erewrite data_at_rec_type_changable; first done.
   rewrite name_member_get.
   rewrite nested_field_type_ind.
   rewrite H; reflexivity.
@@ -657,12 +671,12 @@ Proof.
 Qed.
 
 Lemma array_at_len_0: forall sh t gfs i p,
-  array_at sh t gfs i i nil p = !! (field_compatible0 t (ArraySubsc i :: gfs) p) && emp.
+  array_at sh t gfs i i nil p = (⌜field_compatible0 t (ArraySubsc i :: gfs) p⌝ ∧ emp).
 Proof.
   intros.
   unfold array_at.
   rewrite array_pred_len_0 by lia.
-  apply pred_ext; normalize.
+  f_equal; f_equal; apply prop_ext; tauto.
 Qed.
 
 Lemma array_at_len_1: forall sh t gfs i v v' p,
@@ -676,8 +690,7 @@ Proof.
   rewrite @nested_field_type_ArraySubsc with (i := i).
   intros.
   apply JMeq_eq in H; rewrite H.
-  f_equal.
-  apply ND_prop_ext.
+  f_equal; f_equal; apply prop_ext.
   rewrite field_compatible_field_compatible0'.
   reflexivity.
 Qed.
@@ -686,13 +699,15 @@ Lemma split2_array_at: forall sh t gfs lo mid hi v p,
   lo <= mid <= hi ->
   Zlength v = hi - lo ->
   array_at sh t gfs lo hi v p =
-  array_at sh t gfs lo mid (sublist 0 (mid-lo) v) p *
-  array_at sh t gfs mid hi (sublist (mid-lo) (Zlength v) v) p.
+  (array_at sh t gfs lo mid (sublist 0 (mid-lo) v) p ∗
+   array_at sh t gfs mid hi (sublist (mid-lo) (Zlength v) v) p).
 Proof.
   intros.
   unfold array_at.
   normalize.
-  apply andp_prop_ext.
+  apply andp_prop_eq.
+  { destruct (field_compatible0_dec t (gfs SUB lo) p); [|right; tauto].
+    destruct (field_compatible0_dec t (gfs SUB hi) p); [left | right]; tauto. }
   + split; [| tauto].
     intros [? ?].
     assert (field_compatible0 t (gfs SUB mid) p) by (apply (field_compatible0_range _ lo hi); auto).
@@ -708,13 +723,13 @@ Lemma split3seg_array_at: forall sh t gfs lo ml mr hi v p,
   mr <= hi ->
   Zlength v = hi-lo ->
   array_at sh t gfs lo hi v p =
-    array_at sh t gfs lo ml (sublist 0 (ml-lo) v) p*
-    array_at sh t gfs ml mr (sublist (ml-lo) (mr-lo) v) p *
-    array_at sh t gfs mr hi (sublist (mr-lo) (hi-lo) v) p.
+    (array_at sh t gfs lo ml (sublist 0 (ml-lo) v) p ∗
+     array_at sh t gfs ml mr (sublist (ml-lo) (mr-lo) v) p ∗
+     array_at sh t gfs mr hi (sublist (mr-lo) (hi-lo) v) p).
 Proof.
   intros.
   rewrite split2_array_at with (lo := lo) (mid := ml) (hi := hi) by lia.
-  rewrite sepcon_assoc; f_equal.
+  f_equal.
   assert (Zlength (sublist (ml - lo) (hi - lo) v) = hi - ml).
   {
     replace (hi - ml) with (hi - lo - (ml - lo)) by lia.
@@ -723,9 +738,9 @@ Proof.
   rewrite H2.
   rewrite split2_array_at with (lo := ml) (mid := mr) (hi := hi) by lia.
   f_equal.
-  rewrite sublist_sublist; try lia. f_equal.  f_equal; lia.
+  rewrite sublist_sublist; try lia. f_equiv. f_equal; lia.
   rewrite Zlength_sublist by lia.
-  rewrite sublist_sublist; try lia. f_equal.  f_equal; lia.
+  rewrite sublist_sublist; try lia. f_equiv. f_equal; lia.
 Qed.
 
 Lemma split3_array_at: forall sh t gfs lo mid hi v v0 p,
@@ -733,15 +748,14 @@ Lemma split3_array_at: forall sh t gfs lo mid hi v v0 p,
   Zlength v = hi-lo ->
   JMeq v0 (Znth (mid-lo) v) ->
   array_at sh t gfs lo hi v p =
-    array_at sh t gfs lo mid (sublist 0 (mid-lo) v) p *
-    field_at sh t (ArraySubsc mid :: gfs) v0 p *
-    array_at sh t gfs (mid + 1) hi (sublist (mid+1-lo) (hi-lo) v) p.
+    (array_at sh t gfs lo mid (sublist 0 (mid-lo) v) p ∗
+     field_at sh t (ArraySubsc mid :: gfs) v0 p ∗
+     array_at sh t gfs (mid + 1) hi (sublist (mid+1-lo) (hi-lo) v) p).
 Proof.
   intros.
   rename H0 into e; rename H1 into H0.
   rewrite split3seg_array_at with (ml := mid) (mr := mid + 1) by lia.
-  f_equal.
-  f_equal.
+  f_equal. f_equal.
   replace (mid + 1 - lo) with (mid - lo + 1) by lia.
   rewrite sublist_len_1 by lia.
   rewrite array_at_len_1 with (v' :=v0); [auto |].
@@ -763,17 +777,20 @@ Proof.
   rewrite (nested_field_offset_ind (nested_field_type t gfs) nil) by (simpl; tauto).
   unfold field_address.
   if_tac.
-  + unfold at_offset; normalize.
-    rewrite prop_true_andp; [auto |].
-    destruct p; try (destruct H; contradiction).
-    generalize (field_compatible_nested_field t gfs (Vptr b i));
-    unfold at_offset; solve_mod_modulus; intros. auto.
-  + apply pred_ext; normalize. destruct H0; contradiction.
+  + f_equal.
+    * f_equal.
+      apply prop_ext; split; auto.
+      apply field_compatible_nested_field.
+    * unfold at_offset.
+      rewrite isptr_offset_val_zero by (destruct H; auto).
+      done.
+  + rewrite !prop_false_andp; auto.
+    intros (? & ?); contradiction.
 Qed.
 
 Lemma field_at_data_at' : forall sh t gfs v p, field_at sh t gfs v p =
-  !!field_compatible t gfs p &&
-  data_at sh (nested_field_type t gfs) v (offset_val (nested_field_offset t gfs) p).
+  (⌜field_compatible t gfs p⌝ ∧
+   data_at sh (nested_field_type t gfs) v (offset_val (nested_field_offset t gfs) p)).
 Proof.
   intros.
   rewrite field_at_data_at.
@@ -788,27 +805,24 @@ Lemma field_at__data_at_: forall sh t gfs p,
   field_at_ sh t gfs p =
   data_at_ sh (nested_field_type t gfs) (field_address t gfs p).
 Proof.
-  intros.
-  unfold data_at_, field_at_. apply field_at_data_at.
+  intros. apply field_at_data_at.
 Qed.
 
 Lemma lifted_field_at_data_at: forall sh t gfs v p,
-  `(field_at sh t gfs) v p =
-  `(data_at sh (nested_field_type t gfs)) v (`(field_address t gfs) p).
+  assert_of (`(field_at sh t gfs) v p) =
+  assert_of (`(data_at sh (nested_field_type t gfs)) v (`(field_address t gfs) p)).
 Proof.
   intros.
-  extensionality rho.
-  unfold liftx, lift; simpl.
+  apply assert_ext; intros; unfold_lift.
   apply field_at_data_at.
 Qed.
 
 Lemma lifted_field_at__data_at_: forall sh t gfs p,
-  `(field_at_ sh t gfs) p =
-  `(data_at_ sh (nested_field_type t gfs)) (`(field_address t gfs) p).
+  assert_of (`(field_at_ sh t gfs) p) =
+  assert_of (`(data_at_ sh (nested_field_type t gfs)) (`(field_address t gfs) p)).
 Proof.
   intros.
-  extensionality rho.
-  unfold liftx, lift; simpl.
+  apply assert_ext; intros; unfold_lift.
   apply field_at__data_at_.
 Qed.
 
@@ -823,10 +837,10 @@ Qed.
 Lemma array_at_data_at: forall sh t gfs lo hi v p,
   lo <= hi ->
   array_at sh t gfs lo hi v p =
-  (!! field_compatible0 t (ArraySubsc lo :: gfs) p) &&
-  (!! field_compatible0 t (ArraySubsc hi :: gfs) p) &&
+  (⌜field_compatible0 t (ArraySubsc lo :: gfs) p⌝ ∧
+  ⌜field_compatible0 t (ArraySubsc hi :: gfs) p⌝ ∧
   at_offset (data_at sh (nested_field_array_type t gfs lo hi) v)
-               (nested_field_offset t (ArraySubsc lo :: gfs)) p.
+               (nested_field_offset t (ArraySubsc lo :: gfs)) p).
 Proof.
   intros.
   unfold array_at.
@@ -838,11 +852,12 @@ Proof.
   rewrite data_at_rec_eq.
   rewrite <- at_offset_eq.
   normalize.
-  apply andp_prop_ext.
-  f_equal.
+  apply andp_prop_eq.
+  { destruct (field_compatible0_dec t (gfs SUB lo) p); [|right; tauto].
+    destruct (field_compatible0_dec t (gfs SUB hi) p); [left | right]; tauto. }
   + pose proof field_compatible0_nested_field_array t gfs lo hi p.
     tauto.
-  + intros [? ?].
+  + intros (? & ?).
     rewrite at_offset_eq, <- at_offset_eq2.
     rewrite at_offset_array_pred.
     rewrite Z.max_r by lia.
@@ -850,20 +865,19 @@ Proof.
     intros.
     rewrite at_offset_eq at 1.
     rewrite at_offset_eq, <- at_offset_eq2, at_offset_eq.
-    f_equal.
-    f_equal.
-    f_equal.
+    f_equiv.
+    f_equiv.
     rewrite @nested_field_offset_ind with (gfs := nil) by (apply (field_compatible0_nested_field_array t gfs lo hi p); auto).
-    assert (field_compatible0 t (gfs SUB i') p)
+    assert (field_compatible0 t (gfs SUB i') p) as Hcompat
       by (apply (field_compatible0_range _ lo hi); auto; lia).
     rewrite @nested_field_offset_ind with (gfs := ArraySubsc i' :: _) by auto.
     rewrite @nested_field_offset_ind with (gfs := ArraySubsc lo :: _) by auto.
     rewrite @nested_field_type_ind with (gfs := ArraySubsc 0 :: _).
-    rewrite field_compatible0_cons in H4.
+    rewrite field_compatible0_cons in Hcompat.
     destruct (nested_field_type t gfs); try tauto.
     unfold gfield_offset, gfield_type.
     assert (sizeof t0 * i' = sizeof t0 * lo + sizeof t0 * i)%Z by (rewrite Zred_factor4; f_equal; lia).
-    lia.
+    hnf; lia.
 Qed.
 
 Lemma array_at_data_at':
@@ -879,7 +893,7 @@ Proof.
   rewrite array_at_data_at by auto.
   rewrite !prop_true_andp by auto.
   unfold at_offset.
-  f_equal.
+  f_equiv.
   unfold field_address0.
   rewrite if_true; auto.
 Qed.
@@ -899,10 +913,8 @@ Proof.
   if_tac.
   + rewrite !prop_true_andp by auto.
     auto.
-  + apply pred_ext.
-    - normalize.
-    - rewrite data_at_isptr.
-      normalize.
+  + rewrite (data_at_isptr _ _ _ Vundef).
+    rewrite !prop_false_andp by auto; done.
 Qed.
 
 Lemma array_at_data_at''':
@@ -927,10 +939,8 @@ Proof.
       lia.
     - rewrite !prop_true_andp by auto.
       auto.
-  + apply pred_ext.
-    - normalize.
-    - rewrite data_at_isptr.
-      normalize.
+  + rewrite (data_at_isptr _ _ _ Vundef).
+    rewrite !prop_false_andp by auto; done.
 Qed.
 
 Lemma split3seg_array_at': forall sh t gfs lo ml mr hi v p,
@@ -939,18 +949,19 @@ Lemma split3seg_array_at': forall sh t gfs lo ml mr hi v p,
   mr <= hi ->
   Zlength v = hi-lo ->
   array_at sh t gfs lo hi v p =
-    array_at sh t gfs lo ml (sublist 0 (ml-lo) v) p*
-    data_at sh (nested_field_array_type t gfs ml mr)
+    (array_at sh t gfs lo ml (sublist 0 (ml-lo) v) p ∗
+     data_at sh (nested_field_array_type t gfs ml mr)
         (sublist (ml-lo) (mr-lo) v)
-               (field_address0 t (ArraySubsc ml::gfs) p) *
-    array_at sh t gfs mr hi (sublist (mr-lo) (hi-lo) v) p.
+               (field_address0 t (ArraySubsc ml::gfs) p) ∗
+     array_at sh t gfs mr hi (sublist (mr-lo) (hi-lo) v) p).
 Proof.
   intros.
   rewrite (split3seg_array_at sh t gfs lo ml mr hi); auto.
-  rewrite (add_andp _ _ (array_at_local_facts sh t gfs mr hi _ _)).
-  normalize.
-  apply andp_prop_ext; [tauto |].
-  intros [? [? _]].
+  unfold array_at at 3 5; normalize.
+  apply andp_prop_eq1.
+  { destruct (field_compatible0_dec t (gfs SUB mr) p); [|right; tauto].
+    destruct (field_compatible0_dec t (gfs SUB hi) p); [left | right]; tauto. }
+  intros (? & ?).
   rewrite (array_at_data_at'' sh t gfs ml mr); auto.
 Qed.
 
@@ -961,13 +972,13 @@ Lemmas about underscore and memory_block
 ************************************************)
 
 Lemma field_at_field_at_: forall sh t gfs v p,
-  field_at sh t gfs v p |-- field_at_ sh t gfs p.
+  field_at sh t gfs v p ⊢ field_at_ sh t gfs p.
 Proof.
   intros.
   destruct (field_compatible_dec t gfs p).
   + destruct_ptr p.
     unfold field_at_, field_at.
-    apply andp_derives; auto.
+    apply bi.and_mono; first done.
     pose proof field_compatible_nested_field _ _ _ f.
     unfold field_compatible in H, f.
     unfold offset_val in H.
@@ -990,14 +1001,14 @@ Qed.
 
 Lemma field_at_field_at_default : forall sh t gfs v v' p,
   v' = default_val (nested_field_type t gfs) ->
-  field_at sh t gfs v p |-- field_at sh t gfs v' p.
+  field_at sh t gfs v p ⊢ field_at sh t gfs v' p.
 Proof.
   intros; subst.
   apply field_at_field_at_.
 Qed.
 
 Lemma field_at__memory_block: forall sh t gfs p,
-  field_at_ sh t gfs p =
+  field_at_ sh t gfs p ⊣⊢
   memory_block sh (sizeof (nested_field_type t gfs)) (field_address t gfs p).
 Proof.
   intros.
@@ -1021,10 +1032,10 @@ Proof.
     change (sizeof ?A) with (expr.sizeof A) in *.
     rewrite (Z.mod_small ofs) in * by lia.
     rewrite (Z.mod_small (ofs + nested_field_offset t gfs)) in H by (pose proof base.sizeof_pos (nested_field_type t gfs); lia).
-    rewrite memory_block_data_at_rec_default_val; try tauto; unfold expr.sizeof in *; try lia.
+    rewrite memory_block_data_at_rec_default_val; first done; try tauto; unfold expr.sizeof in *; try lia.
   + unfold field_at_, field_at.
     rewrite memory_block_isptr.
-    apply pred_ext; normalize.
+    apply bi.equiv_entails_2; normalize.
 Qed.
 
 Lemma mapsto_zero_data_at_zero:
@@ -1033,7 +1044,7 @@ Lemma mapsto_zero_data_at_zero:
     complete_legal_cosu_type t = true ->
     fully_nonvolatile (rank_type cenv_cs t) t = true ->
     field_compatible t nil p ->
-    mapsto_zeros (sizeof t) sh p |-- data_at sh t (zero_val t) p.
+    mapsto_zeros (sizeof t) sh p ⊢ data_at sh t (zero_val t) p.
 Proof.
 intros.
 unfold data_at, field_at.
@@ -1050,7 +1061,7 @@ rep_lia.
 Qed.
 
 Lemma data_at_data_at_ : forall sh t v p,
-  data_at sh t v p |-- data_at_ sh t p.
+  data_at sh t v p ⊢ data_at_ sh t p.
 Proof.
   intros.
   apply field_at_field_at_.
@@ -1058,15 +1069,15 @@ Qed.
 
 Lemma data_at_data_at_default : forall sh t v v' p,
   v' = default_val (nested_field_type t nil) ->
-  data_at sh t v p |-- data_at sh t v' p.
+  data_at sh t v p ⊢ data_at sh t v' p.
 Proof.
   intros; subst.
   apply data_at_data_at_.
 Qed.
 
 Lemma data_at__memory_block: forall sh t p,
-  data_at_ sh t p =
-  (!! field_compatible t nil p) && memory_block sh (sizeof t) p.
+  data_at_ sh t p ⊣⊢
+  (⌜field_compatible t nil p⌝ ∧ memory_block sh (sizeof t) p).
 Proof.
   intros.
   unfold data_at_, data_at.
@@ -1076,14 +1087,14 @@ Proof.
   + normalize.
   + unfold field_at_, field_at.
     rewrite memory_block_isptr.
-    replace (!!field_compatible t nil p : mpred) with FF by (apply ND_prop_ext; tauto).
-    replace (!!isptr Vundef : mpred) with FF by reflexivity.
-    normalize.
+    rewrite bi.pure_False by auto.
+    rewrite (bi.pure_False _ H).
+    iSplit; iIntros "([] & _)".
 Qed.
 
 Lemma memory_block_data_at_: forall sh t p,
   field_compatible t nil p ->
-  memory_block sh (sizeof t) p = data_at_ sh t p.
+  memory_block sh (sizeof t) p ⊣⊢ data_at_ sh t p.
 Proof.
   intros.
   rewrite data_at__memory_block.
@@ -1092,7 +1103,7 @@ Qed.
 
 Lemma data_at__memory_block_cancel:
    forall sh t p,
-       data_at_ sh t p |-- memory_block sh (sizeof t) p.
+       data_at_ sh t p ⊢ memory_block sh (sizeof t) p.
 Proof.
   intros.
   rewrite data_at__memory_block.
@@ -1101,33 +1112,31 @@ Qed.
 
 Lemma data_at_memory_block:
   forall sh t v p,
-     data_at sh t v p |-- memory_block sh (sizeof t) p.
+     data_at sh t v p ⊢ memory_block sh (sizeof t) p.
 Proof.
   intros.
-  eapply derives_trans; [apply data_at_data_at_; reflexivity |].
+  rewrite data_at_data_at_.
   rewrite data_at__memory_block by auto.
-  apply andp_left2.
-  auto.
+  iIntros "(_ & $)".
 Qed.
 
 Lemma array_at_array_at_: forall sh t gfs lo hi v p,
-  array_at sh t gfs lo hi v p |-- array_at_ sh t gfs lo hi p.
+  array_at sh t gfs lo hi v p ⊢ array_at_ sh t gfs lo hi p.
 Proof.
   intros.
-  eapply derives_trans; [apply andp_right; [apply array_at_local_facts | apply derives_refl] | ].
- normalize.
-  unfold array_at_.
-  apply array_at_ext_derives.
-  1: rewrite Zlength_Zrepeat by (rewrite Zlength_correct in H1; lia); lia.
+  iIntros "H".
+  iDestruct (array_at_local_facts with "H") as %H.
+  iApply (array_at_ext_derives with "H").
+  { rewrite Zlength_Zrepeat by (rewrite Zlength_correct in H; lia); lia. }
   intros.
   destruct (field_compatible0_dec t (ArraySubsc i :: gfs) p).
-  + revert u1 H5; erewrite <- @nested_field_type_ArraySubsc with (i := i); intros.
-    apply JMeq_eq in H5; rewrite H5. unfold Znth. rewrite if_false by lia.
+  + generalize dependent u1; erewrite <- @nested_field_type_ArraySubsc with (i := i).
+    intros ? ->%JMeq_eq. unfold Znth. rewrite if_false by lia.
     unfold Zrepeat; rewrite nth_repeat.
     apply field_at_field_at_; auto.
   + unfold field_at.
     normalize.
-    contradiction (field_compatible_field_compatible0 t (ArraySubsc i :: gfs) p H6).
+    contradiction n; apply field_compatible_field_compatible0; done.
 Qed.
 
 Lemma withspacer_field_at__Tunion: forall sh t gfs i id a p,
@@ -1137,7 +1146,7 @@ Lemma withspacer_field_at__Tunion: forall sh t gfs i id a p,
    (nested_field_offset t gfs +
     sizeof (field_type i (co_members (get_co id))))
    (nested_field_offset t gfs + sizeof (nested_field_type t gfs))
-   (field_at_ sh t (gfs UDOT i)) p =
+   (field_at_ sh t (gfs UDOT i)) p ⊣⊢
   memory_block sh (sizeof (nested_field_type t gfs)) (field_address t gfs p).
 Proof.
   intros.
@@ -1151,7 +1160,7 @@ Proof.
     unfold field_address.
     rewrite if_false by auto.
     rewrite H.
-    apply pred_ext; normalize.
+    apply bi.equiv_entails_2; normalize.
   }
   rewrite field_at__memory_block.
   assert (field_compatible t (gfs UDOT i) p) by (rewrite field_compatible_cons, H; split; auto).
@@ -1170,8 +1179,7 @@ Proof.
   + reflexivity.
   + pose proof sizeof_pos (field_type i (co_members (get_co id))); lia.
   + lia.
-  +
-    change (sizeof ?A) with (expr.sizeof A) in *.
+  + change (sizeof ?A) with (expr.sizeof A) in *.
     split.
     - rewrite sizeof_Tunion.
       erewrite co_consistent_sizeof by apply get_co_consistent.
@@ -1201,75 +1209,49 @@ Lemma array_at_ramif: forall sh t gfs t0 n a lo hi i v v0 p,
   nested_field_type t gfs = Tarray t0 n a ->
   lo <= i < hi ->
   JMeq v0 (Znth (i - lo) v) ->
-  array_at sh t gfs lo hi v p |-- field_at sh t (ArraySubsc i :: gfs) v0 p *
-   (ALL v0: _, ALL v0': _, !! JMeq v0 v0' -->
-      (field_at sh t (ArraySubsc i :: gfs) v0 p -*
-        array_at sh t gfs lo hi (upd_Znth (i - lo) v v0') p)).
-Proof.
-  intros.
-  rewrite (add_andp _ _ (array_at_local_facts _ _ _ _ _ _ _)).
-  normalize.
-  rewrite allp_uncurry'.
-  change (ALL  st: _,
-    !!JMeq (fst st) (snd st) -->
-     (field_at sh t (gfs SUB i) (fst st) p -*
-      array_at sh t gfs lo hi (upd_Znth (i - lo) v (snd st)) p))
-  with (allp ((fun st => !!JMeq (fst st) (snd st)) -->
-               ((fun st => field_at sh t (gfs SUB i) (fst st) p) -*
-                 fun st => array_at sh t gfs lo hi (upd_Znth (i - lo) v (snd st)) p))).
-  eapply RAMIF_Q'.solve with
-    (array_at sh t gfs lo i (sublist 0 (i - lo) v) p *
-     array_at sh t gfs (i + 1) hi (sublist (i + 1 - lo) (hi - lo) v) p).
-  + simpl; auto.
-  + erewrite (split3_array_at sh t gfs lo i hi) by (eauto; lia).
-    cancel.
-  + clear v0 H1.
-    intros [v0 v0'].
-    normalize.
-    erewrite (split3_array_at sh t gfs lo i hi).
-    2: auto.
-    2:{
-      rewrite upd_Znth_Zlength by lia.
-      auto.
-    }
-    2:{
-      rewrite upd_Znth_same by lia.
-      exact H1.
-    }
-    rewrite @sublist_upd_Znth_l with (lo := 0) by lia.
-    rewrite @sublist_upd_Znth_r with (lo := (i + 1 - lo)) by lia.
-    unfold fst; cancel.
+  array_at sh t gfs lo hi v p ⊢ field_at sh t (ArraySubsc i :: gfs) v0 p ∗
+   ∀ v0 v0', ⌜JMeq v0 v0'⌝ →
+      (field_at sh t (ArraySubsc i :: gfs) v0 p -∗
+        array_at sh t gfs lo hi (upd_Znth (i - lo) v v0') p).
+Proof.
+  intros.
+  iIntros "H".
+  iDestruct (array_at_local_facts with "H") as %(? & ? & ? & ?).
+  erewrite (split3_array_at sh t gfs lo i hi) by (eauto; lia).
+  iDestruct "H" as "(? & $ & ?)".
+  clear dependent v0.
+  iIntros (v0 v0' ?) "?".
+  erewrite (split3_array_at sh t gfs lo i hi).
+  2: auto.
+  2:{ rewrite upd_Znth_Zlength by lia.
+      auto. }
+  2:{ rewrite upd_Znth_same by lia.
+      done. }
+  rewrite @sublist_upd_Znth_l with (lo := 0) by lia.
+  rewrite @sublist_upd_Znth_r with (lo := (i + 1 - lo)) by lia.
+  iFrame.
 Qed.
 
 Lemma nested_sfieldlist_at_ramif: forall sh t gfs id a i v p,
   let d := default_val _ in
   nested_field_type t gfs = Tstruct id a ->
   in_members i (co_members (get_co id)) ->
-  nested_sfieldlist_at sh t gfs (co_members (get_co id)) v p |--
+  nested_sfieldlist_at sh t gfs (co_members (get_co id)) v p ⊢
   field_at sh t (StructField (name_member (get_member i (co_members (get_co id)))) :: gfs)
-    (proj_struct i (co_members (get_co id)) v d) p *
-      (ALL v0: _,
-         field_at sh t (StructField (name_member (get_member i (co_members (get_co id)))) :: gfs) v0 p -*
+    (proj_struct i (co_members (get_co id)) v d) p ∗
+      (∀ v0,
+         field_at sh t (StructField (name_member (get_member i (co_members (get_co id)))) :: gfs) v0 p -∗
            nested_sfieldlist_at sh t gfs (co_members (get_co id))
             (upd_struct i (co_members (get_co id)) v v0) p).
 Proof.
   intros.
   pose proof (get_co_members_no_replicate id).
- forget (co_members (get_co id)) as m.
- destruct m; [inv H0|].
+  forget (co_members (get_co id)) as m.
+  destruct m; [inv H0|].
   revert v d H0; intros.
   unfold nested_sfieldlist_at.
-
-  match goal with
-  | |- _ |-- _ * (ALL v0: _, ?A1 v0 p -* ?A2 (?A3 v0) p) =>
-      change (ALL v0: _, A1 v0 p -* A2 (A3 v0) p)
-      with (allp (Basics.compose (fun P => P p) (fun v0 => A1 v0) -*
-                  Basics.compose (fun v0 => A2 (A3 v0) p) (fun v0 => v0)))
-  end.
-
-  Opaque struct_pred. eapply @RAMIF_Q.trans. Transparent struct_pred.
-  2:{
-    apply (struct_pred_ramif (m::m0)
+  etrans.
+  { apply (struct_pred_ramif (m::m0)
             (fun it v p =>
               withspacer sh
                 (nested_field_offset t gfs +
@@ -1278,43 +1260,31 @@ Proof.
                 (nested_field_offset t gfs +
                  field_offset_next cenv_cs (name_member it) (m::m0)
                    (sizeof (nested_field_type t gfs)))
-                (field_at sh t (gfs DOT name_member it) v) p)); auto.
-  }
-  2:{
-    apply withspacer_ramif_Q.
-  }
-  intros.
-  apply derives_refl.
+                (field_at sh t (gfs DOT name_member it) v) p)); eauto. }
+  iIntros "(H & H1)".
+  iDestruct (withspacer_ramif_Q with "H") as "($ & H2)".
+  iIntros (?) "?"; iApply "H1"; iApply "H2"; done.
 Qed.
 
 Lemma nested_ufieldlist_at_ramif: forall sh t gfs id a i v p,
   let d := default_val _ in
   nested_field_type t gfs = Tunion id a ->
   in_members i (co_members (get_co id)) ->
-  nested_ufieldlist_at sh t gfs (co_members (get_co id)) v p |--
+  nested_ufieldlist_at sh t gfs (co_members (get_co id)) v p ⊢
   field_at sh t (UnionField (name_member (get_member i (co_members (get_co id)))) :: gfs)
-    (proj_union i (co_members (get_co id)) v d) p *
-      (ALL v0: _,
-         field_at sh t (UnionField (name_member (get_member i (co_members (get_co id)))) :: gfs) v0 p -*
+    (proj_union i (co_members (get_co id)) v d) p ∗
+      (∀ v0,
+         field_at sh t (UnionField (name_member (get_member i (co_members (get_co id)))) :: gfs) v0 p -∗
            nested_ufieldlist_at sh t gfs (co_members (get_co id))
             (upd_union i (co_members (get_co id)) v v0) p).
 Proof.
   intros.
   pose proof (get_co_members_no_replicate id).
- destruct (co_members (get_co id)) eqn:?; [inv H0|].
+  destruct (co_members (get_co id)) eqn:?; [inv H0|].
   revert v d H0; intros.
   unfold nested_ufieldlist_at.
-
-  match goal with
-  | |- _ |-- _ * (ALL v0: _, ?A1 v0 p -* ?A2 (?A3 v0) p) =>
-      change (ALL v0: _, A1 v0 p -* A2 (A3 v0) p)
-      with (allp (Basics.compose (fun P => P p) (fun v0 => A1 v0) -*
-                  Basics.compose (fun v0 => A2 (A3 v0) p) (fun v0 => v0)))
-  end.
-
-  Opaque union_pred. eapply @RAMIF_Q.trans. Transparent union_pred.
-  2:{
-    apply (union_pred_ramif (m::m0)
+  etrans.
+  { apply (union_pred_ramif (m::m0)
             (fun it v p =>
               withspacer sh
                 (nested_field_offset t gfs +
@@ -1322,33 +1292,30 @@ Proof.
                    (field_type (name_member it) (m::m0)))
                 (nested_field_offset t gfs +
                  sizeof (nested_field_type t gfs))
-                (field_at sh t (gfs UDOT name_member it) v) p)); auto.
+                (field_at sh t (gfs UDOT name_member it) v) p)); try done.
     instantiate (1 := default_val _).
     intros.
     rewrite !withspacer_spacer.
     unfold fst.
     fold (field_at_ sh t (gfs UDOT i) p).
-    eapply derives_trans; [eapply sepcon_derives; [apply derives_refl | apply field_at_field_at_] |].
+    rewrite field_at_field_at_.
     rewrite <- !withspacer_spacer.
-   rewrite name_member_get.
-   rewrite <- Heqm.
+    rewrite name_member_get.
+    rewrite <- Heqm.
     erewrite !withspacer_field_at__Tunion; try eassumption; auto.
-   rewrite name_member_get. rewrite Heqm. auto.
+    rewrite name_member_get. rewrite Heqm. auto.
     rewrite Heqm; auto.
   }
-  2:{
-    unfold fst.
-    apply withspacer_ramif_Q.
-  }
-  intros.
-  apply derives_refl.
+  iIntros "(H & H1)".
+  iDestruct (withspacer_ramif_Q with "H") as "($ & H2)".
+  iIntros (?) "?"; iApply "H1"; iApply "H2"; done.
 Qed.
 
 Lemma memory_block_valid_ptr:
   forall sh n p,
-     sepalg.nonidentity sh ->
+     sh ≠ Share.bot ->
      n > 0 ->
-     memory_block sh n p |-- valid_pointer p.
+     memory_block sh n p ⊢ valid_pointer p.
 Proof.
   intros.
   rewrite memory_block_isptr.
@@ -1364,9 +1331,9 @@ Qed.
 
 Lemma data_at__valid_ptr:
   forall sh t p,
-     sepalg.nonidentity sh ->
+     sh ≠ Share.bot ->
      sizeof t > 0 ->
-     data_at_ sh t p |-- valid_pointer p.
+     data_at_ sh t p ⊢ valid_pointer p.
 Proof.
   intros.
   rewrite data_at__memory_block.
@@ -1376,20 +1343,20 @@ Qed.
 
 Lemma data_at_valid_ptr:
   forall sh t v p,
-     sepalg.nonidentity sh ->
+     sh ≠ Share.bot ->
      sizeof t > 0 ->
-     data_at sh t v p |-- valid_pointer p.
+     data_at sh t v p ⊢ valid_pointer p.
 Proof.
   intros.
-  eapply derives_trans; [apply data_at_data_at_ |].
+  rewrite data_at_data_at_.
   apply data_at__valid_ptr; auto.
 Qed.
 
 Lemma field_at_valid_ptr:
   forall sh t path v p,
-     sepalg.nonidentity sh ->
+     sh ≠ Share.bot ->
      sizeof (nested_field_type t path) > 0 ->
-     field_at sh t path v p |-- valid_pointer (field_address t path p).
+     field_at sh t path v p ⊢ valid_pointer (field_address t path p).
 Proof.
 intros.
 rewrite field_at_data_at.
@@ -1398,10 +1365,10 @@ Qed.
 
 Lemma field_at_valid_ptr0:
   forall sh t path v p,
-     sepalg.nonidentity sh ->
+     sh ≠ Share.bot ->
      sizeof (nested_field_type t path) > 0 ->
      nested_field_offset t path = 0 ->
-     field_at sh t path v p |-- valid_pointer p.
+     field_at sh t path v p ⊢ valid_pointer p.
 Proof.
 intros.
 assert_PROP (field_compatible t path p).
@@ -1421,50 +1388,44 @@ Other lemmas
 
 ************************************************)
 
-Lemma lower_andp_val:
-  forall (P Q: val->mpred) v,
-  ((P && Q) v) = (P v && Q v).
-Proof. reflexivity. Qed.
-
-Lemma compute_legal_nested_field_spec: forall {A : Type} {ND : NatDed A} (P: A) t gfs,
-  Forall (fun Q => P |-- !!Q) (compute_legal_nested_field t gfs) ->
-  P |-- !! (legal_nested_field t gfs).
+Lemma compute_legal_nested_field_spec {prop:bi}: forall (P: prop) t gfs,
+  Forall (fun Q => P ⊢ ⌜Q⌝) (compute_legal_nested_field t gfs) ->
+  P ⊢ ⌜legal_nested_field t gfs⌝.
 Proof.
   intros.
   induction gfs as [| gf gfs].
   + simpl.
-    apply prop_right; auto.
+    by iIntros "?".
   + simpl in H |- *.
     unfold legal_field.
     destruct (nested_field_type t gfs), gf; inversion H; subst;
     try
     match goal with
-    | HH : P |-- (prop False) |-
-           P |-- (prop (_)) => apply (derives_trans _ _ _ HH); apply prop_derives; tauto
+    | HH : P ⊢ ⌜False⌝ |-
+           P ⊢ ⌜_⌝ => rewrite HH; apply bi.pure_mono; tauto
     end.
     - apply IHgfs in H3.
       rewrite (add_andp _ _ H2).
       rewrite (add_andp _ _ H3).
       normalize.
-      apply prop_right; tauto.
     - destruct_in_members i0 (co_members (get_co i)).
-      * apply IHgfs in H.
-        apply (derives_trans _ _ _ H), prop_derives; tauto.
+      * apply IHgfs in H as ->.
+        apply bi.pure_mono; tauto.
       * inversion H1.
     - destruct_in_members i0 (co_members (get_co i)).
-      * apply IHgfs in H.
-        apply (derives_trans _ _ _ H), prop_derives; tauto.
-      * inversion H.
-        apply (derives_trans _ _ _ H6), prop_derives; tauto.
+      * apply IHgfs in H as ->.
+        apply bi.pure_mono; tauto.
+      * inv H.
+        rewrite H6; iIntros "[]".
     - destruct_in_members i0 (co_members (get_co i)).
-      * apply IHgfs in H.
-        apply (derives_trans _ _ _ H), prop_derives; tauto.
+      * apply IHgfs in H as ->.
+        apply bi.pure_mono; tauto.
       * inversion H1.
     - destruct_in_members i0 (co_members (get_co i)).
-      * apply IHgfs in H.
-        apply (derives_trans _ _ _ H), prop_derives; tauto.
-      * inversion H.
-        apply (derives_trans _ _ _ H6), prop_derives; tauto.
+      * apply IHgfs in H as ->.
+        apply bi.pure_mono; tauto.
+      * inv H.
+        rewrite H6; iIntros "[]".
 Qed.
 
 
@@ -1476,7 +1437,7 @@ Proof.
   intros.
   induction gfs as [| gf gfs].
   + simpl; auto.
-  +  simpl in H|-*.
+  + simpl in H|-*.
     unfold legal_field. unfold nested_field_type in *.
     destruct (nested_field_rec t gfs) as [[? ?] | ].
     destruct t0; try now inv H; contradiction.
@@ -1503,10 +1464,10 @@ Definition compute_legal_nested_field0 (t: type) (gfs: list gfield) : list Prop
     | Tarray _ n _, ArraySubsc i =>
        (0 <= i <= n) :: compute_legal_nested_field t gfs0
     | Tstruct id _, StructField i =>
-       if compute_in_members i (co_members (get_co id)) then compute_legal_nested_field t gfs else False :: nil
+       if compute_in_members i (co_members (get_co id)) then compute_legal_nested_field t gfs else False%type :: nil
     | Tunion id _, UnionField i =>
-       if compute_in_members i (co_members (get_co id)) then compute_legal_nested_field t gfs else False :: nil
-    | _, _ => False :: nil
+       if compute_in_members i (co_members (get_co id)) then compute_legal_nested_field t gfs else False%type :: nil
+    | _, _ => False%type :: nil
     end
   end.
 
@@ -1551,60 +1512,80 @@ do 2 rewrite Share.rel_top1.
 erewrite Share.split_together; eauto.
 Qed.
 
+Lemma field_at_share_joins: forall sh1 sh2 t fld p v,
+  0 < sizeof (nested_field_type t fld) ->
+  field_at sh1 t fld v p ∗ field_at sh2 t fld v p ⊢ ⌜sepalg.joins sh1 sh2⌝.
+Proof.
+  intros.
+  rewrite field_at_compatible'.
+  iIntros "(((% & % & % & % & %) & H1) & H2)".
+  destruct (nested_field_offset_in_range t fld); [done..|].
+  assert (0 < sizeof (nested_field_type t fld) < Ptrofs.modulus).
+  {
+    destruct p; try done.
+    simpl in *.
+    inv_int i.
+    unfold expr.sizeof in *.
+    lia.
+  }
+  rewrite !field_at_field_at_.
+  rewrite !field_at__memory_block by auto.
+  iApply (memory_block_share_joins with "[$H1 $H2]"); lia.
+Qed.
+
 Lemma field_at_conflict: forall sh t fld p v v',
-  sepalg.nonidentity sh ->
+  sh ≠ Share.bot ->
   0 < sizeof (nested_field_type t fld) ->
-  field_at sh t fld v p * field_at sh t fld v' p|-- FF.
+  field_at sh t fld v p ∗ field_at sh t fld v' p ⊢ False.
 Proof.
   intros.
-  rewrite field_at_compatible'. normalize.
-  destruct H1 as [? [? [? [? ?]]]].
-  destruct (nested_field_offset_in_range t fld H5 H2).
+  rewrite field_at_compatible'.
+  iIntros "(((% & % & % & % & %) & ?) & ?)".
+  destruct (nested_field_offset_in_range t fld); [done..|].
   assert (0 < sizeof (nested_field_type t fld) < Ptrofs.modulus).
   {
-    destruct p; inv H1.
-    simpl in H3.
+    destruct p; try done.
+    simpl in *.
     inv_int i.
     unfold expr.sizeof in *.
     lia.
   }
-  clear - H H1 H8.
-  eapply derives_trans.
-  + apply sepcon_derives.
-    apply field_at_field_at_; try assumption; auto.
-    apply field_at_field_at_; try assumption; auto.
-  + fold (field_at_ sh t fld p).
-    rewrite field_at__memory_block by auto.
-    normalize.
-    apply memory_block_conflict; try  (unfold Ptrofs.max_unsigned; lia).
-    apply sepalg.nonidentity_nonunit; auto.
+  rewrite !field_at_field_at_.
+  rewrite field_at__memory_block by auto.
+  iApply (memory_block_conflict with "[$]"); first done; unfold Ptrofs.max_unsigned; lia.
+Qed.
+
+Lemma data_at_share_joins: forall sh1 sh2 t v p,
+  0 < sizeof t ->
+  data_at sh1 t v p ∗ data_at sh2 t v p ⊢ ⌜sepalg.joins sh1 sh2⌝.
+Proof.
+  intros. unfold data_at. apply field_at_share_joins; auto.
 Qed.
 
 Lemma data_at_conflict: forall sh t v v' p,
-  sepalg.nonidentity sh ->
+  sh ≠ Share.bot ->
   0 < sizeof t ->
-  data_at sh t v p * data_at sh t v' p |-- FF.
+  data_at sh t v p ∗ data_at sh t v' p ⊢ False.
 Proof.
   intros. unfold data_at. apply field_at_conflict; auto.
 Qed.
 
 Lemma field_at__conflict:
   forall sh t fld p,
-  sepalg.nonidentity sh ->
+  sh ≠ Share.bot ->
   0 < sizeof (nested_field_type t fld) ->
         field_at_ sh t fld p
-        * field_at_ sh t fld p |-- FF.
+        ∗ field_at_ sh t fld p ⊢ False.
 Proof.
 intros.
 apply field_at_conflict; auto.
 Qed.
 
-Lemma sepcon_FF_derives':
-  forall (P Q: mpred), (Q |-- FF) -> P * Q |-- FF.
+Lemma sepcon_False_derives' {prop:bi}:
+  forall (P Q: prop), (Q ⊢ False) -> P ∗ Q ⊢ False.
 Proof.
-intros.
-eapply derives_trans. apply sepcon_derives; try eassumption; eauto.
-rewrite sepcon_FF. auto.
+  intros ?? ->.
+  iIntros "(_ & [])".
 Qed.
 
 Lemma field_compatible_offset_isptr:
@@ -1663,21 +1644,21 @@ Lemma var_block_data_at_:
   Z.ltb (sizeof t) Ptrofs.modulus = true ->
   is_aligned cenv_cs ha_env_cs la_env_cs t 0 = true ->
   readable_share sh ->
-  var_block sh (id, t) = `(data_at_ sh t) (eval_lvar id t).
+  var_block sh (id, t) ⊣⊢ assert_of (`(data_at_ sh t) (eval_lvar id t)).
 Proof.
-  intros; extensionality rho.
-  unfold var_block.
-  unfold_lift.
-  simpl.
+  intros; split => rho.
+  unfold var_block; monPred.unseal.
+  unfold_lift; simpl.
   apply Zlt_is_lt_bool in H0.
   rewrite data_at__memory_block; try auto.
   rewrite memory_block_isptr.
   unfold local, lift1; unfold_lift.
   pose proof eval_lvar_spec id t rho.
   destruct (eval_lvar id t rho); simpl in *; normalize.
+  { iSplit; iIntros "((_ & []) & _)". }
   subst.
-  f_equal.
-  apply ND_prop_ext.
+  apply bi.and_proper; last done.
+  apply bi.pure_iff.
   unfold field_compatible.
   unfold isptr, legal_nested_field, size_compatible, align_compatible.
   change (Ptrofs.unsigned Ptrofs.zero) with 0.
@@ -1687,63 +1668,59 @@ Proof.
   apply la_env_cs_sound in H1; tauto.
 Qed.
 
-End CENV.
-
-#[export] Hint Extern 2 (memory_block _ _ _ |-- valid_pointer _) =>
-  (apply memory_block_valid_ptr; [auto with valid_pointer | rep_lia]) : valid_pointer.
-
 Lemma valid_pointer_weak:
- forall a, valid_pointer a |-- weak_valid_pointer a.
+ forall a, valid_pointer a ⊢ weak_valid_pointer a.
 Proof.
 intros.
-unfold valid_pointer, weak_valid_pointer.
-change predicates_hered.orp with orp.
-apply orp_right1.
-auto.
+unfold valid_pointer, weak_valid_pointer; auto.
 Qed.
 
 Lemma valid_pointer_weak':
-  forall P q, (P |-- valid_pointer q) ->
-                 P |-- weak_valid_pointer q.
+  forall P q, (P ⊢ valid_pointer q) ->
+                 P ⊢ weak_valid_pointer q.
 Proof.
 intros.
-eapply derives_trans; try eassumption.
-apply valid_pointer_weak.
+rewrite <- valid_pointer_weak; done.
 Qed.
 
-#[export] Hint Resolve valid_pointer_weak' : valid_pointer.
-
 Lemma valid_pointer_offset_zero: forall P q,
-   (P |-- valid_pointer (offset_val 0 q)) ->
-   P |-- valid_pointer q.
+   (P ⊢ valid_pointer (offset_val 0 q)) ->
+   P ⊢ valid_pointer q.
 Proof.
 intros.
 destruct q; auto.
-eapply derives_trans; try eassumption.
-simpl valid_pointer.
-constructor.
-intros ? ?. contradiction H0.
-rewrite offset_val_zero_Vptr in H.
-auto.
+- rewrite H.
+  simpl valid_pointer.
+  iIntros "[]".
+- rewrite offset_val_zero_Vptr in H.
+  auto.
 Qed.
 
-#[export] Hint Extern 1 (_ |-- valid_pointer ?Q) =>
+End CENV.
+
+#[export] Hint Extern 2 (memory_block _ _ _ ⊢ valid_pointer _) =>
+  (apply memory_block_valid_ptr; [auto with valid_pointer | rep_lia]) : valid_pointer.
+
+#[export] Hint Resolve valid_pointer_weak' : valid_pointer.
+
+#[export] Hint Extern 1 (_ ⊢ valid_pointer ?Q) =>
   lazymatch Q with
   | offset_val _ _ => fail
   | _ => apply valid_pointer_offset_zero
   end : core.
 
-#[export] Hint Extern 2 (memory_block _ _ _ |-- weak_valid_pointer _) =>
-  (apply SeparationLogic.memory_block_weak_valid_pointer;
+#[export] Hint Extern 2 (memory_block _ _ _ ⊢ weak_valid_pointer _) =>
+  (apply memory_block_weak_valid_pointer;
         [rep_lia | rep_lia | auto with valid_pointer]) : valid_pointer.
 
+Local Set SsrRewrite. (* for rewrite bi._ to work *)
 Ltac field_at_conflict z fld :=
-eapply derives_trans with FF; [ | apply FF_left];
- rewrite <- ?sepcon_assoc;
+ apply (derives_trans _ False); [ | apply bi.False_elim];
+ repeat rewrite bi.sep_assoc;
  unfold data_at_, data_at, field_at_;
  let x := fresh "x" in set (x := field_at _ _ fld _ z); pull_right x;
  let y := fresh "y" in set (y := field_at _ _ fld _ z); pull_right y;
- try (rewrite sepcon_assoc; eapply sepcon_FF_derives');
+ try (rewrite <- bi.sep_assoc; eapply sepcon_False_derives');
  subst x y;
  apply field_at_conflict; auto;
  try solve [simpl;  (* This simpl seems safe enough, it's just simplifying (sizeof (nested_field_type _ _))
@@ -1759,15 +1736,18 @@ Ltac data_at_conflict_neq_aux1 A sh fld E x y :=
    | context [field_at sh _ fld _ y] => idtac
    | context [field_at_ sh _ fld y]  => idtac
    end;
-   apply derives_trans with (!! (~ E) && A);
-   [apply andp_right; [ | apply derives_refl];
+   trans (⌜~ E⌝ ∧ A);
+   [apply bi.and_intro; [ | apply derives_refl];
     let H := fresh in
     apply not_prop_right; intro H;
     (rewrite H || rewrite (ptr_eq_e _ _ H));
     field_at_conflict y fld
-   | apply derives_extract_prop;
-     let H1 := fresh in intro H1;
-     rewrite (eq_True _ H1)
+   | apply bi.pure_elim_l;
+     (* for this tactic to succeed, it must introduce a new hyp H1,
+        but rewriting H1 can fail, as the goal might be _-∗⌜C[~E]⌝
+        for some context C *)
+     let H1 := fresh in fancy_intro H1;
+     rewrite ->?(bi.pure_True (~E)) by assumption
     ].
 
 Ltac data_at_conflict_neq_aux2 A E x y :=
@@ -1779,12 +1759,13 @@ Ltac data_at_conflict_neq_aux2 A E x y :=
    end.
 
 Ltac data_at_conflict_neq :=
-  match goal with |- ?A |-- ?B =>
+  match goal with |- ?A ⊢ ?B =>
    match B with
    | context [?x <> ?y] => data_at_conflict_neq_aux2 A (x=y) x y
    | context [~ ptr_eq ?x ?y] => data_at_conflict_neq_aux2 A (ptr_eq x y) x y
    end
   end.
+Local Unset SsrRewrite.
 
 Definition natural_aligned {cs: compspecs} (na: Z) (t: type): bool := (na mod (hardware_alignof ha_env_cs t) =? 0) && is_aligned cenv_cs ha_env_cs la_env_cs t 0.
 
@@ -1846,34 +1827,40 @@ Qed.
  (apply malloc_compatible_field_compatible;
   [assumption | reflexivity | reflexivity]) : core.
 
+Section local_facts.
+
+Context `{!VSTGS OK_ty Σ}.
+
 Lemma data_array_at_local_facts {cs: compspecs}:
  forall t' n a sh (v: list (reptype t')) p,
-  data_at sh (Tarray t' n a) v p |--
-  !! (field_compatible (Tarray t' n a) nil p
+  data_at sh (Tarray t' n a) v p ⊢
+  ⌜field_compatible (Tarray t' n a) nil p
      /\ Zlength v = Z.max 0 n
-     /\ Forall (value_fits t') v).
+     /\ Forall (value_fits t') v⌝.
 Proof.
 intros.
-eapply derives_trans; [apply data_at_local_facts |].
-apply prop_derives.
+rewrite data_at_local_facts.
+apply bi.pure_mono.
 intros [? ?]; split; auto.
 Qed.
 
 Lemma data_array_at_local_facts' {cs: compspecs}:
  forall t' n a sh (v: list (reptype t')) p,
   n >= 0 ->
-  data_at sh (Tarray t' n a) v p |--
-  !! (field_compatible (Tarray t' n a) nil p
+  data_at sh (Tarray t' n a) v p ⊢
+  ⌜field_compatible (Tarray t' n a) nil p
      /\ Zlength v = n
-     /\ Forall (value_fits t') v).
+     /\ Forall (value_fits t') v⌝.
 Proof.
 intros.
-eapply derives_trans; [apply data_array_at_local_facts |].
-apply prop_derives.
+rewrite data_array_at_local_facts.
+apply bi.pure_mono.
 intros [? [? ?]]; split3; auto.
 rewrite Z.max_r in H1 by lia. auto.
 Qed.
 
+End local_facts.
+
 Lemma value_fits_by_value {cs: compspecs}:
   forall t v,
    type_is_volatile t = false ->
@@ -1887,8 +1874,8 @@ Qed.
 
 Ltac field_at_saturate_local :=
 unfold data_at;
-match goal with |- field_at ?sh ?t ?path ?v ?c |-- _ =>
-eapply derives_trans; [apply field_at_local_facts |];
+match goal with |- field_at ?sh ?t ?path ?v ?c ⊢ _ =>
+rewrite field_at_local_facts;
   let p := fresh "p" in set (p := nested_field_type t path);
   simpl in p; unfold field_type in p; simpl in p; subst p;  (* these simpls are probably not dangerous *)
   try rewrite value_fits_by_value by reflexivity;
@@ -1901,35 +1888,35 @@ end.
 Ltac data_at_valid_aux :=
  first [computable | unfold sizeof; simpl Ctypes.sizeof; rewrite ?Z.max_r by rep_lia; rep_lia | rep_lia].
 
-#[export] Hint Extern 1 (data_at _ _ _ _ |-- valid_pointer _) =>
+#[export] Hint Extern 1 (data_at _ _ _ _ ⊢ valid_pointer _) =>
     (simple apply data_at_valid_ptr; [now auto | data_at_valid_aux]) : valid_pointer.
 
-#[export] Hint Extern 1 (field_at _ _ _ _ _ |-- valid_pointer _) =>
+#[export] Hint Extern 1 (field_at _ _ _ _ _ ⊢ valid_pointer _) =>
     (simple apply field_at_valid_ptr; [now auto | data_at_valid_aux]) : valid_pointer.
 
-#[export] Hint Extern 1 (data_at_ _ _ _ |-- valid_pointer _) =>
+#[export] Hint Extern 1 (data_at_ _ _ _ ⊢ valid_pointer _) =>
     (simple apply data_at__valid_ptr; [now auto | data_at_valid_aux]) : valid_pointer.
 
-#[export] Hint Extern 1 (field_at_ _ _ _ _ |-- valid_pointer _) =>
+#[export] Hint Extern 1 (field_at_ _ _ _ _ ⊢ valid_pointer _) =>
     (apply field_at_valid_ptr; [now auto | data_at_valid_aux]) : valid_pointer.
 
-#[export] Hint Extern 1 (field_at _ _ _ _ _ |-- _) =>
+#[export] Hint Extern 1 (field_at _ _ _ _ _ ⊢ _) =>
  (field_at_saturate_local) : saturate_local.
 
-#[export] Hint Extern 1 (data_at _ _ _ _ |-- _) =>
+#[export] Hint Extern 1 (data_at _ _ _ _ ⊢ _) =>
  (field_at_saturate_local) : saturate_local.
 
 #[export] Hint Resolve array_at_local_facts array_at__local_facts : saturate_local.
 
 #[export] Hint Resolve field_at__local_facts : saturate_local.
 #[export] Hint Resolve data_at__local_facts : saturate_local.
-#[export] Hint Extern 0 (data_at _ (Tarray _ _ _) _ _ |-- _) =>
+#[export] Hint Extern 0 (data_at _ (Tarray _ _ _) _ _ ⊢ _) =>
   (apply data_array_at_local_facts'; lia) : saturate_local.
-#[export] Hint Extern 0 (data_at _ (tarray _ _) _ _ |-- _) =>
+#[export] Hint Extern 0 (data_at _ (tarray _ _) _ _ ⊢ _) =>
   (apply data_array_at_local_facts'; lia) : saturate_local.
-#[export] Hint Extern 1 (data_at _ (Tarray _ _ _) _ _ |-- _) =>
+#[export] Hint Extern 1 (data_at _ (Tarray _ _ _) _ _ ⊢ _) =>
   (apply data_array_at_local_facts) : saturate_local.
-#[export] Hint Extern 1 (data_at _ (tarray _ _) _ _ |-- _) =>
+#[export] Hint Extern 1 (data_at _ (tarray _ _) _ _ ⊢ _) =>
   (apply data_array_at_local_facts) : saturate_local.
 #[export] Hint Rewrite <- @field_at_offset_zero: norm1.
 #[export] Hint Rewrite <- @field_at__offset_zero: norm1.
@@ -1945,65 +1932,71 @@ Ltac data_at_valid_aux :=
   as Hint Resolve derives_refl, to limit their application
   and make them fail faster *)
 
+Section cancel.
+
+Context `{!VSTGS OK_ty Σ}.
+
 Lemma data_at_cancel:
   forall {cs: compspecs} sh t v p,
-    data_at sh t v p |-- data_at sh t v p.
+    data_at sh t v p ⊢ data_at sh t v p.
 Proof. intros. apply derives_refl. Qed.
 Lemma field_at_cancel:
   forall {cs: compspecs} sh t gfs v p,
-    field_at sh t gfs v p |-- field_at sh t gfs v p.
+    field_at sh t gfs v p ⊢ field_at sh t gfs v p.
 Proof. intros. apply derives_refl. Qed.
 
 Lemma data_at_field_at_cancel:
   forall {cs: compspecs} sh t v p,
-    data_at sh t v p |-- field_at sh t nil v p.
+    data_at sh t v p ⊢ field_at sh t nil v p.
 Proof. intros. apply derives_refl. Qed.
 Lemma field_at_data_at_cancel:
   forall {cs: compspecs} sh t v p,
-    field_at sh t nil v p |-- data_at sh t v p.
+    field_at sh t nil v p ⊢ data_at sh t v p.
 Proof. intros. apply derives_refl. Qed.
 
-#[export] Hint Resolve data_at_cancel field_at_cancel
-   data_at_field_at_cancel field_at_data_at_cancel : cancel.
-
 Lemma field_at__data_at__cancel:
   forall {cs: compspecs} sh t p,
-   field_at_ sh t nil p |-- data_at_ sh t p.
+   field_at_ sh t nil p ⊢ data_at_ sh t p.
 Proof. intros. apply derives_refl. Qed.
 
 Lemma data_at__field_at__cancel:
   forall {cs: compspecs} sh t p,
-   data_at_ sh t p |-- field_at_ sh t nil p.
+   data_at_ sh t p ⊢ field_at_ sh t nil p.
 Proof. intros. apply derives_refl. Qed.
-#[export] Hint Resolve  field_at__data_at__cancel data_at__field_at__cancel : cancel.
 
+End cancel.
+
+#[export] Hint Resolve data_at_cancel field_at_cancel
+   data_at_field_at_cancel field_at_data_at_cancel : cancel.
+
+#[export] Hint Resolve  field_at__data_at__cancel data_at__field_at__cancel : cancel.
 
 (* We do these as Hint Extern, instead of Hint Resolve,
   to limit their application and make them fail faster *)
 
-#[export] Hint Extern 2 (field_at _ _ _ _ _ |-- field_at_ _ _ _ _) =>
+#[export] Hint Extern 2 (field_at _ _ _ _ _ ⊢ field_at_ _ _ _ _) =>
    (simple apply field_at_field_at_) : cancel.
 
-#[export] Hint Extern 2 (field_at _ _ _ _ _ |-- field_at _ _ _ _ _) =>
+#[export] Hint Extern 2 (field_at _ _ _ _ _ ⊢ field_at _ _ _ _ _) =>
   (simple apply field_at_field_at_default;
    match goal with |- _ = default_val _ => reflexivity end) : cancel.
 
-#[export] Hint Extern 1 (data_at _ _ _ _ |-- data_at_ _ _ _) =>
+#[export] Hint Extern 1 (data_at _ _ _ _ ⊢ data_at_ _ _ _) =>
     (simple apply data_at_data_at_) : cancel.
 
-#[export] Hint Extern 1 (data_at _ _ _ _ |-- memory_block _ _ _) =>
+#[export] Hint Extern 1 (data_at _ _ _ _ ⊢ memory_block _ _ _) =>
     (simple apply data_at__memory_block_cancel) : cancel.
 
-#[export] Hint Extern 2 (data_at _ _ _ _ |-- data_at _ _ _ _) =>
+#[export] Hint Extern 2 (data_at _ _ _ _ ⊢ data_at _ _ _ _) =>
   (simple apply data_at_data_at_default;
    match goal with |- _ = default_val _ => reflexivity end) : cancel.
 
 (* too slow this way.
-#[export] Hint Extern 2 (data_at _ _ _ _ |-- data_at _ _ _ _) =>
+#[export] Hint Extern 2 (data_at _ _ _ _ ⊢ data_at _ _ _ _) =>
   (apply data_at_data_at_default; reflexivity) : cancel.
 *)
 
-#[export] Hint Extern 2 (array_at _ _ _ _ _ _ _ |-- array_at_ _ _ _ _ _ _) =>
+#[export] Hint Extern 2 (array_at _ _ _ _ _ _ _ ⊢ array_at_ _ _ _ _ _ _) =>
   (simple apply array_at_array_at_) : cancel.
 #[export] Hint Extern 1 (isptr _) => (eapply field_compatible_offset_isptr; eassumption) : core.
 #[export] Hint Extern 1 (isptr _) => (eapply field_compatible0_offset_isptr; eassumption) : core.
@@ -2046,83 +2039,86 @@ match goal with
    clear H; subst D; simpl in E; subst E
 end.
 
-Definition field_at_mark := @field_at.
-Definition field_at_hide := @field_at.
-Definition data_at_hide := @data_at.
+Definition field_at_mark `{!VSTGS OK_ty Σ} cs := field_at(cs := cs).
+Definition field_at_hide `{!VSTGS OK_ty Σ} cs  := field_at(cs := cs).
+Definition data_at_hide `{!VSTGS OK_ty Σ} cs  := data_at(cs := cs).
 
 Ltac find_field_at N :=
  match N with
- | S O =>  change @field_at with field_at_mark at 1;
-              change field_at_hide with @field_at
- | S ?k => change @field_at with field_at_hide at 1;
+ | S O =>  change (field_at(cs := ?cs)) with (field_at_mark cs) at 1;
+              change (field_at_hide ?cs) with (field_at(cs := cs))
+ | S ?k => change (field_at(cs := ?cs)) with (field_at_hide cs) at 1;
                 find_field_at k
  end.
 
 Ltac find_data_at N :=
  match N with
- | S O =>  match goal with |- context[@data_at ?cs ?sh ?t] =>
-                 change (@data_at cs sh t) with (field_at_mark cs sh t nil) at 1
+ | S O =>  match goal with |- context[data_at ?sh ?t] =>
+                 change (data_at(cs := ?cs) sh t) with (field_at_mark cs sh t nil) at 1
                  end;
-                 change data_at_hide with @data_at
- | S ?k => change @data_at with data_at_hide at 1;
+                 change (data_at_hide ?cs) with (data_at(cs := cs))
+ | S ?k => change (data_at(cs := ?cs)) with (data_at_hide cs) at 1;
                 find_data_at k
  end.
 
 Definition protect (T: Type) (x: T) := x.
 Global Opaque protect.
 
-Lemma field_at_ptr_neq{cs: compspecs} :
+Section lemmas.
+
+Context `{!VSTGS OK_ty Σ}.
+
+Lemma field_at_ptr_neq {cs: compspecs} :
    forall sh t fld p1 p2 v1 v2,
-  sepalg.nonidentity sh ->
+  sh ≠ Share.bot ->
    0 < sizeof (nested_field_type t (fld :: nil))  ->
-   field_at sh t (fld::nil) v1 p1 *
+   field_at sh t (fld::nil) v1 p1 ∗
    field_at sh t (fld::nil) v2 p2
-   |--
-   !! (~ ptr_eq p1 p2).
+   ⊢
+   ⌜~ ptr_eq p1 p2⌝.
 Proof.
    intros.
    apply not_prop_right; intros.
-  rewrite -> (ptr_eq_e _ _ H1).
+   rewrite -> (ptr_eq_e _ _ H1).
    apply field_at_conflict; try assumption.
 Qed.
 
-Lemma field_at_ptr_neq_andp_emp{cs: compspecs} :
+Lemma field_at_ptr_neq_andp_emp {cs: compspecs} :
     forall sh t fld p1 p2 v1 v2,
-  sepalg.nonidentity sh ->
+  sh ≠ Share.bot ->
  0 < sizeof (nested_field_type t (fld :: nil))  ->
-   field_at sh t (fld::nil) v1 p1 *
+   field_at sh t (fld::nil) v1 p1 ∗
    field_at sh t (fld::nil) v2 p2
-   |--
-   field_at sh t (fld::nil) v1 p1 *
-   field_at sh t (fld::nil) v2 p2 *
-   (!! (~ ptr_eq p1 p2) && emp).
+   ⊢
+   field_at sh t (fld::nil) v1 p1 ∗
+   field_at sh t (fld::nil) v2 p2 ∗
+   (⌜~ ptr_eq p1 p2⌝ ∧ emp).
 Proof.
-   intros.
-   normalize.
-   apply andp_right.
-   apply field_at_ptr_neq; assumption.
-   cancel.
+  intros.
+  iIntros "H".
+  iDestruct (field_at_ptr_neq with "H") as %?; [done..|].
+  iDestruct "H" as "($ & $)"; done.
 Qed.
 
-Lemma field_at_ptr_neq_null{cs: compspecs} :
+Lemma field_at_ptr_neq_null {cs: compspecs} :
    forall sh t fld v p,
-   field_at sh t fld v p |-- !! (~ ptr_eq p nullval).
+   field_at sh t fld v p ⊢ ⌜~ ptr_eq p nullval⌝.
 Proof.
-   intros.
-   rewrite -> field_at_isptr.
-  normalize. apply prop_right.
-   destruct p; unfold nullval; simpl in *; tauto.
+  intros.
+  rewrite -> field_at_isptr.
+  normalize. apply bi.pure_intro.
+  destruct p; unfold nullval; simpl in *; tauto.
 Qed.
 
 Lemma spacer_share_join:
   forall sh1 sh2 sh J K q,
    sepalg.join sh1 sh2 sh ->
-   spacer sh1 J K q * spacer sh2 J K q = spacer sh J K q.
+   spacer sh1 J K q ∗ spacer sh2 J K q ⊣⊢ spacer sh J K q.
 Proof.
- intros.
- unfold spacer.
-  if_tac. normalize.
- unfold at_offset.
+  intros.
+  unfold spacer.
+  if_tac. { apply bi.sep_emp. }
+  unfold at_offset.
   apply memory_block_share_join; auto.
 Qed.
 
@@ -2132,11 +2128,10 @@ Lemma struct_pred_cons2:
    (v: compact_prod (map A (it::it'::m)))
    (p: val),
  struct_pred (it :: it' :: m) P v p =
-    P _ (fst v) p * struct_pred (it'::m) P (snd v) p.
+    (P _ (fst v) p ∗ struct_pred (it'::m) P (snd v) p).
 Proof.
 intros.
-destruct v. unfold fst, snd.
-reflexivity.
+destruct v; reflexivity.
 Qed.
 
 Lemma union_pred_cons2:
@@ -2151,17 +2146,83 @@ intros.
 destruct v; reflexivity.
 Qed.
 
+Lemma struct_pred_timeless: forall m {A} (P : forall it : member, A it -> val -> mpred) v p
+  (HP : forall it a p, (P it a p = emp) \/ Timeless (P it a p)),
+  (struct_pred m P v p = emp) \/ Timeless (struct_pred m P v p).
+Proof.
+  intros.
+  induction m as [| a1 m]; intros; auto.
+  destruct m; eauto.
+  rewrite struct_pred_cons2.
+  destruct (HP a1 v.1 p) as [Hemp | Htimeless], (IHm v.2) as [Hemp' | Htimeless'].
+  - left; rewrite Hemp, Hemp'; apply sep_emp.
+  - right; rewrite Hemp, emp_sep; done.
+  - right; rewrite Hemp', sep_emp; done.
+  - right; apply _.
+Qed.
+
+Lemma spacer_timeless : forall sh a b p, b - a > 0 -> Timeless (spacer sh a b p).
+Proof.
+  intros; unfold spacer.
+  rewrite if_false by lia.
+  by apply memory_block_timeless.
+Qed.
+
+Lemma withspacer_timeless : forall sh a b P p, a <= b -> Timeless (P p) -> Timeless (withspacer sh a b P p).
+Proof.
+  intros; unfold withspacer.
+  if_tac; last apply bi.sep_timeless; try apply _.
+  apply spacer_timeless; lia.
+Qed.
+
+Lemma data_at_rec_timeless {cs:compspecs} (sh : share) t (v : reptype t) p : sizeof t > 0 -> Timeless (data_at_rec sh t v p).
+Proof.
+  revert v p.
+  type_induction t; intros; rewrite data_at_rec_eq; try apply _;
+    try (simple_if_tac; [by apply memory_block_timeless | apply _]).
+  - simpl in *.
+    unfold array_pred, aggregate_pred.array_pred.
+    apply bi.and_timeless; first apply _.
+    rewrite Z.sub_0_r, Z.max_r by lia.
+    assert (Ctypes.sizeof t > 0) by lia.
+    set (lo := 0).
+    assert (lo >= 0) by lia.
+    assert (Z.to_nat z > 0) as Hz by lia; clear H.
+    forget (Z.to_nat z) as n; clearbody lo.
+    match goal with |-context[aggregate_pred.rangespec _ _ ?Q] => set (P := Q) end.
+    assert (forall i v, Timeless (P i v)).
+    { intros; apply IH; auto. }
+    clearbody P; clear IH; generalize dependent lo; induction n; first lia; simpl; intros.
+    destruct (eq_dec n O).
+    + subst; simpl. eapply bi.Timeless_proper; first apply bi.sep_emp.
+      apply _.
+    + apply bi.sep_timeless; try apply _.
+      apply IHn; lia.
+  - edestruct struct_pred_timeless; last done.
+    + intros.
+      destruct (Z.gt_dec (sizeof (field_type (name_member it) (co_members (get_co id)))) 0).
+      * right; apply withspacer_timeless.
+        {
+Abort.
+
+(*Lemma data_at_timeless {cs:compspecs} sh t v p : sizeof t > 0 -> Timeless (data_at sh t v p).
+Proof.
+  intros.
+  apply bi.and_timeless; first apply _.
+  by apply data_at_rec_timeless.
+Qed.*)
+
 Lemma data_at_rec_void:
   forall {cs: compspecs}
-      sh t v q, t = Tvoid -> data_at_rec sh t v q = FF.
+      sh t v q, t = Tvoid -> data_at_rec sh t v q = False.
 Proof.
  intros; subst; reflexivity.
 Qed.
 
-Lemma field_at_share_join{cs: compspecs}:
+Lemma field_at_share_join {cs: compspecs}:
   forall sh1 sh2 sh t gfs v p,
     sepalg.join sh1 sh2 sh ->
-   field_at sh1 t gfs v p * field_at sh2 t gfs v p = field_at sh t gfs v p.
+   field_at sh1 t gfs v p ∗ field_at sh2 t gfs v p ⊣⊢ field_at sh t gfs v p.
 Proof.
 intros.
 unfold field_at.
@@ -2175,28 +2236,28 @@ destruct p; try inversion H1.
 apply data_at_rec_share_join; auto.
 Qed.
 
-Lemma field_at__share_join{cs: compspecs}:
+Lemma field_at__share_join {cs: compspecs}:
   forall sh1 sh2 sh t gfs p,
     sepalg.join sh1 sh2 sh ->
-   field_at_ sh1 t gfs p * field_at_ sh2 t gfs p = field_at_ sh t gfs p.
+   field_at_ sh1 t gfs p ∗ field_at_ sh2 t gfs p ⊣⊢ field_at_ sh t gfs p.
 Proof. intros. apply field_at_share_join. auto. Qed.
 
-Lemma data_at_share_join{cs: compspecs}:
+Lemma data_at_share_join {cs: compspecs}:
   forall sh1 sh2 sh t v p,
     sepalg.join sh1 sh2 sh ->
-   data_at sh1 t v p * data_at sh2 t v p = data_at sh t v p.
+   data_at sh1 t v p ∗ data_at sh2 t v p ⊣⊢ data_at sh t v p.
 Proof. intros. apply field_at_share_join; auto. Qed.
 
-Lemma data_at__share_join{cs: compspecs}:
+Lemma data_at__share_join {cs: compspecs}:
   forall sh1 sh2 sh t p,
     sepalg.join sh1 sh2 sh ->
-   data_at_ sh1 t p * data_at_ sh2 t p = data_at_ sh t p.
+   data_at_ sh1 t p ∗ data_at_ sh2 t p ⊣⊢ data_at_ sh t p.
 Proof. intros. apply data_at_share_join; auto. Qed.
 
 Lemma data_at_conflict_glb: forall {cs: compspecs} sh1 sh2 t v v' p,
   sepalg.nonidentity (Share.glb sh1 sh2) ->
   0 < sizeof t ->
-  data_at sh1 t v p * data_at sh2 t v' p |-- FF.
+  data_at sh1 t v p ∗ data_at sh2 t v' p ⊢ False.
 Proof.
   intros.
   pose (sh := Share.glb sh1 sh2).
@@ -2217,17 +2278,10 @@ Proof.
       unfold sh. rewrite Share.glb_commute.
      rewrite Share.lub_commute, Share.lub_absorb. auto.
    }
-   rewrite <- (data_at_share_join _ _ _ _ _ _ H1).
-   rewrite <- (data_at_share_join _ _ _ _ _ _ H2).
-   rewrite sepcon_assoc. 
-   rewrite <- (sepcon_assoc (data_at (Share.glb _ _) _ _ _)). 
-   rewrite (sepcon_comm (data_at (Share.glb sh1 _) _ _ _)).
-   rewrite <- !sepcon_assoc.
-   rewrite (sepcon_assoc (_ * _)).
-   eapply derives_trans.
-   apply sepcon_derives; [ | apply derives_refl].
-   apply data_at_conflict; auto.
-   rewrite FF_sepcon. auto.
+  rewrite <- (data_at_share_join _ _ _ _ _ _ H1).
+  rewrite <- (data_at_share_join _ _ _ _ _ _ H2).
+  iIntros "((H11 & H12) & (H21 & H22))".
+  iDestruct (data_at_conflict with "[$H11 $H21]") as "[]"; auto.
 Qed.
 
 Lemma nonreadable_memory_block_field_at:
@@ -2235,7 +2289,7 @@ Lemma nonreadable_memory_block_field_at:
       sh t gfs v p,
   ~ readable_share sh ->
    value_fits _ v ->
-   memory_block sh (sizeof (nested_field_type t gfs)) (field_address t gfs p) = field_at sh t gfs v p.
+   memory_block sh (sizeof (nested_field_type t gfs)) (field_address t gfs p) ⊣⊢ field_at sh t gfs v p.
 Proof.
   intros until p. intros NONREAD VF.
   unfold field_address.
@@ -2263,14 +2317,14 @@ Proof.
     apply nonreadable_memory_block_data_at_rec; try tauto; try lia.
   + unfold field_at_, field_at.
     rewrite memory_block_isptr.
-    apply pred_ext; normalize.
+    apply bi.equiv_entails_2; normalize.
 Qed.
 
-Lemma nonreadable_memory_block_data_at: forall  {cs: compspecs} sh t v p,
+Lemma nonreadable_memory_block_data_at: forall {cs: compspecs} sh t v p,
   ~ readable_share sh ->
   field_compatible t nil p ->
   value_fits t v ->
-  memory_block sh (sizeof t) p = data_at sh t v p.
+  memory_block sh (sizeof t) p ⊣⊢ data_at sh t v p.
 Proof.
   intros.
   replace p with (field_address t nil p) at 1.
@@ -2287,11 +2341,11 @@ Lemma nonreadable_field_at_eq {cs: compspecs} :
   forall sh t gfs v v' p,
    ~ readable_share sh ->
    (value_fits (nested_field_type t gfs) v <-> value_fits (nested_field_type t gfs) v') ->
-   field_at sh t gfs v p = field_at sh t gfs v' p.
+   field_at sh t gfs v p ⊣⊢ field_at sh t gfs v' p.
 Proof.
 intros.
 rewrite !field_at_data_at.
-apply pred_ext; saturate_local.
+apply bi.equiv_entails_2; saturate_local.
 rewrite <- !nonreadable_memory_block_data_at; auto.
 apply H0; auto.
 destruct (readable_share_dec sh); try contradiction.
@@ -2304,23 +2358,22 @@ Lemma nonreadable_readable_memory_block_data_at_join
   forall ash bsh psh t v p,
     sepalg.join ash bsh psh ->
     ~ readable_share ash ->
-   memory_block ash (sizeof t) p * data_at bsh t v p = data_at psh t v p.
+   memory_block ash (sizeof t) p ∗ data_at bsh t v p ⊣⊢ data_at psh t v p.
 Proof.
 intros.
-apply pred_ext; saturate_local.
+apply bi.equiv_entails_2; saturate_local.
 rewrite @nonreadable_memory_block_data_at with (v:=v); auto.
 unfold data_at.
-erewrite field_at_share_join; eauto. apply derives_refl.
+erewrite field_at_share_join; eauto.
 rewrite @nonreadable_memory_block_data_at with (v:=v); auto.
 unfold data_at.
 erewrite field_at_share_join; eauto.
-apply derives_refl.
 Qed.
 
 Lemma nonreadable_data_at_eq {cs: compspecs}:
   forall sh t v v' p, ~readable_share sh ->
    (value_fits t v <-> value_fits t v') ->
-     data_at sh t v p = data_at sh t v' p.
+     data_at sh t v p ⊣⊢ data_at sh t v' p.
 Proof.
 intros.
 unfold data_at.
@@ -2331,7 +2384,7 @@ Lemma field_at_share_join_W {cs: compspecs}:
   forall sh1 sh2 sh t gfs v1 v2 p,
     sepalg.join sh1 sh2 sh ->
     writable_share sh1 ->
-    field_at sh1 t gfs v1 p * field_at sh2 t gfs v2 p |-- field_at sh t gfs v1 p.
+    field_at sh1 t gfs v1 p ∗ field_at sh2 t gfs v2 p ⊢ field_at sh t gfs v1 p.
 Proof.
   intros.
   pose proof join_writable_readable H H0.
@@ -2347,7 +2400,7 @@ Lemma data_at_share_join_W {cs: compspecs}:
   forall sh1 sh2 sh t v1 v2 p,
     sepalg.join sh1 sh2 sh ->
     writable_share sh1 ->
-    data_at sh1 t v1 p * data_at sh2 t v2 p |-- data_at sh t v1 p.
+    data_at sh1 t v1 p ∗ data_at sh2 t v2 p ⊢ data_at sh t v1 p.
 Proof.
   intros.
   apply field_at_share_join_W; auto.
@@ -2358,6 +2411,7 @@ Lemma value_fits_Tint_trivial {cs: compspecs} :
 Proof.
 intros.
 rewrite value_fits_eq; simpl.
+unfold type_is_volatile; simpl.
 destruct (attr_volatile a); auto.
 hnf. intro. apply Coq.Init.Logic.I.
 Qed.
@@ -2368,8 +2422,8 @@ Proof.
   intros.
   unfold data_at, field_at.
   f_equal.
+  f_equal; apply prop_ext.
   unfold field_compatible.
-  apply ND_prop_ext.
   assert (align_compatible tuint p <-> align_compatible tint p); [| tauto].
   destruct p; simpl; try tauto.
   split; intros.
@@ -2394,7 +2448,7 @@ Proof.
   apply (fun HH => JMeq_trans HH (JMeq_sym (repinject_JMeq _ v' H))) in H2.
   apply JMeq_eq in H2.
   rewrite prop_true_andp by auto.
-  f_equal; auto.
+  f_equiv; auto.
   apply field_compatible_field_address; auto.
 Qed.
 
@@ -2403,9 +2457,9 @@ Lemma mapsto_field_at_ramify {cs: compspecs} sh t gfs v v' w w' p:
   type_is_volatile (nested_field_type t gfs) = false ->
   JMeq v v' ->
   JMeq w w' ->
-  field_at sh t gfs v' p |--
-    mapsto sh (nested_field_type t gfs) (field_address t gfs p) v *
-     (mapsto sh (nested_field_type t gfs) (field_address t gfs p) w -*
+  field_at sh t gfs v' p ⊢
+    mapsto sh (nested_field_type t gfs) (field_address t gfs p) v ∗
+     (mapsto sh (nested_field_type t gfs) (field_address t gfs p) w -∗
         field_at sh t gfs w' p).
 Proof.
   intros.
@@ -2416,7 +2470,7 @@ Proof.
   normalize.
   rewrite field_compatible_field_address by auto.
   subst.
-  apply RAMIF_PLAIN.solve with emp; [rewrite sepcon_emp | rewrite emp_sepcon]; auto.
+  iIntros "$ $".
 Qed.
 
 Lemma mapsto_data_at {cs: compspecs} sh t v v' p :  (* not needed here *)
@@ -2437,7 +2491,7 @@ Proof.
   rewrite by_value_data_at_rec_nonvolatile by auto.
   apply (fun HH => JMeq_trans HH (JMeq_sym (repinject_JMeq _ v' H))) in H5; apply JMeq_eq in H5.
   rewrite prop_true_andp; auto.
-  f_equal. auto.
+  f_equiv; auto.
   repeat split; auto.
 Qed.
 
@@ -2454,7 +2508,7 @@ Proof.
   rewrite prop_true_andp by auto.
   rewrite by_value_data_at_rec_nonvolatile by auto.
   apply (fun HH => JMeq_trans HH (JMeq_sym (repinject_JMeq _ v' H))) in H2; apply JMeq_eq in H2.
-  f_equal; auto.
+  f_equiv; auto.
   destruct H1. destruct p; try contradiction.
   rewrite ptrofs_add_repr_0_r. auto.
 Qed.
@@ -2492,34 +2546,31 @@ Qed.
 Lemma data_at_type_changable {cs}: forall (sh: Share.t) (t1 t2: type) v1 v2,
   t1 = t2 ->
   JMeq v1 v2 ->
-  @data_at cs sh t1 v1 = data_at sh t2 v2.
+  data_at (cs := cs) sh t1 v1 = data_at sh t2 v2.
 Proof. intros. subst. apply JMeq_eq in H0. subst v2. reflexivity. Qed.
 
-Lemma field_at_change_composite {cs_from cs_to} {CCE: change_composite_env cs_from cs_to}: forall (sh: Share.t) (t: type) gfs v1 v2,
+Lemma field_at_change_composite {cs_from cs_to} {CCE: change_composite_env cs_from cs_to}: forall (sh: Share.t) (t: type) gfs v1 v2 p,
   JMeq v1 v2 ->
   cs_preserve_type cs_from cs_to (coeq _ _) t = true ->
-  @field_at cs_from sh t gfs v1 = @field_at cs_to sh t gfs v2.
+  field_at (cs := cs_from) sh t gfs v1 p ⊣⊢ field_at (cs := cs_to) sh t gfs v2 p.
 Proof.
   intros.
   unfold field_at.
-  extensionality p.
   apply andp_prop_ext.
   + apply field_compatible_change_composite; auto.
   + intros.
     pose proof H1.
     rewrite field_compatible_change_composite in H2 by auto.
-    f_equal.
-    - revert v1 H;
-      rewrite nested_field_type_change_composite by auto.
-      intros.
-      apply data_at_rec_change_composite; auto.
-      apply nested_field_type_preserves_change_composite; auto.
-    - apply nested_field_offset_change_composite; auto.
+    rewrite nested_field_offset_change_composite by auto.
+    revert v1 H; rewrite nested_field_type_change_composite by auto.
+    intros.
+    apply data_at_rec_change_composite; auto.
+    apply nested_field_type_preserves_change_composite; auto.
 Qed.
 
-Lemma field_at__change_composite {cs_from cs_to} {CCE: change_composite_env cs_from cs_to}: forall (sh: Share.t) (t: type) gfs,
+Lemma field_at__change_composite {cs_from cs_to} {CCE: change_composite_env cs_from cs_to}: forall (sh: Share.t) (t: type) gfs p,
   cs_preserve_type cs_from cs_to (coeq _ _) t = true ->
-  @field_at_ cs_from sh t gfs = @field_at_ cs_to sh t gfs.
+  field_at_ (cs := cs_from) sh t gfs p ⊣⊢ field_at_ (cs := cs_to) sh t gfs p.
 Proof.
   intros.
   apply field_at_change_composite; auto.
@@ -2528,43 +2579,46 @@ Proof.
   apply nested_field_type_preserves_change_composite; auto.
 Qed.
 
-Lemma data_at_change_composite {cs_from cs_to} {CCE: change_composite_env cs_from cs_to}: forall (sh: Share.t) (t: type) v1 v2,
+Lemma data_at_change_composite {cs_from cs_to} {CCE: change_composite_env cs_from cs_to}: forall (sh: Share.t) (t: type) v1 v2 p,
   JMeq v1 v2 ->
   cs_preserve_type cs_from cs_to (coeq _ _) t = true ->
-  @data_at cs_from sh t v1 = @data_at cs_to sh t v2.
+  data_at (cs := cs_from) sh t v1 p ⊣⊢ data_at (cs := cs_to) sh t v2 p.
 Proof.
   intros.
   apply field_at_change_composite; auto.
 Qed.
 
-Lemma data_at__change_composite {cs_from cs_to} {CCE: change_composite_env cs_from cs_to}: forall (sh: Share.t) (t: type),
+Lemma data_at__change_composite {cs_from cs_to} {CCE: change_composite_env cs_from cs_to}: forall (sh: Share.t) (t: type) p,
   cs_preserve_type cs_from cs_to (coeq _ _) t = true ->
-  @data_at_ cs_from sh t = @data_at_ cs_to sh t.
+  data_at_ (cs := cs_from) sh t p ⊣⊢ data_at_ (cs := cs_to) sh t p.
 Proof.
   intros.
   apply field_at__change_composite; auto.
 Qed.
 
 (* TODO: rename and clean up all array_at_data_at lemmas. *)
-Lemma array_at_data_at1 {cs} : forall sh t gfs lo hi v p,
+Lemma array_at_data_at1 {cs : compspecs} : forall sh t gfs lo hi v p,
    lo <= hi ->
    field_compatible0 t (gfs SUB lo) p ->
    field_compatible0 t (gfs SUB hi) p ->
-  @array_at cs sh t gfs lo hi v p =
-  at_offset (@data_at cs sh (nested_field_array_type t gfs lo hi) v)
+  array_at sh t gfs lo hi v p =
+  at_offset (data_at sh (nested_field_array_type t gfs lo hi) v)
                (nested_field_offset t (ArraySubsc lo :: gfs)) p.
 Proof.
-  intros. rewrite array_at_data_at by auto. unfold at_offset. apply pred_ext; normalize.
+  intros. rewrite array_at_data_at by auto. unfold at_offset.
+  normalize.
 Qed.
 
-Lemma data_at_ext_derives {cs} sh t v v' p q: v=v' -> p=q -> @data_at cs sh t v p |-- @data_at cs sh t v' q.
+Lemma data_at_ext_derives {cs : compspecs} sh t v v' p q: v=v' -> p=q -> data_at sh t v p ⊢ data_at sh t v' q.
 Proof. intros; subst.
 apply derives_refl.
 Qed.
 
-Lemma data_at_ext_eq {cs} sh t v v' p q: v=v' -> p=q -> @data_at cs sh t v p = @data_at cs sh t v' q.
+Lemma data_at_ext_eq {cs : compspecs} sh t v v' p q: v=v' -> p=q -> data_at sh t v p = data_at sh t v' q.
 Proof. intros; subst. trivial. Qed.
 
+End lemmas.
+
 (* does not simplify array indices, because that might be too expensive *)
 Ltac simpl_compute_legal_nested_field :=
   repeat match goal with
@@ -2575,7 +2629,7 @@ Ltac simpl_compute_legal_nested_field :=
 
 Ltac solve_legal_nested_field_in_entailment :=
    match goal with
-   | |- _ |-- !! legal_nested_field ?t_root ?gfs =>
+   | |- _ ⊢ ⌜legal_nested_field ?t_root ?gfs⌝ =>
      try unfold t_root;
      try unfold gfs;
      try match gfs with
@@ -2583,15 +2637,15 @@ Ltac solve_legal_nested_field_in_entailment :=
      end
   end;
   first
-  [ apply prop_right; apply compute_legal_nested_field_spec';
+  [ apply bi.pure_intro; apply compute_legal_nested_field_spec';
     simpl_compute_legal_nested_field;
     repeat apply Forall_cons; try apply Forall_nil; lia
   |
   apply compute_legal_nested_field_spec;
   simpl_compute_legal_nested_field;
   repeat apply Forall_cons; try apply Forall_nil;
-  try solve [apply prop_right; auto; lia];
-  try solve [normalize; apply prop_right; auto; lia]
+  try solve [apply bi.pure_intro; auto; lia];
+  try solve [normalize; apply bi.pure_intro; auto; lia]
   ].
 
 Ltac headptr_field_compatible :=
@@ -2606,25 +2660,22 @@ Ltac headptr_field_compatible :=
 #[export] Hint Extern 2 (field_compatible _ _ _) => headptr_field_compatible : field_compatible.
 
 (* BEGIN New experiments *)
+Section new_lemmas.
+
+Context `{!VSTGS OK_ty Σ}.
 
 Lemma data_at_data_at_cancel  {cs: compspecs}: forall sh t v v' p,
   v = v' ->
-  data_at sh t v p |-- data_at sh t v' p.
+  data_at sh t v p ⊢ data_at sh t v' p.
 Proof. intros. subst. apply derives_refl. Qed.
 
-#[export] Hint Resolve data_at_data_at_cancel : cancel.
-
-
 Lemma field_at_field_at_cancel  {cs: compspecs}: forall sh t gfs v v' p,
   v = v' ->
-  field_at sh t gfs v p |-- field_at sh t gfs v' p.
+  field_at sh t gfs v p ⊢ field_at sh t gfs v' p.
 Proof. intros. subst. apply derives_refl. Qed.
 
-#[export] Hint Resolve data_at_data_at_cancel : cancel.
-#[export] Hint Resolve field_at_field_at_cancel : cancel.
-
 Lemma data_at__data_at {cs: compspecs}:
-   forall sh t v p, v = default_val t -> data_at_ sh t p |-- data_at sh t v p.
+   forall sh t v p, v = default_val t -> data_at_ sh t p ⊢ data_at sh t v p.
 Proof.
 intros; subst; unfold data_at_; apply derives_refl.
 Qed.
@@ -2634,143 +2685,122 @@ Proof.
   intros; unfold data_at_, data_at, field_at_; auto.
 Qed.
 
-Lemma data_at_shares_join : forall {cs} sh t v p shs sh1 (Hsplit : sepalg_list.list_join sh1 shs sh),
-  @data_at cs sh1 t v p * iter_sepcon.iter_sepcon (fun sh => data_at sh t v p) shs =
+Lemma data_at_shares_join : forall {cs : compspecs} sh t v p shs sh1 (Hsplit : sepalg_list.list_join sh1 shs sh),
+  data_at sh1 t v p ∗ ([∗ list] sh ∈ shs, data_at sh t v p) ⊣⊢
   data_at sh t v p.
 Proof.
   induction shs; intros; simpl.
   - inv Hsplit.
-    rewrite sepcon_emp; auto.
+    apply bi.sep_emp.
   - inv Hsplit.
-    erewrite <- sepcon_assoc, data_at_share_join; eauto.
+    rewrite assoc, data_at_share_join; eauto; apply _.
 Qed.
 
-Lemma data_at_shares_join_old : forall {cs} sh t v p shs sh1 (Hsplit : sepalg_list.list_join sh1 shs sh),
-  @data_at cs sh1 t v p * fold_right sepcon emp (map (fun sh => data_at sh t v p) shs) =
+Lemma data_at_shares_join_old : forall {cs : compspecs} sh t v p shs sh1 (Hsplit : sepalg_list.list_join sh1 shs sh),
+  data_at sh1 t v p ∗ fold_right bi_sep emp (map (fun sh => data_at sh t v p) shs) ⊣⊢
   data_at sh t v p.
 Proof.
   induction shs; intros; simpl.
   - inv Hsplit.
-    rewrite sepcon_emp; auto.
+    apply bi.sep_emp.
   - inv Hsplit.
-    erewrite <- sepcon_assoc, data_at_share_join; eauto.
+    rewrite assoc, data_at_share_join; eauto; apply _.
 Qed.
 
 Lemma struct_pred_value_cohere : forall {cs : compspecs} m sh1 sh2 p t f off v1 v2
   (Hsh1 : readable_share sh1) (Hsh2 : readable_share sh2)
   (IH : Forall (fun it : member => forall v1 v2 (p : val),
         readable_share sh1 -> readable_share sh2 ->
-        data_at_rec sh1 (t it) v1 p * data_at_rec sh2 (t it) v2 p |--
-        data_at_rec sh1 (t it) v1 p * data_at_rec sh2 (t it) v1 p) m),
+        data_at_rec sh1 (t it) v1 p ∗ data_at_rec sh2 (t it) v2 p ⊢
+        data_at_rec sh1 (t it) v1 p ∗ data_at_rec sh2 (t it) v1 p) m),
   struct_pred m (fun (it : member) v =>
-    withspacer sh1 (f it + sizeof (t it)) (off it) (at_offset (data_at_rec sh1 (t it) v) (f it))) v1 p *
+    withspacer sh1 (f it + sizeof (t it)) (off it) (at_offset (data_at_rec sh1 (t it) v) (f it))) v1 p ∗
   struct_pred m (fun (it : member) v =>
-    withspacer sh2 (f it + sizeof (t it)) (off it) (at_offset (data_at_rec sh2 (t it) v) (f it))) v2 p |--
+    withspacer sh2 (f it + sizeof (t it)) (off it) (at_offset (data_at_rec sh2 (t it) v) (f it))) v2 p ⊢
   struct_pred m (fun (it : member) v =>
-    withspacer sh1 (f it + sizeof (t it)) (off it) (at_offset (data_at_rec sh1 (t it) v) (f it))) v1 p *
+    withspacer sh1 (f it + sizeof (t it)) (off it) (at_offset (data_at_rec sh1 (t it) v) (f it))) v1 p ∗
   struct_pred m (fun (it : member) v =>
     withspacer sh2 (f it + sizeof (t it)) (off it) (at_offset (data_at_rec sh2 (t it) v) (f it))) v1 p.
 Proof.
   intros.
   revert v1 v2; induction m; auto; intros.
-  apply derives_refl.
   inv IH.
   destruct m.
   - unfold withspacer, at_offset; simpl.
     if_tac; auto.
-    match goal with |- (?P1 * ?Q1) * (?P2 * ?Q2) |-- _ => apply derives_trans with (Q := (P1 * P2) * (Q1 * Q2));
+    match goal with |- (?P1 ∗ ?Q1) ∗ (?P2 ∗ ?Q2) ⊢ _ => trans ((P1 ∗ P2) ∗ (Q1 ∗ Q2));
       [cancel|] end.
-    eapply derives_trans; [apply sepcon_derives, derives_refl|].
-    { apply H1; auto. }
+    rewrite H1; auto.
     cancel.
   - rewrite !struct_pred_cons2.
-    match goal with |- (?P1 * ?Q1) * (?P2 * ?Q2) |-- _ => apply derives_trans with (Q := (P1 * P2) * (Q1 * Q2));
+    match goal with |- (?P1 ∗ ?Q1) ∗ (?P2 ∗ ?Q2) ⊢ _ => trans ((P1 ∗ P2) ∗ (Q1 ∗ Q2));
       [cancel|] end.
-    match goal with |- _ |-- (?P1 * ?Q1) * (?P2 * ?Q2) => apply derives_trans with (Q := (P1 * P2) * (Q1 * Q2));
+    match goal with |- _ ⊢ (?P1 ∗ ?Q1) ∗ (?P2 ∗ ?Q2) => trans ((P1 ∗ P2) ∗ (Q1 ∗ Q2));
       [|cancel] end.
-    apply sepcon_derives; [|auto].
+    apply bi.sep_mono; auto.
     unfold withspacer, at_offset; simpl.
     if_tac; auto.
-    match goal with |- (?P1 * ?Q1) * (?P2 * ?Q2) |-- _ => apply derives_trans with (Q := (P1 * P2) * (Q1 * Q2));
+    match goal with |- (?P1 ∗ ?Q1) ∗ (?P2 ∗ ?Q2) ⊢ _ => trans ((P1 ∗ P2) ∗ (Q1 ∗ Q2));
       [cancel|] end.
-    eapply derives_trans; [apply sepcon_derives, derives_refl|].
-    { apply H1; auto. }
+    rewrite H1; auto.
     cancel.
 Qed.
 
 Lemma mapsto_value_eq: forall sh1 sh2 t p v1 v2, readable_share sh1 -> readable_share sh2 ->
-  v1 <> Vundef -> v2 <> Vundef -> mapsto sh1 t p v1 * mapsto sh2 t p v2 |-- !!(v1 = v2).
+  v1 <> Vundef -> v2 <> Vundef -> mapsto sh1 t p v1 ∗ mapsto sh2 t p v2 ⊢ ⌜v1 = v2⌝.
 Proof.
   intros; unfold mapsto.
-  destruct (access_mode t); try solve [rewrite FF_sepcon; apply FF_left].
-  destruct (type_is_volatile t); try solve [rewrite FF_sepcon; apply FF_left].
-  destruct p; try solve [rewrite FF_sepcon; apply FF_left].
-  destruct (readable_share_dec sh1); [|contradiction n; auto].
-  destruct (readable_share_dec sh2); [|contradiction n; auto].
-
-  Transparent mpred.
-  rewrite !prop_false_andp with (P := v1 = Vundef), !orp_FF; auto; Intros.
-  rewrite !prop_false_andp with (P := v2 = Vundef), !orp_FF; auto; Intros.
-  Opaque mpred.
-  constructor; apply res_predicates.address_mapsto_value_cohere.
+  destruct (access_mode t); try solve [iIntros "([] & _)"].
+  destruct (type_is_volatile t); try solve [iIntros "([] & _)"].
+  destruct p; try solve [iIntros "([] & _)"].
+  rewrite !if_true by done.
+  iIntros "([(_ & H1) | (-> & % & H1)] & [(_ & H2) | (-> & % & H2)])"; try solve [exfalso; pose proof (JMeq_refl Vundef); done];
+    iApply res_predicates.address_mapsto_value_cohere; iFrame.
 Qed.
 
 Lemma mapsto_value_cohere: forall sh1 sh2 t p v1 v2, readable_share sh1 ->
-  mapsto sh1 t p v1 * mapsto sh2 t p v2 |-- mapsto sh1 t p v1 * mapsto sh2 t p v1.
+  mapsto sh1 t p v1 ∗ mapsto sh2 t p v2 ⊢ mapsto sh1 t p v1 ∗ mapsto sh2 t p v1.
 Proof.
   intros; unfold mapsto.
   destruct (access_mode t); try simple apply derives_refl.
   destruct (type_is_volatile t); try simple apply derives_refl.
   destruct p; try simple apply derives_refl.
-  destruct (readable_share_dec sh1); [|contradiction n; auto].
+  rewrite if_true by done.
   destruct (eq_dec v1 Vundef).
-  Transparent mpred.
-  - subst; rewrite !prop_false_andp with (P := tc_val t Vundef), !FF_orp, prop_true_andp; auto;
+  - subst; rewrite !prop_false_andp with (P := tc_val t Vundef), !bi.False_or, prop_true_andp; auto;
       try apply tc_val_Vundef.
     cancel.
-    rewrite prop_true_andp with (P := Vundef = Vundef); auto.
     if_tac.
-    + apply orp_left; Intros; auto.
-      Exists v2; auto.
-    + Intros. apply andp_right; auto. apply prop_right; split; auto. hnf; intros. contradiction H3; auto.
-  - rewrite !prop_false_andp with (P := v1 = Vundef), !orp_FF; auto; Intros.
-    apply andp_right; [apply prop_right; auto|].
+    + iIntros "[(% & ?) | (% & ?)]"; iRight; auto.
+    + Intros. iIntros "$"; iPureIntro; repeat split; auto. apply tc_val'_Vundef.
+  - rewrite !prop_false_andp with (P := v1 = Vundef), !bi.or_False; auto; Intros.
+    apply bi.and_intro; [apply bi.pure_intro; auto|].
     if_tac.
-    eapply derives_trans with (Q := _ * EX v2' : val,
-      res_predicates.address_mapsto m v2' _ _);
-      [apply sepcon_derives; [apply derives_refl|]|].
-    + destruct (eq_dec v2 Vundef).
-      * subst; rewrite prop_false_andp with (P := tc_val t Vundef), FF_orp;
-          try apply tc_val_Vundef.
-        rewrite prop_true_andp with (P := Vundef = Vundef); auto.  apply derives_refl.
-      * rewrite prop_false_andp with (P := v2 = Vundef), orp_FF; auto; Intros.
-        Exists v2; auto.
-    + Intro v2'.
-      assert_PROP (v1 = v2') by (constructor; apply res_predicates.address_mapsto_value_cohere).
-      subst. apply sepcon_derives; auto. apply andp_right; auto.
-      apply prop_right; auto.
-    + apply sepcon_derives; auto.
-      Intros. apply andp_right; auto.
-      apply prop_right; split; auto.
-      intro; auto.
-Opaque mpred.
+    + iIntros "(H1 & H2)".
+      iAssert (∃ v2' : val, res_predicates.address_mapsto m v2' _ _) with "[H2]" as (v2') "H2".
+      { iDestruct "H2" as "[(% & ?) | (_ & $)]"; auto. }
+      iAssert ⌜v1 = v2'⌝ as %->. { iApply res_predicates.address_mapsto_value_cohere; iFrame. }
+      iFrame; eauto.
+    + apply bi.sep_mono; first done.
+      iIntros "((% & %) & $)"; iPureIntro; repeat split; auto.
+      apply tc_val_tc_val'; auto.
 Qed.
 
 Lemma data_at_value_cohere : forall {cs : compspecs} sh1 sh2 t v1 v2 p, readable_share sh1 ->
   type_is_by_value t = true -> type_is_volatile t = false ->
-  data_at sh1 t v1 p * data_at sh2 t v2 p |--
-  data_at sh1 t v1 p * data_at sh2 t v1 p.
+  data_at sh1 t v1 p ∗ data_at sh2 t v2 p ⊢
+  data_at sh1 t v1 p ∗ data_at sh2 t v1 p.
 Proof.
-  intros; unfold data_at, field_at, at_offset; Intros.
-  apply andp_right; [apply prop_right; auto|].
+  intros; unfold data_at, field_at, at_offset.
+  iIntros "((% & ?) & (% & ?))".
   rewrite !by_value_data_at_rec_nonvolatile by auto.
-  apply mapsto_value_cohere; auto.
+  iDestruct (mapsto_value_cohere with "[-]") as "($ & $)"; auto; iFrame.
 Qed.
 
 Lemma data_at_value_eq : forall {cs : compspecs} sh1 sh2 t v1 v2 p,
   readable_share sh1 -> readable_share sh2 ->
   is_pointer_or_null v1 -> is_pointer_or_null v2 ->
-  data_at sh1 (tptr t) v1 p * data_at sh2 (tptr t) v2 p |-- !! (v1 = v2).
+  data_at sh1 (tptr t) v1 p ∗ data_at sh2 (tptr t) v2 p ⊢ ⌜v1 = v2⌝.
 Proof.
   intros; unfold data_at, field_at, at_offset; Intros.
   rewrite !by_value_data_at_rec_nonvolatile by auto.
@@ -2781,60 +2811,67 @@ Qed.
 
 Lemma data_at_array_value_cohere : forall {cs : compspecs} sh1 sh2 t z a v1 v2 p, readable_share sh1 ->
   type_is_by_value t = true -> type_is_volatile t = false ->
-  data_at sh1 (Tarray t z a) v1 p * data_at sh2 (Tarray t z a) v2 p |--
-  data_at sh1 (Tarray t z a) v1 p * data_at sh2 (Tarray t z a) v1 p.
+  data_at sh1 (Tarray t z a) v1 p ∗ data_at sh2 (Tarray t z a) v2 p ⊢
+  data_at sh1 (Tarray t z a) v1 p ∗ data_at sh2 (Tarray t z a) v1 p.
 Proof.
-  intros; unfold data_at, field_at, at_offset; Intros.
-  apply andp_right; [apply prop_right; auto|].
+  intros; unfold data_at, field_at, at_offset.
+  iIntros "((% & H1) & (_ & H2))".
+  rewrite !bi.pure_True, !bi.True_and by done.
   rewrite !data_at_rec_eq; simpl.
-  unfold array_pred, aggregate_pred.array_pred. Intros.
-  apply andp_right; [apply prop_right; auto|].
+  unfold array_pred, aggregate_pred.array_pred.
+  iDestruct "H1" as (?) "H1"; iDestruct "H2" as (?) "H2".
+  rewrite !bi.pure_True, !bi.True_and by done.
   rewrite Z.sub_0_r in *.
-  erewrite aggregate_pred.rangespec_ext by (intros; rewrite Z.sub_0_r; apply f_equal; auto).
-  setoid_rewrite aggregate_pred.rangespec_ext at 2; [|intros; rewrite Z.sub_0_r; apply f_equal; auto].
-  setoid_rewrite aggregate_pred.rangespec_ext at 4; [|intros; rewrite Z.sub_0_r; apply f_equal; auto].
-  clear H3 H4.
   rewrite Z2Nat_max0 in *.
-  forget (offset_val 0 p) as p'; forget (Z.to_nat z) as n; forget 0 as lo; generalize dependent lo; induction n; auto; simpl; intros.
- apply derives_refl.
-  match goal with |- (?P1 * ?Q1) * (?P2 * ?Q2) |-- _ =>
-    eapply derives_trans with (Q := (P1 * P2) * (Q1 * Q2)); [cancel|] end.
-  eapply derives_trans; [apply sepcon_derives|].
-  - unfold at_offset.
-    rewrite 2by_value_data_at_rec_nonvolatile by auto.
-    apply mapsto_value_cohere; auto.
-  - apply IHn.
-  - unfold at_offset; rewrite 2by_value_data_at_rec_nonvolatile by auto; cancel.
+  clear H3 H4.
+  forget (offset_val 0 p) as p'; forget (Z.to_nat z) as n.
+  set (lo := 0) at 1 3 5 7; clearbody lo.
+  iInduction n as [|] "IH" forall (lo); auto; simpl; intros.
+  iDestruct "H1" as "(H1a & H1b)"; iDestruct "H2" as "(H2a & H2b)".
+  unfold at_offset.
+  rewrite !by_value_data_at_rec_nonvolatile by auto.
+  iDestruct (mapsto_value_cohere with "[$H1a $H2a]") as "($ & $)"; first done.
+  iApply ("IH" with "H1b H2b").
 Qed.
 
 Lemma field_at_array_inbounds : forall {cs : compspecs} sh t z a i v p,
-  field_at sh (Tarray t z a) (ArraySubsc i :: nil) v p |-- !!(0 <= i < z).
+  field_at sh (Tarray t z a) (ArraySubsc i :: nil) v p ⊢ ⌜0 <= i < z⌝.
 Proof.
   intros. rewrite field_at_compatible'.
-  apply derives_extract_prop. intros.
-  apply prop_right.
+  apply bi.pure_elim_l. intros.
+  apply bi.pure_intro.
   destruct H as (_ & _ & _ & _ & _ & ?); auto.
 Qed.
 
 Lemma field_at__field_at {cs: compspecs} :
-   forall sh t gfs v p, v = default_val (nested_field_type t gfs) -> field_at_ sh t gfs p |-- field_at sh t gfs v p.
+   forall sh t gfs v p, v = default_val (nested_field_type t gfs) -> field_at_ sh t gfs p ⊢ field_at sh t gfs v p.
 Proof.
 intros; subst; unfold field_at_; apply derives_refl.
 Qed.
 
 Lemma data_at__field_at {cs: compspecs}:
-   forall sh t v p, v = default_val t -> data_at_ sh t p |-- field_at sh t nil v p.
+   forall sh t v p, v = default_val t -> data_at_ sh t p ⊢ field_at sh t nil v p.
 Proof.
 intros; subst; unfold data_at_; apply derives_refl.
 Qed.
 
 Lemma field_at__data_at {cs: compspecs} :
-   forall sh t v p, v = default_val (nested_field_type t nil) -> field_at_ sh t nil p |-- data_at sh t v p.
+   forall sh t v p, v = default_val (nested_field_type t nil) -> field_at_ sh t nil p ⊢ data_at sh t v p.
 Proof.
 intros; subst; unfold field_at_; apply derives_refl.
 Qed.
 
+Lemma field_at_data_at_cancel': forall {cs : compspecs} sh t v p,
+  field_at sh t nil v p = data_at sh t v p.
+Proof.
+  intros. reflexivity.
+Qed.
+
+End new_lemmas.
 
+#[export] Hint Resolve data_at_data_at_cancel : cancel.
+#[export] Hint Resolve data_at_data_at_cancel : cancel.
+#[export] Hint Resolve field_at_field_at_cancel : cancel.
 #[export] Hint Resolve data_at__data_at : cancel.
 #[export] Hint Resolve field_at__field_at : cancel.
 #[export] Hint Resolve data_at__field_at : cancel.
@@ -2851,33 +2888,22 @@ Qed.
 
 (* enhance cancel to solve field_at and data_at *)
 
-Lemma field_at_data_at_cancel': forall {cs : compspecs} sh t v p,
-  field_at sh t nil v p = data_at sh t v p.
-Proof.
-  intros. apply pred_ext.
-  apply field_at_data_at_cancel.
-  apply data_at_field_at_cancel.
-Qed.
-
 #[export] Hint Rewrite
   @field_at_data_at_cancel'
   @field_at_data_at
   @field_at__data_at_ : cancel.
-
+ 
 (* END new experiments *)
 
+Section more_lemmas.
+
+Context `{!VSTGS OK_ty Σ}.
 
 Lemma data_at__Tarray:
   forall {CS: compspecs} sh t n a,
   data_at_ sh (Tarray t n a) =
   data_at sh (Tarray t n a) (Zrepeat (default_val t) n).
-Proof.
-intros.
-unfold data_at_, field_at_, data_at.
-extensionality p.
-simpl.
-f_equal.
-Qed.
+Proof. reflexivity. Qed.
 
 Lemma data_at__tarray:
   forall {CS: compspecs} sh t n,
@@ -2890,13 +2916,7 @@ Lemma data_at__Tarray':
   v = Zrepeat (default_val t) n ->
   data_at_ sh (Tarray t n a) = data_at sh (Tarray t n a) v.
 Proof.
-intros.
-unfold data_at_, field_at_, data_at.
-extensionality p.
-simpl.
-f_equal.
-subst.
-reflexivity.
+intros. subst; reflexivity.
 Qed.
 
 Lemma data_at__tarray':
@@ -2905,26 +2925,6 @@ Lemma data_at__tarray':
   data_at_ sh (tarray t n) = data_at sh (tarray t n) v.
 Proof. intros; apply data_at__Tarray'; auto. Qed.
 
-Ltac unfold_data_at_ p :=
- match goal with |- context [data_at_ ?sh ?t p] =>
-  let d := fresh "d" in set (d := data_at_ sh t p);
-  pattern d;
-  let g := fresh "goal" in
-   match goal with |- ?G d => set (g:=G) end;
-  revert d;
-  match t with
-   | Tarray ?t1 ?n _ =>
-          erewrite data_at__Tarray' by apply eq_refl;
-          try change (default_val t1) with Vundef
-   | tarray ?t1 ?n =>
-          erewrite data_at__tarray' by apply eq_refl;
-          try change (default_val t1) with Vundef
-   | _ => change (data_at_ sh t p) with (data_at sh t (default_val t) p);
-              try change (default_val t) with Vundef
-  end;
-  subst g; intro d; subst d; cbv beta
- end.
-
 Lemma change_compspecs_field_at_cancel:
   forall {cs1 cs2: compspecs} {CCE : change_composite_env cs1 cs2}
         (sh: share) (t1 t2: type) gfs
@@ -2934,13 +2934,11 @@ Lemma change_compspecs_field_at_cancel:
     t1 = t2 ->
     cs_preserve_type cs1 cs2 (@coeq cs1 cs2 CCE) t1 = true ->
    JMeq v1 v2 ->
-   @field_at cs1 sh t1 gfs v1 p |-- @field_at cs2 sh t2 gfs v2 p.
+   field_at (cs := cs1) sh t1 gfs v1 p ⊢ field_at (cs := cs2) sh t2 gfs v2 p.
 Proof.
 intros.
 subst t2.
-apply derives_refl'.
-apply equal_f.
-apply @field_at_change_composite with CCE; auto.
+rewrite @field_at_change_composite with CCE; auto.
 Qed.
 
 Lemma change_compspecs_data_at_cancel:
@@ -2951,7 +2949,7 @@ Lemma change_compspecs_data_at_cancel:
     t1 = t2 ->
     cs_preserve_type cs1 cs2 (@coeq cs1 cs2 CCE) t1 = true ->
    JMeq v1 v2 ->
-   @data_at cs1 sh t1 v1 p |-- @data_at cs2 sh t2 v2 p.
+   data_at (cs := cs1) sh t1 v1 p ⊢ data_at (cs := cs2) sh t2 v2 p.
 Proof.
 intros.
 apply change_compspecs_field_at_cancel; auto.
@@ -2963,7 +2961,7 @@ Lemma change_compspecs_field_at_cancel2:
         (p: val),
     t1 = t2 ->
     cs_preserve_type cs1 cs2 (@coeq cs1 cs2 CCE) t1 = true ->
-   @field_at_ cs1 sh t1 gfs p |-- @field_at_ cs2 sh t2 gfs p.
+   field_at_ (cs := cs1) sh t1 gfs p ⊢ field_at_ (cs := cs2) sh t2 gfs p.
 Proof.
 intros.
 subst t2.
@@ -2980,7 +2978,7 @@ Lemma change_compspecs_data_at_cancel2:
         (p: val),
     t1 = t2 ->
     cs_preserve_type cs1 cs2 (@coeq cs1 cs2 CCE) t1 = true ->
-   @data_at_ cs1 sh t1 p |-- @data_at_ cs2 sh t2 p.
+   data_at_ (cs := cs1) sh t1 p ⊢ data_at_ (cs := cs2) sh t2 p.
 Proof.
 intros.
 apply change_compspecs_field_at_cancel2; auto.
@@ -2993,12 +2991,11 @@ Lemma change_compspecs_field_at_cancel3:
         (p: val),
     t1 = t2 ->
     cs_preserve_type cs1 cs2 (@coeq cs1 cs2 CCE) t1 = true ->
-   @field_at cs1 sh t1 gfs v1 p |-- @field_at_ cs2 sh t2 gfs p.
+   field_at (cs := cs1) sh t1 gfs v1 p ⊢ field_at_ (cs := cs2) sh t2 gfs p.
 Proof.
 intros.
 subst t2.
-apply derives_trans with (@field_at_ cs1 sh t1 gfs p).
-apply field_at_field_at_.
+rewrite field_at_field_at_.
 apply @change_compspecs_field_at_cancel2 with CCE; auto.
 Qed.
 
@@ -3009,65 +3006,32 @@ Lemma change_compspecs_data_at_cancel3:
         (p: val),
     t1 = t2 ->
     cs_preserve_type cs1 cs2 (@coeq cs1 cs2 CCE) t1 = true ->
-   @data_at cs1 sh t1 v1 p |-- @data_at_ cs2 sh t2 p.
+   data_at (cs := cs1) sh t1 v1 p ⊢ data_at_ (cs := cs2) sh t2 p.
 Proof.
 intros.
 apply @change_compspecs_field_at_cancel3 with CCE; auto.
 Qed.
 
-#[export] Hint Extern 2 (@data_at_ ?cs1 ?sh _ ?p |-- @data_at_ ?cs2 ?sh _ ?p) =>
-    (tryif constr_eq cs1 cs2 then fail
-     else simple apply change_compspecs_data_at_cancel2; reflexivity) : cancel.
-
-#[export] Hint Extern 2 (@data_at ?cs1 ?sh _ _ ?p |-- @data_at_ ?cs2 ?sh _ ?p) =>
-    (tryif constr_eq cs1 cs2 then fail
-     else simple apply change_compspecs_data_at_cancel3; reflexivity) : cancel.
-
-#[export] Hint Extern 2 (@data_at ?cs1 ?sh _ _ ?p |-- @data_at ?cs2 ?sh _ _ ?p) =>
-    (tryif constr_eq cs1 cs2 then fail
-     else simple apply change_compspecs_data_at_cancel;
-       [ reflexivity | reflexivity | apply JMeq_refl]) : cancel.
-
-#[export] Hint Extern 2 (@field_at_ ?cs1 ?sh _ ?gfs ?p |-- @field_at_ ?cs2 ?sh _ ?gfs ?p) =>
-    (tryif constr_eq cs1 cs2 then fail
-     else simple apply change_compspecs_field_at_cancel2; reflexivity) : cancel.
-
-#[export] Hint Extern 2 (@field_at ?cs1 ?sh _ ?gfs _ ?p |-- @field_at_ ?cs2 ?sh _ ?gfs ?p) =>
-    (tryif constr_eq cs1 cs2 then fail
-     else simple apply change_compspecs_field_at_cancel3; reflexivity) : cancel.
-
-#[export] Hint Extern 2 (@field_at ?cs1 ?sh _ ?gfs _ ?p |-- @field_at ?cs2 ?sh _ ?gfs _ ?p) =>
-    (tryif constr_eq cs1 cs2 then fail
-     else simple apply change_compspecs_field_at_cancel;
-        [ reflexivity | reflexivity | apply JMeq_refl]) : cancel.
-
 Lemma data_at_nullptr:
  forall {cs: compspecs} sh t p,
-  data_at sh size_t nullval p =
+  data_at sh size_t nullval p ⊣⊢
   data_at sh (tptr t) nullval p.
 Proof.
 intros.
 unfold data_at, field_at.
-f_equal.
-f_equal.
+apply bi.and_proper.
+f_equiv.
 unfold field_compatible; simpl.
-f_equal; auto.
-f_equal; auto.
-f_equal.
-f_equal.
-unfold align_compatible.
-destruct p; try auto.
-apply prop_ext; split; intro;
-(eapply align_compatible_rec_by_value_inv in H; [ | reflexivity];
+intuition; destruct p; try auto;
+(eapply align_compatible_rec_by_value_inv in H2; [ | reflexivity];
  eapply align_compatible_rec_by_value; [reflexivity | ];
- apply H).
-simpl.
+ apply H2).
 unfold at_offset.
 rewrite !by_value_data_at_rec_nonvolatile by reflexivity.
 simpl.
 unfold nested_field_type; simpl.
-rewrite <- mapsto_size_t_tptr_nullval with (t:=t).
-f_equal.
+rewrite <- mapsto_tuint_tptr_nullval with (t:=t).
+done.
 Qed.
 
 Lemma data_at_int_or_ptr_int:
@@ -3090,8 +3054,6 @@ Proof.
   eapply align_compatible_rec_by_value_inv in H;
    try reflexivity;
   try (eapply align_compatible_rec_by_value; eauto).
-  reflexivity.
-  reflexivity.
 Qed.
 
 Lemma data_at_int_or_ptr_ptr:
@@ -3117,8 +3079,6 @@ Proof.
   eapply align_compatible_rec_by_value_inv in H;
    try reflexivity;
   try (eapply align_compatible_rec_by_value; eauto).
-  reflexivity.
-  reflexivity.
  unfold at_offset.
  unfold nested_field_type;  simpl.
  unfold data_at_rec; simpl.
@@ -3161,3 +3121,51 @@ intros Hshw Hshr.
 apply nonempty_writable0_glb; try assumption.
 apply writable_writable0; assumption.
 Qed.
+
+End more_lemmas.
+
+Ltac unfold_data_at_ p :=
+ match goal with |- context [data_at_ ?sh ?t p] =>
+  let d := fresh "d" in set (d := data_at_ sh t p);
+  pattern d;
+  let g := fresh "goal" in
+   match goal with |- ?G d => set (g:=G) end;
+  revert d;
+  match t with
+   | Tarray ?t1 ?n _ =>
+          erewrite data_at__Tarray' by apply eq_refl;
+          try change (default_val t1) with Vundef
+   | tarray ?t1 ?n =>
+          erewrite data_at__tarray' by apply eq_refl;
+          try change (default_val t1) with Vundef
+   | _ => change (data_at_ sh t p) with (data_at sh t (default_val t) p);
+              try change (default_val t) with Vundef
+  end;
+  subst g; intro d; subst d; cbv beta
+ end.
+
+#[export] Hint Extern 2 (data_at_(cs := ?cs1) ?sh _ ?p ⊢ data_at_(cs := ?cs2) ?sh _ ?p) =>
+    (tryif constr_eq cs1 cs2 then fail
+     else simple apply change_compspecs_data_at_cancel2; reflexivity) : cancel.
+
+#[export] Hint Extern 2 (data_at(cs := ?cs1) ?sh _ _ ?p ⊢ data_at_(cs := ?cs2) ?sh _ ?p) =>
+    (tryif constr_eq cs1 cs2 then fail
+     else simple apply change_compspecs_data_at_cancel3; reflexivity) : cancel.
+
+#[export] Hint Extern 2 (data_at(cs := ?cs1) ?sh _ _ ?p ⊢ data_at(cs := ?cs2) ?sh _ _ ?p) =>
+    (tryif constr_eq cs1 cs2 then fail
+     else simple apply change_compspecs_data_at_cancel;
+       [ reflexivity | reflexivity | apply JMeq_refl]) : cancel.
+
+#[export] Hint Extern 2 (field_at_(cs := ?cs1) ?sh _ ?gfs ?p ⊢ field_at_(cs := ?cs2) ?sh _ ?gfs ?p) =>
+    (tryif constr_eq cs1 cs2 then fail
+     else simple apply change_compspecs_field_at_cancel2; reflexivity) : cancel.
+
+#[export] Hint Extern 2 (field_at(cs := ?cs1) ?sh _ ?gfs _ ?p ⊢ field_at_(cs := ?cs2) ?sh _ ?gfs ?p) =>
+    (tryif constr_eq cs1 cs2 then fail
+     else simple apply change_compspecs_field_at_cancel3; reflexivity) : cancel.
+
+#[export] Hint Extern 2 (field_at(cs := ?cs1) ?sh _ ?gfs _ ?p ⊢ field_at(cs := ?cs2) ?sh _ ?gfs _ ?p) =>
+    (tryif constr_eq cs1 cs2 then fail
+     else simple apply change_compspecs_field_at_cancel;
+        [ reflexivity | reflexivity | apply JMeq_refl]) : cancel.
diff --git a/floyd/field_at_wand.v b/floyd/field_at_wand.v
index f60bba4184..5be58bb44c 100644
--- a/floyd/field_at_wand.v
+++ b/floyd/field_at_wand.v
@@ -1,4 +1,6 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.nested_field_lemmas.
 Require Import VST.floyd.efield_lemmas.
@@ -14,31 +16,32 @@ Require Import VST.floyd.replace_refill_reptype_lemmas.
 Require Import VST.floyd.loadstore_field_at.
 Require Import VST.floyd.nested_loadstore.
 
-Local Open Scope logic.
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ}.
 
 Definition array_with_hole {cs: compspecs} sh (t: type) lo hi n (al': list (reptype t)) p :=
-!! field_compatible (tarray t n) nil p &&
-(ALL cl: list (reptype t),
+⌜field_compatible (tarray t n) nil p⌝ ∧
+(∀ cl: list (reptype t),
 (data_at sh (tarray t (hi-lo)) cl (field_address0 (tarray t n) (ArraySubsc lo :: nil) p)
--* data_at sh (tarray t n) (sublist 0 lo al' ++ cl ++ sublist hi n al') p)).
+-∗ data_at sh (tarray t n) (sublist 0 lo al' ++ cl ++ sublist hi n al') p)).
 
 Lemma array_with_hole_local_facts {cs: compspecs}: forall sh t lo hi n (al': list (reptype t)) p,
-array_with_hole sh t lo hi n al' p |-- 
-!! (field_compatible (tarray t n) nil p).
+array_with_hole sh t lo hi n al' p ⊢
+⌜field_compatible (tarray t n) nil p⌝.
 Proof.
 intros.
 unfold array_with_hole. entailer!.
 Qed.
-#[export] Hint Resolve array_with_hole_local_facts : saturate_local.
 
 Lemma wand_slice_array:
 forall {cs: compspecs} lo hi n sh t (al: list (reptype t)) p,
 0 <= lo <= hi ->
 hi <= n ->
 Zlength al = n ->
-data_at sh (tarray t n) al p =
-!! (field_compatible (tarray t n) nil p) &&
-data_at sh (tarray t (hi-lo)) (sublist lo hi al) (field_address0 (tarray t n) (ArraySubsc lo :: nil) p) *
+data_at sh (tarray t n) al p ⊣⊢
+⌜field_compatible (tarray t n) nil p⌝ ∧
+data_at sh (tarray t (hi-lo)) (sublist lo hi al) (field_address0 (tarray t n) (ArraySubsc lo :: nil) p) ∗
 array_with_hole sh t lo hi n al p.
 Proof.
   intros until p.
@@ -50,91 +53,51 @@ Proof.
     rewrite reptype_eq.
     auto.
   }
-  apply pred_ext.
-  + rewrite (add_andp _ _ (field_at_local_facts _ _ _ _ _)).
-    normalize.
-    rename H3 into H7, H4 into H8.
-    erewrite field_at_Tarray.
-      2: constructor.
-      2: reflexivity.
-      2: lia.
-      2: apply JMeq_refl.
-    erewrite (split3seg_array_at' _ _ _ 0 lo hi n); try lia.
-      2:etransitivity; [exact H1 | lia].
+  iSplit.
+  + iIntros "H".
+    iDestruct (field_at_local_facts with "H") as %(H7 & H8).
+    rewrite -!prop_and_same_derives' //.
+    erewrite field_at_Tarray by (try done; lia).
+    rewrite (split3seg_array_at' _ _ _ 0 lo hi n); try lia. iDestruct "H" as "(? & ? & ?)".
+    2: { rewrite H1; lia. }
+    rewrite !Z.sub_0_r /data_at; iFrame.
+    iIntros (v) "H".
     unfold data_at.
-    rewrite (sepcon_comm (array_at _ _ _ _ _ _ _)), sepcon_assoc.
-    apply sepcon_derives.
-    - apply derives_refl'.
-      f_equal.
-      rewrite !Z.sub_0_r.
-      auto.
-    - apply allp_right; intros v. change (list (reptype t)) in v.
-      * apply -> wand_sepcon_adjoint.
-        rewrite (add_andp _ _ (field_at_local_facts _ _ _ _ _)).
-        normalize.
-        rewrite value_fits_eq in H4; simpl in H4.
-        destruct H4.
-        rewrite Z.max_r in H4 by lia.
-        change (@Zlength (reptype t) v = hi - lo) in H4.
-        erewrite (field_at_Tarray _ (tarray t n)).
-          2: constructor.
-          2: reflexivity.
-          2: lia.
-          2: apply JMeq_refl.
-        erewrite (split3seg_array_at' _ _ _ 0 lo hi n); try lia.
-        2:{
-          change (Zlength (sublist 0 lo al ++ v ++ sublist hi n al) = n - 0).
-          autorewrite with sublist.
-          lia.
-        }
-        autorewrite with norm.
-        change (array_at sh (tarray t n) nil 0 lo (sublist 0 lo al) p *
-                array_at sh (tarray t n) nil hi n (sublist hi n al) p *
-                field_at sh (tarray t (hi - lo)) nil v (field_address0 (tarray t n) (SUB lo) p)
-                |-- array_at sh (tarray t n) nil 0 lo
-                      (sublist 0 lo (sublist 0 lo al ++ v ++ sublist hi n al)) p *
-                    data_at sh (nested_field_array_type (tarray t n) nil lo hi)
-                      (sublist lo hi (sublist 0 lo al ++ v ++ sublist hi n al))
-                      (field_address0 (tarray t n) (SUB lo) p) *
-                    array_at sh (tarray t n) nil hi n
-                      (sublist hi n (sublist 0 lo al ++ v ++ sublist hi n al)) p).
-        unfold tarray; autorewrite with sublist.
-        rewrite H4.
-        replace (hi - lo - (hi - lo) + hi) with hi by lia.
-        replace (n - lo - (hi - lo) + hi) with n by lia.
-        rewrite !sepcon_assoc.
-        apply sepcon_derives; [apply derives_refl |].
-        rewrite sepcon_comm.
-        apply sepcon_derives; [| apply derives_refl].
-        autorewrite with sublist.
-        apply derives_refl.
-  + normalize.
-    clear H2.
-    rewrite sepcon_comm.
-    apply wand_sepcon_adjoint.
-    apply (allp_left _ (sublist lo hi al)); intros.
-    apply wand_derives; [apply derives_refl |].
-    unfold data_at.
-    apply derives_refl'.
-    f_equal.
+    iDestruct (field_at_local_facts with "H") as %(? & H4).
+    rewrite value_fits_eq in H4; simpl in H4.
+    destruct H4.
+    rewrite -> Z.max_r in H4 by lia.
+    change (@Zlength (reptype t) v = hi - lo) in H4.
+    erewrite (field_at_Tarray _ (tarray t n)) by (try done; lia).
+    erewrite (split3seg_array_at' _ _ _ 0 lo hi n); try lia.
+    2:{ autorewrite with sublist. lia. }
+    autorewrite with norm.
+    unfold tarray; autorewrite with sublist.
+    rewrite H4.
+    replace (hi - lo - (hi - lo) + hi) with hi by lia.
+    replace (n - lo - (hi - lo) + hi) with n by lia.
+    rewrite /data_at; iFrame.
+    autorewrite with sublist; iFrame.
+  + iIntros "(% & ? & _ & H)".
+    rewrite /data_at; iSpecialize ("H" with "[$]").
     autorewrite with sublist.
     auto.
 Qed.
 
-Module SingletonHole.
+Section SingletonHole.
 
-Definition array_with_hole {cs: compspecs} sh (t: type) i n (al': list (reptype t)) p :=
-ALL v:reptype t,
- (data_at sh t v (field_address (tarray t n) (ArraySubsc i :: nil) p) -* data_at sh (tarray t n) (upd_Znth i al' v) p).
+Definition array_with_singleton_hole {cs: compspecs} sh (t: type) i n (al': list (reptype t)) p :=
+∀ v:reptype t,
+ (data_at sh t v (field_address (tarray t n) (ArraySubsc i :: nil) p) -∗ data_at sh (tarray t n) (upd_Znth i al' v) p).
 
-Lemma array_with_hole_intro {cs: compspecs} sh: forall t i n (al: list (reptype t)) p,
+Lemma array_with_singleton_hole_intro {cs: compspecs} sh: forall t i n (al: list (reptype t)) p,
   0 <= i < n ->
-  data_at sh (tarray t n) al p |--
-    data_at sh t (Znth i al) (field_address (tarray t n) (ArraySubsc i :: nil) p) *
-      array_with_hole sh t i n al p.
+  data_at sh (tarray t n) al p ⊢
+    data_at sh t (Znth i al) (field_address (tarray t n) (ArraySubsc i :: nil) p) ∗
+      array_with_singleton_hole sh t i n al p.
 Proof.
   intros.
-  unfold data_at, array_with_hole.
+  unfold data_at, array_with_singleton_hole.
   assert (forall n, reptype (tarray t n) = list (reptype t)).
   {
     intros.
@@ -145,7 +108,7 @@ Proof.
   assert (Zlength al = n).
   {
     destruct H2 as [? _].
-    rewrite Z.max_r in H2 by lia.
+    rewrite -> Z.max_r in H2 by lia.
     rewrite <- H2.
     reflexivity.
   }
@@ -165,9 +128,7 @@ Proof.
   rewrite field_at_data_at.
   change ((nested_field_type (tarray t n) (ArraySubsc i :: nil))) with t.
   cancel.
-  apply allp_right; intros v.
-  apply -> wand_sepcon_adjoint.
-  
+  iIntros.
   unfold data_at at 2.
   erewrite field_at_Tarray.
       2: constructor.
@@ -189,19 +150,16 @@ Proof.
       2: change (nested_field_type (tarray t n) (ArraySubsc 0 :: nil)) with t; lia.
   rewrite sublist_upd_Znth_r; try lia.
       2: change (nested_field_type (tarray t n) (ArraySubsc 0 :: nil)) with t; lia.
-  cancel.
+  iFrame.
 Qed.
 
-Lemma array_with_hole_elim {cs: compspecs} sh: forall t i n (a: reptype t) (al: list (reptype t)) p,
-  data_at sh t a (field_address (tarray t n) (ArraySubsc i :: nil) p) *
-    array_with_hole sh t i n al p |--
+Lemma array_with_singleton_hole_elim {cs: compspecs} sh: forall t i n (a: reptype t) (al: list (reptype t)) p,
+  data_at sh t a (field_address (tarray t n) (ArraySubsc i :: nil) p) ∗
+    array_with_singleton_hole sh t i n al p ⊢
       data_at sh (tarray t n) (upd_Znth i al a) p.
 Proof.
   intros.
-  rewrite sepcon_comm.
-  apply wand_sepcon_adjoint.
-  apply (allp_left _ a).
-  auto.
+  iIntros "(? & H)"; iApply "H"; done.
 Qed.
 
 End SingletonHole.
@@ -211,21 +169,21 @@ Definition splice_into_list {A} (lo hi: Z) (source target : list A) : list A :=
    ++ source 
    ++ sublist hi (Zlength target) target.
 
-Module SegmentHole.
+Section SegmentHole.
 
-Definition array_with_hole {cs: compspecs} sh (t: type) lo hi n (al': list (reptype t)) p :=
-ALL v: list (reptype t),
- (data_at sh (tarray t (hi - lo)) v (field_address0 (tarray t n) (ArraySubsc lo :: nil) p) -* data_at sh (tarray t n) (splice_into_list lo hi v al') p).
+Definition array_with_segment_hole {cs: compspecs} sh (t: type) lo hi n (al': list (reptype t)) p :=
+∀ v: list (reptype t),
+ (data_at sh (tarray t (hi - lo)) v (field_address0 (tarray t n) (ArraySubsc lo :: nil) p) -∗ data_at sh (tarray t n) (splice_into_list lo hi v al') p).
 
-Lemma array_with_hole_intro {cs: compspecs} sh: forall t lo hi n (al: list (reptype t)) p,
+Lemma array_with_segment_hole_intro {cs: compspecs} sh: forall t lo hi n (al: list (reptype t)) p,
   0 <= lo <= hi ->
   hi <= n ->
-  data_at sh (tarray t n) al p |--
-    data_at sh (tarray t (hi - lo)) (sublist lo hi al) (field_address0 (tarray t n) (ArraySubsc lo :: nil) p) *
-      array_with_hole sh t lo hi n al p.
+  data_at sh (tarray t n) al p ⊢
+    data_at sh (tarray t (hi - lo)) (sublist lo hi al) (field_address0 (tarray t n) (ArraySubsc lo :: nil) p) ∗
+      array_with_segment_hole sh t lo hi n al p.
 Proof.
   intros.
-  unfold data_at at 1, array_with_hole.
+  unfold data_at at 1, array_with_segment_hole.
   assert (forall n, reptype (tarray t n) = list (reptype t)).
   {
     intros.
@@ -236,7 +194,7 @@ Proof.
   assert (Zlength al = n).
   {
     destruct H3 as [? _].
-    rewrite Z.max_r in H3 by lia.
+    rewrite -> Z.max_r in H3 by lia.
     rewrite <- H3.
     reflexivity.
   }
@@ -252,17 +210,15 @@ Proof.
   change (tarray t (hi - lo)) with (nested_field_array_type (tarray t n) nil lo hi).
   erewrite <- array_at_data_at''' by first [reflexivity | lia].
   cancel.
-  apply allp_right; intros v.
-  apply -> wand_sepcon_adjoint.
-  
+  iIntros "(? & ?)" (?) "?".
   unfold data_at at 2.
-  assert_PROP (Zlength v = hi - lo).
+  iAssert ⌜Zlength v = hi - lo⌝ as %?.
   {
-    saturate_local.
+    iStopProof; saturate_local.
     destruct H13.
     clear - H H13.
-    apply prop_right.
-    rewrite Z.max_r in H13 by lia.
+    apply bi.pure_intro.
+    rewrite -> Z.max_r in H13 by lia.
     exact H13.
   }
   erewrite field_at_Tarray.
@@ -273,26 +229,26 @@ Proof.
   erewrite (split3seg_array_at _ _ _ 0 lo hi n); try lia.
       2: unfold splice_into_list; autorewrite with sublist; change (nested_field_type (tarray t n) (ArraySubsc 0 :: nil)) with t; lia.
   erewrite <- array_at_data_at''' by first [reflexivity | lia].
-  cancel.
   unfold splice_into_list.
   autorewrite with sublist.
   replace (hi - lo - Zlength v + hi) with hi by lia.
   replace (n - lo - Zlength v + hi) with n by lia.
-  cancel.
+  iFrame.
   autorewrite with sublist.
-  cancel.
+  iFrame.
 Qed.
 
-Lemma array_with_hole_elim {cs: compspecs} sh: forall t lo hi n (a: list (reptype t)) (al: list (reptype t)) p,
-  data_at sh (tarray t (hi - lo)) a (field_address0 (tarray t n) (ArraySubsc lo :: nil) p) *
-    array_with_hole sh t lo hi n al p |--
+Lemma array_with_segment_hole_elim {cs: compspecs} sh: forall t lo hi n (a: list (reptype t)) (al: list (reptype t)) p,
+  data_at sh (tarray t (hi - lo)) a (field_address0 (tarray t n) (ArraySubsc lo :: nil) p) ∗
+    array_with_segment_hole sh t lo hi n al p ⊢
       data_at sh (tarray t n) (splice_into_list lo hi a al) p.
 Proof.
   intros.
-  rewrite sepcon_comm.
-  apply wand_sepcon_adjoint.
-  apply (allp_left _ a).
-  auto.
+  iIntros "(? & H)"; iApply "H"; done.
 Qed.
 
 End SegmentHole.
+
+End mpred.
+
+#[export] Hint Resolve array_with_hole_local_facts : saturate_local.
diff --git a/floyd/field_compat.v b/floyd/field_compat.v
index 523cd3a771..cf688c56ef 100644
--- a/floyd/field_compat.v
+++ b/floyd/field_compat.v
@@ -1,4 +1,6 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.type_induction.
 Require Import VST.floyd.nested_pred_lemmas.
@@ -11,6 +13,8 @@ Require Import VST.floyd.jmeq_lemmas.
 Require Import VST.zlist.sublist.
 Require Import VST.floyd.field_at.
 
+Local Unset SsrRewrite.
+
 Lemma field_compatible_offset_zero:
   forall {cs: compspecs} t gfs p,
     field_compatible t gfs p <-> field_compatible t gfs (offset_val 0 p).
@@ -263,56 +267,71 @@ Qed.
 #[export] Hint Extern 2 (field_compatible0 _ _ (offset_val _ _)) =>
   (apply field_compatible0_nested_field_array; auto with field_compatible) : core. (*FIXME: should be field_compatible*)
 
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ}.
+
+Lemma andp_prop_eq' : forall P P' (Q Q' : mpred) (Hdec : {P} + {~P} ),
+  (P <-> P') -> (P -> (⌜P⌝ ∧ Q) = (⌜P'⌝ ∧ Q')) -> (⌜P⌝ ∧ Q) = (⌜P'⌝ ∧ Q').
+Proof.
+  intros.
+  apply andp_prop_eq; auto; intros.
+  rewrite !prop_true_andp in H0 by tauto; auto.
+Qed.
+
+Lemma split2_data_at_Tarray {cs: compspecs} sh t n n1 (v v' v1 v2: list (reptype t)) p:
+   0 <= n1 <= n ->
+   n <= Zlength v' ->
+   v = (sublist 0 n v') ->
+   v1 = (sublist 0 n1 v') ->
+   v2 = (sublist n1 n v') ->
+   data_at sh (Tarray t n noattr) v p =
+    (data_at sh (Tarray t n1 noattr) v1 p ∗
+     data_at sh (Tarray t (n - n1) noattr) v2 (field_address0 (Tarray t n noattr) (ArraySubsc n1::nil) p)).
+Proof.
+  intros.
+  unfold data_at, field_at; normalize.
+  apply andp_prop_eq'.
+  { apply field_compatible_dec. }
+  { apply field_compatible_Tarray_split; auto. }
+  intros Hcompat.
+  assert (Zlength v = n) as Hv by (subst; autorewrite with sublist; auto).
+  setoid_rewrite field_at_Tarray; eauto; [|lia].
+  rewrite (split2_array_at sh (Tarray t n noattr) nil 0 n1); auto; [|setoid_rewrite Hv; lia].
+  trans (data_at sh (Tarray t n1 noattr) v1 p ∗
+    data_at sh (Tarray t (n - n1) noattr) v2 (field_address0 (Tarray t n noattr) (SUB n1) p)); [|unfold data_at, field_at; normalize].
+  erewrite !array_at_data_at''' by (eauto; lia).
+  subst; autorewrite with sublist.
+  f_equal.
+  rewrite field_address0_offset, !nested_field_offset_ind; simpl; auto.
+  rewrite Z.mul_0_r, isptr_offset_val_zero by (destruct Hcompat; auto).
+  erewrite (data_at_type_changable _ _ (Tarray t n1 noattr)); auto.
+  rewrite nested_field_type_ind; simpl.
+  rewrite Z.sub_0_r; auto.
+  { lia. }
+  { rewrite field_compatible0_cons; simpl; split; auto; lia. }
+Qed.
+
 Lemma split2_data_at_Tarray_unfold {cs: compspecs}
      sh t n n1 (v v' v1 v2: list (reptype t)) p:
    0 <= n1 <= n ->
   v = v' ->
   v1 = (sublist 0 n1 v') ->
   v2 = (sublist n1 n v') ->
-  data_at sh (Tarray t n noattr) v p |--
-  data_at sh (Tarray t n1 noattr) v1 p *
+  data_at sh (Tarray t n noattr) v p ⊢
+  data_at sh (Tarray t n1 noattr) v1 p ∗
   data_at sh (Tarray t (n - n1) noattr) v2
     (field_address0 (Tarray t n noattr) (ArraySubsc n1::nil) p).
 Proof.
   intros.
   assert_PROP (Zlength v' = n). {
-    eapply derives_trans; [apply data_at_local_facts | apply prop_derives].
+    rewrite data_at_local_facts; apply bi.pure_mono.
     intros [? ?]. destruct H4 as [? _]. rewrite Z.max_r in H4 by lia.
     rewrite <- H0. exact H4.
   }
-  assert_PROP (field_compatible0 (Tarray t n noattr) (ArraySubsc n1::nil) p). {
-     eapply derives_trans; [apply data_at_local_facts | apply prop_derives].
-     intros [? _]; auto with field_compatible.
-  }
-  rewrite field_address0_offset by auto.
-  rewrite !nested_field_offset_ind by (repeat split; auto; lia).
-  rewrite nested_field_type_ind. unfold gfield_offset.
-  rewrite Z.add_0_l.
-  rewrite data_at_isptr at 1.
-  unfold data_at at 1. intros; simpl; normalize.
-  erewrite (field_at_Tarray sh  (Tarray t n noattr) _ t); try reflexivity; trivial.
-  2: lia.
-  rewrite (split2_array_at sh (Tarray t n noattr) nil 0 n1).
-  2: auto. 2: rewrite Z.sub_0_r, H0; auto.
-  do 2 rewrite array_at_data_at by tauto.
-  rewrite Zminus_0_r.
-  unfold at_offset.
-  erewrite (data_at_type_changable sh
-            (nested_field_array_type (Tarray t n noattr) nil 0 n1)
-            (Tarray t n1 noattr) _ v1).
-  2: unfold nested_field_array_type; simpl; rewrite Zminus_0_r; trivial.
-  2: rewrite H1, H0; auto.
-  erewrite (data_at_type_changable sh
-            (nested_field_array_type (Tarray t n noattr) nil n1 n)
-            (Tarray t (n - n1) noattr) _  v2).
-  2: unfold nested_field_array_type; simpl; trivial.
-  2: rewrite H2, <- H3, H0; auto.
-  rewrite !nested_field_offset_ind by (repeat split; auto; lia).
-  rewrite !nested_field_type_ind.
-  unfold gfield_offset.
-  rewrite !Z.add_0_l. rewrite Z.mul_0_r.
-  rewrite isptr_offset_val_zero; trivial.
-  normalize.
+  subst; erewrite split2_data_at_Tarray; eauto.
+  - lia.
+  - autorewrite with sublist; auto.
 Qed.
 
 Lemma split2_data_at_Tarray_fold {cs: compspecs} sh t n n1 (v v' v1 v2: list (reptype t)) p:
@@ -321,74 +340,15 @@ Lemma split2_data_at_Tarray_fold {cs: compspecs} sh t n n1 (v v' v1 v2: list (re
    v = (sublist 0 n v') ->
    v1 = (sublist 0 n1 v') ->
    v2 = (sublist n1 n v') ->
-   data_at sh (Tarray t n1 noattr) v1 p *
+   data_at sh (Tarray t n1 noattr) v1 p ∗
    data_at sh (Tarray t (n - n1) noattr) v2
         (field_address0 (Tarray t n noattr) (ArraySubsc n1::nil) p)
-   |--
+   ⊢
    data_at sh (Tarray t n noattr) v p.
 Proof.
-  intros until 1. intro Hn; intros.
-  unfold field_address0.
-  if_tac; [ |
-  eapply derives_trans; [apply sepcon_derives;
-           apply prop_and_same_derives; apply data_at_local_facts
-    | normalize ];
-  destruct H6; contradiction].
-  assert_PROP (field_compatible (Tarray t n noattr) nil p). {
-    eapply derives_trans.
-    apply sepcon_derives; apply prop_and_same_derives; apply data_at_local_facts .
-    normalize. apply prop_right.
-   clear - H3 H4 H.
-   hnf in H3,H4|-*; intuition.
-  } clear H3; rename H4 into H3.
-  rewrite data_at_isptr at 1. unfold at_offset. intros; normalize.
-  unfold data_at at 3.  erewrite field_at_Tarray; try reflexivity; eauto; try lia.
-  rewrite H0.
-  rewrite (split2_array_at sh (Tarray t n noattr) nil 0 n1); trivial.
-  2: autorewrite with sublist; auto.
-  autorewrite with sublist.
-  unfold data_at at 1; erewrite field_at_Tarray; try reflexivity; eauto; try lia.
-  unfold data_at at 1; erewrite field_at_Tarray; try reflexivity; eauto; try lia.
-  apply sepcon_derives.
-  unfold array_at.
-  rewrite H1.
-  simpl. apply andp_derives; auto.
-  2: apply derives_refl. 
-  apply prop_derives. intuition auto with field_compatible.
-  assert (sublist n1 (Z.min n (Zlength v')) v' = sublist n1 n v').
-  f_equal. autorewrite with sublist. auto.
-  rewrite H2.
-  clear - H H3.
-  rewrite array_at_data_at by lia. normalize.
-  rewrite array_at_data_at by lia.
-  rewrite !prop_true_andp by auto with field_compatible.
-  unfold at_offset.
-  apply derives_refl'.
-  rewrite offset_offset_val.
-  rewrite !nested_field_offset_ind by (repeat split; auto; lia).
-  rewrite !nested_field_type_ind. unfold gfield_offset.
-  rewrite !Z.add_0_l. rewrite Z.mul_0_r, Z.add_0_r.
-  apply equal_f.
-  apply data_at_type_changable; auto.
-  unfold nested_field_array_type.
-  rewrite !nested_field_type_ind.  unfold gfield_type. simpl. f_equal; lia.
-Qed.
-
-Lemma split2_data_at_Tarray {cs: compspecs} sh t n n1 (v v' v1 v2: list (reptype t)) p:
-   0 <= n1 <= n ->
-   n <= Zlength v' ->
-   v = (sublist 0 n v') ->
-   v1 = (sublist 0 n1 v') ->
-   v2 = (sublist n1 n v') ->
-   data_at sh (Tarray t n noattr) v p =
-    data_at sh (Tarray t n1 noattr) v1 p *
-    data_at sh (Tarray t (n - n1) noattr) v2 (field_address0 (Tarray t n noattr) (ArraySubsc n1::nil) p).
-Proof. intros.
- apply pred_ext.
- eapply split2_data_at_Tarray_unfold; try eassumption.
-  autorewrite with sublist; auto.
-  autorewrite with sublist; auto.
- eapply split2_data_at_Tarray_fold; try eassumption.
+  intros.
+  erewrite <-
+ split2_data_at_Tarray; eauto.
 Qed.
 
 Lemma field_compatible0_Tarray_offset:
@@ -401,7 +361,7 @@ Lemma field_compatible0_Tarray_offset:
   p' = offset_val (sizeof t * (i'-i)) p ->
   field_compatible0 (Tarray t n noattr) (ArraySubsc i :: nil) p'.
 Proof.
-intros until 1. intros ?H ?H Hni Hii Hp. subst p'.
+  intros until 1. intros ?H ?H Hni Hii Hp. subst p'.
   assert (SP := sizeof_pos t).
   assert (SS: sizeof t * n <= sizeof t * n').
   apply Zmult_le_compat_l. lia. lia.
@@ -461,10 +421,11 @@ Lemma split3_data_at_Tarray {cs: compspecs} sh t n n1 n2 v (v' v1 v2 v3: list (r
    v2 = (sublist n1 n2 v') ->
    v3 = (sublist n2 n v') ->
    data_at sh (Tarray t n noattr) v p =
-    data_at sh (Tarray t n1 noattr) v1 p *
-    data_at sh (Tarray t (n2 - n1) noattr) v2 (field_address0 (Tarray t n noattr) (ArraySubsc n1::nil) p) *
-    data_at sh (Tarray t (n - n2) noattr) v3 (field_address0 (Tarray t n noattr) (ArraySubsc n2::nil) p).
-Proof. intros until 1. rename H into NA; intros.
+    (data_at sh (Tarray t n1 noattr) v1 p ∗
+     data_at sh (Tarray t (n2 - n1) noattr) v2 (field_address0 (Tarray t n noattr) (ArraySubsc n1::nil) p) ∗
+     data_at sh (Tarray t (n - n2) noattr) v3 (field_address0 (Tarray t n noattr) (ArraySubsc n2::nil) p)).
+Proof.
+  intros until 1. rename H into NA; intros.
   destruct (field_compatible0_dec (tarray t n) (ArraySubsc n2::nil) p).
   erewrite (split2_data_at_Tarray sh t n n1); try eassumption; try lia.
   instantiate (1:= sublist n1 n v').
@@ -478,14 +439,12 @@ Proof. intros until 1. rename H into NA; intros.
   2: autorewrite with sublist;
      instantiate (1:= sublist n2 n v');
      auto.
-  rewrite sepcon_assoc.
-  f_equal. f_equal. f_equal. auto.
+  f_equiv. f_equiv. f_equiv. auto.
   replace  (field_address0 (Tarray t (n - n1) noattr) (SUB (n2 - n1))
      (field_address0 (Tarray t n noattr) (SUB n1) p))
    with (field_address0 (Tarray t n noattr) (SUB n2) p).
-  apply equal_f.
-  replace (n - n1 - (n2 - n1)) with (n - n2) by lia.
-  subst v3; reflexivity.
+  { replace (n - n1 - (n2 - n1)) with (n - n2) by lia.
+    subst v3; reflexivity. }
   rewrite field_address0_offset by auto with field_compatible.
   rewrite (field_address0_offset (Tarray t n noattr) ) by auto with field_compatible.
   rewrite field_address0_offset.
@@ -499,43 +458,43 @@ Proof. intros until 1. rename H into NA; intros.
   rewrite Z.add_0_l.
   eapply field_compatible0_Tarray_offset; try eassumption; try lia.
   f_equal. f_equal. lia.
-  apply pred_ext.
-  eapply derives_trans. apply data_at_local_facts. normalize.
-  contradiction n0. auto with field_compatible.
-  unfold field_address0 at 2.
-  if_tac.
-  contradiction n0. auto with field_compatible.
-  eapply derives_trans. apply sepcon_derives; [apply derives_refl | ].
-  apply prop_and_same_derives; apply data_at_local_facts .
-  normalize. destruct H6 as [H6 _]; contradiction H6.
+  unfold data_at, field_at; normalize; rewrite !prop_false_andp; auto.
+  - intros (? & ? & Hcompat).
+    unfold field_address0 in Hcompat.
+    if_tac in Hcompat; auto.
+    destruct Hcompat; done.
+  - intros ?.
+    contradiction n0. auto with field_compatible.
 Qed.
 
 Lemma split2_data_at_Tarray_tuchar {cs: compspecs} sh n n1 (v: list val) p:
    0 <= n1 <= n ->
    Zlength v = n ->
    data_at sh (Tarray tuchar n noattr) v p =
-    data_at sh (Tarray tuchar n1 noattr) (sublist 0 n1 v) p *
-    data_at sh (Tarray tuchar (n - n1) noattr) (sublist n1 n v) (field_address0 (Tarray tuchar n noattr) (ArraySubsc n1::nil) p).
-Proof. intros.
- eapply split2_data_at_Tarray; auto;
- change (@reptype cs tuchar) with val.
- symmetry in H0.
- list_solve.
- rewrite sublist_same; try lia; auto.
+   (data_at sh (Tarray tuchar n1 noattr) (sublist 0 n1 v) p ∗
+    data_at sh (Tarray tuchar (n - n1) noattr) (sublist n1 n v) (field_address0 (Tarray tuchar n noattr) (ArraySubsc n1::nil) p)).
+Proof.
+  intros.
+  eapply split2_data_at_Tarray; auto;
+  change (@reptype cs tuchar) with val.
+  symmetry in H0.
+  list_solve.
+  rewrite sublist_same; try lia; auto.
 Qed.
 
 Lemma split2_data_at_Tarray_tschar {cs: compspecs} sh n n1 (v: list val) p:
    0 <= n1 <= n ->
    Zlength v = n ->
    data_at sh (Tarray tschar n noattr) v p =
-    data_at sh (Tarray tschar n1 noattr) (sublist 0 n1 v) p *
-    data_at sh (Tarray tschar (n - n1) noattr) (sublist n1 n v) (field_address0 (Tarray tschar n noattr) (ArraySubsc n1::nil) p).
-Proof. intros.
- eapply split2_data_at_Tarray; auto;
- change (@reptype cs tschar) with val.
- symmetry in H0.
- list_solve.
- rewrite sublist_same; try lia; auto.
+   (data_at sh (Tarray tschar n1 noattr) (sublist 0 n1 v) p ∗
+    data_at sh (Tarray tschar (n - n1) noattr) (sublist n1 n v) (field_address0 (Tarray tschar n noattr) (ArraySubsc n1::nil) p)).
+Proof.
+  intros.
+  eapply split2_data_at_Tarray; auto;
+  change (@reptype cs tschar) with val.
+  symmetry in H0.
+  list_solve.
+  rewrite sublist_same; try lia; auto.
 Qed.
 
 Lemma split3_data_at_Tarray_tuchar {cs: compspecs} sh n n1 n2 (v: list val) p:
@@ -543,14 +502,15 @@ Lemma split3_data_at_Tarray_tuchar {cs: compspecs} sh n n1 n2 (v: list val) p:
    n2 <= n ->
    Zlength v = n ->
    data_at sh (Tarray tuchar n noattr) v p =
-    data_at sh (Tarray tuchar n1 noattr) (sublist 0 n1 v) p *
-    data_at sh (Tarray tuchar (n2 - n1) noattr) (sublist n1 n2 v) (field_address0 (Tarray tuchar n noattr) (ArraySubsc n1::nil) p) *
-    data_at sh (Tarray tuchar (n - n2) noattr) (sublist n2 n v) (field_address0 (Tarray tuchar n noattr) (ArraySubsc n2::nil) p).
-Proof. intros.
- eapply split3_data_at_Tarray; auto;
- change (@reptype cs tuchar) with val.
+   (data_at sh (Tarray tuchar n1 noattr) (sublist 0 n1 v) p ∗
+    data_at sh (Tarray tuchar (n2 - n1) noattr) (sublist n1 n2 v) (field_address0 (Tarray tuchar n noattr) (ArraySubsc n1::nil) p) ∗
+    data_at sh (Tarray tuchar (n - n2) noattr) (sublist n2 n v) (field_address0 (Tarray tuchar n noattr) (ArraySubsc n2::nil) p)).
+Proof.
+  intros.
+  eapply split3_data_at_Tarray; auto;
+  change (@reptype cs tuchar) with val.
   split; simpl; auto. list_solve.
- rewrite sublist_same; try lia; auto.
+  rewrite sublist_same; try lia; auto.
 Qed.
 
 Lemma split3_data_at_Tarray_tschar {cs: compspecs} sh n n1 n2 (v: list val) p:
@@ -558,30 +518,32 @@ Lemma split3_data_at_Tarray_tschar {cs: compspecs} sh n n1 n2 (v: list val) p:
    n2 <= n ->
    Zlength v = n ->
    data_at sh (Tarray tschar n noattr) v p =
-    data_at sh (Tarray tschar n1 noattr) (sublist 0 n1 v) p *
-    data_at sh (Tarray tschar (n2 - n1) noattr) (sublist n1 n2 v) (field_address0 (Tarray tschar n noattr) (ArraySubsc n1::nil) p) *
-    data_at sh (Tarray tschar (n - n2) noattr) (sublist n2 n v) (field_address0 (Tarray tschar n noattr) (ArraySubsc n2::nil) p).
-Proof. intros.
- eapply split3_data_at_Tarray; auto;
- change (@reptype cs tschar) with val.
+   (data_at sh (Tarray tschar n1 noattr) (sublist 0 n1 v) p ∗
+    data_at sh (Tarray tschar (n2 - n1) noattr) (sublist n1 n2 v) (field_address0 (Tarray tschar n noattr) (ArraySubsc n1::nil) p) ∗
+    data_at sh (Tarray tschar (n - n2) noattr) (sublist n2 n v) (field_address0 (Tarray tschar n noattr) (ArraySubsc n2::nil) p)).
+Proof.
+  intros.
+  eapply split3_data_at_Tarray; auto;
+  change (@reptype cs tschar) with val.
   split; simpl; auto. list_solve.
- rewrite sublist_same; try lia; auto.
+  rewrite sublist_same; try lia; auto.
 Qed.
 
-Lemma sizeof_tarray_tuchar {cs} n (N:0<=n): @sizeof cs (tarray tuchar n) = n.
+Lemma sizeof_tarray_tuchar {cs : compspecs} n (N:0<=n): @sizeof cs (tarray tuchar n) = n.
 Proof. unfold sizeof; simpl. rewrite Z.max_r. destruct n; trivial. lia. Qed. 
 
-Lemma sizeof_tarray_tschar {cs} n (N:0<=n): @sizeof cs (tarray tschar n) = n.
+Lemma sizeof_tarray_tschar {cs : compspecs} n (N:0<=n): @sizeof cs (tarray tschar n) = n.
 Proof. unfold sizeof; simpl. rewrite Z.max_r. destruct n; trivial. lia. Qed. 
 
 Opaque sizeof.
 Import ListNotations.
 
-Lemma memory_block_field_compatible_tarraytuchar_ent {cs} sh n p (N:0<=n < Ptrofs.modulus):
-memory_block sh n p |-- !! @field_compatible cs (tarray tuchar n) nil p.
-Proof. Transparent memory_block. unfold memory_block. Opaque memory_block.
-   destruct p; try solve [apply FF_left]. normalize.
-   apply prop_right. red.
+Lemma memory_block_field_compatible_tarraytuchar_ent {cs : compspecs} sh n p (N:0<=n < Ptrofs.modulus):
+memory_block sh n p ⊢ ⌜@field_compatible cs (tarray tuchar n) nil p⌝.
+Proof.
+  Transparent memory_block. unfold memory_block. Opaque memory_block.
+   destruct p; try solve [iIntros "[]"]. normalize.
+   apply bi.pure_intro. red.
    destruct (Ptrofs.unsigned_range i). simpl.
    repeat split; try rewrite sizeof_tarray_tuchar; trivial; try lia.
    (* TODO: abstract this proof. *)
@@ -594,11 +556,12 @@ Proof. Transparent memory_block. unfold memory_block. Opaque memory_block.
    + reflexivity.
 Qed.
 
-Lemma memory_block_field_compatible_tarraytschar_ent {cs} sh n p (N:0<=n < Ptrofs.modulus):
-memory_block sh n p |-- !! @field_compatible cs (tarray tschar n) nil p.
-Proof. Transparent memory_block. unfold memory_block. Opaque memory_block.
-   destruct p; try solve [apply FF_left]. normalize.
-   apply prop_right. red.
+Lemma memory_block_field_compatible_tarraytschar_ent {cs : compspecs} sh n p (N:0<=n < Ptrofs.modulus):
+memory_block sh n p ⊢ ⌜@field_compatible cs (tarray tschar n) nil p⌝.
+Proof.
+  Transparent memory_block. unfold memory_block. Opaque memory_block.
+   destruct p; try solve [iIntros "[]"]. normalize.
+   apply bi.pure_intro. red.
    destruct (Ptrofs.unsigned_range i). simpl.
    repeat split; try rewrite sizeof_tarray_tschar; trivial; try lia.
    (* TODO: abstract this proof. *)
@@ -611,22 +574,22 @@ Proof. Transparent memory_block. unfold memory_block. Opaque memory_block.
    + reflexivity.
 Qed.
 
-Lemma memory_block_field_compatible_tarraytuchar {cs} sh n p (N:0<=n < Ptrofs.modulus):
-memory_block sh n p = !!(@field_compatible cs (tarray tuchar n) nil p) && memory_block sh n p.
-Proof. apply pred_ext. apply andp_right; trivial. apply memory_block_field_compatible_tarraytuchar_ent; trivial.
+Lemma memory_block_field_compatible_tarraytuchar {cs : compspecs} sh n p (N:0<=n < Ptrofs.modulus):
+memory_block sh n p ⊣⊢ ⌜@field_compatible cs (tarray tuchar n) nil p⌝ ∧ memory_block sh n p.
+Proof. apply bi.equiv_entails_2. apply bi.and_intro; trivial. apply memory_block_field_compatible_tarraytuchar_ent; trivial.
 normalize.
 Qed. 
 
-Lemma memory_block_field_compatible_tarraytschar {cs} sh n p (N:0<=n < Ptrofs.modulus):
-memory_block sh n p = !!(@field_compatible cs (tarray tschar n) nil p) && memory_block sh n p.
-Proof. apply pred_ext. apply andp_right; trivial. apply memory_block_field_compatible_tarraytschar_ent; trivial.
+Lemma memory_block_field_compatible_tarraytschar {cs : compspecs} sh n p (N:0<=n < Ptrofs.modulus):
+memory_block sh n p ⊣⊢ ⌜@field_compatible cs (tarray tschar n) nil p⌝ ∧ memory_block sh n p.
+Proof. apply bi.equiv_entails_2. apply bi.and_intro; trivial. apply memory_block_field_compatible_tarraytschar_ent; trivial.
 normalize.
 Qed. 
 
-Lemma memory_block_data_at__tarray_tuchar {cs} sh p n (N: 0<=n < Ptrofs.modulus):
-  memory_block sh n p |-- @data_at_ cs sh (tarray tuchar n) p.
+Lemma memory_block_data_at__tarray_tuchar {cs : compspecs} sh p n (N: 0<=n < Ptrofs.modulus):
+  memory_block sh n p ⊢ data_at_ sh (tarray tuchar n) p.
 Proof. 
-  rewrite memory_block_field_compatible_tarraytuchar, memory_block_isptr; trivial. 
+  rewrite memory_block_field_compatible_tarraytuchar, memory_block_isptr; trivial.
   normalize. destruct p; try solve [inv Pp].
   unfold data_at_, data_at.
   rewrite field_at__memory_block. 
@@ -635,38 +598,38 @@ Proof.
   rewrite Ptrofs.add_zero, sizeof_tarray_tuchar; try apply derives_refl; lia.
 Qed.
 
-Lemma memory_block_data_at__tarray_tschar {cs} sh p n (N: 0<=n < Ptrofs.modulus):
-  memory_block sh n p |-- @data_at_ cs sh (tarray tschar n) p.
+Lemma memory_block_data_at__tarray_tschar {cs : compspecs} sh p n (N: 0<=n < Ptrofs.modulus):
+  memory_block sh n p ⊢ data_at_ sh (tarray tschar n) p.
 Proof. 
-  rewrite memory_block_field_compatible_tarraytschar, memory_block_isptr; trivial. 
+  rewrite memory_block_field_compatible_tarraytschar, memory_block_isptr; trivial.
   normalize. destruct p; try solve [inv Pp].
   unfold data_at_, data_at.
-  rewrite field_at__memory_block. 
+  rewrite field_at__memory_block.
   unfold field_address. rewrite if_true; trivial.
   unfold nested_field_offset, nested_field_type; simpl.
   rewrite Ptrofs.add_zero, sizeof_tarray_tschar; try apply derives_refl; lia.
 Qed.
 
-Lemma memory_block_data_at__tarray_tuchar_eq {cs} sh p n (N: 0<=n < Ptrofs.modulus):
-  memory_block sh n p = @data_at_ cs sh (tarray tuchar n) p.
+Lemma memory_block_data_at__tarray_tuchar_eq {cs : compspecs} sh p n (N: 0<=n < Ptrofs.modulus):
+  memory_block sh n p ⊣⊢ data_at_ sh (tarray tuchar n) p.
 Proof.
-  apply pred_ext. apply memory_block_data_at__tarray_tuchar; trivial.
-  rewrite data_at__memory_block; simpl. normalize. 
-  rewrite sizeof_tarray_tuchar; try apply derives_refl; lia. 
+  apply bi.equiv_entails_2. apply memory_block_data_at__tarray_tuchar; trivial.
+  rewrite data_at__memory_block; simpl. normalize.
+  rewrite sizeof_tarray_tuchar; try apply derives_refl; lia.
 Qed.
 
-Lemma memory_block_data_at__tarray_tschar_eq {cs} sh p n (N: 0<=n < Ptrofs.modulus):
-  memory_block sh n p = @data_at_ cs sh (tarray tschar n) p.
+Lemma memory_block_data_at__tarray_tschar_eq {cs : compspecs} sh p n (N: 0<=n < Ptrofs.modulus):
+  memory_block sh n p ⊣⊢ data_at_ sh (tarray tschar n) p.
 Proof.
-  apply pred_ext. apply memory_block_data_at__tarray_tschar; trivial.
+  apply bi.equiv_entails_2. apply memory_block_data_at__tarray_tschar; trivial.
   rewrite data_at__memory_block; simpl. normalize. 
   rewrite sizeof_tarray_tschar; try apply derives_refl; lia. 
 Qed.
 
-Lemma isptr_field_compatible0_tarray {cs}:
+Lemma isptr_field_compatible0_tarray {cs : compspecs}:
   forall t (H: complete_legal_cosu_type t = true) p,
        isptr p -> 
-      @field_compatible cs (tarray t 0) nil p.
+      field_compatible (tarray t 0) nil p.
 Proof. intros; red. destruct p; try contradiction.
   repeat split; simpl; trivial.
   change (sizeof (tarray t 0)) with (sizeof t * 0)%Z.
@@ -677,14 +640,14 @@ Qed.
 
 Transparent sizeof.
 
-Lemma data_at_singleton_array {cs} sh t vl v p:
+Lemma data_at_singleton_array {cs : compspecs} sh t vl v p:
   vl = [v] ->
-  @data_at cs sh t v p |-- @data_at cs sh (tarray t 1) vl p.  
+  data_at sh t v p ⊢ data_at sh (tarray t 1) vl p.
 Proof.
   intros. rename H into Heq.
   rewrite data_at_isptr. normalize.
   assert_PROP (field_compatible (tarray t 1) [] p).
-  { eapply derives_trans. eapply data_at_local_facts. normalize.
+  { iIntros "H"; iDestruct (data_at_local_facts with "H") as %(? & ?); iPureIntro.
     destruct p; auto.
     inv_int i.
     destruct H as [? [? [? [? ?]]]].
@@ -707,13 +670,13 @@ Proof.
   eapply field_compatible_cons_Tarray. reflexivity. trivial. lia.
 Qed.
 
-Lemma data_at_singleton_array_inv {cs} sh t (vl : list (reptype t)) v p:
+Lemma data_at_singleton_array_inv {cs : compspecs} sh t (vl : list (reptype t)) v p:
   vl = [v] ->
-  @data_at cs sh (tarray t 1) vl p |-- @data_at cs sh t v p.  
+  data_at sh (tarray t 1) vl p ⊢ data_at sh t v p.
 Proof.
   rewrite data_at_isptr. normalize.
   assert_PROP (field_compatible (tarray t 1) [] p).
-  { eapply derives_trans. eapply data_at_local_facts. normalize. }
+  { rewrite data_at_local_facts; apply bi.pure_mono; tauto. }
   unfold data_at at 1.
   erewrite field_at_Tarray.
   2: simpl; trivial. 2: reflexivity. 2: lia. 2: apply JMeq_refl.
@@ -727,62 +690,62 @@ Proof.
 Qed.
 
 Opaque sizeof.
- 
-Lemma data_at_singleton_array_eq {cs} sh t v (vl: list (reptype t)) p:
+
+Lemma data_at_singleton_array_eq {cs : compspecs} sh t v (vl: list (reptype t)) p:
   vl = [v] ->
-  @data_at cs sh (tarray t 1) vl p = @data_at cs sh t v p.  
+  data_at sh (tarray t 1) vl p ⊣⊢ data_at sh t v p.
 Proof. 
   intros.
-   apply pred_ext.
+   apply bi.equiv_entails_2.
   apply data_at_singleton_array_inv; rewrite H; auto.
   apply data_at_singleton_array; auto.
 Qed.
 
-Lemma data_at_tuchar_singleton_array {cs} sh (v: val) p:
-  @data_at cs sh tuchar v p |-- @data_at cs sh (tarray tuchar 1) [v] p.  
+Lemma data_at_tuchar_singleton_array {cs : compspecs} sh (v: val) p:
+  data_at sh tuchar v p ⊢ data_at sh (tarray tuchar 1) [v] p.
 Proof. apply data_at_singleton_array. reflexivity. Qed.
 
-Lemma data_at_tschar_singleton_array {cs} sh (v: val) p:
-  @data_at cs sh tschar v p |-- @data_at cs sh (tarray tschar 1) [v] p.  
+Lemma data_at_tschar_singleton_array {cs : compspecs} sh (v: val) p:
+  data_at sh tschar v p ⊢ data_at sh (tarray tschar 1) [v] p.
 Proof. apply data_at_singleton_array. reflexivity. Qed.
 
-Lemma data_at_tuchar_singleton_array_inv {cs} sh (v: val) p:
-  @data_at cs sh (tarray tuchar 1) [v] p |-- @data_at cs sh tuchar v p.  
+Lemma data_at_tuchar_singleton_array_inv {cs : compspecs} sh (v: val) p:
+  data_at sh (tarray tuchar 1) [v] p ⊢ data_at sh tuchar v p.
 Proof. apply data_at_singleton_array_inv. reflexivity. Qed.
 
-Lemma data_at_tschar_singleton_array_inv {cs} sh (v: val) p:
-  @data_at cs sh (tarray tschar 1) [v] p |-- @data_at cs sh tschar v p.  
+Lemma data_at_tschar_singleton_array_inv {cs : compspecs} sh (v: val) p:
+  data_at sh (tarray tschar 1) [v] p ⊢ data_at sh tschar v p.
 Proof. apply data_at_singleton_array_inv. reflexivity. Qed.
 
-Lemma data_at_tuchar_singleton_array_eq {cs} sh (v: val) p:
-  @data_at cs sh (tarray tuchar 1) [v] p = @data_at cs sh tuchar v p.  
+Lemma data_at_tuchar_singleton_array_eq {cs : compspecs} sh (v: val) p:
+  data_at sh (tarray tuchar 1) [v] p ⊣⊢ data_at sh tuchar v p.
 Proof. apply data_at_singleton_array_eq. reflexivity. Qed.
 
-Lemma data_at_tschar_singleton_array_eq {cs} sh (v: val) p:
-  @data_at cs sh (tarray tschar 1) [v] p = @data_at cs sh tschar v p.  
+Lemma data_at_tschar_singleton_array_eq {cs : compspecs} sh (v: val) p:
+  data_at sh (tarray tschar 1) [v] p ⊣⊢ data_at sh tschar v p.
 Proof. apply data_at_singleton_array_eq. reflexivity. Qed.
 
-Lemma data_at_zero_array {cs} sh t (v: list (reptype t)) p:
+Lemma data_at_zero_array {cs : compspecs} sh t (v: list (reptype t)) p:
   complete_legal_cosu_type t = true ->
   isptr p ->
   v = (@nil (reptype t)) ->
-  emp |-- @data_at cs sh (tarray t 0) v p.  
+  emp ⊢ data_at sh (tarray t 0) v p.
 Proof. intros.
   unfold data_at. 
   erewrite field_at_Tarray. 3: reflexivity. 3: lia. 3: apply JMeq_refl. 2: simpl; trivial.
   rewrite H1.
-  rewrite array_at_len_0. apply andp_right; try apply derives_refl.
-  apply prop_right.
+  rewrite array_at_len_0. apply bi.and_intro; try apply derives_refl.
+  apply bi.pure_intro.
   apply field_compatible0_ArraySubsc0.
   apply isptr_field_compatible0_tarray; auto.
- simpl.
+  simpl.
   split; auto. lia.
 Qed.
 
-Lemma data_at_zero_array_inv {cs} sh t (v: list (reptype t)) p:
+Lemma data_at_zero_array_inv {cs : compspecs} sh t (v: list (reptype t)) p:
   complete_legal_cosu_type t = true ->
   v = (@nil (reptype t)) ->
-  @data_at cs sh (tarray t 0) v p |-- emp.  
+  data_at sh (tarray t 0) v p ⊢ emp.
 Proof. intros.
   unfold data_at. 
   erewrite field_at_Tarray. 3: reflexivity. 3: lia. 3: rewrite H0; apply JMeq_refl. 2: simpl; trivial.
@@ -790,83 +753,84 @@ Proof. intros.
   rewrite array_at_len_0. normalize. 
 Qed.
 
-Lemma data_at_zero_array_eq {cs} sh t (v: list (reptype t)) p:
+Lemma data_at_zero_array_eq {cs : compspecs} sh t (v: list (reptype t)) p:
   complete_legal_cosu_type t = true ->
   isptr p ->
   v = (@nil (reptype t)) ->
-  @data_at cs sh (tarray t 0) v p = emp.
+  data_at sh (tarray t 0) v p ⊣⊢ emp.
 Proof. intros. 
-  apply pred_ext.
+  apply bi.equiv_entails_2.
   apply data_at_zero_array_inv; auto.
   apply data_at_zero_array; auto.
 Qed. 
 
-Lemma data_at_tuchar_zero_array {cs} sh p: isptr p ->
-  emp |-- @data_at cs sh (tarray tuchar 0) [] p.  
+Lemma data_at_tuchar_zero_array {cs : compspecs} sh p: isptr p ->
+  emp ⊢ data_at sh (tarray tuchar 0) [] p.
 Proof. intros. apply data_at_zero_array; auto. Qed.
 
-Lemma data_at_tschar_zero_array {cs} sh p: isptr p ->
-  emp |-- @data_at cs sh (tarray tschar 0) [] p.  
+Lemma data_at_tschar_zero_array {cs : compspecs} sh p: isptr p ->
+  emp ⊢ data_at sh (tarray tschar 0) [] p.
 Proof. intros. apply data_at_zero_array; auto. Qed.
 
-Lemma data_at_tuchar_zero_array_inv {cs} sh p:
-  @data_at cs sh (tarray tuchar 0) [] p |-- emp.  
+Lemma data_at_tuchar_zero_array_inv {cs : compspecs} sh p:
+  data_at sh (tarray tuchar 0) [] p ⊢ emp.
 Proof. intros. apply data_at_zero_array_inv; auto. Qed.
 
-Lemma data_at_tschar_zero_array_inv {cs} sh p:
-  @data_at cs sh (tarray tschar 0) [] p |-- emp.  
+Lemma data_at_tschar_zero_array_inv {cs : compspecs} sh p:
+  data_at sh (tarray tschar 0) [] p ⊢ emp.
 Proof. intros. apply data_at_zero_array_inv; auto. Qed.
 
-Lemma data_at_tuchar_zero_array_eq {cs} sh p:
+Lemma data_at_tuchar_zero_array_eq {cs : compspecs} sh p:
   isptr p ->
-  @data_at cs sh (tarray tuchar 0) [] p = emp.  
+  data_at sh (tarray tuchar 0) [] p ⊣⊢ emp.
 Proof. intros. apply data_at_zero_array_eq; auto. Qed.
 
-Lemma data_at_tschar_zero_array_eq {cs} sh p:
+Lemma data_at_tschar_zero_array_eq {cs : compspecs} sh p:
   isptr p ->
-  @data_at cs sh (tarray tschar 0) [] p = emp.  
+  data_at sh (tarray tschar 0) [] p ⊣⊢ emp.
 Proof. intros. apply data_at_zero_array_eq; auto. Qed.
 
-Lemma data_at__tuchar_zero_array {cs} sh p (H: isptr p):
-  emp |-- @data_at_ cs sh (tarray tuchar 0) p.  
+Lemma data_at__tuchar_zero_array {cs : compspecs} sh p (H: isptr p):
+  emp ⊢ data_at_ sh (tarray tuchar 0) p.
 Proof. unfold data_at_, field_at_. apply data_at_tuchar_zero_array; trivial. Qed.
 
-Lemma data_at__tschar_zero_array {cs} sh p (H: isptr p):
-  emp |-- @data_at_ cs sh (tarray tschar 0) p.  
+Lemma data_at__tschar_zero_array {cs : compspecs} sh p (H: isptr p):
+  emp ⊢ data_at_ sh (tarray tschar 0) p.
 Proof. unfold data_at_, field_at_. apply data_at_tschar_zero_array; trivial. Qed.
 
-Lemma data_at__tuchar_zero_array_inv {cs} sh p:
-  @data_at_ cs sh (tarray tuchar 0) p |-- emp.  
+Lemma data_at__tuchar_zero_array_inv {cs : compspecs} sh p:
+  data_at_ sh (tarray tuchar 0) p ⊢ emp.
 Proof. unfold data_at_, field_at_. apply data_at_tuchar_zero_array_inv. Qed.
 
-Lemma data_at__tschar_zero_array_inv {cs} sh p:
-  @data_at_ cs sh (tarray tschar 0) p |-- emp.  
+Lemma data_at__tschar_zero_array_inv {cs : compspecs} sh p:
+  data_at_ sh (tarray tschar 0) p ⊢ emp.
 Proof. unfold data_at_, field_at_. apply data_at_tschar_zero_array_inv. Qed.
 
-Lemma data_at__tuchar_zero_array_eq {cs} sh p (H: isptr p):
-  @data_at_ cs sh (tarray tuchar 0) p = emp.  
+Lemma data_at__tuchar_zero_array_eq {cs : compspecs} sh p (H: isptr p):
+  data_at_ sh (tarray tuchar 0) p ⊣⊢ emp.
 Proof. intros.
-  apply pred_ext.
+  apply bi.equiv_entails_2.
   apply data_at__tuchar_zero_array_inv.
   apply data_at__tuchar_zero_array; trivial.
 Qed. 
 
-Lemma data_at__tschar_zero_array_eq {cs} sh p (H: isptr p):
-  @data_at_ cs sh (tarray tschar 0) p = emp.  
+Lemma data_at__tschar_zero_array_eq {cs : compspecs} sh p (H: isptr p):
+  data_at_ sh (tarray tschar 0) p ⊣⊢ emp.
 Proof. intros.
-  apply pred_ext.
+  apply bi.equiv_entails_2.
   apply data_at__tschar_zero_array_inv.
   apply data_at__tschar_zero_array; trivial.
 Qed. 
 
 Lemma split2_data_at__Tarray_tuchar
-     : forall {cs} (sh : Share.t)  (n n1 : Z) (p : val),
+     : forall {cs : compspecs} (sh : Share.t)  (n n1 : Z) (p : val),
        0 <= n1 <= n -> isptr p ->field_compatible (Tarray tuchar n noattr) [] p ->
-       @data_at_ cs sh (Tarray tuchar n noattr) p =
-       @data_at_ cs sh (Tarray tuchar n1 noattr) p *
-       @data_at_ cs sh (Tarray tuchar (n - n1) noattr)
-         (field_address0 (Tarray tuchar n noattr) [ArraySubsc n1] p).
-Proof. intros. unfold data_at_ at 1; unfold field_at_.
+       data_at_ sh (Tarray tuchar n noattr) p =
+       (data_at_ sh (Tarray tuchar n1 noattr) p ∗
+        data_at_ sh (Tarray tuchar (n - n1) noattr)
+          (field_address0 (Tarray tuchar n noattr) [ArraySubsc n1] p)).
+Proof.
+intros. unfold data_at_ at 1; unfold field_at_.
 rewrite field_at_data_at.
 erewrite (@split2_data_at_Tarray cs sh tuchar n n1).
 instantiate (1:= Zrepeat Vundef (n-n1)).
@@ -883,12 +847,12 @@ unfold default_val. simpl. autorewrite with sublist. reflexivity.
 Qed. 
 
 Lemma split2_data_at__Tarray_tschar
-     : forall {cs} (sh : Share.t)  (n n1 : Z) (p : val),
+     : forall {cs : compspecs} (sh : Share.t)  (n n1 : Z) (p : val),
        0 <= n1 <= n -> isptr p ->field_compatible (Tarray tschar n noattr) [] p ->
-       @data_at_ cs sh (Tarray tschar n noattr) p =
-       @data_at_ cs sh (Tarray tschar n1 noattr) p *
-       @data_at_ cs sh (Tarray tschar (n - n1) noattr)
-         (field_address0 (Tarray tschar n noattr) [ArraySubsc n1] p).
+       data_at_ sh (Tarray tschar n noattr) p =
+       (data_at_ sh (Tarray tschar n1 noattr) p ∗
+        data_at_ sh (Tarray tschar (n - n1) noattr)
+         (field_address0 (Tarray tschar n noattr) [ArraySubsc n1] p)).
 Proof. intros. unfold data_at_ at 1; unfold field_at_.
 rewrite field_at_data_at.
 erewrite (@split2_data_at_Tarray cs sh tschar n n1).
@@ -912,9 +876,9 @@ Lemma split2_data_at_Tarray_app:
     Zlength v1 = mid ->
     Zlength v2 = n-mid ->
     data_at sh (tarray t n) (v1 ++ v2) p =
-    data_at sh (tarray t mid) v1  p *
-    data_at sh (tarray t (n-mid)) v2
-            (field_address0 (tarray t n) [ArraySubsc mid] p).
+    (data_at sh (tarray t mid) v1  p ∗
+     data_at sh (tarray t (n-mid)) v2
+            (field_address0 (tarray t n) [ArraySubsc mid] p)).
 Proof.
 intros.
 pose proof (Zlength_nonneg v1).
@@ -931,15 +895,15 @@ Qed.
 Fixpoint sepconN N (P: val -> mpred) sz (p:val):mpred :=
   match N with
     O => emp
-  | S n => (P p * sepconN n P sz (offset_val sz p))%logic
+  | S n => P p ∗ sepconN n P sz (offset_val sz p)
   end.
 
 Lemma mapsto_zeros_mapsto_nullval_N {cenv} N sh t b z:
        readable_share sh ->
        (align_chunk Mptr | Ptrofs.unsigned z) ->
        mapsto_zeros (Z.of_nat N * size_chunk Mptr) sh (Vptr b z)
-       |-- !! (0 <= Ptrofs.unsigned z /\
-               (Z.of_nat N * size_chunk Mptr + Ptrofs.unsigned z < Ptrofs.modulus)%Z) &&
+       ⊢ ⌜0 <= Ptrofs.unsigned z /\
+               (Z.of_nat N * size_chunk Mptr + Ptrofs.unsigned z < Ptrofs.modulus)%Z⌝ ∧
            sepconN N (fun p => mapsto sh (Tpointer t noattr) p nullval)
                      (@sizeof cenv (Tpointer t noattr)) (Vptr b z).
 Proof.
@@ -951,8 +915,8 @@ Proof. rewrite size_chunk_Mptr. unfold Ptrofs.max_unsigned.
  specialize Ptrofs.modulus_eq64.
  specialize Ptrofs.modulus_eq32.
  destruct (Archi.ptr64); intros X Y.
- rewrite Y; [ simpl; lia | trivial].
- rewrite X; [ simpl; lia | trivial].
+ rewrite Y; [ simpl; rep_lia | trivial].
+ rewrite X; [ simpl; rep_lia | trivial].
 Qed.
 
 Lemma sizeof_Tpointer cenv t a: @sizeof cenv (Tpointer t a) = if Archi.ptr64 then 8 else 4.
@@ -971,7 +935,7 @@ Lemma sepconN_mapsto_array {cenv t b sh} K : forall z
     (Hz: 0 <= Ptrofs.unsigned z /\
                Z.of_nat K * size_chunk Mptr + Ptrofs.unsigned z < Ptrofs.modulus),
     sepconN K (fun p : val => mapsto sh (Tpointer t noattr) p nullval) (size_chunk Mptr) (Vptr b z)
-|-- @data_at cenv sh (tarray (Tpointer t noattr) (Z.of_nat K)) (repeat nullval K) (Vptr b z).
+⊢ data_at(cs := cenv) sh (tarray (Tpointer t noattr) (Z.of_nat K)) (repeat nullval K) (Vptr b z).
 Proof.
   specialize (Zle_0_nat K); specialize size_chunk_range; intros SZ Kpos.
   induction K; intros.
@@ -982,7 +946,7 @@ Proof.
   replace (Z.of_nat (S K) * size_chunk Mptr)%Z with 
           (Z.of_nat K * size_chunk Mptr + size_chunk Mptr)%Z in Hz by lia.
   replace  (Z.of_nat (S K) - 1) with (Z.of_nat K) by lia.
-  eapply sepcon_derives.
+  eapply bi.sep_mono.
   - erewrite mapsto_data_at'; simpl; trivial.
     erewrite data_at_singleton_array_eq. apply derives_refl. trivial.
     red; simpl. rewrite sizeof_Tpointer. intuition. unfold size_chunk, Mptr in H2. destruct (Archi.ptr64); simpl; lia.
@@ -994,40 +958,39 @@ Proof.
       assert (c < Ptrofs.modulus).
       + eapply Z.le_lt_trans. 2: apply Hz. apply (Z.add_le_mono 0). apply Zmult_gt_0_le_0_compat; lia. lia.
       + lia. }
-    fold sepconN. unfold offset_val. eapply derives_trans.
+    fold sepconN. unfold offset_val. etrans.
     * apply IHK; clear IHK; trivial.
       ++ rewrite Ptrofs.add_unsigned. rewrite (Ptrofs.unsigned_repr (size_chunk Mptr)) by lia.
          rewrite Ptrofs.unsigned_repr by trivial.
          apply Z.divide_add_r; trivial. apply align_size_chunk_divides.
       ++ rewrite Ptrofs.add_unsigned. rewrite (Ptrofs.unsigned_repr (size_chunk Mptr)) by lia.
          rewrite Ptrofs.unsigned_repr by trivial. lia.
-    * apply derives_refl'. simpl. clear IHK.
-      f_equal. rewrite Zpos_P_of_succ_nat, <- Nat2Z.inj_succ. unfold field_address0.
+    * apply bi.equiv_entails_1_1. simpl. clear IHK.
+      f_equiv; hnf. unfold field_address0.
       rewrite if_true. reflexivity.
       red; repeat split; try solve [simpl; trivial; lia].
       ++ red. unfold tarray. rewrite sizeof_Tarray, sizeof_Tpointer, Z.max_r by lia.
          unfold Mptr in *. destruct Archi.ptr64; simpl in *; lia.
       ++ red. constructor; intros. econstructor. reflexivity. rewrite Csizeof_Tpointer.
          simpl. unfold Mptr in *. destruct (Archi.ptr64).
-         -- apply Z.divide_add_r. trivial. 
+         -- apply Z.divide_add_r. trivial.
             eapply Z.divide_trans. apply align_size_chunk_divides. simpl size_chunk. exists i; lia.
          -- apply Z.divide_add_r. trivial.
             eapply Z.divide_trans. apply align_size_chunk_divides. simpl size_chunk. exists i; lia.
 Qed.
 
-Lemma mapsto_zeros_data_atTarrayTptr_nullval_N {cenv} N sh t b z:
+Lemma mapsto_zeros_data_atTarrayTptr_nullval_N {cenv : compspecs} N sh t b z:
        readable_share sh ->
        (align_chunk Mptr | Ptrofs.unsigned z) ->
        mapsto_zeros (Z.of_nat N * size_chunk Mptr) sh (Vptr b z)
-       |-- @data_at cenv sh (tarray (Tpointer t noattr) (Z.of_nat N)) (repeat nullval N) (Vptr b z).
-Proof. intros. 
-  eapply derives_trans.
-  eapply (mapsto_zeros_mapsto_nullval_N N sh); trivial.
+       ⊢ data_at sh (tarray (Tpointer t noattr) (Z.of_nat N)) (repeat nullval N) (Vptr b z).
+Proof. intros.
+  rewrite mapsto_zeros_mapsto_nullval_N; try done.
   Intros. apply sepconN_mapsto_array; trivial.
 Qed.
 
-Lemma mapsto_zeros_isptr z sh p : mapsto_zeros z sh p |-- !! isptr p.
-Proof. unfold mapsto_zeros. destruct p; try apply FF_left. apply prop_right. simpl; trivial. Qed.
+Lemma mapsto_zeros_isptr z sh p : mapsto_zeros z sh p ⊢ ⌜isptr p⌝.
+Proof. unfold mapsto_zeros. destruct p; try iIntros "[]". apply bi.pure_intro. simpl; trivial. Qed.
 
 Lemma field_compatible_byvalue {cs: compspecs}:
  forall big b small s gfs p k,
@@ -1122,34 +1085,11 @@ apply Zmult_le_compat_r; [ | lia].
 lia.
 Qed.
 
-#[export] Hint Extern 2 (field_compatible _ _ _) =>
-  (eapply field_compatible_byvalue0; [ reflexivity | eassumption | reflexivity..]) : field_compatible.
-#[export] Hint Extern 2 (field_compatible _ _ (offset_val _ _)) =>
-  (eapply field_compatible_byvalue'; [ reflexivity | eassumption | reflexivity..]) : field_compatible.
-
-#[export] Hint Extern 2 (field_address _ _ _ = field_address _ _ _) =>
-  (do 2 rewrite field_address_offset by auto with field_compatible;
-   reflexivity) : field_compatible.
-
-#[export] Hint Extern 2 (field_address _ _ _ = field_address0 _ _ _) =>
-  (rewrite field_address_offset by auto with field_compatible;
-   rewrite field_address0_offset by auto with field_compatible;
-   reflexivity) : field_compatible.
-
-#[export] Hint Extern 2 (field_address0 _ _ _ = field_address _ _ _) =>
-  (rewrite field_address_offset by auto with field_compatible;
-   rewrite field_address0_offset by auto with field_compatible;
-   reflexivity) : field_compatible.
-
-#[export] Hint Extern 2 (field_address0 _ _ _ = field_address0 _ _ _) =>
-  (do 2 rewrite field_address0_offset by auto with field_compatible;
-   reflexivity) : field_compatible.
-
 Lemma split2_data_at__Tarray_app {cs: compspecs}
      : forall (mid n : Z) (sh : Share.t) (t : type) (p : val),
        0 <= mid <= n ->
-       data_at_ sh (tarray t n) p = data_at_ sh (tarray t mid) p
-                                                * data_at_ sh (tarray t (n - mid)) 
+       data_at_ sh (tarray t n) p ⊣⊢ data_at_ sh (tarray t mid) p
+                                                ∗ data_at_ sh (tarray t (n - mid)) 
                                                     (field_address0 (tarray t n) (SUB mid) p).
 Proof.
 intros.
@@ -1157,12 +1097,12 @@ unfold tarray.
 rewrite !data_at__Tarray.
 fold (tarray t n). fold (tarray t mid). fold (tarray t (n-mid)).
 rewrite <- split2_data_at_Tarray_app by list_solve.
-f_equal. rewrite Zrepeat_app by list_solve. f_equal. lia.
+f_equiv. rewrite Zrepeat_app by list_solve. f_equal. lia.
 Qed.
 
 Lemma data__at_singleton_array_eq:
   forall {cs : compspecs} (sh : Share.t) (t : type) (p : val), 
-  data_at_ sh (tarray t 1) p = data_at_ sh t p.
+  data_at_ sh (tarray t 1) p ⊣⊢ data_at_ sh t p.
 Proof.
 intros.
 apply data_at_singleton_array_eq.
@@ -1217,9 +1157,10 @@ rewrite Z.mul_add_distr_l in H2.
 rewrite <- (Ptrofs.repr_unsigned i0), ptrofs_add_repr.
 rewrite Ptrofs.unsigned_repr.
 unfold sizeof.
+rewrite Z.add_0_l.
 replace  (Ptrofs.unsigned i0 + (Ctypes.sizeof t * j) + Ctypes.sizeof t * i1)
  with   (Ptrofs.unsigned i0 + (Ctypes.sizeof t * i1 + Ctypes.sizeof t * j))
-  by lia; auto.
+  by rep_lia; auto.
 unfold sizeof.
 pose proof (Ctypes.sizeof_pos t).
 assert (0 <= Ctypes.sizeof t * j <= Ctypes.sizeof t * j + Ctypes.sizeof t * i1) by nia.
@@ -1238,4 +1179,27 @@ auto with field_compatible.
 Opaque sizeof.
 Qed.
 
+End mpred.
 
+#[export] Hint Extern 2 (field_compatible _ _ _) =>
+  (eapply field_compatible_byvalue0; [ reflexivity | eassumption | reflexivity..]) : field_compatible.
+#[export] Hint Extern 2 (field_compatible _ _ (offset_val _ _)) =>
+  (eapply field_compatible_byvalue'; [ reflexivity | eassumption | reflexivity..]) : field_compatible.
+
+#[export] Hint Extern 2 (field_address _ _ _ = field_address _ _ _) =>
+  (do 2 rewrite field_address_offset by auto with field_compatible;
+   reflexivity) : field_compatible.
+
+#[export] Hint Extern 2 (field_address _ _ _ = field_address0 _ _ _) =>
+  (rewrite field_address_offset by auto with field_compatible;
+   rewrite field_address0_offset by auto with field_compatible;
+   reflexivity) : field_compatible.
+
+#[export] Hint Extern 2 (field_address0 _ _ _ = field_address _ _ _) =>
+  (rewrite field_address_offset by auto with field_compatible;
+   rewrite field_address0_offset by auto with field_compatible;
+   reflexivity) : field_compatible.
+
+#[export] Hint Extern 2 (field_address0 _ _ _ = field_address0 _ _ _) =>
+  (do 2 rewrite field_address0_offset by auto with field_compatible;
+   reflexivity) : field_compatible.
diff --git a/floyd/fieldlist.v b/floyd/fieldlist.v
index 5b4c338da8..f4c9b0b7f1 100644
--- a/floyd/fieldlist.v
+++ b/floyd/fieldlist.v
@@ -1,6 +1,9 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
-Import compcert.lib.Maps.
+
+Local Unset SsrRewrite.
 
 Arguments align !n !amount / .
 Arguments Z.max !n !m / .
@@ -171,7 +174,7 @@ Lemma complete_legal_cosu_type_field_type: forall id
 Proof.
   unfold get_co.
   intros.
-  destruct (cenv_cs ! id) as [co |] eqn:CO.
+  destruct (cenv_cs !! id) as [co |] eqn:CO.
   + apply in_members_field_type in H; auto.
     pose proof cenv_legal_su _ _ CO.
     apply complete_legal_cosu_member with i (co_members co); eauto.
@@ -257,9 +260,9 @@ Lemma align_compatible_rec_Tstruct_inv': forall id a ofs,
 Proof.
   unfold get_co.
   intros.
-  destruct (cenv_cs ! id) as [co |] eqn:CO.
-  + inv H. inv H1.
-      inversion2 CO H3.
+  destruct (Maps.PTree.get id cenv_cs) as [co |] eqn:CO.
+  + inv H.
+      inversion CO.
       apply (H6 i (field_type i (co_members co)) (field_offset cenv_cs i (co_members co))); clear H6.
       clear - H0; unfold in_members in H0.
       induction (co_members co).
@@ -281,9 +284,9 @@ Proof.
   unfold get_co.
   intros.
   unfold in_members in *.
-  destruct (cenv_cs ! id) as [co |] eqn:CO.
-  + inv H. inv H1.
-      inversion2 CO H3.
+  destruct (Maps.PTree.get id cenv_cs) as [co |] eqn:CO.
+  + inv H.
+      inversion CO.
       apply (H6 i (field_type i (co_members co))); clear H6.
       clear - H0; unfold in_members in H0.
       induction (co_members co).
@@ -913,7 +916,7 @@ End COMPOSITE_ENV.
 
 Lemma members_spec_change_composite' {cs_from cs_to} {CCE: change_composite_env cs_from cs_to}: 
   forall id,
-  match (coeq cs_from cs_to) ! id with
+  match Maps.PTree.get id (coeq cs_from cs_to) with
   | Some b => test_aux cs_from cs_to b id
   | None => false
   end = true ->
@@ -921,29 +924,27 @@ Lemma members_spec_change_composite' {cs_from cs_to} {CCE: change_composite_env
              (co_members (@get_co cs_to id)).
 Proof.
   intros.
-  destruct ((@cenv_cs cs_to) ! id) eqn:?H.
+  destruct (Maps.PTree.get id (@cenv_cs cs_to)) eqn:H0.
   + pose proof proj1 (coeq_complete _ _ id) (ex_intro _ c H0) as [b ?].
     rewrite H1 in H.
     apply (coeq_consistent _ _ id _ _ H0) in H1.
     unfold test_aux in H.
     destruct b; [| inv H].
     rewrite !H0 in H.
-    destruct ((@cenv_cs cs_from) ! id) eqn:?H; [| inv H].
+    destruct (Maps.PTree.get id (@cenv_cs cs_from)) eqn:?H; [| inv H].
     simpl in H.
     rewrite !andb_true_iff in H.
     unfold get_co in *.
-    rewrite H0 in *.
+    setoid_rewrite H0.
     clear - H1.
     symmetry in H1.
     induction (co_members c) as [|[|]]; intros.
     - constructor.
-    - 
-       simpl in H1; rewrite andb_true_iff in H1; destruct H1.
+    - simpl in H1; rewrite andb_true_iff in H1; destruct H1.
       constructor; auto.
-   - 
-       simpl in H1.
+    - simpl in H1.
       constructor; auto.
-  + destruct ((coeq cs_from cs_to) ! id) eqn:?H.
+  + destruct (Maps.PTree.get id (coeq cs_from cs_to)) eqn:?H.
     - pose proof proj2 (coeq_complete _ _ id) (ex_intro _ b H1) as [co ?].
       congruence.
     - inv H.
@@ -951,7 +952,7 @@ Qed.
 
 Lemma members_spec_change_composite'' {cs_from cs_to} {CCE: change_composite_env cs_from cs_to}:
   forall id,
-  match (coeq cs_from cs_to) ! id with
+  match (coeq cs_from cs_to) !! id with
   | Some b => test_aux cs_from cs_to b id
   | None => false
   end = true ->
@@ -968,7 +969,7 @@ Qed.
  
 Lemma members_spec_change_composite {cs_from cs_to} {CCE: change_composite_env cs_from cs_to}:
   forall id,
-  match (coeq cs_from cs_to) ! id with
+  match (coeq cs_from cs_to) !! id with
   | Some b => test_aux cs_from cs_to b id
   | None => false
   end = true ->
@@ -999,7 +1000,7 @@ Qed.
 (* TODO: we have already proved a related field_offset lemma in veric/change_compspecs.v. But it seems not clear how to use that in an elegant way. *)
 Lemma field_offset_change_composite {cs_from cs_to} {CCE: change_composite_env cs_from cs_to}: 
   forall id i,
-  match (coeq cs_from cs_to) ! id with
+  match (coeq cs_from cs_to) !! id with
   | Some b => test_aux cs_from cs_to b id
   | None => false
   end = true ->
@@ -1027,7 +1028,7 @@ Qed.
 
 Lemma field_offset_next_change_composite {cs_from cs_to} {CCE: change_composite_env cs_from cs_to}: 
   forall id i,
-  match (coeq cs_from cs_to) ! id with
+  match (coeq cs_from cs_to) !! id with
   | Some b => test_aux cs_from cs_to b id
   | None => false
   end = true ->
diff --git a/floyd/find_nth_tactic.v b/floyd/find_nth_tactic.v
index 05cfb37099..a20481d667 100644
--- a/floyd/find_nth_tactic.v
+++ b/floyd/find_nth_tactic.v
@@ -94,9 +94,9 @@ Proof.
 Qed.
 
 Ltac find_nth_rec tac :=
-  first [ simple eapply find_nth_preds_rec_cons_head; tac
-        | simple eapply find_nth_preds_rec_cons_tail; find_nth_rec tac
-        | simple eapply find_nth_preds_rec_nil].
+  first [ (*simple*) eapply find_nth_preds_rec_cons_head; tac
+        | (*simple*) eapply find_nth_preds_rec_cons_tail; find_nth_rec tac
+        | (*simple*) eapply find_nth_preds_rec_nil].
 
 Ltac find_nth tac :=
   eapply find_nth_preds_constr; find_nth_rec tac.
diff --git a/floyd/finish.v b/floyd/finish.v
index 6f0816ee04..b223aa1f91 100644
--- a/floyd/finish.v
+++ b/floyd/finish.v
@@ -1,6 +1,8 @@
 From Ltac2 Require Import Ltac2.
 
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.functional_base.
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.nested_field_lemmas.
@@ -15,7 +17,7 @@ Require Import VST.floyd.fastforward.
 (* Things that we always want to simpl *)
 
 Ltac2 mutable simpl_safe_list () : constr list := [
-  'projT1; 'andb; 'orb
+  '@projT1; 'andb; 'orb
 ].
 
 Ltac2 simpl_safe () :=
@@ -27,14 +29,13 @@ Ltac simpl_safe := ltac2:(simpl_safe ()).
 
 Ltac2 rec simpl_entailment_aux (part : constr) :=
   lazy_match! part with
-  | andp ?a ?b => simpl_entailment_aux a; simpl_entailment_aux b
-  | orp ?a ?b => simpl_entailment_aux a; simpl_entailment_aux b
-  | imp ?a ?b => simpl_entailment_aux a; simpl_entailment_aux b
-  | sepcon ?a ?b => simpl_entailment_aux a; simpl_entailment_aux b
-  | wand ?a ?b => simpl_entailment_aux a; simpl_entailment_aux b
-  | ewand ?a ?b => simpl_entailment_aux a; simpl_entailment_aux b
-  | exp _ => ()
-  | allp _ => ()
+  | bi_and ?a ?b => simpl_entailment_aux a; simpl_entailment_aux b
+  | bi_or ?a ?b => simpl_entailment_aux a; simpl_entailment_aux b
+  | bi_impl ?a ?b => simpl_entailment_aux a; simpl_entailment_aux b
+  | bi_sep ?a ?b => simpl_entailment_aux a; simpl_entailment_aux b
+  | bi_wand ?a ?b => simpl_entailment_aux a; simpl_entailment_aux b
+  | bi_exist _ => ()
+  | bi_forall _ => ()
   | _ =>
     let p := Fresh.in_goal @part in
     set (p := $part);
@@ -44,7 +45,7 @@ Ltac2 rec simpl_entailment_aux (part : constr) :=
 
 Ltac2 simpl_entailment () := Control.enter (fun () =>
   lazy_match! goal with
-  | [ |- ?pre |-- ?post ] =>
+  | [ |- ?pre ⊢ ?post ] =>
     simpl_entailment_aux pre;
     simpl_entailment_aux post
   end).
@@ -174,7 +175,7 @@ Ltac inst_EX :=
 
 Ltac2 simpl_entailer_goal () := Control.enter (fun () =>
   repeat (first
-  [ progress ltac1:(Intros *); fin_log "Intros *."
+  [ progress ltac1:(Intros * ); fin_log "Intros *."
   | progress (simpl_safe ()); fin_log "simpl_safe."
   | progress (subst_decisives ()); fin_log "subst_decisives."
   | progress ltac1:(finish_pre_solve_simpl)
@@ -203,13 +204,13 @@ Ltac2 norm_entailer () := Control.enter (fun () =>
 Ltac2 finish_entailer_aux (fin : unit -> unit) (fin_ent : (unit -> unit) -> unit) :=
   Control.enter (fun () =>
   match! goal with
-  | [ |- @derives mpred _ _ _ ] => solve [ltac1:(cancel)]; fin_log "solve [cancel]."
-  | [ |- _ |-- _ ] =>
+  | [ |- @bi_entails (iPropI _) _ _ ] => solve [ltac1:(cancel)]; fin_log "solve [cancel]."
+  | [ |- _ ⊢ _ ] =>
     first
     [ ltac1:(list_solve); fin_log "list_solve."
     | ltac1:(finish_entailer_solve)
     | lazy_match! goal with
-      | [ |- context [ _ |-- _ ] ] => progress (norm_entailer ()); fin_ent fin
+      | [ |- context [ _ ⊢ _ ] ] => progress (norm_entailer ()); fin_ent fin
       | [ |- _ ] => fin ()
       end
     ]
@@ -249,7 +250,7 @@ Ltac2 simpl_hyps () := Control.enter (fun () =>
     | [ h : orb _ _ = true |- _ ] => rewrite orb_true_iff in h; fin_log "rewrite orb_true_iff in H."
     | [ h : orb _ _ = false |- _ ] => rewrite orb_false_iff in h; fin_log "rewrite orb_false_iff in H."
     | [ h : context [ Is_true ] |- _ ] => rewrite Is_true_eq_true in h; fin_log "rewrite Is_true_eq_true in H."
-    | [ |- context [ _ |-- _ ] ] => progress ltac1:(autorewrite with sublist in * |-); fin_log "autorewrite with sublist in * |-."
+    | [ |- context [ _ ⊢ _ ] ] => progress ltac1:(autorewrite with sublist in * |-); fin_log "autorewrite with sublist in * |-."
     end
   )).
 
@@ -281,15 +282,15 @@ Ltac2 rec finish_specialize (fin : unit -> unit) (agro : bool):= Control.enter (
   | [ |- forall _, _ ] => intro; fin_log "intro."; fin ()
   | [ |- exists _, _ ] => ltac1:(inst_exists); fin_log "inst_exists."; fin ()
   | [ |- semax_body _ _ _ _ ] => ltac1:(start_function); fin_log "start_function."; fin ()
-  | [ |- semax _ _ _ _ ] => fastforward agro; fin ()
+  | [ |- semax _ _ _ _ _ ] => fastforward agro; fin ()
   | [ |- ?x = ?x ] => reflexivity; fin_log "reflexivity."
   (* | [ |- context [if _ then _ else _]] => ltac1:(if_tac); fin_log "if_tac."; fin () *) (* TODO: Breaks entailment matching?! Maybe checking nesting? *)
   (* | [ |- context [match ?expr _ with | _ => _ end]] => destruct expr > [ | ]; fin_log "destruct match."; fin () *)
-  | [ |- context [ _ |-- _ ] ] => 
+  | [ |- context [ _ ⊢ _ ] ] => 
     simpl_entailer_goal ();
     Control.enter (fun () =>
       lazy_match! goal with
-      | [ |- context [ _ |-- _ ] ] => finish_entailer_aux fin finish_entailer
+      | [ |- context [ _ ⊢ _ ] ] => finish_entailer_aux fin finish_entailer
       | [ |- _ ] => fin ()
       end
     )
diff --git a/floyd/for_lemmas.v b/floyd/for_lemmas.v
index 04257c83d4..faf92374ef 100644
--- a/floyd/for_lemmas.v
+++ b/floyd/for_lemmas.v
@@ -1,4 +1,6 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.mapsto_memory_block.
 Require Import VST.floyd.closed_lemmas.
@@ -13,8 +15,7 @@ Require Import VST.floyd.local2ptree_eval.
 Require Import VST.floyd.local2ptree_typecheck.
 Import Cop.
 Import LiftNotation.
-Import compcert.lib.Maps.
-Local Open Scope logic.
+Import -(notations) compcert.lib.Maps.
 
 Transparent intsize_eq.
 
@@ -96,27 +97,33 @@ Proof.
   apply Int64.eqm_sym, Int64.eqm_unsigned_repr.
 Qed.
 
-Inductive Sfor_inv_rec (LONG: bool) {cs: compspecs} (Delta: tycontext): ident -> Z -> Z -> expr -> Z -> (environ -> mpred) -> (environ -> mpred) -> (environ -> mpred) -> Prop :=
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs}.
+
+Local Notation assert := (@assert Σ).
+
+Inductive Sfor_inv_rec (LONG: bool) (Delta: tycontext): ident -> Z -> Z -> expr -> Z -> assert -> assert -> assert -> Prop :=
 | Sfor_inv_rec_step': forall A _i i m hi n assert_callee inv0 inv1,
     (forall x: A,
        Sfor_inv_rec LONG Delta _i i m hi n (assert_callee x) (inv0 x) (inv1 x)) ->
-    Sfor_inv_rec LONG Delta _i i m hi n (exp assert_callee) (exp inv0) (exp inv1)
+    Sfor_inv_rec LONG Delta _i i m hi n (bi_exist assert_callee) (bi_exist inv0) (bi_exist inv1)
 | Sfor_inv_rec_end: forall _i i m hi n' n P Q R T1 T2 GV (*tactic callee*),
     local2ptree Q = (T1, T2, nil, GV) ->
-    T1 ! _i = None ->
+    T1 !! _i = None ->
     msubst_eval_expr Delta T1 T2 GV hi = Some n' ->
     Int6432_val (typeof hi) n' n ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- tc_expr Delta hi ->
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢ tc_expr Delta hi ->
     Sfor_inv_rec LONG Delta _i i m hi n
       (PROPx P (LOCALx Q (SEPx R)))
       (PROPx ((m <= i <= n) :: P) (LOCALx (temp _i (if LONG then Vlong (Int64.repr i) else Vint (Int.repr i)) :: Q) (SEPx R)))
       (PROPx P (LOCALx (temp _i (if LONG then Vlong (Int64.repr i) else Vint (Int.repr i)) :: Q) (SEPx R))).
 
-Lemma Sfor_inv_rec_step (LONG: bool) {cs: compspecs} (Delta: tycontext): forall A _i i m hi n assert_callee inv0 inv1,
+Lemma Sfor_inv_rec_step (LONG: bool) (Delta: tycontext): forall A _i i m hi n assert_callee inv0 inv1,
     (forall x: A, exists inv0' inv1',
        Sfor_inv_rec LONG Delta _i i m hi n (assert_callee x) inv0' inv1' /\
        inv0 x = inv0' /\ inv1 x = inv1') ->
-    Sfor_inv_rec LONG Delta _i i m hi n (exp assert_callee) (exp inv0) (exp inv1).
+    Sfor_inv_rec LONG Delta _i i m hi n (bi_exist assert_callee) (bi_exist inv0) (bi_exist inv1).
 Proof.
   intros.
   apply Sfor_inv_rec_step'.
@@ -126,70 +133,65 @@ Proof.
   subst; auto.
 Qed.
 
-Inductive Sfor_inv (LONG: bool) {cs: compspecs} (Delta: tycontext):
+Inductive Sfor_inv (LONG: bool) (Delta: tycontext):
   forall (_i: ident) (m: Z) (hi: expr) (n: Z)
-         (assert_callee: Z -> environ -> mpred)
-         (inv0: environ -> mpred)
-         (inv1 inv2: Z -> environ -> mpred), Prop :=
+         (assert_callee: Z -> assert)
+         (inv0: assert)
+         (inv1 inv2: Z -> assert), Prop :=
 | construct_Sfor_inv: forall _i m hi n assert_callee inv0 inv1,
     (forall i i', exists inv0' inv0'' inv1' inv1'', Sfor_inv_rec LONG Delta _i i' m hi n (assert_callee i) inv0'' inv1'' /\ inv0' i' = inv0'' /\ inv0 i = inv0' /\ inv1' i' = inv1'' /\ inv1 i = inv1') ->
-    Sfor_inv LONG Delta _i m hi n assert_callee (EX i: Z, inv0 i i) (fun i => inv1 i i) (fun i => inv1 (i+1) i).
+    Sfor_inv LONG Delta _i m hi n assert_callee (∃ i: Z, inv0 i i) (fun i => inv1 i i) (fun i => inv1 (i+1) i).
 
-Inductive Sfor_setup {cs: compspecs} {Espec: OracleKind} (Delta: tycontext):
-  forall (_i: ident) (Pre: environ -> mpred) (init: statement) (hi: expr) (type_i: type)
-         (m n: Z) (assert_callee: Z -> environ -> mpred)
-         (inv0: environ -> mpred), Prop :=
+Inductive Sfor_setup E (Delta: tycontext):
+  forall (_i: ident) (Pre: assert) (init: statement) (hi: expr) (type_i: type)
+         (m n: Z) (assert_callee: Z -> assert)
+         (inv0: assert), Prop :=
 | Sfor_setup_const_init: forall (m' m: Z) lo _i type_i hi n Pre assert_callee inv0 range,
     range_init_hl (typeof lo) type_i (typeof hi) range ->
     const_only_eval_expr lo = Some (if is_long_type type_i then Vlong (Int64.repr m') else Vint (Int.repr m')) ->
     (if is_long_type type_i then Int64_eqm_unsigned (Int64.repr m') m else Int_eqm_unsigned (Int.repr m') m) ->
     range m n ->
-    ENTAIL Delta, Pre |-- assert_callee m ->
-    Sfor_setup Delta _i Pre (Sset _i lo) hi type_i m n assert_callee inv0
+    ENTAIL Delta, Pre ⊢ assert_callee m ->
+    Sfor_setup E Delta _i Pre (Sset _i lo) hi type_i m n assert_callee inv0
 | Sfor_setup_other: forall _i Pre init hi type_i m n assert_callee inv0 range,
     range_init_h type_i (typeof hi) m range ->
     range n ->
-    @semax cs Espec Delta Pre init (normal_ret_assert inv0) ->
-    Sfor_setup Delta _i Pre init hi type_i m n assert_callee inv0.
+    semax E Delta Pre init (normal_ret_assert inv0) ->
+    Sfor_setup E Delta _i Pre init hi type_i m n assert_callee inv0.
 
-Lemma Sfor_inv_rec_spec (LONG: bool) : forall {cs: compspecs} (Delta: tycontext),
+Lemma Sfor_inv_rec_spec (LONG: bool) : forall (Delta: tycontext),
   forall _i i m hi n assert_callee inv0 inv1,
     Sfor_inv_rec LONG Delta _i i m hi n assert_callee inv0 inv1 ->
-    ENTAIL Delta, inv0 |-- EX n': val, !! (Int6432_val (typeof hi) n' n) && local (` (eq n') (eval_expr hi)) /\
-    ENTAIL Delta, inv0 |-- tc_expr Delta hi /\
+    (ENTAIL Delta, inv0 ⊢ ∃ n': val, ⌜Int6432_val (typeof hi) n' n⌝ ∧ local (` (eq n') (eval_expr hi))) /\
+    (ENTAIL Delta, inv0 ⊢ tc_expr Delta hi) /\
     (closed_wrt_vars (eq _i) assert_callee) /\
-    local (locald_denote (temp _i (if LONG then Vlong (Int64.repr i) else Vint (Int.repr i)))) && assert_callee = inv1 /\
-    !! (m <= i <= n) && inv1 = inv0.
+    (local (locald_denote (temp _i (if LONG then Vlong (Int64.repr i) else Vint (Int.repr i)))) ∧ assert_callee) ≡ inv1 /\
+    (⌜m <= i <= n⌝ ∧ inv1) ≡ inv0.
 Proof.
   intros.
   induction H.
   + split; [| split; [| split; [| split]]].
     - specialize (fun x => proj1 (H0 x)); clear H H0; intros.
-      rewrite exp_andp2.
-      apply exp_left; auto.
+      Intros x; auto.
     - specialize (fun x => proj1 (proj2 (H0 x))); clear H H0; intros.
-      rewrite exp_andp2.
-      apply exp_left; auto.
+      Intros x; auto.
     - specialize (fun x => proj1 (proj2 (proj2 (H0 x)))); clear H H0; intros.
       apply closed_wrt_exp; auto.
     - specialize (fun x => proj1 (proj2 (proj2 (proj2 (H0 x))))); clear H H0; intros.
-      rewrite exp_andp2.
-      apply exp_congr; auto.
+      rewrite bi.and_exist_l; f_equiv; auto.
     - specialize (fun x => proj2 (proj2 (proj2 (proj2 (H0 x))))); clear H H0; intros.
-      rewrite exp_andp2.
-      apply exp_congr; auto.
+      rewrite bi.and_exist_l; f_equiv; auto.
   + split; [| split; [| split; [| split]]].
     - eapply (msubst_eval_expr_eq _ P _ _ _ R) in H1.
       erewrite <- (app_nil_l P), <- local2ptree_soundness in H1 by eauto.
       rewrite <- insert_local, <- insert_prop.
       Exists n'.
-      normalize.
-      eapply derives_trans; [| exact H1].
-      solve_andp.
+      rewrite -H1.
+      iIntros "(? & _ & _ & $)"; auto.
     - rewrite <- insert_local, <- insert_prop.
-      eapply derives_trans; [| exact H3].
-      solve_andp.
-    - erewrite local2ptree_soundness, app_nil_l by eauto.
+      rewrite -H3.
+      iIntros "(? & _ & _ & $)"; auto.
+    - rewrite closed_wrt_proper; last by intros ?; rewrite local2ptree_soundness. (* Proper should let us rewrite local2ptree_soundness directly *)
       apply closed_wrt_PROPx.
       apply closed_wrt_LOCALx; [| apply closed_wrt_SEPx].
       rewrite Forall_forall.
@@ -208,15 +210,15 @@ Proof.
       reflexivity.
 Qed.
 
-Lemma Sfor_inv_spec (LONG: bool): forall {cs: compspecs} (Delta: tycontext),
+Lemma Sfor_inv_spec (LONG: bool): forall (Delta: tycontext),
   forall _i m hi n assert_callee inv0 inv1 inv2,
     Sfor_inv LONG Delta _i m hi n assert_callee inv0 inv1 inv2 ->
-    ENTAIL Delta, inv0 |-- EX n': val, !! (Int6432_val (typeof hi) n' n) && local (` (eq n') (eval_expr hi)) /\
-    ENTAIL Delta, inv0 |-- tc_expr Delta hi /\
-    (forall v i, subst _i (`v) (assert_callee i) = assert_callee i) /\
-    (forall i, local (locald_denote (temp _i (if LONG then Vlong (Int64.repr i) else Vint (Int.repr i)))) && assert_callee i = inv1 i) /\
-    (forall i, local (locald_denote (temp _i (if LONG then Vlong (Int64.repr i) else Vint (Int.repr i)))) && assert_callee (i+1) = inv2 i) /\
-    (EX i: Z, !! (m <= i <= n) && inv1 i = inv0).
+    (ENTAIL Delta, inv0 ⊢ ∃ n': val, ⌜Int6432_val (typeof hi) n' n⌝ ∧ local (` (eq n') (eval_expr hi))) /\
+    (ENTAIL Delta, inv0 ⊢ tc_expr Delta hi) /\
+    (forall v i, assert_of (subst _i (`v) (assert_callee i)) ⊣⊢ assert_callee i) /\
+    (forall i, (local (locald_denote (temp _i (if LONG then Vlong (Int64.repr i) else Vint (Int.repr i)))) ∧ assert_callee i) ≡ inv1 i) /\
+    (forall i, (local (locald_denote (temp _i (if LONG then Vlong (Int64.repr i) else Vint (Int.repr i)))) ∧ assert_callee (i+1)) ≡ inv2 i) /\
+    ((∃ i: Z, ⌜m <= i <= n⌝ ∧ inv1 i) ≡ inv0).
 Proof.
   intros.
   inv H.
@@ -240,7 +242,7 @@ Proof.
     destruct H as [_ [? _]].
     auto.
   + intros.
-    apply closed_wrt_subst.
+    split => rho; apply closed_wrt_subst.
     specialize (H i i).
     destruct H as [_ [_ [? _]]].
     auto.
@@ -252,21 +254,21 @@ Proof.
     specialize (H (i + 1) i).
     destruct H as [_ [_ [_ [? _]]]].
     auto.
-  + apply exp_congr; intros i.
+  + f_equiv; intros i.
     specialize (H i i).
     destruct H as [_ [_ [_ [_ ?]]]].
     auto.
 Qed.
 
-Lemma Sfor_setup_spec: forall {cs: compspecs} {Espec: OracleKind} (Delta: tycontext),
+Lemma Sfor_setup_spec: forall E (Delta: tycontext),
   forall _i Pre init type_i hi m n assert_callee inv0 inv1,
-    Sfor_setup Delta _i Pre init hi type_i m n assert_callee inv0 ->
+    Sfor_setup E Delta _i Pre init hi type_i m n assert_callee inv0 ->
     forall
-      (TI: (temp_types Delta) ! _i = Some type_i),
-    (forall i, local (locald_denote (temp _i (if is_long_type type_i then Vlong (Int64.repr i) else Vint (Int.repr i)))) && assert_callee i = inv1 i) ->
-    (EX i: Z, !! (m <= i <= n) && inv1 i = inv0) ->
-    (forall v i, subst _i (`v) (assert_callee i) = assert_callee i) ->
-    @semax cs Espec Delta Pre init (normal_ret_assert inv0) /\
+      (TI: (temp_types Delta) !! _i = Some type_i),
+    (forall i, (local (locald_denote (temp _i (if is_long_type type_i then Vlong (Int64.repr i) else Vint (Int.repr i)))) ∧ assert_callee i) ⊣⊢ inv1 i) ->
+    ((∃ i: Z, ⌜m <= i <= n⌝ ∧ inv1 i) ⊣⊢ inv0) ->
+    (forall v i, assert_of (subst _i (`v) (assert_callee i)) ⊣⊢ assert_callee i) ->
+    semax E Delta Pre init (normal_ret_assert inv0) /\
     exists int_min int_max,
     int_type_min_max type_i (typeof hi) = Some (int_min, int_max) /\
     int_min <= m <= int_max /\
@@ -274,47 +276,42 @@ Lemma Sfor_setup_spec: forall {cs: compspecs} {Espec: OracleKind} (Delta: tycont
 Proof.
   intros.
   inv H.
-  + remember (typeof hi) as type_hi eqn:?H.
+  + remember (typeof hi) as type_hi eqn:H.
     inv H3.
     split.
     - eapply semax_pre; [apply H7 | clear H7].
-      eapply semax_post'; [| clear H0].
-      {
-        apply andp_left2, (exp_right m).
-        apply andp_right; [apply prop_right; lia |].
-        apply derives_refl', H0.
-      }
+      eapply semax_post'; [| clear H0 H1].
+      { rewrite bi.and_elim_r -H1.
+        Exists m; apply bi.and_intro; first by apply bi.pure_intro; lia.
+        rewrite -H0 //. }
       eapply semax_pre_post'; [| | apply semax_set_forward].
-      * eapply derives_trans; [| apply now_later].
-        apply andp_right; [| apply andp_left2, derives_refl].
-        unfold tc_expr, tc_temp_id.
-        apply andp_right; [eapply const_only_eval_expr_tc; eauto |].
-        unfold typecheck_temp_id.
-        rewrite TI.
-        simpl typeof.
-        replace (is_neutral_cast (implicit_deref (typeof lo)) type_i) with true
-        by (destruct type_i as [| [| | |] | [|] | | | | | | ]; inv H8; 
-               destruct (typeof lo) as [| [| | |] [|] | [|] | | | | | | ]; inv H1; simpl; auto).
-        simpl tc_bool.
-        rewrite tc_andp_TT1.
-        unfold isCastResultType.
-        destruct Archi.ptr64 eqn:Hp;
-         destruct type_i as [| [| | |] | [|] | | | | | | ]; inv H8; auto;
-         destruct (typeof lo) as [| [| | |] | | | | | | | ]; inv H1; auto;
-        simpl denote_tc_assert; rewrite Hp; try apply TT_right;
-        simple_if_tac; apply TT_right.
-      * apply andp_left2.
+      * iIntros "(#? & H) !>".
+        iSplit; [|iSplit; [|iApply "H"]].
+        { iApply (const_only_eval_expr_tc with "H"); eauto. }
+        { iStopProof; split => rho.
+          unfold tc_temp_id, typecheck_temp_id.
+          rewrite TI.
+          replace (is_neutral_cast (implicit_deref (typeof lo)) type_i) with true
+          by (destruct type_i as [| [| | |] | [|] | | | | | | ]; inv H9; 
+               destruct (typeof lo) as [| [| | |] [|] | [|] | | | | | | ]; inv H8; simpl; auto).
+          simpl tc_bool.
+          rewrite tc_andp_TT1.
+          unfold isCastResultType.
+          destruct Archi.ptr64 eqn:Hp;
+           destruct type_i as [| [| | |] | [|] | | | | | | ]; inv H9; auto;
+           destruct (typeof lo) as [| [| | |] | | | | | | | ]; inv H8; auto;
+          simpl denote_tc_assert; rewrite Hp; try apply TT_right;
+          simple_if_tac; apply TT_right. }
+      * rewrite bi.and_elim_r.
         Intros old.
-        apply andp_derives; [| rewrite H2; auto].
-        simpl; intro rho.
+        apply bi.and_mono; [| rewrite H2; auto].
+        split => rho.
         eapply (const_only_eval_expr_eq (env_set rho _i old)) in H4.
         unfold subst, local, lift1; unfold_lift; simpl.
         rewrite H4.
         set (m'1 := Int64.repr m') in *.
         set (m'2 := Int.repr m') in *. clearbody m'1. clearbody m'2. clear m'.
-        destruct (is_long_type type_i); inv H5; normalize.
-        split; [auto | congruence].
-        split; [auto | congruence].
+        destruct (is_long_type type_i); inv H5; by normalize.
     - exists int_min, int_max.
       split; auto. lia.
   + inv H3.
@@ -336,27 +333,26 @@ Qed.
 Section Sfor.
 
 Context
-        {cs : compspecs}
         (Delta: tycontext)
         (_i: ident)
         (m n: Z)
         (init: statement)
         (hi: expr)
-        (inv0: environ -> mpred)
-        (assert_callee inv1 inv2: Z -> environ -> mpred)
+        (inv0: assert)
+        (assert_callee inv1 inv2: Z -> assert)
         (type_i: type)
         (int_min int_max: Z).
 
-Hypothesis EVAL_hi: ENTAIL Delta, inv0 |-- EX n': val, !! (Int6432_val (typeof hi) n' n) && local (` (eq n') (eval_expr hi)).
-Hypothesis TC_hi: ENTAIL Delta, inv0 |-- tc_expr Delta hi.
+Hypothesis EVAL_hi: ENTAIL Delta, inv0 ⊢ ∃ n': val, ⌜Int6432_val (typeof hi) n' n⌝ ∧ local (` (eq n') (eval_expr hi)).
+Hypothesis TC_hi: ENTAIL Delta, inv0 ⊢ tc_expr Delta hi.
 Hypothesis IMM: int_type_min_max type_i (typeof hi) = Some (int_min, int_max).
 Hypothesis Range_m: int_min <= m <= int_max.
 Hypothesis Range_n: int_min <= n <= int_max.
-Hypothesis TI: (temp_types Delta) ! _i = Some type_i.
-Hypothesis EQ_inv1: forall i : Z, local (locald_denote (temp _i (if is_long_type type_i then Vlong (Int64.repr i) else Vint (Int.repr i)))) && assert_callee i = inv1 i.
-Hypothesis EQ_inv0: (EX i : Z, !! (m <= i <= n) && inv1 i)%assert = inv0.
-Hypothesis EQ_inv2: forall i, local (locald_denote (temp _i (if is_long_type type_i then Vlong (Int64.repr i) else Vint (Int.repr i)))) && assert_callee (i+1) = inv2 i.
-Hypothesis SUBST_callee: forall v i, subst _i (`v) (assert_callee i) = assert_callee i.
+Hypothesis TI: (temp_types Delta) !! _i = Some type_i.
+Hypothesis EQ_inv1: forall i : Z, (local (locald_denote (temp _i (if is_long_type type_i then Vlong (Int64.repr i) else Vint (Int.repr i)))) ∧ assert_callee i) ≡ inv1 i.
+Hypothesis EQ_inv0: (∃ i : Z, ⌜m <= i <= n⌝ ∧ inv1 i)%assert ≡ inv0.
+Hypothesis EQ_inv2: forall i, (local (locald_denote (temp _i (if is_long_type type_i then Vlong (Int64.repr i) else Vint (Int.repr i)))) ∧ assert_callee (i+1)) ≡ inv2 i.
+Hypothesis SUBST_callee: forall v i, assert_of (subst _i (`v) (assert_callee i)) ⊣⊢ assert_callee i.
 
 Lemma CLASSIFY_CMP: classify_cmp type_i (typeof hi) = cmp_default.
 Proof.
@@ -365,37 +361,32 @@ Proof.
 Qed.
 
 Lemma Sfor_loop_cond_tc:
-  ENTAIL Delta, inv0 |-- tc_expr Delta (Eunop Onotbool (Ebinop Olt (Etempvar _i type_i) hi tint) tint).
+  ENTAIL Delta, inv0 ⊢ tc_expr Delta (Eunop Onotbool (Ebinop Olt (Etempvar _i type_i) hi tint) tint).
 Proof.
   intros.
   remember (Ebinop Olt (Etempvar _i type_i) hi tint).
-  unfold tc_expr at 1; simpl typecheck_expr.
+  unfold tc_expr at 1; unfold typecheck_expr; fold typecheck_expr; simpl.
   replace (typeof e) with tint by (rewrite Heqe; auto).
   rewrite tc_andp_TT1.
   subst e.
 
-  Opaque isBinOpResultType.
-  simpl typecheck_expr.
-  Transparent isBinOpResultType.
+  unfold typecheck_expr; fold typecheck_expr.
   rewrite TI.
 
-  simpl orb.
-  simpl snd.
   replace (is_neutral_cast type_i type_i || same_base_type type_i type_i)%bool with true
     by (destruct type_i as [| [| | |] [|] | | | | | | | ]; inv IMM; auto).
   
-  rewrite denote_tc_assert_andp; apply andp_right; auto.
+  rewrite denote_tc_assert_andp; apply bi.and_intro; auto.
   rewrite (add_andp _ _ EVAL_hi).
   Intros n'.
-  apply andp_left1.
+  rewrite bi.and_elim_l.
   rewrite <- EQ_inv0.
   Intros i.
   rewrite <- EQ_inv1.
-  rewrite denote_tc_assert_andp; apply andp_right.
- 2:{ eapply derives_trans; [ | apply temp_tc_initialized].
-    apply andp_derives. apply derives_refl. apply andp_left2.
-    apply andp_left1.   apply derives_refl. auto. }
-  
+  rewrite denote_tc_assert_andp; apply bi.and_intro.
+  2:{ rewrite -temp_tc_initialized //.
+      solve_andp. }
+
   unfold isBinOpResultType; simpl typeof.
   rewrite CLASSIFY_CMP.
   replace (is_numeric_type type_i) with true
@@ -403,7 +394,7 @@ Proof.
   replace (is_numeric_type (typeof hi)) with true
     by (destruct type_i as [| [| | |] [|] | [|] | | | | | | ]; destruct (typeof hi) as [| [| | |] [|] | [|] | | | | | | ]; inv IMM; auto).
   simpl tc_bool.
-  apply TT_right.
+  split => rho; apply TT_right.
 Qed.
 
 Lemma Sfor_comparison_Signed_I32: forall i n',
@@ -422,7 +413,7 @@ Proof.
   simpl;
   unfold Int.lt;
   unfold both_int; simpl; unfold Clight_Cop2.sem_cast, Clight_Cop2.classify_cast;
-  destruct Archi.ptr64 eqn:Hp; simpl;  rewrite !Int.signed_repr by rep_lia;
+  destruct Archi.ptr64 eqn:Hp; simpl;  rewrite -> !Int.signed_repr by rep_lia;
   try solve [if_tac; [split; [intro HH; inv HH | intros; lia] |  split; auto]].
 Qed.
 
@@ -441,8 +432,8 @@ Proof.
   simpl;
   unfold both_int; simpl; unfold Clight_Cop2.sem_cast, Clight_Cop2.classify_cast;
   destruct Archi.ptr64 eqn:Hp; simpl; unfold Int.ltu;
-  rewrite ?Int.signed_repr by rep_lia;
-  rewrite ?Int.unsigned_repr by rep_lia;
+  rewrite -> ?Int.signed_repr by rep_lia;
+  rewrite -> ?Int.unsigned_repr by rep_lia;
   try solve [if_tac; [split; [intro HH; inv HH | intros; lia] |  split; auto]].
 Qed.
 
@@ -461,9 +452,9 @@ Proof.
   unfold both_long, Clight_Cop2.sem_cast; simpl;
   destruct Archi.ptr64 eqn:Hp; simpl;
   unfold Int64.lt;
-  rewrite ?Int64.signed_repr by rep_lia;
-  rewrite ?Int.signed_repr by rep_lia;
-  rewrite ?Int.unsigned_repr by rep_lia;
+  rewrite -> ?Int64.signed_repr by rep_lia;
+  rewrite -> ?Int.signed_repr by rep_lia;
+  rewrite -> ?Int.unsigned_repr by rep_lia;
   if_tac; split; intro Hx; try solve [inv Hx]; try lia; reflexivity.
 Qed.
 
@@ -484,239 +475,199 @@ Proof.
    inv H; try inv H5; try inv H6; simpl;
    inv IMM;
   unfold Int64.ltu;
-  rewrite ?Int.signed_repr by rep_lia;
-  rewrite ?Int.unsigned_repr by rep_lia;
-  rewrite ?Int64.unsigned_repr by rep_lia;
-  rewrite ?Int64.signed_repr by rep_lia;
-  try ( if_tac; split; intro Hx; try solve [inv Hx]; try lia; reflexivity).
+  rewrite -> ?Int.signed_repr by rep_lia;
+  rewrite -> ?Int.unsigned_repr by rep_lia;
+  rewrite -> ?Int64.unsigned_repr by rep_lia;
+  rewrite -> ?Int64.signed_repr by rep_lia;
+  try (if_tac; split; intro Hx; try solve [inv Hx]; try lia; reflexivity).
 Qed.
 
 Lemma Sfor_loop_cond_true:
-  ENTAIL Delta, inv0 && local
+  ENTAIL Delta, inv0 ∧ local
     ((` (typed_true (typeof (Ebinop Olt (Etempvar _i type_i) hi tint))))
-       (eval_expr (Ebinop Olt (Etempvar _i type_i) hi tint))) |--
-  EX i: Z, !! (m <= i < n) && inv1 i.
+       (eval_expr (Ebinop Olt (Etempvar _i type_i) hi tint))) ⊢
+  ∃ i: Z, ⌜m <= i < n⌝ ∧ inv1 i.
 Proof.
   intros.
-  rewrite <- andp_assoc, (add_andp _ _ EVAL_hi), <- EQ_inv0.
-  Intros n' i; Exists i.
-  rewrite <- EQ_inv1.
-  apply andp_right; [| solve_andp].
-  simpl eval_expr.
-  unfold local, lift1; intro rho; simpl; unfold_lift.
-  normalize.
-  apply prop_right; auto.
-  rewrite <- H4 in H.
+  iIntros "(#? & inv0 & #?)".
+  iPoseProof (EVAL_hi with "[-]") as (??) "#?"; first auto.
+  rewrite -EQ_inv0.
+  iDestruct "inv0" as (i ?) "inv1".
+  iExists i.
+  rewrite - EQ_inv1.
+  iSplit; last done.
+  iStopProof; split => rho; monPred.unseal; rewrite monPred_at_intuitionistically /=.
+  rewrite /lift1; unfold_lift.
+  iIntros "((% & %Ht & ->) & (%Hi & %) & _)"; iPureIntro.
+  rewrite <- Hi in Ht.
   forget (eval_expr hi rho) as n'.
-  clear H4.
-  rename H5 into H4. rename H into H'. rename H1 into H.
-  rename H2 into H2'.
-  rename H0 into H2.
-  assert (H0 := conj H2' H3). clear H2' H3. rename H' into H1.
-  unfold force_val2, Clight_Cop2.sem_cmp in H1.
-  rewrite CLASSIFY_CMP in H1.
+  clear Hi.
+  unfold force_val2, Clight_Cop2.sem_cmp in Ht.
+  rewrite CLASSIFY_CMP in Ht.
   destruct (classify_binarith type_i (typeof hi)) as [ [|] | [|] | | |] eqn:H3;
     [| | | | 
       destruct type_i as [| [| | |] [|] | [|] | | | | | |]; try solve [inv IMM];
      destruct (typeof hi) as [| [| | |] [|] | [|] | | | | | |]; inv IMM; inv H3 ..].
   + assert (H6: force_val (sem_cmp_default Clt type_i (typeof hi)
                            (if is_long_type type_i then Vlong (Int64.repr i) else Vint (Int.repr i)) n') <> Vint Int.zero) 
-        by (intro Hx; rewrite Hx in H1; inv H1).
-      rewrite Sfor_comparison_Signed_I32 in H6 by auto.
+        by (intro Hx; rewrite Hx in Ht; inv Ht).
+      rewrite -> Sfor_comparison_Signed_I32 in H6 by auto.
       lia.
   + assert (H6: force_val (sem_cmp_default Clt type_i (typeof hi)
                            (if is_long_type type_i then Vlong (Int64.repr i) else Vint (Int.repr i)) n') <> Vint Int.zero) 
-        by (intro Hx; rewrite Hx in H1; inv H1).
-      rewrite Sfor_comparison_Unsigned_I32 in H6 by auto.
+        by (intro Hx; rewrite Hx in Ht; inv Ht).
+      rewrite -> Sfor_comparison_Unsigned_I32 in H6 by auto.
       lia.
   + assert (H6: force_val (sem_cmp_default Clt type_i (typeof hi)
                            (if is_long_type type_i then Vlong (Int64.repr i) else Vint (Int.repr i)) n') <> Vint Int.zero) 
-        by (intro Hx; rewrite Hx in H1; inv H1).
-      rewrite Sfor_comparison_Signed_I64 in H6 by auto.
+        by (intro Hx; rewrite Hx in Ht; inv Ht).
+      rewrite -> Sfor_comparison_Signed_I64 in H6 by auto.
       lia.
   + assert (H6: force_val (sem_cmp_default Clt type_i (typeof hi)
                            (if is_long_type type_i then Vlong (Int64.repr i) else Vint (Int.repr i)) n') <> Vint Int.zero) 
-        by (intro Hx; rewrite Hx in H1; inv H1).
-      rewrite Sfor_comparison_Unsigned_I64 in H6 by auto.
+        by (intro Hx; rewrite Hx in Ht; inv Ht).
+      rewrite -> Sfor_comparison_Unsigned_I64 in H6 by auto.
     lia.
 Qed.
 
 Lemma Sfor_loop_cond_false:
-  ENTAIL Delta, inv0 && local
+  ENTAIL Delta, inv0 ∧ local
     ((` (typed_false (typeof (Ebinop Olt (Etempvar _i type_i) hi tint))))
-       (eval_expr (Ebinop Olt (Etempvar _i type_i) hi tint))) |--
+       (eval_expr (Ebinop Olt (Etempvar _i type_i) hi tint))) ⊢
   inv1 n.
 Proof.
   intros.
-  rewrite <- andp_assoc, (add_andp _ _ EVAL_hi), <- EQ_inv0.
-  Intros n' i. assert_PROP (i = n); [| subst; solve_andp].
-  rewrite <- EQ_inv1.
-  simpl eval_expr.
-  unfold local, lift1; intro rho; simpl; unfold_lift.
-  normalize.
-  apply prop_right; auto.
-  rename H into H'. rename H1 into H. rename H' into H1.
-  rename H0 into H0'. assert (H0 := conj H2 H3). clear H2 H3.
-  rename H0' into H2. rename H4 into H3. rename H5 into H4.
-  rewrite <- H3 in H1.
+  iIntros "(#? & inv0 & #?)".
+  iPoseProof (EVAL_hi with "[-]") as (??) "#?"; first auto.
+  rewrite -EQ_inv0.
+  iDestruct "inv0" as (i ?) "inv1".
+  iAssert ⌜i = n⌝ as %?; [| subst; done].
+  rewrite - EQ_inv1.
+  iStopProof; split => rho; monPred.unseal; rewrite monPred_at_intuitionistically /=.
+  rewrite /lift1; unfold_lift.
+  iIntros "((% & %Ht & ->) & (%Hi & %) & _)"; iPureIntro.
+  rewrite <- Hi in Ht.
   forget (eval_expr hi rho) as n'.
-  clear H3.
-  unfold force_val2, Clight_Cop2.sem_cmp in H1.
-  rewrite CLASSIFY_CMP in H1.
+  clear Hi.
+  unfold force_val2, Clight_Cop2.sem_cmp in Ht.
+  rewrite CLASSIFY_CMP in Ht.
   destruct (classify_binarith type_i (typeof hi)) as [ [|] | [|] | | |] eqn:H3;
     [| | | | 
      destruct type_i as [| [| | |] [|] | [|] | | | | | |]; try solve [inv IMM];
      destruct (typeof hi) as [| [| | |] [|] | [|] | | | | | |]; inv IMM; inv H3 ..];
-    try apply typed_false_tint_e in H1.
-  + rewrite Sfor_comparison_Signed_I32 in H1 by auto.
+    try apply typed_false_tint_e in Ht.
+  + rewrite -> Sfor_comparison_Signed_I32 in Ht by auto.
     lia.
-  + rewrite Sfor_comparison_Unsigned_I32 in H1 by auto.
+  + rewrite -> Sfor_comparison_Unsigned_I32 in Ht by auto.
     lia.
-  + rewrite Sfor_comparison_Signed_I64 in H1 by auto.
+  + rewrite -> Sfor_comparison_Signed_I64 in Ht by auto.
     lia.
-  + rewrite Sfor_comparison_Unsigned_I64 in H1 by auto.
+  + rewrite -> Sfor_comparison_Unsigned_I64 in Ht by auto.
     lia.
 Qed.
 
 Lemma Sfor_inc_tc: forall i s,
   m <= i < n ->
   ENTAIL Delta, inv2 i
-  |-- tc_expr Delta (Ebinop Oadd (Etempvar _i type_i) (Econst_int (Int.repr 1) (Tint I32 s noattr)) type_i) &&
+  ⊢ tc_expr Delta (Ebinop Oadd (Etempvar _i type_i) (Econst_int (Int.repr 1) (Tint I32 s noattr)) type_i) ∧
       tc_temp_id _i (typeof (Ebinop Oadd (Etempvar _i type_i) (Econst_int (Int.repr 1) (Tint I32 s noattr)) type_i))
         Delta (Ebinop Oadd (Etempvar _i type_i) (Econst_int (Int.repr 1) (Tint I32 s noattr)) type_i).
 Proof.
   intros.
-  unfold tc_expr, tc_temp_id.
-  destruct type_i as [| [| | |] [|] | | | | | | |]; 
-  simpl typecheck_expr; unfold typecheck_temp_id;
-  try solve [destruct (typeof hi) as [| [| | |] [|] | [|] | | | | | |]; inv IMM].
-  + 
-    rewrite TI. simpl tc_andp.
-    match goal with
+  unfold tc_expr, typecheck_expr, tc_temp_id, typecheck_temp_id; rewrite TI /=.
+  destruct type_i as [| [| | |] [|] | | | | | | |];
+  try solve [destruct (typeof hi) as [| [| | |] [|] | [|] | | | | | |]; inv IMM]; simpl.
+  + match goal with
     | |- context [ binarithType ?A ?B ?C ?D ?E ] =>
            replace (binarithType A B C D E) with tc_TT by (destruct s; auto)
-    end;
-     destruct s, (typeof hi) as [| [| | |] [|] | [|] | | | | | |]; inv IMM;
-    rewrite <- EQ_inv2, <- denote_tc_assert_andp, tc_andp_TT1, !tc_andp_TT2;
-    rewrite ?denote_tc_assert_andp;
-    unfold isCastResultType;
-    simpl denote_tc_assert; unfold locald_denote; unfold local, lift1; unfold_lift;
-    intro rho; repeat change (andp ?A ?B rho) with (andp (A rho) (B rho)); cbv beta;
-    destruct Archi.ptr64 eqn:Hp;
-    simpl; Intros; rewrite <- ?H1;
-    repeat (simple_if_tac; simpl);
-    repeat apply andp_right; try apply prop_right; auto;
-    try (unfold eval_id in H1;
-          destruct (Map.get (te_of rho) _i); simpl in H1; try discriminate H1; subst v;
-          eexists; split; [reflexivity | apply I]);
-     rewrite ?Int64.signed_repr by rep_lia;
-     rewrite ?Int.signed_repr by rep_lia;
-     rep_lia.
-  + rewrite TI. simpl tc_andp.
-    intro rho.
-    simpl.
-    rewrite <- EQ_inv2.
-    unfold isCastResultType;
-    simpl; unfold_lift; unfold local, lift1.
-    destruct Archi.ptr64 eqn:Hp;
-    normalize.
-    apply prop_right.
-    exists (Vint (Int.repr i)); split; auto.
-    unfold eval_id in H1.
-    destruct (Map.get (te_of rho) _i); simpl in H1; inv H1; auto.
-    apply andp_right.
-    apply prop_right.
-       exists (Vint (Int.repr i)); split; auto;
-      unfold eval_id in H1;
-      destruct (Map.get (te_of rho) _i); simpl in H1; inv H1; auto.
-    simple_if_tac; simpl; apply TT_right.
-  + 
-    rewrite TI. simpl tc_andp.
-    match goal with
+    end; rewrite tc_andp_TT1 tc_andp_TT2 denote_tc_assert_andp.
+    apply bi.and_intro; last by rewrite /isCastResultType /=; destruct Archi.ptr64 eqn: Hp; try simple_if_tac; split => rho /=; unfold_lift; apply TT_right.
+    rewrite /tc_nobinover /if_expr_signed /= /denote_tc_initialized -EQ_inv2.
+    split => rho; monPred.unseal; rewrite /lift1; unfold_lift.
+    iIntros "(% & (%Hv & %) & _)".
+    destruct s; rewrite /= /denote_tc_nosignedover; unfold_lift; unfold eval_id in *; destruct (Map.get (te_of rho) _i) eqn: Hi; simpl in Hv; subst; try done; simpl;
+      iPureIntro; (split; [|eexists; done]); try done;
+      simpl in IMM; destruct (typeof hi) as [| [| | |] [|] | [|] | | | | | |]; inv IMM;
+      rewrite -> ?Int64.signed_repr by rep_lia;
+      rewrite -> ?Int.signed_repr by rep_lia;
+      rep_lia.
+  + apply bi.and_intro; last by rewrite /isCastResultType /=; destruct Archi.ptr64 eqn: Hp; try simple_if_tac; split => rho /=; unfold_lift; apply TT_right.
+    rewrite /denote_tc_initialized -EQ_inv2.
+    split => rho; monPred.unseal; rewrite /lift1; unfold_lift.
+    iIntros "(% & (%Hv & %) & _)".
+    unfold eval_id in *; destruct (Map.get (te_of rho) _i) eqn: Hi; simpl in Hv; subst; try done; simpl.
+    eauto.
+  + match goal with
     | |- context [ binarithType ?A ?B ?C ?D ?E ] =>
            replace (binarithType A B C D E) with tc_TT by (destruct s0; auto)
-    end.
-     destruct s0, (typeof hi) as [| [| | |] [|] | [|] | | | | | |]; inv IMM;
-    rewrite <- EQ_inv2, <- denote_tc_assert_andp, tc_andp_TT1, !tc_andp_TT2;
-    rewrite ?denote_tc_assert_andp;
-    unfold isCastResultType;
-    simpl denote_tc_assert; unfold locald_denote; unfold local, lift1; unfold_lift;
-    intro rho; repeat change (andp ?A ?B rho) with (andp (A rho) (B rho)); cbv beta;
-    destruct Archi.ptr64 eqn:Hp;
-    simpl; Intros; rewrite <- ?H1;
-    repeat (simple_if_tac; simpl);
-    repeat apply andp_right; try apply prop_right; auto;
-    try (unfold eval_id in H1;
-          destruct (Map.get (te_of rho) _i); simpl in H1; try discriminate H1; subst v;
-          eexists; split; [reflexivity | apply I]);
-     destruct s; 
-    rewrite <- H1; apply prop_right;
-     rewrite ?Int64.signed_repr by rep_lia;
-     rewrite ?Int.signed_repr by rep_lia;
-     rewrite ?Int.unsigned_repr by rep_lia;
-     rep_lia.
+    end; rewrite tc_andp_TT1 tc_andp_TT2 denote_tc_assert_andp.
+    apply bi.and_intro; last by rewrite /isCastResultType /=; destruct Archi.ptr64 eqn: Hp; try simple_if_tac; split => rho /=; unfold_lift; apply TT_right.
+    rewrite /tc_nobinover /if_expr_signed /= /denote_tc_initialized -EQ_inv2.
+    split => rho; monPred.unseal; rewrite /lift1; unfold_lift.
+    iIntros "(% & (%Hv & %) & _)".
+    destruct s, s0; rewrite /= /denote_tc_nosignedover; unfold_lift; unfold eval_id in *; destruct (Map.get (te_of rho) _i) eqn: Hi; simpl in Hv; subst; try done; simpl;
+      iPureIntro; (split; [|eexists; done]); try done;
+      simpl in IMM; destruct (typeof hi) as [| [| | |] [|] | [|] | | | | | |]; inv IMM;
+      rewrite -> ?Int64.signed_repr by rep_lia;
+      rewrite -> ?Int.signed_repr by rep_lia;
+      rewrite -> ?Int.unsigned_repr by rep_lia;
+      rep_lia.
 Qed.
 
 Lemma Sfor_inc_entail: forall i s,
   m <= i < n ->
-  EX old : val,
-  local
-    ((` eq) (eval_id _i)
+  (∃ old : val, local ((` eq) (eval_id _i)
        (subst _i (` old)
-          (eval_expr (Ebinop Oadd (Etempvar _i type_i) (Econst_int (Int.repr 1) (Tint I32 s noattr)) type_i)))) &&
-    subst _i (` old) (inv2 i) |--
+          (eval_expr (Ebinop Oadd (Etempvar _i type_i) (Econst_int (Int.repr 1) (Tint I32 s noattr)) type_i)))) ∧
+    assert_of (subst _i (` old) (inv2 i))) ⊢
   inv0.
 Proof.
   intros.
   Intros old.
   rewrite <- EQ_inv0.
   Exists (i + 1).
-  rewrite <- EQ_inv1, <- EQ_inv2.
-  rewrite subst_andp, SUBST_callee.
-  simpl.
-  intro rho; unfold local, lift1, subst; unfold_lift.
-  normalize.
-  rewrite eval_id_same in *.
-  subst old.
+  rewrite -EQ_inv1 -subst_proper; last apply EQ_inv2.
+  rewrite subst_andp SUBST_callee /=.
+  rewrite !assoc; apply bi.and_mono; last done.
+  apply bi.and_intro; first by apply bi.pure_intro; clear - H; lia.
+  split => rho; monPred.unseal; rewrite /lift1 /=; unfold_lift.
+  rewrite /subst.
   normalize.
-  apply andp_right; auto.
-  apply prop_right.
-  split; [lia |].
-  rewrite H0; clear H0.
-  clear H2.
+  rewrite -> eval_id_same in *; subst.
+  split; last by simple_if_tac.
+  rewrite H0.
   destruct type_i as [| [| | |] [|] | | | | | | |];
   try solve [destruct (typeof hi) as [| [| | |] [|] | [|] | | | | | |]; inv IMM];
   simpl;
   destruct s; try destruct s0; unfold Clight_Cop2.sem_binarith; simpl;
   unfold both_int; simpl; unfold Clight_Cop2.sem_cast; simpl;
   destruct Archi.ptr64 eqn:Hp; simpl;
-  (split; [ | congruence]);
-   rewrite ?add_repr, ?add64_repr;
+   rewrite ?add_repr ?add64_repr;
    reflexivity.
 Qed.
 
 End Sfor.
 
 Lemma semax_for:
- forall (Inv: environ->mpred) (n: Z) Espec {cs: compspecs} Delta
-           (Pre: environ->mpred)
+ forall (Inv: assert) (n: Z) E Delta
+           (Pre: assert)
            (_i: ident) (init: statement) (m: Z) (hi: expr) (body MORE_COMMAND: statement) (Post: ret_assert)
            (type_i: type)
-           (assert_callee: Z -> environ -> mpred)
-           (inv0: environ -> mpred)
-           (inv1 inv2: Z -> environ -> mpred) s
-     (TI: (temp_types Delta) ! _i = Some type_i),
+           (assert_callee: Z -> assert)
+           (inv0: assert)
+           (inv1 inv2: Z -> assert) s
+     (TI: (temp_types Delta) !! _i = Some type_i),
     forall
-     (CALLEE: Inv = exp assert_callee)
+     (CALLEE: Inv = ∃ x, assert_callee x)
      (INV: Sfor_inv (is_long_type type_i) Delta _i m hi n assert_callee inv0 inv1 inv2)
-     (SETUP: Sfor_setup Delta _i Pre init hi type_i m n assert_callee inv0),
+     (SETUP: Sfor_setup E Delta _i Pre init hi type_i m n assert_callee inv0),
      (forall i, m <= i < n ->
-     @semax cs Espec Delta (inv1 i)
+     semax E Delta (inv1 i)
         body
         (for_ret_assert (inv2 i) Post)) ->
-     @semax cs Espec Delta
+     semax E Delta
         (inv1 n) MORE_COMMAND Post ->
-     @semax cs Espec Delta Pre
+     semax E Delta Pre
        (Ssequence
          (Sfor init
                 (Ebinop Olt (Etempvar _i type_i) hi (Tint I32 Signed noattr))
@@ -727,8 +678,8 @@ Proof.
   intros.
   destruct Post as [nPost bPost cPost rPost].
   apply semax_seq with (inv1 n); [clear H0 | exact H0].
-  apply semax_post with {| RA_normal := inv1 n; RA_break := FF; RA_continue := FF; RA_return := rPost |};
-    [apply andp_left2, derives_refl | apply andp_left2, FF_left | apply andp_left2, FF_left | intros; simpl RA_return; solve_andp |].
+  apply semax_post with {| RA_normal := inv1 n; RA_break := False; RA_continue := False; RA_return := rPost |};
+    [intros; rewrite bi.and_elim_r //; iIntros "[]" ..|].
   simpl for_ret_assert in H.
   clear bPost cPost.
   unfold Sfor.
@@ -739,90 +690,89 @@ Proof.
   destruct SETUP as [INIT [init_min_i [init_max_i [init_min_hi [init_max_hi [? ?]]]]]].
 
   apply semax_seq' with inv0; [exact INIT | clear INIT].
-  apply (semax_loop _ inv0 (EX i: Z, !! (m <= i < n) && inv2 i));
-    [apply semax_seq with (EX i : Z, !! (m <= i < n) && inv1 i) |].
-  + apply semax_pre with (|> (tc_expr Delta (Eunop Onotbool (Ebinop Olt (Etempvar _i type_i) hi tint) (Tint I32 Signed noattr)) && inv0)).
-    {
-      eapply derives_trans, now_later.
-      apply andp_right; [| solve_andp].
-      eapply Sfor_loop_cond_tc; eauto.
-    }
+  apply (semax_loop _ _ inv0 (∃ i: Z, ⌜m <= i < n⌝ ∧ inv2 i));
+    [apply semax_seq with (∃ i : Z, ⌜m <= i < n⌝ ∧ inv1 i) |].
+  + apply semax_pre with (▷ (tc_expr Delta (Eunop Onotbool (Ebinop Olt (Etempvar _i type_i) hi tint) (Tint I32 Signed noattr)) ∧ inv0)).
+    { iIntros "(#? & ?) !>"; iSplit; last done.
+      iApply Sfor_loop_cond_tc; eauto. }
     apply semax_ifthenelse; auto.
-    - eapply semax_post; [.. | apply semax_skip].
+    - eapply semax_post, semax_skip.
       * unfold RA_normal, normal_ret_assert, overridePost, loop1_ret_assert.
         eapply Sfor_loop_cond_true; eauto.
-      * apply andp_left2, FF_left.
-      * apply andp_left2, FF_left.
-      * intros; apply andp_left2, FF_left.
-    - eapply semax_pre; [| apply semax_break].
+      * iIntros "(? & [])".
+      * iIntros "(? & [])".
+      * intros; iIntros "(? & [])".
+    - eapply semax_pre, semax_break.
       unfold RA_break, overridePost, loop1_ret_assert.
       eapply Sfor_loop_cond_false; eauto.
   + Intros i.
     apply semax_extract_prop; intros.
     unfold loop1_ret_assert.
-    eapply semax_post; [.. | apply H; auto].
+    eapply semax_post, H; auto.
     - unfold RA_normal.
-      apply (exp_right i).
-      apply andp_right; [apply prop_right | apply andp_left2]; auto.
+      Exists i.
+      iIntros "(_ & $)"; auto.
     - unfold RA_break.
-      intro; simpl;
-      apply andp_left2, FF_left.
+      iIntros "(_ & [])".
     - unfold RA_continue.
-      apply (exp_right i).
-      apply andp_right; [apply prop_right | apply andp_left2]; auto.
+      Exists i.
+      iIntros "(_ & $)"; auto.
     - intros.
-      apply andp_left2, derives_refl.
+      iIntros "(_ & $)".
   + Intros i.
     apply semax_extract_prop; intros.
-    eapply semax_pre_post; [.. | apply semax_set_forward].
-    - eapply derives_trans; [| apply now_later].
-      apply andp_right; [| apply andp_left2, derives_refl].
-      eapply (Sfor_inc_tc _ _ m n); eauto.
+    eapply semax_pre_post, semax_set_forward.
+    - iIntros "(#? & H) !>".
+      rewrite assoc; iSplit; last by iApply "H".
+      iApply (Sfor_inc_tc _ _ m n); eauto.
     - unfold RA_normal, loop2_ret_assert, normal_ret_assert.
-      eapply andp_left2, (Sfor_inc_entail _ _ m n); eauto.
-    - apply andp_left2, FF_left.
-    - apply andp_left2, FF_left.
-    - intros; apply andp_left2, FF_left.
+      iIntros "(_ & ?)".
+      iApply Sfor_inc_entail; eauto.
+    - iIntros "(_ & [])".
+    - iIntros "(_ & [])".
+    - intros; iIntros "(_ & [])".
 Qed.
 
 Lemma semax_for_x :
- forall (Inv: environ->mpred) (n: Z) Espec {cs: compspecs} Delta
-           (Pre: environ->mpred)
+ forall (Inv: assert) (n: Z) E Delta
+           (Pre: assert)
            (_i: ident) (init: statement) (m: Z) (hi: expr) (body MORE_COMMAND: statement) (Post: ret_assert)
            (type_i: type)
-           (assert_callee: Z -> environ -> mpred)
-           (inv0: environ -> mpred)
-           (inv1 inv2: Z -> environ -> mpred) s
+           (assert_callee: Z -> assert)
+           (inv0: assert)
+           (inv1 inv2: Z -> assert) s
            test incr,
      test = Ebinop Olt (Etempvar _i type_i) hi (Tint I32 Signed noattr) ->
      incr = Sset _i (Ebinop Oadd (Etempvar _i type_i) (Econst_int (Int.repr 1) (Tint I32 s noattr)) type_i) ->
      forall
-     (TI: (temp_types Delta) ! _i = Some type_i)
-     (CALLEE: Inv = exp assert_callee)
+     (TI: (temp_types Delta) !! _i = Some type_i)
+     (CALLEE: Inv = ∃ x, assert_callee x)
      (INV: Sfor_inv (is_long_type type_i) Delta _i m hi n assert_callee inv0 inv1 inv2)
-     (SETUP: Sfor_setup Delta _i Pre init hi type_i m n assert_callee inv0),
+     (SETUP: Sfor_setup E Delta _i Pre init hi type_i m n assert_callee inv0),
      (forall i, m <= i < n ->
-     @semax cs Espec Delta (inv1 i)
+     semax E Delta (inv1 i)
         body
         (for_ret_assert (inv2 i) Post)) ->
-     @semax cs Espec Delta
+     semax E Delta
         (inv1 n) MORE_COMMAND Post ->
-     @semax cs Espec Delta Pre
+     semax E Delta Pre
        (Ssequence (Sfor init test body incr)
          MORE_COMMAND) Post.
 Proof.
-intros.
-subst test incr.
-eapply semax_for; eauto.
+  intros.
+  subst test incr.
+  eapply semax_for; eauto.
 Qed.
 
 Lemma quick_derives_right:
-  forall P Q : environ -> mpred,
-   (TT |-- Q) -> P |-- Q.
+  forall P Q : assert,
+   (True ⊢ Q) -> P ⊢ Q.
 Proof.
-intros. eapply derives_trans; try eassumption; auto.
+  intros ?? <-; auto.
 Qed.
 
+End mpred.
+
 Ltac quick_typecheck3 :=
  (* do not clear hyps anymore!  See issue #772 
  clear;
@@ -831,7 +781,7 @@ Ltac quick_typecheck3 :=
  | H : _ |- _ => clear H
  end; *)
  apply quick_derives_right; clear; go_lowerx; intros;
- clear; repeat apply andp_right; 
+ clear; repeat apply bi.and_intro;
  try apply derives_refl;  (* see issue #756 *)
  auto; fail.
 
@@ -885,7 +835,7 @@ Ltac prove_Sfor_inv_rec :=
   match goal with
   | |- Sfor_inv_rec _ _ _ _ _ _ _ ?assert_callee _ _ =>
     lazymatch assert_callee with
-    | exp (fun x => _) =>
+    | ∃ x, _ =>
         let x' := fresh x in
         eapply Sfor_inv_rec_step;
         intros x';
@@ -963,7 +913,7 @@ Ltac forward_for_simple_bound'' n Inv :=
   [ check_forloop_test
   | check_forloop_incr
   | reflexivity
-  | (reflexivity || fail 1000 "The loop invariant for forward_for_simple_bound should have form (EX i: Z, _).")
+  | (reflexivity || fail 1000 "The loop invariant for forward_for_simple_bound should have form (∃ i: Z, _).")
   | prove_Sfor_inv
   | try change (if is_long_type _ then ?A else ?B) with A;
     try change (if is_long_type _ then ?A else ?B) with B;
@@ -974,11 +924,10 @@ Ltac forward_for_simple_bound'' n Inv :=
     abbreviate_semax;
     repeat
       match goal with
-      | |- semax _ (exp (fun x => _)) _ _ =>
+      | |- semax _ _ (∃ x, _) _ _ =>
           let x' := fresh x in
           apply extract_exists_pre; intro x'; cbv beta
       end
   | try change (if is_long_type _ then ?A else ?B) with A;
     try change (if is_long_type _ then ?A else ?B) with B;
     idtac ].
-
diff --git a/floyd/forward.v b/floyd/forward.v
index b065e5aafc..efba32db4a 100644
--- a/floyd/forward.v
+++ b/floyd/forward.v
@@ -1,9 +1,12 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.go_lower.
 Require Import VST.floyd.closed_lemmas.
 Require Import VST.floyd.subsume_funspec.
-Require Import VST.floyd.forward_lemmas VST.floyd.call_lemmas.
+Require Import VST.floyd.forward_lemmas.
+Require Import VST.floyd.call_lemmas.
 Require Import VST.floyd.extcall_lemmas.
 Require Import VST.floyd.nested_field_lemmas.
 Require Import VST.floyd.efield_lemmas.
@@ -35,7 +38,7 @@ Import Cop.
 Import Cop2.
 Import Clight_Cop2.
 Import LiftNotation.
-Import compcert.lib.Maps.
+Import -(notations) compcert.lib.Maps.
 
 Global Opaque denote_tc_test_eq.
 Global Transparent intsize_eq signedness_eq attr_eq floatsize_eq type_eq typelist_eq calling_convention_eq.
@@ -45,12 +48,18 @@ Arguments Z.div _ _ / .
 #[export] Hint Rewrite @sem_add_pi_ptr_special' using (solve [try reflexivity; auto with norm]) : norm.
 #[export] Hint Rewrite @sem_add_pl_ptr_special' using (solve [try reflexivity; auto with norm]) : norm.
 
-Lemma func_ptr'_emp phi v: func_ptr' phi v |-- emp.
-Proof. apply andp_left2; trivial. Qed.
+Lemma func_ptr_emp `{!VSTGS OK_ty Σ} phi v: func_ptr phi v ⊢ emp.
+Proof. iIntros. done. Qed.
 
-Lemma func_ptr'_mono {fs gs v}: funspec_sub fs gs ->
-       func_ptr' fs v |-- func_ptr' gs v.
-Proof. intros. apply andp_derives; trivial. apply func_ptr_mono; trivial. Qed.
+Lemma func_ptr_mono `{!VSTGS OK_ty Σ} {fs gs v}: funspec_sub fs gs ->
+       func_ptr fs v ⊢ func_ptr gs v.
+Proof. apply funspec_sub_implies_func_prt_si_mono. Qed.
+
+Lemma split_func_ptr `{!VSTGS OK_ty Σ}:  forall fs p, func_ptr fs p ⊣⊢ func_ptr fs p ∗ func_ptr fs p.
+Proof.
+intros.
+apply bi.persistent_sep_dup; apply _.
+Qed.
 
 Lemma isptr_force_sem_add_ptr_int:
   forall {cs: compspecs}  t si p i,
@@ -108,64 +117,63 @@ intros. subst. apply field_compatible_field_address; auto.
 Qed.
 
 #[export] Hint Resolve field_address_eq_offset' : prove_it_now.
-
-#[export] Hint Rewrite <- @prop_and using solve [auto with typeclass_instances]: norm1.
-
-Local Open Scope logic.
+#[export] Hint Rewrite <- @pure_and @pure_and': norm1.
 
 
 Lemma var_block_lvar2:
- forall {cs: compspecs} {Espec: OracleKind} id t Delta P Q R Vs c Post,
-   (var_types Delta) ! id = Some t ->
+ forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} id t E Delta P Q R Vs c Post,
+   (var_types Delta) !! id = Some t ->
    complete_legal_cosu_type t = true ->
    sizeof t < Ptrofs.modulus ->
    is_aligned cenv_cs ha_env_cs la_env_cs t 0 = true ->
   (forall v,
-   semax Delta ((PROPx P (LOCALx (lvar id t v :: Q) (SEPx (data_at_ Tsh t v :: R))))
-                      * fold_right sepcon emp Vs)
+   semax E Delta ((PROPx P (LOCALx (lvar id t v :: Q) (SEPx (data_at_ Tsh t v :: R))))
+                      ∗ fold_right bi_sep emp Vs)
                c Post) ->
- semax Delta ((PROPx P (LOCALx Q (SEPx R)))
-                      * fold_right sepcon emp (var_block Tsh (id,t) :: Vs))
+ semax E Delta ((PROPx P (LOCALx Q (SEPx R)))
+                      ∗ fold_right bi_sep emp (var_block Tsh (id,t) :: Vs))
                c Post.
 Proof.
 intros.
 assert (Int.unsigned Int.zero + sizeof t <= Ptrofs.modulus)
  by (rewrite Int.unsigned_zero; lia).
 eapply semax_pre.
-instantiate (1 := EX v:val, (PROPx P (LOCALx (lvar id t v :: Q) (SEPx (data_at_ Tsh t v :: R))))
-                      * fold_right sepcon emp Vs).
-unfold var_block,  eval_lvar.
-go_lowerx. unfold lvar_denote.
+instantiate (1 := ∃ v:val, (PROPx P (LOCALx (lvar id t v :: Q) (SEPx (data_at_ Tsh t v :: R))))
+                      ∗ fold_right bi_sep emp Vs).
+unfold var_block, eval_lvar; simpl.
+go_lowerx.
+rewrite -sep_exist_r; cancel.
+unfold lvar_denote.
 normalize.
 unfold Map.get.
 destruct (ve_of rho id) as [[? ?] | ] eqn:?.
 destruct (eqb_type t t0) eqn:?.
 apply eqb_type_true in Heqb0.
 subst t0.
-apply exp_right with (Vptr b Ptrofs.zero).
+apply bi.exist_intro' with (Vptr b Ptrofs.zero).
 unfold size_compatible.
-rewrite prop_true_andp. rewrite TT_andp.
-rewrite memory_block_data_at_.
+rewrite !prop_true_andp //.
+rewrite memory_block_data_at_; auto.
 cancel.
 split3; auto. apply Coq.Init.Logic.I.
 split3; auto.
 apply la_env_cs_sound; auto.
 apply Coq.Init.Logic.I.
-split; auto.
-rewrite memory_block_isptr; normalize.
-rewrite memory_block_isptr; normalize.
-apply extract_exists_pre.  apply H3.
+rewrite memory_block_isptr; Intros; contradiction.
+rewrite memory_block_isptr; Intros; contradiction.
+apply extract_exists_pre. apply H3.
 Qed.
 
 Lemma var_block_lvar0
-     : forall {cs: compspecs} (id : positive) (t : type) (Delta : tycontext)  v rho,
-       (var_types Delta) ! id = Some t ->
+     : forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs}
+       (id : positive) (t : type) (Delta : tycontext)  v rho,
+       (var_types Delta) !! id = Some t ->
        complete_legal_cosu_type t = true ->
        sizeof t < Ptrofs.modulus ->
        is_aligned cenv_cs ha_env_cs la_env_cs t 0 = true ->
        tc_environ Delta rho ->
        locald_denote (lvar id t v) rho ->
-       data_at_ Tsh t v |-- var_block Tsh (id, t) rho.
+       data_at_ Tsh t v ⊢ var_block Tsh (id, t) rho.
 Proof.
 intros.
 hnf in H4.
@@ -173,12 +181,13 @@ assert (Ptrofs.unsigned Ptrofs.zero + sizeof t <= Ptrofs.modulus)
  by (rewrite Ptrofs.unsigned_zero; lia).
 unfold var_block.
 simpl @fst; simpl @snd.
-rewrite prop_true_andp
+monPred.unseal.
+rewrite ->prop_true_andp
   by (change (Ptrofs.max_unsigned) with (Ptrofs.modulus-1); lia).
 unfold_lift.
 rewrite (lvar_eval_lvar _ _ _ _ H4).
 rewrite memory_block_data_at_; auto.
-hnf in H4.
+hnf in H5.
 destruct ( Map.get (ve_of rho) id); try contradiction.
 destruct p.
 destruct H4; subst.
@@ -187,73 +196,77 @@ apply la_env_cs_sound; eauto.
 Qed.
 
 Lemma postcondition_var_block:
-  forall {cs: compspecs} {Espec: OracleKind} Delta Pre c S1 S2 i t vbs,
-       (var_types  Delta) ! i = Some t ->
+  forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs}
+       E Delta Pre c S1 S2 i t vbs,
+       (var_types  Delta) !! i = Some t ->
        complete_legal_cosu_type t = true ->
        sizeof t < Ptrofs.modulus ->
        is_aligned cenv_cs ha_env_cs la_env_cs t 0 = true ->
-   semax Delta Pre c (frame_ret_assert S1
-     (S2 *  (EX  v : val, local (locald_denote (lvar i t v)) && `(data_at_ Tsh t v))
-      * fold_right sepcon emp vbs)) ->
-  semax Delta Pre c (frame_ret_assert S1
-     (S2 * fold_right sepcon emp (var_block Tsh (i,t) :: vbs))).
+   semax E Delta Pre c (frame_ret_assert S1
+     (S2 ∗  (∃  v : val, local (locald_denote (lvar i t v)) ∧ (assert_of `(data_at_ Tsh t v)))
+      ∗ fold_right bi_sep emp vbs)) ->
+  semax E Delta Pre c (frame_ret_assert S1
+     (S2 ∗ fold_right bi_sep emp (var_block Tsh (i,t) :: vbs))).
 Proof.
 intros.
 destruct S1 as [?R ?R ?R ?R];
 eapply semax_post; try apply H3; clear H3;
  intros; simpl_ret_assert; go_lowerx.
 *
-apply sepcon_derives; auto.
-rewrite <- !sepcon_assoc.
-apply sepcon_derives; auto.
-apply sepcon_derives; auto.
-apply exp_left; intro v.
+apply bi.sep_mono; auto.
+rewrite !bi.sep_assoc.
+apply bi.sep_mono; auto.
+apply bi.sep_mono; auto.
+apply bi.exist_elim; intro v.
 normalize.
 eapply var_block_lvar0; try apply H; try eassumption.
 *
-apply sepcon_derives; auto.
-rewrite <- !sepcon_assoc.
-apply sepcon_derives; auto.
-apply sepcon_derives; auto.
-apply exp_left; intro v.
+apply bi.sep_mono; auto.
+rewrite !bi.sep_assoc.
+apply bi.sep_mono; auto.
+apply bi.sep_mono; auto.
+apply bi.exist_elim; intro v.
 normalize.
 eapply var_block_lvar0; try apply H; try eassumption.
 *
-apply sepcon_derives; auto.
-rewrite <- !sepcon_assoc.
-apply sepcon_derives; auto.
-apply sepcon_derives; auto.
-apply exp_left; intro v.
+apply bi.sep_mono; auto.
+rewrite !bi.sep_assoc.
+apply bi.sep_mono; auto.
+apply bi.sep_mono; auto.
+apply bi.exist_elim; intro v.
 normalize.
 eapply var_block_lvar0; try apply H; try eassumption.
 *
-apply sepcon_derives; auto.
-rewrite <- !sepcon_assoc.
-apply sepcon_derives; auto.
-apply sepcon_derives; auto.
-apply exp_left; intro v.
+apply bi.sep_mono; auto.
+rewrite !bi.sep_assoc.
+apply bi.sep_mono; auto.
+apply bi.sep_mono; auto.
+apply bi.exist_elim; intro v.
 normalize.
 eapply var_block_lvar0; try apply H; try eassumption.
 Qed.
 
+Lemma sep_emp_2 {prop:bi} (P:prop) : P ∗ emp ⊢ P.
+Proof. rewrite bi.sep_comm bi.emp_sep_2 //. Qed.
+
 Ltac process_stackframe_of :=
- lazymatch goal with |- semax _ (_ * stackframe_of ?F) _ _ =>
+ lazymatch goal with |- semax _ _ (_ ∗ stackframe_of ?F) _ _ =>
    let sf := fresh "sf" in set (sf:= stackframe_of F) at 1;
      unfold stackframe_of in sf; simpl map in sf; subst sf
   end;
  repeat
-   lazymatch goal with |- semax _ (_ * fold_right sepcon emp (var_block _ (?i,_) :: _)) _ _ =>
+   lazymatch goal with |- semax _ _ (_ ∗ fold_right bi_sep emp (var_block _ (?i,_) :: _)) _ _ =>
      simple apply var_block_lvar2;
        [ reflexivity | reflexivity | reflexivity | reflexivity | let n := fresh "v" i in intros n ]
    end;
   repeat (simple apply postcondition_var_block;
    [reflexivity | reflexivity | reflexivity | reflexivity | reflexivity |  ]);
- change (fold_right sepcon emp (@nil (environ->mpred))) with
-   (@emp (environ->mpred) _ _);
- rewrite ?sepcon_emp, ?emp_sepcon.
+ change (fold_right bi_sep emp (@nil assert)) with
+   (@bi_emp assert);
+ rewrite ?bi.emp_sep ?bi.sep_emp.
 
 Definition tc_option_val' (t: type) : option val -> Prop :=
- match t with Tvoid => fun v => True | _ => fun v => tc_val t (force_val v) end.
+ match t with Tvoid => fun v => (True:Prop) | _ => fun v => tc_val t (force_val v) end.
 Lemma tc_option_val'_eq: tc_option_val = tc_option_val'.
 Proof. extensionality t v.
 unfold tc_option_val, tc_option_val'.
@@ -262,10 +275,10 @@ unfold tc_val. destruct (eqb_type _ _); reflexivity.
 Qed.
 #[export] Hint Rewrite tc_option_val'_eq : norm.
 
-Lemma emp_make_ext_rval:
-  forall ge t v, @emp (environ->mpred) _ _ (make_ext_rval ge t v) = emp.
-Proof. reflexivity. Qed.
-#[export] Hint Rewrite emp_make_ext_rval : norm2.
+Lemma emp_make_ext_rval `{heapGS Σ}:
+  forall ge t v, @bi_emp assert (make_ext_rval ge t v) = emp.
+Proof. intros. monPred.unseal. reflexivity. Qed.
+#[export] Hint Rewrite @emp_make_ext_rval : norm2.
 
 Ltac semax_func_cons_ext_tc :=
   repeat match goal with
@@ -274,8 +287,8 @@ Ltac semax_func_cons_ext_tc :=
   | |- forall x:?T, _ => let t := fresh "t" in set (t:=T); progress simpl in t; subst t
   | |- forall x, _ => intro
   end;
-  try apply prop_True_right;
-  normalize; simpl tc_option_val' .
+  try apply bi.True_intro;
+  normalize; simpl tc_option_val'.
 
 Ltac fast_Qed_reflexivity :=
 hnf;
@@ -302,15 +315,18 @@ Ltac LookupB :=
  fast_Qed_reflexivity
  || fail "Lookup for a function pointer block in Genv failed".
 
-Lemma semax_body_subsumption' cs cs' V V' F F' f spec
-      (SF: @semax_body V F cs f spec)
+Section FORWARD.
+Context `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs}.
+Lemma semax_body_subsumption' 
+      (cs cs':compspecs) V V' F F' f spec
+      (SF: semax_body V F (C:=cs) f spec)
       (CSUB: cspecs_sub cs cs')
       (COMPLETE : Forall (fun it : ident * type => complete_type (@cenv_cs cs) (snd it) = true) (fn_vars f))
       (TS: tycontext_sub (func_tycontext f V F nil) (func_tycontext f V' F' nil)):
-  @semax_body V' F' cs' f spec.
+  semax_body V' F' (C:=cs') f spec.
 Proof.
   intros.
-  apply (@semax_body_cenv_sub _ _ CSUB); auto.
+  apply (semax_body_cenv_sub CSUB); auto.
   eapply semax_body_subsumption; try eassumption.
 Qed.
 
@@ -320,7 +336,7 @@ Lemma sub_option_get' {A: Type} (s t: PTree.t A) B (f:A -> option B):
                        (match PTree.get i t with Some x => f x | _ => None end).
 Proof.
 intros.
-destruct (s ! i) eqn:?H; [ | apply I].
+destruct (s !! i) eqn:?H; [ | apply I].
 pose proof (PTree.elements_correct s i H0).
 rewrite Forall_forall in H.
 apply H in H1.
@@ -332,15 +348,15 @@ Lemma sub_option_get {A: Type} (s t: PTree.t A):
   forall i, sub_option (PTree.get i s) (PTree.get i t).
 Proof.
   intros; specialize (sub_option_get' s t A Some H i); intros.
-  destruct (s!i); [simpl; destruct (t!i); inv H0 | ]; trivial.
+  destruct (s!!i); [simpl; destruct (t!!i); inv H0 | ]; trivial.
 Qed. 
 
 Definition tycontext_subVG Vprog1 Gprog1 Vprog2 Gprog2 :=
  (forall id : positive,
-   sub_option (make_tycontext_g Vprog1 Gprog1) ! id
-    (make_tycontext_g Vprog2 Gprog2) ! id) /\
+   sub_option ((make_tycontext_g Vprog1 Gprog1) !! id)
+    ((make_tycontext_g Vprog2 Gprog2) !! id)) /\
  (forall id : positive,
-   subsumespec (make_tycontext_s Gprog1) ! id (make_tycontext_s Gprog2) ! id).
+   subsumespec ((make_tycontext_s Gprog1) !! id) ((make_tycontext_s Gprog2) !! id)).
 
 Lemma tycontext_sub_i99:
  forall f Vprog1 Vprog2 Gprog1 Gprog2 Annot,
@@ -353,36 +369,38 @@ destruct H.
 split3; [ | | split3; [ | | split]]; auto.
 -
 unfold temp_types, func_tycontext, make_tycontext.
-intros. destruct ((make_tycontext_t (fn_params f) (fn_temps f)) ! id); auto.
+intros. destruct ((make_tycontext_t (fn_params f) (fn_temps f)) !! id); auto.
 -
 intros. apply Annotation_sub_refl.
 Qed.
 
+  Local Notation make_tycontext_s := (@make_tycontext_s Σ).
+  Local Notation make_tycontext_g := (@make_tycontext_g Σ).
   Lemma make_tycontext_s_app1 G1 G2 i:
-    sub_option (make_tycontext_s G1) ! i (make_tycontext_s (G1++G2)) ! i.
+    sub_option ((make_tycontext_s G1) !! i) ((make_tycontext_s (G1++G2)) !! i).
   Proof.
-    red; rewrite 2 semax_prog.find_id_maketycontext_s.
+    red; rewrite 2!semax_prog.find_id_maketycontext_s.
     remember (initial_world.find_id i G1) as q; destruct q; [symmetry in Heqq | trivial].
     apply initial_world.find_id_app1; trivial.
   Qed.
   Lemma make_tycontext_s_app2 G1 G2 i: list_norepet (map fst (G1++G2)) ->
-    sub_option (make_tycontext_s G2) ! i (make_tycontext_s (G1++G2)) ! i.
+    sub_option ((make_tycontext_s G2) !! i) ((make_tycontext_s (G1++G2)) !! i).
   Proof.
-    intros; red; rewrite 2 semax_prog.find_id_maketycontext_s.
+    intros; red; rewrite 2!semax_prog.find_id_maketycontext_s.
     remember (initial_world.find_id i G2) as q; destruct q; [symmetry in Heqq | trivial].
     apply initial_world.find_id_app2; trivial.
   Qed.
   
   Lemma make_tycontext_g_app1 V G1 G2 (HG1: list_norepet (map fst G1))
         (HG12: list_norepet (map fst V ++ map fst (G1 ++ G2))) i:
-    sub_option ((make_tycontext_g V G1) ! i) ((make_tycontext_g V (G1 ++ G2)) ! i).
+    sub_option ((make_tycontext_g V G1) !! i) ((make_tycontext_g V (G1 ++ G2)) !! i).
   Proof.
     intros. apply semax_prog.suboption_make_tycontext_s_g; trivial.
     intros. eapply make_tycontext_s_app1. 
   Qed.
   Lemma make_tycontext_g_app2 V G1 G2 (HG1: list_norepet (map fst G2))
         (HG12: list_norepet (map fst V ++ map fst (G1 ++ G2))) i:
-    sub_option ((make_tycontext_g V G2) ! i) ((make_tycontext_g V (G1 ++ G2)) ! i).
+    sub_option ((make_tycontext_g V G2) !! i) ((make_tycontext_g V (G1 ++ G2)) !! i).
   Proof.
     intros. apply semax_prog.suboption_make_tycontext_s_g; trivial.
     apply list_norepet_append_right in HG12. 
@@ -390,17 +408,17 @@ Qed.
   Qed.
   
   Lemma subsumespec_app1 G1 G2 i:
-    subsumespec ((make_tycontext_s G1) ! i) ((make_tycontext_s (G1++G2)) ! i).
+    subsumespec ((make_tycontext_s G1) !! i) ((make_tycontext_s (G1++G2)) !! i).
   Proof.
-    red. remember ((make_tycontext_s G1) ! i) as q; destruct q; [symmetry in Heqq | trivial].
+    red. remember ((make_tycontext_s G1) !! i) as q; destruct q; [symmetry in Heqq | trivial].
     specialize (make_tycontext_s_app1 G1 G2 i). rewrite Heqq; simpl. intros X; rewrite X; clear X.
     exists f; split. trivial. apply seplog.funspec_sub_si_refl.
   Qed.
   
   Lemma subsumespec_app2 G1 G2 i: list_norepet (map fst (G1++G2)) ->
-    subsumespec ((make_tycontext_s G2) ! i) ((make_tycontext_s (G1++G2)) ! i).
+    subsumespec ((make_tycontext_s G2) !! i) ((make_tycontext_s (G1++G2)) !! i).
   Proof.
-    intros; red. remember ((make_tycontext_s G2) ! i) as q; destruct q; [symmetry in Heqq | trivial].
+    intros; red. remember ((make_tycontext_s G2) !! i) as q; destruct q; [symmetry in Heqq | trivial].
     specialize (make_tycontext_s_app2 G1 G2 i H). rewrite Heqq; simpl. intros X; rewrite X; clear X.
     exists f; split. trivial. apply seplog.funspec_sub_si_refl.
   Qed.
@@ -435,19 +453,20 @@ Qed.
   
 Lemma subsume_spec_get:
   forall (s t: PTree.t funspec),
-   Forall (fun x => subsumespec (Some (snd x)) (t ! (fst x))) (PTree.elements s) ->
-   (forall i, subsumespec (s ! i) (t ! i)).
+   Forall (fun x => subsumespec (Some (snd x)) (t !! (fst x))) (PTree.elements s) ->
+   (forall i, subsumespec (s !! i) (t !! i)).
 Proof.
 intros.
-destruct (s ! i) eqn:?H; [ | apply I].
+destruct (s !! i) eqn:?H; [ | apply I].
 pose proof (PTree.elements_correct s i H0).
 rewrite Forall_forall in H.
 apply H in H1.
 auto.
 Qed.
+End FORWARD.
 
 Ltac apply_semax_body L := 
-eapply (@semax_body_subsumption' _ _ _ _ _ _ _ _ L);
+eapply (semax_body_subsumption' _ _ _ _ _ _ _ _ L);
   [ first [ apply cspecs_sub_refl
           | split3; red; apply @sub_option_get; 
             repeat (apply Forall_cons; [reflexivity | ]);  apply Forall_nil ]
@@ -501,8 +520,9 @@ Ltac semax_func_cons L :=
  repeat (eapply semax_func_cons_ext_vacuous; [reflexivity | reflexivity | LookupID | LookupB |]);
  try apply semax_func_nil.
 
+
 (* This is a better way of finding an element in a long list. *)
-Lemma from_elements_In : forall {A} l i (v : A), (pTree_from_elements l) ! i = Some v ->
+Lemma from_elements_In : forall {A} l i (v : A), (pTree_from_elements l) !! i = Some v ->
   In (i, v) l.
 Proof.
   induction l; simpl; intros.
@@ -513,19 +533,19 @@ Proof.
 Qed.
 
 Lemma typecheck_return_value:
-  forall (f: val -> Prop)  t (v: val) (gx: genviron) (ret: option val) P R,
+  forall `{HH: heapGS Σ} (f: val -> Prop)  t (v: val) (gx: genviron) (ret: option val) P R,
  f v -> 
  (PROPx P
  (LOCALx (temp ret_temp v::nil)
- (SEPx R))) (make_ext_rval gx t ret) |-- !! f (force_val ret).
+ (SEPx R))) (make_ext_rval gx t ret) ⊢ ⌜f (force_val ret)⌝.
 Proof.
 intros.
  rewrite <- insert_local.
- rewrite lower_andp.
- apply derives_extract_prop; intro.
+ rewrite monPred_at_and.
+ apply bi.pure_elim_l; intro.
  hnf in H0. unfold_lift in H0.
  destruct H0.
-apply prop_right.
+apply bi.pure_intro.
 unfold make_ext_rval in H0.
 destruct (xtype_eq t Xvoid).
 subst t.
@@ -549,8 +569,6 @@ Ltac semax_func_cons_ext :=
           | reflexivity ]]]
       || fail "Try 'eapply semax_func_cons_ext.'"
               "To solve [semax_external] judgments, do 'eapply semax_ext.'"
-              "Make sure that the Espec declared using 'Existing Instance'
-               is defined as 'add_funspecs NullExtension.Espec Gprog.'"
     |
     ].
 
@@ -559,7 +577,7 @@ Tactic Notation "forward_seq" :=
          | eapply semax_post_flipped' ].
 
 Tactic Notation "forward_seq" constr(R) :=
-match goal with P := @abbreviate ret_assert _ |- semax _ _ _ ?P' =>
+match goal with P := @abbreviate ret_assert _ |- semax _ _ _ _ ?P' =>
   constr_eq P P'; unfold abbreviate in P; subst P;
   first [apply semax_seq with R; abbreviate_semax
           | apply (semax_post_flipped' R); [abbreviate_semax | ]]
@@ -568,9 +586,9 @@ end.
 (* end of "stuff to move elsewhere" *)
 
 Lemma local_True_right:
- forall (P: environ -> mpred),
-   P |-- local (`True).
-Proof. intros. intro rho; apply TT_right.
+ forall `{!VSTGS OK_ty Σ} (P: environ -> mpred),
+   assert_of P ⊢ local (`(True:Prop)).
+Proof. intros. raise_rho; apply TT_right.
 Qed.
 
 Lemma force_val_sem_cast_neutral_isptr:
@@ -583,63 +601,59 @@ intros.
 Qed.
 
 Lemma prop_Forall_cons:
- forall {B}{A} {NB: NatDed B} (P: B) F (a:A) b,
-  (P |-- !! F a && !! Forall F b) ->
-  P |-- !! Forall F (a::b).
+ forall {B:bi} {A} (P: B) F (a:A) b,
+  (P ⊢ ⌜F a⌝ ∧ ⌜Forall F b⌝) ->
+  P ⊢ ⌜Forall F (a::b)⌝.
 Proof.
-intros. eapply derives_trans; [apply H |].
-normalize.
+intros. rewrite H. normalize; auto.
 Qed.
 
 Lemma prop_Forall_cons':
- forall {B}{A} {NB: NatDed B} (P: B) P1 F (a:A) b,
-  (P |-- !! (P1 /\ F a) && !! Forall F b) ->
-  P |-- !! P1 && !! Forall F (a::b).
+ forall {B:bi} {A} (P: B) P1 F (a:A) b,
+  (P ⊢ ⌜P1 ∧ F a⌝ ∧ ⌜Forall F b⌝) ->
+  P ⊢ ⌜P1⌝ ∧ ⌜Forall F (a::b)⌝.
 Proof.
-intros. eapply derives_trans; [apply H |].
-normalize.
+intros. rewrite H. normalize; auto.
 Qed.
 
 Lemma prop_Forall_nil:
- forall {B}{A} {NB: NatDed B} (P: B)  (F: A -> Prop),
-  P |-- !! Forall F nil.
+ forall {B:bi} {A} (P: B)  (F: A -> Prop),
+  P ⊢ ⌜ Forall F nil⌝.
 Proof.
-intros. apply prop_right; constructor.
+intros. apply bi.pure_intro; constructor.
 Qed.
 
 Lemma prop_Forall_nil':
- forall {B}{A} {NB: NatDed B} (P: B)  P1 (F: A -> Prop),
-  (P |-- !! P1)->
-  P |-- !! P1 && !! Forall F nil.
+ forall {B:bi} {A} (P: B) P1 (F: A -> Prop),
+  (P ⊢ ⌜P1⌝)->
+  P ⊢ ⌜P1⌝ ∧ ⌜Forall F nil⌝.
 Proof.
-intros. eapply derives_trans; [apply H |].
-normalize.
+intros. rewrite H. normalize; auto.
 Qed.
 
 Lemma prop_Forall_cons1:
- forall {B}{A} {NB: NatDed B} (P: B) (F: A -> Prop) (a:A) b,
+ forall {B:bi} {A} (P: B) (F: A -> Prop) (a:A) b,
   F a ->
-  (P |-- !! Forall F b) ->
-  P |-- !! Forall F (a::b).
+  (P ⊢ ⌜Forall F b⌝) ->
+  P ⊢ ⌜Forall F (a::b)⌝.
 Proof.
-intros. eapply derives_trans; [apply H0 |].
-normalize.
+intros. rewrite H0. normalize; auto.
 Qed.
 
 Ltac check_vl_eq_args:=
 first [ 
    cbv beta; go_lower;
-   repeat (( simple apply derives_extract_prop
-                || simple apply derives_extract_prop');
+   repeat (( simple apply bi.pure_elim_l
+                || simple apply bi.pure_elim_r);
                 fancy_intros true);
    gather_prop;
-   repeat (( simple apply derives_extract_prop
-                || simple apply derives_extract_prop');
+   repeat (( simple apply bi.pure_elim_l
+                || simple apply bi.pure_elim_r);
                 fancy_intros true);
  repeat erewrite unfold_reptype_elim in * by reflexivity;
    try autorewrite with entailer_rewrite in *;
    simpl; auto;
- apply prop_right;
+ apply bi.pure_intro;
  match goal with
  | |- ?A = ?B =>
     unify (Datatypes.length A) (Datatypes.length B)
@@ -661,21 +675,30 @@ first [
  end
   | idtac (*alternative: fail 99 "Fail in tactic check_vl_eq_args"*)] .
 
+Lemma exp_uncurry: forall {T:bi} A B (F : A -> B -> T),
+  (∃ a : A, ∃ b : B, F a b) ⊣⊢ ∃ ab : A * B, F (fst ab) (snd ab).
+Proof.
+  intros.
+  apply bi.equiv_entails; split.
+  - iIntros "(% & % & H)"; iExists (_, _); done.
+  - iIntros "(%ab & H)"; destruct ab; eauto.
+Qed.
+
 Lemma exp_uncurry2:
-  forall {T} {ND: NatDed T} A B C F,
-    @exp T ND A (fun a => @exp T ND B (fun b => @exp T ND C
+  forall {T:bi} A B C F,
+    @bi_exist T A (fun a => @bi_exist T B (fun b => @bi_exist T C
            (fun c => F a b c)))
-   = @exp T ND (A*B*C) (fun x => F (fst (fst x)) (snd (fst x)) (snd x)).
+   ⊣⊢ @bi_exist T (A*B*C:Type) (fun x => F (fst (fst x)) (snd (fst x)) (snd x)).
 Proof.
 intros.
 repeat rewrite exp_uncurry; auto.
 Qed.
 
 Lemma exp_uncurry3:
-  forall {T} {ND: NatDed T} A B C D F,
-    @exp T ND A (fun a => @exp T ND B (fun b => @exp T ND C
-           (fun c => @exp T ND D (fun d => F a b c d))))
-   = @exp T ND (A*B*C*D)
+  forall {T:bi} A B C D F,
+    @bi_exist T A (fun a => @bi_exist T B (fun b => @bi_exist T C
+           (fun c => @bi_exist T D (fun d => F a b c d))))
+   ⊣⊢ @bi_exist T (A*B*C*D:Type)
         (fun x => F (fst (fst (fst x))) (snd (fst (fst x))) (snd (fst x)) (snd x)).
 Proof.
 intros.
@@ -685,11 +708,11 @@ Qed.
 Ltac  unify_postcondition_exps :=
 first [ reflexivity
   | rewrite exp_uncurry;
-     apply exp_congr; intros [? ?]; reflexivity
+     apply exists_pred_ext; intros [? ?]; reflexivity
   | rewrite exp_uncurry2;
-     apply exp_congr; intros [[? ?] ?]; reflexivity
+     apply exists_pred_ext; intros [[? ?] ?]; reflexivity
   | rewrite exp_uncurry3;
-     apply exp_congr; intros [[[? ?] ?] ?]; reflexivity
+     apply exists_pred_ext; intros [[[? ?] ?] ?]; reflexivity
   ].
 
 Ltac prove_cs_preserve_type := 
@@ -713,8 +736,8 @@ a "versus" b ")"
  else fail
 end.
 
-Lemma change_compspecs_cstring: forall cs1 cs2: compspecs, 
-    @cstring cs1 = @cstring cs2.
+Lemma change_compspecs_cstring: forall `{VSTGS0 : VSTGS OK_ty Σ} (cs1 cs2: compspecs),
+    cstring(CS := cs1) = cstring(CS := cs2).
 Proof.
 intros.
 extensionality sh s p.
@@ -739,16 +762,16 @@ apply prop_ext; split; intro;
  inv H; econstructor; eauto).
 Qed.
 
-Ltac change_compspecs_warning A cs cs' := 
+Ltac change_compspecs_warning A cs cs' :=
      idtac "Remark: change_compspecs on user-defined mpred:" A cs cs'
  "(to disable this message, Ltac change_compspecs_warning A cs cs' ::= idtac".
 
 Ltac change_compspecs' cs cs' :=
   lazymatch goal with
-  | |- context [@data_at cs' ?sh ?t ?v1] => erewrite (@data_at_change_composite cs' cs _ sh t); [| apply JMeq_refl | prove_cs_preserve_type]
-  | |- context [@field_at cs' ?sh ?t ?gfs ?v1] => erewrite (@field_at_change_composite cs' cs _ sh t gfs); [| apply JMeq_refl | prove_cs_preserve_type]
-  | |- context [@data_at_ cs' ?sh ?t] => erewrite (@data_at__change_composite cs' cs _ sh t); [| prove_cs_preserve_type]
-  | |- context [@field_at_ cs' ?sh ?t ?gfs] => erewrite (@field_at__change_composite cs' cs _ sh t gfs); [| prove_cs_preserve_type]
+  | |- context [data_at(cs := cs') ?sh ?t ?v1] => erewrite (data_at_change_composite(cs_from := cs')(cs_to := cs)(CCE := _) sh t); [| apply JMeq_refl | prove_cs_preserve_type]
+  | |- context [field_at(cs := cs') ?sh ?t ?gfs ?v1] => erewrite (field_at_change_composite(cs_from := cs')(cs_to := cs)(CCE := _) sh t gfs); [| apply JMeq_refl | prove_cs_preserve_type]
+  | |- context [data_at_(cs := cs') ?sh ?t] => erewrite (data_at__change_composite(cs_from := cs')(cs_to := cs)(CCE := _) sh t); [| prove_cs_preserve_type]
+  | |- context [field_at_(cs := cs') ?sh ?t ?gfs] => erewrite (field_at__change_composite(cs_from := cs')(cs_to := cs)(CCE := _) sh t gfs); [| prove_cs_preserve_type]
   | |- _ => 
     match goal with 
   | |- context [?A cs'] => 
@@ -863,7 +886,7 @@ Ltac lookup_spec id :=
    | |- ?fs = _ => check_canonical_funspec (id,fs);
       first [reflexivity |
       match goal with
-       | |- mk_funspec _ _ ?t1 _ _ = mk_funspec _ _ ?t2 _ _ =>
+       | |- mk_funspec _ _ _ ?t1 _ _ = mk_funspec _ _ _ ?t2 _ _ =>
          first [unify t1 t2
            | exfalso; error (Witness_type_of_forward_call_does_not_match_witness_type_of_funspec
       t2 t1)]
@@ -877,32 +900,26 @@ Ltac goal_has_evars :=
  match goal with |- ?A => has_evar A end.
 
 Lemma drop_SEP_tc:
- forall Delta P Q R' RF R S,
-   (forall rho, predicates_hered.boxy predicates_sl.extendM (S rho)) ->
-   fold_right_sepcon R = sepcon (fold_right_sepcon R') (fold_right_sepcon RF) ->
-   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R')) |-- S ->
-   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- S.
+ forall `{!VSTGS OK_ty Σ} Delta P Q R' RF R (S : assert), Absorbing S ->
+   fold_right_sepcon R ⊣⊢ (fold_right_sepcon R') ∗ (fold_right_sepcon RF) ->
+   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R')) ⊢ S ->
+   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢ S.
 Proof.
   intros.
-  unfold PROPx, LOCALx, SEPx in H1 |- *.
-  intro rho; specialize (H1 rho).
-  simpl in H1 |- *.
-  unfold local, lift1; simpl.
-  rewrite H0.
-  rewrite <- !sepcon_andp_prop'.
-  specialize (H rho).
-  eapply derives_trans; [apply sepcon_derives; [exact H1 | apply derives_refl] |].
-  constructor; apply predicates_sl.extend_sepcon; auto.
+  iIntros "(? & ? & ? & H)".
+  rewrite /SEPx H0.
+  iDestruct "H" as "(H & _)".
+  iApply H1; repeat iSplit; auto.
 Qed.
 
 Ltac delete_FRZR_from_SEP :=
 match goal with
-| |- ENTAIL _, PROPx _ (LOCALx _ (SEPx ?R)) |-- _ =>
+| |- ENTAIL _, PROPx _ (LOCALx _ (SEPx ?R)) ⊢ _ =>
   match R with context [FRZR] =>
   eapply drop_SEP_tc;
-    [ first [apply extend_tc.extend_tc_expr
-             | apply extend_tc.extend_tc_exprlist
-             | apply extend_tc.extend_tc_lvalue]
+    [ first [apply extend_tc.tc_expr_absorbing
+             | apply extend_tc.tc_exprlist_absorbing
+             | apply extend_tc.tc_lvalue_absorbing]
    | apply split_FRZ_in_SEP_spec; prove_split_FRZ_in_SEP
    | ]
 end end.
@@ -926,20 +943,28 @@ end.
 Ltac cancel_for_forward_call := cancel_for_evar_frame.
 Ltac default_cancel_for_forward_call := cancel_for_evar_frame.
 
-Ltac unfold_post := match goal with |- ?Post = _ => let A := fresh "A" in let B := fresh "B" in first
-  [evar (A : Type); evar (B : A -> environ -> mpred); unify Post (@exp _ _ ?A ?B);
-     change Post with (@exp _ _ A B); subst A B |
-   evar (A : list Prop); evar (B : environ -> mpred); unify Post (PROPx ?A ?B);
+Ltac unfold_post := match goal with |- ?Post ⊣⊢ _ => let A := fresh "A" in let B := fresh "B" in
+  let T := type of Post in first
+  [evar (A : Type); evar (B : A -> T); unify Post (@bi_exist _ ?A ?B);
+     change Post with (@bi_exist _ A B); subst A B |
+   evar (A : list Prop); evar (B : T); unify Post (PROPx ?A ?B);
      change Post with (PROPx A B); subst A B | idtac] end.
 
 
 Lemma PROP_LOCAL_SEP_ext :
-  forall P P' Q Q' R R', P=P' -> Q=Q' -> R=R' -> 
+  forall `{heapGS Σ} P P' Q Q' R R', P=P' -> Q=Q' -> R=R' -> 
      PROPx P (LOCALx Q (SEPx R)) = PROPx P' (LOCALx Q' (SEPx R')).
 Proof.
 intros; subst; auto.
 Qed.
 
+Lemma PROP_LOCAL_SEP_ext' :
+  forall `{heapGS Σ} P P' Q Q' R R', P=P' -> Q=Q' -> R=R' -> 
+     PROPx P (LOCALx Q (SEPx R)) ⊣⊢ PROPx P' (LOCALx Q' (SEPx R')).
+Proof.
+intros; subst; auto.
+Qed.
+
 Ltac fix_up_simplified_postcondition_warning :=
   idtac "Warning: Fixed up a postcondition that was damaged; typically this has happened because you did 'simpl in *' that messed up Delta_specs.  Avoid 'simpl in *'.".
 
@@ -951,8 +976,8 @@ Ltac fix_up_simplified_postcondition :=
   (* If the user's postcondition (e.g., fetched from Delta_specs) has been
     messed up by 'simpl in *', try to patch it. *)
   lazymatch goal with
-  | |- (fun a => exp (fun x:?T => ?P a)) = ?Q => 
-            (change (exp (fun x:T => P) = Q) || fix_up_simplified_postcondition_warning)
+  | |- (fun a => bi_exist (fun x:?T => ?P a)) = ?Q => 
+            (change (bi_exist (fun x:T => P) = Q) || fix_up_simplified_postcondition_warning)
             || fix_up_simplified_postcondition_failure
   | |- (fun a => ?P a) = ?Q => 
            (change (P=Q); fix_up_simplified_postcondition_warning)
@@ -962,23 +987,24 @@ Ltac fix_up_simplified_postcondition :=
 
 Ltac match_postcondition := 
 fix_up_simplified_postcondition;
-cbv beta iota zeta; unfold_post;  extensionality rho; 
+cbv beta iota zeta; unfold_post;
+constructor; let rho := fresh "rho" in intro rho; cbn [monPred_at assert_of ofe_mor_car];
    repeat rewrite exp_uncurry;
-   try rewrite no_post_exists; repeat rewrite exp_unfold;
-tryif apply exp_congr
+   try rewrite no_post_exists; repeat rewrite monPred_at_exist;
+tryif apply bi.exist_proper
  then (intros ?vret;
-          apply equal_f; 
-          apply PROP_LOCAL_SEP_ext; [reflexivity | | reflexivity];
+          generalize rho; rewrite -local_assert; apply PROP_LOCAL_SEP_ext';
+          [reflexivity | | reflexivity];
           (reflexivity || fail "The funspec of the function has a POSTcondition
 that is ill-formed.  The LOCALS part of the postcondition
 should be (temp ret_temp ...), but it is not"))
  else fail "The funspec of the function should have a POSTcondition that starts
-with an existential, that is,  EX _:_, PROP...LOCAL...SEP".
+with an existential, that is,  ∃ _:_, PROP...LOCAL...SEP".
 
 Ltac prove_PROP_preconditions :=
   unfold fold_right_and; repeat rewrite and_True; my_auto.
 
-Ltac  forward_call_id1_wow_nil := 
+(*Ltac  forward_call_id1_wow_nil := 
 let H := fresh in intro H;
 eapply (semax_call_id1_wow_nil H); 
  clear H; 
@@ -989,9 +1015,9 @@ eapply (semax_call_id1_wow_nil H);
  | prove_delete_temp
  | unify_postcondition_exps
  | prove_PROP_preconditions
- ].
+ ].*)
 
-Ltac  forward_call_id1_wow := 
+Ltac  forward_call_id1_wow :=
 let H := fresh in intro H;
 eapply (semax_call_id1_wow H);
  clear H;
@@ -1004,7 +1030,7 @@ eapply (semax_call_id1_wow H);
  | prove_PROP_preconditions
  ].
 
-Ltac forward_call_id1_x_wow_nil :=
+(*Ltac forward_call_id1_x_wow_nil :=
 let H := fresh in intro H;
 eapply (semax_call_id1_x_wow_nil H); 
  clear H;
@@ -1017,7 +1043,7 @@ eapply (semax_call_id1_x_wow_nil H);
  | prove_delete_temp
  | unify_postcondition_exps
  | prove_PROP_preconditions
- ].
+ ].*)
 
 Ltac forward_call_id1_x_wow :=
 let H := fresh in intro H;
@@ -1034,7 +1060,7 @@ eapply (semax_call_id1_x_wow H);
  | prove_PROP_preconditions
  ].
 
-Ltac forward_call_id1_y_wow_nil :=
+(*Ltac forward_call_id1_y_wow_nil :=
 let H := fresh in intro H;
 eapply (semax_call_id1_y_wow_nil H); 
  clear H;
@@ -1047,7 +1073,7 @@ eapply (semax_call_id1_y_wow_nil H);
  | prove_delete_temp
  | unify_postcondition_exps
  | prove_PROP_preconditions
- ].
+ ].*)
 
 Ltac forward_call_id1_y_wow :=
 let H := fresh in intro H;
@@ -1064,7 +1090,7 @@ eapply (semax_call_id1_y_wow H);
  | prove_PROP_preconditions
  ].
 
-Ltac forward_call_id01_wow_nil :=
+(*Ltac forward_call_id01_wow_nil :=
 let H := fresh in intro H;
 eapply (semax_call_id01_wow_nil H); 
  clear H;
@@ -1073,11 +1099,11 @@ eapply (semax_call_id01_wow_nil H);
  | match_postcondition
  | unify_postcondition_exps
  | prove_PROP_preconditions
- ].
+ ].*)
 
 Ltac forward_call_id01_wow :=
 let H := fresh in intro H;
-eapply (semax_call_id01_wow H); 
+eapply (semax_call_id01_wow H);
  clear H;
  lazymatch goal with Frame := _ : list mpred |- _ => try clear Frame end;
  [ apply Coq.Init.Logic.I 
@@ -1086,7 +1112,7 @@ eapply (semax_call_id01_wow H);
  | prove_PROP_preconditions
  ].
 
-Ltac forward_call_id00_wow_nil  :=
+(*Ltac forward_call_id00_wow_nil  :=
 let H := fresh in intro H;
 eapply (semax_call_id00_wow_nil H); 
  clear H;
@@ -1105,23 +1131,24 @@ that is ill-formed.  The LOCALS part of the postcondition
 should be empty, but it is not")
  | unify_postcondition_exps
  | prove_PROP_preconditions
- ].
+ ].*)
 
 Ltac forward_call_id00_wow  :=
 let H := fresh in intro H;
-eapply (semax_call_id00_wow H); 
+eapply (semax_call_id00_wow H);
  clear H;
  lazymatch goal with Frame := _ : list mpred |- _ => try clear Frame end;
  [ check_result_type 
- | (*match_postcondition*)
-    fix_up_simplified_postcondition;
-    cbv beta iota zeta; unfold_post;
+ | fix_up_simplified_postcondition;
+    cbv beta iota zeta; rewrite ?assert_of_at; unfold_post;
+    constructor; let rho := fresh "rho" in intro rho; cbn [monPred_at assert_of ofe_mor_car];
     repeat rewrite exp_uncurry;
+    repeat rewrite monPred_at_exist;
 
-    first [ apply exp_congr | try rewrite no_post_exists0; apply exp_congr];
+    first [ apply bi.exist_proper | try rewrite no_post_exists0 monPred_at_exist; apply bi.exist_proper];
 
-    intros ?vret;
-    apply PROP_LOCAL_SEP_ext; [reflexivity | | reflexivity];
+    intros ?vret; generalize rho; rewrite -local_assert;
+    apply PROP_LOCAL_SEP_ext'; [reflexivity | | reflexivity];
     (reflexivity || fail "The funspec of the function has a POSTcondition
 that is ill-formed.  The LOCALS part of the postcondition
 should be empty, but it is not")
@@ -1138,7 +1165,7 @@ try match goal with |- context [strong_cast ?t1 ?t2 ?v] =>
 end.
 
 Ltac fwd_skip :=
- match goal with |- semax _ _ Sskip _ =>
+ match goal with |- semax _ _ _ Sskip _ =>
    normalize_postcondition;
    first [eapply semax_pre | eapply semax_pre_simple];
       [ | apply semax_skip]
@@ -1146,24 +1173,24 @@ Ltac fwd_skip :=
 
 Definition BINDER_NAME := tt.
 Ltac find_postcond_binder_names :=
-  match goal with |- semax ?Delta _ ?c _ =>
+  match goal with |- semax _ ?Delta _ ?c _ =>
      match c with context [Scall _ (Evar ?id _) _] =>
-     let x := constr:((glob_specs Delta) ! id) in
+     let x := constr:((glob_specs Delta) !! id) in
      let x' := eval hnf in x in
      match x' with
-     | Some (mk_funspec _ _ _ _ (fun _ => exp (fun y1 => exp (fun y2 => exp (fun y3 => exp (fun y4 => _)))))) =>
+     | Some (mk_funspec _ _ _ _ _ (fun _ => bi_exist (fun y1 => bi_exist (fun y2 => bi_exist (fun y3 => bi_exist (fun y4 => _)))))) =>
          let y4' := fresh y4 in  pose (y4' := BINDER_NAME);
          let y3' := fresh y3 in  pose (y3' := BINDER_NAME);
          let y2' := fresh y2 in  pose (y2' := BINDER_NAME);
          let y1' := fresh y1 in  pose (y1' := BINDER_NAME)
-     | Some (mk_funspec _ _ _ _ (fun _ => exp (fun y1 => exp (fun y2 => exp (fun y3 => _))))) =>
+     | Some (mk_funspec _ _ _ _ _ (fun _ => bi_exist (fun y1 => bi_exist (fun y2 => bi_exist (fun y3 => _))))) =>
          let y3' := fresh y3 in  pose (y3' := BINDER_NAME);
          let y2' := fresh y2 in  pose (y2' := BINDER_NAME);
          let y1' := fresh y1 in  pose (y1' := BINDER_NAME)
-     | Some (mk_funspec _ _ _ _ (fun _ => exp (fun y1 => exp (fun y2 => _)))) =>
+     | Some (mk_funspec _ _ _ _ _ (fun _ => bi_exist (fun y1 => bi_exist (fun y2 => _)))) =>
          let y2' := fresh y2 in  pose (y2' := BINDER_NAME);
          let y1' := fresh y1 in  pose (y1' := BINDER_NAME)
-     | Some (mk_funspec _ _ _ _ (fun _ => exp (fun y1 => _))) =>
+     | Some (mk_funspec _ _ _ _ _ (fun _ => bi_exist (fun y1 => _))) =>
          let y1' := fresh y1 in  pose (y1' := BINDER_NAME)
      | _ => idtac
      end
@@ -1215,27 +1242,27 @@ Ltac after_forward_call :=
      end;
     try (apply extract_exists_pre; intros _); 
     match goal with
-        | |- semax _ _ _ _ => idtac
-        | |- unit -> semax _ _ _ _ => intros _
+        | |- semax _ _ _ _ _ => idtac
+        | |- unit -> semax _ _ _ _ _ => intros _
     end;
     match goal with
-        | |- @semax ?CS ?Espec ?Delta (exp ?F) ?c ?Post =>
+        | |- @semax _ _ _ _ ?CS _ ?Delta (bi_exist ?F) ?c ?Post =>
                lazymatch F with context [@app mpred _ ?x] =>
                   let hide := fresh "hide" in set (hide := x);
                   try change_compspecs CS;
                   subst hide
                end;
                unfold_app
-        | |- @semax ?CS ?Espec ?Delta (PROPx (?P1 ++ ?P2) (LOCALx ?Q (SEPx (?A ++ ?B)))) ?c ?Post =>
+        | |- @semax ?W ?X ?Y ?Z ?CS ?E ?Delta (PROPx (?P1 ++ ?P2) (LOCALx ?Q (SEPx (?A ++ ?B)))) ?c ?Post =>
                let hide := fresh "hide" in
-               pose (hide x := @semax CS Espec Delta (PROPx (P1 ++ P2) 
+               pose (hide x := @semax W X Y Z CS E Delta (PROPx (P1 ++ P2) 
                                      (LOCALx Q (SEPx (x ++ B)))) c Post);
                change (hide A);
                try change_compspecs CS;
                subst hide; 
                cbv beta;
                unfold_app
-        | |- @semax ?CS _ _ _ _ _ => 
+        | |- @semax _ _ _ _ ?CS _ _ _ _ _ => 
                afc_error1;
                unfold_app;
                try change_compspecs CS
@@ -1255,27 +1282,13 @@ Ltac clear_MORE_POST :=
 
 Inductive Ridiculous: Type := .
 
-Ltac check_witness_type ts A witness :=
-  (unify A (rmaps.ConstType Ridiculous); (* because [is_evar A] doesn't seem to work *)
+Ltac check_witness_type (*ts*) Σ A witness :=
+  (unify A (ConstType Ridiculous); (* because [is_evar A] doesn't seem to work *)
              exfalso)
  ||
- let TA := constr:(functors.MixVariantFunctor._functor
-     (rmaps.dependent_type_functor_rec ts A) mpred) in
-  let TA' := eval cbv 
-     [functors.MixVariantFunctor._functor
-      functors.MixVariantFunctorGenerator.fpair
-      functors.MixVariantFunctorGenerator.fconst
-      functors.MixVariantFunctorGenerator.fidentity
-      rmaps.dependent_type_functor_rec
-      functors.GeneralFunctorGenerator.CovariantBiFunctor_MixVariantFunctor_compose
-      functors.CovariantFunctorGenerator.fconst
-      functors.CovariantFunctorGenerator.fidentity
-      functors.CovariantBiFunctor._functor
-      functors.CovariantBiFunctorGenerator.Fpair
-      functors.GeneralFunctorGenerator.CovariantFunctor_MixVariantFunctor
-      functors.CovariantFunctor._functor
-      functors.MixVariantFunctor.fmap
-      ] in TA
+ let TA := constr:(ofe_car (@dtfr Σ A)) in
+  let TA' := eval cbv [dtfr dependent_type_functor_rec constOF idOF prodOF discrete_funOF
+      ofe_morOF sigTOF list.listOF oFunctor_car ofe_car] in TA
  in let TA'' := eval simpl in TA'
   in match type of witness with ?T => 
        unify T TA''
@@ -1300,7 +1313,7 @@ Qed.
 
 Lemma classify_fun_ty_hack:
  (* This is needed for the varargs (printf) hack *)
-  forall fs fs',
+  forall `{!VSTGS OK_ty Σ} fs fs',
   funspec_sub fs fs' ->
   forall ty typs retty cc,
   ty = type_of_funspec fs ->
@@ -1309,8 +1322,8 @@ Lemma classify_fun_ty_hack:
 Proof.
 intros.
 subst.
-destruct fs, fs'. 
-destruct H as [[? ?] _].
+destruct fs, fs'.
+destruct H as [(? & ?) _].
 subst.
 simpl in H1.
 inv H1.
@@ -1325,7 +1338,7 @@ Ltac check_type_of_funspec id :=
   end.
 
 Ltac check_subsumes subsumes :=
- apply subsumes ||
+ apply subsumes; done ||
  lazymatch goal with |- ?g =>
  lazymatch type of subsumes with ?t =>
   fail 100 "Function-call subsumption fails.  The term" subsumes "of type" t
@@ -1335,13 +1348,13 @@ Ltac check_subsumes subsumes :=
 (*This has two cases; it priorizitizes func_ptr lookup over Delta-lookup*)
 Ltac prove_call_setup1 subsumes :=
   match goal with
-  | |- @semax _ _ _ (@exp _ _ _ _) _ _ =>
-    fail 1 "forward_call fails because your precondition starts with EX.
+  | |- semax _ _ (@bi_exist _ _ _) _ _ =>
+    fail 1 "forward_call fails because your precondition starts with ∃.
 Use Intros  to move          the existentially bound variables above the line"
-  | |- @semax ?CS _ ?Delta (PROPx ?P (LOCALx ?Q (SEPx ?R'))) ?c _ =>
+  | |- semax ?E ?Delta (PROPx ?P (LOCALx ?Q (SEPx ?R'))) ?c _ =>
     match c with
     | context [Scall _ ?a ?bl] =>
-      exploit (call_setup1_i CS Delta P Q R' a bl);
+      exploit (call_setup1_i E Delta P Q R' a bl);
       [check_prove_local2ptree
       |reflexivity
       |prove_func_ptr
@@ -1352,7 +1365,7 @@ Use Intros  to move          the existentially bound variables above the line"
       |check_cast_params
       | ]
     | context [Scall _ (Evar ?id ?ty) ?bl] =>
-      exploit (call_setup1_i2 CS Delta P Q R' id ty bl) ;
+      exploit (call_setup1_i2 E Delta P Q R' id ty bl) ;
       [check_prove_local2ptree
       | apply can_assume_funcptr2;
         [ check_function_name
@@ -1361,7 +1374,7 @@ Use Intros  to move          the existentially bound variables above the line"
         | check_type_of_funspec id
         ]
       |check_subsumes subsumes
-      | try reflexivity; (eapply classify_fun_ty_hack; [apply subsumes| reflexivity ..])  (* function-id type in AST matches type in funspec *)
+      | try reflexivity; (eapply classify_fun_ty_hack; [apply subsumes; done | reflexivity ..])  (* function-id type in AST matches type in funspec *)
       |check_typecheck
       |check_typecheck
       |check_cast_params
@@ -1386,21 +1399,21 @@ Ltac check_gvars_spec :=
    fail "Function precondition requires (gvars" gv ") in LOCAL clause"
   end.
 
-Ltac prove_call_setup_aux  ts witness :=
+Ltac prove_call_setup_aux  (*ts*) witness :=
  let H := fresh "SetupOne" in
  intro H;
- match goal with | |- @semax ?CS _ _ (PROPx ?P (LOCALx ?L (SEPx ?R'))) _ _ =>
+ match goal with | |- @semax _ _ _ _ ?CS _ _ (PROPx ?P (LOCALx ?L (SEPx ?R'))) _ _ =>
  let Frame := fresh "Frame" in evar (Frame: list mpred); 
  let cR := (fun R =>
- exploit (call_setup2_i _ _ _ _ _ _ _ _ R R' _ _ _ _ ts _ _ _ _ _ _ _ H witness Frame); clear H;
- simpl functors.MixVariantFunctor._functor;
- [ try_convertPreElim
+ exploit (call_setup2_i _ _ _ _ _ _ _ _ R R' _ _ _ _ (*ts*) _ _ _ _ _ _ H witness Frame); clear H;
+ [ set_solver
+ | try_convertPreElim
  | check_prove_local2ptree
  | check_vl_eq_args
  | auto 50 with derives
  | check_gvars_spec
  | let lhs := fresh "lhs" in 
-   match goal with |- ?A |-- ?B => pose (lhs := A); change (lhs |-- B) end;
+   match goal with |- ?A ⊢ ?B => pose (lhs := A); change (lhs ⊢ B) end;
    try change_compspecs CS; subst lhs;
    cancel_for_forward_call
  |
@@ -1408,73 +1421,73 @@ Ltac prove_call_setup_aux  ts witness :=
   in strip1_later R' cR
  end.
 
-Ltac prove_call_setup ts subsumes witness :=
+Ltac prove_call_setup (*ts*) subsumes witness :=
  prove_call_setup1 subsumes;
  [ .. | 
- match goal with |- call_setup1  _ _ _ _ _ _ _ _ _ _ _ _ _ ?A _ _ _ _ _ _  -> _ =>
-      check_witness_type ts A witness
+ match goal with |- @call_setup1 _ ?Σ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ?A _ _ _ _ _  -> _ =>
+      check_witness_type (*ts*) Σ A witness
  end;
- prove_call_setup_aux ts witness].
+ prove_call_setup_aux (*ts*) witness].
 
-Ltac fwd_call' ts subsumes witness :=
+Ltac fwd_call' (*ts*) subsumes witness :=
 check_POSTCONDITION;
 lazymatch goal with
-| |- semax _ _ (Ssequence (Scall ?ret _ _) _) _ =>
+| |- semax _ _ _ (Ssequence (Scall ?ret _ _) _) _ =>
   eapply semax_seq';
-    [prove_call_setup ts subsumes witness;
+    [prove_call_setup (*ts*) subsumes witness;
      clear_Delta_specs; clear_MORE_POST;
      [ .. |
       lazymatch goal with
-      | |- _ -> semax _ _ (Scall (Some _) _ _) _ =>
+      | |- _ -> semax _ _ _ (Scall (Some _) _ _) _ =>
          forward_call_id1_wow
-      | |- call_setup2 _ _ _ _ _ _ _ _ _ _ _ _ ?retty _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ -> 
-                semax _ _ (Scall None _ _) _ =>
+      | |- call_setup2 _ _ _ _ _ _ _ _ _ _ _ _ ?retty _ _ _ _ _ _ _ _ _ _ _ _ _ _ -> 
+                semax _ _ _ (Scall None _ _) _ =>
         tryif (unify retty Tvoid)
         then forward_call_id00_wow
         else forward_call_id01_wow
      end]
    | after_forward_call ]
-| |- semax _ _ (Ssequence (Ssequence (Scall (Some ?ret') _ _)
+| |- semax _ _ _ (Ssequence (Ssequence (Scall (Some ?ret') _ _)
                                        (Sset _ (Ecast (Etempvar ?ret'2 _) _))) _) _ =>
        unify ret' ret'2;
        eapply semax_seq';
-         [prove_call_setup ts subsumes witness;
+         [prove_call_setup (*ts*) subsumes witness;
           clear_Delta_specs; clear_MORE_POST;
              [ .. | forward_call_id1_x_wow ]
          |  after_forward_call ]
-| |- semax _ _ (Ssequence (Ssequence (Scall (Some ?ret') _ _)
+| |- semax _ _ _ (Ssequence (Ssequence (Scall (Some ?ret') _ _)
                                        (Sset _ (Etempvar ?ret'2 _))) _) _ =>
        unify ret' ret'2;
        eapply semax_seq';
-         [prove_call_setup ts subsumes witness;
+         [prove_call_setup (*ts*) subsumes witness;
           clear_Delta_specs; clear_MORE_POST;
              [ .. | forward_call_id1_y_wow ]
          |  after_forward_call ]
-| |- _ => rewrite <- seq_assoc; fwd_call' ts subsumes witness
+| |- _ => rewrite <- seq_assoc; fwd_call' (*ts*) subsumes witness
 end.
 
-Ltac fwd_call_dep ts subsumes witness :=
+Ltac fwd_call_dep (*ts*) subsumes witness :=
  try lazymatch goal with
-      | |- semax _ _ (Scall _ _ _) _ => rewrite -> semax_seq_skip
+      | |- semax _ _ _ (Scall _ _ _) _ => rewrite -> semax_seq_skip
       end;
  repeat lazymatch goal with
-  | |- semax _ _ (Ssequence (Ssequence (Ssequence _ _) _) _) _ =>
+  | |- semax _ _ _ (Ssequence (Ssequence (Ssequence _ _) _) _) _ =>
       rewrite <- seq_assoc
  end;
-lazymatch goal with |- @semax ?CS _ ?Delta _ (Ssequence ?C _) _ =>
+lazymatch goal with |- semax _ ?Delta _ (Ssequence ?C _) _ =>
   lazymatch C with context [Scall _ _ _] =>
-         fwd_call' ts subsumes witness
+         fwd_call' (*ts*) subsumes witness
     end
 end.
 
-Tactic Notation "forward_call" constr(ts) constr(subsumes) constr(witness) :=
-    fwd_call_dep ts subsumes witness.
+(*Tactic Notation "forward_call" constr(ts) constr(subsumes) constr(witness) :=
+    fwd_call_dep ts subsumes witness.*)
 
 Tactic Notation "forward_call" constr(witness) :=
-    fwd_call_dep (@nil Type) funspec_sub_refl witness.
+    fwd_call_dep (*(@nil Type)*) funspec_sub_refl_dep witness.
 
 Tactic Notation "forward_call" constr(subsumes) constr(witness) := 
-  fwd_call_dep (@nil Type) subsumes witness.
+  fwd_call_dep (*(@nil Type)*) subsumes witness.
 
 Ltac tuple_evar2 name T cb evar_tac :=
   lazymatch T with
@@ -1485,54 +1498,41 @@ Ltac tuple_evar2 name T cb evar_tac :=
   | _ => my_unshelve_evar name T cb evar_tac
   end; idtac.
 
-Ltac get_function_witness_type func :=
- let TA := constr:(functors.MixVariantFunctor._functor
-     (rmaps.dependent_type_functor_rec nil func) mpred) in
-  let TA' := eval cbv 
-     [functors.MixVariantFunctor._functor
-      functors.MixVariantFunctorGenerator.fpair
-      functors.MixVariantFunctorGenerator.fconst
-      functors.MixVariantFunctorGenerator.fidentity
-      rmaps.dependent_type_functor_rec
-      functors.GeneralFunctorGenerator.CovariantBiFunctor_MixVariantFunctor_compose
-      functors.CovariantFunctorGenerator.fconst
-      functors.CovariantFunctorGenerator.fidentity
-      functors.CovariantBiFunctor._functor
-      functors.CovariantBiFunctorGenerator.Fpair
-      functors.GeneralFunctorGenerator.CovariantFunctor_MixVariantFunctor
-      functors.CovariantFunctor._functor
-      functors.MixVariantFunctor.fmap
-      ] in TA
+Ltac get_function_witness_type Σ func :=
+ let TA := constr:(ofe_car (@dtfr Σ func)) in
+  let TA' := eval cbv
+     [dtfr dependent_type_functor_rec constOF idOF prodOF discrete_funOF
+      ofe_morOF sigTOF list.listOF oFunctor_car ofe_car] in TA
  in let TA'' := eval simpl in TA'
  in TA''.
 
 Ltac new_prove_call_setup :=
- prove_call_setup1 funspec_sub_refl;
+ prove_call_setup1 funspec_sub_refl_dep;
  [ .. | 
- match goal with |- call_setup1 _ _ _ _ _ _ _ _ _ _ _ _ _ ?A _ _ _ _ _ _ -> _ =>
-      let x := fresh "x" in tuple_evar2 x ltac:(get_function_witness_type A)
-      ltac:(prove_call_setup_aux (@nil Type))
+ match goal with |- @call_setup1 _ ?Σ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ?A _ _ _ _ _ -> _ =>
+      let x := fresh "x" in tuple_evar2 x ltac:(get_function_witness_type Σ A)
+      ltac:(prove_call_setup_aux (*(@nil Type)*))
       ltac:(fun _ => try refine tt; fail "Failed to infer some parts of witness")
  end].
 
 Ltac new_fwd_call' :=
 lazymatch goal with
-| |- semax _ _ (Ssequence (Scall _ _ _) _) _ =>
+| |- semax _ _ _ (Ssequence (Scall _ _ _) _) _ =>
   eapply semax_seq';
     [new_prove_call_setup;
      clear_Delta_specs; clear_MORE_POST;
      [ .. |
       lazymatch goal with
-      | |- _ -> semax _ _ (Scall (Some _) _ _) _ =>
+      | |- _ -> semax _ _ _ (Scall (Some _) _ _) _ =>
          forward_call_id1_wow
-      | |- call_setup2 _ _ _ _ _ _ _ _ _ _ _ _ ?retty _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ->
-                semax _ _ (Scall None _ _) _ =>
+      | |- call_setup2 _ _ _ _ _ _ _ _ _ _ _ _ ?retty _ _ _ _ _ _ _ _ _ _ _ _ _ _ ->
+                semax _ _ _ (Scall None _ _) _ =>
         tryif (unify retty Tvoid)
         then forward_call_id00_wow
         else forward_call_id01_wow
      end]
    | after_forward_call ]
-| |- semax _ _ (Ssequence (Ssequence (Scall (Some ?ret') _ _)
+| |- semax _ _ _ (Ssequence (Ssequence (Scall (Some ?ret') _ _)
                                        (Sset _ (Ecast (Etempvar ?ret'2 _) _))) _) _ =>
        unify ret' ret'2;
        eapply semax_seq';
@@ -1540,7 +1540,7 @@ lazymatch goal with
           clear_Delta_specs; clear_MORE_POST;
              [ .. | forward_call_id1_x_wow ]
          |  after_forward_call ]
-| |- semax _ _ (Ssequence (Ssequence (Scall (Some ?ret') _ _)
+| |- semax _ _ _ (Ssequence (Ssequence (Scall (Some ?ret') _ _)
                                        (Sset _ (Etempvar ?ret'2 _))) _) _ =>
        unify ret' ret'2;
        eapply semax_seq';
@@ -1552,15 +1552,15 @@ lazymatch goal with
 end.
 
 
-Ltac new_fwd_call:=
+Ltac new_fwd_call :=
  try lazymatch goal with
-      | |- semax _ _ (Scall _ _ _) _ => rewrite -> semax_seq_skip
+      | |- semax _ _ _ (Scall _ _ _) _ => rewrite -> semax_seq_skip
       end;
  repeat lazymatch goal with
-  | |- semax _ _ (Ssequence (Ssequence (Ssequence _ _) _) _) _ =>
+  | |- semax _ _ _ (Ssequence (Ssequence (Ssequence _ _) _) _) _ =>
       rewrite <- seq_assoc
  end;
-lazymatch goal with |- @semax ?CS _ ?Delta _ (Ssequence ?C _) _ =>
+lazymatch goal with |- semax _ ?Delta _ (Ssequence ?C _) _ =>
   lazymatch C with context [Scall _ _ _] =>
          new_fwd_call'
     end
@@ -1569,9 +1569,10 @@ end.
 Tactic Notation "forward_call"  := new_fwd_call.
 
 Lemma seq_assoc2:
-  forall (Espec: OracleKind) {cs: compspecs}  Delta P c1 c2 c3 c4 Q,
-  semax Delta P (Ssequence (Ssequence c1 c2) (Ssequence c3 c4)) Q ->
-  semax Delta P (Ssequence (Ssequence (Ssequence c1 c2) c3) c4) Q.
+  forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {cs: compspecs}
+    E Delta P c1 c2 c3 c4 Q,
+  semax E Delta P (Ssequence (Ssequence c1 c2) (Ssequence c3 c4)) Q ->
+  semax E Delta P (Ssequence (Ssequence (Ssequence c1 c2) c3) c4) Q.
 Proof.
 intros.
  rewrite <- seq_assoc. auto.
@@ -1579,57 +1580,58 @@ Qed.
 
 (* solve msubst_eval_expr, msubst_eval_lvalue, msubst_eval_LR *)
 Ltac solve_msubst_eval :=
-    let e := match goal with
-       | |- msubst_eval_expr _ _ _ _ ?a = _ => a
-       | |- msubst_eval_lvalue _ _ _ _ ?a = _ => a
-    end in
-     match goal with
-     | |- ?E = Some _ => let E' := eval hnf in E in change E with E'
-     end;
-     match goal with
-     | |- Some ?E = Some _ => let E' := eval hnf in E in
-       match E' with
-       | (match ?E'' with
-         | Some _ => _
-         | None => Vundef
-         end)
-         => change E with (force_val E'')
-       | (match ?E'' with
-         | Vundef => Vundef
-         | Vint _ => Vundef
-         | Vlong _ => Vundef
-         | Vfloat _ => Vundef
-         | Vsingle _ => Vundef
-         | Vptr _ _ => Vptr _ (Ptrofs.add _ (Ptrofs.repr ?ofs))
-         end)
-         => change E with (offset_val ofs E'')
-       | _ => change E with E'
-       end
-     | |- ?NotSome = Some _ => 
-             fail 1000 "The C-language expression " e
-                 " does not necessarily evaluate, perhaps because some variable is missing from your LOCAL clause"
-
-     end.
+  let e := match goal with
+      | |- msubst_eval_expr _ _ _ _ ?a = _ => a
+      | |- msubst_eval_lvalue _ _ _ _ ?a = _ => a
+  end in
+  (* REVIEW otherwise hnf does not reduce under msubst_eval_expr; is there a deeper reason? *)
+  unfold msubst_eval_expr, msubst_eval_lvalue; 
+  match goal with
+  | |- ?E = Some _ => let E' := eval hnf in E in change E with E'
+  end;
+  match goal with
+  | |- Some ?E = Some _ => let E' := eval hnf in E in
+    match E' with
+    | (match ?E'' with
+      | Some _ => _
+      | None => Vundef
+      end)
+      => change E with (force_val E'')
+    | (match ?E'' with
+      | Vundef => Vundef
+      | Vint _ => Vundef
+      | Vlong _ => Vundef
+      | Vfloat _ => Vundef
+      | Vsingle _ => Vundef
+      | Vptr _ _ => Vptr _ (Ptrofs.add _ (Ptrofs.repr ?ofs))
+      end)
+      => change E with (offset_val ofs E'')
+    | _ => change E with E'
+    end
+  | |- ?NotSome = Some _ => 
+          fail 1000 "The C-language expression " e
+              " does not necessarily evaluate, perhaps because some variable is missing from your LOCAL clause"
+  end.
 
 Ltac ignore x := idtac.
 
 (*start tactics for forward_while unfolding *)
 Ltac intro_ex_local_derives :=
 (match goal with
-   | |- local (_) && exp (fun y => _) |-- _ =>
-       rewrite exp_andp2; apply exp_left; let y':=fresh y in intro y'
+   | |- local (_) ∧ bi_exist (fun y => _) ⊢ _ =>
+       rewrite bi.and_exist_l; apply bi.exist_elim; let y':=fresh y in intro y'
 end).
 
 Ltac unfold_and_function_derives_left :=
 (repeat match goal with
-          | |- _ && (exp _) |--  _ => fail 1
-          | |- _ && (PROPx _ _) |-- _ => fail 1
-          | |- _ && (?X _ _ _ _ _) |--  _ => unfold X
-          | |- _ && (?X _ _ _ _) |--  _ => unfold X
-          | |- _ && (?X _ _ _) |--  _ => unfold X
-          | |- _ && (?X _ _) |--  _ => unfold X
-          | |- _ && (?X _) |--  _ => unfold X
-          | |- _ && (?X) |--  _ => unfold X
+          | |- _ ∧ (bi_exist _) ⊢  _ => fail 1
+          | |- _ ∧ (PROPx _ _) ⊢ _ => fail 1
+          | |- _ ∧ (?X _ _ _ _ _) ⊢  _ => unfold X
+          | |- _ ∧ (?X _ _ _ _) ⊢  _ => unfold X
+          | |- _ ∧ (?X _ _ _) ⊢  _ => unfold X
+          | |- _ ∧ (?X _ _) ⊢  _ => unfold X
+          | |- _ ∧ (?X _) ⊢  _ => unfold X
+          | |- _ ∧ (?X) ⊢  _ => unfold X
 end).
 
 Ltac unfold_and_local_derives :=
@@ -1637,59 +1639,61 @@ try rewrite <- local_lift2_and;
 unfold_and_function_derives_left;
 repeat intro_ex_local_derives;
 try rewrite local_lift2_and;
-repeat (try rewrite andp_assoc; rewrite insert_local).
+repeat (try rewrite -bi.and_assoc; rewrite insert_local).
 
 Ltac unfold_function_derives_right :=
 (repeat match goal with
-          | |- _ |-- (exp _) => fail 1
-          | |- _ |-- (PROPx _ _) => fail 1
-          | |- _ |-- (?X _ _ _ _ _)  => unfold X
-          | |- _ |-- (?X _ _ _ _)  => unfold X
-          | |- _ |-- (?X _ _ _)  => unfold X
-          | |- _ |-- (?X _ _)  => unfold X
-          | |- _ |-- (?X _)  => unfold X
-          | |- _ |-- (?X)  => unfold X
+          | |- _ ⊢ (bi_exist _) => fail 1
+          | |- _ ⊢ (PROPx _ _) => fail 1
+          | |- _ ⊢ (?X _ _ _ _ _)  => unfold X
+          | |- _ ⊢ (?X _ _ _ _)  => unfold X
+          | |- _ ⊢ (?X _ _ _)  => unfold X
+          | |- _ ⊢ (?X _ _)  => unfold X
+          | |- _ ⊢ (?X _)  => unfold X
+          | |- _ ⊢ (?X)  => unfold X
 
 end).
 
 Ltac unfold_pre_local_andp :=
 (repeat match goal with
-          | |- semax _ ((local _) && exp _) _ _ => fail 1
-          | |- semax _ ((local _) && (PROPx _ _)) _ _ => fail 1
-          | |- semax _ ((local _) && ?X _ _ _ _ _) _ _ => unfold X at 1
-          | |- semax _ ((local _) && ?X _ _ _ _) _ _ => unfold X at 1
-          | |- semax _ ((local _) && ?X _ _ _) _ _ => unfold X at 1
-          | |- semax _ ((local _) && ?X _ _) _ _ => unfold X at 1
-          | |- semax _ ((local _) && ?X _) _ _ => unfold X at 1
-          | |- semax _ ((local _) && ?X) _ _ => unfold X at 1
+          | |- semax _ _ ((local _) ∧ bi_exist _) _ _ => fail 1
+          | |- semax _ _ ((local _) ∧ (PROPx _ _)) _ _ => fail 1
+          | |- semax _ _ ((local _) ∧ ?X _ _ _ _ _) _ _ => unfold X at 1
+          | |- semax _ _ ((local _) ∧ ?X _ _ _ _) _ _ => unfold X at 1
+          | |- semax _ _ ((local _) ∧ ?X _ _ _) _ _ => unfold X at 1
+          | |- semax _ _ ((local _) ∧ ?X _ _) _ _ => unfold X at 1
+          | |- semax _ _ ((local _) ∧ ?X _) _ _ => unfold X at 1
+          | |- semax _ _ ((local _) ∧ ?X) _ _ => unfold X at 1
         end).
 
 Ltac intro_ex_local_semax :=
 (match goal with
-   | |- semax _ (local (_) && exp (fun y => _)) _ _  =>
-       rewrite exp_andp2; apply extract_exists_pre; let y':=fresh y in intro y'
+   | |- semax _ _ (local (_) ∧ bi_exist (fun y => _)) _ _  =>
+       rewrite bi.and_exist_l; apply extract_exists_pre; let y':=fresh y in intro y'
 end).
 
 Lemma do_compute_expr_helper_lemma:
- forall {cs: compspecs} Delta P Q R v e T1 T2 GV,
+ forall `{!VSTGS OK_ty Σ} {cs: compspecs}
+   Delta P Q R v e T1 T2 GV,
  local2ptree Q = (T1,T2,nil,GV) ->
  msubst_eval_expr Delta T1 T2 GV e = Some v ->
- ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- 
+ ENTAIL Delta, PROPx(Σ := Σ) P (LOCALx Q (SEPx R)) ⊢ 
    local (liftx (eq v) (eval_expr e)).
 Proof.
 intros.
 eapply derives_trans;
  [ |  apply (go_lower_localdef_canon_eval_expr
  _ P Q R _ _ _ _ v v H H0)].
-apply andp_right; auto.
-intro.
-apply prop_right; auto.
+rewrite bi.and_assoc.
+apply bi.and_intro; auto.
+unfold_lift. split => rho; monPred.unseal.
+apply bi.pure_intro; auto.
 Qed.
 
 Ltac do_compute_expr_helper_old Delta Q v e :=
    try assumption;
    eapply derives_trans; [| apply msubst_eval_expr_eq];
-    [apply andp_derives; [apply derives_refl | apply derives_refl']; apply local2ptree_soundness; try assumption;
+    [apply bi.and_mono; [apply entails_refl | apply entails_refl']; apply local2ptree_soundness; try assumption;
      let HH := fresh "H" in
      construct_local2ptree Q HH;
      exact HH |
@@ -1782,7 +1786,7 @@ Ltac do_compute_expr_helper Delta Q v e :=
 
 Ltac do_compute_expr1 CS Delta Pre e :=
  lazymatch Pre with
- | @exp _ _ ?A ?Pre1 =>
+ | @bi_exist _ ?A ?Pre1 =>
   let P := fresh "P" in let Q := fresh "Q" in let R := fresh "R" in
   let H8 := fresh "DCE" in let H9 := fresh "DCE" in
   evar (P: A -> list Prop);
@@ -1791,13 +1795,13 @@ Ltac do_compute_expr1 CS Delta Pre e :=
   assert (H8: Pre1 =  (fun a => PROPx (P a) (LOCALx (Q a) (SEPx (R a)))))
     by (extensionality; unfold P,Q,R; reflexivity);
   let v := fresh "v" in evar (v: A -> val);
-  assert (H9: forall a, ENTAIL Delta, PROPx (P a) (LOCALx (Q a) (SEPx (R a))) |--
+  assert (H9: forall a, ENTAIL Delta, PROPx (P a) (LOCALx (Q a) (SEPx (R a))) ⊢
                        local (`(eq (v a)) (eval_expr e)))
      by (let a := fresh "a" in intro a; do_compute_expr_helper Delta (Q a) v e)
  | PROPx ?P (LOCALx ?Q (SEPx ?R)) =>
   let H9 := fresh "H" in
   let v := fresh "v" in evar (v: val);
-  assert (H9:  ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))|--
+  assert (H9:  ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))⊢
                      local (`(eq v) (@eval_expr CS e)))
    by (do_compute_expr_helper Delta Q v e)
  end.
@@ -1924,18 +1928,18 @@ Proof.
 Qed.
 
 Ltac cleanup_repr H :=
-rewrite ?mul_repr, ?add_repr, ?sub_repr in H;
+rewrite ->?mul_repr, ?add_repr, ?sub_repr in H;
 match type of H with
  | _ (Int.signed (Int.repr ?A)) (Int.signed (Int.repr ?B)) =>
-    try (rewrite (Int.signed_repr A) in H by rep_lia);
-    try (rewrite (Int.signed_repr B) in H by rep_lia)
+    try (rewrite ->(Int.signed_repr A) in H by rep_lia);
+    try (rewrite ->(Int.signed_repr B) in H by rep_lia)
  | _ (Int.unsigned (Int.repr ?A)) (Int.unsigned (Int.repr ?B)) =>
-    try (rewrite (Int.unsigned_repr A) in H by rep_lia);
-    try (rewrite (Int.unsigned_repr B) in H by rep_lia)
+    try (rewrite ->(Int.unsigned_repr A) in H by rep_lia);
+    try (rewrite ->(Int.unsigned_repr B) in H by rep_lia)
  | context [Int.signed (Int.repr ?A) ] =>
-    try (rewrite (Int.signed_repr A) in H by rep_lia)
+    try (rewrite ->(Int.signed_repr A) in H by rep_lia)
  | context [Int.unsigned (Int.repr ?A) ] =>
-    try (rewrite (Int.unsigned_repr A) in H by rep_lia)
+    try (rewrite ->(Int.unsigned_repr A) in H by rep_lia)
 end.
 
 Lemma typed_true_ptr_e:
@@ -2167,7 +2171,7 @@ Ltac do_repr_inj H :=
      | _ => idtac
     end;
    rewrite ?ptrofs_to_int_repr in H;
-   rewrite ?ptrofs_to_int64_repr in H by reflexivity;
+   rewrite ->?ptrofs_to_int64_repr in H by reflexivity;
    repeat (rewrite -> negb_true_iff in H || rewrite -> negb_false_iff in H);
    try apply int_eq_e in H;
    try apply int64_eq_e in H;
@@ -2208,7 +2212,7 @@ Ltac do_repr_inj H :=
          | simple apply lt_false_inv64 in H; cleanup_repr H
          | idtac
          ];
-    rewrite ?Byte_signed_lem, ?Byte_signed_lem',
+    rewrite ->?Byte_signed_lem, ?Byte_signed_lem',
                  ?int_repr_byte_signed_eq0, ?int_repr_byte_signed_eq0
       in H.
 
@@ -2244,10 +2248,12 @@ Ltac special_intros_EX :=
    end.
 
 Lemma trivial_exp:
- forall P: environ -> mpred,
- P = exp (fun x: unit => P).
+ forall `{!VSTGS OK_ty Σ} (P: environ -> mpred),
+ (assert_of P) ⊣⊢ bi_exist (fun x: unit => (assert_of P)).
 Proof.
-intros. apply pred_ext. Exists tt. auto. Intros u; auto.
+intros. iSplit; iIntros "H".
+- iExists tt; done.
+- iApply bi.exist_elim. intro. apply derives_refl. simpl. done.
 Qed.
 
 Fixpoint nobreaksx (s: statement) : bool :=
@@ -2265,12 +2271,12 @@ Ltac forward_while_advise_loop :=
 Tactic Notation "forward_while" constr(Inv) :=
   repeat (apply -> seq_assoc; abbreviate_semax);
   match goal with
-  | |- semax _ _ (Ssequence _ _) _ => idtac 
-  | Post := @abbreviate ret_assert ?P' |- semax _ _ (Swhile _ _) ?P =>
+  | |- semax _ _ _ (Ssequence _ _) _ => idtac 
+  | Post := @abbreviate ret_assert ?P' |- semax _ _ _ (Swhile _ _) ?P =>
        constr_eq P Post;
        tryif (no_evars P') then forward_while_advise_loop else idtac;
       apply <- semax_seq_skip
-  | |- semax _ _ (Swhile _ _) ?P => 
+  | |- semax _ _ _ (Swhile _ _) ?P => 
        tryif (no_evars P) then forward_while_advise_loop else idtac;
       apply <- semax_seq_skip
   | _ => apply <- semax_seq_skip 
@@ -2280,26 +2286,26 @@ Tactic Notation "forward_while" constr(Inv) :=
   apply semax_pre with Inv;
     [ unfold_function_derives_right
     | repeat match goal with
-       | |- semax _ (exp _) _ _ => fail 1
-       | |- semax _ (PROPx _ _) _ _ => fail 1
-       | |- semax _ ?Pre _ _ => match Pre with context [ ?F ] => unfold F end
+       | |- semax _ _ (bi_exist _) _ _ => fail 1
+       | |- semax _ _ (PROPx _ _) _ _ => fail 1
+       | |- semax _ _ ?Pre _ _ => match Pre with context [ ?F ] => unfold F end
        end;
        match goal with
-       | |- semax _ (exp (fun a1 => _)) _ _ =>
+       | |- semax _ _ (bi_exist (fun a1 => _)) _ _ =>
              let a := fresh a1 in pose (a := EXP_NAME)
-       | |- semax _ (PROPx ?P ?QR) _ _ =>
+       | |- semax _ _ (PROPx ?P ?QR) _ _ =>
              let a := fresh "u" in pose (a := EXP_UNIT);
                   rewrite (trivial_exp (PROPx P QR))
        end;
-       repeat match goal with |- semax _ (exp (fun a1 => (exp (fun a2 => _)))) _ _ =>
+       repeat match goal with |- semax _ _ (bi_exist (fun a1 => (bi_exist (fun a2 => _)))) _ _ =>
           let a := fresh a2 in pose (a := EXP_NAME);
           rewrite exp_uncurry
       end;
       eapply semax_seq;
-      [match goal with |- @semax ?CS _ ?Delta ?Pre (Swhile ?e ?s) _ =>
+      [match goal with |- @semax _ _ _ _ ?CS _ ?Delta ?Pre (Swhile ?e ?s) _ =>
         tryif (unify (nobreaksx s) true) then idtac 
         else fail "Your while-loop has a break command in the body.  Therefore, you should use forward_loop to prove it, since the standard while-loop postcondition (Invariant & ~test) may not hold at the break statement";
-        match goal with [ |- semax _ (@exp _ _ ?A _) _ _ ] => eapply (@semax_while_3g1 _ _ A) end;
+        match goal with [ |- semax _ _ (@bi_exist  _ ?A _) _ _ ] => eapply (@semax_while_3g1 _ _ _ _ _ A) end;
         (* check if we can revert back to the previous version with coq 8.5.
            (as of December 2015 with compcert 2.6 the above fix is still necessary)
            The bug happens when we destruct the existential variable of the loop invariant:
@@ -2318,7 +2324,7 @@ Tactic Notation "forward_while" constr(Inv) :=
                 POST [ tint ] main_post prog u).
              start_function.
              forward.
-             pose (Inv := (EX b : bool, PROP () LOCAL (temp _i (Vint (Int.repr (if b then 1 else 0)))) SEP ())).
+             pose (Inv := (∃ b : bool, PROP () LOCAL (temp _i (Vint (Int.repr (if b then 1 else 0)))) SEP ())).
              forward_while Inv. (** FAILS WITH THE FORMER VERSION OF forward_while **)
          *)
         simpl typeof;  (* this 'simpl' should be fine, since its argument is just clightgen-produced ASTs *)
@@ -2348,8 +2354,9 @@ Loop test expression:" e
 Inductive Type_of_invariant_in_forward_for_should_be_environ_arrow_mpred_but_is : Type -> Prop := .
 Inductive Type_of_bound_in_forward_for_should_be_Z_but_is : Type -> Prop := .
 
+
 Ltac check_type_forward_for_simple_bound :=
-   match goal with |- semax _ _ ?c _ => 
+   match goal with |- semax _ _ _ ?c _ => 
          let x := constr:(match c with (Ssequence _ (Sloop _ (Sset _ e))) => Some (typeof e) | _ => None end) in
          let x := eval hnf in x in
          let x := eval simpl in x in   (* this 'simpl' should be safe enough  *)
@@ -2361,14 +2368,16 @@ Ltac check_type_forward_for_simple_bound :=
          end
      end.
 
+Ltac get_Sigma_from_semax := match goal with |- semax(Σ := ?Σ) _ _ _ _ _ => Σ end.
+
 Ltac forward_for_simple_bound n Pre :=
   check_Delta; check_POSTCONDITION;
  repeat match goal with |-
-      semax _ _ (Ssequence (Ssequence (Ssequence _ _) _) _) _ =>
+      semax _ _ _ (Ssequence (Ssequence (Ssequence _ _) _) _) _ =>
       apply -> seq_assoc; abbreviate_semax
  end;
  match goal with |-
-      semax _ _ (Ssequence (Ssequence (Sfor _ _ _ _) _) _) _ =>
+      semax _ _ _ (Ssequence (Ssequence (Sfor _ _ _ _) _) _) _ =>
       apply -> seq_assoc; abbreviate_semax
  | _ => idtac
  end;
@@ -2376,16 +2385,17 @@ Ltac forward_for_simple_bound n Pre :=
       ?t => tryif (unify t Z) then idtac 
                else fail "Type of bound" n "should be Z but is" t
  end;
+ let Σ := get_Sigma_from_semax in
  match type of Pre with
- | ?t => tryif (unify t (environ->mpred)) then idtac 
-               else fail "Type of precondition" Pre "should be environ->mpred but is" t
+ | ?t => tryif (unify t (assert)) then idtac 
+               else fail "Type of precondition" Pre "should be assert but is" t
   end;
  match goal with
-    | |- semax _ _ (Sfor _ _ _ _) _ =>
+    | |- semax _ _ _ (Sfor _ _ _ _) _ =>
            rewrite semax_seq_skip
-    | |- semax _ _ (Ssequence _ (Sloop _ _)) _ =>
+    | |- semax _ _ _ (Ssequence _ (Sloop _ _)) _ =>
            rewrite semax_seq_skip
-    | |- semax _ _ (Ssequence _ ?MORE_COMMANDS) _ =>
+    | |- semax _ _ _ (Ssequence _ ?MORE_COMMANDS) _ =>
         revert MORE_COMMANDS;
         match goal with
         | |- let MORE_COMMANDS := @abbreviate _ (Sloop _ _) in _ =>
@@ -2402,9 +2412,9 @@ Ltac forward_for3 Inv PreInc Postcond :=
         [ reflexivity
         |intro  
         | intro ;
-          match goal with |- ENTAIL ?Delta, ?Pre |-- local (liftx (eq _) (@eval_expr ?CS ?e)) =>
+          match goal with |- ENTAIL ?Delta, ?Pre ⊢ local (liftx (eq _) (@eval_expr ?CS ?e)) =>
             do_compute_expr1 CS Delta Pre e;
-            match goal with v := _ : val , H: ENTAIL _ , _ |-- _ |- _ => subst v; apply H end
+            match goal with v := _ : val , H: ENTAIL _ , _ ⊢ _ |- _ => subst v; apply H end
           end
         | intro; let HRE := fresh in
             apply semax_extract_PROP; intro HRE; 
@@ -2435,10 +2445,10 @@ Fixpoint no_breaks (s: statement) : bool :=
  end.
 
 Ltac forward_for2 Inv PreInc :=
- repeat  match goal with P := @abbreviate ret_assert _ |- semax _ _ _ ?P' =>
+ repeat  match goal with P := @abbreviate ret_assert _ |- semax _ _ _ _ ?P' =>
                          constr_eq P P'; unfold abbreviate in P; subst P
            end;
- match goal with |- semax _ _ (Sloop (Ssequence (Sifthenelse _ Sskip Sbreak) ?body) _) _ =>
+ match goal with |- semax _ _ _ (Sloop (Ssequence (Sifthenelse _ Sskip Sbreak) ?body) _) _ =>
    (tryif unify (no_breaks body) true 
           then idtac
       else fail "Since there is a break in the loop body, you need to supply an explicit postcondition using the 3-argument form of forward_for.");
@@ -2446,9 +2456,9 @@ Ltac forward_for2 Inv PreInc :=
         [ reflexivity 
         |intro  
         | intro ;
-          match goal with |- ENTAIL ?Delta, ?Pre |-- local (liftx (eq _) (@eval_expr ?CS ?e)) =>
+          match goal with |- ENTAIL ?Delta, ?Pre ⊢ local (liftx (eq _) (@eval_expr ?CS ?e)) =>
             do_compute_expr1 CS Delta Pre e;
-            match goal with v := _ : val , H: ENTAIL _ , _ |-- _ |- _ => subst v; apply H end
+            match goal with v := _ : val , H: ENTAIL _ , _ ⊢ _ |- _ => subst v; apply H end
           end
         | intro; let HRE := fresh in 
             apply semax_extract_PROP; intro HRE; 
@@ -2461,48 +2471,52 @@ Ltac forward_for2 Inv PreInc :=
         ]    
   end.
 
+Section FORWARD.
+Context `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS : compspecs}.
+
 Lemma seq_assoc1: 
-   forall (Espec: OracleKind) (CS : compspecs) (Delta : tycontext) (P : environ -> mpred)
+   forall E (Delta : tycontext) P
          (s1 s2 s3 : statement) (R : ret_assert),
-       semax Delta P (Ssequence s1 (Ssequence s2 s3)) R ->
-       semax Delta P (Ssequence (Ssequence s1 s2) s3) R.
+       semax E Delta P (Ssequence s1 (Ssequence s2 s3)) R ->
+       semax E Delta P (Ssequence (Ssequence s1 s2) s3) R.
 Proof. intros. apply -> seq_assoc; auto. Qed.
 
 Lemma semax_loop_noincr :
-  forall {Espec: OracleKind}{CS: compspecs} ,
-forall Delta Q body R,
-     @semax CS Espec Delta  Q body (loop1_ret_assert Q R) ->
-     @semax CS Espec Delta Q (Sloop body Sskip) R.
+  forall E Delta Q body R,
+     semax E Delta Q body (loop1_ret_assert Q R) ->
+     semax E Delta Q (Sloop body Sskip) R.
 Proof.
 intros.
 apply semax_loop with Q; auto.
 eapply semax_post_flipped.
 apply semax_skip.
-all: try (simpl; intros; apply andp_left2; destruct R; try apply derives_refl; apply FF_left).
+all: by (simpl; raise_rho; rewrite bi.and_elim_r; destruct R; try apply derives_refl; apply bi.False_elim).
 Qed.
 
-Lemma semax_post1: forall R' Espec {cs: compspecs} Delta R P c,
-           ENTAIL Delta, R' |-- RA_normal R ->
-      @semax cs Espec Delta P c (overridePost R' R) ->
-      @semax cs Espec Delta P c R.
+Lemma semax_post1:
+  forall R' E Delta R P c,
+           ENTAIL Delta, R' ⊢ RA_normal R ->
+      semax E Delta P c (overridePost R' R) ->
+      semax E Delta P c R.
 Proof. intros. eapply semax_post; try apply H0.
  destruct R; apply H.
- all: intros; destruct R; apply andp_left2; apply derives_refl.
+ all: intros; destruct R; apply bi.and_elim_r; apply derives_refl.
 Qed.
 
-Lemma semax_post1_flipped: forall R' Espec {cs: compspecs} Delta R P c,
-      @semax cs Espec Delta P c (overridePost R' R) ->
-         ENTAIL Delta, R' |-- RA_normal R ->
-      @semax cs Espec Delta P c R.
+Lemma semax_post1_flipped: forall R' E Delta R P c,
+      semax E Delta P c (overridePost R' R) ->
+         ENTAIL Delta, R' ⊢ RA_normal R ->
+      semax E Delta P c R.
 Proof. intros. apply semax_post1 with R'; auto. Qed.
 
 Lemma semax_skip_seq1:
-  forall {Espec: OracleKind} {CS: compspecs} Delta P s1 s2 Q,
-   semax Delta P (Ssequence s1 s2) Q ->
-   semax Delta P (Ssequence (Ssequence Sskip s1) s2) Q.
+  forall E Delta P s1 s2 Q,
+   semax E Delta P (Ssequence s1 s2) Q ->
+   semax E Delta P (Ssequence (Ssequence Sskip s1) s2) Q.
 Proof.
-intros. apply seq_assoc1. apply -> semax_skip_seq. auto.
+intros. eapply seq_assoc1. apply -> semax_skip_seq. auto.
 Qed.
+End FORWARD.
 
 Ltac delete_skip :=
  repeat apply -> semax_skip_seq;
@@ -2510,17 +2524,18 @@ Ltac delete_skip :=
 
 Ltac forward_loop_aux2 Inv PreInc :=
  lazymatch goal with
-  | |- semax _ _ (Sloop _ Sskip) _ => 
+  | |- semax _ _ _ (Sloop _ Sskip) _ => 
          tryif (constr_eq Inv PreInc) then (apply (semax_loop_noincr _ Inv); abbreviate_semax)
          else (apply (semax_loop _ Inv PreInc); [delete_skip | ]; abbreviate_semax)
-  | |- semax _ _ (Sloop _ _) _ =>apply (semax_loop _ Inv PreInc); [delete_skip | ]; abbreviate_semax
+  | |- semax _ _ _ (Sloop _ _) _ =>
+     apply semax_loop with (Q:=Inv) (Q':=PreInc); [delete_skip | ]; abbreviate_semax
  end.
 
 Ltac forward_loop_aux1 Inv PreInc:=
   lazymatch goal with
-  | |- semax _ _ (Sfor _ _ _ _) _ => apply semax_seq' with Inv; [abbreviate_semax | forward_loop_aux2 Inv PreInc]
-  | |- semax _ _ (Sloop _ _) _ => apply semax_pre with Inv; [ | forward_loop_aux2 Inv PreInc]
-  | |- semax _ _ (Swhile ?E ?B) _ => 
+  | |- semax _ _ _ (Sfor _ _ _ _) _ => apply semax_seq' with Inv; [abbreviate_semax | forward_loop_aux2 Inv PreInc]
+  | |- semax _ _ _ (Sloop _ _) _ => apply semax_pre with Inv; [ | forward_loop_aux2 Inv PreInc]
+  | |- semax _ _ _ (Swhile ?E ?B) _ => 
           let x := fresh "x" in set (x := Swhile E B); hnf in x; subst x;
           apply semax_pre with Inv; [ | forward_loop_aux2 Inv PreInc]
  end.
@@ -2530,13 +2545,13 @@ check_POSTCONDITION;
   repeat simple apply seq_assoc1;
  repeat apply -> semax_seq_skip;
   match goal with
-  | |- semax _ _ (Ssequence (Sloop _ _) _) _ => 
+  | |- semax _ _ _ (Ssequence (Sloop _ _) _) _ => 
           apply semax_seq with Post; [forward_loop_aux1 Inv PreInc | abbreviate_semax ]
-  | |- semax _ _ (Ssequence (Sfor _ _ _ _) _) _ => 
+  | |- semax _ _ _ (Ssequence (Sfor _ _ _ _) _) _ => 
           apply semax_seq with Post; [forward_loop_aux1 Inv PreInc | abbreviate_semax ]
-  | |- semax _ _ (Ssequence (Swhile _ _) _) _ => 
+  | |- semax _ _ _ (Ssequence (Swhile _ _) _) _ => 
           apply semax_seq with Post; [forward_loop_aux1 Inv PreInc | abbreviate_semax ]
-  | |- semax _ _ _ ?Post' => 
+  | |- semax _ _ _ _ ?Post' => 
             tryif (unify Post Post') then forward_loop_aux1 Inv PreInc 
            else (apply (semax_post1_flipped Post); [ forward_loop_aux1 Inv PreInc | ])
   end.
@@ -2556,15 +2571,15 @@ Tactic Notation "forward_loop" constr(Inv) "continue:" constr(PreInc) :=
 check_POSTCONDITION;
  repeat apply -> semax_seq_skip;
 lazymatch goal with
-  | |- semax _ _ (Ssequence (Sloop _ _) _) _ =>
+  | |- semax _ _ _ (Ssequence (Sloop _ _) _) _ =>
          fail 100 "Your loop is followed by more statements, so you must use the form of forward_loop with the break: keyword to supply an explicit postcondition for the loop."
-  | |- semax _ _ (Ssequence (Sfor _ _ _ _) _) _ =>
+  | |- semax _ _ _ (Ssequence (Sfor _ _ _ _) _) _ =>
          fail 100 "Your loop is followed by more statements, so you must use the form of forward_loop with the break: keyword to supply an explicit postcondition for the loop."
-  | P := @abbreviate ret_assert ?Post' |- semax _ _ _ ?Post => 
+  | P := @abbreviate ret_assert ?Post' |- semax _ _ _ _ ?Post => 
       first [constr_eq P Post | fail 100 "forward_loop failed; try doing abbreviate_semax first"];
       try (has_evar Post'; fail 100 "Error: your postcondition " P " has unification variables (evars), so you must use the form of forward_loop with the break: keyword to supply an explicit postcondition for the loop.");
      forward_loop Inv continue: PreInc break: Post
-  | |- semax _ _ _ _ => fail 100 "forward_loop failed; try doing abbreviate_semax first"
+  | |- semax _ _ _ _ _ => fail 100 "forward_loop failed; try doing abbreviate_semax first"
   | |- _ => fail 100 "forward_loop applicable only to a semax goal"
 end.
 
@@ -2618,9 +2633,9 @@ Ltac forward_loop_nocontinue2 Inv :=
 
 Ltac forward_loop_nocontinue1 Inv :=
   lazymatch goal with
-  | |- semax _ _ (Sfor _ _ _ _) _ => apply semax_seq' with Inv; [abbreviate_semax | forward_loop_nocontinue2 Inv]
-  | |- semax _ _ (Sloop _ _) _ => apply semax_pre with Inv; [ | forward_loop_nocontinue2 Inv]
-  | |- semax _ _ (Swhile ?E ?B) _ => 
+  | |- semax _ _ _ (Sfor _ _ _ _) _ => apply semax_seq' with Inv; [abbreviate_semax | forward_loop_nocontinue2 Inv]
+  | |- semax _ _ _ (Sloop _ _) _ => apply semax_pre with Inv; [ | forward_loop_nocontinue2 Inv]
+  | |- semax _ _ _ (Swhile ?E ?B) _ => 
           let x := fresh "x" in set (x := Swhile E B); hnf in x; subst x;
           apply semax_pre with Inv; [ | forward_loop_nocontinue2 Inv]
  end.
@@ -2629,9 +2644,9 @@ Ltac forward_loop_nocontinue Inv Post :=
   repeat simple apply seq_assoc1;
   repeat apply -> semax_seq_skip;
   match goal with
-  | |- semax _ _ (Ssequence _ _) _ => 
+  | |- semax _ _ _ (Ssequence _ _) _ => 
           apply semax_seq with Post; [forward_loop_nocontinue1 Inv  | abbreviate_semax ]
-  | |- semax _ _ _ ?Post' => 
+  | |- semax _ _ _ _ ?Post' => 
             tryif (unify Post Post') then forward_loop_nocontinue1 Inv
            else (apply (semax_post1_flipped Post); [ forward_loop_nocontinue1 Inv  
                            | abbreviate_semax; simpl_ret_assert; auto ])
@@ -2640,18 +2655,18 @@ Ltac forward_loop_nocontinue Inv Post :=
 Ltac forward_loop_nocontinue_nobreak Inv :=
  repeat apply -> semax_seq_skip;
   lazymatch goal with
-  | |- semax _ _ (Ssequence (Swhile _ ?S) _) _ =>
+  | |- semax _ _ _ (Ssequence (Swhile _ ?S) _) _ =>
           tryif (unify (nocontinue S) true; unify (nobreaksx S) true) then forward_while Inv 
           else fail 100 "Use forward_while, or (unfold Swhile at 1) and then use forward_loop"
-  | |- semax _ _ (Ssequence (Sloop _ _) _) _ =>
+  | |- semax _ _ _ (Ssequence (Sloop _ _) _) _ =>
          fail 100 "Your loop is followed by more statements, so you must use the form of forward_loop with the break: keyword to supply an explicit postcondition for the loop."
-  | |- semax _ _ (Ssequence (Sfor _ _ _ _) _) _ =>
+  | |- semax _ _ _ (Ssequence (Sfor _ _ _ _) _) _ =>
          fail 100 "Your loop is followed by more statements, so you must use the form of forward_loop with the break: keyword to supply an explicit postcondition for the loop."
-  | P := @abbreviate ret_assert ?Post' |- semax _ _ _ ?Post => 
+  | P := @abbreviate ret_assert ?Post' |- semax _ _ _ _ ?Post => 
       first [constr_eq P Post | fail 100 "forward_loop failed; try doing abbreviate_semax first"];
       try (has_evar Post'; fail 100 "Error: your postcondition " P " has unification variables (evars), so you must use the form of forward_loop with the break: keyword to supply an explicit postcondition for the loop.");
      forward_loop_nocontinue Inv Post
-  | |- semax _ _ _ _ => fail 100 "forward_loop failed; try doing abbreviate_semax first"
+  | |- semax _ _ _ _ _ => fail 100 "forward_loop failed; try doing abbreviate_semax first"
   | |- _ => fail 100 "forward_loop applicable only to a semax goal"
 end.
 
@@ -2659,17 +2674,17 @@ Tactic Notation "forward_loop" constr(Inv)  :=
  repeat simple apply seq_assoc1;
  repeat apply -> semax_seq_skip;
   lazymatch goal with
-  | |- semax _ _ (Ssequence (Sfor _ ?e2 ?s3 ?s4) _) _ =>
+  | |- semax _ _ _ (Ssequence (Sfor _ ?e2 ?s3 ?s4) _) _ =>
      let c := constr:(Sloop (Ssequence (Sifthenelse e2 Sskip Sbreak) s3) s4) in
     tryif (check_nocontinue c)
      then forward_loop_nocontinue_nobreak Inv
      else (check_no_incr c; forward_loop Inv continue: Inv)
-  | |- semax _ _ (Sfor _ ?e2 ?s3 ?s4) _ =>
+  | |- semax _ _ _ (Sfor _ ?e2 ?s3 ?s4) _ =>
      let c := constr:(Sloop (Ssequence (Sifthenelse e2 Sskip Sbreak) s3) s4) in
     tryif (check_nocontinue c)
      then forward_loop_nocontinue_nobreak Inv
      else (check_no_incr c; forward_loop Inv continue: Inv)
-  | |- semax _ _ ?c _ =>
+  | |- semax _ _ _ ?c _ =>
   tryif (check_nocontinue c)
    then forward_loop_nocontinue_nobreak Inv
   else (check_no_incr c; forward_loop Inv continue: Inv)
@@ -2679,17 +2694,17 @@ Tactic Notation "forward_loop" constr(Inv) "break:" constr(Post) :=
  repeat simple apply seq_assoc1;
  repeat apply -> semax_seq_skip;
   lazymatch goal with
-  | |- semax _ _ (Ssequence (Sfor _ ?e2 ?s3 ?s4) _) _ =>
+  | |- semax _ _ _ (Ssequence (Sfor _ ?e2 ?s3 ?s4) _) _ =>
      let c := constr:(Sloop (Ssequence (Sifthenelse e2 Sskip Sbreak) s3) s4) in
       tryif (check_nocontinue c)
        then forward_loop_nocontinue Inv Post
        else (check_no_incr c; forward_loop Inv continue: Inv break: Post)
-  | |- semax _ _ (Sfor _ ?e2 ?s3 ?s4) _ =>
+  | |- semax _ _ _ (Sfor _ ?e2 ?s3 ?s4) _ =>
      let c := constr:(Sloop (Ssequence (Sifthenelse e2 Sskip Sbreak) s3) s4) in
       tryif (check_nocontinue c)
        then forward_loop_nocontinue Inv Post
        else (check_no_incr c; forward_loop Inv continue: Inv break: Post)
-  | |- semax _ _ ?c _ =>
+  | |- semax _ _ _ ?c _ =>
   tryif (check_nocontinue c)
    then forward_loop_nocontinue Inv Post
   else (check_no_incr c; forward_loop Inv continue: Inv break: Post)
@@ -2698,18 +2713,19 @@ Tactic Notation "forward_loop" constr(Inv) "break:" constr(Post) :=
 Tactic Notation "forward_for" constr(Inv) "continue:" constr(PreInc) :=
   check_Delta; check_POSTCONDITION;
   repeat simple apply seq_assoc1;
+(* removing these checks for now, since they keep failing on monPreds
   lazymatch type of Inv with
-  | _ -> environ -> mpred => idtac
-  | _ => fail "Invariant (first argument to forward_for) must have type (_ -> environ -> mpred)"
+  | _ -> assert => idtac
+  | _ => fail "Invariant (first argument to forward_for) must have type (_ -> assert)"
   end;
   lazymatch type of PreInc with
-  | _ -> environ -> mpred => idtac
-  | _ => fail "PreInc (continue: argument to forward_for) must have type (_ -> environ -> mpred)"
-  end;
+  | _ -> assert mpred => idtac
+  | _ => fail "PreInc (continue: argument to forward_for) must have type (_ -> assert)"
+  end;*)
   lazymatch goal with
-  | |- semax _ _ (Ssequence (Sfor _ _ _ _) _) _ =>
+  | |- semax _ _ _ (Ssequence (Sfor _ _ _ _) _) _ =>
       apply -> seq_assoc;
-      apply semax_seq' with (exp Inv); abbreviate_semax;
+      apply semax_seq' with (∃ x:_, Inv x); abbreviate_semax;
       [  | eapply semax_seq; 
          [ forward_for2 Inv PreInc 
           | abbreviate_semax;
@@ -2719,14 +2735,14 @@ Tactic Notation "forward_for" constr(Inv) "continue:" constr(PreInc) :=
             repeat (apply semax_extract_PROP; fancy_intro true);
             do_repr_inj HRE]
    ]
-  | |- semax _ _ (Sfor _ _ _ _) ?Post =>
-      apply semax_seq' with (exp Inv); abbreviate_semax;
+  | |- semax _ _ _ (Sfor _ _ _ _) ?Post =>
+      apply semax_seq' with (∃ x:_, Inv x); abbreviate_semax;
       [  | forward_for3 Inv PreInc Post]
-  | |- semax _ _ (Sloop (Ssequence (Sifthenelse _ Sskip Sbreak) _) _) ?Post =>
-     apply semax_pre with (exp Inv);
+  | |- semax _ _ _ (Sloop (Ssequence (Sifthenelse _ Sskip Sbreak) _) _) ?Post =>
+     apply semax_pre with (∃ x:_, Inv x);
       [  | forward_for3 Inv PreInc Post]
-  | |- semax _ _ (Sloop (Ssequence (Sifthenelse _ Sskip Sbreak) _) _) _ =>
-     apply semax_pre with (exp Inv);
+  | |- semax _ _ _ (Sloop (Ssequence (Sifthenelse _ Sskip Sbreak) _) _) _ =>
+     apply semax_pre with (∃ x:_, Inv x);
       [ unfold_function_derives_right | forward_for2 Inv PreInc ]
   | |- _ => fail "forward_for2x cannot recognize the loop"
   end.
@@ -2734,25 +2750,26 @@ Tactic Notation "forward_for" constr(Inv) "continue:" constr(PreInc) :=
 Tactic Notation "forward_for" constr(Inv) "continue:" constr(PreInc) "break:" constr(Postcond) :=
   check_Delta; check_POSTCONDITION;
   repeat simple apply seq_assoc1;
+(* removing these checks for now, since they keep failing on monPreds
   lazymatch type of Inv with
-  | _ -> environ -> mpred => idtac
-  | _ => fail "Invariant (first argument to forward_for) must have type (_ -> environ -> mpred)"
+  | _ -> assert => idtac
+  | _ => fail "Invariant (first argument to forward_for) must have type (_ -> assert)"
   end;
   lazymatch type of PreInc with
-  | _ -> environ -> mpred => idtac
-  | _ => fail "PreInc (second argument to forward_for) must have type (_ -> environ -> mpred)"
+  | _ -> assert => idtac
+  | _ => fail "PreInc (second argument to forward_for) must have type (_ -> assert)"
   end;
   lazymatch type of Postcond with
-  | environ -> mpred => idtac
-  | _ => fail "Postcond (third argument to forward_for) must have type (environ -> mpred)"
-  end;
+  | assert => idtac
+  | _ => fail "Postcond (third argument to forward_for) must have type (assert)"
+  end;*)
   lazymatch goal with
-  | |- semax _ _ (Ssequence (Sfor _ _ _ _) _) _ =>
+  | |- semax _ _ _ (Ssequence (Sfor _ _ _ _) _) _ =>
       apply -> seq_assoc;
-      apply semax_seq' with (exp Inv); abbreviate_semax;
+      apply semax_seq' with (∃ x:_, Inv x); abbreviate_semax;
       [  | forward_for3 Inv PreInc Postcond]
-  | |- semax _ _ (Sloop (Ssequence (Sifthenelse _ Sskip Sbreak) _) _) _ =>
-     apply semax_pre with (exp Inv);
+  | |- semax _ _ _ (Sloop (Ssequence (Sifthenelse _ Sskip Sbreak) _) _) _ =>
+     apply semax_pre with (∃ x:_, Inv x);
       [ unfold_function_derives_right | forward_for3 Inv PreInc Postcond ]
   end.
 
@@ -2761,19 +2778,19 @@ Tactic Notation "forward_for" constr(Inv) "break:" constr(Postcond) "continue:"
 
 Tactic Notation "forward_for" constr(Inv) constr(PreInc) :=
   fail "Usage of the forward_for tactic:
-forward_for  Inv   (* where Inv: A->environ->mpred is a predicate on index values of type A *)
+forward_for  Inv   (* where Inv: A->assert is a predicate on index values of type A *)
 forward_for Inv continue: PreInc (* where Inv,PreInc are predicates on index values of type A *)
-forward_for Inv continue: PreInc break:Post (* where Post: environ->mpred is an assertion *)".
+forward_for Inv continue: PreInc break:Post (* where Post: assert is an assertion *)".
 
 Lemma semax_convert_for_while:
- forall CS Espec Delta Pre s1 e2 s3 s4 Post,
+ forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS : compspecs} E Delta Pre s1 e2 s3 s4 Post,
   nocontinue s4 = true ->
   nocontinue s3 = true ->
-  @semax CS Espec Delta Pre (Ssequence s1 (Swhile e2 (Ssequence s4 s3))) Post ->
-  @semax CS Espec Delta Pre (Sfor s1 e2 s4 s3) Post.
+  semax E Delta Pre (Ssequence s1 (Swhile e2 (Ssequence s4 s3))) Post ->
+  semax E Delta Pre (Sfor s1 e2 s4 s3) Post.
 Proof.
 intros.
-pose proof (semax_convert_for_while' CS Espec Delta Pre s1 e2 s3 s4 Sskip Post H).
+pose proof (semax_convert_for_while' E Delta Pre s1 e2 s3 s4 Sskip Post H).
 spec H2; auto.
 apply -> semax_seq_skip in H1; auto.
 apply seq_assoc in H1; auto.
@@ -2784,32 +2801,31 @@ Qed.
 Tactic Notation "forward_for" constr(Inv) :=
   check_Delta; check_POSTCONDITION;
   repeat simple apply seq_assoc1;
-  lazymatch type of Inv with
-  | _ -> environ -> mpred => idtac
-  | _ => fail "Invariant (first argument to forward_for) must have type (_ -> environ -> mpred)"
-  end;
+(*  lazymatch type of Inv with
+  | _ -> assert => idtac
+  | _ => fail "Invariant (first argument to forward_for) must have type (_ -> assert)"
+  end;*)
   lazymatch goal with
-  | |- semax _ _ (Ssequence (Sfor _ _ _ _) _) _ =>
+  | |- semax _ _ _ (Ssequence (Sfor _ _ _ _) _) _ =>
         apply semax_convert_for_while';
              [(reflexivity ||
                  fail "Your for-loop has a continue statement, so your forward_for needs a continue: clause")
                | (reflexivity || fail "Unexpected continue statement in for-loop increment")
-               | apply semax_seq' with (exp Inv);
-                   [  |  forward_while (EX x:_, Inv x); [ apply ENTAIL_refl | | |  ]  ] ]
-  | |- semax _ _ (Sfor _ _ _ _) _ =>
+               | apply semax_seq' with (∃ x:_, Inv x);
+                   [  |  forward_while (∃ x:_, Inv x); [ apply ENTAIL_refl | | |  ]  ] ]
+  | |- semax _ _ _ (Sfor _ _ _ _) _ =>
         apply semax_convert_for_while;
              [(reflexivity ||
                  fail "Your for-loop has a continue statement, so your forward_for needs a continue: clause")
                | (reflexivity || fail "Unexpected continue statement in for-loop increment")
-               | apply semax_seq' with (exp Inv);
-                   [  |  forward_while (EX x:_, Inv x);
+               | apply semax_seq' with (∃ x:_, Inv x);
+                   [  |  forward_while (∃ x:_, Inv x);
                              [ apply ENTAIL_refl | | | eapply semax_post_flipped'; [apply semax_skip | ] ]  ] ]
-        
   end.
 
 Ltac process_cases sign := 
 match goal with
-| |- semax _ _ (seq_of_labeled_statement 
+| |- semax _ _ _ (seq_of_labeled_statement 
      match select_switch_case ?N (LScons (Some ?X) ?C ?SL)
       with Some _ => _ | None => _ end) _ =>
        let y := constr:(adjust_for_sign sign X) in let y := eval compute in y in 
@@ -2826,16 +2842,16 @@ match goal with
         end;
         try match type of E with ?a = _ => is_var a; subst a end;
         repeat apply -> semax_skip_seq
-     | try (rewrite if_false by (contradict NE; symmetry; apply NE));
+     | try (rewrite ->if_false by (contradict NE; symmetry; apply NE));
         process_cases sign
     ]
-| |- semax _ _ (seq_of_labeled_statement 
+| |- semax _ _ _ (seq_of_labeled_statement 
      match select_switch_case ?N (LScons None ?C ?SL)
       with Some _ => _ | None => _ end) _ =>
       change (select_switch_case N (LScons None C SL))
        with (select_switch_case N SL);
         process_cases sign
-| |- semax _ _ (seq_of_labeled_statement 
+| |- semax _ _ _ (seq_of_labeled_statement 
      match select_switch_case ?N LSnil
       with Some _ => _ | None => _ end) _ =>
       change (select_switch_case N LSnil)
@@ -2847,7 +2863,7 @@ end.
 
 Ltac forward_switch' := 
 match goal with
-| |- @semax ?CS _ ?Delta ?Pre (Sswitch ?e _) _ =>
+| |- @semax _ _ _ _ ?CS _ ?Delta ?Pre (Sswitch ?e _) _ =>
    let sign := constr:(signof e) in let sign := eval hnf in sign in
     let HRE := fresh "H" in let v := fresh "v" in 
     do_compute_expr1 CS Delta Pre e;
@@ -2860,7 +2876,7 @@ match goal with
     let n' := fresh "n" in pose (n' := Int.unsigned n); 
     let H' := fresh in assert (H': n = Int.repr n');
        [try (symmetry; apply Int.repr_unsigned) 
-       | rewrite H,H' in HRE; clear H H';
+       | rewrite H H' in HRE; clear H H';
          subst n' n v; 
          rewrite (Int.repr_unsigned (Int.repr _)) in HRE;
          eapply semax_switch_PQR; 
@@ -2883,74 +2899,77 @@ Ltac forward_if'_new :=
  repeat (apply seq_assoc1; try apply -> semax_seq_skip);
  hoist_later_in_pre;
 match goal with
-| |- @semax ?CS _ ?Delta (|> ?Pre) (Sifthenelse ?e ?c1 ?c2) _ =>
+| |- @semax _ _ _ _ ?CS _ ?Delta (▷ ?Pre) (Sifthenelse ?e ?c1 ?c2) _ =>
    let HRE := fresh "H" in let v := fresh "v" in
     do_compute_expr1 CS Delta Pre e;
     match goal with v' := _, H:_ |- _ => rename H into HRE; rename v' into v end;
-    apply (semax_ifthenelse_PQR' _ v);
+    apply (semax_ifthenelse_PQR' v);
      [ reflexivity | entailer | assumption
      | simpl in v; clear HRE; subst v; apply semax_extract_PROP; intro HRE;
        do_repr_inj HRE;
        repeat (apply semax_extract_PROP; intro);
-       try rewrite Int.signed_repr in HRE by rep_lia;
+       try rewrite -> Int.signed_repr in HRE by rep_lia;
        repeat apply -> semax_skip_seq;
        abbreviate_semax
      |  simpl in v; clear HRE; subst v; apply semax_extract_PROP; intro HRE;
        do_repr_inj HRE;
        repeat (apply semax_extract_PROP; intro);
-       try rewrite Int.signed_repr in HRE by rep_lia;
+       try rewrite -> Int.signed_repr in HRE by rep_lia;
        repeat apply -> semax_skip_seq;
        abbreviate_semax
      ]
-| |- semax ?Delta (|> PROPx ?P (LOCALx ?Q (SEPx ?R))) (Ssequence (Sifthenelse ?e ?c1 ?c2) _) _ =>
+| |- semax _ ?Delta (▷ PROPx ?P (LOCALx ?Q (SEPx ?R))) (Ssequence (Sifthenelse ?e ?c1 ?c2) _) _ =>
     tryif (unify (orb (quickflow c1 nofallthrough) (quickflow c2 nofallthrough)) true)
     then (apply semax_if_seq; forward_if'_new)
-    else fail 1 "Because your if-statement is followed by another statement, you need to do 'forward_if Post', where Post is a postcondition of type (environ->mpred) or of type Prop"
-| |- semax _ (@exp _ _ _ _) _ _ =>
-      fail 1 "First use Intros ... to take care of the EXistentially quantified variables in the precondition"
-| |- semax _ _ (Sswitch _ _) _ =>
+    else fail 1 "Because your if-statement is followed by another statement, you need to do 'forward_if Post', where Post is a postcondition of type assert or of type Prop"
+| |- semax _ _ (@bi_exist _ _ _) _ _ =>
+      fail 1 "First use Intros ... to take care of the existentially quantified variables in the precondition"
+| |- semax _ _ _ (Sswitch _ _) _ =>
   forward_switch'
-| |- semax _ _ (Ssequence (Sifthenelse _ _ _) _) _ => 
+| |- semax _ _ _ (Ssequence (Sifthenelse _ _ _) _) _ => 
      fail 1 "forward_if failed for some unknown reason, perhaps your precondition is not in canonical form"
-| |- semax _ _ (Ssequence (Sswitch _ _) _) _ => 
-     fail 1 "Because your switch statement is followed by another statement, you need to do 'forward_if Post', where Post is a postcondition of type (environ->mpred) or of type Prop"
+| |- semax _ _ _ (Ssequence (Sswitch _ _) _) _ => 
+     fail 1 "Because your switch statement is followed by another statement, you need to do 'forward_if Post', where Post is a postcondition of type assert or of type Prop"
 end.
 
+Section FORWARD.
+Context `{!VSTGS OK_ty Σ}.
 Lemma ENTAIL_break_normal:
- forall Delta R S, ENTAIL Delta, RA_break (normal_ret_assert R) |-- S.
+ forall Delta R (S : assert), ENTAIL Delta, RA_break (normal_ret_assert R) ⊢ S.
 Proof.
-intros. simpl_ret_assert. apply andp_left2; apply FF_left.
+intros. simpl_ret_assert. rewrite bi.and_elim_r; apply bi.False_elim.
 Qed.
 
 Lemma ENTAIL_continue_normal:
- forall Delta R S, ENTAIL Delta, RA_continue (normal_ret_assert R) |-- S.
+ forall Delta R (S : assert), ENTAIL Delta, RA_continue (normal_ret_assert R) ⊢ S.
 Proof.
-intros. simpl_ret_assert. apply andp_left2; apply FF_left.
+intros. simpl_ret_assert. rewrite bi.and_elim_r; apply bi.False_elim.
 Qed.
 
 Lemma ENTAIL_return_normal:
- forall Delta R v S, ENTAIL Delta, RA_return (normal_ret_assert R) v |-- S.
+ forall Delta R v (S : assert), ENTAIL Delta, RA_return (normal_ret_assert R) v ⊢ S.
 Proof.
-intros. simpl_ret_assert. apply andp_left2; apply FF_left.
+intros. simpl_ret_assert. rewrite bi.and_elim_r; apply bi.False_elim.
 Qed.
+End FORWARD.
 
 #[export] Hint Resolve ENTAIL_break_normal ENTAIL_continue_normal ENTAIL_return_normal : core.
 
-#[export] Hint Extern 0 (ENTAIL _, _ |-- _) =>
- match goal with |- ENTAIL _, ?A |-- ?B => constr_eq A B; simple apply ENTAIL_refl end : core.
+#[export] Hint Extern 0 (ENTAIL _, _ ⊢ _) =>
+ match goal with |- ENTAIL _, ?A ⊢ ?B => constr_eq A B; simple apply ENTAIL_refl end : core.
 
 Ltac forward_if_tac post :=
   check_Delta; check_POSTCONDITION;
   repeat (apply -> seq_assoc; abbreviate_semax);
   repeat apply -> semax_seq_skip;
-first [ignore (post: environ->mpred)
-      | fail 1 "Invariant (first argument to forward_if) must have type (environ->mpred)"];
+first [ignore (post: assert)
+      | fail 1 "Invariant (first argument to forward_if) must have type assert"];
 match goal with
- | |- semax _ _ (Sifthenelse _ _ _) (overridePost post _) =>
+ | |- semax _ _ _ (Sifthenelse _ _ _) (overridePost post _) =>
        forward_if'_new
- | |- semax _ _ (Sswitch _ _) _ =>
+ | |- semax _ _ _ (Sswitch _ _) _ =>
        forward_switch'
- | |- semax _ _ (Sifthenelse _ _ _) ?P =>
+ | |- semax _ _ _ (Sifthenelse _ _ _) ?P =>
       apply (semax_post_flipped (overridePost post P));
       [ forward_if'_new
       | try subst P; unfold abbreviate;
@@ -2963,14 +2982,14 @@ match goal with
         try (match goal with |- ?A => no_evars A end;
              try apply ENTAIL_refl; 
              try solve [normalize])
-        .. 
+        ..
       ]
-   | |- semax _ _ (Ssequence (Sifthenelse _ _ _) _) _ =>
+   | |- semax _ _ _ (Ssequence (Sifthenelse _ _ _) _) _ =>
      apply semax_seq with post;
       [forward_if'_new 
       | abbreviate_semax; 
         simpl_ret_assert]
-   | |- semax _ _ (Ssequence (Sswitch _ _) _) _ =>
+   | |- semax _ _ _ (Ssequence (Sswitch _ _) _) _ =>
      apply semax_seq with post;
       [forward_switch' 
       | abbreviate_semax; 
@@ -3003,24 +3022,24 @@ Tactic Notation "forward_if" constr(post) :=
   lazymatch type of post with
   | Prop =>
       match goal with
-      | |- semax _ (PROPx (?P) ?Q) _ _ =>
+      | |- semax _ _ (PROPx (?P) ?Q) _ _ =>
           forward_if_tac (PROPx (post :: P) Q)
       end
   | list Prop =>
       match goal with
-      | |- semax _ (PROPx (?P) ?Q) _ _ =>
+      | |- semax _ _ (PROPx (?P) ?Q) _ _ =>
           let P' := eval cbv iota zeta beta delta [app] in (post ++ P) in
           forward_if_tac (PROPx P' Q)
       end
   | localdef =>
       match goal with
-      | |- semax _ (PROPx (?P) (LOCALx ?Q ?R)) _ _ =>
+      | |- semax _ _ (PROPx (?P) (LOCALx ?Q ?R)) _ _ =>
           let Q' := remove_LOCAL2 constr:(cons post nil) Q in
           forward_if_tac (PROPx (P) (LOCALx (post :: Q') R))
       end
   | list localdef =>
       match goal with
-      | |- semax _ (PROPx (?P) (LOCALx ?Q ?R)) _ _ =>
+      | |- semax _ _ (PROPx (?P) (LOCALx ?Q ?R)) _ _ =>
           let Q' := remove_LOCAL2 post Q in
           let Q'' := eval cbv iota zeta beta delta [app] in (post ++ Q') in
           forward_if_tac (PROPx (P) (LOCALx Q'' R))
@@ -3055,9 +3074,9 @@ Qed.
 Lemma eqb_su_refl s: eqb_su s s = true. Proof. unfold eqb_su. destruct s; trivial. Qed.
 Lemma Neqb_option_refl n: @eqb_option N N.eqb n n = true. Proof. destruct n; simpl; trivial. apply N.eqb_refl. Qed.
 Lemma eqb_attr_refl a: eqb_attr a a = true.
-Proof. unfold eqb_attr. destruct a. rewrite eqb_reflx, Neqb_option_refl; trivial. Qed.
+Proof. unfold eqb_attr. destruct a. rewrite eqb_reflx Neqb_option_refl; trivial. Qed.
 Lemma eqb_member_refl m: eqb_member m m = true.
-Proof. unfold eqb_member. destruct m. rewrite eqb_ident_true, eqb_type_refl; trivial.
+Proof. unfold eqb_member. destruct m. rewrite eqb_ident_true eqb_type_refl; trivial.
      rewrite eqb_ident_true. rewrite (proj2 (eqb_intsize_spec _ _) (eq_refl _)).
      rewrite (proj2 (eqb_signedness_spec _ _) (eq_refl _)).
       rewrite eqb_attr_refl. rewrite Z.eqb_refl.
@@ -3098,12 +3117,12 @@ Qed.
 
 Lemma test_aux_sym cs1 cs2 b i: test_aux cs1 cs2 b i = test_aux cs2 cs1 b i. 
 Proof. unfold test_aux. f_equal.
-  destruct ((@cenv_cs cs1) ! i); destruct ((@cenv_cs cs2) ! i); trivial.
-  rewrite eqb_list_sym, eqb_su_sym, eqb_member_sym, eqb_attr_sym; trivial.
+  destruct ((@cenv_cs cs1) !! i); destruct ((@cenv_cs cs2) !! i); trivial.
+  rewrite eqb_list_sym eqb_su_sym eqb_member_sym eqb_attr_sym; trivial.
 Qed.
 
 Lemma cs_preserve_type_sym cs1 cs2: forall t CCE, cs_preserve_type cs1 cs2 CCE t = cs_preserve_type cs2 cs1 CCE t. 
-Proof. induction t; simpl; trivial; intros; destruct (CCE ! i); trivial; apply test_aux_sym. Qed.
+Proof. induction t; simpl; trivial; intros; destruct (CCE !! i); trivial; apply test_aux_sym. Qed.
 
 
 Lemma subst_temp_special:
@@ -3111,20 +3130,22 @@ Lemma subst_temp_special:
    i <> j -> subst i e (`f (eval_id j)) = `f (eval_id j).
 Proof.
  intros.
- autorewrite with subst; auto.
+ unfold_lift. unfold subst. extensionality. f_equal.
+ unfold eval_id.
+ rewrite Map.gso //.
 Qed.
 #[export] Hint Rewrite subst_temp_special using safe_auto_with_closed: subst.
 
 Ltac ensure_normal_ret_assert :=
  match goal with
- | |- semax _ _ _ (normal_ret_assert _) => idtac
- | |- semax _ _ _ _ => apply sequential
+ | |- semax _ _ _ _ (normal_ret_assert _) => idtac
+ | |- semax _ _ _ _ _ => apply sequential
  end.
 
 Ltac ensure_open_normal_ret_assert :=
  try simple apply sequential';
  match goal with
- | |- semax _ _ _ (normal_ret_assert ?X) => is_evar X
+ | |- semax _ _ _ _ (normal_ret_assert ?X) => is_evar X
  end.
 
 Definition This_is_a_warning := tt.
@@ -3142,33 +3163,37 @@ Ltac warn s :=
    assert_ (Warning s
                IGNORE_THIS_WARNING_USING_THE_ack_TACTIC_IF_YOU_WISH).
 
+Section FORWARD.
+Context `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS : compspecs}.
 
 Lemma semax_post3:
-  forall R' Espec {cs: compspecs} Delta P c R,
-    (local (tc_environ Delta) && R' |-- R) ->
-    @semax cs Espec Delta P c (normal_ret_assert R') ->
-    @semax cs Espec Delta P c (normal_ret_assert R) .
+  forall E R' {cs: compspecs} Delta P c R,
+    (local (tc_environ Delta) ∧ R' ⊢ R) ->
+    semax E Delta P c (normal_ret_assert R') ->
+    semax E Delta P c (normal_ret_assert R) .
 Proof.
  intros. eapply semax_post'; [ | apply H0]. auto.
 Qed.
 
 Lemma semax_post_flipped3:
-  forall R' Espec {cs: compspecs} Delta P c R,
-    @semax cs Espec Delta P c (normal_ret_assert R') ->
-    (local (tc_environ Delta) && R' |-- R) ->
-    @semax cs Espec Delta P c (normal_ret_assert R) .
+  forall E R' {cs: compspecs} Delta P c R,
+    semax E Delta P c (normal_ret_assert R') ->
+    (local (tc_environ Delta) ∧ R' ⊢ R) ->
+    semax E Delta P c (normal_ret_assert R) .
 Proof.
 intros; eapply semax_post3; eauto.
 Qed.
 
+Local Notation PROPx := (@PROPx _ Σ).
 Lemma focus_make_args:
   forall A Q R R' Frame,
     R = R' ->
-    (A |-- PROPx nil (LOCALx Q (SEPx (R' :: Frame))))  ->
-    A |-- PROPx nil (LOCALx Q (SEPx (R :: Frame))) .
+    (A ⊢ PROPx nil (LOCALx Q (SEPx (R' :: Frame))))  ->
+    A ⊢ PROPx nil (LOCALx Q (SEPx (R :: Frame))) .
 Proof.
 intros; subst; auto.
 Qed.
+End FORWARD.
 
 Lemma subst_make_args1:
   forall i e j v,
@@ -3187,14 +3212,15 @@ Ltac check_sequential s :=
 
 Ltac sequential :=
  match goal with
- |  |- @semax _ _ _ _ (normal_ret_assert _) => fail 2
- |  |- @semax _ _ _ ?s _ =>  check_sequential s; apply sequential
+ |  |- semax _ _ _ _ (normal_ret_assert _) => fail 2
+ |  |- semax _ _ _ ?s _ =>  check_sequential s; apply sequential
  end.
 
 (* move these two elsewhere, perhaps entailer.v *)
 #[export] Hint Extern 1 (@sizeof _ ?A > 0) =>
    (let a := fresh in set (a:= sizeof A); hnf in a; subst a; computable)
   : valid_pointer.
+
 #[export] Hint Resolve denote_tc_test_eq_split : valid_pointer.
 
 Ltac pre_entailer :=
@@ -3214,14 +3240,14 @@ Ltac forward_setx :=
   ensure_normal_ret_assert;
   hoist_later_in_pre;
  match goal with
- | |- semax ?Delta (|> (PROPx ?P (LOCALx ?Q (SEPx ?R)))) (Sset _ ?e) _ =>
+ | |- semax _ ?Delta (▷ (PROPx ?P (LOCALx ?Q (SEPx ?R)))) (Sset _ ?e) _ =>
         eapply semax_PTree_set;
         [ prove_local2ptree
         | reflexivity
         | check_cast_assignment
         | solve_msubst_eval; simplify_casts; reflexivity
         | first [ quick_typecheck3
-                | pre_entailer; try solve [entailer!]]
+                | pre_entailer ; try solve [entailer!] ]
         ]
  end.
 
@@ -3239,17 +3265,24 @@ Ltac construct_nested_efield e e1 efs tts lr :=
     change e with (nested_efield e1 efs tts);
     clear pp.
 
-Lemma efield_denote_cons_array: forall {cs: compspecs} P efs gfs ei i,
-  (P |-- local (efield_denote efs gfs)) ->
-  (P |-- local (`(eq (Vint i)) (eval_expr ei))) ->
+Definition int_signed_or_unsigned (t: type) : int -> Z :=
+  match typeconv t with
+  | Tint _ Signed _ => Int.signed
+  | Tint _ Unsigned _ => Int.unsigned
+  | _ => fun _ => 0 (* bogus *)
+  end.
+
+Lemma efield_denote_cons_array: forall `{!VSTGS OK_ty Σ} {cs: compspecs} P efs gfs ei i,
+  (P ⊢ local(Σ:=Σ) (efield_denote efs gfs)) ->
+  (P ⊢ local (`(eq (Vint i)) (eval_expr ei))) ->
   is_int_type (typeof ei) = true ->
-  P |-- local (efield_denote (eArraySubsc ei :: efs) 
+  P ⊢ local (efield_denote (eArraySubsc ei :: efs) 
           (ArraySubsc (int_signed_or_unsigned (typeof ei) i) :: gfs)).
 Proof.
   intros.
-  rewrite (add_andp _ _ H), (add_andp _ _ H0), andp_assoc.
-  apply andp_left2.
-  intros rho; simpl; unfold local, lift1; unfold_lift; floyd.seplog_tactics.normalize.
+  rewrite (add_andp _ _ H) (add_andp _ _ H0) -bi.and_assoc.
+  rewrite bi.and_elim_r.
+  raise_rho; simpl; unfold local, lift1; unfold_lift; floyd.seplog_tactics.normalize.
   constructor; auto.
   2:   constructor; auto.
   clear - H1. destruct (typeof ei); inv H1.
@@ -3257,26 +3290,28 @@ Proof.
   rewrite <- H2.
   destruct (typeof ei); inv H1.
   unfold int_signed_or_unsigned. destruct i0,s; simpl;
-  rewrite ?Int.repr_signed, ?Int.repr_unsigned; auto. 
+  rewrite ?Int.repr_signed ?Int.repr_unsigned; auto. 
 Qed.
 
-Lemma efield_denote_cons_struct: forall {cs: compspecs} P efs gfs i,
-  (P |-- local (efield_denote efs gfs)) ->
-  P |-- local (efield_denote (eStructField i :: efs) (StructField i :: gfs)).
+Lemma efield_denote_cons_struct: forall `{!VSTGS OK_ty Σ} {cs: compspecs} P efs gfs i,
+  (P ⊢ local(Σ:=Σ) (efield_denote efs gfs)) ->
+  P ⊢ local (efield_denote (eStructField i :: efs) (StructField i :: gfs)).
 Proof.
   intros.
   eapply derives_trans; [exact H |].
-  intros rho; simpl; unfold local, lift1; unfold_lift; floyd.seplog_tactics.normalize.
+  raise_rho; simpl; unfold local, lift1; unfold_lift.
+  apply bi.pure_mono. intros.
   constructor; auto.
 Qed.
 
-Lemma efield_denote_cons_union: forall {cs: compspecs} P efs gfs i,
-  (P |-- local (efield_denote efs gfs)) ->
-  P |-- local (efield_denote (eUnionField i :: efs) (UnionField i :: gfs)).
+Lemma efield_denote_cons_union: forall `{!VSTGS OK_ty Σ} {cs: compspecs} P efs gfs i,
+  (P ⊢ local(Σ:=Σ) (efield_denote efs gfs)) ->
+  P ⊢ local (efield_denote (eUnionField i :: efs) (UnionField i :: gfs)).
 Proof.
   intros.
   eapply derives_trans; [exact H |].
-  intros rho; simpl; unfold local, lift1; unfold_lift; floyd.seplog_tactics.normalize.
+  raise_rho; simpl; unfold local, lift1; unfold_lift.
+  apply bi.pure_mono. intros.
   constructor; auto.
 Qed.
 
@@ -3366,7 +3401,7 @@ Ltac simple_value v :=
 
 Inductive undo_and_first__assert_PROP: Prop -> Prop := .
 
-Ltac default_entailer_for_store_tac := try solve [entailer!].
+Ltac default_entailer_for_store_tac := try solve [entailer!]. 
 
 Ltac entailer_for_store_tac := default_entailer_for_store_tac.
 
@@ -3382,13 +3417,12 @@ match goal with |- context [@proj_reptype ?cs ?t ?gfs ?v] =>
   remember (@proj_reptype cs t gfs v) as d eqn:Hd;
  unfold proj_reptype, proj_gfield_reptype, unfold_reptype,
    nested_field_type, nested_field_rec in Hd;
- rewrite ?eq_rect_r_eq, <- ?eq_rect_eq in Hd;
+ rewrite ->?eq_rect_r_eq, <- ?eq_rect_eq in Hd;
  simpl proj_struct in Hd;
- rewrite ?eq_rect_r_eq, <- ?eq_rect_eq in Hd;
+ rewrite ->?eq_rect_r_eq, <- ?eq_rect_eq in Hd;
   subst d
 end.
 
-
 Ltac store_tac :=
 ensure_open_normal_ret_assert;
 hoist_later_in_pre;
@@ -3398,17 +3432,18 @@ sc_set_load_store.store_tac.
 
 Ltac forward0 :=  (* USE FOR DEBUGGING *)
   match goal with
-  | |- @semax _ _ _ ?PQR (Ssequence ?c1 ?c2) ?PQR' =>
+  | |- semax(Σ := ?Σ) _ _ ?PQR (Ssequence ?c1 ?c2) ?PQR' =>
            let Post := fresh "Post" in
-              evar (Post : environ->mpred);
+              evar (Post : assert);
               apply semax_seq' with Post;
                [
                | unfold Post; clear Post ]
   end.
 
-Lemma bind_ret_derives t P Q v: (P |-- Q) -> bind_ret v t P |-- bind_ret v t Q.
-Proof. intros. destruct v. simpl; intros. entailer!. apply H.
-  destruct t; try apply derives_refl. simpl; intros. apply H. 
+Lemma bind_ret_derives `{!VSTGS OK_ty Σ} t P Q v: (P ⊢ Q) -> bind_ret(Σ:=Σ) v t P ⊢ bind_ret v t Q.
+Proof. intros. destruct v.
+  - simpl; intros. raise_rho. apply bi.and_mono. done. rewrite H. done.
+  - destruct t; try apply derives_refl. simpl; raise_rho. rewrite H. done. 
 Qed.
 
 Ltac entailer_for_return := entailer.
@@ -3419,7 +3454,7 @@ Ltac solve_return_inner_gen :=
   match goal with
   | |- return_inner_gen _ ?v ?P _ =>
     match P with
-    | exp _ =>
+    | bi_exist _ =>
       simple apply return_inner_gen_EX;
       let a := fresh "a" in
       intro a;
@@ -3445,22 +3480,22 @@ Ltac solve_return_inner_gen :=
     end
  end.
 
-Inductive fn_data_at {cs: compspecs} (Delta: tycontext) (T2: PTree.t (type * val)): ident * type -> mpred -> Prop :=
+Inductive fn_data_at `{!VSTGS OK_ty Σ} {cs: compspecs} (Delta: tycontext) (T2: PTree.t (type * val)): ident * type -> mpred -> Prop :=
 | fn_data_at_intro: forall i t p,
     (complete_legal_cosu_type t && (sizeof t <? Ptrofs.modulus) && is_aligned cenv_cs ha_env_cs la_env_cs t 0 = true)%bool ->
     msubst_eval_lvar Delta T2 i t = Some p ->
     fn_data_at Delta T2 (i, t) (data_at_ Tsh t p).
 
-Lemma canonicalize_stackframe: forall {cs: compspecs} Delta P Q R T1 T2 GV fn,
+Lemma canonicalize_stackframe: forall `{!VSTGS OK_ty Σ} {cs: compspecs} Delta P Q R T1 T2 GV fn,
   local2ptree Q = (T1, T2, nil, GV) ->
   Forall2 (fn_data_at Delta T2) fn R ->
-  local (tc_environ Delta) && PROPx P (LOCALx Q (SEPx R)) |-- fold_right sepcon emp (map (var_block Tsh) fn).
+  local (tc_environ Delta) ∧ PROPx P (LOCALx Q (SEPx R)) ⊢ fold_right bi_sep emp (map (var_block Tsh) fn).
 Proof.
   intros.
   induction H0.
   + go_lowerx.
-  + change (ENTAIL Delta, PROPx P (LOCALx Q (SEPx (y :: l'))) |-- var_block Tsh x * fold_right sepcon emp (map (var_block Tsh) l)).
-    eapply derives_trans; [| apply sepcon_derives; [apply derives_refl | exact IHForall2]]; clear IHForall2.
+  + change (ENTAIL Delta, PROPx P (LOCALx Q (SEPx (y :: l'))) ⊢ (var_block Tsh x ∗ fold_right bi_sep emp (map (var_block Tsh) l))).
+    eapply derives_trans; [| apply bi.sep_mono; [apply derives_refl | exact IHForall2]]; clear IHForall2.
     apply (local2ptree_soundness P Q (y :: l')) in H; simpl app in H.
     inv H0.
     rewrite !andb_true_iff in H2; destruct H2 as [[? ?] ?].
@@ -3468,13 +3503,15 @@ Proof.
     rewrite <- H in H3; clear H.
     rewrite (add_andp _ _ H3); clear H3.
     go_lowerx.
-    apply sepcon_derives; auto.
+    apply bi.sep_mono; auto.
     subst.
-    rewrite var_block_data_at_ by auto. apply derives_refl.
+    rewrite var_block_data_at_ //.
+    unfold is_aligned, is_aligned_aux. destruct H4 as [-> ->]. auto.
+    auto.
 Qed.
 
-Lemma canonicalize_stackframe_emp: forall {cs: compspecs} Delta P Q,
-  local (tc_environ Delta) && PROPx P (LOCALx Q (SEPx nil)) |-- emp.
+Lemma canonicalize_stackframe_emp: forall `{!VSTGS OK_ty Σ} {cs: compspecs} Delta P Q,
+  local (tc_environ Delta) ∧ PROPx(Σ:=Σ) P (LOCALx Q (SEPx nil)) ⊢ emp.
 Proof.
   intros.
   go_lowerx.
@@ -3495,58 +3532,66 @@ Ltac solve_canon_derives_stackframe :=
       ]
     ].
 
+Lemma False_sep :
+  forall {prop:bi} (P:prop), False ∗ P ⊣⊢ False.
+Proof. intros. iSplit.
+  - iIntros "[$ _]".
+  - iApply bi.False_elim.
+Qed.
+
 Ltac fold_frame_function_body :=
 match goal with P := @abbreviate ret_assert _ |- _ => unfold abbreviate in P; subst P end;
-match goal with |- semax _ _ _ ?R =>
- match R with {| RA_return := (fun vl rho => bind_ret _ ?t ?P _ * stackframe_of ?f _) |} =>
+match goal with |- semax _ _ _ _ ?R =>
+ match R with {| RA_return := (fun vl rho => bind_ret _ ?t ?P _ ∗ stackframe_of ?f _) |} =>
   apply semax_post with (frame_ret_assert (function_body_ret_assert t P) (stackframe_of f));
-   [ simpl_ret_assert; rewrite FF_sepcon; apply andp_left2; apply FF_left
-   | simpl_ret_assert; rewrite FF_sepcon; apply andp_left2; apply FF_left
-   | simpl_ret_assert; rewrite FF_sepcon; apply andp_left2; apply FF_left
+   [ simpl_ret_assert; rewrite False_sep; apply bi.and_elim_r; apply bi.False_elim
+   | simpl_ret_assert; rewrite False_sep; apply bi.and_elim_r; apply bi.False_elim
+   | simpl_ret_assert; rewrite False_sep; apply bi.and_elim_r; apply bi.False_elim
    | simpl_ret_assert; solve [auto]
    |]
  end
 end.
 
 Lemma fold_another_var_block:
-  forall {cs: compspecs} Delta P Q R P' Q' R' i (t: type) vbs T1 T2 GV p,
+  forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS : compspecs}
+  Delta P Q R P' Q' R' i (t: type) vbs T1 T2 GV p,
   local2ptree Q = (T1,T2,[],GV) ->
   complete_legal_cosu_type t = true ->
   sizeof t <? Ptrofs.modulus = true ->
   is_aligned cenv_cs ha_env_cs la_env_cs t 0 = true ->
-  (var_types Delta) ! i = Some t ->
-  T2 ! i = Some (t,p) ->
+  (var_types Delta) !! i = Some t ->
+  T2 !! i = Some (t,p) ->
   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) 
-      |-- PROPx P' (LOCALx Q' (SEPx (data_at_ Tsh t p :: R')))
-             * fold_right sepcon emp (map (var_block Tsh) vbs) ->
+      ⊢ (PROPx P' (LOCALx Q' (SEPx (data_at_ Tsh t p :: R')))
+             ∗ fold_right bi_sep emp (map (var_block Tsh) vbs)) ->
   ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) 
-    |-- PROPx P' (LOCALx Q' (SEPx R')) 
-           * fold_right sepcon emp (map (var_block Tsh) ((i,t)::vbs)).
+    ⊢ (PROPx P' (LOCALx Q' (SEPx R')) 
+           ∗ fold_right bi_sep emp (map (var_block Tsh) ((i,t)::vbs))).
 Proof.
-intros until 1.
-intros H1 H2 H3 H4 H5 H0.
+intros until p.
+intros H H1 H2 H3 H4 H5 H0.
 set (r1 := data_at_ Tsh t p) in *.
-change (ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- 
-    PROPx P' (LOCALx Q' (SEPx R')) * (var_block Tsh (i,t) * fold_right sepcon emp (map (var_block Tsh) vbs))).
-forget  (fold_right sepcon emp (map (var_block Tsh) vbs)) as VBS.
-replace (PROPx P' (LOCALx Q' (SEPx (r1 :: R'))) * VBS)
-   with (PROPx P' (LOCALx Q' (SEPx R')) * (liftx r1 * VBS)) in H0.
-2:{
-  extensionality rho;
+change (ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢ 
+    (PROPx P' (LOCALx Q' (SEPx R')) ∗ (var_block Tsh (i,t) ∗ fold_right bi_sep emp (map (var_block Tsh) vbs)))).
+forget  (fold_right bi_sep emp (map (var_block Tsh) vbs)) as VBS.
+assert  ((PROPx P' (LOCALx Q' (SEPx (r1 :: R'))) ∗ VBS) ⊣⊢
+         ((PROPx P' (LOCALx Q' (SEPx R'))) ∗ ((assert_of (` r1 )) ∗ VBS))).
+{
+  raise_rho;
  unfold PROPx, LOCALx, SEPx; unfold_lift; simpl.
  unfold local, lift1.
- floyd.seplog_tactics.normalize. f_equal. rewrite <- sepcon_assoc.
+ floyd.seplog_tactics.normalize. rewrite bi.sep_assoc.
  pull_left r1. auto.
 }
+rewrite H6 in H0; clear H6.
 apply derives_trans with
-((local (tc_environ Delta) &&  PROPx P (LOCALx Q (SEPx R))) 
-   && (local (tc_environ Delta) &&  PROPx nil (LOCALx Q (SEPx(TT::nil))))).
+((local (tc_environ Delta) ∧  PROPx P (LOCALx Q (SEPx R))) 
+   ∧ (local (tc_environ Delta) ∧  PROPx nil (LOCALx Q (SEPx(True::nil))))).
 go_lowerx.
-repeat apply andp_right; auto; try apply prop_right; auto.
-rewrite sepcon_emp. apply TT_right.
-erewrite (local2ptree_soundness nil Q) by eassumption.
+repeat apply bi.and_intro; auto; try apply bi.pure_intro; auto.
+rewrite ->(local2ptree_soundness nil Q) by eassumption.
 eapply derives_trans.
-apply andp_derives.
+apply bi.and_mono.
 apply H0. apply derives_refl.
 forget (PROPx P' (LOCALx Q' (SEPx R'))) as PQR'.
 clear H0.
@@ -3555,39 +3600,38 @@ inv H1.
 assert (  msubst_extract_local Delta T1 T2 GV (lvar i t p)).
 hnf.
 rewrite H5. rewrite eqb_type_refl. auto.
-apply localdef_local_facts_inv with (P:=nil)(R := [TT]) in H0.
+apply localdef_local_facts_inv with (P:=nil)(R := [True]) in H0.
 forget (LocalD T1 T2 GV) as L.
 eapply derives_trans with
-(PQR' * (liftx r1 * VBS) && 
-(local (tc_environ Delta) && local (locald_denote (lvar i t p)))).
-apply andp_derives; auto.
-apply andp_right.
-apply andp_left1; auto.
-auto.
+((PQR' ∗ (assert_of (` r1) ∗ VBS)) ∧ 
+ (local (tc_environ Delta) ∧ local (locald_denote (lvar i t p)))).
+apply bi.and_mono; auto.
+apply bi.and_intro; auto.
+apply bi.and_elim_l; auto.
 go_lowerx.
 normalize.
-apply sepcon_derives; auto.
-apply sepcon_derives; auto.
+apply bi.sep_mono; auto.
+apply bi.sep_mono; auto.
 eapply var_block_lvar0; try eassumption.
 apply Z.ltb_lt; auto.
 Qed.
 
 Lemma no_more_var_blocks:
- forall {cs: compspecs} Delta PQR PQR',
-  ENTAIL Delta, PQR |-- PQR' ->
-  ENTAIL Delta, PQR |-- PQR' * fold_right sepcon emp (map (var_block Tsh) []).
+ forall `{!VSTGS OK_ty Σ} {cs: compspecs} Delta PQR PQR',
+  ENTAIL Delta, PQR ⊢ PQR' ->
+  ENTAIL Delta, PQR ⊢ (PQR' ∗ fold_right bi_sep emp (map (var_block Tsh) [])).
 Proof.
 intros.
 unfold map.
 unfold fold_right.
-rewrite sepcon_emp.
+rewrite bi.sep_emp.
 auto.
 Qed.
 
 Ltac try_clean_up_stackframe :=
   lazymatch goal with |-
-     ENTAIL _, PROPx _ (LOCALx _ (SEPx _)) |--
-        PROPx _ (LOCALx _ (SEPx _)) * stackframe_of _ =>
+     ENTAIL _, PROPx _ (LOCALx _ (SEPx _)) ⊢
+        PROPx _ (LOCALx _ (SEPx _)) ∗ stackframe_of _ =>
      unfold stackframe_of;
      simpl fn_vars;
      repeat (
@@ -3600,8 +3644,8 @@ Ltac try_clean_up_stackframe :=
 
 Ltac clean_up_stackframe ::=
   lazymatch goal with |-
-     ENTAIL _, PROPx _ (LOCALx _ (SEPx _)) |--
-        PROPx _ (LOCALx _ (SEPx _)) * stackframe_of _ =>
+     ENTAIL _, PROPx _ (LOCALx _ (SEPx _)) ⊢
+        PROPx _ (LOCALx _ (SEPx _)) ∗ stackframe_of _ =>
      unfold stackframe_of;
      simpl fn_vars;
      repeat (
@@ -3609,9 +3653,9 @@ Ltac clean_up_stackframe ::=
        [reflexivity | reflexivity | reflexivity | reflexivity | reflexivity 
          | reflexivity | ]);
      try simple apply no_more_var_blocks
-  | |- ENTAIL _ , _ |-- exp _ * stackframe_of _ =>
+  | |- ENTAIL _ , _ ⊢ bi_exist _ ∗ stackframe_of _ =>
       fail 2 "In this case, because stackframe_of is present, use Exists to instantiate the existential before calling entailer!"
-  | |- ENTAIL _ , _ |-- exp ?P =>
+  | |- ENTAIL _ , _ ⊢ bi_exist ?P =>
         lazymatch P with context [@stackframe_of] => 
          fail 2 "In this case, because stackframe_of is present, use Exists to instantiate the existential before calling entailer!"
        | _ => idtac
@@ -3622,7 +3666,7 @@ Ltac clean_up_stackframe ::=
 Ltac forward_return :=
   try fold_frame_function_body;
   match goal with
-  | |- @semax ?CS _ ?Delta ?Pre (Sreturn ?oe) _ =>
+  | |- @semax _ _ _ _ ?CS _ ?Delta ?Pre (Sreturn ?oe) _ =>
     match oe with
     | None =>
         eapply semax_return_None;
@@ -3688,14 +3732,14 @@ Ltac no_loads_expr e as_lvalue :=
  | Ealignof _ _ => idtac
 end.
 
-Definition Undo__Then_do__forward_call_W__where_W_is_a_witness_whose_type_is_given_above_the_line_now := False.
+Definition Undo__Then_do__forward_call_W__where_W_is_a_witness_whose_type_is_given_above_the_line_now := (False:Prop).
 
 Ltac advise_forward_call :=
- prove_call_setup1 funspec_sub_refl;
+ prove_call_setup1 funspec_sub_refl_dep;
  [ .. | 
  match goal with |- call_setup1 _ _ _ _ _ _ _ _ _ _ _ _ _ ?A _ _ _ _ _ _ _ -> _ =>
   lazymatch A with
-  | rmaps.ConstType ?T => 
+  | ConstType ?T => 
              fail "To prove this function call, use forward_call(W), where
 W:"T"
 is a WITH-clause witness"
@@ -3705,15 +3749,15 @@ end].
 
 Ltac advise_prepare_postcondition := 
  match goal with
- | Post' := _ : ret_assert |- semax _ _ _ ?Post =>
+ | Post' := _ : ret_assert |- semax _ _ _ _ ?Post =>
      tryif (constr_eq Post' Post) then (unfold abbreviate in Post'; subst Post') else idtac
  end;
  lazymatch goal with
- | Delta' := @abbreviate tycontext _ |- semax ?Delta _ _ _ =>
+ | Delta' := @abbreviate tycontext _ |- semax _ ?Delta _ _ _ =>
      tryif (constr_eq Delta' Delta)
        then idtac
        else fail "Please use abbreviate_semax to put your proof goal into standard form" 
- | |- semax _ _ _ _ => fail "Please use abbreviate_semax to put your proof goal into standard form."
+ | |- semax _ _ _ _ _ => fail "Please use abbreviate_semax to put your proof goal into standard form."
  | |- _ => fail "Proof goal is not (semax _ _ _ _)."
  end;
  repeat match goal with
@@ -3727,57 +3771,57 @@ Ltac forward_advise_loop c :=
  try lazymatch c with
  | Sfor _ _ Sskip ?body =>
         unify (nobreaksx body) true;
-        fail "Use [forward; forward_while Inv] to prove this loop, where Inv is a loop invariant of type (environ->mpred)"
+        fail "Use [forward; forward_while Inv] to prove this loop, where Inv is a loop invariant of type assert"
  | Swhile _ ?body =>
         unify (nobreaksx body) true;
-        fail "Use [forward_while Inv] to prove this loop, where Inv is a loop invariant of type (environ->mpred)"
+        fail "Use [forward_while Inv] to prove this loop, where Inv is a loop invariant of type assert"
  | Sloop (Ssequence (Sifthenelse _ Sbreak Sskip) ?body) Sskip =>
         unify (nobreaksx body) true;
-        fail "Use [forward_while Inv] to prove this loop, where Inv is a loop invariant of type (environ->mpred)"
+        fail "Use [forward_while Inv] to prove this loop, where Inv is a loop invariant of type assert"
  end;
  lazymatch c with
   | Sfor _ ?test ?body ?incr  =>
        tryif (unify (nobreaksx body) true; test_simple_bound test incr)
-       then fail "You can probably use [forward_for_simple_bound n Inv], provided that the upper bound of your loop can be expressed as a constant value (n:Z), and the loop invariant Inv can be expressed as (EX i:Z, ...).  Note that the Inv should not mention the LOCAL binding of the loop-count variable to the value i, and need not assert the PROP that i<=n; these will be inserted automatically.
-Otherwise, you can use the general case: Use [forward_loop Inv] to prove this loop, where Inv is a loop invariant of type (environ -> mpred).  The [forward_loop] tactic will advise you if you need continue: or break: assertions in addition"
-       else fail "Use [forward_loop Inv] to prove this loop, where Inv is a loop invariant of type (environ -> mpred).  The [forward_loop] tactic will advise you if you need continue: or break: assertions in addition"
+       then fail "You can probably use [forward_for_simple_bound n Inv], provided that the upper bound of your loop can be expressed as a constant value (n:Z), and the loop invariant Inv can be expressed as (∃ i:Z, ...).  Note that the Inv should not mention the LOCAL binding of the loop-count variable to the value i, and need not assert the PROP that i<=n; these will be inserted automatically.
+Otherwise, you can use the general case: Use [forward_loop Inv] to prove this loop, where Inv is a loop invariant of type assert.  The [forward_loop] tactic will advise you if you need continue: or break: assertions in addition"
+       else fail "Use [forward_loop Inv] to prove this loop, where Inv is a loop invariant of type assert.  The [forward_loop] tactic will advise you if you need continue: or break: assertions in addition"
   | Sloop _ _ =>
-     fail "Use [forward_loop Inv] to prove this loop, where Inv is a loop invariant of type (environ -> mpred).  The [forward_loop] tactic will advise you if you need continue: or break: assertions in addition"
+     fail "Use [forward_loop Inv] to prove this loop, where Inv is a loop invariant of type assert.  The [forward_loop] tactic will advise you if you need continue: or break: assertions in addition"
  end.
 
 Ltac forward_advise_for :=
  lazymatch goal with
- | |- semax _ _ (Sfor _ _ ?body Sskip) ?R =>
+ | |- semax _ _ _ (Sfor _ _ ?body Sskip) ?R =>
        tryif unify (no_breaks body) true
-       then fail "Use [forward_while Inv] to prove this loop, where Inv is a loop invariant of type (environ->mpred)"
+       then fail "Use [forward_while Inv] to prove this loop, where Inv is a loop invariant of type assert"
        else tryif has_evar R
-            then fail "Use [forward_for Inv Inv Post] to prove this loop, where Inv is a loop invariant of type (A -> environ -> mpred), and Post is a loop-postcondition. A is the type of whatever loop-varying quantity you have, such as the value of your loop iteration variable.  You can use the same Inv twice, before and after the for-loop-increment statement, because your for-loop-increment statement is trivial"
-            else fail "Use [forward_for Inv Inv] to prove this loop, where Inv is a loop invariant of type (A -> environ -> mpred).  A is the type of whatever loop-varying quantity you have, such as your loop iteration variable.  You can use the same Inv twice, before and after the for-loop-increment statement, because your for-loop-increment statement is trivial"
-  | |- semax _ _ (Sfor _ ?test ?body ?incr) ?R =>
+            then fail "Use [forward_for Inv Inv Post] to prove this loop, where Inv is a loop invariant of type (A -> assert), and Post is a loop-postcondition. A is the type of whatever loop-varying quantity you have, such as the value of your loop iteration variable.  You can use the same Inv twice, before and after the for-loop-increment statement, because your for-loop-increment statement is trivial"
+            else fail "Use [forward_for Inv Inv] to prove this loop, where Inv is a loop invariant of type (A -> assert).  A is the type of whatever loop-varying quantity you have, such as your loop iteration variable.  You can use the same Inv twice, before and after the for-loop-increment statement, because your for-loop-increment statement is trivial"
+  | |- semax _ _ _ (Sfor _ ?test ?body ?incr) ?R =>
        tryif has_evar R
        then tryif unify (no_breaks body) true
                then tryif test_simple_bound test incr
-                  then fail "You can probably use [forward_for_simple_bound n Inv], provided that the upper bound of your loop can be expressed as a constant value (n:Z), and the loop invariant Inv can be expressed as (EX i:Z, ...).  Note that the Inv need not mention the LOCAL binding of the loop-count variable to the value i, and need not assert the PROP that i<=n; these will be inserted automatically.
+                  then fail "You can probably use [forward_for_simple_bound n Inv], provided that the upper bound of your loop can be expressed as a constant value (n:Z), and the loop invariant Inv can be expressed as (∃ i:Z, ...).  Note that the Inv need not mention the LOCAL binding of the loop-count variable to the value i, and need not assert the PROP that i<=n; these will be inserted automatically.
 Otherwise, you can use the general case:
-Use [forward_for Inv PreInc] to prove this loop, where Inv is a loop invariant of type (A -> environ -> mpred), and PreInc is the invariant (of the same type) just before the for-loop-increment statement"
-                  else fail "Use [forward_for Inv PreInc] to prove this loop, where Inv is a loop invariant of type (A -> environ -> mpred), and PreInc is the invariant (of the same type) just before the for-loop-increment statement"
-               else fail "Use [forward_for Inv PreInc Post] to prove this loop, where Inv is a loop invariant of type (A -> environ -> mpred), PreInc is the invariant (of the same type) just before the for-loop-increment statement, and  Post is a loop-postcondition"
+Use [forward_for Inv PreInc] to prove this loop, where Inv is a loop invariant of type (A -> assert), and PreInc is the invariant (of the same type) just before the for-loop-increment statement"
+                  else fail "Use [forward_for Inv PreInc] to prove this loop, where Inv is a loop invariant of type (A -> assert), and PreInc is the invariant (of the same type) just before the for-loop-increment statement"
+               else fail "Use [forward_for Inv PreInc Post] to prove this loop, where Inv is a loop invariant of type (A -> assert), PreInc is the invariant (of the same type) just before the for-loop-increment statement, and  Post is a loop-postcondition"
        else tryif test_simple_bound test incr
-               then fail "You can probably use [forward_for_simple_bound n Inv], provided that the upper bound of your loop can be expressed as a constant value (n:Z), and the loop invariant Inv can be expressed as (EX i:Z, ...).  Note that the Inv need not mention the LOCAL binding of the loop-count variable to the value i, and need not assert the PROP that i<=n; these will be inserted automatically.
+               then fail "You can probably use [forward_for_simple_bound n Inv], provided that the upper bound of your loop can be expressed as a constant value (n:Z), and the loop invariant Inv can be expressed as (∃ i:Z, ...).  Note that the Inv need not mention the LOCAL binding of the loop-count variable to the value i, and need not assert the PROP that i<=n; these will be inserted automatically.
 Otherwise, you can use the general case:
-Use [forward_for Inv PreInc] to prove this loop, where Inv is a loop invariant of type (A -> environ -> mpred), and PreInc is the invariant (of the same type) for just before the for-loop-increment statement"
-               else fail "Use [forward_for Inv PreInc] to prove this loop, where Inv is a loop invariant of type (A -> environ -> mpred), and PreInc is the invariant (of the same type) for just before the for-loop-increment statement"
+Use [forward_for Inv PreInc] to prove this loop, where Inv is a loop invariant of type (A -> assert), and PreInc is the invariant (of the same type) for just before the for-loop-increment statement"
+               else fail "Use [forward_for Inv PreInc] to prove this loop, where Inv is a loop invariant of type (A -> assert), and PreInc is the invariant (of the same type) for just before the for-loop-increment statement"
   end.
 
 
 Ltac forward_advise_if := 
   advise_prepare_postcondition;
  lazymatch goal with
-   | |- semax _ _ (Sifthenelse _ _ _) ?R =>
+   | |- semax _ _ _ (Sifthenelse _ _ _) ?R =>
        tryif has_evar R
        then fail "Use [forward_if Post] to prove this if-statement, where Post is the postcondition of both branches, or try simply 'forward_if' without a postcondition to see if that is permitted in this case"
        else fail "Use [forward_if] to prove this if-statement; you don't need to supply a postcondition"
-   | |- semax _ _ (Sswitch _ _) ?R =>
+   | |- semax _ _ _ (Sswitch _ _) ?R =>
        tryif has_evar R
        then fail "Use [forward_if Post] to prove this switch-statement, where Post is the postcondition of all branches, or try simply 'forward_if' without a postcondition to see if that is permitted in this case"
        else fail "Use [forward_if] to prove this switch-statement; you don't need to supply a postcondition"
@@ -3786,7 +3830,7 @@ Ltac forward_advise_if :=
 Ltac forward_advise_while := 
   advise_prepare_postcondition;
  lazymatch goal with
-   | |- semax _ _ (Swhile _ _) _ =>
+   | |- semax _ _ _ (Swhile _ _) _ =>
        fail "Use [forward_while Inv] to prove this loop, where Inv is the loop invariant"
   end.
 
@@ -3822,10 +3866,10 @@ eapply semax_pre; [ | apply semax_continue ];
 
 Ltac simpl_first_temp :=
 try match goal with
-| |- semax _ (PROPx _ (LOCALx (temp _ ?v :: _) _)) _ _ =>
+| |- semax _ _ (PROPx _ (LOCALx (temp _ ?v :: _) _)) _ _ =>
   let x := fresh "x" in set (x:=v);
          simpl in x; unfold x; clear x
-| |- (PROPx _ (LOCALx (temp _ ?v :: _) _)) |-- _ =>
+| |- (PROPx _ (LOCALx (temp _ ?v :: _) _)) ⊢ _ =>
   let x := fresh "x" in set (x:=v);
          simpl in x; unfold x; clear x
 end.
@@ -3837,7 +3881,7 @@ Lemma lt_repr_zlt:
 Proof.
 intros.
 unfold Int.lt.
-rewrite !Int.signed_repr by rep_lia.
+rewrite ->!Int.signed_repr by rep_lia.
 reflexivity.
 Qed.
 
@@ -3849,7 +3893,7 @@ Lemma lt64_repr_zlt:
 Proof.
 intros.
 unfold Int64.lt.
-rewrite !Int64.signed_repr by rep_lia.
+rewrite ->!Int64.signed_repr by rep_lia.
 reflexivity.
 Qed.
 
@@ -3861,7 +3905,7 @@ Lemma ltptrofs_repr_zlt:
 Proof.
 intros.
 unfold Ptrofs.lt.
-rewrite !Ptrofs.signed_repr by rep_lia.
+rewrite ->!Ptrofs.signed_repr by rep_lia.
 reflexivity.
 Qed.
 
@@ -3872,7 +3916,7 @@ Lemma ltu_repr_zlt:
 Proof.
 intros.
 unfold Int.ltu.
-rewrite !Int.unsigned_repr by rep_lia.
+rewrite ->!Int.unsigned_repr by rep_lia.
 reflexivity.
 Qed.
 
@@ -3883,7 +3927,7 @@ Lemma ltu64_repr_zlt:
 Proof.
 intros.
 unfold Int64.ltu.
-rewrite !Int64.unsigned_repr by rep_lia.
+rewrite ->!Int64.unsigned_repr by rep_lia.
 reflexivity.
 Qed.
 
@@ -3894,7 +3938,7 @@ Lemma ltuptrofs_repr_zlt:
 Proof.
 intros.
 unfold Ptrofs.ltu.
-rewrite !Ptrofs.unsigned_repr by rep_lia.
+rewrite ->!Ptrofs.unsigned_repr by rep_lia.
 reflexivity.
 Qed.
 
@@ -3905,7 +3949,7 @@ Lemma eq_repr_zeq:
 Proof.
 intros.
 unfold Int.eq.
-rewrite !Int.unsigned_repr by rep_lia.
+rewrite ->!Int.unsigned_repr by rep_lia.
 reflexivity.
 Qed.
 
@@ -3916,7 +3960,7 @@ Lemma eq64_repr_zeq:
 Proof.
 intros.
 unfold Int64.eq.
-rewrite !Int64.unsigned_repr by rep_lia.
+rewrite ->!Int64.unsigned_repr by rep_lia.
 reflexivity.
 Qed.
 
@@ -3927,7 +3971,7 @@ Lemma eqptrofs_repr_zeq:
 Proof.
 intros.
 unfold Ptrofs.eq.
-rewrite !Ptrofs.unsigned_repr by rep_lia.
+rewrite ->!Ptrofs.unsigned_repr by rep_lia.
 reflexivity.
 Qed.
 
@@ -3962,9 +4006,9 @@ Ltac simplify_new_temp' e :=
 
 Ltac simplify_new_temp :=
  lazymatch goal with
- | |- semax _ (PROPx _ (LOCALx (temp _ ?e :: _) _)) _ _ =>
+ | |- semax _ _ (PROPx _ (LOCALx (temp _ ?e :: _) _)) _ _ =>
        try simplify_new_temp' e
- | |- ENTAIL _, PROPx _ (LOCALx (temp _ ?e :: _) _) |-- _ =>
+ | |- ENTAIL _, PROPx _ (LOCALx (temp _ ?e :: _) _) ⊢ _ =>
        try simplify_new_temp' e
  | |- _ => idtac
 end.
@@ -3984,14 +4028,14 @@ Ltac fwd_result :=
 
 Ltac check_precondition :=
   lazymatch goal with
-  | |- semax _ (PROPx _ (LOCALx _ (SEPx ?R))) _ _ => 
-    lazymatch R with context [sepcon _ _ :: _] =>
+  | |- semax _ _ (PROPx _ (LOCALx _ (SEPx ?R))) _ _ => 
+    lazymatch R with context [bi_sep _ _ :: _] =>
         fail "The SEP clause of the precondition contains * (separating conjunction).
 You must flatten the SEP clause, e.g. by doing [Intros],
 or else hide the * by making a Definition or using a freezer"
        | _ => idtac
     end
-  | |- semax _ (exp _) _ _ => 
+  | |- semax _ _ (bi_exist _) _ _ => 
              fail 3 "Before going 'forward', you need to move the existentially quantified variable at the head of your precondition 'above the line'.  Do this by the tactic 'Intros x', where 'x' is the name you want to give to this Coq variable"
   | |- _ => fail "Your precondition is not in canonical form (PROP (..) LOCAL (..) SEP (..))"
  end.
@@ -4038,7 +4082,7 @@ end.
 
 Ltac forward :=
  lazymatch goal with
- | |- ENTAIL _, _ |-- _ * stackframe_of _ =>
+ | |- ENTAIL _, _ ⊢ _ ∗ stackframe_of _ =>
      (* backward-compatibility hack *)
       clean_up_stackframe; entailer_for_return
  | |- _ =>
@@ -4046,26 +4090,26 @@ Ltac forward :=
   check_Delta; check_POSTCONDITION;
   repeat rewrite <- seq_assoc;
   lazymatch goal with 
-  | |- semax _ _ (Ssequence (Sreturn _) _) _ =>
-    apply semax_seq with FF; [ | apply semax_ff];
+  | |- semax _ _ _ (Ssequence (Sreturn _) _) _ =>
+    apply semax_seq with False; [ | apply semax_ff];
     clear_Delta_specs; forward_return
-  | |- semax _ _ (Sreturn _) _ =>  clear_Delta_specs; forward_return
-  | |- semax _ _ (Ssequence Sbreak _) _ =>
-    apply semax_seq with FF; [ | apply semax_ff];  forward_break
-  | |- semax _ _ (Ssequence Scontinue _) _ =>
-    apply semax_seq with FF; [ | apply semax_ff];  forward_continue
-  | |- semax _ _ Sbreak _ => forward_break
-  | |- semax _ _ Scontinue _ => forward_continue
-  | |- semax _ _ Sskip _ => fwd_skip
-  | |- semax _ _ ?c0 _ =>
+  | |- semax _ _ _ (Sreturn _) _ =>  clear_Delta_specs; forward_return
+  | |- semax _ _ _ (Ssequence Sbreak _) _ =>
+    apply semax_seq with False; [ | apply semax_ff];  forward_break
+  | |- semax _ _ _ (Ssequence Scontinue _) _ =>
+    apply semax_seq with False; [ | apply semax_ff];  forward_continue
+  | |- semax _ _ _ Sbreak _ => forward_break
+  | |- semax _ _ _ Scontinue _ => forward_continue
+  | |- semax _ _ _ Sskip _ => fwd_skip
+  | |- semax _ _ _ ?c0 _ =>
     match c0 with
     | Ssequence _ _ => idtac
     | _ => rewrite -> semax_seq_skip
     end;
     match goal with
-    | |- semax _ _ (Ssequence (Sassign (Efield ?e1 ?id1 ?t1) _) ?s2) _ =>
+    | |- semax _ _ _ (Ssequence (Sassign (Efield ?e1 ?id1 ?t1) _) ?s2) _ =>
            try_forward_store_union_hack e1 s2 id1 t1
-    | |- semax _ _ (Ssequence ?c _) _ =>
+    | |- semax _ _ _ (Ssequence ?c _) _ =>
       check_precondition;
       check_unfold_mpred_for_at;
       eapply semax_seq';
@@ -4079,22 +4123,28 @@ Ltac forward :=
  end.
 
 Lemma start_function_aux1:
-  forall (Espec: OracleKind) {cs: compspecs} Delta R1 P Q R c Post,
-   semax Delta (PROPx P (LOCALx Q (SEPx (R1::R)))) c Post ->
-   semax Delta ((PROPx P (LOCALx Q (SEPx R))) * `R1) c Post.
+  forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS : compspecs}
+         E Delta R1 P Q R c Post,
+    semax E Delta (PROPx P (LOCALx Q (SEPx (R1::R)))) c Post ->
+    semax E Delta ((PROPx P (LOCALx Q (SEPx R))) ∗ (assert_of (`R1))) c Post.
 Proof.
 intros.
-rewrite sepcon_comm. rewrite insert_SEP. apply H.
+rewrite bi.sep_comm. unfold_lift.
+assert (assert_of (λ _ : environ, R1) ⊣⊢ ⎡R1⎤). { raise_rho. reflexivity. }
+rewrite H0.
+rewrite insert_SEP. apply H.
 Qed.
 
 Lemma semax_stackframe_emp:
- forall Espec {cs: compspecs} Delta P c R,
- @semax cs Espec Delta P c R ->
-  @semax cs Espec Delta (P * emp) c (frame_ret_assert R emp) .
-Proof. intros.
-            rewrite sepcon_emp;
-            rewrite frame_ret_assert_emp;
-   auto.
+  forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS : compspecs}
+         E Delta P c R,
+    semax E Delta P c R ->
+    semax E Delta (P ∗ emp) c (frame_ret_assert R emp) .
+Proof. 
+intros.
+rewrite bi.sep_emp.
+rewrite frame_ret_assert_emp;
+auto.
 Qed.
 
 Definition must_return (ek: exitkind) : bool :=
@@ -4108,29 +4158,30 @@ Ltac make_func_ptr id :=
   | split; reflexivity | ].
 
 Lemma gvars_denote_HP':
- forall Delta P Q R gv i, 
+ forall `{!VSTGS OK_ty Σ} Delta P Q R gv i, 
   In (gvars gv) Q ->
-  isSome ((glob_types Delta) ! i) ->
-  ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- !! headptr (gv i).
+  isSome ((glob_types Delta) !! i) ->
+  ENTAIL Delta, PROPx(Σ := Σ) P (LOCALx Q (SEPx R)) ⊢ ⌜headptr (gv i)⌝.
 Proof.
 intros.
-intro rho.
+remember (PROPx P (LOCALx Q (SEPx R))) as PQR.
+raise_rho.
 unfold local, lift1.
-simpl.
-normalize.
-destruct ((glob_types Delta) ! i) eqn:?H; try contradiction.
+subst.
+apply bi.pure_elim_l => ?.
+destruct ((glob_types Delta) !! i) eqn:?H; try contradiction.
 eapply derives_trans.
 apply in_local'; eassumption.
 unfold local, lift1.
 simpl.
-apply prop_derives; intro.
+apply bi.pure_mono; intro.
 eapply gvars_denote_HP; eauto.
 Qed.
 
 Ltac prove_headptr_gv :=
- first [simple apply gvars_denote_HP'; 
+ first [simple apply gvars_denote_HP';
          [solve [repeat (try (left; reflexivity) || right)] | apply I ]
-        | solve [entailer!]
+        | solve [ entailer! ]
        ].
 
 Ltac change_mapsto_gvar_to_data_at' gv S :=
@@ -4155,18 +4206,18 @@ Ltac change_mapsto_gvar_to_data_at' gv S :=
 
 Ltac change_mapsto_gvar_to_data_at := 
 match goal with
-| gv: globals |- semax _ (PROPx _ (LOCALx ?L (SEPx ?S))) _ _ =>
+| gv: globals |- semax _ _ (PROPx _ (LOCALx ?L (SEPx ?S))) _ _ =>
                                            change_mapsto_gvar_to_data_at' gv S
-| gv: globals |- ?S |-- _ => change_mapsto_gvar_to_data_at' gv S
+| gv: globals |- ?S ⊢ _ => change_mapsto_gvar_to_data_at' gv S
 end.
 
 Ltac type_lists_compatible al bl :=
  match al with
- | cons ?a ?al' => match bl with cons ?b ?bl' => 
+ | ?a :: ?al' => match bl with ?b :: ?bl' => 
                  first [unify a b | unify (classify_cast a b) cast_case_pointer];
                  type_lists_compatible al' bl'
                 end
- | nil => match bl with nil => idtac end
+ | [] => match bl with [] => idtac end
  end.
 
 Ltac function_types_compatible t1 t2 :=
@@ -4307,19 +4358,19 @@ match x with
 end.
 
 Lemma elim_close_precondition:
-  forall {CS: compspecs} {Espec: OracleKind} al Delta P F c Q,
-   semax Delta ((argsassert2assert al P) * F) c Q ->
-   semax Delta (close_precondition al P * F) c Q.
+  forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {cs: compspecs} E al Delta P F c Q,
+   semax E Delta (argsassert2assert al P ∗ F) c Q ->
+   semax E Delta (close_precondition al P ∗ F) c Q.
 Proof.
 intros.
- apply semax_pre with ((argsassert2assert al P)*F); auto.
- apply andp_left2.
- apply sepcon_derives; [ clear H | apply derives_refl].
- intro rho. unfold close_precondition, argsassert2assert.
- normalize. apply derives_refl'. f_equal. f_equal.
+ apply semax_pre with (argsassert2assert al P ∗ F); auto.
+ rewrite bi.and_elim_r.
+ apply bi.sep_mono; [ clear H | apply derives_refl].
+ raise_rho. unfold close_precondition, argsassert2assert.
+ normalize. apply entails_refl'. f_equal. f_equal.
   unfold eval_id. simpl. clear - H. generalize dependent vals.
  induction al; simpl; intros; destruct vals; trivial; inv H.
- rewrite (IHal _ H2), H1; trivial.
+ rewrite (IHal _ H2) H1; trivial.
 Qed.
 
 Ltac check_parameter_types' :=
@@ -4371,84 +4422,85 @@ Fixpoint computeQ (ids:list ident) (vals:list val) : option (list localdef) :=
   end.
 
 Lemma compute_close_precondition_entails1: 
-  forall ids P gv vals Q R,
+  forall `{!VSTGS OK_ty Σ} ids P gv vals Q R,
   compute_list_norepet ids = true ->
   computeQ ids vals = Some Q ->
   PROPx P (LOCALx ((map gvars gv)++Q) (SEPx R))
-  |-- close_precondition ids (PROPx P (LAMBDAx gv vals (SEPx R))).
+  ⊢ close_precondition(Σ:=Σ) ids (PROPx P (LAMBDAx gv vals (SEPx R))).
 Proof.
-intros. rewrite <- insert_locals. intros rho. unfold close_precondition; normalize. 
-Exists vals. unfold GLOBALSx, PARAMSx. simpl.
+intros. rewrite <- insert_locals. raise_rho. unfold close_precondition; super_unfold_lift; normalize. 
+apply (bi.exist_intro' _ _ vals). unfold GLOBALSx, PARAMSx. simpl.
   unfold argsassert2assert.
-  unfold PROPx, LOCALx, SEPx. simpl. normalize.  
-  apply andp_right.
-  { apply andp_left2. apply andp_left1. unfold local, liftx, lift1, lift; simpl.
-    apply prop_derives; intros.
+  unfold PROPx, LOCALx, SEPx. simpl. normalize.
+  apply bi.and_intro.
+  { apply bi.pure_intro.
     assert (AUX: map (Map.get (te_of rho)) ids = map Some vals /\
             Forall (fun v : val => v <> Vundef) vals).
     { generalize dependent Q. generalize dependent vals.
       induction ids; simpl; intros.
       - destruct vals; inv H0. simpl; split; trivial.
-      - destruct vals; inv H0. remember (computeQ ids vals) as t; destruct t; try discriminate. inv H4.
+      - destruct vals; inv H0. remember (computeQ ids vals) as t; destruct t; try discriminate. inv H5.
         symmetry in Heqt. inv H.
-        remember (id_in_list a ids) as b; symmetry in Heqb; destruct b. discriminate. destruct H2.
-        destruct (IHids H3 _ _ Heqt) as [X1 X2]; simpl; trivial.
+        remember (id_in_list a ids) as b; symmetry in Heqb; destruct b. discriminate. destruct H3.
+        destruct (IHids H4 _ _ Heqt) as [X1 X2]; simpl; trivial.
         red in H. unfold eval_id, liftx, lift in H. simpl in H. destruct H.
         unfold force_val in H. destruct (Map.get (te_of rho) a); [subst | congruence].
         rewrite X1. split; auto. }
      clear - H1 AUX; intuition. }
-  apply andp_right.
-  { apply andp_left1. clear. unfold local, liftx, lift1, lift; simpl. apply prop_derives; intros.
+  raise_rho. super_unfold_lift. normalize.
+  apply bi.and_intro.
+  { apply bi.pure_intro. split; auto.
     unfold Clight_seplog.mkEnv; simpl. unfold seplog.globals_only; simpl.
-    induction gv; simpl in *. trivial. destruct H.
+    induction gv; simpl in *. trivial. destruct H1.
     split; auto. }
-  do 2 apply andp_left2; trivial.
+  done.
 Qed.
 
 Lemma compute_close_precondition_entails2: 
-  forall ids P gv vals Q R,
+  forall `{!VSTGS OK_ty Σ} ids P gv vals Q R,
   compute_list_norepet ids = true ->
   computeQ ids vals = Some Q ->
   close_precondition ids (PROPx P (LAMBDAx gv vals (SEPx R)))
-  |--  (PROPx P (LOCALx ((map gvars gv)++Q) (SEPx R))).
+  ⊢  (PROPx(Σ:=Σ) P (LOCALx ((map gvars gv)++Q) (SEPx R))).
 Proof.
-intros. rewrite <- insert_locals. intros rho. unfold close_precondition; normalize.
-unfold GLOBALSx, PARAMSx, argsassert2assert, PROPx, LOCALx, SEPx. simpl. normalize. 
-  apply andp_right.
-  { apply andp_left1. unfold Clight_seplog.mkEnv. simpl.
-    unfold seplog.globals_only; simpl. unfold local, liftx, lift1, lift; simpl. clear.
-    apply prop_derives; intros.
+intros. rewrite <- insert_locals. 
+  unfold close_precondition; split => rho; monPred.unseal; normalize. raise_rho. super_unfold_lift.
+ unfold GLOBALSx, PARAMSx, argsassert2assert, PROPx, LOCALx, SEPx.
+  normalize. 
+  apply bi.and_intro; [|by done].
+  rewrite bi.pure_and; apply bi.and_intro.
+  { apply bi.pure_intro.
     induction gv; simpl in *; trivial.
-    unfold gvars_denote in *; simpl in *; destruct H. split; auto. } 
-  apply andp_derives; trivial.
-  unfold local, liftx ,lift1, lift; simpl. apply prop_right. clear - H H0 H1 H2.
+    destruct H4. split; auto. }
+  apply bi.pure_intro. clear - H H0 H1 H2 H3 H4.
+  split; [done|].
   generalize dependent Q. generalize dependent vals.
   induction ids; simpl; intros.
-  - destruct vals; inv H0. simpl; trivial.
-  - destruct vals; inv H0. remember (computeQ ids vals) as t; destruct t; try discriminate. inv H4.
+  - destruct vals; inv H0. simpl. split; trivial.
+  - destruct vals; inv H0. remember (computeQ ids vals) as t; destruct t; try discriminate. inv H6.
     symmetry in Heqt. inv H; inv H1; inv H2.
     remember (id_in_list a ids) as b; symmetry in Heqb; destruct b. discriminate.
-    split; [ red | eauto].
-    unfold liftx, lift; simpl. unfold eval_id. rewrite H0. split; trivial.
+    simpl. unfold_lift. unfold eval_id. rewrite H0. repeat split; trivial. eapply IHids; done.
 Qed.
 
 Lemma compute_close_precondition_eq:
-  forall ids P gv vals Q R,
+  forall `{!VSTGS OK_ty Σ} ids P gv vals Q R,
   compute_list_norepet ids = true ->
   computeQ ids vals = Some Q ->
   close_precondition ids (PROPx P (LAMBDAx gv vals (SEPx R)))
-  = (PROPx P (LOCALx ((map gvars gv)++Q) (SEPx R))).
+  ⊣⊢ (PROPx(Σ:=Σ) P (LOCALx ((map gvars gv)++Q) (SEPx R))).
 Proof. intros.
-  apply pred_ext. eapply compute_close_precondition_entails2; trivial.
+  apply bi.equiv_entails_2.
+  eapply compute_close_precondition_entails2; trivial.
   eapply compute_close_precondition_entails1; trivial.
 Qed.
 
 Lemma semax_elim_close_precondition:
-  forall {CS: compspecs} {Espec: OracleKind} ids Delta P gv vals R F c Q T,
+  forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {cs: compspecs} ids E Delta P gv vals R F c Q T,
   compute_list_norepet ids = true ->
   computeQ ids vals = Some Q ->
-   semax Delta (PROPx P (LOCALx ((map gvars gv)++Q) (SEPx R)) * F) c T ->
-   semax Delta (close_precondition ids ((PROPx P (LAMBDAx gv vals (SEPx R)))) * F) c T.
+   semax E Delta (PROPx P (LOCALx ((map gvars gv)++Q) (SEPx R)) ∗ F) c T ->
+   semax E Delta (close_precondition ids ((PROPx P (LAMBDAx gv vals (SEPx R)))) ∗ F) c T.
 Proof.
 intros. erewrite compute_close_precondition_eq; [ | eassumption | eassumption ]; trivial.
 Qed.
@@ -4456,16 +4508,18 @@ Qed.
 Ltac start_func_convert_precondition := idtac.
 Ltac rewrite_old_main_pre := idtac.
 
+
+
 Ltac start_function1 :=
  leaf_function;
- lazymatch goal with |- @semax_body ?V ?G ?cs ?F ?spec =>
+ lazymatch goal with |- semax_body ?V ?G ?F ?spec =>
     check_normalized F;
     function_body_unsupported_features F;
     let s := fresh "spec" in
     pose (s:=spec); hnf in s; cbn zeta in s; (* dependent specs defined with Program Definition often have extra lets *)
    repeat lazymatch goal with
     | s := (_, NDmk_funspec _ _ _ _ _) |- _ => fail
-    | s := (_, mk_funspec _ _ _ _ _ _ _) |- _ => fail
+    | s := (_, mk_funspec _ _ _ _ _ _) |- _ => fail
     | s := (_, ?a _ _ _ _) |- _ => unfold a in s
     | s := (_, ?a _ _ _) |- _ => unfold a in s
     | s := (_, ?a _ _) |- _ => unfold a in s
@@ -4478,46 +4532,55 @@ Ltac start_function1 :=
                POST [ tint ] _) |- _ => idtac
     | s := ?spec' |- _ => check_canonical_funspec spec'
    end;
-   change (@semax_body V G cs F s); subst s;
-   unfold NDmk_funspec'
+   change (semax_body V G F s); subst s;
+   unfold mk_funspec'
  end;
- let DependedTypeList := fresh "DependedTypeList" in
- unfold NDmk_funspec; 
- match goal with |- semax_body _ _ _ (pair _ (mk_funspec _ _ _ ?Pre _ _ _)) =>
-
+(* let DependedTypeList := fresh "DependedTypeList" in*)
+ match goal with
+ | |- semax_body _ _ _ (pair _ (mk_funspec _ _ _ _ ?Pre _)) =>
    split3; [check_parameter_types' | check_return_type | ];
-    match Pre with
-   | (fun _ => convertPre _ _ (fun i => _)) =>  intros Espec DependedTypeList i
-   | (fun _ x => match _ with (a,b) => _ end) => intros Espec DependedTypeList [a b]
-   | (fun _ i => _) => intros Espec DependedTypeList i
-   end;
-   simpl fn_body; simpl fn_params; simpl fn_return
+   match Pre with
+   | (monPred_at (convertPre _ _ (fun i => _))) =>  intros Espec (*DependedTypeList*) i
+   | (λne x, monPred_at match _ with (a,b) => _ end) => intros Espec (*DependedTypeList*) [a b]
+   | (λne i, _) => intros Espec (*DependedTypeList*) i (* this seems to be named "a" no matter what *)
+   end
+ | |- semax_body _ _ _ (pair _ (NDmk_funspec _ _ _ ?Pre _)) =>
+   split3; [check_parameter_types' | check_return_type | ];
+   match Pre with
+   | (convertPre _ _ (fun i => _)) =>  intros Espec (*DependedTypeList*) i
+   | (fun x => match _ with (a,b) => _ end) => intros Espec (*DependedTypeList*) [a b]
+   | (fun i => _) => intros Espec (*DependedTypeList*) i (* this seems to be named "a" no matter what *)
+   end
  end;
- try match goal with |- semax _ (fun rho => ?A rho * ?B rho) _ _ =>
-     change (fun rho => ?A rho * ?B rho) with (A * B)
-  end;
- simpl functors.MixVariantFunctor._functor in *;
- simpl rmaps.dependent_type_functor_rec;
- clear DependedTypeList;
+ simpl fn_body; simpl fn_params; simpl fn_return;
+ cbv [dtfr dependent_type_functor_rec constOF idOF prodOF discrete_funOF
+      ofe_morOF sigTOF list.listOF oFunctor_car ofe_car] in *;
+ cbv [ofe_mor_car];
+(* clear DependedTypeList; *)
  rewrite_old_main_pre;
+ rewrite ?argsassert_of_at ?assert_of_at;
  repeat match goal with
- | |- @semax _ _ _ (match ?p with (a,b) => _ end * _) _ _ =>
+ | |- semax _ _ (match ?p with (a,b) => _ end ∗ _) _ _ =>
+             destruct p as [a b]
+ | |- semax _ _ (close_precondition _ match ?p with (a,b) => _ end ∗ _) _ _ =>
              destruct p as [a b]
- | |- @semax _ _ _ (close_precondition _ match ?p with (a,b) => _ end * _) _ _ =>
+ | |- semax _ _ (close_precondition _ (argsassert_of match ?p with (a,b) => _ end) ∗ _) _ _ =>
              destruct p as [a b]
- | |- @semax _ _ _ ((match ?p with (a,b) => _ end) eq_refl * _) _ _ =>
+ | |- semax _ _ ((match ?p with (a,b) => _ end) eq_refl ∗ _) _ _ =>
              destruct p as [a b]
- | |- @semax _ _ _ (close_precondition _ ((match ?p with (a,b) => _ end) eq_refl) * _) _ _ =>
+ | |- semax _ _ (close_precondition _ ((match ?p with (a,b) => _ end) eq_refl) ∗ _) _ _ =>
              destruct p as [a b]
- | |- semax _ (close_precondition _
-                                                (fun ae => !! (Datatypes.length (snd ae) = ?A) && ?B
-                                                      (make_args ?C (snd ae) (mkEnviron (fst ae) _ _))) * _) _ _ =>
+ | |- semax _ _ (close_precondition _ (argsassert_of ((match ?p with (a,b) => _ end) eq_refl)) ∗ _) _ _ =>
+             destruct p as [a b]
+ | |- semax _ _ (close_precondition _ (argsassert_of (fun ae => ⌜(Datatypes.length (snd ae) = ?A)⌝ ∧ monPred_at ?B
+                                                      (make_args ?C (snd ae) (mkEnviron (fst ae) _ _)))) ∗ _) _ _ =>
           match B with match ?p with (a,b) => _ end => destruct p as [a b] end
        end;
 (* this speeds things up, but only in the very rare case where it applies,
    so maybe not worth it ...
   repeat match goal with H: reptype _ |- _ => progress hnf in H; simpl in H; idtac "reduced a reptype" end;
 *)
+ rewrite ?argsassert_of_at ?assert_of_at;
  try start_func_convert_precondition.
 
 Ltac expand_main_pre := expand_main_pre_old.
@@ -4556,7 +4619,7 @@ Ltac start_function3 :=
                end);
  abbreviate_semax;
  lazymatch goal with 
- | |- semax ?Delta (PROPx _ (LOCALx ?L _)) _ _ => check_parameter_vals Delta L
+ | |- semax _ ?Delta (PROPx _ (LOCALx ?L _)) _ _ => check_parameter_vals Delta L
  | _ => idtac
  end;
  try match goal with DS := @abbreviate (PTree.t funspec) ?DS1 |- _ =>
@@ -4566,15 +4629,15 @@ Ltac start_function3 :=
 
 Ltac start_function :=
   start_function1;
-  start_function2; 
+  start_function2;
   start_function3.
 
-Opaque sepcon.
-Opaque emp.
-Opaque andp.
+Opaque bi_sep.
+Opaque bi_emp.
+Opaque bi_and.
 
-Arguments overridePost Q R / .
-Arguments eq_dec A EqDec / a a' .
+Arguments overridePost {_ _} Q R / .
+Arguments eq_dec A EqDec / !a !a' .
 Arguments EqDec_exitkind !a !a'.
 
 (**** make_compspecs ****)
@@ -4582,7 +4645,7 @@ Arguments EqDec_exitkind !a !a'.
 Lemma composite_env_consistent_i':
   forall (f: composite -> Prop) (env: composite_env),
    Forall (fun idco => f (snd idco)) (PTree.elements env) ->
-   (forall id co, env ! id = Some co -> f co).
+   (forall id co, env !! id = Some co -> f co).
 Proof.
 intros.
 pose proof (Forall_ptree_elements_e _ (fun idco : positive * composite => f (snd idco))).
@@ -4593,7 +4656,7 @@ Qed.
 Lemma composite_env_consistent_i:
   forall (f: composite_env -> composite -> Prop) (env: composite_env),
    Forall (fun idco => f env (snd idco)) (PTree.elements env) ->
-   (forall id co, env ! id = Some co -> f env co).
+   (forall id co, env !! id = Some co -> f env co).
 Proof.
 intros.
 eapply composite_env_consistent_i'; eassumption.
@@ -4663,7 +4726,7 @@ Ltac simplify_composite_of_def d :=
        co_rank := rank;
        co_sizeof_pos := sp;
        co_alignof_two_p := altwo;
-       co_sizeof_alignof := sa |})
+       co_sizeof_alignof := sa |} )
   in
  d
 end.
@@ -4730,7 +4793,7 @@ Ltac make_compspecs_cenv cenv :=
     la_env_cs_consistent := la_env_consistent;
     la_env_cs_complete := la_env_complete;
     la_env_cs_sound := la_env_sound
-   |}).
+   |} ).
 
 Ltac make_compspecs prog :=
   tryif lazymatch type of prog with
@@ -4752,7 +4815,7 @@ Ltac simpl_prog_defs p :=
  match p with
  | context C [prog_defs (Clightdefs.mkprogram _ ?d _ _ _)] =>
        let q := context C [d] in q
- | context C [prog_defs ({| prog_defs := ?d |})] =>
+ | context C [prog_defs ({| prog_defs := ?d |} )] =>
        let q := context C [d] in q
   end.
 
@@ -4829,11 +4892,11 @@ Ltac with_library' p G :=
 Ltac with_library prog G :=
   let pr := eval unfold prog in prog in  with_library' pr G.
 
-Definition semax_prog {Espec} {CS} prog z V G :=
- @SeparationLogicAsLogicSoundness.MainTheorem.CSHL_MinimumLogic.CSHL_Defs.semax_prog
-  Espec CS prog z V (augment_funspecs prog G).
+Definition semax_prog `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {cs: compspecs} prog z V G :=
+ SeparationLogicAsLogicSoundness.MainTheorem.CSHL_MinimumLogic.CSHL_Defs.semax_prog
+  prog z V (augment_funspecs prog G).
 
-Lemma mk_funspec_congr:
+(* Lemma mk_funspec_congr:
   forall a b c d e f g a' b' c' d' e' f' g',
    a=a' -> b=b' -> c=c' -> JMeq d d' -> JMeq e e' ->
  mk_funspec a b c d e f g = mk_funspec a' b' c' d' e' f' g'.
@@ -4844,7 +4907,7 @@ apply JMeq_eq in H2.
 apply JMeq_eq in H3.
 subst d' e'.
 f_equal; apply proof_irr.
-Qed.
+Qed. *)
 
 Ltac prove_semax_prog_old :=
  split3; [ | | split3; [ | | split]];
@@ -4932,10 +4995,10 @@ Definition mk_OKComposite env su m a al PR1 PR2 PR3 : composite:=
        co_rank := rank_members env m;
        co_sizeof_pos := PR1;
        co_alignof_two_p := PR2;
-       co_sizeof_alignof := PR3 |}.
+       co_sizeof_alignof := PR3 |} .
   
 Lemma composite_abbrv env id su m a: composite_of_def env id su m a = 
-  match env ! id with
+  match env !! id with
   | Some _ => Errors.Error [Errors.MSG "Multiple definitions of struct or union "; Errors.CTX id]
   | None => if complete_members env m
             then let al := align_attr a (alignof_composite env m) in
@@ -5023,7 +5086,7 @@ Ltac prove_semax_prog_aux tac :=
      unfold prog at 1; (rewrite extract_prog_main || rewrite extract_prog_main');
      ((hnf; eexists;
       try match goal with |- snd ?A = _ => let j := fresh in set (j:=A); hnf in j; subst j; unfold snd at 1 end;
-      try (unfold NDmk_funspec'; rewrite_old_main_pre); reflexivity) || 
+      try (unfold NDmk_funspec(* FIXME or just delete this unfold? *); rewrite_old_main_pre); reflexivity) || 
         fail "Funspec of _main is not in the proper form")
     end
  ]; 
@@ -5055,13 +5118,13 @@ Tactic Notation "assert_after" constr(n) constr(PQR) :=
               | _ => n
              end in
  match goal with
- | |- semax _ _ (Ssequence (Ssequence ?c1 ?c2) ?c3) _ =>
+ | |- semax _ _ _ (Ssequence (Ssequence ?c1 ?c2) ?c3) _ =>
  let c := reassociate_to c1 c2 n
   in match c with (Ssequence ?d ?e) =>
            let f := constr:(Ssequence d (Ssequence e c3))
             in apply (semax_unfold_Ssequence _ f); [reflexivity | ]
       end
- | |- semax _ _ (Ssequence ?c1 ?c2) _ =>
+ | |- semax _ _ _ (Ssequence ?c1 ?c2) _ =>
  let c := reassociate_to c1 c2 n
   in  apply (semax_unfold_Ssequence c); [reflexivity | ]
  end;
@@ -5070,13 +5133,11 @@ Tactic Notation "assert_after" constr(n) constr(PQR) :=
 Ltac do_funspec_sub :=
 intros;
 apply NDsubsume_subsume;
-[ split; extensionality gv; reflexivity
-| split; [ split; reflexivity | intros w; simpl in w; intros [g args]; normalize;
-                                unfold_for_go_lower; simpl; entailer! ]
-].
+split; [ split3; reflexivity | intros w; simpl in w; intros [g args];
+                                unfold_for_go_lower; simpl; monPred.unseal; entailer! ].
 
 Ltac do_funspec_sub_nonND :=
    split; 
-   [ split; try reflexivity 
-   | intros ts w; simpl in w; intros [g args]; Intros;
-      fold (@rmaps.dependent_type_functor_rec ts) in * ].
+   [ split3; try reflexivity
+   | intros (*ts*) w; simpl in w; intros [g args]; Intros;
+      fold (dtfr) in * ].
diff --git a/floyd/forward_if2.v b/floyd/forward_if2.v
deleted file mode 100644
index bbcf7860b2..0000000000
--- a/floyd/forward_if2.v
+++ /dev/null
@@ -1,55 +0,0 @@
-Lemma sem_cast_i2bool_of_bool : forall (b : bool),
-  sem_cast_i2bool (Val.of_bool b) = Some (Val.of_bool b).
-Proof.
-  destruct b; auto.
-Qed.
-
-Ltac forward_if2 :=
-  repeat apply seq_assoc1;
-  apply semax_if_seq;
-  forward_if.
-Ltac step2 := first [step | forward_if2].
-Ltac info_step2 := first [simpl eval_binop; rewrite sem_cast_i2bool_of_bool | info_step | forward_if2; idtac "forward_if2."].
-
-Definition typed_true_bool (t : type) (v : val) :=
-   eqb_option Bool.eqb (strict_bool_val v t) (Some true).
-
-Definition typed_false_bool (t : type) (v : val) :=
-   eqb_option Bool.eqb (strict_bool_val v t) (Some false).
-
-Definition cond (b : bool) (s : statement) :=
-  if b then s else Sskip.
-
-
-
-Lemma semax_if_merge :
-  forall (Espec : OracleKind) (cs : compspecs) (v : val) (Delta : tycontext) (P : list Prop) (Q : list localdef) 
-         (R : list mpred) (b : expr) (c d : statement) (Post : ret_assert),
-  bool_type (typeof b) = true ->
-  ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- (tc_expr Delta (Eunop Cop.Onotbool b tint)) ->
-  ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- local ((` (eq v)) (eval_expr b)) ->
-  semax Delta (PROPx P (LOCALx Q (SEPx R)))
-    (Ssequence (cond (typed_true_bool (typeof b) v) c) (cond (typed_false_bool (typeof b) v) d)) Post ->
-  semax Delta (PROPx P (LOCALx Q (SEPx R))) (Sifthenelse b c d) Post.
-Proof.
-  intros. apply semax_ifthenelse_PQR' with v; auto;
-  unfold typed_true_bool, typed_false_bool in *; destruct (strict_bool_val v (typeof b)) as [[] | ] eqn:?; simpl in *.
-  3, 6 :
-    assert_PROP (tc_val (typeof b) v) by admit; (* Don't know how to prove this *)
-    assert (exists b0, strict_bool_val v (typeof b) = Some b0) as HSome;
-    [apply expr_lemmas.tc_bool_val; auto | destruct HSome; congruence].
-  all : unfold typed_true, typed_false; apply semax_extract_PROP; intros.
-  2, 3 : congruence.
-  apply semax_seq_skip in H2; auto.
-  apply semax_skip_seq in H2; auto.
-Admitted.
-
-Definition val_of_bool (b : bool) :=
-  if b then Vtrue else Vfalse.
-
-Lemma val_of_bool_strict_bool_val : forall b,
-  strict_bool_val (val_of_bool b) tint = Some b.
-Proof.
-  destruct b; auto.
-Qed.
-
diff --git a/floyd/forward_lemmas.v b/floyd/forward_lemmas.v
index ca9ff6d7c7..ef9ca7f606 100644
--- a/floyd/forward_lemmas.v
+++ b/floyd/forward_lemmas.v
@@ -1,17 +1,18 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
-Require Import VST.floyd.closed_lemmas.
+(* Require Import VST.floyd.closed_lemmas. *)
 Import Cop.
 Import LiftNotation.
-Import compcert.lib.Maps.
-Local Open Scope logic.
-
-Lemma semax_while_peel:
-  forall {CS: compspecs} {Espec: OracleKind} Inv Delta P expr body R,
-  @semax CS Espec Delta P (Ssequence (Sifthenelse expr Sskip Sbreak) body) 
-                             (loop1_ret_assert Inv R) ->
-  @semax CS Espec Delta Inv (Swhile expr body) R ->
-  @semax CS Espec Delta P (Swhile expr body) R.
+Import -(notations) compcert.lib.Maps.
+
+Lemma semax_while_peel: 
+  forall `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} {CS : compspecs} Inv E Delta P expr body R,
+  semax E Delta P (Ssequence (Sifthenelse expr Sskip Sbreak) body) 
+                            (loop1_ret_assert Inv R) ->
+  semax E Delta Inv (Swhile expr body) R ->
+  semax E Delta P (Swhile expr body) R.
 Proof.
 intros.
 apply semax_loop_unroll1 with (P' := Inv) (Q := Inv); auto.
@@ -25,7 +26,8 @@ intros. simpl. f_equal. apply IHl.
 Qed. 
 
 Lemma semax_func_cons_ext_vacuous:
-     forall {Espec: OracleKind} (V : varspecs) (G : funspecs) (C : compspecs) ge
+     forall `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty}
+         (V : varspecs) (G : funspecs) (C : compspecs) ge
          (fs : list (ident * Clight.fundef)) (id : ident) (ef : external_function)
          (argsig : list type) (retsig : type)
          (G' : funspecs) cc b,
@@ -42,22 +44,26 @@ Lemma semax_func_cons_ext_vacuous:
          ((id, vacuous_funspec (External ef argsig retsig cc)) :: G').
 Proof.
 intros.
-specialize (@semax_func_cons_ext Espec V G C ge fs id ef argsig retsig
-  (rmaps.ConstType Impossible) (fun _ _ => FF) (fun _ _ => FF) ). simpl. 
+specialize (semax_func_cons_ext V G ge fs id ef argsig retsig
+  (ConstType Impossible)).
+simpl.
 intros HH.
-unfold vacuous_funspec. simpl.
-unfold compcert_rmaps.typesig_of_funsig. simpl.
-rewrite typelist2list_arglist.
+rewrite /vacuous_funspec /= /typesig_of_funsig /= typelist2list_arglist.
  eapply HH; clear HH; try assumption; trivial.
-* right. clear. hnf. intros. simpl in X; inv X.
-* intros. simpl. apply andp_left1, FF_left.
+* right. clear. hnf. intros x. inv x.
+* intros. unfold monPred_at. done.
 * eassumption.
 * assumption.
-* apply semax_external_FF.
+* erewrite (@OfeMor_eq (leibnizO Impossible) (discrete_funO (fun _ : argsEnviron_index => ouPredO (iResUR Σ))) (λ _, monPred_at False)
+    (λ _, monPred_at False)) by done.
+  erewrite (@OfeMor_eq (leibnizO Impossible) (discrete_funO (fun _ : environ_index => ouPredO (iResUR Σ))) (λ _, monPred_at False)
+    (λ _, monPred_at False)) by done.
+  apply semax_external_FF.
 Qed.
 
 Lemma semax_func_cons_int_vacuous
-  (Espec : OracleKind) (V : varspecs) (G : funspecs) 
+  `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty}
+  (V : varspecs) (G : funspecs) 
     (cs : compspecs) (ge : Genv.t (fundef function) type)
     (fs : list (ident * Clight.fundef)) (id : ident) ifunc
     (b : block) G'
@@ -68,24 +74,25 @@ Lemma semax_func_cons_int_vacuous
   (CTvars: Forall (fun it : ident * type => complete_type cenv_cs (snd it) = true) (fn_vars ifunc))
   (LNR_PT: list_norepet (map fst (fn_params ifunc) ++ map fst (fn_temps ifunc)))
   (LNR_Vars: list_norepet (map fst (fn_vars ifunc)))
-  (VarSizes: semax.var_sizes_ok cenv_cs (fn_vars ifunc))
-  (Sfunc: @semax_func Espec V G cs ge fs G'):
-  @semax_func Espec V G cs ge ((id, Internal ifunc) :: fs)
+  (VarSizes: @semax.var_sizes_ok cenv_cs (fn_vars ifunc))
+  (Sfunc: semax_func V G ge fs G'):
+  semax_func V G ge ((id, Internal ifunc) :: fs)
     ((id, vacuous_funspec (Internal ifunc)) :: G').
 Proof.
 eapply semax_func_cons; try eassumption.
-+ rewrite ID, ID2. simpl. unfold semax_body_params_ok.
++ rewrite ID ID2. simpl. unfold semax_body_params_ok.
   apply compute_list_norepet_i in LNR_PT. rewrite LNR_PT.
   apply compute_list_norepet_i in LNR_Vars. rewrite LNR_Vars. trivial.
 + destruct ifunc; simpl; trivial.
 + red; simpl. split3.
   - destruct ifunc; simpl; trivial.
   - destruct ifunc; simpl; trivial.
-  - intros ? ? Impos. inv Impos.
+  - intros ? Impos. inv Impos.
 Qed.
 
 Lemma semax_prog_semax_func_cons_int_vacuous
-  (Espec : OracleKind) (V : varspecs) (G : funspecs) 
+  `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty}
+  (V : varspecs) (G : funspecs) 
     (cs : compspecs) (ge : Genv.t (fundef function) type)
     (fs : list (ident * Clight.fundef)) (id : ident) ifunc
     (b : block) G'
@@ -95,9 +102,9 @@ Lemma semax_prog_semax_func_cons_int_vacuous
   (CTvars: Forall (fun it : ident * type => complete_type cenv_cs (snd it) = true) (fn_vars ifunc))
   (LNR_PT: list_norepet (map fst (fn_params ifunc) ++ map fst (fn_temps ifunc)))
   (LNR_Vars: list_norepet (map fst (fn_vars ifunc)))
-  (VarSizes: semax.var_sizes_ok cenv_cs (fn_vars ifunc))
-  (Sfunc: @semax_prog.semax_func Espec V G cs ge fs G'):
-  @semax_prog.semax_func Espec V G cs ge ((id, Internal ifunc) :: fs)
+  (VarSizes: @semax.var_sizes_ok cenv_cs (fn_vars ifunc))
+  (Sfunc: semax_prog.semax_func OK_spec V G ge fs G'):
+  semax_prog.semax_func OK_spec V G ge ((id, Internal ifunc) :: fs)
     ((id, vacuous_funspec (Internal ifunc)) :: G').
 Proof.
 apply id_in_list_false in ID. destruct Sfunc as [Hyp1 [Hyp2 Hyp3]].
@@ -106,27 +113,29 @@ split3.
   unfold type_of_function. simpl. trivial. }
 { clear Hyp3. red; intros j fd J. destruct J; [ inv H | auto].
   exists b; split; trivial. }
-intros. specialize (Hyp3 _ Gfs Gffp n).
-intros v sig cc A P Q ? m NM EM CL. simpl in CL. red in CL.
-destruct CL as [j [Pne [Qne [J GJ]]]]. simpl in J.
+intros. specialize (Hyp3 _ Gfs Gffp).
+iIntros (v sig cc A E P Q CL).
+hnf in CL.
+destruct CL as [j [J GJ]]. simpl in J.
 rewrite PTree.gsspec in J.
 destruct (peq j id); subst.
-+ specialize (Hyp3 v sig cc A P Q _ _ NM EM).
-  clear Hyp3.
-  destruct GJ as [bb [BB VV]]. inv J. 
++ 
+  destruct GJ as [bb [BB VV]]. inv J.
   assert (bb = b). 
   { clear - GfsB Gfs BB. specialize (Gfs id); unfold sub_option, Clight.fundef in *.
     rewrite GfsB in Gfs. destruct ge'. simpl in *. rewrite Gfs in BB. inv BB; trivial. }
-  subst bb. right. simpl. exists b, ifunc.
+  subst bb. iRight. unfold believe_internal. iExists b, ifunc.
   specialize (Gffp b).
   unfold Clight.fundef in *. simpl in *. rewrite GffpB in Gffp. simpl in Gffp.
+  iSplit.
+  iPureIntro.
   repeat split; trivial.
   destruct ifunc; trivial.
   destruct ifunc; trivial.
-  intros until b2; intros Impos; inv Impos.
-+ apply (Hyp3 v sig cc A P Q _ _ NM EM).
-  simpl. exists j; do 2 eexists; split. apply J. apply GJ.
-Qed. 
+  iIntros (???? []).
++ iApply Hyp3; iPureIntro.
+  exists j; split. apply J. apply GJ.
+Qed.
 
 Lemma int_eq_false_e:
   forall i j, Int.eq i j = false -> i <> j.
@@ -152,37 +161,41 @@ intro; subst.
 rewrite Ptrofs.eq_true in H; inv H.
 Qed.
 
+Lemma derives_trans: forall {prop:bi} (P Q R:prop),
+  (P ⊢ Q) -> (Q ⊢ R) -> (P ⊢ R).
+Proof. intros. rewrite H H0 //. Qed.
+
 Lemma semax_ifthenelse_PQR' :
-   forall Espec {cs: compspecs} (v: val) Delta P Q R (b: expr) c d Post,
+   forall `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} {CS : compspecs} (v: val) E Delta P Q R (b: expr) c d Post,
       bool_type (typeof b) = true ->
-     ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+     ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
          (tc_expr Delta (Eunop Cop.Onotbool b tint))  ->
-     ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+     ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
         local (`(eq v) (eval_expr b)) ->
-     @semax cs Espec Delta (PROPx (typed_true (typeof b) v :: P) (LOCALx Q (SEPx R)))
+     semax E Delta (PROPx (typed_true (typeof b) v :: P) (LOCALx Q (SEPx R)))
                         c Post ->
-     @semax cs Espec Delta (PROPx (typed_false (typeof b) v :: P) (LOCALx Q (SEPx R)))
+     semax E Delta (PROPx (typed_false (typeof b) v :: P) (LOCALx Q (SEPx R)))
                         d Post ->
-     @semax cs Espec Delta (|> PROPx P (LOCALx Q (SEPx R)))
+     semax E Delta (▷ PROPx P (LOCALx Q (SEPx R)))
                          (Sifthenelse b c d) Post.
 Proof.
  intros.
  eapply semax_pre;  [ | apply semax_ifthenelse]; auto.
- instantiate (1:=(local (`(eq v) (eval_expr b)) && PROPx P (LOCALx Q (SEPx R)))).
- eapply derives_trans; [apply andp_derives, derives_refl; apply now_later|].
- rewrite <- later_andp; apply later_derives.
- apply andp_right; try assumption. apply andp_right; try assumption.
- apply andp_left2; auto.
- eapply semax_pre; [ | eassumption].
- rewrite <- insert_prop.
- forget ( PROPx P (LOCALx Q (SEPx R))) as PQR.
- go_lowerx. normalize. apply andp_right; auto.
- subst; apply prop_right; repeat split; auto.
- eapply semax_pre; [ | eassumption].
- rewrite <- insert_prop.
- forget ( PROPx P (LOCALx Q (SEPx R))) as PQR.
- go_lowerx. normalize. apply andp_right; auto.
- subst; apply prop_right; repeat split; auto.
+ - instantiate (1:=(local (`(eq v) (eval_expr b)) ∧ PROPx P (LOCALx Q (SEPx R)))).
+   eapply derives_trans; [apply bi.and_mono, derives_refl; apply bi.later_intro|].
+   rewrite -bi.later_and; apply bi.later_mono.
+   apply bi.and_intro; try assumption. apply bi.and_intro; try assumption.
+   apply bi.and_elim_r; auto.
+ - eapply semax_pre; [ | eassumption].
+   rewrite <- insert_prop.
+   forget (PROPx P (LOCALx Q (SEPx R))) as PQR.
+   go_lowerx. normalize. apply bi.and_intro; auto.
+   subst; apply bi.pure_intro; repeat split; auto.
+ - eapply semax_pre; [ | eassumption].
+   rewrite <- insert_prop.
+   forget (PROPx P (LOCALx Q (SEPx R))) as PQR.
+   go_lowerx. normalize. apply bi.and_intro; auto.
+   subst; apply bi.pure_intro; repeat split; auto.
 Qed.
 
 Definition logical_and_result v1 t1 v2 t2 :=
@@ -221,249 +234,267 @@ Definition logical_and tid e1 e2 :=
               (Sset tid (Ecast (Etempvar tid tint) tint)))
             (Sset tid (Econst_int (Int.repr 0) tint))).
 
+(*
+(* TODO move to mpred.v *)
+Section MPRED.
+Definition massert' `{heapGS Σ} := environ -> mpred.
+Program Definition assert_of_m `{heapGS Σ} (P : massert') : assert' := P.
+Fail Example bi_of_massert'_test `{heapGS Σ} : forall (P Q : massert'), P ∗ Q ⊢ Q ∗ P.
+Global Coercion assert_of_m : massert' >-> assert'.
+Example bi_of_massert'_test `{heapGS Σ} : forall (P Q : massert'), P ∗ Q ⊢ Q ∗ P.
+Proof. intros. rewrite bi.sep_comm. done. Qed.
+
+(* FIXME can this be avoided? *)
+
+Context `{!heapGS Σ}.
+Lemma bi_assert_id : forall P,  bi_assert(Σ:=Σ) P ⊣⊢ P.
+Proof. intros. unfold bi_assert. constructor. intros simpl. constructor. intros.
+       split; intros; simpl; done.
+Qed.
+End MPRED.
+*)
+
 Lemma semax_pre_flipped :
- forall (P' : environ -> mpred) (Espec : OracleKind) {cs: compspecs}
-         (Delta : tycontext) (P1 : list Prop) (P2 : list localdef)
+ forall `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} (P' : assert) {cs: compspecs}
+        E (Delta : tycontext) (P1 : list Prop) (P2 : list localdef)
          (P3 : list mpred) (c : statement)
          (R : ret_assert),
-       semax Delta P' c R ->
-       ENTAIL Delta, PROPx P1 (LOCALx P2 (SEPx P3)) |-- P' ->
-        semax Delta (PROPx P1 (LOCALx P2 (SEPx P3))) c R.
+       semax E Delta P' c R ->
+       ENTAIL Delta, PROPx P1 (LOCALx P2 (SEPx P3)) ⊢ P' ->
+       semax E Delta (PROPx P1 (LOCALx P2 (SEPx P3))) c R.
 Proof. intros.
-eapply semax_pre. apply H0. auto.
+eapply semax_pre. apply H0. apply H.
 Qed.
 
 Lemma semax_while :
- forall Espec {cs: compspecs} Delta Q test body (R: ret_assert),
+ forall `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} {cs: compspecs}
+     E Delta Q test body (R: ret_assert),
      bool_type (typeof test) = true ->
-     (local (tc_environ Delta) && Q |--  (tc_expr Delta (Eunop Cop.Onotbool test tint))) ->
-     (local (tc_environ Delta) && local (lift1 (typed_false (typeof test)) (eval_expr test)) && Q |-- RA_normal R) ->
-     @semax cs Espec Delta (local (`(typed_true (typeof test)) (eval_expr test)) && Q)  body (loop1_ret_assert Q R) ->
-     @semax cs Espec Delta Q (Swhile test body) R.
+     (local (tc_environ Delta) ∧ Q ⊢  (tc_expr Delta (Eunop Cop.Onotbool test tint))) ->
+     (local (tc_environ Delta) ∧ local (lift1 (typed_false (typeof test)) (eval_expr test)) ∧ Q ⊢ RA_normal R) ->
+     semax E Delta (local (`(typed_true (typeof test)) (eval_expr test)) ∧ Q)  body (loop1_ret_assert Q R) ->
+     semax E Delta Q (Swhile test body) R.
 Proof.
-intros ? ? ? ? ? ? ? BT TC Post H.
+intros ? ? ? ? ? ? ? ? ? ? ? BT TC Post H.
 unfold Swhile.
-apply (@semax_loop cs Espec Delta Q Q).
+apply (semax_loop E Delta Q Q).
 2:{
  clear. eapply semax_post_flipped. apply semax_skip.
- all: try (intros; apply andp_left2; destruct R; apply derives_refl).
- intros. apply andp_left2. destruct R; simpl. normalize.
- intros. apply andp_left2. destruct R; simpl. normalize.
+ all: try (intros; rewrite bi.and_elim_r; destruct R; apply derives_refl).
+ intros. rewrite bi.and_elim_r. destruct R; simpl. normalize.
+ intros. rewrite bi.and_elim_r. destruct R; simpl. normalize.
 } 
 apply semax_seq with
- (local (`(typed_true (typeof test)) (eval_expr test)) && Q).
-apply semax_pre_simple with (|>( (tc_expr Delta (Eunop Cop.Onotbool test tint)) && Q)).
-eapply derives_trans, now_later.
-apply andp_right. apply TC.
-apply andp_left2.
-intro; auto.
+ (local (`(typed_true (typeof test)) (eval_expr test)) ∧ Q).
+apply semax_pre_simple with (▷( (tc_expr Delta (Eunop Cop.Onotbool test tint)) ∧ Q)).
+eapply derives_trans, bi.later_intro.
+apply bi.and_intro. apply TC.
+apply bi.and_elim_r.
 clear H.
 apply semax_ifthenelse; auto.
 eapply semax_post_flipped. apply semax_skip.
 destruct R as [?R ?R ?R ?R].
-simpl RA_normal in *. apply andp_left2. intro rho; simpl. rewrite andp_comm. auto.
-all: try (intro rho; simpl; normalize).
+simpl RA_normal in *. rewrite bi.and_elim_r. raise_rho; simpl. rewrite bi.and_comm. auto.
+all: try (raise_rho; simpl; normalize).
 eapply semax_pre_simple; [ | apply semax_break].
-rewrite (andp_comm Q).
-rewrite <- andp_assoc.
+rewrite (bi.and_comm Q).
 eapply derives_trans; try apply Post.
 destruct R; simpl; auto.
-auto.
 Qed.
 
 Lemma semax_while_3g1 :
- forall Espec {cs: compspecs} {A} (v: A -> val) Delta P Q R test body Post,
+ forall `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} {cs: compspecs}
+     {A} (v: A -> val) E Delta P Q R test body Post,
      bool_type (typeof test) = true ->
-     (forall a, ENTAIL Delta, PROPx (P a) (LOCALx (Q a) (SEPx (R a))) |-- (tc_expr Delta (Eunop Cop.Onotbool test tint))) ->
-     (forall a, ENTAIL Delta, PROPx (P a) (LOCALx (Q a) (SEPx (R a))) |-- local (`(eq (v a)) (eval_expr test))) ->
-     (forall a, @semax cs Espec Delta (PROPx (typed_true (typeof test) (v a) :: (P a)) (LOCALx (Q a) (SEPx (R a))))
-                 body (loop1_ret_assert (EX a:A, PROPx (P a) (LOCALx (Q a) (SEPx (R a))))
+     (forall a, ENTAIL Delta, PROPx (P a) (LOCALx (Q a) (SEPx (R a))) ⊢ (tc_expr Delta (Eunop Cop.Onotbool test tint))) ->
+     (forall a, ENTAIL Delta, PROPx (P a) (LOCALx (Q a) (SEPx (R a))) ⊢ local (`(eq (v a)) (eval_expr test))) ->
+     (forall a, semax E Delta (PROPx (typed_true (typeof test) (v a) :: (P a)) (LOCALx (Q a) (SEPx (R a))))
+                 body (loop1_ret_assert (∃ a:A, PROPx (P a) (LOCALx (Q a) (SEPx (R a))))
                            (overridePost
-                            (EX a:A, PROPx (typed_false (typeof test) (v a) :: P a)  (LOCALx (Q a) (SEPx (R a))))
+                            (∃ a:A, PROPx (typed_false (typeof test) (v a) :: P a)  (LOCALx (Q a) (SEPx (R a))))
                             Post))) ->
-     @semax cs Espec Delta (EX a:A, PROPx (P a) (LOCALx (Q a) (SEPx (R a))))
+     semax E Delta (∃ a:A, PROPx (P a) (LOCALx (Q a) (SEPx (R a))))
                  (Swhile test body)
                  (overridePost
-                   (EX a:A, PROPx (typed_false (typeof test) (v a) :: P a)  (LOCALx (Q a) (SEPx (R a))))
+                   (∃ a:A, PROPx (typed_false (typeof test) (v a) :: P a)  (LOCALx (Q a) (SEPx (R a))))
                    Post).
 Proof.
 intros.
 apply semax_while; auto.
 *
- rewrite exp_andp2. apply exp_left; intro a.
+ rewrite bi.and_exist_l. apply bi.exist_elim; intro a.
  eapply derives_trans; [ | apply H0].
  apply derives_refl.
 *
-repeat rewrite exp_andp2. apply exp_left; intro a.
+repeat rewrite  bi.and_exist_l. apply bi.exist_elim; intro a.
 rewrite overridePost_normal'.
-apply exp_right with a.
+apply bi.exist_intro' with a.
 eapply derives_trans.
-apply andp_right; [ | apply derives_refl].
+apply bi.and_intro; [ | apply derives_refl].
 eapply derives_trans; [ | apply (H1 a)].
-rewrite (andp_comm (local _)).
-rewrite andp_assoc. apply andp_left2. auto.
+rewrite (bi.and_comm (local _)).
+rewrite -bi.and_assoc. rewrite bi.and_elim_r. rewrite bi.and_comm. auto.
 go_lowerx; normalize.
-repeat apply andp_right; auto. apply prop_right; split; auto.
+repeat apply bi.and_intro; auto.
+apply bi.pure_intro; split; auto.
 rewrite H3; auto.
 *
- repeat rewrite exp_andp2.
+ repeat rewrite  bi.and_exist_l.
  apply extract_exists_pre; intro a.
  eapply semax_pre_post; try apply (H2 a).
  +
- rewrite <- andp_assoc.
+ rewrite bi.and_assoc.
  rewrite <- insert_prop.
- apply andp_right; [ | apply andp_left2; auto].
- rewrite (andp_comm (local _)). rewrite andp_assoc.
+ apply bi.and_intro; [ | apply bi.and_elim_r; auto].
+ rewrite (bi.and_comm (local _)). rewrite -bi.and_assoc.
  eapply derives_trans.
- apply andp_right; [ | apply derives_refl].
- apply andp_left2; apply (H1 a).
- rewrite <- andp_assoc.
- apply andp_left1.
- go_lowerx. intro; apply prop_right. rewrite H3; auto.
- + apply andp_left2. destruct Post; simpl; auto.
- + apply andp_left2. destruct Post; simpl; auto.
- + apply andp_left2. destruct Post; simpl; auto.
- + intros; apply andp_left2. destruct Post; simpl; auto.
+ apply bi.and_intro; [ | apply derives_refl].
+ rewrite (H1 a). apply bi.and_elim_r.
+ rewrite bi.and_assoc.
+ rewrite bi.and_elim_l.
+ go_lowerx. intro; apply bi.pure_intro. rewrite H3; auto.
+ + apply bi.and_elim_r.
+ + apply bi.and_elim_r.
+ + apply bi.and_elim_r.
+ + intros; apply bi.and_elim_r.
 Qed.
 
 Lemma semax_for_x :
- forall Espec {cs: compspecs} Delta Q test body incr PreIncr Post,
+ forall `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} {cs: compspecs}
+     E Delta Q test body incr PreIncr Post,
      bool_type (typeof test) = true ->
-     (local (tc_environ Delta) && Q |-- (tc_expr Delta (Eunop Cop.Onotbool test tint))) ->
+     (local (tc_environ Delta) ∧ Q ⊢ (tc_expr Delta (Eunop Cop.Onotbool test tint))) ->
      (local (tc_environ Delta)
-      && local (`(typed_false (typeof test)) (eval_expr test))
-      && Q |-- RA_normal Post) ->
-     @semax cs Espec Delta (local (`(typed_true (typeof test)) (eval_expr test)) && Q)
+      ∧ local (`(typed_false (typeof test)) (eval_expr test))
+      ∧ Q ⊢ RA_normal Post) ->
+     semax E Delta (local (`(typed_true (typeof test)) (eval_expr test)) ∧ Q)
              body (loop1_ret_assert PreIncr Post) ->
-     @semax cs Espec Delta PreIncr incr (normal_ret_assert Q) ->
-     @semax cs Espec Delta Q
+     semax E Delta PreIncr incr (normal_ret_assert Q) ->
+     semax E Delta Q
        (Sloop (Ssequence (Sifthenelse test Sskip Sbreak) body) incr)
        Post.
 Proof.
 intros.
 apply semax_loop with PreIncr.
-apply semax_seq with (local (tc_environ Delta) &&
-   (Q && local (` (typed_true (typeof test)) (eval_expr test)))) .
-apply semax_pre_simple with (|> ((tc_expr Delta (Eunop Cop.Onotbool test tint)) && Q)).
-eapply derives_trans, now_later.
-apply andp_right; auto.
-apply andp_left2; auto.
+apply semax_seq with (local (tc_environ Delta) ∧
+   (Q ∧ local (` (typed_true (typeof test)) (eval_expr test)))) .
+apply semax_pre_simple with (▷ ((tc_expr Delta (Eunop Cop.Onotbool test tint)) ∧ Q)).
+eapply derives_trans, bi.later_intro.
+apply bi.and_intro; auto.
+apply bi.and_elim_r; auto.
 apply semax_ifthenelse; auto.
 *
 eapply semax_post_flipped; [ apply semax_skip | .. ].
-intro rho; destruct Post as [?P ?P ?P ?P]; simpl; normalize.
-intro rho; destruct Post as [?P ?P ?P ?P]; simpl; normalize.
-intro rho; destruct Post as [?P ?P ?P ?P]; simpl; normalize.
-intros vl rho; destruct Post as [?P ?P ?P ?P]; simpl; normalize.
+destruct Post as [?P ?P ?P ?P]; simpl; normalize.
+destruct Post as [?P ?P ?P ?P]; simpl; normalize.
+destruct Post as [?P ?P ?P ?P]; simpl; normalize.
+intros vl; destruct Post as [?P ?P ?P ?P]; simpl; normalize.
 *
 eapply semax_pre_simple; [ | apply semax_break].
-intro rho; destruct Post as [?P ?P ?P ?P]; simpl; normalize.
-eapply derives_trans; [ | apply (H1 rho)].
-rewrite (andp_comm (Q rho)).
+destruct Post as [?P ?P ?P ?P]; simpl.
+split => rho; monPred.unseal; normalize.
+eapply derives_trans; [ | apply H1].
+rewrite (bi.and_comm (Q rho)).
 simpl.
-rewrite andp_assoc.
-auto.
+raise_rho.
+done.
 *
 eapply semax_pre_simple; [ | apply H2].
-apply andp_left2.
-apply andp_left2.
-rewrite andp_comm. auto.
+rewrite bi.and_elim_r.
+rewrite bi.and_elim_r.
+rewrite bi.and_comm. auto.
 *
 eapply semax_post_flipped. apply H3.
-apply andp_left2; intro rho; destruct Post as [?P ?P ?P ?P]; simpl; auto.
-apply andp_left2; intro rho; destruct Post as [?P ?P ?P ?P]; simpl; auto.
+rewrite bi.and_elim_r; raise_rho; destruct Post as [?P ?P ?P ?P]; simpl; auto.
+rewrite bi.and_elim_r; raise_rho; destruct Post as [?P ?P ?P ?P]; simpl; auto.
 normalize.
-apply andp_left2; intro rho; destruct Post as [?P ?P ?P ?P]; simpl; auto.
-intro; apply andp_left2; intro rho; destruct Post as [?P ?P ?P ?P]; simpl; auto.
+rewrite bi.and_elim_r; raise_rho; destruct Post as [?P ?P ?P ?P]; simpl. apply bi.False_elim.
+intro; rewrite bi.and_elim_r; raise_rho; destruct Post as [?P ?P ?P ?P]; simpl; auto.
 normalize.
 Qed.
 
 Lemma semax_for :
- forall Espec {cs: compspecs} {A:Type} (v: A -> val) Delta P Q R test body incr PreIncr Post,
+ forall `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} {cs: compspecs}
+     {A:Type} (v: A -> val) E Delta P Q R test body incr PreIncr Post,
      bool_type (typeof test) = true ->
      (forall a:A, ENTAIL Delta, PROPx (P a) (LOCALx (Q a) (SEPx (R a)))
-           |-- tc_expr Delta (Eunop Cop.Onotbool test tint)) ->
-     (forall a:A, ENTAIL Delta, PROPx (P a) (LOCALx (Q a) (SEPx (R a))) |--  local (`(eq (v a)) (eval_expr test))) ->
+           ⊢ tc_expr Delta (Eunop Cop.Onotbool test tint)) ->
+     (forall a:A, ENTAIL Delta, PROPx (P a) (LOCALx (Q a) (SEPx (R a))) ⊢  local (`(eq (v a)) (eval_expr test))) ->
      (forall a:A,
-        @semax cs Espec Delta (PROPx (typed_true (typeof test) (v a) :: P a) (LOCALx (Q a) (SEPx (R a))))
+        semax E Delta (PROPx (typed_true (typeof test) (v a) :: P a) (LOCALx (Q a) (SEPx (R a))))
              body (loop1_ret_assert (PreIncr a) Post)) ->
-     (forall a, @semax cs Espec Delta (PreIncr a) incr (normal_ret_assert (PROPx (P a) (LOCALx (Q a) (SEPx (R a)))))) ->
+     (forall a, semax E Delta (PreIncr a) incr (normal_ret_assert (PROPx (P a) (LOCALx (Q a) (SEPx (R a)))))) ->
      (forall a:A, ENTAIL Delta, PROPx (typed_false (typeof test) (v a) :: P a) (LOCALx (Q a) (SEPx (R a)))
-          |-- RA_normal Post) ->
-     @semax cs Espec Delta (EX a:A, PROPx (P a) (LOCALx (Q a) (SEPx (R a))))
+          ⊢ RA_normal Post) ->
+     semax E Delta (∃ a:A, PROPx (P a) (LOCALx (Q a) (SEPx (R a))))
        (Sloop (Ssequence (Sifthenelse test Sskip Sbreak) body) incr)
        Post.
 Proof.
 intros.
-apply semax_for_x with (EX a:A, PreIncr a); auto.
-normalize.
-normalize.
-eapply derives_trans; [ | apply (H4 a)].
-clear - H4 H1.
-eapply derives_trans; [ | eapply derives_trans; [ eapply andp_derives | ]].
-apply andp_right.
-rewrite (andp_comm (local (tc_environ _))).
-rewrite andp_assoc. apply andp_left2.
-apply H1. apply derives_refl. apply derives_refl. apply derives_refl.
-rewrite <- insert_prop.
-rewrite <- !andp_assoc.
-apply andp_derives; auto.
-intro rho; unfold local, lift1; unfold_lift. simpl.
-normalize. split; auto. rewrite H0; auto.
-normalize.
-apply extract_exists_pre; intro a.
-eapply semax_pre_post; try apply (H2 a).
-rewrite <- insert_prop.
-eapply derives_trans; [ | eapply derives_trans].
-eapply andp_right; [ | apply derives_refl].
-eapply derives_trans; [ | apply (H1 a)].
-apply andp_derives; auto.
-apply andp_left2; auto.
-apply derives_refl.
-rewrite <- !andp_assoc.
-apply andp_derives; auto.
-intro rho; unfold local, lift1; unfold_lift. simpl.
-normalize. rewrite H6; auto.
-intros.
-apply andp_left2.
-unfold loop1_ret_assert.
-destruct Post as [?P ?P ?P ?P]; apply exp_right with a; apply derives_refl.
-destruct Post as [?P ?P ?P ?P]; apply andp_left2; apply derives_refl.
-destruct Post as [?P ?P ?P ?P]; apply exp_right with a; apply andp_left2; simpl; auto.
-intros vl; destruct Post as [?P ?P ?P ?P]; apply andp_left2; apply derives_refl.
-apply extract_exists_pre; intro a.
-eapply semax_post'; try apply (H3 a).
-apply exp_right with a; auto.
-apply andp_left2; auto.
+apply semax_for_x with (∃ a:A, PreIncr a); auto.
+- rewrite bi.and_exist_l. apply bi.exist_elim. apply H0.
+- clear - H4 H1. rewrite !bi.and_exist_l. apply bi.exist_elim. intro a; eapply derives_trans; [| apply H4].
+  iIntros "(H1 & H2 & H3 & H4 & H5)". repeat iSplit; try done. 
+  iPoseProof (H1 with "[-]") as "#H6". { repeat iSplit; try done.  }
+  iDestruct "H6" as "-# H6". (* by moving to spatail context, H6 gets an affine modality when exiting ipm,
+                                and allows normalize to extract info from it instead of just throwing it away *)
+  iStopProof. unfold local.  super_unfold_lift. raise_rho. normalize. rewrite H5. apply bi.pure_intro. done.
+- Intro'' a.
+  eapply semax_pre_post; try apply (H2 a).
+  + rewrite <- insert_prop.
+    eapply derives_trans; [ | eapply derives_trans].
+    eapply bi.and_intro; [ | apply derives_refl].
+    eapply derives_trans; [ | apply (H1 a)].
+    apply bi.and_mono; auto.
+    apply bi.and_elim_r; auto.
+    apply derives_refl.
+    rewrite 2![in X in (X⊢_)]bi.and_assoc.
+    apply bi.and_mono; auto.
+    raise_rho; unfold local, lift1; unfold_lift.
+    iIntros "((%H5 & %H6) & %H7)". rewrite H5; done.
+  + rewrite bi.and_elim_r.
+    unfold loop1_ret_assert.
+    destruct Post as [?P ?P ?P ?P]; apply bi.exist_intro'  with a; apply derives_refl.
+  + destruct Post as [?P ?P ?P ?P]; apply bi.and_elim_r; apply derives_refl.
+  + destruct Post as [?P ?P ?P ?P]; apply bi.exist_intro'  with a; apply bi.and_elim_r; simpl; auto.
+  + intros vl; destruct Post as [?P ?P ?P ?P]; apply bi.and_elim_r; apply derives_refl.
+- apply extract_exists_pre; intro a.
+  eapply semax_post'; try apply (H3 a).
+  apply bi.exist_intro'  with a; auto.
+  apply bi.and_elim_r; auto.
 Qed.
 
 Lemma forward_setx':
-  forall Espec {cs: compspecs} Delta P id e,
-  (P |-- (tc_expr Delta e) && (tc_temp_id id (typeof e) Delta e) ) ->
-  @semax cs Espec Delta
+  forall `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} {cs: compspecs}
+  E Delta P id e,
+  (P ⊢ (tc_expr Delta e) ∧ (tc_temp_id id (typeof e) Delta e) ) ->
+  semax E Delta
              P
              (Sset id e)
              (normal_ret_assert
-                  (EX old:val,  local (`eq (eval_id id) (subst id (`old) (eval_expr e))) &&
-                            subst id (`old) P)).
+                  (∃ old:val, local (`eq (eval_id id) (subst id (`old) (eval_expr e))) ∧
+                              ( (assert_of (subst id (`old) P))))).
 Proof.
 intros.
-eapply semax_pre; try apply (semax_set_forward Delta P id e).
-+ eapply derives_trans ; [ | apply now_later].
-   apply andp_left2; apply andp_right; auto.
+eapply semax_pre.
+2:{  specialize (semax_set_forward E Delta P id e) as HH.
+     instantiate (1:=(▷ (tc_expr Delta e ∧ tc_temp_id id (typeof e) Delta e ∧ P))).
+     apply HH. }
++ eapply derives_trans ; [ | apply bi.later_intro ].
+   rewrite bi.and_elim_r. rewrite bi.and_assoc. apply bi.and_intro; auto.
 Qed.
 
 Lemma semax_switch_PQR: 
-  forall {Espec: OracleKind}{CS: compspecs} ,
-  forall n Delta (Pre: environ->mpred) a sl (Post: ret_assert),
+  forall `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} {CS: compspecs} ,
+  forall n E Delta (Pre: assert) a sl (Post: ret_assert),
      is_int_type (typeof a) = true ->
-     ENTAIL Delta, Pre |-- tc_expr Delta a ->
-     ENTAIL Delta, Pre |-- local (`(eq (Vint (Int.repr n))) (eval_expr a)) ->
-     @semax CS Espec Delta 
+     ENTAIL Delta, Pre ⊢ tc_expr Delta a ->
+     ENTAIL Delta, Pre ⊢ local (`(eq (Vint (Int.repr n))) (eval_expr a)) ->
+     semax E Delta
                Pre
                (seq_of_labeled_statement (select_switch (Int.unsigned (Int.repr n)) sl))
                (switch_ret_assert Post) ->
-     @semax CS Espec Delta Pre (Sswitch a sl) Post.
+     semax E Delta Pre (Sswitch a sl) Post.
 Proof.
 intros.
 eapply semax_pre.
@@ -471,16 +502,16 @@ apply derives_refl.
 apply (semax_switch); auto.
 intro n'.
 assert_PROP (n' = Int.repr n). {
-apply derives_trans with (local (`( eq (Vint (Int.repr n))) (eval_expr a)) && local (` eq (eval_expr a) `(Vint n'))).
-apply andp_right.
+apply derives_trans with (local (`( eq (Vint (Int.repr n))) (eval_expr a)) ∧ local (` eq (eval_expr a) `(Vint n'))).
+apply bi.and_intro.
 eapply derives_trans; [ | eassumption].
-intro rho.
+raise_rho.
 unfold local, lift1, liftx, lift; simpl.
 normalize.
-intro rho.
+raise_rho.
 unfold local, lift1, liftx, lift; simpl.
 normalize.
-intro rho.
+raise_rho.
 unfold local, lift1, liftx, lift; simpl.
 normalize.
 rewrite <- H3 in H4.
@@ -489,10 +520,7 @@ auto.
 }
 subst n'.
 eapply semax_pre; [ | eassumption].
-apply andp_left2.
-apply andp_left2.
-apply andp_left2.
-auto.
+rewrite !bi.and_elim_r //.
 Qed.
 
 Lemma modulo_samerepr:
@@ -513,7 +541,7 @@ pose proof (Z.div_mod y m).
 spec H. intro Hx; inv Hx.
 evar (k: Z).
 exists k.
-rewrite H at 2; clear H.
+rewrite {2}H; clear H.
 rewrite (Z.mul_comm m).
 assert (z * m = k*m + (y/m*m))%Z; [ | lia].
 rewrite <- Z.mul_add_distr_r.
@@ -535,7 +563,7 @@ intros.
 simpl.
 apply modulo_samerepr in H.
 rewrite <- H.
-rewrite Int.unsigned_repr by rep_lia.
+rewrite -> Int.unsigned_repr by rep_lia.
 auto.
 Qed.
 
@@ -553,94 +581,96 @@ Definition adjust_for_sign (s: signedness) (x: Z) :=
  end.
 
 Lemma semax_for_3g1 :
- forall Espec {cs: compspecs} {A} (PQR: A -> environ -> mpred) (v: A -> val) Delta P Q R test body incr Post,
+ forall `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} {cs: compspecs} {A} (PQR: A -> assert) (v: A -> val)
+     E Delta P Q R test body incr Post,
      bool_type (typeof test) = true ->
-     (forall a, ENTAIL Delta, PROPx (P a) (LOCALx (Q a) (SEPx (R a))) |-- (tc_expr Delta (Eunop Cop.Onotbool test tint))) ->
-     (forall a, ENTAIL Delta, PROPx (P a) (LOCALx (Q a) (SEPx (R a))) |-- local (`(eq (v a)) (eval_expr test))) ->
-     (forall a, @semax cs Espec Delta (PROPx (typed_true (typeof test) (v a) :: (P a)) (LOCALx (Q a) (SEPx (R a))))
-                 body (loop1_ret_assert (EX a:A, PQR a) Post)) ->
-     (forall a, @semax cs Espec Delta (PQR a) incr
-                         (normal_ret_assert (EX a:A, PROPx (P a) (LOCALx (Q a) (SEPx (R a)))))) ->
+     (forall a, ENTAIL Delta, PROPx (P a) (LOCALx (Q a) (SEPx (R a))) ⊢ (tc_expr Delta (Eunop Cop.Onotbool test tint))) ->
+     (forall a, ENTAIL Delta, PROPx (P a) (LOCALx (Q a) (SEPx (R a))) ⊢ local (`(eq (v a)) (eval_expr test))) ->
+     (forall a, semax E Delta (PROPx (typed_true (typeof test) (v a) :: (P a)) (LOCALx (Q a) (SEPx (R a))))
+                 body (loop1_ret_assert  (∃ a:A, PQR a) Post)) ->
+     (forall a, semax E Delta (PQR a) incr
+                         (normal_ret_assert (∃ a:A, PROPx (P a) (LOCALx (Q a) (SEPx (R a)))))) ->
      (forall a, ENTAIL Delta, PROPx (typed_false (typeof test) (v a) :: (P a)) (LOCALx (Q a) (SEPx (R a))) 
-                             |-- RA_normal Post) ->
-     @semax cs Espec Delta (EX a:A, PROPx (P a) (LOCALx (Q a) (SEPx (R a))))
+                             ⊢ RA_normal Post) ->
+     semax E Delta (∃ a:A, PROPx (P a) (LOCALx (Q a) (SEPx (R a))))
                  (Sloop (Ssequence (Sifthenelse test Sskip Sbreak)  body) incr)
                  Post.
 Proof.
 intros.
-apply semax_loop with (Q':= (EX a:A, PQR a)).
+apply semax_loop with (Q':= (∃ a:A, PQR a)).
 *
  apply extract_exists_pre; intro a.
  apply @semax_seq with (Q := PROPx (typed_true (typeof test) (v a) :: P a) (LOCALx (Q a) (SEPx (R a)))).
- apply semax_pre with (|> (tc_expr Delta (Eunop Onotbool test (Tint I32 Signed noattr)) 
-                                        && (local (`(eq (v a)) (eval_expr test)) && (PROPx (P a) (LOCALx (Q a) (SEPx (R a)))))));
+ apply semax_pre with (▷ (tc_expr Delta (Eunop Onotbool test (Tint I32 Signed noattr)) 
+                                        ∧ (local (`(eq (v a)) (eval_expr test)) ∧ (PROPx (P a) (LOCALx (Q a) (SEPx (R a)))))));
    [ | apply semax_ifthenelse; auto].
- eapply derives_trans, now_later.
- apply andp_right; auto.
- apply andp_right; auto.
- apply andp_left2; auto.
+ eapply derives_trans, bi.later_intro .
+ apply bi.and_intro; auto.
+ apply bi.and_intro; auto.
+ apply bi.and_elim_r; auto.
  apply sequential.
  eapply semax_post_flipped; [apply semax_skip | | | | ].
 +
- apply andp_left2.
+ rewrite bi.and_elim_r.
  destruct Post; simpl_ret_assert.
  clear.
  rewrite <- insert_prop.
  forget (PROPx (P a) (LOCALx (Q a) (SEPx (R a)))) as PQR.
- intro rho.  simpl. unfold_lift.  unfold local, lift1. normalize.
+ raise_rho.  simpl. unfold_lift.  unfold local, lift1. normalize.
  rewrite H0. normalize.
 +
- destruct Post; simpl_ret_assert. apply andp_left2; auto.
+ destruct Post; simpl_ret_assert. apply bi.and_elim_r; auto.
 +
- destruct Post; simpl_ret_assert. apply andp_left2; auto.
+ destruct Post; simpl_ret_assert. apply bi.and_elim_r; auto.
 +
- intros; destruct Post; simpl_ret_assert. apply andp_left2; auto.
+ intros; destruct Post; simpl_ret_assert. apply bi.and_elim_r; auto.
 +
  eapply semax_pre; [ | apply semax_break].
  autorewrite with ret_assert.
  eapply derives_trans; [ | apply (H4 a)]. clear.
- apply andp_derives; auto.
+ apply bi.and_mono; auto.
  rewrite <- insert_prop.
  clear.
  forget (PROPx (P a) (LOCALx (Q a) (SEPx (R a)))) as PQR.
- intro rho.  simpl. unfold_lift.  unfold local, lift1. normalize.
+ raise_rho.  simpl. unfold_lift.  unfold local, lift1. normalize.
  rewrite H0. normalize.
 +
  eapply semax_post_flipped.
  apply H2.
- all: intros; apply andp_left2; auto.
+ all: intros; apply bi.and_elim_r; auto.
 *
  make_sequential.
- Intros a.
- eapply semax_post_flipped. apply (H3 a).
- all: intros; destruct Post; simpl_ret_assert; apply andp_left2; auto.
+ apply extract_exists_pre. intro a.
+ eapply semax_post_flipped. apply H3.
+ all: intros; destruct Post; simpl_ret_assert; apply bi.and_elim_r; auto.
 Qed.
 
 Lemma semax_for_3g2:  (* no break statements in loop *)
- forall Espec {cs: compspecs} {A} (PQR: A -> environ -> mpred) (v: A -> val) Delta P Q R test body incr Post,
+ forall `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} {cs: compspecs} 
+     {A} (PQR: A -> assert) (v: A -> val) E Delta P Q R test body incr Post,
      bool_type (typeof test) = true ->
-     (forall a, ENTAIL Delta, PROPx (P a) (LOCALx (Q a) (SEPx (R a))) |-- (tc_expr Delta (Eunop Cop.Onotbool test tint))) ->
-     (forall a, ENTAIL Delta, PROPx (P a) (LOCALx (Q a) (SEPx (R a))) |-- local (`(eq (v a)) (eval_expr test))) ->
-     (forall a, @semax cs Espec Delta (PROPx (typed_true (typeof test) (v a) :: (P a)) (LOCALx (Q a) (SEPx (R a))))
-                 body (loop1x_ret_assert (EX a:A, PQR a) Post)) ->
-     (forall a, @semax cs Espec Delta (PQR a) incr
-                         (normal_ret_assert (EX a:A, PROPx (P a) (LOCALx (Q a) (SEPx (R a)))))) ->
-     @semax cs Espec Delta (EX a:A, PROPx (P a) (LOCALx (Q a) (SEPx (R a))))
+     (forall a, ENTAIL Delta, PROPx (P a) (LOCALx (Q a) (SEPx (R a))) ⊢ (tc_expr Delta (Eunop Cop.Onotbool test tint))) ->
+     (forall a, ENTAIL Delta, PROPx (P a) (LOCALx (Q a) (SEPx (R a))) ⊢ local (`(eq (v a)) (eval_expr test))) ->
+     (forall a, semax E Delta (PROPx (typed_true (typeof test) (v a) :: (P a)) (LOCALx (Q a) (SEPx (R a))))
+                 body (loop1x_ret_assert (∃ a:A, PQR a) Post)) ->
+     (forall a, semax E Delta (PQR a) incr
+                         (normal_ret_assert (∃ a:A, PROPx (P a) (LOCALx (Q a) (SEPx (R a)))))) ->
+     semax E Delta (∃ a:A, PROPx (P a) (LOCALx (Q a) (SEPx (R a))))
                  (Sloop (Ssequence (Sifthenelse test Sskip Sbreak)  body) incr)
                  (overridePost
-                      (EX a:A, PROPx (typed_false (typeof test) (v a) :: (P a)) (LOCALx (Q a) (SEPx (R a))))
+                      (∃ a:A, PROPx (typed_false (typeof test) (v a) :: (P a)) (LOCALx (Q a) (SEPx (R a))))
                   Post).
 Proof.
 intros.
 eapply semax_for_3g1; try eassumption.
 *
  intro a.  eapply semax_post_flipped. apply H2.
- all: intros; destruct Post; simpl_ret_assert; apply andp_left2; auto.
- apply FF_left.
+ all: intros; destruct Post; simpl_ret_assert; rewrite bi.and_elim_r; auto.
+ apply bi.False_elim.
 *
  intro a.
- apply andp_left2. destruct Post; simpl_ret_assert. Exists a. auto.
+ rewrite bi.and_elim_r. destruct Post; simpl_ret_assert. apply (bi.exist_intro' _ _ a). auto.
 Qed.
 
-Transparent tc_andp.  (* ? should leave it opaque, maybe? *)
+Transparent tc_andp.  (* ? should leave it opaque, maybe? *) 
 
diff --git a/floyd/freezer.v b/floyd/freezer.v
index ec5cbaf6ed..e8f2d3cf1d 100644
--- a/floyd/freezer.v
+++ b/floyd/freezer.v
@@ -1,12 +1,12 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.canon.
 Require Import VST.floyd.entailer.
 Require Import Coq.Lists.List.
 Export ListNotations.
 Require Import VST.floyd.client_lemmas.
 
-Local Open Scope logic.
-
 Module ZOrder <: Orders.TotalLeBool.
   Definition t := Z.
   Definition leb := Z.leb.
@@ -28,35 +28,48 @@ End NatOrder.
 Module SortNat := Mergesort.Sort(NatOrder).
 
 Module Type FREEZER.
+
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ}.
+
 Parameter FRZ : mpred -> mpred.
-Parameter FRZ1: forall p, p |-- FRZ p.
-Parameter FRZ2: forall p, FRZ p |-- p.
+(* Should we just replace these by FRZ p = p? *)
+Parameter FRZ1: forall p, p ⊢ FRZ p.
+Parameter FRZ2: forall p, FRZ p ⊢ p.
 
 Parameter FRZL : list mpred -> mpred.
-Parameter FRZL1: forall ps, fold_right sepcon emp ps |-- FRZL ps.
-Parameter FRZL2: forall ps, FRZL ps |-- fold_right sepcon emp ps.
+Parameter FRZL1: forall ps, fold_right bi_sep emp ps ⊢ FRZL ps.
+Parameter FRZL2: forall ps, FRZL ps ⊢ fold_right bi_sep emp ps.
 
 Parameter FRZRw : list mpred -> list mpred -> Type.
 Parameter FRZRw_constr : forall {L1 G1: list mpred} {F: mpred},
-    ((fold_right sepcon emp G1) |-- fold_right sepcon emp L1 * F) -> FRZRw L1 G1.
+    ((fold_right bi_sep emp G1) ⊢ fold_right bi_sep emp L1 ∗ F) -> FRZRw L1 G1.
 Parameter FRZR : forall L1 G1 {w: FRZRw L1 G1}, mpred.
-Parameter FRZR1: forall L1 G1 (w: FRZRw L1 G1), fold_right sepcon emp G1 |-- fold_right sepcon emp L1 * @FRZR L1 G1 w.
-Parameter FRZR2: forall L1 G1 L2 G2 F H, (F |-- fold_right sepcon emp L2 -* fold_right sepcon emp G2) -> fold_right sepcon emp L2  * @FRZR L1 G1 (@FRZRw_constr L1 G1 F H) |-- fold_right sepcon emp G2.
+Parameter FRZR1: forall L1 G1 (w: FRZRw L1 G1), fold_right bi_sep emp G1 ⊢ fold_right bi_sep emp L1 ∗ @FRZR L1 G1 w.
+Parameter FRZR2: forall L1 G1 L2 G2 F H, (F ⊢ fold_right bi_sep emp L2 -∗ fold_right bi_sep emp G2) -> fold_right bi_sep emp L2  ∗ @FRZR L1 G1 (@FRZRw_constr L1 G1 F H) ⊢ fold_right bi_sep emp G2.
+
+End mpred.
 
 End FREEZER.
 
 Module Freezer : FREEZER.
+
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ}.
+
 Definition FRZ (p: mpred) := p.
-Lemma FRZ1 p: p |-- FRZ p. apply derives_refl. Qed.
-Lemma FRZ2 p: FRZ p |-- p. apply derives_refl. Qed.
+Lemma FRZ1 p: p ⊢ FRZ p. apply derives_refl. Qed.
+Lemma FRZ2 p: FRZ p ⊢ p. apply derives_refl. Qed.
 
-Definition FRZL (ps:list mpred): mpred := fold_right sepcon emp ps.
-Lemma FRZL1 ps: (fold_right_sepcon ps) |-- FRZL ps. apply derives_refl. Qed.
-Lemma FRZL2 ps: FRZL ps |-- fold_right_sepcon ps. apply derives_refl. Qed.
+Definition FRZL (ps:list mpred): mpred := fold_right bi_sep emp ps.
+Lemma FRZL1 ps: (fold_right bi_sep emp ps) ⊢ FRZL ps. done. Qed.
+Lemma FRZL2 ps: FRZL ps ⊢ fold_right bi_sep emp ps. done. Qed.
 
 Inductive FRZRw' (L1 G1: list mpred): Type :=
 | FRZRw'_constr: forall F: mpred,
-    ((fold_right sepcon emp G1) |-- fold_right sepcon emp L1 * F) -> FRZRw' L1 G1.
+    ((fold_right bi_sep emp G1) ⊢ fold_right bi_sep emp L1 ∗ F) -> FRZRw' L1 G1.
 
 Definition FRZRw := FRZRw'.
 Definition FRZRw_constr:= FRZRw'_constr.
@@ -66,11 +79,13 @@ Definition FRZR (L1 G1: list mpred) {w: FRZRw L1 G1}: mpred :=
   | FRZRw'_constr F _ => F
   end.
 
-Lemma FRZR1: forall L1 G1 (w: FRZRw L1 G1), fold_right sepcon emp G1 |-- fold_right sepcon emp L1 * @FRZR L1 G1 w.
+Lemma FRZR1: forall L1 G1 (w: FRZRw L1 G1), fold_right bi_sep emp G1 ⊢ fold_right bi_sep emp L1 ∗ @FRZR L1 G1 w.
 Proof. intros ? ? [? ?]. auto. Qed.
 
-Lemma FRZR2: forall L1 G1 L2 G2 F H, (F |-- fold_right sepcon emp L2 -* fold_right sepcon emp G2) -> fold_right sepcon emp L2 * @FRZR L1 G1 (@FRZRw_constr L1 G1 F H) |-- fold_right sepcon emp G2.
-Proof. intros ? ? ? ? ? ? ?. rewrite sepcon_comm. apply wand_sepcon_adjoint; auto. Qed.
+Lemma FRZR2: forall L1 G1 L2 G2 F H, (F ⊢ fold_right bi_sep emp L2 -∗ fold_right bi_sep emp G2) -> fold_right bi_sep emp L2 ∗ @FRZR L1 G1 (@FRZRw_constr L1 G1 F H) ⊢ fold_right bi_sep emp G2.
+Proof. intros ? ? ? ? ? ? ?. iIntros "(? & ?)"; iApply (H0 with "[$]"); done. Qed.
+
+End mpred.
 
 End Freezer.
 
@@ -79,9 +94,13 @@ Notation FRZL := Freezer.FRZL.
 Notation FRZR := Freezer.FRZR.
 Notation FRZRw := Freezer.FRZRw.
 
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {cs: compspecs}.
+
 (************************ Freezing a single mpred ************************)
-Lemma FRZ_ax:forall p, FRZ p = p.
-Proof. intros. apply pred_ext. apply Freezer.FRZ2. apply Freezer.FRZ1. Qed.
+Lemma FRZ_ax:forall p, FRZ p ⊣⊢ p.
+Proof. intros. iSplit; [iApply Freezer.FRZ2 | iApply Freezer.FRZ1]. Qed.
 
 Fixpoint freeze_nth (n: nat) (al: list mpred) {struct n}: list mpred :=
  match n, al with
@@ -91,27 +110,17 @@ Fixpoint freeze_nth (n: nat) (al: list mpred) {struct n}: list mpred :=
  end.
 
 Lemma freeze1_SEP':
- forall n Espec {cs: compspecs} Delta P Q R c Post,
- @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx (freeze_nth n R)))) c Post ->
- @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R))) c Post.
+ forall n E Delta P Q R c Post,
+ semax E Delta (PROPx P (LOCALx Q (SEPx (freeze_nth n R)))) c Post ->
+ semax E Delta (PROPx P (LOCALx Q (SEPx R))) c Post.
 Proof.
-intros. subst.
+intros.
 eapply semax_pre; try apply H.
-apply andp_left2.
-go_lowerx; entailer!.  clear.
+rewrite bi.and_elim_r.
+go_lowerx; entailer!. clear.
 generalize dependent R.
 induction n; destruct R; simpl; cancel. apply Freezer.FRZ1.
 Qed.
-Tactic Notation "freeze1_SEP" constr(n) :=
-  eapply (freeze1_SEP' (Z.to_nat n)); simpl.
-Tactic Notation "freeze1_SEP" constr(n) constr(m) :=
-  (gather_SEP' (n::m::nil)); eapply (freeze1_SEP' (Z.to_nat 0)); simpl.
-Tactic Notation "freeze1_SEP" constr(n) constr(m) constr(k)  :=
-  (gather_SEP' (n::m::k::nil)); eapply (freeze1_SEP' (Z.to_nat 0)); simpl.
-Tactic Notation "freeze1_SEP" constr(n) constr(m) constr(k)  constr(p) :=
-  (gather_SEP' (n::m::k::p::nil)); eapply (freeze1_SEP' (Z.to_nat 0)); simpl.
-Tactic Notation "freeze1_SEP" constr(n) constr(m) constr(k) constr(p) constr(q) :=
-  (gather_SEP' (n::m::k::p::q::nil)); eapply (freeze1_SEP' (Z.to_nat 0)); simpl.
 
 (*******************freezing a list of mpreds ******************************)
 
@@ -126,9 +135,9 @@ Definition freezelist_nth (ns: list nat) (al: list mpred) : list mpred * list mp
   (map (fun i => my_nth i al emp) ns,
    delete_list (SortNat.sort ns) al).
 
-Lemma my_nth_delete_nth_permutation: 
+Lemma my_nth_delete_nth_permutation:
   forall al a, 
-   (a < length al)%nat -> Permutation al (my_nth a al emp :: delete_nth a al).
+   (a < length al)%nat -> Permutation al (my_nth a al (emp : mpred) :: delete_nth a al).
 Proof.
 induction al; simpl; intros.
 lia.
@@ -248,101 +257,73 @@ apply Permutation_trans
 Qed.
 
 (* This older version of freezelist_nth didn't work when the l list was not sorted 
-Fixpoint freezelist_nth (l: list nat) (al: list mpred): (list mpred) * (list mpred) :=
+Fixpoint freezelist_nth (l: list nat) (al: list mpred): (list mpred) ∗ (list mpred) :=
  match l with
  | nil => (nil,al)
  | (n::l') => let (xs, ys) := freezelist_nth l' al
               in (nth n ys emp::xs, delete_nth n ys)
  end.
 *)
-Lemma FRZL_ax ps: FRZL ps = fold_right_sepcon ps.
-Proof. intros. apply pred_ext. apply Freezer.FRZL2. apply Freezer.FRZL1. Qed.
+Lemma FRZL_ax ps: FRZL ps ⊣⊢ fold_right_sepcon ps.
+Proof. intros. rewrite fold_right_sepcon_eq. iSplit; [iApply Freezer.FRZL2 | iApply Freezer.FRZL1]. Qed.
 
 Lemma fold_right_sepcon_deletenth: forall n (l: list mpred),
-  fold_right_sepcon l = nth n l emp * fold_right_sepcon (delete_nth n l).
+  fold_right_sepcon l = (nth n l emp ∗ fold_right_sepcon (delete_nth n l)).
 Proof.
-  induction n; destruct l; simpl. rewrite sepcon_emp; trivial.
+  induction n; destruct l; simpl. rewrite sep_emp; trivial.
   reflexivity.
-  rewrite sepcon_emp; trivial.
-  rewrite IHn.
-  do 2 rewrite <- sepcon_assoc. rewrite (sepcon_comm m). trivial.
+  rewrite sep_emp; trivial.
+  rewrite IHn. rewrite sep_assoc (sep_comm m) -sep_assoc //.
 Qed.
-Lemma fold_right_sepcon_deletenth': forall n (l:list (LiftEnviron mpred)),
-  @fold_right (environ -> mpred) (environ -> mpred) sepcon emp l =
-  nth n l emp * fold_right sepcon emp (delete_nth n l).
+Lemma fold_right_sepcon_deletenth': forall n (l:list assert),
+  @fold_right assert assert bi_sep emp l =
+  (nth n l emp ∗ fold_right bi_sep emp (delete_nth n l)).
 Proof.
-  induction n; destruct l; simpl. rewrite sepcon_emp; trivial.
+  induction n; destruct l; simpl. rewrite sep_emp'; trivial.
   reflexivity.
-  rewrite sepcon_emp; trivial.
-  rewrite IHn; clear IHn. extensionality. simpl.
-  do 2 rewrite <- sepcon_assoc. rewrite (sepcon_comm (l x)). trivial.
+  rewrite sep_emp'; trivial.
+  rewrite IHn; clear IHn.
+  rewrite sep_assoc' (sep_comm' a) -sep_assoc' //.
 Qed.
 
 Lemma fold_right_sepcon_permutation:
- forall al bl, Permutation al bl -> fold_right_sepcon al = fold_right_sepcon bl.
+ forall (al bl : list mpred), Permutation al bl -> fold_right_sepcon al = fold_right_sepcon bl.
 Proof.
 intros.
 induction H; simpl; auto.
-congruence.
-rewrite <- ! sepcon_assoc.
-rewrite (sepcon_comm x).
-auto.
-congruence.
+- rewrite IHPermutation //.
+- rewrite sep_assoc (sep_comm y) -sep_assoc //.
+- rewrite IHPermutation1 //.
 Qed.
 
 Lemma freeze_SEP':
- forall l Espec {cs: compspecs} Delta P Q  R c Post xs ys,
+ forall l E Delta P Q  R c Post xs ys,
   is_increasing (SortNat.sort l) (length R) = true ->
  (xs, ys) = freezelist_nth l R ->
- @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx (FRZL xs:: ys)))) c Post ->
- @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R))) c Post.
+ semax E Delta (PROPx P (LOCALx Q (SEPx (FRZL xs:: ys)))) c Post ->
+ semax E Delta (PROPx P (LOCALx Q (SEPx R))) c Post.
 Proof.
-intros *. intro Hii; intros. subst.
+intros *. intro Hii; intros.
 eapply semax_pre; try eassumption.
-apply andp_left2. unfold PROPx. normalize.
-apply andp_derives; auto.
-pose proof (freezelist_nth_permutation _ _ Hii).
-rewrite <- H in H2.
-simpl in H2.
-clear - H2.
-unfold SEPx.
-intros _.
-rewrite (fold_right_sepcon_permutation _ _ H2).
-rewrite FRZL_ax.
-clear.
-induction xs; simpl.
-rewrite emp_sepcon.
-auto.
-rewrite sepcon_assoc.
-apply sepcon_derives; auto.
+go_lowerx.
+pose proof (freezelist_nth_permutation _ _ Hii) as HR.
+rewrite -H /= in HR.
+erewrite fold_right_sepcon_permutation, fold_right_sepcon_app, FRZL_ax; done.
 Qed.
 
 Lemma freeze_SEP'entail:
  forall l Delta P Q  R Post xs ys,
   is_increasing (SortNat.sort l) (length R) = true ->
  (xs, ys) = freezelist_nth l R ->
- ENTAIL Delta, (PROPx P (LOCALx Q (SEPx (FRZL xs:: ys)))) |-- Post ->
- ENTAIL Delta, (PROPx P (LOCALx Q (SEPx R))) |-- Post.
+ ENTAIL Delta, (PROPx P (LOCALx Q (SEPx (FRZL xs:: ys)))) ⊢ Post ->
+ ENTAIL Delta, (PROPx P (LOCALx Q (SEPx R))) ⊢ Post.
 Proof.
-intros *. intro Hii; intros. subst.
-eapply derives_trans; try apply H0.
-unfold PROPx. normalize.
-apply andp_derives; auto.
-pose proof (freezelist_nth_permutation _ _ Hii).
-rewrite <- H in H2.
-simpl in H2.
-clear - H2.
-apply andp_derives; auto.
-unfold SEPx.
-intros _.
-rewrite (fold_right_sepcon_permutation _ _ H2).
-rewrite FRZL_ax.
-clear.
-induction xs; simpl.
-rewrite emp_sepcon.
-auto.
-rewrite sepcon_assoc.
-apply sepcon_derives; auto.
+intros *. intro Hii; intros.
+rewrite -H0.
+go_lowerx.
+pose proof (freezelist_nth_permutation _ _ Hii) as HR.
+rewrite -H /= in HR.
+erewrite fold_right_sepcon_permutation, fold_right_sepcon_app, FRZL_ax; done.
 Qed.
 
 Lemma map_delete_nth {A B} (f:A->B): forall n l, delete_nth n (map f l) = map f (delete_nth n l).
@@ -405,7 +386,7 @@ Proof. (*unfold my_freezelist_nth, freezelist_nth. *)
 Qed.
 
 (*Variant if l is monotonically decreasing
-Fixpoint new_freezelist_nth (l: list nat) (al: list mpred): (list mpred) * (list mpred) :=
+Fixpoint new_freezelist_nth (l: list nat) (al: list mpred): (list mpred) ∗ (list mpred) :=
  match l with
  | nil => (nil,al)
  | (n::l') => let (xs, ys) := new_freezelist_nth l' (my_delete_nth n al)
@@ -413,11 +394,11 @@ Fixpoint new_freezelist_nth (l: list nat) (al: list mpred): (list mpred) * (list
  end.*)
 
 Lemma freeze_SEP'':
- forall l Espec {cs: compspecs} Delta P Q  R c Post xs ys,
+ forall l E Delta P Q  R c Post xs ys,
   is_increasing (SortNat.sort l) (length R) = true ->
  (xs, ys) = my_freezelist_nth l R ->
- @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx (FRZL xs:: ys)))) c Post ->
- @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R))) c Post.
+ semax E Delta (PROPx P (LOCALx Q (SEPx (FRZL xs:: ys)))) c Post ->
+ semax E Delta (PROPx P (LOCALx Q (SEPx R))) c Post.
 Proof. intros. rewrite my_freezelist_nth_freezelist_nth in H0.
   eapply freeze_SEP'; eassumption.  Qed.
 
@@ -425,11 +406,24 @@ Lemma freeze_SEP''entail:
  forall l Delta P Q  R Post xs ys,
   is_increasing (SortNat.sort l) (length R) = true ->
  (xs, ys) = my_freezelist_nth l R ->
- ENTAIL Delta, (PROPx P (LOCALx Q (SEPx (FRZL xs:: ys)))) |-- Post ->
- ENTAIL Delta, (PROPx P (LOCALx Q (SEPx R))) |-- Post.
+ ENTAIL Delta, (PROPx P (LOCALx Q (SEPx (FRZL xs:: ys)))) ⊢ Post ->
+ ENTAIL Delta, (PROPx P (LOCALx Q (SEPx R))) ⊢ Post.
 Proof. intros. rewrite my_freezelist_nth_freezelist_nth in H0.
   eapply freeze_SEP'entail; eassumption.  Qed.
 
+End mpred.
+
+Tactic Notation "freeze1_SEP" constr(n) :=
+  eapply (freeze1_SEP' (Z.to_nat n)); simpl.
+Tactic Notation "freeze1_SEP" constr(n) constr(m) :=
+  (gather_SEP' (n::m::nil)); eapply (freeze1_SEP' (Z.to_nat 0)); simpl.
+Tactic Notation "freeze1_SEP" constr(n) constr(m) constr(k)  :=
+  (gather_SEP' (n::m::k::nil)); eapply (freeze1_SEP' (Z.to_nat 0)); simpl.
+Tactic Notation "freeze1_SEP" constr(n) constr(m) constr(k)  constr(p) :=
+  (gather_SEP' (n::m::k::p::nil)); eapply (freeze1_SEP' (Z.to_nat 0)); simpl.
+Tactic Notation "freeze1_SEP" constr(n) constr(m) constr(k) constr(p) constr(q) :=
+  (gather_SEP' (n::m::k::p::q::nil)); eapply (freeze1_SEP' (Z.to_nat 0)); simpl.
+
 Ltac solve_is_increasing :=
   reflexivity ||
   match goal with |- is_increasing (SortNat.sort ?L) ?K = true =>
@@ -444,7 +438,7 @@ Ltac freeze_tac L name :=
   eapply (freeze_SEP'' (map Z.to_nat L)); 
    [solve_is_increasing | reflexivity 
    | match goal with
-           | |- semax _ (PROPx _ (LOCALx _ (SEPx ((FRZL ?xs) :: my_delete_list ?A _)))) _ _ =>
+           | |- semax _ _ (PROPx _ (LOCALx _ (SEPx ((FRZL ?xs) :: my_delete_list ?A _)))) _ _ =>
            let D := fresh name in
            set (D:=xs);
            change xs with (@abbreviate (list mpred) xs) in D;
@@ -457,7 +451,7 @@ Ltac freeze_tac_entail L name :=
   eapply (freeze_SEP''entail (map Z.to_nat L)); 
    [solve_is_increasing | reflexivity 
    | match goal with
-           | |- ENTAIL _, (PROPx _ (LOCALx _ (SEPx ((FRZL ?xs) :: my_delete_list ?A _)))) |-- _ =>
+           | |- ENTAIL _, (PROPx _ (LOCALx _ (SEPx ((FRZL ?xs) :: my_delete_list ?A _)))) ⊢ _ =>
            let D := fresh name in
            set (D:=xs);
 (*           hnf in D;*)
@@ -485,26 +479,26 @@ Definition Zlist_complement (n: nat) (al: list Z) : list Z :=
 
 Ltac find_freeze1 comp id A :=
 lazymatch goal with
-| fr := @abbreviate mpred _ |- semax _ (PROPx _ (LOCALx _ (SEPx ?R))) _ _ =>
+| fr := @abbreviate mpred _ |- semax _ _ (PROPx _ (LOCALx _ (SEPx ?R))) _ _ =>
   match R with context [fr :: ?R'] =>
     let L := constr:(Zlength R - (Z.succ (Zlength R'))) in
      let L := eval cbn in L in
       let A' := constr:(L::A) in
         unfold abbreviate in fr; subst fr; find_freeze1 comp id A'
    end
-| |- semax _ (PROPx _ (LOCALx _ (SEPx ?R))) _ _ => 
+| |- semax _ _ (PROPx _ (LOCALx _ (SEPx ?R))) _ _ => 
             let A' := constr:(if comp then Zlist_complement (length R) A 
                                      else A) in
             let A' := eval compute in A' in
             freeze_tac A' id
-| fr := @abbreviate mpred _ |- ENTAIL _, (PROPx _ (LOCALx _ (SEPx ?R))) |-- _ =>
+| fr := @abbreviate mpred _ |- ENTAIL _, (PROPx _ (LOCALx _ (SEPx ?R))) ⊢ _ =>
   match R with context [fr :: ?R'] =>
     let L := constr:(Zlength R - (Z.succ (Zlength R'))) in
      let L := eval cbn in L in
       let A' := constr:(L::A) in
         unfold abbreviate in fr; subst fr; find_freeze1 comp id A'
    end
-| |- ENTAIL _, (PROPx _ (LOCALx _ (SEPx ?R))) |-- _ => 
+| |- ENTAIL _, (PROPx _ (LOCALx _ (SEPx ?R))) ⊢ _ => 
             let A' := constr:(if comp then Zlist_complement (length R) A 
                                      else A) in
             let A' := eval compute in A' in
@@ -560,34 +554,34 @@ Tactic Notation "freeze" ident(i) ":=" "-" uconstr(a1) uconstr(a2) uconstr(a3) u
 Tactic Notation "freeze" ident(i) ":=" "-" uconstr(a1) uconstr(a2) uconstr(a3) uconstr(a4) uconstr(a5) uconstr(a6) uconstr(a7) uconstr(a8) uconstr(a9) uconstr(a10):=
   freeze1 a1; freeze1 a2; freeze1 a3; freeze1 a4; freeze1 a5; freeze1 a6; freeze1 a7; freeze1 a8; freeze1 a9; freeze1 a10; complement_freezer i.
 
-(****************************************************************************)
+(************************************************************************∗∗∗*)
 
-Lemma flatten_emp_in_mpreds' {A}:
+Lemma flatten_emp_in_mpreds' `{!heapGS Σ} {A}:
   forall n (R: list mpred),
    nth_error R n = Some emp ->
-   @SEPx A R = SEPx (Floyd_firstn n R ++ Floyd_skipn (S n) R).
+   SEPx(A := A) R = SEPx (Floyd_firstn n R ++ Floyd_skipn (S n) R).
 Proof.
-unfold SEPx. intros. extensionality rho.
+unfold SEPx. intros. apply assert_ext; intros; monPred.unseal.
 revert R H. clear.
 induction n; destruct R; intros.
 + inv H.
-+ simpl nth_error in H. inv H. simpl. apply emp_sepcon.
++ simpl nth_error in H. inv H. simpl. apply emp_sep.
 + reflexivity.
 + inv H.
   specialize (IHn _ H1). clear H1. simpl Floyd_firstn.
   change (m :: Floyd_firstn n R) with (app (m::nil) (Floyd_firstn n R)).
   rewrite <- app_assoc. unfold app at 1.
-  simpl; f_equal; auto.
+  simpl; f_equiv; auto.
 Qed.
 
 Lemma flatten_emp_in_SEP':
-  forall n P Q (R: list mpred) R',
+  forall `{!heapGS Σ} n P Q (R: list mpred) R',
    nth_error R n = Some emp ->
    R' = Floyd_firstn n R ++ Floyd_skipn (S n) R ->
    PROPx P (LOCALx Q (SEPx R)) = PROPx P (LOCALx Q (SEPx R')).
 Proof.
 intros.
-f_equal. f_equal. subst R'.
+f_equiv. f_equiv. subst R'.
  apply flatten_emp_in_mpreds'. trivial.
 Qed.
 (*
@@ -608,8 +602,8 @@ Ltac flatten_emp_in_mpreds RR :=
 
 Ltac flatten_emp :=
   match goal with
-  | |- semax _ ?PQR _ _ => flatten_emp_in_SEP PQR
-  | |-  ?PQR |-- _ => first [flatten_emp_in_SEP PQR |
+  | |- semax _ _ ?PQR _ _ => flatten_emp_in_SEP PQR
+  | |-  ?PQR ⊢ _ => first [flatten_emp_in_SEP PQR |
                              flatten_emp_in_mpreds PQR ]
 end.*)
 
@@ -631,8 +625,8 @@ Ltac flatten_emp_in_SEP PQR :=
 
 Ltac flatten_emp :=
   match goal with
-  | |- semax _ ?PQR _ _ => flatten_emp_in_SEP PQR
-  | |-  ?PQR |-- _ => flatten_emp_in_SEP PQR
+  | |- semax _ _ ?PQR _ _ => flatten_emp_in_SEP PQR
+  | |-  ?PQR ⊢ _ => flatten_emp_in_SEP PQR
 end.
 
 (*Thawing a freezer results in the sepcon product of the frozen items.*)
@@ -649,7 +643,7 @@ let x := fresh "x" in let y := fresh "y" in let a := fresh "a" in
 lazymatch goal with
 |  |- context [fold_right_sepcon (map ?F ?A)] =>
   set (x:= fold_right_sepcon (map F A));
-  set (y := F) in *; 
+  set (y := F) in *;
   simpl in x
 |  |- context [fold_right_sepcon ?A] =>
   set (x:= fold_right_sepcon A);
@@ -658,110 +652,70 @@ end;
 pattern x;
 match goal with |- ?A x => set (a:=A) end;
 revert x;
-rewrite <- ?sepcon_assoc, sepcon_emp;
-intro x; subst a x; try subst y;
+intro x; subst a x; rewrite -> ?sep_assoc, sep_emp; try subst y;
   unfold my_delete_list, my_delete_nth, my_nth, fold_right_sepcon;
   repeat flatten_sepcon_in_SEP; repeat flatten_emp.
 
+Section ramification.
+
+Context `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {cs: compspecs}.
+
 (************************ Ramification ************************)
 
-Inductive split_FRZ_in_SEP: list mpred -> list mpred -> list mpred -> Prop :=
+Inductive split_FRZ_in_SEP : list mpred -> list mpred -> list mpred -> Prop :=
 | split_FRZ_in_SEP_nil: split_FRZ_in_SEP nil nil nil
 | split_FRZ_in_SEP_FRZ: forall R R' RF F, split_FRZ_in_SEP R R' RF -> split_FRZ_in_SEP (FRZ F :: R) R' (FRZ F :: RF)
 | split_FRZ_in_SEP_FRZL: forall R R' RF F, split_FRZ_in_SEP R R' RF -> split_FRZ_in_SEP (FRZL F :: R) R' (FRZL F :: RF)
-| split_FRZ_in_SEP_FRZR: forall R R' RF L G w, split_FRZ_in_SEP R R' RF -> split_FRZ_in_SEP (@FRZR L G w :: R) R' (@FRZR L G w :: RF)
+| split_FRZ_in_SEP_FRZR: forall R R' RF L G w, split_FRZ_in_SEP R R' RF -> split_FRZ_in_SEP (FRZR L G (w := w) :: R) R' (FRZR L G (w := w) :: RF)
 | split_FRZ_in_SEP_other: forall R R' RF R0, split_FRZ_in_SEP R R' RF -> split_FRZ_in_SEP (R0 :: R) (R0 :: R') RF.
 
-Ltac prove_split_FRZ_in_SEP :=
-  solve [
-    repeat first
-    [ simple apply split_FRZ_in_SEP_nil
-    | simple apply split_FRZ_in_SEP_FRZ
-    | simple apply split_FRZ_in_SEP_FRZL
-    | simple apply split_FRZ_in_SEP_FRZR
-    | simple apply split_FRZ_in_SEP_other]].
-
 Lemma split_FRZ_in_SEP_spec: forall R R' RF,
   split_FRZ_in_SEP R R' RF ->
-  fold_right_sepcon R = fold_right_sepcon R' * fold_right_sepcon RF.
+  fold_right_sepcon R = (fold_right_sepcon R' ∗ fold_right_sepcon RF).
 Proof.
   intros.
   induction H.
   + simpl.
-    rewrite sepcon_emp; auto.
+    rewrite sep_emp; auto.
   + simpl.
     rewrite IHsplit_FRZ_in_SEP.
-    apply pred_ext; cancel.
+    rewrite sep_assoc (sep_comm (FRZ F)) -sep_assoc //.
   + simpl.
     rewrite IHsplit_FRZ_in_SEP.
-    apply pred_ext; cancel.
+    rewrite sep_assoc (sep_comm (FRZL F)) -sep_assoc //.
   + simpl.
     rewrite IHsplit_FRZ_in_SEP.
-    apply pred_ext; cancel.
+    rewrite sep_assoc (sep_comm (FRZR L G)) -sep_assoc //.
   + simpl.
     rewrite IHsplit_FRZ_in_SEP.
-    apply pred_ext; cancel.
+    rewrite -sep_assoc //.
 Qed.
 
-
-Definition protect_evar {A} (x: A) := x.
-
-Lemma localize: forall R_L Espec {cs: compspecs} Delta P Q R R_FR R_G c Post,
+Lemma localize: forall R_L E Delta P Q R R_FR R_G c Post,
   split_FRZ_in_SEP R R_G R_FR ->
   (let FR_L := @abbreviate _ R_L in
    let FR_G := @abbreviate _ R_G in
    exists  (w: FRZRw FR_L FR_G),
-  @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx (R_L ++ @FRZR FR_L FR_G w :: R_FR)))) c Post) ->
-  @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R))) c Post.
+  semax E Delta (PROPx P (LOCALx Q (SEPx (R_L ++ FRZR FR_L FR_G (w := w) :: R_FR)))) c Post) ->
+  semax E Delta (PROPx P (LOCALx Q (SEPx R))) c Post.
 Proof.
   intros.
   destruct H0 as [? ?].
   eapply semax_pre; [clear H0 | exact H0].
   apply split_FRZ_in_SEP_spec in H.
-  apply andp_left2.
-  apply andp_derives; auto.
-  apply andp_derives; auto.
-  unfold SEPx; intro.
+  go_lowerx.
   rewrite H.
   rewrite fold_right_sepcon_app.
   simpl.
   cancel.
-  apply Freezer.FRZR1.
+  rewrite !fold_right_sepcon_eq; apply Freezer.FRZR1.
 Qed.
 
-Ltac unfold_app :=
-change (@app mpred)
-  with (fix app (l m : list mpred) {struct l} : list mpred :=
-  match l with
-  | nil => m
-  | cons a l1 => cons a (app l1 m)
-  end);
-change (@app Prop)
-  with (fix app (l m : list Prop) {struct l} : list Prop :=
-  match l with
-  | nil => m
-  | cons a l1 => cons a (app l1 m)
-  end);
-cbv beta iota.
-
-Ltac localize R_L :=
-  eapply (localize R_L); [prove_split_FRZ_in_SEP |];
-  let FR_L := fresh "RamL" in
-  let FR_G := fresh "RamG" in
-  intros FR_L FR_G;
-  (* regarding the next 4 lines, see 
-      https://github.com/PrincetonUniversity/VST/issues/756 *)
-  let w := fresh "w" in let wx := fresh "wx" in 
-  evar(wx: FRZRw FR_L FR_G);
-  pose (w := protect_evar wx); subst wx;
-  exists w;
-  unfold_app.
-
 Lemma unlocalize_aux: forall R_G2 R R_FR R_L1 R_G1 R_L2 F w,
-  split_FRZ_in_SEP R R_L2 (@FRZR R_L1 R_G1 w :: R_FR) ->
-  (exists (H: (fold_right_sepcon R_G1) |-- fold_right_sepcon R_L1 * F), w = @Freezer.FRZRw_constr _ _ _ H) ->
-  (F |-- fold_right_sepcon R_L2 -* fold_right_sepcon R_G2) ->
-  fold_right_sepcon R |-- fold_right_sepcon (R_G2 ++ R_FR).
+  split_FRZ_in_SEP R R_L2 (FRZR R_L1 R_G1 (w := w) :: R_FR) ->
+  (exists (H: (fold_right bi_sep emp R_G1) ⊢ fold_right bi_sep emp R_L1 ∗ F), w = Freezer.FRZRw_constr H) ->
+  (F ⊢ fold_right_sepcon R_L2 -∗ fold_right_sepcon R_G2) ->
+  fold_right_sepcon R ⊢ fold_right_sepcon (R_G2 ++ R_FR).
 Proof.
   intros.
   apply split_FRZ_in_SEP_spec in H.
@@ -770,59 +724,157 @@ Proof.
   simpl.
   cancel.
   destruct H0 as [? ?]; subst.
+  rewrite -> !fold_right_sepcon_eq in *.
   apply Freezer.FRZR2.
   auto.
 Qed.
 
-Lemma unlocalize_triple: forall R_G2 Espec {cs: compspecs} Delta P Q R R_FR R_L1 R_G1 R_L2 c Post w,
-  split_FRZ_in_SEP R R_L2 (@FRZR R_L1 R_G1 w :: R_FR) ->
-  (exists (H: fold_right_sepcon R_G1 |-- fold_right_sepcon R_L1 * (fold_right_sepcon R_L2 -* fold_right_sepcon R_G2)), w = @Freezer.FRZRw_constr _ _ _ H) ->
-  (@abbreviate _ (fun _ _ => True) R_L1 R_G1 -> @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx (R_G2 ++ R_FR)))) c Post) ->
-  @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R))) c Post.
+Lemma unlocalize_triple: forall R_G2 E Delta P Q R R_FR R_L1 R_G1 R_L2 c Post w,
+  split_FRZ_in_SEP R R_L2 (FRZR R_L1 R_G1 (w := w) :: R_FR) ->
+  (exists (H: fold_right bi_sep emp R_G1 ⊢ fold_right bi_sep emp R_L1 ∗ (fold_right_sepcon R_L2 -∗ fold_right_sepcon R_G2)), w = Freezer.FRZRw_constr H) ->
+  (@abbreviate _ (fun _ _ => True%type) R_L1 R_G1 -> semax E Delta (PROPx P (LOCALx Q (SEPx (R_G2 ++ R_FR)))) c Post) ->
+  semax E Delta (PROPx P (LOCALx Q (SEPx R))) c Post.
 Proof.
   intros.
   eapply semax_pre; [clear H1 | exact (H1 I)].
-  apply andp_left2.
-  apply andp_derives; auto.
-  apply andp_derives; auto.
-  unfold SEPx; intro.
+  go_lowerx.
   eapply unlocalize_aux; eauto.
 Qed.
 
 Lemma unlocalize_derives_canon: forall R_G2 Delta P Q R R_FR R_L1 R_G1 R_L2 Post w,
-  split_FRZ_in_SEP R R_L2 (@FRZR R_L1 R_G1 w :: R_FR) ->
-  (exists (H: (fold_right_sepcon R_G1) |-- fold_right_sepcon R_L1 * (fold_right_sepcon R_L2 -* fold_right_sepcon R_G2)), w = @Freezer.FRZRw_constr _ _ _ H) ->
-  (@abbreviate _ (fun _ _ => True) R_L1 R_G1 -> local (tc_environ Delta) && PROPx P (LOCALx Q (SEPx (R_G2 ++ R_FR))) |-- Post) ->
-  local (tc_environ Delta) && PROPx P (LOCALx Q (SEPx R)) |-- Post.
+  split_FRZ_in_SEP R R_L2 (FRZR R_L1 R_G1 (w := w) :: R_FR) ->
+  (exists (H: (fold_right bi_sep emp R_G1) ⊢ fold_right bi_sep emp R_L1 ∗ (fold_right_sepcon R_L2 -∗ fold_right_sepcon R_G2)), w = Freezer.FRZRw_constr H) ->
+  (@abbreviate _ (fun _ _ => True%type) R_L1 R_G1 -> local (tc_environ Delta) ∧ PROPx P (LOCALx Q (SEPx (R_G2 ++ R_FR))) ⊢ Post) ->
+  local (tc_environ Delta) ∧ PROPx P (LOCALx Q (SEPx R)) ⊢ Post.
 Proof.
   intros.
-  eapply derives_trans; [clear H1 | exact (H1 I)].
-  apply andp_derives; auto.
-  apply andp_derives; auto.
-  apply andp_derives; auto.
-  unfold SEPx; intro.
+  etrans; [clear H1 | exact (H1 I)].
+  go_lowerx.
   eapply unlocalize_aux; eauto.
 Qed.
 
 Lemma unlocalize_derives_unlift: forall R_G2 Pre R R_FR R_L1 R_G1 R_L2 Post w,
   construct_fold_right_sepcon Pre R ->
-  split_FRZ_in_SEP R R_L2 (@FRZR R_L1 R_G1 w :: R_FR) ->
-  (exists (H: (fold_right_sepcon R_G1) |-- fold_right_sepcon R_L1 * (fold_right_sepcon R_L2 -* fold_right_sepcon R_G2)), w = @Freezer.FRZRw_constr _ _ _ H) ->
-  (@abbreviate _ (fun _ _ => True) R_L1 R_G1 -> fold_left_sepconx (R_G2 ++ R_FR) |-- Post) ->
-  Pre |-- Post.
+  split_FRZ_in_SEP R R_L2 (FRZR R_L1 R_G1 (w := w) :: R_FR) ->
+  (exists (H: (fold_right bi_sep emp R_G1) ⊢ fold_right bi_sep emp R_L1 ∗ (fold_right_sepcon R_L2 -∗ fold_right_sepcon R_G2)), w = Freezer.FRZRw_constr H) ->
+  (@abbreviate _ (fun _ _ => True%type) R_L1 R_G1 -> fold_left_sepconx (R_G2 ++ R_FR) ⊢ Post) ->
+  Pre ⊢ Post.
 Proof.
   intros.
   apply construct_fold_right_sepcon_spec in H.
-  subst Pre.
-  eapply derives_trans; [clear H2 | exact (H2 I)].
+  rewrite -H.
+  etrans; [clear H2 | exact (H2 I)].
   rewrite fold_left_sepconx_eq.
   eapply unlocalize_aux; eauto.
 Qed.
 
 Inductive ramif_frame_gen: mpred -> mpred -> Prop :=
 | ramif_frame_gen_refl: forall P, ramif_frame_gen P P
-| ramif_frame_gen_prop: forall (Pure: Prop) P Q, Pure -> ramif_frame_gen P (imp (prop Pure) Q) -> ramif_frame_gen P Q
-| ramif_frame_gen_allp: forall {A: Type} (x: A) P Q, (forall x: A, ramif_frame_gen (P x) (Q x)) -> ramif_frame_gen (allp P) (Q x).
+| ramif_frame_gen_prop: forall (Pure: Prop) P Q, Pure -> ramif_frame_gen P (⌜Pure⌝ → Q) -> ramif_frame_gen P Q
+| ramif_frame_gen_allp: forall {A: Type} (x: A) P Q, (forall x: A, ramif_frame_gen (P x) (Q x)) -> ramif_frame_gen (bi_forall P) (Q x).
+
+Lemma ramif_frame_gen_spec: forall P Q, ramif_frame_gen P Q -> P ⊢ Q.
+Proof.
+  intros.
+  induction H.
+  + apply derives_refl.
+  + rewrite IHramif_frame_gen.
+    iIntros "H"; iApply "H"; done.
+  + rewrite (bi.forall_elim x) //.
+Qed.
+
+Lemma unlocalizeQ_triple: forall R_G2 E Delta P Q R R_FR R_L1 R_G1 R_L2 F c Post w,
+  split_FRZ_in_SEP R R_L2 (FRZR R_L1 R_G1 (w := w) :: R_FR) ->
+  ramif_frame_gen F (bi_wand (fold_right_sepcon R_L2) (fold_right_sepcon R_G2)) ->
+  (exists (H: (fold_right bi_sep emp R_G1) ⊢ (fold_right bi_sep emp R_L1) ∗ F), w = Freezer.FRZRw_constr H) ->
+  (@abbreviate _ (fun _ _ => True%type) R_L1 R_G1 -> semax E Delta (PROPx P (LOCALx Q (SEPx (R_G2 ++ R_FR)))) c Post) ->
+  semax E Delta (PROPx P (LOCALx Q (SEPx R))) c Post.
+Proof.
+  intros.
+  eapply semax_pre; [clear H2 | exact (H2 I)].
+  go_lowerx.
+  apply ramif_frame_gen_spec in H0; auto.
+  eapply unlocalize_aux; eauto.
+Qed.
+
+Lemma unlocalizeQ_derives_canon: forall R_G2 Delta P Q R R_FR R_L1 R_G1 R_L2 F Post w,
+  split_FRZ_in_SEP R R_L2 (FRZR R_L1 R_G1 (w := w) :: R_FR) ->
+  ramif_frame_gen F (bi_wand (fold_right_sepcon R_L2) (fold_right_sepcon R_G2)) ->
+  (exists (H: (fold_right bi_sep emp R_G1) ⊢ (fold_right bi_sep emp R_L1) ∗ F), w = Freezer.FRZRw_constr H) ->
+  (@abbreviate _ (fun _ _ => True%type) R_L1 R_G1 -> local (tc_environ Delta) ∧ PROPx P (LOCALx Q (SEPx (R_G2 ++ R_FR))) ⊢ Post) ->
+  local (tc_environ Delta) ∧ PROPx P (LOCALx Q (SEPx R)) ⊢ Post.
+Proof.
+  intros.
+  etrans; [clear H2 | exact (H2 I)].
+  go_lowerx.
+  apply ramif_frame_gen_spec in H0; auto.
+  eapply unlocalize_aux; eauto.
+Qed.
+
+Lemma unlocalizeQ_derives_unlift: forall R_G2 Pre R R_FR R_L1 R_G1 R_L2 F Post w,
+  construct_fold_right_sepcon Pre R ->
+  split_FRZ_in_SEP R R_L2 (FRZR R_L1 R_G1 (w := w) :: R_FR) ->
+  ramif_frame_gen F (bi_wand (fold_right_sepcon R_L2) (fold_right_sepcon R_G2)) ->
+  (exists (H: (fold_right bi_sep emp R_G1) ⊢ (fold_right bi_sep emp R_L1) ∗ F), w = Freezer.FRZRw_constr H) ->
+  (@abbreviate _ (fun _ _ => True%type) R_L1 R_G1 -> fold_left_sepconx (R_G2 ++ R_FR) ⊢ Post) ->
+  Pre ⊢ Post.
+Proof.
+  intros.
+  apply construct_fold_right_sepcon_spec in H.
+  rewrite -H.
+  etrans; [clear H3 | exact (H3 I)].
+  apply ramif_frame_gen_spec in H1; auto.
+  rewrite fold_left_sepconx_eq.
+  eapply unlocalize_aux; eauto.
+Qed.
+
+End ramification.
+
+Ltac prove_split_FRZ_in_SEP :=
+  solve [
+    repeat first
+    [ simple apply split_FRZ_in_SEP_nil
+    | simple apply split_FRZ_in_SEP_FRZ
+    | simple apply split_FRZ_in_SEP_FRZL
+    | simple apply split_FRZ_in_SEP_FRZR
+    | simple apply split_FRZ_in_SEP_other]].
+
+
+Definition protect_evar {A} (x: A) := x.
+
+Ltac unfold_app :=
+change (@app mpred)
+  with (fix app (l m : list mpred) {struct l} : list mpred :=
+  match l with
+  | nil => m
+  | cons a l1 => cons a (app l1 m)
+  end);
+change (@app (ouPredI (iResUR _)))
+  with (fix app (l m : list mpred) {struct l} : list mpred :=
+  match l with
+  | nil => m
+  | cons a l1 => cons a (app l1 m)
+  end);
+change (@app Prop)
+  with (fix app (l m : list Prop) {struct l} : list Prop :=
+  match l with
+  | nil => m
+  | cons a l1 => cons a (app l1 m)
+  end);
+cbv beta iota.
+
+Ltac localize R_L :=
+  eapply (localize R_L); [prove_split_FRZ_in_SEP |];
+  let FR_L := fresh "RamL" in
+  let FR_G := fresh "RamG" in
+  intros FR_L FR_G;
+  (* regarding the next 4 lines, see 
+      https://github.com/PrincetonUniversity/VST/issues/756 *)
+  let w := fresh "w" in let wx := fresh "wx" in 
+  evar(wx: FRZRw FR_L FR_G);
+  pose (w := protect_evar wx); subst wx;
+  exists w;
+  unfold_app.
 
 Ltac prove_ramif_frame_gen_rec wit :=
   match wit with
@@ -858,69 +910,6 @@ Ltac prove_ramif_frame_gen_prop assu :=
   let Pure := type of H in
     apply (ramif_frame_gen_prop Pure _ _ H).
 
-Lemma ramif_frame_gen_spec: forall P Q, ramif_frame_gen P Q -> P |-- Q.
-Proof.
-  intros.
-  induction H.
-  + apply derives_refl.
-  + apply imp_andp_adjoint in IHramif_frame_gen.
-    eapply derives_trans; [| apply IHramif_frame_gen].
-    apply andp_right; auto.
-    apply prop_right; auto.
-  + apply (allp_left _ x).
-    apply H0.
-Qed.
-
-Lemma unlocalizeQ_triple: forall R_G2 Espec {cs: compspecs} Delta P Q R R_FR R_L1 R_G1 R_L2 F c Post w,
-  split_FRZ_in_SEP R R_L2 (@FRZR R_L1 R_G1 w :: R_FR) ->
-  ramif_frame_gen F (wand (fold_right_sepcon R_L2) (fold_right_sepcon R_G2)) ->
-  (exists (H: (fold_right_sepcon R_G1) |-- sepcon (fold_right_sepcon R_L1) F), w = @Freezer.FRZRw_constr _ _ _ H) ->
-  (@abbreviate _ (fun _ _ => True) R_L1 R_G1 -> @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx (R_G2 ++ R_FR)))) c Post) ->
-  @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R))) c Post.
-Proof.
-  intros.
-  eapply semax_pre; [clear H2 | exact (H2 I)].
-  apply andp_left2.
-  apply andp_derives; auto.
-  apply andp_derives; auto.
-  unfold SEPx; intro.
-  apply ramif_frame_gen_spec in H0; auto.
-  eapply unlocalize_aux; eauto.
-Qed.
-
-Lemma unlocalizeQ_derives_canon: forall R_G2 Delta P Q R R_FR R_L1 R_G1 R_L2 F Post w,
-  split_FRZ_in_SEP R R_L2 (@FRZR R_L1 R_G1 w :: R_FR) ->
-  ramif_frame_gen F (wand (fold_right_sepcon R_L2) (fold_right_sepcon R_G2)) ->
-  (exists (H: (fold_right_sepcon R_G1) |-- sepcon (fold_right_sepcon R_L1) F), w = @Freezer.FRZRw_constr _ _ _ H) ->
-  (@abbreviate _ (fun _ _ => True) R_L1 R_G1 -> local (tc_environ Delta) && PROPx P (LOCALx Q (SEPx (R_G2 ++ R_FR))) |-- Post) ->
-  local (tc_environ Delta) && PROPx P (LOCALx Q (SEPx R)) |-- Post.
-Proof.
-  intros.
-  eapply derives_trans; [clear H2 | exact (H2 I)].
-  apply andp_derives; auto.
-  apply andp_derives; auto.
-  apply andp_derives; auto.
-  unfold SEPx; intro.
-  apply ramif_frame_gen_spec in H0; auto.
-  eapply unlocalize_aux; eauto.
-Qed.
-
-Lemma unlocalizeQ_derives_unlift: forall R_G2 Pre R R_FR R_L1 R_G1 R_L2 F Post w,
-  construct_fold_right_sepcon Pre R ->
-  split_FRZ_in_SEP R R_L2 (@FRZR R_L1 R_G1 w :: R_FR) ->
-  ramif_frame_gen F (wand (fold_right_sepcon R_L2) (fold_right_sepcon R_G2)) ->
-  (exists (H: (fold_right_sepcon R_G1) |-- sepcon (fold_right_sepcon R_L1) F), w = @Freezer.FRZRw_constr _ _ _ H) ->
-  (@abbreviate _ (fun _ _ => True) R_L1 R_G1 -> fold_left_sepconx (R_G2 ++ R_FR) |-- Post) ->
-  Pre |-- Post.
-Proof.
-  intros.
-  apply construct_fold_right_sepcon_spec in H.
-  subst Pre.
-  eapply derives_trans; [clear H3 | exact (H3 I)].
-  apply ramif_frame_gen_spec in H1; auto.
-  rewrite fold_left_sepconx_eq.
-  eapply unlocalize_aux; eauto.
-Qed.
 
 Ltac unprotect_evar := 
  match goal with w := protect_evar _ |- _ => 
@@ -930,17 +919,17 @@ Ltac unprotect_evar :=
 Ltac unlocalize_plain R_G2 :=
   unprotect_evar; 
   match goal with
-  | |- @semax _ _ _ _ _ _ =>
+  | |- @semax _ _ _ _ _ _ _ _ _ _ =>
           eapply (unlocalize_triple R_G2)
-  | |- local (tc_environ _) && _ |-- _ =>
+  | |- local (tc_environ _) ∧ _ ⊢ _ =>
           eapply (unlocalize_derives_canon R_G2)
-  | |- @derives _ Nveric _ _ =>
+  | |- @bi_entails (iPropI _) _ _ =>
           eapply (unlocalize_derives_unlift R_G2); [construct_fold_right_sepcon | ..]
   end;
   [ prove_split_FRZ_in_SEP
   | refine (ex_intro _ _ eq_refl);
     match goal with
-    | |- fold_right_sepcon ?R_G1 |-- sepcon (fold_right_sepcon ?R_L1) _ =>
+    | |- fold_right_sepcon ?R_G1 ⊢ bi_sep (fold_right_sepcon ?R_L1) _ =>
            unfold abbreviate in R_L1, R_G1; unfold R_L1, R_G1; clear R_L1 R_G1
     end;
     rewrite <- !fold_left_sepconx_eq;
@@ -957,11 +946,11 @@ Ltac unlocalize_plain R_G2 :=
 Ltac unlocalize_wit R_G2 wit tac :=
   unprotect_evar; 
   match goal with
-  | |- @semax _ _ _ _ _ _ =>
+  | |- @semax _ _ _ _ _ _ _ _ _ _ =>
           eapply (unlocalizeQ_triple R_G2)
-  | |- local (tc_environ _) && _ |-- _ =>
+  | |- local (tc_environ _) ∧ _ ⊢ _ =>
           eapply (unlocalizeQ_derives_canon R_G2)
-  | |- @derives _ Nveric _ _ =>
+  | |- @bi_entails (iPropI _) _ _ =>
           eapply (unlocalizeQ_derives_unlift R_G2); [construct_fold_right_sepcon | ..]
   end;
   [ prove_split_FRZ_in_SEP
@@ -971,7 +960,7 @@ Ltac unlocalize_wit R_G2 wit tac :=
     prove_ramif_frame_gen wit
   | refine (ex_intro _ _ eq_refl);
     match goal with
-    | |- fold_right_sepcon ?R_G1 |-- sepcon (fold_right_sepcon ?R_L1) _ =>
+    | |- fold_right_sepcon ?R_G1 ⊢ bi_sep (fold_right_sepcon ?R_L1) _ =>
            unfold abbreviate in R_L1, R_G1; unfold R_L1, R_G1; clear R_L1 R_G1
     end;
     rewrite <- !fold_right_sepconx_eq;
@@ -1000,14 +989,13 @@ thaw' i;
 let x := fresh "x" in let y := fresh "y" in let a := fresh "a" in 
 match goal with |- context [fold_right_sepcon (map ?F ?A)] =>
   set (x:= fold_right_sepcon (map F A));
-  set (y := F) in *; 
+  set (y := F) in *;
   simpl in x
 end;
 pattern x;
 match goal with |- ?A x => set (a:=A) end;
 revert x;
-rewrite <- ?sepcon_assoc, sepcon_emp;
-intro x; subst a x y;
+intro x; subst a x y; rewrite -> ?bi.sep_assoc; rewrite bi.sep_emp;
   unfold my_delete_list, my_delete_nth, my_nth, fold_right_sepcon.
 
 Ltac gather_SEP'' L :=
@@ -1040,4 +1028,3 @@ Tactic Notation "gather_SEP" uconstr(a) uconstr(b) uconstr(c) uconstr(d) uconstr
 
 Tactic Notation "gather_SEP" uconstr(a) uconstr(b) uconstr(c) uconstr(d) uconstr(e) uconstr(f) uconstr(g) uconstr(h) uconstr(i0) :=
   gather_SEP'' (a::b::c::d::e::f::g::h::i0::nil) ||  (let i := fresh "i" in freeze i := a b c d e f g h i0; thaw'' i).
-
diff --git a/floyd/functional_base.v b/floyd/functional_base.v
index eb6689d512..63e125400f 100644
--- a/floyd/functional_base.v
+++ b/floyd/functional_base.v
@@ -252,6 +252,19 @@ Definition ptr_eq (v1 v2: val) : Prop :=
 
 Definition ptr_neq (v1 v2: val) := ~ ptr_eq v1 v2.
 
+Lemma ptr_eq_dec: forall v1 v2, {ptr_eq v1 v2} + {~ptr_eq v1 v2}.
+Proof.
+  intros; destruct v1, v2; simpl; auto.
+  - destruct Archi.ptr64; [intuition discriminate|].
+    destruct (Int.eq i i0) eqn: Heq; [|intuition discriminate].
+    destruct (Int.eq i (Int.repr 0)); intuition discriminate.
+  - destruct Archi.ptr64; [|intuition discriminate].
+    destruct (Int64.eq i i0) eqn: Heq; [|intuition discriminate].
+    destruct (Int64.eq i (Int64.repr 0)); intuition discriminate.
+  - destruct (eq_block b b0); [|intuition discriminate].
+    destruct (Ptrofs.eq i i0) eqn: Heq; intuition discriminate.
+Qed.
+
 Lemma ptr_eq_e: forall v1 v2, ptr_eq v1 v2 -> v1=v2.
 Proof.
 intros. destruct v1; destruct v2; simpl in H; try contradiction.
diff --git a/floyd/funspec_old.v b/floyd/funspec_old.v
index d38bab3e35..93d8f77e4d 100644
--- a/floyd/funspec_old.v
+++ b/floyd/funspec_old.v
@@ -1,3 +1,6 @@
+(* Note: this still sort of works, at least for simple examples, but calling functions
+   declared with old_funspecs may fail and making it work will hurt the performance of
+   regular funspecs. Consider this file deprecated. *)
 Require Import VST.floyd.base2.
 Require Import VST.floyd.canon.
 Require Import VST.floyd.client_lemmas.
@@ -13,7 +16,6 @@ Require Import VST.floyd.globals_lemmas.
 Require Import VST.floyd.forward.
 Import ListNotations.
 Import LiftNotation.
-Local Open Scope logic.
 
 Declare Scope old_funspec_scope.
 Delimit Scope old_funspec_scope with old_funspec.
@@ -23,106 +25,106 @@ Notation " a 'OF' ta " := (a%positive,ta%type) (at level 100, only parsing): for
 Delimit Scope formals with formals.
 
 Notation "'WITH' x : tx 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default tx (fun x => P%assert) (fun x => Q%assert))
+     (mk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default tx (fun x => P%assert) (fun x => Q%assert))
             (at level 200, x at level 0, P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH' x : tx 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' (nil, tz) cc_default tx (fun x => P%assert) (fun x => Q%assert))
+     (mk_funspec' (nil, tz) cc_default tx (fun x => P%assert) (fun x => Q%assert))
             (at level 200, x at level 0, P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2)
+     (mk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2)
            (fun x => match x with (x1,x2) => P%assert end)
            (fun x => match x with (x1,x2) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' (nil, tz) cc_default (t1*t2)
+     (mk_funspec' (nil, tz) cc_default (t1*t2)
            (fun x => match x with (x1,x2) => P%assert end)
            (fun x => match x with (x1,x2) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3)
+     (mk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3)
            (fun x => match x with (x1,x2,x3) => P%assert end)
            (fun x => match x with (x1,x2,x3) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' (nil, tz) cc_default (t1*t2*t3)
+     (mk_funspec' (nil, tz) cc_default (t1*t2*t3)
            (fun x => match x with (x1,x2,x3) => P%assert end)
            (fun x => match x with (x1,x2,x3) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, P at level 100, Q at level 100) : old_funspec_scope.
 
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4)
+     (mk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4)
            (fun x => match x with (x1,x2,x3,x4) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0, P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' (nil, tz) cc_default (t1*t2*t3*t4)
+     (mk_funspec' (nil, tz) cc_default (t1*t2*t3*t4)
            (fun x => match x with (x1,x2,x3,x4) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0, P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5)
+     (mk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5)
            (fun x => match x with (x1,x2,x3,x4,x5) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0, x5 at level 0, P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5)
+     (mk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5)
            (fun x => match x with (x1,x2,x3,x4,x5) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0, x5 at level 0, P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6)
+     (mk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6)
            (fun x => match x with (x1,x2,x3,x4,x5,x6) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
               x5 at level 0, x6 at level 0, P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6)
+     (mk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6)
            (fun x => match x with (x1,x2,x3,x4,x5,x6) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
              x5 at level 0, x6 at level 0, P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7)
+     (mk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
               x5 at level 0, x6 at level 0, x7 at level 0, P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7)
+     (mk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
              x5 at level 0, x6 at level 0, x7 at level 0, P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8)
+     (mk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
               x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8)
+     (mk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
              x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9)
+     (mk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -130,7 +132,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
              P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9)
+     (mk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -138,7 +140,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
              P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10)
+     (mk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -147,7 +149,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
              P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10)
+     (mk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -156,7 +158,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
              P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11)
+     (mk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -165,7 +167,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
              P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11)
+     (mk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -174,7 +176,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
              P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12)
+     (mk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -183,7 +185,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
              P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12)
+     (mk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -192,7 +194,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
              P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13)
+     (mk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -201,7 +203,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
              P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13)
+     (mk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -210,7 +212,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
              P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 , x14 : t14 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14)
+     (mk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -219,7 +221,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
              P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 , x14 : t14 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14)
+     (mk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -228,7 +230,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
              P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 , x14 : t14 , x15 : t15 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15)
+     (mk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -239,7 +241,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
 
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 , x14 : t14 , x15 : t15 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15)
+     (mk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -249,7 +251,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
              P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 , x14 : t14 , x15 : t15 , x16 : t16 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16)
+     (mk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -260,7 +262,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
 
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 , x14 : t14 , x15 : t15 , x16 : t16 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16)
+     (mk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -270,7 +272,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
              P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 , x14 : t14 , x15 : t15 , x16 : t16 , x17 : t17 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17)
+     (mk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -281,7 +283,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
 
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 , x14 : t14 , x15 : t15 , x16 : t16 , x17 : t17 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17)
+     (mk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -291,7 +293,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
              P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 , x14 : t14 , x15 : t15 , x16 : t16 , x17 : t17 , x18 : t18 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17*t18)
+     (mk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17*t18)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -302,7 +304,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
 
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 , x14 : t14 , x15 : t15 , x16 : t16 , x17 : t17 , x18 : t18 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17*t18)
+     (mk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17*t18)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -312,7 +314,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
              P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 , x14 : t14 , x15 : t15 , x16 : t16 , x17 : t17 , x18 : t18 , x19 : t19 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17*t18*t19)
+     (mk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17*t18*t19)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -323,7 +325,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
 
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 , x14 : t14 , x15 : t15 , x16 : t16 , x17 : t17 , x18 : t18 , x19 : t19 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17*t18*t19)
+     (mk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17*t18*t19)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -333,7 +335,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
              P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 , x14 : t14 , x15 : t15 , x16 : t16 , x17 : t17 , x18 : t18 , x19 : t19 , x20 : t20 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17*t18*t19*t20)
+     (mk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17*t18*t19*t20)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -345,7 +347,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
 
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 , x14 : t14 , x15 : t15 , x16 : t16 , x17 : t17 , x18 : t18 , x19 : t19 , x20 : t20 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17*t18*t19*t20)
+     (mk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17*t18*t19*t20)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -356,7 +358,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
              P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 , x14 : t14 , x15 : t15 , x16 : t16 , x17 : t17 , x18 : t18 , x19 : t19 , x20 : t20 , x21 : t21 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17*t18*t19*t20*t21)
+     (mk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17*t18*t19*t20*t21)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20,x21) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20,x21) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -368,7 +370,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
 
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 , x14 : t14 , x15 : t15 , x16 : t16 , x17 : t17 , x18 : t18 , x19 : t19 , x20 : t20 , x21 : t21 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17*t18*t19*t20*t21)
+     (mk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17*t18*t19*t20*t21)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20,x21) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20,x21) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -379,7 +381,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
              P at level 100, Q at level 100) : old_funspec_scope.
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 , x14 : t14 , x15 : t15 , x16 : t16 , x17 : t17 , x18 : t18 , x19 : t19 , x20 : t20 , x21 : t21 , x22 : t22 'PRE'  [ ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17*t18*t19*t20*t21*t22)
+     (mk_funspec' (nil, tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17*t18*t19*t20*t21*t22)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20,x21,x22) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20,x21,x22) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -391,7 +393,7 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
 
 
 Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 , x14 : t14 , x15 : t15 , x16 : t16 , x17 : t17 , x18 : t18 , x19 : t19 , x20 : t20 , x21 : t21 , x22 : t22 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
-     (NDmk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17*t18*t19*t20*t21*t22)
+     (mk_funspec' ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17*t18*t19*t20*t21*t22)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20,x21,x22) => P%assert end)
            (fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20,x21,x22) => Q%assert end))
             (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
@@ -401,42 +403,29 @@ Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7
              x20 at level 0, x21 at level 0, x22 at level 0,
              P at level 100, Q at level 100) : old_funspec_scope.
 
-Definition main_pre {Z: Type} (prog: Clight.program) (ora: Z) : globals -> environ -> mpred :=
- fun gv rho => !! (gv = globals_of_env rho) && (globvars2pred gv (prog_vars prog) * has_ext ora).
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ}.
+
+Definition main_pre (prog: Clight.program) (ora: OK_ty) : globals -> assert :=
+ fun gv => local (fun rho => gv = globals_of_env rho) ∧ ⎡globvars2pred gv (prog_vars prog) ∗ has_ext ora⎤.
 
 Lemma old_main_pre_eq:
- forall prog,  convertPre (nil,tint) globals (main_pre prog tt) = SeparationLogic.main_pre prog tt.
+ forall prog ora gv,  convertPre (nil,tint) globals (main_pre prog ora) gv ⊣⊢ semax_prog.main_pre prog ora gv.
 Proof.
 intros.
-unfold convertPre.
-extensionality gv.
-unfold SeparationLogic.main_pre, main_pre.
-extensionality ae.
+unfold convertPre, convertPre'.
+unfold main_pre.
+split => ae.
 destruct ae as [g args].
-simpl.
-apply pred_ext; normalize.
--
-destruct args; inv H.
-simpl. normalize.
-apply derives_refl'.
-f_equal.
-simpl.
-unfold globvars2pred.
-unfold lift2.
-simpl.
-rewrite prop_true_andp; auto.
--
-simpl.
-unfold globvars2pred.
-unfold lift2.
-normalize.
-simpl.
-rewrite prop_true_andp by (split; auto).
-auto.
+rewrite /local /lift1 /=.
+iSplit.
+- iIntros "(% & G & $)".
+  destruct args; inv H; simpl.
+  iDestruct "G" as %->; auto.
+- iIntros "((% & %) & $)"; subst; auto.
 Qed.
 
-Ltac rewrite_old_main_pre ::= rewrite ?old_main_pre_eq; unfold convertPre.
-
 (*Notation "'main_pre'" := (old_main_pre) : old_funspec_scope. *)
 (*
 Definition main_pre := @SeparationLogic.main_pre.
@@ -445,22 +434,23 @@ Arguments main_pre {Z} _ _ _.
 
 Lemma convertPre_helper1:
   forall P1 P Q R x,
-   !! P1 && PROPx P (LOCALx Q (SEPx R)) x = 
-   PROPx P ((!!P1 && (local (fold_right (liftx and) (liftx True) (map locald_denote Q)))) && SEPx R) x.
+   ⌜P1⌝ ∧ PROPx(Σ := Σ) P (LOCALx Q (SEPx R)) x ⊣⊢
+   PROPx P ((⌜P1⌝ ∧ (local (fold_right (liftx and) (liftx True%type) (map locald_denote Q)))) ∧ SEPx R) x.
 Proof.
 intros.
-unfold PROPx, LOCALx; simpl; normalize.
-f_equal; auto.
-f_equal; auto.
-apply prop_ext; intuition.
+unfold PROPx, LOCALx; simpl.
+monPred.unseal.
+rewrite /lift1 /=.
+normalize.
+rewrite and_assoc (and_comm P1) and_assoc //.
 Qed.
 
 Definition all_defined P R vals :=
-andp (!! fold_right and True P) (fold_right_sepcon R) |-- 
-  !! (fold_right and True (map (fun v => v<>Vundef) vals)).
+  ⌜fold_right and True P⌝ ∧ (fold_right_sepcon R) ⊢
+  ⌜fold_right and True (map (fun v => v<>Vundef) vals)⌝ : mpred.
 
 Lemma Forall_fold_right:
- forall {A} (f: A -> Prop) al, Forall f al = fold_right and True (map f al).
+ forall {A} (f: A -> Prop) al, Forall f al = fold_right and True%type (map f al).
 Proof.
 induction al; simpl; intros; apply prop_ext; split; intros ?; auto.
 inv H; split; auto.
@@ -473,56 +463,32 @@ Qed.
 Lemma convertPre_helper2:
   forall P1 P Q R G L x y,
   (Forall (fun v : val => v <> Vundef) L ->
-   !!P1 && (local (fold_right (liftx and) (liftx True) (map locald_denote Q)) x) =
-      !! (snd y = L) &&
-         local (fold_right (liftx and) (liftx True) (map locald_denote (map gvars G)))
+   ⌜P1⌝ ∧ (local(Σ := Σ) (fold_right (liftx and) (liftx True%type) (map locald_denote Q)) x) ⊣⊢
+      ⌜snd y = L⌝ ∧
+         local (fold_right (liftx and) (liftx True%type) (map locald_denote (map gvars G)))
                    (Clight_seplog.mkEnv (fst y) [] [])) ->
    all_defined P R L ->
-   !! P1 && PROPx P (LOCALx Q (SEPx R)) x 
-   = PROPx P (LAMBDAx G L (SEPx R)) y.
+   ⌜P1⌝ ∧ PROPx P (LOCALx Q (SEPx R)) x
+   ⊣⊢ PROPx P (LAMBDAx G L (SEPx R)) y.
 Proof.
 intros.
 unfold PROPx,PARAMSx, GLOBALSx, LOCALx, SEPx.
 red in H0.
-unfold local, lift1.
-simpl.
-unfold_lift.
-apply pred_ext; normalize;
-rewrite prop_true_andp in H0 by auto.
--
-clear P H2.
-rewrite prop_true_andp in H by auto.
-clear P1 H1.
-eapply derives_trans.
-apply andp_right; [apply H0 | apply derives_refl].
-clear H0.
-Intros.
-rewrite <- Forall_fold_right in H0.
-specialize (H H0); clear H0.
-unfold local, lift1 in H.
-normalize in H.
-apply derives_trans with (fold_right_sepcon R && TT).
-normalize.
-rewrite H; clear H.
-normalize.
-apply andp_right; [ | apply derives_refl].
-apply prop_right; split; auto.
--
-unfold argsassert2assert.
-apply andp_right; [ | apply derives_refl].
-eapply derives_trans.
-apply andp_right; [apply H0 | apply derives_refl].
-clear H0.
-Intros.
-rewrite <- Forall_fold_right in H0.
-specialize (H H0); clear H0.
-unfold local, lift1 in H.
-normalize in H.
-apply derives_trans with (fold_right_sepcon R && TT).
-normalize.
-rewrite <- H; clear H.
-normalize.
-apply prop_right; split; auto.
+unfold local, lift1 in *; simpl in *.
+monPred.unseal.
+iSplit.
+- iIntros "(% & % & % & ?)".
+  iDestruct (H0 with "[-]") as %?; auto.
+  rewrite Forall_fold_right in H.
+  iSplit; first done.
+  rewrite assoc; iSplit; last done.
+  iApply H; auto.
+- iIntros "(% & % & % & ?)".
+  iDestruct (H0 with "[-]") as %?; auto.
+  rewrite Forall_fold_right in H.
+  iFrame "%".
+  rewrite assoc; iSplit; last done.
+  iApply H; auto.
 Qed.
 
 
@@ -547,9 +513,9 @@ Fixpoint temps_of_localdef (dl: list localdef) : list ident :=
  end.
 
 Definition no_locals_localdefs : list localdef -> Prop :=
- Forall (fun d => match d with lvar _ _ _ => False | _ => True end).
+ Forall (fun d => match d with lvar _ _ _ => False%type | _ => True%type end).
 Definition no_globals_localdefs : list localdef -> Prop :=
- Forall (fun d => match d with gvars _ => False | _ => True end).
+ Forall (fun d => match d with gvars _ => False%type | _ => True%type end).
 
 Fixpoint globals_localdefs (lds: list localdef) : list globals :=
  match lds with
@@ -584,81 +550,6 @@ Proof.
 intro; inv H.
 Qed.
 
-Ltac prove_all_defined := 
- red; simpl makePARAMS;
-lazymatch goal with |- !! ?A _ _ _ && _ |-- !! ?B=>
- let a := fresh "a" in let b := fresh "b" in 
-  set (b:=B); set (a:=A); 
-  unfold fold_right in a;
- simpl in b;
-  unfold fold_right_sepcon;
-  subst a b; cbv beta iota zeta
-end;
-pull_out_props;
-saturate_local;
-apply prop_right; repeat split;
-let H := fresh in 
-try congruence; 
-try apply Vptrofs_neq_Vundef;
-try apply Vbyte_neq_Vundef;
-try apply nullval_neq_Vundef;
-try (intro H; rewrite H in *;
-      (contradiction || eapply field_compatible_Vundef; eassumption));
-match goal with  |- ?A <> Vundef =>
-  fail 100 "From assumptions above the line and PROP and SEP clauses in precondition, cannot prove LOCAL variable" A "<>Vundef"
-end.
-
-Ltac convertPreElim' := 
-unfold convertPre;
-let ae := fresh "ae" in extensionality ae;
-let g := fresh "g" in let args := fresh "args" in destruct ae as [g args];
-lazymatch goal with |-
-  andp _ (PROPx _ (LOCALx ?Q _) _)  =  PROPx _ (LAMBDAx ?G _ _) _ =>
- unify G (globals_localdefs Q)
-end;
-apply convertPre_helper2;
- [intro;
-  simpl fst; simpl snd;
-  match goal with |- !! (_ = Datatypes.length ?L) && local (fold_right _ _ (map _ ?D)) _=
-                              !! (args = ?A) && local (fold_right _ _ (map _ (map _ ?G))) _ => 
-  let p := constr:(makePARAMS L D) in
-  let p := eval simpl in p in 
-    unify A p
-   end
-  | ];  
-  [ | prove_all_defined ];
-unfold local, lift1; unfold_lift; rewrite <- !prop_and; apply f_equal;
-let H0 := fresh in let H1 := fresh  in 
-apply prop_ext; split; intros [H0 H1];
-[ simpl in H0;
-  repeat (destruct args as [ | ? args]; [discriminate H0 | ]);
-  destruct args; [clear H0 | inv H0];
-  simpl in H1; unfold_lift in H1;
-  unfold eval_id, env_set in H1;
-  simpl in H1; 
-  decompose [and] H1; clear H1; subst;
-  simpl;
-  repeat split; auto
-| subst args; 
-  simpl in H1; unfold_lift in H1;
-  unfold eval_id, env_set in H1;
-  simpl in H1; 
-  decompose [and] H1; clear H1; subst;
-  simpl; unfold_lift; unfold eval_id, env_set; simpl;
-  repeat match goal with H: Forall _ _ |- _ => inv H end;
-  repeat split; auto
-].
-
-Ltac convertPreElim := 
-  match goal with |- convertPre _ _ _ _ = _ => idtac end;
-  convertPreElim' || fail 100 "Could not convert old-style precondition to new-style".
-
-Ltac try_convertPreElim ::= 
-  lazymatch goal with
-  | |- convertPre _ _ _ _ = _ =>  convertPreElim
-  | |- _ => reflexivity
-  end.
-
 Lemma convertPre_helper3:
   forall (fsig: funsig) P Q R vals gvs,
   makePARAMS (fst fsig) Q = vals ->
@@ -668,32 +559,29 @@ Lemma convertPre_helper3:
   no_locals_localdefs Q ->
   globals_localdefs Q = gvs ->
   all_defined P R vals ->
-  (fun ae : argsEnviron => !! (Datatypes.length (snd ae) = Datatypes.length (fst fsig)) &&
+  argsassert_of (fun ae : argsEnviron => ⌜Datatypes.length (snd ae) = Datatypes.length (fst fsig)⌝ ∧
       (PROPx P (LOCALx Q (SEPx R)))
         (make_args
            (map fst (fst fsig))
            (snd ae)
            (mkEnviron (fst ae) (Map.empty (block * type))
-              (Map.empty val)))) =
+              (Map.empty val)))) ⊣⊢
   PROPx P (PARAMSx vals (GLOBALSx gvs (SEPx R))).
 Proof.
-intros. 
+intros.
 rename H3 into Hloc. rename H4 into Hglob. rename H5 into Hdef.
-extensionality ae.
+split => ae.
 apply convertPre_helper2; auto.
 clear Hdef; intros Hdef.
 unfold local, lift1.
 unfold_lift.
 simpl.
 normalize.
-f_equal.
-apply prop_ext.
+f_equiv.
 destruct ae as [g args].
 simpl snd.
 simpl fst.
-(*
-
-split.
+(*split.
 -
 clear Hloc Hglob Hdef.
 intros [? ?].
@@ -741,7 +629,7 @@ hnf in H0.
 unfold_lift in H0.
 destruct H0.
  unfold eval_id, env_set in H0. simpl in H0.
-rewrite Map.gss in H0. simpl in H0. auto.
+rewrite Map.gss in H0. simpl in H0. subst.
 apply IHQ; auto.
 destruct H; subst; try contradiction; auto.
 *
@@ -893,8 +781,89 @@ rewrite H1; clear H1.
 *)
 Admitted. (* might be true *)
 
+End mpred.
+
+Ltac rewrite_old_main_pre ::= rewrite ?old_main_pre_eq; unfold convertPre, convertPre'.
+
+Ltac prove_all_defined :=
+ red; simpl makePARAMS;
+lazymatch goal with |- ⌜?A _ _ _⌝ ∧ _ ⊢ ⌜?B⌝ =>
+ let a := fresh "a" in let b := fresh "b" in 
+  set (b:=B); set (a:=A); 
+  unfold fold_right in a;
+ simpl in b;
+  unfold fold_right_sepcon;
+  subst a b; cbv beta iota zeta
+end;
+pull_out_props;
+saturate_local;
+apply bi.pure_intro; repeat split;
+let H := fresh in 
+try congruence; 
+try apply Vptrofs_neq_Vundef;
+try apply Vbyte_neq_Vundef;
+try apply nullval_neq_Vundef;
+try (intro H; rewrite -> H in *;
+      (contradiction || eapply field_compatible_Vundef; eassumption));
+match goal with  |- ?A <> Vundef =>
+  fail 100 "From assumptions above the line and PROP and SEP clauses in precondition, cannot prove LOCAL variable" A "<>Vundef"
+end.
+
+
+
+Ltac convertPreElim' :=
+unfold convertPre;
+let ae := fresh "ae" in split => ae;
+let g := fresh "g" in let args := fresh "args" in destruct ae as [g args];
+lazymatch goal with |-
+  _ ∧ (PROPx _ (LOCALx ?Q _) _)  ⊣⊢  PROPx _ (LAMBDAx ?G _ _) _ =>
+ unify G (globals_localdefs Q)
+end;
+apply convertPre_helper2;
+ [intro;
+  simpl fst; simpl snd;
+  match goal with |- ⌜_ = Datatypes.length ?L⌝ ∧ local (fold_right _ _ (map _ ?D)) _ ⊣⊢
+                              ⌜args = ?A⌝ ∧ local (fold_right _ _ (map _ (map _ ?G))) _ =>
+  let p := constr:(makePARAMS L D) in
+  let p := eval simpl in p in 
+    unify A p
+   end
+  | ];
+  [ | prove_all_defined ];
+unfold local, lift1; unfold_lift; rewrite -!bi.pure_and; f_equiv;
+let H0 := fresh in let H1 := fresh in
+apply prop_ext; split; intros [H0 H1];
+[ simpl in H0;
+  repeat (destruct args as [ | ? args]; [discriminate H0 | ]);
+  destruct args; [clear H0 | inv H0];
+  simpl in H1; unfold_lift in H1;
+  unfold eval_id, env_set in H1;
+  simpl in H1;
+  decompose [and] H1; clear H1; subst;
+  simpl;
+  repeat split; auto
+| subst args;
+  simpl in H1; unfold_lift in H1;
+  unfold eval_id, env_set in H1;
+  simpl in H1;
+  decompose [and] H1; clear H1; subst;
+  simpl; unfold_lift; unfold eval_id, env_set; simpl;
+  repeat match goal with H: Forall _ _ |- _ => inv H end;
+  repeat split; auto
+].
+
+Ltac convertPreElim :=
+  match goal with |- monPred_at (convertPre _ _ _ _) ⊣⊢ _ => idtac end;
+  convertPreElim' || fail 100 "Could not convert old-style precondition to new-style".
+
+Ltac try_convertPreElim ::=
+  lazymatch goal with
+  | |- (ofe_mor_car _ _ (λne _, monPred_at (convertPre _ _ _ _)) _) ⊣⊢ _ => unfold ofe_mor_car; convertPreElim
+  | |- monPred_at (convertPre _ _ _ _) ⊣⊢ _ => convertPreElim
+  | |- _ => reflexivity
+  end.
 
-Ltac prove_norepet := 
+Ltac prove_norepet :=
    clear; repeat constructor; simpl; intros ?H;
      repeat match goal with H: _ \/ _ |- _ => destruct H end;
       repeat match goal with H: _ = _ |- _ => inv H end; auto.
@@ -902,7 +871,7 @@ Ltac prove_norepet :=
 
 Ltac start_func_convert_precondition ::=
 erewrite convertPre_helper3;
- [ 
+ [
  | reflexivity || fail 100 "makePARAMS filed in start_func_convert_precondition"
  | prove_norepet || fail 100 "repeated temp-identifier in LOCAL clause"
  | prove_norepet || fail 100 "repeated formal parameter in funsig"
diff --git a/floyd/globals_lemmas.v b/floyd/globals_lemmas.v
index 0be6220db9..c795d5b319 100644
--- a/floyd/globals_lemmas.v
+++ b/floyd/globals_lemmas.v
@@ -1,4 +1,6 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.nested_field_lemmas.
 Require Import VST.floyd.mapsto_memory_block.
@@ -11,32 +13,7 @@ Require Import VST.floyd.data_at_list_solver.
 Require Import VST.floyd.closed_lemmas.
 Require Import VST.floyd.nested_pred_lemmas.
 Import LiftNotation.
-Import compcert.lib.Maps.
-Local Open Scope logic.
-
-Fixpoint fold_right_sepcon' (l: list(environ->mpred)) : environ -> mpred :=
- match l with
- | nil => emp
- | b::nil => b
- | b::r => b * fold_right_sepcon' r
- end.
-
-Lemma fold_right_sepcon'_eq:
-  fold_right_sepcon' = @fold_right (environ->mpred) _ sepcon emp.
-Proof.
-extensionality l rho.
-induction l; auto.
-simpl.
-destruct l. simpl. rewrite sepcon_emp. auto.
-f_equal; auto.
-Qed.
-
-
-Lemma orp_dup {A}{ND: NatDed A}: forall P: A, P || P = P.
-Proof. intros. apply pred_ext.
-apply orp_left; apply derives_refl.
-apply orp_right1; apply derives_refl.
-Qed.
+Import -(notations) compcert.lib.Maps.
 
 Lemma unsigned_repr_range: forall i, 0 <= i -> 0 <= Ptrofs.unsigned (Ptrofs.repr i) <= i.
 Proof.
@@ -53,14 +30,18 @@ Proof.
   (compute in x; subst x; spec H0; [lia| ]; spec H1; lia).
 Qed.
 
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ}.
+
 Lemma tc_globalvar_sound:
   forall Delta i t gz idata rho,
-   (var_types Delta) ! i = None ->
-   (glob_types Delta) ! i = Some t ->
+   (var_types Delta) !! i = None ->
+   (glob_types Delta) !! i = Some t ->
    gvar_volatile gz = false ->
    gvar_init gz = idata ->
    tc_environ Delta rho ->
-   globvar2pred (globals_of_env rho) (i, gz) |-- init_data_list2pred (globals_of_env rho) idata (readonly2share (gvar_readonly gz)) (eval_var i t rho).
+   globvar2pred (globals_of_env rho) (i, gz) ⊢ init_data_list2pred (globals_of_env rho) idata (readonly2share (gvar_readonly gz)) (eval_var i t rho).
 Proof.
 intros.
 unfold globvar2pred.
@@ -70,18 +51,17 @@ destruct_var_types i.
 destruct_glob_types i.
 unfold globals_of_env.
 unfold eval_var.
-rewrite Heqo0, Heqo1, H1, H2.
-auto.
+rewrite Heqo0 Heqo1 H1 H2 //.
 Qed.
 
 Lemma tc_globalvar_sound':
   forall Delta i t gv idata rho,
-   (var_types Delta) ! i = None ->
-   (glob_types Delta) ! i = Some t ->
+   (var_types Delta) !! i = None ->
+   (glob_types Delta) !! i = Some t ->
    gvar_volatile gv = false ->
    gvar_init gv = idata ->
    tc_environ Delta rho ->
-   globvar2pred (globals_of_env rho) (i, gv) |--
+   globvar2pred (globals_of_env rho) (i, gv) ⊢
    init_data_list2pred (globals_of_env rho) idata (readonly2share (gvar_readonly gv)) (globals_of_env rho i).
 Proof.
 intros.
@@ -90,17 +70,16 @@ simpl.
 red in H3.
 destruct_glob_types i.
 unfold globals_of_env.
-rewrite Heqo0, H1, H2.
-auto.
+rewrite Heqo0 H1 H2 //.
 Qed.
 
-Lemma init_data_tarray_tuchar: (* move this to vst/floyd/globals_lemmas.v *)
+Lemma init_data_tarray_tuchar:
   forall {cs : compspecs} sh (gv : globals) (b : block) (xs : list int) (i : ptrofs),
   Ptrofs.unsigned i + Zlength xs < Ptrofs.modulus ->
   Forall (fun a => Int.unsigned a <= Byte.max_unsigned) xs ->
   init_data_list2pred gv (map Init_int8 xs) sh (Vptr b i)
-  |-- data_at sh (tarray tuchar (Zlength xs)) (map Vint xs) (Vptr b i).
-Proof. 
+  ⊢ data_at sh (tarray tuchar (Zlength xs)) (map Vint xs) (Vptr b i).
+Proof.
   intros.
   replace xs with (map (Int.zero_ext 8) xs). 
   2:{
@@ -119,34 +98,34 @@ Proof.
             (sublist 0 1 (Vint (Int.zero_ext 8 a) :: map Vint (map (Int.zero_ext 8) xs)))
             (sublist 1 (Zlength (Int.zero_ext 8 a :: xs)) (Vint (Int.zero_ext 8 a) :: map Vint (map (Int.zero_ext 8) xs))) (Vptr b i)); try list_solve.
 
-   apply sepcon_derives.
-   + fold tuchar. 
-     rewrite (data_at_singleton_array_eq sh tuchar (Vint (Int.zero_ext 8 a)))
+   apply bi.sep_mono.
+   + fold tuchar.
+     rewrite -> (data_at_singleton_array_eq sh tuchar (Vint (Int.zero_ext 8 a)))
        by trivial.
-     erewrite mapsto_data_at'; auto; trivial.
-     rewrite Int.zero_ext_idem by lia. auto.
-     red; simpl; intuition auto with *.
+     erewrite mapsto_data_at'; [|auto..].
+     rewrite -> Int.zero_ext_idem by lia. auto.
+     red; simpl; intuition auto. lia.
      econstructor. reflexivity. simpl; trivial. apply Z.divide_1_l.
-   + eapply derives_trans. apply IHxs; clear IHxs.
+   + etrans. apply IHxs; clear IHxs.
      * rewrite ! Ptrofs.unsigned_repr; try rep_lia.
      * rewrite Zlength_cons.
        unfold Z.succ. rewrite Z.add_simpl_r. autorewrite with sublist.
-       rewrite sublist_1_cons by lia.
-       rewrite sublist_same by list_solve.
-       apply derives_refl'. f_equal.
+       rewrite -> sublist_1_cons by lia.
+       rewrite -> sublist_same by list_solve.
+       f_equiv.
        unfold field_address0. rewrite if_true; simpl; trivial.
-       red; intuition auto with *.
+       red; intuition auto with field_compatible.
        -- reflexivity.
-       -- red. rewrite sizeof_Tarray, Z.max_r. simpl sizeof; rep_lia. list_solve.
+       -- red. rewrite sizeof_Tarray Z.max_r. simpl sizeof; rep_lia. list_solve.
        -- eapply align_compatible_rec_Tarray; intros.
           econstructor. reflexivity.
           simpl. apply Z.divide_1_l.
-Qed. 
+Qed.
 
 
 
 Lemma init_data_tarray_tint {cs:compspecs} gv b: forall xs i (Hi: Z.divide 4 (Ptrofs.unsigned i)) (Hxs: Ptrofs.unsigned i + 4 * Zlength xs < Ptrofs.modulus),
-  init_data_list2pred gv (map Init_int32 xs) Ews (Vptr b i) |--
+  init_data_list2pred gv (map Init_int32 xs) Ews (Vptr b i) ⊢
   data_at Ews (tarray tint (Zlength xs)) (map Vint xs) (Vptr b i).
 Proof. induction xs; intros; simpl.
   - rewrite data_at_zero_array_eq; auto; reflexivity.
@@ -159,26 +138,26 @@ Proof. induction xs; intros; simpl.
             (Vint a :: map Vint xs) (Vint a :: map Vint xs)
             (sublist 0 1 (Vint a :: map Vint xs))
             (sublist 1 (Zlength (a :: xs)) (Vint a :: map Vint xs)) (Vptr b i)); try list_solve.
-
-   apply sepcon_derives.
-   + rewrite (data_at_singleton_array_eq Ews tint (Vint a)) by trivial.
-     erewrite mapsto_data_at'; auto; trivial.
-     red; simpl; intuition auto with *.
-     econstructor. reflexivity. simpl; trivial.
-   + eapply derives_trans. apply IHxs; clear IHxs.
-     * rewrite ! Ptrofs.unsigned_repr; try rep_lia.
-        apply Z.divide_add_r; [ trivial | apply Z.divide_refl].
-     * rewrite ! Ptrofs.unsigned_repr; rep_lia.
-     * rewrite Zlength_cons.
-       replace (Z.succ (Zlength xs) - 1) with (Zlength xs) by lia.
-       apply derives_refl'. f_equal. list_solve.
-       unfold field_address0. rewrite if_true; simpl; trivial.
-       red; intuition auto with *.
-       -- reflexivity.
-       -- red. rewrite sizeof_Tarray, Z.max_r. simpl sizeof; rep_lia. list_solve.
-       -- eapply align_compatible_rec_Tarray; intros.
-          econstructor. reflexivity.
-          apply Z.divide_add_r; [ trivial | exists i0; rewrite Z.mul_comm; reflexivity].
+    rewrite -> (data_at_singleton_array_eq Ews tint (Vint a)) by trivial.
+    erewrite mapsto_data_at'; auto; trivial.
+    rewrite IHxs.
+    rewrite Zlength_cons.
+    replace (Z.succ (Zlength xs) - 1) with (Zlength xs) by lia.
+    cancel. f_equiv. { list_solve. }
+    unfold field_address0. rewrite if_true; simpl; trivial.
+    repeat (split; first done).
+    split3.
+    * red. rewrite sizeof_Tarray Z.max_r. simpl sizeof; rep_lia. list_solve.
+    * eapply align_compatible_rec_Tarray; intros.
+      econstructor. reflexivity.
+      apply Z.divide_add_r; [ trivial | exists i0; rewrite Z.mul_comm; reflexivity].
+    * split. reflexivity. simpl; lia.
+    * rewrite ! Ptrofs.unsigned_repr; try rep_lia.
+      apply Z.divide_add_r; [ trivial | apply Z.divide_refl].
+    * rewrite ! Ptrofs.unsigned_repr; rep_lia.
+    * red; simpl; intuition auto.
+      -- lia.
+      -- econstructor; auto.
 Qed. 
 
 Definition zero_of_type (t: type) : val :=
@@ -205,12 +184,12 @@ Definition init_data2pred'
   | Init_float64 r =>  mapsto sh tdouble v (Vfloat r)
   | Init_space n =>  mapsto_zeros n sh v
   | Init_addrof symb ofs =>
-      match (var_types Delta) ! symb, (glob_types Delta) ! symb with
+      match (var_types Delta) !! symb, (glob_types Delta) !! symb with
       | None, Some (Tarray t n' att) =>
            mapsto sh (Tpointer t noattr) v (offset_val (Ptrofs.unsigned ofs) (gv symb))
       | None, Some t => mapsto sh (Tpointer t noattr) v (offset_val (Ptrofs.unsigned ofs) (gv symb))
       | Some _, Some _ => mapsto_ sh (Tpointer Tvoid noattr) v
-      | _, _ => TT
+      | _, _ => True
       end
  end.
 
@@ -227,26 +206,23 @@ Lemma mapsto_aligned:
  forall t ch, access_mode t = By_value ch ->
   forall  sh b z p,
   mapsto sh t (Vptr b z) p
-   |-- !! (Memdata.align_chunk ch | Ptrofs.unsigned z).
+   ⊢ ⌜(Memdata.align_chunk ch | Ptrofs.unsigned z)⌝.
 Proof.
 intros.
 unfold mapsto. simpl.
 rewrite H.
 if_tac.
-simple_if_tac.
-apply FF_left.
-apply orp_left. normalize. clear H H0.
-rewrite (res_predicates.address_mapsto_align).
-match goal with |- ?A |-- ?B => constructor; change (predicates_hered.derives A B) end.
-intros ? ?. destruct H. apply H0.
-normalize.
-clear.
-rewrite (res_predicates.address_mapsto_align).
-match goal with |- ?A |-- ?B => constructor; change (predicates_hered.derives A B) end.
-intros ? ?. destruct H. apply H0.
-simple_if_tac.
-apply FF_left.
-normalize.
+- simple_if_tac.
+  { iIntros "[]". }
+  iIntros "[H | H]".
+  + rewrite (res_predicates.address_mapsto_align).
+    iDestruct "H" as "(_ & _ & $)".
+  + iDestruct "H" as (??) "H".
+    rewrite (res_predicates.address_mapsto_align).
+    iDestruct "H" as "(_ & $)".
+- simple_if_tac.
+  { iIntros "[]". }
+  normalize.
 Qed.
 
 Lemma sizeof_Tpointer {cs: compspecs} : forall t, 
@@ -270,7 +246,7 @@ Lemma init_data2pred_rejigger {cs: compspecs}:
   v = Vptr b (Ptrofs.repr 0) ->
   readable_share sh ->
    init_data2pred (globals_of_env rho) idata sh (offset_val ofs v)
-    |-- init_data2pred' Delta (globals_of_env rho) idata sh (offset_val ofs v).
+    ⊢ init_data2pred' Delta (globals_of_env rho) idata sh (offset_val ofs v).
 Proof.
 intros until v.
 intros H7 H8 RS.
@@ -284,24 +260,23 @@ assert (H6:=I).
  destruct idata; super_unfold_lift; try apply derives_refl.
  red in H7.
  unfold globals_of_env.
- destruct_var_types i eqn:Hv&Hv'; rewrite ?Hv, ?Hv';
-  destruct_glob_types i eqn:Hg&Hg'; rewrite ?Hg, ?Hg';
+ destruct_var_types i eqn:Hv&Hv'; rewrite ?Hv ?Hv';
+  destruct_glob_types i eqn:Hg&Hg'; rewrite ?Hg ?Hg';
 try solve [simpl; apply TT_right].
  + rewrite H8. cancel.
  + replace (offset_val (Ptrofs.unsigned i0) (globals_of_env rho i)) with (Vptr b0 i0).
-   replace (mapsto sh (Tpointer Tvoid noattr) (offset_val ofs v) (Vptr b0 i0))
-   with (mapsto sh (Tpointer t noattr) (offset_val ofs v) (Vptr b0 i0)).
-   simpl offset_val. rewrite !Ptrofs.add_zero_l.
-   rewrite Ptrofs.repr_unsigned.
-   destruct t; auto; try apply derives_refl.
-   unfold mapsto; simpl.
-   destruct (offset_val ofs v); auto. rewrite !if_true by auto. rewrite andb_false_r.
-   apply derives_refl.
+   trans (mapsto sh (Tpointer t noattr) (offset_val ofs v) (Vptr b0 i0)).
+   2: { simpl offset_val. rewrite !Ptrofs.add_zero_l.
+        rewrite Ptrofs.repr_unsigned.
+        destruct t; auto; try apply derives_refl.
+        unfold mapsto; simpl.
+        destruct (offset_val ofs v); auto. rewrite -> !if_true by auto. rewrite andb_false_r.
+        apply derives_refl. }
    unfold mapsto; simpl.
-   destruct (offset_val ofs v); auto. rewrite !if_true by auto. rewrite andb_false_r.
-   reflexivity.
-   unfold globals_of_env. rewrite Hg'. simpl. rewrite Ptrofs.add_zero_l.
-   f_equal. rewrite Ptrofs.repr_unsigned; auto.
+   destruct (offset_val ofs v); auto. rewrite andb_false_r /=. rewrite -> !if_true by auto.
+   rewrite !Ptrofs.add_zero_l //.
+   { unfold globals_of_env. rewrite Hg'. simpl. rewrite Ptrofs.add_zero_l.
+     f_equal. rewrite Ptrofs.repr_unsigned; auto. }
 Qed.
 
 Lemma readable_readonly2share: forall ro, readable_share (readonly2share ro).
@@ -311,49 +286,47 @@ Qed.
 
 Lemma unpack_globvar  {cs: compspecs}:
   forall Delta gz i t gv idata,
-   (var_types Delta) ! i = None ->
-   (glob_types Delta) ! i = Some t ->
+   (var_types Delta) !! i = None ->
+   (glob_types Delta) !! i = Some t ->
   (complete_legal_cosu_type (gvar_info gv) && is_aligned cenv_cs ha_env_cs la_env_cs (gvar_info gv) 0 = true)%bool ->
    gvar_volatile gv = false ->
    gvar_info gv = t ->
    gvar_init gv = idata :: nil ->
    init_data_size idata <= sizeof t ->
    sizeof t <= Ptrofs.max_unsigned ->
-   local (`and (tc_environ Delta) (fun rho =>gz = globals_of_env rho)) && `(globvar2pred gz (i, gv)) |--
-       `(init_data2pred' Delta gz idata (readonly2share (gvar_readonly gv)) (gz i)).
+   local (`and (tc_environ Delta) (fun rho =>gz = globals_of_env rho)) ∧ ⎡globvar2pred gz (i, gv)⎤ ⊢
+       ⎡init_data2pred' Delta gz idata (readonly2share (gvar_readonly gv)) (gz i)⎤.
 Proof.
 intros.
 go_lowerx. subst gz.
-eapply derives_trans; [eapply tc_globalvar_sound'; try eassumption | ].
+etrans; [eapply tc_globalvar_sound'; try eassumption | ].
 assert (RS:= readable_readonly2share (gvar_readonly gv)).
 forget (readonly2share (gvar_readonly gv)) as sh.
 autorewrite with subst norm1 norm2; normalize.
 unfold init_data_list2pred.
-rewrite sepcon_emp.
+rewrite bi.sep_emp.
 destruct (globvar_eval_var _ _ _ _ H7 H H0) as [b [? ?]].
 assert (globals_of_env rho i = offset_val 0 (globals_of_env rho i)).
 unfold globals_of_env.
 rewrite H9. reflexivity.
-rewrite H10 at 1.
- apply derives_trans with
-     (init_data2pred' Delta (globals_of_env rho) idata sh
+rewrite -> H10 at 1.
+trans (init_data2pred' Delta (globals_of_env rho) idata sh
       (offset_val 0 (globals_of_env rho i))).
 + rewrite andb_true_iff in H1; destruct H1.
   eapply init_data2pred_rejigger; eauto; try lia.
   unfold globals_of_env; rewrite H9; reflexivity.
- +
- unfold init_data2pred'.
++ unfold init_data2pred'.
   rewrite <- H10.
- destruct idata; unfold_lift;
-   try (rewrite H8; simpl; rewrite Ptrofs.add_zero_l; auto);
- try apply derives_refl.
+  destruct idata; unfold_lift;
+    try (rewrite H8; simpl; rewrite Ptrofs.add_zero_l; auto);
+  try apply derives_refl.
 Qed.
 
 Fixpoint id2pred_star   {cs: compspecs}
    (Delta: tycontext) (gz: globals) (sh: share) (v: val) (dl: list init_data) : mpred :=
  match dl with
  | d::dl' => init_data2pred' Delta gz d sh v
-                   * id2pred_star Delta gz sh (offset_val (init_data_size d) v) dl'
+                   ∗ id2pred_star Delta gz sh (offset_val (init_data_size d) v) dl'
  | nil => emp
  end.
 
@@ -374,48 +347,38 @@ Qed.
 
 Lemma unpack_globvar_star  {cs: compspecs}:
   forall Delta gz i gv,
-   (var_types Delta) ! i = None ->
-   (glob_types Delta) ! i = Some (gvar_info gv) ->
+   (var_types Delta) !! i = None ->
+   (glob_types Delta) !! i = Some (gvar_info gv) ->
    gvar_volatile gv = false ->
-   local (`and (tc_environ Delta) (fun rho =>gz = globals_of_env rho)) && `(globvar2pred gz (i, gv)) |-- 
-       `(id2pred_star Delta gz (readonly2share (gvar_readonly gv)) (gz i) (gvar_init gv)).
+   local (`and (tc_environ Delta) (fun rho =>gz = globals_of_env rho)) ∧ ⎡globvar2pred gz (i, gv)⎤ ⊢
+       ⎡id2pred_star Delta gz (readonly2share (gvar_readonly gv)) (gz i) (gvar_init gv)⎤.
 Proof.
 intros until 2. pose proof I. intros H2.
-pose (H5 := True).
 remember (gvar_info gv) as t eqn:H3; symmetry in H3.
 remember (gvar_init gv) as idata eqn:H4; symmetry in H4.
 intros.
-pose (H6:=True).
-go_lowerx. subst gz.
-eapply derives_trans; [eapply tc_globalvar_sound'; eassumption | ].
-normalize.
-  autorewrite with subst norm1 norm2; normalize.
-match goal with |- _ |-- ?F _ _ _ _ _ _  => change F with @id2pred_star end.
-normalize.
-  autorewrite with subst norm1 norm2; normalize.
+go_lowerx. fold id2pred_star. subst gz.
+etrans; [eapply tc_globalvar_sound'; eassumption | ].
 assert (RS:= readable_readonly2share (gvar_readonly gv)).
 forget (readonly2share (gvar_readonly gv)) as sh.
 set (ofs:=0%Z).
 assert (alignof t | Ptrofs.unsigned (Ptrofs.repr ofs)) by (subst ofs; simpl; apply Z.divide_0_r).
-destruct (globvar_eval_var _ _ _ _ H7 H H0) as [b [_ H9']].
+destruct (globvar_eval_var _ _ _ _ H5 H H0) as [b [_ H9']].
 unfold globals_of_env. rewrite H9'. clear H9'.
 remember (Vptr b Ptrofs.zero) as x.
 replace x with (offset_val ofs x) at 1 2 by (subst x; normalize).
 fold (globals_of_env rho).
 clearbody ofs.
-clear H1 H8 gv H3 H2 H4 H H0 H6 H5.
+clear - H5 RS Heqx.
 revert ofs.
 induction idata; simpl; auto; intros.
-match goal with |- _ |-- _ * ?F _ _ _ _ _ _  => 
-    change F with @id2pred_star 
-end.
-apply sepcon_derives.
-*
-  clear IHidata. 
+fold id2pred_star.
+apply bi.sep_mono.
+* clear IHidata.
   eapply init_data2pred_rejigger; eauto.
 * specialize (IHidata (ofs + init_data_size a)).
-   rewrite offset_offset_val.
- apply IHidata.
+  rewrite offset_offset_val.
+  apply IHidata.
 Qed.
 
 Definition inttype2init_data (sz: intsize) : (int -> init_data) :=
@@ -434,30 +397,30 @@ Lemma id2pred_star_ZnthV_Tint  {cs: compspecs} :
   (NBS: notboolsize sz),
   n = Zlength mdata ->
   mdata = map (inttype2init_data sz) data ->
-  !! isptr v && !! align_compatible (Tint sz sign noattr) v &&
-  !! (offset_strict_in_range (sizeof (Tint sz sign noattr) * n)) v &&
-  `(id2pred_star Delta gz sh v mdata) |--
-  `(data_at sh (tarray (Tint sz sign noattr) n)
-           (map (Basics.compose Vint (Cop.cast_int_int sz sign)) data) v).
+  ⌜isptr v⌝ ∧ ⌜align_compatible (Tint sz sign noattr) v⌝ ∧
+  ⌜offset_strict_in_range (sizeof (Tint sz sign noattr) * n) v⌝ ∧
+  (⎡id2pred_star Delta gz sh v mdata⎤ : assert) ⊢
+  ⎡data_at sh (tarray (Tint sz sign noattr) n)
+           (map (Basics.compose Vint (Cop.cast_int_int sz sign)) data) v⎤.
 Proof.
   intros. subst n mdata.
   replace (Zlength (map  (inttype2init_data sz) data)) with (Zlength data)
     by (repeat rewrite Zlength_correct; rewrite map_length; auto).
   go_lowerx.
-  match goal with |- ?F _ _ _ _ _ _ |-- _ => change F with @id2pred_star end.
+  fold id2pred_star.
   change (offset_strict_in_range (sizeof (Tint sz sign noattr) * Zlength data) v) in H1.
   assert (offset_strict_in_range (sizeof (Tint sz sign noattr) * 0) v) by
     (unfold offset_strict_in_range; destruct v; auto; pose proof Ptrofs.unsigned_range i; lia).
-unfold tarray.
-set (t := Tint sz sign noattr) in *.
-revert v H H0 H1 H2; induction data; intros.
+  unfold tarray.
+  set (t := Tint sz sign noattr) in *.
+  revert v H H0 H1 H2; induction data; intros.
 *
   rewrite Zlength_nil. unfold data_at, field_at; simpl.
   unfold at_offset; simpl.
    unfold nested_field_type; simpl.
    rewrite data_at_rec_eq. unfold  aggregate_pred.aggregate_pred.array_pred.
   unfold aggregate_pred.array_pred. simpl.
-  repeat apply andp_right; auto; try apply prop_right; try reflexivity.  
+  repeat apply bi.and_intro; auto; try apply bi.pure_intro; try reflexivity.
   hnf. simpl.
   split3; auto.
   split3; auto.
@@ -473,11 +436,11 @@ erewrite (split2_data_at_Tarray sh t (Z.succ (Zlength data)) 1).
 4: apply eq_refl.
 2: list_solve.
 2: list_solve. 2: auto. 2: list_solve. 2: apply eq_refl. 2: apply eq_refl.
-rewrite (sublist_one) by list_solve.
+rewrite -> (sublist_one) by list_solve.
 autorewrite with sublist.
 rewrite sublist_1_cons.
-rewrite sublist_same by list_solve.
-apply sepcon_derives.
+rewrite -> sublist_same by list_solve.
+apply bi.sep_mono.
 +
 clear IHdata.
 fold (tarray t 1). erewrite data_at_singleton_array_eq by apply eq_refl.
@@ -517,14 +480,14 @@ apply derives_refl.
    destruct v; try contradiction.
    pose proof (Ptrofs.unsigned_range i).
    assert (Ptrofs.max_unsigned = Ptrofs.modulus-1) by computable.
-   rewrite Z.mul_0_r in *.
+   rewrite -> Z.mul_0_r in *.
    assert (0 <= sizeof t * Zlength data) by (apply Z.mul_nonneg_nonneg; lia).
    unfold offset_strict_in_range, offset_val in *.
    unfold align_compatible in H0|-*.
    unfold Ptrofs.add.
-   rewrite (Ptrofs.unsigned_repr (sizeof t)) 
+   rewrite -> (Ptrofs.unsigned_repr (sizeof t)) 
     by (unfold sizeof, Ptrofs.max_unsigned, Ptrofs.modulus, Ptrofs.wordsize, Wordsize_Ptrofs.wordsize;
-          clear; subst t; destruct sz,sign, Archi.ptr64; simpl; lia).
+          clear; subst t; destruct sz,sign, Archi.ptr64; simpl; computable).
   rewrite Ptrofs.unsigned_repr.
   split3; try lia.
    assert (exists ch, access_mode t = By_value ch)
@@ -538,10 +501,10 @@ apply derives_refl.
   lia.
  }
  destruct H8 as [H8a [H8b H8c]].
-  eapply derives_trans; [ apply IHdata | ]; clear IHdata; auto.
+  etrans; [ apply IHdata | ]; clear IHdata; auto.
   replace (Z.succ (Zlength data) - 1) with (Zlength data) by (clear; lia).
-   apply derives_refl'; f_equal.
- unfold field_address0.
+  apply bi.equiv_entails_1_1; f_equiv; hnf.
+  unfold field_address0.
   rewrite if_true.
   unfold offset_val. destruct v; simpl; auto. f_equal.
   subst t; destruct sz,sign; reflexivity.
@@ -552,7 +515,7 @@ apply derives_refl.
   split3; auto; red.
   unfold sizeof, Ctypes.sizeof;  fold Ctypes.sizeof. fold (sizeof t).
   pose proof (Zlength_nonneg data).
-  rewrite Z.max_r by lia.
+  rewrite -> Z.max_r by lia.
   unfold offset_strict_in_range in H1. rewrite Zlength_cons in H1.
   lia.
   apply align_compatible_rec_Tarray; intros.
@@ -575,10 +538,10 @@ Lemma id2pred_star_ZnthV_tint  {cs: compspecs}:
  forall Delta gz sh n (v: val) (data: list int) mdata,
   n = Zlength mdata ->
   mdata = map Init_int32 data ->
-  !! isptr v && !! align_compatible tint v &&
-  !! offset_strict_in_range (sizeof tint * n) v &&
-  `(id2pred_star Delta gz sh v mdata) |--
-  `(data_at sh (tarray tint n) (map Vint data) v).
+  ⌜isptr v⌝ ∧ ⌜align_compatible tint v⌝ ∧
+  ⌜offset_strict_in_range (sizeof tint * n) v⌝ ∧
+  (⎡id2pred_star Delta gz sh v mdata⎤ : assert) ⊢
+  ⎡data_at sh (tarray tint n) (map Vint data) v⎤.
 Proof. intros; apply id2pred_star_ZnthV_Tint; auto; apply Coq.Init.Logic.I.
 Qed.
 
@@ -592,8 +555,8 @@ Qed.
 
 Lemma unpack_globvar_array  {cs: compspecs}:
   forall t sz sign (data: list int)  n Delta gz i gv,
-   (var_types Delta) ! i = None ->
-   (glob_types Delta) ! i = Some (gvar_info gv) ->
+   (var_types Delta) !! i = None ->
+   (glob_types Delta) !! i = Some (gvar_info gv) ->
    gvar_info gv = tarray t n ->
    gvar_volatile gv = false ->
    t = Tint sz sign noattr ->
@@ -601,44 +564,24 @@ Lemma unpack_globvar_array  {cs: compspecs}:
    n = Zlength (gvar_init gv) ->
    gvar_init gv = map (inttype2init_data sz) data ->
    init_data_list_size (gvar_init gv) <= sizeof (gvar_info gv) <= Ptrofs.max_unsigned ->
-   local (`and (tc_environ Delta) (fun rho =>gz = globals_of_env rho)) && `(globvar2pred gz(i, gv)) |--
-      `(data_at (readonly2share (gvar_readonly gv))
+   local (`and (tc_environ Delta) (fun rho =>gz = globals_of_env rho)) ∧ ⎡globvar2pred gz(i, gv)⎤ ⊢
+      ⎡data_at (readonly2share (gvar_readonly gv))
          (tarray (Tint sz sign noattr) n)
          (map (Basics.compose Vint (Cop.cast_int_int sz sign)) data)
-         (gz i)).
+         (gz i)⎤.
 Proof.
   intros. subst t.
-  match goal with |- ?A |-- _ =>
-    erewrite (add_andp A (local (tc_environ Delta)))
-  end.
- 2: solve [apply andp_left1; unfold local, lift1; intro rho; apply prop_derives; intros [? ?]; auto].
-  match goal with |- ?A |-- _ =>
-    erewrite (add_andp A (local (`isptr (eval_var i (tarray (Tint sz sign noattr) n)))))
-  end.
-  2:{
-    go_lowerx. apply prop_right. eapply eval_var_isptr; eauto.
-    right; split; auto. rewrite <- H1; auto.
-   }
-  eapply derives_trans.
-  apply andp_right.
-  apply andp_left1. apply andp_left1. apply andp_left1. apply derives_refl.
-  apply andp_derives; [ apply andp_derives;
-    [ eapply unpack_globvar_star; try eassumption; try reflexivity
-    | apply derives_refl]  | apply derives_refl].
+  iIntros "(#? & H)".
+  iPoseProof (unpack_globvar_star with "[$H]") as "H"; eauto.
   rewrite H5.
-  rewrite <- andp_assoc.
-  apply andp_left1.
-  go_lowerx. 
-  eapply derives_trans; [| apply (id2pred_star_ZnthV_Tint Delta (globals_of_env rho)); auto].
-  instantiate (1 := rho).
- 2: rewrite <- H5; auto.
- match goal with |- ?F _ _ _ _ _ _ |-- _ => change F with @id2pred_star end.
-  subst gz.
-  normalize. clear H8.
-  rewrite H1 in H6.
+  rewrite -(id2pred_star_ZnthV_Tint Delta gz); auto.
+  iStopProof; go_lowerx.
+  rewrite monPred_at_intuitionistically.
+  fold id2pred_star.
+  iIntros "((% & ->) & $)"; iPureIntro.
   assert (headptr (globals_of_env rho i)). {
-    unfold globals_of_env. destruct  (globvar_eval_var _ _ _ _ H3 H H0) as [b [_ H10]]. rewrite H10.
-    exists b; auto. 
+    unfold globals_of_env. eapply globvar_eval_var in H0 as [b [_ H10]]; eauto. rewrite H10.
+    exists b; auto.
   }
   assert (align_compatible (Tint sz sign noattr) (globals_of_env rho i)). {
     destruct H7 as [b ?]. rewrite H7.
@@ -650,28 +593,30 @@ Proof.
     apply Z.divide_0_r.
   }
  apply headptr_isptr in H7.
- simpl andp. fold (sizeof (Tint sz sign noattr)).
-  assert (offset_strict_in_range (sizeof (Tint sz sign noattr) * n) (globals_of_env rho i)). {
-    unfold offset_strict_in_range.
-    destruct (globals_of_env rho i) eqn:?H; auto.
-    rewrite H5 in H6; simpl in H6. unfold sizeof in H6; simpl in H6.
-    pose proof initial_world.zlength_nonneg _ (gvar_init gv).
-    rewrite Z.max_r in H6 by lia.
-   change (match sz with I16 => 2 | I32 => 4 | _ => 1 end)
-    with (sizeof (Tint sz sign noattr)) in H6.
-    unfold Ptrofs.max_unsigned in H6.
-    pose proof init_data_list_size_pos (gvar_init gv).
-    simpl in H8.
-    unfold globals_of_env in H9. destruct (Map.get (ge_of rho) i) eqn:?H; inv H9.
-    rewrite Ptrofs.unsigned_zero.
-    split; try lia. 
-    rewrite Z.add_0_l.
-    apply Z.mul_nonneg_nonneg.
-    clear; pose proof (sizeof_pos (Tint sz sign noattr)); lia.
-    apply Zlength_nonneg.
-  }
-  normalize.
-  apply derives_refl.
+ split; first done; split; first done; split; last done.
+ unfold offset_strict_in_range.
+ destruct (globals_of_env rho i) eqn:?H; auto.
+ rewrite H1 H5 /= /sizeof /= in H6.
+ pose proof initial_world.zlength_nonneg _ (gvar_init gv).
+ rewrite -> Z.max_r in H6 by lia.
+ change (match sz with I16 => 2 | I32 => 4 | _ => 1 end)
+   with (sizeof (Tint sz sign noattr)) in H6.
+ unfold Ptrofs.max_unsigned in H6.
+ pose proof init_data_list_size_pos (gvar_init gv).
+ simpl in H8.
+ unfold globals_of_env in H9. destruct (Map.get (ge_of rho) i) eqn:?H; inv H9.
+ rewrite Ptrofs.unsigned_zero.
+ change (match sz with
+         | I16 => 2
+         | I32 => 4
+         | _ => 1
+         end) with (sizeof (Tint sz sign noattr)).
+ split; try lia.
+ rewrite Z.add_0_l.
+ apply Z.mul_nonneg_nonneg.
+ clear; pose proof (sizeof_pos (Tint sz sign noattr)); lia.
+   apply Zlength_nonneg.
+{ rewrite -H5 //. }
 Qed.
 
 Definition float_type (sz: floatsize) : Type :=
@@ -687,16 +632,16 @@ Lemma id2pred_star_ZnthV_tfloat  {cs: compspecs}:
  forall Delta sz gz sh n (v: val) (data: list (float_type sz)) mdata,
   n = Zlength mdata ->
   mdata = map (floattype2init_data sz) data ->
-  !! isptr v && !! align_compatible (Tfloat sz noattr) v &&
-  !! offset_strict_in_range (sizeof (Tfloat sz noattr) * n) v &&
-  `(id2pred_star Delta gz sh v mdata) |--
-  `(data_at sh (tarray (Tfloat sz noattr) n) (map  (float_constructor sz) data) v).
+  ⌜isptr v⌝ ∧ ⌜align_compatible (Tfloat sz noattr) v⌝ ∧
+  ⌜offset_strict_in_range (sizeof (Tfloat sz noattr) * n) v⌝ ∧
+  (⎡id2pred_star Delta gz sh v mdata⎤ : assert) ⊢
+  ⎡data_at sh (tarray (Tfloat sz noattr) n) (map  (float_constructor sz) data) v⎤.
 Proof. intros.
   subst n mdata.
   replace (Zlength (map  (floattype2init_data sz) data)) with (Zlength data)
     by (repeat rewrite Zlength_correct; rewrite map_length; auto).
   go_lowerx.
-  match goal with |- ?F _ _ _ _ _ _ |-- _ => change F with @id2pred_star end.
+  fold id2pred_star.
   change (offset_strict_in_range (sizeof (Tfloat sz noattr) * Zlength data) v) in H1.
   assert (offset_strict_in_range (sizeof (Tfloat sz noattr) * 0) v) by
     (unfold offset_strict_in_range; destruct v; auto; pose proof Ptrofs.unsigned_range i; lia).
@@ -709,7 +654,7 @@ revert v H H0 H1 H2; induction data; intros.
    unfold nested_field_type; simpl.
    rewrite data_at_rec_eq. unfold  aggregate_pred.aggregate_pred.array_pred.
   unfold aggregate_pred.array_pred. simpl.
-  repeat apply andp_right; auto; try apply prop_right; try reflexivity.  
+  repeat apply bi.and_intro; auto; try apply bi.pure_intro; try reflexivity.  
   hnf. simpl.
   split3; auto.
   split3; auto.
@@ -725,11 +670,11 @@ erewrite (split2_data_at_Tarray sh t (Z.succ (Zlength data)) 1).
 4: apply eq_refl.
 2: list_solve.
 2: list_solve. 2: auto. 2: list_solve. 2: apply eq_refl. 2: apply eq_refl.
-rewrite (sublist_one) by list_solve.
+rewrite -> (sublist_one) by list_solve.
 autorewrite with sublist.
 rewrite sublist_1_cons.
-rewrite sublist_same by list_solve.
-apply sepcon_derives.
+rewrite -> sublist_same by list_solve.
+apply bi.sep_mono.
 +
 clear IHdata.
 fold (tarray t 1). erewrite data_at_singleton_array_eq by apply eq_refl.
@@ -768,14 +713,14 @@ destruct sz; apply derives_refl.
    destruct v; try contradiction.
    pose proof (Ptrofs.unsigned_range i).
    assert (Ptrofs.max_unsigned = Ptrofs.modulus-1) by computable.
-   rewrite Z.mul_0_r in *.
+   rewrite -> Z.mul_0_r in *.
    assert (0 <= sizeof t * Zlength data) by (apply Z.mul_nonneg_nonneg; lia).
    unfold offset_strict_in_range, offset_val in *.
    unfold align_compatible in H0|-*.
    unfold Ptrofs.add.
-   rewrite (Ptrofs.unsigned_repr (sizeof t)) 
+   rewrite -> (Ptrofs.unsigned_repr (sizeof t))
     by (unfold sizeof, Ptrofs.max_unsigned, Ptrofs.modulus, Ptrofs.wordsize, Wordsize_Ptrofs.wordsize;
-          clear; subst t; destruct sz, Archi.ptr64; simpl; lia).
+          clear; subst t; destruct sz, Archi.ptr64; simpl; computable).
   rewrite Ptrofs.unsigned_repr.
   split3; try lia.
    assert (exists ch, access_mode t = By_value ch)
@@ -790,12 +735,12 @@ destruct sz; apply derives_refl.
   lia.
  }
  destruct H8 as [H8a [H8b H8c]].
-  eapply derives_trans; [ apply IHdata | ]; clear IHdata; auto.
+  etrans; [ apply IHdata | ]; clear IHdata; auto.
   replace (Z.succ (Zlength data) - 1) with (Zlength data) by (clear; lia).
-   apply derives_refl'; f_equal.
+   apply bi.equiv_entails_1_1; f_equal.
  unfold field_address0.
   rewrite if_true.
-  unfold offset_val. destruct v; simpl; auto. f_equal.
+  unfold offset_val. destruct v; simpl; auto. f_equiv; hnf.
   subst t; destruct sz; reflexivity.
   eapply field_compatible0_cons_Tarray.
   reflexivity.
@@ -804,7 +749,7 @@ destruct sz; apply derives_refl.
   split3; auto; red.
   unfold sizeof, Ctypes.sizeof;  fold Ctypes.sizeof. fold (sizeof t).
   pose proof (Zlength_nonneg data).
-  rewrite Z.max_r by lia.
+  rewrite -> Z.max_r by lia.
   unfold offset_strict_in_range in H1. rewrite Zlength_cons in H1.
   lia.
   apply align_compatible_rec_Tarray; intros.
@@ -825,49 +770,29 @@ Qed.
 
 Lemma unpack_globvar_array_float  {cs: compspecs}:
   forall t sz (data: list (float_type sz))  n Delta gz i gv,
-   (var_types Delta) ! i = None ->
-   (glob_types Delta) ! i = Some (gvar_info gv) ->
+   (var_types Delta) !! i = None ->
+   (glob_types Delta) !! i = Some (gvar_info gv) ->
    gvar_info gv = tarray t n ->
    gvar_volatile gv = false ->
    t = Tfloat sz noattr ->
    n = Zlength (gvar_init gv) ->
    gvar_init gv = map (floattype2init_data sz) data ->
    init_data_list_size (gvar_init gv) <= sizeof (gvar_info gv) <= Ptrofs.max_unsigned ->
-   local (`and (tc_environ Delta) (fun rho =>gz = globals_of_env rho)) && `(globvar2pred gz(i, gv)) |--
-      `(data_at (readonly2share (gvar_readonly gv))
+   local (`and (tc_environ Delta) (fun rho =>gz = globals_of_env rho)) ∧ ⎡globvar2pred gz(i, gv)⎤ ⊢
+      ⎡data_at (readonly2share (gvar_readonly gv))
          (tarray (Tfloat sz noattr) n)
          (map (float_constructor sz) data)
-         (gz i)).
+         (gz i)⎤.
 Proof.
   intros. subst t.
-  match goal with |- ?A |-- _ =>
-    erewrite (add_andp A (local (tc_environ Delta)))
-  end.
- 2: solve [apply andp_left1; unfold local, lift1; intro rho; apply prop_derives; intros [? ?]; auto].
-  match goal with |- ?A |-- _ =>
-    erewrite (add_andp A (local (`isptr (eval_var i (tarray (Tfloat sz noattr) n)))))
-  end.
-  2:{
-    go_lowerx. apply prop_right. eapply eval_var_isptr; eauto.
-    right; split; auto. rewrite <- H1; auto.
-   }
-  eapply derives_trans.
-  apply andp_right.
-  apply andp_left1. apply andp_left1. apply andp_left1. apply derives_refl.
-  apply andp_derives; [ apply andp_derives;
-    [ eapply unpack_globvar_star; try eassumption; try reflexivity
-    | apply derives_refl]  | apply derives_refl].
+  iIntros "(#? & H)".
+  iPoseProof (unpack_globvar_star with "[$H]") as "H"; eauto.
   rewrite H5.
-  rewrite <- andp_assoc.
-  apply andp_left1.
-  go_lowerx. 
-  eapply derives_trans; [| apply (id2pred_star_ZnthV_tfloat Delta sz (globals_of_env rho)); auto].
-  instantiate (1 := rho).
- 2: rewrite <- H5; auto.
- match goal with |- ?F _ _ _ _ _ _ |-- _ => change F with @id2pred_star end.
-  subst gz.
-  normalize. clear H8.
-  rewrite H1 in H6.
+  rewrite -(id2pred_star_ZnthV_tfloat Delta sz gz); auto.
+  iStopProof; go_lowerx.
+  rewrite monPred_at_intuitionistically.
+  fold id2pred_star.
+  iIntros "((% & ->) & $)"; iPureIntro.
   assert (headptr (globals_of_env rho i)). {
     unfold globals_of_env. destruct  (globvar_eval_var _ _ _ _ H3 H H0) as [b [_ H10]]. rewrite H10.
     exists b; auto. 
@@ -882,28 +807,25 @@ Proof.
     apply Z.divide_0_r.
   }
  apply headptr_isptr in H7.
- simpl andp. fold (sizeof (Tfloat sz noattr)).
-  assert (offset_strict_in_range (sizeof (Tfloat sz noattr) * n) (globals_of_env rho i)). {
-    unfold offset_strict_in_range.
-    destruct (globals_of_env rho i) eqn:?H; auto.
-    rewrite H5 in H6; simpl in H6. unfold sizeof in H6; simpl in H6.
-    pose proof initial_world.zlength_nonneg _ (gvar_init gv).
-    rewrite Z.max_r in H6 by lia.
-   change (match sz with F32 => 4 | F64 => 8 end)
-    with (sizeof (Tfloat sz noattr)) in H6.
-    unfold Ptrofs.max_unsigned in H6.
-    pose proof init_data_list_size_pos (gvar_init gv).
-    simpl in H8.
-    unfold globals_of_env in H9. destruct (Map.get (ge_of rho) i) eqn:?H; inv H9.
-    rewrite Ptrofs.unsigned_zero.
-    split; try lia. 
-    rewrite Z.add_0_l.
-    apply Z.mul_nonneg_nonneg.
-    clear; pose proof (sizeof_pos (Tfloat sz noattr)); lia.
-    apply Zlength_nonneg.
-  }
-  normalize.
-  apply derives_refl.
+ split; first done; split; first done; split; last done.
+ unfold offset_strict_in_range.
+ destruct (globals_of_env rho i) eqn:?H; auto.
+ rewrite H1 H5 /= /sizeof /= in H6.
+ pose proof initial_world.zlength_nonneg _ (gvar_init gv).
+ rewrite -> Z.max_r in H6 by lia.
+ change (match sz with F32 => 4 | F64 => 8 end)
+   with (sizeof (Tfloat sz noattr)) in *.
+ unfold Ptrofs.max_unsigned in H6.
+ pose proof init_data_list_size_pos (gvar_init gv).
+ simpl in H8.
+ unfold globals_of_env in H9. destruct (Map.get (ge_of rho) i) eqn:?H; inv H9.
+ rewrite Ptrofs.unsigned_zero.
+ split; try lia.
+ rewrite Z.add_0_l.
+ apply Z.mul_nonneg_nonneg.
+ clear; pose proof (sizeof_pos (Tfloat sz noattr)); lia.
+   apply Zlength_nonneg.
+{ rewrite -H5 //. }
 Qed.
 
 Definition gv_globvars2pred (gv: ident->val) (vl: list (ident * globvar type)) : mpred :=
@@ -938,84 +860,61 @@ Qed.
 
 Definition globvars_in_process (gv: globals) (done: list mpred)
                (halfdone: mpred)
-               (al: list (ident * globvar type)) (rho: environ) : mpred :=
- !! (gvars_denote gv rho) &&
- (fold_right_sepcon done * halfdone * globvars2pred gv al).
+               (al: list (ident * globvar type)) : assert :=
+ local (gvars_denote gv) ∧
+ ⎡fold_right_sepcon done ∗ halfdone ∗ globvars2pred gv al⎤.
+
+Context {OK_spec : ext_spec OK_ty} {cs: compspecs}.
 
 Lemma start_globvars_in_process:
-  forall {cs: compspecs} {Espec: OracleKind} Delta P Q R
+  forall E Delta P Q R
           gz al SF c Post,
-  semax Delta
-    (PROPx P (LOCALx (gvars gz :: Q) (SEPx R)) *
-          globvars_in_process gz nil emp al * SF) c Post ->
-  semax Delta
-    (PROPx P (LOCALx (gvars gz :: Q) (SEPx R)) *
-     `(globvars2pred gz al) * SF) c Post.
+  semax E Delta
+    ((PROPx P (LOCALx (gvars gz :: Q) (SEPx R)) ∗
+          globvars_in_process gz nil emp al) ∗ SF) c Post ->
+  semax E Delta
+    ((PROPx P (LOCALx (gvars gz :: Q) (SEPx R)) ∗
+     ⎡globvars2pred gz al⎤) ∗ SF) c Post.
 Proof.
 intros.
 eapply semax_pre; [ | apply H].
-apply andp_left2.
-intro rho.
-unfold PROPx, LOCALx, SEPx, local, lift1.
-unfold_lift.
-simpl. normalize.
-apply sepcon_derives; auto.
-apply sepcon_derives; auto.
-unfold globvars_in_process.
-rewrite prop_true_andp by auto.
-simpl.
-rewrite !emp_sepcon.
-unfold globvars2pred.
-auto.
+rewrite /globvars_in_process; go_lowerx.
+iIntros "((($ & ((% & %) & $)) & $ ) & $)"; auto.
 Qed.
 
 Lemma semax_process_globvars:
-  forall {cs: compspecs} {Espec: OracleKind} Delta P Q R R'
+  forall E Delta P Q R R'
           gz al SF c Post,
-  ENTAIL Delta, globvars_in_process gz R emp al |-- globvars_in_process gz R' emp nil ->
-  semax Delta
-    (PROPx P (LOCALx (gvars gz :: Q) (SEPx R')) * emp * SF) c Post ->
-  semax Delta
-    (PROPx P (LOCALx (gvars gz :: Q) (SEPx R)) *
-          `(globvars2pred gz al) * SF) c Post.
+  ENTAIL Delta, globvars_in_process gz R emp al ⊢ globvars_in_process gz R' emp nil ->
+  semax E Delta
+    ((PROPx P (LOCALx (gvars gz :: Q) (SEPx R')) ∗ emp) ∗ SF) c Post ->
+  semax E Delta
+    ((PROPx P (LOCALx (gvars gz :: Q) (SEPx R)) ∗
+          ⎡globvars2pred gz al⎤) ∗ SF) c Post.
 Proof.
 intros.
 apply start_globvars_in_process.
 eapply semax_pre; [ | apply H0].
-intro rho.
-specialize (H rho).
-unfold PROPx, LOCALx, SEPx, local, lift1.
-simpl; normalize.
-unfold local, lift1 in H.
-simpl in H.
-rewrite prop_true_andp in H by auto.
-apply sepcon_derives; auto.
-clear - H.
-unfold globvars_in_process in *.
-simpl in *.
-normalize.
-rewrite !prop_true_andp in H by auto.
-match goal with |- _ * ?A |-- _ =>
- change A with (globvars2pred gz al)
-end.
-rewrite !sepcon_emp in H.
-eapply derives_trans; [ apply H | ].
-unfold globvars2pred, lift2; simpl; normalize.
+iIntros "(#? & ((% & #? & HR) & Hglob) & $)".
+rewrite /globvars_in_process in H |- *.
+iPoseProof (H with "[-]") as "(_ & $ & _)".
+iDestruct "Hglob" as "(? & _ & $ & $)"; auto.
+iSplit; auto.
 Qed.
 
 Lemma process_globvar':
   forall {cs: compspecs} Delta done (i: ident)
           gz gv al (idata : init_data) t,
-       (var_types Delta) ! i = None ->
-       (glob_types Delta) ! i = Some t ->
+       (var_types Delta) !! i = None ->
+       (glob_types Delta) !! i = Some t ->
   (complete_legal_cosu_type (gvar_info gv) && is_aligned cenv_cs ha_env_cs la_env_cs (gvar_info gv) 0)%bool = true ->
        gvar_volatile gv = false ->
        gvar_info gv = t ->
        gvar_init gv = (idata::nil) ->
        init_data_size idata <= sizeof t ->
        sizeof t <= Ptrofs.max_unsigned ->
-  ENTAIL Delta,   
-       globvars_in_process gz done emp ((i,gv)::al) |--
+  ENTAIL Delta,
+       globvars_in_process gz done emp ((i,gv)::al) ⊢
     globvars_in_process gz done
             (id2pred_star Delta gz
                          (readonly2share (gvar_readonly gv))
@@ -1027,21 +926,16 @@ pose proof  (unpack_globvar Delta gz i t gv idata H H0 H1 H2 H3 H4 H5 H6).
 clear H H0 H1 H2 H3 H4 H5 H6.
 unfold globvars_in_process.
 unfold globvars2pred.
-change (lift_S (LiftEnviron Prop)) with environ in *.
-go_lowerx. unfold lift2.
-normalize.
-rewrite sepcon_assoc.
-apply sepcon_derives; auto.
-apply sepcon_derives; auto.
-unfold local, lift1 in H7. specialize (H7 rho). simpl in H7. rewrite prop_true_andp in H7 by (split; auto).
-apply H7.
+go_lowerx.
+iIntros "($ & $ & ? & $)".
+iApply (H7 with "[-]"); iFrame; eauto.
 Qed.
 
 Lemma process_globvar_array:
-  forall {cs: compspecs} Delta done gz (i: ident)
+  forall Delta done gz (i: ident)
           gv al (n: Z) (t: type)  (sz : intsize) (sign : signedness) (data : list int),
-       (var_types Delta) ! i = None ->
-       (glob_types Delta) ! i = Some (gvar_info gv) ->
+       (var_types Delta) !! i = None ->
+       (glob_types Delta) !! i = Some (gvar_info gv) ->
        gvar_info gv = tarray t n ->
        gvar_volatile gv = false ->
        t = Tint sz sign noattr ->
@@ -1051,12 +945,12 @@ Lemma process_globvar_array:
        init_data_list_size (gvar_init gv) <= sizeof (gvar_info gv) <=
        Ptrofs.max_unsigned ->
   ENTAIL Delta,   
-       globvars_in_process gz done emp ((i,gv)::al) |--
+       globvars_in_process gz done emp ((i,gv)::al) ⊢
     globvars_in_process gz 
         (data_at
                    (readonly2share (gvar_readonly gv))
                    (tarray (Tint sz sign noattr) n)
-                   (map (Vint oo Cop.cast_int_int sz sign) data) (gz i) :: done)
+                   (map (Basics.compose Vint (Cop.cast_int_int sz sign)) data) (gz i) :: done)
         emp al.
 Proof.
 intros.
@@ -1064,21 +958,13 @@ pose proof (unpack_globvar_array _ _ _ _ _ _ gz _ _ H H0 H1 H2 H3 H4 H5 H6 H7).
 clear H H0 H1 H2 H3 H4 H5 H6 H7.
 unfold globvars_in_process.
 unfold globvars2pred.
-change (lift_S (LiftEnviron Prop)) with environ in *.
-unfold lift2.
-change  (fun rho : environ => gz = globals_of_env rho)
-  with (locald_denote (gvars gz)) in H8|-*.
 go_lowerx.
-normalize.
-pull_right (fold_right_sepcon done).
-apply sepcon_derives; auto.
-apply sepcon_derives; auto.
-unfold local, lift1 in H8. specialize (H8 rho). simpl in H8. rewrite prop_true_andp in H8 by (split; auto).
-apply H8.
+iIntros "($ & $ & ? & $)".
+iApply (H8 with "[-]"); iFrame; eauto.
 Qed.
 
 Lemma process_globvar_array_float:
-  forall {cs: compspecs} Delta done gz (i: ident)
+  forall Delta done gz (i: ident)
           gv al (n: Z) (t: type)  (sz : floatsize)
          (data : list (float_type sz)),
        Maps.PTree.get i (var_types Delta) = None ->
@@ -1090,8 +976,8 @@ Lemma process_globvar_array_float:
        gvar_init gv = map (floattype2init_data sz) data ->
        init_data_list_size (gvar_init gv) <= sizeof (gvar_info gv) <=
        Ptrofs.max_unsigned ->
-  ENTAIL Delta,   
-       globvars_in_process gz done emp ((i,gv)::al) |--
+  ENTAIL Delta,
+       globvars_in_process gz done emp ((i,gv)::al) ⊢
     globvars_in_process gz 
         (data_at
                    (readonly2share (gvar_readonly gv))
@@ -1104,27 +990,19 @@ assert (H8 := unpack_globvar_array_float _ _ _ _ _ gz _ _ H H0 H1 H2 H3 H4 H5 H6
 clear H H0 H1 H2 H3 H4 H5 H6.
 unfold globvars_in_process.
 unfold globvars2pred.
-change (lift_S (LiftEnviron Prop)) with environ in *.
-unfold lift2.
-change  (fun rho : environ => gz = globals_of_env rho)
-  with (locald_denote (gvars gz)) in H8|-*.
 go_lowerx.
-normalize.
-pull_right (fold_right_sepcon done).
-apply sepcon_derives; auto.
-apply sepcon_derives; auto.
-unfold local, lift1 in H8. specialize (H8 rho). simpl in H8. rewrite prop_true_andp in H8 by (split; auto).
-apply H8.
+iIntros "($ & $ & ? & $)".
+iApply (H8 with "[-]"); iFrame; eauto.
 Qed.
 
 Lemma process_globvar_star':
   forall {cs: compspecs} Delta done gz (i: ident)
           gv al,
-       (var_types Delta) ! i = None ->
-       (glob_types Delta) ! i = Some (gvar_info gv) ->
+       (var_types Delta) !! i = None ->
+       (glob_types Delta) !! i = Some (gvar_info gv) ->
        gvar_volatile gv = false ->
-  ENTAIL Delta,   
-       globvars_in_process gz done emp ((i,gv)::al) |--
+  ENTAIL Delta,
+       globvars_in_process gz done emp ((i,gv)::al) ⊢
     globvars_in_process gz done
             (id2pred_star Delta gz
                          (readonly2share (gvar_readonly gv))
@@ -1135,39 +1013,30 @@ intros.
 assert (H5 := unpack_globvar_star _ gz _ _ H H0 H1).
 clear H H0 H1.
 unfold globvars_in_process, globvars2pred.
-change (lift_S (LiftEnviron Prop)) with environ in *.
-unfold lift2.
-change  (fun rho : environ => gz = globals_of_env rho)
-  with (locald_denote (gvars gz)) in H5|-*.
 go_lowerx.
-normalize.
-rewrite sepcon_assoc.
-apply sepcon_derives; auto.
-apply sepcon_derives; auto.
-unfold local, lift1 in H5. specialize (H5 rho). simpl in H5.
-rewrite prop_true_andp in H5 by (split; auto).
-apply H5.
+iIntros "($ & _ & ? & $)".
+iApply (H5 with "[-]"); iFrame; eauto.
 Qed.
 
 Fixpoint init_datalist2pred' {cs: compspecs}
      (Delta: tycontext) (gv: globals) (dl: list init_data)  (sh: share) (ofs: Z) (v: val) : mpred :=
  match dl with
  | d::dl' => init_data2pred' Delta gv d sh (offset_val ofs v) 
-                * init_datalist2pred' Delta gv dl' sh (ofs + init_data_size d) v
+                ∗ init_datalist2pred' Delta gv dl' sh (ofs + init_data_size d) v
  | nil => emp
  end.
 
 Lemma halfprocess_globvar_star:
   forall {cs: compspecs} Delta done gz (i: ident)
           gv al,
-       (var_types Delta) ! i = None ->
-       (glob_types Delta) ! i = Some (gvar_info gv) ->
+       (var_types Delta) !! i = None ->
+       (glob_types Delta) !! i = Some (gvar_info gv) ->
   (complete_legal_cosu_type (gvar_info gv) && is_aligned cenv_cs ha_env_cs la_env_cs (gvar_info gv) 0)%bool = true ->
        gvar_volatile gv = false ->
        init_data_list_size (gvar_init gv) <= sizeof (gvar_info gv) <=
        Ptrofs.max_unsigned ->
   ENTAIL Delta,   
-       globvars_in_process gz done emp ((i,gv)::al) |--
+       globvars_in_process gz done emp ((i,gv)::al) ⊢
     globvars_in_process gz
        (init_datalist2pred' Delta gz (gvar_init gv) (readonly2share (gvar_readonly gv)) 0 (gz i) :: done)
             emp  al.
@@ -1176,11 +1045,7 @@ intros.
 unfold globvars_in_process.
 unfold globvars2pred; fold globvars2pred.
 go_lowerx.
-unfold lift2. simpl.
-normalize.
-pull_right (fold_right_sepcon done).
-apply sepcon_derives; auto.
-cancel.
+iIntros "($ & _ & H & $)".
 unfold globvar2pred.
 simpl.
 rewrite H2.
@@ -1190,22 +1055,19 @@ replace gz with (globals_of_env rho).
 rewrite <- offset_zero_globals_of_env at 1.
 set (ofs:=0).
 clearbody ofs.
-revert ofs; induction (gvar_init gv); intros.
-apply derives_refl.
-apply sepcon_derives.
-destruct (globvar_eval_var _ _ _ _ H4 H H0) as [b [? ?]].
-eapply init_data2pred_rejigger; eauto.
-unfold globals_of_env.
-rewrite H8. reflexivity.
-fold init_data_list2pred.
-fold init_datalist2pred'.
-spec IHl.
-simpl in H3.
-pose proof (init_data_size_pos a).
-lia.
-eapply derives_trans; [ | apply IHl].
-rewrite offset_offset_val.
-auto.
+iInduction (gvar_init gv)as [|] "IH" forall (ofs); simpl.
+{ done. }
+iDestruct "H" as "(H & ?)"; iSplitL "H".
+- destruct (globvar_eval_var _ _ _ _ H4 H H0) as [b [? ?]].
+  iApply init_data2pred_rejigger; eauto.
+  unfold globals_of_env.
+  rewrite H8. reflexivity.
+- iApply "IH".
+  + iPureIntro.
+    simpl in H3.
+    pose proof (init_data_size_pos a).
+    lia.
+  + rewrite offset_offset_val //.
 Qed.
 
 Lemma map_instantiate:
@@ -1228,33 +1090,26 @@ normalize. destruct rho; simpl.
 unfold gvars_denote. unfold_lift. unfold local, lift1.
 rewrite sepcon_comm. unfold Clight_seplog.mkEnv; simpl. unfold seplog.globals_only, globals_of_env; simpl.
 apply pred_ext; normalize.
-+ apply andp_right. apply prop_right. intuition. trivial.
-+ apply andp_right. apply prop_right. intuition. trivial.
++ apply bi.and_intro. apply bi.pure_intro. intuition. trivial.
++ apply bi.and_intro. apply bi.pure_intro. intuition. trivial.
 Qed.
  *)
 
-Definition main_pre_old {Z: Type} (prog: Clight.program) (ora: Z) : globals -> environ -> mpred :=
-fun gv rho => 
-  !! (gv = globals_of_env rho) &&
-   (globvars2pred gv (prog_vars prog) * has_ext ora).
+Definition main_pre_old (prog: Clight.program) (ora: OK_ty) (gv: globals) : assert :=
+local (fun rho => gv = globals_of_env rho) ∧
+   ⎡globvars2pred gv (prog_vars prog) ∗ has_ext ora⎤.
 
 Lemma main_pre_start_old:
- forall {Z} prog gv (ora : Z),
-   main_pre_old prog ora gv = (PROP() LOCAL(gvars gv) SEP(has_ext ora))%assert * `(globvars2pred gv (prog_vars prog)).
+ forall prog gv ora,
+   main_pre_old prog ora gv ⊣⊢ (PROP() LOCAL(gvars gv) SEP(has_ext ora))%assert ∗ ⎡globvars2pred gv (prog_vars prog)⎤.
 Proof.
 intros.
 unfold main_pre_old.
 unfold globvars2pred,  PROPx, LOCALx, SEPx.
-unfold lift2.
-extensionality rho.
-simpl.
+split => rho; monPred.unseal.
+unfold_lift; rewrite /lift1.
 normalize.
-unfold gvars_denote. unfold_lift. unfold local, lift1.
-fold (globals_of_env rho).
-rewrite sepcon_comm.
-apply pred_ext; intros; normalize.
-rewrite prop_true_andp by auto.
-auto.
+rewrite and_True True_and bi.sep_comm //.
 Qed.
 
 
@@ -1275,18 +1130,18 @@ Definition init_data2byte (d: init_data) : byte :=
 Import ListNotations.
 
 (* The following lemma is not yet made use of by the tactics *)
-Lemma globvar2pred_cstring: (* move this to vst/floyd/globals_lemmas.v *)
- forall {cs: compspecs} gv i v,
+Lemma globvar2pred_cstring:
+ forall gv i v,
   headptr (gv i) ->
   0 < Zlength (gvar_init v) < Ptrofs.modulus ->
   Znth (Zlength (gvar_init v)-1) (gvar_init v) = Init_int8 Int.zero ->
   gvar_volatile v = false ->
   forallb ok_initbyte (sublist 0 (Zlength (gvar_init v)-1) (gvar_init v)) = true ->
   gvar_info v = tarray tschar (Zlength (gvar_init v)) ->
-  (globvar2pred gv (i, v) |--
+  (globvar2pred gv (i, v) ⊢
   cstring (readonly2share (gvar_readonly v)) (map init_data2byte (sublist 0 (Zlength (gvar_init v)-1) (gvar_init v))) (gv i)).
 Proof.
-intros cs gv i v HEAD BOUND ZERO; intros.
+intros gv i v HEAD BOUND ZERO; intros.
 destruct HEAD as [b ?].
 destruct v;
 unfold globvar2pred; simpl in *.
@@ -1312,7 +1167,7 @@ assert (exists al, map Init_int8 al = bl
   apply negb_true_iff, Z.eqb_neq in H. 
   apply Z.leb_le in H0. apply Z.ltb_lt in H2.
   assert (Byte.signed (Byte.repr j) = Byte.signed (Byte.zero)) by congruence.
-  rewrite Byte.signed_repr in H3 by rep_lia. contradiction.
+  rewrite -> Byte.signed_repr in H3 by rep_lia. contradiction.
 }
 rewrite H2.
 destruct H as [al [H3 H3']].
@@ -1321,7 +1176,7 @@ replace bl0 with (map Init_int8 (al ++ [Int.zero])).
  2:{ rewrite map_app. rewrite H3.
       simpl map. rewrite <- ZERO. list_solve.
 }
-eapply derives_trans.
+etrans.
 apply init_data_tarray_tuchar.
 list_solve.
 { rewrite <- H3 in H0. clear - H0.
@@ -1336,12 +1191,12 @@ list_solve.
 }
 unfold cstring.
 rewrite data_at_tarray_tschar_tuchar.
-apply andp_right.
-apply prop_right.
+apply bi.and_intro.
+apply bi.pure_intro.
 replace (map _ _) with (map (Byte.repr oo Int.intval) al); auto.
 autorewrite with sublist. rewrite sublist_map.
-rewrite sublist_app1 by rep_lia.
-rewrite sublist_same by lia.
+rewrite -> sublist_app1 by rep_lia.
+rewrite -> sublist_same by lia.
 clear.
 induction al; simpl; auto. f_equal; auto.
 rewrite !Zlength_map.
@@ -1354,13 +1209,12 @@ assert (map Vubyte (map init_data2byte (map Init_int8 al)) = map Vint al). {
   f_equal; auto.
   apply Z.leb_le in H0. apply Z.ltb_lt in H1.
   unfold Vubyte. f_equal.
-  rewrite Byte.unsigned_repr by rep_lia.
+  rewrite -> Byte.unsigned_repr by rep_lia.
   change (Int.intval a) with (Int.unsigned a).
   rewrite Int.repr_unsigned. auto.
 }
 autorewrite with sublist.
-apply derives_refl'.
-f_equal.
+f_equiv.
 rewrite sublist_map.
 autorewrite with sublist.
 rewrite !map_app.
@@ -1390,12 +1244,12 @@ apply (initdata_list2pred_ge_eq RS).
 Qed.
 
 Lemma globvars2pred_ge_eq_entails {rho sigma gz} (RS: ge_of rho = ge_of sigma):
-      forall l, globvars2pred gz l rho |-- globvars2pred gz l sigma.
+      forall l, globvars2pred gz l rho ⊢ globvars2pred gz l sigma.
 Proof.
 unfold globvars2pred, lift2. induction l.
 + simpl. unfold globals_of_env; rewrite RS; trivial.
 + eapply derives_trans. simpl. rewrite sepcon_comm, <- sepcon_andp_prop'.
-  apply sepcon_derives. apply IHl. apply derives_refl. clear IHl.
+  apply bi.sep_mono. apply IHl. apply derives_refl. clear IHl.
   simpl. rewrite sepcon_andp_prop', sepcon_comm, (globvar2pred_ge_eq RS). trivial.
 Qed.
 
@@ -1404,18 +1258,14 @@ Lemma globvars2pred_ge_eq {rho sigma gz l} (RS: ge_of rho = ge_of sigma):
 Proof. apply pred_ext; apply globvars2pred_ge_eq_entails; [ | symmetry]; trivial. Qed.
  *)
 
-Lemma close_precondition_main {Z p ora gv}:
-close_precondition nil (@main_pre Z p ora gv) = @main_pre_old Z p ora gv.
+Lemma close_precondition_main {p ora gv}:
+close_precondition nil (main_pre p ora gv) ⊣⊢ main_pre_old p ora gv.
 Proof.
-unfold close_precondition; extensionality rho.
-unfold main_pre, main_pre_old; simpl snd. 
-forget (prog_vars p) as vars. clear p.
-remember (globvars2pred gv vars) as G.
-apply pred_ext.
-+ apply exp_left. intros vals. normalize.
-+ Exists (@nil val). 
-  apply andp_right. apply prop_right; split; [trivial | constructor].
-  clear HeqG. normalize. rewrite prop_true_andp; auto.
+rewrite /close_precondition /main_pre /main_pre_old.
+split => rho; simpl; monPred.unseal; rewrite /lift1.
+iSplit.
+- iIntros "H"; iDestruct "H" as (? _ (-> & ?)) "$"; auto.
+- iIntros "(% & $)"; iExists []; auto.
 Qed.
 
 
@@ -1423,16 +1273,16 @@ Lemma process_globvar_space0:
   forall {cs: compspecs} Delta done (i: ident)
           gz gv al t,
        gvar_info gv = t ->
-       (var_types Delta) ! i = None ->
-       (glob_types Delta) ! i = Some t ->
+       (var_types Delta) !! i = None ->
+       (glob_types Delta) !! i = Some t ->
   (complete_legal_cosu_type (gvar_info gv)
    && is_aligned cenv_cs ha_env_cs la_env_cs (gvar_info gv) 0
    && fully_nonvolatile (rank_type cenv_cs t) t)%bool = true ->
        gvar_volatile gv = false ->
        gvar_init gv = (Init_space (sizeof t)::nil) ->
        sizeof t <= Ptrofs.max_unsigned ->
-  ENTAIL Delta,   
-       globvars_in_process gz done emp ((i,gv)::al) |--
+  ENTAIL Delta,
+       globvars_in_process gz done emp ((i,gv)::al) ⊢
     globvars_in_process gz
        (data_at (readonly2share (gvar_readonly gv)) t  (zero_val t) (gz i) :: done)
             emp  al.
@@ -1441,44 +1291,35 @@ intros until t. intros H3; intros.
 rewrite andb_true_iff in H1. destruct H1 as [H1 Hvol].
 assert (H7 := unpack_globvar Delta gz i t gv _ H H0 H1 H2 H3 H4).
 spec H7.
-simpl. pose proof (sizeof_pos t). rewrite Z.max_l by lia. lia.
+simpl. pose proof (sizeof_pos t). rewrite -> Z.max_l by lia. lia.
 specialize (H7 H5).
-go_lowerx.
 unfold globvars_in_process.
 unfold globvars2pred; fold globvars2pred.
-unfold lift2. simpl. normalize.
-pull_right (fold_right_sepcon done).
-apply sepcon_derives; auto.
-apply sepcon_derives; auto.
-specialize (H7 rho).
-unfold_lift in H7. unfold local, lift1 in H7.
-simpl in H7.
-rewrite prop_true_andp in H7 by auto.
-eapply derives_trans; [ apply H7  | ].
-rewrite andb_true_iff in H1.
-destruct H1.
-rewrite H3 in *.
-apply mapsto_zero_data_at_zero; auto.
-apply readable_readonly2share.
-pose proof (la_env_cs_sound 0 t H1 H9).
-apply headptr_field_compatible; auto.
-eapply go_lower.gvars_denote_HP; eauto.
-red; auto.
-rep_lia.
+go_lowerx.
+iIntros "($ & $ & ? & $)".
+apply andb_true_iff in H1 as [H1 H9].
+rewrite -> H3 in *.
+iApply mapsto_zero_data_at_zero; last iApply H7; auto.
+- apply readable_readonly2share.
+- pose proof (la_env_cs_sound 0 t H1 H9).
+  apply headptr_field_compatible; auto.
+  + eapply go_lower.gvars_denote_HP; eauto.
+  + red; auto.
+  + rep_lia.
 Qed.
 
 Lemma process_globvar_space:
   forall {cs: compspecs} Delta done (i: ident)
           gz gv al t,
        gvar_info gv = t ->
-       (var_types Delta) ! i = None ->
-       (glob_types Delta) ! i = Some t ->
+       (var_types Delta) !! i = None ->
+       (glob_types Delta) !! i = Some t ->
   (complete_legal_cosu_type (gvar_info gv) && is_aligned cenv_cs ha_env_cs la_env_cs (gvar_info gv) 0)%bool = true ->
        gvar_volatile gv = false ->
        gvar_init gv = (Init_space (sizeof t)::nil) ->
        sizeof t <= Ptrofs.max_unsigned ->
-  ENTAIL Delta,   
-       globvars_in_process gz done emp ((i,gv)::al) |--
+  ENTAIL Delta,
+       globvars_in_process gz done emp ((i,gv)::al) ⊢
     globvars_in_process gz
        (data_at_  (readonly2share (gvar_readonly gv)) t (gz i) :: done)
             emp  al.
@@ -1486,48 +1327,37 @@ Proof.
 intros until t. intros H3; intros.
 assert (H7 := unpack_globvar Delta gz i t gv _ H H0 H1 H2 H3 H4).
 spec H7.
-simpl. pose proof (sizeof_pos t). rewrite Z.max_l by lia. lia.
+simpl. pose proof (sizeof_pos t). rewrite -> Z.max_l by lia. lia.
 specialize (H7 H5).
-go_lowerx.
 unfold globvars_in_process.
 unfold globvars2pred; fold globvars2pred.
-unfold lift2. simpl. normalize.
-pull_right (fold_right_sepcon done).
-apply sepcon_derives; auto.
-apply sepcon_derives; auto.
-specialize (H7 rho).
-unfold_lift in H7. unfold local, lift1 in H7.
-simpl in H7.
-rewrite prop_true_andp in H7 by auto.
-eapply derives_trans; [ apply H7  | ].
-eapply derives_trans. apply mapsto_zeros_memory_block.
-destruct (gvar_readonly gv); simpl; auto. apply readable_Ers.
-assert_PROP (isptr (gz i)) by (saturate_local; apply prop_right; auto).
-assert (headptr (gz i)).
-rewrite H8 in *. destruct (Map.get (ge_of rho) i); try contradiction. hnf; eauto.
-rewrite memory_block_data_at_; auto.
-subst t.
-rewrite andb_true_iff in H1; destruct H1.
-pose proof (la_env_cs_sound 0 (gvar_info gv) H1 H3).
-apply headptr_field_compatible; auto.
-apply I.
-assert (Ptrofs.modulus = Ptrofs.max_unsigned + 1) by computable.
-lia.
+go_lowerx.
+iIntros "($ & $ & ? & $)".
+apply andb_true_iff in H1 as [H1 H9].
+rewrite -> H3 in *.
+iApply memory_block_data_at_.
+{ subst t.
+  pose proof (la_env_cs_sound 0 (gvar_info gv) H1 H9).
+  apply headptr_field_compatible; auto.
+  + eapply go_lower.gvars_denote_HP; eauto.
+  + red; auto.
+  + rep_lia. }
+iApply mapsto_zeros_memory_block; iApply H7; auto.
 Qed.
 
 Lemma process_globvar_ptrarray_space:
-  forall {cs: compspecs} Delta done (i: ident)
+  forall Delta done (i: ident)
           gz gv al t t' n,
        t = Tarray (Tpointer t' noattr) n noattr ->
        gvar_info gv = t ->
-       (var_types Delta) ! i = None ->
-       (glob_types Delta) ! i = Some t ->
+       (var_types Delta) !! i = None ->
+       (glob_types Delta) !! i = Some t ->
   (complete_legal_cosu_type (gvar_info gv) && is_aligned cenv_cs ha_env_cs la_env_cs (gvar_info gv) 0)%bool = true ->
        gvar_volatile gv = false ->
        gvar_init gv = (Init_space (sizeof t)::nil) ->
        sizeof t <= Ptrofs.max_unsigned ->
   ENTAIL Delta,   
-       globvars_in_process gz done emp ((i,gv)::al) |--
+       globvars_in_process gz done emp ((i,gv)::al) ⊢
     globvars_in_process gz
        (data_at  (readonly2share (gvar_readonly gv)) (Tarray (Tpointer t' noattr) n noattr)
                                   (Zrepeat nullval n)  (gz i) :: done)
@@ -1536,76 +1366,63 @@ Proof.
 intros until n. intros Ht H3; intros.
 assert (H7 := unpack_globvar Delta gz i t gv _ H H0 H1 H2 H3 H4).
 spec H7.
-simpl. pose proof (sizeof_pos t). rewrite Z.max_l by lia. lia.
+simpl. pose proof (sizeof_pos t). rewrite -> Z.max_l by lia. lia.
 specialize (H7 H5).
-go_lowerx.
 unfold globvars_in_process.
 unfold globvars2pred; fold globvars2pred.
-unfold lift2.
-simpl.
-normalize.
-pull_right (fold_right_sepcon done).
-apply sepcon_derives; auto.
-apply sepcon_derives; auto.
-specialize (H7 rho).
-unfold_lift in H7. unfold local, lift1 in H7.
-simpl in H7.
-rewrite prop_true_andp in H7 by auto.
-eapply derives_trans; [ apply H7  | ].
+go_lowerx.
+iIntros "($ & $ & ? & $)".
+apply andb_true_iff in H1 as [H1 H9].
+rewrite -> H3 in *.
+iPoseProof (H7 with "[-]") as "H"; first auto; simpl.
 subst t; simpl.
 destruct (zlt n 0).
 -
 unfold sizeof; simpl.
-rewrite Z.max_l by lia.
-simpl.
+rewrite -> Z.max_l by lia.
 rewrite Z.mul_0_r.
 assert (readable_share (readonly2share (gvar_readonly gv)))
   by apply readable_readonly2share.
 forget  (readonly2share (gvar_readonly gv)) as sh.
 unfold mapsto_zeros.
-destruct (gz i); try apply FF_left.
-normalize.
+destruct (gz i); try done.
 unfold data_at, field_at.
 change (nested_field_offset _ _) with 0.
 unfold at_offset.
 unfold nested_field_type; simpl.
-normalize.
 rewrite data_at_rec_eq.
-rewrite Z.max_l by lia.
+rewrite -> Z.max_l by lia.
 change (unfold_reptype _) with (repeat nullval (Z.to_nat n)).
-rewrite Z2Nat_neg by auto.  simpl repeat.
-rewrite aggregate_pred.aggregate_pred.array_pred_len_0 by auto.
-change predicates_sl.emp with emp.
-apply andp_right; auto.
-apply prop_right.
+rewrite -> Z2Nat_neg by auto.  simpl repeat.
+rewrite -> aggregate_pred.aggregate_pred.array_pred_len_0 by auto.
+iDestruct "H" as "(% & _)"; iPureIntro.
+split; last done.
 split3; auto. apply I.
 split3.
 simpl. unfold sizeof; simpl.  lia.
 2: apply I.
-red. constructor; auto. intros. lia. 
+red. constructor; auto. intros. lia.
 -
-unfold sizeof; simpl.
-rewrite Z.max_r by lia.
+rewrite -> Z.max_r by lia.
 unfold data_at.
 erewrite @field_at_Tarray with (n:=n);
   [ | apply I | reflexivity | lia | apply JMeq_refl].
 unfold mapsto_zeros.
-destruct (gz i) eqn:?H;
- try apply FF_left.
-normalize.
+destruct (gz i) eqn:?H; try done.
+iDestruct "H" as "(% & H)".
 assert (field_compatible0 (Tarray (Tpointer t' noattr) n noattr) (ArraySubsc 0::nil) (gz i)).
-{ rewrite H9; split3; auto. apply I. split; auto. simpl. unfold sizeof; simpl.
-   rewrite Z.max_r by lia. lia.
+{ rewrite H10; split3; auto. apply I. split; auto. simpl. unfold sizeof; simpl.
+   rewrite -> Z.max_r by lia. lia.
   split. red. apply align_compatible_rec_Tarray. intros.
      eapply align_compatible_rec_by_value. reflexivity.
      simpl.
-  rewrite H8 in H9; unfold globals_of_env in H9. destruct (Map.get (ge_of rho) i); inv H9.
+  rewrite H8 in H10; unfold globals_of_env in H10. destruct (Map.get (ge_of rho) i); inv H10.
   normalize. apply Z.divide_mul_l. unfold Mptr.  destruct Archi.ptr64; exists 1; simpl; auto.
   simpl. split; auto. lia.
 }
 assert (Halign: (align_chunk Mptr | Ptrofs.unsigned i0)). {
-  rewrite H8 in H9;
- clear - H9. unfold globals_of_env in H9. destruct (Map.get (ge_of rho) i); inv H9.
+  rewrite H8 in H10;
+ clear - H10. unfold globals_of_env in H10. destruct (Map.get (ge_of rho) i); inv H10.
  apply Z.divide_0_r.
 }
 forget (gz i) as p.
@@ -1619,119 +1436,110 @@ rewrite prop_true_andp.
 destruct H12 as [? [? [? [? [? ?]]]]].
 split3; auto. split3; auto. simpl; split; auto. lia.
 }
-apply andp_right.
-apply prop_right. autorewrite with sublist. auto.
-rewrite Z2Nat.inj_mul; [ | destruct Archi.ptr64; lia| lia].
-rewrite Z2Nat.inj_sub by lia.
+iSplit.
+{ autorewrite with sublist; auto. }
+rewrite -> Z2Nat.inj_mul; [ | destruct Archi.ptr64; lia| lia].
+rewrite -> Z2Nat.inj_sub by lia.
 change (Z.to_nat 0) with O. rewrite Nat.sub_0_r.
 unfold nested_field_type; simpl.
 unfold nested_field_offset; simpl.
 unfold at_offset.
 rewrite <- (Z2Nat.id n) in H11 by lia.
 unfold Zrepeat.
-clear - H10 H11 H13 Halign.
-revert i0 H10 H11 Halign; induction (Z.to_nat n); intros; simpl.
-rewrite Nat.mul_0_r; apply derives_refl.
+clear - H11 H13 Halign.
+rewrite mapsto_memory_block.address_mapsto_zeros_eq.
+iInduction (Z.to_nat n) as [|] "IH" forall (i0 H11 Halign); intros; simpl.
+{ done. }
 autorewrite with sublist. normalize.
-rewrite mapsto_memory_block.address_mapsto_zeros_eq in *.
-rewrite Nat2Z.inj_mul.
-rewrite Z2Nat.id by (destruct Archi.ptr64; computable).
+rewrite !Nat2Z.inj_mul.
+rewrite -> Z2Nat.id by (destruct Archi.ptr64; computable).
 rewrite inj_S. unfold Z.succ.
 rewrite Z.add_comm.
-rewrite Z.mul_add_distr_l.
-rewrite Z.mul_1_r.
-rewrite mapsto_memory_block.address_mapsto_zeros'_split by (destruct Archi.ptr64; rep_lia).
-change (predicates_sl.sepcon ?A ?B) with (A*B).
-apply sepcon_derives.
-unfold data_at_rec;  simpl.
-unfold mapsto. simpl. rewrite if_true by apply H13.
-rewrite andb_false_r.
-apply orp_right1.
-rewrite prop_true_andp by apply mapsto_memory_block.is_pointer_or_null_nullval.
-{
-change (if Archi.ptr64 then 8 else 4) with (size_chunk Mptr). constructor.
-apply mapsto_memory_block.address_mapsto_address_mapsto_zeros; auto.
-}
-unfold adr_add.
-simpl.
-assert (H20: 0 <= (if Archi.ptr64 then 8 else 4) <= Ptrofs.max_unsigned)
-  by (destruct Archi.ptr64; clear; rep_lia).
-change (if Archi.ptr64 then 8 else 4) with (size_chunk Mptr) in *.
-specialize (IHn0 (Ptrofs.add i0 (Ptrofs.repr (size_chunk Mptr)))).
-rewrite Nat2Z.inj_mul in IHn0 by lia.
-rewrite Z2Nat.id in IHn0 by lia.
-replace (Ptrofs.unsigned i0 + (size_chunk Mptr))
+rewrite -> Z.mul_add_distr_l.
+rewrite -> Z.mul_1_r.
+rewrite -> mapsto_memory_block.address_mapsto_zeros'_split by (destruct Archi.ptr64; rep_lia).
+iDestruct "H" as "(H & ?)"; iSplitL "H".
++ unfold data_at_rec; simpl.
+  unfold mapsto. simpl. rewrite -> if_true by done.
+  rewrite andb_false_r.
+  iLeft.
+  rewrite -> prop_true_andp by apply mapsto_memory_block.is_pointer_or_null_nullval.
+  iApply mapsto_memory_block.address_mapsto_address_mapsto_zeros; auto.
++ unfold adr_add.
+  simpl.
+  assert (H20: 0 <= (if Archi.ptr64 then 8 else 4) <= Ptrofs.max_unsigned)
+    by (destruct Archi.ptr64; clear; rep_lia).
+  change (if Archi.ptr64 then 8 else 4) with (size_chunk Mptr) in *.
+  iSpecialize ("IH" $! (Ptrofs.add i0 (Ptrofs.repr (size_chunk Mptr)))).
+  replace (Ptrofs.unsigned i0 + (size_chunk Mptr))
   with (Ptrofs.unsigned
-           (Ptrofs.add i0 (Ptrofs.repr (size_chunk Mptr)))). 
-eapply derives_trans; [eapply IHn0 | ].
-rep_lia.
-rewrite inj_S in H11.
-unfold Ptrofs.add.
-rewrite Ptrofs.unsigned_repr.
-rewrite Ptrofs.unsigned_repr by lia.
-lia.
-rewrite Ptrofs.unsigned_repr by lia.
-rep_lia.
-clear - Halign H10 H11 H20.
-unfold Ptrofs.add. rewrite Ptrofs.unsigned_repr.
-apply Z.divide_add_r; auto.
-rewrite Ptrofs.unsigned_repr by lia.
-apply align_size_chunk_divides.
-rewrite Ptrofs.unsigned_repr by lia.
-rep_lia.
-apply aggregate_pred.rangespec_shift_derives.
-intros.
-rewrite Z.sub_0_r in H0. subst i.
-rewrite !Z.sub_0_r.
-rewrite Znth_pos_cons by lia.
-rewrite <- (Nat2Z.id n0).
-rewrite Znth_repeat_inrange by lia.
-apply derives_refl'. f_equal. 
-simpl.
-f_equal.
-rewrite Ptrofs.add_assoc. f_equal.
-rewrite ptrofs_add_repr.
-f_equal. simpl; unfold sizeof; simpl.
-  change (if Archi.ptr64 then 8 else 4) with (size_chunk Mptr). lia.
-unfold Ptrofs.add.
-rewrite Ptrofs.unsigned_repr.
-2:{
-rewrite Ptrofs.unsigned_repr by (destruct Archi.ptr64; rep_lia).
-destruct Archi.ptr64; rep_lia.
-}
-reflexivity.
+           (Ptrofs.add i0 (Ptrofs.repr (size_chunk Mptr)))).
+  iPoseProof ("IH" with "[%] [%] [$]") as "?".
+  { split; first rep_lia.
+    rewrite inj_S in H11.
+    unfold Ptrofs.add.
+    rewrite Ptrofs.unsigned_repr.
+    rewrite -> Ptrofs.unsigned_repr by lia.
+    lia.
+    rewrite -> Ptrofs.unsigned_repr by lia.
+    rep_lia. }
+  { unfold Ptrofs.add. rewrite Ptrofs.unsigned_repr.
+    apply Z.divide_add_r; auto.
+    rewrite -> Ptrofs.unsigned_repr by lia.
+    apply align_size_chunk_divides.
+    rewrite -> Ptrofs.unsigned_repr by lia.
+    rep_lia. }
+  iApply (aggregate_pred.rangespec_shift_derives with "[$]").
+  intros.
+  rewrite Z.sub_0_r in H0. subst i.
+  rewrite !Z.sub_0_r.
+  rewrite -> Znth_pos_cons by lia.
+  rewrite <- (Nat2Z.id n0).
+  rewrite -> !Znth_repeat_inrange by lia.
+  apply bi.equiv_entails_1_1. f_equiv; hnf; simpl.
+  rewrite Ptrofs.add_assoc. f_equal.
+  rewrite ptrofs_add_repr.
+  f_equal. f_equal. lia.
+  { unfold Ptrofs.add.
+    rewrite Ptrofs.unsigned_repr //.
+    rewrite -> Ptrofs.unsigned_repr by (destruct Archi.ptr64; rep_lia).
+    rep_lia. }
 Qed.
 
 Lemma process_globvar_extern:
  forall {CS: compspecs} Delta done gz i gv al,
        gvar_init gv = nil ->
        gvar_volatile gv = false ->
-  ENTAIL Delta,   
-       globvars_in_process gz done emp ((i,gv)::al) |--
+  ENTAIL Delta,
+       globvars_in_process gz done emp ((i,gv)::al) ⊢
     globvars_in_process gz done emp  al.
 Proof.
 intros.
-apply andp_left2.
 unfold globvars_in_process.
-intro rho.
-unfold globvars2pred, lift2.
-apply andp_derives; auto.
-simpl.
-normalize.
-apply sepcon_derives; auto.
-unfold globvar2pred.
-simpl. rewrite H0, H.
-simpl. rewrite emp_sepcon.
-apply derives_refl.
+go_lowerx.
+iIntros "($ & $ & ?)".
+rewrite /globvars2pred /= /globvar2pred /=.
+rewrite H0 H /= bi.emp_sep //.
+Qed.
+
+Lemma finish_process_globvars: 
+ forall E Delta PQR SF c Post,
+  semax E Delta (PQR ∗ SF) c Post ->
+  semax E Delta ((PQR ∗ emp) ∗ SF) c Post.
+Proof.
+intros.
+rewrite bi.sep_emp //.
 Qed.
 
 Definition is_array_type t :=
  match t with Tarray _ _ _ => true | _ => false end.
 
+End mpred.
+
 Ltac process_one_globvar' :=
  first
   [ simple eapply process_globvar_extern; [reflexivity | reflexivity ]
-  | match goal with |- ENTAIL ?Delta, globvars_in_process ?gv _ emp ((?i,?v)::_) |-- _ =>
+  | match goal with |- ENTAIL ?Delta, globvars_in_process ?gv _ emp ((?i,?v)::_) ⊢ _ =>
         (* need this hack because, for some reason, simple eapply does not work here *)
            unify (is_array_type (gvar_info v)) true
      end;
@@ -1744,7 +1552,7 @@ Ltac process_one_globvar' :=
   | simple eapply process_globvar';
       [reflexivity | reflexivity | reflexivity | reflexivity | reflexivity | reflexivity
       | reflexivity | compute; congruence ]
-  | match goal with |- ENTAIL ?Delta, globvars_in_process ?gv _ emp ((?i,?v)::_) |-- _ =>
+  | match goal with |- ENTAIL ?Delta, globvars_in_process ?gv _ emp ((?i,?v)::_) ⊢ _ =>
         (* need this hack because, for some reason, simple eapply does not work here *)
            unify (is_array_type (gvar_info v)) true
      end;
@@ -1753,7 +1561,7 @@ Ltac process_one_globvar' :=
       | compute; clear; congruence
       | repeat eapply map_instantiate; symmetry; apply map_nil
       | compute; split; clear; congruence  ]
-  | match goal with |- ENTAIL ?Delta, globvars_in_process ?gv _ emp ((?i,?v)::_) |-- _ =>
+  | match goal with |- ENTAIL ?Delta, globvars_in_process ?gv _ emp ((?i,?v)::_) ⊢ _ =>
         (* need this hack because, for some reason, simple eapply does not work here *)
            unify (is_array_type (gvar_info v)) true
      end;
@@ -1772,18 +1580,15 @@ Ltac process_one_globvar :=
   eapply ENTAIL_trans; [process_one_globvar' | simpl float_constructor].
 
 Lemma move_globfield_into_done:
- forall Delta gv done S1 R al R',
-  ENTAIL Delta, globvars_in_process gv (S1::done) R al |-- R' ->
-  ENTAIL Delta, globvars_in_process gv done (S1 * R) al |-- R'.
+ forall `{!VSTGS OK_ty Σ} Delta gv done S1 R al R',
+  ENTAIL Delta, globvars_in_process gv (S1::done) R al ⊢ R' ->
+  ENTAIL Delta, globvars_in_process gv done (S1 ∗ R) al ⊢ R'.
 Proof.
 intros.
-eapply ENTAIL_trans; [ | apply H]; clear.
-apply andp_left2.
-unfold globvars_in_process.
-intro rho; simpl; normalize.
-rewrite <- !sepcon_assoc.
-pull_left S1.
-auto.
+rewrite -H.
+apply bi.and_mono; first done.
+unfold globvars_in_process; simpl.
+iIntros "(? & $ & ($ & $) & $)"; auto.
 Qed.
 
 (*
@@ -1833,7 +1638,7 @@ Lemma move_globfield_into_SEP0:
  semax Delta (S0 * emp * S3 * S4) c Post.
 Proof.
 intros.
-rewrite sepcon_emp; auto.
+rewrite bi.sep_emp; auto.
 Qed.
 
 *)
@@ -1851,7 +1656,7 @@ Qed.
 Ltac process_idstar :=
      process_one_globvar;
      lazymatch goal with Delta := @abbreviate tycontext _ 
-                             |- ENTAIL _, globvars_in_process _ _ ?A _ |-- _ =>
+                             |- ENTAIL _, globvars_in_process _ _ ?A _ ⊢ _ =>
       match A with id2pred_star _ _ _ (_ ?i) _ =>
          let p := fresh "p" in set (p:=A);
          simpl in p;
@@ -1860,14 +1665,14 @@ Ltac process_idstar :=
          cbv beta iota zeta in p;
          simpl init_data_size in p;
          revert p; rewrite ?offset_offset_val; intro p; simpl Z.add in p;
-         let t := constr:(match (glob_types Delta) ! i with Some x => x | _ => Tvoid end) in
+         let t := constr:(match (glob_types Delta) !! i with Some x => x | _ => Tvoid end) in
          let t := eval hnf in t in
          match t with Tpointer ?t2 _ =>
            repeat match goal with p := ?D |- _ =>
                        match D with context [mapsto ?sh ?t' ?q ?v] =>
                             revert p;
                            change (mapsto sh t' q v) with (mapsto sh size_t q nullval);
-                           rewrite <- (mapsto_size_t_tptr_nullval sh q t2);
+                           rewrite <- (mapsto_tuint_tptr_nullval sh q t2);
                            intro p
                        end end
          | _ => idtac end;
@@ -1876,7 +1681,7 @@ Ltac process_idstar :=
          repeat simple apply move_globfield_into_done
       | _ => idtac
        end
-    | |- ENTAIL _, _ |-- _ => idtac
+    | |- ENTAIL _, _ ⊢ _ => idtac
     end.
 
 Create HintDb zero_val discriminated.
@@ -1928,21 +1733,12 @@ Qed.
 #[export] Hint Rewrite @zero_val_Tlong @zero_val_Tint : zero_val.
 #[export] Hint Rewrite @zero_val_tint @zero_val_tuint @zero_val_tlong @zero_val_tulong @zero_val_tptr : zero_val.
 
-Lemma finish_process_globvars: 
- forall {cs: compspecs}{Espec: OracleKind} Delta PQR SF c Post,
-  semax Delta (PQR * SF) c Post ->
-  semax Delta (PQR * emp * SF) c Post.
-Proof.
-intros.
-rewrite sepcon_emp; auto.
-Qed.
-
 Lemma prog_defs_Clight_mkprogram:
  forall c g p m w,
  prog_defs (Clightdefs.mkprogram c g p m w) = g.
 Proof.
 intros. unfold Clightdefs.mkprogram.
-destruct ( build_composite_env' c w).
+destruct (build_composite_env' c w).
 reflexivity.
 Qed.
 
@@ -1950,16 +1746,16 @@ Ltac process_globals :=
   repeat process_idstar; 
   change (Share.lub extern_retainer _) with Ews;
   change (Share.lub extern_retainer _) with Ers;
-  try change (Vint oo _) with (Vint oo id);
+  try change (Basics.compose Vint _) with (Basics.compose Vint id);
   fold_types;
   rewrite ?Combinators.compose_id_right;
   apply ENTAIL_refl.
 
 Ltac expand_main_pre_old :=
- match goal with | |- semax _ (main_pre_old ?prog _ _ * _) _ _ =>
+ match goal with | |- semax _ _ (main_pre_old ?prog _ _ ∗ _) _ _ =>
     rewrite main_pre_start_old;
     unfold prog_vars, prog
-                          | |- semax _ (main_pre_old ?prog _ _) _ _ =>
+                          | |- semax _ _ (main_pre_old ?prog _ _) _ _ =>
     rewrite main_pre_start_old;
     unfold prog_vars, prog
  end;
@@ -1973,5 +1769,3 @@ simple eapply semax_process_globvars;
  rewrite ?offset_val_unsigned_repr;
  simpl readonly2share;
  autorewrite with zero_val.
-
-
diff --git a/floyd/go_lower.v b/floyd/go_lower.v
index 7d61b37ff5..374ca0a5f0 100644
--- a/floyd/go_lower.v
+++ b/floyd/go_lower.v
@@ -1,4 +1,6 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.efield_lemmas.
 Require Import VST.floyd.local2ptree_denote.
@@ -6,9 +8,7 @@ Require Import VST.floyd.local2ptree_eval.
 Require Import VST.floyd.local2ptree_typecheck.
 Require Import VST.floyd.semax_tactics.
 Import LiftNotation.
-Import compcert.lib.Maps.
-
-Local Open Scope logic.
+Import -(notations) compcert.lib.Maps.
 
 Ltac unfold_for_go_lower :=
   cbv delta [PROPx LAMBDAx PARAMSx GLOBALSx LOCALx SEPx argsassert2assert locald_denote
@@ -19,24 +19,25 @@ Ltac unfold_for_go_lower :=
                       make_args' bind_ret get_result1 retval
                        classify_cast
                        (* force_val sem_cast_neutral ... NOT THESE TWO!  *)
-                      denote_tc_assert (* tc_andp tc_iszero *)
+                      expr2.denote_tc_assert (* tc_andp tc_iszero *)
     liftx LiftEnviron Tarrow Tend lift_S lift_T
     lift_prod lift_last lifted lift_uncurry_open lift_curry
      local lift lift0 lift1 lift2 lift3
    ] beta iota.
 
 Lemma grab_tc_environ:
-  forall Delta PQR S rho,
-    (tc_environ Delta rho -> PQR rho |-- S) ->
-    (local (tc_environ Delta) && PQR) rho |-- S.
+  forall `{!VSTGS OK_ty Σ} Delta (PQR : assert) S rho,
+    (tc_environ Delta rho -> PQR rho ⊢ S) ->
+    (local (tc_environ Delta) ∧ PQR) rho ⊢ S.
 Proof.
 intros.
 unfold PROPx,LOCALx in *; simpl in *.
-normalize.
-unfold local, lift1. normalize.
+monPred.unseal.
+by apply bi.pure_elim_l.
 Qed.
 
 Ltac go_lower0 :=
+try monPred.unseal; constructor;
 intros ?rho;
  try (simple apply grab_tc_environ; intro);
  repeat (progress unfold_for_go_lower; simpl).
@@ -47,30 +48,35 @@ intros ?rho;
 
 (*** New go_lower stuff ****)
 
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ}.
+
 Lemma lower_one_temp:
  forall t rho Delta P i v Q R S,
-  (temp_types Delta) ! i = Some t ->
+  (temp_types Delta) !! i = Some t ->
   (tc_val t v -> eval_id i rho = v ->
-   (local (tc_environ Delta) && PROPx P (LOCALx Q (SEPx R))) rho |-- S) ->
-  (local (tc_environ Delta) && PROPx P (LOCALx (temp i v :: Q) (SEPx R))) rho |-- S.
+   (local (tc_environ Delta) ∧ PROPx P (LOCALx Q (SEPx R))) rho ⊢ S) ->
+  (local (tc_environ Delta) ∧ PROPx P (LOCALx (temp i v :: Q) (SEPx R))) rho ⊢ S.
 Proof.
 intros.
 rewrite <- insert_local.
 forget (PROPx P (LOCALx Q (SEPx R))) as PQR.
-unfold local,lift1 in *.
-simpl in *. unfold_lift.
-normalize.
-rewrite prop_true_andp in H0 by auto.
-apply H0; auto.
-apply tc_eval'_id_i with Delta; auto.
+revert H0; monPred.unseal; intros H0.
+unfold_lift; apply bi.pure_elim_l; intros.
+apply bi.pure_elim_l; intros (-> & ?).
+rewrite -H0 //.
+- auto.
+- apply tc_val_tc_val'; last done.
+  apply tc_eval'_id_i with Delta; auto.
 Qed.
 
 Lemma lower_one_temp_Vint:
  forall t rho Delta P i v Q R S,
-  (temp_types Delta) ! i = Some t ->
+  (temp_types Delta) !! i = Some t ->
   (tc_val t (Vint v) -> eval_id i rho = Vint v ->
-   (local (tc_environ Delta) && PROPx P (LOCALx Q (SEPx R))) rho |-- S) ->
-  (local (tc_environ Delta) && PROPx P (LOCALx (temp i (Vint v) :: Q) (SEPx R))) rho |-- S.
+   (local (tc_environ Delta) ∧ PROPx P (LOCALx Q (SEPx R))) rho ⊢ S) ->
+  (local (tc_environ Delta) ∧ PROPx P (LOCALx (temp i (Vint v) :: Q) (SEPx R))) rho ⊢ S.
 Proof.
 intros.
 eapply lower_one_temp; eauto.
@@ -79,21 +85,19 @@ Qed.
 Lemma lower_one_lvar:
  forall t rho Delta P i v Q R S,
   (headptr v -> lvar_denote i t v rho ->
-   (local (tc_environ Delta) && PROPx P (LOCALx Q (SEPx R))) rho |-- S) ->
-  (local (tc_environ Delta) && PROPx P (LOCALx (lvar i t v :: Q) (SEPx R))) rho |-- S.
+   (local (tc_environ Delta) ∧ PROPx P (LOCALx Q (SEPx R))) rho ⊢ S) ->
+  (local (tc_environ Delta) ∧ PROPx P (LOCALx (lvar i t v :: Q) (SEPx R))) rho ⊢ S.
 Proof.
 intros.
 rewrite <- insert_local.
 forget (PROPx P (LOCALx Q (SEPx R))) as PQR.
-unfold local,lift1 in *.
-simpl in *. unfold_lift.
-normalize.
-rewrite prop_true_andp in H by auto.
+rewrite assoc (bi.and_comm (local _)) -assoc.
+revert H; monPred.unseal; intros H.
+apply bi.pure_elim_l; intros Hlvar.
 apply H; auto.
-hnf in H1.
-destruct (Map.get (ve_of rho) i); try contradiction.
-destruct p. destruct H1; subst.
-hnf; eauto.
+unfold lvar_denote in Hlvar.
+destruct (Map.get (ve_of rho) i) as [(?, ?)|]; try contradiction.
+destruct Hlvar; unfold headptr; eauto.
 Qed.
 
 Lemma finish_compute_le:  Lt = Gt -> False.
@@ -102,7 +106,7 @@ Proof. congruence. Qed.
 Lemma gvars_denote_HP: forall rho Delta gv i t,
   gvars_denote gv rho ->
   tc_environ Delta rho ->
-  (glob_types Delta) ! i = Some t ->
+  (glob_types Delta) !! i = Some t ->
   headptr (gv i).
 Proof.
   intros.
@@ -115,38 +119,38 @@ Qed.
 
 Lemma lower_one_gvars:
  forall  rho Delta P gv Q R S,
-  ((forall i t, (glob_types Delta) ! i = Some t -> headptr (gv i)) -> gvars_denote gv rho ->
-   (local (tc_environ Delta) && PROPx P (LOCALx Q (SEPx R))) rho |-- S) ->
-  (local (tc_environ Delta) && PROPx P (LOCALx (gvars gv :: Q) (SEPx R))) rho |-- S.
+  ((forall i t, (glob_types Delta) !! i = Some t -> headptr (gv i)) -> gvars_denote gv rho ->
+   (local (tc_environ Delta) ∧ PROPx P (LOCALx Q (SEPx R))) rho ⊢ S) ->
+  (local (tc_environ Delta) ∧ PROPx P (LOCALx (gvars gv :: Q) (SEPx R))) rho ⊢ S.
 Proof.
   intros.
   rewrite <- insert_local.
   forget (PROPx P (LOCALx Q (SEPx R))) as PQR.
-  unfold local,lift1 in *.
-  simpl in *.
-  normalize.
-  rewrite prop_true_andp in H by auto.
-  apply H; auto.
+  revert H; monPred.unseal; intros H.
+  apply bi.pure_elim_l; intros.
+  apply bi.pure_elim_l; intros.
+  rewrite -H //; first auto.
   intros.
   eapply gvars_denote_HP; eauto.
 Qed.
 
 Lemma finish_lower:
   forall rho (D: environ -> Prop) R S,
-  (D rho -> fold_right_sepcon R |-- S) ->
-  (local D && PROP() LOCAL() (SEPx R))%assert rho |-- S.
+  (D rho -> fold_right_sepcon R ⊢ S) ->
+  (local D ∧ PROP() LOCAL() (SEPx R))%assert rho ⊢ S.
 Proof.
 intros.
 simpl.
-unfold_for_go_lower; simpl. normalize.
+unfold_for_go_lower; simpl; monPred.unseal.
+normalize; auto.
 Qed.
 
 Lemma lower_one_temp_Vint':
  forall sz sg rho Delta P i v Q R S,
-  (temp_types Delta) ! i = Some (Tint sz sg noattr) ->
+  (temp_types Delta) !! i = Some (Tint sz sg noattr) ->
   ((exists j, v = Vint j /\ tc_val (Tint sz sg noattr) (Vint j) /\ eval_id i rho = (Vint j)) ->
-   (local (tc_environ Delta) && PROPx P (LOCALx Q (SEPx R))) rho |-- S) ->
-  (local (tc_environ Delta) && PROPx P (LOCALx (temp i v :: Q) (SEPx R))) rho |-- S.
+   (local (tc_environ Delta) ∧ PROPx P (LOCALx Q (SEPx R))) rho ⊢ S) ->
+  (local (tc_environ Delta) ∧ PROPx P (LOCALx (temp i v :: Q) (SEPx R))) rho ⊢ S.
 Proof.
 intros.
 eapply lower_one_temp; eauto.
@@ -157,94 +161,33 @@ hnf in H3. destruct v; try contradiction.
 exists i0. split3; auto.
 Qed.
 
-Ltac check_safe_subst z :=
- try (repeat lazymatch goal with
-       | H: z = ?A |- _ => match A with context [z] => revert H end
-       | H: ?A = z |- _ => match A with context [z] => revert H end
-       | H: ?A |- _ => match A with context [z] => revert H end
-       end;
-    match goal with |- ?G => 
-       try (has_evar G; fail 3 "subst not performed because the goal contains evars") 
-    end;
-   fail).
-
-Ltac safe_subst z :=
-  check_safe_subst z; subst z.
-
-Ltac safe_subst_any :=
-  repeat
-   match goal with
-   | H:?x = ?y |- _ => first [ safe_subst x | safe_subst y ]
-   end.
-
-(* safe_subst is meant to avoid doing rewrites or substitution of variables that
-  are in the scope of a unification variable.  See issue #186. *)
-
-Ltac lower_one_temp_Vint' :=
- match goal with
- | |- (local _ && PROPx _ (LOCALx (temp _ ?v :: _) _)) _ |-- _ =>
-    is_var v;
-     simple eapply lower_one_temp_Vint';
-     [ reflexivity | ];
-    let v' := fresh "v" in rename v into v';
-     let tc := fresh "TC" in
-     intros [v [? [tc ?EVAL]]]; unfold tc_val in tc; safe_subst v';
-     revert tc; fancy_intro true
- end.
-
 Lemma lower_one_temp_trivial:
  forall t rho Delta P i v Q R S,
-  (temp_types Delta) ! i = Some t ->
+  (temp_types Delta) !! i = Some t ->
   (tc_val t v ->
-   (local (tc_environ Delta) && PROPx P (LOCALx Q (SEPx R))) rho |-- S) ->
-  (local (tc_environ Delta) && PROPx P (LOCALx (temp i v :: Q) (SEPx R))) rho |-- S.
+   (local (tc_environ Delta) ∧ PROPx P (LOCALx Q (SEPx R))) rho ⊢ S) ->
+  (local (tc_environ Delta) ∧ PROPx P (LOCALx (temp i v :: Q) (SEPx R))) rho ⊢ S.
 Proof.
 intros.
 rewrite <- insert_local.
 forget (PROPx P (LOCALx Q (SEPx R))) as PQR.
-unfold local,lift1 in *.
-simpl in *. unfold_lift.
-normalize.
-rewrite prop_true_andp in H0 by auto.
-apply H0; auto.
+revert H0; monPred.unseal; intros H0.
+unfold_lift; apply bi.pure_elim_l; intros.
+apply bi.pure_elim_l; intros (-> & ?).
+rewrite -H0 //; first auto.
+apply tc_val_tc_val'; last done.
 apply tc_eval'_id_i with Delta; auto.
 Qed.
 
 Lemma quick_finish_lower:
-  forall LHS,
-  (emp |-- !! True) ->
-  LHS |-- !! True.
+  forall {B : bi} (LHS : B),
+  (emp ⊢ ⌜True⌝ : B) ->
+  LHS ⊢ ⌜True⌝.
 Proof.
 intros.
-apply prop_right; auto.
+apply bi.True_intro.
 Qed.
 
-Ltac gvar_headptr_intro_case1 gv H i :=
-         match goal with
-         | _ := gv i |- _ => fail 1
-         | H: isptr (gv i), H': headptr (gv i) |- _ => fail 1
-         | _ => generalize (H i _ ltac:(first[reflexivity | eassumption])); fancy_intro true
-         end.
-
-Ltac gvar_headptr_intro_case2 gv H x i :=
-         match goal with
-         | H: isptr x, H': headptr x |- _ => fail 1
-         | _ => generalize ((H i _ ltac:(first[reflexivity | eassumption])): headptr x); fancy_intro true
-         end.
-
-Ltac gvar_headptr_intro gv H:=
-  repeat
-     match goal with
-     | x:= gv ?i |- _ =>
-         gvar_headptr_intro_case2 gv H x i
-     | |- context [gv ?i] =>
-         gvar_headptr_intro_case1 gv H i
-     | _: context [gv ?i] |- _ =>
-         gvar_headptr_intro_case1 gv H i
-     | x:= context [gv ?i] |- _ =>
-         gvar_headptr_intro_case1 gv H i
-     end.
-
 Fixpoint remove_localdef (x: localdef) (l: list localdef) : list localdef :=
   match l with
   | nil => nil
@@ -265,7 +208,7 @@ Fixpoint remove_localdef (x: localdef) (l: list localdef) : list localdef :=
 Definition localdef_tc (Delta: tycontext) (gvar_idents: list ident) (x: localdef): list Prop :=
   match x with
   | temp i v =>
-      match (temp_types Delta) ! i with
+      match (temp_types Delta) !! i with
       | Some t => tc_val t v :: nil
       | _ => nil
       end
@@ -276,25 +219,25 @@ Definition localdef_tc (Delta: tycontext) (gvar_idents: list ident) (x: localdef
   end.
 
 Definition legal_glob_ident (Delta: tycontext) (i: ident): bool :=
-  match (glob_types Delta) ! i with
+  match (glob_types Delta) !! i with
   | Some _ => true
   | _ => false
   end.
 
+Local Notation local := (local(Σ := Σ)).
+
 Lemma localdef_local_facts: forall Delta gvar_ident x,
   fold_right andb true (map (legal_glob_ident Delta) gvar_ident) = true ->
-  local (tc_environ Delta) && local (locald_denote x) |-- !! fold_right and True (localdef_tc Delta gvar_ident x).
+  local (tc_environ Delta) ∧ local (locald_denote x) ⊢ ⌜fold_right and True (localdef_tc Delta gvar_ident x)⌝.
 Proof.
-  intros.
-  rename H into LEGAL.
-  unfold local, lift1; unfold_lift.
-  intros rho; simpl.
-  rewrite <- prop_and.
-  apply prop_derives.
-  intros [? ?].
+  intros ??? LEGAL.
+  monPred.unseal; split => rho; simpl.
+  rewrite /lift1 -bi.pure_and.
+  apply bi.pure_elim'; intros (? & ?).
+  apply bi.pure_intro.
   destruct x; simpl in H0; unfold_lift in H0.
   + subst; simpl.
-    destruct ((temp_types Delta) ! i) eqn:?; simpl; auto.
+    destruct ((temp_types Delta) !! i) eqn:?; simpl; auto.
     destruct H0; subst.
     split; auto.
     revert H1.
@@ -318,36 +261,29 @@ Proof.
     destruct_glob_types a.
       2: rewrite Heqo in LEGAL0; inv LEGAL0.
     rewrite Heqo0.
-    hnf; eauto.  
+    hnf; eauto.
+Qed.
+
+Lemma fold_right_and_app' : forall P1 P2, foldr and True%type (P1 ++ P2) <-> foldr and True%type P1 /\ foldr and True%type P2.
+Proof.
+  intros; induction P1; simpl; tauto.
 Qed.
 
 Lemma go_lower_localdef_one_step_canon_left: forall Delta Ppre l Qpre Rpre post gvar_ident
   (LEGAL: fold_right andb true (map (legal_glob_ident Delta) gvar_ident) = true),
-  (local (tc_environ Delta) && PROPx (Ppre ++ localdef_tc Delta gvar_ident l) (LOCALx (l :: Qpre) (SEPx Rpre)) |-- post) ->
-  local (tc_environ Delta) && PROPx Ppre (LOCALx (l :: Qpre) (SEPx Rpre)) |-- post.
+  (local (tc_environ Delta) ∧ PROPx (Ppre ++ localdef_tc Delta gvar_ident l) (LOCALx (l :: Qpre) (SEPx Rpre)) ⊢ post) ->
+  local (tc_environ Delta) ∧ PROPx Ppre (LOCALx (l :: Qpre) (SEPx Rpre)) ⊢ post.
 Proof.
   intros.
-  apply derives_trans with (local (tc_environ Delta) && PROPx (Ppre ++ localdef_tc Delta gvar_ident l) (LOCALx (l :: Qpre) (SEPx Rpre))); auto.
-  replace (PROPx (Ppre ++ localdef_tc Delta gvar_ident l)) with (@PROPx environ (localdef_tc Delta gvar_ident l ++ Ppre)).
-  2:{
-    apply PROPx_Permutation.
-    apply Permutation_app_comm.
-  }
+  rewrite -H.
+  erewrite (PROPx_Permutation (_ ++ _)) by apply Permutation_app_comm.
   rewrite <- !insert_local'.
-  apply andp_right; [solve_andp |].
-  apply andp_right; [solve_andp |].
-  unfold PROPx. apply andp_right; [| solve_andp].
-  rewrite <- andp_assoc.
-  eapply derives_trans; [apply andp_derives; [apply localdef_local_facts; eauto | apply derives_refl] |].
-  rewrite <- andp_assoc.
-  apply andp_left1.
-  remember (localdef_tc Delta gvar_ident l); clear.
-  induction l0.
-  + simpl fold_right.
-    apply andp_left2; auto.
-  + simpl fold_right.
-    rewrite !prop_and, !andp_assoc.
-    apply andp_derives; auto; try apply derives_refl.
+  apply bi.and_intro; [solve_andp |].
+  apply bi.and_intro; [solve_andp |].
+  unfold PROPx. apply bi.and_intro; [| rewrite /LOCALx; solve_andp].
+  rewrite assoc localdef_local_facts //.
+  rewrite fold_right_and_app'.
+  normalize.
 Qed.
 
 Definition localdefs_tc (Delta: tycontext) gvar_ident (Pre: list localdef): list Prop :=
@@ -355,20 +291,19 @@ Definition localdefs_tc (Delta: tycontext) gvar_ident (Pre: list localdef): list
 
 Lemma go_lower_localdef_canon_left: forall Delta Ppre Qpre Rpre post gvar_ident
   (LEGAL: fold_right andb true (map (legal_glob_ident Delta) gvar_ident) = true),
-  (local (tc_environ Delta) && PROPx (Ppre ++ localdefs_tc Delta gvar_ident Qpre) (LOCALx nil (SEPx Rpre)) |-- post) ->
-  local (tc_environ Delta) && PROPx Ppre (LOCALx Qpre (SEPx Rpre)) |-- post.
+  (local (tc_environ Delta) ∧ PROPx (Ppre ++ localdefs_tc Delta gvar_ident Qpre) (LOCALx nil (SEPx Rpre)) ⊢ post) ->
+  local (tc_environ Delta) ∧ PROPx Ppre (LOCALx Qpre (SEPx Rpre)) ⊢ post.
 Proof.
   intros.
   revert Ppre post H; induction Qpre; intros.
-  + cbv [localdefs_tc concat rev map] in H.
+  + cbv [localdefs_tc concat rev map ] in H.
     rewrite !app_nil_r in H; auto.
   + eapply go_lower_localdef_one_step_canon_left; eauto.
-    rewrite <- insert_local, (andp_comm _ (PROPx _ _)), <- andp_assoc, -> imp_andp_adjoint.
+    rewrite -insert_local (bi.and_comm _ (PROPx _ _)) assoc.
+    apply bi.impl_elim_l'.
     apply IHQpre.
-    rewrite <- imp_andp_adjoint.
-    apply andp_left1.
-    rewrite <- !app_assoc.
-    eapply derives_trans; [exact H | auto].
+    apply bi.impl_intro_l.
+    rewrite bi.and_elim_r -app_assoc //.
 Qed.
 
 Inductive No_value_for_temp_variable (i: ident) : Prop := .
@@ -379,12 +314,12 @@ Inductive Missing_gvars (gv: globals) : Prop := .
 Definition msubst_extract_local (Delta: tycontext) (T1: PTree.t val) (T2: PTree.t (type * val)) (GV: option globals) (x: localdef): Prop :=
   match x with
   | temp i u =>
-    match T1 ! i with
+    match T1 !! i with
     | Some v => u = v
     | None => No_value_for_temp_variable i
     end
   | lvar i ti u =>
-    match T2 ! i with
+    match T2 !! i with
     | Some (tj, v) =>
       if eqb_type ti tj
       then u = v
@@ -402,15 +337,15 @@ Definition msubst_extract_locals (Delta: tycontext) (T1: PTree.t val) (T2: PTree
 
 Lemma localdef_local_facts_inv: forall Delta P T1 T2 GV R x,
   msubst_extract_local Delta T1 T2 GV x ->
-  local (tc_environ Delta) && PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) |-- local (locald_denote x).
+  local (tc_environ Delta) ∧ PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) ⊢ local (locald_denote x).
 Proof.
   intros.
   destruct x; simpl in H.
   + apply in_local.
     apply LocalD_sound_temp.
-    destruct (T1 ! i); inv H; auto.
+    destruct (T1 !! i); inv H; auto.
   + apply in_local.
-    destruct (T2 ! i) as [[? ?] |] eqn:?H; try solve [inv H].
+    destruct (T2 !! i) as [[? ?] |] eqn:?H; try solve [inv H].
     destruct (eqb_type t t0) eqn:?H; [| inv H].
     apply eqb_type_spec in H1; subst.
     eapply LocalD_sound_local in H0.
@@ -423,42 +358,37 @@ Qed.
 
 Lemma go_lower_localdef_one_step_canon_canon: forall Delta Ppre Qpre Rpre Ppost l Qpost Rpost T1 T2 GV,
   local2ptree Qpre = (T1, T2, nil, GV) ->
-  local (tc_environ Delta) && PROPx Ppre (LOCALx Qpre (SEPx Rpre)) && PROPx (Ppost ++ msubst_extract_local Delta T1 T2 GV l :: nil) (LOCALx Qpost (SEPx Rpost)) |-- PROPx Ppost (LOCALx (l :: Qpost) (SEPx Rpost)).
+  local (tc_environ Delta) ∧ PROPx Ppre (LOCALx Qpre (SEPx Rpre)) ∧ PROPx (Ppost ++ msubst_extract_local Delta T1 T2 GV l :: nil) (LOCALx Qpost (SEPx Rpost)) ⊢ PROPx Ppost (LOCALx (l :: Qpost) (SEPx Rpost)).
 Proof.
   intros.
-  replace (PROPx (Ppost ++ msubst_extract_local Delta T1 T2 GV l :: nil)) with (@PROPx environ (msubst_extract_local Delta T1 T2 GV l :: Ppost)).
-  2:{
-    apply PROPx_Permutation.
-    eapply Permutation_trans; [| apply Permutation_app_comm].
-    apply Permutation_refl.
-  }
-  rewrite <- !insert_local', <- !insert_prop.
-  apply andp_right; [| solve_andp].
-  normalize.
-  apply andp_left1.
+  erewrite (PROPx_Permutation (_ ++ _)) by apply Permutation_app_comm.
+  rewrite /= -!insert_local' -!insert_prop.
+  apply bi.and_intro; [| rewrite /PROPx /LOCALx; solve_andp].
   apply (local2ptree_soundness Ppre _ Rpre) in H; simpl in H.
   rewrite H.
+  rewrite assoc comm -assoc; apply bi.pure_elim_l; intros.
+  rewrite bi.and_elim_r.
   apply localdef_local_facts_inv; auto.
 Qed.
 
 Lemma go_lower_localdef_canon_canon : forall Delta Ppre Qpre Rpre Ppost Qpost Rpost T1 T2 GV,
   local2ptree Qpre = (T1, T2, nil, GV) ->
-  local (tc_environ Delta) && PROPx Ppre (LOCALx Qpre (SEPx Rpre)) && PROPx (Ppost ++ msubst_extract_locals Delta T1 T2 GV Qpost) (LOCALx nil (SEPx Rpost)) |-- PROPx Ppost (LOCALx Qpost (SEPx Rpost)).
+  local (tc_environ Delta) ∧ PROPx Ppre (LOCALx Qpre (SEPx Rpre)) ∧ PROPx (Ppost ++ msubst_extract_locals Delta T1 T2 GV Qpost) (LOCALx nil (SEPx Rpost)) ⊢ PROPx Ppost (LOCALx Qpost (SEPx Rpost)).
 Proof.
   intros.
   revert Ppost; induction Qpost; intros.
   + simpl app.
     rewrite app_nil_r.
-    solve_andp.
-  + eapply derives_trans; [| apply (go_lower_localdef_one_step_canon_canon Delta Ppre Qpre Rpre); eassumption].
-    apply andp_right; [solve_andp |].
-    eapply derives_trans; [| apply IHQpost].
-    rewrite <- app_assoc; simpl app; auto.
+    rewrite /PROPx /LOCALx; solve_andp.
+  + rewrite -(go_lower_localdef_one_step_canon_canon _ Ppre _ Rpre); last done.
+    apply bi.and_intro; [solve_andp |].
+    apply bi.and_intro; [rewrite /PROPx /LOCALx; solve_andp|].
+    rewrite -IHQpost -app_assoc //.
 Qed.
 
 Lemma go_lower_localdef_canon_tc_expr {cs: compspecs} : forall Delta Ppre Qpre Rpre e T1 T2 GV,
   local2ptree Qpre = (T1, T2, nil, GV) ->
-  local (tc_environ Delta) && PROPx Ppre (LOCALx Qpre (SEPx Rpre)) && `(msubst_tc_expr Delta T1 T2 GV e) |-- tc_expr Delta e.
+  local (tc_environ Delta) ∧ PROPx Ppre (LOCALx Qpre (SEPx Rpre)) ∧ assert_of `(msubst_tc_expr Delta T1 T2 GV e) ⊢ tc_expr Delta e.
 Proof.
   intros.
   erewrite local2ptree_soundness by eassumption.
@@ -467,7 +397,7 @@ Qed.
 
 Lemma go_lower_localdef_canon_tc_lvalue {cs: compspecs} : forall Delta Ppre Qpre Rpre e T1 T2 GV,
   local2ptree Qpre = (T1, T2, nil, GV) ->
-  local (tc_environ Delta) && PROPx Ppre (LOCALx Qpre (SEPx Rpre)) && `(msubst_tc_lvalue Delta T1 T2 GV e) |-- tc_lvalue Delta e.
+  local (tc_environ Delta) ∧ PROPx Ppre (LOCALx Qpre (SEPx Rpre)) ∧ assert_of `(msubst_tc_lvalue Delta T1 T2 GV e) ⊢ tc_lvalue Delta e.
 Proof.
   intros.
   erewrite local2ptree_soundness by eassumption.
@@ -476,7 +406,7 @@ Qed.
 
 Lemma go_lower_localdef_canon_tc_LR {cs: compspecs} : forall Delta Ppre Qpre Rpre e lr T1 T2 GV,
   local2ptree Qpre = (T1, T2, nil, GV) ->
-  local (tc_environ Delta) && PROPx Ppre (LOCALx Qpre (SEPx Rpre)) && `(msubst_tc_LR Delta T1 T2 GV e lr) |-- tc_LR Delta e lr.
+  local (tc_environ Delta) ∧ PROPx Ppre (LOCALx Qpre (SEPx Rpre)) ∧ assert_of `(msubst_tc_LR Delta T1 T2 GV e lr) ⊢ tc_LR Delta e lr.
 Proof.
   intros.
   erewrite local2ptree_soundness by eassumption.
@@ -485,7 +415,7 @@ Qed.
 
 Lemma go_lower_localdef_canon_tc_efield {cs: compspecs} : forall Delta Ppre Qpre Rpre efs T1 T2 GV,
   local2ptree Qpre = (T1, T2, nil, GV) ->
-  local (tc_environ Delta) && PROPx Ppre (LOCALx Qpre (SEPx Rpre)) && `(msubst_tc_efield Delta T1 T2 GV efs) |-- tc_efield Delta efs.
+  local (tc_environ Delta) ∧ PROPx Ppre (LOCALx Qpre (SEPx Rpre)) ∧ assert_of `(msubst_tc_efield Delta T1 T2 GV efs) ⊢ tc_efield Delta efs.
 Proof.
   intros.
   erewrite local2ptree_soundness by eassumption.
@@ -494,7 +424,7 @@ Qed.
 
 Lemma go_lower_localdef_canon_tc_exprlist {cs: compspecs} : forall Delta Ppre Qpre Rpre ts es T1 T2 GV,
   local2ptree Qpre = (T1, T2, nil, GV) ->
-  local (tc_environ Delta) && PROPx Ppre (LOCALx Qpre (SEPx Rpre)) && `(msubst_tc_exprlist Delta T1 T2 GV ts es) |-- tc_exprlist Delta ts es.
+  local (tc_environ Delta) ∧ PROPx Ppre (LOCALx Qpre (SEPx Rpre)) ∧ assert_of `(msubst_tc_exprlist Delta T1 T2 GV ts es) ⊢ tc_exprlist Delta ts es.
 Proof.
   intros.
   erewrite local2ptree_soundness by eassumption.
@@ -503,7 +433,7 @@ Qed.
 
 Lemma go_lower_localdef_canon_tc_expropt {cs: compspecs} : forall Delta Ppre Qpre Rpre e t T1 T2 GV,
   local2ptree Qpre = (T1, T2, nil, GV) ->
-  local (tc_environ Delta) && PROPx Ppre (LOCALx Qpre (SEPx Rpre)) && `(msubst_tc_expropt Delta T1 T2 GV e t) |-- tc_expropt Delta e t.
+  local (tc_environ Delta) ∧ PROPx Ppre (LOCALx Qpre (SEPx Rpre)) ∧ assert_of `(msubst_tc_expropt Delta T1 T2 GV e t) ⊢ tc_expropt Delta e t.
 Proof.
   intros.
   erewrite local2ptree_soundness by eassumption.
@@ -513,29 +443,33 @@ Qed.
 Lemma go_lower_localdef_canon_eval_lvalue {cs: compspecs} : forall Delta Ppre Qpre Rpre e T1 T2 GV u v,
   local2ptree Qpre = (T1, T2, nil, GV) ->
   msubst_eval_lvalue Delta T1 T2 GV e = Some u ->
-  local (tc_environ Delta) && PROPx Ppre (LOCALx Qpre (SEPx Rpre)) && `(!! (u = v)) |-- local (`(eq v) (eval_lvalue e)).
+  local (tc_environ Delta) ∧ PROPx Ppre (LOCALx Qpre (SEPx Rpre)) ∧ local (`(u = v)) ⊢ local (`(eq v) (eval_lvalue e)).
 Proof.
   intros.
   erewrite local2ptree_soundness by eassumption.
+  rewrite assoc msubst_eval_lvalue_eq //.
+  split => rho; monPred.unseal.
   normalize.
-  apply msubst_eval_lvalue_eq, H0.
+  apply bi.pure_elim_r; intros ->; done.
 Qed.
 
 Lemma go_lower_localdef_canon_eval_expr {cs: compspecs} : forall Delta Ppre Qpre Rpre e T1 T2 GV u v,
   local2ptree Qpre = (T1, T2, nil, GV) ->
   msubst_eval_expr Delta T1 T2 GV e = Some u ->
-  local (tc_environ Delta) && PROPx Ppre (LOCALx Qpre (SEPx Rpre)) && `(!! (u = v)) |-- local (`(eq v) (eval_expr e)).
+  local (tc_environ Delta) ∧ PROPx Ppre (LOCALx Qpre (SEPx Rpre)) ∧ local `(u = v) ⊢ local (`(eq v) (eval_expr e)).
 Proof.
   intros.
   erewrite local2ptree_soundness by eassumption.
+  rewrite assoc msubst_eval_expr_eq //.
+  split => rho; monPred.unseal.
   normalize.
-  apply msubst_eval_expr_eq, H0.
+  apply bi.pure_elim_r; intros ->; done.
 Qed.
 
-Inductive clean_LOCAL_right (Delta: tycontext) (T1: PTree.t val) (T2: PTree.t (type * val)) (GV: option globals): (environ -> mpred) -> mpred -> Prop :=
-| clean_LOCAL_right_sep_lift: forall P, clean_LOCAL_right Delta T1 T2 GV (`P) (P)
-| clean_LOCAL_right_local_lift: forall P, clean_LOCAL_right Delta T1 T2 GV (local (`P)) (!! P)
-| clean_LOCAL_right_prop: forall P, clean_LOCAL_right Delta T1 T2 GV (!! P) (!! P)
+Inductive clean_LOCAL_right (Delta: tycontext) (T1: PTree.t val) (T2: PTree.t (type * val)) (GV: option globals): assert -> mpred -> Prop :=
+| clean_LOCAL_right_sep_lift: forall P, clean_LOCAL_right Delta T1 T2 GV ⎡P⎤ (P)
+| clean_LOCAL_right_local_lift: forall P, clean_LOCAL_right Delta T1 T2 GV (local (`P)) (⌜P⌝)
+| clean_LOCAL_right_prop: forall P, clean_LOCAL_right Delta T1 T2 GV (⌜P⌝) (⌜P⌝)
 | clean_LOCAL_right_tc_lvalue: forall (cs: compspecs) e, clean_LOCAL_right Delta T1 T2 GV (denote_tc_assert (typecheck_lvalue Delta e)) (msubst_tc_lvalue Delta T1 T2 GV e)
 | clean_LOCAL_right_tc_expr: forall (cs: compspecs) e, clean_LOCAL_right Delta T1 T2 GV (denote_tc_assert (typecheck_expr Delta e)) (msubst_tc_expr Delta T1 T2 GV e)
 | clean_LOCAL_right_tc_LR: forall (cs: compspecs) e lr, clean_LOCAL_right Delta T1 T2 GV (denote_tc_assert (typecheck_LR Delta e lr)) (msubst_tc_LR Delta T1 T2 GV e lr)
@@ -543,21 +477,20 @@ Inductive clean_LOCAL_right (Delta: tycontext) (T1: PTree.t val) (T2: PTree.t (t
 | clean_LOCAL_right_tc_exprlist: forall (cs: compspecs)  ts es, clean_LOCAL_right Delta T1 T2 GV (denote_tc_assert (typecheck_exprlist Delta ts es)) (msubst_tc_exprlist Delta T1 T2 GV ts es)
 | clean_LOCAL_right_tc_expropt: forall (cs: compspecs) e t, clean_LOCAL_right Delta T1 T2 GV (tc_expropt Delta e t) (msubst_tc_expropt Delta T1 T2 GV e t)
 | clean_LOCAL_right_canon': forall P Q R, clean_LOCAL_right Delta T1 T2 GV (PROPx P (LOCALx Q (SEPx R))) (fold_right_PROP_SEP (P ++ msubst_extract_locals Delta T1 T2 GV Q) R)
-| clean_LOCAL_right_eval_lvalue: forall  (cs: compspecs) e u v, msubst_eval_lvalue Delta T1 T2 GV e = Some u -> clean_LOCAL_right Delta T1 T2 GV (local (`(eq v) (eval_lvalue e))) (!! (u = v))
-| clean_LOCAL_right_eval_expr: forall  (cs: compspecs) e u v, msubst_eval_expr Delta T1 T2 GV e = Some u -> clean_LOCAL_right Delta T1 T2 GV (local (`(eq v) (eval_expr e))) (!! (u = v))
-| clean_LOCAL_right_andp: forall P1 P2 Q1 Q2, clean_LOCAL_right Delta T1 T2 GV P1 Q1 -> clean_LOCAL_right Delta T1 T2 GV P2 Q2 -> clean_LOCAL_right Delta T1 T2 GV (P1 && P2) (Q1 && Q2)
-| clean_LOCAL_right_EX': forall A (P: A -> environ -> mpred) (Q: A -> mpred), (forall a, clean_LOCAL_right Delta T1 T2 GV (P a) (Q a)) -> clean_LOCAL_right Delta T1 T2 GV (exp P) (exp Q).
+| clean_LOCAL_right_eval_lvalue: forall  (cs: compspecs) e u v, msubst_eval_lvalue Delta T1 T2 GV e = Some u -> clean_LOCAL_right Delta T1 T2 GV (local (`(eq v) (eval_lvalue e))) (⌜u = v⌝)
+| clean_LOCAL_right_eval_expr: forall  (cs: compspecs) e u v, msubst_eval_expr Delta T1 T2 GV e = Some u -> clean_LOCAL_right Delta T1 T2 GV (local (`(eq v) (eval_expr e))) (⌜u = v⌝)
+| clean_LOCAL_right_andp: forall P1 P2 Q1 Q2, clean_LOCAL_right Delta T1 T2 GV P1 Q1 -> clean_LOCAL_right Delta T1 T2 GV P2 Q2 -> clean_LOCAL_right Delta T1 T2 GV (P1 ∧ P2) (Q1 ∧ Q2)
+| clean_LOCAL_right_tc_andp: forall {cs : compspecs} P1 P2 Q1 Q2, clean_LOCAL_right Delta T1 T2 GV (denote_tc_assert P1) Q1 -> clean_LOCAL_right Delta T1 T2 GV (denote_tc_assert P2) Q2 -> clean_LOCAL_right Delta T1 T2 GV (denote_tc_assert (tc_andp P1 P2)) (Q1 ∧ Q2)
+| clean_LOCAL_right_EX': forall A (P: A -> assert) (Q: A -> mpred), (forall a, clean_LOCAL_right Delta T1 T2 GV (P a) (Q a)) -> clean_LOCAL_right Delta T1 T2 GV (∃ x, P x) (∃ x, Q x).
 
-Lemma clean_LOCAL_right_TT (Delta : tycontext) (T1 : PTree.t val) (T2 : PTree.t (type * val)) (GV : option globals): clean_LOCAL_right Delta T1 T2 GV TT TT.
+Lemma clean_LOCAL_right_True (Delta : tycontext) (T1 : PTree.t val) (T2 : PTree.t (type * val)) (GV : option globals): clean_LOCAL_right Delta T1 T2 GV True True.
 Proof.
-  intros.
-  exact (clean_LOCAL_right_sep_lift _ _ _ _ TT).
+  exact (clean_LOCAL_right_prop _ _ _ _ True).
 Qed.
 
-Lemma clean_LOCAL_right_FF (Delta : tycontext) (T1 : PTree.t val) (T2 : PTree.t (type * val)) (GV : option globals): clean_LOCAL_right Delta T1 T2 GV FF FF.
+Lemma clean_LOCAL_right_False (Delta : tycontext) (T1 : PTree.t val) (T2 : PTree.t (type * val)) (GV : option globals): clean_LOCAL_right Delta T1 T2 GV False False.
 Proof.
-  intros.
-  exact (clean_LOCAL_right_sep_lift _ _ _ _ FF).
+  exact (clean_LOCAL_right_prop _ _ _ _ False).
 Qed.
 
 Lemma clean_LOCAL_right_canon (Delta : tycontext) (T1 : PTree.t val) (T2 : PTree.t (type * val)) (GV : option globals): forall P Q R Res, (fold_right_PROP_SEP (VST_floyd_app P (msubst_extract_locals Delta T1 T2 GV Q)) R) = Res -> clean_LOCAL_right Delta T1 T2 GV (PROPx P (LOCALx Q (SEPx R))) Res.
@@ -567,16 +500,18 @@ Proof.
   apply clean_LOCAL_right_canon'.
 Qed.
 
-Lemma clean_LOCAL_right_tc_andp {cs: compspecs} (Delta : tycontext) (T1 : PTree.t val) (T2 : PTree.t (type * val)) (GV : option globals): forall P1 P2 Q1 Q2, clean_LOCAL_right Delta T1 T2 GV (denote_tc_assert P1) Q1 -> clean_LOCAL_right Delta T1 T2 GV (denote_tc_assert P2) Q2 -> clean_LOCAL_right Delta T1 T2 GV (denote_tc_assert (tc_andp P1 P2)) (Q1 && Q2).
+(* clean_LOCAL_right is syntactic except for this lemma -- maybe we should just add it as a case?
+Lemma clean_LOCAL_right_tc_andp {cs: compspecs} (Delta : tycontext) (T1 : PTree.t val) (T2 : PTree.t (type * val)) (GV : option globals): forall P1 P2 Q1 Q2, clean_LOCAL_right Delta T1 T2 GV (denote_tc_assert P1) Q1 -> clean_LOCAL_right Delta T1 T2 GV (denote_tc_assert P2) Q2 -> clean_LOCAL_right Delta T1 T2 GV (denote_tc_assert (tc_andp P1 P2)) (Q1 ∧ Q2).
 Proof.
   intros.
+  simpl.
   rewrite denote_tc_assert_andp.
   apply clean_LOCAL_right_andp; auto.
-Qed.
+Qed.*)
 
-Lemma clean_LOCAL_right_EX: forall (Delta: tycontext) (T1: PTree.t val) (T2: PTree.t (type * val)) (GV: option globals) A (P: A -> environ -> mpred) (Q: A -> mpred),
+Lemma clean_LOCAL_right_EX: forall (Delta: tycontext) (T1: PTree.t val) (T2: PTree.t (type * val)) (GV: option globals) A (P: A -> assert) (Q: A -> mpred),
   (forall a, exists Q', clean_LOCAL_right Delta T1 T2 GV (P a) Q' /\ Q' = Q a) ->
-  clean_LOCAL_right Delta T1 T2 GV (exp P) (exp Q).
+  clean_LOCAL_right Delta T1 T2 GV (∃ x, P x) (∃ x, Q x).
 Proof.
   intros.
   apply clean_LOCAL_right_EX'.
@@ -585,55 +520,62 @@ Proof.
   subst; auto.
 Qed.
 
+Lemma assert_of_liftx_embed P: assert_of(Σ:=Σ) (liftx P) ⊣⊢ ⎡P⎤.
+Proof.
+  intros.
+  split => rho //; monPred.unseal; done.
+Qed.
+
 Lemma clean_LOCAL_right_aux: forall gvar_ident (Delta: tycontext) (T1: PTree.t val) (T2: PTree.t (type * val)) (GV: option globals) P Q R S S'
   (LEGAL: fold_right andb true (map (legal_glob_ident Delta) gvar_ident) = true),
   local2ptree Q = (T1, T2, nil, GV) ->
   clean_LOCAL_right Delta T1 T2 GV S S' ->
-  local (tc_environ Delta) && PROPx P (LOCALx Q (SEPx R)) && ` S' |-- S.
+  local (tc_environ Delta) ∧ PROPx P (LOCALx Q (SEPx R)) ∧ assert_of (` S') ⊢ S.
 Proof.
   intros.
   induction H0.
-  + apply andp_left2. apply derives_refl.
-  + apply andp_left2. apply derives_refl.
-  + apply andp_left2. apply derives_refl.
+  + rewrite assert_of_liftx_embed; solve_andp.
+  + solve_andp.
+  + rewrite lift0C_prop; solve_andp.
   + eapply go_lower_localdef_canon_tc_lvalue; eauto.
   + eapply go_lower_localdef_canon_tc_expr; eauto.
   + eapply go_lower_localdef_canon_tc_LR; eauto.
   + eapply go_lower_localdef_canon_tc_efield; eauto.
   + eapply go_lower_localdef_canon_tc_exprlist; eauto.
   + eapply go_lower_localdef_canon_tc_expropt; eauto.
-  + eapply derives_trans; [| eapply (go_lower_localdef_canon_canon Delta P Q R); eauto].
-    apply andp_right; [apply andp_left1; auto |].
+  + etrans; [| eapply (go_lower_localdef_canon_canon Delta P Q R); eauto].
+    apply bi.and_intro; [rewrite bi.and_elim_l; auto |].
     go_lowerx.
-    rewrite fold_right_PROP_SEP_spec.
+    rewrite fold_right_PROP_SEP_spec fold_right_sepconx_eq.
     normalize.
-    solve_andp.
   + eapply go_lower_localdef_canon_eval_lvalue; eauto.
   + eapply go_lower_localdef_canon_eval_expr; eauto.
-  + apply andp_right.
-    - eapply derives_trans; [| apply IHclean_LOCAL_right1].
-      unfold_lift; intros rho; simpl.
-      solve_andp.
-    - eapply derives_trans; [| apply IHclean_LOCAL_right2].
-      unfold_lift; intros rho; simpl.
-      solve_andp.
-  + normalize.
-    apply (exp_right x).
-    apply H1.
+  + rewrite lift0C_andp; apply bi.and_intro.
+    - rewrite -IHclean_LOCAL_right1.
+      rewrite /PROPx /LOCALx; solve_andp.
+    - rewrite -IHclean_LOCAL_right2.
+      rewrite /PROPx /LOCALx; solve_andp.
+  + rewrite lift0C_andp denote_tc_assert_andp; apply bi.and_intro.
+    - rewrite -IHclean_LOCAL_right1.
+      rewrite /PROPx /LOCALx; solve_andp.
+    - rewrite -IHclean_LOCAL_right2.
+      rewrite /PROPx /LOCALx; solve_andp.
+  + rewrite lift0C_exp !bi.and_exist_l; apply bi.exist_elim; intros.
+    rewrite -bi.exist_intro //.
 Qed.
 
 Lemma clean_LOCAL_right_spec: forall gvar_ident (Delta: tycontext) (T1: PTree.t val) (T2: PTree.t (type * val)) (GV: option globals) P Q R S S'
   (LEGAL: fold_right andb true (map (legal_glob_ident Delta) gvar_ident) = true),
   local2ptree Q = (T1, T2, nil, GV) ->
   clean_LOCAL_right Delta T1 T2 GV S S' ->
-  (local (tc_environ Delta) && PROPx (VST_floyd_app P (localdefs_tc Delta gvar_ident Q)) (LOCALx nil (SEPx R)) |-- ` S') ->
-  local (tc_environ Delta) && PROPx P (LOCALx Q (SEPx R)) |-- S.
+  (local (tc_environ Delta) ∧ PROPx (VST_floyd_app P (localdefs_tc Delta gvar_ident Q)) (LOCALx nil (SEPx R)) ⊢ assert_of (` S')) ->
+  local (tc_environ Delta) ∧ PROPx P (LOCALx Q (SEPx R)) ⊢ S.
 Proof.
   intros.
-  assert (ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- `S')
+  assert (ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢ assert_of (`S'))
     by (eapply go_lower_localdef_canon_left; eauto).
   rewrite (add_andp _ _ H2); clear H1 H2.
-  eapply clean_LOCAL_right_aux; eauto.
+  rewrite -assoc; eapply clean_LOCAL_right_aux; eauto.
 Qed.
 
 (* This version of clean_LOCAL_right (with "bangbang") is to
@@ -644,57 +586,114 @@ Lemma clean_LOCAL_right_spec_bangbang: forall gvar_ident
   (LEGAL: fold_right andb true (map (legal_glob_ident Delta) gvar_ident) = true),
   local2ptree Q = (T1, T2, nil, GV) ->
   clean_LOCAL_right Delta T1 T2 GV S S' ->
-  (local (tc_environ Delta) && PROPx P (LOCALx nil (SEPx R)) |-- liftx S') ->
-  local (tc_environ Delta) && PROPx P (LOCALx Q (SEPx R)) |-- S.
+  (local (tc_environ Delta) ∧ PROPx P (LOCALx nil (SEPx R)) ⊢ assert_of (liftx S')) ->
+  local (tc_environ Delta) ∧ PROPx P (LOCALx Q (SEPx R)) ⊢ S.
 Proof.
   intros.
-  assert (ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- `S'). {
+  assert (ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢ assert_of (`S')). {
     eapply go_lower_localdef_canon_left; try eassumption.
     eapply ENTAIL_trans; try eassumption.
-    apply andp_left2.
+    rewrite bi.and_elim_r.
     clear.
-    apply andp_derives; auto.
-    apply prop_derives.
-    intros.
-    induction P; simpl in *; tauto. 
+    apply bi.and_mono; last done.
+    rewrite fold_right_and_app' bi.pure_and bi.and_elim_l //.
   }
   rewrite (add_andp _ _ H2); clear H1 H2.
-  eapply clean_LOCAL_right_aux; eauto.
+  rewrite -assoc; eapply clean_LOCAL_right_aux; eauto.
 Qed.
 
 Lemma clean_LOCAL_right_bupd_spec: forall gvar_ident (Delta: tycontext) (T1: PTree.t val) (T2: PTree.t (type * val)) (GV: option globals) P Q R S S'
   (LEGAL: fold_right andb true (map (legal_glob_ident Delta) gvar_ident) = true),
   local2ptree Q = (T1, T2, nil, GV) ->
   clean_LOCAL_right Delta T1 T2 GV S S' ->
-  (local (tc_environ Delta) && PROPx (VST_floyd_app P (localdefs_tc Delta gvar_ident Q)) (LOCALx nil (SEPx R)) |-- (|==> ` S')) ->
-  local (tc_environ Delta) && PROPx P (LOCALx Q (SEPx R)) |-- |==> S.
+  (local (tc_environ Delta) ∧ PROPx (VST_floyd_app P (localdefs_tc Delta gvar_ident Q)) (LOCALx nil (SEPx R)) ⊢ (|==> assert_of (` S'))) ->
+  local (tc_environ Delta) ∧ PROPx P (LOCALx Q (SEPx R)) ⊢ |==> S.
 Proof.
   intros.
-  assert (ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- |==> `S')
+  assert (ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢ |==> assert_of (`S'))
     by (eapply go_lower_localdef_canon_left; eauto).
-  pose proof clean_LOCAL_right_aux _ _ _ _ _ P _ (TT :: nil) _ _ LEGAL H H0.
+  pose proof clean_LOCAL_right_aux _ _ _ _ _ P _ (True :: nil) _ _ LEGAL H H0.
   rewrite (add_andp _ _ H2); clear H1 H2.
-  eapply derives_trans.
-  + apply andp_derives; [| apply derives_refl].
-    apply andp_derives; [apply derives_refl |].
-    instantiate (1 := PROPx P (LOCALx Q (SEPx (TT::nil)))).
-    apply andp_derives; auto.
-    apply andp_derives; auto.
-    unfold SEPx; simpl.
-    rewrite sepcon_emp; auto.
-  + rewrite andp_comm.
-    eapply derives_trans; [apply bupd_andp2_corable |].
-    - apply corable_andp; [intro; apply corable_prop |].
-      apply corable_andp; [intro; simpl; apply corable_prop |].
-      apply corable_andp; [intro; simpl; apply corable_prop |].
-      unfold SEPx; simpl.
-      rewrite sepcon_emp.
-      intro; simpl. apply corable_prop.
-    - apply bupd_mono.
-      rewrite andp_comm.
-      auto.
+  rewrite -H3.
+  etrans.
+  + apply bi.and_mono; last done.
+    apply bi.and_mono; first done.
+    instantiate (1 := PROPx P (LOCALx Q (SEPx (True::nil)))).
+    rewrite /PROPx /LOCALx /SEPx /= bi.sep_emp.
+    repeat (apply bi.and_mono; first done).
+    rewrite embed_pure; apply bi.True_intro.
+  + rewrite /PROPx /LOCALx /SEPx /local /lift1; monPred.unseal; split => rho; simpl.
+    iIntros "(#(? & ? & ? & ?) & >$) !>"; auto.
+Qed.
+
+Lemma remove_emp_l : forall (P Q : mpred), (P ⊢ Q) -> P ∗ emp ⊢ Q.
+Proof.
+  intros; rewrite bi.sep_emp //.
 Qed.
 
+End mpred.
+
+Ltac check_safe_subst z :=
+ try (repeat lazymatch goal with
+       | H: z = ?A |- _ => match A with context [z] => revert H end
+       | H: ?A = z |- _ => match A with context [z] => revert H end
+       | H: ?A |- _ => match A with context [z] => revert H end
+       end;
+    match goal with |- ?G => 
+       try (has_evar G; fail 3 "subst not performed because the goal contains evars") 
+    end;
+   fail).
+
+Ltac safe_subst z :=
+  check_safe_subst z; subst z.
+
+Ltac safe_subst_any :=
+  repeat
+   match goal with
+   | H:?x = ?y |- _ => first [ safe_subst x | safe_subst y ]
+   end.
+
+(* safe_subst is meant to avoid doing rewrites or substitution of variables that
+  are in the scope of a unification variable.  See issue #186. *)
+
+Ltac lower_one_temp_Vint' :=
+ match goal with
+ | |- (local _ ∧ PROPx _ (LOCALx (temp _ ?v :: _) _)) _ ⊢ _ =>
+    is_var v;
+     simple eapply lower_one_temp_Vint';
+     [ reflexivity | ];
+    let v' := fresh "v" in rename v into v';
+     let tc := fresh "TC" in
+     intros [v [? [tc ?EVAL]]]; unfold tc_val in tc; safe_subst v';
+     revert tc; fancy_intro true
+ end.
+
+Ltac gvar_headptr_intro_case1 gv H i :=
+         match goal with
+         | _ := gv i |- _ => fail 1
+         | H: isptr (gv i), H': headptr (gv i) |- _ => fail 1
+         | _ => generalize (H i _ ltac:(first[reflexivity | eassumption])); fancy_intro true
+         end.
+
+Ltac gvar_headptr_intro_case2 gv H x i :=
+         match goal with
+         | H: isptr x, H': headptr x |- _ => fail 1
+         | _ => generalize ((H i _ ltac:(first[reflexivity | eassumption])): headptr x); fancy_intro true
+         end.
+
+Ltac gvar_headptr_intro gv H:=
+  repeat
+     match goal with
+     | x:= gv ?i |- _ =>
+         gvar_headptr_intro_case2 gv H x i
+     | |- context [gv ?i] =>
+         gvar_headptr_intro_case1 gv H i
+     | _: context [gv ?i] |- _ =>
+         gvar_headptr_intro_case1 gv H i
+     | x:= context [gv ?i] |- _ =>
+         gvar_headptr_intro_case1 gv H i
+     end.
+
 Ltac unfold_localdef_name QQ Q :=
   match Q with
   | nil => idtac
@@ -723,11 +722,11 @@ Ltac simply_msubst_extract_locals :=
 
 Ltac solve_clean_LOCAL_right :=
   solve
-    [ simple apply clean_LOCAL_right_sep_lift
+    [ (*simple*) apply clean_LOCAL_right_sep_lift
     | simple apply clean_LOCAL_right_local_lift
     | simple apply clean_LOCAL_right_prop
-    | simple apply clean_LOCAL_right_TT
-    | simple apply clean_LOCAL_right_FF
+    | simple apply clean_LOCAL_right_True
+    | simple apply clean_LOCAL_right_False
     | try unfold tc_lvalue; simple apply clean_LOCAL_right_tc_lvalue
     | try unfold tc_expr; simple apply clean_LOCAL_right_tc_expr
     | try unfold tc_LR; simple apply clean_LOCAL_right_tc_LR
@@ -739,7 +738,7 @@ Ltac solve_clean_LOCAL_right :=
       unify_for_go_lower;
       unfold VST_floyd_app;
       unfold fold_right_PROP_SEP, fold_right_and_True;
-      unfold fold_right_sepcon; fold fold_right_sepcon; rewrite ?sepcon_emp;
+      cbv [fold_right_sepconx];
       reflexivity
     | simple apply clean_LOCAL_right_eval_lvalue; solve_msubst_eval_lvalue
     | simple apply clean_LOCAL_right_eval_expr; solve_msubst_eval_expr
@@ -765,8 +764,8 @@ Inductive bangbang : Prop := bangbang_i.
  of the clean_LOCAL_right_spec lemma; otherwise the default version *)
 Ltac choose_clean_LOCAL_right_spec L :=
  lazymatch goal with 
- | H: bangbang |- _ => eapply (@clean_LOCAL_right_spec_bangbang L)
- | |- _ => eapply (@clean_LOCAL_right_spec L)
+ | H: bangbang |- _ => eapply (clean_LOCAL_right_spec_bangbang L)
+ | |- _ => eapply (clean_LOCAL_right_spec L)
  end.
 
 Ltac eapply_clean_LOCAL_right_spec_rec gv L :=
@@ -782,28 +781,28 @@ Ltac eapply_clean_LOCAL_right_spec_rec gv L :=
       | _ => eapply_clean_LOCAL_right_spec_rec gv (@cons ident i L)
       end
   | _ => match goal with
-         | |- _ |-- |==> _ => eapply (@clean_LOCAL_right_bupd_spec L)
+         | |- _ ⊢ |==> _ => eapply (@clean_LOCAL_right_bupd_spec L)
          | _ => choose_clean_LOCAL_right_spec L
          end
   end.
 
 Definition emptyCS : compspecs.
 assert (composite_env_consistent (PTree.empty _)).
- hnf; intros; rewrite PTree.gempty in *; discriminate.
+ hnf; intros; rewrite -> PTree.gempty in *; discriminate.
 assert (composite_env_complete_legal_cosu_type (PTree.empty _)).
- hnf; intros; rewrite PTree.gempty in *; discriminate.
+ hnf; intros; rewrite -> PTree.gempty in *; discriminate.
 assert (hardware_alignof_env_consistent (PTree.empty _) (PTree.empty _)).
- hnf; intros; rewrite PTree.gempty in *; discriminate.
+ hnf; intros; rewrite -> PTree.gempty in *; discriminate.
 assert (hardware_alignof_env_complete (PTree.empty _) (PTree.empty _)).
- hnf; intros; rewrite PTree.gempty in *;
-split; intros [? ?]; rewrite PTree.gempty in *; discriminate.
+ hnf; intros; rewrite -> PTree.gempty in *;
+split; intros [? ?]; rewrite -> PTree.gempty in *; discriminate.
 assert (legal_alignas_env_consistent (PTree.empty _) (PTree.empty _) (PTree.empty _)).
- hnf; intros; rewrite PTree.gempty in *; discriminate.
+ hnf; intros; rewrite -> PTree.gempty in *; discriminate.
 assert (legal_alignas_env_complete (PTree.empty _) (PTree.empty _)).
- hnf; intros; rewrite PTree.gempty in *;
-split; intros [? ?]; rewrite PTree.gempty in *; discriminate.
+ hnf; intros; rewrite -> PTree.gempty in *;
+split; intros [? ?]; rewrite -> PTree.gempty in *; discriminate.
 refine (mkcompspecs (PTree.empty _) _ _ _ (PTree.empty _) _ _ (PTree.empty _) _ _ _); auto.
- hnf; intros; rewrite PTree.gempty in *; discriminate.
+ hnf; intros; rewrite -> PTree.gempty in *; discriminate.
 apply legal_alignas_soundness; auto.
 Defined.
 
@@ -812,7 +811,7 @@ Ltac eapply_clean_LOCAL_right_spec :=
    | |- context [gvars ?gv] => 
           eapply_clean_LOCAL_right_spec_rec gv (@nil ident)
    | _ => match goal with
-         | |- _ |-- |==> _ => eapply (clean_LOCAL_right_bupd_spec (@nil ident))
+         | |- _ ⊢ |==> _ => eapply (clean_LOCAL_right_bupd_spec (@nil ident))
          | _ => choose_clean_LOCAL_right_spec (@nil ident)
          end
   end.
@@ -888,15 +887,14 @@ Ltac intro_PROP :=
   | |- _ => fancy_intro true
   end.
 
-
 Ltac check_mpreds R :=
  lazymatch R with
  | ?a :: ?al => match type of a with ?t =>
-                          first [constr_eq t mpred | fail 4 "The SEP conjunct" a "has type" t "but should have type mpred; these two types may be convertible but they are not identical"]
+                          first [unify t mpred | fail 4 "The SEP conjunct" a "has type" t "but should have type mpred; these two types may be convertible but they are not identical"]
                      end; check_mpreds al
  | nil => idtac
  | _ => match type of R with ?t => 
-               first [constr_eq t (list mpred)
+               first [unify t (list mpred)
                       | fail 4 "The SEP list" R "has type" t "but should have type (list mpred); these two types may be convertible but they are not identical"]
             end
  end.
@@ -905,28 +903,32 @@ Ltac go_lower :=
 clear_Delta_specs;
 intros;
 match goal with
- | |- local _ && PROPx _ (LOCALx _ (SEPx ?R)) |-- _ => check_mpreds R
- | |- ENTAIL _, PROPx _ (LOCALx _ (SEPx ?R)) |-- _ => check_mpreds R
- | |- ENTAIL _, _ |-- _ => fail 10 "The left-hand-side of your entailment is not in PROP/LOCAL/SEP form"
- | _ => fail 10 "go_lower requires a proof goal in the form of (ENTAIL _ , _ |-- _)"
+ | |- local _ ∧ PROPx _ (LOCALx _ (SEPx ?R)) ⊢ _ => check_mpreds R
+ | |- ENTAIL _, PROPx _ (LOCALx _ (SEPx ?R)) ⊢ _ => check_mpreds R
+ | |- ENTAIL _, _ ⊢ _ => fail 10 "The left-hand-side of your entailment is not in PROP/LOCAL/SEP form"
+ | _ => fail 10 "go_lower requires a proof goal in the form of (ENTAIL _ , _ ⊢ _)"
 end;
 clean_LOCAL_canon_mix;
 repeat (simple apply derives_extract_PROP; intro_PROP);
 let rho := fresh "rho" in
-intro rho;
+split => rho;
 first
 [ simple apply quick_finish_lower
-|          
+|
  (let TC := fresh "TC" in apply finish_lower; intros TC ||
  match goal with
- | |- (_ && PROPx nil _) _ |-- _ => fail 1 "LOCAL part of precondition is not a concrete list (or maybe Delta is not concrete)"
+ | |- (_ ∧ PROPx nil _) _ ⊢ _ => fail 1 "LOCAL part of precondition is not a concrete list (or maybe Delta is not concrete)"
  | |- _ => fail 1 "PROP part of precondition is not a concrete list"
  end);
-unfold fold_right_sepcon; fold fold_right_sepcon; rewrite ?sepcon_emp; (* for the left side *)
 unfold_for_go_lower;
-simpl tc_val; 
+rewrite -!fold_right_sepconx_eq;
+cbv [fold_right_sepconx];
+simpl tc_val;
 cbv [typecheck_exprlist typecheck_expr]; simpl tc_andp;
 simpl msubst_denote_tc_assert;
+try monPred.unseal; unfold assert_of;
+repeat match goal with |-context[@monPred_at ?A ?B ?C ?D] =>
+  change (@monPred_at A B C D) with (let (monPred_at, _) := C in monPred_at D); cbv match beta end;
 try clear dependent rho;
 clear_Delta
 ].
@@ -937,13 +939,13 @@ Ltac sep_apply_in_lifted_entailment H :=
      allows us to use propositional facts derived from the PROP and LOCAL
      parts of the left-hand side *)
 (* unfold fold_right_sepcon at 1; *)
- match goal with |- ?R |-- ?R2 => 
-  let r2 := fresh "R2" in pose (r2 := R2); change (R |-- r2);
+ match goal with |- ?R ⊢ ?R2 => 
+  let r2 := fresh "R2" in pose (r2 := R2); change (R ⊢ r2);
   sep_apply_in_entailment H; [ .. | 
-  match goal with |- ?R' |-- _ =>
+  match goal with |- ?R' ⊢ _ =>
    let R'' := refold_right_sepcon R' 
-     in replace R' with (fold_right_sepcon R'') 
-           by (unfold fold_right_sepcon; rewrite ?sepcon_emp; reflexivity);
+     in rewrite (_:R' ⊣⊢ fold_right_sepcon R'');
+       [..| unfold fold_right_sepcon; rewrite ?bi.sep_emp; reflexivity ];
         subst r2; apply derives_refl
    end]
  end.
@@ -953,24 +955,24 @@ Ltac sep_apply_in_semax H :=
 
 Ltac sep_apply H :=
  match goal with
- | |- ENTAIL _ , _ |-- _ => eapply ENTAIL_trans; [sep_apply_in_lifted_entailment H | ] 
- | |- @derives mpred _ _ _ => sep_apply_in_entailment H
- | |- semax _ _ _ _ => sep_apply_in_semax H
+ | |- ENTAIL _ , _ ⊢ _ => eapply ENTAIL_trans; [sep_apply_in_lifted_entailment H | ] 
+ | |- _ ⊢ _ => sep_apply_in_entailment H
+ | |- semax _ _ _ _ _ => sep_apply_in_semax H
  end.
 
 Ltac new_sep_apply_in_lifted_entailment H evar_tac prop_tac :=
   apply SEP_entail';
-  go_lower; (* Using SEP_entail' and go_lower, instead of just SEP_entail,
+  match goal with |- ?R ⊢ ⎡?R2⎤ =>
+    let r2 := fresh "R2" in pose (r2 := R2); change (R ⊢ ⎡r2⎤);
+    go_lower; (* Using SEP_entail' and go_lower, instead of just SEP_entail,
      allows us to use propositional facts derived from the PROP and LOCAL
      parts of the left-hand side *)
   (* unfold fold_right_sepcon at 1; *)
-  match goal with |- ?R |-- ?R2 =>
-    let r2 := fresh "R2" in pose (r2 := R2); change (R |-- r2);
     new_sep_apply_in_entailment H evar_tac prop_tac; [ .. |
-    match goal with |- ?R' |-- _ =>
+    match goal with |- ?R' ⊢ _ =>
       let R'' := refold_right_sepcon R' in
-      replace R' with (fold_right_sepcon R'')
-             by (unfold fold_right_sepcon; rewrite ?sepcon_emp; reflexivity);
+      rewrite (_:R' ⊣⊢ fold_right_sepcon R'');
+        [..| unfold fold_right_sepcon; rewrite ?bi.sep_emp; reflexivity ];
           subst r2; apply derives_refl
     end]
   end.
@@ -980,9 +982,9 @@ Ltac new_sep_apply_in_semax H evar_tac prop_tac :=
 
 Ltac new_sep_apply H evar_tac prop_tac :=
   lazymatch goal with
-  | |- ENTAIL _ , _ |-- _ => eapply ENTAIL_trans; [new_sep_apply_in_lifted_entailment H evar_tac prop_tac | ]
-  | |- @derives mpred _ _ _ => new_sep_apply_in_entailment H evar_tac prop_tac
-  | |- semax _ _ _ _ => new_sep_apply_in_semax H evar_tac prop_tac
+  | |- ENTAIL _ , _ ⊢ _ => eapply ENTAIL_trans; [new_sep_apply_in_lifted_entailment H evar_tac prop_tac | ]
+  | |- _ ⊢ _ => new_sep_apply_in_entailment H evar_tac prop_tac
+  | |- semax _ _ _ _ _ => new_sep_apply_in_semax H evar_tac prop_tac
   end.
 
 Ltac sep_apply_evar_tac x := fail 0 "Unable to find an instance for the variable" x.
@@ -998,7 +1000,3 @@ Ltac sep_eapply_prop_tac := sep_apply_prop_tac.
 
 Ltac sep_eapply H :=
   new_sep_apply H sep_eapply_evar_tac sep_apply_prop_tac.
-
-
-
-
diff --git a/floyd/hints.v b/floyd/hints.v
index 4f0a9eb46d..dc2c09d92b 100644
--- a/floyd/hints.v
+++ b/floyd/hints.v
@@ -1,4 +1,6 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.go_lower.
 Require Import VST.floyd.closed_lemmas.
@@ -27,7 +29,9 @@ Require Import VST.floyd.deadvars.
 Require Import VST.zlist.list_solver.
 Import Cop.
 Import Cop2.
-Import compcert.lib.Maps.
+Import -(notations) compcert.lib.Maps.
+
+Local Unset SsrRewrite.
 
 Ltac hint_loop := 
   idtac "Hint: try 'forward_for_simple_bound N (EX i:Z, PROP... LOCAL...SEP...)%assert', where N is the upper bound of the loop, i is the loop iteration value,  and the LOCAL clause does NOT contain a 'temp' binding for the loop iteration variable";
@@ -96,10 +100,10 @@ Ltac print_sumbool_hint Pre :=
 Ltac hint_allp_left A := 
 lazymatch A with
 | @cons mpred ?B ?C => hint_allp_left B; hint_allp_left C
-| @sepcon mpred _ _ ?B ?C => hint_allp_left B; hint_allp_left C
-| @andp mpred _ ?B ?C => hint_allp_left B; hint_allp_left C
-| @orp mpred _ ?B ?C => hint_allp_left B; hint_allp_left C
-| @allp mpred _ ?T _ => 
+| @bi_sep (iPropI _) ?B ?C => hint_allp_left B; hint_allp_left C
+| @bi_and (iPropI _) ?B ?C => hint_allp_left B; hint_allp_left C
+| @bi_or (iPropI _) ?B ?C => hint_allp_left B; hint_allp_left C
+| @bi_forall (iPropI _) ?T _ => 
    idtac "Hint: You can instantiate the universally quantified ";
    idtac "(ALL _:"T", _) in your precondition";
    idtac "using the tactic 'allp_left x',";
@@ -110,7 +114,7 @@ end.
 Ltac print_hint_semax D Pre c Post :=
  try (tryif (try (deadvars!; fail 1)) then fail
      else idtac "Hint: 'deadvars!' removes useless LOCAL definitions");
- try match Pre with exp _ => idtac "Hint: try 'Intros x' where x is the name you want to give the variable bound by EX'"  end;
+ try match Pre with bi_exist _ => idtac "Hint: try 'Intros x' where x is the name you want to give the variable bound by EX'"  end;
  try match Pre with PROPx (_::_) _ => idtac "Hint: use 'Intros' to move propositions above the line" end;
  try match Pre with PROPx nil (LOCALx _ (SEPx ?R)) =>
      try let x := fresh "x" in
@@ -138,11 +142,11 @@ Ltac print_sumbool_hint_hyp :=
                                     else idtac "Hint: 'rewrite if_true in"H"by auto'"
        end end.
 
-Ltac cancelable A := 
+Ltac cancelable A :=
 lazymatch A with
-| @sepcon mpred _ _ ?B ?C => cancelable B; cancelable C
-| @andp mpred _ _ _ => fail
-| @orp mpred _ _ _ => fail
+| @bi_sep (iPropI _) ?B ?C => cancelable B; cancelable C
+| @bi_and (iPropI _) _ _ => fail
+| @bi_or (iPropI _) _ _ => fail
 | _ => idtac
 end.
 
@@ -192,20 +196,20 @@ Ltac hint_solves :=
  | match goal with |- context [field_compatible] => idtac | |- context [field_compatible0] => idtac end;
        tryif (try (assert True; [ | solve [auto with field_compatible]]; fail 1)) then fail
        else  idtac "Hint:  'auto with field_compatible' solves the goal"
- | match goal with |- @derives mpred _ _ _ =>
+ | match goal with |- @bi_entails (iPropI _) _ _ =>
      tryif (try (assert True; [ | solve [cancel]]; fail 1)) then fail
      else  idtac "Hint:  'cancel' or 'entailer!' solves the goal"
    end
  | tryif (try (assert True; [ | solve [entailer!]]; fail 1)) then fail
      else  idtac "Hint:  'entailer!' solves the goal"
- | match goal with |- ?A |-- ?B => 
+ | match goal with |- ?A ⊢ ?B => 
          timeout 1 (unify A B);
          idtac "Hint: 'apply derives_refl' solves the goal.  You might wonder why 'auto' or 'cancel' does not solve this goal; the reason is that the left and right sides of the entailment are equal but not identical, and sometimes the attempt to unify terms like this would be far too slow to build into 'auto' or 'cancel'"
    end
  ].
 
 Ltac hint_exists :=
-  try match goal with |- _ |-- ?B => match B with context [@exp _ _ ?t ] =>
+  try match goal with |- _ ⊢ ?B => match B with context [@bi_exist _ ?t ] =>
        idtac "Hint: try 'Exists x', where x is a value of type " t " to instantiate the existential"
    end end.
 
@@ -239,16 +243,15 @@ Ltac hint_saturate_local' P :=
 
 Ltac hint_saturate_local P :=
 match P with
-| @sepcon mpred _ _ ?A ?B => hint_saturate_local A; hint_saturate_local B
-| @andp mpred _ ?A ?B => hint_saturate_local A; hint_saturate_local B
-| @wand mpred _ _ _ _ => idtac
-| @orp mpred _ _ _ => idtac
-| @emp mpred _ _ _ => idtac
-| @prop mpred _ _ => idtac
-| @allp _ _ _ _ => idtac
-| @exp _ _ _ _ => idtac
-| @emp _ _ _ => idtac
-| _ => tryif (try (let x := fresh "x" in evar (x: Prop); assert (P |-- prop x);
+| @bi_sep (iPropI _) ?A ?B => hint_saturate_local A; hint_saturate_local B
+| @bi_and (iPropI _) ?A ?B => hint_saturate_local A; hint_saturate_local B
+| @bi_wand (iPropI _) _ _ => idtac
+| @bi_or (iPropI _) _ _ => idtac
+| @bi_emp _ => idtac
+| @bi_pure (iPropI _) _ => idtac
+| @bi_forall (iPropI _) _ _ => idtac
+| @bi_exist (iPropI _) _ _ => idtac
+| _ => tryif (try (let x := fresh "x" in evar (x: Prop); assert (P ⊢ ⌜x⌝);
                     [subst x; solve [eauto with saturate_local] | fail 1]))
                then hint_saturate_local' P
                else idtac
@@ -256,11 +259,11 @@ end.
 
 Ltac cancel_frame_hint := 
 match goal with
-| |- @derives mpred _  _ ?A =>
+| |- @bi_entails (iPropI _) _ ?A =>
   match A with context [fold_right_sepcon ?Frame] =>
       match goal with F := ?G : list mpred |- _ => constr_eq F Frame; is_evar G end;
-      match A with context [@sepcon] => idtac end;
-      idtac "Hint: In order for the 'cancel' tactic to automatically instantiate the Frame, it must be able to cancel all the other right-hand-side conjuncts against some left-hand-side conjuncts.  Right now the r.h.s. conjuncts do not exactly match l.h.s. conjuncts; perhaps you can unfold or rewrite on both sides of the |-- so that they do cancel."
+      match A with context [@bi_sep] => idtac end;
+      idtac "Hint: In order for the 'cancel' tactic to automatically instantiate the Frame, it must be able to cancel all the other right-hand-side conjuncts against some left-hand-side conjuncts.  Right now the r.h.s. conjuncts do not exactly match l.h.s. conjuncts; perhaps you can unfold or rewrite on both sides of the ⊢ so that they do cancel."
   end
 end.
 
@@ -286,18 +289,18 @@ Ltac hint_progress any n :=
  | 8%nat => tryif (try (progress rewrite if_false by (auto; lia); fail 1)) then fail
      else  idtac "Hint:  try 'rewrite if_false by auto' or 'rewrite if_false by lia'"
  |9%nat => lazymatch goal with
-   | D := @abbreviate tycontext _, Po := @abbreviate ret_assert _ |- semax ?D' ?Pre ?c ?Post =>
+   | D := @abbreviate tycontext _, Po := @abbreviate ret_assert _ |- semax ?E ?D' ?Pre ?c ?Post =>
      tryif (constr_eq D D'; constr_eq Po Post) then print_hint_semax D Pre c Post
      else idtac "Hint: use abbreviate_semax to put your proof goal into a more standard form"
-   | |- semax _ _ _ _ => 
+   | |- semax _ _ _ _ _ => 
          idtac "Hint: use abbreviate_semax to put your proof goal into a more standard form"
-   | |- ENTAIL _, ?Pre |-- _ => 
+   | |- ENTAIL _, ?Pre ⊢ _ => 
               print_sumbool_hint Pre;
               idtac "Hint: try 'entailer!'";
               try match Pre with PROPx _ (LOCALx _ (SEPx ?R)) => hint_allp_left R end
-   | |- @derives mpred _ ?A ?B =>
+   | |- @bi_entails (iPropI _) ?A ?B =>
               cancelable A; cancelable B;
-              tryif (try (assert True; [ | rewrite ?sepcon_emp, ?emp_sepcon; progress cancel]; fail 1)) 
+              tryif (try (assert True; [ | rewrite ?bi.sep_emp, ?bi.emp_sep; progress cancel]; fail 1)) 
                 then cancel_frame_hint
                 else  idtac "Hint:  try 'cancel'" 
    end
@@ -319,15 +322,15 @@ Ltac try_redundant_lia H :=
  end.
 
 Ltac hint_whatever :=
- try match goal with  |- @derives mpred _ ?A ?B =>
+ try match goal with  |- @bi_entails (iPropI _) ?A ?B =>
             hint_saturate_local A;
             tryif (try (assert True; [ | progress_entailer]; fail 1)) then idtac
               else  idtac "Hint:  try 'entailer!'";
             try hint_allp_left A;
-            try print_sumbool_hint (A |-- B)
+            try print_sumbool_hint (A ⊢ B)
  end;
  try match goal with |- @eq mpred _ _ => 
-              idtac "Hint: try 'apply pred_ext'"
+              idtac "Hint: try 'iSplit'"
       end;
  try match goal with
  | H: ?A = ?B |- _ => unify A B; idtac "Hint: hypothesis" H "is a tautology, perhaps 'clear" H "'"
@@ -374,4 +377,3 @@ Ltac hint_special := idtac.
 
 Ltac hint :=
    first [hint_solves | hint_special; hint_exists; first [hint_progress false O | hint_whatever]].
-
diff --git a/floyd/io_events.v b/floyd/io_events.v
index 820a1e4e34..08b52330e8 100644
--- a/floyd/io_events.v
+++ b/floyd/io_events.v
@@ -5,7 +5,7 @@ Require Import ITree.Eq.SimUpToTaus.
 Require Import ITree.Interp.Traces.
 (*Import ITreeNotations.*)
 Notation "t1 ;; t2" := (ITree.bind t1 (fun _ => t2))
-  (at level 100, right associativity) : itree_scope.
+  (at level 100, t2 at level 200, right associativity) : itree_scope.
 Require Import Morphisms.
 
 #[global] Hint Mode ReSum - - - - : typeclass_instances.
@@ -26,8 +26,10 @@ Definition write f (c : byte) : itree E unit := embed (EWrite f c).
 
 Definition IO_itree := itree E unit.
 
+Context `{!VSTGS IO_itree Σ}.
+
 (* We need a layer of inclusion to allow us to use the monad laws. *)
-Definition ITREE (tr : IO_itree) := EX tr' : _, !!(sutt eq tr tr') &&
+Definition ITREE (tr : IO_itree) := ∃ tr' : _, ⌜sutt eq tr tr'⌝ ∧
   has_ext tr'.
 
 (* this should be in ITrees *)
@@ -42,37 +44,37 @@ Proof.
   apply eqit_bind; [|intros []]; reflexivity.
 Qed.
 
-Lemma has_ext_ITREE : forall tr, has_ext tr |-- ITREE tr.
+Lemma has_ext_ITREE : forall tr, has_ext tr ⊢ ITREE tr.
 Proof.
   intro; unfold ITREE.
   Exists tr; entailer!.
 Qed.
 
 Lemma ITREE_impl' : forall tr tr', sutt eq tr' tr ->
-  ITREE tr |-- ITREE tr'.
+  ITREE tr ⊢ ITREE tr'.
 Proof.
   intros.
   unfold ITREE.
   Intros tr1; Exists tr1; entailer!.
-  rewrite trace_incl_iff_sutt in *; unfold trace_incl in *; auto.
+  rewrite -> trace_incl_iff_sutt in *; unfold trace_incl in *; auto.
 Qed.
 
 Lemma ITREE_impl : forall tr tr', eutt eq tr tr' ->
-  ITREE tr |-- ITREE tr'.
+  ITREE tr ⊢ ITREE tr'.
 Proof.
   intros; apply ITREE_impl'.
   apply eutt_sutt; symmetry; auto.
 Qed.
 
 Lemma ITREE_ext : forall tr tr', eutt eq tr tr' ->
-  ITREE tr = ITREE tr'.
+  ITREE tr ⊣⊢ ITREE tr'.
 Proof.
-  intros; apply pred_ext; apply ITREE_impl; auto.
-  symmetry; auto.
+  intros; iSplit; iApply ITREE_impl; auto.
+  by symmetry.
 Qed.
 
 Global Instance eutt_ITREE :
-  Proper (eutt eq ==> eq) ITREE.
+  Proper (eutt eq ==> equiv) ITREE.
 Proof. repeat intro. apply ITREE_ext; auto. Qed.
 
 Fixpoint write_list f l : IO_itree :=
diff --git a/floyd/library.v b/floyd/library.v
index c7c77571d3..452f1bec91 100644
--- a/floyd/library.v
+++ b/floyd/library.v
@@ -1,4 +1,6 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.zlist.sublist.
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.closed_lemmas.
@@ -33,13 +35,18 @@ Require Import VST.floyd.globals_lemmas.
 Require Import VST.floyd.diagnosis.
 Require Import VST.floyd.freezer.
 Import ListNotations.
-Import String.
 
-Definition body_lemma_of_funspec  {Espec: OracleKind} (ef: external_function) (f: funspec) :=
-  match f with mk_funspec sig _ A P Q _ _ =>
-    semax_external ef A P Q
+Section semax.
+
+Context `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty}.
+
+Definition body_lemma_of_funspec (ef: external_function) (f: funspec) :=
+  match f with mk_funspec sig _ A E P Q =>
+    ⊢ semax_external ef A E P Q
   end.
 
+Local Notation funspec := (@funspec Σ).
+
 Definition try_spec  (name: string) (spec: funspec) : 
    list (ident * globdef Clight.fundef type) -> list (ident*funspec) :=
 fun defs => 
@@ -49,67 +56,41 @@ fun defs =>
  end.
 Arguments try_spec name spec defs / .
 
-Definition exit_spec' :=
+Definition exit_spec' : funspec :=
  WITH arg: Z
  PRE [tint]
    PROP () PARAMS (Vint (Int.repr arg)) SEP()
  POST [ tvoid ]
-   PROP(False) RETURN() SEP().
+   PROP(False%type) RETURN() SEP().
 
 Definition exit_spec := try_spec "exit" exit_spec'.
 
 Parameter body_exit:
- forall {Espec: OracleKind},
   body_lemma_of_funspec
     (EF_external "exit"
        {| sig_args := Xint :: nil; sig_res := Xvoid; sig_cc := cc_default |})
    exit_spec'.
 
 Parameter mem_mgr: globals -> mpred.
-Axiom create_mem_mgr: forall gv, emp |-- mem_mgr gv.
+Axiom create_mem_mgr: forall gv, emp ⊢ mem_mgr gv.
 
 Parameter malloc_token : forall {cs: compspecs}, share -> type -> val -> mpred.
 Parameter malloc_token_valid_pointer:
-  forall {cs: compspecs} sh t p, sizeof t <= 0 -> malloc_token sh t p |-- valid_pointer p.
+  forall {cs: compspecs} sh t p, malloc_token sh t p ⊢ valid_pointer p.
 
-#[export] Hint Extern 1 (malloc_token _ _ _ |-- valid_pointer _) =>
-  (simple apply malloc_token_valid_pointer; data_at_valid_aux) : valid_pointer.
+Parameter malloc_token_local_facts:
+  forall {cs: compspecs} sh t p, malloc_token sh t p ⊢ ⌜malloc_compatible (sizeof t) p⌝.
 
-Ltac malloc_token_data_at_valid_pointer :=
-  (* If the size of t is unknown, can still prove valid pointer
-      from (malloc_token sh t p * ... * data_at[_] sh t p)  *)
-  match goal with |- ?A |-- valid_pointer ?p =>
-   match A with
-   | context [malloc_token _ ?t p] =>
-         try (assert (sizeof t <= 0) by (simpl sizeof in *; rep_lia); fail 1);
-         try (assert (sizeof t > 0) by (simpl sizeof in *; rep_lia); fail 1);
-         destruct (zlt 0 (sizeof t));
-         auto with valid_pointer
-   end
- end.
+Parameter malloc_token_change_composite: forall {cs_from cs_to} {CCE : change_composite_env cs_from cs_to} sh t v,
+  cs_preserve_type cs_from cs_to (coeq cs_from cs_to) t = true ->
+  @malloc_token cs_from sh t v ⊣⊢ @malloc_token cs_to sh t v.
 
-#[export] Hint Extern 4 (_ |-- valid_pointer _) => malloc_token_data_at_valid_pointer : valid_pointer.
+Parameter malloc_token_share_join: forall {cs: compspecs} sh1 sh2 sh t p,
+  sepalg.join sh1 sh2 sh -> malloc_token sh1 t p ∗ malloc_token sh2 t p ⊣⊢ malloc_token sh t p.
+
+Parameter malloc_token_conflict: forall {cs: compspecs} sh t p, sh <> Share.bot ->
+  0 < sizeof t -> malloc_token sh t p ∗ malloc_token sh t p ⊢ False.
 
-Parameter malloc_token_local_facts:
-  forall {cs: compspecs} sh t p, malloc_token sh t p |-- !! malloc_compatible (sizeof t) p.
-#[export] Hint Resolve malloc_token_local_facts : saturate_local.
-Parameter malloc_token_change_composite: forall {cs_from cs_to} {CCE : change_composite_env cs_from cs_to} sh t,
-  cs_preserve_type cs_from cs_to (coeq cs_from cs_to) t = true ->
-  @malloc_token cs_from sh t = @malloc_token cs_to sh t.
-Ltac change_compspecs' cs cs' ::=
-  match goal with
-  | |- context [@data_at cs' ?sh ?t ?v1] => erewrite (@data_at_change_composite cs' cs _ sh t); [| apply JMeq_refl | reflexivity]
-  | |- context [@field_at cs' ?sh ?t ?gfs ?v1] => erewrite (@field_at_change_composite cs' cs _ sh t gfs); [| apply JMeq_refl | reflexivity]
-  | |- context [@data_at_ cs' ?sh ?t] => erewrite (@data_at__change_composite cs' cs _ sh t); [| reflexivity]
-  | |- context [@field_at_ cs' ?sh ?t ?gfs] => erewrite (@field_at__change_composite cs' cs _ sh t gfs); [| reflexivity]
-  | |- context [@malloc_token cs' ?sh ?t] => erewrite (@malloc_token_change_composite cs' cs _ sh t); [| reflexivity]
-  | |- context [?A cs'] => change (A cs') with (A cs)
-  | |- context [?A cs' ?B] => change (A cs' B) with (A cs B)
-  | |- context [?A cs' ?B ?C] => change (A cs' B C) with (A cs B C)
-  | |- context [?A cs' ?B ?C ?D] => change (A cs' B C D) with (A cs B C D)
-  | |- context [?A cs' ?B ?C ?D ?E] => change (A cs' B C D E) with (A cs B C D E)
-  | |- context [?A cs' ?B ?C ?D ?E ?F] => change (A cs' B C D E F) with (A cs B C D E F)
- end.
 (*
 Parameter malloc_token_precise:
   forall {cs: compspecs} sh t p, predicates_sl.precise (malloc_token sh t p).
@@ -136,15 +117,15 @@ Definition malloc_spec'  {cs: compspecs} :=
                 natural_aligned natural_alignment t = true)
        PARAMS (Vptrofs (Ptrofs.repr (sizeof t))) GLOBALS (gv)
        SEP (mem_mgr gv)
-    POST [ tptr tvoid ] EX p:_,
+    POST [ tptr tvoid ] ∃ p:_,
        PROP ()
        RETURN (p)
        SEP (mem_mgr gv;
              if eq_dec p nullval then emp
-            else (malloc_token Ews t p * data_at_ Ews t p)).
+            else (malloc_token Ews t p ∗ data_at_ Ews t p)).
 
 Parameter body_malloc:
- forall {Espec: OracleKind} {cs: compspecs} ,
+ forall {cs: compspecs},
   body_lemma_of_funspec EF_malloc malloc_spec'.
 (*
 Definition free_spec'  {cs: compspecs} :=
@@ -166,14 +147,14 @@ Definition free_spec'  {cs: compspecs} :=
        PARAMS (p) GLOBALS (gv)
        SEP (mem_mgr gv;
               if eq_dec p nullval then emp
-              else (malloc_token Ews t p * data_at_ Ews t p))
+              else (malloc_token Ews t p ∗ data_at_ Ews t p))
     POST [ Tvoid ]
        PROP ()
        RETURN ()
        SEP (mem_mgr gv).
 
 Parameter body_free:
- forall {Espec: OracleKind} {cs: compspecs} ,
+ forall {cs: compspecs} ,
   body_lemma_of_funspec EF_free free_spec'.
 
 Definition library_G  {cs: compspecs} prog :=
@@ -182,34 +163,71 @@ Definition library_G  {cs: compspecs} prog :=
   try_spec "_malloc" malloc_spec' defs ++
   try_spec "_free" free_spec' defs.
 
-Ltac with_library prog G :=
-  let pr := eval unfold prog in prog in  
- let x := constr:(library_G pr ++ G) in
-  let x := eval cbv beta delta [app library_G] in x in
-  let x := simpl_prog_defs x in 
-  let x := eval cbv beta iota zeta delta [try_spec] in x in 
-  let x := eval simpl in x in 
-    with_library' pr x.
-
 Lemma semax_func_cons_malloc_aux:
   forall {cs: compspecs} (gv: globals) (gx : genviron) (t :type) (ret : option val),
-(EX p : val,
+(∃ p : val,
  PROP ( )
  RETURN (p)
  SEP (mem_mgr gv;
       if eq_dec p nullval
       then emp
-      else malloc_token Ews t p * data_at_ Ews t p))%assert
-  (make_ext_rval gx (rettype_of_type (tptr tvoid)) ret) |-- !! is_pointer_or_null (force_val ret).
+      else malloc_token Ews t p ∗ data_at_ Ews t p))%assert
+  (make_ext_rval gx (rettype_of_type (tptr tvoid)) ret) ⊢ ⌜is_pointer_or_null (force_val ret)⌝.
 Proof.
  intros.
- rewrite exp_unfold. Intros p.
+ monPred.unseal. Intros p.
  rewrite <- insert_local.
- rewrite lower_andp.
- apply derives_extract_prop; intro.
- destruct H; unfold_lift in H.
- unfold_lift in H0. destruct ret; try contradiction.
+ monPred.unseal.
+ apply bi.pure_elim_l; intros (? & ?).
+ super_unfold_lift.
+ destruct ret; try contradiction.
  unfold eval_id in H. Transparent peq. simpl in H. Opaque peq. subst p.
  if_tac. rewrite H; entailer!.
- renormalize. entailer!.
+ renormalize. monPred.unseal. entailer!.
 Qed.
+
+End semax.
+
+#[export] Hint Extern 1 (malloc_token _ _ _ ⊢ valid_pointer _) =>
+  (simple apply malloc_token_valid_pointer(*; data_at_valid_aux*)) : valid_pointer.
+
+(*Ltac malloc_token_data_at_valid_pointer :=
+  (* If the size of t is unknown, can still prove valid pointer
+      from (malloc_token sh t p * ... * data_at[_] sh t p)  *)
+  match goal with |- ?A ⊢ valid_pointer ?p =>
+   match A with
+   | context [malloc_token _ ?t p] =>
+         try (assert (sizeof t <= 0) by (simpl sizeof in *; rep_lia); fail 1);
+         try (assert (sizeof t > 0) by (simpl sizeof in *; rep_lia); fail 1);
+         destruct (zlt 0 (sizeof t));
+         auto with valid_pointer
+   end
+ end.
+
+#[export] Hint Extern 4 (_ ⊢ valid_pointer _) => malloc_token_data_at_valid_pointer : valid_pointer.*)
+
+#[export] Hint Resolve malloc_token_local_facts : saturate_local.
+
+Ltac change_compspecs' cs cs' ::=
+  match goal with
+  | |- context [data_at(cs := cs') ?sh ?t ?v1] => erewrite (@data_at_change_composite _ _ cs' cs _ sh t); [| apply JMeq_refl | reflexivity]
+  | |- context [field_at(cs := cs') ?sh ?t ?gfs ?v1] => erewrite (@field_at_change_composite _ _ cs' cs _ sh t gfs); [| apply JMeq_refl | reflexivity]
+  | |- context [data_at_(cs := cs') ?sh ?t] => erewrite (@data_at__change_composite _ _ cs' cs _ sh t); [| reflexivity]
+  | |- context [field_at_(cs := cs') ?sh ?t ?gfs] => erewrite (@field_at__change_composite _ _ cs' cs _ sh t gfs); [| reflexivity]
+  | |- context [malloc_token(cs := cs') ?sh ?t] => erewrite (@malloc_token_change_composite _ _ cs' cs _ sh t); [| reflexivity]
+  | |- context [?A cs'] => change (A cs') with (A cs)
+  | |- context [?A cs' ?B] => change (A cs' B) with (A cs B)
+  | |- context [?A cs' ?B ?C] => change (A cs' B C) with (A cs B C)
+  | |- context [?A cs' ?B ?C ?D] => change (A cs' B C D) with (A cs B C D)
+  | |- context [?A cs' ?B ?C ?D ?E] => change (A cs' B C D E) with (A cs B C D E)
+  | |- context [?A cs' ?B ?C ?D ?E ?F] => change (A cs' B C D E F) with (A cs B C D E F)
+ end.
+
+Ltac with_library prog G :=
+  let pr := eval unfold prog in prog in  
+ let x := constr:(library_G pr ++ G) in
+  let x := eval cbv beta delta [app library_G] in x in
+  let x := simpl_prog_defs x in 
+  let x := eval cbv beta iota zeta delta [try_spec] in x in 
+  let x := eval simpl in x in 
+    with_library' pr x.
diff --git a/floyd/linking.v b/floyd/linking.v
index c7f18cd6c5..0dd460ed6d 100644
--- a/floyd/linking.v
+++ b/floyd/linking.v
@@ -1,6 +1,7 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Import ListNotations.
-Import compcert.lib.Maps.
 
 Module PosOrder <: Orders.TotalLeBool.
   Definition t := positive.
@@ -50,8 +51,8 @@ Module SortGlobdef := Mergesort.Sort(GlobdefOrder).
 Definition isnil {A} (al: list A) := 
    match al with nil => true | _ => false end.
 
-Lemma prod_eq_dec {A B} (Ha: forall (a1 a2:A), {a1 = a2} + {a1<>a2})
-      (Hb: forall (b1 b2:B), {b1 = b2} + {b1<>b2}):
+Lemma prod_eq_dec {A B} (Ha: forall (a1 a2:A), {a1 = a2} + {a1<>a2} )
+      (Hb: forall (b1 b2:B), {b1 = b2} + {b1<>b2} ):
       forall (x y : A * B), {x=y} + {x<>y}.
 Proof. intros. destruct x as [a1 b1]. destruct y as [a2 b2].
 destruct (Ha a1 a2); [ subst | right; congruence].
@@ -230,7 +231,7 @@ Proof. intros. unfold prog_types. unfold Clightdefs.mkprogram.
 destruct (build_composite_env' c w ); trivial.
 Qed. 
 
-Module NEW_LINK_PROGS.  (* Everything in this Module should perhaps be moved to floyd/linking.v *)
+Module NEW_LINK_PROGS.
 
 (* All of this complexity is because the naturally computed proof whose type is
      build_composite_env t12 = Errors.OK e12
@@ -309,7 +310,7 @@ Ltac process_composite_definitions :=
  unfold build_composite_env; 
  unfold add_composite_definitions, composite_of_def; 
  simpl align; simpl align_attr; simpl rank_members;
- simpl PTree.set;
+ simpl Maps.PTree.set;
  repeat process_composite_definitions_step;
  reflexivity.
 
diff --git a/floyd/loadstore_field_at.v b/floyd/loadstore_field_at.v
index 1583f327ae..75f5761994 100644
--- a/floyd/loadstore_field_at.v
+++ b/floyd/loadstore_field_at.v
@@ -1,4 +1,6 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.nested_field_lemmas.
 Require Import VST.floyd.efield_lemmas.
@@ -9,7 +11,6 @@ Require Import VST.floyd.field_at.
 Require Import VST.floyd.loadstore_mapsto.
 
 Import LiftNotation.
-Local Open Scope logic.
 
 Lemma is_neutral_cast_by_value: forall t t',
   is_neutral_cast t t' = true ->
@@ -32,31 +33,59 @@ Section LOADSTORE_FIELD_AT.
 
 Context {cs: compspecs}.
 
-Lemma self_ramify_trans: forall {A} `{SepLog A} (g m l: A), (g |-- m * TT) -> (m |-- l * TT) -> g |-- l * TT.
+Lemma self_ramify_trans: forall {prop:bi} (g m l: prop), (g ⊢ m ∗ True) -> (m ⊢ l ∗ True) -> g ⊢ l ∗ True.
 Proof.
-  intros A ND SL ? ? ? ? ?.
+  intros.
+  rewrite H. rewrite H0. rewrite bi.sep_True. done.
+Qed.
+
+(* TODO weak_ramif_spec, solve, trans are the same as the one in msl/ramification_lemmas.v; delete this when that file is fixed *)
+Lemma weak_ramif_spec: forall {prop:bi} (g l g' l':prop), (g ⊢ l ∗ (l' -∗ g')) -> g ⊢ l ∗ True.
+Proof.
+  intros.
   eapply derives_trans; [exact H |].
-  eapply derives_trans; [apply sepcon_derives; [exact H0 | apply derives_refl] |].
-  rewrite sepcon_assoc.
-  apply sepcon_derives; auto.
+  apply bi.sep_mono; auto.
+Qed.
+Lemma solve: forall {prop:bi} (g l g' l' F:prop), (g ⊢ l ∗ F) -> (F ∗ l' ⊢ g') -> g ⊢ l ∗ (l' -∗ g').
+Proof.
+  intros.
+  apply derives_trans with (l ∗ F); auto.
+  apply bi.sep_mono; auto.
+  apply bi.wand_intro_r; auto.
+Qed.
+Lemma trans: forall {prop:bi} {g m l g' m' l':prop},
+  (g ⊢ m ∗ (m' -∗ g')) ->
+  (m ⊢ l ∗ (l' -∗ m')) ->
+  g ⊢ l ∗ (l' -∗ g').
+Proof.
+intros.
+apply solve with ((l' -∗ m') ∗ (m' -∗ g')).
++ eapply derives_trans; [exact H |].
+eapply derives_trans; [apply bi.sep_mono; [exact H0 | apply derives_refl] |].
+rewrite bi.sep_assoc; auto.
++ rewrite (bi.sep_comm _ l') !bi.sep_assoc.
+eapply derives_trans; [| apply modus_ponens_wand].
+apply bi.sep_mono; [| apply derives_refl].
+apply modus_ponens_wand.
 Qed.
 
 Lemma semax_load_nth_ram_field_at :
-  forall {Espec: OracleKind}{cs: compspecs} n (Delta: tycontext) sh id P Q R e1 Pre
+  forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {cs: compspecs} 
+    E n (Delta: tycontext) sh id P Q R e1 Pre
     t_id t_root gfs (p v_val: val) (v_reptype: reptype (nested_field_type t_root gfs)),
     typeof e1 = nested_field_type t_root gfs ->
     typeof_temp Delta id = Some t_id ->
     is_neutral_cast (nested_field_type t_root gfs) t_id = true ->
     type_is_volatile (nested_field_type t_root gfs) = false ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
        local (`(eq (field_address t_root gfs p)) (eval_lvalue e1)) ->
     nth_error R n = Some Pre ->
     readable_share sh ->
-    (Pre |-- field_at sh t_root gfs v_reptype p * TT) ->
+    (Pre ⊢ field_at sh t_root gfs v_reptype p ∗ True) ->
     JMeq v_reptype v_val ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
-      (tc_lvalue Delta e1) && local (`(tc_val (nested_field_type t_root gfs) v_val)) ->
-    @semax cs Espec Delta (|> PROPx P (LOCALx Q (SEPx R)))
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
+      ((tc_lvalue Delta e1) ∧ local (`(tc_val (nested_field_type t_root gfs) v_val))) ->
+    semax E Delta (▷ PROPx P (LOCALx Q (SEPx R)))
       (Sset id e1)
       (normal_ret_assert
          (PROPx P
@@ -74,28 +103,29 @@ Proof.
   1: eassumption.
   2: eassumption.
   eapply self_ramify_trans; [exact H6 |].
-  eapply RAMIF_PLAIN.weak_ramif_spec.
+  eapply weak_ramif_spec.
   apply mapsto_field_at_ramify; auto.
   eapply JMeq_sym; exact H7.
 Qed.
 
 Lemma semax_cast_load_nth_ram_field_at :
-  forall {Espec: OracleKind}{cs: compspecs} n (Delta: tycontext) sh id P Q R e1 Pre
+  forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {cs: compspecs}
+    E n (Delta: tycontext) sh id P Q R e1 Pre
     t_to t_root gfs (p v_val: val) (v_reptype: reptype (nested_field_type t_root gfs)),
     typeof e1 = nested_field_type t_root gfs ->
     type_is_by_value (nested_field_type t_root gfs) = true ->
     type_is_volatile (nested_field_type t_root gfs) = false ->
     typeof_temp Delta id = Some t_to ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
       local (`(eq (field_address t_root gfs p)) (eval_lvalue e1)) ->
     nth_error R n = Some Pre ->
      cast_pointer_to_bool (nested_field_type t_root gfs) t_to = false ->
     readable_share sh ->
-    (Pre |-- field_at sh t_root gfs v_reptype p * TT) ->
+    (Pre ⊢ field_at sh t_root gfs v_reptype p ∗ True) ->
     JMeq v_reptype v_val ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
-     (tc_lvalue Delta e1) && local (`(tc_val t_to (eval_cast (nested_field_type t_root gfs) t_to v_val))) ->
-    @semax cs Espec Delta (|> PROPx P (LOCALx Q (SEPx R)))
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
+     ((tc_lvalue Delta e1) ∧ local (`(tc_val t_to (eval_cast (nested_field_type t_root gfs) t_to v_val)))) ->
+    semax E Delta (▷ PROPx P (LOCALx Q (SEPx R)))
      (Sset id (Ecast e1 t_to))
      (normal_ret_assert
          (PROPx P
@@ -112,47 +142,39 @@ Proof.
   1: eassumption.
   2: eassumption.
   eapply self_ramify_trans; [exact H7 |].
-  eapply RAMIF_PLAIN.weak_ramif_spec.
+  eapply weak_ramif_spec.
   apply mapsto_field_at_ramify; auto.
   eapply JMeq_sym; exact H8.
 Qed.
 
-Lemma lower_andp_lifted_val:
-  forall (P Q: val->mpred) v,
-  (`(P && Q) v) = (`P v && `Q v).
-Proof. reflexivity. Qed.
-
-Lemma remove_one_LOCAL_left: forall P Q0 Q R S,
-  (PROPx P (LOCALx Q R) |-- S) -> PROPx P (LOCALx (Q0 :: Q) R) |-- S.
+Lemma remove_one_LOCAL_left: forall `{!heapGS Σ} P Q0 Q R S,
+  (PROPx(Σ:=Σ) P (LOCALx Q R) ⊢ S) -> PROPx P (LOCALx (Q0 :: Q) R) ⊢ S.
 Proof.
   intros.
   simpl in H |- *.
-  intro rho; specialize (H rho).
-  unfold PROPx, LOCALx, SEPx in *.
-  normalize.
-  autorewrite with subst norm1 norm2; normalize.
-  normalize in H.
-  autorewrite with subst norm1 norm2 in H; normalize in H; normalize.
+  rewrite -insert_local'.
+  rewrite H. apply bi.and_elim_r.
 Qed.
 
 Lemma semax_store_nth_ram_field_at:
-  forall {Espec: OracleKind} {cs: compspecs} n Delta sh P Q R e1 e2 Pre Post
+  forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {cs: compspecs}
+    E n Delta sh P Q R e1 e2 Pre Post
     t_root gfs (p v_val: val) (v_reptype: reptype (nested_field_type t_root gfs)),
     typeof e1 = nested_field_type t_root gfs ->
     type_is_by_value (nested_field_type t_root gfs) = true ->
     type_is_volatile (nested_field_type t_root gfs) = false ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
        local (`(eq (field_address t_root gfs p)) (eval_lvalue e1)) ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
        local (`(eq v_val) (eval_expr (Ecast e2 (nested_field_type t_root gfs)))) ->
     JMeq v_val v_reptype ->
     nth_error R n = Some Pre ->
     writable_share sh ->
-    (Pre |-- field_at_ sh t_root gfs p * (field_at sh t_root gfs v_reptype p -* Post)) ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
-     (tc_lvalue Delta e1) && (tc_expr Delta (Ecast e2 (nested_field_type t_root gfs))) ->
-    semax Delta
-     (|> PROPx P (LOCALx Q (SEPx R)))
+    (Pre ⊢ field_at_ sh t_root gfs p ∗ (field_at sh t_root gfs v_reptype p -∗ Post)) ->
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
+     ((tc_lvalue Delta e1) ∧ (tc_expr Delta (Ecast e2 (nested_field_type t_root gfs)))) ->
+    semax E Delta
+     (▷ PROPx P (LOCALx Q (SEPx R)))
      (Sassign e1 e2)
      (normal_ret_assert
         (PROPx P (LOCALx Q (SEPx (replace_nth n R Post))))).
@@ -165,7 +187,7 @@ Proof.
   1: eassumption.
   1: eassumption.
   2: eassumption.
-  eapply RAMIF_PLAIN.trans; [exact H7 |].
+  eapply trans; [exact H7 |].
   apply mapsto_field_at_ramify; auto.
   apply JMeq_sym; apply by_value_default_val; auto.
 Qed.
@@ -178,7 +200,8 @@ destruct t; inv H; auto.
 Qed.
 
 Lemma semax_store_nth_ram_field_at_union_hack:
-  forall {Espec: OracleKind} {cs: compspecs} n Delta sh P Q R e1 e2 Pre Post
+  forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {cs: compspecs}
+    E n Delta sh P Q R e1 e2 Pre Post
     t_root gfs gfs' ch ch' (p v_val v_val': val) (v_reptype: reptype (nested_field_type t_root gfs')),
     typeof e1 = nested_field_type t_root gfs ->
     access_mode (nested_field_type t_root gfs) = By_value ch ->
@@ -188,19 +211,19 @@ Lemma semax_store_nth_ram_field_at_union_hack:
     field_address t_root gfs p = field_address t_root gfs' p ->
     type_is_volatile (nested_field_type t_root gfs) = false ->
     type_is_volatile (nested_field_type t_root gfs') = false ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
        local (`(eq (field_address t_root gfs p)) (eval_lvalue e1)) ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
        local (`(eq v_val) (eval_expr (Ecast e2 (nested_field_type t_root gfs)))) ->
     decode_encode_val v_val ch ch' v_val' ->
     JMeq v_val' v_reptype ->
     nth_error R n = Some Pre ->
     writable_share sh ->
-    Pre |-- (field_at_ sh t_root gfs p) * (field_at sh t_root gfs' v_reptype p -* Post) ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
-     (tc_lvalue Delta e1) && (tc_expr Delta (Ecast e2 (nested_field_type t_root gfs))) ->
-    semax Delta
-     (|> PROPx P (LOCALx Q (SEPx R)))
+    (Pre ⊢ ((field_at_ sh t_root gfs p) ∗ (field_at sh t_root gfs' v_reptype p -∗ Post))) ->
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
+     ((tc_lvalue Delta e1) ∧ (tc_expr Delta (Ecast e2 (nested_field_type t_root gfs)))) ->
+    semax E Delta
+     (▷ PROPx P (LOCALx Q (SEPx R)))
      (Sassign e1 e2)
      (normal_ret_assert
         (PROPx P (LOCALx Q (SEPx (replace_nth n R Post))))).
@@ -208,27 +231,27 @@ Proof.
   intros.
   assert (H15: sizeof (nested_field_type t_root gfs) = sizeof (nested_field_type t_root gfs')). {
     clear - H0 H1 H3.
-    apply semax_straight.decode_encode_val_size in H3.
+    apply decode_encode_val_size in H3.
     unfold sizeof; erewrite !size_chunk_sizeof; eauto.
   }
   eapply semax_store_nth_ram_union_hack.
   eassumption. eassumption.  eassumption. eassumption. eassumption.
   eassumption. eassumption. eassumption. eassumption. eassumption. 2: auto.
-  eapply RAMIF_PLAIN.trans; [exact H13 |].
+  eapply trans; [exact H13 |].
   eapply derives_trans.
   apply prop_and_same_derives; apply field_at__local_facts.
-  apply derives_extract_prop; intro FC.
+  apply bi.pure_elim_l; intro FC.
   assert (FC1: field_compatible  (nested_field_type t_root gfs) nil (offset_val (nested_field_offset t_root gfs) p)).
     apply field_compatible_nested_field; auto.
   assert (FC1': field_compatible  (nested_field_type t_root gfs') nil (offset_val (nested_field_offset t_root gfs') p)).
     apply field_compatible_nested_field.
-    clear - H4 FC. unfold field_address in *. rewrite if_true in H4 by auto.
+    clear - H4 FC. unfold field_address in *. rewrite ->if_true in H4 by auto.
     if_tac in H4; auto.
     destruct FC as [? _]. destruct p; try contradiction. inv H4.
   replace  (offset_val (nested_field_offset t_root gfs) p) with (field_address t_root gfs p) in FC1
       by (unfold field_address; rewrite if_true; auto).
   replace  (offset_val (nested_field_offset t_root gfs') p) with (field_address t_root gfs' p) in FC1'.
-  2:{ clear - H4 FC. unfold field_address in *. rewrite if_true in H4 by auto.
+  2:{ clear - H4 FC. unfold field_address in *. rewrite ->if_true in H4 by auto.
        if_tac in H4; auto. destruct FC as [? _]. destruct p; try contradiction. inv H4.
    }
   rewrite <- memory_block_mapsto_; auto.
@@ -248,10 +271,6 @@ Proof.
   eapply access_mode_by_value'; eassumption.
   apply JMeq_sym; apply by_value_default_val; auto.
   eapply access_mode_by_value'; eassumption.
- apply sepcon_derives; auto.
-  apply andp_right; auto.
-  apply derives_refl.
-  apply derives_refl.
+ apply bi.sep_mono; auto.
 Qed.
-
 End LOADSTORE_FIELD_AT.
diff --git a/floyd/loadstore_mapsto.v b/floyd/loadstore_mapsto.v
index 48316c4fda..4e6528a96b 100644
--- a/floyd/loadstore_mapsto.v
+++ b/floyd/loadstore_mapsto.v
@@ -1,9 +1,10 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.mapsto_memory_block.
 Import LiftNotation.
 
-Local Open Scope logic.
 
 (***************************************
 
@@ -18,17 +19,21 @@ Load/store lemmas about mapsto:
 
 Definition semax_load_37 := @semax_load.
 
+Lemma derives_trans: forall {prop:bi} (P Q R:prop),
+  (P ⊢ Q) -> (Q ⊢ R) -> (P ⊢ R).
+Proof. intros. rewrite H H0 //. Qed.
+
 Lemma semax_load_37' :
-  forall {Espec: OracleKind}{cs: compspecs} ,
-forall (Delta: tycontext) sh id P Q R e1 t2 (v2: val),
+  forall `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} {cs: compspecs},
+forall E (Delta: tycontext) sh id P Q R e1 t2 (v2: val),
     typeof_temp Delta id = Some t2 ->
     is_neutral_cast (typeof e1) t2 = true ->
     readable_share sh ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
-          (tc_lvalue Delta e1) &&
-         local (`(tc_val (typeof e1) v2)) &&
-         (`(mapsto sh (typeof e1)) (eval_lvalue e1) `(v2) * TT) ->
-    @semax cs Espec Delta (|> PROPx P (LOCALx Q (SEPx R)))
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
+        ((tc_lvalue Delta e1) ∧
+         (local `(tc_val (typeof e1) v2)) ∧
+         (assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) `(v2)) ∗ True)) ->
+    semax E Delta (▷ PROPx P (LOCALx Q (SEPx R)))
        (Sset id e1)
        (normal_ret_assert
          (PROPx P
@@ -39,62 +44,68 @@ Proof.
   rename H1 into H_READABLE; rename H2 into H1.
   eapply semax_pre_post'; [ | | apply semax_load with sh t2; auto].
   + instantiate (1:= PROPx (tc_val (typeof e1) v2 :: P) (LOCALx Q (SEPx R))).
-    apply later_left2.
-    match goal with |- ?A |-- _ => rewrite <- (andp_dup A) end.
-    eapply derives_trans.
-    apply andp_derives; [apply derives_refl | apply H1].
-    clear H.
-    go_lowerx.
-    gather_prop.
-    apply derives_extract_prop; intro.
-    apply andp_right.
-    apply prop_right; repeat split; try eassumption.
-    apply andp_right.
-    apply andp_left2. apply andp_left1; auto.
-    apply andp_left1; auto.
-  + intros. apply andp_left2.
-    eapply derives_trans.
-    - apply andp_right.
-      * apply exp_left; intros.
-        apply andp_left2.
-        rewrite <- insert_prop.
-        autorewrite with subst.
-        apply andp_left1, derives_refl.
-      * apply exp_derives; intro old.
+    iIntros "(#? & H)"; iNext.
+    iAssert ⌜tc_val (typeof e1) v2⌝ as %?.
+    { iDestruct (H1 with "[$]") as "(_ & ? & _)"; unfold local. rewrite lift0C_prop //. }
+    iSplit.
+    { iDestruct (H1 with "[$]") as "($ & _)". }
+    iSplit; first done.
+    iDestruct "H" as "(? & ? & $)".
+    iSplit; auto; iSplit; auto.
+  + rewrite bi.and_elim_r.
+    apply (derives_trans _ (⌜tc_val (typeof e1) v2⌝ ∧
+                            (∃ old : val,
+                              local ((` eq) (eval_id id) (` v2)) ∧ 
+                              (assert_of (subst id (` old) (PROPx P (LOCALx Q (SEPx R)))))))).
+    - apply bi.and_intro.
+      * apply bi.exist_elim; intros.
+        rewrite bi.and_elim_r.
+        constructor => rho; simpl.
+        unfold subst.
         rewrite <- insert_prop.
-        autorewrite with subst.
-        apply andp_derives; [| apply andp_left2, derives_refl].
-        autorewrite with subst.
+        rewrite bi.and_elim_l.
+        rewrite monPred_at_pure.
+        rewrite -monPred_at_pure. (* this generalizes the index of bi_pure*)
         apply derives_refl.
-    - apply derives_extract_prop; intro.
-      rewrite <- exp_andp2.
+      * apply bi.exist_mono. intro old.
+        apply bi.and_mono; [done |].
+        constructor => rho; simpl.
+        unfold subst.
+        rewrite <- insert_prop.
+        rewrite bi.and_elim_r.
+        done.
+    - apply bi.pure_elim_l; intro.
+      rewrite <- bi.and_exist_l.
       rewrite <- insert_local.
-      apply andp_derives; auto.
+      apply bi.and_mono; auto.
       * simpl; unfold local, lift1; unfold_lift.
-        intros; apply prop_derives.
+        raise_rho.
+        intros; apply bi.pure_mono.
         intros; split; [congruence |].
         intro; clear H3; subst; revert H2. apply tc_val_Vundef.
-      * apply remove_localdef_temp_PROP.
+      * rewrite -remove_localdef_temp_PROP.
+        apply bi.exist_mono => ?; done.
   + eapply derives_trans; [eapply derives_trans; [| apply H1] | clear H1].
-    - apply andp_derives; auto.
+    - apply bi.and_mono; auto.
       rewrite <- insert_prop.
-      apply andp_left2; auto.
-    - apply andp_left2. auto.
+      rewrite bi.and_elim_r; auto.
+    - rewrite bi.and_elim_r. rewrite bi.and_elim_r.
+      iIntros "[H1 H2]"; iFrame.
 Qed.
 
 Definition semax_cast_load_37 := @semax_cast_load.
 
 Lemma semax_cast_load_37' :
-  forall {Espec: OracleKind}{cs: compspecs} ,
-forall (Delta: tycontext) sh id P Q R e1 t1 (v2: val),
+  forall `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} {cs: compspecs},
+forall E (Delta: tycontext) sh id P Q R e1 t1 (v2: val),
     typeof_temp Delta id = Some t1 ->
-     cast_pointer_to_bool (typeof e1) t1 = false ->
+    cast_pointer_to_bool (typeof e1) t1 = false ->
     readable_share sh ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
-          (tc_lvalue Delta e1) &&
-         local (`(tc_val t1 (eval_cast (typeof e1) t1 v2))) &&
-         (`(mapsto sh (typeof e1)) (eval_lvalue e1) `(v2) * TT) ->
-    @semax cs Espec Delta (|> PROPx P (LOCALx Q (SEPx R)))
+    (ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
+      ((tc_lvalue Delta e1) ∧
+       (local (`(tc_val t1 (eval_cast (typeof e1) t1 v2)))) ∧
+       (assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) `(v2)) ∗ True))) ->
+    semax E Delta (▷ PROPx P (LOCALx Q (SEPx R)))
        (Sset id (Ecast e1 t1))
        (normal_ret_assert
          (PROPx P
@@ -104,48 +115,51 @@ Proof.
   intros until 1. intros HCAST H_READABLE H1. pose proof I.
   eapply semax_pre_post'; [ | | apply @semax_cast_load with (sh:=sh)(v2:= v2); auto].
   + instantiate (1:= PROPx (tc_val t1 (force_val (sem_cast (typeof e1) t1 v2)) :: P) (LOCALx Q (SEPx R))).
-    apply later_left2.
-    match goal with |- ?A |-- _ => rewrite <- (andp_dup A) end.
-    eapply derives_trans.
-    apply andp_derives; [apply derives_refl | apply H1].
-    clear H1.
-    go_lowerx.
-    gather_prop.
-    apply derives_extract_prop; intro.
-    apply andp_right.
-    apply prop_right; repeat split; eassumption.
-    apply andp_right.
-    apply andp_left2. apply andp_left1; auto.
-    apply andp_left1; auto.
-  + intros. apply andp_left2.
-    eapply derives_trans.
-    - apply andp_right.
-      * apply exp_left; intros.
-        apply andp_left2.
+    iIntros "(#? & H)"; iNext.
+    iAssert ⌜tc_val t1 (force_val (sem_cast (typeof e1) t1 v2))⌝ as %?.
+    { iDestruct (H1 with "[$]") as "(_ & ? & _)"; unfold local. rewrite lift0C_prop //. }
+    rewrite assoc; iSplit.
+    { iPoseProof (H1 with "[$]") as "H"; iSplit; [iDestruct "H" as "($ & _)" | iDestruct "H" as "(_ & $ & _)"]. }
+    iDestruct "H" as "(? & ? & $)"; simpl.
+    iSplit; auto; iSplit; auto.
+  + intros. rewrite bi.and_elim_r.
+    eapply (derives_trans _ (⌜tc_val t1 (force_val (sem_cast (typeof e1) t1 v2))⌝ ∧
+                             (∃ old : val,
+                                local ((` eq) (eval_id id) (` (eval_cast (typeof e1) t1 v2))) ∧
+                                (assert_of (subst id (` old) (PROPx P (LOCALx Q (SEPx R)))))))).
+    - apply bi.and_intro.
+      * apply bi.exist_elim; intros.
+        rewrite bi.and_elim_r.
+        constructor => rho; simpl.
+        unfold subst.
         rewrite <- insert_prop.
-        autorewrite with subst.
-        apply andp_left1, derives_refl.
-      * apply exp_derives; intro old.
-        rewrite <- insert_prop.
-        autorewrite with subst.
-        apply andp_derives; [| apply andp_left2, derives_refl].
-        autorewrite with subst.
+        rewrite bi.and_elim_l.
+        rewrite monPred_at_pure.
+        rewrite -monPred_at_pure. (* this generalizes the index of bi_pure*)
         apply derives_refl.
-    - apply derives_extract_prop; intro.
-      rewrite <- exp_andp2.
+      * apply bi.exist_mono. intro old.
+        apply bi.and_mono; [done |].
+        constructor => rho; simpl.
+        unfold subst.
+        rewrite <- insert_prop.
+        rewrite bi.and_elim_r.
+        done.
+    - apply bi.pure_elim_l; intro.
+      rewrite <- bi.and_exist_l.
       rewrite <- insert_local.
-      apply andp_derives; auto.
+      apply bi.and_mono; auto.
       * simpl; unfold local, lift1; unfold_lift.
-        intros; apply prop_derives.
+        constructor => ?; simpl; apply bi.pure_mono.
         unfold force_val1 in *.
         intros; split; [congruence |].
         intro; clear H3; revert H2; rewrite H4. apply tc_val_Vundef.
       * apply remove_localdef_temp_PROP.
   + eapply derives_trans; [eapply derives_trans; [| apply H1] | clear H1].
-    - apply andp_derives; auto.
+    - apply bi.and_mono; auto.
       rewrite <- insert_prop.
-      apply andp_left2; auto.
-    - apply andp_left2. auto.
+      rewrite bi.and_elim_r; auto.
+    - rewrite bi.and_elim_r. rewrite bi.and_elim_r.
+      iIntros "[H1 H2]"; iFrame.
 Qed.
 
 (***************************************
@@ -158,18 +172,19 @@ Load/store lemmas about mapsto:
 ***************************************)
 
 Lemma semax_load_nth_ram :
-  forall {Espec: OracleKind}{cs: compspecs} n (Delta: tycontext) sh id P Q R e1 Pre t1 t2 v p,
+  forall `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} {cs: compspecs}
+    E n (Delta: tycontext) sh id P Q R e1 Pre t1 t2 v p,
     typeof e1 = t1 ->
     typeof_temp Delta id = Some t2 ->
     is_neutral_cast (typeof e1) t2 = true ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
        local (`(eq p) (eval_lvalue e1)) ->
     nth_error R n = Some Pre ->
     readable_share sh ->
-    (Pre |-- mapsto sh t1 p v * TT) ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
-      (tc_lvalue Delta e1) && local (`(tc_val t1 v)) ->
-    @semax cs Espec Delta (|> PROPx P (LOCALx Q (SEPx R)))
+    (Pre ⊢ mapsto sh t1 p v ∗ True) ->
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
+      ((tc_lvalue Delta e1) ∧ local (`(tc_val t1 v))) ->
+    semax E Delta (▷ PROPx P (LOCALx Q (SEPx R)))
       (Sset id e1)
       (normal_ret_assert
          (PROPx P
@@ -178,34 +193,37 @@ Lemma semax_load_nth_ram :
 Proof.
   intros.
   subst; eapply semax_load_37'; eauto.
-  apply andp_right; auto.
+  rewrite bi.and_assoc.
+  apply bi.and_intro; auto.
   rewrite (add_andp _ _ H2).
-  rewrite andp_comm. rewrite <- andp_assoc.
+  rewrite bi.and_comm. rewrite bi.and_assoc.
   erewrite SEP_nth_isolate, <- insert_SEP by eauto.
   rewrite <- local_lift2_and.
   rewrite <- local_sepcon_assoc1.
-  eapply derives_trans.
-  + apply sepcon_derives; [| apply derives_refl].
-    instantiate (1 := `(mapsto sh (typeof e1)) (eval_lvalue e1) `(v) * `TT).
-    unfold local, lift1; unfold_lift; intro rho; simpl.
+  set (PROPx P (LOCALx Q (SEPx (replace_nth n R emp)))) as PQR.
+  apply (derives_trans _ ((assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (` v)) ∗ True)
+                          ∗ PQR)).
+  + apply bi.sep_mono; [| apply derives_refl].
+    unfold local; super_unfold_lift; raise_rho.
     normalize.
-  + rewrite sepcon_assoc.
-    apply sepcon_derives; auto.
+  + rewrite -bi.sep_assoc.
+    apply bi.sep_mono; auto.
 Qed.
 
 Lemma semax_cast_load_nth_ram :
-  forall {Espec: OracleKind}{cs: compspecs} n (Delta: tycontext) sh id P Q R e1 Pre t1 t2 v p,
+  forall `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} {cs: compspecs}
+    E n (Delta: tycontext) sh id P Q R e1 Pre t1 t2 v p,
     typeof e1 = t1 ->
     typeof_temp Delta id = Some t2 ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
       local (`(eq p) (eval_lvalue e1)) ->
     nth_error R n = Some Pre ->
     cast_pointer_to_bool t1 t2 = false ->
     readable_share sh ->
-    (Pre |-- mapsto sh t1 p v * TT) ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
-     (tc_lvalue Delta e1) && local (`(tc_val t2 (eval_cast t1 t2 v))) ->
-    @semax cs Espec Delta (|> PROPx P (LOCALx Q (SEPx R)))
+    (Pre ⊢ mapsto sh t1 p v ∗ True) ->
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
+     ((tc_lvalue Delta e1) ∧ local (`(tc_val t2 (eval_cast t1 t2 v)))) ->
+    semax E Delta (▷ PROPx P (LOCALx Q (SEPx R)))
      (Sset id (Ecast e1 t2))
      (normal_ret_assert
          (PROPx P
@@ -214,68 +232,64 @@ Lemma semax_cast_load_nth_ram :
 Proof.
   intros.
   subst; eapply semax_cast_load_37'; eauto.
-  apply andp_right; auto.
+  rewrite bi.and_assoc.
+  apply bi.and_intro; auto.
   rewrite (add_andp _ _ H1).
-  rewrite andp_comm. rewrite <- andp_assoc.
+  rewrite bi.and_comm. rewrite bi.and_assoc.
   erewrite SEP_nth_isolate, <- insert_SEP by eauto.
   rewrite <- local_lift2_and.
   rewrite <- local_sepcon_assoc1.
-  eapply derives_trans.
-  + apply sepcon_derives; [| apply derives_refl].
-    instantiate (1 := `(mapsto sh (typeof e1)) (eval_lvalue e1) `(v) * `TT).
-    unfold local, lift1; unfold_lift; intro rho; simpl.
+  apply (derives_trans _ ((assert_of (`( mapsto sh (typeof e1)) (eval_lvalue e1) `( v)) ∗ True) ∗
+                          PROPx P (LOCALx Q (SEPx (replace_nth n R emp))))).
+  + apply bi.sep_mono; [| apply derives_refl].
+    unfold local, lift1; unfold_lift; raise_rho; simpl.
     normalize.
-  + rewrite sepcon_assoc.
-    apply sepcon_derives; auto.
+  + rewrite -bi.sep_assoc.
+    apply bi.sep_mono; auto.
 Qed.
 
 Lemma semax_store_nth_ram:
-  forall {Espec: OracleKind} {cs: compspecs} n Delta P Q R e1 e2 Pre Post p v sh t1,
+  forall `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} {cs: compspecs}
+    E n Delta P Q R e1 e2 Pre Post p v sh t1,
     typeof e1 = t1 ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
        local (`(eq p) (eval_lvalue e1)) ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
        local (`(eq v) (eval_expr (Ecast e2 t1))) ->
     nth_error R n = Some Pre ->
     writable_share sh ->
-    (Pre |-- mapsto_ sh t1 p * (mapsto sh t1 p v -* Post)) ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
-     (tc_lvalue Delta e1) && (tc_expr Delta (Ecast e2 t1)) ->
-    semax Delta
-     (|> PROPx P (LOCALx Q (SEPx R)))
+    (Pre ⊢ mapsto_ sh t1 p ∗ (mapsto sh t1 p v -∗ Post)) ->
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
+     ((tc_lvalue Delta e1) ∧ (tc_expr Delta (Ecast e2 t1))) ->
+    semax E Delta
+     (▷ PROPx P (LOCALx Q (SEPx R)))
      (Sassign e1 e2)
      (normal_ret_assert
         (PROPx P (LOCALx Q (SEPx (replace_nth n R Post))))).
 Proof.
   intros.
   eapply semax_pre_simple; [| eapply semax_post'; [| apply semax_store; eauto]].
-  + apply later_left2.
-    apply andp_right;  [subst; auto |].
-    simpl lifted.
-    change  (@LiftNatDed environ mpred Nveric)
-      with (@LiftNatDed' mpred Nveric).
-    rewrite (add_andp _ _ H0).
-    rewrite (add_andp _ _ H1).
+  + iIntros "(#? & H)"; iNext.
+    iSplit; first by subst; iApply H5; auto.
+    iDestruct (H0 with "[$]") as "#?".
+    iDestruct (H1 with "[$]") as "#?".
     erewrite SEP_nth_isolate, <- insert_SEP by eauto.
-    rewrite !(andp_comm _ (local _)).
-    rewrite <- (andp_dup (local (`(eq p) (eval_lvalue e1)))), andp_assoc.
-    do 3 rewrite <- local_sepcon_assoc2.  rewrite <- local_sepcon_assoc1.
-    eapply derives_trans.
-    - apply sepcon_derives; [| apply derives_refl].
-      instantiate (1 := `(mapsto_ sh (typeof e1)) (eval_lvalue e1) * `(mapsto sh t1 p v -* Post)).
-      unfold local, lift1; unfold_lift; intro rho; simpl.
-      subst t1.
-      normalize.
-    - rewrite sepcon_assoc.
-      apply derives_refl.
-  + rewrite <- sepcon_assoc.
-    rewrite !local_sepcon_assoc2, <- !local_sepcon_assoc1.
+    instantiate (1 := (assert_of (`(bi_wand (mapsto sh t1 p v) Post))) ∗
+                            ((local ((` (eq p)) (eval_lvalue e1))) ∧
+                             (local ((` (eq v)) (eval_expr (Ecast e2 t1))) ∧
+                             (local (tc_environ Delta)) ∧ 
+                             PROPx P (LOCALx Q (SEPx (replace_nth n R emp)))))).
+    rewrite H4.
+    iStopProof; split => rho; monPred.unseal; unfold_lift; rewrite monPred_at_intuitionistically /=.
+    iIntros "(#(? & -> & ?) & (? & $) & $)"; subst; auto with iFrame.
+  + rewrite bi.sep_assoc.
+    rewrite ->!local_sepcon_assoc2, <- !local_sepcon_assoc1.
     erewrite SEP_replace_nth_isolate with (Rn' := Post), <- insert_SEP by eauto.
-    apply sepcon_derives; auto.
+    apply bi.sep_mono; auto.
     change (`force_val (`(sem_cast (typeof e2) (typeof e1)) (eval_expr e2)))
       with (eval_expr (Ecast e2 (typeof e1))).
     Opaque eval_lvalue eval_expr.
-    unfold local, lift1; unfold_lift; intro rho; simpl.
+    unfold local, lift1; unfold_lift; raise_rho; simpl.
     normalize.
     Transparent eval_lvalue eval_expr.
     subst t1.
@@ -283,11 +297,12 @@ Proof.
 Qed.
 
 Lemma semax_store_nth_ram_union_hack:
-  forall {Espec: OracleKind} {cs: compspecs} n Delta P Q R e1 e2 Pre Post p v v' ch ch' sh t1 t2,
+  forall `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} {cs: compspecs}
+    E n Delta P Q R e1 e2 Pre Post p v v' ch ch' sh t1 t2,
     typeof e1 = t1 ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
        local (`(eq p) (eval_lvalue e1)) ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
        local (`(eq v) (eval_expr (Ecast e2 t1))) ->
     nth_error R n = Some Pre ->
     writable_share sh ->
@@ -296,59 +311,48 @@ Lemma semax_store_nth_ram_union_hack:
     access_mode t1 = By_value ch ->
     access_mode t2 = By_value ch' ->
     decode_encode_val v ch ch' v' ->
-    Pre |-- (mapsto_ sh t1 p && mapsto_ sh t2 p) * (mapsto sh t2 p v' -* Post) ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
-     (tc_lvalue Delta e1) && (tc_expr Delta (Ecast e2 t1)) ->
-    semax Delta
-     (|> PROPx P (LOCALx Q (SEPx R)))
+    (Pre ⊢ ((mapsto_ sh t1 p ∧ mapsto_ sh t2 p) ∗ (mapsto sh t2 p v' -∗ Post))) ->
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
+     ((tc_lvalue Delta e1) ∧ (tc_expr Delta (Ecast e2 t1))) ->
+    semax E Delta
+     (▷ PROPx P (LOCALx Q (SEPx R)))
      (Sassign e1 e2)
      (normal_ret_assert
         (PROPx P (LOCALx Q (SEPx (replace_nth n R Post))))).
 Proof.
   intros * ? ? ? ? ? NT OK; intros.
   eapply semax_pre_simple; [| eapply semax_post'; [| apply semax_store_union_hack; subst; eauto]].
-  + apply later_left2.
-    apply andp_right;  [subst; auto |].
-    simpl lifted.
-    change  (@LiftNatDed environ mpred Nveric)
-      with (@LiftNatDed' mpred Nveric).
-    rewrite (add_andp _ _ H0).
-    rewrite (add_andp _ _ H1).
+  + iIntros "(#? & H)"; iNext.
+    iSplit; first by subst; iApply H8; auto.
+    iDestruct (H0 with "[$]") as "#?".
+    iDestruct (H1 with "[$]") as "#?".
     erewrite SEP_nth_isolate, <- insert_SEP by eauto.
-    rewrite !(andp_comm _ (local _)).
-    rewrite <- (andp_dup (local (`(eq p) (eval_lvalue e1)))), andp_assoc.
-    do 3 rewrite <- local_sepcon_assoc2.  rewrite <- local_sepcon_assoc1.
-    eapply derives_trans.
-    - apply sepcon_derives; [| apply derives_refl].
-      instantiate (1 := (`(mapsto_ sh (typeof e1)) (eval_lvalue e1) && 
-                                 `(mapsto_ sh t2) (eval_lvalue e1)) * `(mapsto sh t2 p v' -* Post)).
-      unfold local, lift1; unfold_lift; intro rho; simpl.
-      subst t1.
-      normalize.
-    - rewrite sepcon_assoc.
-      apply derives_refl.
+    instantiate (1 := (assert_of (`(bi_wand (mapsto sh t2 p v') Post))) ∗
+                            ((local ((` (eq p)) (eval_lvalue e1))) ∧
+                             (local ((` (eq v)) (eval_expr (Ecast e2 t1))) ∧
+                             (local (tc_environ Delta)) ∧ 
+                             PROPx P (LOCALx Q (SEPx (replace_nth n R emp)))))).
+    rewrite H7.
+    iStopProof; split => rho; monPred.unseal; unfold_lift; rewrite monPred_at_intuitionistically /=.
+    iIntros "(#(? & -> & ?) & (? & $) & $)"; subst; auto with iFrame.
   +
-     rewrite (@exp_andp2 _ _).
-     apply exp_left; intro v''.
-     rewrite <- andp_assoc. rewrite (andp_comm (local _)).
-    rewrite andp_assoc.
-    intro rho.
-    unfold local at 1. unfold lift1 at 1. simpl.
-    apply derives_extract_prop.
-   intro. unfold_lift in H9.
+    rewrite (@bi.and_exist_l _ _).
+    apply bi.exist_elim; intro v''.
+    rewrite bi.and_assoc. rewrite (bi.and_comm (local _)).
+    rewrite -bi.and_assoc.
     erewrite SEP_replace_nth_isolate with (Rn' := Post), <- insert_SEP by eauto.
-   set (PQ := (PROPx P _)). clearbody PQ.
+    set (PQ := (PROPx P _)). clearbody PQ.
     change (`(force_val1 (sem_cast (typeof e2) t1)) (eval_expr e2))
-      with (eval_expr (Ecast e2 t1)).
+    with (eval_expr (Ecast e2 t1)).
     Opaque eval_lvalue eval_expr.
     unfold local, lift1; unfold_lift; simpl.
+    go_lowerx.
     normalize.
     Transparent eval_lvalue eval_expr.
-     subst t1.
-    assert (v''=v'). eapply semax_straight.decode_encode_val_fun; eauto.
-    subst v''.    
-    rewrite <- sepcon_assoc.
-    apply sepcon_derives; auto.
+    subst t1.
+    assert (v''=v'). eapply juicy_mem_lemmas.decode_encode_val_fun; eauto.
+    subst v''.
+    rewrite bi.sep_assoc.
+    apply bi.sep_mono; auto.
     apply modus_ponens_wand.
 Qed.
-
diff --git a/floyd/local2ptree_denote.v b/floyd/local2ptree_denote.v
index 622386f69d..560990be60 100644
--- a/floyd/local2ptree_denote.v
+++ b/floyd/local2ptree_denote.v
@@ -1,9 +1,11 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
-Import compcert.lib.Maps.
+Import -(notations) compcert.lib.Maps.
 
 Import LiftNotation.
-Local Open Scope logic.
+Require Import iris.proofmode.monpred.
 
 Definition pTree_from_elements {A} (el: list (positive * A)) : PTree.t A :=
  fold_right (fun ia t => PTree.set (fst ia) (snd ia) t) (PTree.empty _) el.
@@ -16,11 +18,11 @@ Definition local2ptree1 (Q: localdef)
    (f:  PTree.t val -> PTree.t (type * val) -> list Prop -> option globals -> local_trees)
    : local_trees :=
 match Q with
-| temp i v =>   match T1 ! i with
+| temp i v =>   match T1 !! i with
                 | None => f (PTree.set i v T1) T2 P' Q'
                 | Some v' => f T1 T2 ((v=v')::P')  Q'
                 end
-| lvar i t v => match T2 ! i with
+| lvar i t v => match T2 !! i with
                 | None => f T1 (PTree.set i (t, v) T2) P' Q'
                 | Some (t', vl) => f T1 T2 ((vl=v)::(t'=t)::P') Q'
                 end
@@ -115,7 +117,7 @@ Proof.
     inversion H.
     subst.
     left; auto.
-  + rewrite PTree.gso in H by auto.
+  + rewrite PTree.gso // in H.
     right.
     apply PTree.elements_correct.
     auto.
@@ -128,7 +130,7 @@ Proof.
  unfold LocalD; intros.
  forget (PTree.fold (fun Q i tv => match tv with (t, v) => lvar i t v end :: Q) T2
           match Q with Some gv => (gvars gv) :: nil | None => nil end) as Q'.
- rewrite !PTree.fold_spec, <- !fold_left_rev_right.
+ rewrite !PTree.fold_spec  -!fold_left_rev_right.
  apply PTree.elements_correct in H.
  rewrite in_rev in H.
  forget (rev (PTree.elements T1)) as L.
@@ -143,7 +145,7 @@ Lemma LocalD_sound_local:
    In (lvar i t v) (LocalD T1 T2 Q).
 Proof.
  unfold LocalD; intros.
- rewrite !PTree.fold_spec, <- !fold_left_rev_right.
+ rewrite !PTree.fold_spec -!fold_left_rev_right.
  apply PTree.elements_correct in H.
  rewrite in_rev in H.
  forget (rev (PTree.elements T1)) as L.
@@ -164,7 +166,7 @@ Lemma LocalD_sound_gvars:
 Proof.
  unfold LocalD; intros.
  subst Q.
- rewrite !PTree.fold_spec, <- !fold_left_rev_right.
+ rewrite !PTree.fold_spec -!fold_left_rev_right.
  forget (rev (PTree.elements T1)) as L.
  induction L; [ | right; apply IHL].
  forget (rev (PTree.elements T2)) as L.
@@ -200,7 +202,7 @@ Lemma LocalD_complete : forall q T1 T2 Q,
 Proof.
   intros.
   unfold LocalD in H.
-  rewrite !PTree.fold_spec, <- !fold_left_rev_right in H.
+  rewrite !PTree.fold_spec -!fold_left_rev_right in H.
   remember (rev (PTree.elements T1)) as L.
   simpl in H.
   change L with (nil ++ L) in HeqL.
@@ -218,7 +220,7 @@ Proof.
       destruct H; [| tauto].
       subst; eexists; eauto.
     - assert (In a (PTree.elements T2)).
-      { rewrite in_rev, <- HeqL. rewrite in_app. right; left; auto. }
+      { rewrite in_rev -HeqL. rewrite in_app. right; left; auto. }
       destruct a as [i [t v]].
       apply PTree.elements_complete in H0.
       destruct H; try subst q; eauto 50.
@@ -227,7 +229,7 @@ Proof.
   + destruct H.
     - subst q.
       assert (In a (PTree.elements T1)).
-      { rewrite in_rev, <- HeqL. rewrite in_app. right; left; auto. }
+      { rewrite in_rev -HeqL. rewrite in_app. right; left; auto. }
       destruct a as [i v]; apply PTree.elements_complete in H; eauto.
     - destruct a as [i v].
       specialize (IHL H (K ++ (i,v)::nil)).
@@ -272,15 +274,15 @@ Proof.
         rewrite PTree.gss in H.
         inversion H; subst.
         left; reflexivity.
-      * rewrite PTree.gso in H by auto.
+      * rewrite PTree.gso // in H.
         right.
         apply LocalD_sound_temp.
-        rewrite PTree.gro by auto. auto.
+        rewrite PTree.gro //.
     - right.
       destruct H.
       * destruct H as [j [t [v1 [? ?]]]]; subst Q0.
         unfold LocalD.
-        rewrite !PTree.fold_spec, <- !fold_left_rev_right.
+        rewrite !PTree.fold_spec -!fold_left_rev_right.
         induction (rev (PTree.elements (PTree.remove i T1))); simpl.
        ++ apply PTree.elements_correct in H. rewrite in_rev in H.
           induction  (rev (PTree.elements T2)).
@@ -290,7 +292,7 @@ Proof.
            ** simpl. destruct a as [? ?]; simpl; repeat right; auto.
        ++ right; apply IHl.
       * unfold LocalD.
-        rewrite !PTree.fold_spec, <- !fold_left_rev_right.
+        rewrite !PTree.fold_spec -!fold_left_rev_right.
         destruct H as [gv [? ?]]; subst Q Q0.
         induction (rev (PTree.elements (PTree.remove i T1))); simpl.
        ++ induction (rev (PTree.elements T2)); simpl; auto.
@@ -299,7 +301,8 @@ Proof.
     - subst.
       apply LocalD_sound_temp. apply PTree.gss.
     - unfold LocalD in *.
-      rewrite !PTree.fold_spec, <- !fold_left_rev_right in *.
+      rewrite !PTree.fold_spec -!fold_left_rev_right.
+      rewrite !PTree.fold_spec -!fold_left_rev_right in H.
       forget  (fold_right (fun (y : positive * (type * val)) (x : list localdef) => (let (t, v0) := snd y in lvar (fst y) t v0) :: x)
         match Q with
         | Some gv => gvars gv :: nil
@@ -314,7 +317,7 @@ Proof.
         clear - H0.
         destruct (ident_eq i j); subst.
        ++ rewrite PTree.grs in H0; inv H0.
-       ++ rewrite PTree.gro in H0 by auto. rewrite PTree.gso; auto.
+       ++ rewrite PTree.gro // in H0. rewrite PTree.gso; auto.
       * right; auto.
 Qed.
 
@@ -336,7 +339,7 @@ Proof.
 *
  right; left. exists x,x0,x1. split; auto.
  destruct (ident_eq i x). subst. rewrite PTree.grs in H; inv H.
- rewrite PTree.gro in H by auto; rewrite PTree.gso by auto; auto.
+ rewrite PTree.gro // in H; rewrite PTree.gso //.
 *
  repeat right. exists x; split; auto.
 Qed.
@@ -359,11 +362,11 @@ Proof.
     -
       destruct (ident_eq i x).
       * subst x;   rewrite PTree.gss in H; inv H. simpl. auto.
-      * rewrite PTree.gso in H by auto.
+      * rewrite PTree.gso // in H.
          destruct vd; simpl;
         repeat right; apply LocalD_sound;
         right; left;
-        exists x,x0,x1; rewrite PTree.gro by auto; auto.
+        exists x,x0,x1; rewrite PTree.gro //.
     - right.
       apply LocalD_sound_gvars. auto.
  +
@@ -408,28 +411,44 @@ Proof.
     * inv H.
 Qed.
 
+Lemma raise_and:
+forall `{heapGS Σ} (A B : assert),
+    assert_of (fun rho: environ => A rho ∧ B rho) = (A ∧ B).
+Proof.
+intros. apply assert_ext; intros; monPred.unseal. done.
+Qed.
+
+Lemma local_assert:
+forall `{heapGS Σ} (P Q : assert),
+  P ⊣⊢ Q <-> forall rho, (P rho ⊣⊢ Q rho).
+Proof.
+  intros. split; intros HPQ; intros.
+  - rewrite HPQ //.
+  - constructor; auto.
+Qed.
+
+Section LOCAL2PTREE_DENOTE.
+
+Context  `{heapGS0: heapGS Σ}.
+
 Lemma LOCALx_shuffle_derives': forall P Q Q' R,
   (forall Q0, In Q0 Q' -> In Q0 Q) ->
-  PROPx P (LOCALx Q R) |-- PROPx P (LOCALx Q' R).
+  PROPx P (LOCALx Q R) ⊢ PROPx P (LOCALx Q' R).
 Proof.
   intros.
   induction Q'.
-  {
-    unfold PROPx, LOCALx.
+  { go_lowerx.
     normalize.
-    apply andp_left2; auto.
   }
   pose proof (H a (or_introl _ eq_refl)).
   rewrite <- insert_local'.
-  apply andp_right.
+  apply bi.and_intro.
   + clear -H0.
     induction Q; [inversion H0 |].
     rewrite <- insert_local'.
     simpl in H0; inversion H0.
-    - subst.
-      apply andp_left1.
-      apply derives_refl.
-    - apply andp_left2.
+    - subst. solve_andp.
+    - rewrite bi.and_elim_r.
       apply IHQ, H.
   + apply IHQ'.
     intros.
@@ -441,15 +460,29 @@ Qed.
 
 Lemma LOCALx_shuffle_derives: forall P Q Q' R,
   (forall Q0, In Q0 Q' -> In Q0 Q) ->
-  PROPx P (LOCALx Q (SEPx R)) |-- PROPx P (LOCALx Q' (SEPx R)).
+  PROPx P (LOCALx Q (SEPx R)) ⊢ PROPx P (LOCALx Q' (SEPx R)).
 Proof. intros. apply LOCALx_shuffle_derives'. auto. Qed.
 
+Lemma foldr_Forall' : forall Q rho, foldr (` and) (` True%type) (map locald_denote Q) rho ↔
+  Forall (fun P => P rho) (map locald_denote Q).
+Proof.
+  induction Q; simpl; intros; unfold_lift.
+  - split; [constructor | auto].
+  - rewrite IHQ; split.
+    + intros (? & ?); constructor; auto.
+    + inversion 1; auto.
+Qed.
+
 Lemma LOCALx_shuffle': forall P Q Q' R,
   (forall Q0, In Q0 Q' <-> In Q0 Q) ->
   PROPx P (LOCALx Q R) = PROPx P (LOCALx Q' R).
 Proof.
   intros.
-  apply pred_ext; apply LOCALx_shuffle_derives'; intros; apply H; auto.
+  f_equal.
+  unfold LOCALx; f_equal; f_equal.
+  extensionality; apply prop_ext.
+  rewrite !foldr_Forall' !Forall_forall.
+  setoid_rewrite in_map_iff. setoid_rewrite H. done.
 Qed.
 
 Lemma LOCALx_shuffle: forall P Q Q' R,
@@ -457,11 +490,11 @@ Lemma LOCALx_shuffle: forall P Q Q' R,
   PROPx P (LOCALx Q (SEPx R)) = PROPx P (LOCALx Q' (SEPx R)).
 Proof.
   intros.
-  apply pred_ext; apply LOCALx_shuffle_derives; intros; apply H; auto.
+  apply LOCALx_shuffle'; done.
 Qed.
 
 Lemma LocalD_remove_empty_from_PTree1: forall i T1 T2 Q Q0,
-  T1 ! i = None ->
+  T1 !! i = None ->
   (In Q0 (LocalD (PTree.remove i T1) T2 Q) <-> In Q0 (LocalD T1 T2 Q)).
 Proof.
   intros until Q0; intro G; split; intros;
@@ -484,7 +517,7 @@ Proof.
 Qed.
 
 Lemma LocalD_remove_empty_from_PTree2: forall i T1 T2 Q Q0,
-  T2 ! i = None ->
+  T2 !! i = None ->
   (In Q0 (LocalD T1 (PTree.remove i T2) Q) <-> In Q0 (LocalD T1 T2 Q)).
 Proof.
   intros until Q0; intro G; split; intros;
@@ -498,28 +531,38 @@ Proof.
    try solve [repeat right; auto];
      try (destruct (ident_eq i x);
            [try congruence; subst x; rewrite PTree.grs in H; inv H
-           | try rewrite PTree.gro in H by auto]).
+           | try rewrite PTree.gro // in H]).
   - do 1 right; left; repeat eexists; eauto.
   - do 2 right; repeat eexists; eauto.
-  - do 1 right; left; repeat eexists; rewrite PTree.gro by auto; eauto.
-  - do 2 right; repeat eexists; rewrite PTree.gro by auto; eauto.
+  - do 1 right; left; repeat eexists; rewrite PTree.gro //.
+  - do 2 right; repeat eexists; rewrite PTree.gro //.
 Qed.
 
 Lemma nth_error_local':
   forall n P Q R (Qn: localdef),
     nth_error Q n = Some Qn ->
-    PROPx P (LOCALx Q R) |-- local (locald_denote Qn).
+    PROPx P (LOCALx Q R) ⊢ local (locald_denote Qn).
 Proof.
 intros.
-apply andp_left2. apply andp_left1.
-go_lowerx. normalize.
+unfold PROPx. rewrite bi.and_elim_r. unfold LOCALx. rewrite bi.and_elim_l.
+
+(* the slightly modified go_lowerx tactic *)
+unfold PROPx, LOCALx, SEPx, local, lift1; unfold_lift; split => rho.
+simpl.  
+repeat rewrite -bi.and_assoc;
+repeat ((simple apply go_lower_lem1 || apply bi.pure_elim_l || apply bi.pure_elim_r); intro);
+try apply bi.pure_elim';
+repeat rewrite -> prop_true_andp by assumption;
+try apply entails_refl.
+
+intros. iPureIntro. intros.
 revert Q H H0; induction n; destruct Q; intros; inv H.
 destruct H0; auto.
 destruct H0. apply (IHn Q); auto.
 Qed.
 
 Lemma in_local': forall Q0 P Q R, In Q0 Q ->
-   PROPx P (LOCALx Q R) |-- local (locald_denote Q0).
+   PROPx P (LOCALx Q R) ⊢ local (locald_denote Q0).
 Proof.
   intros.
   destruct (in_nth_error _ _ H) as [?n ?H].
@@ -528,17 +571,16 @@ Proof.
 Qed.
 
 Lemma local2ptree_sound_aux: forall P Q R Q0 Q1 Q2,
-  Q1 && local (locald_denote Q0) = Q2 && local (locald_denote Q0) ->
+  Q1 ∧ local (locald_denote Q0) ⊣⊢ Q2 ∧ local (locald_denote Q0) ->
   In Q0 Q ->
-  Q1 && PROPx P (LOCALx Q R) = Q2 && PROPx P (LOCALx Q R).
+  Q1 ∧ PROPx P (LOCALx Q R) ⊣⊢ Q2 ∧ PROPx P (LOCALx Q R).
 Proof.
   intros.
   pose proof in_local' _ P _ R H0.
   rewrite (add_andp _ _ H1).
-  rewrite (andp_comm _ (local (locald_denote Q0))).
-  rewrite <- !andp_assoc.
-  f_equal.
-  exact H.
+  rewrite (bi.and_comm _ (local (locald_denote Q0))).
+  rewrite !bi.and_assoc.
+  rewrite H. reflexivity.
 Qed.
 
 Lemma LOCALx_expand_vardesc': forall P R i vd T1 T2 Q,
@@ -561,71 +603,67 @@ Qed.
 
 Lemma local_equal_lemma :
  forall i t v t' v',
-  local (locald_denote (lvar i t v)) && local (locald_denote (lvar i t' v')) =
-  !!(v' = v) && !!(t'=t) && local (locald_denote (lvar i t' v')).
+  (local(Σ:=Σ) (locald_denote (lvar i t v)) ∧ local (locald_denote (lvar i t' v'))) =
+  (⌜(v' = v)⌝ ∧ ⌜(t'=t)⌝ ∧ local (locald_denote (lvar i t' v'))).
 Proof.
-intros; extensionality rho.
+intros. raise_rho.
 unfold local, lift1; simpl.
-normalize. f_equal. apply prop_ext.
-unfold lvar_denote.
-split; intros [? ?].
-hnf in H,H0.
-destruct (Map.get (ve_of rho) i) as [[? ?] | ] eqn:H8; try contradiction.
-destruct H, H0; subst.
-repeat split; auto.
-destruct (Map.get (ve_of rho) i) as [[? ?] | ] eqn:H8; try contradiction.
-destruct H0 as [[? ?] ?]; subst. subst. repeat split; auto.
-destruct H0; contradiction.
+apply assert_ext; intros; monPred.unseal; normalize.
+f_equal; apply prop_ext; split.
+- intros (? & ?).
+  unfold lvar_denote in *.
+  destruct (Map.get (ve_of rho) i) as [[? ?] | ] eqn:H8; try contradiction.
+  destruct H, H0; subst; auto.
+- intros (-> & -> & ?); auto.
 Qed.
 
 Lemma gvars_equal_lemma :
   forall g g0,
-  local (locald_denote (gvars g)) && local (locald_denote (gvars g0)) = !! (g0 = g) && local (locald_denote (gvars g0)).
+  (local(Σ:=Σ) (locald_denote (gvars g)) ∧ local (locald_denote (gvars g0))) = (⌜g0 = g⌝ ∧ local (locald_denote (gvars g0))).
 Proof.
-intros; extensionality rho.
+intros. raise_rho.
 unfold local, lift1; simpl.
-normalize. f_equal. apply prop_ext.
-unfold gvars_denote.
-split; intros [? ?].
-+
-subst; split; auto.
-+
-subst; split; auto.
+apply assert_ext; intros; monPred.unseal.
+rewrite -!pure_and; f_equal; apply prop_ext; intuition.
+- unfold gvars_denote in *; subst; auto.
+- subst; auto.
 Qed.
 
 Lemma insert_locals:
   forall P A B C,
-  local (fold_right `(and) `(True) (map locald_denote A)) && PROPx P (LOCALx B C) =
+  (local (fold_right `(and) `((True:Prop)) (map locald_denote A)) ∧ PROPx P (LOCALx B C)) =
   PROPx P (LOCALx (A++B) C).
 Proof.
 intros.
 induction A.
-extensionality rho; simpl. unfold local, lift1. rewrite prop_true_andp by auto.
-auto.
+apply assert_ext; intros; monPred.unseal; simpl. rewrite prop_true_andp //.
 simpl app. rewrite <- (insert_local' a).
 rewrite <- IHA.
-rewrite <- andp_assoc.
-f_equal.
-extensionality rho; simpl; unfold_lift; unfold local, lift1; simpl.
+rewrite assert_lemmas.and_assoc'.
+simpl.
+apply assert_ext; intros; unfold PROPx; monPred.unseal; unfold_lift; unfold lift1.
 normalize.
 Qed.
 
 Lemma LOCALx_app_swap:
-  forall A B, LOCALx (A++B) = LOCALx (B++A).
+  forall A B R, LOCALx (A++B) R = LOCALx (B++A) R.
 Proof.
 intros.
-extensionality R rho; unfold LOCALx.
-simpl andp. cbv beta. f_equal.
-rewrite !map_app.
-simpl map. unfold local,lift1. f_equal.
-rewrite !fold_right_and_app.
-apply prop_ext; intuition.
+unfold LOCALx.
+rewrite !map_app !fold_right_local_app.
+rewrite (and_comm' (local _)) //.
+Qed.
+
+Lemma and_mono_iff:
+  forall {prop:bi} (P P' Q Q': prop), (P ⊣⊢ Q) → (P' ⊣⊢ Q') → (P ∧ P') ⊣⊢ (Q ∧ Q').
+Proof.
+  intros; by apply bi.and_proper.
 Qed.
 
 Lemma local2ptree_soundness' : forall P Q R T1a T2a Pa Qa T1 T2 P' Q',
   local2ptree_aux Q T1a T2a Pa Qa = (T1, T2, P', Q') ->
   PROPx (Pa++P) (LOCALx (Q ++ LocalD T1a T2a Qa) R)
-   = PROPx (P' ++ P) (LOCALx (LocalD T1 T2 Q') R).
+    ⊣⊢ PROPx (P' ++ P) (LOCALx (LocalD T1 T2 Q') R).
 Proof.
   intros until R.
   induction Q; intros.
@@ -633,18 +671,18 @@ Proof.
   simpl in H.
   destruct a; simpl in H.
 +
-    destruct (T1a ! i) eqn:H8; inv H;
+    destruct (T1a !! i) eqn:H8; inv H;
     rewrite <- (IHQ _ _ _ _ _ _ _ _ H1); clear H1 IHQ.
     simpl app. rewrite <- insert_prop.
     rewrite <- insert_local'.
     apply local2ptree_sound_aux with (Q0 := temp i v0).
-    extensionality rho. unfold locald_denote; simpl.
-    unfold local, lift1; unfold_lift; simpl. normalize.
-    f_equal. apply prop_ext; split.
-    intros [? [? [? ?]]]; subst; split; auto.
-    intros [? [? ?]]; subst; split; auto.
+    unfold locald_denote; simpl.
+    unfold local, lift1; unfold_lift; simpl.
+    constructor; intro rho; rewrite !monPred_at_and /=.
+    rewrite monPred_at_pure. rewrite -!pure_and.
+    apply bi.pure_iff. split; intuition congruence.
     rewrite in_app; right. apply LocalD_sound_temp. auto.
-    apply LOCALx_shuffle'; intros.
+    erewrite LOCALx_shuffle'; first done; intros.
     simpl In. rewrite !in_app. simpl In. intuition.
     apply LOCALx_expand_temp_var in H0. simpl In in H0.
     destruct H0; auto. right. right.
@@ -655,13 +693,13 @@ Proof.
     simpl.
     right. apply (LocalD_remove_empty_from_PTree1 i T1a T2a Qa Q0 H8). auto.
   +
-    destruct (T2a ! i) as [[?t ?v] |] eqn:H8; inv H;
+    destruct (T2a !! i) as [[?t ?v] |] eqn:H8; inv H;
     rewrite <- (IHQ _ _ _ _ _ _ _ _ H1); clear H1 IHQ;
     simpl app;
      rewrite  <- ?insert_prop, <- ?insert_local', <- ?andp_assoc;
     rewrite <- !insert_locals;
-    forget (local (fold_right `(and) `(True) (map locald_denote Q))) as QQ;
-    destruct (T2a ! i) as [ vd |  ] eqn:H9;
+    forget (local(Σ:=Σ) (fold_right `(and) `(True:Prop) (map locald_denote Q))) as QQ;
+    destruct (T2a !! i) as [ vd |  ] eqn:H9;
     try assert (H8 := LOCALx_expand_vardesc i vd T1 T2 Q');
     inv H8.
    -
@@ -669,39 +707,37 @@ Proof.
      rewrite !LOCALx_expand_vardesc'.
      simpl app.
      rewrite  <- ?insert_prop, <- ?insert_local', <- ?andp_assoc.
-     f_equal.
-     rewrite !andp_assoc.
-     rewrite !(andp_comm QQ). rewrite <- !andp_assoc. f_equal.
-     apply local_equal_lemma.
-  -
-     rewrite !(andp_comm QQ). rewrite <- !andp_assoc. f_equal.
+     rewrite !(bi.and_comm QQ).
+     rewrite !bi.and_assoc.
+     rewrite local_equal_lemma.
+     rewrite !bi.and_assoc //.
+   -
+     rewrite !(bi.and_comm QQ). rewrite !bi.and_assoc. rewrite and_mono_iff //.
      rewrite !LOCALx_expand_vardesc'.
      rewrite <- !insert_local'.
-     rewrite LOCALx_shuffle'
-       with (Q:= LocalD T1a (PTree.remove i T2a) Qa)
-              (Q':= LocalD T1a T2a Qa); auto.
-    intro; symmetry; apply (LocalD_remove_empty_from_PTree2); auto.
+     rewrite (LOCALx_shuffle' _
+              (LocalD T1a (PTree.remove i T2a) Qa)
+              (LocalD T1a T2a Qa)) //=.
+    2: {intro; symmetry; apply (LocalD_remove_empty_from_PTree2); auto. }
+    rewrite /PROPx /LOCALx. rewrite !bi.and_assoc //. 
  + destruct Qa; rewrite <- (IHQ _ _ _ _ _ _ _ _ H); clear IHQ H;
    simpl app; rewrite <- ?insert_prop; rewrite <- insert_local', <- ?andp_assoc;
    rewrite <- !insert_locals;
-   forget (local (fold_right `(and) `(True) (map locald_denote Q))) as QQ.
+   forget (local(Σ:=Σ) (fold_right `(and) `(True:Prop) (map locald_denote Q))) as QQ.
    - rewrite LOCALx_expand_gvars'.
      simpl app.
-     rewrite  <- ?insert_prop, <- ?insert_local', <- ?andp_assoc.
-     f_equal.
-     rewrite !andp_assoc.
-     rewrite !(andp_comm QQ). rewrite <- !andp_assoc. f_equal.
-     apply gvars_equal_lemma.
+     rewrite  <- ?insert_prop, <- ?insert_local'.
+     rewrite [in QQ ∧ _]bi.and_comm. rewrite !bi.and_assoc.
+     rewrite gvars_equal_lemma //.
    - rewrite LOCALx_expand_gvars'.
      simpl app.
-     rewrite  <- ?insert_prop, <- ?insert_local', <- ?andp_assoc.
-     f_equal.
-     apply andp_comm.
+     rewrite -?insert_prop -?insert_local' !bi.and_assoc.
+     rewrite [in QQ ∧ _]bi.and_comm //.
 Qed.
 
 Lemma local2ptree_soundness  : forall P Q R T1 T2 P' Q',
   local2ptree Q = (T1, T2, P', Q') ->
-  PROPx P (LOCALx Q (SEPx R)) = PROPx (P' ++ P) (LOCALx (LocalD T1 T2 Q') (SEPx R)).
+  PROPx P (LOCALx Q (SEPx R)) ⊣⊢ PROPx (P' ++ P) (LOCALx (LocalD T1 T2 Q') (SEPx R)).
 Proof. intros. eapply local2ptree_soundness' in H.
    etransitivity; [ | apply H]. clear H.
    simpl. rewrite app_nil_r; auto.
@@ -709,22 +745,25 @@ Qed.
 
 Lemma local2ptree_soundness'' : forall Q T1 T2 gv,
   local2ptree Q = (T1, T2, nil, Some gv) ->
-  LOCALx Q TT = LOCALx (LocalD T1 T2 (Some gv)) TT.
+  LOCALx Q True ⊣⊢ LOCALx (LocalD T1 T2 (Some gv)) True.
 Proof.
   intros.
   eapply local2ptree_soundness in H.
-  match goal with |- LOCALx _ ?B = _ =>
-    replace B with (@SEPx environ (TT::nil))
+  match goal with |- LOCALx _ ?B ⊣⊢ _ =>
+    assert (H0: B ⊣⊢ (@SEPx environ_index Σ (True::nil)))
   end.
+  {  unfold SEPx. simpl. rewrite bi.sep_emp embed_pure //. }
+  rewrite H0.
   instantiate (2:=@nil Prop) in H.
   simpl app in H.
   unfold PROPx in H.
   simpl fold_right in H.
-  rewrite !prop_true_andp in H by auto. apply H.
-  extensionality rho; unfold SEPx; simpl. rewrite sepcon_emp. reflexivity.
+  rewrite !bi.True_and in H.
+  rewrite H.
+  raise_rho; rewrite /SEPx //.
 Qed.
 
-Lemma local_ext: forall Q0 Q rho, In Q0 Q -> fold_right `(and) `(True) Q rho -> Q0 rho.
+Lemma local_ext: forall Q0 Q rho, In Q0 Q -> fold_right `(and) `(True:Prop) Q rho -> Q0 rho.
 Proof.
   intros.
   induction Q.
@@ -739,11 +778,11 @@ Proof.
       tauto.
 Qed.
 
-Lemma local_ext_rev: forall (Q: list (environ -> Prop)) rho, (forall Q0, In Q0 Q -> Q0 rho) -> fold_right `(and) `(True) Q rho.
+Lemma local_ext_rev: forall (Q: list (environ -> Prop)) rho, (forall Q0, In Q0 Q -> Q0 rho) -> fold_right `(and) `(True:Prop) Q rho.
 Proof.
   intros.
   induction Q.
-  + simpl; auto.
+  + simpl; constructor.
   + simpl.
     split.
     - apply H; simpl; auto.
@@ -765,16 +804,16 @@ Fixpoint force_list {A} (al: list (option A)) : option (list A) :=
  end.
 
 Lemma make_func_ptr:
- forall id (Espec: OracleKind) (CS: compspecs) Delta P Q R fs gv p c Post,
-   (var_types Delta) ! id = None ->
-   (glob_specs Delta) ! id = Some fs ->
-   (glob_types Delta) ! id = Some (type_of_funspec fs) ->
+ forall `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty} id (CS: compspecs) E Delta P Q R fs gv p c Post,
+   (var_types Delta) !! id = None ->
+   (glob_specs Delta) !! id = Some fs ->
+   (glob_types Delta) !! id = Some (type_of_funspec fs) ->
    snd (local2ptree Q) = Some gv /\ gv id = p ->
-  semax Delta (PROPx P (LOCALx Q (SEPx (func_ptr' fs p :: R)))) c Post ->
-  semax Delta (PROPx P (LOCALx Q (SEPx R))) c Post.
+  semax E Delta (PROPx P (LOCALx Q (SEPx (func_ptr fs p :: R)))) c Post ->
+  semax E Delta (PROPx P (LOCALx Q (SEPx R))) c Post.
 Proof.
 intros.
-apply (semax_fun_id id fs Delta); auto.
+apply (semax_fun_id id fs E Delta); auto.
 eapply semax_pre; try apply H3. clear H3.
 destruct (local2ptree Q) as [[[? ?] ?] ?] eqn:?.
 simpl in H2.
@@ -782,11 +821,12 @@ destruct H2 as [H3 H2']; subst o.
 pose proof (local2ptree_soundness P Q R t t0 l _ Heqp0) as H3.
 pose proof LocalD_sound_gvars gv t t0 _ eq_refl as H2.
 forget (LocalD t t0 (Some gv)) as Q'.
-assert (local (tc_environ Delta) |-- fun rho => !! (Map.get (ve_of rho) id = None)) as TC.
-{
-  intro rho.
+assert (forall rho, local(Σ:=Σ) (tc_environ Delta) rho ⊢ ⌜Map.get (ve_of rho) id = None⌝) as TC.
+{  
+  intro rho. simpl.
   unfold local, lift1.
-  normalize.
+  apply bi.pure_mono.
+  intros.
   destruct H4 as [_ [? _]].
   specialize (H4 id).
   rewrite H in H4.
@@ -797,26 +837,23 @@ assert (local (tc_environ Delta) |-- fun rho => !! (Map.get (ve_of rho) id = Non
   inv H4.
 }
 clear - H2 H2' H3 TC.
-rewrite <- insert_SEP.
-unfold func_ptr'.
+rewrite -insert_SEP.
+unfold func_ptr.
+split => rho; monPred.unseal.
 normalize.
-rewrite corable_andp_sepcon1
-  by (unfold_lift; simpl; intros; apply corable_func_ptr).
-apply andp_right; [ | apply andp_left2; apply andp_left1; normalize].
+iIntros "(%H0 & H1 & H2)".  iSplit. 2: { done. }
 rewrite H3.
-rewrite <- andp_assoc.
-rewrite (add_andp _ _ (in_local _ Delta (l ++ P) _ (SEPx R) H2)).
-rewrite (add_andp _ _ TC).
-apply derives_trans with ((fun rho : environ => !! (Map.get (ve_of rho) id = None)) &&
-local (locald_denote (gvars gv)) && (` (func_ptr fs)) (eval_var id (type_of_funspec fs))); [solve_andp |].
+iPoseProof (in_local _ Delta (l ++ P) _ (SEPx R) H2 with "[H1]") as "H3".
+{ rewrite /PROPx /LOCALx. iSplit;  done. }
+iPoseProof (TC) as "%H4". apply H4 in H0.
 subst p.
-clear.
-intro rho.
-unfold_lift. unfold local, lift1; simpl.
+unfold local, lift1; simpl.
 normalize.
 unfold eval_var.
-hnf in H0.
+iDestruct "H3" as "%H5".
+hnf in H5.
 subst gv.
-rewrite H.
-auto.
+rewrite H0. done.
 Qed.
+
+End LOCAL2PTREE_DENOTE.
diff --git a/floyd/local2ptree_eval.v b/floyd/local2ptree_eval.v
index 6c2b8c94a5..ac4adfe918 100644
--- a/floyd/local2ptree_eval.v
+++ b/floyd/local2ptree_eval.v
@@ -1,15 +1,16 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
-Require Import VST.floyd.closed_lemmas.
 Require Import VST.floyd.local2ptree_denote.
 Import LiftNotation.
-Import compcert.lib.Maps.
-
-Local Open Scope logic.
+Import -(notations) compcert.lib.Maps.
 
+Section LOCAL2PTREE_EVAL.
+Context `{!heapGS Σ}.
 Definition eval_vardesc (id: ident) (ty: type) (Delta: tycontext) (T2: PTree.t (type * val)) (GV: option globals) : option val :=
-  match (var_types Delta) ! id with
-  | Some _ => match T2 ! id with
+  match (var_types Delta) !! id with
+  | Some _ => match T2 !! id with
               | Some (ty', v) =>
                       if eqb_type ty ty'
                       then Some v
@@ -23,8 +24,8 @@ Definition eval_vardesc (id: ident) (ty: type) (Delta: tycontext) (T2: PTree.t (
   end.
 
 Definition eval_lvardesc (id: ident) (ty: type) (Delta: tycontext) (T2: PTree.t (type * val)) : option val :=
-  match (var_types Delta) ! id with
-  | Some _ => match T2 ! id with
+  match (var_types Delta) !! id with
+  | Some _ => match T2 !! id with
               | Some (ty', v) =>
                       if eqb_type ty ty'
                       then Some v
@@ -81,14 +82,14 @@ Definition msubst_eval_lvar {cs: compspecs} Delta T2 i t :=
 
 Lemma msubst_eval_expr_eq_aux:
   forall {cs: compspecs} (Delta: tycontext) (T1: PTree.t val) (T2: PTree.t (type * val)) (GV: option globals) e rho v,
-    (forall i v, T1 ! i = Some v -> eval_id i rho = v) ->
+    (forall i v, T1 !! i = Some v -> eval_id i rho = v) ->
     (forall i t v,
      eval_vardesc i t Delta T2 GV  = Some v -> eval_var i t rho = v) ->
     msubst_eval_expr Delta T1 T2 GV e = Some v ->
     eval_expr e rho = v
 with msubst_eval_lvalue_eq_aux:
   forall {cs: compspecs} (Delta: tycontext) (T1: PTree.t val) (T2: PTree.t (type * val)) (GV: option globals) e rho v,
-    (forall i v, T1 ! i = Some v -> eval_id i rho = v) ->
+    (forall i v, T1 !! i = Some v -> eval_id i rho = v) ->
     (forall i t v,
      eval_vardesc i t Delta T2 GV = Some v -> eval_var i t rho = v) ->
     msubst_eval_lvalue Delta T1 T2 GV e = Some v ->
@@ -100,19 +101,19 @@ Proof.
     - unfold_lift; simpl.
       destruct (msubst_eval_expr Delta T1 T2 GV e) eqn:?; [| inversion H1].
       inversion H1.
-      rewrite IHe with (v := v0) by auto.
+      rewrite -> IHe with (v := v0) by auto.
       reflexivity.
     - unfold_lift; simpl.
       destruct (msubst_eval_expr Delta T1 T2 GV e1) eqn:?; [| inversion H1].
       destruct (msubst_eval_expr Delta T1 T2 GV e2) eqn:?; [| inversion H1].
       inversion H1.
-      rewrite IHe1 with (v := v0) by auto.
-      rewrite IHe2 with (v := v1) by auto.
+      rewrite -> IHe1 with (v := v0) by auto.
+      rewrite -> IHe2 with (v := v1) by auto.
       reflexivity.
     - unfold_lift; simpl.
       destruct (msubst_eval_expr Delta T1 T2 GV e) eqn:?; [| inversion H1].
       inversion H1.
-      rewrite IHe with (v := v0) by auto.
+      rewrite -> IHe with (v := v0) by auto.
       reflexivity.
     - unfold_lift; simpl.
       destruct (msubst_eval_lvalue Delta T1 T2 GV e) eqn:?; [| inversion H1].
@@ -129,17 +130,17 @@ Proof.
     - unfold_lift; simpl.
       destruct (msubst_eval_lvalue Delta T1 T2 GV e) eqn:?; [| inversion H1].
       inversion H1.
-      rewrite IHe with (v := v0) by auto.
+      rewrite -> IHe with (v := v0) by auto.
       reflexivity.
 Qed.
 
-Require Import VST.veric.expr_lemmas2.
+(* Require Import VST.veric.expr_lemmas2. *)
 
 
 Lemma msubst_eval_eq_aux {cs: compspecs}: forall Delta T1 T2 GV rho,
   tc_environ Delta rho ->
-  fold_right `(and) `(True) (map locald_denote (LocalD T1 T2 GV)) rho ->
-  (forall i v, T1 ! i = Some v -> eval_id i rho = v) /\
+  fold_right `(and) `(True:Prop) (map locald_denote (LocalD T1 T2 GV)) rho ->
+  (forall i v, T1 !! i = Some v -> eval_id i rho = v) /\
   (forall i t v, eval_vardesc i t Delta T2 GV = Some v ->
       eval_var i t rho = v).
 Proof.
@@ -157,8 +158,8 @@ Proof.
   + intros.
     unfold eval_vardesc in H1.
     unfold eval_var. red in H.
-    destruct_var_types i; rewrite ?Heqo, ?Heqo0 in *.
-    - destruct (T2 ! i) as [[? ?]|] eqn:?; [| inv H1].
+    destruct_var_types i; rewrite ?Heqo ?Heqo0 in H1 *.
+    - destruct (T2 !! i) as [[? ?]|] eqn:?; [| inv H1].
       destruct (eqb_type t t1) eqn:?; inv H1.
       apply eqb_type_true in Heqb0. subst t1.
       assert (In (locald_denote (lvar i t v))  (map locald_denote (LocalD T1 T2 GV)))
@@ -178,15 +179,15 @@ Qed.
 
 Lemma msubst_eval_lvar_eq_aux {cs: compspecs}: forall Delta T1 T2 GV rho,
   tc_environ Delta rho ->
-  fold_right `(and) `(True) (map locald_denote (LocalD T1 T2 GV)) rho ->
+  fold_right `(and) `(True:Prop) (map locald_denote (LocalD T1 T2 GV)) rho ->
   (forall i t v, eval_lvardesc i t Delta T2 = Some v ->
       eval_lvar i t rho = v).
 Proof.
   intros.
   unfold eval_lvar.
   unfold eval_lvardesc in H1. red in H.
-  destruct_var_types i; rewrite ?Heqo, ?Heqo0 in *; [| inv H1].
-  destruct (T2 ! i) as [[? ?]|] eqn:?; [| inv H1].
+  destruct_var_types i; rewrite ?Heqo ?Heqo0 in H1 *; [| inv H1].
+  destruct (T2 !! i) as [[? ?]|] eqn:?; [| inv H1].
   destruct (eqb_type t t1) eqn:?; inv H1.
   apply eqb_type_true in Heqb0; subst t1.
   assert (In (locald_denote (lvar i t v))  (map locald_denote (LocalD T1 T2 GV)))
@@ -197,41 +198,43 @@ Proof.
   destruct H3; subst. rewrite eqb_type_refl. auto.
 Qed.
 
+Local Notation PROPx := (PROPx(Σ := Σ)).
+
 Lemma msubst_eval_expr_eq: forall {cs: compspecs} Delta P T1 T2 GV R e v,
   msubst_eval_expr Delta T1 T2 GV e = Some v ->
-  ENTAIL Delta, PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) |--
+  ENTAIL Delta, PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) ⊢
     local (`(eq v) (eval_expr e)).
 Proof.
   intros.
   unfold PROPx, LOCALx.
-  apply derives_trans with (local (tc_environ Delta) && local (fold_right (` and) (` True) (map locald_denote (LocalD T1 T2 GV)))); [solve_andp |].
   unfold local, lift, lift1.
-  simpl; intro rho.
+  raise_rho.
   normalize; intros.
-      autorewrite with subst norm1 norm2; normalize.
-  destruct (msubst_eval_eq_aux _ _ _ _ _ H0 H1).
+  autorewrite with subst norm1 norm2; normalize.
+  apply bi.pure_intro.
+  destruct (msubst_eval_eq_aux _ _ _ _ _ H0 H2).
   apply eq_sym, (msubst_eval_expr_eq_aux Delta T1 T2 GV); auto.
 Qed.
 
 Lemma msubst_eval_lvalue_eq: forall {cs: compspecs} Delta P T1 T2 GV R e v,
   msubst_eval_lvalue Delta T1 T2 GV e = Some v ->
-  ENTAIL Delta, PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) |--
+  ENTAIL Delta, PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) ⊢
     local (`(eq v) (eval_lvalue e)).
 Proof.
   intros.
   unfold PROPx, LOCALx.
-  apply derives_trans with (local (tc_environ Delta) && local (fold_right (` and) (` True) (map locald_denote (LocalD T1 T2 GV)))); [solve_andp |].
   unfold local, lift, lift1.
-  simpl; intro rho.
+  raise_rho.
   normalize; intros.
       autorewrite with subst norm1 norm2; normalize.
-  destruct (msubst_eval_eq_aux _ _ _ _ _ H0 H1).
+  apply bi.pure_intro.
+  destruct (msubst_eval_eq_aux _ _ _ _ _ H0 H2).
   apply eq_sym, (msubst_eval_lvalue_eq_aux Delta T1 T2 GV); auto.
 Qed.
 
 Lemma msubst_eval_LR_eq: forall {cs: compspecs} Delta P T1 T2 GV R e v lr,
   msubst_eval_LR Delta T1 T2 GV e lr = Some v ->
-  ENTAIL Delta, PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) |--
+  ENTAIL Delta, PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) ⊢
     local (`(eq v) (eval_LR e lr)).
 Proof.
   intros.
@@ -245,13 +248,13 @@ Lemma msubst_eval_exprlist_eq:
   force_list
            (map (msubst_eval_expr Delta T1 T2 GV)
               (explicit_cast_exprlist tys el)) = Some vl ->
- ENTAIL Delta, PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) |--
+ ENTAIL Delta, PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) ⊢
    local (`(eq vl) (eval_exprlist tys el)).
 Proof.
 intros.
 revert tys vl H; induction el; destruct tys, vl; intros;
   try solve [inv H];
-  try solve [go_lowerx;  apply prop_right; reflexivity].
+  try solve [go_lowerx; iIntros; iPureIntro; reflexivity].
  simpl map in H.
  unfold force_list in H; fold (@force_list val) in H.
  destruct (msubst_eval_expr Delta T1 T2 GV a) eqn:?.
@@ -268,34 +271,38 @@ revert tys vl H; induction el; destruct tys, vl; intros;
   simpl eval_exprlist.
   destruct (msubst_eval_expr Delta T1 T2 GV a) eqn:?; inv Heqo.
   apply @msubst_eval_expr_eq with (P:=P) (GV:=GV) (R:=R) in Heqo1.
-  apply derives_trans with (local (`(eq v0) (eval_expr a)) && local (`(eq vl) (eval_exprlist tys el))).
-  apply andp_right; auto.
-  go_lowerx. unfold_lift. intros. apply prop_right.
-  rewrite <- H. rewrite <- H0.
- auto.
+  iApply (bi.wand_trans _ (local (`(eq v0) (eval_expr a)) ∧ local (`(eq vl) (eval_exprlist tys el)))).
+  iSplitL. 
+  - iIntros. rewrite -IHel -Heqo1; auto.
+  - iStopProof. go_lowerx. iIntros. destruct H0.
+    subst. done.
 Qed.
 
 Lemma msubst_eval_lvar_eq: forall {cs: compspecs} Delta P T1 T2 GV R i t v,
   msubst_eval_lvar Delta T2 i t = Some v ->
-  ENTAIL Delta, PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) |--
+  ENTAIL Delta, PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) ⊢
     local (`(eq v) (eval_lvar i t)).
 Proof.
   intros.
   unfold PROPx, LOCALx.
-  apply derives_trans with (local (tc_environ Delta) && local (fold_right (` and) (` True) (map locald_denote (LocalD T1 T2 GV)))); [solve_andp |].
+  iApply (bi.wand_trans _ (local (tc_environ Delta) ∧ local (fold_right (` and) (` (True:Prop)) (map locald_denote (LocalD T1 T2 GV)))));
+    iSplitL; iStopProof; apply bi.entails_wand'.
+  { solve_andp. }
   unfold local, lift, lift1.
-  simpl; intro rho.
+  raise_rho.
+  iIntros "[%H0 %H1]"; iPureIntro.
   normalize; intros.
       autorewrite with subst norm1 norm2; normalize.
   pose proof (msubst_eval_lvar_eq_aux _ _ _ _ _ H0 H1).
   apply eq_sym.
   apply H2; auto.
 Qed.
+End LOCAL2PTREE_EVAL.
 
 Ltac prove_eqb_type :=
  match goal with |- context [eqb_type ?A ?B] => 
   try change (eqb_type A B) with true;
-  rewrite (proj2 (eqb_type_spec A B))
+  rewrite -> (proj2 (eqb_type_spec A B))
      by (repeat f_equal; rep_lia)
  end;
  cbv beta iota.
@@ -303,7 +310,7 @@ Ltac prove_eqb_type :=
 Ltac solve_msubst_eval_lvalue :=
   (simpl;
   cbv beta iota zeta delta [force_val2 force_val1];
-  rewrite ?isptr_force_ptr, <- ?offset_val_force_ptr by auto;
+  rewrite -> ?isptr_force_ptr, <- ?offset_val_force_ptr by auto;
   unfold eval_vardesc;
   repeat match goal with |- match match PTree.get ?A ?B with _ => _ end with _ => _ end = _ =>
          let x := fresh "x" in set (x := PTree.get A B); hnf in x; subst x;
@@ -317,9 +324,9 @@ Ltac solve_msubst_eval_lvalue :=
   end.
 
 Ltac solve_msubst_eval_expr :=
-  (simpl;
+  (unfold msubst_eval_expr; simpl;
   cbv beta iota zeta delta [force_val2 force_val1];
-  rewrite ?isptr_force_ptr, <- ?offset_val_force_ptr by auto;
+  rewrite -> ?isptr_force_ptr, <- ?offset_val_force_ptr by auto;
   reflexivity) ||
   match goal with 
   |- msubst_eval_expr _ _ _ _ ?e = _ =>
@@ -330,7 +337,7 @@ Ltac solve_msubst_eval_LR :=
   (unfold msubst_eval_LR;
   simpl;
   cbv beta iota zeta delta [force_val2 force_val1];
-  rewrite ?isptr_force_ptr, <- ?offset_val_force_ptr by auto;
+  rewrite -> ?isptr_force_ptr, <- ?offset_val_force_ptr by auto;
   unfold eval_vardesc;
   repeat match goal with |- match PTree.get ?A ?B with _ => _ end = _ =>
          let x := fresh "x" in set (x := PTree.get A B); hnf in x; subst x;
@@ -356,7 +363,6 @@ Ltac solve_msubst_eval_lvar :=
   |- msubst_eval_lvar _ _ ?id _ = _ =>
    fail "Cannot symbolically evaluate lvar" id "given the information in your LOCAL clause; did you forget an 'lvar' declaration?"
   end.
-
 (**********************************************************)
 (* Continuation *)
 (*
diff --git a/floyd/local2ptree_typecheck.v b/floyd/local2ptree_typecheck.v
index 147af62a6b..bab9676185 100644
--- a/floyd/local2ptree_typecheck.v
+++ b/floyd/local2ptree_typecheck.v
@@ -1,4 +1,6 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.closed_lemmas.
 Require Import VST.floyd.efield_lemmas.
@@ -6,28 +8,32 @@ Require Import VST.floyd.local2ptree_denote.
 Require Import VST.floyd.local2ptree_eval.
 
 Import LiftNotation.
-Import compcert.lib.Maps.
-Local Open Scope logic.
+Import -(notations) compcert.lib.Maps.
+
+
+
+Section MSUBST_DENOTE_TC_ASSERT.
+
+Context `{!VSTGS OK_ty Σ}.
+Context {cs: compspecs} (Delta: tycontext) (T1: PTree.t val) (T2: PTree.t (type * val)) (GV: option globals).
 
 Definition msubst_simpl_tc_assert (T1: PTree.t val): tc_assert -> tc_assert :=
   fix msubst_simpl_tc_assert (tc: tc_assert): tc_assert :=
   match tc with
   | tc_andp' tc1 tc2 => tc_andp (msubst_simpl_tc_assert tc1) (msubst_simpl_tc_assert tc2)
   | tc_orp' tc1 tc2 => tc_orp (msubst_simpl_tc_assert tc1) (msubst_simpl_tc_assert tc2)
-  | tc_initialized i _ => match T1 ! i with Some _ => tc_TT | None => tc_FF miscellaneous_typecheck_error end
+  | tc_initialized i _ => match T1 !! i with Some _ => tc_TT | None => tc_FF miscellaneous_typecheck_error end
   | _ => tc
   end.
 
-Section MSUBST_DENOTE_TC_ASSERT.
 
-Context {cs: compspecs} (Delta: tycontext) (T1: PTree.t val) (T2: PTree.t (type * val)) (GV: option globals).
 
 Fixpoint msubst_denote_tc_assert (tc: tc_assert): mpred :=
   match tc with
-  | tc_FF msg => !! (typecheck_error msg)
-  | tc_TT => TT
-  | tc_andp' b c => (msubst_denote_tc_assert b) && (msubst_denote_tc_assert c)
-  | tc_orp' b c => (msubst_denote_tc_assert b) || (msubst_denote_tc_assert c)
+  | tc_FF msg => ⌜typecheck_error msg⌝
+  | tc_TT => True
+  | tc_andp' b c => (msubst_denote_tc_assert b) ∧ (msubst_denote_tc_assert c)
+  | tc_orp' b c => (msubst_denote_tc_assert b) ∨ (msubst_denote_tc_assert c)
   | tc_nonzero' e => denote_tc_nonzero (force_val (msubst_eval_expr Delta T1 T2 GV e))
   | tc_isptr e => denote_tc_isptr (force_val (msubst_eval_expr Delta T1 T2 GV e))
   | tc_isint e => denote_tc_isint (force_val (msubst_eval_expr Delta T1 T2 GV e))
@@ -40,7 +46,7 @@ Fixpoint msubst_denote_tc_assert (tc: tc_assert): mpred :=
   | tc_Zge e z => denote_tc_Zle z (force_val (msubst_eval_expr Delta T1 T2 GV e))
   | tc_samebase e1 e2 => denote_tc_samebase (force_val (msubst_eval_expr Delta T1 T2 GV e1)) (force_val (msubst_eval_expr Delta T1 T2 GV e2))
   | tc_nodivover' v1 v2 => denote_tc_nodivover (force_val (msubst_eval_expr Delta T1 T2 GV v1)) (force_val (msubst_eval_expr Delta T1 T2 GV v2))
-  | tc_initialized id ty => FF
+  | tc_initialized id ty => False
   | tc_iszero' e => denote_tc_iszero (force_val (msubst_eval_expr Delta T1 T2 GV e))
   | tc_nosignedover op e1 e2 => 
      match typeof e1, typeof e2 with
@@ -76,295 +82,205 @@ Definition msubst_tc_expropt (e: option expr) (t: type) :=
      end)).
 
 (* Soundness proof *)
+Lemma denote_tc_assert_andp': forall P Q,
+  denote_tc_assert (tc_andp' P Q) ⊣⊢ denote_tc_assert P ∧ denote_tc_assert Q.
+Proof.
+  intros.
+  simpl. unfold_lift. raise_rho. done.
+Qed.
+
+Lemma lift_or: forall P Q,
+  assert_of(Σ:=Σ) `(P ∨ Q) ⊣⊢ (assert_of `(P) ∨ (assert_of `(Q))).
+Proof.
+  intros. unfold_lift. raise_rho. done.
+Qed.
+
+Lemma derives_trans: forall {prop:bi} (P Q R:prop),
+  (P ⊢ Q) -> (Q ⊢ R) -> (P ⊢ R).
+Proof. intros. rewrite H H0 //. Qed.
 
 Lemma msubst_denote_tc_assert_sound: forall P R tc,
-  local (tc_environ Delta) && PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) && `(msubst_denote_tc_assert tc) |--
+  local (tc_environ Delta) ∧ PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) ∧ (assert_of `(msubst_denote_tc_assert tc)) ⊢
     denote_tc_assert tc.
 Proof.
+  Ltac and_elim_rightmost := 
+    rewrite bi.and_elim_l; apply bi.impl_intro_r; rewrite bi.and_elim_r;
+    simpl denote_tc_nonzero; unfold local, lift1; unfold_lift;
+    raise_rho; try apply bi.pure_mono; normalize.
   intros.
   induction tc.
-  + apply andp_left2; apply derives_refl.
-  + apply andp_left2; apply derives_refl.
-  + change (denote_tc_assert (tc_andp' tc1 tc2)) with (denote_tc_assert tc1 && denote_tc_assert tc2).
-    change (`(msubst_denote_tc_assert (tc_andp' tc1 tc2)))
-      with (`(msubst_denote_tc_assert tc1) && `(msubst_denote_tc_assert tc2)).
-    apply andp_right.
-    - eapply derives_trans; [| apply IHtc1].
+  + rewrite !bi.and_elim_r. done.
+  + rewrite !bi.and_elim_r. done.
+  + rewrite denote_tc_assert_andp'.
+    apply bi.and_intro.
+    - rewrite -IHtc1 /=. rewrite bi.and_mono //. rewrite bi.and_mono //. 
+      unfold_lift. raise_rho. simpl.
       solve_andp.
-    - eapply derives_trans; [| apply IHtc2].
+    - rewrite -IHtc2 /=. rewrite bi.and_mono //. rewrite bi.and_mono //. 
+      unfold_lift. raise_rho. simpl.
       solve_andp.
-  + change (denote_tc_assert (tc_orp' tc1 tc2)) with (denote_tc_assert tc1 || denote_tc_assert tc2).
-    change (`(msubst_denote_tc_assert (tc_orp' tc1 tc2)))
-      with (`(msubst_denote_tc_assert tc1) || `(msubst_denote_tc_assert tc2)).
-    rewrite (andp_comm (_ && _)).
-    apply imp_andp_adjoint.
-    apply orp_left; apply imp_andp_adjoint; rewrite <- (andp_comm (_ && _)).
-    - eapply derives_trans; [exact IHtc1 | apply orp_right1; auto].
-    - eapply derives_trans; [exact IHtc2 | apply orp_right2; auto].
+  + simpl (` (msubst_denote_tc_assert _)).
+    rewrite lift_or.
+    rewrite bi.and_assoc.
+    rewrite bi.and_or_l.
+    apply bi.or_elim; rewrite -bi.and_assoc.
+    - rewrite IHtc1. split => rho. simpl. unfold_lift. apply bi.or_intro_l.
+    - rewrite IHtc2. split => rho. simpl. unfold_lift. apply bi.or_intro_r.
   + simpl msubst_denote_tc_assert; simpl denote_tc_assert.
-    apply imp_andp_adjoint.
+    rewrite bi.and_assoc. apply bi.impl_elim_l'.
     destruct (msubst_eval_expr Delta T1 T2 GV e) eqn:?H.
     - eapply derives_trans; [eapply msubst_eval_expr_eq; eauto |].
-      apply imp_andp_adjoint.
-      unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl.
-      normalize.
-    - apply andp_left1, imp_andp_adjoint, andp_left2.
-      simpl denote_tc_nonzero.
+      apply bi.impl_intro_r.
       unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl.
+      split => rho; monPred.unseal;
       normalize.
+    - and_elim_rightmost.
   + simpl msubst_denote_tc_assert; simpl denote_tc_assert.
-    apply imp_andp_adjoint.
+    rewrite bi.and_assoc. apply bi.impl_elim_l'.
     destruct (msubst_eval_expr Delta T1 T2 GV e) eqn:?H.
     - eapply derives_trans; [eapply msubst_eval_expr_eq; eauto |].
-      apply imp_andp_adjoint.
+      apply bi.impl_intro_l.
       unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl.
-      normalize.
-    - apply andp_left1, imp_andp_adjoint, andp_left2.
-      simpl denote_tc_iszero.
-      unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl.
+      raise_rho.
       normalize.
+    - and_elim_rightmost.
   + simpl msubst_denote_tc_assert; simpl denote_tc_assert.
-    apply imp_andp_adjoint.
+    rewrite bi.and_assoc. apply bi.impl_elim_l'.
     destruct (msubst_eval_expr Delta T1 T2 GV e) eqn:?H.
     - eapply derives_trans; [eapply msubst_eval_expr_eq; eauto |].
-      apply imp_andp_adjoint.
+      apply bi.impl_intro_l.
       unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl.
-      normalize.
-    - apply andp_left1, imp_andp_adjoint, andp_left2.
-      unfold denote_tc_isptr.
-      unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl.
+      raise_rho.
       normalize.
+    - and_elim_rightmost.
   + simpl msubst_denote_tc_assert; simpl denote_tc_assert.
-    apply imp_andp_adjoint.
+    rewrite bi.and_assoc. apply bi.impl_elim_l'.
     destruct (msubst_eval_expr Delta T1 T2 GV e) eqn:?H.
     - eapply derives_trans; [eapply msubst_eval_expr_eq; eauto |].
-      apply imp_andp_adjoint.
+      apply bi.impl_intro_l.
       unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl.
-      normalize.
-    - apply andp_left1, imp_andp_adjoint, andp_left2.
-      unfold denote_tc_isint.
-      unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl.
+      raise_rho.
       normalize.
+    - and_elim_rightmost.
   + simpl msubst_denote_tc_assert; simpl denote_tc_assert.
-    apply imp_andp_adjoint.
+    rewrite bi.and_assoc. apply bi.impl_elim_l'.
     destruct (msubst_eval_expr Delta T1 T2 GV e) eqn:?H.
     - eapply derives_trans; [eapply msubst_eval_expr_eq; eauto |].
-      apply imp_andp_adjoint.
-      unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl.
-      normalize.
-    - apply andp_left1, imp_andp_adjoint, andp_left2.
-      unfold denote_tc_islong.
+      apply bi.impl_intro_l.
       unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl.
+      raise_rho.
       normalize.
+    - and_elim_rightmost.
   + simpl msubst_denote_tc_assert; simpl denote_tc_assert.
-    apply imp_andp_adjoint.
+    rewrite bi.and_assoc. apply bi.impl_elim_l'.
     destruct (msubst_eval_expr Delta T1 T2 GV e) eqn:?H, (msubst_eval_expr Delta T1 T2 GV e0) eqn:?H.
-    - eapply derives_trans; [apply andp_right; eapply msubst_eval_expr_eq; [exact H | exact H0] |].
-      rewrite <- imp_andp_adjoint.
+    - eapply derives_trans; [apply bi.and_intro; eapply msubst_eval_expr_eq; [exact H | exact H0] |].
+      apply bi.impl_intro_l.
       unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl.
+      raise_rho.
       normalize.
-    - apply andp_left1, imp_andp_adjoint, andp_left2.
-      unfold denote_tc_test_eq.
-      unfold local, lift1; unfold_lift.
-      intros rho.
+    - and_elim_rightmost.
       destruct v; simpl; normalize.
-    - apply andp_left1, imp_andp_adjoint, andp_left2.
-      unfold denote_tc_test_eq.
-      unfold local, lift1; unfold_lift.
-      intros rho.
-      destruct v; simpl; normalize.
-    - apply andp_left1, imp_andp_adjoint, andp_left2.
-      unfold denote_tc_test_eq.
-      unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl; normalize.
+    - and_elim_rightmost.
+    - and_elim_rightmost.
   + simpl msubst_denote_tc_assert; simpl denote_tc_assert.
-    apply imp_andp_adjoint.
+    rewrite bi.and_assoc. apply bi.impl_elim_l'.
     destruct (msubst_eval_expr Delta T1 T2 GV e) eqn:?H, (msubst_eval_expr Delta T1 T2 GV e0) eqn:?H.
-    - eapply derives_trans; [apply andp_right; eapply msubst_eval_expr_eq; [exact H | exact H0] |].
-      rewrite <- imp_andp_adjoint.
+    - eapply derives_trans; [apply bi.and_intro; eapply msubst_eval_expr_eq; [exact H | exact H0] |].
+      apply bi.impl_intro_l.
       unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl.
+      raise_rho.
       normalize.
-    - apply andp_left1, imp_andp_adjoint, andp_left2.
+    - and_elim_rightmost.
       unfold denote_tc_test_order.
-      unfold local, lift1; unfold_lift.
-      intros rho.
-      destruct v; simpl; normalize.
-    - apply andp_left1, imp_andp_adjoint, andp_left2.
-      unfold denote_tc_test_order.
-      unfold local, lift1; unfold_lift.
-      intros rho.
       destruct v; simpl; normalize.
-    - apply andp_left1, imp_andp_adjoint, andp_left2.
-      unfold denote_tc_test_order.
-      unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl; normalize.
+    - and_elim_rightmost.
+    - and_elim_rightmost.
   + simpl msubst_denote_tc_assert; simpl denote_tc_assert.
-    apply imp_andp_adjoint.
+    rewrite bi.and_assoc. apply bi.impl_elim_l'.
     destruct (msubst_eval_expr Delta T1 T2 GV e) eqn:?H.
     - eapply derives_trans; [eapply msubst_eval_expr_eq; eauto |].
-      apply imp_andp_adjoint.
-      unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl.
-      normalize.
-    - apply andp_left1, imp_andp_adjoint, andp_left2.
-      simpl denote_tc_igt.
+      apply bi.impl_intro_l.
       unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl.
+      raise_rho.
       normalize.
+    - and_elim_rightmost.
   + simpl msubst_denote_tc_assert; simpl denote_tc_assert.
-    apply imp_andp_adjoint.
+    rewrite bi.and_assoc. apply bi.impl_elim_l'.
     destruct (msubst_eval_expr Delta T1 T2 GV e) eqn:?H.
     - eapply derives_trans; [eapply msubst_eval_expr_eq; eauto |].
-      apply imp_andp_adjoint.
+      apply bi.impl_intro_l.
       unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl.
-      normalize.
-    - apply andp_left1, imp_andp_adjoint, andp_left2.
-      simpl denote_tc_Zge.
-      unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl.
+      raise_rho.
       normalize.
+    - and_elim_rightmost.
   + simpl msubst_denote_tc_assert; simpl denote_tc_assert.
-    apply imp_andp_adjoint.
+    rewrite bi.and_assoc. apply bi.impl_elim_l'.
     destruct (msubst_eval_expr Delta T1 T2 GV e) eqn:?H.
     - eapply derives_trans; [eapply msubst_eval_expr_eq; eauto |].
-      apply imp_andp_adjoint.
-      unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl.
-      normalize.
-    - apply andp_left1, imp_andp_adjoint, andp_left2.
-      simpl denote_tc_Zle.
+      apply bi.impl_intro_l.
       unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl.
+      raise_rho.
       normalize.
+    - and_elim_rightmost.
   + simpl msubst_denote_tc_assert; simpl denote_tc_assert.
-    apply imp_andp_adjoint.
+    rewrite bi.and_assoc. apply bi.impl_elim_l'.
     destruct (msubst_eval_expr Delta T1 T2 GV e) eqn:?H.
     - eapply derives_trans; [eapply msubst_eval_expr_eq; eauto |].
-      apply imp_andp_adjoint.
+      apply bi.impl_intro_l.
       unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl.
-      normalize.
-    - apply andp_left1, imp_andp_adjoint, andp_left2.
-      simpl denote_tc_Zle.
-      unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl.
+      raise_rho.
       normalize.
+    - and_elim_rightmost.
   + simpl msubst_denote_tc_assert; simpl denote_tc_assert.
-    apply imp_andp_adjoint.
+    rewrite bi.and_assoc. apply bi.impl_elim_l'.
     destruct (msubst_eval_expr Delta T1 T2 GV e) eqn:?H, (msubst_eval_expr Delta T1 T2 GV e0) eqn:?H.
-    - eapply derives_trans; [apply andp_right; eapply msubst_eval_expr_eq; [exact H | exact H0] |].
-      rewrite <- imp_andp_adjoint.
+    - eapply derives_trans; [apply bi.and_intro; eapply msubst_eval_expr_eq; [exact H | exact H0] |].
+      apply bi.impl_intro_l.
       unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl.
+      raise_rho.
       normalize.
-    - apply andp_left1, imp_andp_adjoint, andp_left2.
-      unfold denote_tc_samebase.
-      unfold local, lift1; unfold_lift.
-      intros rho.
-      destruct v; simpl; normalize.
-    - apply andp_left1, imp_andp_adjoint, andp_left2.
+    - and_elim_rightmost.
       unfold denote_tc_samebase.
-      unfold local, lift1; unfold_lift.
-      intros rho.
       destruct v; simpl; normalize.
-    - apply andp_left1, imp_andp_adjoint, andp_left2.
-      unfold denote_tc_samebase.
-      unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl; normalize.
+    - and_elim_rightmost.
+    - and_elim_rightmost.
   + simpl msubst_denote_tc_assert; simpl denote_tc_assert.
-    apply imp_andp_adjoint.
+    rewrite bi.and_assoc. apply bi.impl_elim_l'.
     destruct (msubst_eval_expr Delta T1 T2 GV e) eqn:?H, (msubst_eval_expr Delta T1 T2 GV e0) eqn:?H.
-    - eapply derives_trans; [apply andp_right; eapply msubst_eval_expr_eq; [exact H | exact H0] |].
-      rewrite <- imp_andp_adjoint.
+    - eapply derives_trans; [apply bi.and_intro; eapply msubst_eval_expr_eq; [exact H | exact H0] |].
+      apply bi.impl_intro_l.
       unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl.
+      raise_rho.
       normalize.
-    - apply andp_left1, imp_andp_adjoint, andp_left2.
+    - and_elim_rightmost.
       unfold denote_tc_nodivover.
-      unfold local, lift1; unfold_lift.
-      intros rho.
-      destruct v; simpl; normalize.
-    - apply andp_left1, imp_andp_adjoint, andp_left2.
-      unfold denote_tc_nodivover.
-      unfold local, lift1; unfold_lift.
-      intros rho.
       destruct v; simpl; normalize.
-    - apply andp_left1, imp_andp_adjoint, andp_left2.
-      unfold denote_tc_nodivover.
-      unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl; normalize.
+    - and_elim_rightmost.
+    - and_elim_rightmost.
   + simpl msubst_denote_tc_assert; simpl denote_tc_assert.
     unfold local, lift1; unfold_lift.
-    intros rho.
-    simpl; normalize.
+    raise_rho.
+    normalize.
   + simpl msubst_denote_tc_assert; simpl denote_tc_assert.
-    apply imp_andp_adjoint.
+    rewrite bi.and_assoc. apply bi.impl_elim_l'.
     destruct (msubst_eval_expr Delta T1 T2 GV e) eqn:?H, (msubst_eval_expr Delta T1 T2 GV e0) eqn:?H.
-    - eapply derives_trans; [apply andp_right; eapply msubst_eval_expr_eq; [exact H | exact H0] |].
-      rewrite <- imp_andp_adjoint.
+    - eapply derives_trans; [apply bi.and_intro; eapply msubst_eval_expr_eq; [exact H | exact H0] |].
+      apply bi.impl_intro_l.
       unfold local, lift1; unfold_lift.
-      intros rho.
-      simpl.
+      raise_rho.
       normalize.
      destruct (typeof e) as [ | _ [ | ] _ | | | | | | | ],
        (typeof e0) as [ | _ [ | ] _ | | | | | | | ]; simpl; normalize.
-    - apply andp_left1, imp_andp_adjoint, andp_left2.
-      unfold denote_tc_samebase.
-      unfold local, lift1; unfold_lift.
-      intros rho.
+    - and_elim_rightmost.
      destruct (typeof e) as [ | _ [ | ] _ | | | | | | | ],
        (typeof e0) as [ | _ [ | ] _ | | | | | | | ],
          v; simpl; normalize.
-    - apply andp_left1, imp_andp_adjoint, andp_left2.
-      unfold denote_tc_samebase.
-      unfold local, lift1; unfold_lift.
-      intros rho.
+    - and_elim_rightmost.
      destruct (typeof e) as [ | _ [ | ] _ | | | | | | | ],
        (typeof e0) as [ | _ [ | ] _ | | | | | | | ],
          v; simpl; normalize.
-    - apply andp_left1, imp_andp_adjoint, andp_left2.
-      unfold denote_tc_samebase.
-      unfold local, lift1; unfold_lift.
-      intros rho.
+    - and_elim_rightmost.
      destruct (typeof e) as [ | _ [ | ] _ | | | | | | | ],
        (typeof e0) as [ | _ [ | ] _ | | | | | | | ];
       simpl; normalize.
@@ -372,70 +288,73 @@ Qed.
 
 End MSUBST_DENOTE_TC_ASSERT.
 
+Section MSUBST_TC.
+Context `{!VSTGS OK_ty Σ}.
 Definition legal_tc_init (Delta: tycontext): tc_assert -> Prop :=
   fix legal_tc_init (tc: tc_assert): Prop :=
   match tc with
   | tc_andp' tc1 tc2 => legal_tc_init tc1 /\ legal_tc_init tc2
   | tc_orp' tc1 tc2 => legal_tc_init tc1 /\ legal_tc_init tc2
-  | tc_initialized i t => (temp_types Delta) ! i = Some t
-  | _ => True
+  | tc_initialized i t => (temp_types Delta) !! i = Some t
+  | _ => True:Prop
   end.
 
 Lemma temp_tc_initialized: forall Delta i t v,
-  (temp_types Delta) ! i = Some t ->
-  local (tc_environ Delta) && local (locald_denote (temp i v))
-    |-- denote_tc_initialized i t.
+  (temp_types Delta) !! i = Some t ->
+  local (tc_environ Delta) ∧ local (locald_denote (temp i v))
+    ⊢ assert_of (denote_tc_initialized i t).
 Proof.
   intros.
-  intros rho.
   unfold local, lift1; simpl; unfold_lift; simpl.
-  normalize.
-  unfold denote_tc_initialized.
-  apply prop_right.
+  raise_rho.
+  iIntros "[%H0 %H1]".
+  iPureIntro.
   destruct H0 as [? _].
   specialize (H0 _ _ H).
-  destruct H0 as [v [? ?]].
+  destruct H0 as [v' [? ?]].
   unfold eval_id, force_val in H1.
-  rewrite H0 in *.
+  rewrite -> H0 in *.
+  destruct H1 as [Hv H1]; subst.
   specialize (H2 H1).
   eauto.
 Qed.
 
 Lemma msubst_simpl_tc_assert_sound: forall {cs: compspecs} Delta P T1 T2 Q R tc,
   legal_tc_init Delta tc ->
-  local (tc_environ Delta) && PROPx P (LOCALx (LocalD T1 T2 Q) (SEPx R)) &&
-    denote_tc_assert (msubst_simpl_tc_assert T1 tc) |--
+  local (tc_environ Delta) ∧ PROPx P (LOCALx (LocalD T1 T2 Q) (SEPx R)) ∧
+    denote_tc_assert (msubst_simpl_tc_assert T1 tc) ⊢
   denote_tc_assert tc.
 Proof.
   intros.
-  induction tc; try solve [apply andp_left2, derives_refl].
+  induction tc; try solve [rewrite bi.and_assoc; apply bi.and_elim_r; apply derives_refl].
   + inversion H.
     simpl msubst_simpl_tc_assert.
+    rewrite denote_tc_assert_andp'.
     rewrite denote_tc_assert_andp.
-    change (denote_tc_assert (tc_andp' tc1 tc2)) with
-      (denote_tc_assert tc1 && denote_tc_assert tc2).
-    apply andp_right.
-    - eapply derives_trans; [| apply IHtc1, H0].
+    apply bi.and_intro.
+    - iIntros "H". iApply (IHtc1 with "[H]"); first done. iStopProof.
+      raise_rho.
       solve_andp.
-    - eapply derives_trans; [| apply IHtc2, H1].
+    - iIntros "H". iApply (IHtc2 with "[H]"); first done. iStopProof.
+      raise_rho.
       solve_andp.
   + inversion H.
     simpl msubst_simpl_tc_assert.
     rewrite denote_tc_assert_orp.
-    change (denote_tc_assert (tc_orp' tc1 tc2)) with
-      (denote_tc_assert tc1 || denote_tc_assert tc2).
-    rewrite (andp_comm (_ && _)).
-    apply imp_andp_adjoint.
-    apply orp_left; apply imp_andp_adjoint; rewrite <- (andp_comm (_ && _)).
-    - eapply derives_trans; [apply IHtc1, H0 | apply orp_right1; auto].
-    - eapply derives_trans; [apply IHtc2, H1 | apply orp_right2; auto].
+    rewrite bi.and_assoc.
+    rewrite bi.and_or_l.
+    apply bi.or_elim; rewrite -bi.and_assoc.
+    - rewrite (IHtc1 H0). raise_rho. simpl. unfold_lift. apply bi.or_intro_l.
+    - rewrite (IHtc2 H1). raise_rho. simpl. unfold_lift. apply bi.or_intro_r.
   + inv H.
     simpl denote_tc_assert.
-    destruct (T1 ! e) eqn:?H; [apply andp_left1 | simpl; intros; apply andp_left2, FF_left].
-    apply (LocalD_sound_temp _ _ _ T2 Q) in H.
-    rewrite (add_andp _ _ (in_local _ _ _ _ _ H)).
-    eapply derives_trans; [| apply (temp_tc_initialized Delta _ _ v); eauto].
-    solve_andp.
+    destruct (T1 !! e) eqn:?H.
+    - rewrite bi.and_assoc; rewrite bi.and_elim_l.
+      apply (LocalD_sound_temp _ _ _ T2 Q) in H.
+      rewrite (add_andp _ _ (in_local _ _ _ _ _ H)).
+      eapply derives_trans; [| apply (temp_tc_initialized Delta _ _ v); eauto].
+      solve_andp.
+    - simpl; intros; rewrite bi.and_assoc; rewrite bi.and_elim_r. raise_rho. apply bi.False_elim. 
 Qed.
 
 Lemma legal_tc_init_tc_bool: forall Delta b err,
@@ -539,7 +458,7 @@ Qed.
 
 Ltac solve_legal_tc_init :=
   repeat progress
-   (simpl; auto;
+   (simpl; auto; unfold typecheck_lvalue; unfold typecheck_expr;
       match goal with
       | |- context [match ?A with _ => _ end] => destruct A eqn:?H
       | |- legal_tc_init _ (tc_bool _ _) => apply legal_tc_init_tc_bool
@@ -618,72 +537,89 @@ Proof.
 Qed.
 
 Lemma msubst_tc_lvalue_sound: forall {cs: compspecs} Delta P T1 T2 GV R e,
-  local (tc_environ Delta) && PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) && ` (msubst_tc_lvalue Delta T1 T2 GV e) |--
+  local (tc_environ Delta) ∧ PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) ∧ (assert_of `(msubst_tc_lvalue Delta T1 T2 GV e)) ⊢
     tc_lvalue Delta e.
 Proof.
   intros.
   eapply derives_trans; [| apply msubst_simpl_tc_assert_sound, typecheck_lvalue_legal_tc_init].
-  apply andp_right; [apply andp_left1; apply derives_refl | ].
+  rewrite [in X in X ⊢ _]bi.and_assoc.
+  rewrite [in X in _ ⊢ X]bi.and_assoc.
+  apply bi.and_intro; [rewrite bi.and_elim_l; apply derives_refl | ].
+  rewrite -bi.and_assoc.
   apply msubst_denote_tc_assert_sound.
 Qed.
 
 Lemma msubst_tc_expr_sound: forall {cs: compspecs} Delta P T1 T2 GV R e,
-  local (tc_environ Delta) && PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) && ` (msubst_tc_expr Delta T1 T2 GV e) |--
+  local (tc_environ Delta) ∧ PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) ∧ (assert_of `(msubst_tc_expr Delta T1 T2 GV e)) ⊢
     tc_expr Delta e.
 Proof.
   intros.
   eapply derives_trans; [| apply msubst_simpl_tc_assert_sound, typecheck_expr_legal_tc_init].
-  apply andp_right; [apply andp_left1; apply derives_refl | ].
+  rewrite [in X in X ⊢ _]bi.and_assoc.
+  rewrite [in X in _ ⊢ X]bi.and_assoc.
+  apply bi.and_intro; [rewrite bi.and_elim_l; apply derives_refl | ].
+  rewrite -bi.and_assoc.
   apply msubst_denote_tc_assert_sound.
 Qed.
 
 Lemma msubst_tc_LR_sound: forall {cs: compspecs} Delta P T1 T2 GV R e lr,
-  local (tc_environ Delta) && PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) && ` (msubst_tc_LR Delta T1 T2 GV e lr) |--
+  local (tc_environ Delta) ∧ PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) ∧ (assert_of `(msubst_tc_LR Delta T1 T2 GV e lr)) ⊢
     tc_LR Delta e lr.
 Proof.
   intros.
   eapply derives_trans; [| apply msubst_simpl_tc_assert_sound, typecheck_LR_legal_tc_init].
-  apply andp_right; [apply andp_left1; apply derives_refl | ].
+  rewrite [in X in X ⊢ _]bi.and_assoc.
+  rewrite [in X in _ ⊢ X]bi.and_assoc.
+  apply bi.and_intro; [rewrite bi.and_elim_l; apply derives_refl | ].
+  rewrite -bi.and_assoc.
   apply msubst_denote_tc_assert_sound.
 Qed.
 
 Lemma msubst_tc_efield_sound: forall {cs: compspecs} Delta P T1 T2 GV R efs,
-  local (tc_environ Delta) && PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) && ` (msubst_tc_efield Delta T1 T2 GV efs) |--
+  local (tc_environ Delta) ∧ PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) ∧ (assert_of `(msubst_tc_efield Delta T1 T2 GV efs)) ⊢
     tc_efield Delta efs.
 Proof.
   intros.
   eapply derives_trans; [| apply msubst_simpl_tc_assert_sound, typecheck_efield_legal_tc_init].
-  apply andp_right; [apply andp_left1; apply derives_refl | ].
+  rewrite [in X in X ⊢ _]bi.and_assoc.
+  rewrite [in X in _ ⊢ X]bi.and_assoc.
+  apply bi.and_intro; [rewrite bi.and_elim_l; apply derives_refl | ].
+  rewrite -bi.and_assoc.
   apply msubst_denote_tc_assert_sound.
 Qed.
 
 Lemma msubst_tc_exprlist_sound: forall {cs: compspecs} Delta P T1 T2 GV R ts es,
-  local (tc_environ Delta) && PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) && ` (msubst_tc_exprlist Delta T1 T2 GV ts es) |--
+  local (tc_environ Delta) ∧ PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) ∧ (assert_of `(msubst_tc_exprlist Delta T1 T2 GV ts es)) ⊢
     tc_exprlist Delta ts es.
 Proof.
   intros.
   eapply derives_trans; [| apply msubst_simpl_tc_assert_sound, typecheck_exprlist_legal_tc_init].
-  apply andp_right; [apply andp_left1; apply derives_refl | ].
+  rewrite [in X in X ⊢ _]bi.and_assoc.
+  rewrite [in X in _ ⊢ X]bi.and_assoc.
+  apply bi.and_intro; [rewrite bi.and_elim_l; apply derives_refl | ].
+  rewrite -bi.and_assoc.
   apply msubst_denote_tc_assert_sound.
 Qed.
 
 Lemma msubst_tc_expropt_sound: forall {cs: compspecs} Delta P T1 T2 GV R t e,
-  local (tc_environ Delta) && PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) && ` (msubst_tc_expropt Delta T1 T2 GV e t) |--
+  local (tc_environ Delta) ∧ PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) ∧ (assert_of `(msubst_tc_expropt Delta T1 T2 GV e t)) ⊢
     tc_expropt Delta e t.
 Proof.
   intros.
   unfold msubst_tc_expropt, msubst_tc_expr, tc_expropt.
   destruct e.
   + eapply derives_trans; [| apply msubst_simpl_tc_assert_sound, typecheck_expr_legal_tc_init].
-    apply andp_right; [apply andp_left1; apply derives_refl | ].
+    rewrite [in X in X ⊢ _]bi.and_assoc.
+    rewrite [in X in _ ⊢ X]bi.and_assoc.
+    apply bi.and_intro; [rewrite bi.and_elim_l; apply derives_refl | ].
+    rewrite -bi.and_assoc.
     apply msubst_denote_tc_assert_sound.
   + destruct (eqb_type t Tvoid) eqn:?H.
     - rewrite eqb_type_spec in H.
       subst.
-      simpl; intro.
-      unfold_lift.
-      normalize.
-    - simpl; intro.
+      iIntros; done.
+    - raise_rho.
       unfold_lift.
       normalize.
 Qed.
+End MSUBST_TC.
diff --git a/floyd/mapsto_memory_block.v b/floyd/mapsto_memory_block.v
index d9522a25b6..f7b7164366 100644
--- a/floyd/mapsto_memory_block.v
+++ b/floyd/mapsto_memory_block.v
@@ -1,9 +1,15 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Import VST.veric.valid_pointer.
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.nested_pred_lemmas.
 
 Import LiftNotation.
-Local Open Scope logic.
+
+Section mpred.
+
+Context `{!heapGS Σ}.
 
 (******************************************
 
@@ -11,21 +17,20 @@ Basic lemmas about local_facts, isptr, offset_zero
 
 ******************************************)
 
-Lemma local_facts_isptr: forall P Q (p: val), (P p |-- !! Q) -> (Q -> isptr p) -> P p = !! (isptr p) && P p.
+Lemma local_facts_isptr: forall (P : val -> mpred) Q (p: val), (P p ⊢ ⌜Q⌝) -> (Q -> isptr p) -> P p ⊣⊢ ⌜isptr p⌝ ∧ P p.
 Proof.
   intros.
-  rewrite andp_comm; apply add_andp.
-  eapply derives_trans; [eassumption |].
-  apply prop_derives; auto.
+  iSplit; last by iIntros "(_ & $)".
+  rewrite comm; iApply add_and.
+  rewrite H; apply bi.pure_mono; done.
 Qed.
 
-Lemma local_facts_offset_zero: forall P, (forall p, P p |-- !! isptr p) -> (forall p, P p = P (offset_val 0 p)).
+Lemma local_facts_offset_zero: forall (P : val -> mpred), (forall p, P p ⊢ ⌜isptr p⌝) -> (forall p, P p ⊣⊢ P (offset_val 0 p)).
 Proof.
   intros.
-  pose proof (H p).
-  pose proof (H Vundef).
-  destruct p; simpl in *; apply pred_ext; normalize.
-all: try solve [eapply derives_trans; [eassumption | normalize]].
+  rewrite (add_andp (P p)); last apply H.
+  rewrite (add_andp (P (offset_val 0 p))); last apply H.
+  destruct p; simpl in *; apply bi.equiv_entails_2; normalize.
 Qed.
 
 (******************************************
@@ -35,38 +40,30 @@ Lemmas about mapsto and mapsto_.
 ******************************************)
 
 Lemma mapsto_local_facts:
-  forall sh t v1 v2,  mapsto sh t v1 v2 |-- !! (isptr v1 /\ tc_val' t v2).
+  forall sh t v1 v2,  mapsto sh t v1 v2 ⊢ ⌜isptr v1 /\ tc_val' t v2⌝.
 Proof.
   intros.
-  rewrite prop_and.
-  apply andp_right.
-  + unfold mapsto.
-    destruct (access_mode t); try apply FF_left.
-    destruct (type_is_volatile t); try apply FF_left.
-    destruct v1; try apply FF_left.
-    apply prop_right; split; auto; apply Coq.Init.Logic.I.
-  + apply mapsto_tc_val'.
+  iIntros "H"; iSplit.
+  + by iDestruct (mapsto_pure_facts with "H") as %(_ & ?).
+  + by iApply mapsto_tc_val'.
 Qed.
 
 Lemma mapsto__local_facts:
-  forall sh t v1, mapsto_ sh t v1 |-- !! isptr v1.
+  forall sh t v1, mapsto_ sh t v1 ⊢ ⌜isptr v1⌝.
 Proof.
   intros.
-  eapply derives_trans; [apply mapsto_local_facts |].
-  apply prop_derives; tauto.
+  rewrite /mapsto_ mapsto_local_facts.
+  by iIntros ((? & ?)).
 Qed.
-#[export] Hint Resolve mapsto_local_facts mapsto__local_facts : saturate_local.
 
 Lemma mapsto_offset_zero:
   forall sh t v1 v2, mapsto sh t v1 v2 = mapsto sh t (offset_val 0 v1) v2.
 Proof.
   intros.
-  change (mapsto sh t (offset_val 0 v1) v2) with ((fun v0 => mapsto sh t v0 v2) (offset_val 0 v1)).
-  rewrite <- local_facts_offset_zero.
-  reflexivity.
-  intros.
-  eapply derives_trans; [  apply mapsto_local_facts | ].
-  normalize.
+  unfold mapsto.
+  destruct (access_mode t), (type_is_volatile t); auto.
+  destruct v1; auto.
+  rewrite isptr_offset_val_zero //.
 Qed.
 
 Lemma mapsto__offset_zero:
@@ -77,21 +74,19 @@ Proof.
   apply mapsto_offset_zero.
 Qed.
 
-Lemma mapsto_isptr: forall sh t v1 v2, mapsto sh t v1 v2 = !! (isptr v1) && mapsto sh t v1 v2.
+Lemma mapsto_isptr: forall sh t v1 v2, mapsto sh t v1 v2 = (⌜isptr v1⌝ ∧ mapsto sh t v1 v2).
 Proof.
   intros.
-  change (mapsto sh t v1 v2) with ((fun v1 => mapsto sh t v1 v2) v1).
-  eapply local_facts_isptr.
-  + apply mapsto_local_facts.
-  + tauto.
+  unfold mapsto.
+  destruct (access_mode t); try by rewrite log_normalize.and_False.
+  destruct (type_is_volatile t); try by rewrite log_normalize.and_False.
+  destruct v1; try by rewrite log_normalize.and_False.
+  rewrite (prop_true_andp (isptr _)) //.
 Qed.
 
-Lemma mapsto__isptr: forall sh t v1, mapsto_ sh t v1 = !! (isptr v1) && mapsto_ sh t v1.
+Lemma mapsto__isptr: forall sh t v1, mapsto_ sh t v1 = (⌜isptr v1⌝ ∧ mapsto_ sh t v1).
 Proof.
-  intros.
-  eapply local_facts_isptr.
-  + apply mapsto_local_facts.
-  + tauto.
+  intros; apply mapsto_isptr.
 Qed.
 
 (******************************************
@@ -100,9 +95,7 @@ Lemmas about memory_block
 
 ******************************************)
 
-#[export] Hint Rewrite memory_block_zero_Vptr: norm.
-
-Definition size_compatible' (n: Z) (p: val) :=
+Definition size_compatible' (n: Z) (p: val) : Prop :=
 match p with
 | Vundef => True
 | Vint _ => True
@@ -113,49 +106,43 @@ match p with
 end.
 
 Lemma memory_block_local_facts: forall sh n p, 
-  memory_block sh n p |-- !! (isptr p /\ size_compatible' n p).
+  memory_block sh n p ⊢ ⌜isptr p /\ size_compatible' n p⌝.
 Proof.
   intros.
-   unfold memory_block.
-  destruct p; simpl; normalize. apply prop_right;split; auto.
+  unfold memory_block.
+  destruct p; simpl; normalize.
 Qed.
 
-#[export] Hint Resolve memory_block_local_facts : saturate_local.
-
 Lemma memory_block_offset_zero:
   forall sh n v, memory_block sh n v = memory_block sh n (offset_val 0 v).
 Proof.
   intros.
-  rewrite <- local_facts_offset_zero.
-  reflexivity.
-  intro. eapply derives_trans;[ apply memory_block_local_facts | ]. normalize.
+  unfold memory_block.
+  destruct v; try done.
+  rewrite isptr_offset_val_zero //.
 Qed.
 
-Lemma memory_block_isptr: forall sh n p, memory_block sh n p = !!(isptr p) && memory_block sh n p.
+Lemma memory_block_isptr: forall sh n p, memory_block sh n p = (⌜isptr p⌝ ∧ memory_block sh n p).
 Proof.
   intros.
-  eapply local_facts_isptr.
-  + apply memory_block_local_facts.
-  + intuition.
+  unfold memory_block.
+  destruct p; try by rewrite log_normalize.and_False.
+  rewrite (prop_true_andp (isptr _)) //.
 Qed.
 
-Lemma memory_block_zero: forall sh p, memory_block sh 0 p = !! isptr p && emp.
+Lemma memory_block_zero: forall sh p, memory_block sh 0 p = (⌜isptr p⌝ ∧ emp).
 Proof.
   intros.
   rewrite memory_block_isptr.
   destruct p;
-  try rewrite memory_block_zero_Vptr;
-  simpl;
-  change (!!False) with FF;
-  repeat rewrite FF_andp;
-  auto.
+  try rewrite memory_block_zero_Vptr //; try rewrite !log_normalize.False_and //.
 Qed.
 
 Lemma access_mode_by_value: forall t, type_is_by_value t = true -> exists ch, access_mode t = By_value ch.
 Proof.
   intros.
   assert (forall ch', exists ch, By_value ch' = By_value ch).
-    intros. exists ch'. reflexivity.
+  { intros. exists ch'. reflexivity. }
   destruct t; inversion H; simpl.
   - destruct i, s; apply H0.
   - apply H0.
@@ -163,13 +150,11 @@ Proof.
   - apply H0.
 Qed.
 
-Lemma mapsto_by_value: forall sh t p v, mapsto sh t p v = !! (type_is_by_value t = true) && mapsto sh t p v.
+Lemma mapsto_by_value: forall sh t p v, mapsto sh t p v = (⌜type_is_by_value t = true⌝ ∧ mapsto sh t p v).
 Proof.
   intros.
-  apply pred_ext; normalize.
-  apply andp_right; [|cancel].
   unfold mapsto.
-  destruct t; simpl; normalize; try (apply prop_right; auto).
+  destruct t; simpl; try rewrite log_normalize.and_False //; try normalize.
 Qed.
 
 (******************************************
@@ -188,7 +173,7 @@ Lemma memory_block_mapsto_:
    type_is_volatile t = false ->
    size_compatible t p ->
    align_compatible t p ->
-   memory_block sh (sizeof t) p = mapsto_ sh t p.
+   memory_block sh (sizeof t) p ⊣⊢ mapsto_ sh t p.
 Proof.
   intros.
   assert (isptr p \/ ~isptr p) by (destruct p; simpl; auto).
@@ -196,10 +181,12 @@ Proof.
   + simpl in H1, H2.
     destruct (access_mode_by_value _ H) as [ch ?].
     unfold expr.sizeof, Ctypes.sizeof in *; erewrite size_chunk_sizeof in H1 |- * by eauto.
-    rewrite mapsto_memory_block.mapsto__memory_block with (ch := ch); auto.
+    rewrite mapsto_memory_block.mapsto__memory_block //.
     eapply align_compatible_rec_by_value_inv in H2; [| eassumption].
     auto.
-  + apply pred_ext; saturate_local; try contradiction.
+  + apply bi.equiv_entails_2.
+    * rewrite memory_block_isptr bi.pure_False //; iIntros "([] & _)".
+    * rewrite mapsto__local_facts bi.pure_False //; iIntros "[]".
 Qed.
 
 Lemma nonreadable_memory_block_mapsto: forall sh p t v,
@@ -209,61 +196,38 @@ Lemma nonreadable_memory_block_mapsto: forall sh p t v,
   size_compatible t p ->
   align_compatible t p ->
   tc_val' t v ->
-  memory_block sh (sizeof t) p = mapsto sh t p v.
+  memory_block sh (sizeof t) p ⊣⊢ mapsto sh t p v.
 Proof.
   intros.
   apply access_mode_by_value in H0; destruct H0 as [ch ?].
-  assert (isptr p \/ ~isptr p) by (destruct p; simpl; auto).
-  destruct H5. destruct p; try contradiction.
+  assert (isptr p \/ ~isptr p) as [|] by (destruct p; simpl; auto).
+  destruct p; try contradiction.
   + simpl in H2, H3.
     unfold expr.sizeof in *.
     erewrite size_chunk_sizeof in H2 |- * by eauto.
     apply mapsto_memory_block.nonreadable_memory_block_mapsto; auto.
     eapply align_compatible_rec_by_value_inv in H3; [| eassumption].
     auto.
-  + apply pred_ext; saturate_local; try contradiction.
+  + apply bi.equiv_entails_2.
+    * rewrite memory_block_isptr bi.pure_False //; iIntros "([] & _)".
+    * rewrite mapsto_isptr bi.pure_False //; iIntros "([] & _)".
 Qed.
 
 Lemma memory_block_size_compatible:
   forall sh t p,
-  memory_block sh (sizeof t) p = 
-  !! (size_compatible t p) && memory_block sh (sizeof t) p.
+  memory_block sh (sizeof t) p =
+  (⌜size_compatible t p⌝ ∧ memory_block sh (sizeof t) p).
 Proof.
   intros.
   unfold memory_block, size_compatible.
-  apply pred_ext; destruct p; normalize.
+  destruct p; simpl; try by rewrite log_normalize.True_and.
+  normalize; f_equal; f_equal; apply prop_ext; tauto.
 Qed.
 
 Global Opaque memory_block.
 
 End COMPSPECS.
 
-(******************************************
-
-Lemmas about specific types
-
-******************************************)
-
-(* We do these as Hint Extern, instead of Hint Resolve,
-  to limit their application and make them fail faster *)
-
-#[export] Hint Extern 1 (mapsto _ _ _ _ |-- mapsto _ _ _ _) =>
-   (simple apply mapsto_mapsto_int32; apply Coq.Init.Logic.I)  : cancel.
-
-#[export] Hint Extern 1 (mapsto _ _ _ _ |-- mapsto_ _ _ _) =>
-   (simple apply mapsto_mapsto__int32; apply Coq.Init.Logic.I)  : cancel.
-
-#[export] Hint Extern 1 (mapsto _ _ _ _ |-- mapsto_ _ _ _) =>
-    (apply mapsto_mapsto_) : cancel.
-
-#[export] Hint Extern 1 (mapsto _ _ _ _ |-- mapsto_ _ _ _) =>
-   (apply mapsto_mapsto__int32)  : cancel.
-
-#[export] Hint Extern 1 (mapsto _ _ _ _ |-- mapsto _ _ _ _) =>
-   (apply mapsto_mapsto_int32)  : cancel.
-
-#[export] Hint Extern 0 (legal_alignas_type _ = true) => reflexivity : cancel.
-
 Lemma mapsto_force_ptr: forall sh t v v',
   mapsto sh t (force_ptr v) v' = mapsto sh t v v'.
 Proof.
@@ -271,8 +235,6 @@ intros.
 destruct v; simpl; auto.
 Qed.
 
-#[export] Hint Rewrite mapsto_force_ptr: norm.
-
 (******************************************
 
 Definition of at_offset.
@@ -293,11 +255,10 @@ intros; auto.
 Qed.
 
 Lemma lifted_at_offset_eq: forall (P: val -> mpred) z v,
-  `(at_offset P z) v = `P (`(offset_val z) v).
+  assert_of (`(at_offset P z) v) = assert_of (`P (`(offset_val z) v)).
 Proof.
   intros.
-  unfold liftx, lift in *. simpl in *.
-  extensionality p.
+  apply assert_ext; intros; unfold_lift.
   apply at_offset_eq.
 Qed.
 
@@ -323,7 +284,7 @@ Proof.
   reflexivity.
 Qed.
 
-Lemma at_offset_derives: forall P Q p , (forall p, P p |-- Q p) -> forall pos, at_offset P pos p |-- at_offset Q pos p.
+Lemma at_offset_derives: forall P Q p , (forall p, P p ⊢ Q p) -> forall pos, at_offset P pos p ⊢ at_offset Q pos p.
 Proof.
   intros.
   rewrite !at_offset_eq.
@@ -349,29 +310,33 @@ Definition spacer (sh: share) (be: Z) (ed: Z) : val -> mpred :=
 Definition withspacer sh (be: Z) (ed: Z) P (p: val): mpred :=
    if Z.eq_dec (ed - be) 0
    then P p
-   else P p * spacer sh be ed p.
+   else P p ∗ spacer sh be ed p.
 
 Lemma withspacer_spacer: forall sh be ed P p,
-   withspacer sh be ed P p = spacer sh be ed p * P p.
+   withspacer sh be ed P p = (spacer sh be ed p ∗ P p).
 Proof.
   intros.
   unfold withspacer, spacer.
   if_tac.
-  + normalize.
-  + simpl; apply sepcon_comm.
+  + rewrite emp_sep //.
+  + rewrite sep_comm //.
+Qed.
+
+Global Instance withspacer_proper: Proper (eq ==> eq ==> eq ==> pointwise_relation _ equiv ==> eq ==> equiv) withspacer.
+Proof.
+  intros ?? -> ?? -> ?? -> ?? H ?? ->.
+  rewrite !withspacer_spacer H //.
 Qed.
 
 Lemma withspacer_ramif_Q: forall sh be ed P p,
-  withspacer sh be ed P p |-- P p *
-    allp ((fun Q => Q p) -* (fun Q => withspacer sh be ed Q p)).
+  withspacer sh be ed P p ⊢ P p ∗
+    ∀ Q, Q p -∗ withspacer sh be ed Q p.
 Proof.
   intros.
-  apply RAMIF_Q.solve with (spacer sh be ed p).
-  + rewrite withspacer_spacer.
-    cancel.
-  + intros.
-    rewrite withspacer_spacer.
-    cancel.
+  rewrite withspacer_spacer.
+  iIntros "(? & $)" (?) "?".
+  rewrite withspacer_spacer.
+  iFrame.
 Qed.
 
 Lemma spacer_offset_zero:
@@ -381,7 +346,7 @@ Proof.
   unfold spacer.
   destruct (Z.eq_dec (ed - be) 0);  auto.
   repeat rewrite at_offset_eq;
-  try rewrite offset_offset_val; try  rewrite Int.add_zero_l; auto.
+  try rewrite offset_offset_val; try rewrite Int.add_zero_l; auto.
 Qed.
 
 Lemma withspacer_add:
@@ -404,28 +369,26 @@ Proof.
   reflexivity.
 Qed.
 
-Lemma offset_val_preserve_isptr: forall p pos, !! (isptr (offset_val pos p)) |-- !! (isptr p).
+Lemma offset_val_preserve_isptr: forall p pos, (⌜isptr (offset_val pos p)⌝ : mpred) ⊢ ⌜isptr p⌝.
 Proof.
   intros.
-  destruct p; simpl; apply derives_refl.
+  destruct p; simpl; done.
 Qed.
 
-Lemma at_offset_preserve_local_facts: forall P pos, (forall p, P p |-- !!(isptr p)) -> (forall p, at_offset P pos p |-- !!(isptr p)).
+Lemma at_offset_preserve_local_facts: forall P pos, (forall p, P p ⊢ ⌜isptr p⌝) -> (forall p, at_offset P pos p ⊢ ⌜isptr p⌝).
 Proof.
   intros.
   rewrite at_offset_eq.
   specialize (H (offset_val pos p)).
-  eapply derives_trans; [exact H |].
+  rewrite H.
   apply offset_val_preserve_isptr.
 Qed.
 
-Lemma withspacer_preserve_local_facts: forall sh be ed P, (forall p, P p |-- !! (isptr p)) -> (forall p, withspacer sh be ed P p |-- !! (isptr p)).
+Lemma withspacer_preserve_local_facts: forall sh be ed P, (forall p, P p ⊢ ⌜isptr p⌝) -> (forall p, withspacer sh be ed P p ⊢ ⌜isptr p⌝).
 Proof.
   intros.
   rewrite withspacer_spacer.
-  simpl; rewrite sepcon_comm.
-  apply (derives_left_sepcon_right_corable (!!isptr p) (P p) _); [apply corable_prop|].
-  apply H.
+  rewrite H; iIntros "(_ & $)".
 Qed.
 
 Transparent memory_block.
@@ -448,21 +411,54 @@ Lemma spacer_sepcon_memory_block: forall sh ofs lo hi b i,
   0 <= ofs ->
   lo <= hi < Ptrofs.modulus ->
   Ptrofs.unsigned i + ofs + hi < Ptrofs.modulus ->
-  spacer sh (ofs + lo) (ofs + hi) (Vptr b i) * memory_block sh lo (offset_val ofs (Vptr b i)) = memory_block sh hi (offset_val ofs (Vptr b i)).
+  spacer sh (ofs + lo) (ofs + hi) (Vptr b i) ∗ memory_block sh lo (offset_val ofs (Vptr b i)) ⊣⊢ memory_block sh hi (offset_val ofs (Vptr b i)).
 Proof.
   intros.
-  rewrite spacer_memory_block by (simpl; auto).
+  rewrite -> spacer_memory_block by (simpl; auto).
   simpl offset_val.
   inv_int i.
   rewrite !ptrofs_add_repr.
-  rewrite sepcon_comm, Z.add_assoc, <- memory_block_split by lia.
-  f_equal.
+  rewrite bi.sep_comm Z.add_assoc -memory_block_split; [|lia..].
+  f_equiv; hnf.
   lia.
 Qed.
 
-#[export] Hint Rewrite at_offset_eq3 : at_offset_db.
-#[export] Hint Rewrite withspacer_spacer : at_offset_db.
-#[export] Hint Rewrite spacer_memory_block using (simpl; auto): at_offset_db.
+End mpred.
 
-Opaque memory_block.
+#[export] Hint Resolve mapsto_local_facts mapsto__local_facts : saturate_local.
+#[export] Hint Rewrite @memory_block_zero_Vptr: norm.
+#[export] Hint Resolve memory_block_local_facts : saturate_local.
+
+(******************************************
+
+Lemmas about specific types
+
+******************************************)
+
+(* We do these as Hint Extern, instead of Hint Resolve,
+  to limit their application and make them fail faster *)
 
+#[export] Hint Extern 1 (mapsto _ _ _ _ ⊢ mapsto _ _ _ _) =>
+   (simple apply mapsto_mapsto_int32; apply Coq.Init.Logic.I)  : cancel.
+
+#[export] Hint Extern 1 (mapsto _ _ _ _ ⊢ mapsto_ _ _ _) =>
+   (simple apply mapsto_mapsto__int32; apply Coq.Init.Logic.I)  : cancel.
+
+#[export] Hint Extern 1 (mapsto _ _ _ _ ⊢ mapsto_ _ _ _) =>
+    (apply mapsto_mapsto_) : cancel.
+
+#[export] Hint Extern 1 (mapsto _ _ _ _ ⊢ mapsto_ _ _ _) =>
+   (apply mapsto_mapsto__int32)  : cancel.
+
+#[export] Hint Extern 1 (mapsto _ _ _ _ ⊢ mapsto _ _ _ _) =>
+   (apply mapsto_mapsto_int32)  : cancel.
+
+#[export] Hint Extern 0 (legal_alignas_type _ = true) => reflexivity : cancel.
+
+#[export] Hint Rewrite @mapsto_force_ptr: norm.
+
+#[export] Hint Rewrite @at_offset_eq3 : at_offset_db.
+#[export] Hint Rewrite @withspacer_spacer : at_offset_db.
+#[export] Hint Rewrite @spacer_memory_block using (simpl; auto): at_offset_db.
+
+Opaque memory_block.
diff --git a/floyd/measure.v b/floyd/measure.v
deleted file mode 100644
index a92367be12..0000000000
--- a/floyd/measure.v
+++ /dev/null
@@ -1,64 +0,0 @@
-
-Definition size_is (n: Z) : Prop := False.
-
-Lemma assert_size_is_Type (n: Z) :
-  forall (A: Type), size_is n -> A.
-Proof.
-intros. exfalso; apply H.
-Qed.
-
-Lemma assert_size_is_Prop (n: Z) :
-  forall (A: Prop), size_is n -> A.
-Proof.
-intros. exfalso; apply H.
-Qed.
-
-Opaque size_is.
-
-
-Ltac composite i :=
-  match i with
-  | _ _ => idtac
-  | (fun _ => _) => idtac
-  end.
-
-Ltac primary i := try (composite i; fail 1).
-
-Ltac count_one :=
-match goal with
-|  H := ?t |- _ =>
-     primary t;
-     clear H
-| H := fun x : ?t => _ |- size_is ?n  =>
-        let y := fresh "y" in
-         assert (y:t) by admit;
-         let H1 := fresh in pose (H1 := H y);
-          unfold H in H1; clear H;
-       change (size_is (Z.succ n)); compute
-|  H := ?t1 ?t2 |- size_is ?n =>
-      first [ primary t2;
-              let H1 := fresh in pose (H1:=t1);
-               first [clear H | clearbody H];
-               change (size_is (Z.succ n)); compute
-             | primary t1;
-              let H2 := fresh in pose (H2:=t2);
-               first [clear H | clearbody H];
-               change (size_is (Z.succ n)); compute
-             | composite t1;
-              let H1 := fresh in pose (H1:=t1);
-              change (t1 t2) with (H1 t2) in H
-             | composite t2;
-               let H2 := fresh in pose (H2 := t2);
-               first [clear H | clearbody H];
-               change (size_is (Z.succ n)); compute
-             | first [clear H | clearbody H];
-               change (size_is (Z.succ n)); compute
-              ]
-end.
-
-Ltac goal_size :=
-match goal with |- ?A =>
-  let H := fresh in set (H:=A);
-  first [apply (assert_size_is_Type 0) | apply (assert_size_is_Prop 0)];
-  repeat count_one
-end.
\ No newline at end of file
diff --git a/floyd/nested_field_lemmas.v b/floyd/nested_field_lemmas.v
index 081ab8977a..9e6098ccc3 100644
--- a/floyd/nested_field_lemmas.v
+++ b/floyd/nested_field_lemmas.v
@@ -1,12 +1,15 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.fieldlist.
 Require Import VST.floyd.type_induction.
 Require Import VST.floyd.nested_pred_lemmas.
 Require Import VST.floyd.align_compatible_dec.
-Import compcert.lib.Maps.
 Open Scope Z.
 
+Local Unset SsrRewrite.
+
 (************************************************
 
 Definition of nested_field_type2, nested_field_offset2
@@ -144,7 +147,7 @@ Definition nested_field_type (t: type) (gfs: list gfield) : type :=
 Definition nested_field_array_type t gfs lo hi :=
   Tarray (nested_field_type t (ArraySubsc 0 :: gfs)) (hi - lo) (no_alignas_attr (attr_of_type (nested_field_type t gfs))).
 
-Definition legal_field t gf :=
+Definition legal_field t gf : Prop :=
   match t, gf with
   | Tarray _ n _, ArraySubsc i => 0 <= i < n
   | Tstruct id _, StructField i => in_members i (co_members (get_co id))
@@ -152,7 +155,7 @@ Definition legal_field t gf :=
   | _, _ => False
   end.
 
-Definition legal_field0 t gf :=
+Definition legal_field0 t gf : Prop :=
   match t, gf with
   | Tarray _ n _, ArraySubsc i => 0 <= i <= n
   | Tstruct id _, StructField i => in_members i (co_members (get_co id))
@@ -166,7 +169,7 @@ Fixpoint legal_nested_field (t: type) (gfs: list gfield) : Prop :=
   | gf :: gfs0 => legal_nested_field t gfs0 /\ legal_field (nested_field_type t gfs0) gf
   end.
 
-Definition legal_nested_field0 t gfs :=
+Definition legal_nested_field0 t gfs : Prop :=
   match gfs with
   | nil => True
   | gf :: gfs0 => legal_nested_field t gfs0 /\ legal_field0 (nested_field_type t gfs0) gf
@@ -180,10 +183,10 @@ Fixpoint compute_legal_nested_field (t: type) (gfs: list gfield) : list Prop :=
     | Tarray _ n _, ArraySubsc i =>
        (0 <= i < n) :: compute_legal_nested_field t gfs0
     | Tstruct id _, StructField i =>
-       if compute_in_members i (co_members (get_co id)) then compute_legal_nested_field t gfs0 else False :: nil
+       if compute_in_members i (co_members (get_co id)) then compute_legal_nested_field t gfs0 else False%type :: nil
     | Tunion id _, UnionField i =>
-       if compute_in_members i (co_members (get_co id)) then compute_legal_nested_field t gfs0 else False :: nil
-    | _, _ => False :: nil
+       if compute_in_members i (co_members (get_co id)) then compute_legal_nested_field t gfs0 else False%type :: nil
+    | _, _ => False%type :: nil
     end
   end.
 
@@ -668,7 +671,7 @@ Proof.
   intros.
   destruct t as [| | | | | | | id ? | id ?], gf; auto;
   unfold gfield_type in *; simpl in H, H0; unfold get_co in *.
-  + destruct (cenv_cs ! id) eqn:?H; [| inv H0].
+  + destruct (cenv_cs !! id) eqn:?H; [| inv H0].
     pose proof cenv_legal_su _ _ H1.
     unfold in_members in H.
     induction (co_members c) as [| [i0 t0|] ?].
@@ -684,7 +687,7 @@ Proof.
       apply IHm; auto. 
       destruct H; auto; congruence.
      simpl in H0. destruct (co_su c); try discriminate.
-  + destruct (cenv_cs ! id) eqn:?H; [| inv H0].
+  + destruct (cenv_cs !! id) eqn:?H; [| inv H0].
     pose proof cenv_legal_su _ _ H1.
     unfold in_members in H.
     induction (co_members c) as [| [i0 t0|] ?].
@@ -921,23 +924,23 @@ Qed.
 Lemma complete_legal_cosu_type_Tstruct_get_co:
   forall id a,
    complete_legal_cosu_type (Tstruct id a) = true ->
-    cenv_cs ! id = Some (get_co id).
+    cenv_cs !! id = Some (get_co id).
 Proof.
 intros.
  simpl in H.
  unfold get_co.
- destruct (cenv_cs ! id); try discriminate. auto.
+ destruct (cenv_cs !! id); try discriminate. auto.
 Qed.
 
 Lemma complete_legal_cosu_type_Tunion_get_co:
   forall id a,
    complete_legal_cosu_type (Tunion id a) = true ->
-    cenv_cs ! id = Some (get_co id).
+    cenv_cs !! id = Some (get_co id).
 Proof.
 intros.
  simpl in H.
  unfold get_co.
- destruct (cenv_cs ! id); try discriminate. auto.
+ destruct (cenv_cs !! id); try discriminate. auto.
 Qed.
 
 Lemma sizeof_Tstruct_co_sizeof:
@@ -948,7 +951,7 @@ Lemma sizeof_Tstruct_co_sizeof:
 Proof.
  intros.
  simpl in H.
- destruct (cenv_cs ! id) eqn:?H; try discriminate.
+ destruct (cenv_cs !! id) eqn:?H; try discriminate.
  destruct (co_su c) eqn:?H; try discriminate.
  assert (sizeof_struct cenv_cs 0 (co_members (get_co id)) <= co_sizeof (get_co id)).
  rewrite co_consistent_sizeof with (env := cenv_cs) by apply get_co_consistent.
@@ -967,7 +970,7 @@ Lemma sizeof_Tunion_co_sizeof:
 Proof.
  intros.
  simpl in H.
- destruct (cenv_cs ! id) eqn:?H; try discriminate.
+ destruct (cenv_cs !! id) eqn:?H; try discriminate.
  destruct (co_su c) eqn:?H; try discriminate.
    assert (sizeof_union cenv_cs (co_members (get_co id)) <= co_sizeof (get_co id)).
         rewrite co_consistent_sizeof with (env := cenv_cs) by apply get_co_consistent.
diff --git a/floyd/nested_loadstore.v b/floyd/nested_loadstore.v
index cd3666ba72..58252267dc 100644
--- a/floyd/nested_loadstore.v
+++ b/floyd/nested_loadstore.v
@@ -1,5 +1,6 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
-
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.nested_field_lemmas.
 Require Import VST.floyd.efield_lemmas.
@@ -7,20 +8,17 @@ Require Import VST.floyd.mapsto_memory_block.
 Require Import VST.floyd.reptype_lemmas.
 Require Import VST.floyd.data_at_rec_lemmas.
 Require Import VST.floyd.field_at.
-Require Import VST.floyd.stronger.
 Require Import VST.floyd.entailer.
 Require Import VST.floyd.closed_lemmas.
 Require Import VST.floyd.proj_reptype_lemmas.
 Require Import VST.floyd.replace_refill_reptype_lemmas.
 Require Import VST.floyd.loadstore_field_at.
-Import DataCmpNotations.
+(* Import DataCmpNotations. *)
 Import LiftNotation.
 
-Local Open Scope logic.
-
 Section NESTED_RAMIF.
 
-Context {cs: compspecs}.
+Context `{!VSTGS OK_ty Σ} {cs: compspecs}.
 
 Lemma reptype_Tarray_JMeq_constr0: forall t gfs t0 n a (v: reptype (nested_field_type t gfs)),
   legal_nested_field t gfs ->
@@ -30,7 +28,7 @@ Lemma reptype_Tarray_JMeq_constr0: forall t gfs t0 n a (v: reptype (nested_field
 Proof.
   intros.
   apply JMeq_sigT.
-  rewrite @nested_field_type_ind with (gfs := cons _ _).
+  rewrite ->@nested_field_type_ind with (gfs := cons _ _).
   rewrite !H0.
   rewrite reptype_eq.
   auto.
@@ -44,7 +42,7 @@ Lemma reptype_Tarray_JMeq_constr1: forall t gfs t0 n a i (v: reptype (nested_fie
 Proof.
   intros.
   apply JMeq_sigT.
-  rewrite @nested_field_type_ind with (gfs := cons _ _).
+  rewrite ->@nested_field_type_ind with (gfs := cons _ _).
   reflexivity.
 Qed.
 
@@ -56,7 +54,7 @@ Lemma reptype_Tarray_JMeq_constr2: forall t gfs t0 n a i (v': reptype (nested_fi
 Proof.
   intros.
   apply JMeq_sigT.
-  rewrite @nested_field_type_ArraySubsc with (i := i).
+  rewrite ->@nested_field_type_ArraySubsc with (i := i).
   auto.
 Qed.
 
@@ -107,6 +105,10 @@ Proof.
   apply JMeq_eq in H. auto.
 Qed.
 
+Ltac rewrite_field_at_type_changeable :=
+  match goal with | |- field_at ?sh ?t1 ?g1 ?v1 = field_at ?sh ?t2 ?g2 ?v2 =>
+  rewrite (field_at_type_changeable sh t1 t2 _ g1 g2 _ v1 v2) // end.
+
 Lemma JMeq_field_type_name_member {CS: compspecs} i m :
   forall a, JMeq (@field_type_name_member CS i m a) a.
 Proof.
@@ -121,9 +123,9 @@ Qed.
 Lemma gfield_ramif: forall sh t gfs gf v v0 p,
   JMeq (proj_gfield_reptype (nested_field_type t gfs) gf v) v0 ->
   field_compatible t (gf :: gfs) p ->
-  field_at sh t gfs v p |-- field_at sh t (gf :: gfs) v0 p *
-    (ALL v0': _,
-      (field_at sh t (gf :: gfs) v0' p -*
+  field_at sh t gfs v p ⊢ field_at sh t (gf :: gfs) v0 p ∗
+    (∀ v0': _,
+      (field_at sh t (gf :: gfs) v0' p -∗
          field_at sh t gfs
            (upd_gfield_reptype (nested_field_type t gfs) gf v
               (eq_rect_r reptype v0' (eq_sym (nested_field_type_ind t _))))
@@ -140,30 +142,30 @@ Proof.
     destruct H1.
     destruct (reptype_Tarray_JMeq_constr0 t gfs t0 z a v) as [v' ?H]; auto.
     erewrite field_at_Tarray; [| eauto | eauto | lia | eauto].
-    replace
-      (ALL  v0' : _,
-        field_at sh t (gfs SUB i) v0' p -*
+    assert(Hrrt:
+      (∀ v0' : _,
+        field_at sh t (gfs SUB i) v0' p -∗
         field_at sh t gfs
           (upd_gfield_reptype (nested_field_type t gfs)
              (ArraySubsc i) v
              (eq_rect_r reptype v0'
                 (eq_sym (nested_field_type_ind t (gfs SUB i))))) p)
-    with
-      (ALL  v0' : _, (ALL  v0'': _,
-        !!JMeq v0' v0'' -->
-        (field_at sh t (gfs SUB i) v0' p -*
-         array_at sh t gfs 0 z (upd_Znth (i - 0) v' v0'') p))).
-    2:{
+      ⊣⊢
+      (∀ v0' : _, (∀  v0'': _,
+        ⌜JMeq v0' v0''⌝ →
+        (field_at sh t (gfs SUB i) v0' p -∗
+         array_at sh t gfs 0 z (upd_Znth (i - 0) v' v0'') p)))).
+    {
       rewrite Z.sub_0_r.
       clear v0 H.
-      apply pred_ext.
-      + apply allp_right; intro v0.
-        apply (allp_left _ v0).
-        destruct (reptype_Tarray_JMeq_constr2 t gfs t0 z a i v0) as [v0' ?H]; auto.
-        apply (allp_left _ v0').
-        rewrite prop_imp by auto.
-        apply wand_derives; auto.
+      apply bi.equiv_entails_2.
+      + apply bi.forall_mono; intro v0.
+        apply bi.forall_intro => v0'.
+        apply bi.impl_intro_l; normalize.
+        apply bi.wand_mono; auto.
+        destruct (reptype_Tarray_JMeq_constr1 t gfs t0 z a i v0) as [v0'' ?H]; auto.
         erewrite field_at_Tarray; [apply derives_refl | eauto | eauto | lia |].
+        clear v0'' H5.
         set (v0'' := eq_rect_r reptype v0 (eq_sym (nested_field_type_ind t (gfs SUB i)))).
         assert (JMeq v0' v0'') by (apply JMeq_sym; eapply JMeq_trans; [apply eq_rect_r_JMeq | auto]).
         clearbody v0''; clear v0 H.
@@ -171,17 +173,16 @@ Proof.
         unfold upd_gfield_reptype.
         eapply JMeq_trans; [apply fold_reptype_JMeq |].
         apply (JMeq_trans (unfold_reptype_JMeq _ v)) in H4.
-        revert v' v0' H4 H5; rewrite @nested_field_type_ind with (gfs := cons _ _), H2; simpl; intros.
+        revert v' v0' H4 H5; rewrite ->@nested_field_type_ind with (gfs := cons _ _), H2; simpl; intros.
         apply JMeq_eq in H4; apply JMeq_eq in H5.
         subst; apply JMeq_refl.
-      + apply allp_right; intro v0.
-        apply allp_right; intro v0'.
-        apply (allp_left _ v0).
-        apply imp_andp_adjoint; normalize.
-        apply wand_derives; auto.
-        destruct (reptype_Tarray_JMeq_constr1 t gfs t0 z a i v0) as [v0'' ?H]; auto.
+      + apply bi.forall_intro; intro v0.
+        rewrite (bi.forall_elim v0).
+        destruct (reptype_Tarray_JMeq_constr2 t gfs t0 z a i v0) as [v0' ?H]; auto.
+        rewrite (bi.forall_elim v0').
+        rewrite ->prop_imp by auto.
+        apply bi.wand_mono; auto.
         erewrite field_at_Tarray; [apply derives_refl | eauto | eauto | lia |].
-        clear v0'' H5.
         set (v0'' := eq_rect_r reptype v0 (eq_sym (nested_field_type_ind t (gfs SUB i)))).
         assert (JMeq v0' v0'') by (apply JMeq_sym; eapply JMeq_trans; [apply eq_rect_r_JMeq | auto]).
         clearbody v0''; clear v0 H.
@@ -189,14 +190,15 @@ Proof.
         unfold upd_gfield_reptype.
         eapply JMeq_trans; [apply fold_reptype_JMeq |].
         apply (JMeq_trans (unfold_reptype_JMeq _ v)) in H4.
-        revert v' v0' H4 H5; rewrite @nested_field_type_ind with (gfs := cons _ _), H2; simpl; intros.
+        revert v' v0' H4 H5; rewrite ->@nested_field_type_ind with (gfs := cons _ _), H2; simpl; intros.
         apply JMeq_eq in H4; apply JMeq_eq in H5.
         subst; apply JMeq_refl.
     }
+    rewrite Hrrt; clear Hrrt.
     apply (array_at_ramif sh t gfs t0 z a 0 z i v' v0 p); auto.
     eapply JMeq_trans; [apply @JMeq_sym, H |]; clear v0 H.
     revert v v' H4.
-    rewrite @nested_field_type_ind with (gfs := cons _ _), H2.
+    rewrite ->@nested_field_type_ind with (gfs := cons _ _), H2.
     unfold proj_gfield_reptype, gfield_type.
     intros.
     apply (JMeq_trans (unfold_reptype_JMeq _ v)) in H4.
@@ -211,11 +213,11 @@ Proof.
     destruct H1.
     destruct (reptype_Tstruct_JMeq_constr0 t gfs i0 a v) as [v' ?H]; auto.
     erewrite field_at_Tstruct by eauto.
-    eapply derives_trans; [eapply nested_sfieldlist_at_ramif; eauto |].
-    apply sepcon_derives.
-    - apply derives_refl'.
+    etrans; [eapply nested_sfieldlist_at_ramif; eauto |].
+    apply bi.sep_mono.
+    - apply entails_refl'.
       apply equal_f.
-      apply field_at_type_changeable; auto.
+      rewrite_field_at_type_changeable.
       rewrite name_member_get; auto.
       eapply JMeq_trans; [| exact H].
       clear v0 H.
@@ -234,21 +236,21 @@ Proof.
              (fun it : member => @reptype cs (@nested_field_type cs t (@cons gfield (StructField (name_member it)) gfs)))
              (fun it => reptype (field_type (name_member it) (co_members (get_co i0))))); auto.
       -- intros.
-        rewrite nested_field_type_ind, H2; reflexivity.
+        rewrite nested_field_type_ind H2; reflexivity.
       -- apply in_get_member; auto.
     - clear v0 H.
 set (i' := name_member (get_member i (co_members (get_co i0)))).
-apply derives_trans with 
- (ALL v0' : reptype (nested_field_type t (gfs DOT i')),
-    field_at sh t (gfs DOT i') v0' p -*
+trans
+ (∀ v0' : reptype (nested_field_type t (gfs DOT i')),
+    field_at sh t (gfs DOT i') v0' p -∗
     field_at sh t gfs
       (upd_gfield_reptype (nested_field_type t gfs) 
          (StructField i') v
          (eq_rect_r reptype v0' (eq_sym (nested_field_type_ind t (gfs DOT i')))))
       p).
     *
-      apply allp_derives; intro v0.
-      apply wand_derives; auto.
+      apply bi.forall_mono; intro v0.
+      apply bi.wand_mono; auto.
       erewrite field_at_Tstruct; [apply derives_refl | eauto |].
       set (v0' := eq_rect_r reptype v0 (eq_sym (nested_field_type_ind t (gfs DOT i')))).
       assert (JMeq v0' v0) by apply eq_rect_r_JMeq.
@@ -265,22 +267,23 @@ apply derives_trans with
       apply upd_compact_prod_JMeq; auto.
       unfold i'. rewrite name_member_get; auto.
       intros.
-      rewrite nested_field_type_ind, H2.
+      rewrite nested_field_type_ind H2.
       reflexivity.
       eapply JMeq_trans. 
       apply eq_rect_r_JMeq; auto. auto.
-     * apply allp_right. intro.
-        apply allp_left with (@eq_rect_r _ i (fun i => reptype (nested_field_type t (gfs DOT i))) v0 i'
+     * apply bi.forall_intro. intro v0.
+       rewrite bi.forall_elim.
+       instantiate (1:=@eq_rect_r _ i (fun i => reptype (nested_field_type t (gfs DOT i))) v0 i'
                           (name_member_get _ _)).
-       apply wand_derives.
-       apply derives_refl'. apply equal_f.
-       apply field_at_type_changeable; auto.
+       apply bi.wand_mono.
+       apply entails_refl'. apply equal_f.
+       rewrite_field_at_type_changeable.
        f_equal. f_equal. symmetry; apply name_member_get.
        subst i'. clear.
-       rewrite name_member_get. unfold eq_rect_r.  simpl. apply JMeq_refl.
-       apply derives_refl'. apply equal_f.
-       apply field_at_type_changeable; auto.
-       subst i'. clear. rewrite name_member_get.
+       rewrite -> name_member_get. unfold eq_rect_r. simpl. apply JMeq_refl.
+       apply entails_refl'. apply equal_f.
+       rewrite_field_at_type_changeable.
+       subst i'. clear. rewrite -> name_member_get.
        apply JMeq_refl.
   + pose proof H0.
     rewrite field_compatible_cons in H1.
@@ -290,11 +293,11 @@ apply derives_trans with
     destruct H1.
     destruct (reptype_Tunion_JMeq_constr0 t gfs i0 a v) as [v' ?H]; auto.
     erewrite field_at_Tunion by eauto.
-    eapply derives_trans; [eapply nested_ufieldlist_at_ramif; eauto |].
-    apply sepcon_derives.
-    - apply derives_refl'.
+    etrans; [eapply nested_ufieldlist_at_ramif; eauto |].
+    apply bi.sep_mono.
+    - apply entails_refl'.
       apply equal_f.
-      apply field_at_type_changeable; auto.
+      rewrite_field_at_type_changeable.
       rewrite name_member_get; auto.
       eapply JMeq_trans; [| exact H].
       clear v0 H.
@@ -311,25 +314,25 @@ apply derives_trans with
              (fun it => reptype (nested_field_type t (gfs UDOT name_member it)))
              (fun it => reptype (field_type (name_member it) (co_members (get_co i0))))); auto.
       * intros.
-        rewrite nested_field_type_ind, H2; reflexivity.
-      * rewrite nested_field_type_ind, H2; apply JMeq_refl.
+        rewrite nested_field_type_ind H2; reflexivity.
+      * rewrite nested_field_type_ind H2; apply JMeq_refl.
     - clear v0 H.
       set (i' := name_member _).
-      apply allp_right; intro v0.
-      apply allp_left with 
-        (eq_rect i (fun i => reptype (nested_field_type t (gfs UDOT i))) v0 i'
-               (eq_sym (name_member_get _ _))).
-       apply wand_derives; apply derives_refl'.
-       * apply equal_f.
-          apply field_at_type_changeable; auto.
-          subst i'; rewrite name_member_get; auto.
-          apply JMeq_sym.
-          subst i'; clear.
-          rewrite name_member_get; auto.
+      apply bi.forall_intro  ; intro v0.
+      rewrite (bi.forall_elim (eq_rect i (fun i => reptype (nested_field_type t (gfs UDOT i))) v0 i'
+                                       (eq_sym (name_member_get _ _)))).
+       apply bi.wand_mono. 
+       * apply entails_refl'.
+         apply equal_f.
+         rewrite_field_at_type_changeable.
+         subst i'; rewrite name_member_get; auto.
+         apply JMeq_sym.
+         subst i'; clear.
+         rewrite -> name_member_get; auto.
       *
       subst i'.
       set (u := upd_union _ _ _ _).
-      rewrite @field_at_Tunion with (id:=i0) (a:=a)(v2:=u); auto.
+      rewrite ->@field_at_Tunion with (id:=i0) (a:=a)(v2:=u); auto.
       subst u.
       set (v0' := eq_rect_r _ _ _).
       assert (JMeq v0' v0) by apply eq_rect_r_JMeq.
@@ -344,7 +347,7 @@ apply derives_trans with
       eapply JMeq_trans; [apply fold_reptype_JMeq |].
       apply upd_compact_sum_JMeq; auto.
       intros.
-      rewrite nested_field_type_ind, H2.
+      rewrite nested_field_type_ind H2.
       reflexivity.
       fold (eq_rect_r (fun i1 : ident => reptype (nested_field_type t (gfs UDOT i1))) v0
            (name_member_get i (co_members (get_co i0)))).
@@ -353,114 +356,69 @@ apply derives_trans with
       clear - H.
       eapply JMeq_trans. apply eq_rect_r_JMeq.
       eapply JMeq_trans; [ apply H |]. clear v0' H.
-      unfold eq_rect_r. rewrite name_member_get. apply JMeq_refl.
+      unfold eq_rect_r. rewrite -> name_member_get. apply JMeq_refl.
 Qed.
 
 Lemma nested_field_ramif: forall sh t gfs0 gfs1 v v0 p,
   JMeq (proj_reptype (nested_field_type t gfs0) gfs1 v) v0 ->
   field_compatible t (gfs1 ++ gfs0) p ->
-  field_at sh t gfs0 v p |--
-    field_at sh t (gfs1 ++ gfs0) v0 p *
-    (ALL v0': _, ALL v0'': _, !! JMeq v0' v0'' -->
-      (field_at sh t (gfs1 ++ gfs0) v0' p -*
+  field_at sh t gfs0 v p ⊢
+    field_at sh t (gfs1 ++ gfs0) v0 p ∗
+    (∀ v0': _, ∀ v0'': _, ⌜ JMeq v0' v0''⌝ →
+      (field_at sh t (gfs1 ++ gfs0) v0' p -∗
          field_at sh t gfs0 (upd_reptype (nested_field_type t gfs0) gfs1 v v0'') p)).
 Proof.
   intros.
-  rewrite allp_uncurry'.
-  RAMIF_Q'.formalize.
+  rewrite allp_uncurry.
   revert v0 H; induction gfs1 as [| gf gfs1]; intros.
-  + simpl app in *.
-    apply RAMIF_Q'.solve with emp.
-    - simpl; auto.
-    - simpl in H. unfold eq_rect_r in H; rewrite <- eq_rect_eq in H; apply JMeq_eq in H.
-      rewrite H, sepcon_emp; auto.
-    - clear v0 H.
-      intros [v0 v0']; unfold fst, snd.
-      normalize.
-      simpl.
-      unfold eq_rect_r; rewrite <- eq_rect_eq; apply JMeq_eq in H.
-      rewrite H; auto.
+  + simpl in *.
+    rewrite /eq_rect_r /= in H.
+    apply JMeq_eq in H as <-.
+    iIntros "$" (??) "?".
+    rewrite /eq_rect_r /=.
+    apply JMeq_eq in H as <-; done.
   + simpl app in H0, v0, H |- *.
-    assert ({v1: reptype (nested_field_type t (gfs1 ++ gfs0)) | JMeq (proj_reptype (nested_field_type t gfs0) gfs1 v) v1})
+    assert ({v1: reptype (nested_field_type t (gfs1 ++ gfs0)) | JMeq (proj_reptype (nested_field_type t gfs0) gfs1 v) v1} ) as (v1 & ?H)
       by (apply JMeq_sigT; rewrite nested_field_type_nested_field_type; auto).
-    destruct X as [v1 ?H].
-    change
-      (fun st: reptype (nested_field_type t (gf :: gfs1 ++ gfs0)) *
-               reptype (nested_field_type (nested_field_type t gfs0) (gf :: gfs1)) =>
-       field_at sh t (gf :: gfs1 ++ gfs0) (fst st) p)
-    with
-      (Basics.compose
-        (fun v => field_at sh t (gf :: gfs1 ++ gfs0) v p)
-        (fun st: reptype (nested_field_type t (gf :: gfs1 ++ gfs0)) *
-               reptype (nested_field_type (nested_field_type t gfs0) (gf :: gfs1)) =>
-         fst st)).
-    change (fun st: reptype (nested_field_type t (gf :: gfs1 ++ gfs0)) *
-               reptype (nested_field_type (nested_field_type t gfs0) (gf :: gfs1)) =>
-       field_at sh t gfs0
-         (upd_reptype (nested_field_type t gfs0) (gf :: gfs1) v (snd st)) p)
-      with
-      (Basics.compose
-        (fun st: reptype (nested_field_type t (gfs1 ++ gfs0)) *
-                 reptype (nested_field_type (nested_field_type t gfs0) gfs1) =>
-         field_at sh t gfs0
-           (upd_reptype (nested_field_type t gfs0) gfs1 v (snd st)) p)
-        (fun st: reptype (nested_field_type t (gf :: gfs1 ++ gfs0)) *
-                 reptype (nested_field_type (nested_field_type t gfs0) (gf :: gfs1)) =>
-           (upd_gfield_reptype _ gf v1 (eq_rect_r reptype (fst st) (eq_sym (nested_field_type_ind _ (gf :: _)))),
-            upd_gfield_reptype _ gf (proj_reptype _ gfs1 v) (eq_rect_r reptype (snd st) (eq_sym (nested_field_type_ind _ (gf :: _))))))).
-    eapply RAMIF_Q'.trans with
-      (pL := fun _ => !! True)
-      (pG := fun st => !! JMeq (fst st) (snd st)).
-    - simpl; auto.
-    - simpl; auto.
-    - simpl; auto.
-    - apply IHgfs1; clear IHgfs1.
-      * clear - H0.
-        rewrite field_compatible_cons in H0.
-        destruct (nested_field_type t (gfs1 ++ gfs0)), gf; tauto.
-      * exact H1.
-    - eapply derives_trans; [apply gfield_ramif |].
-      * instantiate (1 := v0).
-        eapply JMeq_trans; [| apply H].
-        clear - H1.
-        unfold proj_reptype; fold proj_reptype.
-        eapply JMeq_trans; [| apply @JMeq_sym, eq_rect_r_JMeq].
-        revert v1 H1; rewrite <- nested_field_type_nested_field_type; intros.
-        apply JMeq_eq in H1; subst v1.
-        apply JMeq_refl.
-      * auto.
-      * apply sepcon_derives; auto.
-        apply allp_derives; intros v0'.
-        Opaque nested_field_type_ind. simpl. Transparent nested_field_type_ind.
-        rewrite prop_imp by auto.
-        apply derives_refl.
-    - intros; apply prop_right; auto.
-    - clear v0 H.
-      intros [v0 v0']; unfold fst, snd.
-      apply andp_derives; [| auto].
-      apply prop_derives; intro.
-      clear - H H1.
-      set (v0'' := eq_rect_r reptype v0 (eq_sym (nested_field_type_ind t (gf :: gfs1 ++ gfs0)))).
-      set (v0''' := eq_rect_r reptype v0' (eq_sym (nested_field_type_ind (nested_field_type t gfs0) (gf :: gfs1)))).
-      assert (JMeq v0'' v0''') by (eapply JMeq_trans; [apply eq_rect_r_JMeq | apply (JMeq_trans H), @JMeq_sym, eq_rect_r_JMeq]).
-      clearbody v0'' v0'''.
-      clear v0 v0' H.
-      revert v0'' v1 H0 H1.
-      change (gf :: gfs1 ++ gfs0) with ((gf :: gfs1) ++ gfs0).
-      rewrite <- nested_field_type_nested_field_type.
-      intros.
-      apply JMeq_eq in H1; subst v1.
-      apply JMeq_eq in H0; subst v0'''.
-      apply JMeq_refl.
+    rewrite IHgfs1 //; clear IHgfs1.
+    2: { rewrite field_compatible_cons in H0. destruct (nested_field_type t (gfs1 ++ gfs0)), gf; tauto. }
+    rewrite gfield_ramif //.
+    2: { instantiate (1 := v0).
+         eapply JMeq_trans; [| apply H].
+         clear - H1.
+         unfold proj_reptype; fold proj_reptype.
+         eapply JMeq_trans; [| apply @JMeq_sym, eq_rect_r_JMeq].
+         revert v1 H1; rewrite <- nested_field_type_nested_field_type; intros.
+         apply JMeq_eq in H1; subst v1.
+         apply JMeq_refl. }
+    iIntros "(($ & H1) & H2)" ((va, vb) Heq) "?"; simpl fst in *; simpl snd in *.
+    iSpecialize ("H1" with "[$]").
+    unfold upd_reptype; fold upd_reptype.
+    set (v0'' := eq_rect_r reptype va (eq_sym (nested_field_type_ind t (gf :: gfs1 ++ gfs0)))).
+    set (v0''' := eq_rect_r reptype vb (eq_sym (nested_field_type_ind (nested_field_type t gfs0) (gf :: gfs1)))).
+    assert (JMeq v0'' v0''') by (eapply JMeq_trans; [apply eq_rect_r_JMeq | apply (JMeq_trans Heq), @JMeq_sym, eq_rect_r_JMeq]).
+    clearbody v0'' v0'''.
+    clear v0 H va vb Heq.
+    iApply ("H2" $! (upd_gfield_reptype (nested_field_type t (gfs1 ++ gfs0)) gf v1 v0'',
+      upd_gfield_reptype (nested_field_type (nested_field_type t gfs0) gfs1) gf
+        (proj_reptype (nested_field_type t gfs0) gfs1 v) v0''') with "[%] [$]"); simpl.
+    revert v0'' v1 H0 H1 H2.
+    change (gf :: gfs1 ++ gfs0) with ((gf :: gfs1) ++ gfs0).
+    rewrite -nested_field_type_nested_field_type.
+    intros.
+    apply JMeq_eq in H1; subst v1.
+    apply JMeq_eq in H2; subst v0'''.
+    done.
 Qed.
 
+(* use <absorb>? *)
 Lemma nested_field_ramif_load: forall sh t gfs0 gfs1 (v_reptype: reptype (nested_field_type t gfs0)) (v_val: val) p,
   field_compatible t (gfs1 ++ gfs0) p ->
   JMeq (proj_reptype (nested_field_type t gfs0) gfs1 v_reptype) v_val ->
   exists v_reptype',
     JMeq v_reptype' v_val /\
-    (field_at sh t gfs0 v_reptype p |--
-      field_at sh t (gfs1 ++ gfs0) v_reptype' p * TT).
+    (field_at sh t gfs0 v_reptype p ⊢
+      field_at sh t (gfs1 ++ gfs0) v_reptype' p ∗ True).
 Proof.
   intros.
   generalize (JMeq_refl (proj_reptype (nested_field_type t gfs0) gfs1 v_reptype)).
@@ -468,12 +426,12 @@ Proof.
   clearbody v0.
   revert v0.
   pattern (reptype (nested_field_type (nested_field_type t gfs0) gfs1)) at 1 3.
-  rewrite nested_field_type_nested_field_type at 1.
+  rewrite {2}nested_field_type_nested_field_type.
   intros; exists v0.
   split.
   1: eapply JMeq_trans; [apply @JMeq_sym |]; eassumption.
-  eapply derives_trans; [apply nested_field_ramif; eassumption |].
-  apply sepcon_derives; auto.
+  etrans; [apply nested_field_ramif; eassumption |].
+  apply bi.sep_mono; auto.
 Qed.
 
 Lemma nested_field_ramif_store: forall sh t gfs0 gfs1 (v_reptype: reptype (nested_field_type t gfs0)) (v0_reptype: reptype (nested_field_type (nested_field_type t gfs0) gfs1)) (v_val: val) p,
@@ -481,9 +439,9 @@ Lemma nested_field_ramif_store: forall sh t gfs0 gfs1 (v_reptype: reptype (neste
   JMeq v0_reptype v_val ->
   exists v0_reptype',
     JMeq v0_reptype' v_val /\
-    (field_at sh t gfs0 v_reptype p |--
-      field_at_ sh t (gfs1 ++ gfs0) p *
-       (field_at sh t (gfs1 ++ gfs0) v0_reptype' p -*
+    (field_at sh t gfs0 v_reptype p ⊢
+      field_at_ sh t (gfs1 ++ gfs0) p ∗
+       (field_at sh t (gfs1 ++ gfs0) v0_reptype' p -∗
           field_at sh t gfs0 (upd_reptype (nested_field_type t gfs0) gfs1 v_reptype v0_reptype) p)).
 Proof.
   intros.
@@ -495,26 +453,23 @@ Proof.
   clearbody v0_reptype'.
   revert v0 v0_reptype'.
   pattern (reptype (nested_field_type (nested_field_type t gfs0) gfs1)) at 1 2 4 6.
-  rewrite nested_field_type_nested_field_type at 1.
+  rewrite {3}nested_field_type_nested_field_type.
   intros; exists v0_reptype'.
   split.
   1: eapply JMeq_trans; [apply @JMeq_sym |]; eassumption.
-  eapply derives_trans; [apply nested_field_ramif; eassumption |].
-  apply sepcon_derives.
+  etrans; [apply nested_field_ramif; eassumption |].
+  apply bi.sep_mono.
   1: apply field_at_field_at_.
-  eapply allp_left.
-  eapply allp_left.
-  rewrite prop_imp; [apply derives_refl |].
-  auto.
+  iIntros "H"; iApply "H"; auto.
 Qed.
 
 Lemma nested_field_ramif': forall sh t gfs0 gfs1 v v0 p,
   JMeq (proj_reptype (nested_field_type t gfs0) gfs1 v) v0 ->
   legal_nested_field t (gfs1 ++ gfs0) ->
-  field_at sh t gfs0 v p |--
-    field_at sh t (gfs1 ++ gfs0) v0 p *
-    (ALL v0': _, ALL v0'': _, !! JMeq v0' v0'' -->
-      (field_at sh t (gfs1 ++ gfs0) v0' p -*
+  field_at sh t gfs0 v p ⊢
+    field_at sh t (gfs1 ++ gfs0) v0 p ∗
+    (∀ v0': _, ∀ v0'': _, ⌜JMeq v0' v0''⌝ →
+      (field_at sh t (gfs1 ++ gfs0) v0' p -∗
          field_at sh t gfs0 (upd_reptype (nested_field_type t gfs0) gfs1 v v0'') p)).
 Proof.
   intros.
@@ -528,10 +483,10 @@ Qed.
 Lemma nested_field_ramif'': forall sh t gfs0 gfs1 v v0 p,
   JMeq (proj_reptype (nested_field_type t gfs0) gfs1 v) v0 ->
   legal_nested_field (nested_field_type t gfs0) gfs1 ->
-  field_at sh t gfs0 v p |--
-    field_at sh t (gfs1 ++ gfs0) v0 p *
-    (ALL v0': _, ALL v0'': _, !! JMeq v0' v0'' -->
-      (field_at sh t (gfs1 ++ gfs0) v0' p -*
+  field_at sh t gfs0 v p ⊢
+    field_at sh t (gfs1 ++ gfs0) v0 p ∗
+    (∀ v0': _, ∀ v0'': _, ⌜JMeq v0' v0''⌝ →
+      (field_at sh t (gfs1 ++ gfs0) v0' p -∗
          field_at sh t gfs0 (upd_reptype (nested_field_type t gfs0) gfs1 v v0'') p)).
 Proof.
   intros.
@@ -545,44 +500,24 @@ Qed.
 
 End NESTED_RAMIF.
 
-Lemma semax_extract_later_prop' {cs: compspecs}:
-  forall {Espec: OracleKind},
-    forall (Delta : tycontext) (PP : Prop) P Q R c post,
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- !!PP ->
-      (PP -> semax Delta (|>PROPx P (LOCALx Q (SEPx R))) c post) ->
-      semax Delta (|>PROPx P (LOCALx Q (SEPx R))) c post.
+Lemma semax_extract_later_prop' :
+  forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {cs: compspecs} ,
+    forall E (Delta : tycontext) (PP : Prop) P Q R c post,
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢ ⌜PP⌝ ->
+      (PP -> semax E Delta (▷PROPx P (LOCALx Q (SEPx R))) c post) ->
+      semax E Delta (▷PROPx P (LOCALx Q (SEPx R))) c post.
 Proof.
   intros.
   eapply semax_pre_simple.
   + hoist_later_left.
-    apply later_derives.
+    apply bi.later_mono.
     rewrite (add_andp _ _ H).
-    rewrite andp_assoc.
-    apply andp_left2.
-    rewrite andp_comm.
-    apply derives_refl.
-  + apply semax_extract_later_prop1.
+    rewrite -bi.and_assoc.
+    apply bi.and_elim_r.
+  + rewrite bi.and_comm. apply semax_extract_later_prop1.
     auto.
 Qed.
 
-Lemma insert_corable_sep: forall R1 P Q R,
-  corable R1 ->
-  `R1 && PROPx P (LOCALx Q (SEPx R)) = PROPx P (LOCALx Q (SEPx (R1 && emp :: R))).
-Proof.
-  intros.
-  rewrite andp_comm.
-  unfold PROPx.
-  rewrite andp_assoc; f_equal.
-  unfold LOCALx.
-  rewrite andp_assoc; f_equal.
-  unfold SEPx.
-  extensionality rho.
-  simpl.
-  rewrite andp_comm.
-  rewrite andp_left_corable by auto.
-  reflexivity.
-Qed.
-
 (************************************************
 
 Lemmas of field nested load/store
@@ -604,10 +539,10 @@ Proof.
     reflexivity.
 Qed.
 
-Lemma field_at_app {cs: compspecs}:
+Lemma field_at_app `{!VSTGS OK_ty Σ} {cs: compspecs}:
  forall sh t gfs1 gfs2 v v' p,
  JMeq v v' ->
- field_at sh t (gfs1++gfs2) v p =
+ field_at sh t (gfs1++gfs2) v p ⊣⊢
  field_at sh (nested_field_type t gfs2) gfs1 v' (field_address t gfs2 p).
 Proof.
 intros.
@@ -615,9 +550,7 @@ rewrite !field_at_data_at.
 rewrite (data_at_type_changeable sh
    (nested_field_type t (gfs1 ++ gfs2))
   (nested_field_type (nested_field_type t gfs2) gfs1) v v'); auto.
-f_equal.
+f_equiv.
 apply field_address_app.
 symmetry; apply nested_field_type_nested_field_type.
 Qed.
-
-
diff --git a/floyd/nested_pred_lemmas.v b/floyd/nested_pred_lemmas.v
index 314c058659..d1a38b528e 100644
--- a/floyd/nested_pred_lemmas.v
+++ b/floyd/nested_pred_lemmas.v
@@ -1,10 +1,13 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.type_induction.
 Require Import VST.floyd.fieldlist.
-Import compcert.lib.Maps.
 Open Scope Z.
 
+Local Unset SsrRewrite.
+
 (************************************************
 
 Definition, lemmas and useful samples of nested_pred
@@ -153,7 +156,7 @@ Proof.
   intros.
   simpl in H.
   unfold get_co.
-  destruct (cenv_cs ! id); auto.
+  destruct (cenv_cs !! id); auto.
   destruct (co_su c); congruence.
 Qed.
 
@@ -164,7 +167,7 @@ Proof.
   intros.
   simpl in H.
   unfold get_co.
-  destruct (cenv_cs ! id); auto; try congruence.
+  destruct (cenv_cs !! id); auto; try congruence.
   destruct (co_su c); congruence.
 Qed.
 
@@ -189,7 +192,7 @@ Lemma complete_Tstruct_plain:
 Proof.
 intros.
 unfold get_co; simpl in H.
-destruct (cenv_cs ! id); [ | discriminate].
+destruct (cenv_cs !! id); [ | discriminate].
 destruct (co_su c); auto; discriminate.
 Qed.
 
@@ -200,7 +203,7 @@ Lemma complete_Tunion_plain:
 Proof.
 intros.
 unfold get_co; simpl in H.
-destruct (cenv_cs ! id); [ | discriminate].
+destruct (cenv_cs !! id); [ | discriminate].
 destruct (co_su c); auto; discriminate.
 Qed.
 
diff --git a/floyd/printf.v b/floyd/printf.v
index 2b2dc0eb44..27b4fad85a 100644
--- a/floyd/printf.v
+++ b/floyd/printf.v
@@ -47,8 +47,12 @@ Fixpoint format_argtys (fl: list format_item) : list type :=
  | nil => nil
  end.
 
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ}.
+
 Definition readable_cstring {CS: compspecs} x := 
-  !! readable_share (fst (fst x)) && cstring (fst (fst x)) (snd (fst x)) (snd x).
+  ⌜readable_share (fst (fst x))⌝ ∧ cstring (fst (fst x)) (snd (fst x)) (snd x).
 
 Fixpoint SEP_of_format {CS: compspecs}
     (fl: list format_item)
@@ -67,7 +71,7 @@ match stuff with ((sh,s,p),_) => cstring sh s p end
 - (* FI_text *)
 apply (SEP_of_format CS fl' stuff).
 - (* FI_error *)
-apply (FF::nil).
+apply (False::nil).
 Defined.
 
 
@@ -110,12 +114,15 @@ Proof.
   rewrite <- Nat2Z.inj_div by discriminate.
   rewrite !Nat2Z.id.
   apply Nat2Z.inj_lt.
-  rewrite Nat2Z.inj_div, Z2Nat.id by lia; simpl.
+  rewrite -> Nat2Z.inj_div, Z2Nat.id by lia; simpl.
   apply Z.div_lt; auto; lia.
 Qed.
 
 Definition charminus := Byte.repr 45.
 
+Local Obligation Tactic := unfold RelationClasses.complement, Equivalence.equiv;
+  Tactics.program_simpl.
+
 Program Fixpoint chars_of_Z (n : Z) { measure (Z.to_nat (if n <? 0 then Z.abs n + 1 else n)) } : list byte :=
   match n <? 0 with true => charminus :: chars_of_Z (Z.abs n) | false =>
   let n' := n / 10 in
@@ -130,7 +137,7 @@ Proof.
 Defined.
 Next Obligation.
 Proof.
-  rewrite ?Zaux.Zdiv_eucl_unique in *. (* for Coq 8.15 *)
+  rewrite -> ?Zaux.Zdiv_eucl_unique in *.  (* Coq 8.15 and after *)
   rewrite <- Heq_anonymous0.
   destruct (Z.ltb_spec n 0); try discriminate.
   pose proof (Z.div_pos _ 10 H).
@@ -190,16 +197,21 @@ apply (l ++ string_of_format CS fl' stuff).
 apply nil.
 Defined.
 
+End mpred.
+
 Section file_id.
 
 Class FileId := { file_id : Type; stdin : file_id; stdout : file_id }.
 Context {FI : FileId}.
-Context {E : Type -> Type} {IO_E: IO_event(file_id := file_id) -< E} {CS : compspecs}.
+Context {E : Type -> Type} {IO_E: IO_event(file_id := file_id) -< E}
+  `{!VSTGS (IO_itree(E := E)) Σ} {CS : compspecs}.
+
+Local Notation funspec := (@funspec Σ).
 
 Axiom file_at : file_id -> val -> mpred.
 
 Axiom file_at_local_facts:
-   forall f p, file_at f p |-- !! (isptr p).
+   forall f p, file_at f p ⊢ ⌜isptr p⌝.
 
 Class FileStruct := { abs_file : FileId; FILEid : ident; reent : ident; f_stdin : ident; f_stdout : ident }.
 Global Existing Instance abs_file.
@@ -208,11 +220,11 @@ Context {FS : FileStruct}.
 
 Axiom reent_struct : val -> mpred.
 
-Axiom init_stdio : emp |-- EX p : val, EX inp : val, EX outp : val, EX inp' : _, EX outp' : _,
-  !!(JMeq inp' inp /\ JMeq outp' outp) && reent_struct p *
-  field_at Ews (Tstruct reent noattr) [StructField f_stdin] inp' p *
-  field_at Ews (Tstruct reent noattr) [StructField f_stdout] outp' p *
-  file_at stdin inp * file_at stdout outp.
+Axiom init_stdio : emp ⊢ ∃ p : val, ∃ inp : val, ∃ outp : val, ∃ inp' : _, ∃ outp' : _,
+  ⌜JMeq inp' inp /\ JMeq outp' outp⌝ ∧ reent_struct p ∗
+  field_at Ews (Tstruct reent noattr) [StructField f_stdin] inp' p ∗
+  field_at Ews (Tstruct reent noattr) [StructField f_stdout] outp' p ∗
+  file_at stdin inp ∗ file_at stdout outp.
 
 Definition get_reent_spec :=
   WITH p : val
@@ -244,7 +256,7 @@ Definition fprintf_spec_parametrized FILEid (fmtz: list Z) :=
       end)
      (fun x : (val * share * list byte * val * format_stuff fl * (file_id * IO_itree)) => 
       match x with (outp,sh,fmt,fmtp,stuff,(out,k)) =>
-       EX n:int,
+       ∃ n:int,
         PROPx nil 
         (LOCALx (temp ret_temp (Vint n)::nil)
          (SEPx (cstring sh fmt fmtp :: file_at out outp :: ITREE k :: SEP_of_format fl stuff)))
@@ -268,7 +280,7 @@ Definition printf_spec_parametrized (fmtz: list Z) :=
       end)
      (fun x : (val * share * list byte * val * format_stuff fl * IO_itree) => 
       match x with (outp,sh,fmt,fmtp,stuff,k) =>
-       EX n:int,
+       ∃ n:int,
         PROPx nil 
         (LOCALx (temp ret_temp (Vint n)::nil)
          (SEPx (cstring sh fmt fmtp :: ITREE k :: SEP_of_format fl stuff)))
@@ -307,8 +319,8 @@ End file_id.
 
 #[export] Hint Resolve file_at_local_facts : saturate_local.
 
-Ltac make_stdio :=
-  sep_apply (@init_stdio _ _ _); let p := fresh "reentp" in let inp := fresh "inp" in let outp := fresh "outp" in
+Ltac make_stdio E :=
+  sep_apply (init_stdio(E := E)); let p := fresh "reentp" in let inp := fresh "inp" in let outp := fresh "outp" in
   let inp' := fresh "inp'" in let outp' := fresh "outp'" in Intros p inp outp inp' outp';
   change (reptype (tptr (Tstruct _ noattr))) with val in inp', outp';
   repeat match goal with H : JMeq _ _ |- _ => apply JMeq_eq in H; subst end.
@@ -353,15 +365,15 @@ Ltac strip_int_repr s :=
  end.
 
 Ltac do_string2bytes :=
-match goal with |- semax _ (PROPx _ (LOCALx _ (SEPx ?R))) _ _ =>
+match goal with |- semax _ _ (PROPx _ (LOCALx _ (SEPx ?R))) _ _ =>
  match R with context [data_at _ (tarray tschar ?n) 
-                                     (map (Vint oo cast_int_int I8 Signed) ?il)] =>
+                                     (map (Basics.compose Vint (cast_int_int I8 Signed)) ?il)] =>
   match il with context [Int.repr 0 :: nil] =>
     let zl := strip_int_repr il in
     let s := constr:(listZ2string zl) in
     let s := eval compute in s in
     let y := constr:(string2bytes s) in
-    change  (map (Vint oo cast_int_int I8 Signed) il) 
+    change  (map (Basics.compose Vint (cast_int_int I8 Signed)) il)
              with (map Vbyte (y ++ [Byte.zero]))
  end end end.
 
@@ -406,11 +418,11 @@ Ltac forward_fprintf' gv Pre id sub outv w w' :=
 
 Ltac forward_fprintf outv w w' :=
  repeat rewrite <- seq_assoc;
- try match goal with |- semax _ _ (Scall _ _) _ =>
+ try match goal with |- semax _ _ _ (Scall _ _) _ =>
    rewrite -> semax_seq_skip
  end;
 lazymatch goal with
- | gv: globals |- @semax ?cs _ _ ?Pre (Ssequence (Scall None (Evar _ _) (?f :: Evar ?id _ :: _)) _) _ =>
+ | gv: globals |- semax(C := ?cs) _ _ ?Pre (Ssequence (Scall None (Evar _ _) (?f :: Evar ?id _ :: _)) _) _ =>
    let tf := constr:(typeof f) in
    let tf := eval hnf in tf in
    lazymatch tf with Tpointer (Tstruct ?FILEid _) _ =>
@@ -421,15 +433,15 @@ end.
 
 Ltac forward_printf w w' :=
  repeat rewrite <- seq_assoc;
- try match goal with |- semax _ _ (Scall _ _) _ =>
+ try match goal with |- semax _ _ _ (Scall _ _) _ =>
    rewrite -> semax_seq_skip
  end;
-match goal with
- | gv: globals |- @semax ?cs _ _ ?Pre (Ssequence (Scall None (Evar _ _) (Evar ?id _ :: _)) _) _ =>
+lazymatch goal with
+ | gv: globals |- semax(C := ?cs) _ _ ?Pre (Ssequence (Scall None (Evar _ _) (Evar ?id _ :: _)) _) _ =>
        forward_fprintf' gv Pre id (printf_spec_sub(CS := cs)) nullval w w'
 end.
 
-Fixpoint make_printf_specs' {FS : FileStruct} (defs: list (ident * globdef (fundef function) type)) : list (ident*funspec) :=
+Fixpoint make_printf_specs' `{!VSTGS (@IO_itree E) Σ} {FS : FileStruct} (defs: list (ident * globdef (fundef function) type)) : list (ident*funspec) :=
  match defs with
  | (i, Gfun (External (EF_external "fprintf" _) 
                        (cons (Tpointer (Tstruct id _) _) _) _ _)) :: defs' => 
diff --git a/floyd/proj_reptype_lemmas.v b/floyd/proj_reptype_lemmas.v
index 8f7adc94e0..1e02e78c5c 100644
--- a/floyd/proj_reptype_lemmas.v
+++ b/floyd/proj_reptype_lemmas.v
@@ -1,4 +1,6 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.nested_field_lemmas.
 Require Import VST.floyd.type_induction.
diff --git a/floyd/proofauto.v b/floyd/proofauto.v
index 7a8e9a418a..137f5c461a 100644
--- a/floyd/proofauto.v
+++ b/floyd/proofauto.v
@@ -1,7 +1,9 @@
 From compcert Require Export common.AST cfrontend.Ctypes cfrontend.Clight.
 Export Cop.
 Require VST.veric.version.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Export VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Export VST.floyd.functional_base.
 Require Export VST.floyd.client_lemmas.
 Require Export VST.floyd.go_lower.
@@ -48,17 +50,96 @@ Require Export VST.floyd.hints.
 Require Export VST.floyd.Clightnotations.
 Require Export VST.floyd.data_at_list_solver.
 Require Export VST.floyd.data_at_lemmas.
-Require VST.msl.iter_sepcon.
-Require VST.msl.wand_frame.
-Require VST.msl.wandQ_frame.
 Require VST.floyd.linking.
 
+(* undo some "simpl never" settings from std++ 
+   https://gitlab.mpi-sws.org/iris/stdpp/-/blob/master/stdpp/numbers.v *)
+#[global] Arguments Pos.pred : simpl nomatch.
+#[global] Arguments Pos.succ : simpl nomatch.
+#[global] Arguments Pos.of_nat : simpl nomatch.
+#[global] Arguments Pos.to_nat !x /.
+#[global] Arguments Pos.mul : simpl nomatch.
+#[global] Arguments Pos.add : simpl nomatch.
+#[global] Arguments Pos.sub : simpl nomatch.
+#[global] Arguments Pos.pow : simpl nomatch.
+#[global] Arguments Pos.shiftl : simpl nomatch.
+#[global] Arguments Pos.shiftr : simpl nomatch.
+#[global] Arguments Pos.gcd : simpl nomatch.
+#[global] Arguments Pos.min : simpl nomatch.
+#[global] Arguments Pos.max : simpl nomatch.
+#[global] Arguments Pos.lor : simpl nomatch.
+#[global] Arguments Pos.land : simpl nomatch.
+#[global] Arguments Pos.lxor : simpl nomatch.
+#[global] Arguments Pos.square : simpl nomatch.
+
+#[global] Arguments N.pred : simpl nomatch.
+#[global] Arguments N.succ : simpl nomatch.
+#[global] Arguments N.of_nat : simpl nomatch.
+#[global] Arguments N.to_nat : simpl nomatch.
+#[global] Arguments N.mul : simpl nomatch.
+#[global] Arguments N.add : simpl nomatch.
+#[global] Arguments N.sub : simpl nomatch.
+#[global] Arguments N.pow : simpl nomatch.
+#[global] Arguments N.div : simpl nomatch.
+#[global] Arguments N.modulo : simpl nomatch.
+#[global] Arguments N.shiftl : simpl nomatch.
+#[global] Arguments N.shiftr : simpl nomatch.
+#[global] Arguments N.gcd : simpl nomatch.
+#[global] Arguments N.lcm : simpl nomatch.
+#[global] Arguments N.min : simpl nomatch.
+#[global] Arguments N.max : simpl nomatch.
+#[global] Arguments N.lor : simpl nomatch.
+#[global] Arguments N.land : simpl nomatch.
+#[global] Arguments N.lxor : simpl nomatch.
+#[global] Arguments N.lnot : simpl nomatch.
+#[global] Arguments N.square : simpl nomatch.
+
+#[global] Arguments Z.pred : simpl nomatch.
+#[global] Arguments Z.succ : simpl nomatch.
+#[global] Arguments Z.of_nat : simpl nomatch.
+#[global] Arguments Z.to_nat : simpl nomatch.
+#[global] Arguments Z.mul : simpl nomatch.
+#[global] Arguments Z.add : simpl nomatch.
+#[global] Arguments Z.sub : simpl nomatch.
+#[global] Arguments Z.opp : simpl nomatch.
+#[global] Arguments Z.pow : simpl nomatch.
+#[global] Arguments Z.div _ _ /.
+#[global] Arguments Z.modulo : simpl nomatch.
+#[global] Arguments Z.quot : simpl nomatch.
+#[global] Arguments Z.rem : simpl nomatch.
+#[global] Arguments Z.shiftl : simpl nomatch.
+#[global] Arguments Z.shiftr : simpl nomatch.
+#[global] Arguments Z.gcd : simpl nomatch.
+#[global] Arguments Z.lcm : simpl nomatch.
+#[global] Arguments Z.min : simpl nomatch.
+#[global] Arguments Z.max : simpl nomatch.
+#[global] Arguments Z.lor : simpl nomatch.
+#[global] Arguments Z.land : simpl nomatch.
+#[global] Arguments Z.lxor : simpl nomatch.
+#[global] Arguments Z.lnot : simpl nomatch.
+#[global] Arguments Z.square : simpl nomatch.
+#[global] Arguments Z.abs : simpl nomatch.
+
+Global Arguments Qreduction.Qred : simpl nomatch.
+Global Arguments pos_to_Qp : simpl nomatch.
+Global Arguments Qp.add : simpl nomatch.
+Global Arguments Qp.sub : simpl nomatch.
+Global Arguments Qp.mul : simpl nomatch.
+Global Arguments Qp.inv : simpl nomatch.
+Global Arguments Qp.div : simpl nomatch.
+
+Global Instance inhabitant_inhabited `{Inhabitant A} : Inhabited A := populate default.
+
 (*funspec scope is the default, so remains open.
-  User who wnt ot use old funspecs should 
+  Users who want to use old funspecs should 
   "Require Import Require Import VST.floyd.Funspec_old_Notation."
   Global Close Scope funspec_scope.*)
 
-Arguments semax {CS} {Espec} Delta Pre%assert cmd%C Post%assert.
+Notation default_VSTGS Σ := (VSTGS unit Σ).
+
+#[export] Instance NullEspec : ext_spec unit := void_spec unit.
+
+Arguments semax {_} {_} {_} {_} {_} E Delta Pre%_assert cmd%_C Post%_assert.
 Export ListNotations.
 Export Clight_Cop2.
  
@@ -93,7 +174,7 @@ Lemma modu_repr: forall x y,
    0 <= y <= Int.max_unsigned ->
   Int.modu (Int.repr x) (Int.repr y) = Int.repr (x mod y).
 Proof.
-intros. unfold Int.modu. rewrite !Int.unsigned_repr by auto. auto.
+intros. unfold Int.modu. rewrite ->!Int.unsigned_repr by auto. auto.
 Qed.
 #[export] Hint Rewrite modu_repr using rep_lia : entailer_rewrite norm.
 
@@ -109,7 +190,7 @@ Qed.
 #[export] Hint Extern 1 (@nil _ = default_val _) => reflexivity : cancel.
 #[export] Hint Extern 1 (default_val _ = @nil _) => reflexivity : cancel.
 
-#[export] Instance Inhabitant_mpred : Inhabitant mpred := @FF mpred Nveric.
+#[export] Instance Inhabitant_mpred `{!VSTGS OK_ty Σ} : Inhabitant mpred := False.
 #[export] Instance Inhabitant_share : Inhabitant share := Share.bot.
 
 Arguments deref_noload ty v / .
@@ -192,6 +273,8 @@ Ltac gather_prop ::=
 #[export] Hint Resolve Clight_mapsto_memory_block.tc_val_pointer_nullval : core.
 #[export] Hint Resolve mapsto_memory_block.tc_val_pointer_nullval : core.
 
+Global Instance val_inhabited : Inhabited val := populate Vundef.
+
 (*
 Ltac eapply_clean_LOCAL_right_spec'' R ::=
   lazymatch R with
@@ -211,5 +294,3 @@ Ltac eapply_clean_LOCAL_right_spec'' R ::=
 Ltac eapply_clean_LOCAL_right_spec'' R :=
    eapply_clean_LOCAL_right_spec' emptyCS.
 *)
-
-
diff --git a/floyd/quickprogram.v b/floyd/quickprogram.v
index c0ce1c149f..f6b63001b8 100644
--- a/floyd/quickprogram.v
+++ b/floyd/quickprogram.v
@@ -1,7 +1,11 @@
+Set Warnings "-hiding-delimiting-key,-custom-entry-overridden,-notation-overridden".
 Require Import VST.floyd.base.
+Set Warnings "hiding-delimiting-key,custom-entry-overridden,notation-overridden".
 Require Import VST.floyd.PTops.
 Require Import VST.floyd.QPcomposite.
-Import compcert.lib.Maps.
+Import -(notations) compcert.lib.Maps.
+
+Local Unset SsrRewrite.
 
 Fixpoint filter_options {A B} (f: A -> option B) (al: list A) : list B :=
  match al with
@@ -159,7 +163,7 @@ Proof.
 intros.
 destruct s1, s2; simpl in *.
 rewrite !andb_true_iff in H; destruct H as [[? ?] ?].
-assert (sig_res = sig_res0). { 
+assert (sig_res = sig_res0). {
  destruct sig_res, sig_res0; inv H0; auto.
 }
 assert (sig_args = sig_args0). {
@@ -329,7 +333,7 @@ destruct u,u0; inv H; auto.
 destruct b,b0; inv H; auto.
 Qed.
 
-Fixpoint eqb_statement (s1 s2: statement ) : bool :=
+Fixpoint eqb_statement (s1 s2: statement) : bool :=
 match s1, s2 with
 | Sskip, Sskip => true
 | Sassign a1 b1, Sassign a2 b2 => 
@@ -425,7 +429,7 @@ rewrite ?Int.eq_true, ?Int64.eq_true, ?eqb_type_refl, ?eqb_ident_refl,
  rewrite ?eqb_external_function_refl,
  ?IHs, ?IHs1, ?IHs2; auto.
  destruct o; auto; simpl; rewrite eqb_ident_refl; auto.
- destruct o; auto; simpl; rewrite eqb_ident_refl; auto.
+ destruct o; auto; simpl; rewrite ?eqb_ident_refl; auto.
  destruct o; auto; simpl; rewrite eqb_expr_refl; auto.
  simpl; auto.
 - clear eqb_labeled_statements_refl.
@@ -646,8 +650,8 @@ apply  (merged_compspecs' _ _ OK1 OK2 _ H).
 intros i.
 apply (merge_PTrees_e i) in H.
 red.
-destruct ((QP.prog_comp_env p1) ! i); auto.
-destruct ((QP.prog_comp_env p2) ! i); auto.
+destruct ((QP.prog_comp_env p1) !! i); auto.
+destruct ((QP.prog_comp_env p2) !! i); auto.
 destruct H as [? [? ?]].
 rewrite H0.
 destruct (QPcomposite_eq c c0) eqn:?H; inv H.
@@ -656,8 +660,8 @@ apply QPcomposite_eq_e in H1; auto.
 intros i.
 apply (merge_PTrees_e i) in H.
 red.
-destruct ((QP.prog_comp_env p2) ! i); auto.
-destruct ((QP.prog_comp_env p1) ! i); auto.
+destruct ((QP.prog_comp_env p2) !! i); auto.
+destruct ((QP.prog_comp_env p1) !! i); auto.
 destruct H as [? [? ?]].
 rewrite H0.
 destruct (QPcomposite_eq c0 c) eqn:?H; inv H.
@@ -726,10 +730,10 @@ specialize (H4 i i H5).
 apply PTree_In_fst_elements in H6.
 destruct H6 as [g ?].
 rewrite H in EQ1.
-destruct ((QP.prog_defs p1) ! i) eqn:?H.
+destruct ((QP.prog_defs p1) !! i) eqn:?H.
 apply H2; auto.
 apply PTree_In_fst_elements; eauto.
-destruct ((QP.prog_defs p2) ! i) eqn:?H.
+destruct ((QP.prog_defs p2) !! i) eqn:?H.
 inv EQ1.
 apply H4; auto.
 apply PTree_In_fst_elements; eauto.
@@ -739,7 +743,7 @@ Qed.
 Lemma QPfind_def_symbol:
   forall {F} p id g,
   QPprogram_OK p ->
-  In (id,g) (map of_builtin (QP.prog_builtins p)) \/ (QP.prog_defs p)!id = Some g <-> 
+  In (id,g) (map of_builtin (QP.prog_builtins p)) \/ (QP.prog_defs p)!!id = Some g <-> 
  exists b, Genv.find_symbol (@QPglobalenv F p) id = Some b
    /\ Genv.find_def (@QPglobalenv F p) b = Some g.
 Proof.
@@ -836,7 +840,7 @@ Qed.
 Lemma QPfind_funct_ptr_exists:
 forall (p: QP.program Clight.function) i f,
   QPprogram_OK p ->
-(QP.prog_defs p) ! i = Some (Gfun f) ->
+(QP.prog_defs p) !! i = Some (Gfun f) ->
 exists b,
  Genv.find_symbol (QPglobalenv p) i = Some b
 /\ Genv.find_funct_ptr (QPglobalenv p) b = Some f.
@@ -978,7 +982,7 @@ Fixpoint QPcomplete_type (env : QP.composite_env) (t : type) :  bool :=
   | Tarray t' _ _ => QPcomplete_type env t'
   | Tvoid | Tfunction _ _ _ => false
   | Tstruct id _ | Tunion id _ =>
-      match env ! id with
+      match env !! id with
       | Some _ => true
       | None => false
       end
@@ -1022,19 +1026,3 @@ Definition program_of_QPprogram {F} (p: QP.program F)
 *)
 
 End Junkyard.
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/floyd/reassoc_seq.v b/floyd/reassoc_seq.v
index e946df6f78..bde05a0739 100644
--- a/floyd/reassoc_seq.v
+++ b/floyd/reassoc_seq.v
@@ -1,14 +1,16 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.semax_tactics.
 Import ListNotations.
 
 Ltac reassoc_seq_raw :=
   cbv [Sfor Swhile Sdowhile];
   match goal with
-  | |- semax _ _ ?cs _ =>
+  | |- semax _ _ _ ?cs _ =>
     let cs' := eval cbv [unfold_seq fold_seq app]
                in (fold_seq (unfold_seq cs)) in
-    apply (semax_unfold_seq cs' cs eq_refl)
+    apply (semax_unfold_seq _ cs' cs eq_refl)
   end.
 
 Ltac reassoc_seq := unfold_abbrev'; reassoc_seq_raw; abbreviate_semax.
@@ -36,7 +38,7 @@ Definition reassoc_into_chunks (cs: statement) (chunksize: Z) : statement :=
 Ltac reassoc_seq_chunks chunksize :=
   cbv [Sfor Swhile Sdowhile];
   match goal with
-  | |- semax _ _ ?cs _ => let cs' := eval cbv
+  | |- semax _ _ _ ?cs _ => let cs' := eval cbv
        [reassoc_into_chunks fold_seq map partition unfold_seq Zlength Zlength_aux Z.succ Z.add
         Pos.add Pos.succ Pos.add_carry app Z.eqb Pos.eqb Z.sub Z.opp Z.pos_sub
         Z.succ_double Z.pred_double Z.double Pos.pred_double]
diff --git a/floyd/replace_refill_reptype_lemmas.v b/floyd/replace_refill_reptype_lemmas.v
index 9ed55993f2..e8c37ee82d 100644
--- a/floyd/replace_refill_reptype_lemmas.v
+++ b/floyd/replace_refill_reptype_lemmas.v
@@ -1,4 +1,6 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.nested_field_lemmas.
 Require Import VST.floyd.type_induction.
@@ -7,9 +9,8 @@ Require Import VST.floyd.reptype_lemmas.
 Require Import VST.floyd.proj_reptype_lemmas.
 Require Import Coq.Classes.RelationClasses.
 Require Import VST.zlist.sublist.
-Require Import VST.floyd.stronger.
+(* Require Import VST.floyd.stronger. *)
 
-Require Import VST.floyd.stronger.
 Section SINGLE_HOLE.
 
 Context {cs: compspecs}.
@@ -79,7 +80,7 @@ Fixpoint upd_reptype (t: type) (gfs: list gfield) (v: reptype t) (v0: reptype (n
   | gf :: gfs0 => fun v0 => upd_reptype t gfs0 v (upd_gfield_reptype _ gf (proj_reptype t gfs0 v) v0)
   end (eq_rect_r reptype v0 (eq_sym (nested_field_type_ind t gfs))).
 
-Lemma upd_reptype_data_equal: forall t gfs v v0 v1, data_equal v0 v1 -> data_equal (upd_reptype t gfs v v0) (upd_reptype t gfs v v1).
+(* Lemma upd_reptype_data_equal: forall t gfs v v0 v1, data_equal v0 v1 -> data_equal (upd_reptype t gfs v v0) (upd_reptype t gfs v v1).
 Proof.
   intros.
   induction gfs as [| gf gfs].
@@ -100,14 +101,14 @@ Proof.
     clear - H0.
     revert V0 V1 H0 V.
     destruct (nested_field_type t gfs), gf; unfold upd_gfield_reptype; intros; try reflexivity.
-Abort.
+Abort. *)
 End SINGLE_HOLE.
 
 Module zlist_hint_db.
 
 Lemma Znth_sub_0_r: forall A {d: Inhabitant A} i (l: list A), Znth (i - 0) l = Znth i l.
   intros.
-  rewrite Z.sub_0_r by lia.
+  rewrite ->Z.sub_0_r by lia.
   auto.
 Qed.
 
@@ -255,7 +256,8 @@ Ltac pose_proj_reptype CS t gfs v H :=
      end
   end.
 
-Ltac pose_upd_reptype_1 CS t gf v v0 H :=
+(* FIXME these look like they are obsolete? *)
+(* Ltac pose_upd_reptype_1 CS t gf v v0 H :=
   let t' := eval compute in t in
   assert (data_equal (@upd_gfield_reptype CS t gf v v0) (@upd_gfield_reptype CS t' gf v v0)) as H
     by reflexivity;
@@ -275,7 +277,7 @@ Ltac pose_upd_reptype_1 CS t gf v v0 H :=
     pose proof (JMeq_eq (fold_reptype_JMeq t' v_res)) as H0;
     rewrite H0 in H;
     clear H0
-  end.
+  end. *)
 (*
 Ltac pose_upd_reptype CS t gfs v v0 H :=
   match gfs with
diff --git a/floyd/reptype_lemmas.v b/floyd/reptype_lemmas.v
index 4073934841..7743c330d4 100644
--- a/floyd/reptype_lemmas.v
+++ b/floyd/reptype_lemmas.v
@@ -1,9 +1,13 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.type_induction.
 Require Export VST.floyd.compact_prod_sum.
 Require Import VST.floyd.fieldlist.
 Require Import VST.zlist.sublist.
 
+Local Unset SsrRewrite.
+
 Definition
 map_map: forall {A B C : Type} (f : A -> B) (g : B -> C) (l : list A),
        map g (map f l) = map (fun x : A => g (f x)) l :=
@@ -56,20 +60,20 @@ Proof.
 Defined.
 
 Definition compact_prod_map {X: Type} {F F0: X -> Type} (l: list X)
-  (f: ListType (map (fun x => F x -> F0 x) l)): compact_prod (map F l) -> compact_prod (map F0 l).
+  (f: hlist (tmap (fun x => F x -> F0 x) l)): compact_prod (map F l) -> compact_prod (map F0 l).
 Proof.
   intros.
   destruct l; [exact tt |].
   revert x f X0; induction l; intros; simpl in *.
   + inversion f; subst.
-    exact (a X0).
+    exact (X1 X0).
   + remember ((F a -> F0 a) :: map (fun x0 : X => F x0 -> F0 x0) l) as L;
     inversion f; subst.
-    exact (a0 (fst X0), IHl a b (snd X0)).
+    exact (X1 (fst X0), IHl a X2 (snd X0)).
 Defined.
 
 Lemma compact_prod_map_nil: forall {X: Type} {F F0: X -> Type},
-  @compact_prod_map X F F0 nil Nil tt = tt.
+  @compact_prod_map X F F0 nil hnil tt = tt.
 Proof.
   intros.
   reflexivity.
@@ -77,39 +81,39 @@ Qed.
 
 Lemma compact_prod_map_single: forall {X: Type} {F F0: X -> Type} (x: X)
   (f: F x -> F0 x) (v: F x),
-  compact_prod_map (x :: nil) (Cons f Nil) v = f v.
+  compact_prod_map (x :: nil) (hcons f hnil) v = f v.
 Proof.
   intros.
   reflexivity.
 Qed.
 
 Lemma compact_prod_map_cons: forall {X: Type} {F F0: X -> Type} (x x0: X) (l: list X)
-  (f: F x -> F0 x) (fl: ListType (map (fun x => F x -> F0 x) (x0 :: l)))
+  (f: F x -> F0 x) (fl: hlist (tmap (fun x => F x -> F0 x) (x0 :: l)))
   (v: F x) (vl: compact_prod (map F (x0 :: l))),
-  compact_prod_map (x :: x0 :: l) (Cons f fl) (v, vl) = (f v, compact_prod_map _ fl vl).
+  compact_prod_map (x :: x0 :: l) (hcons f fl) (v, vl) = (f v, compact_prod_map _ fl vl).
 Proof.
   intros.
   reflexivity.
 Qed.
 
 Definition compact_sum_map {X: Type} {F F0: X -> Type} (l: list X)
-  (f: ListType (map (fun x => F x -> F0 x) l)): compact_sum (map F l) -> compact_sum (map F0 l).
+  (f: hlist (tmap (fun x => F x -> F0 x) l)): compact_sum (map F l) -> compact_sum (map F0 l).
 Proof.
   intros.
   destruct l; [exact tt |].
   revert x f X0; induction l; intros; simpl in *.
   + inversion f; subst.
-    exact (a X0).
+    exact (X1 X0).
   + remember ((F a -> F0 a) :: map (fun x0 : X => F x0 -> F0 x0) l) as L;
     inversion f; subst.
     exact match X0 with
-          | inl X0_l => inl (a0 X0_l)
-          | inr X0_r => inr (IHl a b X0_r)
+          | inl X0_l => inl (X1 X0_l)
+          | inr X0_r => inr (IHl a X2 X0_r)
           end.
 Defined.
 
 Lemma compact_sum_map_nil: forall {X: Type} {F F0: X -> Type},
-  @compact_sum_map X F F0 nil Nil tt = tt.
+  @compact_sum_map X F F0 nil hnil tt = tt.
 Proof.
   intros.
   reflexivity.
@@ -117,25 +121,25 @@ Qed.
 
 Lemma compact_sum_map_single: forall {X: Type} {F F0: X -> Type} (x: X)
   (f: F x -> F0 x) (v: F x),
-  compact_sum_map (x :: nil) (Cons f Nil) v = f v.
+  compact_sum_map (x :: nil) (hcons f hnil) v = f v.
 Proof.
   intros.
   reflexivity.
 Qed.
 
 Lemma compact_sum_map_cons_inl: forall {X: Type} {F F0: X -> Type} (x x0: X) (l: list X)
-  (f: F x -> F0 x) (fl: ListType (map (fun x => F x -> F0 x) (x0 :: l)))
+  (f: F x -> F0 x) (fl: hlist (tmap (fun x => F x -> F0 x) (x0 :: l)))
   (v: F x),
-  compact_sum_map (x :: x0 :: l) (Cons f fl) (inl v) = inl (f v).
+  compact_sum_map (x :: x0 :: l) (hcons f fl) (inl v) = inl (f v).
 Proof.
   intros.
   reflexivity.
 Qed.
 
 Lemma compact_sum_map_cons_inr: forall {X: Type} {F F0: X -> Type} (x x0: X) (l: list X)
-  (f: F x -> F0 x) (fl: ListType (map (fun x => F x -> F0 x) (x0 :: l)))
+  (f: F x -> F0 x) (fl: hlist (tmap (fun x => F x -> F0 x) (x0 :: l)))
   (vl: compact_sum (map F (x0 :: l))),
-  compact_sum_map (x :: x0 :: l) (Cons f fl) (inr vl) = inr (compact_sum_map _ fl vl).
+  compact_sum_map (x :: x0 :: l) (hcons f fl) (inr vl) = inr (compact_sum_map _ fl vl).
 Proof.
   intros.
   reflexivity.
@@ -145,26 +149,26 @@ Definition reptype_gen {cs: compspecs} : type -> (sigT (fun x => x)) :=
   type_func (fun _ => (sigT (fun x => x)))
   (fun t =>
      if (type_is_by_value t)
-     then existT (fun x => x) val Vundef
-     else existT (fun x => x) unit tt)
-  (fun t n a TV => existT (fun x => x) (list (projT1 TV)) (Zrepeat (projT2 TV) n))
-  (fun id a TVs => existT (fun x => x) (compact_prod_sigT_type (decay TVs)) (compact_prod_sigT_value (decay TVs)))
-  (fun id a TVs => existT (fun x => x) (compact_sum_sigT_type (decay TVs)) (compact_sum_sigT_value (decay TVs))).
+     then existT (P := fun x => x) val Vundef
+     else existT (P := fun x => x) unit tt)
+  (fun t n a TV => existT (P := fun x => x) (list (projT1 TV)) (Zrepeat (projT2 TV) n))
+  (fun id a TVs => existT (P := fun x => x) (compact_prod_sigT_type (decay TVs)) (compact_prod_sigT_value (decay TVs)))
+  (fun id a TVs => existT (P := fun x => x) (compact_sum_sigT_type (decay TVs)) (compact_sum_sigT_value (decay TVs))).
 
 Definition reptype_gen0 {cs: compspecs} : type -> (sigT (fun x => x)) :=
   type_func (fun _ => (sigT (fun x => x)))
   (fun t =>
      match t with
-     | Tint _ _ _ => existT (fun x => x) val (Vint Int.zero)
-     | Tlong _ _ => existT (fun x => x) val (Vlong Int64.zero)
-     | Tfloat F32 _ => existT (fun x => x) val (Vsingle Float32.zero)
-     | Tfloat F64 _ => existT (fun x => x) val (Vfloat Float.zero)
-     | Tpointer _ _ => existT (fun x => x) val (Vptrofs Ptrofs.zero)
-     | _ => existT (fun x => x) unit tt
+     | Tint _ _ _ => existT (P := fun x => x) val (Vint Int.zero)
+     | Tlong _ _ => existT (P := fun x => x) val (Vlong Int64.zero)
+     | Tfloat F32 _ => existT (P := fun x => x) val (Vsingle Float32.zero)
+     | Tfloat F64 _ => existT (P := fun x => x) val (Vfloat Float.zero)
+     | Tpointer _ _ => existT (P := fun x => x) val (Vptrofs Ptrofs.zero)
+     | _ => existT (P := fun x => x) unit tt
      end)
-  (fun t n a TV => existT (fun x => x) (list (projT1 TV)) (Zrepeat (projT2 TV) n))
-  (fun id a TVs => existT (fun x => x) (compact_prod_sigT_type (decay TVs)) (compact_prod_sigT_value (decay TVs)))
-  (fun id a TVs => existT (fun x => x) (compact_sum_sigT_type (decay TVs)) (compact_sum_sigT_value (decay TVs))).
+  (fun t n a TV => existT (P := fun x => x) (list (projT1 TV)) (Zrepeat (projT2 TV) n))
+  (fun id a TVs => existT (P := fun x => x) (compact_prod_sigT_type (decay TVs)) (compact_prod_sigT_value (decay TVs)))
+  (fun id a TVs => existT (P := fun x => x) (compact_sum_sigT_type (decay TVs)) (compact_sum_sigT_value (decay TVs))).
 
 Definition reptype {cs: compspecs} t: Type := match reptype_gen t with existT t _ => t end.
 
@@ -178,16 +182,16 @@ Definition default_val {cs: compspecs} t: reptype t :=
 Lemma reptype_gen_eq {cs: compspecs}: forall t,
   reptype_gen t =
   match t with
-  | Tarray t0 n _ => existT (fun x => x) (list (projT1 (reptype_gen t0))) (Zrepeat (projT2 (reptype_gen t0)) n)
-  | Tstruct id _ => existT (fun x => x)
+  | Tarray t0 n _ => existT (P := fun x => x) (list (projT1 (reptype_gen t0))) (Zrepeat (projT2 (reptype_gen t0)) n)
+  | Tstruct id _ => existT (P := fun x => x)
                      (compact_prod_sigT_type (map reptype_gen (map (fun it => field_type (name_member it) (co_members (get_co id))) (co_members (get_co id)))))
                      (compact_prod_sigT_value (map reptype_gen (map (fun it => field_type (name_member it) (co_members (get_co id))) (co_members (get_co id)))))
-  | Tunion id _ => existT (fun x => x)
+  | Tunion id _ => existT (P := fun x => x)
                      (compact_sum_sigT_type (map reptype_gen (map (fun it => field_type (name_member it) (co_members (get_co id))) (co_members (get_co id)))))
                      (compact_sum_sigT_value (map reptype_gen (map (fun it => field_type (name_member it) (co_members (get_co id))) (co_members (get_co id)))))
   | _ => if (type_is_by_value t)
-         then existT (fun x => x) val Vundef
-         else existT (fun x => x) unit tt
+         then existT (P := fun x => x) val Vundef
+         else existT (P := fun x => x) unit tt
   end.
 Proof.
   intros.
@@ -206,21 +210,21 @@ Defined.
 Lemma reptype_gen0_eq {cs: compspecs}: forall t,
   reptype_gen0 t =
   match t with
-  | Tarray t0 n _ => existT (fun x => x) (list (projT1 (reptype_gen0 t0))) (Zrepeat (projT2 (reptype_gen0 t0)) n)
-  | Tstruct id _ => existT (fun x => x)
+  | Tarray t0 n _ => existT (P := fun x => x) (list (projT1 (reptype_gen0 t0))) (Zrepeat (projT2 (reptype_gen0 t0)) n)
+  | Tstruct id _ => existT (P := fun x => x)
                      (compact_prod_sigT_type (map reptype_gen0 (map (fun it => field_type (name_member it) (co_members (get_co id))) (co_members (get_co id)))))
                      (compact_prod_sigT_value (map reptype_gen0 (map (fun it => field_type (name_member it) (co_members (get_co id))) (co_members (get_co id)))))
-  | Tunion id _ => existT (fun x => x)
+  | Tunion id _ => existT (P := fun x => x)
                      (compact_sum_sigT_type (map reptype_gen0 (map (fun it => field_type (name_member it) (co_members (get_co id))) (co_members (get_co id)))))
                      (compact_sum_sigT_value (map reptype_gen0 (map (fun it => field_type (name_member it) (co_members (get_co id))) (co_members (get_co id)))))
   | _ => 
      match t with
-     | Tint _ _ _ => existT (fun x => x) val (Vint Int.zero)
-     | Tlong _ _ => existT (fun x => x) val (Vlong Int64.zero)
-     | Tfloat F32 _ => existT (fun x => x) val (Vsingle Float32.zero)
-     | Tfloat F64 _ => existT (fun x => x) val (Vfloat Float.zero)
-     | Tpointer _ _ => existT (fun x => x) val (Vptrofs Ptrofs.zero)
-     | _ => existT (fun x => x) unit tt
+     | Tint _ _ _ => existT (P := fun x => x) val (Vint Int.zero)
+     | Tlong _ _ => existT (P := fun x => x) val (Vlong Int64.zero)
+     | Tfloat F32 _ => existT (P := fun x => x) val (Vsingle Float32.zero)
+     | Tfloat F64 _ => existT (P := fun x => x) val (Vfloat Float.zero)
+     | Tpointer _ _ => existT (P := fun x => x) val (Vptrofs Ptrofs.zero)
+     | _ => existT (P := fun x => x) unit tt
      end
   end.
 Proof.
@@ -246,7 +250,7 @@ assert (forall t, projT1 (reptype_gen t) = projT1 (reptype_gen0 t)).
 clear t; intro t.
 type_induction t; auto.
 - destruct f; auto.
--  rewrite reptype_gen_eq, reptype_gen0_eq. simpl; f_equal; auto.
+- rewrite reptype_gen_eq, reptype_gen0_eq. simpl; f_equal; auto.
 - rewrite reptype_gen_eq, reptype_gen0_eq. simpl.
    forget (co_members (get_co id)) as m. clear id.
    cbv zeta in IH.
@@ -398,7 +402,7 @@ Definition union_default_filter m :=
   | hd :: _ => fun m => if member_dec hd m then true else false
   end.
 
-Definition is_default_filter {A} f (l: list A) :=
+Definition is_default_filter {A} f (l: list A) : Prop :=
   match l with
   | nil => True
   | hd :: _ => f hd = true
@@ -446,11 +450,11 @@ Qed.
 
 Lemma compact_prod_sigT_compact_prod_gen:
   forall {A B} {P: A -> Type} (genT: B -> A) (genV: forall b: B, P (genT b)) (gen: B -> sigT P) (l: list B),
-    (forall b, gen b = existT P (genT b) (genV b)) ->
+    (forall b, gen b = existT (genT b) (genV b)) ->
     JMeq (compact_prod_sigT_value (map gen l)) (compact_prod_gen genV l).
 Proof.
   intros.
-  assert (gen = fun b => existT P (genT b) (genV b)) by (extensionality; apply H).
+  assert (gen = fun b => existT (genT b) (genV b)) by (extensionality; apply H).
   rewrite H0; clear H H0 gen.
   destruct l; [apply JMeq_refl |].
   revert b; induction l; intros.
@@ -458,28 +462,28 @@ Proof.
   + simpl map.
     change (compact_prod_gen genV (b :: a :: l)) with (genV b, compact_prod_gen genV (a :: l)).
     change (compact_prod_sigT_value
-        (existT P (genT b) (genV b)
-         :: existT P (genT a) (genV a)
-            :: map (fun b0 : B => existT P (genT b0) (genV b0)) l)) with
-      (genV b, compact_prod_sigT_value (existT P (genT a) (genV a) :: map (fun b0 : B => existT P (genT b0) (genV b0)) l)).
+        (existT (genT b) (genV b)
+         :: existT (genT a) (genV a)
+            :: map (fun b0 : B => existT (genT b0) (genV b0)) l)) with
+      (genV b, compact_prod_sigT_value (existT (genT a) (genV a) :: map (fun b0 : B => existT (genT b0) (genV b0)) l)).
     apply JMeq_pair; [auto |].
     exact (IHl a).
 Qed.
 
 Lemma compact_sum_sigT_compact_sum_gen:
   forall {A B} {P: A -> Type} (genT: B -> A) (genV: forall b: B, P (genT b)) (filter: B -> bool) (gen: B -> sigT P) (l: list B),
-    (forall b, gen b = existT P (genT b) (genV b)) ->
+    (forall b, gen b = existT (genT b) (genV b)) ->
     is_default_filter filter l ->
     JMeq (compact_sum_sigT_value (map gen l)) (compact_sum_gen filter genV l).
 Proof.
   intros.
-  assert (gen = fun b => existT P (genT b) (genV b)) by (extensionality; apply H).
+  assert (gen = fun b => existT (genT b) (genV b)) by (extensionality; apply H).
   rewrite H1; clear H H1 gen.
   destruct l; [apply JMeq_refl |].
   destruct l.
   + apply JMeq_refl.
   + change (compact_sum_sigT_value
-        (map (fun b1 : B => existT P (genT b1) (genV b1)) (b :: b0 :: l))) with
+        (map (fun b1 : B => existT (genT b1) (genV b1)) (b :: b0 :: l))) with
   (@inl (P (genT b)) (compact_sum (map (fun tv => match tv with existT t _ => P t end) (map (fun b1 : B => @existT A P (genT b1) (genV b1)) (b0 :: l)))) (genV b)).
     change (compact_sum (map (fun tv => match _ with existT t _ => P t end) (map (fun b1 : B => @existT A P (genT b1) (genV b1)) (b :: b0 :: l)))) with
       (P (genT b) + compact_sum (map (fun tv => match tv with existT t _ => P t end) (map (fun b1 : B => @existT A P (genT b1) (genV b1)) (b0 :: l))))%type.
@@ -726,10 +730,10 @@ Definition repinj_bv (t: type): reptype' t -> reptype t :=
    | Tunion id a => fun _ => union_default_val _
    end (unfold_reptype' v)).
 
-Definition repinj_aux_s (id: ident) (a: attr) (F: ListType (map (fun it => reptype' (field_type (name_member it) (co_members (get_co id))) -> reptype (field_type (name_member it) (co_members (get_co id)))) (co_members (get_co id)))): reptype' (Tstruct id a) -> reptype (Tstruct id a) :=
+Definition repinj_aux_s (id: ident) (a: attr) (F: hlist (tmap (fun it => reptype' (field_type (name_member it) (co_members (get_co id))) -> reptype (field_type (name_member it) (co_members (get_co id)))) (co_members (get_co id)))): reptype' (Tstruct id a) -> reptype (Tstruct id a) :=
   fun v => @fold_reptype (Tstruct id a) (compact_prod_map _ F (unfold_reptype' v)).
 
-Definition repinj_aux_u (id: ident) (a: attr) (F: ListType (map (fun it => reptype' (field_type (name_member it) (co_members (get_co id))) -> reptype (field_type (name_member it) (co_members (get_co id)))) (co_members (get_co id)))): reptype' (Tunion id a) -> reptype (Tunion id a) :=
+Definition repinj_aux_u (id: ident) (a: attr) (F: hlist (tmap (fun it => reptype' (field_type (name_member it) (co_members (get_co id))) -> reptype (field_type (name_member it) (co_members (get_co id)))) (co_members (get_co id)))): reptype' (Tunion id a) -> reptype (Tunion id a) :=
   fun v => @fold_reptype (Tunion id a) (compact_sum_map _ F (unfold_reptype' v)).
 
 Definition repinj: forall t: type, reptype' t -> reptype t :=
@@ -750,8 +754,8 @@ Lemma repinj_eq: forall t v,
    | Tfloat _ a => Vfloat
    | Tpointer _ a => pointer_val_val
    | Tarray t0 _ _ => map (repinj t0)
-   | Tstruct id a => compact_prod_map _ (ListTypeGen (fun it => reptype' (field_type (name_member it) (co_members (get_co id))) -> reptype (field_type (name_member it) (co_members (get_co id)))) (fun it => repinj (field_type (name_member it) (co_members (get_co id)))) (co_members (get_co id)))
-   | Tunion id a => compact_sum_map _ (ListTypeGen (fun it => reptype' (field_type (name_member it) (co_members (get_co id))) -> reptype (field_type (name_member it) (co_members (get_co id)))) (fun it => repinj (field_type (name_member it) (co_members (get_co id)))) (co_members (get_co id)))
+   | Tstruct id a => compact_prod_map _ (hmap (fun it => reptype' (field_type (name_member it) (co_members (get_co id))) -> reptype (field_type (name_member it) (co_members (get_co id)))) (fun it => repinj (field_type (name_member it) (co_members (get_co id)))) (co_members (get_co id)))
+   | Tunion id a => compact_sum_map _ (hmap (fun it => reptype' (field_type (name_member it) (co_members (get_co id))) -> reptype (field_type (name_member it) (co_members (get_co id)))) (fun it => repinj (field_type (name_member it) (co_members (get_co id)))) (co_members (get_co id)))
    end (unfold_reptype' v)).
 Proof.
   intros.
@@ -808,7 +812,7 @@ Lemma repinject_unfold_reptype: forall t v,
   | Tfloat _ _
   | Tlong _ _
   | Tpointer _ _ => fun vv => repinject t v = vv
-  | _ => fun _ => True
+  | _ => fun _ => True%type
   end (unfold_reptype v).
 Proof.
   intros; destruct t; auto;
@@ -1154,7 +1158,8 @@ intros.
  assert (n <= length al)%nat by lia; clear H0.
  revert al H; induction n; simpl; intros; auto.
  destruct al; simpl in H. lia.
- f_equal.
+ simpl. f_equal.
+ unfold drop in IHn.
  rewrite <- (IHn al) by lia. clear IHn.
  rewrite <- (replist'_succ 0 n r al) by lia.
  reflexivity.
diff --git a/floyd/sc_set_load_store.v b/floyd/sc_set_load_store.v
index 3924434123..9a24c6d65e 100644
--- a/floyd/sc_set_load_store.v
+++ b/floyd/sc_set_load_store.v
@@ -1,4 +1,6 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.nested_field_lemmas.
 Require Import VST.floyd.efield_lemmas.
@@ -18,23 +20,20 @@ Require Import VST.floyd.local2ptree_denote.
 Require Import VST.floyd.local2ptree_eval.
 Require Import VST.floyd.simpl_reptype.
 Import LiftNotation.
-Import compcert.lib.Maps.
-
-Local Open Scope logic.
+Import -(notations) compcert.lib.Maps.
 
 Section SEMAX_SC.
 
-Context {cs: compspecs}.
+Context `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {cs: compspecs}.
 
 Lemma semax_SC_set:
-  forall {Espec: OracleKind},
-    forall Delta id P Q R (e2: expr) t v,
+    forall E Delta id P Q R (e2: expr) t v,
       typeof_temp Delta id = Some t ->
       is_neutral_cast (implicit_deref (typeof e2)) t = true ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- local (`(eq v) (eval_expr e2)) ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢ local (`(eq v) (eval_expr e2)) ->
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
          (tc_expr Delta e2) ->
-      semax Delta (|>PROPx P (LOCALx Q (SEPx R)))
+      semax E Delta (▷PROPx P (LOCALx Q (SEPx R)))
         (Sset id e2)
           (normal_ret_assert
             (PROPx P
@@ -44,24 +43,28 @@ Proof.
   intros.
   assert_PROP (tc_val (typeof e2) v).
   {
-    rewrite (add_andp _ _ H1), (add_andp _ _ H2).
-    unfold_lift.
-    intro rho; unfold local, lift1; simpl.
-    normalize.
-    apply andp_left2.
-    apply typecheck_expr_sound; auto.
+    rewrite (add_andp _ _ H1) (add_andp _ _ H2).
+    remember (PROPx _ _) as PQR.
+    raise_rho. super_unfold_lift.
+    subst.
+    rewrite bi.and_comm.
+    apply bi.pure_elim_l => ?; subst.
+    rewrite -bi.and_assoc.
+    apply bi.pure_elim_l => tc.
+    rewrite -typecheck_expr_sound. 2: { apply tc. }
+    apply bi.and_elim_r.
   }
   assert (v <> Vundef) as UNDEF by (intro; subst; apply tc_val_Vundef in H3; auto).
   clear H3.
-  assert (ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
-     (tc_expr Delta e2) &&  (tc_temp_id id (typeof e2) Delta e2)).
+  assert (ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
+     ((tc_expr Delta e2) ∧ (tc_temp_id id (typeof e2) Delta e2))).
   {
-    apply andp_right.
+    apply bi.and_intro.
     + auto.
     + unfold tc_temp_id.
       unfold typecheck_temp_id.
       unfold typeof_temp in H.
-      destruct ((temp_types Delta) ! id) as [?|]; [| inversion H].
+      destruct ((temp_types Delta) !! id) as [?|]; [| inversion H].
       inversion H; clear H; subst.
       rewrite H0.
       simpl denote_tc_assert; simpl; intros.
@@ -72,43 +75,43 @@ Proof.
   {
     hoist_later_left.
     rewrite (add_andp _ _ H3).
-    rewrite andp_comm.
+    rewrite bi.and_comm.
     rewrite (add_andp _ _ H1).
-    apply later_derives.
-    apply andp_derives; [apply derives_refl |].
-    apply andp_derives; [| apply derives_refl].
-    apply andp_left2.
-    apply derives_refl.
+    apply bi.later_mono.
+    apply bi.and_mono; [apply derives_refl |].
+    apply bi.and_mono; [| apply derives_refl].
+    apply bi.and_elim_r.
   }
-  eapply semax_post'; [| apply semax_set_forward].
-  apply andp_left2; 
+  eapply semax_post'. 2:{ rewrite -bi.and_assoc.  apply semax_set_forward. }
+  rewrite bi.and_elim_r; 
   rewrite <- insert_local.
-  eapply derives_trans; [| apply andp_derives; [apply derives_refl | apply remove_localdef_temp_PROP]].
-  normalize.
-  apply (exp_right old).
-  autorewrite with subst.
-  rewrite andp_comm, andp_assoc, andp_comm.
-  apply andp_derives; auto.
-  simpl; unfold local, lift1; unfold_lift; intro rho; simpl.
+  eapply derives_trans; [| apply bi.and_mono; [apply derives_refl | apply remove_localdef_temp_PROP]].
+  (* TODO maybe normalize shouldn't unfold local? *)
+  split => rho; monPred.unseal.
+  Opaque local. normalize. Transparent local.
+  apply (bi.exist_intro' _ _ x).
+  rewrite bi.and_comm -bi.and_assoc bi.and_comm.
+  apply bi.and_mono; auto.
+  simpl; unfold local, lift1; unfold_lift; raise_rho; simpl.
   normalize.
 Qed.
 
 Lemma semax_SC_field_load:
-  forall {Espec: OracleKind} n (Delta: tycontext) sh id P Q R e1
+  forall E n (Delta: tycontext) sh id P Q R e1
     t_id t_root gfs0 gfs1 gfs (p v_val: val) (v_reptype: reptype (nested_field_type t_root gfs0)),
     typeof e1 = nested_field_type t_root gfs ->
     typeof_temp Delta id = Some t_id ->
     is_neutral_cast (nested_field_type t_root gfs) t_id = true ->
     type_is_volatile (nested_field_type t_root gfs) = false ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
        local (`(eq (field_address t_root gfs p)) (eval_lvalue e1)) ->
     nth_error R n = Some (field_at sh t_root gfs0 v_reptype p) ->
     gfs = gfs1 ++ gfs0 ->
     readable_share sh ->
     JMeq (proj_reptype (nested_field_type t_root gfs0) gfs1 v_reptype) v_val ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
-      (tc_lvalue Delta e1) && local (`(tc_val (nested_field_type t_root gfs) v_val)) ->
-    @semax cs Espec Delta (|> PROPx P (LOCALx Q (SEPx R)))
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
+      ((tc_lvalue Delta e1) ∧ local (`(tc_val (nested_field_type t_root gfs) v_val))) ->
+    semax E Delta (▷ PROPx P (LOCALx Q (SEPx R)))
       (Sset id e1)
       (normal_ret_assert
          (PROPx P
@@ -118,69 +121,48 @@ Proof.
   intros.
   assert_PROP (field_compatible t_root gfs p).
   {
-    rewrite (add_andp _ _ H8), (add_andp _ _ H3).
-    apply derives_trans with (local (tc_environ Delta) && local (` (eq (field_address t_root gfs p)) (eval_lvalue e1)) && (tc_lvalue Delta e1)); [solve_andp |].
-    unfold local, lift1; intros rho; simpl; unfold_lift.
-    normalize.
-    eapply derives_trans; [apply typecheck_lvalue_sound; auto |].
-    rewrite <- H10; normalize.
+    rewrite (add_andp _ _ H8) (add_andp _ _ H3).
+    apply derives_trans with (local (tc_environ Delta) ∧ local (` (eq (field_address t_root gfs p)) (eval_lvalue e1)) ∧ (tc_lvalue Delta e1)); [solve_andp |].
+    unfold local, lift1; raise_rho; simpl; unfold_lift.
+    iIntros "(% & % & H)".
+    iDestruct (typecheck_lvalue_sound with "H") as %Htc; first done.
+    rewrite -H10 in Htc; auto.
   }
   subst gfs.
   pose proof nested_field_ramif_load sh _ _ _ _ _ _ H9 H7 as [v_reptype' [? ?]].
-  eapply semax_load_nth_ram_field_at.
-  1: eassumption.
-  1: eassumption.
-  1: eassumption.
-  1: eassumption.
-  1: eassumption.
-  1: eassumption.
-  1: eassumption.
-  1: eassumption.
-  1: eassumption.
-  1: eassumption.
+  eapply semax_load_nth_ram_field_at; done.
 Qed.
 
+Local Notation PROPx := (PROPx(Σ := Σ)).
+
 Lemma nth_error_SEP_sepcon_TT': forall D P Q R n Rn S,
-  ENTAIL D, PROPx P (LOCALx Q (SEPx (Rn :: nil))) |-- S ->
+  ENTAIL D, PROPx P (LOCALx Q (SEPx (Rn :: nil))) ⊢ S ->
   nth_error R n = Some Rn ->
-  ENTAIL D, (PROPx P (LOCALx Q (SEPx R))) |-- S * TT.
+  ENTAIL D, (PROPx P (LOCALx Q (SEPx R))) ⊢ (S ∗ True).
 Proof.
   intros.
   erewrite SEP_nth_isolate by eauto.
-  unfold PROPx, LOCALx, SEPx in *.
-  unfold local, lift1 in H |- *.
-  unfold_lift in H.
-  unfold_lift.
-  simpl in H |- *.
-  intros rho.
-  specialize (H rho).
-  rewrite <- !andp_assoc in H |- *.
-  rewrite <- !prop_and in H |- *.
-  rewrite sepcon_emp in H.
-  rewrite <- sepcon_andp_prop'.
-  apply sepcon_derives.
-  exact H.
-  apply prop_right.
-  auto.
+  rewrite PROP_LOCAL_sep1 bi.persistent_and_sep_assoc H.
+  iIntros "($ & _)".
 Qed.
 
 Lemma semax_SC_field_cast_load:
-  forall {Espec: OracleKind} n (Delta: tycontext) sh id P Q R e1 t
+  forall n E (Delta: tycontext) sh id P Q R e1 t
     t_root gfs0 gfs1 gfs (p v_val: val) (v_reptype: reptype (nested_field_type t_root gfs0)),
     typeof e1 = nested_field_type t_root gfs ->
     typeof_temp Delta id = Some t ->
     type_is_by_value (nested_field_type t_root gfs) = true ->
     cast_pointer_to_bool (nested_field_type t_root gfs) t = false ->
     type_is_volatile (nested_field_type t_root gfs) = false ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
        local (`(eq (field_address t_root gfs p)) (eval_lvalue e1)) ->
     nth_error R n = Some (field_at sh t_root gfs0 v_reptype p) ->
     gfs = gfs1 ++ gfs0 ->
     readable_share sh ->
     JMeq (proj_reptype (nested_field_type t_root gfs0) gfs1 v_reptype) v_val ->
-    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
-      (tc_lvalue Delta e1) && local (`(tc_val t (eval_cast (nested_field_type t_root gfs) t v_val))) ->
-    @semax cs Espec Delta (|> PROPx P (LOCALx Q (SEPx R)))
+    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
+      ((tc_lvalue Delta e1) ∧ local (`(tc_val t (eval_cast (nested_field_type t_root gfs) t v_val)))) ->
+    semax E Delta (▷ PROPx P (LOCALx Q (SEPx R)))
       (Sset id (Ecast e1 t))
       (normal_ret_assert
          (PROPx P
@@ -190,32 +172,20 @@ Proof.
   intros.
   assert_PROP (field_compatible t_root gfs p).
   {
-    rewrite (add_andp _ _ H9), (add_andp _ _ H4).
-    apply derives_trans with (local (tc_environ Delta) && local (` (eq (field_address t_root gfs p)) (eval_lvalue e1)) && (tc_lvalue Delta e1)); [solve_andp |].
-    unfold local, lift1; intros rho; simpl; unfold_lift.
-    normalize.
-    eapply derives_trans; [apply typecheck_lvalue_sound; auto |].
-    rewrite <- H11; normalize.
+    rewrite (add_andp _ _ H9) (add_andp _ _ H4).
+    apply derives_trans with (local (tc_environ Delta) ∧ local (` (eq (field_address t_root gfs p)) (eval_lvalue e1)) ∧ (tc_lvalue Delta e1)); [solve_andp |].
+    unfold local, lift1; split => rho; monPred.unseal; unfold_lift.
+    iIntros "(% & % & H)".
+    iDestruct (typecheck_lvalue_sound with "H") as %Htc; first done.
+    rewrite -H11 in Htc; auto.
   }
   subst gfs.
   pose proof nested_field_ramif_load sh _ _ _ _ _ _ H10 H8 as [v_reptype' [? ?]].
-  eapply semax_cast_load_nth_ram_field_at.
-  1: eassumption.
-  1: eassumption.
-  1: eassumption.
-  1: eassumption.
-  1: eassumption.
-  1: eassumption.
-  1: eassumption.
-  1: eassumption.
-  1: eassumption.
-  1: eassumption.
-  1: eassumption.
+  eapply semax_cast_load_nth_ram_field_at; done.
 Qed.
 
 Lemma semax_SC_field_store:
-  forall {Espec: OracleKind},
-    forall Delta sh n (p: val) P Q R (e1 e2 : expr)
+    forall E Delta sh n (p: val) P Q R (e1 e2 : expr)
       (t_root: type) (gfs0 gfs1 gfs: list gfield)
       (v0: reptype (nested_field_type (nested_field_type t_root gfs0) gfs1))
       (v0_val: val) (v v_new: reptype (nested_field_type t_root gfs0)),
@@ -224,17 +194,17 @@ Lemma semax_SC_field_store:
       type_is_volatile (nested_field_type t_root gfs) = false ->
       gfs = gfs1 ++ gfs0 ->
       nth_error R n = Some (field_at sh t_root gfs0 v p) ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
         local (`(eq (field_address t_root gfs p)) (eval_lvalue e1)) ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
         local (`(eq v0_val) (eval_expr (Ecast e2 (nested_field_type t_root gfs)))) ->
       writable_share sh ->
       JMeq v0 v0_val ->
       data_equal (upd_reptype (nested_field_type t_root gfs0) gfs1 v v0) v_new ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
-         (tc_lvalue Delta e1) && 
-         (tc_expr Delta (Ecast e2 (nested_field_type t_root gfs))) ->
-      semax Delta (|>PROPx P (LOCALx Q (SEPx R)))
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
+         ((tc_lvalue Delta e1) ∧ 
+         (tc_expr Delta (Ecast e2 (nested_field_type t_root gfs)))) ->
+      semax E Delta (▷PROPx P (LOCALx Q (SEPx R)))
         (Sassign e1 e2)
           (normal_ret_assert
             (PROPx P
@@ -244,36 +214,27 @@ Lemma semax_SC_field_store:
                     (field_at sh t_root gfs0 v_new p)))))).
 Proof.
   intros.
-  erewrite field_at_data_equal by (symmetry; apply H8).
+  eapply semax_post'.
+  { rewrite bi.and_elim_r /mpred; apply replace_nth_SEP.
+    rewrite -field_at_data_equal //. }
   clear H8 v_new.
   assert_PROP (field_compatible t_root gfs p).
   {
-    rewrite (add_andp _ _ H9), (add_andp _ _ H4).
-    apply derives_trans with (local (tc_environ Delta) && local (` (eq (field_address t_root gfs p)) (eval_lvalue e1)) && (tc_lvalue Delta e1)); [solve_andp |].
-    unfold local, lift1; intros rho; simpl; unfold_lift.
-    normalize.
-    eapply derives_trans; [apply typecheck_lvalue_sound; auto |].
-    rewrite <- H10; normalize.
+    rewrite (add_andp _ _ H9) (add_andp _ _ H4).
+    apply derives_trans with (local (tc_environ Delta) ∧ local (` (eq (field_address t_root gfs p)) (eval_lvalue e1)) ∧ (tc_lvalue Delta e1)); [solve_andp |].
+    unfold local, lift1; split => rho; monPred.unseal; unfold_lift.
+    iIntros "(% & % & H)".
+    iDestruct (typecheck_lvalue_sound with "H") as %Htc; first done.
+    rewrite -H10 in Htc; auto.
   }
   subst gfs.
   pose proof nested_field_ramif_store sh _ _ _ v _ _ _ H8 H7 as [v_reptype' [? ?]].
-  eapply semax_store_nth_ram_field_at.
-  1: eassumption.
-  1: eassumption.
-  1: eassumption.
-  1: eassumption.
-  1: eassumption.
-  1: apply @JMeq_sym. eassumption.
-  1: eassumption.
-  1: eassumption.
-  1: eassumption.
-  rewrite (add_andp _ _ H9), (add_andp _ _ H5); solve_andp.
+  eapply semax_store_nth_ram_field_at; try done.
+  by apply @JMeq_sym.
 Qed.
 
-
 Lemma semax_SC_field_store_union_hack (gfs1': list gfield):
-  forall {Espec: OracleKind},
-    forall Delta sh n (p: val) P Q R (e1 e2 : expr) ch ch'
+    forall E Delta sh n (p: val) P Q R (e1 e2 : expr) ch ch'
       (t_root: type) (gfs0 gfs1 gfs gfs': list gfield)
       (v0: reptype (nested_field_type (nested_field_type t_root gfs0) gfs1'))
       (v0_val v0_val': val) (v v_new: reptype (nested_field_type t_root gfs0)),
@@ -288,19 +249,19 @@ Lemma semax_SC_field_store_union_hack (gfs1': list gfield):
       gfs = gfs1 ++ gfs0 ->
       gfs' = gfs1' ++ gfs0 ->
       nth_error R n = Some (field_at sh t_root gfs0 v p) ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
         local (`(eq (field_address t_root gfs p)) (eval_lvalue e1)) ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
         local (`(eq v0_val) (eval_expr (Ecast e2 (nested_field_type t_root gfs)))) ->
       writable_share sh ->
       decode_encode_val v0_val ch ch' v0_val' ->
       JMeq v0 v0_val' ->
       data_equal (upd_reptype (nested_field_type t_root gfs0) gfs1' v v0) v_new ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
-         (tc_lvalue Delta e1) && 
-         (tc_expr Delta (Ecast e2 (nested_field_type t_root gfs))) &&
-         !! field_compatible t_root gfs' p ->
-      semax Delta (|>PROPx P (LOCALx Q (SEPx R)))
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
+         ((tc_lvalue Delta e1) ∧ 
+         (tc_expr Delta (Ecast e2 (nested_field_type t_root gfs))) ∧
+         ⌜field_compatible t_root gfs' p⌝) ->
+      semax E Delta (▷PROPx P (LOCALx Q (SEPx R)))
         (Sassign e1 e2)
           (normal_ret_assert
             (PROPx P
@@ -311,41 +272,35 @@ Lemma semax_SC_field_store_union_hack (gfs1': list gfield):
 Proof.
   intros *.
   intros H H0 H0' NT OK H1 H1' NFO H2 H2' H3 H4 H5 H6 DE H7 H8 H9.
-  erewrite field_at_data_equal by (symmetry; apply H8).
+  eapply semax_post'.
+  { rewrite bi.and_elim_r /mpred; apply replace_nth_SEP.
+    rewrite -field_at_data_equal //. }
   clear H8 v_new.
   assert_PROP (field_compatible t_root gfs p /\ field_compatible t_root gfs' p) as H8.
   {
-    rewrite (add_andp _ _ H9), (add_andp _ _ H4).
+    rewrite (add_andp _ _ H9) (add_andp _ _ H4).
     apply derives_trans 
-        with (local (tc_environ Delta) && local (` (eq (field_address t_root gfs p)) (eval_lvalue e1)) 
-                && (tc_lvalue Delta e1) && !! (field_compatible t_root gfs' p)); [solve_andp |].
-    rewrite prop_and.
-    unfold local, lift1; intros rho; simpl; unfold_lift.
-    apply andp_derives; auto.
-    normalize.
-    eapply derives_trans; [apply typecheck_lvalue_sound; auto |].
-    rewrite <- H10; normalize.
+        with (local (tc_environ Delta) ∧ local (` (eq (field_address t_root gfs p)) (eval_lvalue e1)) 
+                ∧ (tc_lvalue Delta e1) ∧ ⌜field_compatible t_root gfs' p⌝); [solve_andp |].
+    unfold local, lift1; split => rho; monPred.unseal; unfold_lift.
+    iIntros "(% & % & H & %)".
+    iDestruct (typecheck_lvalue_sound with "H") as %Htc; first done.
+    rewrite -H10 in Htc; auto.
   }
   destruct H8 as [H8 FC'].
   subst gfs.
   subst gfs'.
   pose proof nested_field_ramif_store sh _ _ _ v _ _ _ FC' H7 as [v_reptype' [? ?]].
-  eapply semax_store_nth_ram_field_at_union_hack.
-  1-14: try eassumption.
--
-  unfold field_address. rewrite !if_true by auto. rewrite NFO; auto.
--
-  1: apply @JMeq_sym. eassumption.
--
-   replace (field_at_ sh t_root (gfs1 ++ gfs0) p) with (field_at_ sh t_root (gfs1' ++ gfs0) p); auto.
-   rewrite !field_at__memory_block. 
-   unfold field_address; rewrite !if_true by auto.
-   rewrite NFO. f_equal.
-   symmetry.
-   unfold sizeof; erewrite !size_chunk_sizeof by eauto.
-   apply semax_straight.decode_encode_val_size; eauto.
--
-  rewrite (add_andp _ _ H9), (add_andp _ _ H5); solve_andp.
+  eapply semax_store_nth_ram_field_at_union_hack; try done.
+  - unfold field_address. rewrite -> !if_true by auto. rewrite NFO; auto.
+  - by apply @JMeq_sym.
+  - assert (field_at_ sh t_root (gfs1 ++ gfs0) p ⊣⊢ field_at_ sh t_root (gfs1' ++ gfs0) p) as ->; auto.
+    rewrite !field_at__memory_block.
+    unfold field_address; rewrite -> !if_true by auto.
+    rewrite NFO. f_equiv.
+    unfold sizeof; erewrite !size_chunk_sizeof by eauto.
+    apply decode_encode_val_size; eauto.
+  - rewrite (add_andp _ _ H9) (add_andp _ _ H5); solve_andp.
 Qed.
 
 End SEMAX_SC.
@@ -374,7 +329,7 @@ Lemma ptrofs_unsigned_ofint64_repr:
 Proof.
 intros.
 unfold Ptrofs.of_int64.
-rewrite Ptrofs_repr_Int64_unsigned_special by auto.
+rewrite -> Ptrofs_repr_Int64_unsigned_special by auto.
 rewrite Ptrofs.repr_unsigned.
 auto.
 Qed.
@@ -382,8 +337,8 @@ Qed.
 Ltac solve_Ptrofs_eqm_unsigned :=
   solve
    [ autorewrite with norm;
-    rewrite ?Ptrofs_repr_Int_unsigned_special by reflexivity;
-    rewrite ?Ptrofs_repr_Int64_unsigned_special by reflexivity;
+    rewrite -> ?Ptrofs_repr_Int_unsigned_special by reflexivity;
+    rewrite -> ?Ptrofs_repr_Int64_unsigned_special by reflexivity;
     match goal with
     | |- Ptrofs_eqm_unsigned ?V _ =>
       match V with
@@ -398,7 +353,7 @@ Ltac solve_Ptrofs_eqm_unsigned :=
       | _ => rewrite <- (Ptrofs.repr_unsigned V) at 1
       end
     end;
-    rewrite ?ptrofs_unsigned_ofint64_repr by reflexivity;
+    rewrite -> ?ptrofs_unsigned_ofint64_repr by reflexivity;
     apply Ptrofs_eqm_unsigned_repr
   ].
 
@@ -406,8 +361,7 @@ Ltac solve_Ptrofs_eqm_unsigned :=
 Inductive Int64_eqm_unsigned: int64 -> Z -> Prop :=
 | Int64_eqm_unsigned_repr: forall z, Int64_eqm_unsigned (Int64.repr z) z.
 
-
-Inductive msubst_efield_denote {cs: compspecs} (Delta: tycontext) (T1: PTree.t val) (T2: PTree.t (type * val)) (GV: option globals): list efield -> list gfield -> Prop :=
+Inductive msubst_efield_denote `{!VSTGS OK_ty Σ} {cs: compspecs} (Delta: tycontext) (T1: PTree.t val) (T2: PTree.t (type * val)) (GV: option globals): list efield -> list gfield -> Prop :=
 | msubst_efield_denote_nil: msubst_efield_denote Delta T1 T2 GV nil nil
 | msubst_efield_denote_cons_array: forall ei i i' efs gfs,
     is_int_type (typeof ei) = true ->
@@ -434,51 +388,51 @@ Inductive msubst_efield_denote {cs: compspecs} (Delta: tycontext) (T1: PTree.t v
     msubst_efield_denote Delta T1 T2 GV efs gfs ->
     msubst_efield_denote Delta T1 T2 GV (eUnionField i :: efs) (UnionField i :: gfs).
 
-Lemma msubst_efield_denote_eq: forall {cs: compspecs} Delta P T1 T2 GV R efs gfs,
+Lemma msubst_efield_denote_eq: forall `{!VSTGS OK_ty Σ} {cs: compspecs} Delta P T1 T2 GV R efs gfs,
   msubst_efield_denote Delta T1 T2 GV efs gfs ->
-  ENTAIL Delta, PROPx P (LOCALx (LocalD T1 T2 GV) (SEPx R)) |-- local (efield_denote efs gfs).
+  ENTAIL Delta, PROPx(Σ := Σ) P (LOCALx (LocalD T1 T2 GV) (SEPx R)) ⊢ local (efield_denote efs gfs).
 Proof.
-  intros ? ? ? ? ? ? ? ? ? MSUBST_EFIELD_DENOTE.
+  intros ? ? ? ? ? ? ? ? ? ? ? ? MSUBST_EFIELD_DENOTE.
   induction MSUBST_EFIELD_DENOTE.
-  + intro rho; apply prop_right; constructor.
+  + split => rho; apply bi.pure_intro; constructor.
   + subst i'.
     eapply (msubst_eval_expr_eq _ P _ _ GV R) in H0.
-    rewrite (add_andp _ _ H0), (add_andp _ _ IHMSUBST_EFIELD_DENOTE).
+    rewrite (add_andp _ _ H0) (add_andp _ _ IHMSUBST_EFIELD_DENOTE).
     clear H0 IHMSUBST_EFIELD_DENOTE.
-    rewrite !andp_assoc; apply andp_left2, andp_left2.
-    unfold local, lift1; unfold_lift; intro rho; simpl.
-    normalize.
+    rewrite -!bi.and_assoc bi.and_elim_r bi.and_elim_r.
+    unfold local, lift1; unfold_lift; split => rho; monPred.unseal; simpl.
+    normalize. apply bi.pure_intro.
     constructor; auto.
     clear - H; destruct (typeof ei); inv H; destruct i0,s; simpl;
     unfold int_signed_or_unsigned; simpl;
     try apply Int.signed_range; rep_lia.
-    constructor. rewrite <- H1. f_equal.
+    constructor. rewrite <- H2. f_equal.
     unfold int_signed_or_unsigned.
     destruct (typeof ei); inv H. destruct i0, s; simpl;
     try apply Int.repr_signed; apply Int.repr_unsigned.
   + eapply (msubst_eval_expr_eq _ P _ _ GV R) in H0.
-    rewrite (add_andp _ _ H0), (add_andp _ _ IHMSUBST_EFIELD_DENOTE).
+    rewrite (add_andp _ _ H0) (add_andp _ _ IHMSUBST_EFIELD_DENOTE).
     clear H0 IHMSUBST_EFIELD_DENOTE.
-    rewrite !andp_assoc; apply andp_left2, andp_left2.
-    unfold local, lift1; unfold_lift; intro rho; simpl.
-    normalize.
+    rewrite -!bi.and_assoc bi.and_elim_r bi.and_elim_r.
+    unfold local, lift1; unfold_lift; split => rho; monPred.unseal; simpl.
+    normalize. apply bi.pure_intro.
     apply efield_denote_ArraySubsc_long; auto.
     apply array_subsc_denote_intro_long.
-    rewrite <- H2. f_equal.
+    rewrite <- H3. f_equal.
     inv H1. auto.
   + eapply (msubst_eval_expr_eq _ P _ _ GV R) in H0.
-    rewrite (add_andp _ _ H0), (add_andp _ _ IHMSUBST_EFIELD_DENOTE).
+    rewrite (add_andp _ _ H0) (add_andp _ _ IHMSUBST_EFIELD_DENOTE).
     clear H0 IHMSUBST_EFIELD_DENOTE.
-    rewrite !andp_assoc; apply andp_left2, andp_left2.
-    unfold local, lift1; unfold_lift; intro rho; simpl.
-    normalize.
+    rewrite -!bi.and_assoc bi.and_elim_r bi.and_elim_r.
+    unfold local, lift1; unfold_lift; split => rho; monPred.unseal; simpl.
+    normalize. apply bi.pure_intro.
     apply efield_denote_ArraySubsc_ptrofs; auto.
-    unfold Vptrofs in H2.
+    unfold Vptrofs in H3.
     destruct Archi.ptr64 eqn:Hp.
     *
     apply array_subsc_denote_intro_long.
     apply Ptrofs_eqm_unsigned_spec in H1.
-    rewrite <- H2; symmetry.
+    rewrite <- H3; symmetry.
     f_equal.
     clear - H1 Hp.
      rewrite <- Ptrofs.eqm64 in H1 by auto.
@@ -486,20 +440,18 @@ Proof.
    *
      apply array_subsc_denote_intro_int.
     apply Ptrofs_eqm_unsigned_spec in H1.
-    rewrite <- H2; symmetry.
+    rewrite <- H3; symmetry.
     f_equal.
     clear - H1 Hp.
      rewrite <- Ptrofs.eqm32 in H1 by auto.
     unfold Ptrofs.to_int.
     apply Int.eqm_samerepr; auto.
   + eapply derives_trans; [eassumption |].
-    unfold local, lift1; unfold_lift; intro rho; simpl.
-    normalize.
-    constructor; auto.
+    unfold local, lift1; unfold_lift; split => rho; simpl.
+    apply bi.pure_mono; constructor; auto.
   + eapply derives_trans; [eassumption |].
-    unfold local, lift1; unfold_lift; intro rho; simpl.
-    normalize.
-    constructor; auto.
+    unfold local, lift1; unfold_lift; split => rho; simpl.
+    apply bi.pure_mono; constructor; auto.
 Qed.
 
 Ltac insist_rep_lia :=
@@ -553,8 +505,8 @@ Ltac solve_msubst_efield_denote :=
             let y := fresh "y" in set (y:=j);
             unfold int_signed_or_unsigned; simpl;
             subst x;
-            rewrite ?(Int.signed_repr i) by insist_rep_lia;
-            rewrite ?(Int.unsigned_repr i) by insist_rep_lia;
+            rewrite -> ?(Int.signed_repr i) by insist_rep_lia;
+            rewrite -> ?(Int.unsigned_repr i) by insist_rep_lia;
             subst y
         | |- int_signed_or_unsigned ?t _ = _ =>
               try change (int_signed_or_unsigned t) with Int.signed;
@@ -647,16 +599,16 @@ Ltac solve_field_address_gen :=
       ]
   ].
 
-Inductive find_type_contradict_pred {cs: compspecs} (t: type) (p: val): mpred -> Prop :=
+Inductive find_type_contradict_pred `{!VSTGS OK_ty Σ} {cs: compspecs} (t: type) (p: val): mpred -> Prop :=
 | find_type_contradict_pred_data_at: forall sh t0 v0, eqb_type t0 t = false -> find_type_contradict_pred t p (data_at sh t0 v0 p)
 | find_type_contradict_pred_data_at_: forall sh t0, eqb_type t0 t = false -> find_type_contradict_pred t p (data_at_ sh t0 p)
 | find_type_contradict_pred_field_at: forall sh t0 v0, eqb_type t0 t = false -> find_type_contradict_pred t p (field_at sh t0 nil v0 p)
 | find_type_contradict_pred_field_at_: forall sh t0, eqb_type t0 t = false -> find_type_contradict_pred t p (field_at_ sh t0 nil p).
 
-Definition find_type_contradict_preds {cs: compspecs} (t: type) (p: val) :=
+Definition find_type_contradict_preds `{!VSTGS OK_ty Σ} {cs: compspecs} (t: type) (p: val) :=
   find_nth_preds (find_type_contradict_pred t p).
 
-Lemma SEP_type_contradict_lemma: forall {cs: compspecs} Delta e R goal Q T1 T2 GV e_root efs lr p_full_from_e p_root_from_e gfs_from_e t_root_from_e p_root_from_hint gfs_from_hint t_root_from_hint
+Lemma SEP_type_contradict_lemma: forall `{!VSTGS OK_ty Σ} {cs: compspecs} Delta e R goal Q T1 T2 GV e_root efs lr p_full_from_e p_root_from_e gfs_from_e t_root_from_e p_root_from_hint gfs_from_hint t_root_from_hint
   mm1 mm2,
   local2ptree Q = (T1, T2, nil, GV) ->
   compute_nested_efield e = (e_root, efs, lr) ->
@@ -680,7 +632,7 @@ Ltac find_type_contradict_rec :=
         | simple eapply find_type_contradict_pred_data_at_; reflexivity
         | simple eapply find_type_contradict_pred_field_at; reflexivity
         | simple eapply find_type_contradict_pred_field_at_; reflexivity].
-
+ 
 Definition unknown_type := Tvoid.
 
 Ltac SEP_type_contradict_msg r e :=
@@ -715,7 +667,7 @@ Ltac SEP_type_contradict LOCAL2PTREE Delta e R :=
   end;
   fail 0.
 
-Lemma hint_msg_lemma: forall {cs: compspecs} Delta e goal Q T1 T2 GV e_root efs lr p_full_from_e p_root_from_e gfs_from_e t_root_from_e p_root_from_hint gfs_from_hint t_root_from_hint
+Lemma hint_msg_lemma: forall `{!VSTGS OK_ty Σ} {cs: compspecs} Delta e goal Q T1 T2 GV e_root efs lr p_full_from_e p_root_from_e gfs_from_e t_root_from_e p_root_from_hint gfs_from_hint t_root_from_hint
   t gfs p,
   local2ptree Q = (T1, T2, nil, GV) ->
   compute_nested_efield e = (e_root, efs, lr) ->
@@ -741,7 +693,7 @@ Ltac hint_msg_aux R1 A :=
   | data_at_ => idtac
   | field_at_ => idtac
   | memory_block => idtac
-  | @exp _ _ _ _  => idtac "
+  | bi_exist _ _  => idtac "
 Or, perhaps you need to do [Intros x] to introduce the EXistential" R1 "in your SEP clause."
   | _ _ => idtac
   | _ => idtac "
@@ -771,7 +723,7 @@ Ltac hint_msg_aux2 R p2 :=
    end.
 
 Ltac hint_msg LOCAL2PTREE Delta e :=
- match goal with |- semax _ (|> PROPx _ (LOCALx _ (SEPx ?R))) _ _ =>
+ match goal with |- semax _ _ (▷ PROPx _ (LOCALx _ (SEPx ?R))) _ _ =>
   eapply (hint_msg_lemma Delta e);
   [ exact LOCAL2PTREE
   | reflexivity
@@ -817,7 +769,7 @@ Ltac has_at_already_aux R p :=
   end.
 
 Ltac has_at_already p :=
-  lazymatch goal with |- semax _ (PROPx _ (LOCALx _ (SEPx ?R))) _ _ =>
+  lazymatch goal with |- semax _ _ (PROPx _ (LOCALx _ (SEPx ?R))) _ _ =>
     has_at_already_aux R p
   end.
 
@@ -877,7 +829,7 @@ Ltac find_unfold_mpred R p :=
     ]
   end.
 
-Lemma check_unfold_lemma: forall {cs: compspecs} Delta e goal Q T1 T2 GV e_root efs lr p_full_from_e p_root_from_e gfs_from_e t_root_from_e p_root_from_hint gfs_from_hint t_root_from_hint,
+Lemma check_unfold_lemma: forall `{!VSTGS OK_ty Σ} {cs: compspecs} Delta e goal Q T1 T2 GV e_root efs lr p_full_from_e p_root_from_e gfs_from_e t_root_from_e p_root_from_hint gfs_from_hint t_root_from_hint,
   local2ptree Q = (T1, T2, nil, GV) ->
   compute_nested_efield e = (e_root, efs, lr) ->
   msubst_eval_lvalue Delta T1 T2 GV e = Some p_full_from_e ->
@@ -946,24 +898,23 @@ Ltac check_unfold_mpred_for_at_aux2 Delta P Q R e :=
 
 Ltac check_unfold_mpred_for_at :=
   lazymatch goal with
-  | |- semax ?Delta (PROPx ?P (LOCALx ?Q (SEPx ?R))) ?e _ =>
+  | |- semax _ ?Delta (PROPx ?P (LOCALx ?Q (SEPx ?R))) ?e _ =>
     check_unfold_mpred_for_at_aux2 Delta P Q R e
   end.
 
 Section SEMAX_PTREE.
 
-Context {cs: compspecs}.
+Context `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {cs: compspecs}.
 
 Lemma semax_PTree_set:
-  forall {Espec: OracleKind},
-    forall Delta id P Q R T1 T2 GV (e2: expr) t v,
+    forall E Delta id P Q R T1 T2 GV (e2: expr) t v,
       local2ptree Q = (T1, T2, nil, GV) ->
       typeof_temp Delta id = Some t ->
       is_neutral_cast (implicit_deref (typeof e2)) t = true ->
       msubst_eval_expr Delta T1 T2 GV e2 = Some v ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
          (tc_expr Delta e2) ->
-      semax Delta (|>PROPx P (LOCALx Q (SEPx R)))
+      semax E Delta (▷PROPx P (LOCALx Q (SEPx R)))
         (Sset id e2)
           (normal_ret_assert
             (PROPx P
@@ -971,17 +922,13 @@ Lemma semax_PTree_set:
                 (SEPx R)))).
 Proof.
   intros.
-  eapply semax_SC_set.
-  1: eassumption.
-  1: eassumption.
-  2: eassumption.
+  eapply semax_SC_set; try done.
   erewrite local2ptree_soundness by eassumption.
   apply msubst_eval_expr_eq; auto.
 Qed.
 
 Lemma semax_PTree_field_load_no_hint:
-  forall {Espec: OracleKind},
-    forall n Rn Delta sh id P Q R (e: expr) t
+    forall n Rn E Delta sh id P Q R (e: expr) t
       T1 T2 GV e_root (efs: list efield) lr
       t_root_from_e gfs_from_e p_from_e
       (t_root: type) (gfs0 gfs1 gfs: list gfield) (p: val)
@@ -998,14 +945,14 @@ Lemma semax_PTree_field_load_no_hint:
       find_nth_preds (fun Rn => Rn = field_at sh t_root gfs0 v' p /\ gfs = gfs1 ++ gfs0) R (Some (n, Rn)) ->
       readable_share sh ->
       JMeq (proj_reptype (nested_field_type t_root gfs0) gfs1 v') v ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
-        !! (legal_nested_field (nested_field_type t_root gfs0) gfs1) ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
+        ⌜legal_nested_field (nested_field_type t_root gfs0) gfs1⌝ ->
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
         local `(tc_val (typeof e) v) ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
         denote_tc_assert
           (tc_andp (typecheck_LR Delta e_root lr) (typecheck_efield Delta efs)) ->
-      semax Delta (|>PROPx P (LOCALx Q (SEPx R)))
+      semax E Delta (▷PROPx P (LOCALx Q (SEPx R)))
         (Sset id e)
           (normal_ret_assert
             (PROPx P
@@ -1030,8 +977,8 @@ Proof.
     simpl app.
     apply (msubst_efield_denote_eq _ P _ _ GV R)  in EVAL_EFIELD.
     eapply derives_trans; [apply EVAL_EFIELD |].
-    intro rho; simpl; unfold local, lift1; unfold_lift.
-    apply prop_derives; intros.
+    split => rho; monPred.unseal; simpl; unfold local, lift1; unfold_lift.
+    apply bi.pure_mono; intros.
     pose proof compute_nested_efield_lemma _ rho BY_VALUE.
     rewrite COMPUTE_NESTED_EFIELD in H3.
     destruct (H3 t_root_from_e gfs_from_e) as [tts ?].
@@ -1043,16 +990,10 @@ Proof.
   destruct H2 as [tts [NESTED_EFIELD [LR [LEGAL_NESTED_EFIELD TYPEOF]]]].
   rewrite <- TYPEOF in BY_VALUE.
   assert_PROP (field_compatible t_root gfs0 p).
-  {
-    rewrite <- (corable_sepcon_TT (prop _)) by auto.
-    eapply nth_error_SEP_sepcon_TT'; [| eassumption].
-    apply andp_left2.
-    apply andp_left2.
-    apply andp_left2.
+  { rewrite nth_error_SEP_sepcon_TT' //.
     rewrite field_at_compatible'.
     go_lowerx.
-    normalize.
-  }
+    normalize. }
   rename H2 into FIELD_COMPATIBLE.
   assert_PROP (legal_nested_field (nested_field_type t_root gfs0) gfs1); auto.
   clear LEGAL_NESTED_FIELD; rename H2 into LEGAL_NESTED_FIELD.
@@ -1064,43 +1005,30 @@ Proof.
   specialize (FIELD_COMPATIBLE_E FIELD_COMPATIBLE).
   pose proof nested_efield_facts Delta _ _ efs _ _ _ _ FIELD_COMPATIBLE_E LR LEGAL_NESTED_EFIELD BY_VALUE as DERIVES.
   rewrite denote_tc_assert_andp in TC.
-  apply (derives_trans (local (tc_environ Delta) && PROPx P (LOCALx Q (SEPx R)))) in DERIVES.
+  apply (derives_trans (local (tc_environ Delta) ∧ PROPx P (LOCALx Q (SEPx R)))) in DERIVES.
   2:{
-    rewrite (andp_comm _ (local (efield_denote _ _))), <- !andp_assoc.
     rewrite (add_andp _ _ TC).
     rewrite (add_andp _ _ TC_VAL).
     rewrite LR.
-    apply andp_right; [| solve_andp].
-    apply andp_right; [| solve_andp].
-    apply andp_right; [| solve_andp].
-    apply andp_left1.
-    erewrite (local2ptree_soundness P Q R) by eauto.
-    apply andp_left1.
-    simpl app.
-    apply andp_right.
-    + apply (msubst_efield_denote_eq _ P _ _ GV R) in EVAL_EFIELD; auto.
+    apply bi.and_intro, bi.and_intro, bi.and_intro, bi.and_intro; [| solve_andp | solve_andp | solve_andp |];
+      rewrite bi.and_elim_l; erewrite (local2ptree_soundness P Q R) by eauto;  rewrite bi.and_elim_l; simpl app.
     + apply (msubst_eval_LR_eq _ P _ _ GV R) in EVAL_ROOT; auto.
+    + apply (msubst_efield_denote_eq _ P _ _ GV R) in EVAL_EFIELD; auto.
   }
-  eapply semax_SC_field_load.
-  1: rewrite NESTED_EFIELD, <- TYPEOF, TYPE_EQ; reflexivity.
-  1: eassumption.
+  eapply semax_SC_field_load; try done.
+  1: rewrite NESTED_EFIELD -TYPEOF TYPE_EQ //.
   1: rewrite <- TYPE_EQ, TYPEOF; eassumption.
   1: rewrite <- TYPE_EQ, TYPEOF; eassumption.
-  2: eassumption.
-  2: eassumption.
-  2: eassumption.
-  2: eassumption.
   + rewrite <- FIELD_ADD_EQ.
     eapply derives_trans; [exact DERIVES | solve_andp].
-  + apply andp_right.
+  + apply bi.and_intro.
     - eapply derives_trans; [exact DERIVES | solve_andp].
     - rewrite <- TYPE_EQ, TYPEOF.
       rewrite (add_andp _ _ TC_VAL); solve_andp.
 Qed.
 
 Lemma semax_PTree_field_load_with_hint:
-  forall {Espec: OracleKind},
-    forall n Rn Delta sh id P Q R (e: expr) t
+    forall n Rn E Delta sh id P Q R (e: expr) t
       T1 T2 GV p_from_e
       (t_root: type) (gfs0 gfs1 gfs: list gfield) (p: val)
       (v_val : val) (v_reptype : reptype (nested_field_type t_root gfs0)),
@@ -1114,11 +1042,11 @@ Lemma semax_PTree_field_load_with_hint:
       find_nth_preds (fun Rn => Rn = field_at sh t_root gfs0 v_reptype p /\ gfs = gfs1 ++ gfs0) R (Some (n, Rn)) ->
       readable_share sh ->
       JMeq (proj_reptype (nested_field_type t_root gfs0) gfs1 v_reptype) v_val ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
         local (`(tc_val (typeof e) v_val)) ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
         tc_lvalue Delta e ->
-      @semax cs Espec Delta (|> PROPx P (LOCALx Q (SEPx R)))
+      semax E Delta (▷ PROPx P (LOCALx Q (SEPx R)))
         (Sset id e)
         (normal_ret_assert
           (PROPx P
@@ -1132,16 +1060,10 @@ Proof.
          LOCAL2PTREE ? ? ? EVAL_L FIELD_ADD TYPE_EQ NTH SH JMEQ TC_VAL TC.
   apply find_nth_preds_Some in NTH.
   destruct NTH as [NTH [? GFS]]; subst Rn.
-  pose proof andp_right _ _ _ TC TC_VAL.
-  eapply semax_SC_field_load.
-  1: eassumption.
-  1: eassumption.
+  pose proof bi.and_intro _ _ _ TC TC_VAL.
+  eapply semax_SC_field_load; try done.
   1: rewrite <- TYPE_EQ; eassumption.
   1: rewrite <- TYPE_EQ; eassumption.
-  2: eassumption.
-  2: eassumption.
-  2: eassumption.
-  2: eassumption.
   2: rewrite <- TYPE_EQ; eassumption.
   rewrite <- FIELD_ADD.
   erewrite (local2ptree_soundness P Q R) by eassumption.
@@ -1150,8 +1072,7 @@ Proof.
 Qed.
 
 Lemma semax_PTree_field_cast_load_no_hint:
-  forall {Espec: OracleKind},
-    forall n Rn Delta sh id P Q R (e: expr) t
+    forall n Rn E Delta sh id P Q R (e: expr) t
       T1 T2 GV e_root (efs: list efield) lr
       t_root_from_e gfs_from_e p_from_e
       (t_root: type) (gfs0 gfs1 gfs: list gfield) (p: val)
@@ -1169,14 +1090,14 @@ Lemma semax_PTree_field_cast_load_no_hint:
       find_nth_preds (fun Rn => Rn = field_at sh t_root gfs0 v' p /\ gfs = gfs1 ++ gfs0) R (Some (n, Rn)) ->
       readable_share sh ->
       JMeq (proj_reptype (nested_field_type t_root gfs0) gfs1 v') v ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
-        !! (legal_nested_field (nested_field_type t_root gfs0) gfs1) ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
+        ⌜legal_nested_field (nested_field_type t_root gfs0) gfs1⌝ ->
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
         local `(tc_val t (eval_cast (typeof e) t v)) ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
         denote_tc_assert
           (tc_andp (typecheck_LR Delta e_root lr) (typecheck_efield Delta efs)) ->
-      semax Delta (|>PROPx P (LOCALx Q (SEPx R)))
+      semax E Delta (▷PROPx P (LOCALx Q (SEPx R)))
         (Sset id (Ecast e t))
           (normal_ret_assert
             (PROPx P
@@ -1198,10 +1119,10 @@ Proof.
   {
     erewrite (local2ptree_soundness P Q R) by eauto.
     simpl app.
-    apply (msubst_efield_denote_eq _ P _ _ GV R)  in EVAL_EFIELD.
+    apply (msubst_efield_denote_eq _ P _ _ GV R) in EVAL_EFIELD.
     eapply derives_trans; [apply EVAL_EFIELD |].
-    intro rho; simpl; unfold local, lift1; unfold_lift.
-    apply prop_derives; intros.
+    split => rho; monPred.unseal; simpl; unfold local, lift1; unfold_lift.
+    apply bi.pure_mono; intros.
     pose proof compute_nested_efield_lemma _ rho BY_VALUE.
     rewrite COMPUTE_NESTED_EFIELD in H3.
     destruct (H3 t_root_from_e gfs_from_e) as [tts ?].
@@ -1213,12 +1134,7 @@ Proof.
   destruct H2 as [tts [NESTED_EFIELD [LR [LEGAL_NESTED_EFIELD TYPEOF]]]].
   rewrite <- TYPEOF in BY_VALUE.
   assert_PROP (field_compatible t_root gfs0 p).
-  {
-    rewrite <- (corable_sepcon_TT (prop _)) by auto.
-    eapply nth_error_SEP_sepcon_TT'; [| eassumption].
-    apply andp_left2.
-    apply andp_left2.
-    apply andp_left2.
+  { rewrite nth_error_SEP_sepcon_TT' //.
     rewrite field_at_compatible'.
     go_lowerx.
     normalize.
@@ -1234,43 +1150,31 @@ Proof.
   specialize (FIELD_COMPATIBLE_E FIELD_COMPATIBLE).
   pose proof nested_efield_facts Delta _ _ efs _ _ _ _ FIELD_COMPATIBLE_E LR LEGAL_NESTED_EFIELD BY_VALUE as DERIVES.
   rewrite denote_tc_assert_andp in TC.
-  apply (derives_trans (local (tc_environ Delta) && PROPx P (LOCALx Q (SEPx R)))) in DERIVES.
+  apply (derives_trans (local (tc_environ Delta) ∧ PROPx P (LOCALx Q (SEPx R)))) in DERIVES.
   2:{
-    rewrite (andp_comm _ (local (efield_denote _ _))), <- !andp_assoc.
     rewrite (add_andp _ _ TC).
     rewrite LR.
-    apply andp_right; [| solve_andp].
-    apply andp_right; [| solve_andp].
-    apply andp_right; [| solve_andp].
-    apply andp_left1.
-    erewrite (local2ptree_soundness P Q R) by eauto.
-    simpl app.
-    apply andp_right.
-    + apply (msubst_efield_denote_eq _ P _ _ GV R) in EVAL_EFIELD; auto.
+    apply bi.and_intro, bi.and_intro, bi.and_intro, bi.and_intro; [| solve_andp | solve_andp | solve_andp |];
+      rewrite bi.and_elim_l; erewrite (local2ptree_soundness P Q R) by eauto; simpl app.
     + apply (msubst_eval_LR_eq _ P _ _ GV R) in EVAL_ROOT; auto.
+    + apply (msubst_efield_denote_eq _ P _ _ GV R) in EVAL_EFIELD; auto.
   }
   rewrite NESTED_EFIELD. rewrite <- TYPEOF, TYPE_EQ.
-  eapply semax_SC_field_cast_load.
+  eapply semax_SC_field_cast_load; try done.
   1: rewrite <- TYPEOF, TYPE_EQ; reflexivity.
-  1: eassumption.
   1: rewrite <- TYPE_EQ; eassumption.
   1: rewrite <- TYPE_EQ, TYPEOF; eassumption.
   1: rewrite <- TYPE_EQ, TYPEOF; eassumption.
-  2: eassumption.
-  2: eassumption.
-  2: eassumption.
-  2: eassumption.
   + rewrite <- FIELD_ADD_EQ.
     eapply derives_trans; [exact DERIVES | rewrite NESTED_EFIELD; solve_andp].
-  + apply andp_right.
+  + apply bi.and_intro.
     - eapply derives_trans; [exact DERIVES | rewrite NESTED_EFIELD; solve_andp].
     - rewrite <- TYPE_EQ, TYPEOF.
       rewrite (add_andp _ _ TC_VAL); solve_andp.
 Qed.
 
 Lemma semax_PTree_field_cast_load_with_hint:
-  forall {Espec: OracleKind},
-    forall n Rn Delta sh id P Q R (e: expr) t
+    forall n Rn E Delta sh id P Q R (e: expr) t
       T1 T2 GV p_from_e
       (t_root: type) (gfs0 gfs1 gfs: list gfield) (p: val)
       (v_val : val) (v_reptype : reptype (nested_field_type t_root gfs0)),
@@ -1285,11 +1189,11 @@ Lemma semax_PTree_field_cast_load_with_hint:
       find_nth_preds (fun Rn => Rn = field_at sh t_root gfs0 v_reptype p /\ gfs = gfs1 ++ gfs0) R (Some (n, Rn)) ->
       readable_share sh ->
       JMeq (proj_reptype (nested_field_type t_root gfs0) gfs1 v_reptype) v_val ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
         local (`(tc_val t (eval_cast (typeof e) t v_val))) ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
         tc_lvalue Delta e ->
-      @semax cs Espec Delta (|> PROPx P (LOCALx Q (SEPx R)))
+      semax E Delta (▷ PROPx P (LOCALx Q (SEPx R)))
         (Sset id (Ecast e t))
         (normal_ret_assert
           (PROPx P
@@ -1303,18 +1207,12 @@ Proof.
          LOCAL2PTREE ? ? ? ? EVAL_L FIELD_ADD TYPE_EQ NTH SH JMEQ TC_VAL TC.
   apply find_nth_preds_Some in NTH.
   destruct NTH as [NTH [? GFS]]; subst Rn.
-  pose proof andp_right _ _ _ TC TC_VAL.
+  pose proof bi.and_intro _ _ _ TC TC_VAL.
   rewrite TYPE_EQ.
-  eapply semax_SC_field_cast_load.
-  1: eassumption.
-  1: eassumption.
+  eapply semax_SC_field_cast_load; try done.
   1: rewrite <- TYPE_EQ; eassumption.
   1: rewrite <- TYPE_EQ; eassumption.
   1: rewrite <- TYPE_EQ; eassumption.
-  2: eassumption.
-  2: eassumption.
-  2: eassumption.
-  2: eassumption.
   2: rewrite <- TYPE_EQ; eassumption.
   rewrite <- FIELD_ADD.
   erewrite (local2ptree_soundness P Q R) by eassumption.
@@ -1323,8 +1221,7 @@ Proof.
 Qed.
 
 Lemma semax_PTree_field_store_no_hint:
-  forall {Espec: OracleKind},
-    forall n Rn Delta sh P Q R (e1 e2 : expr)
+    forall n Rn E Delta sh P Q R (e1 e2 : expr)
       T1 T2 GV e_root (efs: list efield) lr
       t_root_from_e gfs_from_e p_from_e
       (t_root: type) (gfs0 gfs1 gfs: list gfield) (p: val) 
@@ -1343,14 +1240,14 @@ Lemma semax_PTree_field_store_no_hint:
       writable_share sh ->
       JMeq v0_val v0 ->
       data_equal (upd_reptype (nested_field_type t_root gfs0) gfs1 v v0) v_new ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
         denote_tc_assert
           (tc_andp (typecheck_LR Delta e_root lr)
             (tc_andp (typecheck_expr Delta (Ecast e2 (typeof e1)))
               (typecheck_efield Delta efs))) ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
-        !! (legal_nested_field (nested_field_type t_root gfs0) gfs1) ->
-      semax Delta (|>PROPx P (LOCALx Q (SEPx R)))
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
+        ⌜legal_nested_field (nested_field_type t_root gfs0) gfs1⌝ ->
+      semax E Delta (▷PROPx P (LOCALx Q (SEPx R)))
         (Sassign e1 e2)
           (normal_ret_assert
             (PROPx P
@@ -1375,8 +1272,8 @@ Proof.
     simpl app.
     apply (msubst_efield_denote_eq _ P _ _ GV R)  in EVAL_EFIELD.
     eapply derives_trans; [apply EVAL_EFIELD |].
-    intro rho; simpl; unfold local, lift1; unfold_lift.
-    apply prop_derives; intros.
+    split => rho; monPred.unseal; simpl; unfold local, lift1; unfold_lift.
+    apply bi.pure_mono; intros.
     pose proof compute_nested_efield_lemma _ rho BY_VALUE.
     rewrite COMPUTE_NESTED_EFIELD in H1.
     destruct (H1 t_root_from_e gfs_from_e) as [tts ?].
@@ -1388,12 +1285,7 @@ Proof.
   destruct H0 as [tts [NESTED_EFIELD [LR [LEGAL_NESTED_EFIELD TYPEOF]]]].
   rewrite <- TYPEOF in BY_VALUE.
   assert_PROP (field_compatible t_root gfs0 p).
-  {
-    rewrite <- (corable_sepcon_TT (prop _)) by auto.
-    eapply nth_error_SEP_sepcon_TT'; [| eassumption].
-    apply andp_left2.
-    apply andp_left2.
-    apply andp_left2.
+  { rewrite nth_error_SEP_sepcon_TT' //.
     rewrite field_at_compatible'.
     go_lowerx.
     normalize.
@@ -1408,43 +1300,33 @@ Proof.
   destruct FIELD_ADD_GEN as [FIELD_ADD_EQ [TYPE_EQ FIELD_COMPATIBLE_E]].
   specialize (FIELD_COMPATIBLE_E FIELD_COMPATIBLE).
   pose proof nested_efield_facts Delta _ _ efs _ _ _ _ FIELD_COMPATIBLE_E LR LEGAL_NESTED_EFIELD BY_VALUE as DERIVES.
-  rewrite !denote_tc_assert_andp in TC.
-  apply (derives_trans (local (tc_environ Delta) && PROPx P (LOCALx Q (SEPx R)))) in DERIVES.
+  rewrite denote_tc_assert_andp denote_tc_assert_andp in TC.
+  apply (derives_trans (local (tc_environ Delta) ∧ PROPx P (LOCALx Q (SEPx R)))) in DERIVES.
   2:{
-    rewrite (andp_comm _ (local (efield_denote _ _))), <- !andp_assoc.
     rewrite (add_andp _ _ TC).
     rewrite LR.
-    apply andp_right; [| solve_andp].
-    apply andp_right; [| solve_andp].
-    apply andp_right; [| solve_andp].
-    apply andp_left1.
-    erewrite (local2ptree_soundness P Q R) by eauto.
-    simpl app.
-    apply andp_right.
-    + apply (msubst_efield_denote_eq _ P _ _ GV R) in EVAL_EFIELD; auto.
+    apply bi.and_intro, bi.and_intro, bi.and_intro, bi.and_intro; [| solve_andp | solve_andp | solve_andp |];
+      rewrite bi.and_elim_l; erewrite (local2ptree_soundness P Q R) by eauto; simpl app.
     + apply (msubst_eval_LR_eq _ P _ _ GV R) in EVAL_ROOT; auto.
+    + apply (msubst_efield_denote_eq _ P _ _ GV R) in EVAL_EFIELD; auto.
   }
   rewrite NESTED_EFIELD.
-  eapply semax_SC_field_store.
+  eapply semax_SC_field_store; try done.
   1: rewrite <- TYPEOF, TYPE_EQ; reflexivity.
   1: rewrite <- TYPE_EQ; eassumption.
   1: rewrite <- TYPE_EQ, TYPEOF; eassumption.
-  1: eassumption.
-  1: eassumption.
-  3: eassumption.
   3: eapply JMeq_sym; eassumption.
-  3: eassumption.
   + rewrite <- FIELD_ADD_EQ.
     eapply derives_trans; [exact DERIVES | rewrite NESTED_EFIELD; solve_andp].
   + rewrite <- TYPE_EQ, TYPEOF.
     erewrite local2ptree_soundness by eauto.
     apply msubst_eval_expr_eq; eauto.
-  + rewrite (add_andp _ _ DERIVES), (add_andp _ _ TC).
+  + rewrite (add_andp _ _ DERIVES) (add_andp _ _ TC).
     rewrite <- TYPE_EQ, TYPEOF, NESTED_EFIELD.
     solve_andp.
 Qed.
 
- 
+
 Definition replace_UnionField (id: ident) (gfs: list gfield) : option (list gfield) :=
   match gfs with
   | UnionField _ :: gfs' => Some (UnionField id :: gfs')
@@ -1452,8 +1334,7 @@ Definition replace_UnionField (id: ident) (gfs: list gfield) : option (list gfie
  end.
 
 Lemma semax_PTree_field_store_union_hack:
-  forall {Espec: OracleKind},
-    forall id n Rn Delta sh P Q R (e1 e2 : expr)
+    forall id n Rn E Delta sh P Q R (e1 e2 : expr)
       T1 T2 GV e_root (efs: list efield) lr ch ch'
       t_root_from_e gfs_from_e p_from_e
       (t_root: type) (gfs0 gfs1 gfs1' gfs gfs': list gfield) (p: val) 
@@ -1480,16 +1361,16 @@ Lemma semax_PTree_field_store_union_hack:
       decode_encode_val v0_val ch ch' v0_val' ->
       JMeq v0_val' v0 ->
       data_equal (upd_reptype (nested_field_type t_root gfs0) gfs1' v v0) v_new ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
         denote_tc_assert
           (tc_andp (typecheck_LR Delta e_root lr)
             (tc_andp (typecheck_expr Delta (Ecast e2 (typeof e1)))
-              (typecheck_efield Delta efs)))->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
-        !! (legal_nested_field (nested_field_type t_root gfs0) gfs1) ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
-        !! (field_compatible t_root gfs' p)  ->
-      semax Delta (|>PROPx P (LOCALx Q (SEPx R)))
+              (typecheck_efield Delta efs))) ->
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
+        ⌜legal_nested_field (nested_field_type t_root gfs0) gfs1⌝ ->
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
+        ⌜field_compatible t_root gfs' p⌝ ->
+      semax E Delta (▷PROPx P (LOCALx Q (SEPx R)))
         (Sassign e1 e2)
           (normal_ret_assert
             (PROPx P
@@ -1521,8 +1402,8 @@ Proof.
     simpl app.
     apply (msubst_efield_denote_eq _ P _ _ GV R)  in EVAL_EFIELD.
     eapply derives_trans; [apply EVAL_EFIELD |].
-    intro rho; simpl; unfold local, lift1; unfold_lift.
-    apply prop_derives; intros.
+    split => rho; monPred.unseal; simpl; unfold local, lift1; unfold_lift.
+    apply bi.pure_mono; intros.
     pose proof compute_nested_efield_lemma _ rho BY_VALUE0.
     rewrite COMPUTE_NESTED_EFIELD in H1.
     destruct (H1 t_root_from_e gfs_from_e) as [tts ?].
@@ -1534,12 +1415,7 @@ Proof.
   destruct H0 as [tts [NESTED_EFIELD [LR [LEGAL_NESTED_EFIELD TYPEOF]]]].
   rewrite <- TYPEOF in BY_VALUE.
   assert_PROP (field_compatible t_root gfs0 p) as FIELD_COMPATIBLE.
-  {
-    rewrite <- (corable_sepcon_TT (prop _)) by auto.
-    eapply nth_error_SEP_sepcon_TT'; [| eassumption].
-    apply andp_left2.
-    apply andp_left2.
-    apply andp_left2.
+  { rewrite nth_error_SEP_sepcon_TT' //.
     rewrite field_at_compatible'.
     go_lowerx.
     normalize.
@@ -1555,56 +1431,49 @@ Proof.
   destruct FIELD_ADD_GEN as [FIELD_ADD_EQ [TYPE_EQ FIELD_COMPATIBLE_E]].
   specialize (FIELD_COMPATIBLE_E FIELD_COMPATIBLE).
   pose proof nested_efield_facts Delta _ _ efs _ _ _ _ FIELD_COMPATIBLE_E LR LEGAL_NESTED_EFIELD as DERIVES.
-  rewrite !denote_tc_assert_andp in TC.
-  apply (derives_trans (local (tc_environ Delta) && PROPx P (LOCALx Q (SEPx R)))) in DERIVES.
+  rewrite denote_tc_assert_andp denote_tc_assert_andp in TC.
+  apply (derives_trans (local (tc_environ Delta) ∧ PROPx P (LOCALx Q (SEPx R)))) in DERIVES.
   2:{
-    rewrite (andp_comm _ (local (efield_denote _ _))), <- !andp_assoc.
     rewrite (add_andp _ _ TC).
     rewrite LR.
-    apply andp_right; [| solve_andp].
-    apply andp_right; [| solve_andp].
-    apply andp_right; [| solve_andp].
-    apply andp_left1.
-    erewrite (local2ptree_soundness P Q R) by eauto.
-    simpl app.
-    apply andp_right.
-    + apply (msubst_efield_denote_eq _ P _ _ GV R) in EVAL_EFIELD; auto.
+    apply bi.and_intro, bi.and_intro, bi.and_intro, bi.and_intro; [| solve_andp | solve_andp | solve_andp |];
+      rewrite bi.and_elim_l; erewrite (local2ptree_soundness P Q R) by eauto; simpl app.
     + apply (msubst_eval_LR_eq _ P _ _ GV R) in EVAL_ROOT; auto.
+    + apply (msubst_efield_denote_eq _ P _ _ GV R) in EVAL_EFIELD; auto.
   }
   rewrite NESTED_EFIELD.
   eapply semax_SC_field_store_union_hack.
--  rewrite <- TYPEOF, TYPE_EQ; reflexivity.
--  rewrite <- TYPE_EQ; eassumption.
--  apply BY_VALUE'.
--  auto.
--  auto.
--  rewrite <- TYPE_EQ, TYPEOF; eassumption.
--  assumption.
--  assumption.
--  eassumption.
--  instantiate (1:=gfs1').
-          clear - GFS REPLACE REPLACE'.
-          destruct gfs1 as [ | [ | | ] ]; inv REPLACE'. inv REPLACE. auto.
--  eassumption.
-- rewrite <- FIELD_ADD_EQ.
+  - rewrite <- TYPEOF, TYPE_EQ; reflexivity.
+  - rewrite <- TYPE_EQ; eassumption.
+  - apply BY_VALUE'.
+  - auto.
+  - auto.
+  - rewrite <- TYPE_EQ, TYPEOF; eassumption.
+  - assumption.
+  - assumption.
+  - eassumption.
+  - instantiate (1:=gfs1').
+    clear - GFS REPLACE REPLACE'.
+    destruct gfs1 as [ | [ | | ] ]; inv REPLACE'. inv REPLACE. auto.
+  - eassumption.
+  - rewrite <- FIELD_ADD_EQ.
     eapply derives_trans; [exact DERIVES | rewrite NESTED_EFIELD; solve_andp].
-- rewrite <- TYPE_EQ, TYPEOF.
+  - rewrite <- TYPE_EQ, TYPEOF.
     erewrite local2ptree_soundness by eauto.
     apply msubst_eval_expr_eq; eauto.
-- auto.
-- eassumption.
-- eapply JMeq_sym; eassumption.
-- assumption.
-- apply andp_right. 2: apply prop_right; auto.
-    rewrite (add_andp _ _ DERIVES), (add_andp _ _ TC).
+  - auto.
+  - eassumption.
+  - eapply JMeq_sym; eassumption.
+  - assumption.
+  - rewrite assoc; apply bi.and_intro; last auto.
+    rewrite (add_andp _ _ DERIVES) (add_andp _ _ TC).
     rewrite <- TYPE_EQ, TYPEOF, NESTED_EFIELD.
     solve_andp.
-- eapply access_mode_by_value'; eauto.
+  - eapply access_mode_by_value'; eauto.
 Qed.
 
 Lemma semax_PTree_field_store_with_hint:
-  forall {Espec: OracleKind},
-    forall n Rn Delta sh P Q R (e1 e2 : expr)
+    forall n Rn E Delta sh P Q R (e1 e2 : expr)
       T1 T2 GV p_from_e
       (t_root: type) (gfs0 gfs1 gfs: list gfield) (p: val) 
       (v0: reptype (nested_field_type (nested_field_type t_root gfs0) gfs1))
@@ -1620,10 +1489,10 @@ Lemma semax_PTree_field_store_with_hint:
       writable_share sh ->
       JMeq v0_val v0 ->
       data_equal (upd_reptype (nested_field_type t_root gfs0) gfs1 v v0) v_new ->
-      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |--
+      ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) ⊢
         denote_tc_assert
           (tc_andp (typecheck_lvalue Delta e1) (typecheck_expr Delta (Ecast e2 (typeof e1)))) ->
-      semax Delta (|>PROPx P (LOCALx Q (SEPx R)))
+      semax E Delta (▷PROPx P (LOCALx Q (SEPx R)))
         (Sassign e1 e2)
           (normal_ret_assert
             (PROPx P
@@ -1640,15 +1509,10 @@ Proof.
   apply find_nth_preds_Some in NTH.
   destruct NTH as [NTH [[? ?] GFS]]; subst Rn Rv.
   rewrite denote_tc_assert_andp in TC.
-  eapply semax_SC_field_store.
-  1: eassumption.
+  eapply semax_SC_field_store; try done.
   1: rewrite <- TYPE_EQ; eassumption.
   1: rewrite <- TYPE_EQ; eassumption.
-  1: eassumption.
-  1: eassumption.
-  3: eassumption.
   3: eapply JMeq_sym; eassumption.
-  3: eassumption.
   3: rewrite <- TYPE_EQ; auto.
   + rewrite <- FIELD_ADD.
     erewrite (local2ptree_soundness P Q R) by eassumption.
@@ -1678,7 +1542,7 @@ Ltac equal_pointers p q :=
 
 Ltac SEP_field_at_unify' gfs :=
   match goal with
-  | |- @field_at ?csl ?shl ?tl ?gfsl ?vl ?pl = @field_at ?csr ?shr ?tr ?gfsr ?vr ?pr =>
+  | |- field_at(cs := ?csl) ?shl ?tl ?gfsl ?vl ?pl = field_at(cs := ?csr) ?shr ?tr ?gfsr ?vr ?pr =>
       unify tl tr;
       unify (Floyd_skipn (length gfs - length gfsl) gfs) gfsl;
       unify gfsl gfsr;
@@ -1686,7 +1550,7 @@ Ltac SEP_field_at_unify' gfs :=
       unify vl vr;
       equal_pointers pl pr;
       constr_eq csl csr +
-      fail 12 "Two different compspecs present:" 
+      fail 14 "Two different compspecs present:" 
          csl "and" csr 
         ".  Try using change_compspecs, or use VSUs";
 
@@ -1710,7 +1574,7 @@ Ltac SEP_field_at_unify gfs :=
 
 Ltac SEP_field_at_strong_unify' gfs :=
   match goal with
-  | |- @field_at ?cs ?shl ?tl ?gfsl ?vl ?pl = ?Rv ?vr /\ (_ = fun v => field_at ?shr ?tr ?gfsr v ?pr) =>
+  | |- field_at(cs := ?cs) ?shl ?tl ?gfsl ?vl ?pl = ?Rv ?vr /\ (_ = fun v => field_at ?shr ?tr ?gfsr v ?pr) =>
       unify tl tr;
       unify (Floyd_skipn (length gfs - length gfsl) gfs) gfsl;
       unify gfsl gfsr;
@@ -1718,18 +1582,18 @@ Ltac SEP_field_at_strong_unify' gfs :=
       unify vl vr;
       split;
       [ match type of vl with
-        | ?tv1 => unify Rv (fun v: tv1 => @field_at cs shl tl gfsl v pl)
+        | ?tv1 => unify Rv (fun v: tv1 => field_at(cs := cs) shl tl gfsl v pl)
         end; reflexivity
       | extensionality;
         rewrite <- ?field_at_offset_zero; reflexivity]
-  | |- @data_at ?cs ?shl ?tl ?vl ?pl = ?Rv ?vr /\ (_ = fun v => field_at ?shr ?tr ?gfsr v ?pr) =>
+  | |-  data_at(cs := ?cs) ?shl ?tl ?vl ?pl = ?Rv ?vr /\ (_ = fun v => field_at ?shr ?tr ?gfsr v ?pr) =>
       unify tl tr;
       unify gfsr (@nil gfield);
       unify shl shr;
       unify vl vr;
       split;
       [ match type of vl with
-        | ?tv1 => unify Rv (fun v: tv1 => @data_at cs shl tl v pl)
+        | ?tv1 => unify Rv (fun v: tv1 => data_at(cs := cs) shl tl v pl)
         end; reflexivity
       | extensionality;
         unfold data_at;
@@ -1738,8 +1602,8 @@ Ltac SEP_field_at_strong_unify' gfs :=
 
 Ltac SEP_field_at_strong_unify gfs :=
   match goal with
-  | |- @data_at_ ?cs ?sh ?t ?p = _ /\ _ =>
-      change (@data_at_ cs sh t p) with (@data_at cs sh t (default_val t) p);
+  | |- data_at_(cs := ?cs) ?sh ?t ?p = _ /\ _ =>
+      change (data_at_(cs := cs) sh t p) with (data_at(cs := cs) sh t (default_val t) p);
       SEP_field_at_strong_unify' gfs
   | |- field_at_ _ _ _ _ = _ /\ _ =>
       unfold field_at_; SEP_field_at_strong_unify' gfs
@@ -1776,18 +1640,19 @@ end.
 Ltac search_field_at_in_SEP := find_nth test_field_at_in_SEP.
 
 Lemma quick_derives_right:
-  forall P Q : environ -> mpred,
-   (TT |-- Q) -> P |-- Q.
+  forall `{!heapGS Σ} (P Q : assert),
+   (True ⊢ Q) -> P ⊢ Q.
 Proof.
 intros. eapply derives_trans; try eassumption; auto.
 Qed.
 
+(* I'm not sure this tactic ever succeeds in practice. *)
 Ltac quick_typecheck3 :=
   (* do not clear hyps anymore!  See issue #772 *)
  apply quick_derives_right; go_lowerx; intros;
- repeat apply andp_right; 
+ repeat apply bi.and_intro;
  try apply derives_refl;  (* see issue #756 *)
- auto; fail.
+ (*auto;*) fail.
 
 Ltac default_entailer_for_load_store :=
   (* Don't clear!  See issue #772 repeat match goal with H := _ |- _ => clear H end; *)
@@ -1859,7 +1724,7 @@ Ltac load_tac_no_hint LOCAL2PTREE :=
 
 Ltac load_tac :=
   match goal with
-  | |- semax ?Delta (|> (PROPx ?P (LOCALx ?Q (SEPx ?R)))) (Sset _ ?e) _ =>
+  | |- semax _ ?Delta (▷ (PROPx ?P (LOCALx ?Q (SEPx ?R)))) (Sset _ ?e) _ =>
     let T1 := fresh "T1" in evar (T1: PTree.t val);
     let T2 := fresh "T2" in evar (T2: PTree.t (type * val));
     let G := fresh "GV" in evar (G: option globals);
@@ -1920,7 +1785,7 @@ Ltac cast_load_tac_no_hint LOCAL2PTREE :=
 
 Ltac cast_load_tac :=
   match goal with
-  | |- semax ?Delta (|> (PROPx ?P (LOCALx ?Q (SEPx ?R)))) (Sset _ (Ecast ?e _)) _ =>
+  | |- semax _ ?Delta (▷ (PROPx ?P (LOCALx ?Q (SEPx ?R)))) (Sset _ (Ecast ?e _)) _ =>
     let T1 := fresh "T1" in evar (T1: PTree.t val);
     let T2 := fresh "T2" in evar (T2: PTree.t (type * val));
     let G := fresh "GV" in evar (G: option globals);
@@ -1931,14 +1796,13 @@ Ltac cast_load_tac :=
     clear T1 T2 G LOCAL2PTREE
   end.
 
-Lemma data_equal_congr {cs: compspecs}:
+Lemma data_equal_congr `{!VSTGS OK_ty Σ} {cs: compspecs}:
     forall T (v1 v2: reptype T),
    v1 = v2 ->
    data_equal v1 v2.
-Proof. intros. subst. intro. reflexivity.
-Qed.
+Proof. intros. subst. intro. reflexivity. Qed.
 
-Definition intsize_leq a b := 
+Definition intsize_leq a b : Prop := 
  match a,b with
  | IBool, IBool => True
  | IBool, _ => False
@@ -1961,13 +1825,13 @@ destruct x; auto.
 simpl.
 destruct sz1,sz2; try contradiction;
 destruct sg; simpl;
-rewrite ?Int.sign_ext_widen,
+rewrite -> ?Int.sign_ext_widen,
            ?Int.zero_ext_widen by lia; auto;
 destruct (Int.eq i Int.zero); auto.
 Qed.
 
 Ltac convert_stored_value :=
-  rewrite ?sem_cast_i2i_compose by apply Logic.I;
+  rewrite -> ?sem_cast_i2i_compose by apply Logic.I;
    apply JMeq_refl
   || fail 1000 "store_tac: unexpected failure in converting stored value".
  
@@ -2028,7 +1892,7 @@ Ltac check_expression_by_value e :=
 
 Ltac store_tac :=
   match goal with
-  | |- semax ?Delta (|> (PROPx ?P (LOCALx ?Q (SEPx ?R)))) (Sassign ?e1 ?e2) _ =>
+  | |- semax _ ?Delta (▷ (PROPx ?P (LOCALx ?Q (SEPx ?R)))) (Sassign ?e1 ?e2) _ =>
     check_expression_by_value e1;
     let T1 := fresh "T1" in evar (T1: PTree.t val);
     let T2 := fresh "T2" in evar (T2: PTree.t (type * val));
@@ -2042,7 +1906,7 @@ Ltac store_tac :=
 
 Ltac forward_store_union_hack id :=
  match goal with
-  | |- semax ?Delta (|> (PROPx ?P (LOCALx ?Q (SEPx ?R)))) (Sassign ?e1 ?e2) _ =>
+  | |- semax _ ?Delta (▷ (PROPx ?P (LOCALx ?Q (SEPx ?R)))) (Sassign ?e1 ?e2) _ =>
     check_expression_by_value e1;
     let T1 := fresh "T1" in evar (T1: PTree.t val);
     let T2 := fresh "T2" in evar (T2: PTree.t (type * val));
@@ -2081,7 +1945,6 @@ Ltac forward_store_union_hack id :=
   | first [solve_legal_nested_field_in_entailment
                                              | fail 1000 "unexpected failure in store_tac_union_hack."
                                                          "unexpected failure in solve_legal_nested_field_in_entailment"]
-  | solve [entailer!] || match goal with |- _ |-- prop ?A => fail 1000 "cannot prove" A end
+  | solve [entailer!] || match goal with |- _ ⊢ ⌜?A⌝ => fail 1000 "cannot prove" A end
   ]
   end.
-
diff --git a/floyd/semax_tactics.v b/floyd/semax_tactics.v
index 76d6b7254a..721d380097 100644
--- a/floyd/semax_tactics.v
+++ b/floyd/semax_tactics.v
@@ -1,6 +1,8 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
-Import compcert.lib.Maps.
+Import -(notations) compcert.lib.Maps.
 
 (* Bug: abbreviate replaces _ALL_ instances, when sometimes
   we only want just one. *)
@@ -45,8 +47,8 @@ Ltac clear_abbrevs :=  repeat match goal with
                                     | H := @abbreviate ret_assert _ |- _ => clear H
                                     | H := @abbreviate tycontext _ |- _ => clear H
                                     end.
-
-Arguments var_types !Delta / .
+       
+Arguments var_types _ _  !Delta / .
 
 (*
 Fixpoint initialized_list ids D :=
@@ -129,15 +131,18 @@ Ltac simplify_func_tycontext' DD :=
 
 Ltac simplify_func_tycontext :=
 match goal with
- | |- semax ?DD _ _ _ => simplify_func_tycontext'  DD
- | |- ENTAIL ?DD, _ |-- _ => simplify_func_tycontext'  DD
+ | |- semax _ ?DD _ _ _ => simplify_func_tycontext'  DD
+ | |- ENTAIL ?DD, _ ⊢ _ => simplify_func_tycontext'  DD
 end.
 
+Section SEMAX_TACTICS.
+Context `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty}.
 
 Definition with_Delta_specs (DS: PTree.t funspec) (Delta: tycontext) : tycontext :=
   match Delta with
     mk_tycontext a b c d _ ann => mk_tycontext a b c d DS ann
   end.
+End SEMAX_TACTICS.
 
 Ltac compute_in_Delta :=
  lazymatch goal with
@@ -186,42 +191,42 @@ Ltac simplify_Delta :=
 match goal with
  | Delta := @abbreviate tycontext _ |- _ => clear Delta; simplify_Delta
  | DS := @abbreviate (PTree.t funspec) _ |- _ => clear DS; simplify_Delta
- | D1 := @abbreviate tycontext _ |- semax ?D _ _ _ => 
+ | D1 := @abbreviate tycontext _ |- semax _ ?D _ _ _ => 
        constr_eq D1 D (* ONLY this case terminates! *)
 (*                 
- | |- semax ?D _ _ _ => unfold D; simplify_Delta
+ | |- semax _ ?D _ _ _ => unfold D; simplify_Delta
  | |- _ => simplify_func_tycontext; simplify_Delta
- | |- semax (mk_tycontext ?a ?b ?c ?d ?e) _ _ _ => (* delete this case? *)
+ | |- semax _ (mk_tycontext ?a ?b ?c ?d ?e) _ _ _ => (* delete this case? *)
      let DS := fresh "Delta_specs" in set (DS := e : PTree.t funspec);
      change e with (@abbreviate (PTree.t funspec) e) in DS;
      let D := fresh "Delta" in set (D := mk_tycontext a b c d DS);
      change (mk_tycontext a b c d DS) with (@abbreviate _ (mk_tycontext a b c d DS)) in D
 *)
- | D1 := @abbreviate tycontext _ |- ENTAIL ?D, _ |-- _ => 
+ | D1 := @abbreviate tycontext _ |- ENTAIL ?D, _ ⊢ _ => 
        constr_eq D1 D (* ONLY this case terminates! *)
- | |- semax ?D _ _ _ => unfold D; simplify_Delta
- | |- ENTAIL ?D, _ |-- _ => unfold D; simplify_Delta
+ | |- semax _ ?D _ _ _ => unfold D; simplify_Delta
+ | |- ENTAIL ?D, _ ⊢_ => unfold D; simplify_Delta
  | |- _ => simplify_func_tycontext; simplify_Delta
  | Delta := @abbreviate tycontext ?D 
-      |- semax ?DD _ _ _ => simplify_Delta' Delta D DD; simplify_Delta
+      |- semax _ ?DD _ _ _ => simplify_Delta' Delta D DD; simplify_Delta
  | Delta := @abbreviate tycontext ?D 
-      |- ENTAIL ?DD, _ |-- _ => simplify_Delta' Delta D DD; simplify_Delta
- | |- semax ?DD _ _ _ =>  simplify_Delta
- |  |- ENTAIL (ret_tycon ?DD), _ |-- _ => 
+      |- ENTAIL ?DD, _ ⊢ _ => simplify_Delta' Delta D DD; simplify_Delta
+ | |- semax _ ?DD _ _ _ =>  simplify_Delta
+ |  |- ENTAIL (ret_tycon ?DD), _ ⊢ _ => 
         let D := fresh "D" in 
           set (D := ret_tycon DD);
           hnf in D; simpl is_void_type in D;
           cbv beta iota in D;
           pose (Delta := @abbreviate tycontext D);
           change D with Delta; subst D; simplify_Delta
- |  |- ENTAIL (ret0_tycon ?DD), _ |-- _ => 
+ |  |- ENTAIL (ret0_tycon ?DD), _ ⊢ _ => 
         let D := fresh "D" in 
           set (D := ret0_tycon DD);
           hnf in D; simpl is_void_type in D;
           cbv beta iota in D;
           pose (Delta := @abbreviate tycontext D);
           change D with Delta; subst D; simplify_Delta
- | |- ENTAIL (ret_tycon ?DD), _ |-- _ => simplify_Delta
+ | |- ENTAIL (ret_tycon ?DD), _ ⊢ _ => simplify_Delta
  | |- _ => fail "simplify_Delta did not put Delta_specs and Delta into canonical form"
  end.
 
@@ -266,40 +271,40 @@ with is_sequential_ls co ls :=
 
 Ltac force_sequential  :=
 match goal with
-| P := @abbreviate ret_assert (normal_ret_assert _) |- semax _ _ _ ?P' =>
+| P := @abbreviate ret_assert (normal_ret_assert _) |- semax _ _ _ _ ?P' =>
     constr_eq P P'
-| P := @abbreviate ret_assert _ |- semax _ _ ?c ?P' =>
+| P := @abbreviate ret_assert _ |- semax _ _ _ ?c ?P' =>
     constr_eq P P'; 
     try (is_sequential false false c;
          unfold abbreviate in P; subst P;
          apply sequential; simpl_ret_assert)
 | P := @abbreviate ret_assert _ |- _ => unfold abbreviate in P; subst P;
       force_sequential
-| P := _ : ret_assert |- semax _ _ _ ?P' => 
+| P := _ |- semax _ _ _ _ ?P' => 
       constr_eq P P'; unfold abbreviate in P; subst P;
       force_sequential
-| |- semax _ _ _ (normal_ret_assert ?P) => 
+| |- semax _ _ _ _ (normal_ret_assert ?P) => 
        abbreviate (normal_ret_assert P) : ret_assert as POSTCONDITION
-| |- semax _ _ ?c ?P =>
+| |- semax _ _ _ ?c ?P =>
     tryif (is_sequential false false c)
     then (apply sequential; simpl_ret_assert;
-          match goal with |- semax _ _ _ ?Q =>
-             abbreviate Q : ret_assert as POSTCONDITION
+          match goal with |- semax _ _ _ _ ?Q =>
+             abbreviate Q as POSTCONDITION
           end)
-    else abbreviate P : ret_assert as POSTCONDITION
+    else abbreviate P as POSTCONDITION
 end.
 
 Ltac abbreviate_semax :=
  match goal with
- | |- semax _ FF _ _ => apply semax_ff
- | |- semax _ (PROPx (False::_) _) _ _ => Intros; contradiction
- | |- semax _ _ _ _ =>
+ | |- semax _ _ False _ _ => apply semax_ff
+ | |- semax _ _ (PROPx (False::_) _) _ _ => Intros; contradiction
+ | |- semax _ _ _ _ _ =>
   simplify_Delta;
   repeat match goal with
   | MC := @abbreviate statement _ |- _ => unfold abbreviate in MC; subst MC
   end;
   force_sequential;
-  match goal with |- semax _ _ ?C _ =>
+  match goal with |- semax _ _ _ ?C _ =>
             match C with
             | Ssequence ?C1 ?C2 =>
                (* use the next 3 lines instead of "abbreviate"
@@ -315,7 +320,7 @@ Ltac abbreviate_semax :=
             | _ => idtac
             end
   end
- | |- _ |-- _ => unfold_abbrev_ret
+ | |- _ ⊢ _ => unfold_abbrev_ret
  end;
  clear_abbrevs;
  simpl typeof.
@@ -325,19 +330,19 @@ match goal with
  | Delta := @abbreviate tycontext (mk_tycontext _ _ _ _ _) |- _ =>
     match goal with
     | |- _ => clear Delta; check_Delta
-    | |- semax Delta _ _ _ => idtac
+    | |- semax _ Delta _ _ _ => idtac
     end
  | _ => simplify_Delta;
-     match goal with |- semax ?D _ _ _ =>
+     match goal with |- semax _ ?D _ _ _ =>
             abbreviate D : tycontext as Delta
      end
 end.
 
 Ltac normalize_postcondition :=  (* produces a normal_ret_assert *)
  match goal with
- | P := _ |- semax _ _ _ ?P =>
+ | P := _ |- semax _ _ _ _ ?P =>
      unfold P, abbreviate; clear P; normalize_postcondition
- | |- semax _ _ _ (normal_ret_assert _) => idtac
+ | |- semax _ _ _ _ (normal_ret_assert _) => idtac
  | |- _ => apply sequential
   end;
  autorewrite with ret_assert.
@@ -402,7 +407,7 @@ Ltac mkConciseDelta V G F Ann Delta :=
 *)
 Ltac semax_subcommand V G F Ann :=
   abbreviate_semax;
-  match goal with |- semax ?Delta _ _ _ =>
+  match goal with |- semax _ ?Delta _ _ _ =>
 (*
       mkConciseDelta V G F Ann Delta;
 *)
@@ -437,12 +442,16 @@ Ltac check_POSTCONDITION' P :=
 
 Ltac check_POSTCONDITION :=
   match goal with
-  | P := ?P' |- semax _ _ _ ?P'' =>
+  | P := ?P' |- semax _ _ _ _ ?P'' =>
      constr_eq P P''; check_POSTCONDITION' P'
-  | |- semax _ _ _ ?P => check_POSTCONDITION' P
+  | |- semax _ _ _ _ ?P => check_POSTCONDITION' P
   | _ => fail 100 "Your POSTCONDITION is ill-formed in some way "
   end.
 
+Section SEMAX_TACTICS.
+
+Context `{!VSTGS OK_ty Σ} {OK_spec: ext_spec OK_ty}.
+
 Fixpoint find_expressions {A: Type} (f: expr -> A -> A) (c: statement) (x: A) : A :=
  match c with
  | Sskip => x
@@ -483,11 +492,11 @@ Definition isNone {A} (x: option A) :=
  match x with None => true | _ => false end.
 
 Definition check_no_overlap
-    (V: varspecs) (G: funspecs) : bool :=
+     (V: varspecs) (G: (@funspecs Σ)) : bool :=
   let table :=  List.fold_left (fun t v => PTree.set (fst v) tt t) G (PTree.empty _)
-   in forallb (fun f => isNone (table ! (fst f))) V.
+   in forallb (fun f => isNone (table !! (fst f))) V.
 
-Lemma check_no_overlap_e:
+Lemma check_no_overlap_e  :
   forall V G, check_no_overlap V G = true ->
   forall i, In i (map fst V) -> ~ In i (map fst G).
 Proof.
@@ -495,14 +504,14 @@ intros *. intros H i H1 H0.
 unfold check_no_overlap in *.
 assert ((fun (f: positive * type)  =>
        isNone
-         (fold_left
+         ((fold_left
             (fun t v =>
-             PTree.set (fst v) tt t) G (PTree.empty unit)) ! (fst f))
+             PTree.set (fst v) tt t) G (PTree.empty unit)) !! (fst f)))
  =  (fun f =>
        isNone
-         (fold_right
+         ((fold_right
             (fun v t=>
-             PTree.set (fst v) tt t) (PTree.empty unit) G) ! (fst f))).
+             PTree.set (fst v) tt t) (PTree.empty unit) G) !! (fst f)))).
 {
 clear.
 extensionality idx.
@@ -512,11 +521,11 @@ unfold isNone.
 replace ((fold_right
      (fun v t
       => PTree.set (fst v) tt t)
-     (PTree.empty unit) G) ! j) with
+     (PTree.empty unit) G) !! j) with
     ((fold_left
      (fun t v
       => PTree.set (fst v) tt t) G
-     (PTree.empty unit)) ! j); auto.
+     (PTree.empty unit)) !! j); auto.
 rewrite <- fold_left_rev_right.
 forget (PTree.empty unit) as base.
 revert base.
@@ -546,7 +555,7 @@ subst.
 rewrite !PTree.gss; auto.
 rewrite !PTree.gso; auto.
 }
-rewrite H2 in *. clear H2.
+rewrite H2 in H. clear H2.
 induction V.
 inv H1.
 destruct H1.
@@ -572,18 +581,17 @@ clear H0 IHG.
 simpl in H.
 change positive with ident in *.
 destruct (ident_eq (fst a0) (fst a)).
-rewrite e in *.
+rewrite e in H.
 rewrite PTree.gss in H.
 inv H.
-rewrite PTree.gso in H by auto.
-auto.
+rewrite PTree.gso in H; auto.
 -
 simpl in H.
 rewrite andb_true_iff in H.
 destruct H.
 auto.
 Qed.
-
+ 
 Lemma leaf_function': 
  forall Vprog Gprog (CS: compspecs) f s,
  check_no_overlap Vprog Gprog = true ->
@@ -597,18 +605,18 @@ destruct fs.
 destruct H0 as [H0' [H0'' H0]]; split3; auto.
 clear H0'.
 intros.
-specialize (H0 Espec ts x).
+specialize (H0 _ x).
 eapply semax_Delta_subsumption; [ | apply H0].
 clear - H.
 split3; [ | | split3; [ | | split]]; auto.
 -
 intros; simpl; auto.
 destruct ((make_tycontext_t (fn_params f) (fn_temps f))
-  ! id); auto.
+  !! id); auto.
 -
 intros; hnf; intros.
 destruct ((glob_types (func_tycontext f Vprog nil nil))
-  ! id) eqn:?H; auto.
+  !! id) eqn:?H; auto.
 simpl in *.
 unfold make_tycontext_g.
 apply check_no_overlap_e with (i:=id) in H.
@@ -622,7 +630,7 @@ simpl in H.
 apply Decidable.not_or in H.
 destruct H.
 simpl.
-rewrite PTree.gso by auto.
+rewrite PTree.gso; [|by auto].
 auto.
 clear - H0.
 induction Vprog.
@@ -630,7 +638,7 @@ simpl in H0. rewrite PTree.gempty in H0. inv H0.
 simpl in *.
 destruct (ident_eq (fst a) id).
 auto.
-rewrite PTree.gso in H0 by auto.
+rewrite PTree.gso in H0; [|by auto].
 auto.
 -
 intros; hnf; intros.
@@ -645,11 +653,11 @@ Qed.
 
 Definition check_no_overlap'
     (V: varspecs) (Gtable: PTree.t unit) : bool :=
-  forallb (fun f => isNone (Gtable ! (fst f))) V.
+  forallb (fun f => isNone (Gtable !! (fst f))) V.
 
 Definition check_no_Gvars (Gtable: PTree.t unit) (s: statement) : bool :=
   find_expressions 
-    (find_vars (fun i b => match Gtable!i with Some _=> false | None => b end))
+    (find_vars (fun i b => match Gtable!!i with Some _=> false | None => b end))
     s true.
 
 Lemma leaf_function: 
@@ -669,45 +677,6 @@ subst Gtable.
 apply H0.
 Qed.
 
-Definition function_pointers := tt.
-Ltac function_pointers :=
- let x := fresh "there_are" in
- pose (x := function_pointers).
-
-Ltac leaf_function := 
- try lazymatch goal with
- | x := function_pointers |- _ => clear x
- | |- semax_body ?Vprog ?Gprog _ _ =>
- eapply leaf_function;
- [reflexivity 
- | reflexivity; fail "Error in leaf_function tactic: your" Vprog "and" Gprog "overlap!"
- | reflexivity; fail "Error in leaf_function tactic: your function body refers to an identifier in" Gprog
- | ]
-end.
-
-(*
-Definition any_gvars (ds: PTree.t funspec) (s: statement) : bool :=
-  find_expressions 
-    (find_vars (fun i b => match ds!i with Some _=> true | None => b end))
-    s false.
-
-Ltac suggest_leaf_function :=
- lazymatch goal with 
- | x := function_pointers |- _ => clear x
- | DS := @abbreviate (PTree.t funspec) ?ds,
-   D := @abbreviate tycontext (mk_tycontext _ _ _ _ ?DS' _) |-
-   semax ?D' _ ?c _ =>
-   constr_eq DS DS'; constr_eq D D';
-   let b := constr:(any_gvars ds c) in
-   let b := eval compute in b in
-   constr_eq b false;
-   idtac "This function appears to be a leaf function, that is, has no function calls.
-* If you will reason about function-pointers (using make_func_ptr) in this proof, apply the tactic [function_pointers] before doing [start_function].
-* If this semax_body proof does NOT involve function-pointers, use the tactic [leaf_function] before [start_function]; this is optional but will speed up the proof by clearing the body of Delta_specs."
-end.
-*)
-
-
 Fixpoint seq_stmt_size (c: statement) : nat :=
  match c with
  | Ssequence c1 c2 => seq_stmt_size c1 + seq_stmt_size c2
@@ -785,7 +754,7 @@ Lemma unfold_seq_to_unfold_Ssequence: forall cs,
   unfold_Ssequence cs = flat_map unfold_Ssequence (unfold_seq cs).
 Proof.
   intro cs. induction cs; try reflexivity.
-  - simpl. rewrite IHcs1, IHcs2. rewrite flat_map_app.
+  - simpl. rewrite IHcs1 IHcs2. rewrite flat_map_app.
     destruct cs2; try reflexivity;
     try rewrite flat_map_unfold_Ssequence_idempotent; try reflexivity.
     destruct cs2_1; try reflexivity;
@@ -807,9 +776,9 @@ Proof.
     destruct cs2; reflexivity.
 Qed.
 
-Lemma semax_unfold_seq {Espec: OracleKind} {CS: compspecs} : forall c1 c2,
+Lemma semax_unfold_seq {CS: compspecs} : forall E c1 c2,
   unfold_seq c1 = unfold_seq c2 ->
-  forall P Q Delta, semax Delta P c1 Q -> semax Delta P c2 Q.
+  forall P Q Delta, semax Delta P E c1 Q -> semax Delta P E c2 Q.
 Proof.
   intros. eapply semax_unfold_Ssequence; [ | eassumption ].
   do 2 rewrite unfold_seq_to_unfold_Ssequence.
@@ -817,7 +786,7 @@ Proof.
 Qed.
 
 Ltac first_N_statements n :=
- lazymatch goal with |- semax _ _ ?c _ =>
+ lazymatch goal with |- semax _ _ _ ?c _ =>
  let c' := constr:(unfold_seqN n c) in
  let c' := eval cbv beta iota zeta delta
    [seq_stmt_size app unfold_seqN unfold_seqN' Init.Nat.add]
@@ -829,4 +798,42 @@ Ltac first_N_statements n :=
                          apply semax_unfold_seq with (Ssequence al' c''); 
                          [reflexivity | eapply semax_seq' ]
  end end.
+End SEMAX_TACTICS.
+
+Definition function_pointers := tt.
+Ltac function_pointers :=
+ let x := fresh "there_are" in
+ pose (x := function_pointers).
 
+Ltac leaf_function := 
+ try lazymatch goal with
+ | x := function_pointers |- _ => clear x
+ | |- semax_body ?Vprog ?Gprog _ _ =>
+ eapply leaf_function;
+ [reflexivity 
+ | reflexivity; fail "Error in leaf_function tactic: your" Vprog "and" Gprog "overlap!"
+ | reflexivity; fail "Error in leaf_function tactic: your function body refers to an identifier in" Gprog
+ | ]
+end.
+
+(*
+Definition any_gvars (ds: PTree.t funspec) (s: statement) : bool :=
+  find_expressions 
+    (find_vars (fun i b => match ds!i with Some _=> true | None => b end))
+    s false.
+
+Ltac suggest_leaf_function :=
+ lazymatch goal with 
+ | x := function_pointers |- _ => clear x
+ | DS := @abbreviate (PTree.t funspec) ?ds,
+   D := @abbreviate tycontext (mk_tycontext _ _ _ _ ?DS' _) |-
+   semax _ ?D' _ ?c _ =>
+   constr_eq DS DS'; constr_eq D D';
+   let b := constr:(any_gvars ds c) in
+   let b := eval compute in b in
+   constr_eq b false;
+   idtac "This function appears to be a leaf function, that is, has no function calls.
+   * If you will reason about function-pointers (using make_func_ptr) in this proof, apply the tactic [function_pointers] before doing [start_function].
+    * If this semax_body proof does NOT involve function-pointers, use the tactic [leaf_function] before [start_function]; this is optional but will speed up the proof by clearing the body of Delta_specs."
+    end.
+    *)
\ No newline at end of file
diff --git a/floyd/seplog_tactics.v b/floyd/seplog_tactics.v
index 5072189507..8030a323ad 100644
--- a/floyd/seplog_tactics.v
+++ b/floyd/seplog_tactics.v
@@ -1,186 +1,357 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Import VST.veric.lifting_expr.
 Require Import VST.floyd.base.
 Require Import VST.floyd.val_lemmas.
-Local Open Scope logic.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
+Require Import VST.veric.log_normalize.
 
-Definition prop_and_mpred := @prop_and mpred _.
+Section pred.
 
-#[export] Hint Rewrite <- prop_and_mpred : gather_prop.
+Context {M : uora}.
+
+Implicit Types (P Q R : ouPred M).
 
 Lemma gather_prop_left:
-  forall P Q (R: mpred),  !! P && (!! Q && R) = !!(P/\Q) && R.
-Proof. intros. rewrite <- andp_assoc. rewrite <- prop_and; auto.
-Qed.
+  forall (P Q : Prop) R,  (⌜P⌝ ∧ (⌜Q⌝ ∧ R)) = (⌜P /\ Q⌝ ∧ R).
+Proof. intros. rewrite and_assoc -pure_and //. Qed.
 
 Lemma gather_prop_right:
-  forall P Q (R: mpred),  R && !! P && !! Q = !!(P/\Q) && R.
-Proof. intros. rewrite andp_assoc. rewrite andp_comm.  rewrite <- prop_and; auto.
-Qed.
-#[export] Hint Rewrite gather_prop_left gather_prop_right : gather_prop.
+  forall (P Q : Prop) R,  ((R ∧ ⌜P⌝) ∧ ⌜Q⌝) = (⌜P /\ Q⌝ ∧ R).
+Proof. intros. rewrite -and_assoc -pure_and and_comm //. Qed.
 
-Lemma andp_in_order1 {A}{NA: NatDed A}:
-  forall P Q, P && Q = P && (P --> Q).
+Lemma andp_in_order1:
+  forall P Q, (P ∧ Q) ⊣⊢ (P ∧ (P → Q)).
 Proof.
   intros.
-  apply pred_ext.
-  + apply andp_derives; auto.
-    apply imp_andp_adjoint.
-    apply andp_left1; auto.
-  + apply andp_right.
-    - apply andp_left1; auto.
-    - apply modus_ponens.
+  iSplit; iIntros "H"; (iSplit; first rewrite bi.and_elim_l //).
+  + iApply (bi.impl_intro_l with "H").
+    rewrite !bi.and_elim_r //.
+  + iApply (modus_ponens with "H").
 Qed.
 
-Lemma andp_in_order2 {A}{NA: NatDed A}:
-  forall P Q, P && Q = Q && (Q --> P).
+Lemma andp_in_order2:
+  forall P Q, P ∧ Q ⊣⊢ Q ∧ (Q → P).
 Proof.
   intros.
-  rewrite (andp_comm P Q).
+  rewrite comm.
   apply andp_in_order1.
 Qed.
 
-Lemma andp_right1{A}{NA: NatDed A}:
-  forall P Q R, (P |-- Q) -> (P && Q |-- R) -> P |-- Q && R.
+Lemma andp_right1:
+  forall P Q R, (P ⊢ Q) -> (P ∧ Q ⊢ R) -> P ⊢ Q ∧ R.
 Proof.
   intros.
   rewrite andp_in_order1.
-  apply andp_right; auto.
-  apply imp_andp_adjoint; auto.
+  apply bi.and_intro; first done.
+  by apply bi.impl_intro_r.
 Qed.
 
-Lemma andp_right2{A}{NA: NatDed A}:
-  forall P Q R, (P |-- R) -> (P && R |-- Q) -> P |-- Q && R.
+Lemma andp_right2:
+  forall P Q R, (P ⊢ R) -> (P ∧ R ⊢ Q) -> P ⊢ Q ∧ R.
 Proof.
   intros.
-  rewrite andp_comm.
+  rewrite comm.
   apply andp_right1; auto.
 Qed.
 
-Definition not_a_prop (P: mpred) := True.
+Definition not_a_prop P := True%type.
 
-Ltac not_a_prop := match goal with
-  | |- not_a_prop  (prop _) => fail 1
-  | |- _ => apply Coq.Init.Logic.I
+Lemma flip_prop: forall P (Q : Prop),
+      not_a_prop P -> ((P ∧ ⌜Q⌝) = (⌜Q⌝ ∧ P)).
+Proof. intros; rewrite and_comm //. Qed.
+
+Lemma gather_prop3:
+  forall (P: Prop) Q R,  not_a_prop R -> not_a_prop Q -> (R ∧ (⌜P⌝ ∧ Q)) = (⌜P⌝ ∧ (R ∧ Q)).
+Proof.
+  intros. rewrite and_comm. rewrite -and_assoc.
+  rewrite (and_comm Q); auto.
+Qed.
+
+Lemma gather_prop4:
+  forall (P: Prop) Q R,  not_a_prop R -> not_a_prop Q -> ((⌜P⌝ ∧ R) ∧ Q) = (⌜P⌝ ∧ (R ∧ Q)).
+Proof.
+  intros. rewrite -and_assoc. auto.
+Qed.
+
+Lemma gather_prop5:
+  forall (P: Prop) Q R,  not_a_prop R -> not_a_prop Q -> ((R ∧ ⌜P⌝) ∧ Q) = (⌜P⌝ ∧ (R ∧ Q)).
+Proof.
+  intros. rewrite -and_assoc. rewrite and_comm. rewrite -and_assoc.
+  f_equal; apply and_comm.
+Qed.
+
+Lemma pull_left_special: forall (A B C : ouPred M),
+    (B ∗ (A ∗ C)) = (A ∗ (B ∗ C)).
+Proof.
+intros. rewrite sep_comm. rewrite -sep_assoc. f_equal.
+ apply sep_comm.
+Qed.
+
+Lemma pull_left_special0: forall (A B : ouPred M),
+    (B ∗ A) = (A ∗ B).
+Proof.
+intros; apply sep_comm.
+Qed.
+
+Lemma prop_sepcon: forall (P : Prop) Q, (⌜P⌝ ∗ Q) = (⌜P⌝ ∧ (True ∗ Q)).
+Proof.
+  intros.
+  rewrite -{1}(and_True ⌜_⌝) sepcon_andp_prop' //.
+Qed.
+
+Lemma prop_sepcon2: forall (P : Prop) Q, (Q ∗ ⌜P⌝) = (⌜P⌝ ∧ (True ∗ Q)).
+Proof.
+  intros.
+  rewrite sep_comm. apply prop_sepcon.
+Qed.
+
+Fixpoint fold_right_sepconx {PROP : bi} (l: list PROP) : PROP :=
+match l with
+| nil => emp
+| a::nil => a
+| a::b => a ∗ fold_right_sepconx b
 end.
 
-Lemma flip_prop: forall P Q,
-      not_a_prop P -> (P&& !! Q = !! Q && P).
-Proof. intros. apply andp_comm. Qed.
+Definition fold_left_sepconx {PROP : bi} (l: list PROP) : PROP :=
+match l with
+| nil => emp
+| a::l => (fix fold_left_sepconx (a: PROP) (l: list PROP) {struct l}: PROP :=
+          match l with
+          | nil => a
+          | b :: l => fold_left_sepconx (bi_sep a b) l
+          end) a l
+end.
 
-#[export] Hint Rewrite flip_prop using not_a_prop : gather_prop.
+Lemma fold_right_sepconx_eq: forall (l : list (ouPred M)), fold_right_sepconx l = fold_right_sepcon l.
+Proof.
+induction l; simpl; auto.
+rewrite -IHl.
+destruct l; simpl; auto. rewrite sep_emp; auto.
+Qed.
 
-Lemma gather_prop3:
-  forall P Q R,  not_a_prop R -> not_a_prop Q -> R && (!! P && Q) = !!P && (R && Q).
-Proof. intros. rewrite andp_comm. rewrite andp_assoc.
-        rewrite (andp_comm Q); auto.
+Lemma fold_left_sepconx_eq: forall (l : list (ouPred M)), fold_left_sepconx l = fold_right_sepcon l.
+Proof.
+  intros; rewrite <- fold_right_sepconx_eq.
+  destruct l; auto; simpl.
+  revert o; induction l; intros; auto.
+  simpl in *.
+  rewrite <- IHl.
+  clear IHl.
+  revert o a; induction l; intros; auto.
+  simpl.
+  rewrite !IHl sep_assoc //.
 Qed.
 
-#[export] Hint Rewrite gather_prop3 using not_a_prop : gather_prop.
+Lemma fold_right_sepconx_eqx:
+  forall (A : ouPred M) B, (A ⊢ fold_right_sepconx B) -> A ⊢ fold_right_sepcon B.
+Proof.
+intros.
+rewrite <- fold_right_sepconx_eq; auto.
+Qed.
 
-Lemma gather_prop4:
-  forall P Q R,  not_a_prop R -> not_a_prop Q -> (!!P && R) && Q = !!P && (R && Q).
-Proof. intros. rewrite andp_assoc. auto.
+Context `{!heapGS Σ}.
+
+Lemma local_and_sep_assoc : forall (P : environ -> Prop) (Q R : assert), (local P ∧ (Q ∗ R)) = ((local P ∧ Q) ∗ R).
+Proof.
+  intros; apply assert_ext; intros; monPred.unseal.
+  rewrite sepcon_andp_prop' //.
 Qed.
-#[export] Hint Rewrite gather_prop4 using not_a_prop : gather_prop.
 
-Lemma gather_prop5:
-  forall P Q R,  not_a_prop R -> not_a_prop Q -> (R && !!P && Q) = !!P && (R && Q).
-Proof. intros. rewrite andp_assoc. rewrite andp_comm. rewrite andp_assoc.
-  f_equal; apply andp_comm.
+Lemma local_and_sep_assoc' : forall (P : assert) (Q : environ -> Prop) (R : assert), (P ∗ (local Q ∧ R)) = (local Q ∧ (P ∗ R)).
+Proof.
+  intros; rewrite sep_comm' -local_and_sep_assoc sep_comm' //.
 Qed.
-#[export] Hint Rewrite gather_prop5 using not_a_prop : gather_prop.
 
-#[export] Hint Rewrite sepcon_andp_prop sepcon_andp_prop' : gather_prop gather_prop_core.
+Lemma local_and_sep_assoc2 : forall (P : environ -> Prop) (Q R : assert), (local P ∧ (Q ∗ R)) = ((Q ∧ local P) ∗ R).
+Proof.
+  intros; rewrite (and_comm' Q); apply local_and_sep_assoc.
+Qed.
+
+Lemma local_and_sep_assoc2' : forall (P : assert) (Q : environ -> Prop) (R : assert), (P ∗ (R ∧ local Q)) = (local Q ∧ (P ∗ R)).
+Proof.
+  intros; rewrite (and_comm' R); apply local_and_sep_assoc'.
+Qed.
+
+Lemma pure_and_sep_assoc : forall (P : Prop) (Q R : assert), (⌜P⌝ ∧ (Q ∗ R)) = ((⌜P⌝ ∧ Q) ∗ R).
+Proof.
+  intros; apply assert_ext; intros; monPred.unseal.
+  rewrite sepcon_andp_prop' //.
+Qed.
+
+Lemma pure_and_sep_assoc' : forall (P : assert) (Q : Prop) (R : assert), (P ∗ (⌜Q⌝ ∧ R)) = (⌜Q⌝ ∧ (P ∗ R)).
+Proof.
+  intros; rewrite sep_comm' -pure_and_sep_assoc sep_comm' //.
+Qed.
+
+Lemma pure_and_sep_assoc2 : forall (P : Prop) (Q R : assert), (⌜P⌝ ∧ (Q ∗ R)) = ((Q ∧ ⌜P⌝) ∗ R).
+Proof.
+  intros; rewrite (and_comm' Q); apply pure_and_sep_assoc.
+Qed.
+
+Lemma pure_and_sep_assoc2' : forall (P : assert) (Q : Prop) (R : assert), (P ∗ (R ∧ ⌜Q⌝)) = (⌜Q⌝ ∧ (P ∗ R)).
+Proof.
+  intros; rewrite (and_comm' R); apply pure_and_sep_assoc'.
+Qed.
+
+Lemma sepcon_andp_prop2' : forall (P : Prop) Q R, ((Q ∧ ⌜P⌝) ∗ R) = (⌜P⌝ ∧ (Q ∗ R)).
+Proof.
+  intros; rewrite (and_comm Q); apply sepcon_andp_prop'.
+Qed.
+
+Lemma sepcon_andp_prop2 : forall P (Q : Prop) R, (P ∗ (R ∧ ⌜Q⌝)) = (⌜Q⌝ ∧ (P ∗ R)).
+Proof.
+  intros; rewrite (and_comm R); apply sepcon_andp_prop.
+Qed.
+
+Lemma and_assoc2 : forall P Q R, (Q ∧ (P ∧ R)) = (P ∧ (Q ∧ R)).
+Proof.
+  intros; rewrite !and_assoc (and_comm Q) //.
+Qed.
+
+End pred.
+
+#[export] Hint Rewrite <- @pure_and : gather_prop.
+
+Section PROP.
+
+Context {PROP : bi}.
 
 Lemma go_lower_lem1:
-  forall (P1 P: Prop) (QR PQR: mpred),
-      (P1 -> prop P && QR |-- PQR) ->
-      (prop (P1 /\ P ) && QR |-- PQR).
+  forall (P1 P: Prop) (QR PQR: PROP),
+      (P1 -> ⌜P⌝ ∧ QR ⊢ PQR) ->
+      (⌜P1 /\ P⌝ ∧ QR ⊢ PQR).
 Proof.
  intros.
- apply derives_extract_prop; intros [? ?].
- apply derives_trans with (!!P && QR).
- apply andp_right; auto. apply prop_right; auto.
+ apply bi.pure_elim_l; intros [? ?].
+ trans (⌜P⌝ ∧ QR).
+ apply bi.and_intro; auto.
  apply H; auto.
 Qed.
 
 Lemma go_lower_lem1':
-  forall (P1 P2 P: Prop) (QR PQR: mpred),
-      (prop (P1 /\ (P2 /\ P)) && QR |-- PQR) ->
-      (prop ((P1 /\ P2) /\ P ) && QR |-- PQR).
+  forall (P1 P2 P: Prop) (QR PQR: PROP),
+      (⌜P1 /\ (P2 /\ P)⌝ ∧ QR ⊢ PQR) ->
+      (⌜(P1 /\ P2) /\ P⌝ ∧ QR ⊢ PQR).
 Proof.
  intros.
- eapply derives_trans;  [ | apply H].
- apply andp_derives; auto.
- apply prop_derives; intuition.
+ rewrite -H base.and_assoc //.
 Qed.
 
 (* These versions can sometimes take minutes,
    when A and B can't be unified
-#[export] Hint Extern 1 (_ |-- _) => (simple apply (@derives_refl mpred _) ) : cancel.
-#[export] Hint Extern 1 (_ |-- |> _) => (simple apply (@now_later mpred _ _) ) : cancel.
+#[export] Hint Extern 1 (_ ⊢ _) => (simple apply (@entails_refl PROP _) ) : cancel.
+#[export] Hint Extern 1 (_ ⊢ |> _) => (simple apply (@now_later PROP _ _) ) : cancel.
 *)
 
-#[export] Hint Extern 2 (?A |-- ?B) => (constr_eq A B; simple apply derives_refl) : cancel.
-#[export] Hint Extern 2 (?A |-- |> ?B) => (constr_eq A B; simple apply now_later) : cancel.
-
 Lemma cancel1_start:
- forall P Q : mpred,
-   (P |-- Q * emp) ->
-   P |-- Q.
-Proof. Set Printing All. intros. rewrite sepcon_emp in H; auto.
+ forall P Q : PROP,
+   (P ⊢ Q ∗ emp) ->
+   P ⊢ Q.
+Proof. intros. rewrite bi.sep_emp in H; auto.
 Qed.
 
 Lemma cancel1_here:
-  forall P P' Q1 Q2 Q3 : mpred,
-  (P' |-- Q2) ->
-  (P |-- Q1 * Q3) ->
-  P * P' |-- Q1 * Q2 * Q3.
+  forall P P' Q1 Q2 Q3 : PROP,
+  (P' ⊢ Q2) ->
+  (P ⊢ Q1 ∗ Q3) ->
+  P ∗ P' ⊢ (Q1 ∗ Q2) ∗ Q3.
 Proof.
-intros. rewrite (sepcon_comm Q1).
-rewrite sepcon_assoc.  rewrite sepcon_comm. apply sepcon_derives; auto.
+intros. rewrite (bi.sep_comm Q1).
+rewrite -bi.sep_assoc.  rewrite bi.sep_comm. apply bi.sep_mono; auto.
 Qed.
 
 Lemma cancel1_next:
-  forall P Q1 Q2 Q3 : mpred,
-   (P |-- Q1 * (Q2 * Q3)) ->
-   P |-- Q1 * Q2 * Q3.
-Proof. intros. rewrite sepcon_assoc; auto. Qed.
+  forall P Q1 Q2 Q3 : PROP,
+   (P ⊢ Q1 ∗ (Q2 ∗ Q3)) ->
+   P ⊢ (Q1 ∗ Q2) ∗ Q3.
+Proof. intros. rewrite -bi.sep_assoc; auto. Qed.
 
 Lemma cancel1_last:
-  forall P P' Q2 Q3 : mpred,
-  (P' |-- Q2) ->
-  (P |-- Q3) ->
-  P * P' |-- Q2 * Q3.
+  forall P P' Q2 Q3 : PROP,
+  (P' ⊢ Q2) ->
+  (P ⊢ Q3) ->
+  P ∗ P' ⊢ Q2 ∗ Q3.
 Proof.
- intros. rewrite sepcon_comm; apply sepcon_derives; auto.
+ intros. rewrite bi.sep_comm; apply bi.sep_mono; auto.
 Qed.
 
 Lemma cancel1_finish1:
-  forall P Q1 Q2 Q3 : mpred,
-   (P |-- Q1 * Q2 * Q3) ->
-   P |-- Q1 * (Q2 * Q3).
+  forall P Q1 Q2 Q3 : PROP,
+   (P ⊢ (Q1 ∗ Q2) ∗ Q3) ->
+   P ⊢ Q1 ∗ (Q2 ∗ Q3).
 Proof.
- intros. rewrite <- sepcon_assoc. auto.
+ intros. rewrite bi.sep_assoc. auto.
 Qed.
 
 Lemma cancel1_finish2:
-  forall P Q : mpred,
-    (P |-- Q) ->
-   P |-- Q * emp.
-Proof. intros. rewrite sepcon_emp; auto.
+  forall P Q : PROP,
+    (P ⊢ Q) ->
+   P ⊢ Q ∗ emp.
+Proof. intros. rewrite bi.sep_emp; auto.
+Qed.
+
+Lemma cancel_frame0:
+  (emp : PROP) ⊢ fold_right bi_sep emp nil.
+Proof. done. Qed.
+
+Lemma cancel_frame2: forall (P Q: PROP) F,
+     (Q  ⊢ fold_right_sepcon F)  ->
+    (P ∗ Q) ⊢ fold_right_sepcon (P::F).
+Proof. intros. apply bi.sep_mono; auto.
+Qed.
+
+Lemma cancel_frame1: forall (P: PROP),
+         P ⊢ fold_right_sepcon (P::nil).
+Proof. intros. unfold fold_right_sepcon. rewrite bi.sep_emp //.
+Qed.
+
+Lemma cancel_left: forall P Q R: PROP,
+   (Q ⊢ R) -> P ∗ Q ⊢ P ∗ R.
+Proof.
+intros; apply bi.sep_mono; auto.
+Qed.
+
+Lemma fun_equal: forall {A B} (f g : A -> B) (x y : A),
+  f = g -> x = y -> f x = g y.
+Proof. congruence. Qed.
+
+Lemma fun_equal': forall {A B} (f g : forall (x:A), B x) (y : A),
+  f = g -> f y = g y.
+Proof. congruence. Qed.
+
+Lemma if_congr: forall {T: Type} (a a': bool) (b b' c c' : T),
+  a=a' -> b=b' -> c=c' -> (if a then b else c) = (if a' then b' else c').
+Proof.
+intros; subst; auto.
 Qed.
 
+End PROP.
+
+Ltac not_a_prop := match goal with
+  | |- not_a_prop  (⌜_⌝) => fail 1
+  | |- _ => apply Coq.Init.Logic.I
+end.
+
+#[export] Hint Rewrite @gather_prop_left @gather_prop_right : gather_prop.
+#[export] Hint Rewrite @flip_prop using not_a_prop : gather_prop.
+#[export] Hint Rewrite @gather_prop3 using not_a_prop : gather_prop.
+#[export] Hint Rewrite @gather_prop4 using not_a_prop : gather_prop.
+#[export] Hint Rewrite @gather_prop5 using not_a_prop : gather_prop.
+#[export] Hint Rewrite @sepcon_andp_prop @sepcon_andp_prop' : gather_prop gather_prop_core.
+#[export] Hint Extern 2 (?A ⊢ ?B) => (constr_eq A B; simple apply entails_refl) : cancel.
+#[export] Hint Extern 2 (?A ⊢ ▷ ?B) => (constr_eq A B; simple apply bi.later_intro) : cancel.
+
 Ltac cancel1 :=
  first [
    simple apply cancel1_here; [
-    try match goal with H := _ : list mpred |- _ => clear H end; (*
+    try match goal with H := _ (*: list PROP*) |- _ => clear H end; (*
       this line is to work around Coq 8.4 bug,
       Anomaly: undefined_evars_of_term *)
     solve [eauto with nocore cancel]
    | ]
  | simple apply cancel1_next; cancel1
  | simple apply cancel1_last; [
-    try match goal with H := _ : list mpred |- _ => clear H end; (*
+    try match goal with H := _ (*: list PROP*) |- _ => clear H end; (*
       this line is to work around Coq 8.4 bug,
       Anomaly: undefined_evars_of_term *)
     solve [eauto with nocore cancel] | ]
@@ -219,10 +390,10 @@ Ltac lift4 a e1 e2 e3 e4 rho :=
 
 Ltac abstract_env rho P :=
   match P with
-   | @emp mpred _ _ => constr:(@emp (environ->mpred) _ _)
-   | @sepcon mpred _ _ ?e1 ?e2 =>
+   | @bi_emp ?PROP => constr:(@bi_emp (monPred environ_index PROP) _ _)
+   | @bi_sep ?PROP ?e1 ?e2 =>
       let e1' := abstract_env rho e1 in let e2' := abstract_env rho e2
-       in constr:(@sepcon (environ->mpred) _ _ e1' e2')
+       in constr:(@bi_sep (monPred environ_index PROP) _ _ e1' e2')
    | ?a0 ?a1 ?a2 ?e1 ?e2 ?e3 ?e4 =>
       let e1' := abstract_env rho e1  in let e2' := abstract_env rho e2 in let e3' := abstract_env rho e3 in let e4' := abstract_env rho e4
       in lift3 (a0 a1 a2) e1' e2' e3' e4' rho
@@ -243,101 +414,20 @@ Ltac abstract_env rho P :=
    | ?a => constr:(lift0 a)
    end.
 
-Lemma cancel_frame0{A}{ND: NatDed A}{SL: SepLog A}:
-  forall rho: environ, emp rho |-- fold_right sepcon emp nil rho.
-Proof. intro; apply derives_refl. Qed.
-
-Lemma cancel_frame0_low:
-  emp |-- fold_right_sepcon nil.
-Proof.  apply derives_refl. Qed.
-
-Lemma cancel_frame2: forall (P Q: environ->mpred) F (rho: environ),
-     (Q rho |-- 	fold_right sepcon emp F rho) ->
-    (P * Q) rho |-- fold_right sepcon emp (P::F) rho.
-Proof. intros. simpl. apply sepcon_derives; auto.
-Qed.
-
-Lemma cancel_frame2_low: forall (P Q: mpred) F,
-     (Q  |-- fold_right_sepcon F)  ->
-    (P * Q) |-- fold_right_sepcon (P::F).
-Proof. intros. apply sepcon_derives; auto.
-Qed.
-
-Lemma cancel_frame1: forall (P: environ->mpred) (rho: environ),
-         P rho |-- fold_right sepcon emp (P::nil) rho.
-Proof. intros. unfold fold_right. rewrite sepcon_emp; apply derives_refl.
-Qed.
-
-Lemma cancel_frame1_low: forall (P: mpred),
-         P |-- fold_right_sepcon (P::nil).
-Proof. intros. unfold fold_right_sepcon. rewrite sepcon_emp; apply derives_refl.
-Qed.
-
 
 Ltac fixup_lifts :=
  repeat
  match goal with
- | |- context[@lift0 mpred] => change (@lift0 mpred) with (@liftx (LiftEnviron mpred))
- | |- context[@lift1 ?A] => change (@lift1 A mpred) with (@liftx (Tarrow A (LiftEnviron mpred)))
- | |- context[@lift2 ?A ?B] =>  change (@lift2 A B mpred) with (@liftx (Tarrow A (Tarrow B (LiftEnviron mpred))))
- | |- context[@lift3 ?A ?B ?C] => change (@lift3 A B C mpred) with (@liftx (Tarrow A (Tarrow B (Tarrow C (LiftEnviron mpred)))))
- | |- context[@lift4 ?A ?B ?C ?D] => change (@lift4 A B C D mpred) with (@liftx (Tarrow A (Tarrow B (Tarrow C (Tarrow D (LiftEnviron mpred))))))
+ | |- context[@lift0 ?PROP] => change (@lift0 PROP) with (@liftx (LiftEnviron PROP))
+ | |- context[@lift1 ?A ?PROP] => change (@lift1 A PROP) with (@liftx (Tarrow A (LiftEnviron PROP)))
+ | |- context[@lift2 ?A ?B ?PROP] =>  change (@lift2 A B PROP) with (@liftx (Tarrow A (Tarrow B (LiftEnviron PROP))))
+ | |- context[@lift3 ?A ?B ?C ?PROP] => change (@lift3 A B C PROP) with (@liftx (Tarrow A (Tarrow B (Tarrow C (LiftEnviron PROP)))))
+ | |- context[@lift4 ?A ?B ?C ?D ?PROP] => change (@lift4 A B C D PROP) with (@liftx (Tarrow A (Tarrow B (Tarrow C (Tarrow D (LiftEnviron PROP))))))
  end.
 
-Fixpoint fold_right_sepconx (l: list mpred) : mpred :=
-match l with
-| nil => emp
-| a::nil => a
-| a::b => a * fold_right_sepconx b
-end.
-
-Definition fold_left_sepconx (l: list mpred) : mpred :=
-match l with
-| nil => emp
-| a::l => (fix fold_left_sepconx (a: mpred) (l: list mpred) {struct l}: mpred :=
-          match l with
-          | nil => a
-          | b :: l => fold_left_sepconx (sepcon a b) l
-          end) a l
-end.
-
-Lemma fold_right_sepconx_eq: fold_right_sepconx = fold_right_sepcon.
-Proof.
-extensionality l.
-induction l; simpl; auto.
-rewrite IHl.
-destruct l; simpl; auto. rewrite sepcon_emp; auto.
-Qed.
-
-Lemma fold_left_sepconx_eq:
-  fold_left_sepconx = fold_right_sepcon.
-Proof.
-  extensionality l.
-  rewrite <- fold_right_sepconx_eq.
-  destruct l; auto.
-  revert m; induction l; intros.
-  + auto.
-  + simpl in *.
-    rewrite <- IHl.
-    clear IHl.
-    revert m a; induction l; intros.
-    - auto.
-    - simpl.
-      rewrite sepcon_assoc.
-      rewrite IHl.
-      auto.
-Qed.
-
-Lemma fold_right_sepconx_eqx:
-  forall A B, (A |-- fold_right_sepconx B) -> A |-- fold_right_sepcon B.
-Proof.
-intros.
-rewrite <- fold_right_sepconx_eq; auto.
-Qed.
-
 Ltac unfold_right_sepcon A :=
  lazymatch A with
- | (?B * ?C)%logic => let x := unfold_right_sepcon C
+ | (?B ∗ ?C) => let x := unfold_right_sepcon C
                                in let y := constr:(B :: x)
                                in y
  | ?D => let y := constr:(D::nil) in y
@@ -345,28 +435,28 @@ end.
 
 Ltac cancel_frame :=
 match goal with
-| |- _ |-- fold_right_sepcon _  => (* setup *)
-   rewrite !sepcon_assoc; cancel_frame
-| F := ?v |- ?A |-- fold_right_sepcon ?F  => (* fast way *)
+| |- _ ⊢ fold_right_sepcon _  => (* setup *)
+   rewrite -!bi.sep_assoc; cancel_frame
+| F := ?v |- ?A ⊢ fold_right_sepcon ?F  => (* fast way *)
    is_evar v;
    apply fold_right_sepconx_eqx;
    let w := unfold_right_sepcon A
     in instantiate (1:=w) in (value of F);
     unfold F;
     unfold fold_right_sepconx;
-    simple apply derives_refl
+    simple apply entails_refl
 (*
-| |- _ |-- fold_right_sepcon ?F  =>  (* slow way *)
+| |- _ ⊢ fold_right_sepcon ?F  =>  (* slow way *)
    repeat apply cancel_frame2_low;
     try (unfold F; apply cancel_frame0_low);
     try (unfold F; apply cancel_frame1_low)
 *)
-| |- ?P |-- fold_right _ _ ?F ?rho  =>
+| |- ?P ⊢ fold_right _ _ ?F ?rho  =>
      let P' := abstract_env rho P in
-       change ( P' rho |-- fold_right sepcon emp F rho);
+       change ( P' rho ⊢ fold_right bi_sep emp F rho);
    fixup_lifts; cbv beta;
-    repeat rewrite sepcon_assoc;
-   repeat match goal with |- (_ * _) _ |-- _ =>
+    repeat rewrite -bi.sep_assoc;
+   repeat match goal with |- (_ ∗ _) _ ⊢ _ =>
                    apply cancel_frame2
                     end;
     try (unfold F; apply cancel_frame1);
@@ -382,47 +472,28 @@ Ltac pull_left A :=
   and which sometimes fails when the terms get complicated.
  *)
   repeat match goal with
-  | |- context [?Q * ?R * A] => rewrite <- (pull_right A Q R)
-  | |- context [?Q * A] => rewrite <- (pull_right0 A Q)
+  | |- context [(?Q ∗ ?R) ∗ A] => rewrite <- (pull_right A Q R)
+  | |- context [?Q ∗ A] => rewrite <- (pull_right0 A Q)
   end.
 
-Lemma cancel_left: forall P Q R: mpred,
-   (Q |-- R) -> P * Q |-- P * R.
-Proof.
-intros; apply sepcon_derives; auto.
-Qed.
-
-Lemma pull_left_special: forall A B C : mpred,
-    (B * (A * C)) = (A * (B * C)).
-Proof.
-intros. rewrite sepcon_comm. rewrite sepcon_assoc. f_equal.
- apply sepcon_comm.
-Qed.
-
-Lemma pull_left_special0: forall A B : mpred,
-    (B * A) = (A * B).
-Proof.
-intros; apply sepcon_comm.
-Qed.
-
 Ltac qcancel P :=
  lazymatch P with
- | sepcon ?A ?B => 
-     match goal with |- _ |-- ?Q =>
+ | bi_sep ?A ?B => 
+     match goal with |- _ ⊢ ?Q =>
        try match Q with context [A] =>
         let a := fresh "A" in set (a:=A);
-         rewrite ?(pull_left_special0 a), ?(pull_left_special a);
+         rewrite ?(pull_left_special0 a) ?(pull_left_special a);
          apply cancel_left;
          clear a
        end;
        qcancel B
      end
  | ?A => 
-     try match goal with |- _ |-- ?Q =>
+     try match goal with |- _ ⊢ ?Q =>
        lazymatch Q with context [A] =>
         let a := fresh "A" in set (a:=A);
-         rewrite ?(pull_left_special0 a), ?(pull_left_special a);
-         rewrite ?(pull_left_special0 A), ?(pull_left_special A);
+         rewrite ?(pull_left_special0 a) ?(pull_left_special a);
+         rewrite ?(pull_left_special0 A) ?(pull_left_special A);
          apply cancel_left;
          clear a
       end
@@ -435,20 +506,6 @@ Ltac is_Type_or_type T :=
   | type => idtac
   end.
 
-Lemma fun_equal: forall {A B} (f g : A -> B) (x y : A),
-  f = g -> x = y -> f x = g y.
-Proof. congruence. Qed.
-
-Lemma fun_equal': forall {A B} (f g : forall (x:A), B x) (y : A),
-  f = g -> f y = g y.
-Proof. congruence. Qed.
-
-Lemma if_congr: forall {T: Type} (a a': bool) (b b' c c' : T),
-  a=a' -> b=b' -> c=c' -> (if a then b else c) = (if a' then b' else c').
-Proof.
-intros; subst; auto.
-Qed.
-
 
 Ltac ecareful_unify :=
   match goal with
@@ -465,54 +522,65 @@ Ltac careful_unify :=
   | |- (if _ then _ else _) = if _ then _ else _ => simple apply if_congr; solve[careful_unify]   
   end; idtac.
 
+Lemma entails_refl' {PROP : bi} : forall (P Q : PROP), P = Q -> P ⊢ Q.
+Proof.
+  by intros ?? ->.
+Qed.
+
 Ltac cancel :=
-  rewrite ?sepcon_assoc;
-  repeat match goal with |- ?A * _ |-- ?B * _ => 
+  rewrite -?sep_assoc;
+  repeat match goal with |- ?A ∗ _ ⊢ ?B ∗ _ => 
      constr_eq A B;  simple apply (cancel_left A)
   end;
-  match goal with |- ?P |-- _ => qcancel P end;
-  repeat first [rewrite emp_sepcon | rewrite sepcon_emp];
-  try match goal with |- ?A |-- ?B => 
-       constr_eq A B; simple apply (derives_refl A)
+  match goal with |- ?P ⊢ _ => qcancel P end;
+  repeat first [rewrite bi.emp_sep | rewrite bi.sep_emp];
+  try match goal with |- ?A ⊢ ?B => 
+       constr_eq A B; simple apply (entails_refl A)
   end;
-  match goal with |- ?P |-- _ =>
+  match goal with |- ?P ⊢ _ =>
    (* The "emp" is a marker to notice when one complete pass has been made *)
-   rewrite <- (emp_sepcon P)
+   rewrite <- (bi.emp_sep P)
   end;
-  repeat rewrite <- sepcon_assoc;
+  repeat rewrite bi.sep_assoc;
   repeat match goal with
-    | |- sepcon _ emp |-- _ => fail 1
-    | |- sepcon _ TT |-- _ => pull_left (@TT mpred _)
-    | |- sepcon _ ?P' |-- _ => first [ cancel2 | pull_left P' ]
+    | |- bi_sep _ emp ⊢ _ => fail 1
+    | |- bi_sep _ True ⊢ _ => pull_left True%I
+    | |- bi_sep _ ?P' ⊢ _ => first [ cancel2 | pull_left P' ]
    end;
-  repeat first [rewrite emp_sepcon | rewrite sepcon_emp];
-  pull_left (@TT mpred _);
-  first [ simpl; apply derives_refl'; solve [careful_unify]
+  repeat first [rewrite bi.emp_sep | rewrite bi.sep_emp];
+  pull_left True%I;
+  first [ simpl; apply entails_refl'; solve [careful_unify]
             (* this is NOT a _complete_ tactic;
-                 for example, "simple apply derives_refl" would be more complete.  But that
+                 for example, "simple apply entails_refl" would be more complete.  But that
                  tactic can sometimes take minutes to discover that something doesn't unify;
                  what I have here is a compromise between reliable speed, and (in)completeness.
                *)
-          | apply TT_right
-          | apply @sepcon_TT; solve [auto with nocore typeclass_instances]
-          | apply @TT_sepcon; solve [auto with nocore typeclass_instances]
+          | apply bi.True_intro
+          | apply @bi.sep_True_2; solve [auto with nocore typeclass_instances]
+          | apply @bi.True_sep_2; solve [auto with nocore typeclass_instances]
           | cancel_frame
           | idtac
           ].
 
-Inductive syntactic_cancel: list mpred -> list mpred -> list mpred -> list mpred -> Prop :=
+Section PROP.
+
+Context {PROP : bi}.
+
+Local Notation fold_right_sepcon := (@fold_right_sepcon PROP).
+
+Inductive syntactic_cancel: list PROP -> list PROP -> list PROP -> list PROP -> Prop :=
 | syntactic_cancel_nil: forall R, syntactic_cancel R nil R nil
 | syntactic_cancel_cons_succeed: forall n R0 R L0 L F Res,
-    find_nth_preds (fun R0 => R0 |-- L0) R (Some (n, R0)) ->
+    find_nth_preds (fun R0 => R0 ⊢ L0) R (Some (n, R0)) ->
     syntactic_cancel (delete_nth n R) L F Res ->
     syntactic_cancel R (L0 :: L) F Res
 | syntactic_cancel_cons_fail: forall R L0 L F Res,
-    find_nth_preds (fun R0 => R0 |-- L0) R None ->
+    find_nth_preds (fun R0 => R0 ⊢ L0) R None ->
     syntactic_cancel R L F Res ->
     syntactic_cancel R (L0 :: L) F (L0 :: Res).
 
 Lemma syntactic_cancel_cons: forall nR0 R L0 L F Res,
-  find_nth_preds (fun R0 => R0 |-- L0) R nR0 ->
+  find_nth_preds (fun R0 => R0 ⊢ L0) R nR0 ->
   syntactic_cancel match nR0 with
                    | Some (n, _) => delete_nth n R
                    | None => R
@@ -531,7 +599,7 @@ Qed.
 
 Lemma delete_nth_SEP: forall R n R0,
   nth_error R n = Some R0 ->
-  fold_right_sepcon R |-- R0 * fold_right_sepcon (delete_nth n R).
+  fold_right_sepcon R ⊢ R0 ∗ fold_right_sepcon (delete_nth n R).
 Proof.
   intros.
   revert R H; induction n; intros; destruct R; try solve [inv H].
@@ -541,57 +609,57 @@ Proof.
   + simpl in H.
     apply IHn in H.
     simpl.
-    rewrite <- sepcon_assoc, (sepcon_comm _ m), sepcon_assoc.
-    apply sepcon_derives; auto.
+    rewrite bi.sep_assoc (bi.sep_comm _ b) -bi.sep_assoc.
+    apply bi.sep_mono; auto.
 Qed.
 
 Lemma syntactic_cancel_solve1: forall F,
-  fold_right_sepcon F |-- fold_right_sepcon nil * fold_right_sepcon F.
+  fold_right_sepcon F ⊢ fold_right_sepcon nil ∗ fold_right_sepcon F.
 Proof.
   intros.
-  simpl; rewrite emp_sepcon; auto.
+  simpl; rewrite bi.emp_sep; auto.
 Qed.
 
 Lemma syntactic_cancel_solve2: forall G,
-  fold_right_sepcon G |-- fold_right_sepcon nil * TT.
+  fold_right_sepcon G ⊢ fold_right_sepcon nil ∗ True.
 Proof.
   intros.
-  simpl; rewrite emp_sepcon.
-  apply TT_right.
+  simpl; rewrite bi.emp_sep.
+  apply bi.True_intro.
 Qed.
 
 Lemma syntactic_cancel_spec1: forall G1 L1 G2 L2 F,
   syntactic_cancel G1 L1 G2 L2 ->
-  (fold_right_sepcon G2 |-- fold_right_sepcon L2 * F) ->
-  fold_right_sepcon G1 |-- fold_right_sepcon L1 * F.
+  (fold_right_sepcon G2 ⊢ fold_right_sepcon L2 ∗ F) ->
+  fold_right_sepcon G1 ⊢ fold_right_sepcon L1 ∗ F.
 Proof.
   intros.
   revert F H0; induction H; intros.
   + auto.
   + apply IHsyntactic_cancel in H1.
     simpl.
-    rewrite sepcon_assoc.
-    eapply derives_trans; [| apply sepcon_derives; [apply derives_refl | apply H1]].
+    rewrite -bi.sep_assoc.
+    etrans; [| apply bi.sep_mono; [done | apply H1]].
     clear IHsyntactic_cancel H1.
     apply find_nth_preds_Some in H.
     destruct H.
-    eapply derives_trans; [apply delete_nth_SEP; eauto |].
-    apply sepcon_derives; auto.
+    etrans; [apply delete_nth_SEP; eauto |].
+    apply bi.sep_mono; auto.
   + simpl in H1.
-    rewrite (sepcon_comm L0), sepcon_assoc in H1.
-    apply (IHsyntactic_cancel (L0*F0)) in H1.
-    eapply derives_trans; [exact H1 |].
+    rewrite (bi.sep_comm L0) -bi.sep_assoc in H1.
+    apply (IHsyntactic_cancel (L0∗F0)) in H1.
+    etrans; [exact H1 |].
     simpl.
-    rewrite <- sepcon_assoc.
-    apply sepcon_derives; auto.
-    rewrite sepcon_comm; auto.
+    rewrite bi.sep_assoc.
+    apply bi.sep_mono; auto.
+    rewrite bi.sep_comm; auto.
 Qed.
 
 Lemma syntactic_cancel_spec2: forall G1 L1 G2 L2 G3 L3 F,
   syntactic_cancel G1 L1 G2 L2 ->
   syntactic_cancel G2 L2 G3 L3 ->
-  (fold_right_sepcon G3 |-- fold_right_sepcon L3 * F) ->
-  fold_right_sepcon G1 |-- fold_right_sepcon L1 * F.
+  (fold_right_sepcon G3 ⊢ fold_right_sepcon L3 ∗ F) ->
+  fold_right_sepcon G1 ⊢ fold_right_sepcon L1 ∗ F.
 Proof.
   intros.
   eapply syntactic_cancel_spec1; eauto.
@@ -599,76 +667,353 @@ Proof.
 Qed.
 
 Lemma syntactic_cancel_solve3:
-  fold_right_sepcon nil |-- fold_right_sepcon nil.
+  fold_right_sepcon nil ⊢ fold_right_sepcon nil.
 Proof.
   auto.
 Qed.
 
 Lemma syntactic_cancel_spec3: forall G1 L1 G2 L2,
   syntactic_cancel G1 L1 G2 L2 ->
-  (fold_right_sepcon G2 |-- fold_right_sepcon L2) ->
-  fold_right_sepcon G1 |-- fold_right_sepcon L1.
+  (fold_right_sepcon G2 ⊢ fold_right_sepcon L2) ->
+  fold_right_sepcon G1 ⊢ fold_right_sepcon L1.
 Proof.
   intros.
-  rewrite <- (sepcon_emp (fold_right_sepcon L1)).
+  rewrite <- (bi.sep_emp (fold_right_sepcon L1)).
   eapply syntactic_cancel_spec1; eauto.
-  rewrite sepcon_emp; auto.
+  rewrite bi.sep_emp //.
+Qed.
+
+Inductive merge_abnormal_PROP: PROP -> option PROP -> option PROP -> Prop :=
+| merge_abnormal_PROP_None: forall P, merge_abnormal_PROP P None (Some P)
+| merge_abnormal_PROP_TT_Some: forall P, merge_abnormal_PROP True (Some P) (Some P)
+| merge_abnormal_PROP_Some_TT: forall P, merge_abnormal_PROP P (Some True) (Some P).
+
+Inductive fold_abnormal_PROP: list PROP -> list PROP -> option PROP -> Prop :=
+| fold_abnormal_PROP_nil:
+    fold_abnormal_PROP nil nil None
+| fold_abnormal_PROP_TT: forall R res R' res',
+    fold_abnormal_PROP R R' res ->
+    merge_abnormal_PROP True res res' ->
+    fold_abnormal_PROP (True :: R) R' res'
+| fold_abnormal_PROP_fold: forall F R res R' res',
+    fold_abnormal_PROP R R' res ->
+    merge_abnormal_PROP (fold_right_sepcon F) res res' ->
+    fold_abnormal_PROP ((fold_right_sepcon F) :: R) R' res'
+| fold_abnormal_PROP_normal: forall P R R' res,
+    fold_abnormal_PROP R R' res ->
+    fold_abnormal_PROP (P :: R) (P :: R') res.
+
+Definition Some_or_emp (res: option PROP) := match res with | Some P => P | _ => emp end.
+
+Lemma merge_abnormal_PROP_spec: forall P res res',
+  merge_abnormal_PROP P res res' ->
+  Some_or_emp res' ⊢ P ∗ Some_or_emp res.
+Proof.
+  intros.
+  inv H; simpl.
+  + rewrite bi.sep_emp; auto.
+  + apply bi.True_sep_2.
+  + apply bi.sep_True_2.
+Qed.
+
+Lemma fold_abnormal_PROP_spec: forall R R' res,
+  fold_abnormal_PROP R R' res ->
+  fold_right_sepcon R' ∗ Some_or_emp res ⊢ fold_right_sepcon R.
+Proof.
+  intros.
+  induction H; simpl.
+  + rewrite bi.emp_sep; auto.
+  + apply merge_abnormal_PROP_spec in H0.
+    etrans; [apply bi.sep_mono; [done | apply H0] |].
+    rewrite bi.sep_assoc.
+    rewrite (bi.sep_comm _ True).
+    rewrite -bi.sep_assoc.
+    apply bi.sep_mono; auto.
+  + apply merge_abnormal_PROP_spec in H0.
+    etrans; [apply bi.sep_mono; [done | apply H0] |].
+    rewrite bi.sep_assoc.
+    rewrite (bi.sep_comm _ (fold_right_sepcon F)).
+    rewrite -bi.sep_assoc.
+    apply bi.sep_mono; auto.
+  + rewrite -bi.sep_assoc.
+    apply bi.sep_mono; auto.
+Qed.
+
+Inductive construct_fold_right_sepcon_rec: PROP -> list PROP -> list PROP -> Prop :=
+| construct_fold_right_sepcon_rec_sepcon: forall P Q R R' R'',
+    construct_fold_right_sepcon_rec Q R R' ->
+    construct_fold_right_sepcon_rec P R' R'' ->
+    construct_fold_right_sepcon_rec (P ∗ Q) R R''
+| construct_fold_right_sepcon_rec_emp: forall R,
+    construct_fold_right_sepcon_rec emp R R
+| construct_fold_right_sepcon_rec_single: forall P R,
+    construct_fold_right_sepcon_rec P R (P :: R).
+
+Local Unset Elimination Schemes. (* ensure that we avoid name collision with the above *)
+Inductive construct_fold_right_sepcon: PROP -> list PROP-> Prop :=
+| construct_fold_right_sepcon_constr: forall P R,
+    construct_fold_right_sepcon_rec P nil R ->
+    construct_fold_right_sepcon P R.
+Scheme Minimality for construct_fold_right_sepcon Sort Prop.
+Local Set Elimination Schemes.
+
+Lemma construct_fold_right_sepcon_spec: forall P R,
+  construct_fold_right_sepcon P R ->
+  fold_right_sepcon R ⊣⊢ P.
+Proof.
+  intros.
+  destruct H.
+  rename R into R'.
+  transitivity (fold_right_sepcon nil ∗ P).
+  2:{
+    simpl.
+    rewrite !bi.emp_sep.
+    auto.
+  }
+  forget (@nil PROP) as R.
+  induction H.
+  + etransitivity; [eassumption |].
+    transitivity ((fold_right_sepcon R ∗ Q) ∗ P); [f_equiv; eassumption |].
+    clear.
+    rewrite (bi.sep_comm P).
+    rewrite -!bi.sep_assoc; auto.
+  + rewrite bi.sep_emp; auto.
+  + simpl.
+    rewrite (bi.sep_comm _ P).
+    auto.
+Qed.
+
+Definition before_symbol_cancel (P Q: list PROP) (res: option PROP): Prop :=
+  match res with
+  | Some R => fold_right_sepcon P ⊢ fold_right_sepcon Q ∗ R
+  | None => fold_right_sepcon P ⊢ fold_right_sepcon Q
+  end.
+
+Lemma symbolic_cancel_setup: forall P P' Q Q' Q'' Qr,
+  construct_fold_right_sepcon P P' ->
+  construct_fold_right_sepcon Q Q' ->
+  fold_abnormal_PROP Q' Q'' Qr ->
+  before_symbol_cancel P' Q'' Qr ->
+  P ⊢ Q.
+Proof.
+  intros.
+  apply construct_fold_right_sepcon_spec in H.
+  apply construct_fold_right_sepcon_spec in H0.
+  apply fold_abnormal_PROP_spec in H1.
+  rewrite <- H, <- H0.
+  etrans; [| exact H1].
+  destruct Qr; auto.
+  rewrite bi.sep_emp //.
+Qed.
+
+(*
+
+Export ListNotations.
+
+Goal forall A B C D E F G H I J K L: PROP,
+  A * B * (C * D) * (E * F * (G * H)) * (I * J * K * L) *
+  A * B * (C * D) * (E * F * (G * H)) * (I * J * K * L) ⊢
+  (I * J * (D * K) * L) * A * B * (C * H) * (E * F * G) *
+  (I * J * (D * K) * L) * A * B * (C * H) * (E * F * G).
+Proof.
+  intros.
+  Time
+  do 4
+  match goal with
+  | |- ?P => assert (P /\ P /\ P); [| tauto]; split; [| split]
+  end;
+  (rewrite -?bi.sep_assoc;
+  repeat match goal with |- ?A * _ ⊢ ?B * _ => 
+     constr_eq A B;  simple apply (cancel_left A)
+  end;
+  match goal with |- ?P ⊢ _ => qcancel P end;
+  repeat first [rewrite bi.emp_sep | rewrite bi.sep_emp];
+  try match goal with |- ?A ⊢ ?B => 
+       constr_eq A B; simple apply (entails_refl A)
+  end;
+  match goal with |- ?P ⊢ _ =>
+   (* The "emp" is a marker to notice when one complete pass has been made *)
+   rewrite <- (bi.emp_sep P)
+  end;
+  repeat rewrite bi.sep_assoc;
+  repeat match goal with
+    | |- sepcon _ emp ⊢ _ => fail 1
+    | |- sepcon _ TT ⊢ _ => pull_left (@TT PROP _)
+    | |- sepcon _ ?P' ⊢ _ => first [ cancel2 | pull_left P' ]
+   end;
+  repeat first [rewrite bi.emp_sep | rewrite bi.sep_emp];
+  pull_left (@TT PROP _);
+  first [ simpl; apply entails_refl'; solve [careful_unify]
+            (* this is NOT a _complete_ tactic;
+                 for example, "simple apply entails_refl" would be more complete.  But that
+                 tactic can sometimes take minutes to discover that something doesn't unify;
+                 what I have here is a compromise between reliable speed, and (in)completeness.
+               *)
+          | apply bi.True_intro
+          | apply @bi.sep_True_2; solve [auto with nocore typeclass_instances]
+          | apply @bi.True_sep_2; solve [auto with nocore typeclass_instances]
+          | cancel_frame
+          | idtac
+          ]).
+
+
+  cancel. (* New cancel: 8.983 9.199 8.599 *)
+          (* Old cancel: 133.919 133.224 138.729 *)
+Abort
+
+
+
+
+Goal forall A B C D: PROP,
+  A * B * (C * A) * B ⊢ B * (A * A) * TT.
+Proof.
+  intros.
+  Time
+  do 4
+  match goal with
+  | |- ?P => assert (P /\ P /\ P); [| tauto]; split; [| split]
+  end;
+(* cancel. (* 4.323 4.275 3.887 3.763 3.684 3.66 3.6 3.534 3.616 3.6 3.591 3.606 *) *)
+(*  new_cancel. (* 0.615 0.656 0.655 0.653 0.687 *) *)
+
+Goal forall A B C D: PROP,
+  A * B * (C * fold_right_sepcon [A; B] * A) * B ⊢ B * (A * A) * fold_right_sepcon [A; B].
+Proof.
+  intros.
+  cancel.
+
+Goal forall A B C D: PROP,
+  A * B * (C * A) * B ⊢ B * TT * (A * A).
+Proof.
+  intros.
+  new_cancel.
+
+Goal forall A B C D: PROP, exists F': list PROP,
+  let F := F' in
+  A * B * (C * A) * B ⊢ B * (A * A) * fold_right_sepcon F.
+Proof.
+  intros; eexists; intros.
+  new_cancel.
+
+Goal forall A B C D: PROP,
+  A * B * (C * A) * B ⊢ B * (A * D).
+Proof.
+  intros.
+  new_cancel.
+
+
+Goal forall A B C D: PROP,
+  fold_right_sepcon [A; B; C; A; B] ⊢ fold_right_sepcon [B; A; D].
+Proof.
+  intros.
+  cancel_for_normal.
+
+Goal forall A B C D: PROP,
+  fold_right_sepcon [A; B; C; A; B] ⊢ fold_right_sepcon [B; A] * TT.
+Proof.
+  intros.
+  cancel_for_TT.
+
+Goal forall A B C D: PROP, exists F: list PROP,
+  fold_right_sepcon [A; B; C; A; B] ⊢ fold_right_sepcon [B; A] * fold_right_sepcon F.
+Proof.
+  intros.
+  eexists.
+  cancel_for_evar_frame.
+*)
+
+Lemma wand_refl_cancel_right:
+  forall (P: PROP), emp ⊢ P -∗ P.
+Proof.
+  iIntros; done.
+Qed.
+
+Lemma cancel_emp_wand:
+  forall P Q R: PROP,
+    (P ⊢ Q) ->
+    P ⊢ Q ∗ (R -∗ R).
+Proof.
+  intros ??? ->.
+  iIntros "$ $".
+Qed.
+
+Lemma allp_instantiate:
+   forall {B} (P : B -> PROP) (x : B),
+       (∀ y : B, P y) ⊢ P x.
+Proof.
+  intros; apply bi.forall_elim.
 Qed.
 
+(* these two lemmas work better with new sep_apply and sep_eapply *)
+Lemma allp_instantiate': forall (B : Type) (P : B -> PROP) (x : B),
+  bi_forall P ⊢ P x.
+Proof. intros. apply allp_instantiate. Qed.
+
+Lemma wand_frame_elim'': forall (P Q : PROP),
+  (P -∗ Q) ∗ P ⊢ Q.
+Proof. apply bi.wand_elim_l. Qed.
+
+Lemma eq_equiv : forall (A B : PROP), A = B -> A ⊣⊢ B.
+Proof.
+  by intros ?? ->.
+Qed.
+
+End PROP.
+
 Ltac local_cancel_in_syntactic_cancel unify_tac :=
   cbv beta;
-  match goal with |- ?A |-- ?B => 
-    solve [ constr_eq A B; simple apply (derives_refl A)
+  match goal with |- ?A ⊢ ?B => 
+    solve [ constr_eq A B; simple apply (entails_refl A)
           | tryif first [has_evar A | has_evar B] then fail else auto with nocore cancel
-          | apply derives_refl'; unify_tac ]
+          | apply entails_refl'; unify_tac ]
   end.
 
 Ltac syntactic_cancel local_tac :=
   repeat first
-         [ simple apply syntactic_cancel_nil
-         | simple apply syntactic_cancel_cons;
+         [ (*simple*) apply syntactic_cancel_nil
+         | (*simple*) apply syntactic_cancel_cons;
            [ find_nth local_tac
            | cbv iota; unfold delete_nth; cbv zeta iota
            ]
          ].
 
-(* To solve: Frame := ?Frame |- fold_right_sepcon G |-- fold_right_sepcon L * fold_right_sepcon Frame *)
+(* To solve: Frame := ?Frame |- fold_right_sepcon G ⊢ fold_right_sepcon L * fold_right_sepcon Frame *)
 Ltac cancel_for_evar_frame' local_tac :=
   eapply syntactic_cancel_spec1;
   [ syntactic_cancel local_tac
   | cbv iota; cbv zeta beta;
     first [ match goal with
-            | |- _ |-- _ * fold_right_sepcon ?F => try unfold F
+            | |- _ ⊢ _ ∗ fold_right_sepcon ?F => try unfold F
             end;
             simple apply syntactic_cancel_solve1
           | match goal with
-            | |- fold_right_sepcon ?A |-- fold_right_sepcon ?B * ?C =>
+            | |- fold_right_sepcon ?A ⊢ fold_right_sepcon ?B ∗ ?C =>
                   let a := fresh in let b := fresh in let c := fresh in 
                   pose (a:=A); pose (b:=B); pose (c:=C);
-                  change (fold_right_sepcon a |-- fold_right_sepcon b * c);
-                  rewrite <- fold_left_sepconx_eq;
+                  change (fold_right_sepcon a ⊢ fold_right_sepcon b ∗ c);
+                  rewrite <- !fold_right_sepconx_eq;
                   subst a b c
 (*                  rewrite <- (fold_left_sepconx_eq A), <- (fold_left_sepconx_eq B) *)
             end;
-            unfold fold_left_sepconx; cbv iota beta ]
+            unfold fold_right_sepconx; cbv iota beta ]
   ].
 
-(* To solve: |- fold_right_sepcon G |-- fold_right_sepcon L * TT *)
+(* To solve: |- fold_right_sepcon G ⊢ fold_right_sepcon L * TT *)
 Ltac cancel_for_TT local_tac :=
   eapply syntactic_cancel_spec1;
   [ syntactic_cancel local_tac
   | cbv iota; cbv zeta beta;
     first [ simple apply syntactic_cancel_solve2
           | match goal with
-            | |- fold_right_sepcon ?A |-- fold_right_sepcon ?B * ?C =>
+            | |- fold_right_sepcon ?A ⊢ fold_right_sepcon ?B ∗ ?C =>
                   let a := fresh in let b := fresh in let c := fresh in 
                   pose (a:=A); pose (b:=B); pose (c:=C);
-                  change (fold_right_sepcon a |-- fold_right_sepcon b * c);
-                  rewrite <- fold_left_sepconx_eq;
+                  change (fold_right_sepcon a ⊢ fold_right_sepcon b ∗ c);
+                  rewrite <- !fold_right_sepconx_eq;
                   subst a b c
 (* rewrite <- (fold_left_sepconx_eq A), <- (fold_left_sepconx_eq B) *)
             end;
-            unfold fold_left_sepconx; cbv iota beta ]
+            unfold fold_right_sepconx; cbv iota beta ]
   ].
 
 Ltac cancel_for_normal local_tac :=
@@ -677,163 +1022,39 @@ Ltac cancel_for_normal local_tac :=
   | cbv iota; cbv zeta beta;
     first [ simple apply syntactic_cancel_solve3
           | match goal with
-            | |- fold_right_sepcon ?A |-- fold_right_sepcon ?B =>
+            | |- fold_right_sepcon ?A ⊢ fold_right_sepcon ?B =>
                   let a := fresh in let b := fresh in
                   pose (a:=A); pose (b:=B);
-                  change (fold_right_sepcon a |-- fold_right_sepcon b);
-                  rewrite <- fold_left_sepconx_eq;
+                  change (fold_right_sepcon a ⊢ fold_right_sepcon b);
+                  rewrite <- !fold_right_sepconx_eq;
                   subst a b
 (*  rewrite <- (fold_left_sepconx_eq A), <- (fold_left_sepconx_eq B) *)
             end;
-            unfold fold_left_sepconx; cbv iota beta ]
+            unfold fold_right_sepconx; cbv iota beta ]
   ].
 
 
 (* return Some true exists TT, return Some false if exists fold_right_sepcon. *)
 (* unused?
-Ltac Check_normal_mpred_list_rec L :=
+Ltac Check_normal_PROP_list_rec L :=
   match L with
   | nil => constr:(@None bool)
   | cons TT _ => constr:(Some true)
   | cons (fold_right_sepcon _) _ => constr:(Some false)
-  | cons _ ?L0 => Check_normal_mpred_list_rec L0
+  | cons _ ?L0 => Check_normal_PROP_list_rec L0
   end.
 
 Ltac Check_pre_no_TT L :=
-  let res := Check_normal_mpred_list_rec L in
+  let res := Check_normal_PROP_list_rec L in
   match res with
   | Some true => fail 1000 "No TT should appear in the SEP clause of a funcspec's precondition"
   | _ => idtac
   end.
 *)
 
-Inductive merge_abnormal_mpred: mpred -> option mpred -> option mpred -> Prop :=
-| merge_abnormal_mpred_None: forall P, merge_abnormal_mpred P None (Some P)
-| merge_abnormal_mpred_TT_Some: forall P, merge_abnormal_mpred TT (Some P) (Some P)
-| merge_abnormal_mpred_Some_TT: forall P, merge_abnormal_mpred P (Some TT) (Some P).
-
-Inductive fold_abnormal_mpred: list mpred -> list mpred -> option mpred -> Prop :=
-| fold_abnormal_mpred_nil:
-    fold_abnormal_mpred nil nil None
-| fold_abnormal_mpred_TT: forall R res R' res',
-    fold_abnormal_mpred R R' res ->
-    merge_abnormal_mpred TT res res' ->
-    fold_abnormal_mpred (TT :: R) R' res'
-| fold_abnormal_mpred_fold: forall F R res R' res',
-    fold_abnormal_mpred R R' res ->
-    merge_abnormal_mpred (fold_right_sepcon F) res res' ->
-    fold_abnormal_mpred ((fold_right_sepcon F) :: R) R' res'
-| fold_abnormal_mpred_normal: forall P R R' res,
-    fold_abnormal_mpred R R' res ->
-    fold_abnormal_mpred (P :: R) (P :: R') res.
-
-Definition Some_or_emp (res: option mpred) := match res with | Some P => P | _ => emp end.
-
-Lemma merge_abnormal_mpred_spec: forall P res res',
-  merge_abnormal_mpred P res res' ->
-  Some_or_emp res' |-- P * Some_or_emp res.
-Proof.
-  intros.
-  inv H; simpl.
-  + rewrite sepcon_emp; auto.
-  + apply TT_sepcon.
-  + apply sepcon_TT.
-Qed.
-
-Lemma fold_abnormal_mpred_spec: forall R R' res,
-  fold_abnormal_mpred R R' res ->
-  fold_right_sepcon R' * Some_or_emp res |-- fold_right_sepcon R.
-Proof.
-  intros.
-  induction H; simpl.
-  + rewrite emp_sepcon; auto.
-  + apply merge_abnormal_mpred_spec in H0.
-    eapply derives_trans; [apply sepcon_derives; [apply derives_refl | apply H0] |].
-    rewrite <- sepcon_assoc.
-    rewrite (sepcon_comm _ TT).
-    rewrite sepcon_assoc.
-    apply sepcon_derives; auto.
-  + apply merge_abnormal_mpred_spec in H0.
-    eapply derives_trans; [apply sepcon_derives; [apply derives_refl | apply H0] |].
-    rewrite <- sepcon_assoc.
-    rewrite (sepcon_comm _ (fold_right_sepcon F)).
-    rewrite sepcon_assoc.
-    apply sepcon_derives; auto.
-  + rewrite sepcon_assoc.
-    apply sepcon_derives; auto.
-Qed.
-
-Inductive construct_fold_right_sepcon_rec: mpred -> list mpred -> list mpred -> Prop :=
-| construct_fold_right_sepcon_rec_sepcon: forall P Q R R' R'',
-    construct_fold_right_sepcon_rec Q R R' ->
-    construct_fold_right_sepcon_rec P R' R'' ->
-    construct_fold_right_sepcon_rec (P * Q) R R''
-| construct_fold_right_sepcon_rec_emp: forall R,
-    construct_fold_right_sepcon_rec emp R R
-| construct_fold_right_sepcon_rec_single: forall P R,
-    construct_fold_right_sepcon_rec P R (P :: R).
-
-Local Unset Elimination Schemes. (* ensure that we avoid name collision with the above *)
-Inductive construct_fold_right_sepcon: mpred -> list mpred-> Prop :=
-| construct_fold_right_sepcon_constr: forall P R,
-    construct_fold_right_sepcon_rec P nil R ->
-    construct_fold_right_sepcon P R.
-Scheme Minimality for construct_fold_right_sepcon Sort Prop.
-Local Set Elimination Schemes.
-
-Lemma construct_fold_right_sepcon_spec: forall P R,
-  construct_fold_right_sepcon P R ->
-  fold_right_sepcon R = P.
-Proof.
-  intros.
-  destruct H.
-  rename R into R'.
-  transitivity (fold_right_sepcon nil * P).
-  2:{
-    simpl.
-    rewrite !emp_sepcon.
-    auto.
-  }
-  forget (@nil mpred) as R.
-  induction H.
-  + etransitivity; [eassumption |].
-    transitivity (fold_right_sepcon R * Q * P); [f_equal; eassumption |].
-    clear.
-    rewrite (sepcon_comm P).
-    rewrite !sepcon_assoc; auto.
-  + rewrite sepcon_emp; auto.
-  + simpl.
-    rewrite (sepcon_comm _ P).
-    auto.
-Qed.
-
-Definition before_symbol_cancel (P Q: list mpred) (res: option mpred): Prop :=
-  match res with
-  | Some R => fold_right_sepcon P |-- fold_right_sepcon Q * R
-  | None => fold_right_sepcon P |-- fold_right_sepcon Q
-  end.
-
-Lemma symbolic_cancel_setup: forall P P' Q Q' Q'' Qr,
-  construct_fold_right_sepcon P P' ->
-  construct_fold_right_sepcon Q Q' ->
-  fold_abnormal_mpred Q' Q'' Qr ->
-  before_symbol_cancel P' Q'' Qr ->
-  P |-- Q.
-Proof.
-  intros.
-  apply construct_fold_right_sepcon_spec in H.
-  apply construct_fold_right_sepcon_spec in H0.
-  apply fold_abnormal_mpred_spec in H1.
-  rewrite <- H, <- H0.
-  eapply derives_trans; [| exact H1].
-  destruct Qr; auto.
-  simpl in H2 |- *.
-  rewrite sepcon_emp; auto.
-Qed.
-
 Ltac construct_fold_right_sepcon_rec :=
   match goal with
-  | |- construct_fold_right_sepcon_rec (sepcon _ _) _ _ =>
+  | |- construct_fold_right_sepcon_rec (bi_sep _ _) _ _ =>
          eapply construct_fold_right_sepcon_rec_sepcon;
          [construct_fold_right_sepcon_rec | construct_fold_right_sepcon_rec]
   | |- construct_fold_right_sepcon_rec ?A ?X ?Y =>
@@ -845,11 +1066,11 @@ Ltac construct_fold_right_sepcon_rec :=
          apply construct_fold_right_sepcon_rec_single
   end.
 
-Ltac merge_abnormal_mpred :=
+Ltac merge_abnormal_PROP :=
   first
-  [ simple apply merge_abnormal_mpred_None
-  | simple apply merge_abnormal_mpred_TT_Some
-  | simple apply merge_abnormal_mpred_Some_TT
+  [ simple apply merge_abnormal_PROP_None
+  | simple apply merge_abnormal_PROP_TT_Some
+  | simple apply merge_abnormal_PROP_Some_TT
   | fail 1000 "There should not be two fold_right_sepcon in the right side."
   ].
 
@@ -859,30 +1080,30 @@ Ltac construct_fold_right_sepcon :=
 
 Ltac is_evar_def F := try first [is_var F; unfold F; fail 1 | fail 2 F "is not evar definition"].
 
-Ltac fold_abnormal_mpred :=
+Ltac fold_abnormal_PROP :=
   match goal with
-  | |- fold_abnormal_mpred nil _ _ =>
-         simple apply fold_abnormal_mpred_nil
-  | |- fold_abnormal_mpred (?P :: _) _ _ =>
+  | |- fold_abnormal_PROP nil _ _ =>
+         apply fold_abnormal_PROP_nil
+  | |- fold_abnormal_PROP (?P :: _) _ _ =>
          match P with
-         | TT => simple eapply fold_abnormal_mpred_TT; [fold_abnormal_mpred | merge_abnormal_mpred]
-         | prop True => simple eapply fold_abnormal_mpred_TT; [fold_abnormal_mpred | merge_abnormal_mpred]
+         | True%I => eapply fold_abnormal_PROP_TT; [fold_abnormal_PROP | merge_abnormal_PROP]
+         | ⌜True⌝ => eapply fold_abnormal_PROP_TT; [fold_abnormal_PROP | merge_abnormal_PROP]
          | fold_right_sepcon ?F =>
               is_evar_def F;
-              simple eapply fold_abnormal_mpred_fold; [fold_abnormal_mpred | merge_abnormal_mpred]
-         | _ => simple apply fold_abnormal_mpred_normal; fold_abnormal_mpred
+              eapply fold_abnormal_PROP_fold; [fold_abnormal_PROP | merge_abnormal_PROP]
+         | _ => apply fold_abnormal_PROP_normal; fold_abnormal_PROP
          end
   end.
 
 Ltac new_cancel local_tac :=
   match goal with
-  | |- @derives mpred Nveric _ _ => idtac
-  | _ => fail "Tactic cancel can only handle proof goals with form _ |-- _ (unlifted version)."
+  | |- _ ⊢ _ => idtac
+  | _ => fail "Tactic cancel can only handle proof goals with form _ ⊢ _ (unlifted version)."
   end;
   eapply symbolic_cancel_setup;
   [ construct_fold_right_sepcon
   | construct_fold_right_sepcon
-  | fold_abnormal_mpred
+  | fold_abnormal_PROP
   | match goal with
     | |- before_symbol_cancel _ _ None =>
            cbv iota beta delta [before_symbol_cancel];
@@ -890,10 +1111,7 @@ Ltac new_cancel local_tac :=
     | |- before_symbol_cancel _ _ (Some (fold_right_sepcon _)) =>
            cbv iota beta delta [before_symbol_cancel];
            cancel_for_evar_frame' local_tac
-    | |- before_symbol_cancel _ _ (Some TT) =>
-           cbv iota beta delta [before_symbol_cancel];
-           cancel_for_TT local_tac
-    | |- before_symbol_cancel _ _ (Some (prop True)) =>
+    | |- before_symbol_cancel _ _ (Some True) =>
            cbv iota beta delta [before_symbol_cancel];
            cancel_for_TT local_tac
     end
@@ -905,10 +1123,10 @@ Ltac cancel_unify_tac :=
 
 Ltac cancel_local_tac :=
   cbv beta;
-  match goal with |- ?A |-- ?B =>
-    solve [ constr_eq A B; simple apply (derives_refl A)
+  match goal with |- ?A ⊢ ?B =>
+    solve [ constr_eq A B; simple apply (entails_refl A)
           | auto with nocore cancel
-          | apply derives_refl'; cancel_unify_tac]
+          | apply entails_refl'; cancel_unify_tac]
   end.
 
 Ltac cancel ::= new_cancel cancel_local_tac.
@@ -943,144 +1161,28 @@ Ltac info_ecancel_local_tac :=
 
 Ltac info_ecancel := info_cancel; new_cancel info_ecancel_local_tac.
 
-(*
-
-Export ListNotations.
-
-Goal forall A B C D E F G H I J K L: mpred,
-  A * B * (C * D) * (E * F * (G * H)) * (I * J * K * L) *
-  A * B * (C * D) * (E * F * (G * H)) * (I * J * K * L) |--
-  (I * J * (D * K) * L) * A * B * (C * H) * (E * F * G) *
-  (I * J * (D * K) * L) * A * B * (C * H) * (E * F * G).
-Proof.
-  intros.
-  Time
-  do 4
-  match goal with
-  | |- ?P => assert (P /\ P /\ P); [| tauto]; split; [| split]
-  end;
-  (rewrite ?sepcon_assoc;
-  repeat match goal with |- ?A * _ |-- ?B * _ => 
-     constr_eq A B;  simple apply (cancel_left A)
-  end;
-  match goal with |- ?P |-- _ => qcancel P end;
-  repeat first [rewrite emp_sepcon | rewrite sepcon_emp];
-  try match goal with |- ?A |-- ?B => 
-       constr_eq A B; simple apply (derives_refl A)
-  end;
-  match goal with |- ?P |-- _ =>
-   (* The "emp" is a marker to notice when one complete pass has been made *)
-   rewrite <- (emp_sepcon P)
-  end;
-  repeat rewrite <- sepcon_assoc;
-  repeat match goal with
-    | |- sepcon _ emp |-- _ => fail 1
-    | |- sepcon _ TT |-- _ => pull_left (@TT mpred _)
-    | |- sepcon _ ?P' |-- _ => first [ cancel2 | pull_left P' ]
-   end;
-  repeat first [rewrite emp_sepcon | rewrite sepcon_emp];
-  pull_left (@TT mpred _);
-  first [ simpl; apply derives_refl'; solve [careful_unify]
-            (* this is NOT a _complete_ tactic;
-                 for example, "simple apply derives_refl" would be more complete.  But that
-                 tactic can sometimes take minutes to discover that something doesn't unify;
-                 what I have here is a compromise between reliable speed, and (in)completeness.
-               *)
-          | apply TT_right
-          | apply @sepcon_TT; solve [auto with nocore typeclass_instances]
-          | apply @TT_sepcon; solve [auto with nocore typeclass_instances]
-          | cancel_frame
-          | idtac
-          ]).
-
-
-  cancel. (* New cancel: 8.983 9.199 8.599 *)
-          (* Old cancel: 133.919 133.224 138.729 *)
-Abort
-
-
-
-
-Goal forall A B C D: mpred,
-  A * B * (C * A) * B |-- B * (A * A) * TT.
-Proof.
-  intros.
-  Time
-  do 4
-  match goal with
-  | |- ?P => assert (P /\ P /\ P); [| tauto]; split; [| split]
-  end;
-(* cancel. (* 4.323 4.275 3.887 3.763 3.684 3.66 3.6 3.534 3.616 3.6 3.591 3.606 *) *)
-(*  new_cancel. (* 0.615 0.656 0.655 0.653 0.687 *) *)
-
-Goal forall A B C D: mpred,
-  A * B * (C * fold_right_sepcon [A; B] * A) * B |-- B * (A * A) * fold_right_sepcon [A; B].
-Proof.
-  intros.
-  cancel.
-
-Goal forall A B C D: mpred,
-  A * B * (C * A) * B |-- B * TT * (A * A).
-Proof.
-  intros.
-  new_cancel.
-
-Goal forall A B C D: mpred, exists F': list mpred,
-  let F := F' in
-  A * B * (C * A) * B |-- B * (A * A) * fold_right_sepcon F.
-Proof.
-  intros; eexists; intros.
-  new_cancel.
-
-Goal forall A B C D: mpred,
-  A * B * (C * A) * B |-- B * (A * D).
-Proof.
-  intros.
-  new_cancel.
-
-
-Goal forall A B C D: mpred,
-  fold_right_sepcon [A; B; C; A; B] |-- fold_right_sepcon [B; A; D].
-Proof.
-  intros.
-  cancel_for_normal.
-
-Goal forall A B C D: mpred,
-  fold_right_sepcon [A; B; C; A; B] |-- fold_right_sepcon [B; A] * TT.
-Proof.
-  intros.
-  cancel_for_TT.
-
-Goal forall A B C D: mpred, exists F: list mpred,
-  fold_right_sepcon [A; B; C; A; B] |-- fold_right_sepcon [B; A] * fold_right_sepcon F.
-Proof.
-  intros.
-  eexists.
-  cancel_for_evar_frame.
-*)
-
 Ltac apply_find_core X :=
  match X with
  | ?U -> ?V => match type of U with Prop => apply_find_core V end
- | @derives mpred _ _ _ => constr:(X)
- | @eq mpred ?A ?B => constr:(@derives mpred A B)
+ | _ ⊢ _ => constr:(X)
+ | ?A = ?B => constr:(A ⊢ B)
  end.
 
-Lemma adjust_sep_apply:  forall (Q: mpred) (P: Prop),
-   (Q |-- !! P) ->
-   Q |-- !! P && Q.
-Proof. intros. apply andp_right; auto. Qed.
+Lemma adjust_sep_apply:  forall {PROP : bi} (Q: PROP) (P: Prop),
+   (Q ⊢ ⌜P⌝) ->
+   Q ⊢ ⌜P⌝ ∧ Q.
+Proof. intros. apply bi.and_intro; auto. Qed.
 
 Ltac adjust_sep_apply H :=
  match type of H with 
- | _ |-- !! _ => constr:(adjust_sep_apply _ _ H)
+ | _ ⊢ ⌜_⌝ => constr:(adjust_sep_apply _ _ H)
  | _ => H
  end.
 
 Ltac adjust2_sep_apply H :=
  let x := adjust_sep_apply H in
  match type of x with
- | @eq mpred _ _ => constr:(derives_refl' _ _ x)
+ | _ = _ => constr:(entails_refl' _ _ x)
  | _ => x
  end.
 
@@ -1088,15 +1190,15 @@ Ltac cancel_for_sep_apply := ecancel.
 
 Ltac sep_apply_aux2 H' := 
 match type of H' with ?TH =>
-     match apply_find_core TH with  ?C |-- ?D =>
-      let frame := fresh "frame" in evar (frame: list mpred);
-       apply derives_trans with (C * fold_right_sepcon frame);
+     match apply_find_core TH with @bi_entails ?PROP ?C ?D =>
+      let frame := fresh "frame" in evar (frame: list PROP);
+       trans (C ∗ fold_right_sepcon frame);
              [ solve [cancel_for_sep_apply]
-             | eapply derives_trans; 
-                [apply sepcon_derives; [clear frame; apply H' | apply derives_refl] 
+             | etrans; 
+                [apply bi.sep_mono; [clear frame; apply H' | apply entails_refl] 
                 |  let x := fresh "x" in set (x := fold_right_sepcon frame);
                   subst frame; unfold fold_right_sepcon in x; subst x; 
-                  rewrite ?sepcon_emp
+                  rewrite ?bi.sep_emp
                 ]
              ]
      end
@@ -1108,15 +1210,15 @@ Ltac head_of_type_of H :=
 Ltac sep_apply_aux1 H := 
  let B := head_of_type_of H in
  lazymatch B with
- | ?A |-- _ =>
+ | ?A ⊢ _ =>
    lazymatch A with
-   | context [!! ?P && _] =>
+   | context [⌜?P⌝ ∧ _] =>
       let H' := fresh in
       assert (H' := H);
-      rewrite ?(andp_assoc (!! P)) in H';
+      rewrite ?(bi.and_assoc (⌜P⌝)) in H';
       let H := fresh in 
       assert (H:P);
-       [ clear H' | rewrite (prop_true_andp P) in H' by apply H; clear H;
+       [ clear H' | rewrite -> (prop_true_andp P) in H' by apply H; clear H;
            sep_apply_aux1 H'; clear H' ]
    | _ => sep_apply_aux2 H
     end
@@ -1125,7 +1227,7 @@ Ltac sep_apply_aux1 H :=
 Ltac sep_apply_aux0 H :=
  let B := head_of_type_of H in
  lazymatch B with
- | ?A ?D |-- _ =>
+ | ?A ?D ⊢ _ =>
     tryif (match type of D with ?DT => constr_eq DT globals end)
    then
     (tryif (unfold A in H) then sep_apply_aux1 H
@@ -1138,7 +1240,7 @@ Ltac sep_apply_aux0 H :=
  end.
 
 Ltac sep_apply_in_entailment H :=
-    match goal with |- _ |-- _ =>
+    match goal with |- _ ⊢ _ =>
      let H' := adjust2_sep_apply H in
          sep_apply_aux0 H'
     end.
@@ -1177,37 +1279,19 @@ Ltac new_sep_apply_in_entailment originalH evar_tac prop_tac :=
           ltac:(fun x => sep_apply_in_entailment_rec (H x))
           evar_tac
       end
-    | ?A |-- ?B => sep_apply_in_entailment H
+    | ?A ⊢ ?B => sep_apply_in_entailment H
     | ?A = ?B => sep_apply_in_entailment H
     | _ => fail 0 originalH "is not an entailment"
     end
   in
   sep_apply_in_entailment_rec originalH.
 
-Lemma wand_refl_cancel_right:
-  forall {A}{ND: NatDed A} {SL: SepLog A}{CA: ClassicalSep A}
-    (P: A),  emp |-- P -* P.
-Proof.
-intros. apply wand_sepcon_adjoint.
-rewrite emp_sepcon. apply derives_refl.
-Qed.
-
-Lemma cancel_emp_wand:
-  forall P Q R: mpred,
-    (P |-- Q) ->
-    P |-- Q * (R -* R).
-Proof.
-intros. rewrite <- (sepcon_emp P).
-apply sepcon_derives; auto.
-apply wand_refl_cancel_right.
-Qed.
-
 Ltac cancel_wand :=
   repeat
-  match goal with |- _ |-- ?B =>
-    match B with context [?A -* ?A] =>
-    rewrite ?sepcon_assoc;
-    pull_right (A -* A);
+  match goal with |- bi_entails _ ?B =>
+    match B with context [bi_wand ?A ?A] =>
+    rewrite -?bi.sep_assoc;
+    pull_right (bi_wand A A);
     first [apply cancel_emp_wand | apply wand_refl_cancel_right]
     end
   end.
@@ -1233,55 +1317,64 @@ rewrite_strat (topdown hints test888).
 match goal with |- S n = S n => reflexivity end.
 Qed.  (* Yes, this works in Coq 8.7.2 *)
 
+(* In some data-intensive proofs, discriminate can run forever, so here's a safer done
+   for normalize to use. *)
+Ltac safe_done :=
+  solve
+  [ repeat (first
+    [ fast_done
+    | solve [trivial]
+    (* All the tactics below will introduce themselves anyway, or make no sense
+       for goals of product type. So this is a good place for us to do it. *)
+    | progress intros
+    | solve [symmetry; trivial]
+    | solve [apply not_symmetry; trivial]
+(*    | discriminate*)
+    | contradiction
+    | match goal with |- _ /\ _ => split end
+    | match goal with H : (¬_)%type |- _ => case H; clear H; fast_done end ])
+  ].
 
 Ltac normalize1 :=
          match goal with
-            | |- context [@andp ?A (@LiftNatDed ?T ?B ?C) ?D ?E ?F] =>
-                      change (@andp A (@LiftNatDed T B C) D E F) with (D F && E F)
-            | |- context [@later ?A  (@LiftNatDed ?T ?B ?C) (@LiftIndir ?X1 ?X2 ?X3 ?X4 ?X5) ?D ?F] =>
-                   change (@later A  (@LiftNatDed T B C) (@LiftIndir X1 X2 X3 X4 X5) D F)
-                     with (@later B C X5 (D F))
-            | |- context [@sepcon ?A (@LiftNatDed ?B ?C ?D)
-                                                         (@LiftSepLog ?E ?F ?G ?H) ?J ?K ?L] =>
-                   change (@sepcon A (@LiftNatDed B C D) (@LiftSepLog E F G H) J K L)
-                      with (@sepcon C D H (J L) (K L))
-            | |- context [(?P && ?Q) * ?R] => rewrite (corable_andp_sepcon1 P Q R) by (auto with norm)
-            | |- context [?Q * (?P && ?R)] => rewrite (corable_sepcon_andp1 P Q R) by (auto with norm)
-            | |- context [(?Q && ?P) * ?R] => rewrite (corable_andp_sepcon2 P Q R) by (auto with norm)
-            | |- context [?Q * (?R && ?P)] => rewrite (corable_sepcon_andp2 P Q R) by (auto with norm)
-            | |-  derives ?A   ?B => match A with
-                   | FF => apply FF_left
-                   | !! _ => apply derives_extract_prop0
-                   | exp (fun y => _) => apply imp_extract_exp_left; (intro y || intro)
-                   | !! _ && _ => apply derives_extract_prop
-                   | _ && !! _ => apply derives_extract_prop'
-                   | context [ ((!! ?P) && ?Q) && ?R ] => rewrite (andp_assoc (!!P) Q R)
-                   | context [ ?Q && (!! ?P && ?R)] =>
-                                  match Q with !! _ => fail 2 | _ => rewrite (andp_assoc' (!!P) Q R) end
+         (* SEE ISSUE   https://github.com/PrincetonUniversity/VST/issues/773
+            | |- bi_entails(PROP := monPredI _ _) _ _ => let rho := fresh "rho" in split => rho; monPred.unseal
+	  *)
+            | |- context [((⌜?P⌝ ∧ ?Q) ∗ ?R)%I] => rewrite -> (sepcon_andp_prop' Q P R)
+            | |- context [(?P ∗ (⌜?Q⌝ ∧ ?R))%I] => rewrite -> (sepcon_andp_prop P Q R)
+            | |- context [((?Q ∧ ⌜?P⌝) ∗ ?R)%I] => rewrite -> (sepcon_andp_prop2' P Q R)
+            | |- context [(?Q ∗ (?R ∧ ⌜?P⌝))%I] => rewrite -> (sepcon_andp_prop2 Q P R)
+            | |-  bi_entails ?A ?B => match A with
+                   | False => apply bi.False_elim
+                   | ⌜True⌝ => apply bi.pure_intro
+                   | ⌜?P⌝ => tryif (constr_eq P True%type) then fail else apply bi.pure_elim'
+                   | bi_exist (fun y => _) => apply bi.exist_elim; (intro y || intro)
+                   | ⌜_⌝ ∧ _ => apply bi.pure_elim_l
+                   | _ ∧ ⌜_⌝ => apply bi.pure_elim_r
+                   | context [ (⌜?P⌝ ∧ ?Q) ∧ ?R ] => rewrite -(log_normalize.and_assoc (⌜P⌝) Q R)
+                   | context [ ?Q ∧ (⌜?P⌝ ∧ ?R)] =>
+                                  match Q with ⌜_⌝ => fail 2 | _ => rewrite (and_assoc2 (⌜P⌝) Q R) end
                  (* In the next four rules, doing it this way (instead of leaving it to autorewrite)
                     preserves the name of the "y" variable *)
-                   | context [andp (exp (fun y => _)) _] =>
+                   | context [(∃ y, _) ∧ _] =>
                                let BB := fresh "BB" in set (BB:=B); norm_rewrite; unfold BB; clear BB;
-                               apply imp_extract_exp_left; intro y
-                   | context [andp _ (exp (fun y => _))] =>
+                               apply bi.exist_elim; intro y
+                   | context [_ ∧ (∃ y, _)] =>
                                let BB := fresh "BB" in set (BB:=B); norm_rewrite; unfold BB; clear BB;
-                               apply imp_extract_exp_left; intro y
-                   | context [sepcon (exp (fun y => _)) _] =>
+                               apply bi.exist_elim; intro y
+                   | context [(∃ y, _) ∗ _] =>
                                let BB := fresh "BB" in set (BB:=B); norm_rewrite; unfold BB; clear BB;
-                               apply imp_extract_exp_left; intro y
-                   | context [sepcon _ (exp (fun y => _))] =>
+                               apply bi.exist_elim; intro y
+                   | context [_ ∗ (∃ y, _)] =>
                                let BB := fresh "BB" in set (BB:=B); norm_rewrite; unfold BB; clear BB;
-                                apply imp_extract_exp_left; intro y
-                   | _ => simple apply TT_prop_right
-                   | _ => simple apply TT_right
-                   | _ => constr_eq A B; apply derives_refl
+                                apply bi.exist_elim; intro y
+                   | _ => simple apply bi.True_intro
+                   | _ => constr_eq A B; done
                    end
-              | |- _ => solve [auto]
-              | |- _ |-- !! (?x = ?y) && _ =>
-                            (rewrite (prop_true_andp' (x=y))
-                                            by (unfold y; reflexivity); unfold y in *; clear y) ||
-                            (rewrite (prop_true_andp' (x=y))
-                                            by (unfold x; reflexivity); unfold x in *; clear x)
+              | |- _ => first [safe_done | (* by apply bi.pure_mono | *) by apply bi.pure_intro]
+              | |- _ ⊢ ⌜?x = ?y⌝ ∧ _ =>
+                            (apply pure_intro_l; first by (unfold y; reflexivity); unfold y in *; clear y) ||
+                            (apply pure_intro_l; first by (unfold x; reflexivity); unfold x in *; clear x)
               |  |- ?ZZ -> ?YY => match type of ZZ with
                                                | Prop => fancy_intros true || fail 1
                                                | _ => intros _
@@ -1294,43 +1387,12 @@ Ltac normalize1 :=
 Ltac normalize :=
    gather_prop;
    repeat (((repeat simple apply go_lower_lem1'; simple apply go_lower_lem1)
-              || simple apply derives_extract_prop
-              || simple apply derives_extract_prop');
+              || simple apply bi.pure_elim_l
+              || simple apply bi.pure_elim_r);
               fancy_intros true);
    repeat normalize1; try contradiction.
 
-Lemma allp_instantiate:
-   forall {A : Type} {NA : NatDed A} {B : Type} (P : B -> A) (x : B),
-       ALL y : B, P y |-- P x.
-Proof.
-intros. apply allp_left with x. auto.
-Qed.
-
-Ltac allp_left x := 
- match goal with |- ?A |-- _ => match A with context [@allp ?T ?ND ?B ?P] =>
-   sep_apply_in_entailment (@allp_instantiate T ND B P x)
+Ltac allp_left x :=
+ match goal with |- ?A ⊢ _ => match A with context [@bi_forall ?PROP ?B ?P] =>
+   sep_apply_in_entailment (@allp_instantiate PROP B P x)
  end end.
-
-(* these two lemmas work better with new sep_apply and sep_eapply *)
-Lemma allp_instantiate': forall (B : Type) (P : B -> mpred) (x : B),
-  allp P |-- P x.
-Proof. intros. apply allp_instantiate. Qed.
-
-Lemma wand_frame_elim'': forall P Q,
-  (P -* Q) * P |-- Q.
-Proof. intros. rewrite sepcon_comm. apply wand_frame_elim. Qed.
-
-Lemma prop_sepcon: forall {A}{ND: NatDed A}{SL: SepLog A}
-    P Q, !! P * Q = !! P && (TT * Q).
-Proof.
- intros.
- rewrite <- (andp_TT (!! _)), sepcon_andp_prop'. normalize.
-Qed.
-
-Lemma prop_sepcon2: forall {A}{ND: NatDed A}{SL: SepLog A}
-    P Q, Q * !! P = !! P && (TT * Q).
-Proof.
- intros.
- rewrite sepcon_comm. apply prop_sepcon.
-Qed.
-
diff --git a/floyd/simpl_reptype.v b/floyd/simpl_reptype.v
index dc471c5ed9..c6de385f4c 100644
--- a/floyd/simpl_reptype.v
+++ b/floyd/simpl_reptype.v
@@ -1,4 +1,6 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.functional_base.
 Require Import VST.floyd.nested_field_lemmas.
 Require Import VST.floyd.reptype_lemmas.
@@ -8,6 +10,8 @@ Require Import VST.floyd.simple_reify.
 Require Import VST.floyd.aggregate_type.
 Require Import VST.zlist.Zlength_solver.
 
+Local Unset SsrRewrite.
+
 Definition int_signed_or_unsigned (t: type) : int -> Z :=
   match typeconv t with
   | Tint _ Signed _ => Int.signed
@@ -191,7 +195,7 @@ Ltac canon_load_result := default_canon_load_result.
 Definition myfst {A}{B} (x: A*B) : A := match x with (y,z) => y end.
 Definition mysnd {A}{B} (x: A*B) : B := match x with (y,z) => z end.
 
-Definition proj_compact_prod' {A: Type} {F: A -> Type} (a: A) (l: list A) (v: compact_prod (map F l)) (default: F a) (H: forall a b: A, {a = b} + {a <> b}) : F a.
+Definition proj_compact_prod' {A: Type} {F: A -> Type} (a: A) (l: list A) (v: compact_prod (map F l)) (default: F a) (H: forall a b: A, {a = b} + {a <> b } ) : F a.
 Proof.
   destruct l; [exact default |].
   revert a0 v; induction l; intros.
@@ -205,7 +209,7 @@ Proof.
     - exact (IHl a0 (mysnd v)).
 Defined.
 
-Definition upd_compact_prod' {A} {F} (l: list A) (v: compact_prod (map F l)) (a: A) (v0: F a) (H: forall a b: A, {a = b} + {a <> b}) : compact_prod (map F l).
+Definition upd_compact_prod' {A} {F} (l: list A) (v: compact_prod (map F l)) (a: A) (v0: F a) (H: forall a b: A, {a = b} + {a <> b} ) : compact_prod (map F l).
 Proof.
   intros.
   destruct l; [exact v |].
@@ -316,9 +320,9 @@ Ltac solve_load_rule_evaluation :=
 Ltac simplify_casts := 
   cbv beta iota delta [ Cop.cast_int_int  Cop.cast_int_float Cop.cast_float_int  Cop.cast_int_single Cop.cast_single_int
                   Cop.cast_int_long Cop.cast_long_float Cop.cast_long_single Cop.cast_float_long Cop.cast_single_long ];
- rewrite ?sign_ext_inrange 
+ rewrite ->?sign_ext_inrange 
   by (let z := fresh "z" in set (z := two_p (Zpos _ - 1)); compute in z; subst z;
-          rewrite Int.signed_repr by rep_lia;  rep_lia).
+          rewrite ->Int.signed_repr by rep_lia;  rep_lia).
 
 Lemma cons_congr: forall {A} (a a': A) bl bl',
   a=a' -> bl=bl' -> a::bl = a'::bl'.
diff --git a/floyd/step.v b/floyd/step.v
index 4a7cd2dd4f..c60cf208dd 100644
--- a/floyd/step.v
+++ b/floyd/step.v
@@ -1,4 +1,6 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.functional_base.
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.go_lower.
@@ -36,8 +38,8 @@ Ltac EExists_unify :=
   evar (T:Type); evar (x:T); subst T; 
   Exists x;
   match goal with
-  | |- _ |-- !! ?P && _ => EExists_unify1 x P
-  | |- _ |-- !! ?P => EExists_unify1 x P
+  | |- _ ⊢ ⌜?P⌝ ∧ _ => EExists_unify1 x P
+  | |- _ ⊢ ⌜?P⌝ => EExists_unify1 x P
   end.
 
 Ltac simpl_implicit :=
@@ -54,11 +56,11 @@ Ltac step :=
   | forward_if
   | forward_call
   | rep_lia | cstring' | Zlength_solve
-  | match goal with |- ENTAIL _, _ |-- _ =>  go_lower end
+  | match goal with |- ENTAIL _, _ ⊢ _ =>  go_lower end
   | EExists_unify
   | cstring1
   | deadvars!
-  | solve [match goal with |- @derives mpred _ _ _ => cancel end]
+  | solve [match goal with |- @bi_entails (iPropI _) _ _ => cancel end]
   | solve [entailer!; try cstring']
   | list_solve
   ].
diff --git a/floyd/stronger.v b/floyd/stronger.v
index ed6102a206..44f3d1de67 100644
--- a/floyd/stronger.v
+++ b/floyd/stronger.v
@@ -1,5 +1,7 @@
 (* TODO: remove this file *)
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.nested_field_lemmas.
 Require Import VST.floyd.mapsto_memory_block.
@@ -13,16 +15,14 @@ Require Import Coq.Classes.RelationClasses.
 Require Import Coq.Classes.Morphisms.
 Require Import VST.zlist.sublist.
 
-Local Open Scope logic.
-
 Section STRONGER.
 
-Context {cs: compspecs}.
+Context `{!VSTGS OK_ty Σ} {cs: compspecs}.
 
 Definition stronger {t: type} (v v': reptype t) : Prop :=
-  forall sh, data_at sh t v |-- data_at sh t v'.
+  forall sh p, data_at sh t v p ⊢ data_at sh t v' p.
 
-Definition data_equal {t} v1 v2 := forall sh, data_at sh t v1 = data_at sh t v2.
+Definition data_equal {t} v1 v2 := forall sh p, data_at sh t v1 p ⊣⊢ data_at sh t v2 p.
 
 Notation "X '>>>' Y" := (stronger X Y) (at level 60, no associativity).
 Notation "X '===' Y" := (data_equal X Y) (at level 60, no associativity).
@@ -63,7 +63,7 @@ Lemma stronger_data_at_rec_derives: forall sh t v0 v1 pos p,
   (alignof t | pos) ->
   v0 >>> v1 ->
   field_compatible t nil (offset_val (Int.repr pos) p) ->
-  data_at_rec sh type_id_env.empty_ti t pos v0 p |--
+  data_at_rec sh type_id_env.empty_ti t pos v0 p ⊢
     data_at_rec sh type_id_env.empty_ti t pos v1 p.
 Proof.
   intros.
@@ -86,7 +86,7 @@ Lemma stronger_data_at_rec_nested_field_derives: forall sh t gfs t0 v0 v1 p,
   v0 >>> v1 ->
   size_compatible t p ->
   align_compatible t p ->
-  data_at_rec sh type_id_env.empty_ti t0 (nested_field_offset2 t gfs) v0 p |--
+  data_at_rec sh type_id_env.empty_ti t0 (nested_field_offset2 t gfs) v0 p ⊢
     data_at_rec sh type_id_env.empty_ti t0 (nested_field_offset2 t gfs) v1 p.
 Proof.
   intros.
@@ -106,22 +106,17 @@ Lemma stronger_trans: forall t (v0 v1 v2: reptype t),
   v0 >>> v1 -> v1 >>> v2 -> v0 >>> v2.
 Proof.
   intros.
-  intro sh.
-  eapply derives_trans.
-  apply H.
-  apply H0.
+  intros sh p.
+  rewrite H H0 //.
 Qed.
 
-Lemma field_at_stronger: forall sh t gfs v0 v1,
+Lemma field_at_stronger: forall sh t gfs v0 v1 p,
   v0 >>> v1 ->
-  field_at sh t gfs v0 |-- field_at sh t gfs v1.
+  field_at sh t gfs v0 p ⊢ field_at sh t gfs v1 p.
 Proof.
   intros.
-  intros p.
-  rewrite !field_at_data_at by exact H.
-  simpl.
+  rewrite -> !field_at_data_at by exact H.
   normalize.
-  apply H.
 Qed.
 
 Lemma stronger_array_ext: forall t0 n a (v0 v1: reptype (Tarray t0 n a)),
@@ -135,38 +130,36 @@ Proof.
 *
   unfold field_at.
   entailer.
-  apply derives_refl'.
-  f_equal.
+  apply bi.equiv_entails_1_2.
+  rewrite /at_offset.
   unfold nested_field_type; simpl.
   rewrite !data_at_rec_eq.
-  rewrite Z.max_l by lia.
+  rewrite -> Z.max_l by lia.
   unfold aggregate_pred.aggregate_pred.array_pred.
   unfold aggregate_pred.array_pred.
   simpl.
-  extensionality Vundef.
-  f_equal. f_equal.
   change (unfold_reptype v0) with v0.
   change (unfold_reptype v1) with v1.
-  rewrite H. auto.
+  rewrite H //.
 *
   assert_PROP (Zlength (unfold_reptype v0) = n). {
-     entailer!. destruct H2 as [? _]. rewrite Z.max_r in H2 by lia. auto.
+     entailer!. destruct H2 as [? _]. rewrite -> Z.max_r in H2 by lia. auto.
   }
   rewrite H1 in H. symmetry in H.
   unfold field_at.
   normalize.
   unfold at_offset.
-  unfold nested_field_offset, nested_field_type;   simpl.
+  unfold nested_field_offset, nested_field_type; simpl.
   rewrite !data_at_rec_eq.
   unfold aggregate_pred.aggregate_pred.array_pred.
   unfold aggregate_pred.array_pred.
-  rewrite Z.max_r by lia. rewrite Z.sub_0_r.
+  rewrite -> Z.max_r by lia. rewrite Z.sub_0_r.
   normalize.
   apply aggregate_pred.rangespec_ext_derives.
   intros.
   unfold at_offset.
   rewrite Z.sub_0_r.
-  rewrite Z2Nat.id in H3 by lia. rewrite Z.add_0_l in H3.
+  rewrite -> Z2Nat.id in H3 by lia. rewrite Z.add_0_l in H3.
   specialize (H0 _ H3 sh).
   unfold data_at, field_at in H0.
   simpl in H0.
@@ -184,7 +177,7 @@ Proof.
     rewrite H4 in H1. rewrite Z.mul_0_l in H1.
     rewrite Ptrofs.add_zero. lia.
    red in H2|-*. apply align_compatible_rec_Tarray_inv with (i:=i) in H2; auto.
-    fold (sizeof t0) in H2. rewrite H4 in H2. rewrite Z.mul_0_l, Z.add_0_r in H2. simpl.
+    fold (sizeof t0) in H2. rewrite H4 in H2. rewrite Z.mul_0_l Z.add_0_r in H2. simpl.
     rewrite Ptrofs.add_zero. auto.
    -
     clear - H2 H3 g0.
@@ -197,16 +190,16 @@ Proof.
       apply Zmult_lt_compat_l; lia.
     }
     hnf in H1. destruct p; try contradiction.
-    unfold sizeof in H1; simpl in H1. rewrite Z.max_r in H1 by lia.
+    unfold sizeof in H1; simpl in H1. rewrite -> Z.max_r in H1 by lia.
     fold (sizeof t0) in *.
     split3; [ | | split3]; auto.
    +
     red. simpl.
     rewrite Ptrofs.add_unsigned.
     pose proof (Ptrofs.unsigned_range i0).
-    rewrite (Ptrofs.unsigned_repr (_*_))
+    rewrite -> (Ptrofs.unsigned_repr (_*_))
       by (change (Ptrofs.max_unsigned) with (Ptrofs.modulus - 1); lia).
-    rewrite (Ptrofs.unsigned_repr)
+    rewrite -> (Ptrofs.unsigned_repr)
       by (change (Ptrofs.max_unsigned) with (Ptrofs.modulus - 1); lia).
     assert (sizeof t0 * i + sizeof t0 <= sizeof t0 * n). {
        rewrite <- (Z.mul_1_r (sizeof t0)) at 2.
@@ -216,17 +209,17 @@ Proof.
     lia.
     +
      red in H2. apply align_compatible_rec_Tarray_inv with (i:=i) in H2; auto.
-     unfold offset_val. 
+     unfold offset_val.
      red.
      rewrite Ptrofs.add_unsigned.
     pose proof (Ptrofs.unsigned_range i0).
-    rewrite (Ptrofs.unsigned_repr (_*_))
+    rewrite -> (Ptrofs.unsigned_repr (_*_))
       by (change (Ptrofs.max_unsigned) with (Ptrofs.modulus - 1); lia).
-    rewrite (Ptrofs.unsigned_repr)
+    rewrite -> (Ptrofs.unsigned_repr)
       by (change (Ptrofs.max_unsigned) with (Ptrofs.modulus - 1); lia).
     auto.
   }
-  rewrite !prop_true_andp in H0 by auto.
+  rewrite -> !prop_true_andp in H0 by auto.
   unfold at_offset in H0.
   unfold nested_field_offset, nested_field_type in H0;   simpl in H0.
   rewrite !offset_offset_val in H0.
@@ -251,7 +244,6 @@ split; intros.
 hnf; intros.
 specialize (H sh).
 unfold data_at in *.
-intro p.
 unfold field_at in *.
 normalize.
 unfold at_offset.
@@ -266,9 +258,9 @@ Lemma data_equal_stronger: forall {t} (v1 v2: reptype t), (v1 === v2) <-> (v1 >>
 Proof.
   intros.
   split; intro.
-  + split; intro sh; rewrite H; auto.
+  + split; intros sh p; rewrite H; auto.
   + destruct H.
-    intro sh; apply pred_ext; [apply H | apply H0].
+    intros sh p; iSplit; [iApply H | iApply H0].
 Qed.
 
 Lemma data_equal_JMeq:
@@ -304,7 +296,7 @@ Proof.
   + intro; intros.
     rewrite H; reflexivity.
   + intro; intros.
-    rewrite H, H0; reflexivity.
+    rewrite H H0; reflexivity.
 Defined.
 
 Lemma data_equal_refl': forall t (v v': reptype t), v = v' -> v === v'.
@@ -312,21 +304,21 @@ Proof.
   intros. subst. reflexivity.
 Qed.
 
-Lemma field_at_data_equal: forall sh t gfs v0 v1,
+Lemma field_at_data_equal: forall sh t gfs v0 v1 p,
   v0 === v1 ->
-  field_at sh t gfs v0 = field_at sh t gfs v1.
+  field_at sh t gfs v0 p ⊣⊢ field_at sh t gfs v1 p.
 Proof.
   intros.
   destruct (data_equal_stronger v0 v1) as [? _].
   spec H0; [auto |].
-  apply pred_ext; apply field_at_stronger; tauto.
+  iSplit; iApply field_at_stronger; tauto.
 Qed.
 
 #[export] Instance Proper_field_at: forall sh t gfs,
-  Proper ((@data_equal _) ==> eq) (field_at sh t gfs).
+  Proper ((@data_equal _) ==> eq ==> equiv) (field_at sh t gfs).
 Proof.
   intros.
-  intro; intros.
+  intros ????? ->.
   apply field_at_data_equal; auto.
 Defined.
 
@@ -430,4 +422,4 @@ End DataCmpNotations.
 
 Global Existing Instance Equiv_data_equal.
 (*Global Existing Instance Proper_fold_reptype_array.*)
-Global Existing Instance Proper_field_at.
\ No newline at end of file
+Global Existing Instance Proper_field_at.
diff --git a/floyd/subsume_funspec.v b/floyd/subsume_funspec.v
index f04d7557ab..51829feabf 100644
--- a/floyd/subsume_funspec.v
+++ b/floyd/subsume_funspec.v
@@ -1,79 +1,72 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.closed_lemmas.
 Require Import VST.floyd.mapsto_memory_block.
 Require Import VST.floyd.local2ptree_denote.
 Require Import VST.floyd.local2ptree_eval.
 Import LiftNotation.
-Import compcert.lib.Maps.
-Local Open Scope logic.
+Import -(notations) compcert.lib.Maps.
+
 (*
 Definition NDfunspec_sub (f1 f2 : funspec) :=
 let Delta2 := xtype_tycontext (snd (typesig_of_funspec f2)) in
 match f1 with
-| mk_funspec tpsig1 cc1 (rmaps.ConstType A1) P1 Q1 _ _ =>
+| mk_funspec tpsig1 cc1 (ConstType A1) P1 Q1 _ _ =>
     match f2 with
-    | mk_funspec tpsig2 cc2 (rmaps.ConstType As) P2 Q2 _ _ =>
+    | mk_funspec tpsig2 cc2 (ConstType As) P2 Q2 _ _ =>
         (tpsig1=tpsig2 /\ cc1=cc2) /\
         forall x2 (rho:argsEnviron),
-        ((!! (tc_argsenv Delta2 (fst tpsig2)) rho) && P2 nil x2 rho)
-         |-- (EX x1:_, EX F:_, 
-                           (F * (P1 nil x1 rho)) &&
+        ((!! (tc_argsenv Delta2 (fst tpsig2)) rho) ∧ P2 nil x2 rho)
+         ⊢ (∃ x1:_, ∃ F:_, 
+                           (F ∗ (P1 nil x1 rho)) ∧
                                (!! (forall rho',
-                                           ((!! (tc_environ (xtype_tycontext (snd tpsig1)) rho') &&
-                                                 (F * (Q1 nil x1 rho')))
-                                         |-- (Q2 nil x2 rho')))))
+                                           ((!! (tc_environ (xtype_tycontext (snd tpsig1)) rho') ∧
+                                                 (F ∗ (Q1 nil x1 rho')))
+                                         ⊢ (Q2 nil x2 rho')))))
  | _ => False end
  | _ => False end.*)
 
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ}.
+
 Definition NDfunspec_sub (f1 f2 : funspec) :=
 let Delta2 := xtype_tycontext (snd (typesig_of_funspec f2)) in
 match f1 with
-| mk_funspec tpsig1 cc1 (rmaps.ConstType A1) P1 Q1 _ _ =>
+| mk_funspec tpsig1 cc1 (ConstType A1) E1 P1 Q1 =>
     match f2 with
-    | mk_funspec tpsig2 cc2 (rmaps.ConstType As) P2 Q2 _ _ =>
+    | mk_funspec tpsig2 cc2 (ConstType As) E2 P2 Q2 =>
         (tpsig1=tpsig2 /\ cc1=cc2) /\
         forall x2 (gargs:argsEnviron),
-        ((!! (argsHaveTyps(snd gargs)(fst tpsig1)) && P2 nil x2 gargs)
-         |-- (EX x1:_, EX F:_, 
-                           (F * (P1 nil x1 gargs)) &&
-                               (!! (forall rho',
-                                           ((!! (ve_of rho' = Map.empty (block * type))) &&
-                                                 (F * (Q1 nil x1 rho')))
-                                         |-- (Q2 nil x2 rho')))))
- | _ => False end
- | _ => False end.
+        (⌜argsHaveTyps(snd gargs)(fst tpsig1)⌝ ∧ P2 x2 gargs)
+         ⊢ |={E2 x2}=> (∃ x1:_, ∃ F:_,
+                           ⌜E1 x1 ⊆ E2 x2⌝ ∧ (F ∗ (P1 x1 gargs)) ∧
+                               (⌜forall rho',
+                                           (⌜ve_of rho' = Map.empty (block * type)⌝ ∧
+                                                 (F ∗ (Q1 x1 rho')))
+                                         ⊢ (Q2 x2 rho')⌝))
+ | _ => False%type end
+ | _ => False%type end.
 
-Definition is_NDfunspec (fs: funspec) :=
+(*Definition is_NDfunspec (fs: funspec) :=
  match fs with
- | mk_funspec _ _ (rmaps.ConstType A) P Q _ _ =>
+ | mk_funspec _ _ (ConstType A) P Q =>
     (forall ts, P ts = P nil /\ Q ts = Q nil)
  | _ => False
- end.
+ end.*)
 
 Lemma NDsubsume_subsume:
-  forall f1 f2, 
-   is_NDfunspec f2 ->
+  forall f1 f2,
+(*   is_NDfunspec f2 ->*)
    NDfunspec_sub f1 f2 ->
    funspec_sub f1 f2.
 Proof.
-intros f1 f2. pose proof I. intros H0 H1.
-destruct f1, f2; hnf in H1.
+intros.
+destruct f1, f2; hnf in H.
 destruct A; try contradiction. destruct A0; try contradiction.
-destruct H1 as [[? ?] ?]; split; auto.
-subst t0 c0.
-intros ts1 x1 rho.
-specialize (H3 x1).
-simpl in H0.
-specialize (H0 ts1). destruct H0 as [H0 H0'].
-rewrite H0.
-eapply derives_trans; [apply H3 | clear H3 ].
-eapply derives_trans; [|apply fupd_intro].
-apply (exp_right (@nil Type)). simpl.
-apply exp_derives; intros x2.
-apply exp_derives; intros F.
-apply andp_derives; trivial. simpl. apply prop_derives. intros.
-rewrite H0'. apply H1.
+destruct H as [[? ?] ?]; split; auto.
 Qed.
 
 (*
@@ -86,12 +79,12 @@ match f1 with
         fsig1 = fsig2 /\ cc1=cc2 /\
         forall (ts2 : list Type) x2,
                ENTAIL Delta, P2 ts2 x2
-           |--
-               |==> (EX ts1:_,  EX x1:_, EX F:_, 
-                           (`F * (P1 ts1 x1)) &&
+           ⊢
+               |==> (∃ ts1:_,  ∃ x1:_, ∃ F:_, 
+                           (`F ∗ (P1 ts1 x1)) ∧
                                (!! ENTAIL (ret0_tycon Delta),
-                                                 (`F * (Q1 ts1 x1))
-                                         |--
+                                                 (`F ∗ (Q1 ts1 x1))
+                                         ⊢
                                            |==> (Q2 ts2 x2)))
     end
 end.
@@ -108,44 +101,35 @@ Qed.
 
 Inductive empty_type : Type := .
 
-Definition withtype_of_NDfunspec fs := match fs with
-  mk_funspec _ _ (rmaps.ConstType A) _ _ _ _ => A | _ => empty_type end.
+Definition withtype_of_NDfunspec (fs : funspec) := match fs with
+  mk_funspec _ _ (ConstType A) _ _ _ => A | _ => empty_type end.
  
 
-Definition withtype_of_funspec fs := match fs with
-  mk_funspec _ _ A _ _ _ _ => A end.
+Definition withtype_of_funspec (fs : funspec) := match fs with
+  mk_funspec _ _ A _ _ _ => A end.
 
 Lemma sepcon_ENTAIL:
- forall Delta P Q P' Q',
-  ENTAIL Delta, P |-- P' ->
-  ENTAIL Delta, Q |-- Q' ->
-  ENTAIL Delta, P * Q |-- P' * Q'.
+ forall Delta (P Q P' Q' : assert),
+  (ENTAIL Delta, P ⊢ P') ->
+  (ENTAIL Delta, Q ⊢ Q') ->
+  (ENTAIL Delta, (P ∗ Q) ⊢ (P' ∗ Q')).
 Proof.
-intros.
-intro rho; specialize (H rho); specialize (H0 rho); simpl in *.
-unfold local, lift1 in *.
-normalize.
-rewrite prop_true_andp in H,H0 by auto.
-apply sepcon_derives; auto.
+  intros; apply sepcon_ENTAIL; done.
 Qed.
 
 Lemma NDfunspec_sub_refl:
-  forall fsig cc A P Q, 
+  forall fsig cc A P Q,
    NDfunspec_sub (NDmk_funspec fsig cc A P Q) (NDmk_funspec fsig cc A P Q).
 Proof.
-intros.
-simpl.
-split; auto.
-intros.
-Exists x2. Exists emp.
-unfold_lift.
-rewrite !emp_sepcon.
-apply andp_right.
-apply andp_left2; auto.
-apply prop_right.
-intros rho'.
-rewrite emp_sepcon.
-apply andp_left2; auto.
+  intros.
+  simpl.
+  split; auto.
+  intros.
+  iIntros "(% & ?) !>".
+  iExists x2, emp; iFrame.
+  iSplit; iPureIntro; first done.
+  split; first done.
+  intros; iIntros "(_ & ? & $)".
 Qed.
 
 Lemma NDfunspec_sub_trans:
@@ -154,116 +138,97 @@ Lemma NDfunspec_sub_trans:
    NDfunspec_sub (NDmk_funspec fsig2 cc2 A2 P2 Q2) (NDmk_funspec fsig3 cc3 A3 P3 Q3) ->
    NDfunspec_sub (NDmk_funspec fsig1 cc1 A1 P1 Q1) (NDmk_funspec fsig3 cc3 A3 P3 Q3).
 Proof.
-intros.
-destruct H as [[?E ?E'] H]. 
-destruct H0 as [[?F ?F'] H0].
-subst.
-split; auto.
-intro x3; simpl in x3. simpl in H, H0. simpl. intros.
-specialize (H0 x3 gargs).
-eapply derives_trans. apply andp_right. apply andp_left1. apply derives_refl. apply H0. clear H0.
-(*eapply ENTAIL_trans; [apply H0 | ].
-clear H0.*)
-normalize. rename x1 into x2.
-specialize (H x2 gargs).
-eapply derives_trans.
-(*apply sepcon_ENTAIL.*) apply sepcon_derives.
-(*apply ENTAIL_refl.*) apply derives_refl.
-apply andp_right. apply prop_right. apply H0. apply derives_refl. 
-eapply derives_trans. apply sepcon_derives. apply derives_refl.  apply H. 
-clear H.
-Intros x1.
-Intros F1.
-Exists x1 (F*F1). rewrite sepcon_assoc. apply andp_right; trivial.
-apply prop_right.
-intro tau.
-eapply derives_trans. 2: apply H1. clear H1. normalize.
-rewrite sepcon_assoc. apply sepcon_derives; trivial.
-eapply derives_trans. 2: apply H. clear H. normalize.
+  intros.
+  destruct H as [(?E & ?E') H].
+  destruct H0 as [(?F & ?F') H0].
+  subst.
+  split; auto.
+  intro x3; simpl in x3. simpl in H, H0. simpl. intros.
+  specialize (H0 x3 gargs).
+  iIntros "(% & ?)".
+  iMod (H0 with "[-]") as (???) "((F & H) & %Hpost)".
+  { iFrame; iFrame "%". }
+  iMod (H with "[H]") as (???) "((F1 & H1) & %Hpost1)".
+  { iFrame; iFrame "%". }
+  iExists _, (F ∗ F0); iFrame.
+  iModIntro; iSplit; iPureIntro; first done.
+  split; first done.
+  intros; iIntros "(% & (? & ?) & ?)".
+  rewrite -Hpost; iFrame; iFrame "%".
+  rewrite -Hpost1; iFrame; iFrame "%".
 Qed.
 
-Lemma later_exp'' (A: Type) (ND: NatDed A)(Indir: Indir A):
-      forall T : Type,
-       (exists x: T, True) ->
-       forall F : T -> A,
-       |> (EX x : _, F x) = EX x : T, |> F x.
-Proof.
-intros.
-destruct H as [x _].
-apply later_exp'; auto.
-Qed.
+Context {OK_spec: ext_spec OK_ty} {CS: compspecs}.
 
 Lemma semax_call_subsume:
-  forall (fs1: funspec) A P Q NEP NEQ argsig retsig cc,
-    funspec_sub fs1 (mk_funspec  (argsig,retsig) cc A P Q NEP NEQ)  ->
-   forall {CS: compspecs} {Espec: OracleKind} Delta  ts x (F: environ -> mpred) ret  a bl,
+  forall (fs1: funspec) A E P Q argsig retsig cc,
+    funspec_sub fs1 (mk_funspec  (argsig,retsig) cc A E P Q)  ->
+  forall Delta x F ret a bl,
            Cop.classify_fun (typeof a) =
            Cop.fun_case_f argsig retsig cc ->
-           (retsig = Tvoid -> ret = None) ->   
+           (retsig = Tvoid -> ret = None) ->
           tc_fn_return Delta ret retsig ->
-  @semax CS Espec Delta
-          (((*|>*)((tc_expr Delta a) && (tc_exprlist Delta argsig bl)))  &&
-         (`(func_ptr fs1) (eval_expr a) &&
-          |>(F * (fun rho => P ts x (ge_of rho, eval_exprlist argsig bl rho)))))
+  semax (E x) Delta
+       (((tc_expr Delta a ∧ tc_exprlist Delta argsig bl))  ∧
+           (assert_of (fun rho => func_ptr fs1 (eval_expr a rho)) ∗
+          (▷(F ∗ assert_of (fun rho => P x (ge_of rho, eval_exprlist argsig bl rho))))))
          (Scall ret a bl)
          (normal_ret_assert
-          (EX old:val, substopt ret (`old) F * maybe_retval (Q ts x) retsig ret)).
-Proof. intros.
-eapply semax_pre. 2: apply @semax_call with (P:=P) (NEP:=NEP) (NEQ:=NEQ); trivial; eassumption.
-apply andp_left2. apply andp_derives; trivial. apply andp_derives; trivial.
-unfold liftx, lift. simpl. intros rho. clear - H.
-remember (mk_funspec (argsig, retsig) cc A P Q NEP NEQ) as gs.
-remember (eval_expr a rho) as v.
-unfold func_ptr.
-apply func_ptr_mono; trivial.
-apply derives_refl.
+          (∃ old:val, assert_of (substopt ret (`old) F) ∗ maybe_retval (assert_of (Q x)) retsig ret)).
+Proof.
+  intros.
+  eapply semax_pre, semax_call; [|done..].
+  rewrite bi.and_elim_r; apply bi.and_mono; first done.
+  apply bi.sep_mono; last done.
+  split => rho; simpl.
+  by apply func_ptr_mono.
 Qed.
 
 Lemma semax_call_subsume_si:
-  forall (fs1: funspec) A P Q NEP NEQ argsig retsig cc,
-   forall {CS: compspecs} {Espec: OracleKind} Delta  ts x (F: environ -> mpred) ret  a bl,
+  forall (fs1: funspec) A (E : dtfr (MaskTT A)) P Q argsig retsig cc,
+   forall Delta  x F ret a bl,
            Cop.classify_fun (typeof a) =
            Cop.fun_case_f argsig retsig cc  ->
-           (retsig = Tvoid -> ret = None) ->   
+           (retsig = Tvoid -> ret = None) ->
           tc_fn_return Delta ret retsig ->
-  @semax CS Espec Delta
-          (((*|>*)((tc_expr Delta a) && (tc_exprlist Delta argsig bl)))  && 
-          
-         (`(func_ptr fs1) (eval_expr a) && `(funspec_sub_si fs1 (mk_funspec  (argsig,retsig) cc A P Q NEP NEQ)) &&
-          |>(F * (fun rho => P ts x (ge_of rho, eval_exprlist argsig bl rho)))))
+  semax (E x) Delta
+       ((tc_expr Delta a ∧ tc_exprlist Delta argsig bl) ∧
+           ((assert_of (fun rho => func_ptr_si fs1 (eval_expr a rho)) ∧ ⎡funspec_sub_si fs1 (mk_funspec  (argsig,retsig) cc A E P Q)⎤) ∗
+          (▷(F ∗ assert_of (fun rho => P x (ge_of rho, eval_exprlist argsig bl rho))))))
          (Scall ret a bl)
          (normal_ret_assert
-          (EX old:val, substopt ret (`old) F * maybe_retval (Q ts x) retsig ret)).
-Proof. intros.
-eapply semax_pre. 2: apply @semax_call with (P:=P) (NEP:=NEP) (NEQ:=NEQ); trivial; eassumption.
-apply andp_left2. apply andp_derives; trivial. apply andp_derives; trivial.
-unfold liftx, lift. simpl. clear. intros rho.
-rewrite andp_comm. constructor. apply func_ptr_si_mono.
-apply derives_refl.
+          (∃ old:val, assert_of (substopt ret (`old) F) ∗ maybe_retval (assert_of (Q x)) retsig ret)).
+Proof.
+  intros.
+  eapply semax_pre, semax_call; [|done..].
+  rewrite bi.and_elim_r; apply bi.and_mono; first done.
+  apply bi.sep_mono; last done.
+  monPred.unseal; split => rho; simpl.
+  rewrite comm; apply func_ptr_si_mono.
 Qed.
 
+(* For now, NDmk_funspec defaults to ⊤ mask, so functions can only be called at ⊤. *)
 Lemma semax_call_NDsubsume :
   forall (fs1: funspec) A P Q argsig retsig cc,
-    NDfunspec_sub fs1 
+    NDfunspec_sub fs1
         (NDmk_funspec  (argsig,retsig) cc A P Q)  ->
-     forall {CS: compspecs} {Espec: OracleKind},
-    forall  Delta  x (F: environ -> mpred) ret a bl,
+    forall  Delta  x F ret a bl,
            Cop.classify_fun (typeof a) =
            Cop.fun_case_f argsig retsig cc ->
            (retsig = Tvoid -> ret = None) ->
           tc_fn_return Delta ret retsig ->
-  @semax CS Espec Delta
-          (((*|>*)((tc_expr Delta a) && (tc_exprlist Delta argsig bl)))  &&
-         (`(func_ptr fs1) (eval_expr a) &&
-          |>(F * (fun rho => P x (ge_of rho, eval_exprlist argsig bl rho)))))
+  semax ⊤ Delta
+       (((tc_expr Delta a ∧ tc_exprlist Delta argsig bl))  ∧
+           (assert_of (fun rho => func_ptr fs1 (eval_expr a rho)) ∗
+          (▷(F ∗ assert_of (fun rho => P x (ge_of rho, eval_exprlist argsig bl rho))))))
          (Scall ret a bl)
          (normal_ret_assert
-          (EX old:val, substopt ret (`old) F * maybe_retval (Q x) retsig ret)).
+          (∃ old:val, assert_of (substopt ret (`old) F) ∗ maybe_retval (assert_of (Q x)) retsig ret)).
 Proof.
-intros.
-apply (semax_call_subsume fs1 (rmaps.ConstType A) (fun _ => P) (fun _ => Q)
-   (args_const_super_non_expansive A _) (const_super_non_expansive A _)
-    argsig retsig cc); auto.
-clear - H.
-apply NDsubsume_subsume. simpl; auto. apply H. apply nil.
+  intros.
+  pose proof (semax_call_subsume fs1 (ConstType A) (λne _, ⊤) (λne (a : leibnizO A), (P a) : _ -d> iProp Σ) (λne (a : leibnizO A), (Q a) : _ -d> iProp Σ) argsig retsig cc) as Hcall.
+  simpl in Hcall; apply Hcall; auto.
+  apply NDsubsume_subsume. simpl; auto.
 Qed.
+
+End mpred.
diff --git a/floyd/type_induction.v b/floyd/type_induction.v
index 25e64f0a62..95c1ed22e7 100644
--- a/floyd/type_induction.v
+++ b/floyd/type_induction.v
@@ -1,10 +1,12 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.fieldlist.
 Require Import VST.floyd.computable_theorems.
-Import compcert.lib.Maps.
+Require Export stdpp.hlist. (* use this instead of ListType to avoid universe inconsistencies? *)
 Open Scope nat.
 
-Inductive ListType: list Type -> Type :=
+(*Inductive ListType: list Type -> Type :=
   | Nil: ListType nil
   | Cons: forall {A B} (a: A) (b: ListType B), ListType (A :: B).
 
@@ -22,7 +24,7 @@ Proof.
   induction l.
   + reflexivity.
   + simpl.
-    rewrite H, IHl.
+    rewrite H; first rewrite IHl.
     - reflexivity.
     - intros; apply H; simpl; tauto.
     - simpl; left; auto.
@@ -95,6 +97,101 @@ Proof.
   + simpl.
     f_equal.
     auto.
+Defined.*)
+
+Fixpoint tmap {A} (f : A -> Type) l : tlist :=
+  match l with
+  | [] => tnil
+  | x :: rest => tcons (f x) (tmap f rest)
+  end.
+
+Fixpoint hmap {A} (F: A -> Type) (f: forall A, F A) (l: list A) : hlist (tmap F l) :=
+  match l with
+  | nil => hnil
+  | cons h t => hcons (f h) (hmap F f t)
+  end.
+
+Lemma hmap_preserve: forall A F f1 f2 (l: list A),
+  (forall a, In a l -> f1 a = f2 a) ->
+  hmap F f1 l = hmap F f2 l.
+Proof.
+  intros.
+  induction l.
+  + reflexivity.
+  + simpl.
+    rewrite H; first rewrite IHl.
+    - reflexivity.
+    - intros; apply H; simpl; tauto.
+    - simpl; left; auto.
+Defined.
+
+Definition decay' {X} {F: Type} {l: list X} (v: hlist (tmap (fun _ => F) l)): list F.
+  remember (tmap (fun _ : X => F) l) eqn:E.
+  revert l E.
+  induction v; intros.
+  + exact nil.
+  + destruct l; inversion E.
+    specialize (IHv l H1).
+    rewrite H0 in a.
+    exact (a :: IHv).
+Defined.
+
+Fixpoint decay'' {X} {F: Type} (l0 : tlist) (v: hlist l0) :
+  forall (l: list X), l0 = tmap (fun _ => F) l -> list F :=
+  match v in hlist l1
+    return forall l2, l1 = tmap (fun _ => F) l2 -> list F
+  with
+  | hnil => fun _ _ => nil
+  | hcons A B a b =>
+    fun (l1 : list X) (E0 : tcons A B = tmap (fun _ : X => F) l1) =>
+    match l1 as l2 return (tcons A B = tmap (fun _ : X => F) l2 -> list F) with
+    | nil => fun _ => nil (* impossible case *)
+    | x :: l2 =>
+       fun E1 : tcons A B = tmap (fun _ : X => F) (x :: l2) =>
+       (fun
+          X0 : tmap (fun _ : X => F) (x :: l2) =
+               tmap (fun _ : X => F) (x :: l2) -> list F =>
+        X0 eq_refl)
+         match
+           E1 in (_ = y)
+           return (y = tmap (fun _ : X => F) (x :: l2) -> list F)
+         with
+         | eq_refl =>
+             fun H0 : tcons A B = tmap (fun _ : X => F) (x :: l2) =>
+              (fun (H3 : A = F) (H4 : B = tmap (fun _ : X => F) l2) =>
+                  (eq_rect A (fun A0 : Type => A0) a F H3) :: (decay'' B b l2 H4))
+                 (f_equal
+                    (fun e : tlist =>
+                     match e with
+                     | tnil => A
+                     | tcons T _ => T
+                     end) H0)
+                (f_equal
+                   (fun e : tlist =>
+                    match e with
+                    | tnil => B
+                    | tcons _ l3 => l3
+                    end) H0)
+         end
+    end E0
+  end.
+
+Definition decay {X} {F: Type} {l: list X} (v: hlist (tmap (fun _ => F) l)): list F :=
+  let l0 := tmap (fun _ => F) l in
+  let E := @eq_refl _ (tmap (fun _ => F) l) : l0 = tmap (fun _ => F) l in
+  decay'' l0 v l E.
+
+Lemma decay_spec: forall A F f l,
+  decay (hmap (fun _: A => F) f l) = map f l.
+Proof.
+  intros.
+  unfold decay.
+  induction l.
+  + simpl.
+    reflexivity.
+  + simpl.
+    f_equal.
+    auto.
 Defined.
 
 Section COMPOSITE_ENV.
@@ -126,11 +223,11 @@ Proof.
   + (* Tstruct level 0 *)
     simpl in RANK.
     unfold get_co in IH_TYPE.
-    destruct (cenv_cs ! i); [inv RANK | apply IH_TYPE; simpl; constructor].
+    destruct (Maps.PTree.get i cenv_cs); [inv RANK | apply IH_TYPE; simpl; constructor].
   + (* Tunion level 0 *)
     simpl in RANK.
     unfold get_co in IH_TYPE.
-    destruct (cenv_cs ! i); [inv RANK | apply IH_TYPE].
+    destruct (Maps.PTree.get i cenv_cs); [inv RANK | apply IH_TYPE].
     simpl; constructor.
   + (* Tarray level positive *)
     simpl in RANK.
@@ -141,7 +238,7 @@ Proof.
     simpl in RANK.
     pose proof get_co_members_no_replicate i.
     unfold get_co in *.
-    destruct (cenv_cs ! i) as [co |] eqn:CO; [| apply IH_TYPE; simpl; constructor].
+    destruct (Maps.PTree.get i cenv_cs) as [co |] eqn:CO; [| apply IH_TYPE; simpl; constructor].
     apply IH_TYPE; clear IH_TYPE.
     apply Forall_forall.
     intros ? ?; simpl.
@@ -157,7 +254,7 @@ Proof.
     simpl in RANK.
     pose proof get_co_members_no_replicate i.
     unfold get_co in *.
-    destruct (cenv_cs ! i) as [co |] eqn:CO; [| apply IH_TYPE; simpl; constructor].
+    destruct (Maps.PTree.get i cenv_cs) as [co |] eqn:CO; [| apply IH_TYPE; simpl; constructor].
     apply IH_TYPE; clear IH_TYPE.
     apply Forall_forall.
     intros ? ?; simpl.
@@ -189,7 +286,7 @@ Definition A_members (ms: members) (m: member) : Type :=
     A (field_type (name_member m) ms).
 
 Definition FT_aux id :=
-    let m := co_members (get_co id) in ListType (map (fun it => A (field_type (name_member it) m)) m).
+    let m := co_members (get_co id) in hlist (tmap (fun it => A (field_type (name_member it) m)) m).
 
 Variable F_ByValue: forall t: type, A t.
 Variable F_Tarray: forall t n a, A t -> A (Tarray t n a).
@@ -202,16 +299,16 @@ Fixpoint type_func_rec (n: nat) (t: type): A t :=
   | 0 =>
     match t as t0 return A t0 with
     | Tstruct id a =>
-       match cenv_cs ! id with
+       match Maps.PTree.get id cenv_cs with
        | None => let m := co_members (get_co id) in
-                       F_Tstruct id a (ListTypeGen (fun it => A (field_type (name_member it) m))
+                       F_Tstruct id a (hmap (fun it => A (field_type (name_member it) m))
                                      (fun it => F_ByValue (field_type (name_member it) m)) m)
        | _ => F_ByValue (Tstruct id a)
        end
     | Tunion id a =>
-       match cenv_cs ! id with
+       match Maps.PTree.get id cenv_cs with
        | None => let m := co_members (get_co id) in
-                      F_Tunion id a (ListTypeGen (fun it => A (field_type (name_member it) m))
+                      F_Tunion id a (hmap (fun it => A (field_type (name_member it) m))
                                      (fun it => F_ByValue (field_type (name_member it) m)) m)
        | _ => F_ByValue (Tunion id a)
        end
@@ -221,10 +318,10 @@ Fixpoint type_func_rec (n: nat) (t: type): A t :=
     match t as t0 return A t0 with
     | Tarray t0 n a => F_Tarray t0 n a (type_func_rec n' t0)
     | Tstruct id a =>  let m := co_members (get_co id) in
-                            F_Tstruct id a (ListTypeGen (fun it => A (field_type (name_member it) m))
+                            F_Tstruct id a (hmap (fun it => A (field_type (name_member it) m))
                                         (fun it => type_func_rec n' (field_type (name_member it) m)) m)
     | Tunion id a =>  let m := co_members (get_co id) in
-                            F_Tunion id a (ListTypeGen (fun it => A (field_type (name_member it) m))
+                            F_Tunion id a (hmap (fun it => A (field_type (name_member it) m))
                                         (fun it => type_func_rec n' (field_type (name_member it) m)) m)
     | t' => F_ByValue t'
     end
@@ -232,20 +329,20 @@ Fixpoint type_func_rec (n: nat) (t: type): A t :=
 
 Definition type_func t := type_func_rec (rank_type cenv_cs t) t.
 
-Lemma rank_type_Tstruct: forall id a co, cenv_cs ! id = Some co ->
+Lemma rank_type_Tstruct: forall id a co, Maps.PTree.get id cenv_cs = Some co ->
   rank_type cenv_cs (Tstruct id a) = S (co_rank (get_co id)).
 Proof.
   intros.
   unfold get_co; simpl.
-  destruct (cenv_cs ! id); auto; congruence.
+  destruct (Maps.PTree.get id cenv_cs); auto; congruence.
 Defined.
 
-Lemma rank_type_Tunion: forall id a co, cenv_cs ! id = Some co ->
+Lemma rank_type_Tunion: forall id a co, Maps.PTree.get id cenv_cs = Some co ->
   rank_type cenv_cs (Tunion id a) = S (co_rank (get_co id)).
 Proof.
   intros.
   unfold get_co; simpl.
-  destruct (cenv_cs ! id); auto; congruence.
+  destruct (Maps.PTree.get id cenv_cs); auto; congruence.
 Defined.
 
 Lemma type_func_rec_rank_irrelevent: forall t n n0,
@@ -266,7 +363,7 @@ Proof.
     simpl. f_equal.
     apply IH; apply le_S_n; auto.
   + (* Tstruct *)
-    destruct (cenv_cs ! id) as [co |] eqn: CO.
+    destruct (Maps.PTree.get id cenv_cs) as [co |] eqn: CO.
     - erewrite rank_type_Tstruct in H by eauto.
       erewrite rank_type_Tstruct in H0 by eauto.
       clear co CO.
@@ -274,7 +371,7 @@ Proof.
     destruct n0; simpl in H; try solve [inv H0].
       simpl.
       f_equal.
-      apply ListTypeGen_preserve.
+      apply hmap_preserve.
       intros m Hin.
       simpl in IH.
       generalize (Forall_forall1 _ _ IH); clear IH; intro IH.
@@ -291,7 +388,7 @@ Proof.
       generalize (F_Tstruct id a) as FF; unfold get_co;
       rewrite CO; intros; auto.
   + (* Tunion *)
-    destruct (cenv_cs ! id) as [co |] eqn: CO.
+    destruct (Maps.PTree.get id cenv_cs) as [co |] eqn: CO.
     - erewrite rank_type_Tunion in H by eauto.
       erewrite rank_type_Tunion in H0 by eauto.
       clear co CO.
@@ -299,7 +396,7 @@ Proof.
     destruct n0; simpl in H; try solve [inv H0].
       simpl.
       f_equal.
-      apply ListTypeGen_preserve.
+      apply hmap_preserve.
       intros m Hin.
       generalize (Forall_forall1 _ _ IH); clear IH; intro IH.
       specialize (IH _ Hin n n0).
@@ -317,7 +414,7 @@ Defined.
 
 Definition FTI_aux id :=
     let m := co_members (get_co id) in
-    (ListTypeGen (fun it => A (field_type (name_member it) m)) (fun it => type_func (field_type (name_member it) m)) m).
+    (hmap (fun it => A (field_type (name_member it) m)) (fun it => type_func (field_type (name_member it) m)) m).
 
 Lemma type_func_eq: forall t,
   type_func t =
@@ -333,9 +430,9 @@ Proof.
   + (* Tstruct *)
     unfold type_func in *.
     simpl type_func_rec.
-    destruct (cenv_cs ! id) as [co |] eqn:CO; simpl.
+    destruct (Maps.PTree.get id cenv_cs) as [co |] eqn:CO; simpl.
     - f_equal.
-      apply ListTypeGen_preserve; intro m.
+      apply hmap_preserve; intro m.
       unfold get_co; rewrite CO.
       intro Hin.
       generalize (Forall_forall1 _ _ IH); clear IH; intro IH.
@@ -354,9 +451,9 @@ Proof.
   + (* Tunion *)
     unfold type_func in *.
     simpl type_func_rec.
-    destruct (cenv_cs ! id) as [co |] eqn:CO; simpl.
+    destruct (Maps.PTree.get id cenv_cs) as [co |] eqn:CO; simpl.
     - f_equal.
-      apply ListTypeGen_preserve; intro m.
+      apply hmap_preserve; intro m.
       unfold get_co; rewrite CO.
       intro Hin.
       generalize (Forall_forall1 _ _ IH); clear IH; intro IH.
diff --git a/floyd/typecheck_lemmas.v b/floyd/typecheck_lemmas.v
index 70f1fdec68..d36ae64546 100644
--- a/floyd/typecheck_lemmas.v
+++ b/floyd/typecheck_lemmas.v
@@ -1,46 +1,44 @@
-
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
+Notation denote_tc_assert A := (assert_of (denote_tc_assert A)).
+
+Section mpred.
 
-Local Open Scope logic.
+Context `{!heapGS Σ} {CS: compspecs}.
 
 Lemma denote_tc_assert_andp:
-  forall {CS: compspecs} (a b : tc_assert),
-  denote_tc_assert (tc_andp a b) = andp (denote_tc_assert a) (denote_tc_assert b).
+  forall (a b : tc_assert),
+  denote_tc_assert (tc_andp a b) ⊣⊢ (denote_tc_assert a) ∧ (denote_tc_assert b).
 Proof.
   intros.
-  extensionality rho.
-  simpl.
-  apply expr2.denote_tc_assert_andp.
+  split => rho; monPred.unseal.
+  apply denote_tc_assert_andp.
 Qed.
 
 Lemma denote_tc_assert_orp:
-  forall {CS: compspecs} (a b : tc_assert),
-  denote_tc_assert (tc_orp a b) = orp (denote_tc_assert a) (denote_tc_assert b).
+  forall (a b : tc_assert),
+  denote_tc_assert (tc_orp a b) ⊣⊢ (denote_tc_assert a) ∨ (denote_tc_assert b).
 Proof.
   intros.
-  extensionality rho.
-  simpl.
+  split => rho; monPred.unseal.
   apply binop_lemmas2.denote_tc_assert_orp.
 Qed.
 
 Lemma denote_tc_assert_bool:
-  forall {CS: compspecs} b c, denote_tc_assert (tc_bool b c) =
-               prop (b=true).
+  forall b c, denote_tc_assert (tc_bool b c) ⊣⊢ ⌜b=true⌝.
 Proof.
   intros.
-  extensionality rho; simpl.
+  split => rho; monPred.unseal.
   unfold tc_bool.
-  destruct b.
-  apply pred_ext; normalize; apply derives_refl.
-  apply pred_ext.  apply @FF_left.
-  normalize. inv H.
+  destruct b; iSplit; done.
 Qed.
 
-Lemma neutral_isCastResultType_64:
+(*Lemma neutral_isCastResultType_64:
  Archi.ptr64 = true ->
-  forall {cs: compspecs}  P t t' v rho,
+  forall P t t' v,
    is_neutral_cast t' t = true ->
-   P |-- denote_tc_assert (isCastResultType t' t v) rho.
+   P ⊢ denote_tc_assert (isCastResultType t' t v).
 Proof.
 intro Hp.
 intros.
@@ -80,9 +78,9 @@ Qed.
 
 Lemma neutral_isCastResultType_32:
  Archi.ptr64 = false ->
-  forall {cs: compspecs}  P t t' v rho,
+  forall  P t t' v rho,
    is_neutral_cast t' t = true ->
-   P |-- denote_tc_assert (isCastResultType t' t v) rho.
+   P ⊢ denote_tc_assert (isCastResultType t' t v) rho.
 Proof.
 intro Hp.
 intros.
@@ -109,16 +107,15 @@ destruct (eqb_type (Tpointer t' a) (Tpointer t a0)); try apply @TT_right.
 unfold is_pointer_type.
 rewrite H,H0.
 apply @TT_right.
-Qed.
+Qed.*)
 
 Lemma neutral_isCastResultType:
-  forall {cs: compspecs}  P t t' v rho,
+  forall P t t' v,
    is_neutral_cast t' t = true ->
-   P |-- denote_tc_assert (isCastResultType t' t v) rho.
+   P ⊢ denote_tc_assert (isCastResultType t' t v).
 Proof.
-destruct Archi.ptr64 eqn:Hp.
-exact (@neutral_isCastResultType_64 Hp).
-exact (@neutral_isCastResultType_32 Hp).
+  intros; split => rho.
+  apply neutral_isCastResultType; done.
 Qed.
 
 Lemma tc_andp_TT2:  forall e, tc_andp e tc_TT = e.
@@ -126,15 +123,14 @@ Proof. intros; unfold tc_andp.  destruct e; reflexivity. Qed.
 
 Lemma tc_andp_TT1:  forall e, tc_andp tc_TT e = e.
 Proof. intros; unfold tc_andp; reflexivity. Qed.
-#[export] Hint Rewrite tc_andp_TT1 tc_andp_TT2 : norm.
 
-Definition typecheck_LR_strong {cs: compspecs} Delta e lr :=
+Definition typecheck_LR_strong Delta e lr :=
   match lr with
   | LLLL => typecheck_lvalue Delta e
   | RRRR => typecheck_expr Delta e
   end.
 
-Definition typecheck_LR {cs: compspecs} Delta e lr :=
+Definition typecheck_LR Delta e lr :=
   match e with
   | Ederef e0 t =>
      match lr with
@@ -152,34 +148,38 @@ Definition typecheck_LR {cs: compspecs} Delta e lr :=
   | _ => typecheck_LR_strong Delta e lr
   end.
 
-Definition tc_LR_strong {cs: compspecs} Delta e lr := denote_tc_assert (typecheck_LR_strong Delta e lr).
+Definition tc_LR_strong Delta e lr := denote_tc_assert (typecheck_LR_strong Delta e lr).
 
-Definition tc_LR {cs: compspecs} Delta e lr := denote_tc_assert (typecheck_LR Delta e lr).
+Definition tc_LR Delta e lr := denote_tc_assert (typecheck_LR Delta e lr).
 
-Definition eval_LR {cs: compspecs} e lr :=
+Definition eval_LR e lr :=
   match lr with
   | LLLL => eval_lvalue e
   | RRRR => eval_expr e
   end.
 
-Lemma tc_LR_tc_LR_strong: forall {cs: compspecs} Delta e lr rho,
-  tc_LR Delta e lr rho && !! isptr (eval_LR e lr rho) |-- tc_LR_strong Delta e lr rho.
+Lemma tc_LR_tc_LR_strong: forall Delta e lr rho,
+  tc_LR Delta e lr rho ∧ ⌜isptr (eval_LR e lr rho)⌝ ⊢ tc_LR_strong Delta e lr rho.
 Proof.
   intros.
   unfold tc_LR, tc_LR_strong, typecheck_LR, typecheck_LR_strong.
-  destruct e; try solve [apply andp_left1; auto].
+  destruct e; try solve [rewrite bi.and_elim_l; auto].
   unfold tc_lvalue, tc_expr.
   destruct lr; simpl.
-  + rewrite !denote_tc_assert_andp.
+  + rewrite !expr2.denote_tc_assert_andp.
     simpl.
     unfold denote_tc_isptr.
     unfold_lift.
     auto.
-  + destruct (access_mode t); try solve [apply andp_left1; auto].
-    rewrite !denote_tc_assert_andp.
+  + unfold typecheck_expr; fold typecheck_expr.
+    destruct (access_mode t); try solve [iIntros "([] & _)"].
+    rewrite !expr2.denote_tc_assert_andp.
     simpl.
     unfold denote_tc_isptr.
     unfold_lift.
     auto.
 Qed.
 
+End mpred.
+
+#[export] Hint Rewrite @tc_andp_TT1 @tc_andp_TT2 : norm.
diff --git a/floyd/unfold_data_at.v b/floyd/unfold_data_at.v
index 0d3421cdac..0d09bb8fbb 100644
--- a/floyd/unfold_data_at.v
+++ b/floyd/unfold_data_at.v
@@ -1,4 +1,6 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.floyd.base2.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.floyd.client_lemmas.
 Require Import VST.floyd.nested_field_lemmas.
 Require Import VST.floyd.data_at_rec_lemmas.
@@ -6,8 +8,6 @@ Require Import VST.floyd.field_at.
 Require Import VST.floyd.mapsto_memory_block.
 Opaque alignof.
 
-Local Open Scope logic.
-
 (* This is not well developed or well tested yet, but it does
    get through all the Travis tests 11/10/17 *)
 Ltac unfold_field_at' :=
@@ -15,7 +15,7 @@ Ltac unfold_field_at' :=
  | |- context [field_at_mark ?cs ?sh ?t ?gfs ?v ?p] =>
      let F := fresh "F" in
        set (F := field_at_mark cs sh t gfs v p);
-       change field_at_mark with @field_at in F;
+       change (field_at_mark cs) with (field_at(cs := cs)) in F;
      let V := fresh "V" in set (V:=v) in F;
      let P := fresh "P" in set (P:=p) in F;
      let T := fresh "T" in set (T:=t) in F;
@@ -23,14 +23,20 @@ Ltac unfold_field_at' :=
      let Heq := fresh "Heq" in
      assert (Heq: nested_field_type T gfs = Tstruct id noattr)
            by (unfold id,T; reflexivity);
-     let H := fresh in
-     assert (H:= @field_at_Tstruct cs sh T gfs id noattr
+     let HF := fresh "HF" in
+     assert (HF:= field_at_Tstruct(cs := cs) sh T gfs id noattr
                           V V P  (eq_refl _) (JMeq_refl _));
-     unfold id in H; clear Heq id;
-     fold F in H; clearbody F;
+     unfold id in HF; clear Heq id;
+     fold F in HF; clearbody F;
+     (* need to pick out RHS before simpl it since bi_equiv obstructs simpl *)
+     let H := fresh "H" in
+     match goal with
+       | HF: (_ ⊣⊢ ?RHS) |- _ => 
+     set (H:= RHS)  end;
+     fold H in HF;
      simpl co_members in H;
      lazy beta iota zeta delta  [nested_sfieldlist_at ] in H;
-     change (@field_at cs sh T) with (@field_at cs sh t) in H;
+     change (field_at(cs := cs) sh T) with (field_at(cs := cs) sh t) in H;
      hnf in T; subst T;
      change v with (protect _ v) in V;
      simpl in H;
@@ -41,15 +47,17 @@ Ltac unfold_field_at' :=
      | context[fst (?A,?B)] => change (fst (A,B)) with A in H
      | context[snd (?A,?B)] => change (snd (A,B)) with B in H
      end;
-     subst P;
-     subst F;
+     subst P; 
+     subst H;
+     rewrite HF;
+     clear HF F;
      cbv beta;
      repeat flatten_sepcon_in_SEP;
      repeat simplify_project_default_val
  | |- context [field_at_mark ?cs ?sh ?t ?gfs ?v ?p] =>
      let F := fresh "F" in
-       set (F := field_at_mark cs sh t gfs v p);
-       change field_at_mark with @field_at in F;
+       set (HF := field_at_mark cs sh t gfs v p);
+       change (field_at_mark cs) with (field_at(cs := cs)) in HF;
      let V := fresh "V" in set (V:=v) in F;
      let P := fresh "P" in set (P:=p) in F;
      let T := fresh "T" in set (T:=t) in F;
@@ -58,13 +66,19 @@ Ltac unfold_field_at' :=
      assert (Heq: nested_field_type T gfs = Tunion id noattr)
            by (unfold id,T; reflexivity);
      let H := fresh in
-     assert (H:= @field_at_Tunion cs sh T gfs id noattr
+     assert (H:= field_at_Tunion(cs := cs) sh T gfs id noattr
                           V V P  (eq_refl _) (JMeq_refl _));
-     unfold id in H; clear Heq id;
-     fold F in H; clearbody F;
+     unfold id in HF; clear Heq id;
+     fold F in HF; clearbody F;
+     (* need to pick out RHS before simpl it since bi_equiv obstructs simpl *)
+     let H := fresh "H" in
+     match goal with
+       | HF: (_ ⊣⊢ ?RHS) |- _ => 
+     set (H:= RHS)  end;
+     fold H in HF;
      simpl co_members in H;
      lazy beta iota zeta delta  [nested_ufieldlist_at ] in H;
-     change (@field_at cs sh T) with (@field_at cs sh t) in H;
+     change (field_at(cs := cs) sh T) with (field_at(cs := cs) sh t) in H;
      hnf in T; subst T;
      change v with (protect _ v) in V;
      simpl in H;
@@ -75,8 +89,10 @@ Ltac unfold_field_at' :=
      | context[fst (?A,?B)] => change (fst (A,B)) with A in H
      | context[snd (?A,?B)] => change (snd (A,B)) with B in H
      end;
-     subst P;
-     subst F;
+     subst P; 
+     subst H;
+     rewrite HF;
+     clear HF F;
      cbv beta;
      repeat flatten_sepcon_in_SEP;
      repeat simplify_project_default_val
@@ -104,20 +120,20 @@ Tactic Notation "unfold_data_at" uconstr(a) :=
   lazymatch goal with
   | x := ?D : mpred |- _ =>
     match D with
-     | (@data_at_ ?cs ?sh ?t ?p) =>
-            change D with (@field_at_mark cs sh t (@nil gfield) (@default_val cs (@nested_field_type cs t nil)) p) in x
-     | (@data_at ?cs ?sh ?t ?v ?p) =>
-            change D with (@field_at_mark cs sh t (@nil gfield) v p) in x
-     | (@field_at_ ?cs ?sh ?t ?gfs ?p) =>
-            change D with (@field_at_mark cs sh t gfs (@default_val cs (@nested_field_type cs t gfs)) p) in x
-     | (@field_at ?cs ?sh ?t ?gfs ?v ?p) =>
-            change D with (@field_at_mark cs sh t gfs v p) in x
+     | (data_at_(cs := ?cs) ?sh ?t ?p) =>
+            change D with (field_at_mark cs sh t (@nil gfield) (@default_val cs (@nested_field_type cs t nil)) p) in x
+     | (data_at(cs := ?cs) ?sh ?t ?v ?p) =>
+            change D with (field_at_mark cs sh t (@nil gfield) v p) in x
+     | (field_at_(cs := ?cs) ?sh ?t ?gfs ?p) =>
+            change D with (field_at_mark cs sh t gfs (@default_val cs (@nested_field_type cs t gfs)) p) in x
+     | (field_at(cs := ?cs) ?sh ?t ?gfs ?v ?p) =>
+            change D with (field_at_mark cs sh t gfs v p) in x
      end;
         subst x;  unfold_field_at';
-   repeat match goal with |- context [@field_at ?cs ?sh ?t ?gfs (@default_val ?cs' ?t') ?p] => 
-       change (@field_at cs sh t gfs (default_val cs' t') p) with (@field_at_ cs sh t gfs p)
-    end
-end).
+     repeat match goal with |- context [field_at(cs := ?cs) ?sh ?t ?gfs (@default_val ?cs' ?t') ?p] => 
+       change (field_at(cs := cs) sh t gfs (default_val cs' t') p) with (field_at_(cs := cs) sh t gfs p)
+     end
+  end).
 
 Tactic Notation "unfold_field_at" uconstr(a) :=
  tryif (is_nat_uconstr a)
@@ -126,4 +142,3 @@ Tactic Notation "unfold_field_at" uconstr(a) :=
      let x := constr:(a) in unfold_field_at_tac x
    )
  else unfold_data_at a.
-
diff --git a/floyd/val_lemmas.v b/floyd/val_lemmas.v
index 1e24c71025..2c0757fe9f 100644
--- a/floyd/val_lemmas.v
+++ b/floyd/val_lemmas.v
@@ -1,6 +1,8 @@
 From compcert Require Export Clightdefs.
 Require Export VST.veric.base.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Export VST.veric.SeparationLogic.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Export VST.msl.Extensionality.
 Require Export compcert.lib.Coqlib.
 Require Export VST.msl.Coqlib2 VST.veric.coqlib4 VST.floyd.coqlib3.
@@ -21,9 +23,9 @@ destruct i.
       destruct (zle (Int.signed i0) Byte.max_signed). left; lia. right; lia.
     * destruct (zle (Int.unsigned i0) Byte.max_unsigned). left; lia. right; lia.
 + destruct s.
-    * destruct (zle (-32768) (Int.signed i0)); [| right; lia].
-      destruct (zle (Int.signed i0) 32767). left; lia. right; lia.
-    * destruct (zle (Int.unsigned i0) 65535). left; lia. right; lia.
+    * destruct (zle (-two_power_pos 15) (Int.signed i0)); [| right; lia].
+      destruct (zle (Int.signed i0) (two_power_pos 15 - 1)). left; lia. right; lia.
+    * destruct (zle (Int.unsigned i0) (two_power_pos 16 - 1)). left; lia. right; lia.
 + left; trivial.
 + destruct (Int.eq_dec i0 Int.zero); subst. left; left; trivial.
     destruct (Int.eq_dec i0 Int.one); subst. left; right; trivial.
@@ -38,7 +40,7 @@ Proof. destruct t; simpl.
 + destruct f. apply is_single_dec. apply is_float_dec.
 + destruct ((eqb_type t Ctypes.Tvoid &&
     eqb_attr a
-      {| attr_volatile := false; attr_alignas := Some log2_sizeof_pointer |})%bool).
+      {| attr_volatile := false; attr_alignas := Some log2_sizeof_pointer |} )%bool).
   apply is_pointer_or_integer_dec.
   apply is_pointer_or_null_dec.
 + apply is_pointer_or_null_dec.
@@ -61,8 +63,8 @@ Proof.
   unfold Cop.ptrofs_of_int, Ptrofs.of_ints, Ptrofs.of_intu, Ptrofs.of_int.
   f_equal. f_equal. f_equal.
   destruct si; rewrite <- ptrofs_mul_repr;  f_equal.
-  rewrite Int.signed_repr by lia; auto.
-  rewrite Int.unsigned_repr by lia; auto.
+  rewrite -> Int.signed_repr by lia; auto.
+  rewrite -> Int.unsigned_repr by lia; auto.
 Qed.
 #[export] Hint Rewrite @sem_add_pi_ptr using (solve [auto with norm]) : norm.
 
@@ -89,7 +91,7 @@ Proof.
 Qed.
 #[export] Hint Rewrite sem_cast_neutral_Vint : norm.
 
-Definition isVint v := match v with Vint _ => True | _ => False end.
+Definition isVint v : Prop := match v with Vint _ => True | _ => False end.
 
 Lemma is_int_is_Vint: forall i s v, is_int i s v -> isVint v.
 Proof. intros.
@@ -394,8 +396,8 @@ Lemma typed_false_tint:
  forall v, typed_false tint v -> v=nullval.
 Proof.
 intros.
- hnf in H0. destruct v; inv H0.
- destruct (Int.eq i Int.zero) eqn:?; inv H2.
+ hnf in H0. destruct v; inversion H0.
+ destruct (Int.eq i Int.zero) eqn:?; inversion H2.
  apply int_eq_e in Heqb. subst.
  inv H; reflexivity.
 Qed.
@@ -405,9 +407,9 @@ Lemma typed_false_tlong:
  forall v, typed_false tlong v -> v=nullval.
 Proof.
 intros. unfold nullval. rewrite H.
- hnf in H0. destruct v; inv H0.
+ hnf in H0. destruct v; inversion H0.
 pose proof (Int64.eq_spec i Int64.zero).
- destruct (Int64.eq i Int64.zero); inv H2.
+ destruct (Int64.eq i Int64.zero); inversion H2; subst.
 reflexivity.
 Qed.
 
@@ -435,7 +437,7 @@ Proof.
 intros.
 unfold typed_true, strict_bool_val in H. simpl in H.
 pose proof (Int.eq_spec v Int.zero).
-destruct (Int.eq v Int.zero); auto. inv H.
+destruct (Int.eq v Int.zero); auto.
 Qed.
 
 Lemma typed_true_tlong_Vlong:
@@ -444,7 +446,7 @@ Proof.
 intros.
 unfold typed_true, strict_bool_val in H. simpl in H.
 pose proof (Int64.eq_spec v Int64.zero).
-destruct (Int64.eq v Int64.zero); auto. inv H.
+destruct (Int64.eq v Int64.zero); auto.
 Qed.
 
 Lemma typed_false_tlong_Vlong:
@@ -466,7 +468,7 @@ Ltac fancy_intro aggressive :=
  lazymatch goal with
  | |- ?P -> _ => match type of P with Prop => idtac end
  end;
- tryif 
+ tryif
  lazymatch goal with |- ?P -> _ =>
      lazymatch P with
      | ptr_eq ?v1 ?v2 => intro_redundant (v1=v2)
@@ -486,7 +488,7 @@ Ltac fancy_intro aggressive :=
          | _ =>  intro_redundant (isptr v)
          end
      | ?x = ?y => constr_eq x y + intro_redundant P
-     | _ => intro_redundant P + unify P True
+     | _ => intro_redundant P + unify P True%type
     end
    end
    then intros _
@@ -554,7 +556,7 @@ Ltac fold_types1 :=
 
 Lemma is_int_Vbyte: forall c, is_int I8 Signed (Vbyte c).
 Proof.
-intros. simpl. normalize. rewrite Int.signed_repr by rep_lia. rep_lia.
+intros. simpl. rewrite -> Int.signed_repr by rep_lia. rep_lia.
 Qed.
 #[export] Hint Resolve is_int_Vbyte : core.
 
diff --git a/hmacdrbg/HMAC_DRBG_common_lemmas.v b/hmacdrbg/HMAC_DRBG_common_lemmas.v
index 12f6c157eb..e1ef074872 100644
--- a/hmacdrbg/HMAC_DRBG_common_lemmas.v
+++ b/hmacdrbg/HMAC_DRBG_common_lemmas.v
@@ -1,6 +1,6 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Import ListNotations.
-Local Open Scope logic.
 
 Require Import hmacdrbg.hmac_drbg.
 Require Import hmacdrbg.spec_hmac_drbg.
@@ -15,25 +15,25 @@ Qed.
 
 Lemma da_emp_isptrornull sh t v p :
    da_emp sh t v p = (!!is_pointer_or_null p) &&  da_emp sh t v p.
- Proof. unfold da_emp; apply pred_ext.
-  + apply orp_left.
-    - apply derives_extract_prop; intros; subst; simpl. entailer. apply orp_right1. auto.
-    - rewrite (data_at_isptr _ _ _ p) at 1. normalize.
-      destruct p; simpl in *; try contradiction. entailer. apply orp_right2. entailer.
-  + entailer.
+Proof.
+  unfold da_emp.
+  destruct (is_pointer_or_null_dec p).
+  + rewrite (prop_true_andp _ _ i); reflexivity.
+  + rewrite prop_false_andp by (intros ->; auto).
+    rewrite log_normalize.or_False.
+    unfold data_at, field_at; normalize.
+    f_equal; f_equal; apply prop_ext; intuition auto.
 Qed.
 
 Lemma da_emp_null sh t v p: p=nullval -> da_emp sh t v p = emp.
 Proof. intros; subst. unfold da_emp. rewrite data_at_isptr. unfold isptr. simpl.
-  apply pred_ext.
-  + normalize. apply orp_left. auto. normalize.
-  + simpl. apply orp_right1. entailer.
+  rewrite log_normalize.False_and, log_normalize.and_False, log_normalize.False_or.
+  rewrite prop_true_andp; auto.
 Qed.
 Lemma da_emp_ptr sh t v b i: da_emp sh t v (Vptr b i) = !! (sizeof t > 0) && data_at sh t v (Vptr b i).
 Proof. intros; unfold da_emp, nullval; simpl.
-  apply pred_ext.
-  + apply orp_left; normalize. inv H.
-  + apply orp_right2. auto.
+  rewrite prop_false_andp by discriminate.
+  rewrite log_normalize.or_False; reflexivity.
 Qed.
 
 Lemma false_zgt z a: false = (z >? a) -> z<=a. 
@@ -90,7 +90,7 @@ Lemma data_at_weak_valid_ptr: forall (sh : Share.t) (t : type) (v : reptype t) (
        sepalg.nonidentity sh ->
        (*sizeof cenv_cs t >= 0 -> *) sizeof t > 0 -> data_at sh t v p |-- weak_valid_pointer p.
 Proof. intros.
-eapply derives_trans. 2: apply valid_pointer_weak. apply data_at_valid_ptr; trivial. Qed.
+eapply derives_trans. 2: apply valid_pointer_weak. apply data_at_valid_ptr; auto. Qed.
 
 Lemma sublist_app_exact1:
   forall X (A B: list X), sublist 0 (Zlength A) (A ++ B) = A.
diff --git a/hmacdrbg/drbg_protocol_proofs.v b/hmacdrbg/drbg_protocol_proofs.v
index cdf4a8a688..19cc43c834 100644
--- a/hmacdrbg/drbg_protocol_proofs.v
+++ b/hmacdrbg/drbg_protocol_proofs.v
@@ -1,6 +1,6 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Import ListNotations.
-Local Open Scope logic.
 
 Require Import sha.general_lemmas.
 Require Import hmacdrbg.hmac_drbg.
@@ -40,7 +40,7 @@ Require hmacdrbg.verif_hmac_drbg_seed.
 Require Import VST.floyd.subsume_funspec.
 
 Lemma drb_seed_256_subsume:
-  NDfunspec_sub 
+  NDfunspec_sub
        (snd hmac_drbg_seed_inst256_spec)
        (snd drbg_seed_inst256_spec_abs).
 Proof.
@@ -50,11 +50,14 @@ intros [[[[[[[[[[[[[sh dp] ctx] info] len] data] Data]
                          Info] s] rc] pr_flag] ri] handle_ss] gv].
 unfold seedREP.
 intros [g args]. entailer. clear H.
-unfold LAMBDAx, PROPx, GLOBALSx, LOCALx, SEPx, argsassert2assert. simpl. Intros a.
-Exists (dp,  ctx, sh, info, Zlength Data, data, sh, Data, a, 
+unfold LAMBDAx, PROPx, GLOBALSx, LOCALx, SEPx, argsassert2assert. monPred.unseal. simpl. Intros a.
+rewrite <- fupd_intro.
+Exists (dp,  ctx, sh, info, Zlength Data, data, sh, Data, a,
               Info, s, rc, pr_flag, ri, handle_ss, gv).
-Exists emp.
+Exists (emp : mpred).
 rewrite emp_sepcon.
+simpl.
+apply andp_right; [apply prop_right; auto|].
 apply andp_right.
 *
 entailer!. apply andp_derives. trivial. cancel.
@@ -105,13 +108,13 @@ Proof.
   start_function.
   rename H into HDlen1; rename H0 into HDlen2.
   unfold seedbufREP.
-  rewrite extract_exists_in_SEP. Intros Ctx.
+  Intros Ctx.
   rename H into WF1. rename H0 into WF2. rename H1 into WF3.
   rewrite data_at_isptr with (p:=ctx). Intros.
   destruct ctx; try contradiction; clear Pctx.
   unfold_data_at 1%nat.
   destruct Ctx as [mds [V [RC [EL [PR RI]]]]]; simpl.
-  destruct mds as [M1 [M2 M3]]. 
+  destruct mds as [M1 [M2 M3]].
   freeze [1;2;3;4;5] FIELDS. unfold hmac256drbgstate_md_info_pointer; simpl.
   rewrite field_at_compatible'. Intros. rename H into FC_mdx.
   rewrite field_at_data_at. unfold field_address. simpl. rewrite if_true; trivial. rewrite ptrofs_add_repr_0_r.
@@ -119,7 +122,7 @@ Proof.
   time forward_call ((M1,(M2,M3)), Vptr b i, sh, Vint (Int.repr 1), info, gv).
 
   Intros v. rename H into Hv. simpl.
-  freeze [0] FR1. forward. thaw FR1. 
+  freeze [0] FR1. forward. thaw FR1.
   forward_if.
   { destruct Hv; try lia. rewrite if_false; trivial.
     forward. Exists (Vint (Int.repr (-20864))). rewrite if_true; trivial.
@@ -223,8 +226,8 @@ Proof.
   rename H1 into BOUND.
   rename v_seed into seed.
   unfold AREP. focus_SEP 2.
-  rewrite extract_exists_in_SEP. Intros Info. unfold REP.
-  rewrite extract_exists_in_SEP. Intros i. rename H into WFI. 
+  Intros Info. unfold REP.
+  Intros i. rename H into WFI. 
   destruct I.
   destruct i as [md_ctx' [V' [reseed_counter' [entropy_len' [prediction_resistance' reseed_interval']]]]].
   unfold hmac256drbg_relate.
@@ -246,7 +249,7 @@ Proof.
     { subst contents'. unfold contents_with_add.
       destruct (eq_dec add_len 0); simpl.
         rewrite andb_false_r. left; apply Zlength_nil.
-        destruct (EqDec_val additional nullval); simpl. left; apply Zlength_nil.
+        destruct (eq_dec additional nullval); simpl. left; apply Zlength_nil.
         right; trivial.
     }
 
@@ -434,14 +437,14 @@ Proof.
   }
  unfold hmac256drbgstate_md_info_pointer; entailer!! .
   1,2,3: subst POSTCONDITION; unfold abbreviate; simpl_ret_assert; normalize.
- 
+
   intros.
-  unfold POSTCONDITION, abbreviate.  simpl_ret_assert. go_lowerx.
+  unfold POSTCONDITION, abbreviate.  simpl_ret_assert. unfold bind_ret; go_lowerx.
   unfold reseedPOST; destruct vl; trivial; try apply derives_refl. simpl. Intros.
   apply andp_right. apply prop_right;  trivial.
   unfold_lift.
   apply sepcon_derives; [ normalize; simpl; Intros | apply derives_refl].
-  Exists v. rewrite <- Heqcontents' in *.  
+  Exists v. rewrite <- Heqcontents' in *.
   unfold hmac256drbgabs_common_mpreds, hmac256drbgstate_md_info_pointer; simpl.
   remember (mbedtls_HMAC256_DRBG_reseed_function s
               (HMAC256DRBGabs key V reseed_counter entropy_len
@@ -480,37 +483,36 @@ Proof.
   start_function.
   rename H0 into M. destruct H as [N1 N2].
   unfold AREP. focus_SEP 1.
-  rewrite extract_exists_in_SEP. Intros Info. unfold REP.
-  rewrite extract_exists_in_SEP. Intros i. 
+  Intros Info. unfold REP.
+  Intros i.
   destruct H as [WF1 [WF2 [WF3 [WF4 WF5]]]].
   forward. simpl.
   forward_call (@nil byte, nullval, Tsh, Z0, output, sho, n, ctx, shc, i,
                 I, Info, s, gv).
   { rewrite da_emp_null; trivial. cancel. }
-  { lia. }
   Intros v. forward. unfold HMAC256_DRBG_bridge_to_FCF.mbedtls_generate in M.
   remember (mbedtls_HMAC256_DRBG_generate_function s I n []) as q; destruct q; try discriminate. 
   destruct p as [bytes' J].
   destruct J as [[[[V K] RC] x] PR]. inv M.
-  unfold generatePOST, contents_with_add; simpl. 
-  apply Zgt_is_gt_bool_f in N2. rewrite N2 in *. 
+  unfold generatePOST, contents_with_add; simpl.
+  apply Zgt_is_gt_bool_f in N2. rewrite N2 in *.
   rewrite <- Heqq in *.
   unfold return_value_relate_result, da_emp; simpl. 
   symmetry in Heqq.
   apply AUX in Heqq. rewrite Heqq.
   Intros. inversion H; clear H; subst v.
   assert_PROP (n=Zlength(map Vubyte bytes)) as HN by entailer!.
-  entailer!. 
+  entailer!.
   Exists Info
      (hmac256drbgabs_to_state
        (hmac256drbgabs_generate I s (Zlength (map Vubyte bytes)) []) i).
   rewrite Heqq. unfold hmac256drbgabs_common_mpreds. 
-  normalize. 
-  apply andp_right. 
+  normalize.
+  apply andp_right.
   + apply prop_right. red. simpl.
     apply hmac256drbgabs_generateWF in Heqq. intuition.
-    lia. intuition. red in WF3. clear - WF3. lia. 
-  + cancel. 
+    lia. intuition. red in WF3. clear - WF3. lia.
+  + cancel.
     apply orp_left; [ trivial | normalize]. inv H2.
 Time Qed. (*Coq8.6: 2.3secs*)
 
@@ -521,19 +523,18 @@ Proof.
   start_function.
   destruct H as [N1 N2]. rename H0 into M.
   unfold AREP. focus_SEP 1.
-  rewrite extract_exists_in_SEP. Intros Info. unfold REP.
-  rewrite extract_exists_in_SEP. Intros i. 
+  Intros Info. unfold REP.
+  Intros i.
   destruct H as [WF1 [WF2 [WF3 [WF4 WF5]]]].
   forward. simpl.
   forward_call (@nil byte, nullval, Tsh, Z0, output, sho, n, ctx, shc, i, 
                 I, Info, s, gv).
   { rewrite da_emp_null; trivial. cancel. }
-  { lia. }
   Intros v. forward. destruct J as [[[[V K] RC] x] PR].
-  unfold generatePOST, contents_with_add; simpl. 
-  apply Zgt_is_gt_bool_f in N2. rewrite N2 in *. 
+  unfold generatePOST, contents_with_add; simpl.
+  apply Zgt_is_gt_bool_f in N2. rewrite N2 in *.
   rewrite M in *.
-  unfold return_value_relate_result, da_emp; simpl. 
+  unfold return_value_relate_result, da_emp; simpl.
   Exists (hmac256drbgabs_generate I s n []).
   apply AUX in M. rewrite <- M.
   Intros. inversion H; clear H; subst v.
@@ -544,10 +545,10 @@ Proof.
        (hmac256drbgabs_generate I s (Zlength (map Vubyte bytes)) []) i).
   unfold hmac256drbgabs_common_mpreds; simpl.
   normalize.
-  apply andp_right. 
+  apply andp_right.
   + apply prop_right. rewrite M; red. simpl.
     apply hmac256drbgabs_generateWF in M. intuition.
-    lia. intuition. red in WF3. lia. 
+    lia. intuition. red in WF3. lia.
   + cancel.
     apply orp_left; [ trivial | normalize]. inv H2.
 Time Qed. (*Coq8.6: 2.3secs*)
@@ -577,9 +578,9 @@ Proof. start_function.
   rename v_K into K. rename v_sep into sep.
   rename H into AL1. rename H0 into HAL.
   unfold AREP. focus_SEP 2.
-  rewrite extract_exists_in_SEP. Intros Info.
-  unfold REP. 
-  rewrite extract_exists_in_SEP. Intros i.
+  Intros Info.
+  unfold REP.
+  Intros i.
   rename H into WFI.
   destruct i as [IS1 [IS2 [IS3 [IS4 [IS5 IS6]]]]].
   rewrite da_emp_isptrornull.
@@ -610,13 +611,13 @@ Proof. start_function.
       subst i; simpl. entailer!. (* simpl. *)
       thaw FR2. thaw FR1. thaw FR0. normalize.
       rewrite da_emp_ptr. normalize.
-      auto 50 with valid_pointer. (* TODO regression, this should have solved it *)
+      auto 50 with nocore valid_pointer. (* TODO regression, this should have solved it *)
     }
 
     { entailer!.
       destruct additional; simpl in PNadditional; try contradiction.
       subst i; simpl; trivial.
-      simpl. destruct (EqDec_Z add_len 0); trivial; lia.
+      simpl. destruct (eq_dec add_len 0); trivial; lia.
     }
   }
 
@@ -641,7 +642,7 @@ Proof. start_function.
 
   forward. 
   (*deadvars!. VST Issue: statement IS a semax (but with an unabbreviated statement - abbreviate_semax also fails*)
-  drop_LOCAL 1%nat. (*_t'3*) 
+  drop_LOCAL 1%nat. (*_t'3*)
   remember (hmac256drbgabs_key I) as initial_key.
   remember (hmac256drbgabs_value I) as initial_value.
 
@@ -732,17 +733,17 @@ Proof. start_function.
 
     (* mbedtls_md_hmac_reset( &ctx->md_ctx ); *)
     Time forward_call (field_address t_struct_hmac256drbg_context_st [StructField _md_ctx] ctx,
-                       (*md_ctx*)(IS1a, (IS1b, IS1c)), shc, key, gv). 
+                       (*md_ctx*)(IS1a, (IS1b, IS1c)), shc, key, gv).
     unfold md_full; simpl; cancel.
     (* mbedtls_md_hmac_update( &ctx->md_ctx, ctx->V, md_len ); *)
     thaw FR3. rewrite <- H4. freeze [3;4;5;6;8] FR4.
     Time forward_call (key, field_address t_struct_hmac256drbg_context_st [StructField _md_ctx] ctx,
                        (*md_ctx*)(IS1a, (IS1b, IS1c)), shc,
                        field_address t_struct_hmac256drbg_context_st [StructField _V] ctx, shc,
-                       @nil byte, V, gv). 
+                       @nil byte, V, gv).
     { rewrite H4. compute; auto.
     }
-    Intros. 
+    Intros.
     simpl.
     assert (Hiuchar: Int.zero_ext 8 (Int.repr i) = Int.repr i).
     {
@@ -756,14 +757,14 @@ Proof. start_function.
     Time forward_call (key, field_address t_struct_hmac256drbg_context_st [StructField _md_ctx] ctx,
                        (*md_ctx*)(IS1a, (IS1b, IS1c)), shc, sep, Tsh, V, [Byte.repr i], gv). 
     simpl map. replace (Vint (Int.repr i)) with (Vubyte (Byte.repr i)). cancel.
-    unfold Vubyte. f_equal. clear - Heqrounds H. 
+    unfold Vubyte. f_equal. clear - Heqrounds H.
     rewrite Byte.unsigned_repr by (destruct na; rep_lia); auto.
     { 
       (* prove the PROP clauses *)
       rewrite H4.
       change (Zlength [Byte.repr i]) with 1. split; auto.
     }
-    Intros. 
+    Intros.
 
     (* if( rounds == 2 ) *)
      thaw FR5.
@@ -814,7 +815,7 @@ Proof. start_function.
       (* prove the post condition of the if statement *)
       rewrite <- app_assoc.
       rewrite H4. rewrite da_emp_ptr.
-      entailer!. 
+      entailer!.
     }
     {
       (* rounds <> 2 case *)
@@ -828,7 +829,7 @@ Proof. start_function.
       forward. rewrite H4, NAF.
       destruct additional; try contradiction; simpl in PNadditional.
       + subst i0. rewrite da_emp_null; trivial. go_lower; simpl; entailer!.
-      + rewrite da_emp_ptr. Intros. entailer!. 
+      + rewrite da_emp_ptr. Intros. entailer!.
     }
 
     (* mbedtls_md_hmac_finish( &ctx->md_ctx, K ); *)
@@ -837,7 +838,7 @@ Proof. start_function.
     Intros.
     Time forward_call ((V ++ [Byte.repr i] ++ (if na then contents else [])), key,
                        field_address t_struct_hmac256drbg_context_st [StructField _md_ctx] ctx,
-                       (*md_ctx*)(IS1a, (IS1b, IS1c)), shc, K, Tsh, gv). 
+                       (*md_ctx*)(IS1a, (IS1b, IS1c)), shc, K, Tsh, gv).
         sep_apply (memory_block_data_at__tarray_tuchar Tsh K 32).
         rep_lia. cancel.
     Intros.
@@ -847,20 +848,20 @@ Proof. start_function.
     thaw FR9.
     replace_SEP 1 (md_empty (IS1a, (IS1b, IS1c))).
        { entailer!; unfold md_empty, md_full; simpl; cancel.
-         apply UNDER_SPEC.FULL_EMPTY. } 
+         apply UNDER_SPEC.FULL_EMPTY. }
     (* mbedtls_md_hmac_starts( &ctx->md_ctx, K, md_len ); *)
     Time forward_call (field_address t_struct_hmac256drbg_context_st [StructField _md_ctx] ctx, shc,
-                       (*md_ctx*)(IS1a, (IS1b, IS1c)), 
+                       (*md_ctx*)(IS1a, (IS1b, IS1c)),
                        (Zlength (HMAC256 (V ++ [Byte.repr i] ++ (if na then contents else [])) key)),
                        HMAC256 (V ++ [Byte.repr i] ++ (if na then contents else [])) key, sk, ik, Tsh, gv). 
     {
       (* prove the function parameters match up *)
-      apply prop_right. 
+      apply prop_right.
       rewrite hmac_common_lemmas.HMAC_Zlength, FA_ctx_MDCTX; simpl.
       rewrite offset_val_force_ptr, isptr_force_ptr; trivial.
     }
-    rewrite hmac_common_lemmas.HMAC_Zlength. cancel. 
-    { split; auto. 
+    rewrite hmac_common_lemmas.HMAC_Zlength. cancel.
+    { split; auto.
       (* prove that output of HMAC can serve as its key *)
         unfold spec_hmac.has_lengthK; simpl.
         rewrite hmac_common_lemmas.HMAC_Zlength;
@@ -877,7 +878,7 @@ Proof. start_function.
     {
       (* prove the function parameters match up *)
       rewrite H4, FA_ctx_V, FA_ctx_MDCTX. apply prop_right. simpl.
-      destruct ctx; try contradiction. simpl. 
+      destruct ctx; try contradiction. simpl.
       rewrite ptrofs_add_repr_0_r; trivial.
     }
     { 
@@ -915,12 +916,12 @@ Proof. start_function.
     unfold hmac256drbgabs_common_mpreds, hmac256drbgabs_to_state.
     unfold hmac256drbg_relate.
     rewrite hmac_common_lemmas.HMAC_Zlength. rewrite hmac_common_lemmas.HMAC_Zlength.
-    
+
     cancel; unfold md_full; entailer!.
     unfold_data_at 3%nat.
     thaw OtherFields. cancel.
   }
-  Intros key value final_state_abs. 
+  Intros key value final_state_abs.
   assert (UPD: hmac256drbgabs_hmac_drbg_update I (contents_with_add additional add_len contents) = final_state_abs).
   { destruct I; destruct final_state_abs. destruct H2 as [? [? [? ?]]]; subst.  
     clear - HAL H. simpl in H.
@@ -944,16 +945,16 @@ Lemma body_hmac_drbg_setEntropyLen:
       f_mbedtls_hmac_drbg_set_entropy_len drbg_setEntropyLen_spec_abs.
 Proof.
   start_function. unfold AREP.
-  rewrite extract_exists_in_SEP. Intros Info.
-  unfold REP. 
-  rewrite extract_exists_in_SEP. Intros a.
+  Intros Info.
+  unfold REP.
+  Intros a.
   destruct a as [md_ctx [V [rc [el [pr ri]]]]].
   destruct A as [K VV RC EL PR RI].
   unfold hmac256drbg_relate. normalize.
   rewrite data_at_isptr. Intros. destruct ctx; try contradiction.
   unfold_data_at 1%nat.
   freeze [0;1;2;4;5;6;7;8] FR. forward. entailer!.
-  unfold AREP, REP. 
+  unfold AREP, REP.
   Exists Info (md_ctx,
      (map Vubyte VV,
      (Vint (Int.repr RC),
@@ -968,16 +969,16 @@ Lemma body_hmac_drbg_setPredictionResistance:
       f_mbedtls_hmac_drbg_set_prediction_resistance drbg_setPredictionResistance_spec_abs.
 Proof.
   start_function. unfold AREP.
-  rewrite extract_exists_in_SEP. Intros Info.
-  unfold REP. 
-  rewrite extract_exists_in_SEP. Intros a.
+  Intros Info.
+  unfold REP.
+  Intros a.
   destruct a as [md_ctx [V [rc [el [pr ri]]]]].
   destruct A as [K VV RC EL PR RI].
   unfold hmac256drbg_relate. normalize.
   rewrite data_at_isptr. Intros. destruct ctx; try contradiction.
-  unfold_data_at 1%nat. 
+  unfold_data_at 1%nat.
   freeze [0;1;2;3;5;6;7;8] FR. forward. entailer!.
-  unfold AREP, REP. 
+  unfold AREP, REP.
   Exists Info (md_ctx,
      (map Vubyte VV,
      (Vint (Int.repr RC),
@@ -991,21 +992,21 @@ Lemma body_hmac_drbg_setReseedInterval:
       f_mbedtls_hmac_drbg_set_reseed_interval drbg_setReseedInterval_spec_abs.
 Proof.
   start_function. unfold AREP.
-  rewrite extract_exists_in_SEP. Intros Info.
-  unfold REP. 
-  rewrite extract_exists_in_SEP. Intros a.
+  Intros Info.
+  unfold REP.
+  Intros a.
   destruct a as [md_ctx [V [rc [el [pr z]]]]].
   destruct A as [K VV RC EL PR RI].
   unfold hmac256drbg_relate. normalize.
   rewrite data_at_isptr. Intros. destruct ctx; try contradiction.
   unfold_data_at 1%nat.
   freeze [0;1;2;3;4;6;7;8] FR. forward. entailer!.
-  unfold AREP, REP. 
+  unfold AREP, REP.
   Exists Info (md_ctx,
      (map Vubyte VV,
      (Vint (Int.repr RC),
      (Vint (Int.repr EL), (bool2val PR, Vint (Int.repr ri)))))).
-  simpl; entailer!. 
+  simpl; entailer!.
   + red; simpl. red in H0; simpl in H0. intuition.
-  + unfold_data_at 1%nat; thaw FR; cancel. 
+  + unfold_data_at 1%nat; thaw FR; cancel.
 Time Qed. (*1.8s*)
diff --git a/hmacdrbg/drbg_protocol_specs.v b/hmacdrbg/drbg_protocol_specs.v
index 09f4d3e210..88bc483036 100644
--- a/hmacdrbg/drbg_protocol_specs.v
+++ b/hmacdrbg/drbg_protocol_specs.v
@@ -1,6 +1,6 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Import ListNotations.
-Local Open Scope logic.
 
 Require Import sha.general_lemmas.
 Require Import hmacdrbg.hmac_drbg.
@@ -15,7 +15,7 @@ Require Import VST.floyd.library.
 Require Import hmacdrbg.HMAC256_DRBG_bridge_to_FCF.
 
 Definition WF (I:hmac256drbgabs):=
-         Zlength (hmac256drbgabs_value I) = 32 /\ 
+         Zlength (hmac256drbgabs_value I) = 32 /\
          0 < hmac256drbgabs_entropy_len I <= 384 /\
          RI_range (hmac256drbgabs_reseed_interval I) /\
          0 <= hmac256drbgabs_reseed_counter I < Int.max_signed.
diff --git a/hmacdrbg/hmac_drbg_compspecs.v b/hmacdrbg/hmac_drbg_compspecs.v
index 8aac6f316d..921d21431e 100644
--- a/hmacdrbg/hmac_drbg_compspecs.v
+++ b/hmacdrbg/hmac_drbg_compspecs.v
@@ -17,9 +17,9 @@ Global Instance CompSpecs_Preserve: change_composite_env
 Global Instance CompSpecs_Preserve': change_composite_env 
              CompSpecs spec_hmac.CompSpecs := ltac:(make_cs_preserve').
 
-Lemma change_compspecs_data_block: forall sh v,
-  @data_block spec_hmac.CompSpecs sh v =
-  @data_block CompSpecs sh v.
+Lemma change_compspecs_data_block: forall sh v p,
+  @data_block spec_hmac.CompSpecs sh v p ⊣⊢
+  @data_block CompSpecs sh v p.
 Proof.
   intros.
   unfold data_block.
@@ -29,10 +29,10 @@ Qed.
 Ltac change_compspecs' cs cs' ::=
   match goal with
   | |- context [@data_block cs'] => rewrite change_compspecs_data_block
-  | |- context [@data_at cs' ?sh ?t ?v1] => erewrite (@data_at_change_composite cs' cs _ sh t); [| apply JMeq_refl | reflexivity]
-  | |- context [@field_at cs' ?sh ?t ?gfs ?v1] => erewrite (@field_at_change_composite cs' cs _ sh t gfs); [| apply JMeq_refl | reflexivity]
-  | |- context [@data_at_ cs' ?sh ?t] => erewrite (@data_at__change_composite cs' cs _ sh t); [| reflexivity]
-  | |- context [@field_at_ cs' ?sh ?t ?gfs] => erewrite (@field_at__change_composite cs' cs _ sh t gfs); [| reflexivity]
+  | |- context [data_at(cs := cs') ?sh ?t ?v1] => erewrite (data_at_change_composite(cs_from := cs') (cs_to := cs) sh t); [| apply JMeq_refl | reflexivity]
+  | |- context [field_at(cs := cs') ?sh ?t ?gfs ?v1] => erewrite (field_at_change_composite(cs_from := cs') (cs_to := cs) sh t gfs); [| apply JMeq_refl | reflexivity]
+  | |- context [data_at_(cs := cs') ?sh ?t] => erewrite (data_at__change_composite(cs_from := cs') (cs_to := cs) sh t); [| reflexivity]
+  | |- context [field_at_(cs := cs') ?sh ?t ?gfs] => erewrite (field_at__change_composite(cs_from := cs') (cs_to := cs) sh t gfs); [| reflexivity]
   | |- context [?A cs'] => change (A cs') with (A cs)
   | |- context [?A cs' ?B] => change (A cs' B) with (A cs B)
   | |- context [?A cs' ?B ?C] => change (A cs' B C) with (A cs B C)
@@ -40,4 +40,3 @@ Ltac change_compspecs' cs cs' ::=
   | |- context [?A cs' ?B ?C ?D ?E] => change (A cs' B C D E) with (A cs B C D E)
   | |- context [?A cs' ?B ?C ?D ?E ?F] => change (A cs' B C D E F) with (A cs B C D E F)
  end.
-
diff --git a/hmacdrbg/spec_hmac_drbg.v b/hmacdrbg/spec_hmac_drbg.v
index 91ab5d1885..04115e29ff 100644
--- a/hmacdrbg/spec_hmac_drbg.v
+++ b/hmacdrbg/spec_hmac_drbg.v
@@ -1,13 +1,12 @@
 Require Import VST.floyd.proofauto.
 Import ListNotations.
-Local Open Scope logic.
 
 Require Import hmacdrbg.hmac_drbg.
 Require Import hmacdrbg.HMAC256_DRBG_functional_prog.
 Require Import hmacdrbg.DRBG_functions.
 Require Import hmacdrbg.HMAC_DRBG_algorithms.
 Require Import hmacdrbg.entropy.
-Require Import sha.protocol_spec_hmac. 
+Require Import sha.protocol_spec_hmac.
 Require Import sha.vst_lemmas.
 Require Import sha.HMAC256_functional_prog.
 
@@ -20,8 +19,8 @@ Require Export hmacdrbg.hmac_drbg_compspecs.
 (*Require Import VST.floyd.Funspec_old_Notation.*)
 
 Ltac fix_hmacdrbg_compspecs :=
-  rewrite (@data_at__change_composite spec_hmac.CompSpecs hmac_drbg_compspecs.CompSpecs
-            hmac_drbg_compspecs.CompSpecs_Preserve) by reflexivity.
+  rewrite (data_at__change_composite(cs_from := spec_hmac.CompSpecs)(cs_to := hmac_drbg_compspecs.CompSpecs)
+            (CCE := hmac_drbg_compspecs.CompSpecs_Preserve)) by reflexivity.
 
 Declare Module UNDER_SPEC : HMAC_ABSTRACT_SPEC.
 Definition mdstate: Type := (val * (val * val))%type.
@@ -53,13 +52,13 @@ intros. unfold md_full, md_empty. cancel. apply UNDER_SPEC.FULL_EMPTY.
 Qed.
 
 Lemma md_empty_unfold: forall (r: mdstate), 
-       md_empty r = 
+       md_empty r ⊣⊢
        malloc_token Ews (Tstruct _hmac_ctx_st noattr) (snd (snd r)) *
        data_at_ Ews (Tstruct _hmac_ctx_st noattr) (snd (snd r)).
 Proof.
 intros.
 unfold md_empty.
-f_equal.
+f_equiv.
 symmetry.
 apply pred_ext.
 eapply derives_trans; [ | apply UNDER_SPEC.mkEmpty].
@@ -130,7 +129,7 @@ Definition drbg_memset_spec := (_memset, snd spec_sha.memset_spec).
 Definition drbg_memcpy_spec := (_memcpy, snd spec_sha.memcpy_spec). 
 *)
 
-Definition md_get_size_spec :=
+Definition md_get_size_spec : ident * funspec :=
   DECLARE _mbedtls_md_get_size
    WITH (*u:unit*)v:val
    PRE [ (*_md_info OF*) tptr (Tstruct _mbedtls_md_info_t noattr)]
@@ -899,8 +898,8 @@ Definition hmac_drbg_free_spec :=
 
 Definition HmacDrbgVarSpecs : varspecs := (sha._K256, tarray tuint 64)::nil.
 
-Definition ndfs_merge fA cA A PA QA FSA (HFSA: FSA = NDmk_funspec fA cA A PA QA) 
-                    fB cB B PB QB FSB (HFSB: FSB = NDmk_funspec fB cB B PB QB): option funspec.
+Definition ndfs_merge fA cA A PA QA (FSA : funspec) (HFSA: FSA = NDmk_funspec fA cA A PA QA)
+                    fB cB B PB QB (FSB : funspec) (HFSB: FSB = NDmk_funspec fB cB B PB QB): option funspec.
 destruct (eq_dec fA fB); subst.
 + destruct (eq_dec cA cB); subst.
   - apply Some. eapply (NDmk_funspec fB cB (A+B) 
@@ -964,35 +963,31 @@ Definition hmac_init_funspec:=
                   end).
 
 Lemma hmac_init_merge: 
-      ndfs_merge _ _ _ _ _ (snd UNDER_SPEC.hmac_reset_spec) (eq_refl _)
-                 _ _ _ _ _ (snd UNDER_SPEC.hmac_starts_spec) (eq_refl _)
-      = Some hmac_init_funspec.
+      equiv (ndfs_merge _ _ _ _ _ (snd UNDER_SPEC.hmac_reset_spec) (eq_refl _)
+                 _ _ _ _ _ (snd UNDER_SPEC.hmac_starts_spec) (eq_refl _))
+      (Some hmac_init_funspec).
 Proof. unfold ndfs_merge. simpl. rewrite if_true by trivial.
-f_equal. unfold hmac_init_funspec. simpl. 
-  apply semax_prog.funspec_eq; simpl.
-  + extensionality ts x.
+f_equiv. unfold hmac_init_funspec. simpl. unfold NDmk_funspec; f_equiv.
+  + intros x.
     destruct x as [[[[[c sh] l] key] gv] | [[[[[[[c sh] l] key] b] i] shk] gv]].
-    - unfold convertPre. simpl. unfold PROPx, LAMBDAx, GLOBALSx, LOCALx, SEPx.
+    - unfold convertPre, convertPre'. simpl. unfold PROPx, LAMBDAx, GLOBALSx, LOCALx, SEPx.
+      intros rho; monPred.unseal.
       apply pred_ext; simpl; intros.
-      * unfold argsassert2assert, local, lift1, liftx, lift; simpl. destruct x as [g args]. simpl.
-        normalize. destruct args; [ inv H |]. destruct args; [ inv H |]. destruct args; [ inv H |].
-        destruct args; [ | inv H]. 
-        unfold env_set, eval_id in *.  simpl in *. subst. entailer!.
-      * unfold argsassert2assert, local, lift1, liftx, lift; simpl. destruct x as [g args]. simpl.
-        normalize. entailer!.  discriminate. 
-    - unfold convertPre. simpl. unfold PROPx, LAMBDAx, GLOBALSx, LOCALx, SEPx.
-      change_compspecs CompSpecs.
+      * unfold argsassert2assert, local, lift1, liftx, lift; simpl. destruct rho as [g args]. simpl.
+        normalize. entailer!!.
+      * unfold argsassert2assert, local, lift1, liftx, lift; simpl. destruct rho as [g args]. simpl.
+        normalize. entailer!.
+    - unfold convertPre, convertPre'. simpl. unfold PROPx, LAMBDAx, GLOBALSx, LOCALx, SEPx.
+      intros rho; monPred.unseal. change_compspecs CompSpecs.
       apply pred_ext; simpl; intros.
-      * unfold argsassert2assert, local, lift1, liftx, lift; simpl. destruct x as [g args]. simpl.
-        normalize. destruct args; [ inv H |]. destruct args; [ inv H |]. destruct args; [ inv H |].
-        destruct args; [ | inv H]. 
-        unfold env_set, eval_id in *.  simpl in *. subst. entailer!.
-      * unfold argsassert2assert, local, lift1, liftx, lift; simpl. destruct x as [g args]. simpl.
+      * unfold argsassert2assert, local, lift1, liftx, lift; simpl. destruct rho as [g args]. simpl.
+        normalize. entailer!!.
+      * unfold argsassert2assert, local, lift1, liftx, lift; simpl. destruct rho as [g args]. simpl.
         normalize. entailer!.
-  + extensionality ts x.
+  + intros x.
     destruct x as [[[[[c sh] l] key] gv] | [[[[[[[c sh] l] key] b] i] shk] gv]].
     - auto.
-    - change_compspecs CompSpecs.
+    - intros rho; simpl. change_compspecs CompSpecs.
       auto.
 Qed.
 
@@ -1079,7 +1074,7 @@ Definition HmacDrbgFunSpecs : funspecs :=  ltac:(with_library prog (
   drbg_memcpy_spec:: drbg_memset_spec::
   sha.spec_hmac.sha256init_spec::sha.spec_hmac.sha256update_spec::sha.spec_hmac.sha256final_spec::nil)).
 
-Lemma datablock_NoVundef sh bytes v: data_block sh  bytes v |-- !!(v <> Vundef).
+Lemma datablock_NoVundef sh bytes v: data_block sh bytes v |-- !!(v <> Vundef).
 Proof. unfold data_block. entailer!. Qed.
 
-#[export] Hint Resolve datablock_NoVundef : saturate_local.
\ No newline at end of file
+#[export] Hint Resolve datablock_NoVundef : saturate_local.
diff --git a/hmacdrbg/verif_hmac_drbg_NISTseed.v b/hmacdrbg/verif_hmac_drbg_NISTseed.v
index d1c2279a5d..cb8907c120 100644
--- a/hmacdrbg/verif_hmac_drbg_NISTseed.v
+++ b/hmacdrbg/verif_hmac_drbg_NISTseed.v
@@ -1,6 +1,6 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Import ListNotations.
-Local Open Scope logic.
 Require Import VST.zlist.sublist.
 
 Require Import sha.HMAC256_functional_prog.
diff --git a/hmacdrbg/verif_hmac_drbg_generate.v b/hmacdrbg/verif_hmac_drbg_generate.v
index 24475daccb..155c9b3091 100644
--- a/hmacdrbg/verif_hmac_drbg_generate.v
+++ b/hmacdrbg/verif_hmac_drbg_generate.v
@@ -1,6 +1,6 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Import ListNotations.
-Local Open Scope logic.
 Require Import VST.zlist.sublist.
 
 Require Import sha.HMAC256_functional_prog.
@@ -982,12 +982,12 @@ Proof.
   }
   { forward. entailer!. subst after_reseed_add_len na.
     destruct should_reseed; simpl; trivial. rewrite andb_false_r. reflexivity.
-    destruct (EqDec_Z (Zlength contents)  0); simpl. 
+    destruct (eq_dec (Zlength contents)  0); simpl.
     + rewrite e. simpl. rewrite andb_false_r. reflexivity.
     + unfold bool2val; f_equal.
         rewrite (Int.eq_false (Int.repr (Zlength contents))); simpl.
-      destruct (EqDec_val additional nullval); try reflexivity. contradiction.
-      contradict n. apply repr_inj_unsigned in n; auto. rep_lia. 
+      destruct (eq_dec additional nullval); try reflexivity. contradiction.
+      contradict n. apply repr_inj_unsigned in n; auto. rep_lia.
   }
   { forward. rewrite H in *. entailer!. }
 
@@ -1010,14 +1010,14 @@ Proof.
     md_full key2 (mc1, (mc2, mc3))))).
    { change (na = true) in H. subst na.
      destruct should_reseed; simpl in PRS, H. rewrite andb_false_r in H; discriminate.
-     destruct (EqDec_Z (Zlength contents) 0); simpl in H.
+     destruct (eq_dec (Zlength contents) 0); simpl in H.
      { rewrite andb_false_r in H; discriminate. }
      rewrite andb_true_r in H.
      destruct additional; simpl in PNadditional; try contradiction.
      { subst i0; discriminate. }
-     destruct PRS as [? [? ?]]; subst key1 stream1 ctx1. clear H. 
+     destruct PRS as [? [? ?]]; subst key1 stream1 ctx1. clear H.
      
-       forward_call (contents, Vptr b0 i0, sha, after_reseed_add_len, 
+       forward_call (contents, Vptr b0 i0, sha, after_reseed_add_len,
                     (*ctx*)Vptr b i, shc, initial_state,I, Info, gv).
        { assert (FR: Frame = [data_at_ sho (tarray tuchar out_len) output * Stream s]).
          { subst Frame; reflexivity. }
@@ -1026,23 +1026,23 @@ Proof.
          thaw FR3. (*subst (*initial_state*) IC.*)
          unfold hmac256drbg_relate, hmac256drbgstate_md_info_pointer; simpl. cancel. entailer!. 
        }
-       { (*subst na.*)subst after_reseed_add_len. 
-         entailer. simpl.  progress entailer. unfold hmac256drbgabs_common_mpreds.
-         remember ( HMAC256_DRBG_update
+       { (*subst na.*)subst after_reseed_add_len.
+         entailer. simpl. unfold hmac256drbgabs_common_mpreds.
+         remember (HMAC256_DRBG_update
              (contents_with_add (Vptr b0 i0) (Zlength contents) contents) key
-             V) as UPD. destruct UPD as [KK VV]. simpl. 
+             V) as UPD. destruct UPD as [KK VV]. simpl.
          Exists (mc1, (mc2, mc3),
             (map Vubyte VV,
             (Vint (Int.repr reseed_counter),
             (Vint (Int.repr entropy_len),
             (bool2val prediction_resistance,
             Vint (Int.repr reseed_interval)))))) KK.
-         normalize.  
+         normalize.
          apply andp_right; [ apply prop_right | thaw FR3; cancel].
          split; [| repeat split; trivial].
-         exists b0, i0, VV. repeat split; trivial. }  
+         exists b0, i0, VV. repeat split; trivial. }
      }
-     { clear - H.  change (na=false) in H. forward. rewrite H in *. 
+     { clear - H.  change (na=false) in H. forward. rewrite H in *.
        Exists ctx1 key1. entailer!. simpl; auto. }
   Intros ctx2 key2. rename H into PUPD.
 
@@ -1054,7 +1054,7 @@ set (after_reseed_state_abs := if should_reseed
 
 assert (ZLength_ARSA_val: Zlength (hmac256drbgabs_value after_reseed_state_abs) = 32).
 { subst after_reseed_state_abs.
-  destruct should_reseed; trivial. 
+  destruct should_reseed; trivial.
   apply Zlength_hmac256drbgabs_reseed_value; trivial. }
 
 assert (RC_x: 0 <= hmac256drbgabs_reseed_counter after_reseed_state_abs < Int.max_signed).
@@ -1078,7 +1078,7 @@ set (after_update_state_abs := (if na then hmac256drbgabs_hmac_drbg_update I con
 
 assert (ZLength_AUSA_val: Zlength (hmac256drbgabs_value after_update_state_abs) = 32).
 { subst after_update_state_abs.
-  destruct na; trivial. apply Zlength_hmac256drbgabs_update_value. } 
+  destruct na; trivial. apply Zlength_hmac256drbgabs_update_value. }
 
 assert (RC_y: 0 <= hmac256drbgabs_reseed_counter after_update_state_abs < Int.max_signed).
 { subst after_update_state_abs.
@@ -1092,12 +1092,12 @@ apply semax_pre with (P':=
    LOCAL (temp _md_len (Vint (Int.repr 32)); temp _info mc1;
    temp _reseed_interval (Vint (Int.repr reseed_interval));
    temp _reseed_counter (Vint (Int.repr reseed_counter));
-   temp _prediction_resistance (bool2val prediction_resistance); 
-   temp _out output; temp _left (Vint (Int.repr out_len)); 
+   temp _prediction_resistance (bool2val prediction_resistance);
+   temp _out output; temp _left (Vint (Int.repr out_len));
    temp _ctx (Vptr b i); temp _p_rng (Vptr b i); temp _output output;
    temp _out_len (Vint (Int.repr out_len)); temp _additional additional;
    temp _add_len (Vint (Int.repr after_reseed_add_len)); gvars gv)
-   SEP (data_at_ sho (tarray tuchar out_len) output; Stream stream1; 
+   SEP (data_at_ sho (tarray tuchar out_len) output; Stream stream1;
      K_vector gv;
      da_emp sha (tarray tuchar (Zlength contents)) (map Vubyte contents) additional;
      after_update_Mpred ))).
@@ -1118,11 +1118,11 @@ apply semax_pre with (P':=
     destruct PRS as [VV [KK [aa [zz [cc [ss [HM [? [? ?]]]]]]]]]. subst ss KK ctx1; rewrite HM in *.
     remember (HMAC256_DRBG_update contents key V) as UPD; destruct UPD as [KKK VVV].
     subst M after_reseed_state_abs. subst h; simpl in *.
-    destruct PUPD; subst key2 ctx2. entailer!. 
+    destruct PUPD; subst key2 ctx2. entailer!.
   + destruct PRS as [? [? ?]]; subst stream1 key1 ctx1 after_reseed_state_abs.
-    destruct (EqDec_val additional nullval); simpl in *.
+    destruct (eq_dec additional nullval); simpl in *.
     - destruct PUPD; subst ctx2 key2 na h; simpl in *. entailer!.
-    - remember (EqDec_Z (Zlength contents) 0) as q; destruct q; simpl in *. 
+    - remember (eq_dec (Zlength contents) 0) as q; destruct q; simpl in *. 
       * destruct PUPD; subst ctx2 key2 na h; simpl in *. entailer!. 
       * destruct PUPD as [bb [ii [UVAL [ADD [HUPD CTX2 ]]]]]. 
         unfold contents_with_add in HUPD. simpl in HUPD; rewrite <- Heqq in HUPD; simpl in HUPD.  
@@ -1318,8 +1318,8 @@ Opaque hmac256drbgabs_reseed.
        (contents_with_add additional (Zlength contents) contents)).
 Transparent hmac256drbgabs_generate. 
     unfold hmac256drbgabs_generate.
-Opaque hmac256drbgabs_generate. rewrite <- Heqr. 
-    rewrite !sepcon_assoc.
+Opaque hmac256drbgabs_generate. rewrite <- Heqr.
+    rewrite <- !sepcon_assoc.
     apply sepcon_derives. apply derives_refl.
     remember ( (hmac256drbgabs_generate
         (HMAC256DRBGabs key V reseed_counter entropy_len
@@ -1327,6 +1327,6 @@ Opaque hmac256drbgabs_generate. rewrite <- Heqr.
         (contents_with_add additional (Zlength contents) contents))). destruct h. simpl.
     destruct a as [? [? [? [? [? ?]]]]]. normalize.
     destruct r.
-    - destruct p as [? [? ?]]. destruct p as [[[? ?] ?] ?]. simpl. entailer!. 
+    - destruct p as [? [? ?]]. destruct p as [[[? ?] ?] ?]. simpl. entailer!.
     - simpl. entailer!.
 Time Qed. (*Coq 8.10.1: 26s; was: Desktop:83ss*) 
\ No newline at end of file
diff --git a/hmacdrbg/verif_hmac_drbg_generate_abs.v b/hmacdrbg/verif_hmac_drbg_generate_abs.v
index ee4df36bd1..f4fac0d52d 100644
--- a/hmacdrbg/verif_hmac_drbg_generate_abs.v
+++ b/hmacdrbg/verif_hmac_drbg_generate_abs.v
@@ -1,6 +1,6 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Import ListNotations.
-Local Open Scope logic.
 Require Import VST.zlist.sublist.
 
 Require Import sha.HMAC256_functional_prog.
@@ -59,10 +59,10 @@ Opaque mbedtls_HMAC256_DRBG_reseed_function.
 Lemma body_hmac_drbg_generate_abs: semax_body HmacDrbgVarSpecs HmacDrbgFunSpecs 
        f_mbedtls_hmac_drbg_random_with_add hmac_drbg_generate_abs_spec.
 Proof.
-  start_function. 
-  unfold AREP. focus_SEP 2. rewrite extract_exists_in_SEP. Intros Info.
-  unfold REP. rewrite extract_exists_in_SEP. Intros a.
-  rename H3 into WFI.  
+  start_function.
+  unfold AREP. focus_SEP 2. Intros Info.
+  unfold REP. Intros a.
+  rename H3 into WFI.
   assert (Hreseed_counter_in_range: 0 <= hmac256drbgabs_reseed_counter I < Int.max_signed) by apply WFI.
   assert (Hreseed_interval: RI_range (hmac256drbgabs_reseed_interval I)) by apply WFI.
   rename H1 into AddLenC. rename H2 into Hentlen.
@@ -87,7 +87,7 @@ Proof.
         (bool2val prediction_resistance, Vint (Int.repr reseed_interval))))))) in *.
 
   (* mbedtls_hmac_drbg_context *ctx = p_rng; *)
-  forward. 
+  forward.
 
   (* int left = out_len *)
   forward.
@@ -136,7 +136,7 @@ Proof.
   }
   {
     forward.
-    entailer!. 
+    entailer!.
   }
 
   Intros.  thaw FR0. clear Pctx.
@@ -166,7 +166,7 @@ Proof.
       assumption.
     }
     unfold generate_absPOST. rewrite Hout_lenb, Hadd_lenb; simpl.
-    entailer!. 
+    entailer!.
     thaw FR2. cancel. unfold AREP, REP. Exists Info. Exists a.
     entailer!. unfold hmac256drbg_relate; subst I a; simpl in *; entailer!.
   }
@@ -203,7 +203,7 @@ Proof.
   { subst prediction_resistance'.
     rename H into Hpr.
     destruct prediction_resistance; try solve [inversion Hpr].
-    simpl in should_reseed; clear Hpr. 
+    simpl in should_reseed; clear Hpr.
     forward.
     entailer!.
     
@@ -275,9 +275,9 @@ Proof.
        red in WFI.
        subst contents'; destruct ZLc' as [ZLc' | ZLc']; rewrite ZLc'; rep_lia.
     }
-     
+
     Intros return_value.
-    forward. 
+    forward.
 
     assert (F: 0>? 256 = false) by reflexivity.
     forward_if (return_value = Vzero).
@@ -366,10 +366,10 @@ Proof.
   }
   { forward. entailer!. subst after_reseed_add_len na.
     destruct should_reseed; simpl; trivial. rewrite andb_false_r. reflexivity.
-    destruct (EqDec_Z (Zlength contents)  0); simpl. 
+    destruct (eq_dec (Zlength contents)  0); simpl.
     + rewrite e. simpl. rewrite andb_false_r. reflexivity.
-    + rewrite Int.eq_false; simpl. 
-      destruct (EqDec_val additional nullval); try reflexivity. contradiction. 
+    + rewrite Int.eq_false; simpl.
+      destruct (eq_dec additional nullval); try reflexivity. contradiction.
       contradict n. apply repr_inj_unsigned in n; lia.
   }
   { forward. rewrite H in *. entailer!. }
@@ -393,13 +393,13 @@ Proof.
     md_full key2 (mc1, (mc2, mc3))))).
   { change (na = true) in H. rewrite H in *. subst na.
      destruct should_reseed; simpl in PRS, H. rewrite andb_false_r in H; discriminate.
-     destruct (EqDec_Z (Zlength contents) 0); simpl in H.
+     destruct (eq_dec (Zlength contents) 0); simpl in H.
      { rewrite andb_false_r in H; discriminate. }
      rewrite andb_true_r in H.
      destruct additional; simpl in PNadditional; try contradiction.
      { subst i0; discriminate. }
-     destruct PRS as [? [? ?]]; subst key1 stream1 ctx1. clear H. 
-     
+     destruct PRS as [? [? ?]]; subst key1 stream1 ctx1. clear H.
+
        forward_call (contents, Vptr b0 i0, sha, after_reseed_add_len, 
                     (*ctx*)Vptr b i, shc, aaa,I, Info, gv).
        { assert (FR: Frame = [data_at_ sho (tarray tuchar out_len) output * Stream s]).
@@ -481,14 +481,14 @@ apply semax_pre with (P':=
     subst M after_reseed_state_abs. subst h; simpl in *.
     destruct PUPD; subst key2 ctx2. entailer!. 
   + destruct PRS as [? [? ?]]; subst stream1 key1 ctx1 after_reseed_state_abs.
-    destruct (EqDec_val additional nullval); simpl in *.
+    destruct (eq_dec additional nullval); simpl in *.
     - destruct PUPD; subst ctx2 key2 na h; simpl in *. entailer!.
-    - remember (EqDec_Z (Zlength contents) 0) as q; destruct q; simpl in *. 
-      * destruct PUPD; subst ctx2 key2 na h; simpl in *. entailer!. 
-      * destruct PUPD as [bb [ii [UVAL [ADD [HUPD CTX2 ]]]]]. 
+    - remember (eq_dec (Zlength contents) 0) as q; destruct q; simpl in *.
+      * destruct PUPD; subst ctx2 key2 na h; simpl in *. entailer!.
+      * destruct PUPD as [bb [ii [UVAL [ADD [HUPD CTX2 ]]]]].
         unfold contents_with_add in HUPD. simpl in HUPD; rewrite <- Heqq in HUPD; simpl in HUPD.  
         rewrite <- HUPD in *. subst h ctx2; simpl in *. entailer!.
-}  
+}
 subst after_update_Mpred.
 assert (TR: mkSTREAM1 (prediction_resistance || (reseed_counter >? reseed_interval)) s
   key V reseed_counter entropy_len prediction_resistance reseed_interval
@@ -604,7 +604,7 @@ Opaque mbedtls_HMAC256_DRBG_generate_function.
           (Vint (Int.repr entropy_len0),
           (bool2val prediction_resistance0, Vint (Int.repr reseed_interval0))))))) in *.
   thaw StreamAdd.
-  freeze [3;5] StreamOut. 
+  freeze [3;5] StreamOut.
 
   (* mbedtls_hmac_drbg_update( ctx, additional, add_len ); *)
   (*subst add_len.*)
@@ -632,10 +632,10 @@ Opaque mbedtls_HMAC256_DRBG_generate_function.
   subst ctx3. simpl in ctx4. destruct ABS4. simpl in ctx4. subst ctx4. simpl. normalize.
   unfold hmac256drbgstate_md_info_pointer. simpl.
   Intros.
-  freeze [2;3;4;5] FR5. 
+  freeze [2;3;4;5] FR5.
   unfold_data_at 1%nat.
   freeze [1;2;4;5;6;7] FIELDS.
-  forward. 
+  forward.
 assert (RC_x: 0 <= hmac256drbgabs_reseed_counter after_reseed_state_abs < Int.max_signed).
 { subst after_reseed_state_abs.
   destruct should_reseed; simpl in *; [|trivial]. simpl.
@@ -664,7 +664,7 @@ assert (RC_y: 0 <= hmac256drbgabs_reseed_counter after_update_state_abs < Int.ma
   destruct na; trivial. subst I; simpl.
   destruct (HMAC256_DRBG_update contents key V). simpl; trivial. }
   assert (RC1: 0 <= reseed_counter1 < Int.max_signed).
-  { clear - RC_x RC_y HeqABS3 HeqABS4. 
+  { clear - RC_x RC_y HeqABS3 HeqABS4.
     unfold hmac256drbgabs_hmac_drbg_update in HeqABS4.
     remember (HMAC256_DRBG_update
                (contents_with_add additional
@@ -675,7 +675,7 @@ assert (RC_y: 0 <= hmac256drbgabs_reseed_counter after_update_state_abs < Int.ma
     destruct na.
     + subst; simpl in *.
       remember (HMAC256_DRBG_update contents key V) as q. destruct q.
-      inv HeqABS3. trivial. 
+      inv HeqABS3. trivial.
     + subst; simpl in *. subst after_reseed_state_abs. simpl in *.
       destruct should_reseed.
       - simpl in *.
@@ -688,16 +688,16 @@ assert (RC_y: 0 <= hmac256drbgabs_reseed_counter after_update_state_abs < Int.ma
   Exists (Vint (Int.repr 0)).
   apply andp_right. apply prop_right; split; trivial.
   thaw FIELDS. thaw FR5. thaw StreamOut.
-  subst.  
+  subst.
 (*
   clear - WFI HeqABS4 HeqABS3 STREAM1 H1 H3 H4 H6 Hreseed_counter_in_range
           Hout_lenb ZLa Hreseed_interval.*)
  assert (H6:= entailment2 key0 V0 reseed_counter0 entropy_len0 prediction_resistance0 
    reseed_interval0 contents additional sha output sho out_len b i shc key V
-    reseed_counter entropy_len 
-    prediction_resistance reseed_interval 
+    reseed_counter entropy_len
+    prediction_resistance reseed_interval
        gv s ).
   simpl in H6. sep_apply H6.
  + red in WFI; subst I; simpl in *. apply WFI.
-  + normalize. unfold AREP, REP. Exists Info a. normalize. apply derives_refl.
-Time Qed. (*Coq 8.10.1: 13s; was: 61s*) 
\ No newline at end of file
+  + normalize. unfold AREP, REP. Exists Info a. normalize.
+Time Qed. (*Coq 8.10.1: 13s; was: 61s*)
diff --git a/hmacdrbg/verif_hmac_drbg_generate_common.v b/hmacdrbg/verif_hmac_drbg_generate_common.v
index 92417f936c..21b9a244f4 100644
--- a/hmacdrbg/verif_hmac_drbg_generate_common.v
+++ b/hmacdrbg/verif_hmac_drbg_generate_common.v
@@ -1,6 +1,6 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Import ListNotations.
-Local Open Scope logic.
 Require Import VST.zlist.sublist.
 
 Require Import sha.HMAC256_functional_prog.
@@ -881,13 +881,13 @@ Opaque HMAC256_DRBG_generate_function.
         unfold contents_with_add in HeqCONT.
         destruct (eq_dec (Zlength contents) 0); simpl in HeqCONT. 
         ++ rewrite e in *. rewrite (Zlength_nil_inv _ e) in *.
-           simpl in na. destruct (EqDec_Z (Zlength contents) 0); try solve [lia]; simpl in na.
-           subst na; rewrite andb_false_r in *. 
-           assert (F: (negb (EqDec_val additional nullval) &&
+           simpl in na. destruct (eq_dec (Zlength contents) 0); try solve [lia]; simpl in na.
+           subst na; rewrite andb_false_r in *.
+           assert (F: (negb (eq_dec additional nullval) &&
                             false)%bool = false).
            { rewrite andb_false_r. trivial. }
            subst after_update_state_abs; rewrite F in *.
-           inv HeqAUSA. simpl.  
+           inv HeqAUSA. simpl.
            rewrite hmac_common_lemmas.HMAC_Zlength.
            inv Heqq. inv HeqUPD.
            unfold hmac256drbgstate_md_info_pointer; simpl in *. entailer!. 
@@ -897,7 +897,7 @@ Opaque HMAC256_DRBG_generate_function.
            rewrite <- Heqp, sublist_firstn; simpl. cancel.
            unfold_data_at 1%nat. cancel.
            }
-        ++ destruct (EqDec_val additional nullval); simpl in na, HeqCONT.
+        ++ destruct (eq_dec additional nullval); simpl in na, HeqCONT.
            2: subst contents; elim n; apply Zlength_nil.
            subst na. simpl in *.
            inv HeqUPD. inv HeqAUSA. inv Heqq.
@@ -914,8 +914,8 @@ Opaque HMAC256_DRBG_generate_function.
        destruct Heqf as [Heqf1 Heqf2]. apply negb_true_iff in Heqf1. apply negb_true_iff in Heqf2.
        destruct (eq_dec additional nullval); try discriminate.
        destruct (eq_dec (Zlength contents) 0); try discriminate.
-       destruct (EqDec_val additional nullval). { subst additional. elim n; trivial. }
-       destruct (EqDec_Z (Zlength contents) 0); simpl in na. { lia. }
+       destruct (eq_dec additional nullval). { subst additional. elim n; trivial. }
+       destruct (eq_dec (Zlength contents) 0); simpl in na. { lia. }
        subst na. simpl in HeqAUSA.
        Exists (mc1, (mc2, mc3),
              (map Vubyte l0,
@@ -937,7 +937,7 @@ Opaque HMAC256_DRBG_generate_function.
          apply hmac_common_lemmas.HMAC_Zlength.
          apply hmac_common_lemmas.HMAC_Zlength. }
        unfold_data_at 1%nat. cancel.
-  - subst HLP MRES'.  
+  - subst HLP MRES'.
       remember  MGen as MGen'. subst MGen.
 Transparent mbedtls_HMAC256_DRBG_generate_function.
 Transparent HMAC256_DRBG_generate_function.
@@ -961,11 +961,11 @@ Opaque HMAC256_DRBG_generate_function.
              (Vfalse, Vint (Int.repr reseed_interval)))))).
         subst MGen'. subst Gen.
         unfold contents_with_add in HeqCONT.
-        destruct (eq_dec (Zlength contents) 0); simpl in HeqCONT. 
+        destruct (eq_dec (Zlength contents) 0); simpl in HeqCONT.
         ++ rewrite e0 in *. rewrite (Zlength_nil_inv _ e0) in *.
-           simpl in na. destruct (EqDec_Z (Zlength contents) 0); try solve [lia]; simpl in na.
-           subst na; rewrite andb_false_r in *. 
-           assert (F: (negb (EqDec_val additional nullval) &&
+           simpl in na. destruct (eq_dec (Zlength contents) 0); try solve [lia]; simpl in na.
+           subst na; rewrite andb_false_r in *.
+           assert (F: (negb (eq_dec additional nullval) &&
                             false)%bool = false).
            { rewrite andb_false_r. trivial. }
            subst after_update_state_abs; rewrite F in *.
@@ -977,12 +977,12 @@ Opaque HMAC256_DRBG_generate_function.
              apply hmac_common_lemmas.HMAC_Zlength. }
            rewrite <- Heqp, sublist_firstn; simpl. cancel.
            unfold_data_at 1%nat. cancel.
-        ++ destruct (EqDec_val additional nullval); simpl in na, HeqCONT.
+        ++ destruct (eq_dec additional nullval); simpl in na, HeqCONT.
            2: subst contents; elim n; apply Zlength_nil.
            subst na. simpl in *.
            inv HeqUPD. inv HeqAUSA. inv Heqq.
            apply andp_right. apply prop_right. repeat split; trivial.
-           rewrite hmac_common_lemmas.HMAC_Zlength. 
+           rewrite hmac_common_lemmas.HMAC_Zlength.
            entailer!.
            { destruct WFI as [WFI1 [WFI2 [WFI3 WFI4]]]. red in Hreseed_interval. red in WFI3; simpl in *; repeat split; simpl; trivial; try lia. 
              apply hmac_common_lemmas.HMAC_Zlength. }
@@ -994,8 +994,8 @@ Opaque HMAC256_DRBG_generate_function.
        destruct Heqf as [Heqf1 Heqf2]. apply negb_true_iff in Heqf1. apply negb_true_iff in Heqf2.
        destruct (eq_dec additional nullval); try discriminate.
        destruct (eq_dec (Zlength contents) 0); try discriminate.
-       destruct (EqDec_val additional nullval). { subst additional. elim n; trivial. }
-       destruct (EqDec_Z (Zlength contents) 0); simpl in na. { lia. }
+       destruct (eq_dec additional nullval). { subst additional. elim n; trivial. }
+       destruct (eq_dec (Zlength contents) 0); simpl in na. { lia. }
        subst na. simpl in HeqAUSA.
        Exists (mc1, (mc2, mc3),
              (map Vubyte l0,
@@ -1022,7 +1022,7 @@ Time Qed. (*laptop 11s, desktop25s*)
 Opaque mbedtls_HMAC256_DRBG_reseed_function.
 Opaque mbedtls_HMAC256_DRBG_generate_function.
 
-Lemma loopbody_explicit (StreamAdd:list mpred) : forall (Espec : OracleKind)
+Lemma loopbody_explicit (StreamAdd:list mpred) : forall Espec
 (contents : list byte)
 (additional : val)
 (add_len : Z)
@@ -1100,7 +1100,7 @@ Lemma loopbody_explicit (StreamAdd:list mpred) : forall (Espec : OracleKind)
 (WFI : drbg_protocol_specs.WF
         (HMAC256DRBGabs key V reseed_counter entropy_len
            prediction_resistance reseed_interval)),
-@semax hmac_drbg_compspecs.CompSpecs Espec
+semax(C := hmac_drbg_compspecs.CompSpecs)(OK_spec := Espec) ⊤
      (func_tycontext f_mbedtls_hmac_drbg_random_with_add HmacDrbgVarSpecs
         HmacDrbgFunSpecs nil)
   (PROP ( )
@@ -1284,7 +1284,7 @@ Proof. intros.
       destruct ctx''; inversion Hisptr. reflexivity.
     }
     unfold_data_at 1%nat.
-    
+
     freeze [2;3;4;5] FR_unused_struct_fields.
     freeze [0;3;5] FR1.
 
@@ -1326,9 +1326,10 @@ Proof. intros.
     assert_PROP (field_compatible t_struct_hmac256drbg_context_st
          [StructField _md_ctx] (Vptr b i)) as FC_M by entailer.
     forward_call (field_address t_struct_hmac256drbg_context_st [StructField _md_ctx] (*ctx*)(Vptr b i),  (*md_ctx'*)(mc1,(mc2,mc3)), shc, key0, gv).
+    { simpl; entailer!. f_equal; auto with field_compatible. }
     { unfold md_full; simpl. cancel. }
     (* mbedtls_md_hmac_update( &ctx->md_ctx, ctx->V, md_len ); *)
-    rename H into HZlength_V.  
+    rename H into HZlength_V.
     assert_PROP (field_compatible t_struct_hmac256drbg_context_st [StructField _V] (Vptr b i)) as FCV by entailer!.
 
     forward_call (key0, field_address t_struct_hmac256drbg_context_st [StructField _md_ctx] (*ctx*)(Vptr b i),
@@ -1363,6 +1364,8 @@ Proof. intros.
                field_address t_struct_hmac256drbg_context_st [StructField _md_ctx] (*ctx*)(Vptr b i), 
                (*md_ctx'*)(mc1, (mc2, mc3)), shc,
                field_address t_struct_hmac256drbg_context_st [StructField _V] (*ctx*)(Vptr b i), shc, gv).
+    { simpl; entailer!. f_equal; [|f_equal]; auto with field_compatible.
+      rewrite field_compatible_field_address; auto. }
     {
       rewrite <- memory_block_data_at_ by trivial. cancel.
     }
@@ -1384,13 +1387,13 @@ Proof. intros.
         apply hmac_common_lemmas.HMAC_Zlength.
         exists n; reflexivity.
       }
-      
+
       apply data_at_complete_split; try rewrite HZlength1; try rewrite Zlength_repeat; auto; try lia.
       (*simpl. simpl in HZlength1. rewrite HZlength1.*)
       replace ((n * 32)%Z + (out_len - (n * 32)%Z)) with out_len by lia. assumption.
     }
     normalize.
-    
+
     remember (offset_val done output) as done_output.
     remember (Z.min 32 (out_len - done)) as use_len.
     assert_PROP (field_compatible (tarray tuchar (out_len - done)) [] done_output) as Hfield_compat_done_output.
@@ -1676,7 +1679,7 @@ Time Qed. (*Coq8.10.1: 8.9s; was: 27s*)
 Opaque mbedtls_HMAC256_DRBG_generate_function.
 
 Lemma generate_loopbody: forall (StreamAdd: list mpred)
-(Espec : OracleKind)
+Espec
 (contents : list byte)
 (additional : val)
 (add_len : Z)
@@ -1744,7 +1747,7 @@ Lemma generate_loopbody: forall (StreamAdd: list mpred)
 (Hshc: writable_share shc)
 (H : 0 <= done <= out_len)
 (H0 : is_multiple done 32 \/ done = out_len),
-@semax hmac_drbg_compspecs.CompSpecs Espec
+semax(C := hmac_drbg_compspecs.CompSpecs)(OK_spec := Espec) ⊤
   (func_tycontext f_mbedtls_hmac_drbg_random_with_add HmacDrbgVarSpecs
         HmacDrbgFunSpecs nil)
   (PROP ( )
@@ -1867,4 +1870,4 @@ apply (loopbody_explicit StreamAdd); try assumption;
     subst I; red in WFI; simpl in *; lia.
 apply andp_left2.
 go_lowerx.
-Time Qed. (*2s*)
\ No newline at end of file
+Time Qed. (*2s*)
diff --git a/hmacdrbg/verif_hmac_drbg_other.v b/hmacdrbg/verif_hmac_drbg_other.v
index eeeedc7d44..36afd4a63b 100644
--- a/hmacdrbg/verif_hmac_drbg_other.v
+++ b/hmacdrbg/verif_hmac_drbg_other.v
@@ -1,6 +1,5 @@
 Require Import VST.floyd.proofauto.
 Import ListNotations.
-Local Open Scope logic.
 
 Require Import sha.spec_sha.
 Require Import hmacdrbg.entropy.
@@ -20,13 +19,12 @@ Proof.
   destruct ctx; try contradiction.
   - (*ctx==null*)
     simpl in PNctx; subst i. rewrite da_emp_null; trivial.
-    forward_if (liftx FF).
-    + forward. apply tt.
+    forward_if.
+    + forward.
     + contradiction H; reflexivity.
-    + apply semax_ff.
   - (*isptr ctx*)
     rewrite if_false; try discriminate.
-    rewrite da_emp_ptr.  Intros. 
+    rewrite da_emp_ptr.  Intros.
     assert_PROP (field_compatible t_struct_hmac256drbg_context_st
                    [StructField _md_ctx] (Vptr b i)) as FC_mdctx.
         entailer!.
@@ -38,7 +36,6 @@ Proof.
       assert_PROP (field_compatible t_struct_hmac256drbg_context_st [] (Vptr b i)) as FC by entailer!.
       unfold_data_at 1%nat.
       freeze [1;2;3;4;5] FR. unfold hmac256drbg_relate. destruct ABS. normalize.
-      2: apply tt.
       destruct C1 as [? [? ?]]. rewrite field_at_data_at.
       unfold field_address. rewrite if_true by trivial. 
       simpl offset_val. rewrite Ptrofs.add_zero.
@@ -67,7 +64,7 @@ Proof.
                   destruct (Ptrofs.unsigned_range i). lia. }
               thaw FR.
                destruct (Ptrofs.unsigned_range i).  eapply derives_trans.
-               rewrite ?sepcon_assoc.
+               rewrite <- ?sepcon_assoc.
                eapply sepcon_derives. apply field_at_field_at_.
                eapply sepcon_derives. apply field_at_field_at_.
                eapply sepcon_derives. apply field_at_field_at_.
@@ -93,7 +90,7 @@ Proof.
             }
       clear FR1. clear FR.
       forward_call (sizeof (Tstruct _mbedtls_hmac_drbg_context noattr), Vptr b i, shc).
-      simpl Z.to_nat. entailer!.
+      simpl Z.to_nat. Exists tt. entailer!.
 Qed.
 
 Lemma body_hmac_drbg_random: semax_body HmacDrbgVarSpecs HmacDrbgFunSpecs
@@ -107,7 +104,6 @@ Proof.
   forward_call (@nil byte, nullval, Tsh, Z0, output, sho, out_len, ctx, shc, initial_state,
                I, info_contents, s, gv).
   { rewrite da_emp_null; trivial. cancel. }
-  { lia. }
   Intros v. forward. simpl. Exists (Vint v). entailer!.
 Qed.
 
@@ -172,7 +168,6 @@ Proof.
   forward_call (@nil byte, nullval, Tsh, Z0, output, Ews, n, ctx, Ews, i,
                 I, info, s, gv).
   { rewrite da_emp_null; trivial. cancel. }
-  { rep_lia. }
   Intros v. forward. unfold hmac256drbgabs_common_mpreds.
   unfold generatePOST, contents_with_add; simpl. 
   apply Zgt_is_gt_bool_f in ASS7. rewrite ASS7 in *.
@@ -468,4 +463,3 @@ Proof.
   unfold_data_at 1%nat. forward. entailer!. simpl; entailer!.
   unfold_data_at 1%nat. cancel.
 Qed.
-
diff --git a/hmacdrbg/verif_hmac_drbg_reseed.v b/hmacdrbg/verif_hmac_drbg_reseed.v
index ef4ac566d8..454465a159 100644
--- a/hmacdrbg/verif_hmac_drbg_reseed.v
+++ b/hmacdrbg/verif_hmac_drbg_reseed.v
@@ -1,6 +1,6 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Import ListNotations.
-Local Open Scope logic.
 
 Require Import hmacdrbg.entropy.
 Require Import hmacdrbg.entropy_lemmas.
@@ -13,7 +13,7 @@ Require Import hmacdrbg.HMAC_DRBG_common_lemmas.
 Require Import hmacdrbg.verif_hmac_drbg_reseed_common.
 
 Opaque hmac256drbgabs_reseed.
-Opaque mbedtls_HMAC256_DRBG_reseed_function. 
+Opaque mbedtls_HMAC256_DRBG_reseed_function.
 
 Lemma body_hmac_drbg_reseed: semax_body HmacDrbgVarSpecs HmacDrbgFunSpecs
        f_mbedtls_hmac_drbg_reseed hmac_drbg_reseed_spec.
@@ -47,7 +47,7 @@ Proof.
     { subst contents'. unfold contents_with_add.
       destruct (eq_dec add_len 0); simpl.
         rewrite andb_false_r. left; apply Zlength_nil.
-        destruct (EqDec_val additional nullval); simpl. left; apply Zlength_nil.
+        destruct (eq_dec additional nullval); simpl. left; apply Zlength_nil.
         right; trivial.
     }
 
@@ -220,7 +220,7 @@ Proof.
   rewrite <- XH7.
   simple eapply reseed_REST  with (s0:=s0)(contents':=contents'); try eassumption;
     auto.
-idtac "Timing the Qed of drbg_reseed (goal: 25secs)". lia. 
+idtac "Timing the Qed of drbg_reseed (goal: 25secs)". lia.
 Time Qed. (*May23th, Coq8.6:12secs
            Feb 23 2017: Finished transaction in 105.344 secs (74.078u,0.015s) (successful)*)
           (*earlier Coq8.5pl2: 24secs*)
diff --git a/hmacdrbg/verif_hmac_drbg_reseed_common.v b/hmacdrbg/verif_hmac_drbg_reseed_common.v
index fbfbcf2911..b0a5807977 100644
--- a/hmacdrbg/verif_hmac_drbg_reseed_common.v
+++ b/hmacdrbg/verif_hmac_drbg_reseed_common.v
@@ -1,6 +1,6 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Import ListNotations.
-Local Open Scope logic.
 
 Require Import sha.general_lemmas.
 Require Import hmacdrbg.entropy.
@@ -22,8 +22,8 @@ Lemma my_fold_right_eq {A B} (f : B -> A -> A) a: my_fold_right f a = fold_right
 Proof. extensionality l. induction l; auto. Qed.
 
 
-Lemma FRZL_ax' ps: FRZL ps = my_fold_right sepcon emp ps.
-Proof. rewrite FRZL_ax. rewrite my_fold_right_eq. trivial. Qed.
+Lemma FRZL_ax' ps: FRZL ps ⊣⊢ my_fold_right bi_sep emp ps.
+Proof. rewrite FRZL_ax. rewrite my_fold_right_eq. rewrite fold_right_sepcon_eq. trivial. Qed.
 
 (*Tactic requires the resulting goal to be normalized manually.*)
 Ltac my_thaw' name :=
@@ -38,7 +38,7 @@ Ltac my_thaw name :=
 Lemma isptrD v: isptr v -> exists b ofs, v = Vptr b ofs.
 Proof. intros. destruct v; try contradiction. eexists; eexists; reflexivity. Qed.
 
-Lemma reseed_REST: forall (Espec : OracleKind) (contents : list byte) additional (sha: share) add_len ctx
+Lemma reseed_REST: forall Espec (contents : list byte) additional (sha: share) add_len ctx
   (md_ctx': mdstate) reseed_counter' entropy_len' prediction_resistance' reseed_interval'
   key (V: list byte) reseed_counter entropy_len prediction_resistance reseed_interval gv
   info_contents (s : ENTROPY.stream)
@@ -65,7 +65,7 @@ Lemma reseed_REST: forall (Espec : OracleKind) (contents : list byte) additional
   (Heqentropy_result : ENTROPY.success entropy_bytes s0 = ENTROPY.get_bytes (Z.to_nat entropy_len) s)
   (Hsha: readable_share sha)
   (Hshc: writable_share shc),
-@semax hmac_drbg_compspecs.CompSpecs Espec
+semax(C := hmac_drbg_compspecs.CompSpecs)(OK_spec := Espec) ⊤
   (func_tycontext f_mbedtls_hmac_drbg_reseed HmacDrbgVarSpecs
         HmacDrbgFunSpecs nil)
   (PROP ( )
@@ -148,8 +148,7 @@ Proof.
          ((map Vubyte entropy_bytes) ++ (repeat (Vint Int.zero) (Z.to_nat (384 - entropy_len)))) seed).
   {
     entailer!. thaw SEED; clear FR6. (*subst entropy_len.*) rewrite ?sepcon_emp.
-    apply derives_refl'. symmetry.
-    apply data_at_complete_split; repeat rewrite Zlength_map;
+    erewrite <- data_at_complete_split; eauto; repeat rewrite Zlength_map;
     try rewrite (*Hentropy_bytes_length,*) Zlength_repeat; try rewrite Zplus_minus; trivial; lia.
   }
 
@@ -212,14 +211,14 @@ Proof.
     rewrite da_emp_ptr. Intros. rename H into addlen_pos.
     assert (contents' = contents).
     { subst contents'. unfold contents_with_add. simpl.
-        destruct (EqDec_Z add_len 0). lia. reflexivity. }
+        destruct (eq_dec add_len 0). lia. reflexivity. }
     clear Heqcontents'; subst contents'. clear ZLc'.
     replace_SEP 0 ((data_at Tsh (tarray tuchar entropy_len)
          (map Vubyte entropy_bytes) seed) * (data_at Tsh (tarray tuchar (384 - entropy_len))
          (repeat (Vint Int.zero) (Z.to_nat (384 - entropy_len))) (offset_val entropy_len seed))).
     {
       entailer!.
-      apply derives_refl'; apply data_at_complete_split; trivial; try lia.
+      erewrite data_at_complete_split; trivial; try lia.
       rewrite Zlength_app in H0; rewrite H0; trivial.
       repeat rewrite Zlength_map; trivial.
       rewrite Zlength_repeat; lia.
@@ -239,8 +238,7 @@ Proof.
       remember (Vptr b (Ptrofs.add i (Ptrofs.repr entropy_len))) as seed'.
       clear Heqseed'.
       (*entailer!*) go_lower.
-      apply derives_refl'.
-      apply data_at_complete_split; try rewrite Zlength_repeat; try lia; auto.
+      erewrite data_at_complete_split; eauto; try rewrite Zlength_repeat; try lia; auto.
       + rewrite Zlength_repeat.
         replace (Zlength contents + (384 - entropy_len - Zlength contents)) with (384 - entropy_len); trivial; lia.
         lia.
@@ -324,7 +322,7 @@ Proof.
     { subst contents'. unfold contents_with_add.
       destruct (eq_dec add_len 0); simpl in *.
       + rewrite e in *. rewrite andb_false_r; trivial.
-      + destruct (EqDec_val additional nullval); simpl in *; trivial; discriminate. }
+      + destruct (eq_dec additional nullval); simpl in *; trivial; discriminate. }
     clear Heqcontents'; subst contents'.
     rewrite Zlength_nil, Zplus_0_r.
     apply andp_right.
@@ -344,8 +342,7 @@ Proof.
     rewrite app_assoc.
     entailer!.
     autorewrite with sublist in H0.
-    apply derives_refl'.
-    apply data_at_complete_split; try list_solve.
+    erewrite data_at_complete_split; eauto; try list_solve.
   }
   flatten_sepcon_in_SEP.
 
@@ -398,7 +395,7 @@ Proof.
     entailer!.
     destruct seed; simpl in Pseed; try contradiction.
     rewrite da_emp_ptr. Intros.
-    apply derives_refl'; symmetry; apply data_at_complete_split;
+    erewrite <- data_at_complete_split; eauto;
      repeat rewrite Zlength_repeat; try lia; auto; try rewrite Zlength_app;
      try rewrite ZLbytes; repeat rewrite Zlength_map; auto.
      replace (Zlength entropy_bytes + Zlength contents' +
@@ -453,7 +450,7 @@ Proof.
     unfold HMAC256_DRBG_functional_prog.HMAC256_DRBG_update in Heqp.
     destruct seed; simpl in Pseed; try contradiction.
     unfold contents_with_add in Heqp at 1. simpl in Heqp.
-    destruct (EqDec_Z (Zlength entropy_bytes +
+    destruct (eq_dec (Zlength entropy_bytes +
                  Zlength (contents_with_add additional (Zlength contents) contents)) 0); simpl in Heqp.
     specialize (Zlength_nonneg (contents_with_add additional (Zlength contents) contents)).
     intros; lia.
@@ -468,7 +465,7 @@ Proof.
   unfold HMAC256_DRBG_functional_prog.HMAC256_DRBG_update in Heqp.
   destruct seed; simpl in Pseed; try contradiction.
   unfold contents_with_add in Heqp at 1. simpl in Heqp.
-  destruct (EqDec_Z (Zlength entropy_bytes +
+  destruct (eq_dec (Zlength entropy_bytes +
                  Zlength (contents_with_add additional (Zlength contents) contents)) 0); simpl in Heqp.
   specialize (Zlength_nonneg (contents_with_add additional (Zlength contents) contents)).
   intros; lia.
diff --git a/hmacdrbg/verif_hmac_drbg_seed.v b/hmacdrbg/verif_hmac_drbg_seed.v
index fab5cd6537..c3b1afd390 100644
--- a/hmacdrbg/verif_hmac_drbg_seed.v
+++ b/hmacdrbg/verif_hmac_drbg_seed.v
@@ -1,6 +1,6 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Import ListNotations.
-Local Open Scope logic.
 Require Import VST.zlist.sublist.
 
 Require Import sha.HMAC256_functional_prog.
@@ -24,7 +24,7 @@ Require Import hmacdrbg.verif_hmac_drbg_seed_common.
 Opaque mbedtls_HMAC256_DRBG_reseed_function.
 Opaque initial_key. Opaque initial_value.
 Opaque mbedtls_HMAC256_DRBG_reseed_function.
-Opaque repeat. 
+Opaque repeat.
 
 Lemma body_hmac_drbg_seed_256: semax_body HmacDrbgVarSpecs HmacDrbgFunSpecs
       f_mbedtls_hmac_drbg_seed hmac_drbg_seed_inst256_spec.
@@ -126,12 +126,11 @@ Proof.
          data_at shc t_struct_hmac256drbg_context_st ST (Vptr b i) *
          hmac256drbg_relate myABS ST).
   { simpl liftx. entailer!. thaw INI. clear - FC_V. (*KVStreamInfoDataFreeBlk.*) thaw FR_CTX.
-    apply andp_right. apply prop_right. repeat split; trivial.
-    unfold_data_at 2%nat. 
-    cancel. unfold md_full; simpl.
+    unfold_data_at 2%nat.
+    cancel. simpl. unfold md_full; simpl.
     rewrite field_at_data_at; simpl.
     unfold field_address. rewrite if_true; simpl; trivial.
-    cancel.
+    entailer!.
     apply UNDER_SPEC.REP_FULL.
   }
 
@@ -142,7 +141,7 @@ Proof.
     subst ST; simpl. cancel.
   }
   { split; auto. compute; congruence. subst myABS; simpl. rewrite <- initialize.max_unsigned_modulus in *; rewrite hmac_pure_lemmas.ptrofs_max_unsigned_eq.
-    split. lia. 
+    split. lia.
        unfold contents_with_add. simple_if_tac. lia. rewrite Zlength_nil; lia.
   }
 
@@ -178,11 +177,11 @@ Proof.
         subst myABS. rewrite <- instantiate256_reseed in HeqMRS; trivial.
         rewrite RES in HeqMRS. inv HeqMRS. 
   }
-  { rename H into Hv. forward. entailer!. 
+  { rename H into Hv. forward. entailer!.
     apply negb_false_iff in Hv.
     symmetry in Hv; apply binop_lemmas2.int_eq_true in Hv; subst v. trivial.
   }
-  deadvars!. Intros. subst v. unfold reseedPOST. 
+  deadvars!. Intros. subst v. unfold reseedPOST.
 
   remember ((zlt 256 (Zlength Data)
           || zlt 384 (hmac256drbgabs_entropy_len myABS + Zlength Data))%bool) as d.
@@ -196,13 +195,13 @@ Proof.
   destruct handle as [[[[newV newK] newRC] dd] newPR].
   unfold hmac256drbgabs_common_mpreds.
   simpl. subst ST. unfold hmac256drbgstate_md_info_pointer. simpl.
-  unfold_data_at 1%nat. 
+  unfold_data_at 1%nat.
   freeze [0;1;2;4;5;6;7;8;9;10;11;12] ALLSEP.
   forward. forward.
  
   Exists Int.zero. simpl.
-  apply andp_right. apply prop_right; split; trivial. 
-  Exists p. 
+  apply andp_right. apply prop_right; split; trivial.
+  Exists p.
   thaw ALLSEP. thaw OLD_MD. rewrite <- instantiate256_reseed, RES; trivial. simpl. 
   cancel; entailer!.
   unfold_data_at 1%nat. cancel.
diff --git a/hmacdrbg/verif_hmac_drbg_seed_buf.v b/hmacdrbg/verif_hmac_drbg_seed_buf.v
index bfb5b9f682..b544ebaa40 100644
--- a/hmacdrbg/verif_hmac_drbg_seed_buf.v
+++ b/hmacdrbg/verif_hmac_drbg_seed_buf.v
@@ -1,6 +1,6 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Import ListNotations.
-Local Open Scope logic.
 Require Import VST.zlist.sublist.
 
 Require Import sha.HMAC256_functional_prog.
diff --git a/hmacdrbg/verif_hmac_drbg_seed_common.v b/hmacdrbg/verif_hmac_drbg_seed_common.v
index 35cd3e9ffb..3179d2c34b 100644
--- a/hmacdrbg/verif_hmac_drbg_seed_common.v
+++ b/hmacdrbg/verif_hmac_drbg_seed_common.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import hmacdrbg.HMAC_DRBG_algorithms.
 Require Import hmacdrbg.HMAC_DRBG_common_lemmas.
 Require Import hmacdrbg.spec_hmac_drbg.
diff --git a/hmacdrbg/verif_hmac_drbg_update.v b/hmacdrbg/verif_hmac_drbg_update.v
index 2341e8bc83..27c0fd3a1a 100644
--- a/hmacdrbg/verif_hmac_drbg_update.v
+++ b/hmacdrbg/verif_hmac_drbg_update.v
@@ -1,6 +1,6 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Import ListNotations.
-Local Open Scope logic.
 
 Require Import sha.spec_sha.
 Require Import hmacdrbg.hmac_drbg.
@@ -12,7 +12,7 @@ Require Import hmacdrbg.HMAC_DRBG_common_lemmas.
 Require Import hmacdrbg.verif_hmac_drbg_update_common.
 
 Lemma BDY_update: forall
-(Espec : OracleKind)
+Espec
 (contents : list byte)
 (additional : val) (sha: share)
 (add_len : Z)
@@ -27,7 +27,7 @@ Lemma BDY_update: forall
 (H1 : add_len = Zlength contents \/ add_len = 0)
 (Hsha: readable_share sha)
 (Hshc: writable_share shc),
-@semax hmac_drbg_compspecs.CompSpecs Espec
+semax(C := hmac_drbg_compspecs.CompSpecs)(OK_spec := Espec) ⊤
  (func_tycontext f_mbedtls_hmac_drbg_update HmacDrbgVarSpecs
         HmacDrbgFunSpecs nil)
   (PROP ( )
@@ -38,9 +38,9 @@ Lemma BDY_update: forall
    data_at_ Tsh (tarray tuchar 1) sep;
    da_emp sha (tarray tuchar (Zlength contents))
      (map Vubyte contents) additional;
-   data_at shc t_struct_hmac256drbg_context_st initial_state ctx;
+   data_at(cs := hmac_drbg_compspecs.CompSpecs) shc t_struct_hmac256drbg_context_st initial_state ctx;
    hmac256drbg_relate initial_state_abs initial_state;
-   data_at shc t_struct_mbedtls_md_info info_contents
+   data_at(cs := hmac_drbg_compspecs.CompSpecs) shc t_struct_mbedtls_md_info info_contents
      (hmac256drbgstate_md_info_pointer initial_state); K_vector gv))
   (fn_body f_mbedtls_hmac_drbg_update)
   (normal_ret_assert
@@ -99,7 +99,7 @@ Proof. intros. do 2 pose proof I.
     { entailer!.
       destruct additional; simpl in PNadditional; try contradiction.
       subst i; simpl; trivial.
-      simpl. destruct (EqDec_Z add_len 0); trivial; lia.
+      simpl. destruct (eq_dec add_len 0); trivial; lia.
     }
   }
 
@@ -339,7 +339,7 @@ Proof. intros. do 2 pose proof I.
                        HMAC256 (V ++ [Byte.repr i] ++ (if na then contents else [])) key, sk, ik, Tsh, gv). 
     {
       (* prove the function parameters match up *)
-      apply prop_right. 
+      apply prop_right.
       rewrite hmac_common_lemmas.HMAC_Zlength, FA_ctx_MDCTX; simpl.
       rewrite offset_val_force_ptr, isptr_force_ptr; trivial.
     }
diff --git a/hmacdrbg/verif_hmac_drbg_update_common.v b/hmacdrbg/verif_hmac_drbg_update_common.v
index a471e232ef..8b7ca8e840 100644
--- a/hmacdrbg/verif_hmac_drbg_update_common.v
+++ b/hmacdrbg/verif_hmac_drbg_update_common.v
@@ -1,6 +1,5 @@
 Require Import VST.floyd.proofauto.
 Import ListNotations.
-Local Open Scope logic.
 
 Require Import hmacdrbg.HMAC_DRBG_algorithms.
 Require Import hmacdrbg.spec_hmac_drbg.
@@ -76,8 +75,8 @@ Lemma update_char add_len contents (HL:add_len = Zlength contents \/ add_len = 0
     HMAC_DRBG_update_round HMAC256 (contents_with_add additional add_len contents) key0 V
       (Z.to_nat
          (if
-           (negb (EqDec_val additional nullval) &&
-            negb (EqDec_Z add_len 0))%bool
+           (negb (eq_dec additional nullval) &&
+            negb (eq_dec add_len 0))%bool
           then 2
           else 1))):
 hmac256drbgabs_hmac_drbg_update
@@ -88,9 +87,9 @@ HMAC256DRBGabs key1 V0 reseed_counter entropy_len prediction_resistance
 Proof. rename key0 into K. rename V0 into VV. rename key1 into KK.
 unfold hmac256drbgabs_hmac_drbg_update, HMAC256_DRBG_functional_prog.HMAC256_DRBG_update.
 rewrite HMAC_DRBG_update_concrete_correct. unfold HMAC_DRBG_update_concrete, contents_with_add in *; simpl in *.
-destruct (EqDec_val additional nullval); simpl in *.
+destruct (eq_dec additional nullval); simpl in *.
 + inv H; trivial.
-+ destruct (EqDec_Z add_len 0).
++ destruct (eq_dec add_len 0).
   -  subst add_len. change (negb (left eq_refl)) with false in *. 
      simpl in H. inv H; trivial.
   - change (negb (right n0)) with true in *. simpl.
diff --git a/hmacdrbg/verif_mocked_md.v b/hmacdrbg/verif_mocked_md.v
index cb229e7517..d02c3d1fc9 100644
--- a/hmacdrbg/verif_mocked_md.v
+++ b/hmacdrbg/verif_mocked_md.v
@@ -1,6 +1,5 @@
 Require Import VST.floyd.proofauto.
 Import ListNotations.
-Local Open Scope logic.
 Require Import VST.zlist.sublist.
 
 Require Import hmacdrbg.hmac_drbg.
@@ -45,7 +44,7 @@ Proof.
   unfold data_block. simpl. cancel.
 Qed.
 
-#[export] Hint Extern 2 (@data_at ?cs1 ?sh _ _ ?p |-- @data_at ?cs2 ?sh _ _ ?p) =>
+#[export] Hint Extern 2 (data_at(cs := ?cs1) ?sh _ _ ?p |-- data_at(cs := ?cs2) ?sh _ _ ?p) =>
     (tryif constr_eq cs1 cs2 then fail
      else simple apply change_compspecs_data_at_cancel; 
        [ reflexivity | reflexivity | apply JMeq_refl]) : cancel.
@@ -71,7 +70,6 @@ Proof.
   assert_PROP (isptr d) by entailer!.
   (* HMAC_Update(hmac_ctx, input, ilen); *)
   destruct d; try contradiction.
-
   forward_call (key, internal_r, Ews, Vptr b i, sh, data, data1, gv).
   { unfold data_block.
     entailer!.
@@ -141,7 +139,7 @@ Proof.
   Intros vret.
 
   forward_if.
-  { simpl. destruct (EqDec_val vret nullval).
+  { simpl. destruct (eq_dec vret nullval).
     + subst vret; entailer!.
     + entailer!.
   }
diff --git a/ivst.md b/ivst.md
new file mode 100644
index 0000000000..79fbb4d9f9
--- /dev/null
+++ b/ivst.md
@@ -0,0 +1,67 @@
+# Building VST-on-Iris (VST 3.x)
+
+## Option 1: Use OPAM
+
+VST-on-Iris releases are now available on OPAM as part of the `coq-released` repo, and can be installed automatically -- look for versions numbered 3.x. It may take a few months for new versions to appear on OPAM.
+
+## Option 2: Build from Source
+
+You can either clone the current master branch, or download a release from the [Releases](https://github.com/PrincetonUniversity/VST/releases) page. Each release lists the major Iris version and CompCert version it has been tested with (CompCert is only necessary if you want to `clightgen` your own C files), and master will usually work with the same versions as the latest release. The code may also work with dev Iris versions, but probably not those any earlier than the listed version. You will also need to install `coq-flocq`, probably via OPAM.
+
+Once the dependencies are installed and you have the code, run `make -j` to build VST. If you clone the repo, you may first need to do `git submodule update --init ora` to initialize the ORA submodule.
+
+## Running Examples
+
+Run `make *.vo` to compile any example proof. For instance, to compile the [proof for the list reverse function](./progs64/verif_reverse2.v):
+
+```(bash)
+make progs64/verif_reverse2.vo -j
+```
+
+To generate a `_CoqProject` file for external use:
+
+```(bash)
+make _CoqProject
+```
+
+## For legacy VST users
+
+VST 3.x is mostly backwards-compatible. `Require Import VST.floyd.compat` to use VST 2.x notation, structure, lemma names, etc. If anything doesn't behave as expected, please contact mansky1@uic.edu.
+
+If you want to use the new features, the following information may be useful:
+
+## `VST` to `VST_on_Iris` name conversion
+
+| VST                       | vst_on_iris                         | syntax                                      |
+| ------------------------- | ---------------------------- | ------------------------------------------- |
+| prop_right                | bi.pure_intro                | φ → _ -∗ ⌜φ⌝                                |
+| andp                      | bi.and                       | ∧                                           |
+| andp_right                | bi.and_intro                 | (P -∗ Q) → (P -∗ R) → P -∗ Q ∧ R            |
+| andp_left1                | bi.and_elim_l                | P ∧ _ -∗ P                                  |
+| andp_left2                | bi.and_elim_r                | _ ∧ Q -∗ Q                                  |
+| andp_assoc                | bi.and_assoc                 | && left assoc, ∧ right assoc                |
+| andp_comm                 | bi.and_comm                  |                                             |
+| andp_derives              | bi.and_mono                  |                                             |
+|                           | >                            | ▷                                           |  |
+| now_later                 | bi.later_intro               | P -∗ ▷ P                                    |
+| intro rho (environ_index) | raise_rho                    |                                             |
+| EX                        | ∃                            | becomes Prop                                |
+| exp_andp2                 | bi.and_exist_l               | P ∧ (∃ a, Ψ a) ⊣⊢ (∃ a, P ∧ Ψ a)            |
+| exp_andp1                 | bi.and_exist_r               | (∃ a, Φ a) ∧ P ⊣⊢ (∃ a, Φ a ∧ P)            |
+| exp_left                  | bi.exist_elim                | (∀ a : A, (Φ a -∗ Q)) → (∃ a : A, Φ a) -∗ Q |
+| exp_right                 | bi.exist_intro'              | (P -∗ Ψ a) → P -∗ ∃ a0, Ψ a0                |
+|                           | semax (E:coPset) Delta P c Q |                                             |
+| FF_left                   | bi.False_elim                | False -∗ _                                  |
+| \| --                     | ⊢                            |                                             |
+
+also change `apply andp_left1/2` to `rewrite bi.and_elim_l/r`.
+
+derives_trans is a bit different from bi.wand_trans. Can be obtained by:
+
+```(Coq)
+Lemma derives_trans: forall {prop:bi} (P Q R:prop),
+  (P -∗ Q) -> (Q -∗ R) -> (P -∗ R).
+Proof. intros. rewrite H H0 //. Qed.
+```
+
+TODO: maybe move this to some library
diff --git a/lib/proof/spec_SC_atomics.v b/lib/proof/spec_SC_atomics.v
index dc14e8e91a..554b58ed5d 100644
--- a/lib/proof/spec_SC_atomics.v
+++ b/lib/proof/spec_SC_atomics.v
@@ -6,27 +6,28 @@ Require Import VSTlib.SC_atomics_extern.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
-Import VST.veric.rmaps.
-Require Import Ensembles.
+(*Import VST.veric.rmaps.*)
+(*Require Import Ensembles.*)
 Notation vint z := (Vint (Int.repr z)).
 
 
-#[export] Class AtomicsAPD := {
+#[export] Class AtomicsAPD `{!VSTGS OK_ty Σ} := {
    atomic_int : type := Tstruct _atom_int noattr;
    atomic_int_at: share -> val -> val -> mpred;
-   atomic_int_at__ : forall sh v p, atomic_int_at sh v p |-- atomic_int_at sh Vundef p;
-   atomic_int_conflict : forall sh v v' p, sepalg.nonidentity sh -> atomic_int_at sh v p * atomic_int_at sh v' p |-- FF ;
-   atomic_int_isptr : forall sh v p, atomic_int_at sh v p |-- !! isptr p;
-   atomic_int_timeless : forall sh v p, fupd.timeless' (atomic_int_at sh v p);
-   atomic_ptr : type := Tstruct _atom_ptr noattr; 
+   atomic_int_at__ : forall sh v p, atomic_int_at sh v p ⊢ atomic_int_at sh Vundef p;
+   atomic_int_conflict : forall sh v v' p, sepalg.nonidentity sh -> atomic_int_at sh v p ∗ atomic_int_at sh v' p ⊢ False%I;
+   atomic_int_isptr : forall sh v p, atomic_int_at sh v p ⊢ ⌜isptr p⌝;
+   atomic_int_timeless sh v p :: Timeless (atomic_int_at sh v p);
+   atomic_ptr : type := Tstruct _atom_ptr noattr;
    atomic_ptr_at : share -> val -> val -> mpred;
-  atomic_ptr_conflict : forall sh v v' p, sepalg.nonidentity sh -> atomic_ptr_at sh v p * atomic_ptr_at sh v' p |-- FF 
+  atomic_ptr_conflict : forall sh v v' p, sepalg.nonidentity sh -> atomic_ptr_at sh v p ∗ atomic_ptr_at sh v' p ⊢ False%I
 }.
 
 #[export] Hint Resolve atomic_int_isptr : saturate_local.
 #[export] Hint Resolve atomic_int_timeless : core.
 
 Section AtomicsASI.
+Context `{VOK: !VSTGS OK_ty Σ}.
 Context {M: AtomicsAPD}.
 
 Definition make_atomic_spec :=
@@ -36,7 +37,7 @@ Definition make_atomic_spec :=
     PARAMS (v)
     SEP ()
   POST [ tptr atomic_int ]
-   EX p : val,
+    ∃p : val,
     PROP ()
     RETURN (p)
     SEP (atomic_int_at Ews v p).
@@ -48,7 +49,7 @@ Definition make_atomic_ptr_spec :=
     PARAMS (v)
     SEP ()
   POST [ tptr atomic_ptr ]
-   EX p : val,
+     ∃ p : val,
     PROP (is_pointer_or_null p)
     RETURN (p)
     SEP (atomic_ptr_at Ews v p).
@@ -58,7 +59,7 @@ Definition free_atomic_ptr_spec :=
   PRE [ tptr atomic_ptr ]
     PROP (is_pointer_or_null p)
     PARAMS (p)
-    SEP (EX v : val, atomic_ptr_at Ews v p)
+    SEP (∃v : val, atomic_ptr_at Ews v p)
   POST[ tvoid ]
     PROP ()
     LOCAL ()
@@ -69,160 +70,118 @@ Definition free_atomic_int_spec :=
   PRE [ tptr atomic_int ]
     PROP (is_pointer_or_null p)
     PARAMS (p)
-    SEP (EX v : val, atomic_int_at Ews v p)
+    SEP (∃v : val, atomic_int_at Ews v p)
   POST[ tvoid ]
     PROP ()
     LOCAL ()
     SEP ().
 
-Definition AL_type := ProdType (ConstType (val * Ensemble nat * Ensemble nat)) (ArrowType (ConstType val) Mpred).
+
+Definition AL_type := ProdType (ProdType (ProdType (ConstType val)
+  (ConstType coPset)) (ConstType coPset))
+  (DiscreteFunType val Mpred).
 
 Program Definition atomic_load_spec := TYPE AL_type
-  WITH p : val, Eo : Ensemble nat, Ei : Ensemble nat, Q : val -> mpred
+  WITH p : val, Eo : coPset, Ei : coPset, Q : val -> mpred
   PRE [ tptr atomic_int ]
-   PROP (Included Ei Eo)
+   PROP (subseteq Ei Eo)
    PARAMS (p)
-   SEP (|={Eo,Ei}=> EX sh : share, EX v : val, !!(readable_share sh) &&
-              atomic_int_at sh v p * (atomic_int_at sh v p -* |={Ei,Eo}=> Q v))
+   SEP (|={Eo,Ei}=> ∃ sh : share, ∃ v : val, ⌜readable_share sh⌝ ∧
+              atomic_int_at sh v p ∗ (atomic_int_at sh v p -∗ |={Ei,Eo}=> Q v))
   POST [ tint ]
-   EX v : val,
+   ∃ v : val,
    PROP ()
    RETURN (v)
    SEP (Q v).
 Next Obligation.
 Proof.
-  repeat intro.
-  destruct x as (((?, ?), ?), ?).
-  unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; f_equal;
-    f_equal; f_equal; rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  setoid_rewrite fupd_nonexpansive; do 2 f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality.
-  rewrite !approx_exp; apply f_equal; extensionality.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite wand_nonexpansive_r; f_equal; f_equal.
-  apply fupd_nonexpansive.
+  intros ? (((?, ?), ?), ?) (((?, ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  repeat f_equiv.
 Qed.
 Next Obligation.
-Proof.
-  repeat intro.
-  destruct x as (((?, ?), ?), ?); simpl.
-  rewrite !approx_exp; apply f_equal; extensionality.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 apply f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem; auto.
+  intros ? (((?, ?), ?), ?) (((?, ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  repeat f_equiv.
 Qed.
 
-Definition AS_type := ProdType (ConstType (val * val * Ensemble nat * Ensemble nat)) Mpred.
+Definition AS_type := ProdType (ProdType (ProdType (ConstType (val * val))
+  (ConstType coPset)) (ConstType coPset)) Mpred.
 
 Program Definition atomic_store_spec := TYPE AS_type
-  WITH p : val, v : val, Eo : Ensemble nat, Ei : Ensemble nat, Q : mpred
+  WITH p : val, v : val, Eo : coPset, Ei : coPset, Q : mpred
   PRE [ tptr atomic_int, tint ]
-   PROP (Included Ei Eo)
+   PROP (subseteq Ei Eo)
    PARAMS (p; v)
-   SEP (|={Eo,Ei}=> EX sh : share, !!(writable_share sh) && atomic_int_at sh Vundef p *
-      (atomic_int_at sh v p -* |={Ei,Eo}=> Q))
+   SEP (|={Eo,Ei}=> ∃ sh : share, ⌜writable_share sh⌝ ∧ atomic_int_at sh Vundef p ∗
+      (atomic_int_at sh v p -∗ |={Ei,Eo}=> Q))
   POST [ tvoid ]
    PROP ()
    LOCAL ()
    SEP (Q).
 Next Obligation.
 Proof.
-  repeat intro.
-  destruct x as ((((?, ?), ?), ?), ?).
-  unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; f_equal;
-    f_equal; f_equal; rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  setoid_rewrite fupd_nonexpansive; do 2 f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality sh.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite wand_nonexpansive_r; f_equal; f_equal.
-  apply fupd_nonexpansive.
+  intros ? ((((?, ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 Next Obligation.
-Proof.
-  repeat intro.
-  destruct x as ((((?, ?), ?), ?), ?); simpl.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 apply f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem; auto.
+  intros ? ((((?, ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 
 Definition ACAS_type := ProdType (ProdType (ProdType (ConstType (val * share * val * val * val))
-  (ConstType (Ensemble nat))) (ConstType (Ensemble nat)))
-  (ArrowType (ConstType val) Mpred).
+  (ConstType coPset)) (ConstType coPset))
+  (DiscreteFunType val Mpred).
 
 Program Definition atomic_CAS_spec := TYPE ACAS_type
-  WITH p : val, shc : share, pc : val, c : val, v : val, Eo : Ensemble nat, Ei : Ensemble nat, Q : val -> mpred
+  WITH p : val, shc : share, pc : val, c : val, v : val, Eo : coPset, Ei : coPset, Q : val -> mpred
   PRE [ tptr atomic_int, tptr tint, tint ]
-   PROP (readable_share shc; Included Ei Eo)
+   PROP (readable_share shc; subseteq Ei Eo)
    PARAMS (p; pc; v)
-   SEP (data_at shc tint c pc; |={Eo,Ei}=> EX sh : share, EX v0 : val,
-      !!(writable_share sh) && atomic_int_at sh v0 p *
-           (atomic_int_at sh (if eq_dec v0 c then v else v0) p -* |={Ei,Eo}=> Q v0))
+   SEP (data_at shc tint c pc; |={Eo,Ei}=> ∃ sh : share, ∃ v0 : val,
+      ⌜writable_share sh⌝ ∧ atomic_int_at sh v0 p ∗
+           (atomic_int_at sh (if eq_dec v0 c then v else v0) p -∗ |={Ei,Eo}=> Q v0))
   POST [ tint ]
-   EX v' : val,
+   ∃ v' : val,
    PROP ()
    LOCAL (temp ret_temp (vint (if eq_dec v' c then 1 else 0)))
    SEP (data_at shc tint v' pc; Q v').
 Next Obligation.
 Proof.
-  repeat intro.
-  destruct x as (((((((?, ?), ?), ?), ?), ?), ?), ?).
-  unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; f_equal;
-    f_equal; f_equal; rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  f_equal.
-  setoid_rewrite fupd_nonexpansive; do 2 f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality sh.
-  rewrite !approx_exp; apply f_equal; extensionality.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite wand_nonexpansive_r; f_equal; f_equal.
-  apply fupd_nonexpansive.
+  intros ? (((((((?, ?), ?), ?), ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 Next Obligation.
-Proof.
-  repeat intro.
-  destruct x as (((((((?, ?), ?), ?), ?), ?), ?), ?); simpl.
-  rewrite !approx_exp; apply f_equal; extensionality vr.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 apply f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem; auto.
+  intros ? (((((((?, ?), ?), ?), ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 
 Definition AEX_type := ProdType (ProdType (ProdType (ConstType (val * val))
-  (ConstType (Ensemble nat))) (ConstType (Ensemble nat)))
-  (ArrowType (ConstType val) Mpred).
+  (ConstType coPset)) (ConstType coPset))
+  (DiscreteFunType val Mpred).
 
 Program Definition atomic_exchange_spec := TYPE AEX_type
-  WITH p : val, v : val, Eo : Ensemble nat, Ei : Ensemble nat, Q : val -> mpred
-  PRE [ tptr tint, tint ]
-   PROP (Included Ei Eo)
+  WITH p : val, v : val, Eo : coPset, Ei : coPset, Q : val -> mpred
+  PRE [ tptr atomic_int, tint ]
+   PROP (subseteq Ei Eo)
    PARAMS (p; v)
-   SEP (|={Eo,Ei}=> EX sh : share, EX v0 : val, !!(writable_share sh) &&
-              data_at sh tint v0 p *
-        (data_at sh tint v p -* |={Ei,Eo}=> Q v0))
+   SEP (|={Eo,Ei}=> ∃ sh : share, ∃ v0 : val, ⌜writable_share sh⌝ ∧
+              atomic_int_at sh v0 p ∗
+        (atomic_int_at sh v p -∗ |={Ei,Eo}=> Q v0))
   POST [ tint ]
-   EX v' : val,
+   ∃ v' : int,
    PROP ()
-   LOCAL (temp ret_temp v')
-   SEP (Q v').
+   LOCAL (temp ret_temp (Vint v'))
+   SEP (Q (Vint v')).
 Next Obligation.
 Proof.
-  repeat intro.
-  destruct x as ((((?, ?), ?), ?), ?).
-  unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; f_equal;
-    f_equal; f_equal; rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  setoid_rewrite fupd_nonexpansive; do 2 f_equal.
-  rewrite !approx_exp; apply f_equal; extensionality sh.
-  rewrite !approx_exp; apply f_equal; extensionality.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite wand_nonexpansive_r; f_equal; f_equal.
-  apply fupd_nonexpansive.
+  intros ? ((((?, ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 Next Obligation.
-Proof.
-  repeat intro.
-  destruct x as ((((?, ?), ?), ?), ?); simpl.
-  rewrite !approx_exp; apply f_equal; extensionality vr.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 apply f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem; auto.
+  intros ? ((((?, ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & [=]) & [=]) & HQ) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 
+
 Definition AtomicsASI:funspecs := [
   (_make_atomic, make_atomic_spec);
   (_make_atomic_ptr, make_atomic_ptr_spec);
diff --git a/lib/proof/spec_locks.v b/lib/proof/spec_locks.v
index db91ca2917..1c999ee3a8 100644
--- a/lib/proof/spec_locks.v
+++ b/lib/proof/spec_locks.v
@@ -1,288 +1,86 @@
-Require Import VST.veric.rmaps.
 Require Import VST.concurrency.conclib.
-Require Import VST.concurrency.cancelable_invariants.
-Require Import VST.concurrency.ghosts. 
 Require Import VSTlib.locks.
 Require Import VSTlib.spec_malloc.
-Import FashNotation.
-
-(* lock invariants should be exclusive *)
-Definition exclusive_mpred P := P * P |-- FF.
-
-Program Definition weak_exclusive_mpred (P: mpred): mpred :=
-  unfash (fash ((P * P) --> FF)).
-
-Lemma corable_weak_exclusive R : seplog.corable (weak_exclusive_mpred R).
-Proof.
-  apply assert_lemmas.corable_unfash, _.
-Qed.
-
-Lemma exclusive_mpred_nonexpansive : nonexpansive weak_exclusive_mpred.
-Proof.
-  unfold weak_exclusive_mpred, nonexpansive; intros.
-  apply @subtypes.eqp_unfash, @subtypes.eqp_subp_subp, eqp_refl.
-  apply eqp_sepcon; apply predicates_hered.derives_refl.
-Qed.
-
-Lemma exclusive_mpred_super_non_expansive:
-  forall R n, compcert_rmaps.RML.R.approx n (weak_exclusive_mpred R) =
-    compcert_rmaps.RML.R.approx n (weak_exclusive_mpred (compcert_rmaps.RML.R.approx n R)).
-Proof.
-  apply nonexpansive_super_non_expansive, exclusive_mpred_nonexpansive.
-Qed.
-
-Lemma exclusive_weak_exclusive1: forall R P,
-  exclusive_mpred R ->
-  P |-- weak_exclusive_mpred R.
-Proof.
-  intros; unfold weak_exclusive_mpred; unfold exclusive_mpred in H.
-  unseal_derives; apply derives_unfash_fash; auto.
-Qed.
-
-Lemma exclusive_weak_exclusive: forall R,
-  exclusive_mpred R ->
-  emp |-- weak_exclusive_mpred R && emp.
-Proof.
-  intros; apply andp_right; auto; apply exclusive_weak_exclusive1; auto.
-Qed.
-
-Lemma weak_exclusive_conflict : forall P,
-  (weak_exclusive_mpred P && emp) * P * P |-- FF.
-Proof.
-  intros.
-  rewrite sepcon_assoc, <- andp_left_corable by (apply corable_weak_exclusive).
-  unseal_derives; intros ? [].
-  unfold weak_exclusive_mpred in H; specialize (H a ltac:(lia) _ _ (ageable.necR_refl _) (predicates_hered.ext_refl _)).
-  apply H; auto.
-Qed.
-
-Lemma exclusive_sepcon1 : forall P Q (HP : exclusive_mpred P), exclusive_mpred (P * Q).
-Proof.
-  unfold exclusive_mpred; intros.
-  eapply derives_trans, sepcon_FF_derives' with (P := Q * Q), HP; cancel; apply derives_refl.
-Qed.
-
-Lemma exclusive_sepcon2 : forall P Q (HP : exclusive_mpred Q), exclusive_mpred (P * Q).
-Proof.
-  intros; rewrite sepcon_comm; apply exclusive_sepcon1; auto.
-Qed.
-
-Lemma exclusive_andp1 : forall P Q (HP : exclusive_mpred P), exclusive_mpred (P && Q).
-Proof.
-  unfold exclusive_mpred; intros.
-  eapply derives_trans, HP.
-  apply sepcon_derives; apply andp_left1; auto.
-Qed.
-
-Lemma exclusive_andp2 : forall P Q (HQ : exclusive_mpred Q), exclusive_mpred (P && Q).
-Proof.
-  intros; rewrite andp_comm; apply exclusive_andp1; auto.
-Qed.
-
-Lemma exclusive_FF : exclusive_mpred FF.
-Proof.
-  unfold exclusive_mpred.
-  rewrite FF_sepcon; auto.
-Qed.
-
-Lemma derives_exclusive : forall P Q (Hderives : P |-- Q) (HQ : exclusive_mpred Q),
-  exclusive_mpred P.
-Proof.
-  unfold exclusive_mpred; intros.
-  eapply derives_trans, HQ.
-  apply sepcon_derives; auto.
-Qed.
-
-Lemma mapsto_exclusive : forall (sh : Share.t) (t : type) (v : val),
-  sepalg.nonunit sh -> exclusive_mpred (EX v2 : _, mapsto sh t v v2).
-Proof.
-  intros; unfold exclusive_mpred.
-  Intros v1 v2; apply mapsto_conflict; auto.
-Qed.
-
-Lemma field_at__exclusive : forall (cs : compspecs) (sh : Share.t) (t : type) (fld : list gfield) (p : val),
-  sepalg.nonidentity sh ->
-  0 < sizeof (nested_field_type t fld) -> exclusive_mpred (field_at_ sh t fld p).
-Proof.
-  intros; apply field_at__conflict; auto.
-Qed.
-
-Lemma ex_field_at_exclusive : forall (cs : compspecs) (sh : Share.t) (t : type) (fld : list gfield) (p : val),
-  sepalg.nonidentity sh ->
-  0 < sizeof (nested_field_type t fld) -> exclusive_mpred (EX v : _, field_at sh t fld v p).
-Proof.
-  intros; unfold exclusive_mpred.
-  Intros v v'; apply field_at_conflict; auto.
-Qed.
-
-Corollary field_at_exclusive : forall (cs : compspecs) (sh : Share.t) (t : type) (fld : list gfield) v (p : val),
-  sepalg.nonidentity sh -> 0 < sizeof (nested_field_type t fld) -> exclusive_mpred (field_at sh t fld v p).
-Proof.
-  intros; eapply derives_exclusive, ex_field_at_exclusive; eauto.
-  Exists v; apply derives_refl.
-Qed.
-
-Lemma ex_data_at_exclusive : forall (cs : compspecs) (sh : Share.t) (t : type) (p : val),
-  sepalg.nonidentity sh -> 0 < sizeof t -> exclusive_mpred (EX v : _, data_at sh t v p).
-Proof.
-  intros; unfold exclusive_mpred.
-  Intros v v'; apply data_at_conflict; auto.
-Qed.
-
-Corollary data_at_exclusive : forall (cs : compspecs) (sh : Share.t) (t : type) v (p : val),
-  sepalg.nonidentity sh -> 0 < sizeof t -> exclusive_mpred (data_at sh t v p).
-Proof.
-  intros; eapply derives_exclusive, ex_data_at_exclusive; eauto.
-  Exists v; apply derives_refl.
-Qed.
-
-Corollary data_at__exclusive : forall (cs : compspecs) (sh : Share.t) (t : type) (p : val),
-  sepalg.nonidentity sh -> 0 < sizeof t -> exclusive_mpred (data_at_ sh t p).
-Proof.
-  intros; eapply derives_exclusive, data_at_exclusive; eauto.
-  apply data_at__data_at; eauto.
-Qed.
-
-Definition lock_handle : Type := val * invariants.iname * ghosts.gname.
+Require Import iris_ora.logic.cancelable_invariants.
 
+Definition lock_handle : Type := val * namespace * gname.
 Definition ptr_of (h: lock_handle) : val := let '(v, i, g) := h in v.
 
-  (* We can use self_part sh h * R instead of selflock sh h R. *)
-Definition self_part sh (h : val * invariants.iname * ghosts.gname) := let '(v, i, g) := h in cinv_own g sh.
+ (* We can use self_part sh h * R instead of selflock sh h R. *)
+Definition self_part `{!VSTGS OK_ty Σ, !cinvG Σ} sh (h : lock_handle) := let '(v, i, g) := h in cinv_own g sh.
 
-Lemma self_part_exclusive : forall sh h, sh <> Share.bot -> exclusive_mpred (self_part sh h).
-  Proof.
-    intros; unfold exclusive_mpred, self_part; destruct h as ((?, ?), ?).
-    unfold cinv_own; rewrite own_op'; Intros ?.
-    apply sepalg.join_self, identity_share_bot in H0; contradiction.
-  Qed.
+Section GFUNCTORS.
 
-#[export] Hint Resolve self_part_exclusive : core.
+Context `{!VSTGS OK_ty Σ, !cinvG Σ}.
 
 
 Class lockAPD := {
   t_lock : type := Tstruct _atom_int noattr;
   inv_for_lock: forall (v: val) (R: mpred), mpred;
-  inv_for_lock_nonexpansive : forall v, nonexpansive (inv_for_lock v)
+  inv_for_lock_nonexpansive : forall v, NonExpansive (inv_for_lock v)
 }.
 
-Definition lock_inv {L: lockAPD} (sh: share) (h: lock_handle)  (R: mpred) :=
-   let '(v, i, g) := h in !!(sh <> Share.bot /\ isptr v) && cinvariant i g (inv_for_lock v R) * cinv_own g sh.
+#[export] Existing Instance inv_for_lock_nonexpansive.
 
-Lemma lock_inv_nonexpansive {L: lockAPD}  : forall sh h, nonexpansive (lock_inv sh h).
-  Proof.
-   intros.
-    unfold lock_inv. destruct h as [[? ?] ?].
-    apply sepcon_nonexpansive, const_nonexpansive.
-    apply @conj_nonexpansive; [apply const_nonexpansive|].
-    apply cinvariant_nonexpansive2, inv_for_lock_nonexpansive.
-  Qed.
+Definition lock_inv {L: lockAPD} (sh: Qp) (h: lock_handle)  (R: mpred) :=
+   let '(v, i, g) := h in ⌜ isptr v⌝ ∧ cinv i g (inv_for_lock v R) ∗ cinv_own g sh.
 
-Lemma lock_inv_share_join {L: lockAPD} : forall sh1 sh2 sh3 h R, sh1 <> Share.bot -> sh2 <> Share.bot ->
-    sepalg.join sh1 sh2 sh3 -> lock_inv sh1 h R * lock_inv sh2 h R = lock_inv sh3 h R.
-  Proof.
-    unfold lock_inv. destruct h as [[??]?]. intros.
-    destruct (isptr_dec v).
-    rewrite !prop_true_andp; auto.
-    rewrite <- !sepcon_assoc, (sepcon_comm (_ * cinv_own _ _)), !sepcon_assoc.
-    unfold cinv_own at 1 2; erewrite <- own_op by eauto.
-    rewrite <- sepcon_assoc; f_equal.
-    symmetry; apply cinvariant_dup.
-    { split; auto; intros ?; subst. apply join_Bot in H1 as []; contradiction. }
-    { rewrite prop_false_andp, !FF_sepcon, prop_false_andp, FF_sepcon; auto; intros []; contradiction. }
-  Qed.
-
-Lemma lock_inv_exclusive  {L: lockAPD} : forall sh h R, exclusive_mpred (lock_inv sh h R).
-  Proof.
-    intros. destruct h as [[??]?].
-    unfold exclusive_mpred, lock_inv; Intros.
-    unfold cinv_own. sep_apply @own_op'.
-    Intros ?; Intros.
-    apply sepalg.join_self, identity_share_bot in H0; contradiction.
-  Qed.
+#[export] Instance lock_inv_nonexpansive {L: lockAPD}: 
+  ∀ (sh : Qp) (h : val * namespace * gname) (n : nat),
+  Proper (dist n ==> dist n) (lock_inv sh h).
+Proof. unfold lock_inv. solve_proper. Qed.
 
-Lemma lock_inv_share  {L: lockAPD} : forall sh h R, lock_inv sh h R |-- !!(sh <> Share.bot /\ isptr (ptr_of h)).
+Lemma self_part_eq {L: lockAPD}: forall sh1 sh2 h R, 
+    lock_inv sh1 h (self_part sh2 h ∗ R) ∗ self_part sh2 h ⊣⊢
+    lock_inv sh1 h (self_part sh2 h ∗ R) ∗ lock_inv sh2 h (self_part sh2 h ∗ R).
   Proof.
     intros.
-    unfold lock_inv. destruct h as [[??]?]. entailer!. 
-Qed.
-
-#[export] Hint Resolve lock_inv_share : saturate_local.
-
-#[export] Hint Resolve lock_inv_exclusive data_at_exclusive data_at__exclusive field_at_exclusive field_at__exclusive : core.
+    simpl; unfold lock_inv; destruct h as ((?, ?), ?).
+    iSplit.
+    - iIntros "((#$ & #$ & $) & $)".
+    - iIntros "(($ & $ & $) & (_ & _ & $))".
+  Qed.
 
-Lemma self_part_eq  {L: lockAPD} : forall 
-    (sh1 sh2: share)
-   (h: val * invariants.iname * ghosts.gname) R, 
-   sh2 <> Share.bot -> 
-    lock_inv sh1 h (self_part sh2 h * R) * self_part sh2 h =
-    lock_inv sh1 h (self_part sh2 h * R) * lock_inv sh2 h (self_part sh2 h * R).
+Lemma lock_inv_share_join {L: lockAPD} : forall sh1 sh2 h R,
+    lock_inv sh1 h R ∗ lock_inv sh2 h R ⊣⊢ lock_inv (sh1 ⋅ sh2) h R.
   Proof.
-    intros.
-    simpl; unfold self_part, lock_inv; destruct h as ((?, ?), ?).
-    destruct (eq_dec sh1 Share.bot).
-    { rewrite prop_false_andp, !FF_sepcon; auto; intros []; contradiction. }
-    destruct (isptr_dec v).
-    rewrite !prop_true_andp by auto.
-    rewrite cinvariant_dup at 1.
-    rewrite <- !sepcon_assoc; f_equal.
-    rewrite (sepcon_comm (_ * _) (cinvariant _ _ _)), <- sepcon_assoc; reflexivity.
-    { rewrite prop_false_andp, !FF_sepcon; auto; intros []; contradiction. }
+    unfold lock_inv.
+    intros ?? ((?, ?), ?) ?.
+    rewrite /cinv_own own_op; iSplit.
+    - iIntros "(($ & $ & $) & (_ & _ & $))".
+    - iIntros "(#$ & #$ & $ & $)".
   Qed.
 
-Ltac lock_props := match goal with |-context[weak_exclusive_mpred ?P && emp] => sep_apply (exclusive_weak_exclusive P); [auto with share | try timeout 20 cancel] end.
-
 Section lock_specs.
 
   Context {M: MallocAPD} {L : lockAPD}.
 
-  Definition selflock R sh h := self_part sh h * R.
+  Definition selflock R sh h := self_part sh h ∗ R.
 
-  Lemma lock_inv_isptr : forall sh h R, lock_inv sh h R |-- !! isptr (ptr_of h).
-  Proof. intros. entailer!. Qed.
-
-  Lemma lock_inv_nonexpansive2 : forall {A} (P Q : A -> mpred) sh p x, (ALL x : _, |> (P x <=> Q x) |--
-    |> lock_inv sh p (P x) <=> |> lock_inv sh p (Q x))%logic.
-  Proof.
-    intros.
-    apply allp_left with x.
-    eapply derives_trans, eqp_later1; apply later_derives.
-    apply nonexpansive_entail; apply lock_inv_nonexpansive.
-  Qed.
-
-  Lemma lock_inv_super_non_expansive : forall sh h R n,
-    compcert_rmaps.RML.R.approx n (lock_inv sh h R) = compcert_rmaps.RML.R.approx n (lock_inv sh h (compcert_rmaps.RML.R.approx n R)).
-  Proof.
-    intros; apply nonexpansive_super_non_expansive, lock_inv_nonexpansive.
-  Qed.
+  Lemma lock_inv_isptr : forall sh h R, lock_inv sh h R ⊢ ⌜isptr (ptr_of h)⌝.
+  Proof. intros. destruct h as [[? ?] ?]; simpl. entailer!!. Qed.
 
   Notation InvType := Mpred.
 
   (* R should be able to take the lock_handle as an argument, with subspecs for plain and selflock *)
   Program Definition makelock_spec :=
-    TYPE (ProdType (ConstType globals) (ArrowType (ConstType lock_handle) InvType)) WITH gv: _, R : _
+    TYPE (ProdType (ConstType globals) (DiscreteFunType lock_handle InvType)) WITH gv: _, R : _
     PRE [ ]
        PROP ()
        PARAMS () GLOBALS (gv)
-       SEP (M.(mem_mgr) gv)
-    POST [ tptr t_lock ] EX h,
+       SEP (mem_mgr gv)
+    POST [ tptr t_lock ] ∃ h,
        PROP ()
        RETURN (ptr_of h)
-       SEP (M.(mem_mgr) gv; lock_inv Tsh h (R h)).
+       SEP (mem_mgr gv; lock_inv 1 h (R h)).
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x; simpl.
-    reflexivity.
+    intros ? (?, ?) (?, ?) ([=] & HR) ?; simpl in *; subst; done.
   Qed.
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x; simpl.
-    rewrite !approx_exp; f_equal; extensionality.
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; do 2 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    f_equal; apply lock_inv_super_non_expansive.
+    intros ? (?, ?) (?, ?) ([=] & HR) ?; simpl in *; subst.
+    unfold lock_inv. repeat f_equiv.
   Qed.
 
   Program Definition freelock_spec :=
@@ -291,31 +89,20 @@ Section lock_specs.
     PRE [ tptr t_lock ]
      PROP ()
      PARAMS (ptr_of h)
-     SEP (lock_inv Tsh h R; P; (P * lock_inv Tsh h R * R -* FF) && emp)
+     SEP (lock_inv 1 h R; P; <affine> (P ∗ lock_inv 1 h R ∗ R -∗ False))
    POST[ tvoid ]
      PROP ()
      LOCAL ()
      SEP (P).
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x as ((?, ?), ?); simpl.
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; do 3 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    f_equal.
-    { apply lock_inv_super_non_expansive. }
-    f_equal.
-    rewrite !approx_andp; f_equal.
-    setoid_rewrite wand_nonexpansive; rewrite !approx_sepcon; do 2 f_equal; rewrite !approx_idem; auto.
-    do 2 f_equal; apply lock_inv_super_non_expansive.
+    intros ? ((?, ?), ?) ((?, ?), ?) (([=] & HR) & HP) ?; simpl in *; subst.
+    by repeat f_equiv.
   Qed.
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x as ((?, ?), ?); simpl.
-    unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    reflexivity.
+    intros ? ((?, ?), ?) ((?, ?), ?) (([=] & HR) & HP) ?; simpl in *; subst.
+    by repeat f_equiv.
   Qed.
 
   Program Definition freelock_spec_simple :=
@@ -324,48 +111,43 @@ Section lock_specs.
     PRE [ tptr t_lock ]
      PROP ()
      PARAMS (ptr_of h)
-     SEP (weak_exclusive_mpred R && emp; lock_inv Tsh h R; R)
+     SEP (<affine> (R ∗ R -∗ False); lock_inv 1 h R; R)
    POST[ tvoid ]
      PROP ()
      LOCAL ()
      SEP (R).
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x; simpl.
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; do 3 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    f_equal.
-    { rewrite !approx_andp; f_equal.
-      apply exclusive_mpred_super_non_expansive. }
-    f_equal. apply lock_inv_super_non_expansive.
+    intros ? (?, ?) (?, ?) ([=] & HR) ?; simpl in *; subst.
+    by repeat f_equiv.
   Qed.
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x; simpl.
-    unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    reflexivity.
+    intros ? (?, ?) (?, ?) ([=] & HR) ?; simpl in *; subst.
+    by repeat f_equiv.
   Qed.
 
   Lemma freelock_simple : funspec_sub freelock_spec freelock_spec_simple.
   Proof.
     unfold funspec_sub; simpl.
-    split; auto; intros ? (h, R) ?; Intros.
-    eapply derives_trans, fupd_intro.
-    Exists (nil : list Type) (h, R, R) emp; entailer!.
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; entailer!.
-    apply andp_right, andp_left2; auto.
-    rewrite <- wand_sepcon_adjoint; sep_apply weak_exclusive_conflict; auto.
-    rewrite FF_sepcon; auto.
+    split; first done; intros (h, R) ?; Intros.
+    iIntros "(? & ? & H) !>"; iExists (h, R, R), emp.
+    iSplit; first done.
+    iSplit; last by iPureIntro; entailer!.
+    repeat (iSplit; first done).
+    rewrite /SEPx /= /LOCALx /argsassert2assert /=; monPred.unseal.
+    repeat (iSplit; first done).
+    iDestruct "H" as "(? & HR & $ & $ & _)".
+    repeat (iSplit; last done).
+    iApply (bi.affinely_mono with "HR").
+    iIntros "HR (? & ? & ?)"; iApply ("HR" with "[$]").
   Qed.
 
   Program Definition acquire_spec :=
     TYPE (ProdType (ConstType _) InvType)
     WITH sh : _, h : _, R : _
     PRE [ tptr t_lock ]
-       PROP (sh <> Share.bot)
+       PROP ()
        PARAMS (ptr_of h)
        SEP (lock_inv sh h R)
     POST [ tvoid ]
@@ -374,127 +156,96 @@ Section lock_specs.
        SEP (lock_inv sh h R; R).
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x as ((?, ?), ?); simpl.
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; do 3 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    apply lock_inv_super_non_expansive.
+    intros ? ((?, ?), ?) ((?, ?), ?) ([=] & HR) ?; simpl in *; subst.
+    by repeat f_equiv.
   Qed.
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x as ((?, ?), ?); simpl.
-    unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    f_equal. apply lock_inv_super_non_expansive.
+    intros ? ((?, ?), ?) ((?, ?), ?) ([=] & HR) ?; simpl in *; subst.
+    by repeat f_equiv.
   Qed.
 
   Program Definition release_spec :=
     TYPE (ProdType (ProdType (ProdType (ConstType _) InvType) Mpred) Mpred)
     WITH sh : _, h : _, R : _, P : _, Q : _
     PRE [ tptr t_lock ]
-       PROP (sh <> Share.bot)
+       PROP ()
        PARAMS (ptr_of h)
-       SEP (weak_exclusive_mpred R && emp; |> lock_inv sh h R; P; lock_inv sh h R * P -* Q * R)
+       SEP (<affine> (R ∗ R -∗ False); ▷ lock_inv sh h R; P; lock_inv sh h R ∗ P -∗ Q ∗ R)
     POST [ tvoid ]
        PROP ()
        LOCAL ()
        SEP (Q).
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x as ((((?, ?), ?), ?), ?); simpl.
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; do 3 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    f_equal.
-    { rewrite !approx_andp; f_equal.
-      apply exclusive_mpred_super_non_expansive. }
-    f_equal.
-    { setoid_rewrite later_nonexpansive; do 2 f_equal.
-      apply lock_inv_super_non_expansive. }
-    f_equal.
-    setoid_rewrite wand_nonexpansive; rewrite !approx_sepcon; do 2 f_equal; rewrite !approx_idem; f_equal.
-    apply lock_inv_super_non_expansive.
+    intros ? ((((?, ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & HR) & HP) & HQ) ?; simpl in *; subst.
+    by repeat f_equiv.
   Qed.
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x as ((((?, ?), ?), ?), ?); simpl.
-    unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    reflexivity.
+    intros ? ((((?, ?), ?), ?), ?) ((((?, ?), ?), ?), ?) ((([=] & HR) & HP) & HQ) ?; simpl in *; subst.
+    by repeat f_equiv.
   Qed.
 
   Program Definition release_spec_simple :=
     TYPE (ProdType (ConstType _) InvType)
     WITH sh : _, h : _, R : _
     PRE [ tptr t_lock ]
-       PROP (sh <> Share.bot)
+       PROP ()
        PARAMS (ptr_of h)
-       SEP (weak_exclusive_mpred R && emp; lock_inv sh h R; R)
+       SEP (<affine> (R ∗ R -∗ False); lock_inv sh h R; R)
     POST [ tvoid ]
        PROP ()
        LOCAL ()
        SEP (lock_inv sh h R).
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x as ((?, ?), ?); simpl.
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; do 3 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    f_equal.
-    { rewrite !approx_andp; f_equal.
-      apply exclusive_mpred_super_non_expansive. }
-    f_equal.
-    apply lock_inv_super_non_expansive.
+    intros ? ((?, ?), ?) ((?, ?), ?) ([=] & HR) ?; simpl in *; subst.
+    by repeat f_equiv.
   Qed.
   Next Obligation.
   Proof.
-    repeat intro.
-    destruct x as ((?, ?), ?); simpl.
-    unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 f_equal;
-      rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-    apply lock_inv_super_non_expansive.
+    intros ? ((?, ?), ?) ((?, ?), ?) ([=] & HR) ?; simpl in *; subst.
+    by repeat f_equiv.
   Qed.
 
   Lemma release_simple : funspec_sub release_spec release_spec_simple.
   Proof.
     unfold funspec_sub; simpl.
-    split; auto; intros ? ((sh, h), R) ?; Intros.
-    eapply derives_trans, fupd_intro.
-    Exists (nil : list Type) (sh, h, R, R, lock_inv sh h R) emp; entailer!.
-    unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; entailer!.
-    apply wand_refl_cancel_right.
+    split; first done; intros ((sh, h), R) ?; Intros.
+    iIntros "(? & ? & H) !>"; iExists (sh, h, R, R, lock_inv sh h R), emp.
+    iSplit; first done.
+    iSplit; last by iPureIntro; entailer!.
+    repeat (iSplit; first done).
+    rewrite /SEPx /= /LOCALx /argsassert2assert /=; monPred.unseal.
+    repeat (iSplit; first done).
+    iDestruct "H" as "(? & HR & $ & $ & _)".
+    iFrame; auto.
   Qed.
 
+Opaque lock_inv.
+
 (* freelock and release specialized for self_part *)
 Program Definition freelock_spec_self :=
   TYPE (ProdType (ConstType _) Mpred)
   WITH sh1 : _, sh2 : _, h : _, R : _
   PRE [ tptr t_lock ]
-     PROP (sh2 <> Share.bot; sepalg.join sh1 sh2 Tsh)
+     PROP (sh1 ⋅ sh2 = 1%Qp)
      PARAMS (ptr_of h)
-     SEP (lock_inv sh1 h (self_part sh2 h * R); self_part sh2 h)
+     SEP (lock_inv sh1 h (self_part sh2 h ∗ R); self_part sh2 h)
   POST [ tvoid ]
      PROP ()
      LOCAL ()
      SEP ().
 Next Obligation.
 Proof.
-  repeat intro.
-  destruct x as (((?, ?), ?), ?); simpl.
-  unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; do 3 f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  f_equal.
-  setoid_rewrite lock_inv_super_non_expansive; do 2 f_equal.
-  rewrite !approx_sepcon, approx_idem; auto.
+  intros ? (((?, ?), ?), ?) (((?, ?), ?), ?) ([=] & HR) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 Next Obligation.
 Proof.
-  repeat intro.
-  destruct x as (((?, ?), ?), ?); simpl.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; do 2 f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
+  intros ? (((?, ?), ?), ?) (((?, ?), ?), ?) ([=] & HR) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 
 Program Definition release_spec_self :=
@@ -503,64 +254,63 @@ Program Definition release_spec_self :=
   PRE [ tptr t_lock ]
      PROP ()
      PARAMS (ptr_of h)
-     SEP (lock_inv sh h (self_part sh h * R); R)
+     SEP (<affine> (R ∗ R -∗ False); lock_inv sh h (self_part sh h ∗ R); R)
   POST [ tvoid ]
      PROP ()
      LOCAL ()
      SEP ().
 Next Obligation.
 Proof.
-  repeat intro.
-  destruct x as ((?, ?), ?); simpl.
-  unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; do 3 f_equal;
-    rewrite -> !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  f_equal.
-  setoid_rewrite lock_inv_super_non_expansive; do 2 f_equal.
-  rewrite !approx_sepcon, approx_idem; auto.
+  intros ? ((?, ?), ?) ((?, ?), ?) ([=] & HR) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 Next Obligation.
 Proof.
-  repeat intro.
-  destruct x as ((?, ?), ?); simpl.
-  reflexivity.
+  intros ? ((?, ?), ?) ((?, ?), ?) ([=] & HR) ?; simpl in *; subst.
+  by repeat f_equiv.
 Qed.
 
-Lemma release_self : funspec_sub release_spec release_spec_self.
+Transparent lock_inv.
+
+Lemma release_self : funspec_sub lock_specs.release_spec release_spec_self.
 Proof.
   unfold funspec_sub; simpl.
-  split; auto; intros ? ((sh, h), R) ?; Intros.
-  eapply derives_trans, fupd_intro.
-  Exists (nil : list Type) (sh, h, self_part sh h * R, R, emp) emp; entailer!.
-  { intros; unfold PROPx, LOCALx, SEPx; simpl; entailer!. }
-  unfold lock_inv; destruct h as ((?, ?), ?).
-  unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; entailer!.
-  lock_props.
-  { apply exclusive_sepcon1.
-     apply (self_part_exclusive sh (v,i,g)); auto.
- }
-  rewrite <- sepcon_emp at 1; apply sepcon_derives; [apply now_later|].
-  rewrite <- wand_sepcon_adjoint, emp_sepcon; cancel.
-  apply inv_dealloc.
+  split; first done; intros ((sh, h), R) ?; Intros.
+  iIntros "(? & ? & H) !>"; iExists (sh, h, self_part sh h ∗ R, R, emp), emp.
+  iSplit; first done.
+  iSplit.
+  - repeat (iSplit; first done).
+    rewrite /SEPx /= /LOCALx /argsassert2assert /=; monPred.unseal.
+    repeat (iSplit; first done).
+    iDestruct "H" as "(? & HR & ? & ? & _)"; iFrame.
+    iSplitL "HR".
+    + iIntros "!> ((? & ?) & (? & ?))".
+      rewrite bi.affinely_elim; iApply ("HR" with "[$]").
+    + iSplit; first done; iSplit; last done.
+      destruct h as ((?, ?), ?); iIntros "((% & (? & $)) & $)".
+  - iPureIntro; intros.
+    unfold PROPx, LOCALx, SEPx; simpl; entailer!.
 Qed.
 
-Lemma freelock_self : funspec_sub freelock_spec freelock_spec_self.
+Lemma freelock_self : funspec_sub lock_specs.freelock_spec freelock_spec_self.
 Proof.
-  unfold freelock_spec, freelock_spec_self.
   unfold funspec_sub; simpl.
-  split; auto; intros ? (((sh1, sh2), h), R) ?; Intros.
-  eapply derives_trans, fupd_intro.
-  Exists (nil : list Type) (h, self_part sh2 h * R, emp) emp; entailer!.
-  { intros; unfold PROPx, LOCALx, SEPx; simpl; entailer!. }
-  unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl.
-  set (P := _ * _); entailer!; subst P.
-  rewrite sepcon_emp; setoid_rewrite self_part_eq; auto.
-  saturate_local.
-  erewrite lock_inv_share_join by eauto; simpl; cancel.
-  apply andp_right; auto.
-  rewrite <- wand_sepcon_adjoint, emp_sepcon.
-  destruct h as ((p, i), g); simpl; Intros.
-  sep_apply cinv_own_excl.
-  rewrite FF_sepcon; auto.
+  split; first done; intros (((sh1, sh2), h), R) ?; Intros.
+  iIntros "((%Hsh & _) & ? & H) !>"; iExists (h, self_part sh2 h ∗ R, emp), emp.
+  iSplit; first done.
+  iSplit.
+  - repeat (iSplit; first done).
+    rewrite /SEPx /= /LOCALx /argsassert2assert /=; monPred.unseal.
+    repeat (iSplit; first done).
+    iDestruct "H" as "(? & p & self & _)"; iFrame.
+    iCombine "p self" as "p"; rewrite self_part_eq lock_inv_share_join Hsh; iFrame.
+    iSplit; first done; iSplit; last done.
+    iIntros "!> (_ & p & self & ?)".
+    iCombine "p self" as "p"; rewrite self_part_eq lock_inv_share_join.
+    destruct h as ((?, ?), ?); simpl.
+    iDestruct "p" as "(_ & _ & ? & ?)"; iApply (cinv_own_1_l with "[$] [$]").
+  - iPureIntro; intros.
+    unfold PROPx, LOCALx, SEPx; simpl; entailer!.
 Qed.
 
 Opaque lock_handle.
@@ -578,3 +328,11 @@ Definition LockASI:funspecs := [
 ].
 
 End lock_specs.
+End GFUNCTORS.
+
+Ltac lock_props := match goal with |-context[<affine> (?P ∗ ?P -∗ False)] => rewrite -(exclusive_weak_exclusive P);
+  [rewrite bi.affinely_emp ?bi.emp_sep ?bi.sep_emp | auto with share] end.
+
+
+#[export] Hint Resolve lock_inv_isptr : saturate_local.
+
diff --git a/lib/proof/spec_malloc.v b/lib/proof/spec_malloc.v
index 36df37d61b..9f927f580e 100644
--- a/lib/proof/spec_malloc.v
+++ b/lib/proof/spec_malloc.v
@@ -1,8 +1,12 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat.
 Require Import VSTlib.malloc_extern.
 
 Local Open Scope assert.
 
+Section GFUNCTORS.
+Context `{VSTGS_OK: !VSTGS OK_ty Σ}.
+
 Class MallocAPD := {
    mem_mgr: globals -> mpred;
    malloc_token': share -> Z -> val -> mpred;
@@ -22,22 +26,24 @@ Lemma malloc_token_valid_pointer: forall {cs: compspecs} {M: MallocAPD} sh t p,
 Proof. intros. unfold malloc_token.
  apply andp_left2. apply malloc_token'_valid_pointer.
 Qed.
-
-#[export] Hint Resolve malloc_token'_valid_pointer : valid_pointer.
-#[export] Hint Resolve malloc_token_valid_pointer : valid_pointer.
-
 Lemma malloc_token_local_facts:  forall {cs: compspecs} {M: MallocAPD} sh t p,
       malloc_token sh t p |-- !! (field_compatible t [] p /\ malloc_compatible (sizeof t) p).
 Proof. intros.
  unfold malloc_token.
- normalize. rewrite prop_and.
- apply andp_right. apply prop_right; auto.
+ normalize.
+ apply prop_and_right; auto.
  apply malloc_token'_local_facts.
 Qed.
+End GFUNCTORS.
+
+#[export] Hint Resolve malloc_token'_valid_pointer : valid_pointer.
+#[export] Hint Resolve malloc_token_valid_pointer : valid_pointer.
+
 #[export] Hint Resolve malloc_token'_local_facts : saturate_local.
 #[export] Hint Resolve malloc_token_local_facts : saturate_local.
 
 Section MallocASI.
+Context `{VSTGS_OK: !VSTGS OK_ty Σ}.
 Context {M:MallocAPD}.
 
 Definition malloc_spec' :=
@@ -103,7 +109,10 @@ Lemma malloc_spec_sub:
    funspec_sub (snd malloc_spec') (snd (malloc_spec t)).
 Proof.
 do_funspec_sub. rename w into gv. clear H.
-Exists (sizeof t, gv) emp. simpl; entailer!.
+rewrite <- fupd_intro.
+Exists (sizeof t, gv).
+Exists  (@bi_emp (iPropI Σ)).
+simpl; entailer!.
 intros tau ? ?. Exists (eval_id ret_temp tau).
 entailer!.
 if_tac; auto.
@@ -120,7 +129,8 @@ Lemma free_spec_sub:
    funspec_sub (snd free_spec') (snd (free_spec t)).
 Proof.
 do_funspec_sub. destruct w as [p gv]. clear H.
-Exists (sizeof t, p, gv) emp. simpl; entailer!.
+rewrite <- fupd_intro.
+Exists (sizeof t, p, gv) (@bi_emp (iPropI Σ)). simpl; entailer!.
 if_tac; trivial.
 sep_apply data_at__memory_block_cancel.
 unfold malloc_token; entailer!.
diff --git a/lib/proof/spec_math.v b/lib/proof/spec_math.v
index 8ea1761ca2..bc7b334001 100644
--- a/lib/proof/spec_math.v
+++ b/lib/proof/spec_math.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat.
 Require Import VSTlib.math_extern.
 Require Import vcfloat.FPCompCert vcfloat.klist vcfloat.FPCore.
 Require Import Reals.
@@ -130,15 +131,21 @@ Defined.
 Definition reflect_to_val (t: FPCore.type) (x: ftype t) : val :=
   reflect_to_val_constructor t x.
 
+
+Section GFUNCTORS.
+Context `{VSTGS_OK: !VSTGS OK_ty Σ}.
+
 Definition vacuous_funspec' args result : funspec := 
-  mk_funspec (map reflect_to_ctype args, reflect_to_ctype result) cc_default
-     (rmaps.ConstType Impossible)
-     (fun _ _ => FF) (fun _ _ => FF) 
-     (args_const_super_non_expansive _ _) (const_super_non_expansive _ _).
+  mk_funspec (map reflect_to_ctype args, reflect_to_ctype result)
+     cc_default
+     (ConstType Impossible)
+  (λne a, ⊤)
+ (λne a : leibnizO Impossible , (fun _ => FF): _ -d> iProp Σ)
+ (λne a : leibnizO Impossible , (fun _ => FF): _ -d> iProp Σ).
 
 Definition floatspec {args result} :
   forall {precond rfunc} 
-       (ff: floatfunc args result precond rfunc), funspec.
+       (ff: floatfunc args result precond rfunc), @funspec Σ.
 refine (match args with [a1] => _ | [a1;a2] => _ | [a1;a2;a3] => _ | _ => _ end); 
   intros.
 exact (vacuous_funspec' args result).
@@ -175,12 +182,6 @@ refine (
 exact (vacuous_funspec' args result).
 Defined.
 
-Ltac floatspec f :=
-   let a := constr:(floatspec f) in
-   let a := eval cbv [floatspec reflect_to_ctype reflect_to_val reflect_to_val_constructor] in a in 
-   let a := eval simpl in a in
-   exact a.
-
 Lemma generic_round_property:
   forall (t: type) (x: R),
 exists delta epsilon : R,
@@ -395,7 +396,7 @@ simpl.
 rewrite !Rmult_1_l.
 apply generic_round_property.
 +
-exfalso; clear - H H0 H2 FIN.
+exfalso; clear - VSTGS_OK H H0 H2 FIN.
 pose proof trunc_ff_aux t x FIN.
 Lra.lra.
 -
@@ -556,7 +557,7 @@ apply fma_ff_aux1.
 apply fma_ff_aux2.
 Defined.
 
-Definition ldexp_spec' (t: type) `{STD: is_standard t}:=
+Definition ldexp_spec' (t: type) `{STD: is_standard t} : @funspec Σ :=
    WITH x : ftype t, i: Z
    PRE [ reflect_to_ctype t , tint ]
        PROP (Int.min_signed <= i <= Int.max_signed)
@@ -575,13 +576,13 @@ Definition frexp_spec' (t: type) `{STD: is_standard t} :=
    PRE [ reflect_to_ctype t , tptr tint ]
        PROP (writable_share sh)
        PARAMS (reflect_to_val t x; p)
-       SEP (@data_at_ emptyCS sh tint p)
+       SEP (data_at_ (cs:=emptyCS) sh tint p)
     POST [ reflect_to_ctype t ]
        PROP ()
        RETURN (reflect_to_val t 
                      (ftype_of_float (fst (Binary.Bfrexp (fprec t) (femax t)  (fprec_gt_0 t) 
                               (float_of_ftype x)))))
-       SEP (@data_at emptyCS sh tint (Vint (Int.repr 
+       SEP (data_at (cs:=emptyCS) sh tint (Vint (Int.repr 
                          (snd (Binary.Bfrexp (fprec t) (femax t)  (fprec_gt_0 t) 
                               (float_of_ftype x)))))
                          p).
@@ -601,7 +602,7 @@ Definition nextafter (t: type) `{STD: is_standard t} (x y: ftype t) : ftype t :=
   | None => ftype_of_float (proj1_sig (bogus_nan t _))
   end.
 
-Definition nextafter_spec' (t: type) `{STD: is_standard t}  :=
+Definition nextafter_spec' (t: type) `{STD: is_standard t} : @funspec Σ  :=
    WITH x : ftype t, y: ftype t
    PRE [ reflect_to_ctype t , reflect_to_ctype t ]
        PROP ()
@@ -621,7 +622,7 @@ Definition copysign (t: type) `{STD: is_standard t} (x y: ftype t) : ftype t :=
  | Binary.B754_nan _ _ _ pl H => Binary.B754_nan _ _ (Binary.Bsign _ _ (float_of_ftype y)) pl H
 end.
 
-Definition copysign_spec' (t: type) `{STD: is_standard t} :=
+Definition copysign_spec' (t: type) `{STD: is_standard t} : @funspec Σ  :=
    WITH x : ftype t, y : ftype t
    PRE [ reflect_to_ctype t , reflect_to_ctype t ]
        PROP ()
@@ -632,7 +633,7 @@ Definition copysign_spec' (t: type) `{STD: is_standard t} :=
        RETURN (reflect_to_val t (copysign t x y))
        SEP ().
 
-Definition nan_spec' (t: type) `{STD: is_standard t} :=
+Definition nan_spec' (t: type) `{STD: is_standard t}: @funspec Σ  :=
    WITH p: val
    PRE [ tptr tschar ]
        PROP ()
@@ -653,6 +654,14 @@ Fixpoint always_true (args: list type) : function_type (map RR args) Prop :=
  | _ :: args' => fun _ => always_true args'
  end.
 
+End GFUNCTORS.
+
+Ltac floatspec Σ f :=
+   let a := constr:(floatspec (Σ:=Σ) f) in
+   let a := eval cbv [floatspec reflect_to_ctype reflect_to_val reflect_to_val_constructor] in a in 
+   let a := eval simpl in a in
+   exact a.
+
 Ltac vacuous_bnds_list tys :=
  match tys with
  | nil => constr:(@Knil _ bounds )
@@ -741,61 +750,64 @@ Ltac reduce1 t :=
    let a := eval simpl in a in
    exact a.
 
-Definition acos_spec := DECLARE _acos ltac:(floatspec MF.acos).
-Definition acosf_spec := DECLARE _acosf ltac:(floatspec MF.acosf).
-Definition acosh_spec := DECLARE _acosh ltac:(floatspec MF.acosh).
-Definition acoshf_spec := DECLARE _acoshf ltac:(floatspec MF.acoshf).
-Definition asin_spec := DECLARE _asin ltac:(floatspec MF.asin).
-Definition asinf_spec := DECLARE _asinf ltac:(floatspec MF.asinf).
-Definition asinh_spec := DECLARE _asinh ltac:(floatspec MF.asinh).
-Definition asinhf_spec := DECLARE _asinhf ltac:(floatspec MF.asinhf).
-Definition atan_spec := DECLARE _atan ltac:(floatspec MF.atan).
-Definition atanf_spec := DECLARE _atanf ltac:(floatspec MF.atanf).
-Definition atan2_spec := DECLARE _atan2 ltac:(floatspec MF.atan2).
-Definition atan2f_spec := DECLARE _atan2f ltac:(floatspec MF.atan2f).
-Definition atanh_spec := DECLARE _atanh ltac:(floatspec MF.atanh).
-Definition atanhf_spec := DECLARE _atanhf ltac:(floatspec MF.atanhf).
-Definition cbrt_spec := DECLARE _cbrt ltac:(floatspec MF.cbrt).
-Definition cbrtf_spec := DECLARE _cbrtf ltac:(floatspec MF.cbrtf).
-Definition copysign_spec := DECLARE _copysign ltac:(reduce1 (copysign_spec' Tdouble)).
-Definition copysignf_spec := DECLARE _copysignf ltac:(reduce1 (copysign_spec' Tsingle)).
-Definition cos_spec := DECLARE _cos ltac:(floatspec MF.cos).
-Definition cosf_spec := DECLARE _cosf ltac:(floatspec MF.cosf).
-Definition cosh_spec := DECLARE _cosh ltac:(floatspec MF.cosh).
-Definition coshf_spec := DECLARE _coshf ltac:(floatspec MF.coshf).
-Definition exp_spec := DECLARE _exp ltac:(floatspec MF.exp).
-Definition expf_spec := DECLARE _expf ltac:(floatspec MF.expf).
-Definition exp2_spec := DECLARE _exp2 ltac:(floatspec MF.exp2).
-Definition exp2f_spec := DECLARE _exp2f ltac:(floatspec MF.exp2f).
-Definition expm1_spec := DECLARE _expm1 ltac:(floatspec MF.expm1).
-Definition expm1f_spec := DECLARE _expm1f ltac:(floatspec MF.expm1f).
-Definition fabs_spec := DECLARE _fabs ltac:(floatspec (abs_ff Tdouble)).
-Definition fabsf_spec := DECLARE _fabsf ltac:(floatspec (abs_ff Tsingle)).
-Definition pow_spec := DECLARE _pow ltac:(floatspec MF.pow).
-Definition powf_spec := DECLARE _powf ltac:(floatspec MF.powf).
-Definition sqrt_spec := DECLARE _sqrt ltac:(floatspec (sqrt_ff Tdouble)).
-Definition sqrtf_spec := DECLARE _sqrtf ltac:(floatspec (sqrt_ff Tsingle)).
-Definition sin_spec := DECLARE _sin ltac:(floatspec MF.sin).
-Definition sinf_spec := DECLARE _sinf ltac:(floatspec MF.sinf).
-Definition sinh_spec := DECLARE _sinh ltac:(floatspec MF.sinh).
-Definition sinhf_spec := DECLARE _sinhf ltac:(floatspec MF.sinhf).
-Definition tan_spec := DECLARE _tan ltac:(floatspec MF.tan).
-Definition tanf_spec := DECLARE _tanf ltac:(floatspec MF.tanf).
-Definition tanh_spec := DECLARE _tanh ltac:(floatspec MF.tanh).
-Definition tanhf_spec := DECLARE _tanhf ltac:(floatspec MF.tanhf).
-
-Definition fma_spec := DECLARE _fma ltac:(floatspec (fma_ff Tdouble)).
-Definition fmaf_spec := DECLARE _fmaf ltac:(floatspec (fma_ff Tsingle)).
+Section GFUNCTORS.
+Context `{VSTGS_OK: !VSTGS OK_ty Σ}.
+
+Definition acos_spec := DECLARE _acos ltac:(floatspec Σ MF.acos). 
+Definition acosf_spec := DECLARE _acosf ltac:(floatspec Σ MF.acosf).
+Definition acosh_spec := DECLARE _acosh ltac:(floatspec Σ MF.acosh).
+Definition acoshf_spec := DECLARE _acoshf ltac:(floatspec Σ MF.acoshf).
+Definition asin_spec := DECLARE _asin ltac:(floatspec Σ MF.asin).
+Definition asinf_spec := DECLARE _asinf ltac:(floatspec Σ MF.asinf).
+Definition asinh_spec := DECLARE _asinh ltac:(floatspec Σ MF.asinh).
+Definition asinhf_spec := DECLARE _asinhf ltac:(floatspec Σ MF.asinhf).
+Definition atan_spec := DECLARE _atan ltac:(floatspec Σ MF.atan).
+Definition atanf_spec := DECLARE _atanf ltac:(floatspec Σ MF.atanf).
+Definition atan2_spec := DECLARE _atan2 ltac:(floatspec Σ MF.atan2).
+Definition atan2f_spec := DECLARE _atan2f ltac:(floatspec Σ MF.atan2f).
+Definition atanh_spec := DECLARE _atanh ltac:(floatspec Σ MF.atanh).
+Definition atanhf_spec := DECLARE _atanhf ltac:(floatspec Σ MF.atanhf).
+Definition cbrt_spec := DECLARE _cbrt ltac:(floatspec Σ MF.cbrt).
+Definition cbrtf_spec := DECLARE _cbrtf ltac:(floatspec Σ MF.cbrtf).
+Definition copysign_spec := DECLARE _copysign ltac:(reduce1 (copysign_spec' (Σ:=Σ) Tdouble)).
+Definition copysignf_spec := DECLARE _copysignf ltac:(reduce1 (copysign_spec' (Σ:=Σ)  Tsingle)).
+Definition cos_spec := DECLARE _cos ltac:(floatspec Σ MF.cos).
+Definition cosf_spec := DECLARE _cosf ltac:(floatspec Σ MF.cosf).
+Definition cosh_spec := DECLARE _cosh ltac:(floatspec Σ MF.cosh).
+Definition coshf_spec := DECLARE _coshf ltac:(floatspec Σ MF.coshf).
+Definition exp_spec := DECLARE _exp ltac:(floatspec Σ MF.exp).
+Definition expf_spec := DECLARE _expf ltac:(floatspec Σ MF.expf).
+Definition exp2_spec := DECLARE _exp2 ltac:(floatspec Σ MF.exp2).
+Definition exp2f_spec := DECLARE _exp2f ltac:(floatspec Σ MF.exp2f).
+Definition expm1_spec := DECLARE _expm1 ltac:(floatspec Σ MF.expm1).
+Definition expm1f_spec := DECLARE _expm1f ltac:(floatspec Σ MF.expm1f).
+Definition fabs_spec := DECLARE _fabs ltac:(floatspec Σ (abs_ff Tdouble)).
+Definition fabsf_spec := DECLARE _fabsf ltac:(floatspec Σ (abs_ff Tsingle)).
+Definition pow_spec := DECLARE _pow ltac:(floatspec Σ MF.pow).
+Definition powf_spec := DECLARE _powf ltac:(floatspec Σ MF.powf).
+Definition sqrt_spec := DECLARE _sqrt ltac:(floatspec Σ (sqrt_ff Tdouble)).
+Definition sqrtf_spec := DECLARE _sqrtf ltac:(floatspec Σ (sqrt_ff Tsingle)).
+Definition sin_spec := DECLARE _sin ltac:(floatspec Σ MF.sin).
+Definition sinf_spec := DECLARE _sinf ltac:(floatspec Σ MF.sinf).
+Definition sinh_spec := DECLARE _sinh ltac:(floatspec Σ MF.sinh).
+Definition sinhf_spec := DECLARE _sinhf ltac:(floatspec Σ MF.sinhf).
+Definition tan_spec := DECLARE _tan ltac:(floatspec Σ MF.tan).
+Definition tanf_spec := DECLARE _tanf ltac:(floatspec Σ MF.tanf).
+Definition tanh_spec := DECLARE _tanh ltac:(floatspec Σ MF.tanh).
+Definition tanhf_spec := DECLARE _tanhf ltac:(floatspec Σ MF.tanhf).
+
+Definition fma_spec := DECLARE _fma ltac:(floatspec Σ (fma_ff Tdouble)).
+Definition fmaf_spec := DECLARE _fmaf ltac:(floatspec Σ (fma_ff Tsingle)).
 Definition frexp_spec := DECLARE _frexp ltac:(reduce1 (frexp_spec' Tdouble)).
 Definition frexpf_spec := DECLARE _frexpf ltac:(reduce1 (frexp_spec' Tsingle)).
-Definition ldexp_spec := DECLARE _ldexp ltac:(reduce1 (ldexp_spec' Tdouble)).
-Definition ldexpf_spec := DECLARE _ldexpf ltac:(reduce1 (ldexp_spec' Tsingle)).
-Definition nan_spec := DECLARE _nan ltac:(reduce1 (nan_spec' Tdouble)).
-Definition nanf_spec := DECLARE _nanf ltac:(reduce1 (nan_spec' Tsingle)).
-Definition nextafter_spec := DECLARE _nextafter ltac:(reduce1 (nextafter_spec' Tdouble)).
-Definition nextafterf_spec := DECLARE _nextafterf ltac:(reduce1 (nextafter_spec' Tsingle)).
-Definition trunc_spec := DECLARE _trunc ltac:(floatspec (trunc_ff Tdouble)).
-Definition truncf_spec := DECLARE _truncf ltac:(floatspec (trunc_ff Tsingle)).
+Definition ldexp_spec := DECLARE _ldexp ltac:(reduce1 (ldexp_spec' (Σ:=Σ) Tdouble)).
+Definition ldexpf_spec := DECLARE _ldexpf ltac:(reduce1 (ldexp_spec' (Σ:=Σ) Tsingle)).
+Definition nan_spec := DECLARE _nan ltac:(reduce1 (nan_spec' (Σ:=Σ) Tdouble)).
+Definition nanf_spec := DECLARE _nanf ltac:(reduce1 (nan_spec' (Σ:=Σ) Tsingle)).
+Definition nextafter_spec := DECLARE _nextafter ltac:(reduce1 (nextafter_spec' (Σ:=Σ) Tdouble)).
+Definition nextafterf_spec := DECLARE _nextafterf ltac:(reduce1 (nextafter_spec' (Σ:=Σ) Tsingle)).
+Definition trunc_spec := DECLARE _trunc ltac:(floatspec Σ (trunc_ff Tdouble)).
+Definition truncf_spec := DECLARE _truncf ltac:(floatspec Σ (trunc_ff Tsingle)).
 
 Definition MathASI:funspecs := [ 
   acos_spec; acosf_spec; acosh_spec; acoshf_spec; asin_spec; asinf_spec; asinh_spec; asinhf_spec;
@@ -862,4 +874,5 @@ exists {| nonneg:= FT2R x; cond_nonneg := H |}.
 split; auto.
 Admitted.
 
+End GFUNCTORS.
 
diff --git a/lib/proof/spec_threads.v b/lib/proof/spec_threads.v
index 44676ba1ce..cba31de213 100644
--- a/lib/proof/spec_threads.v
+++ b/lib/proof/spec_threads.v
@@ -4,116 +4,59 @@ Require Import VSTlib.threads.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
-Import VST.veric.rmaps.
-Require Import Ensembles.
 Notation vint z := (Vint (Int.repr z)).
 
-Local Open Scope logic.
-
-Definition spawn_arg_type := rmaps.ProdType (rmaps.ProdType (rmaps.ProdType (rmaps.ConstType (val * val))
-  (rmaps.ArrowType (rmaps.DependentType 0) (rmaps.ConstType globals))) (rmaps.DependentType 0))
-  (rmaps.ArrowType (rmaps.DependentType 0) (rmaps.ArrowType (rmaps.ConstType val) rmaps.Mpred)).
-
-Definition spawn_pre :=
-  (fun (ts: list Type) (x: val * val * (nth 0 ts unit -> globals) * nth 0 ts unit *
-                           (nth 0 ts unit -> val -> mpred)) =>
-   match x with
-   | (f, b, gv, w, pre) =>
-     PROP (tc_val (tptr Ctypes.Tvoid) b)
-     PARAMS (f;b) GLOBALS (gv w)
-     (SEP (
-         (func_ptr'
-           (WITH y : val, x : nth 0 ts unit
+Definition spawn_arg_type := ProdType (ConstType (val * val)) (SigType Type (fun A => ProdType (ProdType
+  (DiscreteFunType A (ConstType globals)) (ConstType A))
+  (DiscreteFunType A (DiscreteFunType val Mpred)))).
+
+Local Unset Program Cases.
+
+
+Section mpred.
+Context `{!VSTGS OK_ty Σ}.
+
+Program Definition spawn_pre : dtfr (ArgsTT spawn_arg_type) := λne x,
+  let '(f, b, fs) := x in
+  PROP (tc_val (tptr Tvoid) b)
+    PARAMS (f; b)
+    GLOBALS (let 'existT A ((gv, w), _) := fs in gv w)
+    SEP (let 'existT A ((gv, w), pre) := fs in
+         (func_ptr
+           (WITH y : val, x : A
              PRE [ tptr tvoid ]
                PROP ()
-               PARAMS (y) GLOBALS (gv x)
-               (SEP   (pre x y))
+               PARAMS (y)
+               GLOBALS (gv x)
+               SEP (pre x y)
              POST [ tint ]
                PROP  ()
                RETURN (Vint Int.zero) (* spawned functions must return 0 for now *)
                SEP   ())
            f);
-         pre w b))
-   end)%argsassert.
-
-Definition spawn_post :=
-  (fun (ts: list Type) (x: val * val * (nth 0 ts unit -> globals) * nth 0 ts unit *
-                           (nth 0 ts unit -> val -> mpred)) =>
-   match x with
-   | (f, b, w, pre) =>
-     PROP ()
-     LOCAL ()
-     SEP () (* here's where we'd put a join condition *)
-   end).
-
-Lemma approx_idem : forall n P, compcert_rmaps.R.approx n (compcert_rmaps.R.approx n P) =
-  compcert_rmaps.R.approx n P.
+         let 'existT A ((gv, w), pre) := fs in (*valid_pointer b ∧*) pre w b) (* Do we need the valid_pointer here? *).
+Next Obligation.
 Proof.
-  intros.
-  transitivity (base.compose (compcert_rmaps.R.approx n) (compcert_rmaps.R.approx n) P); auto.
-  rewrite compcert_rmaps.RML.approx_oo_approx; auto.
-Qed.
-
-Lemma funcptr_f_equal' fs fs' v v': fs=fs' -> v=v' -> func_ptr' fs v = func_ptr' fs' v'.
-Proof. intros; subst; trivial. Qed.
-
-Import compcert_rmaps.R.
-
-Lemma approx_Sn_eq_weaken:
-  forall n a b, approx (S n) a = approx (S n) b -> approx n a = approx n b.
+  intros ? ((f, b), (?, ((gv, ?), pre))) ((?, ?), (?, ((?, w), ?))) ([=] & ? & Hfs) rho; simpl in *; subst; simpl in *.
+  destruct Hfs as ((Hgv & [=]) & Hpre); simpl in *; subst.
+  rewrite (Hgv _).
+  do 6 f_equiv.
+  - apply func_ptr_si_nonexpansive; last done.
+    split; last split; [done..|].
+    exists eq_refl; simpl.
+    split3; intros (?, ?); simpl; try done.
+    intros ?; rewrite Hgv (Hpre _ _) //.
+  - rewrite (Hpre _ _) //.
+Defined.
+
+Program Definition spawn_post : @dtfr Σ (AssertTT spawn_arg_type) := λne x,
+  let '(f, b, fs) := x in PROP () LOCAL () SEP ().
+Next Obligation.
 Proof.
-intros.
-apply predicates_hered.pred_ext.
--
-intros ? ?.
-destruct H0.
-split; auto.
-assert (predicates_hered.app_pred (approx (S n) b) a0).
-rewrite <- H.
-split; auto.
-apply H2.
--
-intros ? ?.
-destruct H0.
-split; auto.
-assert (predicates_hered.app_pred (approx (S n) a) a0).
-rewrite H.
-split; auto.
-apply H2.
-Qed.
-
-Lemma spawn_pre_nonexpansive: @args_super_non_expansive spawn_arg_type spawn_pre.
-Proof. repeat intro.
-  destruct x as ((((?, ?), ?), ?), ?); simpl.
-  unfold PROPx; simpl; rewrite !approx_andp; f_equal.
-  unfold LAMBDAx. rewrite !approx_andp; f_equal.
-  unfold GLOBALSx, LOCALx; simpl. rewrite !approx_andp. f_equal.
-  unfold argsassert2assert. simpl.
-  unfold SEPx; simpl. rewrite !sepcon_emp.
-  rewrite !approx_sepcon. rewrite approx_idem.
-  apply pred_ext; apply sepcon_derives; trivial; apply derives_refl'.
-  (* f_equal.*)
-  + apply approx_Sn_eq_weaken.
-    rewrite approx_func_ptr'.
-    setoid_rewrite approx_func_ptr' at 2. apply f_equal.
-    apply funcptr_f_equal'; trivial. simpl.
-    apply semax_prog.funspec_eq; trivial.
-    extensionality tss a rho'; destruct a.
-    rewrite !approx_andp, !approx_sepcon, approx_idem; auto.
-  + apply approx_Sn_eq_weaken.
-    rewrite approx_func_ptr'.
-    setoid_rewrite approx_func_ptr' at 2. apply f_equal.
-    apply funcptr_f_equal'; trivial. simpl.
-    apply semax_prog.funspec_eq; trivial.
-    extensionality tss a rho'; destruct a.
-    rewrite !approx_andp, !approx_sepcon, approx_idem; auto.
+  intros ? ((f, b), ?) ((?, ?), ?) ?.
+  reflexivity.
 Qed.
 
-Lemma spawn_post_nonexpansive: @super_non_expansive spawn_arg_type spawn_post.
-Proof.
-  hnf; intros.
-  destruct x as [[[]] pre]; auto.
-Qed.
 
 (* The following hack is to achieve compatibility between CompCert <= 3.14 and CompCert >= 3.15 *)
 
@@ -143,16 +86,10 @@ Local Definition Tnil :=
 
 Definition spawned_funtype := Tfunction (Tcons (tptr tvoid) Tnil) tint cc_default.
 
-Definition spawn_spec := mk_funspec
-  ((tptr spawned_funtype) :: (tptr tvoid) :: nil, tvoid)
-  cc_default
-  spawn_arg_type
-  spawn_pre
-  spawn_post
-  spawn_pre_nonexpansive
-  spawn_post_nonexpansive.
+Definition spawn_spec := mk_funspec ([tptr spawned_funtype; tptr tvoid], tvoid) cc_default
+  spawn_arg_type (λne _, ⊤) spawn_pre spawn_post.
 
-Definition exit_thread_spec :=
+Definition exit_thread_spec : ident * @funspec Σ :=
   DECLARE _exit_thread
   WITH v : val
   PRE [ tint ]
@@ -168,4 +105,6 @@ Definition ThreadsASI:funspecs := [
     (_spawn, spawn_spec); exit_thread_spec
  ].
 
+End mpred.
+
 
diff --git a/lib/proof/verif_SC_atomics.v b/lib/proof/verif_SC_atomics.v
index 4f5d544553..f0e4082acd 100644
--- a/lib/proof/verif_SC_atomics.v
+++ b/lib/proof/verif_SC_atomics.v
@@ -3,9 +3,13 @@ Require Import VST.floyd.VSU.
 Require VST.floyd.library. (*for body_lemma_of_funspec *)
 Require Import VSTlib.SC_atomics_extern.
 Require Import VSTlib.spec_SC_atomics.
-
+(*
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
+*)
+
+Section AtomicsASI.
+Context `{VOK: !VSTGS OK_ty Σ}.
 
 #[export] Declare Instance M: AtomicsAPD.
 
@@ -23,41 +27,41 @@ Local Definition get_extfun (i: ident) : external_function :=
 
 
 Parameter body_make_atomic: 
- forall {Espec: OracleKind} ,
+ forall {Espec: ext_spec OK_ty} ,
    VST.floyd.library.body_lemma_of_funspec (get_extfun _make_atomic)
 (*        (EF_external "make_atomic" (mksignature (Xint :: nil) Xptr cc_default))*)
        make_atomic_spec. 
 
 Parameter body_make_atomic_ptr:
- forall {Espec: OracleKind}  ,
+ forall {Espec: ext_spec OK_ty}  ,
    VST.floyd.library.body_lemma_of_funspec (get_extfun _make_atomic_ptr)
 (*       (EF_external "make_atomic_ptr"
                    (mksignature (Xptr :: nil) Xptr cc_default))*)
        make_atomic_ptr_spec.
 
 Parameter body_free_atomic: 
- forall {Espec: OracleKind}  ,
+ forall {Espec: ext_spec OK_ty}  ,
    VST.floyd.library.body_lemma_of_funspec (get_extfun _free_atomic)
 (*        (EF_external "free_atomic"
                    (mksignature (Xptr :: nil) Xvoid cc_default))*)
        free_atomic_int_spec.
 
 Parameter body_free_atomic_ptr: 
- forall {Espec: OracleKind}  ,
+ forall {Espec: ext_spec OK_ty}  ,
    VST.floyd.library.body_lemma_of_funspec (get_extfun _free_atomic_ptr)
 (*        (EF_external "free_atomic_ptr"
                    (mksignature (Xptr :: nil) Xvoid cc_default))*)
        free_atomic_ptr_spec.
 
 Parameter body_atom_load: 
- forall {Espec: OracleKind}  ,
+ forall {Espec: ext_spec OK_ty}  ,
    VST.floyd.library.body_lemma_of_funspec (get_extfun _atom_load)
 (*        (EF_external "atom_load"
                    (mksignature (Xptr :: nil) Xint cc_default))*)
        atomic_load_spec.
 
 Parameter body_atom_store: 
- forall {Espec: OracleKind}  ,
+ forall {Espec: ext_spec OK_ty}  ,
    VST.floyd.library.body_lemma_of_funspec (get_extfun _atom_store)
 (*        (EF_external "atom_store"
                    (mksignature (Xptr :: Xint :: nil) Xvoid cc_default))
@@ -65,7 +69,7 @@ Parameter body_atom_store:
        atomic_store_spec.
 
 Parameter body_atom_CAS: 
- forall {Espec: OracleKind}  ,
+ forall {Espec: ext_spec OK_ty}  ,
    VST.floyd.library.body_lemma_of_funspec (get_extfun _atom_CAS)
 (*        (EF_external "atom_CAS"
                    (mksignature (Xptr :: Xptr :: Xint :: nil)
@@ -75,7 +79,7 @@ Parameter body_atom_CAS:
 
 
 Parameter body_atom_exchange: 
- forall {Espec: OracleKind}  ,
+ forall {Espec: ext_spec OK_ty}  ,
    VST.floyd.library.body_lemma_of_funspec (get_extfun _atom_exchange)
 (*        (EF_external "atom_exchange"
                    (mksignature (Xptr :: Xint :: nil) Xint
@@ -83,7 +87,7 @@ Parameter body_atom_exchange:
 *)
        atomic_exchange_spec.
 
-Definition SC_atomics_placeholder_spec :=
+Definition SC_atomics_placeholder_spec : ident * @funspec Σ :=
  DECLARE _SC_atomics_placeholder
  WITH u: unit
  PRE [ ]
@@ -93,7 +97,7 @@ Definition SC_atomics_placeholder_spec :=
 
   Definition SCA_ASI: funspecs := AtomicsASI.
 
-  Definition SCA_imported_specs:funspecs :=  nil.
+  Definition SCA_imported_specs: @funspecs Σ :=  nil.
 
   Definition SCA_internal_specs: funspecs := SC_atomics_placeholder_spec::SCA_ASI.
 
@@ -111,7 +115,7 @@ contradiction.
 Qed.
 
 Definition SCA_E : funspecs := SCA_ASI.
-
+(*
 Ltac check_mpreds2 R ::= (* Patch for https://github.com/PrincetonUniversity/VST/issues/638 *)
  lazymatch R with
  | @sepcon mpred _ _ ?a ?b => check_mpreds2 a; check_mpreds2 b
@@ -121,10 +125,29 @@ Ltac check_mpreds2 R ::= (* Patch for https://github.com/PrincetonUniversity/VST
                      end
  | nil => idtac
  end.
+*)
+(*#[local] Existing Instance NullExtension.Espec.  (* FIXME *)
+*)
 
-#[local] Existing Instance NullExtension.Espec.  (* FIXME *)
+Ltac solve_SF_external B ::=
+  first [ split3;
+            [ reflexivity 
+            | reflexivity 
+            | split3;
+                [ reflexivity
+                | reflexivity
+                | split3;
+                   [ left; trivial
+                   | clear; intros ? ? ?; cbv [ofe_mor_car]; 
+                     try solve [entailer!]; try apply TT_right;
+                     repeat match goal with |- (let (y, z) := ?x in _) _ ∧ _ ⊢ _ =>
+                                     destruct x as [y z]
+                     end
+                    | split; [ try apply B | eexists; split; cbv; reflexivity ]
+            ] ] ]
+        | idtac ].
 
-Definition SCAVSU: VSU SCA_E SCA_imported_specs ltac:(QPprog prog) SCA_ASI emp.
+Definition SCAVSU `{Espec: ext_spec OK_ty}: VSU SCA_E SCA_imported_specs ltac:(QPprog prog) SCA_ASI (fun _ => emp).
   Proof. 
     mkVSU prog SCA_internal_specs.
     - solve_SF_internal body_SC_atomics_placeholder.
@@ -137,7 +160,6 @@ Definition SCAVSU: VSU SCA_E SCA_imported_specs ltac:(QPprog prog) SCA_ASI emp.
     - solve_SF_external body_atom_load.
         simpl. admit.
     - solve_SF_external body_atom_store.
-        simpl. admit.
     - solve_SF_external body_atom_CAS.
         simpl. admit.
     - solve_SF_external body_atom_exchange.
@@ -145,3 +167,4 @@ Definition SCAVSU: VSU SCA_E SCA_imported_specs ltac:(QPprog prog) SCA_ASI emp.
 Admitted.  (* all these admits are undoubtedly provable; see for example 
                             Lemma RETURN_tc_option_val_float  in verif_math.v *)
 
+End AtomicsASI.
diff --git a/lib/proof/verif_locks.v b/lib/proof/verif_locks.v
index aafdbc876e..1ecc044ee2 100755
--- a/lib/proof/verif_locks.v
+++ b/lib/proof/verif_locks.v
@@ -6,39 +6,27 @@ Require Import VSTlib.spec_locks.
 Require Import VSTlib.spec_malloc.
 Require Import VSTlib.spec_SC_atomics.
 Require Import VSTlib.verif_SC_atomics VSTlib.verif_malloc.
-Require Import VST.veric.rmaps.
 Require Import VST.concurrency.conclib.
-Require Import VST.concurrency.ghosts. (* why does this have locks in it? *)
-Require Import VST.concurrency.cancelable_invariants.
+Require Import iris_ora.logic.cancelable_invariants.
 
 #[global] Opaque VSTlib.verif_SC_atomics.M.
 
 #[local] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
-Definition inv_for_lock' v R := 
-  EX b, atomic_int_at Ews (Val.of_bool b) v * if b then emp else R.
 
-Lemma inv_for_lock_nonexpansive' : forall v, nonexpansive (inv_for_lock' v).
-  Proof.
-    intros.
-    apply @exists_nonexpansive; intros.
-    apply sepcon_nonexpansive; [apply const_nonexpansive|].
-    destruct x; [apply const_nonexpansive | apply identity_nonexpansive].
-  Qed.
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ, !cinvG Σ(*, atom_impl : !atomic_int_impl (Tstruct _atom_int noattr)*)}.
+
 
 #[export] Program Instance M : lockAPD := {
-  inv_for_lock := fun v R => EX b, atomic_int_at Ews (Val.of_bool b) v * if b then emp else R
+  inv_for_lock := fun v R => ∃ b, atomic_int_at Ews (Val.of_bool b) v ∗ if b then emp else R
 }.
 Next Obligation. (*inv_for_lock_nonexpansive *)
-  Proof.
-    intros.
-    apply @exists_nonexpansive; intros.
-    apply sepcon_nonexpansive; [apply const_nonexpansive|].
-    destruct x; [apply const_nonexpansive | apply identity_nonexpansive].
-  Qed.
+  Proof. solve_proper. Qed.
 
-  Definition makelock_spec := DECLARE _makelock (@spec_locks.makelock_spec verif_malloc.M M).
+  Definition makelock_spec := DECLARE _makelock spec_locks.makelock_spec.
   Definition freelock_spec := DECLARE _freelock spec_locks.freelock_spec.
   Definition acquire_spec := DECLARE _acquire spec_locks.acquire_spec.
   Definition release_spec := DECLARE _release spec_locks.release_spec.
@@ -55,173 +43,131 @@ Definition Gprog := lockImports ++ LockASI.
 
   Lemma body_makelock: semax_body Vprog Gprog f_makelock makelock_spec.
   Proof.
+  (* the following line should not be necessary;
+    start_function1 should do a better job unfolding,
+    but currently it's blocked on spec-definitions that
+    have implicit arguments. *)
+  unfold makelock_spec, spec_locks.makelock_spec.
     start_function.
     forward_call (vint 1).
     Intros p.
-    viewshift_SEP 0 (EX i g, lock_inv Tsh (p, i, g) (R (p, i, g))).
-    { go_lower; simpl.
-      entailer!.
-      eapply derives_trans, fupd_mono; [|apply exp_derives; intros; apply exp_derives; intros; apply sepcon_derives, derives_refl; apply andp_right, derives_refl; entailer!].
-      eapply derives_trans, cinv_alloc_dep.
-      unfold inv_for_lock.
-      do 2 (apply allp_right; intros).
-      eapply derives_trans, now_later.
-      Exists true; simpl; cancel. apply derives_refl. }
-    simpl.
+    viewshift_SEP 0 (∃ i g, lock_inv 1 (p, i, g) (R (p, i, g))).
+    { go_lowerx.
+      iIntros "(? & _)".
+      iDestruct (atomic_int_isptr with "[$]") as "#$".
+      iMod (cinv_alloc_strong (λ _, True%type) _ (nroot .@ "lock")) as (?) "(_ & ? & inv)".
+      { apply pred_infinite_True. }
+      iExists _, _; iFrame; iApply "inv".
+      rewrite /inv_for_lock.
+      iExists true; auto. }
     forward.
-    simpl; Exists (p, i, g); unfold lock_inv; entailer!. apply derives_refl.
+    unfold lock_inv; simpl.
+    Exists (p, i, g); unfold lock_inv; entailer!!.
   Qed.
 
-  #[local] Hint Resolve Ensembles.Full_intro : core.
-
   Lemma body_freelock: semax_body Vprog Gprog f_freelock freelock_spec.
   Proof.
+  (* the following line should not be necessary;
+    start_function1 should do a better job unfolding,
+    but currently it's blocked on spec-definitions that
+    have implicit arguments. *)
+  unfold freelock_spec, spec_locks.freelock_spec.
     start_function.
     destruct h as ((p, i), g); simpl; Intros.
-    gather_SEP (cinvariant _ _ _) (cinv_own _ _); viewshift_SEP 0 (cinvariant i g (inv_for_lock p R) * |> inv_for_lock p R).
-    { go_lower; simpl; Intros.
-      rewrite cinvariant_dup at 1; unfold cinvariant at 1; sep_apply (inv_open Ensembles.Full_set); auto.
-      eapply derives_trans, fupd_elim; [apply fupd_frame_r|].
-      rewrite later_orp, !distrib_orp_sepcon; apply orp_left.
-      - sep_apply (modus_ponens_wand' (cinv_own g Tsh)).
-        { apply orp_right2, now_later. }
-        sep_apply fupd_frame_r; rewrite emp_sepcon.
-        sep_apply fupd_frame_r; rewrite sepcon_comm; apply derives_refl.
-      - eapply derives_trans, except_0_fupd.
-        apply orp_right1.
-        rewrite sepcon_assoc; eapply derives_trans; [apply sepcon_derives, now_later; apply derives_refl|].
-        rewrite <- later_sepcon; apply later_derives.
-        sep_apply cinv_own_excl.
-        rewrite FF_sepcon; auto. }
-    unfold inv_for_lock at 2. unfold M at 2.
-    rewrite (later_exp' _ true); Intros b.
+    gather_SEP (cinv _ _ _) (cinv_own _ _); viewshift_SEP 0 (cinv i g (inv_for_lock p R) ∗ ▷ inv_for_lock p R).
+    { go_lowerx.
+      iIntros "((#$ & ?) & _)".
+      iMod (cinv_cancel with "[$] [$]") as "$"; done. }
+    unfold inv_for_lock at 2.
+    rewrite bi.later_exist; Intros b.
     destruct b.
-    - assert_PROP (is_pointer_or_null p) by entailer!.
-      forward_call (p).
+    - forward_call (p).
       { Exists (Val.of_bool true); cancel. }
       entailer!.
-      rewrite <- emp_sepcon; apply sepcon_derives, andp_left2, derives_refl.
-      apply inv_dealloc.
-    - gather_SEP 0 1 2 3.
-      viewshift_SEP 0 FF.
-      go_lower.
-      rewrite cinvariant_dup at 1.
-      unfold cinvariant at 1; sep_apply (inv_open Ensembles.Full_set); auto.
-      eapply derives_trans, fupd_elim; [apply fupd_frame_r|].
-      rewrite <- !sepcon_assoc, (sepcon_comm _ (|> _)), <- !sepcon_assoc.
-      rewrite 3sepcon_assoc; eapply derives_trans; [apply sepcon_derives, derives_refl|].
-      { rewrite <- later_sepcon; apply later_derives.
-        rewrite distrib_orp_sepcon2; apply orp_left, derives_refl.
-        unfold inv_for_lock, M; Intros b.
-        sep_apply atomic_int_conflict; auto.
-        rewrite FF_sepcon; apply FF_left. }
-      rewrite <- !sepcon_assoc, (sepcon_comm _ (_ -* _)).
-      rewrite !later_sepcon, <- !sepcon_assoc, 4sepcon_assoc.
-      eapply derives_trans; [apply sepcon_derives; [apply derives_refl|]|].
-      rewrite <- !sepcon_assoc; eapply derives_trans, modus_ponens_wand.
-      eapply sepcon_derives, derives_trans; [|apply now_later | rewrite later_andp, later_wand; apply andp_left1, derives_refl].
-      rewrite !later_sepcon; entailer!.
-      apply now_later.
-      { rewrite sepcon_assoc, <- later_sepcon, sepcon_FF.
-        eapply derives_trans; [apply sepcon_derives, derives_refl; apply now_later|].
-        rewrite <- later_sepcon, sepcon_FF.
-        eapply derives_trans, except_0_fupd; apply orp_right1; auto. }
-      { eapply semax_pre, semax_ff; entailer!. }
+      by iIntros "(_ & _)".
+    - gather_SEP (cinv _ _ _) (▷ _) (P) (<affine> _).
+      viewshift_SEP 0 (False : mpred).
+      go_lowerx.
+      iIntros "((#I & (p & R) & P & HR) & _)".
+      rewrite {1}/cinv.
+      iInv "I" as "[(% & p' & ?) | Hown]".
+      { iAssert (▷False) with "[p p']" as ">[]".
+        iApply atomic_int_conflict; last iFrame; auto. }
+      iAssert (▷ False) with "[-]" as ">[]".
+      iNext; rewrite bi.affinely_elim; iDestruct ("HR" with "[$P $R $Hown]") as "[]"; done.
+      { eapply semax_pre, semax_ff; go_lower; done. }
   Qed.
 
-Opaque inv_for_lock.
-
   Lemma body_release: semax_body Vprog Gprog f_release release_spec.
   Proof.
+  (* the following line should not be necessary;
+    start_function1 should do a better job unfolding,
+    but currently it's blocked on spec-definitions that
+    have implicit arguments. *)
+  unfold release_spec, spec_locks.release_spec.
     start_function.
-    forward_call (ptr_of h, vint 0, @Ensembles.Full_set invariants.iname, @Ensembles.Empty_set invariants.iname, Q).
-    - simpl; unfold lock_inv; destruct h as ((p, i), g); Intros.
+    forward_call (ptr_of h, vint 0, ⊤ : coPset, ∅ : coPset, Q).
+    - destruct h as ((p, i), g); simpl; Intros.
       subst Frame; instantiate (1 := []); simpl; cancel.
-      rewrite cinvariant_dup at 1.
-      sep_apply (cinv_open Ensembles.Full_set); auto.
-      repeat sep_apply fupd_frame_r; apply fupd_elim.
-      rewrite prop_true_andp by auto.
-      sep_apply (modus_ponens_wand (cinvariant i g (inv_for_lock p R) * cinv_own g sh * P)).
-      unfold inv_for_lock at 1. unfold M at 1.
-      rewrite (later_exp' _ true); Intros b; destruct b.
-      + rewrite sepcon_emp, !sepcon_assoc; sep_eapply fupd_timeless; auto; repeat sep_eapply fupd_frame_r; apply fupd_elim.
-        sep_apply atomic_int_at__.
-        eapply derives_trans, fupd_mask_intro_all; rewrite <- wand_sepcon_adjoint.
-        Exists Ews; simpl; entailer!.
-        rewrite <- wand_sepcon_adjoint.
-        sep_apply fupd_frame_l; repeat sep_apply fupd_frame_r; apply fupd_elim.
-        unfold ptr_of; sep_apply (modus_ponens_wand' (R * atomic_int_at Ews (vint 0) p)).
-        { unfold inv_for_lock at 1. unfold M.
-          eapply derives_trans, now_later.
-          Exists false; cancel. }
-        repeat sep_apply fupd_frame_r; apply fupd_mono; cancel.
-        apply andp_left2; auto.
-      + eapply derives_trans, except_0_fupd; apply orp_right1.
-        rewrite sepcon_comm, !sepcon_assoc; eapply derives_trans; [apply sepcon_derives, now_later; apply derives_refl|].
-        rewrite <- later_sepcon; apply later_derives.
-        sep_apply spec_locks.weak_exclusive_conflict.
-        rewrite FF_sepcon; auto.
-    - hnf; inversion 1.
+      iIntros "(HR & #I & ? & P & HQ)".
+      iInv i as "((% & >p & ?) & Hown)" "Hclose".
+      destruct b.
+      + iExists Ews; rewrite (bi.pure_True (writable_share _)) //.
+        rewrite atomic_int_at__; iFrame.
+        iApply fupd_mask_intro; first set_solver.
+        iIntros "Hmask p".
+        iDestruct ("HQ" with "[$Hown $P]") as "($ & ?)"; first auto.
+        iMod "Hmask"; iApply "Hclose".
+        iExists false; iFrame.
+      + iDestruct ("HQ" with "[$Hown $P]") as "(? & ?)"; first auto.
+        iAssert (▷ False) with "[-]" as ">[]".
+        rewrite bi.affinely_elim; iNext; iApply ("HR" with "[$]").
     - entailer!.
   Qed.
 
   Lemma body_acquire: semax_body Vprog Gprog f_acquire acquire_spec.
   Proof.
-    start_function; simpl.
+  (* the following line should not be necessary;
+    start_function1 should do a better job unfolding,
+    but currently it's blocked on spec-definitions that
+    have implicit arguments. *)
+  unfold acquire_spec, spec_locks.acquire_spec.
+    start_function.
     forward.
     forward_loop (PROP ( )
                        LOCAL (temp _b (vint 0); lvar _expected tint v_expected;
                               temp _lock (ptr_of h))
                        SEP (data_at_ Tsh tint v_expected; lock_inv sh h R)).
-    { entailer!. }
+    { unfold lock_inv; simpl; entailer!. }
     forward.
     forward_call
-      (ptr_of h, Tsh, v_expected, (vint 0), (vint 1), @Ensembles.Full_set invariants.iname, @Ensembles.Empty_set invariants.iname,
+      (ptr_of h, Tsh, v_expected, (vint 0), (vint 1), ⊤ : coPset, ∅ : coPset,
             fun v':val =>
-              lock_inv sh h R * if (eq_dec v' (vint 0)) then |> R else emp).
+              lock_inv sh h R ∗ if (eq_dec v' (vint 0)) then ▷ R else emp).
     - unfold lock_inv; destruct h as ((p, i), g); Intros.
       subst Frame; instantiate (1 := []); simpl fold_right_sepcon; cancel.
-      rewrite cinvariant_dup at 1.
-      sep_apply (cinv_open Ensembles.Full_set); auto.
-      repeat sep_apply fupd_frame_r; apply fupd_elim.
-      unfold inv_for_lock at 1. unfold M at 1.
-      rewrite (later_exp' _ true); Intros b.
-      rewrite later_sepcon; sep_eapply fupd_timeless; auto; repeat sep_eapply fupd_frame_r; apply fupd_elim.
-      eapply derives_trans, fupd_mask_intro_all; rewrite <- wand_sepcon_adjoint.
-      Exists Ews (Val.of_bool b); simpl; entailer!.
-      rewrite <- wand_sepcon_adjoint.
-      sep_apply fupd_frame_l; repeat sep_apply fupd_frame_r; apply fupd_elim.
-      destruct b; simpl eq_dec.
-      + rewrite !if_false by discriminate.
-        sep_eapply fupd_timeless; [apply fupd.emp_timeless|]; repeat sep_eapply fupd_frame_r; apply fupd_elim.
-        rewrite emp_sepcon.
-        sep_apply (modus_ponens_wand' (atomic_int_at Ews (Val.of_bool true) p)).
-        { unfold inv_for_lock at 1. unfold M at 1.
-          eapply derives_trans, now_later.
-          Exists true; cancel. }
-        repeat sep_apply fupd_frame_r; apply fupd_mono; cancel.
-      + rewrite !if_true by auto.
-        sep_apply (modus_ponens_wand' (atomic_int_at Ews (vint 1) p)).
-        { unfold inv_for_lock at 1. unfold M at 1.
-          eapply derives_trans, now_later.
-          Exists true; cancel. }
-        repeat sep_apply fupd_frame_r; apply fupd_mono; cancel.
-    - hnf; inversion 1.
+      iIntros "(#I & ?)".
+      rewrite {1}/inv_for_lock /=.
+      iInv "I" as "((% & >? & ?) & ?)" "Hclose".
+      iExists Ews, (Val.of_bool b); rewrite (bi.pure_True (writable_share _)) //.
+      iFrame.
+      iApply fupd_mask_intro; first set_solver.
+      iIntros "Hmask p"; iMod "Hmask" as "_".
+      destruct b; simpl.
+      + iMod ("Hclose" with "[-]"); last auto.
+        iExists true; iFrame.
+      + iMod ("Hclose" with "[p]"); last by iFrame; auto.
+        iExists true; iFrame; auto.
     - Intros r. if_tac; forward_if; try discriminate; try contradiction.
       + forward. simpl spec_locks.lock_inv; entailer!.
       + forward. simpl spec_locks.lock_inv; entailer!.
-Unshelve. (* This part is for compatibility with VST < 2.15 *)
-all: apply Build_change_composite_env with (coeq := Maps.PTree.empty bool);
- [intros; inv H1 |
-  intros; unfold cenv_cs; simpl; rewrite !Maps.PTree.gempty;
-   split; intros [? ?]; discriminate].
-Qed.
+  Qed.
 
-#[global] Opaque M.
+Opaque inv_for_lock.
 
-#[local] Existing Instance NullExtension.Espec.  (* FIXME *)
+#[global] Opaque M.
 
-Definition LockVSU: VSU nil lockImports ltac:(QPprog prog) LockASI emp.
+Definition LockVSU `{Espec: ext_spec OK_ty}: VSU nil lockImports ltac:(QPprog prog) LockASI (fun _ => emp).
   Proof. 
     mkVSU prog LockASI.
     - solve_SF_internal body_makelock.
@@ -229,3 +175,6 @@ Definition LockVSU: VSU nil lockImports ltac:(QPprog prog) LockASI emp.
     - solve_SF_internal body_acquire.
     - solve_SF_internal body_release.
   Qed.
+
+End mpred.
+
diff --git a/lib/proof/verif_malloc.v b/lib/proof/verif_malloc.v
index 4f4361d136..1782280182 100644
--- a/lib/proof/verif_malloc.v
+++ b/lib/proof/verif_malloc.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat.
 Require Import VST.floyd.VSU.
 Require Import VST.floyd.library. (*for body_lemma_of_funspec *)
 Require Import VSTlib.malloc_extern.
@@ -6,27 +7,30 @@ Require Import VSTlib.spec_malloc.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 
-#[export] Declare Instance M: MallocAPD.
+#[export] Declare Instance M `{VSTGS_OK: !VSTGS OK_ty Σ} : MallocAPD.
 
+
+Section GFUNCTORS.
+Context `{VSTGS_OK: !VSTGS OK_ty Σ}.
 Axiom mem_mgr_rep: forall gv, emp |-- mem_mgr gv.
 
 Parameter body_malloc:
- forall {Espec: OracleKind} {cs: compspecs} ,
+ forall {Espec: ext_spec OK_ty} {cs: compspecs} ,
    VST.floyd.library.body_lemma_of_funspec EF_malloc (snd malloc_spec').
 
 Parameter body_free:
- forall {Espec: OracleKind} {cs: compspecs} ,
+ forall {Espec: ext_spec OK_ty} {cs: compspecs} ,
    VST.floyd.library.body_lemma_of_funspec EF_free (snd free_spec').
 
 (*
 Parameter body_exit:
- forall {Espec: OracleKind},
+ forall {Espec: ext_spec OK_ty},
   VST.floyd.library.body_lemma_of_funspec
     (EF_external "exit" (mksignature (AST.Tint :: nil) AST.Tvoid cc_default))
     (snd (exit_spec)).
 *)
 
-Definition malloc_placeholder_spec :=
+Definition malloc_placeholder_spec : ident * @funspec Σ :=
  DECLARE _malloc_placeholder
  WITH u: unit
  PRE [ ]
@@ -36,7 +40,7 @@ Definition malloc_placeholder_spec :=
 
   Definition MF_ASI: funspecs := MallocASI.
 
-  Definition MF_imported_specs:funspecs :=  nil.
+  Definition MF_imported_specs: @funspecs Σ :=  nil.
 
   Definition MF_internal_specs: funspecs := malloc_placeholder_spec::MF_ASI.
 
@@ -61,29 +65,32 @@ Lemma semax_func_cons_malloc_aux {cs: compspecs} (gv: globals) (gx : genviron) (
     (make_ext_rval gx (rettype_of_type (tptr tvoid)) ret) |-- !! is_pointer_or_null (force_val ret).
 Proof.
  intros.
- rewrite exp_unfold. Intros p.
+ monPred.unseal. Intros p.
  rewrite <- insert_local.
- rewrite lower_andp.
- apply derives_extract_prop; intro.
- destruct H; unfold_lift in H.
- unfold_lift in H0. destruct ret; try contradiction.
- unfold eval_id in H. simpl in H. subst p.
+ monPred.unseal.
+ apply bi.pure_elim_l; intros (? & ?).
+ super_unfold_lift.
+ destruct ret; try contradiction.
+ unfold eval_id in H. Transparent peq. simpl in H. Opaque peq. subst p.
  if_tac. rewrite H; entailer!.
- renormalize. entailer!.
+ renormalize. monPred.unseal. entailer!.
 Qed.
 
-
 Definition MF_E : funspecs := MF_ASI.
 
-Definition MallocVSU: @VSU NullExtension.Espec
-         MF_E MF_imported_specs ltac:(QPprog prog) MF_ASI mem_mgr.
+Definition MallocVSU `{Espec: ext_spec OK_ty} : 
+      VSU MF_E MF_imported_specs ltac:(QPprog prog) MF_ASI mem_mgr.
   Proof. 
     mkVSU prog MF_internal_specs.
     - solve_SF_internal body_malloc_placeholder.
-    - solve_SF_external (@body_malloc NullExtension.Espec CompSpecs). 
+    - solve_SF_external body_malloc.
+      destruct x as [n gv].
       Intros. eapply derives_trans.
       apply (semax_func_cons_malloc_aux gv gx ret n).
       destruct ret; simpl; trivial.
-    - solve_SF_external (@body_free NullExtension.Espec CompSpecs).
+    - solve_SF_external body_free.
     - apply MF_Init.
 Qed.
+
+End GFUNCTORS.
+
diff --git a/lib/proof/verif_math.v b/lib/proof/verif_math.v
index 19825b6bed..c1a281fac1 100644
--- a/lib/proof/verif_math.v
+++ b/lib/proof/verif_math.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat.
 Require Import VST.floyd.VSU.
 Require Import VST.floyd.library. (*for body_lemma_of_funspec *)
 Require Import VSTlib.math_extern.
@@ -6,7 +7,10 @@ Require Import VSTlib.spec_math.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 
-Definition math_placeholder_spec :=
+Section GFUNCTORS.
+Context `{VSTGS_OK: !VSTGS OK_ty Σ}.
+
+Definition math_placeholder_spec : ident * @funspec Σ :=
  DECLARE _math_placeholder
  WITH u: unit
  PRE [ ]
@@ -14,15 +18,19 @@ Definition math_placeholder_spec :=
  POST [ tint ]
    PROP() LOCAL() SEP().
 
-Definition Math_imported_specs:funspecs :=  nil.
+Definition Math_imported_specs: @funspecs Σ :=  nil.
 
 Definition Math_internal_specs: funspecs := math_placeholder_spec::MathASI.
 
 Definition MathVprog : varspecs. mk_varspecs prog. Defined.
 Definition MathGprog: funspecs := Math_imported_specs ++ Math_internal_specs.
 
-Lemma Math_Init: VSU_initializer prog emp.
-Proof. InitGPred_tac. apply derives_refl. Qed.
+
+Lemma Math_Init: VSU_initializer prog (id (fun gv => emp)).
+Proof.
+intros ? ?.
+eapply InitGPred_process_globvars; auto.
+Qed.
 
 Lemma body_placeholder: semax_body MathVprog MathGprog f_math_placeholder math_placeholder_spec.
 Proof.
@@ -38,17 +46,18 @@ Definition is_float_val v :=
 Lemma RETURN_tc_option_val_float:
  forall P v R t ret gx,
   is_float_val v = true ->
-  (PROPx P (LOCALx (temp ret_temp v :: nil) (SEPx R)))
+  (PROPx (Σ:=Σ) P (LOCALx (temp ret_temp v :: nil) (SEPx R)))
          (make_ext_rval gx (rettype_of_type t) ret)
   && !! Builtins0.val_opt_has_rettype ret (rettype_of_type t)
-  |-- prop (tc_option_val t ret).
+  |-- !! (tc_option_val t ret).
 Proof.
 intros.
 Intros.
 cbv [PROPx LOCALx SEPx local liftx lift lift1 lift_curry lift_uncurry_open fold_right].
-simpl. 
+rewrite !monPred_at_and.
 apply andp_left2.
 apply andp_left1.
+simpl.
 apply prop_derives.
 intros [[? _] _].
 hnf in H0,H1.
@@ -81,68 +90,6 @@ destruct t; try destruct i; try destruct s; try destruct f; simpl in H0; try con
 destruct v; try contradiction; try discriminate H; hnf in H; auto.
 Qed.
 
-Ltac carefully_unroll_Forall := 
-match goal with |- Forall _ (_ _ ?L) => 
-     let z := constr:(L) in let z := eval hnf in z 
-     in lazymatch z with 
-         | (_ , _)::_ => change L with z
-         | ?u :: ?r => let u' := eval hnf in u in change L with (u'::r)
-         | _ => apply Forall_nil
-          end
-end;
-(cbv beta delta [filter_options] fix;
- cbv match;
- match goal with |- context [Maps.PTree.get ?i ?m] =>
-    let u := fresh "u" in set (u := Maps.PTree.get i m); hnf in u; subst u; 
-    cbv beta zeta match  delta [snd]
- end;
- match goal with |- Forall _ (?hx :: ?tx) => 
-    let h := fresh "h" in let t := fresh "t" in 
-     set (h := hx); set (t := tx); simple apply Forall_cons; subst h t
- end; 
-  [ |  carefully_unroll_Forall]).
-
-Ltac VSU.mkComponent prog ::=
- hnf;
- match goal with |- Component _ _ ?IMPORTS _ _ _ _ =>
-     let i := compute_list' IMPORTS in change_no_check IMPORTS with i 
- end;
- test_Component_prog_computed;
- let p := fresh "p" in
- match goal with |- @Component _ _ _ _ ?pp _ _ _ => set (p:=pp) end;
- let HA := fresh "HA" in 
-   assert (HA: PTree_samedom cenv_cs ha_env_cs) by repeat constructor;
- let LA := fresh "LA" in 
-   assert (LA: PTree_samedom cenv_cs la_env_cs) by repeat constructor;
- let OK := fresh "OK" in
-  assert (OK: QPprogram_OK p)
-   by (split; [apply compute_list_norepet_e; reflexivity 
-           |  apply (QPcompspecs_OK_i HA LA) ]);
- (* Doing the  set(myenv...), instead of before proving the CSeq assertion,
-     prevents nontermination in some cases  *)
- pose (myenv:= (QP.prog_comp_env (QPprogram_of_program prog ha_env_cs la_env_cs)));
- assert (CSeq: _ = compspecs_of_QPcomposite_env myenv 
-                     (proj2 OK))
-   by (apply compspecs_eq_of_QPcomposite_env; reflexivity);
- subst myenv;
- change (QPprogram_of_program prog ha_env_cs la_env_cs) with p in CSeq;
- clear HA LA;
- exists OK;
-  [ check_Comp_Imports_Exports
-  | apply compute_list_norepet_e; reflexivity || fail "Duplicate funspec among the Externs++Imports"
-  | apply compute_list_norepet_e; reflexivity || fail "Duplicate funspec among the Exports"
-  | apply compute_list_norepet_e; reflexivity
-  | apply forallb_isSomeGfunExternal_e; reflexivity
-  | intros; simpl; split; trivial; try solve [lookup_tac]
-  | let i := fresh in let H := fresh in 
-    intros i H; first [ solve contradiction | simpl in H];
-    repeat (destruct H; [ subst; reflexivity |]); try contradiction
-  | apply prove_G_justified; carefully_unroll_Forall;  try SF_vacuous
-  | finishComponent
-  | first [ solve [intros; apply derives_refl] | solve [intros; reflexivity] | solve [intros; simpl; cancel] | idtac]
-  ].
-
-
  Ltac admit_external := 
  split3;
      [ reflexivity
@@ -152,21 +99,24 @@ Ltac VSU.mkComponent prog ::=
         | reflexivity
         | split3;
            [ left; trivial
-           | clear; intros ? ? ? ?; try (solve [ entailer ! ]);
+           | clear; intros ? ? ?; cbv [ofe_mor_car]; 
+             try (solve [ entailer ! ]);
               repeat
                match goal with
-               | |- (let (y, z) := ?x in _) _ && _ |-- _ =>
+               | |- monPred_at (let (y, z) := ?x in _) _ && _ |-- _ =>
                      destruct x as [y z]
                end;
                apply RETURN_tc_option_val_float; reflexivity
            | split; [  | eexists; split; compute; reflexivity ] ] ] ];
      [ admit ].
 
-Definition MathVSU: @VSU NullExtension.Espec
-        Math_E Math_imported_specs ltac:(QPprog prog) MathASI emp.
-  Proof. 
-    mkVSU prog Math_internal_specs; 
+
+Definition MathVSU `{Espec: ext_spec OK_ty}:
+    VSU Math_E Math_imported_specs ltac:(QPprog prog) MathASI (fun _ => emp).
+  Proof.
+    mkVSU prog Math_internal_specs;
     [solve_SF_internal body_placeholder | try admit_external .. ].
 all: fail.
 Admitted.
 
+End GFUNCTORS.
diff --git a/lib/proof/verif_threads.v b/lib/proof/verif_threads.v
index 842c58ee6e..3db3e1b756 100644
--- a/lib/proof/verif_threads.v
+++ b/lib/proof/verif_threads.v
@@ -3,35 +3,28 @@ Require Import VST.floyd.VSU.
 Require Import VSTlib.threads.
 Require Import VSTlib.spec_threads.
 
+Section mpred.
+Context `{!VSTGS OK_ty Σ}.
+
 Definition Threads_internal_specs: funspecs := ThreadsASI.
 
 Axiom body_spawn: semax_body Vprog Threads_internal_specs f_spawn (_spawn, spawn_spec).
 Axiom body_exit_thread: semax_body Vprog Threads_internal_specs f_exit_thread exit_thread_spec.
 
-Definition Threads_imported_specs:funspecs :=  nil.
+Definition Threads_imported_specs: @funspecs Σ :=  nil.
 
 
 Definition ThreadsVprog : varspecs. mk_varspecs prog. Defined.
 Definition ThreadsGprog: funspecs := Threads_imported_specs ++ Threads_internal_specs.
 
-Definition Threads_E : funspecs := nil.
-
-Ltac check_mpreds2 R ::= (* Patch for https://github.com/PrincetonUniversity/VST/issues/638 *)
- lazymatch R with
- | @sepcon mpred _ _ ?a ?b => check_mpreds2 a; check_mpreds2 b
- | _ => match type of R with ?t =>
-                          first [constr_eq t mpred
-                                 | fail 4 "The conjunct" R "has type" t "but should have type mpred; these two types may be convertible but they are not identical"]
-                     end
- | nil => idtac
- end.
+Definition Threads_E : @funspecs Σ := nil.
 
-#[local] Existing Instance NullExtension.Espec.   (* FIXME *)
-
-Definition ThreadsVSU: VSU Threads_E Threads_imported_specs ltac:(QPprog prog) ThreadsASI emp.
+Definition ThreadsVSU `{Espec: ext_spec OK_ty}: VSU Threads_E Threads_imported_specs ltac:(QPprog prog) ThreadsASI (fun _ => emp).
   Proof. 
     mkVSU prog Threads_internal_specs.
     - solve_SF_internal body_spawn.
     - solve_SF_internal body_exit_thread.
   Qed.
 
+End mpred.
+
diff --git a/lib/test/verif_incr.v b/lib/test/verif_incr.v
index b7feae0737..f8b135d65d 100644
--- a/lib/test/verif_incr.v
+++ b/lib/test/verif_incr.v
@@ -1,8 +1,11 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.VSU.
 Require Import VST.concurrency.conclib.
-Require Import VST.concurrency.ghosts.
 From VSTlib Require Import spec_locks spec_threads spec_malloc.
 Require VSTlib.verif_locks.
+Require Import iris_ora.algebra.ext_order.
+Require Import iris_ora.logic.cancelable_invariants.
+Require Import iris.algebra.lib.excl_auth.
 Require Import VSTlibtest.incr.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
@@ -11,53 +14,69 @@ Definition Vprog : varspecs. mk_varspecs prog. Defined.
 #[export] Existing Instance verif_locks.M.
 #[export] Existing Instance verif_malloc.M.
 
+Canonical Structure excl_authR A := inclR (excl_authR A).
+
+Section mpred.
+Context `{VSTGS1: !VSTGS unit Σ,
+          cinvG1: !cinvG Σ,
+          inG1: !inG Σ (excl_authR natO),
+          aii1: !atomic_int_impl (Tstruct _atom_int noattr)}.
+
 Definition spawn_spec := DECLARE _spawn spawn_spec.
 
 Definition t_counter := Tstruct _counter noattr.
 
-Definition cptr_lock_inv g1 g2 ctr := EX z : Z, field_at Ews t_counter [StructField _ctr] (Vint (Int.repr z)) ctr *
-  EX x : Z, EX y : Z, !!(z = x + y) && ghost_var gsh1 x g1 * ghost_var gsh1 y g2.
+Definition ghost_auth (g : gname) (n : nat) : mpred := own g (●E n : excl_authR natO).
+Definition ghost_frag (g : gname) (n : nat) : mpred := own g (◯E n : excl_authR natO).
+
+Definition cptr_lock_inv (g1 g2 : gname) (ctr : val) := ∃ z : nat, field_at Ews t_counter [StructField _ctr] (Vint (Int.repr z)) ctr ∗
+  ∃ x : nat, ∃ y : nat, ⌜(z = x + y)%nat⌝ ∧ ghost_auth g1 x ∗ ghost_auth g2 y.
 
 Definition incr_spec :=
  DECLARE _incr
-  WITH sh1 : share, sh : share, h : lock_handle, g1 : gname, g2 : gname, left : bool, n : Z, gv: globals
+  WITH sh1 : share, sh : Qp, h : lock_handle, g1 : gname, g2 : gname, left : bool, n : nat, gv: globals
   PRE [ ]
-         PROP  (readable_share sh1)
-         PARAMS () GLOBALS (gv)
-         SEP   (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c); lock_inv sh h (cptr_lock_inv g1 g2 (gv _c)); ghost_var gsh2 n (if left then g1 else g2))
+      PROP  (readable_share sh1)
+      PARAMS () GLOBALS (gv)
+      SEP (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c);
+           lock_inv sh h (cptr_lock_inv g1 g2 (gv _c));
+           ghost_frag (if left then g1 else g2) n)
   POST [ tvoid ]
-         PROP ()
-         LOCAL ()
-         SEP (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c); lock_inv sh h (cptr_lock_inv g1 g2 (gv _c)); ghost_var gsh2 (n+1) (if left then g1 else g2)).
+      PROP ()
+      LOCAL ()
+      SEP (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c);
+           lock_inv sh h (cptr_lock_inv g1 g2 (gv _c));
+           ghost_frag (if left then g1 else g2) (n+1)%nat).
+
 
 Definition read_spec :=
  DECLARE _read
-  WITH sh1 : share, sh : share, h : lock_handle, g1 : gname, g2 : gname, n1 : Z, n2 : Z, gv: globals
+  WITH sh1 : share, sh : Qp, h : lock_handle, g1 : gname, g2 : gname, n1 : nat, n2 : nat, gv: globals
   PRE [ ]
          PROP  (readable_share sh1)
          PARAMS () GLOBALS (gv)
-         SEP   (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c); lock_inv sh h (cptr_lock_inv g1 g2 (gv _c)); ghost_var gsh2 n1 g1; ghost_var gsh2 n2 g2)
+         SEP   (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c); lock_inv sh h (cptr_lock_inv g1 g2 (gv _c)); ghost_frag g1 n1; ghost_frag g2 n2)
   POST [ tuint ]
          PROP ()
-         RETURN (Vint (Int.repr (n1 + n2)))
-         SEP (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c); lock_inv sh h (cptr_lock_inv g1 g2 (gv _c)); ghost_var gsh2 n1 g1; ghost_var gsh2 n2 g2).
+         RETURN (Vint (Int.repr (n1 + n2)%nat))
+         SEP (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c); lock_inv sh h (cptr_lock_inv g1 g2 (gv _c)); ghost_frag g1 n1; ghost_frag g2 n2).
 
-Definition thread_lock_R sh1 sh h g1 g2 ctr :=
-  field_at sh1 t_counter [StructField _lock] (ptr_of h) ctr * lock_inv sh h (cptr_lock_inv g1 g2 ctr) * ghost_var gsh2 1 g1.
+Definition thread_lock_R sh1 (sh : Qp) h (g1 g2 : gname) (ctr : val) :=
+  field_at sh1 t_counter [StructField _lock] (ptr_of h) ctr ∗ lock_inv sh h (cptr_lock_inv g1 g2 ctr) ∗ ghost_frag g1 1.
 
 Definition thread_lock_inv sh1 sh h g1 g2 ctr ht :=
-  self_part sh ht * thread_lock_R sh1 sh h g1 g2 ctr.
+  self_part sh ht ∗ thread_lock_R sh1 sh h g1 g2 ctr.
 
 Definition thread_func_spec :=
  DECLARE _thread_func
-  WITH y : val, x : share * share * lock_handle * lock_handle * gname * gname * globals
+  WITH y : val, x : share * Qp * lock_handle * lock_handle * gname * gname * globals
   PRE [ tptr tvoid ]
          let '(sh1, sh, h, ht, g1, g2, gv) := x in
          PROP  (readable_share sh1; ptr_of ht = y)
          PARAMS (y) GLOBALS (gv)
          SEP   (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c);
                 lock_inv sh h (cptr_lock_inv g1 g2 (gv _c));
-                ghost_var gsh2 0 g1;
+                ghost_frag g1 0;
                 lock_inv sh ht (thread_lock_inv sh1 sh h g1 g2 (gv _c) ht))
   POST [ tint ]
          PROP ()
@@ -86,54 +105,72 @@ Lemma ctr_inv_exclusive : forall g1 g2 p,
   exclusive_mpred (cptr_lock_inv g1 g2 p).
 Proof.
   intros; unfold cptr_lock_inv.
-  eapply derives_exclusive, exclusive_sepcon1 with (Q := EX x : Z, EX y : Z, _),
-    field_at__exclusive with (sh := Ews)(t := t_counter); auto; simpl.
-  Intro z; apply sepcon_derives; [cancel|].
-  Intros x y; Exists x y; apply derives_refl.
+  iIntros "((% & ? & ?) & (% & ? & ?))".
+  rewrite !field_at_field_at_; iApply (field_at__conflict with "[$]"); auto.
   { simpl; lia. }
 Qed.
-#[export] Hint Resolve ctr_inv_exclusive : core.
+#[local] Hint Resolve ctr_inv_exclusive : core.
 
-Lemma ghost_var_incr : forall g1 g2 x y n (left : bool), ghost_var gsh1 x g1 * ghost_var gsh1 y g2 * ghost_var gsh2 n (if left then g1 else g2) |--
-  |==> !!((if left then x else y) = n) && ghost_var gsh1 (n+1) (if left then g1 else g2) * ghost_var gsh2 (n+1) (if left then g1 else g2) * ghost_var gsh1 (if left then y else x) (if left then g2 else g1).
+Lemma thread_inv_exclusive : forall sh1 sh h g1 g2 p,
+  exclusive_mpred (thread_lock_R sh1 sh h g1 g2 p).
+Proof.
+  intros; unfold thread_lock_R.
+  iIntros "((? & ? & g1) & (? & ? & g2))".
+  iDestruct (own_valid_2 with "g1 g2") as %[]%@excl_auth_frag_op_valid.
+Qed.
+#[local] Hint Resolve thread_inv_exclusive : core.
+
+Lemma ghost_var_inj : forall g x y, ghost_auth g x ∗ ghost_frag g y ⊢ ⌜x = y⌝.
+Proof.
+  intros; iIntros "(a & f)".
+  iDestruct (own_valid_2 with "a f") as %H%@excl_auth_agree; done.
+Qed.
+
+Lemma ghost_var_incr : forall g1 g2 x y n (left : bool), ghost_auth g1 x ∗ ghost_auth g2 y ∗ ghost_frag (if left then g1 else g2) n ⊢
+  |==> ⌜(if left then x else y) = n⌝ ∧ ghost_auth (if left then g1 else g2) (n+1)%nat ∗ ghost_frag (if left then g1 else g2) (n+1)%nat ∗
+       ghost_auth (if left then g2 else g1) (if left then y else x).
 Proof.
   destruct left.
-  - eapply derives_trans, bupd_frame_r; cancel.
-    rewrite sepcon_andp_prop'; apply ghost_var_update'.
-  - eapply derives_trans, bupd_frame_r; cancel.
-    rewrite sepcon_andp_prop'; apply ghost_var_update'.
+  - iIntros "(a & $ & f)".
+    iDestruct (ghost_var_inj with "[$a $f]") as %->.
+    iMod (own_update_2 with "a f") as "($ & $)"; last done.
+    apply @excl_auth_update.
+  - iIntros "($ & a & f)".
+    iDestruct (ghost_var_inj with "[$a $f]") as %->.
+    iMod (own_update_2 with "a f") as "($ & $)"; last done.
+    apply @excl_auth_update.
 Qed.
 
 Lemma body_incr: semax_body Vprog Gprog f_incr incr_spec.
 Proof.
   start_function.
   forward.
-  assert_PROP (sh <> Share.bot) by entailer!.
   forward_call (sh, h, cptr_lock_inv g1 g2 (gv _c)).
-  unfold cptr_lock_inv at 2. 
-Intros z x y.
+  unfold cptr_lock_inv at 2.
+  Intros z x y.
   forward.
   forward.
 
-  gather_SEP (ghost_var _ x g1) (ghost_var _ y g2) (ghost_var _ n _).
-  rewrite sepcon_assoc.
-  viewshift_SEP 0 (!!((if left then x else y) = n) &&
-    ghost_var gsh1 (n+1) (if left then g1 else g2) *
-    ghost_var gsh2 (n+1) (if left then g1 else g2) *
-    ghost_var gsh1 (if left then y else x) (if left then g2 else g1)).
-  { go_lower.
-    eapply derives_trans, bupd_fupd.
-    rewrite <- sepcon_assoc; apply ghost_var_incr. }
+  gather_SEP (ghost_auth g1 x) (ghost_auth g2 y) (ghost_frag _ n).
+  viewshift_SEP 0 (⌜(if left then x else y) = n⌝ ∧
+    ghost_auth (if left then g1 else g2) (n+1)%nat ∗
+    ghost_frag (if left then g1 else g2) (n+1)%nat ∗
+    ghost_auth (if left then g2 else g1) (if left then y else x)).
+  { go_lowerx.
+    iIntros "(? & _)".
+    by iMod (ghost_var_incr with "[$]"). }
   Intros.
   forward.
   forward_call release_simple (sh, h, cptr_lock_inv g1 g2 (gv _c)).
   { lock_props.
-    unfold cptr_lock_inv; Exists (z + 1).
-    unfold Frame; instantiate (1 := [ghost_var gsh2 (n+1) (if left then g1 else g2);
+    unfold cptr_lock_inv; Exists (z + 1)%nat.
+    unfold Frame; instantiate (1 := [ghost_frag (if left then g1 else g2) (n+1)%nat;
       field_at sh1 t_counter (DOT _lock) (ptr_of h) (gv _c)]); simpl.
     destruct left.
-    - Exists (n+1) y; entailer!.
-    - Exists x (n+1); entailer!. }
+    - Exists (n+1)%nat y; subst; entailer!.
+      rewrite !Nat2Z.inj_add //.
+    - Exists x (n+1)%nat; entailer!.
+      rewrite !Nat2Z.inj_add //. }
   forward.
   cancel.
 Qed.
@@ -142,20 +179,20 @@ Lemma body_read : semax_body Vprog Gprog f_read read_spec.
 Proof.
   start_function.
   forward.
-  assert_PROP (sh <> Share.bot) by entailer!.
   forward_call (sh, h, cptr_lock_inv g1 g2 (gv _c)).
-  unfold cptr_lock_inv at 2.
+  unfold cptr_lock_inv at 2; simpl.
   Intros z x y.
   forward.
   assert_PROP (x = n1 /\ y = n2) as Heq.
-  { sep_apply (ghost_var_inj gsh1 gsh2 x); auto.
-    sep_apply (ghost_var_inj gsh1 gsh2 y); auto.
+  { sep_apply ghost_var_inj.
+    sep_apply (ghost_var_inj g2).
     entailer!. }
   forward.
   forward_call release_simple (sh, h, cptr_lock_inv g1 g2 (gv _c)).
-  { lock_props.    
-    unfold cptr_lock_inv. Exists z x y. entailer!. }
-  destruct Heq; forward; cancel.
+  { lock_props.
+    unfold cptr_lock_inv; Exists z x y; entailer!. }
+  destruct Heq as [-> ->]; forward.
+  entailer!.
 Qed.
 
 Lemma body_thread_func : semax_body Vprog Gprog f_thread_func thread_func_spec.
@@ -164,70 +201,65 @@ Proof.
   forward_call (sh1, sh, h, g1, g2, true, 0, gv).
   simpl.
   forward_call release_self (sh, ht, thread_lock_R sh1 sh h g1 g2 (gv _c)).
-  { unfold thread_lock_inv, thread_lock_R; cancel. }
+  { lock_props.
+    unfold thread_lock_R at 2; unfold thread_lock_inv; cancel. }
   forward.
 Qed.
 
-Lemma ghost_dealloc:
-  forall {A} sh a pp, @ghost_var A sh a pp |-- emp.
-Proof.
-intros.
-unfold ghost_var.
-apply own_dealloc.
-Qed.
-
 Lemma body_compute2:  semax_body Vprog Gprog f_compute2 compute2_spec.
 Proof.
   start_function.
   set (ctr := gv _c).
   forward.
-  ghost_alloc (ghost_var Tsh 0).
+  ghost_alloc (fun g => own g (●E O ⋅ ◯E O : excl_authR natO)).
+  { apply excl_auth_valid. }
   Intro g1.
-  ghost_alloc (ghost_var Tsh 0).
+  ghost_alloc (fun g => own g (●E O ⋅ ◯E O : excl_authR natO)).
+  { apply excl_auth_valid. }
   Intro g2.
   forward_call (gv, fun _ : lock_handle => cptr_lock_inv g1 g2 ctr).
   Intros lock.
   forward.
   forward.
-  forward_call release_simple (Tsh, lock, cptr_lock_inv g1 g2 ctr).
+  forward_call release_simple (1%Qp, lock, cptr_lock_inv g1 g2 ctr).
   { lock_props.
-    rewrite <- !(ghost_var_share_join gsh1 gsh2 Tsh) by auto with share.
-    unfold_data_at (data_at _ _ _ _).
-    unfold cptr_lock_inv; Exists 0 0 0; entailer!. }
+    rewrite !own_op /cptr_lock_inv /ghost_auth.
+    Exists O O O.
+    unfold_data_at (data_at _ _ _ _); entailer!. }
   (* need to split off shares for the locks here *)
   destruct split_Ews as (sh1 & sh2 & ? & ? & Hsh).
-  forward_call (gv, fun lockt => thread_lock_inv sh2 gsh2 lock g1 g2 ctr lockt).
+  forward_call (gv, fun lockt => thread_lock_inv sh2 (1/2)%Qp lock g1 g2 ctr lockt).
   Intros lockt.
   sep_apply lock_inv_isptr; Intros.
-  forward_spawn _thread_func (ptr_of lockt) (sh2, gsh2, lock, lockt, g1, g2, gv).
-  { erewrite <- lock_inv_share_join; try apply gsh1_gsh2_join; auto.
-    erewrite <- (lock_inv_share_join _ _ Tsh); try apply gsh1_gsh2_join; auto.
+  forward_spawn _thread_func (ptr_of lockt) (sh2, (1/2)%Qp, lock, lockt, g1, g2, gv).
+  { rewrite -{3}Qp.half_half -frac_op -lock_inv_share_join.
+    rewrite -{1}Qp.half_half -frac_op -lock_inv_share_join.
     erewrite <- field_at_share_join; try apply Hsh; auto.
     subst ctr; entailer!. }
   { simpl; auto. }
-  forward_call (sh1, gsh1, lock, g1, g2, false, 0, gv).
-  forward_call (gsh1, lockt, thread_lock_inv sh2 gsh2 lock g1 g2 (gv _c) lockt).
+  forward_call (sh1, (1/2)%Qp, lock, g1, g2, false, 0, gv).
+  forward_call ((1/2)%Qp, lockt, thread_lock_inv sh2 (1/2)%Qp lock g1 g2 (gv _c) lockt).
   unfold thread_lock_inv at 2; unfold thread_lock_R; Intros.
   simpl.
-  forward_call (sh1, gsh1, lock, g1, g2, 1, 1, gv).
+  forward_call (sh1, (1/2)%Qp, lock, g1, g2, 1, 1, gv).
   (* We've proved that t is 2! *)
   forward.
-  forward_call (gsh1, lock, cptr_lock_inv g1 g2 (gv _c)).
-  forward_call freelock_self (gsh1, gsh2, lockt, thread_lock_R sh2 gsh2 lock g1 g2 (gv _c)).
+  forward_call ((1/2)%Qp, lock, cptr_lock_inv g1 g2 (gv _c)).
+  forward_call freelock_self ((1/2)%Qp, (1/2)%Qp, lockt, thread_lock_R sh2 (1/2) lock g1 g2 (gv _c)).
   { unfold thread_lock_inv, selflock; cancel. }
+  { rewrite frac_op Qp.half_half //. }
   forward.
   forward_call freelock_simple (lock, cptr_lock_inv g1 g2 (gv _c)).
   { lock_props.
-    erewrite <- (lock_inv_share_join _ _ Tsh); try apply gsh1_gsh2_join; auto; subst ctr; cancel. }
+    rewrite -{2}Qp.half_half -frac_op -lock_inv_share_join.
+    subst ctr; cancel. }
   forward.
-  unfold_data_at (data_at_ _ _ _).
-  simpl.
-  unfold cptr_lock_inv. Intros z x y.
-  sep_apply (field_at_share_join sh1 sh2 Ews).
+  unfold_data_at (data_at_ _ _ _). simpl.
   cancel.
-  repeat sep_apply (@ghost_dealloc Z).
-  cancel.
-Qed.
+  unfold cptr_lock_inv; Intros z x y; cancel.
+  rewrite -(field_at_share_join _ _ Ews); [|eauto]; cancel.
+  by iIntros "(_ & _ & _ & _)".
+ Qed.
 
 (*
 
@@ -236,10 +268,6 @@ Definition extlink := ext_link_prog prog. (* this is wrong, because
 Definition Espec := add_funspecs (Concurrent_Espec unit _ extlink) extlink Gprog.
 *)
 
-#[local] Existing Instance NullExtension.Espec.  (* FIXME *)
-
-Require Import VST.floyd.VSU.
-
 Definition IncrVSU: VSU nil incrImports ltac:(QPprog prog) [compute2_spec] (InitGPred (Vardefs (QPprog prog))).
   Proof. 
     mkVSU prog incrInternals.
@@ -248,3 +276,6 @@ Definition IncrVSU: VSU nil incrImports ltac:(QPprog prog) [compute2_spec] (Init
     - solve_SF_internal body_thread_func.
     - solve_SF_internal body_compute2.
   Qed.
+
+End mpred.
+
diff --git a/lib/test/verif_incr_main.v b/lib/test/verif_incr_main.v
index 781f1d4016..466b35e79e 100644
--- a/lib/test/verif_incr_main.v
+++ b/lib/test/verif_incr_main.v
@@ -1,20 +1,29 @@
 (* Do not edit this file, it was generated automatically *)
 Require Import VST.floyd.proofauto.
 Require Import VST.concurrency.conclib.
-Require Import VST.concurrency.ghosts.
 From VSTlib Require Import spec_locks spec_threads spec_malloc.
 Require VSTlib.verif_locks.
+Require Import iris_ora.logic.cancelable_invariants.
 Require Import VSTlibtest.incr_main.
 Require Import VSTlibtest.verif_incr.
 Require Import VST.floyd.VSU.
 
 Require VSTlib.verif_threads.
+
+Section mpred.
+Context `{VSTGS1: !VSTGS unit Σ, 
+          cinvG1: !cinvG Σ, 
+          inG1: !inG Σ (excl_authR natO), 
+          aii1: !atomic_int_impl (Tstruct locks._atom_int noattr)}.
+
+
 Definition AB_VSU :=
   ltac:(linkVSUs (verif_SC_atomics.SCAVSU) (verif_threads.ThreadsVSU)).
 
 Require VSTlib.verif_locks.
-Definition ABC_VSU :=
-  ltac:(linkVSUs AB_VSU verif_locks.LockVSU).
+Definition ABC_VSU:=
+  ltac:(linkVSUs AB_VSU 
+         (verif_locks.LockVSU)).
 
 Ltac SC_tac ::=
  match goal with |- SC_test ?ids _ _ =>
@@ -39,13 +48,13 @@ Definition core_VSU :=
 Definition main_QPprog := ltac:(QPprog prog).
 Definition whole_prog := ltac:(QPlink_progs main_QPprog (VSU_prog core_VSU)).
 Definition Vprog: varspecs := QPvarspecs whole_prog.
-Definition Main_imports := filter (matchImportExport main_QPprog) (VSU_Exports core_VSU). 
+Definition Main_imports := filter (matchImportExport main_QPprog) (VSU_Exports core_VSU).
 
 Definition main_spec :=
  DECLARE _main
   WITH gv : globals
   PRE  [] main_pre whole_prog tt gv
-  POST [ tint ] PROP() RETURN (Vint (Int.repr 2)) SEP (TT).
+  POST [ tint ] PROP() RETURN (Vint (Int.repr 2)) SEP (True).
 
 Definition Gprog :=  Main_imports ++ [main_spec].
 
@@ -58,7 +67,7 @@ pose core_VSU.
  unfold InitGPred; simpl. Intros. unfold globvar2pred; simpl.
  change (Maps.PTree.prev _) with incr._c.
  change 16 with (@sizeof verif_incr.CompSpecs t_counter).
- sep_apply (@mapsto_zero_data_at_zero verif_incr.CompSpecs t_counter Ews (gv incr._c)); 
+ sep_apply (mapsto_zero_data_at_zero (cs:=verif_incr.CompSpecs) t_counter Ews (gv incr._c)); 
        auto with field_compatible.
   repeat (rewrite zero_val_eq; simpl).
   repeat change (fold_reptype ?a) with a.
@@ -67,7 +76,7 @@ pose core_VSU.
   forward.
 Qed.
 
-Definition MainComp:  MainCompType nil main_QPprog core_VSU whole_prog (snd main_spec)  emp.
+Definition MainComp:  MainCompType nil main_QPprog core_VSU whole_prog (snd main_spec) (fun _ => emp).
 Proof.
 mkComponent prog.
 solve_SF_internal body_main.
@@ -88,3 +97,5 @@ Definition extlink := ext_link_prog prog. (* this is wrong, because
        it doesn't include the programs of all the imported VSUs *)
 Definition Espec := add_funspecs (Concurrent_Espec unit _ extlink) extlink Gprog.
 *)
+End mpred.
+
diff --git a/lib/test/verif_testmath.v b/lib/test/verif_testmath.v
index 9601541d93..12c02ebc6a 100644
--- a/lib/test/verif_testmath.v
+++ b/lib/test/verif_testmath.v
@@ -1,5 +1,6 @@
 Require Import VST.floyd.proofauto.
-Require Import VSTlibtest.testmath.
+Require Import VST.floyd.compat.
+Require Import VSTlibtest.testmath. Import NoOracle.
 Require Import VSTlib.spec_math.
 Require Import vcfloat.FPCompCert.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
@@ -15,7 +16,7 @@ Definition f_model (t: ftype Tdouble) : ftype Tdouble :=
   let y := sin t in
   (x*x+y*y)%F64.
 
-Definition f_spec :=
+Definition f_spec : ident * funspec :=
  DECLARE _f
   WITH t: float
   PRE [ tdouble ]
@@ -163,8 +164,8 @@ Lemma f_model_accurate': forall t,
 Proof.
 intros.
 rename t into x.
-pose_valmap_of_list vmap [(_x, existT ftype Tdouble (ftype_of_float x))].
-pose proof prove_roundoff_bound_x vmap.
+pose_valmap_of_list vmap1 [(_x, existT Tdouble (ftype_of_float x))].
+pose proof prove_roundoff_bound_x vmap1.
 red in H0.
 spec H0. {
   apply boundsmap_denote_i; simpl; auto.
@@ -175,10 +176,10 @@ red in H0.
 destruct H0.
 split; auto.
 unfold f_model.
-change (FT2R _) with (FT2R (fval (env_ vmap) F')).
-forget (FT2R (fval (env_ vmap) F')) as g.
+change (FT2R _) with (FT2R (fval (env_ vmap1) F')).
+forget (FT2R (fval (env_ vmap1) F')) as g.
 simpl in H1.
-change (env_ vmap Tdouble _ _x) with x in H1.
+change (env_ vmap1 Tdouble _ _x) with x in H1.
 clear - H1.
 rewrite  Rplus_comm in H1.
 change (sin ?t * sin ?t + cos ?t * cos ?t) with ((sin t)² + (cos t)²) in H1.
diff --git a/mailbox/mailbox.c b/mailbox/mailbox.c
index 0bdf6b1abf..6c343ecdba 100644
--- a/mailbox/mailbox.c
+++ b/mailbox/mailbox.c
@@ -2,12 +2,12 @@
 #include <stddef.h>
 #include "stdlib.h"
 //#include <stdio.h>
-#include "atomic_exchange.h"
+#include "../atomics/SC_atomics.h"
+#include "../concurrency/threads.h"
 //#include "threads.h"
 //#include <stdatomic.h>
 
 
-
 void *surely_malloc (size_t n) {
   void *p = malloc(n);
   if (!p) exit(1);
@@ -31,8 +31,7 @@ typedef int buf_id;
 
 typedef struct buffer {int data;} buffer;
 buffer *bufs[B];
-lock_t lock[N];
-buf_id *comm[N];
+atom_int *comm[N];
 
 //registrar function
 buf_id *reading[N], *last_read[N];
@@ -44,15 +43,12 @@ void initialize_channels(){
     bufs[i] = b;
   }
   for(int r = 0; r < N; r++){
+    atom_int *a = make_atomic(First);
+    comm[r] = a;
     buf_id *c = surely_malloc(sizeof(buf_id));
-    *c = First;
-    comm[r] = c;
-    c = surely_malloc(sizeof(buf_id));
     reading[r] = c;
     c = surely_malloc(sizeof(buf_id));
     last_read[r] = c;
-    lock[r] = makelock();
-    release(lock[r]);
   }
 }
 
@@ -66,11 +62,10 @@ void initialize_reader(int r){
 
 buf_id start_read(int r){
   buf_id b;
-  buf_id *c = comm[r];
-  lock_t l = lock[r];
+  atom_int *c = comm[r];
   buf_id *rr = reading[r];
   buf_id *lr = last_read[r];
-  b = simulate_atomic_exchange(c, l, Empty);
+  b = atom_exchange(c, Empty);
   if(b >= 0 && b < B)
     *lr = b;
   else
@@ -123,9 +118,8 @@ void finish_write(){
   buf_id last = last_given;
   buf_id w = writing;
   for(int r = 0; r < N; r++){
-    buf_id *c = comm[r];
-    lock_t l = lock[r];
-    buf_id b = simulate_atomic_exchange(c, l, w);
+    atom_int *c = comm[r];
+    buf_id b = atom_exchange(c, w);
     if(b == Empty)
       last_taken[r] = last;
   }
diff --git a/mailbox/mailbox.v b/mailbox/mailbox.v
index 0db696b06b..186eb97f88 100644
--- a/mailbox/mailbox.v
+++ b/mailbox/mailbox.v
@@ -10,24 +10,22 @@ Module Info.
   Definition build_number := "".
   Definition build_tag := "".
   Definition build_branch := "".
-  Definition arch := "aarch64".
-  Definition model := "default".
-  Definition abi := "apple".
+  Definition arch := "x86".
+  Definition model := "64".
+  Definition abi := "standard".
   Definition bitsize := 64.
   Definition big_endian := false.
   Definition source_file := "mailbox/mailbox.c".
   Definition normalized := true.
 End Info.
 
+Definition ___builtin_ais_annot : ident := $"__builtin_ais_annot".
 Definition ___builtin_annot : ident := $"__builtin_annot".
 Definition ___builtin_annot_intval : ident := $"__builtin_annot_intval".
 Definition ___builtin_bswap : ident := $"__builtin_bswap".
 Definition ___builtin_bswap16 : ident := $"__builtin_bswap16".
 Definition ___builtin_bswap32 : ident := $"__builtin_bswap32".
 Definition ___builtin_bswap64 : ident := $"__builtin_bswap64".
-Definition ___builtin_cls : ident := $"__builtin_cls".
-Definition ___builtin_clsl : ident := $"__builtin_clsl".
-Definition ___builtin_clsll : ident := $"__builtin_clsll".
 Definition ___builtin_clz : ident := $"__builtin_clz".
 Definition ___builtin_clzl : ident := $"__builtin_clzl".
 Definition ___builtin_clzll : ident := $"__builtin_clzll".
@@ -47,6 +45,8 @@ Definition ___builtin_fnmsub : ident := $"__builtin_fnmsub".
 Definition ___builtin_fsqrt : ident := $"__builtin_fsqrt".
 Definition ___builtin_membar : ident := $"__builtin_membar".
 Definition ___builtin_memcpy_aligned : ident := $"__builtin_memcpy_aligned".
+Definition ___builtin_read16_reversed : ident := $"__builtin_read16_reversed".
+Definition ___builtin_read32_reversed : ident := $"__builtin_read32_reversed".
 Definition ___builtin_sel : ident := $"__builtin_sel".
 Definition ___builtin_sqrt : ident := $"__builtin_sqrt".
 Definition ___builtin_unreachable : ident := $"__builtin_unreachable".
@@ -54,6 +54,8 @@ Definition ___builtin_va_arg : ident := $"__builtin_va_arg".
 Definition ___builtin_va_copy : ident := $"__builtin_va_copy".
 Definition ___builtin_va_end : ident := $"__builtin_va_end".
 Definition ___builtin_va_start : ident := $"__builtin_va_start".
+Definition ___builtin_write16_reversed : ident := $"__builtin_write16_reversed".
+Definition ___builtin_write32_reversed : ident := $"__builtin_write32_reversed".
 Definition ___compcert_i64_dtos : ident := $"__compcert_i64_dtos".
 Definition ___compcert_i64_dtou : ident := $"__compcert_i64_dtou".
 Definition ___compcert_i64_sar : ident := $"__compcert_i64_sar".
@@ -73,8 +75,9 @@ Definition ___compcert_va_composite : ident := $"__compcert_va_composite".
 Definition ___compcert_va_float64 : ident := $"__compcert_va_float64".
 Definition ___compcert_va_int32 : ident := $"__compcert_va_int32".
 Definition ___compcert_va_int64 : ident := $"__compcert_va_int64".
-Definition _acquire : ident := $"acquire".
+Definition _a : ident := $"a".
 Definition _arg : ident := $"arg".
+Definition _atom_exchange : ident := $"atom_exchange".
 Definition _atom_int : ident := $"atom_int".
 Definition _avail : ident := $"avail".
 Definition _available : ident := $"available".
@@ -94,15 +97,13 @@ Definition _i__1 : ident := $"i__1".
 Definition _initialize_channels : ident := $"initialize_channels".
 Definition _initialize_reader : ident := $"initialize_reader".
 Definition _initialize_writer : ident := $"initialize_writer".
-Definition _l : ident := $"l".
 Definition _last : ident := $"last".
 Definition _last_given : ident := $"last_given".
 Definition _last_read : ident := $"last_read".
 Definition _last_taken : ident := $"last_taken".
-Definition _lock : ident := $"lock".
 Definition _lr : ident := $"lr".
 Definition _main : ident := $"main".
-Definition _makelock : ident := $"makelock".
+Definition _make_atomic : ident := $"make_atomic".
 Definition _malloc : ident := $"malloc".
 Definition _memset : ident := $"memset".
 Definition _n : ident := $"n".
@@ -110,26 +111,20 @@ Definition _p : ident := $"p".
 Definition _r : ident := $"r".
 Definition _reader : ident := $"reader".
 Definition _reading : ident := $"reading".
-Definition _release : ident := $"release".
 Definition _rr : ident := $"rr".
 Definition _s : ident := $"s".
-Definition _simulate_atomic_exchange : ident := $"simulate_atomic_exchange".
 Definition _spawn : ident := $"spawn".
 Definition _start_read : ident := $"start_read".
 Definition _start_write : ident := $"start_write".
 Definition _surely_malloc : ident := $"surely_malloc".
-Definition _tgt : ident := $"tgt".
 Definition _v : ident := $"v".
 Definition _w : ident := $"w".
 Definition _writer : ident := $"writer".
 Definition _writing : ident := $"writing".
-Definition _x : ident := $"x".
 Definition _t'1 : ident := 128%positive.
 Definition _t'2 : ident := 129%positive.
 Definition _t'3 : ident := 130%positive.
 Definition _t'4 : ident := 131%positive.
-Definition _t'5 : ident := 132%positive.
-Definition _t'6 : ident := 133%positive.
 
 Definition f_surely_malloc := {|
   fn_return := (tptr tvoid);
@@ -188,15 +183,8 @@ Definition v_bufs := {|
   gvar_volatile := false
 |}.
 
-Definition v_lock := {|
-  gvar_info := (tarray (tptr (Tstruct _atom_int noattr)) 3);
-  gvar_init := (Init_space 24 :: nil);
-  gvar_readonly := false;
-  gvar_volatile := false
-|}.
-
 Definition v_comm := {|
-  gvar_info := (tarray (tptr tint) 3);
+  gvar_info := (tarray (tptr (Tstruct _atom_int noattr)) 3);
   gvar_init := (Init_space 24 :: nil);
   gvar_readonly := false;
   gvar_volatile := false
@@ -222,11 +210,11 @@ Definition f_initialize_channels := {|
   fn_params := nil;
   fn_vars := nil;
   fn_temps := ((_i, tint) :: (_b, (tptr (Tstruct _buffer noattr))) ::
-               (_r, tint) :: (_c, (tptr tint)) ::
-               (_t'5, (tptr (Tstruct _atom_int noattr))) ::
-               (_t'4, (tptr tvoid)) :: (_t'3, (tptr tvoid)) ::
-               (_t'2, (tptr tvoid)) :: (_t'1, (tptr tvoid)) ::
-               (_t'6, (tptr (Tstruct _atom_int noattr))) :: nil);
+               (_r, tint) :: (_a, (tptr (Tstruct _atom_int noattr))) ::
+               (_c, (tptr tint)) :: (_t'4, (tptr tvoid)) ::
+               (_t'3, (tptr tvoid)) ::
+               (_t'2, (tptr (Tstruct _atom_int noattr))) ::
+               (_t'1, (tptr tvoid)) :: nil);
   fn_body :=
 (Ssequence
   (Ssequence
@@ -273,74 +261,45 @@ Definition f_initialize_channels := {|
         (Ssequence
           (Ssequence
             (Scall (Some _t'2)
-              (Evar _surely_malloc (Tfunction (tulong :: nil) (tptr tvoid)
-                                     cc_default))
-              ((Esizeof tint tulong) :: nil))
-            (Sset _c (Etempvar _t'2 (tptr tvoid))))
+              (Evar _make_atomic (Tfunction (tint :: nil)
+                                   (tptr (Tstruct _atom_int noattr))
+                                   cc_default))
+              ((Econst_int (Int.repr 0) tint) :: nil))
+            (Sset _a (Etempvar _t'2 (tptr (Tstruct _atom_int noattr)))))
           (Ssequence
-            (Sassign (Ederef (Etempvar _c (tptr tint)) tint)
-              (Econst_int (Int.repr 0) tint))
+            (Sassign
+              (Ederef
+                (Ebinop Oadd
+                  (Evar _comm (tarray (tptr (Tstruct _atom_int noattr)) 3))
+                  (Etempvar _r tint)
+                  (tptr (tptr (Tstruct _atom_int noattr))))
+                (tptr (Tstruct _atom_int noattr)))
+              (Etempvar _a (tptr (Tstruct _atom_int noattr))))
             (Ssequence
-              (Sassign
-                (Ederef
-                  (Ebinop Oadd (Evar _comm (tarray (tptr tint) 3))
-                    (Etempvar _r tint) (tptr (tptr tint))) (tptr tint))
-                (Etempvar _c (tptr tint)))
               (Ssequence
+                (Scall (Some _t'3)
+                  (Evar _surely_malloc (Tfunction (tulong :: nil)
+                                         (tptr tvoid) cc_default))
+                  ((Esizeof tint tulong) :: nil))
+                (Sset _c (Etempvar _t'3 (tptr tvoid))))
+              (Ssequence
+                (Sassign
+                  (Ederef
+                    (Ebinop Oadd (Evar _reading (tarray (tptr tint) 3))
+                      (Etempvar _r tint) (tptr (tptr tint))) (tptr tint))
+                  (Etempvar _c (tptr tint)))
                 (Ssequence
-                  (Scall (Some _t'3)
-                    (Evar _surely_malloc (Tfunction (tulong :: nil)
-                                           (tptr tvoid) cc_default))
-                    ((Esizeof tint tulong) :: nil))
-                  (Sset _c (Etempvar _t'3 (tptr tvoid))))
-                (Ssequence
+                  (Ssequence
+                    (Scall (Some _t'4)
+                      (Evar _surely_malloc (Tfunction (tulong :: nil)
+                                             (tptr tvoid) cc_default))
+                      ((Esizeof tint tulong) :: nil))
+                    (Sset _c (Etempvar _t'4 (tptr tvoid))))
                   (Sassign
                     (Ederef
-                      (Ebinop Oadd (Evar _reading (tarray (tptr tint) 3))
+                      (Ebinop Oadd (Evar _last_read (tarray (tptr tint) 3))
                         (Etempvar _r tint) (tptr (tptr tint))) (tptr tint))
-                    (Etempvar _c (tptr tint)))
-                  (Ssequence
-                    (Ssequence
-                      (Scall (Some _t'4)
-                        (Evar _surely_malloc (Tfunction (tulong :: nil)
-                                               (tptr tvoid) cc_default))
-                        ((Esizeof tint tulong) :: nil))
-                      (Sset _c (Etempvar _t'4 (tptr tvoid))))
-                    (Ssequence
-                      (Sassign
-                        (Ederef
-                          (Ebinop Oadd
-                            (Evar _last_read (tarray (tptr tint) 3))
-                            (Etempvar _r tint) (tptr (tptr tint)))
-                          (tptr tint)) (Etempvar _c (tptr tint)))
-                      (Ssequence
-                        (Ssequence
-                          (Scall (Some _t'5)
-                            (Evar _makelock (Tfunction nil
-                                              (tptr (Tstruct _atom_int noattr))
-                                              cc_default)) nil)
-                          (Sassign
-                            (Ederef
-                              (Ebinop Oadd
-                                (Evar _lock (tarray (tptr (Tstruct _atom_int noattr)) 3))
-                                (Etempvar _r tint)
-                                (tptr (tptr (Tstruct _atom_int noattr))))
-                              (tptr (Tstruct _atom_int noattr)))
-                            (Etempvar _t'5 (tptr (Tstruct _atom_int noattr)))))
-                        (Ssequence
-                          (Sset _t'6
-                            (Ederef
-                              (Ebinop Oadd
-                                (Evar _lock (tarray (tptr (Tstruct _atom_int noattr)) 3))
-                                (Etempvar _r tint)
-                                (tptr (tptr (Tstruct _atom_int noattr))))
-                              (tptr (Tstruct _atom_int noattr))))
-                          (Scall None
-                            (Evar _release (Tfunction
-                                             ((tptr (Tstruct _atom_int noattr)) ::
-                                              nil) tvoid cc_default))
-                            ((Etempvar _t'6 (tptr (Tstruct _atom_int noattr))) ::
-                             nil))))))))))))
+                    (Etempvar _c (tptr tint)))))))))
       (Sset _r
         (Ebinop Oadd (Etempvar _r tint) (Econst_int (Int.repr 1) tint) tint)))))
 |}.
@@ -374,63 +333,53 @@ Definition f_start_read := {|
   fn_callconv := cc_default;
   fn_params := ((_r, tint) :: nil);
   fn_vars := nil;
-  fn_temps := ((_b, tint) :: (_c, (tptr tint)) ::
-               (_l, (tptr (Tstruct _atom_int noattr))) ::
+  fn_temps := ((_b, tint) :: (_c, (tptr (Tstruct _atom_int noattr))) ::
                (_rr, (tptr tint)) :: (_lr, (tptr tint)) :: (_t'2, tint) ::
                (_t'1, tint) :: nil);
   fn_body :=
 (Ssequence
   (Sset _c
     (Ederef
-      (Ebinop Oadd (Evar _comm (tarray (tptr tint) 3)) (Etempvar _r tint)
-        (tptr (tptr tint))) (tptr tint)))
+      (Ebinop Oadd (Evar _comm (tarray (tptr (Tstruct _atom_int noattr)) 3))
+        (Etempvar _r tint) (tptr (tptr (Tstruct _atom_int noattr))))
+      (tptr (Tstruct _atom_int noattr))))
   (Ssequence
-    (Sset _l
+    (Sset _rr
       (Ederef
-        (Ebinop Oadd
-          (Evar _lock (tarray (tptr (Tstruct _atom_int noattr)) 3))
-          (Etempvar _r tint) (tptr (tptr (Tstruct _atom_int noattr))))
-        (tptr (Tstruct _atom_int noattr))))
+        (Ebinop Oadd (Evar _reading (tarray (tptr tint) 3))
+          (Etempvar _r tint) (tptr (tptr tint))) (tptr tint)))
     (Ssequence
-      (Sset _rr
+      (Sset _lr
         (Ederef
-          (Ebinop Oadd (Evar _reading (tarray (tptr tint) 3))
+          (Ebinop Oadd (Evar _last_read (tarray (tptr tint) 3))
             (Etempvar _r tint) (tptr (tptr tint))) (tptr tint)))
       (Ssequence
-        (Sset _lr
-          (Ederef
-            (Ebinop Oadd (Evar _last_read (tarray (tptr tint) 3))
-              (Etempvar _r tint) (tptr (tptr tint))) (tptr tint)))
+        (Ssequence
+          (Scall (Some _t'1)
+            (Evar _atom_exchange (Tfunction
+                                   ((tptr (Tstruct _atom_int noattr)) ::
+                                    tint :: nil) tint cc_default))
+            ((Etempvar _c (tptr (Tstruct _atom_int noattr))) ::
+             (Eunop Oneg (Econst_int (Int.repr 1) tint) tint) :: nil))
+          (Sset _b (Etempvar _t'1 tint)))
         (Ssequence
           (Ssequence
-            (Scall (Some _t'1)
-              (Evar _simulate_atomic_exchange (Tfunction
-                                                ((tptr tint) ::
-                                                 (tptr (Tstruct _atom_int noattr)) ::
-                                                 tint :: nil) tint
-                                                cc_default))
-              ((Etempvar _c (tptr tint)) ::
-               (Etempvar _l (tptr (Tstruct _atom_int noattr))) ::
-               (Eunop Oneg (Econst_int (Int.repr 1) tint) tint) :: nil))
-            (Sset _b (Etempvar _t'1 tint)))
-          (Ssequence
-            (Ssequence
-              (Sifthenelse (Ebinop Oge (Etempvar _b tint)
-                             (Econst_int (Int.repr 0) tint) tint)
-                (Sset _t'2
-                  (Ecast
-                    (Ebinop Olt (Etempvar _b tint)
-                      (Ebinop Oadd (Econst_int (Int.repr 3) tint)
-                        (Econst_int (Int.repr 2) tint) tint) tint) tbool))
-                (Sset _t'2 (Econst_int (Int.repr 0) tint)))
-              (Sifthenelse (Etempvar _t'2 tint)
-                (Sassign (Ederef (Etempvar _lr (tptr tint)) tint)
-                  (Etempvar _b tint))
-                (Sset _b (Ederef (Etempvar _lr (tptr tint)) tint))))
-            (Ssequence
-              (Sassign (Ederef (Etempvar _rr (tptr tint)) tint)
+            (Sifthenelse (Ebinop Oge (Etempvar _b tint)
+                           (Econst_int (Int.repr 0) tint) tint)
+              (Sset _t'2
+                (Ecast
+                  (Ebinop Olt (Etempvar _b tint)
+                    (Ebinop Oadd (Econst_int (Int.repr 3) tint)
+                      (Econst_int (Int.repr 2) tint) tint) tint) tbool))
+              (Sset _t'2 (Econst_int (Int.repr 0) tint)))
+            (Sifthenelse (Etempvar _t'2 tint)
+              (Sassign (Ederef (Etempvar _lr (tptr tint)) tint)
                 (Etempvar _b tint))
-              (Sreturn (Some (Etempvar _b tint))))))))))
+              (Sset _b (Ederef (Etempvar _lr (tptr tint)) tint))))
+          (Ssequence
+            (Sassign (Ederef (Etempvar _rr (tptr tint)) tint)
+              (Etempvar _b tint))
+            (Sreturn (Some (Etempvar _b tint)))))))))
 |}.
 
 Definition f_finish_read := {|
@@ -591,8 +540,7 @@ Definition f_finish_write := {|
   fn_params := nil;
   fn_vars := nil;
   fn_temps := ((_last, tint) :: (_w, tint) :: (_r, tint) ::
-               (_c, (tptr tint)) ::
-               (_l, (tptr (Tstruct _atom_int noattr))) :: (_b, tint) ::
+               (_c, (tptr (Tstruct _atom_int noattr))) :: (_b, tint) ::
                (_t'1, tint) :: nil);
   fn_body :=
 (Ssequence
@@ -611,37 +559,29 @@ Definition f_finish_write := {|
             (Ssequence
               (Sset _c
                 (Ederef
-                  (Ebinop Oadd (Evar _comm (tarray (tptr tint) 3))
-                    (Etempvar _r tint) (tptr (tptr tint))) (tptr tint)))
+                  (Ebinop Oadd
+                    (Evar _comm (tarray (tptr (Tstruct _atom_int noattr)) 3))
+                    (Etempvar _r tint)
+                    (tptr (tptr (Tstruct _atom_int noattr))))
+                  (tptr (Tstruct _atom_int noattr))))
               (Ssequence
-                (Sset _l
-                  (Ederef
-                    (Ebinop Oadd
-                      (Evar _lock (tarray (tptr (Tstruct _atom_int noattr)) 3))
-                      (Etempvar _r tint)
-                      (tptr (tptr (Tstruct _atom_int noattr))))
-                    (tptr (Tstruct _atom_int noattr))))
                 (Ssequence
-                  (Ssequence
-                    (Scall (Some _t'1)
-                      (Evar _simulate_atomic_exchange (Tfunction
-                                                        ((tptr tint) ::
-                                                         (tptr (Tstruct _atom_int noattr)) ::
-                                                         tint :: nil) tint
-                                                        cc_default))
-                      ((Etempvar _c (tptr tint)) ::
-                       (Etempvar _l (tptr (Tstruct _atom_int noattr))) ::
-                       (Etempvar _w tint) :: nil))
-                    (Sset _b (Etempvar _t'1 tint)))
-                  (Sifthenelse (Ebinop Oeq (Etempvar _b tint)
-                                 (Eunop Oneg (Econst_int (Int.repr 1) tint)
-                                   tint) tint)
-                    (Sassign
-                      (Ederef
-                        (Ebinop Oadd (Evar _last_taken (tarray tint 3))
-                          (Etempvar _r tint) (tptr tint)) tint)
-                      (Etempvar _last tint))
-                    Sskip)))))
+                  (Scall (Some _t'1)
+                    (Evar _atom_exchange (Tfunction
+                                           ((tptr (Tstruct _atom_int noattr)) ::
+                                            tint :: nil) tint cc_default))
+                    ((Etempvar _c (tptr (Tstruct _atom_int noattr))) ::
+                     (Etempvar _w tint) :: nil))
+                  (Sset _b (Etempvar _t'1 tint)))
+                (Sifthenelse (Ebinop Oeq (Etempvar _b tint)
+                               (Eunop Oneg (Econst_int (Int.repr 1) tint)
+                                 tint) tint)
+                  (Sassign
+                    (Ederef
+                      (Ebinop Oadd (Evar _last_taken (tarray tint 3))
+                        (Etempvar _r tint) (tptr tint)) tint)
+                    (Etempvar _last tint))
+                  Sskip))))
           (Sset _r
             (Ebinop Oadd (Etempvar _r tint) (Econst_int (Int.repr 1) tint)
               tint))))
@@ -890,6 +830,12 @@ Definition global_definitions : list (ident * globdef fundef type) :=
                    (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
                      cc_default)) (tulong :: tulong :: nil) tulong
      cc_default)) ::
+ (___builtin_ais_annot,
+   Gfun(External (EF_builtin "__builtin_ais_annot"
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid
+                     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
+     ((tptr tschar) :: nil) tvoid
+     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
  (___builtin_bswap64,
    Gfun(External (EF_builtin "__builtin_bswap64"
                    (mksignature (AST.Xlong :: nil) AST.Xlong cc_default))
@@ -1001,18 +947,16 @@ Definition global_definitions : list (ident * globdef fundef type) :=
    Gfun(External (EF_builtin "__builtin_expect"
                    (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
                      cc_default)) (tlong :: tlong :: nil) tlong cc_default)) ::
- (___builtin_cls,
-   Gfun(External (EF_builtin "__builtin_cls"
-                   (mksignature (AST.Xint :: nil) AST.Xint cc_default))
-     (tint :: nil) tint cc_default)) ::
- (___builtin_clsl,
-   Gfun(External (EF_builtin "__builtin_clsl"
-                   (mksignature (AST.Xlong :: nil) AST.Xint cc_default))
-     (tlong :: nil) tint cc_default)) ::
- (___builtin_clsll,
-   Gfun(External (EF_builtin "__builtin_clsll"
-                   (mksignature (AST.Xlong :: nil) AST.Xint cc_default))
-     (tlong :: nil) tint cc_default)) ::
+ (___builtin_fmax,
+   Gfun(External (EF_builtin "__builtin_fmax"
+                   (mksignature (AST.Xfloat :: AST.Xfloat :: nil) AST.Xfloat
+                     cc_default)) (tdouble :: tdouble :: nil) tdouble
+     cc_default)) ::
+ (___builtin_fmin,
+   Gfun(External (EF_builtin "__builtin_fmin"
+                   (mksignature (AST.Xfloat :: AST.Xfloat :: nil) AST.Xfloat
+                     cc_default)) (tdouble :: tdouble :: nil) tdouble
+     cc_default)) ::
  (___builtin_fmadd,
    Gfun(External (EF_builtin "__builtin_fmadd"
                    (mksignature
@@ -1037,15 +981,24 @@ Definition global_definitions : list (ident * globdef fundef type) :=
                      (AST.Xfloat :: AST.Xfloat :: AST.Xfloat :: nil)
                      AST.Xfloat cc_default))
      (tdouble :: tdouble :: tdouble :: nil) tdouble cc_default)) ::
- (___builtin_fmax,
-   Gfun(External (EF_builtin "__builtin_fmax"
-                   (mksignature (AST.Xfloat :: AST.Xfloat :: nil) AST.Xfloat
-                     cc_default)) (tdouble :: tdouble :: nil) tdouble
+ (___builtin_read16_reversed,
+   Gfun(External (EF_builtin "__builtin_read16_reversed"
+                   (mksignature (AST.Xptr :: nil) AST.Xint16unsigned
+                     cc_default)) ((tptr tushort) :: nil) tushort
      cc_default)) ::
- (___builtin_fmin,
-   Gfun(External (EF_builtin "__builtin_fmin"
-                   (mksignature (AST.Xfloat :: AST.Xfloat :: nil) AST.Xfloat
-                     cc_default)) (tdouble :: tdouble :: nil) tdouble
+ (___builtin_read32_reversed,
+   Gfun(External (EF_builtin "__builtin_read32_reversed"
+                   (mksignature (AST.Xptr :: nil) AST.Xint cc_default))
+     ((tptr tuint) :: nil) tuint cc_default)) ::
+ (___builtin_write16_reversed,
+   Gfun(External (EF_builtin "__builtin_write16_reversed"
+                   (mksignature (AST.Xptr :: AST.Xint16unsigned :: nil)
+                     AST.Xvoid cc_default))
+     ((tptr tushort) :: tushort :: nil) tvoid cc_default)) ::
+ (___builtin_write32_reversed,
+   Gfun(External (EF_builtin "__builtin_write32_reversed"
+                   (mksignature (AST.Xptr :: AST.Xint :: nil) AST.Xvoid
+                     cc_default)) ((tptr tuint) :: tuint :: nil) tvoid
      cc_default)) ::
  (___builtin_debug,
    Gfun(External (EF_external "__builtin_debug"
@@ -1058,29 +1011,25 @@ Definition global_definitions : list (ident * globdef fundef type) :=
    Gfun(External (EF_external "exit"
                    (mksignature (AST.Xint :: nil) AST.Xvoid cc_default))
      (tint :: nil) tvoid cc_default)) ::
- (_makelock,
-   Gfun(External (EF_external "makelock"
-                   (mksignature nil AST.Xptr cc_default)) nil
-     (tptr (Tstruct _atom_int noattr)) cc_default)) ::
- (_release,
-   Gfun(External (EF_external "release"
-                   (mksignature (AST.Xptr :: nil) AST.Xvoid cc_default))
-     ((tptr (Tstruct _atom_int noattr)) :: nil) tvoid cc_default)) ::
+ (_make_atomic,
+   Gfun(External (EF_external "make_atomic"
+                   (mksignature (AST.Xint :: nil) AST.Xptr cc_default))
+     (tint :: nil) (tptr (Tstruct _atom_int noattr)) cc_default)) ::
+ (_atom_exchange,
+   Gfun(External (EF_external "atom_exchange"
+                   (mksignature (AST.Xptr :: AST.Xint :: nil) AST.Xint
+                     cc_default))
+     ((tptr (Tstruct _atom_int noattr)) :: tint :: nil) tint cc_default)) ::
  (_spawn,
    Gfun(External (EF_external "spawn"
                    (mksignature (AST.Xptr :: AST.Xptr :: nil) AST.Xvoid
                      cc_default))
      ((tptr (Tfunction ((tptr tvoid) :: nil) tint cc_default)) ::
       (tptr tvoid) :: nil) tvoid cc_default)) ::
- (_simulate_atomic_exchange,
-   Gfun(External (EF_external "simulate_atomic_exchange"
-                   (mksignature (AST.Xptr :: AST.Xptr :: AST.Xint :: nil)
-                     AST.Xint cc_default))
-     ((tptr tint) :: (tptr (Tstruct _atom_int noattr)) :: tint :: nil) tint
-     cc_default)) :: (_surely_malloc, Gfun(Internal f_surely_malloc)) ::
+ (_surely_malloc, Gfun(Internal f_surely_malloc)) ::
  (_memset, Gfun(Internal f_memset)) :: (_bufs, Gvar v_bufs) ::
- (_lock, Gvar v_lock) :: (_comm, Gvar v_comm) ::
- (_reading, Gvar v_reading) :: (_last_read, Gvar v_last_read) ::
+ (_comm, Gvar v_comm) :: (_reading, Gvar v_reading) ::
+ (_last_read, Gvar v_last_read) ::
  (_initialize_channels, Gfun(Internal f_initialize_channels)) ::
  (_initialize_reader, Gfun(Internal f_initialize_reader)) ::
  (_start_read, Gfun(Internal f_start_read)) ::
@@ -1097,20 +1046,21 @@ Definition public_idents : list ident :=
 (_main :: _writer :: _reader :: _finish_write :: _start_write ::
  _initialize_writer :: _last_given :: _writing :: _last_taken ::
  _finish_read :: _start_read :: _initialize_reader :: _initialize_channels ::
- _last_read :: _reading :: _comm :: _lock :: _bufs :: _memset ::
- _surely_malloc :: _simulate_atomic_exchange :: _spawn :: _release ::
- _makelock :: _exit :: _malloc :: ___builtin_debug :: ___builtin_fmin ::
- ___builtin_fmax :: ___builtin_fnmsub :: ___builtin_fnmadd ::
- ___builtin_fmsub :: ___builtin_fmadd :: ___builtin_clsll ::
- ___builtin_clsl :: ___builtin_cls :: ___builtin_expect ::
- ___builtin_unreachable :: ___builtin_va_end :: ___builtin_va_copy ::
- ___builtin_va_arg :: ___builtin_va_start :: ___builtin_membar ::
- ___builtin_annot_intval :: ___builtin_annot :: ___builtin_sel ::
- ___builtin_memcpy_aligned :: ___builtin_sqrt :: ___builtin_fsqrt ::
- ___builtin_fabsf :: ___builtin_fabs :: ___builtin_ctzll ::
- ___builtin_ctzl :: ___builtin_ctz :: ___builtin_clzll :: ___builtin_clzl ::
- ___builtin_clz :: ___builtin_bswap16 :: ___builtin_bswap32 ::
- ___builtin_bswap :: ___builtin_bswap64 :: ___compcert_i64_umulh ::
+ _last_read :: _reading :: _comm :: _bufs :: _memset :: _surely_malloc ::
+ _spawn :: _atom_exchange :: _make_atomic :: _exit :: _malloc ::
+ ___builtin_debug :: ___builtin_write32_reversed ::
+ ___builtin_write16_reversed :: ___builtin_read32_reversed ::
+ ___builtin_read16_reversed :: ___builtin_fnmsub :: ___builtin_fnmadd ::
+ ___builtin_fmsub :: ___builtin_fmadd :: ___builtin_fmin ::
+ ___builtin_fmax :: ___builtin_expect :: ___builtin_unreachable ::
+ ___builtin_va_end :: ___builtin_va_copy :: ___builtin_va_arg ::
+ ___builtin_va_start :: ___builtin_membar :: ___builtin_annot_intval ::
+ ___builtin_annot :: ___builtin_sel :: ___builtin_memcpy_aligned ::
+ ___builtin_sqrt :: ___builtin_fsqrt :: ___builtin_fabsf ::
+ ___builtin_fabs :: ___builtin_ctzll :: ___builtin_ctzl :: ___builtin_ctz ::
+ ___builtin_clzll :: ___builtin_clzl :: ___builtin_clz ::
+ ___builtin_bswap16 :: ___builtin_bswap32 :: ___builtin_bswap ::
+ ___builtin_bswap64 :: ___builtin_ais_annot :: ___compcert_i64_umulh ::
  ___compcert_i64_smulh :: ___compcert_i64_sar :: ___compcert_i64_shr ::
  ___compcert_i64_shl :: ___compcert_i64_umod :: ___compcert_i64_smod ::
  ___compcert_i64_udiv :: ___compcert_i64_sdiv :: ___compcert_i64_utof ::
diff --git a/mailbox/verif_atomic_exchange.v b/mailbox/verif_atomic_exchange.v
index a6fcf44454..c5d873a71b 100644
--- a/mailbox/verif_atomic_exchange.v
+++ b/mailbox/verif_atomic_exchange.v
@@ -1,16 +1,6 @@
-Require Import VST.veric.rmaps.
 Require Import VST.concurrency.conclib.
-Require Import VST.concurrency.ghosts.
-Require Import VST.floyd.library.
-Require Import VST.zlist.sublist.
-Require Import VST.concurrency.lock_specs.
-Require Import VST.atomics.verif_lock.
-Require Import mailbox.atomic_exchange.
-Require Import Lia.
-
-(* standard VST prelude *)
-#[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
-Definition Vprog : varspecs. mk_varspecs prog. Defined.
+From iris_ora.algebra Require Import frac_auth.
+Require Import VST.atomics.SC_atomics.
 
 Section AEHist.
 
@@ -23,8 +13,6 @@ Fixpoint apply_hist a h :=
   | AE r w :: h' => if eq_dec r a then apply_hist w h' else None
   end.
 
-Arguments eq_dec _ _ _ _ : simpl never.
-
 Lemma apply_hist_app : forall h1 i h2, apply_hist i (h1 ++ h2) =
   match apply_hist i h1 with Some v => apply_hist v h2 | None => None end.
 Proof.
@@ -35,157 +23,259 @@ Qed.
 
 End AEHist.
 
-Notation hist := (nat -> option AE_hist_el).
+Notation hist := (gmap nat (excl AE_hist_el)).
+Notation histR := (iris.algebra.gmap.gmapR nat (iris.algebra.excl.exclR (leibnizO AE_hist_el))).
 
-(* the lock invariant used to encode an atomic invariant *)
-Definition AE_inv x g i R := EX h : list AE_hist_el, EX v : val,
-  !!(apply_hist i h = Some v /\ tc_val tint v) &&
-  (data_at Ews tint v x * ghost_ref h g * R h v).
+#[global] Instance hist_inhabitant : Inhabitant hist := (∅ : hist).
 
-Lemma AE_inv_exclusive : forall x g i R, exclusive_mpred (AE_inv x g i R).
+Fixpoint list_to_hist (l : list AE_hist_el) n : hist :=
+  match l with
+  | [] => ∅
+  | e :: rest => <[n := Excl e]> (list_to_hist rest (S n))
+  end.
+
+Lemma list_to_hist_lookup : forall l n i, (n <= i)%nat ->
+  (list_to_hist l n !! i) = option_map Excl (nth_error l (i - n)).
 Proof.
-  unfold AE_inv; intros.
-  eapply derives_exclusive, exclusive_sepcon1 with (Q := EX h : list AE_hist_el, EX v : val, _),
-    data_at__exclusive with (sh := Ews)(t := tint); auto; simpl; try lia.
-  Intros h v; rewrite sepcon_assoc; apply sepcon_derives; [cancel|].
-  Exists h v; apply derives_refl.
+  induction l; simpl; intros.
+  - rewrite lookup_empty nth_error_nil //.
+  - destruct (eq_dec n i).
+    + subst; rewrite lookup_insert Nat.sub_diag //.
+    + rewrite lookup_insert_ne //.
+      destruct (i - n)%nat as [|n'] eqn: Hi; first lia.
+      rewrite IHl /=; last lia.
+      do 2 f_equal; lia.
 Qed.
-#[export] Hint Resolve AE_inv_exclusive : core.
 
-Definition AE_loc sh l p g i R (h : hist) := lock_inv sh l (AE_inv p g i R) * ghost_hist sh h g.
+Lemma list_to_hist_insert : forall l n e,
+  <[(n + length l)%nat := Excl e]>(list_to_hist l n) = list_to_hist (l ++ [e]) n.
+Proof.
+  induction l; simpl; intros.
+  - rewrite Nat.add_0_r //.
+  - rewrite insert_commute; last lia.
+    replace (n + S _)%nat with (S n + length l)%nat by lia.
+    rewrite IHl //.
+Qed.
+
+Definition hist_incl (h : hist) l := forall t e, h !! t = Some (Excl e) -> nth_error l t = Some e.
+
+Definition newer (l : hist) t := forall t', l !! t' <> None -> (t' < t)%nat.
 
-Lemma AE_inv_super_non_expansive : forall n p g i R,
-  compcert_rmaps.RML.R.approx n (AE_inv p g i R) =
-  compcert_rmaps.RML.R.approx n (AE_inv p g i (fun h v => compcert_rmaps.RML.R.approx n (R h v))).
+Lemma hist_incl_lt : forall (h : histR) l (Hv : ✓ h),
+  hist_incl h l -> newer h (length l).
 Proof.
-  intros; unfold AE_inv.
-  rewrite !approx_exp; apply f_equal; extensionality h.
-  rewrite !approx_exp; apply f_equal; extensionality v.
-  rewrite !approx_andp, !approx_sepcon.
-  rewrite approx_idem; auto.
+  unfold hist_incl; repeat intro.
+  specialize (H t'); specialize (Hv t').
+  destruct (h !! t') as [e|] eqn: Ht'; [|contradiction].
+  rewrite Ht' in Hv.
+  destruct e; try done.
+  by apply nth_error_Some; erewrite H.
 Qed.
 
-Lemma AE_loc_super_non_expansive : forall n sh l p g i R h,
-  compcert_rmaps.RML.R.approx n (AE_loc sh l p g i R h) =
-  compcert_rmaps.RML.R.approx n (AE_loc sh l p g i (fun h v => compcert_rmaps.RML.R.approx n (R h v)) h).
+Lemma newer_over : forall h t t', newer h t -> (t <= t')%nat -> h !! t' = None.
 Proof.
-  intros; unfold AE_loc.
-  rewrite !approx_sepcon; f_equal.
-  setoid_rewrite lock_inv_super_non_expansive; do 2 f_equal.
-  rewrite AE_inv_super_non_expansive; auto.
+  intros.
+  specialize (H t').
+  destruct (h !! t'); auto.
+  lapply H; [lia | discriminate].
 Qed.
 
-(* This predicate describes the valid pre- and postconditions for a given atomic invariant R. *)
-Definition AE_spec i P R Q := ALL hc : _, ALL hx : _, ALL vc : _, ALL vx : _,
-  !!(apply_hist i hx = Some vx /\ hist_incl hc hx) -->
-  ((R hx vx * P hc vc) -* (|==> R (hx ++ [AE vx vc]) vc *
-    Q (map_upd hc (length hx) (AE vx vc)) vx)).
-
-Lemma AE_spec_super_non_expansive : forall n i P R Q, compcert_rmaps.RML.R.approx n (AE_spec i P R Q) =
-  compcert_rmaps.RML.R.approx n (AE_spec i (fun h v => compcert_rmaps.RML.R.approx n (P h v))
-                                           (fun h v => compcert_rmaps.RML.R.approx n (R h v))
-                                           (fun h v => compcert_rmaps.RML.R.approx n (Q h v))).
+Corollary newer_out : forall h t, newer h t -> h !! t = None.
+Proof.
+  intros; eapply newer_over; eauto.
+Qed.
+
+Class AEGS `{!VSTGS OK_ty Σ} (atomic_int : type) := { histG :: inG Σ (frac_authR histR);
+  AI :: atomic_int_impl atomic_int }.
+
+Section AE.
+
+Context `{!VSTGS OK_ty Σ} `{!AEGS atomic_int}.
+
+(* to SC_atomics? *)
+Axiom atomic_int_timeless : forall sh v p, Timeless (atomic_int_at sh v p).
+#[export] Existing Instance atomic_int_timeless.
+Axiom atomic_int_isptr : forall sh v p, atomic_int_at sh v p ⊢ ⌜isptr p⌝.
+#[local] Hint Resolve atomic_int_isptr : saturate_local.
+
+Definition ghost_ref h g := own g (●F (list_to_hist h O : histR) : frac_authR _).
+Definition ghost_hist q (h : histR) g := own g (◯F{q} h : frac_authR _).
+Definition ghost_hist_ref q (h r : histR) g := own g (●F r ⋅ ◯F{q} h : frac_authR _).
+
+Lemma ghost_hist_init : ✓ (●F (∅ : histR) ⋅ ◯F (∅ : histR) : frac_authR _).
+Proof. by apply @frac_auth_valid. Qed.
+
+Lemma hist_ref_join_nil : forall q g, ghost_hist q ∅ g ∗ ghost_ref [] g ⊣⊢ ghost_hist_ref q ∅ ∅ g.
+Proof.
+  intros.
+  rewrite bi.sep_comm; symmetry; apply own_op.
+Qed.
+
+Lemma hist_ref_incl : forall sh h h' p,
+  ghost_hist sh h p ∗ ghost_ref h' p ⊢ ⌜hist_incl h h'⌝.
 Proof.
-  intros; unfold AE_spec.
-  rewrite !(approx_allp _ _ _ empty_map); apply f_equal; extensionality.
-  rewrite !(approx_allp _ _ _ []); apply f_equal; extensionality.
-  rewrite !(approx_allp _ _ _ Vundef); apply f_equal; extensionality.
-  rewrite !(approx_allp _ _ _ Vundef); apply f_equal; extensionality.
-  setoid_rewrite approx_imp; f_equal; f_equal.
-  rewrite view_shift_nonexpansive, !approx_sepcon; auto.
+  intros; iIntros "(Hh & Hr)".
+  iPoseProof (own_valid_2 with "Hr Hh") as "H".
+  rewrite frac_auth_agreeI.
+  if_tac.
+  - iDestruct "H" as %Hh; iPureIntro.
+    apply leibniz_equiv in Hh as <-.
+    intros ??.
+    rewrite list_to_hist_lookup; last lia.
+    destruct (nth_error _ _) eqn: E; inversion 1; subst.
+    rewrite Nat.sub_0_r // in E.
+  - iDestruct "H" as %Hh; iPureIntro.
+    assert (forall i, included(A := optionR (exclR (leibnizO AE_hist_el)))
+      (h !! i) (list_to_hist h' 0 !! i)) as Hincl.
+    { rewrite -gmap.lookup_included /included.
+      destruct Hh as (z & Hz); exists z; rewrite Hz //. }
+    intros ?? Ht.
+    specialize (Hincl t); rewrite Ht list_to_hist_lookup in Hincl; last lia.
+    rewrite Nat.sub_0_r in Hincl.
+    destruct (nth_error h' t) eqn: Hnth.
+    rewrite Excl_included in Hincl; rewrite Hincl //.
+    { rewrite option_included in Hincl.
+      destruct Hincl as [| (? & ? & ? & ? & ?)]; done. }
 Qed.
 
+Lemma hist_add' : forall sh h h' e p,
+  ghost_hist sh h p ∗ ghost_ref h' p ⊢ |==>
+  ghost_hist sh (<[length h' := Excl e]>h) p ∗ ghost_ref (h' ++ [e]) p.
+Proof.
+  intros; iIntros "(Hh & Hr)".
+  iMod (own_update_2 with "Hr Hh") as "H".
+  { apply (frac_auth_update sh (list_to_hist h' 0: histR)).
+    apply (gmap.alloc_local_update _ _ (length h') ((Excl e) : exclR (leibnizO _))); last done.
+    rewrite list_to_hist_lookup; last lia.
+    rewrite (proj2 (nth_error_None _ _)) //; lia. }
+  iDestruct (own_op with "H") as "(Hr & $)".
+  rewrite (list_to_hist_insert _ O) //.
+Qed.
+
+(* the lock invariant used to encode an atomic invariant *)
+Definition AE_inv x g i (R : list AE_hist_el -d> val -d> mpred) := ∃ h v, ⌜apply_hist i h = Some v /\ tc_val tint v⌝ ∧
+  (atomic_int_at Ews v x ∗ ghost_ref h g ∗ R h v).
+
+#[export] Instance AE_inv_ne x g i : NonExpansive (AE_inv x g i).
+Proof. solve_proper. Qed.
+
+Lemma AE_inv_exclusive : forall x g i R, exclusive_mpred (AE_inv x g i R).
+Proof.
+  unfold AE_inv; intros.
+  rewrite /exclusive_mpred; iIntros "((% & % & % & Ha & _) & (% & % & % & Hb & _))".
+  iApply atomic_int_conflict; last iFrame; auto.
+Qed.
+
+Definition AE_loc sh p g i (R : list AE_hist_el -d> val -d> mpred) (h : hist) := ⌜isptr p⌝ ∧ (inv (nroot .@ "AE") (AE_inv p g i R) ∗ ghost_hist sh h g).
+
+Lemma AE_loc_isptr : forall sh p g i R h, AE_loc sh p g i R h ⊢ ⌜isptr p⌝.
+Proof.
+  intros; rewrite /AE_loc.
+  iIntros "($ & _)".
+Qed.
+
+#[export] Instance AE_loc_ne sh p g i n : Proper (dist n ==> eq ==> dist n) (AE_loc sh p g i).
+Proof. solve_proper. Qed.
+
+(* This predicate describes the valid pre- and postconditions for a given atomic invariant R. *)
+Definition AE_spec i (P : histR -d> val -d> mpred) (R : list AE_hist_el -d> val -d> mpred) (Q : histR -d> val -d> mpred) := ∀ (hc : histR) hx vc vx,
+  ⌜apply_hist i hx = Some vx /\ ✓ (hc : histR) /\ hist_incl hc hx⌝ →
+  ((▷R hx vx ∗ P hc vc) -∗ (|={⊤ ∖ ↑(nroot .@ "AE")}=> ▷R (hx ++ [AE vx vc]) vc ∗
+    Q (<[length hx := Excl (AE vx vc)]>hc) vx)).
+
+#[export] Instance AE_spec_ne i : NonExpansive3 (AE_spec i).
+Proof. solve_proper. Qed.
+
 Definition AE_type := ProdType (ProdType (ProdType
-  (ConstType (share * val * gname * lock_handle * val * val * hist))
-  (ArrowType (ConstType hist) (ArrowType (ConstType val) Mpred)))
-  (ArrowType (ConstType (list AE_hist_el)) (ArrowType (ConstType val) Mpred)))
-  (ArrowType (ConstType hist) (ArrowType (ConstType val) Mpred)).
+  (ConstType (Qp * val * gname * val * val * hist))
+  (DiscreteFunType hist (DiscreteFunType val Mpred)))
+  (DiscreteFunType (list AE_hist_el) (DiscreteFunType val Mpred)))
+  (DiscreteFunType hist (DiscreteFunType val Mpred)).
 
 (* specification of atomic exchange *)
-Program Definition atomic_exchange_spec := DECLARE _simulate_atomic_exchange
-  TYPE AE_type WITH lsh : share, tgt : val, g : gname, l : lock_handle,
+Program Definition atomic_exchange_spec :=
+  TYPE AE_type WITH lsh : Qp, tgt : val, g : gname,
     i : val, v : val, h : hist, P : hist -> val -> mpred, R : list AE_hist_el -> val -> mpred, Q : hist -> val -> mpred
-  PRE [ tptr tint, tptr t_lock, tint ]
-   PROP (tc_val tint v; readable_share lsh)
-   PARAMS (tgt; ptr_of l; v) GLOBALS ()
-   SEP (AE_loc lsh l tgt g i R h; P h v; AE_spec i P R Q)
+  PRE [ tptr atomic_int, tint ]
+   PROP (tc_val tint v)
+   PARAMS (tgt; v) GLOBALS ()
+   SEP (AE_loc lsh tgt g i R h; P h v; AE_spec i P R Q)
   POST [ tint ]
-   EX t : nat, EX v' : val,
+   ∃ t : nat, ∃ v' : val,
    PROP (tc_val tint v'; newer h t)
    LOCAL (temp ret_temp v')
-   SEP (AE_loc lsh l tgt g i R (map_upd h t (AE v' v)); Q (map_upd h t (AE v' v)) v').
+   SEP (AE_loc lsh tgt g i R (<[t := Excl (AE v' v)]>h); Q (<[t := Excl (AE v' v)]>h) v').
 Next Obligation.
 Proof.
-  repeat intro.
-  destruct x as (((((((((?, ?), ?), ?), ?), ?), ?), P), R), Q); simpl.
-  unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, argsassert2assert; simpl; rewrite !approx_andp; f_equal; f_equal;
-    rewrite !sepcon_emp, ?approx_sepcon, ?approx_idem.
-  rewrite AE_loc_super_non_expansive; do 3 f_equal.
-  apply AE_spec_super_non_expansive.
+  intros ? ((((((((?, ?), ?), ?), ?), ?), ?), ?), ?) (((((?, ?), ?), ?), ?), ?) ((([=] & ?) & ?) & ?) rho; simpl in *; subst; simpl in *.
+  solve_proper.
 Qed.
 Next Obligation.
 Proof.
-  repeat intro.
-  destruct x as (((((((((?, ?), ?), ?), ?), ?), ?), P), R), Q); simpl.
-  rewrite !approx_exp; apply f_equal; extensionality t.
-  rewrite !approx_exp; apply f_equal; extensionality v'.
-  unfold PROPx, LOCALx, SEPx; simpl; rewrite !approx_andp; f_equal; f_equal;
-    rewrite !sepcon_emp, ?approx_sepcon, ?approx_idem, AE_loc_super_non_expansive; auto.
+  intros ? ((((((((?, ?), ?), ?), ?), ?), ?), ?), ?) (((((?, ?), ?), ?), ?), ?) ((([=] & ?) & ?) & ?) rho; simpl in *; subst; simpl in *.
+  solve_proper.
 Qed.
 
-Definition Gprog : funspecs := ltac:(with_library prog [acquire_spec; release_spec; atomic_exchange_spec]).
-
-(* proof of the lock-based implementation of atomic exchange *)
-Lemma body_atomic_exchange : semax_body Vprog Gprog f_simulate_atomic_exchange atomic_exchange_spec.
-Proof. 
-  start_dep_function.
-  unfold AE_loc; Intros.
-  forward_call (lsh, l, AE_inv tgt g i R).
-  unfold AE_inv at 2; Intros h' v'.
-  assert (lsh <> Share.bot).
-  { intro; subst; contradiction unreadable_bot. }
-  forward.
-  forward.
-  assert (apply_hist i (h' ++ [AE v' v]) = Some v) as Hh'.
-  { rewrite apply_hist_app.
-    replace (apply_hist i h') with (Some v'); simpl.
-    apply eq_dec_refl. }
-  gather_SEP (ghost_hist _ _ _) (ghost_ref _ _).
-  assert_PROP (hist_incl h h') as Hincl.
-  { go_lower; apply sepcon_derives_prop.
-    rewrite hist_ref_join by auto.
-    Intros hr.
-    apply prop_right; eapply hist_sub_list_incl; eauto. }
-  viewshift_SEP 0
-    (ghost_hist lsh (map_upd h (length h') (AE v' v)) g * ghost_ref (h' ++ [AE v' v]) g)
-    by (go_lower; eapply derives_trans, bupd_fupd; apply hist_add').
-  gather_SEP (AE_spec _ _ _ _) (R h' v') (P h v); rewrite sepcon_assoc; simpl.
-  viewshift_SEP 0 (R (h' ++ [AE v' v]) v * Q (map_upd h (length h') (AE v' v)) v').
-  { go_lower; unfold AE_spec.
-    eapply derives_trans, bupd_fupd.
-    eapply derives_trans; [apply allp_sepcon1 | apply allp_left with h].
-    eapply derives_trans; [apply allp_sepcon1 | apply allp_left with h'].
-    eapply derives_trans; [apply allp_sepcon1 | apply allp_left with (Vint v)].
-    eapply derives_trans; [apply allp_sepcon1 | apply allp_left with (Vint v')].
-    rewrite prop_imp by auto.
-    rewrite sepcon_comm; apply modus_ponens_wand. }
-  forward_call release_simple (lsh, l, AE_inv tgt g i R).
-  { lock_props.
+Lemma AE_sub : funspec_sub SC_atomics.atomic_exchange_spec atomic_exchange_spec.
+Proof.
+  split; first done.
+  intros ((((((((q, p), g), i), v), h), P), R), Q) ?; simpl.
+  iIntros "(% & (% & _) & % & H) !>"; iExists (p, v, ⊤, ∅,
+    fun v' => ∃ t, ⌜tc_val tint v' /\ newer h t⌝ ∧ AE_loc q p g i R (<[t := Excl (AE v' v)]>h) ∗ Q (<[t := Excl (AE v' v)]>h) v'), emp.
+  iSplit; first done.
+  iSplit.
+  - repeat (iSplit; first done).
+    rewrite /SEPx /= /LOCALx /argsassert2assert /=; monPred.unseal.
+    repeat (iSplit; first done).
+    iDestruct "H" as "(_ & (% & #I & hist) & P & spec & _)".
+    iSplit; last done.
     unfold AE_inv.
-    Exists (h' ++ [AE v' v]) v; entailer!; cancel.
-  }
-  forward.
-  Exists (length h') (Vint v'). unfold AE_loc; entailer!.
-  apply hist_incl_lt; auto.
+    iInv "I" as "(% & % & HI)" "Hclose".
+    rewrite bi.later_and; iDestruct "HI" as "(>(%Hh0 & %) & >Hp & >ref & R)".
+    iApply fupd_mask_intro; first set_solver; iIntros "Hmask".
+    iExists _, _; iFrame "Hp"; iSplit; first done.
+    iIntros "Hp".
+    iMod "Hmask" as "_".
+    iDestruct (own_valid with "hist") as %Hh.
+    rewrite auth_frag_valid in Hh; destruct Hh.
+    iDestruct (hist_ref_incl with "[$hist $ref]") as %?.
+    iMod (hist_add' with "[$hist $ref]") as "(hist & ref)".
+    rewrite /AE_spec.
+    iMod ("spec" with "[%] [$P $R]") as "(R & Q)"; first done.
+    iMod ("Hclose" with "[Hp ref R]") as "_".
+    { rewrite /AE_inv; iNext.
+      iExists _, _; iFrame; iPureIntro.
+      repeat (split; auto).
+      rewrite apply_hist_app Hh0 /=.
+      apply eq_dec_refl. }
+    iIntros "!>"; iExists _; iFrame.
+    iSplit; last auto.
+    iPureIntro; split; auto.
+    apply hist_incl_lt; done.
+  - iPureIntro; intros.
+    iIntros "(% & _ & % & _ & ? & H & _)"; simpl.
+    iDestruct "H" as (t ?) "(? & ?)".
+    iExists t, (Vint v'); iSplit.
+    { simpl; iPureIntro; tauto. }
+    iSplit; first done.
+    simpl; iFrame.
 Qed.
 
-Lemma AE_loc_join : forall sh1 sh2 sh l p g i R h1 h2 (Hjoin : sepalg.join sh1 sh2 sh)
-  (Hsh1 : readable_share sh1) (Hsh2 : readable_share sh2) (Hcompat : disjoint h1 h2),
-  AE_loc sh1 l p g i R h1 * AE_loc sh2 l p g i R h2 = AE_loc sh l p g i R (map_add h1 h2).
+Lemma AE_loc_join : forall sh1 sh2 p g i R h1 h2,
+  AE_loc sh1 p g i R h1 ∗ AE_loc sh2 p g i R h2 ⊣⊢ AE_loc (sh1 ⋅ sh2) p g i R (@op _ (gmap.gmap_op_instance(A := exclR (leibnizO _))) h1 h2).
 Proof.
-  intros; unfold AE_loc.
-  match goal with |- (?P1 * ?Q1) * (?P2 * ?Q2) = _ => transitivity ((P1 * P2) * (Q1 * Q2));
-    [apply pred_ext; cancel|] end.
-  erewrite lock_inv_share_join, ghost_hist_join by (eauto; intro; subst; contradiction unreadable_bot).
-  rewrite prop_true_andp; auto.
+  intros; rewrite /AE_loc.
+  assert (ghost_hist (sh1 ⋅ sh2) (h1 ⋅ h2) g ⊣⊢ ghost_hist sh1 h1 g ∗ ghost_hist sh2 h2 g) as ->.
+  { rewrite -own_op. rewrite /ghost_hist; f_equiv.
+    rewrite frac_op.
+    apply (frac_auth_frag_op(A := histR) sh1 sh2 h1 h2). }
+  iSplit.
+  - iIntros "(($ & $ & $) & (_ & _ & $))".
+  - iIntros "(#$ & #$ & $ & $)".
 Qed.
+
+End AE.
+
+#[export] Hint Resolve AE_loc_isptr : saturate_local.
+#[export] Hint Resolve AE_inv_exclusive : core.
+#[export] Hint Resolve ghost_hist_init : init.
diff --git a/mailbox/verif_mailbox_all.v b/mailbox/verif_mailbox_all.v
index af599ac8c8..67a8346272 100644
--- a/mailbox/verif_mailbox_all.v
+++ b/mailbox/verif_mailbox_all.v
@@ -1,6 +1,5 @@
 Require Import mailbox.verif_atomic_exchange.
 Require Import VST.concurrency.conclib.
-Require Import VST.concurrency.ghosts.
 Require Import VST.floyd.library.
 Require Import VST.zlist.sublist.
 Require Import mailbox.mailbox.
@@ -12,32 +11,35 @@ Require Import mailbox.verif_mailbox_reader.
 Require Import mailbox.verif_mailbox_writer.
 Require Import mailbox.verif_mailbox_main.
 
-Definition extlink := ext_link_prog prog.
-Definition Espec := add_funspecs (Concurrent_Espec unit _ extlink) extlink Gprog.
-#[export] Existing Instance Espec.
+Section mpred.
+
+Context `{!VSTGS unit Σ, AEGS0 : !AEGS t_atom_int, !inG Σ (excl_authR (leibnizO val))}.
+
+Definition ext_link := ext_link_prog prog.
+
+#[local] Instance AE_ext_spec : ext_spec unit := add_funspecs_rec unit ext_link (void_spec unit)
+  [(ext_link "make_atomic", SC_atomics.make_atomic_spec);
+   (ext_link "atom_exchange", SC_atomics.atomic_exchange_spec);
+   (ext_link "spawn", semax_conc.spawn_spec)].
 
 (* This lemma ties all the function proofs into a single proof for the entire program. *)
 Lemma all_funcs_correct:
-  semax_func Vprog Gprog (Genv.globalenv prog) (prog_funct prog) 
-   ltac:(old_with_library prog Gprog).
+  semax_prog prog tt Vprog Gprog.
 Proof.
-unfold prog, prog_funct, main_post, prog_vars; simpl.
-prove_semax_prog_setup_globalenv.
-repeat (eapply semax_func_cons_ext_vacuous; [reflexivity | reflexivity | LookupID | LookupB |]).
-repeat semax_func_cons_ext.
-semax_func_cons body_malloc. apply semax_func_cons_malloc_aux.
-repeat semax_func_cons_ext.
-{ unfold PROPx, LOCALx, SEPx, local, lift1, liftx, lift; simpl.
-  unfold liftx, lift; simpl.
-  Intros x; subst.
-  sep_apply lock_inv_isptr; Intros.
-  apply prop_right; unfold make_ext_rval, eval_id in *; simpl in *.
-  destruct ret; simpl in *; subst; auto. }
-{ unfold PROPx, LOCALx, SEPx, local, lift1, liftx, lift; simpl.
-  unfold liftx, lift; simpl.
-  Intros; subst.
-  apply prop_right; unfold make_ext_rval, eval_id in *; simpl in *.
-  destruct ret; simpl in *; subst; auto. }
+prove_semax_prog.
+semax_func_cons body_malloc.
+{ destruct x; apply semax_func_cons_malloc_aux. }
+semax_func_cons body_exit.
+semax_func_cons_ext.
+{ simpl; monPred.unseal; Intro p.
+  assert_PROP (isptr p); last by apply typecheck_return_value with (t := Xint16signed); auto.
+  rewrite /PROPx /LOCALx /SEPx; monPred.unseal.
+  rewrite !bi.and_elim_r.
+  rewrite bi.sep_emp; apply atomic_int_isptr. }
+semax_func_cons_ext.
+{ simpl; destruct x as ((((?, ?), ?), ?), ?); monPred.unseal; Intro i.
+  apply typecheck_return_value with (t := Xint16signed); auto. }
+semax_func_cons_ext.
 semax_func_cons body_surely_malloc.
 semax_func_cons body_memset.
 semax_func_cons body_initialize_channels.
@@ -45,12 +47,11 @@ semax_func_cons body_initialize_reader.
 semax_func_cons body_start_read.
 semax_func_cons body_finish_read.
 semax_func_cons body_initialize_writer.
-eapply semax_func_cons; [ reflexivity
-           | repeat apply Forall_cons; try apply Forall_nil; simpl; auto; computable
-           | unfold var_sizes_ok; repeat constructor; simpl; computable | reflexivity | LookupID | LookupB 
-           | apply body_start_write |].
+semax_func_cons body_start_write.
 semax_func_cons body_finish_write.
 semax_func_cons body_reader.
 semax_func_cons body_writer.
 semax_func_cons body_main.
 Qed.
+
+End mpred.
diff --git a/mailbox/verif_mailbox_init.v b/mailbox/verif_mailbox_init.v
index df45af175f..b9886e35ed 100644
--- a/mailbox/verif_mailbox_init.v
+++ b/mailbox/verif_mailbox_init.v
@@ -1,11 +1,15 @@
 Require Import mailbox.verif_atomic_exchange.
 Require Import VST.concurrency.conclib.
-Require Import VST.concurrency.ghosts.
 Require Import VST.floyd.library.
 Require Import VST.zlist.sublist.
 Require Import mailbox.mailbox.
 Require Import mailbox.verif_mailbox_specs.
 
+Section mpred.
+
+Context `{!VSTGS unit Σ, AEGS0 : !AEGS t_atom_int, !inG Σ (excl_authR (leibnizO val))}.
+Existing Instance concurrent_ext_spec.
+
 Lemma body_surely_malloc: semax_body Vprog Gprog f_surely_malloc surely_malloc_spec.
 Proof.
   start_function.
@@ -16,19 +20,16 @@ Proof.
   (PROP ( )
    LOCAL (temp _p p)
    SEP (mem_mgr gv; malloc_token Ews t p; data_at_ Ews t p)).
-*
-  if_tac.
+  * if_tac.
     subst p. entailer!.
     entailer!.
-*
-    forward_call 1.
+  * forward_call 1.
     contradiction.
-*
-    if_tac.
+  * if_tac.
     + forward. subst p. congruence.
     + Intros. forward. entailer!.
-*
-  forward. Exists p; entailer!.
+  * forward.
+    Exists p; entailer!!.
 Qed.
 
 Lemma body_memset : semax_body Vprog Gprog f_memset memset_spec.
@@ -45,17 +46,17 @@ Proof.
     pose proof Ptrofs.unsigned_range i.
     simpl. rep_lia.
   }
-  forward_for_simple_bound n (EX i : Z, PROP ()
+  forward_for_simple_bound n (∃ i : Z, PROP ()
     LOCAL (temp _p p; temp _s p; temp _c (vint c); temp _n (vptrofs (4 * n)))
     SEP (data_at sh (tarray tint n) (repeat (vint c) (Z.to_nat i) ++ repeat Vundef (Z.to_nat (n - i))) p)).
-  { rewrite Z.mul_comm, Z_div_mult by lia; auto. }
+  { rewrite -> Z.mul_comm, Z_div_mult by lia; auto. }
   { entailer!.
-    apply derives_trans with (Q := data_at_ sh (tarray tint n) p).
+    trans (data_at_ sh (tarray tint n) p).
     - rewrite !data_at__memory_block; simpl.
       assert ((4 * Z.max 0 n)%Z = sizeof t) as Hsize.
       { rewrite Z.max_r; auto; lia. }
-      setoid_rewrite Hsize; Intros; apply andp_right; [|simpl; apply derives_refl].
-      apply prop_right; match goal with H : field_compatible _ _ _ |- _ =>
+      setoid_rewrite Hsize; Intros; entailer!!.
+      match goal with H : field_compatible _ _ _ |- _ =>
         destruct H as (? & ? & ? & ? & ?) end; repeat split; simpl; auto.
       + unfold size_compatible in *; simpl.
         destruct p; try contradiction.
@@ -75,7 +76,7 @@ Proof.
     rewrite upd_init_const; [|lia].
     entailer!.
   - forward.
-    rewrite Zminus_diag, app_nil_r; apply derives_refl.
+    rewrite Zminus_diag app_nil_r; apply derives_refl.
 Qed.
 
 Opaque upto.
@@ -86,21 +87,21 @@ Proof.
 intros.
 hnf in H. destruct p; try contradiction; simpl; auto.
 Qed.
-#[export] Hint Resolve malloc_compatible_isptr : core.
+#[local] Hint Resolve malloc_compatible_isptr : core.
 
 Lemma body_initialize_channels : semax_body Vprog Gprog f_initialize_channels initialize_channels_spec.
 Proof.
   start_function.
   assert (N < Int.max_signed) as HN by computable.
   assert (B < Int.max_signed) as HB by computable.
-  forward_for_simple_bound B (EX i : Z, PROP ()
+  forward_for_simple_bound B (∃ i : Z, PROP ()
     LOCAL (gvars gv)
-    SEP (data_at_ Ews (tarray (tptr tint) N) (gv _comm); data_at_ Ews (tarray (tptr t_lock) N) (gv _lock);
+    SEP (data_at_ Ews (tarray (tptr t_atom_int) N) (gv _comm);
          data_at_ Ews (tarray (tptr tint) N) (gv _reading); data_at_ Ews (tarray (tptr tint) N) (gv _last_read);
-         EX bufs : list val, !!(Zlength bufs = i /\ Forall isptr bufs) &&
-           data_at Ews (tarray (tptr tbuffer) B) (bufs ++ repeat Vundef (Z.to_nat (B - i))) (gv _bufs) *
-           fold_right sepcon emp (map (@data_at CompSpecs Ews tbuffer (vint 0)) bufs) *
-           fold_right sepcon emp (map (malloc_token Ews tbuffer) bufs);
+         ∃ bufs : list val, ⌜Zlength bufs = i /\ Forall isptr bufs⌝ ∧
+           data_at Ews (tarray (tptr tbuffer) B) (bufs ++ repeat Vundef (Z.to_nat (B - i))) (gv _bufs) ∗
+           [∗] (map (data_at Ews tbuffer (vint 0)) bufs) ∗
+           [∗] (map (malloc_token Ews tbuffer) bufs);
           mem_mgr gv)).
   { unfold B, N; computable. }
   { entailer!.
@@ -114,15 +115,15 @@ Proof.
     forward.
     rewrite upd_init; auto; try lia.
     entailer!.
-    Exists (bufs ++ [b]); rewrite Zlength_app, <- app_assoc, !map_app, !sepcon_app, Forall_app; simpl; entailer!.
+    Exists (bufs ++ [b]); rewrite -> Zlength_app, <- app_assoc, !map_app, !big_sepL_app, Forall_app; simpl; entailer!.
     clear; unfold data_at, field_at, at_offset; Intros.
     rewrite !data_at_rec_eq; unfold withspacer; simpl.
     unfold array_pred, aggregate_pred.array_pred, unfold_reptype; simpl.
-    entailer!. clear H0.
+    rewrite Znth_0_cons; entailer!. clear H0.
     { destruct H as [? [? [? [? ?]]]].
       split; [| split; [| split; [| split]]]; auto.
       destruct b; inv H.
-      inv H2. inv H.
+      inv H2.
       specialize (H7 0 ltac:(lia)).
       simpl.
       eapply align_compatible_rec_Tstruct; [reflexivity.. |].
@@ -135,108 +136,100 @@ Proof.
       inv H7.
       inv H.
       rewrite Z.mul_0_r in H2.
-      auto. }
-      apply derives_refl. }
-  Intros bufs; rewrite Zminus_diag, app_nil_r.
-  forward_for_simple_bound N (EX i : Z, PROP ()
+      auto. } }
+  Intros bufs; rewrite Zminus_diag app_nil_r.
+  forward_for_simple_bound N (∃ i : Z, PROP ()
     LOCAL (gvars gv)
-    SEP (EX locks : list lock_handle, EX comms : list val, EX g : list gname, EX g0 : list gname, EX g1 : list gname,
-         EX g2 : list gname, !!(Zlength locks = i /\ Zlength comms = i /\ Forall isptr comms /\ Zlength g = i /\
-           Zlength g0 = i /\ Zlength g1 = i /\ Zlength g2 = i) &&
-          (data_at Ews (tarray (tptr t_lock) N) (map ptr_of locks ++ repeat Vundef (Z.to_nat (N - i))) (gv _lock) *
-           data_at Ews (tarray (tptr tint) N) (comms ++ repeat Vundef (Z.to_nat (N - i))) (gv _comm) *
-           fold_right sepcon emp (map (fun r => comm_loc Tsh (Znth r locks) (Znth r comms)
+    SEP (∃ comms : list val, ∃ g : list gname, ∃ g0 : list gname, ∃ g1 : list gname,
+         ∃ g2 : list gname, ⌜Zlength comms = i /\ (*Forall isptr comms /\*) Zlength g = i /\
+           Zlength g0 = i /\ Zlength g1 = i /\ Zlength g2 = i⌝ ∧
+          (data_at Ews (tarray (tptr t_atom_int) N) (comms ++ repeat Vundef (Z.to_nat (N - i))) (gv _comm) ∗
+           [∗] (map (fun r => comm_loc 1 (Znth r comms)
              (Znth r g) (Znth r g0) (Znth r g1) (Znth r g2) bufs
-             (Znth r shs) gsh2 empty_map) (upto (Z.to_nat i)))) *
-           fold_right sepcon emp (map (ghost_var gsh1 (vint 1)) g0) *
-           fold_right sepcon emp (map (ghost_var gsh1 (vint 0)) g1) *
-           fold_right sepcon emp (map (ghost_var gsh1 (vint 1)) g2) *
-           fold_right sepcon emp (map (malloc_token Ews tint) comms);
-         EX reads : list val, !!(Zlength reads = i) &&
-           data_at Ews (tarray (tptr tint) N) (reads ++ repeat Vundef (Z.to_nat (N - i))) (gv _reading) *
-           fold_right sepcon emp (map (data_at_ Ews tint) reads) *
-           fold_right sepcon emp (map (malloc_token Ews tint) reads);
-         EX lasts : list val, !!(Zlength lasts = i) &&
-           data_at Ews (tarray (tptr tint) N) (lasts ++ repeat Vundef (Z.to_nat (N - i))) (gv _last_read) *
-           fold_right sepcon emp (map (data_at_ Ews tint) lasts) *
-           fold_right sepcon emp (map (malloc_token Ews tint) lasts);
-         @data_at CompSpecs Ews (tarray (tptr tbuffer) B) bufs (gv _bufs);
-         EX sh : share, !!(sepalg_list.list_join sh1 (sublist i N shs) sh) &&
-           @data_at CompSpecs sh tbuffer (vint 0) (Znth 0 bufs);
-         fold_right sepcon emp (map (@data_at CompSpecs Ews tbuffer (vint 0)) (sublist 1 (Zlength bufs) bufs));
-         fold_right sepcon emp (map (malloc_token Ews tbuffer) bufs);
+             (Znth r shs) ∅) (upto (Z.to_nat i)))) ∗
+           [∗] (map (ghost_frag (vint 1)) g0) ∗
+           [∗] (map (ghost_frag (vint 0)) g1) ∗
+           [∗] (map (ghost_frag (vint 1)) g2);
+         ∃ reads : list val, ⌜Zlength reads = i⌝ ∧
+           data_at Ews (tarray (tptr tint) N) (reads ++ repeat Vundef (Z.to_nat (N - i))) (gv _reading) ∗
+           [∗] (map (data_at_ Ews tint) reads) ∗
+           [∗] (map (malloc_token Ews tint) reads);
+         ∃ lasts : list val, ⌜Zlength lasts = i⌝ ∧
+           data_at Ews (tarray (tptr tint) N) (lasts ++ repeat Vundef (Z.to_nat (N - i))) (gv _last_read) ∗
+           [∗] (map (data_at_ Ews tint) lasts) ∗
+           [∗] (map (malloc_token Ews tint) lasts);
+         data_at Ews (tarray (tptr tbuffer) B) bufs (gv _bufs);
+         ∃ sh : share, ⌜sepalg_list.list_join sh1 (sublist i N shs) sh⌝ ∧
+           data_at sh tbuffer (vint 0) (Znth 0 bufs);
+         [∗] (map (data_at Ews tbuffer (vint 0)) (sublist 1 (Zlength bufs) bufs));
+         [∗] (map (malloc_token Ews tbuffer) bufs);
          mem_mgr gv)).
-  { Exists ([] : list lock_handle) ([] : list val) ([] : list gname) ([] : list gname) ([] : list gname)
-      ([] : list gname) ([] : list val) ([] : list val) Ews; rewrite !data_at__eq; entailer!.
+  { Exists ([] : list val) ([] : list gname) ([] : list gname) ([] : list gname)
+      ([] : list gname) ([] : list val) ([] : list val) Ews. rewrite !data_at__eq. entailer!.
     - rewrite sublist_same; auto; lia.
-    - erewrite <- sublist_same with (al := bufs), sublist_next at 1; eauto; try (unfold B, N in *; lia).
-      simpl; cancel. }
-  { Intros locks comms g g0 g1 g2 reads lasts sh.
-    forward_call (tint, gv).  Intros c.
-    forward.
+    - erewrite <- sublist_same with (al := bufs), sublist_next at 1; eauto; try (unfold B, N in *; lia). }
+  { Intros comms g g0 g1 g2 reads lasts sh.
+    forward_call (vint 0). Intros c.
     forward.
     forward_call (tint, gv). Intros rr.
     forward.
-    forward_call (tint, gv).  Intros ll.
-    forward.
-    ghost_alloc (ghost_var Tsh (vint 1)).
-    ghost_alloc (ghost_var Tsh (vint 0)).
-    ghost_alloc (ghost_var Tsh (vint 1)).
-    ghost_alloc (ghost_hist_ref(hist_el := AE_hist_el) Tsh empty_map empty_map).
-    try apply ghost_hist_init. (* needed in Coq 8.16 and before *)
+    forward_call (tint, gv). Intros ll.
+    ghost_alloc (fun g => own g (●E (vint 1) ⋅ ◯E (vint 1) : excl_authR (leibnizO val))).
+    { apply excl_auth_valid. }
+    ghost_alloc (fun g => own g (●E (vint 0) ⋅ ◯E (vint 0) : excl_authR (leibnizO val))).
+    { apply excl_auth_valid. }
+    ghost_alloc (fun g => own g (●E (vint 1) ⋅ ◯E (vint 1) : excl_authR (leibnizO val))).
+    { apply excl_auth_valid. }
+    ghost_alloc (ghost_hist_ref 1 ∅ ∅).
     Intros g' g0' g1' g2'.
-    forward_call (gv, fun _ : lock_handle => AE_inv c g' (vint 0) (comm_R bufs (Znth i shs) gsh2 g0' g1' g2')).
-    Intros l.
-    rewrite <- hist_ref_join_nil by apply Share.nontrivial; Intros.
-    rewrite <- !(ghost_var_share_join gsh1 gsh2 Tsh) by auto.
+    rewrite !own_op -hist_ref_join_nil.
+    repeat match goal with |-context[own ?g (●E ?v)] => change (own g (●E v : excl_authR (leibnizO _))) with (ghost_auth v g) end.
+    repeat match goal with |-context[own ?g (◯E ?v)] => change (own g (◯E v : excl_authR (leibnizO _))) with (ghost_frag v g) end.
     match goal with H : sepalg_list.list_join sh1 (sublist i N shs) sh |- _ =>
       erewrite sublist_next in H; try lia; inversion H as [|????? Hj1 Hj2] end.
     apply sepalg.join_comm in Hj1; eapply sepalg_list.list_join_assoc1 in Hj2; eauto.
     destruct Hj2 as (sh' & ? & Hsh').
     rewrite <- (data_at_share_join (Znth i shs) sh' sh) by (apply Hsh').
     Intros.
+    gather_SEP (ghost_hist _ _ _) (ghost_ref _ _) (ghost_auth _ g0') (ghost_auth _ g1') (ghost_auth _ g2') (SC_atomics.atomic_int_at _ _ _)
+      (data_at (Znth i shs) _ _ _);
+      viewshift_SEP 0 (AE_loc 1 c g' (vint 0) (comm_R bufs (Znth i shs) g0' g1' g2') ∅).
+    { go_lowerx.
+      rewrite bi.sep_emp /AE_loc.
+      sep_apply atomic_int_isptr; Intros; rewrite bi.pure_True // bi.True_and.
+      iIntros "(? & $ & ? & ? & ? & ? & ?)"; iApply inv_alloc.
+      rewrite /AE_inv; iNext.
+      iExists [], (vint 0); iFrame.
+      iSplit; first done.
+      iExists 0, 1; simpl.
+      eauto with iFrame. }
     forward.
-    assert (0 <= i < Zlength (map ptr_of locks ++ repeat Vundef (Z.to_nat (N - i)))) as Hlen.
-    { subst; rewrite Zlength_app, Zlength_map, Zlength_repeat, Zplus_minus; auto; lia. }
-    forward.
-    { rewrite upd_Znth_same by auto; entailer!. }
-    rewrite upd_Znth_same by auto.
-    forward_call release_simple (Tsh, l, AE_inv c g' (vint 0) (comm_R bufs (Znth i shs) gsh2 g0' g1' g2')).
-    { lock_props.
-      cancel.
-      unfold AE_inv.
-      Exists (@nil AE_hist_el) (vint 0).
-      unfold comm_R at 1.
-      Exists 0 1 1; unfold last_two_reads, last_write, prev_taken; simpl.
-      rewrite !sepcon_andp_prop', !sepcon_andp_prop, !sepcon_andp_prop'; apply andp_right;
-        [apply prop_right; auto|].
-      apply andp_right; [apply prop_right; repeat (split; auto); computable|].
-      change_compspecs CompSpecs.
-      Exists 0; cancel. }
-    Exists (locks ++ [l]) (comms ++ [c]) (g ++ [g']) (g0 ++ [g0']) (g1 ++ [g1']) (g2 ++ [g2'])
-      (reads ++ [rr]) (lasts ++ [ll]) sh'; rewrite !upd_init by (rewrite ?Zlength_map in *; auto; lia).
-    rewrite !Zlength_app, !Zlength_cons, !Zlength_nil; rewrite !map_app, <- !app_assoc.
+    Exists (comms ++ [c]) (g ++ [g']) (g0 ++ [g0']) (g1 ++ [g1']) (g2 ++ [g2'])
+      (reads ++ [rr]) (lasts ++ [ll]) sh'; rewrite -> !upd_init by (rewrite -> ?Zlength_map in *; auto; lia).
+    rewrite -> !Zlength_app, !Zlength_cons, !Zlength_nil; rewrite -> !map_app, <- !app_assoc.
     go_lower.
-    apply andp_right; [apply prop_right; repeat split; auto|].
-    assert_PROP (isptr ll /\ isptr rr /\ isptr c /\ isptr (ptr_of l)) by (entailer!; eauto).
-    rewrite prop_true_andp
-      by  (rewrite ?Forall_app; repeat split; auto; try lia; repeat constructor; intuition).
-    rewrite !prop_true_andp
-      by  (rewrite ?Forall_app; repeat split; auto; try lia; repeat constructor; intuition).
-    rewrite Z2Nat.inj_add, upto_app, !map_app, !sepcon_app; try lia; simpl.
+    rewrite bi.pure_True // bi.True_and.
+    assert_PROP (isptr ll /\ isptr rr (*/\ isptr c*)) by (entailer!; eauto).
+    rewrite !bi.pure_True; [|rewrite ?Forall_app; repeat split; auto; try lia; repeat constructor; intuition..].
+    rewrite !bi.True_and.
+    rewrite -> Z2Nat.inj_add, upto_app, !map_app, !big_sepL_app; try lia; simpl.
     change (upto 1) with [0]; simpl.
-    rewrite Z2Nat.id, Z.add_0_r by lia.
-    rewrite !Znth_app1 by auto.
-    replace (Z.to_nat (N - (Zlength locks + 1))) with (Z.to_nat (N - (i + 1))) by (subst; clear; rep_lia).
-    subst; rewrite Zlength_correct, Nat2Z.id.
+    rewrite -> Z2Nat.id, Z.add_0_r by lia.
+    rewrite -> !Znth_app1 by auto.
+    subst; rewrite Zlength_correct Nat2Z.id.
     unfold comm_loc, AE_loc; cancel.
     erewrite map_ext_in; [apply derives_refl|].
-    intros; rewrite In_upto, <- Zlength_correct in *.
+    intros; rewrite -> In_upto, <- Zlength_correct in *.
     rewrite !app_Znth1; (lia || tauto). }
-  Intros locks comms g g0 g1 g2 reads lasts sh.
+  Intros comms g g0 g1 g2 reads lasts sh.
   match goal with H : sepalg_list.list_join sh1 (sublist N N shs) sh |- _ =>
     rewrite sublist_nil in H; inv H end.
   rewrite !app_nil_r.
-  Exists comms locks bufs reads lasts g g0 g1 g2.
+  Exists comms bufs reads lasts g g0 g1 g2.
+  (* cancel appears not to cancel enough because constr_eq is failing on identical
+     terms, which I don't know how to fix. *)
+  #[local] Ltac cancel_unify_tac ::= reflexivity.
   entailer!.
 Qed.
+
+End mpred.
diff --git a/mailbox/verif_mailbox_main.v b/mailbox/verif_mailbox_main.v
index 4a88c34064..b6383ce833 100644
--- a/mailbox/verif_mailbox_main.v
+++ b/mailbox/verif_mailbox_main.v
@@ -1,6 +1,5 @@
 Require Import mailbox.verif_atomic_exchange.
 Require Import VST.concurrency.conclib.
-Require Import VST.concurrency.ghosts.
 Require Import VST.floyd.library.
 Require Import VST.zlist.sublist.
 Require Import mailbox.mailbox.
@@ -8,139 +7,118 @@ Require Import mailbox.verif_mailbox_specs.
 
 Opaque upto.
 Opaque eq_dec.
+Opaque N.
 
-Lemma iter_sepcon_fold_right_sepcon:
-  forall {A} (f: A -> mpred) (al: list A), iter_sepcon f al = fold_right sepcon emp (map f al).
-Proof.
-induction al; simpl; auto.
-f_equal; auto.
-Qed.
+Section mpred.
+
+Context `{!VSTGS unit Σ, AEGS0 : !AEGS t_atom_int, !inG Σ (excl_authR (leibnizO val))}.
 
 Lemma body_main : semax_body Vprog Gprog f_main main_spec.
 Proof.
   start_function.
+  change 3 with N; change 5 with B.
   sep_apply (create_mem_mgr gv).
-  do 3 sep_apply (data_at_data_at_ Ews (tarray (tptr tint) 3)).
-  sep_apply (data_at_data_at_ Ews (tarray (tptr t_lock) 3)).
-  sep_apply (data_at_data_at_ Ews (tarray (tptr (Tstruct _buffer noattr)) 5)).
-(*  simpl readonly2share.  (* TODO: delete this line when possible *)*)
   exploit (split_shares (Z.to_nat N) Ews); auto; intros (sh0 & shs & ? & ? & ? & ?).
-  rewrite (data_at__eq _ (tarray (tptr t_lock) N)).
   forward_call (sh0, shs, gv).
-  Intros x; destruct x as ((((((((comms, locks), bufs), reads), lasts), g), g0), g1), g2).
-  assert_PROP (Zlength comms = N).
-  { go_lowerx; apply sepcon_derives_prop.
-    eapply derives_trans; [apply data_array_at_local_facts'; unfold N; lia|].
-    unfold unfold_reptype; simpl.
-    apply prop_left; intros (? & ? & ?); apply prop_right; auto. }
+  Intros x; destruct x as (((((((comms, bufs), reads), lasts), g), g0), g1), g2).
+  assert_PROP (Zlength comms = N) by entailer!.
   simpl fst in *. simpl snd in *.
-  assert_PROP (Zlength bufs = B).
-  { go_lowerx; rewrite <- !sepcon_assoc, (sepcon_comm _ (data_at _ _ _ (gv _bufs))), !sepcon_assoc.
-    apply sepcon_derives_prop.
-    eapply derives_trans; [apply data_array_at_local_facts'; unfold B, N; lia|].
-    unfold unfold_reptype; simpl.
-    apply prop_left; intros (? & ? & ?); apply prop_right; auto. }
+  assert_PROP (Zlength bufs = B) by entailer!.
   assert (exists sh2, sepalg.join sh0 sh2 Ews /\ readable_share sh2) as (sh2 & Hsh2 & Hrsh2).
   { destruct (sepalg_list.list_join_assoc1 (join_bot_eq _) H2) as (? & ? & ?).
     do 2 eexists; eauto.
     eapply readable_share_list_join; eauto.
     inv H1; auto; discriminate. }
-  forward_spawn _writer (vptrofs 0) (locks, comms, bufs, sh0, gsh1, sh0, shs, g, g0, g1, g2, gv).
-  { rewrite !sepcon_andp_prop'.
-    apply andp_right; [apply prop_right; repeat (split; auto)|].
-    erewrite (map_ext (fun r => comm_loc _ _ _ _ _ _ _ _ _ _ _));
-      [|intro; unfold comm_loc; erewrite <- AE_loc_join with (h1 := empty_map)(h2 := empty_map);
-        try apply incl_compatible; eauto; reflexivity].
-    rewrite !sepcon_map.
-    do 3 (erewrite <- (data_at_shares_join_old Ews); eauto).
-    rewrite (extract_nth_sepcon (map (data_at _ _ _) (sublist 1 _ bufs)) 0), Znth_map;
-      rewrite ?Zlength_map, ?Zlength_sublist; try (unfold B, N in *; lia).
+  assert (B > 1) by done.
+  forward_spawn _writer (vptrofs 0) (comms, bufs, sh0, (1/2)%Qp, sh0, shs, g, g0, g1, g2, gv).
+  { entailer!.
+    do 2 (erewrite <- (data_at_shares_join Ews); eauto).
+    assert ([∗] map (fun r => comm_loc 1 (Znth r comms) (Znth r g) (Znth r g0)
+            (Znth r g1) (Znth r g2) bufs (Znth r shs) ∅) (upto (Z.to_nat N)) ⊢
+       [∗] map (fun r => comm_loc (1/2) (Znth r comms) (Znth r g) (Znth r g0)
+           (Znth r g1) (Znth r g2) bufs (Znth r shs) ∅ ∗
+           comm_loc (1/2) (Znth r comms) (Znth r g) (Znth r g0)
+           (Znth r g1) (Znth r g2) bufs (Znth r shs) ∅) (upto (Z.to_nat N))) as ->.
+    { f_equiv.
+      rewrite Forall2_forall_Znth; split; first done.
+      intros i Hi; rewrite Zlength_map in Hi; rewrite !Znth_map; [|done..].
+      rewrite Zlength_upto in Hi; rewrite Znth_upto //; [|done..].
+      rewrite /comm_loc AE_loc_join frac_op Qp.half_half //. }
+    rewrite big_sep_map; cancel.
+    assert (0 <= 0%nat < Zlength (sublist 1 (Zlength bufs) bufs)).
+    { rewrite Zlength_sublist; lia. }
+    rewrite (big_sepL_insert_acc _ (map _ (sublist 1 _ bufs)) (Z.to_nat O)).
+    2: { apply Znth_lookup; rewrite Zlength_map //. }
+    rewrite Znth_map; last done.
     erewrite <- (data_at_shares_join Ews tbuffer) by eauto.
-    rewrite (sepcon_comm (data_at sh0 _ _ (Znth 0 (sublist _ _ bufs)))),
-      (sepcon_assoc _ (data_at sh0 _ _ (Znth 0 (sublist _ _ bufs)))).
-    rewrite replace_nth_sepcon. 2 : {
-      rewrite Zlength_map.
-      rewrite Zlength_sublist; unfold B, N in *; lia.
-    }
-    unfold comm_loc; cancel.
-    rewrite (sepcon_comm _ (fold_right sepcon emp (upd_Znth 0 _ _))), !sepcon_assoc.
-    rewrite <- !sepcon_assoc, (sepcon_comm _ (data_at sh0 tbuffer _ _)), !sepcon_assoc.
-    rewrite <- sepcon_assoc; apply sepcon_derives; [|cancel].
-    assert (Zlength (data_at sh0 tbuffer (vint 0) (Znth 0 bufs)
-         :: upd_Znth 0 (map (data_at Ews tbuffer (vint 0)) (sublist 1 (Zlength bufs) bufs))
-              (data_at sh0 tbuffer (vint 0) (Znth 0 (sublist 1 (Zlength bufs) bufs)))) = B) as Hlen.
-    { rewrite Zlength_cons, upd_Znth_Zlength; rewrite Zlength_map, Zlength_sublist, ?Zlength_upto;
-        simpl; unfold B, N in *; lia. }
-    apply sepcon_list_derives with (l1 := _ :: _).
-    { rewrite Zlength_map; auto. }
-    intros; rewrite Hlen in *.
-    erewrite Znth_map, Znth_upto; rewrite ?Zlength_upto; auto; simpl; try (unfold B, N in *; lia).
-    destruct (eq_dec i 0); [|destruct (eq_dec i 1)].
-    - subst; rewrite Znth_0_cons.
-      Exists sh0 0; entailer'.
-    - subst; rewrite Znth_pos_cons, Zminus_diag, upd_Znth_same; rewrite ?Zlength_map, ?Zlength_sublist; try lia.
-      rewrite Znth_sublist; try lia.
-      Exists sh0 0; entailer'.
-    - rewrite Znth_pos_cons, upd_Znth_diff; rewrite ?Zlength_map, ?Zlength_sublist; try lia.
-      erewrite Znth_map; [|rewrite Zlength_sublist; lia].
-      rewrite Znth_sublist; try lia.
-      rewrite Z.sub_simpl_r.
-      Exists Ews 0; entailer'. }
-  rewrite Znth_sublist; try (unfold B, N in *; lia).
+    iIntros "(? & ? & ? & ? & ? & ? & ? & ? & ? & H0 & ((H1 & ?) & Hrest) & ?)";
+      iSplitL "H0 H1 Hrest"; last by iStopProof; cancel.
+    iSpecialize ("Hrest" with "H1").
+    change (upto (Z.to_nat B)) with (0 :: map Z.succ (upto (Z.to_nat (B - 1)))); simpl map.
+    iSplitL "H0"; first eauto.
+    iStopProof; f_equiv.
+    rewrite list_insert_upd; last rewrite Zlength_map //.
+    rewrite Forall2_forall_Znth Zlength_upd_Znth !Zlength_map Zlength_upto Zlength_sublist; [|lia..].
+    split; first lia.
+    intros i Hi; rewrite !Znth_map; [|rewrite ?Zlength_map ?Zlength_upto; lia..].
+    rewrite Znth_upto; [|lia].
+    destruct (eq_dec (Z.succ i) 0); first lia.
+    destruct (eq_dec i 0).
+    - subst; rewrite upd_Znth_same; last by rewrite Zlength_map.
+      if_tac; last done.
+      rewrite Znth_sublist; [|lia..].
+      Exists sh0 0; entailer!.
+    - rewrite upd_Znth_diff; [|rewrite ?Zlength_map ?Zlength_sublist; lia..].
+      rewrite Znth_map; [|rewrite Zlength_sublist; lia].
+      rewrite Znth_sublist; [|lia..].
+      Exists Ews 0; entailer!.
+      if_tac; auto; lia. }
+  rewrite Znth_sublist; [|lia..].
   rewrite <- seq_assoc.
   assert_PROP (Zlength reads = N) by entailer!.
   assert_PROP (Zlength lasts = N) by entailer!.
-  forward_for_simple_bound N (EX i : Z, PROP ( )
+  forward_for_simple_bound N (∃ i : Z, PROP ( )
    LOCAL (gvars gv)
-   SEP (EX sh' : share, !!(sepalg_list.list_join sh0 (sublist i N shs) sh') &&
-          data_at sh' (tarray (tptr tint) N) lasts (gv _last_read) * data_at sh' (tarray (tptr tint) N) reads (gv _reading);
-        fold_right sepcon emp (map (fun sh => data_at sh (tarray (tptr tint) N) comms (gv _comm)) (sublist i N shs));
-        fold_right sepcon emp (map (fun sh => data_at sh (tarray (tptr t_lock) N) (map ptr_of locks) (gv _lock)) (sublist i N shs));
-        fold_right sepcon emp (map (fun sh => data_at sh (tarray (tptr tbuffer) B) bufs (gv _bufs)) (sublist i N shs));
-        fold_right sepcon emp (map (fun x => comm_loc gsh2 (Znth x locks) (Znth x comms)
-          (Znth x g) (Znth x g0) (Znth x g1) (Znth x g2) bufs (Znth x shs) gsh2
-          empty_map) (sublist i N (upto (Z.to_nat N))));
-        fold_right sepcon emp (map (ghost_var gsh1 (vint 1)) (sublist i N g0));
-        fold_right sepcon emp (map (data_at_ Ews tint) (sublist i N reads));
-        fold_right sepcon emp (map (data_at_ Ews tint) (sublist i N lasts));
-        fold_right sepcon emp (map (malloc_token Ews tint) comms);
-        fold_right sepcon emp (map (malloc_token Ews tbuffer) bufs);
-        fold_right sepcon emp (map (malloc_token Ews tint) reads);
-        fold_right sepcon emp (map (malloc_token Ews tint) lasts);
-        fold_right sepcon emp (map (fun sh => @data_at CompSpecs sh tbuffer (vint 0) (Znth 1 bufs)) (sublist i N shs));
+   SEP (∃ sh' : share, ⌜sepalg_list.list_join sh0 (sublist i N shs) sh'⌝ ∧
+          data_at sh' (tarray (tptr tint) N) lasts (gv _last_read) ∗ data_at sh' (tarray (tptr tint) N) reads (gv _reading);
+        [∗ list] sh ∈ sublist i N shs, data_at sh (tarray (tptr t_atom_int) N) comms (gv _comm);
+        [∗ list] sh ∈ sublist i N shs, data_at sh (tarray (tptr tbuffer) B) bufs (gv _bufs);
+        [∗] (map (fun x => comm_loc (1/2) (Znth x comms)
+          (Znth x g) (Znth x g0) (Znth x g1) (Znth x g2) bufs (Znth x shs) ∅) (sublist i N (upto (Z.to_nat N))));
+        [∗] (map (ghost_frag (vint 1)) (sublist i N g0));
+        [∗] (map (data_at_ Ews tint) (sublist i N reads));
+        [∗] (map (data_at_ Ews tint) (sublist i N lasts));
+        [∗] (map (malloc_token Ews tbuffer) bufs);
+        [∗] (map (malloc_token Ews tint) reads);
+        [∗] (map (malloc_token Ews tint) lasts);
+        [∗ list] sh ∈ sublist i N shs, data_at sh tbuffer (vint 0) (Znth 1 bufs);
         mem_mgr gv; has_ext tt)).
-  { unfold N; computable. }
-  { Exists Ews; rewrite !sublist_same; auto; unfold N.
-  rewrite iter_sepcon_fold_right_sepcon.
+  { done. }
+  { Exists Ews; rewrite !sublist_same; auto.
     entailer!. apply derives_refl. }
-  { Intros sh'.
-    forward_call (tint, gv). Intros d.
-    forward.
-    match goal with H : sepalg_list.list_join sh0 _ sh' |- _ => rewrite sublist_next in H;
-      auto; [inversion H as [|????? Hj1 Hj2]; subst |
-      match goal with H : Zlength shs = _ |- _ => setoid_rewrite H; rewrite Z2Nat.id; lia end] end.
-    apply sepalg.join_comm in Hj1; destruct (sepalg_list.list_join_assoc1 Hj1 Hj2) as (sh1' & ? & Hj').
-    assert_PROP (isptr d) by entailer!.
-    forward_spawn _reader d (i, reads, lasts, locks, comms,
-      bufs, Znth i shs, gsh2, Znth i shs, Znth i g, Znth i g0, Znth i g1, Znth i g2, gv).
-    - rewrite !sepcon_andp_prop'.
-      apply andp_right; [apply prop_right; repeat (split; auto)|].
-      { apply Forall_Znth; auto; match goal with H : Zlength shs = _ |- _ => setoid_rewrite H; auto end. }
-      { apply Forall_Znth; auto; match goal with H : Zlength shs = _ |- _ => setoid_rewrite H; auto end. }
-      { apply Forall_Znth; auto; match goal with H : Zlength comms = _ |- _ => setoid_rewrite H; auto end. }
-      rewrite <- !(data_at_share_join _ _ _ _ _ _ Hj').
-      rewrite (@sublist_next Share.t _ i); auto;
-        [simpl | match goal with H : Zlength shs = _ |- _ => setoid_rewrite H; rewrite Z2Nat.id; lia end].
-      simpl in *; rewrite !(@sublist_next val _ i); auto; try lia; simpl;
-        try (unfold N in *; lia).
-      simpl in *; rewrite !(@sublist_next gname _ i); auto; try lia; simpl;
-        try (unfold N in *; lia).
-      rewrite (@sublist_next Z N i); rewrite ?Znth_upto; auto; rewrite? Zlength_upto; simpl;
-        try (unfold N in *; lia).
-      Exists 0; cancel.
-    - (* Why didn't forward_call_dep discharge this? *) apply isptr_is_pointer_or_null; auto.
-    - Exists sh1'; entailer!. simpl; cancel. }
-    forward_loop (PROP()LOCAL()(SEP(TT))) break: (@FF (environ->mpred) _).
-    entailer!.
-    forward. entailer!.
+  Intros sh'.
+  forward_call (tint, gv). Intros d.
+  forward.
+  match goal with H : sepalg_list.list_join sh0 _ sh' |- _ => rewrite sublist_next in H;
+    auto; [inversion H as [|????? Hj1 Hj2]; subst |
+    match goal with H : Zlength shs = _ |- _ => setoid_rewrite H; rewrite Z2Nat.id; lia end] end.
+  apply sepalg.join_comm in Hj1; destruct (sepalg_list.list_join_assoc1 Hj1 Hj2) as (sh1' & ? & Hj').
+  assert_PROP (isptr d) by entailer!.
+  forward_spawn _reader d (i, reads, lasts, comms,
+    bufs, Znth i shs, (1/2)%Qp, Znth i shs, Znth i g, Znth i g0, Znth i g1, Znth i g2, gv).
+  - entailer!!.
+    { split; apply Forall_Znth; auto; lia. }
+    rewrite <- !(data_at_share_join _ _ _ _ _ _ Hj').
+    rewrite (@sublist_next Share.t _ i); auto;
+      [|match goal with H : Zlength shs = _ |- _ => setoid_rewrite H; rewrite Z2Nat.id; lia end].
+    rewrite !(@sublist_next val _ i); [|lia..].
+    rewrite !(@sublist_next gname _ i); [|lia..].
+    rewrite (@sublist_next Z N i); rewrite ?Znth_upto; auto; rewrite ?Zlength_upto //.
+    Exists 0; simpl; cancel.
+  - (* Why didn't forward_call discharge this? *) apply isptr_is_pointer_or_null; auto.
+  - Exists sh1'; entailer!. simpl; cancel.
+  - forward_loop (True : assert) break: (False : assert); auto.
+    forward. done.
 Qed.
+
+End mpred.
diff --git a/mailbox/verif_mailbox_read.v b/mailbox/verif_mailbox_read.v
index a0eee8ed27..49c66ddcdb 100644
--- a/mailbox/verif_mailbox_read.v
+++ b/mailbox/verif_mailbox_read.v
@@ -1,6 +1,5 @@
 Require Import mailbox.verif_atomic_exchange.
 Require Import VST.concurrency.conclib.
-Require Import VST.concurrency.ghosts.
 Require Import VST.floyd.library.
 Require Import VST.zlist.sublist.
 Require Import mailbox.mailbox.
@@ -8,6 +7,10 @@ Require Import mailbox.verif_mailbox_specs.
 
 Opaque eq_dec.
 
+Section mpred.
+
+Context `{!VSTGS unit Σ, AEGS0 : !AEGS t_atom_int, !inG Σ (excl_authR (leibnizO val))}.
+
 Lemma body_initialize_reader : semax_body Vprog Gprog f_initialize_reader initialize_reader_spec.
 Proof.
   start_function.
@@ -15,7 +18,7 @@ Proof.
   assert_PROP (Zlength reads = N) by entailer!.
   assert (0 <= r < N) as Hr.
   { exploit (Znth_inbounds r reads); [|lia].
-    intro Heq; rewrite Heq in *; contradiction. }
+    intro Heq; rewrite -> Heq in *; contradiction. }
   assert (N < Int.max_signed) by computable.
   forward.
   forward.
@@ -31,62 +34,51 @@ Proof.
   assert_PROP (Zlength reads = N) by entailer!.
   assert (0 <= r < N) as Hr.
   { exploit (Znth_inbounds r reads); [|lia].
-    intro Heq; rewrite Heq in *; contradiction. }
+    intro Heq; rewrite -> Heq in *; contradiction. }
   assert (N < Int.max_signed) by computable.
+  sep_apply comm_loc_isptr; Intros.
   forward.
-  rewrite comm_loc_isptr; Intros.
-  forward.
-  { entailer!. rewrite Znth_map; [auto|]. rewrite Zlength_map in *; simpl in *; lia. }
   forward.
   forward.
   set (c := Znth r comms).
-  set (l := Znth r locks).
-  forward_call (sh2, c, g, l, vint 0, Empty, h,
-    fun h b => !!(b = Empty /\ latest_read h (vint b0)) &&
-      (EX v : Z, data_at sh tbuffer (vint v) (Znth b0 bufs)) * ghost_var gsh1 (vint b0) g0,
-    comm_R bufs sh gsh2 g0 g1 g2, fun h b => EX b' : Z, !!((if eq_dec b Empty then b' = b0 else b = vint b') /\
-      -1 <= b' < B /\ latest_read h (vint b')) &&
-      (EX v : Z, data_at sh tbuffer (vint v) (Znth b' bufs)) * ghost_var gsh1 (vint b') g0).
-  { entailer!. rewrite Znth_map; rewrite Zlength_map in *; auto; lia. }
+  forward_call AE_sub (sh2, c, g, vint 0, Empty, h,
+    fun h b => ⌜b = Empty /\ latest_read h (vint b0)⌝ ∧
+      (∃ v : Z, data_at sh tbuffer (vint v) (Znth b0 bufs)) ∗ ghost_frag (vint b0) g0,
+    comm_R bufs sh g0 g1 g2, fun h b => ∃ b' : Z, ⌜(if eq_dec b Empty then b' = b0 else b = vint b') /\
+      -1 <= b' < B /\ latest_read h (vint b')⌝ ∧
+      (∃ v : Z, data_at sh tbuffer (vint v) (Znth b' bufs)) ∗ ghost_frag (vint b') g0).
   { unfold comm_loc; entailer!.
-    rewrite <- emp_sepcon at 1; apply sepcon_derives; [|cancel].
-    unfold AE_spec.
-    apply allp_right; intro hc.
-    apply allp_right; intro hx.
-    apply allp_right; intro vc.
-    apply allp_right; intro vx.
-    rewrite <- imp_andp_adjoint; Intros.
-    rewrite <- wand_sepcon_adjoint, emp_sepcon; Intros.
-    unfold comm_R at 1 2.
-    rewrite !rev_app_distr; simpl.
-    rewrite !last_two_reads_cons, prev_taken_cons.
+    rewrite <- bi.emp_sep at 1; apply bi.sep_mono; last cancel.
+    rewrite /AE_spec -sep_exist_r.
+    iIntros "_" (???? (? & ? & Hincl)) "(>comm & (% & %) & buf & g0)".
+    rewrite /comm_R.
+    rewrite !rev_app_distr /= !last_two_reads_cons prev_taken_cons.
     unfold last_write in *; simpl in *.
     pose proof (last_two_reads_fst (rev hx)).
-    Intros b b1 b2.
-    assert (last_two_reads (rev hx) = (vint b1, vint b2)) as Hlast by assumption.
-    rewrite <- sepcon_assoc, sepcon_comm, <- !sepcon_assoc, 3sepcon_assoc.
-    erewrite ghost_var_share_join' by eauto; Intros.
-    eapply derives_trans; [apply sepcon_derives, derives_refl;
-      apply ghost_var_update with (v' := vint (if eq_dec (vint b) Empty then b0 else b))|].
-    eapply derives_trans, bupd_mono; [apply bupd_frame_r|].
+    iDestruct "comm" as (???) "(%Hcomm & a0 & a1 & a2 & buf')".
+    destruct Hcomm as (-> & ? & Hhx & Hlast & ? & ?).
+    iMod (ghost_var_update _ _ _ (vint (if eq_dec (vint b) Empty then b0 else b)) with "a0 g0") as "(%Heq & a0 & g0)".
     assert (repable_signed b0) by (apply repable_buf; lia).
-    assert (b1 = b0) by (apply repr_inj_signed; auto); subst.
+    assert (b1 = b0) as -> by (apply repr_inj_signed; auto; congruence).
     lapply (repable_buf b); auto; intro.
     rewrite Hlast.
-    erewrite <- ghost_var_share_join by eauto.
-    Exists (-1) (if eq_dec (vint b) Empty then b0 else b)
-      (if eq_dec (vint b) Empty then b2 else b0); entailer!.
+    iIntros "!>". rewrite -bi.later_intro.
+    rewrite sep_exist_r; iExists (-1).
+    rewrite sep_exist_r; iExists (if eq_dec (vint b) Empty then b0 else b).
+    rewrite sep_exist_r; iExists (if eq_dec (vint b) Empty then b2 else b0).
+    iStopProof; entailer!.
     { split; [rewrite Forall_app; repeat constructor; auto|].
       { exists b, (-1); split; [|split]; auto; lia. }
-      rewrite eq_dec_refl.
+      split; last by if_tac.
+      if_tac; last done.
       if_tac; auto. }
-    rewrite !eq_dec_refl.
-    Exists (if eq_dec (vint b) Empty then b0 else b).
-    rewrite <- exp_sepcon2; cancel.
-    lapply (hist_incl_lt hc hx); auto; intro.
+    rewrite -!bi.sep_exist_l -!sep_exist_r.
+    setoid_rewrite (if_true (Empty = Empty)); [|done..].
+    Exists (if eq_dec (vint b) Empty then b0 else b); cancel.
+    apply hist_incl_lt in Hincl; last done.
     destruct (eq_dec (vint b) Empty).
     - assert (b = -1) by (apply Empty_inj; auto; apply repable_buf; auto).
-      subst; rewrite eq_dec_refl; entailer!.
+      rewrite if_true //; entailer!.
       rewrite latest_read_Empty; auto.
     - destruct (eq_dec b (-1)); [subst; contradiction n; auto|].
       entailer!.
@@ -94,12 +86,12 @@ Proof.
   Intros x b'; destruct x as (t, v). simpl fst in *; simpl snd in *.
   assert (exists b, v = vint b /\ -1 <= b < B /\ if eq_dec b (-1) then b' = b0 else b' = b) as (b & ? & ? & ?).
   { destruct (eq_dec v Empty); subst.
-    - exists (-1); rewrite eq_dec_refl; split; auto; lia.
+    - exists (-1); if_tac; last done; split; auto; lia.
     - do 2 eexists; eauto; split; [lia|].
       destruct (eq_dec b' (-1)); [subst; contradiction n; auto | auto]. }
   exploit repable_buf; eauto; intro; subst.
   forward_if (temp _t'2 (bool2val (negb (eq_dec b (-1))))).
-  { if_tac in H13; try lia.
+  { destruct (eq_dec b (-1)); try lia; subst.
     forward.
     entailer!!.
     destruct (zlt _ _); auto.
@@ -109,31 +101,30 @@ Proof.
     entailer!!. }
   forward_if (PROP () LOCAL (temp _b (vint (if eq_dec b (-1) then b0 else b)); temp _rr (Znth r reads);
       temp _r (vint r); gvars gv)
-    SEP (comm_loc sh2 l c g g0 g1 g2 bufs sh gsh2 (map_upd h t (AE (vint b) Empty));
-         EX v : Z, data_at sh tbuffer (vint v) (Znth (if eq_dec b (-1) then b0 else b) bufs);
-         ghost_var gsh1 (vint b') g0;
+    SEP (comm_loc sh2 c g g0 g1 g2 bufs sh (<[t := Excl (AE (vint b) Empty)]>h);
+         ∃ v : Z, data_at sh tbuffer (vint v) (Znth (if eq_dec b (-1) then b0 else b) bufs);
+         ghost_frag (vint b') g0;
          data_at sh1 (tarray (tptr tint) N) reads (gv _reading); data_at sh1 (tarray (tptr tint) N) lasts (gv _last_read);
          data_at_ Ews tint (Znth r reads);
          data_at Ews tint (vint (if eq_dec b (-1) then b0 else b)) (Znth r lasts);
-         data_at sh1 (tarray (tptr tint) N) comms (gv _comm);
-         data_at sh1 (tarray (tptr t_lock) N) (map ptr_of locks) (gv _lock))).
-  -
-    forward. if_tac; inv H11.
+         data_at sh1 (tarray (tptr t_atom_int) N) comms (gv _comm))).
+  - forward.
+    destruct (eq_dec b (-1)); try done.
     entailer!!.
-  - forward. if_tac; inv H11.
+  - forward.
+    destruct (eq_dec b (-1)); try done.
     entailer!!.
   - forward.
     forward.
     Exists (if eq_dec b (-1) then b0 else b) t (vint b) v.
-    apply andp_right.
-    { apply prop_right.
-      split; [destruct (eq_dec b (-1)); auto; lia|].
+    entailer!!.
+    { split; [destruct (eq_dec b (-1)); auto; lia|].
       destruct (eq_dec (vint b) Empty).
       + assert (b = -1) by (apply Empty_inj; auto).
-        subst; rewrite eq_dec_refl; auto.
+        if_tac; try done; subst; auto.
       + destruct (eq_dec b (-1)); [subst; contradiction n; auto|].
-        split; auto; split; auto; apply latest_read_new; auto. }
-    subst c l; cancel.
+        split; auto; apply latest_read_new; auto. }
+    subst c; cancel.
     destruct (eq_dec b (-1)); subst; apply derives_refl.
 Qed.
 
@@ -144,9 +135,11 @@ Proof.
   assert_PROP (Zlength reads = N) by entailer!.
   assert (0 <= r < N) as Hr.
   { exploit (Znth_inbounds r reads); [|lia].
-    intro Heq; rewrite Heq in *; contradiction. }
+    intro Heq; rewrite -> Heq in *; contradiction. }
   assert (N < Int.max_signed) by computable.
   forward.
   forward.
   entailer!.
 Qed.
+
+End mpred.
diff --git a/mailbox/verif_mailbox_reader.v b/mailbox/verif_mailbox_reader.v
index 68700cd225..927da58682 100644
--- a/mailbox/verif_mailbox_reader.v
+++ b/mailbox/verif_mailbox_reader.v
@@ -1,6 +1,5 @@
 Require Import mailbox.verif_atomic_exchange.
 Require Import VST.concurrency.conclib.
-Require Import VST.concurrency.ghosts.
 Require Import VST.floyd.library.
 Require Import VST.zlist.sublist.
 Require Import mailbox.mailbox.
@@ -9,6 +8,10 @@ Require Import mailbox.verif_mailbox_specs.
 Ltac entailer_for_load_tac ::= unfold tc_efield; go_lower; entailer'.
 Ltac entailer_for_store_tac ::= unfold tc_efield; go_lower; entailer'.
 
+Section mpred.
+
+Context `{!VSTGS unit Σ, AEGS0 : !AEGS t_atom_int, !inG Σ (excl_authR (leibnizO val))}.
+
 Lemma body_reader : semax_body Vprog Gprog f_reader reader_spec.
 Proof.
   start_function.
@@ -20,24 +23,22 @@ Proof.
   forward_call (r, reads, lasts, sh1, gv).
 (*  eapply semax_seq'; [|apply semax_ff]. *)
   set (c := Znth r comms).
-  set (l := Znth r locks).
-  forward_loop (EX b0 : Z, EX h : hist, PROP (0 <= b0 < B; latest_read h (vint b0))
+  forward_loop (∃ b0 : Z, ∃ h : hist, PROP (0 <= b0 < B; latest_read h (vint b0))
     LOCAL (temp _r (vint r); temp _arg arg; gvars gv)
     SEP (data_at sh1 (tarray (tptr tint) N) reads (gv _reading); data_at sh1 (tarray (tptr tint) N) lasts (gv _last_read);
          data_at Ews tint Empty (Znth r reads); data_at Ews tint (vint b0) (Znth r lasts);
          data_at Ews tint (vint r) (force_val (sem_cast_pointer arg)); malloc_token Ews tint arg;
-         data_at sh1 (tarray (tptr tint) N) comms (gv _comm);
-         data_at sh1 (tarray (tptr t_lock) N) (map ptr_of locks) (gv _lock);
+         data_at sh1 (tarray (tptr t_atom_int) N) comms (gv _comm);
          data_at sh1 (tarray (tptr tbuffer) B) bufs (gv _bufs);
-         comm_loc sh2 l c g g0 g1 g2 bufs sh gsh2 h;
-         EX v : Z, @data_at CompSpecs sh tbuffer (vint v) (Znth b0 bufs);
-         ghost_var gsh1 (vint b0) g0))
-  break: (@FF (environ->mpred) _).
-  { Exists 1 (empty_map : hist); entailer!.
+         comm_loc sh2 c g g0 g1 g2 bufs sh h;
+         ∃ v : Z, data_at sh tbuffer (vint v) (Znth b0 bufs);
+         ghost_frag (vint b0) g0))
+  break: (False : assert).
+  { Exists 1 (∅ : hist); entailer!.
     unfold latest_read.
     left; split; auto; discriminate. }
   Intros b0 h.
-  subst c l; subst; forward_call (r, reads, lasts, locks, comms, bufs,
+  subst c; subst; forward_call (r, reads, lasts, comms, bufs,
     sh, sh1, sh2, b0, g, g0, g1, g2, h, gv).
   Intros x; destruct x as (((b, t), e), v); cbv [fst snd] in *.
   rewrite (data_at_isptr _ tbuffer); Intros.
@@ -45,5 +46,7 @@ Proof.
   forward.
   forward_call (r, reads, sh1, gv).
   entailer!.
-  Exists b (map_upd h t (AE e Empty)) v; entailer!.
+  Exists b (<[t := Excl (AE e Empty)]>h) v; entailer!.
 Qed.
+
+End mpred.
diff --git a/mailbox/verif_mailbox_specs.v b/mailbox/verif_mailbox_specs.v
index 4ccd0d7f22..5aaa060c29 100644
--- a/mailbox/verif_mailbox_specs.v
+++ b/mailbox/verif_mailbox_specs.v
@@ -1,28 +1,62 @@
-Require Import mailbox.verif_atomic_exchange.
 Require Import VST.concurrency.conclib.
-Require Import VST.concurrency.ghosts.
+Require Import VST.atomics.SC_atomics.
 Require Import VST.floyd.library.
+Require Import mailbox.verif_atomic_exchange.
+Require Import iris_ora.algebra.excl_auth.
 Require Import VST.zlist.sublist.
-Require Export VST.concurrency.lock_specs.
-Require Export VST.atomics.verif_lock.
 Require Import mailbox.mailbox.
-Require Import Lia.
-Open Scope funspec_scope.
 
 (* standard VST prelude *)
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
-#[export] Instance CompSpecs_Preserve: change_composite_env verif_atomic_exchange.CompSpecs CompSpecs.
-  make_cs_preserve verif_atomic_exchange.CompSpecs CompSpecs.
-Defined.
-#[export] Instance CompSpecs_Preserve': change_composite_env CompSpecs verif_atomic_exchange.CompSpecs.
-  make_cs_preserve CompSpecs verif_atomic_exchange.CompSpecs.
-Defined.
 
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
-(* import concurrency funspecs *)
+Definition t_atom_int := Tstruct _atom_int noattr.
+
+Open Scope Z.
+
+Definition Ish := Share.comp Ews.
+
+Lemma Ews_Ish_join : sepalg.join Ews Ish Tsh.
+Proof.
+  apply comp_join_top.
+Qed.
+
+Lemma Ish_not_bot : Ish <> Share.bot.
+Proof.
+  intro.
+  generalize Ews_Ish_join; rewrite H.
+  intro X; eapply sepalg.join_eq in X; [|apply join_bot_eq].
+  generalize juicy_mem.perm_of_Ews; rewrite X.
+  unfold juicy_mem.perm_of_sh.
+  rewrite -> if_true by auto.
+  rewrite -> if_true by auto; discriminate.
+Qed.
+#[export] Hint Resolve Ish_not_bot : core.
+
+Section mpred.
+
+Context `{!VSTGS unit Σ, AEGS0 : !AEGS t_atom_int, !inG Σ (excl_authR (leibnizO val))}.
+
+Definition make_atomic_spec := DECLARE _make_atomic make_atomic_spec.
+Definition atomic_exchange_spec := DECLARE _atom_exchange SC_atomics.atomic_exchange_spec.
 Definition spawn_spec := DECLARE _spawn spawn_spec.
 
+(* up *)
+Lemma list_insert_upd : forall {A} i (a : A) l, 0 <= i < Zlength l ->
+  <[Z.to_nat i := a]>l = upd_Znth i l a.
+Proof.
+  intros; generalize dependent i; induction l; simpl; intros.
+  - rewrite Zlength_nil in H; lia.
+  - rewrite Zlength_cons in H.
+    destruct (Z.to_nat i) eqn: Hi; simpl.
+    + assert (i = 0) as -> by lia.
+      rewrite upd_Znth0 //.
+    + rewrite upd_Znth_cons; last lia.
+      rewrite -IHl; last lia.
+      replace n with (Z.to_nat (i - 1)) by lia; done.
+Qed.
+
 (* utility function specs *)
 Definition surely_malloc_spec :=
   DECLARE _surely_malloc
@@ -33,10 +67,10 @@ Definition surely_malloc_spec :=
                 natural_aligned natural_alignment t = true)
        PARAMS (Vptrofs (Ptrofs.repr (sizeof t))) GLOBALS (gv)
        SEP (mem_mgr gv)
-    POST [ tptr tvoid ] EX p:_,
+    POST [ tptr tvoid ] ∃ p:_,
        PROP ()
        LOCAL (temp ret_temp p)
-       SEP (mem_mgr gv; malloc_token Ews t p * data_at_ Ews t p).
+       SEP (mem_mgr gv; malloc_token Ews t p ∗ data_at_ Ews t p).
 
 Definition memset_spec :=
  DECLARE _memset
@@ -57,8 +91,6 @@ Definition tbuffer := Tstruct _buffer noattr.
 
 Definition Empty := vint (-1).
 
-Opaque eq_dec.
-
 (* operations on histories *)
 Fixpoint find_read h d :=
   match h with
@@ -79,40 +111,55 @@ Definition prev_taken h := fst (find_read (snd (find_write h (vint 0))) (vint 1)
 
 Definition last_write h := fst (find_write h (vint 0)).
 
+Definition ghost_auth (v : val) (g : gname) : mpred := own g (●E v : excl_authR (leibnizO val)).
+Definition ghost_frag (v : val) (g : gname) : mpred := own g (◯E v : excl_authR (leibnizO val)).
+
+Lemma ghost_var_update : forall g v1 v2 v', ghost_auth v1 g -∗ ghost_frag v2 g ==∗
+  ⌜v1 = v2⌝ ∧ (ghost_auth v' g ∗ ghost_frag v' g).
+Proof.
+  intros; iIntros "auth frag".
+  iDestruct (own_valid_2 with "auth frag") as %->%excl_auth_agree_L; rewrite bi.pure_True // bi.True_and.
+  rewrite /ghost_auth /ghost_frag; iCombine "auth frag" as "H"; rewrite -!own_op.
+  iApply (own_update with "H").
+  apply @excl_auth_update.
+Qed.
+
 (* This is the invariant for the location buffers comm[N]. *)
 (* The ghost variables are the last value read, the last value written, and the last value read before
    the last write (i.e., last_taken). The first is updated by the reader, the rest by the writer. *)
-Definition comm_R bufs sh gsh g0 g1 g2 h v := EX b : Z, EX b1 : Z, EX b2 : Z,
-  !!(v = vint b /\ -1 <= b < B /\
+Definition comm_R bufs sh g0 g1 g2 h v := ∃ b : Z, ∃ b1 : Z, ∃ b2 : Z,
+  ⌜v = vint b /\ -1 <= b < B /\
      Forall (fun a => match a with AE v1 v2 =>
        exists r w, v1 = vint r /\ v2 = vint w /\ -1 <= r < B /\ -1 <= w < B end) h /\
-     last_two_reads (rev h) = (vint b1, vint b2) /\ repable_signed b1 /\ repable_signed b2) &&
-  ghost_var gsh (vint b1) g0 * ghost_var gsh (last_write (rev h)) g1 *
-  ghost_var gsh (prev_taken (rev h)) g2 *
-  if eq_dec b (-1) then EX v : Z, data_at sh tbuffer (vint v) (Znth b2 bufs)
-  else EX v : Z, data_at sh tbuffer (vint v) (Znth b bufs).
-
-Definition comm_loc lsh lock comm g g0 g1 g2 bufs sh gsh :=
-  AE_loc lsh lock comm g (vint 0) (comm_R bufs sh gsh g0 g1 g2).
+     last_two_reads (rev h) = (vint b1, vint b2) /\ repable_signed b1 /\ repable_signed b2⌝ ∧
+  ghost_auth (vint b1) g0 ∗ ghost_auth (last_write (rev h)) g1 ∗ ghost_auth (prev_taken (rev h)) g2 ∗
+  if eq_dec b (-1) then ∃ v : Z, data_at sh tbuffer (vint v) (Znth b2 bufs)
+  else ∃ v : Z, data_at sh tbuffer (vint v) (Znth b bufs).
 
-Definition Ish := Share.comp Ews.
+#[export] Instance data_at_buffer_timeless sh v p : Timeless (data_at sh tbuffer v p).
+Proof.
+  apply bi.and_timeless; first apply _.
+  rewrite /at_offset data_at_rec_eq /withspacer /=.
+  apply _.
+Qed.
 
-Lemma Ews_Ish_join : sepalg.join Ews Ish Tsh.
+#[export] Instance comm_R_timeless bufs sh g0 g1 g2 h v : Timeless (comm_R bufs sh g0 g1 g2 h v).
 Proof.
-  apply comp_join_top.
+  rewrite /comm_R.
+  repeat (apply bi.exist_timeless; intros).
+  apply bi.and_timeless; first apply _.
+  repeat (apply bi.sep_timeless; first apply _).
+  if_tac; apply _.
 Qed.
 
-Lemma Ish_not_bot : Ish <> Share.bot.
+Definition comm_loc lsh comm g g0 g1 g2 bufs sh :=
+  AE_loc lsh comm g (vint 0) (comm_R bufs sh g0 g1 g2).
+
+Lemma comm_loc_isptr : forall lsh comm g g0 g1 g2 bufs sh h,
+  comm_loc lsh comm g g0 g1 g2 bufs sh h ⊢ ⌜isptr comm⌝.
 Proof.
-  intro.
-  generalize Ews_Ish_join; rewrite H.
-  intro X; eapply sepalg.join_eq in X; [|apply join_bot_eq].
-  generalize juicy_mem.perm_of_Ews; rewrite X.
-  unfold juicy_mem.perm_of_sh.
-  rewrite if_true by auto.
-  rewrite if_true by auto; discriminate.
+  intros; apply AE_loc_isptr.
 Qed.
-#[export] Hint Resolve Ish_not_bot : core.
 
 (* messaging system function specs *)
 Definition initialize_channels_spec :=
@@ -121,36 +168,34 @@ Definition initialize_channels_spec :=
   PRE [ ]
    PROP (Zlength shs = N; sepalg_list.list_join sh1 shs Ews)
    PARAMS () GLOBALS (gv)
-   SEP (data_at_ Ews (tarray (tptr tint) N) (gv _comm); data_at_ Ews (tarray (tptr t_lock) N) (gv _lock);
+   SEP (data_at_ Ews (tarray (tptr t_atom_int) N) (gv _comm);
         data_at_ Ews (tarray (tptr tbuffer) B) (gv _bufs);
         data_at_ Ews (tarray (tptr tint) N) (gv _reading); data_at_ Ews (tarray (tptr tint) N) (gv _last_read);
         mem_mgr gv)
   POST [ tvoid ]
-   EX comms : list val, EX locks : list lock_handle, EX bufs : list val, EX reads : list val, EX lasts : list val,
-     EX g : list gname, EX g0 : list gname, EX g1 : list gname, EX g2 : list gname,
-   PROP (Forall isptr comms; Zlength g = N; Zlength g0 = N; Zlength g1 = N; Zlength g2 = N)
+   ∃ comms : list val, ∃ bufs : list val, ∃ reads : list val, ∃ lasts : list val,
+     ∃ g : list gname, ∃ g0 : list gname, ∃ g1 : list gname, ∃ g2 : list gname,
+   PROP ((*Forall isptr comms;*) Zlength g = N; Zlength g0 = N; Zlength g1 = N; Zlength g2 = N)
    LOCAL ()
-   SEP (data_at Ews (tarray (tptr tint) N) comms (gv _comm);
-        data_at Ews (tarray (tptr t_lock) N) (map ptr_of locks) (gv _lock);
+   SEP (data_at Ews (tarray (tptr t_atom_int) N) comms (gv _comm);
         data_at Ews (tarray (tptr tbuffer) B) bufs (gv _bufs);
         data_at Ews (tarray (tptr tint) N) reads (gv _reading);
         data_at Ews (tarray (tptr tint) N) lasts (gv _last_read);
-        fold_right sepcon emp (map (fun r =>
-          comm_loc Tsh (Znth r locks) (Znth r comms) (Znth r g) (Znth r g0)
-            (Znth r g1) (Znth r g2) bufs (Znth r shs) gsh2 empty_map) (upto (Z.to_nat N)));
-        fold_right sepcon emp (map (ghost_var gsh1 (vint 1)) g0);
-        fold_right sepcon emp (map (ghost_var gsh1 (vint 0)) g1);
-        fold_right sepcon emp (map (ghost_var gsh1 (vint 1)) g2);
-        fold_right sepcon emp (map (malloc_token Ews tint) comms);
-        fold_right sepcon emp (map (malloc_token Ews tbuffer) bufs);
-        fold_right sepcon emp (map (malloc_token Ews tint) reads);
-        fold_right sepcon emp (map (malloc_token Ews tint) lasts);
+        [∗] (map (fun r =>
+          comm_loc 1 (Znth r comms) (Znth r g) (Znth r g0)
+            (Znth r g1) (Znth r g2) bufs (Znth r shs) ∅) (upto (Z.to_nat N)));
+        [∗] (map (ghost_frag (vint 1)) g0);
+        [∗] (map (ghost_frag (vint 0)) g1);
+        [∗] (map (ghost_frag (vint 1)) g2);
+        [∗] (map (malloc_token Ews tbuffer) bufs);
+        [∗] (map (malloc_token Ews tint) reads);
+        [∗] (map (malloc_token Ews tint) lasts);
         data_at sh1 tbuffer (vint 0) (Znth 0 bufs);
-        fold_right sepcon emp (map (data_at Ews tbuffer (vint 0)) (sublist 1 (Zlength bufs) bufs));
-        fold_right sepcon emp (map (data_at_ Ews tint) reads);
-        fold_right sepcon emp (map (data_at_ Ews tint) lasts);
+        [∗] (map (data_at Ews tbuffer (vint 0)) (sublist 1 (Zlength bufs) bufs));
+        [∗] (map (data_at_ Ews tint) reads);
+        [∗] (map (data_at_ Ews tint) lasts);
         mem_mgr gv).
-(* All the communication channels are now inside locks. Buffer 0 also starts distributed among the channels. *)
+(* All the communication channels are now inside atomic invariants. Buffer 0 also starts distributed among the channels. *)
 
 Definition initialize_reader_spec :=
  DECLARE _initialize_reader
@@ -168,36 +213,36 @@ Definition initialize_reader_spec :=
 
 Definition latest_read (h : hist) v :=
   (* initial condition *)
-  ((forall t r w, h t = Some (AE r w) -> w = Empty -> r = Empty) /\ v = vint 1) \/
-  v <> Empty /\ exists n, h n = Some (AE v Empty) /\
-  forall t r w, h t = Some (AE r w) -> w = Empty -> r <> Empty -> (t <= n)%nat.
+  ((forall t r w, h !! t = Excl' (AE r w) -> w = Empty -> r = Empty) /\ v = vint 1) \/
+  v <> Empty /\ exists n, h !! n = Excl' (AE v Empty) /\
+  forall t r w, h !! t = Excl' (AE r w) -> w = Empty -> r <> Empty -> (t <= n)%nat.
 
 (* last_read retains the last buffer read, while reading is reset to Empty. *)
 Definition start_read_spec :=
  DECLARE _start_read
   WITH r : Z, reads : list val, lasts : list val,
-    locks : list lock_handle, comms : list val, bufs : list val, sh : share, sh1 : share, sh2 : share, b0 : Z,
+    comms : list val, bufs : list val, sh : share, sh1 : share, sh2 : Qp, b0 : Z,
     g : gname, g0 : gname, g1 : gname, g2 : gname, h : hist, gv: globals
   PRE [ tint ]
-   PROP (0 <= b0 < B; readable_share sh; readable_share sh1; readable_share sh2; isptr (Znth r comms); latest_read h (vint b0))
+   PROP (0 <= b0 < B; readable_share sh; readable_share sh1; latest_read h (vint b0))
    PARAMS (vint r) GLOBALS (gv)
    SEP (data_at sh1 (tarray (tptr tint) N) reads (gv _reading); data_at sh1 (tarray (tptr tint) N) lasts (gv _last_read);
-        data_at sh1 (tarray (tptr tint) N) comms (gv _comm); data_at sh1 (tarray (tptr t_lock) N) (map ptr_of locks) (gv _lock);
+        data_at sh1 (tarray (tptr t_atom_int) N) comms (gv _comm);
         data_at_ Ews tint (Znth r reads); data_at Ews tint (vint b0) (Znth r lasts);
-        comm_loc sh2 (Znth r locks) (Znth r comms) g g0 g1 g2 bufs sh gsh2 h;
-        EX v : Z, data_at sh tbuffer (vint v) (Znth b0 bufs);
-        ghost_var gsh1 (vint b0) g0)
+        comm_loc sh2 (Znth r comms) g g0 g1 g2 bufs sh h;
+        ∃ v : Z, data_at sh tbuffer (vint v) (Znth b0 bufs);
+        ghost_frag (vint b0) g0)
   POST [ tint ]
-   EX b : Z, EX t : nat, EX v0 : val, EX v : Z,
+   ∃ b : Z, ∃ t : nat, ∃ v0 : val, ∃ v : Z,
    PROP (0 <= b < B; if eq_dec v0 Empty then b = b0 else v0 = vint b;
-         latest_read (map_upd h t (AE v0 Empty)) (vint b))
+         latest_read (<[t := Excl (AE v0 Empty)]>h) (vint b))
    LOCAL (temp ret_temp (vint b))
    SEP (data_at sh1 (tarray (tptr tint) N) reads (gv _reading); data_at sh1 (tarray (tptr tint) N) lasts (gv _last_read);
-        data_at sh1 (tarray (tptr tint) N) comms (gv _comm); data_at sh1 (tarray (tptr t_lock) N) (map ptr_of locks) (gv _lock);
+        data_at sh1 (tarray (tptr t_atom_int) N) comms (gv _comm);
         data_at Ews tint (vint b) (Znth r reads); data_at Ews tint (vint b) (Znth r lasts);
-        comm_loc sh2 (Znth r locks) (Znth r comms) g g0 g1 g2 bufs sh gsh2 (map_upd h t (AE v0 Empty));
+        comm_loc sh2 (Znth r comms) g g0 g1 g2 bufs sh (<[t := Excl (AE v0 Empty)]>h);
         data_at sh tbuffer (vint v) (Znth b bufs);
-        ghost_var gsh1 (vint b) g0).
+        ghost_frag (vint b) g0).
 (* And bufs[b] is the most recent buffer completed by finish_write. *)
 
 
@@ -236,7 +281,7 @@ Definition start_write_spec :=
    SEP (data_at_ Ews tint (gv _writing); data_at Ews tint (vint b0) (gv _last_given);
         data_at Ews (tarray tint N) (map (fun x => vint x) lasts) (gv _last_taken))
   POST [ tint ]
-   EX b : Z,
+   ∃ b : Z,
    PROP (0 <= b < B; b <> b0; ~In b lasts)
    LOCAL (temp ret_temp (vint b))
    SEP (data_at Ews tint (vint b) (gv _writing); data_at Ews tint (vint b0) (gv _last_given);
@@ -253,85 +298,82 @@ Fixpoint make_shares shs (lasts : list Z) i : list share :=
 
 Definition finish_write_spec :=
  DECLARE _finish_write
-  WITH comms : list val, locks : list lock_handle, bufs : list val, b : Z, b0 : Z, lasts : list Z,
-    sh1 : share, lsh : share, shs : list share, g : list gname, g0 : list gname, g1 : list gname, g2 : list gname,
+  WITH comms : list val, bufs : list val, b : Z, b0 : Z, lasts : list Z,
+    sh1 : share, lsh : Qp, shs : list share, g : list gname, g0 : list gname, g1 : list gname, g2 : list gname,
     h : list hist, sh0 : share, gv: globals
   PRE [ ]
    PROP (0 <= b < B; 0 <= b0 < B; Forall (fun x => 0 <= x < B) lasts; Zlength h = N; Zlength shs = N;
-         readable_share sh1; readable_share lsh; Forall readable_share shs;
-         sepalg_list.list_join sh0 shs Ews; Forall isptr comms; b <> b0; ~In b lasts; ~In b0 lasts)
+         readable_share sh1; Forall readable_share shs;
+         sepalg_list.list_join sh0 shs Ews; (*Forall isptr comms;*) b <> b0; ~In b lasts; ~In b0 lasts)
    PARAMS () GLOBALS (gv)
    SEP (data_at Ews tint (vint b) (gv _writing); data_at Ews tint (vint b0) (gv _last_given);
         data_at Ews (tarray tint N) (map (fun x => vint x) lasts) (gv _last_taken);
-        data_at sh1 (tarray (tptr tint) N) comms (gv _comm);
-        data_at sh1 (tarray (tptr t_lock) N) (map ptr_of locks) (gv _lock);
-        fold_right sepcon emp (map (fun r =>
-          comm_loc lsh (Znth r locks) (Znth r comms) (Znth r g) (Znth r g0)
-            (Znth r g1) (Znth r g2) bufs (Znth r shs) gsh2 (Znth r h)) (upto (Z.to_nat N)));
-        fold_right sepcon emp (map (fun r => ghost_var gsh1 (vint b0) (Znth r g1) *
-          ghost_var gsh1 (vint (@Znth Z (-1) r lasts)) (Znth r g2)) (upto (Z.to_nat N)));
-        fold_right sepcon emp (map (fun i => EX sh : share,
-          !!(if eq_dec i b0 then sh = sh0 else sepalg_list.list_join sh0 (make_shares shs lasts i) sh) &&
-          EX v : Z, data_at sh tbuffer (vint v) (Znth i bufs)) (upto (Z.to_nat B))))
+        data_at sh1 (tarray (tptr t_atom_int) N) comms (gv _comm);
+        [∗] (map (fun r =>
+          comm_loc lsh (Znth r comms) (Znth r g) (Znth r g0)
+            (Znth r g1) (Znth r g2) bufs (Znth r shs) (Znth r h)) (upto (Z.to_nat N)));
+        [∗] (map (fun r => ghost_frag (vint b0) (Znth r g1) ∗
+          ghost_frag (vint (@Znth Z (-1) r lasts)) (Znth r g2)) (upto (Z.to_nat N)));
+        [∗] (map (fun i => ∃ sh : share,
+          ⌜if eq_dec i b0 then sh = sh0 else sepalg_list.list_join sh0 (make_shares shs lasts i) sh⌝ ∧
+          ∃ v : Z, data_at sh tbuffer (vint v) (Znth i bufs)) (upto (Z.to_nat B))))
   POST [ tvoid ]
-   EX lasts' : list Z, EX h' : list hist,
+   ∃ lasts' : list Z, ∃ h' : list hist,
    PROP (Forall (fun x => 0 <= x < B) lasts';
-         Forall2 (fun h1 h2 => exists t v, h2 = map_upd h1 t (AE v (vint b))) h h';
+         Forall2 (fun h1 h2 => exists t v, h2 = <[t := Excl (AE v (vint b))]>h1) h h';
          ~In b lasts')
    LOCAL ()
    SEP (data_at Ews tint Empty (gv _writing); data_at Ews tint (vint b) (gv _last_given);
         data_at Ews (tarray tint N) (map (fun x => vint x) lasts') (gv _last_taken);
-        data_at sh1 (tarray (tptr tint) N) comms (gv _comm);
-        data_at sh1 (tarray (tptr t_lock) N) (map ptr_of locks) (gv _lock);
-        fold_right sepcon emp (map (fun r =>
-          comm_loc lsh (Znth r locks) (Znth r comms) (Znth r g) (Znth r g0)
-            (Znth r g1) (Znth r g2) bufs (Znth r shs) gsh2 (Znth r h')) (upto (Z.to_nat N)));
-        fold_right sepcon emp (map (fun r => ghost_var gsh1 (vint b) (Znth r g1) *
-          ghost_var gsh1 (vint (@Znth Z (-1) r lasts')) (Znth r g2)) (upto (Z.to_nat N)));
-        fold_right sepcon emp (map (fun i => EX sh : share,
-          !!(if eq_dec i b then sh = sh0 else sepalg_list.list_join sh0 (make_shares shs lasts' i) sh) &&
-          EX v : Z, data_at sh tbuffer (vint v) (Znth i bufs)) (upto (Z.to_nat B)))).
+        data_at sh1 (tarray (tptr t_atom_int) N) comms (gv _comm);
+        [∗] (map (fun r =>
+          comm_loc lsh (Znth r comms) (Znth r g) (Znth r g0)
+            (Znth r g1) (Znth r g2) bufs (Znth r shs) (Znth r h')) (upto (Z.to_nat N)));
+        [∗] (map (fun r => ghost_frag (vint b) (Znth r g1) ∗
+          ghost_frag (vint (@Znth Z (-1) r lasts')) (Znth r g2)) (upto (Z.to_nat N)));
+        [∗] (map (fun i => ∃ sh : share,
+          ⌜if eq_dec i b then sh = sh0 else sepalg_list.list_join sh0 (make_shares shs lasts' i) sh⌝ ∧
+          ∃ v : Z, data_at sh tbuffer (vint v) (Znth i bufs)) (upto (Z.to_nat B)))).
 
 (* client function specs *)
 Definition reader_spec :=
  DECLARE _reader
-  WITH arg : val, x : Z * list val * list val * list lock_handle * list val * list val *
-                      share * share * share * gname * gname * gname * gname * globals
+  WITH arg : val, x : Z * list val * list val * list val * list val *
+                      share * Qp * share * gname * gname * gname * gname * globals
   PRE [ tptr tvoid ]
-   let '(r, reads, lasts, locks, comms, bufs, sh1, sh2, sh, g, g0, g1, g2, gv) := x in
-   PROP (readable_share sh; readable_share sh1; readable_share sh2; isptr (Znth r comms))
+   let '(r, reads, lasts, comms, bufs, sh1, sh2, sh, g, g0, g1, g2, gv) := x in
+   PROP (readable_share sh; readable_share sh1)
    PARAMS (arg) GLOBALS (gv)
    SEP (data_at Ews tint (vint r) arg; malloc_token Ews tint arg;
         data_at sh1 (tarray (tptr tint) N) reads (gv _reading); data_at sh1 (tarray (tptr tint) N) lasts (gv _last_read);
-        data_at sh1 (tarray (tptr tint) N) comms (gv _comm); data_at sh1 (tarray (tptr t_lock) N) (map ptr_of locks) (gv _lock);
+        data_at sh1 (tarray (tptr t_atom_int) N) comms (gv _comm);
         data_at_ Ews tint (Znth r reads); data_at_ Ews tint (Znth r lasts);
         data_at sh1 (tarray (tptr tbuffer) B) bufs (gv _bufs);
-        comm_loc sh2 (Znth r locks) (Znth r comms) g g0 g1 g2 bufs sh gsh2 empty_map;
-        EX v : Z, data_at sh tbuffer (vint v) (Znth 1 bufs);
-        ghost_var gsh1 (vint 1) g0)
+        comm_loc sh2 (Znth r comms) g g0 g1 g2 bufs sh ∅;
+        ∃ v : Z, data_at sh tbuffer (vint v) (Znth 1 bufs);
+        ghost_frag (vint 1) g0)
   POST [ tint ] PROP () RETURN (Vint Int.zero) SEP ().
 
 Definition writer_spec :=
  DECLARE _writer
-  WITH arg : val, x : list lock_handle * list val * list val * share * share *
+  WITH arg : val, x : list val * list val * share * Qp *
                       share * list share * list gname * list gname * list gname * list gname * globals
   PRE [ tptr tvoid ]
-   let '(locks, comms, bufs, sh1, lsh, sh0, shs, g, g0, g1, g2, gv) := x in
-   PROP (Zlength shs = N; readable_share sh1; readable_share lsh; Forall readable_share shs;
-         sepalg_list.list_join sh0 shs Ews; Zlength g1 = N; Zlength g2 = N; Forall isptr comms)
+   let '(comms, bufs, sh1, lsh, sh0, shs, g, g0, g1, g2, gv) := x in
+   PROP (Zlength shs = N; readable_share sh1; Forall readable_share shs;
+         sepalg_list.list_join sh0 shs Ews; Zlength g1 = N; Zlength g2 = N(*; Forall isptr comms*))
    PARAMS (arg) GLOBALS (gv)
    SEP (data_at_ Ews tint (gv _writing); data_at_ Ews tint (gv _last_given); data_at_ Ews (tarray tint N) (gv _last_taken);
-        data_at sh1 (tarray (tptr tint) N) comms (gv _comm);
-        data_at sh1 (tarray (tptr t_lock) N) (map ptr_of locks) (gv _lock);
+        data_at sh1 (tarray (tptr t_atom_int) N) comms (gv _comm);
         data_at sh1 (tarray (tptr tbuffer) B) bufs (gv _bufs);
-        fold_right sepcon emp (map (fun r =>
-          comm_loc lsh (Znth r locks) (Znth r comms) (Znth r g) (Znth r g0)
-            (Znth r g1) (Znth r g2) bufs (Znth r shs) gsh2 empty_map) (upto (Z.to_nat N)));
-        fold_right sepcon emp (map (ghost_var gsh1 (vint 0)) g1);
-        fold_right sepcon emp (map (ghost_var gsh1 (vint 1)) g2);
-        fold_right sepcon emp (map (fun i => EX sh : share,
-          !!(if eq_dec i 0 then sh = sh0 else if eq_dec i 1 then sh = sh0 else sh = Ews) &&
-          EX v : Z, data_at sh tbuffer (vint v) (Znth i bufs)) (upto (Z.to_nat B))))
+        [∗] (map (fun r =>
+          comm_loc lsh (Znth r comms) (Znth r g) (Znth r g0)
+            (Znth r g1) (Znth r g2) bufs (Znth r shs) ∅) (upto (Z.to_nat N)));
+        [∗] (map (ghost_frag (vint 0)) g1);
+        [∗] (map (ghost_frag (vint 1)) g2);
+        [∗] (map (fun i => ∃ sh : share,
+          ⌜if eq_dec i 0 then sh = sh0 else if eq_dec i 1 then sh = sh0 else sh = Ews⌝ ∧
+          ∃ v : Z, data_at sh tbuffer (vint v) (Znth i bufs)) (upto (Z.to_nat B))))
   POST [ tint ] PROP () RETURN (Vint Int.zero) SEP ().
 
 Definition main_spec :=
@@ -341,8 +383,8 @@ Definition main_spec :=
   POST [ tint ] main_post prog gv.
 
 (* Create the environment containing all function specs. *)
-Definition Gprog : funspecs := ltac:(with_library prog [release_spec; makelock_spec; spawn_spec;
-  surely_malloc_spec; memset_spec; atomic_exchange_spec; initialize_channels_spec; initialize_reader_spec;
+Definition Gprog : funspecs := ltac:(with_library prog [spawn_spec;
+  surely_malloc_spec; memset_spec; make_atomic_spec; atomic_exchange_spec; initialize_channels_spec; initialize_reader_spec;
   start_read_spec; finish_read_spec; initialize_writer_spec; start_write_spec; finish_write_spec;
   reader_spec; writer_spec; main_spec]).
 
@@ -419,58 +461,54 @@ Proof.
   unfold last_two_reads; intros.
   destruct (find_read h (vint 1)) eqn: Hfind.
   destruct (find_read_In (vint 1) l); simpl in *; auto.
-  right; eapply find_read_incl; rewrite Hfind; auto.
+  right; eapply find_read_incl; rewrite -> Hfind; auto.
 Qed.
 
 Lemma latest_read_Empty : forall h n v, newer h n ->
-  latest_read (map_upd h n (AE Empty Empty)) v <-> latest_read h v.
+  latest_read (<[n := Excl (AE Empty Empty)]>h) v <-> latest_read h v.
 Proof.
   unfold latest_read; split; intros [(Hnone & ?) | (? & m & Hin & Hlatest)]; subst.
   - left; split; auto; intros.
     eapply (Hnone t); eauto.
-    unfold map_upd; if_tac; auto.
-    subst; erewrite newer_out in H0 by eauto; discriminate.
+    rewrite lookup_insert_ne //.
+    intros ->; erewrite newer_out in H0 by eauto; discriminate.
   - right; split; auto; exists m.
-    unfold map_upd in Hin; destruct (eq_dec m n); [congruence|].
+    destruct (eq_dec m n); [subst; rewrite lookup_insert in Hin; congruence | rewrite lookup_insert_ne // in Hin].
     split; auto; intros; eapply Hlatest; eauto.
-    unfold map_upd; if_tac; auto.
-    subst; erewrite newer_out in H1 by eauto; discriminate.
+    rewrite lookup_insert_ne //.
+    intros ->; erewrite newer_out in H1 by eauto; discriminate.
   - left; split; auto.
-    unfold map_upd; intros ???.
-    if_tac; eauto.
+    intros ???.
+    destruct (eq_dec n t); [subst; rewrite lookup_insert | rewrite lookup_insert_ne //]; eauto.
     inversion 1; auto.
   - right; split; auto; exists m.
-    unfold map_upd.
     apply newer_out in H.
-    split; [if_tac; auto; congruence|].
-    intros ??; if_tac; eauto.
+    split; [destruct (eq_dec m n); [subst; rewrite lookup_insert; congruence | rewrite lookup_insert_ne //]|].
+    intros ??.
+    destruct (eq_dec n t); [subst; rewrite lookup_insert | rewrite lookup_insert_ne //]; eauto.
     intro; inversion 1; contradiction.
 Qed.
 
 Lemma latest_read_new : forall h n v, newer h n -> v <> Empty ->
-  latest_read (map_upd h n (AE v Empty)) v.
+  latest_read (<[n := Excl (AE v Empty)]>h) v.
 Proof.
   unfold latest_read; intros.
   right; split; auto; exists n.
-  unfold map_upd; rewrite eq_dec_refl; split; auto.
-  intros ???; if_tac; [subst; auto|].
+  rewrite lookup_insert; split; auto.
+  intros ???; destruct (eq_dec n t); [subst; auto | rewrite lookup_insert_ne //].
   intro Ht; specialize (H t); rewrite Ht in H; lapply H; [lia | discriminate].
 Qed.
 
-Lemma comm_loc_isptr : forall lsh l c g g0 g1 g2 b sh gsh h,
-  comm_loc lsh l c g g0 g1 g2 b sh gsh h = !!(isptr (ptr_of l)) && comm_loc lsh l c g g0 g1 g2 b sh gsh h.
-Proof.
-  intros; eapply local_facts_isptr with (P := fun l => _); [|eauto].
-  unfold comm_loc, AE_loc.
-  sep_apply lock_inv_isptr; entailer!.
-Qed.
-
 Lemma make_shares_out : forall b lasts shs
   (Hb : ~In b lasts) (Hlen : Zlength lasts = Zlength shs), make_shares shs lasts b = shs.
 Proof.
   induction lasts; auto; simpl; intros.
-  { rewrite Zlength_nil in *; destruct shs; auto; rewrite Zlength_cons, Zlength_correct in *; lia. }
+  { rewrite -> Zlength_nil in *; destruct shs; auto; rewrite -> Zlength_cons, Zlength_correct in *; lia. }
   destruct (eq_dec a b); [contradiction Hb; auto|].
-  destruct shs; rewrite !Zlength_cons in *; [rewrite Zlength_nil, Zlength_correct in *; lia|].
+  destruct shs; rewrite -> !Zlength_cons in *; [rewrite -> Zlength_nil, Zlength_correct in *; lia|].
   simpl; rewrite IHlasts; auto; lia.
 Qed.
+
+End mpred.
+
+#[export] Hint Resolve comm_loc_isptr : saturate_locals.
diff --git a/mailbox/verif_mailbox_write.v b/mailbox/verif_mailbox_write.v
index 50a5a2ebbc..953168a587 100644
--- a/mailbox/verif_mailbox_write.v
+++ b/mailbox/verif_mailbox_write.v
@@ -1,6 +1,5 @@
 Require Import mailbox.verif_atomic_exchange.
 Require Import VST.concurrency.conclib.
-Require Import VST.concurrency.ghosts.
 Require Import VST.floyd.library.
 Require Import VST.zlist.sublist.
 Require Import mailbox.mailbox.
@@ -8,19 +7,22 @@ Require Import mailbox.verif_mailbox_specs.
 
 Opaque upto.
 
+Section mpred.
+
+Context `{!VSTGS unit Σ, AEGS0 : !AEGS t_atom_int, !inG Σ (excl_authR (leibnizO val))}.
+
 Lemma body_initialize_writer : semax_body Vprog Gprog f_initialize_writer initialize_writer_spec.
 Proof.
   start_function.
   forward.
   forward.
-  forward_for_simple_bound N (EX i : Z, PROP ( )
+  forward_for_simple_bound N (∃ i : Z, PROP ( )
    LOCAL (gvars gv)
    SEP (field_at Ews tint [] (eval_unop Oneg tint (vint 1)) (gv _writing); field_at Ews tint [] (vint 0) (gv _last_given);
         data_at Ews (tarray tint N) (repeat (vint 1) (Z.to_nat i) ++ repeat Vundef (Z.to_nat (N - i))) (gv _last_taken))).
   { unfold N; computable. }
   { unfold N; computable. }
-  { entailer!; 
-       try  (simpl; cancel).  (* this line for backward compatibility before VST 2.12 *) }
+  { entailer!. }
   - assert (N < Int.max_signed) by computable.
     forward.
     rewrite upd_init_const; auto.
@@ -32,7 +34,7 @@ Proof.
   start_function.
   assert (N < Int.max_signed) as HN by computable.
   assert (B < Int.max_signed) as HB by computable.
-  forward_for_simple_bound B (EX i : Z, PROP ( )
+  forward_for_simple_bound B (∃ i : Z, PROP ( )
    LOCAL (lvar _available (tarray tint B) v_available; gvars gv)
    SEP (data_at Tsh (tarray tint B) (repeat (vint 1) (Z.to_nat i) ++ repeat Vundef (Z.to_nat (B - i))) v_available;
         data_at_ Ews tint (gv _writing); data_at Ews tint (vint b0) (gv _last_given);
@@ -41,7 +43,7 @@ Proof.
         simpl; cancel. (* this line needed before VST 2.12 *)  }
   { forward.
     rewrite upd_init_const; auto; entailer!. }
-  rewrite Zminus_diag, app_nil_r.
+  rewrite Zminus_diag app_nil_r.
   forward.
   forward.
   assert_PROP (Zlength lasts = N).
@@ -49,27 +51,26 @@ Proof.
     go_lowerx.
     apply sepcon_derives_prop.
     eapply derives_trans; [apply data_array_at_local_facts'; unfold N; lia|].
-    apply prop_left; intros (? & ? & ?).
+    apply bi.pure_mono; intros (? & ? & ?).
     unfold unfold_reptype in *; simpl in *.
-    rewrite Zlength_map in *; apply prop_right; auto. }
-  forward_for_simple_bound N (EX i : Z, PROP ( )
+    rewrite -> Zlength_map in *; auto. }
+  forward_for_simple_bound N (∃ i : Z, PROP ( )
    LOCAL (temp _i (vint B); lvar _available (tarray tint B) v_available; gvars gv)
    SEP (data_at Tsh (tarray tint B) (map (fun x => vint (if eq_dec x b0 then 0
      else if in_dec eq_dec x (sublist 0 i lasts) then 0 else 1)) (upto (Z.to_nat B))) v_available;
    data_at_ Ews tint (gv _writing); data_at Ews tint (vint b0) (gv _last_given);
    data_at Ews (tarray tint N) (map (fun x : Z => vint x) lasts) (gv _last_taken))).
   { entailer!.
-   apply derives_refl'; f_equal.
+    f_equiv.
     rewrite upd_Znth_eq;
-       [|simpl; rewrite !Zlength_cons, Zlength_nil; unfold B, N in *; lia].
+       [|simpl; rewrite -> !Zlength_cons, Zlength_nil; unfold B, N in *; lia].
     simpl Datatypes.length.
     change (Z.to_nat B) with 5%nat.
     apply map_ext_in; intros ? Hin.
     rewrite In_upto in Hin. unfold eq_dec, EqDec_Z, zeq.
     destruct (Z.eq_dec a b0); auto.
-    rewrite if_false.
-    rewrite Znth_repeat' by auto. auto.
-    list_solve. }
+    if_tac; first list_solve.
+    rewrite -> Znth_repeat' by auto; done. }
   Opaque eq_dec.
   { assert (0 <= i < Zlength lasts) by lia.
     forward.
@@ -83,11 +84,12 @@ Proof.
       forward.
       entailer!.
       rewrite upd_Znth_eq; [|auto].
-      apply derives_refl'; erewrite map_ext_in; [reflexivity|].
-      intros; rewrite In_upto, map_length, upto_length in *; simpl in *.
+      rewrite /data_at; f_equiv.
+      apply map_ext_in.
+      intros; rewrite -> In_upto(*, map_length, upto_length*) in *; simpl in *.
       erewrite Znth_map, Znth_upto; simpl; auto; try lia.
       erewrite sublist_split with (mid := i)(hi := i + 1), sublist_len_1; auto; try lia.
-      destruct (in_dec eq_dec a (sublist 0 i lasts ++ [Znth i lasts])); rewrite in_app in *.
+      destruct (in_dec eq_dec a (sublist 0 i lasts ++ [Znth i lasts])); rewrite -> in_app in *.
       + destruct (Z.eq_dec a (Znth i lasts)); destruct (eq_dec a b0); auto.
         destruct (in_dec eq_dec a (sublist 0 i lasts)); auto.
         destruct i0 as [? | [? | ?]]; subst; try contradiction.
@@ -97,12 +99,13 @@ Proof.
         destruct (in_dec eq_dec a (sublist 0 i lasts)); auto; contradiction n; auto.
     - forward.
       entailer!.
-      apply derives_refl'; erewrite map_ext_in; [reflexivity|].
-      intros; rewrite In_upto in *; simpl in *.
+      rewrite /data_at; f_equiv.
+      apply map_ext_in.
+      intros; rewrite -> In_upto in *; simpl in *.
       destruct (eq_dec a b0); auto.
       erewrite sublist_split with (mid := i)(hi := i + 1), sublist_len_1; auto; try lia.
 (*      match goal with H : Int.repr _ = Int.neg _ |- _ => apply repr_inj_signed in H end. *)
-      destruct (in_dec eq_dec a (sublist 0 i lasts ++ [Znth i lasts])); rewrite in_app in *.
+      destruct (in_dec eq_dec a (sublist 0 i lasts ++ [Znth i lasts])); rewrite -> in_app in *.
       + destruct (in_dec eq_dec a (sublist 0 i lasts)); auto.
         destruct i0 as [? | [? | ?]]; subst; try contradiction.
         apply repr_inj_signed in H4; rep_lia.
@@ -115,7 +118,7 @@ Proof.
   unfold Sfor.
   forward.
   eapply semax_seq, semax_ff.
-  eapply semax_pre with (P' := EX i : Z, PROP (0 <= i <= B; forall j, 0 <= j < i -> Znth j available = vint 0)
+  eapply semax_pre with (P' := ∃ i : Z, PROP (0 <= i <= B; forall j, 0 <= j < i -> Znth j available = vint 0)
     LOCAL (temp _i__1 (vint i); lvar _available (tarray tint 5) v_available; gvars gv)
     SEP (field_at Tsh (tarray tint 5) [] available v_available; data_at_ Ews tint (gv _writing);
          data_at Ews tint (vint b0) (gv _last_given); data_at Ews (tarray tint N) (map (fun x => vint x) lasts) (gv _last_taken))).
@@ -142,10 +145,10 @@ Proof.
       destruct (in_dec eq_dec j lasts); [contradiction Hout; simpl; auto|].
       discriminate. }
     Intros.
+    assert (0 <= i < Zlength (upto (Z.to_nat B))) by tauto.
     forward.
-    entailer!. change B with 5%Z in *. lia.
     { entailer!.
-      subst available; apply Forall_Znth; [rewrite Zlength_map, Zlength_upto; unfold B, N in *; simpl; lia|].
+      subst available; apply Forall_Znth; [rewrite Zlength_map Zlength_upto; unfold B, N in *; simpl; lia|].
       rewrite Forall_forall; intros ? Hin.
       rewrite in_map_iff in Hin; destruct Hin as (? & ? & ?); subst; simpl; auto. }
     forward_if (PROP (Znth i available = vint 0)
@@ -157,21 +160,18 @@ Proof.
       Exists i; entailer!.
       { subst available.
         match goal with H : typed_true _ _ |- _ => setoid_rewrite Znth_map in H; [rewrite Znth_upto in H|];
-          try assumption; rewrite ?Zlength_upto, ?Z2Nat.id; try lia; unfold typed_true in H; simpl in H; inv H end.
-        destruct (eq_dec i b0); [|destruct (in_dec eq_dec i lasts)]; auto; discriminate.
-        all: change B with 5 in * ; lia.
- }
+          try assumption; rewrite ?Zlength_upto ?Z2Nat.id; try lia; unfold typed_true in H; simpl in H; inv H end.
+        destruct (eq_dec i b0); [|destruct (in_dec eq_dec i lasts)]; auto; discriminate. }
       unfold data_at_, field_at_; entailer!. }
     { forward.
       entailer!.
       subst available.
-      erewrite Znth_map, Znth_upto; rewrite ?Zlength_upto, ?Z2Nat.id; try assumption; try lia.
+      erewrite Znth_map, Znth_upto; rewrite -> ?Zlength_upto, ?Z2Nat.id; try assumption; try lia.
       match goal with H : typed_false _ _ |- _ => setoid_rewrite Znth_map in H; [rewrite Znth_upto in H|];
-        try assumption; rewrite ?Zlength_upto, ?Z2Nat.id; try lia; unfold typed_true in H; simpl in H; inv H end.
+        try assumption; rewrite ?Zlength_upto ?Z2Nat.id; try lia; unfold typed_true in H; simpl in H; inv H end.
       destruct (eq_dec _ _); auto.
-      destruct (in_dec _ _ _); auto; discriminate.
-        all: change B with 5 in * ; lia. }
-    instantiate (1 := EX i : Z, PROP (0 <= i < B; Znth i available = vint 0;
+      destruct (in_dec _ _ _); auto; discriminate. }
+    instantiate (1 := ∃ i : Z, PROP (0 <= i < B; Znth i available = vint 0;
       forall j : Z, 0 <= j < i -> Znth j available = vint 0)
       LOCAL (temp _i__1 (vint i); lvar _available (tarray tint B) v_available; gvars gv)
       SEP (field_at Tsh (tarray tint B) [] available v_available; data_at_ Ews tint (gv _writing);
@@ -185,7 +185,7 @@ Proof.
     unfold loop2_ret_assert.
     Exists (i + 1); entailer!.
     intros; destruct (eq_dec j i); subst; auto.
-    assert (0<= j < i) by lia; auto.
+    assert (0 <= j < i) by lia; auto.
 Qed.
 
 Lemma find_write_rest : forall d h, exists n, snd (find_write h d) = skipn n h.
@@ -204,7 +204,7 @@ Proof.
   intros; unfold prev_taken.
   destruct (find_read_In (vint 1) (snd (find_write h (vint 0)))).
   - inv H; auto.
-  - destruct (find_write_rest (vint 0) h) as (? & Hrest); rewrite Hrest in *.
+  - destruct (find_write_rest (vint 0) h) as (? & Hrest); rewrite -> Hrest in *.
     right; eapply skipn_In; eauto.
 Qed.
 
@@ -229,7 +229,7 @@ Proof.
   destruct (apply_hist i (rev h)) eqn: Hh; [|discriminate].
   destruct (eq_dec r v); [subst | discriminate].
   inv Hread.
-  rewrite !eq_dec_refl.
+  if_tac; last done.
   destruct (eq_dec v Empty); eauto.
   exploit write_val; eauto; intros [? | ?]; subst; eauto; contradiction n; auto.
 Qed.
@@ -241,7 +241,7 @@ Proof.
   induction h; simpl; intros.
   - inv H.
     destruct (eq_dec (vint 0) Empty); auto.
-  - destruct a; rewrite prev_taken_cons, last_two_reads_cons.
+  - destruct a; rewrite prev_taken_cons last_two_reads_cons.
     rewrite apply_hist_app in H; simpl in H.
     destruct (apply_hist (vint 0) (rev h)) eqn: Hh; [|discriminate].
     destruct (eq_dec r v0); [subst | discriminate].
@@ -266,10 +266,10 @@ Lemma make_shares_app : forall i l1 l2 shs, Zlength l1 + Zlength l2 <= Zlength s
 Proof.
   induction l1; simpl; intros.
   - rewrite sublist_same; auto.
-  - rewrite Zlength_cons in *.
+  - rewrite -> Zlength_cons in *.
     destruct shs.
-    { rewrite Zlength_nil, !Zlength_correct in *; lia. }
-    rewrite Zlength_cons in *; simpl; rewrite IHl1; [|lia].
+    { rewrite -> Zlength_nil, !Zlength_correct in *; lia. }
+    rewrite -> Zlength_cons in *; simpl; rewrite IHl1; [|lia].
     rewrite (sublist_S_cons (Z.succ _)); [|rewrite Zlength_correct; lia].
     unfold Z.succ; rewrite !Z.add_simpl_r.
     destruct (eq_dec a i); auto.
@@ -279,14 +279,14 @@ Lemma make_shares_ext : forall i l l' shs (Hlen : Zlength l = Zlength l')
   (Hi : forall j, 0 <= j < Zlength l -> Znth j l = i <-> Znth j l' = i),
   make_shares shs l i = make_shares shs l' i.
 Proof.
-  induction l; destruct l'; simpl; intros; rewrite ?Zlength_cons, ?Zlength_nil in *; auto;
-    try (rewrite Zlength_correct in *; lia).
+  induction l; destruct l'; simpl; intros; rewrite -> ?Zlength_cons, ?Zlength_nil in *; auto;
+    try (rewrite -> Zlength_correct in *; lia).
   exploit (Hi 0); [rewrite Zlength_correct; lia|].
   rewrite !Znth_0_cons; intro Hiff.
   rewrite (IHl l'); try lia.
   - destruct (eq_dec a i), (eq_dec z i); tauto.
   - intros; exploit (Hi (j + 1)); [lia|].
-    rewrite !Znth_pos_cons, !Z.add_simpl_r; auto; lia.
+    rewrite -> !Znth_pos_cons, !Z.add_simpl_r; auto; lia.
 Qed.
 
 (* The complement of make_shares. *)
@@ -302,8 +302,8 @@ Lemma make_shares_minus : forall i lasts sh0 shs sh' sh1 (Hsh' : sepalg_list.lis
   (Hlen : Zlength shs = Zlength lasts),
   sepalg_list.list_join sh1 (make_shares_inv shs lasts i) sh'.
 Proof.
-  induction lasts; destruct shs; simpl; intros; rewrite ?Zlength_cons, ?Zlength_nil in *;
-    try (rewrite Zlength_correct in *; lia).
+  induction lasts; destruct shs; simpl; intros; rewrite -> ?Zlength_cons, ?Zlength_nil in *;
+    try (rewrite -> Zlength_correct in *; lia).
   - inv Hsh1; inv Hsh'; constructor.
   - inversion Hsh' as [|????? Hj1 Hj2]; subst.
     destruct (eq_dec a i).
@@ -321,10 +321,10 @@ Lemma make_shares_add : forall i i' lasts j shs (Hj : 0 <= j < Zlength lasts)
   exists shs1 shs2, make_shares shs lasts i = shs1 ++ shs2 /\
     make_shares shs (upd_Znth j lasts i') i = shs1 ++ Znth j shs :: shs2.
 Proof.
-  induction lasts; destruct shs; simpl; intros; rewrite ?Zlength_cons, ?Zlength_nil in *; try lia.
+  induction lasts; destruct shs; simpl; intros; rewrite -> ?Zlength_cons, ?Zlength_nil in *; try lia.
   destruct (eq_dec j 0).
   - subst; rewrite Znth_0_cons in Hi', IHlasts; rewrite !Znth_0_cons.
-    rewrite eq_dec_refl, upd_Znth0; auto; try lia; simpl.
+    rewrite eq_dec_refl upd_Znth0; auto; try lia; simpl.
     destruct (eq_dec i' a); [contradiction Hi'; auto|].
     eexists [], _; simpl; split; eauto.
   - rewrite Znth_pos_cons in Hi; [|lia].
@@ -332,7 +332,7 @@ Proof.
     exploit (IHlasts (j - 1) shs); try lia.
     intros (shs1 & shs2 & Heq1 & Heq2).
     rewrite upd_Znth_cons; [simpl | lia].
-    exists (if eq_dec a i then shs1 else t :: shs1), shs2; rewrite Heq1, Heq2; destruct (eq_dec a i); auto.
+    exists (if eq_dec a i then shs1 else t :: shs1), shs2; rewrite Heq1 Heq2; destruct (eq_dec a i); auto.
 Qed.
 
 Lemma make_shares_In : forall i lasts x shs (Hx : 0 <= x < Zlength lasts) (Hi : Znth x lasts <> i)
@@ -340,8 +340,8 @@ Lemma make_shares_In : forall i lasts x shs (Hx : 0 <= x < Zlength lasts) (Hi :
   In (Znth x shs)  (make_shares shs lasts i).
 Proof.
   induction lasts; simpl; intros.
-  - rewrite Zlength_nil in *; lia.
-  - destruct shs; rewrite !Zlength_cons in *; [rewrite Zlength_nil, Zlength_correct in *; lia|].
+  - rewrite -> Zlength_nil in *; lia.
+  - destruct shs; rewrite -> !Zlength_cons in *; [rewrite -> Zlength_nil, Zlength_correct in *; lia|].
     destruct (eq_dec x 0).
     + subst; rewrite Znth_0_cons in Hi; rewrite Znth_0_cons.
       destruct (eq_dec a i); [contradiction Hi | simpl]; auto.
@@ -356,10 +356,10 @@ Lemma make_shares_inv_In : forall i lasts x shs (Hx : 0 <= x < Zlength lasts) (H
   In (Znth x shs) (make_shares_inv shs lasts i).
 Proof.
   induction lasts; simpl; intros.
-  - rewrite Zlength_nil in *; lia.
-  - destruct shs; rewrite !Zlength_cons in *; [rewrite Zlength_nil, Zlength_correct in *; lia|].
+  - rewrite -> Zlength_nil in *; lia.
+  - destruct shs; rewrite -> !Zlength_cons in *; [rewrite -> Zlength_nil, Zlength_correct in *; lia|].
     destruct (eq_dec x 0).
-    + subst; rewrite Znth_0_cons in *; rewrite Znth_0_cons; subst.
+    + subst; rewrite -> Znth_0_cons in *; rewrite Znth_0_cons; subst.
       rewrite eq_dec_refl; simpl; auto.
     + rewrite Znth_pos_cons in Hi; [|lia].
       rewrite Znth_pos_cons; [|lia].
@@ -371,8 +371,8 @@ Lemma make_shares_sub : forall i lasts shs sh0 sh1 sh2 (Hlen : Zlength shs >= Zl
   (Hsh1 : sepalg_list.list_join sh0 shs sh1) (Hsh2 : sepalg_list.list_join sh0 (make_shares shs lasts i) sh2),
   sepalg.join_sub sh2 sh1.
 Proof.
-  induction lasts; destruct shs; simpl; intros; rewrite ?Zlength_nil, ?Zlength_cons in *;
-    try (rewrite Zlength_correct in *; lia).
+  induction lasts; destruct shs; simpl; intros; rewrite -> ?Zlength_nil, ?Zlength_cons in *;
+    try (rewrite -> Zlength_correct in *; lia).
   - inv Hsh1; inv Hsh2; apply sepalg.join_sub_refl.
   - inversion Hsh1 as [|????? Hj1 Hj2]; inv Hsh2.
     destruct (sepalg_list.list_join_assoc1 Hj1 Hj2) as (? & ? & ?); eexists; eauto.
@@ -395,8 +395,8 @@ Lemma make_shares_join : forall i lasts shs sh0 j sh1 sh2
   (Hj : Znth j lasts = i),
   exists sh', sepalg.join sh2 (Znth j shs) sh'.
 Proof.
-  induction lasts; destruct shs; simpl; intros; rewrite ?Zlength_nil, ?Zlength_cons in *;
-    try (rewrite Zlength_correct in *; lia); try lia.
+  induction lasts; destruct shs; simpl; intros; rewrite -> ?Zlength_nil, ?Zlength_cons in *;
+    try (rewrite -> Zlength_correct in *; lia); try lia.
   { rewrite Znth_overflow in Hj; [|rewrite Zlength_nil; lia].
     inv Hsh2.
     exploit (Znth_In j (t :: shs)); [rewrite Zlength_cons; auto|].
@@ -429,8 +429,8 @@ Lemma make_shares_join' : forall i lasts shs sh0 j sh1 sh2
   (Hin : 0 <= j < Zlength shs) (Hout : Zlength lasts <= j),
   exists sh', sepalg.join sh2 (Znth j shs) sh'.
 Proof.
-  induction lasts; destruct shs; simpl; intros; rewrite ?Zlength_nil, ?Zlength_cons in *;
-    try (rewrite Zlength_correct in *; lia); try lia.
+  induction lasts; destruct shs; simpl; intros; rewrite -> ?Zlength_nil, ?Zlength_cons in *;
+    try (rewrite -> Zlength_correct in *; lia); try lia.
   { inv Hsh2.
     exploit (Znth_In j (t :: shs)); [rewrite Zlength_cons; auto|].
     intro Hin'; apply in_split in Hin'.
@@ -449,11 +449,11 @@ Proof.
 Qed.
 
 Lemma data_at_buffer_cohere : forall sh1 sh2 v1 v2 p, readable_share sh1 ->
-  data_at sh1 tbuffer v1 p * data_at sh2 tbuffer v2 p |--
-  data_at sh1 tbuffer v1 p * data_at sh2 tbuffer v1 p.
+  data_at sh1 tbuffer v1 p ∗ data_at sh2 tbuffer v2 p ⊢
+  data_at sh1 tbuffer v1 p ∗ data_at sh2 tbuffer v1 p.
 Proof.
   intros; unfold data_at, field_at, at_offset; Intros.
-  apply andp_right; [apply prop_right; auto|].
+  apply bi.and_intro; first auto.
   rewrite !data_at_rec_eq; unfold withspacer, at_offset; simpl.
   rewrite !data_at_rec_eq; simpl.
   apply mapsto_value_cohere; auto.
@@ -464,6 +464,22 @@ Proof.
 intros. destruct al; reflexivity.
 Qed.
 
+Lemma upd_Znth_sep : forall i l (P : mpred), 0 <= i < Zlength l ->
+  P ∗ [∗] (upd_Znth i l emp) ⊣⊢ [∗] (upd_Znth i l P).
+Proof.
+  intros; iSplit.
+  - rewrite big_sepL_insert_acc; last by (apply Znth_lookup; rewrite Zlength_upd_Znth).
+    rewrite upd_Znth_same //.
+    iIntros "(P & _ & H)"; iSpecialize ("H" with "P").
+    rewrite list_insert_upd; last by rewrite Zlength_upd_Znth.
+    rewrite upd_Znth_twice //.
+  - rewrite big_sepL_insert_acc; last by (apply Znth_lookup; rewrite Zlength_upd_Znth).
+    rewrite upd_Znth_same //.
+    iIntros "($ & H)"; iSpecialize ("H" $! emp with "[]"); first done.
+    rewrite list_insert_upd; last by rewrite Zlength_upd_Znth.
+    rewrite upd_Znth_twice //.
+Qed.
+
 (* The relationship between the last_taken array and the shares held by the writer is
    preserved by the action of the loop body. *)
 Lemma upd_write_shares : forall bufs b b0 lasts shs sh0 (Hb : 0 <= b < B) (Hb0 : 0 <= b0 < B)
@@ -474,23 +490,23 @@ Lemma upd_write_shares : forall bufs b b0 lasts shs sh0 (Hb : 0 <= b < B) (Hb0 :
   (Hbsh' : sepalg_list.list_join sh0 (sublist (Zlength h' + 1) N shs) bsh')
   bsh (Hbsh : sepalg.join bsh' (Znth (Zlength h') shs) bsh),
   (if eq_dec v' (-1) then
-   EX v0 : Z, data_at (Znth (Zlength h') shs) tbuffer (vint v0) (Znth (Znth (Zlength h') lasts) bufs)
-   else !! (v' = b0) && (EX v'0 : Z, data_at (Znth (Zlength h') shs) tbuffer (vint v'0) (Znth b0 bufs))) *
-  ((EX v0 : Z, data_at bsh' tbuffer (vint v0) (Znth b bufs)) *
-  fold_right sepcon emp (upd_Znth b (map (fun a => EX sh : share, !! (if eq_dec a b0 then
+   ∃ v0 : Z, data_at (Znth (Zlength h') shs) tbuffer (vint v0) (Znth (Znth (Zlength h') lasts) bufs)
+   else ⌜v' = b0⌝ ∧ (∃ v'0 : Z, data_at (Znth (Zlength h') shs) tbuffer (vint v'0) (Znth b0 bufs))) ∗
+  ((∃ v0 : Z, data_at bsh' tbuffer (vint v0) (Znth b bufs)) ∗
+  [∗] (upd_Znth b (map (fun a => ∃ sh : share, ⌜if eq_dec a b0 then
     sepalg_list.list_join sh0 (make_shares shs (sublist 0 (Zlength h')
       (map (fun i : Z => if eq_dec (Znth i h') Empty then b0 else Znth i lasts) (upto (Z.to_nat N)))) a) sh
       else if eq_dec a b then sepalg_list.list_join sh0 (sublist (Zlength h') N shs) sh
       else sepalg_list.list_join sh0 (make_shares shs
-      (map (fun i : Z => if eq_dec (Znth i h') Empty then b0 else Znth i lasts) (upto (Z.to_nat N))) a) sh) &&
-      (EX v0 : Z, data_at sh tbuffer (vint v0) (Znth a bufs))) (upto (Z.to_nat B))) emp))
-  |-- fold_right sepcon emp (map (fun a => EX sh : share, !! (if eq_dec a b0 then
+      (map (fun i : Z => if eq_dec (Znth i h') Empty then b0 else Znth i lasts) (upto (Z.to_nat N))) a) sh⌝ ∧
+      (∃ v0 : Z, data_at sh tbuffer (vint v0) (Znth a bufs))) (upto (Z.to_nat B))) emp))
+  ⊢ [∗] (map (fun a => ∃ sh : share, ⌜if eq_dec a b0 then
         sepalg_list.list_join sh0 (make_shares shs (sublist 0 (Zlength h' + 1)
           (map (fun i : Z => if eq_dec (Znth i (h' ++ [vint v'])) Empty then b0 else Znth i lasts) (upto (Z.to_nat N)))) a) sh
           else if eq_dec a b then sepalg_list.list_join sh0 (sublist (Zlength h' + 1) N shs) sh
           else sepalg_list.list_join sh0 (make_shares shs
-          (map (fun i : Z => if eq_dec (Znth i (h' ++ [vint v'])) Empty then b0 else Znth i lasts) (upto (Z.to_nat N))) a) sh) &&
-          (EX v0 : Z, data_at sh tbuffer (vint v0) (Znth a bufs))) (upto (Z.to_nat B))).
+          (map (fun i : Z => if eq_dec (Znth i (h' ++ [vint v'])) Empty then b0 else Znth i lasts) (upto (Z.to_nat N))) a) sh⌝ ∧
+          (∃ v0 : Z, data_at sh tbuffer (vint v0) (Znth a bufs))) (upto (Z.to_nat B))).
 Proof.
   intros; set (shi := Znth (Zlength h') shs).
   assert (readable_share shi).
@@ -501,79 +517,72 @@ Proof.
   { intro; match goal with H : ~In b lasts |- _ => contradiction H end; subst b lasti; auto. }
   assert (lasti <> b0) as Hneq0.
   { intro; match goal with H : ~In b0 lasts |- _ => contradiction H end; subst b0 lasti; auto. }
-  set (l0 := upd_Znth b (map (fun a => EX sh : share, !!(if eq_dec a b0 then
+  set (l0 := upd_Znth b (map (fun a => ∃ sh : share, ⌜if eq_dec a b0 then
              sepalg_list.list_join sh0 (make_shares shs (sublist 0 (Zlength h')
                (map (fun i => if eq_dec (Znth i h') Empty then b0 else Znth i lasts) (upto (Z.to_nat N)))) a) sh
            else if eq_dec a b then sepalg_list.list_join sh0 (sublist (Zlength h') N shs) sh
            else sepalg_list.list_join sh0 (make_shares shs (map (fun i => if eq_dec (Znth i h') Empty then b0
-                                           else Znth i lasts) (upto (Z.to_nat N))) a) sh) &&
-          (EX v1 : Z, @data_at CompSpecs sh tbuffer (vint v1) (Znth a bufs))) (upto (Z.to_nat B)))
-          (EX v1 : Z, @data_at CompSpecs bsh' tbuffer (vint v1) (Znth b bufs))).
+                                           else Znth i lasts) (upto (Z.to_nat N))) a) sh⌝ ∧
+          (∃ v1 : Z, data_at(cs := CompSpecs) sh tbuffer (vint v1) (Znth a bufs))) (upto (Z.to_nat B)))
+          (∃ v1 : Z, data_at(cs := CompSpecs) bsh' tbuffer (vint v1) (Znth b bufs))).
   assert (Zlength l0 = B).
-  { subst l0; rewrite upd_Znth_Zlength; rewrite Zlength_map, Zlength_upto; auto. }
+  { subst l0; rewrite upd_Znth_Zlength; rewrite Zlength_map Zlength_upto; auto. }
   assert (0 <= lasti < B).
   { apply Forall_Znth; auto; lia. }
-  apply derives_trans with (fold_right sepcon emp (
+  apply derives_trans with ([∗] (
     if eq_dec v' (-1) then upd_Znth lasti l0
-            (EX sh : share, !!(exists sh', sepalg_list.list_join sh0 (make_shares shs
+            (∃ sh : share, ⌜exists sh', sepalg_list.list_join sh0 (make_shares shs
              (map (fun i => if eq_dec (Znth i h') Empty then b0 else Znth i lasts) (upto (Z.to_nat N))) lasti) sh' /\
-             sepalg.join sh' shi sh) &&
-            (EX v1 : Z, @data_at CompSpecs sh tbuffer (vint v1) (Znth lasti bufs)))
-          else upd_Znth b0 l0 (EX sh : share, !!(exists sh', sepalg_list.list_join sh0 (make_shares shs
+             sepalg.join sh' shi sh⌝ ∧
+            (∃ v1 : Z, data_at(cs := CompSpecs) sh tbuffer (vint v1) (Znth lasti bufs)))
+          else upd_Znth b0 l0 (∃ sh : share, ⌜exists sh', sepalg_list.list_join sh0 (make_shares shs
             (sublist 0 (Zlength h') (map (fun i => if eq_dec (Znth i h') Empty then b0 else Znth i lasts)
-            (upto (Z.to_nat N)))) b0) sh' /\ sepalg.join sh' shi sh) &&
-            (EX v1 : Z, @data_at CompSpecs sh tbuffer (vint v1) (Znth b0 bufs))))).
-  { rewrite replace_nth_sepcon. 2 : {
+            (upto (Z.to_nat N)))) b0) sh' /\ sepalg.join sh' shi sh⌝ ∧
+            (∃ v1 : Z, data_at(cs := CompSpecs) sh tbuffer (vint v1) (Znth b0 bufs))))).
+  { rewrite upd_Znth_sep. 2 : {
       rewrite Zlength_map.
       rewrite Zlength_upto.
       lia.
     }
     destruct (eq_dec v' (-1)).
-    - rewrite extract_nth_sepcon with (i := lasti); [|subst l0; lia].
+    - rewrite (big_sepL_insert_acc _ _ (Z.to_nat lasti)).
+      2: { apply Znth_lookup. subst l0; rewrite H0 //. }
       erewrite upd_Znth_diff, Znth_map, Znth_upto; rewrite ?Z2Nat.id; auto; try lia.
       destruct (eq_dec lasti b0); [contradiction Hneq0; auto|].
       destruct (eq_dec lasti b); [contradiction Hneq; auto|].
       Intros v1 ish v2.
-      rewrite <- sepcon_assoc.
-      eapply derives_trans; [apply sepcon_derives; [apply data_at_buffer_cohere; auto | apply derives_refl]|].
+      sep_apply data_at_buffer_cohere.
       assert (exists sh', sepalg.join ish shi sh') as (sh' & ?).
       { eapply make_shares_join; eauto.
-        + setoid_rewrite Hshs; rewrite Zlength_map, Zlength_upto, Z2Nat.id; lia.
+        + setoid_rewrite Hshs; rewrite Zlength_map Zlength_upto Z2Nat.id; lia.
         + setoid_rewrite Hshs; auto.
-        + rewrite Znth_map by (rewrite Zlength_upto, Z2Nat.id; lia).
-            rewrite Znth_upto by (rewrite ?Z2Nat.id; lia).
+        + rewrite -> Znth_map by (rewrite Zlength_upto Z2Nat.id; lia).
+            rewrite -> Znth_upto by (rewrite ?Z2Nat.id; lia).
             rewrite Znth_overflow; auto; lia. }
       erewrite data_at_share_join; [|eapply sepalg.join_comm; eauto].
-      rewrite (extract_nth_sepcon (upd_Znth lasti l0 (EX sh : share, _)) lasti); [|rewrite upd_Znth_Zlength; lia].
-      rewrite upd_Znth_twice; [|lia].
-      apply sepcon_derives; [|apply derives_refl].
-      rewrite upd_Znth_same; [|lia].
-      Exists sh'; apply andp_right; [|Exists v1; auto].
-      apply prop_right; eauto.
+      setoid_rewrite list_insert_upd; last by subst l0; rewrite H0.
+      iIntros "(d & H)"; iApply "H".
+      iExists sh'; iSplit; eauto.
     - Intros; subst.
-      rewrite extract_nth_sepcon with (i := b0); [|subst l0; lia].
+      rewrite (big_sepL_insert_acc _ _ (Z.to_nat b0)).
+      2: { apply Znth_lookup. subst l0; rewrite H0 //. }
       erewrite upd_Znth_diff, Znth_map, Znth_upto; rewrite ?Z2Nat.id; auto; try lia.
-      destruct (eq_dec b0 b0); [|contradiction n0; auto]. clear e.
+      if_tac; last done.
       Intros v1 ish v2.
-      rewrite <- sepcon_assoc.
-      eapply derives_trans; [apply sepcon_derives; [apply data_at_buffer_cohere; auto | apply derives_refl]|].
+      sep_apply data_at_buffer_cohere.
       assert (exists sh', sepalg.join ish shi sh') as (sh' & ?).
       { eapply make_shares_join'; try eassumption.
-        + setoid_rewrite Hshs; rewrite Zlength_sublist; rewrite ?Zlength_map, ?Zlength_upto, ?Z2Nat.id; lia.
+        + setoid_rewrite Hshs; rewrite Zlength_sublist; rewrite ?Zlength_map ?Zlength_upto ?Z2Nat.id; lia.
         + setoid_rewrite Hshs; auto.
-        + rewrite Zlength_sublist; rewrite ?Zlength_map, ?Zlength_upto, ?Z2Nat.id; lia. }
+        + rewrite Zlength_sublist; rewrite ?Zlength_map ?Zlength_upto ?Z2Nat.id; lia. }
       erewrite data_at_share_join; [|eapply sepalg.join_comm; eauto].
-      rewrite (extract_nth_sepcon (upd_Znth b0 l0 (EX sh : share, _)) b0); [|rewrite upd_Znth_Zlength; lia].
-      rewrite upd_Znth_twice; [|lia].
-      apply sepcon_derives; [|apply derives_refl].
-      rewrite upd_Znth_same; [|lia].
-      Exists sh'; apply andp_right; [|Exists v1; auto].
-      apply prop_right; eauto. }
-  apply derives_refl'; f_equal.
-  match goal with |- ?l = _ => assert (Zlength l = B) as Hlen end.
-  { destruct (eq_dec v' (-1)); auto; rewrite upd_Znth_Zlength; auto; lia. }
-  apply Znth_eq_ext.
-  { rewrite Hlen, Zlength_map, Zlength_upto; auto. }
+      setoid_rewrite list_insert_upd; last by subst l0; rewrite H0.
+      iIntros "(d & H)"; iApply "H".
+      iExists sh'; iSplit; eauto. }
+  f_equiv.
+  match goal with |- Forall2 _ ?l _ => assert (Zlength l = B) as Hlen end.
+  { destruct (eq_dec v' (-1)); auto; rewrite upd_Znth_Zlength H0 //. }
+  rewrite Forall2_forall_Znth; split; first done.
   rewrite Hlen; intros j ?.
   assert (0 <= j <= B) by lia.
   erewrite Znth_map, Znth_upto; auto.
@@ -584,284 +593,257 @@ Proof.
       destruct (eq_dec lasti b); [contradiction Hneq; auto|].
       exploit (make_shares_add lasti b0 (map (fun i => if eq_dec (Znth i h') Empty then b0
         else Znth i lasts) (upto (Z.to_nat N))) (Zlength h') shs); auto.
-      { erewrite Znth_map, Znth_upto; rewrite ?Zlength_upto, ?Z2Nat.id; try lia.
+      { erewrite Znth_map, Znth_upto; rewrite ?Zlength_upto ?Z2Nat.id; try lia.
         rewrite Znth_overflow; [|lia].
         destruct (eq_dec Vundef Empty); [discriminate | auto]. }
-      { setoid_rewrite Hshs; rewrite Zlength_map, Zlength_upto, Z2Nat.id; lia. }
+      { setoid_rewrite Hshs; rewrite Zlength_map Zlength_upto Z2Nat.id; lia. }
       simpl; intros (shsa & shsb & Hshs1 & Hshs2).
-      f_equal; extensionality; f_equal; f_equal.
+      f_equiv; intros ?; f_equiv; f_equiv.
       rewrite Hshs1.
       erewrite make_shares_ext, Hshs2.
-      apply prop_ext; split.
       * intros (? & Hj1 & Hj2).
         apply sepalg_list.list_join_comm.
         apply sepalg.join_comm in Hj2; destruct (sepalg_list.list_join_assoc2 Hj1 Hj2) as (? & ? & ?).
         econstructor. apply sepalg.join_comm; eassumption.
         apply sepalg_list.list_join_comm; auto.
-      * intro Hj; apply sepalg_list.list_join_comm in Hj.
-        inversion Hj as [|????? Hj1 Hj2]; subst.
-        apply sepalg.join_comm in Hj1; destruct (sepalg_list.list_join_assoc1 Hj1 Hj2) as (? & ? & ?).
-        do 2 eexists. apply sepalg_list.list_join_comm; eassumption. apply sepalg.join_comm; eassumption.
       * rewrite upd_Znth_Zlength; rewrite !Zlength_map; auto.
-      * rewrite Zlength_map, Zlength_upto; intros.
-        rewrite Znth_map, Znth_upto; try lia; try assumption.
+      * rewrite Zlength_map Zlength_upto; intros.
+        rewrite -> Znth_map, Znth_upto; try lia; try assumption.
         destruct (zlt j (Zlength h')); [|destruct (eq_dec j (Zlength h'))].
-        -- rewrite app_Znth1, upd_Znth_diff; auto; try lia.
-           erewrite Znth_map, Znth_upto; auto. reflexivity.
-        -- subst; rewrite Znth_app1, eq_dec_refl, upd_Znth_same; auto; reflexivity.
-        -- rewrite Znth_overflow, upd_Znth_diff; auto; [|rewrite Zlength_app, Zlength_cons, Zlength_nil; lia].
+        -- rewrite -> app_Znth1, upd_Znth_diff; auto; try lia.
+           erewrite Znth_map, Znth_upto; auto.
+        -- subst; rewrite -> Znth_app1, eq_dec_refl, upd_Znth_same; auto; reflexivity.
+        -- rewrite -> Znth_overflow, upd_Znth_diff; auto; [|rewrite Zlength_app Zlength_cons Zlength_nil; lia].
            erewrite Znth_map, Znth_upto; auto; try lia.
-           rewrite Znth_overflow with (al := h'); [reflexivity | lia].
-    + subst l0; rewrite 2upd_Znth_diff; auto; try lia.
+           rewrite -> Znth_overflow with (al := h'); [reflexivity | lia].
+    + subst l0; rewrite -> 2upd_Znth_diff; auto; try lia.
       erewrite Znth_map, Znth_upto; try assumption.
       destruct (eq_dec lasti b0); [contradiction Hneq0; auto|].
       destruct (eq_dec lasti b); [contradiction Hneq; auto|].
       simpl; erewrite make_shares_ext; eauto.
-      rewrite Zlength_map, Zlength_upto; intros.
+      rewrite Zlength_map Zlength_upto; intros.
       erewrite Znth_map, Znth_map, !Znth_upto; auto; try lia.
       destruct (zlt j (Zlength h')); [|destruct (eq_dec j (Zlength h'))].
       * rewrite app_Znth1; auto; lia.
-      * subst; rewrite Znth_overflow, Znth_app1; auto.
+      * subst; rewrite -> Znth_overflow, Znth_app1; auto.
         destruct (eq_dec Vundef Empty); [discriminate|].
         destruct (eq_dec (vint v') Empty); [contradiction n | reflexivity].
         apply Empty_inj; auto; apply repable_buf; auto.
-      * rewrite Znth_overflow, Znth_overflow with (al := h' ++ [vint v']); auto; [reflexivity|].
-        rewrite Zlength_app, Zlength_cons, Zlength_nil; lia.
+      * rewrite -> Znth_overflow, Znth_overflow with (al := h' ++ [vint v']); auto.
+        rewrite Zlength_app Zlength_cons Zlength_nil; lia.
   - assert (Zlength (sublist 0 (Zlength h') (map (fun i : Z => if eq_dec (Znth i h') Empty then b0
       else Znth i lasts) (upto (Z.to_nat N)))) = Zlength h') as Hlenh.
     { rewrite Zlength_sublist; try lia.
-      rewrite Zlength_map, Zlength_upto, Z2Nat.id; lia. }
+      rewrite Zlength_map Zlength_upto Z2Nat.id; lia. }
     assert (Zlength (sublist 0 (Zlength h') (map (fun i : Z => if eq_dec (Znth i (h' ++ [vint v'])) Empty
       then b0 else Znth i lasts) (upto (Z.to_nat N)))) = Zlength h') as Hlenh'.
     { rewrite Zlength_sublist; try lia.
-      rewrite Zlength_map, Zlength_upto, Z2Nat.id; lia. }
+      rewrite Zlength_map Zlength_upto Z2Nat.id; lia. }
     simpl in *.
     destruct (eq_dec v' (-1)).
-    + assert (EX sh : share, !! sepalg_list.list_join sh0 (make_shares shs (sublist 0 (Zlength h')
+    + assert ((∃ sh : share, ⌜sepalg_list.list_join sh0 (make_shares shs (sublist 0 (Zlength h')
           (map (fun i : Z => if eq_dec (Znth i h') Empty then b0 else Znth i lasts) (upto (Z.to_nat N)))) b0)
-          sh && (EX v1 : Z, data_at sh tbuffer (vint v1) (Znth b0 bufs)) =
-        EX sh : share, !! sepalg_list.list_join sh0 (make_shares shs (sublist 0 (Zlength h' + 1)
+          sh⌝ ∧ (∃ v1 : Z, data_at sh tbuffer (vint v1) (Znth b0 bufs))) ⊢
+        ∃ sh : share, ⌜sepalg_list.list_join sh0 (make_shares shs (sublist 0 (Zlength h' + 1)
           (map (fun i : Z => if eq_dec (Znth i (h' ++ [vint v'])) Empty then b0 else Znth i lasts)
-          (upto (Z.to_nat N)))) b0) sh && (EX v0 : Z, data_at sh tbuffer (vint v0) (Znth b0 bufs))).
+          (upto (Z.to_nat N)))) b0) sh⌝ ∧ (∃ v0 : Z, data_at sh tbuffer (vint v0) (Znth b0 bufs))).
       { erewrite sublist_split with (mid := Zlength h')(hi := Zlength h' + 1), sublist_len_1, Znth_map, Znth_upto;
-          auto; rewrite ?Zlength_map, ?Zlength_upto, ?Z2Nat.id; try lia.
+          auto; rewrite -> ?Zlength_map, ?Zlength_upto, ?Z2Nat.id; try lia.
         rewrite Znth_app1; auto.
-        subst; rewrite eq_dec_refl, make_shares_app; simpl.
-        rewrite eq_dec_refl, app_nil_r.
+        subst; rewrite -> eq_dec_refl, make_shares_app; simpl.
+        rewrite -> eq_dec_refl, app_nil_r.
         erewrite make_shares_ext; eauto; [lia|].
         rewrite Hlenh; intros; erewrite !Znth_sublist, Znth_map, Znth_map, !Znth_upto; auto;
           rewrite ?Zlength_upto; simpl; try (unfold N in *; lia).
         rewrite app_Znth1; [reflexivity | lia].
-        { setoid_rewrite Hshs; rewrite Hlenh', Zlength_cons, Zlength_nil; lia. } }
-      destruct (eq_dec lasti (-1)); subst l0; [rewrite upd_Znth_diff | rewrite 2upd_Znth_diff]; auto; try lia;
-        erewrite Znth_map, Znth_upto; auto; destruct (eq_dec b0 b0); auto; absurd (b0 = b0); auto.
+        { setoid_rewrite Hshs; rewrite -> Hlenh', Zlength_cons, Zlength_nil; lia. } }
+      destruct (eq_dec lasti (-1)); subst l0; [rewrite upd_Znth_diff | rewrite -> 2upd_Znth_diff]; auto; try lia;
+        erewrite Znth_map, Znth_upto; auto; if_tac; done.
     + rewrite upd_Znth_same; [|lia].
       erewrite sublist_split with (mid := Zlength h')(hi := Zlength h' + 1), sublist_len_1, Znth_map, Znth_upto;
-        auto; rewrite ?Zlength_map, ?Zlength_upto, ?Z2Nat.id; simpl; try (unfold N in *; lia).
+        auto; rewrite -> ?Zlength_map, ?Zlength_upto, ?Z2Nat.id; simpl; try (unfold N in *; lia).
       rewrite Znth_app1; auto.
       destruct (eq_dec (vint v') Empty).
       { contradiction n0; apply Empty_inj; auto; apply repable_buf; auto. }
       rewrite make_shares_app; simpl.
       destruct (eq_dec _ b0); [contradiction n; auto|].
-      rewrite hd_Znth', Znth_sublist; rewrite ?Hlenh'; try setoid_rewrite Hshs; try lia.
-      f_equal; extensionality; f_equal; f_equal.
+      rewrite -> hd_Znth', Znth_sublist; rewrite ?Hlenh'; try setoid_rewrite Hshs; try lia.
+      f_equiv; intros ?; f_equiv; f_equiv.
       erewrite make_shares_ext.
-      apply prop_ext; split.
       * intros (? & Hj1 & Hj2).
         apply sepalg.join_comm in Hj2; destruct (sepalg_list.list_join_assoc2 Hj1 Hj2) as (? & ? & ?).
         apply sepalg_list.list_join_comm; econstructor; try eassumption. apply sepalg.join_comm; eauto.
-      * intro Hj; apply sepalg_list.list_join_comm in Hj; inversion Hj as [|????? Hj1 Hj2]; subst.
-        apply sepalg.join_comm in Hj1; destruct (sepalg_list.list_join_assoc1 Hj1 Hj2) as (? & ? & ?).
-        do 2 eexists; eauto. apply sepalg.join_comm; eauto.
       * lia.
       * rewrite Hlenh; intros; erewrite !Znth_sublist, Znth_map, Znth_map, !Znth_upto;
           rewrite ?Zlength_upto; simpl; try (unfold N in *; lia).
         rewrite app_Znth1; [reflexivity | lia].
-      * rewrite Hlenh', Zlength_cons, Zlength_nil; setoid_rewrite Hshs; lia.
+      * rewrite Hlenh' Zlength_cons Zlength_nil; setoid_rewrite Hshs; lia.
   - transitivity (Znth j l0).
     { destruct (eq_dec v' (-1)); rewrite upd_Znth_diff; auto; lia. }
     subst l0.
     destruct (eq_dec j b).
     + subst; rewrite upd_Znth_same; auto.
-      apply pred_ext.
-      * Exists bsh'; entailer!.
-      * Intros sh.
-        assert (sh = bsh') by (eapply sepalg_list.list_join_eq; eauto; apply HshP).
-        subst; auto.
     + rewrite upd_Znth_diff; auto.
       erewrite Znth_map, Znth_upto; auto.
       destruct (eq_dec j b0); [contradiction n0; auto|].
       destruct (eq_dec j b); [contradiction n1; auto|].
       simpl; erewrite make_shares_ext; eauto.
-      rewrite Zlength_map, Zlength_upto; intros.
+      rewrite -> Zlength_map, Zlength_upto; intros.
       erewrite Znth_map, Znth_map, !Znth_upto; auto; try lia.
       destruct (zlt j0 (Zlength h')); [|destruct (eq_dec j0 (Zlength h'))].
       * rewrite app_Znth1; auto; lia.
-      * subst; rewrite Znth_overflow, Znth_app1; auto.
+      * subst; rewrite -> Znth_overflow, Znth_app1; auto.
         destruct (eq_dec Vundef Empty); [discriminate|].
         destruct (eq_dec (vint v') Empty); [|reflexivity].
         split; intro; subst; tauto.
-      * rewrite Znth_overflow, Znth_overflow with (al := h' ++ [vint v']); auto; [reflexivity|].
-        rewrite Zlength_app, Zlength_cons, Zlength_nil; lia.
+      * rewrite -> Znth_overflow, Znth_overflow with (al := h' ++ [vint v']); auto.
+        rewrite Zlength_app Zlength_cons Zlength_nil; lia.
+Qed.
+
+Lemma map_add_empty : forall (h : hist), (h : gmap.gmapR _ (exclR (leibnizO _))) ⋅ ∅ = h.
+Proof.
+  intros.
+  apply (gmap.gmapO_leibniz(A := exclO (leibnizO _))); first apply _.
+  apply right_id.
+  apply (uora_unit_right_id(A := gmap.gmapUR nat (exclR (leibnizO AE_hist_el)))).
 Qed.
 
 Lemma body_finish_write : semax_body Vprog Gprog f_finish_write finish_write_spec.
 Proof.
   start_function. simpl map.
-  rewrite sepcon_map; Intros.
+  rewrite big_sep_map; Intros.
   forward.
   forward.
   assert (N < Int.max_signed) by computable.
   assert_PROP (Zlength (map (fun i => vint i) lasts) = N) by entailer!.
-  rewrite Zlength_map in *.
-  forward_for_simple_bound N (EX i : Z, PROP ( )
+  rewrite -> Zlength_map in *.
+  forward_for_simple_bound N (∃ i : Z, PROP ( )
    LOCAL (temp _w (vint b); temp _last (vint b0); gvars gv)
    SEP (data_at Ews tint (vint b) (gv _writing); data_at Ews tint (vint b0) (gv _last_given);
-        data_at sh1 (tarray (tptr tint) N) comms (gv _comm); data_at sh1 (tarray (tptr t_lock) N) (map ptr_of locks) (gv _lock);
-        EX t' : list nat, EX h' : list val, !!(Zlength t' = i /\ Zlength h' = i /\ Forall2 newer (sublist 0 i h) t') &&
-          fold_right sepcon emp (map (fun r => comm_loc lsh (Znth r locks) (Znth r comms)
+        data_at sh1 (tarray (tptr t_atom_int) N) comms (gv _comm);
+        ∃ t' : list nat, ∃ h' : list val, ⌜Zlength t' = i /\ Zlength h' = i /\ Forall2 newer (sublist 0 i h) t'⌝ ∧
+          [∗] (map (fun r => comm_loc lsh (Znth r comms)
             (Znth r g) (Znth r g0) (Znth r g1) (Znth r g2) bufs (Znth r shs)
-            gsh2 (map_add (Znth r h) (if zlt r i then singleton (Znth r t') (AE (Znth r h') (vint b)) else empty_map)))
-            (upto (Z.to_nat N))) *
+            ((Znth r h : gmap.gmapR _ (exclR (leibnizO _))) ⋅ (if zlt r i then {[Znth r t' := Excl (AE (Znth r h') (vint b))]} else ∅)))
+            (upto (Z.to_nat N))) ∗
           let lasts' := map (fun i => if eq_dec (Znth i h') Empty then b0 else Znth i lasts)
                             (upto (Z.to_nat N)) in
-            data_at Ews (tarray tint N) (map (fun i => vint i) lasts') (gv _last_taken) *
-            fold_right sepcon emp (map (fun r =>
-              ghost_var gsh1 (vint (if zlt r i then b else b0)) (Znth r g1)) (upto (Z.to_nat N))) *
-            fold_right sepcon emp (map (fun r =>
-              ghost_var gsh1 (vint (@Znth Z (-1) r lasts')) (Znth r g2)) (upto (Z.to_nat N))) *
-            fold_right sepcon emp (map (fun a => EX sh : share,
-              !!(if eq_dec a b0 then sepalg_list.list_join sh0 (make_shares shs (sublist 0 i lasts') a) sh
+            data_at Ews (tarray tint N) (map (fun i => vint i) lasts') (gv _last_taken) ∗
+            [∗] (map (fun r =>
+              ghost_frag (vint (if zlt r i then b else b0)) (Znth r g1)) (upto (Z.to_nat N))) ∗
+            [∗] (map (fun r =>
+              ghost_frag (vint (@Znth Z (-1) r lasts')) (Znth r g2)) (upto (Z.to_nat N))) ∗
+            [∗] (map (fun a => ∃ sh : share,
+              ⌜if eq_dec a b0 then sepalg_list.list_join sh0 (make_shares shs (sublist 0 i lasts') a) sh
                  else if eq_dec a b then sepalg_list.list_join sh0 (sublist i N shs) sh
-                 else sepalg_list.list_join sh0 (make_shares shs lasts' a) sh) &&
-              EX v : Z, @data_at CompSpecs sh tbuffer (vint v) (Znth a bufs)) (upto (Z.to_nat B))))).
+                 else sepalg_list.list_join sh0 (make_shares shs lasts' a) sh⌝ ∧
+              ∃ v : Z, data_at(cs := CompSpecs) sh tbuffer (vint v) (Znth a bufs)) (upto (Z.to_nat B))))).
   { Exists (@nil nat) (@nil val).
     replace (map (fun i => if eq_dec (Znth i []) Empty then b0 else Znth i lasts) (upto (Z.to_nat N)))
       with lasts.
     rewrite sublist_nil; entailer!.
-    apply derives_refl'; f_equal; f_equal.
-    { f_equal. f_equal.
-      apply map_ext_in.
-      intros; rewrite In_upto in *.
-      destruct (zlt a 0); [lia | rewrite map_add_empty; auto]. }
-    apply map_ext; intro.
-    f_equal; extensionality; f_equal; f_equal.
-    apply prop_ext.
-    destruct (eq_dec a b0); [|destruct (eq_dec a b); [|reflexivity]].
-    - split; intro Hx; [subst; constructor | inv Hx; auto].
-    - subst; rewrite sublist_same, make_shares_out; auto; try reflexivity.
+    f_equiv; f_equiv.
+    { rewrite Forall2_forall_Znth; split; first done.
+      intros ?; rewrite Zlength_map Zlength_upto.
+      intros ?; rewrite -> !Znth_map, !Znth_upto by (unfold N; rewrite ?Zlength_upto; lia).
+      destruct (zlt i 0); [lia | rewrite map_add_empty //]. }
+    { f_equiv.
+      rewrite Forall2_forall_Znth; split; first done.
+      intros ?; rewrite Zlength_map Zlength_upto.
+      intros ?; rewrite -> !Znth_map, !Znth_upto by (unfold N; rewrite ?Zlength_upto; lia).
+      destruct (zlt i 0); [lia | done]. }
+    f_equiv; first done.
+    f_equiv.
+    rewrite Forall2_forall_Znth; split; first done.
+    intros ?; rewrite Zlength_map Zlength_upto.
+    intros ?; rewrite -> !Znth_map, !Znth_upto by (unfold B, N; rewrite ?Zlength_upto; lia).
+    f_equiv; intros ?; f_equiv; apply bi.pure_mono.
+    destruct (eq_dec i b0); [|destruct (eq_dec i b); auto]; subst.
+    - intros ->; constructor.
+    - rewrite -> sublist_same, make_shares_out; auto; try reflexivity.
       replace (Zlength lasts) with N; auto.
-    - rewrite (list_Znth_eq lasts) at 1.
+    - rewrite {1}(list_Znth_eq lasts).
       replace (length lasts) with (Z.to_nat N).
       apply map_ext.
       intro; rewrite Znth_nil; destruct (eq_dec Vundef Empty); auto; discriminate.
-      { rewrite Zlength_correct in *; rep_lia. } }
+      { rewrite -> Zlength_correct in *; rep_lia. } }
   - assert_PROP (Zlength comms = N) as Hcomms by entailer!.
     Intros t' h'.
     forward.
-    { entailer!.
-      apply Forall_Znth.
-      { rewrite Hcomms; auto. }
-      apply Forall_impl with (P := isptr); auto. }
-    rewrite (extract_nth_sepcon (map _ (upto (Z.to_nat N))) i);
-      [|rewrite Zlength_map; auto].
-    rewrite (@Znth_map _ N); [|rewrite Zlength_upto; auto].
-    rewrite Znth_upto; [|rewrite Z2Nat.id; auto; lia].
+    { assert_PROP (isptr (Znth i comms)); [|entailer!!].
+      go_lower.
+      rewrite (big_sepL_lookup_acc _ _ (Z.to_nat i)); [|apply Znth_lookup; rewrite Zlength_map Zlength_upto //].
+      rewrite Znth_map // Znth_upto //; sep_apply comm_loc_isptr; entailer!!. }
+    lazymatch goal with |-context[[∗] map ?f (upto (Z.to_nat N))] =>
+      gather_SEP ([∗] map f (upto (Z.to_nat N))); evar (P : mpred); replace_SEP 0 P end.
+    { go_lower; apply (big_sepL_insert_acc _ _ (Z.to_nat i)), Znth_lookup.
+      rewrite Zlength_map Zlength_upto //. }
+    subst P; rewrite Znth_map //.
+    rewrite Znth_upto //.
     destruct (zlt i i); [lia | rewrite map_add_empty].
-    rewrite comm_loc_isptr; Intros.
-    assert_PROP (Zlength locks = N).
-    { entailer!. rewrite Zlength_map in *; auto. }
-    assert (0 <= i < Zlength locks) by lia.
-    forward.
-    { rewrite Znth_map by auto; entailer!. }
-    rewrite Znth_map by auto.
-    rewrite (extract_nth_sepcon (map _ (upto (Z.to_nat B))) b); [|rewrite Zlength_map, Zlength_upto; auto].
-    rewrite (@Znth_map _ B), Znth_upto; rewrite ?Zlength_upto, ?Z2Nat.id; auto; try lia.
+    lazymatch goal with |-context[[∗] map ?f (upto 5)] =>
+      gather_SEP ([∗] map f (upto 5)); evar (P : mpred); replace_SEP 0 P end.
+    { go_lower; apply (big_sepL_insert_acc _ _ (Z.to_nat b)), Znth_lookup.
+      rewrite Zlength_map Zlength_upto //. }
+    subst P; simpl; rewrite Znth_map //.
+    rewrite Znth_upto //.
     Intros bsh.
-    destruct (eq_dec b b0); [absurd (b = b0); auto|].
+    destruct (eq_dec b b0); first done.
     match goal with H : if eq_dec b b then _ else _ |- _ => rewrite eq_dec_refl in H end.
     match goal with H : sepalg_list.list_join _ (sublist i N shs) _ |- _ =>
-      rewrite sublist_split with (mid := i + 1) in H; try lia;
+      rewrite -> sublist_split with (mid := i + 1) in H; try lia;
       apply sepalg_list.list_join_comm, sepalg_list.list_join_unapp in H; destruct H as (bsh' & ? & Hsh) end.
-    rewrite sublist_len_1, <- sepalg_list.list_join_1 in Hsh; [|lia].
-    rewrite (extract_nth_sepcon (map _ (upto (Z.to_nat N))) i); [|rewrite Zlength_map; auto].
-    rewrite (extract_nth_sepcon (map _ (upto (Z.to_nat N))) i); [|rewrite Zlength_map; auto].
-    erewrite !Znth_map; rewrite ?Znth_upto; rewrite ?Znth_upto, ?Zlength_upto; rewrite ?Z2Nat.id; auto; try lia.
-    rewrite Znth_overflow with (al := h'); [|lia].
+    rewrite -> sublist_len_1, <- sepalg_list.list_join_1 in Hsh; [|lia].
+    repeat match goal with |-context[[∗] map ?f ?l] =>
+      gather_SEP ([∗] map f l); evar (P : mpred); replace_SEP 0 P;
+      [go_lower; apply (big_sepL_insert_acc _ _ (Z.to_nat i)), Znth_lookup;
+       rewrite Zlength_map Zlength_upto // | subst P; simpl; rewrite !Znth_map // !Znth_upto //] end.
+    rewrite -> Znth_overflow with (al := h'); [|lia].
     destruct (zlt i i); [clear - l; lia|].
     destruct (eq_dec _ _); [discriminate|].
-    forward_call (lsh, Znth i comms, Znth i g, Znth i locks, vint 0, vint b, Znth i h,
-      fun (h : hist) (v : val) => !!(v = vint b) &&
-        ghost_var gsh1 (vint b0) (Znth i g1) *
-        ghost_var gsh1 (vint (Znth i lasts)) (Znth i g2) *
-        EX v : Z, data_at (Znth i shs) tbuffer (vint v) (Znth b bufs),
-      comm_R bufs (Znth i shs) gsh2 (Znth i g0) (Znth i g1) (Znth i g2),
-        fun (h : hist) (v : val) => EX b' : Z, !!(v = vint b' /\ -1 <= b' < B) &&
-          ghost_var gsh1 (vint b) (Znth i g1) *
-          ghost_var gsh1 (vint (if eq_dec b' (-1) then b0 else Znth i lasts)) (Znth i g2) *
-          if eq_dec b' (-1) then EX v : Z, data_at (Znth i shs) tbuffer (vint v) (Znth (Znth i lasts) bufs)
-          else !!(b' = b0) && EX v' : Z, data_at (Znth i shs) tbuffer (vint v') (Znth b0 bufs)).
+    forward_call AE_sub (lsh, Znth i comms, Znth i g, vint 0, vint b, Znth i h,
+      fun (h : hist) (v : val) => ⌜v = vint b⌝ ∧
+        ghost_frag (vint b0) (Znth i g1) ∗
+        ghost_frag (vint (Znth i lasts)) (Znth i g2) ∗
+        ∃ v : Z, data_at (Znth i shs) tbuffer (vint v) (Znth b bufs),
+      comm_R bufs (Znth i shs) (Znth i g0) (Znth i g1) (Znth i g2),
+        fun (h : hist) (v : val) => ∃ b' : Z, ⌜v = vint b' /\ -1 <= b' < B⌝ ∧
+          ghost_frag (vint b) (Znth i g1) ∗
+          ghost_frag (vint (if eq_dec b' (-1) then b0 else Znth i lasts)) (Znth i g2) ∗
+          if eq_dec b' (-1) then ∃ v : Z, data_at (Znth i shs) tbuffer (vint v) (Znth (Znth i lasts) bufs)
+          else ⌜b' = b0⌝ ∧ ∃ v' : Z, data_at (Znth i shs) tbuffer (vint v') (Znth b0 bufs)).
     { unfold comm_loc; cancel.
-      rewrite prop_true_andp by auto; cancel.
-      rewrite (sepcon_comm _ (EX v : Z, _)), !sepcon_assoc.
-      eapply derives_trans; [apply sepcon_derives, derives_refl|].
-      { instantiate (1 := (EX v : Z, data_at bsh' tbuffer (vint v) (Znth b bufs)) *
-          (EX v : Z, data_at (Znth i shs) tbuffer (vint v) (Znth b bufs))).
-         Intro v0; Exists v0 v0; rewrite (data_at_share_join _ _ _ _ _ _ Hsh); auto. }
+      rewrite bi.pure_True // bi.True_and; cancel.
+      assert ((∃ v, data_at bsh tbuffer (vint v) (Znth b bufs)) ⊢
+        (∃ v, data_at bsh' tbuffer (vint v) (Znth b bufs)) ∗ (∃ v, data_at (Znth i shs) tbuffer (vint v) (Znth b bufs))) as ->.
+      { Intro v0; Exists v0 v0; rewrite (data_at_share_join _ _ _ _ _ _ Hsh); auto. }
       cancel.
-      rewrite <- emp_sepcon at 1; apply sepcon_derives; [|cancel].
+      rewrite <- bi.emp_sep; apply bi.sep_mono; last cancel.
       unfold AE_spec.
-      apply allp_right; intro hc.
-      apply allp_right; intro hx.
-      apply allp_right; intro vc.
-      apply allp_right; intro vx.
-      rewrite <- imp_andp_adjoint; Intros.
-      rewrite <- wand_sepcon_adjoint, emp_sepcon; Intros.
-      Intros.
-      unfold comm_R at 1 2.
-      rewrite rev_app_distr; simpl.
-      rewrite last_two_reads_cons, prev_taken_cons.
+      iIntros "_" (???? (? & ? & ?)) "(>comm & % & g1 & g2 & buf)".
+      unfold comm_R.
+      rewrite rev_app_distr /=.
+      rewrite last_two_reads_cons prev_taken_cons.
       assert (repable_signed b) by (apply repable_buf; lia).
       destruct (eq_dec vc Empty).
       { subst; assert (b = -1) by (apply Empty_inj; auto); lia. }
-      Intros b' b1 b2.
-      apply (derives_trans _ (ghost_var gsh1 (vint b0) (Znth i g1) *
-         ghost_var gsh2 (last_write (rev hx)) (Znth i g1) *
-        ((ghost_var gsh1 (vint (Znth i lasts)) (Znth i g2) *
-         ghost_var gsh2 (prev_taken (rev hx)) (Znth i g2)) *
-        (ghost_var gsh2 (vint b1) (Znth i g0) *
-         (if eq_dec b' (-1) then EX v1 : Z, @data_at CompSpecs (Znth i shs) tbuffer (vint v1) (Znth b2 bufs)
-          else EX v1 : Z, @data_at CompSpecs (Znth i shs) tbuffer (vint v1) (Znth b' bufs)) *
-         (EX v1 : Z, @data_at CompSpecs (Znth i shs) tbuffer (vint v1) (Znth b bufs)))))).
-      { cancel. }
-      assert_PROP (last_write (rev hx) = vint b0) as Hwrite.
-      { apply sepcon_derives_prop; rewrite sepcon_comm; apply ghost_var_inj; auto. }
-      assert_PROP (prev_taken (rev hx) = vint (Znth i lasts)) as Hprev.
-      { rewrite <- sepcon_assoc, (sepcon_comm (_ * _) (_ * ghost_var _ _ _)).
-        do 2 apply sepcon_derives_prop.
-        rewrite sepcon_comm; apply ghost_var_inj; auto. }
-      rewrite <- Hprev, <- Hwrite in *.
-      erewrite !ghost_var_share_join by eauto.
-      eapply derives_trans; [apply sepcon_derives, derives_refl;
-        apply ghost_var_update with (v' := vint b)|].
-      rewrite sepcon_comm, !sepcon_assoc.
-      eapply derives_trans; [apply sepcon_derives, derives_refl; apply ghost_var_update with
-        (v' := if eq_dec b' (-1) then last_write (rev hx) else prev_taken (rev hx))|].
-      rewrite <- !sepcon_assoc, sepcon_comm, <- !sepcon_assoc, 2sepcon_assoc.
-      eapply derives_trans; [apply sepcon_derives, derives_refl; apply bupd_sepcon|].
-      eapply derives_trans; [apply bupd_frame_r | apply bupd_mono].
-      erewrite <- !(ghost_var_share_join _ _ Tsh) by eauto.
-      Exists b b1 b2; entailer!.
+      iDestruct "comm" as (b' b1 b2 (-> & ? & ? & Hlast & ? & ?)) "(a0 & a1 & a2 & buf')".
+      iMod (ghost_var_update with "a1 g1") as "(%Hwrite & a1 & g1)".
+      iMod (ghost_var_update with "a2 g2") as "(%Hprev & a2 & g2)".
+      iIntros "!>". rewrite -bi.later_intro.
+      rewrite bi.sep_exist_r; iExists b.
+      rewrite bi.sep_exist_r; iExists b1.
+      rewrite bi.sep_exist_r; iExists b2.
+      iStopProof; entailer!.
       { rewrite Forall_app; repeat constructor; auto.
         exists b', b; split; [|split]; auto; lia. }
       destruct (eq_dec b (-1)); [lia|].
       Exists b'.
-      rewrite <- exp_sepcon2; cancel.
-      rewrite prop_true_andp by auto.
-      assert (last_two_reads (rev hx) = (vint b1, vint b2)) as Hlast by assumption.
+      rewrite -bi.sep_exist_l -bi.sep_exist_r; ecancel.
+      rewrite bi.pure_True // bi.True_and.
       erewrite take_read, Hlast in *; try (rewrite rev_involutive; eauto).
       unfold last_write in *; simpl in *.
-      rewrite (if_false (vint b = Empty)) by auto.
+      subst; rewrite -> (if_false (vint b = Empty)) by auto.
       assert (Znth (Zlength t') lasts = if eq_dec (vint b') Empty then b2 else b1).
       { assert (repable_signed (Znth (Zlength t') lasts)).
         { apply Forall_Znth; [lia|].
@@ -869,13 +851,12 @@ Proof.
           apply repable_buf; simpl in *; lia. }
         if_tac; apply repr_inj_signed; auto; congruence. }
       destruct (eq_dec (vint b') Empty); subst; simpl; cancel.
-      + assert (b' = -1) by (apply Empty_inj; auto; apply repable_buf; auto).
-        subst; rewrite !eq_dec_refl.
-        rewrite Hwrite; simpl; cancel.
+      + assert (b' = -1) as -> by (apply Empty_inj; auto; apply repable_buf; auto).
+        destruct (eq_dec _ _); last done.
         exploit find_write_read.
-        { rewrite rev_involutive; eauto. }
+        { rewrite -> rev_involutive; eauto. }
         { discriminate. }
-        intros ->; rewrite Hwrite; auto.
+        intros ->; rewrite Hwrite; cancel.
       + assert (exists rest, find_write (rev hx) (vint 0) = (vint b', rest)) as (? & Hwrite').
         { assert (apply_hist (vint 0) hx = Some (vint b')) as Hvx by assumption.
           replace hx with (rev (rev hx)) in Hvx by (apply rev_involutive).
@@ -890,162 +871,159 @@ Proof.
           destruct (apply_hist (vint 0) (rev l)); [simpl in * | discriminate].
           destruct (eq_dec r v); [|discriminate].
           inv Hvx.
-          destruct (eq_dec (vint b') Empty); [absurd (vint b' = Empty); auto | eauto]. }
+          destruct (eq_dec (vint b') Empty); [done | eauto]. }
         rewrite Hwrite' in Hwrite.
-        assert (b' = b0); subst.
+        assert (b' = b0) as ->.
         { apply repr_inj_signed; [apply repable_buf | apply repable_buf | simpl in *; congruence]; auto; lia. }
         destruct (eq_dec b0 (-1)); [subst; contradiction n3; auto|].
         unfold last_two_reads in Hlast; destruct (find_read (rev hx) (vint 1)); inv Hlast.
         simpl; entailer!. }
     Intros x b'; destruct x as (t, v); simpl in *.
-    gather_SEP (AE_loc _ _ _ _ _ _ _) (fold_right _ _ _).
-    replace_SEP 0 (fold_right sepcon emp (map (fun r =>
-      comm_loc lsh (Znth r locks) (Znth r comms) (Znth r g) (Znth r g0)
-        (Znth r g1) (Znth r g2) bufs (Znth r shs) gsh2 (map_add (Znth r h)
-        (if zlt r (i + 1) then singleton (Znth r (t' ++ [t])) (AE (Znth r (h' ++ [v])) (vint b)) else empty_map)))
+    gather_SEP 0 8; replace_SEP 0 ([∗] (map (fun r =>
+      comm_loc lsh (Znth r comms) (Znth r g) (Znth r g0)
+        (Znth r g1) (Znth r g2) bufs (Znth r shs) ((Znth r h : gmap.gmapR _ (exclR (leibnizO _))) ⋅
+        (if zlt r (i + 1) then {[Znth r (t' ++ [t]) := Excl (AE (Znth r (h' ++ [v])) (vint b))]} else ∅)))
       (upto (Z.to_nat N)))).
     { go_lower.
-      rewrite replace_nth_sepcon.
-      2 : { rewrite Zlength_map, Zlength_upto. unfold N in *; simpl in *; lia. }
-      apply sepcon_list_derives; rewrite upd_Znth_Zlength;
-        rewrite !Zlength_map, Zlength_upto; auto.
+      iIntros "(a & H)"; iSpecialize ("H" with "a").
+      rewrite list_insert_upd //.
+      iApply (big_sepL_id_mono' with "H").
+      rewrite Forall2_forall_Znth; rewrite Zlength_upd_Znth Zlength_map Zlength_upto; split; first done.
       intros j ?; destruct (eq_dec j i).
-      + subst; rewrite upd_Znth_same by (rewrite Zlength_map, Zlength_upto; auto).
-        rewrite (@Znth_map _ N), Znth_upto by (auto; lia).
+      + subst; rewrite -> upd_Znth_same by (rewrite -> Zlength_map, Zlength_upto; auto).
+        rewrite -> (@Znth_map _ N), Znth_upto by (auto; lia).
         destruct (zlt (Zlength t') (Zlength t' + 1)); [|lia].
-        rewrite !app_Znth2 by lia.
-        rewrite Zminus_diag; replace (Zlength t') with (Zlength h'); rewrite Zminus_diag, !Znth_0_cons; auto.
-        rewrite map_add_comm, map_add_single; [apply derives_refl|].
-        intros ??? Ht; unfold singleton.
-        if_tac; intro X; inv X.
-        rewrite newer_out in Ht; [discriminate|].
+        rewrite -> !app_Znth2 by lia.
+        rewrite Zminus_diag; replace (Zlength t') with (Zlength h'); rewrite -> Zminus_diag, !Znth_0_cons; auto.
+        rewrite /comm_loc; f_equiv.
+        apply (leibniz_equiv(A := gmap.gmapR _ (exclR (leibnizO _)))).
+        rewrite ora_comm.
+        intros i; rewrite gmap.lookup_op.
+        destruct (eq_dec i t); [subst; rewrite lookup_insert lookup_singleton | rewrite lookup_insert_ne // lookup_singleton_ne // left_id //].
+        rewrite newer_out //.
         replace (Zlength h') with (Zlength t'); auto.
-      + rewrite upd_Znth_diff' by (rewrite ?Zlength_map, ?Zlength_upto; auto).
-        rewrite !(@Znth_map _ N), !Znth_upto by (auto; lia).
-        if_tac; if_tac; rewrite ?map_add_empty; try lia; try apply derives_refl.
-        rewrite !app_Znth1 by lia; apply derives_refl. }
-    gather_SEP (ghost_var _ _ (Znth i g1)) (fold_right sepcon emp (upd_Znth _ _ _)).
-    replace_SEP 0 (fold_right sepcon emp (map (fun r =>
-      ghost_var gsh1 (vint (if zlt r (i + 1) then b else b0)) (Znth r g1)) (upto (Z.to_nat N)))).
-    { go_lowerx.
-      rewrite (extract_nth_sepcon (map _ (upto (Z.to_nat N))) i);
-        [|rewrite Zlength_map, Zlength_upto; auto].
-      erewrite Znth_map, Znth_upto; rewrite ?Zlength_upto, ?Z2Nat.id; simpl; auto;
-        try (unfold N in *; auto; lia).
-      destruct (zlt i (i + 1)); [fast_cancel | lia].
-      apply sepcon_list_derives; rewrite !upd_Znth_Zlength; rewrite !Zlength_map; auto; intros.
-      destruct (eq_dec i0 i); [subst; rewrite !upd_Znth_same by (rewrite ?Zlength_map; auto); auto|].
-      rewrite !upd_Znth_diff' by (rewrite ?Zlength_map; auto).
-      erewrite !Znth_map, !Znth_upto by (auto; rewrite Zlength_upto in *; lia).
-      destruct (zlt i0 i), (zlt i0 (i + 1)); auto; lia. }
-    gather_SEP (ghost_var _ _ (Znth i g2)) (fold_right sepcon emp (upd_Znth _ _ _)).
-    replace_SEP 0 (fold_right sepcon emp (map (fun r =>
-      ghost_var gsh1 (vint (@Znth Z (-1) r (map (fun i0 => if eq_dec (Znth i0 (h' ++ [v])) Empty then b0
+      + rewrite -> upd_Znth_diff' by (rewrite -> ?Zlength_map, ?Zlength_upto; auto).
+        rewrite -> !(@Znth_map _ N), !Znth_upto by (auto; lia).
+        rewrite /comm_loc; f_equiv.
+        if_tac; if_tac; rewrite ?map_add_empty; try lia; try done.
+        rewrite -> !app_Znth1 by lia; done. }
+    gather_SEP 1 5; replace_SEP 0 ([∗] (map (fun r =>
+      ghost_frag (vint (if zlt r (i + 1) then b else b0)) (Znth r g1)) (upto (Z.to_nat N)))).
+    { go_lower.
+      iIntros "(a & H)"; iSpecialize ("H" with "a").
+      rewrite list_insert_upd //.
+      iApply (big_sepL_id_mono' with "H").
+      rewrite Forall2_forall_Znth; rewrite Zlength_upd_Znth Zlength_map Zlength_upto; split; first done.
+      intros j ?; destruct (eq_dec j i).
+      + subst; rewrite upd_Znth_same // Znth_map // Znth_upto //.
+        if_tac; [done | lia].
+      + rewrite upd_Znth_diff' // !Znth_map // Znth_upto //.
+        if_tac; if_tac; try done; lia. }
+    gather_SEP 2 4; replace_SEP 0 ([∗] (map (fun r =>
+      ghost_frag (vint (Znth r (map (fun i0 => if eq_dec (Znth i0 (h' ++ [v])) Empty then b0
         else Znth i0 lasts) (upto (Z.to_nat N))))) (Znth r g2)) (upto (Z.to_nat N)))).
-    { go_lowerx.
-      rewrite (extract_nth_sepcon (map _ (upto (Z.to_nat N))) i);
-        [|rewrite Zlength_map, Zlength_upto; auto].
-      erewrite Znth_map, Znth_upto; rewrite ?Zlength_upto, ?Z2Nat.id; simpl; auto;
-        try (unfold N in *; auto; lia).
-      erewrite Znth_map, Znth_upto by (auto; unfold N in *; simpl; lia).
-      replace i with (Zlength h'); rewrite app_Znth2, Zminus_diag, Znth_0_cons; [fast_cancel | lia].
-      apply sepcon_derives.
-      { destruct (eq_dec v Empty), (eq_dec b' (-1)); auto; subst.
-        + contradiction n1; apply Empty_inj; auto; apply repable_buf; auto.
-        + contradiction n1; auto. }
-      apply sepcon_list_derives; rewrite !upd_Znth_Zlength; rewrite !Zlength_map;
-        try (rewrite !Zlength_upto; simpl; unfold N in *; lia); intros.
-      destruct (eq_dec i0 (Zlength h')); [subst; rewrite !upd_Znth_same by (rewrite ?Zlength_map; auto); auto|].
-      rewrite !upd_Znth_diff' by (rewrite ?Zlength_map, ?Zlength_upto; unfold N in *; simpl; auto; lia).
-      erewrite !Znth_map; rewrite ?Znth_upto; rewrite ?Znth_upto; auto; rewrite Zlength_upto in *; try lia.
-      destruct (zlt i0 (Zlength h')).
-      + rewrite app_Znth1; auto.
-      + rewrite Znth_overflow with (al := h'), Znth_overflow with (al := (h' ++ [v])); auto.
-        rewrite Zlength_app, Zlength_cons, Zlength_nil; lia. }
+    { go_lower.
+      iIntros "(a & H)"; iSpecialize ("H" with "a").
+      rewrite list_insert_upd //.
+      iApply (big_sepL_id_mono' with "H").
+      rewrite Forall2_forall_Znth; rewrite Zlength_upd_Znth Zlength_map Zlength_upto; split; first done.
+      intros j ?; destruct (eq_dec j i).
+      + subst; rewrite upd_Znth_same // !Znth_map // !Znth_upto //.
+        rewrite app_Znth2; last lia.
+        replace (Zlength t') with (Zlength h'); rewrite Zminus_diag Znth_0_cons //.
+        destruct (eq_dec (vint b') Empty), (eq_dec b' (-1)); auto; subst.
+        * contradiction n1; apply Empty_inj; auto; apply repable_buf; auto.
+        * contradiction n1; auto.
+      + rewrite upd_Znth_diff' // !Znth_map // !Znth_upto //.
+        destruct (zlt j (Zlength h')).
+        * rewrite app_Znth1; auto.
+        * rewrite -> Znth_overflow with (al := h'), Znth_overflow with (al := (h' ++ [vint b'])); auto.
+          rewrite -> Zlength_app, Zlength_cons, Zlength_nil; lia. }
     assert (repable_signed b') by (apply repable_buf; auto); subst v.
-    focus_SEP 9.
-    match goal with |- semax _ (PROP () (LOCALx ?Q (SEPx (data_at _ _ ?l (gv _last_taken) :: ?R)))) _ _ =>
+    gather_SEP (data_at _ _ _ (gv _last_taken)).
+    match goal with |- semax _ _ (PROP () (LOCALx ?Q (SEPx (data_at _ _ ?l (gv _last_taken) :: ?R)))) _ _ =>
       forward_if (PROP () (LOCALx Q (SEPx (data_at Ews (tarray tint N)
         (upd_Znth i l (vint (if eq_dec (vint b') Empty then b0 else Znth i lasts))) (gv _last_taken) :: R)))) end.
     + forward.
-      subst. rewrite (if_true (vint b' = Empty)) by (rewrite H21; reflexivity).
+      subst. rewrite -> (if_true (vint b' = Empty)) by (rewrite H17; reflexivity).
       apply ENTAIL_refl.
-    + forward. rewrite neg_repr in H21.
-      rename H21 into n1.
+    + forward. rewrite neg_repr in H17.
+      rename H17 into n1.
       erewrite (upd_Znth_triv i).
       apply ENTAIL_refl.
-      * rewrite !Zlength_map, Zlength_upto; auto.
-      * rewrite !Znth_map, Znth_upto; try (simpl; unfold N in *; lia).
-        rewrite Znth_overflow by lia.
-        rewrite if_false. rewrite if_false; auto.
-        clear - H20 n1. unfold Empty. contradict n1. apply Vint_inj in n1. auto.
-        intro Hx; inv Hx.
-        change (Zlength (upto 3)) with 3. unfold N in *; lia.
-        autorewrite with sublist.     change (Zlength (upto 3)) with 3. unfold N in *; lia.
+      * rewrite !Zlength_map Zlength_upto; auto.
+      * rewrite -> !Znth_map, Znth_upto; [|done..].
+        rewrite -> Znth_overflow by lia.
+        if_tac; first done; if_tac; auto.
+        contradict n1; apply Vint_inj; done.
     + subst.
       Exists (t' ++ [t]) (h' ++ [vint b']).
-      go_lower.
-      repeat (apply andp_right; [apply prop_right; repeat split; auto; lia|]).
-      cancel.
-      rewrite !sepcon_andp_prop'.
-      rewrite Zlength_app, Zlength_cons, Zlength_nil; apply andp_right.
-      { replace (Zlength t') with (Zlength h') in *; apply prop_right; rewrite Zlength_app; repeat (split; auto).
-        rewrite sublist_split with (mid := Zlength h') by lia.
-        rewrite (sublist_one (Zlength h')) by (auto; lia).
+      entailer!.
+      { rewrite !Zlength_app !Zlength_cons !Zlength_nil; split3; [lia..|].
+        replace (Zlength t') with (Zlength h') in *.
+        rewrite -> sublist_split with (mid := Zlength h') by lia.
+        rewrite -> (sublist_one (Zlength h')) by (auto; lia).
         apply Forall2_app; auto. }
-      cancel.
-      rewrite !sepcon_assoc; apply sepcon_derives.
-      * apply derives_refl'; f_equal.
+      rewrite -!bi.sep_exist_l -bi.sep_exist_r.
+      apply bi.sep_mono.
+      * f_equiv.
         erewrite upd_Znth_eq, !map_length, upto_length, !map_map;
-          [|rewrite !Zlength_map, Zlength_upto; unfold N in *; auto].
-        apply map_ext_in; intros; rewrite In_upto in *.
+          [|rewrite -> !Zlength_map, Zlength_upto; unfold N in *; auto].
+        apply map_ext_in; intros; rewrite -> In_upto in *.
         replace (Zlength t') with (Zlength h').
         destruct (Z.eq_dec a (Zlength h')).
-        -- subst; rewrite app_Znth2, Zminus_diag, Znth_0_cons; auto; clear; lia.
-        -- rewrite !Znth_map, Znth_upto; try lia; try assumption.
+        -- subst; rewrite -> app_Znth2, Zminus_diag, Znth_0_cons; auto; clear; lia.
+        -- rewrite -> !Znth_map, Znth_upto; try lia; try assumption.
            destruct (zlt a (Zlength t')); [rewrite app_Znth1 | rewrite Znth_overflow]; auto; try lia.
-           rewrite Znth_overflow with (al := _ ++ _); auto.
-           rewrite Zlength_app, Zlength_cons, Zlength_nil; lia.
-      * simpl; cancel.
-        rewrite !sepcon_assoc; replace (Zlength t') with (Zlength h') in *; eapply upd_write_shares; eauto.
+           rewrite -> Znth_overflow with (al := _ ++ _); auto.
+           rewrite -> Zlength_app, Zlength_cons, Zlength_nil; lia.
+      * iIntros "($ & ? & ? & H)".
+        iSpecialize ("H" $! emp with "[]"); first done.
+        rewrite list_insert_upd //.
+        rewrite -and_exist_l.
+        replace (Zlength t') with (Zlength h') in *; by iApply (upd_write_shares with "[$]").
   - Intros t' h'.
     forward.
     forward.
-    rewrite sublist_nil, sublist_same; rewrite ?Zlength_map; auto.
+    rewrite -> sublist_nil, sublist_same; rewrite ?Zlength_map; auto.
     Exists (map (fun i => if eq_dec (Znth i h') Empty then b0 else Znth i lasts) (upto (Z.to_nat N)))
-      (map (fun '(h, (t, v)) => map_upd h t (AE v (vint b))) (combine h (combine t' h'))); entailer!.
+      (map (fun '(h, (t, v)) => <[t := Excl (AE v (vint b))]>h) (combine h (combine t' h'))); entailer!.
     + repeat split.
-      * rewrite Forall_map, Forall_forall; intros; simpl.
+      * rewrite Forall_map Forall_forall; intros; simpl.
         destruct (eq_dec (Znth x h') Empty); [lia|].
-        rewrite In_upto, Z2Nat.id in *; unfold N; try lia.
+        rewrite -> In_upto, Z2Nat.id in *; unfold N; try lia.
         apply Forall_Znth; [lia | auto].
       * assert (Zlength h' = Zlength h) as Hlen by lia; assert (Zlength t' = Zlength h') as Hlen' by lia;
         clear - Hlen Hlen'; generalize dependent h; generalize dependent t'; induction h';
-          destruct h, t'; rewrite ?Zlength_nil, ?Zlength_cons in *; simpl; intros; auto;
-          try (rewrite Zlength_correct in *; lia).
+          destruct h, t'; rewrite -> ?Zlength_nil, ?Zlength_cons in *; simpl; intros; auto;
+          try (rewrite -> Zlength_correct in *; lia).
         constructor; eauto.
         apply IHh'; lia.
       * rewrite in_map_iff; intros (i & ? & ?); subst.
-        rewrite In_upto, Z2Nat.id in *; try (unfold N; lia).
-        destruct (eq_dec (Znth i h') Empty); [absurd (b0 = b0); auto|].
+        rewrite -> In_upto, Z2Nat.id in *; try (unfold N; lia).
+        destruct (eq_dec (Znth i h') Empty); first done.
         match goal with H : ~In _ lasts |- _ => contradiction H; apply Znth_In; lia end.
-    + rewrite sepcon_map, <- !sepcon_assoc.
-      apply derives_refl'; f_equal; f_equal; [f_equal|].
-      { erewrite map_ext_in; eauto; intros; simpl.
-        rewrite In_upto in *.
+    + rewrite big_sep_map; iIntros "(Hcomm & $ & $ & Hbufs)".
+      iSplitL "Hcomm".
+      * erewrite map_ext_in; eauto; intros; simpl.
+        rewrite -> In_upto in *.
         destruct (zlt a N); [|unfold N in *; simpl in *; lia].
-        rewrite map_add_comm, map_add_single.
-        rewrite Znth_map, !Znth_combine by
+        f_equal.
+        rewrite -> Znth_map, !Znth_combine by
           (rewrite ?Zlength_combine; rewrite ?Z.min_l; rewrite ?Z.min_l; auto; lia); auto.
-        intros ??? Ha; unfold singleton.
-        if_tac; intro X; inv X.
-        rewrite newer_out in Ha; [discriminate|].
-        rewrite sublist_same_gen in H13 by lia.
-        apply Forall2_Znth; auto; lia. }
-      apply map_ext; intro.
-      f_equal; extensionality; f_equal; f_equal; apply prop_ext.
-      destruct (eq_dec a b).
-      * destruct (eq_dec a b0); [absurd (b = b0); subst; auto|].
-        split; intro Hx; [inv Hx; auto | subst; constructor].
-      * destruct (eq_dec a b0); reflexivity.
+        apply (leibniz_equiv(A := gmap.gmapR _ (exclR (leibnizO _)))).
+        rewrite ora_comm.
+        intros i; rewrite gmap.lookup_op.
+        destruct (eq_dec i (Znth a t')); [subst; rewrite lookup_singleton lookup_insert | rewrite lookup_singleton_ne // lookup_insert_ne // left_id //].
+        rewrite newer_out //.
+        apply Forall2_Znth; auto; last lia.
+        erewrite <- (sublist_same_gen _ _ h); first done; lia.
+      * iApply (big_sepL_id_mono' with "Hbufs").
+        rewrite Forall2_forall_Znth; rewrite Zlength_map Zlength_upto; split; first done.
+        intros j ?; rewrite !Znth_map // Znth_upto //.
+        do 4 f_equiv.
+        destruct (eq_dec j b); if_tac; subst; try done.
+        inversion 1; done.
 Qed.
+
+End mpred.
diff --git a/mailbox/verif_mailbox_writer.v b/mailbox/verif_mailbox_writer.v
index a0a773bf30..9b58562c27 100644
--- a/mailbox/verif_mailbox_writer.v
+++ b/mailbox/verif_mailbox_writer.v
@@ -1,6 +1,5 @@
 Require Import mailbox.verif_atomic_exchange.
 Require Import VST.concurrency.conclib.
-Require Import VST.concurrency.ghosts.
 Require Import VST.floyd.library.
 Require Import VST.zlist.sublist.
 Require Import mailbox.mailbox.
@@ -13,100 +12,85 @@ Opaque eq_dec.
 Ltac entailer_for_load_tac ::= unfold tc_efield; go_lower; entailer'.
 Ltac entailer_for_store_tac ::= unfold tc_efield; go_lower; entailer'.
 
+Section mpred.
+
+Context `{!VSTGS unit Σ, AEGS0 : !AEGS t_atom_int, !inG Σ (excl_authR (leibnizO val))}.
+
 Lemma body_writer : semax_body Vprog Gprog f_writer writer_spec.
 Proof.
   start_function.
   assert (B < Int.max_signed) as HB by computable.
   forward_call gv.
   forward.
-  forward_loop (EX v : Z, EX b0 : Z, EX lasts : list Z, EX h : list hist,
+  forward_loop (∃ v : Z, ∃ b0 : Z, ∃ lasts : list Z, ∃ h : list hist,
    PROP (0 <= b0 < B; Forall (fun x => 0 <= x < B) lasts; Zlength h = N; ~In b0 lasts)
    LOCAL (temp _v (vint v); temp _arg arg; gvars gv)
    SEP (data_at Ews tint Empty (gv _writing); data_at Ews tint (vint b0) (gv _last_given);
    data_at Ews (tarray tint N) (map (fun x => vint x) lasts) (gv _last_taken);
-   data_at sh1 (tarray (tptr tint) N) comms (gv _comm); data_at sh1 (tarray (tptr t_lock) N) (map ptr_of locks) (gv _lock);
+   data_at sh1 (tarray (tptr t_atom_int) N) comms (gv _comm);
    data_at sh1 (tarray (tptr tbuffer) B) bufs (gv _bufs);
-   fold_right sepcon emp (map (fun r0 => comm_loc lsh (Znth r0 locks) (Znth r0 comms)
+   [∗] (map (fun r0 => comm_loc lsh (Znth r0 comms)
      (Znth r0 g) (Znth r0 g0) (Znth r0 g1) (Znth r0 g2) bufs
-     (Znth r0 shs) gsh2 (Znth r0 h)) (upto (Z.to_nat N)));
-   fold_right sepcon emp (map (fun r0 => ghost_var gsh1 (vint b0) (Znth r0 g1) *
-     ghost_var gsh1 (vint (@Znth Z (-1) r0 lasts)) (Znth r0 g2)) (upto (Z.to_nat N)));
-   fold_right sepcon emp (map (fun i => EX sh : share, !! (if eq_dec i b0 then sh = sh0
-     else sepalg_list.list_join sh0 (make_shares shs lasts i) sh) &&
-     (EX v : Z, @data_at CompSpecs sh tbuffer (vint v) (Znth i bufs))) (upto (Z.to_nat B)))))
-  break: (@FF (environ->mpred) _).
-  { Exists 0 0 (repeat 1 (Z.to_nat N)) (repeat (empty_map : hist) (Z.to_nat N)); entailer!; simpl.
+     (Znth r0 shs) (Znth r0 h)) (upto (Z.to_nat N)));
+   [∗] (map (fun r0 => ghost_frag (vint b0) (Znth r0 g1) ∗
+     ghost_frag (vint (@Znth Z (-1) r0 lasts)) (Znth r0 g2)) (upto (Z.to_nat N)));
+   [∗] (map (fun i => ∃ sh : share, ⌜if eq_dec i b0 then sh = sh0
+     else sepalg_list.list_join sh0 (make_shares shs lasts i) sh⌝ ∧
+     (∃ v : Z, data_at(cs := CompSpecs) sh tbuffer (vint v) (Znth i bufs))) (upto (Z.to_nat B)))))
+  break: (False : assert).
+  { Exists 0 0 (repeat 1 (Z.to_nat N)) (repeat (∅ : hist) (Z.to_nat N)); entailer!; simpl.
     my_auto.
     { repeat constructor; computable. }
-    rewrite sepcon_map.
-    apply derives_refl'.
-    rewrite !sepcon_assoc; f_equal; f_equal; [|f_equal].
-    - rewrite list_Znth_eq with (l := g1) at 1.
+    rewrite big_sep_map -bi.sep_assoc; f_equiv.
+    { erewrite map_ext; first done.
+      by intros ?; setoid_rewrite (Znth_repeat 3). }
+    f_equiv; first by rewrite -> list_Znth_eq with (l := g1) at 1; rewrite map_map;
       replace (length g1) with (Z.to_nat N) by (symmetry; rewrite <- Zlength_length; auto; unfold N; computable).
-      rewrite map_map; auto.
-    - rewrite list_Znth_eq with (l := g2) at 1.
+    f_equiv; first by rewrite -> list_Znth_eq with (l := g2) at 1; rewrite map_map;
       replace (length g2) with (Z.to_nat N) by (symmetry; rewrite <- Zlength_length; auto; unfold N; computable).
-      erewrite map_map, map_ext_in; eauto.
-      intros; rewrite In_upto in *.
-      match goal with |- context[@Znth Z (-1) a ?l] => replace (@Znth Z (-1) a l) with 1; auto end.
-      apply Forall_Znth; auto.
-    - erewrite map_ext_in; eauto.
-      intros; rewrite In_upto in *.
-      destruct (eq_dec a 0); auto.
-      destruct (eq_dec a 1), (eq_dec 1 a); auto; try lia.
-      { apply pred_ext; Intros sh; Exists sh; entailer!.
-        * constructor.
-        * match goal with H : sepalg_list.list_join sh0 _ sh |- _ => inv H; auto end. }
-      generalize (make_shares_out a (repeat 1 (Z.to_nat N)) shs); simpl; intro Heq.
-      destruct (eq_dec 1 a); [contradiction n0; auto|].
-       rewrite Heq; auto; [|lia].
-      apply pred_ext; Intros sh; Exists sh; entailer!.
-      eapply sepalg_list.list_join_eq; eauto. }
+    f_equiv.
+    rewrite Forall2_map Forall2_forall_Znth; split; first done.
+    intros ?; rewrite Zlength_upto.
+    intros ?; rewrite -> !Znth_upto by (unfold N; rewrite ?Zlength_upto; lia).
+    destruct (eq_dec i 0); try done.
+    destruct (eq_dec i 1), (eq_dec 1 i); try done.
+    { Intros sh; Exists sh; entailer!; constructor. }
+    generalize (make_shares_out i (repeat 1 (Z.to_nat N)) shs); simpl.
+    rewrite !if_false //; intros ->; [| lia | auto].
+    Intros sh; Exists sh; entailer!. }
   Intros v b0 lasts h.
-  rewrite sepcon_map; Intros.
+  rewrite big_sep_map; Intros.
   forward_call (b0, lasts, gv).
   Intros b.
-  rewrite (extract_nth_sepcon (map _ (upto (Z.to_nat B))) b); [|rewrite Zlength_map; auto].
-  erewrite Znth_map, Znth_upto; auto; rewrite ?Z2Nat.id; try lia.
+  lazymatch goal with |-context[[∗] map ?f (upto (Z.to_nat B))] =>
+    gather_SEP ([∗] map f (upto (Z.to_nat B))); evar (P : mpred); replace_SEP 0 P end.
+  { go_lowerx; rewrite bi.sep_emp; apply (big_sepL_lookup_acc _ _ (Z.to_nat b)), Znth_lookup.
+    rewrite Zlength_map Zlength_upto //. }
+  subst P; simpl; rewrite Znth_map // Znth_upto //.
   Intros sh v0.
   rewrite (data_at_isptr _ tbuffer); Intros.
   forward.
-  destruct (eq_dec b b0); [absurd (b = b0); auto|].
+  destruct (eq_dec b b0); first done.
   assert_PROP (Zlength lasts = N).
-  { gather_SEP (data_at _ _ _ (gv _last_taken)).
-    go_lowerx; apply sepcon_derives_prop.
-    eapply derives_trans; [apply data_array_at_local_facts|].
-    apply prop_left; intros (_ & ? & _); apply prop_right.
-    unfold unfold_reptype in *; simpl in *.
-    rewrite Zlength_map in *; auto. }
-  rewrite make_shares_out in *; auto; [|setoid_rewrite H; auto].
+  { entailer!.
+    autorewrite with sublist in *.
+    unfold N in *; simpl in *; lia. }
+  rewrite -> make_shares_out in * by (auto; setoid_rewrite H; auto).
   assert (sh = Ews) by (eapply sepalg_list.list_join_eq; eauto); subst.
   forward.
-  gather_SEP (fold_right sepcon emp (map (fun x : Z => ghost_var gsh1 (vint b0) _) _))
-                     (fold_right sepcon emp (map (fun x : Z => ghost_var gsh1 (vint (Znth x lasts)) _) _)).
-  rewrite <- sepcon_map.
-  gather_SEP (data_at _ _ _ (Znth b bufs))
-                    (fold_right sepcon emp (upd_Znth b _ _)).
- replace_SEP 0 (fold_right sepcon emp (map (fun i => EX sh2 : share,
-    !! (if eq_dec i b0 then sh2 = sh0 else sepalg_list.list_join sh0 (make_shares shs lasts i) sh2) &&
-    (EX v1 : Z, data_at sh2 tbuffer (vint v1) (Znth i bufs))) (upto (Z.to_nat B)))).
-  { Opaque B.
-    go_lowerx; eapply derives_trans with (Q := _ * _);
-      [|erewrite replace_nth_sepcon, upd_Znth_triv; try apply derives_refl; eauto].
-
-    rewrite Znth_map by (rewrite (Zlength_upto); assumption).
-    rewrite Znth_upto by assumption.
-    destruct (eq_dec b b0); [absurd (b = b0); auto|].
-    rewrite make_shares_out; auto; [|setoid_rewrite H; auto].
-    Exists Ews v; entailer!. }
+  gather_SEP 0 1; replace_SEP 0 ([∗] (map (fun i => ∃ sh2 : share,
+    ⌜if eq_dec i b0 then sh2 = sh0 else sepalg_list.list_join sh0 (make_shares shs lasts i) sh2⌝ ∧
+    (∃ v1 : Z, data_at sh2 tbuffer (vint v1) (Znth i bufs))) (upto (Z.to_nat B)))).
+  { go_lower; iIntros "(? & H)"; iApply "H"; eauto. }
   change (upto 3) with (upto (Z.to_nat N)).
   change (upto 5) with (upto (Z.to_nat B)).
-  forward_call (comms, locks, bufs, b, b0, lasts,
-    sh1, lsh, shs, g, g0, g1, g2, h, sh0, gv).
+  forward_call (comms, bufs, b, b0, lasts, sh1, lsh, shs, g, g0, g1, g2, h, sh0, gv).
+  { rewrite big_sep_map; cancel. }
   Intros x; destruct x as (lasts', h').
-  rewrite sepcon_map; Intros.
   forward.
-  Exists (v + 1) b lasts' h'; rewrite sepcon_map; entailer!.
-  replace N with (Zlength h) by auto; symmetry; eapply mem_lemmas.Forall2_Zlength; eauto.
-  simpl; cancel.
+  Exists (v + 1) b lasts' h'; entailer!.
+  { replace N with (Zlength h) by auto; symmetry; eapply mem_lemmas.Forall2_Zlength; eauto. }
+  cancel.
 Qed.
+
+End mpred.
diff --git a/msl/age_sepalg.v b/msl/age_sepalg.v
deleted file mode 100644
index b56cfca0e6..0000000000
--- a/msl/age_sepalg.v
+++ /dev/null
@@ -1,838 +0,0 @@
-(*
- * Copyright (c) 2009-2010, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-Require Import VST.msl.base.
-Require Import VST.msl.ageable.
-Require Import VST.msl.sepalg.
-Require Import VST.msl.sepalg_generators.
-
-Class Age_alg (A:Type) {JOIN: Join A}{as_age : ageable A}{SA: Sep_alg A} :=
-mkAge {
-  age1_join : forall x {y z x'}, join x y z -> age x x' ->
-    exists y':A, exists z':A, join x' y' z' /\ age y y' /\ age z z'
-; age1_join2 : forall x {y z z'}, join x y z -> age z z' ->
-    exists x':A, exists y':A, join x' y' z' /\ age x x' /\ age y y'
-; unage_join : forall x {x' y' z'}, join x' y' z' -> age x x' ->
-    exists y:A, exists z:A, join x y z /\ age y y' /\ age z z'
-; unage_join2 : forall z {x' y' z'}, join x' y' z' -> age z z' ->
-    exists x:A, exists y:A, join x y z /\ age x x' /\ age y y'
-; age_core : forall x y : A, age x y -> age (core x) (core y)
-}.
-
-Lemma age1_None_joins {A}{JA: Join A}{PA: Perm_alg A}{agA: ageable A}{SA: Sep_alg A}{XA: Age_alg A}: forall phi1 phi2, joins phi1 phi2 -> age1 phi1 = None -> age1 phi2 = None.
-Proof.
-  intros.
-  destruct H.
-  case_eq (age1 phi2); intros; auto.
-  destruct (age1_join _ (join_comm H) H1)  as [phi1' [x' [? [? ?]]]].
-  unfold age in *; rewrite H0 in H3; inv H3.
-Qed.
-
-Lemma age1_joins_eq {A} {JA: Join A}{PA: Perm_alg A}{agA: ageable A}{SA: Sep_alg A}{XA: Age_alg A}: forall phi1 phi2,
-        joins phi1 phi2 ->
-        forall phi1', age1 phi1 = Some phi1' ->
-        forall phi2', age1 phi2 = Some phi2' ->
-        joins phi1' phi2'.
-Proof.
-  intros.
-  destruct H.
-  destruct (age1_join _ H H0) as [phi7 [x' [? [? ?]]]].
-  unfold age in *; rewrite H1 in H3; inv H3.
-  exists x'; auto.
-Qed.
-
-Section BIJECTION.
-  Variables A B : Type.
-  Variable JA: Join A.
-  Variable PA: Perm_alg A.
-  Variable ag: ageable A.
-  Variable bijAB: bijection A B.
-  Variable SA: Sep_alg A.
-  Variable asa : Age_alg A.
-
-  #[local] Existing Instance PA.
-
-  #[local] Instance agB : ageable B := (ag_bij _ _ ag bijAB).
-
-(*  #[local] Instance PA_B:  @Perm_alg B (Join_bij _ _ _ bijAB ) := @Perm_bij A JA PA B bijAB. *)
-
-  Theorem asa_bijection : @Age_alg B (Join_bij _ _ _ bijAB) agB (Sep_bij _ _ _ bijAB).
-  Proof.
-    constructor; unfold age, Join_bij; simpl;     destruct bijAB as [f g fg gf]; simpl  in *; intros.
-
-    (* commute1 *)
-    revert H0; case_eq (age1 (g x)); intros; try discriminate.
-    inv H1.
-    rename a into gx'.  red in H.
-    destruct (age1_join _ H H0) as  [gy' [gz' [? [? ?]]]].
-    exists (f gy'); exists (f gz').
-    split. red.
-    repeat rewrite gf. auto.
-    rewrite H2; rewrite H3.
-    auto.
-
-    (* commute2 *)
-    revert H0; case_eq (age1 (g z)); intros; try discriminate.
-    inv H1.
-    rename a into gz'. red in H.
-    destruct (age1_join2 _ H H0) as  [gx' [gy' [? [? ?]]]].
-    exists (f gx'); exists (f gy').
-    split. red; repeat rewrite gf; auto.
-    rewrite H2; rewrite H3.
-    auto.
-
-    (* commute3 *)
-    revert H0; case_eq (age1 (g x)); intros; try discriminate.
-    inv H1.
-    rename a into gx'. red in H.
-    rewrite gf in *.
-    destruct (unage_join _ H H0) as  [gy' [gz' [? [? ?]]]].
-    exists (f gy'); exists (f gz').
-    split. red; repeat rewrite gf; auto.
-    repeat rewrite gf. rewrite H2; rewrite H3.
-    repeat rewrite fg; split; auto.
-
-    (* commute4 *)
-    revert H0; case_eq (age1 (g z)); intros; try discriminate.
-    inv H1.
-    rename a into gz'. red in H.
-    rewrite gf in *.
-    destruct (unage_join2 _ H H0) as  [gx' [gy' [? [? ?]]]].
-    exists (f gx'); exists (f gy').
-    split. red.    repeat rewrite gf; auto.
-    repeat rewrite gf.
-    rewrite H2; rewrite H3.
-    repeat rewrite fg; split; auto.
-
-    (* core *)
-    rewrite gf. destruct (age1 (g x)) eqn: Hage; [|discriminate].
-    inv H. apply age_core in Hage; rewrite Hage.
-    rewrite gf; reflexivity.
-  Qed.
-End BIJECTION.
-
-Section PROD.
-  Variable A : Type.
-  Variable J_A: Join A.
-  Variable saA : Perm_alg A.
-  Variable SA : Sep_alg A.
-  Variable agA : ageable A.
-  Variable B: Type.
-  Variable J_B: Join B.
-  Variable saB : Perm_alg B.
-  Variable SB : Sep_alg B.
-  Variable asa : Age_alg A.
-
-  Theorem asa_prod : @Age_alg (prod A B) _ (ag_prod A B agA) (Sep_prod SA SB).
-  Proof.
-    constructor; unfold age; simpl; unfold Join_prod.
-
-    (* commute1 *)
-    intros [xa xb] [ya yb] [za zb] [xa' xb'] [? ?].
-    simpl in *.
-    case_eq (age1 xa); intros; inv H2.
-    destruct (age1_join _ H H1) as [ya' [za' [? [? ?]]]].
-    exists (ya',yb); exists (za',zb);
-      rewrite H3; rewrite H4; repeat split; auto.
-
-    (* commute2 *)
-    intros [xa xb] [ya yb] [za zb] [za' zb'] [? ?].
-    simpl in *.
-    case_eq (age1 za); intros; inv H2.
-    destruct (age1_join2 _ H H1) as [xa' [ya' [? [? ?]]]].
-    exists (xa',xb); exists (ya',yb);
-      rewrite H3; rewrite H4; repeat split; auto.
-
-    (* commute3 *)
-    intros [xa xb] [xa' xb'] [ya' yb'] [za' zb'] [? ?].
-    simpl in *.
-    case_eq (age1 xa); intros; inv H2.
-    destruct (unage_join _ H H1) as [ya [za [? [? ?]]]].
-    exists (ya,yb'); exists (za,zb'); simpl.
-    rewrite H3; rewrite H4; repeat split; auto.
-
-    (* commute4 *)
-    intros [za zb] [xa' xb'] [ya' yb'] [za' zb'] [? ?].
-    simpl in *.
-    case_eq (age1 za); intros; inv H2.
-    destruct (unage_join2 _ H H1) as [xa [ya [? [? ?]]]].
-    exists (xa,xb'); exists (ya,yb'); simpl.
-    rewrite H3; rewrite H4; repeat split; auto.
-
-    (* core *)
-    intros (?, ?) ?; simpl.
-    destruct (age1 a) eqn: Hage; [|discriminate].
-    intros X; inv X.
-    apply age_core in Hage; rewrite Hage. reflexivity.
-  Qed.
-End PROD.
-
-Section PROD'.
-  Variable A : Type.
-  Variable J_A: Join A.
-  Variable saA : Perm_alg A.
-  Variable SA : Sep_alg A.
-  Variable B: Type.
-  Variable J_B: Join B.
-  Variable saB : Perm_alg B.
-  Variable SB : Sep_alg B.
-  Variable agB : ageable B.
-  Variable asb : Age_alg B.
-
-
-  Theorem asa_prod' : @Age_alg (prod A B) _ (ag_prod' A B agB) (Sep_prod SA SB).
-  Proof.
-    constructor; unfold age; simpl; unfold Join_prod.
-
-    (* commute1 *)
-    intros [xa xb] [ya yb] [za zb] [xa' xb'] [? ?].
-    simpl in *.
-    case_eq (age1 xb); intros; inv H2.
-    destruct (age1_join _ H0 H1) as [yb' [zb' [? [? ?]]]].
-    exists (ya,yb'); exists (za,zb');
-      rewrite H3; rewrite H4; repeat split; auto.
-
-    (* commute2 *)
-    intros [xa xb] [ya yb] [za zb] [za' zb'] [? ?].
-    simpl in *.
-    case_eq (age1 zb); intros; inv H2.
-    destruct (age1_join2 _ H0 H1) as [xb' [yb' [? [? ?]]]].
-    exists (xa,xb'); exists (ya,yb');
-      rewrite H3; rewrite H4; repeat split; auto.
-
-    (* commute3 *)
-    intros [xa xb] [xa' xb'] [ya' yb'] [za' zb'] [? ?].
-    simpl in *.
-    case_eq (age1 xb); intros; inv H2.
-    destruct (unage_join _ H0 H1) as [yb [zb [? [? ?]]]].
-    exists (ya',yb); exists (za',zb); simpl.
-    rewrite H3; rewrite H4; repeat split; auto.
-
-    (* commute4 *)
-    intros [za zb] [xa' xb'] [ya' yb'] [za' zb'] [? ?].
-    simpl in *.
-    case_eq (age1 zb); intros; inv H2.
-    destruct (unage_join2 _ H0 H1) as [xb [yb [? [? ?]]]].
-    exists (xa',xb); exists (ya',yb); simpl.
-    rewrite H3; rewrite H4; repeat split; auto.
-
-    (* core *)
-    intros (?, ?) ?; simpl.
-    destruct (age1 b) eqn: Hage; [|discriminate].
-    intros X; inv X.
-    apply age_core in Hage; rewrite Hage. reflexivity.
-  Qed.
-End PROD'.
-
-
-Lemma joins_fashionR {A}  {JA: Join A}{PA: Perm_alg A}{agA: ageable A}{SA: Sep_alg A}{XA: Age_alg A} : forall x y,
-  joins x y -> fashionR x y.
-Proof.
-  pose proof I.
-  intros.
-  unfold fashionR.
-  destruct H0 as [z ?].
-  revert y z H0; induction x using age_induction; intros.
-  case_eq (age1 x); intros.
-  destruct (age1_join _ H1 H2) as [p [q [? [? ?]]]].
-  assert (level a = level p).
-  apply H0 with q; auto.
-  replace (level x) with (S (level a)).
-  replace (level y) with (S (level p)).
-  f_equal; auto.
-  symmetry; apply age_level; auto.
-  symmetry; apply age_level; auto.
-  case_eq (age1 y); intros.
-  apply join_comm in H1.
-  destruct (age1_join _ H1 H3) as [p [q [? [? ?]]]].
-  hnf in H5; rewrite H5 in H2; discriminate.
-  rewrite age1_level0 in H2.
-  rewrite age1_level0 in H3.
-  congruence.
-Qed.
-
-Lemma comparable_fashionR {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A} {agA: ageable A} {XA: Age_alg A} : forall x y,
-  comparable x y -> fashionR x y.
-Proof.
-  intros.
-  apply comparable_common_unit in H.
-  destruct H as [u [H1 H2]].
-  hnf; transitivity (level u).
-  apply joins_fashionR; eauto.
-  symmetry.
-  apply joins_fashionR; eauto.
-Qed.
-
-Lemma age_identity {A} `{asaA: Age_alg A}: forall phi phi', age phi phi'->
-    identity phi -> identity phi'.
-Proof.
-intros.
-unfold identity in *.
-intros.
-destruct (unage_join _ H1 H) as [y [? [? [? ?]]]].
-specialize (H0 y x H2).
-subst.
-unfold age in *. congruence.
-Qed.
-
-Lemma age_comparable {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{DA: Flat_alg A} {agA: ageable A}{asaA: Age_alg A}:
-    forall phi1 phi2 phi1' phi2', age phi1 phi1' -> age phi2 phi2' ->
-      comparable phi1 phi2 -> comparable phi1' phi2'.
-Proof.
-  intros.
-  destruct (comparable_common_unit H1) as [e [? ?]].
-  destruct (age1_join _ (join_comm H2) H) as [a [b [? [? ?]]]].
-  destruct (age1_join _ (join_comm H3) H0) as [c [d [? [? ?]]]].
-  assert (c=a) by (unfold age in *; congruence); subst c.
-  assert (b=phi1') by (unfold age in *; congruence). subst b.
-  assert (d=phi2') by (unfold age in *; congruence). subst d.
-  apply common_unit_comparable.
-  exists a.
-  split; apply join_comm; auto.
-Qed.
-
-  Lemma asa_nat : @Age_alg nat (Join_equiv nat) ag_nat _.
-  Proof.
-    constructor.
-    repeat intro. hnf in H; subst; auto.
-    intros.
-    destruct H; subst.
-    exists x'. exists x'.
-    intuition.
-    intros.
-    destruct H; subst.
-    exists z'; exists z'; intuition.
-    intros. destruct H; subst.
-    exists x; exists x. intuition.
-    intros. destruct H; subst.
-    exists z; exists z; intuition.
-    intros; simpl; auto.
-  Qed.
-
-Lemma nec_identity {A} `{asaA: Age_alg A}: forall phi phi', necR phi phi'->
-    identity phi -> identity phi'.
-Proof.
-  induction 1; auto.
-  apply age_identity; auto.
-Qed.
-
-Lemma later_join2 {A} `{asaA : Age_alg A}: forall {x y z z' : A},
-       join x y z ->
-       laterR z z' ->
-       exists x',
-         exists y',
-           join x' y' z' /\ laterR x x' /\ laterR y y'.
-Proof.
-intros.
-revert x y H; induction H0; intros.
-edestruct (age1_join2) as [x' [y' [? [? ?]]]]; eauto.
-exists x'; exists y'; split; auto.
-split; constructor 1; auto.
-destruct (IHclos_trans1 _ _ H) as [x' [y' [? [? ?]]]].
-destruct (IHclos_trans2 _ _ H0) as [x'' [y'' [? [? ?]]]].
-exists x''; exists y''.
-split; auto.
-split; econstructor 2; eauto.
-Qed.
-
-Lemma nec_join2 {A} `{asaA : Age_alg A}: forall {x y z z' : A},
-       join x y z ->
-       necR z z' ->
-       exists x',
-         exists y',
-           join x' y' z' /\ necR x x' /\ necR y y'.
-Proof.
-intros.
-apply nec_refl_or_later in H0 as [|]; [subst; eauto|].
-eapply later_join2 in H0 as (? & ? & ? & ? & ?); eauto.
-do 3 eexists; eauto; split; apply laterR_necR; auto.
-Qed.
-
-Lemma later_join {A} `{asaA : Age_alg A}: forall {x y z x' : A},
-       join x y z ->
-       laterR x x' ->
-       exists y' ,
-         exists z' ,
-           join x' y' z' /\ laterR y y' /\ laterR z z'.
-Proof.
-intros.
-revert y z H; induction H0; intros.
-edestruct age1_join as [y' [z' [? [? ?]]]]; eauto.
-exists y'; exists z'; split; auto.
-split; constructor 1; auto.
-destruct (IHclos_trans1 _ _ H) as [y' [z' [? [? ?]]]].
-destruct (IHclos_trans2 _ _ H0) as [y'' [z'' [? [? ?]]]].
-exists y''; exists z''.
-split; auto.
-split; econstructor 2; eauto.
-Qed.
-
-Lemma nec_join {A} `{asaA : Age_alg A}: forall {x y z x' : A},
-       join x y z ->
-       necR x x' ->
-       exists y' ,
-         exists z' ,
-           join x' y' z' /\ necR y y' /\ necR z z'.
-Proof.
-intros.
-apply nec_refl_or_later in H0 as [|]; [subst; eauto|].
-eapply later_join in H0 as (? & ? & ? & ? & ?); eauto.
-do 3 eexists; eauto; split; apply laterR_necR; auto.
-Qed.
-
-Lemma nec_join4 {A} `{asaA : Age_alg A}: forall z x' y' z' : A,
-       join x' y' z' ->
-       necR z z' ->
-       exists x,
-         exists y,
-           join x y z /\ necR x x' /\ necR y y'.
-Proof.
-intros.
-revert x' y' H.
-induction H0; intros.
-destruct (unage_join2 _ H0 H) as  [x0 [y0 [? [? ?]]]].
-exists x0; exists y0; split; auto.
-split; constructor 1; auto.
-exists x'; exists y'; split; auto.
-
-rename x into z1.
-rename y into z2.
-destruct (IHclos_refl_trans2 _ _ H) as [x'' [y'' [? [? ?]]]].
-destruct (IHclos_refl_trans1 _ _ H0) as [x0 [y0 [? [? ?]]]].
-exists x0; exists y0.
-split; auto.
-split; econstructor 3; eauto.
-Qed.
-
-Lemma nec_join3 {A} `{asaA : Age_alg A}: forall x x' y' z' : A,
-       join x' y' z' ->
-       necR x x' ->
-       exists y,
-         exists z,
-           join x y z /\ necR y y' /\ necR z z'.
-Proof.
-intros.
-revert y' z' H.
-induction H0; intros.
-destruct (unage_join _ H0 H) as  [y0 [z0 [? [? ?]]]].
-exists y0; exists z0; split; auto.
-split; constructor 1; auto.
-exists y'; exists z'; split; auto.
-
-rename y into x1.
-rename z into x2.
-destruct (IHclos_refl_trans2 _ _ H) as [y'' [z'' [? [? ?]]]].
-destruct (IHclos_refl_trans1 _ _ H0) as [y0 [z0 [? [? ?]]]].
-exists y0; exists z0.
-split; auto.
-split; econstructor 3; eauto.
-Qed.
-
-
-Lemma join_level {A}{JA: Join A}{PA: Perm_alg A}{AG: ageable A}{SA: Sep_alg A}{AgeA: Age_alg A}:
-  forall x y z, join x y z -> level x = level z /\ level y = level z.
-Proof.
-  intros.
-  assert (exists n, n = level x) by (eexists; reflexivity).
-  destruct H0 as [n  ?].
-  revert x y z H0 H; induction n; intros.
-  case_eq (level y); intros.
-  case_eq (level z); intros.
-  split; congruence.
-  destruct (levelS_age1 _ _ H2).
-  destruct (age1_join2 _ H H3) as [u [v [? [? ?]]]].
-  apply age_level in H5. congruence.
-  destruct (levelS_age1 _ _ H1).
-  destruct (age1_join _ (join_comm H) H2) as [u [v [? [? ?]]]].
-  apply age_level in H4. congruence.
-  symmetry in H0.
-  destruct (levelS_age1 _ _ H0) as [x' ?].
-  destruct (age1_join _ H H1) as [y' [z' [? [? ?]]]].
-  specialize (IHn x' y' z').
-  apply age_level in H1. apply age_level in H3. apply age_level in H4.
-  destruct IHn; auto. congruence.
-  split; congruence.
-Qed.
-
- Lemma level_core {A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}:
-     forall m:A, level (core m) = level m.
- Proof. intros.
-  generalize (core_unit m); unfold unit_for; intro.
-  apply join_level in H. intuition.
- Qed.
-
-Lemma age_core_eq {A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}:
-  forall x y x' y', age x x' -> age y y' -> core x = core y -> core x' = core y'.
-Proof.
- intros.
- pose proof (age_core _ _ H) as Hc1.
- pose proof (age_core _ _ H0) as Hc2.
- rewrite H1 in Hc1; unfold age in *; congruence.
-Qed.
-
-Lemma age_twin {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}:
-  forall phi1 phi2 n phi1',
-  level phi1 = level phi2 ->
-  ageN n phi1 = Some phi1' ->
-  exists phi2', ageN n phi2 = Some phi2' /\ level phi1' = level phi2'.
-Proof.
-intros until n; revert n phi1 phi2.
-induction n; intros.
-exists phi2.
-split; trivial.
-inversion H0.
-subst phi1'.
-trivial.
-unfold ageN in H0.
-simpl in H0.
-revert H0; case_eq (age1 phi1); intros; try discriminate.
-rename a into phi.
-assert (exists ophi2, age phi2 ophi2 /\ level phi = level ophi2).
-generalize (age_level _ _ H0); intro.
-rewrite H in H2; apply levelS_age1 in H2. destruct H2 as [y ?].
-exists y; split; auto.
-apply age_level in H0; apply age_level in H2; lia.
-destruct H2 as [ophi2 [? ?]].
-specialize (IHn _ _ _ H3 H1).
-destruct IHn as [phi2' [? ?]].
-exists phi2'.
-split; trivial.
-unfold ageN.
-simpl.
-rewrite H2.
-trivial.
-Qed.
-
-Lemma age1_join_eq {A}  {JA: Join A}{PA: Perm_alg A}{agA: ageable A}{SA: Sep_alg A}{AgeA: Age_alg A} : forall phi1 phi2 phi3,
-        join phi1 phi2 phi3 ->
-        forall phi1', age1 phi1 = Some phi1' ->
-        forall phi2', age1 phi2 = Some phi2' ->
-        forall phi3', age1 phi3 = Some phi3' ->
-        join phi1' phi2' phi3'.
-Proof.
-intros until phi3.
-intros H phi1' H0 phi2' H1 phi3' H2.
-destruct (age1_join _ H H0) as [phi4 [x' [? [? ?]]]].
-unfold age in *.
-rewrite H4 in H1.
-inversion H1.
-rewrite <- H7.
-rewrite H5 in H2.
-inversion H2.
-rewrite <- H8.
-auto.
-Qed.
-
-Lemma strong_nat_ind (P : nat -> Prop) (IH : forall n, (forall i, lt i n -> P i) -> P n) n : P n.
-Proof.
-  apply IH; induction n; intros i li; inversion li; eauto.
-Qed.
-
-Lemma laterR_core {A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}:
-  forall x y : A, laterR x y -> laterR (core x) (core y).
-Proof.
- induction 1.
- constructor 1; apply age_core; auto.
- constructor 2 with (core y); auto.
-Qed.
-
-Lemma unlaterR_core {A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}:
-  forall x y : A, laterR (core x) y -> exists y0, laterR x y0 /\ y = core y0.
-Proof.
-  intros; remember (core x) as cx; generalize dependent x; induction H; intros; subst.
-  - pose proof (age_level _ _ H) as Hlevel.
-    rewrite level_core in Hlevel.
-    destruct (levelS_age1 _ _ Hlevel) as (y0 & Hage).
-    exists y0; split; [constructor; auto|].
-    apply age_core in Hage.
-    unfold age in *; congruence.
-  - edestruct IHclos_trans1 as (y0 & ? & ?); eauto; subst.
-    edestruct IHclos_trans2 as (? & ? & ?); eauto; subst.
-    eexists; split; [|reflexivity].
-    econstructor 2; eauto.
-Qed.
-
-Lemma necR_core {A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}:
-  forall x y : A, necR x y -> necR (core x) (core y).
-Proof.
- induction 1.
- constructor 1; apply age_core; auto.
- constructor 2.
- constructor 3 with (core y); auto.
-Qed.
-
-Definition relation_mul {A: Type} (R0 R1: relation A) (x y: A) := exists z, R0 x z /\ R1 z y.
-
-Fixpoint relation_power {A: Type} (n: nat) (R: relation A) :=
-  match n with
-  | O => eq
-  | S n0 => relation_mul R (relation_power n0 R)
-  end.
-
-Fixpoint partial_fun_power {A: Type} (n: nat) (f: A -> option A) (x: A) :=
-  match n with
-  | O => Some x
-  | S n0 => match f x with
-            | Some fx => partial_fun_power n0 f fx
-            | None => None
-            end
-  end.
-
-Lemma laterR_power_age: forall {A:Type} {agA:ageable A} (x y: A),
-  laterR x y <-> (exists n, relation_power (S n) age x y).
-Proof.
-  intros.
-  remember (level x) eqn:?H.
-  revert x y H; induction n; intros.
-  + split; intros.
-    - apply laterR_level in H0.
-      lia.
-    - destruct H0 as [n ?H].
-      destruct H0 as [z [? ?]].
-      apply age_level in H0; lia.
-  + split; intros.
-    - destruct (age1 x) as [a' |] eqn:?H; [| apply age1_level0 in H1; lia].
-      assert (age x a') by auto; clear H1.
-      pose proof age_later_nec _ _ _ H2 H0.
-      destruct (nec_refl_or_later _ _ H1).
-      * exists 0.
-        simpl.
-        exists y.
-        subst; auto.
-      * simpl.
-        pose proof age_level _ _ H2.
-        rewrite <- H in H4; inversion H4; clear H4.
-        destruct (IHn a' y H6) as [? _].
-        destruct (H4 H3) as [n0 ?H].
-        exists (S n0).
-        simpl.
-        exists a'.
-        auto.
-    - destruct H0 as [n0 [z [?H ?H]]].
-      pose proof age_level _ _ H0.
-      rewrite <- H in H2; inversion H2; clear H2.
-      destruct (IHn z y H4) as [_ ?H].
-      destruct n0.
-      * simpl in H1; subst.
-        apply t_step; auto.
-      * spec H2; [exists n0; auto |].
-        eapply t_trans; eauto.
-        apply t_step; auto.
-Qed.
-
-Lemma necR_power_age: forall {A:Type} {agA:ageable A} (x y: A),
-  necR x y <-> (exists n, relation_power n age x y).
-Proof.
-  intros.
-  split; intros.
-  + destruct (nec_refl_or_later _ _ H).
-    - subst.
-      exists 0.
-      simpl.
-      auto.
-    - destruct (laterR_power_age x y) as [? _].
-      destruct (H1 H0) as [n0 ?H].
-      exists (S n0); auto.
-  + destruct H as [n ?H].
-    destruct n.
-    - simpl in H; subst.
-      auto.
-    - destruct (laterR_power_age x y) as [_ ?].
-      spec H0; [exists n; auto |].
-      apply laterR_necR; auto.
-Qed.
-
-Lemma power_age_age1: forall {A:Type} {agA:ageable A} n x y,
-  relation_power n age x y <-> partial_fun_power n age1 x = Some y.
-Proof.
-  intros.
-  revert x; induction n; intros.
-  + simpl.
-    split; intros; [subst| inversion H]; reflexivity.
-  + simpl.
-    split; intros.
-    - destruct H as [z [?H ?H]].
-      rewrite H.
-      apply IHn; auto.
-    - destruct (age1 x) as [z |] eqn:?H; [| inversion H].
-      exists z.
-      split; [auto |].
-      apply IHn; auto.
-Qed.
-
-Lemma power_age1_level_small: forall {A:Type} {agA:ageable A} n x,
-  partial_fun_power n age1 x = None <-> level x < n.
-Proof.
-  intros.
-  revert x; induction n; intros.
-  + simpl; split; intros.
-    - inversion H.
-    - lia.
-  + simpl; split; intros.
-    - destruct (age1 x) eqn:?H.
-      * apply age_level in H0.
-        apply IHn in H.
-        lia.
-      * apply age1_level0 in H0.
-        lia.
-    - destruct (age1 x) eqn:?H.
-      * apply IHn.
-        apply age_level in H0.
-        lia.
-      * reflexivity.
-Qed.
-
-Lemma power_age_core: forall {A:Type} {agA:ageable A} {JA: Join A} {PA: Perm_alg A} {SaA: Sep_alg A} {XA: Age_alg A} (x y: A) n,
-  relation_power n age x y -> relation_power n age (core x) (core y).
-Proof.
-  intros.
-  revert x y H; induction n; intros.
-  + simpl in H |- *.
-    subst; reflexivity.
-  + simpl in H |- *.
-    destruct H as [z [?H ?H]].
-    exists (core z).
-    split.
-    - apply age_core; auto.
-    - apply IHn; auto.
-Qed.
-
-Lemma power_age_core_eq: forall {A:Type} {agA:ageable A} {JA: Join A} {PA: Perm_alg A} {SaA: Sep_alg A} {XA: Age_alg A} (x x' y y': A) n,
-  relation_power n age x x' -> relation_power n age y y' -> core x = core y -> core x' = core y'.
-Proof.
-  intros.
-  revert x y H H0 H1; induction n; intros.
-  + simpl in H, H0 |- *.
-    subst; auto.
-  + simpl in H, H0 |- *.
-    destruct H as [x'' [?H ?H]].
-    destruct H0 as [y'' [?H ?H]].
-    pose proof age_core_eq _ _ _ _ H H0 H1.
-    specialize (IHn x'' y'' H2 H3 H4).
-    auto.
-Qed.
-
-Lemma levelS_age {A: Type} {agA: ageable A} : forall (x:A) n,
-  S n = level x ->
-  exists y, age x y /\ n = level y.
-Proof.
-  intros.
-  apply eq_sym in H.
-  remember H as H0; clear HeqH0.
-  apply levelS_age1 in H0.
-  destruct H0 as [y ?].
-  exists y.
-  assert (age x y).
-  unfold age.
-  exact H0.
-  split.
-  exact H1.
-  apply age_level in H1.
-  rewrite H in H1.
-  inversion H1.
-  reflexivity.
-Qed.
-
-Lemma clos_refl_trans_addone: forall (A : Type) (R : relation A) (x y z: A), R x y -> clos_refl_trans A R y z -> clos_refl_trans A R x z.
-Proof.
-  intros.
-  apply (rt_step A R x y) in H.
-  apply rt_trans with y.
-  exact H.
-  exact H0.
-Qed.
-
-Lemma necR_same_level: forall {A:Type} {agA:ageable A} (x y x': A), necR x x' -> level x = level y -> exists y', (necR y y' /\ level x' = level y').
-Proof.
-  intros A agA x y.
-  remember (level x) as n.
-  generalize Heqn; clear Heqn.
-  generalize x y; clear x y.
-  induction n.
-  (* basic step *)
-  + intros.
-    apply necR_level in H.
-    rewrite <- Heqn in H.
-    destruct (level x') eqn:HH; [|lia].
-    exists y.
-    split.
-       unfold necR; auto.
-       exact H0.
-  + intros.
-    apply nec_refl_or_later in H.
-    destruct H.
-    - exists y.
-      split.
-         unfold necR; auto.
-         rewrite <- H0. rewrite -> Heqn. rewrite H. reflexivity.
-    - apply levelS_age in H0; destruct H0 as [y'' [? ?]].
-      apply levelS_age in Heqn; destruct Heqn as [x'' [? ?]].
-      remember (IHn x'' y'' H3 x') as HH; clear HeqHH.
-      assert(necR x'' x').
-        apply (age_later_nec x); [exact H2 | exact H].
-      apply HH in H4; clear HH; [|exact H1].
-      destruct H4 as [y' [? ?]].
-      exists y'.
-      split; [| exact H5].
-      unfold necR.
-      apply clos_refl_trans_addone with y''; [exact H0| exact H4].
-Qed.
-
-Lemma laterR_same_level: forall {A:Type} {agA:ageable A} (x y x': A), laterR x x' -> level x = level y -> exists y', (laterR y y' /\ level x' = level y').
-Proof.
-  intros.
-  assert (HH: laterR x x'). exact H.
-  apply laterR_necR in H.
-  assert (exists y' : A, necR y y' /\ level x' = level y').
-     apply (necR_same_level x y).
-     exact H.
-     exact H0.
-  destruct H1 as [y' [? ?]].
-  exists y'.
-  split; [|exact H2].
-  apply nec_refl_or_later in H1.
-  destruct H1.
-  + apply laterR_level in HH.
-    subst.
-    rewrite <- H0 in H2.
-    lia.
-  + exact H1.
-Qed.
-
-Lemma power_age_parallel: forall {A:Type} {agA:ageable A} (x x' y: A) n,
-  level x = level y ->
-  relation_power n age x x' ->
-  exists y', relation_power n age y y'.
-Proof.
-  intros.
-  destruct (partial_fun_power n age1 y) eqn:?H.
-  + exists a.
-    apply power_age_age1; auto.
-  + apply power_age_age1 in H0.
-    apply power_age1_level_small in H1.
-    rewrite <- H in H1.
-    apply power_age1_level_small in H1.
-    rewrite H0 in H1.
-    inversion H1.
-Qed.
-
-Lemma power_age_parallel': forall {A:Type} {agA:ageable A} {JA: Join A} {PA: Perm_alg A} {SaA: Sep_alg A} {XA: Age_alg A} (x x' y: A) n,
-  core x = core y ->
-  relation_power n age x x' ->
-  exists y', relation_power n age y y' /\ core x' = core y'.
-Proof.
-  intros.
-  assert (level x = level y).
-  1:{
-    pose proof level_core y.
-    pose proof level_core x.
-    rewrite H in H2.
-    congruence.
-  }
-  destruct (power_age_parallel x x' y n H1 H0) as [y' ?H].
-  exists y'.
-  split; [auto |].
-  eapply power_age_core_eq; eauto.
-Qed.
-
diff --git a/msl/age_to.v b/msl/age_to.v
deleted file mode 100644
index a535fa8139..0000000000
--- a/msl/age_to.v
+++ /dev/null
@@ -1,375 +0,0 @@
-(* The definitions and other results of age_by and age_to should be
-moved here from msl/ageable.v.  Alternatively, this can be moved to
-msl/ageable.v (or this file to msl/) eventually, but we keep it here
-for now to reduce compilation time. *)
-
-Require Import VST.msl.ageable.
-Require Import VST.msl.predicates_hered.
-Require Import VST.msl.sepalg.
-Require Import VST.msl.age_sepalg.
-Require Import VST.msl.sepalg_generators.
-Require Import Lia.
-
-(* Apply [age1] n times (meaningful when [n <= level x] *)
-
-Definition age1' {A} `{agA : ageable A} : A -> A :=
-  fun x => match age1 x with Some y => y | None => x end.
-
-Definition age_by n {A} `{agA : ageable A} : A -> A := Nat.iter n age1'.
-
-Lemma level_age1' {A} `{agA : ageable A} x : level (age1' x) = level x - 1.
-Proof.
-  unfold age1'. destruct (age1 x) eqn:E.
-  - apply age_level in E. lia.
-  - apply age1_level0 in E. lia.
-Qed.
-
-Lemma level_age_by n {A} `{agA : ageable A} x : level (age_by n x) = level x - n.
-Proof.
-  revert x; induction n; intros x; simpl.
-  - lia.
-  - simpl. rewrite level_age1'. rewrite IHn. lia.
-Qed.
-
-Lemma age_age_by n {A} `{agA : ageable A} (x y : A) : age x y -> age_by (S n) x = age_by n y.
-Proof.
-  intros E.
-  induction n.
-  - simpl.
-    unfold age1' in *.
-    rewrite E. auto.
-  - change (age1' (age_by (S n) x) = age_by (S n) y).
-    rewrite IHn.
-    reflexivity.
-Qed.
-
-(* Age [x] to the level [k] (meaningul when [k <= level x] *)
-Definition age_to k {A} `{agA : ageable A} (x : A) : A := age_by (level x - k) x.
-
-Lemma level_age_to k {A} `{agA : ageable A} x : k <= level x -> level (age_to k x) = k.
-Proof.
-  intros L. unfold age_to.
-  rewrite level_age_by; lia.
-Qed.
-
-(* Proof techniques for age_to *)
-Lemma age_to_lt k {A} `{agA : ageable A} (x : A) : k < level x -> exists y, age x y /\ age_to k x = age_to k y.
-Proof.
-  intros L.
-  destruct (age1 x) as [y|] eqn:Ex; swap 1 2.
-  - rewrite age1_level0 in Ex. lia.
-  - exists y; split; auto.
-    unfold age_to.
-    pose proof age_level _ _ Ex as E.
-    replace (level x - k) with (S (level y - k)) by lia.
-    generalize (level y - k).
-    clear E L.
-    intros.
-    apply age_age_by, Ex.
-Qed.
-
-Lemma age_to_ge k {A} `{agA : ageable A} (x : A) : k >= level x -> age_to k x = x.
-Proof.
-  intros E. unfold age_to.
-  replace (level x - k) with 0 by lia.
-  reflexivity.
-Qed.
-
-Lemma age_to_eq k {A} `{agA : ageable A} (x : A) : k = level x -> age_to k x = x.
-Proof.
-  intros ->; apply age_to_ge, PeanoNat.Nat.le_refl.
-Qed.
-
-Lemma age_age_to n {A} `{agA : ageable A} x y : level x = S n -> age x y -> age_to n x = y.
-Proof.
-  intros E Y.
-  assert (L : (n < level x)%nat) by lia.
-  unfold age_to. rewrite E. replace (S n - n) with 1 by lia.
-  simpl. unfold age1'. rewrite Y. reflexivity.
-Qed.
-
-Lemma age_by_ind {A} `{agA : ageable A} (P : A -> Prop) :
-  (forall x y, age x y -> P x -> P y) ->
-  forall x n, P x -> P (age_by n x).
-Proof.
-  intros IH x n.
-  unfold age_by.
-  induction n; intros Px.
-  - auto.
-  - simpl. unfold age1' at 1.
-    destruct (age1 (Nat.iter n age1' x)) as [y|] eqn:Ey; auto.
-    eapply IH; eauto.
-Qed.
-
-Lemma age_to_ind {A} `{agA : ageable A} (P : A -> Prop) :
-  (forall x y, age x y -> P x -> P y) ->
-  forall x n, P x -> P (age_to n x).
-Proof.
-  intros IH x n.
-  apply age_by_ind, IH.
-Qed.
-
-Lemma age_to_ind_refined n {A} `{agA : ageable A} (P : A -> Prop) :
-  (forall x y, age x y -> n <= level y -> P x -> P y) ->
-  forall x, P x -> P (age_to n x).
-Proof.
-  intros IH x Px.
-  assert (dec : n >= level x \/ n <= level x) by lia.
-  destruct dec as [Ge|Le].
-  - rewrite age_to_ge; auto.
-  - eapply (age_to_ind (fun x => n <= level x -> P x)); auto.
-    + intros x0 y H H0 H1.
-      eapply IH; eauto.
-      apply age_level in H.
-      apply H0.
-      lia.
-    + rewrite level_age_to; auto.
-Qed.
-
-Lemma iter_iter n m {A} f (x : A) : Nat.iter n f (Nat.iter m f x) = Nat.iter (n + m) f x.
-Proof.
-  induction n; auto; simpl. rewrite IHn; auto.
-Qed.
-
-Lemma age_by_age_by n m  {A} `{agA : ageable A} (x : A) : age_by n (age_by m x) = age_by (n + m) x.
-Proof.
-  apply iter_iter.
-Qed.
-
-Lemma age_by_ind_opp {A} `{agA : ageable A} (P : A -> Prop) :
-  (forall x y, age x y -> P y -> P x) ->
-  forall x n, P (age_by n x) -> P x.
-Proof.
-  intros IH x n.
-  unfold age_by.
-  induction n; intros Px.
-  - auto.
-  - simpl in Px. unfold age1' at 1 in Px.
-    destruct (age1 (Nat.iter n age1' x)) as [y|] eqn:Ey; auto.
-    eapply IH in Ey; eauto.
-Qed.
-
-Lemma age_to_ind_opp {A} `{agA : ageable A} (P : A -> Prop) :
-  (forall x y, age x y -> P y -> P x) ->
-  forall x n, P (age_to n x) -> P x.
-Proof.
-  intros IH x n.
-  apply age_by_ind_opp, IH.
-Qed.
-
-Lemma rewrite_age_to {A} `{agA : ageable A} (P : A -> Prop) :
-  (forall x y, age x y -> P x <-> P y) ->
-  forall x n, P x <-> P (age_to n x).
-Proof.
-  intros IH x n; split.
-  - apply age_to_ind. intros; rewrite <-IH; eauto.
-  - apply age_to_ind_opp. intros; rewrite IH; eauto.
-Qed.
-
-Lemma level_age_to_le k {A} `{agA : ageable A} x : level (age_to k x) <= level x.
-Proof.
-  destruct (Compare_dec.le_lt_dec k (level x)) as [l|l]. rewrite level_age_to; auto.
-  rewrite age_to_ge; lia.
-Qed.
-
-Lemma level_age_to_le' k {A} `{agA : ageable A} x : level (age_to k x) <= k.
-Proof.
-  destruct (Compare_dec.le_lt_dec k (level x)) as [l|l]. rewrite level_age_to; auto.
-  rewrite age_to_ge; lia.
-Qed.
-
-Lemma age_by_necR {A} `{agA : ageable A} n x : necR x (age_by n x).
-Proof.
-  generalize (necR_refl x).
-  generalize x at 1 3; intros u.
-  apply age_by_ind; clear x.
-  intros x y a N.
-  constructor 3 with x; auto.
-  constructor; auto.
-Qed.
-
-Lemma age_to_necR {A} `{agA : ageable A} n x : necR x (age_to n x).
-Proof.
-  apply age_by_necR.
-Qed.
-
-Lemma necR_age_by {A} `{agA : ageable A} x x' : necR x x' -> x' = age_by (level x - level x') x.
-Proof.
-  intros N; induction N.
-  - rewrite (age_level _ _ H).
-    replace (S _ - _) with 1. 2:lia.
-    simpl. unfold age1'. rewrite H; auto.
-  - replace (_ - _) with 0. 2:lia. reflexivity.
-  - rewrite IHN2, IHN1.
-    rewrite age_by_age_by.
-    repeat rewrite level_age_by.
-    f_equal.
-    apply necR_level in N1.
-    apply necR_level in N2.
-    replace (_ x - (_ x - _ y)) with (level y) by lia.
-    replace (_ y - _ z + (_ x - _ y)) with (level x - level z) by lia.
-    lia.
-Qed.
-
-Lemma necR_age_to {A} `{agA : ageable A} x x' : necR x x' -> x' = age_to (level x') x.
-Proof.
-  apply necR_age_by.
-Qed.
-
-Lemma necR_age_by_iff {A} `{agA : ageable A} x x' : necR x x' <-> x' = age_by (level x - level x') x.
-Proof.
-  split. apply necR_age_by. intros ->. apply age_by_necR.
-Qed.
-
-Lemma necR_age_to_iff {A} `{agA : ageable A} x x' : necR x x' <-> x' = age_to (level x') x.
-Proof.
-  apply necR_age_by_iff.
-Qed.
-
-Lemma age_to_pred {A} `{agA : ageable A} {EO : Ext_ord A} (P : pred A) x n :
-  app_pred P x ->
-  app_pred P (age_to n x).
-Proof.
-  apply age_to_ind. clear x n.
-  destruct P as [x h]. apply h.
-Qed.
-
-Lemma age_by_pred {A} `{agA : ageable A} {EO : Ext_ord A} (P : pred A) x n :
-  app_pred P x ->
-  app_pred P (age_by n x).
-Proof.
-  apply age_by_ind. clear x n.
-  destruct P as [x h]. apply h.
-Qed.
-
-Lemma pred_age1' {A} `{agA : ageable A} {EO : Ext_ord A} (R : pred A) x : app_pred R x -> app_pred R (age1' x).
-Proof.
-  unfold age1'. destruct (age1 x) as [phi' | ] eqn:Ephi'; auto.
-  destruct R as [R [h ?]]. apply h. apply Ephi'.
-Qed.
-
-Lemma age_by_age_by_pred {A} `{agA : ageable A} {EO : Ext_ord A} (P : pred A) x n1 n2 :
-  le n1 n2 ->
-  app_pred P (age_by n1 x) ->
-  app_pred P (age_by n2 x).
-Proof.
-  intros l. replace n2 with ((n2 - n1) + n1) by lia.
-  rewrite <-age_by_age_by.
-  apply age_by_pred.
-Qed.
-
-Fixpoint composeOptN' {A} (f : A -> option A) n x :=
-  match n with
-  | 0 => Some x
-  | S n =>
-    match composeOptN' f n x with
-    | Some y => f y
-    | None => None
-    end
-  end.
-
-Lemma composeOptN_assoc_aux_None {A} (f : A -> option A) n x :
-  f x = None ->
-  match composeOptN f n x with
-  | Some x => f x
-  | None => None
-  end = None.
-Proof.
-  revert x; induction n; intros x E; simpl; auto.
-  destruct (f x); congruence.
-Qed.
-
-Lemma composeOptN_assoc_aux_Some {A} (f : A -> option A) n x y :
-  f x = Some y ->
-  match composeOptN f n x with
-  | Some x => f x
-  | None => None
-  end = composeOptN f n y.
-Proof.
-  revert x y; induction n; intros x y Ey; simpl. auto.
-  rewrite Ey.
-  destruct (f y) as [z|] eqn:Ez.
-  - eauto.
-  - apply composeOptN_assoc_aux_None, Ez.
-Qed.
-
-Lemma composeOptN_assoc {A} (f : A -> option A) n x :
-  composeOptN f n x = composeOptN' f n x.
-Proof.
-  revert x; induction n; intros x; simpl. auto.
-  destruct (f x) as [y|] eqn:Ey; rewrite <-IHn.
-  - erewrite composeOptN_assoc_aux_Some; eauto.
-  - rewrite composeOptN_assoc_aux_None; eauto.
-Qed.
-
-Lemma age_by_ageN {A} `{agA : ageable A} n (x : A) :
-  n <= level x ->
-  ageN n x = Some (age_by n x).
-Proof.
-  revert x; induction n; intros x l. reflexivity.
-  unfold ageN.
-  rewrite composeOptN_assoc; simpl; rewrite <-composeOptN_assoc.
-  change (composeOptN age1 n x) with (ageN n x).
-  rewrite IHn. 2:lia.
-  unfold age1' in *.
-  destruct (age1 (age_by n x)) as [y|] eqn:Ey. auto.
-  exfalso. rewrite age1_level0 in Ey.
-  rewrite level_age_by in Ey. lia.
-Qed.
-
-Lemma age_to_ageN {A} `{agA : ageable A} n (x : A) :
-  ageN (level x - n) x = Some (age_to n x).
-Proof.
-  apply age_by_ageN. lia.
-Qed.
-
-Lemma age_by_1 {A} {_ : ageable A} x : 0 < level x -> age x (age_by 1 x).
-Proof.
-  intros l.
-  unfold age_by, age1'; simpl.
-  destruct (age1 x) eqn:E; eauto.
-  apply age1_level0 in E.
-  lia.
-Qed.
-
-Lemma age_to_1 {A} {_ : ageable A} n x : level x = S n -> age x (age_to n x).
-Proof.
-  unfold age_to; intros E; rewrite E.
-  replace (S n - n) with 1 by lia.
-  apply age_by_1. lia.
-Qed.
-
-Lemma age_to_identy {A} `{asaA: Age_alg A}: forall k phi,
-    identity phi -> identity (age_to k phi).
-Proof.
-  intros k phi. unfold age_to. generalize (level phi - k); intros n; revert phi.
-  induction n; intros phi id; simpl; auto. unfold age1'.
-  destruct (age1 (age_by n phi)) eqn:E; auto.
-  eapply age_identity. apply E. auto.
-Qed.
-
-Lemma age_to_join_eq {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO : Ext_ord A}  :
-  forall k x1 x2 x3,
-    join x1 x2 x3 ->
-    k <= level x3 ->
-    join (age_to k x1) (age_to k x2) (age_to k x3).
-Proof.
-  intros k x1 x2 x3 J.
-  remember (level x3) as l3 eqn:e3; symmetry in e3.
-  pose proof join_level _ _ _ J as [e1 e2]; rewrite e3 in e1, e2.
-  revert l3 x1 x2 x3 e1 e2 e3 J.
-  intros n; induction n as [ n IHn ] using strong_nat_ind. intros x1 x2 x3 e1 e2 e3 J L.
-  destruct (Compare_dec.le_lt_eq_dec _ _ L) as [Lt | ->]; swap 1 2.
-  now do 3 (rewrite age_to_eq at 1; auto).
-  assert (l1 : k < level x1) by lia.
-  assert (l2 : k < level x2) by lia.
-  assert (l3 : k < level x3) by lia.
-  destruct (age_to_lt _ x1 l1) as [x1' [E1 ->]].
-  destruct (age_to_lt _ x2 l2) as [x2' [E2 ->]].
-  destruct (age_to_lt _ x3 l3) as [x3' [E3 ->]].
-  pose proof @age1_join_eq A _ _ _ _ _ _ _ _ J _ E1 _ E2 _ E3.
-  pose proof @af_level2 A level age1 (@age_facts _ agA) _ _ E1.
-  pose proof @af_level2 A level age1 (@age_facts _ agA) _ _ E2.
-  pose proof @af_level2 A level age1 (@age_facts _ agA) _ _ E3.
-  apply IHn with (level x1'); lia || auto.
-Qed.
diff --git a/msl/ageable.v b/msl/ageable.v
deleted file mode 100644
index 517be5c888..0000000000
--- a/msl/ageable.v
+++ /dev/null
@@ -1,940 +0,0 @@
-(*
- * Copyright (c) 2009-2010, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-
-Require Import VST.msl.base.
-  Require Coq.funind.Recdef.
-
-Local Open Scope nat_scope.
-
-Record ageable_facts (A:Type) (level: A -> nat) (age1:A -> option A)  :=
-{ af_unage : forall x':A, exists x, age1 x = Some x'
-; af_level1 : forall x, age1 x = None <-> level x = 0
-; af_level2 : forall x y, age1 x = Some y -> level x = S (level y)
-}.
-
-Arguments af_unage [A] [level] [age1] _ _.
-Arguments af_level1 [A] [level] [age1] _ _.
-Arguments af_level2 [A] [level] [age1] _ _ _ _.
-
-Class ageable (A:Type) := mkAgeable
-{ level : A -> nat
-; age1 : A -> option A
-; age_facts : ageable_facts A level age1
-}.
-
-Definition age {A} `{ageable A} (x y:A) := age1 x = Some y.
-
-Lemma af_wf {A} `{ageable A} :
- well_founded (fun x y => age y x).
-Proof.
-  intros.
-  intro.
-  remember (level a).
-  revert a Heqn.
-  induction n; intros; constructor; intros.
-  apply (af_level2 age_facts) in H0.
-  rewrite H0 in Heqn.
-  inversion Heqn.
-  copy H0.
-  apply (af_level2 age_facts) in H0.
-  apply IHn.
-  lia.
-Qed.
-Arguments af_wf [A] _ _.
-
-Definition age_induction {A} `{ageable A} :=
-  well_founded_induction (af_wf _).
-
-Definition fashionR {A1} `{ageable A1} {A2}`{ageable A2} (x:A1) (y: A2) : Prop :=
-  level x = level y.
-
-Lemma fashionR_refl {A} `{ageable A} : reflexive _ fashionR.
-Proof.
-  repeat intro; hnf; auto.
-Qed.
-
-Lemma fashionR_trans {A} `{ageable A} {B} `{ageable B} {C} `{ageable C} :
-    forall (x: A) (y: B) (z: C), fashionR x y -> fashionR y z -> fashionR x z.
-Proof.
-  unfold fashionR; intros; congruence.
-Qed.
-
-Lemma fashionR_sym {A} `{ageable A} {B} `{ageable B}:
-   forall (x: A) (y: B), fashionR x y -> fashionR y x.
-Proof.
-  unfold fashionR; intros; auto.
-Qed.
-
-Lemma age_level {A} `{ageable A} : forall (x y:A),
-  age x y -> level x = S (level y).
-Proof.
-  intros.
-  apply (af_level2 age_facts); auto.
-Qed.
-
-Lemma age1_level0 {A} `{ageable A} : forall (x:A),
-  age1 x = None <-> level x = 0.
-Proof.
-  intros; apply (af_level1 age_facts).
-Qed.
-
-Section level'.
-  Variable A:Type.
-  Variable ag:ageable A.
-
-  Function level' (x:A) { wf (fun x y => @age A ag y x)  x } : nat :=
-(*  Function level' (x:A) { wf (transp _ (@age A ag)) x } : nat := *)
-    match age1 x with
-    | None => 0
-    | Some x' => S (level' x')
-    end.
-    intros. hnf. assumption.
-    unfold transp. apply (af_wf _).
-  Defined.
-
-  Theorem level_level' : forall x:A, level x = level' x.
-  Proof.
-    intro x; induction x using age_induction; intros.
-    rewrite level'_equation.
-    case_eq (age1 x); intros.
-    rewrite (af_level2 age_facts x a); auto.
-    rewrite <- age1_level0; auto.
-  Qed.
-End level'.
-
-Lemma levelS_age1 {A} `{ageable A} : forall (x:A) n,
-  level x = S n ->
-  exists y, age1 x = Some y.
-Proof.
-  intros; rewrite level_level' in H0.
-  rewrite level'_equation in H0.
-  destruct (age1 x); eauto.
-  inv H0.
-Qed.
-
-Lemma age1_levelS {A} `{ageable A} : forall (x y:A),
-  age1 x = Some y ->
-  exists n, level x = S n.
-Proof.
-  intros; rewrite level_level'.
-  rewrite level'_equation.
-  destruct (age1 x); eauto.
-  inv H0.
-Qed.
-
-Lemma age1_level0_absurd {A} `{ageable A} : forall (x y:A),
-  age1 x = Some y ->
-  level x = 0 ->
-  False.
-Proof.
-  intros.
-  rewrite <- age1_level0 in H1.
-  rewrite H0 in H1; discriminate.
-Qed.
-
-Lemma age1None_levelS_absurd {A} `{ageable A} : forall (x:A) n,
-  age1 x = None ->
-  level x = S n ->
-  False.
-Proof.
-  intros.
-  rewrite age1_level0 in H0.
-  rewrite H0 in H1; discriminate.
-Qed.
-
-Section RtRft.
-  Variable A:Type.
-  Variable R:relation A.
-
-  Let Rt := clos_trans A R.
-  Let Rft := clos_refl_trans A R.
-
-  Lemma Rt_Rft : forall x y, Rt x y -> Rft x y.
-  Proof.
-    intros; elim H; intros.
-    apply rt_step; auto.
-    eapply rt_trans; eauto.
-  Qed.
-
-  Lemma Rt_Rft_trans : forall x y z, Rt x y -> Rft y z -> Rt x z.
-  Proof.
-    intros x y z H H1; revert x H; elim H1; intros; auto.
-    eapply t_trans; eauto; apply t_step; auto.
-  Qed.
-
-  Lemma Rft_Rt_trans : forall x y z, Rft x y -> Rt y z -> Rt x z.
-  Proof.
-    intros x y z H; revert z; elim H; intros; auto.
-    eapply t_trans; eauto; apply t_step; auto.
-  Qed.
-
-  Lemma transpose_clos_trans : forall A R x y,
-    clos_trans A (transp A R) x y <-> transp A (clos_trans A R) x y.
-  Proof.
-    unfold transp; intuition.
-
-    elim H; intros.
-    apply t_step; auto.
-    apply t_trans with y0; auto.
-
-    elim H; intros.
-    apply t_step; auto.
-    apply t_trans with y0; auto.
-  Qed.
-End RtRft.
-
-#[export] Hint Resolve rt_refl : core.
-
-Definition laterR {A} `{ageable A} : relation A := clos_trans A age.
-Definition necR   {A} `{ageable A} : relation A := clos_refl_trans A age.
-
-Require Coq.Wellfounded.Wellfounded.
-Lemma laterR_wf {A} `{ageable A} :
-  well_founded (transp _ laterR).
-Proof.
-  intros.
-  hnf; intro.
-  induction a using
-    (well_founded_induction (Wellfounded.Transitive_Closure.wf_clos_trans _ (fun x y => age y x) (af_wf _))).
-  constructor; intros.
-  unfold laterR in H1.
-  rewrite <- transpose_clos_trans in H1.
-  apply H0; auto.
-Qed.
-
-Definition laterR_induction {A} `{ageable A} :=
-  @well_founded_induction A (transp A laterR) laterR_wf.
-
-Lemma age_irreflexive {A}  `{ageable A}: forall x, age x x -> False.
-Proof.
-  intros x.
-  induction x using age_induction; intros.
-  apply H0 with x; auto.
-Qed.
-
-Lemma laterR_irreflexive {A} `{HA: ageable A} : forall x, laterR x x -> False.
-Proof.
-  intros x.
-  induction x using laterR_induction; intros.
-  apply H with x; auto.
-Qed.
-
-Lemma nec_refl_or_later {A} `{ageable A} : forall x y,
-  necR x y -> x = y \/ laterR x y.
-Proof.
-  intros.
-  elim H0; intros; auto.
-  right; apply t_step; auto.
-  destruct H2; destruct H4; subst; auto.
-  right; apply t_trans with y0; auto.
-Qed.
-
-Lemma necR_antisym {A} `{ageable A} : forall x y,
-  necR x y -> necR y x -> x = y.
-Proof.
-  intros.
-  apply nec_refl_or_later in H0.
-  apply nec_refl_or_later in H1.
-  intuition.
-  elim (laterR_irreflexive x).
-  eapply t_trans; eauto.
-Qed.
-
-Lemma age_later_nec {A} `{HA: ageable A} : forall x y z,
-  age x y ->
-  laterR x z ->
-  necR y z.
-Proof.
-  intros x y z H H1; revert y H.
-  induction H1; intros.
-  replace y0 with y.
-  apply rt_refl.
-  unfold age in *; congruence.
-  apply rt_trans with y; auto.
-  apply IHclos_trans1; auto.
-  apply Rt_Rft; auto.
-Qed.
-
-Lemma necR_level {A} `{X: ageable A} : forall (x y:A),
-  necR x y ->
-  level x >= level y.
-Proof.
-  intros x y H; induction H; auto.
-  rewrite (age_level x y); auto.
-  lia.
-Qed.
-
-Lemma laterR_level {A} `{X: ageable A} : forall (x y:A),
-  laterR x y ->
-  level x > level y.
-Proof.
-  intros x y H; induction H; auto.
-  rewrite (age_level x y); auto.
-  lia.
-Qed.
-
-Section NAT_AGEABLE.
-
-  Definition natLevel (x:nat) : nat := x.
-  Definition natAge1 (x:nat) : option nat :=
-    match x with
-    | 0 => None
-    | S n => Some n
-    end.
-  Definition natUnage (x:nat) : nat := S x.
-
-  Lemma ag_nat_facts :
-    ageable_facts nat natLevel natAge1.
-  Proof.
-    constructor.
-    intros; exists (S x'); compute; auto.
-    intro x; destruct x; intuition; inv H.
-    firstorder;
-      destruct x; inv H; compute; eauto.
-  Qed.
-
-  Definition ag_nat : ageable nat :=
-    mkAgeable nat natLevel natAge1 ag_nat_facts.
-
-  Lemma nec_nat : forall (n n':nat),
-    @necR _ ag_nat n n' <-> n' <= n.
-  Proof.
-    intros. split; intro.
-    induction H.
-    destruct x; inv H; auto.
-    auto.
-    lia.
-
-    induction H.
-    apply rt_refl.
-    apply rt_trans with m.
-    apply rt_step. compute; auto.
-    auto.
-  Qed.
-
-  Lemma later_nat : forall (n n':nat),
-    @laterR _ ag_nat n n' <-> n' < n.
-  Proof.
-    intros. split; intro.
-    induction H.
-    destruct x; simpl in H.
-    inv H.
-    inv H. lia.
-    lia.
-    hnf in H.
-    inv H.
-    apply t_step.
-    compute; auto.
-    apply Rt_Rft_trans with m.
-    apply t_step. compute; auto.
-    change (@necR _ ag_nat m n').
-    rewrite nec_nat.
-    lia.
-  Qed.
-
-End NAT_AGEABLE.
-
-
-Lemma laterR_level' {A} `{H : ageable A}: forall {w1 w2: A}, laterR w1 w2 -> @laterR _ ag_nat (level w1) (level w2).
-Proof.
-induction 1.
-constructor 1. apply age_level in H0. rewrite H0; reflexivity.
-constructor 2 with (level y); auto.
-Qed.
-
-Lemma necR_nat {A} `{H : ageable A}:
-    forall {x y: A}, necR x y -> @necR nat ag_nat (level x) (level y).
-  Proof.
-    intros. apply necR_level in H0.
-     induction H0; simpl in *. constructor 2.
-     constructor 3 with m. constructor 1. constructor.
-     auto.
-  Qed.
-
-Section BIJECTION.
-  Variable A B : Type.
-  Variable ag: ageable A.
-  Variable bijAB: bijection A B.
-
-  Let levelB (x:B) : nat :=
-    level (bij_g _ _ bijAB x).
-
-  Let age1B  (x: B) : option B :=
-     match age1 (bij_g _ _ bijAB x) with
-     | Some y => Some (bij_f _ _ bijAB y)
-     | None => None
-     end.
-
-  Let ageB (x y: B) :=age1B x = Some y.
-
-  Lemma age_bij_unage :
-    forall x', exists x, age1B x = Some x'.
-  Proof.
-    unfold age1B, levelB; simpl; intros.
-    destruct bijAB as [f g fg gf]; simpl in *.
-    destruct (af_unage age_facts (g x')) as [y ?].
-   exists (f y). rewrite gf. rewrite H. f_equal. apply fg.
-  Qed.
-
-  Lemma age_bij_level1 :
-    forall x, age1B x = None <-> levelB x = 0.
-  Proof.
-    intros.
-    unfold age1B, levelB; simpl.
-    destruct bijAB as [f g fg gf]; simpl.
-    case_eq (age1 (g x)); intuition; try discriminate.
-    rewrite <- age1_level0 in H1.
-    rewrite H0 in H1; discriminate.
-    rewrite <- age1_level0; auto.
-  Qed.
-
-  Lemma age_bij_level2 :
-    forall x y, age1B x = Some y -> levelB x = S (levelB y).
-  Proof.
-    intros.
-    unfold age1B, levelB in *; simpl in *.
-    destruct bijAB as [f g fg gf]; simpl in *.
-    case_eq (age1 (g x)); intros; rewrite H0 in H; inv H.
-    rewrite gf.
-    apply (af_level2 age_facts); auto.
-  Qed.
-
-  Lemma ag_bij_facts : ageable_facts B levelB age1B.
-  Proof.
-    constructor.
-    exact age_bij_unage.
-    exact age_bij_level1.
-    exact age_bij_level2.
-  Qed.
-
-  Definition ag_bij : ageable B :=
-    mkAgeable B levelB age1B ag_bij_facts.
-End BIJECTION.
-
-Section PROD.
-  Variable A B : Type.
-  Variable agA: ageable A.
-
-  Let levelAB (x:prod A B) := level (fst x).
-  Let age1AB (x:prod A B) :=
-    match age1 (fst x) with
-    | None => None
-    | Some a' => Some (a',snd x)
-    end.
-
-  Lemma ag_prod_facts : ageable_facts (prod A B) levelAB age1AB.
-  Proof.
-    constructor.
-    unfold levelAB, age1AB; simpl; intros.
-    destruct (af_unage age_facts (fst x')) as [y1 ?].
-    exists (y1, snd x'). simpl. rewrite H. f_equal. destruct x'; auto.
-    intros [a b]; firstorder.
-    unfold age1AB in H; simpl in H.
-    case_eq (age1 a); intros; rewrite H0 in H; inv H.
-    unfold levelAB; simpl.
-    rewrite <- age1_level0; auto.
-    unfold levelAB in H.
-    simpl in H.
-    rewrite <- age1_level0 in H.
-    unfold age1AB; simpl.
-    rewrite H; auto.
-    intros.
-    unfold age1AB in H.
-    unfold levelAB.
-    destruct x; simpl in *.
-    case_eq (age1 a); intros; rewrite H0 in H; inv H.
-    simpl.
-    apply age_level; auto.
-  Qed.
-
-  Definition ag_prod :=
-    mkAgeable (prod A B) levelAB age1AB ag_prod_facts.
-
-  Lemma prod_nec_split : forall n x n' x',
-    @necR (prod A B) ag_prod (n,x) (n',x') <-> necR n n' /\ x = x'.
-  Proof.
-    intros; split; intro.
-    remember (n,x) as w.
-    remember (n',x') as w'.
-    revert n x n' x' Heqw Heqw'.
-    induction H; simpl; intros; subst; auto.
-    unfold age in H. simpl in H.
-    unfold age1AB in H. simpl in H.
-    case_eq (age1 n); intros; rewrite H0 in H; inv H.
-    split; auto.
-    apply rt_step. auto.
-    inv Heqw'.
-    split; auto.
-    apply rt_refl.
-    specialize (IHclos_refl_trans1 n x0 (fst y) (snd y)).
-    spec IHclos_refl_trans1; auto.
-    spec IHclos_refl_trans1; destruct y; auto.
-    simpl in *.
-    specialize (IHclos_refl_trans2 a b n' x').
-    spec IHclos_refl_trans2; auto.
-    spec IHclos_refl_trans2; auto.
-    intuition. eapply rt_trans; eauto.
-    congruence.
-
-    destruct H; subst.
-    induction H.
-    apply rt_step. hnf.
-    hnf in H. simpl.
-    unfold age1AB. simpl. rewrite H. auto.
-    apply rt_refl.
-    eapply rt_trans; eauto.
-  Qed.
-
-  Lemma prod_later_split : forall n x n' x',
-    @laterR (prod A B) ag_prod (n,x) (n',x') <-> laterR n n' /\ x = x'.
-  Proof.
-    intros; split; intro.
-    remember (n,x) as w.
-    remember (n',x') as w'.
-    revert n x n' x' Heqw Heqw'.
-    induction H; simpl; intros; subst; auto.
-    unfold age in H. simpl in H.
-    unfold age1AB in H; simpl in H.
-    case_eq (age1 n); intros; rewrite H0 in H; inv H.
-    split; auto.
-    apply t_step. compute. auto.
-    specialize (IHclos_trans1 n x0 (fst y) (snd y)).
-    spec IHclos_trans1; auto.
-    spec IHclos_trans1; destruct y; auto.
-    simpl in *.
-    specialize (IHclos_trans2 a b n' x').
-    spec IHclos_trans2; auto.
-    spec IHclos_trans2; auto.
-    intuition. eapply t_trans; eauto.
-    congruence.
-
-    destruct H; subst.
-    induction H.
-    apply t_step.
-    hnf; simpl. unfold age1AB. simpl; rewrite H. auto.
-    eapply t_trans; eauto.
-  Qed.
-
-End PROD.
-
-Section PROD'.
-  Variable A B : Type.
-  Variable agB: ageable B.
-
-  Let levelAB (x:prod A B) := level (snd x).
-  Let age1AB (x:prod A B) :=
-    match age1 (snd x) with
-    | None => None
-    | Some a' => Some (fst x, a')
-    end.
-
-  Lemma ag_prod'_facts : ageable_facts (prod A B) levelAB age1AB.
-  Proof.
-    constructor.
-    unfold levelAB, age1AB; simpl; intros.
-    destruct (af_unage age_facts (snd x')) as [y2 ?].
-    exists (fst x', y2). simpl. rewrite H. f_equal. destruct x'; auto.
-    intros [a b]; firstorder.
-    unfold age1AB in H; simpl in H.
-    case_eq (age1 b); intros; rewrite H0 in H; inv H.
-    unfold levelAB; simpl.
-    rewrite <- age1_level0; auto.
-    unfold levelAB in H.
-    simpl in H.
-    rewrite <- age1_level0 in H.
-    unfold age1AB; simpl.
-    rewrite H; auto.
-    intros.
-    unfold age1AB in H.
-    unfold levelAB.
-    destruct x; simpl in *.
-    case_eq (age1 b); intros; rewrite H0 in H; inv H.
-    simpl.
-    apply age_level; auto.
-  Qed.
-
-  Definition ag_prod' :=
-    mkAgeable (prod A B) levelAB age1AB ag_prod'_facts.
-
-  Lemma prod'_nec_split : forall n x n' x',
-    @necR (prod A B) ag_prod' (x,n) (x',n') <-> necR n n' /\ x = x'.
-  Proof.
-    intros; split; intro.
-    remember (x,n) as w.
-    remember (x',n') as w'.
-    revert n x n' x' Heqw Heqw'.
-    induction H; simpl; intros; subst; auto.
-    unfold age in H. simpl in H.
-    unfold age1AB in H. simpl in H.
-    case_eq (age1 n); intros; rewrite H0 in H; inv H.
-    split; auto.
-    apply rt_step. auto.
-    inv Heqw'.
-    split; auto.
-    apply rt_refl.
-    specialize (IHclos_refl_trans1 n x0 (snd y) (fst y)).
-    spec IHclos_refl_trans1; auto.
-    spec IHclos_refl_trans1; destruct y; auto.
-    simpl in *.
-    specialize ( IHclos_refl_trans2 b a n' x').
-    spec IHclos_refl_trans2; auto.
-    spec IHclos_refl_trans2; auto.
-    intuition. eapply rt_trans; eauto.
-    congruence.
-
-    destruct H; subst.
-    induction H.
-    apply rt_step. hnf.
-    hnf in H. simpl.
-    unfold age1AB. simpl. rewrite H. auto.
-    apply rt_refl.
-    eapply rt_trans; eauto.
-  Qed.
-
-  Lemma prod'_later_split : forall n x n' x',
-    @laterR (prod A B) ag_prod' (x,n) (x',n') <-> laterR n n' /\ x = x'.
-  Proof.
-    intros; split; intro.
-    remember (x,n) as w.
-    remember (x',n') as w'.
-    revert n x n' x' Heqw Heqw'.
-    induction H; simpl; intros; subst; auto.
-    unfold age in H. simpl in H.
-    unfold age1AB in H; simpl in H.
-    case_eq (age1 n); intros; rewrite H0 in H; inv H.
-    split; auto.
-    apply t_step. compute. auto.
-    specialize (IHclos_trans1 n x0 (snd y) (fst y)).
-    spec IHclos_trans1; auto.
-    spec IHclos_trans1; destruct y; auto.
-    simpl in *.
-    specialize ( IHclos_trans2 b a n' x').
-    spec IHclos_trans2; auto.
-    spec IHclos_trans2; auto.
-    intuition. eapply t_trans; eauto.
-    congruence.
-
-    destruct H; subst.
-    induction H.
-    apply t_step.
-    hnf; simpl. unfold age1AB. simpl; rewrite H. auto.
-    eapply t_trans; eauto.
-  Qed.
-
-End PROD'.
-
-Fixpoint composeOptN (A: Type) (f: A -> option A)
-         (n: nat) (w: A) {struct n} : option A :=
- match n  with
- | S n' => match f w with Some w' => composeOptN A f n' w' | None => None end
- | O => Some w
- end.
-Arguments composeOptN [A] _ _ _.
-
-Definition ageN {A} `{ageable A}: nat -> A -> option A := composeOptN age1.
-
-Lemma ageN1  {A} `{ageable A}: ageN 1 = age1.
-Proof.
-intros.
-unfold ageN. simpl.
-extensionality phi.
-case_eq (age1 phi); intros; try rewrite H; auto.
-Qed.
-
-Lemma ageN_compose {A} `{agA : ageable A}:
- forall a b c phi1 phi2 phi3,ageN a phi1 = Some phi2 ->
-       ageN b phi2 = Some phi3 ->  (a+b=c)%nat ->  ageN c phi1 = Some phi3.
-Proof.
-unfold ageN in *.
-induction a; simpl; intros.
-subst. inversion H; clear H. auto.
-subst c.
-case_eq (age1 phi1); intros; rewrite H1 in H; try discriminate.
-simpl.
-rewrite H1.
-eapply IHa; eauto.
-Qed.
-
-Lemma ageN_compose' {A} `{agA : ageable A}:
-  forall a b phi1 phi3,
-   ageN (a+b)%nat phi1 = Some phi3 -> exists phi2, ageN a phi1 = Some phi2 /\ ageN b phi2 = Some phi3.
-Proof.
-intros.
-case_eq (ageN a phi1); intros.
-rename a0 into phi.
-exists phi.
-split; auto.
-case_eq (ageN b phi); intros.
-rename a0 into phi0.
-generalize (ageN_compose a b (a+b) phi1 _ _ H0 H1 (refl_equal _)); intro.
-rewrite H in H2; auto.
-exfalso.
-revert phi1 phi H H1 H0; induction a; intros.
-simpl in *.
-inv H0.
-rewrite H in H1; discriminate.
-replace (S a + b)%nat with (S (a+b))%nat in H by lia.
-unfold ageN in *;
-simpl in *.
-case_eq (age1 phi1); intros; rewrite H2 in H; try discriminate.
-rewrite H2 in H0.
-eapply IHa; eauto.
-exfalso.
-unfold ageN in *.
-revert phi1 H H0; induction a; intros.
-simpl in *. discriminate.
-replace (S a + b)%nat with (S (a+b))%nat in H by lia.
-simpl in *.
-revert H H0; case_eq (age1 phi1); intros; try discriminate.
-eapply IHa; eauto.
-Qed.
-
-Lemma necR_evolve {A} `{agA : ageable A}:
-    necR = fun (phi phi': A) => exists n, ageN n phi = Some phi'.
-Proof.
-extensionality w w'.
-apply prop_ext; split; intros.
-unfold necR in H.
-induction H.
-exists 1%nat. rewrite ageN1.
-simpl.
-auto.
-exists O; auto.
-destruct IHclos_refl_trans1 as [n1 ?].
-destruct IHclos_refl_trans2 as [n2 ?].
-exists (n1+n2)%nat.
-eapply ageN_compose; eauto.
-destruct H as [n ?].
-revert w w' H; induction n; intros.
-inv H.
-constructor 2.
-unfold ageN in H.
-simpl in H.
-revert H; case_eq (age1 w); intros; try discriminate.
-constructor 3 with a.
-constructor 1; auto.
-apply IHn; auto.
-Qed.
-
-Lemma age_noetherian  {A} `{ageable A}: forall phi, exists n, ageN n phi = None.
-Proof.
-  intros.
-  induction phi using age_induction.
-  rename x into phi.
-  case_eq (age1 phi); intros.
-  generalize H1; intros.
-  apply H0 in H1.
-  destruct H1 as [n ?].
-  exists (S n).
-  unfold ageN; simpl.
-  rewrite H2; auto.
-  exists (S O); simpl.
-  unfold ageN; simpl.
-  rewrite H1.
-  auto.
-Qed.
-
-Lemma predicate_max:
-  forall (F: nat -> Prop) (Fdec: forall n, {F n}+{~ F n}) n,
-  F 0%nat ->
-  ~ F n ->
-  exists i, F i /\ (i<n)%nat /\ ~ F (S i).
-Proof.
-intros.
-assert (forall m, (m <= n)%nat ->
-         (forall k, (k<m)%nat -> F k) \/
-         (exists i, F i /\ (i<m)%nat /\ ~ F (S i))).
-induction m.
-left; intros.
-exfalso; lia.
-intro.
-assert (m<=n)%nat; try lia.
-destruct (IHm H2).
-assert (m < n \/ m = n)%nat; try lia.
-destruct H4.
-destruct (Fdec m) as [?H|?H].
-left.
-intros.
-assert (k < m \/ k = m)%nat; try lia.
-destruct H7.
-auto.
-subst k; auto.
-right.
-exists (Peano.pred m).
-destruct m.
-contradiction.
-replace (Peano.pred (S m)) with m; try lia.
-split.
-apply H3; try lia.
-split; try lia.
-auto.
-subst m.
-right.
-destruct n.
-contradiction.
-exists n; repeat split; auto; try lia.
-right.
-destruct H3 as [i H4].
-destruct H4.
-destruct H4.
-exists i; repeat split; auto; lia.
-assert (n <= n)%nat; try lia.
-destruct (H1 _ H2).
-destruct n; try contradiction.
-exists n; repeat split; auto; try lia.
-auto.
-Qed.
-
-Lemma age_noetherian'  {A} `{agA : ageable A}:
-       forall phi, exists! n, exists phi', ageN n phi = Some phi' /\ age1 phi' = None.
-Proof.
-intros.
-destruct (age_noetherian phi) as [n ?].
-assert (Fdec: forall n, {ageN n phi <> None}+{~( ageN n phi <> None)})
-  by (intros; destruct (ageN n0 phi); auto; left; intro Hx; inversion Hx).
-destruct (predicate_max (fun n => ageN n phi <> None) Fdec n) as [i [? [? ?]]].
-intro. inv H0.
-intro.
-rewrite H in H0.
-contradiction H0; auto.
-exists i.
-split.
-revert H0; case_eq (ageN i phi); intros.
-exists a; split; auto.
-revert H2; case_eq (ageN (S i) phi); intros.
-contradiction H4.
-intro Hx; inv Hx.
-clear - H0 H2.
-revert phi a H0 H2; induction i; intros.
-inv H0.
-rewrite ageN1 in H2; auto.
-unfold ageN in *.
-simpl in H0.
-revert H0; case_eq (age1 phi); intros; try discriminate.
-simpl in H2.
-rewrite H in H2.
-eapply IHi.
-eauto.
-simpl.
-auto.
-contradiction H3; auto.
-intros.
-destruct H3 as [phi' [? ?]].
-assert (ageN (S i) phi = None).
-clear - H2.
-revert H2; case_eq (ageN (S i) phi); intros.
-contradict H2. intro Hx; inv Hx.
-auto. clear H2.
-clear - H0 H5 H3 H4.
-revert H0; case_eq (ageN i phi); intros.
-2: contradiction H0; auto.
-clear H0.
-assert (age1 a = None).
-clear - H H5.
-revert phi H5 H; induction i; intros.
-inv H; rewrite ageN1 in H5; auto.
-unfold ageN in *.
-revert H H5; simpl. case_eq (age1 phi); intros; try discriminate.
-eapply IHi; eauto.
-clear H5.
-assert (forall i d phi a a', ageN i phi = Some a -> ageN (i+d) phi = Some a' -> age1 a' = None -> age1 a = None -> d=0%nat).
-clear.
-induction i; intros.
-inv H.
-destruct d; auto.
-simpl in H0.
-unfold ageN in H0. simpl in H0.
-rewrite H2 in H0. inv H0.
-unfold ageN in H, H0. simpl in *.
-revert H; case_eq (age1 phi); intros; try discriminate.
-rewrite H in H0.
-eauto.
-assert (i<x' \/ i=x' \/ i>x')%nat by lia.
-destruct H2 as [?| [?| ?]]; auto.
-replace x' with (i+(x'-i))%nat in H3 by lia.
-specialize (H1 _ _ _ _ _ H H3 H4 H0).
-lia.
-replace i with (x'+(i-x'))%nat in H by lia.
-specialize (H1 _ _ _ _ _ H3 H H0 H4).
-lia.
-Qed.
-
-Lemma ageable_ext:
-   forall A (B C: ageable A),
-      @age1 _ B = @age1 _ C -> @level _ B = @level _ C -> B=C.
-Proof.
-intros.
-destruct B; destruct C.
-simpl in *.
-subst age3. subst level0.
-replace age_facts1 with age_facts0; auto.
-apply proof_irr.
-Qed.
-
-Lemma necR_linear {A} `{H : ageable A}:
-  forall {a b c}, necR a b -> necR a c -> necR b c \/ necR c b.
-Proof.
-intros.
-apply trans_rt1n in H0.
-apply trans_rt1n in H1.
-revert c H1; induction H0; intros; auto.
-left; apply rt1n_trans; auto.
-inversion H2; subst.
-right.
-apply rt_trans with y.
-constructor 1; auto.
-apply rt1n_trans; auto.
-unfold age in H0,H3.
-rewrite H0 in H3; inv H3.
-destruct (IHclos_refl_trans_1n _ H4); auto.
-Qed.
-
-Lemma necR_linear' {A} `{H : ageable A}:
-   forall {a b c}, necR a b -> necR a c -> level b = level c -> b=c.
-Proof.
-intros.
-destruct (necR_linear H0 H1).
-clear - H2 H3.
-apply nec_refl_or_later in H3.
-destruct H3; auto.
-apply laterR_level in H0; unfold fashionR in H2; exfalso; lia.
-apply nec_refl_or_later in H3.
-destruct H3; auto.
-apply laterR_level in H3; unfold fashionR in H2; exfalso; lia.
-Qed.
-
-Lemma laterR_necR {A} `{agA : ageable A}:
-  forall {x y}, laterR x y -> necR x y.
-Proof.
-induction 1; intros.
-constructor; auto.
-econstructor 3; auto.
-apply rt_trans with y; auto.
-Qed.
-
-Lemma necR_refl {A} `{H : ageable A}:
-  forall phi, necR phi phi.
-Proof.
-intros; constructor 2.
-Qed.
-
-#[export] Hint Resolve necR_refl : core.
-
-Lemma necR_trans  {A} `{H : ageable A}:
-  forall phi1 phi2 phi3, necR phi1 phi2 -> necR phi2 phi3 -> necR phi1 phi3.
-Proof.
-intros.
-econstructor 3; eauto.
-Qed.
-
-Lemma necR_laterR {A} `{agA : ageable A}:
-  forall w1 w2 w3, necR w1 w2 -> laterR w2 w3 -> laterR w1 w3.
-Proof.
-intros.
-revert w3 H0; induction H; intros.
-econstructor 2. constructor 1; eauto. apply H0.
-auto.
-auto.
-Qed.
diff --git a/msl/alg_seplog.v b/msl/alg_seplog.v
deleted file mode 100644
index 883cc890e9..0000000000
--- a/msl/alg_seplog.v
+++ /dev/null
@@ -1,223 +0,0 @@
-Require Import VST.msl.seplog.
-Require Import VST.msl.base.
-Require Import VST.msl.ageable.
-Require Import VST.msl.sepalg.
-Require Import VST.msl.age_sepalg.
-Require Import VST.msl.predicates_hered.
-Require Import VST.msl.predicates_sl.
-Require Import VST.msl.subtypes.
-Require Import VST.msl.subtypes_sl.
-Require Import VST.msl.predicates_rec.
-Require Import VST.msl.contractive.
-Require VST.msl.normalize.
-
-Local Open Scope logic.
-
-Inductive nd_derives {T: Type}{agT: ageable T}{EO: Ext_ord T} A B := { derivesI: predicates_hered.derives A B }.
-
-Lemma nd_derives_eq {T: Type}{agT: ageable T}{EO: Ext_ord T} : nd_derives = predicates_hered.derives(AG := agT)(EO := EO).
-Proof.
-  do 2 extensionality.
-  apply prop_ext; split.
-  - inversion 1; auto.
-  - constructor; auto.
-Qed.
-
-Ltac unseal_derives := intros; rewrite ?nd_derives_eq; repeat match goal with H : context[nd_derives] |- _ => rewrite nd_derives_eq in H; revert H end.
-
-#[global] Instance algNatDed (T: Type){agT: ageable T}{EO: Ext_ord T} : NatDed (pred T).
-  apply (mkNatDed _
-                    predicates_hered.andp
-                    predicates_hered.orp
-                    (@predicates_hered.exp _ _ _)
-                    (@predicates_hered.allp _ _ _)
-                    predicates_hered.imp predicates_hered.prop
-                    (nd_derives)); unseal_derives.
- apply pred_ext.
- apply derives_refl.
- apply derives_trans.
- apply andp_right.
- apply andp_left1.
- apply andp_left2.
- apply orp_left.
- apply orp_right1.
- apply orp_right2.
- apply @exp_right.
- apply @exp_left.
- apply @allp_left.
- apply @allp_right.
- apply imp_andp_adjoint.
- repeat intro. eapply H; eauto. hnf; auto.
- repeat intro. hnf; auto.
- repeat intro. specialize (H a a (necR_refl _) (ext_refl _)). simpl in H. auto.
- repeat intro. specialize (H b). simpl in H. auto.
-Defined.
-
-#[global] Instance algSepLog (T: Type) {agT: ageable T}{JoinT: Join T}{PermT: Perm_alg T}{SepT: Sep_alg T}{AgeT: Age_alg T}{EO: Ext_ord T}{ET: Ext_alg T} :
-      @SepLog (pred T) (algNatDed T).
- apply (mkSepLog _ (algNatDed T) predicates_sl.emp predicates_sl.sepcon
-            predicates_sl.wand predicates_sl.ewand); simpl; unseal_derives.
- apply sepcon_assoc.
- apply sepcon_comm.
- intros. pose proof (wand_sepcon_adjoint P Q R). simpl. rewrite H; split; auto.
- intros; simpl. apply predicates_hered.pred_ext; simpl.
-          intros ? [w1 [w2 [? [? [? ?]]]]];  split; auto. exists w1; exists w2; repeat split; auto.
-          intros ? [? [w1 [w2 [? [? ?]]]]];  exists w1; exists w2; repeat split; auto.
- intros; intro; apply sepcon_derives; auto.
-(* intros; simpl; apply ewand_sepcon; auto.
- intros; simpl. apply ewand_TT_sepcon; auto.
- intros; simpl. intros w [w1 [w2 [? [? ?]]]]. exists w1,w2; repeat split; auto. intros ????. eapply nec_join in H as (? & ? & ? & ? & ?); eauto. exists w2; exists w; repeat split; auto.*)
-  intros; simpl. apply ewand_conflict; auto.
-Defined.
-
-#[global] Instance algClassicalSep (T: Type) {agT: ageable T}{JoinT: Join T}{PermT: Perm_alg T}{SepT: Sep_alg T}{AgeT: Age_alg T}{EO: Ext_ord T}{ET: Ext_alg T}:
-     @ClassicalSep (pred T) (algNatDed T)(algSepLog T).
- constructor; intros. simpl. apply predicates_sl.sepcon_emp.
-Qed.
-
-Definition Triv := predicates_hered.pred nat.
-#[global] Instance TrivNatDed: NatDed Triv := algNatDed nat.
-
-#[global] Instance ea_nat : Ext_alg nat (SA := fsep_sep (sepalg_generators.Sep_equiv nat)).
-Proof.
-  constructor.
-  - simpl; intros ???? [] ?; subst.
-    do 2 eexists; eauto; split; auto.
-  - simpl; intros ????? []; subst.
-    do 2 eexists; eauto; split; auto.
-  - intros; do 2 eexists; [|split; auto].
-    intros ?? []; auto.
-Qed.
-
-#[global] Instance TrivSeplog: SepLog Triv := algSepLog _ (AgeT := asa_nat) (ET := ea_nat).
-#[global] Instance TrivClassical: ClassicalSep Triv := algClassicalSep _ (AgeT := asa_nat) (ET := ea_nat).
-#[global] Instance TrivIntuitionistic: IntuitionisticSep Triv.
- constructor. intros. hnf. constructor. hnf. intros. destruct H as [w1 [w2 [? [? _]]]].
- destruct H; subst; auto.
-Qed.
-
-#[global] Instance algIndir (T: Type) {agT: ageable T}{JoinT: Join T}{PermT: Perm_alg T}{SepT: Sep_alg T}
-                {AgeT: Age_alg T}{EO: Ext_ord T}:
-         @Indir (pred T) (algNatDed T).
- apply (mkIndir _ _ (box laterM)); intros; simpl in *; unseal_derives.
- apply @predicates_hered.now_later.
- apply @predicates_hered.axiomK.
- apply @predicates_hered.later_allp.
- simpl. intros; apply @box_ex.
- simpl. intros; apply @later_ex; auto.
- simpl. intros; apply @later_ex''.
-(* apply @predicates_hered.later_imp.*)
- apply @predicates_hered.later_prop.
- apply @predicates_hered.loeb; auto.
-Defined.
-
-#[global] Instance TrivIndir: Indir Triv := algIndir _ (AgeT := asa_nat).
-
-Section SL2. Import VST.msl.seplog.
-
-Class RecIndir (A: Type) {NA: NatDed A}{IA: Indir A} := mkRecIndir {
-  fash : A -> Triv;
-  unfash : Triv -> A;
-  HORec : forall {X} (f: (X -> A) -> (X -> A)), X -> A;
-  unfash_fash:  forall P: A, unfash (fash P) |-- P;
-  fash_K: forall P Q, fash (P --> Q) |-- fash P --> fash Q;
-  fash_derives: forall P Q, (P |-- Q) -> fash P |-- fash Q;
-  unfash_derives:  forall P Q,  (P |-- Q) -> unfash P |-- unfash Q;
-  later_fash:  forall P, later (fash P) = fash (later P);
-  later_unfash:  forall P, later (unfash P) = unfash (later P);
-  fash_andp: forall P Q, fash (P && Q) = fash P && fash Q;
-  unfash_allp:  forall {B} (P: B -> Triv), unfash (allp P) = ALL x:B, unfash (P x);  subp_allp: forall G B (X Y:B -> A),  (forall x:B, G |-- fash (imp (X x) (Y x))) ->  G |-- fash (imp (allp X) (allp Y));
-  subp_exp: forall G B (X Y:B -> A),  (forall x:B, G |-- fash (imp (X x) (Y x))) ->  G |-- fash (imp (exp X) (exp Y));
-  subp_e: forall (P Q : A), (TT |-- fash (P --> Q)) -> P |-- Q;
-  subp_i1: forall P (Q R: A), (unfash P && Q |-- R) -> P |-- fash (Q --> R);
- fash_TT: forall G, G |-- fash TT;
-  HOcontractive: forall {X: Type} (f: (X -> A) -> (X -> A)), Prop :=
-         fun {X} f => forall P Q,  (ALL x:X, later (fash (P x <--> Q x))) |-- (ALL x:X, fash (f P x <--> f Q x));
-  HORec_fold_unfold : forall X (f: (X -> A) -> (X -> A)) (H: HOcontractive f), HORec f = f (HORec f)
-}.
-
-Definition HOnonexpansive {A}{NA: NatDed A}{IA: Indir A}{RA: RecIndir A}
-        {X: Type} (f: (X -> A) -> (X -> A)) :=
-         forall P Q: X -> A,  (ALL x:X, fash (P x <--> Q x)) |-- (ALL x:X, fash (f P x <--> f Q x)).
-End SL2.
-
-Module FashNotation.
-Notation "'#' e" := (fash e) (at level 20, right associativity): logic.
-Notation "'!' e" := (unfash e) (at level 20, right associativity): logic.
-Notation "P '>=>' Q" := (# (P --> Q)) (at level 55, right associativity) : logic.
-Notation "P '<=>' Q" := (# (P <--> Q)) (at level 57, no associativity) : logic.
-End FashNotation.
-
-Definition algRecIndir (T: Type) {agT: ageable T}{JoinT: Join T}{PermT: Perm_alg T}{SepT: Sep_alg T}{AgeT: Age_alg T}{EO: Ext_ord T}{ET: Ext_alg T} :
-         @RecIndir (pred T) (algNatDed T) (algIndir T).
- apply (mkRecIndir _ _ _ subtypes.fash subtypes.unfash HoRec.HORec); intros; simpl in *; unseal_derives.
- repeat intro. do 3 red in H. apply H; auto.
- apply @subtypes.fash_K.
- apply @subtypes.fash_derives; auto.
- intros ? ?. do 3 red in H. apply H.
- apply @subtypes.later_fash; auto.
- apply @subtypes.later_unfash.
- apply @subtypes.fash_and.
- apply pred_ext; repeat intro; do 3 red in H; apply (H b); auto.
- apply @subtypes.subp_allp; auto.
- eapply @subtypes.subp_exp; auto.
- eapply @subtypes.subp_e; eauto.
- eapply @subtypes.subp_i1; eauto.
- repeat intro; hnf; auto.
- intros. apply HoRec.HORec_fold_unfold; auto.
-Defined.
-
-#[global] Instance TrivRecIndir: RecIndir Triv := algRecIndir nat.
-
-Section SL3. Import VST.msl.seplog.
-
-Lemma fash_triv: forall P: Triv, fash P = P.
-Proof.
- intros.
- apply pred_ext; simpl; unseal_derives; intros ? ?.
- eapply H. unfold level; simpl.  unfold natLevel; auto.
- hnf; intros. eapply pred_nec_hereditary; try eapply H.
- apply nec_nat. auto.
-Qed.
-
-Class SepRec  (A: Type) {NA: NatDed A}{SA: SepLog A}{IA: Indir A}{RA: RecIndir A} := mkSepRec {
-  unfash_sepcon_distrib: forall (P: Triv) (Q R: A),
-                 andp (unfash P) (sepcon Q R) = sepcon (andp (unfash P) Q) (andp (unfash P) R)
-}.
-
-End SL3.
-
-#[global] Instance algSepIndir (T: Type) {agT: ageable T}{JoinT: Join T}{PermT: Perm_alg T}{SepT: Sep_alg T}{AgeT: Age_alg T}{EO: Ext_ord T}{ET: Ext_alg T} :
-         @SepIndir (pred T) (algNatDed T) (algSepLog T) (algIndir T).
- apply mkSepIndir; simpl.
- apply @predicates_sl.later_sepcon; auto.
- apply @predicates_sl.later_wand; auto.
-(* apply @predicates_sl.later_ewand; auto.*)
-Qed.
-
-#[global] Instance algSepRec (T: Type) {agT: ageable T}{JoinT: Join T}{PermT: Perm_alg T}{SepT: Sep_alg T}{AgeT: Age_alg T}{EO: Ext_ord T}{ET: Ext_alg T} :
-         @SepRec (pred T) (algNatDed T) (algSepLog T) (algIndir T)(algRecIndir T).
-constructor.
- intros; simpl. apply subtypes_sl.unfash_sepcon_distrib.
-Qed.
-
-#[global] Instance algCorableSepLog (T: Type) {agT: ageable T}{JoinT: Join T}{PermT: Perm_alg T}{SepT: Sep_alg T}{AgeT: Age_alg T}{EO: Ext_ord T}{ET: Ext_alg T} :
-         @CorableSepLog (pred T) (algNatDed T) (algSepLog T).
-  apply mkCorableSepLog with (corable := corable.corable).
-  + apply corable.corable_prop.
-  + apply corable.corable_andp.
-  + apply corable.corable_orp.
-  + apply corable.corable_imp.
-  + intros; apply corable.corable_allp; auto.
-  + intros; apply corable.corable_exp; auto.
-  + apply corable.corable_sepcon.
-  + apply corable.corable_wand.
-  + intros; simpl.
-    apply corable.corable_andp_sepcon1; auto.
-Defined.
-
-#[global] Instance algCorableIndir (T: Type) {agT: ageable T}{JoinT: Join T}{PermT: Perm_alg T}{SepT: Sep_alg T}{AgeT: Age_alg T}{EO: Ext_ord T}{ET: Ext_alg T} :
-         @CorableIndir (pred T) (algNatDed T) (algSepLog T) (algCorableSepLog T) (algIndir T).
-  unfold CorableIndir; simpl.
-  apply corable.corable_later.
-Defined.
diff --git a/msl/alg_seplog_direct.v b/msl/alg_seplog_direct.v
deleted file mode 100644
index 6c9e94cfe1..0000000000
--- a/msl/alg_seplog_direct.v
+++ /dev/null
@@ -1,72 +0,0 @@
-Require Import VST.msl.Extensionality.
-Require Import VST.msl.seplog.
-Require Import VST.msl.base.
-Require Import VST.msl.boolean_alg.
-Require Import VST.msl.sepalg.
-Require Import VST.msl.predicates_sa.
-Require Import VST.msl.corable_direct.
-
-Local Open Scope logic.
-
-#[global] Instance algNatDed (T: Type) : NatDed (pred T).
-  apply (mkNatDed _
-                    predicates_sa.andp
-                    predicates_sa.orp
-                    (@predicates_sa.exp _)
-                    (@predicates_sa.allp _)
-                    predicates_sa.imp predicates_sa.prop
-                    (@predicates_sa.derives _)).
- apply pred_ext.
- apply derives_refl.
- apply derives_trans.
- apply andp_right.
- apply andp_left1.
- apply andp_left2.
- apply orp_left.
- apply orp_right1.
- apply orp_right2.
- intros ? ?; apply @exp_right.
- intros ? ?; apply @exp_left.
- intros ? ?; apply @allp_left.
- intros ? ?; apply @allp_right.
- apply imp_andp_adjoint.
- repeat intro. eapply H; eauto.
- repeat intro. hnf; auto.
- repeat intro. unfold imp, prop in H. auto.
- repeat intro. specialize (H b); unfold prop in H. auto.
-Defined.
-
-#[global] Instance algSepLog (T: Type) {JoinT: Join T}{PermT: Perm_alg T}{SepT: Sep_alg T} :
-      @SepLog (pred T) (algNatDed T).
- apply (mkSepLog _ (algNatDed T) identity predicates_sa.sepcon predicates_sa.wand
-                             predicates_sa.ewand).
- apply sepcon_assoc.
- apply sepcon_comm.
- intros. pose proof (wand_sepcon_adjoint P Q R). simpl. rewrite H; split; auto.
- intros. apply (predicates_sa.sepcon_andp_prop P Q R).
- intros; intro; apply sepcon_derives; auto.
-(* intros; apply predicates_sa.ewand_sepcon.*)
-(* intros; simpl. apply ewand_TT_sepcon; auto.*)
-(* intros; simpl. intros w [w1 [w2 [? [? ?]]]]. exists w1,w2; repeat split; auto. exists w2; exists w; repeat split; auto.*)
- intros; simpl. apply ewand_conflict; auto.
-Defined.
-
-#[global] Instance algClassicalSep (T: Type) {JoinT: Join T}{PermT: Perm_alg T}{SepT: Sep_alg T}{CancT: Canc_alg T}:
-     @ClassicalSep (pred T) (algNatDed T)(algSepLog T).
- constructor; intros. simpl. apply predicates_sa.sepcon_emp.
-Defined.
-
-#[global] Instance algCorableSepLog (T: Type){JoinT: Join T}{PermT: Perm_alg T}{SepT: Sep_alg T}{FT: Flat_alg T}:
-         @CorableSepLog (pred T) (algNatDed T) (algSepLog T).
-  apply mkCorableSepLog with (corable := corable_direct.corable); unfold algNatDed, algSepLog; simpl.
-  + apply corable_prop.
-  + apply corable_andp.
-  + apply corable_orp.
-  + apply corable_imp.
-  + intros. apply corable_allp; auto.
-  + intros; apply corable_exp; auto.
-  + apply corable_sepcon.
-  + apply corable_wand.
-  + intros; simpl.
-    apply corable_andp_sepcon1; auto.
-Defined.
diff --git a/msl/cjoins.v b/msl/cjoins.v
deleted file mode 100644
index 05beca6870..0000000000
--- a/msl/cjoins.v
+++ /dev/null
@@ -1,171 +0,0 @@
-(*
- * Copyright (c) 2009-2010, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-
-Require Import VST.msl.base.
-Require Import VST.msl.sepalg.
-
-Definition constructive_join_sub {A} {JOIN: Join A} (w1 w3: A) := {w2 | join w1 w2 w3}.
-
-Lemma cjoin_sub_join_sub{A} {JOIN: Join A}:
-    forall {w1 w3}, constructive_join_sub w1 w3 -> join_sub w1 w3.
-Proof.
-intros.
-destruct X as [w2 ?]; exists w2; auto.
-Qed.
-
-Lemma cjoin_sub_irr {A} `{Perm_alg A}{CA: Canc_alg A}:
-    forall {w1 w3: A} (j1 j2: constructive_join_sub w1 w3), proj1_sig j1 = proj1_sig j2.
-Proof.
-intros.
-destruct j1 as [w2 ?].
-destruct j2 as [w2' ?].
-simpl.
-apply (join_canc (join_comm j) (join_comm j0)).
-Qed.
-
-Lemma cjoin_sub_trans {A} `{Perm_alg A}: forall a b c,
-          constructive_join_sub a b -> constructive_join_sub b c -> constructive_join_sub a c.
-Proof.
-intros.
-destruct X as [u ?H].
-destruct X0 as [v ?H].
-destruct (join_assoc H0 H1) as [f [? ?]].
-exists f; auto.
-Qed.
-
-
-Lemma constructive_join_sub_refl {A} `{Perm_alg A}{SA: Sep_alg A}: forall x, constructive_join_sub x x.
-Proof.
-intros.
-destruct (join_ex_units x).
-exists x0. apply join_comm; apply u.
-Qed.
-
-#[export] Hint Resolve constructive_join_sub_refl : core.
-Definition constructive_joins {A}  {JOIN: Join A} (w1 w2 : A) := {w3 | join w1 w2 w3}.
-
-Lemma cjoins_joins {A}  {JOIN: Join A}: forall {w1 w2}, constructive_joins w1 w2 -> joins w1 w2.
-Proof.
-intros.
-destruct X as [w3 ?]; exists w3; auto.
-Qed.
-
-Lemma cjoins_irr {A} `{Perm_alg A}: forall {w1 w2: A}
-    (j1 j2: constructive_joins w1 w2), proj1_sig j1 = proj1_sig j2.
-Proof.
-intros.
-destruct j1 as [w3 ?].
-destruct j2 as [w3' ?].
-simpl.
-apply  (join_eq j j0).
-Qed.
-
-Lemma constructive_joins_sym {A} `{Perm_alg A}: forall a b,
-      constructive_joins a b = constructive_joins b a.
-Proof.
-intros.
-unfold constructive_joins.
-f_equal.
-extensionality w3.
-apply prop_ext; split; auto.
-Qed.
-
-Definition same_constructive_silhouette {A} {JOIN: Join A} (a b: A) :=
-    forall c, (constructive_joins c a -> constructive_joins c b) *
-                 (constructive_joins c b -> constructive_joins c a).
-
-
-  Definition sub_constructive_silhouette {A} {JOIN: Join A}  (a b: A) :=
-    forall c, constructive_joins c b -> constructive_joins c a.
-
-  Lemma sub_constructive_silhouette_refl {A} {JOIN: Join A} : forall a, sub_constructive_silhouette a a.
-  Proof. unfold sub_constructive_silhouette; intuition. Qed.
-
-  Lemma sub_constructive_silhouette_trans {A} {JOIN: Join A} : forall a b c,
-    sub_constructive_silhouette a b -> sub_constructive_silhouette b c -> sub_constructive_silhouette a c.
-  Proof. unfold sub_constructive_silhouette; intuition. Qed.
-
-  Lemma same_constructive_silhouette_refl {A} {JOIN: Join A} : forall a, same_constructive_silhouette a a.
-  Proof. unfold same_constructive_silhouette; intuition. Qed.
-
-  Lemma same_constructive_silhouette_sym {A} {JOIN: Join A}: forall a b,
-    same_constructive_silhouette a b -> same_constructive_silhouette b a.
-  Proof. unfold same_constructive_silhouette; intuition; destruct (X c); auto. Qed.
-
-  Lemma same_constructive_silhouette_trans {A} {JOIN: Join A}: forall a b c,
-    same_constructive_silhouette a b -> same_constructive_silhouette b c -> same_constructive_silhouette a c.
- Proof. unfold same_constructive_silhouette; intuition;
-             destruct (X c0); destruct (X0 c0);   auto. Qed.
-
-  Lemma same_constructive_silhouette_sub1{A} {JOIN: Join A}: forall a b,
-    same_constructive_silhouette a b -> sub_constructive_silhouette a b.
-  Proof. unfold same_constructive_silhouette, sub_constructive_silhouette; intuition; destruct (X c); auto. Qed.
-
-  Lemma same_constructive_silhouette_sub2 {A} {JOIN: Join A}: forall a b,
-     same_constructive_silhouette a b -> sub_constructive_silhouette b a.
-  Proof. unfold same_constructive_silhouette, sub_constructive_silhouette; intuition; destruct (X c); auto. Qed.
-
-
-  Lemma sub_same_constructive_silhouette {A} {JOIN: Join A}:
-    forall a b, sub_constructive_silhouette a b -> sub_constructive_silhouette b a -> same_constructive_silhouette a b.
-  Proof. unfold same_constructive_silhouette, sub_constructive_silhouette; intuition; destruct (H0 c); auto. Qed.
-
-  Lemma same_constructive_silhouette_join {A} `{HA: Perm_alg A}:
-    forall phi phi' phiy phiz phiz',
-      same_constructive_silhouette phi phi' ->
-      join phi phiy phiz ->
-      join phi' phiy phiz' ->
-      same_constructive_silhouette phiz phiz'.
-  Proof.
-    intros * H ? ?.
-    intro phiu.
-    split; intros [phix ?H].
-    destruct (join_assoc H0 (join_comm H2)) as [phif [? ?]].
-    specialize (H phif).
-    destruct H as [?H ?H].
-    assert (H6: constructive_joins phi phif) by (econstructor; eauto).
-    spec H. rewrite constructive_joins_sym.  auto.
-    clear H5 H6.
-    destruct H as [phix' ?H].
-    destruct (join_assoc (join_comm H3) H) as [phig [? ?]].
-    generalize (join_eq H1 (join_comm H5)); intro. rewrite <- H7 in *; clear H7 phig.
-    clear H5.
-    exists phix'.
-    auto.
-    destruct (join_assoc H1 (join_comm H2)) as [phif [? ?]].
-    specialize (H phif).
-    destruct H as [?H ?H].
-    assert (H6: constructive_joins phi' phif) by (econstructor; eauto).
-    spec H5. rewrite constructive_joins_sym.  auto.
-    clear H H6.
-    destruct H5 as [phix' ?H].
-    destruct (join_assoc (join_comm H3) H) as [phig [? ?]].
-    generalize (join_eq H0 (join_comm H5)); intro. rewrite <- H7 in *; clear H7  phig.
-    clear H5.
-    exists phix'.
-    auto.
-  Qed.
-
-Lemma constructive_join_sub_joins_trans {A} {JA: Join A}{PA: Perm_alg A}: forall {a b c},
-  constructive_join_sub a c -> constructive_joins c b -> constructive_joins a b.
-Proof.
-intros.
-destruct X as [wx X].
-destruct X0 as [wy X0].
-destruct (join_assoc (join_comm X) X0) as [wf [? ?]].
-econstructor; eauto.
-Qed.
-
-Lemma join_constructive_join_sub1 {A} {JA: Join A}{PA: Perm_alg A}: forall {a b c},
-  join a b c -> constructive_join_sub a c.
-Proof. intros; exists b; auto. Qed.
-
-Lemma join_constructive_join_sub2 {A} {JA: Join A}{PA: Perm_alg A}: forall {a b c},
-  join a b c -> constructive_join_sub b c.
-Proof. intros; exists a; auto. Qed.
-
-Lemma join_constructive_joins {A} {JA: Join A}{PA: Perm_alg A}: forall {a b c},
-  join a b c -> constructive_joins a b.
-Proof. intros; exists c; auto. Qed.
diff --git a/msl/combiner_sa.v b/msl/combiner_sa.v
deleted file mode 100644
index 4d7fbd9590..0000000000
--- a/msl/combiner_sa.v
+++ /dev/null
@@ -1,632 +0,0 @@
-(*
- * Copyright (c) 2009-2011, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-
-(* A portion of this file was developed by Le Xuan Bach *)
-
-Require Import VST.msl.base.
-Require Import VST.msl.sepalg.
-Require Import VST.msl.functors.
-Require Import VST.msl.sepalg_generators.
-Require Import VST.msl.sepalg_functors.
-
-Import MixVariantFunctor.
-Import MixVariantFunctorLemmas.
-Import MixVariantFunctorGenerator.
-
-Definition midObj {A} {JA: Join A} (a : A) : Prop := ~identity a /\ ~ full a.
-
-Definition ijoinable A {JA: Join A} : Type := {sh : A & midObj sh}.
-
-Definition ijoin {A} {JA: Join A} (j1 j2 j3 : ijoinable A) : Prop :=
-  match (j1, j2, j3) with
-  (existT _ t1 _, existT _ t2 _, existT _ t3 _) => join t1 t2 t3
-  end.
-
-Lemma ijoin_eq {A} {JA: Join A}{PA: Perm_alg A} : forall j1 j2 j3 j3',
-  ijoin j1 j2 j3 ->
-  ijoin j1 j2 j3' ->
-  j3 = j3'.
-Proof.
-  intros.
-  icase j1; icase j2; icase j3; icase j3'.
-  unfold ijoin in *.
-  apply existT_ext.
-  eapply join_eq; eauto.
-Qed.
-
-Lemma ijoin_com {A} {JA: Join A}{PA: Perm_alg A} : forall j1 j2 j3,
-  ijoin j1 j2 j3 -> ijoin j2 j1 j3.
-Proof with auto.
-  intros.
-  icase j1; icase j2; icase j3.
-  red in H; red.
-  apply join_comm...
-Qed.
-
-Lemma ijoin_assoc {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{CA: Disj_alg A} : forall a b c d e,
-  ijoin a b d ->
-  ijoin d c e ->
-  {f : ijoinable A | ijoin b c f /\ ijoin a f e}.
-Proof with auto.
-  intros.
-  icase a; icase b; icase c; icase d; icase e.
-  unfold ijoin in *.
-  destruct (join_assoc H H0) as [f [? ?]].
-  assert ((~identity f) /\ (~full f)).
-    unfold midObj in *.
-    split.
-    intro.
-    generalize (split_identity _ _ H1 H3); intro.
-    tauto.
-    intro.
-    specialize ( H3 x). spec H3. exists x3...
-    specialize ( H3 f x3 H2). subst x3.
-    apply unit_identity in H2.
-    tauto.
-  exists (existT midObj f H3).
-  split...
-Qed.
-
-Lemma ijoin_canc {A}  {JA: Join A}{SA: Sep_alg A}{CA: Canc_alg A}: forall a a' b c,
-  ijoin a b c ->
-  ijoin a' b c ->
-  a = a'.
-Proof with auto.
-  intros.
-  icase a; icase a'; icase b; icase c.
-  unfold ijoin in *.
-  apply existT_ext.
-  eapply join_canc; eauto.
-Qed.
-
-Lemma ijoin_identity1 {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{CA: Disj_alg A}: forall a b,
-  ijoin a b b ->
-  False.
-Proof with auto.
-  intros.
-  icase a; icase b.
-  destruct m. apply n.
-  apply (unit_identity x0).
-  apply H.
-Qed.
-
-Lemma ijoin_identity2 {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{DA: Disj_alg A}: forall a b,
-  ijoin a a b ->
-  False.
-Proof with auto.
-  intros.
-  icase a. icase b.
-  destruct m; destruct m0.
-  red in H; apply join_self in H; contradiction.
-Qed.
-
-Section CombineJoin.
-
-Variable A : Type.
-Variable JA: Join A.
-Variable pa_A : Perm_alg A.
-Variable sa_A : Sep_alg A.
-Variable ca_A : Canc_alg A.
-Variable da_A : Disj_alg A.
-
-(* We either need an explicit top witness or some kind of axiom of choice
-    (if not here, then in sa_fun or somesuch).  It is a little ugly this way but
-    I don't see any other way around. Aquinas *)
-Variable A_top : A.
-Variable A_top_full : full A_top.
-
-Variable T1 : Type.
-Variable T2 : Type.
-Variable J1: Join T1.
-Variable pa_T1: Perm_alg T1.
-Variable sa_T1: Sep_alg T1.
-
-Variable combjoin : T1 -> T1 -> T2 -> Prop.
-
-Variable combjoin_eq : forall v1 v1' v2 v2',
-  combjoin v1 v1' v2 ->
-  combjoin v1 v1' v2' ->
-  v2 = v2'.
-
-Variable combjoin_assoc : forall v1 v2 v3 v4 v5,
-   join v1 v2 v3 ->
-   combjoin v3 v4 v5 ->
-   {v' : T1 & join v2 v4 v' /\ combjoin v1 v' v5}.
-
-Variable combjoin_com : forall v1 v2 v3,
-   combjoin v1 v2 v3 ->
-   combjoin v2 v1 v3.
-
-Variable combjoin_canc : forall v1 v1' v2 v3,
-    combjoin v1 v2 v3 ->
-    combjoin v1' v2 v3 ->
-    v1 = v1'.
-
-(* We would really prefer this to be:
-       exists top, join (projT1 j1) (projT1 j2) top /\ full top
-   but, again, we run into Type/Prop problems and wind up needing
-   some form of the axiom of choice somewhere or other. *)
-Definition covers (j1 j2 : ijoinable A) : Prop :=
-  join (projT1 j1) (projT1 j2) A_top.
-
-Inductive combiner : Type :=
-  | CEmpty
-  | CPart : forall (sh : ijoinable A) (v : T1), combiner
-  | CFull : forall (v : T2), combiner.
-
-#[global] Instance Join_combiner : Join combiner :=
-  fun c1 c2 c3 =>
-  match (c1,c2,c3) with
-  | (CEmpty, CEmpty, CEmpty) => True
-  | (CEmpty, CPart a v, CPart a' v') => a = a' /\ v = v'
-  | (CPart a v, CEmpty, CPart a' v')  => a = a' /\ v = v'
-  | (CEmpty, CFull v, CFull v') => v = v'
-  | (CFull v, CEmpty, CFull v') => v = v'
-  | (CPart a v, CPart a' v', CPart a'' v'') => ijoin a a' a'' /\ join v v' v''
-  | (CPart a v, CPart a' v', CFull v'') => combjoin v v' v'' /\ covers a a'
-  | _ => False
- end.
-
-Lemma combineJ_eq: forall x y z z' : combiner,
-  join x y z -> join x y z' -> z = z'.
-Proof with auto.
-  intros.
-  icase x;icase y;icase z;icase z';try inversion H;try inversion H0;try congruence.
-
-  f_equal.
-  eapply ijoin_eq; eauto.
-  eapply join_eq; eauto.
-
-  exfalso; clear - pa_A sa_A H1 H4 A_top_full.
-  destruct sh; destruct sh0; destruct sh1.
-  red in H1; red in H4; simpl in H4.
-  generalize (join_eq H1 H4); intro; subst x1.
-  unfold midObj in *.
-  tauto.
-
-  exfalso; clear - pa_A sa_A H2 H3 A_top_full.
-  destruct sh;destruct sh0;destruct sh1.
-  red in H3; red in H2; simpl in H2.
-  generalize (join_eq H2 H3);intro;subst x1.
-  unfold midObj in *.
-  tauto.
-
-  rewrite (combjoin_eq _ _ _ _ H1 H3)...
-Qed.
-
-Lemma combineJ_assoc: forall a b c d e : combiner,
-  join a b d -> join d c e ->
-                    {f : combiner & join b c f /\ join a f e}.
-Proof with auto.
-   intros. red in H, H0. unfold join.
-   icase a;icase b;icase c;icase d;icase e;inv H;inv H0.
-
-
-   exists CEmpty;split;red...
-   exists (CPart sh0 v0);split;red...
-   exists (CFull v0);split;red...
-   exists (CPart sh1 v1);split;red...
-   exists (CPart sh2 v2);split;red...
-   exists (CFull v2);split;red...
-   exists (CFull v1);split;red...
-   exists CEmpty;split;red...
-   exists (CPart sh0 v0);split;red...
-   exists (CPart sh0 v0);split;red...
-   exists (CPart sh0 v0);split;red...
-   exists (CPart sh0 v0);split;red...
-   3: exists (CEmpty);split;red...
-
-   destruct (ijoin_assoc _ _ _ _ _ H1 H) as [sh' [? ?]].
-   destruct (join_assoc H2 H3) as [fv [? ?]].
-   exists (CPart sh' fv); split; red...
-
-   icase sh; icase sh0; icase sh1; icase sh2.
-   red in H1, H3. simpl in H1, H3.
-   destruct (join_assoc H1 H3) as [sh' [? ?]].
-   assert ((~identity sh') /\ (~full sh')).
-     split; intro.
-     generalize (split_identity _ _ H0 H5); intro.
-     unfold midObj in *.
-     tauto.
-     specialize ( H5 x).
-     spec H5. exists A_top...
-     specialize ( H5 sh' A_top H4).
-     subst sh'.
-     apply unit_identity in H4.
-     unfold midObj in *.
-     tauto.
-  destruct (combjoin_assoc _ _ _ _ _ H2 H) as [v' [? ?]].
-  exists (CPart (existT _ sh' H5) v').
-  split; split...
-Qed.
-
-Lemma combineJ_com: forall a b c : combiner,
-    join a b c -> join b a c.
-Proof with auto.
-  intros. unfold join in H|-*.
-  icase a; icase b.
-  icase c; red in H; red; destruct H;
-  split...
-  apply ijoin_com...
-  apply join_comm...
-Qed.
-
-Lemma combineJ_canc {C1: Canc_alg T1}: forall a1 a2 b c : combiner,
-       join a1 b c -> join a2 b c -> a1=a2.
-Proof with auto.
-   intros. unfold join in H,H0.
-   icase c;icase b;icase a1;icase a2;inv H;inv H0;auto.
-
-   destruct (ijoin_identity1 _ _ H).
-   destruct (ijoin_identity1 _ _ H1).
-
-   generalize (ijoin_canc _ _ _ _ H1 H).
-   generalize (join_canc H2 H3); intros.
-   subst sh2 v2...
-
-   generalize (join_canc H2 H3).
-   generalize (combjoin_canc _ _ _ _ H1 H); intros.
-   f_equal...
-   icase sh0; icase sh1.
-   apply existT_ext...
-Qed.
-
-Lemma combineJ_ex_identities: forall a , {e : combiner &  join e a a}.
-Proof with auto.
-   intros.
-   icase a;
-   exists CEmpty;
-   constructor...
-Qed.
-
-Lemma combineJ_self' {DA: Disj_alg A}:
-  forall a b : combiner, join a a b -> identity a.
-Proof.
-  repeat intro.
-  icase a; icase b; inv H.
-  - icase a0; icase b0; inv H0; auto.
-  - apply ijoin_identity2 in H1; contradiction.
-  - clear - DA H2 A_top_full.
-    icase sh. red in H2. simpl in H2.
-    apply join_self in H2; destruct m; contradiction.
-Qed.
-
-Lemma combineJ_self {DA: Disj_alg A}:
-        forall a b : combiner, join a a b -> a = b.
-Proof.
-  intros; eapply combineJ_self'; eauto.
-Qed.
-
-#[global] Instance Perm_combiner : Perm_alg combiner.
-Proof. constructor.
-  apply combineJ_eq.
-  apply combineJ_assoc.
-  apply combineJ_com.
-   (* positivity *)
-  intros.
-  hnf in H, H0.
-  destruct a, a'; try contradiction; destruct b,b'; try contradiction; auto;
-  try solve [destruct H; destruct H0; congruence].
-  destruct H; destruct H0.
-  f_equal.
-  destruct sh as [sh i]; destruct sh0 as [sh0 i0];
-  destruct sh1 as [sh1 i1]; destruct sh2 as [sh2 i2].
-  apply existT_ext. unfold ijoin in H,H0.
-  eapply join_positivity; eauto.
-  eapply join_positivity; eauto.
-Qed.
-
-#[global] Instance Sep_combiner: FSep_alg combiner.
-Proof.
-  apply mkSep with (fun _ => CEmpty).
-  intros. hnf.  destruct t; auto.
-  auto.
-Defined.
-
-#[global] Instance Sing_combiner: Sing_alg combiner.
-Proof.
-  apply (mkSing CEmpty).
-  auto.
-Defined.
-
-#[global] Instance Canc_combiner {C1: Canc_alg T1}: Canc_alg combiner.
-Proof.
- repeat intro. eapply combineJ_canc; eauto.
-Qed.
-
-#[global] Instance Disj_combiner {D1: Disj_alg A}: Disj_alg combiner.
-Proof.
- intro; apply combineJ_self'.
-Qed.
-
-(* Usefull facts about combiners *)
-
-Lemma identity_combiner {C1: Canc_alg T1}: forall d : combiner,
-  identity d ->
-  d = CEmpty.
-Proof.
-  intros.
-  rewrite identity_unit_equiv in H.
-  icase d.
-  destruct H.
-  destruct (ijoin_identity1 _ _ H).
-Qed.
-
-Lemma combiner_identity {C1: Canc_alg T1}:
-  identity CEmpty.
-Proof.
-  intros.
-  rewrite identity_unit_equiv.
-  compute.
-  trivial.
-Qed.
-
-Lemma combiner_full {C1: Canc_alg T1}: forall t2,
-  full (CFull t2).
-Proof.
-  unfold full.  intros.
-  destruct H as [sigma'' ?].
-  icase sigma'.
-  apply combiner_identity.
-Qed.
-
-(* This one is only true under various restrictions. *)
-(*
-Lemma full_combiner: forall (d : combiner),
-  (* we require that As have complements *)
-  (forall a : ijoinable, exists a' : ijoinable, join (projT1 a) (projT1 a') A_top) ->
-  (* we require that T2 be nonempty *)
-  forall (at2 : T2),
-  full d ->
-  {t2 : T2 | d = DFull t2}.
-Proof.
-  intros.
-  icase d.
-  3: exists v; trivial.
-  spec H0 (DFull at2) (DFull at2).
-  spec H0.
-  apply identity_unit.
-  apply combiner_identity.
-  exists (DFull at2).
-  compute. trivial.
-  apply identity_combiner in H0.
-  inversion H0.
-
-  exfalso.
-  spec H sh.
-  destruct H as [sh' ?].
-  destruct (join_ex_identities v) as [v0 [? ?]].
-  spec H0 ( sh' v0) (DFull .
-
-
-  ad mit.
-  exists v. trivial.
-Qed.
-*)
-
-End CombineJoin.
-
-Arguments combiner [A] _ _ _.
-Arguments Join_combiner [A] [JA] _ [T1 T2] _ _ _ _ _.
-Arguments CEmpty {A JA T1 T2}.
-Arguments CPart [A JA T1 T2] _ _.
-Arguments CFull [A JA T1 T2] _.
-(*
-Arguments identity_combiner.
-Arguments combiner_identity.
-Arguments combiner_full.
-*)
-Section ParameterizedCombiner.
-
-  #[global] Existing Instance Join_combiner.
-
-  Variable S : Type.
-  Variable JS : Join S.
-  Variable pa_S : Perm_alg S.
-  Variable sa_S : Sep_alg S.
-  Variable ca_S : Canc_alg S.
-  Variable da_S : Disj_alg S.
-
-  Variable T1 : functor.
-  Variable J1: forall A, Join (T1 A).
-  Variable Perm1: forall A, Perm_alg (T1 A).
-  Variable Sep1: forall A, Sep_alg (T1 A).
-  Variable T2 : functor.
-
-  Definition fcombiner (A : Type) : Type :=
-    @combiner S JS (T1 A) (T2 A).
-
-  Definition fcombiner_fmap (A B : Type) (f: A -> B) (g: B -> A)
-    (fa : fcombiner A) : fcombiner B :=
-      match fa with
-        | CEmpty => CEmpty
-        | CPart sh rs => CPart sh (fmap T1 f g rs)
-        | CFull trs => CFull (fmap T2 f g trs)
-      end.
-  Arguments fcombiner_fmap [A B] _ _ _.
-
-  Lemma ff_combiner : functorFacts fcombiner fcombiner_fmap.
-  Proof with auto.
-    constructor; intros;
-    extensionality pd; unfold fcombiner_fmap.
-    icase pd; rewrite fmap_id...
-    icase pd; rewrite <- fmap_comp...
-  Qed.
-
-  Definition f_combiner : functor := Functor ff_combiner.
-
-  Variable top_S : S.
-  Variable topS_full : full top_S.
-  Variable combjoin : forall A, (T1 A) -> (T1 A) -> (T2 A) -> Prop.
-  Variable combjoin_eq : forall A v1 v1' v2 v2',
-    combjoin A v1 v1' v2 ->
-    combjoin A v1 v1' v2' ->
-    v2 = v2'.
-  Variable combjoin_assoc : forall A (v1 v2 v3 v4: T1 A) (v5: T2 A),
-    join v1 v2 v3 ->
-    combjoin A v3 v4 v5 ->
-    {v' : (T1 A) & join v2 v4 v' /\ combjoin A v1 v' v5}.
-  Variable combjoin_com : forall A v1 v2 v3,
-    combjoin A v1 v2 v3 ->
-    combjoin A v2 v1 v3.
-  Variable combjoin_canc : forall A v1 v1' v2 v3,
-    combjoin A v1 v2 v3 ->
-    combjoin A v1' v2 v3 ->
-    v1 = v1'.
-  Variable saf_T1 : pafunctor T1 J1.
-
-  #[global] Instance Join_fcombiner (A: Type) : Join (fcombiner A) :=
-    Join_combiner top_S (J1 A) (combjoin A).
-
-
-  #[global] Instance Perm_fcombiner (A: Type): Perm_alg (fcombiner A).
-  Proof. apply Perm_combiner; auto.
-     apply combjoin_eq. apply combjoin_assoc.
-  Defined.
-
-
-  #[global] Instance Sep_fcombiner (A: Type): FSep_alg (fcombiner A).
-  Proof. apply Sep_combiner; auto.
-  Defined.
-
-  #[global] Instance Canc_fcombiner (A: Type) (CA: Canc_alg (T1 A)): Canc_alg (fcombiner A).
-  Proof.  apply Canc_combiner; auto. apply combjoin_canc.
-  Qed.
-
-  Definition combjoin_hom (A : Type) (B : Type)
-    (f : T1 A -> T1 B) (g : T2 A -> T2 B) : Prop :=
-      forall x y z,
-        combjoin A x y z ->
-        combjoin B (f x) (f y) (g z).
-  Arguments combjoin_hom [A B] _ _.
-
-  Variable fmaps_combjoin_hom: forall A B (f : A -> B) (g: B -> A),
-    combjoin_hom (fmap T1 f g) (fmap T2 f g).
-
-  Lemma fmap_fcombiner_hom: forall A B (f : A -> B) (g: B -> A),
-    join_hom (JA := Join_fcombiner A) (JB := Join_fcombiner B) (fmap f_combiner f g).
-  Proof with auto.
-    repeat intro. hnf in H|-*.
-    icase x; icase y; icase z.
-    destruct H.
-    split; congruence.
-    simpl in H. subst v0. simpl...
-    destruct H.
-    split; congruence.
-    destruct H.
-    split...
-    apply paf_join_hom...
-    destruct H.
-    split...
-    apply fmaps_combjoin_hom...
-    simpl in H. subst v0. simpl...
-  Qed.
-
-  Definition combjoin_unmap_left (A B : Type)
-    (f : T1 A -> T1 B) (g : T2 A -> T2 B) : Type :=
-      forall (x' : T1 B) (y :T1 A) (z : T2 A),
-        combjoin B x' (f y) (g z) ->
-        {x : T1 A &  {y0 : T1 A | combjoin A x y0 z /\ f x = x' /\ f y0 = f y}}.
-  Arguments combjoin_unmap_left [A B] _ _.
-
-  Variable combjoin_preserves_unmap_left : forall A B (f : A -> B) (g: B -> A),
-    combjoin_unmap_left (fmap T1 f g) (fmap T2 f g).
-
-  Definition combjoin_unmap_right (A B : Type)
-    (f : T1 A -> T1 B) (g : T2 A -> T2 B) : Type :=
-      forall (x y :T1 A) (z' : T2 B),
-        combjoin B (f x) (f y) z' ->
-        {y0 : T1 A &  {z : T2 A | combjoin A x y0 z /\ f y0 = f y /\ g z = z'}}.
-  Arguments combjoin_unmap_right [A B] _ _.
-
-  Variable combjoin_preserves_unmap_right : forall A B (f : A -> B) (g: B -> A),
-    combjoin_unmap_right (fmap T1 f g) (fmap T2 f g).
-
-  Lemma fmap_fcombiner_preserves_unmap_left: forall A B (f : A -> B) (g: B -> A),
-    unmap_left (Join_fcombiner A) (Join_fcombiner B) (fmap f_combiner f g).
-  Proof with auto.
-    repeat intro. simpl in H|-*. unfold join in H|-*. simpl in H|-*.
-    icase x'; icase y; icase z.
-    exists (CEmpty). exists (CEmpty). firstorder.
-    exists (CEmpty). exists (CPart sh0 v0).
-    destruct H. simpl.
-    repeat split; congruence.
-    exists (CEmpty). exists (CFull v0).
-    simpl in H. simpl.
-    repeat split; congruence.
-    exists (CPart sh v0). exists (CEmpty).
-    destruct H. simpl.
-    repeat split; congruence.
-    destruct H.
-    generalize (paf_preserves_unmap_left saf_T1 f g v v0 v1 H0); intro X.
-    destruct X as [x [y0 [? [? ?]]]].
-    exists (CPart sh x). exists (CPart sh0 y0).
-    split. split...
-    simpl. split; congruence.
-    (* combjoin case *)
-    destruct H.
-    specialize ( combjoin_preserves_unmap_left A B f g v v0 v1 H).
-    destruct combjoin_preserves_unmap_left as [x [y0 [? [? ?]]]].
-    exists (CPart sh x). exists (CPart sh0 y0).
-    split. split...
-    simpl. split; congruence.
-    (* end combjoin case *)
-    exists (CFull v0). exists (CEmpty).
-    simpl in H. simpl.
-    repeat split; congruence.
-  Qed.
-
-  Lemma fmap_fcombiner_preserves_unmap_right: forall A B (f : A -> B) (g: B -> A),
-    unmap_right (Join_fcombiner A) (Join_fcombiner B) (fmap f_combiner f g).
-  Proof with auto.
-    repeat intro. simpl in H|-*. unfold join in H|-*. simpl in H|-*.
-    icase x; icase y; icase z'.
-    exists (CEmpty). exists (CEmpty). firstorder.
-    exists (CPart sh v). exists (CPart sh v).
-    destruct H. simpl.
-    repeat split; congruence.
-    exists (CFull v). exists (CFull v).
-    simpl in H. simpl.
-    repeat split; congruence.
-    exists (CEmpty). exists (CPart sh v).
-    destruct H. simpl.
-    repeat split; congruence.
-    destruct H.
-    generalize (paf_preserves_unmap_right saf_T1 f g v v0 v1 H0); intro X.
-    destruct X as [y0 [z [? [? ?]]]].
-    exists (CPart sh0 y0). exists (CPart sh1 z).
-    split. split...
-    simpl. split; congruence.
-    (* combjoin case *)
-    destruct H.
-    specialize ( combjoin_preserves_unmap_right A B f g v v0 v1 H).
-    destruct combjoin_preserves_unmap_right as [y0 [z [? [? ?]]]].
-    exists (CPart sh0 y0). exists (CFull z).
-    split. split...
-    simpl. split; congruence.
-    (* end combjoin case *)
-    exists (CEmpty). exists (CFull v).
-    simpl in H. simpl.
-    repeat split; congruence.
-  Qed.
-
- Definition paf_combiner: @pafunctor f_combiner Join_fcombiner.
- Proof.
-    constructor.
-    apply fmap_fcombiner_hom.
-    apply fmap_fcombiner_preserves_unmap_left.
-    apply fmap_fcombiner_preserves_unmap_right.
- Qed.
-
-End ParameterizedCombiner.
-
-Arguments fcombiner [S] _ _ _ _.
-Arguments combjoin_hom [T1 T2] _ [A B] _ _.
-Arguments combjoin_unmap_left [T1 T2] _ [A B] _ _.
-Arguments combjoin_unmap_right [T1 T2] _ [A B] _ _.
-Arguments f_combiner {S JS T1 T2}.
-(*
-Arguments paf_combiner.
-*)
diff --git a/msl/contractive.v b/msl/contractive.v
deleted file mode 100644
index 8a596d15e4..0000000000
--- a/msl/contractive.v
+++ /dev/null
@@ -1,670 +0,0 @@
-(*
- * Copyright (c) 2009-2010, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-
-Require Import VST.msl.base.
-Require Import VST.msl.ageable.
-Require Import VST.msl.sepalg.
-Require Import VST.msl.sepalg_generators.
-Require Import VST.msl.age_sepalg.
-Require Import VST.msl.predicates_hered.
-Require Import VST.msl.predicates_rec.
-Require Import VST.msl.predicates_sl.
-Require Import VST.msl.subtypes.
-Require Import VST.msl.subtypes_sl.
-
-Local Open Scope pred.
-
-Lemma conj_nonexpansive {A} `{ageable A} {EO : Ext_ord A} : forall (F G:pred A -> pred A),
-  nonexpansive F ->
-  nonexpansive G ->
-  nonexpansive (fun x:pred A => F x && G x).
-Proof.
-  unfold nonexpansive; intros.
-  apply subp_eqp.
-  apply subp_andp; apply eqp_subp; auto.
-  apply subp_andp; apply eqp_subp2; auto.
-Qed.
-
-Lemma conj_contractive {A} `{ageable A} {EO : Ext_ord A} : forall F G,
-  contractive F ->
-  contractive G ->
-  contractive (fun x => F x && G x).
-Proof.
-  unfold contractive; intros.
-  apply subp_eqp.
-  apply subp_andp; apply eqp_subp; auto.
-  apply subp_andp; apply eqp_subp2; auto.
-Qed.
-
-Lemma disj_nonexpansive {A} `{ageable A}  {EO : Ext_ord A} : forall (F G:pred A -> pred A),
-  nonexpansive F ->
-  nonexpansive G ->
-  nonexpansive (fun x:pred A => F x || G x).
-Proof.
-  unfold nonexpansive; intros.
-  apply subp_eqp.
-  apply subp_orp; apply eqp_subp; auto.
-  apply subp_orp; apply eqp_subp2; auto.
-Qed.
-
-Lemma disj_contractive {A} `{ageable A}  {EO : Ext_ord A} : forall F G,
-  contractive F ->
-  contractive G ->
-  contractive (fun x => F x || G x).
-Proof.
-  unfold contractive; intros.
-  apply subp_eqp.
-  apply subp_orp; apply eqp_subp; auto.
-  apply subp_orp; apply eqp_subp2; auto.
-Qed.
-
-Lemma impl_contractive {A} `{ageable A}  {EO : Ext_ord A} : forall F G,
-  contractive F ->
-  contractive G ->
-  contractive (fun x => F x --> G x).
-Proof.
-  unfold contractive; intros.
-  apply subp_eqp.
-  apply subp_imp.
-  apply eqp_subp2; auto.
-  apply eqp_subp; auto.
-  apply subp_imp.
-  apply eqp_subp; auto.
-  apply eqp_subp2; auto.
-Qed.
-
-Lemma impl_nonexpansive {A} `{ageable A} {EO : Ext_ord A} : forall F G,
-  nonexpansive F ->
-  nonexpansive G ->
-  nonexpansive (fun x => F x --> G x).
-Proof.
-  unfold nonexpansive; intros.
-  apply subp_eqp.
-  apply subp_imp.
-  apply eqp_subp2; auto.
-  apply eqp_subp; auto.
-  apply subp_imp.
-  apply eqp_subp; auto.
-  apply eqp_subp2; auto.
-Qed.
-
-Lemma forall_contractive {A} `{ageable A} {EO : Ext_ord A} : forall B (X : pred A -> B -> pred A),
-  (forall x, (contractive (fun y => X y x))) ->
-  contractive (fun x => (allp (X x))).
-Proof.
-  unfold contractive; intros.
-  apply subp_eqp.
-  apply subp_allp; intros.
-  apply eqp_subp; auto.
-  apply subp_allp; intros.
-  apply eqp_subp2; auto.
-Qed.
-
-Lemma forall_nonexpansive {A} `{ageable A} {EO : Ext_ord A} : forall B (X : pred A -> B -> pred A),
-  (forall x, (nonexpansive (fun y => X y x))) ->
-  nonexpansive (fun x => (allp (X x))).
-Proof.
-  unfold nonexpansive; intros.
-  apply subp_eqp.
-  apply subp_allp; intros.
-  apply eqp_subp; auto.
-  apply subp_allp; intros.
-  apply eqp_subp2; auto.
-Qed.
-
-Lemma exists_contractive {A} `{ageable A} {EO : Ext_ord A} : forall B (X : pred A -> B -> pred A),
-  (forall x, (contractive (fun y => X y x))) ->
-  contractive (fun x => (exp (X x))).
-Proof.
-  unfold contractive; intros.
-  apply subp_eqp; apply subp_exp; intros.
-  apply eqp_subp; auto.
-  apply eqp_subp2; auto.
-Qed.
-
-Lemma exists_nonexpansive {A} `{ageable A} {EO : Ext_ord A} : forall B (X : pred A -> B -> pred A),
-  (forall x, (nonexpansive (fun y => X y x))) ->
-  nonexpansive (fun x => (exp (X x))).
-Proof.
-  unfold nonexpansive; intros.
-  apply subp_eqp; apply subp_exp; intros.
-  apply eqp_subp; auto.
-  apply eqp_subp2; auto.
-Qed.
-
-Lemma later_contractive {A} `{ageable A} {EO : Ext_ord A} : forall F,
-  nonexpansive F ->
-  contractive (fun X => (|>(F X))).
-Proof.
-  unfold nonexpansive, contractive; intros.
-  apply subp_eqp.
-  eapply derives_trans, subp_later1.
-  apply box_positive; auto.
-  apply eqp_subp; auto.
-  eapply derives_trans, subp_later1.
-  apply box_positive; auto.
-  apply eqp_subp2; auto.
-Qed.
-
-Lemma const_nonexpansive {A: Type} {H: ageable A} {EO : Ext_ord A} : forall P: pred A,
-  nonexpansive (fun _ => P).
-Proof.
-  intros.
-  hnf; intros.
-  intros w ? ? ?.
-  clear.
-  hnf; split; intros ? ? ?; auto.
-Qed.
-
-Lemma const_contractive {A: Type} {H: ageable A} {EO : Ext_ord A} : forall P: pred A,
-  contractive (fun _ => P).
-Proof.
-  intros.
-  hnf; intros.
-  intros w ? ? ?.
-  clear.
-  hnf; split; intros ? ? ?; auto.
-Qed.
-
-Lemma identity_nonexpansive {A: Type} {H: ageable A} {EO : Ext_ord A} :
-  nonexpansive (fun P: pred A => P).
-Proof.
-  hnf; intros.
-  intros ?; auto.
-Qed.
-
-(*
-Lemma box_contractive {A} `{ageable A} : forall F (M:modality),
-  inclusion _ M fashionR ->
-  contractive F ->
-  contractive (fun X => box M (F X)).
-Proof.
-  unfold contractive; intros.
-  apply subp_eqp.
-  apply sub_box; auto.
-  apply eqp_subp; auto.
-  apply sub_box; auto.
-  apply eqp_subp2; auto.
-Qed.
-
-Lemma box_nonexpansive {A} `{ageable A} : forall F (M:modality),
-  inclusion _ M fashionR ->
-  nonexpansive F ->
-  nonexpansive (fun X => box M (F X)).
-Proof.
-  unfold nonexpansive; intros.
-  apply subp_eqp.
-  apply sub_box; auto.
-  apply eqp_subp; auto.
-  apply sub_box; auto.
-  apply eqp_subp2; auto.
-Qed.
-
-Lemma diamond_contractive {A} `{ageable A} : forall F (M:modality),
-  inclusion _ M fashionR ->
-  contractive F ->
-  contractive (fun X => diamond M (F X)).
-Proof.
-  unfold contractive; intros.
-  apply subp_eqp.
-  apply sub_diamond; auto.
-  apply eqp_subp; auto.
-  apply sub_diamond; auto.
-  apply eqp_subp2; auto.
-Qed.
-
-Lemma diamond_nonexpansive {A} `{ageable A} : forall F (M:modality),
-  inclusion _ M fashionR ->
-  nonexpansive F ->
-  nonexpansive (fun X => diamond M (F X)).
-Proof.
-  unfold nonexpansive; intros.
-  apply subp_eqp.
-  apply sub_diamond; auto.
-  apply eqp_subp; auto.
-  apply sub_diamond; auto.
-  apply eqp_subp2; auto.
-Qed.
-*)
-
-Lemma contractive_nonexpansive {A} `{ageable A} {EO: Ext_ord A}: forall F,
-  contractive F ->
-  nonexpansive F.
-Proof.
-  unfold contractive, nonexpansive; intros.
-  apply @derives_trans with (|>(P <=>Q)); auto.
-  apply now_later.
-Qed.
-
-Lemma sepcon_contractive {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A} : forall F G,
-  contractive F ->
-  contractive G ->
-  contractive (fun x => F x * G x).
-Proof.
-  unfold contractive; intros.
-  apply subp_eqp.
-  apply subp_sepcon; apply eqp_subp; auto.
-  apply subp_sepcon; apply eqp_subp2; auto.
-Qed.
-
-Lemma sepcon_nonexpansive {A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A} : forall F G,
-  nonexpansive F ->
-  nonexpansive G ->
-  nonexpansive (fun x => F x * G x).
-Proof.
-  unfold nonexpansive; intros.
-  apply subp_eqp.
-  apply subp_sepcon; apply eqp_subp; auto.
-  apply subp_sepcon; apply eqp_subp2; auto.
-Qed.
-
-Lemma wand_contractive {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A} : forall F G,
-  contractive F ->
-  contractive G ->
-  contractive (fun x => F x -* G x).
-Proof.
-  unfold contractive; intros.
-  apply subp_eqp.
-  apply sub_wand.
-  apply eqp_subp2; auto.
-  apply eqp_subp; auto.
-  apply sub_wand.
-  apply eqp_subp; auto.
-  apply eqp_subp2; auto.
-Qed.
-
-Lemma wand_nonexpansive {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A} : forall F G,
-  nonexpansive F ->
-  nonexpansive G ->
-  nonexpansive (fun x => F x -* G x).
-Proof.
-  unfold nonexpansive; intros.
-  apply subp_eqp.
-  apply sub_wand.
-  apply eqp_subp2; auto.
-  apply eqp_subp; auto.
-  apply sub_wand.
-  apply eqp_subp; auto.
-  apply eqp_subp2; auto.
-Qed.
-
-Lemma prove_contractive {A} `{ageable A} {EO: Ext_ord A}: forall F,
-  (forall P Q,
-    |>(P >=> Q) |-- F P >=> F Q) ->
-  contractive F.
-Proof.
-  intros.
-  unfold contractive.
-  intros.
-  apply subp_eqp.
-  apply @derives_trans with (|>(P >=> Q)).
-  apply box_positive.
-  apply eqp_subp.
-  hnf; auto.
-  auto.
-  apply @derives_trans with (|>(Q >=> P)).
-  apply box_positive.
-  apply eqp_subp2.
-  hnf; auto.
-  auto.
-Qed.
-
-Lemma prove_HOcontractive1 {A} `{ageable A} {EO: Ext_ord A}: forall X F,
-  (forall P Q: X -> pred A,
-    (ALL x:X, |>(P x >=> Q x) |--
-        ALL x:X, F P x >=> F Q x)) ->
-   HOcontractive F.
-Proof.
-  unfold HOcontractive.
-  repeat intro.
-  split.
-  eapply H0; eauto.
-  repeat intro; eapply H1; eauto.
-  eapply H0; eauto.
-  repeat intro; eapply H1; eauto.
-Qed.
-
-
-Lemma prove_HOcontractive {A} `{ageable A} {EO: Ext_ord A}: forall X F,
-  (forall (P Q: X -> pred A) (x: X),
-    (ALL x:X, (|> P x <=> |> Q x) |-- F P x >=> F Q x)) ->
-   HOcontractive F.
-Proof.
-  unfold HOcontractive.
-  intros. apply allp_right. intros.
-  repeat intro.
-  split.
-  eapply H0; eauto.
-  intro x; specialize (H1 x). apply eqp_later1. auto.
-  eapply H0; eauto.
-  intro x; specialize (H1 x). rewrite eqp_comm.
-  apply eqp_later1. auto.
-Qed.
-
-Lemma prove_HOcontractive' {A} `{ageable A} {EO: Ext_ord A}: forall X F,
-  (forall (P Q: X -> pred A) (x: X),
-    (ALL x:X, |>(P x <=> Q x) |-- F P x >=> F Q x)) ->
-   HOcontractive F.
-Proof.
-  unfold HOcontractive.
-  intros. apply allp_right. intros.
-  repeat intro.
-  split.
-  eapply H0; eauto.
-  eapply H0; eauto.
-  intro x; specialize (H1 x). rewrite eqp_comm. auto.
-Qed.
-
-Ltac sub_unfold :=
-   match goal with
-    | |- _ |-- ?A _ >=> ?A _ => unfold A
-    | |- _ |-- ?A _ _ >=> ?A _ _ => unfold A
-    | |- _ |-- ?A _ _ _ >=> ?A _ _ _ => unfold A
-    | |- _ |-- ?A _ _ _ _ >=> ?A _ _ _ _ => unfold A
-    | |- _ |-- ?A _ _ _ _ _ >=> ?A _ _ _ _ _ => unfold A
-    | v: _ |- _ => destruct v
-   end.
-
-#[export] Hint Extern 2 (_ |-- _ >=> _) => sub_unfold : contractive.
-
-#[export] Hint Resolve prove_HOcontractive
-  subp_allp subp_imp subp_refl subp_exp subp_andp subp_orp subp_subp
-  allp_imp2_later_e1 allp_imp2_later_e2 : contractive.
-
-Lemma Rec_sub {A} `{ageable A} {EO: Ext_ord A}: forall G
-  (F   : pred A -> pred A -> pred A)
-  (HF1 : forall X, contractive (F X))
-  (HF2 : forall R P Q, P >=> Q |-- F P R >=> F Q R)
-  (HF3 : forall P Q X, |>(P >=> Q) |-- F X P >=> F X Q),
-  forall P Q,
-    (G |-- P >=> Q) ->
-    G |-- Rec (F P) >=> Rec (F Q).
-Proof.
-  intros.
-  apply @derives_trans with (P >=> Q); auto.
-  clear H0.
-  apply goedel_loeb; repeat intro.
-  destruct H0.
-  rewrite Rec_fold_unfold by auto.
-  specialize ( HF2 (Rec (F Q)) P Q).
-  specialize ( HF2 a H0 a').
-  spec  HF2.  apply necR_level in H2; lia.
-  eapply HF2; auto.
-  rewrite Rec_fold_unfold in H4 by auto.
-  generalize (HF3 (Rec (F P)) (Rec (F Q)) P); intros Hrec.
-  specialize ( Hrec a H5 a').
-  spec Hrec.  apply necR_level in H2; lia.
-  eapply Hrec; auto.
-Qed.
-
-Lemma HORec_sub {A} `{ageable A} {EO: Ext_ord A}: forall G B
-  (F : pred A -> (B -> pred A) -> B -> pred A)
-  (HF1 : forall X, HOcontractive (F X))
-  (HF2 : forall R a P Q, P >=> Q |-- F P R a >=> F Q R a)
-  (HF3 : forall P Q X, ALL b:B, |>(P b >=> Q b) |-- ALL b:B, F X P b >=> F X Q b),
-  forall P Q,
-    (G |-- P >=> Q) ->
-    G |-- ALL b:B, HORec (F P) b >=> HORec (F Q) b.
-Proof.
-  intros.
-  apply @derives_trans with (P>=>Q); auto.
-  clear H0.
-  apply goedel_loeb; repeat intro.
-  destruct H0.
-  rewrite HORec_fold_unfold by auto.
-  specialize ( HF2 (HORec (F Q)) b P Q a H0 a').
-  spec HF2. apply necR_level in H2; lia.
-  eapply HF2; auto.
-  rewrite HORec_fold_unfold in H4 by auto.
-  rewrite box_all in H5.
-  specialize ( HF3 (HORec (F P)) (HORec (F Q)) P a H5 b a').
-  spec HF3. apply necR_level in H2; lia.
-  eapply HF3; auto.
-Qed.
-
-Lemma Rec_contractive {A} `{ageable A} {EO: Ext_ord A}: forall
-  (F   : pred A -> pred A -> pred A)
-  (HF1 : forall X, contractive (F X))
-  (HF2 : forall R, contractive (fun X => F X R)),
-  contractive (fun X => Rec (F X)).
-Proof.
-  intros; hnf; intros.
-  simpl.
-  apply goedel_loeb; repeat intro.
-  destruct H0.
-  split; repeat intro.
-  rewrite Rec_fold_unfold by auto.
-  specialize ( HF2 (Rec (F Q)) P Q a H0 a').
-  spec HF2. apply necR_level in H3; lia.
-  destruct HF2 as [HF2 _].
-  eapply HF2; auto.
-  rewrite Rec_fold_unfold in H5 by auto.
-  generalize (HF1 P (Rec (F P)) (Rec (F Q))); intros Hrec.
-  specialize ( Hrec a).
-  detach Hrec; auto.
-  specialize ( Hrec a').  spec Hrec. apply necR_level in H3; lia.
-  destruct Hrec; eauto.
-
-  rewrite Rec_fold_unfold by auto.
-  specialize ( HF2 (Rec (F P)) P Q a H0 a').
-  spec HF2. apply necR_level in H3; lia.
-  destruct HF2 as [_ HF2].
-  eapply HF2; auto.
-  rewrite Rec_fold_unfold in H5 by auto.
-  generalize (HF1 Q (Rec (F P)) (Rec (F Q))); intros Hrec.
-  specialize ( Hrec a).
-  detach Hrec; auto.
-  specialize ( Hrec a').  spec Hrec. apply necR_level in H3; lia.
-  destruct Hrec; eauto.
-Qed.
-
-Lemma Rec_nonexpansive {A} `{ageable A} {EO: Ext_ord A}: forall
-  (F   : pred A -> pred A -> pred A)
-  (HF1 : forall X, contractive (F X))
-  (HF2 : forall R, nonexpansive (fun X => F X R)),
-  nonexpansive (fun X => Rec (F X)).
-Proof.
-  intros; hnf; intros.
-  simpl.
-  apply goedel_loeb; repeat intro.
-  destruct H0.
-  split; repeat intro.
-  rewrite Rec_fold_unfold by auto.
-  specialize ( HF2 (Rec (F Q)) P Q a H0 a').
-  spec HF2. apply necR_level in H3; lia.
-  destruct HF2 as [HF2 _].
-  eapply HF2; auto.
-  rewrite Rec_fold_unfold in H5 by auto.
-  generalize (HF1 P (Rec (F P)) (Rec (F Q))); intros Hrec.
-  specialize ( Hrec a).
-  detach Hrec; auto.
-  specialize ( Hrec a').  spec Hrec. apply necR_level in H3; lia.
-  destruct Hrec; eauto.
-
-  rewrite Rec_fold_unfold by auto.
-  specialize ( HF2 (Rec (F P)) P Q a H0 a').
-  spec HF2. apply necR_level in H3; lia.
-  destruct HF2 as [_ HF2].
-  eapply HF2; auto.
-  rewrite Rec_fold_unfold in H5 by auto.
-  generalize (HF1 Q (Rec (F P)) (Rec (F Q))); intros Hrec.
-  specialize ( Hrec a).
-  detach Hrec; auto.
-  specialize ( Hrec a').  spec Hrec. apply necR_level in H3; lia.
-  destruct Hrec; eauto.
-Qed.
-
-
-Lemma HORec_contractive {A} `{ageable A} {EO: Ext_ord A}: forall B
-  (F : pred A -> (B -> pred A) -> B -> pred A)
-  (HF1 : forall X, HOcontractive (F X))
-  (HF2 : forall R a, contractive (fun X => F X R a)),
-  forall a, contractive (fun X => HORec (F X) a).
-Proof.
-  intros; hnf; intros.
-  simpl.
-  cut (|>(P <=> Q) |-- ALL a:B, HORec (F P) a <=> HORec (F Q) a).
-  repeat intro.
-  eapply H0; eauto.
-
-  clear a.
-  apply goedel_loeb.
-  repeat intro.
-  destruct H0.
-  split; repeat intro.
-  rewrite HORec_fold_unfold by auto.
-  specialize ( HF2 (HORec (F Q)) b P Q a H0 a').
-  spec HF2. apply necR_level in H3; lia.
-  destruct HF2 as [HF2 _].
-  eapply HF2; auto.
-  rewrite HORec_fold_unfold in H5 by auto.
-  generalize (HF1 P (HORec (F P)) (HORec (F Q))); intros Hrec.
-  specialize ( Hrec a).
-  detach Hrec.
-  specialize ( Hrec b a').  spec Hrec. apply necR_level in H3; lia.
-  destruct Hrec; eauto.
-  rewrite <- box_all.
-  auto.
-
-  rewrite HORec_fold_unfold by auto.
-  specialize ( HF2 (HORec (F P)) b P Q a H0 a').
-  spec HF2. apply necR_level in H3; lia.
-  destruct HF2 as [_ HF2].
-  eapply HF2; auto.
-  rewrite HORec_fold_unfold in H5 by auto.
-  generalize (HF1 Q (HORec (F P)) (HORec (F Q))); intros Hrec.
-  specialize (Hrec a).
-  detach Hrec.
-  specialize (Hrec b a').  spec Hrec. apply necR_level in H3; lia.
-  destruct Hrec; eauto.
-  rewrite <- box_all.
-  auto.
-Qed.
-
-Lemma HORec_nonexpansive {A} `{ageable A} {EO: Ext_ord A}: forall B
-  (F : pred A -> (B -> pred A) -> B -> pred A)
-  (HF1 : forall X, HOcontractive (F X))
-  (HF2 : forall R a, nonexpansive (fun X => F X R a)),
-  forall a, nonexpansive (fun X => HORec (F X) a).
-Proof.
-  intros; hnf; intros.
-  simpl.
-  cut (P <=> Q |-- ALL a:B, HORec (F P) a <=> HORec (F Q) a).
-  repeat intro.
-  eapply H0; eauto.
-
-  clear a.
-  apply goedel_loeb.
-  repeat intro.
-  destruct H0.
-  split; repeat intro.
-  rewrite HORec_fold_unfold by auto.
-  specialize ( HF2 (HORec (F Q)) b P Q a H0 a').
-  spec HF2. apply necR_level in H3; lia.
-  destruct HF2 as [HF2 _].
-  eapply HF2; auto.
-  rewrite HORec_fold_unfold in H5 by auto.
-  generalize (HF1 P (HORec (F P)) (HORec (F Q))); intros Hrec.
-  specialize (Hrec a).
-  detach Hrec.
-  specialize (Hrec b a').  spec Hrec. apply necR_level in H3; lia.
-  destruct Hrec; eauto.
-  rewrite <- box_all.
-  auto.
-
-  rewrite HORec_fold_unfold by auto.
-  specialize ( HF2 (HORec (F P)) b P Q a H0 a').
-  spec HF2. apply necR_level in H3; lia.
-  destruct HF2 as [_ HF2].
-  eapply HF2; auto.
-  rewrite HORec_fold_unfold in H5 by auto.
-  generalize (HF1 Q (HORec (F P)) (HORec (F Q))); intros Hrec.
-  specialize (Hrec a).
-  detach Hrec.
-  specialize (Hrec b a').  spec Hrec. apply necR_level in H3; lia.
-  destruct Hrec; eauto.
-  rewrite <- box_all.
-  auto.
-Qed.
-
-Module Trashcan.
-
-(* Note: This approach to proving HOcontractive doesn't automate
-  as well as the methods above.*)
-
-Lemma orp_HOcontractive {A}{agA: ageable A}{EO: Ext_ord A}: forall X (P Q: (X -> pred A) -> (X -> pred A)),
-       HOcontractive P -> HOcontractive Q -> HOcontractive (fun R x => P R x || Q R x).
-Proof.
- intros.
- intros F G n H2 x y Hy.
- specialize (H F G n H2 x y Hy). specialize (H0 F G n H2 x y Hy).
- destruct H, H0.
- split; (intros z ? Hz ? [?|?]; [left|right]); eauto.
-Qed.
-Lemma andp_HOcontractive {A}{agA: ageable A}{EO: Ext_ord A}: forall X (P Q: (X -> pred A) -> (X -> pred A)),
-       HOcontractive P -> HOcontractive Q -> HOcontractive (fun R x => P R x && Q R x).
-Proof.
- intros.
- intros F G n H2 x y Hy.
- specialize (H F G n H2 x y Hy). specialize (H0 F G n H2 x y Hy).
- destruct H, H0.
- split; (intros z ? Hz ? [? ?]); split; eauto.
-Qed.
-Lemma sepcon_HOcontractive {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}: forall X (P Q: (X -> pred A) -> (X -> pred A)),
-       HOcontractive P -> HOcontractive Q -> HOcontractive (fun R x => P R x * Q R x).
-Proof.
- intros.
- unfold HOcontractive in *|-.
- apply prove_HOcontractive'; intros F G ?.
- specialize (H F G). specialize (H0 F G).
- apply subp_sepcon.
- eapply derives_trans.
- apply allp_derives; intro. apply derives_refl.
- eapply derives_trans; [ apply H | ].
- apply allp_left with x.
- apply fash_derives. apply andp_left1. auto.
- eapply derives_trans.
- apply allp_derives; intro. apply derives_refl.
- eapply derives_trans; [ apply H0 | ].
- apply allp_left with x.
- apply fash_derives. apply andp_left1. auto.
-Qed.
-
-Lemma const_HOcontractive{A}{agA: ageable A}{EO: Ext_ord A}: forall X (P : X -> pred A), HOcontractive (fun _ => P).
-Proof.
- intros.
- apply prove_HOcontractive. intros. apply subp_refl.
-Qed.
-
-Lemma exp_HOcontractive {A}{agA: ageable A}{EO: Ext_ord A}:
-  forall X Y (G: Y -> X -> X) (F: Y -> X -> pred A -> pred A),
-   (forall y x, contractive (F y x)) ->
-   HOcontractive (fun (R: X -> pred A) (x: X) => EX y: Y, F y x (R (G y x))).
-Proof.
- intros.
- apply prove_HOcontractive'; intros.
- apply subp_exp; intro y.
- specialize (H y x (P (G y x)) (Q (G y x))).
- eapply derives_trans; [ | apply eqp_subp; apply H].
- apply allp_left with (G y x). auto.
-Qed.
-Lemma const_contractive {A}{agA: ageable A}{EO: Ext_ord A}: forall P : pred A, contractive (fun _ => P).
-Proof.
- intros.
- apply prove_contractive. intros. apply subp_refl.
-Qed.
-Lemma later_contractive' {A} `{ageable A} {EO: Ext_ord A}: contractive (box laterM).
-Proof.
-  unfold contractive; intros.
-  apply subp_eqp.
-  eapply derives_trans, subp_later1.
-  apply box_positive; auto.
-  apply eqp_subp; auto.
-  eapply derives_trans, subp_later1.
-  apply box_positive; auto.
-  apply eqp_subp2; auto.
-Qed.
-
-End Trashcan.
diff --git a/msl/corable.v b/msl/corable.v
deleted file mode 100644
index 201c2f890c..0000000000
--- a/msl/corable.v
+++ /dev/null
@@ -1,213 +0,0 @@
-Require Import VST.msl.base.
-Require Import VST.msl.ageable.
-Require Import VST.msl.sepalg.
-Require Import VST.msl.sepalg_generators.
-Require Import VST.msl.age_sepalg.
-Require Import VST.msl.predicates_hered.
-Require Import VST.msl.predicates_sl.
-
-Local Open Scope pred.
-
-(*Definition corable {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}
-         (P: pred A) := forall w, P w = P (core w).
-
-Lemma corable_spec: forall {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}
-  (P: pred A),
-    corable P = forall x y:A, core x = core y -> P x -> P y.
-Proof.
-  unfold corable; intros; apply prop_ext; split; intros.
-  + rewrite H in H1 |- *.
-    rewrite <- H0.
-    auto.
-  + pose proof core_idem w.
-    pose proof (H _ _ H0).
-    pose proof (H _ _ (eq_sym H0)).
-    apply prop_ext; split; auto.
-Qed.*)
-
-(* from Iris: "persistent and absorbing" *)
-Definition corable {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}
-         (P: pred A) := forall w, P w -> forall w', (join_sub w w' \/ join_sub w' w \/ ext_order w' w) -> P w'.
-
-Lemma corable_core : forall {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A} P w1 w2, corable P ->
-  core w1 = core w2 -> P w1 -> P w2.
-Proof.
-  intros.
-  eapply H; [eapply H; [eassumption|]|].
-  - right; left; eexists; apply core_unit.
-  - left; rewrite H0; eexists; apply core_unit.
-Qed.
-
-Lemma corable_andp {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}:
-  forall P Q, corable P -> corable Q -> corable (P && Q).
-Proof.
- unfold corable; intros; simpl.
- destruct H1; eauto.
-Qed.
-Lemma corable_orp {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}:
-  forall P Q, corable P -> corable Q -> corable (P || Q).
-Proof.
- unfold corable; intros; simpl.
- destruct H1; eauto.
-Qed.
-Lemma corable_allp {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}:
-  forall {B: Type} (P:  B -> pred A) ,
-      (forall b, corable (P b)) -> corable (allp P).
-Proof.
- unfold corable; simpl; intros.
- eauto.
-Qed.
-Lemma corable_exp {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}:
-  forall {B: Type} (P:  B -> pred A) ,
-      (forall b, corable (P b)) -> corable (exp P).
-Proof.
- unfold corable; intros; simpl.
- destruct H0; eauto.
-Qed.
-Lemma corable_prop {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}:
-  forall P, corable (prop P).
-Proof.
- unfold corable, prop; intros.
- simpl in *; auto.
-Qed.
-
-Lemma ext_later_compat {A}{agA: ageable A}{EO: Ext_ord A}: forall a b a', ext_order a b -> laterR a a' -> exists b', laterR b b' /\ ext_order a' b'.
-Proof.
-  intros.
-  generalize dependent b; induction H0; intros.
-  - eapply ext_age_compat in H as (? & ? & ?); eauto.
-    do 2 eexists; [|eauto].
-    apply t_step; auto.
-  - apply IHclos_trans1 in H as (? & ? & Hext).
-    apply IHclos_trans2 in Hext as (? & ? & Hext).
-    do 2 eexists; [eapply t_trans|]; eauto.
-Qed.
-
-Lemma ext_nec_compat {A}{agA: ageable A}{EO: Ext_ord A}: forall a b a', ext_order a b -> necR a a' -> exists b', necR b b' /\ ext_order a' b'.
-Proof.
-  intros.
-  apply nec_refl_or_later in H0 as [|]; subst; eauto.
-  eapply ext_later_compat in H as (? & ? & ?); eauto.
-  do 2 eexists; [apply laterR_necR|]; eauto.
-Qed.
-
-Lemma corable_imp {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A} {agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}:
-  forall P Q, corable P -> corable Q -> corable (P --> Q).
-Proof.
-  unfold corable; simpl; intros.
-  destruct H2 as [[? J] | [[? J] | E]].
-  - eapply nec_join2 in J as (? & ? & ? & Hw & ?); eauto.
-    eapply ext_join_commut in H2 as (? & ? & ?); eauto.
-    eapply H1 in H2; eauto.
-  - eapply nec_join in J as (? & ? & ? & ? & Hw); eauto.
-    eapply H1 in Hw; [| eauto | eauto].
-    + eapply pred_upclosed, H0; eauto.
-    + apply H with a'; eauto.
-  - eapply ext_nec_compat in E as (? & Hnec & ?); eauto.
-    eapply H1 in Hnec; try reflexivity.
-    + eapply pred_upclosed, H0; eauto.
-    + eapply pred_upclosed, H; eauto.
-Qed.
-
-Lemma corable_sepcon {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}:
-  forall P Q, corable P -> corable Q -> corable (P * Q).
-Proof.
-  unfold corable; simpl; intros.
-  destruct H1 as (? & ? & J & HP & HQ).
-  destruct H2 as [[? J'] | [[? J'] | E]].
-  - destruct (join_assoc J J') as (? & ? & ?).
-    do 3 eexists; eauto.
-  - do 3 eexists; [apply core_unit|].
-    split.
-    + eapply H; [eapply H; [eassumption|]|].
-      * left; eexists; apply J.
-      * right; left; eapply join_sub_trans; [|eexists; eauto].
-        eexists; apply core_unit.
-    + eapply H0; [eapply H0; [eassumption|]|].
-      * left; eexists; apply join_comm, J.
-      * eauto.
-  - do 3 eexists; [apply core_unit|].
-    split.
-    + eapply H in HP; [|left; eexists; eauto].
-      eapply H in HP; [|right; right; eauto].
-      eapply H; eauto.
-      right; left; eexists; apply core_unit.
-    + eapply H0 in HQ; [|left; eexists; eauto]; eauto.
-Qed.
-
-Lemma corable_wand: forall {A:Type} {agA:ageable A} {JA: Join A} {PA: Perm_alg A} {SaA: Sep_alg A} {XA: Age_alg A} {EO: Ext_ord A}{EA: Ext_alg A} (P Q: pred A), corable P -> corable Q -> corable (P -* Q).
-Proof.
-  unfold corable; simpl; intros.
-  destruct H2 as [[? J] | [[? J] | E]].
-  - eapply nec_join2 in J as (? & ? & J' & Hw & ?); eauto.
-    eapply H1 in Hw; try apply J'; eauto.
-    eapply H; [eapply H; [eapply H; [eassumption|]|]|].
-    + left; eexists; apply join_comm; eassumption.
-    + right; left; eexists; eauto.
-    + eauto.
-  - eapply nec_join in J as (? & ? & J' & ? & Hw); eauto.
-    eapply H1 in Hw; try apply join_comm, core_unit.
-    + eapply H0; [eapply H0; [eassumption|]|].
-      * right; left; eexists; eauto.
-      * left; eexists; eauto.
-    + eapply H; [eapply H; [eapply H; [eapply H; [eassumption|]|]|]|].
-      * left; eexists; eauto.
-      * right; left; eexists; eauto.
-      * left; eexists; eauto.
-      * right; left; eexists; apply core_unit.
-  - eapply ext_nec_compat in E as (? & Hnec & ?); eauto.
-    eapply H1 in Hnec; [| apply join_comm, core_unit |].
-    + eapply H0; [eapply H0; eauto|]; eauto.
-    + eapply H; [|right; left; eexists; apply core_unit].
-      eapply pred_upclosed; eauto.
-      eapply H; [|right; left; eexists; eauto]; eauto.
-Qed.
-
-Lemma corable_later: forall {A:Type} {agA:ageable A} {JA: Join A} {PA: Perm_alg A} {SaA: Sep_alg A} {XA: Age_alg A} {EO: Ext_ord A}{EA: Ext_alg A} P, corable P -> corable (|> P).
-Proof.
-  unfold corable; simpl; intros.
-  destruct H1 as [[? J] | [[? J] | E]].
-  - eapply later_join2 in J as (? & ? & ? & ? & ?); eauto.
-  - eapply later_join in J as (? & ? & ? & ? & ?); eauto.
-    eapply H; eauto.
-  - eapply ext_later_compat in E as (? & ? & ?); eauto.
-Qed.
-
-#[export] Hint Resolve corable_andp corable_orp corable_allp corable_exp
-                    (*corable_imp*) corable_prop corable_sepcon corable_wand corable_later : core.
-
-Lemma corable_andp_sepcon1{A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}:
-   forall P Q R, corable P ->  (P && Q) * R = P && (Q * R).
-Proof.
-intros.
-apply pred_ext.
-intros w [w1 [w2 [? [[? ?] ?]]]].
-split; [eapply H; eauto|].
-exists w1, w2; auto.
-intros w [? [w1 [w2 [? [? ?]]]]].
-exists w1; exists w2; split; [|split]; auto.
-split; eauto.
-Qed.
-
-(* The following 3 lemmas should not be necessary *)
-Lemma corable_andp_sepcon2{A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}:
-   forall P Q R, corable P ->  (Q && P) * R = P && (Q * R).
-Proof.
-intros. rewrite andp_comm. apply corable_andp_sepcon1. auto.
-Qed.
-
-Lemma corable_sepcon_andp1 {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}:
-   forall P Q R, corable P ->  Q  * (P && R) = P && (Q * R).
-Proof.
-intros. rewrite sepcon_comm. rewrite corable_andp_sepcon1; auto. rewrite sepcon_comm; auto.
-Qed.
-
-Lemma corable_sepcon_andp2 {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}:
-   forall P Q R, corable P ->  Q  * (R && P) = P && (Q * R).
-Proof.
-intros. rewrite sepcon_comm. rewrite andp_comm. rewrite corable_andp_sepcon1; auto. rewrite sepcon_comm; auto.
-Qed.
-
-(* This hint doesn't work well, hence the extra clauses in normalize1 and normalize1_in *)
-#[export] Hint Rewrite @corable_andp_sepcon1 @corable_andp_sepcon2
-                    @corable_sepcon_andp1 @corable_sepcon_andp2 using solve [auto with normalize typeclass_instances] : core.
\ No newline at end of file
diff --git a/msl/corable_direct.v b/msl/corable_direct.v
deleted file mode 100644
index 9846fcc188..0000000000
--- a/msl/corable_direct.v
+++ /dev/null
@@ -1,123 +0,0 @@
-Require Import VST.msl.base.
-Require Import VST.msl.sepalg.
-Require Import VST.msl.predicates_sa.
-
-Local Open Scope pred.
-
-Definition corable {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}
-         (P: pred A) := forall w, P w = P (core w).
-
-Lemma corable_spec: forall {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}
-  (P: pred A),
-    corable P = forall x y:A, core x = core y -> P x -> P y.
-Proof.
-  unfold corable; intros; apply prop_ext; split; intros.
-  + rewrite H in H1 |- *.
-    rewrite <- H0.
-    auto.
-  + pose proof core_idem w.
-    pose proof (H _ _ H0).
-    pose proof (H _ _ (eq_sym H0)).
-    apply prop_ext; split; auto.
-Qed.
-
-Lemma corable_andp {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}:
-  forall P Q, corable P -> corable Q -> corable (P && Q).
-Proof.
- unfold corable; intros.
- apply prop_ext; split; intros [? ?]; split; congruence.
-Qed.
-Lemma corable_orp {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}:
-  forall P Q, corable P -> corable Q -> corable (P || Q).
-Proof.
- unfold corable; intros.
- apply prop_ext; split; (intros [?|?]; [left|right]; congruence).
-Qed.
-Lemma corable_allp {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}:
-  forall {B: Type} (P:  B -> pred A) ,
-      (forall b, corable (P b)) -> corable (allp P).
-Proof.
- unfold corable, allp; intros.
- apply prop_ext; split; simpl; intros.
- rewrite <- H; auto. rewrite H; auto.
-Qed.
-Lemma corable_exp {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}:
-  forall {B: Type} (P:  B -> pred A) ,
-      (forall b, corable (P b)) -> corable (exp P).
-Proof.
- unfold corable, exp; intros.
- apply prop_ext; split; simpl; intros;  destruct H0 as [b ?]; exists b.
- rewrite <- H; auto. rewrite H; auto.
-Qed.
-Lemma corable_prop{A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}:
-  forall P, corable (prop P).
-Proof.
- unfold corable, prop; intros.
- apply prop_ext; split; simpl; intros; auto.
-Qed.
-
-Lemma corable_imp {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A} :
-  forall P Q, corable P -> corable Q -> corable (P --> Q).
-Proof.
-  intros.
-  rewrite corable_spec in H, H0 |- *.
-  unfold imp in *.
-  simpl in *.
-  intros.
-  eapply H0; eauto.
-Qed.
-
-Lemma corable_sepcon {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{FA: Flat_alg A}:
-  forall P Q, corable P -> corable Q -> corable (P * Q).
-Proof.
-  intros.
-  rewrite corable_spec in H, H0 |- *.
-  unfold sepcon.
-  intros.
-  simpl in H2 |- *.
-  destruct H2 as [x' [x'' [? [? ?]]]].
-  pose proof join_core H2.
-  pose proof join_core (join_comm H2).
-  exists (core y), y.
-  repeat split.
-  + apply core_unit.
-  + apply H with x'; auto.
-    rewrite core_idem.
-    congruence.
-  + apply H0 with x''; auto.
-    congruence.
-Qed.
-
-Lemma corable_wand: forall {A:Type} {JA: Join A} {PA: Perm_alg A} {SaA: Sep_alg A} {FA: Flat_alg A} (P Q: pred A), corable P -> corable Q -> corable (P -* Q).
-Proof.
-  intros.
-  rewrite corable_spec in H, H0 |- *.
-  unfold wand in *.
-  simpl in *.
-  intros.
-  pose proof join_core H3.
-  pose proof join_core (join_comm H3).
-  apply H0 with x; [congruence |].
-  apply (H2 (core x) x).
-  + apply core_unit.
-  + apply H with x0; auto.
-    rewrite core_idem.
-    congruence.
-Qed.
-
-Lemma corable_andp_sepcon1{A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{FA: Flat_alg A}:
-   forall P Q R, corable P ->  (P && Q) * R = P && (Q * R).
-Proof.
-intros.
-apply pred_ext.
-intros w [w1 [w2 [? [[? ?] ?]]]].
-split.
-apply join_core in H0.
-rewrite H in H1|-*. rewrite <- H0; auto.
-exists w1; exists w2; split; [| split]; auto.
-intros w [? [w1 [w2 [? [? ?]]]]].
-exists w1; exists w2; split; [|split]; auto.
-split; auto.
-apply join_core in H1.
-rewrite H in H0|-*. rewrite H1; auto.
-Qed.
diff --git a/msl/corec.v b/msl/corec.v
deleted file mode 100644
index 1f4dc7c691..0000000000
--- a/msl/corec.v
+++ /dev/null
@@ -1,104 +0,0 @@
-Require Import VST.msl.base.
-Require Import VST.msl.sepalg.
-Require Import VST.msl.predicates_sa.
-
-Definition covariant {B A : Type} (F: (B -> pred A) -> (B -> pred A)) : Prop :=
-forall (P Q: B -> pred A), (forall x, P x |-- Q x) -> (forall x, F P x |-- F Q x).
-
-Definition corec {B A: Type}  (F: (B -> pred A) -> (B -> pred A)) : B -> pred A :=
-fun x w => forall P: B -> pred A, (forall x, F P x |-- P x) -> P x w.
-
-Lemma corec_fold_unfold {B A}:
-forall {F: (B -> pred A) -> (B -> pred A)},
-       covariant F ->
-        corec F = F (corec F).
-Proof.
-intros.
-assert (forall x, F (corec F) x |-- corec F x).
-2:{
-extensionality x.
-apply pred_ext; intros w ?.
-apply H1. intros x' ? ?.
-eapply H.  eapply H0.
-replace (F (corec F)) with (fun (x : B) (w : A) => F (corec F) x w); auto.
-apply H0; auto.
-}
-intros x ? ?.
-intros ? ?.
-specialize (H (corec F) P).
-apply H1. apply H; auto.
-intros x' ? ?.
-apply H2; auto.
-Qed.
-
-Lemma corec_least_fixpoint {B A}:
-forall {F: (B -> pred A) -> (B -> pred A)}, forall {P : B -> pred A},
-  P = F P ->
-  forall b, corec F b |-- P b.
-Proof.
-  intros. do 2 intro.
-  apply H0 with (P := P). intros b' ? ?.
-  rewrite H. apply H1.
-Qed.
-
-Lemma covariant_sepcon {B}{A} {JA: Join A}{PA: Perm_alg A}:
-   forall P Q : (B -> pred A) -> (B -> pred A),
-    covariant P -> covariant Q ->
-    covariant (fun (x : B -> pred A) b => P x b * Q x b)%pred.
-Proof.
-intros. intros R S ? ?.
-eapply sepcon_derives; auto.
-Qed.
-
-Lemma covariant_const {B A}:    forall P : B -> pred A, covariant (fun _ => P).
-Proof.
-intros. intros R S ?. auto.
-Qed.
-
-Lemma covariant_orp {B A}:  forall P Q: (B -> pred A)-> (B -> pred A),
-      covariant P -> covariant Q -> covariant (fun x b => P x b || Q x b)%pred.
-Proof.
-intros. intros R S ? ?.
-intros w [H2|H2]; [left; eapply H | right; eapply H0]; try apply H1; eauto.
-Qed.
-
-Lemma covariant_andp {B A}:  forall P Q: (B -> pred A) -> (B -> pred A),
-      covariant P -> covariant Q -> covariant (fun x b => P x b && Q x b)%pred.
-Proof.
-intros. intros R S ? ?.
-apply andp_derives; auto.
-Qed.
-
-Lemma covariant_exp {C B A}: forall F: C -> (B -> pred A) -> (B -> pred A),
-  (forall c, covariant (F c)) ->
-   covariant (fun P b => EX c:C, F c P b)%pred.
-Proof.
-intros.
-repeat intro.
-destruct H1 as [b ?].
-exists b. specialize (H b).
-unfold covariant in H.
-apply (H P Q H0). auto.
-Qed.
-
-
-Lemma covariant_id {B A}: covariant (fun F: B -> pred A => F).
-Proof.
-unfold covariant; auto.
-Qed.
-
-Lemma covariant_const' {B A}:
-  forall c:B,  covariant (fun (P: B -> pred A) _ => P c).
-Proof.
-repeat intro.
-apply H; auto.
-Qed.
-
-
-
-
-
-
-
-
-
diff --git a/msl/cross_split.v b/msl/cross_split.v
deleted file mode 100644
index 81a8b10d19..0000000000
--- a/msl/cross_split.v
+++ /dev/null
@@ -1,520 +0,0 @@
-(*
- * Copyright (c) 2009-2011, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-
-Require Import VST.msl.base.
-Require Import VST.msl.sepalg.
-Require Import VST.msl.psepalg.
-Require Import VST.msl.sepalg_generators.
-Require Import VST.msl.cjoins.
-Require Import VST.msl.eq_dec.
-
-(** The cross split axiom looks unwieldly,
-    but here we show that it arises naturally
-    as a kind of distributivity property.
-    Cross split can be rendered, with some accuracy,
-    as "the separation algebra is distributive."
- *)
-
-  (** This definition mirrors the definition of
-      distributivity in a join-semilattice.  This
-      definition generalizes the standard notion of
-      distributivity in a lattice, but only mentions
-      of the lattice operators.  Here we transplant
-      the semilattice definition into the setting
-      of separation algebras.
-    *)
-  Definition sa_distributive (A: Type) {JOIN: Join A} :=
-    forall a b x z,
-      join a b z ->
-      constructive_join_sub x z ->
-      {a' : A & {b' : A &
-           (constructive_join_sub a' a * constructive_join_sub b' b * join a' b' x)%type}}.
-
-(*
-  (** We define this weaker version of cross-split
-      in order to show that the sa_distributive
-      axiom is equivalent. The ordinary cross_split
-      is more constructive (it uses a sigma type rather
-      than 'exists'), so we have to weaken it to show
-      the correspondence.  We could, instead, define
-      and use a constructive version of join_sub.
-    *)
-  Definition weak_cross_split `{sepalg A} :=
-    forall a b c d z : A,
-      join a b z ->
-      join c d z ->
-      exists x:(A*A*A*A), match x with (ac,ad,bc,bd) =>
-         join ac ad a /\
-         join bc bd b /\
-         join ac bc c /\
-         join ad bd d
-       end.
-*)
-
-  (** Here we show that the cross split axiom is
-      the same as the statement of distributivity
-      for join semilattices transliterated into the
-      setting of separation algebras.
-    *)
-  Theorem cross_split_distibutive {A} `{Perm_alg A}{SA: Sep_alg A}{CS: Cross_alg A} :
-          sa_distributive A.
-  Proof.
-    intros ? ? ? ? H1 [x0 H2].
-    destruct (CS _ _ _ _ _ H1 H2) as [[[[? ?] ?] ?] ?].
-    intuition eauto.
-    exists a0.
-    exists a2.
-    intuition eauto.
-    econstructor; eauto.
-    econstructor; eauto.
-  Qed.
-
-  Theorem distributive_cross_split {A} `{Perm_alg A}{SA: Sep_alg A}{CA: Canc_alg A}:
-     sa_distributive A -> Cross_alg A.
-  Proof.
-    intros H0.
-    repeat intro.
-    hnf in H0.
-    destruct (H0 a b c z H1) as [a' [b' [[?H ?H] ?H]]].
-    exists d; auto.
-    destruct H3 as [q ?H].
-    destruct H4 as [w ?H].
-    exists (a',q,b',w). split; auto. split; auto. split; auto.
-    destruct (join_assoc H3 H1) as [f [? ?]].
-    apply join_comm in H6.
-    destruct (join_assoc H4 H6) as [g [? ?]].
-    assert (H10: g = d); [ | rewrite H10 in *; auto].
-    apply join_comm in H7.
-    apply join_comm in H9.
-    destruct (join_assoc H9 H7) as [h [? ?]].
-    generalize (join_eq H5 (join_comm H10)); intro.
-    rewrite <- H12 in *; clear H12 h.
-    eapply join_canc; eauto.
-  Qed.
-
-(** NOTICE ABOUT REDUNDANT LEMMAS:
- Since sa_distribute <-> cross_split, many of the proofs below are redundant.
- This was part of an experiment to see whether, in general, sa_distributive is
- simpler to prove than cross_split.  Short answer:  not really.
-*)
-
-Lemma distributive_equiv: forall A, @sa_distributive  _ (@Join_equiv A).
-Proof.
-  repeat intro.
- destruct H; subst.
- exists x; exists x; repeat split; auto.
-Qed.
-
-Lemma cross_split_equiv : forall A,  @Cross_alg _ (@Join_equiv A).
-Proof.
-  repeat intro.
-  destruct H; destruct H0. subst. exists (((z,z),z),z). repeat split; auto.
-Qed.
-
-Lemma distributive_fun: forall A (JOIN: Join A) (key: Type),
-               sa_distributive A -> @sa_distributive (key -> A) (Join_fun key A JOIN).
-Proof.
-unfold sa_distributive; intros.
-assert (forall k, constructive_join_sub (x k) (z k)).
-destruct X0 as [y ?].
-intro k; exists (y k); auto.
-assert (J := fun (k: key) => X (a k) (b k) (x k) (z k) (H k) (X1 k)).
-clear X.
-exists (fun k => projT1 (J k)).
-exists (fun k => projT1 (projT2 (J k))).
-split; [split|].
-exists (fun k => proj1_sig (fst (fst (projT2 (projT2 (J k))))));
-intro k; destruct (J k) as [ak' [bk' [[c c0] j]]];  simpl; destruct c; auto.
-exists (fun k => proj1_sig (snd (fst (projT2 (projT2 (J k))))));
-intro k; destruct (J k) as [ak' [bk' [[c c0] j]]];  simpl; destruct c0; auto.
-intro k; destruct (J k) as [ak' [bk' [[c c0] j]]]; simpl; auto.
-Qed.
-
-#[global] Instance cross_split_fun: forall A (JOIN: Join A) (key: Type),
-          Cross_alg A -> Cross_alg (key -> A).
-Proof.
-repeat intro.
-pose (f (x: key) := projT1 (X (a x) (b x) (c x) (d x) (z x) (H x) (H0 x))).
-pose (g (x: key) := projT2 (X (a x) (b x) (c x) (d x) (z x) (H x) (H0 x))).
-pose (ac (x: key) := fst (fst (fst (f x)))).
-pose (ad (x: key) := snd (fst (fst (f x)))).
-pose (bc (x: key) := snd (fst (f x))).
-pose (bd (x: key) := snd (f x)).
-exists (ac,ad,bc,bd).
-unfold ac, ad, bc, bd, f; clear ac ad bc bd f.
-repeat split; intro x; simpl;
-generalize (g x);  destruct (projT1 (X (a x) (b x) (c x) (d x) (z x) (H x) (H0 x))) as [[[? ?] ?] ?]; simpl; intuition.
-Qed.
-
-Lemma sa_distributive_prod : forall A B saA saB,
-  @sa_distributive A saA ->
-  @sa_distributive B saB ->
-  @sa_distributive (A * B) (Join_prod A _ B _).
-Proof.
- intros.
- intros [a1 a2] [b1 b2] [c1 c2] [z1 z2] [? ?].
- intros [[d1 d2] [? ?]].
- simpl in *.
- destruct (X a1 b1 c1 z1 H) as [a1' [b1' [[[u1 ?] [v1 ?]] ?]]]. exists d1; auto.
- destruct (X0 a2 b2 c2 z2 H0) as [a2' [b2' [[[u2 ?] [v2 ?]] ?]]]. exists d2; auto.
- exists (a1',a2'). exists (b1',b2').
- split; [split|].
- exists (u1,u2); split; auto.
- exists (v1,v2); split; auto.
- split; auto.
-Qed.
-
-#[global] Instance Cross_prod : forall A B saA saB,
-  @Cross_alg A saA ->
-  @Cross_alg B saB ->
-  @Cross_alg (A * B) (Join_prod _ saA _ saB).
-Proof.
-  repeat intro.
-  destruct a as [a1 a2].
-  destruct b as [b1 b2].
-  destruct c as [c1 c2].
-  destruct d as [d1 d2].
-  destruct z as [z1 z2].
-  destruct H.
-  destruct H0.
-  simpl in *.
-  destruct (X a1 b1 c1 d1 z1)
-    as [p ?]; auto.
-  destruct p as [[[s1 p1] q1] r1].
-  destruct (X0 a2 b2 c2 d2 z2)
-    as [p ?]; auto.
-  destruct p as [[[s2 p2] q2] r2].
-  exists ((s1,s2),(p1,p2),(q1,q2),(r1,r2)).
-  simpl; intuition; (split; simpl; auto).
-Qed.
-
-Lemma sa_distributive_bij : forall A B JA bij,
-  @sa_distributive A JA ->
-  @sa_distributive B (Join_bij A JA B bij).
-Proof.
- repeat intro.
- destruct X0 as [u ?]. unfold Join_bij; simpl.
- destruct bij. simpl.
- destruct (X (bij_g a) (bij_g b) (bij_g x) (bij_g z)) as [a' [b' [[[? ?] [? ?]] ?]]]; auto.
- exists (bij_g u); auto.
- exists (bij_f a'); exists (bij_f b'); split; [split|].
- exists (bij_f x0); hnf; repeat rewrite bij_gf; auto.
- exists (bij_f x1); hnf; repeat rewrite bij_gf; auto.
- hnf; repeat rewrite bij_gf; auto.
-Qed.
-
-Lemma Cross_bij : forall A B JA bij,
-  @Cross_alg A  JA ->
-  @Cross_alg B (Join_bij A JA B bij).
-Proof.
-  repeat intro. unfold join, Join_bij in *.
-  destruct bij. simpl in *.
-  destruct (X (bij_g a) (bij_g b) (bij_g c) (bij_g d) (bij_g z)); auto.
-  destruct x as [[[s p] q] r].
-  exists (bij_f s,bij_f p,bij_f q,bij_f r).
-  simpl.
-  repeat rewrite bij_gf.
-  auto.
-Qed.
-
-Lemma constructive_join_sub_smash {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{CA: Disj_alg A}:
-  (forall x:A, {identity x}+{~identity x}) ->
-  forall a c : lifted JA,
-    constructive_join_sub (proj1_sig a) (proj1_sig c) ->
-    @constructive_join_sub (option (lifted JA)) _ (Some a) (Some c).
-Proof.
-intros.
-destruct X0 as [b ?].
-destruct (X b).
-assert (a=c).
-destruct a; destruct c. apply exist_ext.
-simpl in j.
-eapply join_eq; try apply j. apply join_comm; apply identity_unit; eauto.
-subst c.
-exists None; constructor.
-exists (Some (mk_lifted _ (nonidentity_nonunit n))).
-constructor.
-destruct a; destruct c; simpl in *.
-auto.
-Qed.
-
-Lemma sa_distributive_smash : forall A JA {PA: Perm_alg A}{SA: Sep_alg A}{CA: Disj_alg A},
-  (forall x:A, {identity x}+{~identity x}) ->
-  @sa_distributive A JA ->
-  sa_distributive (option (lifted JA)).
-Proof.
-intros. unfold Join_lower, Join_lift; simpl.
-intros [[a Ha]|].
-2: intros; assert (b=z) by (inv H; auto); subst z; exists None; exists x;
-    split; [split|]; auto; [ econstructor  | ]; constructor.
-intros [[b Hb]|].
-2: intros b [[z Hz]|] ? ?;
- [assert (a=z) by (inv H; auto); subst z; clear H;
-   rewrite (proof_irr Hz Ha) in X1; clear Hz; exists b; exists None;
-    split; [split|]; auto
- | exfalso; inv H];
-  [ econstructor  | ]; constructor.
-intros [[c Hc]|].
-2: intros ? ? ?; exists None; exists None; split; [split|]; econstructor; econstructor.
-intros [[z Hz]|] H Hj.
-2: exfalso; inv H.
-destruct (X0 a b c z) as [a' [b' [[? ?] ?]]].
-inv H. apply H3.
-inversion Hj.
-destruct x.
-exists (lifted_obj l). inv H0.  apply H4.
-assert (c=z) by (inv H0; auto). replace c with z.
-apply constructive_join_sub_refl.
-destruct (X a') as [Pa'|Pa']; [exists None | exists (Some (mk_lifted _ (nonidentity_nonunit Pa'))) ].
-assert (b'=c) by (eapply join_eq; try apply j; apply identity_unit; eauto).
-subst b'.
-exists (Some (mk_lifted c Hc)).
-split; [split|]; eauto. econstructor; econstructor.
-apply constructive_join_sub_smash; auto.
-constructor.
-destruct (X b') as [Pb'|Pb']; [exists None | exists (Some (mk_lifted _ (nonidentity_nonunit Pb')))].
-split; [split|]; eauto.
-apply constructive_join_sub_smash; auto.
-econstructor; econstructor.
-apply join_unit2. econstructor; eauto.
-f_equal. apply exist_ext.
-symmetry. eapply join_eq. eapply join_comm; apply j.  apply identity_unit; eauto.
-split; [split|]; eauto.
-apply constructive_join_sub_smash; auto.
-apply constructive_join_sub_smash; auto.
-constructor; auto.
-Qed.
-
-Lemma Cross_smash : forall A (JA: Join A) {PA: Perm_alg A}{SA: Sep_alg A}{CA: Disj_alg A},
-  (forall x:A, {identity x}+{~identity x}) ->
-  Cross_alg A ->
-  Cross_alg (option (lifted JA)).
-Proof.
-  intros.
-  hnf; intros.
-  destruct a as [[a Na] | ].
-2:{
-  apply join_unit1_e in H; [ | apply None_identity]. subst z.
-  exists (None,None,c,d); repeat split; auto; constructor; auto.
-}
-  destruct b as [[b Nb] | ].
-2:{
-  apply join_unit2_e in H; [ | apply None_identity]. subst z.
-  exists (c,d,None,None); repeat split; auto; constructor; auto.
-}
-  destruct c as [[c Nc] | ].
-2:{
-  apply join_unit1_e in H0; [ | apply None_identity]. subst z.
-  exists (None, Some (exist nonunit _ Na), None, Some (exist nonunit _ Nb));
-     repeat split; auto; constructor.
-}
-  destruct d as [[d Nd] | ].
-2:{
-  apply join_unit2_e in H0; [ | apply None_identity]. subst z.
-  exists (Some (exist nonunit _ Na), None,Some (exist nonunit _ Nb),None); repeat split; auto; constructor; auto.
-}
-  destruct z as [[z Nz] | ]; [ | exfalso; inv H].
-  destruct (X0 a b c d z) as [[[[ac ad] bc] bd] [? [? [? ?]]]]; try (inv H; inv H0; auto). clear H H0.
-  destruct (X ac) as [Nac | Nac ].
-  apply Nac in H1. subst ad. apply Nac in H3. subst bc.
-  destruct (X bd) as [Nbd | Nbd].
-  apply join_unit2_e in H4; auto. subst d.
-  apply join_unit2_e in H2; auto. subst c.
-  rewrite (proof_irr Nd Na) in *. rewrite (proof_irr Nc Nb) in *.
-  exists (None, Some (exist nonunit a Na), Some (exist nonunit b Nb), None);
-    repeat split; auto;  constructor.
-  exists (None, Some (exist nonunit a Na), Some (exist nonunit c Nc),
-      Some (exist nonunit bd (nonidentity_nonunit Nbd))).
-  repeat split; auto;  try constructor. apply H2. apply H4.
-  destruct (X ad) as [Nad | Nad].
-  apply join_unit2_e in H1; auto. subst ac.
-  apply join_unit1_e in H4; auto. subst bd.
-  destruct (X bc) as [Nbc | Nbc].
-  apply join_unit2_e in H3; auto. subst c.
-  apply join_unit1_e in H2; auto. subst d.
-  rewrite (proof_irr Nd Nb) in *. rewrite (proof_irr Nc Na) in *.
-  exists (Some (exist nonunit a Na), None, None, Some (exist nonunit b Nb));
-    repeat split; auto; constructor.
-  apply nonidentity_nonunit in Nbc.
-  exists (Some (exist nonunit a Na), None, Some (exist nonunit _ Nbc), Some (exist nonunit d Nd));
-    repeat split; auto; constructor. apply H2. apply H3.
-  destruct (X bc) as [Nbc | Nbc].
-  apply join_unit2_e in H3; auto. subst ac.
-  apply join_unit1_e in H2; auto. subst bd.
-  apply nonidentity_nonunit in Nad.
-  exists (Some (exist nonunit c Nc), Some (exist nonunit _ Nad), None, Some (exist nonunit b Nb));
-    repeat split; auto; try constructor. apply H1. apply H4.
-  destruct (X bd) as [Nbd | Nbd].
-  apply join_unit2_e in H2; auto. subst bc.
-  apply join_unit2_e in H4; auto. subst ad.
-  apply nonidentity_nonunit in Nbc.   apply nonidentity_nonunit in Nad.
-    apply nonidentity_nonunit in Nac.
-  exists (Some (exist nonunit ac Nac), Some (exist nonunit d Nd),
-             Some (exist nonunit b Nb), None).
-    repeat split; auto; try constructor. apply H1. apply H3.
-  apply nonidentity_nonunit in Nbc.   apply nonidentity_nonunit in Nad.
-    apply nonidentity_nonunit in Nac. apply nonidentity_nonunit in Nbd.
-  exists (Some (exist nonunit ac Nac), Some (exist nonunit ad Nad),
-             Some (exist nonunit bc Nbc), Some (exist nonunit bd Nbd)).
-  repeat split; constructor; assumption.
-Qed.
-
-Lemma cross_split_fpm : forall A B
-      (JB: Join B) (PB: Perm_alg B)(SB : Sep_alg B)(CB: Disj_alg B)
-  (Bdec: forall x:B, {identity x}+{~identity x}) ,
-  Cross_alg B  ->
-  Cross_alg (fpm A (lifted JB)) .
-Proof.
-  intros.
-  assert (Cross_alg (A -> option (lifted JB))).
-  apply cross_split_fun. apply Cross_smash; auto.
-
-  hnf. intros [a Ha] [b Hb] [c Hc] [d Hd] [z Hz].
-  simpl; intros.
-  destruct (X0 a b c d z); auto.
-  destruct x as [[[s p] q] r].
-  decompose [and] y; clear y.
-  assert (Hs : finMap s).
-  destruct Ha.
-  exists x.
-  intros.
-  specialize ( H1 a0).
-  rewrite e in H1; auto. inv H1; auto.
-  assert (Hq : finMap q).
-  destruct Hb.
-  exists x.
-  intros.
-  specialize ( H3 a0). inv H3; auto. rewrite H9; rewrite e; auto.
-  rewrite e in H8; auto. inv H8.
-  assert (Hr : finMap r).
-  destruct Hb.
-  exists x.
-  intros.
-  specialize ( H3 a0).
-  rewrite e in H3; auto. inv H3; auto.
-  assert (Hp : finMap p).
-  destruct Hd.
-  exists x. intros. specialize ( H5 a0). rewrite e in H5; auto. inv H5; auto.
-  exists (exist _ s Hs, exist _ p Hp, exist _ q Hq, exist _ r Hr).
-  simpl; intuition.
-Qed.
-
-Lemma Cross_fpm (A B: Type){JB: Join B} {PB: Perm_alg B}{PosB : Pos_alg B}
-  {CrB: Cross_alg B}:   Cross_alg (fpm A B) .
- (* Warning: This lemma is valid, but it's not clear that it's useful *)
-Proof.
-  intros.
-  assert (Cross_alg (A -> option B)).
-  apply cross_split_fun.
-  unfold Cross_alg.
-  destruct a as [a |]. destruct b as [b|]. destruct c as [c|]. destruct d as [d|].
-  destruct z as [z|].
-  intros.
-  hnf in H.
-  assert (join a b z) by (clear - H; inv H; auto).
-  assert (join c d z) by (clear - H0; inv H0; auto).
-  clear H H0.
-  destruct (CrB _ _ _ _ _ H1 H2) as [[[[s p] q] r] [? [? [? ?]]]].
-  exists (Some s, Some p, Some q, Some r); repeat split; try constructor; auto.
-  intros. exfalso; inv H.
-  intros. assert (z = Some c) by (clear - H0; inv H0; auto).
-  subst. assert (join a b c) by   (clear - H; inv H; auto).
-  exists (Some a, None, Some b, None); repeat split; try constructor; auto.
-  intros.
-  destruct d as [d|].
-  assert (z=Some d) by (clear - H0; inv H0; auto). subst z.
-  exists (None, Some a, None, Some b); repeat split; try constructor; auto.
-  clear - H; inv H; auto.
-  exfalso; inv H0; inv H.
-  destruct c as [c|]. destruct d as [d|].
-  intros.
-  assert (z = Some a) by (clear - H; inv H; auto). subst z.
-  exists (Some c, Some d, None, None); repeat split; try constructor; eauto.
-  inv H0; auto.
-  intros. assert (z = Some a) by (clear - H; inv H; auto). subst.
-  assert (a=c) by (clear - H0; inv H0; auto). subst c.
-  exists (Some a, None, None, None); repeat split; try constructor; auto.
-  intros.
-  assert (z=d) by (clear - H0; inv H0; auto). subst d.
-  assert (z = Some a) by (inv H; auto).
-  subst.
-  exists (None, Some a, None, None); repeat split; try constructor; auto.
-  destruct b as [b|]. destruct c as [c|]. destruct d as [d|].
-  intros.
-  assert (z=Some b) by (inv H; auto). subst.
-  exists (None, None, Some c, Some d); repeat split; try constructor; auto.
-  inv H0; auto.
-  intros.
-  assert (z = Some b) by (inv H; auto); subst.
-  assert (c=b) by (inv H0; auto); subst.
-  exists (None, None, Some b, None); repeat split; try constructor; auto.
-  intros.
-  assert (z=d) by (clear - H0; inv H0; auto). subst d.
-  assert (z=Some b) by (inv H; auto). subst.
-  exists (None, None, None, Some b); repeat split; try constructor; auto.
-  intros. assert (z=None) by (inv H; auto).
-  subst.
-  exists (None, None, None, None).
-  inv H0; repeat split; constructor.
-
-  intros [a Ha] [b Hb] [c Hc] [d Hd] [z Hz].
-  simpl; intros.
-  unfold Cross_alg in X.
-  destruct (X (fun x => a x) b c d z); auto.
-  destruct x as [[[s p] q] r].
-  decompose [and] y; clear y.
-  assert (Hs : finMap s).
-  destruct Ha.
-  exists x.
-  intros.
-  specialize ( H1 a0).
-  rewrite e in H1; auto. inv H1; auto.
-  assert (Hq : finMap q).
-  destruct Hb.
-  exists x.
-  intros.
-  specialize ( H3 a0). inv H3; auto. rewrite H9; rewrite e; auto.
-  rewrite e in H8; auto. inv H8.
-  assert (Hr : finMap r).
-  destruct Hb.
-  exists x.
-  intros.
-  specialize ( H3 a0).
-  rewrite e in H3; auto. inv H3; auto.
-  assert (Hp : finMap p).
-  destruct Hd.
-  exists x. intros. specialize ( H5 a0). rewrite e in H5; auto. inv H5; auto.
-  exists (exist _ s Hs, exist _ p Hp, exist _ q Hq, exist _ r Hr).
-  simpl; intuition.
-Qed.
-
-Definition opposite_bij {A B} (b: bijection A B) : bijection B A :=
- Bijection _ _ (bij_g _ _ b) (bij_f _ _ b) (bij_gf _ _ b) (bij_fg _ _ b).
-
-Lemma Cross_bij' : forall A B JA JB bij,
-  @Cross_alg B JB ->
-   JB =  (Join_bij A JA B bij) ->
-  @Cross_alg A  JA.
-Proof.
-  repeat intro. subst. unfold join, Join_bij in *.
-  destruct bij. simpl in *.
-  destruct (X (bij_f a) (bij_f b) (bij_f c) (bij_f d) (bij_f z)).
-  red. repeat rewrite bij_gf; auto.
-  red. repeat rewrite bij_gf; auto.
-  destruct x as [[[s p] q] r].
-  exists (bij_g s,bij_g p,bij_g q,bij_g r).
-  unfold join in y.
-  repeat rewrite bij_gf in y.
-  auto.
-Qed.
-
-Definition option_bij {A B} (D: bijection A B) : bijection (option A) (option B).
- apply
- (Bijection (option A) (option B)
-    (fun a => match a with Some a' => Some (bij_f _ _ D a') | None => None end)
-    (fun b => match b with Some b' => Some (bij_g _ _ D b') | None => None end)).
- intros. destruct x; simpl; auto. rewrite bij_fg. auto.
- intros. destruct x; simpl; auto. rewrite bij_gf. auto.
-Defined.
diff --git a/msl/env.v b/msl/env.v
deleted file mode 100644
index 46a13ce2be..0000000000
--- a/msl/env.v
+++ /dev/null
@@ -1,1146 +0,0 @@
-Require Import VST.msl.base.
-Require Import VST.msl.boolean_alg.
-Require Import VST.msl.sepalg.
-Require Import VST.msl.functors.
-Require Import VST.msl.sepalg_functors.
-Require Import VST.msl.sepalg_generators.
-Require Import VST.msl.shares.
-Require Import VST.msl.cross_split.
-Require Import VST.msl.psepalg.
-Require Import VST.msl.pshares.
-Require Import VST.msl.eq_dec.
-
-Require VST.msl.predicates_sa.
-
-Lemma in_app:   (* THIS IS FROM compcert/Coqlib.v *)
-  forall (A: Type) (x: A) (l1 l2: list A), In x (l1 ++ l2) <-> In x l1 \/ In x l2.
-Proof.
-  intros. split; intro. apply in_app_or. auto. apply in_or_app. auto.
-Qed.
-
-Definition list_disjoint {A: Type} (l1 l2: list A) : Prop :=   (* THIS IS FROM compcert/Coqlib.v *)
-  forall (x y: A), In x l1 -> In y l2 -> x <> y.
-
-Inductive pshareval_join' {A}{JA: Join A}
-  : option (pshare * A) ->  option (pshare * A) ->  option (pshare * A) -> Prop :=
-  | pshareval_None1: forall x, pshareval_join' None x x
-  | pshareval_None2: forall x, pshareval_join' x None x
-  | pshareval_Some: forall x y z,
-      join (fst x) (fst y) (fst z) ->
-      join (snd x) (snd y) (snd z) ->
-      pshareval_join' (Some x) (Some y) (Some z).
-
-Lemma pshareval_join_e{A}{JA: Join A}:  forall a b c, join a b c -> pshareval_join' a b c.
-Proof.
-intros.
-inv H; [constructor 1 | constructor 2 | constructor 3]; auto.
-apply H0.
-apply H0.
-Qed.
-
-Lemma pshareval_join_i{A}{JA: Join A}: forall a b c, pshareval_join' a b c -> join a b c.
-Proof.
-intros.
-inv H; [constructor 1 | constructor 2 | constructor 3]; auto.
-split; auto.
-Qed.
-
-Module Type ENV.
-
-Parameter env: forall (key: Type) (A: Type), Type.
-
-Section ENVSEC.
-Context {key: Type}{A: Type}.
-
-#[local] Instance JA: Join A := Join_equiv A. (* It's a feature, not a bug, that this Instance is not visible as an Instance
-   outside the Section *)
-
-Parameter env_get: forall (rho: env key A) (id: key), option (pshare * A).
-Parameter env_set_sh: forall {KE: EqDec key} (id: key) (v: option (pshare * A)) (rho: env key A), env key A.
-
-Definition env_set  {KE: EqDec key} (id: key) (v: A) (rho: env key A) : env key A :=
-     env_set_sh id (Some (pfullshare, v)) rho.
-
-Axiom env_gss: forall {KE: EqDec key}  i a rho, env_get (env_set i a rho) i = Some (pfullshare, a).
-Axiom env_gso: forall {KE: EqDec key}  i j a rho, i <> j -> env_get (env_set j a rho) i = env_get rho i.
-
-Axiom env_gss_sh: forall {KE: EqDec key} i v rho,
-  env_get (env_set_sh i v rho) i = v.
-
-Axiom env_gso_sh: forall {KE: EqDec key} i j v rho, i <> j ->
-   env_get (env_set_sh j v rho) i = env_get rho i.
-
-Definition finite_idfun (f: key -> option (pshare * A)) :=
-  exists l, forall a, ~In a l -> f a = None.
-
-Parameter mk_env:  forall (f: key -> option (pshare * A)), finite_idfun f -> env key A.
-(*
-Arguments mk_env.
-*)
-
-Axiom env_get_mk_env:  forall (f: key -> option (pshare * A)) P, env_get (mk_env f P) = f.
-
-Axiom env_finite: forall rho, finite_idfun (env_get rho).
-
-Axiom env_ext: forall rho1 rho2, env_get rho1 = env_get rho2 -> rho1=rho2.
-
-Axiom env_funct: forall rho1 rho2,
-  rho1 = rho2 -> forall id sh1 sh2 v1 v2, env_get rho1 id = Some(sh1, v1)
-  -> env_get rho2 id = Some(sh2, v2)
-  -> v1 = v2.
-
-Parameter empty_env : env key A.
-
-Axiom env_get_empty: forall id, env_get empty_env id = None.
-
-(* SEPARATION ALGEBRAS *)
-(* We use the Section to hide these instances, because  variables-as-resources clients
-  will want Join_env, but global-variables users will want Join_equiv.
-  Only the variables-as-resources clients should add these instances,
-  which is done in the Module EnvSA,  below
-*)
-#[local] Instance Join_env: Join (env key A) :=
-    fun (rho1 rho2 rho3: env key A) => join (env_get rho1) (env_get rho2) (env_get rho3).
-Parameter Perm_env: forall {PA: Perm_alg A}, Perm_alg (env key A).  #[global] Existing Instance Perm_env.
-
-#[global] Instance Sep_env {SA: Sep_alg A}: FSep_alg (env key A).
- refine (mkSep Join_env (fun _ => empty_env) _ _).
- repeat intro; rewrite env_get_empty; constructor.
- auto.
-Defined.
-
-#[local] Instance Sing_env  {SA: Sep_alg A} : Sing_alg (env key A).
-  refine (mkSing empty_env _). reflexivity.
-Defined.
-
-Parameter Canc_env: forall {PA: Perm_alg A}{CA: Canc_alg A}, Canc_alg (env key A). #[global] Existing Instance Canc_env.
-Parameter Disj_env: forall {PA: Perm_alg A}{DA: Disj_alg A}, Disj_alg (env key A).   #[global] Existing Instance Disj_env.
-Parameter Cross_env : Cross_alg (env key A).  #[global] Existing Instance Cross_env.
-
-
-(* env_mapsto and the lemmas about it are in a Separation Logic, not just a separation algebra.
-  We have two style of separation logic (direct and ageable), and this module Env is usable with
-   either kind.  Thus, we build primitives whose names start with _ to avoid polluting the
-  namespace; then we reveal them at appropriate types in EnvSL and EnvASL, below.
-*)
-Import VST.msl.predicates_sa.
-
-(* ENV_MAPSTO *)
-Parameter _env_mapsto: forall {KE: EqDec key}  (id: key) (sh: Share.t) (v: A), pred (env key A).
-
-Axiom _env_mapsto_exists: forall {KE: EqDec key}  id sh v, exists rho, _env_mapsto id (pshare_sh sh) v rho.
-
-Axiom _env_get_mapsto: forall {KE: EqDec key}  id v rho,
-  (exists sh, env_get rho id = Some (sh,v)) =
-  (exp (fun sh => _env_mapsto id sh v) * TT)%pred rho.
-
-Axiom _env_get_mapsto': forall {KE: EqDec key}  id (sh: pshare) v rho,
-  env_get rho id = Some(pfullshare,v) ->
-       (_env_mapsto id (pshare_sh sh) v * TT)%pred rho.
-
-Axiom _env_mapsto_set: forall {KE: EqDec key} id v,
-  _env_mapsto id Share.top v (env_set id v empty_env).
-
-Axiom _env_mapsto_set_sh: forall {KE: EqDec key} id (sh: pshare) v,
-  _env_mapsto id (pshare_sh sh) v (env_set_sh id (Some (sh, v)) empty_env).
-
-Axiom _env_mapsto_get: forall {KE: EqDec key}  id sh v rho,
-  _env_mapsto id sh v rho
-   -> exists Pf,
-        env_get rho id = Some (exist nonunit sh Pf, v).
-
-Axiom _env_mapsto_get_neq: forall {KE: EqDec key}  (id1 id2: key) (sh: Share.t) (v: A) rho,
-  id1 <> id2 -> _env_mapsto id1 sh v rho -> env_get rho id2 = None.
-
-Axiom _env_mapsto_empty_env: forall {KE: EqDec key}  id v sh, ~(_env_mapsto id sh v empty_env).
-
-Axiom _env_mapsto_splittable: forall {KE: EqDec key}  id v (sh sh1 sh2: pshare) rho,
-  join sh1 sh2 sh
-  -> (_env_mapsto id (pshare_sh sh) v rho
-        <-> (_env_mapsto id (pshare_sh sh1) v * _env_mapsto id (pshare_sh sh2) v)%pred rho).
-End ENVSEC.
-
-End ENV.
-
-Module Env: ENV.
-
-Section ENVSEC.
-Context {key: Type}{A: Type}.
-#[local] Instance JA: Join A := Join_equiv A.
-
-Definition env := fpm key (pshare * A).
-
-Definition env_get (rho: env) (id: key) : option (pshare * A) := lookup_fpm rho id.
-
-Definition env_set_sh {KE: EqDec key} (id: key) (v: option (pshare * A)) (rho: env) : env :=
-  insert'_fpm _ id v rho.
-
-Definition env_set {KE: EqDec key} (id: key) (v: A) (rho: env) : env :=
-  insert_fpm _ id (pfullshare,v) rho.
-
-Lemma env_gss {KE: EqDec key} : forall i a rho, env_get (env_set i a rho) i = Some (pfullshare, a).
-Proof.
-intros.
-apply fpm_gss.
-Qed.
-
-Lemma env_gso {KE: EqDec key}: forall i j a rho, i <> j -> env_get (env_set j a rho) i = env_get rho i.
-Proof.
-intros.
-apply fpm_gso; auto.
-Qed.
-
-Lemma env_gss_sh {KE: EqDec key}: forall i v rho, env_get (env_set_sh i v rho) i = v.
-Proof.
-  intros. unfold env_get, env_set_sh.
-  unfold lookup_fpm, insert'_fpm; simpl. destruct rho as [f Hf]. simpl.
-  destruct (eq_dec i i); auto. contradiction n; auto.
-Qed.
-
-Lemma env_gso_sh {KE: EqDec key} : forall i j v rho, i <> j -> env_get (env_set_sh j v rho) i = env_get rho i.
-Proof.
-  intros. unfold env_get, env_set_sh.
-  unfold lookup_fpm, insert'_fpm; simpl. destruct rho as [f Hf]. simpl.
-  destruct (eq_dec j i); auto.
-  subst; contradiction H; auto.
-Qed.
-
-Definition finite_idfun (f: key -> option (pshare * A)) :=
-          (exists l, forall a, ~In a l -> f a = None).
-
-Definition mk_env_aux: forall f, finite_idfun f -> finMap f.
-Proof.
-intros.
-unfold finMap.
-destruct H as  [l ?].
-exists l.
-intros.
-unfold compose; simpl.
-rewrite H; auto.
-Qed.
-
-Definition mk_env (f: key -> option (pshare * A))  (FIN: finite_idfun f):  env :=
-   exist _ _ (mk_env_aux _ FIN).
-
-Lemma env_get_mk_env: forall (f: key -> option (pshare * A)) P, env_get (mk_env f P) = f.
-Proof.
-intros.
-unfold mk_env, env_get.
-simpl.
-unfold compose.
-extensionality id; auto.
-Qed.
-
-Lemma env_finite: forall rho, finite_idfun (env_get rho).
-intros.
-destruct rho.
-unfold finite_idfun, finMap in *.
-generalize f; intros [l ?].
-exists l; simpl in *.
-intros; unfold compose in *.
-apply e; auto.
-Qed.
-
-Lemma env_ext: forall rho1 rho2, env_get rho1 = env_get rho2 -> rho1=rho2.
-Proof.
-intros.
-destruct rho1; destruct rho2; simpl in *.
-apply exist_ext.
-unfold env_get in *.
-simpl in *.
-extensionality id.
-generalize (equal_f  H id); intro.
-destruct (x id); destruct (x0 id); inv H0; auto.
-Qed.
-
-Lemma env_funct: forall rho1 rho2,
-  rho1 = rho2 -> forall id sh1 sh2 v1 v2, env_get rho1 id = Some(sh1, v1)
-  -> env_get rho2 id = Some(sh2, v2)
-  -> v1 = v2.
-Proof.
-  intros rho1 rho2 H id sh1 sh2 v1 v2 H1 H2.
-  destruct rho1; destruct rho2; unfold env_get in *; simpl in *.
-  inversion H; subst x0. inv H. congruence.
-Qed.
-
-Lemma finite_idfun_empty: finite_idfun (fun _ => None).
-Proof.
-exists nil.
-auto.
-Qed.
-
-Definition empty_env : env := mk_env _ finite_idfun_empty.
-
-Lemma env_get_empty: forall id, env_get empty_env id = None.
-Proof.
-intros.
-unfold empty_env. rewrite env_get_mk_env; auto.
-Qed.
-
-#[local] Instance Join_env: Join env :=
-    fun (rho1 rho2 rho3: env) => join (env_get rho1) (env_get rho2) (env_get rho3).
-
-Lemma Join_env_eq: Join_env = Join_fpm (Join_prod _ Join_pshare _ JA).
-Proof.
-  repeat intro.
- extensionality rho1 rho2 rho3;
-destruct rho1 as [rho1 V1]; destruct rho2 as [rho2 V2]; destruct rho3 as [rho3 V3].
-unfold Join_env, Join_fpm; simpl.
-apply prop_ext; split; intros H id; specialize ( H id);
-unfold env_get in * ; simpl in *; clear - H;
-destruct (rho1 id) as [[[sh1 v1] n1]| ];
-destruct (rho2 id) as [[[sh2 v2] n2]| ];
-destruct (rho3 id) as [[[sh3 v3] n3]| ];
-inv H; simpl in *;  try constructor; auto.
-rewrite (proof_irr v1 v3); constructor.
-rewrite (proof_irr v2 v3); constructor.
-rewrite (proof_irr v1 v3); constructor.
-rewrite (proof_irr v2 v3); constructor.
-Qed.
-
-#[local] Instance Perm_env {PA: Perm_alg A}: @Perm_alg env Join_env.
-Proof.
-  rewrite Join_env_eq. apply Perm_fpm; auto with typeclass_instances.
-Qed.
-
-#[local] Instance Sep_env {SA: Sep_alg A}: @FSep_alg env Join_env.
- refine (mkSep Join_env (fun _ => empty_env) _ _).
- repeat intro; rewrite env_get_empty; constructor.
- auto.
-Defined.
-
-#[local] Instance Sing_env {SA: Sep_alg A}: @Sing_alg env Join_env (fsep_sep Sep_env).
-  refine (mkSing empty_env _). reflexivity.
-Defined.
-
-#[local] Instance Canc_env {PA: Perm_alg A}{CA: Canc_alg A}: @Canc_alg env Join_env.
-Proof.   rewrite Join_env_eq. apply Canc_fpm; auto with typeclass_instances.
-Qed.
-
-#[local] Instance Disj_env {PA: Perm_alg A}{DA: Disj_alg A}: @Disj_alg env Join_env.
-Proof.   rewrite Join_env_eq. apply Disj_fpm; auto with typeclass_instances.
-Qed.
-
-#[local] Instance Cross_env: Cross_alg env.
-Proof.
- rewrite Join_env_eq.
- unfold env.
- pose (bij := @fpm_bij key _ _ (@lift_prod_bij share _ A)).
- pose (J := @Join_fpm key _ (@Join_lift _ (Join_prod share _ _ JA))).
- unfold pshare.
- replace
-  (@Join_fpm key (@lifted Share.t Share.Join_ba * A)
-     (Join_prod (@lifted Share.t Share.Join_ba) Join_pshare A
-        JA))
-  with (Join_bij
-       (fpm key
-          (@lifted (share * A)
-             (Join_prod share Share.Join_ba A JA))) _
-       (fpm key (@lifted share Share.Join_ba * A)) bij).
- apply (Cross_bij _ _ _ bij).
- apply cross_split_fpm; auto with typeclass_instances.
- intros [sh v]. destruct (dec_share_identity sh); [left | right].
- apply identity_unit_equiv in i. apply identity_unit_equiv. split; auto.
- contradict n.
- apply identity_unit_equiv in n. apply identity_unit_equiv. destruct n; auto.
- extensionality x y z.
- unfold J, bij; clear J bij.
- apply forall_ext; intro i.
- unfold finMap; simpl.
- change  (@proj1_sig (key -> option (@lifted Share.t Share.Join_ba * A))
-     (fun f : key -> option (@lifted Share.t Share.Join_ba * A) =>
-      exists l : list key,
-        forall a : key,
-        ~ @In key a l -> f a = @None (@lifted Share.t Share.Join_ba * A)))
-  with (@proj1_sig (key -> option (@lifted share Share.Join_ba * A))
-      (@finMap key (@lifted share Share.Join_ba * A))).
- set  (xi := proj1_sig x i); clearbody xi.
- set (yi:= proj1_sig y i); clearbody yi.
- set (zi:= proj1_sig z i); clearbody zi.
- clear.
- destruct xi; destruct yi; destruct zi;
- apply prop_ext; split; intro; inv H; try constructor.
- destruct p as [[x Hx] x']. destruct p0 as [[y Hy] y']. destruct p1 as [[z Hz] z'].
-  simpl in *. inv H3; simpl in *. split; auto.
- destruct p as [[x Hx] x']. destruct p0 as [[y Hy] y']. destruct p1 as [[z Hz] z'].
-  simpl in *. inv H3; simpl in *. split; auto.
- destruct p as [[x Hx] x']. destruct p0 as [[z Hz] z'].
- simpl in H1. inv H1. apply join_unit2; auto.
- repeat f_equal; apply proof_irr.
- destruct p as [[x Hx] x']. destruct p0 as [[z Hz] z'].
- simpl in H0. inv H0. apply join_unit1; auto.
- repeat f_equal; apply proof_irr.
-Qed.
-
-Import VST.msl.predicates_sa.
-
-Definition _env_mapsto {KE: EqDec key} (id: key) (sh: Share.t) (v: A) : pred env :=
-    fun rho => exists p,
-   forall id', env_get rho id' = if eq_dec id id' then Some (exist _ sh p,v) else None.
-
-Lemma _env_mapsto_exists{KE: EqDec key}: forall id sh v, exists rho, _env_mapsto id (pshare_sh sh) v rho.
-Proof.
-intros.
-assert (finite_idfun (fun id' => if eq_dec id id' then Some (sh, v) else None)).
-exists (id::nil).
-intros.
-simpl in H.
-intuition.
-destruct (eq_dec id a); try contradiction; auto.
-exists (mk_env _ H).
-unfold _env_mapsto.
-destruct sh; simpl in *.
-exists n.
-intros.
-auto.
-Qed.
-
-Lemma _env_get_mapsto {KE: EqDec key}:  forall (id: key) (v: A) (rho: env),
-  (exists sh, env_get rho id = Some (sh,v)) =
-  (exp (fun sh => _env_mapsto id sh v) * TT)%pred rho.
-Proof.
-intros.
-apply prop_ext; split; intros.
-destruct H as [sh ?].
-destruct (_env_mapsto_exists id sh v) as [rho1 ?].
-exists rho1.
-assert (finite_idfun (fun id' => if eq_dec id id' then None else env_get rho id')).
-destruct (env_finite rho) as [l ?].
-exists l.
-intros.
-destruct (eq_dec id a); auto.
-exists (mk_env _ H1).
-split.
-simpl.
-intro x.
-rewrite env_get_mk_env.
-intros.
-destruct H0.
-rename x into id0.
-specialize ( H0 id0).
-destruct (eq_dec id id0).
-subst.
-rewrite H; rewrite H0.
-destruct sh; simpl in *.
-rewrite (proof_irr x0 n); constructor.
-rewrite H0.
-constructor.
-split.
-exists (pshare_sh sh).
-auto.
-auto.
-destruct H as [?w [?w [? [[sh ?] _]]]].
-destruct H0.
-specialize ( H0 id).
-destruct (eq_dec id id); try congruence.
-specialize ( H id).
-rewrite H0 in H.
-inv H.
-econstructor; eauto.
-destruct a2; destruct a3; destruct H4 as [? [? ?]]; simpl in *; subst.
-econstructor; eauto.
-Qed.
-
-Lemma _env_get_mapsto'  {KE: EqDec key}: forall id (sh: pshare) v rho,
-  env_get rho id = Some(pfullshare,v) -> (_env_mapsto id (pshare_sh sh) v * TT)%pred rho.
-Proof.
-intros.
-destruct (top_correct' (pshare_sh sh)) as [sh2 ?].
-assert (finite_idfun (fun i => if eq_dec i id then Some (sh,v) else None)).
-exists (id::nil); intros. simpl in H1.
-assert (id <> a) by intuition.
-destruct (eq_dec a id); auto. contradiction H2; auto.
-destruct (dec_share_identity sh2).
-assert (finite_idfun (fun i => if eq_dec i id then None else env_get rho i)).
-destruct (env_finite rho) as [l ?].
-exists l; intros. destruct (eq_dec a id); auto.
-exists (mk_env _ H1); exists (mk_env _ H2); split; [|split]; auto.
-intro i'.
-do 2 rewrite env_get_mk_env.
-destruct (eq_dec i' id).
-subst. rewrite H.
-apply join_comm in H0.
-apply i in H0.
-destruct sh; simpl in *.
-subst.
-rewrite (proof_irr n top_share_nonunit).
-constructor.
-constructor.
-exists (proj2_sig sh).
-intros.
-rewrite env_get_mk_env.
-destruct (eq_dec id' id).
-subst. destruct (eq_dec id id); try congruence.
-f_equal. f_equal. destruct sh; simpl. auto.
-destruct (eq_dec id' id); try contradiction; auto.
-destruct (eq_dec id id'); try contradiction; auto.
-contradiction n; auto.
-assert (finite_idfun (fun i => if eq_dec i id then Some(mk_lifted sh2 (nonidentity_nonunit n), v) else env_get rho i)).
-destruct (env_finite rho) as [l ?].
-exists l; intros. destruct (eq_dec a id); auto.
-subst.
-specialize ( H2 id H3).
-rewrite H in H2; inv H2.
-exists (mk_env _ H1); exists (mk_env _ H2); split; [|split]; auto.
-intro i'.
-do 2 rewrite env_get_mk_env.
-destruct (eq_dec i' id).
-subst. rewrite H.
-constructor; simpl; auto.
-constructor; simpl; auto.
-apply join_equiv_refl.
-constructor.
-exists (proj2_sig sh).
-intros.
-rewrite env_get_mk_env.
-destruct (eq_dec id' id).
-subst. destruct (eq_dec id id); try contradiction n0; auto.
-f_equal. f_equal. destruct sh; simpl.  auto.
-destruct (eq_dec id id'); auto. contradiction n0; auto.
-Qed.
-
-Lemma _env_mapsto_set{KE: EqDec key}: forall id v,
-  _env_mapsto id Share.top v (env_set id v empty_env).
-Proof.
-  intros id v.
-  exists top_share_nonunit.
-  intros id'.
-  destruct (eq_dec id id') as [Hid|].
-    rewrite <- Hid.
-    rewrite env_gss; auto.
-    rewrite env_gso; auto.
-Qed.
-
-Lemma _env_mapsto_set_sh{KE: EqDec key}: forall id (sh: pshare) v,
-  _env_mapsto id (pshare_sh sh) v (env_set_sh id (Some (sh,v)) empty_env).
-Proof.
-  intros id [sh Pf] v.
-  exists Pf.
-  intros id'.
-  destruct (eq_dec id id') as [Hid|].
-    rewrite <- Hid.
-    rewrite env_gss_sh; auto.
-    rewrite env_gso_sh; auto.
-Qed.
-
-Lemma _env_mapsto_get{KE: EqDec key}: forall id sh v rho,
-  _env_mapsto id sh v rho
-   -> exists Pf: nonunit sh,
-        env_get rho id = Some (exist nonunit sh Pf, v).
-Proof.
-  unfold _env_mapsto, env_get.
-  intros id sh v rho [p H1].
-  specialize ( H1 id); simpl in *.
-  destruct (eq_dec id id); firstorder.
-Qed.
-
-Lemma _env_mapsto_empty_env {KE: EqDec key} : forall id v sh,
-  ~(_env_mapsto id sh v empty_env).
-Proof.
-  unfold not, _env_mapsto.
-  intros ? ? ? [p H].
-  specialize ( H id).
-  destruct (eq_dec id id); auto.
-  inversion H.
-Qed.
-
-Lemma _env_mapsto_get_neq {KE: EqDec key} : forall (id1 id2: key) (sh: Share.t) (v: A) rho,
-  id1 <> id2 -> _env_mapsto id1 sh v rho -> env_get rho id2 = None.
-Proof.
-  unfold _env_mapsto.
-  intros id1 id2 sh v rho Hneq [p H1].
-  specialize ( H1 id2).
-  destruct (eq_dec id1 id2); try contradiction ;auto.
-Qed.
-
-Lemma _env_mapsto_splittable1 {KE: EqDec key}: forall id v (sh sh1 sh2: pshare) rho,
-  join (proj1_sig sh1) (proj1_sig sh2) (proj1_sig sh)
-  -> (_env_mapsto id  (pshare_sh sh1) v * _env_mapsto id (pshare_sh sh2) v)%pred rho
-  -> _env_mapsto id (pshare_sh sh) v rho.
-Proof.
-  intros id v sh sh1 sh2 rho H1 H2.
-  destruct H2 as [rho1 [rho2 [Hrho_join [[Pf1 H_env_mapsto1] [Pf2 H_env_mapsto2]]]]].
-  exists (proj2_sig sh); intro id'.
-  specialize ( H_env_mapsto1 id'); specialize ( H_env_mapsto2 id').
-  generalize Hrho_join; clear Hrho_join; unfold join; simpl; intros Hrho_join.
-  specialize ( Hrho_join id').
-  rewrite H_env_mapsto1 in Hrho_join; rewrite H_env_mapsto2 in Hrho_join.
-  destruct (eq_dec id id').
-
-  (* id = id' *)
-  inversion Hrho_join; simpl in *; subst.
-  destruct a3; destruct H3 as [? [? ?]]; simpl in *; subst.
-  apply (f_equal (fun x => Some(x, a))).
-  apply lifted_eq.
-  eapply join_eq; eauto.
-
-  (* id <> id' *)
-  inversion Hrho_join; auto.
-Qed.
-
-Lemma _env_mapsto_splittable2{KE: EqDec key}: forall id v (sh sh1 sh2: pshare) rho,
-  join (proj1_sig sh1) (proj1_sig sh2) (proj1_sig sh)
-  -> _env_mapsto id (pshare_sh sh) v rho
-  -> (_env_mapsto id (pshare_sh sh1) v * _env_mapsto id (pshare_sh sh2) v)%pred rho.
-Proof.
-  intros id v sh sh1 sh2 rho Hjoin H.
-  destruct H as [? H0].
-  exists (env_set_sh id (Some (sh1,v)) empty_env); exists (env_set_sh id (Some(sh2,v)) empty_env).
-  split.
-
-  intros id'.
-  specialize ( H0 id'); rewrite H0.
-  destruct (eq_dec id id') as [Hid_id'_eq | Hid_id'_neq].
-
-  (* id = id' *)
-  subst id'.
-  do 2 rewrite env_gss_sh. constructor.
-  constructor; auto.
-  apply join_equiv_refl.
-
-  (* id <> id' *)
-  rewrite (env_gso_sh); auto.
-  rewrite (env_gso_sh); auto.
-  rewrite env_get_empty. constructor.
-
-  destruct sh1 as [sh1 n1]; destruct sh2 as [sh2 n2];  unfold _env_mapsto; split.
-  exists n1; reflexivity.
-  exists n2; reflexivity.
-Qed.
-
-Lemma _env_mapsto_splittable {KE: EqDec key}: forall id v (sh sh1 sh2: pshare) rho,
-  join (proj1_sig sh1) (proj1_sig sh2) (proj1_sig sh)
-  -> (_env_mapsto id (pshare_sh sh) v rho
-        <-> (_env_mapsto id (pshare_sh sh1) v * _env_mapsto id (pshare_sh sh2)  v)%pred rho).
-Proof.
-  intros.
-  split; intros.
-  eapply _env_mapsto_splittable2; eauto.
-  eapply _env_mapsto_splittable1; eauto.
-Qed.
-
-End ENVSEC.
-End Env.
-Export Env.
-
-Module EnvSA.
-
-#[global] Existing Instance Join_env.
-#[global] Existing Instance Perm_env.
-#[global] Existing Instance Sep_env.
-#[global] Existing Instance Sing_env.
-#[global] Existing Instance Canc_env.
-#[global] Existing Instance Disj_env.
-#[global] Existing Instance Cross_env.
-
-Lemma empty_env_unit {key: Type}{A: Type}:
-    forall rho: env key A, unit_for empty_env rho.
-Proof.
-intro; intros.
-unfold unit_for.
-intro.
-rewrite env_get_empty.
-constructor.
-Qed.
-
-Lemma empty_env_unit' {key: Type}{A: Type}: forall rho: env key A, join empty_env rho rho.
-Proof.
-intros; apply empty_env_unit.
-Qed.
-#[export] Hint Resolve empty_env_unit empty_env_unit' : core.
-
-Lemma env_join_sub1 {key: Type}{A: Type}:
-  forall rho1 rho2: env key A, (forall id x, env_get rho1 id = Some x -> env_get rho2 id = Some x) ->
-     join_sub rho1 rho2.
-Proof.
-intros.
-pose (JA := Join_equiv A).
-assert (forall i: key, cjoin_sub (env_get rho1 i) (env_get rho2 i)).
-
-intro.
-case_eq (env_get rho1 i); intros.
-specialize (H _ _ H0).
-exists None. rewrite H. constructor.
-econstructor; constructor.
-assert (finite_idfun (fun i => proj1_sig (X i))).
-destruct (env_finite rho2) as [l ?].
-exists l; intros.
-specialize (H0 _ H1).
-generalize (X a); intro.
-destruct c.
-simpl.
-rewrite H0 in j; inv j; auto.
-exists (mk_env _ H0).
-intro i.
-rewrite env_get_mk_env.
-destruct (X i).
-simpl.
-auto.
-Qed.
-
-Lemma env_get_join_sub {key: Type}{A: Type}: forall (rho rho': env key A) id sh v,
-   join_sub rho rho' -> env_get rho id = Some (sh,v) ->
-     exists sh', env_get rho' id = Some (sh', v) /\ join_sub (pshare_sh sh)  (pshare_sh sh').
-Proof.
-intros.
-destruct H.
-specialize ( H id).
-rewrite H0 in H.
-clear H0 rho.
-destruct sh as [sh n].
-destruct (env_get rho' id) as [[[sh' n'] v'] |]; [|inv H].
-revert H;
-destruct (env_get x id) as [[[shx nx] vx] | ]; intro H; inv H.
-simpl in *.
-destruct H3 as [? [? ?]]; simpl in *; subst.
-econstructor; split; eauto. econstructor; eauto.
-econstructor; split; eauto.
-simpl. apply join_sub_refl.
-Qed.
-
-Lemma env_at_joins {key: Type}{A: Type}{KE: EqDec key}:
-  forall rho1 rho2: env key A,
-         (forall id, @joins _ (@Join_lower (pshare * A) (Join_prod pshare Join_pshare A (Join_equiv _))) (env_get rho1 id) (env_get rho2 id)) ->
-               joins rho1 rho2.
-Proof.
-intros.
-unfold joins in H.
-pose (share_of rho id := match @env_get key A rho id with
-                                       | None => Share.bot
-                                       | Some (p,v) => pshare_sh p
-                                       end).
-assert (forall id, joins (share_of rho1 id) (share_of rho2 id)).
-intros.
-destruct (H id) as [x H0].
-clear - H0.
-unfold share_of.
-inv H0.
-apply bot_joins.
-rewrite joins_sym.
-apply bot_joins.
-destruct a1; destruct a2; destruct a3; destruct H2 as [? [? ?]]; simpl in *. subst. eauto.
-pose (h id := proj1_sig (share_joins_constructive _ _ (H0 id))).
-pose (g sh (v: A) := match dec_share_identity sh with
-                         | left _ => None
-                         | right p => Some (mk_lifted _ (nonidentity_nonunit p), v)
-                         end).
-pose (f id := match env_get rho1 id, env_get rho2 id with
-                     | None, shv => shv
-                     | shv, None => shv
-                     | Some (_,v), _ => g (h id) v
-                      end).
-assert (finite_idfun f).
-destruct (env_finite rho1) as [l1 ?].
-destruct (env_finite rho2) as [l2 ?].
-exists (l1++l2).
-intros.
-rewrite in_app in H3.
-destruct (In_dec eq_dec a l1) as [H3' | H3'].
-contradiction H3; auto.
-assert (H4: ~In a l2) by intuition.
-specialize ( H1 a H3'). specialize ( H2 a H4).
-unfold f.
-rewrite H1; rewrite H2; auto.
-exists (mk_env _ H1).
-intro id.
-rewrite env_get_mk_env.
-unfold f; clear H1 f.
-unfold g, h; clear g h.
-destruct (share_joins_constructive (share_of rho1 id) (share_of rho2 id) (H0 id)).
-simpl.
-specialize ( H id). destruct H as [c ?].
-unfold share_of in *; clear share_of.
-specialize ( H0 id).
-destruct (env_get rho1 id) as [[sh1 v1]|];
-destruct (env_get rho2 id) as [[sh2 v2]|];
-try solve [constructor].
-inv H.
-destruct a3; destruct H3 as [? [? ?]].  simpl in H,H1,H2; subst.
-destruct (dec_share_identity x).
-generalize (split_identity _ _ j i); intro.
-exfalso; clear - H1.
-revert H1; apply nonunit_nonidentity.
-apply pshare_nonunit.
-constructor; auto. constructor; auto. simpl. apply join_equiv_refl.
-Qed.
-
-Lemma env_at_join_sub {key: Type}{A: Type}{KE: EqDec key}:
-  forall rho1 rho2, (forall id: key, @join_sub _ (@Join_lower (pshare * A) (Join_prod pshare Join_pshare A (Join_equiv _))) (env_get rho1 id) (env_get rho2 id)) -> join_sub rho1 rho2.
-Proof.
-intros.
-unfold join_sub in H.
-pose (share_of rho id := match @env_get key A rho id with
-                                       | None => Share.bot
-                                       | Some (p,v) => pshare_sh p
-                                       end).
-assert (forall id, join_sub (share_of rho1 id) (share_of rho2 id)).
-intros.
-specialize (H id); destruct H.
-unfold share_of.
-inv H.
-apply bot_correct'.
-apply join_sub_refl.
-destruct a1; destruct a2; destruct a3; destruct H3 as [? [? ?]]; simpl in *. subst.
-econstructor; eauto.
-pose (h id := proj1_sig (share_join_sub_constructive _ _ (H0 id))).
-pose (g sh (v: A) := match dec_share_identity sh with
-                         | left _ => None
-                         | right p => Some (mk_lifted _ (nonidentity_nonunit p), v)
-                         end).
-pose (f id := match env_get rho2 id with
-                     | None => None
-                     | Some (_,v) => g (h id) v
-                      end).
-assert (finite_idfun f).
-destruct (env_finite rho2) as [l2 ?].
-exists l2.
-intros.
-unfold f. rewrite H1; auto.
-exists (mk_env _ H1).
-intro id.
-rewrite env_get_mk_env.
-unfold f; clear H1 f.
-unfold g, h; clear g h.
-destruct (share_join_sub_constructive (share_of rho1 id) (share_of rho2 id) (H0 id)).
-simpl.
-specialize ( H id). destruct H as [c ?].
-unfold share_of in *; clear share_of.
-specialize ( H0 id).
-destruct (env_get rho1 id) as [[sh1 v1]|];
-destruct (env_get rho2 id) as [[sh2 v2]|].
-inv H.
-destruct (dec_share_identity x).
-constructor.
-contradiction n.
-apply unit_identity with (pshare_sh sh2); apply join_comm; auto.
-destruct H4 as [? [? ?]]; simpl snd in *; subst.
-generalize (join_canc (join_comm j) (join_comm H)); intro; subst.
-destruct (dec_share_identity (lifted_obj (fst a2))).
-contradiction (@nonunit_nonidentity _ _ _ _ (lifted_obj (fst a2))).
-destruct (fst a2); simpl; auto.
-destruct a2; simpl in *. destruct p; simpl in *.
-constructor; simpl; auto.
-constructor; auto.
-simpl. apply join_equiv_refl.
-inv H.
-apply bot_identity in j.
-subst.
-destruct (dec_share_identity (pshare_sh sh2)).
-contradiction (@nonunit_nonidentity _ _ _ _ (pshare_sh sh2)).
-apply pshare_nonunit.
-apply join_unit1; auto.
-f_equal. f_equal. unfold mk_lifted; destruct sh2; simpl. f_equal.
-constructor.
-Qed.
-
-
-Lemma identity_empty_env {key: Type}{A: Type}{KE: EqDec key}:  forall rho: env key A, identity rho <-> rho = empty_env.
-Proof.
-intros.
-split; intros.
-generalize (identity_unit (a:=empty_env)H); intro.
-spec H0.
-exists rho; apply join_comm; apply empty_env_unit.
-generalize (empty_env_unit rho); intro.
-unfold unit_for in *.
-generalize (join_eq H0 (join_comm H1)); intro; auto.
-subst.
-simpl.
-apply unit_identity with empty_env; auto.
-Qed.
-
-End EnvSA.
-
-Module EnvSL.
-Import EnvSA.
-Import VST.msl.predicates_sa.
-
-Definition env_mapsto: forall {key A}{KE: EqDec key} (id: key) (sh: Share.t) (v: A) , pred (env key A) := @_env_mapsto.
-Arguments env_mapsto [key] [A] [KE] _ _ _ _.
-
-Lemma env_mapsto_exists{key A}{KE: EqDec key}: forall id sh (v: A), exists rho, _env_mapsto id (pshare_sh sh) v rho.
-Proof. apply _env_mapsto_exists. Qed.
-
-Lemma env_get_mapsto {key A}{KE: EqDec key}:  forall (id: key) (v: A) (rho: env _ _),
-  (exists sh, env_get rho id = Some (sh,v)) =
-  (exp (fun sh => _env_mapsto id sh v) * TT)%pred rho.
-Proof. apply _env_get_mapsto. Qed.
-
-Lemma env_get_mapsto'  {key A}{KE: EqDec key}: forall id (sh: pshare) (v: A) rho,
-  env_get rho id = Some(pfullshare,v) -> (_env_mapsto id (pshare_sh sh) v * TT)%pred rho.
-Proof. apply _env_get_mapsto'. Qed.
-
-Lemma env_mapsto_set {key A}{KE: EqDec key}: forall id (v: A),
-    env_mapsto id Share.top v (env_set id v empty_env).
-Proof. apply _env_mapsto_set. Qed.
-
-Lemma env_mapsto_set_sh{key A}{KE: EqDec key}: forall id (sh: pshare) (v: A),
-  _env_mapsto id (pshare_sh sh) v (env_set_sh id (Some (sh,v)) empty_env).
-Proof. apply _env_mapsto_set_sh. Qed.
-
-Lemma env_mapsto_get{key A}{KE: EqDec key}: forall id sh (v:A) rho,
-  env_mapsto id sh v rho
-   -> exists Pf: nonunit sh,
-        env_get rho id = Some (exist nonunit sh Pf, v).
-Proof. apply _env_mapsto_get. Qed.
-
-Lemma env_mapsto_empty_env {key A}{KE: EqDec key} : forall id (v:A) sh,
-  ~(env_mapsto id sh v empty_env).
-  Proof. apply _env_mapsto_empty_env. Qed.
-
-Lemma env_mapsto_get_neq {key A}{KE: EqDec key} : forall (id1 id2: key) (sh: Share.t) (v: A) rho,
-  id1 <> id2 -> env_mapsto id1 sh v rho -> env_get rho id2 = None.
-Proof. apply _env_mapsto_get_neq. Qed.
-
-Lemma env_mapsto_splittable {key A}{KE: EqDec key}: forall id (v:A) (sh sh1 sh2: pshare) rho,
-  join (proj1_sig sh1) (proj1_sig sh2) (proj1_sig sh)
-  -> (_env_mapsto id (pshare_sh sh) v rho
-        <-> (_env_mapsto id (pshare_sh sh1) v * _env_mapsto id (pshare_sh sh2)  v)%pred rho).
-Proof. apply _env_mapsto_splittable. Qed.
-
-Lemma env_mapsto_positive{key: Type}{A: Type}{KE: EqDec key}: forall id sh (v: A) rho,
-  env_mapsto id sh v rho -> nonidentity sh.
-Proof.
-  intros until rho.
-  intro H; apply env_mapsto_get in H; destruct H.
-  auto.
-  apply nonunit_nonidentity; auto.
-Qed.
-
-Lemma emp_empty_env {key: Type}{A: Type}:  forall rho: env key A, emp rho <-> rho = empty_env.
-Proof.
-intros.
-split; intros.
-generalize (identity_unit (a:=empty_env)H); intro.
-spec H0.
-exists rho; apply join_comm; apply empty_env_unit.
-generalize (empty_env_unit rho); intro.
-unfold unit_for in *.
-generalize (join_eq H0 (join_comm H1)); intro; auto.
-subst.
-simpl.
-apply unit_identity with empty_env; auto.
-Qed.
-
-Lemma emp_empty_env' {key}{A}: emp (@empty_env key A).
-Proof.
-rewrite emp_empty_env.
-auto.
-Qed.
-#[export] Hint Resolve emp_empty_env' : core.
-
-Lemma env_mapsto_cohere{key: Type}{A: Type}{KE: EqDec key}: forall id sh1 (v1: A) sh2 v2,
-  (env_mapsto id sh1 v1 * TT) && (env_mapsto id sh2 v2 * TT)
-    |-- !!(v1=v2).
-Proof.
-  intros.
-  intros w [? ?].
-  unfold prop.
-  destruct H as [?w [?w [? [? _]]]].
-  destruct H0 as [?w [?w [? [? _]]]].
-  apply env_mapsto_get in H1; destruct H1.
-  apply env_mapsto_get in H2; destruct H2.
-  destruct (env_get_join_sub _ _ _ _ _ (join_join_sub H) H1) as [sh' [? ?]].
-  destruct (env_get_join_sub _ _ _ _ _ (join_join_sub H0) H2) as [sh'' [? ?]].
-  congruence.
-Qed.
-
-Lemma env_mapsto_precise{key: Type}{A: Type}{KE: EqDec key}: forall id sh (v:A), precise (env_mapsto id sh v).
-Proof.
-  intros; intro; intros.
-  apply env_ext.
-  extensionality id'.
-  destruct (eq_dec id id'); auto; subst.
-    apply env_mapsto_get in H; destruct H.
-    apply env_mapsto_get in H0; destruct H0.
-    rewrite H; rewrite H0.
-    repeat f_equal; auto.
-
-    eapply env_mapsto_get_neq in H; eauto.
-    eapply env_mapsto_get_neq in H0; eauto.
-    rewrite H; rewrite H0; auto.
-Qed.
-
-Definition own_var {key: Type}{A: Type}{KE: EqDec key} (sh: pshare) (id: key) : pred (env key A) :=
-  exp (env_mapsto id (pshare_sh sh)).
-
-Definition see_var {key: Type}{A: Type}{KE: EqDec key} (id: key) : pred (env key A) :=
-  exp (fun sh: pshare => own_var sh id).
-
-Definition own_all {key: Type}{A: Type}{KE: EqDec key} (l: list key) : pred (env key A) :=
-   list_sepcon (map (own_var pfullshare) l).
-
-Lemma own_all_nil {key: Type}{A: Type}{KE: EqDec key} : own_all nil = (emp: pred (env key A)).
-Proof. unfold own_all; simpl; auto. Qed.
-
-Opaque env_mapsto.
-End EnvSL.
-
-
-
-Definition restrict_env' {key: Type}{A: Type}{KE: EqDec key} (ids: list key) (rho: env key A) (id: key) : option (pshare * A) :=
-  if  In_dec eq_dec id ids
-                      then env_get rho id
-                      else None.
-
-Lemma restrict_env'_finite {key: Type}{A: Type}{KE: EqDec key} : forall ids (rho: env key A), finite_idfun (restrict_env' ids rho).
-Proof.
-unfold finite_idfun, restrict_env'; intros.
-exists ids.
-intros.
-destruct (in_dec eq_dec a ids); try contradiction; auto.
-Qed.
-
-Definition restrict_env {key: Type}{A: Type}{KE: EqDec key} (ids: list key) (rho:env key A) : env key A :=
-  mk_env _ (restrict_env'_finite ids rho).
-
-Definition restrict_env_comp' {key: Type}{A: Type}{KE: EqDec key} (ids: list key) (rho: env key A) (id: key) : option (pshare * A) :=
-  if  In_dec eq_dec id ids
-                      then None
-                      else env_get rho id.
-
-Lemma restrict_env_comp'_finite {key: Type}{A: Type}{KE: EqDec key}:
-    forall ids (rho: env key A), finite_idfun (restrict_env_comp' ids rho).
-Proof.
-unfold finite_idfun, restrict_env_comp'; intros.
-destruct (env_finite rho) as [l ?].
-exists l.
-intros.
-destruct (in_dec eq_dec a ids); try contradiction; auto.
-Qed.
-
-Definition restrict_env_comp  {key: Type}{A: Type}{KE: EqDec key} (ids: list key) (rho:env key A) : env key A:=
-  mk_env _ (restrict_env_comp'_finite ids rho).
-
-Lemma restrict_env_nil  {key: Type}{A: Type}{KE: EqDec key}:
-  forall ge, restrict_env nil ge = (empty_env: env key A).
-Proof.
-intros.
-apply env_ext. extensionality id.
-unfold restrict_env; rewrite env_get_mk_env; unfold restrict_env'; simpl.
-rewrite env_get_empty.
-auto.
-Qed.
-
-Lemma restrict_env_app  {key: Type}{A: Type}{KE: EqDec key} :
-  forall ids1 ids2 (rho: env key A),  list_disjoint ids1 ids2 ->
-    join (restrict_env ids1 rho) (restrict_env ids2 rho) (restrict_env (ids1++ids2) rho).
-Proof.
-intros.
-intro id.
-unfold restrict_env; simpl.
-repeat rewrite env_get_mk_env.
-unfold restrict_env'.
-unfold list_disjoint in H.
-specialize ( H id id).
-destruct (in_dec eq_dec id ids1).
-destruct (in_dec eq_dec id ids2).
-contradiction H; auto.
-destruct (in_dec eq_dec id (ids1++ids2)).
-constructor.
-contradiction n0;
-rewrite in_app; auto.
-destruct (in_dec eq_dec id ids2).
-destruct (in_dec eq_dec id (ids1++ids2)).
-constructor.
-contradiction n0;
-rewrite in_app; auto.
-destruct (in_dec eq_dec id (ids1++ids2)).
-rewrite in_app in i; intuition.
-constructor.
-Qed.
-
-Lemma restrict_env_comp_join {key: Type}{A: Type}{KE: EqDec key}:
-  forall ids (ge: env key A), join (restrict_env ids ge) (restrict_env_comp ids ge) ge.
-Proof.
-intros.
-intro id.
-unfold restrict_env, restrict_env_comp.
-repeat rewrite env_get_mk_env.
-unfold restrict_env', restrict_env_comp'.
-destruct (in_dec eq_dec id ids); constructor.
-Qed.
-
-Lemma restrict_env_rev {key: Type}{A: Type}{KE: EqDec key}:
-    forall ids, @restrict_env key A _ (rev ids) = restrict_env ids.
-Proof.
-intros.
-extensionality w.
-unfold restrict_env.
-apply env_ext; extensionality id.
-repeat rewrite env_get_mk_env.
-unfold restrict_env'.
-destruct (in_dec eq_dec id (rev ids));
-destruct (in_dec eq_dec id ids); auto.
-rewrite <- In_rev in i; contradiction.
-rewrite In_rev in i; contradiction.
-Qed.
-
-
-#[global] Instance Trip_pshareval {B} : @Trip_alg (option (pshare * B)) (Join_lower (Join_prod _ _ _ (Join_equiv B))).
-Proof.
-intro; intros.
-apply pshareval_join_e in H.
-apply pshareval_join_e in H0.
-apply pshareval_join_e in H1.
-destruct a as [[[sa pa] va]|];
-destruct b as [[[sb pb] vb]|];
-destruct ab as [[[sab pab] vab]|]; try solve [exfalso; inv H];
-destruct c as [[[sc pc] vc]|];
-destruct bc as [[[sbc pbc] vbc]|]; try solve [exfalso; inv H0];
-destruct ac as [[[sac pac] vac]|]; try solve [exfalso; inv H1];
-simpl in *;
-try (assert (Hx: join sa sb sab /\ va = vb /\ vb = vab)
-     by (inv H; simpl in *; intuition;
-            match goal with H: @join B _ _ _ _ |- _ => destruct H end;
-             congruence);
-    decompose [and] Hx; clear H Hx; subst vab);
-try (assert (Hx: join sb sc sbc /\ vb = vc /\ vb = vbc)
-    by (inv H0; simpl in *; intuition;
-            match goal with H: @join B _ _ _ _ |- _ => destruct H end;
-             congruence);
-    decompose [and] Hx; clear H0 Hx; subst vbc);
-try (assert (Hx: join sa sc sac /\ va = vc /\ va = vac)
-    by (inv H1; simpl in *; intuition;
-            match goal with H: @join B _ _ _ _ |- _ => destruct H end;
-             congruence);
-    decompose [and] Hx; clear H1 Hx; subst vac);
-subst; subst;
-try solve [econstructor; constructor].
-destruct (triple_join_exists_share _ _ _ _ _ _ H2 H H0) as [sabc ?].
-assert (nonidentity sabc). eapply join_nonidentity. apply nonunit_nonidentity; apply pab. eauto.
-exists (Some (mk_lifted _ (nonidentity_nonunit H1), vc)).
-constructor; split; simpl; auto.
-exists (Some (mk_lifted _ pac, vbc)); econstructor; simpl; auto.
-inv H0. inv H. constructor; auto.
-exists (Some (mk_lifted _ pbc, vac)); inv H1; inv H; constructor; simpl; auto.
-constructor; auto.
-Qed.
-
-#[global] Instance Trip_env {A} {EA: EqDec A} {B} {JB: Join B}: Trip_alg (env A B).
-Proof.
-intro; intros.
-pose (f id := Trip_pshareval _ _ _ _ _ _ (H id) (H0 id) (H1 id)).
-assert (finite_idfun (fun id => proj1_sig (f id))).
-destruct (env_finite ab) as [l1 H3].
-destruct (env_finite c) as [l2 H4].
-exists (l1++l2).
-intro id; specialize ( H3 id); specialize ( H4 id).
-intro.
-assert (~ (In id l1 \/ In id l2)).
-contradict H2.
-rewrite in_app. auto.
-clear H2.
-destruct (In_dec eq_dec id l1) as [H5' | H5'].
-contradiction H5; auto.
-assert (H6: ~In id l2) by intuition.
-destruct (f id).
-simpl.
-apply pshareval_join_e in j.
-rewrite H3 in j; rewrite H4 in j; inv j; auto.
-exists (mk_env (fun id => proj1_sig (f id)) H2).
-intro id.
-rewrite env_get_mk_env.
-destruct (f id); simpl.
-auto.
-Qed.
diff --git a/msl/functors.v b/msl/functors.v
deleted file mode 100644
index 7bbe1593af..0000000000
--- a/msl/functors.v
+++ /dev/null
@@ -1,591 +0,0 @@
-(*
- * Copyright (c) 2009-2011, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-
-Require Import VST.msl.base.
-
-Set Implicit Arguments.
-
-Module CovariantFunctor.
-
-Record functorFacts (PS : Type -> Type)
-  (fmap : forall A B (f : A -> B), PS A -> PS B) : Type :=
-FunctorFacts {
-  ff_id : forall A, fmap _ _ (id A) = id (PS A);
-  ff_comp : forall A B C (f : B -> C) (g : A -> B),
-fmap _ _ f oo fmap _ _ g = fmap _ _ (f oo g)
-}.
-
-Record functor : Type := Functor {
-  _functor: Type -> Type;
-  fmap : forall A B (f : A -> B), _functor A -> _functor B;
-  functor_facts : functorFacts _functor fmap
-}.
-
-End CovariantFunctor.
-
-Module ContraVariantFunctor.
-
-Record functorFacts (PS : Type -> Type)
-  (fmap : forall A B (f : B -> A), PS A -> PS B) : Type :=
-FunctorFacts {
-  ff_id : forall A, fmap _ _ (id A) = id (PS A);
-  ff_comp : forall A B C (f : C -> B) (g : B -> A),
-fmap _ _ f oo fmap _ _ g = fmap _ _ (g oo f)
-}.
-
-Record functor : Type := Functor {
-  _functor: Type -> Type;
-  fmap : forall A B (f : B -> A), _functor A -> _functor B;
-  functor_facts : functorFacts _functor fmap
-}.
-
-End ContraVariantFunctor.
-
-Module MixVariantFunctor.
-
-Record functorFacts (PS : Type -> Type)
- (fmap : forall A B (f1 : A -> B) (f2 : B -> A), PS A -> PS B) : Type :=
-FunctorFacts {
-  ff_id : forall A, fmap _ _ (id A) (id A) = id (PS A);
-  ff_comp : forall A B C (f1 : B -> C) (f2 : C -> B) (g1 : A -> B)
-(g2 : B -> A), fmap _ _ f1 f2 oo fmap _ _ g1 g2 = fmap _ _ (f1 oo g1) (g2 oo f2)
-}.
-
-Record functor : Type := Functor {
-  _functor: Type -> Type;
-  fmap : forall A B (f1 : A -> B) (f2 : B -> A), _functor A -> _functor B;
-  functor_facts : functorFacts _functor fmap
-}.
-
-End MixVariantFunctor.
-
-Module CovariantBiFunctor.
-
-Record functorFacts (PS : Type -> Type -> Type)
- (fmap : forall A1 B1 A2 B2 (f1 : A1 -> B1) (f2 : A2 -> B2),
-    PS A1 A2 -> PS B1 B2) : Type :=
-FunctorFacts {
-  ff_id : forall A1 A2, fmap _ _ _ _ (id A1) (id A2) = id (PS A1 A2);
-  ff_comp : forall A1 A2 B1 B2 C1 C2 (f1 : B1 -> C1) (f2 : B2 -> C2)
-(g1 : A1 -> B1) (g2 : A2 -> B2),
-  fmap _ _ _ _ f1 f2 oo fmap _ _ _ _ g1 g2 = fmap _ _ _ _ (f1 oo g1) (f2 oo g2)
-}.
-
-Record functor : Type := Functor {
-  _functor: Type -> Type -> Type;
-  fmap : forall A1 B1 A2 B2 (f1 : A1 -> B1) (f2 : A2 -> B2),
-    _functor A1 A2 -> _functor B1 B2;
-  functor_facts : functorFacts _functor fmap
-}.
-
-End CovariantBiFunctor.
-
-Module CoContraVariantBiFunctor.
-
-Record functorFacts (PS : Type -> Type -> Type)
- (fmap : forall A1 B1 A2 B2 (f1 : A1 -> B1) (f2 : B2 -> A2),
-    PS A1 A2 -> PS B1 B2) : Type :=
-FunctorFacts {
-  ff_id : forall A1 A2, fmap _ _ _ _ (id A1) (id A2) = id (PS A1 A2);
-  ff_comp : forall A1 A2 B1 B2 C1 C2 (f1 : B1 -> C1) (f2 : C2 -> B2)
-(g1 : A1 -> B1) (g2 : B2 -> A2),
-  fmap _ _ _ _ f1 f2 oo fmap _ _ _ _ g1 g2 = fmap _ _ _ _ (f1 oo g1) (g2 oo f2)
-}.
-
-Record functor : Type := Functor {
-  _functor: Type -> Type -> Type;
-  fmap : forall A1 B1 A2 B2 (f1 : A1 -> B1) (f2 : B2 -> A2),
-    _functor A1 A2 -> _functor B1 B2;
-  functor_facts : functorFacts _functor fmap
-}.
-
-End CoContraVariantBiFunctor.
-
-Coercion CovariantFunctor._functor:
-  CovariantFunctor.functor >-> Funclass.
-Coercion ContraVariantFunctor._functor:
-  ContraVariantFunctor.functor >-> Funclass.
-Coercion MixVariantFunctor._functor:
-  MixVariantFunctor.functor >-> Funclass.
-Coercion CovariantBiFunctor._functor:
-  CovariantBiFunctor.functor >-> Funclass.
-Coercion CoContraVariantBiFunctor._functor:
-  CoContraVariantBiFunctor.functor >-> Funclass.
-
-Module CovariantFunctorLemmas.
-
-Import CovariantFunctor.
-
-Lemma fmap_id {F: functor} : forall A, fmap F (id A) = id (F A).
-Proof. intros. destruct F as [F FM [ff_id ?]]; simpl. apply ff_id. Qed.
-
-Lemma fmap_comp {F: functor} : forall A B C (f : B -> C) (g : A -> B),
-  fmap F f oo fmap F g = fmap F (f oo g).
-Proof. intros. destruct F as [F FM [? ff_comp]]; simpl. apply ff_comp. Qed.
-
-Lemma fmap_app {F: functor} : forall A B C (f : B -> C) (g : A -> B) x,
-  fmap F f (fmap F g x) = fmap F (f oo g) x.
-Proof. intros. rewrite <- fmap_comp; auto. Qed.
-
-End CovariantFunctorLemmas.
-
-Module ContraVariantFunctorLemmas.
-
-Import ContraVariantFunctor.
-
-Lemma fmap_id {F: functor} : forall A, fmap F (id A) = id (F A).
-Proof. intros. destruct F as [F FM [ff_id ?]]; simpl. apply ff_id. Qed.
-
-Lemma fmap_comp {F: functor} : forall A B C (f : C -> B) (g : B -> A),
-  fmap F f oo fmap F g = fmap F (g oo f).
-Proof. intros. destruct F as [F FM [? ff_comp]]; simpl. apply ff_comp. Qed.
-
-Lemma fmap_app {F: functor} : forall A B C (f : C -> B) (g : B -> A) x,
-  fmap F f (fmap F g x) = fmap F (g oo f) x.
-Proof. intros. rewrite <- fmap_comp; auto. Qed.
-
-End ContraVariantFunctorLemmas.
-
-Module MixVariantFunctorLemmas.
-
-Import MixVariantFunctor.
-
-Lemma fmap_id {F: functor} : forall A, fmap F (id A) (id A) = id (F A).
-Proof. intros. destruct F as [F FM [ff_id ?]]; simpl. apply ff_id. Qed.
-
-Lemma fmap_comp {F: functor} : forall A B C (f1 : B -> C) (f2: C -> B)
-(g1 : A -> B) (g2: B -> A),
-  fmap F f1 f2 oo fmap F g1 g2 = fmap F (f1 oo g1) (g2 oo f2).
-Proof. intros. destruct F as [F FM [? ff_comp]]; simpl. apply ff_comp. Qed.
-
-Lemma fmap_app {F: functor} : forall A B C (f1 : B -> C) (f2: C -> B)
-(g1 : A -> B) (g2: B -> A) x,
-  fmap F f1 f2 (fmap F g1 g2 x) = fmap F (f1 oo g1) (g2 oo f2) x.
-Proof. intros. rewrite <- fmap_comp; auto. Qed.
-
-End MixVariantFunctorLemmas.
-
-Module CovariantBiFunctorLemmas.
-
-Import CovariantBiFunctor.
-
-Lemma fmap_id {F: functor} : forall A1 A2, fmap F (id A1) (id A2) = id (F A1 A2).
-Proof. intros. destruct F as [F FM [ff_id ?]]; simpl. apply ff_id. Qed.
-
-Lemma fmap_comp {F: functor} : forall A1 A2 B1 B2 C1 C2 (f1 : B1 -> C1)
-(f2: B2 -> C2) (g1 : A1 -> B1) (g2: A2 -> B2),
-  fmap F f1 f2 oo fmap F g1 g2 = fmap F (f1 oo g1) (f2 oo g2).
-Proof. intros. destruct F as [F FM [? ff_comp]]; simpl. apply ff_comp. Qed.
-
-Lemma fmap_app {F: functor} : forall A1 A2 B1 B2 C1 C2 (f1 : B1 -> C1)
-(f2: B2 -> C2) (g1 : A1 -> B1) (g2: A2 -> B2) x,
-  fmap F f1 f2 (fmap F g1 g2 x) = fmap F (f1 oo g1) (f2 oo g2) x.
-Proof. intros. rewrite <- fmap_comp; auto. Qed.
-
-End CovariantBiFunctorLemmas.
-
-Module CoContraVariantBiFunctorLemmas.
-
-Import CoContraVariantBiFunctor.
-
-Lemma fmap_id {F: functor} : forall A1 A2, fmap F (id A1) (id A2) = id (F A1 A2).
-Proof. intros. destruct F as [F FM [ff_id ?]]; simpl. apply ff_id. Qed.
-
-Lemma fmap_comp {F: functor} : forall A1 A2 B1 B2 C1 C2 (f1 : B1 -> C1)
-(f2: C2 -> B2) (g1 : A1 -> B1) (g2: B2 -> A2),
-  fmap F f1 f2 oo fmap F g1 g2 = fmap F (f1 oo g1) (g2 oo f2).
-Proof. intros. destruct F as [F FM [? ff_comp]]; simpl. apply ff_comp. Qed.
-
-Lemma fmap_app {F: functor} : forall A1 A2 B1 B2 C1 C2 (f1 : B1 -> C1)
-(f2: C2 -> B2) (g1 : A1 -> B1) (g2: B2 -> A2) x,
-  fmap F f1 f2 (fmap F g1 g2 x) = fmap F (f1 oo g1) (g2 oo f2) x.
-Proof. intros. rewrite <- fmap_comp; auto. Qed.
-
-End CoContraVariantBiFunctorLemmas.
-
-Module GeneralFunctorGenerator.
-
-Lemma CovariantFunctor_MixVariantFunctorFacts (F: CovariantFunctor.functor) :
-  MixVariantFunctor.functorFacts (fun T : Type => F T)
-  (fun (A B : Type) (f : A -> B) (_ : B -> A) => CovariantFunctor.fmap F f).
-Proof.
-  constructor; intros; simpl.
-  + apply CovariantFunctor.ff_id, CovariantFunctor.functor_facts.
-  + apply CovariantFunctor.ff_comp, CovariantFunctor.functor_facts.
-Qed.
-
-Definition CovariantFunctor_MixVariantFunctor (F: CovariantFunctor.functor) :=
-  MixVariantFunctor.Functor (CovariantFunctor_MixVariantFunctorFacts F).
-
-Lemma ContraVariantFunctor_MixVariantFunctorFacts
-  (F: ContraVariantFunctor.functor):
-  MixVariantFunctor.functorFacts (fun T : Type => F T)
-  (fun (A B : Type) (_ : A -> B) (f : B -> A) => ContraVariantFunctor.fmap F f).
-Proof.
-  constructor; intros; simpl.
-  + apply ContraVariantFunctor.ff_id, ContraVariantFunctor.functor_facts.
-  + apply ContraVariantFunctor.ff_comp, ContraVariantFunctor.functor_facts.
-Qed.
-
-Definition ContraVariantFunctor_MixVariantFunctor (F: ContraVariantFunctor.functor) :=
-  MixVariantFunctor.Functor (ContraVariantFunctor_MixVariantFunctorFacts F).
-
-Lemma CovariantFunctor_CoContraVariantBiFunctorFacts
-  (F: CovariantFunctor.functor):
-  CoContraVariantBiFunctor.functorFacts (fun T1 T2 : Type => F T1)
-  (fun (A B C D : Type) (f : A -> B) (_ : D -> C) => CovariantFunctor.fmap F f).
-Proof.
-  constructor; intros; simpl.
-  + apply CovariantFunctor.ff_id, CovariantFunctor.functor_facts.
-  + apply CovariantFunctor.ff_comp, CovariantFunctor.functor_facts.
-Qed.
-
-Definition CovariantFunctor_CoContraVariantBiFunctor (F: CovariantFunctor.functor) :=
-  CoContraVariantBiFunctor.Functor (CovariantFunctor_CoContraVariantBiFunctorFacts F).
-
-Lemma CoContraVariantBiFunctor_MixVariantFunctorFacts
-  (F: CoContraVariantBiFunctor.functor):
-  MixVariantFunctor.functorFacts (fun T : Type => F T T)
-  (fun (A B : Type) (f : A -> B) (g : B -> A) => CoContraVariantBiFunctor.fmap F f g).
-Proof.
-  constructor; intros; simpl.
-  + apply CoContraVariantBiFunctor.ff_id,
-          CoContraVariantBiFunctor.functor_facts.
-  + apply CoContraVariantBiFunctor.ff_comp,
-          CoContraVariantBiFunctor.functor_facts.
-Qed.
-
-Definition CoContraVariantBiFunctor_MixVariantFunctor (F: CoContraVariantBiFunctor.functor) :=
-  MixVariantFunctor.Functor (CoContraVariantBiFunctor_MixVariantFunctorFacts F).
-
-Lemma CovariantFunctor_CovariantFunctor_composeFacts
-  (F1 F2: CovariantFunctor.functor):
-  CovariantFunctor.functorFacts (fun T : Type => F1 (F2 T))
-  (fun (A B : Type) (f : A -> B) => CovariantFunctor.fmap F1 (CovariantFunctor.fmap F2 f)).
-Proof.
-  constructor; intros; simpl.
-  + rewrite !CovariantFunctorLemmas.fmap_id; auto.
-  + rewrite !CovariantFunctorLemmas.fmap_comp; auto.
-Qed.
-
-Definition CovariantFunctor_CovariantFunctor_compose (F1 F2: CovariantFunctor.functor) :=
-  CovariantFunctor.Functor (CovariantFunctor_CovariantFunctor_composeFacts F1 F2).
-
-Lemma CovariantFunctor_MixVariantFunctor_composeFacts
-  (F1: CovariantFunctor.functor) (F2: MixVariantFunctor.functor):
-  MixVariantFunctor.functorFacts (fun T : Type => F1 (F2 T))
-  (fun (A B : Type) (f : A -> B) (g : B -> A) =>
-   CovariantFunctor.fmap F1 (MixVariantFunctor.fmap F2 f g)).
-Proof.
-  constructor; intros; simpl.
-  + rewrite MixVariantFunctorLemmas.fmap_id, CovariantFunctorLemmas.fmap_id; auto.
-  + rewrite !CovariantFunctorLemmas.fmap_comp, MixVariantFunctorLemmas.fmap_comp; auto.
-Qed.
-
-Definition CovariantFunctor_MixVariantFunctor_compose (F1: CovariantFunctor.functor) (F2: MixVariantFunctor.functor) :=
-  MixVariantFunctor.Functor (CovariantFunctor_MixVariantFunctor_composeFacts F1 F2).
-
-Lemma CovariantBiFunctor_CovariantFunctor_composeFacts
-  (F: CovariantBiFunctor.functor)
-  (F1 F2: CovariantFunctor.functor):
-  CovariantFunctor.functorFacts (fun T : Type => F (F1 T) (F2 T))
-    (fun (A B : Type) (f : A -> B) =>
-     CovariantBiFunctor.fmap F (CovariantFunctor.fmap F1 f) (CovariantFunctor.fmap F2 f)).
-Proof.
-  constructor; intros; simpl.
-  + rewrite !CovariantFunctorLemmas.fmap_id, CovariantBiFunctorLemmas.fmap_id; auto.
-  + rewrite CovariantBiFunctorLemmas.fmap_comp, !CovariantFunctorLemmas.fmap_comp; auto.
-Qed.
-
-Definition CovariantBiFunctor_CovariantFunctor_compose
-  (F: CovariantBiFunctor.functor)
-  (F1 F2: CovariantFunctor.functor) :=
-  CovariantFunctor.Functor (CovariantBiFunctor_CovariantFunctor_composeFacts F F1 F2).
-
-Lemma CovariantBiFunctor_MixVariantFunctor_composeFacts
-  (F: CovariantBiFunctor.functor)
-  (F1 F2: MixVariantFunctor.functor):
-  MixVariantFunctor.functorFacts (fun T : Type => F (F1 T) (F2 T))
-    (fun (A B : Type) (f : A -> B) (g : B -> A) =>
-     CovariantBiFunctor.fmap F (MixVariantFunctor.fmap F1 f g) (MixVariantFunctor.fmap F2 f g)).
-Proof.
-  constructor; intros; simpl.
-  + rewrite !MixVariantFunctorLemmas.fmap_id, CovariantBiFunctorLemmas.fmap_id; auto.
-  + rewrite CovariantBiFunctorLemmas.fmap_comp, !MixVariantFunctorLemmas.fmap_comp; auto.
-Qed.
-
-Definition CovariantBiFunctor_MixVariantFunctor_compose
-  (F: CovariantBiFunctor.functor)
-  (F1 F2: MixVariantFunctor.functor):=
-  MixVariantFunctor.Functor (CovariantBiFunctor_MixVariantFunctor_composeFacts F F1 F2).
-
-Lemma CoContraVariantBiFunctor_CoContraVariantFunctor_composeFacts
-  (F: CoContraVariantBiFunctor.functor)
-  (F1: CovariantFunctor.functor)
-  (F2: ContraVariantFunctor.functor):
-  CovariantFunctor.functorFacts (fun T : Type => F (F1 T) (F2 T))
-    (fun (A B : Type) (f : A -> B) =>
-     CoContraVariantBiFunctor.fmap F (CovariantFunctor.fmap F1 f)
-       (ContraVariantFunctor.fmap F2 f)).
-Proof.
-  constructor; intros; simpl.
-  + rewrite CovariantFunctorLemmas.fmap_id, ContraVariantFunctorLemmas.fmap_id, CoContraVariantBiFunctorLemmas.fmap_id; auto.
-  + rewrite CoContraVariantBiFunctorLemmas.fmap_comp, CovariantFunctorLemmas.fmap_comp, ContraVariantFunctorLemmas.fmap_comp; auto.
-Qed.
-
-Definition CoContraVariantBiFunctor_CoContraVariantFunctor_compose
-  (F: CoContraVariantBiFunctor.functor)
-  (F1: CovariantFunctor.functor)
-  (F2: ContraVariantFunctor.functor) :=
-  CovariantFunctor.Functor (CoContraVariantBiFunctor_CoContraVariantFunctor_composeFacts F F1 F2).
-
-Lemma CoContraVariantBiFunctor_MixVariantFunctor_composeFacts
-  (F: CoContraVariantBiFunctor.functor)
-  (F1 F2: MixVariantFunctor.functor):
-  MixVariantFunctor.functorFacts (fun T : Type => F (F1 T) (F2 T))
-    (fun (A B : Type) (f : A -> B) (g : B -> A) =>
-     CoContraVariantBiFunctor.fmap F (MixVariantFunctor.fmap F1 f g)
-       (MixVariantFunctor.fmap F2 g f)).
-Proof.
-  constructor; intros; simpl.
-  + rewrite !MixVariantFunctorLemmas.fmap_id, CoContraVariantBiFunctorLemmas.fmap_id; auto.
-  + rewrite CoContraVariantBiFunctorLemmas.fmap_comp, !MixVariantFunctorLemmas.fmap_comp; auto.
-Qed.
-
-Definition CoContraVariantBiFunctor_MixVariantFunctor_compose
-  (F: CoContraVariantBiFunctor.functor)
-  (F1 F2: MixVariantFunctor.functor):=
-  MixVariantFunctor.Functor (CoContraVariantBiFunctor_MixVariantFunctor_composeFacts F F1 F2).
-
-End GeneralFunctorGenerator.
-
-Module CovariantBiFunctorGenerator.
-
-Import CovariantBiFunctor.
-Import CovariantBiFunctorLemmas.
-
-Definition Fpair: functor.
-  refine (@Functor
-   (fun T1 T2 => prod T1 T2)
-   (fun _ _ _ _ f1 f2 x => (f1 (fst x), f2 (snd x))) _).
-  constructor; intros; simpl; auto.
-  extensionality p; destruct p as [a1 a2]; simpl; auto.
-Defined.
-
-Definition Fchoice: functor.
-  refine (@Functor
-   (fun T1 T2 => sum T1 T2)
-   (fun _ _ _ _ f1 f2 x =>
-      match x with
-      | inl x => inl (f1 x)
-      | inr x => inr (f2 x)
-      end) _).
-  constructor; intros; simpl.
-  + extensionality c.
-    destruct c; auto.
-  + extensionality c.
-    destruct c; unfold compose; simpl; auto.
-Defined.
-
-End CovariantBiFunctorGenerator.
-
-Module CoContraVariantBiFunctorGenerator.
-
-Import CoContraVariantBiFunctor.
-Import CoContraVariantBiFunctorLemmas.
-
-Definition Ffunc: functor.
-  refine (@Functor
-   (fun T1 T2 => T2 -> T1)
-   (fun _ _ _ _ f1 f2 x => fun a => f1 (x (f2 a))) _).
-  constructor; intros; simpl; auto.
-Defined.
-
-End CoContraVariantBiFunctorGenerator.
-
-Module CovariantFunctorGenerator.
-
-Import CovariantFunctor.
-Import CovariantFunctorLemmas.
-
-Definition fconst (T : Type): functor.
-  refine (@Functor (fun _ => T) (fun _ _ _ x => x) _).
-  constructor; intros; auto.
-Defined.
-
-Definition fidentity: functor.
-  refine (@Functor (fun T => T) (fun _ _ f => f) _).
-  constructor; intros; auto.
-Defined.
-
-Definition Foption: functor.
-  refine (@Functor (fun T => option T)
-   (fun _ _ f x => match x with Some x0 => Some (f x0) | _ => None end) _).
-  constructor; intros; simpl; auto.
-  + extensionality x; destruct x; auto.
-  + extensionality x; destruct x; auto.
-Defined.
-
-Definition Flist: functor.
-  refine (@Functor (fun T => list T)
-   (fun _ _ f x => map f x) _).
-  constructor; intros; simpl; auto.
-  + extensionality x; apply map_id.
-  + extensionality x; apply map_map.
-Defined.
-
-Definition fpair (F1 F2: functor): functor :=
-  GeneralFunctorGenerator.CovariantBiFunctor_CovariantFunctor_compose
-  CovariantBiFunctorGenerator.Fpair
-  F1
-  F2.
-
-Goal forall (F1 F2: functor) (T: Type), fpair F1 F2 T = prod (F1 T) (F2 T).
-reflexivity.
-Qed.
-
-Definition fchoice (F1 F2: functor): functor :=
-  GeneralFunctorGenerator.CovariantBiFunctor_CovariantFunctor_compose
-  CovariantBiFunctorGenerator.Fchoice
-  F1
-  F2.
-
-Definition foption (F: functor): functor :=
-  GeneralFunctorGenerator.CovariantFunctor_CovariantFunctor_compose
-  Foption
-  F.
-
-Definition flist (F: functor): functor :=
-  GeneralFunctorGenerator.CovariantFunctor_CovariantFunctor_compose
-  Flist
-  F.
-
-Goal forall (F : functor) (T: Type), foption F T = option (F T).
-reflexivity.
-Qed.
-
-Definition ffunc (F1: ContraVariantFunctor.functor) (F2: functor): functor :=
-  GeneralFunctorGenerator.CoContraVariantBiFunctor_CoContraVariantFunctor_compose
-  CoContraVariantBiFunctorGenerator.Ffunc
-  F2
-  F1.
-
-Goal forall (F1 : ContraVariantFunctor.functor) (F2: functor) (T: Type),
-  ffunc F1 F2 T = (F1 T -> F2 T).
-reflexivity.
-Qed.
-
-Definition fsig {I: Type} (F: I -> functor): functor.
-  refine (@Functor
-   (fun T => @sigT I (fun i => F i T))
-   (fun _ _ f x => match x with existT _ i x0 => existT _ i (fmap (F i) f x0) end) _).
-  constructor; intros; simpl.
-  + extensionality p; destruct p as [i a]; simpl.
-    rewrite !fmap_id; auto.
-  + extensionality p; destruct p as [i a]; simpl.
-    unfold compose at 1. rewrite !fmap_app; auto.
-Defined.
-
-Definition fsubset (F: functor) (P: forall A, F A -> Prop)
-  (Pfmap: forall A B (f: A -> B) x, P A x -> P B (fmap F f x)): functor.
-  refine (@Functor
-   (fun T => {x: F T | P T x})
-   (fun _ _ f x =>
-      match x with exist _ x' H => exist _ (fmap F f x')
-                                           (Pfmap _ _ f x' H) end) _).
-  constructor; intros; simpl.
-  + extensionality x; destruct x as [x ?H].
-    apply exist_ext.
-    rewrite !fmap_id; auto.
-  + extensionality x; destruct x as [x ?H].
-    apply exist_ext.
-    rewrite !fmap_app; auto.
-Defined.
-
-End CovariantFunctorGenerator.
-
-Module MixVariantFunctorGenerator.
-
-Import MixVariantFunctor.
-Import MixVariantFunctorLemmas.
-
-Definition fconst (T : Type): functor :=
-  GeneralFunctorGenerator.CovariantFunctor_MixVariantFunctor
-  (CovariantFunctorGenerator.fconst T).
-
-Definition fidentity: functor :=
-  GeneralFunctorGenerator.CovariantFunctor_MixVariantFunctor
-  CovariantFunctorGenerator.fidentity.
-
-Definition fpair (F1 F2: functor): functor :=
-  GeneralFunctorGenerator.CovariantBiFunctor_MixVariantFunctor_compose
-  CovariantBiFunctorGenerator.Fpair
-  F1
-  F2.
-
-Definition fchoice (F1 F2: functor): functor :=
-  GeneralFunctorGenerator.CovariantBiFunctor_MixVariantFunctor_compose
-  CovariantBiFunctorGenerator.Fchoice
-  F1
-  F2.
-
-Definition foption (F: functor): functor :=
-  GeneralFunctorGenerator.CovariantFunctor_MixVariantFunctor_compose
-  CovariantFunctorGenerator.Foption
-  F.
-
-Definition flist (F: functor): functor :=
-  GeneralFunctorGenerator.CovariantFunctor_MixVariantFunctor_compose
-  CovariantFunctorGenerator.Flist
-  F.
-
-Definition ffunc (F1 F2: functor): functor :=
-  GeneralFunctorGenerator.CoContraVariantBiFunctor_MixVariantFunctor_compose
-  CoContraVariantBiFunctorGenerator.Ffunc
-  F2
-  F1.
-
-Definition fsig {I: Type} (F: I -> functor): functor.
-  refine (@Functor
-   (fun T => @sigT I (fun i => F i T))
-   (fun _ _ f g x => match x with existT _ i x0 => existT _ i (fmap (F i) f g x0) end) _).
-  constructor; intros; simpl.
-  + extensionality p; destruct p as [i a]; simpl.
-    rewrite !fmap_id; auto.
-  + extensionality p; destruct p as [i a]; simpl.
-    unfold compose at 1. rewrite !fmap_app; auto.
-Defined.
-
-Definition fpi {I: Type} (F: I -> functor): functor.
-  refine (@Functor
-   (fun T => forall i: I, F i T)
-   (fun _ _ f g x => fun i => fmap (F i) f g (x i)) _).
-  constructor; intros; simpl.
-  + extensionality p i; simpl.
-    rewrite !fmap_id; auto.
-  + extensionality p i; simpl.
-    unfold compose at 1. rewrite !fmap_app; auto.
-Defined.
-
-Definition fsubset (F: functor) (P: forall A, F A -> Prop)
-  (Pfmap: forall A B f g x, P A x -> P B (fmap F f g x)): functor.
-  refine (@Functor
-   (fun T => {x: F T | P T x})
-   (fun _ _ f g x =>
-      match x with exist _ x' H => exist _ (fmap F f g x')
-                                           (Pfmap _ _ f g x' H) end) _).
-  constructor; intros; simpl.
-  + extensionality x; destruct x as [x ?H].
-    apply exist_ext.
-    rewrite !fmap_id; auto.
-  + extensionality x; destruct x as [x ?H].
-    apply exist_ext.
-    rewrite !fmap_app; auto.
-Defined.
-
-End MixVariantFunctorGenerator.
-
-Unset Implicit Arguments.
-
diff --git a/msl/ghost.v b/msl/ghost.v
deleted file mode 100644
index 383a092324..0000000000
--- a/msl/ghost.v
+++ /dev/null
@@ -1,50 +0,0 @@
-Require Import VST.msl.sepalg.
-
-Class Ghost := { G : Type; valid : G -> Prop;
-  Join_G : Join G; Sep_G : Sep_alg G; Perm_G : Perm_alg G;
-  join_valid : forall a b c, join a b c -> valid c -> valid a }.
-Global Existing Instance Join_G.
-Global Existing Instance Sep_G.
-Global Existing Instance Perm_G.
-
-Section Update.
-
-Context {RA: Ghost}.
-
-Lemma core_valid: forall a, valid a -> valid (core a).
-Proof.
-  intros; eapply join_valid; eauto.
-  apply core_unit.
-Qed.
-
-(*Lemma core2_valid: forall a, valid a -> valid (core2 a).
-Proof.
-  intros; eapply join_valid; eauto.
-  apply core2_unit.
-Qed.*)
-
-Definition valid_2 a b := exists c, join a b c /\ valid c.
-
-Definition fp_update_ND a B := forall c, valid_2 a c -> exists b, B b /\ valid_2 b c.
-
-Definition fp_update a b := forall c, valid_2 a c -> valid_2 b c.
-
-Lemma fp_update_equiv: forall a b, fp_update a b <-> fp_update_ND a (eq b).
-Proof.
-  split; repeat intro.
-  - exists b; split; eauto; constructor.
-  - destruct (H _ H0) as (? & Hx & ?); inversion Hx; auto.
-Qed.
-
-Lemma fp_update_sub: forall a b, join_sub b a -> fp_update a b.
-Proof.
-  repeat intro.
-  unfold valid_2 in *.
-  destruct H0 as (? & J & ?).
-  destruct H as [? J'].
-  destruct (join_assoc (join_comm J') J) as (c' & ? & ?).
-  exists c'; split; auto.
-  eapply join_valid; eauto.
-Qed.
-
-End Update.
diff --git a/msl/ghost_seplog.v b/msl/ghost_seplog.v
deleted file mode 100644
index b28abbf5b4..0000000000
--- a/msl/ghost_seplog.v
+++ /dev/null
@@ -1,313 +0,0 @@
-Require Import VST.msl.Extensionality.
-Require Import VST.msl.seplog.
-Require Import VST.msl.sepalg.
-Require Import VST.msl.ghost.
-Require Import Ensembles List.
-
-Local Open Scope logic.
-
-Definition pred_infinite {N} (P : N -> Prop) := forall l, exists x, ~In x l /\ P x.
-
-(* c.f. https://gitlab.mpi-sws.org/iris/iris/-/blob/master/iris/bi/updates.v *)
-Class BupdSepLog (A N D: Type) {ND: NatDed A}{SL: SepLog A} := mkBSL {
-  bupd: A -> A;
-  own: forall {RA: Ghost}, N -> G -> D -> A;
-  infinite_names: forall (l : list N), exists x, ~In x l;
-  bupd_intro: forall P, P |-- bupd P;
-  bupd_mono: forall P Q, (P |-- Q) -> bupd P |-- bupd Q;
-  bupd_trans: forall P, bupd (bupd P) |-- bupd P;
-  bupd_frame_r: forall P Q, bupd P * Q |-- bupd (P * Q);
-  own_alloc_strong: forall {RA: Ghost} P a pp, pred_infinite P -> valid a ->
-    emp |-- bupd (EX g: N, !!(P g) && own g a pp);
-  own_op: forall {RA: Ghost} g (a1 a2 a3: G) pp, join a1 a2 a3 ->
-    own g a3 pp = own g a1 pp * own g a2 pp;
-  own_valid_2: forall {RA: Ghost} g (a1 a2: G) pp,
-    own g a1 pp * own g a2 pp |-- !!valid_2 a1 a2;
-  own_update_ND: forall {RA: Ghost} g (a: G) B pp, fp_update_ND a B ->
-    own g a pp |-- bupd (EX b : _, !!(B b) && own g b pp);
-  own_dealloc: forall {RA: Ghost} g (a: G) pp,
-    own g a pp |-- emp
-  }.
-
-Declare Scope logic_upd. (* so we can close this scope when we import Iris *)
-
-Open Scope logic_upd.
-
-Notation "|==> P" := (bupd P) (at level 99, P at level 200): logic_upd.
-
-Section bupd_derived.
-
-Context `{BUPD : BupdSepLog}.
-
-Lemma bupd_orp_r: forall (P Q: A), ((|==> P) || Q) |-- |==> P || Q.
-Proof.
-  intros.
-  apply orp_left.
-  + apply bupd_mono.
-    apply orp_right1, derives_refl.
-  + eapply derives_trans; [| apply bupd_intro].
-    apply orp_right2, derives_refl.
-Qed.
-
-Lemma bupd_orp_l: forall (P Q: A), (P || |==> Q) |-- |==> P || Q.
-Proof.
-  intros; rewrite orp_comm, (orp_comm P Q); apply bupd_orp_r.
-Qed.
-
-Lemma bupd_orp: forall (P Q: A), ((|==> P) || |==> Q) |-- |==> P || Q.
-Proof.
-  intros.
-  eapply derives_trans, bupd_trans.
-  eapply derives_trans; [apply bupd_orp_l|].
-  apply bupd_mono, bupd_orp_r.
-Qed.
-
-Lemma bupd_frame_l: forall (P Q: A), (P * |==> Q) |-- |==> P * Q.
-Proof.
-  intros; rewrite sepcon_comm, (sepcon_comm P Q); apply bupd_frame_r.
-Qed.
-
-Lemma bupd_sepcon: forall (P Q: A), ((|==> P) * |==> Q) |-- |==> P * Q.
-Proof.
-  intros.
-  eapply derives_trans, bupd_trans.
-  eapply derives_trans; [apply bupd_frame_l|].
-  apply bupd_mono, bupd_frame_r.
-Qed.
-
-Lemma own_alloc: forall {RA: Ghost} (a: G) pp,
-  valid a -> emp |-- bupd (EX g: N, own g a pp).
-Proof.
-  intros.
-  eapply derives_trans; [apply (own_alloc_strong (fun _ => True)); eauto|].
-  { intros ?.
-    destruct (infinite_names l); eauto. }
-  apply bupd_mono.
-  apply exp_left; intro g; apply exp_right with g.
-  apply andp_left2, derives_refl.
-Qed.
-
-Lemma own_update: forall {RA: Ghost} g (a: G) b pp, fp_update a b ->
-    own g a pp |-- |==> (own g b pp).
-Proof.
-  intros.
-  eapply derives_trans; [apply own_update_ND with (B := Singleton _ b)|].
-  - intros ? J; destruct (H _ J).
-    do 2 eexists; [constructor | eauto].
-  - apply bupd_mono.
-    apply exp_left; intro.
-    rewrite imp_andp_adjoint; apply prop_left; intro X.
-    inversion X; auto.
-    rewrite <- imp_andp_adjoint; apply andp_left2, derives_refl.
-Qed.
-
-Lemma own_valid: forall {RA: Ghost} g (a: G) pp,
-  own g a pp |-- !!valid a.
-Proof.
-  intros.
-  erewrite own_op by apply core_unit.
-  eapply derives_trans; [apply own_valid_2|].
-  apply prop_left; intros (a' & J & ?); apply prop_right.
-  assert (a = a') as ->; auto.
-  eapply join_eq; eauto; apply core_unit.
-Qed.
-
-Lemma own_sub: forall {RA: Ghost} g (a b: G) pp,
-  join_sub b a ->
-  own g a pp |-- |==> own g b pp.
-Proof.
-  intros; apply own_update, fp_update_sub; auto.
-Qed.
-
-Lemma own_core: forall {RA: Ghost} g (a: G) pp,
-  own g a pp |-- |==> own g (core a) pp.
-Proof.
-  intros; apply own_sub.
-  eexists; apply core_unit.
-Qed.
-
-End bupd_derived.
-
-#[global] Instance LiftBupdSepLog (A B N D: Type) {NB: NatDed B}{SB: SepLog B}{BSLB: BupdSepLog B N D} :
-  BupdSepLog (A -> B) N D.
- apply (mkBSL _ _ _ _ _ (fun P rho => |==> P rho) (fun RA g a pp rho => own g a pp));
-   repeat intro; simpl.
- apply infinite_names.
- apply bupd_intro.
- apply bupd_mono; auto.
- apply bupd_trans.
- apply bupd_frame_r.
- apply own_alloc_strong; auto.
- extensionality rho; apply own_op; auto.
- apply own_valid_2.
- apply own_update_ND; auto.
- apply own_dealloc; auto.
-Defined.
-
-Class FupdSepLog (A N D I: Type) {ND: NatDed A}{IA: Indir A}{SL: SepLog A}{BSL: BupdSepLog A N D} := mkFSL {
-  fupd: Ensemble I -> Ensemble I -> A -> A;
-  fupd_mask_union: forall E1 E2, Disjoint _ E1 E2 ->
-    emp |-- fupd (Union _ E1 E2) E2 (fupd E2 (Union _ E1 E2) emp);
-  except_0_fupd: forall E1 E2 P, ((|> FF) || fupd E1 E2 P) |-- fupd E1 E2 P;
-  fupd_mono: forall E1 E2 P Q, (P |-- Q) -> fupd E1 E2 P |-- fupd E1 E2 Q;
-  fupd_trans: forall E1 E2 E3 P, fupd E1 E2 (fupd E2 E3 P) |-- fupd E1 E3 P;
-  fupd_mask_frame_r': forall E1 E2 Ef P, Disjoint _ E1 Ef ->
-    fupd E1 E2 (!! (Disjoint _ E2 Ef) --> P) |-- fupd (Union _ E1 Ef) (Union _ E2 Ef) P;
-  fupd_frame_r: forall E1 E2 P Q, (fupd E1 E2 P) * Q |-- fupd E1 E2 (P * Q);
-  bupd_fupd: forall E P, bupd P |-- fupd E E P
-  }.
-
-Notation "|={ E1 , E2 }=> P" := (fupd E1 E2 P) (at level 99, E1 at level 50, E2 at level 50, P at level 200): logic_upd.
-Notation "|={ E }=> P" := (fupd E E P) (at level 99, E at level 50, P at level 200): logic_upd.
-
-Lemma Empty_set_Union : forall {A} S, Union A (Empty_set A) S = S.
-Proof.
-  intros; apply Extensionality_Ensembles; split; intros ? H.
-  - inversion H; auto; contradiction.
-  - constructor 2; auto.
-Qed.
-
-Lemma Union_Empty_set : forall {A} S, Union A S (Empty_set A) = S.
-Proof.
-  intros; apply Extensionality_Ensembles; split; intros ? H.
-  - inversion H; auto; contradiction.
-  - constructor 1; auto.
-Qed.
-
-Lemma Empty_set_disjoint1 : forall {A} (E : Ensemble A), Disjoint _ (Empty_set _) E.
-Proof.
-  constructor; intros.
-  intros Hin; inversion Hin; subst; contradiction.
-Qed.
-
-Lemma Empty_set_disjoint2 : forall {A} (E : Ensemble A), Disjoint _ E (Empty_set _).
-Proof.
-  constructor; intros.
-  intros Hin; inversion Hin; subst; contradiction.
-Qed.
-
-Section fupd_derived.
-
-Context `{FUPD : FupdSepLog}.
-
-Lemma fupd_mask_intro_union {CA : ClassicalSep A} E1 E2 P : Disjoint _ E1 E2 ->
-  P |-- |={Union _ E1 E2,E2}=> |={E2,Union _ E1 E2}=> P.
-Proof.
-  intros.
-  rewrite <- (sepcon_emp P), sepcon_comm.
-  eapply derives_trans; [apply sepcon_derives, derives_refl; apply fupd_mask_union; eauto|].
-  eapply derives_trans; [apply fupd_frame_r | apply fupd_mono].
-  apply fupd_frame_r.
-Qed.
-
-Lemma fupd_intro {CA : ClassicalSep A} E P : P |-- |={E}=> P.
-Proof.
-  eapply derives_trans, fupd_trans.
-  eapply derives_trans; [apply (fupd_mask_intro_union (Empty_set _))|].
-  { apply Empty_set_disjoint1. }
-  rewrite Empty_set_Union. apply derives_refl.
-Qed.
-
-Lemma fupd_except_0 {CA : ClassicalSep A} E1 E2 (P : A) : (|={E1,E2}=> ((|> FF) || P)) |-- |={E1,E2}=> P.
-Proof.
-  eapply derives_trans; [apply fupd_mono|].
-  { apply orp_left; [apply orp_right1, derives_refl | apply orp_right2, fupd_intro]. }
-  eapply derives_trans; [apply fupd_mono, except_0_fupd|].
-  apply fupd_trans.
-Qed.
-
-Lemma fupd_idem E P {CA : ClassicalSep A} : (|={E}=> |={E}=> P) = |={E}=> P.
-Proof.
-  apply pred_ext.
-  - apply fupd_trans.
-  - apply fupd_intro.
-Qed.
-
-Lemma fupd_frame_l E1 E2 P Q : (P * |={E1,E2}=> Q) |-- |={E1,E2}=> P * Q.
-Proof.
-  rewrite !(sepcon_comm P); apply fupd_frame_r.
-Qed.
-
-Lemma fupd_mask_intro {CA : ClassicalSep A} E1 E2 P : Disjoint _ E1 E2 ->
-  ((|={E2,Union _ E1 E2}=> emp) -* P) |-- |={Union _ E1 E2,E2}=> P.
-Proof.
-  intros.
-  rewrite <- sepcon_emp at 1.
-  eapply derives_trans; [apply sepcon_derives, fupd_mask_intro_union; eauto; apply derives_refl|].
-  eapply derives_trans, fupd_mono; [apply fupd_frame_l|].
-  rewrite wand_sepcon_adjoint; apply derives_refl.
-Qed.
-
-Lemma fupd_mask_intro_all {CA : ClassicalSep A} E P :
-  ((|={Empty_set _,E}=> emp) -* P) |-- |={E,Empty_set _}=> P.
-Proof.
-  intros.
-  rewrite <- (Union_Empty_set E); apply fupd_mask_intro.
-  apply Empty_set_disjoint2.
-Qed.
-
-Lemma fupd_elim E1 E2 E3 P Q :
-    Q |-- (|={E2,E3}=> P) -> (|={E1,E2}=> Q) |-- (|={E1,E3}=> P).
-Proof.
-  intros.
-  eapply derives_trans; [apply fupd_mono, H|].
-  apply fupd_trans.
-Qed.
-
-Lemma fupd_mask_frame_r E1 E2 Ef P :
-  Disjoint _ E1 Ef -> (|={E1,E2}=> P) |-- |={Union _ E1 Ef, Union _ E2 Ef}=> P.
-Proof.
-  intros.
-  eapply derives_trans, fupd_mask_frame_r'; auto.
-  apply fupd_mono.
-  rewrite <- imp_andp_adjoint.
-  apply andp_left1, derives_refl.
-Qed.
-
-Lemma fupd_or E1 E2 P Q :
-    (|={E1,E2}=> P) || (|={E1,E2}=> Q) |-- (|={E1,E2}=> (P || Q)).
-Proof.
-  apply orp_left; apply fupd_mono; [apply orp_right1 | apply orp_right2]; apply derives_refl.
-Qed.
-
-Lemma fupd_and E1 E2 P Q :
-    (|={E1,E2}=> (P && Q)) |-- (|={E1,E2}=> P) && (|={E1,E2}=> Q).
-Proof.
-  apply andp_right; apply fupd_mono; [apply andp_left1 | apply andp_left2]; apply derives_refl.
-Qed.
-
-Lemma fupd_exists E1 E2 T (P : T -> A) : (EX x : T, |={E1, E2}=> P x) |-- |={E1, E2}=> EX x : T, P x.
-Proof.
-  apply exp_left; intros x.
-  apply fupd_mono.
-  apply exp_right with x, derives_refl.
-Qed.
-
-Lemma fupd_forall E1 E2 T (P : T -> A) : (|={E1, E2}=> ALL x : T, P x) |-- ALL x : T, |={E1, E2}=> P x.
-Proof.
-  apply allp_right; intros x.
-  apply fupd_mono.
-  apply allp_left with x, derives_refl.
-Qed.
-
-Lemma fupd_sep E P Q : (|={E}=> P) * (|={E}=> Q) |-- |={E}=> P * Q.
-Proof.
-  eapply derives_trans; [apply fupd_frame_r|].
-  eapply derives_trans, fupd_trans; apply fupd_mono.
-  apply fupd_frame_l.
-Qed.
-
-End fupd_derived.
-
-#[global] Instance LiftFupdSepLog (A B N D I: Type) {NB: NatDed B}{IB: Indir B}{SB: SepLog B}{BSLB: BupdSepLog B N D}{FSLB: FupdSepLog B N D I} :
-  FupdSepLog (A -> B) N D I.
- apply (mkFSL _ _ _ _ _ _ _ _ (fun E1 E2 P rho => |={E1,E2}=> P rho));
-   repeat intro; simpl.
- apply fupd_mask_union; auto.
- apply except_0_fupd.
- apply fupd_mono; auto.
- apply fupd_trans.
- apply fupd_mask_frame_r'; auto.
- apply fupd_frame_r.
- apply bupd_fupd.
-Defined.
diff --git a/msl/iter_sepcon.v b/msl/iter_sepcon.v
deleted file mode 100644
index 53bbb86af4..0000000000
--- a/msl/iter_sepcon.v
+++ /dev/null
@@ -1,681 +0,0 @@
-(* This file are developed by Qinxiang Cao, Shengyi Wang and Aquinas Hobor in 2015 *)
-(* summer in Yale-NUS.                                                             *)
-
-Require Import VST.msl.base.
-Require Import VST.msl.Extensionality.
-Require Import VST.msl.simple_CCC.
-Require Import VST.msl.seplog.
-Require Import VST.msl.log_normalize.
-Require Import VST.zlist.sublist.
-Require Import Coq.Lists.List.
-Require Import Coq.ZArith.ZArith.
-Require Import Coq.Sorting.Permutation.
-Require Export Coq.Classes.Morphisms.
-
-Lemma In_Permutation_cons: forall {A : Type} (l : list A) (x : A),
-  In x l ->
-  exists l', Permutation l (x :: l').
-Proof.
-  intros.
-  induction l.
-  + inversion H.
-  + destruct H.
-    - exists l; subst; reflexivity.
-    - destruct (IHl H) as [l' ?].
-      exists (a :: l').
-      rewrite H0.
-      constructor.
-Qed.
-
-Lemma incl_Permutation {A: Type}: forall (l1 l2: list A), NoDup l2 -> incl l2 l1 -> exists l', Permutation l1 (l2 ++ l').
-Proof.
-  intros l1 l2. revert l1. induction l2; intros.
-  - exists l1. simpl. auto.
-  - rewrite NoDup_cons_iff in H. destruct H. hnf in H0. assert (In a l1) by (apply H0; simpl; auto). assert (incl l2 l1) by (hnf; intros; apply H0; simpl; auto).
-    specialize (IHl2 l1 H1 H3). destruct IHl2 as [l3 ?]. assert (In a l3) by (rewrite H4 in H2; apply in_app_or in H2; destruct H2; [exfalso|]; auto).
-    apply In_Permutation_cons in H5. destruct H5 as [l4 ?]. rewrite H5 in H4. exists l4. rewrite H4. rewrite <- app_comm_cons. symmetry. apply Permutation_middle.
-Qed.
-
-Local Open Scope logic.
-
-Set Implicit Arguments.
-
-Definition sepcon_unique1 {X A} `{SepLog A} (P: X -> A): Prop :=
-  forall x, P x * P x |-- FF.
-
-Definition sepcon_unique2 {X Y A} `{SepLog A} (P: X -> Y -> A): Prop :=
-  forall x y1 y2, P x y1 * P x y2 |-- FF.
-
-Section IterSepCon.
-
-  Context {A : Type}.
-  Context {B : Type}.
-  Context {ND : NatDed A}.
-  Context {SL : SepLog A}.
-  Context {ClS: ClassicalSep A}.
-  Context {CoSL: CorableSepLog A}.
-
-Section SingleSepPred.
-
-  Context (p : B -> A).
-
-Fixpoint iter_sepcon (l : list B) : A :=
-  match l with
-    | nil => emp
-    | x :: xl => p x * iter_sepcon xl
-  end.
-
-Lemma iter_sepcon_app:
-  forall (l1 l2 : list B), iter_sepcon (l1 ++ l2) = iter_sepcon l1 * iter_sepcon l2.
-Proof.
-  induction l1; intros; simpl. rewrite emp_sepcon; auto. rewrite IHl1. rewrite sepcon_assoc. auto.
-Qed.
-
-Lemma iter_sepcon_app_comm: forall (l1 l2 : list B), iter_sepcon (l1 ++ l2) = iter_sepcon (l2 ++ l1).
-Proof. intros. do 2 rewrite iter_sepcon_app. rewrite sepcon_comm. auto. Qed.
-
-Lemma iter_sepcon_permutation: forall  (l1 l2 : list B), Permutation l1 l2 -> iter_sepcon l1 = iter_sepcon l2.
-Proof.
-  intros. induction H; simpl; auto.
-  + rewrite IHPermutation. auto.
-  + do 2 rewrite <- sepcon_assoc. rewrite (sepcon_comm (p y)). auto.
-  + rewrite IHPermutation1. auto.
-Qed.
-
-Lemma iter_sepcon_in_true: forall (l : list B) x, In x l -> iter_sepcon l |-- p x * TT.
-Proof.
-  intros. apply in_split in H. destruct H as [l1 [l2 ?]]. subst.
-  rewrite iter_sepcon_app_comm. rewrite <- app_comm_cons. simpl.
-  apply sepcon_derives; auto. apply TT_right.
-Qed.
-
-Lemma iter_sepcon_incl_true: forall (l s: list B),
-    NoDup s -> incl s l -> iter_sepcon l |-- iter_sepcon s * TT.
-Proof.
-  intros. destruct (incl_Permutation l s H H0) as [l' ?].
-  apply iter_sepcon_permutation in H1. rewrite H1, iter_sepcon_app.
-  apply sepcon_derives; auto. apply TT_right.
-Qed.
-
-Lemma iter_sepcon_unique_nodup: forall (l : list B), sepcon_unique1 p -> iter_sepcon l |-- !!(NoDup l).
-Proof.
-  intros. induction l.
-  + apply prop_right. constructor.
-  + simpl.
-    assert (p a * iter_sepcon l |-- !!(~ In a l)). {
-      apply not_prop_right.
-      intros. apply iter_sepcon_in_true in H0.
-      apply derives_trans with (p a * p a * TT).
-      + rewrite sepcon_assoc. apply sepcon_derives. apply derives_refl. auto.
-      + specialize (H a). apply derives_trans with (FF * TT).
-        apply sepcon_derives; auto. rewrite sepcon_comm, sepcon_FF. apply derives_refl.
-    }
-  apply derives_trans with (!!(NoDup l) && !!(~ In a l)).
-  - apply andp_right; auto. rewrite (add_andp _ _ IHl). normalize.
-  - normalize. constructor; auto.
-Qed.
-
-Lemma iter_sepcon_emp': forall (l : list B), (forall x, In x l -> p x = emp) -> iter_sepcon l = emp.
-Proof.
-  induction l; intros; simpl; auto.
-  rewrite H, IHl, sepcon_emp; simpl; auto.
-  intros; apply H; simpl; auto.
-Qed.
-
-Lemma iter_sepcon_emp: forall (l l' : list B), (forall x, p x |-- emp) -> NoDup l' -> incl l' l -> iter_sepcon l |-- iter_sepcon l'.
-Proof.
-  intros.
-  revert l H1; induction l'; intros.
-  + simpl; clear H1.
-    induction l; simpl; auto.
-    rewrite <- (emp_sepcon emp).
-    apply sepcon_derives; auto.
-  + inversion H0; subst.
-    spec IHl'; [auto |].
-    assert (In a l) by (specialize (H1 a); simpl in H1; auto).
-    apply in_split in H2.
-    destruct H2 as [l1 [l2 ?]].
-    specialize (IHl' (l1 ++ l2)).
-    spec IHl'.
-    {
-      clear - H2 H1 H4.
-      intros x ?H.
-      specialize (H1 x).
-      spec H1; [simpl; auto |].
-      subst.
-      rewrite in_app_iff in H1; simpl in H1.
-      rewrite in_app_iff.
-      assert (a = x -> False) by (intros; subst; tauto).
-      tauto.
-    }
-    subst.
-    rewrite iter_sepcon_app in *.
-    simpl.
-    rewrite (sepcon_comm (p a)), <- sepcon_assoc, (sepcon_comm _ (p a)).
-    apply sepcon_derives; auto.
-Qed.
-
-Lemma iter_sepcon_nil: iter_sepcon nil = emp.
-Proof. intros; reflexivity. Qed.
-
-End SingleSepPred.
-
-Lemma iter_sepcon_sepcon: forall (f g1 g2: B -> A) l,
-     (forall b : B, f b = g1 b * g2 b) ->
-  iter_sepcon f l = iter_sepcon g1 l * iter_sepcon g2 l.
-Proof.
-  intros; induction l; simpl.
-  autorewrite with norm; auto.
-  rewrite H, IHl.
-  rewrite !sepcon_assoc.
-  f_equal.
-  rewrite sepcon_comm.
-  rewrite !sepcon_assoc.
-  f_equal.
-  apply sepcon_comm.
-Qed.
-
-Lemma iter_sepcon_sepcon': forall g1 g2 (l : list B),
-  iter_sepcon (fun x => g1 x * g2 x) l = iter_sepcon g1 l * iter_sepcon g2 l.
-Proof.
-  intros. apply iter_sepcon_sepcon. easy.
-Qed.
-
-Lemma iter_sepcon_derives :
-   forall f g (l : list B), (forall x, In x l -> f x |-- g x) -> iter_sepcon f l |-- iter_sepcon g l.
-Proof.
-  induction l; simpl; auto; intros.
-  apply sepcon_derives; auto.
-Qed.
-
-Lemma iter_sepcon_func: forall l P Q, (forall x, P x = Q x) -> iter_sepcon P l = iter_sepcon Q l.
-Proof. intros. induction l; simpl; [|f_equal]; auto. Qed.
-
-Lemma iter_sepcon_func_strong: forall l P Q, (forall x, In x l -> P x = Q x) -> iter_sepcon P l = iter_sepcon Q l.
-Proof.
-  intros. induction l.
-  + reflexivity.
-  + simpl.
-    f_equal.
-    - apply H.
-      simpl; auto.
-    - apply IHl.
-      intros; apply H.
-      simpl; auto.
-Qed.
-
-#[global] Instance iter_sepcon_permutation_proper : Proper ((pointwise_relation B eq) ==> (@Permutation B) ==> eq) iter_sepcon.
-Proof.
-  repeat intro. transitivity (iter_sepcon x y0).
-  + apply iter_sepcon_permutation. auto.
-  + apply iter_sepcon_func.
-    exact H.
-Qed.
-
-Lemma iter_sepcon_Znth: forall {d : Inhabitant B} f (l : list B) (i: Z), (0 <= i < Zlength l)%Z ->
-  iter_sepcon f l = f (Znth i l) * iter_sepcon f (remove_Znth i l).
-Proof.
-  intros; unfold remove_Znth.
-  rewrite <- sublist_same at 1 by auto.
-  rewrite sublist_split with (mid := i) by lia.
-  rewrite (sublist_next i) by lia.
-  rewrite !iter_sepcon_app; simpl.
-  rewrite <- !sepcon_assoc. f_equal.
-  apply sepcon_comm.
-Qed.
-
-#[global] Arguments iter_sepcon_Znth {d} f l i.
-
-Lemma iter_sepcon_Znth_remove : forall {d : Inhabitant B} f (l: list B) i j,
-  (0 <= i < Zlength l)%Z -> (0 <= j < Zlength l)%Z -> i <> j ->
-  iter_sepcon f (remove_Znth j l) =
-  f (Znth i l) * iter_sepcon f (remove_Znth (if Z_lt_dec i j then i else i - 1) (remove_Znth j l)).
-Proof.
-  intros ????? Hi Hj Hn.
-  pose proof (Zlength_remove_Znth _ _ Hj) as Hlen.
-  unfold remove_Znth at 1 2; rewrite Hlen.
-  unfold remove_Znth in *.
-  destruct (Z_lt_dec i j).
-  - rewrite -> !sublist_app by (rewrite -> ?Zlength_app in *; lia).
-    autorewrite with sublist.
-    rewrite -> (sublist_split 0 i j) by lia.
-    rewrite !iter_sepcon_app.
-    rewrite -> (sublist_next i _) by lia; simpl.
-    replace (Zlength l - _ - _ + _)%Z with (Zlength l) by lia.
-    rewrite <- !sepcon_assoc. do 2 f_equal. apply sepcon_comm.
-  - rewrite -> !sublist_app by (rewrite -> ?Zlength_app in *; lia).
-    autorewrite with sublist.
-    rewrite -> (sublist_split (j + 1) i (Zlength l)) by lia.
-    rewrite !iter_sepcon_app.
-    rewrite -> (sublist_next i _) by lia; simpl.
-    replace (Zlength l - _ - _ + _)%Z with (Zlength l) by lia.
-    replace (i - _ - _ + _)%Z with i by lia.
-    replace (i - _ + _)%Z with (i + 1)%Z by lia.
-    rewrite (sepcon_comm (f _) (_ * _ * _)).
-    rewrite <- !sepcon_assoc. do 2 rewrite (sepcon_assoc (_ * _)).
-    f_equal. apply sepcon_comm.
-Qed.
-
-Lemma iter_sepcon_Znth' : forall {d : Inhabitant B} f (l: list B) i,
-  (0 <= i < Zlength l)%Z -> iter_sepcon f l = f (Znth i l) * (f (Znth i l) -* iter_sepcon f l).
-Proof.
-  intros; eapply wand_eq, iter_sepcon_Znth; auto.
-Qed.
-
-Lemma iter_sepcon_remove_wand : forall {d : Inhabitant B} f (l: list B) i,
-  (0 <= i < Zlength l)%Z -> iter_sepcon f (remove_Znth i l) |-- f (Znth i l) -* iter_sepcon f l.
-Proof.
-  intros; rewrite <- wand_sepcon_adjoint.
-  erewrite (iter_sepcon_Znth _ l) by eauto.
-  rewrite sepcon_comm. auto.
-Qed.
-
-Lemma iter_sepcon_In : forall (x : B) f (l: list B), In x l -> iter_sepcon f l = f x * (f x -* iter_sepcon f l).
-Proof.
-  intros.
-  apply (@In_Znth _ x) in H as (? & ? & Heq).
-  rewrite <- Heq; apply iter_sepcon_Znth'; auto.
-Qed.
-
-End IterSepCon.
-
-Lemma iter_sepcon_map: forall {A B C: Type} {ND : NatDed A} {SL : SepLog A} (l : list C) (f : B -> A) (g: C -> B),
-                         iter_sepcon (fun x : C => f (g x)) l = iter_sepcon f (map g l).
-Proof. intros. induction l; simpl; [|f_equal]; auto. Qed.
-
-Global Existing Instance iter_sepcon_permutation_proper.
-
-Definition uncurry {A B C} (f: A -> B -> C) (xy: A*B) : C :=
-  f (fst xy) (snd xy).
-
-Section IterSepCon2.
-
-  Context {A : Type}.
-  Context {B1 B2 : Type}.
-  Context {ND : NatDed A}.
-  Context {SL : SepLog A}.
-  Context {ClS: ClassicalSep A}.
-  Context {CoSL: CorableSepLog A}.
-  Context (p : B1 -> B2 -> A).
-
-Fixpoint iter_sepcon2 (l : list B1) : list B2 -> A :=
-    match l with
-    | nil => fun l2 =>
-       match l2 with
-       | nil => emp
-       | _ => FF
-       end
-    | x :: xl => fun l' =>
-       match l' with
-       | nil => FF
-       | y :: yl => p x y * iter_sepcon2 xl yl
-       end
-  end.
-
-Lemma iter_sepcon2_spec: forall l1 l2,
-  iter_sepcon2 l1 l2 = EX l: list (B1 * B2), !! (l1 = map fst l /\ l2 = map snd l) && iter_sepcon (uncurry p) l.
-Proof.
-  intros.
-  apply pred_ext.
-  + revert l2; induction l1; intros; destruct l2.
-    - apply (exp_right nil); simpl.
-      apply andp_right; auto.
-      apply prop_right; auto.
-    - simpl.
-      apply FF_left.
-    - simpl.
-      apply FF_left.
-    - simpl.
-      specialize (IHl1 l2).
-      eapply derives_trans; [apply sepcon_derives; [apply derives_refl | apply IHl1] | clear IHl1].
-      normalize.
-      destruct H.
-      apply (exp_right ((a, b) :: l)).
-      simpl.
-      apply andp_right; [apply prop_right; subst; auto |].
-      apply derives_refl.
-  + apply exp_left; intros l.
-    normalize.
-    destruct H; subst.
-    induction l.
-    - simpl. auto.
-    - simpl.
-      eapply derives_trans; [apply sepcon_derives; [apply derives_refl | apply IHl] | clear IHl].
-      apply derives_refl.
-Qed.
-
-Lemma iter_sepcon2_Znth: forall {d1 : Inhabitant B1} {d2 : Inhabitant B2}
-  (l1 : list B1) (l2 : list B2) i, (0 <= i < Zlength l1)%Z -> Zlength l1 = Zlength l2 ->
-  iter_sepcon2 l1 l2 =
-  p (Znth i l1) (Znth i l2) * iter_sepcon2 (remove_Znth i l1) (remove_Znth i l2).
-Proof.
-  intros; rewrite !iter_sepcon2_spec.
-  apply pred_ext.
-  - apply exp_left. intros l. apply derives_extract_prop. intros [? ?].
-    subst. rewrite Zlength_map in *.
-    rewrite !remove_Znth_map, !Znth_map, (iter_sepcon_Znth (uncurry p) l i) by auto.
-    unfold uncurry at 1. apply sepcon_derives; auto.
-    apply exp_right with (remove_Znth i l). apply prop_and_same_derives.
-    apply prop_right. auto.
-  - rewrite exp_sepcon2. apply exp_left; intros l. apply exp_right with (combine l1 l2).
-    rewrite sepcon_andp_prop. apply derives_extract_prop. intros [? ?].
-    rewrite combine_fst, combine_snd
-      by (rewrite <- !ZtoNat_Zlength; apply Nat2Z.inj; rewrite !Z2Nat.id; lia).
-    rewrite (iter_sepcon_Znth _ (combine _ _) i)
-      by (rewrite Zlength_combine, Z.min_l; lia).
-    rewrite Znth_combine, remove_Znth_combine by auto.
-    rewrite H1, H2, combine_eq; unfold uncurry. cbn [fst snd].
-    apply prop_and_same_derives. apply prop_right. auto.
-all:    apply derives_refl.  (*  We need this for Coq 8.14 and before. *)
-Qed.
-
-End IterSepCon2.
-
-Section IterPredSepCon.
-
-  Context {A : Type}.
-  Context {B : Type}.
-  Context {ND : NatDed A}.
-  Context {SL : SepLog A}.
-  Context {ClS: ClassicalSep A}.
-
-Definition pred_sepcon (p: B -> A) (P: B -> Prop): A :=
-  EX l: list B, !! (forall x, In x l <-> P x) && !! NoDup l && iter_sepcon p l.
-
-Lemma pred_sepcon_eq: forall (P: B -> Prop) (p: B -> A),
-    pred_sepcon p P =
-    (EX l: list B, !! ((forall x, In x l <-> P x) /\ NoDup l) && iter_sepcon p l).
-Proof.
-  intros. unfold pred_sepcon. f_equal. extensionality l. rewrite prop_and. auto.
-Qed.
-
-Lemma pred_sepcon_strong_proper: forall P1 P2 p1 p2,
-  (forall x, P1 x <-> P2 x) ->
-  (forall x, P1 x -> P2 x -> p1 x = p2 x) ->
-  pred_sepcon p1 P1 = pred_sepcon p2 P2.
-Proof.
-  assert (forall P1 P2 p1 p2,
-    (forall x, P1 x <-> P2 x) ->
-    (forall x, P1 x -> P2 x -> p1 x = p2 x) ->
-    pred_sepcon p1 P1 |-- pred_sepcon p2 P2).
-  2: intros; apply pred_ext; apply H; [auto | auto | symmetry; auto | symmetry; auto].
-  intros.
-  unfold pred_sepcon.
-  apply exp_left; intro l; apply (exp_right l).
-  normalize.
-  assert (forall x : B, In x l <-> P2 x) by (intros; rewrite H1, H; reflexivity).
-  normalize.
-  erewrite iter_sepcon_func_strong; [apply derives_refl |].
-  intros.
-  specialize (H1 x); specialize (H3 x).
-  apply H0; tauto.
-Qed.
-
-#[global] Instance pred_sepcon_proper: Proper (pointwise_relation B eq ==> pointwise_relation B iff ==> eq) pred_sepcon.
-Proof.
-  intros.
-  do 2 (hnf; intros).
-  apply pred_sepcon_strong_proper; intros; auto.
-Defined.
-
-Global Existing Instance pred_sepcon_proper.
-
-Lemma pred_sepcon1: forall p x0,
-  pred_sepcon p (fun x => x = x0) = p x0.
-Proof.
-  intros.
-  unfold pred_sepcon.
-  apply pred_ext.
-  + apply exp_left; intro l.
-    normalize.
-    destruct l as [| ? [|]].
-    - specialize (H x0); simpl in H.
-      tauto.
-    - specialize (H x0); simpl in H.
-      assert (b = x0) by tauto; subst b.
-      simpl.
-      rewrite sepcon_emp; auto.
-    - pose proof proj1 (H b) as HH; simpl in HH.
-      spec HH; [auto |].
-      subst b.
-      pose proof proj1 (H b0) as HH; simpl in HH.
-      spec HH; [auto |].
-      subst b0.
-      clear - H0.
-      inversion H0; subst.
-      simpl in H2; tauto.
-  + apply (exp_right (x0 :: nil)).
-    repeat apply andp_right.
-    - apply prop_right.
-      intros.
-      simpl.
-      split; [intros [? | ?]; [congruence | tauto] | left; congruence].
-    - apply prop_right.
-      constructor; [simpl; tauto | constructor].
-    - simpl.
-      rewrite sepcon_emp; auto.
-Qed.
-
-(*
-Lemma pred_sepcon_sepcon: forall (P Q R: B -> Prop) p,
-  Prop_join P Q R ->
-  pred_sepcon P p * pred_sepcon Q p = pred_sepcon R p.
-Proof.
-  intros.
-  destruct H.
-  unfold pred_sepcon; apply pred_ext.
-  + rewrite exp_sepcon1. apply exp_left; intro lP.
-    rewrite exp_sepcon2. apply exp_left; intro lQ.
-    normalize.
-    apply (exp_right (lP ++ lQ)).
-    apply andp_right; [apply andp_right |].
-    - apply prop_right.
-      intros.
-      rewrite in_app_iff.
-      firstorder.
-    - apply prop_right.
-      apply NoDup_app_inv; auto.
-      firstorder.
-    - rewrite <- iter_sepcon_app; auto.
-  + apply exp_left; intro l.
-    rewrite andp_assoc.
-    do 2 (apply derives_extract_prop; intro).
-    destruct (spec_list_split l P Q R H2 H1 (conj H H0)) as [lp [lq [? [? [? [? ?]]]]]].
-    rewrite exp_sepcon1. apply (exp_right lp).
-    rewrite exp_sepcon2. apply (exp_right lq).
-    normalize.
-    rewrite H7, iter_sepcon_app; auto.
-Qed.
-
-Lemma pred_sepcon_sepcon1: forall (P P': B -> Prop) p x0,
-  (forall x, P' x <-> P x \/ x = x0) ->
-  ~ P x0 ->
-  pred_sepcon P' p = pred_sepcon P p * p x0.
-Proof.
-  intros.
-  rewrite <- pred_sepcon_sepcon with (Q := fun x => x = x0) (P := P).
-  + f_equal.
-    apply pred_sepcon1.
-  + split; intros.
-    - specialize (H a).
-      assert (a = x0 -> ~ P a) by (intro; subst; auto).
-      tauto.
-    - subst.
-      specialize (H x0).
-      tauto.
-Qed.
-*)
-
-Lemma pred_sepcon_unique_sepcon1: forall (P: B -> Prop) p x0,
-  sepcon_unique1 p ->
-  pred_sepcon p P * p x0 |-- !! (~ P x0).
-Proof.
-  intros.
-  apply not_prop_right; intro.
-  unfold pred_sepcon; normalize.
-  rewrite <- H1 in H0.
-  eapply derives_trans; [apply sepcon_derives; [apply iter_sepcon_in_true; eauto| apply derives_refl] |].
-  rewrite sepcon_comm, <- sepcon_assoc.
-  eapply derives_trans; [apply sepcon_derives; [apply H | apply derives_refl] |].
-  normalize.
-Qed.
-
-Lemma prop_forall_allp: forall (P: B -> Prop),
-  !! (forall x, P x) = ALL x: B, !! P x.
-Proof.
-  intros.
-  apply pred_ext.
-  + apply allp_right; intros.
-    apply prop_derives; intros.
-    auto.
-  + apply allp_prop_left.
-Qed.
-
-Lemma prop_impl_imp: forall (P Q: Prop),
-  !! (P -> Q) = !! P --> !! Q.
-Proof.
-  intros.
-  apply pred_ext.
-  + apply imp_andp_adjoint.
-    normalize.
-  + apply prop_imp_prop_left.
-Qed.
-
-Lemma pred_sepcon_prop_true: forall (P: B -> Prop) p x,
-  P x ->
-  pred_sepcon p P |-- p x * TT.
-Proof.
-  intros.
-  unfold pred_sepcon; normalize.
-  intros.
-  normalize.
-  rename x0 into l.
-  rewrite <- H0 in H.
-  eapply iter_sepcon_in_true; auto.
-Qed.
-
-(*
-Lemma pred_sepcon_prop_true_weak:
-  forall (P Q: B -> Prop) (qdec: forall x, Decidable (Q x)) p,
-    (forall x, Q x -> P x) -> pred_sepcon P p |-- pred_sepcon Q p * TT.
-Proof.
-  intros. unfold pred_sepcon. normalize.
-  apply (exp_right (filter (fun x => if (qdec x) then true else false) l)).
-  rewrite <- prop_and, sepcon_andp_prop'.
-  remember (filter (fun x0 : B => if qdec x0 then true else false) l) as l'.
-  assert (forall x : B, In x l' <-> Q x). {
-    intros. subst l'. rewrite filter_In. destruct (qdec x); split; intros; auto.
-    - split; auto. apply H in H2. rewrite H0. auto.
-    - destruct H2; inversion H3.
-    - exfalso; auto.
-  } assert (NoDup l') by (subst l'; apply NoDup_filter; auto). apply andp_right.
-  - apply prop_right. split; auto.
-  - apply iter_sepcon_incl_true; auto. intro. rewrite H0, H2. apply H.
-Qed.
-*)
-Lemma pred_sepcon_False: forall p,
-  pred_sepcon p (fun _ => False) = emp.
-Proof.
-  intros.
-  unfold pred_sepcon.
-  apply pred_ext.
-  + apply exp_left; intros.
-    normalize.
-    destruct x; [apply derives_refl |].
-    specialize (H b); simpl in H; tauto.
-  + apply (exp_right nil).
-    normalize.
-    apply andp_right.
-    apply prop_right; constructor.
-    apply derives_refl.
-Qed.
-
-Lemma pred_sepcon_False':
- forall (P: B -> Prop) (p : B -> A),
-  (forall x, ~ P x) ->
-  pred_sepcon p P = emp.
-Proof.
-intros.
-replace P with (fun _:B  => False).
-apply pred_sepcon_False.
-extensionality i.
-apply prop_ext; split; intros. contradiction.
-apply (H i); auto.
-Qed.
-
-End IterPredSepCon.
-
-Lemma pred_sepcon_isolate:
-  forall {A B: Type}{NA: NatDed A}{SA: SepLog A}
-  (x: B)
-  (DECB: forall x y: B, {x=y}+{x<>y})
-  (f: B -> A) (u: B -> Prop),
-  (u x) ->
-  pred_sepcon f u = pred_sepcon f (fun y => u y /\ y<>x) * f x.
-Proof.
-intros.
-rewrite !pred_sepcon_eq.
-pose (neqx y := if DECB x y then false else true).
-apply pred_ext.
-apply exp_left; intro l.
-normalize.
-destruct H0.
-apply exp_right with (filter neqx l).
-rewrite prop_true_andp.
-apply derives_trans with (iter_sepcon f (x :: filter neqx l)).
-apply derives_refl'.
-apply iter_sepcon_permutation.
-apply NoDup_Permutation; auto.
-constructor.
-intro. apply filter_In in H2. destruct H2.
-unfold neqx in H3.
-destruct (DECB x x). inversion H3. contradiction n; auto.
-apply NoDup_filter; auto.
-intro.
-split; intro.
-destruct (DECB x0 x).
-subst. left; auto. right. apply filter_In. split; auto.
-unfold neqx.
-destruct (DECB x x0); auto.
-destruct H2.
-subst.
-rewrite <- H0 in H. auto.
-apply filter_In in H2. destruct H2; auto.
-simpl. rewrite sepcon_comm; auto.
-split.
-intro. split; intro.
-apply filter_In in H2. destruct H2.
-rewrite H0 in H2.
-split; auto.
-intro; subst.
-unfold neqx in H3.
-destruct (DECB x x); auto. inv H3.
-destruct H2.
-apply filter_In. split; auto.
-rewrite H0; auto.
-unfold neqx.
-destruct (DECB x x0); auto.
-apply NoDup_filter. auto.
-normalize.
-destruct H0.
-apply exp_right with (x::l).
-rewrite prop_true_andp.
-simpl.
-rewrite sepcon_comm; auto.
-split.
-intro.
-specialize (H0 x0).
-simpl. rewrite H0.
-split; intro.
-destruct H2.
-subst; auto.
-destruct H2. auto.
-destruct (DECB x0 x).
-subst.
-auto.
-right; auto.
-constructor; auto.
-rewrite H0.
-intros [? ?].
-contradiction.
-Qed.
diff --git a/msl/join_hom_lemmas.v b/msl/join_hom_lemmas.v
deleted file mode 100644
index e4c835797c..0000000000
--- a/msl/join_hom_lemmas.v
+++ /dev/null
@@ -1,363 +0,0 @@
-(*
- * Copyright (c) 2009-2010, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-
-Require Import VST.msl.base.
-Require Import VST.msl.sepalg.
-Require Import VST.msl.sepalg_generators.
-Require Import VST.msl.psepalg.
-
-(* This file defines a series of lemmas for proving functions from the carrier set
-   of one SA to the carrier set of another are join homomorphisms, and then shows
-   that some simple properties of SA elems, like identity, comparability, etc.,
-   are preserved by join homs.  The idea is due to Rob.
-*)
-
-(* Two-argument join homomorphisms *)
-Section join_hom2.
-  Variables (A B C: Type)
-            (JA: Join A)
-            (JB: Join B)
-            (JC: Join C)
-            (f: A -> B -> C).
-
-  Definition join_hom2 := forall (a1 a2 a3: A)(b1 b2 b3: B),
-      join a1 a2 a3
-      -> join b1 b2 b3
-      -> join (f a1 b1) (f a2 b2) (f a3 b3).
-
-  (* Two-argument join homomorphisms with a dummy argument *)
-  Definition join_hom2' := forall (a1 a2 a3: A)(b1 b2 b3: B),
-      join a1 a2 a3
-      -> join (f a1 b1) (f a2 b2) (f a3 b3).
-End join_hom2.
-
-Arguments join_hom2 [A B C JA JB JC] _.
-Arguments join_hom2' [A B C JA] _ _.
-
-(* [id] is join hom *)
-  Lemma join_hom_id (A: Type) (JA: Join A) : join_hom (fun x => x).
-  Proof. unfold join_hom; auto. Qed.
-
-(* Product SA
-   Join hom functions on products *)
-Section join_hom_prod.
-  Variables (A A' B B': Type)
-            (JA: Join A) (JA': Join A')
-            (JB: Join B)  (JB': Join B')
-            (f: A -> A') (g: B -> B')
-            (join_hom_f: join_hom f)
-            (join_hom_g: join_hom g).
-
-  Lemma join_hom2_pair: join_hom2 (fun a b => (f a, g b)).
-  Proof. firstorder. Qed.
-
-  Lemma join_hom2_pair' : join_hom2 (fun (a: A) (b: B) => (a, b)).
-  Proof. firstorder. Qed.
-
-  (* The function from [(a,b)] to [(a',b')] *)
-  Lemma join_hom_prod : join_hom (fun p => (f (fst p), g (snd p))).
-  Proof. unfold join_hom; firstorder. Qed.
-
-  (* The function from [a] to [(a', e)] *)
-  Lemma join_hom_prodA
-    : forall e: B', join e e e -> join_hom (fun a :A => (f a, e)).
-  Proof.
-    unfold join_hom in *; intros; simpl; split; auto.
-    simpl; auto.
-  Qed.
-
-  Lemma join_hom_prodA'
-    : forall e: B, join e e e -> join_hom (fun a :A'  => (a, e)).
-  Proof.
-    unfold join_hom in *; split; simpl; auto.
-  Qed.
-
-  (* The function from [b] to [(e, b')] *)
-  Lemma join_hom_prodB
-    : forall e: A', join e e e -> join_hom (fun b: B => (e, g b)).
-  Proof.
-    unfold join_hom in *; split; simpl; auto.
-  Qed.
-
-  Lemma join_hom_prodB'
-    : forall e: A, join e e e -> join_hom (fun b : B' => (e, b)).
-  Proof.
-    unfold join_hom in *; simpl; split; auto.
-  Qed.
-
-  (* Projections are join hom. *)
-  Lemma join_hom_proj1
-    : join_hom (fun p: A*B => fst p).
-  Proof. unfold join_hom; firstorder. Qed.
-
-  Lemma join_hom_proj2
-    : join_hom (fun p : A*B => snd p).
-  Proof. unfold join_hom; firstorder. Qed.
-End join_hom_prod.
-
-Arguments join_hom2_pair [A A' B B' JA JA' JB JB'] _ _ _ _ _ _ _ _ _ _ _ _.
-Arguments join_hom2_pair' [A B JA JB] _ _ _ _ _ _ _ _.
-Arguments join_hom_prodA [A] _ [B' JA] _ [JB'] _ _ _ _ _ _ _ _.
-Arguments join_hom_prodA' [A' B JA' JB] _ _ _ _ _ _.
-Arguments join_hom_prodB [A' B] _ [JA' JB] _ _ _ _ _ _ _ _ _.
-Arguments join_hom_prodB' [A B' JA JB'] _ _ _ _ _ _.
-Arguments join_hom_proj1 [A B JA JB] _ _ _ _.
-Arguments join_hom_proj2 [A B JA JB] _ _ _ _.
-
-(* Disjoint Sum SA *)
-Section join_hom_disjoint_sum.
-  Variables (A A' B B': Type)
-            (JA: Join A) (JA': Join A')
-            (JB: Join B) (JB': Join B')
-            (f: A -> A') (g: B -> B')
-            (join_hom_f: join_hom f)
-            (join_hom_g: join_hom g).
-(*
-   Definition saAorB := sa_sum saA saB.
-  Definition saA'orB' := sa_sum saA' saB'.
-*)
-  Lemma join_hom_sum
-    : join_hom (fun s: A+B =>
-        match s with
-          | inl x => inl _ (f x)
-          | inr y => inr _ (g y)
-        end).
-  Proof.
-    unfold join_hom.
-    destruct x; destruct y; destruct z; firstorder.
-  Qed.
-
-  Lemma join_hom_sum_l
-    : join_hom (fun s: A+B =>
-        match s with
-          | inl x => inl _ (f x)
-          | inr y => inr _ y
-        end).
-  Proof.
-    unfold join_hom.
-    destruct x; destruct y; destruct z; firstorder.
-  Qed.
-
-  Lemma join_hom_sum_r
-    : join_hom (fun s: A+B =>
-        match s with
-          | inl x => inl _ x
-          | inr y => inr _ (g y)
-        end).
-  Proof.
-    unfold join_hom.
-    destruct x; destruct y; destruct z; firstorder.
-  Qed.
-
-  Lemma join_hom_inj_l
-    : join_hom (fun a : A=> inl Void (f a)).
-  Proof. firstorder. Qed.
-
-  Lemma join_hom_inj_r
-    : join_hom (fun b => inr Void (g b)).
-  Proof. firstorder. Qed.
-
-  (* Bijection between [A+unit] and [option A], for convenience later on *)
-  Definition sa_sum_option (s: A+unit): option A :=
-    match s with
-      | inl s' => Some s'
-      | inr _ => None
-    end.
-
-  Definition option_sa_sum (s: option A): A+unit :=
-    match s with
-      | Some s' => inl _ s'
-      | None => inr _ tt
-    end.
-
-  Lemma sa_sum__option: forall s, sa_sum_option (option_sa_sum s) = s.
-  Proof. destruct s; firstorder. Qed.
-
-  Lemma option__sa_sum: forall s, option_sa_sum (sa_sum_option s) = s.
-  Proof. destruct s; firstorder; destruct u; firstorder. Qed.
-
-  Definition bij_sa_sum_option : bijection (A+unit) (option A) :=
-    Bijection _ _ sa_sum_option option_sa_sum sa_sum__option option__sa_sum.
-End join_hom_disjoint_sum.
-
-(* List SA *)
-Section join_hom_list.
-  Variables (A: Type) (JA: Join A).
-
-  Lemma join_hom_list_nil
-    : join_hom (fun a => a :: nil).
-  Proof.
-    unfold join_hom;
-      solve [constructor; auto || constructor].
-  Qed.
-
-  Lemma join_hom2_list_cons
-    : join_hom2 (fun a l => a :: l).
-  Proof.
-    unfold join_hom2; constructor; auto.
-  Qed.
-End join_hom_list.
-
-(* FPMs
-   This section proves a join hom lemma specialized to finite partial maps
-   producing [option]s.
-*)
-Section join_hom_fun.
-  Variables (Key A: Type)
-            (Key_dec_eq: forall k1 k2: Key, {k1=k2}+{~k1=k2})
-            (JA: Join A).
-(*
-  Definition saKey := sa_equiv Key.
-  Definition saKeyA := sa_prod saKey saA.
-  Definition saKeyAList := sa_list saKeyA.
-  Definition saSum := sa_sum saA sa_unit.
-  Definition saRange := sa_bijection _ _ (bij_sa_sum_option A) _ saSum.
-*)
-
-  Fixpoint lookup k (rho: list (Key*A)) :=
-    match rho with
-      | nil => None
-      | (k', a) :: rho' =>
-          if Key_dec_eq k k' then Some a else lookup k rho'
-    end.
-
-  #[global] Instance Join_Key : Join Key := @Join_equiv Key.
-
-  Lemma join_hom_fun
-    : join_hom (fun env k => lookup k env).
-  Proof.
-    unfold join_hom; intros x y z H.
-    induction H.
-
-    (* env is nil *)
-    simpl; auto. intro. constructor.
-
-    (* env is cons *)
-    simpl; intro x0.
-    destruct x as [k1 a1]; destruct y as [k2 a2]; destruct z as [k3 a3].
-    destruct H. simpl in *. destruct H. subst k2 k3.
-    destruct (Key_dec_eq x0 k1); auto. constructor; auto.
-  Qed.
-End join_hom_fun.
-Arguments lookup [Key A] _ _ _.
-
-Lemma join_hom_bij {A: Type} `{Perm_alg A}
-            {B: Type}
-          (bij: bijection A B):
-       @join_hom _ _ _ (Join_bij _ _ _ bij) (bij_f _ _ bij).
-  Proof.
-    unfold join_hom. intros. do 3 red.
-    repeat rewrite bij_gf. auto.
-  Qed.
-
-(* Some simple properties preserved by join homs *)
-  Lemma join_hom_join_sub {A}{B}`{Join A}`{Join B}:
-     forall (f: A -> B) a1 a2, join_sub a1 a2 -> join_hom f -> join_sub (f a1) (f a2).
-  Proof.
-    intros.
-    destruct H1 as [b H1].
-    exists (f b).  auto.
-  Qed.
-
-  Lemma join_hom_identity  {A}{B}`{Perm_alg A}{SA: Sep_alg A}{CA: Disj_alg A}`{Perm_alg B}{SB: Sep_alg B}{CB: Disj_alg B}:
-      forall (f: A -> B) a1, identity a1 -> join_hom f -> identity (f a1).
-  Proof.
-    intros.
-    rewrite identity_unit_equiv in H1.
-    rewrite identity_unit_equiv.
-    unfold unit_for in *. auto.
-  Qed.
-
-  Lemma join_hom2_identity  {A}{B}{C}
-          `{Perm_alg A}{SA: Sep_alg A}{CA: Disj_alg A}
-          `{Perm_alg B}{SB: Sep_alg B}{CB: Disj_alg B}
-          `{Perm_alg C}{SC: Sep_alg C}{CC: Disj_alg C}:
-   forall (g: A -> B -> C) a1 b1,
-      identity a1 -> identity b1 -> join_hom2 g -> identity (g a1 b1).
-  Proof.
-   intros.
-    unfold join_hom2 in *.
-    rewrite identity_unit_equiv in H2.
-    rewrite identity_unit_equiv in H3.
-    rewrite identity_unit_equiv.
-    unfold unit_for in *. auto.
-  Qed.
-
-  Lemma join_hom_comparable {A}{B}`{Perm_alg A}{SA: Sep_alg A}{FA: Flat_alg A}`{Perm_alg B}{SB:Sep_alg B}{FB: Flat_alg B}:
-      forall (f: A -> B) a1 a2, comparable a1 a2 -> join_hom f -> comparable (f a1) (f a2).
-  Proof.
-    intros.
-    unfold join_hom in *.
-    destruct (comparable_common_unit H1) as [e [? ?]].
-    apply common_unit_comparable.
-    exists (f e); split; auto.
-  Qed.
-
-  Lemma join_hom2_comparable {A}{B}{C}
-          `{Perm_alg A}{SA: Sep_alg A}{FA: Flat_alg A}`{Perm_alg B}{SB: Sep_alg B}{FB: Flat_alg B}`{Perm_alg C}{SC: Sep_alg C}{FC: Flat_alg C}:
-   forall (g: A -> B -> C) a1 a2 b1 b2,
-     comparable a1 a2
-      -> comparable b1 b2
-      -> join_hom2 g
-      -> comparable (g a1 b1) (g a2 b2).
-  Proof.
-    intros.
-    unfold join_hom2 in *.
-    destruct (comparable_common_unit H2) as [ea [? ?]].
-    destruct (comparable_common_unit H3) as [eb [? ?]].
-    apply common_unit_comparable.
-    exists (g ea eb); auto.
-  Qed.
-
-(* EXamples: *)
-
-(*  This example doesn't make so much sense, as "comparable"
-  is not so well-defined for Pos_algs
-(* Finite Partial Maps from [nat]s to [option]s *)
-Section fpm_ex.
-  Variables (A: Type)
-            (JA: Join A) (saA: Pos_alg A)(CA: Canc_alg A)
-            (a b: A)
-            (l: list (nat*A)).
-
-  Definition mkEnv := fun p:nat*A => p :: l.
-  Definition env1 := mkEnv (1%nat, a).
-  Definition env2 := mkEnv (1%nat, b).
-  Definition fpm (env: list (nat*A)) := fun k:nat => lookup eq_nat_dec k env.
-
-Check Sep_sum.
-
-
- Definition saOption := Perm_bij _ _ _ _ (bij_sa_sum_option A).
-  Definition saB := Perm_fun nat _ _ saOption.
-  Local Instance Join_nat : Join nat := @Join_equiv nat.
-  Local Instance Sep_nat : Sep_alg nat := Sep_equiv nat.
-
-  Local Instance Canc_B : Canc_alg (nat -> option A).
-  Proof. auto with typeclass_instances. Qed.
-
-  Lemma fpm_comparable_ex
-    : comparable (fpm env1) (fpm env2).
-  Proof.
-    simpl.
-
-Check (@join_hom_comparable (list (nat*A)) _ _ _ _ _ fpm).
-Print join_hom_comparable.
-A, B, J, H,  J0, H0
-
-    apply join_hom_comparable with (f := fpm).
-
-; [ | apply join_hom_fun; auto].
-    eapply join_hom2_comparable.
-    eapply join_hom2_comparable with (g := fun a b => (a,b)).
-    eapply comparable_refl.
-    eapply H.
-    eapply join_hom2_pair'.
-    eapply comparable_refl.
-    eapply join_hom2_list_cons.
-Qed.
-
-End fpm_ex.
-*)
diff --git a/msl/knot.v b/msl/knot.v
deleted file mode 100644
index e96448579f..0000000000
--- a/msl/knot.v
+++ /dev/null
@@ -1,487 +0,0 @@
-(*
- * Copyright (c) 2009-2011, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-
-Require Import VST.msl.base.
-Require Import VST.msl.ageable.
-Require Import Coq.Logic.Eqdep_dec.
-Require Import VST.msl.functors.
-
-Import CovariantFunctor.
-Import CovariantFunctorLemmas.
-Import CovariantFunctorGenerator.
-
-Local Open Scope nat_scope.
-
-Module Type TY_FUNCTOR.
-  Parameter F : functor.
-
-  Parameter T : Type.
-  Parameter T_bot : T.
-
-  Parameter other : Type.
-End TY_FUNCTOR.
-
-Module Type KNOT.
-  Declare Module TF:TY_FUNCTOR.
-  Import TF.
-
-  Parameter knot : Type.
-
-  Parameter ag_knot : ageable knot.
-  #[global] Existing Instance ag_knot.
-  #[global] Existing Instance ag_prod.
-
-  Definition predicate := (knot * other) -> T.
-
-  Parameter squash : (nat * F predicate) -> knot.
-  Parameter unsquash : knot -> (nat * F predicate).
-
-  Definition approx (n:nat) (p:predicate) : predicate :=
-     fun w => if Compare_dec.le_gt_dec n (level w) then T_bot else p w.
-
-  Axiom squash_unsquash : forall x, squash (unsquash x) = x.
-  Axiom unsquash_squash : forall n x', unsquash (squash (n,x')) = (n,fmap F (approx n) x').
-
-
-  Axiom knot_level : forall k:knot,
-    level k = fst (unsquash k).
-
-  Axiom knot_age1 : forall k:knot,
-    age1 k =
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-
-End KNOT.
-
-Module Knot (TF':TY_FUNCTOR) : KNOT with Module TF:=TF'.
-  Module TF := TF'.
-  Import TF.
-
-  (* Put the discrete pointed order on rhs *)
-  Inductive leT : T -> T -> Prop :=
-   | leT_refl : forall t, leT t t
-   | leT_bot: forall t, leT T_bot t.
-
-  Lemma leT_asym: forall t t',
-    leT t t' -> leT t' t -> t = t'.
-  Proof.
-    intros.
-    inversion H; subst; auto.
-    inversion H0; subst; auto.
-  Qed.
-
-  Fixpoint sinv (n: nat) : Type :=
-    match n with
-      | O => unit
-      | S n => prodT (sinv n) ((F (sinv n) * other) -> T)
-    end.
-
-  Fixpoint floor (m:nat) (n:nat) (p:sinv (m+n)) : sinv n :=
-    match m as m' return forall (p : sinv (m'+n)), sinv n with
-    | O => fun p => p
-    | S m' => fun p => floor m' n (fst p)
-    end p.
-
-  Definition knot := { n:nat & F (sinv n) }.
-
-  Definition predicate := knot * other -> T.
-
-  Fixpoint stratify (n:nat) (Q:predicate) {struct n} : sinv n :=
-    match n as n' return sinv n' with
-    | O => tt
-    | S n' => ( stratify n' Q, fun v => Q (existT (F oo sinv) n' (fst v),snd v) )
-    end.
-
-  Lemma decompose_nat : forall (x y:nat), { m:nat & y = (m + S x) } + { ge x y }.
-  Proof.
-    intros x y; revert x; induction y; simpl; intros.
-    right; auto with arith.
-    destruct (IHy x) as [[m H]|H].
-    left; exists (S m); lia.
-    destruct (Peano_dec.eq_nat_dec x y).
-    left; exists O; lia.
-    right; lia.
-  Qed.
-
-  Definition unstratify (n:nat) (p:sinv n) : predicate := fun w =>
-    match w with (existT _ nw w',e) =>
-      match decompose_nat nw n with
-        | inleft (existT _ m Hm) => snd (floor m (S nw) (eq_rect  n _ p (m + S nw) Hm)) (w', e)
-        | inright H => T_bot
-      end
-    end.
-
-  Definition proof_irr_nat := eq_proofs_unicity Peano_dec.dec_eq_nat.
-  Arguments proof_irr_nat [x] [y] _ _.
-
-  Lemma floor_shuffle:
-    forall (m1 n : nat)
-      (p1 : sinv (m1 + S n)) (H1 : (m1 + S n) = (S m1 + n)),
-      floor (S m1) n (eq_rect (m1 + S n) sinv p1 (S m1 + n) H1) = fst (floor m1 (S n) p1).
-  Proof.
-    intros.
-    remember (fst (floor m1 (S n) p1)) as p.
-    revert n p1 H1 p Heqp.
-    induction m1; simpl; intros.
-    replace H1 with (refl_equal (S n)) by (apply proof_irr_nat); simpl; auto.
-    assert (m1 + S n = S m1 + n) by lia.
-    destruct p1 as [p1 f'].
-    generalize (IHm1 n p1 H p Heqp).
-    simpl.
-    clear.
-    revert H1; generalize H.
-    revert p1 f'.
-    rewrite H.
-    simpl; intros.
-    replace H1 with (refl_equal (S (S (m1 + n)))) by (apply proof_irr_nat).
-    simpl.
-    replace H0 with (refl_equal (S (m1+n))) in H2 by (apply proof_irr_nat).
-    simpl in H2.
-    trivial.
-  Qed.
-
-  Lemma stratify_unstratify_more : forall n m1 m2 p1 p2,
-    floor m1 n p1 = floor m2 n p2 ->
-
-    (stratify n oo unstratify (m1+n)) p1 =
-    (stratify n oo unstratify (m2+n)) p2.
-  Proof.
-    unfold compose; induction n; simpl; intros; auto.
-    apply injective_projections; simpl; trivial.
-
-    assert ((m1 + S n) =  (S m1 + n)) by lia.
-    assert ((m2 + S n) =  (S m2 + n)) by lia.
-    assert (floor (S m1) n (eq_rect (m1 + S n) _ p1 _ H0) = floor (S m2) n (eq_rect (m2 + S n) _ p2 _ H1)).
-    do 2 rewrite floor_shuffle.
-    congruence.
-    generalize (IHn (S m1) (S m2) _ _ H2).
-    clear.
-    generalize H0 H1.
-    revert p1 p2.
-    rewrite H0; clear H0.
-    rewrite H1; clear H1.
-    intros p1 p2 H1 H2.
-    replace H1 with (refl_equal (S m1 + n)) by (apply proof_irr_nat).
-    replace H2 with (refl_equal (S m2 + n)) by (apply proof_irr_nat).
-    simpl; auto.
-
-    apply extensionality; intro v.
-    unfold unstratify.
-    destruct (decompose_nat n (m2 + S n)) as [[r Hr]|Hr].
-    2: exfalso; lia.
-    destruct (decompose_nat n (m1 + S n)) as [[s Hs]|Hs].
-    2: exfalso; lia.
-    assert (m2 = r) by lia; subst r.
-    assert (m1 = s) by lia; subst s.
-    simpl.
-    replace Hr with (refl_equal (m2 + S n)) by (apply proof_irr_nat).
-    replace Hs with (refl_equal (m1 + S n)) by (apply proof_irr_nat).
-    simpl.
-    rewrite H; auto.
-  Qed.
-
-  Lemma stratify_unstratify : forall n,
-         stratify n oo unstratify n = id (sinv n).
-  Proof.
-    unfold id, compose; intro n; extensionality p; revert n p.
-    induction n.
-
-    intros; destruct p; auto.
-
-    simpl; intros [p f].
-    apply injective_projections; simpl; trivial.
-
-    replace (stratify n (unstratify (S n) (p,f))) with
-            (stratify n (unstratify n p)); auto.
-    replace (stratify n (unstratify n p)) with
-      ((stratify n oo unstratify (0+n)) p) by trivial.
-    rewrite (stratify_unstratify_more _ 0 1 p (p,f)); trivial.
-
-    extensionality v.
-
-    destruct (decompose_nat n (S n)) as [[r Hr]|?]; auto.
-    assert (r = O) by lia; subst r.
-    simpl in *.
-    replace Hr with (refl_equal (S n)) by (apply proof_irr_nat); simpl; auto.
-    destruct v; auto.
-
-    exfalso.
-    lia.
-  Qed.
-
-  Lemma unstratify_stratify1 : forall n (p:predicate) w,
-    leT ((unstratify n oo stratify n) p w) (p w).
-  Proof.
-    unfold compose; induction n; simpl; intros; unfold unstratify.
-
-    (* 0 case *)
-    destruct w as [nw rm]; simpl.
-    destruct nw as [nw e].
-    destruct (decompose_nat nw O) as [[r Hr]|?].
-    exfalso; lia.
-    apply leT_bot.
-
-    (* S n case *)
-    case_eq w; intros nw rm Hrm.
-    destruct nw as [nw e].
-    destruct (decompose_nat nw (S n)) as [[r Hr]|?]; try (apply lt_rhs_top).
-    destruct r; simpl.
-
-    assert (n = nw) by lia.
-    subst nw.
-    simpl in Hr.
-    replace Hr with (refl_equal (S n)) by apply proof_irr_nat; simpl.
-    unfold compose.
-    destruct w.
-    apply leT_refl.
-
-    simpl in Hr.
-    assert (n = r + S nw) by lia.
-    revert Hr; subst n.
-    intro Hr.
-    replace Hr with (refl_equal (S (r+S nw))) by apply proof_irr_nat; simpl.
-    clear Hr.
-
-    generalize (IHn p w).
-    unfold unstratify.
-    rewrite Hrm.
-    destruct (decompose_nat nw (r + S nw)) as [[x Hx]|?].
-    assert (x = r) by lia; subst x.
-    replace Hx with (refl_equal (r + S nw)) by apply proof_irr_nat.
-    simpl; auto.
-    exfalso; lia.
-    apply leT_bot.
-  Qed.
-
-  Lemma unstratify_stratify2 : forall n p w,
-     projT1 (fst w) < n ->
-        leT (p w) ((unstratify n oo stratify n) p w).
-  Proof.
-    unfold compose.
-    induction n; simpl; intros.
-
-    (* 0 case *)
-    inversion H.
-
-    (* S n case *)
-    unfold unstratify.
-    case_eq w; intros [m rm] e Hw.
-    assert (projT1 (fst w) = m).
-    rewrite Hw; auto.
-
-    destruct (decompose_nat m (S n)) as [[r Hr]|?].
-    destruct r; simpl.
-
-    assert (n = m) by lia.
-    move H0 after H1.
-    subst m. fold sinv. simpl in Hr. rewrite (proof_irr_nat Hr (refl_equal _)). clear Hr.
-    simpl.
-    unfold compose.
-    rewrite <- Hw.
-    apply leT_refl.
-
-    simpl in Hr.
-    assert (n = r + S m) by lia.
-    revert Hr; subst n.
-    intro Hr.
-    replace Hr with (refl_equal (S (r+S m))) by apply proof_irr_nat; simpl.
-    clear Hr.
-    rewrite H0 in H.
-    assert (m < (r +  S m)) by lia.
-    specialize ( IHn p w).
-    rewrite H0 in IHn.
-    specialize ( IHn H1).
-    revert IHn.
-    unfold unstratify.
-    rewrite Hw.
-    destruct (decompose_nat m (r + S m)) as [[x Hx]|?].
-    assert (x = r) by lia; subst x.
-    replace Hx with (refl_equal (r + S m)) by apply proof_irr_nat.
-    simpl; auto.
-    exfalso; lia.
-    exfalso; lia.
-  Qed.
-
-  Lemma unstratify_stratify3 : forall n (p:predicate) w,
-    projT1 (fst w) >= n -> leT ((unstratify n oo stratify n) p w) T_bot.
-  Proof.
-    unfold compose, unstratify; intros n p w H.
-    case_eq w; intros [wn rm] e.
-    intro Hrm.
-    rewrite Hrm in H; simpl in H.
-    destruct (decompose_nat wn n) as [[r Hr]|?].
-    exfalso; lia.
-    apply leT_bot.
-  Qed.
-
-  Definition squash (x:nat * F predicate) : knot :=
-    match x with (n,y) => existT (F oo sinv) n (fmap F (stratify n) y) end.
-
-  Definition unsquash (x:knot) : (nat * F predicate) :=
-    match x with existT _ n y => (n, fmap F (unstratify n) y) end.
-
-  Definition def_knot_level (k:knot) := fst (unsquash k).
-
-  Definition def_knot_age1 (k:knot) : option knot :=
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-
-  Definition def_knot_unage (k:knot) : knot :=
-    match unsquash k with
-    | (n,x) => squash (S n,x)
-    end.
-
-  Definition approx (n:nat) (p:predicate) : predicate :=
-     fun w => if Compare_dec.le_gt_dec n (def_knot_level (fst w)) then T_bot else p w.
-
-  Lemma squash_unsquash : forall x, squash (unsquash x) = x.
-  Proof.
-    intros; destruct x as [x f]; simpl.
-    unfold compose.
-    replace (fmap F (stratify x) (fmap F (unstratify x) f)) with
-      ((fmap F (stratify x) oo fmap F (unstratify x)) f) by trivial.
-    rewrite fmap_comp.
-    replace (stratify x oo unstratify x) with (id (sinv x)).
-    rewrite fmap_id; simpl; auto.
-    unfold compose.
-    extensionality z.
-    replace (stratify x (unstratify x z)) with ((stratify x oo unstratify x) z) by trivial.
-    rewrite stratify_unstratify; auto.
-  Qed.
-
-  Lemma unsquash_squash : forall n x', unsquash (squash (n,x')) = (n,fmap F (approx n) x').
-  Proof.
-    intros.
-    simpl.
-    replace (fmap F  (unstratify n) (fmap F (stratify n) x')) with
-      ((fmap F (unstratify n) oo fmap F (stratify n)) x') by trivial.
-    rewrite fmap_comp.
-    apply injective_projections; simpl; trivial.
-    replace (unstratify n oo stratify n) with (approx n); auto.
-    extensionality p z.
-    apply leT_asym.
-
-    intuition.
-    case (Compare_dec.le_gt_dec n (def_knot_level a)); intro.
-    replace (approx n p (a, b)) with T_bot.
-    apply leT_bot.
-    unfold approx.
-    simpl.
-    case (Compare_dec.le_gt_dec n (def_knot_level a)); intro.
-    trivial.
-    exfalso.
-    lia.
-    replace (approx n p (a,b)) with (p (a,b)).
-    apply unstratify_stratify2.
-    simpl.
-    destruct a.
-    unfold level in g.
-    simpl in *.
-    auto.
-    unfold approx.
-    simpl.
-    case (Compare_dec.le_gt_dec n (def_knot_level a)); intro.
-    exfalso.
-    lia.
-    trivial.
-
-    intuition.
-    destruct (Compare_dec.le_lt_dec n (def_knot_level a)).
-    replace (approx n p (a, b)) with T_bot.
-    apply unstratify_stratify3; auto.
-    simpl.
-    destruct a.
-    unfold level in l.
-    simpl in *.
-    auto.
-    unfold approx.
-    simpl.
-    case (Compare_dec.le_gt_dec n (def_knot_level a)); auto.
-    intro.
-    exfalso.
-    lia.
-    replace (approx n p (a, b)) with (p (a, b)).
-    apply unstratify_stratify1; auto.
-    unfold approx.
-    simpl.
-    case (Compare_dec.le_gt_dec n (def_knot_level a)); auto.
-    intro.
-    exfalso.
-    lia.
-  Qed.
-
-  Lemma unsquash_inj : forall k1 k2,
-    unsquash k1 = unsquash k2 ->
-    k1 = k2.
-  Proof.
-    intros.
-    rewrite <- (squash_unsquash k1).
-    rewrite <- (squash_unsquash k2).
-    rewrite H.
-    trivial.
-  Qed.
-  Arguments unsquash_inj [k1 k2] _.
-
-  Lemma ag_knot_facts : ageable_facts knot def_knot_level def_knot_age1.
-  Proof.
-    constructor.
-
-   unfold def_knot_age1; unfold def_knot_level; simpl; intros x'.
-    case_eq (unsquash x'); intros.
-    destruct x' as [n' xx']. simpl in *. inv H.
-    exists (squash (S n, fmap F (unstratify n) xx')).
-    rewrite unsquash_squash.
-    f_equal.
-    f_equal.
-    transitivity ((fmap F (stratify n) oo fmap F (approx (S n)) oo fmap F (unstratify n)) xx'); auto.
-    do 2 rewrite fmap_comp.
-    replace (stratify n oo approx (S n) oo unstratify n) with (@id (sinv n)).
-    rewrite fmap_id. auto.
-   clear.
-    rewrite <- (stratify_unstratify n).
-    f_equal. extensionality  a w.
-    unfold approx, compose. destruct w.
-    simpl fst.
-    destruct (Compare_dec.le_gt_dec (S n) (def_knot_level k)); auto.
-    destruct k. simpl in *.
-    unfold def_knot_level in l.
-    simpl in *.
-    destruct (decompose_nat x n); auto.
-    destruct s. exfalso.
-    lia.
-
-    intros.
-    unfold def_knot_age1, def_knot_level.
-    destruct (unsquash x); simpl.
-    destruct n; intuition; try discriminate.
-
-    unfold def_knot_age1, def_knot_level; intros.
-    destruct (unsquash x).
-    destruct n; inv H; simpl; auto.
-  Qed.
-
-  Definition ag_knot : ageable knot :=
-    mkAgeable knot def_knot_level def_knot_age1 ag_knot_facts .
-  #[global] Existing Instance ag_knot.
-  #[global] Existing Instance ag_prod.
-
-
-  Lemma knot_level : forall k:knot,
-    level k = fst (unsquash k).
-  Proof (fun k => refl_equal (def_knot_level k)).
-
-  Lemma knot_age1 : forall k:knot,
-    age1 k =
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-  Proof (fun k => refl_equal (def_knot_age1 k)).
-
-End Knot.
diff --git a/msl/knot_full.v b/msl/knot_full.v
deleted file mode 100644
index 726c797da8..0000000000
--- a/msl/knot_full.v
+++ /dev/null
@@ -1,1024 +0,0 @@
-(*
- * Copyright (c) 2009-2010, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-
-(* Knots with all the bells and whistles *)
-
-Require Import VST.msl.base.
-Require Import VST.msl.ageable.
-
-Local Open Scope nat_scope.
-
-Module Type TY_FUNCTOR_FULL.
-  Parameter F : Type -> Type -> Type.
-  Parameter bimap : forall A B C D, (A -> B) -> (C -> D) -> F B C -> F A D.
-  Arguments bimap [A B C D] _ _ _.
-
-  Axiom bimap_id : forall A B, bimap (id A) (id B) = id (F A B).
-  Axiom bimap_comp : forall A B C D E F (f:B -> C) (g:A -> B) (s:F -> E) (t:E -> D),
-    bimap s f oo bimap t g = bimap (t oo s) (f oo g).
-
-  Parameter other : Type.
-
-  Parameter Rel : forall A B, F A B -> F A B -> Prop.
-
-  Parameter Rel_bimap : forall A B C D (f:A->B) (s:C->D) x y,
-    Rel D A x y ->
-    Rel C B (bimap s f x) (bimap s f y).
-  Axiom Rel_refl : forall A B x, Rel A B x x.
-  Axiom Rel_trans : forall A B x y z,
-    Rel A B x y -> Rel A B y z -> Rel A B x z.
-
-  Parameter ORel : other -> other -> Prop.
-  Axiom ORel_refl : reflexive other ORel.
-  Axiom ORel_trans : transitive other ORel.
-
-  Parameter T:Type.
-  Parameter T_bot:T.
-
-  Parameter T_rel : T -> T -> Prop.
-  Parameter T_rel_bot : forall x, T_rel T_bot x.
-  Parameter T_rel_refl : forall x, T_rel x x.
-  Parameter T_rel_trans : transitive T T_rel.
-
-End TY_FUNCTOR_FULL.
-
-Module Type KNOT_FULL.
-  Declare Module TF:TY_FUNCTOR_FULL.
-  Import TF.
-
-  Parameter knot:Type.
-  Parameter ageable_knot : ageable knot.
-  #[global] Existing Instance ageable_knot.
-
-  Parameter hered : (knot * other -> T) -> Prop.
-  Definition predicate := { p:knot * other -> T | hered p }.
-
-  Parameter squash : (nat * F predicate predicate) -> knot.
-  Parameter unsquash : knot -> (nat * F predicate predicate).
-
-  Parameter approx : nat -> predicate -> predicate.
-
-  Axiom squash_unsquash : forall k:knot, squash (unsquash k) = k.
-  Axiom unsquash_squash : forall (n:nat) (f:F predicate predicate),
-    unsquash (squash (n,f)) = (n, bimap (approx n) (approx n) f).
-
-  Axiom approx_spec : forall n p ko,
-    proj1_sig (approx n p) ko =
-     if (Compare_dec.le_gt_dec n (level (fst ko))) then T_bot else proj1_sig p ko.
-
-  Definition knot_rel (k1 k2:knot) :=
-    let (n,f) := unsquash k1 in
-    let (n',f') := unsquash k2 in
-    n = n' /\ Rel predicate predicate f f'.
-
-  Axiom knot_age1 : forall k:knot,
-    age1 k =
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-
-  Axiom knot_level : forall k:knot,
-    level k = fst (unsquash k).
-
-  Axiom hered_spec : forall p,
-    hered p =
-    (forall k k' k'' o o',
-      clos_refl_trans _ age k k' ->
-      knot_rel  k' k'' ->
-      ORel o o' ->
-      T_rel (p (k,o)) (p (k'',o'))).
-
-End KNOT_FULL.
-
-Module KnotFull (TF':TY_FUNCTOR_FULL) : KNOT_FULL with Module TF:=TF'.
-  Module TF:=TF'.
-  Import TF.
-
-  Definition sinv_prod X := prod X (F X X * other -> T).
-
-  Definition guppy_sig := (fun X:Type => X * (F X X * other -> T) -> Prop).
-  Definition guppy_ty := sigT guppy_sig.
-
-  Definition guppy_step_ty (Z:guppy_ty) : Type :=
-    (sig (fun (x:sinv_prod (projT1 Z)) => projT2 Z x)).
-
-  Definition guppy_age (Z:guppy_ty) (x:guppy_step_ty Z) : projT1 Z := fst (proj1_sig x).
-  Definition guppy_unage (Z:guppy_ty)
-    (H:forall t, projT2 Z (t,fun _ => T_bot))
-    (x:projT1 Z) : guppy_step_ty Z :=
-    exist (fun z => projT2 Z z) (x, fun _ => T_bot) (H x).
-
-(*
-  Definition guppy_step_prop (Z:guppy_ty) (xf:sinv_prod (guppy_step_ty Z)) :=
-    forall (k:F (guppy_step_ty Z) (guppy_step_ty Z))
-           (k':F (projT1 Z) (projT1 Z)) (o o':other) H,
-         ORel o o' ->
-         Rel (projT1 Z) (projT1 Z) (bimap (guppy_unage Z H) (guppy_age Z) k) k' ->
-         T_rel (snd xf (k,o)) (snd (proj1_sig (fst xf)) (k',o')).
-*)
-
-  Definition guppy_step_prop (Z:guppy_ty) (xf:sinv_prod (guppy_step_ty Z)) :=
-    (forall (k:F (guppy_step_ty Z) (guppy_step_ty Z)) (o:other) H,
-         T_rel (snd xf (k,o))
-               (snd (proj1_sig (fst xf)) (bimap (guppy_unage Z H) (guppy_age Z) k,o))) /\
-    (forall (k k':F (guppy_step_ty Z) (guppy_step_ty Z)) (o o':other),
-         Rel (guppy_step_ty Z) (guppy_step_ty Z) k k' ->
-         ORel o o' ->
-         T_rel (snd xf (k,o)) (snd xf (k',o'))).
-
-  Definition guppy_step (Z:guppy_ty) : guppy_ty :=
-    existT guppy_sig (guppy_step_ty Z) (guppy_step_prop Z).
-
-  Definition guppy_base : guppy_ty :=
-    existT guppy_sig unit
-      (fun xf =>
-        (forall (k k':F unit unit) (o o':other),
-          Rel unit unit k k' ->
-          ORel o o' ->
-          T_rel (snd xf (k,o)) (snd xf (k',o')))).
-
-  Fixpoint guppy (n:nat) : guppy_ty :=
-    match n with
-    | 0    => guppy_base
-    | S n' => guppy_step (guppy n')
-    end.
-
-  Definition sinv (n:nat) : Type := projT1 (guppy n).
-  Definition sinv_prop (n:nat) : prod (sinv n) (F (sinv n) (sinv n) * other -> T) -> Prop := projT2 (guppy n).
-
-  Fixpoint floor (m:nat) (n:nat) (p:sinv (m+n)) : sinv n :=
-    match m as m' return forall (p : sinv (m'+n)), sinv n with
-    | O => fun p => p
-    | S m' => fun p => floor m' n (fst (proj1_sig p))
-    end p.
-
-  Definition knot := { n:nat & F (sinv n) (sinv n) }.
-
-  Definition sinv_age n : sinv (S n) -> sinv n := guppy_age (guppy n).
-  Program Definition sinv_unage n : sinv n -> sinv (S n) := guppy_unage (guppy n) _.
-  Next Obligation.
-    revert t; induction n; simpl; auto.
-    repeat intro.
-    apply T_rel_bot.
-    split; simpl in *; repeat intro.
-    apply T_rel_bot.
-    apply T_rel_bot.
-  Qed.
-
-  Definition F_sinv n := F (sinv n) (sinv n).
-
-  Definition age1_def (k:knot) : option knot :=
-    match k with
-      | existT _ 0 f => None
-      | existT _ (S m) f => Some
-          (existT F_sinv m (bimap (sinv_unage m) (sinv_age m) f))
-    end.
-
-  Definition age_def x y := age1_def x = Some y.
-
-  Inductive knot_rel_inner : knot -> knot -> Prop :=
-    | intro_krel : forall n (f f':F_sinv n),
-         Rel _ _ f f' ->
-         knot_rel_inner (existT (F_sinv) n f) (existT (F_sinv) n f').
-
-  Definition hered (p:knot * other -> T) : Prop :=
-    forall k k' k'' o o',
-      clos_refl_trans _ age_def k k' ->
-      knot_rel_inner k' k'' -> ORel o o' ->
-      T_rel (p (k,o)) (p (k'',o')).
-
-  Definition predicate := { p:knot * other -> T | hered p }.
-
-  Definition app_sinv (n:nat) (p:sinv (S n)) (x:F_sinv n * other) :=
-    snd (proj1_sig p) x.
-
-  Section stratifies.
-    Variable Q:knot * other -> T.
-    Variable HQ:hered Q.
-
-    Fixpoint stratifies (n:nat) : sinv n -> Prop :=
-    match n as n' return sinv n' -> Prop with
-    | 0 => fun _ => True
-    | S n' => fun (p:sinv (S n')) =>
-          stratifies n' (fst (proj1_sig p)) /\
-          forall (k:F_sinv n') (o:other), snd (proj1_sig p) (k,o) = Q (existT F_sinv n' k,o)
-    end.
-
-    Lemma stratifies_unique : forall n p1 p2,
-      stratifies n p1 ->
-      stratifies n p2 ->
-      p1 = p2.
-    Proof.
-      induction n; simpl; intuition.
-      destruct p1; destruct p2; auto.
-      destruct p1; destruct p2.
-      simpl in *; fold guppy in *.
-      cut (x = x0).
-      intros.
-      revert p p0 H2 H3.
-      rewrite <- H0.
-      intros.
-      replace p0 with p by (apply proof_irr); auto.
-      destruct x; destruct x0; simpl in *.
-      apply injective_projections; simpl.
-      apply IHn; auto.
-      extensionality; intros.
-      simpl in *.
-      destruct x as [x o].
-      destruct (H2 x o); destruct (H3 x o).
-      rewrite H2.
-      rewrite H3.
-      auto.
-    Qed.
-
-    Definition stratify (n:nat) : { x:sinv n | stratifies n x }.
-    Proof.
-      induction n.
-      exists tt; simpl; exact I.
-      assert (HX:
-        projT2 (guppy n)
-        (proj1_sig IHn, fun v : F_sinv n * other => Q (existT F_sinv n (fst v),snd v))).
-      destruct n.
-      simpl; intros.
-      eapply HQ.
-      apply rt_refl.
-      constructor; auto.
-      auto.
-      simpl; intros.
-      destruct IHn; simpl.
-      simpl in s; destruct s.
-      destruct x; simpl in *; fold guppy in *.
-      destruct x; simpl in *.
-      split; hnf; simpl; intros.
-      rewrite H0.
-      eapply HQ.
-      apply rt_step.
-      hnf; simpl.
-      reflexivity.
-      constructor; auto.
-      unfold sinv_unage.
-      replace (sinv_unage_obligation_1 n) with H1.
-      unfold sinv_age.
-      apply Rel_refl.
-      apply proof_irr.
-      apply ORel_refl.
-      eapply HQ.
-      apply rt_refl.
-      constructor; auto.
-      auto.
-
-      exists ((exist (fun x => projT2 (guppy n) x) ( proj1_sig IHn, fun v:F_sinv n * other => Q (existT (F_sinv) n (fst v),snd v) ) HX)).
-      simpl; split; auto.
-      destruct IHn; auto.
-    Qed.
-  End stratifies.
-
-  Lemma decompose_nat : forall (x y:nat), { m:nat & y = (m + S x) } + { ge x y }.
-  Proof.
-    intros x y; revert x; induction y; simpl; intros.
-    right; auto with arith.
-    destruct (IHy x) as [[m H]|H].
-    left; exists (S m); lia.
-    destruct (Peano_dec.eq_nat_dec x y).
-    left; exists O; lia.
-    right; lia.
-  Qed.
-
-  Definition unstratify (n:nat) (p:sinv n) : knot * other -> T := fun w =>
-    match w with (existT _ nw w',o) =>
-      match decompose_nat nw n with
-        | inleft (existT _ m Hm) => snd (proj1_sig (floor m (S nw) (eq_rect  n _ p (m + S nw) Hm))) (w',o)
-        | inright H => T_bot
-      end
-    end.
-
-  Lemma floor_shuffle:
-    forall (m1 n : nat)
-      (p1 : sinv (m1 + S n)) (H1 : (m1 + S n) = (S m1 + n)),
-      floor (S m1) n (eq_rect (m1 + S n) sinv p1 (S m1 + n) H1) = fst (proj1_sig (floor m1 (S n) p1)).
-  Proof.
-    intros.
-    remember (fst (proj1_sig (floor m1 (S n) p1))) as p.
-    fold guppy in *.
-    revert n p1 H1 p Heqp.
-    induction m1; simpl; intros.
-    replace H1 with (refl_equal (S n)) by (apply proof_irr); simpl; auto.
-    assert (m1 + S n = S m1 + n) by lia.
-    destruct p1 as [[p1 f'] Hp1]; simpl in *; fold guppy in *.
-    generalize (IHm1 n p1 H p Heqp).
-    clear.
-    revert Hp1 H1; generalize H.
-    revert p1 f'.
-    rewrite H.
-    simpl; intros.
-    replace H1 with (refl_equal (S (S (m1 + n)))) by (apply proof_irr).
-    simpl.
-    replace H0 with (refl_equal (S (m1+n))) in H2 by (apply proof_irr).
-    simpl in H2.
-    trivial.
-  Qed.
-
-  Lemma unstratify_hered : forall n p,
-    hered (unstratify n p).
-  Proof.
-    intros.
-    hnf; intros.
-    apply T_rel_trans with (unstratify n p (k',o)).
-    clear o' H0 H1.
-    induction H.
-    hnf in H; simpl in H.
-    destruct x; simpl in H.
-    destruct x; try discriminate.
-    assert (y =
-      (existT (F_sinv) x (bimap (sinv_unage x) (sinv_age x) f))).
-    inversion H; auto.
-    subst y.
-    unfold unstratify.
-    case_eq (decompose_nat (S x) n); intros.
-    destruct s.
-    case_eq (decompose_nat x n); intros.
-    destruct s.
-    destruct n.
-    exfalso; lia.
-    assert (S x0 = x1) by lia; subst x1.
-    revert H1.
-    generalize e e0; revert p; rewrite e; intros.
-    rewrite floor_shuffle.
-    replace e1 with (refl_equal (x0 + S (S x)));
-      simpl eq_rect.
-    2: apply proof_irr.
-    revert H1.
-    generalize (floor x0 (S (S x)) p).
-    intros [[s' fs] Hs] H1; simpl in *; fold guppy in *.
-    destruct Hs.
-    simpl in H2.
-    eapply H2; auto.
-    exfalso.
-    lia.
-    apply T_rel_bot.
-    apply T_rel_refl.
-    eapply T_rel_trans; eauto.
-
-    clear H.
-    inv H0.
-    simpl.
-    destruct (decompose_nat n0 n); [ | apply T_rel_bot ].
-    destruct s; simpl.
-    destruct (floor x (S n0) (eq_rect n sinv p (x +S n0) e)); simpl.
-    destruct n0; simpl in x0; destruct x0; simpl.
-    apply p0; auto.
-    apply p0; auto.
-  Qed.
-
-  Lemma unstratify_Q : forall n (p:sinv n) Q,
-    stratifies Q n p ->
-    forall (k:knot) (o:other),
-      projT1 k < n ->
-      (unstratify n p (k,o) = Q (k,o)).
-  Proof.
-    intros.
-    unfold unstratify.
-    destruct k.
-    destruct (decompose_nat x n).
-    destruct s.
-    simpl in H0.
-    2: simpl in *; exfalso; lia.
-    clear H0.
-    revert p H.
-    generalize e.
-    rewrite e.
-    intros.
-    replace e0 with (refl_equal (x0 + S x)) by apply proof_irr.
-    simpl.
-    clear e e0.
-    revert p H.
-    induction x0; simpl; intros.
-    destruct H.
-    auto.
-    destruct H.
-    apply IHx0.
-    auto.
-  Qed.
-
-  Lemma stratifies_unstratify_more :
-    forall (n m1 m2:nat) (p1:sinv (m1+n)) (p2:sinv (m2+n)),
-      floor m1 n p1 = floor m2 n p2 ->
-      (stratifies (unstratify (m1+n) p1) n (floor m1 n p1) ->
-       stratifies (unstratify (m2+n) p2) n (floor m2 n p2)).
-  Proof.
-    induction n; intuition.
-    split.
-    assert (m2 + S n = S m2 + n) by lia.
-    erewrite <- floor_shuffle.
-    instantiate (1:=H1).
-    replace (unstratify (m2 + S n) p2)
-      with (unstratify (S m2 + n) (eq_rect (m2 + S n) sinv p2 (S m2 + n) H1)).
-    assert (m1 + S n = S m1 + n) by lia.
-    eapply (IHn (S m1) (S m2)
-      (eq_rect (m1 + S n) sinv p1 (S m1 + n) H2)).
-    rewrite floor_shuffle.
-    rewrite floor_shuffle.
-    rewrite H; auto.
-    clear - H0.
-    rewrite floor_shuffle.
-    simpl in H0.
-    destruct H0.
-    clear H0.
-    revert p1 H.
-    generalize H2.
-    rewrite <- H2.
-    intros.
-    replace H0 with (refl_equal (m1 + S n)) by apply proof_irr; auto.
-    clear.
-    revert p2.
-    generalize H1.
-    rewrite H1.
-    intros.
-    replace H0 with (refl_equal (S m2 + n)) by apply proof_irr; auto.
-
-    intros.
-    simpl.
-    destruct (decompose_nat n (m2 + S n)).
-    destruct s.
-    assert (m2 = x).
-    lia.
-    subst x.
-    replace e with (refl_equal (m2 + S n)).
-    simpl; tauto.
-    apply proof_irr.
-    exfalso; lia.
-  Qed.
-
-  Lemma stratify_unstratify : forall n p H,
-    proj1_sig (stratify (unstratify n p) H n) = p.
-  Proof.
-    intros.
-    apply stratifies_unique with (unstratify n p).
-    destruct (stratify _ H n).
-    simpl; auto.
-    clear H.
-    revert p; induction n.
-    simpl; intros; auto.
-    intros.
-    simpl; split.
-
-    assert (stratifies (unstratify n (fst (proj1_sig p))) n (fst (proj1_sig p))).
-    apply IHn.
-    apply (stratifies_unstratify_more n 0 1 (fst (proj1_sig p)) p).
-    simpl; auto.
-    auto.
-
-    intros.
-    destruct (decompose_nat n (S n)).
-    destruct s.
-    assert (x = 0) by lia.
-    subst x.
-    simpl.
-    simpl in e.
-    replace e with (refl_equal (S n)) by apply proof_irr.
-    simpl.
-    split; auto.
-    exfalso; lia.
-  Qed.
-
-  Definition strat (n:nat) (p:predicate) : sinv n :=
-    proj1_sig (stratify (proj1_sig p) (proj2_sig p) n).
-
-  Definition unstrat (n:nat) (p:sinv n) : predicate :=
-    exist hered (unstratify n p) (unstratify_hered n p).
-
-  Definition squash (x:nat * F predicate predicate) : knot :=
-    match x with (n,f) => existT (F_sinv) n (bimap (unstrat n) (strat n) f) end.
-
-  Definition unsquash (k:knot) : nat * F predicate predicate :=
-    match k with existT _ n f => (n, bimap (strat n) (unstrat n) f) end.
-
-  Definition knot_level_def (k:knot) : nat :=
-    fst (unsquash k).
-
-  Definition knot_age1_def (k:knot) : option knot :=
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-
-  Definition knot_unage_def (k:knot) :=
-    let (n,k) := unsquash k in squash (S n,k).
-
-  Program Definition approx (n:nat) (p:predicate) : predicate :=
-    fun w => if (Compare_dec.le_gt_dec n (knot_level_def (fst w))) then T_bot else proj1_sig p w.
-  Next Obligation.
-    hnf; simpl; intros.
-    destruct (Compare_dec.le_gt_dec n (knot_level_def k)).
-    apply T_rel_bot.
-    destruct (Compare_dec.le_gt_dec n (knot_level_def k'')).
-    exfalso.
-    cut (knot_level_def k'' <= knot_level_def k).
-    lia.
-    replace (knot_level_def k'') with (knot_level_def k').
-    clear -H; induction H.
-    hnf in H.
-    unfold age1_def in H.
-    destruct x; destruct y; simpl.
-    destruct x; try discriminate.
-    inv H.
-    simpl.
-    unfold knot_level_def; simpl; auto.
-    auto.
-    eapply PeanoNat.Nat.le_trans; eauto.
-    inv H0.
-    unfold knot_level_def; simpl; auto.
-
-    destruct p as [p Hp]; simpl.
-    eapply Hp; eauto.
-  Qed.
-
-  Lemma strat_unstrat : forall n,
-    strat n oo unstrat n = id (sinv n).
-  Proof.
-    intros; extensionality p.
-    unfold compose, id.
-    unfold strat, unstrat.
-    simpl.
-    rewrite stratify_unstratify.
-    auto.
-  Qed.
-
-  Lemma predicate_eq : forall (p1 p2:predicate),
-    proj1_sig p1 = proj1_sig p2 ->
-    p1 = p2.
-  Proof.
-    intros; destruct p1; destruct p2; simpl in H.
-    subst x0.
-    replace h0 with h by apply proof_irr.
-    auto.
-  Qed.
-
-  Lemma unstrat_strat : forall n,
-    unstrat n oo strat n = approx n.
-  Proof.
-    intros.
-    extensionality.
-    unfold compose.
-    unfold unstrat, strat.
-    unfold approx.
-    apply predicate_eq.
-    simpl.
-    extensionality k.
-    destruct (Compare_dec.le_gt_dec n (knot_level_def (fst k))).
-    unfold unstratify.
-    destruct k.
-    destruct k.
-    unfold knot_level_def in l.
-    simpl in *.
-    destruct (decompose_nat x0 n); simpl.
-    destruct s; simpl; exfalso; lia.
-    auto.
-    destruct x as [x Hx]; simpl.
-    destruct (stratify x Hx n); simpl.
-    destruct k.
-    rewrite unstratify_Q with (Q:=x); auto.
-    unfold level in *.
-    destruct k; simpl in *; auto.
-  Qed.
-
-  Lemma squash_unsquash : forall k, squash (unsquash k) = k.
-  Proof.
-    intros.
-    destruct k; simpl.
-    f_equal.
-    change ((bimap (unstrat x) (strat x) oo (bimap (strat x) (unstrat x))) f = f).
-    rewrite bimap_comp.
-    rewrite strat_unstrat.
-    rewrite bimap_id.
-    auto.
-  Qed.
-
-  Lemma unsquash_squash : forall n f,
-    unsquash (squash (n,f)) = (n, bimap (approx n) (approx n) f).
-  Proof.
-    intros.
-    unfold unsquash, squash.
-    f_equal.
-    change ((bimap (strat n) (unstrat n) oo (bimap (unstrat n) (strat n))) f = bimap (approx n) (approx n) f).
-    rewrite bimap_comp.
-    rewrite unstrat_strat.
-    auto.
-  Qed.
-
-
-  Lemma bimap_bimap : forall A B C X Y Z (s:X->Y) (t:Y->Z) (f:B->C) (g:A->B) x,
-    bimap s f (bimap t g x) = bimap (t oo s) (f oo g) x.
-  Proof.
-    intros.
-    rewrite <- bimap_comp.
-    auto.
-  Qed.
-
-
-  Lemma strat_Sx_unstrat : forall x,
-    sinv_unage x = strat (S x) oo unstrat x.
-  Proof.
-    intros.
-    extensionality k.
-    unfold sinv_unage.
-    generalize (sinv_unage_obligation_1); intro P.
-    unfold guppy_unage.
-    unfold compose, strat, unstrat.
-    simpl.
-    apply stratifies_unique with (unstratify x k).
-    revert k.
-    induction x; simpl; intuition.
-    destruct (decompose_nat 0 0); auto.
-    destruct s; exfalso; lia.
-    eapply (stratifies_unstratify_more x 0 1).
-    simpl; reflexivity.
-    simpl.
-    simpl in *.
-    destruct (IHx (fst (proj1_sig k))); auto.
-    destruct (decompose_nat x (S x)).
-    destruct s.
-    assert (x0 = 0) by lia; subst x0.
-    simpl in *.
-    replace e with (refl_equal (S x)) by apply proof_irr; auto.
-    exfalso; lia.
-    destruct (decompose_nat x (S x)).
-    destruct s.
-    assert (x0 = 0) by lia; subst x0.
-    simpl in *.
-    destruct (decompose_nat (S x) (S x)).
-    destruct s; exfalso; lia.
-    auto.
-    destruct (decompose_nat (S x) (S x)).
-    destruct s; exfalso; lia.
-    auto.
-
-    destruct (stratify (unstratify x k) (unstratify_hered x k) (S x)).
-    simpl stratifies in s; case s; intros.
-    simpl stratifies; split; auto.
-  Qed.
-
-  Lemma strat_unstrat_Sx : forall x,
-    sinv_age x = strat x oo unstrat (S x).
-  Proof.
-    intros.
-    extensionality k.
-    unfold sinv_age, guppy_age.
-    unfold compose.
-    unfold strat, unstrat.
-    simpl.
-    apply stratifies_unique with (unstratify x (fst (proj1_sig k))).
-    revert k; induction x; simpl; auto.
-    intros.
-    split.
-    eapply (stratifies_unstratify_more x 0 1 ).
-    simpl; reflexivity.
-    simpl.
-    apply IHx.
-    intros.
-    destruct (decompose_nat x (S x)).
-    destruct s.
-    assert (x0 = 0) by lia; subst x0.
-    simpl in *.
-    replace e with (refl_equal (S x)) by apply proof_irr; simpl.
-    tauto.
-    exfalso; lia.
-    destruct (stratify (unstratify (S x) k)
-      (unstratify_hered (S x) k) x).
-    simpl; auto.
-    cut (x0 = (fst (proj1_sig k))); intros.
-    subst x0.
-    eapply (stratifies_unstratify_more x 1 0).
-    simpl; reflexivity.
-    simpl; auto.
-    eapply stratifies_unique.
-    apply s.
-    eapply (stratifies_unstratify_more x 0 1).
-    simpl; reflexivity.
-    simpl.
-    generalize (fst (proj1_sig k) : sinv x).
-    clear.
-    induction x; simpl; intuition.
-    eapply (stratifies_unstratify_more x 0 1).
-    simpl; reflexivity.
-    simpl.
-    apply IHx.
-    destruct (decompose_nat x (S x)).
-    destruct s0.
-    assert (x0 = 0) by lia; subst.
-    simpl in *.
-    replace e with (refl_equal (S x)); simpl; auto.
-    apply proof_irr.
-    exfalso; lia.
-  Qed.
-
-  Lemma age1_eq : forall k,
-    age1_def k = knot_age1_def k.
-  Proof.
-    intros.
-    unfold knot_age1_def.
-    case_eq (unsquash k); intros.
-    case_eq k; intros.
-    simpl.
-    assert (n = x).
-    subst k.
-    inv H; auto.
-    subst x.
-    destruct n; auto.
-    f_equal.
-    f_equal.
-
-    rewrite strat_Sx_unstrat.
-    rewrite strat_unstrat_Sx.
-    rewrite <- bimap_comp.
-    unfold compose.
-    f_equal.
-    subst k.
-    inv H; auto.
-  Qed.
-
-  Lemma unsquash_inj : forall k1 k2,
-    unsquash k1 = unsquash k2 ->
-    k1 = k2.
-  Proof.
-    intros.
-    rewrite <- (squash_unsquash k1).
-    rewrite <- (squash_unsquash k2).
-    rewrite H.
-    trivial.
-  Qed.
-  Arguments unsquash_inj [k1 k2] _.
-
-
-  Lemma pred_ext : forall (p1 p2:predicate),
-    (forall x, proj1_sig p1 x = proj1_sig p2 x) ->
-    p1 = p2.
-  Proof.
-    intros.
-    destruct p1 as [p1 Hp1]; destruct p2 as [p2 Hp2].
-    simpl in *.
-    assert (p1 = p2).
-    extensionality x; auto.
-    subst p2.
-    replace Hp2 with Hp1; auto.
-    apply proof_irr.
-  Qed.
-
-  Lemma approx_spec : forall n p ko,
-    proj1_sig (approx n p) ko =
-     if (Compare_dec.le_gt_dec n (knot_level_def (fst ko))) then T_bot else proj1_sig p ko.
-  Proof.
-    intros; simpl; auto.
-  Qed.
-
-  Lemma ag_knot_facts : ageable_facts knot knot_level_def knot_age1_def.
-  Proof.
-    constructor.
-
-    unfold knot_age1_def; unfold knot_level_def; simpl; intros x'.
-    case_eq (unsquash x'); intros.
-    destruct x'.
-    exists (squash (S x, TF'.bimap (strat x) (unstrat x) f0)).
-    rewrite unsquash_squash.
-    f_equal. f_equal.
-    clear.
-    transitivity ((TF'.bimap (unstrat x) (strat x) oo TF'.bimap (approx (S x)) (approx (S x)) oo TF'.bimap (strat x) (unstrat x)) f0); auto.
-    do 2 rewrite TF'.bimap_comp.
-    rewrite compose_assoc.
-    replace (strat x oo approx (S x) oo unstrat x) with (@id (sinv x)).
-    rewrite TF'.bimap_id. auto.
-    rewrite <- (strat_unstrat x).
-    f_equal.
-    extensionality a.
-    unfold compose, approx.
-    case_eq (unstrat x a); intros.
-    match goal with
-      [ |- _ = exist _ ?X _ ] =>
-      assert (x0 = X)
-    end.
-   2:{
-    generalize (approx_obligation_1 (S x)
-      (exist (fun p => hered p) x0 h)).
-    rewrite <- H0.
-    intros. f_equal.
-   }
-    extensionality.
-    destruct x1.
-    unfold unstrat in H.
-    inv H.
-    destruct k.
-    unfold unstratify.
-    unfold knot_level_def.
-    simpl fst.
-    destruct (decompose_nat x0 x).
-    destruct s.
-    destruct (Compare_dec.le_gt_dec (S x) x0).
-    exfalso; lia.
-    simpl.
-    destruct (decompose_nat x0 x).
-    destruct s.
-    assert (x1 = x2) by lia.
-    subst x2.
-    replace e0 with e by apply proof_irr.
-    auto.
-    exfalso; lia.
-    destruct (Compare_dec.le_gt_dec (S x) x0); auto.
-    simpl.
-    destruct (decompose_nat x0 x); auto.
-    destruct s. exfalso. lia.
-
-    intro.
-    unfold knot_age1_def, knot_level_def.
-    case_eq (unsquash x); intros.
-    destruct n; simpl; intuition;
-      discriminate.
-
-    intros.
-    unfold knot_age1_def, knot_level_def in *.
-    case_eq (unsquash x); intros; rewrite H0 in H.
-    destruct n; try discriminate; simpl.
-    inv H; simpl; auto.
-  Qed.
-
-  Definition ageable_knot : ageable knot :=
-    mkAgeable knot knot_level_def knot_age1_def ag_knot_facts.
-  #[global] Existing Instance ageable_knot.
-
-  Definition knot_rel (k1 k2:knot) :=
-    let (n,f) := unsquash k1 in
-    let (n',f') := unsquash k2 in
-    n = n' /\ Rel predicate predicate f f'.
-
-  Lemma hered_spec : forall p,
-    hered p =
-    (forall k k' k'' o o',
-      clos_refl_trans _ age k k' ->
-      knot_rel  k' k'' ->
-      ORel o o' ->
-      T_rel (p (k,o)) (p (k'',o'))).
-  Proof.
-    intros.
-    apply prop_ext.
-    intuition.
-    eapply H.
-    instantiate (1:=k').
-    clear -H0; induction H0; auto.
-    apply rt_step.
-    unfold age_def.
-    rewrite age1_eq.
-    auto.
-    eapply rt_trans; eauto.
-    destruct k'; destruct k''.
-    unfold knot_rel, unsquash in H1.
-    destruct H1; subst.
-    constructor.
-    apply (Rel_bimap _ _ _ _ (strat x0) (unstrat x0)) in H3.
-    change f with (id _ f).
-    change f0 with (id _ f0).
-    rewrite <- bimap_id.
-    rewrite <- (strat_unstrat x0).
-    rewrite <- bimap_comp.
-    auto.
-    assumption.
-
-    hnf; intros.
-    apply (H k k' k''); auto.
-    clear -H0; induction H0; auto.
-    apply rt_step.
-    hnf.
-    rewrite <- age1_eq; auto.
-    eapply rt_trans; eauto.
-
-    destruct k'; destruct k''.
-    inv H1.
-    simpl.
-    hnf; split; auto.
-    apply Eqdep_dec.inj_pair2_eq_dec in H5; auto.
-    apply Eqdep_dec.inj_pair2_eq_dec in H7; auto.
-    subst.
-    apply Rel_bimap; auto.
-    exact Peano_dec.eq_nat_dec.
-    exact Peano_dec.eq_nat_dec.
-  Qed.
-
-  Lemma knot_age1 : forall k:knot,
-    age1 k =
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-  Proof.
-    intros; reflexivity.
-  Qed.
-
-  Lemma knot_level : forall k:knot,
-    level k = fst (unsquash k).
-  Proof.
-    intros; reflexivity.
-  Qed.
-
-End KnotFull.
-
-
-Module KnotFull_Lemmas (K : KNOT_FULL).
-  Import K.TF.
-  Import K.
-
-  Lemma unsquash_inj : forall k1 k2,
-    unsquash k1 = unsquash k2 ->
-    k1 = k2.
-  Proof.
-    intros.
-    rewrite <- (squash_unsquash k1).
-    rewrite <- (squash_unsquash k2).
-    rewrite H.
-    trivial.
-  Qed.
-  Arguments unsquash_inj [k1 k2] _.
-
-  Lemma squash_surj : forall k, exists n, exists Fp,
-    squash (n, Fp) = k.
-  Proof.
-    intros.
-    remember (unsquash k).
-    destruct p.
-    exists n.
-    exists f.
-    rewrite Heqp.
-    rewrite squash_unsquash.
-    trivial.
-  Qed.
-
-  Lemma unsquash_approx : forall k n Fp,
-    unsquash k = (n, Fp) ->
-    Fp = bimap (approx n) (approx n) Fp.
-  Proof.
-    intros.
-    generalize H; intro.
-    rewrite <- (squash_unsquash k) in H.
-    rewrite H0 in H.
-    rewrite unsquash_squash in H.
-    inversion H.
-    rewrite H2.
-    symmetry.
-    trivial.
-  Qed.
-  Arguments unsquash_approx [k n Fp] _.
-
-  Lemma pred_ext : forall (p1 p2:predicate),
-    (forall x, proj1_sig p1 x = proj1_sig p2 x) ->
-    p1 = p2.
-  Proof.
-    intros.
-    destruct p1 as [p1 Hp1]; destruct p2 as [p2 Hp2].
-    simpl in *.
-    assert (p1 = p2).
-    extensionality x; auto.
-    subst p2.
-    replace Hp2 with Hp1; auto.
-    apply proof_irr.
-  Qed.
-
-  Lemma approx_approx1 : forall m n,
-    approx n = approx n oo approx (m+n).
-  Proof.
-    intros.
-    extensionality p.
-    apply pred_ext.
-    intros [k o].
-    unfold compose.
-    repeat rewrite approx_spec.
-    simpl.
-    destruct (Compare_dec.le_gt_dec n (level k)); auto.
-    destruct (Compare_dec.le_gt_dec (m+n) (level k)); auto.
-    exfalso; lia.
-  Qed.
-
-  Lemma approx_approx2 : forall m n,
-    approx n = approx (m+n) oo approx n.
-  Proof.
-    intros.
-    extensionality p.
-    apply pred_ext.
-    intros [k o].
-    unfold compose.
-    repeat rewrite approx_spec.
-    simpl.
-    destruct (Compare_dec.le_gt_dec (m+n) (level k)); auto.
-    destruct (Compare_dec.le_gt_dec n (level k)); auto.
-    exfalso; lia.
-  Qed.
-
-
-
-  Lemma bimap_bimap : forall A B C X Y Z (s:X->Y) (t:Y->Z) (f:B->C) (g:A->B) x,
-    bimap s f (bimap t g x) = bimap (t oo s) (f oo g) x.
-  Proof.
-    intros.
-    rewrite <- bimap_comp.
-    auto.
-  Qed.
-End KnotFull_Lemmas.
diff --git a/msl/knot_full_sa.v b/msl/knot_full_sa.v
deleted file mode 100644
index 8dc6e3fbb8..0000000000
--- a/msl/knot_full_sa.v
+++ /dev/null
@@ -1,513 +0,0 @@
-(*
- * Copyright (c) 2009-2011, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-
-Require Import VST.msl.base.
-Local Open Scope nat_scope.
-
-Require Import VST.msl.ageable.
-Require Import VST.msl.functors.
-Require Import VST.msl.sepalg.
-Require Import VST.msl.sepalg_functors.
-Require Import VST.msl.sepalg_generators.
-Require Import VST.msl.age_sepalg.
-Require Import VST.msl.predicates_hered.
-Require Import VST.msl.predicates_sl.
-Require Import VST.msl.knot_full_variant.
-
-Module Type KNOT_FULL_BASIC_INPUT.
-  Import MixVariantFunctor.
-  Parameter F: functor.
-
-  Parameter Rel : forall A, relation (F A).
-
-  Parameter Rel_fmap : forall A B (f1: A->B) (f2:B->A) x y,
-    Rel A x y ->
-    Rel B (fmap F f1 f2 x) (fmap F f1 f2 y).
-  Axiom Rel_refl : forall A x, Rel A x x.
-  Axiom Rel_trans : forall A x y z,
-    Rel A x y -> Rel A y z -> Rel A x z.
-
-End KNOT_FULL_BASIC_INPUT.
-
-Module Type KNOT_FULL_SA_INPUT.
-  Declare Module KI: KNOT_FULL_BASIC_INPUT.
-  Import MixVariantFunctor.
-  Import KI.
-
-  Parameter Join_F: forall A, Join (F A). #[global] Existing Instance Join_F.
-  Parameter paf_F : pafunctor F Join_F.
-  Parameter Perm_F: forall A, Perm_alg (F A).
-  Parameter Sep_F: forall A, Sep_alg (F A).
-
-  Axiom Rel_join_commut : forall {A} {x y z z' : F A}, join x y z ->
-    Rel A z z' -> exists x', Rel A x x' /\ join x' y z'.
-  Axiom join_Rel_commut : forall {A} {x x' y' z' : F A}, Rel A x x' ->
-    join x' y' z' -> exists z, join x y' z /\ Rel A z z'.
-  Axiom id_exists : forall {A} (x : F A), exists e,
-    identity e /\ unit_for e x.
-
-End KNOT_FULL_SA_INPUT.
-
-Module Type KNOT_BASIC.
-  Declare Module KI:KNOT_FULL_BASIC_INPUT.
-  Import MixVariantFunctor.
-  Import KI.
-  Parameter knot: Type.
-  Parameter ageable_knot : ageable knot.
-  #[global] Existing Instance ageable_knot.
-
-  Parameter predicate: Type.
-  Parameter squash : (nat * F predicate) -> knot.
-  Parameter unsquash : knot -> (nat * F predicate).
-  Parameter approx : nat -> predicate -> predicate.
-
-  Axiom squash_unsquash : forall k:knot, squash (unsquash k) = k.
-
-  Axiom unsquash_squash : forall (n:nat) (f:F predicate),
-    unsquash (squash (n,f)) = (n, fmap F (approx n) (approx n) f).
-
-  Axiom knot_age1 : forall k:knot,
-    age1 k =
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-
-  Axiom knot_level : forall k:knot,
-    level k = fst (unsquash k).
-
-  Parameter ext_knot : Ext_ord knot.
-  #[export] Existing Instance ext_knot.
-
-  Axiom knot_order : forall k1 k2 : knot, ext_order k1 k2 <->
-    level k1 = level k2 /\ Rel predicate (snd (unsquash k1)) (snd (unsquash k2)).
-
-End KNOT_BASIC.
-
-Module Type KNOT_BASIC_LEMMAS.
-
-  Declare Module K: KNOT_BASIC.
-  Import MixVariantFunctor.
-  Import K.KI.
-  Import K.
-
-  Axiom unsquash_inj : forall k1 k2,
-    unsquash k1 = unsquash k2 ->
-    k1 = k2.
-
-  Axiom unsquash_approx : forall k n Fp,
-    unsquash k = (n, Fp) ->
-    Fp = fmap F (approx n) (approx n) Fp.
-  Arguments unsquash_approx [k n Fp] _.
-
-  Axiom approx_approx1 : forall m n,
-    approx n = approx n oo approx (m+n).
-
-  Axiom approx_approx2 : forall m n,
-    approx n = approx (m+n) oo approx n.
-
-End KNOT_BASIC_LEMMAS.
-
-Module Type KNOT_ASSM.
-  Declare Module KI: KNOT_FULL_BASIC_INPUT.
-  Declare Module KSAI: KNOT_FULL_SA_INPUT with Module KI := KI.
-  Declare Module K: KNOT_BASIC with Module KI := KI.
-  Import MixVariantFunctor.
-  Import KI.
-  Import KSAI.
-  Import K.
-
-  Axiom approx_core : forall n (f : F predicate),
-    core(Sep_alg := Sep_F predicate) (fmap F (approx n) (approx n) f) = fmap F (approx n) (approx n) (core(Sep_alg := Sep_F predicate) f).
-
-End KNOT_ASSM.
-
-
-Module Type KNOT_FULL_SA.
-  Declare Module KI: KNOT_FULL_BASIC_INPUT.
-  Declare Module KSAI: KNOT_FULL_SA_INPUT with Module KI := KI.
-  Declare Module K: KNOT_BASIC with Module KI := KI.
-  Declare Module KL: KNOT_BASIC_LEMMAS with Module K := K.
-  Declare Module KA: KNOT_ASSM with Module KI := KI with Module KSAI := KSAI with Module K := K.
-
-  Import KI.
-  Import KSAI.
-  Import K.
-  Import KL.
-  Import KA.
-
-  Parameter Join_knot: Join knot.  #[global] Existing Instance Join_knot.
-  Parameter Perm_knot : Perm_alg knot.  #[global] Existing Instance Perm_knot.
-  Parameter Sep_knot : Sep_alg knot.  #[global] Existing Instance Sep_knot.
-  #[global] Instance Join_nat_F: Join (nat * F predicate) :=
-       Join_prod nat  (Join_equiv nat) (F predicate) _.
-  #[global] Instance Perm_nat_F : Perm_alg (nat * F predicate) :=
-    @Perm_prod nat _ _ _ (Perm_equiv _) (Perm_F _).
-  #[global] Instance Sep_nat_F : Sep_alg (nat * F predicate) :=
-    @Sep_prod nat _ _ _ _ (Perm_F predicate) (fsep_sep (Sep_equiv _)) (Sep_F predicate).
-
-  Axiom join_unsquash : forall x1 x2 x3 : knot,
-    join x1 x2 x3 = join (unsquash x1) (unsquash x2) (unsquash x3).
-  Axiom core_unsquash : forall x, core x = squash (core (unsquash x)).
-
-  Axiom asa_knot : Age_alg knot.
-
-  Axiom ea_knot : Ext_alg knot.
-
-End KNOT_FULL_SA.
-
-Module KnotFullSa
-  (KSAI': KNOT_FULL_SA_INPUT)
-  (K': KNOT_BASIC with Module KI:=KSAI'.KI)
-  (KL': KNOT_BASIC_LEMMAS with Module K:=K')
-  (KA': KNOT_ASSM with Module KI := KSAI'.KI with Module KSAI := KSAI' with Module K := K'):
-  KNOT_FULL_SA with Module KI := KSAI'.KI
-               with Module KSAI := KSAI'
-               with Module K:=K'
-               with Module KL := KL'
-               with Module KA := KA'.
-
-  Module KI := KSAI'.KI.
-  Module KSAI := KSAI'.
-  Module K := K'.
-  Module KL := KL'.
-  Module KA := KA'.
-
-  Import MixVariantFunctor.
-  Import MixVariantFunctorLemmas.
-  Import KI.
-  Import KSAI.
-  Import K.
-  Import KL.
-  Import KA.
-
-  #[global] Instance Join_nat_F: Join (nat * F predicate) :=
-       Join_prod nat  (Join_equiv nat) (F predicate) _.
-  #[global] Instance Perm_nat_F : Perm_alg (nat * F predicate) :=
-      @Perm_prod nat _ _ _ (Perm_equiv _) (Perm_F _).
-  #[global] Instance Sep_nat_F : Sep_alg (nat * F predicate) :=
-    @Sep_prod nat _ _ _ _ (Perm_F predicate) (fsep_sep (Sep_equiv _)) (Sep_F predicate).
-
-  Lemma unsquash_squash_join_hom : join_hom (unsquash oo squash).
-  Proof.
-    unfold compose.
-    intros [x1 x2] [y1 y2] [z1 z2] ?.
-    do 3 rewrite (unsquash_squash).
-    firstorder.
-    simpl in *.
-    subst y1.
-    subst z1.
-    apply (paf_join_hom paf_F); auto.
-  Qed.
-
-  #[global] Instance Join_knot : Join knot :=
-           Join_preimage knot (nat * F predicate) Join_nat_F unsquash.
-
-  Lemma join_unsquash : forall x1 x2 x3,
-    join x1 x2 x3 =
-    join (unsquash x1) (unsquash x2) (unsquash x3).
-  Proof.
-    intuition.
-  Qed.
-
-  #[global] Instance Perm_knot : Perm_alg knot :=
-    Perm_preimage _ _ _ _ unsquash squash squash_unsquash unsquash_squash_join_hom.
-
-  Lemma core_unsquash_squash : forall b, core (unsquash (squash b)) = unsquash (squash (core b)).
-  Proof.
-    intros (?, ?); simpl; rewrite !unsquash_squash; simpl.
-    pose proof approx_core n _f.
-    setoid_rewrite approx_core. reflexivity.
-  Qed.
-
-  #[global] Instance Sep_knot: Sep_alg knot :=
-    Sep_preimage _ _ _ _ unsquash squash squash_unsquash unsquash_squash_join_hom core_unsquash_squash.
-
-  Lemma core_unsquash : forall x, core x = squash (core (unsquash x)).
-  Proof.
-    auto.
-  Qed.
-
-  Lemma age_join1 :
-    forall x y z x' : K'.knot,
-      join x y z ->
-      age x x' ->
-      exists y' : K'.knot,
-        exists z' : K'.knot, join x' y' z' /\ age y y' /\ age z z'.
-  Proof.
-    intros.
-    unfold age in *; simpl in *.
-    rewrite knot_age1 in H0.
-    repeat rewrite knot_age1.
-    do 3 red in H.
-    destruct (unsquash x) as [n f].
-    destruct (unsquash y) as [n0 f0].
-    destruct (unsquash z) as [n1 f1].
-    destruct n; try discriminate.
-    inv H0.
-    simpl in H; destruct H.
-    simpl in H; destruct H.
-    subst n0 n1.
-    exists (squash (n,f0)).
-    exists (squash (n,f1)).
-    simpl in H0.
-    split; intuition. do 3  red.
-    repeat rewrite unsquash_squash.
-    split; auto. simpl snd.
-    apply (paf_join_hom paf_F); auto.
-  Qed.
-
-  Lemma age_join2 :
-    forall x y z z' : K'.knot,
-      join x y z ->
-      age z z' ->
-      exists x' : K'.knot,
-        exists y' : K'.knot, join x' y' z' /\ age x x' /\ age y y'.
-  Proof.
-    intros.
-    unfold age in *; simpl in *.
-    rewrite knot_age1 in H0.
-    repeat rewrite knot_age1.
-    do 3 red in H.
-    destruct (unsquash x) as [n f].
-    destruct (unsquash y) as [n0 f0].
-    destruct (unsquash z) as [n1 f1].
-    destruct n1; try discriminate.
-    inv H0.
-    destruct H; simpl in *.
-    destruct H; subst.
-    exists (squash (n1,f)).
-    exists (squash (n1,f0)).
-    split; intuition. do 3  red.
-    repeat rewrite unsquash_squash.
-    split; auto. simpl snd.
-    apply (paf_join_hom paf_F); auto.
-  Qed.
-
-  Lemma unage_join1 : forall x x' y' z', join x' y' z' -> age x x' ->
-    exists y, exists z, join x y z /\ age y y' /\ age z z'.
-  Proof.
-    intros.
-    unfold join, Join_knot, Join_preimage, age in *; simpl in *.
-    revert H0; rewrite knot_age1;
-    destruct (unsquash x) as [n f] eqn:?H; intros.
-    destruct n; inv H1.
-    hnf in H. rewrite unsquash_squash in H. simpl in H.
-    revert H.
-    destruct (unsquash y') as [n1 f1] eqn:?H.
-    destruct (unsquash z') as [n0 f0] eqn:?H; intros.
-    destruct H2; simpl in *.
-    destruct H2; subst.
-    rename n0 into n.
-    destruct (paf_preserves_unmap_right paf_F (approx n) (approx n) f f1 f0)
-      as [q [w [? [? ?]]]].
-    rewrite <- (unsquash_approx H); auto.
-    exists (squash (S n,q)).
-    exists (squash (S n,w)). split. hnf.
-    repeat rewrite unsquash_squash.
-    split; simpl; auto.
-    generalize (paf_join_hom paf_F (approx (S n)) (approx (S n)) _ _ _ H2).
-    rewrite <- (unsquash_approx H0); auto.
-
-    split; hnf.
-    rewrite knot_age1.
-    rewrite unsquash_squash. f_equal.
-    replace y' with (squash (n, fmap F (approx (S n)) (approx (S n)) q)); auto.
-    apply unsquash_inj.
-    rewrite unsquash_squash, H.
-    apply injective_projections; simpl; auto.
-    rewrite (unsquash_approx H).
-    rewrite <- H4.
-    rewrite fmap_app.
-    replace (approx n oo approx (S n)) with (approx n);
-    [replace (approx (S n) oo approx n) with (approx n) |]; auto.
-    extensionality a.
-    replace (S n) with (1 + n)%nat by trivial.
-    rewrite <- (approx_approx2 1 n).
-    trivial.
-    extensionality a.
-    replace (S n) with (1 + n)%nat by trivial.
-    rewrite <- (approx_approx1 1 n).
-    trivial.
-
-    rewrite knot_age1.
-    rewrite unsquash_squash. f_equal.
-    replace z' with  (squash (n,fmap F (approx (S n)) (approx (S n)) w)); auto.
-    apply unsquash_inj.
-    rewrite unsquash_squash, H1.
-    apply injective_projections; simpl; auto.
-    rewrite <- H5.
-    rewrite fmap_app.
-    replace (approx n oo approx (S n)) with (approx n);
-    [replace (approx (S n) oo approx n) with (approx n) |]; auto.
-    extensionality a.
-    replace (S n) with (1 + n)%nat by trivial.
-    rewrite <- (approx_approx2 1 n).
-    trivial.
-    extensionality a.
-    replace (S n) with (1 + n)%nat by trivial.
-    rewrite <- (approx_approx1 1 n).
-    trivial.
-  Qed.
-
-  Lemma unage_join2 :
-    forall z x' y' z', join x' y' z' -> age z z' ->
-      exists x, exists y, join x y z /\ age x x' /\ age y y'.
-  Proof.
-    intros.
-    rewrite join_unsquash in H.
-    revert H H0.
-    unfold join, Join_knot, Join_preimage, age in *; simpl in *.
-    repeat rewrite knot_age1.
-
-    destruct (unsquash z) as [n f] eqn:?H;
-    destruct (unsquash z') as [n0 f0] eqn:?H;
-    destruct (unsquash y') as [n1 f1] eqn:?H;
-    destruct (unsquash x') as [n2 f2] eqn:?H; intros.
-    destruct n;  inv H4.
-    destruct H3. hnf in H3. simpl in *. destruct H3; subst.
-    rewrite unsquash_squash in H0.
-    inv H0.
-    rename n0 into n.
-
-    destruct (paf_preserves_unmap_left paf_F
-      (approx n) (approx n) f2 f1 f)
-      as [wx [wy [? [? ?]]]]; auto.
-    rewrite <- (unsquash_approx H1); auto.
-    exists (squash (S n, wx)).
-    exists (squash (S n, wy)).
-    split. unfold join, Join_nat_F, Join_prod; simpl.
-    (* unfold Join_knot; simpl. unfold Join_preimage; simpl. *)
-    repeat rewrite unsquash_squash.  simpl.  split; auto.
-
-    rewrite (unsquash_approx H).
-    apply (paf_join_hom paf_F); auto.
-    split; rewrite knot_age1; rewrite unsquash_squash; f_equal; hnf.
-    apply unsquash_inj.
-    rewrite unsquash_squash, H2.
-    apply injective_projections; simpl; auto.
-    rewrite fmap_app.
-    replace (approx n oo approx (S n)) with (approx n);
-    [replace (approx (S n) oo approx n) with (approx n) |]; auto.
-    extensionality a.
-    replace (S n) with (1 + n)%nat by trivial.
-    rewrite <- (approx_approx2 1 n).
-    trivial.
-    extensionality a.
-    replace (S n) with (1 + n)%nat by trivial.
-    rewrite <- (approx_approx1 1 n).
-    trivial.
-
-    apply unsquash_inj.
-    rewrite unsquash_squash, H1.
-    apply injective_projections; simpl; auto.
-    rewrite fmap_app.
-    rewrite (unsquash_approx H1), <- H5; auto.
-    replace (approx n oo approx (S n)) with (approx n);
-    [replace (approx (S n) oo approx n) with (approx n) |]; auto.
-    extensionality a.
-    replace (S n) with (1 + n)%nat by trivial.
-    rewrite <- (approx_approx2 1 n).
-    trivial.
-    extensionality a.
-    replace (S n) with (1 + n)%nat by trivial.
-    rewrite <- (approx_approx1 1 n).
-    trivial.
-  Qed.
-
-  Lemma age_core :
-    forall x y, age x y -> age (core x) (core y).
-  Proof.
-    intros x y.
-    unfold age; rewrite !knot_age1; simpl.
-    destruct (unsquash x) eqn: Hx; simpl.
-    destruct n; [discriminate|].
-    intros X; inv X; simpl.
-    rewrite !unsquash_squash; simpl.
-    rewrite approx_core.
-    f_equal; apply unsquash_inj.
-    rewrite !unsquash_squash, !fmap_app.
-    change (S n) with (1 + n).
-    rewrite <- (approx_approx1 1 n), <- (approx_approx2 1 n).
-    setoid_rewrite <- (approx_approx1 0 n).
-    reflexivity.
-  Qed.
-
-  #[export] Instance asa_knot : @Age_alg knot _ K.ageable_knot _.
-  Proof.
-    constructor.
-    exact age_join1.
-    exact age_join2.
-    exact unage_join1.
-    exact unage_join2.
-    exact age_core.
-  Qed.
-
-  #[export] Existing Instance Perm_F.
-  #[export] Existing Instance Sep_F.
-
-  #[export] Instance ea_knot : Ext_alg knot.
-  Proof.
-    constructor.
-    - intros. rewrite knot_order in H0.
-      destruct H0.
-      destruct (join_level _ _ _ H) as [Hl Hly].
-      destruct H as [? J].
-      eapply Rel_join_commut in H1 as (x' & ? & ?); eauto.
-      exists (squash (level z, x')).
-      rewrite knot_order; split.
-      + split. setoid_rewrite knot_level at 2; rewrite unsquash_squash; auto.
-        rewrite unsquash_squash; simpl.
-        destruct (unsquash x) eqn: Hx.
-        rewrite (unsquash_approx Hx).
-        rewrite <- Hl, knot_level, Hx.
-        apply Rel_fmap; auto.
-      + split; rewrite unsquash_squash; simpl. rewrite <- !knot_level; hnf; split; congruence.
-        destruct (unsquash y) eqn: Hy, (unsquash z') eqn: Hz'.
-        rewrite (unsquash_approx Hy), (unsquash_approx Hz').
-        symmetry in H0; rewrite knot_level, Hz' in H0.
-        rewrite knot_level, Hy in Hly.
-        simpl in *; subst. apply paf_join_hom; auto.
-        apply paf_F.
-    - intros.
-      rewrite knot_order in H.
-      destruct H.
-      destruct (join_level _ _ _ H0) as [Hl Hly].
-      destruct H0 as [? J].
-      eapply join_Rel_commut in H1 as (z & ? & ?); eauto.
-      exists (squash (level x, z)).
-      rewrite knot_order, unsquash_squash; simpl. split.
-      + split; rewrite unsquash_squash; simpl. rewrite <- !knot_level; hnf; split; congruence.
-        rewrite knot_level in H |- *.
-        destruct (unsquash x) eqn: Hx, (unsquash y') eqn: Hy'.
-        rewrite (unsquash_approx Hx), (unsquash_approx Hy').
-        rewrite knot_level, Hy' in Hly; simpl in *.
-        rewrite Hly, <- Hl, <- H.
-        apply paf_F; auto.
-      + split. rewrite knot_level, unsquash_squash; simpl; congruence.
-        destruct (unsquash z') eqn: Hz'.
-        rewrite (unsquash_approx Hz').
-        symmetry in Hl; rewrite knot_level, Hz' in Hl.
-        simpl in Hl; subst. rewrite H.
-        apply Rel_fmap; auto.
-    - intros. destruct (unsquash x) eqn: Hx.
-      destruct (id_exists _f) as (_f0 & ? & ?).
-      exists (squash (n, _f0)); split.
-      + intros ?? J.
-        apply unsquash_inj.
-        destruct J as [Jl J].
-        rewrite unsquash_squash in *; simpl in *.
-        destruct (unsquash a) eqn: Ha, (unsquash b) eqn: Hb; simpl in *.
-        destruct Jl; subst.
-        rewrite (unsquash_approx Ha) in J.
-        apply (paf_preserves_unmap_right paf_F) in J as (? & ? & J & ? & ?).
-        rewrite <- (unsquash_approx Ha) in *; subst.
-        apply H in J; subst; auto.
-      + split; rewrite unsquash_squash, Hx; simpl. split; auto.
-        rewrite (unsquash_approx Hx).
-        apply (paf_join_hom paf_F); auto.
-  Qed.
-
-End KnotFullSa.
diff --git a/msl/knot_full_variant.v b/msl/knot_full_variant.v
deleted file mode 100644
index 5f9258d60d..0000000000
--- a/msl/knot_full_variant.v
+++ /dev/null
@@ -1,1640 +0,0 @@
-Require Import VST.msl.base.
-Require Import VST.msl.ageable.
-Require Import VST.msl.functors.
-Require Import VST.msl.predicates_hered.
-Import VST.msl.functors.MixVariantFunctor.
-Import VST.msl.functors.MixVariantFunctorLemmas.
-Require Import Arith.
-
-Module Type KNOT_INPUT__MIXVARIANT_HERED_T_OTH_REL.
-  Parameter F : functor.
-
-  Parameter other : Type.
-
-  Parameter Rel : forall A, F A -> F A -> Prop.
-
-  Parameter Rel_fmap : forall A B (f1: A->B) (f2:B->A) x y,
-    Rel A x y ->
-    Rel B (fmap F f1 f2 x) (fmap F f1 f2 y).
-  Axiom Rel_refl : forall A x, Rel A x x.
-  Axiom Rel_trans : forall A x y z,
-    Rel A x y -> Rel A y z -> Rel A x z.
-
-  Parameter ORel : other -> other -> Prop.
-  Axiom ORel_refl : reflexive other ORel.
-  Axiom ORel_trans : transitive other ORel.
-
-  Parameter T:Type.
-  Parameter T_bot:T.
-
-  Parameter T_rel : T -> T -> Prop.
-  Parameter T_rel_bot : forall x, T_rel T_bot x.
-  Parameter T_rel_refl : forall x, T_rel x x.
-  Parameter T_rel_trans : transitive T T_rel.
-
-End KNOT_INPUT__MIXVARIANT_HERED_T_OTH_REL.
-
-Module Type KNOT__MIXVARIANT_HERED_T_OTH_REL.
-  Declare Module KI: KNOT_INPUT__MIXVARIANT_HERED_T_OTH_REL.
-  Import KI.
-
-  Parameter knot:Type.
-  Parameter ageable_knot : ageable knot.
-  #[global] Existing Instance ageable_knot.
-
-  Parameter hered : (knot * other -> T) -> Prop.
-  Definition predicate := { p:knot * other -> T | hered p }.
-
-  Parameter squash : (nat * F predicate) -> knot.
-  Parameter unsquash : knot -> (nat * F predicate).
-
-  Parameter approx : nat -> predicate -> predicate.
-
-  Axiom squash_unsquash : forall k:knot, squash (unsquash k) = k.
-  Axiom unsquash_squash : forall (n:nat) (f:F predicate),
-    unsquash (squash (n,f)) = (n, fmap F (approx n) (approx n) f).
-
-  Axiom approx_spec : forall n p ko,
-    proj1_sig (approx n p) ko =
-     if (Compare_dec.le_gt_dec n (level (fst ko))) then T_bot else proj1_sig p ko.
-
-  Definition knot_rel (k1 k2:knot) :=
-    let (n,f) := unsquash k1 in
-    let (n',f') := unsquash k2 in
-    n = n' /\ Rel predicate f f'.
-
-  Axiom knot_age1 : forall k:knot,
-    age1 k =
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-
-  Axiom knot_level : forall k:knot,
-    level k = fst (unsquash k).
-
-  Axiom hered_spec : forall p,
-    hered p =
-    (forall k k' k'' o o',
-      clos_refl_trans _ age k k' ->
-      knot_rel  k' k'' ->
-      ORel o o' ->
-      T_rel (p (k,o)) (p (k'',o'))).
-
-  #[export] Program Instance ext_knot : Ext_ord knot := { ext_order := knot_rel }.
-  Next Obligation.
-  Proof.
-    unfold knot_rel. split.
-    - intros k.
-      destruct (unsquash k); split; auto.
-      apply Rel_refl.
-    - intros k1 k2 k3.
-      destruct (unsquash k1), (unsquash k2), (unsquash k3).
-      intros [] []; subst; split; auto.
-      eapply Rel_trans; eauto.
-  Qed.
-  Next Obligation.
-  Proof.
-    intros ?????.
-    unfold age, knot_rel in *. rewrite knot_age1 in H.
-    destruct (unsquash y) eqn: Hy.
-    destruct n; inv H; simpl.
-    destruct (unsquash z) eqn: Hz.
-    destruct H0 as [? H0]; subst.
-    exists (squash (n, _f0)).
-    - rewrite !unsquash_squash.
-      split; auto.
-      apply Rel_fmap; auto.
-    - rewrite knot_age1, Hz; auto.
-  Qed.
-  Next Obligation.
-  Proof.
-    unfold age, knot_rel in *. rewrite knot_age1 in H0.
-    destruct (unsquash a) eqn: Ha.
-    destruct n; inv H0.
-    destruct (unsquash b) eqn: Hb.
-    destruct H as [? H]; subst.
-    exists (squash (n, _f0)).
-    split.
-    - rewrite knot_age1, Hb; auto.
-    - rewrite !unsquash_squash; split; auto.
-      apply Rel_fmap; auto.
-  Qed.
-  Next Obligation.
-  Proof.
-    rewrite !knot_level. unfold knot_rel in H.
-    destruct (unsquash a), (unsquash b), H; auto.
-  Qed.
-
-  Lemma knot_order : ext_order = knot_rel.
-  Proof. reflexivity. Qed.
-
-End KNOT__MIXVARIANT_HERED_T_OTH_REL.
-
-Module Knot_MixVariantHeredTOthRel (KI':KNOT_INPUT__MIXVARIANT_HERED_T_OTH_REL) :
-  KNOT__MIXVARIANT_HERED_T_OTH_REL with Module KI:=KI'.
-  Module KI := KI'.
-  Import KI.
-
-  Definition sinv_prod X := prod X (F X * other -> T).
-
-  Definition guppy_sig := (fun X:Type => X * (F X * other -> T) -> Prop).
-  Definition guppy_ty := sigT guppy_sig.
-
-  Definition guppy_step_ty (Z:guppy_ty) : Type :=
-    (sig (fun (x:sinv_prod (projT1 Z)) => projT2 Z x)).
-
-  Definition guppy_age (Z:guppy_ty) (x:guppy_step_ty Z) : projT1 Z := fst (proj1_sig x).
-  Definition guppy_unage (Z:guppy_ty)
-    (H:forall t, projT2 Z (t,fun _ => T_bot))
-    (x:projT1 Z) : guppy_step_ty Z :=
-    exist (fun z => projT2 Z z) (x, fun _ => T_bot) (H x).
-
-  Definition guppy_step_prop (Z:guppy_ty) (xf:sinv_prod (guppy_step_ty Z)) :=
-    (forall (k:F (guppy_step_ty Z)) (o:other) H,
-         T_rel (snd xf (k,o))
-               (snd (proj1_sig (fst xf)) (fmap F (guppy_age Z) (guppy_unage Z H) k,o))) /\
-    (forall (k k':F (guppy_step_ty Z)) (o o':other),
-         Rel (guppy_step_ty Z) k k' ->
-         ORel o o' ->
-         T_rel (snd xf (k,o)) (snd xf (k',o'))).
-
-  Definition guppy_step (Z:guppy_ty) : guppy_ty :=
-    existT guppy_sig (guppy_step_ty Z) (guppy_step_prop Z).
-
-  Definition guppy_base : guppy_ty :=
-    existT guppy_sig unit
-      (fun xf =>
-        (forall (k k':F unit) (o o':other),
-          Rel unit k k' ->
-          ORel o o' ->
-          T_rel (snd xf (k,o)) (snd xf (k',o')))).
-
-  Fixpoint guppy (n:nat) : guppy_ty :=
-    match n with
-    | 0    => guppy_base
-    | S n' => guppy_step (guppy n')
-    end.
-
-  Definition sinv (n:nat) : Type := projT1 (guppy n).
-  Definition sinv_prop (n:nat) : prod (sinv n) (F (sinv n) * other -> T) -> Prop := projT2 (guppy n).
-
-  Fixpoint floor (m:nat) (n:nat) (p:sinv (m+n)) : sinv n :=
-    match m as m' return forall (p : sinv (m'+n)), sinv n with
-    | O => fun p => p
-    | S m' => fun p => floor m' n (fst (proj1_sig p))
-    end p.
-
-  Definition knot := { n:nat & F (sinv n) }.
-
-  Definition sinv_age n : sinv (S n) -> sinv n := guppy_age (guppy n).
-  Program Definition sinv_unage n : sinv n -> sinv (S n) := guppy_unage (guppy n) _.
-  Next Obligation.
-    revert t; induction n; simpl; auto.
-    repeat intro.
-    apply T_rel_bot.
-    split; simpl in *; repeat intro.
-    apply T_rel_bot.
-    apply T_rel_bot.
-  Qed.
-
-  Definition F_sinv n := F (sinv n).
-
-  Definition age1_def (k:knot) : option knot :=
-    match k with
-      | existT _ 0 f => None
-      | existT _ (S m) f => Some
-          (existT F_sinv m (fmap F (sinv_age m) (sinv_unage m) f))
-    end.
-
-  Definition age_def x y := age1_def x = Some y.
-
-  Inductive knot_rel_inner : knot -> knot -> Prop :=
-    | intro_krel : forall n (f f':F_sinv n),
-         Rel _ f f' ->
-         knot_rel_inner (existT (F_sinv) n f) (existT (F_sinv) n f').
-
-  Definition hered (p:knot * other -> T) : Prop :=
-    forall k k' k'' o o',
-      clos_refl_trans _ age_def k k' ->
-      knot_rel_inner k' k'' -> ORel o o' ->
-      T_rel (p (k,o)) (p (k'',o')).
-
-  Definition predicate := { p:knot * other -> T | hered p }.
-
-  Definition app_sinv (n:nat) (p:sinv (S n)) (x:F_sinv n * other) :=
-    snd (proj1_sig p) x.
-
-  Section stratifies.
-    Variable Q:knot * other -> T.
-    Variable HQ:hered Q.
-
-    Fixpoint stratifies (n:nat) : sinv n -> Prop :=
-    match n as n' return sinv n' -> Prop with
-    | 0 => fun _ => True
-    | S n' => fun (p:sinv (S n')) =>
-          stratifies n' (fst (proj1_sig p)) /\
-          forall (k:F_sinv n') (o:other), snd (proj1_sig p) (k,o) = Q (existT F_sinv n' k,o)
-    end.
-
-    Lemma stratifies_unique : forall n p1 p2,
-      stratifies n p1 ->
-      stratifies n p2 ->
-      p1 = p2.
-    Proof.
-      induction n; simpl; intuition.
-      destruct p1; destruct p2; auto.
-      destruct p1; destruct p2.
-      simpl in *; fold guppy in *.
-      cut (x = x0).
-      intros.
-      revert p p0 H2 H3.
-      rewrite <- H0.
-      intros.
-      replace p0 with p by (apply proof_irr); auto.
-      destruct x; destruct x0; simpl in *.
-      apply injective_projections; simpl.
-      apply IHn; auto.
-      extensionality; intros.
-      simpl in *.
-      destruct x as [x o].
-      destruct (H2 x o); destruct (H3 x o).
-      rewrite H2.
-      rewrite H3.
-      auto.
-    Qed.
-
-    Definition stratify (n:nat) : { x:sinv n | stratifies n x }.
-    Proof.
-      induction n.
-      exists tt; simpl; exact I.
-      assert (HX:
-        projT2 (guppy n)
-        (proj1_sig IHn, fun v : F_sinv n * other => Q (existT F_sinv n (fst v),snd v))).
-      destruct n.
-      simpl; intros.
-      eapply HQ.
-      apply rt_refl.
-      constructor; auto.
-      auto.
-      simpl; intros.
-      destruct IHn; simpl.
-      simpl in s; destruct s.
-      destruct x; simpl in *; fold guppy in *.
-      destruct x; simpl in *.
-      split; hnf; simpl; intros.
-      rewrite H0.
-      eapply HQ.
-      apply rt_step.
-      hnf; simpl.
-      reflexivity.
-      constructor; auto.
-      unfold sinv_unage.
-      replace (sinv_unage_obligation_1 n) with H1.
-      unfold sinv_age.
-      apply Rel_refl.
-      apply proof_irr.
-      apply ORel_refl.
-      eapply HQ.
-      apply rt_refl.
-      constructor; auto.
-      auto.
-
-      exists ((exist (fun x => projT2 (guppy n) x) ( proj1_sig IHn, fun v:F_sinv n * other => Q (existT (F_sinv) n (fst v),snd v) ) HX)).
-      simpl; split; auto.
-      destruct IHn; auto.
-    Qed.
-  End stratifies.
-
-  Lemma decompose_nat : forall (x y:nat), { m:nat & y = (m + S x) } + { ge x y }.
-  Proof.
-    intros x y; revert x; induction y; simpl; intros.
-    right; auto with arith.
-    destruct (IHy x) as [[m H]|H].
-    left; exists (S m); lia.
-    destruct (Peano_dec.eq_nat_dec x y).
-    left; exists O; lia.
-    right; lia.
-  Qed.
-
-  Definition unstratify (n:nat) (p:sinv n) : knot * other -> T := fun w =>
-    match w with (existT _ nw w',o) =>
-      match decompose_nat nw n with
-        | inleft (existT _ m Hm) => snd (proj1_sig (floor m (S nw) (eq_rect  n _ p (m + S nw) Hm))) (w',o)
-        | inright H => T_bot
-      end
-    end.
-
-  Lemma floor_shuffle:
-    forall (m1 n : nat)
-      (p1 : sinv (m1 + S n)) (H1 : (m1 + S n) = (S m1 + n)),
-      floor (S m1) n (eq_rect (m1 + S n) sinv p1 (S m1 + n) H1) = fst (proj1_sig (floor m1 (S n) p1)).
-  Proof.
-    intros.
-    remember (fst (proj1_sig (floor m1 (S n) p1))) as p.
-    fold guppy in *.
-    revert n p1 H1 p Heqp.
-    induction m1; simpl; intros.
-    replace H1 with (refl_equal (S n)) by (apply proof_irr); simpl; auto.
-    assert (m1 + S n = S m1 + n) by lia.
-    destruct p1 as [[p1 f'] Hp1]; simpl in *; fold guppy in *.
-    generalize (IHm1 n p1 H p Heqp).
-    clear.
-    revert Hp1 H1; generalize H.
-    revert p1 f'.
-    rewrite H.
-    simpl; intros.
-    replace H1 with (refl_equal (S (S (m1 + n)))) by (apply proof_irr).
-    simpl.
-    replace H0 with (refl_equal (S (m1+n))) in H2 by (apply proof_irr).
-    simpl in H2.
-    trivial.
-  Qed.
-
-  Lemma unstratify_hered : forall n p,
-    hered (unstratify n p).
-  Proof.
-    intros.
-    hnf; intros.
-    apply T_rel_trans with (unstratify n p (k',o)).
-    clear o' H0 H1.
-    induction H.
-    hnf in H; simpl in H.
-    destruct x as [x f]; simpl in H.
-    destruct x; try discriminate.
-    assert (y =
-      (existT (F_sinv) x (fmap F (sinv_age x) (sinv_unage x) f))).
-    inversion H; auto.
-    subst y.
-    unfold unstratify.
-    case_eq (decompose_nat (S x) n); intros.
-    destruct s.
-    case_eq (decompose_nat x n); intros.
-    destruct s.
-    destruct n.
-    exfalso; lia.
-    assert (S x0 = x1) by lia; subst x1.
-    revert H1.
-    generalize e e0; revert p; rewrite e; intros.
-    rewrite floor_shuffle.
-    replace e1 with (refl_equal (x0 + S (S x)));
-      simpl eq_rect.
-    2: apply proof_irr.
-    revert H1.
-    generalize (floor x0 (S (S x)) p).
-    intros [[s' fs] Hs] H1; simpl in *; fold guppy in *.
-    destruct Hs.
-    simpl in H2.
-    eapply H2; auto.
-    exfalso.
-    lia.
-    apply T_rel_bot.
-    apply T_rel_refl.
-    eapply T_rel_trans; eauto.
-
-    clear H.
-    inv H0.
-    simpl.
-    destruct (decompose_nat n0 n); [ | apply T_rel_bot ].
-    destruct s; simpl.
-    destruct (floor x (S n0) (eq_rect n sinv p (x +S n0) e)); simpl.
-    destruct n0; simpl in x0; destruct x0; simpl.
-    apply p0; auto.
-    apply p0; auto.
-  Qed.
-
-  Lemma unstratify_Q : forall n (p:sinv n) Q,
-    stratifies Q n p ->
-    forall (k:knot) (o:other),
-      projT1 k < n ->
-      (unstratify n p (k,o) = Q (k,o)).
-  Proof.
-    intros.
-    unfold unstratify.
-    destruct k.
-    destruct (decompose_nat x n).
-    destruct s.
-    simpl in H0.
-    2: simpl in *; exfalso; lia.
-    clear H0.
-    revert p H.
-    generalize e.
-    rewrite e.
-    intros.
-    replace e0 with (refl_equal (x0 + S x)) by apply proof_irr.
-    simpl.
-    clear e e0.
-    revert p H.
-    induction x0; simpl; intros.
-    destruct H.
-    auto.
-    destruct H.
-    apply IHx0.
-    auto.
-  Qed.
-
-  Lemma stratifies_unstratify_more :
-    forall (n m1 m2:nat) (p1:sinv (m1+n)) (p2:sinv (m2+n)),
-      floor m1 n p1 = floor m2 n p2 ->
-      (stratifies (unstratify (m1+n) p1) n (floor m1 n p1) ->
-       stratifies (unstratify (m2+n) p2) n (floor m2 n p2)).
-  Proof.
-    induction n; intuition.
-    split.
-    assert (m2 + S n = S m2 + n) by lia.
-    erewrite <- floor_shuffle.
-    instantiate (1:=H1).
-    replace (unstratify (m2 + S n) p2)
-      with (unstratify (S m2 + n) (eq_rect (m2 + S n) sinv p2 (S m2 + n) H1)).
-    assert (m1 + S n = S m1 + n) by lia.
-    eapply (IHn (S m1) (S m2)
-      (eq_rect (m1 + S n) sinv p1 (S m1 + n) H2)).
-    rewrite floor_shuffle.
-    rewrite floor_shuffle.
-    rewrite H; auto.
-    clear - H0.
-    rewrite floor_shuffle.
-    simpl in H0.
-    destruct H0.
-    clear H0.
-    revert p1 H.
-    generalize H2.
-    rewrite <- H2.
-    intros.
-    replace H0 with (refl_equal (m1 + S n)) by apply proof_irr; auto.
-    clear.
-    revert p2.
-    generalize H1.
-    rewrite H1.
-    intros.
-    replace H0 with (refl_equal (S m2 + n)) by apply proof_irr; auto.
-
-    intros.
-    simpl.
-    destruct (decompose_nat n (m2 + S n)).
-    destruct s.
-    assert (m2 = x).
-    lia.
-    subst x.
-    replace e with (refl_equal (m2 + S n)).
-    simpl; tauto.
-    apply proof_irr.
-    exfalso; lia.
-  Qed.
-
-  Lemma stratify_unstratify : forall n p H,
-    proj1_sig (stratify (unstratify n p) H n) = p.
-  Proof.
-    intros.
-    apply stratifies_unique with (unstratify n p).
-    destruct (stratify _ H n).
-    simpl; auto.
-    clear H.
-    revert p; induction n.
-    simpl; intros; auto.
-    intros.
-    simpl; split.
-
-    assert (stratifies (unstratify n (fst (proj1_sig p))) n (fst (proj1_sig p))).
-    apply IHn.
-    apply (stratifies_unstratify_more n 0 1 (fst (proj1_sig p)) p).
-    simpl; auto.
-    auto.
-
-    intros.
-    destruct (decompose_nat n (S n)).
-    destruct s.
-    assert (x = 0) by lia.
-    subst x.
-    simpl.
-    simpl in e.
-    replace e with (refl_equal (S n)) by apply proof_irr.
-    simpl.
-    split; auto.
-    exfalso; lia.
-  Qed.
-
-  Definition strat (n:nat) (p:predicate) : sinv n :=
-    proj1_sig (stratify (proj1_sig p) (proj2_sig p) n).
-
-  Definition unstrat (n:nat) (p:sinv n) : predicate :=
-    exist hered (unstratify n p) (unstratify_hered n p).
-
-  Definition squash (x:nat * F predicate) : knot :=
-    match x with (n,f) => existT (F_sinv) n (fmap F (strat n) (unstrat n) f) end.
-
-  Definition unsquash (k:knot) : nat * F predicate :=
-    match k with existT _ n f => (n, fmap F (unstrat n) (strat n) f) end.
-
-  Definition knot_level_def (k:knot) : nat :=
-    fst (unsquash k).
-
-  Definition knot_age1_def (k:knot) : option knot :=
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-
-  Definition knot_unage_def (k:knot) :=
-    let (n,k) := unsquash k in squash (S n,k).
-
-  Program Definition approx (n:nat) (p:predicate) : predicate :=
-    fun w => if (Compare_dec.le_gt_dec n (knot_level_def (fst w))) then T_bot else proj1_sig p w.
-  Next Obligation.
-    hnf; simpl; intros.
-    destruct (Compare_dec.le_gt_dec n (knot_level_def k)).
-    apply T_rel_bot.
-    destruct (Compare_dec.le_gt_dec n (knot_level_def k'')).
-    exfalso.
-    cut (knot_level_def k'' <= knot_level_def k).
-    lia.
-    replace (knot_level_def k'') with (knot_level_def k').
-    clear -H; induction H.
-    hnf in H.
-    unfold age1_def in H.
-    destruct x; destruct y; simpl.
-    destruct x; try discriminate.
-    inv H.
-    simpl.
-    unfold knot_level_def; simpl; auto.
-    auto.
-    eapply Nat.le_trans; eauto.
-    inv H0.
-    unfold knot_level_def; simpl; auto.
-
-    destruct p as [p Hp]; simpl.
-    eapply Hp; eauto.
-  Qed.
-
-  Lemma strat_unstrat : forall n,
-    strat n oo unstrat n = id (sinv n).
-  Proof.
-    intros; extensionality p.
-    unfold compose, id.
-    unfold strat, unstrat.
-    simpl.
-    rewrite stratify_unstratify.
-    auto.
-  Qed.
-
-  Lemma predicate_eq : forall (p1 p2:predicate),
-    proj1_sig p1 = proj1_sig p2 ->
-    p1 = p2.
-  Proof.
-    intros; destruct p1; destruct p2; simpl in H.
-    subst x0.
-    replace h0 with h by apply proof_irr.
-    auto.
-  Qed.
-
-  Lemma unstrat_strat : forall n,
-    unstrat n oo strat n = approx n.
-  Proof.
-    intros.
-    extensionality.
-    unfold compose.
-    unfold unstrat, strat.
-    unfold approx.
-    apply predicate_eq.
-    simpl.
-    extensionality k.
-    destruct (Compare_dec.le_gt_dec n (knot_level_def (fst k))).
-    unfold unstratify.
-    destruct k.
-    destruct k.
-    unfold knot_level_def in l.
-    simpl in *.
-    destruct (decompose_nat x0 n); simpl.
-    destruct s; simpl; exfalso; lia.
-    auto.
-    destruct x as [x Hx]; simpl.
-    destruct (stratify x Hx n); simpl.
-    destruct k.
-    rewrite unstratify_Q with (Q:=x); auto.
-    unfold level in *.
-    destruct k; simpl in *; auto.
-  Qed.
-
-  Lemma squash_unsquash : forall k, squash (unsquash k) = k.
-  Proof.
-    intros.
-    destruct k as [n f]; simpl.
-    f_equal.
-    change ((fmap F (strat n) (unstrat n) oo (fmap F (unstrat n) (strat n))) f = f).
-    rewrite fmap_comp.
-    rewrite strat_unstrat.
-    rewrite fmap_id.
-    auto.
-  Qed.
-
-  Lemma unsquash_squash : forall n f,
-    unsquash (squash (n,f)) = (n, fmap F (approx n) (approx n) f).
-  Proof.
-    intros.
-    unfold unsquash, squash.
-    f_equal.
-    change ((fmap F (unstrat n) (strat n) oo (fmap F (strat n) (unstrat n))) f = fmap F (approx n) (approx n) f).
-    rewrite fmap_comp.
-    rewrite unstrat_strat.
-    auto.
-  Qed.
-
-  Lemma strat_Sx_unstrat : forall x,
-    sinv_unage x = strat (S x) oo unstrat x.
-  Proof.
-    intros.
-    extensionality k.
-    unfold sinv_unage.
-    generalize (sinv_unage_obligation_1); intro P.
-    unfold guppy_unage.
-    unfold compose, strat, unstrat.
-    simpl.
-    apply stratifies_unique with (unstratify x k).
-    revert k.
-    induction x; simpl; intuition.
-    destruct (decompose_nat 0 0); auto.
-    destruct s; exfalso; lia.
-    eapply (stratifies_unstratify_more x 0 1).
-    simpl; reflexivity.
-    simpl.
-    simpl in *.
-    destruct (IHx (fst (proj1_sig k))); auto.
-    destruct (decompose_nat x (S x)).
-    destruct s.
-    assert (x0 = 0) by lia; subst x0.
-    simpl in *.
-    replace e with (refl_equal (S x)) by apply proof_irr; auto.
-    exfalso; lia.
-    destruct (decompose_nat x (S x)).
-    destruct s.
-    assert (x0 = 0) by lia; subst x0.
-    simpl in *.
-    destruct (decompose_nat (S x) (S x)).
-    destruct s; exfalso; lia.
-    auto.
-    destruct (decompose_nat (S x) (S x)).
-    destruct s; exfalso; lia.
-    auto.
-
-    destruct (stratify (unstratify x k) (unstratify_hered x k) (S x)).
-    simpl stratifies in s; case s; intros.
-    simpl stratifies; split; auto.
-  Qed.
-
-  Lemma strat_unstrat_Sx : forall x,
-    sinv_age x = strat x oo unstrat (S x).
-  Proof.
-    intros.
-    extensionality k.
-    unfold sinv_age, guppy_age.
-    unfold compose.
-    unfold strat, unstrat.
-    simpl.
-    apply stratifies_unique with (unstratify x (fst (proj1_sig k))).
-    revert k; induction x; simpl; auto.
-    intros.
-    split.
-    eapply (stratifies_unstratify_more x 0 1 ).
-    simpl; reflexivity.
-    simpl.
-    apply IHx.
-    intros.
-    destruct (decompose_nat x (S x)).
-    destruct s.
-    assert (x0 = 0) by lia; subst x0.
-    simpl in *.
-    replace e with (refl_equal (S x)) by apply proof_irr; simpl.
-    tauto.
-    exfalso; lia.
-    destruct (stratify (unstratify (S x) k)
-      (unstratify_hered (S x) k) x).
-    simpl; auto.
-    cut (x0 = (fst (proj1_sig k))); intros.
-    subst x0.
-    eapply (stratifies_unstratify_more x 1 0).
-    simpl; reflexivity.
-    simpl; auto.
-    eapply stratifies_unique.
-    apply s.
-    eapply (stratifies_unstratify_more x 0 1).
-    simpl; reflexivity.
-    simpl.
-    generalize (fst (proj1_sig k) : sinv x).
-    clear.
-    induction x; simpl; intuition.
-    eapply (stratifies_unstratify_more x 0 1).
-    simpl; reflexivity.
-    simpl.
-    apply IHx.
-    destruct (decompose_nat x (S x)).
-    destruct s0.
-    assert (x0 = 0) by lia; subst.
-    simpl in *.
-    replace e with (refl_equal (S x)); simpl; auto.
-    apply proof_irr.
-    exfalso; lia.
-  Qed.
-
-  Lemma age1_eq : forall k,
-    age1_def k = knot_age1_def k.
-  Proof.
-    intros.
-    unfold knot_age1_def.
-    case_eq (unsquash k); intros.
-    case_eq k; intros.
-    simpl.
-    assert (n = x).
-    subst k.
-    inv H; auto.
-    subst x.
-    destruct n; auto.
-    f_equal.
-    f_equal.
-
-    rewrite strat_Sx_unstrat.
-    rewrite strat_unstrat_Sx.
-    rewrite <- fmap_comp.
-    unfold compose.
-    f_equal.
-    subst k.
-    inv H; auto.
-  Qed.
-
-  Lemma unsquash_inj : forall k1 k2,
-    unsquash k1 = unsquash k2 ->
-    k1 = k2.
-  Proof.
-    intros.
-    rewrite <- (squash_unsquash k1).
-    rewrite <- (squash_unsquash k2).
-    rewrite H.
-    trivial.
-  Qed.
-  Arguments unsquash_inj [k1 k2] _.
-
-
-  Lemma pred_ext : forall (p1 p2:predicate),
-    (forall x, proj1_sig p1 x = proj1_sig p2 x) ->
-    p1 = p2.
-  Proof.
-    intros.
-    destruct p1 as [p1 Hp1]; destruct p2 as [p2 Hp2].
-    simpl in *.
-    assert (p1 = p2).
-    extensionality x; auto.
-    subst p2.
-    replace Hp2 with Hp1; auto.
-    apply proof_irr.
-  Qed.
-
-  Lemma approx_spec : forall n p ko,
-    proj1_sig (approx n p) ko =
-     if (Compare_dec.le_gt_dec n (knot_level_def (fst ko))) then T_bot else proj1_sig p ko.
-  Proof.
-    intros; simpl; auto.
-  Qed.
-
-  Lemma ag_knot_facts : ageable_facts knot knot_level_def knot_age1_def.
-  Proof.
-    constructor.
-
-    unfold knot_age1_def; unfold knot_level_def; simpl; intros x'.
-    destruct (unsquash x') as [n f] eqn:?H; intros.
-    destruct x' as [x f0].
-    exists (squash (S x, fmap F (unstrat x) (strat x) f0)).
-    rewrite unsquash_squash.
-    f_equal. f_equal.
-    clear.
-    transitivity ((fmap F (strat x) (unstrat x) oo fmap F (approx (S x)) (approx (S x)) oo fmap F (unstrat x) (strat x)) f0); auto.
-    do 2 rewrite fmap_comp.
-    rewrite compose_assoc.
-    replace (strat x oo approx (S x) oo unstrat x) with (@id (sinv x)).
-    rewrite fmap_id. auto.
-    rewrite <- (strat_unstrat x).
-    f_equal.
-    extensionality a.
-    unfold compose, approx.
-    case_eq (unstrat x a); intros.
-    match goal with
-      [ |- _ = exist _ ?X _ ] =>
-      assert (x0 = X)
-    end.
-   2:{
-    generalize (approx_obligation_1 (S x)
-      (exist (fun p => hered p) x0 h)).
-    rewrite <- H0.
-    intros. f_equal.
-    }
-    extensionality.
-    destruct x1.
-    unfold unstrat in H.
-    inv H.
-    destruct k.
-    unfold unstratify.
-    unfold knot_level_def.
-    simpl fst.
-    destruct (decompose_nat x0 x).
-    destruct s.
-    destruct (Compare_dec.le_gt_dec (S x) x0).
-    exfalso; lia.
-    simpl.
-    destruct (decompose_nat x0 x).
-    destruct s.
-    assert (x1 = x2) by lia.
-    subst x2.
-    replace e0 with e by apply proof_irr.
-    auto.
-    exfalso; lia.
-    destruct (Compare_dec.le_gt_dec (S x) x0); auto.
-    simpl.
-    destruct (decompose_nat x0 x); auto.
-    destruct s. exfalso. lia.
-
-    intro.
-    unfold knot_age1_def, knot_level_def.
-    case_eq (unsquash x); intros.
-    destruct n; simpl; intuition;
-      discriminate.
-
-    intros.
-    unfold knot_age1_def, knot_level_def in *.
-    case_eq (unsquash x); intros; rewrite H0 in H.
-    destruct n; try discriminate; simpl.
-    inv H; simpl; auto.
-  Qed.
-
-  Definition ageable_knot : ageable knot :=
-    mkAgeable knot knot_level_def knot_age1_def ag_knot_facts.
-  #[global] Existing Instance ageable_knot.
-
-  Definition knot_rel (k1 k2:knot) :=
-    let (n,f) := unsquash k1 in
-    let (n',f') := unsquash k2 in
-    n = n' /\ Rel predicate f f'.
-
-  Lemma hered_spec : forall p,
-    hered p =
-    (forall k k' k'' o o',
-      clos_refl_trans _ age k k' ->
-      knot_rel  k' k'' ->
-      ORel o o' ->
-      T_rel (p (k,o)) (p (k'',o'))).
-  Proof.
-    intros.
-    apply prop_ext.
-    intuition.
-    eapply H.
-    instantiate (1:=k').
-    clear -H0; induction H0; auto.
-    apply rt_step.
-    unfold age_def.
-    rewrite age1_eq.
-    auto.
-    eapply rt_trans; eauto.
-    destruct k' as [x f], k'' as [x0 f0].
-    unfold knot_rel, unsquash in H1.
-    destruct H1; subst.
-    constructor.
-    apply (Rel_fmap _ _ (strat x0) (unstrat x0)) in H3.
-    change f with (id _ f).
-    change f0 with (id _ f0).
-    rewrite <- fmap_id.
-    rewrite <- (strat_unstrat x0).
-    rewrite <- fmap_comp.
-    auto.
-    assumption.
-
-    hnf; intros.
-    apply (H k k' k''); auto.
-    clear -H0; induction H0; auto.
-    apply rt_step.
-    hnf.
-    rewrite <- age1_eq; auto.
-    eapply rt_trans; eauto.
-
-    destruct k'; destruct k''.
-    inv H1.
-    simpl.
-    hnf; split; auto.
-    apply Eqdep_dec.inj_pair2_eq_dec in H5; auto.
-    apply Eqdep_dec.inj_pair2_eq_dec in H7; auto.
-    subst.
-    apply Rel_fmap; auto.
-    exact Peano_dec.eq_nat_dec.
-    exact Peano_dec.eq_nat_dec.
-  Qed.
-
-  Lemma knot_age1 : forall k:knot,
-    age1 k =
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-  Proof.
-    intros; reflexivity.
-  Qed.
-
-  Lemma knot_level : forall k:knot,
-    level k = fst (unsquash k).
-  Proof.
-    intros; reflexivity.
-  Qed.
-
-  #[export] Program Instance ext_knot : Ext_ord knot := { ext_order := knot_rel }.
-  Next Obligation.
-  Proof.
-    unfold knot_rel. split.
-    - intros k.
-      destruct (unsquash k); split; auto.
-      apply Rel_refl.
-    - intros k1 k2 k3.
-      destruct (unsquash k1), (unsquash k2), (unsquash k3).
-      intros [] []; subst; split; auto.
-      eapply Rel_trans; eauto.
-  Qed.
-(*  Next Obligation.
-  Proof.
-    intros ?????.
-    unfold age, knot_rel in *. rewrite knot_age1 in H0.
-    destruct (unsquash z) eqn: Hz.
-    destruct n; inv H0.
-    rewrite unsquash_squash in H.
-    destruct (unsquash x) eqn: Hx.
-    destruct H as [? H]; subst.
-    exists (squash (S n0, _f0)); simpl.
-    - rewrite knot_age1, unsquash_squash.
-      f_equal; apply unsquash_inj.
-      rewrite unsquash_squash, Hx.
-      rewrite fmap_app, <- (approx_approx1 1), <- (approx_approx2 1), <- (unsquash_approx Hx).
-      reflexivity.
-    - rewrite unsquash_squash; split; auto.
-      rewrite (unsquash_approx Hz); rewrite (unsquash_approx Hx) in *.
-      rewrite fmap_app, <- (approx_approx1 1), <- (approx_approx2 1).
-      (* may not be true: the unaged pred may not be in Rel even if the aged one is *)
-      admit.
-  Admitted.*)
-  Next Obligation.
-  Proof.
-    intros ?????.
-    unfold age, knot_rel in *. rewrite knot_age1 in H.
-    destruct (unsquash y) eqn: Hy.
-    destruct n; inv H; simpl.
-    destruct (unsquash z) eqn: Hz.
-    destruct H0 as [? H0]; subst.
-    exists (squash (n, _f0)); simpl.
-    - split; auto.
-      do 2 apply Rel_fmap; auto.
-    - rewrite knot_age1, Hz; auto.
-  Qed.
-  Next Obligation.
-  Proof.
-    unfold age, knot_rel in *. rewrite knot_age1 in H0.
-    destruct (unsquash a) eqn: Ha.
-    destruct n; inv H0.
-    destruct (unsquash b) eqn: Hb.
-    destruct H as [? H]; subst.
-    exists (squash (n, _f0)).
-    split.
-    - rewrite knot_age1, Hb; auto.
-    - rewrite !unsquash_squash; split; auto.
-      rewrite fmap_app, unstrat_strat.
-      apply Rel_fmap; auto.
-  Qed.
-  Next Obligation.
-  Proof.
-    rewrite !knot_level. unfold knot_rel in H.
-    destruct (unsquash a), (unsquash b), H; auto.
-  Qed.
-
-  Lemma knot_order : ext_order = knot_rel.
-  Proof. reflexivity. Qed.
-
-End Knot_MixVariantHeredTOthRel.
-
-Module KnotLemmas1.
-
-Class Input: Type := {
-  knot: Type;
-  Fpred: Type;
-  squash: nat * Fpred -> knot;
-  unsquash: knot -> nat * Fpred;
-  approxF: nat -> Fpred -> Fpred;
-  squash_unsquash : forall k:knot, squash (unsquash k) = k;
-  unsquash_squash : forall (n:nat) (f:Fpred),
-    unsquash (squash (n,f)) = (n, approxF n f)
-}.
-
-Class Output (input: Input): Prop := {
-  unsquash_inj : forall k1 k2,
-    unsquash k1 = unsquash k2 ->
-    k1 = k2;
-  squash_surj : forall k, exists n, exists Fp,
-    squash (n, Fp) = k;
-  unsquash_approx : forall k n Fp,
-    unsquash k = (n, Fp) ->
-    Fp = approxF n Fp
-}.
-
-Lemma Proof (kli: Input): Output kli.
-Proof.
-  constructor.
-  + intros.
-    rewrite <- (squash_unsquash k1).
-    rewrite <- (squash_unsquash k2).
-    rewrite H.
-    trivial.
-  + intros.
-    remember (unsquash k).
-    destruct p as [n f].
-    exists n.
-    exists f.
-    rewrite Heqp.
-    rewrite squash_unsquash.
-    trivial.
-  + intros.
-    generalize H; intro.
-    rewrite <- (squash_unsquash k) in H.
-    rewrite H0 in H.
-    rewrite unsquash_squash in H.
-    inversion H.
-    rewrite H2.
-    symmetry.
-    trivial.
-Qed.
-
-End KnotLemmas1.
-
-Module KnotLemmas2.
-
-Class Input: Type := {
-  knot: Type;
-  other: Type;
-  T: Type;
-  t0: T;
-  ageable_knot : ageable knot;
-  predicate: Type;
-  p2p: predicate -> (knot * other -> T);
-  approx : nat -> predicate -> predicate;
-  pred_ext : forall (p1 p2:predicate),
-    (forall x, p2p p1 x = p2p p2 x) ->
-    p1 = p2;
-  approx_spec : forall n p ko,
-    p2p (approx n p) ko =
-     if (Compare_dec.le_gt_dec n (level (fst ko))) then t0 else p2p p ko
-}.
-
-Class Output (input: Input): Prop := {
-  approx_approx1 : forall m n,
-    approx n = approx n oo approx (m+n);
-  approx_approx2 : forall m n,
-    approx n = approx (m+n) oo approx n
-}.
-
-Lemma Proof (kli: Input): Output kli.
-Proof.
-  constructor.
-  + intros.
-    extensionality p.
-    apply pred_ext.
-    intros [k o].
-    unfold compose.
-    repeat rewrite approx_spec.
-    simpl.
-    destruct (Compare_dec.le_gt_dec n (level k)); auto.
-    destruct (Compare_dec.le_gt_dec (m+n) (level k)); auto.
-    exfalso; lia.
-  + intros.
-    extensionality p.
-    apply pred_ext.
-    intros [k o].
-    unfold compose.
-    repeat rewrite approx_spec.
-    simpl.
-    destruct (Compare_dec.le_gt_dec (m+n) (level k)); auto.
-    destruct (Compare_dec.le_gt_dec n (level k)); auto.
-    exfalso; lia.
-Qed.
-
-End KnotLemmas2.
-
-Module KnotLemmas_MixVariantHeredTOthRel (K : KNOT__MIXVARIANT_HERED_T_OTH_REL).
-  Import K.KI.
-  Import K.
-
-  Lemma unsquash_inj : forall k1 k2,
-    unsquash k1 = unsquash k2 ->
-    k1 = k2.
-  Proof.
-    apply
-     (@KnotLemmas1.unsquash_inj
-       (KnotLemmas1.Build_Input _ _ _ _ _ squash_unsquash unsquash_squash)),
-     (KnotLemmas1.Proof).
-  Qed.
-  Arguments unsquash_inj [k1 k2] _.
-
-  Lemma squash_surj : forall k, exists n, exists Fp,
-    squash (n, Fp) = k.
-  Proof.
-    apply
-     (@KnotLemmas1.squash_surj
-       (KnotLemmas1.Build_Input _ _ _ _ _ squash_unsquash unsquash_squash)),
-     (KnotLemmas1.Proof).
-  Qed.
-
-  Lemma unsquash_approx : forall k n Fp,
-    unsquash k = (n, Fp) ->
-    Fp = fmap F (approx n) (approx n) Fp.
-  Proof.
-    apply
-     (@KnotLemmas1.unsquash_approx
-       (KnotLemmas1.Build_Input _ _ _ _ _ squash_unsquash unsquash_squash)),
-     (KnotLemmas1.Proof).
-  Qed.
-  Arguments unsquash_approx [k n Fp] _.
-
-  Lemma pred_ext : forall (p1 p2:predicate),
-    (forall x, proj1_sig p1 x = proj1_sig p2 x) ->
-    p1 = p2.
-  Proof.
-    intros.
-    destruct p1 as [p1 Hp1]; destruct p2 as [p2 Hp2].
-    simpl in *.
-    assert (p1 = p2).
-    extensionality x; auto.
-    subst p2.
-    replace Hp2 with Hp1; auto.
-    apply proof_irr.
-  Qed.
-
-  Lemma approx_approx1 : forall m n,
-    approx n = approx n oo approx (m+n).
-  Proof.
-    apply
-     (@KnotLemmas2.approx_approx1
-       (KnotLemmas2.Build_Input _ _ _ _ _ _ _ _ pred_ext approx_spec)),
-     (KnotLemmas2.Proof).
-  Qed.
-
-  Lemma approx_approx2 : forall m n,
-    approx n = approx (m+n) oo approx n.
-  Proof.
-    apply
-     (@KnotLemmas2.approx_approx2
-       (KnotLemmas2.Build_Input _ _ _ _ _ _ _ _ pred_ext approx_spec)),
-     (KnotLemmas2.Proof).
-  Qed.
-
-End KnotLemmas_MixVariantHeredTOthRel.
-
-Module Type KNOT_FULL_OUTPUT.
-  Declare Module KI: KNOT_INPUT__MIXVARIANT_HERED_T_OTH_REL.
-  Declare Module K0: KNOT__MIXVARIANT_HERED_T_OTH_REL with Module KI := KI.
-  Import K0.
-  Parameter predicate: Type.
-  Parameter pkp: bijection predicate K0.predicate.
-End KNOT_FULL_OUTPUT.
-
-Module Type KNOT_FULL.
-  Declare Module KI: KNOT_INPUT__MIXVARIANT_HERED_T_OTH_REL.
-  Declare Module KO: KNOT_FULL_OUTPUT with Module KI := KI.
-  Import KI.
-  Import KO.
-
-  Definition knot : Type := KO.K0.knot.
-  Definition ageable_knot : ageable knot := KO.K0.ageable_knot.
-  #[global] Existing Instance ageable_knot.
-  Definition ext_knot : Ext_ord knot := KO.K0.ext_knot.
-  #[global] Existing Instance ext_knot.
-  Definition predicate: Type := KO.predicate.
-
-  Definition squash : (nat * KI.F predicate) -> knot :=
-    fun k => KO.K0.squash
-     (fst k, fmap KI.F (bij_f _ _ KO.pkp) (bij_g _ _ KO.pkp) (snd k)).
-
-  Definition unsquash : knot -> (nat * KI.F predicate) :=
-    fun k => let (n, f) := KO.K0.unsquash k in
-      (n, fmap KI.F (bij_g _ _ KO.pkp) (bij_f _ _ KO.pkp) f).
-
-  Parameter approx : nat -> predicate -> predicate.
-
-  Axiom squash_unsquash : forall k:knot, squash (unsquash k) = k.
-  Axiom unsquash_squash : forall (n:nat) (f:F predicate),
-    unsquash (squash (n,f)) = (n, fmap F (approx n) (approx n) f).
-
-  Axiom approx_spec : forall n p ko,
-    proj1_sig (bij_f _ _ KO.pkp (approx n p)) ko =
-     if (Compare_dec.le_gt_dec n (level (fst ko)))
-     then KI.T_bot
-     else proj1_sig (bij_f _ _ KO.pkp p) ko.
-
-  Axiom knot_age1 : forall k:knot,
-    age1 k =
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-
-  Axiom knot_level : forall k:knot,
-    level k = fst (unsquash k).
-
-  Definition knot_rel (k1 k2:knot) :=
-    let (n,f) := unsquash k1 in
-    let (n',f') := unsquash k2 in
-    n = n' /\ KI.Rel predicate f f'.
-
-  Axiom knot_rel_spec: forall k1 k2: knot,
-    knot_rel k1 k2 = KO.K0.knot_rel k1 k2.
-
-End KNOT_FULL.
-
-Module Type KNOT_FULL_LEMMAS.
-  Declare Module K: KNOT_FULL.
-  Import K.
-
-  Axiom unsquash_inj : forall k1 k2,
-    unsquash k1 = unsquash k2 ->
-    k1 = k2.
-  Arguments unsquash_inj [k1 k2] _.
-
-  Axiom squash_surj : forall k, exists n, exists Fp,
-    squash (n, Fp) = k.
-
-  Axiom unsquash_approx : forall k n Fp,
-    unsquash k = (n, Fp) ->
-    Fp = fmap KI.F (approx n) (approx n) Fp.
-  Arguments unsquash_approx [k n Fp] _.
-
-  Axiom approx_approx1 : forall m n,
-    approx n = approx n oo approx (m+n).
-
-  Axiom approx_approx2 : forall m n,
-    approx n = approx (m+n) oo approx n.
-
-End KNOT_FULL_LEMMAS.
-
-Module KnotFull
-  (KI': KNOT_INPUT__MIXVARIANT_HERED_T_OTH_REL)
-  (KO': KNOT_FULL_OUTPUT with Module KI := KI'):
-  KNOT_FULL with Module KI := KI' with Module KO:=KO'.
-
-  Import MixVariantFunctor.
-  Module KI:=KI'.
-  Module KO:=KO'.
-
-  Definition knot: Type := KO.K0.knot.
-  Definition ageable_knot : ageable knot := KO.K0.ageable_knot.
-  #[global] Existing Instance ageable_knot.
-  Definition ext_knot : Ext_ord knot := KO.K0.ext_knot.
-  #[global] Existing Instance ext_knot.
-  Definition predicate: Type := KO.predicate.
-
-  Definition squash : (nat * KI.F predicate) -> knot :=
-    fun k => KO.K0.squash
-     (fst k, fmap KI.F (bij_f _ _ KO.pkp) (bij_g _ _ KO.pkp) (snd k)).
-
-  Definition unsquash : knot -> (nat * KI.F predicate) :=
-    fun k => let (n, f) := KO.K0.unsquash k in
-      (n, fmap KI.F (bij_g _ _ KO.pkp) (bij_f _ _ KO.pkp) f).
-
-  Definition approx : nat -> predicate -> predicate :=
-    fun n => (bij_g _ _ KO.pkp) oo KO.K0.approx n oo (bij_f _ _ KO.pkp).
-
-  Lemma squash_unsquash : forall k:knot, squash (unsquash k) = k.
-  Proof.
-    intros; unfold squash, unsquash.
-    destruct (KO.K0.unsquash k) as [n f] eqn:?H; simpl.
-    rewrite fmap_app, bij_fg_id, fmap_id.
-    unfold id.
-    rewrite <- H; apply KO.K0.squash_unsquash.
-  Qed.
-
-  Lemma unsquash_squash : forall (n:nat) (f:KI.F predicate),
-    unsquash (squash (n,f)) = (n, fmap KI.F (approx n) (approx n) f).
-  Proof.
-    intros; unfold squash, unsquash, approx; simpl.
-    rewrite KO.K0.unsquash_squash, !fmap_app, compose_assoc.
-    auto.
-  Qed.
-
-  Lemma approx_spec : forall n p ko,
-    proj1_sig (bij_f _ _ KO.pkp (approx n p)) ko =
-     if (Compare_dec.le_gt_dec n (level (fst ko)))
-     then KI.T_bot
-     else proj1_sig (bij_f _ _ KO.pkp p) ko.
-  Proof.
-    intros.
-    rewrite <- KO.K0.approx_spec.
-    unfold approx.
-    pattern (KO.K0.approx n) at 2.
-    rewrite <- (id_unit2 _ _ (KO.K0.approx n)), <- (bij_fg_id KO.pkp).
-    reflexivity.
-  Qed.
-
-  Lemma knot_age1 : forall k:knot,
-    age1 k =
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-  Proof.
-    intros.
-    unfold squash, unsquash.
-    rewrite KO.K0.knot_age1.
-    destruct (KO.K0.unsquash k) as [n f] eqn:?H.
-    destruct n; auto.
-    f_equal; simpl.
-    rewrite fmap_app, bij_fg_id, fmap_id.
-    auto.
-  Qed.
-
-  Lemma knot_level: forall k:knot, level k = fst (unsquash k).
-  Proof.
-    intros.
-    unfold unsquash.
-    rewrite KO.K0.knot_level.
-    destruct (KO.K0.unsquash k) as [n f]; auto.
-  Qed.
-
-  Definition knot_rel (k1 k2:knot) :=
-    let (n,f) := unsquash k1 in
-    let (n',f') := unsquash k2 in
-    n = n' /\ KI.Rel predicate f f'.
-
-  Lemma knot_rel_spec: forall k1 k2: knot,
-    knot_rel k1 k2 = KO.K0.knot_rel k1 k2.
-  Proof.
-    intros.
-    unfold knot_rel, KO.K0.knot_rel, unsquash.
-    destruct (KO.K0.unsquash k1) as [n1 f1].
-    destruct (KO.K0.unsquash k2) as [n2 f2].
-    f_equal.
-    apply prop_ext.
-    split; intros.
-    + pose proof KI.Rel_fmap _ _ (bij_f _ _ KO.pkp) (bij_g _ _ KO.pkp) _ _ H.
-      rewrite !fmap_app, bij_fg_id, fmap_id in H0.
-      auto.
-    + pose proof KI.Rel_fmap _ _ (bij_g _ _ KO.pkp) (bij_f _ _ KO.pkp) _ _ H.
-      auto.
-  Qed.
-
-End KnotFull.
-
-Module KnotFullLemmas (K: KNOT_FULL).
-  Import K.KI.
-  Import K.
-
-  Lemma unsquash_inj : forall k1 k2,
-    unsquash k1 = unsquash k2 ->
-    k1 = k2.
-  Proof.
-    apply
-     (@KnotLemmas1.unsquash_inj
-       (KnotLemmas1.Build_Input _ _ _ _ _ squash_unsquash unsquash_squash)),
-     (KnotLemmas1.Proof).
-  Qed.
-  Arguments unsquash_inj [k1 k2] _.
-
-  Lemma squash_surj : forall k, exists n, exists Fp,
-    squash (n, Fp) = k.
-  Proof.
-    apply
-     (@KnotLemmas1.squash_surj
-       (KnotLemmas1.Build_Input _ _ _ _ _ squash_unsquash unsquash_squash)),
-     (KnotLemmas1.Proof).
-  Qed.
-
-  Lemma unsquash_approx : forall k n Fp,
-    unsquash k = (n, Fp) ->
-    Fp = fmap F (approx n) (approx n) Fp.
-  Proof.
-    apply
-     (@KnotLemmas1.unsquash_approx
-       (KnotLemmas1.Build_Input _ _ _ _ _ squash_unsquash unsquash_squash)),
-     (KnotLemmas1.Proof).
-  Qed.
-  Arguments unsquash_approx [k n Fp] _.
-
-  Lemma pred_ext : forall (p1 p2:predicate),
-    (forall x, proj1_sig (bij_f _ _ KO.pkp p1) x =
-               proj1_sig (bij_f _ _ KO.pkp p2) x) ->
-    p1 = p2.
-  Proof.
-    intros.
-    change (p1 = p2) with (id K.KO.predicate p1 = id K.KO.predicate p2).
-    rewrite <- (bij_gf_id KO.pkp); unfold compose.
-    destruct (bij_f _ _ KO.pkp p1) as [pp1 Hp1];
-    destruct (bij_f _ _ KO.pkp p2) as [pp2 Hp2].
-    simpl in *.
-    assert (pp1 = pp2).
-    extensionality x; auto.
-    subst pp2.
-    replace Hp2 with Hp1; auto.
-    apply proof_irr.
-  Qed.
-
-  Lemma approx_approx1 : forall m n,
-    approx n = approx n oo approx (m+n).
-  Proof.
-    apply
-     (@KnotLemmas2.approx_approx1
-       (KnotLemmas2.Build_Input _ _ _ _ _ _
-         (@proj1_sig _ _ oo bij_f _ _ K.KO.pkp) _ pred_ext approx_spec)),
-     (KnotLemmas2.Proof).
-  Qed.
-
-  Lemma approx_approx2 : forall m n,
-    approx n = approx (m+n) oo approx n.
-  Proof.
-    apply
-     (@KnotLemmas2.approx_approx2
-       (KnotLemmas2.Build_Input _ _ _ _ _ _
-         (@proj1_sig _ _ oo bij_f _ _ K.KO.pkp) _ pred_ext approx_spec)),
-     (KnotLemmas2.Proof).
-  Qed.
-
-End KnotFullLemmas.
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-(*
-Module Type KNOT_FULL_INPUT.
-  Parameter F : functor.
-
-  Parameter other : Type.
-
-  Parameter Rel : forall A, F A -> F A -> Prop.
-
-  Parameter Rel_fmap : forall A B (f1: A->B) (f2:B->A) x y,
-    Rel A x y ->
-    Rel B (fmap F f1 f2 x) (fmap F f1 f2 y).
-  Axiom Rel_refl : forall A x, Rel A x x.
-  Axiom Rel_trans : forall A x y z,
-    Rel A x y -> Rel A y z -> Rel A x z.
-
-  Parameter ORel : other -> other -> Prop.
-  Axiom ORel_refl : reflexive other ORel.
-  Axiom ORel_trans : transitive other ORel.
-
-  Parameter T:Type.
-  Parameter T_bot:T.
-
-  Parameter T_rel : T -> T -> Prop.
-  Parameter T_rel_bot : forall x, T_rel T_bot x.
-  Parameter T_rel_refl : forall x, T_rel x x.
-  Parameter T_rel_trans : transitive T T_rel.
-
-  Parameter Pred: forall K: Type, ageable K -> (K -> K -> Prop) -> Type.
-
-  Parameter Pred2predicate: forall {K agK KRel},
-    Pred K agK KRel ->
-    { p: K * other -> T |
-      (forall k k' k'' o o',
-      clos_refl_trans _ age k k' ->
-      KRel k' k'' ->
-      ORel o o' ->
-      T_rel (p (k,o)) (p (k'',o'))) }.
-
-  Parameter predicate2Pred: forall {K agK} {KRel: K -> K -> Prop},
-    { p: K * other -> T |
-      (forall (k k' k'': K) o o',
-      clos_refl_trans _ age k k' ->
-      KRel k' k'' ->
-      ORel o o' ->
-      T_rel (p (k,o)) (p (k'',o'))) } ->
-    Pred K agK KRel.
-
-  Axiom P2p2P: forall K agK KRel (P: Pred K agK KRel),
-    predicate2Pred (Pred2predicate P) = P.
-
-  Axiom p2P2p: forall K agK KRel p,
-    Pred2predicate (@predicate2Pred K agK KRel p) = p.
-
-End KNOT_FULL_INPUT.
-
-Module Type KNOT_FULL.
-  Declare Module KI: KNOT_FULL_INPUT.
-  Import KI.
-
-  Parameter knot:Type.
-  Parameter ageable_knot : ageable knot.
-  #[global] Existing Instance ageable_knot.
-  Parameter knot_rel: knot -> knot -> Prop.
-
-  Definition predicate: Type := Pred knot ageable_knot knot_rel.
-
-  Parameter squash : (nat * F predicate) -> knot.
-  Parameter unsquash : knot -> (nat * F predicate).
-
-  Parameter approx : nat -> predicate -> predicate.
-
-  Axiom squash_unsquash : forall k:knot, squash (unsquash k) = k.
-  Axiom unsquash_squash : forall (n:nat) (f:F predicate),
-    unsquash (squash (n,f)) = (n, fmap F (approx n) (approx n) f).
-
-  Axiom approx_spec : forall n p ko,
-    proj1_sig (Pred2predicate (approx n (predicate2Pred p))) ko =
-     if (le_gt_dec n (level (fst ko))) then T_bot else proj1_sig p ko.
-
-  Axiom knot_rel_spec: forall (k1 k2:knot),
-     knot_rel k1 k2 =
-    let (n,f) := unsquash k1 in
-    let (n',f') := unsquash k2 in
-    n = n' /\ Rel predicate f f'.
-
-  Axiom knot_age1 : forall k:knot,
-    age1 k =
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-
-  Axiom knot_level : forall k:knot,
-    level k = fst (unsquash k).
-
-End KNOT_FULL.
-
-Module KnotFull (KI': KNOT_FULL_INPUT): KNOT_FULL with Module KI:=KI'.
-
-  Import MixVariantFunctor.
-  Module KI:=KI'.
-
-  Module Input.
-    Definition F: functor := KI.F.
-    Definition other: Type := KI.other.
-    Definition Rel: forall (A:Type), KI.F A -> KI.F A -> Prop := KI.Rel.
-
-    Definition Rel_fmap : forall A B (f1: A->B) (f2:B->A) x y,
-      Rel A x y ->
-      Rel B (fmap F f1 f2 x) (fmap F f1 f2 y)
-      := KI.Rel_fmap.
-
-    Definition Rel_refl : forall A x, Rel A x x := KI.Rel_refl.
-
-    Definition Rel_trans : forall A x y z,
-      Rel A x y -> Rel A y z -> Rel A x z
-      := KI.Rel_trans.
-
-    Definition ORel := KI.ORel.
-    Definition ORel_refl := KI.ORel_refl.
-    Definition ORel_trans := KI.ORel_trans.
-
-    Definition T := KI.T.
-    Definition T_bot: T := KI.T_bot.
-    Definition T_rel : T -> T -> Prop := KI.T_rel.
-    Definition T_rel_bot : forall x, T_rel T_bot x := KI.T_rel_bot.
-    Definition T_rel_refl : forall x, T_rel x x := KI.T_rel_refl.
-    Definition T_rel_trans : transitive T T_rel := KI.T_rel_trans.
-  End Input.
-
-  Module K := Knot_MixVariantHeredTOthRel(Input).
-  Module KL := KnotLemmas_MixVariantHeredTOthRel(K).
-
-  Definition knot: Type := K.knot.
-  Definition ageable_knot : ageable knot := K.ageable_knot.
-  #[global] Existing Instance ageable_knot.
-  Definition knot_rel: knot -> knot -> Prop := K.knot_rel.
-  Definition predicate: Type := KI.Pred knot ageable_knot knot_rel.
-
-  Definition squash : (nat * KI.F predicate) -> knot :=
-    fun k => K.squash (fst k, fmap KI.F KI.Pred2predicate KI.predicate2Pred (snd k)).
-
-  Parameter unsquash : knot -> (nat * F predicate).
-
-  Parameter approx : nat -> predicate -> predicate.
-
-  Axiom squash_unsquash : forall k:knot, squash (unsquash k) = k.
-  Axiom unsquash_squash : forall (n:nat) (f:F predicate),
-    unsquash (squash (n,f)) = (n, fmap F (approx n) (approx n) f).
-
-  Axiom approx_spec : forall n p ko,
-    proj1_sig (Pred2predicate (approx n (predicate2Pred p))) ko =
-     if (le_gt_dec n (level (fst ko))) then T_bot else proj1_sig p ko.
-
-  Axiom knot_rel_spec: forall (k1 k2:knot),
-     knot_rel k1 k2 =
-    let (n,f) := unsquash k1 in
-    let (n',f') := unsquash k2 in
-    n = n' /\ Rel predicate f f'.
-
-  Axiom knot_age1 : forall k:knot,
-    age1 k =
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-
-  Axiom knot_level : forall k:knot,
-    level k = fst (unsquash k).
-
-*)
diff --git a/msl/knot_hered.v b/msl/knot_hered.v
deleted file mode 100644
index 341992f52b..0000000000
--- a/msl/knot_hered.v
+++ /dev/null
@@ -1,702 +0,0 @@
-(*
- * Copyright (c) 2009-2011, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-
-Require Import VST.msl.base.
-Local Open Scope nat_scope.
-
-Require Import VST.msl.ageable.
-Require Import VST.msl.functors.
-Require Import VST.msl.predicates_hered.
-
-Import CovariantFunctor.
-Import CovariantFunctorLemmas.
-Import CovariantFunctorGenerator.
-
-Module Type TY_FUNCTOR_PROP.
-  Parameter F : functor.
-  Parameter other : Type.
-End TY_FUNCTOR_PROP.
-
-Module Type KNOT_HERED.
-  Declare Module TF:TY_FUNCTOR_PROP.
-  Import TF.
-
-  Parameter knot:Type.
-  Parameter ag_knot : ageable knot.
-  #[global] Existing Instance ag_knot.
-  #[global] Existing Instance ag_prod.
-  Parameter ext_knot : Ext_ord knot.
-  #[global] Existing Instance ext_knot.
-  #[global] Existing Instance Ext_prod.
-
-  Parameter hered : (knot * other -> Prop) -> Prop.
-  Definition predicate := { p:knot * other -> Prop | hered p }.
-
-  Parameter squash : (nat * F predicate) -> knot.
-  Parameter unsquash : knot -> (nat * F predicate).
-
-  Parameter approx : nat -> predicate -> predicate.
-
-  Axiom squash_unsquash : forall k:knot, squash (unsquash k) = k.
-  Axiom unsquash_squash : forall (n:nat) (f:F predicate),
-    unsquash (squash (n,f)) = (n, fmap F (approx n) f).
-
-  Axiom approx_spec : forall n p k,
-    proj1_sig (approx n p) k = (level k < n /\ proj1_sig p k).
-
-  Axiom knot_level : forall k:knot, level k = fst (unsquash k).
-
-  Axiom knot_age1 : forall k,
-    age1 k =
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-
-End KNOT_HERED.
-
-Module KnotHered (TF':TY_FUNCTOR_PROP) : KNOT_HERED with Module TF:=TF'.
-  Module TF:=TF'.
-  Import TF.
-
-  Definition sinv_prod X := prod X (F X * other -> Prop).
-
-  Definition guppy_sig := (fun T:Type => T * (F T * other -> Prop) -> Prop).
-  Definition guppy_ty := sigT guppy_sig.
-
-  Definition guppy_step_ty (Z:guppy_ty) : Type :=
-    (sig (fun (x:sinv_prod (projT1 Z)) => projT2 Z x)).
-
-  Definition guppy_step_prop (Z:guppy_ty) (xf:sinv_prod (guppy_step_ty Z)) :=
-    forall (k:F (guppy_step_ty Z)) (o:other),
-      snd xf (k,o) -> snd (proj1_sig (fst xf)) (fmap F (@fst _ _ oo @proj1_sig _ _) k,o).
-
-  Definition guppy_step (Z:guppy_ty) : guppy_ty :=
-    existT guppy_sig (guppy_step_ty Z) (guppy_step_prop Z).
-
-  Definition guppy_base : guppy_ty :=
-    existT guppy_sig unit (fun _ => True).
-
-  Fixpoint guppy (n:nat) : guppy_ty :=
-    match n with
-    | 0    => guppy_base
-    | S n' => guppy_step (guppy n')
-    end.
-
-  Definition sinv (n:nat) : Type := projT1 (guppy n).
-  Definition sinv_prop (n:nat) : prod (sinv n) (F (sinv n) * other -> Prop) -> Prop := projT2 (guppy n).
-
-  Fixpoint floor (m:nat) (n:nat) (p:sinv (m+n)) : sinv n :=
-    match m as m' return forall (p : sinv (m'+n)), sinv n with
-    | O => fun p => p
-    | S m' => fun p => floor m' n (fst (proj1_sig p))
-    end p.
-
-  Definition knot := { n:nat & F (sinv n) }.
-
-  Definition k_age1 (k:knot) : option (knot) :=
-    match k with
-      | (existT _ 0 f) => None
-      | (existT _ (S m) f) => Some
-          (existT (F oo sinv) m (fmap F (@fst _ _ oo @proj1_sig _ _) f))
-    end.
-
-  Definition k_age (k1 k2:knot) := k_age1 k1 = Some k2.
-
-  Definition ko_age1 (x:knot * other) :=
-    match k_age1 (fst x) with
-    | None => None
-    | Some a' => Some (a',snd x)
-    end.
-  Definition ko_age x y := ko_age1 x = Some y.
-
-  Definition hered := hereditary ko_age.
-  Definition predicate := { p:knot * other -> Prop | hereditary ko_age p }.
-
-  Definition app_sinv (n:nat) (p:sinv (S n)) (x:F (sinv n) * other) :=
-    snd (proj1_sig p) x.
-
-  Lemma app_sinv_age : forall n (p:sinv (S (S n))) (f:F (sinv (S n)) * other),
-    app_sinv (S n) p f ->
-    app_sinv n (fst (proj1_sig p)) (fmap F (@fst _ _ oo @proj1_sig _ _) (fst f), snd f).
-  Proof.
-    intros.
-    unfold app_sinv in *.
-    destruct p; simpl in *; fold guppy in *.
-    apply p; auto.
-    destruct f; auto.
-  Qed.
-
-  Section stratifies.
-    Variable Q:knot * other -> Prop.
-    Variable HQ:hereditary ko_age Q.
-
-    Fixpoint stratifies (n:nat) : sinv n -> Prop :=
-    match n as n' return sinv n' -> Prop with
-    | 0 => fun _ => True
-    | S n' => fun (p:sinv (S n')) =>
-          stratifies n' (fst (proj1_sig p)) /\
-          forall (k:F (sinv n')) (o:other), snd (proj1_sig p) (k,o) <-> Q (existT (F oo sinv) n' k,o)
-    end.
-
-    Lemma stratifies_unique : forall n p1 p2,
-      stratifies n p1 ->
-      stratifies n p2 ->
-      p1 = p2.
-    Proof.
-      induction n; simpl; intuition.
-      destruct p1; destruct p2; auto.
-      destruct p1; destruct p2.
-      simpl in *; fold guppy in *.
-      cut (x = x0).
-      intros.
-      revert p p0 H2 H3.
-      rewrite <- H0.
-      intros.
-      replace p0 with p by (apply proof_irr); auto.
-      destruct x; destruct x0; simpl in *.
-      apply injective_projections; simpl.
-      apply IHn; auto.
-      extensionality; intros.
-      simpl in *.
-      destruct (H2 (fst x) (snd x)); destruct (H3 (fst x) (snd x)).
-      apply prop_ext; destruct x; intuition.
-    Qed.
-
-    Definition stratify (n:nat) : { x:sinv n | stratifies n x }.
-    Proof.
-      induction n.
-      exists tt; simpl; exact I.
-      assert (HX:
-        projT2 (guppy n)
-        (proj1_sig IHn, fun v : F (sinv n) * other => Q (existT (F oo sinv) n (fst v),snd v))).
-      destruct n.
-      simpl; exact I.
-      simpl; intros.
-      destruct IHn; simpl.
-      simpl in s; destruct s.
-      destruct x; simpl in *; fold guppy in *.
-      destruct x; simpl in *.
-      hnf; simpl; intros.
-      rewrite H0.
-      eapply HQ.
-      2: apply H1.
-      simpl; reflexivity.
-      exists ((exist (fun x => projT2 (guppy n) x) ( proj1_sig IHn, fun v:F (sinv n) * other => Q (existT (F oo sinv) n (fst v),snd v) ) HX)).
-      simpl; split.
-      destruct IHn; auto.
-      unfold app_sinv; simpl; intros.
-      split; trivial.
-    Qed.
-  End stratifies.
-
-  Lemma decompose_nat : forall (x y:nat), { m:nat & y = (m + S x) } + { ge x y }.
-  Proof.
-    intros x y; revert x; induction y; simpl; intros.
-    right; auto with arith.
-    destruct (IHy x) as [[m H]|H].
-    left; exists (S m); lia.
-    destruct (Peano_dec.eq_nat_dec x y).
-    left; exists O; lia.
-    right; lia.
-  Qed.
-
-  Definition unstratify (n:nat) (p:sinv n) : knot * other -> Prop := fun w =>
-    match w with (existT _ nw w',o) =>
-      match decompose_nat nw n with
-        | inleft (existT _ m Hm) => snd (proj1_sig (floor m (S nw) (eq_rect  n _ p (m + S nw) Hm))) (w',o)
-        | inright H => False
-      end
-    end.
-
-  Lemma floor_shuffle:
-    forall (m1 n : nat)
-      (p1 : sinv (m1 + S n)) (H1 : (m1 + S n) = (S m1 + n)),
-      floor (S m1) n (eq_rect (m1 + S n) sinv p1 (S m1 + n) H1) = fst (proj1_sig (floor m1 (S n) p1)).
-  Proof.
-    intros.
-    remember (fst (proj1_sig (floor m1 (S n) p1))) as p.
-    fold guppy in *.
-    revert n p1 H1 p Heqp.
-    induction m1; simpl; intros.
-    replace H1 with (refl_equal (S n)) by (apply proof_irr); simpl; auto.
-    assert (m1 + S n = S m1 + n) by lia.
-    destruct p1 as [[p1 f'] Hp1]; simpl in *; fold guppy in *.
-    generalize (IHm1 n p1 H p Heqp).
-    clear.
-    revert Hp1 H1; generalize H.
-    revert p1 f'.
-    rewrite H.
-    simpl; intros.
-    replace H1 with (refl_equal (S (S (m1 + n)))) by (apply proof_irr).
-    simpl.
-    replace H0 with (refl_equal (S (m1+n))) in H2 by (apply proof_irr).
-    simpl in H2.
-    trivial.
-  Qed.
-
-  Lemma unstratify_hered : forall n p,
-    hereditary ko_age (unstratify n p).
-  Proof.
-    intros.
-    hnf; intros k k'; intros.
-    simpl in H.
-    destruct k.
-    destruct k as [x f]. destruct x.
-    discriminate.
-    destruct k' as [k' o'].
-    assert (o = o').
-    hnf in H.
-    simpl in H.
-    inv H. auto.
-    subst o'.
-    replace k' with
-      (existT (F oo sinv) x (fmap F (@fst _ _ oo @proj1_sig _ _ ) f)).
-    2: inversion H; auto.
-    clear H.
-    case_eq (decompose_nat x n); intros.
-    destruct s.
-    case_eq (decompose_nat (S x) n); intros.
-    destruct s.
-    destruct n.
-    exfalso; lia.
-    assert (S x1 = x0) by lia; subst x0.
-    revert H0.
-    unfold unstratify.
-    rewrite H; rewrite H1.
-    generalize e e0; revert p; rewrite e0; intros.
-    rewrite floor_shuffle.
-    replace e2 with (refl_equal (x1 + S (S x))) in H0;
-      simpl eq_rect in H0.
-    2: apply proof_irr.
-    change f with (fst (f,o)).
-    change o with (snd (f,o)).
-    eapply app_sinv_age; apply H0.
-
-    revert H0.
-    unfold unstratify.
-    rewrite H; rewrite H1.
-    intuition.
-
-    case_eq (decompose_nat (S x) n); intros.
-    destruct s.
-    exfalso; lia.
-    revert H0.
-    unfold unstratify.
-    rewrite H; rewrite H1; auto.
-  Qed.
-
-  Lemma unstratify_Q : forall n (p:sinv n) Q,
-    stratifies Q n p ->
-    forall (k:knot) o,
-      projT1 k < n ->
-      (unstratify n p (k,o) <-> Q (k,o)).
-  Proof.
-    intros.
-    unfold unstratify.
-    destruct k.
-    destruct (decompose_nat x n).
-    destruct s.
-    simpl in H0.
-    2: simpl in *; exfalso; lia.
-    clear H0.
-    revert p H.
-    generalize e.
-    rewrite e.
-    intros.
-    replace e0 with (refl_equal (x0 + S x)) by apply proof_irr.
-    simpl.
-    clear e e0.
-    revert p H.
-    induction x0; simpl; intros.
-    destruct H.
-    auto.
-    destruct H.
-    apply IHx0.
-    auto.
-  Qed.
-
-  Lemma stratifies_unstratify_more :
-    forall (n m1 m2:nat) (p1:sinv (m1+n)) (p2:sinv (m2+n)),
-      floor m1 n p1 = floor m2 n p2 ->
-      (stratifies (unstratify (m1+n) p1) n (floor m1 n p1) ->
-       stratifies (unstratify (m2+n) p2) n (floor m2 n p2)).
-  Proof.
-    induction n; intuition.
-    split.
-    assert (m2 + S n = S m2 + n) by lia.
-    erewrite <- floor_shuffle.
-    instantiate (1:=H1).
-    replace (unstratify (m2 + S n) p2)
-      with (unstratify (S m2 + n) (eq_rect (m2 + S n) sinv p2 (S m2 + n) H1)).
-    assert (m1 + S n = S m1 + n) by lia.
-    eapply (IHn (S m1) (S m2)
-      (eq_rect (m1 + S n) sinv p1 (S m1 + n) H2)).
-    rewrite floor_shuffle.
-    rewrite floor_shuffle.
-    rewrite H; auto.
-    clear - H0.
-    rewrite floor_shuffle.
-    simpl in H0.
-    destruct H0.
-    clear H0.
-    revert p1 H.
-    generalize H2.
-    rewrite <- H2.
-    intros.
-    replace H0 with (refl_equal (m1 + S n)) by apply proof_irr; auto.
-    clear.
-    revert p2.
-    generalize H1.
-    rewrite H1.
-    intros.
-    replace H0 with (refl_equal (S m2 + n)) by apply proof_irr; auto.
-
-    intros.
-    simpl.
-    destruct (decompose_nat n (m2 + S n)).
-    destruct s.
-    assert (m2 = x).
-    lia.
-    subst x.
-    replace e with (refl_equal (m2 + S n)).
-    simpl; tauto.
-    apply proof_irr.
-    exfalso; lia.
-  Qed.
-
-  Lemma stratify_unstratify : forall n p H,
-    proj1_sig (stratify (unstratify n p) H n) = p.
-  Proof.
-    intros.
-    apply stratifies_unique with (unstratify n p).
-    destruct (stratify _ H n).
-    simpl; auto.
-    clear H.
-    revert p; induction n.
-    simpl; intros; auto.
-    intros.
-    simpl; split.
-
-    assert (stratifies (unstratify n (fst (proj1_sig p))) n (fst (proj1_sig p))).
-    apply IHn.
-    apply (stratifies_unstratify_more n 0 1 (fst (proj1_sig p)) p).
-    simpl; auto.
-    auto.
-
-    intros.
-    destruct (decompose_nat n (S n)).
-    destruct s.
-    assert (x = 0) by lia.
-    subst x.
-    simpl.
-    simpl in e.
-    replace e with (refl_equal (S n)) by apply proof_irr.
-    simpl.
-    split; auto.
-    exfalso; lia.
-  Qed.
-
-
-  Definition strat (n:nat) (p:predicate) : sinv n :=
-    proj1_sig (stratify (proj1_sig p) (proj2_sig p) n).
-
-  Definition unstrat (n:nat) (p:sinv n) : predicate :=
-    exist (hereditary ko_age) (unstratify n p) (unstratify_hered n p).
-
-  Definition squash (x:nat * F predicate) : knot :=
-    match x with (n,f) => existT (F oo sinv) n (fmap F (strat n) f) end.
-
-  Definition unsquash (k:knot) : nat * F predicate :=
-    match k with existT _ n f => (n, fmap F (unstrat n) f) end.
-
-  Definition level (x:knot) : nat := fst (unsquash x).
-  Program Definition approx (n:nat) (p:predicate) : predicate :=
-     fun w => level (fst w) < n /\ p w.
-  Next Obligation.
-    hnf; simpl; intros.
-    intuition.
-    unfold ko_age, ko_age1 in H.
-    destruct (k_age1 (fst a)) eqn: Hage; inv H; simpl.
-    assert (level k < level (fst a)); [|lia].
-    unfold level, unsquash.
-    destruct a as ((n', ?), ?); simpl in *.
-    destruct n'; inv Hage; simpl in *; lia.
-    destruct p; simpl in *.
-    eapply h; eauto.
-  Qed.
-
-  Lemma strat_unstrat : forall n,
-    strat n oo unstrat n = id (sinv n).
-  Proof.
-    intros; extensionality p.
-    unfold compose, id.
-    unfold strat, unstrat.
-    simpl.
-    rewrite stratify_unstratify.
-    auto.
-  Qed.
-
-  Lemma predicate_eq : forall (p1 p2:predicate),
-    proj1_sig p1 = proj1_sig p2 ->
-    p1 = p2.
-  Proof.
-    intros; destruct p1; destruct p2; simpl in H.
-    subst x0.
-    replace h0 with h by apply proof_irr.
-    auto.
-  Qed.
-
-  Lemma unstrat_strat : forall n,
-    unstrat n oo strat n = approx n.
-  Proof.
-    intros.
-    extensionality.
-    unfold compose.
-    unfold unstrat, strat.
-    unfold approx.
-    apply predicate_eq.
-    simpl.
-    extensionality k.
-    apply prop_ext; intuition.
-    unfold unstratify in H.
-    destruct a.
-    destruct (decompose_nat x0 n).
-    unfold level.
-    simpl.
-    destruct s.
-    lia.
-    elim H.
-    rewrite <- unstratify_Q.
-    apply H.
-    destruct (stratify (proj1_sig x) (proj2_sig x) n); auto.
-    unfold unstratify in H.
-    destruct a; simpl.
-    destruct (decompose_nat x0 n).
-    destruct s; lia.
-    elim H.
-    rewrite unstratify_Q.
-    apply H1.
-    destruct (stratify (proj1_sig x) (proj2_sig x) n); auto.
-    unfold level in H0.
-    destruct a; simpl in *.
-    auto.
-  Qed.
-
-  Lemma squash_unsquash : forall k, squash (unsquash k) = k.
-  Proof.
-    intros.
-    destruct k as [x f]; simpl.
-    f_equal.
-    change ((fmap F (strat x) oo fmap F (unstrat x)) f = f).
-    rewrite fmap_comp.
-    rewrite strat_unstrat.
-    rewrite fmap_id.
-    auto.
-  Qed.
-
-  Lemma unsquash_squash : forall n f,
-    unsquash (squash (n,f)) = (n, fmap F (approx n) f).
-  Proof.
-    intros.
-    unfold unsquash, squash.
-    f_equal.
-    change ((fmap F (unstrat n) oo fmap F (strat n)) f = fmap F (approx n) f).
-    rewrite fmap_comp.
-    rewrite unstrat_strat.
-    auto.
-  Qed.
-
-  Lemma strat_unstrat_Sx : forall x,
-    @fst _ _ oo @proj1_sig _ _ = strat x oo unstrat (S x).
-  Proof.
-    intros.
-    extensionality k.
-    change (sinv (S x)) in k.
-    unfold compose.
-    unfold strat, unstrat.
-    simpl.
-    apply stratifies_unique with (unstratify x (fst (proj1_sig k))).
-    revert k; induction x; simpl; auto.
-    intros.
-    split.
-    eapply (stratifies_unstratify_more x 0 1 ).
-    simpl; reflexivity.
-    simpl.
-    apply IHx.
-    intros.
-    destruct (decompose_nat x (S x)).
-    destruct s.
-    assert (x0 = 0) by lia; subst x0.
-    simpl in *.
-    replace e with (refl_equal (S x)) by apply proof_irr; simpl.
-    tauto.
-    exfalso; lia.
-    destruct (stratify (unstratify (S x) k)
-      (unstratify_hered (S x) k) x).
-    simpl; auto.
-    cut (x0 = (fst (proj1_sig k))); intros.
-    subst x0.
-    eapply (stratifies_unstratify_more x 1 0).
-    simpl; reflexivity.
-    simpl; auto.
-    eapply stratifies_unique.
-    apply s.
-    eapply (stratifies_unstratify_more x 0 1).
-    simpl; reflexivity.
-    simpl.
-    generalize (fst (proj1_sig k) : sinv x).
-    clear.
-    induction x; simpl; intuition.
-    eapply (stratifies_unstratify_more x 0 1).
-    simpl; reflexivity.
-    simpl.
-    apply IHx.
-    destruct (decompose_nat x (S x)).
-    destruct s0.
-    assert (x0 = 0) by lia; subst.
-    simpl in *.
-    replace e with (refl_equal (S x)); simpl; auto.
-    apply proof_irr.
-    lia.
-    destruct (decompose_nat x (S x)).
-    destruct s0.
-    assert (x0 = 0) by lia; subst.
-    simpl in *.
-    replace e with (refl_equal (S x)) in H; simpl; auto.
-    apply proof_irr.
-    elim H.
-  Qed.
-
-  Lemma unsquash_inj : forall k k',
-    unsquash k = unsquash k' -> k = k'.
-  Proof.
-    intros.
-    rewrite <- (squash_unsquash k).
-    rewrite <- (squash_unsquash k').
-    congruence.
-  Qed.
-
-  Lemma knot_age_age1 : forall k k',
-    k_age1 k = Some k' <->
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end = Some k'.
-  Proof.
-    split; intros.
-    unfold k_age1 in H.
-    unfold unsquash in H.
-    destruct k as [x f].
-    destruct x; auto.
-    inv H.
-    simpl.
-    f_equal.
-    f_equal.
-    change (fmap F (strat x) (fmap F (unstrat (S x)) f))
-      with ((fmap F (strat x) oo fmap F (unstrat (S x))) f).
-    rewrite fmap_comp.
-    simpl.
-    f_equal.
-    symmetry.
-    apply (strat_unstrat_Sx x).
-
-    simpl in H.
-    destruct k.
-    destruct x.
-    discriminate.
-    inv H.
-    hnf; simpl.
-    unfold k_age1.
-    f_equal.
-    f_equal.
-    rewrite strat_unstrat_Sx.
-    rewrite <- fmap_comp.
-    auto.
-  Qed.
-
-  #[global] Program Instance ag_knot : ageable knot :=
-  { age1 := k_age1
-  ; level := level
-  }.
-  Next Obligation.
-    econstructor.
-    (* unage *)
-    intros.
-    destruct (unsquash x') as [n f] eqn:?H; intros.
-    exists (squash (S n, f)).
-    rewrite knot_age_age1.
-    rewrite unsquash_squash.
-    f_equal.
-    apply unsquash_inj.
-    rewrite unsquash_squash.
-    rewrite H.
-    f_equal.
-    cut (f = fmap F (approx n) f).
-    intros.
-    rewrite fmap_app.
-    pattern f at 2. rewrite H0.
-    f_equal.
-    extensionality p.
-    apply predicate_eq.
-    extensionality w.
-    simpl. apply prop_ext.
-    intuition.
-    generalize H; intro.
-    rewrite <- (squash_unsquash x') in H.
-    rewrite H0 in H.
-    rewrite unsquash_squash in H.
-    congruence.
-
-    (* level 0 *)
-    intro x. destruct x; simpl.
-    destruct x; intuition; discriminate.
-
-    (* level S *)
-    intros. destruct x; simpl in *.
-    destruct x. discriminate.
-    inv H. simpl. auto.
-  Qed.
-
-  #[global] Existing Instance ag_prod.
-
-  Lemma approx_spec : forall n p (k:knot * other),
-    proj1_sig (approx n p) k = (ageable.level k < n /\ proj1_sig p k).
-  Proof.
-    intros.
-    apply prop_ext.
-    unfold approx; simpl.
-    intuition; simpl in *; auto.
-  Qed.
-
-  Lemma knot_level : forall k:knot, level k = fst (unsquash k).
-  Proof. reflexivity. Qed.
-
-  Lemma knot_age1 : forall k,
-    age1 k =
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-  Proof.
-    intros. simpl.
-    case_eq (k_age1 k). intros.
-    rewrite knot_age_age1 in H.
-    auto.
-    destruct k; simpl. destruct x. auto.
-    intros. discriminate.
-  Qed.
-
-  #[export] Program Instance ext_knot : Ext_ord knot := { ext_order := eq }.
-  Next Obligation.
-  Proof.
-    intros ?????; subst; eauto.
-  Qed.
-  Next Obligation.
-  Proof.
-    eauto.
-  Qed.
-
-End KnotHered.
diff --git a/msl/knot_hered_sa.v b/msl/knot_hered_sa.v
deleted file mode 100644
index ab6d8c5569..0000000000
--- a/msl/knot_hered_sa.v
+++ /dev/null
@@ -1,313 +0,0 @@
-(*
- * Copyright (c) 2009-2011, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-
-Require Import VST.msl.base.
-Open Local Scope nat_scope.
-
-Require Import VST.msl.ageable.
-Require Import VST.msl.functors.
-Require Import VST.msl.sepalg.
-Require Import VST.msl.sepalg_functors.
-Require Import VST.msl.sepalg_generators.
-Require Import VST.msl.predicates_hered.
-Require Import VST.msl.knot_hered.
-Require Import VST.msl.knot_lemmas.
-Require Import VST.msl.age_sepalg.
-
-Import CovariantFunctor.
-Import CovariantFunctorLemmas.
-Import CovariantFunctorGenerator.
-
-Module Type TY_FUNCTOR_SA_PROP.
-  Declare Module TF:TY_FUNCTOR_PROP.
-  Import TF.
-
-  Parameter Join_F: forall A, Join (F A). #[global] Existing Instance Join_F.
-(*   Parameter Perm_F: forall A, Perm_alg (F A). EXisting #[global] Instance Perm_F. *)
-  Parameter paf_F : pafunctor f_F.        #[global] Existing Instance paf_F.
-  Parameter Perm_F: Perm_paf f_F Join_F.
-  Parameter Sep_F: Sep_paf f_F Join_F.
-  Parameter Canc_F: Canc_paf f_F Join_F.
-  Parameter Disj_F: Disj_paf f_F Join_F.
-End TY_FUNCTOR_SA_PROP.
-
-Module Type KNOT_HERED_SA.
-  Declare Module TFSA:TY_FUNCTOR_SA_PROP.
-  Declare Module K:KNOT_HERED with Module TF:=TFSA.TF.
-
-  Import TFSA.TF.
-  Import TFSA.
-  Import K.
-
-  Parameter Join_knot: Join knot.  #[global] Existing Instance Join_knot.
-  Parameter Perm_knot : Perm_alg knot.  #[global] Existing Instance Perm_knot.
-  Parameter Sep_knot : (forall A, Sep_alg (F A)) -> Sep_alg knot.  #[global] Existing Instance Sep_knot.
-  Parameter Canc_knot : (forall A, Canc_alg (F A)) -> Canc_alg knot.  #[global] Existing Instance Canc_knot.
-  Parameter Disj_knot : (forall A, Disj_alg (F A)) -> Disj_alg knot.  #[global] Existing Instance Disj_knot.
-
-  #[global] Instance Join_nat_F: Join (nat * F predicate) :=
-       Join_prod nat  (Join_equiv nat) (F predicate) _.
-
- #[global] Instance Perm_nat_F : Perm_alg (nat * F predicate) :=
-    @Perm_prod nat _ _ _ (Perm_equiv _) (Perm_F predicate _ (Perm_equiv _)).
- #[global] Instance Sep_nat_F (Sep_F: forall A, Sep_alg (F A)): Sep_alg (nat * F predicate) :=
-    @Sep_prod nat _ _ _ (Sep_equiv _) (Sep_F predicate).
- #[global] Instance Canc_nat_F (Canc_F: forall A, Canc_alg (F A)): Canc_alg (nat * F predicate) :=
-    @Canc_prod nat _ _ _ (Canc_equiv _) (Canc_F predicate).
- #[global] Instance Disj_nat_F (Disj_F: forall A, Disj_alg (F A)): Disj_alg (nat * F predicate) :=
-    @Disj_prod nat _ _ _ (Disj_equiv _) (Disj_F predicate).
-
-  Axiom join_unsquash : forall x1 x2 x3 : knot,
-    join x1 x2 x3 = join (unsquash x1) (unsquash x2) (unsquash x3).
-
-  Axiom asa_knot : Age_alg knot.
-
-End KNOT_HERED_SA.
-
-Module KnotHeredSa (TFSA':TY_FUNCTOR_SA_PROP) (K':KNOT_HERED with Module TF:=TFSA'.TF)
-  : KNOT_HERED_SA with Module TFSA:=TFSA' with Module K:=K'.
-
-  Module TFSA:=TFSA'.
-  Module K:=K'.
-
-  Module KL := KnotHered_Lemmas(K).
-
-  Import TFSA.TF.
-  Import TFSA.
-  Import K.
-  Import KL.
-
-  #[global] Instance Join_nat_F: Join (nat * F predicate) :=
-       Join_prod nat  (Join_equiv nat) (F predicate) _.
-
- #[global] Instance Perm_nat_F : Perm_alg (nat * F predicate) :=
-    @Perm_prod nat _ _ _ (Perm_equiv _) (Perm_F predicate _ (Perm_equiv _)).
- #[global] Instance Sep_nat_F (Sep_F: forall A, Sep_alg (F A)): Sep_alg (nat * F predicate) :=
-    @Sep_prod nat _ _ _ (Sep_equiv _) (Sep_F predicate).
- #[global] Instance Canc_nat_F (Canc_F: forall A, Canc_alg (F A)): Canc_alg (nat * F predicate) :=
-    @Canc_prod nat _ _ _ (Canc_equiv _) (Canc_F predicate).
- #[global] Instance Disj_nat_F (Disj_F: forall A, Disj_alg (F A)): Disj_alg (nat * F predicate) :=
-    @Disj_prod nat _ _ _ (Disj_equiv _) (Disj_F predicate).
-
-  Lemma unsquash_squash_join_hom : join_hom (unsquash oo squash).
-  Proof.
-    unfold compose.
-    intros [x1 x2] [y1 y2] [z1 z2] ?.
-    do 3 rewrite (unsquash_squash).
-    firstorder.
-    simpl in *.
-    subst y1.
-    subst z1.
-    apply paf_join_hom. auto.
-  Qed.
-
-  #[global] Instance Join_knot : Join knot :=
-           Join_preimage knot (nat * F predicate) Join_nat_F unsquash.
-
-  #[global] Instance Perm_knot : Perm_alg knot :=
-    Perm_preimage _ _ _ _ unsquash squash squash_unsquash unsquash_squash_join_hom.
-
-  #[global] Instance Sep_knot(Sep_F: forall A, Sep_alg (F A)) : Sep_alg knot :=
-    Sep_preimage _ _ _  unsquash squash squash_unsquash unsquash_squash_join_hom.
-
-  Lemma join_unsquash : forall x1 x2 x3,
-    join x1 x2 x3 =
-    join (unsquash x1) (unsquash x2) (unsquash x3).
-  Proof.
-    intuition.
-  Qed.
-
-  #[global] Instance Canc_knot(Canc_F: forall A, Canc_alg (F A)) : Canc_alg knot.
-  Proof. repeat intro.
-            do 3 red in H, H0.
-            apply unsquash_inj.
-            apply (join_canc H H0).
-  Qed.
-
-  #[global] Instance Disj_knot(Disj_F: forall A, Disj_alg (F A)) : Disj_alg knot.
-  Proof.
-   repeat intro.
-   do 3 red in H.
-   apply join_self in H.
-   apply unsquash_inj; auto.
-  Qed.
-
-  Lemma age_join1 :
-    forall x y z x' : K'.knot,
-      join x y z ->
-      age x x' ->
-      exists y' : K'.knot,
-        exists z' : K'.knot, join x' y' z' /\ age y y' /\ age z z'.
-  Proof.
-    intros.
-    unfold age in *; simpl in *.
-    rewrite knot_age1 in H0.
-    repeat rewrite knot_age1.
-    do 3 red in H.
-    destruct (unsquash x).
-    destruct (unsquash y).
-    destruct (unsquash z).
-    destruct n; try discriminate.
-    inv H0.
-   simpl in H; destruct H.
-    simpl in H; destruct H.
-    subst n0 n1.
-    exists (squash (n,f0)).
-    exists (squash (n,f1)).
-    simpl in H0.
-    split; intuition. do 3  red.
-    repeat rewrite unsquash_squash.
-    split; auto. simpl snd.
-    apply paf_join_hom; auto.
-  Qed.
-  Lemma age_join2 :
-    forall x y z z' : K'.knot,
-      join x y z ->
-      age z z' ->
-      exists x' : K'.knot,
-        exists y' : K'.knot, join x' y' z' /\ age x x' /\ age y y'.
-  Proof.
-    intros.
-    unfold age in *; simpl in *.
-    rewrite knot_age1 in H0.
-    repeat rewrite knot_age1.
-    do 3 red in H.
-    destruct (unsquash x).
-    destruct (unsquash y).
-    destruct (unsquash z).
-    destruct n1; try discriminate.
-    inv H0.
-    destruct H; simpl in *.
-    destruct H; subst.
-    exists (squash (n1,f)).
-    exists (squash (n1,f0)).
-    split; intuition. do 3  red.
-    repeat rewrite unsquash_squash.
-    split; auto. simpl snd.
-    apply paf_join_hom; auto.
-  Qed.
-
-  Lemma unage_join1 : forall x x' y' z', join x' y' z' -> age x x' ->
-    exists y, exists z, join x y z /\ age y y' /\ age z z'.
-  Proof.
-    intros.
-    unfold join, Join_knot, Join_preimage, age in *; simpl in *.
-    revert H0; rewrite knot_age1; case_eq (unsquash x); intros.
-    destruct n; inv H1.
-    hnf in H. rewrite unsquash_squash in H. simpl in H.
-    revert H.
-    case_eq (unsquash y');
-    case_eq (unsquash z'); intros.
-    destruct H2; simpl in *.
-    destruct H2; subst.
-    rename n0 into n.
-    destruct (paf_preserves_unmap_right (approx n) f f1 f0)
-      as [q [w [? [? ?]]]].
-    rewrite <- (unsquash_approx H1); auto.
-    exists (squash (S n,q)).
-    exists (squash (S n,w)). split. hnf.
-    repeat rewrite unsquash_squash.
-    split; simpl; auto.
-    generalize (paf_join_hom (approx (S n)) _ _ _ H2).
-    rewrite <- (unsquash_approx H0); auto.
-
-    split; hnf.
-    rewrite knot_age1.
-    rewrite unsquash_squash. f_equal.
-    replace y' with (squash (n,fmap (approx (S n)) q)); auto.
-    apply unsquash_inj.
-    rewrite unsquash_squash, H1.
-    apply injective_projections; simpl; auto.
-    rewrite (unsquash_approx H1).
-    rewrite <- H4.
-    rewrite fmap_app.
-    replace (approx n oo approx (S n)) with (approx n); auto.
-    extensionality a.
-    replace (S n) with (1 + n)%nat by trivial.
-    rewrite <- (approx_approx1 1 n).
-    trivial.
-
-    rewrite knot_age1.
-    rewrite unsquash_squash. f_equal.
-    replace z' with  (squash (n,fmap (approx (S n)) w)); auto.
-    apply unsquash_inj.
-    rewrite unsquash_squash, H.
-    apply injective_projections; simpl; auto.
-    rewrite <- H5.
-    rewrite fmap_app.
-    replace (approx n oo approx (S n)) with (approx n); auto.
-    extensionality a.
-    replace (S n) with (1 + n)%nat by trivial.
-    rewrite <- (approx_approx1 1 n).
-    trivial.
-  Qed.
-
-  Lemma unage_join2 :
-    forall z x' y' z', join x' y' z' -> age z z' ->
-      exists x, exists y, join x y z /\ age x x' /\ age y y'.
-  Proof.
-    intros.
-    rewrite join_unsquash in H.
-    revert H H0.
-    unfold join, Join_knot, Join_preimage, age in *; simpl in *.
-    repeat rewrite knot_age1.
-
-    case_eq (unsquash x');
-    case_eq (unsquash y');
-    case_eq (unsquash z');
-    case_eq (unsquash z); intros.
-    destruct n;  inv H4.
-    destruct H3. hnf in H3. simpl in *. destruct H3; subst.
-    rewrite unsquash_squash in H0.
-    inv H0.
-    rename n0 into n.
-
-    destruct (paf_preserves_unmap_left
-      (approx n) f2 f1 f)
-      as [wx [wy [? [? ?]]]]; auto.
-    rewrite <- (unsquash_approx H1); auto.
-    exists (squash (S n, wx)).
-    exists (squash (S n, wy)).
-    split. unfold join, Join_nat_F, Join_prod; simpl.
-    (* unfold Join_knot; simpl. unfold Join_preimage; simpl. *)
-    repeat rewrite unsquash_squash.  simpl.  split; auto.
-
-    rewrite (unsquash_approx H).
-    apply paf_join_hom; auto.
-    split; rewrite knot_age1; rewrite unsquash_squash; f_equal; hnf.
-    apply unsquash_inj.
-    rewrite unsquash_squash, H2.
-    apply injective_projections; simpl; auto.
-    rewrite fmap_app.
-    replace (approx n oo approx (S n)) with (approx n); auto.
-    extensionality x.
-    unfold compose.
-    change (approx n (approx (S n) x)) with ((approx n oo approx (1 + n)) x).
-    rewrite <- (approx_approx1 1 n).
-    trivial.
-    apply unsquash_inj.
-    rewrite unsquash_squash, H1.
-    apply injective_projections; simpl; auto.
-    rewrite fmap_app.
-    replace (approx n oo approx (S n)) with (approx n); auto.
-    rewrite H5.
-    rewrite <- (unsquash_approx H1); auto.
-    extensionality x.
-    unfold compose.
-    change (approx n (approx (S n) x)) with ((approx n oo approx (1 + n)) x).
-    rewrite <- (approx_approx1 1 n).
-    trivial.
-  Qed.
-
-  Theorem asa_knot : @Age_alg knot _ K.ag_knot.
-  Proof.
-    constructor.
-    exact age_join1.
-    exact age_join2.
-    exact unage_join1.
-    exact unage_join2.
-  Qed.
-
-End KnotHeredSa.
\ No newline at end of file
diff --git a/msl/knot_lemmas.v b/msl/knot_lemmas.v
deleted file mode 100644
index a24600e87f..0000000000
--- a/msl/knot_lemmas.v
+++ /dev/null
@@ -1,224 +0,0 @@
-(*
- * Copyright (c) 2009-2011, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-
-Require Import VST.msl.base.
-Require Import VST.msl.ageable.
-Require Import VST.msl.knot.
-Require Import VST.msl.knot_hered.
-Require Import VST.msl.functors.
-
-Import CovariantFunctor.
-Import CovariantFunctorLemmas.
-Import CovariantFunctorGenerator.
-
-Module Knot_Lemmas (K : KNOT).
-  Import K.TF.
-  Import K.
-
-  Lemma unsquash_inj : forall k1 k2,
-    unsquash k1 = unsquash k2 ->
-    k1 = k2.
-  Proof.
-    intros.
-    rewrite <- (squash_unsquash k1).
-    rewrite <- (squash_unsquash k2).
-    rewrite H.
-    trivial.
-  Qed.
-  Arguments unsquash_inj [k1 k2] _.
-
-  Lemma squash_surj : forall k, exists n, exists Fp,
-    squash (n, Fp) = k.
-  Proof.
-  intros.
-  remember (unsquash k).
-  destruct p as [n f].
-  exists n.
-  exists f.
-  rewrite Heqp.
-  rewrite squash_unsquash.
-  trivial.
-  Qed.
-
-  Lemma unsquash_approx : forall k n Fp,
-    unsquash k = (n, Fp) ->
-    Fp = fmap F (approx n) Fp.
-  Proof.
-    intros.
-    generalize H; intro.
-    rewrite <- (squash_unsquash k) in H.
-    rewrite H0 in H.
-    rewrite unsquash_squash in H.
-    inversion H.
-    rewrite H2.
-    symmetry.
-    trivial.
-  Qed.
-  Arguments unsquash_approx [k n Fp] _.
-
-  Lemma approx_approx1 : forall m n,
-    approx n = approx n oo approx (m+n).
-  Proof.
-    intros.
-    extensionality p x; destruct x as [k o].
-    unfold approx, compose; simpl.
-    destruct (Compare_dec.le_gt_dec n (level k)); auto.
-    destruct (Compare_dec.le_gt_dec (m+n) (level k)); auto.
-    exfalso; lia.
-  Qed.
-
-  Lemma approx_approx2 : forall m n,
-    approx n = approx (m+n) oo approx n.
-  Proof.
-    intros.
-    extensionality p x; destruct x as [k o].
-    unfold approx, compose; simpl.
-    destruct (Compare_dec.le_gt_dec (m+n) (level k)); auto.
-    destruct (Compare_dec.le_gt_dec n (level k)); auto.
-    exfalso; lia.
-  Qed.
-
-  (* These are provided since sometimes it is tedious to break things out;
-      they are not interesting except as engineering artifacts. *)
-  Lemma unsquash_squash_unfolded : forall nf,
-    unsquash (squash nf) = (fst nf, fmap F (approx (fst nf)) (snd nf)).
-  Proof.
-    intros.
-    destruct nf.
-    apply unsquash_squash.
-  Qed.
-
-  Lemma unsquash_approx_unfolded : forall k,
-    unsquash k = (fst (unsquash k), fmap F (approx (fst (unsquash k))) (snd (unsquash k))).
-  Proof.
-    intros.
-    case_eq (unsquash k); intros.
-    simpl.
-    apply injective_projections; simpl; trivial.
-    apply (unsquash_approx H).
-  Qed.
-
-(*
-  Lemma unsquash_not_surj :
-    (exists rbot : rhs, rbot <> rhs_top) ->
-    (exists Fp : F predicate, True) ->
-    forall n, exists Fp, forall k, unsquash k <> (n, Fp).
-  Proof.
-  intros.
-  destruct H as [bot ?].
-  destruct H0 as [anF _].
-  remember (fun (p : predicate) (w : knot * other) => bot) as badf.
-  remember (fmap badf anF) as badF.
-  exists badF.
-  repeat intro.
-  generalize (unsquash_approx H0); intro.
-  rewrite HeqbadF in H1.
-  replace (fmap (approx n) (fmap badf anF)) with
-    ((fmap (approx n) oo fmap badf) anF) in H1 by trivial.
-  rewrite fmap_comp in H1.
-  XXXXX  (* Gah, annoying *)
-*)
-
-End Knot_Lemmas.
-
-Module KnotHered_Lemmas (K : KNOT_HERED).
-  Import K.TF.
-  Import K.
-
-  Lemma predicate_eq : forall (p1 p2:predicate),
-    proj1_sig p1 = proj1_sig p2 ->
-    p1 = p2.
-  Proof.
-    intros; destruct p1; destruct p2; simpl in H.
-    subst x0.
-    replace h0 with h by apply proof_irr.
-    auto.
-  Qed.
-
-  Lemma unsquash_inj : forall k1 k2,
-    unsquash k1 = unsquash k2 ->
-    k1 = k2.
-  Proof.
-    intros.
-    rewrite <- (squash_unsquash k1).
-    rewrite <- (squash_unsquash k2).
-    rewrite H.
-    trivial.
-  Qed.
-  Arguments unsquash_inj [k1 k2] _.
-
-  Lemma squash_surj : forall k, exists n, exists Fp,
-    squash (n, Fp) = k.
-  Proof.
-  intros.
-  remember (unsquash k).
-  destruct p as [n f].
-  exists n.
-  exists f.
-  rewrite Heqp.
-  rewrite squash_unsquash.
-  trivial.
-  Qed.
-
-  Lemma unsquash_approx : forall k n Fp,
-    unsquash k = (n, Fp) ->
-    Fp = fmap F (approx n) Fp.
-  Proof.
-    intros.
-    generalize H; intro.
-    rewrite <- (squash_unsquash k) in H.
-    rewrite H0 in H.
-    rewrite unsquash_squash in H.
-    inversion H.
-    rewrite H2.
-    symmetry.
-    trivial.
-  Qed.
-  Arguments unsquash_approx [k n Fp] _.
-
-  Lemma approx_approx1 : forall m n,
-    approx n = approx n oo approx (m+n).
-  Proof.
-    intros.
-    extensionality p.
-    apply predicate_eq.
-    extensionality x; destruct x as [k o].
-    unfold compose.
-    repeat rewrite approx_spec.
-    apply prop_ext. intuition.
-    lia.
-  Qed.
-
-  Lemma approx_approx2 : forall m n,
-    approx n = approx (m+n) oo approx n.
-  Proof.
-    intros.
-    extensionality p. apply predicate_eq.
-    extensionality x; destruct x as [k o].
-    unfold compose. repeat rewrite approx_spec.
-    apply prop_ext. intuition. lia.
-  Qed.
-
-  (* These are provided since sometimes it is tedious to break things out;
-      they are not interesting except as engineering artifacts. *)
-  Lemma unsquash_squash_unfolded : forall nf,
-    unsquash (squash nf) = (fst nf, fmap F (approx (fst nf)) (snd nf)).
-  Proof.
-    intros.
-    destruct nf.
-    apply unsquash_squash.
-  Qed.
-
-  Lemma unsquash_approx_unfolded : forall k,
-    unsquash k = (fst (unsquash k), fmap F (approx (fst (unsquash k))) (snd (unsquash k))).
-  Proof.
-    intros.
-    case_eq (unsquash k); intros.
-    simpl.
-    apply injective_projections; simpl; trivial.
-    apply (unsquash_approx H).
-  Qed.
-
-End KnotHered_Lemmas.
diff --git a/msl/knot_prop.v b/msl/knot_prop.v
deleted file mode 100644
index 133c6e8250..0000000000
--- a/msl/knot_prop.v
+++ /dev/null
@@ -1,260 +0,0 @@
-(*
- * Copyright (c) 2009-2011, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-
-Require Import VST.msl.base.
-Require Import VST.msl.knot.
-Require Import VST.msl.ageable.
-Require Import VST.msl.sepalg.
-Require Import VST.msl.sepalg_generators.
-Require Import VST.msl.sepalg_functors.
-Require Import VST.msl.age_sepalg.
-Require Import VST.msl.knot_lemmas.
-Require Import VST.msl.functors.
-Require Import VST.msl.sepalg_functors.
-Require Import VST.msl.knot_hered.
-
-Import CovariantFunctor.
-Import CovariantFunctorLemmas.
-Import CovariantFunctorGenerator.
-
-(* This file specializes knot to have T = Prop *)
-
-Local Open Scope nat_scope.
-
-(*
-  We get these from knot_hered and knot_hered_sa.
-
-Module Type TY_FUNCTOR_PROP.
-  Parameter F : Type -> Type.
-  Parameter f_F : functor F.
-  #[global] Existing Instance f_F.
-
-  Parameter other : Type.
-End TY_FUNCTOR_PROP.
-
-Module Type TY_FUNCTOR_SA_PROP.
-  Declare Module TF:TY_FUNCTOR_PROP.
-  Import TF.
-
-  Parameter saf_F : safunctor f_F.
-  #[global] Existing Instance saf_F.
-End TY_FUNCTOR_SA_PROP.
-*)
-
-Module Type KNOT_PROP.
-  Declare Module TF:TY_FUNCTOR_PROP.
-  Import TF.
-
-  Parameter knot : Type.
-
-  Parameter ag_knot : ageable knot.
-  #[global] Existing Instance ag_knot.
-  #[global] Existing Instance ag_prod.
-
-  Definition predicate := (knot * other) -> Prop.
-
-  Parameter squash : (nat * F predicate) -> knot.
-  Parameter unsquash : knot -> (nat * F predicate).
-
-  Definition approx (n:nat) (p:predicate) : predicate :=
-     fun w => level w < n /\ p w.
-
-  Axiom squash_unsquash : forall x, squash (unsquash x) = x.
-  Axiom unsquash_squash : forall n x', unsquash (squash (n,x')) = (n, fmap F (approx n) x').
-
-  Axiom knot_level : forall k:knot,
-    level k = fst (unsquash k).
-
-  Axiom knot_age1 : forall k:knot,
-    age1 k =
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-End KNOT_PROP.
-
-(* Coercion *)
-Module TyFunctorProp2TyFunctor (TF : TY_FUNCTOR_PROP) <: TY_FUNCTOR.
-(*  EXport TFP. Does not seem to work? *)
-  Definition F := TF.F.
-  Definition T: Type := Prop.
-  Definition T_bot : T := False.
-
-  Definition other := TF.other.
-End TyFunctorProp2TyFunctor.
-
-Module KnotProp (TF':TY_FUNCTOR_PROP) : KNOT_PROP with Module TF:=TF'.
-  Module TF := TF'.
-
-  Module TF_G := TyFunctorProp2TyFunctor(TF).
-
-  Module Knot_G := Knot(TF_G).
-
-  Import TF.
-  Definition knot : Type := Knot_G.knot.
-  Definition predicate := (knot * other) -> Prop.
-
-  Definition squash : (nat * F predicate) -> knot :=
-    Knot_G.squash.
-  Definition unsquash : knot -> (nat * F predicate) :=
-    Knot_G.unsquash.
-
-  Definition ag_knot := Knot_G.ag_knot.
-  #[global] Existing Instance ag_knot.
-  #[global] Existing Instance ag_prod.
-
-  Definition approx (n:nat) (p:predicate) : predicate :=
-     fun w => level w < n /\ p w.
-
-  Lemma squash_unsquash : forall x, squash (unsquash x) = x.
-  Proof.
-    apply Knot_G.squash_unsquash.
-  Qed.
-
-  Lemma unsquash_squash : forall n x', unsquash (squash (n,x')) = (n,fmap F (approx n) x').
-  Proof.
-    replace approx with Knot_G.approx.
-    apply Knot_G.unsquash_squash.
-    extensionality n p w.
-    unfold approx, Knot_G.approx, TF_G.T_bot.
-    destruct (Compare_dec.le_gt_dec); apply prop_ext; firstorder.
-    unfold knot, TF_G.other, ag_knot in *. lia.
-  Qed.
-
-  Definition knot_level := Knot_G.knot_level.
-  Definition knot_age1 := Knot_G.knot_age1.
-End KnotProp.
-
-(* Coercion *)
-Module KnotProp2Knot (TF' : TY_FUNCTOR_PROP)
-                                   (K : KNOT_PROP with Module TF := TF') <:
-                                     KNOT.
-  Module TF := TyFunctorProp2TyFunctor(K.TF).
-  Import TF.
-
-  Definition knot : Type := K.knot.
-  Definition predicate := (knot * other) -> T.
-
-  Definition ag_knot : ageable knot :=
-    K.ag_knot.
-  #[global] Existing Instance ag_knot.
-  #[global] Existing Instance ag_prod.
-
-  Definition squash : (nat * F predicate) -> knot :=
-    K.squash.
-  Definition unsquash : knot -> (nat * F predicate) :=
-    K.unsquash.
-
-  Definition approx (n:nat) (p:predicate) : predicate :=
-     fun w => if Compare_dec.le_gt_dec n (level w) then T_bot else p w.
-
-  Lemma squash_unsquash : forall x, squash (unsquash x) = x.
-  Proof.
-    apply K.squash_unsquash.
-  Qed.
-
-  Lemma unsquash_squash : forall n x', unsquash (squash (n,x')) = (n,fmap F (approx n) x').
-  Proof.
-    replace approx with K.approx.
-    apply K.unsquash_squash.
-    extensionality n p w.
-    unfold approx, K.approx, TF.T_bot.
-    destruct (Compare_dec.le_gt_dec); apply prop_ext; firstorder.
-    unfold knot, ag_knot, other in *.
-    lia.
-  Qed.
-
-
-  Definition knot_level := K.knot_level.
-  Definition knot_age1 := K.knot_age1.
-End KnotProp2Knot.
-
-Module KnotProp_Lemmas (K:KNOT_PROP).
-  Import K.
-  Import K.TF.
-
-  Module K' := KnotProp2Knot(K.TF)(K).
-  Module KL := Knot_Lemmas(K').
-
-  Lemma unsquash_inj : forall k1 k2,
-    unsquash k1 = unsquash k2 ->
-    k1 = k2.
-  Proof.
-    intros.
-    rewrite <- (squash_unsquash k1).
-    rewrite <- (squash_unsquash k2).
-    rewrite H.
-    trivial.
-  Qed.
-  Arguments unsquash_inj [k1 k2] _.
-
-  Lemma squash_surj : forall k, exists n, exists Fp,
-    squash (n, Fp) = k.
-  Proof.
-    intros.
-    remember (unsquash k).
-    destruct p as [n f].
-    exists n.
-    exists f.
-    rewrite Heqp.
-    rewrite squash_unsquash.
-    trivial.
-  Qed.
-
-  Lemma unsquash_approx : forall k n Fp,
-    unsquash k = (n, Fp) ->
-    Fp = fmap F (approx n) Fp.
-  Proof.
-    intros.
-    generalize H; intro.
-    rewrite <- (squash_unsquash k) in H.
-    rewrite H0 in H.
-    rewrite unsquash_squash in H.
-    inversion H.
-    rewrite H2.
-    symmetry.
-    trivial.
-  Qed.
-  Arguments unsquash_approx [k n Fp] _.
-
-  Lemma approx_approx1 : forall m n,
-    approx n = approx n oo approx (m+n).
-  Proof.
-    intros.
-    extensionality p x; destruct x as [k o].
-    unfold approx, compose; simpl.
-    apply prop_ext; intuition. lia.
-  Qed.
-
-  Lemma approx_approx2 : forall m n,
-    approx n = approx (m+n) oo approx n.
-  Proof.
-    intros.
-    extensionality p x; destruct x as [k o].
-    unfold approx, compose; simpl.
-    apply prop_ext; intuition. lia.
-  Qed.
-
-  (* These are provided since sometimes it is tedious to break things out;
-      they are not interesting except as engineering artifacts. *)
-  Lemma unsquash_squash_unfolded : forall nf,
-    unsquash (squash nf) = (fst nf, fmap F (approx (fst nf)) (snd nf)).
-  Proof.
-    intros.
-    destruct nf.
-    apply unsquash_squash.
-  Qed.
-	
-  Lemma unsquash_approx_unfolded : forall k,
-    unsquash k = (fst (unsquash k), fmap F (approx (fst (unsquash k))) (snd (unsquash k))).
-  Proof.
-    intros.
-    case_eq (unsquash k); intros.
-    simpl.
-    apply injective_projections; simpl; trivial.
-    apply (unsquash_approx H).
-  Qed.
-
-End KnotProp_Lemmas.
diff --git a/msl/knot_setoid.v b/msl/knot_setoid.v
deleted file mode 100644
index bebe7bcb6c..0000000000
--- a/msl/knot_setoid.v
+++ /dev/null
@@ -1,601 +0,0 @@
-(*
- * Copyright (c) 2009-2010, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-
-Require Import Coq.Relations.Relations.
-Require Import Coq.Arith.Compare_dec.
-Require Import Coq.Arith.Peano_dec.
-Require Import Coq.Logic.Eqdep_dec.
-Require Import Coq.Classes.SetoidClass.
-Require Import Coq.Classes.Morphisms.
-Require Omega.
-
-Local Open Scope nat_scope.
-
-Program Definition EqSetoid (A:Type) : Setoid A := @Build_Setoid A (@eq A) _.
-Next Obligation.
-  constructor; hnf; intuition.
-  transitivity y; auto.
-Qed.
-
-#[global] Program Instance ProdSetoid `(Setoid A) `(Setoid B) : Setoid (A * B) :=
-  { equiv := fun z w => equiv (fst z) (fst w) /\ equiv (snd z) (snd w)
-  }.
-Next Obligation.
-  constructor; hnf; intuition; simpl in *.
-  transitivity a0; auto.
-  transitivity b0; auto.
-Qed.
-
-Inductive Mor `(As:Setoid A) `(Bs:Setoid B) :=
-  { mor_fun :> A -> B
-  ; mor_prf :> @Morphism (A -> B) (equiv ==> equiv)%signature mor_fun
-  }.
-Implicit Arguments Build_Mor [A B].
-
-Program Definition fstM `{As:Setoid A} `{Bs:Setoid B} : Mor (ProdSetoid As Bs) As
- := Build_Mor _ _ (@fst A B) _.
-Next Obligation.
-  hnf; simpl; intuition.
-Qed.
-
-Program Definition sndM `{As:Setoid A} `{Bs:Setoid B} : Mor (ProdSetoid As Bs) Bs
- := Build_Mor _ _ (@snd A B) _.
-Next Obligation.
-  hnf; simpl; intuition.
-Qed.
-
-Definition ext_equiv `(As:Setoid A) `(Bs:Setoid B) : relation (Mor As Bs) :=
-  fun f g => forall a a':A, a == a' -> f a == g a'.
-
-Lemma ext_is_equiv `(As:Setoid A) `(Bs:Setoid B) : Equivalence (ext_equiv As Bs).
-Proof.
-  intros; constructor; do 2 (hnf; intros).
-  apply mor_prf; auto.
-  transitivity (y a').
-  apply mor_prf; auto.
-  symmetry; apply H; auto.
-  reflexivity.
-  transitivity (y a').
-  apply H; auto.
-  apply H0; reflexivity.
-Qed.
-
-#[global] Instance MorSetoid  `(As:Setoid A) `(Bs:Setoid B) : Setoid (Mor As Bs) :=
-  { equiv := ext_equiv As Bs
-  ; setoid_equiv := ext_is_equiv As Bs
-  }.
-
-Program Definition idM `(As:Setoid A) : Mor As As := Build_Mor As As (@id A) _.
-Next Obligation.
-  hnf; auto.
-Qed.
-
-Program Definition composeM `{As:Setoid A} `{Bs:Setoid B} `{Cs:Setoid C}
-  (f:Mor Bs Cs) `(g:Mor As Bs) := Build_Mor As Cs (fun x => f (g x)) _.
-Next Obligation.
-  hnf; intros.
-  apply f; apply g; auto.
-Qed.
-Infix "oo" := composeM (at level 54, right associativity).
-
-Module Type TY_FUNCTOR.
-  Parameter F : Type -> Type.
-  #[global] Instance Fs : forall {A}, Setoid A -> Setoid (F A).
-
-  Parameter fmap : forall `{As:Setoid A} `{Bs:Setoid B}, Mor As Bs -> Mor (Fs As) (Fs Bs).
-
-  Axiom fmap_mor : forall `{As:Setoid A} `{Bs:Setoid B},
-    Morphism (equiv ==> equiv) fmap.
-
-  Axiom fmap_id : forall `{As:Setoid A}, fmap (idM As) == idM (Fs As).
-  Axiom fmap_comp : forall `{As:Setoid A} `{Bs:Setoid B} `{Cs:Setoid C}
-    (f:Mor Bs Cs) (g:Mor As Bs),
-    fmap f oo fmap g == fmap (f oo g).
-
-  Parameter T : Type.
-  #[global] Instance Ts : Setoid T.
-  Parameter T_bot : T.
-
-  Parameter other : Type.
-  Parameter otherS : Setoid other.
-End TY_FUNCTOR.
-
-Module Type KNOT.
-  Declare Module TF:TY_FUNCTOR.
-  Import TF.
-
-  Parameter knot : Type.
-  #[global] Instance knotS : Setoid knot.
-  Definition koS : Setoid (knot * other) := @ProdSetoid knot knotS other otherS.
-  Definition predicate := Mor koS Ts.
-  Definition predS : Setoid predicate := MorSetoid koS Ts.
-  Definition natFS : Setoid (nat * F predicate) := @ProdSetoid nat (EqSetoid nat) (F predicate) (Fs predS).
-  #[global] Existing Instance koS.
-  #[global] Existing Instance predS.
-  #[global] Existing Instance natFS.
-
-  Parameter squash : Mor natFS knotS.
-  Parameter unsquash : Mor knotS natFS.
-
-  Definition level : Mor knotS (EqSetoid nat) := fstM oo unsquash.
-  Parameter approx : forall n:nat, Mor predS predS.
-
-  Axiom approx_spec : forall n p w, approx n p w ==
-    if (le_gt_dec n (level (fst w))) then T_bot else p w.
-
-  Axiom squash_unsquash : forall x, squash (unsquash x) == x.
-  Axiom unsquash_squash : forall n x', unsquash (squash (n,x')) == (n,fmap (approx n) x').
-
-  Definition knot_age1 (k:knot) : option knot :=
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-
-  Definition knot_age := fun x y => knot_age1 x = Some y.
-End KNOT.
-
-Module Knot (TF':TY_FUNCTOR) : KNOT with Module TF:=TF'.
-  Module TF := TF'.
-  Import TF.
-
-  (* Put the discrete topped order on rhs *)
-  Inductive le_T : T -> T -> Prop :=
-   | le_T_refl : forall t1 t2,
-     t1 == t2 -> le_T t1 t2
-   | le_T_bot: forall t,
-     le_T T_bot t.
-
-  Lemma le_T_asym: forall t1 t2,
-    le_T t1 t2 -> le_T t2 t1 -> t1 == t2.
-  Proof.
-  intros.
-  inversion H; subst; auto.
-  inversion H0; subst; auto.
-  symmetry; auto.
-  reflexivity.
-  Qed.
-
-  Fixpoint sinv (n: nat) : { T:Type & Setoid T } :=
-    match n with
-      | O => existT (fun T => Setoid T) unit (EqSetoid unit)
-      | S n => existT (fun T => Setoid T)
-                  (prodT (projT1 (sinv n))
-                         (Mor (ProdSetoid  (Fs (projT2 (sinv n))) otherS) (Ts)))
-                  (ProdSetoid (projT2 (sinv n)) (MorSetoid _ _))
-    end.
-
-  Fixpoint floor (m:nat) (n:nat) (p:projT1 (sinv (m+n))) : projT1 (sinv n) :=
-    match m as m' return forall (p : projT1 (sinv (m'+n))), projT1 (sinv n) with
-    | O => fun p => p
-    | S m' => fun p => floor m' n (fst p)
-    end p.
-
-  Lemma floor_mor : forall m n, Morphism ( (@equiv _ (projT2 (sinv (m+n)))) ==> (@equiv _ (projT2 (sinv n)))) (floor m n).
-  Proof.
-    induction m; simpl; hnf; intros; hnf; simpl; intros; auto.
-    destruct x; destruct y; simpl in *.
-    destruct H.
-    apply IHm; auto.
-  Qed.
-
-  Definition knot := { n:nat & F (projT1 (sinv n)) }.
-
-  Inductive knotEq : knot -> knot -> Prop :=
-    keq : forall n (f1 f2:F (projT1 (sinv n))),
-      @equiv _ (Fs (projT2 (sinv n))) f1 f2 ->
-      knotEq (existT (fun x => F (projT1 (sinv x))) n f1)
-             (existT (fun x => F (projT1 (sinv x))) n f2).
-  #[global] Program Instance knotS : Setoid knot := { equiv := knotEq }.
-  Next Obligation.
-    constructor; hnf; intros.
-    destruct x; constructor.
-    reflexivity.
-    destruct x; destruct y; simpl in *.
-    inversion H; subst; simpl in *.
-    constructor.
-    replace f with f3.
-    symmetry; auto.
-    revert H2.
-    apply (inj_pair2_eq_dec nat eq_nat_dec) with (P:=fun x => F (projT1 (sinv x))).
-    destruct x; destruct y; destruct z.
-    inversion H; clear H; subst.
-    inversion H0; clear H0; subst.
-    simpl.
-    constructor.
-    transitivity f5.
-    replace f with f4; auto.
-    revert H3.
-    apply (inj_pair2_eq_dec nat eq_nat_dec) with (P:=fun x => F (projT1 (sinv x))).
-    replace f5 with f0.
-    replace f0 with f6; auto.
-    revert H4.
-    apply (inj_pair2_eq_dec nat eq_nat_dec) with (P:=fun x => F (projT1 (sinv x))).
-    symmetry.
-    revert H5.
-    apply (inj_pair2_eq_dec nat eq_nat_dec) with (P:=fun x => F (projT1 (sinv x))).
-  Qed.
-
-  Definition koS : Setoid (knot * other) := @ProdSetoid knot knotS other otherS.
-  Definition predicate := Mor koS Ts.
-  Definition predS : Setoid predicate := MorSetoid koS Ts.
-  Definition natFS : Setoid (nat * F predicate) := @ProdSetoid nat (EqSetoid nat) (F predicate) (Fs predS).
-  #[global] Existing Instance koS.
-  #[global] Existing Instance predS.
-  #[global] Existing Instance natFS.
-
-  Program Definition wrap (n:nat) : Mor (ProdSetoid (Fs (projT2 (sinv n))) otherS) (ProdSetoid knotS otherS) :=
-    @Build_Mor _ _ _ _ (fun v => (existT (fun x => F (projT1 (sinv x))) n (fst v), snd v)) _.
-  Next Obligation.
-    hnf; simpl; intuition.
-    destruct y.
-    constructor.
-    simpl in *; auto.
-  Qed.
-
-  Fixpoint stratify0 (n:nat) (Q:predicate) {struct n} : projT1 (sinv n) :=
-    match n as n' return projT1 (sinv n') with
-    | O => tt
-    | S n' => ( stratify0 n' Q, Q oo (wrap n'))
-    end.
-
-  Lemma stratify_mor : forall n, Morphism (equiv ==> (@equiv _ (projT2 (sinv n)))) (stratify0 n).
-  Proof.
-    induction n; simpl; intros; hnf; simpl; intros; auto.
-    split.
-    apply IHn.
-    apply H.
-    hnf; intros.
-    simpl.
-    apply H.
-    destruct H0.
-    simpl; split; auto.
-    constructor; auto.
-  Qed.
-
-  Definition stratify (n:nat) : Mor predS (projT2 (sinv n)) :=
-    Build_Mor predS (projT2 (sinv n)) (stratify0 n) (stratify_mor n).
-
-  Lemma decompose_nat : forall (x y:nat), { m:nat & y = (m + S x) } + { ge x y }.
-  Proof.
-    intros x y; revert x; induction y; simpl; intros.
-    right; auto with arith.
-    destruct (IHy x) as [[m H]|H].
-    left; exists (S m); lia.
-    destruct (eq_nat_dec x y).
-    left; exists O; lia.
-    right; lia.
-  Qed.
-
-  Definition proof_irr_nat := eq_proofs_unicity dec_eq_nat.
-  Implicit Arguments proof_irr_nat.
-
-  Program Definition unstratify (n:nat) : Mor (projT2 (sinv n)) predS :=
-    Build_Mor _ _ (fun p =>
-      Build_Mor _ _ (fun w =>
-      match w with (existT nw w',e) =>
-        match decompose_nat nw n with
-          | inleft (existT m Hm) => snd (floor m (S nw) (eq_rect n (fun x => projT1 (sinv x)) p (m + S nw) Hm)) (w', e)
-          | inright H => T_bot
-        end
-      end) _) _.
-  Next Obligation.
-    hnf; simpl; intros.
-    destruct x; destruct y; simpl.
-    destruct k; destruct k0; simpl in *.
-    destruct H.
-    inversion H; clear H; subst.
-    assert (f3 = f) by (apply (inj_pair2_eq_dec nat eq_nat_dec) with (P:=fun x => F (projT1 (sinv x))); auto).
-    subst f3.
-    assert (f4 = f0) by (apply (inj_pair2_eq_dec nat eq_nat_dec) with (P:=fun x => F (projT1 (sinv x))); auto).
-    subst f4.
-    clear H3 H5.
-    simpl.
-    destruct (decompose_nat x0 n); simpl.
-    destruct s; simpl.
-    generalize e.
-    subst n; intro e.
-    replace e with (refl_equal (x + S x0)) by apply proof_irr_nat; simpl.
-    generalize (floor_mor x (S x0) p p (setoid_refl _ p)).
-    intro H.
-    simpl in H.
-    destruct H.
-    apply H1.
-    simpl; split; auto.
-    apply setoid_refl.
-  Qed.
-  Next Obligation.
-    repeat (hnf; simpl in *; intros).
-    destruct a; destruct a'; simpl in *.
-    destruct k; destruct k0; destruct H0; simpl in *.
-    inversion H0; clear H0; subst.
-    assert (f3 = f) by (apply (inj_pair2_eq_dec nat eq_nat_dec) with (P:=fun x => F (projT1 (sinv x))); auto).
-    subst f3.
-    assert (f4 = f0) by (apply (inj_pair2_eq_dec nat eq_nat_dec) with (P:=fun x => F (projT1 (sinv x))); auto).
-    subst f4.
-    simpl.
-    destruct (decompose_nat x1 n); simpl.
-    destruct s; simpl.
-    generalize e; subst n.
-    intro e.
-    replace e with (refl_equal (x0 + S x1)) by (apply proof_irr_nat; auto); simpl.
-    generalize (floor_mor x0 (S x1) x y H); simpl.
-    intros [? ?].
-    apply H2.
-    split; auto.
-    reflexivity.
-  Qed.
-
-  Lemma floor_shuffle:
-    forall (m1 n : nat)
-      (p1 : projT1 (sinv (m1 + S n))) (H1 : (m1 + S n) = (S m1 + n)),
-      floor (S m1) n (eq_rect (m1 + S n) (fun x => (projT1 (sinv x))) p1 (S m1 + n) H1) = fst (floor m1 (S n) p1).
-  Proof.
-    intros.
-    remember (fst (floor m1 (S n) p1)) as p.
-    revert n p1 H1 p Heqp.
-    induction m1; simpl; intros.
-    replace H1 with (refl_equal (S n)) by (apply proof_irr_nat); simpl; auto.
-    assert (m1 + S n = S m1 + n) by lia.
-    destruct p1 as [p1 f'].
-    generalize (IHm1 n p1 H p Heqp).
-    simpl.
-    clear.
-    revert H1; generalize H.
-    revert p1 f'.
-    rewrite H.
-    simpl; intros.
-    replace H1 with (refl_equal (S (S (m1 + n)))) by (apply proof_irr_nat).
-    simpl.
-    replace H0 with (refl_equal (S (m1+n))) in H2 by (apply proof_irr_nat).
-    simpl in H2.
-    trivial.
-  Qed.
-
-  Lemma stratify_unstratify_more : forall n m1 m2 p1 p2,
-    @equiv _ (projT2 (sinv n)) (floor m1 n p1) (floor m2 n p2) ->
-
-    @equiv _ (projT2 (sinv n))
-    (stratify n (unstratify (m1+n) p1))
-    (stratify n (unstratify (m2+n) p2)).
-  Proof.
-    induction n; simpl; intros; auto.
-    split.
-
-    assert ((m1 + S n) =  (S m1 + n)) by lia.
-    assert ((m2 + S n) =  (S m2 + n)) by lia.
-    assert (@equiv _ (projT2 (sinv n))
-      (floor (S m1) n (eq_rect (m1 + S n) (fun x => projT1 (sinv x)) p1 _ H0))
-      (floor (S m2) n (eq_rect (m2 + S n) (fun x => (projT1 (sinv x))) p2 _ H1))).
-    do 2 rewrite floor_shuffle.
-    destruct H; auto.
-    generalize (IHn (S m1) (S m2) _ _ H2).
-    clear.
-    generalize H0 H1.
-    revert p1 p2.
-    rewrite H0; clear H0.
-    rewrite H1; clear H1.
-    intros p1 p2 H1 H2.
-    replace H1 with (refl_equal (S m1 + n)) by (apply proof_irr_nat).
-    replace H2 with (refl_equal (S m2 + n)) by (apply proof_irr_nat).
-    simpl; auto.
-
-    hnf; intros.
-    destruct a; destruct a'.
-    unfold unstratify.
-    simpl.
-    destruct (decompose_nat n (m2 + S n)) as [[r Hr]|Hr].
-    2: exfalso; lia.
-    destruct (decompose_nat n (m1 + S n)) as [[s Hs]|Hs].
-    2: exfalso; lia.
-    assert (m2 = r) by lia; subst r.
-    assert (m1 = s) by lia; subst s.
-    replace Hr with (refl_equal (m2 + S n)) by (apply proof_irr_nat).
-    replace Hs with (refl_equal (m1 + S n)) by (apply proof_irr_nat).
-    simpl.
-    destruct H; auto.
-  Qed.
-
-  Lemma stratify_unstratify : forall n,
-         stratify n oo unstratify n == idM (projT2 (sinv n)).
-  Proof.
-    simpl; induction n.
-    hnf; simpl; intros.
-    destruct a'; auto.
-    simpl; intros a a' H.
-    split.
-    destruct a; destruct a'; destruct H; simpl in *.
-    change (@equiv _ (projT2 (sinv n)) (stratify n (unstratify (S n) (p,m))) p0).
-    transitivity (stratify n (unstratify n p)).
-    symmetry.
-    apply (stratify_unstratify_more _ 0 1 p (p,m)).
-    simpl; reflexivity.
-    apply (IHn p p0 H).
-
-    hnf; intros.
-    destruct a0; destruct a'0; destruct H; simpl.
-    destruct (decompose_nat n (S n)).
-    2: exfalso; lia.
-    destruct s.
-    assert (x = 0) by lia; subst x; simpl in *.
-    replace e with (refl_equal (S n)) by (apply proof_irr_nat; auto); simpl.
-    auto.
-  Qed.
-
-  Lemma unstratify_stratify1 : forall n (p:predicate) w,
-    le_T ((unstratify n oo stratify n) p w) (p w).
-  Proof.
-    induction n; simpl; intros; unfold unstratify.
-
-    (* 0 case *)
-    destruct w as [nw rm]; simpl.
-    destruct nw as [nw e].
-    destruct (decompose_nat nw O) as [[r Hr]|?].
-    exfalso; lia.
-    apply le_T_bot.
-
-    (* S n case *)
-    destruct w; simpl; intros.
-    destruct k as [nw e].
-    destruct (decompose_nat nw (S n)) as [[r Hr]|?]; try (apply lt_rhs_bot).
-    destruct r; simpl.
-
-    assert (n = nw) by lia.
-    subst nw.
-    simpl in Hr.
-    replace Hr with (refl_equal (S n)) by apply proof_irr_nat; simpl.
-    apply le_T_refl.
-    reflexivity.
-
-    simpl in Hr.
-    assert (n = r + S nw) by lia.
-    revert Hr; subst n.
-    intro Hr.
-    replace Hr with (refl_equal (S (r+S nw))) by apply proof_irr_nat; simpl.
-    clear Hr.
-
-    generalize (IHn p (existT (fun x => F (projT1 (sinv x))) nw e, o)).
-    unfold unstratify; simpl.
-    destruct (decompose_nat nw (r + S nw)) as [[x Hx]|?].
-    assert (x = r) by lia; subst x.
-    replace Hx with (refl_equal (r + S nw)) by apply proof_irr_nat.
-    simpl; auto.
-    exfalso; lia.
-    apply le_T_bot.
-  Qed.
-
-  Lemma unstratify_stratify2 : forall n (p:predicate) (w:knot * other),
-     projT1 (fst w) < n ->
-        le_T (p w) ((unstratify n oo stratify n) p w).
-  Proof.
-    induction n; simpl; intros.
-
-    (* 0 case *)
-    inversion H.
-
-    (* S n case *)
-    destruct w; simpl in *.
-    destruct k; simpl.
-
-    destruct (decompose_nat x (S n)) as [[r Hr]|?].
-    destruct r; simpl.
-
-    assert (n = x) by lia.
-    subst x.
-    simpl in Hr; replace Hr with (refl_equal (S n)) by apply proof_irr_nat; simpl.
-    apply le_T_refl.
-    reflexivity.
-
-    simpl in Hr.
-    assert (n = r + S x) by lia.
-    revert Hr; subst n.
-    intro Hr.
-    replace Hr with (refl_equal (S (r+S x))) by apply proof_irr_nat; simpl.
-    clear Hr.
-    simpl in H.
-    assert (x < r + S x) by lia.
-    generalize (IHn p (existT (fun x => F (projT1 (sinv x))) x f,o) H0).
-    simpl.
-    destruct (decompose_nat x (r + S x)) as [[y Hy]|?].
-    assert (y = r) by lia; subst y.
-    replace Hy with (refl_equal (r + S x)) by apply proof_irr_nat.
-    simpl; auto.
-    exfalso; lia.
-    simpl in *.
-    exfalso; lia.
-  Qed.
-
-  Lemma unstratify_stratify3 : forall n (p:predicate) w,
-    projT1 (fst w) >= n -> le_T ((unstratify n oo stratify n) p w) T_bot.
-  Proof.
-    intros n p w H; simpl.
-    destruct w; simpl in *.
-    destruct s; simpl in *.
-    destruct (decompose_nat x n) as [[r Hr]|?].
-    exfalso; lia.
-    apply le_T_bot.
-  Qed.
-
-  Program Definition squash : Mor natFS knotS :=
-    Build_Mor _ _
-     (fun x =>
-       match x with (n,y) => existT (fun x => F (projT1 (sinv x))) n (fmap (stratify n) y) end) _.
-  Next Obligation.
-    hnf; simpl; intros.
-    destruct x; destruct y; destruct H; simpl in *.
-    subst n0.
-    constructor.
-    apply mor_prf; auto.
-  Qed.
-
-  Program Definition unsquash : Mor knotS natFS :=
-    Build_Mor _ _
-      (fun x =>
-        match x with existT n y => (n, fmap (unstratify n) y) end) _.
-  Next Obligation.
-    hnf; simpl; intros.
-    destruct x; destruct y; inversion H; clear H; subst; simpl.
-    split; auto.
-    apply mor_prf.
-    transitivity f3; auto.
-    replace f with f3.
-    reflexivity.
-    apply (inj_pair2_eq_dec nat eq_nat_dec) with (P:=fun x => F (projT1 (sinv x))); auto.
-  Qed.
-
-  Definition level : Mor knotS (EqSetoid nat) := fstM oo unsquash.
-  Definition approx (n:nat) := unstratify n oo stratify n.
-
-  Lemma approx_spec : forall n p w, approx n p w ==
-    if (le_gt_dec n (level (fst w))) then T_bot else p w.
-  Proof.
-    intros.
-    replace (level (fst w)) with (projT1 (fst w)).
-    destruct (le_gt_dec n (projT1 (fst w))).
-    apply le_T_asym.
-    unfold approx.
-    apply unstratify_stratify3; auto.
-    apply le_T_bot.
-    apply le_T_asym.
-    apply unstratify_stratify1.
-    apply unstratify_stratify2; auto.
-    unfold level; destruct w; simpl.
-    destruct k; simpl; auto.
-  Qed.
-
-  Lemma squash_unsquash : forall x, squash (unsquash x) == x.
-  Proof.
-    intros; destruct x; simpl.
-    constructor.
-    change (@equiv _ (Fs (projT2 (sinv x))) ((fmap (stratify x) oo fmap (unstratify x)) f)f).
-    transitivity (fmap (stratify x oo unstratify x) f).
-    apply (fmap_comp (stratify x) (unstratify x) f f (setoid_refl _ f)).
-    transitivity (fmap (idM (projT2 (sinv x))) f).
-    apply fmap_mor.
-    apply stratify_unstratify.
-    reflexivity.
-    transitivity (idM (Fs (projT2 (sinv x))) f).
-    apply fmap_id; reflexivity.
-    simpl; reflexivity.
-  Qed.
-
-  Lemma unsquash_squash : forall n x', unsquash (squash (n,x')) == (n,fmap (approx n) x').
-  Proof.
-    intros; simpl; split; auto.
-    unfold approx.
-    change ((fmap (unstratify n) oo fmap (stratify n)) x' == fmap (unstratify n oo stratify n) x').
-    apply fmap_comp.
-    reflexivity.
-  Qed.
-
-  Definition knot_age1 (k:knot) : option knot :=
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-
-  Definition knot_age := fun x y => knot_age1 x = Some y.
-
-End Knot.
diff --git a/msl/knot_shims.v b/msl/knot_shims.v
deleted file mode 100644
index 82d757d2c5..0000000000
--- a/msl/knot_shims.v
+++ /dev/null
@@ -1,1656 +0,0 @@
-(*
- * Copyright (c) 2009-2010, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-
-Require Import VST.msl.base.
-Require Import VST.msl.sig_isomorphism.
-Require Import VST.msl.functors.
-Require VST.msl.knot.
-Require VST.msl.knot_full_variant.
-
-Require Import VST.msl.ageable.
-Require Import VST.msl.predicates_hered.
-
-Module Type KNOT_INPUT__COCONTRAVARIANT_HERED_T_OTH_REL.
-  Import CoContraVariantBiFunctor.
-  Parameter F : functor.
-
-  Parameter other : Type.
-
-  Parameter Rel : forall A B, F A B -> F A B -> Prop.
-
-  Parameter Rel_fmap : forall A B C D (f:A->B) (s:C->D) x y,
-    Rel A D x y ->
-    Rel B C (fmap F f s x) (fmap F f s y).
-  Axiom Rel_refl : forall A B x, Rel A B x x.
-  Axiom Rel_trans : forall A B x y z,
-    Rel A B x y -> Rel A B y z -> Rel A B x z.
-
-  Parameter ORel : other -> other -> Prop.
-  Axiom ORel_refl : reflexive other ORel.
-  Axiom ORel_trans : transitive other ORel.
-
-  Parameter T:Type.
-  Parameter T_bot:T.
-
-  Parameter T_rel : T -> T -> Prop.
-  Parameter T_rel_bot : forall x, T_rel T_bot x.
-  Parameter T_rel_refl : forall x, T_rel x x.
-  Parameter T_rel_trans : transitive T T_rel.
-
-End KNOT_INPUT__COCONTRAVARIANT_HERED_T_OTH_REL.
-
-Module Type KNOT__COCONTRAVARIANT_HERED_T_OTH_REL.
-  Import CoContraVariantBiFunctor.
-  Declare Module KI: KNOT_INPUT__COCONTRAVARIANT_HERED_T_OTH_REL.
-  Import KI.
-
-  Parameter knot:Type.
-  Parameter ageable_knot : ageable knot.
-  #[global] Existing Instance ageable_knot.
-
-  Parameter hered : (knot * other -> T) -> Prop.
-  Definition predicate := { p:knot * other -> T | hered p }.
-
-  Parameter squash : (nat * F predicate predicate) -> knot.
-  Parameter unsquash : knot -> (nat * F predicate predicate).
-
-  Parameter approx : nat -> predicate -> predicate.
-
-  Axiom squash_unsquash : forall k:knot, squash (unsquash k) = k.
-  Axiom unsquash_squash : forall (n:nat) (f:F predicate predicate),
-    unsquash (squash (n,f)) = (n, fmap F (approx n) (approx n) f).
-
-  Axiom approx_spec : forall n p ko,
-    proj1_sig (approx n p) ko =
-     if (Compare_dec.le_gt_dec n (level (fst ko))) then T_bot else proj1_sig p ko.
-
-  Definition knot_rel (k1 k2:knot) :=
-    let (n,f) := unsquash k1 in
-    let (n',f') := unsquash k2 in
-    n = n' /\ Rel predicate predicate f f'.
-
-  Axiom knot_age1 : forall k:knot,
-    age1 k =
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-
-  Axiom knot_level : forall k:knot,
-    level k = fst (unsquash k).
-
-  Axiom hered_spec : forall p,
-    hered p =
-    (forall k k' k'' o o',
-      clos_refl_trans _ age k k' ->
-      knot_rel  k' k'' ->
-      ORel o o' ->
-      T_rel (p (k,o)) (p (k'',o'))).
-
-End KNOT__COCONTRAVARIANT_HERED_T_OTH_REL.
-
-Module Type KNOT_INPUT__COVARIANT_HERED_PROP_OTH_REL.
-
-  Import CovariantFunctor.
-  Parameter F : functor.
-
-  Parameter other : Type.
-
-  Parameter Rel : forall A, F A -> F A -> Prop.
-  Parameter Rel_fmap : forall A B (f:A->B) x y,
-    Rel A x y -> Rel B (fmap F f x) (fmap F f y).
-
-  Parameter Rel_unfmap : forall A B (f:A->B) x y,
-    Rel B (fmap F f x) y ->
-      exists y', Rel A x y' /\ fmap F f y' = y.
-
-  Axiom Rel_refl : forall A x, Rel A x x.
-  Axiom Rel_trans : forall A x y z,
-    Rel A x y -> Rel A y z -> Rel A x z.
-
-  Parameter ORel : other -> other -> Prop.
-  Axiom ORel_refl : reflexive other ORel.
-  Axiom ORel_trans : transitive other ORel.
-
-End KNOT_INPUT__COVARIANT_HERED_PROP_OTH_REL.
-
-(*Module Type KNOT__COVARIANT_HERED_PROP_OTH_REL.
-  Import CovariantFunctor.
-  Declare Module KI : KNOT_INPUT__COVARIANT_HERED_PROP_OTH_REL.
-  Import KI.
-
-  Parameter knot : Type.
-
-  Parameter ageable_knot : ageable knot.
-  #[global] Existing Instance ageable_knot.
-
-  Definition ag_knot_other := ag_prod knot other ageable_knot.
-  #[global] Existing Instance ag_knot_other.
-
-  Parameter expandM : @modality (knot * other) ag_knot_other.
-  Definition assert := { p:pred (knot * other) | boxy expandM p }.
-
-  Parameter squash : (nat * F assert) -> knot.
-  Parameter unsquash : knot -> (nat * F assert).
-
-  Parameter approx : nat -> assert -> assert.
-  Axiom approx_spec : forall n p k,
-    proj1_sig (approx n p) k = (level (fst k) < n /\ proj1_sig p k).
-
-  Axiom squash_unsquash : forall x,
-    squash (unsquash x) = x.
-  Axiom unsquash_squash : forall n x',
-    unsquash (squash (n,x')) = (n, fmap F (approx n) x').
-
-  (* Definition of the expandM modality *)
-
-  Definition knot_rel (k1 k2:knot) :=
-    let (n,f) := unsquash k1 in
-    let (n',f') := unsquash k2 in
-    n = n' /\ Rel assert f f'.
-
-  Axiom expandM_spec : forall k k' o o',
-    expandM (k,o) (k',o') = (knot_rel k k' /\ ORel o o').
-
-  Axiom expandM_refl : reflexive _ expandM.
-  Axiom expandM_trans : transitive _ expandM.
-  Global Hint Resolve expandM_refl expandM_trans : core.
-
-  (* Definitions of the "ageable" operations *)
-  Axiom knot_level : forall (k:knot),
-    level k = fst (unsquash k).
-
-  Axiom knot_age1 : forall (k:knot),
-    age1 k =
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-
-End KNOT__COVARIANT_HERED_PROP_OTH_REL.*)
-
-Module Type KNOT_INPUT__COVARIANT_HERED_PROP_OTH.
-
-  Import CovariantFunctor.
-  Parameter F : functor.
-  Parameter other : Type.
-
-End KNOT_INPUT__COVARIANT_HERED_PROP_OTH.
-
-(*Module Type KNOT__COVARIANT_HERED_PROP_OTH.
-  Declare Module KI : KNOT_INPUT__COVARIANT_HERED_PROP_OTH.
-  Import CovariantFunctor.
-  Import CovariantFunctorLemmas.
-  Import KI.
-
-  Parameter knot : Type.
-
-  Parameter ageable_knot : ageable knot.
-  #[global] Existing Instance ageable_knot.
-
-  Definition ag_knot_other := ag_prod knot other ageable_knot.
-  #[global] Existing Instance ag_knot_other.
-
-  Parameter squash : (nat * F (pred (knot * other))) -> knot.
-  Parameter unsquash : knot -> (nat * F (pred (knot * other))).
-
-  Parameter approx : nat -> pred (knot * other) -> pred (knot * other).
-  Axiom approx_spec : forall n p k,
-    approx n p k = (level (fst k) < n /\ p k).
-
-  Axiom squash_unsquash : forall x,
-    squash (unsquash x) = x.
-  Axiom unsquash_squash : forall n x',
-    unsquash (squash (n,x')) = (n, fmap F (approx n) x').
-
-
-  (* Definitions of the "ageable" operations *)
-  Axiom knot_level : forall (k:knot),
-    level k = fst (unsquash k).
-
-  Axiom knot_age1 : forall (k:knot),
-    age1 k =
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-(*
-  Axiom unsquash_inj : forall k1 k2,
-    unsquash k1 = unsquash k2 ->
-    k1 = k2.
-  Arguments unsquash_inj [k1 k2] _.
-
-  Axiom squash_surj : forall k, exists n, exists Fp,
-    squash (n, Fp) = k.
-
-  Axiom unsquash_approx : forall k n Fp,
-    unsquash k = (n, Fp) ->
-    Fp = KI.fmap (approx n) Fp.
-  Implicit Arguments unsquash_approx [k n Fp].
-
-  Axiom approx_approx1 : forall m n,
-    approx n = approx n oo approx (m+n).
-
-  Axiom approx_approx2 : forall m n,
-    approx n = approx (m+n) oo approx n.
-*)
-End KNOT__COVARIANT_HERED_PROP_OTH.
-
-
-Module Type KNOT_INPUT__COVARIANT_HERED_PROP.
-
-  Import CovariantFunctor.
-  Parameter F : functor.
-
-End KNOT_INPUT__COVARIANT_HERED_PROP.
-
-Module Type KNOT__COVARIANT_HERED_PROP.
-  Declare Module KI : KNOT_INPUT__COVARIANT_HERED_PROP.
-  Import CovariantFunctor.
-  Import CovariantFunctorLemmas.
-  Import KI.
-
-  Parameter knot : Type.
-
-  Parameter ageable_knot : ageable knot.
-  #[global] Existing Instance ageable_knot.
-
-  Parameter squash : (nat * F (pred knot)) -> knot.
-  Parameter unsquash : knot -> (nat * F (pred knot)).
-
-  Parameter approx : nat -> pred knot -> pred knot.
-  Axiom approx_spec : forall n p k,
-    approx n p k = (level k < n /\ p k).
-
-  Axiom squash_unsquash : forall x,
-    squash (unsquash x) = x.
-  Axiom unsquash_squash : forall n x',
-    unsquash (squash (n,x')) = (n, fmap F (approx n) x').
-
-  (* Definitions of the "ageable" operations *)
-  Axiom knot_level : forall (k:knot),
-    level k = fst (unsquash k).
-
-  Axiom knot_age1 : forall (k:knot),
-    age1 k =
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-(*
-  (* Convenience lemmas, provable from the above interface *)
-  Axiom unsquash_inj : forall k1 k2,
-    unsquash k1 = unsquash k2 ->
-    k1 = k2.
-  Arguments unsquash_inj [k1 k2] _.
-
-  Axiom squash_surj : forall k, exists n, exists Fp,
-    squash (n, Fp) = k.
-
-  Axiom unsquash_approx : forall k n Fp,
-    unsquash k = (n, Fp) ->
-    Fp = fmap (approx n) Fp.
-  Implicit Arguments unsquash_approx [k n Fp].
-
-  Axiom approx_approx1 : forall m n,
-    approx n = approx n oo approx (m+n).
-
-  Axiom approx_approx2 : forall m n,
-    approx n = approx (m+n) oo approx n.
-*)
-End KNOT__COVARIANT_HERED_PROP.*)
-
-Module Type KNOT_INPUT__MIXVARIANT_HERED_PROP.
-
-  Import MixVariantFunctor.
-  Parameter F : functor.
-
-  Parameter Rel : forall A, relation (F A).
-
-  Parameter Rel_fmap : forall A B (f1: A->B) (f2:B->A) x y,
-    Rel A x y ->
-    Rel B (fmap F f1 f2 x) (fmap F f1 f2 y).
-  Axiom Rel_refl : forall A x, Rel A x x.
-  Axiom Rel_trans : forall A x y z,
-    Rel A x y -> Rel A y z -> Rel A x z.
-
-End KNOT_INPUT__MIXVARIANT_HERED_PROP.
-
-Module Type KNOT__MIXVARIANT_HERED_PROP.
-  Declare Module KI : KNOT_INPUT__MIXVARIANT_HERED_PROP.
-  Import MixVariantFunctor.
-  Import MixVariantFunctorLemmas.
-  Import KI.
-
-  Parameter knot : Type.
-
-  Parameter ageable_knot : ageable knot.
-  #[global] Existing Instance ageable_knot.
-
-  Parameter ext_knot : Ext_ord knot.
-  #[export] Existing Instance ext_knot.
-
-  Definition predicate := pred knot.
-  Parameter squash : (nat * F (pred knot)) -> knot.
-  Parameter unsquash : knot -> (nat * F (pred knot)).
-
-  Parameter approx : nat -> pred knot -> pred knot.
-  Axiom approx_spec : forall n p k,
-    approx n p k = (level k < n /\ p k).
-
-  Axiom squash_unsquash : forall x,
-    squash (unsquash x) = x.
-  Axiom unsquash_squash : forall n x',
-    unsquash (squash (n,x')) = (n, fmap F (approx n) (approx n) x').
-
-  (* Definitions of the "ageable" operations *)
-  Axiom knot_level : forall (k:knot),
-    level k = fst (unsquash k).
-
-  Axiom knot_age1 : forall (k:knot),
-    age1 k =
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-
-  Axiom knot_order : forall k1 k2 : knot, ext_order k1 k2 <->
-    level k1 = level k2 /\ Rel predicate (snd (unsquash k1)) (snd (unsquash k2)).
-
-End KNOT__MIXVARIANT_HERED_PROP.
-
-Module Knot_CoContraVariantHeredTOthRel
-  (KI': KNOT_INPUT__COCONTRAVARIANT_HERED_T_OTH_REL):
-  KNOT__COCONTRAVARIANT_HERED_T_OTH_REL with Module KI:=KI'.
-
-  Import MixVariantFunctor.
-  Import MixVariantFunctorLemmas.
-  Import GeneralFunctorGenerator.
-  Module KI:=KI'.
-
-  Module Input.
-
-    Definition F : functor :=
-      CoContraVariantBiFunctor_MixVariantFunctor KI.F.
-
-    Definition other := KI.other.
-
-    Definition Rel (A: Type): F A -> F A -> Prop :=
-      KI.Rel A A.
-
-    Definition Rel_fmap (A B: Type): forall (f1: A->B) (f2:B->A) x y,
-      Rel A x y ->
-      Rel B (fmap F f1 f2 x) (fmap F f1 f2 y) :=
-    KI.Rel_fmap A B B A.
-
-    Definition Rel_refl (A: Type): forall x, Rel A x x :=
-      KI.Rel_refl A A.
-
-    Definition Rel_trans (A: Type): forall x y z,
-      Rel A x y -> Rel A y z -> Rel A x z :=
-      KI.Rel_trans A A.
-
-    Definition ORel: other -> other -> Prop := KI.ORel.
-    Definition ORel_refl := KI.ORel_refl.
-    Definition ORel_trans := KI.ORel_trans.
-
-    Definition T := KI.T.
-    Definition T_bot := KI.T_bot.
-
-    Definition T_rel := KI.T_rel.
-    Definition T_rel_bot := KI.T_rel_bot.
-    Definition T_rel_refl := KI.T_rel_refl.
-    Definition T_rel_trans := KI.T_rel_trans.
-
-  End Input.
-
-  Module K := knot_full_variant.Knot_MixVariantHeredTOthRel(Input).
-
-  Definition knot: Type := K.knot.
-  Definition ageable_knot: ageable knot := K.ageable_knot.
-  #[global] Existing Instance ageable_knot.
-
-  Definition hered : (knot * KI.other -> KI.T) -> Prop := K.hered.
-  Definition predicate := { p:knot * KI.other -> KI.T | hered p }.
-
-  Definition squash : (nat * KI.F predicate predicate) -> knot := K.squash.
-  Definition unsquash : knot -> (nat * KI.F predicate predicate) := K.unsquash.
-
-  Definition approx : nat -> predicate -> predicate := K.approx.
-
-  Definition squash_unsquash : forall k:knot, squash (unsquash k) = k
-    := K.squash_unsquash.
-  Definition unsquash_squash : forall (n:nat) (f:KI.F predicate predicate),
-    unsquash (squash (n,f)) =
-     (n, CoContraVariantBiFunctor.fmap KI.F (approx n) (approx n) f)
-    := K.unsquash_squash.
-
-  Definition approx_spec : forall n p ko,
-    proj1_sig (approx n p) ko =
-     if (Compare_dec.le_gt_dec n (level (fst ko))) then KI.T_bot else proj1_sig p ko
-    := K.approx_spec.
-
-  Definition knot_rel (k1 k2:knot) :=
-    let (n,f) := unsquash k1 in
-    let (n',f') := unsquash k2 in
-    n = n' /\ KI.Rel predicate predicate f f'.
-
-  Definition knot_age1 : forall k:knot,
-    age1 k =
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end
-    := K.knot_age1.
-
-  Definition knot_level : forall k:knot,
-    level k = fst (unsquash k)
-    := K.knot_level.
-
-  Definition hered_spec : forall p,
-    hered p =
-    (forall k k' k'' o o',
-      clos_refl_trans _ age k k' ->
-      knot_rel  k' k'' ->
-      KI.ORel o o' ->
-      KI.T_rel (p (k,o)) (p (k'',o')))
-    := K.hered_spec.
-
-End Knot_CoContraVariantHeredTOthRel.
-
-Module KnotLemmas_CoContraVariantHeredTOthRel
-  (K: KNOT__COCONTRAVARIANT_HERED_T_OTH_REL).
-  Import CoContraVariantBiFunctor.
-  Import K.KI.
-  Import K.
-
-  Lemma unsquash_inj : forall k1 k2,
-    unsquash k1 = unsquash k2 ->
-    k1 = k2.
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas1.unsquash_inj
-       (knot_full_variant.KnotLemmas1.Build_Input _ _ _ _ _ squash_unsquash unsquash_squash)),
-     (knot_full_variant.KnotLemmas1.Proof).
-  Qed.
-  Arguments unsquash_inj [k1 k2] _.
-
-  Lemma squash_surj : forall k, exists n, exists Fp,
-    squash (n, Fp) = k.
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas1.squash_surj
-       (knot_full_variant.KnotLemmas1.Build_Input _ _ _ _ _ squash_unsquash unsquash_squash)),
-     (knot_full_variant.KnotLemmas1.Proof).
-  Qed.
-
-  Lemma unsquash_approx : forall k n Fp,
-    unsquash k = (n, Fp) ->
-    Fp = fmap F (approx n) (approx n) Fp.
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas1.unsquash_approx
-       (knot_full_variant.KnotLemmas1.Build_Input _ _ _ _ _ squash_unsquash unsquash_squash)),
-     (knot_full_variant.KnotLemmas1.Proof).
-  Qed.
-  Arguments unsquash_approx [k n Fp] _.
-
-  Lemma pred_ext : forall (p1 p2:predicate),
-    (forall x, proj1_sig p1 x = proj1_sig p2 x) ->
-    p1 = p2.
-  Proof.
-    intros.
-    destruct p1 as [p1 Hp1]; destruct p2 as [p2 Hp2].
-    simpl in *.
-    assert (p1 = p2).
-    extensionality x; auto.
-    subst p2.
-    replace Hp2 with Hp1; auto.
-    apply proof_irr.
-  Qed.
-
-  Lemma approx_approx1 : forall m n,
-    approx n = approx n oo approx (m+n).
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas2.approx_approx1
-       (knot_full_variant.KnotLemmas2.Build_Input _ _ _ _ _ _ _ _
-          pred_ext approx_spec)),
-     (knot_full_variant.KnotLemmas2.Proof).
-  Qed.
-
-  Lemma approx_approx2 : forall m n,
-    approx n = approx (m+n) oo approx n.
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas2.approx_approx2
-       (knot_full_variant.KnotLemmas2.Build_Input _ _ _ _ _ _ _ _
-          pred_ext approx_spec)),
-     (knot_full_variant.KnotLemmas2.Proof).
-  Qed.
-
-End KnotLemmas_CoContraVariantHeredTOthRel.
-
-(*Module Knot_CovariantHeredPropOthRel (KI':KNOT_INPUT__COVARIANT_HERED_PROP_OTH_REL)
-  : KNOT__COVARIANT_HERED_PROP_OTH_REL with Module KI:=KI'.
-
-  Module KI:=KI'.
-
-  Module Input.
-    Import MixVariantFunctor.
-    Import MixVariantFunctorLemmas.
-    Import GeneralFunctorGenerator.
-    Definition F: functor :=
-      GeneralFunctorGenerator.CovariantFunctor_MixVariantFunctor KI.F.
-
-    Definition other := KI.other.
-
-    Definition Rel (A: Type): F A -> F A -> Prop := KI.Rel A.
-
-    Definition Rel_fmap (A B: Type): forall (f1: A->B) (f2:B->A) x y,
-      Rel A x y ->
-      Rel B (fmap F f1 f2 x) (fmap F f1 f2 y) :=
-    fun f s => KI.Rel_fmap A B f.
-
-    Definition Rel_refl (A: Type): forall x, Rel A x x := KI.Rel_refl A.
-
-    Definition Rel_trans (A: Type): forall x y z,
-      Rel A x y -> Rel A y z -> Rel A x z
-      := KI.Rel_trans A.
-
-    Definition ORel := KI.ORel.
-    Definition ORel_refl := KI.ORel_refl.
-    Definition ORel_trans := KI.ORel_trans.
-
-    Definition T := Prop.
-    Definition T_bot := False.
-
-    Definition T_rel (x y:T) := x -> y.
-    Lemma T_rel_bot : forall x, T_rel T_bot x.
-    Proof.
-      compute; intuition.
-    Qed.
-
-    Lemma T_rel_refl : forall x, T_rel x x.
-    Proof.
-      compute; intuition.
-    Qed.
-
-    Lemma T_rel_trans : transitive T T_rel.
-    Proof.
-      repeat intro; intuition.
-    Qed.
-  End Input.
-
-  Import CovariantFunctor.
-  Import CovariantFunctorLemmas.
-
-  Module K0 := knot_full_variant.Knot_MixVariantHeredTOthRel(Input).
-  Module KL0 := knot_full_variant.KnotLemmas_MixVariantHeredTOthRel(K0).
-
-  #[global] Existing Instance K0.ageable_knot.
-
-  Definition ag_knot_other := ag_prod K0.knot KI.other K0.ageable_knot.
-  #[global] Existing Instance ag_knot_other.
-
-  Definition expandR : relation (K0.knot * KI.other) :=
-    fun x y => K0.knot_rel (fst x) (fst y) /\ KI.ORel (snd x) (snd y).
-
-  Lemma valid_rel_expandR : valid_rel expandR.
-  Proof.
-    split; hnf; intros.
-    destruct H0.
-    destruct x as [xk xo].
-    destruct y as [yk yo].
-    simpl in *.
-    hnf in H.
-    hnf in H0.
-    simpl in H.
-    rewrite K0.knot_age1 in H.
-    destruct (K0.unsquash yk) as [n f] eqn:?H; intros.
-    destruct n; try discriminate.
-    inv H.
-    destruct z as [zk zo].
-    simpl in H0.
-    destruct (K0.unsquash zk) as [n0 f0] eqn:?H; intros.
-    destruct H0; subst n0.
-    simpl in H1.
-    exists (K0.squash (n,f0),zo).
-    split; simpl; auto.
-    hnf; repeat rewrite K0.unsquash_squash; split; auto.
-    apply Input.Rel_fmap; auto.
-    hnf; simpl.
-    rewrite K0.knot_age1.
-    rewrite H.
-    auto.
-
-    destruct x as [xk xo].
-    destruct y as [yk yo].
-    destruct H.
-    simpl in *.
-    hnf in H0; simpl in H0.
-    rewrite K0.knot_age1 in H0.
-    destruct z as [zk zo]; simpl in *.
-    destruct (K0.unsquash zk) as [n f] eqn:?H; intros.
-    destruct n; try discriminate.
-    inv H0.
-    hnf in H.
-    rewrite K0.unsquash_squash in H.
-    destruct (K0.unsquash xk) as [n0 f0] eqn:?H; intros.
-    destruct H; subst.
-    destruct (KI.Rel_unfmap _ _ _ _ _ H3)
-      as [z [? ?]].
-    subst f0.
-    exists (K0.squash (S n0,z),xo).
-    hnf; simpl.
-    rewrite K0.knot_age1.
-    rewrite K0.unsquash_squash.
-    f_equal.
-    f_equal.
-    apply KL0.unsquash_inj.
-    rewrite K0.unsquash_squash.
-    rewrite H0.
-    f_equal.
-    rewrite MixVariantFunctorLemmas.fmap_app.
-    change (S n0) with (1 + n0).
-    rewrite <- KL0.approx_approx1.
-    auto.
-    split; simpl; auto.
-    hnf.
-    rewrite H2.
-    rewrite K0.unsquash_squash; split; auto.
-    hnf.
-    rewrite (KL0.unsquash_approx H2).
-    apply KI.Rel_fmap; auto.
-  Qed.
-
-  Definition expandM : @modality (K0.knot * KI.other) ag_knot_other
-    := exist _ expandR valid_rel_expandR.
-
-  Lemma expandM_refl : reflexive _ expandM.
-  Proof.
-    repeat intro.
-    split.
-    hnf.
-    destruct (K0.unsquash (fst x)); split; auto.
-    apply KI.Rel_refl.
-    apply KI.ORel_refl.
-  Qed.
-
-  Lemma expandM_trans : transitive _ expandM.
-  Proof.
-    simpl; unfold expandR;
-      repeat intro; intuition.
-    unfold K0.knot_rel in *.
-    destruct (K0.unsquash (fst x)).
-    destruct (K0.unsquash (fst y)).
-    destruct (K0.unsquash (fst z)).
-    intuition. lia.
-    eapply KI.Rel_trans; eauto.
-    eapply KI.ORel_trans; eauto.
-  Qed.
-
-  Global Hint Resolve expandM_refl expandM_trans : core.
-
-  Definition assert := { p:pred (K0.knot * KI.other) | boxy expandM p }.
-
-  Module Output <: knot_full_variant.KNOT_FULL_OUTPUT with Module KI := Input.
-    Module KI := Input.
-    Module K0 := K0.
-    Definition predicate: Type := assert.
-
-    Lemma boxy_expand_spec: forall (p: pred (K0.knot*KI.other)),
-      boxy expandM p <->
-      (fun p: pred (K0.knot*KI.other) =>
-         forall x y, expandR x y -> proj1_sig p x -> proj1_sig p y) p.
-    Proof.
-      intros.
-      split; intro.
-      + pose proof boxy_e _ _ H; auto.
-      + pose proof boxy_i _ expandM expandM_refl H; auto.
-    Qed.
-
-    Lemma hered_hereditary : forall (p:K0.knot*KI.other -> Prop),
-      K0.hered p <->
-      (hereditary age p /\ (fun p:K0.knot*KI.other -> Prop => forall x y, expandR x y -> p x -> p y) p).
-    Proof.
-      intros; split; repeat intro.
-      split; repeat intro.
-      rewrite K0.hered_spec in H.
-      revert H1.
-      destruct a; destruct a'.
-      hnf in H0; simpl in H0.
-      case_eq (age1 k); intros;
-        rewrite H1 in H0; try discriminate.
-      inv H0.
-      apply (H k k0 k0 o0 o0).
-      apply rt_step; auto.
-      hnf.
-      destruct (K0.unsquash k0); split; auto.
-      apply Input.Rel_refl.
-      apply Input.ORel_refl.
-      auto.
-
-      rewrite K0.hered_spec in H.
-      destruct H0.
-      destruct x as [xk xo].
-      destruct y as [yk yo].
-      simpl in *.
-      revert H1; apply (H xk xk yk xo yo); auto.
-
-      rewrite K0.hered_spec; repeat intro.
-      destruct H.
-      cut (p (k',o)).
-      apply H4.
-      split; auto.
-      revert H3.
-      clear -H0 H; induction H0.
-      apply H; hnf; simpl; auto.
-      hnf in H0.
-      rewrite H0; auto.
-      auto.
-      intuition.
-    Qed.
-
-    Definition pkp: bijection predicate K0.predicate :=
-      (bij_sym (sig_sig_iff_bij hered_hereditary)) ooo
-      (bij_sym (sig_sigsig_bij (hereditary age) _)) ooo
-      (sig_sig_iff_bij boxy_expand_spec).
-
-  End Output.
-
-  Module K := knot_full_variant.KnotFull(Input)(Output).
-
-  Definition knot := K.knot.
-  Definition ageable_knot := K.ageable_knot.
-  Definition squash: (nat * KI.F assert) -> knot := K.squash.
-  Definition unsquash: knot -> (nat * KI.F assert) := K.unsquash.
-  Definition approx: nat -> assert -> assert := K.approx.
-
-  Lemma approx_spec : forall n p k,
-    proj1_sig (approx n p) k = (level (fst k) < n /\ proj1_sig p k).
-  Proof.
-    intros.
-    apply prop_ext.
-    pose proof K.approx_spec n p k.
-    match goal with
-    | _: ?A = _ |- ?B <-> _ => change B with A
-    end.
-    rewrite H.
-    match goal with
-    | |- (if Compare_dec.le_gt_dec _ ?A then _ else _) <-> (?B < _ /\ _) =>
-            change B with A; remember A as TMP eqn:HHH; clear HHH
-    end.
-    destruct (Compare_dec.le_gt_dec n TMP).
-    + split.
-      - intros [].
-      - intros [? ?]; lia.
-    + split.
-      - intros; split; [lia | auto].
-      - intros [? ?]; auto.
-  Qed.
-
-  Definition squash_unsquash := K.squash_unsquash.
-
-  Definition unsquash_squash := K.unsquash_squash.
-
-  Definition knot_age1 := K.knot_age1.
-
-  Definition knot_level := K.knot_level.
-
-  Definition knot_rel (k1 k2:knot) :=
-    let (n,f) := unsquash k1 in
-    let (n',f') := unsquash k2 in
-    n = n' /\ KI.Rel assert f f'.
-
-  Lemma expandM_spec : forall k k' o o',
-    expandM (k,o) (k',o') = (K.knot_rel k k' /\ KI.ORel o o').
-  Proof.
-    intros.
-    rewrite K.knot_rel_spec.
-    apply prop_ext; intuition.
-    + destruct H; simpl in *; auto.
-    + destruct H; auto.
-    + split; simpl; auto.
-  Qed.
-
-End Knot_CovariantHeredPropOthRel.
-
-Module KnotLemmas_CovariantHeredPropOthRel
-  (K: KNOT__COVARIANT_HERED_PROP_OTH_REL).
-
-  Import CovariantFunctor.
-  Import K.KI.
-  Import K.
-
-  Lemma unsquash_inj : forall k1 k2,
-    unsquash k1 = unsquash k2 ->
-    k1 = k2.
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas1.unsquash_inj
-       (knot_full_variant.KnotLemmas1.Build_Input _ _ _ _ _ squash_unsquash unsquash_squash)),
-     (knot_full_variant.KnotLemmas1.Proof).
-  Qed.
-  Arguments unsquash_inj [k1 k2] _.
-
-  Lemma squash_surj : forall k, exists n, exists Fp,
-    squash (n, Fp) = k.
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas1.squash_surj
-       (knot_full_variant.KnotLemmas1.Build_Input _ _ _ _ _ squash_unsquash unsquash_squash)),
-     (knot_full_variant.KnotLemmas1.Proof).
-  Qed.
-
-  Lemma unsquash_approx : forall k n Fp,
-    unsquash k = (n, Fp) ->
-    Fp = fmap KI.F (approx n) Fp.
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas1.unsquash_approx
-       (knot_full_variant.KnotLemmas1.Build_Input _ _ _ _ _ squash_unsquash unsquash_squash)),
-     (knot_full_variant.KnotLemmas1.Proof).
-  Qed.
-  Arguments unsquash_approx [k n Fp] _.
-
-  Lemma pred_ext : forall (p1 p2: assert),
-    (forall x, proj1_sig p1 x = proj1_sig p2 x) ->
-    p1 = p2.
-  Proof.
-    intros.
-    apply exist_ext'.
-    apply pred_ext'.
-    extensionality; auto.
-  Qed.
-
-  Lemma approx_spec': forall n p ko,
-    proj1_sig (approx n p) ko =
-    if (Compare_dec.le_gt_dec n (level (fst ko))) then False else proj1_sig p ko.
-  Proof.
-    intros.
-    rewrite approx_spec.
-    apply prop_ext.
-    destruct (Compare_dec.le_gt_dec n (level (fst ko))).
-    + split; [intros [? ?]; lia | intros []].
-    + tauto.
-  Qed.
-
-  Lemma approx_approx1 : forall m n,
-    approx n = approx n oo approx (m+n).
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas2.approx_approx1
-       (knot_full_variant.KnotLemmas2.Build_Input _ _ _ _ _ assert
-         (@proj1_sig _ _) _ pred_ext approx_spec')),
-     (knot_full_variant.KnotLemmas2.Proof).
-  Qed.
-
-  Lemma approx_approx2 : forall m n,
-    approx n = approx (m+n) oo approx n.
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas2.approx_approx2
-       (knot_full_variant.KnotLemmas2.Build_Input _ _ _ _ _ assert
-         (@proj1_sig _ _) _ pred_ext approx_spec')),
-     (knot_full_variant.KnotLemmas2.Proof).
-  Qed.
-
-End KnotLemmas_CovariantHeredPropOthRel.
-
-Module Knot_CovariantHeredPropOth (KI':KNOT_INPUT__COVARIANT_HERED_PROP_OTH)
-  : KNOT__COVARIANT_HERED_PROP_OTH with Module KI:=KI'.
-
-  Import MixVariantFunctor.
-  Import MixVariantFunctorLemmas.
-  Import GeneralFunctorGenerator.
-  Module KI:=KI'.
-
-  Module Input.
-    Definition F: functor := CovariantFunctor_MixVariantFunctor KI.F.
-    Definition other := KI.other.
-
-    Definition Rel A := @eq (F A).
-    Lemma Rel_fmap : forall A B (f:A -> B) (s:B -> A) x y,
-      Rel A x y ->
-      Rel B (fmap F f s x) (fmap F f s y).
-    Proof.
-      unfold Rel; intuition; subst; auto.
-    Qed.
-
-    Lemma Rel_refl : forall A x, Rel A x x.
-    Proof.
-      intros; hnf; auto.
-    Qed.
-
-    Lemma Rel_trans : forall A x y z,
-      Rel A x y -> Rel A y z -> Rel A x z.
-    Proof.
-      unfold Rel; intuition congruence.
-    Qed.
-
-    Definition ORel := @eq other.
-    Lemma ORel_refl : reflexive other ORel.
-    Proof.
-      hnf; unfold ORel; auto.
-    Qed.
-    Lemma ORel_trans : transitive other ORel.
-    Proof.
-      hnf; unfold ORel; intros; congruence.
-    Qed.
-
-    Definition T := Prop.
-    Definition T_bot := False.
-
-    Definition T_rel (x y:T) := x -> y.
-    Lemma T_rel_bot : forall x, T_rel T_bot x.
-    Proof.
-      compute; intuition.
-    Qed.
-
-    Lemma T_rel_refl : forall x, T_rel x x.
-    Proof.
-      compute; intuition.
-    Qed.
-
-    Lemma T_rel_trans : transitive _ T_rel.
-    Proof.
-      hnf; unfold T_rel; intuition.
-    Qed.
-  End Input.
-
-  Module K0 := knot_full_variant.Knot_MixVariantHeredTOthRel(Input).
-  Module KL0 := knot_full_variant.KnotLemmas_MixVariantHeredTOthRel(K0).
-  #[global] Existing Instance K0.ageable_knot.
-  Definition ag_knot_other := ag_prod K0.knot KI.other K0.ageable_knot.
-  #[global] Existing Instance ag_knot_other.
-
-  Lemma hered_hereditary : forall (p: K0.knot*KI.other -> Prop),
-    K0.hered p <-> hereditary age p.
-  Proof.
-    intros; split; repeat intro.
-    rewrite K0.hered_spec in H.
-    hnf in H0.
-    simpl in H0.
-    destruct a; destruct a'.
-    simpl in *.
-    case_eq (age1 k); intros.
-    rewrite H2 in H0.
-    inv H0.
-    specialize ( H k k0 k0).
-    specialize ( H o0 o0).
-    spec H.
-    apply rt_step; auto.
-    spec H.
-    hnf.
-    destruct (K0.unsquash k0); split; auto.
-    hnf; auto.
-    apply H; auto.
-    hnf; auto.
-    rewrite H2 in H0; discriminate.
-
-    rewrite K0.hered_spec; intros.
-    assert (k' = k'').
-    apply KL0.unsquash_inj.
-    hnf in H1.
-    hnf in H2; subst o'.
-    destruct (K0.unsquash k').
-    destruct (K0.unsquash k'').
-    destruct H1; hnf in H2.
-    subst; auto.
-    subst k''.
-    hnf in H.
-
-    hnf.
-    hnf in H2; subst.
-    clear H1.
-    induction H0.
-    eapply H; eauto.
-    hnf; simpl.
-    hnf in H0.
-    rewrite H0; auto.
-    auto.
-    eauto.
-  Qed.
-
-  Module Output <: knot_full_variant.KNOT_FULL_OUTPUT with Module KI := Input.
-    Module KI := Input.
-    Module K0 := K0.
-
-    Definition predicate : Type := pred (K0.knot * KI.other).
-    Definition pkp: bijection predicate K0.predicate :=
-      bij_sym (sig_sig_iff_bij hered_hereditary).
-  End Output.
-
-  Module K := knot_full_variant.KnotFull(Input)(Output).
-
-  Definition knot := K.knot.
-  Definition ageable_knot := K.ageable_knot.
-  Definition squash: (nat * KI.F (pred (knot*KI.other))) -> knot := K.squash.
-  Definition unsquash: knot -> (nat * KI.F (pred (knot*KI.other))) := K.unsquash.
-  Definition approx: nat -> pred (knot*KI.other) -> pred (knot*KI.other) :=
-    K.approx.
-
-  Lemma approx_spec : forall n p k,
-    approx n p k = (level (fst k) < n /\ p k).
-  Proof.
-    intros.
-    apply prop_ext.
-    pose proof K.approx_spec n p k.
-    match goal with
-    | _: ?A = _ |- ?B <-> _ => change B with A
-    end.
-    rewrite H.
-    match goal with
-    | |- (if Compare_dec.le_gt_dec _ ?A then _ else _) <-> (?B < _ /\ _) =>
-            change B with A; remember A as TMP eqn:HHH; clear HHH
-    end.
-    destruct (Compare_dec.le_gt_dec n TMP).
-    + split.
-      - intros [].
-      - intros [? ?]; lia.
-    + split.
-      - intros; split; [lia | auto].
-      - intros [? ?]; auto.
-  Qed.
-
-  Definition squash_unsquash := K.squash_unsquash.
-
-  Definition unsquash_squash := K.unsquash_squash.
-
-  Definition knot_age1 := K.knot_age1.
-
-  Definition knot_level := K.knot_level.
-
-End Knot_CovariantHeredPropOth.
-
-Module KnotLemmas_CovariantHeredPropOth (K: KNOT__COVARIANT_HERED_PROP_OTH).
-
-  Import CovariantFunctor.
-  Import K.KI.
-  Import K.
-
-  Lemma unsquash_inj : forall k1 k2,
-    unsquash k1 = unsquash k2 ->
-    k1 = k2.
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas1.unsquash_inj
-       (knot_full_variant.KnotLemmas1.Build_Input _ _ _ _ _ squash_unsquash unsquash_squash)),
-     (knot_full_variant.KnotLemmas1.Proof).
-  Qed.
-  Arguments unsquash_inj [k1 k2] _.
-
-  Lemma squash_surj : forall k, exists n, exists Fp,
-    squash (n, Fp) = k.
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas1.squash_surj
-       (knot_full_variant.KnotLemmas1.Build_Input _ _ _ _ _ squash_unsquash unsquash_squash)),
-     (knot_full_variant.KnotLemmas1.Proof).
-  Qed.
-
-  Lemma unsquash_approx : forall k n Fp,
-    unsquash k = (n, Fp) ->
-    Fp = fmap KI.F (approx n) Fp.
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas1.unsquash_approx
-       (knot_full_variant.KnotLemmas1.Build_Input _ _ _ _ _ squash_unsquash unsquash_squash)),
-     (knot_full_variant.KnotLemmas1.Proof).
-  Qed.
-  Arguments unsquash_approx [k n Fp] _.
-
-  Lemma pred_ext : forall (p1 p2: pred (knot * other)),
-    (forall x, p1 x = p2 x) ->
-    p1 = p2.
-  Proof.
-    intros.
-    apply pred_ext'.
-    extensionality; auto.
-  Qed.
-
-  Lemma approx_spec': forall n p ko,
-    (approx n p) ko =
-    if (Compare_dec.le_gt_dec n (level (fst ko))) then False else proj1_sig p ko.
-  Proof.
-    intros.
-    rewrite approx_spec.
-    apply prop_ext.
-    destruct (Compare_dec.le_gt_dec n (level (fst ko))).
-    + split; [intros [? ?]; lia | intros []].
-    + tauto.
-  Qed.
-
-  Lemma approx_approx1 : forall m n,
-    approx n = approx n oo approx (m+n).
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas2.approx_approx1
-       (knot_full_variant.KnotLemmas2.Build_Input _ _ _ _ _ _
-         (@proj1_sig _ _) _ pred_ext approx_spec')),
-     (knot_full_variant.KnotLemmas2.Proof).
-  Qed.
-
-  Lemma approx_approx2 : forall m n,
-    approx n = approx (m+n) oo approx n.
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas2.approx_approx2
-       (knot_full_variant.KnotLemmas2.Build_Input _ _ _ _ _ _
-         (@proj1_sig _ _) _ pred_ext approx_spec')),
-     (knot_full_variant.KnotLemmas2.Proof).
-  Qed.
-
-End KnotLemmas_CovariantHeredPropOth.
-
-Module Knot_CovariantHeredProp (KI':KNOT_INPUT__COVARIANT_HERED_PROP)
-  : KNOT__COVARIANT_HERED_PROP with Module KI:=KI'.
-
-  Import MixVariantFunctor.
-  Import MixVariantFunctorLemmas.
-  Import GeneralFunctorGenerator.
-  Module KI:=KI'.
-
-  Module Input.
-    Definition F: functor := CovariantFunctor_MixVariantFunctor KI.F.
-    Definition other := unit.
-
-    Definition Rel A := @eq (F A).
-    Lemma Rel_fmap : forall A B (f:A -> B) (s:B -> A) x y,
-      Rel A x y ->
-      Rel B (fmap F f s x) (fmap F f s y).
-    Proof.
-      unfold Rel; intuition; subst; auto.
-    Qed.
-
-    Lemma Rel_refl : forall A x, Rel A x x.
-    Proof.
-      intros; hnf; auto.
-    Qed.
-
-    Lemma Rel_trans : forall A x y z,
-      Rel A x y -> Rel A y z -> Rel A x z.
-    Proof.
-      unfold Rel; intuition congruence.
-    Qed.
-
-    Definition ORel := @eq other.
-    Lemma ORel_refl : reflexive other ORel.
-    Proof.
-      hnf; unfold ORel; auto.
-    Qed.
-    Lemma ORel_trans : transitive other ORel.
-    Proof.
-      hnf; unfold ORel; intros; congruence.
-    Qed.
-
-    Definition T := Prop.
-    Definition T_bot := False.
-
-    Definition T_rel (x y:T) := x -> y.
-    Lemma T_rel_bot : forall x, T_rel T_bot x.
-    Proof.
-      compute; intuition.
-    Qed.
-
-    Lemma T_rel_refl : forall x, T_rel x x.
-    Proof.
-      compute; intuition.
-    Qed.
-
-    Lemma T_rel_trans : transitive _ T_rel.
-    Proof.
-      hnf; unfold T_rel; intuition.
-    Qed.
-  End Input.
-
-  Module K0 := knot_full_variant.Knot_MixVariantHeredTOthRel(Input).
-  Module KL0 := knot_full_variant.KnotLemmas_MixVariantHeredTOthRel(K0).
-  #[global] Existing Instance K0.ageable_knot.
-
-  Lemma hered_hereditary : forall (p: K0.knot -> Prop),
-    K0.hered (fun ko => p (fst ko)) <-> hereditary age p.
-  Proof.
-    intros; split; repeat intro.
-    rewrite K0.hered_spec in H.
-    hnf in H0.
-    simpl in H0.
-    specialize ( H a a' a').
-    specialize ( H tt tt).
-    spec H.
-    apply rt_step; auto.
-    spec H.
-    hnf.
-    destruct (K0.unsquash a'); split; auto.
-    hnf; auto.
-    apply H; auto.
-    hnf; auto.
-
-    rewrite K0.hered_spec; intros.
-    assert (k' = k'').
-    apply KL0.unsquash_inj.
-    hnf in H1.
-    destruct (K0.unsquash k').
-    destruct (K0.unsquash k'').
-    destruct H1; hnf in H3.
-    subst; auto.
-    subst k''.
-    hnf in H.
-
-    hnf.
-    simpl.
-    clear -H H0.
-    induction H0; auto.
-    eapply H; eauto.
-  Qed.
-
-  Module Output <: knot_full_variant.KNOT_FULL_OUTPUT with Module KI := Input.
-    Module KI := Input.
-    Module K0 := K0.
-
-    Definition predicate : Type := pred K0.knot.
-
-    Definition pkp: bijection predicate K0.predicate :=
-      bij_sym
-        ((sig_sig_iff_bij hered_hereditary) ooo
-         (bij_sig
-           (bij_sym (func_bij (unit_unit1 K0.knot) (bij_refl Prop)))
-           K0.hered)).
-  End Output.
-
-  Module K := knot_full_variant.KnotFull(Input)(Output).
-
-  Definition knot := K.knot.
-  Definition ageable_knot := K.ageable_knot.
-  Definition squash: (nat * KI.F (pred knot)) -> knot := K.squash.
-  Definition unsquash: knot -> (nat * KI.F (pred knot)) := K.unsquash.
-  Definition approx: nat -> pred knot -> pred knot := K.approx.
-
-  Lemma approx_spec : forall n p k,
-    approx n p k = (level k < n /\ p k).
-  Proof.
-    intros.
-    apply prop_ext.
-    pose proof K.approx_spec n p (k, tt).
-    match goal with
-    | _: ?A = _ |- ?B <-> _ => change B with A
-    end.
-    rewrite H.
-    match goal with
-    | |- (if Compare_dec.le_gt_dec _ ?A then _ else _) <-> (?B < _ /\ _) =>
-            change B with A; remember A as TMP eqn:HHH; clear HHH
-    end.
-    destruct (Compare_dec.le_gt_dec n TMP).
-    + split.
-      - intros [].
-      - intros [? ?]; lia.
-    + split.
-      - intros; split; [lia | auto].
-      - intros [? ?]; auto.
-  Qed.
-
-  Definition squash_unsquash := K.squash_unsquash.
-
-  Definition unsquash_squash := K.unsquash_squash.
-
-  Definition knot_age1 := K.knot_age1.
-
-  Definition knot_level := K.knot_level.
-
-End Knot_CovariantHeredProp.
-
-Module KnotLemmas_CovariantHeredProp (K: KNOT__COVARIANT_HERED_PROP).
-
-  Import CovariantFunctor.
-  Import K.KI.
-  Import K.
-
-  Lemma unsquash_inj : forall k1 k2,
-    unsquash k1 = unsquash k2 ->
-    k1 = k2.
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas1.unsquash_inj
-       (knot_full_variant.KnotLemmas1.Build_Input _ _ _ _ _ squash_unsquash unsquash_squash)),
-     (knot_full_variant.KnotLemmas1.Proof).
-  Qed.
-  Arguments unsquash_inj [k1 k2] _.
-
-  Lemma squash_surj : forall k, exists n, exists Fp,
-    squash (n, Fp) = k.
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas1.squash_surj
-       (knot_full_variant.KnotLemmas1.Build_Input _ _ _ _ _ squash_unsquash unsquash_squash)),
-     (knot_full_variant.KnotLemmas1.Proof).
-  Qed.
-
-  Lemma unsquash_approx : forall k n Fp,
-    unsquash k = (n, Fp) ->
-    Fp = fmap KI.F (approx n) Fp.
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas1.unsquash_approx
-       (knot_full_variant.KnotLemmas1.Build_Input _ _ _ _ _ squash_unsquash unsquash_squash)),
-     (knot_full_variant.KnotLemmas1.Proof).
-  Qed.
-  Arguments unsquash_approx [k n Fp] _.
-
-  Lemma pred_ext : forall (p1 p2: pred knot),
-    (forall x, p1 x = p2 x) ->
-    p1 = p2.
-  Proof.
-    intros.
-    apply pred_ext'.
-    extensionality; auto.
-  Qed.
-
-  Lemma pred_ext': forall (p1 p2: pred knot),
-    (forall x: knot * unit,
-      ((fun (p: knot -> Prop) ko => p (fst ko)) oo app_pred) p1 x =
-      ((fun (p: knot -> Prop) ko => p (fst ko)) oo app_pred) p2 x) ->
-    p1 = p2.
-  Proof.
-    intros.
-    unfold compose in H; simpl in H.
-    apply pred_ext'.
-    extensionality; apply (H (x, tt)).
-  Qed.
-
-  Lemma approx_spec': forall n p k,
-    ((fun (p: knot -> Prop) ko => p (@fst _ unit ko)) oo app_pred) (approx n p) k =
-    if (Compare_dec.le_gt_dec n (level (fst k))) then False else
-    ((fun (p: knot -> Prop) ko => p (@fst _ unit ko)) oo app_pred) p k.
-  Proof.
-    intros.
-    unfold compose; simpl.
-    rewrite approx_spec.
-    apply prop_ext.
-    destruct (Compare_dec.le_gt_dec n (level (fst k))).
-    + split; [intros [? ?]; lia | intros []].
-    + tauto.
-  Qed.
-
-  Lemma approx_approx1 : forall m n,
-    approx n = approx n oo approx (m+n).
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas2.approx_approx1
-       (knot_full_variant.KnotLemmas2.Build_Input _ _ _ _ _ _
-         _ _ pred_ext' approx_spec')),
-     (knot_full_variant.KnotLemmas2.Proof).
-  Qed.
-
-  Lemma approx_approx2 : forall m n,
-    approx n = approx (m+n) oo approx n.
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas2.approx_approx2
-       (knot_full_variant.KnotLemmas2.Build_Input _ _ _ _ _ _
-         _ _ pred_ext' approx_spec')),
-     (knot_full_variant.KnotLemmas2.Proof).
-  Qed.
-
-End KnotLemmas_CovariantHeredProp.*)
-
-Module Knot_MixVariantHeredProp (KI':KNOT_INPUT__MIXVARIANT_HERED_PROP)
-  : KNOT__MIXVARIANT_HERED_PROP with Module KI:=KI'.
-
-  Import MixVariantFunctor.
-  Import MixVariantFunctorLemmas.
-  Import GeneralFunctorGenerator.
-  Module KI:=KI'.
-
-  Module Input.
-    Definition F: functor := KI.F.
-    Definition other := unit.
-
-    Definition Rel A := KI.Rel A.
-    Definition Rel_fmap : forall A B (f:A -> B) (s:B -> A) x y,
-      Rel A x y ->
-      Rel B (fmap F f s x) (fmap F f s y) := KI.Rel_fmap.
-
-    Definition Rel_refl : forall A x, Rel A x x := KI.Rel_refl.
-
-    Definition Rel_trans : forall A x y z,
-      Rel A x y -> Rel A y z -> Rel A x z := KI.Rel_trans.
-
-    Definition ORel := @eq other.
-    Lemma ORel_refl : reflexive other ORel.
-    Proof.
-      hnf; unfold ORel; auto.
-    Qed.
-    Lemma ORel_trans : transitive other ORel.
-    Proof.
-      hnf; unfold ORel; intros; congruence.
-    Qed.
-
-    Definition T := Prop.
-    Definition T_bot := False.
-
-    Definition T_rel (x y:T) := x -> y.
-    Lemma T_rel_bot : forall x, T_rel T_bot x.
-    Proof.
-      compute; intuition.
-    Qed.
-
-    Lemma T_rel_refl : forall x, T_rel x x.
-    Proof.
-      compute; intuition.
-    Qed.
-
-    Lemma T_rel_trans : transitive _ T_rel.
-    Proof.
-      hnf; unfold T_rel; intuition.
-    Qed.
-  End Input.
-
-  Module K0 := knot_full_variant.Knot_MixVariantHeredTOthRel(Input).
-  Module KL0 := knot_full_variant.KnotLemmas_MixVariantHeredTOthRel(K0).
-  #[global] Existing Instance K0.ageable_knot.
-  #[global] Existing Instance K0.ext_knot.
-
-  Lemma hered_hereditary : forall (p: K0.knot -> Prop),
-    K0.hered (fun ko => p (fst ko)) <-> hereditary age p /\ hereditary K0.knot_rel p.
-  Proof.
-    intros; split; repeat intro.
-    rewrite K0.hered_spec in H.
-    split; repeat intro.
-    hnf in H0.
-    simpl in H0.
-    specialize (H a a' a').
-    specialize (H tt tt).
-    spec H.
-    apply rt_step; auto.
-    spec H.
-    hnf.
-    destruct (K0.unsquash a'); split; auto.
-    apply Input.Rel_refl.
-    apply H; auto.
-    hnf; auto.
-
-    eapply (H _ _ _ tt tt); eauto.
-    reflexivity.
-
-    rewrite K0.hered_spec; intros.
-    hnf; simpl.
-    intros Hp.
-    destruct H as [H Hrel].
-    eapply Hrel; eauto.
-    hnf in H.
-
-    hnf.
-    simpl.
-    clear -H H0 Hp.
-    induction H0; auto.
-    eapply H; eauto.
-  Qed.
-
-  Module Output <: knot_full_variant.KNOT_FULL_OUTPUT with Module KI := Input.
-    Module KI := Input.
-    Module K0 := K0.
-
-    Definition predicate : Type := pred K0.knot.
-
-    Definition pkp: bijection predicate K0.predicate :=
-      bij_sym
-        ((sig_sig_iff_bij hered_hereditary) ooo
-         (bij_sig
-           (bij_sym (func_bij (unit_unit1 K0.knot) (bij_refl Prop)))
-           K0.hered)).
-  End Output.
-
-  Module K := knot_full_variant.KnotFull(Input)(Output).
-
-  Definition knot := K.knot.
-  Definition ageable_knot := K.ageable_knot.
-  Definition ext_knot := K.ext_knot.
-  Definition predicate := pred knot.
-  Definition squash: (nat * KI.F (pred knot)) -> knot := K.squash.
-  Definition unsquash: knot -> (nat * KI.F (pred knot)) := K.unsquash.
-  Definition approx: nat -> pred knot -> pred knot := K.approx.
-
-  Lemma approx_spec : forall n p k,
-    approx n p k = (level k < n /\ p k).
-  Proof.
-    intros.
-    apply prop_ext.
-    pose proof K.approx_spec n p (k, tt).
-    match goal with
-    | _: ?A = _ |- ?B <-> _ => change B with A
-    end.
-    rewrite H.
-    match goal with
-    | |- (if Compare_dec.le_gt_dec _ ?A then _ else _) <-> (?B < _ /\ _) =>
-            change B with A; remember A as TMP eqn:HHH; clear HHH
-    end.
-    destruct (Compare_dec.le_gt_dec n TMP).
-    + split.
-      - intros [].
-      - intros [? ?]; lia.
-    + split.
-      - intros; split; [lia | auto].
-      - intros [? ?]; auto.
-  Qed.
-
-  Definition squash_unsquash := K.squash_unsquash.
-
-  Definition unsquash_squash := K.unsquash_squash.
-
-  Definition knot_age1 := K.knot_age1.
-
-  Definition knot_level := K.knot_level.
-
-  Lemma knot_order : forall k1 k2 : knot, ext_order k1 k2 <->
-    level k1 = level k2 /\ Input.Rel predicate (snd (unsquash k1)) (snd (unsquash k2)).
-  Proof.
-    intros; simpl.
-    unfold Output.K0.knot_rel, Output.K0.unsquash, unsquash, K.unsquash.
-    rewrite !K0.knot_level.
-    destruct (K0.unsquash k1) eqn: Hk1, (K0.unsquash k2) eqn: Hk2; unfold snd.
-    unfold Output.K0.KI.Rel.
-    split; intros [? H]; split; auto.
-    - apply KI.Rel_fmap; auto.
-    - apply (KI.Rel_fmap _ _ (bij_f _ _ Output.pkp) (bij_g _ _ Output.pkp)) in H.
-      rewrite !fmap_app, bij_fg_id, fmap_id in H; auto.
-  Qed.
-
-End Knot_MixVariantHeredProp.
-
-Module KnotLemmas_MixVariantHeredProp (K': KNOT__MIXVARIANT_HERED_PROP).
-
-  Import MixVariantFunctor.
-  Module K := K'.
-  Import K.KI.
-  Import K.
-
-  Lemma unsquash_inj : forall k1 k2,
-    unsquash k1 = unsquash k2 ->
-    k1 = k2.
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas1.unsquash_inj
-       (knot_full_variant.KnotLemmas1.Build_Input _ _ _ _ _ squash_unsquash unsquash_squash)),
-     (knot_full_variant.KnotLemmas1.Proof).
-  Qed.
-  Arguments unsquash_inj [k1 k2] _.
-
-  Lemma squash_surj : forall k, exists n, exists Fp,
-    squash (n, Fp) = k.
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas1.squash_surj
-       (knot_full_variant.KnotLemmas1.Build_Input _ _ _ _ _ squash_unsquash unsquash_squash)),
-     (knot_full_variant.KnotLemmas1.Proof).
-  Qed.
-
-  Lemma unsquash_approx : forall k n Fp,
-    unsquash k = (n, Fp) ->
-    Fp = fmap KI.F (approx n) (approx n) Fp.
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas1.unsquash_approx
-       (knot_full_variant.KnotLemmas1.Build_Input _ _ _ _ _ squash_unsquash unsquash_squash)),
-     (knot_full_variant.KnotLemmas1.Proof).
-  Qed.
-  Arguments unsquash_approx [k n Fp] _.
-
-  Lemma pred_ext : forall (p1 p2: pred knot),
-    (forall x, p1 x = p2 x) ->
-    p1 = p2.
-  Proof.
-    intros.
-    apply pred_ext'.
-    extensionality; auto.
-  Qed.
-
-  Lemma pred_ext': forall (p1 p2: pred knot),
-    (forall x: knot * unit,
-      ((fun (p: knot -> Prop) ko => p (fst ko)) oo app_pred) p1 x =
-      ((fun (p: knot -> Prop) ko => p (fst ko)) oo app_pred) p2 x) ->
-    p1 = p2.
-  Proof.
-    intros.
-    unfold compose in H; simpl in H.
-    apply pred_ext'.
-    extensionality; apply (H (x, tt)).
-  Qed.
-
-  Lemma approx_spec': forall n p k,
-    ((fun (p: knot -> Prop) ko => p (@fst _ unit ko)) oo app_pred) (approx n p) k =
-    if (Compare_dec.le_gt_dec n (level (fst k))) then False else
-    ((fun (p: knot -> Prop) ko => p (@fst _ unit ko)) oo app_pred) p k.
-  Proof.
-    intros.
-    unfold compose; simpl.
-    rewrite approx_spec.
-    apply prop_ext.
-    destruct (Compare_dec.le_gt_dec n (level (fst k))).
-    + split; [intros [? ?]; lia | intros []].
-    + tauto.
-  Qed.
-
-  Lemma approx_approx1 : forall m n,
-    approx n = approx n oo approx (m+n).
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas2.approx_approx1
-       (knot_full_variant.KnotLemmas2.Build_Input _ _ _ _ _ _
-         _ _ pred_ext' approx_spec')),
-     (knot_full_variant.KnotLemmas2.Proof).
-  Qed.
-
-  Lemma approx_approx2 : forall m n,
-    approx n = approx (m+n) oo approx n.
-  Proof.
-    apply
-     (@knot_full_variant.KnotLemmas2.approx_approx2
-       (knot_full_variant.KnotLemmas2.Build_Input _ _ _ _ _ _
-         _ _ pred_ext' approx_spec')),
-     (knot_full_variant.KnotLemmas2.Proof).
-  Qed.
-
-End KnotLemmas_MixVariantHeredProp.
diff --git a/msl/knot_unique.v b/msl/knot_unique.v
deleted file mode 100644
index b538c26201..0000000000
--- a/msl/knot_unique.v
+++ /dev/null
@@ -1,1006 +0,0 @@
-(*
- * Copyright (c) 2009-2010, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-
-Require Import VST.msl.base.
-Require Import VST.msl.ageable.
-Require Import VST.msl.knot.
-Require Import VST.msl.knot_lemmas.
-Require Import VST.msl.functors.
-
-Import CovariantFunctor.
-Import CovariantFunctorLemmas.
-Import CovariantFunctorGenerator.
-
-Local Open Scope nat_scope.
-
-Definition map_pair {A B C D} (f:A -> B) (g:C -> D) (x:A * C) : B * D :=
-  (f (fst x), g (snd x)).
-
-Module Type ISOMORPHIC_KNOTS.
-  Declare Module TF : TY_FUNCTOR.
-  Declare Module K1 : KNOT with Module TF := TF.
-  Declare Module K2 : KNOT with Module TF := TF.
-  Import TF.
-
-  Parameter f : K1.knot -> K2.knot.
-  Parameter g : K2.knot -> K1.knot.
-
-  Definition fF : F K1.predicate -> F K2.predicate :=
-    fmap F (fun p : K1.knot * other -> K1.TF.T => p oo map_pair g (@id other)).
-
-  Definition gF : F K2.predicate -> F K1.predicate :=
-    fmap F (fun p : K2.knot * other -> K2.TF.T => p oo map_pair f (@id other)).
-
-  Axiom iso1 : f oo g = id K2.knot.
-  Axiom iso2 : g oo f = id K1.knot.
-
-  Axiom f_squash : forall n F1,
-    f (K1.squash (n, F1)) = K2.squash (n, fF F1).
-
-  Axiom g_squash : forall n F2,
-    g (K2.squash (n, F2)) = K1.squash (n, gF F2).
-
-  Axiom f_unsquash : forall k1 U1,
-    U1 = K1.unsquash k1 ->
-    K2.unsquash (f k1) = (fst U1, fF (snd U1)).
-
-  Axiom g_unsquash : forall k2 U2,
-    U2 = K2.unsquash k2 ->
-    K1.unsquash (g k2) = (fst U2, gF (snd U2)).
-
-End ISOMORPHIC_KNOTS.
-
-Module Unique_Knot (TF' : TY_FUNCTOR)
-                                (K1' : KNOT with Module TF := TF')
-                                (K2' : KNOT with Module TF := TF') :
-                                  ISOMORPHIC_KNOTS
-                                    with Module TF := TF'
-                                    with Module K1 := K1'
-                                    with Module K2 := K2'.
-Module TF := TF'.
-Import TF.
-Module K1 := K1'.
-Module K2 := K2'.
-Module K1L := Knot_Lemmas K1.
-Module K2L := Knot_Lemmas K2.
-
-Section Common.
-Variable f : K1.knot -> K2.knot.
-Variable g : K2.knot -> K1.knot.
-
-Definition f_pred' (p1 : K1.predicate) : K2.predicate :=
-  p1 oo map_pair g (@id other).
-
-Definition g_pred' (p2 : K2.predicate) : K1.predicate :=
-  p2 oo map_pair f (@id other).
-
-Variable f_level : forall k, level k = level (f k).
-Variable g_level : forall k, level k = level (g k).
-
-Lemma f_pred'_approx: forall n,
-f_pred' oo K1.approx n = K2.approx n oo f_pred'.
-Proof.
-intros.
-extensionality P1 k2.
-destruct k2; unfold f_pred', compose; simpl.
-unfold K1'.approx, K2'.approx; simpl.
-rewrite g_level; simpl; auto.
-Qed.
-
-Lemma g_pred'_approx : forall n,
-g_pred' oo K2.approx n = K1.approx n oo g_pred'.
-Proof.
-intros.
-extensionality P k1.
-destruct k1; unfold g_pred', compose; simpl.
-unfold K1'.approx, K2'.approx; simpl.
-rewrite f_level; simpl; auto.
-Qed.
-
-Definition f_F' : TF.F K1.predicate -> TF.F K2.predicate :=
-  fmap F f_pred'.
-
-Definition g_F' : TF.F K2.predicate -> TF.F K1.predicate :=
-  fmap F g_pred'.
-
-End Common.
-
-Section Z.
-(* The base case.  To keep things simple, we will put definitions first. *)
-
-Definition fZ_pred (p2 : K2.predicate) : K1.predicate :=
-fun k1 => T_bot.
-
-Definition gZ_pred (p1 : K1.predicate) : K2.predicate :=
-fun k2 => T_bot.
-
-Definition fF_Z : TF.F K1.predicate -> TF.F K2.predicate :=
-  fmap F gZ_pred.
-
-Definition gF_Z : TF.F K2.predicate -> TF.F K1.predicate :=
-  fmap F fZ_pred.
-
-Definition f_Z (k1 : K1.knot) : K2.knot :=
-  match K1.unsquash k1 with
-    (n, F_p1) => K2.squash (n, fF_Z F_p1)
-  end.
-
-Definition g_Z (k2 : K2.knot) : K1.knot :=
-  match K2.unsquash k2 with
-    (n, F_p2) => K1.squash (n, gF_Z F_p2)
-  end.
-
-(* Now the lemmas *)
-Lemma predZ_iso1: fZ_pred oo K2.approx 0 oo gZ_pred = K1.approx 0.
-Proof.
-intros.
-extensionality p k.
-unfold compose, gZ_pred, fZ_pred, K1'.approx in *.
-destruct k; simpl; auto.
-Qed.
-
-Lemma predZ_iso2: gZ_pred oo K1.approx 0 oo fZ_pred = K2.approx 0.
-Proof.
-intros.
-extensionality p k.
-unfold compose, gZ_pred, fZ_pred, K2'.approx in *.
-destruct k; simpl; auto.
-Qed.
-
-Lemma iso1_Z : forall k, level k <= 0 -> (g_Z oo f_Z) k = k.
-Proof.
-intros.
-unfold compose, g_Z, f_Z.
-remember (K1.unsquash k) as unsq_k.
-destruct unsq_k as [n0 Fp].
-rewrite K2.unsquash_squash.
-rewrite K1.knot_level in H.
-rewrite <- Hequnsq_k in H.
-simpl in H.
-replace (fmap F (K2.approx n0) (fF_Z Fp)) with
-  ((fmap F (K2.approx n0) oo (fmap F gZ_pred)) Fp) by trivial.
-rewrite fmap_comp.
-replace (gF_Z (fmap F (K2.approx n0 oo gZ_pred) Fp)) with
-  ((fmap F fZ_pred oo fmap F (K2.approx n0 oo gZ_pred)) Fp) by trivial.
-rewrite fmap_comp.
-assert (n0 = 0) by lia.
-clear H; subst n0.
-symmetry in Hequnsq_k.
-rewrite predZ_iso1; trivial.
-rewrite <- (K1L.unsquash_approx Hequnsq_k).
-rewrite <- Hequnsq_k.
-rewrite K1.squash_unsquash.
-trivial.
-Qed.
-
-Lemma iso2_Z : forall k, level k <= 0 -> (f_Z oo g_Z) k = k.
-Proof.
-intros.
-unfold compose, g_Z, f_Z.
-remember (K2.unsquash k) as unsq_k.
-destruct unsq_k as [n0 Fp].
-rewrite K1.unsquash_squash.
-rewrite K2.knot_level in H.
-replace (fmap F (K1.approx n0) (gF_Z Fp)) with
-  ((fmap F (K1.approx n0) oo (fmap F fZ_pred)) Fp) by trivial.
-rewrite fmap_comp.
-replace (fF_Z (fmap F (K1.approx n0 oo fZ_pred) Fp)) with
-  ((fmap F gZ_pred oo fmap F (K1.approx n0 oo fZ_pred)) Fp) by trivial.
-rewrite fmap_comp.
-symmetry in Hequnsq_k.
-assert (n0 = 0).
-destruct (K2'.unsquash k); inv Hequnsq_k.
-simpl in H.
-lia.
-subst n0.
-rewrite predZ_iso2; trivial.
-rewrite <- (K2L.unsquash_approx Hequnsq_k).
-rewrite <- Hequnsq_k.
-rewrite K2.squash_unsquash.
-trivial.
-Qed.
-
-(* We must also prove that f_Sn and g_Sn preserve the level property. *)
-Lemma f_level_Z: forall k, level k = level (f_Z k).
-Proof.
-intro.
-unfold f_Z.
-rewrite K1.knot_level, K2.knot_level.
-remember (K1.unsquash k) as uk.
-destruct uk.
-rewrite K2.unsquash_squash.
-trivial.
-Qed.
-
-Lemma g_level_Z: forall k, level k = level (g_Z k).
-Proof.
-intro.
-unfold g_Z.
-simpl.
-rewrite K1.knot_level, K2.knot_level.
-remember (K2.unsquash k) as uk.
-destruct uk.
-rewrite K1.unsquash_squash.
-trivial.
-Qed.
-
-(* Finally, we must show that fZ preserves unsquashing. *)
-Lemma fZ_unsquash : forall k1,
-  level k1 <= 0 ->
-  forall U1,
-  U1 = K1.unsquash k1 ->
-  K2.unsquash (f_Z k1) = (fst U1, fF_Z (snd U1)).
-Proof.
-intros.
-unfold fF_Z, f_Z.
-destruct U1 as [n F1].
-simpl.
-rewrite <- H0.
-rewrite K2.unsquash_squash.
-replace (fmap F (K2.approx n) (fF_Z F1)) with
- ((fmap F (K2.approx n) oo fmap F gZ_pred) F1) by trivial.
-rewrite fmap_comp.
-assert (K2'.approx n oo gZ_pred = gZ_pred).
-extensionality P1 k2.
-destruct k2.
-unfold gZ_pred, compose, K2'.approx; simpl.
-destruct (Compare_dec.le_gt_dec n (level k)); auto.
-congruence.
-Qed.
-
-End Z.
-
-Section Sn.
-(* The inductive step.  To keep things simple, we will put definitions first. *)
-Variable f : K1.knot -> K2.knot.
-Variable g : K2.knot -> K1.knot.
-
-
-Definition f_Sn (k1 : K1.knot) : K2.knot :=
-  match K1.unsquash k1 with
-    (n, F_p1) => K2.squash (n, f_F' g F_p1)
-  end.
-
-Definition g_Sn (k2 : K2.knot) : K1.knot :=
-  match K2.unsquash k2 with
-    (n, F_p2) => K1.squash (n, g_F' f F_p2)
-  end.
-
-
-(* Now we include details relevant to the proof of the inductive step. *)
-
-Variable n : nat.
-Variable iso1 : forall k, level k <= n -> (g oo f) k = k.
-Variable iso2 : forall k, level k <= n -> (f oo g) k = k.
-
-(* These two properties are enough to prove a bijection up to level k *)
-
-Lemma f_inj : forall ka kb,
-  level ka <= n ->
-  level kb <= n ->
-  f ka = f kb ->
-  ka = kb.
-Proof.
-intros.
-assert ((g oo f) ka = (g oo f) kb) by (unfold compose; rewrite H1; trivial).
-do 2 rewrite iso1 in H2; trivial.
-Qed.
-
-Lemma g_inj : forall ka kb,
-  level ka <= n ->
-  level kb <= n ->
-  g ka = g kb ->
-  ka = kb.
-Proof.
-intros.
-assert ((f oo g) ka = (f oo g) kb) by (unfold compose; rewrite H1; trivial).
-do 2 rewrite iso2 in H2; trivial.
-Qed.
-
-Lemma f_surj : forall k2,
-  level k2 <= n ->
-  exists k1,
-  f k1 = k2.
-Proof.
-intros.
-exists (g k2).
-rewrite <- iso2; trivial.
-Qed.
-
-Lemma g_surj : forall k1,
-  level k1 <= n ->
-  exists k2,
-  g k2 = k1.
-Proof.
-intros.
-exists (f k1).
-rewrite <- iso1; trivial.
-Qed.
-
-(* Now we show that k1_pred and k2_pred are the identity under approximation. *)
-(* Not clear that we need this. *)
-(*
-Lemma k1_pred_iso: K1.approx (n+1) oo k1_pred = K1.approx (n+1).
-Proof.
-intros.
-extensionality p k.
-unfold k1_pred, compose, g_pred, f_pred in *.
-apply prop_ext; split; do 2 intro; spec H H0; rewrite iso1 in *; trivial; lia.
-Qed.
-
-Lemma k2_pred_iso: K2.approx (n+1) oo k2_pred = K2.approx (n+1).
-Proof.
-intros.
-extensionality p k.
-unfold k2_pred, compose, g_pred, f_pred in *.
-apply prop_ext; split; do 2 intro; spec H H0; rewrite iso2 in *; trivial; lia.
-Qed.
-*)
-
-(*
-What we would like to show next is that f and g preserve the level of the knot,
-even in their (unfortunately non-unique over level n) inverses.
-Unfortunately, this is not possible:
-
-Lemma f_level: forall k, K1.level k = K2.level (f k).
-
-This is clearly impossible since we don't know anything about the behavior of f
-for knots above level n.
-
-Actually, even this weaker version is not provable:
-
-Lemma f_level: forall k,
-(K1.level k <= n \/ K2.level (f k) <= n) ->
-K1.level k = K2.level (f k).
-
-Counterexample: K1.knot = K2.knot = nat;
-                            K1.level = K2.level = id;
-                            f = inc, g = dec;
-*)
-
-(* So we must assert them as axioms, which means a bigger induction *)
-Variable f_level: forall k, level k = level (f k).
-Variable g_level: forall k, level k = level (g k).
-
-(* However, using them we can prove pred_iso1 and pred_iso2, which are vital. *)
-Lemma predn_iso1: forall m,
-  m <= (n+1) ->
-  g_pred' f oo K2.approx m oo f_pred' g = K1.approx m.
-Proof.
-intros.
-extensionality p k.
-unfold g_pred', f_pred', compose in *.
-destruct k.
-unfold K2'.approx, map_pair, id; simpl.
-unfold K1'.approx; simpl.
-rewrite <- f_level.
-simpl.
-destruct (Compare_dec.le_gt_dec m (level k)); auto.
-rewrite iso1; auto.
-simpl; lia.
-Qed.
-
-Lemma predn_iso2: forall m,
-  m <= (n+1) ->
-  f_pred' g oo K1.approx m oo g_pred' f = K2.approx m.
-Proof.
-intros.
-extensionality p k.
-unfold g_pred', f_pred', compose in *.
-destruct k.
-unfold K1'.approx, map_pair, id; simpl.
-unfold K2'.approx; simpl.
-rewrite <- g_level.
-simpl.
-destruct (Compare_dec.le_gt_dec m (level k)); auto.
-rewrite iso2; auto.
-simpl; lia.
-Qed.
-
-(* Now we can prove that f_Sn and g_Sn preserve the isomorphism. *)
-Lemma iso1_Sn : forall k, level k <= n + 1 -> (g_Sn oo f_Sn) k = k.
-Proof.
-intros.
-unfold compose, g_Sn, f_Sn.
-remember (K1.unsquash k) as unsq_k.
-destruct unsq_k as [n0 Fp].
-rewrite K2.unsquash_squash.
-rewrite K1.knot_level in H.
-rewrite <- Hequnsq_k in H.
-simpl in H.
-replace (fmap F (K2.approx n0) (f_F' g Fp)) with
-  ((fmap F (K2.approx n0) oo (fmap F (f_pred' g))) Fp) by trivial.
-rewrite fmap_comp.
-replace (g_F' f (fmap F (K2.approx n0 oo f_pred' g) Fp)) with
-  ((fmap F (g_pred' f) oo fmap F (K2.approx n0 oo f_pred' g)) Fp) by trivial.
-rewrite fmap_comp.
-symmetry in Hequnsq_k.
-rewrite predn_iso1; trivial.
-rewrite <- (K1L.unsquash_approx Hequnsq_k).
-rewrite <- Hequnsq_k.
-rewrite K1.squash_unsquash.
-trivial.
-Qed.
-
-Lemma iso2_Sn : forall k, level k <= n + 1 -> (f_Sn oo g_Sn) k = k.
-Proof.
-intros.
-unfold compose, g_Sn, f_Sn.
-remember (K2.unsquash k) as unsq_k.
-destruct unsq_k as [n0 Fp].
-rewrite K1.unsquash_squash.
-simpl in H.
-rewrite K2.knot_level in H.
-rewrite <- Hequnsq_k in H.
-simpl in H.
-replace (fmap F (K1.approx n0) (g_F' f Fp)) with
-  ((fmap F (K1.approx n0) oo (fmap F (g_pred' f))) Fp) by trivial.
-rewrite fmap_comp.
-replace (f_F' g (fmap F (K1.approx n0 oo g_pred' f) Fp)) with
-  ((fmap F (f_pred' g) oo fmap F (K1.approx n0 oo g_pred' f)) Fp) by trivial.
-rewrite fmap_comp.
-symmetry in Hequnsq_k.
-rewrite predn_iso2; trivial.
-rewrite <- (K2L.unsquash_approx Hequnsq_k).
-rewrite <- Hequnsq_k.
-rewrite K2.squash_unsquash.
-trivial.
-Qed.
-
-(* We must also prove that f_Sn and g_Sn preserve the level property. *)
-Lemma f_level_Sn: forall k, level k = level (f_Sn k).
-Proof.
-intro.
-unfold f_Sn.
-rewrite K1.knot_level, K2.knot_level.
-remember (K1.unsquash k) as uk.
-destruct uk.
-rewrite K2.unsquash_squash.
-trivial.
-Qed.
-
-Lemma g_level_Sn: forall k, level k = level (g_Sn k).
-Proof.
-intro.
-unfold g_Sn.
-rewrite K1.knot_level, K2.knot_level.
-remember (K2.unsquash k) as uk.
-destruct uk.
-rewrite K1.unsquash_squash.
-trivial.
-Qed.
-
-(* Finally, we must show that f_Sn preserves unsquashing. *)
-Variable fn_unsquash : forall k1,
-  level k1 <= n ->
-  forall U1,
-  U1 = K1.unsquash k1 ->
-  K2.unsquash (f k1) = (fst U1, f_F' g (snd U1)).
-
-Lemma Fn_iso2 : forall m,
-  m <= n + 1 ->
-  g_F' f oo f_F' g oo fmap F (K1.approx m) = fmap F (K1.approx m).
-Proof.
-intros.
-unfold g_F', f_F'.
-do 2 rewrite fmap_comp.
-replace (g_pred' f oo f_pred' g oo K1.approx m) with (K1.approx m); trivial.
-rewrite f_pred'_approx; trivial.
-rewrite predn_iso1; trivial.
-Qed.
-
-Lemma gn_unsquash : forall k2,
-  level k2 <= n ->
-  forall U2,
-  U2 = K2.unsquash k2 ->
-  K1.unsquash (g k2) = (fst U2, g_F' f (snd U2)).
-Proof.
-intros.
-destruct U2 as [m F2].
-simpl.
-generalize (fn_unsquash (g k2)); intro.
-rewrite <- g_level in H1.
-remember (g k2) as k1.
-specialize ( H1 H (K1.unsquash k1)).
-firstorder.
-assert (f k1 = (f oo g) k2) by (unfold compose; congruence).
-rewrite iso2 in H2; trivial.
-rewrite H2 in H1.
-rewrite <- H0 in H1.
-inversion H1.
-apply injective_projections; simpl; trivial.
-remember (K1.unsquash k1) as U1.
-replace (g_F' f (f_F' g (snd U1))) with ((g_F' f oo f_F' g) (snd U1)) by trivial.
-destruct U1 as [m' F1].
-simpl in *.
-subst m'.
-clear H1.
-symmetry in HeqU1.
-generalize (K1L.unsquash_approx HeqU1); intro.
-rewrite H1.
-replace ((g_F' f oo f_F' g) (fmap F (K1'.approx m) F1)) with
-  ((g_F' f oo f_F' g oo fmap F (K1.approx m)) F1) by trivial.
-rewrite Fn_iso2.
-trivial.
-simpl in H.
-rewrite K2.knot_level in H.
-rewrite <- H0 in H.
-simpl in H.
-lia.
-Qed.
-
-Lemma gn_squash : forall m F2,
-  m <= n ->
-  g (K2.squash (m, F2)) = K1.squash (m, g_F' f F2).
-Proof.
-intros.
-apply (K1L.unsquash_inj).
-assert (level (K2.squash (m , F2)) <= n) by
-  (simpl; rewrite K2.knot_level; rewrite K2.unsquash_squash; simpl; trivial).
-rewrite (gn_unsquash (K2'.squash (m, F2)) H0 (K2.unsquash (K2'.squash (m, F2)))); trivial.
-rewrite K1.unsquash_squash.
-rewrite K2.unsquash_squash.
-simpl.
-replace (g_F' f (fmap F (K2'.approx m) F2)) with
-  ((fmap F (g_pred' f) oo (fmap F (K2.approx m))) F2) by trivial.
-replace (m, fmap F (K1'.approx m) (g_F' f F2)) with
-  (m, (fmap F (K1.approx m) oo fmap F (g_pred' f)) F2) by trivial.
-do 2 rewrite fmap_comp.
-apply injective_projections; simpl; trivial.
-rewrite g_pred'_approx; trivial.
-Qed.
-
-Lemma fSn_unsquash : forall k1,
-  level k1 <= n + 1 ->
-  forall U1,
-  U1 = K1.unsquash k1 ->
-  K2.unsquash (f_Sn k1) = (fst U1, f_F' (g_Sn) (snd U1)).
-Proof.
-intros.
-unfold f_Sn.
-rewrite <- H0.
-destruct U1 as [m F1].
-simpl.
-rewrite K2.unsquash_squash.
-apply injective_projections; simpl; trivial.
-unfold f_F'.
-replace (fmap F (K2'.approx m) (fmap F (f_pred' g) F1)) with
-  ((fmap F (K2.approx m) oo fmap F  (f_pred' g)) F1) by trivial.
-rewrite fmap_comp.
-simpl in H.
-rewrite K1.knot_level in H.
-rewrite <- H0 in H.
-simpl in H.
-symmetry in H0.
-generalize (K1L.unsquash_approx H0); intro.
-pattern F1 at 2.
-rewrite H1.
-replace (fmap F (f_pred' g_Sn) (fmap F (K1'.approx m) F1)) with
-  ((fmap F (f_pred' g_Sn) oo fmap F (K1.approx m)) F1) by trivial.
-rewrite fmap_comp.
-assert (K2'.approx m oo f_pred' g = f_pred' g_Sn oo K1.approx m); try congruence.
-extensionality p1 k2.
-destruct k2.
-simpl; unfold f_pred', compose, K1.approx, K2.approx, g_Sn; simpl.
-rewrite K1.knot_level, K2'.knot_level; unfold g_Sn; simpl.
-unfold map_pair; simpl.
-remember (K2.unsquash k) as uk2.
-destruct uk2 as [m' F2].
-rewrite K1.unsquash_squash.
-simpl.
-destruct (Compare_dec.le_gt_dec m m'); auto.
-unfold id.
-rewrite <- gn_squash in *; [ | lia ].
-rewrite Hequk2.
-rewrite K2.squash_unsquash; trivial.
-Qed.
-
-Lemma gn_gSn_eq_n : forall k,
-level k <= n ->
-g k = g_Sn k.
-Proof.
-intros.
-unfold g_Sn.
-remember (K2.unsquash k) as usqk.
-destruct usqk.
-simpl in H.
-rewrite K2.knot_level in H.
-rewrite <- Hequsqk in H.
-simpl in H.
-rewrite <- gn_squash; try lia.
-rewrite Hequsqk.
-rewrite K2.squash_unsquash.
-trivial.
-Qed.
-
-End Sn.
-
-Section FG.
-(* We tie it together *)
-
-Fixpoint fg (n : nat) {struct n} : ((K1.knot -> K2.knot) * (K2.knot -> K1.knot)) :=
-  match n with
-   | 0 => (f_Z, g_Z)
-   | S n => match fg n with (fn, gn) => (f_Sn gn, g_Sn fn) end
-  end.
-
-Lemma fg_level_fst : forall n k, level k = level (fst (fg n) k).
-Proof.
-intros.
-destruct n.
-apply f_level_Z.
-unfold fg.
-fold fg.
-destruct (fg n).
-apply f_level_Sn.
-Qed.
-
-Lemma fg_level_snd : forall n k, level k = level (snd (fg n) k).
-Proof.
-intros.
-destruct n.
-apply g_level_Z.
-unfold fg.
-fold fg.
-destruct (fg n).
-apply g_level_Sn.
-Qed.
-
-Lemma fg_id : forall n k, level k <= n -> (fst (fg n) oo snd (fg n)) k  = k.
-Proof.
-induction n.
-unfold fg.
-simpl.
-intros.
-rewrite iso2_Z; trivial.
-unfold fg.
-fold fg.
-remember (fg n) as fgn.
-destruct fgn as [fn gn].
-simpl in *.
-intros.
-rewrite (iso2_Sn fn gn n); trivial; try lia.
-intros.
-destruct n.
-unfold fg in Heqfgn.
-inversion Heqfgn.
-apply g_level_Z.
-unfold fg in Heqfgn.
-fold fg in Heqfgn.
-destruct (fg n).
-inversion Heqfgn.
-apply g_level_Sn.
-Qed.
-
-Lemma gf_id : forall n k, level k <= n -> (snd (fg n) oo fst (fg n)) k  = k.
-Proof.
-induction n.
-unfold fg.
-simpl.
-intros.
-rewrite iso1_Z; trivial.
-unfold fg.
-fold fg.
-remember (fg n) as fgn.
-destruct fgn as [fn gn].
-simpl in *.
-intros.
-rewrite (iso1_Sn fn gn n); trivial; try lia.
-intros.
-destruct n.
-unfold fg in Heqfgn.
-inversion Heqfgn.
-apply f_level_Z.
-unfold fg in Heqfgn.
-fold fg in Heqfgn.
-destruct (fg n).
-inversion Heqfgn.
-apply f_level_Sn.
-Qed.
-
-Lemma fg_fst_unsquash: forall n k, level k <= n ->
-  forall U1,
-  U1 = K1.unsquash k ->
-  K2.unsquash (fst (fg n) k) = (fst U1, f_F' (snd (fg n)) (snd U1)).
-Proof.
-induction n;
-unfold fg;
-fold fg;
-simpl;
-intros.
-rewrite (fZ_unsquash k H U1 H0).
-(* Move up? *)
-apply injective_projections; simpl; trivial.
-unfold f_F', fF_Z.
-destruct U1 as [m F1].
-simpl.
-simpl in H; rewrite K1.knot_level in H.
-rewrite <- H0 in H.
-simpl in H.
-assert (m = 0) by lia.
-subst m.
-clear H.
-symmetry in H0.
-generalize (K1L.unsquash_approx H0); intro.
-pattern F1 at 2.
-rewrite H.
-replace (fmap F (f_pred' g_Z) (fmap F (K1'.approx 0) F1)) with
-  ((fmap F (f_pred' g_Z) oo fmap F (K1.approx 0)) F1) by trivial.
-rewrite fmap_comp.
-replace (f_pred' g_Z oo K1'.approx 0) with gZ_pred; trivial.
-(* End move up *)
-remember (fg n) as fgn.
-destruct fgn as [fn gn].
-simpl in *.
-replace gn with (snd (fg n)) by (rewrite <- Heqfgn; trivial).
-generalize (fSn_unsquash (fst (fg n)) (snd (fg n)) n (gf_id n) (fg_id n) (fg_level_fst n) (fg_level_snd n)); intro.
-rewrite <- Heqfgn in H1.
-simpl in H1.
-replace (n + 1) with (S n) in H1 by lia.
-specialize ( H1 IHn k H U1 H0).
-rewrite <- Heqfgn.
-simpl.
-rewrite H1.
-trivial.
-Qed.
-
-Lemma fg_fg_eq: forall n k2,
-level k2 < n ->
-snd (fg (level k2)) k2 = snd (fg n) k2.
-Proof.
-intros.
-assert (exists m, level k2 + m = n).
-remember (level k2) as m.
-clear -H.
-induction n.
-inversion H.
-assert (m = n \/ m < n) by lia.
-clear H.
-destruct H0.
-subst n.
-exists 1.
-lia.
-destruct (IHn H) as [m0 ?].
-rewrite <- H0.
-exists (m0 + 1).
-lia.
-destruct H0 as [m ?].
-clear H.
-revert m H0.
-induction n; intros.
-replace (level k2) with 0 by lia; trivial.
-destruct m.
-replace (level k2 + 0) with (level k2) in H0 by trivial.
-rewrite H0.
-trivial.
-specialize ( IHn m).
-rewrite IHn; try lia.
-unfold fg; fold fg.
-remember (fg n) as fgn.
-destruct fgn as [fn gn].
-simpl.
-generalize (gn_gSn_eq_n (fst (fg n)) (snd (fg n)) n (gf_id n) (fg_id n) (fg_level_fst n) (fg_level_snd n) (fg_fst_unsquash n)); intro.
-rewrite <- Heqfgn in H.
-simpl in H.
-apply H.
-simpl in *.
-lia.
-Qed.
-
-End FG.
-
-(* Now for the main definitions and theorems *)
-
-Definition f (k : K1.knot) : K2.knot := fst (fg (level k)) k.
-
-Definition g (k : K2.knot) : K1.knot := snd (fg (level k)) k.
-
-Definition fF : TF.F K1.predicate -> TF.F K2.predicate :=
-  f_F' g.
-
-Definition gF : TF.F K2.predicate -> TF.F K1.predicate :=
-  g_F' f.
-
-Lemma iso1 : f oo g = id K2.knot.
-Proof.
-extensionality k.
-unfold id.
-unfold compose, f, g.
-rewrite <- fg_level_snd.
-remember (level k) as n.
-replace (fst (fg n) (snd (fg n) k)) with ((fst (fg n) oo snd (fg n)) k) by trivial.
-rewrite fg_id; trivial; lia.
-Qed.
-
-Lemma iso2 : g oo f = id K1.knot.
-Proof.
-extensionality k.
-unfold id.
-unfold compose, f, g.
-rewrite <- fg_level_fst.
-remember (level k) as n.
-replace (snd (fg n) (fst (fg n) k)) with ((snd (fg n) oo fst (fg n)) k) by trivial.
-rewrite gf_id; trivial; lia.
-Qed.
-
-Lemma fpred_gpred : f_pred' g oo g_pred' f = id (K2.predicate).
-Proof.
-extensionality P2 k2.
-unfold id.
-unfold g_pred', f_pred', map_pair, compose; simpl.
-destruct k2; simpl.
-replace (f (g k)) with ((f oo g) k) by trivial.
-rewrite iso1.
-trivial.
-Qed.
-
-Lemma gpred_fpred : g_pred' f oo f_pred' g = id (K1.predicate).
-Proof.
-extensionality P1 k1.
-unfold id.
-unfold g_pred', f_pred', compose.
-unfold map_pair; simpl.
-destruct k1; simpl.
-replace (g (f k)) with ((g oo f) k) by trivial.
-rewrite iso2.
-trivial.
-Qed.
-
-Lemma Fiso1 : fF oo gF = id (F K2.predicate).
-Proof.
-extensionality F2.
-unfold id.
-unfold fF, gF, f_F', g_F'.
-rewrite fmap_comp.
-rewrite fpred_gpred.
-rewrite fmap_id.
-trivial.
-Qed.
-
-Lemma Fiso2 : gF oo fF = id (F K1.predicate).
-Proof.
-extensionality F1.
-unfold id.
-unfold fF, gF, f_F', g_F'.
-rewrite fmap_comp.
-rewrite gpred_fpred.
-rewrite fmap_id.
-trivial.
-Qed.
-
-Lemma f_level : forall k, level k = level (f k).
-Proof.
-intros.
-unfold f.
-rewrite <- (fg_level_fst (level k)).
-trivial.
-Qed.
-
-Lemma g_level : forall k, level k = level (g k).
-Proof.
-intros.
-unfold g.
-rewrite <- (fg_level_snd (level k)).
-trivial.
-Qed.
-
-Lemma f_unsquash : forall k1 U1,
-  U1 = K1.unsquash k1 ->
-  K2.unsquash (f k1) = (fst U1, fF (snd U1)).
-Proof.
-intros.
-destruct U1 as [n F1].
-simpl.
-unfold f; simpl; rewrite K1.knot_level.
-rewrite <- H.
-simpl.
-assert (level k1 <= n) by (rewrite K1.knot_level; rewrite <- H; trivial).
-rewrite (fg_fst_unsquash n k1 H0 (n, F1)); trivial.
-simpl.
-apply injective_projections; simpl; trivial.
-unfold fF.
-symmetry in H.
-generalize (K1L.unsquash_approx H); intro.
-rewrite H1.
-unfold f_F'.
-replace (fmap F (f_pred' (snd (fg n))) (fmap F (K1'.approx n) F1)) with
-  ((fmap F (f_pred' (snd (fg n))) oo fmap F (K1.approx n)) F1) by trivial.
-replace (fmap F (f_pred' g) (fmap F (K1'.approx n) F1)) with
-  ((fmap F (f_pred' g) oo fmap F (K1.approx n)) F1) by trivial.
-do 2 rewrite fmap_comp.
-replace (f_pred' (snd (fg n)) oo K1.approx n) with (f_pred' g oo K1'.approx n); trivial.
-extensionality P1 k2.
-unfold f_pred', compose.
-unfold K1.approx.
-unfold map_pair; destruct k2; simpl.
-rewrite <- fg_level_snd.
-rewrite <- g_level.
-simpl.
-destruct (Compare_dec.le_gt_dec n (level k)); auto.
-unfold g.
-red in g0.
-rewrite (fg_fg_eq n k g0).
-auto.
-Qed.
-
-Lemma g_unsquash : forall k2 U2,
-  U2 = K2.unsquash k2 ->
-  K1.unsquash (g k2) = (fst U2, gF (snd U2)).
-Proof.
-intros.
-destruct U2 as [n F2].
-simpl.
-generalize (f_unsquash (g k2)); intro.
-remember (g k2) as k1.
-specialize ( H0 (K1.unsquash k1)).
-firstorder.
-assert (f k1 = (f oo g) k2) by (unfold compose; congruence).
-rewrite iso1 in H1.
-unfold id in H1.
-rewrite H1 in H0.
-rewrite <- H in H0.
-inversion H0.
-remember (K1.unsquash k1) as U1.
-replace (gF (fF (snd U1))) with ((gF oo fF) (snd U1)) by trivial.
-rewrite Fiso2.
-unfold id.
-destruct U1.
-trivial.
-Qed.
-
-
-Lemma fF_approx : forall n,
-fF oo (fmap F (K1.approx n)) = (fmap F (K2.approx n)) oo fF.
-Proof.
-intros.
-unfold fF, f_F'.
-do 2 rewrite fmap_comp.
-rewrite f_pred'_approx.
-trivial.
-apply g_level.
-Qed.
-
-Lemma gF_approx : forall n,
-gF oo (fmap F (K2.approx n)) = (fmap F (K1.approx n)) oo gF.
-Proof.
-intros.
-unfold gF, g_F'.
-do 2 rewrite fmap_comp.
-rewrite g_pred'_approx.
-trivial.
-apply f_level.
-Qed.
-
-Lemma f_squash : forall n F1,
-  f (K1.squash (n, F1)) = K2.squash (n, fF F1).
-Proof.
-intros.
-apply (K2L.unsquash_inj).
-rewrite (f_unsquash (K1'.squash (n, F1)) (K1.unsquash (K1'.squash (n, F1)))); trivial.
-rewrite K1.unsquash_squash.
-rewrite K2.unsquash_squash.
-simpl.
-replace (fF (fmap F (K1'.approx n) F1)) with
-  ((fF oo (fmap F (K1.approx n))) F1) by trivial.
-rewrite fF_approx.
-trivial.
-Qed.
-
-Lemma g_squash : forall n F2,
-  g (K2.squash (n, F2)) = K1.squash (n, gF F2).
-Proof.
-intros.
-apply (K1L.unsquash_inj).
-rewrite (g_unsquash (K2'.squash (n, F2)) (K2.unsquash (K2'.squash (n, F2)))); trivial.
-rewrite K1.unsquash_squash.
-rewrite K2.unsquash_squash.
-simpl.
-replace (gF (fmap F (K2'.approx n) F2)) with
-  ((gF oo (fmap F (K2.approx n))) F2) by trivial.
-rewrite gF_approx.
-trivial.
-Qed.
-
-End Unique_Knot.
diff --git a/msl/log_normalize.v b/msl/log_normalize.v
deleted file mode 100644
index a9e0dc8d99..0000000000
--- a/msl/log_normalize.v
+++ /dev/null
@@ -1,1878 +0,0 @@
-Require Import VST.msl.simple_CCC.
-Require Import VST.msl.seplog.
-(* Require Import VST.msl.alg_seplog. *)
-Require Import VST.msl.Extensionality.
-Require Import Coq.Setoids.Setoid.
-
-(* Set Warnings "-deprecated-hint-rewrite-without-locality".  Delete this line after we abandon Coq 8.13 *)
-
-Create HintDb norm discriminated.
-
-Local Open Scope logic.
-
-#[export] Hint Extern 0 (_ |-- _) => match goal with |- ?A |-- ?B => constr_eq A B; simple apply derives_refl end : core.
-(* Hint Resolve derives_refl.    too expensive sometimes when it fails . . . *)
-
-Ltac solve_andp' :=
-  first [ apply derives_refl
-        | apply andp_left1; solve_andp'
-        | apply andp_left2; solve_andp'].
-
-Ltac solve_andp := repeat apply andp_right; solve_andp'.
-
-Lemma TT_right {A}{NA: NatDed A}: forall P:A, P |-- TT.
-Proof. intros; apply prop_right; auto.
-Qed.
-
-Lemma FF_left {A}{NA: NatDed A}: forall P, FF |-- P.
-Proof.
-intros; apply prop_left. intuition.
-Qed.
-
-#[export] Hint Resolve TT_right: norm.
-#[export] Hint Resolve FF_left : norm.
-
-Ltac norm := auto with norm.
-
-Lemma add_andp: forall {A: Type} `{NatDed A} (P Q: A), (P |-- Q) -> P = P && Q.
-Proof.
-  intros.
-  apply pred_ext.
-  + apply andp_right; auto.
-  + apply andp_left1; apply derives_refl.
-Qed.
-
-Lemma andp_comm  {A}{NA: NatDed A}:
-  forall P Q: A,  P && Q = Q && P.
-Proof with norm.
- intros.
-   apply pred_ext.
-   apply andp_right. apply andp_left2... apply andp_left1...
-    apply andp_right. apply andp_left2... apply andp_left1...
-Qed.
-
-Lemma andp_assoc {A} {NA: NatDed A} : forall P Q R : A,
-  (P && Q) && R = P && (Q && R).
-Proof.
-  intros; apply pred_ext;   repeat apply andp_right.
-  do 2 apply andp_left1; auto.
-  apply andp_left1; apply andp_left2; auto.
-  apply andp_left2; auto.
-  apply andp_left1; auto.
-  apply andp_left2; apply andp_left1; auto.
-  do 2 apply andp_left2; auto.
-Qed.
-
-Lemma andp_derives {A} {NA: NatDed A}:
-  forall P Q P' Q': A, (P |-- P') -> (Q |-- Q') -> P && Q |-- P' && Q'.
-Proof.
-intros.
-apply andp_right.
-apply andp_left1; apply H.
-apply andp_left2; apply H0.
-Qed.
-
-Lemma orp_derives {A} {NA: NatDed A}:
-  forall P Q P' Q': A, (P |-- P') -> (Q |-- Q') -> P || Q |-- P' || Q'.
-Proof.
-intros.
-apply orp_left.
-apply orp_right1; apply H.
-apply orp_right2; apply H0.
-Qed.
-
-Lemma orp_assoc {A} {NA: NatDed A} : forall P Q R : A,
-  (P || Q) || R = P || (Q || R).
-Proof.
-  intros; apply pred_ext;   repeat apply orp_left.
-  apply orp_right1; trivial.
-  apply orp_right2; apply orp_right1; trivial.
-  do 2 apply orp_right2; auto.
-  do 2 apply orp_right1; trivial.
-  apply orp_right1. apply orp_right2; trivial.
-  apply orp_right2; auto.
-Qed.
-
-Lemma exp_comm : forall {A} {NA: NatDed A} {B C} (P: B -> C -> A),
-  (EX x : B, EX y : C, P x y) = EX y : C, EX x : B, P x y.
-Proof.
-  intros; apply pred_ext; apply exp_left; intros x; apply exp_left; intros y;
-    apply exp_right with y; apply exp_right with x; auto.
-Qed.
-
-Class CCCviaNatDed (A: Type) (prod expo: A -> A -> A) {ND: NatDed A}: Prop :=
-  isCCC: CartesianClosedCat.CCC A derives eq prod expo.
-
-Lemma CCC_expo_derives: forall A prod expo {ND: NatDed A} {CCC: CCCviaNatDed A prod expo},
-  forall P P' Q Q', (P' |-- P) -> (Q |-- Q') -> expo P Q |-- expo P' Q'.
-Proof.
-  intros.
-  pose proof isCCC.
-  eapply CartesianClosedCat.expo_UMP; eauto.
-  apply derives_trans.
-Qed.
-
-Lemma CCC_exp_prod1:
-  forall A prod expo {ND : NatDed A} {CCC: CCCviaNatDed A prod expo} B (P: B -> A) Q,
-  prod (exp P) Q = exp (fun x => prod (P x) Q).
-Proof.
-  intros.
-  pose proof isCCC.
-  apply pred_ext.
-  + apply (proj2 (CartesianClosedCat.adjoint _ _ _ _ _ _)).
-    apply exp_left; intro x.
-    apply (proj1 (CartesianClosedCat.adjoint _ _ _ _ _ _)).
-    apply (exp_right x).
-    apply derives_refl.
-  + apply exp_left; intro x.
-    eapply CartesianClosedCat.prod_UMP; eauto.
-    apply (exp_right x).
-    apply derives_refl.
-Qed.
-
-Lemma CCC_exp_prod2:
-  forall A prod expo {ND : NatDed A} {CCC: CCCviaNatDed A prod expo} B P (Q: B -> A),
-  prod P (exp Q) = exp (fun x => prod P (Q x)).
-Proof.
-  intros.
-  rewrite CartesianClosedCat.comm by eauto.
-  erewrite CCC_exp_prod1 by eauto.
-  f_equal. extensionality x.
-  rewrite CartesianClosedCat.comm by eauto.
-  reflexivity.
-Qed.
-
-Lemma CCC_distrib_orp_prod:
-  forall A prod expo {ND : NatDed A} {CCC: CCCviaNatDed A prod expo} P Q R,
-    prod (orp P Q) R = orp (prod P R) (prod Q R).
-Proof.
-  intros.
-  pose proof isCCC.
-  apply pred_ext.
-  + apply (proj2 (CartesianClosedCat.adjoint _ _ _ _ _ _)).
-    apply orp_left.
-    - apply (proj1 (CartesianClosedCat.adjoint _ _ _ _ _ _)).
-      apply orp_right1, derives_refl.
-    - apply (proj1 (CartesianClosedCat.adjoint _ _ _ _ _ _)).
-      apply orp_right2, derives_refl.
-  + apply orp_left; eapply CartesianClosedCat.prod_UMP; eauto.
-    - apply orp_right1, derives_refl.
-    - apply orp_right2, derives_refl.
-Qed.
-
-Lemma CCC_FF_prod:
-  forall A prod expo {ND : NatDed A} {CCC: CCCviaNatDed A prod expo} P,
-    prod FF P = FF.
-Proof.
-  intros.
-  pose proof isCCC.
-  apply pred_ext.
-  + apply (proj2 (CartesianClosedCat.adjoint _ _ _ _ _ _)).
-    apply FF_left.
-  + apply FF_left.
-Qed.
-
-Lemma CCC_prod_FF:
-  forall A prod expo {ND : NatDed A} {CCC: CCCviaNatDed A prod expo} P,
-    prod P FF = FF.
-Proof.
-  intros.
-  pose proof isCCC.
-  rewrite CartesianClosedCat.comm by eauto.
-  eapply CCC_FF_prod; eauto.
-Qed.
-
-#[global] Instance andp_imp_CCC: forall A {ND : NatDed A}, CCCviaNatDed A andp imp.
-Proof.
-  intros.
-  constructor.
-  apply andp_comm.
-  apply andp_assoc.
-  apply imp_andp_adjoint.
-  intros; apply andp_derives; auto.
-Qed.
-
-#[global] Instance sepcon_wand_CCC: forall A {ND : NatDed A} {SL: SepLog A}, CCCviaNatDed A sepcon wand.
-Proof.
-  intros.
-  constructor.
-  apply sepcon_comm.
-  apply sepcon_assoc.
-  apply wand_sepcon_adjoint.
-  intros; apply sepcon_derives; auto.
-Qed.
-
-Lemma exp_unit: forall {A} `{NatDed A} (P: unit -> A),
-  exp P = P tt.
-Proof.
-  intros.
-  apply pred_ext.
-  + apply exp_left; intro x.
-    destruct x.
-    auto.
-  + apply (exp_right tt); auto.
-Qed.
-
-Lemma allp_unit: forall {A} `{NatDed A} (P: unit -> A),
-  allp P = P tt.
-Proof.
-  intros.
-  apply pred_ext.
-  + apply (allp_left _ tt); auto.
-  + apply allp_right; intro x.
-    destruct x.
-    auto.
-Qed.
-
-Lemma andp_is_allp {A}{ND: NatDed A}:
-   forall P Q, andp P Q = allp (fun x : bool => if x then P else Q).
-Proof.
- intros. apply pred_ext.
- apply allp_right. intro b; destruct b.
- apply andp_left1; apply derives_refl.
- apply andp_left2; apply derives_refl.
- apply andp_right.
- apply allp_left with true; apply derives_refl.
- apply allp_left with false; apply derives_refl.
-Qed.
-
-Lemma orp_is_exp {A}{ND: NatDed A}:
-   forall P Q, orp P Q = exp (fun x : bool => if x then P else Q).
-Proof.
- intros. apply pred_ext.
- apply orp_left.
- apply exp_right with true; apply derives_refl.
- apply exp_right with false; apply derives_refl.
- apply exp_left; intro b; destruct b.
- apply orp_right1; apply derives_refl.
- apply orp_right2; apply derives_refl.
-Qed.
-
-Lemma exp_prop: forall {B} {ND: NatDed B} A P, exp (fun x: A => prop (P x)) = prop (exists x: A, P x).
-Proof.
-  intros.
-  apply pred_ext.
-  + apply exp_left; intros x.
-    apply prop_left; intros.
-    apply prop_right; exists x; auto.
-  + apply prop_left; intros.
-    destruct H as [x ?].
-    apply (exp_right x).
-    apply prop_right; auto.
-Qed.
-
-Lemma modus_ponens {A}{ND: NatDed A}: forall P Q: A, derives (andp P (imp P Q)) Q.
-Proof.
-intros. apply derives_trans with (andp (imp P Q) P).
-  apply andp_right; [apply andp_left2 | apply andp_left1]; apply derives_refl.
- apply imp_andp_adjoint. apply derives_refl.
-Qed.
-
-Lemma modus_ponens_wand {A}{ND: NatDed A}{SL: SepLog A}:
-                      forall P Q: A, derives (sepcon P (wand P Q)) Q.
-Proof.
-intros.
-  rewrite sepcon_comm.  apply wand_sepcon_adjoint. auto.
-Qed.
-
-Lemma wand_sepcon_wand: forall {A} {NA: NatDed A} {SA: SepLog A} (P1 P2 Q1 Q2: A),
-  (P1 -* Q1) * (P2 -* Q2) |-- P1 * P2 -* Q1 * Q2.
-Proof.
-  intros.
-  rewrite <- wand_sepcon_adjoint.
-  rewrite (sepcon_comm P1), <- !sepcon_assoc, (sepcon_comm _ P1), (sepcon_assoc _ _ P2), <- (sepcon_assoc P1), (sepcon_comm _ P2).
-  apply sepcon_derives; apply modus_ponens_wand.
-Qed.
-
-Lemma sepcon_FF {A}{ND: NatDed A}{SL: SepLog A} :
-           forall P: A, sepcon P FF = FF.
-Proof.
-  intros.
-  eapply CCC_prod_FF.
-  apply sepcon_wand_CCC.
-Qed.
-
-Lemma FF_sepcon {A} {NA: NatDed A}{SA: SepLog A}: forall P: A, FF * P = FF.
-Proof.
-  intros.
-  eapply CCC_FF_prod.
-  apply sepcon_wand_CCC.
-Qed.
-
-#[export] Hint Rewrite @FF_sepcon @sepcon_FF : norm.
-
-Lemma FF_andp {A}{NA: NatDed A}:  forall P: A, FF && P = FF.
-Proof.
-  intros.
-  eapply CCC_FF_prod.
-  apply andp_imp_CCC.
-Qed.
-
-Lemma andp_FF {A}{NA: NatDed A}:  forall P: A, P && FF = FF.
-Proof.
-  intros.
-  eapply CCC_prod_FF.
-  apply andp_imp_CCC.
-Qed.
-#[export] Hint Rewrite @FF_andp @andp_FF : norm.
-
-Lemma FF_orp: forall {A: Type} `{NatDed A} (P: A), FF || P = P.
-Proof.
-  intros.
-  apply pred_ext.
-  + apply orp_left.
-    apply FF_left.
-    apply derives_refl.
-  + apply orp_right2.
-    apply derives_refl.
-Qed.
-
-Lemma orp_FF {A}{NA: NatDed A}:
-  forall Q, Q || FF = Q.
-Proof.
-  intros.
-  rewrite orp_comm.
-  apply FF_orp.
-Qed.
-
-Lemma orp_TT {A}{NA: NatDed A}:
- forall Q, Q || TT = TT.
-Proof.
-  intros. apply pred_ext.
-  + apply orp_left; apply TT_right.
-  + apply orp_right2; auto.
-Qed.
-
-Lemma TT_orp {A}{NA: NatDed A}:
- forall Q, TT || Q = TT.
-Proof.
-  intros. apply pred_ext.
-  + apply orp_left; apply TT_right.
-  + apply orp_right1; auto.
-Qed.
-
-Lemma allp_forall: forall {A B: Type} `{NatDed A} P Q (x:B), (forall x:B, (P x = Q)) -> (allp P = Q).
-Proof.
-  intros.
-  apply pred_ext.
-  + apply (allp_left _ x).
-    rewrite H0.
-    apply derives_refl.
-  + apply allp_right.
-    intros.
-    rewrite H0.
-    apply derives_refl.
-Qed.
-
-Lemma allp_derives:
-       forall {A: Type}  {NA: NatDed A} (B: Type) (P Q: B -> A),
-               (forall x:B, P x |-- Q x) -> (allp P |-- allp Q).
-Proof.
-intros.
-apply allp_right; intro x; apply allp_left with x; auto.
-Qed.
-
-Lemma allp_congr:
-       forall {A: Type}  {NA: NatDed A} (B: Type) (P Q: B -> A),
-               (forall x:B, P x = Q x) -> (allp P = allp Q).
-Proof.
-intros.
-apply pred_ext; apply allp_derives; intros; rewrite H; auto.
-Qed.
-
-Lemma allp_uncurry: forall {A} `{NatDed A} (S T: Type) (P: S -> T -> A),
-  allp (allp P) = allp (fun st => P (fst st) (snd st)).
-Proof.
-  intros.
-  apply pred_ext.
-  + apply allp_right; intros [s t].
-    simpl.
-    apply (allp_left _ t).
-    apply (allp_left _ s).
-    apply derives_refl.
-  + apply allp_right; intro t.
-    simpl.
-    apply allp_right; intro s.
-    apply (allp_left _ (s, t)).
-    apply derives_refl.
-Qed.
-
-Lemma allp_depended_uncurry': forall {A} `{NatDed A} {S: Type} {T: S -> Type} (P: forall s: S, T s -> A),
-  ALL s: S, (ALL t: T s, P s t) = ALL st: sigT T, P (projT1 st) (projT2 st).
-Proof.
-  intros.
-  apply pred_ext.
-  + apply allp_right; intros [s t].
-    simpl.
-    apply (allp_left _ s).
-    apply (allp_left _ t).
-    apply derives_refl.
-  + apply allp_right; intro s.
-    simpl.
-    apply allp_right; intro t.
-    apply (allp_left _ (existT T s t)).
-    apply derives_refl.
-Qed.
-
-Lemma allp_uncurry': forall {A} `{NatDed A} (S T: Type) (P: S -> T -> A),
-  ALL s: S, (ALL t: T, P s t) = ALL st: prod S T, P (fst st) (snd st).
-Proof.
-  intros.
-  pose proof (@allp_depended_uncurry' A H S (fun _ => T) P).
-  simpl in H0.
-  rewrite H0.
-  apply pred_ext; apply allp_right; intro st; destruct st as [s t].
-  + apply (allp_left _ (existT (fun _ => T) s t)).
-    apply derives_refl.
-  + apply (allp_left _ (s, t)).
-    apply derives_refl.
-Qed.
-
-Lemma allp_curry: forall {A} `{NatDed A} (S T: Type) (P: S * T -> A),
-  allp P = allp (fun s => allp (fun t => P (s, t))).
-Proof.
-  intros.
-  apply pred_ext.
-  + apply allp_right; intro s.
-    apply allp_right; intro t.
-    apply (allp_left _ (s, t)).
-    apply derives_refl.
-  + apply allp_right; intros [s t].
-    apply (allp_left _ s).
-    apply (allp_left _ t).
-    apply derives_refl.
-Qed.
-
-Lemma exp_derives {A}{NA: NatDed A}{B}:
-   forall F G: B -> A, (forall x, F x |-- G x) -> exp F |-- exp G.
-Proof.
-intros.
-apply exp_left; intro x. apply exp_right with x; auto.
-Qed.
-
-Lemma exp_congr:
- forall A NA T X Y,
-    (forall v, X v = Y v) -> @exp A NA T X = @exp A NA T Y.
-Proof.
-intros. f_equal. extensionality v; auto.
-Qed.
-
-Lemma exp_uncurry:
-  forall {T} {ND: NatDed T} A B F, (@exp T ND A (fun a => @exp T ND B (fun b => F a b)))
-   = @exp T ND (A*B) (fun ab => F (fst ab) (snd ab)).
-Proof.
-intros.
-apply pred_ext.
-apply exp_left; intro a. apply exp_left; intro b. apply exp_right with (a,b).
-apply derives_refl.
-apply exp_left; intro ab. apply exp_right with (fst ab). apply exp_right with (snd ab).
-apply derives_refl.
-Qed.
-
-Lemma exp_trivial {A}{NA: NatDed A}:
-  forall {T: Type} (any: T) (P: A), exp (fun x:T => P) = P.
-Proof.
- intros. apply pred_ext. apply exp_left; auto.
- apply exp_right with any; auto.
-Qed.
-
-Lemma allp_andp: forall {A B: Type} `{NatDed A} (P Q: B -> A), allp (P && Q) = allp P && allp Q.
-Proof.
-  intros.
-  apply pred_ext.
-  + apply andp_right; apply allp_derives; intros;
-    simpl; [apply andp_left1|apply andp_left2]; apply derives_refl.
-  + apply allp_right; intros.
-    simpl; apply andp_right; [apply andp_left1|apply andp_left2];
-    apply (allp_left _ v); apply derives_refl.
-Qed.
-
-Lemma distrib_andp_orp: forall {A : Type} {ND : NatDed A} (P Q R : A),
-  (P && Q) || R = (P || R) && (Q || R).
-Proof.
-  intros.
-  apply pred_ext.
-  + apply orp_left.
-    - apply andp_right; apply orp_right1; solve_andp.
-    - apply andp_right; apply orp_right2, derives_refl.
-  + rewrite imp_andp_adjoint.
-    apply orp_left.
-    - rewrite <- imp_andp_adjoint.
-      rewrite andp_comm.
-      rewrite imp_andp_adjoint.
-      apply orp_left.
-      * rewrite <- imp_andp_adjoint.
-        rewrite andp_comm.
-        apply orp_right1, derives_refl.
-      * rewrite <- imp_andp_adjoint.
-        apply orp_right2; solve_andp.
-    - rewrite <- imp_andp_adjoint.
-      apply orp_right2; solve_andp.
-Qed.
-
-Lemma prop_derives {A}{ND: NatDed A}:
- forall (P Q: Prop), (P -> Q) -> prop P |-- prop Q.
-Proof.
-intros; apply prop_left; intro; apply prop_right; auto.
-Qed.
-
-Lemma ND_prop_ext {A}{ND: NatDed A}: forall P Q, (P <-> Q) -> !! P = !! Q.
-Proof.
-  intros.
-  apply pred_ext; apply prop_derives; tauto.
-Qed.
-
-Lemma prop_True_right {A}{NA: NatDed A}: forall P:A, P |-- !! True.
-Proof. intros; apply prop_right; auto.
-Qed.
-
-Lemma derives_refl' {A}{NA: NatDed A}: forall P Q: A, P=Q -> P |-- Q.
-Proof.  intros; subst; apply derives_refl. Qed.
-
-Lemma derives_refl'' {A}{NA: NatDed A}: forall P Q: A, Q=P -> P |-- Q.
-Proof.  intros; subst; apply derives_refl. Qed.
-
-Lemma wand_derives {A}{ND: NatDed A}{SL: SepLog A}:
-    forall P P' Q Q': A , (P' |-- P) -> (Q |-- Q') ->  P -* Q |-- P' -* Q'.
-Proof.
-  eapply CCC_expo_derives.
-  apply sepcon_wand_CCC.
-Qed.
-
-Lemma distrib_orp_andp {A}{ND: NatDed A}:
-   forall (P Q R : A), andp (orp P Q) R = orp (andp P R) (andp Q R).
-Proof.
-  intros.
-  eapply CCC_distrib_orp_prod.
-  apply andp_imp_CCC.
-Qed.
-
-Lemma exp_andp1 {A}{ND: NatDed A}:  forall B (p: B -> A) q, andp (exp p) q = (exp (fun x => andp (p x) q)).
-Proof.
-  eapply CCC_exp_prod1.
-  apply andp_imp_CCC.
-Qed.
-
-Lemma exp_sepcon1 {A}{ND: NatDed A} {SL: SepLog A}:
-  forall T (P: T ->  A) Q, sepcon (exp P) Q = exp (fun x => sepcon (P x) Q).
-Proof.
-  eapply CCC_exp_prod1.
-  apply sepcon_wand_CCC.
-Qed.
-
-Lemma distrib_orp_sepcon {A}{ND: NatDed A}{SL: SepLog A}:
-      forall (P Q R : A), sepcon (P || Q) R = sepcon P R || sepcon Q R.
-Proof.
-  intros.
-  eapply CCC_distrib_orp_prod.
-  apply sepcon_wand_CCC.
-Qed.
-
-Lemma distrib_orp_sepcon2 {A}{ND: NatDed A}{SL: SepLog A}:
-  forall P Q R: A,
-     R * (P || Q) = R * P || R * Q.
-Proof.
-intros. rewrite !(sepcon_comm R). apply distrib_orp_sepcon.
-Qed.
-
-Lemma exp_sepcon2 {A}{NA: NatDed A}{SA: SepLog A}:
-  forall T (P: A) (Q: T -> A),  P * exp Q = exp (fun x => P * Q x).
-Proof.
-  intros.
-  eapply CCC_exp_prod2.
-  apply sepcon_wand_CCC.
-Qed.
-
-Lemma allp_sepcon1 {A}{ND: NatDed A} {SL: SepLog A}:
-  forall T (P: T ->  A) Q, sepcon (allp P) Q |-- allp (fun x => sepcon (P x) Q).
-Proof.
-intros.
-apply allp_right; intro x.
-apply sepcon_derives; auto.
-apply allp_left with x. auto.
-Qed.
-
-Lemma allp_sepcon2 {A}{ND: NatDed A} {SL: SepLog A}:
-  forall T P (Q: T ->  A), sepcon P (allp Q) |-- allp (fun x => sepcon P (Q x)).
-Proof.
-intros.
-apply allp_right; intro x.
-apply sepcon_derives; auto.
-apply allp_left with x. auto.
-Qed.
-
-Lemma exp_andp2  {A}{NA: NatDed A}:
-  forall B (p: A) (q: B -> A) , (p && exp q) = exp (fun x => p && q x).
-Proof.
-  intros.
-  eapply CCC_exp_prod2.
-  apply andp_imp_CCC.
-Qed.
-
-Lemma imp_derives {A} {NA: NatDed A}:
-  forall P P' Q Q' : A,
-    (P' |-- P) ->
-    (Q |-- Q') ->
-    P --> Q |-- P' --> Q'.
-Proof.
-  intros.
-  eapply CCC_expo_derives; auto.
-  apply andp_imp_CCC.
-Qed.
-
-Lemma imp_right2: forall {A} {NA: NatDed A} (P Q : A), P |-- Q --> P.
-Proof.
-  intros.
-  apply imp_andp_adjoint.
-  apply andp_left1.
-  auto.
-Qed.
-
-Lemma  distrib_sepcon_andp {A}{ND: NatDed A}{SL: SepLog A}:
-     forall P Q R, sepcon P (andp Q R) |-- andp (sepcon P Q) (sepcon P R).
-Proof.
-  intros.
-  apply andp_right.
-  apply sepcon_derives; [ apply derives_refl | ].
-  apply andp_left1; apply derives_refl.
-  apply sepcon_derives; [ apply derives_refl | ].
-  apply andp_left2; apply derives_refl.
-Qed.
-
-Lemma later_derives {A}{ND: NatDed A}{IA: Indir A}:
-   forall P Q: A, (P |-- Q) -> later P |-- later Q.
-Proof.
-  intros.
-  apply derives_trans with (TT && later P).
- apply andp_right. apply prop_right; auto. apply derives_refl.
-  apply imp_andp_adjoint.
-  eapply derives_trans; [ | apply later_K].
-  eapply derives_trans; [ | apply now_later].
- apply imp_andp_adjoint.
- apply andp_left2; auto.
-Qed.
-
-Lemma later_andp  {A}{ND: NatDed A}{IA: Indir A}:
-       forall P Q: A, later (P && Q) = later P && later Q.
-Proof.
- intros. repeat rewrite andp_is_allp.
- rewrite later_allp.
- f_equal. extensionality x.
- destruct x; auto.
-Qed.
-
-Lemma later_orp  {A}{ND: NatDed A}{IA: Indir A}:
-       forall P Q: A, later (P || Q) = later P || later Q.
-Proof.
- intros. repeat rewrite orp_is_exp.
- repeat rewrite (later_exp' _ true).
- f_equal. extensionality x.
- destruct x; auto.
-Qed.
-
-Lemma later_left2 {T}{ND: NatDed T}{IT: Indir T}:
- forall A B C : T, (A && B |-- C) -> A && |> B |-- |>C.
-Proof.
-intros.
-apply derives_trans with (|> (A && B)).
-rewrite later_andp.
-apply andp_derives; auto.
-apply now_later.
-apply later_derives; assumption.
-Qed.
-
-Lemma andp_dup {A}{ND: NatDed A}: forall P: A, P && P = P.
-Proof. intros. apply pred_ext.
-apply andp_left1; apply derives_refl.
-apply andp_right; apply derives_refl.
-Qed.
-
-Lemma andp_TT {A}{NA: NatDed A}: forall (P: A), P && TT = P.
-Proof with norm.
-intros.
-apply pred_ext.
-apply andp_left1...
-apply andp_right...
-Qed.
-
-Lemma TT_prop_right {A}{ND: NatDed A}: forall P: Prop,
-   P -> @derives A ND TT (prop P).
-Proof.
-intros. apply prop_right; auto.
-Qed.
-
-Lemma sepcon_andp_prop'  {A}{NA: NatDed A}{SA: SepLog A}:
-     forall (P:A)  (Q:Prop) (R: A), (!!Q && P)*R = !!Q&&(P*R).
-Proof with norm.
-intros.
-rewrite sepcon_comm. rewrite sepcon_andp_prop.
-rewrite sepcon_comm; auto.
-Qed.
-
-Lemma emp_sepcon  {A}{NA: NatDed A}{SA: SepLog A}{CA: ClassicalSep A} : forall (P:A),
-   emp * P = P.
-Proof with norm.
- intros; rewrite sepcon_comm. apply sepcon_emp.
-Qed.
-
-Lemma emp_wand {A}{NA: NatDed A}{SA: SepLog A}{CA: ClassicalSep A}:
-   forall P: A, emp -* P = P.
-Proof.
-intros.
-apply pred_ext.
-rewrite <- (emp_sepcon (emp -* P)).
-apply modus_ponens_wand.
-apply wand_sepcon_adjoint.
-rewrite sepcon_emp; auto.
-Qed.
-
-Lemma wand_eq  {A}{NA: NatDed A}{SA: SepLog A}:
-   forall P Q R, P = Q * R -> P = Q * (Q -* P).
-Proof.
-  intros.
-  apply seplog.pred_ext, modus_ponens_wand.
-  subst. apply sepcon_derives. auto.
-  rewrite <- wand_sepcon_adjoint; auto.
-  rewrite sepcon_comm; auto.
-Qed.
-
-Lemma wand_twice {A}{NA: NatDed A}{SA: SepLog A}:
-   forall P Q R, P -* Q -* R = P * Q -* R.
-Proof.
-  intros; apply seplog.pred_ext.
-  - rewrite <- wand_sepcon_adjoint.
-    rewrite <- sepcon_assoc, wand_sepcon_adjoint.
-    rewrite sepcon_comm; apply modus_ponens_wand.
-  - rewrite <- !wand_sepcon_adjoint.
-    rewrite sepcon_assoc, sepcon_comm; apply modus_ponens_wand.
-Qed.
-
-Lemma wand_frame {A}{NA: NatDed A}{SA: SepLog A}:
-   forall P Q R, P -* Q |-- P * R -* Q * R.
-Proof.
-  intros.
-  rewrite <- wand_sepcon_adjoint.
-  rewrite <- sepcon_assoc. apply sepcon_derives; auto.
-  rewrite sepcon_comm; apply modus_ponens_wand.
-Qed.
-
-Lemma TT_andp {A}{NA: NatDed A}: forall P: A,  TT && P = P.
-Proof with norm.
-  intros. apply pred_ext. apply andp_left2... apply andp_right...
-Qed.
-
-Lemma prop_true_andp {A} {NA: NatDed A}:
-  forall (P: Prop) (Q: A),  P -> (!! P && Q = Q).
-Proof with norm.
-intros.
-apply pred_ext. apply andp_left2...
-apply andp_right... apply prop_right...
-Qed.
-
-Lemma prop_true_andp' (P: Prop) {A} {NA: NatDed A}:
-  forall (Q: A),  P -> (!! P && Q = Q).
-Proof.
-intros.
-apply pred_ext. apply andp_left2, derives_refl.
-apply andp_right. apply prop_right; auto. apply derives_refl.
-Qed.
-
-Lemma TT_andp_right {A}{NA: NatDed A}:
- forall P Q, (TT |-- P) -> (TT |-- Q) -> TT |-- P && Q.
-Proof.
-  intros. apply andp_right; auto.
-Qed.
-
-Ltac immediate := (assumption || reflexivity).
-
-#[export] Hint Rewrite @prop_true_andp using (solve [immediate]) : norm.
-
-Lemma true_eq {A} {NA: NatDed A}:  forall P: Prop, P -> (!! P) = (TT: A).
-Proof with norm.
-intros. apply pred_ext...
-apply prop_right...
-Qed.
-#[export] Hint Rewrite @true_eq using (solve [immediate]) : norm.
-
-#[export] Hint Rewrite @andp_dup : norm.
-
-Lemma sepcon_TT {A} {NA: NatDed A}{SA: SepLog A}{CA: ClassicalSep A}:
-   forall (P: A), P |-- (P * TT).
-Proof with norm.
-intros.
-apply @derives_trans with (P * emp).
-rewrite sepcon_emp...
-apply sepcon_derives...
-Qed.
-#[export] Hint Resolve sepcon_TT : core.
-
-Lemma TT_sepcon {A} {NA: NatDed A}{SA: SepLog A}{CA: ClassicalSep A}:
-   forall (P: A), P |-- (TT * P).
-Proof. intros. rewrite sepcon_comm; apply sepcon_TT.
-Qed.
-
-Lemma imp_extract_exp_left {B A: Type} {NA: NatDed A}:
-    forall    (p : B -> A) (q: A),
-  (forall x, p x |-- q) ->
-   exp p |-- q.
-Proof.
-intros.
-apply exp_left. auto.
-Qed.
-
-#[export] Hint Rewrite @sepcon_emp @emp_sepcon @TT_andp @andp_TT
-             @exp_sepcon1 @exp_sepcon2
-               @exp_andp1 @exp_andp2
-         @sepcon_andp_prop @sepcon_andp_prop'
-     using (solve [auto with typeclass_instances])
-        : norm.
-
-Lemma forall_pred_ext  {A}  {NA: NatDed A}: forall B (P Q: B -> A),
- (ALL x : B, (P x <--> Q x)) |-- (ALL x : B, P x) <--> (ALL x: B, Q x) .
-Proof.
-intros.
-apply andp_right.
- apply @derives_trans with (ALL x:B, P x --> Q x).
- apply allp_derives; intro x; apply andp_left1; auto.
- apply imp_andp_adjoint; apply allp_right; intro x.
- apply @derives_trans with ((P x --> Q x) && P x).
- apply andp_derives; apply allp_left with x; auto.
- rewrite andp_comm. apply modus_ponens.
- apply @derives_trans with (ALL x:B, Q x --> P x).
- apply allp_derives; intro x; apply andp_left2; auto.
- apply imp_andp_adjoint; apply allp_right; intro x.
- apply @derives_trans with ((Q x --> P x) && Q x).
- apply andp_derives; apply allp_left with x; auto.
- rewrite andp_comm. apply modus_ponens.
-Qed.
-
-Lemma exists_pred_ext  {A} {NA: NatDed A}: forall B (P Q: B -> A),
- (ALL x : B, (P x <--> Q x)) |-- (EX x : B, P x) <--> (EX x: B, Q x) .
-Proof.
-intros.
-apply andp_right.
- apply imp_andp_adjoint.
-autorewrite with norm.
-apply exp_left; intro x. apply exp_right with x.
- apply imp_andp_adjoint.
-apply allp_left with x. apply andp_left1; auto.
- apply imp_andp_adjoint.
-autorewrite with norm.
-apply exp_left; intro x. apply exp_right with x.
- apply imp_andp_adjoint.
-apply allp_left with x. apply andp_left2; auto.
-Qed.
-
-Lemma imp_pred_ext  {A}  {NA: NatDed A}: forall B B' P Q,
-       (B <--> B') && (B --> (P <--> Q))
- |-- (B --> P) <-->  (B' --> Q).
-Proof.
-intros.
-apply andp_right.
-apply -> imp_andp_adjoint.
-apply -> imp_andp_adjoint.
-rewrite andp_comm.
-rewrite (andp_comm (B --> B')).
-repeat rewrite <- andp_assoc.
-do 2 rewrite andp_assoc.
-eapply derives_trans; [eapply andp_derives; [apply modus_ponens | apply derives_refl] | ].
-apply @derives_trans with ((B && (B --> (P --> Q))) && (B && (B --> P))).
-repeat apply andp_right.
-apply andp_left1; auto.
-apply andp_left2. apply andp_left2. apply andp_left1. apply imp_derives; auto.
-apply andp_left1; auto.
-apply andp_left1; auto.
-apply andp_left2. apply andp_left2. apply andp_left2. auto.
-apply @derives_trans with ((P --> Q) && P).
-apply andp_derives; apply modus_ponens.
-rewrite andp_comm; apply modus_ponens.
-apply -> imp_andp_adjoint.
-apply -> imp_andp_adjoint.
-rewrite andp_comm.
-repeat rewrite <- andp_assoc.
-do 2 rewrite andp_assoc.
-eapply derives_trans; [eapply andp_derives; [apply modus_ponens | apply derives_refl] | ].
-apply @derives_trans with ((B' && (B' --> (Q --> P))) && (B' && (B' --> Q))).
-repeat apply andp_right.
-apply andp_left1; auto.
-repeat rewrite <- andp_assoc.
-apply andp_left1.
-apply -> imp_andp_adjoint.
-apply andp_left1.
-eapply derives_trans; [eapply andp_derives; [apply modus_ponens | apply derives_refl] | ].
-eapply derives_trans; [apply modus_ponens | ].
-apply andp_left2; auto.
-apply andp_left1; auto.
-repeat apply andp_left2. auto.
-eapply derives_trans; [eapply andp_derives; apply modus_ponens | ].
-rewrite andp_comm; apply modus_ponens.
-Qed.
-
-Lemma pull_right {A} {NA: NatDed A}{SA: SepLog A}:
- forall P Q R : A,
-   (Q * P * R) = (Q * R * P).
-Proof.
-intros. repeat rewrite sepcon_assoc. rewrite (sepcon_comm P); auto.
-Qed.
-
-Lemma pull_right0 {A} {NA: NatDed A}{SA: SepLog A}:
-  forall P Q : A,   (P * Q) = (Q * P).
-Proof.
-intros. rewrite (sepcon_comm P); auto.
-Qed.
-
-Ltac pull_left A := repeat (rewrite <- (pull_right A) || rewrite <- (pull_right0 A)).
-
-Ltac pull_right A := repeat (rewrite (pull_right A) || rewrite (pull_right0 A)).
-
-Lemma derives_extract_prop {A} {NA: NatDed A}:
-  forall (P: Prop) (Q R: A), (P -> Q |-- R) ->  !!P && Q |-- R.
-Proof.
- intros.
- apply imp_andp_adjoint.
- apply prop_left.
- intros. apply imp_andp_adjoint. rewrite TT_andp. apply H; auto.
-Qed.
-
-Lemma derives_extract_prop0 {A}{NA: NatDed A}:
-    forall (P: Prop) (R: A), (P -> TT |-- R)  -> !!P |-- R.
-Proof.
-intros.
-apply derives_trans with (!!P && TT).
-rewrite andp_TT; auto.
-apply derives_extract_prop; auto.
-Qed.
-
-Lemma derives_extract_prop' {A} {NA: NatDed A}:
-  forall (P: Prop) (Q R: A), (P -> Q |-- R) ->  Q && !!P|-- R.
-Proof.
-intros. rewrite andp_comm. apply derives_extract_prop; auto.
-Qed.
-
-Lemma prop_imp {A} {ND: NatDed A}: forall (P: Prop) (Q: A), P -> !! P --> Q = Q.
-Proof.
-  intros.
-  apply pred_ext.
-  + eapply derives_trans; [| apply modus_ponens].
-    apply andp_right; [| apply derives_refl].
-    apply prop_right; auto.
-  + apply imp_andp_adjoint.
-    apply derives_extract_prop'.
-    intros; auto.
-Qed.
-
-Lemma andp_assoc' {A}{NA: NatDed A}:
-  forall P Q R : A, Q && (P && R) = P && (Q && R).
-Proof. intros. rewrite andp_comm. rewrite andp_assoc. f_equal. apply andp_comm.
-Qed.
-
-Lemma corable_andp_sepcon2{A}{NA: NatDed A}{SA: SepLog A}{CA: CorableSepLog A}:
-   forall P Q R : A, corable P ->  (Q && P) * R = P && (Q * R).
-Proof.
-intros. rewrite andp_comm. apply corable_andp_sepcon1. auto.
-Qed.
-
-Lemma corable_sepcon_andp1 {A}{NA: NatDed A}{SA: SepLog A}{CA: CorableSepLog A}:
-   forall P Q R : A, corable P ->  Q  * (P && R) = P && (Q * R).
-Proof.
-intros. rewrite sepcon_comm. rewrite corable_andp_sepcon1; auto. rewrite sepcon_comm; auto.
-Qed.
-
-Lemma corable_sepcon_andp2 {A}{NA: NatDed A}{SA: SepLog A}{CA: CorableSepLog A}:
-   forall P Q R : A, corable P ->  Q  * (R && P) = P && (Q * R).
-Proof.
-intros. rewrite sepcon_comm. rewrite andp_comm. rewrite corable_andp_sepcon1; auto. rewrite sepcon_comm; auto.
-Qed.
-
-#[export] Hint Resolve corable_andp corable_orp corable_allp corable_exp
-                    corable_imp corable_prop corable_sepcon corable_wand corable_later : core.
-#[export] Hint Resolve corable_prop : norm.
-
-(* The followings are not in auto-rewrite lib. *)
-
-Lemma sepcon_left_corable: forall {A}{NA: NatDed A}{SA: SepLog A}{CA: CorableSepLog A} (P Q: A), corable P -> (P * Q = (P && Q) * TT).
-Proof.
-  intros.
-  pattern P at 1.
-  rewrite <- (andp_TT P).
-  rewrite !corable_andp_sepcon1 by auto.
-  rewrite sepcon_comm.
-  reflexivity.
-Qed.
-
-Lemma andp_left_corable: forall {A}{NA: NatDed A}{SA: SepLog A}{ClA: ClassicalSep A}{CA: CorableSepLog A} (P Q: A), corable P -> P && Q = (P && emp) * Q.
-Proof.
-  intros.
-  pattern P at 1.
-  rewrite corable_andp_sepcon1 by auto.
-  rewrite sepcon_comm, sepcon_emp.
-  reflexivity.
-Qed.
-
-Lemma TT_sepcon_TT: forall {A} `{ClassicalSep A}, TT * TT = TT.
-Proof.
-  intros.
-  apply pred_ext.
-  + apply prop_right; auto.
-  + apply sepcon_TT.
-Qed.
-
-Lemma not_prop_right: forall {A} {NA: NatDed A} (P: A) (Q: Prop), (Q -> derives P FF) -> derives P (prop (not Q)).
-Proof.
-  intros.
-  eapply derives_trans; [| apply prop_imp_prop_left].
-  apply imp_andp_adjoint.
-  apply derives_extract_prop'; auto.
-Qed.
-
-Lemma prop_and {A} {NA: NatDed A}:
-    forall P Q: Prop, prop (P /\ Q) = (prop P && prop Q).
-Proof.
-  intros. apply pred_ext.
-  + apply prop_left. intros [? ?].
-    apply andp_right; apply prop_right; auto.
-  + apply derives_extract_prop; intros.
-    apply prop_left; intros.
-    apply prop_right; auto.
-Qed.
-
-Lemma prop_impl {A} {NA: NatDed A}:
-  forall P Q: Prop, prop (P -> Q) = (prop P --> prop Q).
-Proof.
-  intros.
-  apply pred_ext.
-  + apply imp_andp_adjoint.
-    apply derives_extract_prop'; intros.
-    apply prop_derives.
-    auto.
-  + apply prop_imp_prop_left.
-Qed.
-
-Lemma prop_forall {A B} {NA: NatDed A}:
-  forall P: B -> Prop, prop (forall b, P b) = ALL b: B, !! P b.
-Proof.
-  intros.
-  apply pred_ext.
-  + apply allp_right; intros.
-    apply prop_derives; auto.
-  + apply allp_prop_left.
-Qed.
-
-Lemma sepcon_prop_prop:
-  forall {A} `{ClassicalSep A} P Q, !! P * !! Q = !! (P /\ Q).
-Proof.
-  intros.
-  rewrite <- (andp_TT (!! Q)) at 1.
-  rewrite sepcon_andp_prop.
-  rewrite <- (andp_TT (!! P)) at 1.
-  rewrite sepcon_comm.
-  rewrite sepcon_andp_prop.
-  rewrite TT_sepcon_TT.
-  rewrite andp_TT.
-  rewrite andp_comm.
-  rewrite prop_and.
-  reflexivity.
-Qed.
-
-Lemma corable_sepcon_TT: forall {A}{NA: NatDed A}{SA: SepLog A}{ClA: ClassicalSep A}{CA: CorableSepLog A} (P : A), corable P -> P * TT = P.
-Proof.
-  intros.
-  rewrite <- (andp_TT P).
-  rewrite corable_andp_sepcon1 by auto.
-  rewrite TT_sepcon_TT.
-  reflexivity.
-Qed.
-
-Lemma derives_left_sepcon_right_corable: forall {A}{NA: NatDed A}{SA: SepLog A}{ClA: ClassicalSep A}{CA: CorableSepLog A} (P Q R: A), corable P -> (Q |-- P) -> Q * R |-- P.
-Proof.
-  intros.
-  rewrite <- corable_sepcon_TT by auto.
-  apply sepcon_derives; auto.
-  apply TT_right.
-Qed.
-
-Lemma later_prop_andp_sepcon: forall {A: Type} {A}{NA: NatDed A}{SA: SepLog A}{ClA: ClassicalSep A}{IA: Indir A}{CSL: CorableSepLog A} {CI: CorableIndir A} (P: Prop) (Q R: A),
-((|> !! P) && Q) * R = (|> !! P) && (Q * R).
-Proof.
-  intros.
-  apply corable_andp_sepcon1.
-  apply corable_later.
-  apply corable_prop.
-Qed.
-
-Lemma sepcon_corable_corable:
-  forall {A} `{CorableSepLog A} {ClS: ClassicalSep A} P Q, corable P -> corable Q -> P * Q = P && Q.
-Proof.
-  intros.
-  apply pred_ext.
-  + apply andp_right.
-    - rewrite <- (andp_TT P) at 1.
-      rewrite corable_andp_sepcon1 by auto.
-      apply andp_left1; auto.
-    - rewrite <- (andp_TT Q) at 1.
-      rewrite corable_sepcon_andp1 by auto.
-      apply andp_left1; auto.
-  + rewrite andp_left_corable by auto.
-    apply sepcon_derives; auto.
-    apply andp_left1; auto.
-Qed.
-
-Lemma prop_false_andp {A}{NA :NatDed A}:
- forall P Q, ~P -> !! P && Q = FF.
-Proof.
-intros.
-apply pred_ext.
-+ apply derives_extract_prop; tauto.
-+ apply FF_left.
-Qed.
-
-Lemma andp_prop_derives: forall {A} {NA: NatDed A} (P P': Prop) (Q Q': A),
-  (P <-> P') ->
-  (P -> Q |-- Q') ->
-  !! P && Q |-- !! P' && Q'.
-Proof.
-  intros.
-  apply derives_extract_prop.
-  intros.
-  apply andp_right; [apply prop_right; tauto | auto].
-Qed.
-
-Lemma andp_prop_ext:
- forall {A}{NA: NatDed A} (P P': Prop) (Q Q': A),
-  (P<->P') ->
-  (P -> (Q=Q')) ->
-  !! P && Q = !! P' && Q'.
-Proof.
-  intros.
-  apply pred_ext; apply andp_prop_derives.
-  + auto.
-  + intros.
-    rewrite H0 by auto; auto.
-  + tauto.
-  + intros.
-    rewrite H0 by tauto; auto.
-Qed.
-
-Lemma prop_and_same_derives {A}{NA: NatDed A}:
-  forall P Q, (Q |-- !! P)   ->   Q |-- !!P && Q.
-Proof.
-intros. apply andp_right; auto.
-Qed.
-
-Ltac normalize1 :=
-         match goal with
-            | |- _ => contradiction
-            | |- context [@andp ?A (@LiftNatDed ?T ?B ?C) ?D ?E ?F] =>
-                      change (@andp A (@LiftNatDed T B C) D E F) with (D F && E F)
-            | |- context [@later ?A  (@LiftNatDed ?T ?B ?C) (@LiftIndir ?X1 ?X2 ?X3 ?X4 ?X5) ?D ?F] =>
-                   change (@later A  (@LiftNatDed T B C) (@LiftIndir X1 X2 X3 X4 X5) D F)
-                     with (@later B C X5 (D F))
-            | |- context [@sepcon ?A (@LiftNatDed ?B ?C ?D)
-                                                         (@LiftSepLog ?E ?F ?G ?H) ?J ?K ?L] =>
-                   change (@sepcon A (@LiftNatDed B C D) (@LiftSepLog E F G H) J K L)
-                      with (@sepcon C D H (J L) (K L))
-            | |- context [(?P && ?Q) * ?R] => rewrite (corable_andp_sepcon1 P Q R) by (auto with norm)
-            | |- context [?Q * (?P && ?R)] => rewrite (corable_sepcon_andp1 P Q R) by (auto with norm)
-            | |- context [(?Q && ?P) * ?R] => rewrite (corable_andp_sepcon2 P Q R) by (auto with norm)
-            | |- context [?Q * (?R && ?P)] => rewrite (corable_sepcon_andp2 P Q R) by (auto with norm)
-            (* In the next four rules, doing it this way (instead of leaving it to autorewrite)
-                preserves the name of the "y" variable *)
-            | |- context [andp (exp (fun y => _)) _] =>
-                autorewrite with norm; apply imp_extract_exp_left; intro y
-            | |- context [andp _ (exp (fun y => _))] =>
-                autorewrite with norm; apply imp_extract_exp_left; intro y
-            | |- context [sepcon (exp (fun y => _)) _] =>
-               autorewrite with norm; apply imp_extract_exp_left; intro y
-            | |- context [sepcon _ (exp (fun y => _))] =>
-                autorewrite with norm; apply imp_extract_exp_left; intro y
-
-           | |-  derives ?A   _ => match A with
-                          | context [ ((!! ?P) && ?Q) && ?R ] => rewrite (andp_assoc (!!P) Q R)
-                          | context [ ?Q && (!! ?P && ?R)] =>
-                                         match Q with !! _ => fail 2 | _ => rewrite (andp_assoc' (!!P) Q R) end
-                         end
-            | |- _ => progress  (autorewrite with norm); auto with typeclass_instances
-            | |- _ = ?x -> _ => intro; subst x
-            | |- ?x = _ -> _ => intro; subst x
-            |  |- ?ZZ -> _ => match type of ZZ with
-                                               | Prop =>
-                                                    let H := fresh in
-                                                       ((assert (H:ZZ) by auto; clear H; intros _) || intro H)
-                                               | _ => intros _
-                                              end
-            | |- forall _, _ => let x := fresh "x" in (intro x; normalize1; try generalize dependent x)
-            | |- exp _ |-- _ => apply imp_extract_exp_left
-            | |- !! _ |-- _ => apply derives_extract_prop0
-            | |- !! _ && _ |-- _ => apply derives_extract_prop
-            | |- _ && !! _ |-- _ => apply derives_extract_prop'
-            | |- _ |-- !! (?x = ?y) && _ =>
-                            (rewrite prop_true_andp with (P:= (x=y))
-                                            by (unfold y; reflexivity); unfold y in *; clear y) ||
-                            (rewrite prop_true_andp with (P:=(x=y))
-                                            by (unfold x; reflexivity); unfold x in *; clear x)
-            | |- TT |-- !! _ => apply TT_prop_right
-            | |- _ => solve [auto with typeclass_instances]
-            end.
-
-Ltac normalize1_in Hx :=
-             match type of Hx with
-                 | context [@andp ?A (@LiftNatDed ?T ?B ?C) ?D ?E ?F] =>
-                         change (@andp A (@LiftNatDed T B C) D E F) with (D F && E F)
-                 | context [@later ?A  (@LiftNatDed ?T ?B ?C) (@LiftIndir ?X1 ?X2 ?X3 ?X4 ?X5) ?D ?F] =>
-                    change (@later A  (@LiftNatDed T B C) (@LiftIndir X1 X2 X3 X4 X5) D F)
-                     with (@later B C X5 (D F))
-                 | context [@sepcon ?A (@LiftNatDed ?B ?C ?D)
-                                                         (@LiftSepLog ?E ?F ?G ?H) ?J ?K ?L] =>
-                   change (@sepcon A (@LiftNatDed B C D) (@LiftSepLog E F G H) J K L)
-                      with (@sepcon C D H (J L) (K L))
-                | context [ !! ?P ] =>
-                                    rewrite (true_eq P) in Hx by auto with typeclass_instances
-                | context [ !! ?P && ?Q ] =>
-                                    rewrite (prop_true_andp P Q) in Hx by auto with typeclass_instances
-                | context [(?P && ?Q) * ?R] => rewrite (corable_andp_sepcon1 P Q R) in Hx by (auto with norm)
-                | context [?Q * (?P && ?R)] => rewrite (corable_sepcon_andp1 P Q R) in Hx by (auto with norm)
-                | context [(?Q && ?P) * ?R] => rewrite (corable_andp_sepcon2 P Q R) in Hx by (auto with norm)
-                | context [?Q * (?R && ?P)] => rewrite (corable_sepcon_andp2 P Q R) in Hx by (auto with norm)
-                | _ => progress  (autorewrite with norm in Hx); auto with typeclass_instances
-                end.
-
-Ltac normalize := repeat (auto with norm; normalize1).
-
-Tactic Notation "normalize" "in" hyp(H) := repeat (normalize1_in H).
-
-Lemma guarded_sepcon_orp_distr {A}{ND: NatDed A}{SL: SepLog A}: forall (P1 P2: Prop) p1 p2 q1 q2,
-  (P1 -> P2 -> False) ->
-  (!! P1 && p1 || !! P2 && p2) * (!! P1 && q1 || !! P2 && q2) = !! P1 && (p1 * q1) || !! P2 && (p2 * q2).
-Proof.
-  intros.
-  rewrite distrib_orp_sepcon.
-  rewrite (sepcon_comm (!! P1 && p1)).
-  rewrite (sepcon_comm (!! P2 && p2)).
-  rewrite !distrib_orp_sepcon.
-  apply pred_ext.
-  + repeat apply orp_left; normalize.
-    - apply orp_right1.
-      rewrite sepcon_comm; auto.
-    - tauto.
-    - tauto.
-    - apply orp_right2.
-      rewrite sepcon_comm; auto.
-  + apply orp_left.
-    - apply orp_right1.
-      apply orp_right1.
-      normalize.
-      rewrite sepcon_comm; auto.
-    - apply orp_right2.
-      apply orp_right2.
-      normalize.
-      rewrite sepcon_comm; auto.
-Qed.
-
-Definition mark {A: Type} (i: nat) (j: A) := j.
-
-Lemma swap_mark1 {A} {NA: NatDed A}{SA: SepLog A}:
-  forall i j (Pi Pj B : A), (i<j)%nat -> B * mark i Pi * mark j Pj = B * mark j Pj * mark i Pi.
-Proof.
-intros.
-repeat rewrite sepcon_assoc.
-f_equal.
-apply sepcon_comm.
-Qed.
-
-Lemma swap_mark0 {A} {NA: NatDed A}{SA: SepLog A}:
-  forall i j (Pi Pj: A),  (i<j)%nat -> mark i Pi * mark j Pj = mark j Pj * mark i Pi.
-Proof.
-intros.
-apply sepcon_comm.
-Qed.
-
-Ltac select_left n :=
-  repeat match goal with
- | |- context [(_ * mark ?i _ * mark n _)] =>
-      rewrite (swap_mark1 i n); [ | solve [simpl; auto]]
- | |- context [(mark ?i _ * mark n _)] =>
-      rewrite (swap_mark0 i n); [ | solve [simpl; auto]]
-end.
-Ltac select_all n := match n with
-                                | O => idtac
-                                | S ?n' => select_left n; select_all n'
-                              end.
-Ltac markem n P :=
-   match P with
-   | (?Y * ?Z) =>
-        (match goal with H: mark _ Z = Z |- _ => idtac end
-        || assert (mark n Z = Z) by auto); markem (S n) Y
-   | ?Z =>  match goal with H: mark _ Z = Z |- _ => idtac end
-                || assert (mark n Z = Z) by auto
-  end.
-
-Ltac prove_assoc_commut :=
- clear;
- try (match goal with |- ?F _ -> ?G _ => replace G with F; auto end);
-  (repeat rewrite <- sepcon_assoc;
-   match goal with |- ?P = _ => markem O P end;
-   let LEFT := fresh "LEFT" in match goal with |- ?P = _ => set (LEFT := P) end;
-  match goal with H: mark ?n _ = _ |- _ =>
-     repeat  match goal with H: mark ?n _ = ?P |- _ => rewrite <- H; clear H end;
-     select_all n;
-     reflexivity
-   end).
-
-Lemma test_prove_assoc_commut {T}{NA: NatDed T}{SA: SepLog T} : forall A B C D E : T,
-   D * E * A * C * B = A * B * C * D * E.
-Proof.
-intros.
-prove_assoc_commut.
-Qed.
-
-(***** subtyping and contractiveness -- should split this into a separate file ******)
-Require Import VST.msl.alg_seplog.
-Import FashNotation.
-
-Lemma later_fash1 {A} {NA: NatDed A}{IA: Indir A}{RA: RecIndir A}:
-   forall P : A, |> # P |-- # |> P.
-Proof. intros. rewrite later_fash; auto.
-Qed.
-
-Lemma subp_later1 {A}  {NA: NatDed A}{IA: Indir A}{RA: RecIndir A} : forall P Q : A,
-   |>(P >=> Q)  |--   |>P >=> |>Q.
-Proof.
-intros.
-rewrite later_fash. apply fash_derives, later_K.
-Qed.
-
-(*Lemma subp_later {A}  {NA: NatDed A}{IA: Indir A}{RA: RecIndir A} : forall P Q : A,
-   |>(P >=> Q) = |>P >=> |>Q.
-Proof.
-intros.
-rewrite later_fash. rewrite later_imp. auto.
-Qed.*)
-
-Lemma eqp_later1 {A} {NA: NatDed A}{IA: Indir A}{RA: RecIndir A} : forall P Q : A,
-   |>(P <=> Q)  |--   |>P <=> |>Q.
-Proof.
-intros.
-rewrite later_fash.
-rewrite later_andp.
-apply fash_derives, andp_derives; apply later_K.
-Qed.
-
-(*Lemma eqp_later {A}  {NA: NatDed A}{IA: Indir A}{RA: RecIndir A}  : forall P Q: A,
-    (|>(P <=> Q) = |>P <=> |>Q).
-Proof.
-intros.
-rewrite later_fash.
-rewrite later_andp; repeat rewrite later_imp; repeat  rewrite fash_andp. auto.
-Qed.*)
-
-Lemma subp_refl {A} {NA: NatDed A}{IA: Indir A}{RA: RecIndir A}  : forall G (P : A),
-  G |-- P >=> P.
-Proof.
-intros.
-rewrite <- (fash_triv G).
-apply @derives_trans with (#TT).
-apply fash_TT.
-apply fash_derives.
-apply imp_andp_adjoint.
-apply andp_left2; auto.
-Qed.
-
-Lemma subp_trans {A} {NA: NatDed A}{IA: Indir A}{RA: RecIndir A}  : forall G (P Q R: A),
-  (G |-- P >=> Q) ->
-  (G |-- Q >=> R) ->
-  G |-- P >=> R.
-Proof.
-intros.
-  apply @derives_trans with ((P >=> Q) && (Q >=> R)).
- apply andp_right; auto.
-  clear.
- rewrite <- fash_andp. apply fash_derives.
- apply -> imp_andp_adjoint.
- rewrite andp_comm. rewrite <- andp_assoc.
- eapply derives_trans; [ apply andp_derives | ].
- apply modus_ponens. apply derives_refl. apply modus_ponens.
-Qed.
-
-Lemma subp_top {A} {NA: NatDed A}{IA: Indir A}{RA: RecIndir A}  : forall G (P: A),
-  G |-- P >=> TT.
-Proof.
- intros. apply @derives_trans with (#TT).
- apply fash_TT.
- apply fash_derives. apply imp_andp_adjoint.
- apply andp_left1; auto.
-Qed.
-
-Lemma subp_bot {A} {NA: NatDed A}{IA: Indir A}{RA: RecIndir A}  : forall G (P: A),
-  G |-- FF >=> P.
-Proof.
- intros. apply @derives_trans with (#TT).
- apply fash_TT.
- apply fash_derives. apply imp_andp_adjoint.
- apply andp_left2; apply FF_left.
-Qed.
-
-Lemma subp_andp {A} {NA: NatDed A}{IA: Indir A}{RA: RecIndir A}  : forall G {P P' Q Q': A},
-  (G |-- P >=> P') ->
-  (G |-- Q >=> Q') ->
-  G |-- P && Q >=> (P' && Q').
-Proof.
- intros.
- apply @derives_trans with ((P >=> P') && (Q >=> Q')).
- apply andp_right; auto.
- clear.
- rewrite <- fash_andp. apply fash_derives.
- apply -> imp_andp_adjoint.
- apply @derives_trans with ((P && (P --> P')) && (Q && (Q --> Q'))).
- repeat apply andp_right.
- apply andp_left2. apply andp_left1; auto.
- do 2 apply andp_left1; auto.
- repeat apply andp_left2; auto.
- apply andp_left1; apply andp_left2; auto.
- apply andp_derives; apply modus_ponens.
-Qed.
-
-Lemma subp_imp {A} {NA: NatDed A}{IA: Indir A}{RA: RecIndir A}  : forall G (P P' Q Q' : A),
-  (G |-- P' >=> P) ->
-  (G |-- Q >=> Q') ->
-  G |-- (P --> Q) >=> (P' --> Q').
-Proof.
- intros.
- apply @derives_trans with ((P' >=> P) && (Q >=> Q')).
- apply andp_right; auto.
- clear.
- rewrite <- fash_andp. apply fash_derives.
- apply -> imp_andp_adjoint.
- apply -> imp_andp_adjoint.
- apply @derives_trans with (((P' && (P' --> P)) && (P --> Q)) && (Q --> Q')).
- repeat apply andp_right.
- apply andp_left2.  auto.
- do 3 apply andp_left1; auto.
- apply andp_left1. repeat apply andp_left2; auto.
- apply andp_left1; apply andp_left1. apply andp_left2;  auto.
- eapply derives_trans ; [eapply andp_derives | ].
- eapply derives_trans ; [eapply andp_derives | ].
- apply modus_ponens. apply derives_refl.
- apply modus_ponens. apply derives_refl.
- apply modus_ponens.
-Qed.
-
-Lemma subp_orp {A} {NA: NatDed A}{IA: Indir A}{RA: RecIndir A}  : forall G (P P' Q Q' : A),
-  (G |-- P >=> P') ->
-  (G |-- Q >=> Q') ->
-  G |-- (P || Q) >=> (P' || Q').
-Proof.
- intros.
- eapply derives_trans; [ apply andp_right; [apply H | apply H0] | ].
- clear.
- rewrite <- fash_andp. apply fash_derives.
- apply -> imp_andp_adjoint.
-rewrite andp_comm. apply imp_andp_adjoint.
-apply orp_left; apply -> imp_andp_adjoint; [apply orp_right1 | apply orp_right2].
- rewrite <- andp_assoc. apply andp_left1. apply modus_ponens.
- rewrite (andp_comm (_ --> _)).
- rewrite <- andp_assoc. apply andp_left1. apply modus_ponens.
-Qed.
-
-Lemma subp_subp {A} {NA: NatDed A}{IA: Indir A}{RA: RecIndir A}:
-  forall G (P Q R S: A),
-   (G |-- (R >=> P)) ->
-   (G |-- (Q >=> S)) ->
-   G |-- (P >=> Q) >=> (R >=> S).
-Proof.
- intros.
- intros.
- eapply derives_trans; [ apply andp_right; [apply H | apply H0] | ].
- clear.
- rewrite fash_triv.
- apply -> (@imp_andp_adjoint Triv).
- rewrite andp_assoc.
- apply @derives_trans with ((R >=> P) && (P >=> S)).
- apply andp_derives; auto.
- apply subp_trans with Q. apply andp_left2; auto. apply andp_left1; auto.
-  apply subp_trans with P. apply andp_left1; auto. apply andp_left2; auto.
-Qed.
-
-Lemma allp_imp2_later_e2 {B}{A}{NA: NatDed A}{IA: Indir A}{RA: RecIndir A}:
-   forall (P Q: B -> A) (y: B) ,
-      (ALL x:B, |> P x <=> |> Q x) |-- |> Q y >=> |> P y.
-Proof.
-  intros. apply allp_left with y. repeat rewrite fash_andp. apply andp_left2; auto.
-Qed.
-
-Lemma allp_imp2_later_e1 {B}{A}{NA: NatDed A}{IA: Indir A}{RA: RecIndir A}:
-   forall (P Q: B -> A) (y: B) ,
-      (ALL x:B, |> P x <=> |> Q x) |-- |> P y >=> |> Q y.
-Proof.
-  intros. apply allp_left with y. repeat rewrite fash_andp. apply andp_left1; auto.
-Qed.
-
-Lemma prove_HOcontractive1 {A} {NA: NatDed A}{IA: Indir A}{RA: RecIndir A} : forall X F,
-  (forall P Q: X -> A,
-    (ALL x:X, |>(P x >=> Q x) |--
-        ALL x:X, F P x >=> F Q x)) ->
-   HOcontractive F.
-Proof.
-  unfold HOcontractive.
-  intros.
-  apply allp_right; intro v.
-  rewrite fash_andp.
-  apply andp_right.
-  specialize (H P Q).
-  eapply derives_trans; [ | eapply derives_trans ; [ apply H |] ].
-  apply allp_derives; intro x.
-  apply @later_derives. apply fash_derives. apply andp_left1. auto.
-  apply allp_left with v; auto.
-  specialize (H Q P).
-  eapply derives_trans; [ | eapply derives_trans ; [ apply H |] ].
-  apply allp_derives; intro x.
-  apply later_derives. apply fash_derives. apply andp_left2. auto.
-  apply allp_left with v; auto.
-Qed.
-
-Lemma prove_HOcontractive {A} {NA: NatDed A}{IA: Indir A}{RA: RecIndir A} : forall X F,
-  (forall (P Q: X -> A) (x: X),
-    (ALL x:X, (|> P x <=> |> Q x) |-- F P x >=> F Q x)) ->
-   HOcontractive F.
-Proof.
-  unfold HOcontractive.
-  intros. apply allp_right. intros.
-  rewrite fash_andp.
-  apply andp_right; eapply derives_trans, H; apply allp_derives; intros;
-    [|rewrite andp_comm]; apply eqp_later1.
-Qed.
-
-Lemma prove_HOcontractive' {A} {NA: NatDed A}{IA: Indir A}{RA: RecIndir A} : forall X F,
-  (forall (P Q: X -> A) (x: X),
-    (ALL x:X, |>(P x <=> Q x) |-- F P x >=> F Q x)) ->
-   HOcontractive F.
-Proof.
-  unfold HOcontractive.
-  intros. apply allp_right. intros v.
-  setoid_rewrite fash_andp at 2.
-  apply andp_right; auto.
-  eapply derives_trans, H.
-  apply allp_derives; intros.
-  rewrite andp_comm; auto.
-Qed.
-
-Lemma sub_sepcon' {A}{NA: NatDed A}{SL: SepLog A}{IA: Indir A}{RA: RecIndir A}{SRA: SepRec A}:
-  forall P P' Q Q': A, (P >=> P') && (Q >=> Q') |-- (P * Q) >=> (P' * Q').
-Proof.
-intros.
-apply subp_i1.
-rewrite unfash_sepcon_distrib.
-apply sepcon_derives.
-apply derives_trans with ((P --> P') && P).
-apply andp_derives; auto.
-eapply derives_trans; [ | apply unfash_fash ].
-apply unfash_derives. apply andp_left1; auto.
-rewrite andp_comm; apply modus_ponens.
-apply derives_trans with ((Q --> Q') && Q).
-apply andp_derives; auto.
-eapply derives_trans; [ | apply unfash_fash ].
-apply unfash_derives. apply andp_left2; auto.
-rewrite andp_comm; apply modus_ponens.
-Qed.
-
-
-Lemma subp_sepcon {A} {NA: NatDed A}{IA: Indir A}{SA: SepLog A}{SI: SepIndir A}{RA: RecIndir A}{SRA: SepRec A} :
-    forall G (P P' Q Q' : A),
-  (G |-- P >=> P') ->
-  (G |-- Q >=> Q') ->
-  G |-- P * Q >=> P' * Q'.
-Proof.
- intros.
- eapply derives_trans; [ | apply sub_sepcon'].
- apply andp_right; auto.
-Qed.
-
-Ltac sub_unfold :=
-   match goal with
-    | |- _ |-- ?A _ >=> ?A _ => unfold A
-    | |- _ |-- ?A _ _ >=> ?A _ _ => unfold A
-    | |- _ |-- ?A _ _ _ >=> ?A _ _ _ => unfold A
-    | |- _ |-- ?A _ _ _ _ >=> ?A _ _ _ _ => unfold A
-    | |- _ |-- ?A _ _ _ _ _ >=> ?A _ _ _ _ _ => unfold A
-    | v: _ |- _ => destruct v
-   end.
-
-#[export] Hint Extern 2 (_ |-- _ >=> _) => sub_unfold : contractive.
-
-#[export] Hint Resolve prove_HOcontractive
-  subp_allp subp_imp subp_refl subp_exp subp_andp subp_orp subp_subp
-  subp_sepcon (* NOTE: This hint fails to work unless fully instantiated, for some reason;
-                             so the client must re-do the subp_sepcon hint *)
-  allp_imp2_later_e1 allp_imp2_later_e2 : contractive.
-
-Lemma  goedel_loeb {A}  {NA: NatDed A}{IA: Indir A}:
-    forall P Q : A ,   (Q && later P |-- P) ->  Q |-- P.
-Proof.
-intros.
-assert (TT |-- Q --> P).
-apply loeb.
-eapply derives_trans; [apply later_K|].
-apply imp_andp_adjoint.
-eapply derives_trans; [ | apply H].
-apply andp_right.
-apply andp_left2; auto.
-rewrite andp_comm.
-apply derives_trans with (|> Q && (|> Q --> |> P)).
-apply andp_derives; auto.
-apply now_later.
-apply modus_ponens.
-apply derives_trans with (Q && (Q --> P)).
-apply andp_right; auto.
-apply derives_trans with TT; auto.
-apply TT_right.
-apply modus_ponens.
-Qed.
-
-(*Lemma Rec_sub {A} {NA: NatDed A}{IA: Indir A}{RA: RecIndir A} : forall G
-  (F   : A -> A -> A)
-  (HF1 : forall X, contractive (F X))
-  (HF2 : forall R P Q, P >=> Q |-- F P R >=> F Q R)
-  (HF3 : forall P Q X, |>(P >=> Q) |-- F X P >=> F X Q),
-  forall P Q,
-    G |-- P >=> Q ->
-    G |-- Rec (F P) >=> Rec (F Q).
-*)
-
-Section HORec_sub_strong.
-Variable A B : Type.
-Variable NA : NatDed A.
-Variable IA : Indir A.
-Variable RA : RecIndir A.
-Variable F:(B -> A) -> (B -> A) -> B -> A.
-Variable HF1 : forall (f:B->A), HOcontractive (F f).
-Variable HF2 : forall (R: B -> A) (P Q: B->A), ALL b, P b >=> Q b |-- ALL b, F P R b >=> F Q R b.
-Variable HF3 : forall (P Q: B -> A) (f:B->A), ALL b:B, |>(P b >=> Q b) |-- ALL b:B, F f P b >=> F f Q b.
- 
-Lemma HORec_sub_strong G (f g : B->A) (H: G |-- ALL b:B, (f b) >=> (g b)):
-      G |-- ALL b:B, HORec (F f) b >=> HORec (F g) b.
-Proof.
-  assert (HF2': forall (R: B -> A) b (P Q: B->A), ALL a, P a >=> Q a |-- F P R b >=> F Q R b).
-  { intros. eapply derives_trans. apply (HF2 R P Q).
-    apply allp_left with b. trivial. }
-  clear HF2.
-  apply @derives_trans with (ALL b, f b >=> g b); auto.
-  clear G H.
-  apply goedel_loeb.
-  apply allp_right; intro b.
-  rewrite HORec_fold_unfold by auto.
-  pose proof (HORec_fold_unfold _ _ (HF1 f)).
-  pose proof (HORec_fold_unfold _ _ (HF1 g)).
-  set (P' := HORec (F f)) in *.
-  set (Q' := HORec (F g)) in *.
-  rewrite <- H.
-  specialize (HF3 P' Q' f).
-  rewrite later_allp.
-  eapply derives_trans; [apply andp_derives ; [apply derives_refl | apply HF3] | ].
-  specialize (HF2' Q' b f g). rewrite <- H0 in HF2'.
-  rewrite <- H in *.
-  apply subp_trans with  (F f Q' b).
-  apply andp_left2. apply allp_left with b; auto.
-  apply andp_left1; auto.
-Qed.
-
-End HORec_sub_strong.
-
-Lemma HORec_sub' {A}  {NA: NatDed A}{IA: Indir A}{RA: RecIndir A} : forall G B
-  (F : A -> (B -> A) -> B -> A)
-  (HF1 : forall (X:A), HOcontractive (F X))
-  (HF2 : forall (R: B -> A) (P Q: A), P >=> Q |-- ALL b, F P R b >=> F Q R b)
-  (HF3 : forall (P Q: B -> A) (X:A), ALL b:B, |>(P b >=> Q b) |-- ALL b:B, F X P b >=> F X Q b),
-  forall P Q : A,
-    (G |-- P >=> Q) ->
-    G |-- ALL b:B, HORec (F P) b >=> HORec (F Q) b.
-Proof. intros.
-apply (@HORec_sub_strong A B NA IA RA (fun f g b => F (f b) g b)).
-+ clear - HF1. red; intros.
-  apply allp_right; intros b.
-  eapply derives_trans; [ apply (HF1 (f b) P Q) | clear HF1].
-  apply allp_left with b; trivial.
-+ clear - HF2. intros R f g. apply allp_derives; intros b.
-  eapply derives_trans; [ apply (HF2 R (f b) (g b)) | clear HF2].
-  apply allp_left with b; trivial.
-+ clear - HF3. intros P Q f. apply allp_right; intros b.
-  eapply derives_trans; [ apply (HF3 P Q (f b)) | clear HF3].
-  apply allp_left with b; trivial.
-+ apply allp_right; intros b; trivial.
-Qed. 
-
-Lemma HORec_sub {A}  {NA: NatDed A}{IA: Indir A}{RA: RecIndir A} : forall G B
-  (F : A -> (B -> A) -> B -> A)
-  (HF1 : forall X, HOcontractive (F X))
-  (HF2 : forall R a (P Q: A), P >=> Q |-- F P R a >=> F Q R a)
-  (HF3 : forall (P Q: B -> A) X, ALL b:B, |>(P b >=> Q b) |-- ALL b:B, F X P b >=> F X Q b),
-  forall P Q : A,
-    (G |-- P >=> Q) ->
-    G |-- ALL b:B, HORec (F P) b >=> HORec (F Q) b.
-Proof.
-intros. apply HORec_sub'; trivial. 
-intros. apply allp_right; intros b; apply HF2.
-(*old proof:
-  intros.
-  apply @derives_trans with (P>=>Q); auto.
-  clear G H.
-  apply goedel_loeb.
-  apply allp_right; intro b.
-  rewrite HORec_fold_unfold by auto.
-  pose proof (HORec_fold_unfold _ _ (HF1 P)).
-  pose proof (HORec_fold_unfold _ _ (HF1 Q)).
-  set (P' := HORec (F P)) in *.
-  set (Q' := HORec (F Q)) in *.
-  rewrite <- H.
-  specialize (HF3 P' Q' P).
-  rewrite later_allp.
- eapply derives_trans; [apply andp_derives ; [apply derives_refl | apply HF3] | ].
-  specialize (HF2 Q' b P Q). rewrite <- H0 in HF2.
- rewrite <- H in *.
-  apply subp_trans with  (F P Q' b).
-  apply andp_left2.  apply allp_left with b; auto.
-  apply andp_left1. auto.
-*)
-Qed.
-
-(****** End contractiveness *****)
-
-Require Import Coq.ZArith.ZArith.
-Require Import VST.zlist.sublist.
-Require Import Coq.Lists.List.
-Require Import Coq.micromega.Lia.
-
-Lemma sepcon_app  {A} {NA: NatDed A}{SA: SepLog A}{CA: ClassicalSep A}:
-   forall l1 l2, fold_right sepcon emp (l1 ++ l2) =
-  fold_right sepcon emp l1 * fold_right sepcon emp l2.
-Proof.
-  induction l1; simpl; intros.
-  - rewrite emp_sepcon; auto.
-  - rewrite IHl1, sepcon_assoc; auto.
-Qed.
-
-Lemma sepcon_rev {A} {NA: NatDed A}{SA: SepLog A}{CA: ClassicalSep A}:
-  forall l, fold_right sepcon emp (rev l) = fold_right sepcon emp l.
-Proof.
-  induction l; simpl; auto.
-  rewrite sepcon_app; simpl.
-  rewrite sepcon_emp, sepcon_comm, IHl; auto.
-Qed.
-
-Lemma extract_nth_sepcon : forall {A} {NA: NatDed A} {SL: SepLog A} {d: Inhabitant A}
-                             {CA: ClassicalSep A} l i,
-    (0 <= i < Zlength l)%Z ->
-    fold_right sepcon emp l = Znth i l * fold_right sepcon emp (upd_Znth i l emp).
-Proof.
-  intros.
-  erewrite <- sublist_same with (al := l) at 1; auto.
-  rewrite sublist_split with (mid := i); try lia.
-  rewrite (sublist_next i); try lia.
-  rewrite sepcon_app; simpl.
-  rewrite <- sepcon_assoc, (sepcon_comm _ (Znth i l)).
-  unfold_upd_Znth_old; rewrite sepcon_app, sepcon_assoc; simpl.
-  rewrite emp_sepcon; auto.
-Qed.
-
-Lemma replace_nth_sepcon : forall {A} {NA: NatDed A} {SL: SepLog A} {d: Inhabitant A}
-                             {CA: ClassicalSep A} P l i,
-    (0 <= i < Zlength l)%Z ->
-    P * fold_right sepcon emp (upd_Znth i l emp) =
-    fold_right sepcon emp (upd_Znth i l P).
-Proof.
-  intros; unfold_upd_Znth_old.
-  rewrite !sepcon_app; simpl.
-  rewrite emp_sepcon, <- !sepcon_assoc, (sepcon_comm P); auto.
-Qed.
-
-Lemma sepcon_derives_prop : forall {A} {NA: NatDed A} {SL: SepLog A} {CA: ClassicalSep A}
-                              P Q R, (P |-- !!R) -> P * Q |-- !!R.
-Proof.
-  intros. eapply derives_trans with (!! (R /\ True)).
-  - rewrite <- sepcon_prop_prop. apply sepcon_derives; auto. apply prop_True_right.
-  - apply prop_left; intros (? & ?); apply prop_right; auto.
-Qed.
-
-Lemma sepcon_map : forall {A B} {NA: NatDed A} {SL: SepLog A} {CA: ClassicalSep A}
-                     (P Q: B -> A) (l : list B),
-    fold_right sepcon emp (map (fun x => P x * Q x) l) =
-      fold_right sepcon emp (map P l) * fold_right sepcon emp (map Q l).
-Proof.
-  induction l; simpl.
-  - rewrite sepcon_emp; auto.
-  - rewrite !sepcon_assoc, <- (sepcon_assoc (fold_right _ _ _) (Q a)), (sepcon_comm (fold_right _ _ _) (Q _)).
-    rewrite IHl; rewrite sepcon_assoc; auto.
-Qed.
-
-Lemma sepcon_list_derives : forall {A} {NA: NatDed A} {SL: SepLog A} {d: Inhabitant A}
-                              l1 l2 (Hlen : Zlength l1 = Zlength l2)
-  (Heq : forall i, (0 <= i < Zlength l1)%Z -> Znth i l1 |-- Znth i l2),
-  fold_right sepcon emp l1 |-- fold_right sepcon emp l2.
-Proof.
-  induction l1; destruct l2; auto; simpl; intros; rewrite ?Zlength_nil, ?Zlength_cons in *;
-    try (rewrite Zlength_correct in *; lia).
-  apply sepcon_derives.
-  - specialize (Heq 0%Z); rewrite !Znth_0_cons in Heq; apply Heq.
-    rewrite Zlength_correct; lia.
-  - apply IHl1; [lia|].
-    intros; specialize (Heq (i + 1)%Z); rewrite !Znth_pos_cons, !Z.add_simpl_r in Heq; try lia.
-    apply Heq; lia.
-Qed.
-
-Lemma sepcon_rotate : forall {A} {NA: NatDed A} {SL: SepLog A} {CA: ClassicalSep A} lP m n,
-    (0 <= n - m < Zlength lP)%Z ->
-    fold_right sepcon emp lP = fold_right sepcon emp (rotate lP m n).
-Proof.
-  intros.
-  unfold rotate.
-  rewrite sepcon_app, sepcon_comm, <- sepcon_app, sublist_rejoin, sublist_same by lia; auto.
-Qed.
-
-Lemma sepcon_In : forall {A} {NA: NatDed A} {SL: SepLog A} l P,
-    In P l -> exists Q, fold_right sepcon emp l = P * Q.
-Proof.
-  induction l; [contradiction|].
-  intros ? [|]; simpl; subst; eauto.
-  destruct (IHl _ H) as [? ->].
-  rewrite sepcon_comm, sepcon_assoc; eauto.
-Qed.
-
-Lemma extract_wand_sepcon : forall {A} {NA: NatDed A} {SL: SepLog A}
-                              l P, In P l ->
-  fold_right sepcon emp l = P * (P -* fold_right sepcon emp l).
-Proof.
-  intros.
-  destruct (sepcon_In _ _ H).
-  eapply wand_eq; eauto.
-Qed.
-
-Lemma wand_sepcon_map : forall {A B} {NA: NatDed A} {SL: SepLog A} (R : B -> A)
-                          {CA: ClassicalSep A} l P Q
-                          (HR : forall i, In i l -> R i = P i * Q i),
-    fold_right sepcon emp (map R l) = fold_right sepcon emp (map P l) *
-    (fold_right sepcon emp (map P l) -* fold_right sepcon emp (map R l)).
-Proof.
-  intros; eapply wand_eq.
-  erewrite map_ext_in, sepcon_map; eauto.
-  apply HR.
-Qed.
-
-Require Import VST.msl.ghost_seplog.
-
-Lemma bupd_andp2_corable: forall {A N D: Type} {ND : NatDed A} {SL : SepLog A} {CSL: ClassicalSep A} {BS : BupdSepLog A N D} {CoSL: CorableSepLog A},
-  forall P Q, corable Q -> (|==> P) && Q |-- |==> (P && Q).
-Proof.
-  intros.
-  rewrite (andp_comm P Q), (andp_left_corable Q), sepcon_comm by auto.
-  eapply derives_trans; [| apply bupd_frame_r].
-  rewrite (andp_comm _ Q), (andp_left_corable Q), sepcon_comm by auto.
-  auto.
-Qed.
-
-Lemma fupd_andp2_corable: forall {A N D I: Type} {ND : NatDed A} {IA : Indir A} {SL : SepLog A} {CSL: ClassicalSep A} {BS : BupdSepLog A N D} {FS : FupdSepLog A N D I} {CoSL: CorableSepLog A},
-  forall E1 E2 P Q, corable Q -> (|={E1,E2}=> P) && Q |-- |={E1,E2}=> (P && Q).
-Proof.
-  intros.
-  rewrite (andp_comm P Q), (andp_left_corable Q), sepcon_comm by auto.
-  eapply derives_trans; [| apply fupd_frame_r].
-  rewrite (andp_comm _ Q), (andp_left_corable Q), sepcon_comm by auto.
-  auto.
-Qed.
diff --git a/msl/msl_classical.v b/msl/msl_classical.v
deleted file mode 100644
index da5998bc5e..0000000000
--- a/msl/msl_classical.v
+++ /dev/null
@@ -1,5 +0,0 @@
-Require Export VST.msl.msl_standard.
-Require Export Coq.Logic.Classical.
-
-Tactic Notation "LEM" constr(P) :=
-  (destruct (classic (P))).
diff --git a/msl/msl_direct.v b/msl/msl_direct.v
deleted file mode 100644
index 92c09d1eac..0000000000
--- a/msl/msl_direct.v
+++ /dev/null
@@ -1,16 +0,0 @@
-Require Export VST.msl.Extensionality.
-Require Export VST.msl.base.
-Require Export VST.msl.boolean_alg.
-Require Export VST.msl.sepalg.
-Require Export VST.msl.predicates_sa.
-Require Export VST.msl.corable_direct.
-Require Export VST.msl.functors.
-Require Export VST.msl.sepalg_functors.
-Require Export VST.msl.sepalg_generators.
-Require Export VST.msl.combiner_sa.
-Require Export VST.msl.shares.
-Require Export VST.msl.cross_split.
-Require Export VST.msl.psepalg.
-Require Export VST.msl.pshares.
-Require Export VST.msl.corec.
-Require Export VST.msl.eq_dec.
\ No newline at end of file
diff --git a/msl/msl_standard.v b/msl/msl_standard.v
index 68891980ea..a633dc4dad 100644
--- a/msl/msl_standard.v
+++ b/msl/msl_standard.v
@@ -1,30 +1,7 @@
 Require Export VST.msl.Extensionality.
-Require Export VST.msl.ageable.
-Require Export VST.msl.age_sepalg.
 Require Export VST.msl.base.
-Require Export VST.msl.boolean_alg.
-Require Export VST.msl.knot_full_variant.
-Require Export VST.msl.knot_shims.
-Require Export VST.msl.knot_full_sa.
-Require Export VST.msl.knot_shims.
-Require Export VST.msl.predicates_hered.
-Require Export VST.msl.predicates_sl.
-Require Export VST.msl.corable.
-Require Export VST.msl.subtypes.
-Require Export VST.msl.subtypes_sl.
-Require Export VST.msl.predicates_rec.
-Require Export VST.msl.contractive.
 Require Export VST.msl.sepalg.
-Require Export VST.msl.functors.
-Require Export VST.msl.sepalg_functors.
-Require Export VST.msl.sepalg_generators.
-Require Export VST.msl.combiner_sa.
 Require Export VST.msl.shares.
-Require Export VST.msl.cross_split.
 Require Export VST.msl.psepalg.
 Require Export VST.msl.pshares.
 Require Export VST.msl.eq_dec.
-
-Export MixVariantFunctor.
-Export MixVariantFunctorLemmas.
-Export MixVariantFunctorGenerator.
diff --git a/msl/normalize.v b/msl/normalize.v
deleted file mode 100644
index 84dbf01c02..0000000000
--- a/msl/normalize.v
+++ /dev/null
@@ -1,414 +0,0 @@
-Require Import VST.msl.msl_standard.
-
-(* Set Warnings "-deprecated-hint-rewrite-without-locality".  Delete this line after we abandon Coq 8.13 *)
-
-Local Open Scope pred.
-
-Lemma andp_TT {A}`{ageable A}{EO: Ext_ord A}: forall (P: pred A), P && TT = P.
-Proof.
-intros.
-apply pred_ext; intros w ?.
-destruct H0; auto.
-split; auto.
-Qed.
-
-Lemma sepcon_andp_prop' {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}: forall P Q R, (!!Q && P)*R = !!Q&&(P*R).
-Proof.
-intros.
-rewrite sepcon_comm. rewrite sepcon_andp_prop.
-rewrite sepcon_comm; auto.
-Qed.
-
-#[export] Hint Rewrite @sepcon_emp @emp_sepcon @TT_and @andp_TT
-             @exp_sepcon1 @exp_sepcon2
-               @exp_andp1 @exp_andp2
-         @sepcon_andp_prop @sepcon_andp_prop'
-        : normalize.
-
-Definition pure {A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}
-     (P: pred A) : Prop :=
-   P |-- emp.
-
-(*Lemma pure_sepcon {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}: forall (P : pred A), pure P -> P*P=P.
-Proof.
-intros.
-apply pred_ext; intros w ?.
-destruct H0 as (? & ? & J & HP & ?).
-apply H in HP. destruct HP as (? & Hid & Hext).
-eapply join_ext_commut in Hext as (? & J1 & ?); eauto.
-apply Hid in J1; subst.
-eapply pred_upclosed; eauto.
-destruct (H _ H0) as (? & ? & ?).
-exists w; exists w.
-split; [|split]; auto.
-apply H0 in H1.
-do 3 red in H1. apply identity_unit' in H1.
-apply H1.
-Qed.*)
-
-Lemma pure_e {A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}: forall (P: pred A), pure P -> (P |-- emp).
-Proof.
-intros.
-apply H.
-Qed.
-
-#[export] Hint Resolve pure_e : core.
-
-(*Lemma sepcon_pure_andp {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}:
- forall P Q, pure P -> pure Q -> ((P * Q) = (P && Q)).
-Proof.
-intros.
-apply pred_ext; intros w ?.
-destruct H1 as [w1 [w2 [? [? ?]]]].
-unfold pure in *.
-assert (unit_for w1 w2). apply H in H2; simpl in H2;
-apply identity_unit; auto. exists w; auto.
-unfold unit_for in H4.
-assert (w2=w) by (apply (join_eq H4 H1)).
-subst w2.
-assert (join w w1 w1).
-apply identity_unit; apply H0 in H3; simpl in H3; auto. exists w; auto.
-assert (w1=w) by (apply (join_eq H5 (join_comm H1))).
-subst w1.
-split; auto.
-destruct H1.
-exists w; exists w; split; [|split]; auto.
-apply H in H1.
-do 3 red in H1.
-clear dependent P. clear dependent Q.
-pose proof (core_unit w); unfold unit_for in *.
-pose proof (H1 _ _ (join_comm H)).
-rewrite H0 in H; auto.
-Qed.*)
-
-Lemma pure_emp {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}: pure emp.
-Proof.
-intros. unfold pure; auto.
-Qed.
-#[export] Hint Resolve pure_emp : core.
-
-Lemma join_equiv_refl {A}: forall x:A, @join A (Join_equiv A) x x x.
-Proof. split; auto. Qed.
-#[export] Hint Resolve join_equiv_refl : core.
-
-(*Lemma pure_sepcon1'' {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}: forall P Q R, pure P -> (Q |-- R) -> P * Q |-- R.
-Proof.
-pose proof I.
-intros.
-intros w [w1 [w2 [? [? ?]]]].
-apply H0 in H3.
-apply join_unit1_e in H2; auto.
-subst; auto.
-Qed.*)
-
-
-Lemma pure_existential {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}:
-   forall B (P: B -> pred A),    (forall x: B , pure (P x)) -> pure (exp P).
-Proof.
-intros.
-unfold pure in *.
-intros w [x ?].
-apply (H x); auto.
-Qed.
-
-#[export] Hint Resolve pure_existential : core.
-
-(*Lemma pure_core {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}:
-  forall P w, pure P -> P w -> P (core w).
-Proof.
-intros.
-rewrite <- identity_core; auto.
-apply H; auto.
-Qed.*)
-
-Lemma FF_sepcon {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}:
-           forall P, FF * P = FF.
-Proof.
-intros.
-apply pred_ext; intros w ?; try contradiction.
-destruct H as [w1 [w2 [? [? ?]]]]; contradiction.
-Qed.
-Lemma sepcon_FF {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}:
-            forall P, P * FF = FF.
-Proof.
-intros.
-rewrite sepcon_comm. apply FF_sepcon.
-Qed.
-#[export] Hint Rewrite @FF_sepcon @sepcon_FF : normalize.
-
-#[export] Hint Rewrite @prop_true_andp using (solve [auto]) : normalize.
-
-Lemma true_eq {A} `{ageable A} {EO: Ext_ord A}:  forall P: Prop, P -> (!! P) = (TT: pred A).
-Proof.
-intros. apply pred_ext; intros ? ?; simpl in *; intuition.
-Qed.
-#[export] Hint Rewrite @true_eq using (solve [auto]) : normalize.
-
-
-Lemma pure_con' {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}:
-      forall P Q, pure P -> pure Q -> pure (P*Q).
-Proof.
-intros.
-unfold pure in *.
-rewrite <- emp_sepcon.
-apply sepcon_derives; auto.
-Qed.
-#[export] Hint Resolve pure_con' : core.
-
-Lemma pure_intersection1: forall {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}
-       (P Q: pred A), pure P -> pure (P && Q).
-Proof.
-unfold pure; intros; auto.
-intros w [? ?]; auto.
-Qed.
-Lemma pure_intersection2: forall {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}
-     (P Q: pred A), pure Q -> pure (P && Q).
-Proof.
-unfold pure; intros; auto.
-intros w [? ?]; auto.
-Qed.
-#[export] Hint Resolve pure_intersection1 pure_intersection2 : core.
-
-Lemma FF_andp {A} `{ageable A}{EO: Ext_ord A}:  forall P: pred A, FF && P = FF.
-Proof.
-unfold FF, prop, andp; intros; apply pred_ext; intros ? ?; simpl in *; intuition.
-Qed.
-Lemma andp_FF {A}`{ageable A}{EO: Ext_ord A}:  forall P: pred A, P && FF = FF.
-Proof.
-unfold FF, prop, andp; intros; apply pred_ext; intros ? ?; simpl in *; intuition.
-Qed.
-#[export] Hint Rewrite @FF_andp @andp_FF : normalize.
-
-#[export] Hint Rewrite @andp_dup : normalize.
-
-Lemma andp_emp_sepcon_TT {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{FA: Flat_alg A}{AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}:
- forall (Q: pred A),
-     (forall w1 w2, core w1 = core w2 -> Q w1 -> Q w2) ->
-      (Q && emp * TT = Q).
-Proof.
-intros.
-apply pred_ext.
-intros w [w1 [w2 [? [[? ?] ?]]]].
-apply H with w1; auto.
-apply join_core in H0; auto.
-intros w ?.
-destruct (join_ex_identities w) as [e [He [? Hj]]].
-exists e; exists w; split; [|split]; auto.
-specialize (He _ _ Hj); subst; auto.
-split; auto.
-apply H with w; auto.
-symmetry; eapply join_core2; eauto.
-Qed.
-
-Lemma sepcon_TT {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}:
-   forall (P: pred A), P |-- (P * TT).
-Proof.
-intros.
-intros ??.
-exists a, (core a); repeat split; auto.
-apply join_comm, core_unit.
-Qed.
-#[export] Hint Resolve sepcon_TT : core.
-
-Lemma imp_extract_exp_left {B A: Type} `{ageable A}{EO: Ext_ord A}:
-    forall    (p : B -> pred A) (q: pred A),
-  (forall x, p x |-- q) ->
-   exp p |-- q.
-Proof.
-intros.
-intros w [x ?].
-eapply H0; eauto.
-Qed.
-
-(*Lemma pure_sepcon_TT_andp {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}:
-  forall P Q, pure P -> (P * TT) && Q = (P*Q).
-Proof.
- pose proof I.
-intros.
-apply pred_ext.
-intros w [? ?].
-destruct H1 as [w1 [w2 [? [? ?]]]].
-exists w1; exists w2; split; [|split]; auto.
-apply join_unit1_e in H1; auto.
-subst; auto.
-apply H0 in H3; auto.
-apply andp_right.
-apply sepcon_derives; auto.
-intros w [w1 [w2 [? [? ?]]]].
-apply join_unit1_e in H1; auto.
-subst; auto.
-apply H0 in H2; auto.
-Qed.
-
-Lemma pure_sepcon_TT_andp' {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}:
-  forall P Q, pure P -> Q && (P * TT) = (Q*P).
-Proof.
-intros. rewrite andp_comm.
-rewrite pure_sepcon_TT_andp; auto.
-apply sepcon_comm.
-Qed.
-
-Hint Rewrite @pure_sepcon_TT_andp @pure_sepcon_TT_andp' using (solve [auto]): normalize.*)
-
-(*Lemma pure_sepcon1' {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}:
-
-  forall P Q R, pure P -> (P * Q |-- P * R) -> P * Q |-- R.
-Proof.
-intros.
-eapply derives_trans; try apply H0.
-apply pure_sepcon1''; auto.
-Qed.*)
-
-Lemma pull_right {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}:
- forall P Q R,
-   (Q * P * R) = (Q * R * P).
-Proof.
-intros. repeat rewrite sepcon_assoc. rewrite (sepcon_comm P); auto.
-Qed.
-
-Lemma pull_right0 {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}: forall P Q,
-   (P * Q) = (Q * P).
-Proof.
-intros. rewrite (sepcon_comm P); auto.
-Qed.
-
-Ltac pull_left A := repeat (rewrite <- (pull_right A) || rewrite <- (pull_right0 A)).
-
-Ltac pull_right A := repeat (rewrite (pull_right A) || rewrite (pull_right0 A)).
-
-(*Lemma pure_modus {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}:
-  forall P Q,  (P |-- Q) -> pure Q -> P |-- Q && P.
-Proof.
-intros.
-intros w ?.
-split; auto.
-Qed.*)
-
-
-Lemma imp_exp_right {B A : Type} `{saA: ageable A}{EO: Ext_ord A}:
-  forall (x: B) (p: pred A) (q: B -> pred A),
-    (p |-- q x) ->
-    p |-- exp q.
-Proof.
-intros.
-eapply derives_trans; try apply H.
-intros w ?; exists x; auto.
-Qed.
-
-Lemma derives_extract_prop {A} `{ageable A}{EO: Ext_ord A}:
-  forall (P: Prop) (Q R: pred A), (P -> Q |-- R) ->  !!P && Q |-- R.
-Proof.
-unfold derives, prop, andp; hnf in *; intuition.
-hnf in H1; intuition.
-Qed.
-
-Lemma derives_extract_prop' {A} `{ageable A}{EO: Ext_ord A}:
-  forall (P: Prop) (Q R: pred A), (P -> Q |-- R) ->  Q && !!P|-- R.
-Proof.
-unfold derives, prop, andp; intuition; hnf in *; intuition.
-hnf in *; intuition. apply H1; auto.
-Qed.
-
-Ltac normalize1 :=
-             match goal with
-                | |- _ => contradiction
-                | |- context [(?P && ?Q) * ?R] => rewrite (corable_andp_sepcon1 P Q R) by (auto with normalize)
-                | |- context [?Q * (?P && ?R)] => rewrite (corable_sepcon_andp1 P Q R) by (auto with normalize)
-                | |- context [(?Q && ?P) * ?R] => rewrite (corable_andp_sepcon2 P Q R) by (auto with normalize)
-                | |- context [?Q * (?R && ?P)] => rewrite (corable_sepcon_andp2 P Q R) by (auto with normalize)
-                | |- _ => progress  (autorewrite with normalize); auto with typeclass_instances
-                | |- _ = ?x -> _ => intro; subst x
-                | |- ?x = _ -> _ => intro; subst x
-                |  |- ?ZZ -> _ => match type of ZZ with
-                                               | Prop =>
-                                                    let H := fresh in
-                                                       ((assert (H:ZZ) by auto; clear H; intros _) || intro H)
-                                               | _ => intros _
-                                              end
-                | |- forall _, _ => let x := fresh "x" in (intro x; normalize1; try generalize dependent x)
-                | |- exp _ |-- _ => apply imp_extract_exp_left
-                | |- !! _ && _ |-- _ => apply derives_extract_prop
-                | |- _ && !! _ |-- _ => apply derives_extract_prop'
-                | |- _ |-- !! (?x = ?y) && _ =>
-                            (rewrite prop_true_andp with (P:= (x=y))
-                                            by (unfold y; reflexivity); unfold y in *; clear y) ||
-                            (rewrite prop_true_andp with (P:=(x=y))
-                                            by (unfold x; reflexivity); unfold x in *; clear x)
-                | |- _ => solve [auto with typeclass_instances]
-                end.
-
-Ltac normalize1_in Hx :=
-             match type of Hx with
-                | app_pred (exp _) _ => destruct Hx
-                | app_pred (!! _ && _) _ => let H1 := fresh in destruct Hx as [H1 Hx]; unfold prop in H1
-                | context [ !! ?P ] =>
-                                    rewrite (true_eq P) in Hx by auto with typeclass_instances
-                | context [ !! ?P && ?Q ] =>
-                                    rewrite (prop_true_andp P Q) in Hx by auto with typeclass_instances
-                | context [(?P && ?Q) * ?R] => rewrite (corable_andp_sepcon1 P Q R) in Hx by (auto with normalize)
-                | context [?Q * (?P && ?R)] => rewrite (corable_sepcon_andp1 P Q R) in Hx by (auto with normalize)
-                | context [(?Q && ?P) * ?R] => rewrite (corable_andp_sepcon2 P Q R) in Hx by (auto with normalize)
-                | context [?Q * (?R && ?P)] => rewrite (corable_sepcon_andp2 P Q R) in Hx by (auto with normalize)
-                | _ => progress  (autorewrite with normalize in Hx); auto with typeclass_instances
-                end.
-
-Ltac normalize := repeat normalize1.
-
-Tactic Notation "normalize" "in" hyp(H) := repeat (normalize1_in H).
-
-Definition mark {A: Type} (i: nat) (j: A) := j.
-
-Lemma swap_mark1 {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}:
-  forall i j Pi Pj B, (i<j)%nat -> B * mark i Pi * mark j Pj = B * mark j Pj * mark i Pi.
-Proof.
-intros.
-repeat rewrite sepcon_assoc.
-f_equal.
-apply sepcon_comm.
-Qed.
-
-Lemma swap_mark0 {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}:
-  forall i j Pi Pj,  (i<j)%nat -> mark i Pi * mark j Pj = mark j Pj * mark i Pi.
-Proof.
-intros.
-apply sepcon_comm.
-Qed.
-
-Ltac select_left n :=
-  repeat match goal with
- | |- context [(_ * mark ?i _ * mark n _)%pred] =>
-      rewrite (swap_mark1 i n); [ | solve [simpl; auto]]
- | |- context [(mark ?i _ * mark n _)%pred] =>
-      rewrite (swap_mark0 i n); [ | solve [simpl; auto]]
-end.
-Ltac select_all n := match n with
-                                | O => idtac
-                                | S ?n' => select_left n; select_all n'
-                              end.
-Ltac markem n P :=
-   match P with
-   | (?Y * ?Z) =>
-        (match goal with H: mark _ Z = Z |- _ => idtac end
-        || assert (mark n Z = Z) by auto); markem (S n) Y
-   | ?Z =>  match goal with H: mark _ Z = Z |- _ => idtac end
-                || assert (mark n Z = Z) by auto
-  end.
-
-Ltac prove_assoc_commut :=
- match goal with H : Perm_alg _ |- _ => clear - H end;
- try (match goal with |- ?F _ -> ?G _ => replace G with F; auto end);
-  (repeat rewrite <- sepcon_assoc;
-   match goal with |- ?P = _ => markem O P end;
-   let LEFT := fresh "LEFT" in match goal with |- ?P = _ => set (LEFT := P) end;
-  match goal with H: mark ?n _ = _ |- _ =>
-     repeat  match goal with H: mark ?n _ = ?P |- _ => rewrite <- H; clear H end;
-     select_all n;
-     reflexivity
-   end).
-
-Lemma test_prove_assoc_commut {T}{JA: Join T}{PA: Perm_alg T}{SA: Sep_alg T}{agA: ageable T}{AgeA: Age_alg T}{EO: Ext_ord T}{EA: Ext_alg T} : forall A B C D E : pred T,
-   D * E * A * C * B = A * B * C * D * E.
-Proof.
-intros.
-prove_assoc_commut.
-Qed.
diff --git a/msl/op_classes.v b/msl/op_classes.v
deleted file mode 100644
index a9d9ae67f6..0000000000
--- a/msl/op_classes.v
+++ /dev/null
@@ -1,98 +0,0 @@
-Require Import VST.msl.Extensionality.
-Require Import VST.msl.sepalg.
-Require Import VST.msl.ageable.
-Require Import VST.msl.age_sepalg.
-Require Import VST.msl.base.
-Require Import VST.msl.predicates_hered.
-Require Import VST.msl.predicates_sl.
-Require Import VST.msl.subtypes.
-Require Import VST.msl.subtypes_sl.
-Require Import VST.msl.predicates_rec.
-
-(* Given a separation algebra on type [A], we can make a separation logic
-   with predicates of type  [pred A].  But the type   [B -> pred A] is also
-   a natural separation logic.  These typeclasses automagically extend
-   the separation-logic operators to the pointwise-function case.
-   At present, this is just the beginnings of an experiment with this idea;
-   don't expect it to work well enough to be useful.
-   Andrew Appel, August 2012, following an approach suggested by Rob Dockins
-*)
-
-Class StarOp A := {  starOp : A -> A -> A }.
-
-#[global] Instance baseStarOp {A}{agA: ageable A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}
- : StarOp (pred A) := {| starOp := sepcon |}.
-
-#[global] Instance funStarOp (B: Type)(A: Type)(StarA: StarOp A) : StarOp (B -> A) :=
-   {| starOp := fun (P Q : B -> A) (b : B) =>  starOp (P b) (Q b) |}.
-
-Set Warnings "-notation-overridden".
-Notation "P '*' Q" := (starOp P Q) : pred.
-Set Warnings "notation-overridden".
-(* Opaque baseStarOp *)
-
-Class DerivesOp A := {  derivesOp : A -> A -> Prop }.
-
-#[global] Instance baseDerivesOp {A}{agA: ageable A}{EO: Ext_ord A}
- : DerivesOp (pred A) := {| derivesOp := @derives A agA EO|}.
-
-#[global] Instance funDerivesOp (B: Type)(A: Type)(DerivesA: DerivesOp A) : DerivesOp (B -> A)
- := {| derivesOp := fun (P Q : B -> A)  => forall b, derivesOp (P b) (Q b) |}.
-Set Warnings "-notation-overridden".
-Declare Scope logic_derives.
-Notation "P '|--' Q" := (derivesOp P%pred Q%pred) : logic_derives.
-Set Warnings "notation-overridden".
-Open Scope logic_derives.
-(* Opaque baseDerivesOp. *)
-
-Class WandOp A := {  wandOp : A -> A -> A }.
-
-#[global] Instance baseWandOp {A}{agA: ageable A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}
- : WandOp (pred A) := {| wandOp := wand |}.
-
-#[global] Instance funWandOp (B: Type)(A: Type)(WandA: WandOp A) : WandOp (B -> A) :=
-   {| wandOp := fun (P Q : B -> A) (b : B) =>  wandOp (P b) (Q b) |}.
-
-Set Warnings "-notation-overridden".
-Notation "P '-*' Q" := (wandOp P Q) : pred.
-Set Warnings "notation-overridden".
-(* Opaque baseWandOp *)
-
-Class EmpOp A := { Emp: A}.
-
-#[global] Instance baseEmpOp {A}{agA: ageable A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AgeA: Age_alg A}{EO: Ext_ord A}
-  : EmpOp (pred A) := {| Emp := @emp A JA SA agA AgeA EO |}.
-
-#[global] Instance funEmpOp  (B: Type)(A: Type)(EmpA: EmpOp A) : EmpOp (B -> A) :=
-   {| Emp := fun (b : B) =>  Emp  |}.
-
-Section Test.
-Variable environ: Type.
-Variables (rmap : Type)
-      (Join_rmap: Join rmap) (Perm_rmap: @Perm_alg rmap Join_rmap)
-      (Sep_rmap: @Sep_alg rmap Join_rmap)
-      (Canc_rmap: @Canc_alg rmap Join_rmap)
-      (Disj_rmap: @Disj_alg rmap Join_rmap)
-      (ag_rmap: ageable rmap)
-      (Age_rmap: @Age_alg rmap Join_rmap ag_rmap Sep_rmap)
-      (Ext_rmap: @Ext_ord rmap ag_rmap)
-      (ExtA_rmap: @Ext_alg rmap ag_rmap Ext_rmap Join_rmap Sep_rmap).
-#[local] Existing Instance  Join_rmap.
-#[local] Existing Instance  Perm_rmap.
-#[local] Existing Instance  Sep_rmap.
-#[local] Existing Instance  Canc_rmap.
-#[local] Existing Instance  Disj_rmap.
-#[local] Existing Instance  ag_rmap.
-#[local] Existing Instance  Age_rmap.
-#[local] Existing Instance  Ext_rmap.
-#[local] Existing Instance  ExtA_rmap.
-
-Lemma test1: forall (P : environ -> pred rmap) (Q: pred rmap),
-   P * Emp |-- P.
-Proof.
- intros.
-  intro. simpl; rewrite sepcon_emp.
-auto.
-Qed.
-
-End Test.
diff --git a/msl/predicates_hered.v b/msl/predicates_hered.v
deleted file mode 100644
index 83ed845cc1..0000000000
--- a/msl/predicates_hered.v
+++ /dev/null
@@ -1,1572 +0,0 @@
-(*
- * Copyright (c) 2009-2010, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-
-Require Import VST.msl.base.
-Require Import VST.msl.ageable.
-Require Import RelationClasses.
-
-Declare Scope pred.
-Delimit Scope pred with pred.
-Local Open Scope pred.
-
-(* A "pre-predicate" is hereditary iff whenever it is
-   true at world a, it is also true at all worlds
-   accessable from a via R.
- *)
-Definition hereditary {A} (R:A->A->Prop) (p:A->Prop) :=
-  forall a a':A, R a a' -> p a -> p a'.
-
-(* Following the ordered RA approach of "MoSeL: A General, Extensible Modal Framework for
-   Interactive Proofs in Separation Logic", Krebbers et al.,
-   our algebra is equipped with an order, and predicates must be
-   upward-closed w.r.t. that order. In VeriC, this order is
-   "adding more ghost state".
-   Most importantly, "emp" will be true of anything above the empty element
-   in this order. *)
-Class Ext_ord (A : Type) {AG : ageable A} :=
-  { ext_order : relation A;
-    ext_preorder : PreOrder ext_order;
-(*    ext_age_commut : commut A ext_order age;*)
-    (* This may not be true, since non-ordered elements may age to ordered elements *)
-    age_ext_commut : commut A age ext_order;
-    ext_age_compat : forall a b a', ext_order a b -> age a a' -> exists b', age b b' /\ ext_order a' b';
-    ext_level : forall a b, ext_order a b -> level a = level b
-  }.
-Global Existing Instance ext_preorder.
-
-Lemma ext_refl : forall `{Ext_ord} a, ext_order a a.
-Proof.
-  reflexivity.
-Qed.
-
-#[export] Hint Resolve ext_refl : core.
-
-#[export] Program Instance Ext_prod A B `(Ext_ord A) (relB : relation B) {P : PreOrder relB} : @Ext_ord (A * B) (ag_prod A B _) :=
-  { ext_order := fun a b => ext_order (fst a) (fst b) /\ relB (snd a) (snd b) }.
-Next Obligation.
-Proof.
-  split.
-  - intros (?, ?); split; reflexivity.
-  - intros (?, ?) (?, ?) (?, ?) [] []; split; etransitivity; eauto.
-Qed.
-(*Next Obligation.
-Proof.
-  intros (?, ?) (?, ?) [] (?, ?) Hage.
-  hnf in Hage; simpl in Hage.
-  destruct (age1 a1) eqn: Hage1; [|discriminate].
-  inv Hage.
-  eapply ext_age_commut in Hage1 as [? Hage]; eauto.
-  eexists (_, _); hnf; simpl; eauto.
-  rewrite Hage; auto.
-Qed.*)
-Next Obligation.
-Proof.
-  intros (?, ?) (?, ?) Hage (?, ?) [].
-  simpl in *.
-  hnf in Hage; simpl in Hage.
-  destruct (age1 a0) eqn: Hage1; [|discriminate].
-  inv Hage.
-  eapply age_ext_commut in Hage1 as [? ? Hage]; eauto.
-  eexists (_, _); hnf; simpl; eauto.
-  rewrite Hage; auto.
-Qed.
-Next Obligation.
-Proof.
-  simpl in *.
-  hnf in H1; simpl in H1.
-  destruct (age1 a) eqn: Hage1; [|discriminate].
-  inv H1.
-  eapply ext_age_compat in H0 as (? & Hage & ?); eauto.
-  eexists (_, _); split; hnf; simpl; eauto.
-  rewrite Hage; auto.
-Qed.
-Next Obligation.
-Proof.
-  simpl in *.
-  eapply ext_level; eauto.
-Qed.
-
-Section Order.
-
-Context {A : Type} {AG : ageable A}.
-Context {EO : Ext_ord A}.
-
-
-(* A predicate is a hereditary pre-predicate that is upward-closed
-   according to the extension order. *)
-Definition pred := { p:A -> Prop | hereditary age p /\ hereditary ext_order p }.
-
-Bind Scope pred with pred.
-
-(* Here is some junk that makes the definition of "pred" opaque
-   to most tactics but still allows the "Program" extension to
-   see it is a subset type.  The coercion is sugar that allows us to use
-   predicates easily.
- *)
-Definition app_pred (p:pred) : A -> Prop := proj1_sig p.
-Definition pred_hereditary (p:pred) := proj1 (proj2_sig p).
-Definition pred_upclosed (p:pred) := proj2 (proj2_sig p).
-Coercion app_pred : pred >-> Funclass.
-Global Opaque pred.
-
-#[local] Hint Resolve pred_hereditary : core.
-
-Lemma nec_hereditary (p: A -> Prop) : hereditary age p ->
-  forall a a':A, necR a a' -> p a -> p a'.
-Proof.
-  intros.
-  induction H0; auto.
-  apply H with x; auto.
-Qed.
-
-Lemma pred_nec_hereditary (p:pred) :
-  forall a a':A, necR a a' -> p a -> p a'.
-Proof.
-  apply nec_hereditary, pred_hereditary.
-Qed.
-
-(*Lemma ext_later_commut : commut A ext_order laterR.
-Proof.
-  repeat intro.
-  generalize dependent x; induction H0; intros.
-  - eapply ext_age_commut in H as []; eauto.
-    eexists; [|apply H1].
-    apply t_step; auto.
-  - apply IHclos_trans2 in H as [? ? Hext].
-    apply IHclos_trans1 in Hext as [? ? Hext].
-    eexists; [|apply Hext].
-    eapply t_trans; eauto.
-Qed.
-
-Lemma ext_nec_commut : commut A ext_order necR.
-Proof.
-  repeat intro.
-  apply nec_refl_or_later in H0 as [|]; subst; eauto.
-  destruct (ext_later_commut _ _ H _ H0).
-  eexists; [|apply H2].
-  apply laterR_necR; auto.
-Qed.*)
-
-Lemma later_ext_commut : commut A laterR ext_order.
-Proof.
-  repeat intro.
-  generalize dependent z; induction H; intros.
-  - eapply age_ext_commut in H as []; eauto.
-    eexists; [apply H|].
-    apply t_step; auto.
-  - apply IHclos_trans1 in H1 as [? Hext ?].
-    apply IHclos_trans2 in Hext as [? Hext ?].
-    eexists; [apply Hext|].
-    eapply t_trans; eauto.
-Qed.
-
-Lemma nec_ext_commut : commut A necR ext_order.
-Proof.
-  repeat intro.
-  apply nec_refl_or_later in H as [|]; subst; eauto.
-  destruct (later_ext_commut _ _ H _ H0).
-  eexists; [apply H1|].
-  apply laterR_necR; auto.
-Qed.
-
-Program Definition mkPred (p:A -> Prop) : pred :=
-  fun x => forall x' x'', necR x x' -> ext_order x' x'' -> p x''.
-Next Obligation.
-  split; repeat intro.
-  - eapply H0, H2.
-    apply rt_trans with a'; auto.
-    apply rt_step; auto.
-  - eapply nec_ext_commut in H as [? ? ?]; [|apply H1].
-    eapply H0; eauto.
-    etransitivity; eauto.
-Qed.
-
-(* The semantic notion of entailment.
- *)
-Definition derives (P Q:pred) := forall a:A, P a -> Q a.
-
-(* "valid" relations are those that commute with aging and extension.
-   These relations are the ones that can be turned into modalities.
- *)
-Definition valid_rel (R:relation A) : Prop :=
-  commut A age R /\ commut A R age /\ commut A R ext_order (*/\ commut A ext_order R*).
-
-(* A modality is a valid relation *)
-Definition modality := { R:relation A | valid_rel R }.
-
-(* More black magic to make the definition of modality mostly opaque. *)
-Definition app_mode (m:modality) : A -> A -> Prop := proj1_sig m.
-Definition mode_valid (m:modality) := proj2_sig m.
-Global Opaque modality.
-Coercion app_mode : modality >-> Funclass.
-
-(* commutivity facts for the basic relations *)
-
-Lemma valid_rel_commut_later1 : forall R,
-  valid_rel R ->
-  commut A laterR R.
-Proof.
-  intros; hnf; intros.
-  revert z H1.
-  induction H0; intros.
-  destruct H.
-  destruct (H _ _ H0 _ H1).
-  exists x0; auto.
-  apply t_step; auto.
-  destruct (IHclos_trans1 _ H1).
-  destruct (IHclos_trans2 _ H0).
-  exists x1; auto.
-  eapply t_trans; eauto.
-Qed.
-
-Lemma valid_rel_commut_later2 : forall R,
-  valid_rel R ->
-  commut A R laterR.
-Proof.
-  intros; hnf; intros.
-  revert x H0.
-  induction H1; intros.
-  destruct H as (_ & H & _).
-  destruct (H _ _ H1 _ H0).
-  exists x1; auto.
-  apply t_step; auto.
-  destruct (IHclos_trans2 _ H0).
-  destruct (IHclos_trans1 _ H2).
-  exists x2; auto.
-  eapply t_trans; eauto.
-Qed.
-
-Lemma valid_rel_commut_nec1 : forall R,
-  valid_rel R ->
-  commut A necR R.
-Proof.
-  intros; hnf; intros.
-  apply nec_refl_or_later in H0; destruct H0; subst.
-  exists z; auto.
-  destruct (valid_rel_commut_later1 R H x y H0 z H1).
-  exists x0; auto.
-  apply Rt_Rft; auto.
-Qed.
-
-Lemma valid_rel_commut_nec2 : forall R,
-  valid_rel R ->
-  commut A R necR.
-Proof.
-  intros; hnf; intros.
-  apply nec_refl_or_later in H1; destruct H1; subst.
-  exists x; auto.
-  destruct (valid_rel_commut_later2 R H x y H0 z H1).
-  exists x0; auto.
-  apply Rt_Rft; auto.
-Qed.
-
-(*Lemma valid_rel_commut_ext1 : forall R,
-  valid_rel R ->
-  commut A ext_order R.
-Proof.
-  intros ? H; apply H.
-Qed.*)
-
-Lemma valid_rel_commut_ext2 : forall R,
-  valid_rel R ->
-  commut A R ext_order.
-Proof.
-  intros ? H; apply H.
-Qed.
-
-Lemma valid_rel_age : valid_rel age.
-Proof.
-  intros; split; hnf; intros; eauto.
-  split; [|(*split; [*)apply age_ext_commut (*| apply ext_age_commut]*)].
-  unfold commut; eauto.
-Qed.
-
-Lemma valid_rel_later : valid_rel laterR.
-Proof.
-  intros; split; hnf; intros.
-  generalize dependent x.
-  induction H0; intros.
-  exists y; auto.
-  apply t_step; auto.
-  destruct (IHclos_trans2 _ H).
-  destruct (IHclos_trans1 _ H1).
-  exists x2; auto.
-  eapply t_trans; eauto.
-
-  split; [|(*split; [*)apply later_ext_commut (*| apply ext_later_commut]*)].
-  intros ???.
-  induction H; intros.
-  exists x; auto.
-  apply t_step; auto.
-  destruct (IHclos_trans1 _ H1).
-  destruct (IHclos_trans2 _ H2).
-  exists x1; auto.
-  eapply t_trans; eauto.
-Qed.
-
-Lemma valid_rel_nec : valid_rel necR.
-Proof.
-  intros; split; hnf; intros.
-  generalize dependent x.
-  induction H0; intros.
-  exists y; auto.
-  apply rt_step; auto.
-  exists x0; auto.
-  destruct (IHclos_refl_trans2 _ H).
-  destruct (IHclos_refl_trans1 _ H1).
-  exists x2; auto.
-  eapply rt_trans; eauto.
-
-  split; [|(*split; [*)apply nec_ext_commut (*| apply ext_nec_commut]*)].
-  intros ???.
-  induction H; intros.
-  exists x; auto.
-  apply rt_step; auto.
-  exists z; auto.
-
-  destruct (IHclos_refl_trans1 _ H1).
-  destruct (IHclos_refl_trans2 _ H2).
-  exists x1; auto.
-  eapply rt_trans; eauto.
-Qed.
-
-(* Definitions of the basic modalities.
- *)
-Definition ageM : modality
-  := exist _ age valid_rel_age.
-Definition laterM : modality
-  := exist _ laterR valid_rel_later.
-(*
-Definition necM  : modality
-  := exist _ necR valid_rel_nec.
-*)
-
-#[local] Hint Resolve rt_refl rt_trans t_trans : core.
-#[local] Hint Unfold necR : core.
-Local Obligation Tactic := unfold hereditary; intuition;
-    first [eapply pred_hereditary; eauto; fail | eapply pred_upclosed; eauto; fail | eauto ].
-
-(* Definitions of the basic propositional conectives.
- *)
-
-(* Lifting pure mathematical facts to predicates *)
-
-Program Definition prop (P: Prop) : pred := (fun _  => P).
-
-Definition TT : pred := prop True.
-Definition FF  : pred := prop False.
-
-Program Definition imp  (P Q:pred) : pred :=
-   fun a:A => forall a' a'':A, necR a a' -> ext_order a' a'' -> P a'' -> Q a''.
-Next Obligation.
-  apply H0 with a'0; auto.
-  apply rt_trans with a'; auto.
-  apply rt_step; auto.
-
-  eapply nec_ext_commut in H1 as [? ? ?]; eauto.
-  eapply H0; eauto.
-  etransitivity; eauto.
-Qed.
-Program Definition orp  (P Q:pred) : pred :=
-   fun a:A => P a \/ Q a.
-Next Obligation.
-  left; eapply pred_hereditary; eauto.
-  right; eapply pred_hereditary; eauto.
-  left; eapply pred_upclosed; eauto.
-  right; eapply pred_upclosed; eauto.
-Qed.
-
-Program Definition andp  (P Q:pred) : pred :=
-   fun a:A => P a /\ Q a.
-
-(* Universal and exp quantification
- *)
-
-Program Definition allp  {B: Type} (f: B -> pred) : pred
-  := fun a => forall b, f b a.
-Next Obligation.
-  apply pred_hereditary with a; auto.
-  apply H0.
-
-  apply pred_upclosed with a; auto.
-  apply H0.
-Qed.
-
-Program Definition exp  {B: Type} (f: B -> pred) : pred
-  := fun a => exists b, f b a.
-Next Obligation.
-  destruct H0; exists x; eapply pred_hereditary; eauto.
-
-  destruct H0; exists x; eapply pred_upclosed; eauto.
-Qed.
-
-
-(* Definition of the "box" modal operator.  This operator turns
-   modalities (relations) into a "necessarily" type operator.
- *)
-
-Program Definition box  (M:modality) (P:pred) : pred :=
-  fun a:A => forall a', M a a' -> P a'.
-Next Obligation.
-  destruct M as [M [? [H4 ?]]]; simpl in *.
-  destruct (H4 _ _ H1 _ H).
-  apply pred_hereditary with x; auto.
-  apply H0; auto.
-
-  destruct M as [M [? [? (*[*)H4 (*?]*)]]]; simpl in *.
-  destruct (H4 _ _ H1 _ H).
-  apply pred_upclosed with x; auto.
-  apply H0; auto.
-Qed.
-
-(* Definition of the "diamond" modal operator.  This operator
-   turns modalities into a "possibly" type operator.  _However_,
-   note that this is NOT the boolean dual to "box", as usually
-   found in accounts of modal logic. Instead, this is the
-   "proof-theoretic" dual as found in Restall's "A Introduction
-   to Substructural Logic" (2000).
- *)
-
-(*Program Definition diamond  (M:modality) (P:pred) : pred :=
-  fun a:A => exists a', M a' a /\ P a'.
-Next Obligation.
-  destruct M as [M [H3 ?]]; simpl in *.
-  destruct H0 as [x [? ?]].
-  destruct (H3 _ _ H _ H0).
-  exists x0; split; auto.
-  apply pred_hereditary with x; auto.
-
-  destruct M as [M [? [? (*[*)? (*H3]*)]]]; simpl in *.
-  destruct H0 as [x [? ?]].
-  destruct (H3 _ _ H _ H0).
-  exists x0; split; auto.
-  apply pred_upclosed with x; auto.
-Qed.*)
-
-Definition boxy  (m: modality) (p: pred): Prop :=  box m p = p.
-
-(* A pile of notations for the operators we have defined *)
-Declare Scope pred_derives.
-Notation "P '|--' Q" := (derives P%pred Q%pred) (at level 80, no associativity) : pred_derives.
-Open Scope pred_derives.
-Notation "'EX' x .. y , P " :=
-  (exp (fun x => .. (exp (fun y => P%pred)) ..)) (at level 65, x binder, y binder, right associativity) : pred.
-Notation "'ALL' x .. y , P " :=
-  (allp (fun x => .. (allp (fun y => P%pred)) ..)) (at level 65, x binder, y binder, right associativity) : pred.
-Infix "||" := orp (at level 50, left associativity) : pred.
-Infix "&&" := andp (at level 40, left associativity) : pred.
-Notation "P '-->' Q" := (imp P Q) (at level 55, right associativity) : pred.
-Notation "P '<-->' Q" := (andp (imp P Q) (imp Q P)) (at level 57, no associativity) : pred.
-(* Notation "'[]' e" := (box necM e) (at level 30, right associativity): pred. *)
-Notation "'|>' e" := (box laterM e) (at level 20, right associativity): pred.
-Notation "'!!' e" := (prop e) (at level 15) : pred.
-
-(* Rules for the propositional connectives *)
-Lemma modus_ponens  : forall (X P Q:pred),
-  (X |-- P) ->
-  (X |-- (P --> Q)) ->
-  X |-- Q.
-Proof.
-  unfold derives, imp; simpl; intros.
-  eapply H0 in H1; eauto.
-Qed.
-
-Lemma andp_right  : forall (X P Q:pred),
-  (X |-- P) ->
-  (X |-- Q) ->
-  X |-- P && Q.
-Proof.
-  unfold derives, imp, andp; simpl; intuition.
-Qed.
-
-
-Lemma pred_ext' : forall (p1 p2:pred),
-  app_pred p1 = app_pred p2 ->
-  p1 = p2.
-Proof.
-  intros; destruct p1; destruct p2; simpl in H.
-  subst x0.
-  replace a0 with a by apply proof_irr.
-  auto.
-Qed.
-
-Lemma pred_ext : forall (P Q:pred),
-  derives P Q -> derives Q P -> P = Q.
-Proof.
-  intros.
-  destruct P as [P HP].
-  destruct Q as [Q HQ].
-  unfold derives in *. simpl in *.
-  apply (exist_ext (A->Prop) (fun p => hereditary (@age _ AG) p /\ hereditary (@ext_order _ AG EO) p)).
-  extensionality a.
-  apply prop_ext; intuition.
-Qed.
-
-Lemma andp_dup : forall P: pred, P && P = P.
-Proof. intros. apply pred_ext; intros w ?. destruct H; auto. split; auto.
-Qed.
-
-Lemma andp_left1: forall P Q R: pred,  (P |-- R) -> P && Q |-- R.
-Proof. repeat intro. destruct H0; auto.
-Qed.
-
-Lemma andp_left2: forall P Q R: pred,  (Q |-- R) -> P && Q |-- R.
-Proof. repeat intro. destruct H0; auto.
-Qed.
-
-Lemma orp_left: forall P Q R: pred,  (P |-- R) -> (Q |-- R) -> P || Q |-- R.
-Proof. repeat intro. destruct H1; auto.
-Qed.
-
-Lemma orp_right1: forall P Q R: pred,  (P |-- Q) -> P |-- Q || R.
-Proof. repeat intro. left; auto.
-Qed.
-
-Lemma orp_right2: forall P Q R: pred,  (P |-- R) -> P |-- Q || R.
-Proof. repeat intro. right; auto.
-Qed.
-
-Lemma orp_assoc  : forall P Q R: pred, (P || Q) || R = P || (Q || R).
-Proof.
-  intros; apply pred_ext; auto; unfold derives, andp; simpl; intuition.
-Qed.
-
-Lemma derives_trans :
-    forall P Q R: pred, (P |-- Q) -> (Q |-- R) -> P |-- R.
-Proof. firstorder. Qed.
-
-Lemma exp_right:
-  forall {B}(x:B) p (q: B -> pred),
-    (p |-- q x) ->
-    p |-- exp q.
-Proof.
-intros.
-eapply derives_trans; try apply H.
-intros w ?; exists x; auto.
-Qed.
-
-Lemma exp_left:
-  forall {B: Type}(p: B -> pred) q,
-  (forall x, p x |-- q) ->
-   exp p |-- q.
-Proof.
-intros.
-intros w [x' ?].
-eapply H; eauto.
-Qed.
-
-Lemma and1  : forall (X P Q:pred),
-  X |-- P && Q --> P.
-Proof.
-  unfold derives, imp, andp; simpl; intuition eauto.
-Qed.
-
-Lemma and2  : forall (X P Q:pred),
-  X |-- P && Q --> Q.
-Proof.
-  unfold derives, imp, andp; simpl; intuition eauto.
-Qed.
-
-Lemma and3  : forall (X P Q R:pred),
-  X |-- (P --> Q) --> (P --> R) --> (P --> Q && R).
-Proof.
-  unfold derives, imp, andp; simpl; intuition eauto.
-  eapply nec_ext_commut in H4 as [? ? ?]; [|eauto].
-  eapply H2.
-  - eapply rt_trans; eauto.
-  - etransitivity; eauto.
-  - auto.
-Qed.
-
-Lemma or1  : forall (X P Q:pred),
-  X |-- P --> P || Q.
-Proof.
-  unfold derives, imp, orp; simpl; intuition.
-Qed.
-
-Lemma or2  : forall (X P Q:pred),
-  X |-- Q --> P || Q.
-Proof.
-  unfold derives, imp, orp; simpl; intuition.
-Qed.
-
-Lemma or3  : forall (X P Q R:pred),
-  X |-- (P --> R) --> (Q --> R) --> (P || Q --> R).
-Proof.
-  unfold derives, imp, orp; simpl; intuition eauto.
-  eapply nec_ext_commut in H4 as [? ? ?]; [|eauto].
-  eapply H2.
-  - eapply rt_trans; eauto.
-  - etransitivity; eauto.
-  - auto.
-Qed.
-
-Lemma TTrule  : forall X P,
-  X |-- P --> TT.
-Proof.
-  unfold derives, imp, TT; simpl; intuition.
-Qed.
-
-Lemma FFrule  : forall X P,
-  X |-- FF --> P.
-Proof.
-  unfold derives, imp, FF; simpl; intuition.
-Qed.
-
-Lemma distribution  : forall (X P Q R:pred),
-  X |-- P && (Q || R) --> (P && Q) || (P && R).
-Proof.
-  unfold derives, imp, orp, andp; simpl; intuition.
-Qed.
-
-(* Characterize the relation between conjunction and implication *)
-Lemma imp_andp_adjoint  : forall (P Q R:pred),
-  ((P && Q) |-- R) <-> (P |-- (Q --> R)).
-Proof.
-  split; intros.
-  hnf; intros; simpl; intros.
-  apply H.
-  split; auto.
-  eapply pred_nec_hereditary, pred_upclosed in H0; eauto.
-  hnf; intros.
-  hnf in H.
-  unfold imp in H; simpl in H.
-  destruct H0.
-  eapply H; eauto.
-Qed.
-
-(* Some facts about modalities *)
-
-Lemma box_e0 : forall (M: modality) Q,
-            reflexive _ M -> box M Q  |-- Q.
-Proof.
-intros.
-intro; intros.
-apply H0; simpl.
-apply H.
-Qed.
-
-Lemma boxy_i :
-  forall (Q: pred) (M: modality),
-    reflexive _ M ->
-    (forall w w', M w w' -> Q w -> Q w') ->
-    boxy M Q.
-Proof.
-intros.
-unfold boxy.
-apply pred_ext; hnf; intros.
-eapply box_e0; eauto.
-hnf; intros.
-eapply H0; eauto.
-Qed.
-
-(*
-Lemma necM_refl : reflexive _ necM.
-Proof.
-intros; intro; simpl.
-unfold necR.
-constructor 2.
-Qed.
-
-#[export] Hint Resolve necM_refl.
-*)
-
-(* relationship between box and diamond *)
-(*Lemma box_diamond  : forall M (P Q:pred),
-  ((diamond M P) |-- Q) <-> (P |-- (box M Q)).
-Proof.
-  unfold derives; intuition.
-  hnf; intros.
-  apply H.
-  hnf; eauto.
-  destruct H0 as [a' [? ?]].
-  apply H with a'; auto.
-Qed.
-
-(* Box is a normal modal operator *)
-
-Lemma ruleNec  : forall M (P:pred),
-  derives TT P ->
-  derives TT (box M P).
-Proof.
-  intros.
-  rewrite <- box_diamond.
-  hnf; intros.
-  apply H; hnf; auto.
-Qed.*)
-
-Lemma axiomK : forall M (P Q:pred),
-  (box M (P --> Q)) |-- (box M P --> box M Q).
-Proof.
-  intros; do 3 (hnf; intros).
-  destruct M as [R HR]; simpl in *.
-  destruct (valid_rel_commut_ext2 R HR _ _ H3 _ H1) as [? ? HR'].
-  destruct (valid_rel_commut_nec2 R HR _ _ HR' _ H0).
-  eauto.
-Qed.
-
-(* Box and diamond are positive modal operators *)
-
-Lemma box_positive  : forall M (P Q:pred),
-  (P |-- Q) ->
-  box M P |-- box M Q.
-Proof.
-  unfold derives, box; simpl; intuition.
-Qed.
-
-(*Lemma diamond_positive  : forall M (P Q:pred),
-  (P |-- Q) ->
-  diamond M P |-- diamond M Q.
-Proof.
-  unfold derives, diamond; simpl; firstorder.
-Qed.*)
-
-Lemma box_refl_trans : forall (m:modality) p,
-  reflexive _ m ->
-  transitive _ m ->
-  box m (box m p) = box m p.
-Proof.
-  intros.
-  apply pred_ext.
-  repeat intro.
-  assert (box m p a').
-  apply H1; auto.
-  apply H3.
-  apply H.
-  repeat intro.
-  apply H1.
-  eapply H0; eauto.
-Qed.
-
-(* Disribuitivity of box over various connectives *)
-
-Lemma box_and : forall R (P Q:pred),
-  box R (P && Q) = box R P && box R Q.
-Proof.
-  intros; apply pred_ext; hnf; intuition;
-    unfold andp, box in *; simpl in *; firstorder.
-Qed.
-
-Lemma box_all  : forall B R (F:B -> pred),
-  box R (allp F) = ALL x:B, box R (F x).
-Proof.
-  intros; apply pred_ext; hnf; intuition;
-    unfold allp, box in *; simpl in *; firstorder.
-Qed.
-
-Lemma box_ex  : forall B R (F:B->pred),
-  EX x:B, box R (F x) |-- box R (exp F).
-Proof.
-  unfold derives, exp, box; simpl; firstorder.
-Qed.
-
-Lemma box_or  : forall R (P Q:pred),
-   box R P || box R Q |-- box R (P || Q).
-Proof.
-  unfold derives, orp, box; simpl; firstorder.
-Qed.
-
-(* Distributivity of diamond over various operators *)
-
-(*Lemma diamond_or  : forall R (P Q:pred),
-  diamond R (P || Q) = diamond R P || diamond R Q.
-Proof.
-  intros; apply pred_ext; hnf; intuition;
-    unfold diamond, orp in *; simpl in *; firstorder.
-Qed.
-
-Lemma diamond_ex  : forall B R (F:B -> pred),
-  diamond R (exp F) = EX x:B, diamond R (F x).
-Proof.
-  intros; apply pred_ext; hnf; intuition;
-    unfold diamond, exp in *; simpl in *; firstorder.
-Qed.
-
-Lemma diamond_and  : forall R (P Q:pred),
-  diamond R (P && Q) |-- diamond R P && diamond R Q.
-Proof.
-  unfold derives, andp, diamond; simpl; firstorder.
-Qed.
-
-Lemma diamond_all  : forall B R (F:B->pred),
-  diamond R (allp F) |-- ALL x:B, diamond R (F x).
-Proof.
-  unfold derives, allp, diamond; simpl; firstorder.
-Qed.*)
-
-
-(* Lemmas about aging and the later operator *)
-
-(*
-Lemma nec_useless  :
-  forall P, []P = P.
-intros.
-  apply pred_ext; intros.
-  hnf; intros; apply H0.
-  simpl; apply necM_refl.
-  hnf; intros.
-  hnf; intros.
-  apply pred_nec_hereditary with a; auto.
-Qed.
-*)
-
-Lemma later_age  : forall P,
-  |>P = box ageM P.
-Proof.
-  intros; apply pred_ext; do 2 (hnf; intros).
-  simpl in H.
-  apply H.
-  apply t_step; auto.
-  revert H; induction H0; intros.
-  apply H0; auto.
-  apply pred_nec_hereditary with y.
-  apply Rt_Rft; auto.
-  apply IHclos_trans1; auto.
-Qed.
-
-Lemma now_later  : forall P,
-  P |-- |>P.
-Proof.
-  repeat intro.
-  apply pred_nec_hereditary with a; auto.
-  apply Rt_Rft; auto.
-Qed.
-
-Lemma now_later2  : forall G P,
-  (G |-- P) ->
-  G |-- |>P.
-Proof.
-  intros; apply @derives_trans with P; auto.
-  apply now_later.
-Qed.
-
-(* The "induction" rule for later *)
-
-Lemma goedel_loeb  : forall (P Q:pred),
-  (Q && |>P |-- P) ->
-  Q |-- P.
-Proof.
-  intros; hnf; intro a.
-  induction a using age_induction.
-  intros; simpl in H.
-  eapply H; auto.
-  split; auto.
-  rewrite later_age.
-  simpl; intros.
-  apply H0; auto.
-  apply pred_hereditary with x; auto.
-Qed.
-
-Lemma loeb  : forall (P:pred),
-     (|>P |-- P)    ->     TT |-- P.
-Proof.
-  intros. apply goedel_loeb.
-  apply andp_left2. auto.
-Qed.
-
-(* Later distributes over almost everything! *)
-
-(*Lemma later_commute_dia  : forall M (P:pred),
-  diamond M (|> P) |-- |> (diamond M P).
-Proof.
-  intros.
-  repeat rewrite later_age.
-  do 3 (hnf; intros).
-  simpl in H.
-  firstorder.
-  destruct M as [R HR].
-  simpl in *.
-  destruct HR as (H3 & _).
-  destruct (H3 _ _ H0 _ H).
-  exists x0; split; auto.
-Qed.*)
-
-Lemma later_commute  : forall M (P:pred),
-  box M (|>P) = |>(box M P).
-Proof.
-  intros.
-  apply pred_ext; do 3 (hnf; intros).
-  destruct M as [R HR].
-  destruct (valid_rel_commut_later2 R HR _ _ H1 _ H0).
-  apply H with x; simpl; auto.
-  destruct M as [R HR].
-  destruct (valid_rel_commut_later1 R HR _ _ H1 _ H0).
-  apply H with x; auto.
-Qed.
-
-Lemma later_and  : forall P Q,
-  |>(P && Q) = |>P && |> Q.
-Proof.
-  intros; apply box_and.
-Qed.
-
-Lemma later_or  : forall (P Q:pred),
-  |>(P || Q) = |>P || |>Q.
-Proof.
-  intros.
-  repeat rewrite later_age.
-  apply pred_ext.
-  2: apply box_or.
-  hnf; intros.
-  simpl in H.
-  case_eq (age1 a); intros.
-  destruct (H a0); auto.
-  left; simpl; intros.
-  replace a' with a0; auto.
-  congruence.
-  right; simpl; intros.
-  replace a' with a0; auto.
-  congruence.
-  left.
-  hnf; simpl; intros.
-  hnf in H1.
-  rewrite H0 in H1; discriminate.
-Qed.
-
-Lemma later_ex  : forall B (F:B->pred),
-  B ->
-  |>(exp F) = EX x:B, |>(F x).
-Proof.
-  intros.
-  apply pred_ext.
-  2: apply box_ex.
-  hnf; intros.
-  rewrite later_age in H.
-  case_eq (age1 a); intros.
-  destruct (H a0); auto.
-  exists x.
-  rewrite later_age; simpl; intros.
-  replace a' with a0; auto.
-  congruence.
-  exists X.
-  rewrite later_age.
-  hnf; simpl; intros.
-  unfold age in H1.
-  rewrite H0 in H1; discriminate.
-Qed.
-
-Lemma later_ex''  : forall B (F:B->pred),
-  |>(exp F) |-- (EX x:B, |>(F x)) || |> FF.
-Proof.
-  intros.
-  unfold derives; intros.
-  simpl in H |- *.
-  destruct (age1 a) eqn:?H; [left | right].
-  + simpl in H.
-    pose proof H a0.
-    destruct H1 as [b ?].
-    {
-      constructor.
-      auto.
-    }
-    exists b.
-    intros.
-    eapply pred_nec_hereditary, H1.
-    eapply age_later_nec; eauto.
-  + intros.
-    clear - H1 H0.
-    induction H1.
-    - hnf in H; congruence.
-    - auto.
-Qed.
-
-(*Lemma later_imp  : forall P Q,
-  |>(P --> Q) = |>P --> |>Q.
-Proof.
-  intros; repeat rewrite later_age.
-  apply pred_ext.
-  apply axiomK.
-  hnf; intros.
-  simpl; intros.
-  simpl in H.
-  destruct valid_rel_nec as (_ & H4 & _).
-  destruct (H4 _ _ H1 _ H0) as [? Hage ?].
-  lapply (H x x).
-  intros X.
-  eapply ext_age_commut in Hage as []; eauto.
-  eapply H; eauto.
-  intros.
-  replace a'1 with a''; auto.
-  congruence.
-Qed.*)
-
-Lemma TT_boxy  : forall M,
-  boxy M TT.
-Proof.
-  intros; hnf.
-  apply pred_ext; repeat intro; simpl; auto.
-Qed.
-
-Lemma positive_boxy  : forall P Q M,
-  boxy M P ->
-  (P |-- Q) ->
-  P |-- box M Q.
-Proof.
-  intros.
-  rewrite <- H.
-  apply box_positive.
-  auto.
-Qed.
-
-Lemma forallI  : forall A G X,
-  (forall x:A, G |-- X x) ->
-  G |-- allp X.
-Proof.
-  repeat intro.
-  eapply H; auto.
-Qed.
-
-Lemma TT_and  : forall P,
-  TT && P = P.
-Proof.
-  intros; apply pred_ext; repeat intro.
-  destruct H; auto.
-  split; simpl; auto.
-Qed.
-
-Lemma andp_comm  : forall P Q,
-  P && Q = Q && P.
-Proof.
-  intros; apply pred_ext; unfold andp; repeat intro; simpl in *; intuition.
-Qed.
-
-Lemma andp_assoc  : forall P Q R,
-  (P && Q) && R = P && (Q && R).
-Proof.
-  intros; apply pred_ext; auto; unfold derives, andp; simpl; intuition.
-Qed.
-
-Lemma ex_and : forall  B (P:B->pred) Q,
-  (exp P) && Q = EX x:B, P x && Q.
-Proof.
-  intros. apply pred_ext.
-  repeat intro. destruct H. destruct H.
-  exists x. split; auto.
-  repeat intro.
-  destruct H. destruct H.
-  split; auto. exists x; auto.
-Qed.
-
-Lemma FF_and : forall  (P:pred),
-  FF && P = FF.
-Proof.
-  intros. apply pred_ext; repeat intro.
-  destruct H; auto.
-  elim H.
-Qed.
-
-
-Lemma boxy_e : forall (M: modality) P,  boxy M P ->
-           forall w w', app_mode M w w' -> P w -> P w'.
-Proof.
-intros.
-rewrite <- H in H1; eauto.
-Qed.
-
-Lemma boxy_andp :
-     forall (M: modality), reflexive _ (app_mode M) ->
-      forall P Q, boxy M P -> boxy M Q -> boxy M (P && Q).
-Proof.
-destruct M;
-intros.
-simpl in *.
-apply boxy_i; intros; auto.
-destruct H3.
-simpl.
-split; eapply boxy_e; eauto.
-Qed.
-
-#[local] Hint Resolve boxy_andp : core.
-
-Lemma boxy_disjunction :
-     forall (M: modality) , reflexive _ (app_mode M) ->
-      forall P Q, boxy M P -> boxy M Q -> boxy M (P || Q).
-Proof.
-destruct M;
-intros.
-simpl in *.
-apply boxy_i; intros; auto.
-destruct H3.
-left.  eapply boxy_e; eauto.
-right. eapply boxy_e; eauto.
-Qed.
-
-#[local] Hint Resolve boxy_disjunction : core.
-
-Lemma boxy_exp :
-    forall (M: modality) T (P: T -> pred),
-     reflexive _ (app_mode M) ->
-     (forall x, boxy M (P x)) -> boxy M (exp P).
-Proof.
-intros.
-apply boxy_i; auto; intros.
-destruct H2 as [x ?].
-rewrite <- H0 in H2.
-specialize ( H2 w' H1).
-econstructor; eauto.
-Qed.
-
-#[local] Hint Resolve boxy_exp : core.
-
-Lemma boxy_prop :  forall (M: modality) P, reflexive _ (app_mode M) -> boxy M (prop P).
-Proof.
-intros.
-apply boxy_i; auto.
-Qed.
-
-Lemma boxy_TT :  forall (M: modality), reflexive _ (app_mode M) -> boxy M TT.
-Proof.
-intros.
-apply boxy_i; intros; auto.
-Qed.
-
-Lemma boxy_FF :  forall (M: modality), reflexive _ (app_mode M) -> boxy M FF.
-Proof.
-intros; apply boxy_i; intros; auto; contradiction.
-Qed.
-
-#[local] Hint Resolve boxy_TT : core.
-#[local] Hint Resolve boxy_FF : core.
-
-Lemma TT_i  : forall w: A,  app_pred TT w.
-Proof.
-unfold TT, prop; simpl; auto.
-Qed.
-
-#[local] Hint Resolve TT_i : core.
-
-Lemma prop_andp_left : forall (P: Prop) Q R, (P -> Q |-- R) -> !!P && Q |-- R.
-Proof.
- repeat intro. destruct H0; auto. apply H; auto.
-Qed.
-
-Lemma prop_andp_right : forall (P: Prop) Q R, P -> (Q |-- R) -> Q |-- !!P && R.
-Proof.
- repeat intro. split; auto.
-Qed.
-
-Lemma prop_true_andp:
-  forall (P: Prop) (Q: pred), P -> (!! P && Q = Q).
-Proof.
-intros.
-apply pred_ext.
-unfold derives; intros ? [? ?]; auto.
-unfold derives; intros; split; auto.
-Qed.
-
-Lemma prop_false_andp:
-  forall (P: Prop) (Q: pred), ~P -> !! P && Q = FF.
-Proof.
-intros.
-apply pred_ext.
-unfold derives; intros ? [? ?]; tauto.
-unfold derives. intros ? [].
-Qed.
-
-Lemma prop_andp_e :  forall P Q (w:A), (!! P && Q) w -> P /\ Q w.
-Proof.
-intuition; destruct H; auto.
-Qed.
-
-Lemma prop_andp_i :  forall P Q (w:A), P /\ app_pred Q w -> (!! P && Q) w.
-Proof.
-intuition.
-split; auto.
-Qed.
-
-Lemma later_derives : forall {P Q}, (P |-- Q) -> (|> P |-- |> Q).
-Proof.
-unfold derives; intros.
-intro; intros; eapply H.
-eauto.
-Qed.
-
-Lemma boxy_allp :
-  forall (M: modality) (B: Type) F,
-     reflexive _ (app_mode M) ->
-     (forall (x:B), boxy M (F x)) -> boxy M (allp F).
-Proof.
-intros.
-destruct M as [R V].
-simpl in *.
-apply boxy_i; auto.
-intros.
-simpl in *.
-intro.
-specialize (H2 b).
-rewrite <- H0 in H2.
-apply H2; auto.
-Qed.
-#[local] Hint Resolve boxy_allp : core.
-
-Lemma later_allp :
-       forall B P, |> (allp P) = allp (fun x:B => |> (P x)).
-Proof.
-intros.
-apply pred_ext; unfold derives; simpl; intros; eapply H; eauto.
-Qed.
-
-Lemma later_prop :
-       forall P: Prop, |> (prop P) |-- prop P || |> FF.
-Proof.
-  intros.
-  unfold derives; intros.
-  simpl in H |- *.
-  destruct (age1 a) eqn:?H; [left | right].
-  + apply (H a0).
-    unfold laterR.
-    constructor.
-    auto.
-  + intros.
-    clear - H0 H1.
-    induction H1.
-    - hnf in H; congruence.
-    - auto.
-Qed.
-
-Lemma box_derives  : forall M (P Q:pred),
-  (P |-- Q) ->  box M P |-- box M Q.
-Proof. exact box_positive. Qed.
-
-Lemma allp_derives:
-       forall (B: Type) (P Q: B -> pred),
-               (forall x:B, P x |-- Q x) -> (allp P |-- allp Q).
-Proof.
-intros.
-intros w b ?.
-eapply H; eauto.
-Qed.
-
-Lemma forall_pred_ext  : forall B (P Q: B -> pred),
- (ALL x : B, (P x <--> Q x)) |-- (ALL x : B, P x) <--> (ALL x: B, Q x) .
-Proof.
-intros.
-intros w ?.
-split; intros ? ? ? ? ? ?; destruct (H b); eauto.
-Qed.
-
-Lemma exists_pred_ext  : forall B (P Q: B -> pred),
- (ALL x : B, (P x <--> Q x)) |-- (EX x : B, P x) <--> (EX x: B, Q x) .
-Proof.
-intros.
-intros w ?.
-split; intros w' ? ? ? [? ?]; exists x; eapply H; eauto.
-Qed.
-
-Lemma imp_pred_ext  : forall B B' P Q,
-       (B <--> B') && (B --> (P <--> Q))
- |-- (B --> P) <-->  (B' --> Q).
-Proof.
-intros.
-intros w [? ?].
-split; intros ? w'' ? Hext ? ? w3 Hnec' ? ?.
-eapply nec_ext_commut in Hext as []; [|eauto].
-eapply H0.
-eapply rt_trans; eauto.
-etransitivity; eauto.
-eapply H.
-eapply rt_trans; eauto.
-etransitivity; eauto.
-auto.
-apply rt_refl.
-reflexivity.
-eapply H2; eauto.
-eapply H.
-eapply rt_trans; eauto.
-etransitivity; eauto.
-auto.
-eapply nec_ext_commut in Hext as []; [|eauto].
-eapply H0.
-eapply rt_trans; eauto.
-etransitivity; eauto.
-eapply H.
-eapply rt_trans; eauto.
-etransitivity; eauto.
-eapply H.
-eapply rt_trans; eauto.
-etransitivity; eauto.
-auto.
-apply rt_refl.
-reflexivity.
-eapply H2; eauto.
-eapply H.
-eapply rt_trans; eauto.
-etransitivity; eauto.
-auto.
-Qed.
-
-Lemma derives_refl:
-  forall (P: pred), (P |-- P).
-Proof. firstorder.
-Qed.
-
-#[local] Hint Resolve derives_refl : core.
-
-Lemma andp_derives :
-  forall P Q P' Q': pred, (P |-- P') -> (Q |-- Q') -> P && Q |-- P' && Q'.
-Proof.
-intros.
-intros w [? ?]; split; auto.
-Qed.
-
-Lemma orp_derives :
-  forall P Q P' Q': pred, (P |-- P') -> (Q |-- Q') -> P || Q |-- P' || Q'.
-Proof.
-intros.
- apply orp_left. apply orp_right1; auto. apply orp_right2; auto.
-Qed.
-
-Lemma exp_derives :
-       forall B (P: B -> pred) Q , (forall x:B, P x |-- Q x) -> (exp P |-- exp Q).
-Proof.
-intros.
-intros w [b ?].
-exists b; eapply H; eauto.
-Qed.
-
-Lemma box_ext : forall (M: modality) P Q,
-    box M (P <--> Q) |--  box M P <--> box M Q.
-Proof.
-intros.
-repeat rewrite box_and.
-apply andp_right;
-eapply derives_trans; try apply axiomK; intros ? [? ?]; auto.
-Qed.
-
-Lemma andp_pred_ext : forall P Q P' Q',
-       (P <--> P') && (Q <--> Q') |--  (P && Q) <--> (P' && Q').
-Proof.
-intros.
-intros w [? ?].
-split; (intros w' ? ? ? [? ?]; split; [eapply H; eauto | eapply H0; eauto]).
-Qed.
-
-Program Definition exactly  (x: A) : pred := fun w => exists y, necR x y /\ ext_order y w.
-Next Obligation.
-destruct H0 as (? & Hnec & Hext).
-eapply age_ext_commut in Hext as [? Hext ?]; eauto.
-do 2 eexists; [|apply Hext].
-eapply rt_trans; eauto.
-apply rt_step; auto.
-
-destruct H0 as (? & Hnec & Hext).
-do 2 eexists; eauto.
-etransitivity; eauto.
-Qed.
-
-Lemma derives_TT : forall (P: pred), P |-- TT.
-Proof.
-intros.
-intros ? ?; auto.
-Qed.
-#[local] Hint Resolve derives_TT : core.
-
-Lemma FF_derives : forall P, FF |-- P.
-Proof.
-intros. intros ? ?. hnf in H; contradiction.
-Qed.
-#[local] Hint Immediate FF_derives : core.
-
-Lemma necR_level' : forall {w w': A}, necR w w' ->
-       @necR _ ag_nat (level w) (level w').
-Proof.
-induction 1; simpl; intros.
-apply age_level in H. constructor 1.  unfold age, age1; simpl.  rewrite H; reflexivity.
-constructor 2.
-constructor 3 with (level y); auto.
-Qed.
-
-Lemma derives_imp :
-  forall P Q w, (P |-- Q) -> (P --> Q) w.
-Proof.
-intros.
-intros ????; auto.
-Qed.
-
-Lemma exp_andp1 :
- forall B (p: B -> pred) q, (exp p && q)%pred = (exp (fun x => p x && q))%pred.
-Proof.
-intros; apply pred_ext; intros w ?.
-destruct H.
-destruct H.
-exists x; split; auto.
-destruct H. destruct H.
-split; auto.
-exists x; auto.
-Qed.
-
-Lemma exp_andp2 :
- forall B p (q: B -> pred), (p && exp q)%pred = (exp (fun x => p && q x))%pred.
-Proof.
-intros; apply pred_ext; intros w ?.
-destruct H.
-destruct H0.
-exists x; split; auto.
-destruct H. destruct H.
-split; auto.
-exists x; auto.
-Qed.
-
-Lemma exp_imp_left :  forall B (p: B -> pred) q,
-     (exp p --> q)%pred = allp (fun x => p x --> q)%pred.
-Proof.
-intros; apply pred_ext; intros w ?.
-intro.
-intros ? ?w ? ? ?.
-eapply H; eauto.
-exists b; auto.
-intros ?w ? ? ? [? ?].
-eapply H; eauto.
-Qed.
-
-Lemma app_ext  : forall (F G: A -> Prop) p1 p2 w,
-         (F w = G w) ->
-         app_pred (exist (fun P => hereditary age P /\ hereditary ext_order P) F p1) w = app_pred (exist (fun P => hereditary age P /\ hereditary ext_order P) G p2) w.
-Proof.
-simpl; auto.
-Qed.
-
-Lemma imp_derives :
-  forall P P' Q Q',
-    (P' |-- P) ->
-    (Q |-- Q') ->
-    P --> Q |-- P' --> Q'.
-Proof.
-intros.
-intros w ? ? w'' ? ? ?.
-apply H0.
-eapply H1; eauto.
-Qed.
-
-
-Lemma imp_lem0  :  forall P st, (TT --> P) st -> P st.
-Proof.
-intros; eauto.
-Qed.
-
-Lemma conjoin_hyp0  :
-      forall (P Q: pred) w,  P w -> (P --> Q) w -> (TT --> Q) w.
-Proof.
-intros.
-intros w' ? ? ? ?.
-eapply H0;
-eauto.
-eapply pred_nec_hereditary, pred_upclosed in H; eauto.
-Qed.
-
-Lemma conjoin_hyp1 : forall (P Q R: pred)  w,
-            P w -> (P&&Q --> R) w -> (Q --> R) w.
-Proof.
-intros.
-intros w' ? ? ? ?.
-eapply H0; try eassumption.
-split; eauto.
-eapply pred_nec_hereditary, pred_upclosed in H; eauto.
-Qed.
-
-Lemma derives_e : forall p q (st: A),
-      (p |-- q) -> p st -> q st.
-Proof.
-auto.
-Qed.
-
-Lemma later_andp :
-  forall P Q, |> (P && Q) = |>P && |>Q.
-Proof.
-intros.
-apply pred_ext; intros w ?.
-split; intros w' ?; destruct (H _ H0); auto.
-destruct H.
-intros w' ?; split; eauto.
-Qed.
-
-Lemma True_andp_eq :
-  forall (P: Prop) (Q: pred), P -> (!!P && Q)%pred = Q.
-intros.
-apply pred_ext; intros w ?; hnf in *; simpl; intros; intuition.
-Qed.
-
-Lemma distrib_orp_andp :
-   forall P Q R, (P||Q)&&R = (P&&R)||(Q&&R).
-Proof.
-  intros. apply pred_ext.
-  intros w [[?|?] ?]; [left|right]; split; auto.
-  intros w [[? ?]|[? ?]]; split; auto. left; auto. right; auto.
-Qed.
-
-Lemma allp_right {B: Type}:
-  forall (P: pred) (Q: B -> pred),
-  (forall v, P |-- Q v) ->
-   P |-- allp Q.
-Proof.
- intros. intros w ? v; apply (H v); auto.
-Qed.
-
-Lemma allp_left {B}:
-   forall (P: B -> pred) x Q, (P x |-- Q) -> allp P |-- Q.
- Proof.
-   intros. intros ? ?. apply H. apply H0.
-Qed.
-
-(*Lemma later_imp2 : forall P Q: pred,
-                 |> (P <--> Q) = |> P <--> |> Q.
-Proof.
- intros.
-  repeat rewrite <- later_imp. rewrite <- later_andp; auto.
-Qed.*)
-
-End Order.
-
-Arguments pred A {AG EO}.
-
-#[export] Hint Resolve pred_hereditary : core.
-#[export] Hint Resolve rt_refl rt_trans t_trans : core.
-#[export] Hint Unfold necR : core.
-#[export] Hint Resolve boxy_andp : core.
-#[export] Hint Resolve boxy_disjunction : core.
-#[export] Hint Resolve boxy_exp : core.
-#[export] Hint Resolve boxy_TT : core.
-#[export] Hint Resolve boxy_FF : core.
-#[export] Hint Resolve TT_i : core.
-#[export] Hint Resolve boxy_allp : core.
-#[export] Hint Resolve derives_refl : core.
-#[export] Hint Resolve derives_TT : core.
-#[export] Hint Immediate FF_derives : core.
-
-Declare Scope pred_derives.
-Notation "P '|--' Q" := (derives P%pred Q%pred) (at level 80, no associativity) : pred_derives.
-Open Scope pred_derives.
-Notation "'EX' x .. y , P " :=
-  (exp (fun x => .. (exp (fun y => P%pred)) ..)) (at level 65, x binder, y binder, right associativity) : pred.
-Notation "'ALL' x .. y , P " :=
-  (allp (fun x => .. (allp (fun y => P%pred)) ..)) (at level 65, x binder, y binder, right associativity) : pred.
-Infix "||" := orp (at level 50, left associativity) : pred.
-Infix "&&" := andp (at level 40, left associativity) : pred.
-Notation "P '-->' Q" := (imp P Q) (at level 55, right associativity) : pred.
-Notation "P '<-->' Q" := (andp (imp P Q) (imp Q P)) (at level 57, no associativity) : pred.
-(* Notation "'[]' e" := (box necM e) (at level 30, right associativity): pred. *)
-Notation "'|>' e" := (box laterM e) (at level 20, right associativity): pred.
-Notation "'!!' e" := (prop e) (at level 15) : pred.
-
-Ltac slurp :=
- apply imp_lem0;
-  match goal with |-  app_pred (_ --> _)  ?st =>
-        repeat match goal with
-                   | H: app_pred ?P st |- app_pred (?b --> ?c) st =>
-                       (apply (@conjoin_hyp0 _ _ _ P c st H) ||
-                        (apply (@conjoin_hyp1 _ _ _ P b c st H)));
-                       clear H
-                   end;
-        try (revert st; apply derives_e)
-  end.
-
-Lemma test_slurp {A} {agA : ageable A} {EO : Ext_ord A} :  forall (P Q R S : pred A) w ,
-        (P && (Q && R) --> S) w -> P w -> Q w -> R w -> S w.
-Proof.
-intros.
-remember (app_pred (P && (Q && R) --> S) w) as hide.
-slurp.
-subst hide. assumption.
-Qed.
diff --git a/msl/predicates_hered_simple.v b/msl/predicates_hered_simple.v
deleted file mode 100644
index 10baa746ff..0000000000
--- a/msl/predicates_hered_simple.v
+++ /dev/null
@@ -1,1339 +0,0 @@
-(*
- * Copyright (c) 2009-2010, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-
-Require Import VST.msl.base.
-Require Import VST.msl.ageable.
-
-Declare Scope pred.
-Delimit Scope pred with pred.
-Local Open Scope pred.
-
-(* A "pre-predicate" is hereditary iff whenever it is
-   true at world a, it is also true at all worlds
-   accessable from a via R.
- *)
-Definition hereditary {A} (R:A->A->Prop) (p:A->Prop) :=
-  forall a a':A, R a a' -> p a -> p a'.
-
-(* A predicate is a hereditary pre-predicate *)
-Definition pred (A:Type) {AG:ageable A} :=
-  { p:A -> Prop | hereditary age p }.
-
-Bind Scope pred with pred.
-
-(* Here is some junk that makes the definition of "pred" opaque
-   to most tactics but still allows the "Program" extension to
-   see it is a subset type.  The coercion is sugar that allows us to use
-   predicates easily.
- *)
-Definition app_pred {A} `{ageable A} (p:pred A) : A -> Prop := proj1_sig p.
-Definition pred_hereditary `{ageable} (p:pred A) := proj2_sig p.
-Coercion app_pred : pred >-> Funclass.
-Global Opaque pred.
-
-#[export] Hint Resolve pred_hereditary : core.
-
-Lemma nec_hereditary {A} `{ageable A} (p: A -> Prop) : hereditary age p ->
-  forall a a':A, necR a a' -> p a -> p a'.
-Proof.
-  intros.
-  induction H1; auto.
-  apply H0 with x; auto.
-Qed.
-
-Lemma pred_nec_hereditary {A} `{ageable A} (p:pred A) :
-  forall a a':A, necR a a' -> p a -> p a'.
-Proof.
-  apply nec_hereditary, pred_hereditary.
-Qed.
-
-Program Definition mkPred {A} `{ageable A} (p:A -> Prop) : pred A :=
-  fun x => forall x', necR x x' -> p x'.
-Next Obligation.
-  repeat intro.
-  apply H1.
-  apply rt_trans with a'; auto.
-  apply rt_step; auto.
-Qed.
-
-(* The semantic notion of entailment.
- *)
-Definition derives {A} `{ageable A} (P Q:pred A) := forall a:A, P a -> Q a.
-Arguments derives [A] [H] _ _.
-
-(* "valid" relations are those that commute with aging.  These
-   relations are the ones that can be turned into modalities.
- *)
-Definition valid_rel {A} `{ageable A} (R:relation A) : Prop :=
-  commut A age R /\ commut A R age.
-
-(* A modaility is a valid relation *)
-Definition modality {A} `{ageable A} := { R:relation A | valid_rel R }.
-
-(* More black magic to make the definition of modaility mostly opaque. *)
-Definition app_mode {A} `{ageable A} (m:modality) : A -> A -> Prop := proj1_sig m.
-Definition mode_valid {A} `{ageable A} (m:modality) := proj2_sig m.
-Global Opaque modality.
-Coercion app_mode : modality >-> Funclass.
-
-(* commutivity facts for the basic relations *)
-
-Lemma valid_rel_commut_later1 {A} `{ageable A} : forall R,
-  valid_rel R ->
-  commut A laterR R.
-Proof.
-  intros; hnf; intros.
-  revert z H2.
-  induction H1; intros.
-  destruct H0.
-  destruct (H0 _ _ H1 _ H2).
-  exists x0; auto.
-  apply t_step; auto.
-  destruct (IHclos_trans1 _ H2).
-  destruct (IHclos_trans2 _ H1).
-  exists x1; auto.
-  eapply t_trans; eauto.
-Qed.
-
-Lemma valid_rel_commut_later2 {A} `{ageable A} : forall R,
-  valid_rel R ->
-  commut A R laterR.
-Proof.
-  intros; hnf; intros.
-  revert x H1.
-  induction H2; intros.
-  destruct H0.
-  destruct (H3 _ _ H2 _ H1).
-  exists x1; auto.
-  apply t_step; auto.
-  destruct (IHclos_trans2 _ H1).
-  destruct (IHclos_trans1 _ H3).
-  exists x2; auto.
-  eapply t_trans; eauto.
-Qed.
-
-Lemma valid_rel_commut_nec1 {A} `{ageable A} : forall R,
-  valid_rel R ->
-  commut A necR R.
-Proof.
-  intros; hnf; intros.
-  apply nec_refl_or_later in H1; destruct H1; subst.
-  exists z; auto.
-  destruct (valid_rel_commut_later1 R H0 x y H1 z H2).
-  exists x0; auto.
-  apply Rt_Rft; auto.
-Qed.
-
-Lemma valid_rel_commut_nec2 {A} `{ageable A} : forall R,
-  valid_rel R ->
-  commut A R necR.
-Proof.
-  intros; hnf; intros.
-  apply nec_refl_or_later in H2; destruct H2; subst.
-  exists x; auto.
-  destruct (valid_rel_commut_later2 R H0 x y H1 z H2).
-  exists x0; auto.
-  apply Rt_Rft; auto.
-Qed.
-
-Lemma valid_rel_age {A} `{ageable A} : valid_rel age.
-Proof.
-  intros; split; hnf; intros; firstorder.
-Qed.
-
-Lemma valid_rel_later {A} `{ageable A} : valid_rel laterR.
-Proof.
-  intros; split; hnf; intros.
-  revert x H0.
-  induction H1; intros.
-  exists y; auto.
-  apply t_step; auto.
-  destruct (IHclos_trans2 _ H0).
-  destruct (IHclos_trans1 _ H2).
-  exists x2; auto.
-  eapply t_trans; eauto.
-
-  revert z H1.
-  induction H0; intros.
-  exists x; auto.
-  apply t_step; auto.
-  destruct (IHclos_trans1 _ H1).
-  destruct (IHclos_trans2 _ H0).
-  exists x1; auto.
-  eapply t_trans; eauto.
-Qed.
-
-Lemma valid_rel_nec {A} `{ageable A} : valid_rel necR.
-Proof.
-  intros; split; hnf; intros.
-  revert x H0.
-  induction H1; intros.
-  exists y; auto.
-  apply rt_step; auto.
-  exists x0; auto.
-  destruct (IHclos_refl_trans2 _ H0).
-  destruct (IHclos_refl_trans1 _ H2).
-  exists x2; auto.
-  eapply rt_trans; eauto.
-
-  revert z H1.
-  induction H0; intros.
-  exists x; auto.
-  apply rt_step; auto.
-  exists z; auto.
-
-  destruct (IHclos_refl_trans1 _ H1).
-  destruct (IHclos_refl_trans2 _ H0).
-  exists x1; auto.
-  eapply rt_trans; eauto.
-Qed.
-
-(* Definitions of the basic modalities.
- *)
-Definition ageM {A} `{ageable A} : modality
-  := exist _ age valid_rel_age.
-Definition laterM {A} `{ageable A} : modality
-  := exist _ laterR valid_rel_later.
-(*
-Definition necM {A} `{ageable A} : modality
-  := exist _ necR valid_rel_nec.
-*)
-
-#[export] Hint Resolve rt_refl rt_trans t_trans : core.
-#[export] Hint Unfold necR : core.
-Local Obligation Tactic := unfold hereditary; intuition;
-    first [eapply pred_hereditary; eauto; fail | eauto ].
-
-(* Definitions of the basic propositional conectives.
- *)
-
-(* Lifting pure mathematical facts to predicates *)
-
-Program Definition prop {A} `{ageable A}  (P: Prop) : pred A := (fun _  => P).
-
-Definition TT {A} `{ageable A}: pred A := prop True.
-Definition FF  {A} `{ageable A}: pred A := prop False.
-
-Program Definition imp {A} `{ageable A} (P Q:pred A) : pred A :=
-   fun a:A => forall a':A, necR a a' -> P a' -> Q a'.
-Next Obligation.
-  apply H1; auto.
-  apply rt_trans with a'; auto.
-  apply rt_step; auto.
-Qed.
-Program Definition orp {A} `{ageable A} (P Q:pred A) : pred A :=
-   fun a:A => P a \/ Q a.
-Next Obligation.
-  left; eapply pred_hereditary; eauto.
-  right; eapply pred_hereditary; eauto.
-Qed.
-
-Program Definition andp {A} `{ageable A} (P Q:pred A) : pred A :=
-   fun a:A => P a /\ Q a.
-
-(* Universal and exp quantification
- *)
-
-Program Definition allp {A} `{ageable A} {B: Type} (f: B -> pred A) : pred A
-  := fun a => forall b, f b a.
-Next Obligation.
-  apply pred_hereditary with a; auto.
-  apply H1.
-Qed.
-
-Program Definition exp {A} `{ageable A} {B: Type} (f: B -> pred A) : pred A
-  := fun a => exists b, f b a.
-Next Obligation.
-  destruct H1; exists x; eapply pred_hereditary; eauto.
-Qed.
-
-
-(* Definition of the "box" modal operator.  This operator turns
-   modalities (relations) into a "necessarily" type operator.
- *)
-
-Program Definition box {A} `{ageable A} (M:modality) (P:pred A) : pred A :=
-  fun a:A => forall a', M a a' -> P a'.
-Next Obligation.
-  destruct M as [M [H3 H4]]; simpl in *.
-  destruct (H4 _ _ H2 _ H0).
-  apply pred_hereditary with x; auto.
-  apply H1; auto.
-Qed.
-
-(* Definition of the "diamond" modal operator.  This operator
-   turns modalities into a "possibly" type operator.  _However_,
-   note that this is NOT the boolean dual to "box", as usually
-   found in accounts of modal logic. Instead, this is the
-   "proof-theoretic" dual as found in Restall's "A Introduction
-   to Substructural Logic" (2000).
- *)
-
-Program Definition diamond {A} `{ageable A} (M:modality) (P:pred A) : pred A :=
-  fun a:A => exists a', M a' a /\ P a'.
-Next Obligation.
-  destruct M as [M [H3 H4]]; simpl in *.
-  destruct H1 as [x [? ?]].
-  destruct (H3 _ _ H0 _ H1).
-  exists x0; split; auto.
-  apply pred_hereditary with x; auto.
-Qed.
-
-Definition boxy {A} `{ageable A} (m: modality) (p: pred A): Prop :=  box m p = p.
-
-(* A pile of notations for the operators we have defined *)
-Declare Scope pred_derives.
-Notation "P '|--' Q" := (derives P%pred Q%pred) (at level 80, no associativity) : pred_derives.
-Open Scope pred_derives.
-Notation "'EX' x .. y , P " :=
-  (exp (fun x => .. (exp (fun y => P%pred)) ..)) (at level 65, x binder, y binder, right associativity) : pred.
-Notation "'ALL' x .. y , P " :=
-  (allp (fun x => .. (allp (fun y => P%pred)) ..)) (at level 65, x binder, y binder, right associativity) : pred.
-Infix "||" := orp (at level 50, left associativity) : pred.
-Infix "&&" := andp (at level 40, left associativity) : pred.
-Notation "P '-->' Q" := (imp P Q) (at level 55, right associativity) : pred.
-Notation "P '<-->' Q" := (andp (imp P Q) (imp Q P)) (at level 57, no associativity) : pred.
-(* Notation "'[]' e" := (box necM e) (at level 30, right associativity): pred. *)
-Notation "'|>' e" := (box laterM e) (at level 20, right associativity): pred.
-Notation "'!!' e" := (prop e) (at level 15) : pred.
-
-(* Rules for the propositional connectives *)
-Lemma modus_ponens {A} `{ageable A} : forall (X P Q:pred A),
-  (X |-- P) ->
-  (X |-- (P --> Q)) ->
-  X |-- Q.
-Proof.
-  unfold derives, imp; simpl; intuition eauto.
-Qed.
-
-Lemma andp_right {A} `{ageable A} : forall (X P Q:pred A),
-  (X |-- P) ->
-  (X |-- Q) ->
-  X |-- P && Q.
-Proof.
-  unfold derives, imp, andp; simpl; intuition.
-Qed.
-
-
-  Lemma pred_ext' {A} `{ageable A}: forall (p1 p2:pred A),
-    app_pred p1 = app_pred p2 ->
-    p1 = p2.
-  Proof.
-    intros; destruct p1; destruct p2; simpl in H.
-   simpl in H0.
-    subst x0.
-    replace h0 with h by apply proof_irr.
-    auto.
-  Qed.
-
-Lemma pred_ext : forall A `{ageable A} (P Q:pred A),
-  derives P Q -> derives Q P -> P = Q.
-Proof.
-  intros.
-  destruct P as [P HP].
-  destruct Q as [Q HQ].
-  unfold derives in *. simpl in *.
-   apply (exist_ext (A->Prop) (fun p => hereditary (@age _ H) p)).
-  extensionality a.
-  apply prop_ext; intuition.
-Qed.
-
-Lemma andp_dup {A}{agA: ageable A}: forall P: pred A, P && P = P.
-Proof. intros. apply pred_ext; intros w ?. destruct H; auto. split; auto.
-Qed.
-
-Lemma andp_left1{A}{agA: ageable A}: forall P Q R: pred A,  (P |-- R) -> P && Q |-- R.
-Proof. repeat intro. destruct H0; auto.
-Qed.
-
-Lemma andp_left2{A}{agA: ageable A}: forall P Q R: pred A,  (Q |-- R) -> P && Q |-- R.
-Proof. repeat intro. destruct H0; auto.
-Qed.
-
-Lemma orp_left{A}{agA: ageable A}: forall P Q R: pred A,  (P |-- R) -> (Q |-- R) -> P || Q |-- R.
-Proof. repeat intro. destruct H1; auto.
-Qed.
-
-Lemma orp_right1{A}{agA: ageable A}: forall P Q R: pred A,  (P |-- Q) -> P |-- Q || R.
-Proof. repeat intro. left; auto.
-Qed.
-
-Lemma orp_right2{A}{agA: ageable A}: forall P Q R: pred A,  (P |-- R) -> P |-- Q || R.
-Proof. repeat intro. right; auto.
-Qed.
-
-Lemma orp_assoc {A} `{ageable A} : forall P Q R: pred A, (P || Q) || R = P || (Q || R).
-Proof.
-  intros; apply pred_ext; auto; unfold derives, andp; simpl; intuition.
-Qed.
-
-Lemma derives_trans {A}`{ageable A}:
-    forall P Q R: pred A, (P |-- Q) -> (Q |-- R) -> P |-- R.
-Proof. firstorder. Qed.
-
-Lemma exp_right:
-  forall {B A: Type}{agA: ageable A}(x:B) p (q: B -> pred A),
-    (p |-- q x) ->
-    p |-- exp q.
-Proof.
-intros.
-eapply derives_trans; try apply H.
-intros w ?; exists x; auto.
-Qed.
-
-Lemma exp_left:
-  forall {B A: Type}{agA: ageable A}(p: B -> pred A) q,
-  (forall x, p x |-- q) ->
-   exp p |-- q.
-Proof.
-intros.
-intros w [x' ?].
-eapply H; eauto.
-Qed.
-
-Lemma and1 {A} `{ageable A} : forall (X P Q:pred A),
-  X |-- P && Q --> P.
-Proof.
-  unfold derives, imp, andp; simpl; intuition eauto.
-Qed.
-
-Lemma and2 {A} `{ageable A} : forall (X P Q:pred A),
-  X |-- P && Q --> Q.
-Proof.
-  unfold derives, imp, andp; simpl; intuition eauto.
-Qed.
-
-Lemma and3 {A} `{ageable A} : forall (X P Q R:pred A),
-  X |-- (P --> Q) --> (P --> R) --> (P --> Q && R).
-Proof.
-  unfold derives, imp, andp; simpl; intuition eauto.
-Qed.
-
-Lemma or1 {A} `{ageable A} : forall (X P Q:pred A),
-  X |-- P --> P || Q.
-Proof.
-  unfold derives, imp, orp; simpl; intuition.
-Qed.
-
-Lemma or2 {A} `{ageable A} : forall (X P Q:pred A),
-  X |-- Q --> P || Q.
-Proof.
-  unfold derives, imp, orp; simpl; intuition.
-Qed.
-
-Lemma or3 {A} `{ageable A} : forall (X P Q R:pred A),
-  X |-- (P --> R) --> (Q --> R) --> (P || Q --> R).
-Proof.
-  unfold derives, imp, orp; simpl; intuition eauto.
-Qed.
-
-Lemma TTrule {A} `{ageable A} : forall X P,
-  X |-- P --> TT.
-Proof.
-  unfold derives, imp, TT; simpl; intuition.
-Qed.
-
-Lemma FFrule {A} `{ageable A} : forall X P,
-  X |-- FF --> P.
-Proof.
-  unfold derives, imp, FF; simpl; intuition.
-Qed.
-
-Lemma distribution {A} `{ageable A} : forall (X P Q R:pred A),
-  X |-- P && (Q || R) --> (P && Q) || (P && R).
-Proof.
-  unfold derives, imp, orp, andp; simpl; intuition.
-Qed.
-
-(* Characterize the relation between conjunction and implication *)
-Lemma imp_andp_adjoint {A} `{ageable A} : forall (P Q R:pred A),
-  ((P && Q) |-- R) <-> (P |-- (Q --> R)).
-Proof.
-  split; intros.
-  hnf; intros; simpl; intros.
-  apply H0.
-  split; auto.
-  apply pred_nec_hereditary with a; auto.
-  hnf; intros.
-  hnf in H0.
-  unfold imp in H0; simpl in H0.
-  destruct H1.
-  apply H0 with a; auto.
-Qed.
-
-(* Some facts about modalities *)
-
-Lemma box_e0 {A} `{ageable A}: forall (M: modality) Q,
-            reflexive _ M -> box M Q  |-- Q.
-Proof.
-intros.
-intro; intros.
-apply H1; simpl.
-apply H0.
-Qed.
-Arguments box_e0 [A] _ _ _ _ _ _.
-
-Lemma boxy_i {A} `{ageable A}:
-  forall (Q: pred A) (M: modality),
-    reflexive _ M ->
-    (forall w w', M w w' -> Q w -> Q w') ->
-    boxy M Q.
-Proof.
-intros.
-unfold boxy.
-apply pred_ext; hnf; intros.
-eapply box_e0; eauto.
-hnf; intros.
-eapply H1; eauto.
-Qed.
-
-(*
-Lemma necM_refl {A} `{ageable A}: reflexive _ necM.
-Proof.
-intros; intro; simpl.
-unfold necR.
-constructor 2.
-Qed.
-
-#[export] Hint Resolve necM_refl.
-*)
-
-(* relationship between box and diamond *)
-Lemma box_diamond {A} `{ageable A} : forall M (P Q:pred A),
-  ((diamond M P) |-- Q) <-> (P |-- (box M Q)).
-Proof.
-  unfold derives; intuition.
-  hnf; intros.
-  apply H0.
-  hnf; eauto.
-  destruct H1 as [a' [? ?]].
-  apply H0 with a'; auto.
-Qed.
-
-(* Box is a normal modal operator *)
-
-Lemma ruleNec {A} `{ageable A} : forall M (P:pred A),
-  derives TT P ->
-  derives TT (box M P).
-Proof.
-  intros.
-  rewrite <- box_diamond.
-  hnf; intros.
-  apply H0; hnf; auto.
-Qed.
-
-Lemma axiomK {A} `{ageable A}: forall M (P Q:pred A),
-  (box M (P --> Q)) |-- (box M P --> box M Q).
-Proof.
-  intros; do 3 (hnf; intros).
-  destruct M as [R HR]; simpl in *.
-  destruct (valid_rel_commut_nec2 R HR _ _ H3 _ H1).
-  apply H0 with x; auto.
-Qed.
-
-(* Box and diamond are positive modal operators *)
-
-Lemma box_positive {A} `{ageable A} : forall M (P Q:pred A),
-  (P |-- Q) ->
-  box M P |-- box M Q.
-Proof.
-  unfold derives, box; simpl; intuition.
-Qed.
-
-Lemma diamond_positive {A} `{ageable A} : forall M (P Q:pred A),
-  (P |-- Q) ->
-  diamond M P |-- diamond M Q.
-Proof.
-  unfold derives, diamond; simpl; firstorder.
-Qed.
-
-Lemma box_refl_trans {A} `{ageable A}: forall (m:modality) p,
-  reflexive _ m ->
-  transitive _ m ->
-  box m (box m p) = box m p.
-Proof.
-  intros.
-  apply pred_ext.
-  repeat intro.
-  assert (box m p a').
-  apply H2; auto.
-  apply H4.
-  apply H0.
-  repeat intro.
-  apply H2.
-  eapply H1; eauto.
-Qed.
-
-(* Disribuitivity of box over various connectives *)
-
-Lemma box_and {A} `{ageable A}: forall R (P Q:pred A),
-  box R (P && Q) = box R P && box R Q.
-Proof.
-  intros; apply pred_ext; hnf; intuition;
-    unfold andp, box in *; simpl in *; firstorder.
-Qed.
-
-Lemma box_all {A} `{ageable A} : forall B R (F:B -> pred A),
-  box R (allp F) = ALL x:B, box R (F x).
-Proof.
-  intros; apply pred_ext; hnf; intuition;
-    unfold allp, box in *; simpl in *; firstorder.
-Qed.
-
-Lemma box_ex {A} `{ageable A} : forall B R (F:B->pred A),
-  EX x:B, box R (F x) |-- box R (exp F).
-Proof.
-  unfold derives, exp, box; simpl; firstorder.
-Qed.
-
-Lemma box_or {A} `{ageable A} : forall R (P Q:pred A),
-   box R P || box R Q |-- box R (P || Q).
-Proof.
-  unfold derives, orp, box; simpl; firstorder.
-Qed.
-
-(* Distributivity of diamond over various operators *)
-
-Lemma diamond_or {A} `{ageable A} : forall R (P Q:pred A),
-  diamond R (P || Q) = diamond R P || diamond R Q.
-Proof.
-  intros; apply pred_ext; hnf; intuition;
-    unfold diamond, orp in *; simpl in *; firstorder.
-Qed.
-
-Lemma diamond_ex {A} `{ageable A} : forall B R (F:B -> pred A),
-  diamond R (exp F) = EX x:B, diamond R (F x).
-Proof.
-  intros; apply pred_ext; hnf; intuition;
-    unfold diamond, exp in *; simpl in *; firstorder.
-Qed.
-
-Lemma diamond_and {A} `{ageable A} : forall R (P Q:pred A),
-  diamond R (P && Q) |-- diamond R P && diamond R Q.
-Proof.
-  unfold derives, andp, diamond; simpl; firstorder.
-Qed.
-
-Lemma diamond_all {A} `{ageable A} : forall B R (F:B->pred A),
-  diamond R (allp F) |-- ALL x:B, diamond R (F x).
-Proof.
-  unfold derives, allp, diamond; simpl; firstorder.
-Qed.
-
-
-(* Lemmas about aging and the later operator *)
-
-(*
-Lemma nec_useless {A} `{ageable A} :
-  forall P, []P = P.
-intros.
-  apply pred_ext; intros.
-  hnf; intros; apply H0.
-  simpl; apply necM_refl.
-  hnf; intros.
-  hnf; intros.
-  apply pred_nec_hereditary with a; auto.
-Qed.
-*)
-
-Lemma later_age {A} `{ageable A} : forall P,
-  |>P = box ageM P.
-Proof.
-  intros; apply pred_ext; do 2 (hnf; intros).
-  simpl in H0.
-  apply H0.
-  apply t_step; auto.
-  revert H0; induction H1; intros.
-  apply H1; auto.
-  apply pred_nec_hereditary with y.
-  apply Rt_Rft; auto.
-  apply IHclos_trans1; auto.
-Qed.
-
-Lemma now_later {A} `{ageable A} : forall P,
-  P |-- |>P.
-Proof.
-  repeat intro.
-  apply pred_nec_hereditary with a; auto.
-  apply Rt_Rft; auto.
-Qed.
-
-Lemma now_later2 {A} `{ageable A} : forall G P,
-  (G |-- P) ->
-  G |-- |>P.
-Proof.
-  intros; apply @derives_trans with P; auto.
-  apply now_later.
-Qed.
-
-(* The "induction" rule for later *)
-
-Lemma goedel_loeb {A} `{ageable A} : forall (P Q:pred A),
-  (Q && |>P |-- P) ->
-  Q |-- P.
-Proof.
-  intros; hnf; intro a.
-  induction a using age_induction.
-  intros; simpl in H0.
-  eapply H0; auto.
-  split; auto.
-  rewrite later_age.
-  simpl; intros.
-  apply H1; auto.
-  apply pred_hereditary with x; auto.
-Qed.
-
-Lemma loeb {A} `{ageable A} : forall (P:pred A),
-     (|>P |-- P)    ->     TT |-- P.
-Proof.
-  intros. apply goedel_loeb.
-  apply andp_left2. auto.
-Qed.
-
-(* Later distributes over almost everything! *)
-
-Lemma later_commute_dia {A} `{ageable A} : forall M (P:pred A),
-  diamond M (|> P) |-- |> (diamond M P).
-Proof.
-  intros.
-  repeat rewrite later_age.
-  do 3 (hnf; intros).
-  simpl in H0.
-  firstorder.
-  destruct M as [R HR].
-  simpl in *.
-  destruct HR.
-  destruct (H3 _ _ H1 _ H0).
-  exists x0; split; auto.
-Qed.
-
-Lemma later_commute {A} `{ageable A} : forall M (P:pred A),
-  box M (|>P) = |>(box M P).
-Proof.
-  intros.
-  apply pred_ext; do 3 (hnf; intros).
-  destruct M as [R HR].
-  destruct (valid_rel_commut_later2 R HR _ _ H2 _ H1).
-  apply H0 with x; simpl; auto.
-  destruct M as [R HR].
-  destruct (valid_rel_commut_later1 R HR _ _ H2 _ H1).
-  apply H0 with x; auto.
-Qed.
-
-Lemma later_and {A} `{ageable A} : forall P Q,
-  |>(P && Q) = |>P && |> Q.
-Proof.
-  intros; apply box_and.
-Qed.
-
-Lemma later_or {A} `{ageable A} : forall (P Q:pred A),
-  |>(P || Q) = |>P || |>Q.
-Proof.
-  intros.
-  repeat rewrite later_age.
-  apply pred_ext.
-  2: apply box_or.
-  hnf; intros.
-  simpl in H0.
-  case_eq (age1 a); intros.
-  destruct (H0 a0); auto.
-  left; simpl; intros.
-  replace a' with a0; auto.
-  congruence.
-  right; simpl; intros.
-  replace a' with a0; auto.
-  congruence.
-  left.
-  hnf; simpl; intros.
-  hnf in H2.
-  rewrite H1 in H2; discriminate.
-Qed.
-
-Lemma later_ex {A} `{ageable A} : forall B (F:B->pred A),
-  B ->
-  |>(exp F) = EX x:B, |>(F x).
-Proof.
-  intros.
-  apply pred_ext.
-  2: apply box_ex.
-  hnf; intros.
-  rewrite later_age in H0.
-  case_eq (age1 a); intros.
-  destruct (H0 a0); auto.
-  exists x.
-  rewrite later_age; simpl; intros.
-  replace a' with a0; auto.
-  congruence.
-  exists X.
-  rewrite later_age.
-  hnf; simpl; intros.
-  unfold age in H2.
-  rewrite H1 in H2; discriminate.
-Qed.
-
-Lemma later_ex'' {A} `{ageable A} : forall B (F:B->pred A),
-  |>(exp F) |-- (EX x:B, |>(F x)) || |> FF.
-Proof.
-  intros.
-  unfold derives; intros.
-  simpl in H |- *.
-  destruct (age1 a) eqn:?H; [left | right].
-  + simpl in H0.
-    pose proof H0 a0.
-    destruct H2 as [b ?].
-    {
-      constructor.
-      auto.
-    }
-    exists b.
-    intros.
-    revert H2; apply pred_nec_hereditary.
-    eapply age_later_nec; eauto.
-  + intros.
-    clear - H2 H1.
-    induction H2.
-    - hnf in H0; congruence.
-    - auto.
-Qed.
-
-Lemma later_imp {A} `{ageable A} : forall P Q,
-  |>(P --> Q) = |>P --> |>Q.
-Proof.
-  intros; repeat rewrite later_age.
-  apply pred_ext.
-  apply axiomK.
-  hnf; intros.
-  simpl; intros.
-  simpl in H0.
-  destruct valid_rel_nec.
-  destruct (H5 _ _ H2 _ H1).
-  apply H0 with x; auto.
-  intros.
-  replace a'1 with a'0; auto.
-  congruence.
-Qed.
-
-Lemma TT_boxy {A} `{ageable A} : forall M,
-  boxy M TT.
-Proof.
-  intros; hnf.
-  apply pred_ext; repeat intro; simpl; auto.
-Qed.
-
-Lemma positive_boxy {A} `{ageable A} : forall P Q M,
-  boxy M P ->
-  (P |-- Q) ->
-  P |-- box M Q.
-Proof.
-  intros.
-  rewrite <- H0.
-  apply box_positive.
-  auto.
-Qed.
-
-Lemma forallI {A} `{ageable A} : forall A G X,
-  (forall x:A, G |-- X x) ->
-  G |-- allp X.
-Proof.
-  repeat intro.
-  eapply H0; auto.
-Qed.
-
-Lemma TT_and {A} `{ageable A} : forall P,
-  TT && P = P.
-Proof.
-  intros; apply pred_ext; repeat intro.
-  destruct H0; auto.
-  split; simpl; auto.
-Qed.
-
-Lemma andp_comm {A} `{ageable A} : forall P Q,
-  P && Q = Q && P.
-Proof.
-  intros; apply pred_ext; unfold andp; repeat intro; simpl in *; intuition.
-Qed.
-
-Lemma andp_assoc {A} `{ageable A} : forall P Q R,
-  (P && Q) && R = P && (Q && R).
-Proof.
-  intros; apply pred_ext; auto; unfold derives, andp; simpl; intuition.
-Qed.
-
-Lemma ex_and : forall {A} `{ageable A} B (P:B->pred A) Q,
-  (exp P) && Q = EX x:B, P x && Q.
-Proof.
-  intros. apply pred_ext.
-  repeat intro. destruct H0. destruct H0.
-  exists x. split; auto.
-  repeat intro.
-  destruct H0. destruct H0.
-  split; auto. exists x; auto.
-Qed.
-
-Lemma FF_and : forall {A} `{ageable A} (P:pred A),
-  FF && P = FF.
-Proof.
-  intros. apply pred_ext; repeat intro.
-  destruct H0; auto.
-  elim H0.
-Qed.
-
-
-Lemma boxy_e {A} `{H : ageable A}: forall (M: modality) P,  boxy M P ->
-           forall w w', app_mode M w w' -> P w -> P w'.
-Proof.
-intros.
-rewrite <- H0 in H2; eauto.
-Qed.
-
-Lemma boxy_andp {A} `{H : ageable A}:
-     forall (M: modality) , reflexive _ (app_mode M) ->
-      forall P Q, boxy M P -> boxy M Q -> boxy M (P && Q).
-Proof.
-destruct M;
-intros.
-simpl in *.
-apply boxy_i; intros; auto.
-destruct H4.
-simpl.
-split; eapply boxy_e; eauto.
-Qed.
-
-#[export] Hint Resolve boxy_andp : core.
-
-Lemma boxy_disjunction {A} `{H : ageable A}:
-     forall (M: modality) , reflexive _ (app_mode M) ->
-      forall P Q, boxy M P -> boxy M Q -> boxy M (P || Q).
-Proof.
-destruct M;
-intros.
-simpl in *.
-apply boxy_i; intros; auto.
-destruct H4.
-left.  eapply boxy_e; eauto.
-right. eapply boxy_e; eauto.
-Qed.
-
-#[export] Hint Resolve boxy_disjunction : core.
-
-Lemma boxy_exp {A} `{agA : ageable A}:
-    forall (M: modality) T (P: T -> pred A),
-     reflexive _ (app_mode M) ->
-     (forall x, boxy M (P x)) -> boxy M (exp P).
-Proof.
-intros.
-apply boxy_i; auto; intros.
-destruct H2 as [x ?].
-rewrite <- H0 in H2.
-specialize ( H2 w' H1).
-econstructor; eauto.
-Qed.
-
-#[export] Hint Resolve boxy_exp : core.
-
-Lemma boxy_prop {A} `{H : ageable A}:  forall (M: modality) P, reflexive _ (app_mode M) -> boxy M (prop P).
-Proof.
-intros.
-apply boxy_i; auto.
-Qed.
-
-Lemma boxy_TT {A} `{H : ageable A}:  forall (M: modality), reflexive _ (app_mode M) -> boxy M TT.
-Proof.
-intros.
-apply boxy_i; intros; auto.
-Qed.
-
-Lemma boxy_FF {A} `{H : ageable A}:  forall (M: modality), reflexive _ (app_mode M) -> boxy M FF.
-Proof.
-intros; apply boxy_i; intros; auto; contradiction.
-Qed.
-
-#[export] Hint Resolve boxy_TT : core.
-#[export] Hint Resolve boxy_FF : core.
-
-Lemma TT_i  {A} `{ageable A}: forall w: A,  app_pred TT w.
-Proof.
-unfold TT, prop; simpl; auto.
-Qed.
-
-#[export] Hint Resolve TT_i : core.
-
-Lemma prop_andp_left {A}{agA: ageable A}: forall (P: Prop) Q R, (P -> Q |-- R) -> !!P && Q |-- R.
-Proof.
- repeat intro. destruct H0; auto. apply H; auto.
-Qed.
-
-Lemma prop_andp_right {A}{agA: ageable A}: forall (P: Prop) Q R, P -> (Q |-- R) -> Q |-- !!P && R.
-Proof.
- repeat intro. split; auto.
-Qed.
-
-Lemma prop_true_andp:
-  forall (P: Prop) A `{ageable A} (Q: pred A), P -> (!! P && Q = Q).
-Proof.
-intros.
-apply pred_ext.
-unfold derives; intros ? [? ?]; auto.
-unfold derives; intros; split; auto.
-Qed.
-
-Lemma prop_false_andp:
-  forall (P: Prop) A `{ageable A} (Q: pred A),
-   ~P -> !! P && Q = FF.
-Proof.
-intros.
-apply pred_ext.
-unfold derives; intros ? [? ?]; tauto.
-unfold derives. intros ? [].
-Qed.
-
-Lemma prop_andp_e {A} `{ageable A}:  forall P Q (w:A), (!! P && Q) w -> P /\ Q w.
-Proof.
-intuition; destruct H0; auto.
-Qed.
-
-Lemma prop_andp_i {A} `{ageable A}:  forall P Q (w:A), P /\ app_pred Q w -> (!! P && Q) w.
-Proof.
-intuition.
-split; auto.
-Qed.
-
-Lemma later_derives {A} `{agA : ageable A}: forall {P Q}, (P |-- Q) -> (|> P |-- |> Q).
-Proof.
-unfold derives; intros.
-intro; intros; eapply H.
-eauto.
-Qed.
-
-Lemma boxy_allp {A} `{agA : ageable A}:
-  forall (M: modality) (B: Type) F,
-     reflexive _ (app_mode M) ->
-     (forall (x:B), boxy M (F x)) -> boxy M (allp F).
-Proof.
-intros.
-destruct M as [R V].
-simpl in *.
-apply boxy_i; auto.
-intros.
-simpl in *.
-intro.
-specialize ( H2 b).
-rewrite <- H0 in H2.
-apply H2; auto.
-Qed.
-#[export] Hint Resolve boxy_allp : core.
-
-Lemma later_allp {A} `{agA : ageable A}:
-       forall B P, |> (allp P) = allp (fun x:B => |> (P x)).
-Proof.
-intros.
-apply pred_ext; unfold derives; simpl; intros; eapply H; eauto.
-Qed.
-
-Lemma later_prop {A} `{agA : ageable A}:
-       forall P: Prop, |> (prop P) |-- prop P || |> FF.
-Proof.
-  intros.
-  unfold derives; intros.
-  simpl in H |- *.
-  destruct (age1 a) eqn:?H; [left | right].
-  + apply (H a0).
-    unfold laterR.
-    constructor.
-    auto.
-  + intros.
-    clear - H0 H1.
-    induction H1.
-    - hnf in H; congruence.
-    - auto.
-Qed.
-
-Lemma box_derives {A} `{ageable A} : forall M (P Q:pred A),
-  (P |-- Q) ->  box M P |-- box M Q.
-Proof. exact box_positive. Qed.
-
-Lemma allp_derives:
-       forall {A: Type} `{agA: ageable A} (B: Type) (P Q: B -> pred A),
-               (forall x:B, P x |-- Q x) -> (allp P |-- allp Q).
-Proof.
-intros.
-intros w b ?.
-eapply H; eauto.
-Qed.
-
-Lemma forall_pred_ext  {A} `{agA : ageable A}: forall B (P Q: B -> pred A),
- (ALL x : B, (P x <--> Q x)) |-- (ALL x : B, P x) <--> (ALL x: B, Q x) .
-Proof.
-intros.
-intros w ?.
-split; intros ? ? ? ?;  destruct (H b); eauto.
-Qed.
-
-Lemma exists_pred_ext  {A} `{agA : ageable A}: forall B (P Q: B -> pred A),
- (ALL x : B, (P x <--> Q x)) |-- (EX x : B, P x) <--> (EX x: B, Q x) .
-Proof.
-intros.
-intros w ?.
-split; intros w' ? [? ?]; exists x; eapply H; eauto.
-Qed.
-
-Lemma imp_pred_ext  {A} `{agA : ageable A}: forall B B' P Q,
-       (B <--> B') && (B --> (P <--> Q))
- |-- (B --> P) <-->  (B' --> Q).
-Proof.
-intros.
-intros w [? ?].
-split; intros w'' ? ? w3 ? ?.
-eapply H0.
-4: eapply H2; eauto.
-2: eapply H; try apply H4.
-econstructor 3; eauto.
-econstructor 3; eauto.
-constructor 2.
-eapply H; eauto.
-eapply H0.
-4: eapply H2; eauto.
-2: eapply H; try apply H4.
-econstructor 3; eauto.
-econstructor 3; eauto.
-eapply H; eauto.
-econstructor 3; eauto.
-eapply H; eauto.
-Qed.
-
-Lemma derives_refl {A: Type} `{ageable A}:
-  forall (P: pred A), (P |-- P).
-Proof. firstorder.
-Qed.
-
-#[export] Hint Resolve derives_refl : core.
-
-Lemma andp_derives {A} `{ageable A}:
-  forall P Q P' Q': pred A, (P |-- P') -> (Q |-- Q') -> P && Q |-- P' && Q'.
-Proof.
-intros.
-intros w [? ?]; split; auto.
-Qed.
-
-Lemma orp_derives {A} `{ageable A}:
-  forall P Q P' Q': pred A, (P |-- P') -> (Q |-- Q') -> P || Q |-- P' || Q'.
-Proof.
-intros.
- apply orp_left. apply orp_right1; auto. apply orp_right2; auto.
-Qed.
-
-Lemma exp_derives {A} `{HA : ageable A}:
-       forall B (P: B -> pred A) Q , (forall x:B, P x |-- Q x) -> (exp P |-- exp Q).
-Proof.
-intros.
-intros w [b ?].
-exists b; eapply H; eauto.
-Qed.
-
-Lemma box_ext {A} `{agA : ageable A}: forall (M: modality) P Q,
-    box M (P <--> Q) |--  box M P <--> box M Q.
-Proof.
-intros.
-repeat rewrite box_and.
-apply andp_right;
-eapply derives_trans; try apply axiomK; intros ? [? ?]; auto.
-Qed.
-
-Lemma andp_pred_ext {A} `{agA : ageable A}: forall P Q P' Q',
-       (P <--> P') && (Q <--> Q') |--  (P && Q) <--> (P' && Q').
-Proof.
-intros.
-intros w [? ?].
-split; (intros w' ? [? ?]; split; [eapply H; eauto | eapply H0; eauto]).
-Qed.
-
-Program Definition exactly {A} `{ageable A} (x: A) : pred A := necR x.
-Next Obligation.
-constructor 3 with a; auto.
-constructor 1; auto.
-Qed.
-
-Lemma derives_TT {A} `{ageable A}: forall (P: pred A), P |-- TT.
-Proof.
-intros.
-intros ? ?; auto.
-Qed.
-#[export] Hint Resolve derives_TT : core.
-
-Lemma FF_derives {A} `{ageable A}: forall P, FF |-- P.
-Proof.
-intros. intros ? ?. hnf in H0; contradiction.
-Qed.
-#[export] Hint Immediate FF_derives : core.
-
-Lemma necR_level' {A} `{H : ageable A}: forall {w w': A}, necR w w' ->
-       @necR _ ag_nat (level w) (level w').
-Proof.
-induction 1; simpl; intros.
-apply age_level in H0. constructor 1.  unfold age, age1; simpl.  rewrite H0; reflexivity.
-constructor 2.
-constructor 3 with (level y); auto.
-Qed.
-
-Lemma derives_imp {A} `{agA : ageable A}:
-  forall P Q w, (P |-- Q) -> (P --> Q) w.
-Proof.
-intros.
-intros ? _; auto.
-Qed.
-
-Lemma exp_andp1 {A} `{ageable A}:
- forall B (p: B -> pred A) q, (exp p && q)%pred = (exp (fun x => p x && q))%pred.
-Proof.
-intros; apply pred_ext; intros w ?.
-destruct H0.
-destruct H0.
-exists x; split; auto.
-destruct H0. destruct H0.
-split; auto.
-exists x; auto.
-Qed.
-
-Lemma exp_andp2 {A} `{HA: ageable A}:
- forall B p (q: B -> pred A), (p && exp q)%pred = (exp (fun x => p && q x))%pred.
-Proof.
-intros; apply pred_ext; intros w ?.
-destruct H.
-destruct H0.
-exists x; split; auto.
-destruct H. destruct H.
-split; auto.
-exists x; auto.
-Qed.
-
-Lemma exp_imp_left {A} `{agA : ageable A}:  forall B (p: B -> pred A) q,
-     (exp p --> q)%pred = allp (fun x => p x --> q)%pred.
-Proof.
-intros; apply pred_ext; intros w ?.
-intro.
-intros ?w ? ?.
-eapply H.
-apply necR_trans with w0; auto.
-exists b; auto.
-intros ?w ? [? ?].
-eapply H; eauto.
-Qed.
-
-Lemma app_ext  {A: Type} `{ageable A} : forall (F G: A -> Prop) p1 p2 w,
-         (F w = G w) ->
-         app_pred (exist (hereditary age) F p1) w = app_pred (exist (hereditary age) G p2) w.
-Proof.
-simpl; auto.
-Qed.
-
-Lemma imp_derives {A} `{agA : ageable A}:
-  forall P P' Q Q',
-    (P' |-- P) ->
-    (Q |-- Q') ->
-    P --> Q |-- P' --> Q'.
-Proof.
-intros.
-intros w ? w'' ? ?.
-apply H0.
-eapply H1; eauto.
-Qed.
-
-
-Lemma imp_lem0  {A} `{agA : ageable A}:  forall P st, (TT --> P) st -> P st.
-Proof.
-intros; eauto.
-Qed.
-
-Lemma conjoin_hyp0  {A} `{H : ageable A}:
-      forall (P Q: pred A) w,  P w -> (P --> Q) w -> (TT --> Q) w.
-Proof.
-intros.
-intros w' ? ?.
-eapply H1;
-eauto.
-eapply pred_nec_hereditary; eauto.
-Qed.
-
-Lemma conjoin_hyp1 {A} `{agA : ageable A}: forall (P Q R: pred A)  w,
-            P w -> (P&&Q --> R) w -> (Q --> R) w.
-Proof.
-intros.
-intros w' ? ?.
-eapply H0; auto.
-split; eauto.
-eapply pred_nec_hereditary; eauto.
-Qed.
-
-Lemma derives_e {A: Type} `{agA : ageable A}: forall p q (st: A),
-      (p |-- q) -> p st -> q st.
-Proof.
-auto.
-Qed.
-
-Ltac slurp :=
- apply imp_lem0;
-  match goal with |-  app_pred (_ --> _)  ?st =>
-        repeat match goal with
-                   | H: app_pred ?P st |- app_pred (?b --> ?c) st =>
-                       (apply (@conjoin_hyp0 _ _ P c st H) ||
-                        (apply (@conjoin_hyp1 _ _ P b c st H)));
-                       clear H
-                   end;
-        try (revert st; apply derives_e)
-  end.
-
-Lemma test_slurp {A} `{agA : ageable A} :  forall  (P Q R S : pred A) w ,
-        (P && (Q && R) --> S) w -> P w -> Q w -> R w -> S w.
-Proof.
-intros.
-remember (app_pred (P && (Q && R) --> S) w) as hide.
-slurp.
-subst hide. assumption.
-Qed.
-
-Lemma later_andp {A} `{H : ageable A}:
-  forall P Q, |> (P && Q) = |>P && |>Q.
-Proof.
-intros.
-apply pred_ext; intros w ?.
-split; intros w' ?; destruct (H0 _ H1); auto.
-destruct H0.
-intros w' ?; split; eauto.
-Qed.
-
-Lemma True_andp_eq {A}`{ageable A}:
-  forall (P: Prop) (Q: pred A), P -> (!!P && Q)%pred = Q.
-intros.
-apply pred_ext; intros w ?; hnf in *; simpl; intros; intuition.
-Qed.
-
-Lemma distrib_orp_andp {A}{agA: ageable A}:
-   forall P Q R, (P||Q)&&R = (P&&R)||(Q&&R).
-Proof.
-  intros. apply pred_ext.
-  intros w [[?|?] ?]; [left|right]; split; auto.
-  intros w [[? ?]|[? ?]]; split; auto. left; auto. right; auto.
-Qed.
-
-Lemma allp_right {B A: Type}{agA: ageable A}:
-  forall (P: pred A) (Q: B -> pred A),
-  (forall v, P |-- Q v) ->
-   P |-- allp Q.
-Proof.
- intros. intros w ? v; apply (H v); auto.
-Qed.
-
-Lemma allp_left {B}{A}{agA: ageable A}:
-   forall (P: B -> pred A) x Q, (P x |-- Q) -> allp P |-- Q.
- Proof.
-   intros. intros ? ?. apply H. apply H0.
-Qed.
-
-Lemma later_imp2 {A}{agA: ageable A}: forall P Q: pred A,
-                 |> (P <--> Q) = |> P <--> |> Q.
-Proof.
- intros.
-  repeat rewrite <- later_imp. rewrite <- later_andp; auto.
-Qed.
diff --git a/msl/predicates_rec.v b/msl/predicates_rec.v
deleted file mode 100644
index e1ac09594d..0000000000
--- a/msl/predicates_rec.v
+++ /dev/null
@@ -1,202 +0,0 @@
-(*
- * Copyright (c) 2009-2010, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-
-Require Import VST.msl.base.
-Require Import VST.msl.ageable.
-Require Import VST.msl.predicates_hered.
-Require Import VST.msl.subtypes.
-
-Require Import Coq.Wellfounded.Wellfounded.
-Require Import Coq.funind.Recdef.
-
-Delimit Scope pred with pred.
-Local Open Scope pred.
-
-Set Implicit Arguments.
-
-Definition contractive {A} `{ageable A} {EO : Ext_ord A} (f: pred A -> pred A) : Prop :=
-  forall P Q,  |> (P <=> Q)  |-- f P <=> f Q.
-
-Definition nonexpansive {A} `{ageable A} {EO : Ext_ord A} (f: pred A -> pred A) : Prop :=
-  forall P Q,  (P <=> Q)  |-- f P <=> f Q.
-
-Definition HOcontractive {A} `{ageable A} {EO : Ext_ord A} (X: Type) (f: (X -> pred A) -> (X -> pred A)) : Prop :=
-  forall P Q,  (ALL x:X, |> (P x <=> Q x)) |-- (ALL x:X, f P x <=> f Q x).
-
-Definition HOnonexpansive {A} `{ageable A} {EO : Ext_ord A} (X: Type) (f: (X -> pred A) -> (X -> pred A)) : Prop :=
-  forall P Q, (ALL x:X, P x <=> Q x)  |-- (ALL x:X, f P x <=> f Q x).
-
-Module Type HO_REC.
-
-  Parameter HORec : forall {A} `{ageable A} {EO : Ext_ord A} X (f: (X -> pred A) -> (X -> pred A)), X -> pred A.
-  Axiom HORec_fold_unfold : forall {A} `{ageable A} {EO : Ext_ord A} X f (H:HOcontractive (X:=X) f),
-    HORec f = f (HORec f).
-
-  Parameter Rec : forall {A} `{ageable A} {EO : Ext_ord A} (f: pred A -> pred A), pred A.
-  Axiom Rec_fold_unfold : forall {A} `{ageable A} {EO : Ext_ord A} f (H:contractive f),
-    Rec f = f (Rec f).
-
-End HO_REC.
-
-Module HoRec : HO_REC.
-
-Section HORec.
-  Variable A:Type.
-  Variable ag: ageable A.
-  Variable eo: Ext_ord A.
-  Variable X:Type.
-  Variable f: (X-> pred A) -> (X -> pred A).
-
-  Fixpoint HORec' (n:nat) : X -> pred A :=
-    match n with
-    | S n' => f (HORec' n')
-    | O    => f (fun _ => FF)
-    end.
-
-  Hypothesis Hcont : HOcontractive f.
-
-  Lemma HORec'_unage:   forall j n x a,
-        (n >= level a) ->  (HORec' n x a <-> HORec' (j+n) x a).
-  Proof.
-  induction j; intros. simpl; intuition.
-  specialize (IHj _ x a H).
-   rewrite IHj. clear IHj.
-  change (S j + n) with (S (j + n)).
-   assert (j + n >= level a) by lia.
-   clear H; rename H0 into H.
-    remember (j+n) as i; clear Heqi.
-
-   assert ((ALL  x : X , (HORec' i x <=> HORec' (S i) x)) (level a)).
-   clear - H Hcont.
-   remember (level a) as n; clear Heqn.
-   revert n H; induction i; intros.
-   replace n with 0 by lia. clear H.
-   intro x.
-   specialize (Hcont (fun _ => FF) (HORec' 0)).
-   specialize (Hcont O).
-   spec Hcont. repeat (hnf; intros). simpl in *.
-   rewrite laterR_nat in H; exfalso; lia.
-   specialize ( Hcont x).
-    simpl in *. auto.
-   intro x.
-   apply (Hcont (HORec' i) (HORec' (S i))).
-   intro s. intros ? ?. apply IHi.  simpl  in H0.  rewrite laterR_nat in H0; lia.
-   clear - H0.
-   destruct (H0 x a); auto.
-   split; eauto.
-  Qed.
-
-End HORec.
-
-Definition HORec {A} `{ag: ageable A} {EO : Ext_ord A} {X: Type} (f:  (X-> pred A) -> (X -> pred A)) (x: X) : pred A :=
-     mkPred (fun a : A => app_pred (@HORec' A ag EO X f (level a) x) a).
-
-Lemma HORec_fold_unfold {A} `{ageable A} {EO : Ext_ord A} : forall X f (H:HOcontractive (X:=X) f),
-            HORec f = f (HORec f).
-Proof.
-  intros. rename H into ag. rename H0 into Hcont.
-   unfold HORec.
-    extensionality x.
-    cut (forall a, HORec f x a <-> f (HORec f) x a).
-    intros; apply pred_ext; hnf; firstorder.
-
-    intro a; simpl.
-    case_eq (age1 a); intros.
-    apply age_level in H.
-    remember (level a0) as n; clear a0 Heqn.
-    destruct
-      (@Hcont (HORec' f n) (HORec f) (level a)) with x a; [ | lia | ].
-   rewrite H. clear a H.
-    repeat (hnf; intros).
-    simpl in H. apply laterR_level in H. simpl in H. unfold natLevel in H.
-    assert (n >= level y) by lia.
-    clear - Hcont H1.
-    split; hnf; simpl; intros.
-    generalize (necR_level _ _ H3); intro.
-    generalize (necR_level _ _ H); intro.
-    pose proof (ext_level _ _ H0) as Hl0.
-    pose proof (ext_level _ _ H4) as Hl.
-    apply (@HORec'_unage _ _ _ X f  Hcont (n - level x'') (level x'') b x'' ltac:(lia)).
-    replace (n - level x'' + level x'') with n by lia.
-    apply pred_upclosed with x'; auto.
-    apply pred_nec_hereditary with a''; auto.
-    specialize (H2 _ _ (necR_refl _) (ext_refl _)).
-    apply (@HORec'_unage _ _ _ X f Hcont (n - level a'') (level a'') b a'' (PeanoNat.Nat.le_refl _)) in H2.
-    generalize (necR_level _ _ H); intro.
-    pose proof (ext_level _ _ H0) as Hl0.
-    replace (n - level a'' + level a'') with n in H2 by lia.
-    auto.
-    split; intros.
-    specialize (H2 _ _ (necR_refl _) (ext_refl _)).
-    rewrite H in H2. simpl in H2.
-    eapply H0 in H2; auto.
-    eapply H1 in H2; auto.
-    assert (app_pred (HORec' f (level a) x) a).
-    rewrite H. apply H2.
-     clear - H3 H4 H5 Hcont.
-    apply (@HORec'_unage _ _ _ X f Hcont (level a - level x'') (level x'') x x'' (PeanoNat.Nat.le_refl _)).
-    pose proof (ext_level _ _ H4).
-    replace (level a - level x'' + level x'') with (level a)
-        by (apply necR_level in H3; lia).
-    apply pred_upclosed with x'; auto.
-    apply pred_nec_hereditary with a; auto.
- (* None  case *)
-    assert (level a = 0) by (apply age1_level0; auto).
-    split; intros.
-    destruct (@Hcont (fun _ => FF) (HORec f) (level a)) with x a; try lia.
-     rewrite H0.
-    repeat (hnf; intros); split; hnf; simpl; intros.
-    simpl in H2.  apply laterR_level in H2. exfalso; lia.
-        simpl in H2.  apply laterR_level in H2. clear - H2. simpl in H2.  unfold natLevel in H2; lia.
-     specialize (H1 _ _ (necR_refl _) (ext_refl _)). rewrite H0 in H1. simpl in H1.
-     eapply H2; auto.
-     apply clos_rt_rt1n in H2.
-    inv H2; [ | unfold age in H3; congruence].
-    pose proof (ext_level _ _ H3) as <-.
-    rewrite H0; simpl.
-    specialize (Hcont (HORec f) (fun _ => FF)).
-    specialize (Hcont 0).
-    spec Hcont.
-    simpl. intros. apply laterR_level in H2. simpl in H2. unfold natLevel in H2. exfalso; lia.
-    specialize ( Hcont x).
-    hnf in Hcont. specialize ( Hcont x'). spec Hcont. lia.
-    eapply Hcont; auto.
-    eapply pred_upclosed; eauto.
-Qed.
-
-Section recursive.
-  Variable A:Type.
-  Variable ag:ageable A.
-  Variable eo:Ext_ord A.
-
-  Variable f:pred A -> pred A.
-  Variable Hc : contractive f.
-
-  Lemma cont_HOcont : @HOcontractive A ag eo unit (fun x _ => f (x tt)).
-  Proof.
-    repeat intro.
-    specialize ( H tt).
-    eapply Hc; eauto.
-  Qed.
-End recursive.
-
-
-Definition Rec {A} `{ageable A} {EO : Ext_ord A} f : pred A
-  := HORec (fun x _ => f (x tt)) tt.
-
-Lemma Rec_fold_unfold : forall {A} `{ageable A} {EO : Ext_ord A} f (H:contractive f),
-  Rec f = f (Rec f).
-Proof.
-  intros.
-  unfold Rec.
-  pattern (HORec (fun x _ => f (x tt))) at 1.
-  rewrite HORec_fold_unfold.
-  auto.
-  apply cont_HOcont; auto.
-Qed.
-
-End HoRec.
-
-Export HoRec.
diff --git a/msl/predicates_sa.v b/msl/predicates_sa.v
deleted file mode 100644
index a981a9859a..0000000000
--- a/msl/predicates_sa.v
+++ /dev/null
@@ -1,840 +0,0 @@
-Require Import VST.msl.base.
-Require Import VST.msl.sepalg.
-
-Require Import Coq.funind.Recdef.
-Require Coq.Wellfounded.Wellfounded. (* Can't Import this, because that brings the identifier B into
-           scope, which breaks things like `{ageable B}  in this file.
-          Stupid feature of Coq, that the B in `{ageable B} is not unambiguously a
-        binding occurrence of B.  *)
-Declare Scope pred.
-Delimit Scope pred with pred.
-Local Open Scope pred.
-
-Definition pred (A:Type) := A -> Prop.
-Bind Scope pred with pred.
-
-Definition derives (A:Type) (P Q:pred A) := forall a:A, P a -> Q a.
-Arguments derives [A] _ _.
-
-Lemma pred_ext : forall A (P Q:pred A),
-  derives P Q -> derives Q P -> P = Q.
-Proof.
-  intros.
-  extensionality a.
-  apply prop_ext; intuition.
-Qed.
-
-
-Lemma derives_cut {A}  : forall Q P R : pred A,
-  derives P Q ->
-  derives Q R ->
-  derives P R.
-Proof.
-  repeat intro; intuition.
-Qed.
-
-Definition prop {A: Type}  (P: Prop) : pred A := (fun _  => P).
-#[export] Hint Unfold prop : core.
-
-Definition TT {A}: pred A := prop True.
-Definition FF  {A}: pred A := prop False.
-
-Set Implicit Arguments.
-
-Definition imp {A}  (P Q:pred A) :=
-   fun a:A => P a -> Q a.
-Definition orp {A} (P Q:pred A) :=
-   fun a:A => P a \/ Q a.
-Definition andp {A} (P Q:pred A) :=
-   fun a:A => P a /\ Q a.
-
-Definition allp {A B: Type} (f: B -> pred A) : pred A
-  := fun a => forall b, f b a.
-Definition exp {A B: Type} (f: B -> pred A) : pred A
-  := fun a => exists b, f b a.
-
-Notation "'emp'" := identity.
-
-Definition sepcon {A} {JA: Join A}(p q:pred A) := fun z:A =>
-  exists x:A, exists y:A, join x y z /\ p x /\ q y.
-Definition wand {A}  {JA: Join A}  (p q:pred A) := fun y =>
-  forall x z, join x y z -> p x -> q z.
-
-Declare Scope pred_derives.
-Notation "P '|--' Q" := (derives P%pred Q%pred) (at level 80, no associativity) : pred_derives.
-Open Scope pred_derives.
-Notation "'EX' x .. y , P " :=
-  (exp (fun x => .. (exp (fun y => P%pred)) ..)) (at level 65, x binder, y binder, right associativity) : pred.
-Notation "'ALL' x .. y , P " :=
-  (allp (fun x => .. (allp (fun y => P%pred)) ..)) (at level 65, x binder, y binder, right associativity) : pred.
-Infix "||" := orp (at level 50, left associativity) : pred.
-Infix "&&" := andp (at level 40, left associativity) : pred.
-Notation "P '-->' Q" := (imp P Q) (at level 55, right associativity) : pred.
-Notation "P '<-->' Q" := (andp (imp P Q) (imp Q P)) (at level 57, no associativity) : pred.
-Notation "P '*' Q" := (sepcon P Q) : pred.
-Notation "P '-*' Q" := (wand P Q) (at level 60, right associativity) : pred.
-Notation "'!!' e" := (prop e) (at level 15) : pred.
-
-Definition precise {A}  {JA: Join A}{PA: Perm_alg A}  (P: pred A) : Prop :=
-     forall w w1 w2, P w1 -> P w2 -> join_sub w1 w -> join_sub w2 w -> w1=w2.
-
-Definition precise2  {A} {JA: Join A}{PA: Perm_alg A}  (P: pred A) : Prop :=
-     forall Q R, P * (Q && R) = (P * Q) && (P * R).
-
-Lemma precise_eq {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{CA: Canc_alg A}:
-     precise =
-                 fun P : pred A => forall Q R, P * (Q && R) = (P * Q) && (P * R).
-Proof.
-extensionality P.
-unfold precise.
-apply prop_ext; split; intros.
-extensionality w.
-apply prop_ext; split; intros.
-destruct H0 as [phi1 [phi2 [? [? [? ?]]]]].
-split; exists phi1; exists phi2; auto.
-destruct H0 as [[phi1a [phi2a [? [? ?]]]] [phi1b [phi2b [? [? ?]]]]].
-specialize (H w _ _ H1 H4).
-spec H.
-econstructor; eauto.
-spec H.
-econstructor; eauto.
-subst phi1b.
-generalize (join_canc (join_comm H0) (join_comm H3)).
-intro; subst phi2b.
-exists phi1a; exists phi2a; split; auto.
-split; auto.
-split; auto.
-rename w1 into w1a.
-rename w2 into w1b.
-destruct H2 as [w2a ?].
-destruct H3 as [w2b ?].
-pose (fa x := x=w2a).
-pose (fb x := x=w2b).
-assert (((P * fa) && (P * fb)) w).
-split; do 2 econstructor; repeat split; eauto.
-rewrite <- H in H4.
-destruct H4 as [w1 [w2 [? [? [? ?]]]]].
-unfold fa,fb in *.
-subst.
-generalize (join_canc H2 H4); intro.
-subst.
-eapply join_canc; eauto.
-Qed.
-
-Lemma derives_precise {A} {JA: Join A}{PA: Perm_alg A}:
-  forall P Q, (P |-- Q) -> precise Q -> precise P.
-Proof.
-intros; intro; intros; eauto.
-Qed.
-
-Lemma prop_true_and:
-  forall (P: Prop) A (Q: pred A), P -> (!! P && Q = Q).
-Proof.
-intros. unfold prop, andp;
-extensionality w; apply prop_ext; split; intuition.
-Qed.
-
-Lemma prop_andp_e {A}:  forall P Q (w:A), (!! P && Q) w -> P /\ Q w.
-Proof.
-intuition; destruct H; auto.
-Qed.
-
-Lemma prop_andp_i {A}:  forall P Q (w:A), P /\ Q w -> (!! P && Q) w.
-Proof.
-intuition.
-split; auto.
-Qed.
-
-Lemma derives_trans {A}:  forall (P Q R: pred A), (P |-- Q) -> (Q |-- R) -> P |-- R.
-Proof.
-firstorder.
-Qed.
-
-Lemma and_i {A}: forall (P Q R: pred A),
-    (P |-- Q) -> (P |-- R) -> P |-- Q && R.
-Proof. intuition.
-intros w ?.
-split; eauto.
-Qed.
-
-Lemma andp_derives {A}  :
-  forall P Q P' Q': pred A, (P |-- P') -> (Q |-- Q') -> P && Q |-- P' && Q'.
-Proof.
-intros.
-intros w [? ?]; split; auto.
-Qed.
-
-Lemma sepcon_assoc {A} {JA: Join A}{PA: Perm_alg A}:
-  forall p q r, (((p * q) * r) = (p * (q * r))).
-Proof.
-pose proof I.
-intros.
-extensionality w; apply prop_ext; split; intros.
-destruct H0 as [w12 [w3 [? [[w1 [w2 [? [? ?]]]] ?]]]].
-destruct (join_assoc H1 H0) as [w23 [? ?]].
-exists w1; exists w23; repeat split; auto.
-exists w2; exists w3; split; auto.
-destruct H0 as [w1 [w23 [? [? [w2 [w3 [? [? ?]]]]]]]].
- destruct (join_assoc (join_comm H2) (join_comm H0)) as [w12 [? ?]].
-exists w12; exists w3; repeat split; auto.
-exists w1; exists w2; repeat split; auto.
-Qed.
-
-Lemma sepcon_comm {A} {JA: Join A}{PA: Perm_alg A}:  forall (P Q: pred A) , P * Q = Q * P.
-Proof.
-intros.
-extensionality w; apply prop_ext; split; intros;
-(destruct H as [w1 [w2 [? [? ?]]]]; exists w2; exists w1; split ; [apply join_comm; auto | split; auto]).
-Qed.
-
-Lemma sepcon_emp {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{FA: Flat_alg A}: forall P, (P * emp) = P.
-Proof.
-intros.
-extensionality w; apply prop_ext; split; intros.
-destruct H as [w1 [w2 [? [? ?]]]].
-generalize (identity_unit (a:=w1) H1); intro.
-spec H2.
-econstructor; eauto.
-unfold unit_for in H2.
-generalize (join_eq H (join_comm H2)).
-intros; subst; auto.
-destruct (join_ex_identities w) as [e [? ?]].
-exists w; exists e; repeat split; auto.
-apply join_comm.
-apply identity_unit; auto.
-Qed.
-
-Lemma emp_sepcon {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{FA: Flat_alg A}:
-    forall P, (emp*P) = P.
-Proof. intros. rewrite sepcon_comm; rewrite sepcon_emp; auto. Qed.
-
-Lemma precise_emp {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{FA: Flat_alg A}:
-     precise emp.
-Proof.
-repeat intro.
-eapply join_sub_same_identity with (a := w1); eauto.
-apply identity_unit'; auto.
-eapply join_sub_unit_for; eauto.
-apply identity_unit'; auto.
-Qed.
-
-Definition exactly {A} (x: A) : pred A := fun w => w=x.
-
-Lemma join_exactly {A} {JA: Join A}{PA: Perm_alg A}:
-  forall w1 w2 w3, join w1 w2 w3 -> exactly w1 * exactly w2 = exactly w3.
-Proof.
-intros.
-unfold exactly.
-extensionality w.
-apply prop_ext; split; intros.
-destruct H0 as [? [? [? [? ?]]]].
-subst. eapply join_eq; eauto.
-subst w3.
-exists w1; exists w2; split; auto.
-Qed.
-
-
-Lemma exists_and1 {A: Type} : forall {T: Type} (P: T -> pred A) (Q: pred A),
-                   exp P && Q = EX x:T, P x && Q.
-Proof.
-intros.
-extensionality w.
-apply prop_ext; split; intros.
-destruct H as [[x ?] ?].
-exists x; split; auto.
-destruct H as [x [? ?]].
-split; auto.
-exists x; auto.
-Qed.
-
-Lemma andp_comm {A: Type}: forall (P Q: pred A), P && Q = Q && P.
-Proof.
-intros.
-extensionality w.
-unfold andp;
-apply prop_ext; split; intuition.
-Qed.
-
-Lemma andp_assoc {A}: forall (P Q R: pred A),
-                 ((P && Q) && R = P && (Q && R)).
-Proof.
-intros.
-extensionality w.
-unfold andp.
-apply prop_ext; intuition.
-Qed.
-
-Lemma True_andp_eq {A}:
-  forall (P: Prop) (Q: pred A), P -> (!!P && Q)%pred = Q.
-intros.
-extensionality w; apply prop_ext; split; unfold prop, andp; simpl; intros; intuition.
-Qed.
-
-Lemma TT_i  {A} : forall w: A,  TT w.
-Proof.
-unfold TT, prop; simpl; auto.
-Qed.
-
-#[export] Hint Resolve TT_i : core.
-
-Lemma TT_and {A}: forall (Q: pred A), TT && Q = Q.
-intros; unfold andp,  TT, prop; extensionality w.
-apply prop_ext; intuition.
-Qed.
-
-
-Lemma andp_TT {A}: forall (P: pred A), P && TT = P.
-Proof.
-intros.
-extensionality w; apply prop_ext; split; intros.
-destruct H; auto.
-split; auto.
-Qed.
-
-Lemma emp_wand {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{FA: Flat_alg A}:
-    forall P, emp -* P = P.
-Proof.
-intros.
-extensionality w; apply prop_ext; split; intros.
-destruct (join_ex_identities w) as [e [He [? Hj]]].
-eapply H; eauto.
-specialize (He _ _ Hj); subst; auto.
-intro; intros.
-replace z with w; auto.
-Qed.
-
-Lemma wand_derives {A} {JA: Join A}{PA: Perm_alg A}:
-  forall P P' Q Q',  (P' |-- P) -> (Q |-- Q') -> P -* Q |-- P' -* Q'.
-Proof.
-intros.
-intros w ?.
-intro; intros.
-eauto.
-Qed.
-
-Lemma TT_sepcon_TT {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}: TT * TT = TT.
-Proof.
-intros.
-extensionality w; apply prop_ext; split; intros; auto.
-destruct (join_ex_units w).
-exists x; exists w; split; auto.
-Qed.
-
-Definition ewand {A} {JA: Join A} (P Q: pred A) : pred A :=
-  fun w => exists w1, exists w2, join w1 w w2 /\ P w1 /\ Q w2.
-
-(* Notation "P '-o' Q" := (ewand P Q) (at level 60, right associativity). *)
-
-Lemma emp_ewand {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{FA: Flat_alg A}:  forall P, ewand emp P = P.
-Proof.
-intros.
-extensionality w; apply prop_ext; split; intros.
-destruct H as [w1 [w2 [? [? ?]]]].
-replace w with w2; auto.
-eapply join_eq; eauto.
-eapply identity_unit; eauto.
-destruct (join_ex_identities w) as [e [He [? Hj]]].
-exists e; exists w.
-split; auto.
-specialize (He _ _ Hj); subst; auto.
-Qed.
-
-
-Lemma exists_sepcon1 {A} {JA: Join A}{PA: Perm_alg A}:
-  forall T (P: T ->  pred A) Q,  exp P * Q = exp (fun x => P x * Q).
-Proof.
-intros.
-extensionality w.
-apply prop_ext; split; intros.
-destruct H as [w1 [w2 [? [[x ?] ?]]]].
-exists x; exists w1; exists w2; split; auto.
-destruct H as [x [w1 [w2 [? [? ?]]]]].
-exists w1; exists w2; split; auto.
-split; auto.
-exists x; auto.
-Qed.
-
-Lemma derives_refl {A: Type}:
-  forall (P: pred A), (P |-- P).
-Proof. firstorder.
-Qed.
-
-#[export] Hint Resolve derives_refl : core.
-
-Lemma derives_TT {A}: forall (P: pred A), P |-- TT.
-Proof.
-intros.
-intros ? ?; auto.
-Qed.
-#[export] Hint Resolve derives_TT : core.
-
-Lemma sepcon_derives {A} {JA: Join A}{PA: Perm_alg A}:
-  forall p q p' q', (p |-- p') -> (q |-- q') -> (p * q |-- p' * q').
-Proof.
-intros.
-do 2 intro.
-destruct H1 as [w1 [w2 [? [? ?]]]].
-exists w1; exists w2; repeat split ;auto.
-Qed.
-
-Lemma derives_e {A: Type}: forall p q (st: A),
-      (p |-- q) -> p st -> q st.
-Proof.
-auto.
-Qed.
-
-Lemma exp_derives {A} :
-       forall B (P: B -> pred A) Q , (forall x:B, P x |-- Q x) -> (exp P |-- exp Q).
-Proof.
-intros.
-intros w [b ?].
-exists b; eapply H; eauto.
-Qed.
-
-
-Lemma unmodus_wand {A}  {JA: Join A}{PA: Perm_alg A}:
- forall P Q R, Q = P * R ->  Q |-- P * (P -* Q).
-Proof.
-intros.
-subst.
-apply sepcon_derives; auto.
-intros ?w ?; intro; intros.
-exists x; exists w; split; auto.
-Qed.
-
-Definition superprecise {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A} (P: pred A) :=
-   forall w1 w2, P w1 -> P w2 -> comparable w1 w2 -> w1=w2.
-
-Lemma modus_ewand {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{FA : Flat_alg A} :  forall P Q, superprecise P -> P * (ewand P Q) |-- Q.
-Proof.
-pose proof I.
-intros.
-intros w ?.
-destruct H1 as [w1 [w2 [? [? ?]]]].
-unfold ewand in H3.
-destruct H3 as [w1' [w3 [? [? ?]]]].
-assert (w1'=w1).
-  apply H0; auto.
-  apply comparable_trans with w2. eapply join_comparable2; eauto.
-  apply comparable_sym.  eapply join_comparable2; eauto.
-  subst.
-replace w with w3; auto.
-eapply join_eq; eauto.
-Qed.
-
-Lemma exists_expand_sepcon {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}:
- forall B (p: B -> pred A) q, (exp p * q)%pred = (exp (fun x => p x * q))%pred.
-Proof.
-intros; extensionality w; apply prop_ext; split; intros.
-destruct H as [? [? [? [? ?]]]].
-destruct H0.
-exists x1; exists x; exists x0; split; auto.
-destruct H as [? [? [? [? [? ?]]]]].
-exists x0; exists x1; split; auto.
-split; auto.
-exists x; auto.
-Qed.
-
-Lemma exists_expand_sepcon' {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}:
- forall B p (q: B -> pred A), (p * exp q)%pred = (exp (fun x => p * q x))%pred.
-Proof.
-intros; extensionality w; apply prop_ext; split; intros.
-destruct H as [? [? [? [? ?]]]].
-destruct H1.
-exists x1; exists x; exists x0; split; auto.
-destruct H as [? [? [? [? [? ?]]]]].
-exists x0; exists x1; split; auto.
-split; auto.
-exists x; auto.
-Qed.
-
-Lemma exists_expand_and {A}  {JA: Join A}:
- forall B (p: B -> pred A) q, (exp p && q)%pred = (exp (fun x => p x && q))%pred.
-Proof.
-intros; extensionality w; apply prop_ext; split; intros.
-destruct H.
-destruct H.
-exists x; split; auto.
-destruct H. destruct H.
-split; auto.
-exists x; auto.
-Qed.
-
-Lemma exists_expand_and' {A} {JA: Join A}:
- forall B p (q: B -> pred A), (p && exp q)%pred = (exp (fun x => p && q x))%pred.
-Proof.
-intros; extensionality w; apply prop_ext; split; intros.
-destruct H.
-destruct H0.
-exists x; split; auto.
-destruct H. destruct H.
-split; auto.
-exists x; auto.
-Qed.
-
-Lemma allp_derives_right {A} : forall B p (q: B -> pred A),
-  ((p |-- allp q) <-> (forall x, p |-- q x)).
-Proof.
-intros.
-split; intros.
-eapply derives_trans; eauto.
-intros ? ?. apply H0.
-intros ? ? ?.
-eapply (H b).
-auto.
-Qed.
-
-Lemma wand_exists {A} {JA: Join A}{PA: Perm_alg A}:
-   forall B P Q,  (EX x: B, P -* Q x) |-- (P -* EX x : B, Q x).
-Proof.
-pose proof I.
-intros.
-intros w ?.
-destruct H0 as [x ?].
-intros ?w ?w ? ?.
-specialize ( H0 w0 w1 H1 H2).
-exists x; auto.
-Qed.
-
-Lemma modus_wand {A} {JA: Join A}{PA: Perm_alg A}:
-  forall P Q,  P * (P -* Q) |-- Q.
-Proof.
-intros.
-intros w  [?w [?w [? [? ?]]]].
-eapply H1; eauto.
-Qed.
-
-Lemma distrib_sepcon_andp {A} {JA: Join A}{PA: Perm_alg A}:
-  forall P Q R, P * (Q && R) |-- (P * Q) && (P * R).
-Proof.
-intros. intros w [w1 [w2 [? [? ?]]]].
-destruct H1.
-split; exists w1; exists w2; split; auto.
-Qed.
-
-Lemma andp_r {A: Type} : forall (P Q R: pred A), (P |-- Q) -> (P |-- R) -> P |-- Q && R.
-Proof.
-intros.
-intros w ?; split; auto.
-Qed.
-
-Definition list_sepcon {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A} : list (pred A) -> pred A := fold_right sepcon emp.
-
-Lemma sepcon_andp_prop {A} {JA: Join A}{PA: Perm_alg A}: forall P Q R, P * (!!Q && R) = !!Q && (P * R).
-Proof.
-intros.
-extensionality w; apply prop_ext; split; intros.
-destruct H as [w1 [w2 [? [? [? ?]]]]].
-split. apply H1.
-exists w1; exists w2; split; [|split]; auto.
-destruct H.
-destruct H0 as [w1 [w2 [? [? ?]]]].
-exists w1; exists w2; repeat split; auto.
-Qed.
-
-Require Import VST.msl.cross_split.
-
-Lemma exactly_i {A} : forall x: A, exactly x x.
-Proof. intros. reflexivity.
-Qed.
-#[export] Hint Resolve exactly_i : core.
-
-Lemma superprecise_exactly {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}: forall x, superprecise (exactly x).
-Proof.
-unfold exactly, superprecise; intros.
-subst; auto.
-Qed.
-#[export] Hint Resolve superprecise_exactly : core.
-
-Lemma find_overlap {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}:
-     Cross_alg A ->
-     forall S P Q R, (S * P) && (Q * R) |--
-                          EX SQ:_, EX SR:_, EX PQ:_, EX PR:_,
-                            (((SQ* SR) && S)*((PQ* PR) && P)) &&
-                            (((SQ* PQ) && Q)*((SR* PR) && R)) &&
-                            !! (superprecise SQ /\ superprecise SR /\ superprecise PQ /\ superprecise PR).
-Proof.
-pose proof I.
-intros.
-intros w [[w1 [w2 [? [? ?]]]] [w3 [w4 [? [? ?]]]]].
-destruct (X _ _ _ _ _ H0 H3) as [[[[wa wb] wc] wd] [? [? [? ?]]]].
-exists (exactly wa); exists (exactly wb); exists (exactly wc); exists (exactly wd).
-repeat split; auto.
-exists w1; exists w2; split; [|split]; auto; split; auto.
-exists wa; exists wb; split; [|split]; auto.
-exists wc; exists wd; split; [|split]; auto.
-exists w3; exists w4; split; [|split]; auto; split; auto.
-exists wa; exists wc; split; [|split]; auto.
-exists wb; exists wd; split; [|split]; auto.
-Qed.
-
-Lemma modus_ponens {A} : forall (X P Q:pred A),
-  (X |-- P) ->
-  (X |-- (P --> Q)) ->
-  X |-- Q.
-Proof.
-  unfold derives, imp; simpl; intuition eauto.
-Qed.
-
-Lemma and_intro {A}  : forall (X P Q:pred A),
-  (X |-- P) ->
-  (X |-- Q) ->
-  X |-- P && Q.
-Proof.
-  unfold derives, imp, andp; simpl; intuition.
-Qed.
-
-Lemma and1 {A}  : forall (X P Q:pred A),
-  X |-- P && Q --> P.
-Proof.
-  unfold derives, imp, andp; simpl; intuition eauto.
-Qed.
-
-Lemma and2 {A}  : forall (X P Q:pred A),
-  X |-- P && Q --> Q.
-Proof.
-  unfold derives, imp, andp; simpl; intuition eauto.
-Qed.
-
-Lemma and3 {A}  : forall (X P Q R:pred A),
-  X |-- (P --> Q) --> (P --> R) --> (P --> Q && R).
-Proof.
-  unfold derives, imp, andp; simpl; intuition eauto.
-Qed.
-
-Lemma or1 {A}  : forall (X P Q:pred A),
-  X |-- P --> P || Q.
-Proof.
-  unfold derives, imp, orp; simpl; intuition.
-Qed.
-
-Lemma or2 {A}  : forall (X P Q:pred A),
-  X |-- Q --> P || Q.
-Proof.
-  unfold derives, imp, orp; simpl; intuition.
-Qed.
-
-Lemma or3 {A}  : forall (X P Q R:pred A),
-  X |-- (P --> R) --> (Q --> R) --> (P || Q --> R).
-Proof.
-  unfold derives, imp, orp; simpl; intuition eauto.
-Qed.
-
-Lemma TTrule {A}  : forall X (P: pred A),
-  X |-- P --> TT.
-Proof.
-  unfold derives, imp, TT; simpl; intuition.
-Qed.
-
-Lemma FFrule {A}  : forall X (P: pred A),
-  X |-- FF --> P.
-Proof.
-  unfold derives, imp, FF; simpl; intuition.
-hnf in H0; contradiction.
-Qed.
-
-Lemma distribution {A}  : forall (X P Q R:pred A),
-  X |-- P && (Q || R) --> (P && Q) || (P && R).
-Proof.
-  unfold derives, imp, orp, andp; simpl; intuition.
-Qed.
-
-Lemma wand_sepcon_adjoint {A} {JA: Join A}{PA: Perm_alg A} : forall (P Q R:pred A),
-  ((P * Q) |-- R) = (P |-- (Q -* R)).
-Proof.
-  intros. apply prop_ext.
-  split; intros.
-  hnf; intros; simpl; intros.
-  hnf; intros.
-  apply H.
-  exists a; exists x; split; auto.
-  hnf; intros.
-  destruct H0 as [w [v [? [? ?]]]].
-  eapply H; eauto.
-Qed.
-
-Lemma ewand_sepcon {A} {JA: Join A}{PA: Perm_alg A}: forall P Q R,
-      (ewand (P * Q) R = ewand P (ewand Q R))%pred.
-Proof.
-intros; apply pred_ext; intros w ?.
-destruct H as [w1 [w2 [? [? ?]]]].
-destruct H0 as [w3 [w4 [? [? ?]]]].
-exists w3.
-destruct (join_assoc (join_comm H0) H) as [wf [? ?]].
-exists wf.
-split; [|split]; auto.
-exists w4. exists w2. split; auto.
-destruct H as [w1 [w2 [? [? ?]]]].
-destruct H1 as [w3 [w4 [? [? ?]]]].
-destruct (join_assoc (join_comm H) (join_comm H1)) as [wf [? ?]].
-exists wf. exists w4. split; [|split]; auto.
-exists w1; exists w3; split; auto.
-Qed.
-
-
-Lemma andp_right {A}  : forall (X P Q:pred A),
-  (X |-- P) ->
-  (X |-- Q) ->
-  X |-- P && Q.
-Proof.
-  unfold derives, imp, andp; simpl; intuition.
-Qed.
-
-
-Lemma andp_left1{A}: forall P Q R: pred A,  (P |-- R) -> P && Q |-- R.
-Proof. repeat intro. destruct H0; auto.
-Qed.
-
-Lemma andp_left2{A}: forall P Q R: pred A,  (Q |-- R) -> P && Q |-- R.
-Proof. repeat intro. destruct H0; auto.
-Qed.
-
-
-Lemma orp_left{A}: forall P Q R: pred A,  (P |-- R) -> (Q |-- R) -> P || Q |-- R.
-Proof. repeat intro. destruct H1; auto.
-Qed.
-
-Lemma orp_right1{A}: forall P Q R: pred A,  (P |-- Q) -> P |-- Q || R.
-Proof. repeat intro. left; auto.
-Qed.
-
-Lemma orp_right2{A}: forall P Q R: pred A,  (P |-- R) -> P |-- Q || R.
-Proof. repeat intro. right; auto.
-Qed.
-
-Lemma exp_right:
-  forall {B A: Type}(x:B) p (q: B -> pred A),
-    (p |-- q x) ->
-    p |-- exp q.
-Proof.
-intros.
-eapply derives_trans; try apply H.
-intros w ?; exists x; auto.
-Qed.
-
-Lemma exp_left:
-  forall {B A: Type}(p: B -> pred A) q,
-  (forall x, p x |-- q) ->
-   exp p |-- q.
-Proof.
-intros.
-intros w [x' ?].
-eapply H; eauto.
-Qed.
-
-
-Lemma allp_right {B A: Type}:
-  forall (P: pred A) (Q: B -> pred A),
-  (forall v, P |-- Q v) ->
-   P |-- allp Q.
-Proof.
- intros. intros w ? v; apply (H v); auto.
-Qed.
-
-Lemma allp_left {B}{A}:
-   forall (P: B -> pred A) x Q, (P x |-- Q) -> allp P |-- Q.
- Proof.
-   intros. intros ? ?. apply H. apply H0.
-Qed.
-
-Lemma imp_andp_adjoint {A}  : forall (P Q R:pred A),
-  ((P && Q) |-- R) <-> (P |-- (Q --> R)).
-Proof.
-  split; intros.
-  hnf; intros; simpl; intros.
-  intro; intros. apply H. split; auto.
-  intro; intros. destruct H0. apply H; auto.
-Qed.
-
-
-Lemma exp_andp1 {A} :
- forall B (p: B -> pred A) q, (exp p && q)%pred = (exp (fun x => p x && q))%pred.
-Proof.
-intros; apply pred_ext; intros w ?.
-destruct H as [[x ?] ?].
-exists x; split; auto.
-destruct H as [x [? ?]]; split; auto. exists x; auto.
-Qed.
-
-
-Lemma exp_sepcon1 {A}  {JA: Join A}{PA: Perm_alg A}:
-  forall T (P: T ->  pred A) Q,  (exp P * Q = exp (fun x => P x * Q))%pred.
-Proof.
-intros.
-apply pred_ext; intros ? ?.
-destruct H as [w1 [w2 [? [[x ?] ?]]]].
-exists x; exists w1; exists w2; split; auto.
-destruct H as [x [w1 [w2 [? [? ?]]]]].
-exists w1; exists w2; split; auto.
-split; auto.
-exists x; auto.
-Qed.
-
-
-Definition pure {A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}
-     (P: pred A) : Prop :=
-   P |-- emp.
-
-Lemma sepcon_pure_andp {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}:
- forall P Q, pure P -> pure Q -> ((P * Q) = (P && Q)).
-Proof.
-intros.
-apply pred_ext; intros w ?.
-destruct H1 as [w1 [w2 [? [? ?]]]].
-unfold pure in *.
-assert (unit_for w1 w2). apply H in H2; simpl in H2;
-apply identity_unit; auto. exists w; auto.
-unfold unit_for in H4.
-assert (w2=w) by (apply (join_eq H4 H1)).
-subst w2.
-assert (join w w1 w1).
-apply identity_unit; apply H0 in H3; simpl in H3; auto. exists w; auto.
-assert (w1=w) by (apply (join_eq H5 (join_comm H1))).
-subst w1.
-split; auto.
-destruct H1.
-exists w; exists w; split; [|split]; auto.
-apply H in H1.
-clear dependent P. clear dependent Q.
-pose proof (core_unit w); unfold unit_for in *.
-pose proof (H1 _ _ (join_comm H)).
-rewrite H0 in H; auto.
-Qed.
-
-Lemma pure_sepcon_TT_andp {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}:
-  forall P Q, pure P -> (P * TT) && Q = (P*Q).
-Proof.
- pose proof I.
-intros.
-apply pred_ext.
-intros w [? ?].
-destruct H1 as [w1 [w2 [? [? ?]]]].
-exists w1; exists w2; split; [|split]; auto.
-apply join_unit1_e in H1; auto.
-subst; auto.
-apply andp_right.
-apply sepcon_derives; auto.
-intros w [w1 [w2 [? [? ?]]]].
-apply join_unit1_e in H1; auto.
-subst; auto.
-Qed.
-
-Lemma ewand_conflict {T}{JT: Join T}{PT: Perm_alg T}{ST: Sep_alg T}:
-       forall P Q R, (sepcon P Q |-- FF) -> andp P (ewand Q R) |-- FF.
-Proof.
- intros. intros w [? [w1 [w2 [? [? ?]]]]].
- specialize (H w2). apply H. exists w; exists w1; repeat split; auto.
-Qed.
-
-Lemma ewand_TT_sepcon {T}{JT: Join T}{PT: Perm_alg T}{ST: Sep_alg T}:
-      forall P Q R,
-(P * Q && ewand R (!!True))%pred |-- (P && ewand R (!!True) * (Q && ewand R (!!True)))%pred.
-Proof.
-intros.
-intros w [[w1 [w2 [? [? ?]]]] [w3 [w4 [? [? ?]]]]].
-exists w1; exists w2; repeat split; auto.
-destruct (join_assoc (join_comm H) (join_comm H2)) as [f [? ?]].
-exists w3; exists f; repeat split; auto.
-destruct (join_assoc H (join_comm H2)) as [g [? ?]].
-exists w3; exists g; repeat split; auto.
-Qed.
diff --git a/msl/predicates_sl.v b/msl/predicates_sl.v
deleted file mode 100644
index d82600bbd3..0000000000
--- a/msl/predicates_sl.v
+++ /dev/null
@@ -1,1130 +0,0 @@
- (*
- * Copyright (c) 2009-2010, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-
-Require Import VST.msl.base.
-Require Import VST.msl.ageable.
-Require Import VST.msl.sepalg.
-Require Import VST.msl.sepalg_generators.
-Require Import VST.msl.age_sepalg.
-Require Import VST.msl.predicates_hered.
-Require Import VST.msl.cross_split.
-
-(* rules about ext_order, join, and core *)
-Class Ext_alg (A : Type) `{EO : Ext_ord A} {J : Join A} {SA : Sep_alg A} :=
-  { ext_join_commut : forall {x y z z'}, join x y z -> ext_order z z' ->
-      exists x', ext_order x x' /\ join x' y z';
-    join_ext_commut : forall {x x' y' z'}, ext_order x x' -> join x' y' z' ->
-      exists z, join x y' z /\ ext_order z z';
-    (* emp is implemented in terms of a minimum element, but we can
-       have different mins for different elements *)
-    id_exists : forall x, exists e, identity e /\ unit_for e x
-  }.
-
-Section Predicates.
-
-Context {A : Type} {JA : Join A} {PA : Perm_alg A} {SA : Sep_alg A} {AG : ageable A} {XA : Age_alg A} {EO : Ext_ord A} {EA : Ext_alg A}.
-
-(*Definition compareR : relation A := comparable.*)
-Definition extendR : relation A := join_sub.
-
-(*Lemma valid_rel_compare {FA: Flat_alg A} : valid_rel compareR.
-Proof.
-  split; hnf; intros.
-
-  apply comparable_common_unit in H0.
-  destruct H0 as [w [? ?]].
-  destruct (age1_join2  _ H1 H)
-    as [u [v [? [? ?]]]].
-  destruct (age1_join _ H0 H3)
-    as [u' [v' [? [? ?]]]].
-  assert (u' = v').
-  unfold age in *; congruence.
-  subst v'.
-  exists u'; auto.
-  assert (x = v).
-  unfold age in *; congruence.
-  subst v.
-  apply common_unit_comparable.
-  exists u; auto.
-
-  split; hnf; intros.
-  apply comparable_common_unit in H.
-  destruct H as [w [? ?]].
-  destruct (unage_join2 _ H H0)
-    as [u [v [? [? ?]]]].
-  destruct (unage_join _ H1 H3)
-    as [u' [v' [? [? ?]]]].
-  exists v'; auto.
-  apply common_unit_comparable.
-  destruct (join_ex_units u) as [uu Huu].
-  red in Huu.
-  exists uu; split.
-  destruct (join_assoc Huu H2) as [q [? ?]].
-  assert (q = z).
-  eapply join_eq; eauto.
-  subst q; auto.
-  destruct (join_assoc Huu H5) as [q [? ?]].
-  assert (q = v').
-  eapply join_eq; eauto.
-  subst q.
-  auto.
-
-  split; hnf; intros.
-  hnf in H.
-Qed.*)
-
-Lemma valid_rel_extend  : valid_rel extendR.
-Proof.
-  split; hnf; intros.
-  destruct H0 as [w ?].
-  destruct (age1_join2 _ H0 H)
-    as [u [v [? [? ?]]]].
-  exists u; auto.
-  exists v; auto.
-
-  split; hnf; intros.
-  destruct H.
-  destruct (unage_join _ H H0)
-    as [u [v [? [? ?]]]].
-  exists v; auto.
-  exists u; auto.
-
-  destruct H.
-  eapply join_ext_commut in H as (? & ? & ?); eauto.
-  eexists; eauto; eexists; eauto.
-Qed.
-
-(*Definition compareM  : modality
-  := exist _ compareR valid_rel_compare.*)
-Definition extendM : modality
-  := exist _ extendR valid_rel_extend.
-
-(* Definitions of the BI connectives. *)
-Local Obligation Tactic := unfold hereditary; intros; try solve [intuition].
-
-(* This is the key point of the ordered logic: emp is true of anything
-   that's in the extension order with an identity.
-   In VeriC, this means the resources are cores but the ghost state
-   can be anything. *)
-Program Definition emp : pred A := fun w => exists e, identity e /\ ext_order e w.
-Next Obligation.
-  split; intros.
-  - destruct H0 as (? & ? & ?).
-    eapply age_ext_commut in H1 as [?? Hage]; eauto.
-    apply age_identity in Hage; eauto.
-  - destruct H0 as (? & ? & ?).
-    do 2 eexists; eauto.
-    etransitivity; eauto.
-Qed.
-
-Program Definition sepcon  (p q:pred A) : pred A := fun x:A =>
-  exists y:A, exists z:A, join y z x /\ p y /\ q z.
-Next Obligation.
-  split; intros.
-  destruct H0 as (y & z & J & ? & ?).
-  destruct (age1_join2 _ J H) as [y' [z' [? [? ?]]]].
-  do 3 eexists; eauto.
-  split; eapply pred_hereditary; eauto.
-
-  destruct H0 as (y & z & J & ? & ?).
-  eapply ext_join_commut in J as (? & ? & ?); eauto.
-  do 3 eexists; eauto; split; auto.
-  eapply pred_upclosed; eauto.
-Qed.
-
-Program Definition wand  (p q:pred A) : pred A := fun x =>
-  forall x' y z, necR x x' -> join x' y z -> p y -> q z.
-Next Obligation.
-  split; intros.
-  eapply (H0 x'); eauto.
-  apply rt_trans with a'; auto.
-  apply rt_step; auto.
-
-  eapply nec_ext_commut in H1 as []; eauto.
-  eapply join_ext_commut in H2 as (? & ? & ?); eauto.
-  eapply pred_upclosed; eauto.
-  eapply H0; eauto.
-Qed.
-
-Notation "P '*' Q" := (sepcon P Q) : pred.
-Notation "P '-*' Q" := (wand P Q) (at level 60, right associativity) : pred.
-Notation "'%' e"  := (box extendM e)(at level 30, right associativity): pred.
-
-Lemma extendM_refl : reflexive _ extendM.
-Proof.
-intros; intro; simpl; apply join_sub_refl.
-Qed.
-
-(*Lemma compareM_refl {A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{FA: Flat_alg A}{AG: ageable A}{XA: Age_alg A} : reflexive _ compareM.
-Proof.
-intros; intro; simpl.
-apply comparable_refl.
-Qed.*)
-
-#[local] Hint Resolve extendM_refl : core.
-(*#[export] Hint Resolve compareM_refl : core.*)
-
-
-(* Rules for the BI connectives *)
-
-Lemma wand_sepcon_adjoint  : forall (P Q R:pred A),
-  ((P * Q) |-- R) = (P |-- (Q -* R)).
-Proof.
-  intros. apply prop_ext.
-  split; intros.
-  hnf; intros; simpl; intros.
-  apply H.
-  exists x'; exists y.
-  intuition.
-  apply pred_nec_hereditary with a; auto.
-  hnf; intros.
-  hnf in H.
-  unfold wand in H; simpl in H.
-  destruct H0 as [w [v [? [? ?]]]].
-  eapply H; eauto.
-Qed.
-
-Lemma sepcon_assoc  : forall (P Q R:pred A),
-  ((P * Q) * R = P * (Q * R))%pred.
-Proof.
-  pose proof I.
-  intros; apply pred_ext; hnf; intros.
-  destruct H0 as [x [y [? [? ?]]]].
-  destruct H1 as [z [w [? [? ?]]]].
-  destruct (join_assoc H1 H0) as [q [? ?]].
-  exists z; exists q; intuition.
-  exists w; exists y; intuition.
-  destruct H0 as [x [y [? [? ?]]]].
-  destruct H2 as [z [w [? [? ?]]]].
-  apply join_comm in H0.
-  apply join_comm in H2.
-  destruct (join_assoc H2 H0) as [q [? ?]].
-  exists q; exists w; intuition.
-  exists x; exists z; intuition.
-Qed.
-
-Lemma sepcon_comm  : forall (P Q:pred A),
-  (P * Q = Q * P)%pred.
-Proof.
-  pose proof I.
-  intros; apply pred_ext; hnf; intros.
-  destruct H0 as [x [y [? [? ?]]]].
-  exists y; exists x; intuition; apply join_comm; auto.
-  destruct H0 as [x [y [? [? ?]]]].
-  exists y; exists x; intuition; apply join_comm; auto.
-Qed.
-
-Lemma split_sepcon  : forall (P Q R S:pred A),
-  (P |-- Q) ->
-  (R |-- S) ->
-  (P * R) |-- (Q * S).
-Proof.
-  intros; hnf; intros.
-  destruct H1 as [x [y [? [? ?]]]].
-  exists x; exists y; intuition.
-Qed.
-
-Lemma sepcon_cut  : forall (P Q R S:pred A),
-  (P |-- (Q -* R)) ->
-  (S |-- Q) ->
-  (P * S) |-- R.
-Proof.
-  intros.
-  rewrite wand_sepcon_adjoint.
-  hnf; intros.
-  simpl; intros.
-  eapply H; eauto.
-Qed.
-
-Lemma id_emp : forall w, identity w -> emp w.
-Proof.
-  intros; exists w; split; auto; reflexivity.
-Qed.
-#[local] Hint Resolve id_emp : core.
-
-Lemma emp_sepcon  : forall (P:pred A),
-  (emp * P = P)%pred.
-Proof.
-  intros; apply pred_ext; hnf; intros.
-  destruct H as [x [y [J [(? & Hid & ?) ?]]]].
-  eapply join_ext_commut in J as (? & J & ?); eauto.
-  eapply pred_upclosed; eauto.
-  apply Hid in J; subst; auto.
-
-  destruct (id_exists a) as (? & ? & ?).
-  do 3 eexists; eauto; split; auto.
-Qed.
-
-Lemma sepcon_emp   : forall (P:pred A),
-  (P * emp = P)%pred.
-Proof.
-  intros.
-  rewrite sepcon_comm.
-  apply emp_sepcon.
-Qed.
-
-(*Lemma emp_sepcon : forall {A} `{Age_alg A} (P:pred A), emp * P = P.
-Proof. exact @emp_sepcon. Qed.
-Lemma sepcon_emp : forall {A} `{Age_alg A} (P:pred A), P * emp = P.
-Proof. exact @sepcon_emp. Qed.
-*)
-	
-Lemma later_wand  : forall P Q,
-  (|>(P -* Q) = |>P -* |>Q)%pred.
-Proof.
-  pose proof I.
-  intros.
-  repeat rewrite later_age.
-  apply pred_ext; hnf; intros.
-  simpl; intros.
-  simpl in H0.
-  case_eq (age1 a); intros.
-  specialize ( H0 a0 H5).
-  apply nec_refl_or_later in H1.
-  destruct H1; subst.
-  destruct (age1_join2 _ H2 H4) as [w [v [? [? ?]]]].
-  eapply H0; eauto.
-  replace a0 with w; auto.
-  congruence.
-  assert (necR a0 x').
-  eapply age_later_nec; eauto.
-  destruct (age1_join2 _ H2 H4) as [w [v [? [? ?]]]].
-  apply H0 with w v; auto.
-  apply rt_trans with x'; auto.
-  apply rt_step; auto.
-  apply nec_refl_or_later in H1; destruct H1; subst.
-  destruct (age1_join2 _  H2 H4) as [w [v [? [? ?]]]].
-  hnf in H6.
-  rewrite H5 in H6; discriminate.
-  clear -H1 H5.
-  exfalso.
-  revert H5; induction H1; auto.
-  intros.
-  unfold age in H.
-  rewrite H in H5; discriminate.
-
-  simpl; intros.
-  simpl in H0.
-  destruct (valid_rel_nec) as (_ & H6 & _).
-  destruct (H6 _ _ H2 _ H1).
-  destruct (unage_join _ H3 H5) as [w [v [? [? ?]]]].
-  apply H0 with x w v; auto.
-  intros.
-  replace a'0 with y; auto.
-  congruence.
-Qed.
-
-Lemma later_sepcon  : forall P Q,
-  (|>(P * Q) = |>P * |>Q)%pred.
-Proof.
-  pose (H:=True).
-  intros.
-  repeat rewrite later_age.
-  apply pred_ext; hnf; intros.
-  simpl in H0.
-  case_eq (age1 a); intros.
-  destruct (H0 a0) as [w [v [? [? ?]]]]; auto.
-  destruct (unage_join2 _ H2 H1) as [w' [v' [? [? ?]]]].
-  exists w'; exists v'; intuition.
-  simpl; intros.
-  replace a' with w; auto.
-  unfold age in *; congruence.
-  simpl; intros.
-  replace a' with v; auto.
-  unfold age in *; congruence.
-  destruct (join_ex_units a).
-  exists x; exists a.
-  intuition.
-  hnf; intros.
-  red in u.
-  simpl in H2.
-  destruct (age1_join _ u H2) as [s [t [? [? ?]]]].
-  unfold age in H5.
-  rewrite H1 in H5; discriminate.
-  hnf; intros.
-  simpl in H2.
-  unfold age in H2.
-  rewrite H1 in H2; discriminate.
-
-  destruct H0 as [w [v [? [? ?]]]].
-  hnf; intros.
-  simpl in H3.
-  destruct (age1_join2 _ H0 H3) as [w' [v' [? [? ?]]]].
-  exists w'; exists v'; intuition.
-Qed.
-
-Lemma FF_sepcon : forall (P:pred A),
-  (FF * P = FF)%pred.
-Proof.
-  intros. apply pred_ext; repeat intro.
-  destruct H as [? [? [? [? ?]]]].  elim H0.
-  elim H.
-Qed.
-
-Lemma sepcon_derives :
-  forall p q p' q', (p |-- p') -> (q |-- q') -> (p * q |-- p' * q').
-Proof.
-intros.
-do 2 intro.
-destruct H1 as [w1 [w2 [? [? ?]]]].
-exists w1; exists w2; repeat split ;auto.
-Qed.
-
-Lemma exp_sepcon1 :
-  forall T (P: T ->  pred A) Q,  (exp P * Q = exp (fun x => P x * Q))%pred.
-Proof.
-intros.
-apply pred_ext; intros ? ?.
-destruct H as [w1 [w2 [? [[x ?] ?]]]].
-exists x; exists w1; exists w2; split; auto.
-destruct H as [x [w1 [w2 [? [? ?]]]]].
-exists w1; exists w2; split; auto.
-split; auto.
-exists x; auto.
-Qed.
-
-Lemma exp_sepcon2 :
-  forall T (P: pred A) (Q: T -> pred A),  (P * exp Q = exp (fun x => P * Q x))%pred.
-Proof.
-intros.
-apply pred_ext; intros ? ?.
-destruct H as [w1 [w2 [? [? [x ?]]]]].
-exists x; exists w1; exists w2; split; auto.
-destruct H as [x [w1 [w2 [? [? ?]]]]].
-exists w1; exists w2; split; auto.
-split; auto.
-exists x; auto.
-Qed.
-
-Lemma extend_later : forall P, (%|>P = |>%P)%pred.
-Proof.
-  intros; rewrite later_commute; auto.
-Qed.
-
-Lemma extend_later' : forall P, boxy extendM P -> boxy extendM (|> P)%pred.
-Proof.
-intros. unfold boxy in *. rewrite later_commute. rewrite H. auto.
-Qed.
-#[local] Hint Resolve extend_later' : core.
-
-Lemma age_sepcon  :
-      forall P Q, (box ageM (P * Q) = box ageM P * box ageM Q)%pred.
-Proof.
-  pose proof I.
-  intros.
-  apply pred_ext; hnf; intros.
-  hnf in H0.
-  case_eq (age1 a); intros.
-  destruct (H0 a0) as [u [v [? [? ?]]]]; auto.
-  red.
-  destruct (unage_join2 _ H2 H1) as [x [y [? [? ?]]]].
-  exists x; exists y.
-  intuition.
-  hnf; intros.
-  replace a' with u; auto.
-  unfold age in *; congruence.
-  hnf; intros.
-  replace a' with v; auto.
-  unfold age in *; congruence.
-  destruct (join_ex_units a).
-  exists x; exists a.
-  intuition.
-  hnf; intros.
-  red in u.
-  destruct (age1_join _ u H2)
-    as [p [q [? [? ?]]]]; auto.
-  unfold age in *.
-  rewrite H1 in H4; discriminate.
-  hnf; intros.
-  simpl in *.
-  unfold age in *.
-  rewrite H1 in H2; discriminate.
-
-  destruct H0 as [u [v [? [? ?]]]].
-  hnf; intros.
-  destruct (age1_join2 _ H0 H3)
-    as [p [q [? [? ?]]]]; auto.
-  exists p; exists q; intuition.
-Qed.
-
-
-Lemma age_twin {FA:Flat_alg A} :
-  forall phi1 phi2 n phi1',
-  comparable phi1 phi2 ->
-  ageN n phi1 = Some phi1' ->
-  exists phi2', ageN n phi2 = Some phi2' /\ comparable phi1' phi2'.
-Proof.
-intros until n; revert n phi1 phi2.
-induction n; intros.
-exists phi2.
-split; trivial.
-inversion H0.
-subst phi1'.
-trivial.
-unfold ageN in H0.
-simpl in H0.
-revert H0; case_eq (age1 phi1); intros; try discriminate.
-rename a into phi.
-assert (exists ophi2, age phi2 ophi2 /\ comparable phi ophi2).
-destruct (comparable_common_unit H) as [e [? ?]].
-destruct (age1_join _ (join_comm H2) H0) as [eo [phi1'a [eof [? ?]]]].
-destruct (age1_join _ H3 H4) as [phi2' [phi2'a [eof' [? ?]]]].
-unfold age in H7. rewrite H6 in H7. symmetry in H7; inv H7.
-rewrite H5 in H0. inv H0.
-exists phi2'. split; auto.
-apply common_unit_comparable; exists eo; split; auto.
-destruct H2 as [ophi2 [? ?]].
-specialize (IHn _ _ _ H3 H1).
-destruct IHn as [phi2' [? ?]].
-exists phi2'.
-split; trivial.
-unfold ageN.
-simpl.
-rewrite H2.
-trivial.
-Qed.
-
-Lemma ageN_different {FA: Flat_alg A} : forall n phi phi', ageN (S n) phi = Some phi' ->
-    ~ comparable phi phi'.
-Proof.
-   intros.
-   intro.
-   generalize (age_noetherian' phi); intros [k [[? [? ?]] H4]].
-   assert (k <= n \/ k > n)%nat by lia.
-   destruct H3.
-   replace (S n) with (k + (S n - k))%nat in H by lia.
-   destruct (ageN_compose' _ _ _ _ H) as [b [? ?]].
-   rewrite H1 in H5; inv H5.
-   replace (S n - k)%nat with (S (n-k))%nat in H6 by lia.
-   unfold ageN in H6; simpl in H6. rewrite H2 in H6; inv H6.
-   replace k with (S n + (k - S n))%nat in H1 by lia.
-   destruct (ageN_compose' _ _ _ _ H1) as [c [? ?]].
-   rewrite H in H5; inv H5.
-   destruct (age_twin phi c _ _ H0 H1) as [b [? ?]].
-   replace (S n + (k - S n))%nat with ((k - S n) + S n)%nat in H5 by lia.
-   destruct (ageN_compose' _ _ _ _ H5) as [d [? ?]].
-   rewrite H6 in H8; inv H8.
-   clear - H9 H2.
-   unfold ageN in H9; simpl  in H9; rewrite H2 in H9; inv H9.
-Qed.
-
-Lemma necR_comparable {FA: Flat_alg A} :
-  forall w w', necR w w' -> comparable w w' -> w=w'.
-Proof.
-intros.
-rewrite necR_evolve in H.
-destruct H as [n H].
-destruct n.
-inv H; auto.
-contradiction (ageN_different _ _ _ H); auto.
-Qed.
-
-
-Lemma sepcon_andp_prop :
-  forall P Q R, (P * (!!Q && R) = !!Q && (P * R))%pred.
-Proof.
-intros.
-apply pred_ext; intros w ?.
-destruct H as [w1 [w2 [? [? [? ?]]]]].
-split. apply H1.
-exists w1; exists w2; split; [|split]; auto.
-destruct H.
-destruct H0 as [w1 [w2 [? [? ?]]]].
-exists w1; exists w2; repeat split; auto.
-Qed.
-
-Lemma TT_sepcon_TT : (TT * TT = TT)%pred.
-Proof.
-intros.
-apply pred_ext; intros w ?; auto.
-destruct (join_ex_units w).
-exists x; exists w; split; auto.
-Qed.
-
-
-Lemma join_exactly {FA:Flat_alg A}:
-  forall w1 w2 w3, join w1 w2 w3 ->  (exactly w1 * exactly w2 = exactly w3)%pred.
-Proof.
-pose proof I.
-intros.
-unfold exactly.
-apply pred_ext; intros w ?; simpl in *.
-destruct H1 as (? & ? & J & (? & ? & ?) & (w2' & ? & ?)).
-eapply join_ext_commut in J as (? & J & ?); eauto.
-eapply join_comm, join_ext_commut in J as (? & J & ?); eauto.
-destruct (nec_join H0 H1) as [a [b [J' [? ?]]]].
-assert (w2'=a); subst.
- eapply necR_linear'; eauto.
- repeat match goal with H : ext_order _ _ |- _ => apply ext_level in H
-                      | H : join _ _ _ |- _ => apply join_level in H as [] end; lia.
-eapply join_comm, join_eq in J; eauto; subst.
-do 2 eexists; eauto; etransitivity; eauto.
-
-destruct H1 as (? & ? & ?).
-eapply nec_join2 in H0 as (? & ? & J & ? & ?); eauto.
-eapply ext_join_commut in J as (? & ? & ?); eauto.
-do 3 eexists; eauto.
-split; do 2 eexists; eauto.
-Qed.
-
-Lemma extend_sepcon_andp :
-  forall P Q R, boxy extendM Q -> P * (Q && R) |-- Q && (P * R).
-Proof.
-intros.
-intros ?w [?w [?w [? [? [? ?]]]]].
-split.
-rewrite <- H in H2.
-eapply H2.
-exists w0.
-apply join_comm; auto.
-exists w0; exists w1; auto.
-Qed.
-Arguments extend_sepcon_andp : clear implicits.
-
-Lemma distrib_sepcon_andp :
-  forall P Q R, P * (Q && R) |-- (P * Q) && (P * R).
-Proof.
-intros. intros w [w1 [w2 [? [? ?]]]].
-destruct H1.
-split; exists w1; exists w2; split; auto.
-Qed.
-
-Lemma modus_wand :
-  forall P Q,  P * (P -* Q) |-- Q.
-Proof.
-intros.
-intros w  [?w [?w [? [? ?]]]].
-eapply H1; eauto.
-Qed.
-
-Lemma extend_sepcon :
-  forall {Q R: pred A}, boxy extendM Q ->  Q * R |-- Q.
-Proof.
-intros.
-intros w [w1 [w2 [? [? _]]]].
-rewrite <- H in H1. eapply H1; eauto.
-simpl; eauto.
-exists w2; auto.
-Qed.
-
-Definition precise  (P: pred A) : Prop :=
-     forall w w1 w2, P w1 -> P w2 -> join_sub w1 w -> join_sub w2 w -> w1=w2.
-
-Definition precise2   (P: pred A) : Prop :=
-     forall Q R, (P * (Q && R) = (P * Q) && (P * R))%pred.
-
-(*Lemma precise_eq {CA: Canc_alg A}: precise =
-                 fun P : pred A => forall Q R, (P * (Q && R) = (P * Q) && (P * R))%pred.
-Proof.
-extensionality P.
-unfold precise.
-apply prop_ext; split; intros.
-apply pred_ext; unfold derives; intros; rename a into w.
-destruct H0 as [phi1 [phi2 [? [? [? ?]]]]].
-split; exists phi1; exists phi2; auto.
-destruct H0 as [[phi1a [phi2a [? [? ?]]]] [phi1b [phi2b [? [? ?]]]]].
-specialize (H w _ _ H1 H4).
-spec H.
-econstructor; eauto.
-spec H.
-econstructor; eauto.
-subst phi1b.
-generalize (join_canc (join_comm H0) (join_comm H3)).
-intro; subst phi2b.
-exists phi1a; exists phi2a; split; auto.
-split; auto.
-split; auto.
-rename w1 into w1a.
-rename w2 into w1b.
-destruct H2 as [w2a ?].
-destruct H3 as [w2b ?].
-assert (((P * exactly w2a) && (P * exactly w2b)) w)%pred.
-split; do 2 econstructor; repeat split;
-try solve [simpl; do 2 eexists; [apply necR_refl | reflexivity]].
-eassumption. auto. eassumption. auto.
-rewrite <- H in H4.
-destruct H4 as [w1 [w2 [? [? [? ?]]]]].
-destruct H6 as (? & ? & ?), H7 as (? & ? & ?).
-rewrite (necR_comparable _ _ H6) in H2.
-rewrite (necR_comparable _ _ H7) in H3.
-eapply join_canc; eauto.
-apply comparable_trans with w.
-apply join_comparable with w1b; auto.
-apply comparable_sym; apply join_comparable with w1; auto.
-apply comparable_trans with w.
-apply join_comparable with w1a; auto.
-apply comparable_sym; apply join_comparable with w1; auto.
-Qed.*)
-
-Lemma derives_precise :
-  forall P Q, (P |-- Q) -> precise Q -> precise P.
-Proof.
-intros; intro; intros; eauto.
-Qed.
-
-(*Lemma precise_emp : precise emp.
-Proof.
-repeat intro.
-eapply join_sub_same_identity with (a := w1)(c := w); auto.
-apply identity_unit'; auto.
-eapply join_sub_unit_for; eauto.
-apply identity_unit'; auto.
-Qed.*)
-
-Definition superprecise  (P: pred A) :=
-   forall w1 w2, P w1 -> P w2 -> comparable w1 w2 -> w1=w2.
-
-(*Lemma superprecise_exactly : forall w, superprecise (exactly w).
-Proof.
-unfold superprecise; intros.
-destruct H as (? & ? & ?), H0 as (? & ? & ?).
-eapply necR_linear' in H; eauto; subst.
-apply comparable_fashionR; auto.
-Qed.
-#[export] Hint Resolve superprecise_exactly : core.*)
-
-(*Lemma superprecise_precise : forall (P: pred A) , superprecise P -> precise P.
-Proof.
-  pose proof I.
-  unfold precise. unfold superprecise.
-  intros.
-  assert (comparable w1 w2). assert (comparable w1 w) by apply (join_sub_comparable H3).
-  assert (comparable w w2).
-    apply comparable_sym; destruct H4; eapply join_comparable; eauto.
-    apply (comparable_trans H5 H6).
-  apply (H0 _ _ H1 H2 H5).
-Qed.*)
-
-(* EXistential Magic Wand *)
-
-Program Definition ewand  (P Q: pred A) : pred A :=
-  fun w => forall w' w'', necR w w' -> ext_order w' w'' -> exists w1, exists w2, join w1 w'' w2 /\ P w1 /\ Q w2.
-Next Obligation.
-split; intros.
-eapply H0; [|eauto].
-eapply rt_trans, H1. apply rt_step; auto.
-
-eapply nec_ext_commut in H as []; [|eauto].
-eapply H0; eauto.
-etransitivity; eauto.
-Qed.
-
-Lemma later_0 : forall a P, level a = 0 -> (|> P)%pred a.
-Proof.
-  repeat intro.
-  apply age1_level0 in H.
-  apply laterR_power_age in H0 as (? & ? & ? & ?); congruence.
-Qed.
-
-(*Lemma later_ewand  : forall P Q,
-  (|>(ewand P Q) = ewand (|>P) (|>Q))%pred.
-Proof.
-intros.
-apply pred_ext.
-intros w ? ????.
-apply nec_refl_or_later in H0 as [|].
-subst w'.
-case_eq (age1 w); intros.
-eapply ext_age_compat in H1 as (? & ? & Hext); eauto.
-specialize (H _ (t_step _ _ _ _ H0) _ _ (necR_refl _) Hext).
-destruct H as [a1 [a2 [? [? ?]]]].
-destruct (unage_join _ (join_comm H) H1) as [w1 [w2 [? [? ?]]]].
-exists w1; exists w2; split; [|split]; auto.
-hnf; intros.
-apply pred_nec_hereditary with a1; auto.
-eapply age_later_nec; eauto.
-hnf; intros.
-apply pred_nec_hereditary with a2; auto.
-eapply age_later_nec; eauto.
-apply age1_level0 in H0.
-apply ext_level in H1.
-rewrite H0 in H1.
-eexists _, _.
-split.
-apply core_unit.
-split; apply later_0; auto.
-rewrite level_core; auto.
-specialize (H _ H0 _ _ (necR_refl _) H1).
-destruct H as [a1 [a2 [? [? ?]]]].
-do 3 eexists; eauto.
-split; intros ??; eapply pred_nec_hereditary; try apply laterR_necR; eauto.
-
-intros w ???????.
-hnf in H.
-destruct (H w' w'') as (? & ? & ? & ? & ?); auto.
-{ eapply rt_trans, H1. apply laterR_necR; auto. }
-eapply join_ext_commut in H2 as (? & ? & ?); eauto.
-Search necR laterR.
-intros w [w1 [w2 [? [? ?]]]].
-intros w' ?.
-hnf in H2. apply clos_trans_t1n in H2.
-revert w1 w2 H H0 H1; induction H2; intros.
-destruct (age1_join _ (join_comm H0) H) as [w1' [w2' [? [? ?]]]].
-exists w1'; exists w2'; split; auto.
-split.
-eapply H1. hnf; apply clos_t1n_trans. constructor 1; auto.
-eapply H2. hnf; apply clos_t1n_trans. constructor 1; auto.
-destruct (age1_join _ (join_comm H0) H) as [w1' [w2' [? [? ?]]]].
-apply (IHclos_trans_1n _ _ (join_comm H4)); auto; eapply pred_hereditary; eauto.
-Qed.*)
-
-Notation "P '-o' Q" := (ewand P Q) (at level 60, right associativity).
-
-(*Lemma emp_ewand :
-      forall P, ewand emp P = P.
-Proof.
-intros.
-apply pred_ext; intros w ?.
-specialize (H _ _ (necR_refl _) (ext_refl _)).
-destruct H as [w1 [w2 [? [? ?]]]].
-hnf in H0.
-replace w with w2; auto.
-eapply join_eq; eauto.
-eapply identity_unit; eauto.
-destruct (join_ex_identities w) as [e [He [? Hj]]].
-exists e; exists w.
-split; auto.
-specialize (He _ _ Hj); subst; auto.
-Qed.
-
-
-Lemma pry_apart {CA: Canc_alg A}{DA: Disj_alg A}{CrA: Cross_alg A}:
-  forall G P Q, superprecise G -> P = ewand G (G * P)%pred ->
-                       (P * Q) && (G * TT) |-- (P * G * (ewand G Q)).
-Proof.
- pose proof I. intros.
-intros w [? ?].
-destruct H2 as [w2 [w3 [? [? Hq]]]].
-destruct H3 as [w4 [w5 [? [? _]]]].
-rewrite H1 in H4.
-destruct H4 as [wa [wb [? [? ?]]]].
-assert (wa = w4). apply H0; auto.
-apply comparable_trans with w2. apply join_comparable2 with wb; auto.
-apply comparable_trans with w. apply join_comparable with w3; auto.
-apply comparable_sym. apply join_comparable with w5; auto.
-subst wa; clear H6.
-destruct H7 as [w4' [w2' [? [? ?]]]].
-assert (w4' = w4). apply H0; auto.
-apply comparable_trans with wb. eapply join_comparable; eauto.
-apply comparable_sym.  eapply join_comparable; eauto.
-subst w4'; clear H7.
-assert (w2' = w2). eapply join_canc; try apply join_comm; eauto.
-subst w2'; clear H6.
-destruct (CrA _ _ _ _ _ H2 H3) as [[[[w24 w25] w34] w35] [? [? [? ?]]]].
-assert (identity w24).
-  destruct (join_assoc (join_comm H9) H4) as [f [? ?]].
-  destruct (join_assoc (join_comm H6) (join_comm H11)) as [g [? ?]].
-  eapply join_self; eauto.
-assert (w34=w4). eapply join_eq; [eapply identity_unit; eauto | auto ].
-subst w34.
-assert (w25 = w2). eapply join_eq; [eapply identity_unit; eauto | auto ].
-subst w25.
-clear H11 H9 H6 w24.
-destruct (join_assoc (join_comm H10) (join_comm H3)) as [h [? ?]].
-generalize (join_eq H6 (join_comm H4)); clear H6; intro; subst h.
-destruct (join_assoc (join_comm H4) (join_comm H9)) as [h [? ?]].
-generalize (join_eq H6 H7); clear H6; intro; subst h.
-clear H11.
-exists wb; exists w35.
-split. apply join_comm; auto.
-split; auto.
-exists w2; exists w4; split; auto.
-unfold ewand.
-exists w4; exists w3; split; auto.
-Qed.*)
-
-Definition wk_split :=
-      forall a b c d e : A, join a b c -> join d e c -> joins a d -> join_sub d b.
-
-Lemma crosssplit_wkSplit {DA: Disj_alg A}{CrA: Cross_alg A}:
-    wk_split.
-Proof.
-unfold wk_split; intros.
-destruct (CrA _ _ _ _ _ H H0) as [[[[ad ae] bd] be] [myH1 [myH2 [myH3 myH4]]]].
-destruct H1 as [x H_x].
-assert (exists X, join ad X be) as [X HX].
-2:{   exists X.
-               destruct (join_assoc (join_comm HX) (join_comm myH2)) as [y [myH5 myH6]].
-               assert (y=d) by apply (join_eq myH5 myH3).  subst y.
-               apply (join_comm myH6).
-}
-destruct (join_assoc (join_comm myH1) H_x) as [y [myH5 myH6]].
-destruct (join_assoc (join_comm myH3) (join_comm myH5)) as [? [Had ?]].
-apply join_self in Had.
-pose proof (Had _ _ myH1); subst.
-destruct (join_assoc (join_comm myH1) myH4) as [? [Hbe ?]].
-specialize (Had _ _ Hbe); subst; eauto.
-Qed.
-
-(*Lemma wk_pry_apart {CA: Canc_alg A}{DA: Disj_alg A}{CrA: Cross_alg A}:
-  forall G P Q, wk_split -> superprecise G -> P = ewand G (G * P) ->
-                       (P * Q) && (G * TT) |-- (P * G * (ewand G Q)).
-Proof.
-intros.
-intros w [? ?]. unfold ewand.
-destruct H2 as [w2 [w3 [? [? Hq]]]].
-destruct H3 as [w4 [w5 [? [? _]]]].
-rewrite H1 in H4.
-destruct H4 as [wa [wb [? [? ?]]]].
-assert (wa = w4). apply H0; auto.
-apply comparable_trans with w2. eapply join_comparable2; eauto.
-apply comparable_trans with w. eapply join_comparable; eauto.
-apply comparable_sym.  eapply join_comparable; eauto.
-subst wa; clear H6.
-destruct H7 as [w4' [w2' [? [? ?]]]].
-assert (w4' = w4). apply H0; auto.
-apply comparable_trans with wb. eapply join_comparable; eauto.
-apply comparable_sym.  eapply join_comparable; eauto.
-subst w4'; clear H7.
-assert (w2' = w2). eapply join_canc; try apply join_comm; eauto.
-subst w2'; clear H6.
-assert (exists y, join w2 y w5).
-    destruct (H _ _ _ _ _ H2 H3 (join_joins (join_comm H4))).
-    destruct (join_assoc H6 (join_comm H2)) as [y [myH1 myH2]].
-    assert (y=w5) by apply (join_canc  (join_comm myH2) (join_comm H3)). subst y.
-    exists x. apply (join_comm myH1).
-exists wb.
-destruct H6 as [y w2_y_w5].
-               destruct (join_assoc w2_y_w5 (join_comm H3)) as [x [myH1 myH2]].
-               destruct (join_assoc  (join_comm myH1) (join_comm myH2)) as [z [myH3 myH4]].
-                                        assert (w5=z) by apply  (join_canc (join_comm H3) (join_comm myH4)). subst w5.
-                                        assert (w3=x) by apply (join_canc (join_comm H2) (join_comm myH2)).  subst w3.
-                                        destruct (join_assoc myH3 (join_comm myH4)) as [u [myH5 myH6]].
-                                        assert (wb=u) by apply (join_eq H4 (join_comm myH5)). subst wb.
-               exists y. split. apply (join_comm myH6).
-               split. exists w2. exists w4. split. apply (join_comm H4). split; assumption.
-               exists w4. exists x; split. apply (join_comm myH1). split; assumption.
-Qed.
-
-Lemma ewand_overlap {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{CA: Canc_alg A}{DA: Disj_alg A}{CrA: Cross_alg A}{AG: ageable A}{XA: Age_alg A}:
-    forall (P Q: pred A),
-       superprecise Q ->
-       ewand TT (P * Q) * Q |-- ewand TT (P * Q).
-Proof.
-intros P Q PrecQ.
-intros w [w1 [w2 [? [? ?]]]].
-destruct H0 as [w5 [w6 [? [_ ?]]]].
-destruct H2 as [w3 [w4 [? [? ?]]]].
-generalize (PrecQ  _ _ H4 H1); clear H4; intro.
-spec H4.
-apply comparable_trans with w6.
-apply join_comparable with w3; apply join_comm; auto.
-apply comparable_trans with w1.
-apply comparable_sym; apply join_comparable with w5; apply join_comm; auto.
-eapply join_comparable2; eauto.
-subst w4.
-destruct (CrA _ _ _ _ _ H0 H2) as [[[[a b] c] d] [? [? [? ?]]]].
-destruct (join_assoc H5 H) as [f [? ?]].
-destruct (join_assoc H7 (join_comm H8)) as [g [? ?]].
-generalize (join_self' H10); intro.
-subst g.
-assert (identity d).
-eapply unit_identity; eauto.
-assert (b=w2).
-eapply join_canc; eauto.
-subst b.
-assert (f=w2).
-eapply join_eq; eauto.
-subst f.
-clear H11 H10 H7.
-assert (c=w1).
- specialize ( H12 c w1). apply H12. auto.
-subst c.
-clear H9 H5.
-destruct (join_assoc H6 H2) as [h [? ?]].
-generalize (join_eq H5 H); clear H5; intro; subst h.
-exists a; exists w6; split; auto.
-split; auto.
-exists w3; exists w2; split; auto.
-Qed.*)
-
-Lemma ewand_derives :
-  forall P P' Q Q',  (P |-- P') -> (Q |-- Q') -> ewand P Q |-- ewand P' Q'.
-Proof.
-intros.
-intros w ? ????.
-specialize (H1 _ _ H2 H3).
-destruct H1 as [?w [?w [? [? ?]]]].
-exists w0; exists w1; split; auto.
-Qed.
-
-(*Lemma ewand_sepcon : forall P Q R,
-      (ewand (P * Q) R = ewand P (ewand Q R))%pred.
-Proof.
-intros; apply pred_ext; intros w ? ????.
-destruct (H _ _ H0 H1) as [w1 [w2 [? [? ?]]]].
-destruct H3 as [w3 [w4 [? [? ?]]]].
-exists w3.
-destruct (join_assoc (join_comm H3) H2) as [wf [? ?]].
-exists wf.
-split; [|split]; auto.
-intros ????.
-eapply nec_join2 in H7 as (? & ? & ? & ? & ?); eauto.
-eapply ext_join_commut in H10 as (? & ? & ?); eauto.
-eapply join_ext_commut in H1 as (? & ? & ?); eauto.
-specialize (H 
-
-exists w4. exists w2. split; auto.
-destruct H as [w1 [w2 [? [? ?]]]].
-destruct H1 as [w3 [w4 [? [? ?]]]].
-destruct (join_assoc (join_comm H) (join_comm H1)) as [wf [? ?]].
-exists wf. exists w4. split; [|split]; auto.
-exists w1; exists w3; split; auto.
-Qed.*)
-
-(*Lemma ewand_sepcon_assoc {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{FA: Flat_alg A}{CrA: Cross_alg A}{AG: ageable A}{XA: Age_alg A}:
-  Trip_alg A ->
-  forall P Q R: pred A,
-      (forall w1 w2 w3, join w1 w2 w3 -> P w3 -> P w1) ->
-      (forall w w', comparable w w' -> P w -> R w' -> joins w w') ->
-      ((ewand TT P) && (ewand TT R) |-- emp) ->
-     (ewand P (Q * R) = (ewand P Q * R))%pred.
-Proof.
-intros TRIPLE P Q R ?H Hjoins ?H.
-apply pred_ext; intros w ?.
-destruct H1 as [w1 [w2 [? [? ?]]]].
-destruct H3 as [w3 [w4 [? [? ?]]]].
-destruct (CrA _ _ _ _ _ H1 H3) as [[[[? ?] ?] ?] [? [? [? ?]]]].
-generalize (H _ _ _ (join_comm H6) H2); intro.
-assert (emp a0).
-apply H0.
-split.
-2:{ do 2 econstructor; (split; [|split]). 3: eauto. eauto. auto. }
-exists a; exists w1; split; [|split]; eauto.
-apply join_unit2_e in H6; auto.
-subst a.
-apply join_unit1_e in H9; auto.
-subst a2.
-exists a1; exists w4; split; [|split]; auto.
-do 2 econstructor; eauto.
-(*****)
-destruct H1 as [w1 [wR [? [? ?]]]].
-destruct H2 as [wP [wQ [? [? ?]]]].
-apply join_comm in H2.
-specialize (Hjoins wP wR).
-spec Hjoins.
-apply comparable_trans with w1; eapply join_comparable2; eauto.
-destruct Hjoins as [w6 ?]; auto.
-destruct (TRIPLE _ _ _ _ _ _ H1 (join_comm H6) H2) as [wQR ?].
-exists wP. exists wQR.
-split; [|split]; auto.
-destruct (join_assoc H1 j) as [wf [? ?]].
-generalize (join_eq H6 (join_comm H7)); clear H6; intros; subst w6.
-destruct (join_assoc H7 (join_comm H8)) as [wg [? ?]].
-generalize (join_eq H2 (join_comm H6)); clear H6; intros; subst wg.
-do 2 econstructor; eauto.
-Qed.
-
-
-Lemma ewand_sepcon2 {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{CA: Canc_alg A}{DA: Disj_alg A}{CrA: Cross_alg A}{AG: ageable A}{XA: Age_alg A}:
-      forall
-          R (SP: superprecise R)
-          P (H: P = ewand R (R * P))
-          Q,
-          ewand P (Q * R) |-- ewand P Q * R.
-Proof.
-intros.
-intros w ?.
-destruct H0 as [w1 [w34 [? [? [w3 [w4 [? [? ?]]]]]]]].
-generalize (crosssplit_wkSplit  _ _ _ _ _ H0 (join_comm H2)); unfold wk_split; intro.
-spec H5.
-rewrite H in H1.
-destruct H1 as [wa [wb [? [? ?]]]].
-generalize (SP _ _ H6 H4); clear H4; intro.
-spec H4.
-apply comparable_trans with w34. apply comparable_trans with w1.
-eapply join_comparable2; eauto. eapply join_comparable; eauto.
-apply comparable_sym; eapply join_comparable; eauto.
-subst wa.
-destruct H7 as [wx [wy [? [? ?]]]].
-generalize (SP _ _ H7 H6); clear H7; intro.
-spec H7.
-apply comparable_trans with wb.  eapply join_comparable; eauto.
-apply comparable_sym; eapply join_comparable; eauto.
-subst wx.
-generalize (join_canc (join_comm H1) (join_comm H4)); clear H4; intro.
-subst wy.
-econstructor; eauto.
-destruct H5 as [w5 ?].
-exists w5; exists w4; split; [|split]; auto.
-exists w1; exists w3; split; [|split]; auto.
-destruct (join_assoc H5 (join_comm H0)) as [wf [? ?]].
-generalize (join_canc (join_comm H7) H2); clear H7; intro.
-subst wf.
-auto.
-Qed.*)
-
-Lemma sepcon_andp_prop2 :
-  forall P Q R,  (P * (!!Q && R) = !!Q && (P * R))%pred.
-Proof.
-intros.
-apply pred_ext; intros w ?.
-destruct H as [w1 [w2 [? [? [? ?]]]]].
-split. apply H1.
-exists w1; exists w2; split; [|split]; auto.
-destruct H.
-destruct H0 as [w1 [w2 [? [? ?]]]].
-exists w1; exists w2; repeat split; auto.
-Qed.
-
-Lemma sepcon_andp_prop1 :
-   forall (P: Prop) (Q R: pred A) , ((!! P && Q) * R = !! P && (Q * R))%pred.
-Proof.
- intros. rewrite (sepcon_comm). rewrite sepcon_andp_prop2. rewrite sepcon_comm; auto.
-Qed.
-
-Lemma distrib_orp_sepcon :
-  forall (P Q R : pred A), ((P || Q) * R = P * R || Q * R)%pred.
-Proof.
- intros. apply pred_ext.
-  intros w [w1 [w2 [? [[?|?] ?]]]]; [left|right]; exists w1; exists w2; repeat split; auto.
- intros ? [?|?];  destruct H as [w1 [w2 [? [? ?]]]]; exists w1; exists w2; repeat split; auto.
-  left; auto. right; auto.
-Qed.
-
-Lemma distrib_orp_sepcon2:
-  forall (P Q R : pred A),
-     (R * (P || Q) = R * P || R * Q)%pred.
-Proof.
-intros. rewrite !(sepcon_comm R). apply distrib_orp_sepcon.
-Qed.
-
-Lemma ewand_conflict :
-       forall P Q R, (sepcon P Q |-- FF) -> andp P (ewand Q R) |-- FF.
-Proof.
- intros. intros w [HP Hwand].
- specialize (Hwand _ _ (necR_refl _) (ext_refl _)).
- destruct Hwand as [w1 [w2 [? [? ?]]]].
- apply (H w2). exists w; exists w1; repeat split; auto.
-Qed.
-
-(*Lemma ewand_TT_sepcon :
-      forall P Q R,
-(P * Q && ewand R (!!True))%pred |-- (P && ewand R (!!True) * (Q && ewand R (!!True)))%pred.
-Proof.
-intros.
-intros w [[w1 [w2 [? [? ?]]]] Hwand].
-exists w1; exists w2; repeat split; auto;
-intros ?? Hnec Hext.
-- eapply nec_join in Hnec as (? & ? & ? & ? & Hw); eauto.
-  specialize (Hwand _ _ Hw (ext_refl _)).
-  destruct Hwand as (? & ? & J & ? & _).
-  Search ext_order join.
-destruct (join_assoc (join_comm H) (join_comm H2)) as [f [? ?]].
-exists w3; exists f; repeat split; auto.
-destruct (join_assoc H (join_comm H2)) as [g [? ?]].
-exists w3; exists g; repeat split; auto.
-Qed.*)
-
-End Predicates.
-
-Notation "P '*' Q" := (sepcon P Q) : pred.
-Notation "P '-*' Q" := (wand P Q) (at level 60, right associativity) : pred.
-Notation "'%' e"  := (box extendM e)(at level 30, right associativity): pred.
-Notation "P '-o' Q" := (ewand P Q) (at level 60, right associativity).
-
-#[export] Hint Resolve id_emp : core.
-#[export] Hint Resolve extendM_refl : core.
-#[export] Hint Resolve extend_later' : core.
diff --git a/msl/predicates_sl_simple.v b/msl/predicates_sl_simple.v
deleted file mode 100644
index 8226cf4b5e..0000000000
--- a/msl/predicates_sl_simple.v
+++ /dev/null
@@ -1,1046 +0,0 @@
- (*
- * Copyright (c) 2009-2010, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-
-Require Import VST.msl.base.
-Require Import VST.msl.ageable.
-Require Import VST.msl.sepalg.
-Require Import VST.msl.sepalg_generators.
-Require Import VST.msl.age_sepalg.
-Require Import VST.msl.predicates_hered.
-Require Import VST.msl.cross_split.
-
-Definition compareR {A} {JA: Join A}{SA: Sep_alg A}{AG: ageable A} : relation A
-   := comparable.
-Definition extendR  {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A} : relation A := join_sub.
-
-Lemma valid_rel_compare {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{FA: Flat_alg A}{AG: ageable A}{XA: Age_alg A} : valid_rel compareR.
-Proof.
-  split; hnf; intros.
-
-  apply comparable_common_unit in H0.
-  destruct H0 as [w [? ?]].
-  destruct (age1_join2  _ H1 H)
-    as [u [v [? [? ?]]]].
-  destruct (age1_join _ H0 H3)
-    as [u' [v' [? [? ?]]]].
-  assert (u' = v').
-  unfold age in *; congruence.
-  subst v'.
-  exists u'; auto.
-  assert (x = v).
-  unfold age in *; congruence.
-  subst v.
-  apply common_unit_comparable.
-  exists u; auto.
-
-  apply comparable_common_unit in H.
-  destruct H as [w [? ?]].
-  destruct (unage_join2 _ H H0)
-    as [u [v [? [? ?]]]].
-  destruct (unage_join _ H1 H3)
-    as [u' [v' [? [? ?]]]].
-  exists v'; auto.
-  apply common_unit_comparable.
-  destruct (join_ex_units u) as [uu Huu].
-  red in Huu.
-  exists uu; split.
-  destruct (join_assoc Huu H2) as [q [? ?]].
-  assert (q = z).
-  eapply join_eq; eauto.
-  subst q; auto.
-  destruct (join_assoc Huu H5) as [q [? ?]].
-  assert (q = v').
-  eapply join_eq; eauto.
-  subst q.
-  auto.
-Qed.
-
-Lemma valid_rel_extend {A}  {JA: Join A}{PA: Perm_alg A}{SA : Sep_alg A}{AG: ageable A}{XA: Age_alg A} : valid_rel extendR.
-Proof.
-  intros; split; hnf; intros.
-  destruct H0 as [w ?].
-  destruct (age1_join2 _ H0 H)
-    as [u [v [? [? ?]]]].
-  exists u; auto.
-  exists v; auto.
-
-  destruct H.
-  destruct (unage_join _ H H0)
-    as [u [v [? [? ?]]]].
-  exists v; auto.
-  exists u; auto.
-Qed.
-
-Definition compareM {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{FA: Flat_alg A}{AG: ageable A}{XA: Age_alg A} : modality
-  := exist _ compareR valid_rel_compare.
-Definition extendM {A}{JA: Join A}{PA: Perm_alg A}{SA : Sep_alg A}{AG: ageable A}{XA: Age_alg A} : modality
-  := exist _ extendR valid_rel_extend.
-
-(* Definitions of the BI connectives. *)
-Local Obligation Tactic := unfold hereditary; intros; try solve [intuition].
-
-Program Definition emp {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A} : pred A := identity.
-Next Obligation.
-  repeat intro.
-  destruct (unage_join _ H1 H) as [a0' [b' [? [? ?]]]].
-  apply H0 in H2. subst b'. unfold age in H3, H4. congruence.
-Qed.
-
-Program Definition sepcon {A}  {JA: Join A}{PA: Perm_alg A}{SA : Sep_alg A}{AG: ageable A}{XA: Age_alg A} (p q:pred A) : pred A := fun x:A =>
-  exists y:A, exists z:A, join y z x /\ p y /\ q z.
-Next Obligation.
-  destruct H0 as [y [z [? [? ?]]]].
-  destruct (age1_join2 _ H0 H) as [w [v [? [? ?]]]].
-  exists w; exists v; split; auto.
-  split.
-  apply pred_hereditary with y; auto.
-  apply pred_hereditary with z; auto.
-Qed.
-
-Program Definition wand {A}  {JA: Join A}{PA: Perm_alg A}{SA : Sep_alg A}{AG: ageable A}{XA: Age_alg A} (p q:pred A) : pred A := fun x =>
-  forall x' y z, necR x x' -> join x' y z -> p y -> q z.
-Next Obligation.
-  apply H0 with x' y; auto.
-  apply rt_trans with a'; auto.
-  apply rt_step; auto.
-Qed.
-
-Notation "P '*' Q" := (sepcon P Q) : pred.
-Notation "P '-*' Q" := (wand P Q) (at level 60, right associativity) : pred.
-Notation "'%' e"  := (box extendM e)(at level 30, right associativity): pred.
-
-Lemma extendM_refl {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}: reflexive _ extendM.
-Proof.
-intros; intro; simpl; apply join_sub_refl.
-Qed.
-
-Lemma compareM_refl {A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{FA: Flat_alg A}{AG: ageable A}{XA: Age_alg A} : reflexive _ compareM.
-Proof.
-intros; intro; simpl.
-apply comparable_refl.
-Qed.
-
-#[export] Hint Resolve extendM_refl : core.
-#[export] Hint Resolve compareM_refl : core.
-
-
-(* Rules for the BI connectives *)
-
-Lemma wand_sepcon_adjoint {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A} : forall (P Q R:pred A),
-  ((P * Q) |-- R) = (P |-- (Q -* R)).
-Proof.
-  intros. apply prop_ext.
-  split; intros.
-  hnf; intros; simpl; intros.
-  apply H.
-  exists x'; exists y.
-  intuition.
-  apply pred_nec_hereditary with a; auto.
-  hnf; intros.
-  hnf in H.
-  unfold wand in H; simpl in H.
-  destruct H0 as [w [v [? [? ?]]]].
-  eapply H; eauto.
-Qed.
-
-Lemma sepcon_assoc {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A} : forall (P Q R:pred A),
-  ((P * Q) * R = P * (Q * R))%pred.
-Proof.
-  pose proof I.
-  intros; apply pred_ext; hnf; intros.
-  destruct H0 as [x [y [? [? ?]]]].
-  destruct H1 as [z [w [? [? ?]]]].
-  destruct (join_assoc H1 H0) as [q [? ?]].
-  exists z; exists q; intuition.
-  exists w; exists y; intuition.
-  destruct H0 as [x [y [? [? ?]]]].
-  destruct H2 as [z [w [? [? ?]]]].
-  apply join_comm in H0.
-  apply join_comm in H2.
-  destruct (join_assoc H2 H0) as [q [? ?]].
-  exists q; exists w; intuition.
-  exists x; exists z; intuition.
-Qed.
-
-Lemma sepcon_comm {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A} : forall (P Q:pred A),
-  (P * Q = Q * P)%pred.
-Proof.
-  pose proof I.
-  intros; apply pred_ext; hnf; intros.
-  destruct H0 as [x [y [? [? ?]]]].
-  exists y; exists x; intuition; apply join_comm; auto.
-  destruct H0 as [x [y [? [? ?]]]].
-  exists y; exists x; intuition; apply join_comm; auto.
-Qed.
-
-Lemma split_sepcon {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A} : forall (P Q R S:pred A),
-  (P |-- Q) ->
-  (R |-- S) ->
-  (P * R) |-- (Q * S).
-Proof.
-  intros; hnf; intros.
-  destruct H1 as [x [y [? [? ?]]]].
-  exists x; exists y; intuition.
-Qed.
-
-Lemma sepcon_cut {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A} : forall (P Q R S:pred A),
-  (P |-- (Q -* R)) ->
-  (S |-- Q) ->
-  (P * S) |-- R.
-Proof.
-  intros.
-  rewrite wand_sepcon_adjoint.
-  hnf; intros.
-  simpl; intros.
-  eapply H; eauto.
-Qed.
-
-Lemma emp_emp_sepcon {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A} :
-  (emp * emp = emp)%pred.
-Proof.
-  apply pred_ext; hnf; intros.
-  - destruct H as (? & ? & J & H & ?).
-    apply H in J; subst; auto.
-  - exists a, a; repeat split; auto.
-    apply identity_self_join; auto.
-Qed.
-
-Lemma emp_sepcon {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{FA: Flat_alg A}{AG: ageable A}{XA: Age_alg A} : forall (P:pred A),
-  (emp * P = P)%pred.
-Proof.
-  intros; apply pred_ext; hnf; intros.
-  destruct H as [x [y [? [? ?]]]].
-  simpl in H0.
-  replace a with y; auto.
-  destruct (join_ex_identities a) as [u [Hu [? Hj]]].
-  exists u; exists a. split; auto.
-  specialize (Hu _ _ Hj); subst; auto.
-Qed.
-
-Lemma sepcon_emp {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{FA: Flat_alg A}{AG: ageable A}{XA: Age_alg A}  : forall (P:pred A),
-  (P * emp = P)%pred.
-Proof.
-  intros.
-  rewrite sepcon_comm.
-  apply emp_sepcon.
-Qed.
-
-(*Lemma emp_sepcon : forall {A} `{Age_alg A} (P:pred A), emp * P = P.
-Proof. exact @emp_sepcon. Qed.
-Lemma sepcon_emp : forall {A} `{Age_alg A} (P:pred A), P * emp = P.
-Proof. exact @sepcon_emp. Qed.
-*)
-	
-Lemma later_wand {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A} : forall P Q,
-  (|>(P -* Q) = |>P -* |>Q)%pred.
-Proof.
-  pose proof I.
-  intros.
-  repeat rewrite later_age.
-  apply pred_ext; hnf; intros.
-  simpl; intros.
-  simpl in H0.
-  case_eq (age1 a); intros.
-  specialize ( H0 a0 H5).
-  apply nec_refl_or_later in H1.
-  destruct H1; subst.
-  destruct (age1_join2 _ H2 H4) as [w [v [? [? ?]]]].
-  eapply H0; eauto.
-  replace a0 with w; auto.
-  congruence.
-  assert (necR a0 x').
-  eapply age_later_nec; eauto.
-  destruct (age1_join2 _ H2 H4) as [w [v [? [? ?]]]].
-  apply H0 with w v; auto.
-  apply rt_trans with x'; auto.
-  apply rt_step; auto.
-  apply nec_refl_or_later in H1; destruct H1; subst.
-  destruct (age1_join2 _  H2 H4) as [w [v [? [? ?]]]].
-  hnf in H6.
-  rewrite H5 in H6; discriminate.
-  clear -H1 H5.
-  exfalso.
-  revert H5; induction H1; auto.
-  intros.
-  unfold age in H.
-  rewrite H in H5; discriminate.
-
-  simpl; intros.
-  simpl in H0.
-  destruct (valid_rel_nec).
-  destruct (H6 _ _ H2 _ H1).
-  destruct (unage_join _ H3 H7) as [w [v [? [? ?]]]].
-  apply H0 with x w v; auto.
-  intros.
-  replace a'0 with y; auto.
-  congruence.
-Qed.
-
-Lemma later_sepcon {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A} : forall P Q,
-  (|>(P * Q) = |>P * |>Q)%pred.
-Proof.
-  pose (H:=True).
-  intros.
-  repeat rewrite later_age.
-  apply pred_ext; hnf; intros.
-  simpl in H0.
-  case_eq (age1 a); intros.
-  destruct (H0 a0) as [w [v [? [? ?]]]]; auto.
-  destruct (unage_join2 _ H2 H1) as [w' [v' [? [? ?]]]].
-  exists w'; exists v'; intuition.
-  simpl; intros.
-  replace a' with w; auto.
-  unfold age in *; congruence.
-  simpl; intros.
-  replace a' with v; auto.
-  unfold age in *; congruence.
-  destruct (join_ex_units a).
-  exists x; exists a.
-  intuition.
-  hnf; intros.
-  red in u.
-  simpl in H2.
-  destruct (age1_join _ u H2) as [s [t [? [? ?]]]].
-  unfold age in H5.
-  rewrite H1 in H5; discriminate.
-  hnf; intros.
-  simpl in H2.
-  unfold age in H2.
-  rewrite H1 in H2; discriminate.
-
-  destruct H0 as [w [v [? [? ?]]]].
-  hnf; intros.
-  simpl in H3.
-  destruct (age1_join2 _ H0 H3) as [w' [v' [? [? ?]]]].
-  exists w'; exists v'; intuition.
-Qed.
-
-Lemma FF_sepcon : forall {A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A} (P:pred A),
-  (FF * P = FF)%pred.
-Proof.
-  intros. apply pred_ext; repeat intro.
-  destruct H as [? [? [? [? ?]]]].  elim H0.
-  elim H.
-Qed.
-
-Lemma sepcon_derives {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}:
-  forall p q p' q', (p |-- p') -> (q |-- q') -> (p * q |-- p' * q').
-Proof.
-intros.
-do 2 intro.
-destruct H1 as [w1 [w2 [? [? ?]]]].
-exists w1; exists w2; repeat split ;auto.
-Qed.
-
-Lemma exp_sepcon1 {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}:
-  forall T (P: T ->  pred A) Q,  (exp P * Q = exp (fun x => P x * Q))%pred.
-Proof.
-intros.
-apply pred_ext; intros ? ?.
-destruct H as [w1 [w2 [? [[x ?] ?]]]].
-exists x; exists w1; exists w2; split; auto.
-destruct H as [x [w1 [w2 [? [? ?]]]]].
-exists w1; exists w2; split; auto.
-split; auto.
-exists x; auto.
-Qed.
-
-Lemma exp_sepcon2 {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}:
-  forall T (P: pred A) (Q: T -> pred A),  (P * exp Q = exp (fun x => P * Q x))%pred.
-Proof.
-intros.
-apply pred_ext; intros ? ?.
-destruct H as [w1 [w2 [? [? [x ?]]]]].
-exists x; exists w1; exists w2; split; auto.
-destruct H as [x [w1 [w2 [? [? ?]]]]].
-exists w1; exists w2; split; auto.
-split; auto.
-exists x; auto.
-Qed.
-
-Lemma extend_later {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}: forall P, (%|>P = |>%P)%pred.
-Proof.
-  intros; rewrite later_commute; auto.
-Qed.
-
-Lemma extend_later' {A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}: forall P, boxy extendM P -> boxy extendM (|> P).
-Proof.
-intros. unfold boxy in *. rewrite later_commute. rewrite H. auto.
-Qed.
-#[export] Hint Resolve extend_later' : core.
-
-Lemma age_sepcon {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A} :
-      forall P Q, (box ageM (P * Q) = box ageM P * box ageM Q)%pred.
-Proof.
-  pose proof I.
-  intros.
-  apply pred_ext; hnf; intros.
-  hnf in H0.
-  case_eq (age1 a); intros.
-  destruct (H0 a0) as [u [v [? [? ?]]]]; auto.
-  red.
-  destruct (unage_join2 _ H2 H1) as [x [y [? [? ?]]]].
-  exists x; exists y.
-  intuition.
-  hnf; intros.
-  replace a' with u; auto.
-  unfold age in *; congruence.
-  hnf; intros.
-  replace a' with v; auto.
-  unfold age in *; congruence.
-  destruct (join_ex_units a).
-  exists x; exists a.
-  intuition.
-  hnf; intros.
-  red in u.
-  destruct (age1_join _ u H2)
-    as [p [q [? [? ?]]]]; auto.
-  unfold age in *.
-  rewrite H1 in H4; discriminate.
-  hnf; intros.
-  simpl in *.
-  unfold age in *.
-  rewrite H1 in H2; discriminate.
-
-  destruct H0 as [u [v [? [? ?]]]].
-  hnf; intros.
-  destruct (age1_join2 _ H0 H3)
-    as [p [q [? [? ?]]]]; auto.
-  exists p; exists q; intuition.
-Qed.
-
-
-Lemma age_twin {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{FA: Flat_alg A}{AG: ageable A}{XA: Age_alg A}:
-  forall phi1 phi2 n phi1',
-  comparable phi1 phi2 ->
-  ageN n phi1 = Some phi1' ->
-  exists phi2', ageN n phi2 = Some phi2' /\ comparable phi1' phi2'.
-Proof.
-intros until n; revert n phi1 phi2.
-induction n; intros.
-exists phi2.
-split; trivial.
-inversion H0.
-subst phi1'.
-trivial.
-unfold ageN in H0.
-simpl in H0.
-revert H0; case_eq (age1 phi1); intros; try discriminate.
-rename a into phi.
-assert (exists ophi2, age phi2 ophi2 /\ comparable phi ophi2).
-destruct (comparable_common_unit H) as [e [? ?]].
-destruct (age1_join _ (join_comm H2) H0) as [eo [phi1'a [eof [? ?]]]].
-destruct (age1_join _ H3 H4) as [phi2' [phi2'a [eof' [? ?]]]].
-unfold age in H7. rewrite H6 in H7. symmetry in H7; inv H7.
-rewrite H5 in H0. inv H0.
-exists phi2'. split; auto.
-apply common_unit_comparable; exists eo; split; auto.
-destruct H2 as [ophi2 [? ?]].
-specialize (IHn _ _ _ H3 H1).
-destruct IHn as [phi2' [? ?]].
-exists phi2'.
-split; trivial.
-unfold ageN.
-simpl.
-rewrite H2.
-trivial.
-Qed.
-
-Lemma ageN_different {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{FA: Flat_alg A}{AG: ageable A}{XA: Age_alg A}: forall n phi phi', ageN (S n) phi = Some phi' ->
-    ~ comparable phi phi'.
-Proof.
-   intros.
-   intro.
-   generalize (age_noetherian' phi); intros [k [[? [? ?]] H4]].
-   assert (k <= n \/ k > n)%nat by lia.
-   destruct H3.
-   replace (S n) with (k + (S n - k))%nat in H by lia.
-   destruct (ageN_compose' _ _ _ _ H) as [b [? ?]].
-   rewrite H1 in H5; inv H5.
-   replace (S n - k)%nat with (S (n-k))%nat in H6 by lia.
-   unfold ageN in H6; simpl in H6. rewrite H2 in H6; inv H6.
-   replace k with (S n + (k - S n))%nat in H1 by lia.
-   destruct (ageN_compose' _ _ _ _ H1) as [c [? ?]].
-   rewrite H in H5; inv H5.
-   destruct (age_twin phi c _ _ H0 H1) as [b [? ?]].
-   replace (S n + (k - S n))%nat with ((k - S n) + S n)%nat in H5 by lia.
-   destruct (ageN_compose' _ _ _ _ H5) as [d [? ?]].
-   rewrite H6 in H8; inv H8.
-   clear - H9 H2.
-   unfold ageN in H9; simpl  in H9; rewrite H2 in H9; inv H9.
-Qed.
-
-Lemma necR_comparable{A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{FA: Flat_alg A}{AG: ageable A}{XA: Age_alg A}:
-  forall w w', necR w w' -> comparable w w' -> w=w'.
-Proof.
-intros.
-rewrite necR_evolve in H.
-destruct H as [n H].
-destruct n.
-inv H; auto.
-contradiction (ageN_different _ _ _ H); auto.
-Qed.
-
-
-Lemma sepcon_andp_prop {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}:
-  forall P Q R, (P * (!!Q && R) = !!Q && (P * R))%pred.
-Proof.
-intros.
-apply pred_ext; intros w ?.
-destruct H as [w1 [w2 [? [? [? ?]]]]].
-split. apply H1.
-exists w1; exists w2; split; [|split]; auto.
-destruct H.
-destruct H0 as [w1 [w2 [? [? ?]]]].
-exists w1; exists w2; repeat split; auto.
-Qed.
-
-Lemma TT_sepcon_TT {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}: (TT * TT = TT)%pred.
-Proof.
-intros.
-apply pred_ext; intros w ?; auto.
-destruct (join_ex_units w).
-exists x; exists w; split; auto.
-Qed.
-
-
-Lemma join_exactly {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{FA: Flat_alg A}{AG: ageable A}{XA: Age_alg A}:
-  forall w1 w2 w3, join w1 w2 w3 ->  (exactly w1 * exactly w2 = exactly w3)%pred.
-Proof.
-pose proof I.
-intros.
-unfold exactly.
-apply pred_ext; intros w ?; simpl in *.
-destruct H1 as [? [? [? [? ?]]]].
-destruct (nec_join H0 H2) as [a [b [? [? ?]]]].
-assert (x0=a).
- eapply necR_linear'; eauto.
-  transitivity (level x).
-  symmetry; apply comparable_fashionR. eapply join_comparable2; eauto.
-  apply comparable_fashionR. eapply join_comparable2; eauto.
-subst x0.
-generalize (join_eq H4 H1); clear H4; intro; subst.
-auto.
-eapply nec_join2; eauto.
-Qed.
-
-Lemma extend_sepcon_andp {A} {JA: Join A} {PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}:
-  forall P Q R, boxy extendM Q -> P * (Q && R) |-- Q && (P * R).
-Proof.
-intros.
-intros ?w [?w [?w [? [? [? ?]]]]].
-split.
-rewrite <- H in H2.
-eapply H2.
-exists w0.
-apply join_comm; auto.
-exists w0; exists w1; auto.
-Qed.
-Arguments extend_sepcon_andp : clear implicits.
-
-Lemma distrib_sepcon_andp {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}:
-  forall P Q R, P * (Q && R) |-- (P * Q) && (P * R).
-Proof.
-intros. intros w [w1 [w2 [? [? ?]]]].
-destruct H1.
-split; exists w1; exists w2; split; auto.
-Qed.
-
-Lemma modus_wand {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}:
-  forall P Q,  P * (P -* Q) |-- Q.
-Proof.
-intros.
-intros w  [?w [?w [? [? ?]]]].
-eapply H1; eauto.
-Qed.
-
-Lemma extend_sepcon {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}:
-  forall {Q R: pred A}, boxy extendM Q ->  Q * R |-- Q.
-Proof.
-intros.
-intros w [w1 [w2 [? [? _]]]].
-rewrite <- H in H1. eapply H1; eauto.
-simpl; eauto.
-exists w2; auto.
-Qed.
-
-Definition precise {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A} (P: pred A) : Prop :=
-     forall w w1 w2, P w1 -> P w2 -> join_sub w1 w -> join_sub w2 w -> w1=w2.
-
-Definition precise2  {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A} (P: pred A) : Prop :=
-     forall Q R, (P * (Q && R) = (P * Q) && (P * R))%pred.
-
-Lemma precise_eq {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{CA: Canc_alg A}{AG: ageable A}{XA: Age_alg A}: precise =
-                 fun P : pred A => forall Q R, (P * (Q && R) = (P * Q) && (P * R))%pred.
-Proof.
-extensionality P.
-unfold precise.
-apply prop_ext; split; intros.
-apply pred_ext; unfold derives; intros; rename a into w.
-destruct H0 as [phi1 [phi2 [? [? [? ?]]]]].
-split; exists phi1; exists phi2; auto.
-destruct H0 as [[phi1a [phi2a [? [? ?]]]] [phi1b [phi2b [? [? ?]]]]].
-specialize (H w _ _ H1 H4).
-spec H.
-econstructor; eauto.
-spec H.
-econstructor; eauto.
-subst phi1b.
-generalize (join_canc (join_comm H0) (join_comm H3)).
-intro; subst phi2b.
-exists phi1a; exists phi2a; split; auto.
-split; auto.
-split; auto.
-rename w1 into w1a.
-rename w2 into w1b.
-destruct H2 as [w2a ?].
-destruct H3 as [w2b ?].
-assert (((P * exactly w2a) && (P * exactly w2b)) w)%pred.
-split; do 2 econstructor; repeat split;
-try solve [simpl; apply necR_refl].
-eassumption. auto. eassumption. auto.
-rewrite <- H in H4.
-destruct H4 as [w1 [w2 [? [? [? ?]]]]].
-simpl in H6,H7.
-rewrite (necR_comparable _ _ H6) in H2.
-rewrite (necR_comparable _ _ H7) in H3.
-eapply join_canc; eauto.
-apply comparable_trans with w.
-apply join_comparable with w1b; auto.
-apply comparable_sym; apply join_comparable with w1; auto.
-apply comparable_trans with w.
-apply join_comparable with w1a; auto.
-apply comparable_sym; apply join_comparable with w1; auto.
-Qed.
-
-Lemma derives_precise {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}:
-  forall P Q, (P |-- Q) -> precise Q -> precise P.
-Proof.
-intros; intro; intros; eauto.
-Qed.
-
-Lemma precise_emp {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}: precise emp.
-Proof.
-repeat intro.
-eapply join_sub_same_identity with (a := w1)(c := w); auto.
-apply identity_unit'; auto.
-eapply join_sub_unit_for; eauto.
-apply identity_unit'; auto.
-Qed.
-
-Definition superprecise {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A} (P: pred A) :=
-   forall w1 w2, P w1 -> P w2 -> comparable w1 w2 -> w1=w2.
-
-Lemma superprecise_exactly {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}: forall w, superprecise (exactly w).
-Proof.
-unfold superprecise; intros.
-hnf in H,H0.
-eapply necR_linear'; eauto.
-apply comparable_fashionR; auto.
-Qed.
-#[export] Hint Resolve superprecise_exactly : core.
-
-Lemma superprecise_precise {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{FA: Flat_alg A}{AG: ageable A}{XA: Age_alg A}: forall (P: pred A) , superprecise P -> precise P.
-Proof.
-  pose proof I.
-  unfold precise. unfold superprecise.
-  intros.
-  assert (comparable w1 w2). assert (comparable w1 w) by apply (join_sub_comparable H3).
-  assert (comparable w w2).
-    apply comparable_sym; destruct H4; eapply join_comparable; eauto.
-    apply (comparable_trans H5 H6).
-  apply (H0 _ _ H1 H2 H5).
-Qed.
-
-(* EXistential Magic Wand *)
-
-Program Definition ewand {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A} (P Q: pred A) : pred A :=
-  fun w => exists w1, exists w2, join w1 w w2 /\ P w1 /\ Q w2.
-Next Obligation.
-destruct H0 as [w1 [w2 [? [? ?]]]].
-apply join_comm in H0; eapply age1_join in H0; eauto.
-destruct H0 as [w1' [w3' [? [? ?]]]].
-exists w1'; exists w3'; split; auto.
-split;   eapply pred_nec_hereditary; try eassumption.
-constructor 1; auto.
-constructor 1; auto.
-Qed.
-
-Lemma later_ewand {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A} : forall P Q,
-  (|>(ewand P Q) = ewand (|>P) (|>Q))%pred.
-Proof.
-intros.
-apply pred_ext.
-intros w ?.
-case_eq (age1 w); intros.
-destruct (H a (t_step _ _ _ _ H0)) as [a1 [a2 [? [? ?]]]].
-destruct (unage_join _ (join_comm H1) H0) as [w1 [w2 [? [? ?]]]].
-exists w1; exists w2; split; [|split]; auto.
-hnf; intros.
-apply pred_nec_hereditary with a1; auto.
-eapply age_later_nec; eauto.
-hnf; intros.
-apply pred_nec_hereditary with a2; auto.
-eapply age_later_nec; eauto.
-exists (core w), w.
-split; [|split].
-apply core_unit.
-hnf; intros.
-assert (age1 (core w) = None).
-apply age1_None_joins with w; auto.
-exists w; apply join_comm; apply core_unit.
-unfold laterM in H1. simpl in H1.
-unfold laterR in H1.
-apply clos_trans_t1n in H1. inv H1; rewrite H3 in H2; inv H2.
-intros w' ?.
-hnf in H1. apply clos_trans_t1n in H1.
-inv H1; rewrite H2 in H0; inv H0.
-
-intros w [w1 [w2 [? [? ?]]]].
-intros w' ?.
-hnf in H2. apply clos_trans_t1n in H2.
-revert w1 w2 H H0 H1; induction H2; intros.
-destruct (age1_join _ (join_comm H0) H) as [w1' [w2' [? [? ?]]]].
-exists w1'; exists w2'; split; auto.
-split.
-eapply H1. hnf; apply clos_t1n_trans. constructor 1; auto.
-eapply H2. hnf; apply clos_t1n_trans. constructor 1; auto.
-destruct (age1_join _ (join_comm H0) H) as [w1' [w2' [? [? ?]]]].
-apply (IHclos_trans_1n _ _ (join_comm H4)); auto; eapply pred_hereditary; eauto.
-Qed.
-
-(* Notation "P '-o' Q" := (ewand P Q) (at level 60, right associativity). *)
-
-Lemma emp_ewand {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{FA: Flat_alg A}{AG: ageable A}{XA: Age_alg A}:
-      forall P, ewand emp P = P.
-Proof.
-intros.
-apply pred_ext; intros w ?.
-destruct H as [w1 [w2 [? [? ?]]]].
-replace w with w2; auto.
-eapply join_eq; eauto.
-eapply identity_unit; eauto.
-destruct (join_ex_identities w) as [e [He [? Hj]]].
-exists e; exists w.
-split; auto.
-specialize (He _ _ Hj); subst; auto.
-Qed.
-
-
-Lemma pry_apart {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{CA: Canc_alg A}{DA: Disj_alg A}{CrA: Cross_alg A}{AG: ageable A}{XA: Age_alg A}:
-  forall G P Q, superprecise G -> P = ewand G (G * P) ->
-                       (P * Q) && (G * TT) |-- (P * G * (ewand G Q)).
-Proof.
- pose proof I. intros.
-intros w [? ?].
-destruct H2 as [w2 [w3 [? [? Hq]]]].
-destruct H3 as [w4 [w5 [? [? _]]]].
-rewrite H1 in H4.
-destruct H4 as [wa [wb [? [? ?]]]].
-assert (wa = w4). apply H0; auto.
-apply comparable_trans with w2. apply join_comparable2 with wb; auto.
-apply comparable_trans with w. apply join_comparable with w3; auto.
-apply comparable_sym. apply join_comparable with w5; auto.
-subst wa; clear H6.
-destruct H7 as [w4' [w2' [? [? ?]]]].
-assert (w4' = w4). apply H0; auto.
-apply comparable_trans with wb. eapply join_comparable; eauto.
-apply comparable_sym.  eapply join_comparable; eauto.
-subst w4'; clear H7.
-assert (w2' = w2). eapply join_canc; try apply join_comm; eauto.
-subst w2'; clear H6.
-destruct (CrA _ _ _ _ _ H2 H3) as [[[[w24 w25] w34] w35] [? [? [? ?]]]].
-assert (identity w24).
-  destruct (join_assoc (join_comm H9) H4) as [f [? ?]].
-  destruct (join_assoc (join_comm H6) (join_comm H11)) as [g [? ?]].
-  eapply join_self; eauto.
-assert (w34=w4). eapply join_eq; [eapply identity_unit; eauto | auto ].
-subst w34.
-assert (w25 = w2). eapply join_eq; [eapply identity_unit; eauto | auto ].
-subst w25.
-clear H11 H9 H6 w24.
-destruct (join_assoc (join_comm H10) (join_comm H3)) as [h [? ?]].
-generalize (join_eq H6 (join_comm H4)); clear H6; intro; subst h.
-destruct (join_assoc (join_comm H4) (join_comm H9)) as [h [? ?]].
-generalize (join_eq H6 H7); clear H6; intro; subst h.
-clear H11.
-exists wb; exists w35.
-split. apply join_comm; auto.
-split; auto.
-exists w2; exists w4; split; auto.
-unfold ewand.
-exists w4; exists w3; split; auto.
-Qed.
-
-Definition wk_split {A} {JA: Join A} :=
-      forall a b c d e : A, join a b c -> join d e c -> joins a d -> join_sub d b.
-
-Lemma crosssplit_wkSplit {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{DA: Disj_alg A}{CrA: Cross_alg A}{AG: ageable A}{XA: Age_alg A}:
-    wk_split.
-Proof.
-unfold wk_split; intros.
-destruct (CrA _ _ _ _ _ H H0) as [[[[ad ae] bd] be] [myH1 [myH2 [myH3 myH4]]]].
-destruct H1 as [x H_x].
-assert (exists X, join ad X be) as [X HX].
-2:{   exists X.
-               destruct (join_assoc (join_comm HX) (join_comm myH2)) as [y [myH5 myH6]].
-               assert (y=d) by apply (join_eq myH5 myH3).  subst y.
-               apply (join_comm myH6).
-}
-destruct (join_assoc (join_comm myH1) H_x) as [y [myH5 myH6]].
-destruct (join_assoc (join_comm myH3) (join_comm myH5)) as [? [Had ?]].
-apply join_self in Had.
-pose proof (Had _ _ myH1); subst.
-destruct (join_assoc (join_comm myH1) myH4) as [? [Hbe ?]].
-specialize (Had _ _ Hbe); subst; eauto.
-Qed.
-
-Lemma wk_pry_apart {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{CA: Canc_alg A}{DA: Disj_alg A}{CrA: Cross_alg A}{AG: ageable A}{XA: Age_alg A}:
-  forall G P Q, wk_split -> superprecise G -> P = ewand G (G * P) ->
-                       (P * Q) && (G * TT) |-- (P * G * (ewand G Q)).
-Proof.
-intros.
-intros w [? ?]. unfold ewand.
-destruct H2 as [w2 [w3 [? [? Hq]]]].
-destruct H3 as [w4 [w5 [? [? _]]]].
-rewrite H1 in H4.
-destruct H4 as [wa [wb [? [? ?]]]].
-assert (wa = w4). apply H0; auto.
-apply comparable_trans with w2. eapply join_comparable2; eauto.
-apply comparable_trans with w. eapply join_comparable; eauto.
-apply comparable_sym.  eapply join_comparable; eauto.
-subst wa; clear H6.
-destruct H7 as [w4' [w2' [? [? ?]]]].
-assert (w4' = w4). apply H0; auto.
-apply comparable_trans with wb. eapply join_comparable; eauto.
-apply comparable_sym.  eapply join_comparable; eauto.
-subst w4'; clear H7.
-assert (w2' = w2). eapply join_canc; try apply join_comm; eauto.
-subst w2'; clear H6.
-assert (exists y, join w2 y w5).
-    destruct (H _ _ _ _ _ H2 H3 (join_joins (join_comm H4))).
-    destruct (join_assoc H6 (join_comm H2)) as [y [myH1 myH2]].
-    assert (y=w5) by apply (join_canc  (join_comm myH2) (join_comm H3)). subst y.
-    exists x. apply (join_comm myH1).
-exists wb.
-destruct H6 as [y w2_y_w5].
-               destruct (join_assoc w2_y_w5 (join_comm H3)) as [x [myH1 myH2]].
-               destruct (join_assoc  (join_comm myH1) (join_comm myH2)) as [z [myH3 myH4]].
-                                        assert (w5=z) by apply  (join_canc (join_comm H3) (join_comm myH4)). subst w5.
-                                        assert (w3=x) by apply (join_canc (join_comm H2) (join_comm myH2)).  subst w3.
-                                        destruct (join_assoc myH3 (join_comm myH4)) as [u [myH5 myH6]].
-                                        assert (wb=u) by apply (join_eq H4 (join_comm myH5)). subst wb.
-               exists y. split. apply (join_comm myH6).
-               split. exists w2. exists w4. split. apply (join_comm H4). split; assumption.
-               exists w4. exists x; split. apply (join_comm myH1). split; assumption.
-Qed.
-
-Lemma ewand_overlap {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{CA: Canc_alg A}{DA: Disj_alg A}{CrA: Cross_alg A}{AG: ageable A}{XA: Age_alg A}:
-    forall (P Q: pred A),
-       superprecise Q ->
-       ewand TT (P * Q) * Q |-- ewand TT (P * Q).
-Proof.
-intros P Q PrecQ.
-intros w [w1 [w2 [? [? ?]]]].
-destruct H0 as [w5 [w6 [? [_ ?]]]].
-destruct H2 as [w3 [w4 [? [? ?]]]].
-generalize (PrecQ  _ _ H4 H1); clear H4; intro.
-spec H4.
-apply comparable_trans with w6.
-apply join_comparable with w3; apply join_comm; auto.
-apply comparable_trans with w1.
-apply comparable_sym; apply join_comparable with w5; apply join_comm; auto.
-eapply join_comparable2; eauto.
-subst w4.
-destruct (CrA _ _ _ _ _ H0 H2) as [[[[a b] c] d] [? [? [? ?]]]].
-destruct (join_assoc H5 H) as [f [? ?]].
-destruct (join_assoc H7 (join_comm H8)) as [g [? ?]].
-generalize (join_self' H10); intro.
-subst g.
-assert (identity d).
-eapply unit_identity; eauto.
-assert (b=w2).
-eapply join_canc; eauto.
-subst b.
-assert (f=w2).
-eapply join_eq; eauto.
-subst f.
-clear H11 H10 H7.
-assert (c=w1).
- specialize ( H12 c w1). apply H12. auto.
-subst c.
-clear H9 H5.
-destruct (join_assoc H6 H2) as [h [? ?]].
-generalize (join_eq H5 H); clear H5; intro; subst h.
-exists a; exists w6; split; auto.
-split; auto.
-exists w3; exists w2; split; auto.
-Qed.
-
-Lemma ewand_derives {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}:
-  forall P P' Q Q',  (P |-- P') -> (Q |-- Q') -> ewand P Q |-- ewand P' Q'.
-Proof.
-intros.
-intros w ?.
-destruct H1 as [?w [?w [? [? ?]]]].
-exists w0; exists w1; split; auto.
-Qed.
-
-Lemma ewand_sepcon {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}: forall P Q R,
-      (ewand (P * Q) R = ewand P (ewand Q R))%pred.
-Proof.
-intros; apply pred_ext; intros w ?.
-destruct H as [w1 [w2 [? [? ?]]]].
-destruct H0 as [w3 [w4 [? [? ?]]]].
-exists w3.
-destruct (join_assoc (join_comm H0) H) as [wf [? ?]].
-exists wf.
-split; [|split]; auto.
-exists w4. exists w2. split; auto.
-destruct H as [w1 [w2 [? [? ?]]]].
-destruct H1 as [w3 [w4 [? [? ?]]]].
-destruct (join_assoc (join_comm H) (join_comm H1)) as [wf [? ?]].
-exists wf. exists w4. split; [|split]; auto.
-exists w1; exists w3; split; auto.
-Qed.
-
-Lemma ewand_sepcon_assoc {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{FA: Flat_alg A}{CrA: Cross_alg A}{AG: ageable A}{XA: Age_alg A}:
-  Trip_alg A ->
-  forall P Q R: pred A,
-      (forall w1 w2 w3, join w1 w2 w3 -> P w3 -> P w1) ->
-      (forall w w', comparable w w' -> P w -> R w' -> joins w w') ->
-      ((ewand TT P) && (ewand TT R) |-- emp) ->
-     (ewand P (Q * R) = (ewand P Q * R))%pred.
-Proof.
-intros TRIPLE P Q R ?H Hjoins ?H.
-apply pred_ext; intros w ?.
-destruct H1 as [w1 [w2 [? [? ?]]]].
-destruct H3 as [w3 [w4 [? [? ?]]]].
-destruct (CrA _ _ _ _ _ H1 H3) as [[[[? ?] ?] ?] [? [? [? ?]]]].
-generalize (H _ _ _ (join_comm H6) H2); intro.
-assert (emp a0).
-apply H0.
-split.
-2:{ do 2 econstructor; (split; [|split]). 3: eauto. eauto. auto. }
-exists a; exists w1; split; [|split]; eauto.
-apply join_unit2_e in H6; auto.
-subst a.
-apply join_unit1_e in H9; auto.
-subst a2.
-exists a1; exists w4; split; [|split]; auto.
-do 2 econstructor; eauto.
-(*****)
-destruct H1 as [w1 [wR [? [? ?]]]].
-destruct H2 as [wP [wQ [? [? ?]]]].
-apply join_comm in H2.
-specialize (Hjoins wP wR).
-spec Hjoins.
-apply comparable_trans with w1; eapply join_comparable2; eauto.
-destruct Hjoins as [w6 ?]; auto.
-destruct (TRIPLE _ _ _ _ _ _ H1 (join_comm H6) H2) as [wQR ?].
-exists wP. exists wQR.
-split; [|split]; auto.
-destruct (join_assoc H1 j) as [wf [? ?]].
-generalize (join_eq H6 (join_comm H7)); clear H6; intros; subst w6.
-destruct (join_assoc H7 (join_comm H8)) as [wg [? ?]].
-generalize (join_eq H2 (join_comm H6)); clear H6; intros; subst wg.
-do 2 econstructor; eauto.
-Qed.
-
-
-Lemma ewand_sepcon2 {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{CA: Canc_alg A}{DA: Disj_alg A}{CrA: Cross_alg A}{AG: ageable A}{XA: Age_alg A}:
-      forall
-          R (SP: superprecise R)
-          P (H: P = ewand R (R * P))
-          Q,
-          ewand P (Q * R) |-- ewand P Q * R.
-Proof.
-intros.
-intros w ?.
-destruct H0 as [w1 [w34 [? [? [w3 [w4 [? [? ?]]]]]]]].
-generalize (crosssplit_wkSplit  _ _ _ _ _ H0 (join_comm H2)); unfold wk_split; intro.
-spec H5.
-rewrite H in H1.
-destruct H1 as [wa [wb [? [? ?]]]].
-generalize (SP _ _ H6 H4); clear H4; intro.
-spec H4.
-apply comparable_trans with w34. apply comparable_trans with w1.
-eapply join_comparable2; eauto. eapply join_comparable; eauto.
-apply comparable_sym; eapply join_comparable; eauto.
-subst wa.
-destruct H7 as [wx [wy [? [? ?]]]].
-generalize (SP _ _ H7 H6); clear H7; intro.
-spec H7.
-apply comparable_trans with wb.  eapply join_comparable; eauto.
-apply comparable_sym; eapply join_comparable; eauto.
-subst wx.
-generalize (join_canc (join_comm H1) (join_comm H4)); clear H4; intro.
-subst wy.
-econstructor; eauto.
-destruct H5 as [w5 ?].
-exists w5; exists w4; split; [|split]; auto.
-exists w1; exists w3; split; [|split]; auto.
-destruct (join_assoc H5 (join_comm H0)) as [wf [? ?]].
-generalize (join_canc (join_comm H7) H2); clear H7; intro.
-subst wf.
-auto.
-Qed.
-
-Lemma sepcon_andp_prop2 {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}:
-  forall P Q R,  (P * (!!Q && R) = !!Q && (P * R))%pred.
-Proof.
-intros.
-apply pred_ext; intros w ?.
-destruct H as [w1 [w2 [? [? [? ?]]]]].
-split. apply H1.
-exists w1; exists w2; split; [|split]; auto.
-destruct H.
-destruct H0 as [w1 [w2 [? [? ?]]]].
-exists w1; exists w2; repeat split; auto.
-Qed.
-
-Lemma sepcon_andp_prop1 {A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA:  ageable A}{AgeA: Age_alg A}:
-   forall (P: Prop) (Q R: pred A) , ((!! P && Q) * R = !! P && (Q * R))%pred.
-Proof.
- intros. rewrite (sepcon_comm). rewrite sepcon_andp_prop2. rewrite sepcon_comm; auto.
-Qed.
-
-Lemma distrib_orp_sepcon {A : Type}{JA : Join A}  {PA : Perm_alg A}{SA : Sep_alg A}{agA : ageable A}
-    {AgeA : Age_alg A}:
-  forall (P Q R : pred A), ((P || Q) * R = P * R || Q * R)%pred.
-Proof.
- intros. apply pred_ext.
-  intros w [w1 [w2 [? [[?|?] ?]]]]; [left|right]; exists w1; exists w2; repeat split; auto.
- intros ? [?|?];  destruct H as [w1 [w2 [? [? ?]]]]; exists w1; exists w2; repeat split; auto.
-  left; auto. right; auto.
-Qed.
-
-Lemma distrib_orp_sepcon2{A : Type}{JA : Join A}{PA : Perm_alg A}{SA : Sep_alg A}{agA : ageable A}
-    {AgeA : Age_alg A}:
-  forall (P Q R : pred A),
-     (R * (P || Q) = R * P || R * Q)%pred.
-Proof.
-intros. rewrite !(sepcon_comm R). apply distrib_orp_sepcon.
-Qed.
-
-Lemma ewand_conflict {T}{agT:ageable T}{JT: Join T}{PT: Perm_alg T}{ST: Sep_alg T}{AT: Age_alg T}:
-       forall P Q R, (sepcon P Q |-- FF) -> andp P (ewand Q R) |-- FF.
-Proof.
- intros. intros w [? [w1 [w2 [? [? ?]]]]].
- specialize (H w2). apply H. exists w; exists w1; repeat split; auto.
-Qed.
-
-Lemma ewand_TT_sepcon {T}{agT:ageable T}{JT: Join T}{PT: Perm_alg T}{ST: Sep_alg T}{AT: Age_alg T}:
-      forall P Q R,
-(P * Q && ewand R (!!True))%pred |-- (P && ewand R (!!True) * (Q && ewand R (!!True)))%pred.
-Proof.
-intros.
-intros w [[w1 [w2 [? [? ?]]]] [w3 [w4 [? [? ?]]]]].
-exists w1; exists w2; repeat split; auto.
-destruct (join_assoc (join_comm H) (join_comm H2)) as [f [? ?]].
-exists w3; exists f; repeat split; auto.
-destruct (join_assoc H (join_comm H2)) as [g [? ?]].
-exists w3; exists g; repeat split; auto.
-Qed.
diff --git a/msl/ramification_lemmas.v b/msl/ramification_lemmas.v
deleted file mode 100644
index 36a85caefa..0000000000
--- a/msl/ramification_lemmas.v
+++ /dev/null
@@ -1,646 +0,0 @@
-(* The spec and proof of the following rules are based on `The Ramifications  *)
-(* of Sharing in Data Structures' by Aquinas Hobor and Jules Villard.         *)
-(*    RAMIF_PLAIN.frame                                                       *)
-(*    RAMIF_PLAIN.split                                                       *)
-(* The following lemmas are found useful by Shengyi Wang, Qinxiang Cao and    *)
-(* Aquinas Hobor in 2015 summer in Yale-NUS.                                  *)
-(*    RAMIF_PLAIN.solve                                                       *)
-(*    RAMIF_Q.reduce                                                          *)
-(*    RAMIF_Q.solve                                                           *)
-(*    RAMIF_Q.frame                                                           *)
-(*    RAMIF_Q.split                                                           *)
-(* The following lemmas are developed by Qinxiang Cao in 2015 in Princeton.   *)
-(*    RAMIF_PLAIN.trans                                                       *)
-(*    RAMIF_PLAIN.weak_ramif_spec                                             *)
-(*    RAMIF_PLAIN.exp_right                                                   *)
-(*    RAMIF_Q.trans                                                           *)
-(*    RAMIF_Q.simple_trans                                                    *)
-(*    RAMIF_Q.weak_ramif_spec                                                 *)
-(*    RAMIF_Q.plain_spec                                                      *)
-(*    RAMIF_Q.exp_right                                                       *)
-
-Require Import VST.msl.base.
-Require Import VST.msl.Coqlib2.
-Require Import VST.msl.simple_CCC.
-Require Import VST.msl.seplog.
-Require Import VST.msl.log_normalize.
-
-Local Open Scope logic.
-
-Lemma modus_ponens_wand' {A}{ND: NatDed A}{SL: SepLog A}:
-                      forall P P' Q: A, (P |-- P') ->  derives (sepcon P (wand P' Q)) Q.
-Proof.
-intros.
-   eapply derives_trans; [apply sepcon_derives; [ | apply derives_refl] | apply modus_ponens_wand ].
-  auto.
-Qed.
-
-Module RAMIF_PLAIN.
-Section RAMIF_PLAIN.
-
-Context {A : Type}.
-Context {ND : NatDed A}.
-Context {SL : SepLog A}.
-
-Lemma solve: forall g l g' l' F, (g |-- l * F) -> (F * l' |-- g') -> g |-- l * (l' -* g').
-Proof.
-  intros.
-  apply derives_trans with (l * F); auto.
-  apply sepcon_derives; auto.
-  apply wand_sepcon_adjoint.
-  auto.
-Qed.
-
-Lemma weak_ramif_spec: forall g l g' l', (g |-- l * (l' -* g')) -> g |-- l * TT.
-Proof.
-  intros.
-  eapply derives_trans; [exact H |].
-  apply sepcon_derives; auto.
-  apply TT_right.
-Qed.
-
-Lemma trans: forall g m l g' m' l',
-      (g |-- m * (m' -* g')) ->
-      (m |-- l * (l' -* m')) ->
-      g |-- l * (l' -* g').
-Proof.
-  intros.
-  apply solve with ((l' -* m') * (m' -* g')).
-  + eapply derives_trans; [exact H |].
-    eapply derives_trans; [apply sepcon_derives; [exact H0 | apply derives_refl] |].
-    rewrite sepcon_assoc; auto.
-  + rewrite (sepcon_comm _ l'), <- sepcon_assoc.
-    eapply derives_trans; [| apply modus_ponens_wand].
-    apply sepcon_derives; [| apply derives_refl].
-    apply modus_ponens_wand.
-Qed.
-
-Lemma trans':
-   forall (m l g' m' l': A),
-       (m |-- l * (l' -* m')) ->
-       m * (m' -* g') |-- l * (l' -* g').
-Proof.
-  intros. eapply trans. apply derives_refl. auto.
-Qed.
-
-Lemma trans'':
-   forall (p g' m' l': A),
-       (p |-- l' -* m') ->
-       p * (m' -* g') |-- (l' -* g').
-Proof.
-  intros.
-  rewrite -> wand_sepcon_adjoint.
-  eapply derives_trans; [apply H | ]. clear H.
-  rewrite <- wand_sepcon_adjoint.
-  rewrite <- wand_sepcon_adjoint.
-  pull_left l'. apply modus_ponens_wand'. apply modus_ponens_wand.
-Qed.
-
-Lemma split: forall g1 g2 l1 l2 g1' g2' l1' l2',
-  (g1 |-- l1 * (l1' -* g1')) ->
-  (g2 |-- l2 * (l2' -* g2')) ->
-  g1 * g2 |-- (l1 * l2) * (l1' * l2' -* g1' * g2').
-Proof.
-  intros.
-  apply solve with ((l1' -* g1') * (l2' -* g2')).
-  + rewrite (sepcon_assoc l1), <- (sepcon_assoc l2), (sepcon_comm l2), (sepcon_assoc _ l2), <- (sepcon_assoc l1).
-    apply sepcon_derives; auto.
-  + eapply derives_trans; [apply sepcon_derives; [apply wand_sepcon_wand | apply derives_refl] |].
-    rewrite sepcon_comm; apply modus_ponens_wand.
-Qed.
-
-(* Using split to prove frame will lead to a simpler proof. *)
-(* But it requires a unitary separation logic.              *)
-Lemma frame: forall g l g' l' F, (g |-- l * (l' -* g')) -> g * F |-- l * (l' -* g' * F).
-Proof.
-  intros.
-  apply solve with ((l' -* g') * F).
-  + rewrite <- sepcon_assoc.
-    apply sepcon_derives; auto.
-  + rewrite (sepcon_comm _ l'), <- sepcon_assoc.
-    apply sepcon_derives; [apply modus_ponens_wand | auto].
-Qed.
-
-Lemma frame_post: forall g l g' l' F, (g |-- l * (l' -* g')) -> g |-- l * (l' * F -* g' * F).
-Proof.
-  intros.
-  apply solve with (l' -* g').
-  + auto.
-  + rewrite <- sepcon_assoc.
-    apply sepcon_derives; [rewrite sepcon_comm; apply modus_ponens_wand | auto].
-Qed.
-
-Lemma frame_pre: forall g l g' l' F, (g |-- l * (l' -* g')) -> g * F |-- (l * F) * (l' -* g').
-Proof.
-  intros.
-  apply solve with (l' -* g').
-  + rewrite (sepcon_comm l F), sepcon_assoc, (sepcon_comm F).
-    apply sepcon_derives; auto.
-  + rewrite sepcon_comm; apply modus_ponens_wand.
-Qed.
-
-Lemma exp_right: forall {T} (a: T) g l g' l',
-  (g |-- l * (l' -* g' a)) ->
-  g |-- l * (l' -* exp g').
-Proof.
-  intros.
-  apply solve with (l' -* g' a); auto.
-  apply wand_sepcon_adjoint.
-  apply wand_derives; auto.
-  apply (exp_right a); auto.
-Qed.
-
-End RAMIF_PLAIN.
-End RAMIF_PLAIN.
-
-Module RAMIF_Q.
-Section RAMIF_Q.
-
-Context {A : Type}.
-Context {ND : NatDed A}.
-Context {SL : SepLog A}.
-
-Lemma reduce: forall {B} g l (g' l': B -> A),
-  (g |-- l * (allp (l' -* g'))) ->
-  g |-- l * (exp l' -* exp g').
-Proof.
-  intros.
-  eapply derives_trans; [exact H |].
-  apply sepcon_derives; [auto |].
-  apply wand_sepcon_adjoint.
-  rewrite exp_sepcon2.
-  apply exp_left; intro x; apply (exp_right x).
-  apply wand_sepcon_adjoint.
-  apply (allp_left _ x).
-  apply derives_refl.
-Qed.
-
-Lemma solve: forall {B} g l g' l' F,
-  (g |-- l * F) ->
-  (forall x: B, F * l' x |-- g' x) ->
-  g |-- l * (allp (l' -* g')).
-Proof.
-  intros.
-  apply derives_trans with (l * F); auto.
-  apply sepcon_derives; auto.
-  apply allp_right; intro x.
-  simpl;
-  apply wand_sepcon_adjoint.
-  apply H0.
-Qed.
-
-Lemma weak_ramif_spec: forall {B} g l (g' l': B -> A),
-  (g |-- l * allp (l' -* g')) -> g |-- l * TT.
-Proof.
-  intros.
-  eapply derives_trans; [exact H |].
-  apply sepcon_derives; auto.
-  apply TT_right.
-Qed.
-
-Lemma plain_spec: forall {B} g l g' l' (x: B),
-  (g |-- l * (allp (l' -* g'))) ->
-  g |-- l *  (l' x -* g' x).
-Proof.
-  intros.
-  eapply derives_trans; [exact H |].
-  apply sepcon_derives; [auto |].
-  apply (allp_left _ x). apply derives_refl.
-Qed.
-
-Lemma trans: forall {B BG BL} g m l g' mG' mL' l' (fG: B -> BG) (fL: B -> BL),
-  (forall b, mL' (fL b) |-- mG' (fG b)) ->
-  (g |-- m * allp (mG' -* g')) ->
-  (m |-- l * allp (l' -* mL')) ->
-  g |-- l * allp (Basics.compose l' fL -* Basics.compose g' fG).
-Proof.
-  intros.
-  apply solve with (allp (l' -* mL') * allp (mG' -* g')); auto.
-  + eapply derives_trans; [exact H0 |].
-    eapply derives_trans; [apply sepcon_derives; [exact H1 | apply derives_refl] |].
-    rewrite sepcon_assoc; auto.
-  + intro b.
-    rewrite sepcon_assoc.
-    apply wand_sepcon_adjoint.
-    apply (allp_left _ (fL b)).
-    apply wand_sepcon_adjoint.
-    rewrite sepcon_comm, sepcon_assoc, sepcon_comm.
-    apply wand_sepcon_adjoint.
-    apply derives_trans with (mG' (fG b)).
-    - eapply derives_trans; [| apply H].
-      simpl; apply modus_ponens_wand.
-    - apply wand_sepcon_adjoint.
-      rewrite sepcon_comm.
-      apply wand_sepcon_adjoint.
-      apply (allp_left _ (fG b)).
-      apply derives_refl.
-Qed.
-
-Lemma simple_trans: forall {B} g m l (g' m' l': B -> A),
-  (g |-- m * allp (m' -* g')) ->
-  (m |-- l * allp (l' -* m')) ->
-  g |-- l * allp (l' -* g').
-Proof.
-  intros.
-  eapply trans with (mL' := m') (mG' := m') (fL := id B) (fG := id B); eauto.
-Qed.
-
-Lemma trans'':
-  forall {CS: ClassicalSep A}
-     {B C: Type} (f: B->C) p l m g1 g2,
-     g2 = g1 oo f ->
-     (p |-- allp (l -* m oo f)) ->
-     p * allp (m -* g1) |-- allp (l -* g2).
-Proof.
-   intros.
-   subst g2.
-   apply allp_right; intro x.
-   simpl. rewrite <- wand_sepcon_adjoint.
-   rewrite sepcon_assoc.
-   eapply derives_trans; [apply sepcon_derives; [apply H0 | apply derives_refl] | ].
-    rewrite -> wand_sepcon_adjoint.
-  apply allp_left with x.
-   rewrite <- wand_sepcon_adjoint.
-   simpl.
-   rewrite <- !sepcon_assoc.
-   pull_left (l x).
-   eapply derives_trans; [apply sepcon_derives; [ | apply derives_refl] | ].
-   apply modus_ponens_wand.
-   rewrite sepcon_comm.
-   rewrite -> wand_sepcon_adjoint.
-   apply allp_left with (f x). apply derives_refl.
-Qed.
-
-Lemma split: forall {B} g1 g2 l1 l2 (g1' g2' l1' l2': B -> A),
-  (g1 |-- l1 * allp (l1' -* g1')) ->
-  (g2 |-- l2 * allp (l2' -* g2')) ->
-  g1 * g2 |-- (l1 * l2) * allp (l1' * l2' -* g1' * g2').
-Proof.
-  intros.
-  apply solve with (allp (l1' -* g1') * allp (l2' -* g2')).
-  + rewrite (sepcon_assoc l1), <- (sepcon_assoc l2), (sepcon_comm l2), (sepcon_assoc _ l2), <- (sepcon_assoc l1).
-    apply sepcon_derives; auto.
-  + intros x.
-    change ((l1' * l2') x) with (l1' x * l2' x).
-    rewrite <- (sepcon_assoc _ (l1' x)), (sepcon_assoc _ _ (l1' x)), (sepcon_comm _ (l1' x)), <- (sepcon_assoc _ (l1' x)), (sepcon_assoc _ _ (l2' x)).
-    apply sepcon_derives.
-    - apply wand_sepcon_adjoint.
-      apply (allp_left _ x); apply derives_refl.
-    - apply wand_sepcon_adjoint.
-      apply (allp_left _ x).
-      apply derives_refl.
-Qed.
-
-(* Using split to prove frame will lead to a simpler proof. *)
-(* But it requires a unitary separation logic.              *)
-Lemma frame: forall {B} g l (g' l': B -> A) F,
-  (g |-- l * allp (l' -* g')) ->
-  g * F |-- l * allp (l' -* g' * Basics.const F).
-Proof.
-  intros.
-  apply solve with (allp (l' -* g') * F).
-  + rewrite <- sepcon_assoc.
-    apply sepcon_derives; auto.
-  + intros x; unfold Basics.const; simpl.
-    rewrite (sepcon_comm _ (l' x)), <- sepcon_assoc.
-    apply sepcon_derives; [| auto].
-    rewrite sepcon_comm; apply wand_sepcon_adjoint.
-    apply (allp_left _ x); auto.
-Qed.
-
-Lemma frame_post: forall {B} g l (g' l' F: B -> A),
-  (g |-- l * allp (l' -* g')) ->
-  g |-- l * allp (l' * F -* g' * F).
-Proof.
-  intros.
-  apply solve with (allp (l' -* g')).
-  + auto.
-  + intros x; simpl.
-    rewrite <- sepcon_assoc.
-    apply sepcon_derives; [rewrite sepcon_comm | auto].
-    rewrite sepcon_comm; apply wand_sepcon_adjoint.
-    apply (allp_left _ x); auto.
-Qed.
-
-Lemma frame_pre: forall {B} g l (g' l': B -> A) F,
-  (g |-- l * allp (l' -* g')) ->
-  g * F |-- (l * F) * allp (l' -* g').
-Proof.
-  intros.
-  apply solve with (allp (l' -* g')).
-  + rewrite (sepcon_comm l F), sepcon_assoc, (sepcon_comm F).
-    apply sepcon_derives; auto.
-  + intros x.
-    apply wand_sepcon_adjoint.
-    apply (allp_left _ x); apply derives_refl.
-Qed.
-
-Lemma exp_right: forall {T B} (a: B -> T) g l (g': T -> B -> A) (l': B -> A),
-  (g |-- l * allp (l' -* (fun b => g' (a b) b))) ->
-  g |-- l * allp (l' -* exp g').
-Proof.
-  intros.
-  apply solve with (allp (l' -* (fun b => g' (a b) b))); auto.
-  intros.
-  apply wand_sepcon_adjoint.
-  apply (allp_left _ x).
-  simpl.
-  apply wand_derives; auto.
-  apply (exp_right (a x)); auto.
-Qed.
-
-End RAMIF_Q.
-
-Ltac formalize :=
-  match goal with
-  | |- @derives ?Pred _ ?g (?l * @allp ?Pred _ ?T ?Func) =>
-      let g' := fresh "g'" in evar (g': T -> Pred);
-      let l' := fresh "l'" in evar (l': T -> Pred);
-      let x := fresh "x" in
-      let H := fresh "H" in
-      assert (Func = l' -* g') as H;
-      [
-        extensionality x; cbv beta;
-        match goal with
-        | |- ?L' -* exp ?G' = _ =>
-             super_pattern L' x; super_pattern_in_func G' x
-        | |- ?L' -* ?G' = _ =>
-             super_pattern L' x; super_pattern G' x
-        end;
-        match goal with
-        | |- ?L' _ -* exp (fun a => ?G' a _) = _ =>
-             instantiate (1 := L') in (value of l');
-             instantiate (1 := exp G') in (value of g')
-        | |- ?L' _ -* ?G' _ = _ =>
-             instantiate (1 := L') in (value of l');
-             instantiate (1 := G') in (value of g')
-        end;
-        subst g' l';
-        reflexivity
-      | subst g' l'; rewrite H; clear H]
-  end.
-
-End RAMIF_Q.
-
-Module RAMIF_Q'.
-Section RAMIF_Q'.
-
-Context {A : Type}.
-Context {ND : NatDed A}.
-Context {SL : SepLog A}.
-Context {CoSL: CorableSepLog A}.
-
-Lemma reduce: forall {B} g l p (g' l': B -> A),
-  corable p ->
-  (g |-- l * (allp (p --> (l' -* g')))) ->
-  g |-- l * (exp (p && l') -* exp (p && g')).
-Proof.
-  intros.
-  eapply derives_trans; [exact H0 |].
-  apply sepcon_derives; [auto |].
-  apply wand_sepcon_adjoint.
-  rewrite exp_sepcon2.
-  apply exp_left; intro x; apply (exp_right x).
-  apply wand_sepcon_adjoint.
-  apply (allp_left _ x).
-  simpl.
-  apply wand_sepcon_adjoint.
-  rewrite corable_sepcon_andp1 by auto.
-  apply andp_right; [apply andp_left1; auto |].
-  rewrite <- corable_andp_sepcon1 by auto.
-  apply wand_sepcon_adjoint.
-  apply modus_ponens.
-Qed.
-
-Lemma solve: forall {B} g l p g' l' F,
-  corable p ->
-  (g |-- l * F) ->
-  (forall x: B, (p x) && (F * l' x) |-- g' x) ->
-  g |-- l * (allp (p --> (l' -* g'))).
-Proof.
-  intros.
-  apply derives_trans with (l * F); auto.
-  apply sepcon_derives; auto.
-  apply allp_right; intro x.
-  simpl.
-  apply imp_andp_adjoint.
-  apply wand_sepcon_adjoint.
-  rewrite corable_andp_sepcon2 by auto.
-  auto.
-Qed.
-
-Lemma weak_ramif_spec: forall {B} g l p (g' l': B -> A),
-  (g |-- l * allp (p --> l' -* g')) -> g |-- l * TT.
-Proof.
-  intros.
-  eapply derives_trans; [exact H |].
-  apply sepcon_derives; auto.
-  apply TT_right.
-Qed.
-
-Lemma plain_spec: forall {B} g l p g' l' (x: B),
-  corable p ->
-  (g |-- p x) ->
-  (g |-- l * allp (p --> (l' -* g'))) ->
-  g |-- l * (l' x -* g' x).
-Proof.
-  intros.
-  rewrite (add_andp _ _ H1).
-  rewrite (add_andp _ _ H0).
-  rewrite andp_assoc; apply andp_left2.
-  rewrite <- corable_sepcon_andp1 by auto.
-  apply sepcon_derives; [auto |].
-  rewrite andp_comm; apply imp_andp_adjoint.
-  apply (allp_left _ x); apply derives_refl.
-Qed.
-
-Lemma trans: forall {B BG BL} g m l p pG pL g' mG' mL' l' (fG: B -> BG) (fL: B -> BL),
-  corable p ->
-  corable pL ->
-  corable pG ->
-  (g |-- m * allp (pG --> (mG' -* g'))) ->
-  (m |-- l * allp (pL --> (l' -* mL'))) ->
-  (forall b, p b |-- pL (fL b)) ->
-  (forall b, p b && mL' (fL b) |-- pG (fG b) && mG' (fG b)) ->
-  g |-- l * allp (p --> (Basics.compose l' fL -* Basics.compose g' fG)).
-Proof.
-  intros.
-  apply solve with (allp (pL --> (l' -* mL')) * allp (pG --> (mG' -* g'))).
-  + simpl; unfold Basics.compose.
-    auto.
-  + eapply derives_trans; [exact H2 |].
-    eapply derives_trans; [apply sepcon_derives; [exact H3 | apply derives_refl] |].
-    rewrite sepcon_assoc; auto.
-  + intro b.
-    unfold Basics.compose.
-    rewrite <- !corable_andp_sepcon1 by auto.
-    rewrite sepcon_assoc.
-    apply wand_sepcon_adjoint.
-    rewrite andp_comm; apply imp_andp_adjoint.
-    apply (allp_left _ (fL b)); apply imp_andp_adjoint.
-    apply wand_sepcon_adjoint.
-    rewrite sepcon_comm, sepcon_assoc, sepcon_comm.
-    apply wand_sepcon_adjoint.
-    apply derives_trans with (pG (fG b) && mG' (fG b)).
-    - apply derives_trans with (p b && mL' (fL b)); [| apply H5].
-      rewrite corable_sepcon_andp2 by auto.
-      apply andp_right; [apply andp_left1; auto |].
-      rewrite <- corable_sepcon_andp1 by auto.
-      rewrite sepcon_comm.
-      apply wand_sepcon_adjoint.
-      simpl; eapply derives_trans; [| apply modus_ponens].
-      apply andp_derives; [apply H4 | apply derives_refl].
-    - apply wand_sepcon_adjoint.
-      rewrite sepcon_comm.
-      apply wand_sepcon_adjoint.
-      apply (allp_left _ (fG b)); simpl.
-      apply wand_sepcon_adjoint.
-      rewrite corable_sepcon_andp1, <- corable_andp_sepcon1 by auto.
-      apply wand_sepcon_adjoint.
-      apply modus_ponens.
-Qed.
-
-Lemma split: forall {B} g1 g2 l1 l2 (p g1' g2' l1' l2': B -> A),
-  (forall x: B, corable (p x)) ->
-  (g1 |-- l1 * allp (p --> (l1' -* g1'))) ->
-  (g2 |-- l2 * allp (p --> (l2' -* g2'))) ->
-  g1 * g2 |-- (l1 * l2) * allp (p --> (l1' * l2' -* g1' * g2')).
-Proof.
-  intros.
-  apply solve with (allp (p --> (l1' -* g1')) * allp (p --> (l2' -* g2'))).
-  + auto.
-  + rewrite (sepcon_assoc l1), <- (sepcon_assoc l2), (sepcon_comm l2), (sepcon_assoc _ l2), <- (sepcon_assoc l1).
-    apply sepcon_derives; auto.
-  + intros x.
-    change ((l1' * l2') x) with (l1' x * l2' x).
-    rewrite <- (sepcon_assoc _ (l1' x)), (sepcon_assoc _ _ (l1' x)), (sepcon_comm _ (l1' x)), <- (sepcon_assoc _ (l1' x)), (sepcon_assoc _ _ (l2' x)).
-    rewrite <- (andp_dup (p x)), andp_assoc.
-    rewrite <- corable_sepcon_andp1, <- corable_andp_sepcon1 by auto.
-    rewrite <- !corable_sepcon_andp1 by auto.
-    apply sepcon_derives.
-    - apply wand_sepcon_adjoint.
-      apply (allp_left _ x).
-      apply wand_sepcon_adjoint.
-      rewrite corable_sepcon_andp1, <- corable_andp_sepcon1 by auto.
-      (eapply derives_trans; [apply sepcon_derives; [simpl; intros; apply modus_ponens | apply derives_refl] |]).
-      apply wand_sepcon_adjoint; apply derives_refl.
-    - apply wand_sepcon_adjoint.
-      apply (allp_left _ x).
-      apply wand_sepcon_adjoint.
-      rewrite corable_sepcon_andp1, <- corable_andp_sepcon1 by auto.
-      (eapply derives_trans; [apply sepcon_derives; [simpl; intros; apply modus_ponens | apply derives_refl] |]).
-      apply wand_sepcon_adjoint; apply derives_refl.
-Qed.
-
-(* Using split to prove frame will lead to a simpler proof. *)
-(* But it requires a unitary separation logic.              *)
-Lemma frame: forall {B} g l p g' l' F,
-  (forall x: B, corable (p x)) ->
-  (g |-- l * allp (p --> (l' -* g'))) ->
-  g * F |-- l * allp (p --> (l' -* g' * Basics.const F)).
-Proof.
-  intros.
-  apply solve with (allp (p --> (l' -* g')) * F).
-  + auto.
-  + rewrite <- sepcon_assoc.
-    apply sepcon_derives; auto.
-  + intros x; unfold Basics.const; simpl.
-    rewrite <- !corable_andp_sepcon1 by auto.
-    rewrite (sepcon_comm _ (l' x)), <- sepcon_assoc.
-    apply sepcon_derives; [| auto].
-    rewrite sepcon_comm; apply wand_sepcon_adjoint.
-    rewrite andp_comm; apply imp_andp_adjoint; apply (allp_left _ x); apply imp_andp_adjoint.
-    rewrite andp_comm; apply modus_ponens.
-Qed.
-
-Lemma frame_post: forall {B} g l (p g' l' F: B -> A),
-  (forall x: B, corable (p x)) ->
-  (g |-- l * allp (p --> (l' -* g'))) ->
-  g |-- l * allp (p --> (l' * F -* g' * F)).
-Proof.
-  intros.
-  apply solve with (allp (p --> (l' -* g'))).
-  + auto.
-  + auto.
-  + intros x; simpl.
-    rewrite <- !corable_andp_sepcon1 by auto.
-    rewrite <- sepcon_assoc.
-    apply sepcon_derives; [rewrite sepcon_comm | auto].
-    rewrite sepcon_comm; apply wand_sepcon_adjoint.
-    rewrite andp_comm; apply imp_andp_adjoint; apply (allp_left _ x); apply imp_andp_adjoint.
-    rewrite andp_comm; apply modus_ponens.
-Qed.
-
-Lemma frame_pre: forall {B} g l (p g' l': B -> A) F,
-  (forall x: B, corable (p x)) ->
-  (g |-- l * allp (p --> (l' -* g'))) ->
-  g * F |-- (l * F) * allp (p --> (l' -* g')).
-Proof.
-  intros.
-  apply solve with (allp (p --> (l' -* g'))).
-  + auto.
-  + rewrite (sepcon_comm l F), sepcon_assoc, (sepcon_comm F).
-    apply sepcon_derives; auto.
-  + intros x; simpl.
-    rewrite <- !corable_andp_sepcon1 by auto.
-    apply wand_sepcon_adjoint.
-    rewrite andp_comm; apply imp_andp_adjoint; apply (allp_left _ x); apply imp_andp_adjoint.
-    rewrite andp_comm; apply modus_ponens.
-Qed.
-
-Lemma exp_right: forall {T B} (a: B -> T) p g l (g': T -> B -> A) (l': B -> A),
-  corable p ->
-  (g |-- l * allp (p --> (l' -* (fun b => g' (a b) b)))) ->
-  g |-- l * allp (p --> (l' -* exp g')).
-Proof.
-  intros.
-  apply solve with (allp (p --> (l' -* (fun b => g' (a b) b)))); auto.
-  intros.
-  rewrite <- corable_sepcon_andp1 by auto.
-  apply wand_sepcon_adjoint.
-  apply (allp_left _ x).
-  simpl.
-  apply wand_sepcon_adjoint.
-  rewrite corable_sepcon_andp1 by auto.
-  rewrite <- corable_andp_sepcon1 by auto.
-  eapply derives_trans; [apply sepcon_derives; [apply modus_ponens | apply derives_refl] |].
-  apply wand_sepcon_adjoint.
-  apply wand_derives; auto.
-  apply (exp_right (a x)); auto.
-Qed.
-
-End RAMIF_Q'.
-
-Ltac formalize :=
-  match goal with
-  | |- @derives ?Pred _ ?g (?l * @allp ?Pred _ ?T ?Func) =>
-      let p := fresh "p" in evar (p: T -> Pred);
-      let g' := fresh "g'" in evar (g': T -> Pred);
-      let l' := fresh "l'" in evar (l': T -> Pred);
-      let x := fresh "x" in
-      let H := fresh "H" in
-      assert (Func = p --> (l' -* g'));
-      [
-        extensionality x; cbv beta;
-        match goal with
-        | |- ?P --> (?L' -* exp ?G') = _ =>
-             super_pattern P x; super_pattern L' x; super_pattern_in_func G' x
-        | |- ?P --> (?L' -* ?G') = _ =>
-             super_pattern P x; super_pattern L' x; super_pattern G' x
-        end;
-        match goal with
-        | |- ?P _ --> (?L' _ -* exp (fun a => ?G' a _)) = _ =>
-             instantiate (1 := P) in (value of p);
-             instantiate (1 := L') in (value of l');
-             instantiate (1 := exp G') in (value of g')
-        | |- ?P _ --> (?L' _ -* ?G' _) = _ =>
-             instantiate (1 := P) in (value of p);
-             instantiate (1 := L') in (value of l');
-             instantiate (1 := G') in (value of g')
-        end;
-        subst p g' l';
-        reflexivity
-      | subst p g' l'; rewrite H; clear H]
-  end.
-
-End RAMIF_Q'.
diff --git a/msl/rmaps.v b/msl/rmaps.v
deleted file mode 100644
index 21ff5b3e2a..0000000000
--- a/msl/rmaps.v
+++ /dev/null
@@ -1,1038 +0,0 @@
-Require Import VST.msl.msl_standard.
-Require Import VST.msl.Coqlib2.
-
-Module Type ADR_VAL.
-Parameter address : Type.
-Parameter some_address:address.
-
-(* Validity of traces.  The "valid" predicate ensures that related addresses don't get
-    split apart from each other.  *)
-Parameter kind: Type.
-Parameter valid : (address -> option (pshare * kind)) -> Prop.
-Parameter valid_empty: valid (fun _ => None).
-Parameter valid_join: forall f g h : address -> option (pshare * kind),
-   @join _ (Join_fun address (option (pshare * kind))
-                   (Join_lower (Join_prod pshare Join_pshare kind (Join_equiv kind))))
-      f g h  ->
- valid f -> valid g -> valid h.
-End ADR_VAL.
-
-Module Type ADR_VAL0.
-Parameter address : Type.
-Parameter some_address:address.
-Parameter kind: Type.
-End ADR_VAL0.
-
-Module SimpleAdrVal (AV0: ADR_VAL0) <:
-   ADR_VAL with Definition address := AV0.address
-                   with Definition kind := AV0.kind.
-  Import AV0.
-  Definition address := address.
-  Definition some_address := some_address.
-  Definition kind := kind.
-  Definition valid (_: address -> option (pshare * kind)) := True.
-  Lemma valid_empty: valid (fun _ => None).
-  Proof. unfold valid; auto. Qed.
-  Lemma valid_join: forall f g h : address -> option (pshare * kind),
-   @join _ (Join_fun address (option (pshare * kind))
-                   (Join_lower (Join_prod pshare Join_pshare kind (Join_equiv kind))))
-      f g h  ->
-    valid f -> valid g -> valid h.
-  Proof.  intros; unfold valid; auto. Qed.
-End SimpleAdrVal.
-
-Fixpoint listprod (ts: list Type) : Type :=
- match ts with
-  | nil => unit
-  | t :: ts' => prod t (listprod ts')
- end.
-
-Module Type STRAT_MODEL.
-  Declare Module AV : ADR_VAL.
-  Import AV.
-
-  Definition preds (PRED : Type) : Type :=
-    { A: list Type & (listprod A -> PRED) }.
-
-  Definition f_preds : functor preds :=
-    f_sigma _ (fun _ => f_fun _ f_identity).
-  #[global] Existing Instance f_preds.
-
-  Inductive res (PRED : Type) : Type :=
-    | NO'
-    | YES': pshare -> kind -> preds PRED -> res PRED
-    | PURE': kind -> preds PRED -> res PRED.
-
-  Definition res_fmap (A B:Type) (f:A->B) (x:res A) : res B :=
-    match x with
-      | NO' => NO' B
-      | YES' sh k pds => YES' B sh k (fmap f pds)
-      | PURE' k pds => PURE' B k (fmap f pds)
-    end.
-  Axiom ff_res : functorFacts res res_fmap.
-  Definition f_res : functor res := Functor ff_res.
-  #[global] Existing Instance f_res.
-
-  Inductive res_join (PRED : Type) : res PRED -> res PRED -> res PRED -> Prop :=
-    | res_join_NO1 : res_join PRED (NO' PRED) (NO' PRED) (NO' PRED)
-    | res_join_NO2 : forall sh k p, res_join PRED (NO' PRED) (YES' PRED sh k p) (YES' PRED sh k p)
-    | res_join_NO3 : forall sh k p, res_join PRED (YES' PRED sh k p) (NO' PRED) (YES' PRED sh k p)
-    | res_join_YES : forall (sh1 sh2 sh3:pshare) k p,
-      join sh1 sh2 sh3 ->
-      res_join PRED (YES' PRED sh1 k p) (YES' PRED sh2 k p) (YES' PRED sh3 k p)
-    | res_join_PURE : forall k p, res_join PRED (PURE' PRED k p) (PURE' PRED k p) (PURE' PRED k p).
-  Axiom pa_rj : forall PRED, @Perm_alg _ (res_join PRED).
-  Axiom sa_rj : forall PRED, @Sep_alg _ (res_join PRED).
-  Axiom ca_rj : forall PRED, @Canc_alg _ (res_join PRED).
-  Axiom da_rj : forall PRED, @Disj_alg _ (res_join PRED).
-  Axiom paf_res : @pafunctor res f_res res_join.
-
-  #[global] Existing Instance paf_res.
-
-  Definition res_option (PRED : Type) (r: res PRED) :=
-    match r with
-      | NO' => None
-      | YES' sh k _ => Some (sh,k)
-      | PURE' _ _ => None (* PUREs cannot be split in any interesting way, which is what valid is about. *)
-    end.
-
-  Definition valid' A (w: address -> res A) : Prop :=
-    AV.valid (fun l => res_option A (w l)).
-
-  Axiom valid'_res_map : forall A B f m, valid' A m -> valid' B (fmap f oo m).
-
-  Definition pre_rmap (A:Type) := { m:address -> res A | valid' A m }.
-  Definition f_pre_rmap : functor pre_rmap :=
-    f_subset (f_fun _ f_res) _ valid'_res_map.
-  #[global] Existing Instance f_pre_rmap.
-
-  Axiom valid'_res_map2 : forall A B f m, valid' B (res_fmap A B f oo m) -> valid' A m.
-
-  #[global] Instance Join_pre_rmap (A: Type) : Join (pre_rmap A) :=
-            Join_prop _ (Join_fun address (res A) (res_join A)) (valid' A).
-
-  Parameter Perm_pre_rmap: forall (A: Type), Perm_alg (pre_rmap A).
-  Parameter Sep_pre_rmap: forall (A: Type), Sep_alg (pre_rmap A).
-  Parameter Canc_pre_rmap: forall (A: Type), Canc_alg (pre_rmap A).
-  Parameter Disj_pre_rmap: forall (A: Type), Disj_alg (pre_rmap A).
-  #[global] Instance paf_pre_rmap : pafunctor f_pre_rmap :=
-    saf_subset  (paf_fun address paf_res) valid' valid'_res_map valid'_res_map2.
-
-End STRAT_MODEL.
-
-Module StratModel (AV' : ADR_VAL) : STRAT_MODEL with Module AV:=AV'.
-  Module AV := AV'.
-  Import AV.
-
-  Definition preds (PRED : Type) : Type :=
-    { A: list Type & (listprod A -> PRED) }.
-
-  Definition f_preds : functor preds :=
-    f_sigma _ (fun _ => f_fun _ f_identity).
-  #[global] Existing Instance f_preds.
-
-  #[global] Instance Join_preds (A: Type) : Join (preds A) := Join_equiv _.
-
-  Inductive res (PRED : Type) : Type :=
-    | NO'
-    | YES': pshare -> kind -> preds PRED -> res PRED
-    | PURE': kind -> preds PRED -> res PRED.
-
-  Definition res_fmap (A B:Type) (f:A->B) (x:res A) : res B :=
-    match x with
-      | NO' => NO' B
-      | YES' sh k pds => YES' B sh k (fmap f pds)
-      | PURE' k pds => PURE' B k (fmap f pds)
-    end.
-
-  Lemma ff_res : functorFacts res res_fmap.
-  Proof with auto.
-    constructor; intros; extensionality rs; icase rs; unfold res_fmap.
-    rewrite fmap_id... rewrite fmap_id...
-    rewrite <- fmap_comp... rewrite <- fmap_comp...
-  Qed.
-
-  Definition f_res : functor res := Functor ff_res.
-  #[global] Existing Instance f_res.
-
-  Inductive res_join (PRED : Type) : res PRED -> res PRED -> res PRED -> Prop :=
-    | res_join_NO1 : res_join PRED (NO' PRED) (NO' PRED) (NO' PRED)
-    | res_join_NO2 : forall sh k p, res_join PRED (NO' PRED) (YES' PRED sh k p) (YES' PRED sh k p)
-    | res_join_NO3 : forall sh k p, res_join PRED (YES' PRED sh k p) (NO' PRED) (YES' PRED sh k p)
-    | res_join_YES : forall (sh1 sh2 sh3:pshare) k p,
-      join sh1 sh2 sh3 ->
-      res_join PRED (YES' PRED sh1 k p) (YES' PRED sh2 k p) (YES' PRED sh3 k p)
-    | res_join_PURE : forall k p, res_join PRED (PURE' PRED k p) (PURE' PRED k p) (PURE' PRED k p).
-
- #[global] Instance Join_res (PRED: Type) : Join (res PRED) := res_join PRED.
-
-  #[global] Instance pa_rj : forall PRED, @Perm_alg _ (res_join PRED).
-  Proof. intros. constructor.
-
-      (* saf_eq *)
-      intros x y z z' H1 H2; inv H1; inv H2; auto.
-      f_equal. eapply join_eq; eauto.
-
-      (* saf_assoc *)
-      intros a b c d e H1 H2.
-      icase d. exists c. inv H1. inv H2; split; constructor.
-      icase c. 3: exfalso; inv H2. exists b. inv H2. split; auto. icase b. constructor. constructor. inv H1.
-      icase b. 3: exfalso; inv H1. exists (YES' PRED p1 k0 p2). split. constructor. inv H1. apply H2.
-      icase a. 3: exfalso; inv H1. exists e. inv H1. split; auto. icase e. constructor. constructor. inv H2.
-      icase e. 3: exfalso; inv H2. exfalso. inv H2.
-      destruct (@join_assoc _ _ _ p5 p3 p1 p p7) as [sh' [? ?]]. inv H1; auto. inv H2; auto.
-      exists (YES' PRED sh' k p0).
-      inv H1. inv H2. split; constructor; auto.
-      exists (PURE' PRED k p). inv H1. inv H2. split; constructor.
-
-      (* saf_com *)
-      intros a b c H; inv H; econstructor.
-      apply join_comm; auto.
-
-     intros; inv H; inv H0; auto. f_equal. eapply join_positivity; eauto.
- Qed.
-
-  #[global] Instance sa_rj : forall PRED, @Sep_alg _ (res_join PRED).
-  Proof. intros.
-            apply mkSep with (fun x => match x with NO' => NO' _ | YES' _ _ _ => NO' _ | PURE' k pds => PURE' _ k pds end).
-            intro. destruct t; constructor.
-            intros. inversion H; auto.
-  Defined.
-
-  #[global] Instance ca_rj : forall PRED, @Canc_alg _ (res_join PRED).
-  Proof. repeat intro. inv H; inv H0; auto.
-    apply no_units in H2; contradiction.
-    apply no_units in H1; contradiction.
-    f_equal; auto. eapply join_canc; eauto.
-  Qed.
-
-  #[global] Instance da_rj : forall PRED, @Disj_alg _ (res_join PRED).
-  Proof.  repeat intro.
-    inv H; auto. apply join_self in H2. subst; auto.
-  Qed.
-
-  #[global] Instance paf_res : @pafunctor res f_res res_join.
-  Proof. constructor; repeat intro.
-  (* This is a little painful because of the way res_join is defined, but
-      whatever... *)
-    inv H; simpl; constructor; trivial.
-    icase z. exists (NO' _). exists (NO' _). simpl in *. inv H. split. constructor. tauto.
-    2: exists (PURE' _ k p); exists (PURE' _ k p); simpl in *; inv H; split; [constructor | tauto].
-    icase x'. exists (NO' _). exists (YES' _ p k p0). split. constructor. split; auto. simpl in *; inv H. trivial.
-    2: exfalso; inv H.
-    icase y. exists (YES' _ p k p0). exists (NO' _). split. constructor. split; auto. simpl in *. inv H. trivial.
-    2: exfalso; inv H.
-    exists (YES' _ p1 k0 p0). exists (YES' _ p3 k1 p0). simpl in *. inv H. split. constructor. trivial. split; congruence.
-    icase z'. exists (NO' _). exists (NO' _). simpl. icase x; inv H. split. constructor. tauto.
-    destruct x; destruct y; try (exfalso; inv H; fail).
-    exists (YES' _ p1 k0 p2). exists (YES' _ p1 k0 p2). split. constructor. simpl in *. inv H. split; congruence.
-    exists (NO' _). exists (YES' _ p1 k0 p2). split. constructor. simpl in *. inv H. split; congruence.
-    exists (YES' _ p3 k1 p2). exists (YES' _ p k p2). simpl in *. inv H. split. constructor. trivial. split; congruence.
-    destruct x; destruct y; try (exfalso; inv H; fail). unfold fmap in H. unfold f_res in H. unfold res_fmap in H.
-    exists (PURE' _ k0 p0). exists (PURE' _ k0 p0). split. constructor. inv H. simpl. split; congruence.
-  Qed.
-
-  Definition res_option (PRED : Type) (r: res PRED) :=
-    match r with
-      | NO' => None
-      | YES' sh k _ => Some (sh,k)
-      | PURE' _ _ => None
-    end.
-
-  Definition valid' A (w: address -> res A) : Prop :=
-    AV.valid (fun l => res_option A (w l)).
-
-  Lemma same_valid : forall f1 f2, (forall x, f1 x = f2 x) -> AV.valid f1 -> AV.valid f2.
-  Proof.
-    intros; replace f2 with f1; trivial.
-    apply extensionality; auto.
-  Qed.
-
-  Lemma valid'_res_map : forall A B f m,
-    valid' A m -> valid' B (fmap f oo m).
-  Proof.
-    unfold valid'; intros A B f m.
-    apply same_valid; intro l.
-    unfold compose.
-    destruct (m l); simpl; auto.
-  Qed.
-
-  Lemma valid'_res_map2 : forall A B f m,
-    valid' B (res_fmap A B f oo m) -> valid' A m.
-  Proof.
-    unfold valid'; intros A B f m.
-    apply same_valid; intro l.
-    unfold compose.
-    destruct (m l); simpl; auto.
-  Qed.
-
-  Definition pre_rmap (A:Type) := { m:address -> res A | valid' A m }.
-  Definition f_pre_rmap : functor pre_rmap :=
-    f_subset (f_fun _ f_res) _ valid'_res_map.
-  #[global] Existing Instance f_pre_rmap.
-
-  #[global] Instance Join_pre_rmap (A: Type) : Join (pre_rmap A) :=
-            Join_prop _ (Join_fun address (res A) (res_join A)) (valid' A).
-
-  #[global] Instance paf_pre_rmap : pafunctor f_pre_rmap :=
-    saf_subset  (paf_fun address paf_res) valid' valid'_res_map valid'_res_map2.
-
-    Lemma identity_jres : forall PRED (r : res PRED),
-      identity r <-> (r = NO' PRED) \/ (exists k, exists pds, r = PURE' _ k pds).
-    Proof.
-      split; intros.
-      rewrite identity_unit_equiv in H.
-      inv H; auto. elim (pjoin_unit H3).
-      right. exists k. exists p. trivial.
-      rewrite identity_unit_equiv.
-      destruct H as [? | [k [pds ?]]]; subst r; constructor.
-    Qed.
-
-
-  Lemma pre_rmap_sa_valid_core (A: Type):
-        forall x : address -> res A,
-       valid' A x ->
-       valid' A  (@core (address -> res A) (Join_fun address (res A) (res_join A))
-                     (Sep_fun address (res A) (res_join A) (sa_rj A)) x).
-  Proof.
-    intros. red. red.
-    replace (fun l => res_option A (core x l)) with (fun l : address => @None (pshare * kind)).
-    apply AV.valid_empty.
-    extensionality a. simpl. icase (x a).
-  Qed.
-
-
-  Lemma pre_rmap_sa_valid_join : forall A (x y z : address -> res A),
-    @join _ (Join_fun address (res A) (res_join A)) x y z ->
-    valid' A x -> valid' A y -> valid' A z.
-  Proof.
-     intros.
-     simpl in H.
-     unfold valid' in *.
-     apply AV.valid_join with (fun l => res_option A (x l)) (fun l => res_option A (y l)); auto.
-     intro l. spec H l. inv H; try constructor. split; simpl; auto.
-  Qed.
-
-  Definition Perm_pre_rmap (A: Type): Perm_alg (pre_rmap A) :=
-    Perm_prop _ _ (Perm_fun address _ _ _) _ (pre_rmap_sa_valid_join _).
-
-  Definition Sep_pre_rmap (A: Type): Sep_alg (pre_rmap A) :=
-    Sep_prop _ _ (Perm_fun address _ _ _) _ (pre_rmap_sa_valid_join _)  _ (pre_rmap_sa_valid_core _).
-
-  Definition Canc_pre_rmap (A: Type): Canc_alg (pre_rmap A) :=
-    @Canc_prop _ _ _ (Canc_fun address _ _ _).
-
-  Definition Disj_pre_rmap (A: Type): Disj_alg (pre_rmap A) :=
-    @Disj_prop _ _ _ (Disj_fun address _ _ _).
-
-End StratModel.
-
-Open Local Scope nat_scope.
-
-Module Type RMAPS.
-  Declare Module AV:ADR_VAL.
-  Import AV.
-
-  Parameter rmap : Type.
-  Axiom Join_rmap: Join rmap. #[global] Existing Instance Join_rmap.
-  Axiom Perm_rmap: Perm_alg rmap. #[global] Existing Instance Perm_rmap.
-  Axiom Sep_rmap: Sep_alg rmap. #[global] Existing Instance Sep_rmap.
-  Axiom Canc_rmap: Canc_alg rmap.  #[global] Existing Instance Canc_rmap.
-  Axiom Disj_rmap: Disj_alg rmap.  #[global] Existing Instance Disj_rmap.
-  Axiom ag_rmap: ageable rmap.  #[global] Existing Instance ag_rmap.
-  Axiom Age_rmap: Age_alg rmap.  #[global] Existing Instance Age_rmap.
-
-  Inductive preds : Type :=
-    SomeP : forall A : list Type, (listprod A -> pred rmap) -> preds.
-
-  Definition NoneP := SomeP ((Void:Type)::nil) (fun _ => FF).
-  Definition hair := preds.
-
-  Inductive resource : Type :=
-    | NO
-    | YES: pshare -> kind -> preds -> resource
-    | PURE: kind -> preds -> resource.
-
-  Definition res_option (r:resource) :=
-    match r with
-      | NO => None
-      | YES sh k _ => Some (sh,k)
-      | PURE k _ => None
-    end.
-
-  Inductive res_join : resource -> resource -> resource -> Prop :=
-   | res_join_NO1 : res_join NO NO NO
-   | res_join_NO2 : forall sh k p, res_join (YES sh k p) NO (YES sh k p)
-   | res_join_NO3 : forall sh k p, res_join NO (YES sh k p) (YES sh k p)
-   | res_join_YES : forall (sh1 sh2 sh3:pshare) k p,
-        join sh1 sh2 sh3 ->
-        res_join (YES sh1 k p) (YES sh2 k p) (YES sh3 k p)
-   | res_join_PURE : forall k p, res_join (PURE k p) (PURE k p) (PURE k p).
-
-
-  #[global] Instance Join_resource: Join resource := res_join.
-  Axiom Perm_resource: Perm_alg resource. #[global] Existing Instance Perm_resource.
-  Axiom Sep_resource: Sep_alg resource. #[global] Existing Instance Sep_resource.
-  Axiom Canc_resource: Canc_alg resource. #[global] Existing Instance Canc_resource.
-  Axiom Disj_resource: Disj_alg resource. #[global] Existing Instance Disj_resource.
-
-  Definition preds_fmap (f:pred rmap -> pred rmap) (x:preds) : preds :=
-    match x with SomeP A Q => SomeP A (f oo Q)
-    end.
-  Axiom preds_fmap_id : preds_fmap (id _) = id preds.
-  Axiom preds_fmap_comp : forall f g, preds_fmap g oo preds_fmap f = preds_fmap (g oo f).
-
-  Definition resource_fmap (f:pred rmap -> pred rmap) (x:resource) : resource :=
-    match x with
-    | NO => NO
-    | YES sh k p => YES sh k (preds_fmap f p)
-    | PURE k p => PURE k (preds_fmap f p)
-    end.
-  Axiom resource_fmap_id : resource_fmap (id _) = id resource.
-  Axiom resource_fmap_comp : forall f g, resource_fmap g oo resource_fmap f = resource_fmap (g oo f).
-
-  Definition valid (m: address -> resource) : Prop :=
-    AV.valid  (res_option oo m).
-
-  Axiom valid_res_map : forall f m, valid m -> valid (resource_fmap f oo m).
-  Axiom rmapj_valid_join : forall (x y z : address -> resource),
-    join x y z -> valid x -> valid y -> valid z.
-  Axiom rmapj_valid_core: forall x: address -> resource, valid x -> valid (core x).
-
-  Definition rmap' := sig valid.
-
-  Definition rmap_fmap (f: pred rmap -> pred rmap) (x:rmap') : rmap' :=
-    match x with exist m H => exist (fun m => valid m) (resource_fmap f oo m) (valid_res_map f m H) end.
-  Axiom rmap_fmap_id : rmap_fmap (id _) = id rmap'.
-  Axiom rmap_fmap_comp : forall f g, rmap_fmap g oo rmap_fmap f = rmap_fmap (g oo f).
-
-  Parameter squash : (nat * rmap') -> rmap.
-  Parameter unsquash : rmap -> (nat * rmap').
-
-
-  Axiom rmap_level_eq: @level rmap _ = fun x => fst (unsquash x).
-  Axiom rmap_age1_eq: @age1 _ _ =
-     fun k => match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-
-  Definition resource_at (phi:rmap) : address -> resource := proj1_sig (snd (unsquash phi)).
-  Infix "@" := resource_at (at level 50, no associativity).
-
-  #[global] Instance Join_nat_rmap': Join (nat * rmap') := Join_prod _ (Join_equiv nat) _ _.
-
-  Axiom join_unsquash : forall phi1 phi2 phi3,
-    join phi1 phi2 phi3 <->
-    join (unsquash phi1) (unsquash phi2) (unsquash phi3).
-
-  Definition rmap_unage (k:rmap) : rmap :=
-    match unsquash k with
-    | (n,x) => squash (S n, x)
-    end.
-
-  Program Definition approx (n:nat) (p: pred rmap) : pred rmap :=
-    fun w => level w < n /\ p w.
-  Next Obligation.
-  destruct H0.
-  split.
-  apply age_level in H. lia.
-  apply pred_hereditary with a; auto.
-  Qed.
-
-  Axiom squash_unsquash : forall phi, squash (unsquash phi) = phi.
-  Axiom unsquash_squash : forall n rm, unsquash (squash (n,rm)) = (n,rmap_fmap (approx n) rm).
-
-End RMAPS.
-
-Module Rmaps (AV':ADR_VAL) : RMAPS with Module AV:=AV'.
-  Module AV:=AV'.
-  Import AV.
-
-  Module SM := StratModel(AV).
-  Import SM.
-
-  Module TyF. (* <: TY_FUNCTOR_PROP. *)
-    Definition F := pre_rmap.
-    Definition f_F := f_pre_rmap.
-
-    Definition other := unit.
-
-  End TyF.
-
-  Module TyFSA. (* <: TY_FUNCTOR_SA_PROP with Module TF:=TyF. *)
-    Module TF := TyF.
-    Import TF.
-
-  #[global] Instance Join_F: forall A, Join (F A) := _.
-  Definition Perm_F : Perm_paf f_F Join_F := fun A _ _ => Perm_pre_rmap A.
-  Definition Sep_F : Sep_paf f_F Join_F := fun (A : Type) (JA : Join A) _ _ => Sep_pre_rmap A.
-  Definition Canc_F : Canc_paf f_F Join_F := fun (A : Type) (JA : Join A) _ _ => Canc_pre_rmap A.
-  Definition Disj_F : Disj_paf f_F Join_F := fun (A : Type) (JA : Join A) _ _ => Disj_pre_rmap A.
-  Definition paf_F := paf_pre_rmap.
- End TyFSA.
-
-  Module K := KnotHered(TyF).
-  Module KL := KnotHered_Lemmas(K).
-  Module KSa := KnotHeredSa(TyFSA)(K).
-
-  Definition rmap := K.knot.
-  #[global] Instance Join_rmap: Join rmap := KSa.Join_knot.
-  #[global] Instance Perm_rmap : Perm_alg rmap:= KSa.Perm_knot.
-  #[global] Instance Sep_rmap : Sep_alg rmap:= KSa.Sep_knot Sep_pre_rmap.
-  #[global] Instance Canc_rmap : Canc_alg rmap:= KSa.Canc_knot Canc_pre_rmap.
-  #[global] Instance Disj_rmap : Disj_alg rmap:= KSa.Disj_knot Disj_pre_rmap.
-  #[global] Instance ag_rmap : ageable rmap := KSa.K.ag_knot.
-  #[global] Instance Age_rmap: Age_alg rmap := KSa.asa_knot.
-
-  Inductive preds : Type :=
-    SomeP : forall A : list Type, (listprod A -> pred rmap) -> preds.
-
-  Definition NoneP := SomeP ((Void:Type)::nil) (fun _ => FF).
-
-  Definition hair := preds.
-
-  Inductive resource : Type :=
-    | NO
-    | YES: pshare -> kind -> preds -> resource
-    | PURE : kind -> preds -> resource.
-
-  Definition resource2res (r: resource): res (pred rmap) :=
-    match r with
-      | NO => NO' (pred rmap)
-      | YES p k (SomeP A l) => YES' (pred rmap) p k (existT _ A l)
-      | PURE k (SomeP A l) => PURE' (pred rmap) k (existT _ A l)
-    end.
-
-  Definition res2resource (r: res (pred rmap)) : resource :=
-    match r with
-      | NO' => NO
-      | YES' p k (existT A l) => YES p k (SomeP A l)
-      | PURE' k (existT A l) => PURE k (SomeP A l)
-    end.
-
-  Lemma res2resource2res: forall x, resource2res (res2resource x) = x.
-  Proof. unfold resource2res, res2resource; destruct x; try destruct p0; try destruct p; auto. Qed.
-
-  Lemma resource2res2resource: forall x, res2resource (resource2res x) = x.
-  Proof. unfold resource2res, res2resource; destruct x; try destruct p0; try destruct p; auto. Qed.
-
-  Definition res_option (r:resource) :=
-    match r with
-      | NO => None
-      | YES sh k _ => Some (sh,k)
-      | PURE _ _ => None
-    end.
-
-  Lemma res_option_rewrite: res_option = SM.res_option (pred rmap) oo resource2res.
-  Proof. extensionality r; destruct r; auto. destruct p0; auto. destruct p; auto. Qed.
-
-  Definition valid (m: address -> resource) : Prop :=
-    AV.valid (res_option oo m).
-
-  Inductive res_join : resource -> resource -> resource -> Prop :=
-   | res_join_NO1 : res_join NO NO NO
-   | res_join_NO2 : forall sh k p, res_join (YES sh k p) NO (YES sh k p)
-   | res_join_NO3 : forall sh k p, res_join NO (YES sh k p) (YES sh k p)
-   | res_join_YES : forall (sh1 sh2 sh3:pshare) k p,
-        join sh1 sh2 sh3 ->
-        res_join (YES sh1 k p) (YES sh2 k p) (YES sh3 k p)
-   | res_join_PURE : forall k p, res_join (PURE k p) (PURE k p) (PURE k p).
-
-
-  #[global] Instance Join_resource: Join resource := res_join.
-  #[global] Instance Perm_resource: Perm_alg resource.
-  Proof. constructor.
-
-      (* saf_eq *)
-      intros x y z z' H1 H2; inv H1; inv H2; auto.
-      replace sh5 with sh3; auto.
-      eapply join_eq; eauto.
-
-      (* saf_assoc *)
-      intros a b c d e H1 H2.
-      destruct d. exists c. inv H1. inv H2; split; constructor.
-      2: exists (PURE k p); inv H1; inv H2; split; constructor.
-      destruct e; try (exfalso; inv H2; fail).
-      destruct c. exists b. inv H2. split; auto. destruct b; try constructor. inv H1.
-      2: exfalso; inv H2.
-      destruct b. exists (YES p3 k1 p4). split. constructor. inv H1. trivial.
-      2: exfalso; inv H1.
-      destruct a. exists (YES p1 k0 p2). inv H1. split; trivial. constructor.
-      2: exfalso; inv H1.
-      destruct (@join_assoc _ _ _ p7 p5 p3 p p1) as [sh' [? ?]].
-      inv H1; auto. inv H2; auto.
-      exists (YES sh' k p0). inv H1. inv H2. split; constructor; trivial.
-
-      (* saf_com *)
-      intros a b c H; inv H; econstructor.
-      apply join_comm; auto.
-
-      (* positivity *)
-      intros. inv H; inv H0; auto. f_equal. eapply join_positivity; eauto.
-  Qed.
-
-  #[global] Instance Sep_resource: Sep_alg resource.
-  Proof.
-    apply mkSep with (fun x => match x with NO => NO | YES _ _ _ => NO | PURE k pds => PURE k pds end).
-    intros; destruct t; constructor.
-    intros; inv H; auto.
-  Defined.
-
-  #[global] Instance Canc_resource: Canc_alg resource.
-  Proof.
-      intros a1 a2 b c H1 H2; inv H1; inv H2; auto.
-      elim (pjoin_unit H1).
-      elim (pjoin_unit H).
-      f_equal.
-      eapply join_canc; eauto.
-  Qed.
-
-  #[global] Instance Disj_resource: Disj_alg resource.
-  Proof.
-    repeat intro. inv H; auto. f_equal. apply join_self; auto.
-  Qed.
-
-  Lemma identity_resource : forall r,
-    identity r <-> (r = NO) \/ (exists k, exists pds, r = PURE k pds).
-  Proof.
-    split; intros.
-    rewrite identity_unit_equiv in H.
-    inv H; auto.
-    elim (pjoin_unit H3). right. exists k. exists p. trivial.
-    rewrite identity_unit_equiv; destruct H as [? | [? [? ?]]]; subst r; constructor.
-  Qed.
-
-  Lemma same_valid : forall f1 f2, (forall x, f1 x = f2 x) -> AV.valid f1 -> AV.valid f2.
-  Proof.
-    intros; replace f2 with f1; trivial.
-    apply extensionality; auto.
-  Qed.
-
-  Lemma rmapj_valid_core: forall x : address -> resource, valid x -> valid (core x).
-  Proof.
-     unfold valid, compose; intros. red. red.
-     replace (fun x0 => res_option (core x x0)) with (fun _ : address => @None (pshare * kind)).
-     apply AV.valid_empty.
-     extensionality a. simpl. icase (x a).
-  Qed.
-
-  Lemma rmapj_valid_join : forall (x y z : address -> resource),
-    join x y z ->
-    valid x -> valid y -> valid z.
-  Proof.
-     intros.
-     simpl in H.
-     unfold valid, compose in *.
-     apply AV.valid_join with (fun l => res_option (x l)) (fun l => res_option (y l)); auto.
-     intro l. specialize (H l). inv  H; eauto. constructor. constructor. constructor.
-     constructor. constructor. apply H5. split; auto.
-     constructor.
-  Qed.
-
-  Definition rmap' := sig valid.
-  Definition preds_fmap (f:(pred rmap)->(pred rmap)) (x:preds) : preds :=
-    match x with SomeP A ls => SomeP A (f oo ls) end.
-
-  Lemma preds_fmap_id : preds_fmap (id (pred rmap)) = id preds.
-  Proof.
-    intros; apply extensionality; intro x; destruct x; simpl; auto;
-   (* the rest of this is for compatibility with Coq 8.3 *)
-    replace (id (pred rmap) oo p) with p; auto;
-    rewrite id_unit2; auto.
-  Qed.
-
-  Lemma preds_fmap_comp : forall f g, preds_fmap g oo preds_fmap f = preds_fmap (g oo f).
-  Proof.
-    intros; apply extensionality; intro x; destruct x; simpl; auto.
-  Qed.
-
-  Definition resource_fmap (f:(pred rmap)->(pred rmap)) (x:resource) : resource :=
-    match x with
-    | NO => NO
-    | YES sh k p => YES sh k (preds_fmap f p)
-    | PURE k p => PURE k (preds_fmap f p)
-    end.
-
-  Lemma valid_res_map : forall f m, valid m -> valid (resource_fmap f oo m).
-  Proof.
-    unfold valid, compose; intros.
-    replace (fun l : address => res_option (resource_fmap f (m l)))
-       with (fun l : address => res_option (m l)); auto.
-    extensionality l.
-    unfold res_option, resource_fmap.
-    case (m l); auto.
-  Qed.
-
-  Lemma resource_fmap_id : resource_fmap (id (pred rmap)) = id resource.
-  Proof.
-    intros; apply extensionality; intro x.
-    unfold resource_fmap.
-    destruct x; simpl; auto.
-    rewrite preds_fmap_id; auto.
-    rewrite preds_fmap_id; auto.
-  Qed.
-
-  Lemma resource_fmap_comp : forall f g, resource_fmap g oo resource_fmap f = resource_fmap (g oo f).
-  Proof.
-    intros f g.
-    apply extensionality; intro x; destruct x; simpl; auto.
-    unfold compose at 1; simpl.
-    rewrite <- preds_fmap_comp; auto.
-    rewrite <- preds_fmap_comp; auto.
-  Qed.
-
-  Definition rmap_fmap (f:(pred rmap)->(pred rmap)) (x:rmap') : rmap' :=
-    match x with exist m H => exist (fun m => valid m) (resource_fmap f oo m) (valid_res_map f m H) end.
-
-  Lemma rmap_fmap_id : rmap_fmap (id (pred rmap)) = id rmap'.
-  Proof.
-    intros; apply extensionality; intro x.
-    unfold rmap_fmap; destruct x.
-    unfold id at 3.
-    generalize (valid_res_map (id _) x v).
-    rewrite (resource_fmap_id).
-    simpl.
-    rewrite (id_unit2 _ (resource) x).
-    intro v0. f_equal; auto.
-    apply proof_irr.
-  Qed.
-
-  Lemma rmap_fmap_comp : forall f g, rmap_fmap g oo rmap_fmap f = rmap_fmap (g oo f).
-  Proof.
-    intros f g.
-    unfold rmap_fmap.
-    apply extensionality; intro x.
-    unfold compose at 1.
-    destruct x.
-    generalize (valid_res_map g (resource_fmap f oo x) (valid_res_map f x v)).
-    generalize (valid_res_map (g oo f) x v).
-    clear.
-    assert (resource_fmap g oo resource_fmap f oo x = resource_fmap (g oo f) oo x).
-    rewrite <- compose_assoc.
-    rewrite resource_fmap_comp; auto.
-    rewrite H.
-    intros.
-    intros; f_equal; proof_irr; auto.
-  Qed.
-
-  Definition rmap'2pre_rmap (r: rmap') : pre_rmap (pred rmap).
-    destruct r as [f ?].
-    unfold pre_rmap.
-    assert (valid' _ (fun x: address => resource2res (f x))).
-    unfold valid'. unfold valid, compose in v.
-    eapply same_valid; try apply v.
-    intros. simpl.
-    destruct (f x); simpl; auto. destruct p0; simpl; auto. destruct p; simpl; auto.
-    eauto.
-  Defined.
-
-  Definition pre_rmap2rmap' (r: pre_rmap (pred rmap)) : rmap'.
-    destruct r as [f ?].
-    unfold rmap', valid' in *.
-    assert (valid (fun l: address => res2resource (f l))).
-    unfold valid, compose.
-    replace (fun l : address => res_option (res2resource (f l))) with (fun l : address => SM.res_option (pred rmap) (f l)); auto.
-    extensionality l. rewrite res_option_rewrite.
-    unfold compose; simpl. rewrite res2resource2res. auto.
-    eauto.
-  Defined.
-
-  Lemma rmap'2pre_rmap2rmap' :
-    forall x, rmap'2pre_rmap (pre_rmap2rmap' x) = x.
-  Proof.
-    intro. destruct x as [f V]. unfold rmap'2pre_rmap, pre_rmap2rmap'. simpl.
-    match goal with |- exist _ _ ?p = _ => generalize p; intro p1 end.
-    apply exist_ext.
-    extensionality x; rewrite res2resource2res; auto.
-  Qed.
-
-  Lemma pre_rmap2rmap'2pre_rmap :
-    forall x,  pre_rmap2rmap' (rmap'2pre_rmap x) = x.
-  Proof.
-    intro.
-    destruct x as [f V].
-    unfold rmap'2pre_rmap, pre_rmap2rmap'. simpl.
-    match goal with |- exist _ _ ?p = _ => generalize p; intro p1 end.
-    apply exist_ext.
-    extensionality x; rewrite resource2res2resource; auto.
-  Qed.
-
-  Program Definition p2p (p:(pred rmap)) : K.predicate :=
-    fun phi_e => p (fst phi_e).
-  Next Obligation.
-    destruct a as [a b]; destruct a' as [a' b'].
-    unfold age, age1 in H. simpl in H. invSome. simpl in *.
-    eapply pred_hereditary; eauto.
- Qed.
-
-  Program Definition p2p' (p:K.predicate) : (pred rmap) :=
-    fun (v:rmap) => p (v, tt).
-  Next Obligation.
-  unfold age in H; simpl in H.
-  unfold rmap in *.
-  eapply pred_hereditary; eauto.
-  unfold age, age1; simpl.
-  unfold ag_rmap in H. rewrite H. auto.
- Qed.
-
-  Definition squash (n_rm:nat * rmap') : rmap :=
-    match n_rm with (n,rm) => K.squash (n, fmap p2p (rmap'2pre_rmap rm)) end.
-
-  Definition unsquash (phi:rmap) : (nat * rmap') :=
-    match K.unsquash phi with (n,rm) => (n, pre_rmap2rmap' (fmap p2p' rm)) end.
-
-  Definition rmap_level (phi:rmap) : nat := fst (unsquash phi).
-  Definition resource_at (phi:rmap) : address -> resource := proj1_sig (snd (unsquash phi)).
-  Infix "@" := resource_at (at level 50, no associativity).
-
-  Lemma pred_ext': forall {A} `{agA: ageable A} P Q,
-                (forall x, app_pred P x <-> app_pred Q x) -> P = Q.
-  Proof. intros; apply pred_ext; intro; apply H; auto. Qed.
-
-  Lemma squash_unsquash : forall phi, squash (unsquash phi) = phi.
-  Proof.
-    intros.
-    unfold squash, unsquash; simpl.
-    case_eq (K.unsquash phi); simpl; intros.
-    rewrite rmap'2pre_rmap2rmap'.
-    match goal with [ |- K.squash (n,?X) = _ ] =>
-      change X with
-        ((fmap p2p oo fmap p2p') f)
-    end.
-    rewrite fmap_comp.
-    replace (p2p oo p2p') with (id K.predicate).
-    rewrite fmap_id.
-    unfold id.
-    unfold TyF.F in *.
-    rewrite <- H.
-    rewrite K.squash_unsquash; auto.
-    extensionality p.
-    apply pred_ext'. intro x.
-    destruct x as [k e].
-    unfold compose, p2p, p2p'; simpl.
-    unfold id.
-    destruct e; intuition.
-  Qed.
-
-  Program Definition approx (n:nat) (p: (pred rmap)) : (pred rmap) :=
-    fun w => level w < n /\ p w.
-  Next Obligation.
-  destruct H0.
-  split.
-  apply age_level in H.
-  simpl in *. lia.
-  apply pred_hereditary with a; auto.
-  Qed.
-
-  Lemma unsquash_squash : forall n rm, (unsquash (squash (n,rm))) = (n,rmap_fmap (approx n) rm).
-  Proof.
-    intros.
-    unfold unsquash, squash.
-    rewrite K.unsquash_squash; simpl.
-    match goal with [|- (_,?X) = (_,?Y) ] =>
-      replace Y with X; auto
-    end.
-    match goal with [|- pre_rmap2rmap' ?X = _ ] =>
-      replace X with
-        (fmap (p2p' oo K.approx n oo p2p) (rmap'2pre_rmap rm))
-    end.
-    2: repeat rewrite <- fmap_comp.
-    2: unfold compose; auto.
-    destruct rm; simpl.
-    apply exist_ext.
-    extensionality l.
-    unfold compose.
-    destruct (x l); simpl; auto.
-    (* YES *)
-    destruct p0; simpl.
-    f_equal. f_equal.
-    extensionality a.
-    apply pred_ext'; intro w.
-    unfold p2p', p2p, approx, compose; simpl.
-    unfold app_pred at 1.
-    rewrite K.approx_spec.
-    unfold fidentity_fmap;
-    unfold rmap_level, unsquash; simpl;
-    repeat rewrite K.knot_level;
-    repeat rewrite setset, setget;     intuition.
-    (* PURE *)
-    destruct p; simpl.
-    f_equal. f_equal.
-    extensionality a.
-    apply pred_ext'; intro w.
-    unfold p2p', p2p, approx, compose; simpl.
-    unfold app_pred at 1.
-    rewrite K.approx_spec.
-    unfold fidentity_fmap;
-    unfold rmap_level, unsquash; simpl;
-    repeat rewrite K.knot_level;
-    repeat rewrite setset, setget;     intuition.
-  Qed.
-
-  #[global] Instance Join_nat_rmap': Join (nat * rmap') := Join_prod _ (Join_equiv nat) _ _.
-
-Lemma fmap_p2p'_inj:
-  forall p q,
-        @fmap SM.preds f_preds K.predicate (@pred rmap ag_rmap) p2p' p =
-        @fmap SM.preds f_preds K.predicate (@pred rmap ag_rmap) p2p' q ->
-        p=q.
-Proof.
-  intros.
-  destruct p as [p Vp]. destruct q as [q Vq].
-  unfold fmap in *. unfold f_preds in *. simpl in *.
-  inv H.
-  f_equal.
-  apply inj_pair2 in H2. unfold ffun_fmap, f_identity in *.
-  unfold fmap, compose in H2.
-  extensionality w.
- apply equal_f with w in H2. unfold fidentity_fmap in *.
-  unfold p2p' in *. inv H2.
-  unfold K.predicate in *.
-  apply pred_ext'. intros [k o]. destruct o.
-  apply equal_f with k in H0. rewrite H0; intuition.
-Qed.
-
-  Lemma join_unsquash : forall phi1 phi2 phi3,
-    join phi1 phi2 phi3 <->
-    join (unsquash phi1) (unsquash phi2) (unsquash phi3).
-  Proof.
-    intros.
-    unfold unsquash.
-    rewrite KSa.join_unsquash.
-    destruct (K.unsquash phi1).
-    destruct (K.unsquash phi2).
-    destruct (K.unsquash phi3).
-    simpl; intuition.
-    destruct H; simpl in *; split; simpl; auto.
-    intro l; spec H0 l.
-    destruct f as [f ?].
-    destruct f0 as [f0 ?].
-    destruct f1 as [f1 ?].
-    simpl in *.
-    unfold compose.
-    inv H0; simpl.
-    constructor. destruct p. simpl in *. constructor. destruct p. simpl in *. constructor.
-    destruct p; simpl in *.
-    constructor; auto.
-    destruct p; simpl in *.
-    constructor; auto.
-
-    destruct H; simpl in *; split; simpl; auto.
-    destruct f as [f ?].
-    destruct f0 as [f0 ?].
-    destruct f1 as [f1 ?].
-    hnf in H0. simpl proj1_sig in H0.
-    intro l; spec H0 l.
-    simpl proj1_sig.
-    clear - H0.
-    forget (f l) as a; forget (f0 l) as b; forget (f1 l) as c.
-    clear - H0.
-    unfold res2resource in *. unfold res_fmap in *.
-    destruct a as [|sha ka pa|ka pa]; try (remember (fmap p2p' pa) as fa; destruct fa);
-    destruct b as [|shb kb pb|kb pb]; try (remember (fmap p2p' pb) as fb; destruct fb);
-    destruct c as [|shc kc pc|kc pc]; try (remember (fmap p2p' pc) as fc; destruct fc);
-    inv H0.
-    constructor.
-    apply inj_pair2 in H7. subst p0.
-    replace pb with pc; [ constructor |].
-    rewrite Heqfb in Heqfc. clear - Heqfc.
-    apply fmap_p2p'_inj ; auto.
-    apply inj_pair2 in H7. subst p0. rewrite Heqfa in Heqfc; clear - Heqfc.
-    apply fmap_p2p'_inj in Heqfc. subst; constructor.
-   subst x1. apply inj_pair2 in H11. subst p1. apply inj_pair2 in H7; subst p0.
-   rewrite Heqfa in Heqfc, Heqfb; clear Heqfa.
-    apply fmap_p2p'_inj in Heqfc.
-     apply fmap_p2p'_inj in Heqfb. subst. subst. constructor. auto.
-    subst x1. apply inj_pair2 in H8. subst p1. apply inj_pair2 in H5. subst p0.
-   rewrite Heqfa in Heqfc, Heqfb; clear Heqfa.
-    apply fmap_p2p'_inj in Heqfc.
-     apply fmap_p2p'_inj in Heqfb. subst. subst. constructor.
-Qed.
-
-
-  Definition rmap_age1 (k:rmap) : option rmap :=
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-
-  Definition rmap_unage (k:rmap) : rmap :=
-    match unsquash k with
-    | (n,x) => squash (S n, x)
-    end.
-
-  Lemma rmap_age1_knot_age1 :
-    rmap_age1 = @age1 _ K.ag_knot.
-  Proof.
-    extensionality x.
-    unfold rmap_age1.
-    rewrite  K.knot_age1.
-    unfold unsquash, squash.
-    case (K.unsquash x); simpl; intros.
-    destruct n; auto.
-    rewrite rmap'2pre_rmap2rmap'.
-    f_equal. f_equal. f_equal.
-    change ((fmap p2p oo fmap p2p') f = f).
-    rewrite fmap_comp.
-    replace (p2p oo p2p') with (id K.predicate).
-    rewrite fmap_id; auto.
-
-    extensionality p; apply pred_ext'; intro a; simpl.
-    destruct a; unfold id; simpl.
-    unfold compose.
-    unfold p2p. unfold p2p'. simpl.
-    unfold TyF.other in *. destruct o. intuition.
-  Qed.
-
-  Lemma rmap_age1_eq: @age1 _ ag_rmap = rmap_age1.
-  Proof.
-   unfold age1. unfold ag_rmap; simpl; auto.
-   rewrite rmap_age1_knot_age1; reflexivity.
-  Qed.
-
-  Lemma rmap_level_eq: @level rmap ag_rmap = fun x => fst (unsquash x).
-  Proof.
-    intros.
-   extensionality x.  unfold level.  unfold ag_rmap.
-   unfold KSa.K.ag_knot. unfold unsquash.
-   rewrite K.knot_level. destruct (K.unsquash x); simpl. auto.
-  Qed.
-
-  Lemma unevolve_identity_rmap :
-   (* REMARK:  This may not be needed for anything, so for now it's removed
-     from the Module Type *)
-    forall w w':rmap, necR w w' -> identity w' -> identity w.
-  Proof.
-    intros.
-    induction H; eauto.
-    rewrite identity_unit_equiv in H0.
-    rewrite identity_unit_equiv.
-    red in H0. red.
-    rewrite join_unsquash in H0.
-    rewrite join_unsquash.
-    hnf in H. unfold rmap, ag_rmap in H. rewrite <- rmap_age1_knot_age1 in H.
-    unfold rmap_age1 in H.
-   destruct (unsquash x).
-   destruct n. inv H.
-    assert (y = squash (n,r)).
-    inv H; auto.
-    subst y.
-    rewrite unsquash_squash in H0.
-    destruct H0; split;  simpl fst in *; simpl snd in *; try split; auto.
-    intro l; spec H1 l.
-    destruct r.
-    simpl in *.
-    unfold compose in *.
-    destruct (x0 l); simpl in *.
-    constructor.
-    inv H1. constructor; auto.
-    constructor.
-  Qed.
-
-End Rmaps.
-Local Close Scope nat_scope.
-
-
-
-
diff --git a/msl/rmaps_lemmas.v b/msl/rmaps_lemmas.v
deleted file mode 100644
index b88f043801..0000000000
--- a/msl/rmaps_lemmas.v
+++ /dev/null
@@ -1,1364 +0,0 @@
-Require Import VST.msl.msl_standard.
-Require Import VST.msl.cjoins.
-Require Import VST.msl.rmaps.
-Require Import VST.msl.Coqlib2.
-Require Import VST.msl.sepalg_list.
-
-Module Rmaps_Lemmas (R: RMAPS).
-Module R := R.
-Import R.
-
-Definition subp_sepcon_rmap := @subp_sepcon _ Join_rmap Perm_rmap Sep_rmap.
-
-Hint Resolve subp_sepcon_rmap : contractive.
-
- Lemma approx_p  : forall (p:pred rmap) n w, approx n p w -> p w.
- Proof. unfold approx; simpl; intuition. Qed.
-
- Lemma approx_lt : forall (p:pred rmap) n w, lt (level w) n -> p w -> approx n p w.
- Proof. unfold approx; simpl; intuition. Qed.
-
- Lemma approx_ge : forall p n w, ge (level w) n -> approx n p w -> False.
- Proof. unfold approx; intros. des truct H0; auto. lia. Qed.
-
-  Definition identity_rmap' : R.rmap' := exist valid (fun _: AV.address => R.NO) AV.valid_empty.
-  Definition identity_rmap (n:nat) : rmap := R.squash (n, identity_rmap').
-
-  Lemma identity_level : forall n, level (identity_rmap n) = n.
-  Proof.
-    intro n; unfold identity_rmap.
-    rewrite rmap_level_eq. rewrite unsquash_squash. auto.
-  Qed.
-
-  Lemma snd_identity_map : forall n, proj1_sig (snd (R.unsquash (identity_rmap n))) = fun _ => R.NO .
-    unfold identity_rmap; intros.
-    rewrite R.unsquash_squash.
-    simpl.
-    apply extensionality; intro l.
-    unfold compose; simpl; auto.
-  Qed.
-
-  Lemma comparable_level : forall phi1 phi2 : rmap ,
-         comparable phi1 phi2 -> level phi1 = level phi2.
-  Proof.
-   intros.
-   apply comparable_fashionR.
-   trivial.
-  Qed.
-
-  Lemma ageN_level : forall n (phi1 phi2 : rmap),
-    ageN n phi1 = Some phi2 -> level phi1 = (n + (level phi2))%nat.
-  Proof.
-    unfold ageN; induction n; simpl; intros.
-    injection H; intros; subst; auto.
-    revert H.
-    repeat rewrite rmap_level_eq in *.
-    intros. invSome.
-    specialize (IHn _ _ H2).
-    apply  age_level in H.  rewrite rmap_level_eq in *. lia.
-  Qed.
-
-Lemma NO_identity: identity NO.
-Proof.
-  unfold identity; intros.
-  inv H; auto.
-Qed.
-
-Lemma PURE_identity: forall k pds, identity (PURE k pds).
-Proof.
-  unfold identity; intros.
-  inv H; auto.
-Qed.
-
-Lemma identity_NO:
-  forall r, identity  r -> r = NO \/ exists k, exists pds, r = PURE k pds.
-Proof.
-  destruct r; auto; intros.
-  left. symmetry; apply H.
-  apply res_join_NO2.
-  right. exists k. exists p. trivial.
-Qed.
-
-Lemma age1_resource_at_identity:
-  forall phi phi' loc, age1 phi = Some phi' ->
-               identity (phi@loc) ->
-               identity (phi'@loc).
-Proof.
-  intros.
-  generalize (identity_NO _ H0); clear H0; intro.
-  unfold resource_at in *.
-  rewrite rmap_age1_eq in *.
-  revert H H0; case_eq (unsquash phi); simpl; intros.
-  destruct n; inv H0.
-  rewrite unsquash_squash.
-  simpl.
-  destruct r. simpl in *.
-  unfold compose; simpl. destruct H1 as [H1 | [k [pds H1]]]; rewrite H1; simpl; auto.
-  apply NO_identity.
-  apply PURE_identity.
-Qed.
-
-Lemma unage1_resource_at_identity:
-  forall phi phi' loc, age1 phi = Some phi' ->
-               identity (phi'@loc) ->
-               identity (phi@loc).
-Proof.
-  intros.
-  generalize (identity_NO _ H0); clear H0; intro.
-  unfold resource_at in *. simpl in H.
-  rewrite rmap_age1_eq in H.
-  revert H H0; case_eq (unsquash phi); simpl; intros.
-  destruct n; inv H0.
-  rewrite unsquash_squash in H1. destruct r. simpl in *.
-  unfold compose in H1; simpl in H1.
-  unfold resource_fmap in H1.
-  destruct (x loc).
-  apply NO_identity.
-  destruct H1 as [H1 | [k' [pds' H1]]]; inv H1.
-  apply PURE_identity.
-Qed.
-
-Lemma necR_resource_at_identity:
-  forall phi phi' loc, necR phi phi' ->
-         identity (phi@loc) ->
-         identity (phi'@loc).
-Proof.
-  induction 1; auto.
-  intro; eapply age1_resource_at_identity; eauto.
-Qed.
-
-Lemma make_rmap': forall f, AV.valid (fun l => res_option (f l)) ->
-          exists phi: rmap', proj1_sig phi = f.
-Proof.
-  intros.
-  unfold rmap'.
-  exists (exist valid f H).
-  auto.
-Qed.
-
-
-Lemma make_rmap (f: AV.address -> resource) (V: AV.valid (res_option oo f))
-    (n: nat) (H: resource_fmap (approx n) oo f = f) :
-  {phi: rmap | level phi = n /\ resource_at phi = f}.
-Proof.
-intros.
-apply (exist _ (squash (n, @exist (AV.address -> resource) R.valid f V))).
-simpl level; rewrite rmap_level_eq in *; unfold resource_at. rewrite unsquash_squash.
-simpl; auto.
-Qed.
-
-Lemma make_rmap'':
-    forall n (f: AV.address -> resource) ,
-      AV.valid (fun l => res_option (f l)) ->
-      exists phi:rmap, level phi = n /\ resource_at phi = resource_fmap (approx n) oo f.
-  Proof.
-    intros.
-    exists (squash (n, exist valid f H)).
-    rewrite rmap_level_eq.
-      unfold resource_at; rewrite unsquash_squash; simpl; split; auto.
-Qed.
-
-(*
-Lemma make_simple_rmap:
-    forall n (f: AV.address -> resource) ,
-      AV.valid (fun l => res_option (f l)) ->
-      (forall l, match f l with YES _ _ (SomeP _ _) => False | _ => True end) ->
-      exists phi:rmap, level phi = n /\ resource_at phi = f.
-Proof.
-  intros; destruct (make_rmap'' n f H) as [phi [? ?]]; exists phi; split; auto.
-  rewrite H2.
-  extensionality l; unfold compose; simpl;  generalize (H0 l); destruct (f l); auto.
-  destruct p0; intros; try contradiction.
-Qed.
-*)
-
-Lemma approx_oo_approx':
-  forall n n', (n' >= n)%nat -> approx n oo approx n' = approx n.
-Proof.
-unfold compose; intros.
-extensionality P.
- apply pred_ext; intros w ?; unfold approx; simpl in *; intuition.
-Qed.
-
-Lemma approx_oo_approx: forall n, approx n oo approx n = approx n.
-Proof.
-intros; apply approx_oo_approx'; lia.
-Qed.
-
-Lemma approx_approx' n n' x :
-  (n' >= n)%nat -> approx n (approx n' x) = approx n x.
-Proof.
-  intro H.
-  change ((approx n oo approx n') x = approx n x).
-  apply equal_f, approx_oo_approx', H.
-Qed.
-
-Lemma resources_same_level:
-   forall f phi,
-     (forall l : AV.address, join_sub (f l) (phi @ l)) ->
-        resource_fmap (approx (level phi)) oo f = f.
-Proof.
-  intros.
-  rewrite rmap_level_eq.
-  unfold resource_fmap, resource_at in *.
-  unfold compose; extensionality l. spec H l.
-  destruct H as [g ?].
-  revert H; case_eq (unsquash phi); intros n ? ?.
-  generalize H; rewrite <- (squash_unsquash phi).
-  rewrite H. rewrite unsquash_squash.
-  simpl; intros.
-  injection H0. clear H0. intro.
-  clear phi H.
-  rewrite <- H0 in H1.
-  clear H0.
-  unfold rmap_fmap in *.
-  destruct r.
-  simpl in *.
-  revert H1.
-  unfold resource_fmap, compose.
-  destruct (f l); destruct g; destruct (x l); simpl; intro; auto; inv H1.
-  change (preds_fmap (approx n) (preds_fmap (approx n) p2))
-  with ((preds_fmap (approx n) oo preds_fmap (approx n)) p2).
-  rewrite preds_fmap_comp.
-  rewrite approx_oo_approx; auto.
-  change (preds_fmap (approx n) (preds_fmap (approx n) p4))
-  with ((preds_fmap (approx n) oo preds_fmap (approx n)) p4).
-  rewrite preds_fmap_comp.
-  rewrite approx_oo_approx; auto.
-  change (preds_fmap (approx n) (preds_fmap (approx n) p1))
-  with ((preds_fmap (approx n) oo preds_fmap (approx n)) p1).
-  rewrite preds_fmap_comp.
-  rewrite approx_oo_approx; auto.
-Qed.
-
-Lemma deallocate:
-  forall (phi: rmap) (f g : AV.address -> resource),
-  AV.valid (res_option oo f) -> AV.valid (res_option oo g) ->
-  (forall l, join  (f l) (g l) (phi@l)) ->
-   exists phi1, exists phi2,
-     join phi1 phi2 phi /\ resource_at phi1 = f.
-Proof.
-  intros until g. intros Hf Hg H0.
-  generalize (resources_same_level f phi); intro.
-  spec H. intro; econstructor; apply H0.
-  generalize (resources_same_level g phi); intro.
-  spec H1.
-  intro. econstructor; eapply join_comm; eauto.
-  generalize (make_rmap'' (level phi) f Hf); intros [phif [? Gf]].
-  generalize (make_rmap'' (level phi) g Hg); intros [phig [? Gg]].
-  exists phif; exists phig.
-  split.
-  rewrite rmap_level_eq in *.
-  unfold resource_at in *.
-  revert H0 H Gf H1 Gg H2 H3;
-  case_eq (unsquash phif); intros nf phif' ?.
-  case_eq (unsquash phig); intros ng phig' ?.
-  case_eq (unsquash phi); intros n phi' ?.
-  simpl.
-  intros; subst nf ng.
-  rewrite join_unsquash.
-  rewrite H; rewrite H0; rewrite H1.
-  rewrite <- H1.
-  revert H1; case_eq (unsquash phi); intros n' phi'' ?.
-  intros.
-  inversion H5.
-  simpl.
-  split.
-  simpl; constructor; auto.
-  subst n' phi''.
-  intro l; spec H2 l.
-  simpl.
-  rewrite Gf; rewrite Gg; clear Gf Gg.
-  rewrite H3; rewrite H4.
-  auto.
-  rewrite Gf.
-  auto.
-Qed.
-
-Lemma allocate:
-     forall (phi : rmap) (f : AV.address -> resource),
-     AV.valid (res_option oo f) ->
-        resource_fmap (approx (level phi)) oo f = f ->
-       (forall l, {r' | join (phi@l) (f l) r'}) ->
-       exists phi1 : rmap,
-         exists phi2 : rmap,
-           join phi phi1 phi2 /\ resource_at phi1 = f.
-Proof.
- intros. rename X into H1.
- generalize (make_rmap'' (level phi) f H); intros [phif [? Gf]].
- pose (g loc := proj1_sig (H1 loc)).
- assert (H3: forall l, join (phi @ l) (f l) (g l))
-   by (unfold g; intro; destruct (H1 l); simpl in *; auto).
- clearbody g.
- generalize (make_rmap'' (level phi) g); intro.
- spec H4.
-   assert (AV.valid (fun l => res_option (phi @ l))).
-     clear.
-     unfold resource_at.
-     case_eq (unsquash phi); intros.
-     simpl.
-     destruct r. simpl.
-     apply v.
-   eapply AV.valid_join. 2: apply H5. 2: apply H.
-   clear - H3.
-   intro l; spec H3 l.
-   destruct (phi @ l); simpl in *.
-   apply join_unit1_e in H3. unfold compose. rewrite H3. constructor. apply NO_identity.
-   unfold compose at 1. unfold res_option.
-   destruct (f l). apply join_unit2_e in H3; [ | apply NO_identity]. rewrite <- H3. constructor.
-   destruct (g l). inv H3. inv H3.
-   constructor; split; auto.
-   inv H3. inv H3. inv H3. unfold compose, res_option. rewrite <- H. constructor.
- destruct H4 as [phig [? ?]].
- exists phif; exists phig.
- split.
- 2: congruence.
- rewrite join_unsquash.
- unfold resource_at in *.
- rewrite rmap_level_eq in *.
- revert H0 H1 H2 H3 H4 H5 Gf.
- case_eq (unsquash phif); intros nf phif' ?.
- case_eq (unsquash phig); intros ng phig' ?.
- case_eq (unsquash phi); intros n phi' ?.
- simpl.
- intros; subst nf ng.
- split. split; trivial.
- simpl.
- intro l.
- spec H6 l.
- assert (proj1_sig phig' l = g l).
-   generalize (f_equal squash H2); intro.
-   rewrite squash_unsquash in H5.
-   subst phi.
-   rewrite unsquash_squash in H2.
-   injection H2; clear H2; intro.
-   rewrite <- H2 in H6.
-   rewrite <- H3 in H6.
-   rewrite H8.
-   clear - H6.
-   revert H6.
-   unfold rmap_fmap, compose, resource_fmap.
-   destruct phi'; simpl.
-   destruct (x l); destruct (f l); destruct (g l); simpl; intros; auto; try inv H6;
-              try change (preds_fmap (approx n) (preds_fmap (approx n) p0)) with
-                ((preds_fmap (approx n) oo preds_fmap (approx n)) p0);
-              try change (preds_fmap (approx n) (preds_fmap (approx n) p)) with
-                ((preds_fmap (approx n) oo preds_fmap (approx n)) p);
-                rewrite preds_fmap_comp; rewrite approx_oo_approx; auto.
- rewrite H5.
- rewrite Gf.
- rewrite H3.
- auto.
-Qed.
-
-  Lemma unsquash_inj : forall x y,
-      unsquash x = unsquash y -> x = y.
-  Proof.
-    intros.
-    rewrite <- (squash_unsquash x).
-    rewrite <- (squash_unsquash y).
-    rewrite H; auto.
-  Qed.
-
-  Lemma rmap_ext: forall phi1 phi2,
-    level phi1 = level phi2 ->
-    (forall l, phi1@l = phi2@l) ->
-    phi1=phi2.
-  Proof.
-    intros.
-    apply unsquash_inj.
-    rewrite rmap_level_eq in *.
-    unfold resource_at in *.
-    rewrite <- (squash_unsquash phi1).
-    rewrite <- (squash_unsquash phi2).
-    destruct (unsquash phi1).
-    destruct (unsquash phi2).
-    simpl in H.
-    rewrite H.
-    rewrite unsquash_squash.
-    rewrite unsquash_squash.
-    simpl in H0.
-    replace (rmap_fmap (approx n0) r) with (rmap_fmap (approx n0) r0); auto.
-    destruct r; destruct r0.
-    simpl in *.
-    generalize (valid_res_map (approx n0) x0 v0).
-    generalize (valid_res_map (approx n0) x v).
-    replace (resource_fmap (approx n0) oo x0)
-      with (resource_fmap (approx n0) oo x).
-    intros v1 v2; replace v2 with v1 by apply proof_irr; auto.
-    extensionality l.
-    unfold compose.
-    spec H0 l.
-    subst n0.
-    rewrite H0; auto.
-  Qed.
-
-  Lemma resource_at_join:
-    forall phi1 phi2 phi3 loc,
-      join phi1 phi2 phi3 ->
-      join (phi1@loc) (phi2@loc) (phi3@loc).
-  Proof.
-    intros.
-    revert H; rewrite join_unsquash; unfold resource_at.
-    intros [? ?].
-    apply H0.
-  Qed.
-
-  Lemma resource_at_join2:
-    forall phi1 phi2 phi3,
-      level phi1 = level phi3 -> level phi2 = level phi3 ->
-      (forall loc, join (phi1@loc) (phi2@loc) (phi3@loc)) ->
-      join phi1 phi2 phi3.
-  Proof.
-    intros ? ? ?.
-    rewrite join_unsquash.
-    rewrite rmap_level_eq in *.
-    unfold resource_at.
-    case_eq (unsquash phi1); case_eq (unsquash phi2); case_eq (unsquash phi3); simpl; intros.
-    subst.
-    split; auto.
-  Qed.
-
-Lemma all_resource_at_identity:
-  forall w, (forall l, identity (w@l)) ->
-         identity w.
-Proof.
-  intros.
-  rewrite identity_unit_equiv.
-  apply join_unsquash.
-  split. split; auto.
-  revert H. unfold resource_at.
-  case_eq (unsquash w); simpl; intros.
-  intro a. spec H0 a.
-  rewrite identity_unit_equiv in H0.
-  trivial.
-Qed.
-
-  Lemma ageN_squash : forall d n rm, le d n ->
-    ageN d (squash (n, rm)) = Some (squash ((n - d)%nat, rm)).
-  Proof.
-    induction d; simpl; intros.
-    unfold ageN; simpl.
-    replace (n-0)%nat with n by lia; auto.
-    unfold ageN; simpl.
-    rewrite rmap_age1_eq in *.
-    rewrite unsquash_squash.
-    destruct n.
-    inv H.
-    replace (S n - S d)%nat with (n - d)%nat by lia.
-    unfold ageN in IHd. rewrite rmap_age1_eq in IHd.
-    rewrite IHd.
-    2: lia.
-    replace (squash ((n - d)%nat, rmap_fmap (approx (S n)) rm))
-       with (squash ((n - d)%nat, rm)); auto.
-    apply unsquash_inj.
-    rewrite unsquash_squash.
-    rewrite unsquash_squash.
-    replace (rmap_fmap (approx (n - d)) rm)
-       with (rmap_fmap (approx (n - d) oo approx (S n)) rm); auto.
-    rewrite <- rmap_fmap_comp.
-    unfold compose; auto.
-    replace (approx (n-d) oo approx (S n)) with (approx (n-d)).
-    auto.
-    clear.
-    assert (n-d <= (S n))%nat by lia.
-    revert H; generalize (n-d)%nat (S n).
-    clear.
-    intros.
-    extensionality p.
-    apply pred_ext'.  extensionality w.
-    unfold compose, approx.
-    apply prop_ext; simpl; intuition.
-  Qed.
-
-  Lemma unageN: forall n (phi': rmap),   exists phi, ageN n phi = Some phi'.
-  Proof.
-    intros n phi'.
-    rewrite <- (squash_unsquash phi').
-    destruct (unsquash phi'); clear phi'.
-    exists (squash ((n+n0)%nat,r)).
-    rewrite ageN_squash.
-    replace (n + n0 - n)%nat with n0 by lia; auto.
-    lia.
-  Qed.
-
-
-Lemma YES_join_full:
-   forall n P r2 r3,
-       join (R.YES pfullshare n P) r2 r3 ->
-       r2 = NO.
-Proof.
-  intros.
-  simpl in H.
-  inv H. trivial.
-  pfullshare_join.
-Qed.
-
-Lemma YES_not_identity:
-  forall sh k Q, ~ identity (YES sh k Q).
-Proof.
-intros. intro.
-rewrite identity_unit_equiv in H.
-simpl in * |-.
-unfold unit_for in H.
-inv H.
-apply no_units in H1; auto.
-Qed.
-
-Lemma YES_overlap:
-forall (phi0 phi1: rmap) loc (sh : pshare) k k' p p',
-  joins phi0 phi1 -> phi1@loc = R.YES pfullshare k p ->
-               phi0@loc = R.YES sh k' p' -> False.
-Proof.
-  intros.
-  destruct H as [phi3 ?].
-  generalize (resource_at_join _ _ _ loc H); intro.
-  rewrite H1 in H2.
-  rewrite H0 in H2.
-  contradiction (YES_not_identity sh k' p').
-  apply join_comm in H2. apply YES_join_full in H2. discriminate.
-Qed.
-
-Lemma necR_NOx:
-   forall phi phi' l, necR phi phi' -> phi@l = NO -> phi'@l = NO.
-Proof.
-induction 1; eauto.
-unfold age in H; simpl in H.
-revert H; rewrite rmap_age1_eq; unfold resource_at.
-destruct (unsquash x).
-intros; destruct n; inv H.
-rewrite unsquash_squash; simpl in *; auto.
-destruct r; simpl in *.
-unfold compose.
-rewrite H0.
-auto.
-Qed.
-
-Ltac do_map_arg :=
-match goal with |- ?a = ?b =>
-  match a with context [map ?x _] =>
-    match b with context [map ?y _] => replace y with x; auto end end end.
-
-Lemma preds_fmap_fmap:
-  forall f g pp, preds_fmap f (preds_fmap g pp) = preds_fmap (f oo g) pp.
-Proof.
-destruct pp; simpl; auto.
-Qed.
-
-Lemma resource_fmap_fmap:  forall f g r, resource_fmap f (resource_fmap g r) =
-                                                                      resource_fmap (f oo g) r.
-Proof.
-destruct r; simpl; auto.
-rewrite preds_fmap_fmap; auto.
-rewrite preds_fmap_fmap; auto.
-Qed.
-
-Lemma resource_at_approx:
-  forall phi l,
-      phi @ l = resource_fmap (approx (level phi)) (phi @ l).
-Proof.
-intros. rewrite rmap_level_eq. unfold resource_at.
-case_eq (unsquash phi); intros.
-simpl.
-destruct r; simpl in *.
-assert (R.valid (resource_fmap (approx n) oo x)).
-apply valid_res_map; auto.
-set (phi' := (squash (n, exist (fun m : AV.address -> resource => R.valid m) _ H0))).
-generalize (unsquash_inj phi phi'); intro.
-spec H1.
-replace (unsquash phi) with (unsquash (squash (unsquash phi))).
-2: rewrite squash_unsquash; auto.
-rewrite H.
-unfold phi'.
-repeat rewrite unsquash_squash.
-simpl.
-replace (exist (fun m : AV.address -> resource => valid m)
-  (resource_fmap (approx n) oo x) (valid_res_map (approx n) x v)) with
-(exist (fun m : AV.address -> resource => valid m)
-  (resource_fmap (approx n) oo resource_fmap (approx n) oo x)
-  (valid_res_map (approx n) (resource_fmap (approx n) oo x) H0)); auto.
-assert (Hex: forall A (F: A -> Prop) (x x': A) y y', x=x' -> exist F x y = exist F x' y') by auto with extensionality.
-apply Hex.
-unfold compose.
-extensionality y.
-rewrite resource_fmap_fmap.
-rewrite approx_oo_approx; auto.
-unfold phi' in *; clear phi'.
-subst.
-rewrite unsquash_squash in H.
-injection H; clear H; intro.
-pattern x at 1; rewrite <- H.
-unfold compose.
-rewrite resource_fmap_fmap.
-rewrite approx_oo_approx; auto.
-Qed.
-
-Lemma necR_resource_at:
-  forall phi phi' loc r,
-        necR phi phi' ->
-         phi @ loc = resource_fmap (approx (level phi)) r ->
-         phi' @ loc = resource_fmap (approx (level phi')) r.
-Proof.
-intros.
-revert r loc H0; induction H; intros; auto.
-unfold age in H.
-simpl in H.
-revert H H0; rewrite rmap_level_eq, rmap_age1_eq; unfold resource_at.
- case_eq (unsquash x); intros.
-destruct n; inv H0.
-simpl in *.
-rewrite unsquash_squash; simpl.
-destruct r0; simpl in *.
-unfold compose in *.
-rewrite H1; clear H1.
-rewrite resource_fmap_fmap.
-rewrite approx_oo_approx'; auto.
-Qed.
-
-Lemma necR_YES:
-  forall phi phi' loc sh k pp,
-        necR phi phi' ->
-         phi @ loc = YES sh k pp ->
-         phi' @ loc = YES sh k (preds_fmap (approx (level phi')) pp).
-Proof.
-intros.
-generalize (resource_at_approx phi loc);
-pattern (phi @ loc) at 2; rewrite H0; intro.
-apply (necR_resource_at _ _ _ _ H H1).
-Qed.
-
-Lemma necR_PURE:
-  forall phi phi' loc k pp,
-        necR phi phi' ->
-         phi @ loc = PURE k pp ->
-         phi' @ loc = PURE k (preds_fmap (approx (level phi')) pp).
-Proof.
-  intros.
-  generalize (resource_at_approx phi loc);
-  pattern (phi @ loc) at 2; rewrite H0; intro.
-  apply (necR_resource_at _ _ _ _ H H1).
-Qed.
-
-Lemma necR_NO:
-   forall phi phi' l, necR phi phi' ->
-   (phi@l = NO <-> phi'@l = NO).
-Proof.
-  intros; split.
-  apply necR_NOx; auto.
-  intros.
-  case_eq (phi @ l); intros; auto.
-  destruct p0.
-  generalize (necR_YES _ _ _ _ _ _ H H1); rewrite H0; congruence.
-  generalize (necR_PURE _ _ _ _ _ H H1); rewrite H0; congruence.
-Qed.
-
-Lemma resource_at_empty: forall phi, identity phi -> forall l, (phi @ l = NO \/ exists k, exists pds, phi @ l = PURE k pds).
-Proof.
-  intros.
-  rewrite identity_unit_equiv in H.
-  unfold unit_for in H.
-  generalize (resource_at_join _ _ _ l H); intro.
-  remember (phi @ l) as r.
-  destruct r; inv H0; auto.
-  apply no_units in H2; contradiction.
-  right. exists k. exists p. trivial.
-Qed.
-Implicit Arguments resource_at_empty.
-
-
-Lemma rmap_valid: forall r, AV.valid (res_option oo resource_at r).
-Proof.
-unfold compose, resource_at; intros.
-destruct (unsquash r).
-destruct r0.
-simpl.
-apply v.
-Qed.
-
-Ltac inj_pair_tac :=
- match goal with H: (@existT ?U ?P ?p ?x = @existT _ _ _ ?y) |- _ =>
-   generalize (@inj_pair2 U P p x y H); clear H; intro; try (subst x || subst y)
- end.
-
-Lemma preds_fmap_NoneP:
-  forall f, preds_fmap f NoneP = NoneP.
-Proof.
-intros.
-unfold NoneP.
-simpl.
-f_equal. extensionality x; destruct  x.
-destruct v.
-Qed.
-
-Lemma necR_YES':
-   forall phi phi' loc sh k,
-         necR phi phi' -> (phi@loc = YES sh k NoneP <-> phi'@loc = YES sh k NoneP).
-Proof.
-intros.
-induction H.
-rename x into phi; rename y into phi'.
-unfold age in H; simpl in H.
-(* revert H; case_eq (age1 phi); intros; try discriminate. *)
-inv H.
-split; intros.
-rewrite (necR_YES phi phi' loc sh k NoneP); auto; [ | constructor 1; auto].
-f_equal.
-apply preds_fmap_NoneP.
-rewrite rmap_age1_eq in *.
-unfold resource_at in *.
-revert H1; case_eq (unsquash phi); simpl; intros.
-destruct n; inv H1.
-rewrite unsquash_squash in H. simpl in H. destruct r; simpl in *.
-unfold compose in H.
-revert H; destruct (x loc); simpl; intros; auto.
-destruct p0; inv H.
-inj_pair_tac. f_equal.
-unfold NoneP; f_equal.
-extensionality x'; destruct x'.
-destruct v0.
-inv H.
-intuition.
-intuition.
-Qed.
-
-Lemma necR_YES'':
-   forall phi phi' loc sh k,
-         necR phi phi' ->
-    ((exists pp, phi@loc = YES sh k pp) <->
-    (exists pp, phi'@loc = YES sh k pp)).
-Proof.
-intros.
-induction H; try solve [intuition].
-rename x into phi; rename y into phi'.
-revert H; unfold age; case_eq (age1 phi); intros; try discriminate.
-inv H0.
-simpl in *.
-split; intros [pp ?].
-econstructor;
-apply (necR_YES phi phi' loc sh k pp).
-constructor 1; auto. auto.
-rename phi' into r.
-rewrite rmap_age1_eq in *.
-unfold resource_at in *.
-revert H; case_eq (unsquash phi); simpl; intros.
-destruct n; inv H1.
-rewrite unsquash_squash in H0. simpl in H0. destruct r0; simpl in *.
-unfold compose in H0.
-revert H0; destruct (x loc); simpl; intros; auto.
-inv H0.
-inv H0.
-econstructor; eauto.
-inv H0.
-Qed.
-
-Lemma resource_at_join_sub:
-  forall phi1 phi2 l,
-       join_sub phi1 phi2 -> join_sub (phi1@l) (phi2@l).
-Proof.
-intros.
-destruct H as [phi ?].
-generalize (resource_at_join _ _ _ l H); intro.
-econstructor; eauto.
-Qed.
-
-Lemma age1_res_option: forall phi phi' loc,
-     age1 phi = Some phi' -> res_option (phi @ loc) = res_option (phi' @ loc).
-  Proof.
-    unfold res_option, resource_at; simpl.
-   rewrite rmap_age1_eq; intros phi1 phi2 l.
- case_eq (unsquash phi1); intros. destruct n; inv H0.
- rewrite unsquash_squash.
-   destruct r;
-    simpl.
-   unfold compose. destruct (x l); simpl; auto.
-Qed.
-
-Lemma necR_res_option:
-  forall (phi phi' : rmap) (loc : AV.address),
-  necR phi phi' -> res_option (phi @ loc) = res_option (phi' @ loc).
-Proof.
-  intros.
-  case_eq (phi @ loc); intros.
-  rewrite (necR_NO _ _ _ H) in H0. congruence.
-  destruct p0.
-  rewrite (necR_YES phi phi' loc _ _ _ H H0); auto.
-  rewrite (necR_PURE phi phi' loc _ _ H H0); auto.
-Qed.
-
-
-Lemma age1_resource_at:
-     forall phi phi',
-          age1 phi = Some phi' ->
-         forall loc r,
-          phi @ loc = resource_fmap (approx (level phi)) r ->
-          phi' @ loc = resource_fmap (approx (level phi')) r.
-Proof.
-   unfold resource_at; rewrite rmap_age1_eq, rmap_level_eq.
-intros until phi'; case_eq (unsquash phi); intros.
-simpl in *.
-destruct n; inv H0.
-rewrite unsquash_squash.
-destruct r; simpl in *.
-unfold compose; rewrite H1.
-rewrite resource_fmap_fmap.
-rewrite approx_oo_approx'; auto.
-Qed.
-
-
-Lemma age1_YES: forall phi phi' l sh k ,
-  age1 phi = Some phi' -> (phi @ l = YES sh k NoneP <-> phi' @ l = YES sh k NoneP).
-Proof.
-intros.
-apply necR_YES'.
-constructor 1; auto.
-Qed.
-
-Lemma empty_NO: forall r, identity r -> r = NO \/ exists k, exists pds, r = PURE k pds.
-Proof.
-intros.
-destruct r; auto.
-unfold identity in H.
-spec H NO (YES p k p0).
-spec H.
-apply res_join_NO2.
-auto.
-right. exists k. exists p. trivial.
-Qed.
-
-Lemma YES_join_full':
-  forall loc k P m1 m2 m3, join m1 m2 m3 -> m1@loc = YES pfullshare k P ->
-                   m3 @ loc = YES pfullshare k P.
-Proof.
-  intros.
-  generalize (resource_at_join _ _ _ loc H); rewrite H0; intro.
-  generalize (YES_join_full _ _ _ _ H1); intro. rewrite H2 in H1.
-  inv H1.
-  trivial.
-Qed.
-
-
-Lemma level_age_fash:
-  forall m m': rmap, level m = S (level m') -> exists m1, age m m1. (* /\ comparable m1 m'. *)
-Proof.
-  intros.
-  case_eq (age1 m); intros.
-  exists r. auto.
-  exfalso.
-  eapply age1None_levelS_absurd in H0; eauto.
-Qed.
-
-Lemma level_later_fash:
- forall m m': rmap, (level m > level m')%nat  -> exists m1, laterR m m1 /\ level m1 = level m'.
-Proof.
-  intros.
-  assert (exists k, level m = S k + level m')%nat.
-    exists (level m - S (level m'))%nat.
-    lia.
-  clear H; destruct H0 as [k ?].
-  revert m H; induction k; intros.
-  simpl in H.
-  destruct (level_age_fash _ _ H) as [m1 ?].
-  exists m1; split; auto.
-  constructor 1; auto.
-  apply age_level in H0. rewrite H in H0. inv H0. trivial.
-  case_eq (age1 m); intros.
-  spec IHk r.
-  rewrite <- ageN1 in H0.
-  generalize (ageN_level _ _ _ H0); intro.
-  spec IHk; try lia.
-  destruct IHk as [m1 [? ?]].
-  exists m1; split; auto.
-  econstructor 2; eauto.
-  rewrite ageN1 in H0.
-  constructor 1.
-  auto.
-  exfalso.
-  eapply age1None_levelS_absurd in H0; eauto.
-Qed.
-
-Lemma resource_at_constructive_joins2:
-  forall phi1 phi2,
-       level phi1 = level phi2 ->
-       (forall loc, constructive_joins (phi1 @ loc) (phi2 @ loc)) ->
-         constructive_joins phi1 phi2.
-Proof.
-intros ? ? ? H0.
-assert (AV.valid (res_option oo (fun loc => proj1_sig (H0 loc)))).
-apply AV.valid_join with (res_option oo (resource_at phi1)) (res_option oo (resource_at phi2));
- try apply rmap_valid.
-intro l.
-unfold compose in *.
-destruct (H0 l); simpl in *.
-destruct (phi1 @ l). inv j; constructor.
-inv j; constructor. split; auto.
-inv j; constructor.
-(** End of CompCert_AV.valid proof **)
-destruct (make_rmap _ H1 (level phi1)) as [phi' [? ?]].
-clear H1.
-unfold compose; extensionality loc.
-spec H0 loc.
-destruct H0 as [? H1].
-simpl.
-symmetry.
-revert H1; case_eq (phi1 @ loc); intros.
-inv H1. reflexivity.
-rewrite H2.
-rewrite H; apply resource_at_approx.
-inv H1. rewrite <- H0. apply resource_at_approx.
-generalize (resource_at_approx phi1 loc); intro.
-rewrite H0 in H1. simpl in H1.
-simpl. f_equal. injection H1; auto.
-inv H1.
-generalize (resource_at_approx phi1 loc); intro.
-rewrite H0 in H1. simpl in H1.
-simpl. f_equal. injection H1; auto.
-(*  End of make_rmap proof *)
-exists phi'.
-apply resource_at_join2; auto.
-congruence.
-intros.
-rewrite H3.
-destruct (H0 loc).
-simpl; auto.
-Qed.
-
-Lemma resource_at_joins2:
-  forall phi1 phi2,
-       level phi1 = level phi2 ->
-       (forall loc, constructive_joins (phi1 @ loc) (phi2 @ loc)) ->
-         joins phi1 phi2.
-Proof.
-  intros.
-  apply cjoins_joins.
-  apply resource_at_constructive_joins2; trivial.
-Qed.
-
-Definition no_preds (r: resource) :=
-   match r with NO => True | YES _ _ pp => pp=NoneP | PURE _ pp => pp=NoneP end.
-
-Lemma remake_rmap:
-  forall (f: AV.address -> resource),
-       AV.valid (res_option oo f) ->
-       forall n,
-       (forall l, (exists m, level m = n /\ f l = m @ l) \/ no_preds (f l)) ->
-       {phi: rmap | level phi = n /\ resource_at phi = f}.
-Proof.
-  intros.
-  apply make_rmap; auto.
-  extensionality l.
-  unfold compose.
-  destruct (H0 l); clear H0.
-  destruct H1 as [m [?  ?]].
-  rewrite H1.
-  subst.
-  symmetry; apply resource_at_approx.
-  destruct (f l); simpl in *; auto;
-  [destruct p0 | destruct p];
-  rewrite H1;
-  apply f_equal;
-  apply preds_fmap_NoneP.
-Qed.
-
-Lemma rmap_unage_age:
-  forall r, age (rmap_unage r) r.
-Proof.
-intros; unfold age, rmap_unage; simpl.
-case_eq (unsquash r); intros.
-rewrite rmap_age1_eq.
-rewrite unsquash_squash.
-f_equal.
-apply unsquash_inj.
-rewrite H.
-rewrite unsquash_squash.
-f_equal.
-generalize (equal_f (rmap_fmap_comp (approx (S n)) (approx n)) r0); intro.
-unfold compose at 1 in H0.
-rewrite H0.
-rewrite approx_oo_approx'; auto.
-clear - H.
-generalize (unsquash_squash n r0); intros.
-rewrite <- H in H0.
-rewrite squash_unsquash in H0.
-congruence.
-Qed.
-
-Lemma ageN_resource_at_eq:
-  forall phi1 phi2 loc n phi1' phi2',
-          level phi1 = level phi2 ->
-          phi1 @ loc = phi2 @ loc ->
-         ageN n phi1 = Some phi1' ->
-         ageN n phi2 = Some phi2' ->
-         phi1' @ loc = phi2' @ loc.
-Proof.
-intros ? ? ? ? ? ? Hcomp ? ? ?; revert phi1 phi2 phi1' phi2' Hcomp H H0 H1; induction n; intros.
-inv H0; inv H1; auto.
-unfold ageN in H0, H1.
-simpl in *.
-revert H0 H1; case_eq (age1 phi1); case_eq (age1 phi2); intros; try discriminate.
-assert (level r = level r0) by (apply age_level in H0; apply age_level in H1; lia).
-apply (IHn r0 r); auto.
-rewrite (age1_resource_at _ _ H0 loc _ (resource_at_approx _ _)).
-rewrite (age1_resource_at _ _ H1 loc _ (resource_at_approx _ _)).
-rewrite H. rewrite H4; auto.
-Qed.
-
-Lemma join_YES_pfullshare1:
-    forall pp k p x y, join (YES (mk_lifted Share.top pp) k p) x y -> (NO, YES pfullshare k p) = (x,y).
-Proof.
-intros. inv H; try pfullshare_join; f_equal; auto.
-  f_equal. unfold pfullshare. f_equal. apply proof_irr.
-Qed.
-
-Lemma join_YES_pfullshare2:
-    forall pp k p x y, join x (YES  (mk_lifted Share.top pp) k p) y -> (NO, YES pfullshare k p) = (x,y).
-Proof.
-intros. inv H; try pfullshare_join; f_equal; auto.
-  f_equal. unfold pfullshare. f_equal. apply proof_irr.
-Qed.
-
-Ltac inv H := (apply join_YES_pfullshare1 in H || apply join_YES_pfullshare2 in H || idtac);
-                  (inversion H; clear H; subst).
-
-  Definition empty_rmap' : rmap'.
-    set (f:= fun _: AV.address => NO).
-    assert (R.valid f).
-    red; unfold f; simpl.
-    apply AV.valid_empty.
-    exact (exist _ f H).
-  Defined.
-
-  Definition empty_rmap (n:nat) : rmap := R.squash (n, empty_rmap').
-
-Lemma emp_empty_rmap: forall n, emp (empty_rmap n).
-Proof.
-intros.
-intro; intros.
-apply rmap_ext.
-Comp.
-intros.
-apply (resource_at_join _ _ _ l) in H.
-unfold empty_rmap, empty_rmap', resource_at in *.
-destruct (unsquash a); destruct (unsquash b).
-simpl in *.
-destruct r; destruct r0; simpl in *.
-rewrite unsquash_squash in H.
-simpl in *.
-unfold compose in H.
-inv H; auto.
-Qed.
-
-Lemma empty_rmap_level:
-  forall lev, level (empty_rmap lev) = lev.
-Proof.
-intros.
-simpl.
-rewrite rmap_level_eq.
-unfold  empty_rmap.
-rewrite unsquash_squash; auto.
-Qed.
-
-Lemma approx_FF: forall n, approx n FF = FF.
-Proof.
-intros.
-apply pred_ext; auto.
-unfold approx; intros ? ?.
-hnf in H. destruct H; auto.
-Qed.
-
-Lemma resource_at_make_rmap: forall f V lev H, resource_at (proj1_sig (make_rmap f V lev H)) = f.
-refine (fun f V lev H => match proj2_sig (make_rmap f V lev H) with
-                           | conj _ RESOURCE_AT => RESOURCE_AT
-                         end).
-Qed.
-
-Lemma level_make_rmap: forall f V lev H, @level rmap _ (proj1_sig (make_rmap f V lev H)) = lev.
-refine (fun f V lev H => match proj2_sig (make_rmap f V lev H) with
-                           | conj LEVEL _ => LEVEL
-                         end).
-Qed.
-
-#[global] Instance Join_trace : Join (AV.address -> option (pshare * AV.kind)) :=
-     (Join_fun AV.address (option (pshare * AV.kind))
-                   (Join_lower (Join_prod pshare Join_pshare AV.kind (Join_equiv AV.kind)))).
-
-
- Lemma res_option_join:
-    forall x y z, join x y z -> @join _ (@Join_lower (pshare * AV.kind)
-     (Join_prod pshare Join_pshare AV.kind (Join_equiv AV.kind))) (res_option x) (res_option y) (res_option  z).
- Proof.
-   intros.
-  inv H; constructor.  split; auto.
- Qed.
-
-Definition fixup_trace (trace: AV.address -> option (pshare * AV.kind))
-                                    (f: AV.address -> resource) : AV.address -> resource :=
-   fun x => match trace x, f x with
-                   | None, PURE k pp => PURE k pp
-                   | Some(sh,k), PURE _ pp => YES sh k pp
-                   | Some (sh,k), YES _ _ pp => YES sh k pp
-                   | Some (sh, k), NO => YES sh k NoneP
-                   | None, _ => NO
-                   end.
-
-Lemma fixup_trace_valid: forall tr f, AV.valid tr -> AV.valid (res_option oo (fixup_trace tr f)).
- Proof. intros.
-  replace (res_option oo fixup_trace tr f) with tr. auto.
-  extensionality l. unfold compose. unfold fixup_trace.
-  destruct (tr l); simpl; auto.
-  destruct p. destruct (f l); simpl; auto.
-  destruct (f l); reflexivity.
-Qed.
-
-Lemma fixup_trace_rmap:
-    forall (tr: sig AV.valid) (f: rmap),
-        {phi: rmap | level phi = level f /\ resource_at phi = fixup_trace (proj1_sig tr) (resource_at f)}.
-Proof.
- intros.
- apply make_rmap. apply fixup_trace_valid. destruct tr; simpl; auto.
- extensionality l.
- unfold compose, fixup_trace.
- destruct tr. simpl.
- destruct (x l); simpl; auto. destruct p.
- case_eq (f @ l); intros.
- unfold resource_fmap. rewrite preds_fmap_NoneP; auto.
- generalize (resource_at_approx f l); intro.
- rewrite H in H0. symmetry in H0.
-  simpl in H0. simpl.
-   f_equal. injection H0; auto.
- generalize (resource_at_approx f l); intro.
- rewrite H in H0. symmetry in H0.
-  simpl in H0. simpl.
-   f_equal. injection H0; auto.
- case_eq (f @ l); intros; auto.
- generalize (resource_at_approx f l); intro.
- rewrite H in H0. symmetry in H0.
-  simpl in H0. simpl.
-   f_equal. injection H0; auto.
-Qed.
-
-
-Ltac crtac :=
- repeat  (solve [constructor; auto] ||
-   match goal with
- | H: None = res_option ?A |- _ => destruct A; inv H
- | H: Some _ = res_option ?A |- _ => destruct A; inv H
- | H: join NO _ _ |- _ => inv H
- | H: join _ NO _ |- _ => inv H
- | H: join (YES _ _ _) _ _ |- _ => inv H
- | H: join _ (YES _ _ _) _ |- _ => inv H
- | H: join (PURE _ _) _ _ |- _ => inv H
- | H: join _ (PURE _ _) _ |- _ => inv H
- | H: @join _ _ (Some _) _ _ |- _ => inv H
- | H: @join _ _ _ (Some _) _ |- _ => inv H
- | H: @join _ _ None _ _ |- _ =>
-                apply join_unit1_e in H; [| apply None_identity]
- | H: @join _ _ _ None _ |- _ =>
-                apply join_unit2_e in H; [| apply None_identity]
- | H:  prod pshare AV.kind |- _ => destruct H
- | H: @join _ (Join_equiv _) ?a ?b ?c |- _ => destruct H; try subst a; try subst b; try subst c
- | H: @join _ (Join_prod _ _ _ _) (_,_) (_,_) (_,_) |- _ => destruct H; simpl fst in *; simpl snd in *
- end; auto).
-
-Lemma Cross_resource: Cross_alg resource.
-Proof.
-intro; intros.
-destruct a as [|a|a].
-assert (b=z) by (inv H; auto). subst.
-exists (NO,NO,c,d); split; simpl; auto; try constructor; auto.
-inv H. inv H0; split; constructor. inv H0; split; constructor.
-destruct b as [|b|b].
-assert (z=YES a k p) by (inv H; auto). clear H; subst.
-exists (c,d,NO,NO); split; simpl; auto.
-inv H0; split3; constructor.
-assert (Hz: k0=k /\ p0=p) by (inv H; auto). destruct Hz; subst.
-destruct c as [|c|c].
-assert (z=d) by (inv H0; auto). clear H0; subst.
-exists (NO,(YES a k p),NO,(YES b k p)); simpl; split; auto.
-constructor.
-inv H; split3; constructor; auto.
-destruct d as [|d|d].
-assert (z=YES c k0 p0) by (inv H0; auto). clear H0; subst.
-assert (Hz: k0=k /\ p0=p) by (inv H; auto); destruct Hz; subst.
-exists (YES a k p, NO, YES b k p, NO); simpl; split; auto.
-constructor. inv H; split3; constructor; auto.
-destruct z as [|z|z].  exfalso; inv H0.
-assert (Hx: k=k2 /\ k0=k2 /\ k1=k2 /\ p=p2 /\ p0=p2 /\ p1=p2) by  (inv H0; inv H; auto 50).
-destruct Hx as [? [? [? [? [? ?]]]]]; subst.
-assert (join c d z) by (inv H0; auto).
-assert (join a b z) by (inv H; auto).
-clear H H0.
-destruct (share_cross_split _ _ _ _ _ H2 H1) as [[[[ac ad] bc] bd] [Ha [Hb [Hc Hd]]]].
-destruct (dec_share_identity ac).
-apply i in Ha; apply i in Hc. subst.
-destruct (dec_share_identity bd).
-apply join_comm in Hb; apply join_comm in Hd; apply i0 in Hb; apply i0 in Hd; subst.
-apply lifted_eq in Hb. apply lifted_eq in Hd; subst b d.
-rename k2 into k; rename p2 into p.
-exists (NO, YES a k p, YES c k p, NO); simpl; split; auto. constructor.
-split3; constructor; auto.
-rename k2 into k; rename p2 into p.
-apply nonidentity_nonunit in n.
-exists (NO, YES a k p, YES c k p, YES (mk_lifted _ n) k p); simpl; split; auto.
-constructor. split3; constructor; auto.
-destruct (dec_share_identity ad).
-apply join_comm in Ha; apply i in Ha; apply i in Hd; subst bd ac.
-clear n.
-destruct (dec_share_identity bc).
-apply join_comm in Hc; apply i0 in Hb; apply i0 in Hc.  apply lifted_eq in Hb; apply lifted_eq in Hc; subst d c.
-rename k2 into k; rename p2 into p.
-exists (YES a k p, NO, NO, YES b k p); simpl; split; auto.
-constructor. split3; constructor; auto.
-rename k2 into k; rename p2 into p.
-exists (YES a k p, NO, YES (mk_lifted _ (nonidentity_nonunit n)) k p, YES d k p); simpl; split; auto.
-constructor. split3; constructor; auto.
-destruct (dec_share_identity bc).
-apply join_comm in Hc; apply i in Hb; apply i in Hc.  subst ac bd.
-rename k2 into k; rename p2 into p.
-exists (YES c k p, YES (mk_lifted _ (nonidentity_nonunit n0)) k p, NO, YES b k p); simpl; split; auto.
-constructor. auto. split3; constructor; auto.
-destruct (dec_share_identity bd).
-apply join_comm in Hb; apply join_comm in Hd;
- apply i in Hb; apply i in Hd. subst bc ad.
-rename k2 into k; rename p2 into p.
-exists (YES (mk_lifted _ (nonidentity_nonunit n)) k p,  YES d k p, YES b k p, NO); split; simpl; auto.
-constructor; auto. split3; constructor; auto.
-rename k2 into k; rename p2 into p.
-exists (YES (mk_lifted _ (nonidentity_nonunit n)) k p, YES (mk_lifted _ (nonidentity_nonunit n0)) k p,
-       YES (mk_lifted _ (nonidentity_nonunit n1)) k p,  YES (mk_lifted _ (nonidentity_nonunit n2)) k p); split; simpl; auto.
-constructor; auto.  split3; constructor; auto.
-exfalso; inv H0.
-exfalso; inv H0.
-exfalso; inv H0; inv H.
-exfalso; inv H.
-exists (PURE a p, PURE a p, PURE a p, PURE a p).
-inv H. inv H0.
-repeat split; constructor; auto.
-Qed.
-
-#[global] Instance Cross_rmap:
-      @Cross_alg _ (Join_prop _ Join_trace AV.valid) ->
-      Cross_alg rmap.
-Proof.
-  intro CAV.
-  repeat intro.
-  assert (Hz : valid (resource_at z)).
-  unfold resource_at.
-  case_eq (unsquash z); intros.
-  simpl.
-  destruct r; simpl; auto.
-  specialize (CAV
-          (exist AV.valid _ (rmap_valid a))
-          (exist AV.valid _ (rmap_valid b))
-          (exist AV.valid _ (rmap_valid c))
-          (exist AV.valid _ (rmap_valid d))
-          (exist AV.valid _ Hz)).
-  destruct CAV as [[[[Vac Vad] Vbc] Vbd] [Va [Vb [Vc Vd]]]].
-  intro l.  unfold compose. simpl.
-  apply res_option_join. apply resource_at_join. auto.
-  intro l.  simpl. unfold compose.
-  apply res_option_join. apply resource_at_join. auto.
-  destruct (fixup_trace_rmap Vac z) as [Mac [? ?]].
-  destruct (fixup_trace_rmap Vad z) as [Mad [? ?]].
-  destruct (fixup_trace_rmap Vbc z) as [Mbc [? ?]].
-  destruct (fixup_trace_rmap Vbd z) as [Mbd [? ?]].
-  exists (Mac,Mad,Mbc,Mbd).
-  destruct Vac as [ac ?]; destruct Vad as [ad ?]; destruct Vbc as [bc ?];
-  destruct Vbd as [bd ?]; simpl in *.
-  assert (LEVa: level a = level z) by (apply join_level in H; destruct H; auto).
-  assert (LEVb: level b = level z) by (apply join_level in H; destruct H; auto).
-  assert (LEVc: level c = level z) by (apply join_level in H0; destruct H0; auto).
-  assert (LEVd: level d = level z) by (apply join_level in H0; destruct H0; auto).
-  do 2 red in Va,Vb,Vc,Vd; simpl in *.
-  unfold compose in *. clear Hz.
-  split; [|split3];   apply resource_at_join2; try congruence; intro l;
-  spec Va l; spec Vb l; spec Vc l; spec Vd l;
-  apply (resource_at_join _ _ _ l) in H;
-  apply (resource_at_join _ _ _ l) in H0;
-  try rewrite H2; try rewrite H4; try rewrite H6; try rewrite H8;
-  unfold fixup_trace; simpl in *.
-  forget (a @ l) as al; forget (b @ l) as bl; forget (c @ l ) as cl;
-  forget (d @ l) as dl; forget (z @ l) as zl;
-   clear - Va Vb Vc Vd H H0.
-  (* case 1 *)
-  destruct (ac l); crtac. destruct (ad l); crtac.
-  (* case 2 *)
-  destruct (bc l); crtac. destruct (bd l); crtac.
-  (* case 3 *)
-  destruct (ac l); crtac. destruct (bc l); crtac.
-  (* case 4 *)
-  destruct (ad l); crtac. destruct (bd l); crtac.
-Qed.
-
-Lemma Cross_rmap_simple: (forall f, AV.valid f) -> Cross_alg rmap.
-Proof.
-  intro V.
-   apply Cross_rmap.
-   intros [a Ha] [b Hb] [c Hc] [d Hd] [e He] ? ?.
-   do 2 red in H,H0. simpl in *.
-   assert (Cross_alg (AV.address -> option (pshare * AV.kind))).
-     apply (cross_split_fun  (option (pshare * AV.kind))).
-   eapply (Cross_bij' _ _ _ _ (opposite_bij (option_bij (lift_prod_bij _ _)))).
-   apply Cross_smash; auto with typeclass_instances.
-   clear; intro. destruct x. destruct (dec_share_identity t); [left|right].
-    apply identity_unit_equiv in i. apply identity_unit_equiv. split; auto.
-    contradict n.
-    apply identity_unit_equiv in n. apply identity_unit_equiv. destruct n; auto.
-   clear. extensionality a b c. apply prop_ext.
-   destruct a as [[[? ?] ?] | ]; destruct b  as [[[? ?] ?] | ]; destruct c as [[[? ?] ?] | ];
-   split; simpl; intro H; inv H; simpl in *; try constructor; auto; hnf in  *; simpl in *;
-   try proof_irr; try constructor;
-     destruct H3; constructor; simpl; auto. (* this line for compatibility with Coq 8.3 *)
-   destruct (X a b c d e H H0) as [[[[ac ad] bc] bd] [? [? [? ?]]]].
-   exists (exist AV.valid ac (V _), exist AV.valid ad (V _),
-              exist AV.valid bc (V _), exist AV.valid bd (V _)).
-   split; [ |split3]; simpl; auto.
-Qed.
-
-Lemma identity_resource: forall r: resource, identity r <->
-    match r with YES _ _ _ => False | _ => True end.
-Proof.
- intros. destruct r; intuition.
- apply NO_identity.
- specialize (H NO (YES p k p0)).
- spec H. constructor. inv H.
- intros  ? ? ?. inv H0. auto.
-Qed.
-
-Lemma resource_at_core_identity:  forall m i, identity (core m @ i).
-Proof.
-  intros.
-  generalize (core_duplicable m); intro Hdup. apply (resource_at_join _ _ _ i) in Hdup.
-  apply identity_resource.
-  case_eq (core m @ i); intros; auto.
-  rewrite H in Hdup. inv Hdup.
-   apply pshare_nonunit in H1. auto.
-Qed.
-
-Lemma YES_inj: forall sh k pp sh' k' pp',
-           YES sh k pp = YES sh' k' pp' ->
-          sh=sh' /\ k=k' /\ pp=pp'.
-Proof. intros. inv H. auto. Qed.
-
-Lemma SomeP_inj1: forall t t' a a', SomeP t a = SomeP t' a' -> t=t'.
-  Proof. intros. inv H; auto. Qed.
-Lemma SomeP_inj2: forall t a a', SomeP t a = SomeP t a' -> a=a'.
-  Proof. intros. inv H. apply inj_pair2 in H1. auto. Qed.
-Lemma SomeP_inj:
-   forall T a b, SomeP T a = SomeP T b -> a=b.
-Proof. intros. inv H. apply inj_pair2 in H1. auto.
-Qed.
-
-Lemma PURE_inj: forall T x x' y y', PURE x (SomeP T y) = PURE x' (SomeP T y') -> x=x' /\ y=y'.
- Proof. intros. inv H. apply inj_pair2 in H2. subst; auto.
- Qed.
-
-Lemma core_resource_at: forall w i, core (w @ i) = core w @ i.
-Proof.
- intros.
- generalize (core_unit w); intros.
- apply (resource_at_join _ _ _ i) in H.
- generalize (core_unit (w @ i)); unfold unit_for; intros.
- eapply join_canc; eauto.
-Qed.
-
-End Rmaps_Lemmas.
diff --git a/msl/sepalg_functors.v b/msl/sepalg_functors.v
deleted file mode 100644
index 105c9ca71d..0000000000
--- a/msl/sepalg_functors.v
+++ /dev/null
@@ -1,300 +0,0 @@
-(*
- * Copyright (c) 2009-2011, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-
-Require Import VST.msl.base.
-Require Import VST.msl.functors.
-Require Import VST.msl.sepalg.
-Require Import VST.msl.sepalg_generators.
-
-Set Implicit Arguments.
-
-Import MixVariantFunctor.
-Import MixVariantFunctorLemmas.
-Import MixVariantFunctorGenerator.
-
-(* Parameterized separating structures, useful for knot_prop_sa and
-    maybe for the general sa_knot. *)
-
-Section unmaps.
-  Variables (A: Type)(J_A: Join A).
-  Variables (B: Type)(J_B: Join B).
-
-  Definition unmap_left (f:A -> B) :=
-    forall x' y z,
-      join x' (f y) (f z) ->
-      { x:A & { y0:A | join x y0 z /\ f x = x' /\ f y0 = f y }}.
-
-  Definition unmap_right (f:A -> B) :=
-    forall x y z',
-      join (f x) (f y) z' ->
-      { y0: A & { z:A | join x y0 z /\ f y0 = f y /\ f z = z' }}.
-End unmaps.
-(*
-Implicit Arguments unmap_right.
-Implicit Arguments unmap_left.
-*)
-
-(*
-Definition Join_paf (F: functor): Type :=
-  forall A, Join (F A).
-Definition Perm_paf {F: functor} (paf_join: forall A, Join (F A)): Type :=
-  forall A: Type, Perm_alg (F A).
-Definition Sep_paf {F: functor} (paf_join: forall A, Join (F A)): Type :=
-  forall A: Type, Sep_alg (F A).
-Definition Canc_paf {F: functor} (paf_join: forall A, Join (F A)): Type :=
-  forall A: Type, Canc_alg (F A).
-Definition Disj_paf {F: functor} (paf_join: forall A, Join (F A)): Type :=
-  forall A: Type, Disj_alg (F A).
-*)
-
-(* TODO: change pafunctor, unmap_left, unmap_right into prop *)
-Record pafunctor (F: functor) (paf_join: forall A, Join (F A)): Type := Pafunctor
-{
-  paf_join_hom : forall A B (f : A -> B) (g: B -> A), join_hom (fmap F f g);
-  paf_preserves_unmap_left : forall A B (f : A -> B) (g: B -> A),
-    unmap_left (paf_join A) (paf_join B) (fmap F f g);
-  paf_preserves_unmap_right : forall A B (f : A -> B) (g: B -> A),
-    unmap_right (paf_join A) (paf_join B) (fmap F f g)
-}.
-
-(* GENERATORS *)
-
-Section ConstPAFunctor.
-
-  Variables (T : Type)(J_T: Join T).
-
-  Lemma paf_const : pafunctor (fconst T) (fun _ => J_T).
-    constructor; intros; hnf; intros.
-    + auto.
-    + exists x'. exists y. auto.
-    + exists y. exists z'. auto.
-  Qed.
-End ConstPAFunctor.
-
-Section EquivPAFunctor.
-  Variables (F : functor).
-
-  Lemma paf_equiv : @pafunctor F (fun A => @Join_equiv (F A)).
-  Proof with auto.
-    constructor; repeat intro.
-    destruct H; subst; split...
-    destruct H; subst.
-    exists z. exists z. split...
-    destruct H; subst.
-    exists x. exists x. split...
-  Qed.
-
-End EquivPAFunctor.
-
-Section PairSAFunctor.
-  Variables (F1 F2: functor).
-  Variables (J_F1: forall A, Join (F1 A)) (pafF1: pafunctor F1 J_F1).
-  Variables (J_F2: forall A, Join (F2 A)) (pafF2: pafunctor F2 J_F2).
-
-  (* The second argument must be explicitly specified (instead of _) *)
-  (* Or else, it will cause universe inconsistency in floyd. *)
-  Lemma paf_pair : @pafunctor (fpair F1 F2) (fun A : Type => Join_prod (F1 A) (J_F1 A) (F2 A) (J_F2 A)).
-  Proof with auto.
-    constructor; repeat intro.
-    + destruct H.
-      destruct x. destruct y. destruct z.
-      split; simpl in *.
-      - apply (@paf_join_hom _ _ pafF1 _ _ _ _ _ _ _); auto.
-      - apply (@paf_join_hom _ _ pafF2 _ _ _ _ _ _ _); auto.
-    + (* PU *)
-      destruct x' as [f0 f1], y as [f2 f3], z as [f4 f5].
-      destruct H.
-      simpl in H, H0.
-      generalize (paf_preserves_unmap_left pafF1 f g f0 f2 f4 H); intro X.
-      destruct X as [x1 [y01 [? [? ?]]]].
-      generalize (paf_preserves_unmap_left pafF2 f g f1 f3 f5 H0); intro X.
-      destruct X as [x2 [y02 [? [? ?]]]].
-      exists (x1, x2). exists (y01, y02).
-      split. split...
-      split; simpl; congruence.
-    + destruct x as [f0 f1], y as [f2 f3], z' as [f4 f5].
-      destruct H.
-      simpl in H, H0.
-      generalize (paf_preserves_unmap_right pafF1 f g f0 f2 f4 H); intro X.
-      destruct X as [y01 [z1 [? [? ?]]]].
-      generalize (paf_preserves_unmap_right pafF2 f g f1 f3 f5 H0); intro X.
-      destruct X as [y02 [z2 [? [? ?]]]].
-      exists (y01, y02). exists (z1, z2).
-      split. split...
-      split; simpl; congruence.
-  Qed.
-End PairSAFunctor.
-
-Section CoFunSAFunctor.
-  Variables (dom: Type) (rng : functor).
-  Variables (Join_rng: forall A, Join (rng A)) (pss_rng : pafunctor rng Join_rng).
-
-  Definition paf_fun : @pafunctor (ffunc (fconst dom) rng)
-                         (fun A => Join_fun dom _ (Join_rng A)).
-  Proof with auto.
-    constructor; simpl; intros; intro; intros.
-    + intro i.
-      specialize ( H i).
-      apply (paf_join_hom pss_rng f g _ _ _ H).
-    + set (f' := fun d => paf_preserves_unmap_left pss_rng f g _ _ _ (H d)).
-      exists (fun d => projT1 (f' d)).
-      exists (fun d => proj1_sig (projT2 (f' d))).
-      split.
-      - intro d. (*spec f' d. *)
-        destruct (f' d) as [x [y0 [? [? ?]]]]...
-      - split; extensionality d;
-        simpl; unfold compose, f';
-        remember (paf_preserves_unmap_left pss_rng f g (x' d) (y d) (z d) (H d));
-        destruct s as [x [y0 [? [? ?]]]]...
-    + set (f' := fun d => paf_preserves_unmap_right pss_rng f g (x d) (y d) (z' d) (H d)).
-      exists (fun d => projT1 (f' d)).
-      exists (fun d => proj1_sig (projT2 (f' d))).
-      split.
-      - intro d. (*spec f' d. *)
-        destruct (f' d) as [y0 [z [? [? ?]]]]...
-      - split; extensionality d;
-        simpl; unfold compose, f';
-        remember (paf_preserves_unmap_right pss_rng f g (x d) (y d) (z' d) (H d));
-        destruct s as [y0 [z [? [? ?]]]]...
-  Qed.
-End CoFunSAFunctor.
-(*
-(* This one is not used. *)
-(* And the assumption, inj_sig, is wierd. *)
-Section SigmaSAFunctor.
-  Variable I:Type.
-  Variables (F: I -> functor).
-
-  Variables (JOIN: forall i A, Join (F i A))
-            (fSA : forall i, pafunctor (F i) (JOIN i)).
-
-  #[global] Existing Instance Join_sigma.
-
-  Hypothesis inj_sig : forall A i x y,
-    existT (fun i => F i A) i x = existT (fun i => F i A) i y -> x = y.
-
-  Lemma paf_sigma : @pafunctor (fsig F)
-                         (fun A => Join_sigma I (fun i => F i A) (fun i => JOIN i A)).
-  Proof.
-    constructor; simpl; intros.
-    hnf; simpl; intros.
-    inv H. constructor.
-    apply paf_join_hom; auto.
-
-    hnf; simpl; intros.
-    destruct x' as [xi x'].
-    destruct y as [yi y].
-    destruct z as [zi z].
-    unfold fsigma_map in H.
-    assert (xi = yi /\ yi = zi).
-    inv H; auto.
-    destruct H0. subst zi yi.
-    rename xi into i.
-    assert (join x' (fmap f y) (fmap f z)).
-    inv H; auto.
-    apply inj_sig in H2.
-    apply inj_sig in H3.
-    apply inj_sig in H4.
-    subst. auto.
-    apply paf_preserves_unmap_left in H0.
-    destruct H0 as [x [y0 [?[??]]]].
-    exists (existT (fun i => F i A) i x).
-    exists (existT (fun i => F i A) i y0).
-    intuition.
-    constructor; auto.
-    unfold fsigma_map; f_equal; auto.
-    unfold fsigma_map; f_equal; auto.
-
-    hnf; simpl; intros.
-    destruct x as [xi x].
-    destruct y as [yi y].
-    destruct z' as [zi z'].
-    assert (xi = yi /\ yi = zi).
-    inv H; auto.
-    destruct H0. subst zi yi.
-    rename xi into i.
-    assert (join (fmap f x) (fmap f y) z').
-    inv H; auto.
-    apply inj_sig in H2.
-    apply inj_sig in H3.
-    apply inj_sig in H4.
-    subst. auto.
-    apply paf_preserves_unmap_right in H0.
-    destruct H0 as [y0 [z [?[??]]]].
-    exists (existT (fun i => F i A) i y0).
-    exists (existT (fun i => F i A) i z).
-    intuition.
-    constructor; auto.
-    unfold fsigma_map; f_equal; auto.
-    unfold fsigma_map; f_equal; auto.
-  Qed.
-
-End SigmaSAFunctor.
-*)
-Section SepAlgSubset_Functor.
-  Variables (F: functor).
-  Variables (JOIN: forall A, Join (F A))
-            (fSA : @pafunctor F JOIN).
-
-  Variable P : forall A, F A -> Prop.
-  Arguments P {A} _.
-  Hypothesis HPfmap1 : forall A B (f: A -> B) (g: B -> A) x,
-    P x -> P (fmap F f g x).
-  Hypothesis HPfmap2 : forall A B (f: A -> B) (g: B -> A) x,
-    P (fmap F f g x) -> P x.
-
-  Definition paf_subset :
-    @pafunctor (fsubset F (@P) HPfmap1) (fun A => Join_prop _ _ P).
-  Proof.
-    constructor.
-    + repeat intro.
-      destruct x as [x Hx].
-      destruct y as [y Hy].
-      destruct z as [z Hz].
-      red; simpl.
-      apply paf_join_hom; auto.
-    + intros. simpl; hnf; intros.
-      destruct x' as [x' Hx'].
-      destruct y as [y Hy].
-      destruct z as [z Hz].
-      simpl in *.
-      do 2 red in H. simpl in H.
-      apply (paf_preserves_unmap_left fSA) in H.
-      destruct H as [x [y0 [?[??]]]].
-      subst x'.
-      exists (exist (fun x => @P A x) x (HPfmap2 _ _ _ Hx')).
-      assert (P y0). {
-        apply (HPfmap2 f g). rewrite H1. apply HPfmap1. auto.
-      }
-      exists (exist (fun x => @P A x) y0 H0).
-      intuition.
-      - simpl.
-        replace (HPfmap1 f g (HPfmap2 f g x Hx')) with Hx'
-          by apply proof_irr.
-        apply exist_ext; auto.
-      - apply exist_ext; auto.
-    + intros. simpl; hnf; intros.
-      destruct x as [x Hx].
-      destruct y as [y Hy].
-      destruct z' as [z' Hz'].
-      simpl in *.
-      do 2 red in H. simpl in H.
-      apply (paf_preserves_unmap_right fSA) in H.
-      destruct H as [y0 [z [?[??]]]].
-      subst z'.
-      assert (P y0). {
-        apply (HPfmap2 f g). rewrite H0. apply HPfmap1. auto.
-      }
-      exists (exist (fun x => @P A x) y0 H1).
-      exists (exist (fun x => @P A x) z (HPfmap2 _ _ _ Hz')).
-      intuition.
-      - apply exist_ext; auto.
-      - simpl.
-        replace (HPfmap1 f g (HPfmap2 f g z Hz')) with Hz' by apply proof_irr.
-        apply exist_ext; auto.
-  Qed.
-
-End SepAlgSubset_Functor.
-
diff --git a/msl/sepalg_generators.v b/msl/sepalg_generators.v
index f1d65b1a1e..e770b9fa76 100644
--- a/msl/sepalg_generators.v
+++ b/msl/sepalg_generators.v
@@ -829,6 +829,3 @@ End SepAlgBijection.
 #[global] Existing Instance Join_bij.
 #[global] Existing Instance Perm_bij.
 #[global] Existing Instance Sep_bij.
-#[global] Existing Instance Sing_bij.
-#[global] Existing Instance Canc_bij.
-#[global] Existing Instance Disj_bij.
diff --git a/msl/sepalg_list.v b/msl/sepalg_list.v
index 414871d306..b26b6c3483 100644
--- a/msl/sepalg_list.v
+++ b/msl/sepalg_list.v
@@ -106,7 +106,7 @@ inv H5.
 auto.
 Qed.
 
-Definition age1_list {A} `{ageable A} := list_forall2 age.
+(*Definition age1_list {A} `{ageable A} := list_forall2 age.
 
 Lemma age1_list_join {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}:
   forall l (phi phi' phi2: A),
@@ -140,7 +140,7 @@ destruct (IHl phi1 phi2 phi2' H H6) as [l' [phi1' [? [? ?]]]].
 destruct (age1_join2 _ H4 H0) as [phi' [a' [? [? ?]]]].
 exists (a'::l'). exists phi'.
 repeat split; auto; econstructor 2; eauto.
-Qed.
+Qed.*)
 
 Lemma list_join_split_nth {A}{JA: Join A}{PA: Perm_alg A}:
  forall n (l: list A) phin phi phia phib phi2,
@@ -326,7 +326,7 @@ Proof.
 intros; subst; apply comparable_refl.
 Qed.
 
-Lemma ageN_join {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}:
+(*Lemma ageN_join {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}:
   forall n (w1 w2 w3 w1': A),
    join w1 w2 w3 ->
       ageN n w1 = Some w1' ->
@@ -414,7 +414,7 @@ inv H. exists phi2'; exists phi3'; split; auto.
   exists phi4; exists phi5. split; auto.
  split; unfold ageN; simpl. rewrite H6; auto. rewrite H7; auto.
  inv H1.
-Qed.
+Qed.*)
 
 
 #[export] Hint Resolve join_comparable join_comparable'  join_comparable'' join_comparable'''
@@ -453,7 +453,7 @@ Ltac Comp1 phi1 phi2 :=
                           [eauto 3 with comparable  typeclass_instances | clear H; Comp1 phib phi2]
                    | clear H; Comp1 phi1 phi2].
 
-Ltac Comp := match goal with
+(*Ltac Comp := match goal with
                 | |- comparable ?phi1 ?phi2 => Comp1 phi1 phi2
                 | |-  level ?phi1 = level ?phi2 => apply comparable_fashionR; Comp1 phi1 phi2
 (*                | |- level _ = level _ => rewrite comparable_level; Comp *)
@@ -543,4 +543,4 @@ destruct (IHclos_refl_trans1 _ _ H0) as [x0 [y0 [? [? ?]]]].
 exists x0; exists y0.
 split; auto.
 split; econstructor 3; eauto.
-Qed.
+Qed.*)
diff --git a/msl/seplog.v b/msl/seplog.v
deleted file mode 100644
index b21045ee37..0000000000
--- a/msl/seplog.v
+++ /dev/null
@@ -1,263 +0,0 @@
-Require Import VST.msl.Extensionality.
-
-Class NatDed (A: Type) := mkNatDed {
-  andp: A -> A -> A;
-  orp: A -> A -> A;
-  exp: forall {T:Type}, (T -> A) -> A;
-  allp: forall {T:Type}, (T -> A) -> A;
-  imp: A -> A -> A;
-  prop: Prop -> A;
-  derives: A -> A -> Prop;
-  pred_ext: forall P Q, derives P Q -> derives Q P -> P=Q;
-  derives_refl: forall P, derives P P;
-  derives_trans: forall P Q R, derives P Q -> derives Q R -> derives P R;
-  TT := prop True;
-  FF := prop False;
-  andp_right:  forall X P Q:A, derives X P -> derives X Q -> derives X (andp P Q);
-  andp_left1:  forall P Q R:A, derives P R -> derives (andp P Q) R;
-  andp_left2:  forall P Q R:A, derives Q R -> derives (andp P Q) R;
-  orp_left: forall P Q R, derives P R -> derives Q R -> derives (orp P Q) R;
-  orp_right1: forall P Q R, derives P Q -> derives P (orp Q R);
-  orp_right2: forall P Q R, derives P R -> derives P (orp Q R);
-  exp_right: forall {B: Type} (x:B) (P: A) (Q: B -> A),
-                        derives P (Q x) -> derives P (exp Q);
-  exp_left: forall {B: Type} (P: B -> A) (Q: A),
-                      (forall x, derives (P x) Q) -> derives (exp P) Q;
-  allp_left: forall {B}(P: B -> A) x Q, derives (P x) Q -> derives (allp P) Q;
-  allp_right: forall {B}(P: A) (Q: B -> A),  (forall v, derives P (Q v)) -> derives P (allp Q);
-  imp_andp_adjoint: forall P Q R, derives (andp P Q) R <-> derives P (imp Q R);
-  prop_left: forall (P: Prop) Q, (P -> derives TT Q) -> derives (prop P) Q;
-  prop_right: forall (P: Prop) Q, P -> derives Q (prop P);
-  prop_imp_prop_left: forall (P Q: Prop), derives (imp (prop P) (prop Q)) (prop (P -> Q));
-  allp_prop_left: forall {B: Type} (P: B -> Prop), derives (allp (fun b => prop (P b))) (prop (forall b, P b))
-(* not_prop_right: forall (P: A) (Q: Prop), (Q -> derives P FF) -> derives P (prop (not Q)) *)
-}.
-
-#[global] Program Instance LiftNatDed (A B: Type) {ND: NatDed B} : NatDed (A -> B) :=
- mkNatDed (A -> B)
-    (*andp*) (fun P Q x => andp (P x) (Q x))
-    (*orp*) (fun P Q x => orp (P x) (Q x))
-    (*exp*) (fun T (F: T -> A -> B) (a: A) => exp (fun x => F x a))
-    (*allp*) (fun T (F: T -> A -> B) (a: A) => allp (fun x => F x a))
-    (*imp*) (fun P Q x => imp (P x) (Q x))
-    (*prop*) (fun P x => prop P)
-    (*derives*) (fun P Q => forall x, derives (P x) (Q x))
-     _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _.
-Next Obligation.
- intros; extensionality x; apply pred_ext; auto.
-Defined.
-Next Obligation.
- intros; apply derives_refl.
-Defined.
-Next Obligation.
- intros; eapply derives_trans; eauto.
-Defined.
-Next Obligation.
- intros; eapply andp_right; eauto.
-Defined.
-Next Obligation.
- intros; eapply andp_left1; eauto.
-Defined.
-Next Obligation.
- intros; eapply andp_left2; eauto.
-Defined.
-Next Obligation.
- intros; eapply orp_left; eauto.
-Defined.
-Next Obligation.
- intros; eapply orp_right1; eauto.
-Defined.
-Next Obligation.
- intros; eapply orp_right2; eauto.
-Defined.
-Next Obligation.
- intros; eapply exp_right; eauto.
-Defined.
-Next Obligation.
- intros; eapply exp_left; eauto.
-Defined.
-Next Obligation.
- intros; eapply allp_left; eauto.
-Defined.
-Next Obligation.
- intros; eapply allp_right; eauto.
-Defined.
-Next Obligation.
- intros; split; intros;  eapply imp_andp_adjoint; eauto.
-Defined.
-Next Obligation.
- intros; eapply prop_left; eauto.
-Defined.
-Next Obligation.
- intros; eapply prop_right; eauto.
-Defined.
-Next Obligation.
- intros; eapply prop_imp_prop_left; eauto.
-Defined.
-Next Obligation.
- intros; eapply allp_prop_left; eauto.
-Defined.
-
-Declare Scope logic.
-Delimit Scope logic with logic.
-Local Open Scope logic.
-Declare Scope logic_derives.
-Notation "P '|--' Q" := (derives P%logic Q%logic) (at level 80, no associativity) : logic_derives.
-Open Scope logic_derives.
-Notation "'EX' x .. y , P " :=
-  (exp (fun x => .. (exp (fun y => P%logic)) ..)) (at level 65, x binder, y binder, right associativity) : logic.
-Notation "'ALL' x .. y , P " :=
-  (allp (fun x => .. (allp (fun y => P%logic)) ..)) (at level 65, x binder, y binder, right associativity) : logic.
-Infix "||" := orp (at level 50, left associativity) : logic.
-Infix "&&" := andp (at level 40, left associativity) : logic.
-Notation "P '-->' Q" := (imp P Q) (at level 55, right associativity) : logic.
-Notation "P '<-->' Q" := (andp (imp P Q) (imp Q P)) (at level 57, no associativity) : logic.
-Notation "'!!' e" := (prop e) (at level 15) : logic.
-
-Class SepLog (A: Type) {ND: NatDed A} := mkSepLog {
-  emp: A;
-  sepcon: A -> A -> A;
-  wand: A -> A -> A;
-  ewand: A -> A -> A;
-  sepcon_assoc: forall P Q R, sepcon (sepcon P Q) R = sepcon P (sepcon Q R);
-  sepcon_comm:  forall P Q, sepcon P Q = sepcon Q P;
-  wand_sepcon_adjoint: forall (P Q R: A),  (sepcon P Q |-- R) <-> (P |-- wand Q R);
-  sepcon_andp_prop: forall P Q R, sepcon P (!!Q && R) = !!Q && (sepcon P R);
-  sepcon_derives: forall P P' Q Q' : A, (P |-- P') -> (Q |-- Q') -> sepcon P Q |-- sepcon P' Q';
-(* how necessary is ewand? *)
-(*  ewand_sepcon: forall (P Q R : A),  ewand (sepcon P Q) R = ewand P (ewand Q R);
-  ewand_TT_sepcon: forall (P Q R: A),
-                         andp (sepcon P Q) (ewand R TT) |--
-                               sepcon (andp P (ewand R TT)) (andp Q (ewand R TT));
-  exclude_elsewhere: forall P Q: A, sepcon P Q |-- sepcon (andp P (ewand Q TT)) Q;*)
-  ewand_conflict: forall P Q R, (sepcon P Q |-- FF) -> andp P (ewand Q R) |-- FF
-}.
-
-Notation "P '*' Q" := (sepcon P Q) : logic.
-Notation "P '-*' Q" := (wand P Q) (at level 60, right associativity) : logic.
-
-#[global] Instance LiftSepLog (A B: Type) {NB: NatDed B}{SB: SepLog B} : SepLog (A -> B).
- apply (mkSepLog (A -> B) _ (fun rho => emp)
-            (fun P Q rho => P rho * Q rho) (fun P Q rho => P rho -* Q rho)
-            (fun P Q rho => ewand (P rho) (Q rho))).
- (* sepcon_assoc *) intros; extensionality rho; apply sepcon_assoc.
- (* sepcon_comm *) intros; extensionality rho; apply sepcon_comm.
- intros.  split. simpl. intuition.
-    apply wand_sepcon_adjoint. auto.
-    intro. intro rho.     apply <- wand_sepcon_adjoint; auto.
- simpl; intros. extensionality x. apply sepcon_andp_prop.
- simpl; intros; apply sepcon_derives; auto.
-(* simpl; intros; extensionality x; apply ewand_sepcon.
- simpl; intros; eapply ewand_TT_sepcon.
- simpl; intros; eapply exclude_elsewhere.*)
- simpl; intros; eapply ewand_conflict; eauto.
-Defined.
-
-Class ClassicalSep  (A: Type) {ND: NatDed A}{SL: SepLog A} := mkCS {
-   sepcon_emp: forall P, P * emp = P
-}.
-
-#[global] Instance LiftClassicalSep (A B: Type)  {NB: NatDed B}{SB: SepLog B}{CB: ClassicalSep B} :
-        ClassicalSep (A -> B).
- apply mkCS.
- intros. extensionality x. simpl. apply sepcon_emp.
-Qed.
-
-Definition  extensible {A}{ND: NatDed A}{SL: SepLog A}(P:A) := sepcon P TT |-- P.
-
-Class IntuitionisticSep (A: Type) {ND: NatDed A}{SL: SepLog A} := mkIS {
-   all_extensible: forall P, extensible P
-}.
-
-#[global] Instance LiftIntuitionisticSep (A B: Type)  {NB: NatDed B}{SB: SepLog B}{IB: IntuitionisticSep B} :
-        IntuitionisticSep (A -> B).
- apply mkIS.
- intros. intro. simpl. apply all_extensible.
-Qed.
-
-Class Indir (A: Type) {ND: NatDed A} := mkIndir {
-  later: A -> A;
-  now_later: forall P: A, P |-- later P;
-  later_K: forall P Q, later (P --> Q) |-- later P --> later Q;
-  later_allp: forall T (F: T -> A),  later (allp F) = ALL x:T, later (F x);
-  later_exp: forall T (F: T-> A), EX x:T, later (F x) |-- later (exp F);
-  later_exp': forall T (any:T) F, later (exp F) = EX x:T, later (F x);
-  later_exp'': forall T F, later (exp F) |-- (EX x:T, later (F x)) || later FF;
-(*  later_imp: forall P Q,  later(P --> Q) = later P --> later Q;*)
-  later_prop: forall PP: Prop, later (!! PP) |-- !! PP || later FF;
-  loeb: forall P,   (later P |-- P) ->  TT |-- P
-}.
-
-Notation "'|>' e" := (later e) (at level 20, right associativity): logic.
-
-#[global] Instance LiftIndir (A: Type) (B: Type)  {NB: NatDed B}{IXB: Indir B} :
-         @Indir (A -> B) (LiftNatDed A B).
- apply (mkIndir _ _ (fun P rho => later (P rho))); intros; simpl in *; intros.
- apply now_later.
- apply later_K.
- simpl; intros. extensionality rho. apply later_allp.
- simpl; intros. apply later_exp.
- simpl; intros. extensionality rho. apply later_exp'; auto.
- simpl; intros. apply later_exp''.
-(* simpl; intros. extensionality rho. apply later_imp.*)
- simpl; intros. apply later_prop.
- simpl; intros. apply loeb; auto.
-Defined.
-
-Class SepIndir (A: Type) {NA: NatDed A}{SA: SepLog A}{IA: Indir A} := mkSepIndir {
-  later_sepcon: forall P Q, |> (P * Q) = |>P * |>Q;
-  later_wand: forall P Q, |> (P -* Q) = |>P -* |>Q(*;
-  later_ewand: forall P Q, |> (ewand P Q) = ewand (|>P) (|>Q)*)
-}.
-
-#[global] Instance LiftSepIndir  (A: Type) (B: Type)  {NB: NatDed B} {SB: SepLog B}{IB: Indir B}{SIB: SepIndir B} :
-     @SepIndir (A -> B) (LiftNatDed A B) (LiftSepLog A B) (LiftIndir A B).
- constructor.
- intros; simpl. extensionality rho.  apply later_sepcon.
- intros; simpl. extensionality rho.  apply later_wand.
-(* intros; simpl. extensionality rho.  apply later_ewand.*)
-Defined.
-
-Class CorableSepLog (A: Type) {ND: NatDed A}{SL: SepLog A}:= mkCorableSepLog {
-  corable: A -> Prop;
-  corable_prop: forall P, corable (!! P);
-  corable_andp: forall P Q, corable P -> corable Q -> corable (P && Q);
-  corable_orp: forall P Q, corable P -> corable Q -> corable (P || Q);
-  corable_imp: forall P Q, corable P -> corable Q -> corable (P --> Q);
-  corable_allp: forall {B: Type} (P:  B -> A), (forall b, corable (P b)) -> corable (allp P);
-  corable_exp: forall {B: Type} (P:  B -> A), (forall b, corable (P b)) -> corable (exp P);
-  corable_sepcon: forall P Q, corable P -> corable Q -> corable (P * Q);
-  corable_wand: forall P Q, corable P -> corable Q -> corable (P -* Q);
-  corable_andp_sepcon1: forall P Q R, corable P ->  (P && Q) * R = P && (Q * R)
-}.
-
-#[global] Instance LiftCorableSepLog (A: Type) (B: Type) {NB: NatDed B} {SB: SepLog B} {CSL: CorableSepLog B} : @CorableSepLog (A -> B) (LiftNatDed A B) (LiftSepLog A B).
-  apply (@mkCorableSepLog _ _ _ (fun P => forall b, corable (P b))); intros; simpl in *; intros.
-  + apply corable_prop.
-  + apply corable_andp; auto.
-  + apply corable_orp; auto.
-  + apply corable_imp; auto.
-  + apply corable_allp; auto.
-  + apply corable_exp; auto.
-  + apply corable_sepcon; auto.
-  + apply corable_wand; auto.
-  + extensionality b.
-    apply corable_andp_sepcon1; auto.
-Defined.
-
-Class CorableIndir (A: Type) {ND: NatDed A}{SL: SepLog A}{CSL: CorableSepLog A}{ID: Indir A} :=
-  corable_later: forall P, corable P -> corable (|> P).
-
-#[global] Instance LiftCorableIndir (A: Type) (B: Type) {NB: NatDed B} {SB: SepLog B} {CSL: CorableSepLog B} {ID: Indir B} {CI: CorableIndir B}: @CorableIndir (A -> B) (LiftNatDed A B) (LiftSepLog A B) (LiftCorableSepLog A B) (LiftIndir A B).
-  unfold CorableIndir; simpl; intros.
-  apply corable_later; auto.
-Defined.
-
-Lemma orp_comm: forall {A: Type} `{NatDed A} (P Q: A), P || Q = Q || P.
-Proof.
-  intros.
-  apply pred_ext.
-  + apply orp_left; [apply orp_right2 | apply orp_right1]; apply derives_refl.
-  + apply orp_left; [apply orp_right2 | apply orp_right1]; apply derives_refl.
-Qed.
-
diff --git a/msl/shares.v b/msl/shares.v
index 57647de7cf..1c9fc3e397 100644
--- a/msl/shares.v
+++ b/msl/shares.v
@@ -6,8 +6,8 @@
 
 Require Import VST.msl.base.
 Require Import VST.msl.sepalg.
-Require Import VST.msl.psepalg.
 Require Import VST.msl.sepalg_generators.
+Require Import VST.msl.psepalg.
 Require Import VST.msl.boolean_alg.
 Require Import VST.msl.eq_dec.
 
diff --git a/msl/sig_isomorphism.v b/msl/sig_isomorphism.v
deleted file mode 100644
index 6086db2869..0000000000
--- a/msl/sig_isomorphism.v
+++ /dev/null
@@ -1,222 +0,0 @@
-Require Import VST.msl.base.
-
-Program Definition sig_sig_iff {A: Type} {P Q: A -> Prop}
-  (H: forall a, P a <-> Q a) (x: sig P): sig Q := x.
-Next Obligation.
-  rewrite <- H; auto.
-Defined.
-
-Program Definition sig_sig_iff' {A: Type} {P Q: A -> Prop}
-  (H: forall a, P a <-> Q a) (x: sig Q): sig P := x.
-Next Obligation.
-  rewrite H; auto.
-Defined.
-
-Program Definition sig_sig_eq {A: Type} {P Q: A -> Prop}
-  (H: forall a, P a = Q a) (x: sig P): sig Q := x.
-Next Obligation.
-  rewrite <- H; auto.
-Defined.
-
-Program Definition sig_sig_eq' {A: Type} {P Q: A -> Prop}
-  (H: forall a, P a = Q a) (x: sig Q): sig P := x.
-Next Obligation.
-  rewrite H; auto.
-Defined.
-
-Program Definition sigsig_sig {A: Type} {P Q: A -> Prop}
-  (x: sig (fun x: sig P => Q (proj1_sig x))): sig (fun x => P x /\ Q x) := x.
-
-Program Definition sig_sigsig {A: Type} {P Q: A -> Prop}
-  (x: sig (fun x => P x /\ Q x)): sig (fun x: sig P => Q (proj1_sig x)) := x.
-
-Program Definition bij_f_sig {A B} (f: bijection A B) (P: A -> Prop)
-  (x: sig P): sig (fun b => P (bij_g _ _ f b)) := bij_f _ _ f x.
-Next Obligation.
-  rewrite bij_gf; auto.
-Defined.
-
-Program Definition bij_g_sig {A B} (f: bijection A B) (P: A -> Prop)
-  (x: sig (fun b => P (bij_g _ _ f b))): sig P := bij_g _ _ f x.
-
-Lemma sig_sig_iff_iff': forall {A: Type} {P Q: A -> Prop}
-  (H: forall a, P a <-> Q a) x,
-  (sig_sig_iff H) (sig_sig_iff' H x) = x.
-Proof.
-  intros.
-  unfold sig_sig_iff, sig_sig_iff'; simpl.
-  apply exist_ext'; auto.
-Qed.
-
-Lemma sig_sig_iff'_iff: forall {A: Type} {P Q: A -> Prop}
-  (H: forall a, P a <-> Q a) x,
-  (sig_sig_iff' H) (sig_sig_iff H x) = x.
-Proof.
-  intros.
-  unfold sig_sig_iff, sig_sig_iff'; simpl.
-  apply exist_ext'; auto.
-Qed.
-
-Lemma sig_sig_eq_eq': forall {A: Type} {P Q: A -> Prop}
-  (H: forall a, P a = Q a) x,
-  (sig_sig_eq H) (sig_sig_eq' H x) = x.
-Proof.
-  intros.
-  unfold sig_sig_eq, sig_sig_eq'; simpl.
-  apply exist_ext'; auto.
-Qed.
-
-Lemma sig_sig_eq'_eq: forall {A: Type} {P Q: A -> Prop}
-  (H: forall a, P a = Q a) x,
-  (sig_sig_eq' H) (sig_sig_eq H x) = x.
-Proof.
-  intros.
-  unfold sig_sig_iff, sig_sig_iff'; simpl.
-  apply exist_ext'; auto.
-Qed.
-
-Lemma sig_sigsig_sig: forall {A: Type} {P Q: A -> Prop} x,
-  @sig_sigsig A P Q (@sigsig_sig A P Q x) = x.
-Proof.
-  intros.
-  unfold sig_sigsig, sigsig_sig; simpl.
-  destruct x as [[x ?] ?]; simpl.
-  apply exist_ext; auto.
-Qed.
-
-Lemma sigsig_sig_sigsig: forall {A: Type} {P Q: A -> Prop} x,
-  @sigsig_sig A P Q (@sig_sigsig A P Q x) = x.
-Proof.
-  intros.
-  unfold sig_sigsig, sigsig_sig; simpl.
-  apply exist_ext'; auto.
-Qed.
-
-Lemma sig_sig_iff_iff'_id: forall {A: Type} {P Q: A -> Prop}
-  (H: forall a, P a <-> Q a),
-  (sig_sig_iff H) oo (sig_sig_iff' H) = id _.
-Proof.
-  intros.
-  extensionality.
-  unfold id, compose, sig_sig_iff, sig_sig_iff'; simpl.
-  apply exist_ext'; auto.
-Qed.
-
-Lemma bij_fg_sig: forall {A B} (f: bijection A B) (P: A -> Prop) x,
-  bij_f_sig f P (bij_g_sig f P x) = x.
-Proof.
-  intros.
-  destruct x; unfold bij_f_sig, bij_g_sig; simpl.
-  apply exist_ext.
-  rewrite bij_fg; auto.
-Qed.
-
-Lemma bij_gf_sig: forall {A B} (f: bijection A B) (P: A -> Prop) x,
-  bij_g_sig f P (bij_f_sig f P x) = x.
-Proof.
-  intros.
-  destruct x; unfold bij_f_sig, bij_g_sig; simpl.
-  apply exist_ext.
-  rewrite bij_gf; auto.
-Qed.
-
-Lemma sig_sig_iff'_iff_id: forall {A: Type} {P Q: A -> Prop}
-  (H: forall a, P a <-> Q a),
-  (sig_sig_iff' H) oo (sig_sig_iff H) = id _.
-Proof.
-  intros.
-  extensionality.
-  unfold id, compose, sig_sig_iff, sig_sig_iff'; simpl.
-  apply exist_ext'; auto.
-Qed.
-
-Lemma sig_sig_eq_eq'_id: forall {A: Type} {P Q: A -> Prop}
-  (H: forall a, P a = Q a),
-  (sig_sig_eq H) oo (sig_sig_eq' H) = id _.
-Proof.
-  intros.
-  extensionality.
-  unfold id, compose, sig_sig_eq, sig_sig_eq'; simpl.
-  apply exist_ext'; auto.
-Qed.
-
-Lemma sig_sig_eq'_eq_id: forall {A: Type} {P Q: A -> Prop}
-  (H: forall a, P a = Q a),
-  (sig_sig_eq' H) oo (sig_sig_eq H) = id _.
-Proof.
-  intros.
-  extensionality.
-  unfold id, compose, sig_sig_iff, sig_sig_iff'; simpl.
-  apply exist_ext'; auto.
-Qed.
-
-Lemma sig_sigsig_sig_id: forall {A: Type} {P Q: A -> Prop},
-  sig_sigsig oo (@sigsig_sig A P Q) = id _.
-Proof.
-  intros.
-  extensionality.
-  unfold id, compose, sig_sigsig, sigsig_sig; simpl.
-  destruct x as [[x ?] ?]; simpl.
-  apply exist_ext; auto.
-Qed.
-
-Lemma sigsig_sig_sigsig_id: forall {A: Type} {P Q: A -> Prop},
-  sigsig_sig oo (@sig_sigsig A P Q) = id _.
-Proof.
-  intros.
-  extensionality.
-  unfold id, compose, sig_sigsig, sigsig_sig; simpl.
-  apply exist_ext'; auto.
-Qed.
-
-Lemma bij_fg_sig_id: forall {A B} (f: bijection A B) (P: A -> Prop),
-  (bij_f_sig f P) oo (bij_g_sig f P) = id _.
-Proof.
-  intros.
-  extensionality x.
-  destruct x; unfold compose, id, bij_f_sig, bij_g_sig; simpl.
-  apply exist_ext.
-  rewrite bij_fg; auto.
-Qed.
-
-Lemma bij_gf_sig_id: forall {A B} (f: bijection A B) (P: A -> Prop),
-  (bij_g_sig f P) oo (bij_f_sig f P) = id _.
-Proof.
-  intros.
-  extensionality x.
-  destruct x; unfold compose, id, bij_f_sig, bij_g_sig; simpl.
-  apply exist_ext.
-  rewrite bij_gf; auto.
-Qed.
-
-Definition sig_sig_iff_bij {A} {P Q: A -> Prop} (H: forall a, P a <-> Q a):
-  bijection (sig P) (sig Q).
-  refine (Bijection _ _
-           (sig_sig_iff H)
-           (sig_sig_iff' H) _ _).
-  + apply sig_sig_iff_iff'.
-  + apply sig_sig_iff'_iff.
-Defined.
-
-Definition sig_sig_eq_bij {A} {P Q: A -> Prop} (H: forall a, P a = Q a):
-  bijection (sig P) (sig Q).
-  refine (Bijection _ _
-           (sig_sig_eq H)
-           (sig_sig_eq' H) _ _).
-  + apply sig_sig_eq_eq'.
-  + apply sig_sig_eq'_eq.
-Defined.
-
-Definition sig_sigsig_bij {A} (P Q: A -> Prop):
-  bijection (sig (fun a => P a /\ Q a)) (sig (fun a: sig P => Q (proj1_sig a))).
-  refine (Bijection _ _ (sig_sigsig) (sigsig_sig) _ _).
-  + apply sig_sigsig_sig.
-  + apply sigsig_sig_sigsig.
-Defined.
-
-Definition bij_sig {A B} (f: bijection A B) (P: A -> Prop):
-  bijection (sig P) (sig (fun b => P (bij_g _ _ f b))).
-  refine (Bijection _ _ (bij_f_sig f P) (bij_g_sig f P) _ _).
-  + apply bij_fg_sig.
-  + apply bij_gf_sig.
-Defined.
diff --git a/msl/simple_CCC.v b/msl/simple_CCC.v
deleted file mode 100644
index 4f1b98548a..0000000000
--- a/msl/simple_CCC.v
+++ /dev/null
@@ -1,41 +0,0 @@
-(* This is not a complete definition of CCC. But it is enough to prove useful *)
-(* properties.                                                                *)
-(* It is possible to define a Type version instead of Prop version, which is  *)
-(* more faithful to its mathmatical definitions. Again, a Prop version is     *)
-(* good to use in VST already.                                                *)
-(*                                                               -- Qinxiang  *)
-
-Module CartesianClosedCat.
-
-Section CartesianClosedCat.
-
-Variable A: Type.
-Variable arrow: A -> A -> Prop.
-Variable iso: A -> A -> Prop.
-
-Class CCC (prod expo: A -> A -> A): Prop := mkCCC {
-  comm: forall x y, iso (prod x y) (prod y x);
-  assoc: forall x y z, iso (prod (prod x y) z) (prod x (prod y z));
-  adjoint: forall x y z, arrow (prod x y) z <-> arrow x (expo y z);
-  prod_UMP: forall x x' y y', arrow x x' -> arrow y y' -> arrow (prod x y) (prod x' y')
-}.
-
-(* This is an example of useful property. *)
-
-Hypothesis transitivity: forall x y z, arrow x y -> arrow y z -> arrow x z.
-Hypothesis identity: forall x, arrow x x.
-
-Lemma expo_UMP: forall prod expo `{CCC prod expo},
-  forall x x' y y', arrow x' x -> arrow y y' -> arrow (expo x y) (expo x' y').
-Proof.
-  intros.
-  apply adjoint.
-  eapply transitivity; [| exact H1].
-  eapply transitivity; [apply prod_UMP; [apply identity | eassumption] |].
-  apply adjoint.
-  apply identity.
-Qed.
-
-End CartesianClosedCat.
-
-End CartesianClosedCat.
diff --git a/msl/subtypes.v b/msl/subtypes.v
deleted file mode 100644
index dbbac1586d..0000000000
--- a/msl/subtypes.v
+++ /dev/null
@@ -1,588 +0,0 @@
-(*
- * Copyright (c) 2009-2010, Andrew Appel, Robert Dockins and Aquinas Hobor.
- *
- *)
-
-Require Import VST.msl.base.
-Require Import VST.msl.ageable.
-Require Import VST.msl.predicates_hered.
-
-Import Arith.
-
-Local Open Scope pred.
-
-Section Fash.
-
-Context {A : Type} {AG : ageable A} {EO : Ext_ord A}.
-
-Lemma valid_rel_fashion : valid_rel fashionR.
-Proof.
-  split; hnf; intros.
-  unfold fashionR in *.
-  hnf in H.
-  case_eq (age1 z); intros.
-  exists a.
-  rewrite (af_level2 age_facts y x) in H0; auto.
-  rewrite (af_level2 age_facts z a) in H0; auto.
-  auto.
-  rewrite (af_level1 age_facts) in H1; auto.
-  rewrite H1 in H0.
-  symmetry in H0.
-  rewrite <- (af_level1 age_facts) in H0.
-  rewrite H in H0; discriminate.
-
-  split; hnf; intros.
-  hnf in H.
-  destruct (af_unage age_facts x). exists x0. apply H1.
-  hnf.
-  rewrite (af_level2 age_facts x0 x); auto.
-  rewrite (af_level2 age_facts z y); auto.
-
-(*  split; hnf; intros.*)
-  eexists; [reflexivity|].
-  apply ext_level in H0; hnf in *; lia.
-(*  eexists; [|reflexivity].
-  apply ext_level in H; hnf in *; lia.*)
-Qed.
-
-Definition fashionM : modality
-  := exist _ fashionR valid_rel_fashion.
-
-#[global] Existing Instance ag_nat.
-#[global] Program Instance nat_ext : Ext_ord nat := { ext_order := eq }.
-Next Obligation.
-Proof.
-  hnf; intros; subst; eauto.
-Qed.
-Next Obligation.
-Proof.
-  hnf; intros; subst; eauto.
-Qed.
-(*Next Obligation.
-Proof.
-  hnf; intros; subst; eauto.
-Qed.*)
-
-Program Definition fash (P: pred A): pred nat :=
-      fun n => forall y, n >= level y -> P y.
-Next Obligation.
-split; repeat intro.
-destruct P as [P HP].
-simpl in *.
-apply H0.
-unfold age, age1, ag_nat,natAge1 in H.
-destruct a; inv H.
-lia.
-
-subst; auto.
-Qed.
-
-Notation "'#' e" := (fash e) (at level 20, right associativity): pred.
-
-Lemma fash_K : forall (P Q: pred A),
-                 # (P --> Q) |-- # P --> # Q.
-Proof.
-intros.
-intros n ?.
-simpl in H.
-simpl.
-intros w ? ? ? ? ? HP; subst.
-eapply H; eauto.
-apply necR_level in H0; simpl in H0.
-unfold natLevel in H0; lia.
-Qed.
-
-Lemma laterR_nat: forall (n n': nat), laterR n n' <-> (n > n')%nat.
-Proof.
-intros.
-split; induction 1; simpl; intros.
-unfold age, age1 in H; simpl in H; unfold natAge1 in H. destruct x; inv H.
-auto.
-apply Nat.lt_trans with y; auto.
-constructor 1. unfold age, age1; simpl. auto.
-constructor 2 with m; auto.
-constructor 1. unfold age, age1; simpl. auto.
-Qed.
-
-Lemma fash_derives :
-     forall (P Q: pred A), (P |-- Q)  ->  # P |-- # Q.
-Proof.
-intros.
-intros w ?.
-intro; intros.
-apply H.
-eapply H0; auto.
-Qed.
-
-Lemma fash_and : forall (P Q:pred A),
-  # (P && Q) = # P && # Q.
-Proof.
-  intros; apply pred_ext; hnf; intros.
-  split; hnf; intros; destruct (H y H0); auto.
-  hnf; intros.
-  destruct H.
-  split; auto.
-Qed.
-
-End Fash.
-
-#[export] Hint Resolve ag_nat : core.
-
-Notation "'#' e" := (fash e) (at level 20, right associativity): pred.
-
-Lemma fash_triv : forall (P : pred nat), # P = P.
-Proof.
-  intros; apply pred_ext; repeat intro; auto.
-  eapply pred_nec_hereditary, H.
-  rewrite nec_nat; auto.
-Qed.
-
-Section Subtypes.
-
-Context {A : Type} {AG : ageable A} {EO : Ext_ord A}.
-
-Definition fashionable  (P: pred nat) := # P = P.
-
-Notation "P '>=>' Q" := (# (P --> Q)) (at level 55, right associativity) : pred.
-Notation "P '<=>' Q" := (# (P <--> Q)) (at level 57, no associativity) : pred.
-
-Lemma subp_eqp : forall G (P Q: pred A),
-  (G |-- P >=> Q) ->
-  (G |-- Q >=> P) ->
-  G |-- P <=> Q.
-Proof.
-  repeat intro.
-  split.
-  eapply H; eauto.
-  eapply H0; eauto.
-Qed.
-
-Lemma eqp_subp : forall G P Q,
-  (G |-- P <=> Q) ->
-  G |-- P >=> Q.
-Proof.
-  repeat intro.
-  apply H in H0.
-  simpl in H0.
-  destruct (H0 _ H1); eauto.
-Qed.
-
-Lemma eqp_subp2 : forall G P Q,
-  (G |-- P <=> Q) ->
-  G |-- Q >=> P.
-Proof.
-  repeat intro.
-  apply H in H0.
-  simpl in H0.
-  destruct (H0 _ H1); eauto.
-Qed.
-
-Lemma eqp_comm : forall (P Q:pred A),
-  P <=> Q = Q <=> P.
-Proof.
-  intros. apply pred_ext.
-  apply subp_eqp.
-    apply eqp_subp2. hnf; auto.
-    apply eqp_subp. hnf; auto.
-  apply subp_eqp.
-    apply eqp_subp2. hnf; auto.
-    apply eqp_subp. hnf; auto.
-Qed.
-
-Lemma subp_refl : forall G P,
-  G |-- P >=> P.
-Proof.
-  repeat intro; auto.
-Qed.
-
-Lemma subp_trans : forall G P Q R,
-  (G |-- P >=> Q) ->
-  (G |-- Q >=> R) ->
-  G |-- P >=> R.
-Proof.
-  repeat intro.
-  eapply H0; eauto.
-  eapply H; eauto.
-Qed.
-
-Lemma subp_top : forall G P,
-  G |-- P >=> TT.
-Proof.
-  repeat intro; simpl; auto.
-Qed.
-
-Lemma subp_bot : forall G P,
-  G |-- FF >=> P.
-Proof.
-  repeat intro; simpl in *; intuition.
-Qed.
-
-Lemma subp_andp : forall G P P' Q Q',
-  (G |-- P >=> P') ->
-  (G |-- Q >=> Q') ->
-  G |-- P && Q >=> (P' && Q').
-Proof.
-  repeat intro.
-  destruct H5; split.
-  eapply H; eauto.
-  eapply H0; eauto.
-Qed.
-
-Lemma subp_imp : forall G P P' Q Q',
-  (G |-- P' >=> P) ->
-  (G |-- Q >=> Q') ->
-  G |-- (P --> Q) >=> (P' --> Q').
-Proof.
-  repeat intro.
-  assert (a >= level a'').
-  { apply necR_level in H3; apply ext_level in H4; lia. }
-  eapply (H0); eauto.
-  eapply H5; eauto.
-  eapply H; eauto.
-Qed.
-
-Lemma subp_orp : forall G P P' Q Q',
-  (G |-- P >=> P') ->
-  (G |-- Q >=> Q') ->
-  G |-- (P || Q) >=> (P' || Q').
-Proof.
-  repeat intro.
-  destruct H5; [ left | right ].
-  eapply H; eauto.
-  eapply H0; eauto.
-Qed.
-
-Lemma subp_subp :
-  forall (G: pred nat) (P Q R S: pred A),
-   (G |-- (R >=> P)) ->
-   (G |-- (Q >=> S)) ->
-   G |-- (P >=> Q) >=> (R >=> S).
-Proof.
- intros.
- intros w ?.
- specialize (H _ H1). specialize (H0 _ H1). clear G H1.
- intros ? ? ? ? ? ? ? ? ? ? ? ? ? ?.
- assert (w >= level y0).
- { apply necR_level in H2. apply ext_level in H3. simpl in *; unfold natLevel in *. lia. }
- eapply H0, H4, H; eassumption.
-Qed.
-
-Lemma subp_allp : forall G B (X Y:B -> pred A),
-  (forall x:B, G |-- X x >=> Y x) ->
-  G |-- allp X >=> allp Y.
-Proof.
-  repeat intro.
-  eapply H; eauto.
-Qed.
-
-Lemma subp_exp : forall G B (X Y:B -> pred A),
-  (forall x:B, G |-- X x >=> Y x) ->
-  G |-- exp X >=> exp Y.
-Proof.
-  repeat intro.
-  destruct H4; exists x.
-  eapply H; eauto.
-Qed.
-
-Lemma subp_allp_spec : forall G B (X:B -> pred A) x,
-  G |-- allp X >=> X x.
-Proof.
-  repeat intro; eauto.
-Qed.
-
-Lemma subp_exp_spec : forall G B(X:B -> pred A) x,
-  G |-- X x >=> exp X.
-Proof.
-  repeat intro.
-  exists x; auto.
-Qed.
-
-
-Lemma later_fash1 :
-   forall P, |> # P |-- # |> P.
-Proof.
-intros.
-intros w ?.
-intros w' ? w'' ?.
-simpl in *.
-eapply (H (level w'')); auto.
-apply later_nat.
-apply laterR_level in H1.
-lia.
-Qed.
-
-Lemma later_fash :
-    forall P, |> # P = # |> P.
-Proof.
-intros.
-apply pred_ext.
-apply later_fash1.
-(** backward direction **)
-intros w ? w' ?.
-simpl in *.
-intros.
-destruct (af_unage age_facts y).
-apply (H x).
-apply later_nat in H0.
-apply age_level in H2.
-lia.
-constructor 1; auto.
-Qed.
-
-Lemma subp_later1 : forall P Q,
-   |>(P >=> Q)  |--   |>P >=> |>Q.
-Proof.
-intros.
-rewrite later_fash.
-apply fash_derives, axiomK.
-Qed.
-
-(*Lemma subp_later : forall P Q,
-   |>(P >=> Q) = |>P >=> |>Q.
-Proof.
-intros.
-apply pred_ext.
-apply subp_later1.
-rewrite later_fash.
-intros ???????????.
-eapply H.
-f_equal.
-apply later_imp.
-Qed.*)
-
-Lemma eqp_later1 : forall P Q,
-   |>(P <=> Q)  |--   |>P <=> |>Q.
-Proof.
-intros.
-rewrite later_fash.
-apply fash_derives.
-rewrite later_and.
-apply andp_derives; apply axiomK.
-Qed.
-
-(*Lemma eqp_later : forall P Q,
-    (|>(P <=> Q) = |>P <=> |>Q)%pred.
-Proof.
-intros.
-rewrite later_fash.
-f_equal.
-rewrite later_and.
-repeat rewrite later_imp.
-auto.
-Qed.*)
-
-
-Program Definition unfash  (P: pred nat) : pred A :=
-     fun x => P (level x).
-Next Obligation.
- split; hnf; intros.
- apply age_level in H.
- rewrite H in H0.
- eapply pred_hereditary; eauto. unfold age; simpl. auto.
-
- apply ext_level in H as <-; auto.
-Qed.
-
-Notation "'!' e" := (unfash e) (at level 20, right associativity): pred.
-
-Lemma level_later : forall {w: A} {n': nat},
-         laterR (level w) n' ->
-       exists w', laterR w w' /\ n' = level w'.
-Proof.
-intros.
-remember (level w) as n.
-revert w Heqn; induction H; intros; subst.
-case_eq (age1 w); intros.
-exists a; split. constructor; auto.
-symmetry; unfold age in H; simpl in H.
-  unfold natAge1 in H; simpl in H. revert H; case_eq (level w); intros; inv H1.
-  apply age_level in H0. congruence. rewrite age1_level0 in H0.
-   rewrite H0 in H. inv H.
- specialize (IHclos_trans1 _ (refl_equal _)).
-  destruct IHclos_trans1 as [w2 [? ?]].
-  subst.
-  specialize (IHclos_trans2 _ (refl_equal _)).
-  destruct IHclos_trans2 as [w3 [? ?]].
-  subst.
-  exists w3; split; auto. econstructor 2; eauto.
-Qed.
-
-Lemma later_unfash :
-     forall P, |> (unfash P: pred A) = unfash ( |> P).
-Proof.
-unfold unfash; intros.
-apply pred_ext; intros w ?; hnf in *.
-intros n' ?.
-simpl in H0. destruct (level_later H0) as [w' [? ?]].
-  subst. apply H. auto.
- intros ? ?. simpl in H0. apply H. simpl.
-  apply laterR_level in H0. rewrite laterR_nat; auto.
-Qed.
-
-Lemma subp_derives  :
-  forall (P P' Q Q': pred A),
-    (P' |-- P) ->
-    (Q |-- Q') ->
-    (P >=> Q) |-- (P' >=> Q').
-Proof.
-
-intros.
-intros w ?.
-intros ? ? ? ? ? ? ?.
-apply H0.
-eapply H1; eauto.
-Qed.
-
-Lemma derives_subp  :
-      forall (P Q: pred A) (st: nat), (P |-- Q) -> (P >=> Q) st.
-Proof.
-
-intros.
-intros w' ? w'' ? ?.
-eauto.
-Qed.
-
-Lemma exp_subp' :
-  forall (T: Type) (P Q: T -> pred A) (st: nat),
-                (forall x, (P x >=> Q x) st) -> ((EX x : T, P x) >=> (EX x : T, Q x)) st.
-Proof.
-intros.
-repeat intro.
-destruct H3 as [x ?]; exists x.
-eapply H; eauto.
-Qed.
-
-Lemma fash_fash :  forall P: pred A,  # # P = # P.
-Proof.
-intros.
-apply pred_ext; intro; simpl in *; intros.
-apply H with a; auto.
-subst.
-apply H.
-unfold natLevel in H0. lia.
-Qed.
-
-Lemma fash_subp :
-    forall (P Q: pred A), fashionable (P >=> Q).
-Proof.
-intros.
-unfold fashionable.
-rewrite fash_fash. auto.
-Qed.
-#[local] Hint Resolve fash_subp : core.
-
-Lemma fash_allp :
-  forall  (B: Type) (F: B -> pred A),
-      # (allp F) = allp (fun z: B => # F z).
-Proof.
-intros.
-apply pred_ext; intros w ?.
-intro z.
-intros ? ?.
-eapply H; eauto.
-intros ? ? ?.
-eapply H; auto.
-Qed.
-
- Lemma subp_i1 :
-  forall (P : pred nat) (Q R: pred A ), (!P && Q |-- R) -> P |-- Q >=> R.
-Proof. intros.
- intros n ?. intros ? ? ? ? ? ? ?. apply H. split; auto.
- assert (P (level a')). eapply pred_nec_hereditary; try apply H0.
- apply nec_nat. apply necR_level in H2. lia.
- hnf. apply ext_level in H3 as <-. auto.
-Qed.
-
-Lemma subp_eq :
-  forall (P : pred nat) (Q R: pred A ), (!P && Q |-- R) <-> (P |-- Q >=> R).
-Proof. intros. split; [apply subp_i1|].
-  intros ?? []. eapply H; eauto. auto.
-Qed.
-
-Lemma eqp_nat: forall P Q: pred nat, (P <=> Q) = (P <--> Q).
-Proof.
-intros.
-apply pred_ext; intros w ?.
-specialize (H _ (Nat.le_refl _)); auto.
-intros n' ?. inv H0; auto.
-eapply pred_nec_hereditary; try apply H.
-apply nec_nat.
-unfold level in H1. simpl in H1. unfold natLevel in H1. lia.
-Qed.
-
-Lemma prop_andp_subp :
-  forall (P: Prop) Q R w, (P -> app_pred (Q >=> R) w) -> app_pred ((!!P && Q) >=> R) w.
-Proof.
-intros.
-repeat intro.
-destruct H3.
-apply H in H3.
-eapply H3; eauto.
-Qed.
-
-Lemma subp_e : forall P Q : pred A, (TT |-- P >=> Q) -> P |-- Q.
-Proof.
-intros.
-repeat intro.
-eapply H; eauto.
-Qed.
-
-Lemma eqp_unfash : forall G P Q, G |-- P <=> Q -> G |-- (!P <=> !Q).
-Proof.
-  intros.
-  eapply derives_trans; [apply H|].
-  intros ????.
-  split; intros ?????; eapply H0; eauto; apply necR_level in H2; apply ext_level in H3; simpl; unfold natLevel; lia.
-Qed.
-
-Lemma eqp_subp_subp : forall G (P Q R S : pred A),
-  G |-- P <=> R -> G |-- Q <=> S ->
-  G |-- (P >=> Q) <=> (R >=> S).
-Proof.
-  intros.
-  rewrite fash_triv.
-  apply andp_right; rewrite <- imp_andp_adjoint; eapply subp_trans, subp_trans.
-  - apply andp_left1, eqp_subp2, H.
-  - apply andp_left2, derives_refl.
-  - apply andp_left1, eqp_subp, H0.
-  - apply andp_left1, eqp_subp, H.
-  - apply andp_left2, derives_refl.
-  - apply andp_left1, eqp_subp2, H0.
-Qed.
-
-Lemma eqp_trans : forall G (P Q R : pred A),
-  G |-- P <=> Q -> G |-- Q <=> R ->
-  G |-- P <=> R.
-Proof.
-  intros.
-  eapply subp_eqp; eapply subp_trans; eapply eqp_subp.
-  - apply H.
-  - apply H0.
-  - rewrite eqp_comm; apply H0.
-  - rewrite eqp_comm; apply H.
-Qed.
-
-Lemma eqp_eqp : forall G (P Q R S : pred A),
-  G |-- P <=> R -> G |-- Q <=> S ->
-  G |-- (P <=> Q) <=> (R <=> S).
-Proof.
-  intros.
-  rewrite fash_triv.
-  apply andp_right; rewrite <- imp_andp_adjoint; eapply eqp_trans, eqp_trans.
-  - apply andp_left1; rewrite eqp_comm; apply H.
-  - apply andp_left2, derives_refl.
-  - apply andp_left1, H0.
-  - apply andp_left1, H.
-  - apply andp_left2, derives_refl.
-  - apply andp_left1; rewrite eqp_comm; apply H0.
-Qed.
-
-End Subtypes.
-
-Notation "'#' e" := (fash e) (at level 20, right associativity): pred.
-Notation "'!' e" := (unfash e) (at level 20, right associativity): pred.
-Notation "P '>=>' Q" := (# (P --> Q)) (at level 55, right associativity) : pred.
-Notation "P '<=>' Q" := (# (P <--> Q)) (at level 57, no associativity) : pred.
-
-#[export] Hint Resolve ag_nat : core.
-#[export] Hint Resolve fash_subp : core.
diff --git a/msl/subtypes_sl.v b/msl/subtypes_sl.v
deleted file mode 100644
index e7c463880c..0000000000
--- a/msl/subtypes_sl.v
+++ /dev/null
@@ -1,212 +0,0 @@
-Require Import VST.msl.base.
-Require Import VST.msl.ageable.
-Require Import VST.msl.sepalg.
-Require Import VST.msl.sepalg_generators.
-Require Import VST.msl.age_sepalg.
-Require Import VST.msl.predicates_hered.
-Require Import VST.msl.predicates_sl.
-Require Import VST.msl.subtypes.
-
-Local Open Scope pred.
-
-
-Lemma unfash_derives {A} `{agA : ageable A} {EO: Ext_ord A}:
-  forall {P Q}, (P |-- Q) -> @derives A _ _ (! P) (! Q).
-Proof.
-intros. intros w ?. simpl in *. apply H. auto.
-Qed.
-
-Lemma subp_sepcon {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A} : forall G P P' Q Q',
-  (G |-- P >=> P') ->
-  (G |-- Q >=> Q') ->
-  G |-- P * Q >=> P' * Q'.
-Proof.
-  pose proof I.
-  repeat intro.
-  specialize (H0 _ H2).
-  specialize (H1 _ H2).
-  clear G H2.
-  destruct H6 as [w1 [w2 [? [? ?]]]].
-  exists w1; exists w2; split; auto.
-  destruct (join_level _ _ _ H2); auto.
- apply necR_level in H4. apply ext_level in H5. 
-  split.
-  eapply H0; auto; lia.
-  eapply H1; auto; lia.
-Qed.
-
-Lemma sub_wand {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A} : forall G P P' Q Q',
-  (G |-- P' >=> P) ->
-  (G |-- Q >=> Q') ->
-  G |-- (P -* Q) >=> (P' -* Q').
-Proof.
-  pose proof I.
-  repeat intro.
-  specialize (H0 _ H2); specialize (H1 _ H2); clear G H2; pose (H2:=True).
-  eapply H0 in H9; try apply necR_refl; try apply ext_refl.
-  eapply H1; try apply necR_refl; try apply ext_refl.
-  apply necR_level in H4. apply ext_level in H5. apply necR_level in H7. apply join_level in H8 as []. lia.
-  eapply H6; eauto.
-  apply necR_level in H4. apply ext_level in H5. apply necR_level in H7.
-  apply join_level in H8 as []. lia.
-Qed.
-
-(*Lemma find_superprecise {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}{EO: Ext_ord A}:
-   forall Q, Q |-- EX P:_, P && !(P >=> Q) && !!superprecise (P).
-Proof.
-intros.
-intros w ?.
-exists (exactly w).
-split; auto.
-split; auto.
-hnf; eauto.
-intros w' ? w'' ? ? ? ?.
-hnf in H3.
-destruct H3 as (x & ? & ?).
-apply pred_upclosed with x; auto.
-apply pred_nec_hereditary with w; auto.
-do 3 red.
-apply superprecise_exactly.
-Qed.*)
-
-Lemma sepcon_subp' {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}:
-  forall (P P' Q Q' : pred A) (st: nat),
-    (P >=> P') st ->
-    (Q >=> Q') st ->
-    (P * Q >=> P' * Q') st.
-Proof.
- pose proof I.
-intros.
-intros w' ? w'' ? ?%necR_level ?%ext_level [w1 [w2 [J [? ?]]]].
-destruct (join_level _ _ _ J).
-exists w1; exists w2; repeat split; auto.
-eapply H0; auto; lia.
-eapply H1; auto; lia.
-Qed.
-
-Lemma subp_refl'  {A} `{agA : ageable A} {EO: Ext_ord A} : forall (Q: pred A) (st: nat), (Q >=> Q) st.
-Proof.
-intros.
-intros ? ? ? ?; auto.
-Qed.
-
-Lemma subp_trans' {A} `{agA : ageable A} {EO: Ext_ord A} :
-  forall (B C D: pred A) (w: nat), (B >=> C)%pred w -> (C >=> D)% pred w -> (B >=> D)%pred w.
-Proof.
-intros.
-intros w' ? w'' ? ? ? ?.
-eapply H0; eauto.
-eapply H; eauto.
-Qed.
-
-Lemma andp_subp'  {A} `{agA : ageable A} {EO: Ext_ord A} :
- forall (P P' Q Q': pred A) (w: nat), (P >=> P') w -> (Q >=> Q') w -> (P && Q >=> P' && Q') w.
-Proof.
-intros.
-intros w' ? w'' ? ? ? [? ?]; split.
-eapply H; eauto.
-eapply H0; eauto.
-Qed.
-
-Lemma allp_subp' {A} `{agA : ageable A} {EO: Ext_ord A} : forall T (F G: T -> pred A) (w: nat),
-   (forall x,  (F x >=> G x) w) -> (allp (fun x:T => (F x >=> G x)) w).
-Proof.
-intros.
-intro x; apply H; auto.
-Qed.
-
-
-Lemma pred_eq_e1 {A} `{agA : ageable A} {EO: Ext_ord A}: forall (P Q: pred A) w,
-       ((P <=> Q) w -> (P >=> Q) w).
-Proof.
-intros.
-intros w' ? w'' ? ?.
-eapply H; eauto.
-Qed.
-
-Lemma pred_eq_e2 {A} `{agA : ageable A} {EO: Ext_ord A}: forall (P Q: pred A)  w,
-     ((P <=> Q) w -> (Q >=> P) w).
-Proof.
-Proof.
-intros.
-intros w' ? w'' ? ?.
-eapply H; eauto.
-Qed.
-
-#[export] Hint Resolve sepcon_subp' : core.
-#[export] Hint Resolve subp_refl' : core.
-#[export] Hint Resolve andp_subp' : core.
-#[export] Hint Resolve allp_subp' : core.
-#[export] Hint Resolve derives_subp : core.
-#[export] Hint Resolve pred_eq_e1 : core.
-#[export] Hint Resolve pred_eq_e2 : core.
-
-
-Lemma allp_imp2_later_e2 {B}{A}{agA: ageable A}{EO: Ext_ord A}:
-   forall (P Q: B -> pred A) (y: B) ,
-      (ALL x:B, |> P x <=> |> Q x) |-- |> Q y >=> |> P y.
-Proof.
-  intros.  intros w ?. specialize (H y). apply pred_eq_e2. auto.
-Qed.
-Lemma allp_imp2_later_e1 {B}{A}{agA: ageable A}{EO: Ext_ord A}:
-   forall (P Q: B -> pred A) (y: B) ,
-      (ALL x:B, |> P x <=> |> Q x) |-- |> P y >=> |> Q y.
-Proof.
-  intros.  intros w ?. specialize (H y). apply pred_eq_e1. auto.
-Qed.
-
-(*
-Lemma subp_later {A} `{agA:  ageable A} (SS: natty A):
- forall (P Q: pred A), |> (P >=> Q) |-- |> P >=> |> Q.
-Proof.
-intros.
-rewrite later_fash; auto.
-apply fash_derives.
-apply axiomK.
-Qed.
-*)
-
-Lemma extend_unfash {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A} : forall (P: pred nat), boxy extendM (! P).
-Proof.
-intros.
-apply boxy_i; auto; intros.
-unfold unfash in *.
-simpl in H. destruct H.
-hnf in H0|-*.
-apply join_level in H as [<-]; auto.
-Qed.
-
-#[export] Hint Resolve extend_unfash : core.
-
-Lemma subp_unfash {A} `{Age_alg A} {EO: Ext_ord A}:
-  forall (P Q : pred nat) (n: nat), (P >=> Q) n -> ( ! P >=> ! Q) n.
-Proof.
-intros.
-intros w ?. specialize (H0 _ H1).
-intros w' ? ? ?. apply (H0 _ _ (necR_level' H2)).
-apply ext_level; auto.
-Qed.
-#[export] Hint Resolve subp_unfash : core.
-
-
-Lemma unfash_sepcon_distrib:
-        forall {T}{agT: ageable T}{JoinT: Join T}{PermT: Perm_alg T}{SepT: Sep_alg T}{AgeT: Age_alg T}{EO: Ext_ord T}{EA: Ext_alg T}
-           (P: pred nat) (Q R: pred T),
-               unfash P && (Q*R) = (unfash P && Q) * (unfash P && R).
-Proof.
-intros.
-apply pred_ext.
-intros w [? [w1 [w2 [? [? ?]]]]].
-exists w1; exists w2; repeat split; auto.
-apply join_level in H0. destruct H0.
-hnf in H|-*. congruence.
-apply join_level in H0. destruct H0.
-hnf in H|-*. congruence.
-intros w [w1 [w2 [? [[? ?] [? ?]]]]].
-split.
-apply join_level in H. destruct H.
-hnf in H0|-*. congruence.
-exists w1; exists w2; repeat split; auto.
-Qed.
-
-
diff --git a/msl/tree_shares.v b/msl/tree_shares.v
index 85326db6bb..64d043d5ae 100644
--- a/msl/tree_shares.v
+++ b/msl/tree_shares.v
@@ -1087,7 +1087,7 @@ Module Share <: SHARE_MODEL.
 
   (*** Begin Module Signature Definitions and lemmas ***)
 
-  (* Here we show that canonical share trees form a boolean algrbra.  These
+  (* Here we show that canonical share trees form a boolean algebra.  These
      proofs mainly involve showing that the results above commute in the proper
      ways with mkCanon. *)
   Module BA <: BOOLEAN_ALGEBRA.
@@ -6263,46 +6263,102 @@ Qed.
     apply proof_irr.
  Qed.
 
+ (* For some reason, the proof of decompose_rewrite adds extraneous universe constraints when the
+    lemmas below are inlined. *)
+  Lemma decompose_rewrite_case1' : forall x c c1 c2 b, match x as t' return (t' = x -> canonTree * canonTree) with
+  | Leaf b0 =>
+    fun Heq_t : Leaf b0 = x =>
+    (exist (fun t0 : ShareTree => canonicalTree t0) (Leaf b0) (tree_decompose_obligation_1 x c b0 Heq_t),
+     exist (fun t0 : ShareTree => canonicalTree t0) (Leaf b0) (tree_decompose_obligation_2 x c b0 Heq_t))
+  | Node t1 t2 =>
+    fun Heq_t : Node t1 t2 = x =>
+    (exist (fun t0 : ShareTree => canonicalTree t0) t1 (tree_decompose_obligation_3 x c t1 t2 Heq_t),
+     exist (fun t0 : ShareTree => canonicalTree t0) t2 (tree_decompose_obligation_4 x c t1 t2 Heq_t))
+  end eq_refl =
+  (exist (fun t0 : ShareTree => canonicalTree t0) (Leaf b) c1,
+ exist (fun t0 : ShareTree => canonicalTree t0) (Leaf b) c2) <-> x = Leaf b
+.
+  Proof.
+    intros.
+    split; [|intros ->; f_equal; now apply exist_ext].
+    destruct x; intros [=]; subst; auto.
+    destruct c as (? & ? & ? & ?); simpl in *.
+    destruct H, H0; congruence.
+  Qed.
+
+  Lemma decompose_rewrite_case1 : forall x c x1 c1 x2 c2 b (Hcanon : mkCanon
+           (Node (proj1_sig (exist (fun t : ShareTree => canonicalTree t) x1 c1))
+              (proj1_sig (exist (fun t : ShareTree => canonicalTree t) x2 c2))) = 
+         Leaf b), decompose (exist (fun t0 : ShareTree => canonicalTree t0) x c) =
+  (exist (fun t0 : ShareTree => canonicalTree t0) x1 c1,
+   exist (fun t0 : ShareTree => canonicalTree t0) x2 c2) <-> x = Leaf b.
+  Proof.
+    intros.
+    symmetry in Hcanon; apply mkCanon_Leaf_split in Hcanon as [H1 H2].
+    simpl in *.
+    rewrite (mkCanon_identity _ c1) in H1.
+    rewrite (mkCanon_identity _ c2) in H2.
+    subst; simpl.
+    apply decompose_rewrite_case1'.
+  Qed.
+
+  Lemma decompose_rewrite_case2' : forall x s1 s2 c c1 c2 (Hcanon : match mkCanon s1 with
+         | Leaf b1 =>
+             match mkCanon s2 with
+             | Leaf b2 => if bool_dec b1 b2 then Leaf b1 else Node (mkCanon s1) (mkCanon s2)
+             | Node _ _ => Node (mkCanon s1) (mkCanon s2)
+             end
+         | Node _ _ => Node (mkCanon s1) (mkCanon s2)
+         end = Node s1 s2),
+  match x as t' return (t' = x -> canonTree * canonTree) with
+  | Leaf b =>
+    fun Heq_t : Leaf b = x =>
+    (exist (fun t0 : ShareTree => canonicalTree t0) (Leaf b) (tree_decompose_obligation_1 x c b Heq_t),
+     exist (fun t0 : ShareTree => canonicalTree t0) (Leaf b) (tree_decompose_obligation_2 x c b Heq_t))
+  | Node t1 t2 =>
+    fun Heq_t : Node t1 t2 = x =>
+    (exist (fun t0 : ShareTree => canonicalTree t0) t1 (tree_decompose_obligation_3 x c t1 t2 Heq_t),
+     exist (fun t0 : ShareTree => canonicalTree t0) t2 (tree_decompose_obligation_4 x c t1 t2 Heq_t))
+  end eq_refl =
+  (exist (fun t0 : ShareTree => canonicalTree t0) s1 c1,
+   exist (fun t0 : ShareTree => canonicalTree t0) s2 c2) <-> x = Node s1 s2.
+  Proof.
+    intros.
+    split; [|intros ->; f_equal; now apply exist_ext].
+    destruct x; intros [=]; subst; auto; simpl in *.
+    destruct bool_dec; auto; contradiction.
+  Qed.
+
+  Lemma decompose_rewrite_case2 : forall x c x1 c1 x2 c2 s1 s2 (Hcanon : mkCanon
+           (Node (proj1_sig (exist (fun t : ShareTree => canonicalTree t) x1 c1))
+              (proj1_sig (exist (fun t : ShareTree => canonicalTree t) x2 c2))) = 
+         Node s1 s2),
+  decompose (exist (fun t0 : ShareTree => canonicalTree t0) x c) =
+  (exist (fun t0 : ShareTree => canonicalTree t0) x1 c1,
+   exist (fun t0 : ShareTree => canonicalTree t0) x2 c2) <-> x = Node s1 s2.
+  Proof.
+    intros.
+    destruct (mkCanon_split _ _ _ _ Hcanon) as [H1 H2].
+    simpl in *.
+    rewrite (mkCanon_identity _ c1) in H1.
+    rewrite (mkCanon_identity _ c2) in H2.
+    subst; simpl.
+    apply decompose_rewrite_case2'; auto.
+  Qed.
+
+  Lemma exist_ext' : forall A (P : A -> Prop) x y Hx Hy, exist P x Hx = exist P y Hy <-> x = y.
+  Proof.
+    split; [now inversion 1 | now apply exist_ext].
+  Qed.
 
  Lemma decompose_rewrite : forall t t1 t2, decompose t = (t1 ,t2)
        <-> t = exist (fun t => canonicalTree t)
               (mkCanon (Node (proj1_sig t1) (proj1_sig t2))) (mkCanon_correct _).
  Proof.
-  intros.
-  destruct t0 as [x c];
-  destruct t1 as [x1 c1];
-  destruct t2 as [x2 c2].
-  icase x.
-
-  simpl.
-  split;intros; inv H;
-  generalize (mkCanon_identity _ c1);intro;
-  generalize (mkCanon_identity _ c2);intro.
-  apply exist_ext.
-  rewrite H.
-  icase b.
-
-  f_equal;
-  apply exist_ext;
-  rewrite H in H1;rewrite H0 in H1;
-  icase x1;icase x2;
-  icase b0;icase b1.
-
-  split;intro;
-  try apply exist_ext;
-  simpl in H,c;
-  destruct c as [? [? [? ?]]];
-  inv H;
-  simpl;
-  generalize (mkCanon_identity _ c1);intro;
-  generalize (mkCanon_identity _ c2);intro.
-  rewrite H;rewrite H0.
-  icase x1;icase x2.
-  icase b;icase b0;
-  exfalso; firstorder with bool.
-  f_equal;apply exist_ext;
-  rewrite H in H1;rewrite H0 in H1;
-  icase x1;icase x2;try icase b;try icase b0;inv H1;auto.
+  intros [x c] ??; rewrite exist_ext'.
+  destruct (mkCanon _) eqn: Hcanon.
+  - destruct t1, t2; now apply decompose_rewrite_case1.
+  - destruct t1, t2; now apply decompose_rewrite_case2.
  Qed.
  (*L4*)
  Lemma decompose_height : forall n t1 t2 t3,
@@ -7471,13 +7527,18 @@ Proof.
  trivial.
 Qed.
 
+Lemma exist_pair_eq : forall t1 t2 c1 c2 c1' c2', (exist (fun t0 : ShareTree => canonicalTree t0) t1 c1,
+ exist (fun t0 : ShareTree => canonicalTree t0) t2 c2) =
+(exist (fun t0 : ShareTree => canonicalTree t0) t1 c1',
+ exist (fun t0 : ShareTree => canonicalTree t0) t2 c2').
+Proof.
+  intros; f_equal; apply exist_ext; auto.
+Qed.
+
 Lemma decompose_basic: forall b c c1 c2,
  decompose (exist _ (Leaf b) c) = (exist _ (Leaf b) c1,exist _ (Leaf b) c2).
 Proof.
- intros.
- unfold decompose,decompose_tree.
- simpl. f_equal. f_equal.
- f_equal.
+  intros; apply exist_pair_eq.
 Qed.
 
 Lemma decompose_top: decompose top = (top,top).
@@ -7493,12 +7554,7 @@ Qed.
 Lemma decompose_Node: forall t1 t2 c c1 c2,
  decompose (exist _ (Node t1 t2) c) = (exist _ t1 c1, exist _ t2 c2).
 Proof.
- intros.
- unfold decompose. unfold decompose_tree.
- unfold tree_decompose.
- destruct c as [? [? [? ?]]].
- f_equal. f_equal.
- f_equal.
+ intros; apply exist_pair_eq.
 Qed.
 
 Lemma identity_bot: forall s, identity s <-> s = bot.
diff --git a/msl/wandQ_frame.v b/msl/wandQ_frame.v
deleted file mode 100644
index d767e02f15..0000000000
--- a/msl/wandQ_frame.v
+++ /dev/null
@@ -1,97 +0,0 @@
-Require Import VST.msl.seplog.
-Require Import VST.msl.alg_seplog.
-Require Import VST.msl.log_normalize.
-Require Import VST.msl.wand_frame.
-Local Open Scope logic.
-
-Lemma wandQ_frame_refine {A} {ND: NatDed A} {SL: SepLog A}: forall B C (P: B -> A) (f: C -> B),
-  allp P |-- allp (fun c => P (f c)).
-Proof.
-  intros.
-  apply allp_right; intros c.
-  apply (allp_left _ (f c)).
-  auto.
-Qed.
-
-Lemma wandQ_frame_intro {A} {ND: NatDed A} {SL: SepLog A}: forall B (P: B -> A) (Q: A),
-  Q |-- allp (P -* P * (fun _ => Q)).
-Proof.
-  intros. simpl.
-  apply allp_right; intros a.
-  apply wand_frame_intro.
-Qed.
-
-Lemma wandQ_frame_intro' {A} {ND: NatDed A} {SL: SepLog A}: forall B (P: B -> A) (Q: A) (R: B -> A),
-  (forall x: B, P x * Q |-- R x) ->
-  Q |-- allp (P -* R).
-Proof.
-  intros. simpl.
-  apply allp_right; intros a.
-  apply wand_frame_intro'.
-  apply H.
-Qed.
-
-Lemma wandQ_frame_elim {A} {ND: NatDed A} {SL: SepLog A}: forall B (P Q: B -> A) (a: B),
-  P a * allp (P -* Q) |-- Q a.
-Proof.
-  intros.
-  rewrite sepcon_comm.
-  apply wand_sepcon_adjoint.
-  apply (allp_left _ a); simpl. auto.
-Qed.
-
-Lemma wandQ_frame_ver {A} {ND: NatDed A} {SL: SepLog A}: forall B (P Q R: B -> A),
-  allp (P -* Q) * allp (Q -* R) |-- allp (P -* R).
-Proof.
-  intros.
-  apply allp_right; intros a.
-  apply <- wand_sepcon_adjoint.
-  apply (allp_left _ a).
-  apply -> wand_sepcon_adjoint.
-  rewrite sepcon_comm.
-  apply <- wand_sepcon_adjoint.
-  apply (allp_left _ a).
-  apply -> wand_sepcon_adjoint.
-  rewrite sepcon_comm.
-  apply wand_frame_ver.
-Qed.
-
-Lemma wandQ_frame_hor {A} {ND: NatDed A} {SL: SepLog A}: forall B (P1 P2 Q1 Q2: B -> A),
-  allp (P1 -* Q1) * allp (P2 -* Q2) |-- allp (P1 * P2 -* Q1 * Q2).
-Proof.
-  intros.
-  apply allp_right; intros a.
-  apply <- wand_sepcon_adjoint.
-  apply (allp_left _ a).
-  apply -> wand_sepcon_adjoint.
-  rewrite sepcon_comm.
-  apply <- wand_sepcon_adjoint.
-  apply (allp_left _ a).
-  apply -> wand_sepcon_adjoint.
-  rewrite sepcon_comm.
-  apply wand_frame_hor.
-Qed.
-
-Lemma wandQ_frame_frame {A} {ND: NatDed A} {SL: SepLog A}: forall B (P Q F: B -> A),
-  allp (P -* Q) |-- allp (P * F -* Q * F).
-Proof.
-  intros.
-  apply allp_right; intros a.
-  apply (allp_left _ a).
-  apply wand_frame_frame.
-Qed.
-
-Lemma sepcon_wandQ_eq {A} {ND: NatDed A} {SL: SepLog A}: forall B (P: B -> A) (Q: A) (a: B),
-  P a * (ALL b: B, P b -* P b * Q) = P a * Q.
-Proof.
-  intros.
-  apply pred_ext.
-  + rewrite sepcon_comm.
-    apply wand_sepcon_adjoint.
-    apply (allp_left _ a).
-    auto.
-  + apply sepcon_derives; auto.
-    apply allp_right; intros.
-    apply wand_sepcon_adjoint.
-    rewrite sepcon_comm; auto.
-Qed.
diff --git a/msl/wand_frame.v b/msl/wand_frame.v
deleted file mode 100644
index 36390b691c..0000000000
--- a/msl/wand_frame.v
+++ /dev/null
@@ -1,67 +0,0 @@
-Require Import VST.msl.seplog.
-Require Import VST.msl.log_normalize.
-Local Open Scope logic.
-
-Lemma wand_frame_intro {A} {ND: NatDed A} {SL: SepLog A}: forall (P Q: A),
-  Q |-- P -* P * Q.
-Proof.
-  intros.
-  apply wand_sepcon_adjoint.
-  rewrite sepcon_comm; auto.
-Qed.
-
-Lemma wand_frame_intro' {A} {ND: NatDed A} {SL: SepLog A}: forall (P Q R: A),
-  (P * Q |-- R) ->
-  Q |-- P -* R.
-Proof.
-  intros.
-  apply wand_sepcon_adjoint.
-  rewrite sepcon_comm; auto.
-Qed.
-
-Lemma wand_frame_elim {A} {ND: NatDed A} {SL: SepLog A}: forall (P Q: A),
-  P * (P -* Q) |-- Q.
-Proof.
-  intros.
-  rewrite sepcon_comm.
-  apply wand_sepcon_adjoint; auto.
-Qed.
-
-Lemma wand_frame_elim' {A} {ND: NatDed A} {SL: SepLog A}: forall (P P' Q: A),
-  (P |-- P') -> P * (P' -* Q) |-- Q.
-Proof.
-  intros.
-  rewrite sepcon_comm.
-  apply wand_sepcon_adjoint; auto.
-  apply wand_derives; auto.
-Qed.
-
-Lemma wand_frame_ver {A} {ND: NatDed A} {SL: SepLog A}: forall (P Q R: A),
-  (P -* Q) * (Q -* R) |-- P -* R.
-Proof.
-  intros.
-  apply -> wand_sepcon_adjoint.
-  rewrite (sepcon_comm _ P), <- sepcon_assoc.
-  eapply derives_trans.
-  + eapply sepcon_derives; [apply wand_frame_elim | apply derives_refl].
-  + apply wand_frame_elim.
-Qed.
-
-Lemma wand_frame_hor {A} {ND: NatDed A} {SL: SepLog A}: forall (P1 P2 Q1 Q2: A),
-  (P1 -* Q1) * (P2 -* Q2) |-- P1 * P2 -* Q1 * Q2.
-Proof.
-  intros.
-  apply -> wand_sepcon_adjoint.
-  rewrite <- (sepcon_assoc _ P1), (sepcon_comm _ P1), <- (sepcon_assoc P1), (sepcon_assoc _ _ P2), (sepcon_comm _ P2).
-  apply sepcon_derives; apply wand_frame_elim.
-Qed.
-
-Lemma wand_frame_frame {A} {ND: NatDed A} {SL: SepLog A}: forall (P Q F: A),
-  P -* Q |-- P * F -* Q * F.
-Proof.
-  intros.
-  apply -> wand_sepcon_adjoint.
-  rewrite <- sepcon_assoc, (sepcon_comm _ P).
-  apply sepcon_derives; [apply wand_frame_elim | auto].
-Qed.
-
diff --git a/progs/VSUpile/PileModel.v b/progs/VSUpile/PileModel.v
index f805750ba8..977e514477 100644
--- a/progs/VSUpile/PileModel.v
+++ b/progs/VSUpile/PileModel.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 
 (*Model-level definitions and associated lemmas.*)
 
diff --git a/progs/VSUpile/fast/spec_fastpile.v b/progs/VSUpile/fast/spec_fastpile.v
index 2d02567019..07cd721e79 100644
--- a/progs/VSUpile/fast/spec_fastpile.v
+++ b/progs/VSUpile/fast/spec_fastpile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import fastpile.
 Require Import spec_stdlib.
 Require Import PileModel.
diff --git a/progs/VSUpile/fast/spec_fastpile_private.v b/progs/VSUpile/fast/spec_fastpile_private.v
index b8a2a81445..c0b2032ca9 100644
--- a/progs/VSUpile/fast/spec_fastpile_private.v
+++ b/progs/VSUpile/fast/spec_fastpile_private.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import fastpile.
 Require Import spec_stdlib.
 Require Import spec_fastpile.
diff --git a/progs/VSUpile/fast/verif_fastapile.v b/progs/VSUpile/fast/verif_fastapile.v
index 0c508446d5..4bf8ff7cf4 100644
--- a/progs/VSUpile/fast/verif_fastapile.v
+++ b/progs/VSUpile/fast/verif_fastapile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import fastapile.
 Require Import spec_stdlib.
@@ -40,8 +41,8 @@ apply derives_refl.
 Qed.
 
 Lemma apile_Init: VSU_initializer prog (apile nil).
-  Proof. 
-    InitGPred_tac.  rewrite sepcon_emp.
+  Proof.
+    InitGPred_tac.  rewrite sep_emp.
     apply make_apile; auto.
 Qed.
 
@@ -74,14 +75,13 @@ forward_call (gv _a_pile, sigma).
 forward.
 Qed.
 
-Definition ApileVSU: @VSU NullExtension.Espec 
+Definition ApileVSU: VSU
       nil apile_imported_specs ltac:(QPprog prog) Apile_ASI (apile nil).
-  Proof. 
-    mkVSU prog apile_internal_specs.
-    + solve_SF_internal body_Apile_add.
-    + solve_SF_internal body_Apile_count.
-    + apply apile_Init.
-  Qed.
+Proof.
+  mkVSU prog apile_internal_specs.
+  + solve_SF_internal body_Apile_add.
+  + solve_SF_internal body_Apile_count.
+  + apply apile_Init.
+Qed.
 
 End Apile_VSU.
-
diff --git a/progs/VSUpile/fast/verif_fastcore.v b/progs/VSUpile/fast/verif_fastcore.v
index 7b8d441bd6..ec04effbea 100644
--- a/progs/VSUpile/fast/verif_fastcore.v
+++ b/progs/VSUpile/fast/verif_fastcore.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 
 Require Import spec_stdlib.
@@ -15,13 +16,13 @@ Definition PILE: spec_fastpile.PileAPD := spec_fastpile_private.pilepreds PrivPI
 Definition ONEPILE : spec_onepile.OnePileAPD := ONEPILE PILE.
 
 Definition Onepile_Pile_VSU :=
-  ltac:(linkVSUs (PilePrivateVSU M) (OnepileVSU M PILE) ). 
+  ltac:(linkVSUs (PilePrivateVSU M) (OnepileVSU M PILE)).
 
 Definition Apile_Onepile_Pile_VSU :=
-  ltac:(linkVSUs (Onepile_Pile_VSU) (ApileVSU M PrivPILE)). 
+  ltac:(linkVSUs (Onepile_Pile_VSU) (ApileVSU M PrivPILE)).
 
 Definition Triang_Apile_Onepile_Pile_VSU :=
-  ltac:(linkVSUs Apile_Onepile_Pile_VSU (TriangVSU M PILE)). 
+  ltac:(linkVSUs Apile_Onepile_Pile_VSU (TriangVSU M PILE)).
 
 Definition Core_VSU :=
   ltac:(linkVSUs MallocFreeVSU Triang_Apile_Onepile_Pile_VSU).
diff --git a/progs/VSUpile/fast/verif_fastmain.v b/progs/VSUpile/fast/verif_fastmain.v
index 4da3009605..7ba6968884 100644
--- a/progs/VSUpile/fast/verif_fastmain.v
+++ b/progs/VSUpile/fast/verif_fastmain.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.veric.initial_world.
 Require Import VST.floyd.VSU.
 
@@ -50,7 +51,7 @@ forward_call (10,gv).
 forward.
 Qed.
 
-Definition MainComp:  MainCompType nil main_QPprog Core_VSU whole_prog (snd (main_spec whole_prog))  emp.
+Definition MainComp:  MainCompType nil main_QPprog Core_VSU whole_prog (snd (main_spec whole_prog)) (fun _ => emp).
 Proof.
 mkComponent prog.
 solve_SF_internal body_main.
diff --git a/progs/VSUpile/fast/verif_fastonepile.v b/progs/VSUpile/fast/verif_fastonepile.v
index 5370643bc4..c4195e436a 100644
--- a/progs/VSUpile/fast/verif_fastonepile.v
+++ b/progs/VSUpile/fast/verif_fastonepile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import onepile.
 Require Import spec_stdlib.
@@ -83,10 +84,10 @@ Lemma onepile_Init_aux gv: headptr (gv _the_pile) ->
     |-- data_at_ Ews (tptr (Tstruct _pile noattr)) (gv _the_pile).
 Proof. intros.
     unfold globvar2pred. simpl.
-         rewrite sepcon_emp.
+         rewrite sep_emp.
     destruct H as [b Hb]; rewrite Hb in *.
     eapply derives_trans. 
-    + apply mapsto_zeros_memory_block. apply writable_readable. apply writable_Ews.
+    + apply mapsto_zeros_memory_block.
     + rewrite <- memory_block_data_at_; simpl; trivial.
       apply headptr_field_compatible; trivial. exists b; trivial. cbv; trivial. simpl; rep_lia.
       econstructor. reflexivity. apply Z.divide_0_r.
@@ -95,15 +96,14 @@ Qed.
 Lemma onepile_Init: VSU_initializer prog (one_pile None).
 Proof. InitGPred_tac. unfold one_pile. normalize. apply data_at_data_at_. Qed.
 
-Definition OnepileVSU: @VSU NullExtension.Espec
+Definition OnepileVSU: VSU
       nil onepile_imported_specs ltac:(QPprog prog) Onepile_ASI (one_pile None).
-  Proof.
-    mkVSU prog onepile_internal_specs. 
-    + solve_SF_internal body_Onepile_init.
-    + solve_SF_internal body_Onepile_add.
-    + solve_SF_internal body_Onepile_count.
-    + apply onepile_Init.
-  Qed.
+Proof.
+  mkVSU prog onepile_internal_specs.
+  + solve_SF_internal body_Onepile_init.
+  + solve_SF_internal body_Onepile_add.
+  + solve_SF_internal body_Onepile_count.
+  + apply onepile_Init.
+Qed.
 
 End Onepile_VSU.
-
diff --git a/progs/VSUpile/fast/verif_fastpile.v b/progs/VSUpile/fast/verif_fastpile.v
index 4d684dc897..157cbf8808 100644
--- a/progs/VSUpile/fast/verif_fastpile.v
+++ b/progs/VSUpile/fast/verif_fastpile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import fastpile.
 Require Import spec_stdlib.
@@ -151,18 +152,19 @@ forward_call (malloc_spec_sub M t) gv.
 Intros p.
 if_tac.
 { subst.
-  forward_if False.
+  forward_if False%type.
   - forward_call 1. contradiction.
-  - congruence. }
-forward_if True.
+  - congruence.
+  - forward. }
+forward_if True%type.
 + contradiction.
 + forward. entailer!.
 + forward. Exists p. entailer!.
 Qed.
 
-  Definition PileVSU: @VSU NullExtension.Espec
-      nil pile_imported_specs ltac:(QPprog prog) Pile_ASI emp.
-  Proof. 
+  Definition PileVSU: VSU
+      nil pile_imported_specs ltac:(QPprog prog) Pile_ASI (fun _ => emp).
+  Proof.
     mkVSU prog pile_internal_specs.
     + solve_SF_internal body_surely_malloc.
     + solve_SF_internal body_Pile_new.
@@ -171,9 +173,9 @@ Qed.
     + solve_SF_internal body_Pile_free.
   Qed.
 
-  Definition PilePrivateVSU: @VSU NullExtension.Espec
-      nil pile_imported_specs ltac:(QPprog prog) (FastpilePrivateASI M PILEPRIV) emp.
-  Proof. 
+  Definition PilePrivateVSU: VSU
+      nil pile_imported_specs ltac:(QPprog prog) (FastpilePrivateASI M PILEPRIV) (fun _ => emp).
+  Proof.
     mkVSU prog pile_internal_specs.
     + solve_SF_internal body_surely_malloc.
     + solve_SF_internal body_Pile_new.
@@ -183,4 +185,3 @@ Qed.
   Qed.
 
 End Pile_VSU.
-
diff --git a/progs/VSUpile/fast/verif_fasttriang.v b/progs/VSUpile/fast/verif_fasttriang.v
index f66930ef49..b6c8e89f29 100644
--- a/progs/VSUpile/fast/verif_fasttriang.v
+++ b/progs/VSUpile/fast/verif_fasttriang.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import triang.
 Require Import spec_stdlib.
@@ -52,9 +53,9 @@ reflexivity.
 simpl. congruence.
 Qed.
 
-  Definition TriangVSU: @VSU NullExtension.Espec
-      nil triang_imported_specs ltac:(QPprog prog) (TriangASI M) emp.
-  Proof. 
+  Definition TriangVSU: VSU
+      nil triang_imported_specs ltac:(QPprog prog) (TriangASI M) (fun _ => emp).
+  Proof.
     mkVSU prog triang_internal_specs.
     + solve_SF_internal body_Triang_nth.
   Qed.
diff --git a/progs/VSUpile/incr/verif_incr.v b/progs/VSUpile/incr/verif_incr.v
index be287b342e..7a7da46ae4 100644
--- a/progs/VSUpile/incr/verif_incr.v
+++ b/progs/VSUpile/incr/verif_incr.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import incr.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
@@ -32,6 +33,7 @@ Lemma sub_incr12:
   funspec_sub (snd incr2_spec)  (snd incr1_spec).
 Proof.
 do_funspec_sub. destruct w as [[[i a] sh] data]. clear H.
+rewrite <- fupd_intro.
 Exists (i,a) (data_at sh (tarray tuint 10) data a). simpl; entailer!.
 intros tau ? ?. Exists data.
 entailer!.
@@ -66,8 +68,9 @@ Lemma sub_incr34:
   funspec_sub (snd incr4_spec)  (snd incr3_spec).
 Proof.
 do_funspec_sub. destruct w as [[[i gv] sh] data]. clear H.
+rewrite <- fupd_intro.
 Exists i (data_at sh (tarray tuint 10) data (gv _global_auxdata)).
 simpl; entailer!.
 intros tau ? ?. Exists data.
 entailer!.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/progs/VSUpile/simple_spec_apile.v b/progs/VSUpile/simple_spec_apile.v
index c1c5615406..c5ae19943e 100644
--- a/progs/VSUpile/simple_spec_apile.v
+++ b/progs/VSUpile/simple_spec_apile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import apile.
 Require Import simple_spec_stdlib.
 Require Import simple_spec_pile.
diff --git a/progs/VSUpile/simple_spec_main.v b/progs/VSUpile/simple_spec_main.v
index 5928e79b10..03876460af 100644
--- a/progs/VSUpile/simple_spec_main.v
+++ b/progs/VSUpile/simple_spec_main.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.  (* Need this, otherwise get wrong version of main_pre *)
 Require Import main.
 
@@ -11,5 +12,3 @@ Definition main_spec p :=
     LOCAL(temp ret_temp (Vint (Int.repr 0)))
     SEP(TT).
 (*Refine postcondition to ...   SEP(spec_stdlib.mem_mgr gv; has_ext tt).?*)
-
-
diff --git a/progs/VSUpile/simple_spec_onepile.v b/progs/VSUpile/simple_spec_onepile.v
index d40dd60508..3aefc6416e 100644
--- a/progs/VSUpile/simple_spec_onepile.v
+++ b/progs/VSUpile/simple_spec_onepile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import onepile.
 Require Import simple_spec_stdlib.
 Require Import simple_spec_pile.
diff --git a/progs/VSUpile/simple_spec_pile.v b/progs/VSUpile/simple_spec_pile.v
index ffcffe54b2..defdbc6b19 100644
--- a/progs/VSUpile/simple_spec_pile.v
+++ b/progs/VSUpile/simple_spec_pile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import pile.
 #[export] Instance PileCompSpecs : compspecs. make_compspecs prog. Defined.
 Require Import simple_spec_stdlib.
diff --git a/progs/VSUpile/simple_spec_stdlib.v b/progs/VSUpile/simple_spec_stdlib.v
index bccc09b28a..69b18253a9 100644
--- a/progs/VSUpile/simple_spec_stdlib.v
+++ b/progs/VSUpile/simple_spec_stdlib.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import stdlib.
 
 
@@ -23,17 +24,14 @@ Proof. intros. unfold malloc_token.
 Qed.
 
 #[export] Hint Resolve malloc_token'_valid_pointer : valid_pointer.
+#[export] Hint Resolve malloc_token'_local_facts : saturate_local.
 #[export] Hint Resolve malloc_token_valid_pointer : valid_pointer.
 
 Lemma malloc_token_local_facts:  forall {cs: compspecs} sh t p,
       malloc_token sh t p |-- !! (field_compatible t [] p /\ malloc_compatible (sizeof t) p).
 Proof. intros.
- unfold malloc_token.
- normalize. rewrite prop_and.
- apply andp_right. apply prop_right; auto.
- apply malloc_token'_local_facts.
+ unfold malloc_token. entailer!.
 Qed.
-#[export] Hint Resolve malloc_token'_local_facts : saturate_local.
 #[export] Hint Resolve malloc_token_local_facts : saturate_local.
 
 Definition malloc_spec' :=
@@ -107,7 +105,8 @@ Lemma malloc_spec_sub:
    funspec_sub (snd malloc_spec') (snd (malloc_spec t)).
 Proof.
 do_funspec_sub. rename w into gv. clear H.
-Exists (sizeof t, gv) emp. simpl; entailer!.
+rewrite <- fupd_intro.
+Exists (sizeof t, gv) (emp : mpred). simpl; entailer!.
 intros tau ? ?. Exists (eval_id ret_temp tau).
 entailer!.
 if_tac; auto.
@@ -124,7 +123,8 @@ Lemma free_spec_sub:
    funspec_sub (snd free_spec') (snd (free_spec t)).
 Proof.
 do_funspec_sub. destruct w as [p gv]. clear H.
-Exists (sizeof t, p, gv) emp. simpl; entailer!.
+rewrite <- fupd_intro.
+Exists (sizeof t, p, gv) (emp : mpred). simpl; entailer!.
 if_tac; trivial.
 sep_apply data_at__memory_block_cancel.
 unfold malloc_token; entailer!.
diff --git a/progs/VSUpile/simple_spec_triang.v b/progs/VSUpile/simple_spec_triang.v
index 885b022682..93751154cb 100644
--- a/progs/VSUpile/simple_spec_triang.v
+++ b/progs/VSUpile/simple_spec_triang.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import triang.
 Require Import simple_spec_stdlib.
 Require Import PileModel.
diff --git a/progs/VSUpile/simple_verif_apile.v b/progs/VSUpile/simple_verif_apile.v
index 764b679547..60d8573b15 100644
--- a/progs/VSUpile/simple_verif_apile.v
+++ b/progs/VSUpile/simple_verif_apile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import apile.
 Require Import simple_spec_stdlib.
@@ -6,9 +7,9 @@ Require Import simple_spec_pile.
 Require Import simple_spec_apile.
 
 
-Lemma make_apile: forall gv, 
+Lemma make_apile: forall gv,
      globals_ok gv ->
-    @data_at APileCompSpecs Ews size_t nullval
+    data_at(cs := APileCompSpecs) Ews size_t nullval
           (gv _a_pile) |-- apile nil gv.
 Proof.
 intros. unfold apile, pilerep.
@@ -26,7 +27,7 @@ Qed.
 
 Lemma apile_Init: VSU_initializer prog (apile nil).
   Proof. 
-    InitGPred_tac.  rewrite sepcon_emp.
+    InitGPred_tac.  rewrite sep_emp.
     apply make_apile; auto.
 Qed.
 
@@ -52,11 +53,11 @@ start_function.
 unfold apile in *; Intros.
 forward_call (gv _a_pile, sigma).
 forward.
-Qed. 
+Qed.
 
-  Definition ApileVSU: @VSU NullExtension.Espec 
-      nil apile_imported_specs ltac:(QPprog prog) ApileASI (apile nil) .
-  Proof. 
+  Definition ApileVSU: VSU
+      nil apile_imported_specs ltac:(QPprog prog) ApileASI (apile nil).
+  Proof.
     mkVSU prog apile_internal_specs. 
     + solve_SF_internal body_Apile_add.
     + solve_SF_internal body_Apile_count.
diff --git a/progs/VSUpile/simple_verif_main.v b/progs/VSUpile/simple_verif_main.v
index 3126195140..72ccd4ea26 100644
--- a/progs/VSUpile/simple_verif_main.v
+++ b/progs/VSUpile/simple_verif_main.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 
 Require Import PileModel. (*needed for decreasing etc*)
@@ -17,13 +18,13 @@ Require Import simple_verif_apile.
 Require Import simple_verif_triang.
 
 Definition Onepile_Pile_VSU :=
-  ltac:(linkVSUs PileVSU OnepileVSU). 
+  ltac:(linkVSUs PileVSU OnepileVSU).
 
 Definition Apile_Onepile_Pile_VSU :=
-  ltac:(linkVSUs Onepile_Pile_VSU ApileVSU). 
+  ltac:(linkVSUs Onepile_Pile_VSU ApileVSU).
 
 Definition Triang_Apile_Onepile_Pile_VSU :=
-  ltac:(linkVSUs Apile_Onepile_Pile_VSU TriangVSU). 
+  ltac:(linkVSUs Apile_Onepile_Pile_VSU TriangVSU).
 
 Definition Core_VSU :=
   ltac:(linkVSUs MallocFreeVSU Triang_Apile_Onepile_Pile_VSU).
@@ -63,7 +64,7 @@ forward_call (10,gv).
 forward.
 Qed.
 
-Definition MainComp:  MainCompType nil main_QPprog Core_VSU whole_prog (snd (main_spec whole_prog))  emp.
+Definition MainComp:  MainCompType nil main_QPprog Core_VSU whole_prog (snd (main_spec whole_prog)) (fun _ => emp).
 Proof.
 mkComponent prog.
 solve_SF_internal body_main.
@@ -76,4 +77,3 @@ Lemma WholeProgSafe: WholeProgSafeType WholeComp tt.
 Proof. proveWholeProgSafe. Qed.
 
 Eval red in WholeProgSafeType WholeComp tt.
-
diff --git a/progs/VSUpile/simple_verif_onepile.v b/progs/VSUpile/simple_verif_onepile.v
index c10a64347c..016df99637 100644
--- a/progs/VSUpile/simple_verif_onepile.v
+++ b/progs/VSUpile/simple_verif_onepile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import onepile.
 Require Import simple_spec_stdlib.
@@ -54,7 +55,7 @@ Lemma onepile_Init: VSU_initializer prog (onepile None).
 Proof. InitGPred_tac. normalize. apply data_at_data_at_. Qed.
 
 
-Definition OnepileVSU: @VSU NullExtension.Espec
+Definition OnepileVSU: VSU
       nil onepile_imported_specs ltac:(QPprog prog) OnepileASI (onepile None).
   Proof.
     mkVSU prog onepile_internal_specs. 
diff --git a/progs/VSUpile/simple_verif_pile.v b/progs/VSUpile/simple_verif_pile.v
index 546288efd7..f5a895a527 100644
--- a/progs/VSUpile/simple_verif_pile.v
+++ b/progs/VSUpile/simple_verif_pile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import pile.
 Require Import simple_spec_stdlib.
@@ -33,7 +34,7 @@ Proof.
 start_function.
 forward_call (malloc_spec_sub t) gv.
 Intros p.
-if_tac; [ forward_if False | forward_if True ].
+if_tac; [ forward_if False%type | forward_if True%type ].
 all: finish.
 Qed.
 
@@ -83,7 +84,7 @@ forward_loop (EX r:val, EX s2: list Z,
 -
 Exists head sigma.
 entailer!. rewrite Z.sub_diag. auto.
-apply wand_sepcon_adjoint. cancel.
+auto.
 -
 Intros r s2.
 forward_if (r<>nullval).
@@ -94,11 +95,11 @@ forward.
 entailer!.
 assert (s2=nil) by intuition; subst s2.
 simpl. rewrite Z.sub_0_r; auto.
-sep_apply (modus_ponens_wand (listrep s2 nullval)).
+sep_apply (modus_ponens_wand _ (listrep s2 nullval)).
 cancel.
 Intros.
 destruct s2.
-assert_PROP False; [ | contradiction]. {
+assert_PROP False%type; [ | contradiction]. {
  entailer!. assert (r=nullval) by intuition; subst r. congruence.
 }
 unfold listrep at 3; fold listrep.
@@ -127,13 +128,8 @@ simpl in H0.
  }
  rep_lia.
  f_equal; f_equal; lia.
-apply -> wand_sepcon_adjoint.
-match goal with |- (_ * ?A * ?B * ?C)%logic |-- _ => 
- assert ((A * B * C)%logic |-- listrep (z::s2) r) end.
+iIntros "(H & ? & ?) ?"; iApply "H"; iStopProof.
 unfold listrep at 2; fold listrep. Exists r'. entailer!.
-sep_apply H10.
-sep_apply modus_ponens_wand.
-auto.
  -
 forward.
 unfold pilerep.
@@ -156,7 +152,7 @@ forward_while (EX q:val, EX s2: list Z,
 { Exists head sigma; entailer!. }
 { entailer!. }
 { destruct s2.
-   assert_PROP False; [|contradiction]. unfold listrep. entailer!.
+   assert_PROP False%type; [|contradiction]. unfold listrep. entailer!.
   unfold listrep; fold listrep.
   Intros y.
   forward.
@@ -177,14 +173,13 @@ unfold listrep.
 entailer!.
 Qed.
 
-Definition PileVSU: @VSU NullExtension.Espec 
-      nil pile_imported_specs ltac:(QPprog prog) PileASI emp.
-  Proof. 
-    mkVSU prog pile_internal_specs.
-    + solve_SF_internal body_surely_malloc.
-    + solve_SF_internal body_Pile_new.
-    + solve_SF_internal body_Pile_add.
-    + solve_SF_internal body_Pile_count.
-    + solve_SF_internal body_Pile_free.
-  Qed.
-
+Definition PileVSU: VSU
+      nil pile_imported_specs ltac:(QPprog prog) PileASI (fun _ => emp).
+Proof.
+  mkVSU prog pile_internal_specs.
+  + solve_SF_internal body_surely_malloc.
+  + solve_SF_internal body_Pile_new.
+  + solve_SF_internal body_Pile_add.
+  + solve_SF_internal body_Pile_count.
+  + solve_SF_internal body_Pile_free.
+Qed.
diff --git a/progs/VSUpile/simple_verif_stdlib.v b/progs/VSUpile/simple_verif_stdlib.v
index 7c63e44f23..c0abfbadb6 100644
--- a/progs/VSUpile/simple_verif_stdlib.v
+++ b/progs/VSUpile/simple_verif_stdlib.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import VST.floyd.library. (*for body_lemma_of_funspec *)
 Require Import stdlib.
@@ -9,15 +10,12 @@ Require Import simple_spec_stdlib.
 Axiom mem_mgr_rep: forall gv, emp |-- mem_mgr gv.
 
 Parameter body_malloc:
- forall {Espec: OracleKind} {cs: compspecs} ,
    VST.floyd.library.body_lemma_of_funspec EF_malloc (snd malloc_spec').
 
 Parameter body_free:
- forall {Espec: OracleKind} {cs: compspecs} ,
    VST.floyd.library.body_lemma_of_funspec EF_free (snd free_spec').
 
 Parameter body_exit:
- forall {Espec: OracleKind},
   VST.floyd.library.body_lemma_of_funspec
     (EF_external "exit" (mksignature (Xint :: nil) Xvoid cc_default))
     (snd (exit_spec)).
@@ -55,30 +53,30 @@ Lemma semax_func_cons_malloc_aux {cs: compspecs} (gv: globals) (gx : genviron) (
     (make_ext_rval gx (rettype_of_type (tptr tvoid)) ret) |-- !! is_pointer_or_null (force_val ret).
 Proof.
  intros.
- rewrite exp_unfold. Intros p.
+ monPred.unseal. Intros p.
  rewrite <- insert_local.
- rewrite lower_andp.
- apply derives_extract_prop; intro.
+ monPred.unseal.
+ apply bi.pure_elim_l; intro.
  destruct H; unfold_lift in H.
  unfold_lift in H0. destruct ret; try contradiction.
  unfold eval_id in H. simpl in H. subst p.
  if_tac. rewrite H; entailer!.
- renormalize. entailer!.
+ renormalize. monPred.unseal. entailer!.
 Qed.
 
 Definition MF_E : funspecs := MallocFreeASI.
 
-Definition MallocFreeVSU: @VSU NullExtension.Espec
+Definition MallocFreeVSU: VSU
         MF_E MF_imported_specs ltac:(QPprog prog) MallocFreeASI mem_mgr.
-  Proof. 
-    mkVSU prog MF_internal_specs. 
+  Proof.
+    mkVSU prog MF_internal_specs.
     - solve_SF_internal body_placeholder.
-    - solve_SF_external (@body_malloc NullExtension.Espec CompSpecs). 
+    - solve_SF_external body_malloc.
+      destruct x; simpl.
       Intros. eapply derives_trans.
-      apply (semax_func_cons_malloc_aux gv gx ret n).
+      apply semax_func_cons_malloc_aux.
       destruct ret; simpl; trivial.
-    - solve_SF_external (@body_free NullExtension.Espec CompSpecs).
-    - solve_SF_external (@body_exit NullExtension.Espec).
+    - solve_SF_external body_free.
+    - solve_SF_external body_exit.
     - apply MF_Init.
 Qed.
-
diff --git a/progs/VSUpile/simple_verif_triang.v b/progs/VSUpile/simple_verif_triang.v
index 4ca4d93d07..a29d049cc4 100644
--- a/progs/VSUpile/simple_verif_triang.v
+++ b/progs/VSUpile/simple_verif_triang.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import triang.
 Require Import simple_spec_stdlib.
@@ -45,10 +46,9 @@ reflexivity.
 simpl. congruence.
 Qed.
 
-Definition TriangVSU: @VSU NullExtension.Espec 
-      nil triang_imported_specs ltac:(QPprog prog) TriangASI emp.
-  Proof. 
-    mkVSU prog triang_internal_specs. 
-    + solve_SF_internal body_Triang_nth.
-  Qed.
-
+Definition TriangVSU: VSU
+      nil triang_imported_specs ltac:(QPprog prog) TriangASI (fun _ => emp).
+Proof.
+  mkVSU prog triang_internal_specs.
+  + solve_SF_internal body_Triang_nth.
+Qed.
diff --git a/progs/VSUpile/spec_apile.v b/progs/VSUpile/spec_apile.v
index a606b849c8..a209364215 100644
--- a/progs/VSUpile/spec_apile.v
+++ b/progs/VSUpile/spec_apile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import apile.
 Require Import spec_stdlib.
 Require Import PileModel.
diff --git a/progs/VSUpile/spec_main.v b/progs/VSUpile/spec_main.v
index 7168f17a93..67f43a911f 100644
--- a/progs/VSUpile/spec_main.v
+++ b/progs/VSUpile/spec_main.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU. (* must have this or get wrong version of main_pre *)
 Require Import main.
 
@@ -11,5 +12,3 @@ Definition main_spec p :=
     LOCAL(temp ret_temp (Vint (Int.repr 0)))
     SEP(TT).
 (*Refine postcondition to ...   SEP(spec_stdlib.mem_mgr gv; has_ext tt).?*)
-
-
diff --git a/progs/VSUpile/spec_onepile.v b/progs/VSUpile/spec_onepile.v
index 1727ce9b4a..87e7cc7a97 100644
--- a/progs/VSUpile/spec_onepile.v
+++ b/progs/VSUpile/spec_onepile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import onepile.
 Require Import spec_stdlib.
 Require Import PileModel.
diff --git a/progs/VSUpile/spec_pile.v b/progs/VSUpile/spec_pile.v
index e917609005..c71ebebddf 100644
--- a/progs/VSUpile/spec_pile.v
+++ b/progs/VSUpile/spec_pile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import pile.
 Require Import spec_stdlib.
 Require Import PileModel.
diff --git a/progs/VSUpile/spec_pile_private.v b/progs/VSUpile/spec_pile_private.v
index 2535a45d36..88297096eb 100644
--- a/progs/VSUpile/spec_pile_private.v
+++ b/progs/VSUpile/spec_pile_private.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import pile.
 Require Import spec_stdlib.
 Require Import spec_pile.
diff --git a/progs/VSUpile/spec_stdlib.v b/progs/VSUpile/spec_stdlib.v
index fb50c36b92..b5f797ee83 100644
--- a/progs/VSUpile/spec_stdlib.v
+++ b/progs/VSUpile/spec_stdlib.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import stdlib.
 
 Local Open Scope assert.
@@ -24,17 +25,15 @@ Proof. intros. unfold malloc_token.
 Qed.
 
 #[export] Hint Resolve malloc_token'_valid_pointer : valid_pointer.
+#[export] Hint Resolve malloc_token'_local_facts : saturate_local.
 #[export] Hint Resolve malloc_token_valid_pointer : valid_pointer.
 
 Lemma malloc_token_local_facts:  forall {cs: compspecs} M sh t p,
       malloc_token M sh t p |-- !! (field_compatible t [] p /\ malloc_compatible (sizeof t) p).
 Proof. intros.
  unfold malloc_token.
- normalize. rewrite prop_and.
- apply andp_right. apply prop_right; auto.
- apply malloc_token'_local_facts.
+ entailer!.
 Qed.
-#[export] Hint Resolve malloc_token'_local_facts : saturate_local.
 #[export] Hint Resolve malloc_token_local_facts : saturate_local.
 
 Section MallocFreeASI.
@@ -111,7 +110,8 @@ Lemma malloc_spec_sub:
    funspec_sub (snd malloc_spec') (snd (malloc_spec t)).
 Proof.
 do_funspec_sub. rename w into gv. clear H.
-Exists (sizeof t, gv) emp. simpl; entailer!.
+rewrite <- fupd_intro.
+Exists (sizeof t, gv) (emp : mpred). simpl; entailer!.
 intros tau ? ?. Exists (eval_id ret_temp tau).
 entailer!.
 if_tac; auto.
@@ -128,7 +128,8 @@ Lemma free_spec_sub:
    funspec_sub (snd free_spec') (snd (free_spec t)).
 Proof.
 do_funspec_sub. destruct w as [p gv]. clear H.
-Exists (sizeof t, p, gv) emp. simpl; entailer!.
+rewrite <- fupd_intro.
+Exists (sizeof t, p, gv) (emp : mpred). simpl; entailer!.
 if_tac; trivial.
 sep_apply data_at__memory_block_cancel.
 unfold malloc_token; entailer!.
diff --git a/progs/VSUpile/spec_triang.v b/progs/VSUpile/spec_triang.v
index b937e26212..b5ea992c84 100644
--- a/progs/VSUpile/spec_triang.v
+++ b/progs/VSUpile/spec_triang.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import triang.
 Require Import spec_stdlib.
 Require Import PileModel.
diff --git a/progs/VSUpile/verif_apile.v b/progs/VSUpile/verif_apile.v
index 8b1b77a573..f99284e01b 100644
--- a/progs/VSUpile/verif_apile.v
+++ b/progs/VSUpile/verif_apile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import apile.
 Require Import spec_stdlib.
@@ -39,7 +40,7 @@ Qed.
 
 Lemma apile_Init: VSU_initializer prog (apile nil).
   Proof. 
-    InitGPred_tac.  rewrite sepcon_emp.
+    InitGPred_tac.  rewrite sep_emp.
     apply make_apile; auto.
 Qed.
 
@@ -72,13 +73,13 @@ forward.
 entailer!. simpl. unfold apile. entailer!.
 Qed. 
 
-Definition ApileVSU: @VSU NullExtension.Espec
+Definition ApileVSU: VSU
       nil apile_imported_specs ltac:(QPprog prog) Apile_ASI (apile nil).
 Proof.
  mkVSU prog apile_internal_specs.
-    + solve_SF_internal body_Apile_add.
-    + solve_SF_internal body_Apile_count.
-    + apply apile_Init.
-  Qed.
+  + solve_SF_internal body_Apile_add.
+  + solve_SF_internal body_Apile_count.
+  + apply apile_Init.
+Qed.
 
 End Apile_VSU.
diff --git a/progs/VSUpile/verif_core.v b/progs/VSUpile/verif_core.v
index e4eb6772c7..3945ffd7b4 100644
--- a/progs/VSUpile/verif_core.v
+++ b/progs/VSUpile/verif_core.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 
 Require Import VST.floyd.linking.
@@ -22,13 +23,13 @@ Definition PrivPILE: spec_pile_private.PilePrivateAPD M := PILEPRIV M.
 Definition PILE: spec_pile.PileAPD := spec_pile_private.pilepreds PrivPILE. 
 
 Definition Onepile_Pile_VSU :=
-  ltac:(linkVSUs (PilePrivateVSU M) (OnepileVSU M PILE) ). 
+  ltac:(linkVSUs (PilePrivateVSU M) (OnepileVSU M PILE) ).
 
 (* Eval simpl in map fst (VSU_Exports Onepile_Pile_VSU).  *)
  (* Pile_new, Pile_add, Pile_count, Pile_free, Onepile_init, Onepile_add, Onepile_count *)
 
 Definition Apile_Onepile_Pile_VSU :=
-  ltac:(linkVSUs Onepile_Pile_VSU (ApileVSU M PrivPILE)). 
+  ltac:(linkVSUs Onepile_Pile_VSU (ApileVSU M PrivPILE)).
 
 Definition Triang_Apile_Onepile_Pile_VSU :=
   ltac:(linkVSUs Apile_Onepile_Pile_VSU (TriangVSU M PILE)).
diff --git a/progs/VSUpile/verif_main.v b/progs/VSUpile/verif_main.v
index 8a450ea05a..680d69af23 100644
--- a/progs/VSUpile/verif_main.v
+++ b/progs/VSUpile/verif_main.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.veric.initial_world.
 Require Import VST.floyd.VSU.
 
@@ -48,7 +49,7 @@ forward_call (10,gv).
 forward.
 Qed.
 
-Definition MainComp:  MainCompType nil main_QPprog Core_VSU whole_prog (snd (main_spec whole_prog))  emp.
+Definition MainComp:  MainCompType nil main_QPprog Core_VSU whole_prog (snd (main_spec whole_prog)) (fun _ => emp).
 Proof.
 mkComponent prog.
 solve_SF_internal body_main.
diff --git a/progs/VSUpile/verif_onepile.v b/progs/VSUpile/verif_onepile.v
index 2a725a468a..57437ccdbe 100644
--- a/progs/VSUpile/verif_onepile.v
+++ b/progs/VSUpile/verif_onepile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import onepile.
 Require Import spec_stdlib.
@@ -85,10 +86,10 @@ Qed.
     |-- data_at_ Ews (tptr (Tstruct _pile noattr)) (gv _the_pile).
   Proof. intros.
     unfold globvar2pred. simpl.
-         rewrite sepcon_emp.
+         rewrite sep_emp.
     destruct H as [b Hb]; rewrite Hb in *.
-    eapply derives_trans. 
-    + apply mapsto_zeros_memory_block. apply writable_readable. apply writable_Ews.
+    eapply derives_trans.
+    + apply mapsto_zeros_memory_block.
     + rewrite <- memory_block_data_at_; simpl; trivial.
       apply headptr_field_compatible; trivial. exists b; trivial. cbv; trivial. simpl; rep_lia.
       econstructor. reflexivity. apply Z.divide_0_r.
@@ -98,7 +99,7 @@ Qed.
   Lemma onepile_Init: VSU_initializer prog (one_pile None).
   Proof. InitGPred_tac. unfold one_pile. normalize. apply data_at_data_at_. Qed.
 
-Definition OnepileVSU: @VSU NullExtension.Espec
+Definition OnepileVSU: VSU
       nil onepile_imported_specs ltac:(QPprog prog) Onepile_ASI (one_pile None).
 Proof.
  mkVSU prog onepile_internal_specs.
diff --git a/progs/VSUpile/verif_pile.v b/progs/VSUpile/verif_pile.v
index ad7a0ced4e..c359e14075 100644
--- a/progs/VSUpile/verif_pile.v
+++ b/progs/VSUpile/verif_pile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import pile.
 Require Import spec_stdlib.
@@ -92,7 +93,7 @@ Proof.
 start_function.
 forward_call (malloc_spec_sub M t) gv.
 Intros p.
-if_tac; [ forward_if False | forward_if True ].
+if_tac; [ forward_if False%type | forward_if True%type ].
 all: finish.
 Qed.
 
@@ -143,7 +144,7 @@ forward_loop (EX r:val, EX s2: list Z,
 -
 Exists head sigma.
 entailer!. rewrite Z.sub_diag. auto.
-apply wand_sepcon_adjoint. cancel.
+auto.
 -
 Intros r s2.
 forward_if (r<>nullval).
@@ -154,11 +155,11 @@ forward.
 entailer!.
 assert (s2=nil) by intuition; subst s2.
 simpl. rewrite Z.sub_0_r; auto.
-sep_apply (modus_ponens_wand (listrep M s2 nullval)).
+sep_apply (modus_ponens_wand _ (listrep M s2 nullval)).
 cancel.
 Intros.
 destruct s2.
-assert_PROP False; [ | contradiction]. {
+assert_PROP False%type; [ | contradiction]. {
  entailer!. assert (r=nullval) by intuition; subst r. congruence.
 }
 unfold listrep at 3; fold (listrep M).
@@ -187,13 +188,8 @@ simpl in H0.
  }
  rep_lia.
  f_equal; f_equal; lia.
-apply -> wand_sepcon_adjoint.
-match goal with |- (_ * ?A * ?B * ?C)%logic |-- _ => 
- assert ((A * B * C)%logic |-- listrep M (z::s2) r) end.
+iIntros "(H & ? & ?) ?"; iApply "H"; iStopProof.
 unfold listrep at 2; fold (listrep M). Exists r'. entailer!.
-sep_apply H10.
-sep_apply modus_ponens_wand.
-auto.
  -
 forward.
 simpl pilerep; unfold prep.
@@ -216,7 +212,7 @@ forward_while (EX q:val, EX s2: list Z,
 { Exists head sigma; entailer!. }
 { entailer!. }
 { destruct s2.
-   assert_PROP False; [|contradiction]. unfold listrep. entailer!.
+   assert_PROP False%type; [|contradiction]. unfold listrep. entailer!.
   unfold listrep; fold (listrep M).
   Intros y.
   forward.
@@ -238,26 +234,26 @@ entailer!.
 Qed.
 
 
-Definition PileVSU: @VSU NullExtension.Espec
-           nil pile_imported_specs ltac:(QPprog prog) Pile_ASI emp.
- Proof. 
-    mkVSU prog pile_internal_specs.
-    + solve_SF_internal body_surely_malloc.
-    + solve_SF_internal body_Pile_new.
-    + solve_SF_internal body_Pile_add.
-    + solve_SF_internal body_Pile_count.
-    + solve_SF_internal body_Pile_free.
-  Qed.
+Definition PileVSU: VSU
+           nil pile_imported_specs ltac:(QPprog prog) Pile_ASI (fun _ => emp).
+Proof.
+  mkVSU prog pile_internal_specs.
+  + solve_SF_internal body_surely_malloc.
+  + solve_SF_internal body_Pile_new.
+  + solve_SF_internal body_Pile_add.
+  + solve_SF_internal body_Pile_count.
+  + solve_SF_internal body_Pile_free.
+Qed.
 
-Definition PilePrivateVSU: @VSU NullExtension.Espec
-      nil pile_imported_specs ltac:(QPprog prog) (PilePrivateASI M PILEPRIV) emp.
- Proof. 
-    mkVSU prog pile_internal_specs.
-    + solve_SF_internal body_surely_malloc.
-    + solve_SF_internal body_Pile_new.
-    + solve_SF_internal body_Pile_add.
-    + solve_SF_internal body_Pile_count.
-    + solve_SF_internal body_Pile_free.
-  Qed.
+Definition PilePrivateVSU: VSU
+      nil pile_imported_specs ltac:(QPprog prog) (PilePrivateASI M PILEPRIV) (fun _ => emp).
+Proof.
+  mkVSU prog pile_internal_specs.
+  + solve_SF_internal body_surely_malloc.
+  + solve_SF_internal body_Pile_new.
+  + solve_SF_internal body_Pile_add.
+  + solve_SF_internal body_Pile_count.
+  + solve_SF_internal body_Pile_free.
+Qed.
 
 End Pile_VSU.
diff --git a/progs/VSUpile/verif_stdlib.v b/progs/VSUpile/verif_stdlib.v
index 018bbd6292..fcf159543e 100644
--- a/progs/VSUpile/verif_stdlib.v
+++ b/progs/VSUpile/verif_stdlib.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import VST.floyd.library. (*for body_lemma_of_funspec *)
 Require Import stdlib.
@@ -21,15 +22,12 @@ Parameter M: MallocFreeAPD.
 Axiom mem_mgr_rep: forall gv, emp |-- mem_mgr M gv.
 
 Parameter body_malloc:
- forall {Espec: OracleKind} {cs: compspecs} ,
    VST.floyd.library.body_lemma_of_funspec EF_malloc (snd (malloc_spec' M)).
 
 Parameter body_free:
- forall {Espec: OracleKind} {cs: compspecs} ,
    VST.floyd.library.body_lemma_of_funspec EF_free (snd (free_spec' M)).
 
 Parameter body_exit:
- forall {Espec: OracleKind},
   VST.floyd.library.body_lemma_of_funspec
     (EF_external "exit" (mksignature (Xint :: nil) Xvoid cc_default))
     (snd (exit_spec)).
@@ -69,30 +67,31 @@ Lemma semax_func_cons_malloc_aux {cs: compspecs} (gv: globals) (gx : genviron) (
     (make_ext_rval gx (rettype_of_type (tptr tvoid)) ret) |-- !! is_pointer_or_null (force_val ret).
 Proof.
  intros.
- rewrite exp_unfold. Intros p.
+ monPred.unseal. Intros p.
  rewrite <- insert_local.
- rewrite lower_andp.
- apply derives_extract_prop; intro.
+ monPred.unseal.
+ apply bi.pure_elim_l; intro.
  destruct H; unfold_lift in H.
  unfold_lift in H0. destruct ret; try contradiction.
  unfold eval_id in H. simpl in H. subst p.
  if_tac. rewrite H; entailer!.
- renormalize. entailer!.
+ renormalize. monPred.unseal. entailer!.
 Qed.
 
 
 Definition MF_E : funspecs := MF_ASI.
 
-Definition MallocFreeVSU: @VSU NullExtension.Espec
+Definition MallocFreeVSU: VSU
          MF_E MF_imported_specs ltac:(QPprog prog) MF_ASI (mem_mgr M).
-  Proof. 
+  Proof.
     mkVSU prog MF_internal_specs.
     - solve_SF_internal body_placeholder.
-    - solve_SF_external (@body_malloc NullExtension.Espec CompSpecs). 
+    - solve_SF_external body_malloc.
+      destruct x; simpl.
       Intros. eapply derives_trans.
-      apply (semax_func_cons_malloc_aux gv gx ret n).
+      apply semax_func_cons_malloc_aux.
       destruct ret; simpl; trivial.
-    - solve_SF_external (@body_free NullExtension.Espec CompSpecs).
-    - solve_SF_external (@body_exit NullExtension.Espec).
+    - solve_SF_external body_free.
+    - solve_SF_external body_exit.
     - apply MF_Init.
 Qed.
diff --git a/progs/VSUpile/verif_triang.v b/progs/VSUpile/verif_triang.v
index 152067a217..35391bdcbc 100644
--- a/progs/VSUpile/verif_triang.v
+++ b/progs/VSUpile/verif_triang.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import triang.
 Require Import spec_stdlib.
@@ -52,8 +53,8 @@ reflexivity.
 simpl. congruence.
 Qed.
  
-Definition TriangVSU: @VSU NullExtension.Espec
-      nil triang_imported_specs ltac:(QPprog prog) (TriangASI M) emp.
+Definition TriangVSU: VSU
+      nil triang_imported_specs ltac:(QPprog prog) (TriangASI M) (fun _ => emp).
 Proof.
   mkVSU prog triang_internal_specs.
     + solve_SF_internal body_Triang_nth.
diff --git a/progs/bug83.v b/progs/bug83.v
index 18be70f297..c118cfee76 100644
--- a/progs/bug83.v
+++ b/progs/bug83.v
@@ -5,35 +5,36 @@
 *)
 
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.bst.
 
 Require Export VST.floyd.Funspec_old_Notation.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 
-Definition a : environ->mpred := 
+Definition a : assert := 
   SEPx (data_at_ Tsh (Tstruct _tree noattr) Vundef :: nil).
 
-Definition b : environ->mpred := 
-  SEPx (@data_at _ Tsh (Tstruct _tree noattr) (default_val (Tstruct _tree noattr)) Vundef :: nil).
+Definition b : assert := 
+  SEPx (data_at(cs := _) Tsh (Tstruct _tree noattr) (default_val (Tstruct _tree noattr)) Vundef :: nil).
 
-Definition c : environ->mpred := 
-  SEPx (@data_at _ Tsh (Tstruct _tree noattr) (Vundef, (Vundef, (Vundef, Vundef))) Vundef :: nil).
+Definition c : assert := 
+  SEPx (data_at(cs := _) Tsh (Tstruct _tree noattr) (Vundef, (Vundef, (Vundef, Vundef))) Vundef :: nil).
 
-Definition e : environ->mpred := 
- @exp _ _ _ (fun s : val => 
-  SEPx (@data_at _ Tsh (Tstruct _tree noattr) (default_val (Tstruct _tree noattr)) Vundef :: nil)).
+Definition e : assert := 
+ @bi_exist _ _ (fun s : val => 
+  SEPx (data_at(cs := _) Tsh (Tstruct _tree noattr) (default_val (Tstruct _tree noattr)) Vundef :: nil)).
 
-Definition f : environ->mpred := 
- @exp (environ->mpred) _ _ (fun s : val => 
-  SEPx (@data_at _ Tsh (Tstruct _tree noattr) (Vundef, (Vundef, (Vundef, Vundef))) Vundef :: nil)).
+Definition f : assert := 
+ @bi_exist (assert) _ (fun s : val => 
+  SEPx (data_at(cs := _) Tsh (Tstruct _tree noattr) (Vundef, (Vundef, (Vundef, Vundef))) Vundef :: nil)).
 
-Definition g : environ->mpred := 
- @exp _ _ _ (fun s : val => 
-  SEPx (@data_at CompSpecs Tsh (Tstruct _tree noattr) (Vundef, (Vundef, (Vundef, Vundef))) Vundef :: nil)).
+Definition g : assert := 
+ @bi_exist _ _ (fun s : val => 
+  SEPx (data_at(cs := CompSpecs) Tsh (Tstruct _tree noattr) (Vundef, (Vundef, (Vundef, Vundef))) Vundef :: nil)).
 
-Fail Definition h : environ->mpred := 
- @exp _ _ _ (fun s : val => 
-  SEPx (@data_at _ Tsh (Tstruct _tree noattr) (Vundef, (Vundef, (Vundef, Vundef))) Vundef :: nil)).
+(* Fail *) Definition h : assert := 
+ @bi_exist _ _ (fun s : val => 
+  SEPx (data_at(cs := _) Tsh (Tstruct _tree noattr) (Vundef, (Vundef, (Vundef, Vundef))) Vundef :: nil)).
 
 (* Typeclass inference in the presence of dependent types is broken.  
    That is not a new observation; as Gonthier et al. ("How to make ad hoc proof automation 
diff --git a/progs/dry_mem_lemmas.v b/progs/dry_mem_lemmas.v
index 5400ca7c5d..eb0a5a7fc0 100644
--- a/progs/dry_mem_lemmas.v
+++ b/progs/dry_mem_lemmas.v
@@ -1,11 +1,8 @@
 Require Import VST.veric.juicy_mem.
-Require Import VST.veric.compcert_rmaps.
 Require Import VST.veric.initial_world.
-Require Import VST.veric.ghost_PCM.
 Require Import VST.veric.SequentialClight.
 Require Import VST.veric.mem_lessdef.
 Require Import VST.floyd.proofauto.
-Import Maps.
 
 (* functions on byte arrays and CompCert mems *)
 Lemma drop_alloc m : { m' | (let (m1, b) := Mem.alloc m 0 1 in Mem.drop_perm m1 b 0 1 Nonempty) = Some m' }.
@@ -37,414 +34,110 @@ Proof.
   if_tac; if_tac; constructor || contradiction.
 Qed.
 
-Lemma nth_nil : forall {A} n (d : A), nth n nil d = d.
-Proof.
-  destruct n; auto.
-Qed.
-
-Lemma ghost_join_nth : forall (a b c : ghost) n, join a b c ->
-  join (nth n a None) (nth n b None) (nth n c None).
-Proof.
-  intros; revert n; induction H; intro; rewrite ?nth_nil; try constructor.
-  destruct n; eauto.
-Qed.
-
-Lemma ext_ghost_join : forall {Z} (z : Z) (p : preds) b c, join (Some (ext_ghost z, p)) b c ->
-  (c = Some (ext_ghost z, p) /\ (forall d, join (Some (existT _ (ext_PCM Z) d, p)) b (Some (existT _ (ext_PCM Z) d, p)))) \/
-  (b = Some (ext_ref z, p) /\ c = Some (ext_both z, p)).
-Proof.
-  intros.
-  inv H; auto.
-  { left; split; auto.
-    intros; constructor. }
-  destruct a2, a3, H1 as (? & ? & ?); simpl in *; subst.
-  inv H.
-  inj_pair_tac.
-  destruct b0, c0, H4 as [J1 J2]; simpl in *.
-  assert (o0 = o) by (inv J2; auto); subst; clear J2.
-  destruct g as [(?, ?)|], g0 as [(?, ?)|]; try contradiction.
-  { destruct J1 as (? & ? & ?%join_Tsh & ?); tauto. }
-  inv J1.
-  destruct o.
-  - right.
-    destruct vc as (? & d & J); hnf in J.
-    destruct d as [(?, ?)|].
-    { exfalso; destruct J as (? & ? & ?%join_Tsh & ?); tauto. }
-    injection J as ?; subst.
-    unfold ext_ref, ext_both; split; repeat f_equal.
-  - left; split; [unfold ext_ghost; repeat f_equal|].
-    intros; repeat constructor; simpl.
-    destruct d; repeat constructor; simpl.
-    destruct x as ([(?, ?)|], ?); simpl; auto.
-Qed.
-
-(*Lemma has_ext_join : forall {Z} phi1 phi2 phi3 (z1 z2 : Z) (Hext : nth O (ghost_of phi1) None = Some (ext_ghost z1, NoneP))
-  (Hj : join phi1 phi2 phi3) (Hrest : joins (ghost_of phi3) [Some (ext_ref z2, NoneP)]),
-  z1 = z2 /\ nth O (ghost_of phi3) None = Some (ext_ghost z1, NoneP).
-Proof.
-  simpl; intros.
-  apply ghost_of_join, ghost_join_nth with (n := O) in Hj.
-  rewrite Hext in Hj.
-  destruct Hrest as [? Hrest].
-  apply ghost_join_nth with (n := O) in Hrest.
-  inv Hj.
-  - split; auto.
-    rewrite <- H2 in Hrest; inv Hrest.
-    destruct a3; inv H4; simpl in *.
-    inv H; repeat inj_pair_tac.
-    destruct c0; inv H8; simpl in *.
-    inv H4.
-    destruct g as [[]|]; try contradiction.
-    inv H.
-    destruct vc as (? & [[]|] & vc); hnf in vc; try congruence.
-    clear - vc; destruct vc as (? & ? & ?%join_Tsh & ?); tauto.
-  - rewrite <- H1 in Hrest; inv Hrest.
-    destruct a3, a4; inv H5; simpl in *.
-    inv H3.
-    destruct a2; inv H2; simpl in *.
-    inv H3; inj_pair_tac.
-    inv H; repeat inj_pair_tac.
-    destruct b0, c0; inv H9; simpl in *.
-    destruct c1; inv H8; simpl in *.
-    destruct g as [[]|], g0 as [[]|]; try contradiction.
-    { destruct H as (? & ? & ?%join_Tsh & ?); tauto. }
-    inv H.
-    inv H6; [|inv H8].
-    assert (o = None) by (inv H2; auto); subst.
-    destruct o1 as [[]|]; inv H3.
-    split.
-    + destruct vc0 as (? & [[]|] & vc0); hnf in vc0; try congruence.
-      clear - vc0; destruct vc0 as (? & ? & ?%join_Tsh & ?); tauto.
-    + unfold ext_ghost; simpl; repeat f_equal; apply proof_irr.
-Qed.*)
-
-Lemma no_two_ref : forall {Z} (a b : Z) (pa pb : preds),
-  ~joins (Some (ext_both a, pa)) (Some (ext_ref b, pb)).
-Proof.
-  intros ????? [? J].
-  inv J.
-  destruct H1 as [J _]; simpl in *.
-  inv J.
-  repeat inj_pair_tac.
-  destruct H0 as [_ J].
-  inv J.
-  inv H2.
-Qed.
-
-Lemma ghost_not_both : forall {Z} (a1 a2 : Z) (p1 p2 : preds),
-  Some (ext_ghost a1, p1) <> Some (ext_both a2, p2).
-Proof.
-  repeat intro.
-  assert (ext_ghost a1 = ext_both a2) as Heq by congruence.
-  unfold ext_ghost, ext_both in Heq; inj_pair_tac.
-  inv H0.
-Qed.
-
-Lemma change_ext : forall {Z} (a a' z : Z) (rest b c : ghost),
-  join (Some (ext_ghost a, NoneP) :: rest) b c ->
-  joins c [Some (ext_ref z, NoneP)] ->
-  join (Some (ext_ghost a', NoneP) :: rest) b (Some (ext_ghost a', NoneP) :: tl c).
-Proof.
-  intros.
-  inv H; [constructor|].
-  constructor; auto.
-  apply ext_ghost_join in H3 as [[]|[]]; subst; eauto.
-  destruct H0 as [? J]; inv J.
-  exfalso; eapply no_two_ref; eexists; eauto.
-Qed.
+Section mpred.
 
-Lemma change_has_ext : forall {Z} (a a' : Z) r rest H, app_pred (has_ext a) r ->
-  app_pred (has_ext a') (set_ghost r (Some (ext_ghost a', NoneP) :: rest) H).
-Proof.
-  intros; simpl in *.
-  destruct H0 as (p & ? & ?); exists p.
-  unfold set_ghost; rewrite resource_at_make_rmap, ghost_of_make_rmap.
-  split; auto.
-  exists (None :: rest); repeat constructor.
-  match goal with |- join ?a _ ?b => assert (a = b) as ->; [|constructor] end.
-  unfold ext_ghost; repeat f_equal.
-Qed.
+Context `{!VSTGS OK_ty Σ}.
 
-Lemma ext_ref_join : forall {Z} (z : Z), join (ext_ghost z) (ext_ref z) (ext_both z).
-Proof.
-  intros; repeat constructor.
-Qed.
-
-Lemma set_ghost_join : forall a c w1 w2 w (J : join w1 w2 w) H1 H,
-  join a (ghost_of w2) c ->
-  join (set_ghost w1 a H1) w2 (set_ghost w c H).
+Lemma has_ext_state : forall m (z z' : OK_ty),
+  state_interp m z ∗ <absorb> has_ext z' ⊢ ⌜z = z'⌝.
 Proof.
   intros.
-  destruct (join_level _ _ _ J).
-  apply resource_at_join2; unfold set_ghost; intros; rewrite ?level_make_rmap, ?resource_at_make_rmap, ?ghost_of_make_rmap; auto.
-  apply resource_at_join; auto.
+  iIntros "((_ & Hz) & >Hz')".
+  iDestruct (own_valid_2 with "Hz Hz'") as %?%@excl_auth_agree; done.
 Qed.
 
-Lemma age_rejoin : forall {Z} w1 w2 w w' (a a' z : Z) H (J : join w1 w2 w)
-  (Hc : joins (ghost_of w) [Some (ext_ref z, NoneP)])
-  (Hg1 : ghost_of w1 = Some (ext_ghost a, NoneP) :: tl (ghost_of w1))
-  (Hl' : (level w' <= level w)%nat)
-  (Hr' : forall l, w' @ l = resource_fmap (approx (level w')) (approx (level w')) (w @ l))
-  (Hg' : ghost_of w' = Some (ext_ghost a', NoneP) :: own.ghost_approx (level w') (tl (ghost_of w))),
-  join (age_to.age_to (level w') (set_ghost w1 (Some (ext_ghost a', NoneP) :: tl (ghost_of w1)) H)) (age_to.age_to (level w') w2) w'.
+Lemma change_ext_state : forall m (z z' : OK_ty),
+  state_interp m z ∗ has_ext z ⊢ |==> state_interp m z' ∗ has_ext z'.
 Proof.
   intros.
-  destruct (join_level _ _ _ J).
-  apply resource_at_join2.
-  - rewrite age_to.level_age_to; auto.
-    unfold set_ghost; rewrite level_make_rmap; lia.
-  - rewrite age_to.level_age_to; auto; lia.
-  - eapply age_to.age_to_join_eq in J; eauto.
-    intro loc; apply (resource_at_join _ _ _ loc) in J.
-    rewrite !age_to_resource_at.age_to_resource_at in *.
-    unfold set_ghost; rewrite resource_at_make_rmap.
-    rewrite Hr'; auto.
-  - rewrite !age_to_resource_at.age_to_ghost_of.
-    unfold set_ghost; rewrite ghost_of_make_rmap, Hg'.
-    apply ghost_of_join in J; rewrite Hg1 in J.
-    eapply change_ext in J; eauto.
-    apply ghost_fmap_join with (f := approx (level w'))(g := approx (level w')) in J.
-    apply J.
+  iIntros "(($ & Hz) & Hext)".
+  iMod (own_update_2 with "Hz Hext") as "($ & $)"; last done.
+  apply @excl_auth_update.
 Qed.
 
-Lemma memory_block_writable_perm : forall sh n b ofs r jm, writable_share sh ->
+Lemma memory_block_writable_perm : forall sh n b ofs m z, writable_share sh ->
   (0 <= ofs)%Z -> (Z.of_nat n + ofs < Ptrofs.modulus)%Z ->
-  app_pred (mapsto_memory_block.memory_block' sh n b ofs) r -> sepalg.join_sub r (m_phi jm) ->
-  Mem.range_perm (m_dry jm) b ofs (ofs + Z.of_nat n) Memtype.Cur Memtype.Writable.
+  state_interp m z ∗ <absorb> memory_block' sh n b ofs ⊢
+  ⌜Mem.range_perm m b ofs (ofs + Z.of_nat n) Memtype.Cur Memtype.Writable⌝.
 Proof.
   intros.
-  rewrite mapsto_memory_block.memory_block'_eq in H2 by auto.
-  unfold mapsto_memory_block.memory_block'_alt in H2.
-  destruct (readable_share_dec sh).
-  intros ??.
-  apply VALspec_range_e with (loc := (b, ofs0)) in H2 as [? Hb]; simpl; auto.
-  destruct H3 as [? J]; apply resource_at_join with (loc := (b, ofs0)) in J.
-  pose proof (juicy_mem_access jm (b, ofs0)) as Hperm.
-  rewrite Hb in J; inversion J; subst; simpl in *.
-  - rewrite <- H8 in Hperm; simpl in Hperm.
-    eapply access_at_writable, Hperm.
-    apply join_writable1 in RJ; auto.
-  - rewrite <- H8 in Hperm; simpl in Hperm.
-    eapply access_at_writable, Hperm.
-    apply join_writable1 in RJ; auto.
-  - apply shares.writable_readable in H; contradiction.
+  iIntros "((Hm & _) & >Hb)".
+  rewrite memory_block'_eq // /memory_block'_alt if_true; last auto.
+  destruct (eq_dec sh Share.top); first subst;
+    (iDestruct (VALspec_range_perm with "[$]") as %?; [by apply perm_of_freeable || by apply perm_of_writable|]);
+    simpl in *; iPureIntro; first eapply Mem.range_perm_implies; try done.
+  constructor.
 Qed.
 
-Lemma data_at__writable_perm : forall {cs : compspecs} sh t p r jm, writable_share sh ->
-  app_pred (@data_at_ cs sh t p) r -> sepalg.join_sub r (m_phi jm) ->
-  exists b ofs, p = Vptr b ofs /\
-    Mem.range_perm (m_dry jm) b (Ptrofs.unsigned ofs) (Ptrofs.unsigned ofs + sizeof t) Memtype.Cur Memtype.Writable.
+Local Transparent memory_block.
+
+Lemma data_at__writable_perm : forall {cs : compspecs} sh t p m z, writable_share sh ->
+  state_interp m z ∗ <absorb> data_at_ sh t p ⊢
+  ⌜exists b ofs, p = Vptr b ofs /\
+    Mem.range_perm m b (Ptrofs.unsigned ofs) (Ptrofs.unsigned ofs + sizeof t) Memtype.Cur Memtype.Writable⌝.
 Proof.
   intros.
-  rewrite data_at__memory_block in H0; destruct H0 as [[Hptr Hcompat] Hdata].
+  rewrite data_at__memory_block.
+  iIntros "(Hm & >((% & %) & Hp))".
   destruct p; try contradiction.
-  do 3 eexists; eauto.
-  destruct Hdata as [? Hblock].
-  eapply memory_block_writable_perm in Hblock; eauto;
-    rewrite ?Z2Nat.id, ?nat_of_Z_max, ?Z.max_l in * by (pose proof sizeof_pos t; lia); auto.
-  { apply Ptrofs.unsigned_range. }
-  { rewrite Z.add_comm; auto. }
-Qed.
-
-Lemma rebuild_same : forall jm,
-  juicy_mem_lemmas.rebuild_juicy_mem_fmap jm (m_dry jm) = resource_at (m_phi jm).
-Proof.
-  intros; extensionality l.
-  unfold juicy_mem_lemmas.rebuild_juicy_mem_fmap.
-  destruct (m_phi jm @ l) eqn: Hl; auto.
-  - if_tac; auto.
-    destruct jm; simpl in *.
-    rewrite (JMaccess l) in H.
-    rewrite Hl in H; simpl in H.
-    if_tac in H; inv H.
-  - destruct k; auto.
-    destruct jm; simpl in *.
-    if_tac.
-    + apply JMcontents in Hl as [-> ?]; subst; auto.
-    + contradiction H.
-      rewrite (JMaccess l), Hl; simpl.
-      unfold perm_of_sh.
-      if_tac; if_tac; try contradiction; constructor.
+  iExists _, _; iSplit; first done.
+  iDestruct "Hp" as "(% & Hp)".
+  iDestruct (memory_block_writable_perm with "[$Hm $Hp]") as %Hperm; [done | rep_lia..|].
+  rewrite Z2Nat.id in Hperm; auto.
+  pose proof (sizeof_pos t); lia.
 Qed.
 
-Lemma data_at__VALspec_range: forall {cs : compspecs} sh z b o (Hsh: readable_share sh),
-  @data_at_ cs sh (tarray tuchar z) (Vptr b o) |--
-  res_predicates.VALspec_range z sh (b, Ptrofs.unsigned o).
-Proof.
-  intros. rewrite derives_eq.
-  intros ? [(_ & _ & Hsize & _) H]; simpl in *.
-  rewrite data_at_rec_eq in H; simpl in H.
-  unfold default_val, unfold_reptype in H; simpl in H.
-  unfold at_offset in H; rewrite offset_val_zero_Vptr in H.
-  unfold Zrepeat in *.
-  destruct H as [_ H].
-  rewrite Z.sub_0_r, Z2Nat_max0 in H.
-  remember 0 as lo in H at 1.
-  remember (Z.to_nat z) as hi in H at 1.
-  remember (Z.to_nat z) as n in H.
-  assert (Z.to_nat lo + hi <= n)%nat by rep_lia.
-  assert (0 <= lo <= Ptrofs.max_unsigned) by rep_lia.
-  assert (Ptrofs.unsigned o + Z.of_nat n <= Ptrofs.max_unsigned).
-  { subst n; rewrite Z2Nat_id'; rep_lia. }
-  replace (Ptrofs.unsigned o) with (Ptrofs.unsigned o + lo) by lia.
-  clear Heqlo Heqn.
-  generalize dependent lo; generalize dependent z; revert a; induction hi; simpl in *.
-  - intros. setoid_rewrite res_predicates.emp_no in H. destruct b0 as (?, ?); if_tac; [|apply H; auto].
-    unfold adr_range in *. destruct (zlt 0 z); lia.
-  - intros.
-    destruct H as (? & ? & J & Hr1 & Hr2).
-    assert (lo < Z.of_nat n) by lia.
-    assert (z >= 1) by lia.
-    eapply IHhi with (z := z - 1) in Hr2.
-    instantiate (1 := b0) in Hr2.
-    rewrite data_at_rec_eq in Hr1; simpl in Hr1.
-    unfold unfold_reptype in Hr1; simpl in Hr1.
-    rewrite <- (Nat2Z.id n) in Hr1.
-    rewrite Znth_repeat_inrange in Hr1.
-    unfold mapsto in Hr1; simpl in Hr1.
-    rewrite if_true in Hr1 by auto.
-    destruct Hr1 as [[] | (_ & ? & ? & [? Hr1])]; [contradiction|].
-    rewrite Z.mul_1_l in *.
-    unfold Ptrofs.add in Hr1; rewrite !Ptrofs.unsigned_repr in Hr1; auto.
-    + rename b0 into l.
-        specialize (Hr1 l); simpl in *.
-        apply (resource_at_join _ _ _ l) in J.
-        destruct l as (b', o'); if_tac in Hr1; [|if_tac in Hr2].
-        * destruct H5; subst.
-          rewrite if_true.
-          destruct Hr1 as (? & Hr1); rewrite Hr1 in J.
-          rewrite if_false in Hr2.
-          apply join_comm, Hr2 in J; rewrite <- J; eauto.
-          { intros []; lia. }
-          { repeat split; auto; lia. }
-      * rewrite if_true.
-        apply Hr1 in J; rewrite <- J.
-        destruct Hr2 as (? & ? & ->); eauto.
-        { destruct H6; subst.
-          repeat split; auto; lia. }
-      * apply Hr1 in J as <-.
-        rewrite if_false; auto.
-        { fold (adr_range (b, Ptrofs.unsigned o + lo) z (b', o')).
-          replace z with (1 + (z - 1)) by lia.
-          intros X%adr_range_divide; try lia.
-          destruct X; try contradiction.
-          unfold Z.succ in *; rewrite Z.add_assoc in *; contradiction. }
-    + rewrite Ptrofs.unsigned_repr; auto; rep_lia.
-    + lia.
-    + lia.
-    + lia.
-    + lia.
-    + rep_lia.
-Qed.
-
-Lemma data_at_bytes : forall {CS : compspecs} sh z (bytes : list val) buf jm phi
-  (Hreadable : readable_share sh) (Hlen : z = Zlength bytes) (J : join_sub phi (m_phi jm))
-  (Hbuf : app_pred (data_at sh (tarray tuchar z) bytes buf) phi)
+Lemma data_at_bytes : forall {CS : compspecs} sh z (bytes : list val) buf m o
+  (Hreadable : readable_share sh) (Hlen : z = Zlength bytes)
   (Hdef : Forall (fun x => x <> Vundef) bytes),
-  match buf with
-  | Vptr b ofs =>
-      Mem.loadbytes (m_dry jm) b (Ptrofs.unsigned ofs) z =
-        Some (concat (map (encode_val Mint8unsigned) bytes))
-  | _ => False
- end.
+  state_interp m o ∗ <absorb> data_at sh (tarray tuchar z) bytes buf ⊢
+  ⌜match buf with
+   | Vptr b ofs =>
+       Mem.loadbytes m b (Ptrofs.unsigned ofs) z =
+         Some (concat (map (encode_val Mint8unsigned) bytes))
+   | _ => False
+   end⌝.
 Proof.
   intros.
-  destruct Hbuf as [(Hptr & _ & Hlim & _) Hbuf].
-  unfold at_offset in Hbuf.
-  destruct buf; try contradiction; simpl in Hbuf.
-  rewrite ptrofs_add_repr_0_r, data_at_rec_eq in Hbuf; simpl in Hbuf.
-  unfold unfold_reptype in *; simpl in *.
-  destruct Hbuf as [_ Hbuf].
-  rewrite Z.sub_0_r, Z.max_r in Hbuf by rep_lia.
-  clear Hptr.
-  erewrite <- (sublist_same _ _ bytes) by eauto.
-  rewrite <- (Z.add_0_r (Ptrofs.unsigned i)).
-  rewrite <- (Z.add_0_r z) at 2.
-  remember 0 as lo in |- *.
-  assert (0 <= lo) by lia.
-  rewrite <- Heqlo in Hbuf at 1.
-  remember (Z.to_nat z) as n.
-  rewrite <- (Z2Nat.id z), <- Heqn by rep_lia.
-  assert (lo + Z.of_nat n = Zlength bytes) by (subst; rewrite Z2Nat.id; rep_lia).
-  assert (Ptrofs.unsigned i + Zlength bytes < Ptrofs.modulus).
-  { rewrite Z.max_r in Hlim by rep_lia; lia. }
-  clear Heqlo Hlen.
-  clear dependent z.
-  generalize dependent phi; generalize dependent lo.
-  induction n; intros; subst.
-  - unfold sublist; simpl.
-    rewrite skipn_firstn,  Z.add_0_l, Nat.sub_diag.
-    apply Mem.loadbytes_empty; reflexivity.
-  - simpl in Hbuf.
-    destruct Hbuf as (phi0 & ? & J' & Hbyte & Hbytes).
-    rewrite Nat2Z.inj_succ in *.
-    apply IHn in Hbytes; try lia.
-    rewrite sublist_next by lia; simpl.
-    unfold Z.succ in *; rewrite (Z.add_comm _ 1) in *.
-    apply Mem.loadbytes_concat; try lia.
-    clear Hbytes.
-    unfold at_offset in Hbyte; simpl in Hbyte.
-    rewrite data_at_rec_eq in Hbyte; simpl in Hbyte.
-    unfold unfold_reptype, mapsto in Hbyte; simpl in Hbyte.
-    rewrite if_true in Hbyte by auto.
-    destruct Hbyte as [[? Hbyte] | [? Hbyte]].
-    destruct Hbyte as (mv & (? & Hdecode & _) & Hbyte); subst.
-    specialize (Hbyte (b, Ptrofs.unsigned i + lo)); simpl in Hbyte.
-    replace (Ptrofs.unsigned (Ptrofs.add _ _)) with (Ptrofs.unsigned i +lo) in Hbyte.
-    rewrite if_true in Hbyte by (split; auto; lia).
-    destruct Hbyte as [? Hval].
-    rewrite Z.sub_diag in Hval.
-    destruct mv; try discriminate.
-    unfold decode_val in Hdecode; simpl in *.
-    rewrite Z.sub_0_r in *.
-    apply (sublist.Forall_Znth _ _ lo) in Hdef; try lia.
-    setoid_rewrite <- Hdecode in Hdef.
-    destruct m; try contradiction; clear Hdef.
-    destruct mv; try discriminate; simpl in *.
-    setoid_rewrite <- Hdecode; simpl.
-    assert (join_sub phi0 (m_phi jm)) as [? J0].
-    { eapply join_sub_trans; [eexists|]; eauto. }
-    Transparent Mem.loadbytes.
-    unfold Mem.loadbytes.
-    Opaque Mem.loadbytes.
-    destruct jm; simpl in *.
-    assert (exists sh1 rsh1, phi1 @ (b, Ptrofs.unsigned i + lo) = YES sh1 rsh1 (VAL (Byte i0)) NoneP) as (? & ? & Hr).
-    { apply (resource_at_join _ _ _ (b, Ptrofs.unsigned i + lo)) in J0.
-      rewrite Hval in J0; inv J0; eauto. }
-    specialize (JMaccess (b, Ptrofs.unsigned i + lo)); rewrite Hr in JMaccess; simpl in JMaccess.
-    apply JMcontents in Hr as [Hr _].
-    rewrite if_true.
-    unfold contents_at in Hr; simpl in Hr.
-    rewrite Hr.
-    unfold decode_int; simpl.
-    rewrite rev_if_be_singleton; simpl.
-    assert (0 <= Byte.unsigned i0 <= Int.max_unsigned) by rep_lia.
-    rewrite Z.add_0_r, zero_ext_inrange, Int.unsigned_repr; auto.
-    unfold encode_int; simpl.
-    rewrite rev_if_be_singleton; simpl.
-    rewrite Byte.repr_unsigned; auto.
-    * rewrite Int.unsigned_repr by auto.
-      destruct (Byte.unsigned_range i0) as [_ Hmax].
-      unfold Byte.modulus in Hmax.
-      unfold Byte.wordsize, Wordsize_8.wordsize in Hmax.
-      rewrite two_power_nat_two_p in Hmax; simpl Z.of_nat in Hmax; lia.
-    * unfold Mem.range_perm; intros.
-      unfold Mem.perm.
-      assert (ofs = Ptrofs.unsigned i + lo) by lia; subst.
-      unfold access_at in JMaccess; simpl in JMaccess; rewrite JMaccess.
-      unfold perm_of_sh.
-      if_tac; if_tac; try constructor; contradiction.
-    * unfold Ptrofs.add.
-      setoid_rewrite Ptrofs.unsigned_repr at 2; [|rep_lia].
-      rewrite Ptrofs.unsigned_repr; rep_lia.
-    * apply (sublist.Forall_Znth _ _ (lo - 0)) in Hdef; try lia; contradiction.
-    * rewrite Z.add_assoc in *.
-      replace (1 + Z.of_nat n + lo) with (Z.of_nat n + (lo + 1)) by lia; auto.
-    * eapply join_sub_trans; [eexists|]; eauto.
+  assert_PROP (field_compatible (tarray tuchar z) [] buf).
+  { unfold data_at, field_at; iIntros "(_ & >($ & _))". }
+  destruct buf; try by destruct H.
+  remember (Z.to_nat z) as n; generalize dependent i; generalize dependent bytes; generalize dependent z; induction n; intros.
+  { assert (z = 0) as -> by rep_lia.
+    destruct bytes; last by autorewrite with sublist in *; rep_lia.
+    rewrite Mem.loadbytes_empty //; auto. }
+  rewrite (split2_data_at_Tarray_tuchar _ _ 1) // /=; last lia.
+  iIntros "(Hz & >(H & Hrest))".
+  destruct bytes; first by autorewrite with sublist in *; rep_lia.
+  inversion Hdef; clear Hdef.
+  autorewrite with sublist in Hlen.
+  rewrite /field_address0 if_true /=.
+  2: { rewrite field_compatible0_cons; split; auto; lia. }
+  rewrite sublist_1_cons (sublist_same _ (z - 1)) //; last lia.
+  iAssert ⌜field_compatible (tarray tuchar (z - 1)) [] (Vptr b (Ptrofs.add i (Ptrofs.repr 1)))⌝ with "[Hrest]" as %?.
+  { unfold data_at, field_at; iDestruct "Hrest" as "($ & _)". }
+  iDestruct (IHn with "[$Hz $Hrest]") as %Hrest; [lia || done..|].
+  iDestruct "Hz" as "(Hm & _)".
+  rewrite sublist_0_cons // sublist_nil data_at_tuchar_singleton_array_inv.
+  iAssert ⌜field_compatible tuchar [] (Vptr b i)⌝ with "[H]" as %?.
+  { unfold data_at, field_at; iDestruct "H" as "($ & _)". }
+  erewrite <-mapsto_data_at', mapsto_core_load by done.
+  iDestruct (core_load_load' with "[$Hm $H]") as %Hbyte.
+  apply Mem.load_loadbytes in Hbyte as (byte & Hbyte & ->); subst.
+  rewrite Ptrofs.add_unsigned !Ptrofs.unsigned_repr // in Hrest.
+  2: { destruct H as (? & ? & ? & ?); simpl in *; rep_lia. }
+  eapply Mem.loadbytes_concat in Hrest; eauto; [|lia..].
+  pose proof (Mem.loadbytes_length _ _ _ _ _ Hbyte) as Hlen; simpl in Hlen.
+  destruct byte as [|byte []]; [done | | done].
+  replace (encode_val _ (decode_val _ [byte])) with [byte].
+  replace (1 + (Z.succ (Zlength bytes) - 1)) with (Z.succ (Zlength bytes)) in Hrest by lia; done.
+  { destruct byte; try done.
+    rewrite decode_byte_val zero_ext_inrange /= Int.unsigned_repr; [|rep_lia..].
+    rewrite /encode_int /= Byte.repr_unsigned rev_if_be_singleton //. }
 Qed.
 
 (* up *)
-Lemma perm_order_antisym : forall p p', perm_order p p' -> perm_order p' p -> p = p'.
+Lemma perm_order_antisym' : forall p p', perm_order p p' -> perm_order p' p -> p = p'.
 Proof.
   inversion 1; auto; inversion 1; auto.
 Qed.
@@ -458,14 +151,14 @@ Proof.
   extensionality k.
   apply equal_f with b, equal_f with o, equal_f with k in Hperm.
   unfold access_at; simpl.
-  destruct (_ !! _).
+  destruct (_ !!! _).
   - pose proof (equal_f Hperm p) as Hp; simpl in *.
     pose proof (perm_refl p) as Hrefl; rewrite Hp in Hrefl.
-    destruct (_ !! _); [simpl in * | contradiction].
-    f_equal; apply perm_order_antisym; auto.
+    destruct (_ !!! _); [simpl in * | contradiction].
+    f_equal; apply perm_order_antisym'; auto.
     apply equal_f with p0 in Hperm.
     rewrite Hperm; apply perm_refl.
-  - destruct (_ !! _); auto.
+  - destruct (_ !!! _); auto.
     apply equal_f with p in Hperm; simpl in Hperm.
     pose proof (perm_refl p) as Hrefl; rewrite <- Hperm in Hrefl; contradiction.
 Qed.
@@ -480,7 +173,7 @@ Proof.
   Opaque Mem.loadbytes.
   apply equal_f with b, equal_f with o, equal_f with 1 in Hload.
   unfold contents_at; simpl.
-  rewrite 2if_true  in Hload.
+  rewrite !if_true in Hload.
   inv Hload; auto.
   { unfold Mem.range_perm.
     intros; assert (ofs = o) by lia; subst.
@@ -489,374 +182,103 @@ Proof.
     intros; assert (ofs = o) by lia; subst; auto. }
 Qed.
 
-Lemma mem_evolve_access : forall m1 m2, access_at m1 = access_at m2 -> mem_evolve m1 m2.
-Proof.
-  intros; unfold mem_evolve.
-  intro; rewrite H.
-  destruct (access_at _ _ _); auto.
-  destruct p; auto.
-Qed.
-
-Lemma mem_evolve_equiv1 : forall m1 m2 m1', mem_evolve m1 m2 -> mem_equiv m1 m1' -> mem_evolve m1' m2.
-Proof.
-  unfold mem_evolve; intros.
-  rewrite <- (mem_equiv_access _ _ H0); apply H.
-Qed.
-
-Lemma mem_evolve_equiv2 : forall m1 m2 m2', mem_evolve m1 m2 -> mem_equiv m2 m2' -> mem_evolve m1 m2'.
-Proof.
-  unfold mem_evolve; intros.
-  rewrite <- (mem_equiv_access _ _ H0); apply H.
-Qed.
-
-Definition mem_equiv_jm jm m (Heq : mem_equiv (m_dry jm) m) :
-  {jm' | level jm' = level jm /\ m_dry jm' = m /\ m_phi jm' = m_phi jm}.
-Proof.
-  destruct jm; simpl in *.
-  unshelve eexists (mkJuicyMem m phi _ _ _ _); simpl; auto.
-  - unfold contents_cohere in *; intros.
-    destruct (JMcontents _ _ _ _ _ H) as []; subst; split; auto.
-    symmetry; apply mem_equiv_contents; auto.
-    specialize (JMaccess loc).
-    rewrite H in JMaccess; simpl in JMaccess.
-    apply access_at_readable in JMaccess; auto.
-  - unfold access_cohere in *; intros.
-    erewrite <- JMaccess, <- mem_equiv_access; eauto.
-  - unfold max_access_cohere in *; intros.
-    unfold max_access_at in *.
-    erewrite <- mem_equiv_access; eauto.
-  - unfold alloc_cohere in *.
-    destruct Heq as (_ & _ & <-); auto.
-Defined.
-
-(* up *)
-Lemma has_ext_noat : forall {Z} (z : Z), has_ext z |-- ALL x : _, res_predicates.noat x.
-Proof.
-  intros; unfold has_ext, own.own.
-  change (@predicates_hered.exp rmap ag_rmap _) with (@exp mpred _).
-  apply exp_left; intro.
- unfold own.Own.
- change (@predicates_hered.andp rmap ag_rmap _) with (@andp mpred _).
-  apply andp_left1.
-  apply derives_refl.
-Qed.
-
-Lemma inflate_store_join1 : forall phi1 phi2 phi3 m (J : join phi1 phi2 phi3)
-  (Hno : app_pred (ALL x : _, res_predicates.noat x) phi1),
-  join phi1 (inflate_store m phi2) (inflate_store m phi3).
+Lemma mem_auth_equiv : forall m m' (Heq : mem_equiv m m'), mem_auth m ⊢ mem_auth m'.
 Proof.
   intros.
-  destruct (join_level _ _ _ J).
-  apply resource_at_join2; intros; unfold inflate_store;
-    rewrite ?level_make_rmap, ?resource_at_make_rmap, ?ghost_of_make_rmap; try apply ghost_of_join; auto.
-  apply (resource_at_join _ _ _ loc) in J.
-  specialize (Hno loc).
-  apply empty_NO in Hno as [Hno | (? & ? & Hno)]; rewrite Hno in *; inv J; try constructor; auto.
-  rewrite H0.
-  destruct k; constructor; auto.
-Qed.
-
-Lemma inflate_store_join : forall phi1 phi2 phi3 m (J : join phi1 phi2 phi3),
-  join (inflate_store m phi1) (inflate_store m phi2) (inflate_store m phi3).
-Proof.
-  intros.
-  destruct (join_level _ _ _ J) as [H1 H2].
-  apply resource_at_join2; intros; unfold inflate_store;
-    rewrite ?level_make_rmap, ?resource_at_make_rmap, ?ghost_of_make_rmap; try apply ghost_of_join; auto.
-  apply (resource_at_join _ _ _ loc) in J.
-  rewrite H1, H2.
-  inv J; try constructor; auto; destruct k; constructor; auto.
-Qed.
-
-Lemma rebuild_store : forall jm0 phi m m' b o lv phi0 phi1 loc
-  (Hlevel : (level phi <= level (m_phi jm0))%nat)
-  (Hrebuild : compcert_rmaps.R.resource_at phi =
-     compcert_rmaps.R.resource_fmap (compcert_rmaps.R.approx (level phi))
-       (compcert_rmaps.R.approx (level phi))
-     oo juicy_mem_lemmas.rebuild_juicy_mem_fmap jm0 m)
-  (Hstore : Mem.storebytes (m_dry jm0) b o lv = Some m') (Heq : mem_equiv m m')
-  (J : join phi0 phi1 (m_phi jm0))
-  (Hout1 : forall l sh rsh k p, phi1 @ l = YES sh rsh k p -> ~ adr_range (b, o) (Zlength lv) l),
-  join (age_to.age_to (level phi) (inflate_store m' phi0) @ loc)
-         (age_to.age_to (level phi) phi1 @ loc) (phi @ loc).
-Proof.
-  intros.
-  destruct (join_level _ _ _ J).
-  rewrite Hrebuild, !age_to_resource_at.age_to_resource_at.
-  unfold compose, inflate_store, juicy_mem_lemmas.rebuild_juicy_mem_fmap; rewrite !resource_at_make_rmap.
-  apply (resource_at_join _ _ _ loc) in J.
-  simpl.
-  inv J; try constructor.
-  - rewrite if_false; [constructor; auto|].
-    erewrite mem_equiv_access by eauto.
-    erewrite <- storebytes_access by eauto.
-    destruct jm0; simpl in *.
-    rewrite (JMaccess loc), <- H4; simpl.
-    if_tac; auto.
-    intro X; inv X.
-  - destruct k; try (rewrite resource_fmap_fmap, approx_oo_approx', approx'_oo_approx by lia; constructor; auto).
-    destruct jm0; simpl in *.
-    pose proof (JMaccess loc) as Haccess.
-    rewrite <- H4 in Haccess; simpl in Haccess.
-    erewrite storebytes_access, <- mem_equiv_access in Haccess by eauto.
-    destruct loc as (b', o').
-    erewrite <- mem_equiv_contents; eauto.
-    rewrite Haccess, if_true.
-    constructor; auto.
-    { unfold perm_of_sh.
-      if_tac; if_tac; constructor || contradiction. }
-    { eapply access_at_readable; eauto. }
-  - destruct k; try (constructor; auto).
-    pose proof (juicy_mem_access jm0 loc) as Haccess.
-    rewrite <- H4 in Haccess; simpl in Haccess.
-    erewrite storebytes_access, <- mem_equiv_access in Haccess by eauto.
-    rewrite Haccess, if_true.
-    destruct loc as (b', o').
-    erewrite mem_equiv_contents; eauto.
-    exploit (juicy_mem_contents jm0); eauto; intros []; subst.
-    erewrite (storebytes_phi_elsewhere_eq _ _ _ _ _ Hstore); eauto.
-    constructor; auto.
-    { eapply access_at_readable; eauto. }
-    { unfold perm_of_sh.
-      if_tac; if_tac; constructor || contradiction. }
-  - destruct k; try (rewrite resource_fmap_fmap, approx_oo_approx', approx'_oo_approx by lia; constructor; auto).
-    pose proof (juicy_mem_access jm0 loc) as Haccess.
-    rewrite <- H4 in Haccess; simpl in Haccess.
-    erewrite storebytes_access, <- mem_equiv_access in Haccess by eauto.
-    rewrite Haccess, if_true.
-    destruct loc as (b', o').
-    erewrite (mem_equiv_contents m); eauto.
-    exploit (juicy_mem_contents jm0); eauto; intros []; subst.
-    erewrite (storebytes_phi_elsewhere_eq _ _ _ _ _ Hstore); eauto.
-    constructor; auto.
-    { eapply access_at_readable; eauto. }
-    { unfold perm_of_sh.
-      if_tac; if_tac; constructor || contradiction. }
-Qed.
-
-Lemma rebuild_alloc : forall jm0 phi m len phi0 phi1 loc
-  (Hlevel : (level phi <= level (m_phi jm0))%nat)
-  (Hrebuild : compcert_rmaps.R.resource_at phi =
-     compcert_rmaps.R.resource_fmap (compcert_rmaps.R.approx (level phi))
-       (compcert_rmaps.R.approx (level phi))
-     oo juicy_mem_lemmas.rebuild_juicy_mem_fmap jm0 m)
-  (Hno : forall ofs : Z,
-      phi0 @ (Mem.nextblock (m_dry jm0), ofs) = NO Share.bot bot_unreadable)
-  (Heq : mem_equiv m (fst (Mem.alloc (m_dry jm0) 0 len)))
-  (J : join phi0 phi1 (m_phi jm0)),
-  join (age_to.age_to (level phi) (after_alloc 0 len (Mem.nextblock (m_dry jm0)) phi0 Hno) @ loc)
-         (age_to.age_to (level phi) phi1 @ loc) (phi @ loc).
+  rewrite /mem_auth.
+  apply bi.exist_mono; intros σ.
+  iIntros "(%Hcoh & $)"; iPureIntro; split; last done.
+  unfold coherent in *.
+  intros loc; specialize (Hcoh loc).
+  unfold coherent_loc, contents_cohere, access_cohere in *;
+    destruct Hcoh as (Hnext & Hcontents & Haccess); split3.
+  - destruct Heq as (_ & _ & <-); done.
+  - intros.
+    destruct loc as (b, o); erewrite <- mem_equiv_contents; eauto.
+    rewrite /resource_at /resR_to_resource in H Haccess.
+    destruct (σ !! (b, o))%stdpp eqn: Hloc; rewrite Hloc // /= in H Haccess.
+    destruct s; inv H.
+    simpl in *.
+    destruct dq as [[]|]; try done; rewrite H1 /= in Haccess.
+    + rewrite perm_access.
+      eapply perm_order''_trans; eauto.
+      by apply perm_of_readable_share.
+    + if_tac in Haccess; try done.
+      rewrite perm_access.
+      eapply perm_order''_trans; eauto.
+  - erewrite <- mem_equiv_access; eauto.
+Qed.
+
+Lemma storebytes_nil : forall m b o m', Mem.storebytes m b o [] = Some m' ->
+  mem_equiv m m'.
+Proof.
+  intros; split3.
+  - by symmetry; do 3 extensionality; eapply mem_lemmas.loadbytes_storebytes_nil.
+  - rewrite /Mem.perm.
+    by do 4 extensionality; erewrite <- Mem.storebytes_access.
+  - by erewrite <- Mem.nextblock_storebytes.
+Qed.
+
+Lemma data_at__storebytes : forall {CS : compspecs} m m' sh z b o lv (Hsh : writable_share sh)
+  (Hty : Forall (tc_val' tuchar) lv)
+  (Hstore : Mem.storebytes m b (Ptrofs.unsigned o) (concat (map (encode_val Mint8unsigned) lv)) = Some m')
+  (Hz : z = Zlength lv),
+  mem_auth m ∗ data_at_ sh (tarray tuchar z) (Vptr b o) ⊢ |==>
+  mem_auth m' ∗ data_at sh (tarray tuchar z) lv (Vptr b o).
 Proof.
   intros.
-  destruct (join_level _ _ _ J).
-  rewrite Hrebuild, !age_to_resource_at.age_to_resource_at.
-  unfold compose, after_alloc, juicy_mem_lemmas.rebuild_juicy_mem_fmap; rewrite !resource_at_make_rmap.
-  unfold after_alloc'.
-  apply (resource_at_join _ _ _ loc) in J.
-  assert (Mem.alloc (m_dry jm0) 0 len = (fst (Mem.alloc (m_dry jm0) 0 len), Mem.nextblock (m_dry jm0))) as Halloc.
-  { destruct (Mem.alloc (m_dry jm0) 0 len) eqn: Halloc; simpl; f_equal.
-      eapply Mem.alloc_result; eauto. }
-  if_tac.
-  - (* allocated block *)
-    edestruct alloc_dry_updated_on as [Haccess Hcontents]; eauto.
-    destruct loc, H1; subst.
-    destruct jm0; simpl in *.
-    rewrite JMalloc in * by (simpl; Lia.lia).
-    inv J.
-    rewrite if_true.
-    erewrite mem_equiv_contents, Hcontents; try apply Heq.
-    apply join_Bot in RJ as []; subst.
-    constructor; auto.
-    { destruct Heq as (_ & -> & _).
-      eapply Mem.perm_implies; [eapply Mem.perm_alloc_2; eauto; lia | constructor]. }
-    { erewrite mem_equiv_access, Haccess by apply Heq; constructor. }
-  - edestruct alloc_dry_unchanged_on as [Haccess Hcontents]; eauto.
-    simpl.
-    inv J; try constructor.
-    + rewrite if_false; [constructor; auto|].
-      erewrite mem_equiv_access by eauto.
-      rewrite <- Haccess.
-      destruct jm0; simpl in *.
-      rewrite (JMaccess loc), <- H5; simpl.
-      if_tac; auto.
-      intro X; inv X.
-    + destruct k; try (constructor; auto).
-      destruct jm0; simpl in *.
-      pose proof (JMaccess loc) as Haccess'.
-      rewrite <- H5 in Haccess'; simpl in Haccess'.
-      erewrite Haccess, <- mem_equiv_access in Haccess' by eauto.
-      destruct loc as (b', o').
-      assert (Mem.perm_order'' (perm_of_sh sh3) (Some Readable)).
-      { unfold perm_of_sh.
-        if_tac; if_tac; constructor || contradiction. }
-      erewrite mem_equiv_contents; eauto.
-      rewrite Haccess', <- Hcontents, if_true; auto.
-      symmetry in H5; apply JMcontents in H5 as []; subst.
-      constructor; auto.
-      { rewrite JMaccess, <- H5; simpl.
-        unfold perm_of_sh.
-        if_tac; if_tac; auto; discriminate. }
-      { rewrite perm_access, Haccess'; auto. }
-    + destruct k; try (constructor; auto).
-      pose proof (juicy_mem_access jm0 loc) as Haccess'.
-      rewrite <- H5 in Haccess'; simpl in Haccess'.
-      erewrite Haccess, <- mem_equiv_access in Haccess' by eauto.
-      assert (Mem.perm_order'' (perm_of_sh sh3) (Some Readable)).
-      { unfold perm_of_sh.
-        if_tac; if_tac; constructor || contradiction. }
-      rewrite Haccess', if_true; auto.
-      destruct loc as (b', o').
-      destruct jm0; simpl in *.
-      erewrite mem_equiv_contents; eauto.
-      rewrite <- Hcontents.
-      symmetry in H5; apply JMcontents in H5 as []; subst.
-      constructor; auto.
-      { rewrite JMaccess, <- H5; simpl.
-        unfold perm_of_sh.
-        if_tac; if_tac; auto; discriminate. }
-      { rewrite perm_access, Haccess'; auto. }
-  + destruct k; try (constructor; auto).
-      pose proof (juicy_mem_access jm0 loc) as Haccess'.
-      rewrite <- H5 in Haccess'; simpl in Haccess'.
-      erewrite Haccess, <- mem_equiv_access in Haccess' by eauto.
-      assert (Mem.perm_order'' (perm_of_sh sh3) (Some Readable)).
-      { unfold perm_of_sh.
-        if_tac; if_tac; constructor || contradiction. }
-      rewrite Haccess', if_true; auto.
-      destruct loc as (b', o').
-      destruct jm0; simpl in *.
-      erewrite mem_equiv_contents; eauto.
-      rewrite <- Hcontents.
-      symmetry in H5; apply JMcontents in H5 as []; subst.
-      constructor; auto.
-      { rewrite JMaccess, <- H5; simpl.
-        unfold perm_of_sh.
-        if_tac; if_tac; auto; discriminate. }
-      { rewrite perm_access, Haccess'; auto. }
-Qed.
-
-Lemma inflate_emp : forall m phi, app_pred emp phi -> app_pred emp (inflate_store m phi).
-Proof.
-  simpl; intros.
-  setoid_rewrite res_predicates.emp_no in H. setoid_rewrite res_predicates.emp_no.
-  intros l; unfold inflate_store; simpl. rewrite resource_at_make_rmap.
-  specialize (H l); simpl in H.
-  destruct (phi @ l); auto.
-  apply YES_not_identity in H; contradiction.
+  remember (Z.to_nat z) as n; generalize dependent o; generalize dependent lv; generalize dependent z; generalize dependent m; induction n; intros; subst.
+  { destruct lv; try done; simpl in *.
+    rewrite mem_auth_equiv; last by eapply storebytes_nil.
+    rewrite data_at__Tarray Zlength_nil Zrepeat_0; auto.
+    { rewrite Zlength_cons in Heqn; rep_lia. } }
+  assert_PROP (field_compatible (tarray tuchar (Zlength lv)) [] (Vptr b o)) by entailer!.
+  rewrite (split2_data_at__Tarray_tuchar _ _ 1) // /=; last lia.
+  iIntros "(Hm & H & Hrest)".
+  rewrite /field_address0 if_true /=.
+  2: { rewrite field_compatible0_cons; split; auto; lia. }
+  destruct lv; first done; simpl in *.
+  apply Mem.storebytes_split in Hstore as (? & Hstore1 & Hstore2).
+  apply Mem.storebytes_store in Hstore1; last by apply Z.divide_1_l.
+  rewrite data_at__eq data_at_tuchar_singleton_array_inv /=.
+  iAssert ⌜field_compatible tuchar [] (Vptr b o)⌝ with "[H]" as %?.
+  { unfold data_at, field_at; iDestruct "H" as "($ & _)". }
+  erewrite <- mapsto_data_at' by done.
+  inv Hty.
+  iMod (lifting.mapsto_store with "[$Hm $H]") as "(Hm & H)"; [eauto..|].
+  rewrite encode_val_length /= in Hstore2.
+  rewrite /Ptrofs.add Ptrofs.unsigned_repr //.
+  rewrite -> Zlength_cons in *.
+  iMod (IHn with "[$Hm $Hrest]") as "($ & Hrest)"; [lia || done..| |].
+  { rewrite Ptrofs.unsigned_repr //.
+    destruct H as (_ & _ & H & _); simpl in H; rep_lia. }
+  rewrite (split2_data_at_Tarray_tuchar _ (Z.succ (Zlength lv)) 1) // /=; try lia.
+  2: { apply Zlength_cons. }
+  rewrite sublist_0_cons // sublist_nil sublist_1_cons sublist_same //; last lia.
+  rewrite -data_at_tuchar_singleton_array.
+  erewrite mapsto_data_at' by done.
+  rewrite /field_address0 if_true /=.
+  by iFrame.
+  { rewrite field_compatible0_cons; split; auto; lia. }
 Qed.
 
 Lemma encode_vals_length : forall lv,
   length (concat (map (encode_val Mint8unsigned) lv)) = length lv.
 Proof.
   induction lv; auto; simpl.
-  rewrite app_length, IHlv.
-  unfold encode_val; simpl.
-  destruct a; auto.
+  rewrite app_length IHlv encode_val_length //.
 Qed.
 
-Lemma store_bytes_data_at : forall {CS : compspecs} phi m0 m sh lv b o
-  (Hsh : readable_share sh) (Hvals : Forall (fun v => exists i, v = Vint i /\ Int.unsigned i <= Byte.max_unsigned) lv)
-  (Hdata : app_pred (res_predicates.VALspec_range (Zlength lv) sh (b, Ptrofs.unsigned o)) phi)
-  (Hstore : Mem.storebytes m0 b (Ptrofs.unsigned o) (concat (map (encode_val Mint8unsigned) lv)) = Some m)
-  (Hbounds : Ptrofs.unsigned o + Zlength lv <= Ptrofs.max_unsigned),
-  app_pred (data_at sh (tarray tuchar (Zlength lv)) lv (Vptr b o)) (inflate_store m phi).
-Proof.
-  split.
-  { split; simpl; auto.
-    split; auto.
-    split; [rewrite Z.max_r by rep_lia; unfold Ptrofs.max_unsigned in Hbounds; lia|].
-    split; auto.
-    constructor.
-    intros; econstructor; simpl; eauto.
-    apply Z.divide_1_l. }
-  unfold at_offset; rewrite data_at_rec_eq; simpl.
-  rewrite Z.max_r by rep_lia.
-  rewrite ptrofs_add_repr_0_r.
-  unfold unfold_reptype; simpl.
-  split.
-  { rewrite Z.sub_0_r; reflexivity. }
-  rewrite Z.sub_0_r.
-  rewrite <- (Z.add_0_r (Ptrofs.unsigned o)) in Hdata.
-  remember 0 as lo.
-  assert (0 <= lo) by lia.
-  rewrite Heqlo; rewrite <- Heqlo at 1.
-  remember (Z.to_nat (Zlength lv)) as n.
-  replace (Zlength lv) with (Z.of_nat n) in Hdata by (subst; rewrite Z2Nat.id; rep_lia).
-  assert (lo + Z.of_nat n = Zlength lv) as Hlen.
-  { subst; rewrite Z2Nat.id; rep_lia. }
-  clear Heqlo Heqn.
-  generalize dependent lo; generalize dependent phi; induction n; intros.
-  - rewrite res_predicates.VALspec_range_0 in Hdata; simpl.
-    apply inflate_emp; auto.
-  - rewrite Nat2Z.inj_succ, res_predicates.VALspec_range_split2 with (n := 1)(m := Z.of_nat n) in Hdata by lia.
-    destruct Hdata as (phi1 & phi2 & J & Hval1 & Hval2).
-    rewrite Nat2Z.inj_succ in Hlen.
-    rewrite <- Z.add_assoc in Hval2; apply IHn in Hval2; try lia.
-    eexists _, _; split; [apply inflate_store_join; eauto|].
-    split; auto.
-    unfold at_offset.
-    rewrite data_at_rec_eq; simpl.
-    unfold unfold_reptype; simpl.
-    rewrite Z.sub_0_r.
-    unfold mapsto; simpl.
-    rewrite if_true by auto.
-    left.
-    apply Forall_Znth with (i := lo) in Hvals as (i & Hi & ?); try lia.
-    split.
-    { setoid_rewrite Hi; auto. }
-    unfold res_predicates.address_mapsto.
-    exists [Byte (Byte.repr (Int.unsigned i))].
-    split.
-    { split; auto.
-      setoid_rewrite Hi.
-      split; [|apply Z.divide_1_l].
-      unfold decode_val; simpl.
-      unfold decode_int; simpl.
-      rewrite rev_if_be_singleton; simpl.
-      rewrite Byte.unsigned_repr by rep_lia.
-      rewrite Z.add_0_r, Int.repr_unsigned.
-      rewrite zero_ext_inrange; auto. }
-    intro l; simpl.
-    unfold inflate_store; rewrite resource_at_make_rmap.
-    specialize (Hval1 l); simpl in Hval1.
-    unfold Ptrofs.add.
-    replace (Ptrofs.unsigned (Ptrofs.repr (1 * lo))) with lo
-      by (rewrite Ptrofs.unsigned_repr; rep_lia).
-    rewrite Ptrofs.unsigned_repr by rep_lia.
-    if_tac.
-    + destruct Hval1 as (mv & rsh & ->); exists rsh.
-      destruct l as (b', o'); destruct H1; subst.
-      assert (o' = Ptrofs.unsigned o + lo) by lia; subst; simpl.
-      rewrite Z.sub_diag; simpl; f_equal; f_equal.
-      Transparent Mem.storebytes.
-      unfold Mem.storebytes in Hstore.
-      Opaque Mem.storebytes.
-      if_tac in Hstore; inv Hstore; unfold contents_at; simpl.
-      rewrite PMap.gss.
-      replace lv with (sublist 0 lo lv ++ Znth lo lv :: sublist (lo + 1) (Zlength lv) lv).
-      rewrite map_app, concat_app; simpl.
-      rewrite Mem.setN_concat.
-      rewrite Hi; simpl.
-      unfold encode_int; simpl.
-      rewrite rev_if_be_singleton; simpl.
-      rewrite encode_vals_length, <- Zlength_correct.
-      rewrite Zlength_sublist, Mem.setN_outside by lia.
-      rewrite Z.sub_0_r, ZMap.gss; auto.
-      { rewrite <- sublist_next, sublist_rejoin, sublist_same by lia; auto. }
-  + destruct (phi1 @ l); auto.
-    apply YES_not_identity in Hval1; contradiction.
-Qed.
-
-Definition main_pre_dry {Z} (m : mem) (prog : Clight.program) (ora : Z)
-  (ts : list Type) (gv : globals) (z : Z) :=
+Definition main_pre_dry (m : mem) (prog : Clight.program) (ora : OK_ty)
+  (ts : list Type) (gv : globals) (z : OK_ty) :=
   Genv.globals_initialized (Genv.globalenv prog) (Genv.globalenv prog) m /\ z = ora.
 
-Definition main_post_dry {Z} (m0 m : mem) (prog : Clight.program) (ora : Z)
-  (ts : list Type) (gv : globals) (z : Z) := True. (* the desired postcondition might vary by program *)
+Definition main_post_dry (m0 m : mem) (prog : Clight.program) (ora : OK_ty)
+  (ts : list Type) (gv : globals) (z : OK_ty) : Prop := True. (* the desired postcondition might vary by program *)
 
 (* simulate funspec2pre/post *)
 
-Definition main_pre_juicy {Z} prog (ora : Z) gv (x' : rmap * {ts : list Type & unit})
+(*Definition main_pre_juicy {Z} prog (ora : Z) gv (x' : rmap * {ts : list Type & unit})
   (ge_s: extspec.injective_PTree block) args (z : Z) (m : juicy_mem) :=
     Val.has_type_list args [] /\
 (*    (exists phi0 phi1 : rmap,
@@ -879,58 +301,6 @@ Definition main_post_juicy {Z} prog (ora : Z) gv (x' : rmap * {ts : list Type &
          (m_phi m)(*phi0 /\
        necR (fst x') phi1*) /\ joins (ghost_of (m_phi m)) [Some (ext_ref z, NoneP)]).
 
-Lemma ext_compat_sub : forall {Z} (z : Z) a b, semax.ext_compat z b -> join_sub a b ->
-  semax.ext_compat z a.
-Proof.
-  unfold semax.ext_compat; intros.
-  eapply join_sub_joins_trans; eauto.
-  destruct H0; eexists; apply ghost_of_join; eauto.
-Qed.
-
-Lemma ext_ghost_join' : forall {Z} (z z' : Z) (p p' : preds) c, join (Some (ext_ghost z, p)) (Some (ext_ref z', p')) c ->
-  z = z' /\ p = p'.
-Proof.
-  intros.
-  apply ext_ghost_join in H as [[]|[]]; subst.
-  - assert (ghost.valid(Ghost := ext_PCM Z) (None, None)) as H.
-    { split; simpl; auto. }
-    specialize (H0 (exist _ (None, None) H)); inv H0.
-    destruct H4 as [J _]; simpl in *.
-    inv J.
-    repeat inj_pair_tac.
-    destruct H1 as [_ J]; inv J.
-  - assert (ext_ref z' = ext_ref z) as Heq by congruence.
-    unfold ext_ref in Heq; inj_pair_tac.
-    inv H0; inv H; auto.
-Qed.
-
-Lemma has_ext_compat : forall {Z} (z1 z2 : Z) a b, app_pred (has_ext z1) a ->
-  join_sub a b -> semax.ext_compat z2 b -> z1 = z2 /\
-    ghost_of a = (Some (ext_ghost z1, NoneP)) :: tl (ghost_of a) /\
-    ghost_of b = (Some (ext_ghost z1, NoneP)) :: tl (ghost_of b).
-Proof.
-  intros.
-  destruct H as [? [_ H]].
-  destruct H, H1, H0 as [? Hsub%ghost_of_join].
-  rewrite own.ghost_fmap_singleton in H; apply own.singleton_join_inv_gen in H as (? & (?, ?) & ? & ?).
-  rewrite H2 in *; unfold own.list_set in *; simpl in *.
-  match goal with H : join ?a _ _ |- _ => replace a with (Some (ext_ghost z1, NoneP)) in H
-    by (unfold ext_ghost; repeat f_equal) end.
-  apply ext_ghost_join in H as [[]|[]]; subst.
-  - inv H.
-    inv Hsub.
-    + rewrite <- H6 in H1; inv H1.
-      apply ext_ghost_join' in H10 as []; subst; auto.
-    + rewrite <- H6 in H1; inv H1.
-      apply ext_ghost_join in H7 as [[]|[]]; subst.
-      * apply ext_ghost_join' in H12 as []; subst; auto.
-      * exfalso; eapply no_two_ref; eexists; eauto.
-  - inv H3.
-    destruct (join_assoc (join_comm Hsub) H1) as (? & ? & ?).
-    inv H3.
-    exfalso; eapply no_two_ref; eexists; eauto.
-Qed.
-
 Lemma main_dry : forall {Z} prog (ora : Z) ts gv,
   (forall t b vl x jm,
   Genv.init_mem (program_of_program prog) = Some (m_dry jm) ->
@@ -959,4 +329,6 @@ Proof.
     eexists; constructor; constructor.
     instantiate (1 := (_, _)); constructor; simpl; [|constructor; auto].
     apply ext_ref_join.
-Qed.
+Qed.*)
+
+End mpred.
diff --git a/progs/incr.c b/progs/incr.c
index 2b2dea2608..a68f4759ad 100644
--- a/progs/incr.c
+++ b/progs/incr.c
@@ -1,7 +1,7 @@
 #include "../concurrency/threads.h"
 //#include <stdio.h>
 
-typedef struct counter { unsigned ctr; lock_t *lock; } counter;
+typedef struct counter { unsigned ctr; lock_t lock; } counter;
 counter c;
 
 void incr() {
@@ -21,16 +21,16 @@ int thread_func(void *thread_lock) {
   //Increment the counter
   incr();
   //Yield: 'ready to join'.
-  release((lock_t *)thread_lock);
+  release((lock_t)thread_lock);
   return 0;
 }
 
-int main(void)
+int compute2(void)
 {
   c.ctr = 0;
   c.lock = makelock();
   release(c.lock);
-  lock_t *thread_lock = makelock();
+  lock_t thread_lock = makelock();
   /* Spawn */
   spawn((void *)&thread_func, (void *)thread_lock);
 
@@ -49,3 +49,7 @@ int main(void)
 
   return t;
 }
+
+int main(void) {
+ return compute2();
+}
diff --git a/progs/incr.v b/progs/incr.v
index f2d3d8734c..2d25271e2e 100644
--- a/progs/incr.v
+++ b/progs/incr.v
@@ -78,6 +78,7 @@ Definition ___compcert_va_int64 : ident := $"__compcert_va_int64".
 Definition _acquire : ident := $"acquire".
 Definition _atom_int : ident := $"atom_int".
 Definition _c : ident := $"c".
+Definition _compute2 : ident := $"compute2".
 Definition _counter : ident := $"counter".
 Definition _ctr : ident := $"ctr".
 Definition _freelock : ident := $"freelock".
@@ -110,19 +111,18 @@ Definition f_incr := {|
   fn_callconv := cc_default;
   fn_params := nil;
   fn_vars := nil;
-  fn_temps := ((_t'3, (tptr (tptr (Tstruct _atom_int noattr)))) ::
-               (_t'2, tuint) ::
-               (_t'1, (tptr (tptr (Tstruct _atom_int noattr)))) :: nil);
+  fn_temps := ((_t'3, (tptr (Tstruct _atom_int noattr))) :: (_t'2, tuint) ::
+               (_t'1, (tptr (Tstruct _atom_int noattr))) :: nil);
   fn_body :=
 (Ssequence
   (Ssequence
     (Sset _t'3
       (Efield (Evar _c (Tstruct _counter noattr)) _lock
-        (tptr (tptr (Tstruct _atom_int noattr)))))
+        (tptr (Tstruct _atom_int noattr))))
     (Scall None
       (Evar _acquire (Tfunction ((tptr (Tstruct _atom_int noattr)) :: nil)
                        tvoid cc_default))
-      ((Etempvar _t'3 (tptr (tptr (Tstruct _atom_int noattr)))) :: nil)))
+      ((Etempvar _t'3 (tptr (Tstruct _atom_int noattr))) :: nil)))
   (Ssequence
     (Ssequence
       (Sset _t'2 (Efield (Evar _c (Tstruct _counter noattr)) _ctr tuint))
@@ -132,11 +132,11 @@ Definition f_incr := {|
     (Ssequence
       (Sset _t'1
         (Efield (Evar _c (Tstruct _counter noattr)) _lock
-          (tptr (tptr (Tstruct _atom_int noattr)))))
+          (tptr (Tstruct _atom_int noattr))))
       (Scall None
         (Evar _release (Tfunction ((tptr (Tstruct _atom_int noattr)) :: nil)
                          tvoid cc_default))
-        ((Etempvar _t'1 (tptr (tptr (Tstruct _atom_int noattr)))) :: nil)))))
+        ((Etempvar _t'1 (tptr (Tstruct _atom_int noattr))) :: nil)))))
 |}.
 
 Definition f_read := {|
@@ -144,31 +144,30 @@ Definition f_read := {|
   fn_callconv := cc_default;
   fn_params := nil;
   fn_vars := nil;
-  fn_temps := ((_t, tuint) ::
-               (_t'2, (tptr (tptr (Tstruct _atom_int noattr)))) ::
-               (_t'1, (tptr (tptr (Tstruct _atom_int noattr)))) :: nil);
+  fn_temps := ((_t, tuint) :: (_t'2, (tptr (Tstruct _atom_int noattr))) ::
+               (_t'1, (tptr (Tstruct _atom_int noattr))) :: nil);
   fn_body :=
 (Ssequence
   (Ssequence
     (Sset _t'2
       (Efield (Evar _c (Tstruct _counter noattr)) _lock
-        (tptr (tptr (Tstruct _atom_int noattr)))))
+        (tptr (Tstruct _atom_int noattr))))
     (Scall None
       (Evar _acquire (Tfunction ((tptr (Tstruct _atom_int noattr)) :: nil)
                        tvoid cc_default))
-      ((Etempvar _t'2 (tptr (tptr (Tstruct _atom_int noattr)))) :: nil)))
+      ((Etempvar _t'2 (tptr (Tstruct _atom_int noattr))) :: nil)))
   (Ssequence
     (Sset _t (Efield (Evar _c (Tstruct _counter noattr)) _ctr tuint))
     (Ssequence
       (Ssequence
         (Sset _t'1
           (Efield (Evar _c (Tstruct _counter noattr)) _lock
-            (tptr (tptr (Tstruct _atom_int noattr)))))
+            (tptr (Tstruct _atom_int noattr))))
         (Scall None
           (Evar _release (Tfunction
                            ((tptr (Tstruct _atom_int noattr)) :: nil) tvoid
                            cc_default))
-          ((Etempvar _t'1 (tptr (tptr (Tstruct _atom_int noattr)))) :: nil)))
+          ((Etempvar _t'1 (tptr (Tstruct _atom_int noattr))) :: nil)))
       (Sreturn (Some (Etempvar _t tuint))))))
 |}.
 
@@ -186,120 +185,130 @@ Definition f_thread_func := {|
       (Evar _release (Tfunction ((tptr (Tstruct _atom_int noattr)) :: nil)
                        tvoid cc_default))
       ((Ecast (Etempvar _thread_lock (tptr tvoid))
-         (tptr (tptr (Tstruct _atom_int noattr)))) :: nil))
+         (tptr (Tstruct _atom_int noattr))) :: nil))
     (Sreturn (Some (Econst_int (Int.repr 0) tint)))))
 |}.
 
-Definition f_main := {|
+Definition f_compute2 := {|
   fn_return := tint;
   fn_callconv := cc_default;
   fn_params := nil;
   fn_vars := nil;
-  fn_temps := ((_thread_lock, (tptr (tptr (Tstruct _atom_int noattr)))) ::
+  fn_temps := ((_thread_lock, (tptr (Tstruct _atom_int noattr))) ::
                (_t, tuint) :: (_t'3, tuint) ::
                (_t'2, (tptr (Tstruct _atom_int noattr))) ::
                (_t'1, (tptr (Tstruct _atom_int noattr))) ::
-               (_t'6, (tptr (tptr (Tstruct _atom_int noattr)))) ::
-               (_t'5, (tptr (tptr (Tstruct _atom_int noattr)))) ::
-               (_t'4, (tptr (tptr (Tstruct _atom_int noattr)))) :: nil);
+               (_t'6, (tptr (Tstruct _atom_int noattr))) ::
+               (_t'5, (tptr (Tstruct _atom_int noattr))) ::
+               (_t'4, (tptr (Tstruct _atom_int noattr))) :: nil);
   fn_body :=
 (Ssequence
+  (Sassign (Efield (Evar _c (Tstruct _counter noattr)) _ctr tuint)
+    (Econst_int (Int.repr 0) tint))
   (Ssequence
-    (Sassign (Efield (Evar _c (Tstruct _counter noattr)) _ctr tuint)
-      (Econst_int (Int.repr 0) tint))
+    (Ssequence
+      (Scall (Some _t'1)
+        (Evar _makelock (Tfunction nil (tptr (Tstruct _atom_int noattr))
+                          cc_default)) nil)
+      (Sassign
+        (Efield (Evar _c (Tstruct _counter noattr)) _lock
+          (tptr (Tstruct _atom_int noattr)))
+        (Etempvar _t'1 (tptr (Tstruct _atom_int noattr)))))
     (Ssequence
       (Ssequence
-        (Scall (Some _t'1)
-          (Evar _makelock (Tfunction nil (tptr (Tstruct _atom_int noattr))
-                            cc_default)) nil)
-        (Sassign
+        (Sset _t'6
           (Efield (Evar _c (Tstruct _counter noattr)) _lock
-            (tptr (tptr (Tstruct _atom_int noattr))))
-          (Etempvar _t'1 (tptr (Tstruct _atom_int noattr)))))
+            (tptr (Tstruct _atom_int noattr))))
+        (Scall None
+          (Evar _release (Tfunction
+                           ((tptr (Tstruct _atom_int noattr)) :: nil) tvoid
+                           cc_default))
+          ((Etempvar _t'6 (tptr (Tstruct _atom_int noattr))) :: nil)))
       (Ssequence
         (Ssequence
-          (Sset _t'6
-            (Efield (Evar _c (Tstruct _counter noattr)) _lock
-              (tptr (tptr (Tstruct _atom_int noattr)))))
-          (Scall None
-            (Evar _release (Tfunction
-                             ((tptr (Tstruct _atom_int noattr)) :: nil) tvoid
-                             cc_default))
-            ((Etempvar _t'6 (tptr (tptr (Tstruct _atom_int noattr)))) :: nil)))
+          (Scall (Some _t'2)
+            (Evar _makelock (Tfunction nil (tptr (Tstruct _atom_int noattr))
+                              cc_default)) nil)
+          (Sset _thread_lock
+            (Etempvar _t'2 (tptr (Tstruct _atom_int noattr)))))
         (Ssequence
+          (Scall None
+            (Evar _spawn (Tfunction
+                           ((tptr (Tfunction ((tptr tvoid) :: nil) tint
+                                    cc_default)) :: (tptr tvoid) :: nil)
+                           tvoid cc_default))
+            ((Ecast
+               (Eaddrof
+                 (Evar _thread_func (Tfunction ((tptr tvoid) :: nil) tint
+                                      cc_default))
+                 (tptr (Tfunction ((tptr tvoid) :: nil) tint cc_default)))
+               (tptr tvoid)) ::
+             (Ecast (Etempvar _thread_lock (tptr (Tstruct _atom_int noattr)))
+               (tptr tvoid)) :: nil))
           (Ssequence
-            (Scall (Some _t'2)
-              (Evar _makelock (Tfunction nil
-                                (tptr (Tstruct _atom_int noattr)) cc_default))
-              nil)
-            (Sset _thread_lock
-              (Etempvar _t'2 (tptr (Tstruct _atom_int noattr)))))
-          (Ssequence
-            (Scall None
-              (Evar _spawn (Tfunction
-                             ((tptr (Tfunction ((tptr tvoid) :: nil) tint
-                                      cc_default)) :: (tptr tvoid) :: nil)
-                             tvoid cc_default))
-              ((Ecast
-                 (Eaddrof
-                   (Evar _thread_func (Tfunction ((tptr tvoid) :: nil) tint
-                                        cc_default))
-                   (tptr (Tfunction ((tptr tvoid) :: nil) tint cc_default)))
-                 (tptr tvoid)) ::
-               (Ecast
-                 (Etempvar _thread_lock (tptr (tptr (Tstruct _atom_int noattr))))
-                 (tptr tvoid)) :: nil))
+            (Scall None (Evar _incr (Tfunction nil tvoid cc_default)) nil)
             (Ssequence
-              (Scall None (Evar _incr (Tfunction nil tvoid cc_default)) nil)
+              (Scall None
+                (Evar _acquire (Tfunction
+                                 ((tptr (Tstruct _atom_int noattr)) :: nil)
+                                 tvoid cc_default))
+                ((Etempvar _thread_lock (tptr (Tstruct _atom_int noattr))) ::
+                 nil))
               (Ssequence
-                (Scall None
-                  (Evar _acquire (Tfunction
-                                   ((tptr (Tstruct _atom_int noattr)) :: nil)
-                                   tvoid cc_default))
-                  ((Etempvar _thread_lock (tptr (tptr (Tstruct _atom_int noattr)))) ::
-                   nil))
+                (Ssequence
+                  (Scall (Some _t'3)
+                    (Evar _read (Tfunction nil tuint cc_default)) nil)
+                  (Sset _t (Etempvar _t'3 tuint)))
                 (Ssequence
                   (Ssequence
-                    (Scall (Some _t'3)
-                      (Evar _read (Tfunction nil tuint cc_default)) nil)
-                    (Sset _t (Etempvar _t'3 tuint)))
+                    (Sset _t'5
+                      (Efield (Evar _c (Tstruct _counter noattr)) _lock
+                        (tptr (Tstruct _atom_int noattr))))
+                    (Scall None
+                      (Evar _acquire (Tfunction
+                                       ((tptr (Tstruct _atom_int noattr)) ::
+                                        nil) tvoid cc_default))
+                      ((Etempvar _t'5 (tptr (Tstruct _atom_int noattr))) ::
+                       nil)))
                   (Ssequence
+                    (Scall None
+                      (Evar _freelock (Tfunction
+                                        ((tptr (Tstruct _atom_int noattr)) ::
+                                         nil) tvoid cc_default))
+                      ((Etempvar _thread_lock (tptr (Tstruct _atom_int noattr))) ::
+                       nil))
                     (Ssequence
-                      (Sset _t'5
-                        (Efield (Evar _c (Tstruct _counter noattr)) _lock
-                          (tptr (tptr (Tstruct _atom_int noattr)))))
-                      (Scall None
-                        (Evar _acquire (Tfunction
-                                         ((tptr (Tstruct _atom_int noattr)) ::
-                                          nil) tvoid cc_default))
-                        ((Etempvar _t'5 (tptr (tptr (Tstruct _atom_int noattr)))) ::
-                         nil)))
-                    (Ssequence
-                      (Scall None
-                        (Evar _freelock (Tfunction
-                                          ((tptr (Tstruct _atom_int noattr)) ::
-                                           nil) tvoid cc_default))
-                        ((Etempvar _thread_lock (tptr (tptr (Tstruct _atom_int noattr)))) ::
-                         nil))
                       (Ssequence
-                        (Ssequence
-                          (Sset _t'4
-                            (Efield (Evar _c (Tstruct _counter noattr)) _lock
-                              (tptr (tptr (Tstruct _atom_int noattr)))))
-                          (Scall None
-                            (Evar _freelock (Tfunction
-                                              ((tptr (Tstruct _atom_int noattr)) ::
-                                               nil) tvoid cc_default))
-                            ((Etempvar _t'4 (tptr (tptr (Tstruct _atom_int noattr)))) ::
-                             nil)))
-                        (Sreturn (Some (Etempvar _t tuint))))))))))))))
+                        (Sset _t'4
+                          (Efield (Evar _c (Tstruct _counter noattr)) _lock
+                            (tptr (Tstruct _atom_int noattr))))
+                        (Scall None
+                          (Evar _freelock (Tfunction
+                                            ((tptr (Tstruct _atom_int noattr)) ::
+                                             nil) tvoid cc_default))
+                          ((Etempvar _t'4 (tptr (Tstruct _atom_int noattr))) ::
+                           nil)))
+                      (Sreturn (Some (Etempvar _t tuint))))))))))))))
+|}.
+
+Definition f_main := {|
+  fn_return := tint;
+  fn_callconv := cc_default;
+  fn_params := nil;
+  fn_vars := nil;
+  fn_temps := ((_t'1, tint) :: nil);
+  fn_body :=
+(Ssequence
+  (Ssequence
+    (Scall (Some _t'1) (Evar _compute2 (Tfunction nil tint cc_default)) nil)
+    (Sreturn (Some (Etempvar _t'1 tint))))
   (Sreturn (Some (Econst_int (Int.repr 0) tint))))
 |}.
 
 Definition composites : list composite_definition :=
 (Composite _counter Struct
    (Member_plain _ctr tuint ::
-    Member_plain _lock (tptr (tptr (Tstruct _atom_int noattr))) :: nil)
+    Member_plain _lock (tptr (Tstruct _atom_int noattr)) :: nil)
    noattr :: nil).
 
 Definition global_definitions : list (ident * globdef fundef type) :=
@@ -583,11 +592,12 @@ Definition global_definitions : list (ident * globdef fundef type) :=
       (tptr tvoid) :: nil) tvoid cc_default)) :: (_c, Gvar v_c) ::
  (_incr, Gfun(Internal f_incr)) :: (_read, Gfun(Internal f_read)) ::
  (_thread_func, Gfun(Internal f_thread_func)) ::
- (_main, Gfun(Internal f_main)) :: nil).
+ (_compute2, Gfun(Internal f_compute2)) :: (_main, Gfun(Internal f_main)) ::
+ nil).
 
 Definition public_idents : list ident :=
-(_main :: _thread_func :: _read :: _incr :: _c :: _spawn :: _release ::
- _acquire :: _freelock :: _makelock :: ___builtin_debug ::
+(_main :: _compute2 :: _thread_func :: _read :: _incr :: _c :: _spawn ::
+ _release :: _acquire :: _freelock :: _makelock :: ___builtin_debug ::
  ___builtin_write32_reversed :: ___builtin_write16_reversed ::
  ___builtin_read32_reversed :: ___builtin_read16_reversed ::
  ___builtin_fnmsub :: ___builtin_fnmadd :: ___builtin_fmsub ::
diff --git a/progs/io_combine.v b/progs/io_combine.v
index f8eadf1a08..1479ccf6a5 100644
--- a/progs/io_combine.v
+++ b/progs/io_combine.v
@@ -2,9 +2,6 @@ Require Import VST.floyd.proofauto.
 Require Import VST.sepcomp.extspec.
 Require Import VST.veric.semax_ext.
 Require Import VST.veric.juicy_mem.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.initial_world.
-Require Import VST.veric.ghost_PCM.
 Require Import VST.veric.SequentialClight.
 Require Import VST.veric.Clight_core.
 Require Import VST.concurrency.conclib.
@@ -18,7 +15,6 @@ Require Import VST.progs.io_os_specs.
 Require Import VST.progs.io_os_connection.
 Require Import VST.progs.os_combine.
 Require Import VST.progs.dry_mem_lemmas.
-Import Maps.
 
 Section IO_safety.
 
@@ -27,6 +23,8 @@ Variable (prog : Clight.program).
 
 Definition ext_link := ext_link_prog prog.
 
+Hypothesis ext_link_inj : forall s1 s2, List.In s1 ["getchar"; "putchar"] -> ext_link s1 = ext_link s2 -> s1 = s2.
+
 Definition sys_getc_wrap_spec (abd : RData) : option (RData * val * trace) :=
   match sys_getc_spec abd with
   | Some abd' => Some (abd', get_sys_ret abd', trace_of_ostrace (strip_common_prefix IOEvent_eq abd.(io_log) abd'.(io_log)))
@@ -78,73 +76,49 @@ Definition OS_mem (e : external_function) (args : list val) m (s : RData) : mem
   else ...
 *)
 
-Instance IO_Espec : OracleKind := IO_Espec ext_link.
-
-Hypothesis (Jsub: forall ef se lv m t v m' (EFI : ef_inline ef = true) m1
-       (EFC : Events.external_call ef se lv m t v m'), mem_sub m m1 ->
-       exists m1' (EFC1 : Events.external_call ef se lv m1 t v m1'),
-         mem_sub m' m1' /\ proj1_sig (inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC1) =
-         proj1_sig (inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC)).
-
-
-Definition extspec_frame (Espec : OracleKind) := forall e t b lt lv z jm w jm1, ext_spec_pre OK_spec e t b lt lv z jm ->
-        mem_sub (m_dry jm) (m_dry jm1) -> join (m_phi jm) w (m_phi jm1) -> semax.ext_compat z (m_phi jm1) ->
-        exists t1, ext_spec_pre OK_spec e t1 b lt lv z jm1 /\
-        forall ot v z' jm1', ext_spec_post OK_spec e t1 b ot v z' jm1' ->
-          exists jm', ext_spec_post OK_spec e t b ot v z' jm' /\ mem_sub (m_dry jm') (m_dry jm1') /\
-            join (m_phi jm') (age_to.age_to (level jm') w) (m_phi jm1').
-
+Notation IO_itree := (@IO_itree (@IO_event nat)).
 
 Theorem IO_OS_soundness:
- forall {CS: compspecs} (initial_oracle: OK_ty) V G m,
-   semax_prog prog initial_oracle V G ->
+ forall {CS: compspecs} `{!VSTGpreS IO_itree Σ} (initial_oracle: IO_itree) V (G : forall `{!VSTGS IO_itree Σ}, funspecs) m,
+   (forall {HH : VSTGS IO_itree Σ}, semax_prog(OK_spec := IO_ext_spec ext_link) prog initial_oracle V G) ->
    Genv.init_mem prog = Some m ->
    exists b, exists q,
      Genv.find_symbol (Genv.globalenv prog) (prog_main prog) = Some b /\
      initial_core (Clight_core.cl_core_sem (globalenv prog))
          0 m q m (Vptr b Ptrofs.zero) nil /\
-   forall n, exists traces, ext_safeN_trace(J := OK_spec) prog IO_ext_sem IO_inj_mem OS_mem valid_trace n TEnd traces initial_oracle q m /\
+   forall n, exists traces, ext_safeN_trace prog IO_ext_sem IO_inj_mem OS_mem valid_trace n TEnd traces initial_oracle q m /\
      forall t, In traces t -> exists z', consume_trace initial_oracle z' t.
 Proof.
-  intros; eapply OS_soundness with (dryspec := io_dry_spec ext_link); eauto.
+  intros; eapply OS_soundness with (dryspec := io_dry_spec); eauto.
   - unfold IO_ext_sem; intros; simpl in *.
     destruct H2 as [Hvalid Htrace].
     if_tac; [|if_tac; [|contradiction]].
-    + destruct w as (? & _ & ? & ?).
+    + destruct w as (? & ? & ?).
       destruct H1 as (? & ? & Hpre); subst.
       destruct s; simpl in *.
-      rewrite if_true in H3 by auto.  
+      rewrite -> if_true in H3 by auto.
       destruct (get_sys_arg1 _) eqn:Harg; try discriminate.
-      destruct i1.
-      destruct (zeq _ _); subst; try discriminate.
+      destruct (eq_dec _ _); subst; try discriminate.
       destruct (sys_putc_spec _) eqn:Hspec; inv H3.
-      assert (sig_res (ef_sig e) <> AST.Xvoid).
-      { destruct e; inv H2; discriminate. }
-      eapply sys_putc_correct in Hspec as (? & -> & [? Hpost ?]); eauto.
-      rewrite Harg. unfold Vubyte. f_equal.
-      unfold Int.repr. f_equal. apply proof_irr.
-    + destruct w as (? & _ & ?).
+      eapply sys_putc_correct in Hspec as (? & -> & [? Hpost ?]); eauto 7.
+    + destruct w as (? & ?).
       destruct H1 as (? & ? & Hpre); subst.
       destruct s; simpl in *.
-      rewrite if_false in H3 by auto.  
-      rewrite if_true in H3 by auto.  
+      rewrite -> if_false in H3 by auto.
+      rewrite -> if_true in H3 by auto.
       unfold sys_getc_wrap_spec in *.
       destruct (sys_getc_spec) eqn:Hspec; inv H3.
-      assert (sig_res (ef_sig e) <> AST.Xvoid).
-      { destruct e; inv H4; discriminate. }
       eapply (sys_getc_correct _ _ m) in Hspec as (? & -> & [? Hpost ? ?]); eauto.
       * split; auto; do 2 eexists; eauto.
         unfold getchar_post, getchar_post' in *.
-        destruct Hpost as [? Hpost]; split; auto; split; auto.
-        destruct Hpost as [[]|[-> ->]]; split; try (simpl in *; rep_lia).
-        -- rewrite if_false by lia; eauto.
-        -- rewrite if_true; auto.
+        eexists; repeat (split; first done).
+        destruct Hpost as (_ & [[]|[-> ->]]); split; try (simpl in *; auto; rep_lia).
+        rewrite -> if_false by lia; eauto.
       * unfold getchar_pre, getchar_pre' in *.
         apply Traces.sutt_trace_incl; auto.
+  - by apply io_spec_sound.
   - constructor.
-  - apply add_funspecs_frame.
-  - apply juicy_dry_specs.
-  - apply dry_spec_mem.
+  - apply H.
 Qed.
 
 (* relate to OS's external events *)
@@ -153,8 +127,8 @@ Notation ge := (globalenv prog).
 Definition trace_set := @trace (@io_events.IO_event nat) unit * RData -> Prop.
 
   Inductive OS_safeN_trace : nat -> @trace io_events.IO_event unit ->
-               trace_set -> 
-               OK_ty -> RData -> CC_core -> mem -> Prop :=
+               trace_set ->
+               IO_itree -> RData -> CC_core -> mem -> Prop :=
   | OS_safeN_trace_0: forall t z s c m, OS_safeN_trace O t (fun x => x = (TEnd, s)) z s c m
   | OS_safeN_trace_step:
       forall n t traces z s c m c' m',
@@ -166,7 +140,7 @@ Definition trace_set := @trace (@io_events.IO_event nat) unit * RData -> Prop.
       cl_at_external c = Some (e,args) ->
       (forall s s' ret m' t' n'
          (Hargsty : Val.has_type_list args (map proj_xtype (sig_args (ef_sig e))))
-         (Hretty : Builtins0.val_opt_has_rettype  ret (sig_res (ef_sig e))),
+         (Hretty : Builtins0.val_opt_has_rettype ret (sig_res (ef_sig e))),
          IO_inj_mem e args m t s ->
          IO_ext_sem e args s = Some (s', ret, t') ->
          m' = OS_mem e args m s' ->
@@ -188,10 +162,10 @@ Definition trace_set := @trace (@io_events.IO_event nat) unit * RData -> Prop.
       cl_halted c <> None ->
       OS_safeN_trace n t (fun x => x = (TEnd, s)) z s c m.
 
-Lemma strip_all : forall {A} (A_eq : forall x y : A, {x = y} + {x <> y}) t, strip_common_prefix A_eq t t = [].
+Lemma strip_all : forall {A} (A_eq : forall x y : A, {x = y} + {x <> y} ) t, strip_common_prefix A_eq t t = [].
 Proof.
   intros; unfold strip_common_prefix.
-  rewrite common_prefix_full, Nat.leb_refl, skipn_exact_length; auto.
+  rewrite common_prefix_full Nat.leb_refl skipn_exact_length; auto.
 Qed.
 
 Local Ltac inj :=
@@ -223,7 +197,7 @@ Local Ltac destruct_spec Hspec :=
       destruct r1; cbn in *.
       eapply sys_putc_trace_case in Hspec as []; eauto.
       unfold get_sys_ret; cbn.
-      repeat (rewrite ZMap.gss in * || rewrite ZMap.gso in * by easy); subst; inj; reflexivity.
+      repeat (rewrite -> ZMap.gss in * || rewrite -> ZMap.gso in * by easy); subst; inj; reflexivity.
     - unfold sys_getc_wrap_spec.
       destruct sys_getc_spec eqn: Hgetc; inversion 1; subst; split; auto.
       pose proof Hgetc as Hspec.
@@ -233,9 +207,9 @@ Local Ltac destruct_spec Hspec :=
       destruct r1; cbn in *.
       eapply sys_getc_trace_case in Hspec as []; auto.
       unfold get_sys_ret; cbn.
-      repeat (rewrite ZMap.gss in * || rewrite ZMap.gso in * by easy); subst; inj; reflexivity.
+      repeat (rewrite -> ZMap.gss in * || rewrite -> ZMap.gso in * by easy); subst; inj; reflexivity.
     - inversion 1.
-      rewrite common_prefix_full, strip_all; auto.
+      rewrite common_prefix_full strip_all; auto.
   Qed.
 
   Lemma app_trace_end : forall t, app_trace (trace_of_ostrace t) TEnd = trace_of_ostrace t.
@@ -248,8 +222,8 @@ Local Ltac destruct_spec Hspec :=
   Lemma app_trace_strip : forall t1 t2, common_prefix IOEvent_eq t1 t2 = t1 ->
     app_trace (trace_of_ostrace t1) (trace_of_ostrace (strip_common_prefix IOEvent_eq t1 t2)) = trace_of_ostrace t2.
   Proof.
-    intros; rewrite (strip_common_prefix_correct IOEvent_eq t1 t2) at 2.
-    rewrite trace_of_ostrace_app, H; auto.
+    intros; rewrite {2}(strip_common_prefix_correct IOEvent_eq t1 t2).
+    rewrite trace_of_ostrace_app H; auto.
     { rewrite <- H, common_prefix_sym; apply common_prefix_length. }
   Qed.
 
@@ -259,8 +233,7 @@ Local Ltac destruct_spec Hspec :=
     forall t' sf, traces (t', sf) -> valid_trace sf /\ app_trace (trace_of_ostrace s0.(io_log)) t' = trace_of_ostrace sf.(io_log).
   Proof.
     induction n as [n IHn] using lt_wf_ind; intros; inv H.
-    - inv H0.
-      rewrite app_trace_end; auto.
+    - rewrite app_trace_end; auto.
     - eauto.
     - destruct (H3 _ H0) as (? & s' & ? & ? & ? & ? & ? & ? & Hinj & Hcall & ? & ? & ? & ? & ? & ? & ? & ? & Hsafe & ? & ? & ? & Heq).
       inv Heq.
@@ -268,10 +241,9 @@ Local Ltac destruct_spec Hspec :=
       apply IO_ext_sem_trace in Hcall as [Hprefix]; auto; subst.
       eapply IHn in Hsafe as [? Htrace']; eauto; try lia.
       split; auto.
-      rewrite Htrace, <- Htrace', <- app_trace_assoc, app_trace_strip; auto.
-      { rewrite Htrace, app_trace_strip; auto. }
-    - inv H0.
-      rewrite app_trace_end; auto.
+      rewrite -> Htrace, <- Htrace', <- app_trace_assoc, app_trace_strip; auto.
+      { rewrite Htrace app_trace_strip; auto. }
+    - rewrite app_trace_end; auto.
   Qed.
 
   Lemma init_log_valid : forall s, io_log s = [] -> console s = {| cons_buf := []; rpos := 0 |} -> valid_trace s.
@@ -284,7 +256,7 @@ Local Ltac destruct_spec Hspec :=
   Qed.
 
   Lemma OS_trace_correct : forall n traces z s0 c m
-    (Hinit : s0.(io_log) = []) (Hcon : s0.(console) = {| cons_buf := []; rpos := 0 |}),
+    (Hinit : s0.(io_log) = []) (Hcon : s0.(console) = {| cons_buf := []; rpos := 0 |} ),
     OS_safeN_trace n TEnd traces z s0 c m ->
     forall t sf, traces (t, sf) -> valid_trace sf /\ t = trace_of_ostrace sf.(io_log).
   Proof.
@@ -305,7 +277,7 @@ Local Ltac destruct_spec Hspec :=
     traces = traces'.
   Proof.
     induction n as [n IHn] using lt_wf_ind; inversion 1; inversion 1; subst; auto.
-    - eapply semax_lemmas.cl_corestep_fun in H0; eauto; inv H0; eauto.
+    - eapply Clight_core.cl_corestep_fun in H0; eauto; inv H0; eauto.
     - apply cl_corestep_not_at_external in H0; congruence.
     - apply (cl_corestep_not_halted _ _ _ _ _ Int.zero) in H0; contradiction.
     - erewrite cl_corestep_not_at_external in H0 by eauto; congruence.
@@ -329,7 +301,7 @@ Local Ltac destruct_spec Hspec :=
   Qed.
 
   Lemma ext_safe_OS_safe : forall n t traces z q m s0 (Hvalid : valid_trace s0),
-    ext_safeN_trace(J := OK_spec) prog IO_ext_sem IO_inj_mem OS_mem valid_trace n t traces z q m ->
+    ext_safeN_trace prog IO_ext_sem IO_inj_mem OS_mem valid_trace n t traces z q m ->
     exists traces', OS_safeN_trace n t traces' z s0 q m /\ forall t, traces t <-> exists s, traces' (t, s).
   Proof.
     induction n as [n IHn] using lt_wf_ind; intros; inv H.
@@ -368,10 +340,10 @@ Local Ltac destruct_spec Hspec :=
   Qed.
 
 Theorem IO_OS_ext:
- forall {CS: compspecs} (initial_oracle: OK_ty) V G m,
-   semax_prog prog initial_oracle V G ->
+ forall {CS: compspecs} `{!VSTGpreS IO_itree Σ} (initial_oracle: IO_itree) V (G : forall `{!VSTGS IO_itree Σ}, funspecs) m,
+   (forall `{!VSTGS IO_itree Σ}, semax_prog(OK_spec := IO_ext_spec ext_link) prog initial_oracle V G) ->
    Genv.init_mem prog = Some m ->
-   exists b, exists q, 
+   exists b, exists q,
      Genv.find_symbol (Genv.globalenv prog) (AST.prog_main prog) = Some b /\
      initial_core (cl_core_sem (globalenv prog))
          0 m q m (Vptr b Ptrofs.zero) nil /\
diff --git a/progs/io_dry.v b/progs/io_dry.v
index 200f221424..cd3a4426b4 100644
--- a/progs/io_dry.v
+++ b/progs/io_dry.v
@@ -3,18 +3,15 @@ Require Import VST.progs.io.
 Require Import VST.floyd.proofauto.
 Require Import VST.sepcomp.extspec.
 Require Import VST.veric.semax_ext.
-Require Import VST.veric.juicy_mem.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.initial_world.
-Require Import VST.veric.ghost_PCM.
 Require Import VST.veric.SequentialClight.
-Require Import VST.concurrency.conclib.
 Require Import VST.progs.dry_mem_lemmas.
 
 Section IO_Dry.
 
 Context {E : Type -> Type} {IO_E : @IO_event nat -< E}.
 
+Notation IO_itree := (@IO_itree E).
+
 Definition getchar_pre (m : mem) (witness : byte -> IO_itree) (z : IO_itree) :=
   let k := witness in (sutt eq (r <- read stdin;; k r) z).
 
@@ -30,172 +27,78 @@ Definition putchar_post (m0 m : mem) (r : int) (witness : byte * IO_itree) (z :
   (Int.signed r = -1 \/ Int.signed r = Byte.unsigned c) /\
   if eq_dec (Int.signed r) (-1) then sutt eq (write stdout c;; k) z else z = k.
 
-Context (ext_link : String.string -> ident).
-
-Instance Espec : OracleKind := IO_Espec ext_link.
+Existing Instance semax_lemmas.eq_dec_external_function.
 
-Definition io_ext_spec := OK_spec.
+Definition getchar_sig := {| sig_args := []; sig_res := Xint; sig_cc := cc_default |}.
+Definition putchar_sig := {| sig_args := [Xint]; sig_res := Xint; sig_cc := cc_default |}.
 
-Program Definition io_dry_spec : external_specification mem external_function (@IO_itree E).
+Program Definition io_dry_spec : external_specification mem external_function IO_itree.
 Proof.
   unshelve econstructor.
   - intro e.
-    pose (ext_spec_type io_ext_spec e) as T; simpl in T.
-    destruct (oi_eq_dec _ _); [|destruct (oi_eq_dec _ _); [|exact False]];
-      match goal with T := (_ * ?A)%type |- _ => exact (mem * A)%type end.
+    destruct (eq_dec e (EF_external "putchar" putchar_sig)).
+    { exact (mem * (byte * IO_itree))%type. }
+    destruct (eq_dec e (EF_external "getchar" getchar_sig)).
+    { exact (mem * (byte -> IO_itree))%type. }
+    exact False%type.
   - simpl; intros.
-    destruct (oi_eq_dec _ _); [|destruct (oi_eq_dec _ _); [|contradiction]].
-    + destruct X as (m0 & _ & w).
-      exact (X1 = [Vubyte (fst w)] /\ m0 = X3 /\ putchar_pre X3 w X2).
-    + destruct X as (m0 & _ & w).
-      exact (X1 = [] /\ m0 = X3 /\ getchar_pre X3 w X2).
+    if_tac in X; [|if_tac in X; last contradiction]; destruct X as (m & w).
+    + exact (X1 = [Vubyte (fst w)] /\ m = X3 /\ putchar_pre X3 w X2).
+    + exact (X1 = [] /\ m = X3 /\ getchar_pre X3 w X2).
   - simpl; intros ??? ot ???.
-    destruct (oi_eq_dec _ _); [|destruct (oi_eq_dec _ _); [|contradiction]].
-    + destruct X as (m0 & _ & w).
-      destruct X1; [|exact False].
-      destruct v; [exact False | | exact False | exact False | exact False | exact False].
-      exact (ot <> AST.Xvoid /\ putchar_post m0 X3 i w X2).
-    + destruct X as (m0 & _ & w).
-      destruct X1; [|exact False].
-      destruct v; [exact False | | exact False | exact False | exact False | exact False].
-      exact (ot <> AST.Xvoid /\ getchar_post m0 X3 i w X2).
-  - intros; exact True.
+    if_tac in X; [|if_tac in X; last contradiction]; destruct X as (m0 & w).
+    + exact (exists r, X1 = Some (Vint r) /\ ot <> Xvoid /\ putchar_post m0 X3 r w X2).
+    + exact (exists r, X1 = Some (Vint r) /\ ot <> Xvoid /\ getchar_post m0 X3 r w X2).
+  - intros; exact True%type.
 Defined.
 
-Definition dessicate : forall ef (jm : juicy_mem), ext_spec_type io_ext_spec ef -> ext_spec_type io_dry_spec ef.
-Proof.
-  simpl; intros.
-  destruct (oi_eq_dec _ _); [|destruct (oi_eq_dec _ _); [|assumption]].
-  - destruct X as [_ X]; exact (m_dry jm, X).
-  - destruct X as [_ X]; exact (m_dry jm, X).
-Defined.
+Context (ext_link : string -> ident)
+  (ext_link_inj : forall s1 s2, In s1 ["getchar"; "putchar"] -> ext_link s1 = ext_link s2 -> s1 = s2).
 
-Theorem juicy_dry_specs : juicy_dry_ext_spec _ io_ext_spec io_dry_spec dessicate.
-Proof.
-  split; [|split]; try reflexivity; simpl.
-  - unfold funspec2pre, dessicate; simpl.
-    intros ?; if_tac.
-    + intros; subst.
-      destruct t as (? & ? & (c, k)); simpl in *.
-      destruct H1 as (? & phi0 & phi1 & J & Hpre & Hr & Hext).
-      destruct e; inv H; simpl in *.
-      destruct vl; try contradiction; simpl in *.
-      destruct H0, vl; try contradiction.
-      unfold SEPx in Hpre; simpl in Hpre.
-      rewrite seplog.sepcon_emp in Hpre.
-      destruct Hpre as [_ [Hargs [_ [it [H8 Htrace]]]]].
-      assert (Harg: v = Vubyte c) by (inv Hargs; auto). clear Hargs.
-      rewrite Harg.
-      eapply has_ext_compat in Hext as []; eauto; subst; auto.
-      eexists; eauto.
-    + unfold funspec2pre; simpl.
-      if_tac; [|contradiction].
-      intros; subst.
-      destruct t as (? & ? & k); simpl in *.
-      destruct H2 as (? & phi0 & phi1 & J & Hpre & Hr & Hext).
-      destruct e; inv H0; simpl in *.
-      destruct vl; try contradiction.
-      unfold putchar_pre; split; auto; split; auto.
-      unfold SEPx in Hpre; simpl in Hpre.
-      rewrite seplog.sepcon_emp in Hpre.
-      destruct Hpre as [_ [Hargs [_ [it [H8 Htrace]]]]].
-      eapply has_ext_compat in Hext as []; eauto; subst; auto.
-      eexists; eauto.
-  - unfold funspec2pre, funspec2post, dessicate; simpl.
-    intros ?; if_tac.
-    + intros; subst.
-      destruct H0 as (_ & vl & z0 & ? & _ & phi0 & phi1' & J & Hpre & ? & ?).
-      destruct t as (phi1 & t); subst; simpl in *.
-      destruct t as (? & (c, k)); simpl in *.
-      unfold SEPx in Hpre; simpl in Hpre.
-      rewrite seplog.sepcon_emp in Hpre.
-      destruct Hpre as [_ [Hargs [_ [it [H8 Htrace]]]]].
-      edestruct (has_ext_compat _ z0 _ (m_phi jm0) Htrace) as (? & ? & ?); eauto; [eexists; eauto|]; subst.
-      destruct v; try contradiction.
-      destruct v; try contradiction.
-      destruct H4 as (? & Hmem & ? & Hw); simpl in Hw; subst.
-      rewrite <- Hmem in *.
-      rewrite rebuild_same in H2.
-      unshelve eexists (age_to.age_to (level jm) (set_ghost phi0 (Some (ext_ghost x, NoneP) :: tl (ghost_of phi0)) _)), (age_to.age_to (level jm) phi1'); auto.
-      { rewrite <- ghost_of_approx at 2; simpl.
-        destruct (ghost_of phi0); auto. }
-      split; [|split].
-      * eapply age_rejoin; eauto.
-        intro; rewrite H2; auto.
-      * exists i.
-        split3; simpl.
-        -- split; auto.
-        -- unfold_lift. split; auto. split; [|intro Hx; inv Hx].
-             unfold eval_id; simpl. unfold semax.make_ext_rval; simpl.
-             destruct ot; try contradiction; reflexivity.
-        -- unfold SEPx; simpl.
-           rewrite seplog.sepcon_emp.
-           unfold ITREE; exists x; split; [if_tac; auto|].
-           { subst; apply eutt_sutt, Reflexive_eqit_eq. }
-           eapply age_to.age_to_pred, change_has_ext; eauto.
-      * eapply necR_trans; eauto; apply age_to.age_to_necR.
-    + unfold funspec2pre, funspec2post, dessicate; simpl.
-      if_tac; [|contradiction].
-      clear H0.
-      intros; subst.
-      destruct H0 as (_ & vl & z0 & ? & _ & phi0 & phi1' & J & Hpre & ? & ?).
-      destruct t as (phi1 & t); subst; simpl in *.
-      destruct t as (? & k); simpl in *.
-      unfold SEPx in Hpre; simpl in Hpre.
-      rewrite seplog.sepcon_emp in Hpre.
-      destruct Hpre as [_ [Hargs [_ [it [H8 Htrace]]]]].
-      edestruct (has_ext_compat _ z0 _ (m_phi jm0) Htrace) as (? & ? & ?); eauto; [eexists; eauto|]; subst.
-      destruct v; try contradiction.
-      destruct v; try contradiction.
-      destruct H4 as (? & Hmem & ? & Hw); simpl in Hw; subst.
-      rewrite <- Hmem in *.
-      rewrite rebuild_same in H2.
-      unshelve eexists (age_to.age_to (level jm) (set_ghost phi0 (Some (ext_ghost x, NoneP) :: tl (ghost_of phi0)) _)), (age_to.age_to (level jm) phi1'); auto.
-      { rewrite <- ghost_of_approx at 2; simpl.
-        destruct (ghost_of phi0); auto. }
-      split; [|split].
-      * eapply age_rejoin; eauto.
-        intro; rewrite H2; auto.
-      * exists i.
-        split3; simpl.
-        -- split; auto.
-        -- unfold_lift. split; auto. split; [|intro Hx; inv Hx].
-             unfold eval_id; simpl. unfold semax.make_ext_rval; simpl.
-             destruct ot; try contradiction; reflexivity.
-        -- unfold SEPx; simpl.
-             rewrite seplog.sepcon_emp.
-             unfold ITREE; exists x; split; [if_tac; auto|].
-             { subst; apply eutt_sutt, Reflexive_eqit_eq. }
-             eapply age_to.age_to_pred, change_has_ext; eauto.
-      * eapply necR_trans; eauto; apply age_to.age_to_necR.
-Qed.
-
-Instance mem_evolve_refl : Reflexive mem_evolve.
-Proof.
-  repeat intro.
-  destruct (access_at x loc Cur); auto.
-  destruct p; auto.
-Qed.
+Arguments eq_dec : simpl never.
 
-Lemma dry_spec_mem : ext_spec_mem_evolve _ io_dry_spec.
+Theorem io_spec_sound : forall `{!VSTGS IO_itree Σ}, ext_spec_entails (IO_ext_spec ext_link) io_dry_spec.
 Proof.
-  intros ??????????? Hpre Hpost.
-  simpl in Hpre, Hpost.
-  simpl in *.
-  if_tac in Hpre.
-  - destruct w as (m0 & _ & w).
-    destruct Hpre as (_ & ? & Hpre); subst.
-    destruct v; try contradiction.
-    destruct v; try contradiction.
-    destruct Hpost as (? & ? & ?); subst.
-    reflexivity.
-  - if_tac in Hpre; [|contradiction].
-    destruct w as (m0 & _ & w).
-    destruct Hpre as (_ & ? & Hpre); subst.
-    destruct v; try contradiction.
-    destruct v; try contradiction.
-    destruct Hpost as (? & ? & ?); subst.
-    reflexivity.
+  intros; apply juicy_dry_spec; last done; intros.
+  destruct H as [H | [H | ?]]; last done; injection H as <-%ext_link_inj <-; simpl; auto.
+  - if_tac; last done; intros.
+    exists (m, w).
+    destruct w as (c, k).
+    iIntros "(Hz & _ & %Hargs & H)".
+    rewrite /SEPx; monPred.unseal.
+    iDestruct "H" as "(_ & (% & % & Hext) & _)".
+    iDestruct (has_ext_state with "[$Hz $Hext]") as %<-.
+    iSplit; first done.
+    iIntros (???? (r & -> & ? & -> & Hr & Hz')).
+    iMod (change_ext_state with "[$]") as "($ & ?)".
+    iIntros "!>"; iExists r.
+    iSplit; first done.
+    rewrite /local /= /lift1; unfold_lift.
+    iSplit.
+    { iPureIntro; destruct ty; done. }
+    iSplit; last done.
+    iExists z'; iFrame; iPureIntro.
+    split; last done.
+    if_tac; subst; done.
+  - if_tac; last done; intros.
+    exists (m, w).
+    iIntros "(Hz & _ & %Hargs & H)".
+    rewrite /SEPx; monPred.unseal.
+    iDestruct "H" as "(_ & (% & % & Hext) & _)".
+    iDestruct (has_ext_state with "[$Hz $Hext]") as %<-.
+    iSplit; first done.
+    iIntros (???? (r & -> & ? & -> & Hr & Hz')).
+    simpl in Hz'.
+    iMod (change_ext_state with "[$]") as "($ & ?)".
+    iIntros "!>"; iExists r.
+    iSplit; first done.
+    rewrite /local /= /lift1; unfold_lift.
+    iSplit.
+    { iPureIntro; destruct ty; done. }
+    iSplit; last done.
+    iExists z'; iFrame; iPureIntro.
+    split; last done.
+    if_tac; subst; done.
 Qed.
 
 End IO_Dry.
diff --git a/progs/io_mem_dry.v b/progs/io_mem_dry.v
index c07294c4fd..519ef14aa4 100644
--- a/progs/io_mem_dry.v
+++ b/progs/io_mem_dry.v
@@ -2,12 +2,7 @@ Require Import VST.progs.io_mem_specs.
 Require Import VST.floyd.proofauto.
 Require Import VST.sepcomp.extspec.
 Require Import VST.veric.semax_ext.
-Require Import VST.veric.juicy_mem.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.initial_world.
-Require Import VST.veric.ghost_PCM.
 Require Import VST.veric.SequentialClight.
-Require Import VST.concurrency.conclib.
 Require Import VST.progs.dry_mem_lemmas.
 Require Import VST.veric.mem_lessdef.
 
@@ -25,13 +20,15 @@ Qed.
 
 Context {E : Type -> Type} {IO_E : @IO_event nat -< E}.
 
+Notation IO_itree := (@IO_itree E).
+
 Definition getchars_pre (m : mem) (witness : share * val * Z * (list byte -> IO_itree)) (z : IO_itree) :=
   let '(sh, buf, len, k) := witness in (sutt eq (r <- read_list stdin (Z.to_nat len);; k r) z) /\
     match buf with Vptr b ofs =>
       Mem.range_perm m b (Ptrofs.unsigned ofs) (Ptrofs.unsigned ofs + Z.max 0 len) Memtype.Cur Memtype.Writable
       | _ => False end.
 
-Definition getchars_post (m0 m : mem) r (witness : share * val * Z * (list byte -> IO_itree)) (z : @IO_itree E) :=
+Definition getchars_post (m0 m : mem) r (witness : share * val * Z * (list byte -> IO_itree)) (z : IO_itree) :=
   let '(sh, buf, len, k) := witness in r = Int.repr len /\
     exists msg, Zlength msg = len /\ z = k msg /\
     match buf with Vptr b ofs => exists m', Mem.storebytes m0 b (Ptrofs.unsigned ofs) (bytes_to_memvals msg) = Some m' /\
@@ -45,281 +42,107 @@ Definition putchars_pre (m : mem) (witness : share * val * list byte * Z * list
       Some (bytes_to_memvals msg)
     | _ => False end.
 
-Definition putchars_post (m0 m : mem) r (witness : share * val * list byte * Z * list val * IO_itree) (z : @IO_itree E) :=
+Definition putchars_post (m0 m : mem) r (witness : share * val * list byte * Z * list val * IO_itree) (z : IO_itree) :=
   let '(sh, buf, msg, _, _, k) := witness in m0 = m /\ r = Int.repr (Zlength msg) /\ z = k.
 
-Context {CS : compspecs} (ext_link : String.string -> ident).
-
-Instance Espec : OracleKind := IO_Espec ext_link.
+Existing Instance semax_lemmas.eq_dec_external_function.
 
-Definition io_ext_spec := OK_spec.
+Definition getchars_sig := {| sig_args := [Xptr; Xint]; sig_res := Xint; sig_cc := cc_default |}.
+Definition putchars_sig := {| sig_args := [Xptr; Xint]; sig_res := Xint; sig_cc := cc_default |}.
 
-Program Definition io_dry_spec : external_specification mem external_function (@IO_itree E).
+Program Definition io_dry_spec : external_specification mem external_function IO_itree.
 Proof.
   unshelve econstructor.
   - intro e.
-    pose (ext_spec_type io_ext_spec e) as T; simpl in T.
-    destruct (oi_eq_dec _ _); [|destruct (oi_eq_dec _ _); [|exact False]];
-      match goal with T := (_ * ?A)%type |- _ => exact (mem * A)%type end.
+    destruct (eq_dec e (EF_external "putchars" putchars_sig)).
+    { exact (mem * (share * val * list byte * Z * list val * IO_itree))%type. }
+    destruct (eq_dec e (EF_external "getchars" getchars_sig)).
+    { exact (mem * (share * val * Z * (list byte -> IO_itree)))%type. }
+    exact False%type.
   - simpl; intros.
-    destruct (oi_eq_dec _ _); [|destruct (oi_eq_dec _ _); [|contradiction]].
-    + destruct X as (m0 & _ & w).
-      exact ((let '(_, buf, msg, _, _, _) := w in X1 = [buf; Vint (Int.repr (Zlength msg))]) /\ m0 = X3 /\ putchars_pre X3 w X2).
-    + destruct X as (m0 & _ & w).
-      exact ((let '(_, buf, len, _) := w in X1 = [buf; Vint (Int.repr len)]) /\ m0 = X3 /\ getchars_pre X3 w X2).
+    if_tac in X; [|if_tac in X; last contradiction]; destruct X as (m & w).
+    + exact ((let '(_, buf, msg, _, _, _) := w in X1 = [buf; Vint (Int.repr (Zlength msg))]) /\ m = X3 /\ putchars_pre X3 w X2).
+    + exact ((let '(_, buf, len, _) := w in X1 = [buf; Vint (Int.repr len)]) /\ m = X3 /\ getchars_pre X3 w X2).
   - simpl; intros ??? ot ???.
-    destruct (oi_eq_dec _ _); [|destruct (oi_eq_dec _ _); [|contradiction]].
-    + destruct X as (m0 & _ & w).
-      destruct X1; [|exact False].
-      destruct v; [exact False | | exact False | exact False | exact False | exact False].
-      exact (ot <> AST.Xvoid /\ putchars_post m0 X3 i w X2).
-    + destruct X as (m0 & _ & w).
-      destruct X1; [|exact False].
-      destruct v; [exact False | | exact False | exact False | exact False | exact False].
-      exact (ot <> AST.Xvoid /\ getchars_post m0 X3 i w X2).
-  - intros; exact True.
+    if_tac in X; [|if_tac in X; last contradiction]; destruct X as (m0 & w).
+    + exact (exists r, X1 = Some (Vint r) /\ ot <> Xvoid /\ putchars_post m0 X3 r w X2).
+    + exact (exists r, X1 = Some (Vint r) /\ ot <> Xvoid /\ getchars_post m0 X3 r w X2).
+  - intros; exact True%type.
 Defined.
 
-Definition dessicate : forall ef (jm : juicy_mem), ext_spec_type io_ext_spec ef -> ext_spec_type io_dry_spec ef.
-Proof.
-  simpl; intros.
-  destruct (oi_eq_dec _ _); [|destruct (oi_eq_dec _ _); [|assumption]].
-  - destruct X as [_ X]; exact (m_dry jm, X).
-  - destruct X as [_ X]; exact (m_dry jm, X).
-Defined.
+Context {CS : compspecs} (ext_link : string -> ident)
+  (ext_link_inj : forall s1 s2, In s1 ["getchars"; "putchars"] -> ext_link s1 = ext_link s2 -> s1 = s2).
 
-Theorem juicy_dry_specs : juicy_dry_ext_spec _ io_ext_spec io_dry_spec dessicate.
-Proof.
-  split; [|split]; try reflexivity; simpl.
-  - unfold funspec2pre, dessicate; simpl.
-    intros ?; if_tac.
-    + intros; subst.
-      destruct t as (? & ? & (((((sh, buf), msg), len), rest), k)); simpl in *.
-      destruct H1 as (? & phi0 & phi1 & J & Hpre & Hr & Hext).
-      destruct e; inv H; simpl in *.
-      destruct vl; try contradiction; simpl in *.
-      destruct H0, vl; try contradiction; simpl in *.
-      destruct H0, vl; try contradiction.
-      unfold SEPx in Hpre; simpl in Hpre.
-      rewrite seplog.sepcon_emp in Hpre.
-      destruct Hpre as [[Hreadable _] [Hargs [_ [? [? [? [Htrace Hbuf]]]]]]].
- (*     destruct Hpre as ([Hreadable _] & Hargs & ? & ? & J1 & (? & ? & Htrace) & Hbuf). *)
-(*      destruct Hargs as ([Harg1 _] & [Harg2 _] & _); hnf in Harg1, Harg2. *)
-      assert (Harg1: v = buf) by (inv Hargs; auto).
-      assert (Harg2: v0 = vint (Zlength msg)) by (inv Hargs; auto).
-      split; [rewrite Harg1, Harg2; auto|].
-      split; auto.
-     destruct Htrace as [? [J1 Htrace]].
-      eapply has_ext_compat in Htrace as [? Htrace]; eauto; [|eapply join_sub_trans; eexists; eauto]; subst.
-      split; auto.
-      assert (Z.max 0 len = Zlength msg + Zlength rest) as Hlen.
-      { apply data_array_at_local_facts in Hbuf as (_ & ? & _).
-        rewrite Zlength_app, Zlength_map in *; auto. }
-      destruct (zlt len 0).
-      { rewrite Z.max_l in Hlen by lia.
-        destruct msg; [|rewrite Zlength_cons in *; rep_lia].
-        destruct Hbuf as [[? _]]; destruct buf; try contradiction.
-        rewrite Zlength_nil; apply Mem.loadbytes_empty; auto; lia. }
-      rewrite Z.max_r in Hlen by lia; subst.
-      rewrite split2_data_at_Tarray_app with (mid := Zlength msg) in Hbuf.
-      destruct Hbuf as (? & ? & ? & Hbuf & _).
-      eapply data_at_bytes in Hbuf; eauto.
-      rewrite map_map in Hbuf; eauto.
-      { rewrite Zlength_map; auto. }
-      { eapply join_sub_trans; [|eexists; eauto].
-        eapply join_sub_trans; eexists; eauto. }
-      { apply Forall_map, Forall_forall; simpl; discriminate. }
-      { rewrite Zlength_map; auto. }
-      { rewrite Z.add_simpl_l; auto. }
-    + clear H.
-      unfold funspec2pre; simpl.
-      if_tac; [|contradiction].
-      intros; subst.
-      destruct t as (? & ? & (((sh, buf), len), k)); simpl in *.
-      destruct H1 as (? & phi0 & phi1 & J & Hpre & Hr & Hext).
-      destruct e; inv H; simpl in *.
-      destruct vl; try contradiction; simpl in *.
-      destruct H0, vl; try contradiction; simpl in *.
-      destruct H0, vl; try contradiction.
-      unfold SEPx in Hpre; simpl in Hpre.
-      rewrite seplog.sepcon_emp in Hpre.
-      destruct Hpre as [[Hwritable _] [Hargs [_ [? [? [? [[? [? Htrace]] Hbuf]]]]]]].
-      assert (Harg1: v = buf) by (inv Hargs; auto).
-      assert (Harg2: v0 = vint  len) by (inv Hargs; auto).
-      split; [rewrite Harg1, Harg2; auto|].
-      clear Harg1.
-      split; auto.
-      eapply has_ext_compat in Htrace as [? Htrace]; eauto; [|eapply join_sub_trans; eexists; eauto]; subst.
-      split; auto.
-      destruct (data_at__writable_perm _ _ _ _ jm Hwritable Hbuf) as (? & ? & ? & Hperm); subst; simpl.
-      { eapply sepalg.join_sub_trans; [|eexists; eauto].
-        eexists; eauto. }
-      simpl in Hperm.
-      rewrite Z.mul_1_l in Hperm; auto.
-  - unfold funspec2pre, funspec2post, dessicate; simpl.
-    intros ?; if_tac.
-    + intros; subst.
-      destruct H0 as (_ & vl & z0 & ? & _ & phi0 & phi1' & J & Hpre & ? & ?).
-      destruct t as (phi1 & t); subst; simpl in *.
-      destruct t as (? & (((((sh, buf), msg), len), rest), k)); simpl in *.
-      unfold SEPx in Hpre; simpl in Hpre.
-      rewrite seplog.sepcon_emp in Hpre.
-      destruct Hpre as [[Hwritable _] [_ [_ [phig [phir [J1 [[? [? Htrace]] Hbuf]]]]]]].
-      edestruct (has_ext_compat _ z0 _ phi0 Htrace) as (? & Hg & Hg0); eauto; [eexists; eauto | eapply ext_compat_sub; eauto; eexists; eauto|]; subst.
-      destruct v; try contradiction.
-      destruct v; try contradiction.
-      destruct H4 as (? & Hmem & ? & ?); subst.
-      rewrite <- Hmem in *.
-      rewrite rebuild_same in H2.
-      unshelve eexists (age_to.age_to (level jm) (set_ghost phi0 (Some (ext_ghost k, NoneP) :: tl (ghost_of phi0)) _)), (age_to.age_to (level jm) phi1'); auto.
-      { rewrite <- ghost_of_approx at 2; simpl.
-        destruct (ghost_of phi0); auto. }
-      destruct buf; try solve [destruct Hbuf as [[]]; contradiction].
-      destruct (join_level _ _ _ J).
-      split; [|split].
-      * eapply age_rejoin; eauto.
-        intro; rewrite H2; auto.
-      * split3; simpl.
-        { split; auto. }
-        { unfold_lift. split; auto. split; [|intro Hx; inv Hx].
-             unfold eval_id; simpl. unfold semax.make_ext_rval; simpl.
-             destruct ot; try contradiction; reflexivity. }
-        unfold SEPx; simpl.
-        rewrite seplog.sepcon_emp.
-        unshelve eexists (age_to.age_to _ (set_ghost phig (Some (ext_ghost k, NoneP) :: tl (ghost_of phig)) _)), (age_to.age_to _ phir);
-          try (split; [apply age_to.age_to_join_eq|]); try apply set_ghost_join; eauto.
-        { rewrite <- ghost_of_approx at 2.
-          destruct (ghost_of phig); auto. }
-        { apply ghost_of_join in J1.
-          rewrite Hg, Hg0 in J1; inv J1; constructor; auto.
-          apply ext_ghost_join in H13 as [[]|[]]; eauto; subst.
-          apply ghost_not_both in H10; contradiction. }
-        { unfold set_ghost; rewrite level_make_rmap; lia. }
-        split.
-        -- unfold ITREE; exists k; split; [apply eutt_sutt, Reflexive_eqit_eq|].
-             eapply age_to.age_to_pred, change_has_ext; eauto.
-        -- apply age_to.age_to_pred; auto.
-      * eapply necR_trans; eauto; apply age_to.age_to_necR.
-    + clear H.
-      unfold funspec2pre, funspec2post, dessicate; simpl.
-      if_tac; [|contradiction].
-      intros; subst.
-      destruct H0 as (_ & vl& z0 & ? & _ & phi0 & phi1' & J & Hpre & ? & ?).
-      destruct t as (phi1 & t); subst; simpl in *.
-      destruct t as (? & (((sh, buf), len), k)); simpl in *.
-      unfold SEPx in Hpre; simpl in Hpre.
-      rewrite seplog.sepcon_emp in Hpre.
-      destruct Hpre as [[Hwritable _] [_ [_ [phig [phir [J1 [[? [? Htrace]] Hbuf]]]]]]].
-      edestruct (has_ext_compat _ z0 _ phi0 Htrace) as (? & Hg & Hg0); eauto; [eexists; eauto | eapply ext_compat_sub; eauto; eexists; eauto|]; subst.
-      destruct v; try contradiction.
-      destruct v; try contradiction.
-      destruct H4 as (? & ? & msg & ? & ? & Hpost); subst.
-      destruct buf; try contradiction.
-      destruct Hpost as (m' & Hstore & Heq).
-      unshelve eexists (set_ghost (age_to.age_to (level jm) (inflate_store m' phi0)) (Some (ext_ghost (k msg), NoneP) :: own.ghost_approx (age_to.age_to (level jm) (inflate_store m' phi0)) (tl (ghost_of phi0))) _),
-        (age_to.age_to (level jm) phi1').
-      { simpl; rewrite ghost_fmap_fmap, approx_oo_approx; auto. }
-      destruct (join_level _ _ _ J).
-      assert (Ptrofs.unsigned i + Zlength msg <= Ptrofs.max_unsigned) as Hbound.
-      { destruct Hbuf as [(_ & _ & Hsize & _) _]; simpl in Hsize.
-        rewrite Z.max_r in Hsize; rep_lia. }
-      apply data_at__VALspec_range in Hbuf; auto.
-      assert (level (age_to.age_to (level (m_phi jm)) (inflate_store m' phi0)) = level (m_phi jm)) as Hl.
-      { apply age_to.level_age_to.
-        unfold inflate_store; rewrite level_make_rmap; lia. }
-      split.
-      * apply resource_at_join2; auto.
-        -- unfold set_ghost; rewrite level_make_rmap; auto.
-        -- rewrite age_to.level_age_to; auto.
-           rewrite level_juice_level_phi; lia.
-        -- intros.
-           unfold set_ghost; rewrite resource_at_make_rmap.
-           eapply rebuild_store; eauto.
-           intros (b', o') ???? Hr1 []; subst.
-           apply (resource_at_join _ _ _ (b', o')) in J; rewrite Hr1 in J.
-           apply VALspec_range_e with (loc := (b', o')) in Hbuf as [? Hr].
-           apply (resource_at_join _ _ _ (b', o')) in J1; rewrite Hr in J1.
-           inv J1; rewrite <- H15 in J; inv J; eapply join_writable_readable; eauto;
-             apply join_comm in RJ; eapply join_writable1; eauto.
-           { rewrite bytes_to_memvals_length in *; split; auto. }
-        -- unfold set_ghost; rewrite ghost_of_make_rmap, !age_to_resource_at.age_to_ghost_of.
-           rewrite H3.
-           apply ghost_of_join in J.
-           rewrite level_juice_level_phi, Hl.
-           rewrite Hg0 in J; inv J; constructor; auto.
-           destruct (ext_ghost_join _ _ _ _ H13) as [[]|[]]; eauto; subst.
-           inv H13; [constructor|].
-           destruct a0, H17 as (? & ? & ?); simpl in *; subst; eauto.
-           { unfold semax.ext_compat in H6; rewrite <- H12 in H6.
-             exfalso; destruct H6 as [? J]; inv J.
-             eapply no_two_ref; eauto. }
-           { apply ghost_fmap_join; auto. }
-      * split.
-        -- exists msg.
-           split3; simpl.
-           { split; auto. }
-           { unfold_lift. split; auto. split; [|intro Hx; inv Hx].
-             unfold eval_id; simpl. unfold semax.make_ext_rval; simpl.
-             destruct ot; try contradiction; reflexivity. }
-           unfold SEPx; simpl.
-           rewrite seplog.sepcon_emp.
-           unshelve eexists (set_ghost (age_to.age_to _ phig) (Some (ext_ghost (k msg), NoneP) :: own.ghost_approx (age_to.age_to (level jm) (inflate_store m' phi0)) (tl (ghost_of phig))) _), (age_to.age_to _ (inflate_store m' phir));
-             try (split3; [apply set_ghost_join; [apply age_to.age_to_join_eq | ..] | ..]).
-           ++ simpl; rewrite Hl, age_to.level_age_to, ghost_fmap_fmap, approx_oo_approx; auto.
-              apply join_level in J1 as []; lia.
-           ++ eapply inflate_store_join1; eauto.
-                 clear - Htrace. apply has_ext_noat in Htrace. auto.
-           ++ unfold inflate_store; rewrite level_make_rmap; lia.
-           ++ rewrite level_juice_level_phi, Hl.
-              rewrite age_to_resource_at.age_to_ghost_of.
-              unfold inflate_store; rewrite ghost_of_make_rmap.
-              apply ghost_of_join in J1; rewrite Hg, Hg0 in J1; inv J1; constructor; auto.
-              destruct (ext_ghost_join _ _ _ _ H13) as [[]|[]]; eauto; subst.
-              inv H13; [constructor|].
-              destruct a0, H17 as (? & ? & ?); simpl in *; subst; eauto.
-              apply ghost_not_both in H10; contradiction.
-              apply ghost_fmap_join; auto.
-           ++ unfold ITREE; exists (k msg); split; [apply eutt_sutt, Reflexive_eqit_eq|].
-              eapply change_has_ext, age_to.age_to_pred; eauto.
-           ++ apply age_to.age_to_pred.
-              rewrite <- (Zlength_map _ _ Vubyte).
-              eapply store_bytes_data_at; rewrite ?Zlength_map; auto.
-              { rewrite Forall_map, Forall_forall; simpl; intros.
-                exists (Int.repr (Byte.unsigned x)); split; auto.
-                rewrite Int.unsigned_repr; rep_lia. }
-              { rewrite map_map; eauto. }
-        -- eapply necR_trans; eauto; apply age_to.age_to_necR.
-Qed.
-
-Instance mem_evolve_refl : Reflexive mem_evolve.
-Proof.
-  repeat intro.
-  destruct (access_at x loc Cur); auto.
-  destruct p; auto.
-Qed.
+Arguments eq_dec : simpl never.
 
-Lemma dry_spec_mem : ext_spec_mem_evolve _ io_dry_spec.
+Theorem io_spec_sound : forall `{!VSTGS IO_itree Σ}, ext_spec_entails (IO_ext_spec ext_link) io_dry_spec.
 Proof.
-  intros ??????????? Hpre Hpost.
-  simpl in Hpre, Hpost.
-  simpl in *.
-  if_tac in Hpre.
-  - destruct w as (m0 & _ & (((((?, ?), ?), ?), ?), ?)).
-    destruct Hpre as (_ & ? & Hpre); subst.
-    destruct v; try contradiction.
-    destruct v; try contradiction.
-    destruct Hpost as (? & ? & ?); subst.
-    reflexivity.
-  - if_tac in Hpre; [|contradiction].
-    destruct w as (m0 & _ & (((?, ?), ?), ?)).
-    destruct Hpre as (_ & ? & Hpre); subst.
-    destruct v; try contradiction.
-    destruct v; try contradiction.
-    destruct Hpost as (? & ? & msg & ? & ? & Hpost); subst.
-    destruct v0; try contradiction.
-    destruct Hpost as (? & Hstore & ?).
-    eapply mem_evolve_equiv2; [|apply mem_equiv_sym; eauto].
-    eapply mem_evolve_access, storebytes_access; eauto.
+  intros; apply juicy_dry_spec; last done; intros.
+  destruct H as [H | [H | ?]]; last done; injection H as <-%ext_link_inj <-; simpl; auto.
+  - if_tac; last done; intros.
+    exists (m, w).
+    destruct w as (((((sh, buf), msg), len), rest), k).
+    iIntros "(Hz & (%Hsh & _) & %Hargs & H)".
+    rewrite /SEPx; monPred.unseal.
+    iDestruct "H" as "(_ & (% & % & Hext) & Hbuf & _)".
+    iDestruct (has_ext_state with "[$Hz $Hext]") as %<-.
+    iSplit.
+    + iDestruct (data_array_at_local_facts with "Hbuf") as %((? & ?) & Hlen & ?).
+      destruct (eq_dec msg []).
+      { destruct buf; try done.
+        iPureIntro; repeat (split; first done).
+        subst; simpl.
+        rewrite Mem.loadbytes_empty //. }
+      erewrite split2_data_at_Tarray_app; [| done |].
+      iDestruct "Hbuf" as "(Hmsg & _)".
+      iDestruct (data_at_bytes with "[$Hz $Hmsg]") as %Hmsg; [done.. | |].
+      { rewrite Forall_map Forall_forall //. }
+      iPureIntro; repeat (split; first done).
+      rewrite Zlength_map map_map // in Hmsg.
+      { rewrite -> Zlength_app, Z.max_r in Hlen.
+        subst. rewrite Z.add_simpl_l //.
+        { destruct msg; first done.
+          simpl in *; rewrite Zlength_cons in Hlen; rep_lia. } }
+    + iIntros (???? (r & -> & ? & -> & -> & <-)).
+      iMod (change_ext_state with "[$]") as "($ & ?)".
+      iIntros "!>".
+      iSplit; first done.
+      rewrite /local /= /lift1; unfold_lift.
+      iSplit.
+      { iPureIntro; destruct ty; done. }
+      iFrame; done.
+  - if_tac; last done; intros.
+    exists (m, w).
+    destruct w as (((sh, buf), len), k).
+    iIntros "(Hz & (%Hsh & _) & %Hargs & H)".
+    rewrite /SEPx; monPred.unseal.
+    iDestruct "H" as "(_ & (% & % & Hext) & Hbuf & _)".
+    iDestruct (has_ext_state with "[$Hz $Hext]") as %<-.
+    iSplit.
+    + iDestruct (data_at__writable_perm with "[$Hz $Hbuf]") as %(? & ? & -> & Hbuf); first done.
+      iPureIntro; repeat (split; first done).
+      simpl in *.
+      rewrite Z.mul_1_l // in Hbuf.
+    + iIntros (???? (r & -> & ? & -> & msg & <- & -> & Hstore)).
+      iDestruct "Hz" as "(Hm & Hz)".
+      rewrite /state_interp.
+      iMod (own_update_2 with "Hz Hext") as "($ & ?)".
+      { apply @excl_auth_update. }
+      destruct buf; try done.
+      destruct Hstore as (? & Hstore & Heq%mem_equiv_sym).
+      rewrite -(mem_auth_equiv _ m') //.
+      iMod (data_at__storebytes _ _ _ _ _ _ (map Vubyte msg) with "[$]") as "($ & ?)"; first done.
+      { rewrite Forall_map Forall_forall; intros byte ??; simpl.
+        rewrite Int.unsigned_repr; rep_lia. }
+      { rewrite map_map //. }
+      { rewrite Zlength_map //. }
+      iIntros "!>"; iExists msg.
+      iSplit; first done.
+      rewrite /local /= /lift1; unfold_lift.
+      iSplit.
+      { iPureIntro; destruct ty; done. }
+      iFrame.
+      iExists (k msg); iSplit; done.
 Qed.
 
 End IO_Dry.
diff --git a/progs/io_mem_specs.v b/progs/io_mem_specs.v
index 33ab396b14..78b1e722db 100644
--- a/progs/io_mem_specs.v
+++ b/progs/io_mem_specs.v
@@ -16,7 +16,7 @@ Notation "' p <- t1 ;; t2" :=
 
 Section specs.
 
-Context {E : Type -> Type} `{IO_event(file_id := nat) -< E}.
+Context {E : Type -> Type} `{IO_event(file_id := nat) -< E} `{!VSTGS (@IO_itree E) Σ}.
 
 Fixpoint read_list_aux f n d : itree E (list byte) :=
   match n with
@@ -49,18 +49,16 @@ Definition getchars_spec {CS : compspecs} :=
     PARAMS (buf; Vint (Int.repr len)) GLOBALS ()
     SEP (ITREE (r <- read_list stdin (Z.to_nat len) ;; k r); data_at_ sh (tarray tuchar len) buf)
   POST [ tint ]
-   EX msg : list byte,
+   ∃ msg : list byte,
     PROP ()
     LOCAL (temp ret_temp (Vint (Int.repr len)))
     SEP (ITREE (k msg); data_at sh (tarray tuchar len) (map Vubyte msg) buf).
 
 (* Build the external specification. *)
-Definition IO_void_Espec : OracleKind := ok_void_spec (@IO_itree E).
-
 Definition IO_specs {CS : compspecs} (ext_link : string -> ident) :=
   [(ext_link "putchars"%string, putchars_spec); (ext_link "getchars"%string, getchars_spec)].
 
-Definition IO_Espec {CS : compspecs} (ext_link : string -> ident) : OracleKind :=
-  add_funspecs IO_void_Espec ext_link (IO_specs ext_link).
+#[export] Instance IO_ext_spec {CS : compspecs} (ext_link : string -> ident) : ext_spec IO_itree :=
+  add_funspecs_rec IO_itree ext_link (void_spec IO_itree) (IO_specs ext_link).
 
 End specs.
diff --git a/progs/io_os_connection.v b/progs/io_os_connection.v
index d0f12be9a6..d1ca194996 100644
--- a/progs/io_os_connection.v
+++ b/progs/io_os_connection.v
@@ -16,6 +16,8 @@ Require Import VST.zlist.sublist.
 Require Import VST.progs.os_combine.
 Import ExtLib.Structures.Monad.
 
+Opaque eq_dec.eq_dec.
+
 Local Ltac inj :=
   repeat match goal with
   | H: _ = _ |- _ => assert_succeeds (injection H); Coqlib.inv H
@@ -729,9 +731,10 @@ Section Invariants.
       end) evs)).
   Proof.
     induction evs as [| ev evs]; cbn -[Zlength]; intros * Hall Hmax Hlen.
-    { cbn in *.
+    { rewrite app_nil_r.
+      cbn in *.
       replace (Zlength (compute_console' tr)) with CONS_BUFFER_MAX_CHARS by lia.
-      cbn; auto using app_nil_r.
+      cbn; auto.
     }
     rewrite Zlength_cons in Hlen.
     edestruct Hall as (? & ? & ? & ?); eauto; subst.
@@ -1913,7 +1916,7 @@ Import functional_base.
       split; auto; cbn in *.
       rewrite Int.signed_repr by (cbn; lia).
       destruct (Coqlib.zeq z1 (-1)); subst; auto.
-      if_tac; try easy.
+      destruct (eq_dec.eq_dec _ _); try easy.
       rewrite Zle_imp_le_bool by lia.
       destruct Hput as (? & [(? & ?) | (? & ?)]); subst; auto; try lia.
       rewrite Zmod_small; auto; functional_base.rep_lia.
@@ -1985,6 +1988,6 @@ Import functional_base.
       admit.
     - (* trace_itree_match *)
       admit.
-  Admitted.
+  Abort.
 
 End SpecsCorrect.
diff --git a/progs/io_specs.v b/progs/io_specs.v
index 491c91e776..d1de35a5cf 100644
--- a/progs/io_specs.v
+++ b/progs/io_specs.v
@@ -4,19 +4,20 @@ Require Export VST.floyd.io_events.
 Require Export ITree.ITree.
 Require Export ITree.Eq.
 Require Export ITree.Eq.SimUpToTaus.
-(* Import ITreeNotations. *) (* one piece conflicts with subp notation *)
+(* Import ITreeNotations. *) (* notation conflict *)
 Notation "x <- t1 ;; t2" := (ITree.bind t1 (fun x => t2))
   (at level 100, t1 at next level, right associativity) : itree_scope.
 Notation "' p <- t1 ;; t2" :=
   (ITree.bind t1 (fun x_ => match x_ with p => t2 end))
 (at level 100, t1 at next level, p pattern, right associativity) : itree_scope.
-
 Definition stdin := 0%nat.
 Definition stdout := 1%nat.
 
 Section specs.
 
-Context {E : Type -> Type} `{IO_event(file_id := nat) -< E}.
+Context {E : Type -> Type} `{IO_event(file_id := nat) -< E} `{!VSTGS (@IO_itree E) Σ}.
+
+Notation IO_itree := (@IO_itree E).
 
 Definition putchar_spec :=
   WITH c : byte, k : IO_itree
@@ -25,7 +26,7 @@ Definition putchar_spec :=
     PARAMS (Vubyte c) GLOBALS()
     SEP (ITREE (write stdout c ;; k)%itree)
   POST [ tint ]
-   EX i : int,
+   ∃ i : int,
     PROP (Int.signed i = -1 \/ Int.signed i = Byte.unsigned c)
     LOCAL (temp ret_temp (Vint i))
     SEP (ITREE (if eq_dec (Int.signed i) (-1) then (write stdout c ;; k)%itree else k)).
@@ -37,17 +38,16 @@ Definition getchar_spec :=
     PARAMS () GLOBALS()
     SEP (ITREE (r <- read stdin ;; k r)%itree)
   POST [ tint ]
-   EX i : int,
+   ∃ i : int,
     PROP (-1 <= Int.signed i <= Byte.max_unsigned)
     LOCAL (temp ret_temp (Vint i))
     SEP (ITREE (if eq_dec (Int.signed i) (-1) then (r <- read stdin ;; k r)%itree else k (Byte.repr (Int.signed i)))).
 
 (* Build the external specification. *)
-Program Definition IO_void_Espec : OracleKind := ok_void_spec (@IO_itree E).
-
 Definition IO_specs (ext_link : string -> ident) :=
   [(ext_link "putchar"%string, putchar_spec); (ext_link "getchar"%string, getchar_spec)].
 
-Definition IO_Espec (ext_link : string -> ident) : OracleKind := add_funspecs IO_void_Espec ext_link (IO_specs ext_link).
+#[export] Instance IO_ext_spec (ext_link : string -> ident) : ext_spec IO_itree :=
+    add_funspecs_rec IO_itree ext_link (void_spec IO_itree) (IO_specs ext_link).
 
 End specs.
diff --git a/progs/list_dt.v b/progs/list_dt.v
index 3a819bdcc5..36eb901239 100644
--- a/progs/list_dt.v
+++ b/progs/list_dt.v
@@ -18,6 +18,7 @@ Require Import VST.floyd.field_at.
 Require Import VST.floyd.nested_loadstore.
 (*Require Import VST.floyd.unfold_data_at.*)
 Require Import VST.floyd.entailer.
+Require Import VST.floyd.compat. Import NoOracle.
 (*  End TEMPORARILY *)
 
 Lemma int64_eq_e: forall i j, Int64.eq i j = true -> i=j.
@@ -26,29 +27,6 @@ Proof. intros. pose proof (Int64.eq_spec i j); rewrite H in H0; auto. Qed.
 Lemma ptrofs_eq_e: forall i j, Ptrofs.eq i j = true -> i=j.
 Proof. intros. pose proof (Ptrofs.eq_spec i j); rewrite H in H0; auto. Qed.
 
-Lemma allp_andp1  {A}{ND: NatDed A}:  forall B (any: B) (p: B -> A) q, andp (allp p) q = (allp (fun x => andp (p x) q)).
-Proof.
- intros. apply pred_ext.
- apply allp_right; intro x.
- apply andp_derives; auto. apply allp_left with x; auto.
- apply andp_right. apply allp_right; intro x. apply allp_left with x. apply andp_left1; auto.
- apply allp_left with any. apply andp_left2; auto.
-Qed.
-
-Lemma allp_andp2  {A}{ND: NatDed A}:  forall B (any: B) p (q: B -> A),
-     andp p (allp q) = (allp (fun x => andp p (q x))).
-Proof.
-intros. rewrite andp_comm. rewrite allp_andp1; auto.
-f_equal. extensionality x. rewrite andp_comm; auto.
-Qed.
-
-Lemma valid_pointer_offset_val_zero:
-  forall p, valid_pointer (offset_val 0 p) = valid_pointer p.
-Proof.
-Admitted.
-
-Local Open Scope logic.
-
 Class listspec {cs: compspecs} (list_structid: ident) (list_link: ident) (token: share -> val -> mpred):=
   mk_listspec {
    list_fields: members;
@@ -205,8 +183,8 @@ list_rect
                  (eq_rect (it1 :: all_but_link f1)
                     (fun e : members =>
                      match e with
-                     | nil => False
-                     | _ :: _ => True
+                     | nil => False%type
+                     | _ :: _ => True%type
                      end) I nil Heqm1)) Heqm0
          | p :: m0 =>
              fun (_ : all_but_link (it1 :: f1) = p :: m0)
@@ -243,7 +221,7 @@ Lemma struct_pred_type_changable:
   m=m' ->
   JMeq v v' ->
   (forall it v, F it v p = F it v p') ->
-  @struct_pred m A F v p = @struct_pred m' A F v' p'.
+  struct_pred m (A := A) F v p = struct_pred m' (A := A) F v' p'.
 Proof.
 intros.
 subst m'. apply JMeq_eq in H0. subst v'.
@@ -268,8 +246,8 @@ Lemma list_cell_link_join:
      = data_at sh list_struct (list_data v) p.
 Proof.
 unfold list_cell, data_at_, data_at, field_at_, field_at; intros.
-destruct (field_compatible_dec list_struct nil p);
-  [ | solve [apply pred_ext; normalize]].
+(*destruct (field_compatible_dec list_struct nil p);
+  [ | solve [apply pred_ext; normalize]].*)
 Admitted.
 (*
 rewrite <- !gather_prop_left.
@@ -651,7 +629,7 @@ Lemma list_cell_link_join_nospacer:
 Proof.
 intros.
 rewrite <- list_cell_link_join.
-unfold spacer. rewrite if_true. rewrite sepcon_emp. auto.
+unfold spacer. rewrite if_true. rewrite sep_emp. auto.
 lia.
 Qed.
 
@@ -694,25 +672,21 @@ Qed.
 Lemma lseg_eq (ls: listspec list_structid list_link list_token):
   forall dsh psh l v ,
   is_pointer_or_null v ->
-    lseg ls dsh psh l v v = !!(l=nil) && emp.
+    lseg ls dsh psh l v v = (!!(l=nil) && emp).
 Proof.
 intros.
 rewrite (lseg_unfold ls dsh psh l v v).
 destruct l.
-f_equal. f_equal.
-apply prop_ext; split; intro; auto.
+f_equiv. f_equiv. apply prop_ext.
+split; intro; auto.
 unfold ptr_eq.
 unfold is_pointer_or_null in H.
 destruct Archi.ptr64 eqn:Hp;
 destruct v; inv H; auto;
 unfold Ptrofs.cmpu; rewrite Ptrofs.eq_true; auto.
 destruct p.
-apply pred_ext;
-apply derives_extract_prop; intro.
-destruct H0.
-contradiction H1.
-destruct v; inv H; try split; auto; apply Ptrofs.eq_true.
-inv H0.
+rewrite !prop_false_andp; auto.
+rewrite ptr_eq_True; tauto.
 Qed.
 
 Definition lseg_cons (ls: listspec list_structid list_link list_token) dsh psh (l: list (val * elemtype ls)) (x z: val) : mpred :=
@@ -724,59 +698,58 @@ Definition lseg_cons (ls: listspec list_structid list_link list_token) dsh psh (
              lseg ls dsh psh r y z.
 
 Lemma lseg_unroll (ls: listspec list_structid list_link list_token): forall dsh psh l x z ,
-    lseg ls dsh psh l x z =
+    lseg ls dsh psh l x z ⊣⊢
       (!! (ptr_eq x z) && !! (l=nil) && emp) || lseg_cons ls dsh psh l x z.
 Proof.
 intros.
 rewrite lseg_unfold at 1.
 apply pred_ext; destruct l.
-apply derives_extract_prop; intros.
+apply bi.pure_elim_l; intros.
 rewrite prop_true_andp by auto.
 rewrite prop_true_andp by auto.
-apply orp_right1; auto.
+apply bi.or_intro_l; auto.
 destruct p.
-apply orp_right2.
+rewrite <- bi.or_intro_r.
 unfold lseg_cons.
-apply derives_extract_prop; intros.
+apply bi.pure_elim_l; intros.
 destruct H.
-apply exp_left; intro tail.
+apply bi.exist_elim; intro tail.
 normalize.
-apply exp_right with e. rewrite TT_andp.
-apply exp_right with l.
-apply exp_right with tail.
+rewrite <- (bi.exist_intro e).
+rewrite <- (bi.exist_intro l).
+rewrite <- (bi.exist_intro tail).
 repeat rewrite sepcon_andp_prop'.
-apply andp_right.
-apply prop_right; split; auto.
+apply bi.and_intro.
+apply bi.pure_intro; auto.
 subst.
 auto.
 subst. auto.
-apply orp_left.
-rewrite andp_assoc;
-do 2 (apply derives_extract_prop; intro).
- rewrite prop_true_andp by auto. auto.
+apply bi.or_elim.
+rewrite <- bi.pure_and.
+apply bi.pure_elim_l; intros []; auto.
 unfold lseg_cons.
-apply derives_extract_prop; intros.
-apply exp_left; intro h.
-apply exp_left; intro r.
-apply exp_left; intro y.
+apply bi.pure_elim_l; intros.
+apply bi.exist_elim; intro h.
+apply bi.exist_elim; intro r.
+apply bi.exist_elim; intro y.
 do 3 rewrite sepcon_andp_prop'.
-apply derives_extract_prop; intros [? ?].
+apply bi.pure_elim_l; intros [? ?].
 inv H0.
 destruct p.
-apply orp_left.
-rewrite andp_assoc;
-do 2 (apply derives_extract_prop; intro).
+apply bi.or_elim.
+rewrite <- bi.pure_and.
+apply bi.pure_elim_l; intros [].
 inv H0.
 unfold lseg_cons.
-apply derives_extract_prop; intros.
-apply exp_left; intro h.
-apply exp_left; intro r.
-apply exp_left; intro y.
+apply bi.pure_elim_l; intros.
+apply bi.exist_elim; intro h.
+apply bi.exist_elim; intro r.
+apply bi.exist_elim; intro y.
 do 3 rewrite sepcon_andp_prop'.
-apply derives_extract_prop; intros [? ?].
+apply bi.pure_elim_l; intros [? ?].
 symmetry in H0; inv H0.
- rewrite prop_true_andp by auto.
-apply exp_right with y.
+rewrite prop_true_andp by auto.
+rewrite <- (bi.exist_intro y).
 normalize.
 Qed.
 
@@ -789,38 +762,35 @@ Lemma lseg_unroll_nonempty1 (ls: listspec list_structid list_link list_token):
                    (valinject (nested_field_type list_struct (StructField list_link :: nil)) p) v1 *
                lseg ls dsh psh tail p v2)) ->
     P |-- lseg ls dsh psh ((v1,h)::tail) v1 v2.
-Proof. intros. rewrite lseg_unroll. apply orp_right2. unfold lseg_cons.
+Proof. intros. rewrite lseg_unroll. rewrite <- bi.or_intro_r. unfold lseg_cons.
   rewrite prop_true_andp by auto.
-  apply exp_right with h. apply exp_right with tail. apply exp_right with p.
+  rewrite <- (bi.exist_intro h). rewrite <- (bi.exist_intro tail). rewrite <- (bi.exist_intro p).
     rewrite prop_true_andp by auto.
- rewrite sepcon_assoc.
- eapply derives_trans; [ apply H1 | ].
- apply sepcon_derives; auto.
+  rewrite H1; cancel.
 Qed.
 
 Lemma lseg_neq (ls: listspec list_structid list_link list_token):
   forall dsh psh s v v2,
     ptr_neq v v2 ->
-     lseg ls dsh psh s v v2 = lseg_cons ls dsh psh s v v2.
+     lseg ls dsh psh s v v2 ⊣⊢ lseg_cons ls dsh psh s v v2.
 intros. rewrite lseg_unroll.
-apply pred_ext. apply orp_left; auto.
-rewrite andp_assoc.
-do 2 (apply derives_extract_prop; intro).
+apply pred_ext. apply bi.or_elim; auto.
+rewrite <- bi.pure_and.
+apply bi.pure_elim_l; intros [].
 congruence.
-apply orp_right2. auto.
+apply bi.or_intro_r.
 Qed.
 
 Lemma lseg_nonnull (ls: listspec list_structid list_link list_token):
   forall dsh psh s v,
       typed_true (tptr list_struct) v ->
-     lseg ls dsh psh s v nullval = lseg_cons ls dsh psh s v nullval.
+     lseg ls dsh psh s v nullval ⊣⊢ lseg_cons ls dsh psh s v nullval.
 Proof.
 intros. unfold nullval.
 apply lseg_neq.
 destruct v; inv H; intuition; try congruence.
 intro. apply ptr_eq_e in H.
-destruct Archi.ptr64 eqn:Hp; inv H.
-inv H1.
+destruct Archi.ptr64 eqn:Hp; inv H; try done.
 intro. simpl in H.
 destruct Archi.ptr64; congruence.
 Qed.
@@ -842,35 +812,19 @@ Lemma unfold_lseg_neq (ls: listspec list_structid list_link list_token):
         end.
 Proof.
 intros.
-apply derives_trans with
+trans
 (PROPx P (LOCALx (Q1::Q) (SEPx (lseg_cons ls dsh psh s v v2 :: R)))).
-apply derives_trans with
+trans
 (!! ptr_neq v v2 && PROPx P (LOCALx (Q1::Q) (SEPx (lseg ls dsh psh s v v2 :: R)))).
-apply andp_right; auto.
-intro rho; unfold PROPx,LOCALx,SEPx,local,tc_expr,tc_lvalue; unfold_lift; simpl.
-unfold lift1; simpl.
- repeat (apply derives_extract_prop; intro).
- rewrite prop_true_andp by auto.
- rewrite prop_true_andp by auto.
-apply sepcon_derives; auto.
+apply bi.and_intro; auto.
+apply bi.pure_elim_l; intros.
 rewrite lseg_neq; auto.
-intro rho; unfold PROPx,LOCALx,SEPx,local,tc_expr,tc_lvalue,lift2,lift1,lift0; simpl.
- unfold_lift.
- unfold lseg_cons. simpl.
- apply derives_extract_prop; intro.
- apply derives_extract_prop; intros [? ?].
- rewrite sepcon_andp_prop'.
- apply derives_extract_prop; intro.
- rewrite exp_sepcon1; apply exp_left; intro h.
- rewrite exp_sepcon1; apply exp_left; intro r.
- rewrite exp_sepcon1; apply exp_left; intro y.
- repeat rewrite sepcon_andp_prop'.
- apply derives_extract_prop; intros [? ?].
- subst.
- apply exp_right with (h,r,y, v).
- repeat rewrite prop_true_andp by auto.
- repeat rewrite sepcon_assoc.
- auto.
+unfold lseg_cons.
+rewrite <- insert_local.
+iIntros "(#? & #? & #? & ((% & % & % & % & H) & ?))".
+iExists (h, r, y, v).
+iDestruct "H" as "(((((% & %) & ?) & ?) & ?) & ?)"; iSplit; auto.
+iFrame; auto.
 Qed.
 
 Lemma unfold_lseg_cons (ls: listspec list_structid list_link list_token):
@@ -890,29 +844,26 @@ Lemma unfold_lseg_cons (ls: listspec list_structid list_link list_token):
         end.
 Proof.
 intros. apply unfold_lseg_neq.
-eapply derives_trans.
-apply H. normalize.
-unfold local. super_unfold_lift.
-unfold nullval.
+rewrite H. normalize.
 intro.
 apply ptr_eq_e in H1. subst.
 normalize.
 Qed.
 
 Lemma semax_lseg_neq (ls: listspec list_structid list_link list_token):
-  forall (Espec: OracleKind)
-      Delta P Q dsh psh s v v2 R c Post,
+  forall {OK_spec}
+      E Delta P Q dsh psh s v v2 R c Post,
     ~ (ptr_eq v v2) ->
   (forall (h: elemtype ls) (r: list (val * elemtype ls)) (y: val),
     s=(v,h)::r -> is_pointer_or_null y ->
-    semax Delta
+    semax(OK_spec := OK_spec) E Delta
         (PROPx P (LOCALx Q
         (SEPx (list_token dsh v :: list_cell ls dsh h v ::
                   field_at psh list_struct (StructField list_link :: nil)
                       (valinject (nested_field_type list_struct (StructField list_link :: nil)) y) v ::
                   lseg ls dsh psh r y v2 ::
                   R)))) c Post) ->
-   semax Delta
+   semax E Delta
        (PROPx P (LOCALx Q (SEPx (lseg ls dsh psh s v v2 :: R))))
        c Post.
 Proof.
@@ -928,11 +879,9 @@ apply semax_pre0 with
                       (nested_field_type list_struct
                          (StructField list_link :: nil)) y) v ::
         lseg ls dsh psh r y v2 :: R)))).
-go_lowerx; entailer.
+go_lowerx; entailer!.
 Exists h r y.
-rewrite <- ?sepcon_assoc.
-normalize.
-  autorewrite with subst norm1 norm2; normalize.
+entailer!.
 Intros h r y.
 apply semax_extract_prop; intros [? ?].
 eapply H0; eauto.
@@ -940,47 +889,45 @@ Qed.
 
 
 Lemma semax_lseg_nonnull (ls: listspec list_structid list_link list_token):
-  forall (Espec: OracleKind)
-      Delta P Q dsh psh s v R c Post,
-   ENTAIL Delta, PROPx P (LOCALx Q
-            (SEPx (lseg ls dsh psh s v nullval :: R))) |--
-                        !!(typed_true (tptr list_struct) v)  ->
+  forall OK_spec
+      E Delta P Q dsh psh s v R c Post,
+   (ENTAIL Delta, PROPx P (LOCALx Q
+            (SEPx (lseg ls dsh psh s v nullval :: R))) ⊢
+                        !!(typed_true (tptr list_struct) v))  ->
   (forall (h: elemtype ls) (r: list (val * elemtype ls)) (y: val),
     s=(v,h)::r -> is_pointer_or_null y ->
-    semax Delta
+    semax(OK_spec := OK_spec) E Delta
         (PROPx P (LOCALx Q
         (SEPx (list_token dsh v :: list_cell ls dsh h v ::
                   field_at psh list_struct (StructField list_link :: nil) (valinject (nested_field_type list_struct (StructField list_link :: nil)) y) v ::
                   lseg ls dsh psh r y nullval ::
                   R)))) c Post) ->
-   semax Delta
+   semax E Delta
        (PROPx P (LOCALx Q (SEPx (lseg ls dsh psh s v nullval :: R))))
        c Post.
 Proof.
 intros.
 assert_PROP (~ ptr_eq v nullval).
-eapply derives_trans; [apply H |].
+rewrite H.
 normalize.
 apply semax_lseg_neq; auto.
 Qed.
 
 Lemma lseg_nil_eq (ls: listspec list_structid list_link list_token):
-    forall dsh psh p q, lseg ls dsh psh nil p q = !! (ptr_eq p q) && emp.
+    forall dsh psh p q, lseg ls dsh psh nil p q ⊣⊢ !! (ptr_eq p q) && emp.
 Proof. intros.
  rewrite lseg_unroll.
  apply pred_ext.
- apply orp_left.
- rewrite andp_assoc.
- apply andp_derives; auto.
-rewrite prop_true_andp by auto. auto.
- unfold lseg_cons. normalize. inv H0.
- apply orp_right1.  rewrite andp_assoc.
+ apply bi.or_elim.
+ rewrite <- bi.pure_and; apply bi.pure_elim_l; intros []; auto.
+ unfold lseg_cons. by normalize.
+ rewrite <- bi.or_intro_l. rewrite <- bi.and_assoc.
  rewrite (prop_true_andp (_ = _)) by auto. auto.
 Qed.
 
 Lemma lseg_cons_eq (ls: listspec list_structid list_link list_token):
      forall dsh psh h r x z ,
-    lseg ls dsh psh (h::r) x z =
+    lseg ls dsh psh (h::r) x z ⊣⊢
         !!(x = fst h /\ ~ ptr_eq x z) &&
          (EX  y : val,
           !!(is_pointer_or_null y) &&
@@ -989,23 +936,21 @@ Lemma lseg_cons_eq (ls: listspec list_structid list_link list_token):
 Proof.
  intros. rewrite lseg_unroll.
  apply pred_ext.
- apply orp_left.
- rewrite andp_assoc.
- apply derives_extract_prop; intro.
- apply derives_extract_prop; intro.
+ apply bi.or_elim.
+ rewrite <- bi.pure_and.
+ apply bi.pure_elim_l; intros [].
  inv H0.
  unfold lseg_cons.
  normalize.
  symmetry in H0; inv H0.
- apply exp_right with y. normalize.
-  autorewrite with subst norm1 norm2; normalize.
+ rewrite <- (bi.exist_intro y). entailer!. auto.
  normalize. destruct h as [p h]. simpl in *.
- apply orp_right2.
+ rewrite <- bi.or_intro_r.
  unfold lseg_cons.
  rewrite prop_true_andp by auto.
- apply exp_right with h. apply exp_right with r.  apply exp_right with y.
- normalize.
-  autorewrite with subst norm1 norm2; normalize.
+  rewrite <- !bi.exist_intro.
+  cancel.
+  simpl; entailer!.
 Qed.
 
 Definition lseg_cons_right (ls: listspec list_structid list_link list_token)
@@ -1031,27 +976,15 @@ normalize.
 revert x; induction l; simpl; intros.
 *
 normalize.
-  autorewrite with subst norm1 norm2; normalize.
- apply exp_right with z.
+ rewrite <- (bi.exist_intro z).
  entailer!.
 *
 destruct a as [v el].
-normalize.
-apply exp_right with x0.
-normalize.
-rewrite <- ?sepcon_assoc.
-  autorewrite with subst norm1 norm2; normalize.
-specialize (IHl x0).
-entailer.
-pull_right (list_cell ls dsh el x).
-apply sepcon_derives; auto.
-pull_right (field_at psh list_struct (StructField list_link :: nil)
-      (valinject
-         (nested_field_type list_struct (StructField list_link :: nil)) x0)
-      x).
-pull_right (list_token dsh x).
-apply sepcon_derives; auto.
-apply sepcon_derives; auto.
+iIntros "((H & (% & %) & % & ? & lseg) & Hz)"; subst.
+iAssert ⌜~ptr_eq x z⌝ as %?.
+{ iStopProof; entailer!. }
+iPoseProof (IHl with "[$H $lseg $Hz]") as "(? & ?)".
+iFrame; auto.
 Qed.
 
 Lemma lseg_cons_right_null (ls: listspec list_structid list_link list_token): forall dsh psh l x h y,
@@ -1062,36 +995,15 @@ Proof.
 intros.
 revert x; induction l; simpl; intros.
 *
-normalize.
-  autorewrite with subst norm1 norm2; normalize.
-apply exp_right with nullval.
-apply andp_right.
-apply not_prop_right; intro.
-apply ptr_eq_e in H. subst y.
-entailer!.
-destruct H. contradiction H.
-rewrite prop_true_andp by reflexivity.
-rewrite prop_true_andp
-  by (unfold nullval; destruct Archi.ptr64 eqn:Hp; simpl; auto).
-normalize.
+Exists nullval; entailer!.
 *
 destruct a as [v el].
-normalize.
-apply exp_right with x0.
-normalize.
-  autorewrite with subst norm1 norm2; normalize.
-specialize (IHl x0).
-apply andp_right.
-rewrite prop_and.
-apply andp_right; [ | apply prop_right; auto].
-apply not_prop_right; intro.
-apply ptr_eq_e in H0. subst x.
-entailer.
-destruct H2; contradiction H2.
-eapply derives_trans.
-2: apply sepcon_derives; [ | eassumption]; apply derives_refl.
-clear IHl.
-cancel.
+iIntros "(H & (% & %) & % & ? & lseg)"; subst.
+iAssert ⌜~ptr_eq x nullval⌝ as %?.
+{ iStopProof; entailer!. }
+iPoseProof (IHl with "[$H $lseg]") as "?".
+iSplit; first done.
+iExists y0; iFrame.
 Qed.
 
 
@@ -1106,20 +1018,14 @@ Proof.
 intros.
 destruct l'.
 rewrite lseg_nil_eq.
-normalize.
-rewrite prop_true_andp by apply ptr_eq_nullval.
-apply lseg_cons_right_null.
+entailer!.
+rewrite <- lseg_cons_right_null; cancel.
+
 rewrite lseg_cons_eq.
 Intros u. Exists u. subst z.
-rewrite <- ?sepcon_assoc.
-rewrite !prop_true_andp by auto.
-normalize.
-apply sepcon_derives; auto.
-pull_right (list_cell ls dsh (snd p) (fst p)).
-pull_right (list_token dsh (fst p)).
-apply sepcon_derives; auto.
-apply sepcon_derives; auto.
-apply lseg_cons_right_neq; auto.
+iIntros "(H & (? & Hp) & ?)".
+iPoseProof (lseg_cons_right_neq with "[$H $Hp]") as "?"; first done.
+iStopProof; entailer!.
 Qed.
 
 Lemma lseg_unroll_right (ls: listspec list_structid list_link list_token): forall sh sh' l x z ,
@@ -1135,22 +1041,22 @@ Proof.
 intros.
 rewrite lseg_unfold.
 destruct contents.
-apply derives_extract_prop; intro.
+apply bi.pure_elim_l; intro.
 unfold ptr_eq in H.
-apply prop_right.
+apply bi.pure_intro.
 destruct p; try contradiction; simpl; auto.
 destruct q; try contradiction; auto.
 unfold Int.cmpu in H.
 destruct H as [? [? ?]].
 apply int_eq_e in H0.
-apply int_eq_e in H1. subst. rewrite H.
+apply int_eq_e in H1. subst.
 split; auto; split; auto.
 destruct q; try contradiction; auto.
 unfold Int64.cmpu in H.
 destruct H as [? [? ?]].
 apply int64_eq_e in H0.
-apply int64_eq_e in H1. subst. rewrite H.
-split3; auto.
+apply int64_eq_e in H1. subst.
+split3; auto; done.
 destruct q; try contradiction.
 destruct H; subst.
 unfold Ptrofs.cmpu in H0.
@@ -1159,9 +1065,7 @@ subst. tauto.
 destruct p0.
 normalize.
 rewrite field_at_isptr.
-normalize.
-  autorewrite with subst norm1 norm2; normalize.
-apply prop_right.
+Intros; entailer!.
 split. intro; subst q.
 contradiction H. normalize.
 intros. discriminate.
@@ -1175,7 +1079,7 @@ Definition lseg_cell  (ls: listspec list_structid list_link list_token)
 Lemma lseg_cons_eq2: forall
   (ls : listspec list_structid list_link list_token) (dsh psh : share) (h : elemtype ls)
    (r : list (val * elemtype ls))
-  (x x' z : val), lseg ls dsh psh ((x',h) :: r) x z =
+  (x x' z : val), lseg ls dsh psh ((x',h) :: r) x z ⊣⊢
   !!(x=x' /\ ~ ptr_eq x z) && (EX  y : val, lseg_cell ls dsh psh h x y * lseg ls dsh psh r y z).
 Proof.
   intros.
@@ -1196,27 +1100,16 @@ Proof.
   normalize.
   *
   destruct a  as [v a].
-  normalize.
-  autorewrite with subst norm1 norm2; normalize.
-  apply exp_right with y.
-  apply andp_right.
-  apply not_prop_right; intro. apply ptr_eq_e in H1; subst hd.
-  clear IHct1.
+  Intros y.
+  apply bi.and_intro.
+  destruct (eq_dec hd tl); last by entailer!.
+  subst; clear IHct1.
   unfold lseg_cell in H.
   specialize (H a y).
   rewrite prop_true_andp in H by auto.
-  apply derives_trans with
-        (lseg ls dsh psh ct1 y mid * lseg ls dsh psh ct2 mid tl * FF).
- cancel. auto.
-  rewrite sepcon_FF; auto.
-  normalize.
-  specialize (IHct1 y). clear H.
-   do 2 rewrite sepcon_assoc.
-  eapply derives_trans.
- apply sepcon_derives.
-  apply derives_refl.
-  rewrite <- !sepcon_assoc; eassumption.
-  cancel.
+  iIntros "(((? & ?) & ?) & ?)"; iDestruct (H with "[$]") as "[]".
+  go_lower.sep_apply IHct1.
+  Exists y; entailer!.
 Qed.
 
 Lemma list_append_null:
@@ -1228,9 +1121,9 @@ Lemma list_append_null:
    lseg ls dsh psh (ct1++ct2) hd nullval.
 Proof.
 intros.
- rewrite <- sepcon_emp.
- eapply derives_trans; [ | apply (list_append hd mid nullval ct1 ct2 (fun _ => emp))].
- normalize.
+ rewrite <- bi.sep_emp.
+ rewrite (list_append _ _ _ _ _ (fun _ => emp)).
+ iIntros "($ & _)".
  intros.
   unfold lseg_cell. simpl. saturate_local. destruct H. contradiction H.
 Qed.
@@ -1262,7 +1155,7 @@ Definition lseg (ls: listspec list_structid list_link list_token) (sh: share)
              LsegGeneral.lseg ls sh sh al x y.
 
 Lemma lseg_unfold (ls: listspec list_structid list_link list_token): forall sh contents v1 v2,
-    lseg ls sh contents v1 v2 =
+    lseg ls sh contents v1 v2 ⊣⊢
      match contents with
      | h::t => !! (~ ptr_eq v1 v2) && EX tail: val,
                       !! is_pointer_or_null tail &&
@@ -1279,39 +1172,37 @@ Proof.
  apply pred_ext.
  normalize. destruct al; inv H.
  rewrite LsegGeneral.lseg_nil_eq; auto.
- apply exp_right with nil.
- apply derives_extract_prop; intro.
+ rewrite <- (bi.exist_intro nil).
+ apply bi.pure_elim_l; intro.
  normalize.
  apply pred_ext.
- apply exp_left; intros [ | [v1' a'] al].
- normalize. inv H.
- apply derives_extract_prop; intro.
+ apply bi.exist_elim; intros [ | [v1' a'] al].
+ Intros. inv H.
+ apply bi.pure_elim_l; intro.
  symmetry in H; inv H.
  rewrite LsegGeneral.lseg_cons_eq; auto.
- apply derives_extract_prop; intros [? ?].
+ apply bi.pure_elim_l; intros [? ?].
  simpl in H;  subst v1'.
- apply exp_left; intro y.
- normalize. apply exp_right with y. normalize.
- repeat apply sepcon_derives; auto.
- apply exp_right with al; normalize.
- normalize.
- apply exp_right with ((v1,a)::al); normalize.
+ apply bi.exist_elim; intro y.
+ normalize. rewrite <- (bi.exist_intro y). normalize.
+ rewrite <- (bi.exist_intro al); normalize.
+ Intros tail al.
+ rewrite <- (bi.exist_intro ((v1,a)::al)); entailer!.
  simpl.
- normalize. apply exp_right with tail. normalize.
-  autorewrite with subst norm1 norm2; normalize.
+ normalize. rewrite <- (bi.exist_intro tail). entailer!.
 Qed.
 
 Lemma lseg_eq (ls: listspec list_structid list_link list_token):
   forall sh l v ,
   is_pointer_or_null v ->
-    lseg ls sh l v v = !!(l=nil) && emp.
+    lseg ls sh l v v ⊣⊢ !!(l=nil) && emp.
 Proof.
 intros.
 unfold lseg.
 apply pred_ext.
 normalize.
 rewrite LsegGeneral.lseg_eq by auto. normalize.
-apply exp_right with nil.
+rewrite <- (bi.exist_intro nil).
 normalize.
 Qed.
 
@@ -1324,52 +1215,48 @@ Definition lseg_cons (ls: listspec list_structid list_link list_token) sh (l: li
               lseg ls sh r y z.
 
 Lemma lseg_unroll (ls: listspec list_structid list_link list_token): forall sh l x z ,
-    lseg ls sh l x z =
+    lseg ls sh l x z ⊣⊢
       (!! (ptr_eq x z) && !! (l=nil) && emp) || lseg_cons ls sh l x z.
 Proof.
 intros.
 unfold lseg, lseg_cons.
 apply pred_ext.
 *
-apply exp_left; intros.
-apply derives_extract_prop; intro.
+apply bi.exist_elim; intros.
+apply bi.pure_elim_l; intro.
 rewrite LsegGeneral.lseg_unroll.
-apply orp_left; [apply orp_right1 | apply orp_right2].
-rewrite andp_assoc; repeat (apply derives_extract_prop; intro).
-subst. simpl.
-normalize.
+apply bi.or_elim; [rewrite <- bi.or_intro_l | rewrite <- bi.or_intro_r].
+rewrite <- bi.pure_and; apply bi.pure_elim_l; intros [].
+entailer!.
 unfold LsegGeneral.lseg_cons.
-apply derives_extract_prop; intro.
+apply bi.pure_elim_l; intro.
 rewrite prop_true_andp by auto.
-apply exp_derives; intro h.
-apply exp_left; intro r; apply exp_right with (map snd r).
-apply exp_derives; intro y.
+apply bi.exist_mono; intro h.
+apply bi.exist_elim; intro r; rewrite <- (bi.exist_intro (map snd r)).
+apply bi.exist_mono; intro y.
 normalize.
 subst l.
 unfold lseg.
 cancel.
-apply exp_right with r; normalize.
+rewrite <- (bi.exist_intro r); normalize.
 *
-apply orp_left.
-rewrite andp_assoc; repeat (apply derives_extract_prop; intro).
-subst.
-apply exp_right with nil.
-simpl. normalize.
-  autorewrite with subst norm1 norm2; normalize.
-apply derives_extract_prop; intro.
-apply exp_left; intro h.
-apply exp_left; intro r.
-apply exp_left; intro y.
+apply bi.or_elim.
+rewrite <- bi.pure_and; apply bi.pure_elim_l; intros [].
+rewrite <- (bi.exist_intro nil).
+simpl. entailer!.
+apply bi.pure_elim_l; intro.
+apply bi.exist_elim; intro h.
+apply bi.exist_elim; intro r.
+apply bi.exist_elim; intro y.
 normalize.
 unfold lseg.
 normalize.
-apply exp_right with ((x,h)::al).
+rewrite <- (bi.exist_intro ((x,h)::al)).
 normalize.
 simpl.
 normalize.
-apply exp_right with y.
-normalize.
-  autorewrite with subst norm1 norm2; normalize.
+rewrite <- (bi.exist_intro y).
+entailer!.
 Qed.
 
 Lemma lseg_unroll_nonempty1 (ls: listspec list_structid list_link list_token):
@@ -1381,31 +1268,32 @@ Lemma lseg_unroll_nonempty1 (ls: listspec list_structid list_link list_token):
                    (valinject (nested_field_type list_struct (StructField list_link :: nil)) p) v1 *
                lseg ls sh tail p v2)) ->
     P |-- lseg ls sh (h::tail) v1 v2.
-Proof. intros. rewrite lseg_unroll. apply orp_right2. unfold lseg_cons.
+Proof. intros. rewrite lseg_unroll. rewrite <- bi.or_intro_r. unfold lseg_cons.
   rewrite prop_true_andp by auto.
-  apply exp_right with h. apply exp_right with tail. apply exp_right with p.
+  Exists h tail p.
     rewrite prop_true_andp by auto.
- rewrite sepcon_assoc.
- eapply derives_trans; [ apply H1 | ].
- apply sepcon_derives; auto.
+ rewrite H1; entailer!.
 Qed.
 
 Lemma lseg_neq (ls: listspec list_structid list_link list_token):
   forall sh s v v2,
     ptr_neq v v2 ->
-     lseg ls sh s v v2 = lseg_cons ls sh s v v2.
+     lseg ls sh s v v2 ⊣⊢ lseg_cons ls sh s v v2.
+Proof.
 intros. rewrite lseg_unroll.
-apply pred_ext. apply orp_left; auto.
-rewrite andp_assoc.
-do 2 (apply derives_extract_prop; intro).
+apply pred_ext. apply bi.or_elim; auto.
+rewrite <- bi.pure_and.
+apply bi.pure_elim_l; intros [].
 congruence.
-apply orp_right2. auto.
+apply bi.or_intro_r.
 Qed.
 
+Opaque Archi.ptr64.
+
 Lemma lseg_nonnull (ls: listspec list_structid list_link list_token):
   forall sh s v,
       typed_true (tptr list_struct) v ->
-     lseg ls sh s v nullval = lseg_cons ls sh s v nullval.
+     lseg ls sh s v nullval ⊣⊢ lseg_cons ls sh s v nullval.
 Proof.
 intros. unfold nullval.
 apply lseg_neq.
@@ -1413,12 +1301,12 @@ unfold typed_true, strict_bool_val in H.
 simpl in H.
 destruct Archi.ptr64 eqn:Hp.
 *
-destruct v; inv H. 
-destruct (Int64.eq i Int64.zero); inv H1.
+destruct v; inversion H; clear H.
+destruct (Int64.eq i Int64.zero); inversion H1.
 intro; apply ptr_eq_e in H; inv H.
 *
-destruct v; inv H.
-destruct (Int.eq i Int.zero); inv H1.
+destruct v; inversion H; clear H.
+destruct (Int.eq i Int.zero); inversion H1.
 intro; apply ptr_eq_e in H; inv H.
 Qed.
 
@@ -1438,35 +1326,30 @@ Lemma unfold_lseg_neq (ls: listspec list_structid list_link list_token):
         end.
 Proof.
 intros.
-apply derives_trans with
+trans
 (PROPx P (LOCALx (Q1::Q) (SEPx (lseg_cons ls sh s v v2 :: R)))).
-apply derives_trans with
+trans
 (!! (ptr_neq v v2) && PROPx P (LOCALx (Q1::Q) (SEPx (lseg ls sh s v v2 :: R)))).
-apply andp_right; auto.
-intro rho; unfold PROPx,LOCALx,SEPx,local,tc_expr,tc_lvalue; unfold_lift; simpl.
+apply bi.and_intro; auto.
+split => rho; unfold PROPx,LOCALx,SEPx,local,tc_expr,tc_lvalue; unfold_lift; simpl; monPred.unseal.
 unfold lift1; simpl.
- repeat (apply derives_extract_prop; intro).
+ repeat (apply bi.pure_elim_l; intro).
  rewrite prop_true_andp by auto.
  rewrite prop_true_andp by auto.
-apply sepcon_derives; auto.
+apply bi.sep_mono; auto.
 rewrite lseg_neq; auto.
-intro rho; unfold PROPx,LOCALx,SEPx,local,tc_expr,tc_lvalue,lift2,lift1,lift0; simpl.
+split => rho; unfold PROPx,LOCALx,SEPx,local,tc_expr,tc_lvalue,lift2,lift1,lift0; simpl; monPred.unseal.
  unfold_lift.
  unfold lseg_cons. simpl.
- apply derives_extract_prop; intro.
- apply derives_extract_prop; intros [? ?].
+ apply bi.pure_elim_l; intro.
+ apply bi.pure_elim_l; intros [? ?].
  rewrite sepcon_andp_prop'.
- apply derives_extract_prop; intro.
- rewrite exp_sepcon1; apply exp_left; intro h.
- rewrite exp_sepcon1; apply exp_left; intro r.
- rewrite exp_sepcon1; apply exp_left; intro y.
- repeat rewrite sepcon_andp_prop'.
- apply derives_extract_prop; intros [? ?].
+ apply bi.pure_elim_l; intro.
+ Intros h r y.
  subst.
- apply exp_right with (h,r,y).
+ rewrite <- (bi.exist_intro (h,r,y)); simpl.
  repeat rewrite prop_true_andp by auto.
- repeat rewrite sepcon_assoc.
- auto.
+ cancel.
 Qed.
 
 Lemma unfold_lseg_cons (ls: listspec list_structid list_link list_token):
@@ -1485,29 +1368,26 @@ Lemma unfold_lseg_cons (ls: listspec list_structid list_link list_token):
         end.
 Proof.
 intros. apply unfold_lseg_neq.
-eapply derives_trans.
-apply H. normalize.
-unfold local. super_unfold_lift.
-unfold nullval.
+rewrite H. normalize.
 destruct e; inv H0; try congruence; auto.
 intro. apply ptr_eq_e in H0.
 destruct Archi.ptr64; inv H0.
 Qed.
 
 Lemma semax_lseg_neq (ls: listspec list_structid list_link list_token):
-  forall (Espec: OracleKind)
-      Delta P Q sh s v v2 R c Post,
+  forall Espec
+      E Delta P Q sh s v v2 R c Post,
     ~ (ptr_eq v v2) ->
   (forall (h: elemtype ls) (r: list (elemtype ls)) (y: val),
     s=h::r -> is_pointer_or_null y ->
-    semax Delta
+    semax E Delta
         (PROPx P (LOCALx Q
         (SEPx (list_token sh v :: list_cell ls sh h v ::
                   field_at sh list_struct (StructField list_link :: nil)
                       (valinject (nested_field_type list_struct (StructField list_link :: nil)) y) v ::
                    lseg ls sh r y v2 ::
                   R)))) c Post) ->
-   semax Delta
+   semax(OK_spec := Espec) E Delta
        (PROPx P (LOCALx Q (SEPx (lseg ls sh s v v2 :: R))))
        c Post.
 Proof.
@@ -1525,9 +1405,7 @@ apply semax_pre0 with
         lseg ls sh r y v2 :: R)))).
 go_lowerx; entailer.  (* Intros h r y should work here, but doesn't. *)
 Exists h r y.
-rewrite <- ?sepcon_assoc.
-normalize.
-  autorewrite with subst norm1 norm2; normalize.
+entailer!.
 Intros h r y.
 apply semax_extract_prop; intros [? ?].
 eapply H0; eauto.
@@ -1535,47 +1413,46 @@ Qed.
 
 
 Lemma semax_lseg_nonnull (ls: listspec list_structid list_link list_token):
-  forall (Espec: OracleKind)
-      Delta P Q sh s v R c Post,
+  forall Espec
+      E Delta P Q sh s v R c Post,
       ENTAIL Delta, PROPx P (LOCALx Q
             (SEPx (lseg ls sh s v nullval :: R))) |--
                         !!(typed_true (tptr list_struct) v)  ->
   (forall (h: elemtype ls) (r: list (elemtype ls)) (y: val),
     s=h::r -> is_pointer_or_null y ->
-    semax Delta
+    semax(OK_spec := Espec) E Delta
         (PROPx P (LOCALx Q
         (SEPx (list_token sh v :: list_cell ls sh h v ::
                   field_at sh list_struct (StructField list_link :: nil) (valinject (nested_field_type list_struct (StructField list_link :: nil)) y) v ::
                    lseg ls sh r y nullval ::
                   R)))) c Post) ->
-   semax Delta
+   semax E Delta
        (PROPx P (LOCALx Q (SEPx (lseg ls sh s v nullval :: R))))
        c Post.
 Proof.
 intros.
 assert_PROP (~ ptr_eq v nullval).
-eapply derives_trans; [apply H |].
+rewrite H.
 normalize.
 apply semax_lseg_neq; auto.
 Qed.
 
 Lemma lseg_nil_eq (ls: listspec list_structid list_link list_token):
-    forall sh p q, lseg ls sh nil p q = !! (ptr_eq p q) && emp.
+    forall sh p q, lseg ls sh nil p q ⊣⊢ !! (ptr_eq p q) && emp.
 Proof. intros.
  rewrite lseg_unroll.
  apply pred_ext.
- apply orp_left.
- rewrite andp_assoc.
- apply andp_derives; auto.
-rewrite prop_true_andp by auto. auto.
- unfold lseg_cons. normalize. inv H0.
- apply orp_right1.  rewrite andp_assoc.
- rewrite (prop_true_andp (_ = _)) by auto. auto.
+ - apply bi.or_elim.
+   + rewrite <- bi.pure_and.
+     apply bi.pure_elim_l; intros []; auto.
+   + unfold lseg_cons. by normalize.
+ - rewrite <- bi.or_intro_l.
+   apply bi.pure_elim_l; intros; auto.
 Qed.
 
 Lemma lseg_cons_eq (ls: listspec list_structid list_link list_token):
-     forall sh h r x z ,
-    lseg ls sh (h::r) x z =
+     forall sh h r x z,
+    lseg ls sh (h::r) x z ⊣⊢
         !!(~ ptr_eq x z) &&
          (EX  y : val,
           !!(is_pointer_or_null y) &&
@@ -1584,21 +1461,16 @@ Lemma lseg_cons_eq (ls: listspec list_structid list_link list_token):
 Proof.
  intros. rewrite lseg_unroll.
  apply pred_ext.
- apply orp_left.
- rewrite andp_assoc.
- apply derives_extract_prop; intro.
- apply derives_extract_prop; intro.
- inv H0.
- unfold lseg_cons.
- normalize.
- symmetry in H0; inv H0.
- apply exp_right with y. normalize.
- apply orp_right2.
- unfold lseg_cons.
- apply andp_derives; auto.
- apply exp_right with h. apply exp_right with r.  apply exp_derives; intro y.
- normalize.
-  autorewrite with subst norm1 norm2; normalize.
+ - apply bi.or_elim.
+   + rewrite <- bi.pure_and.
+     apply bi.pure_elim_l; intros []; discriminate.
+   + unfold lseg_cons. normalize. inv H0.
+     Exists y; entailer!.
+ - rewrite <- bi.or_intro_r.
+   Intros y.
+   unfold lseg_cons.
+   apply bi.and_intro; first auto.
+   Exists h r y; entailer!.
 Qed.
 
 Definition lseg_cons_right (ls: listspec list_structid list_link list_token)
@@ -1619,10 +1491,9 @@ Proof.
 intros.
 unfold lseg.
 normalize.
-apply exp_right with (al ++ (y,h)::nil).
+Exists (al ++ (y,h)::nil).
 rewrite prop_true_andp by (rewrite map_app; reflexivity).
-eapply derives_trans; [ | apply LsegGeneral.lseg_cons_right_neq; auto].
-cancel.
+apply LsegGeneral.lseg_cons_right_neq; auto.
 Qed.
 
 Lemma lseg_cons_right_null (ls: listspec list_structid list_link list_token): forall sh l x h y,
@@ -1633,10 +1504,9 @@ Proof.
 intros.
 unfold lseg.
 normalize.
-apply exp_right with (al ++ (y,h)::nil).
+Exists (al ++ (y,h)::nil).
 rewrite prop_true_andp by (rewrite map_app; reflexivity).
-eapply derives_trans; [ | apply LsegGeneral.lseg_cons_right_null].
-cancel.
+apply LsegGeneral.lseg_cons_right_null.
 Qed.
 
 
@@ -1650,24 +1520,18 @@ intros.
 destruct l'.
 rewrite lseg_nil_eq.
 normalize.
-rewrite prop_true_andp by apply ptr_eq_nullval.
-apply lseg_cons_right_null.
+rewrite lseg_cons_right_null; auto.
 rewrite lseg_cons_eq.
 Intros u.
 Exists u.
 rewrite !prop_true_andp by auto.
-rewrite <- !sepcon_assoc.
-apply sepcon_derives; auto.
-pull_right (list_cell ls sh e z).
-pull_right (list_token sh z).
-apply sepcon_derives; auto.
-apply sepcon_derives; auto.
-apply lseg_cons_right_neq.
-auto.
+iIntros "(H & (? & Hz) & ?)".
+iDestruct (lseg_cons_right_neq with "[$H $Hz]") as "($ & $)"; first done.
+iFrame.
 Qed.
 
 Lemma lseg_unroll_right (ls: listspec list_structid list_link list_token): forall sh l x z ,
-    lseg ls sh l x z = (!! (ptr_eq x z) && !! (l=nil) && emp) || lseg_cons_right ls sh l x z.
+    lseg ls sh l x z ⊣⊢ (!! (ptr_eq x z) && !! (l=nil) && emp) || lseg_cons_right ls sh l x z.
 Abort.  (* not likely true *)
 
 Lemma lseg_local_facts:
@@ -1678,7 +1542,7 @@ Proof.
 intros.
 unfold lseg.
 normalize.
-eapply derives_trans; [apply LsegGeneral.lseg_local_facts |].
+rewrite LsegGeneral.lseg_local_facts.
 normalize.
 split; auto.
 rewrite H.
@@ -1694,7 +1558,7 @@ Definition lseg_cell (ls: listspec list_structid list_link list_token)
 Lemma lseg_cons_eq2: forall
   (ls : listspec list_structid list_link list_token) (sh : share) (h : elemtype ls)
    (r : list (elemtype ls))
-  (x z : val), lseg ls sh (h :: r) x z =
+  (x z : val), lseg ls sh (h :: r) x z ⊣⊢
   !!(~ ptr_eq x z) && (EX  y : val, lseg_cell ls sh h x y * lseg ls sh r y z).
 Proof.
   intros.
@@ -1712,13 +1576,10 @@ Proof.
   intros.
   unfold lseg.
  normalize.
- eapply derives_trans.
- apply LsegGeneral.list_append.
- intros.
- eapply derives_trans; [ | apply (H x0 tl')].
+ rewrite LsegGeneral.list_append; [ | intros; apply (H _ tl')].
  unfold lseg_cell, LsegGeneral.lseg_cell.
  entailer.
- apply exp_right with (x++al).
+ Exists (al++a).
  rewrite prop_true_andp; auto.
  rewrite map_app; reflexivity.
 Qed.
@@ -1732,9 +1593,9 @@ Lemma list_append_null:
    lseg ls sh (ct1++ct2) hd nullval.
 Proof.
 intros.
- rewrite <- sepcon_emp.
- eapply derives_trans; [ | apply (list_append hd mid nullval ct1 ct2 (fun _ => emp))].
- normalize.
+ rewrite <- bi.sep_emp.
+ rewrite (list_append _ _ _ _ _ (fun _ => emp)).
+ iIntros "($ & _)".
  intros.
   unfold lseg_cell. simpl. saturate_local. destruct H. contradiction H.
 Qed.
@@ -1750,15 +1611,13 @@ Proof.
   intros ? ? ? ? NON_ID ?.
  rewrite list_cell_link_join_nospacer; auto.
  unfold data_at_, field_at_, data_at.
- eapply derives_trans; [ apply field_at_valid_ptr; auto | ].
+ saturate_local.
+ rewrite field_at_valid_ptr; auto.
+ 2: {
  change (nested_field_type list_struct nil) with list_struct.
- apply LsegGeneral.sizeof_list_struct_pos.
+ apply LsegGeneral.sizeof_list_struct_pos. }
  unfold field_address.
- if_tac; auto.
- change (Int.repr (nested_field_offset list_struct nil)) with Int.zero.
-  rewrite valid_pointer_offset_val_zero; auto.
- simpl.
- change predicates_hered.FF with FF. apply FF_left.
+ if_tac; auto; contradiction.
 Qed.
 
 Lemma lseg_valid_pointer:
@@ -1771,20 +1630,16 @@ Lemma lseg_valid_pointer:
 Proof.
 intros ? ? ? ? ? ? NON_ID ? ?.
 destruct contents.
-rewrite lseg_nil_eq. normalize.
+rewrite lseg_nil_eq, H0; entailer!.
 unfold lseg; simpl.
-normalize.
+Intros al.
 destruct al; inv H1.
 rewrite LsegGeneral.lseg_cons_eq.
-normalize.
-destruct p0 as [p z]; simpl in *.
-apply sepcon_valid_pointer2.
-apply sepcon_valid_pointer1.
-rewrite sepcon_assoc.
-apply sepcon_valid_pointer2.
-eapply derives_trans; [ | eapply list_cell_valid_pointer; eauto].
-apply sepcon_derives ; [ apply derives_refl | ].
-cancel.
+Intros y.
+subst; destruct p0 as [p z]; simpl in *.
+iIntros "(? & ((? & cell) & Hp) & ?)".
+iPoseProof (list_cell_valid_pointer with "[$cell Hp]") as "?"; auto.
+iStopProof; cancel.
 Qed.
 
 End LIST.
@@ -1797,10 +1652,10 @@ Ltac resolve_lseg_valid_pointer :=
 match goal with
  | |- ?Q |-- valid_pointer ?p =>
    match Q with context [lseg ?A ?B ?C p ?q] =>
-   repeat rewrite <- sepcon_assoc;
    pull_right (lseg A B C p q);
+   repeat rewrite sep_assoc;
    apply lseg_valid_pointer; [auto | reflexivity | ];
-   auto 50 with valid_pointer
+   auto 50 with nocore valid_pointer
    end
  end.
 
@@ -1837,12 +1692,12 @@ Definition lseg (ls: listspec list_structid list_link list_token) (dsh psh: shar
 Lemma nonreadable_list_cell_eq:
   forall (ls: listspec list_structid list_link list_token) sh v v' p,
     ~ readable_share sh ->
-   list_cell ls sh v p = list_cell ls sh v' p.
+   list_cell ls sh v p ⊣⊢ list_cell ls sh v' p.
 Proof.
 unfold list_cell; intros.
  destruct (field_compatible_dec list_struct nil p);
     [ | solve [ apply pred_ext; normalize ]].
- f_equal.
+ f_equiv.
  revert v v'; unfold elemtype.
  set (m := all_but_link list_fields).
  assert (PLAIN: plain_members m = true). {
@@ -1863,28 +1718,27 @@ unfold list_cell; intros.
  clear IHm; simpl.
  Transparent field_type field_offset.
  rewrite !withspacer_spacer.
- f_equal.
+ f_equiv.
  admit. (* apply nonreadable_data_at_rec_eq; auto. *) (* list_cell should be defined by field_at instead of data_at_rec. *)
  +
  rewrite !struct_pred_cons2.
  rewrite !withspacer_spacer.
- f_equal. f_equal.
+ f_equiv. f_equiv.
  * admit. (* unfold at_offset. apply nonreadable_data_at_rec_eq; auto.*)
  * apply IHm.
-   simpl; auto. 
+   simpl; auto.
 Admitted.
 
 Lemma cell_share_join:
   forall (ls: listspec list_structid list_link list_token) ash bsh psh p v,
    sepalg.join ash bsh psh ->
-   list_cell ls ash v p * list_cell ls bsh v p = list_cell ls psh v p.
+   list_cell ls ash v p * list_cell ls bsh v p ⊣⊢ list_cell ls psh v p.
 Proof.
  intros.
  unfold list_cell.
  destruct (field_compatible_dec list_struct nil p);
     [ | solve [ apply pred_ext; normalize ]].
  normalize.
- f_equal.
  revert v; unfold elemtype.
  set (m := all_but_link list_fields).
  assert (PLAIN: plain_members m = true). {
@@ -1895,7 +1749,7 @@ Proof.
  }
  clearbody m.
  induction m; intros.
- simpl. rewrite emp_sepcon; auto.
+ simpl. apply bi.emp_sep.
  destruct a as [i t|]; [ | discriminate].
  assert (field_compatible (field_type i list_fields) nil
   (offset_val (field_offset cenv_cs i list_fields) p))
@@ -1903,7 +1757,7 @@ Proof.
  destruct m as [ | [i' t'|]]; [ | | discriminate].
  +
  clear IHm; simpl. rewrite !withspacer_spacer.
- rewrite <- sepcon_assoc.
+(* rewrite assoc.
  match goal with |- ?A * ?B * ?C * ?D = _ =>
     pull_left C; pull_left A
  end.
@@ -1931,7 +1785,7 @@ Proof.
  assert (isptr p) by (auto with field_compatible).
  destruct p; try inversion H1.
  apply data_at_rec_share_join; auto.
- apply IHm. auto.
+ apply IHm. auto.*)
 Admitted.
 
 Lemma join_cell_link (ls: listspec list_structid list_link list_token):
@@ -1939,7 +1793,7 @@ Lemma join_cell_link (ls: listspec list_structid list_link list_token):
    sepalg.join ash bsh psh ->
   ~ (readable_share ash) ->
     readable_share bsh ->
-   list_cell ls ash v' p * list_cell ls bsh v p = list_cell ls psh v p.
+   list_cell ls ash v' p * list_cell ls bsh v p ⊣⊢ list_cell ls psh v p.
  Proof.
  intros.
  rewrite (nonreadable_list_cell_eq _ _ v' v _ H0).
@@ -1972,16 +1826,11 @@ Proof.
 intros.
 rewrite (lseg_unfold ls dsh psh l v v).
 destruct l.
-f_equal. f_equal.
-apply prop_ext; split; intro; auto.
+f_equiv. f_equiv. apply prop_ext.
+split; intro; auto.
 normalize.
-apply pred_ext;
-apply derives_extract_prop; intro.
-destruct H0.
-contradiction H1.
-destruct v; inv H; try split; auto.
-unfold Ptrofs.cmpu. apply Ptrofs.eq_true.
-inv H0.
+rewrite !prop_false_andp; auto.
+rewrite ptr_eq_True; tauto.
 Qed.
 
 Definition lseg_cons (ls: listspec list_structid list_link list_token) dsh psh
@@ -1995,59 +1844,43 @@ Definition lseg_cons (ls: listspec list_structid list_link list_token) dsh psh
 
 Lemma lseg_unroll (ls: listspec list_structid list_link list_token): forall dsh psh l x z ,
     ~ (readable_share dsh) ->
-    lseg ls dsh psh l x z =
+    lseg ls dsh psh l x z ⊣⊢
       (!! (ptr_eq x z) && !! (l=nil) && emp) || lseg_cons ls dsh psh l x z.
 Proof.
 intros.
 rename H into NR.
 rewrite lseg_unfold at 1.
 apply pred_ext; destruct l.
-apply derives_extract_prop; intros.
+apply bi.pure_elim_l; intros.
 rewrite prop_true_andp by auto.
 rewrite prop_true_andp by auto.
-apply orp_right1; auto.
-apply orp_right2.
+apply bi.or_intro_l; auto.
+rewrite <- bi.or_intro_r.
 unfold lseg_cons.
-apply derives_extract_prop; intros.
+apply bi.pure_elim_l; intros.
 destruct H.
 subst x.
-apply exp_left; intro tail.
+apply bi.exist_elim; intro tail.
 rewrite (prop_true_andp (~ptr_eq v z)) by auto.
-apply exp_right with (vund ls).
-apply exp_right with l.
-apply exp_right with tail.
+Exists (vund ls) l tail.
+entailer!.
 normalize.
-  autorewrite with subst norm1 norm2; normalize.
-apply orp_left.
-rewrite andp_assoc;
-do 2 (apply derives_extract_prop; intro).
- rewrite prop_true_andp by auto. auto.
+apply bi.or_elim.
+apply bi.pure_elim_l; intros [].
+auto.
 unfold lseg_cons.
-apply derives_extract_prop; intros.
-apply exp_left; intro h.
-apply exp_left; intro r.
-apply exp_left; intro y.
-do 3 rewrite sepcon_andp_prop'.
-apply derives_extract_prop; intros [? ?].
+Intros h r y.
 inv H0.
-apply orp_left.
-rewrite andp_assoc;
-do 2 (apply derives_extract_prop; intro).
+apply bi.or_elim.
+rewrite <- bi.pure_and; apply bi.pure_elim_l; intros [].
 inv H0.
 unfold lseg_cons.
-apply derives_extract_prop; intros.
-apply exp_left; intro h.
-apply exp_left; intro r.
-apply exp_left; intro y.
-do 3 rewrite sepcon_andp_prop'.
-apply derives_extract_prop; intros [? ?].
+Intros h r y.
 symmetry in H0; inv H0.
  rewrite prop_true_andp by auto.
-apply exp_right with y.
-normalize.
-repeat (apply sepcon_derives; auto).
-clear - NR.
-apply derives_refl'; apply nonreadable_list_cell_eq; auto.
+Exists y.
+entailer!.
+rewrite nonreadable_list_cell_eq; auto.
 Qed.
 
 Lemma lseg_unroll_nonempty1 (ls: listspec list_structid list_link list_token):
@@ -2060,33 +1893,31 @@ Lemma lseg_unroll_nonempty1 (ls: listspec list_structid list_link list_token):
                    (valinject (nested_field_type list_struct (StructField list_link :: nil)) p) v1 *
                lseg ls dsh psh tail p v2)) ->
     P |-- lseg ls dsh psh (v1::tail) v1 v2.
-Proof. intros. rewrite lseg_unroll by auto. apply orp_right2. unfold lseg_cons.
+Proof. intros. rewrite lseg_unroll by auto. rewrite <- bi.or_intro_r. unfold lseg_cons.
   rewrite prop_true_andp by auto.
-  apply exp_right with h. apply exp_right with tail. apply exp_right with p.
+  Exists h tail p.
     rewrite prop_true_andp by auto.
- rewrite sepcon_assoc.
- eapply derives_trans; [ eassumption | ].
- apply sepcon_derives; auto.
+  rewrite H2; cancel.
 Qed.
 
 Lemma lseg_neq (ls: listspec list_structid list_link list_token):
   forall dsh psh s v v2,
     ~ (readable_share dsh) ->
     ptr_neq v v2 ->
-     lseg ls dsh psh s v v2 = lseg_cons ls dsh psh s v v2.
+     lseg ls dsh psh s v v2 ⊣⊢ lseg_cons ls dsh psh s v v2.
+Proof.
 intros. rewrite lseg_unroll by auto.
-apply pred_ext. apply orp_left; auto.
-rewrite andp_assoc.
-do 2 (apply derives_extract_prop; intro).
+apply pred_ext. apply bi.or_elim; auto.
+rewrite <- bi.pure_and; apply bi.pure_elim_l; intros [].
 congruence.
-apply orp_right2. auto.
+apply bi.or_intro_r.
 Qed.
 
 Lemma lseg_nonnull (ls: listspec list_structid list_link list_token):
   forall dsh psh s v,
     ~ (readable_share dsh) ->
       typed_true (tptr list_struct) v ->
-     lseg ls dsh psh s v nullval = lseg_cons ls dsh psh s v nullval.
+     lseg ls dsh psh s v nullval ⊣⊢ lseg_cons ls dsh psh s v nullval.
 Proof.
 intros. unfold nullval.
 apply lseg_neq; auto.
@@ -2114,35 +1945,29 @@ Lemma unfold_lseg_neq (ls: listspec list_structid list_link list_token):
         end.
 Proof.
 intros.
-apply derives_trans with
+trans
 (PROPx P (LOCALx (Q1::Q) (SEPx (lseg_cons ls dsh psh s v v2 :: R)))).
-apply derives_trans with
+trans
 (!! (ptr_neq v v2) && PROPx P (LOCALx (Q1::Q) (SEPx (lseg ls dsh psh s v v2 :: R)))).
-apply andp_right; auto.
-intro rho; unfold PROPx,LOCALx,SEPx,local,tc_expr,tc_lvalue; unfold_lift; simpl.
+apply bi.and_intro; auto.
+split => rho; unfold PROPx,LOCALx,SEPx,local,tc_expr,tc_lvalue; unfold_lift; simpl; monPred.unseal.
 unfold lift1; simpl.
- repeat (apply derives_extract_prop; intro).
+ repeat (apply bi.pure_elim_l; intro).
  rewrite prop_true_andp by auto.
  rewrite prop_true_andp by auto.
-apply sepcon_derives; auto.
+apply bi.sep_mono; auto.
 rewrite lseg_neq; auto.
-intro rho; unfold PROPx,LOCALx,SEPx,local,tc_expr,tc_lvalue,lift2,lift1,lift0; simpl.
+split => rho; unfold PROPx,LOCALx,SEPx,local,tc_expr,tc_lvalue,lift2,lift1,lift0; simpl; monPred.unseal.
  unfold_lift.
  unfold lseg_cons. simpl.
- apply derives_extract_prop; intro.
- apply derives_extract_prop; intros [? ?].
+ apply bi.pure_elim_l; intro.
+ apply bi.pure_elim_l; intros [? ?].
  rewrite sepcon_andp_prop'.
- apply derives_extract_prop; intro.
- rewrite exp_sepcon1; apply exp_left; intro h.
- rewrite exp_sepcon1; apply exp_left; intro r.
- rewrite exp_sepcon1; apply exp_left; intro y.
+ apply bi.pure_elim_l; intro.
+ Intros h r y.
  repeat rewrite sepcon_andp_prop'.
- apply derives_extract_prop; intros [? ?].
- subst.
- apply exp_right with (h,r,y, v).
- repeat rewrite prop_true_andp by auto.
- repeat rewrite sepcon_assoc.
- auto.
+ subst; simpl.
+ Exists (h, r, y, v); simpl; entailer!.
 Qed.
 
 Lemma unfold_lseg_cons (ls: listspec list_structid list_link list_token):
@@ -2163,8 +1988,7 @@ Lemma unfold_lseg_cons (ls: listspec list_structid list_link list_token):
         end.
 Proof.
 intros. apply unfold_lseg_neq; auto.
-eapply derives_trans.
-apply H0. normalize.
+rewrite H0. normalize.
 unfold local. super_unfold_lift.
 unfold nullval. destruct e; inv H1; try congruence; auto.
 intro. apply ptr_eq_e in H1.
@@ -2172,20 +1996,20 @@ destruct Archi.ptr64; inv H1.
 Qed.
 
 Lemma semax_lseg_neq (ls: listspec list_structid list_link list_token):
-  forall (Espec: OracleKind)
-      Delta P Q dsh psh s v v2 R c Post,
+  forall Espec
+      E Delta P Q dsh psh s v v2 R c Post,
     ~ (readable_share dsh) ->
     ~ (ptr_eq v v2) ->
   (forall (h: elemtype ls) (r: list val) (y: val),
     s=v::r -> is_pointer_or_null y ->
-    semax Delta
+    semax(OK_spec := Espec) E Delta
         (PROPx P (LOCALx Q
         (SEPx (list_token dsh v :: list_cell ls dsh h v ::
                   field_at psh list_struct (StructField list_link :: nil)
                       (valinject (nested_field_type list_struct (StructField list_link :: nil)) y) v ::
                   lseg ls dsh psh r y v2 ::
                   R)))) c Post) ->
-   semax Delta
+   semax E Delta
        (PROPx P (LOCALx Q (SEPx (lseg ls dsh psh s v v2 :: R))))
        c Post.
 Proof.
@@ -2203,9 +2027,7 @@ apply semax_pre0 with
         lseg ls dsh psh r y v2 :: R)))).
 go_lowerx; entailer.
 Exists h r y.
-rewrite <- ?sepcon_assoc.
-normalize.
-  autorewrite with subst norm1 norm2; normalize.
+entailer!.
 Intros h r y.
 apply semax_extract_prop; intros [? ?].
 eauto.
@@ -2213,27 +2035,27 @@ Qed.
 
 
 Lemma semax_lseg_nonnull (ls: listspec list_structid list_link list_token):
-  forall (Espec: OracleKind)
-      Delta P Q dsh psh s v R c Post,
+  forall Espec
+      E Delta P Q dsh psh s v R c Post,
     ~ (readable_share dsh) ->
    ENTAIL Delta, PROPx P (LOCALx Q
             (SEPx (lseg ls dsh psh s v nullval :: R))) |--
                         !!(typed_true (tptr list_struct) v)  ->
   (forall (h: elemtype ls) (r: list val) (y: val),
     s=v::r -> is_pointer_or_null y ->
-    semax Delta
+    semax(OK_spec := Espec) E Delta
         (PROPx P (LOCALx Q
         (SEPx (list_token dsh v :: list_cell ls dsh h v ::
                   field_at psh list_struct (StructField list_link :: nil) (valinject (nested_field_type list_struct (StructField list_link :: nil)) y) v ::
                   lseg ls dsh psh r y nullval ::
                   R)))) c Post) ->
-   semax Delta
+   semax E Delta
        (PROPx P (LOCALx Q (SEPx (lseg ls dsh psh s v nullval :: R))))
        c Post.
 Proof.
 intros.
 assert_PROP (~ ptr_eq v nullval).
-eapply derives_trans; [eapply H0 |].
+rewrite H0.
 normalize.
 apply semax_lseg_neq; auto.
 Qed.
@@ -2248,7 +2070,7 @@ Qed.
 Lemma lseg_cons_eq (ls: listspec list_structid list_link list_token):
      forall dsh psh h r x z ,
      ~ (readable_share dsh) ->
-    lseg ls dsh psh (h::r) x z =
+    lseg ls dsh psh (h::r) x z ⊣⊢
         !!(x = h /\ ~ ptr_eq x z) &&
          (EX  y : val,
           !!(is_pointer_or_null y) &&
@@ -2257,25 +2079,19 @@ Lemma lseg_cons_eq (ls: listspec list_structid list_link list_token):
 Proof.
  intros. rewrite lseg_unroll by auto.
  apply pred_ext.
- apply orp_left.
- rewrite andp_assoc.
- apply derives_extract_prop; intro.
- apply derives_extract_prop; intro.
+ apply bi.or_elim.
+ Intros.
  inv H1.
  unfold lseg_cons.
- normalize.
+ Intros h0 r0 y.
  symmetry in H1; inv H1.
- apply exp_right with y. normalize.
-  autorewrite with subst norm1 norm2; normalize.
- repeat (apply sepcon_derives; auto).
- apply derives_refl'; apply nonreadable_list_cell_eq; auto.
- apply orp_right2.
- normalize.
+ Exists y; entailer!.
+ rewrite nonreadable_list_cell_eq; auto.
+ rewrite <- bi.or_intro_r.
+ Intros y.
  unfold lseg_cons.
  rewrite prop_true_andp by auto.
- apply exp_right with (vund ls). apply exp_right with r.  apply exp_right with y.
- normalize.
-  autorewrite with subst norm1 norm2; normalize.
+ Exists (vund ls) r y; entailer!.
 Qed.
 
 Definition lseg_cons_right (ls: listspec list_structid list_link list_token)
@@ -2299,34 +2115,22 @@ intros. rename H into SH. rename H0 into NR.
 assert (SZ: 0 < sizeof (nested_field_type list_struct (DOT list_link)))
   by (rewrite list_link_type; unfold sizeof; simpl; destruct Archi.ptr64; computable).
 rewrite (field_at_isptr _ _ _ _ z).
-normalize.
+Intros.
 revert x; induction l; simpl; intros.
 *
 unfold lseg.
 simpl.
-normalize.
-  autorewrite with subst norm1 norm2; normalize.
-apply exp_right with z.
-entailer.
- apply derives_refl';  f_equal. f_equal. f_equal.
- apply (nonreadable_list_cell_eq); auto.
+Intros; subst.
+Exists z.
+entailer!.
+rewrite (nonreadable_list_cell_eq); auto.
 *
 unfold lseg; simpl.
-normalize.
-apply exp_right with x0.
-rewrite <- ?sepcon_assoc.
-normalize.
-  autorewrite with subst norm1 norm2; normalize.
-specialize (IHl x0).
-entailer.
-pull_right (list_token dsh x); pull_right (list_cell ls dsh (vund ls) x).
-apply sepcon_derives; auto.
-apply sepcon_derives; auto.
-pull_right (field_at psh list_struct (StructField list_link :: nil)
-      (valinject
-         (nested_field_type list_struct (StructField list_link :: nil)) x0)
-      x).
-apply sepcon_derives; auto.
+Intros x0; Exists x0.
+iIntros "((H & ? & lseg) & Hz)".
+iDestruct (IHl with "[$H $Hz $lseg]") as "?".
+iStopProof; entailer!.
+auto.
 Qed.
 
 Lemma lseg_cons_right_null (ls: listspec list_structid list_link list_token): forall dsh psh l x h y,
@@ -2339,36 +2143,15 @@ intros. rename H into NR.
 unfold lseg.
 revert x; induction l; simpl; intros.
 *
-normalize.
-  autorewrite with subst norm1 norm2; normalize.
-apply exp_right with nullval.
-apply andp_right.
-apply not_prop_right; intro.
-apply ptr_eq_e in H. subst y.
-entailer!.
-destruct H. contradiction H.
-rewrite prop_true_andp by reflexivity.
-rewrite prop_true_andp by apply ptr_eq_nullval.
-normalize.
-apply derives_refl'; f_equal. f_equal.
-apply nonreadable_list_cell_eq; auto.
+Intros.
+Exists nullval; entailer!.
+rewrite nonreadable_list_cell_eq; auto.
 *
-normalize.
-apply exp_right with x0.
-normalize.
-  autorewrite with subst norm1 norm2; normalize.
-specialize (IHl x0).
-apply andp_right.
-rewrite prop_and.
-apply andp_right; [ | apply prop_right; auto].
-apply not_prop_right; intro.
-apply ptr_eq_e in H0. subst x.
-entailer.
-destruct H2; contradiction H2.
-eapply derives_trans.
-2: apply sepcon_derives; [ | eassumption]; apply derives_refl.
-clear IHl.
-cancel.
+Intros x0.
+Exists x0.
+iIntros "(H & ? & lseg)".
+iDestruct (IHl with "[$H $lseg]") as "$".
+iStopProof; entailer!.
 Qed.
 
 
@@ -2383,23 +2166,19 @@ Proof.
 intros.
 destruct l'.
 rewrite lseg_nil_eq.
-normalize.
+Intros; subst.
 rewrite prop_true_andp by apply ptr_eq_nullval.
-apply lseg_cons_right_null; auto.
+rewrite lseg_cons_right_null; auto.
 rewrite lseg_cons_eq; auto.
 Intros u. Exists u. subst.
 rewrite !prop_true_andp by auto.
-rewrite <- !sepcon_assoc.
-apply sepcon_derives; auto.
-pull_right (list_cell ls dsh (vund ls) v).
-apply sepcon_derives; auto.
-pull_right (list_token dsh v).
-apply sepcon_derives; auto.
-apply lseg_cons_right_neq; auto.
+iIntros "(H & ((? & ?) & Hv) & ?)".
+iDestruct (lseg_cons_right_neq with "[$H $Hv]") as "?"; auto.
+iStopProof; cancel.
 Qed.
 
 Lemma lseg_unroll_right (ls: listspec list_structid list_link list_token): forall sh sh' l x z ,
-    lseg ls sh sh' l x z = (!! (ptr_eq x z) && !! (l=nil) && emp) || lseg_cons_right ls sh sh' l x z.
+    lseg ls sh sh' l x z ⊣⊢ (!! (ptr_eq x z) && !! (l=nil) && emp) || lseg_cons_right ls sh sh' l x z.
 Abort.  (* not likely true *)
 
 Lemma lseg_local_facts:
@@ -2410,32 +2189,30 @@ Proof.
 intros.
 rewrite lseg_unfold.
 destruct contents.
-apply derives_extract_prop; intro.
+apply bi.pure_elim_l; intro.
 unfold ptr_eq in H.
-apply prop_right.
+apply bi.pure_intro.
 destruct p; try contradiction; simpl; auto.
 destruct q; try contradiction; auto.
-destruct H as [? [? ?]]. rewrite H.
-unfold Int.cmpu in *.
+unfold Int.cmpu in H.
+destruct H as [? [? ?]].
 apply int_eq_e in H0.
 apply int_eq_e in H1. subst.
 split; auto; split; auto.
 destruct q; try contradiction; auto.
-destruct H as [? [? ?]]. rewrite H.
-unfold Int64.cmpu in *.
+unfold Int64.cmpu in H.
+destruct H as [? [? ?]].
 apply int64_eq_e in H0.
 apply int64_eq_e in H1. subst.
-split; auto; split; auto.
-destruct q; try contradiction; auto.
+split3; auto; done.
+destruct q; try contradiction.
 destruct H; subst.
-unfold Ptrofs.cmpu in *.
-apply ptrofs_eq_e in H0. subst.
-intuition.
+unfold Ptrofs.cmpu in H0.
+apply ptrofs_eq_e in H0.
+subst. tauto.
 normalize.
 rewrite field_at_isptr.
-normalize.
-  autorewrite with subst norm1 norm2; normalize.
-apply prop_right.
+Intros; entailer!.
 split. intro; subst q.
 contradiction H. normalize.
 intros. discriminate.
@@ -2450,17 +2227,15 @@ Lemma lseg_cons_eq2: forall
   (ls : listspec list_structid list_link list_token) (dsh psh : share) (h : elemtype ls)
    (r : list val )  (x z : val),
      ~ (readable_share dsh) ->
-  lseg ls dsh psh (x :: r) x z =
+  lseg ls dsh psh (x :: r) x z ⊣⊢
   !!(~ ptr_eq x z) && (EX  y : val, lseg_cell ls dsh psh h x y * lseg ls dsh psh r y z).
 Proof.
   intros.
   rewrite -> lseg_cons_eq by auto.
   unfold lseg_cell.
  normalize.
-  autorewrite with subst norm1 norm2; normalize.
- f_equal. extensionality y.
- f_equal. f_equal. f_equal. f_equal.
- apply nonreadable_list_cell_eq; auto.
+ f_equiv. intros y.
+ f_equiv. f_equiv. tauto. rewrite nonreadable_list_cell_eq; done.
 Qed.
 
 Lemma list_append: forall {dsh psh: share}
@@ -2475,33 +2250,20 @@ Proof.
 *
  normalize.
 *
- normalize.
- progress (autorewrite with subst norm1 norm2); normalize.
- apply exp_right with y.
- apply andp_right.
+ Intros y.
+ Exists y.
+ apply bi.and_intro.
  +
-  apply not_prop_right; intro. apply ptr_eq_e in H1; subst hd.
+  destruct (eq_dec hd tl); [|entailer!].
+  subst.
   clear IHct1.
   specialize (H y).
   unfold lseg_cell in H.
-  rewrite prop_true_andp in H by auto.
-  change (LsegGeneral.lseg ls dsh psh (map (fun v : val => (v, vund ls)) ct1))
-    with (lseg ls dsh psh ct1).
-  change (LsegGeneral.lseg ls dsh psh (map (fun v : val => (v, vund ls)) ct2))
-    with (lseg ls dsh psh ct2).
-  apply derives_trans with
-        (lseg ls dsh psh ct1 y mid * lseg ls dsh psh ct2 mid tl * FF).
-  cancel. auto.
-  rewrite sepcon_FF; auto.
+  iIntros "(((H & ?) & ?) & P)"; iDestruct (H with "[H $P]") as "[]".
+  iStopProof; entailer!.
  +
-  normalize.
-  specialize (IHct1 y). clear H.
-   do 2 rewrite sepcon_assoc.
-  eapply derives_trans.
- apply sepcon_derives.
-  apply derives_refl.
-  rewrite <- !sepcon_assoc; eassumption.
-  cancel.
+  go_lower.sep_apply IHct1.
+  entailer!.
 Qed.
 
 Lemma list_append_null:
@@ -2513,9 +2275,9 @@ Lemma list_append_null:
    lseg ls dsh psh (ct1++ct2) hd nullval.
 Proof.
 intros.
- rewrite <- sepcon_emp.
- eapply derives_trans; [ | apply (list_append hd mid nullval ct1 ct2 (fun _ => emp))].
- normalize.
+ rewrite <- bi.sep_emp.
+ rewrite (list_append _ _ _ _ _ (fun _ => emp)).
+ iIntros "($ & _)".
  intros.
   unfold lseg_cell. simpl. saturate_local. destruct H. contradiction H.
 Qed.
@@ -2532,19 +2294,17 @@ Proof.
   intros ? ? ? ? ? NON_ID ? ?.
  destruct H as [bsh ?].
  rewrite <- (field_at__share_join _ _ _ _ _ _ H).
- rewrite <- sepcon_assoc.
- rewrite list_cell_link_join_nospacer; auto.
- apply sepcon_valid_pointer1.
+ iIntros "(c & f & _)".
+ iCombine "c f" as "d"; rewrite list_cell_link_join_nospacer; auto.
  unfold data_at_, field_at_, data_at.
- eapply derives_trans; [ apply field_at_valid_ptr; auto | ].
- change (nested_field_type list_struct nil) with list_struct.
- apply LsegGeneral.sizeof_list_struct_pos.
+ iStopProof.
+ saturate_local.
+ rewrite field_at_valid_ptr; auto.
+ 2: { change (nested_field_type list_struct nil) with list_struct.
+      apply LsegGeneral.sizeof_list_struct_pos. }
  unfold field_address.
  if_tac; auto.
- change (Int.repr (nested_field_offset list_struct nil)) with Int.zero.
-  rewrite valid_pointer_offset_val_zero; auto.
- simpl.
- change predicates_hered.FF with FF. apply FF_left.
+ contradiction.
 Qed.
 
 Lemma list_cell_valid_pointerx:
@@ -2569,25 +2329,19 @@ Lemma lseg_valid_pointer:
 Proof.
 intros.
 destruct contents.
-rewrite lseg_nil_eq. normalize.
+rewrite lseg_nil_eq, H3. entailer!.
 unfold lseg; simpl.
-normalize.
-apply sepcon_valid_pointer2.
-rewrite !sepcon_assoc.
-apply sepcon_valid_pointer2.
-rewrite <- !sepcon_assoc.
-apply sepcon_valid_pointer1.
-eapply derives_trans with
-  (list_cell ls dsh (vund  ls) p * field_at_ psh list_struct (StructField list_link :: nil) p).
-cancel.
-apply list_cell_valid_pointer; auto.
+Intros y.
+iIntros "(? & ((? & cell) & Hp) & ?)".
+iPoseProof (list_cell_valid_pointer with "[$cell Hp]") as "?"; eauto.
+iStopProof; cancel.
 Qed.
 
 End LIST2.
 
 Lemma join_sub_Tsh:
   forall sh, sepalg.join_sub sh Tsh.
-Admitted. (* easy *)
+Proof. apply top_correct'. Qed.
 #[export] Hint Resolve join_sub_Tsh: valid_pointer.
 
 #[export] Hint Rewrite @lseg_nil_eq : norm.
@@ -2602,10 +2356,10 @@ Ltac resolve_lseg_valid_pointer :=
 match goal with
  | |- ?Q |-- valid_pointer ?p =>
    match Q with context [lseg ?A ?B ?C ?D p ?q] =>
-   repeat rewrite <- sepcon_assoc;
    pull_right (lseg A B C D p q);
+   repeat rewrite sep_assoc;
    apply lseg_valid_pointer; [auto | | | reflexivity | ];
-   auto 50 with valid_pointer
+   auto 50 with nocore valid_pointer
    end
  end.
 
@@ -2616,12 +2370,12 @@ Ltac resolve_list_cell_valid_pointer :=
  match goal with |- ?A |-- valid_pointer ?p =>
   match A with context [@list_cell ?cs ?sid ?lid ?tok ?LS ?dsh ?v p] =>
    match A with context [field_at ?psh ?t (StructField lid::nil) ?v' p] =>
-    apply derives_trans with
-      (@list_cell cs sid lid tok LS dsh v p *
-      field_at_ psh t (StructField lid::nil) p * TT);
+    trans
+      ((@list_cell cs sid lid tok LS dsh v p *
+      field_at_ psh t (StructField lid::nil) p) * TT);
       [cancel
       | apply sepcon_valid_pointer1;
-        apply list_cell_valid_pointer; [auto | | reflexivity]; auto with valid_pointer]
+        apply list_cell_valid_pointer; [auto | | reflexivity]; auto with nocore valid_pointer]
    end
   end
  end.
@@ -2632,4 +2386,3 @@ Ltac resolve_list_cell_valid_pointer :=
 End Links.
 
 Arguments elemtype {cs} {list_structid} {list_link} {list_token} ls / .
-
diff --git a/progs/os_combine.v b/progs/os_combine.v
index 631f81b75e..4559b360bb 100644
--- a/progs/os_combine.v
+++ b/progs/os_combine.v
@@ -2,38 +2,36 @@ Require Import VST.floyd.proofauto.
 Require Import VST.sepcomp.extspec.
 Require Import VST.veric.semax_ext.
 Require Import VST.veric.juicy_mem.
-Require Import VST.veric.compcert_rmaps.
 Require Import VST.veric.initial_world.
-Require Import VST.veric.ghost_PCM.
 Require Import VST.veric.SequentialClight.
 Require Import VST.veric.Clight_core.
 Require Import VST.concurrency.conclib.
 Require Import VST.sepcomp.semantics.
 Require Import ITree.ITree.
-(* Import ITreeNotations. *) (* one piece conflicts with subp notation *)
 Notation "t1 >>= k2" := (ITree.bind t1 k2)
   (at level 50, left associativity) : itree_scope.
 Notation "x <- t1 ;; t2" := (ITree.bind t1 (fun x => t2))
   (at level 100, t1 at next level, right associativity) : itree_scope.
 Notation "t1 ;; t2" := (ITree.bind t1 (fun _ => t2))
-  (at level 100, right associativity) : itree_scope.
+  (at level 100, t2 at level 200, right associativity) : itree_scope.
 Notation "' p <- t1 ;; t2" :=
   (ITree.bind t1 (fun x_ => match x_ with p => t2 end))
 (at level 100, t1 at next level, p pattern, right associativity) : itree_scope.
 Require Import ITree.Interp.Traces.
 Require Import Ensembles.
 
+Arguments In {_} _ _.
+
 Section ext_trace.
 
-  Context {event : Type -> Type} {J : juicy_ext_spec (itree event unit)} {OS_state : Type}.
+  Context {event : Type -> Type} {OS_state : Type}.
   Variable prog : Clight.program.
   Variable ext_sem : external_function -> list val -> OS_state -> option (OS_state * option val * @trace event unit).
   Variable inj_mem : external_function -> list val -> mem -> @trace event unit -> OS_state -> Prop.
   Variable extr_mem : external_function -> list val -> mem -> OS_state -> mem.
   Variable OS_valid : OS_state -> Prop.
   Notation ge := (globalenv prog).
-
-  Instance Espec : OracleKind := Build_OracleKind (itree event unit) J.
+  Notation OK_ty := (itree event unit).
 
   (* For any trace that the new itree (z) allows, that trace prefixed with the
      OS-generated trace (t) is allowed by the old itree (z0). *)
@@ -59,8 +57,10 @@ Section ext_trace.
     rewrite app_trace_assoc; auto.
   Qed.
 
-  Inductive ext_safeN_trace : nat -> @trace event unit -> Ensemble (@trace event unit) -> OK_ty -> CC_core -> mem -> Prop :=
-  | ext_safeN_trace_0: forall z t c m, ext_safeN_trace O t (Singleton TEnd) z c m
+  
+
+  Inductive ext_safeN_trace : nat -> @trace event unit -> Ensemble (@trace event unit) -> itree event unit -> CC_core -> mem -> Prop :=
+  | ext_safeN_trace_0: forall z t c m, ext_safeN_trace O t (Singleton _ TEnd) z c m
   | ext_safeN_trace_step:
       forall n t traces z c m c' m',
       cl_step ge c m c' m' ->
@@ -90,9 +90,9 @@ Section ext_trace.
       ext_safeN_trace (S n) t traces z c m
   | ext_safeN_trace_halted: forall n z t c m i,
       halted (cl_core_sem ge) c i ->
-      ext_safeN_trace n t (Singleton TEnd) z c m.
+      ext_safeN_trace n t (Singleton _ TEnd) z c m.
 
-  Variable dryspec : ext_spec OK_ty.
+  Variable dryspec : ext_spec (itree event unit).
   Hypothesis extcalls_correct : forall e w b tl args z m t s, ext_spec_pre dryspec e w b tl args z m ->
     inj_mem e args m t s ->
     forall s' ret t', Some (s', ret, t') = ext_sem e args s ->
@@ -101,7 +101,7 @@ Section ext_trace.
 
 
   Lemma dry_safe_ext_trace_safe : forall n t z q m,
-    step_lemmas.dry_safeN(genv_symb := semax.genv_symb_injective)
+    step_lemmas.dry_safeN(genv_symb := lifting.genv_symb_injective)
      (cl_core_sem (globalenv prog)) dryspec
      (Build_genv (Genv.globalenv prog) (prog_comp_env prog)) n z q m ->
     exists traces, ext_safeN_trace n t traces z q m.
@@ -125,32 +125,24 @@ Section ext_trace.
     - eexists; econstructor; eauto.
   Qed.
 
+  Variable Espec : forall `{!VSTGS OK_ty Σ}, ext_spec (itree event unit).
+  Hypothesis Hdry : forall `{!VSTGS OK_ty Σ}, ext_spec_entails Espec dryspec.
+
   Lemma safety_trace:
-   forall {CS: compspecs} (initial_oracle: OK_ty)
-     (EXIT: semax_prog.postcondition_allows_exit Espec tint)
-     (Jsub: forall ef se lv m t v m' (EFI : ef_inline ef = true) m1
-       (EFC : Events.external_call ef se lv m t v m'), mem_sub m m1 ->
-       exists m1' (EFC1 : Events.external_call ef se lv m1 t v m1'),
-         mem_sub m' m1' /\ proj1_sig (inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC1) =
-         proj1_sig (inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC))
-     (Jframe: extspec_frame OK_spec)
-     (dessicate : forall (ef : external_function) jm,
-               ext_spec_type OK_spec ef ->
-               ext_spec_type dryspec ef)
-     (JDE: juicy_dry_ext_spec _ (@JE_spec OK_ty OK_spec) dryspec dessicate)
-     (DME: ext_spec_mem_evolve _ dryspec)
-     (Esub: forall v z m m', ext_spec_exit dryspec v z m -> mem_sub m m' -> ext_spec_exit dryspec v z m')
-     V G m,
-     @semax_prog Espec CS prog initial_oracle V G ->
+    forall Σ {CS: compspecs} `{!VSTGpreS OK_ty Σ} (initial_oracle: OK_ty)
+     (EXIT: forall `{!VSTGS OK_ty Σ}, semax_prog.postcondition_allows_exit Espec tint)
+     V (G : forall `{!VSTGS OK_ty Σ}, funspecs) m,
+     (forall {HH : VSTGS OK_ty Σ}, semax_prog(OK_spec := Espec) prog initial_oracle V G) ->
      Genv.init_mem prog = Some m ->
      exists b, exists q,
        Genv.find_symbol (Genv.globalenv prog) (prog_main prog) = Some b /\
-       initial_core  (cl_core_sem (globalenv prog))
+       semantics.initial_core (cl_core_sem (globalenv prog))
            0 m q m (Vptr b Ptrofs.zero) nil /\
        forall n, exists traces, ext_safeN_trace n TEnd traces initial_oracle q m.
   Proof.
     intros.
-    eapply CSHL_Sound.semax_prog_sound, whole_program_sequential_safety_ext in H as (b & q & ? & ? & Hsafe); eauto.
+    eapply whole_program_sequential_safety_ext in EXIT as (b & q & ? & ? & Hsafe); eauto.
+    2: { intros; eexists; apply CSHL_Sound.semax_prog_sound, H. }
     do 3 eexists; eauto; split; eauto; intros n.
     eapply dry_safe_ext_trace_safe; eauto.
   Qed.
@@ -173,26 +165,14 @@ Section ext_trace.
   Qed.
 
   Theorem OS_soundness:
-   forall {CS: compspecs} (initial_oracle: OK_ty)
-     (EXIT: semax_prog.postcondition_allows_exit Espec tint)
-     (Jsub: forall ef se lv m t v m' (EFI : ef_inline ef = true) m1
-       (EFC : Events.external_call ef se lv m t v m'), mem_sub m m1 ->
-       exists m1' (EFC1 : Events.external_call ef se lv m1 t v m1'),
-         mem_sub m' m1' /\ proj1_sig (inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC1) =
-         proj1_sig (inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC))
-     (Jframe: extspec_frame OK_spec)
-     (dessicate : forall (ef : external_function) jm,
-               ext_spec_type OK_spec ef ->
-               ext_spec_type dryspec ef)
-     (JDE: juicy_dry_ext_spec _ (@JE_spec OK_ty OK_spec) dryspec dessicate)
-     (DME: ext_spec_mem_evolve _ dryspec)
-     (Esub: forall v z m m', ext_spec_exit dryspec v z m -> mem_sub m m' -> ext_spec_exit dryspec v z m')
-     V G m,
-     @semax_prog Espec CS prog initial_oracle V G ->
+    forall Σ {CS: compspecs} `{!VSTGpreS OK_ty Σ} (initial_oracle: OK_ty)
+     (EXIT: forall `{!VSTGS OK_ty Σ}, semax_prog.postcondition_allows_exit Espec tint)
+     V (G : forall `{!VSTGS OK_ty Σ}, funspecs) m,
+     (forall {HH : VSTGS OK_ty Σ}, semax_prog(OK_spec := Espec) prog initial_oracle V G) ->
      Genv.init_mem prog = Some m ->
      exists b, exists q,
        Genv.find_symbol (Genv.globalenv prog) (prog_main prog) = Some b /\
-       initial_core  (cl_core_sem (globalenv prog))
+       semantics.initial_core (cl_core_sem (globalenv prog))
            0 m q m (Vptr b Ptrofs.zero) nil /\
        forall n, exists traces, ext_safeN_trace n TEnd traces initial_oracle q m /\
          forall t, In traces t -> exists z', consume_trace initial_oracle z' t.
diff --git a/progs/tutorial1.v b/progs/tutorial1.v
index 059e0f4167..2ac2fd95bd 100644
--- a/progs/tutorial1.v
+++ b/progs/tutorial1.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.sumarray.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs.  mk_varspecs prog. Defined.
@@ -79,9 +80,9 @@ intros.
 simpl.
 (* It's not nice that [simpl] unfolded the list_repeat. *)
 entailer!.
-repeat rewrite Zlength_cons. rewrite Zlength_nil. 
+repeat rewrite Zlength_cons. rewrite Zlength_nil.
 rep_lia.
-Abort.
+Qed.
 
 (* To avoid unfolding of the list_repeat, let us make N opaque. *)
 
diff --git a/progs/verif_append.v b/progs/verif_append.v
index 5fe883bc5c..7df1bbfac7 100644
--- a/progs/verif_append.v
+++ b/progs/verif_append.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.list_dt. Import LsegSpecial.
 Require Import VST.progs.append.
 
@@ -31,18 +32,13 @@ Definition append_spec :=
 
 Definition Gprog : funspecs :=   ltac:(with_library prog [ append_spec ]).
 
-Lemma ENTAIL_refl: forall Delta P, ENTAIL Delta, P |-- P.
-Proof. intros; apply andp_left2; auto. Qed.
-
 Lemma body_append: semax_body Vprog Gprog f_append append_spec.
 Proof.
 start_function.
 forward_if.
 *
  forward.
- Exists y.
- simpl app.
- entailer!!.
+ Exists y; simpl; entailer!!.
 *
  forward.
  apply semax_lseg_nonnull; [ | intros a s3 u ? ?].
@@ -63,10 +59,9 @@ forward_if.
  + entailer!!.
  + clear u H1; rename u0 into u. clear a s3 H0. rename a0 into a.
    gather_SEP (list_cell _ _ _ _) (field_at _ _ _ _ _) (lseg _ _ _ x _) (lseg _ _ _ u _).
-   replace_SEP 0 (lseg LS sh (s1a++[a]) x u * lseg LS sh s1b u nullval)%logic.
+   replace_SEP 0 (lseg LS sh (s1a++[a]) x u * lseg LS sh s1b u nullval).
    entailer.
-   rewrite <- (emp_sepcon (list_cell LS sh a t)).
-   apply (lseg_cons_right_list LS); auto.
+   rewrite <- lseg_cons_right_list; first cancel; auto.
    Intros. gather_SEP (lseg _ _ _ u _).
    apply semax_lseg_nonnull; [ | intros a1 s4 u2 ? ?].
    entailer!.
@@ -82,7 +77,7 @@ forward_if.
     forward.
     forward.
     Exists x. entailer!!.
-    apply derives_trans with (lseg LS sh (s1a++[a0]) x y * lseg LS sh s2 y nullval)%logic.
+    apply derives_trans with (lseg LS sh (s1a++[a0]) x y * lseg LS sh s2 y nullval).
     eapply derives_trans; [ | apply (lseg_cons_right_list LS) with (y:=t)]; auto.
     simpl valinject.
     cancel.
diff --git a/progs/verif_append2.v b/progs/verif_append2.v
index f696ea2194..e9d0feabcb 100644
--- a/progs/verif_append2.v
+++ b/progs/verif_append2.v
@@ -5,54 +5,68 @@ Require Import VST.progs.append.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 Definition t_struct_list := Tstruct _list noattr.
 
+Lemma not_bot_nonidentity : forall sh,  sh <> Share.bot -> sepalg.nonidentity sh.
+Proof.
+   intros.
+   unfold sepalg.nonidentity. unfold not.
+   intros. apply identity_share_bot in H0. contradiction.
+Qed.
+Lemma nonidentity_not_bot : forall sh, sepalg.nonidentity sh -> sh <> Share.bot.
+Proof.
+   intros. unfold sepalg.nonidentity. unfold not. intros. apply H. rewrite H0. apply bot_identity.    
+Qed.
+#[export] Hint Resolve not_bot_nonidentity : core.
+#[export] Hint Resolve nonidentity_not_bot : core.
+
+Section Spec.
+
+Context  `{!default_VSTGS Σ}.
 
 Fixpoint listrep (sh: share)
             (contents: list val) (x: val) : mpred :=
  match contents with
  | h::hs =>
-              EX y:val,
-                data_at sh t_struct_list (h,y) x * listrep sh hs y
- | nil => !! (x = nullval) && emp
+              ∃ y:val,
+                data_at sh t_struct_list (h,y) x ∗ listrep sh hs y
+ | nil => ⌜x = nullval⌝ ∧ emp
  end.
 
 Arguments listrep sh contents x : simpl never.
 
 Lemma listrep_local_facts:
   forall sh contents p,
-     listrep sh contents p |--
-     !! (is_pointer_or_null p /\ (p=nullval <-> contents=nil)).
+     listrep sh contents p ⊢
+     ⌜is_pointer_or_null p ∧ (p=nullval <-> contents=nil)⌝.
 Proof.
 intros.
 revert p; induction contents; 
-  unfold listrep; fold listrep; intros. entailer!. intuition.
+  unfold listrep; fold listrep; intros. entailer!. tauto.
 Intros y. entailer!.
 split; intro. subst p. destruct H; contradiction. inv H2.
 Qed.
 
-#[export] Hint Resolve listrep_local_facts : saturate_local.
+
 
 Lemma listrep_valid_pointer:
   forall sh contents p,
-   sepalg.nonidentity sh ->
-   listrep sh contents p |-- valid_pointer p.
+  sepalg.nonidentity sh ->
+   listrep sh contents p ⊢ valid_pointer p.
 Proof.
  destruct contents; unfold listrep; fold listrep; intros; Intros; subst.
  auto with valid_pointer.
  Intros y.
  apply sepcon_valid_pointer1.
  apply data_at_valid_ptr; auto.
- simpl;  computable.
+ simpl; computable.
 Qed.
 
-#[export] Hint Resolve listrep_valid_pointer : valid_pointer.
-
 Lemma listrep_null: forall sh contents,
-    listrep sh contents nullval = !! (contents=nil) && emp.
+    listrep sh contents nullval ⊣⊢ ⌜contents=nil⌝ ∧ emp.
 Proof.
 destruct contents; unfold listrep; fold listrep.
 autorewrite with norm. auto.
-apply pred_ext.
-Intros y. entailer. destruct H; contradiction.
+apply bi.equiv_entails_2.
+Intros y. entailer!. destruct H; contradiction.
 Intros. discriminate.
 Qed.
 
@@ -72,46 +86,48 @@ Definition append_spec :=
      PARAMS (x; y) GLOBALS()
      SEP (listrep sh s1 x; listrep sh s2 y)
   POST [ tptr t_struct_list ]
-    EX r: val,
+    ∃ r: val,
      PROP()
      RETURN (r)
      SEP (listrep sh (s1++s2) r).
 
 Definition Gprog : funspecs :=   ltac:(with_library prog [ append_spec ]).
 
-Module Proof1.
+Hint Resolve listrep_local_facts : saturate_local.
+Hint Extern 1 (listrep _ _ _ ⊢ valid_pointer _) =>
+    (simple apply listrep_valid_pointer; now auto) : valid_pointer.
 
-Definition lseg (sh: share) (contents: list val) (x z: val) : mpred :=
-  ALL cts2:list val, listrep sh cts2 z -* listrep sh (contents++cts2) x.
+Section Proof1.
 
 Lemma body_append: semax_body Vprog Gprog f_append append_spec.
 Proof.
 start_function.
 forward_if.
 *
- subst x. rewrite listrep_null.  Intros.  subst.
+ subst x.
  forward.
+ rewrite listrep_null. Intros; subst.
  Exists y.
  entailer!!.
  simpl; auto.
 *
  forward.
  destruct s1 as [ | v s1']; unfold listrep at 1; fold listrep.
- Intros.  contradiction.
+ { Intros. contradiction. }
  Intros u.
  remember (v::s1') as s1.
  forward.
  forward_while
-      ( EX a: val, EX s1b: list val, EX t: val, EX u: val,
+      (∃ a: val, ∃ s1b: list val, ∃ t: val, ∃ u: val,
             PROP ()
             LOCAL (temp _x x; temp _t t; temp _u u; temp _y y)
-            SEP (listrep sh (a::s1b++s2) t -* listrep sh (s1++s2) x;
+            SEP (listrep sh (a::s1b++s2) t -∗ listrep sh (s1++s2) x;
                    data_at sh t_struct_list (a,u) t;
                    listrep sh s1b u;
                    listrep sh s2 y))%assert.
 + (* current assertion implies loop invariant *)
    Exists v s1' x u.
-   subst s1. entailer!!. simpl. cancel_wand.
+   entailer!. simpl. cancel_wand.
 + (* loop test is safe to execute *)
    entailer!!.
 + (* loop body preserves invariant *)
@@ -123,14 +139,13 @@ forward_if.
    Exists (v,s1b,u0,z). unfold fst, snd.
    simpl app.
    entailer!!.
-   rewrite sepcon_comm.
-   apply RAMIF_PLAIN.trans''.
-   apply wand_sepcon_adjoint.
-   forget (v::s1b++s2) as s3.
-   unfold listrep; fold listrep; Exists u0; auto.
+   iIntros "[Ha Hb]". iIntros.
+   iApply "Ha".
+   unfold listrep; fold listrep. iExists u0; iFrame.
 + (* after the loop *)
    clear v s1' Heqs1.
    forward.
+   simpl. (* TODO this simpl wasn't needed. maybe store_tac_no_hint in forward1 is broken? *)
    forward.
    rewrite (proj1 H2 (eq_refl _)).
    Exists x.
@@ -138,28 +153,26 @@ forward_if.
    clear.
    entailer!!.
    unfold listrep at 3; fold listrep. Intros.
-   pull_right (listrep sh (a :: s2) t -* listrep sh (s1 ++ s2) x).
-   apply modus_ponens_wand'.
-   unfold listrep at 2; fold listrep. Exists y; cancel.
+   iIntros "(Ha & Hb & Hc & Hd)".
+   iApply "Ha".
+   unfold listrep at -1; fold listrep. iExists y; iFrame.
 Qed.
 
 End Proof1.
 
-Module Proof2.
+Section Proof2.
 
 Definition lseg (sh: share) (contents: list val) (x z: val) : mpred :=
-  ALL cts2:list val, listrep sh cts2 z -* listrep sh (contents++cts2) x.
+  ∀ cts2:list val, listrep sh cts2 z -∗ listrep sh (contents++cts2) x.
 
-Lemma body_append: semax_body Vprog Gprog f_append append_spec.
+Lemma body_append2: semax_body Vprog Gprog f_append append_spec.
 Proof.
 start_function.
 forward_if.
 *
- subst x. rewrite listrep_null. Intros; subst. 
+ subst x. rewrite listrep_null. Intros; subst.
  forward.
- Exists y.
- entailer!!.
- simpl; auto.
+ Exists y; simpl; entailer!.
 *
  forward.
  destruct s1 as [ | v s1']; unfold listrep; fold listrep. Intros; contradiction.
@@ -167,7 +180,7 @@ forward_if.
  remember (v::s1') as s1.
  forward.
  forward_while
-      (EX s1a: list val,  EX a: val, EX s1b: list val, EX t: val, EX u: val,
+      (∃ s1a: list val, ∃ a: val, ∃ s1b: list val, ∃ t: val, ∃ u: val,
             PROP (s1 = s1a ++ a :: s1b)
             LOCAL (temp _x x; temp _t t; temp _u u; temp _y y)
             SEP (lseg sh s1a x t;
@@ -176,7 +189,7 @@ forward_if.
                    listrep sh s2 y))%assert.
 + (* current assertion implies loop invariant *)
    Exists (@nil val) v s1' x u.  entailer!!.
-   unfold lseg. apply allp_right; intro. simpl. cancel_wand.
+   unfold lseg. iIntros. simpl. auto.
 + (* loop test is safe to execute *)
    entailer!!.
 + (* loop body preserves invariant *)
@@ -189,122 +202,114 @@ forward_if.
    rewrite <- !app_assoc. simpl app.
    entailer!!.
    unfold lseg.
-   rewrite sepcon_comm.
+   rewrite bi.sep_comm.
    clear.
-   apply RAMIF_Q.trans'' with (cons a).
-   extensionality cts; simpl; rewrite <- app_assoc; reflexivity.
-   apply allp_right; intro. apply wand_sepcon_adjoint.
-   unfold listrep at 2; fold listrep; Exists u0.  apply derives_refl.
+   iIntros "[H1 H2]".
+   iIntros (cts2) "H3".
+   iSpecialize ("H2" $! (a :: cts2)).
+   rewrite -app_assoc.
+   iApply ("H2").
+   unfold listrep at -1; fold listrep. iExists u0. iFrame.
  + (* after the loop *)
-   forward. forward.
+   forward. simpl. forward.
    Exists x. entailer!!.
    destruct H3 as [? _]. specialize (H3 (eq_refl _)). subst s1b.
    unfold listrep at 1.  Intros. autorewrite with norm.  rewrite H0. rewrite <- app_assoc. simpl app.
    unfold lseg.
-   rewrite sepcon_assoc.
-   eapply derives_trans; [apply allp_sepcon1 | ]. apply allp_left with (a::s2).
-   rewrite sepcon_comm.
-   eapply derives_trans; [ | apply modus_ponens_wand].
-   apply sepcon_derives; [ | apply derives_refl].
-   unfold listrep at 2; fold listrep. Exists y; auto.
+   iIntros "(H1 & H2 & H3)".
+   iApply ("H1" $! (a :: s2)).
+   unfold listrep at 2; fold listrep. iExists y; iFrame.
 Qed.
 
 End Proof2.
 
-Module Proof3.  (*************** inductive lseg *******************)
+Section Proof3.  (*************** inductive lseg *******************)
 
-Fixpoint lseg (sh: share)
+Fixpoint lseg2 (sh: share)
             (contents: list val) (x z: val) : mpred :=
  match contents with
- | h::hs => !! (x<>z) && 
-              EX y:val,
-                data_at sh t_struct_list (h,y) x * lseg sh hs y z
- | nil => !! (x = z /\ is_pointer_or_null x) && emp
+ | h::hs => ⌜x<>z⌝ ∧ 
+              ∃ y:val,
+                data_at sh t_struct_list (h,y) x ∗ lseg2 sh hs y z
+ | nil => ⌜x = z /\ is_pointer_or_null x⌝ ∧ emp
  end.
 
-Arguments lseg sh contents x z : simpl never.
+Arguments lseg2 sh contents x z : simpl never.
+Notation lseg := lseg2.
 
 Lemma lseg_local_facts:
   forall sh contents p q,
-     lseg sh contents p q |--
-     !! (is_pointer_or_null p /\ is_pointer_or_null q /\ (p=q <-> contents=nil)).
+     lseg sh contents p q ⊢
+     ⌜is_pointer_or_null p /\ is_pointer_or_null q /\ (p=q <-> contents=nil)⌝.
 Proof.
 intros.
-apply derives_trans with (lseg sh contents p q && !! (is_pointer_or_null p /\
-        is_pointer_or_null q /\ (p = q <-> contents = []))).
-2: entailer!.
 revert p; induction contents; intros; simpl; unfold lseg; fold lseg.
+{ normalize. }
+Intros y.
 entailer!.
-intuition.
-Intros y. Exists y.
-eapply derives_trans.
-apply sepcon_derives.
-apply derives_refl.
-apply IHcontents.
-entailer!.
-intuition congruence.
+intuition discriminate.
 Qed.
 
-#[export] Hint Resolve lseg_local_facts : saturate_local.
+Hint Resolve lseg_local_facts : saturate_local.
 
 Lemma lseg_valid_pointer:
   forall sh contents p ,
    sepalg.nonidentity sh ->
-   lseg sh contents p nullval |-- valid_pointer p.
+   lseg sh contents p nullval ⊢ valid_pointer p.
 Proof.
  destruct contents; unfold lseg; fold lseg; intros. entailer!.
  Intros *.
  auto with valid_pointer.
 Qed.
 
-#[export] Hint Resolve lseg_valid_pointer : valid_pointer.
+Hint Extern 1 (lseg _ _ _ nullval ⊢ valid_pointer _) =>
+    (simple apply lseg_valid_pointer; now auto) : valid_pointer.
 
 Lemma lseg_eq: forall sh contents x,
-    lseg sh contents x x = !! (contents=nil /\ is_pointer_or_null x) && emp.
+    lseg sh contents x x ⊣⊢ ⌜contents=nil /\ is_pointer_or_null x⌝ ∧ emp.
 Proof.
 intros.
 destruct contents; unfold lseg; fold lseg.
-f_equal. f_equal. f_equal. apply prop_ext; intuition.
-apply pred_ext.
-Intros y. contradiction.
-Intros. discriminate.
+- apply and_mono_iff; auto. apply bi.pure_iff. intuition.
+- iSplit. 
+  + iIntros "[%H1 H2]". contradiction.
+  + iIntros "[%H1 H2]". destruct H1. discriminate.
 Qed.
 
 Lemma lseg_null: forall sh contents,
-    lseg sh contents nullval nullval = !! (contents=nil) && emp.
+    lseg sh contents nullval nullval ⊣⊢ ⌜contents=nil⌝ ∧ emp.
 Proof.
 intros.
  rewrite lseg_eq.
- apply pred_ext.
- entailer!.
- entailer!.
+ apply and_mono_iff; auto.
+ apply bi.pure_iff; intuition.
 Qed.
 
-Lemma lseg_cons: forall sh (v u x: val) s,
+Lemma lseg_cons: forall sh (v u x: val) (s: list val),
    readable_share sh ->
- data_at sh t_struct_list (v, u) x * lseg sh s u nullval
- |-- lseg sh [v] x u * lseg sh s u nullval.
+ data_at sh t_struct_list (v, u) x ∗ lseg sh s u nullval
+ ⊢ lseg sh [v] x u ∗ lseg sh s u nullval.
 Proof.
 intros.
-     unfold lseg at 2. Exists u. 
+     unfold lseg at 2. Exists u.
      entailer.
      destruct s; unfold lseg at 1; fold lseg; entailer.
 Qed.
 
-Lemma lseg_cons': forall sh (v u x a b: val) ,
+Lemma lseg_cons': forall sh (v u x a b: val),
    readable_share sh ->
- data_at sh t_struct_list (v, u) x * data_at sh t_struct_list (a,b) u
- |-- lseg sh [v] x u * data_at sh t_struct_list (a,b) u.
+ data_at sh t_struct_list (v, u) x ∗ data_at sh t_struct_list (a,b) u
+ ⊢ lseg sh [v] x u ∗ data_at sh t_struct_list (a,b) u.
 Proof.
 intros.
-     unfold lseg. Exists u. 
+     unfold lseg. Exists u.
      entailer!.
 Qed.
 
 Lemma lseg_app': forall sh s1 s2 (a w x y z: val),
    readable_share sh ->
-   lseg sh s1 w x * lseg sh s2 x y * data_at sh t_struct_list (a,z) y |--
-   lseg sh (s1++s2) w y * data_at sh t_struct_list (a,z) y.
+   (lseg sh s1 w x ∗ lseg sh s2 x y) ∗ data_at sh t_struct_list (a,z) y ⊢
+   lseg sh (s1++s2) w y ∗ data_at sh t_struct_list (a,z) y.
 Proof.
  intros.
  revert w; induction s1; intro; simpl.
@@ -312,12 +317,12 @@ Proof.
  unfold lseg at 1 3; fold lseg. Intros j; Exists j.
  entailer.
  sep_apply (IHs1 j).
- cancel. 
+ cancel.
 Qed.
-
+ 
 Lemma lseg_app_null: forall sh s1 s2 (w x: val),
    readable_share sh ->
-   lseg sh s1 w x * lseg sh s2 x nullval |--
+   lseg sh s1 w x ∗ lseg sh s2 x nullval ⊢
    lseg sh (s1++s2) w nullval.
 Proof.
  intros.
@@ -331,38 +336,36 @@ Qed.
 
 Lemma lseg_app: forall sh s1 s2 a s3 (w x y z: val),
    readable_share sh ->
-   lseg sh s1 w x * lseg sh s2 x y * lseg sh (a::s3) y z |--
-   lseg sh (s1++s2) w y * lseg sh (a::s3) y z.
+   lseg sh s1 w x ∗ lseg sh s2 x y ∗ lseg sh (a::s3) y z ⊢
+   lseg sh (s1++s2) w y ∗ lseg sh (a::s3) y z.
 Proof.
  intros.
  unfold lseg at 3 5; fold lseg.
- Intros u; Exists u. rewrite prop_true_andp by auto.
+ Intros u; Exists u. rewrite prop_true_andp //.
  sep_apply (lseg_app' sh s1 s2 a w x y u); auto.
  cancel.
 Qed.
 
 Lemma listrep_lseg_null :
- listrep = fun sh s p => lseg sh s p nullval.
+ ∀ sh s p, listrep sh s p ⊣⊢ lseg sh s p nullval.
 Proof.
-extensionality sh s p.
+intros.
 revert p.
 induction s; intros.
-unfold lseg, listrep; apply pred_ext; entailer!.
+unfold lseg, listrep; apply bi.equiv_entails_2; entailer!.
 unfold lseg, listrep; fold lseg; fold listrep.
-apply pred_ext; Intros y; Exists y; rewrite IHs; entailer!.
+apply bi.equiv_entails_2; Intros y; Exists y; rewrite IHs; entailer!.
 Qed.
 
-Lemma body_append: semax_body Vprog Gprog f_append append_spec.
+Lemma body_append3: semax_body Vprog Gprog f_append append_spec.
 Proof.
 start_function.
-revert POSTCONDITION; rewrite listrep_lseg_null; intro.
+rewrite -> listrep_lseg_null in * |- *.
 forward_if.
 *
  subst x. rewrite lseg_null. Intros. subst.
  forward.
- Exists y.
- entailer!!.
- simpl; auto.
+ Exists y; simpl; entailer!.
 *
  forward.
  destruct s1 as [ | v s1']; unfold lseg at 1; fold lseg.
@@ -372,7 +375,7 @@ forward_if.
  remember (v::s1') as s1.
  forward.
  forward_while
-      (EX s1a: list val, EX a: val, EX s1b: list val, EX t: val, EX u: val,
+      (∃ s1a: list val, ∃ a: val, ∃ s1b: list val, ∃ t: val, ∃ u: val,
             PROP (s1 = s1a ++ a :: s1b)
             LOCAL (temp _x x; temp _t t; temp _u u; temp _y y)
             SEP (lseg sh s1a x t; 
@@ -381,7 +384,7 @@ forward_if.
                    lseg sh s2 y nullval))%assert.
  + (* current assertion implies loop invariant *)
      Exists (@nil val) v s1' x u.
-     subst s1. rewrite lseg_eq.
+     subst s1. rewrite lseg_eq listrep_lseg_null.
      entailer.
 (*     sep_apply (lseg_cons sh v u x s1'); auto. *)
  + (* loop test is safe to execute *)
@@ -403,13 +406,14 @@ forward_if.
     subst. rewrite lseg_eq. Intros. subst. 
     forward.
     forward.
-    Exists x. 
+    Exists x.
     entailer!!.
     sep_apply (lseg_cons sh a y t s2); auto.
     sep_apply (lseg_app_null sh [a] s2 t y); auto.
     rewrite <- app_assoc.
     sep_apply (lseg_app_null sh s1a ([a]++s2) x t); auto.
+    rewrite listrep_lseg_null //.
 Qed.
 
 End Proof3.
-
+End Spec.
diff --git a/progs/verif_bin_search.v b/progs/verif_bin_search.v
index 22a5503fad..9a753cddc1 100644
--- a/progs/verif_bin_search.v
+++ b/progs/verif_bin_search.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto. (* Import the Verifiable C system *)
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.bin_search. (* Import the AST of this C program *)
 
 (* The next line is "boilerplate", always required after importing an AST. *)
@@ -77,7 +78,7 @@ Proof.
   rewrite firstn_nil, skipn_nil; auto.
 Qed.
 
-Fixpoint sorted2 l :=
+Fixpoint sorted2 l : Prop :=
   match l with
   | [] => True
   | x :: rest => Forall (fun y => x <= y) rest /\ sorted2 rest
@@ -260,7 +261,7 @@ Qed.
 (* Contents of the extern global initialized array "_four" *)
 Definition four_contents := [1; 2; 3; 4].
 
-Lemma body_main:  semax_body Vprog Gprog f_main main_spec.
+Lemma body_main: semax_body Vprog Gprog f_main main_spec.
 Proof.
   start_function.
   forward_call (gv _four,Ews,four_contents,3,0,4).
@@ -270,8 +271,6 @@ Proof.
   Intro r; forward.
 Qed.
 
-#[export] Existing Instance NullExtension.Espec.
-
 Lemma prog_correct:
   semax_prog prog tt Vprog Gprog.
 Proof.
diff --git a/progs/verif_bst.v b/progs/verif_bst.v
index 44d833bb69..b84e7c0271 100644
--- a/progs/verif_bst.v
+++ b/progs/verif_bst.v
@@ -1,4 +1,4 @@
-Require Import VST.floyd.proofauto.
+Require Import VST.floyd.proofauto VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.bst.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
@@ -70,7 +70,7 @@ Definition treebox_rep (t: tree val) (b: val) :=
 
 (* TODO: seems not useful *)
 Lemma treebox_rep_spec: forall (t: tree val) (b: val),
-  treebox_rep t b =
+  treebox_rep t b ⊣⊢
   EX p: val, 
   match t with
   | E => !!(p=nullval) && data_at Tsh (tptr t_struct_tree) p b
@@ -85,20 +85,19 @@ Lemma treebox_rep_spec: forall (t: tree val) (b: val),
 Proof.
   intros.
   unfold treebox_rep at 1.
-  f_equal.
-  extensionality p.
+  f_equiv; intros p.
   destruct t; simpl.
   + apply pred_ext; entailer!!.
   + unfold treebox_rep.
     apply pred_ext; entailer!!.
     - Intros pa pb.
-      Exists pb pa.
+      Exists pa pb.
       unfold_data_at (data_at _ _ _ p).
       rewrite (field_at_data_at _ t_struct_tree [StructField _left]).
       rewrite (field_at_data_at _ t_struct_tree [StructField _right]).
       cancel.
     - Intros pa pb.
-      Exists pb pa.
+      Exists pa pb.
       unfold_data_at (data_at _ _ _ p).
       rewrite (field_at_data_at _ t_struct_tree [StructField _left]).
       rewrite (field_at_data_at _ t_struct_tree [StructField _right]).
@@ -270,23 +269,12 @@ Qed.
 
 #[export] Hint Resolve treebox_rep_saturate_local: saturate_local.
 
-Definition insert_inv (b0: val) (t0: tree val) (x: Z) (v: val): environ -> mpred :=
+Definition insert_inv (b0: val) (t0: tree val) (x: Z) (v: val): assert :=
   EX b: val, EX t: tree val,
   PROP()
   LOCAL(temp _t b; temp _x (Vint (Int.repr x));   temp _value v)
   SEP(treebox_rep t b;  (treebox_rep (insert x v t) b -* treebox_rep (insert x v t0) b0)).
 
-Open Scope logic.
-
-Lemma ramify_PPQQ {A: Type} {NA: NatDed A} {SA: SepLog A} {CA: ClassicalSep A}: forall P Q,
-  P |-- P * (Q -* Q).
-Proof.
-  intros.
-  apply RAMIF_PLAIN.solve with emp.
-  + rewrite sepcon_emp; auto.
-  + rewrite emp_sepcon; auto.
-Qed.
-
 Lemma tree_rep_nullval: forall t,
   tree_rep t nullval |-- !! (t = E).
 Proof.
@@ -323,17 +311,18 @@ Proof.
   rewrite (field_at_data_at _ t_struct_tree [StructField _left]).
   unfold treebox_rep at 1. Exists p1. cancel.
 
-  rewrite <- wand_sepcon_adjoint.
+  iIntros "(? & ? & ? & ?) Hleft".
   clear p1.
   unfold treebox_rep.
-  Exists p.
+  iExists p.
   simpl.
-  Intros p1.
-  Exists p1 p2.
-  entailer!!.
+  iDestruct "Hleft" as (p1) "(? & ?)".
+  iFrame.
+  iSplit; first done.
+  iExists p2.
   unfold_data_at (data_at _ _ _ p).
   rewrite (field_at_data_at _ t_struct_tree [StructField _left]).
-  cancel.
+  iStopProof; cancel.
 Qed.
 
 Lemma bst_right_entail: forall (t1 t2 t2': tree val) k (v p1 p2 p b: val),
@@ -352,26 +341,18 @@ Proof.
   rewrite (field_at_data_at _ t_struct_tree [StructField _right]).
   unfold treebox_rep at 1. Exists p2. cancel.
 
-  rewrite <- wand_sepcon_adjoint.
+  iIntros "(? & ? & ? & ?) Hright".
   clear p2.
   unfold treebox_rep.
-  Exists p.
+  iExists p.
   simpl.
-  Intros p2.
-  Exists p1 p2.
-  entailer!!.
+  iDestruct "Hright" as (p2) "(? & ?)".
+  iFrame.
+  iSplit; first done.
+  iExists p1.
   unfold_data_at (data_at _ _ _ p).
   rewrite (field_at_data_at _ t_struct_tree [StructField _right]).
-  cancel.
-Qed.
-
-Lemma modus_ponens_wand' {A}{ND: NatDed A}{SL: SepLog A}:
-  forall P Q R: A, (P |-- Q) -> P * (Q -* R) |-- R.
-Proof.
-  intros.
-  eapply derives_trans; [| apply modus_ponens_wand].
-  apply sepcon_derives; [| apply derives_refl].
-  auto.
+  iStopProof; cancel.
 Qed.
 
 Lemma if_trueb: forall {A: Type} b (a1 a2: A), b = true -> (if b then a1 else a2) = a1.
@@ -387,11 +368,11 @@ Lemma body_insert: semax_body Vprog Gprog f_insert insert_spec.
 Proof.
   start_function.
   eapply semax_pre; [
-    | apply (semax_loop _ (insert_inv b t x v) (insert_inv b t x v) )].
+    | apply (semax_loop _ _ (insert_inv b t x v) (insert_inv b t x v) )].
   * (* Precondition *)
     unfold insert_inv.
     Exists b t. entailer.
-    apply ramify_PPQQ.
+    iIntros "$ $".
   * (* Loop body *)
     unfold insert_inv at 1.
     Intros b1 t1.
@@ -412,8 +393,8 @@ Proof.
       subst t1. simpl tree_rep. rewrite !prop_true_andp by auto.
       forward. (* *t = p; *)
       forward. (* return; *)
-      apply modus_ponens_wand'.
-      apply treebox_rep_leaf; auto.
+      iIntros "(? & ? & H)"; iApply "H".
+      by iApply (treebox_rep_leaf with "[$]").
     + (* else clause *)
       destruct t1.
         { simpl tree_rep. Intros. contradiction. }
@@ -427,28 +408,18 @@ Proof.
         Exists (field_address t_struct_tree [StructField _left] p) t1_1.
         entailer!. simpl.
         simpl_compb.
-        (* TODO: SIMPLY THIS LINE 
-        replace (offset_val 8 p1)
-          with (field_address t_struct_tree [StructField _left] p1)
-          by (unfold field_address; simpl;
-              rewrite if_true by auto with field_compatible; auto).
-*)
-        apply RAMIF_PLAIN.trans'.
-        apply bst_left_entail; auto.
+        sep_apply (bst_left_entail t1_1 (insert x v t1_1)).
+        iIntros "(($ & H1) & Ht) ?".
+        iApply "Ht"; iApply "H1"; done.
       - (* Inner if, second branch:  k<x *)
         forward. (* t=&p->right *)
         unfold insert_inv.
         Exists (field_address t_struct_tree [StructField _right] p) t1_2.
         entailer!. simpl.
         simpl_compb; simpl_compb.
-        (* TODO: SIMPLY THIS LINE 
-        replace (offset_val 12 p1)
-          with (field_address t_struct_tree [StructField _right] p1)
-          by (unfold field_address; simpl;
-              rewrite if_true by auto with field_compatible; auto).
-*)
-        apply RAMIF_PLAIN.trans'.
-        apply bst_right_entail; auto.
+        sep_apply (bst_right_entail t1_1 t1_2 (insert x v t1_2)).
+        iIntros "(($ & H1) & Ht) ?".
+        iApply "Ht"; iApply "H1"; done.
       - (* Inner if, third branch: x=k *)
         assert (x=k) by lia.
         subst x.  clear H H1 H3.
@@ -457,15 +428,15 @@ Proof.
         (* TODO: SIMPLY THIS LINE *)
         simpl_compb.
         simpl_compb.
-        apply modus_ponens_wand'.
+        iIntros "(? & ? & ? & ? & H)"; iApply "H"; iStopProof.
         unfold treebox_rep. Exists p.
         simpl tree_rep. Exists pa pb. entailer!!.
   * (* After the loop *)
     forward.
-    apply andp_left2. auto.
+    auto.
 Qed.
 
-Definition lookup_inv (b0 p0: val) (t0: tree val) (x: Z): environ -> mpred :=
+Definition lookup_inv (b0 p0: val) (t0: tree val) (x: Z): assert :=
   EX p: val, EX t: tree val, 
   PROP(lookup nullval x t = lookup nullval x t0) 
   LOCAL(temp _p p; temp _x (Vint (Int.repr x)))
@@ -483,7 +454,7 @@ Proof.
   forward_while (lookup_inv b p t x).
   * (* precondition implies loop invariant *)
     Exists p t. entailer!.
-    apply -> wand_sepcon_adjoint. cancel.
+    auto.
   * (* type-check loop condition *)
     entailer!.
   * (* loop body preserves invariant *)
@@ -497,9 +468,7 @@ Proof.
       entailer!!.
       - rewrite <- H0; simpl.
         simpl_compb; auto.
-      - (* TODO: merge the following 2 lines *)
-        apply RAMIF_PLAIN.trans''.
-        apply -> wand_sepcon_adjoint.
+      - iIntros "(? & ? & H) ?"; iApply "H"; iStopProof.
         simpl. Exists pa pb; entailer!.
     + (* else-then clause: y<x *)
       forward. (* p=p<-right *)
@@ -507,9 +476,7 @@ Proof.
       entailer!!.
       - rewrite <- H0; simpl.
         simpl_compb; simpl_compb; auto.
-      - (* TODO: merge the following 2 lines *)
-        apply RAMIF_PLAIN.trans''.
-        apply -> wand_sepcon_adjoint.
+      - iIntros "(? & ? & H) ?"; iApply "H"; iStopProof.
         simpl. Exists pa pb; entailer!.
     + (* else-else clause: x=y *)
       assert (x=k) by lia. subst x. clear H H3 H4.
@@ -518,13 +485,12 @@ Proof.
       entailer!!.
       - rewrite <- H0. simpl.
         simpl_compb; simpl_compb; auto.
-      - (* TODO: merge the following 2 lines *)
-        apply modus_ponens_wand'.
+      - iIntros "(? & ? & ? & H)"; iApply "H"; iStopProof.
         Exists pa pb; entailer!!.
   * (* after the loop *)
     forward. (* return NULL; *)
     entailer!.
-    apply modus_ponens_wand.
+    iIntros "(? & H)"; iApply "H"; done.
 Qed.
 
 Lemma body_turn_left: semax_body Vprog Gprog f_turn_left turn_left_spec.
@@ -543,7 +509,7 @@ Proof.
   entailer!!.
 Qed.
 
-Definition pushdown_left_inv (b_res: val) (t_res: tree val): environ -> mpred :=
+Definition pushdown_left_inv (b_res: val) (t_res: tree val): assert :=
   EX b: val, EX ta: tree val, EX x: Z, EX v: val, EX tb: tree val,
   PROP  () 
   LOCAL (temp _t b)
@@ -551,7 +517,7 @@ Definition pushdown_left_inv (b_res: val) (t_res: tree val): environ -> mpred :=
          (treebox_rep (pushdown_left ta tb) b -* treebox_rep t_res b_res)).
 
 Lemma cancel_emp_spacer:
-  forall sh x y p, x=y -> 
+  forall sh x y p, x=y ->
     emp |-- spacer sh x y p.
 Proof.
 intros.
@@ -574,16 +540,16 @@ Lemma body_pushdown_left: semax_body Vprog Gprog f_pushdown_left pushdown_left_s
 Proof.
   start_function.
   eapply semax_pre; [
-    | apply (semax_loop _ (pushdown_left_inv b (pushdown_left ta tb))
+    | apply (semax_loop _ _ (pushdown_left_inv b (pushdown_left ta tb))
                          (pushdown_left_inv b (pushdown_left ta tb)))].
   + (* Precondition *)
     unfold pushdown_left_inv.
     Exists b ta x v tb.
     entailer!!.
-    eapply derives_trans; [| apply ramify_PPQQ].
     rewrite (treebox_rep_spec (T ta x v tb)).
     Exists p.
     entailer!!.
+    auto.
   + (* Loop body *)
     unfold pushdown_left_inv.
     clear x v H H0.
@@ -592,8 +558,6 @@ Proof.
     Intros p0.
     forward. (* skip *)
     forward. (* p = *t; *)
-      (* TODO entailer: The following should be solve automatically. satuate local does not work *)
- (*     1: rewrite (add_andp _ _ (tree_rep_saturate_local _ _)); entailer!. *)
     simpl tree_rep.
     Intros pa pbc.
     forward. (* q = p->right *)
@@ -611,8 +575,8 @@ Proof.
       }
       forward. (* return *)
       simpl.
-      apply modus_ponens_wand'.
-      Exists pa.
+      iIntros "(? & ? & ? & H)"; iApply "H"; iStopProof.
+      unfold treebox_rep; Exists pa.
       entailer!!.
     - destruct tbc0 as [| tb0 y vy tc0].
         { simpl tree_rep. Intros; contradiction. }
@@ -622,14 +586,14 @@ Proof.
       Exists (field_address t_struct_tree [StructField _left] pbc) ta0 x vx tb0.
       (* TODO entailer: not to simply too much in entailer? *)
       Opaque tree_rep. entailer!. Transparent tree_rep.
-        (* TODO: simplify this line *)
-      apply RAMIF_PLAIN.trans'.
-      apply bst_left_entail; auto.
+      sep_apply (bst_left_entail (T ta0 x vx tb0) (pushdown_left ta0 tb0)).
+      iIntros "(($ & H1) & Ht) ?".
+      iApply "Ht"; iApply "H1"; done.
   + forward. (* Sskip *)
-    apply andp_left2; auto.
+    auto.
 Qed.
 
-Definition delete_inv (b0: val) (t0: tree val) (x: Z): environ -> mpred :=
+Definition delete_inv (b0: val) (t0: tree val) (x: Z): assert :=
   EX b: val, EX t: tree val,
   PROP()
   LOCAL(temp _t b; temp _x (Vint (Int.repr x)))
@@ -639,11 +603,11 @@ Lemma body_delete: semax_body Vprog Gprog f_delete delete_spec.
 Proof.
   start_function.
   eapply semax_pre; [
-    | apply (semax_loop _ (delete_inv b t x) (delete_inv b t x) )].
+    | apply (semax_loop _ _ (delete_inv b t x) (delete_inv b t x) )].
   * (* Precondition *)
     unfold delete_inv.
     Exists b t. entailer.
-    apply ramify_PPQQ.
+    iIntros "$ $".
   * (* Loop body *)
     unfold delete_inv.
     Intros b1 t1.
@@ -657,7 +621,7 @@ Proof.
       subst t1. simpl tree_rep. rewrite !prop_true_andp by auto.
       forward. (* return; *)
       unfold treebox_rep at 1.
-      apply modus_ponens_wand'.
+      iIntros "(? & H)"; iApply "H"; iStopProof.
       Exists nullval.
       simpl tree_rep.
       entailer!!.
@@ -674,28 +638,16 @@ Proof.
         Exists (field_address t_struct_tree [StructField _left] p1) t1_1.
         entailer!. simpl.
         simpl_compb.
-        (* TODO: SIMPLY THIS LINE 
-        replace (offset_val 8 p1)
-          with (field_address t_struct_tree [StructField _left] p1)
-          by (unfold field_address; simpl;
-              rewrite if_true by auto with field_compatible; auto).
-*)
-        apply RAMIF_PLAIN.trans'.
-        apply bst_left_entail; auto.
+        sep_apply (bst_left_entail t1_1 (delete x t1_1)).
+        iIntros "(($ & H1) & Ht) ?"; iApply "Ht"; iApply "H1"; done.
       - (* Inner if, second branch:  k<x *)
         forward. (* t=&p->right *)
         unfold delete_inv.
         Exists (field_address t_struct_tree [StructField _right] p1) t1_2.
         entailer!. simpl.
         simpl_compb; simpl_compb.
-        (* TODO: SIMPLY THIS LINE 
-        replace (offset_val 12 p1)
-          with (field_address t_struct_tree [StructField _right] p1)
-          by (unfold field_address; simpl;
-              rewrite if_true by auto with field_compatible; auto).
-*)
-        apply RAMIF_PLAIN.trans'.
-        apply bst_right_entail; auto.
+        sep_apply (bst_right_entail t1_1 t1_2 (delete x t1_2)).
+        iIntros "(($ & H1) & Ht) ?"; iApply "Ht"; iApply "H1"; done.
       - (* Inner if, third branch: x=k *)
         assert (x=k) by lia.
         subst x.
@@ -725,10 +677,9 @@ Proof.
         simpl.
         simpl_compb.
         simpl_compb.
-        apply modus_ponens_wand'.
-        auto.
+        iIntros "(? & H)"; iApply "H"; done.
   * (* After the loop *)
-    forward. apply andp_left2; auto. 
+    forward. auto.
 Qed.
 
 Lemma body_treebox_new: semax_body Vprog Gprog f_treebox_new treebox_new_spec.
@@ -739,13 +690,13 @@ Proof.
   rewrite memory_block_data_at_ by auto.
   forward.
   forward.
-  Exists p. entailer!!.
+  Exists p; entailer!!.
 Qed.
 
 Lemma body_tree_free: semax_body Vprog Gprog f_tree_free tree_free_spec.
 Proof.
   start_function.
-  forward_if (PROP()LOCAL()SEP()).
+  forward_if.
   + destruct t; simpl tree_rep.
       1: Intros. contradiction.
     Intros pa pb.
@@ -763,7 +714,6 @@ Proof.
   + forward.
     subst.
     unfold tree_rep; entailer!.
-  + forward.
 Qed.
 
 Lemma body_treebox_free: semax_body Vprog Gprog f_treebox_free treebox_free_spec.
@@ -773,10 +723,10 @@ Proof.
   Intros p.
   forward.
   Time forward_call (t,p).
+  simpl.
   Time forward_call (b, sizeof (tptr t_struct_tree)).
-  entailer!.
-  rewrite memory_block_data_at_ by auto.
-  cancel.
+  saturate_local.
+  rewrite memory_block_data_at_ by auto; cancel.
   forward.
 Qed.
 
@@ -870,15 +820,17 @@ Lemma subsume_insert:
  funspec_sub (snd insert_spec) (snd abs_insert_spec).
 Proof.
 do_funspec_sub. destruct w as [[[b x] v] m]. simpl.
-unfold convertPre. Intros.
-destruct args. inv H1. 
+rewrite <- fupd_intro.
+Intros.
+destruct args. inv H1.
+destruct args. inv H1.
 destruct args. inv H1.
-destruct args. inv H1. 
 destruct args; inv H1. simpl in *.
 unfold env_set, eval_id in *. simpl in *. subst. 
 unfold tmap_rep.
 Intros t.
-Exists (b, x, v, t) emp. simpl. entailer!!.
+Exists (b, x, v, t) (emp : mpred). simpl.
+entailer!!.
 intros. Exists (insert x v t).
 entailer!!. apply insert_relate; trivial.
 Qed.
@@ -886,8 +838,10 @@ Qed.
 Lemma subsume_treebox_new:
  funspec_sub (snd treebox_new_spec) (snd abs_treebox_new_spec).
 Proof.
-do_funspec_sub. unfold convertPre. simpl; Intros.
-Exists emp. entailer!!.
+do_funspec_sub.
+rewrite <- fupd_intro.
+Intros.
+Exists (emp : mpred). entailer!!.
 intros tau ? ?. Exists (eval_id ret_temp tau). entailer!!.
 unfold tmap_rep.
 Exists (empty_tree val).
@@ -901,12 +855,14 @@ Qed.
 Lemma subsume_treebox_free:
  funspec_sub (snd treebox_free_spec) (snd abs_treebox_free_spec).
 Proof.
-do_funspec_sub. destruct w as [m p]. clear H. unfold convertPre. simpl; Intros.
+do_funspec_sub. destruct w as [m p]. clear H.
+rewrite <- fupd_intro.
+Intros.
 subst.
 unfold env_set, eval_id in *. simpl in *. 
 unfold tmap_rep.
 Intros t.
-Exists (t,p) emp. entailer!!.
+Exists (t,p) (emp : mpred). simpl. entailer!!.
 Qed.
 
 Lemma body_main: semax_body Vprog Gprog f_main main_spec.
@@ -925,7 +881,7 @@ forward_call subsume_insert (p, 1, gv ___stringlit_2, (t_update (t_empty nullval
 forward_call subsume_insert (p, 4, gv ___stringlit_3, (t_update
              (t_update (t_empty nullval) 3
                 (gv ___stringlit_1)) 1 (gv ___stringlit_2))).
-forward_call subsume_insert (p, 1, gv ___stringlit_4, 
+forward_call subsume_insert (p, 1, gv ___stringlit_4,
            (t_update
              (t_update
                 (t_update (t_empty nullval) 3
diff --git a/progs/verif_bst_oo.v b/progs/verif_bst_oo.v
index 45e5a9781e..6a25262148 100644
--- a/progs/verif_bst_oo.v
+++ b/progs/verif_bst_oo.v
@@ -1,8 +1,7 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.bst_oo.
 
-Open Scope logic.
-
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
@@ -64,11 +63,11 @@ Fixpoint treebox_rep (t: tree val) (b: val) : mpred :=
   match t with
   | E => data_at Tsh (tptr t_struct_tree) nullval b
   | T l x p r =>
-      !! (Int.min_signed <= x <= Int.max_signed) &&
+      (!! (Int.min_signed <= x <= Int.max_signed) &&
       data_at Tsh (tptr t_struct_tree) p b *
       field_at Tsh t_struct_tree [StructField _key] (Vint (Int.repr x)) p *
       treebox_rep l (field_address t_struct_tree [StructField _left] p) *
-      treebox_rep r (field_address t_struct_tree [StructField _right] p)
+      treebox_rep r (field_address t_struct_tree [StructField _right] p))%I
   end.
 
 Fixpoint key_store (s: tree val) (x: key) (q: val): Prop :=
@@ -89,8 +88,8 @@ Definition value_at (t: tree val) (v: val) (x: Z): mpred :=
 
 (* TODO: maybe not useful *)
 Lemma treebox_rep_spec: forall (t: tree val) (b: val),
-  treebox_rep t b =
-  data_at Tsh (tptr t_struct_tree)
+  treebox_rep t b ⊣⊢
+  (data_at Tsh (tptr t_struct_tree)
     match t return val with
     | E => nullval
     | T _ _ p _ => p
@@ -102,7 +101,7 @@ Lemma treebox_rep_spec: forall (t: tree val) (b: val),
       field_at Tsh t_struct_tree [StructField _key] (Vint (Int.repr x)) p *
       treebox_rep l (field_address t_struct_tree [StructField _left] p) *
       treebox_rep r (field_address t_struct_tree [StructField _right] p)
-  end.
+  end)%I.
 Proof.
   intros.
   destruct t; simpl; apply pred_ext; entailer!.
@@ -291,41 +290,15 @@ Qed.
 #[export] Hint Resolve tree_rep_valid_pointer: valid_pointer.
 
 *)
-Lemma modus_ponens_wand' {A}{ND: NatDed A}{SL: SepLog A}:
-  forall P Q R: A, (P |-- Q) -> P * (Q -* R) |-- R.
-Proof.
-  intros.
-  eapply derives_trans; [| apply modus_ponens_wand].
-  apply sepcon_derives; [| apply derives_refl].
-  auto.
-Qed.
-
-Lemma RAMIF_Q2_trans' {X Y A : Type} {ND : NatDed A} {SL : SepLog A}:
+Lemma RAMIF_Q2_trans' {X Y} {A : bi}:
   forall (m l: A) (g' m' l' : X -> Y -> A),
-    (m |-- l * (ALL p: X, ALL q: Y, l' p q -* m' p q)) ->
-    m * (ALL p: X, ALL q: Y, m' p q -* g' p q) |-- l * (ALL p: X, ALL q: Y, l' p q -* g' p q).
+    (m |-- l * (ALL p: X, ALL q: Y, (l' p q -* m' p q))) ->
+    m * (ALL p: X, ALL q: Y, (m' p q -* g' p q)) |-- l * (ALL p: X, ALL q: Y, (l' p q -* g' p q)).
 Proof.
   intros.
-  eapply derives_trans; [apply sepcon_derives; [exact H | apply derives_refl] |].
-  clear H.
-  rewrite sepcon_assoc.
-  apply sepcon_derives; auto.
-  apply allp_right; intros p.
-  apply allp_right; intros q.
-  apply <- wand_sepcon_adjoint.
-  apply (allp_left _ p), (allp_left _ q).
-  apply -> wand_sepcon_adjoint.
-  rewrite sepcon_comm.
-  apply <- wand_sepcon_adjoint.
-  apply (allp_left _ p), (allp_left _ q).
-  apply -> wand_sepcon_adjoint.
-  rewrite sepcon_comm.
-  apply -> wand_sepcon_adjoint.
-  rewrite (sepcon_comm (_ * _) _), <- sepcon_assoc.
-  apply <- wand_sepcon_adjoint.
-  eapply derives_trans; [apply modus_ponens_wand |].
-  apply -> wand_sepcon_adjoint.
-  apply modus_ponens_wand.
+  rewrite H.
+  iIntros "(($ & Hl') & Hm')" (??) "l'".
+  iApply "Hm'"; iApply "Hl'"; done.
 Qed.
 
 Lemma if_trueb: forall {A: Type} b (a1 a2: A), b = true -> (if b then a1 else a2) = a1.
@@ -346,12 +319,12 @@ Definition subscr_post (b0: val) (t0: tree val) (x: Z) (p: val) (q: val) :=
   treebox_rep (insert x p t0) b0 *
   (if tree_inb x t0 then emp else data_at Tsh (tptr tvoid) nullval q).
 
-Definition subscr_inv (b0: val) (t0: tree val) (x: Z): environ -> mpred :=
+Definition subscr_inv (b0: val) (t0: tree val) (x: Z): assert :=
   EX b: val, EX t: tree val, 
   PROP() 
   LOCAL(temp _t b; temp _key (Vint (Int.repr x)))
   SEP(treebox_rep t b;
-      ALL p: val, ALL q: val, subscr_post b t x p q -* subscr_post b0 t0 x p q).
+      ALL p: val, ALL q: val, (subscr_post b t x p q -* subscr_post b0 t0 x p q)).
 
 Axiom tree_inb_true_iff: forall x (t: tree val), tree_inb x t = true <-> key_store_ t x.
 Axiom tree_inb_false_iff: forall x (t: tree val), tree_inb x t = false <-> ~ key_store_ t x.
@@ -369,19 +342,17 @@ Proof.
   Intros p q; Exists p q.
   unfold subscr_post.
   destruct (tree_inb x t) eqn:?.
-  apply tree_inb_true_iff in  Heqb0. entailer!.  apply orp_right1. auto.
-  apply tree_inb_false_iff in  Heqb0. entailer!. apply orp_right2. entailer!.
+  apply tree_inb_true_iff in  Heqb0. entailer!.  auto.
+  apply tree_inb_false_iff in  Heqb0. entailer!. rewrite <- bi.or_intro_r. entailer!.
  }
   rename H into Range_x.
   eapply semax_pre; [
-    | apply (semax_loop _ (subscr_inv b t x) (subscr_inv b t x))].
+    | apply (semax_loop _ _ (subscr_inv b t x) (subscr_inv b t x))].
   * (* Precondition *)
     unfold subscr_inv.
     Exists b t.
     entailer!.
-    apply allp_right; intros p.
-    apply allp_right; intros q.
-    apply wand_sepcon_adjoint; entailer!.
+    auto.
   * (* Loop body *)
     unfold subscr_inv.
     Intros b1 t1.
@@ -401,23 +372,20 @@ Proof.
       forward. (* *t = p; *)
       forward. (* return (&p->value); *)
       Exists p1 (offset_val 4 p1).
-      rewrite (sepcon_comm (_ * _)); apply wand_sepcon_adjoint.
-      apply (allp_left _ p1), (allp_left _ (offset_val 4 p1)).
-      apply wand_sepcon_adjoint; rewrite <- (sepcon_comm (_ * _)).
-      entailer!.
-      apply modus_ponens_wand'.
-      unfold subscr_post.
-      simpl.
+      apply bi.and_intro; auto.
+      iIntros "(? & ? & H)"; iApply "H".
+      unfold subscr_post; simpl.
+      simpl_compb. simpl_compb.
       replace (offset_val 4 p1)
         with (field_address t_struct_tree [StructField _value] p1)
         by (unfold field_address; simpl;
             rewrite if_true by auto with field_compatible; auto).
-      simpl_compb. simpl_compb.
+      iStopProof; entailer!.
       unfold_data_at (data_at _ _ _ p1).
       rewrite (field_at_data_at _ t_struct_tree [StructField _value]).
       rewrite (field_at_data_at _ t_struct_tree [StructField _left]).
       rewrite (field_at_data_at _ t_struct_tree [StructField _right]).
-      entailer!.
+      cancel.
     + 
       Intros.
       forward. (* p = *t; *)
@@ -433,38 +401,32 @@ Proof.
         unfold subscr_inv.
         Exists (offset_val 8 v) t1_1.
         entailer!.
-        apply RAMIF_Q2_trans'.
-        (* TODO: SIMPLY THIS LINE *)
         replace (offset_val 8 v)
           with (field_address t_struct_tree [StructField _left] v)
           by (unfold field_address; simpl;
               rewrite if_true by auto with field_compatible; auto).
-        entailer!.
-        apply allp_right; intros p.
-        apply allp_right; intros q.
-        apply -> wand_sepcon_adjoint.
+        cancel.
+        iIntros "(? & ? & ? & H)" (??) "?".
+        iApply "H".
         unfold subscr_post.
         simpl.
         simpl_compb.
         simpl_compb.
         simpl.
         simpl_compb.
-        entailer!.
+        iStopProof; entailer!.
       - (* Inner if, second branch:  k<x *)
         forward. (* t=&p->right *)
         unfold subscr_inv.
         Exists (offset_val 12 v) t1_2.
         entailer!.
-        apply RAMIF_Q2_trans'.
         (* TODO: SIMPLY THIS LINE *)
         replace (offset_val 12 v)
           with (field_address t_struct_tree [StructField _right] v)
           by (unfold field_address; simpl;
               rewrite if_true by auto with field_compatible; auto).
-        entailer!.
-        apply allp_right; intros p.
-        apply allp_right; intros q.
-        apply -> wand_sepcon_adjoint.
+        iIntros "(? & ? & ? & $ & H)" (p q) "?".
+        iApply "H".
         unfold subscr_post.
         simpl.
         simpl_compb.
@@ -474,7 +436,7 @@ Proof.
         simpl_compb.
         simpl_compb.
         simpl_compb.
-        entailer!.
+        iStopProof; entailer!.
       - (* Inner if, third branch: x=k *)
         assert (x=k) by lia.
         subst x. clear H1 H2.
@@ -483,10 +445,8 @@ Proof.
 
         Exists v (offset_val 4 v).
         entailer!.
-        rewrite (sepcon_comm (_ * _ * _ * _)); apply wand_sepcon_adjoint.
-        apply (allp_left _ v), (allp_left _ (offset_val 4 v)).
-        apply wand_sepcon_adjoint; rewrite <- (sepcon_comm (_ * _ * _ * _)).
-        apply modus_ponens_wand'.
+        iIntros "(? & ? & ? & ? & H)".
+        iApply "H".
         unfold subscr_post.
         simpl.
         simpl_compb.
@@ -496,7 +456,7 @@ Proof.
         simpl.
         simpl_compb.
         simpl_compb.
-        entailer!.
+        iStopProof; entailer!.
         unfold field_address; simpl.
         rewrite if_true; auto.
         rewrite field_compatible_cons in H3 |- *.
@@ -506,7 +466,7 @@ Proof.
         tauto.
   * (* After the loop *)
     forward.
-    simpl loop2_ret_assert. apply andp_left2. auto.
+    simpl loop2_ret_assert. apply andp_left2; auto.
 all:fail.
 Admitted.
 (*
diff --git a/progs/verif_cast_test.v b/progs/verif_cast_test.v
index 9b0b40cc04..8955dad02b 100644
--- a/progs/verif_cast_test.v
+++ b/progs/verif_cast_test.v
@@ -1,11 +1,10 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.cast_test.
 
 #[export] Instance CompSpecs : compspecs.
 Proof. make_compspecs prog. Defined.
 
-Local Open Scope logic.
-
 Definition test_spec :=
  DECLARE _test
   WITH n: Z
@@ -18,7 +17,7 @@ Definition test_spec :=
         RETURN (Vint (Int.repr 0))
         SEP ().
 
-Definition issue500_spec := 
+Definition issue500_spec :=
   DECLARE _issue500
   WITH i: Int64.int
   PRE [ tlong ]
@@ -47,7 +46,7 @@ forward.  (*  c = c << 8; *)
 forward.  (*  d = c & 0xff; *)
 forward.  (*  d = d & b; *)
 forward.  (* return d *)
-clear. apply prop_right; f_equal.
+clear. apply bi.pure_intro; f_equal.
 rewrite <- Int64.mul_pow2 with (n:= Int64.repr 256) by reflexivity.
 rewrite mul64_repr, and64_repr.
 rewrite (Z.land_ones _ 8) by computable.
diff --git a/progs/verif_dotprod.v b/progs/verif_dotprod.v
index a87d87209c..ef0977da99 100644
--- a/progs/verif_dotprod.v
+++ b/progs/verif_dotprod.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.dotprod.
 
 #[export] Instance CompSpecs : compspecs.
@@ -6,8 +7,6 @@ Proof. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
 
-Local Open Scope logic.
-
 Fixpoint map2 {A B C: Type} (f: A -> B -> C) (al: list A) (bl: list B) : list C :=
  match al, bl with
   | a::al', b::bl' => f a b :: map2 f al' bl'
diff --git a/progs/verif_even.v b/progs/verif_even.v
index 9dc90e0a85..f46b9e01df 100644
--- a/progs/verif_even.v
+++ b/progs/verif_even.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.even.
 Require Import VST.progs.verif_evenodd_spec.
 
@@ -29,7 +30,7 @@ forward.
 Qed.
 
 
-Definition Espec := add_funspecs NullExtension.Espec (ext_link_prog even.prog) Gprog.
+Definition Espec := add_funspecs_rec unit (ext_link_prog even.prog) (void_spec _) Gprog.
 #[export] Existing Instance Espec.
 (* The Espec for odd is different from the Espec for even;
   the former has only "even" as an external function, and vice versa. *)
@@ -38,6 +39,10 @@ Lemma prog_correct:
 Proof.
 prove_semax_prog.
 semax_func_cons_ext.
+{ destruct x; simpl.
+  unfold PROPx, LOCALx, SEPx, local, lift1; simpl; unfold liftx; simpl; unfold lift.
+  monPred.unseal; Intros.
+  destruct ret; unfold eval_id in H0; simpl in H0; subst; simpl; [auto | contradiction]. }
 semax_func_cons body_even.
 semax_func_cons body_main.
 Qed.
diff --git a/progs/verif_evenodd.v b/progs/verif_evenodd.v
index 41c9062610..cf349b9269 100644
--- a/progs/verif_evenodd.v
+++ b/progs/verif_evenodd.v
@@ -1,6 +1,6 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.evenodd.
-Local Open Scope logic.
 
 Inductive repr : Z -> val -> Prop :=
 | mk_repr : forall z, z >= 0 -> repr z (Vint (Int.repr z)).
diff --git a/progs/verif_evenodd_spec.v b/progs/verif_evenodd_spec.v
index 68da83fc8b..7fa326364a 100644
--- a/progs/verif_evenodd_spec.v
+++ b/progs/verif_evenodd_spec.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.even.
 
 #[export] Instance CompSpecs : compspecs.
diff --git a/progs/verif_fib.v b/progs/verif_fib.v
index 77c64ec602..5d3317fac8 100644
--- a/progs/verif_fib.v
+++ b/progs/verif_fib.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.fib.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
@@ -95,7 +96,7 @@ Proof.
     (EX i: Z,
     (PROP ()
      LOCAL (temp _a1 (Vint (Int.repr (fib_of_Z (i + 1)))); temp _a0 (Vint (Int.repr (fib_of_Z i))); temp _n (Vint (Int.repr n)))
-     SEP ()))%assert.
+     SEP ())).
   { (* Prove that loop invariant implies typechecking of loop condition *)
     entailer!!.
   }
@@ -152,11 +153,11 @@ Proof.
      LOCAL (temp _a1 (Vint (Int.repr (fib_of_Z (i + 1))));
             temp _a0 (Vint (Int.repr (fib_of_Z i)));
             temp _n (Vint (Int.repr (n - i))))
-     SEP ()))%assert
+     SEP ()))
   break:
     (PROP ()
      LOCAL (temp _a0 (Vint (Int.repr (fib_of_Z n))))
-     SEP ())%assert.
+     SEP ()).
   { (* Prove that the precon implies the loop invariant *)
     Exists 0.
     entailer!.
diff --git a/progs/verif_field_loadstore.v b/progs/verif_field_loadstore.v
index 26aee3397a..bcff7e733a 100644
--- a/progs/verif_field_loadstore.v
+++ b/progs/verif_field_loadstore.v
@@ -1,11 +1,10 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.field_loadstore.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
-Local Open Scope logic.
-
 Definition t_struct_b := Tstruct _b noattr.
 
 Definition sub_spec (sub_id: ident) :=
diff --git a/progs/verif_float.v b/progs/verif_float.v
index 285093de44..0987d69b29 100644
--- a/progs/verif_float.v
+++ b/progs/verif_float.v
@@ -1,11 +1,10 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.float.
 
 #[export] Instance CompSpecs : compspecs.
 Proof. make_compspecs prog. Defined.
 
-Local Open Scope logic.
-
 Definition main_spec :=
  DECLARE _main
   WITH gv: globals
diff --git a/progs/verif_floyd_tests.v b/progs/verif_floyd_tests.v
index cc8076847b..5586daf571 100644
--- a/progs/verif_floyd_tests.v
+++ b/progs/verif_floyd_tests.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.floyd_tests.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs.  mk_varspecs prog. Defined.
diff --git a/progs/verif_funcptr.v b/progs/verif_funcptr.v
index 807ae5eb9a..a18f386921 100644
--- a/progs/verif_funcptr.v
+++ b/progs/verif_funcptr.v
@@ -1,13 +1,13 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.funcptr.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
 Local Open Scope Z.
-Local Open Scope logic.
 
-Definition myspec :=
+Definition myspec : funspec :=
   WITH i: Z
   PRE [ tint ]
           PROP (Int.min_signed <= i < Int.max_signed)
diff --git a/progs/verif_global.v b/progs/verif_global.v
index 42db5abc3f..f66c2e1b76 100644
--- a/progs/verif_global.v
+++ b/progs/verif_global.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.global.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
@@ -38,5 +39,3 @@ rewrite data_at_tuint_tint.
 forward_call gv.
 forward.
 Qed.
-
-
diff --git a/progs/verif_incr.v b/progs/verif_incr.v
index a108632718..86f28bdcc5 100644
--- a/progs/verif_incr.v
+++ b/progs/verif_incr.v
@@ -1,126 +1,167 @@
 Require Import VST.concurrency.conclib.
 Require Import VST.concurrency.lock_specs.
+Require Import VST.atomics.SC_atomics.
 Require Import VST.atomics.verif_lock.
-Require Import VST.concurrency.ghosts.
+Require Import iris_ora.algebra.ext_order.
+Require Import iris.algebra.lib.excl_auth.
 Require Import VST.progs.incr.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
+Canonical Structure excl_authR A := inclR (excl_authR A).
+
+Section mpred.
+
+(* box up concurrentGS? *)
+Context `{!VSTGS unit Σ, !cinvG Σ, !inG Σ (excl_authR natO), !atomic_int_impl (Tstruct _atom_int noattr)}.
+#[local] Instance concurrent_ext_spec : ext_spec unit := concurrent_ext_spec _ (ext_link_prog prog).
+
 Definition spawn_spec := DECLARE _spawn spawn_spec.
 
 Definition t_counter := Tstruct _counter noattr.
 
-Definition cptr_lock_inv g1 g2 ctr := EX z : Z, field_at Ews t_counter [StructField _ctr] (Vint (Int.repr z)) ctr *
-  EX x : Z, EX y : Z, !!(z = x + y) && ghost_var gsh1 x g1 * ghost_var gsh1 y g2.
+Definition ghost_auth (g : gname) (n : nat) : mpred := own g (●E n : excl_authR natO).
+Definition ghost_frag (g : gname) (n : nat) : mpred := own g (◯E n : excl_authR natO).
+
+Definition cptr_lock_inv (g1 g2 : gname) (ctr : val) := ∃ z : nat, field_at Ews t_counter [StructField _ctr] (Vint (Int.repr z)) ctr ∗
+  ∃ x : nat, ∃ y : nat, ⌜(z = x + y)%nat⌝ ∧ ghost_auth g1 x ∗ ghost_auth g2 y.
 
 Definition incr_spec :=
  DECLARE _incr
-  WITH sh1 : share, sh : share, h : lock_handle, g1 : gname, g2 : gname, left : bool, n : Z, gv: globals
+  WITH sh1 : share, sh : Qp, h : lock_handle, g1 : gname, g2 : gname, left : bool, n : nat, gv: globals
   PRE [ ]
          PROP  (readable_share sh1)
          PARAMS () GLOBALS (gv)
-         SEP   (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c); lock_inv sh h (cptr_lock_inv g1 g2 (gv _c)); ghost_var gsh2 n (if left then g1 else g2))
+         SEP   (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c); lock_inv sh h (cptr_lock_inv g1 g2 (gv _c)); ghost_frag (if left then g1 else g2) n)
   POST [ tvoid ]
          PROP ()
          LOCAL ()
-         SEP (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c); lock_inv sh h (cptr_lock_inv g1 g2 (gv _c)); ghost_var gsh2 (n+1) (if left then g1 else g2)).
+         SEP (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c); lock_inv sh h (cptr_lock_inv g1 g2 (gv _c)); ghost_frag (if left then g1 else g2) (n+1)%nat).
 
 Definition read_spec :=
  DECLARE _read
-  WITH sh1 : share, sh : share, h : lock_handle, g1 : gname, g2 : gname, n1 : Z, n2 : Z, gv: globals
+  WITH sh1 : share, sh : Qp, h : lock_handle, g1 : gname, g2 : gname, n1 : nat, n2 : nat, gv: globals
   PRE [ ]
          PROP  (readable_share sh1)
          PARAMS () GLOBALS (gv)
-         SEP   (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c); lock_inv sh h (cptr_lock_inv g1 g2 (gv _c)); ghost_var gsh2 n1 g1; ghost_var gsh2 n2 g2)
+         SEP   (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c); lock_inv sh h (cptr_lock_inv g1 g2 (gv _c)); ghost_frag g1 n1; ghost_frag g2 n2)
   POST [ tuint ]
          PROP ()
-         RETURN (Vint (Int.repr (n1 + n2)))
-         SEP (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c); lock_inv sh h (cptr_lock_inv g1 g2 (gv _c)); ghost_var gsh2 n1 g1; ghost_var gsh2 n2 g2).
+         RETURN (Vint (Int.repr (n1 + n2)%nat))
+         SEP (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c); lock_inv sh h (cptr_lock_inv g1 g2 (gv _c)); ghost_frag g1 n1; ghost_frag g2 n2).
 
-Definition thread_lock_R sh1 sh h g1 g2 ctr :=
-  field_at sh1 t_counter [StructField _lock] (ptr_of h) ctr * lock_inv sh h (cptr_lock_inv g1 g2 ctr) * ghost_var gsh2 1 g1.
+Definition thread_lock_R sh1 (sh : Qp) h (g1 g2 : gname) (ctr : val) :=
+  field_at sh1 t_counter [StructField _lock] (ptr_of h) ctr ∗ lock_inv sh h (cptr_lock_inv g1 g2 ctr) ∗ ghost_frag g1 1.
 
 Definition thread_lock_inv sh1 sh h g1 g2 ctr ht :=
-  self_part sh ht * thread_lock_R sh1 sh h g1 g2 ctr.
+  self_part sh ht ∗ thread_lock_R sh1 sh h g1 g2 ctr.
 
 Definition thread_func_spec :=
  DECLARE _thread_func
-  WITH y : val, x : share * share * lock_handle * lock_handle * gname * gname * globals
+  WITH y : val, x : share * Qp * lock_handle * lock_handle * gname * gname * globals
   PRE [ tptr tvoid ]
          let '(sh1, sh, h, ht, g1, g2, gv) := x in
          PROP  (readable_share sh1; ptr_of ht = y)
          PARAMS (y) GLOBALS (gv)
          SEP   (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c);
                 lock_inv sh h (cptr_lock_inv g1 g2 (gv _c));
-                ghost_var gsh2 0 g1;
+                ghost_frag g1 0;
                 lock_inv sh ht (thread_lock_inv sh1 sh h g1 g2 (gv _c) ht))
   POST [ tint ]
          PROP ()
          RETURN (Vint Int.zero)
          SEP ().
 
+Definition compute2_spec :=
+ DECLARE _compute2
+ WITH gv: globals
+ PRE [] PROP() PARAMS() GLOBALS(gv)
+          SEP(library.mem_mgr gv;
+                data_at Ews t_counter (Vint (Int.repr 0), Vundef) (gv _c);
+                has_ext tt)
+ POST [ tint ] PROP() RETURN (Vint (Int.repr 2)) 
+                    SEP(library.mem_mgr gv; data_at_ Ews t_counter (gv _c); has_ext tt).
+
 Definition main_spec :=
  DECLARE _main
   WITH gv : globals
   PRE  [] main_pre prog tt gv
   POST [ tint ] main_post prog gv.
 
-Definition Gprog : funspecs :=   ltac:(with_library prog [acquire_spec; release_spec; makelock_spec; freelock_spec;
-  spawn_spec; incr_spec; read_spec; thread_func_spec; main_spec]).
+Definition Gprog : funspecs := ltac:(with_library prog [acquire_spec; release_spec; makelock_spec; freelock_spec;
+  spawn_spec; incr_spec; read_spec; thread_func_spec; compute2_spec; main_spec]).
 
 Lemma ctr_inv_exclusive : forall g1 g2 p,
   exclusive_mpred (cptr_lock_inv g1 g2 p).
 Proof.
   intros; unfold cptr_lock_inv.
-  eapply derives_exclusive, exclusive_sepcon1 with (Q := EX x : Z, EX y : Z, _),
-    field_at__exclusive with (sh := Ews)(t := t_counter); auto; simpl.
-  Intro z; apply sepcon_derives; [cancel|].
-  Intros x y; Exists x y; apply derives_refl.
+  iIntros "((% & ? & ?) & (% & ? & ?))".
+  rewrite !field_at_field_at_; iApply (field_at__conflict with "[$]"); auto.
   { simpl; lia. }
 Qed.
-#[export] Hint Resolve ctr_inv_exclusive : core.
+#[local] Hint Resolve ctr_inv_exclusive : core.
+
+Lemma thread_inv_exclusive : forall sh1 sh h g1 g2 p,
+  exclusive_mpred (thread_lock_R sh1 sh h g1 g2 p).
+Proof.
+  intros; unfold thread_lock_R.
+  iIntros "((? & ? & g1) & (? & ? & g2))".
+  iDestruct (own_valid_2 with "g1 g2") as %[]%@excl_auth_frag_op_valid.
+Qed.
+#[local] Hint Resolve thread_inv_exclusive : core.
+
+Lemma ghost_var_inj : forall g x y, ghost_auth g x ∗ ghost_frag g y ⊢ ⌜x = y⌝.
+Proof.
+  intros; iIntros "(a & f)".
+  iDestruct (own_valid_2 with "a f") as %H%@excl_auth_agree; done.
+Qed.
 
-Lemma ghost_var_incr : forall g1 g2 x y n (left : bool), ghost_var gsh1 x g1 * ghost_var gsh1 y g2 * ghost_var gsh2 n (if left then g1 else g2) |--
-  |==> !!((if left then x else y) = n) && ghost_var gsh1 (n+1) (if left then g1 else g2) * ghost_var gsh2 (n+1) (if left then g1 else g2) * ghost_var gsh1 (if left then y else x) (if left then g2 else g1).
+Lemma ghost_var_incr : forall g1 g2 x y n (left : bool), ghost_auth g1 x ∗ ghost_auth g2 y ∗ ghost_frag (if left then g1 else g2) n ⊢
+  |==> ⌜(if left then x else y) = n⌝ ∧ ghost_auth (if left then g1 else g2) (n+1)%nat ∗ ghost_frag (if left then g1 else g2) (n+1)%nat ∗
+       ghost_auth (if left then g2 else g1) (if left then y else x).
 Proof.
   destruct left.
-  - eapply derives_trans, bupd_frame_r; cancel.
-    rewrite sepcon_andp_prop'; apply ghost_var_update'.
-  - eapply derives_trans, bupd_frame_r; cancel.
-    rewrite sepcon_andp_prop'; apply ghost_var_update'.
+  - iIntros "(a & $ & f)".
+    iDestruct (ghost_var_inj with "[$a $f]") as %->.
+    iMod (own_update_2 with "a f") as "($ & $)"; last done.
+    apply @excl_auth_update.
+  - iIntros "($ & a & f)".
+    iDestruct (ghost_var_inj with "[$a $f]") as %->.
+    iMod (own_update_2 with "a f") as "($ & $)"; last done.
+    apply @excl_auth_update.
 Qed.
 
 Lemma body_incr: semax_body Vprog Gprog f_incr incr_spec.
 Proof.
   start_function.
   forward.
-  assert_PROP (sh <> Share.bot) by entailer!.
   forward_call (sh, h, cptr_lock_inv g1 g2 (gv _c)).
-  unfold cptr_lock_inv at 2. simpl.
+  unfold cptr_lock_inv at 2.
   Intros z x y.
   forward.
   forward.
 
-  gather_SEP (ghost_var _ x g1) (ghost_var _ y g2) (ghost_var _ n _).
-  rewrite sepcon_assoc.
-  viewshift_SEP 0 (!!((if left then x else y) = n) &&
-    ghost_var gsh1 (n+1) (if left then g1 else g2) *
-    ghost_var gsh2 (n+1) (if left then g1 else g2) *
-    ghost_var gsh1 (if left then y else x) (if left then g2 else g1)).
-  { go_lower.
-    eapply derives_trans, bupd_fupd.
-    rewrite <- sepcon_assoc; apply ghost_var_incr. }
+  gather_SEP (ghost_auth g1 x) (ghost_auth g2 y) (ghost_frag _ n).
+  viewshift_SEP 0 (⌜(if left then x else y) = n⌝ ∧
+    ghost_auth (if left then g1 else g2) (n+1)%nat ∗
+    ghost_frag (if left then g1 else g2) (n+1)%nat ∗
+    ghost_auth (if left then g2 else g1) (if left then y else x)).
+  { go_lowerx.
+    iIntros "(? & _)".
+    by iMod (ghost_var_incr with "[$]"). }
   Intros.
   forward.
   forward_call release_simple (sh, h, cptr_lock_inv g1 g2 (gv _c)).
   { lock_props.
-    unfold cptr_lock_inv; Exists (z + 1).
-    unfold Frame; instantiate (1 := [ghost_var gsh2 (n+1) (if left then g1 else g2);
+    unfold cptr_lock_inv; Exists (z + 1)%nat.
+    unfold Frame; instantiate (1 := [ghost_frag (if left then g1 else g2) (n+1)%nat;
       field_at sh1 t_counter (DOT _lock) (ptr_of h) (gv _c)]); simpl.
     destruct left.
-    - Exists (n+1) y; entailer!.
-    - Exists x (n+1); entailer!. }
+    - Exists (n+1)%nat y; subst; entailer!.
+      rewrite !Nat2Z.inj_add //.
+    - Exists x (n+1)%nat; entailer!.
+      rewrite !Nat2Z.inj_add //. }
   forward.
   cancel.
 Qed.
@@ -129,20 +170,20 @@ Lemma body_read : semax_body Vprog Gprog f_read read_spec.
 Proof.
   start_function.
   forward.
-  assert_PROP (sh <> Share.bot) by entailer!.
   forward_call (sh, h, cptr_lock_inv g1 g2 (gv _c)).
   unfold cptr_lock_inv at 2; simpl.
   Intros z x y.
   forward.
   assert_PROP (x = n1 /\ y = n2) as Heq.
-  { sep_apply (ghost_var_inj gsh1 gsh2 x); auto.
-    sep_apply (ghost_var_inj gsh1 gsh2 y); auto.
+  { sep_apply ghost_var_inj.
+    sep_apply (ghost_var_inj g2).
     entailer!. }
   forward.
   forward_call release_simple (sh, h, cptr_lock_inv g1 g2 (gv _c)).
   { lock_props.
     unfold cptr_lock_inv; Exists z x y; entailer!. }
-  destruct Heq; forward; cancel.
+  destruct Heq as [-> ->]; forward.
+  entailer!.
 Qed.
 
 Lemma body_thread_func : semax_body Vprog Gprog f_thread_func thread_func_spec.
@@ -151,72 +192,91 @@ Proof.
   forward_call (sh1, sh, h, g1, g2, true, 0, gv).
   simpl.
   forward_call release_self (sh, ht, thread_lock_R sh1 sh h g1 g2 (gv _c)).
-  { unfold thread_lock_inv, thread_lock_R; cancel. }
+  { lock_props.
+    unfold thread_lock_R at 2; unfold thread_lock_inv; cancel. }
   forward.
 Qed.
 
-Lemma body_main:  semax_body Vprog Gprog f_main main_spec.
+Lemma body_compute2:  semax_body Vprog Gprog f_compute2 compute2_spec.
 Proof.
   start_function.
   set (ctr := gv _c).
   forward.
-  ghost_alloc (ghost_var Tsh 0).
+  ghost_alloc (fun g => own g (●E O ⋅ ◯E O : excl_authR natO)).
+  { apply excl_auth_valid. }
   Intro g1.
-  ghost_alloc (ghost_var Tsh 0).
+  ghost_alloc (fun g => own g (●E O ⋅ ◯E O : excl_authR natO)).
+  { apply excl_auth_valid. }
   Intro g2.
-  sep_apply (library.create_mem_mgr gv).
   forward_call (gv, fun _ : lock_handle => cptr_lock_inv g1 g2 ctr).
   Intros lock.
   forward.
   forward.
-  forward_call release_simple (Tsh, lock, cptr_lock_inv g1 g2 ctr).
+  forward_call release_simple (1%Qp, lock, cptr_lock_inv g1 g2 ctr).
   { lock_props.
-    rewrite <- !(ghost_var_share_join gsh1 gsh2 Tsh) by auto with share.
-    unfold_data_at (data_at _ _ _ _).
-    unfold cptr_lock_inv; Exists 0 0 0; entailer!. }
+    rewrite !own_op /cptr_lock_inv /ghost_auth.
+    Exists O O O.
+    unfold_data_at (data_at _ _ _ _); entailer!. }
   (* need to split off shares for the locks here *)
   destruct split_Ews as (sh1 & sh2 & ? & ? & Hsh).
-  forward_call (gv, fun lockt => thread_lock_inv sh2 gsh2 lock g1 g2 ctr lockt).
+  forward_call (gv, fun lockt => thread_lock_inv sh2 (1/2)%Qp lock g1 g2 ctr lockt).
   Intros lockt.
   sep_apply lock_inv_isptr; Intros.
-  forward_spawn _thread_func (ptr_of lockt) (sh2, gsh2, lock, lockt, g1, g2, gv).
-  { erewrite <- lock_inv_share_join; try apply gsh1_gsh2_join; auto.
-    erewrite <- (lock_inv_share_join _ _ Tsh); try apply gsh1_gsh2_join; auto.
+  forward_spawn _thread_func (ptr_of lockt) (sh2, (1/2)%Qp, lock, lockt, g1, g2, gv).
+  { rewrite -{3}Qp.half_half -frac_op -lock_inv_share_join.
+    rewrite -{1}Qp.half_half -frac_op -lock_inv_share_join.
     erewrite <- field_at_share_join; try apply Hsh; auto.
     subst ctr; entailer!. }
   { simpl; auto. }
-  forward_call (sh1, gsh1, lock, g1, g2, false, 0, gv).
-  forward_call (gsh1, lockt, thread_lock_inv sh2 gsh2 lock g1 g2 (gv _c) lockt).
+  forward_call (sh1, (1/2)%Qp, lock, g1, g2, false, 0, gv).
+  forward_call ((1/2)%Qp, lockt, thread_lock_inv sh2 (1/2)%Qp lock g1 g2 (gv _c) lockt).
   unfold thread_lock_inv at 2; unfold thread_lock_R; Intros.
   simpl.
-  forward_call (sh1, gsh1, lock, g1, g2, 1, 1, gv).
+  forward_call (sh1, (1/2)%Qp, lock, g1, g2, 1, 1, gv).
   (* We've proved that t is 2! *)
   forward.
-  forward_call (gsh1, lock, cptr_lock_inv g1 g2 (gv _c)).
-  forward_call freelock_self (gsh1, gsh2, lockt, thread_lock_R sh2 gsh2 lock g1 g2 (gv _c)).
+  forward_call ((1/2)%Qp, lock, cptr_lock_inv g1 g2 (gv _c)).
+  forward_call freelock_self ((1/2)%Qp, (1/2)%Qp, lockt, thread_lock_R sh2 (1/2) lock g1 g2 (gv _c)).
   { unfold thread_lock_inv, selflock; cancel. }
+  { rewrite frac_op Qp.half_half //. }
   forward.
   forward_call freelock_simple (lock, cptr_lock_inv g1 g2 (gv _c)).
   { lock_props.
-    erewrite <- (lock_inv_share_join _ _ Tsh); try apply gsh1_gsh2_join; auto; subst ctr; cancel. }
+    rewrite -{2}Qp.half_half -frac_op -lock_inv_share_join.
+    subst ctr; cancel. }
   forward.
+  unfold_data_at (data_at_ _ _ _). simpl.
+  cancel.
+  unfold cptr_lock_inv; Intros z x y; cancel.
+  rewrite -(field_at_share_join _ _ Ews); [|eauto]; cancel.
+  by iIntros "(_ & _ & _ & _)".
 Qed.
 
-Definition extlink := ext_link_prog prog.
-Definition Espec := add_funspecs (Concurrent_Espec unit _ extlink) extlink Gprog.
-#[export] Existing Instance Espec.
+Lemma body_main:  semax_body Vprog Gprog f_main main_spec.
+Proof.
+  start_function.
+  sep_apply (library.create_mem_mgr gv).
+  forward_call.
+  { rewrite zero_val_eq.
+    repeat change (fold_reptype ?a) with a.
+    repeat unfold_data_at (data_at _ _ _ _); simpl.
+    rewrite zero_val_eq; cancel. }
+  forward.
+Qed.
 
 Lemma prog_correct:
   semax_prog prog tt Vprog Gprog.
 Proof.
 prove_semax_prog.
-repeat (apply semax_func_cons_ext_vacuous; [reflexivity | reflexivity | ]).
 semax_func_cons_ext.
 { simpl.
+  destruct x; simpl.
+  monPred.unseal.
   Intros h.
-  unfold PROPx, LOCALx, SEPx, local, lift1; simpl; unfold liftx; simpl; unfold lift; Intros.
+  unfold PROPx, LOCALx, SEPx, local, lift1; simpl; unfold liftx; simpl; unfold lift.
+  monPred.unseal; Intros.
   destruct ret; unfold eval_id in H0; simpl in H0; subst; simpl; [|contradiction].
-  saturate_local; apply prop_right; auto. }
+  saturate_local; auto. }
 semax_func_cons_ext.
 semax_func_cons_ext.
 semax_func_cons_ext.
@@ -224,5 +284,8 @@ semax_func_cons_ext.
 semax_func_cons body_incr.
 semax_func_cons body_read.
 semax_func_cons body_thread_func.
+semax_func_cons body_compute2.
 semax_func_cons body_main.
 Qed.
+
+End mpred.
diff --git a/progs/verif_incr_atomic.v b/progs/verif_incr_atomic.v
index 32b1f07fd5..7f85f46400 100644
--- a/progs/verif_incr_atomic.v
+++ b/progs/verif_incr_atomic.v
@@ -1,21 +1,33 @@
 Require Import VST.concurrency.conclib.
 Require Import VST.atomics.verif_lock_atomic.
-Require Import VST.concurrency.ghostsI.
+Require Import iris_ora.algebra.ext_order.
+Require Import iris.algebra.lib.excl_auth.
 Require Import VST.progs.incr.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
+Canonical Structure excl_authR A := inclR (excl_authR A).
+
+Section mpred.
+
+(* box up concurrentGS? *)
+Context `{!VSTGS unit Σ, !cinvG Σ, !inG Σ (excl_authR natO), !atomic_int_impl (Tstruct _atom_int noattr)}.
+#[local] Instance concurrent_ext_spec : ext_spec unit := concurrent_ext_spec _ (ext_link_prog prog).
+
 Definition spawn_spec := DECLARE _spawn spawn_spec.
 
 Definition t_counter := Tstruct _counter noattr.
 
-Definition ctr_inv gv g := EX n : nat, field_at Ews t_counter [StructField _ctr] (vint (Z.of_nat n)) (gv _c) * ghost_var gsh2 n g.
-Definition ctr_state gv l g (n : nat) := ghost_var gsh1 n g * inv_for_lock l (ctr_inv gv g).
+Definition ghost_auth (g : gname) (n : nat) : mpred := own g (●E n : excl_authR natO).
+Definition ghost_frag (g : gname) (n : nat) : mpred := own g (◯E n : excl_authR natO).
+
+Definition ctr_inv gv g := ∃ n : nat, field_at Ews t_counter [StructField _ctr] (vint (Z.of_nat n)) (gv _c) ∗ ghost_auth g n.
+Definition ctr_state gv l g (n : nat) := ghost_frag g n ∗ inv_for_lock l (ctr_inv gv g).
 
 Program Definition incr_spec :=
  DECLARE _incr
-  ATOMIC TYPE (rmaps.ConstType (share * val * gname * globals)) OBJ n INVS ∅
+  ATOMIC TYPE (ConstType (share * val * gname * globals)) OBJ n INVS ∅
   WITH sh, l, g, gv
   PRE [ ]
          PROP  (readable_share sh; isptr l)
@@ -28,39 +40,49 @@ Program Definition incr_spec :=
 
 Program Definition read_spec :=
  DECLARE _read
-  ATOMIC TYPE (rmaps.ConstType (share * val * gname * globals)) OBJ n INVS ∅
+  ATOMIC TYPE (ConstType (share * val * gname * globals)) OBJ n INVS ∅
   WITH sh, l, g, gv
   PRE [ ]
          PROP  (readable_share sh; isptr l)
          PARAMS () GLOBALS (gv)
          SEP   (field_at sh t_counter [StructField _lock] l (gv _c)) | (ctr_state gv l g n)
   POST [ tuint ]
-    EX n' : nat,
+    ∃ n' : nat,
          PROP ()
          LOCAL (temp ret_temp (vint (Z.of_nat n')))
-         SEP (field_at sh t_counter [StructField _lock] l (gv _c)) | (!!(n' = n) && ctr_state gv l g n).
+         SEP (field_at sh t_counter [StructField _lock] l (gv _c)) | (⌜n' = n⌝ ∧ ctr_state gv l g n).
 
 Definition cptr_inv g g1 g2 :=
-  EX x y : nat, ghost_var gsh1 x g1 * ghost_var gsh1 y g2 * ghost_var gsh1 (x + y)%nat g.
+  ∃ x y : nat, ghost_auth g1 x ∗ ghost_auth g2 y ∗ ghost_frag g (x + y)%nat.
 
-Definition thread_lock_R sh1 sh gv l g g1 := lock_inv sh l (ctr_inv gv g) * field_at sh1 t_counter [StructField _lock] (ptr_of l) (gv _c) * ghost_var gsh2 1%nat g1.
+Definition thread_lock_R sh1 sh gv l g g1 := lock_inv sh l (ctr_inv gv g) ∗ field_at sh1 t_counter [StructField _lock] (ptr_of l) (gv _c) ∗ ghost_frag g1 1%nat.
 
 Definition thread_lock_inv sh1 sh gv l g g1 lockt := selflock (thread_lock_R sh1 sh gv l g g1) sh lockt.
 
 Definition thread_func_spec :=
  DECLARE _thread_func
-  WITH y : val, x : namespace * share * share * lock_handle * lock_handle * gname * gname * gname * globals
+  WITH y : val, x : namespace * share * Qp * lock_handle * lock_handle * gname * gname * gname * globals
   PRE [ tptr tvoid ]
          let '(i, sh1, sh, l, ht, g, g1, g2, gv) := x in
          PROP  (readable_share sh1; ptr_of ht = y; i ## name_of l)
          PARAMS (y) GLOBALS (gv)
          SEP   (inv i (cptr_inv g g1 g2); lock_inv sh l (ctr_inv gv g); field_at sh1 t_counter [StructField _lock] (ptr_of l) (gv _c);
-                ghost_var gsh2 O g1; lock_inv sh ht (thread_lock_inv sh1 sh gv l g g1 ht))
+                ghost_frag g1 O; lock_inv sh ht (thread_lock_inv sh1 sh gv l g g1 ht))
   POST [ tint ]
          PROP ()
          RETURN (Vint Int.zero)
          SEP ().
 
+Definition compute2_spec :=
+ DECLARE _compute2
+ WITH gv: globals
+ PRE [] PROP() PARAMS() GLOBALS(gv)
+          SEP(library.mem_mgr gv;
+                data_at Ews t_counter (Vint (Int.repr 0), Vundef) (gv _c);
+                has_ext tt)
+ POST [ tint ] PROP() RETURN (Vint (Int.repr 2)) 
+                    SEP(library.mem_mgr gv; data_at_ Ews t_counter (gv _c); has_ext tt).
+
 Definition main_spec :=
  DECLARE _main
   WITH gv : globals
@@ -68,40 +90,71 @@ Definition main_spec :=
   POST [ tint ] main_post prog gv.
 
 Definition Gprog : funspecs :=   ltac:(with_library prog [acquire_spec; release_spec; makelock_spec;
-  freelock_spec; spawn_spec; incr_spec; read_spec; thread_func_spec; main_spec]).
+  freelock_spec; spawn_spec; incr_spec; read_spec; thread_func_spec; compute2_spec; main_spec]).
 
 Lemma ctr_inv_exclusive : forall gv g, exclusive_mpred (ctr_inv gv g).
 Proof.
   intros; unfold ctr_inv.
-  eapply derives_exclusive, exclusive_sepcon1 with (Q := EX n : nat, _),
+  eapply derives_exclusive, exclusive_sepcon1 with (Q := ∃ n : nat, _),
     field_at__exclusive with (sh := Ews)(t := t_counter); auto; simpl; try lia.
-  Intro n; apply sepcon_derives; [cancel|].
+  Intro n; apply bi.sep_mono; [cancel|].
   Exists n; apply derives_refl.
   { simpl; lia. }
 Qed.
 #[local] Hint Resolve ctr_inv_exclusive : core.
 
+(* up *)
+Lemma ghost_var_inj : forall g x y, ghost_auth g x ∗ ghost_frag g y ⊢ ⌜x = y⌝.
+Proof.
+  intros; iIntros "(a & f)".
+  iDestruct (own_valid_2 with "a f") as %H%@excl_auth_agree; done.
+Qed.
+
+Lemma ghost_var_update' : forall g a b c,
+  ghost_frag g a ∗ ghost_auth g b ==∗ ⌜a = b⌝ ∧ ghost_frag g c ∗ ghost_auth g c.
+Proof.
+  intros.
+  iIntros "(f & a)".
+  iDestruct (ghost_var_inj with "[$a $f]") as %->.
+  iMod (own_update_2 with "a f") as "($ & $)"; last done.
+  apply @excl_auth_update.
+Qed.
+
+Lemma ghost_frag_excl : forall g, exclusive_mpred (ghost_frag g 1).
+Proof.
+  intros; iIntros "(g1 & g2)".
+  iDestruct (own_valid_2 with "g1 g2") as "%".
+  rewrite excl_auth_frag_op_valid // in H.
+Qed.
+
+Lemma thread_lock_exclusive : forall sh1 sh gv l g g1, exclusive_mpred (thread_lock_R sh1 sh gv l g g1).
+Proof.
+  intros; unfold thread_lock_R.
+  apply exclusive_sepcon2, exclusive_sepcon2, ghost_frag_excl.
+Qed.
+#[local] Hint Resolve thread_lock_exclusive : core.
+
 Lemma body_incr: semax_body Vprog Gprog f_incr incr_spec.
 Proof.
   start_function.
   forward.
   set (AS := atomic_shift _ _ _ _ _).
-  forward_call acquire_inv (l, ctr_inv gv g, AS).
-  { apply sepcon_derives; [|cancel].
+  forward_call acquire_inv (l, ctr_inv gv g, AS). (* need to patch to simplify rev_curry/tcurry? *)
+  { apply bi.sep_mono; [|cancel].
     unfold atomic_shift; iIntros "AU"; iAuIntro; unfold atomic_acc; simpl.
     iMod "AU" as (n) "[ctr_state Hclose]"; unfold ctr_state at 1.
     iExists tt; iDestruct "ctr_state" as "[g $]".
     iModIntro; iSplit.
     { (* tactic? *)
       iIntros "l"; iApply "Hclose"; iFrame. }
-    iIntros (_) "[inv _]".
+    iIntros (?) "[inv _]".
     iApply "Hclose"; iFrame. }
-  unfold ctr_inv; Intros n.
+  simpl; unfold ctr_inv; Intros n.
   forward.
   forward.
   forward.
   forward_call release_inv (l, ctr_inv gv g, Q).
-  { apply sepcon_derives; [|cancel].
+  { rewrite assoc assoc; apply bi.sep_mono; [|cancel].
     lock_props.
     unfold atomic_shift; iIntros "((AU & ctr) & g)"; iAuIntro; unfold atomic_acc; simpl.
     iMod "AU" as (n') "[ctr_state Hclose]"; unfold ctr_state at 1.
@@ -117,10 +170,10 @@ Proof.
       iMod (ghost_var_update' with "[$g1 $g2]") as "(% & g1 & $)"; subst.
       rewrite Nat2Z.inj_add; iFrame "f".
       iApply "Hclose"; iFrame. }
-    iIntros (_) "[l _]".
+    iIntros (?) "[l _]".
     iDestruct "Hclose" as "[_ Hclose]"; iApply ("Hclose" $! tt); simpl.
-    rewrite sepcon_emp; unfold ctr_state; iFrame. }
-  entailer!.
+    unfold ctr_state; iFrame. }
+  simpl; entailer!.
 Qed.
 
 Lemma body_read : semax_body Vprog Gprog f_read read_spec.
@@ -129,20 +182,20 @@ Proof.
   forward.
   set (AS := atomic_shift _ _ _ _ _).
   forward_call acquire_inv (l, ctr_inv gv g, AS).
-  { apply sepcon_derives; [|cancel].
+  { apply bi.sep_mono; [|cancel].
     unfold atomic_shift; iIntros "AU"; iAuIntro; unfold atomic_acc; simpl.
     iMod "AU" as (n) "[ctr_state Hclose]"; unfold ctr_state at 1.
     iExists tt; iDestruct "ctr_state" as "[g $]".
     iModIntro; iSplit.
     { (* tactic? *)
       iIntros "l"; iApply "Hclose"; iFrame. }
-    iIntros (_) "[inv _]".
+    iIntros (?) "[inv _]".
     iApply "Hclose"; iFrame. }
-  unfold ctr_inv; Intros n.
+  simpl; unfold ctr_inv; Intros n.
   forward.
   forward.
   forward_call release_inv (l, ctr_inv gv g, Q n).
-  { apply sepcon_derives; [|cancel].
+  { rewrite assoc assoc; apply bi.sep_mono; [|cancel].
     lock_props.
     unfold atomic_shift; iIntros "((AU & ctr) & g)"; iAuIntro; unfold atomic_acc; simpl.
     iMod "AU" as (n') "[ctr_state Hclose]"; unfold ctr_state at 1.
@@ -155,18 +208,20 @@ Proof.
       iDestruct "inv" as (?) "[f g2]".
       iDestruct (ghost_var_inj with "[$g' $g2]") as %?; auto; subst.
       iFrame "f g2"; iApply "Hclose"; iFrame. }
-    iIntros (_) "[l _]".
+    iIntros (?) "[l _]".
     iDestruct "Hclose" as "[_ Hclose]"; iApply "Hclose"; simpl.
-    rewrite sepcon_emp; iSplit; auto.
+    iSplit; auto; iSplit; auto.
     unfold ctr_state; iFrame. }
-  forward.
-  Exists n; entailer!.
+  simpl. forward.
+  Exists n; entailer!!.
 Qed.
 
 #[local] Instance ctr_inv_timeless : forall gv g, Timeless (ctr_inv gv g).
 Proof.
   intros; unfold ctr_inv.
-  apply bi.exist_timeless; intros []; apply _.
+  apply bi.exist_timeless; intros.
+  apply bi.sep_timeless; try apply _.
+  apply bi.and_timeless; apply _.
 Qed.
 
 (* In this client, the ctr_state is assembled from the combination of the counter's lock assertion
@@ -175,19 +230,19 @@ Qed.
 
 (* prove a lemma about our specific use pattern of incr *)
 Lemma incr_inv_shift : forall i gv sh g l g1 g2 gvar, (gvar = g1 \/ gvar = g2) -> i ## name_of l ->
-  lock_inv sh l (ctr_inv gv g) * inv i (cptr_inv g g1 g2) * ghost_var gsh2 0%nat gvar |--
+  lock_inv sh l (ctr_inv gv g) ∗ inv i (cptr_inv g g1 g2) ∗ ghost_frag gvar 0%nat ⊢
   atomic_shift (λ n : nat, ctr_state gv (ptr_of l) g n) (⊤ ∖ ∅) ∅
-      (λ (n : nat) (_ : ()), fold_right_sepcon [ctr_state gv (ptr_of l) g (n + 1)%nat]) (λ _ : (), lock_inv sh l (ctr_inv gv g) * ghost_var gsh2 1%nat gvar).
+      (λ (n : nat) (_ : ()), fold_right_sepcon [ctr_state gv (ptr_of l) g (n + 1)%nat]) (λ _ : (), lock_inv sh l (ctr_inv gv g) ∗ ghost_frag gvar 1%nat).
 Proof.
   intros.
-  unfold_lock_inv; Intros.
-  rewrite -> prop_true_andp by auto.
-  iIntros "[[[#inv0 sh] #inv] g]".
+  unfold_lock_inv. unfold atomic_lock_inv. Intros.
+  iIntros "([#inv0 sh] & #inv & g)".
   unfold atomic_shift; iAuIntro; rewrite /atomic_acc /=.
-  iMod (into_acc_cinv with "inv0 sh") as (_) "[[>i sh] Hclose0]". done.
-  iInv "inv" as (x y) ">[[g1 g2] c]" "Hclose"; auto.
+  iMod (into_acc_cinv with "inv0 sh") as (_) "[[>i sh] Hclose0]"; first done.
+  iInv "inv" as (x y) ">(g1 & g2 & c)" "Hclose"; auto.
   unfold ctr_state at 1.
   iExists (x + y)%nat; iFrame "c i sh inv0".
+  iFrame "%".
   iApply fupd_mask_intro; first by set_solver. iIntros "mask"; iSplit.
   - iIntros "[g' c]". iFrame "g".
     iMod "mask"; iMod ("Hclose" with "[g1 g2 g']").
@@ -195,12 +250,12 @@ Proof.
     iApply "Hclose0"; auto.
   - iIntros (_) "([g' c] & _)".
     destruct H; subst.
-    + iMod (ghost_var_update' with "[$g1 $g]") as "(% & g1 & $)"; subst.
+    + iMod (ghost_var_update' with "[$g1 $g]") as "(% & $ & g1)"; subst.
       iMod "mask"; iMod ("Hclose" with "[g1 g2 g']").
       { iExists 1%nat, y; iFrame; auto.
         rewrite Nat.add_0_l Nat.add_comm; auto. }
       iApply "Hclose0"; auto.
-    + iMod (ghost_var_update' with "[$g2 $g]") as "(% & g2 & $)"; subst.
+    + iMod (ghost_var_update' with "[$g2 $g]") as "(% & $ & g2)"; subst.
       iMod "mask"; iMod ("Hclose" with "[g1 g2 g']").
       { iExists x, 1%nat; iFrame; auto.
         rewrite Nat.add_0_r; auto. }
@@ -211,24 +266,37 @@ Lemma body_thread_func : semax_body Vprog Gprog f_thread_func thread_func_spec.
 Proof.
   start_function.
   sep_apply lock_inv_isptr; Intros.
-  forward_call (sh1, ptr_of l, g, gv, lock_inv sh l (ctr_inv gv g) * ghost_var gsh2 1%nat g1).
-  { sep_apply incr_inv_shift; auto; cancel. }
+  forward_call (sh1, ptr_of l, g, gv, lock_inv sh l (ctr_inv gv g) ∗ ghost_frag g1 1%nat); simpl.
+  { rewrite /rev_curry /=. sep_apply incr_inv_shift; auto; simpl; cancel. }
+  { auto. }
   forward_call release_self (sh, ht, thread_lock_R sh1 sh gv l g g1).
-  { unfold thread_lock_inv, thread_lock_R; cancel. }
+  { lock_props.
+    unfold thread_lock_inv, selflock; cancel.
+    unfold thread_lock_R; cancel. }
   forward.
 Qed.
 
-Lemma body_main : semax_body Vprog Gprog f_main main_spec.
+(* up *)
+Lemma ghost_auth_frag : forall g a b, own g (●E a ⋅ ◯E b : excl_authR natO) ⊣⊢ ghost_auth g a ∗ ghost_frag g b.
+Proof.
+  intros; rewrite own_op //.
+Qed.
+
+Opaque Qp.div.
+
+Lemma body_compute2 : semax_body Vprog Gprog f_compute2 compute2_spec.
 Proof.
   start_function.
   forward.
-  ghost_alloc (ghost_var Tsh O).
+  ghost_alloc (fun g => own g (●E O ⋅ ◯E O : excl_authR natO)).
+  { apply excl_auth_valid. }
   Intro g1.
-  ghost_alloc (ghost_var Tsh O).
+  ghost_alloc (fun g => own g (●E O ⋅ ◯E O : excl_authR natO)).
+  { apply excl_auth_valid. }
   Intro g2.
-  ghost_alloc (ghost_var Tsh O).
+  ghost_alloc (fun g => own g (●E O ⋅ ◯E O : excl_authR natO)).
+  { apply excl_auth_valid. }
   Intro g.
-  sep_apply (library.create_mem_mgr gv).
   (* We allocate the lock here, but give it an invariant later. *)
   forward_call (gv).
   Intros lockp.
@@ -238,100 +306,107 @@ Proof.
   forward_call release_nonatomic (lockp).
   (* make lock invariant *)
   unfold_data_at (data_at _ _ _ (gv _c)).
-  rewrite <- 3(ghost_var_share_join gsh1 gsh2 Tsh) by auto with share; Intros.
-  gather_SEP (atomic_int_at _ _ lockp) (field_at _ _ [StructField _ctr] _ _) (ghost_var gsh2 _ g);
-    viewshift_SEP 0 (EX lock, !!(ptr_of lock = lockp /\ name_of lock = nroot .@ "ctr") && lock_inv Tsh lock (ctr_inv gv g)).
-  { go_lower; eapply derives_trans, make_lock_inv_0.
+  rewrite !ghost_auth_frag; Intros.
+  gather_SEP (atomic_int_at _ _ lockp) (field_at _ _ [StructField _ctr] _ _) (ghost_auth g _);
+    viewshift_SEP 0 (∃ lock, ⌜ptr_of lock = lockp /\ name_of lock = nroot .@ "ctr"⌝ ∧ lock_inv 1 lock (ctr_inv gv g)).
+  { go_lowerx; eapply derives_trans, make_lock_inv_0.
     unfold ctr_inv; Exists O; cancel. }
   Intros lock.
   (* need to split off shares for the locks here *)
   destruct split_Ews as (sh1 & sh2 & ? & ? & Hsh).
-  forward_call makelock_inv (gv, nroot .@ "tlock", fun lockt => thread_lock_inv sh2 gsh2 gv lock g g1 lockt).
+  forward_call makelock_inv (gv, nroot .@ "tlock", fun lockt => thread_lock_inv sh2 (1/2) gv lock g g1 lockt).
   Intros lockt.
-  match goal with |-context[|={⊤}=> ?P] => viewshift_SEP 1 P by entailer! end.
+  match goal with |-context[|={⊤}=> ?P] => viewshift_SEP 1 P by (go_lowerx; entailer!) end.
   Intros ht.
   sep_apply lock_inv_isptr; Intros.
-  gather_SEP (ghost_var gsh1 _ g) (ghost_var gsh1 _ g1) (ghost_var gsh1 _ g2).
+  gather_SEP (ghost_frag g _) (ghost_auth g1 _) (ghost_auth g2 _).
   viewshift_SEP 0 (inv (nroot .@ "ctr_inv") (cptr_inv g g1 g2)).
-  { go_lower.
-    eapply derives_trans, inv_alloc.
-    eapply derives_trans, now_later.
+  { go_lowerx.
+    iIntros "((? & ? & ?) & _)"; iApply inv_alloc.
     unfold cptr_inv.
-    Exists O O; simpl; cancel. }
-  rewrite invariant_dup; Intros.
+    by iExists O, O; iFrame. }
+  rewrite (bi.persistent_sep_dup (inv _ _)); Intros.
   assert (nroot.@"ctr_inv" ## name_of lock) by (rewrite H0; solve_ndisj).
-  forward_spawn _thread_func (ptr_of ht) (nroot .@ "ctr_inv", sh2, gsh2, lock, ht, g, g1, g2, gv).
+  forward_spawn _thread_func (ptr_of ht) (nroot .@ "ctr_inv", sh2, (1/2)%Qp, lock, ht, g, g1, g2, gv).
   { entailer!.
-    erewrite <- lock_inv_share_join; try apply gsh1_gsh2_join; auto.
-    erewrite <- (lock_inv_share_join _ _ Tsh); try apply gsh1_gsh2_join; auto.
+    rewrite -{1}Qp.half_half -frac_op -lock_inv_share_join.
+    rewrite -{5}Qp.half_half -frac_op -lock_inv_share_join.
     erewrite <- field_at_share_join; try apply Hsh; auto.
     cancel. }
   { simpl; auto. }
-  rewrite invariant_dup; Intros.
-  forward_call (sh1, ptr_of lock, g, gv, lock_inv gsh1 lock (ctr_inv gv g) * ghost_var gsh2 1%nat g2).
-  { sep_apply incr_inv_shift; auto; cancel. }
-  forward_call acquire_inv_simple (gsh1, ht, thread_lock_inv sh2 gsh2 gv lock g g1 ht).
-  unfold thread_lock_inv at 2; unfold thread_lock_R; rewrite -> 3later_sepcon; Intros.
-  forward_call (sh1, ptr_of lock, g, gv, fun n => !!(n = 2)%nat && lock_inv gsh1 lock (ctr_inv gv g) * ghost_var gsh2 1%nat g1).
-  { iIntros "((((((? & g1) & lock) & g2) & inv) & ?) & ?)"; iSplitL "g1 g2 inv lock"; [|iVST; cancel_frame].
-    unfold_lock_inv; iDestruct "lock" as "[[[% %] #inv0] sh]".
+  rewrite (bi.persistent_sep_dup (inv _ _)); Intros.
+  forward_call (sh1, ptr_of lock, g, gv, lock_inv (1/2) lock (ctr_inv gv g) ∗ ghost_frag g2 1%nat); simpl.
+  { rewrite /rev_curry /=. sep_apply incr_inv_shift; auto; simpl; cancel. }
+  { rewrite H //. }
+  forward_call acquire_inv_simple ((1/2)%Qp, ht, thread_lock_inv sh2 (1/2) gv lock g g1 ht).
+  unfold thread_lock_inv at 2; unfold thread_lock_R; rewrite !bi.later_sep; Intros.
+  forward_call (sh1, ptr_of lock, g, gv, fun n => ⌜n = 2⌝%nat ∧ lock_inv (1/2) lock (ctr_inv gv g) ∗ ghost_frag g1 1%nat ∗ ghost_frag g2 1%nat); simpl.
+  { iIntros "(? & ? & ? & ? & g1 & lock & g2 & inv & ?)"; iSplitL "g1 g2 inv lock"; [|iStopProof; cancel_frame].
+    unfold_lock_inv; iDestruct "lock" as "(% & #inv0 & sh)".
     iDestruct "inv" as "#inv".
+    unfold rev_curry; simpl.
     unfold atomic_shift; iAuIntro; rewrite /atomic_acc /=.
-    iMod (into_acc_cinv with "inv0 sh") as (_) "[[>i sh] Hclose0]". done.
-    iInv "inv" as (x y) ">[gs c]" "Hclose"; auto.
+    iMod (into_acc_cinv with "inv0 sh") as (_) "[[>i sh] Hclose0]"; first done.
+    iInv "inv" as (x y) ">(g1' & g2' & c)" "Hclose"; auto.
     iExists (x + y)%nat; iFrame "c i".
     iApply fupd_mask_intro; first set_solver.
     iFrame "sh".
     iIntros "mask"; iSplit.
     - unfold ctr_state. iIntros "[g i]".
-      iFrame "g1 g2"; iMod "mask"; iMod ("Hclose" with "[gs g]").
+      iFrame "g1 g2"; iMod "mask"; iMod ("Hclose" with "[g1' g2' g]").
       { iExists x, y; iFrame; auto. }
       iApply "Hclose0"; auto.
     - iIntros (z) "[[% [g i]] _]".
       iMod "mask" as "_".
-      iDestruct "gs" as "[g1' g2']".
-      iPoseProof (ghost_var_inj(A := nat) with "[$g1' $g1]") as "%"; auto with share; subst.
-      iPoseProof (ghost_var_inj(A := nat) with "[$g2' $g2]") as "%"; auto with share; subst.
-      iMod (ghost_var_update with "[g1' g1]") as "g1".
-      { rewrite <- (ghost_var_share_join gsh1 gsh2 Tsh) by auto with share; iFrame. }
-      iMod (ghost_var_update with "[g2' g2]") as "g2".
-      { rewrite <- (ghost_var_share_join gsh1 gsh2 Tsh) by auto with share; iFrame. }
-      rewrite <- (ghost_var_share_join gsh1 gsh2 Tsh) by auto with share.
+      iMod (ghost_var_update' with "[$g1' $g1]") as "(<- & $ & g1)".
+      iMod (ghost_var_update' with "[$g2' $g2]") as "(<- & $ & g2)".
       iFrame "inv0".
-      iDestruct "g1" as "[g1 $]".
-      rewrite <- (ghost_var_share_join gsh1 gsh2 Tsh) by auto with share.
-      iDestruct "g2" as "[g2 _]".
       iMod ("Hclose" with "[g1 g2 g]").
-      { iExists 1%nat, 1%nat; iFrame "g1 g2 g"; auto. }
+      { iExists 1%nat, 1%nat; iFrame; auto. }
       iMod ("Hclose0" with "i"); auto. }
   (* We've proved that t is 2! *)
+  { rewrite H //. }
   Intros v; subst.
   forward.
-  forward_call acquire_inv_simple (gsh1, lock, ctr_inv gv g).
+  forward_call acquire_inv_simple ((1/2)%Qp, lock, ctr_inv gv g).
   unfold thread_lock_inv.
-  forward_call freelock_self (gsh1, gsh2, ht, thread_lock_R sh2 gsh2 gv lock g g1).
+  forward_call freelock_self ((1/2)%Qp, (1/2)%Qp, ht, thread_lock_R sh2 (1/2) gv lock g g1).
+  { unfold selflock; cancel. }
+  { apply Qp.half_half. }
   forward.
   forward_call freelock_simple (lock, ctr_inv gv g).
   { lock_props.
-    erewrite <- (lock_inv_share_join gsh1 gsh2 Tsh); auto; cancel. }
+    rewrite -{3}Qp.half_half -frac_op -lock_inv_share_join; cancel. }
   forward.
+  unfold_data_at (data_at_ _ _ _). simpl.
+  cancel.
+  unfold ctr_inv; Intros n; cancel.
+  rewrite -(field_at_share_join _ _ Ews); [|eauto]; cancel.
+  by iIntros "(_ & _ & _)".
 Qed.
 
-Definition extlink := ext_link_prog prog.
-
-Definition Espec := add_funspecs (Concurrent_Espec unit _ extlink) extlink Gprog.
-#[export] Existing Instance Espec.
+Lemma body_main : semax_body Vprog Gprog f_main main_spec.
+Proof.
+  start_function.
+  sep_apply (library.create_mem_mgr gv).
+  forward_call.
+  { rewrite zero_val_eq.
+    repeat change (fold_reptype ?a) with a.
+    repeat unfold_data_at (data_at _ _ _ _); simpl.
+    rewrite zero_val_eq; cancel. }
+  forward.
+Qed.
 
 Lemma prog_correct:
   semax_prog prog tt Vprog Gprog.
 Proof.
 prove_semax_prog.
-repeat (apply semax_func_cons_ext_vacuous; [reflexivity | reflexivity | ]).
 semax_func_cons_ext.
-{ simpl; Intros p; unfold PROPx, LOCALx, SEPx, local; simpl; unfold liftx, lift1, lift; simpl; Intros; subst.
-  sep_apply atomic_int_isptr; Intros.
-  destruct ret; try contradiction.
-  unfold eval_id in *; simpl in *; apply prop_right; auto. }
+{ monPred.unseal; Intros p.
+  unfold PROPx, LOCALx, SEPx, local, lift1; simpl; unfold liftx; simpl; unfold lift.
+  monPred.unseal; Intros.
+  destruct ret; unfold eval_id in H0; simpl in H0; subst; simpl; [|contradiction].
+  saturate_local; auto. }
 semax_func_cons_ext.
 semax_func_cons_ext.
 semax_func_cons_ext.
@@ -339,5 +414,8 @@ semax_func_cons_ext.
 semax_func_cons body_incr.
 semax_func_cons body_read.
 semax_func_cons body_thread_func.
+semax_func_cons body_compute2.
 semax_func_cons body_main.
 Qed.
+
+End mpred.
diff --git a/progs/verif_int_or_ptr.v b/progs/verif_int_or_ptr.v
index 1cf3f4975f..a452bbea50 100644
--- a/progs/verif_int_or_ptr.v
+++ b/progs/verif_int_or_ptr.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.int_or_ptr.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
@@ -22,7 +23,7 @@ Definition valid_int_or_ptr (x: val) :=
  | Vint i => Int.testbit i 0 = true
               \/ Int.unsigned i < POINTER_BOUNDARY
  | Vptr b z => Ptrofs.testbit z 0 = false
- | _ => False
+ | _ => False%type
  end.
 
 Lemma valid_int_or_ptr_ii1:
@@ -185,9 +186,8 @@ Proof.
  forward_call (Vint (Int.repr (i+i+1))).
  forward_if.
  - (* then clause *)
-   forward. simpl.
-   Exists (Vint (Int.repr(i+i+1))).
-   entailer!!.
+   forward.
+   EExists; unfold treerep; entailer!.
  - (* else clause *)
   inv H0.
 * (* NODE *) 
@@ -229,8 +229,6 @@ Proof.
   }
   forward_call r.
   forward. simpl.
-  Exists r p q p1 p2.
+  Exists r p1 p2 p q.
   entailer!!.
 Qed.
-
-
diff --git a/progs/verif_io.v b/progs/verif_io.v
index 1eabbba6f5..7d178d7d1d 100644
--- a/progs/verif_io.v
+++ b/progs/verif_io.v
@@ -1,12 +1,17 @@
 Require Import VST.progs.io.
 Require Import VST.progs.io_specs.
 Require Import VST.floyd.proofauto.
+Require Import ITree.Core.ITreeDefinition.
 
 Local Open Scope itree_scope.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
+Section IO.
+
+Context `{!VSTGS (@IO_itree (IO_event(file_id := nat))) Σ}.
+
 Definition putchar_spec := DECLARE _putchar putchar_spec.
 Definition getchar_spec := DECLARE _getchar getchar_spec.
 
@@ -19,7 +24,7 @@ Definition getchar_blocking_spec :=
     GLOBALS ()
     SEP (ITREE (r <- read stdin;; k r))
   POST [ tint ]
-   EX i : byte,
+   ∃ i : byte,
     PROP ()
     LOCAL (temp ret_temp (Vubyte i))
     SEP (ITREE (k i)).
@@ -46,16 +51,19 @@ Proof.
   rewrite <- Nat2Z.inj_div by discriminate.
   rewrite !Nat2Z.id.
   apply Nat2Z.inj_lt.
-  rewrite Nat2Z.inj_div, Z2Nat.id by lia; simpl.
+  rewrite -> Nat2Z.inj_div, Z2Nat.id by lia; simpl.
   apply Z.div_lt; auto; lia.
 Qed.
 
+Local Obligation Tactic := unfold RelationClasses.complement, Equivalence.equiv;
+  Tactics.program_simpl.
+
 Program Fixpoint chars_of_Z (n : Z) { measure (Z.to_nat n) } : list byte :=
   let n' := n / 10 in
   match n' <=? 0 with true => [Byte.repr (n + char0)] | false => chars_of_Z n' ++ [Byte.repr (n mod 10 + char0)] end.
 Next Obligation.
 Proof.
-  rewrite ?Zaux.Zdiv_eucl_unique in *.  (* Coq 8.15 and after *)
+  rewrite -> ?Zaux.Zdiv_eucl_unique in *.  (* Coq 8.15 and after *)
   apply div_10_dec.
   symmetry in Heq_anonymous; apply Z.leb_nle in Heq_anonymous.
   eapply Z.lt_le_trans, Z_mult_div_ge with (b := 10); lia.
@@ -69,7 +77,6 @@ Program Fixpoint intr n { measure (Z.to_nat n) } : list byte :=
   end.
 Next Obligation.
 Proof.
-  rewrite ?Zaux.Zdiv_eucl_unique in *.  (* Coq 8.15 and after *)
   apply div_10_dec.
   symmetry in Heq_anonymous; apply Z.leb_nle in Heq_anonymous; lia.
 Defined.
@@ -164,26 +171,24 @@ Lemma body_getchar_blocking: semax_body Vprog Gprog f_getchar_blocking getchar_b
 Proof.
   start_function.
   forward.
-  forward_while (EX i : int, PROP (-1 <= Int.signed i <= two_p 8 - 1) LOCAL (temp _r (Vint i))
+  forward_while (∃ i : int, PROP (-1 <= Int.signed i <= two_p 8 - 1) LOCAL (temp _r (Vint i))
     SEP (ITREE (if eq_dec (Int.signed i) (-1) then (r <- read stdin;; k r) else k (Byte.repr (Int.signed i))))).
-  - Exists (Int.neg (Int.repr 1)); entailer!!.
-    { simpl; lia. }
-    rewrite if_true; auto.
-  - entailer!!.
-  - subst; rewrite Int.signed_repr by rep_lia.
-    rewrite if_true by auto.
+  - Exists (Int.neg (Int.repr 1)); simpl; entailer!.
+  - entailer!.
+  - subst; rewrite -> Int.signed_repr by rep_lia.
+    rewrite -> if_true by auto.
     forward_call k.
     Intros i.
     forward.
-    Exists i; entailer!!.
+    Exists i; entailer!.
   - assert (Int.signed i <> -1).
     { intro X.
       apply f_equal with (f := Int.repr) in X.
       rewrite Int.repr_signed in X; auto. }
-    rewrite if_false by auto.
+    rewrite -> if_false by auto.
     forward.
     Exists (Byte.repr (Int.signed i)); entailer!.
-    unfold Vubyte; rewrite Byte.unsigned_repr, Int.repr_signed; auto.
+    unfold Vubyte; rewrite -> Byte.unsigned_repr, Int.repr_signed; auto.
     split; try lia.
     etransitivity; [apply H|].
     simpl; rep_lia.
@@ -193,25 +198,23 @@ Lemma body_putchar_blocking: semax_body Vprog Gprog f_putchar_blocking putchar_b
 Proof.
   start_function.
   forward.
-  forward_while (EX i : int, PROP (Int.signed i = -1 \/ Int.signed i = Byte.unsigned c) LOCAL (temp _r (Vint i); temp _c (Vubyte c))
+  forward_while (∃ i : int, PROP (Int.signed i = -1 \/ Int.signed i = Byte.unsigned c) LOCAL (temp _r (Vint i); temp _c (Vubyte c))
     SEP (ITREE (if eq_dec (Int.signed i) (-1) then (r <- write stdout c;; k) else k))).
-  - Exists (Int.neg (Int.repr 1)); entailer!!.
-    rewrite if_true; auto.
+  - Exists (Int.neg (Int.repr 1)); simpl; entailer!.
   - entailer!.
-  - subst; rewrite Int.signed_repr by rep_lia.
-    rewrite if_true by auto.
+  - subst; rewrite -> if_true by auto.
     forward_call (c, k).
     Intros i.
     forward.
-    Exists i; entailer!!.
+    Exists i; entailer!.
   - assert (Int.signed i <> -1).
     { intro X.
       apply f_equal with (f := Int.repr) in X.
       rewrite Int.repr_signed in X; auto. }
-    rewrite if_false by auto.
+    rewrite -> if_false by auto.
     destruct H; [contradiction | subst].
     forward.
-    entailer!!.
+    entailer!.
     unfold Vubyte.
     rewrite <- H, Int.repr_signed; auto.
 Qed.
@@ -222,24 +225,21 @@ Proof.
   forward_if (PROP () LOCAL () SEP (ITREE tr)).
   - forward.
     forward.
-    rewrite modu_repr, divu_repr by (lia || computable).
+    rewrite -> modu_repr, divu_repr by (lia || computable).
     rewrite intr_eq.
     destruct (Z.leb_spec i 0); try lia.
-    rewrite write_list_app, bind_bind.
+    rewrite write_list_app bind_bind.
     forward_call (i / 10, write_list stdout [Byte.repr (i mod 10 + char0)];; tr).
     { split; [apply Z.div_pos; lia | apply Z.div_le_upper_bound; lia]. }
     simpl write_list.
     forward_call (Byte.repr (i mod 10 + char0), tr).
-    { entailer!!.
+    { entailer!.
       unfold Vubyte; rewrite Byte.unsigned_repr; auto.
       pose proof (Z_mod_lt i 10); unfold char0; rep_lia. }
-    { rewrite <- sepcon_emp at 1; apply sepcon_derives; [|cancel].
-      rewrite bind_ret'; auto. }
-    entailer!!.
+    { rewrite bind_ret'; cancel. }
+    entailer!.
   - forward.
-    subst; entailer!!.
-    simpl.
-    rewrite bind_ret_l; auto.
+    entailer!.
 Qed.
 
 Lemma chars_of_Z_eq : forall n, chars_of_Z n =
@@ -256,10 +256,10 @@ Lemma chars_of_Z_intr : forall n, 0 < n ->
   chars_of_Z n = intr n.
 Proof.
   induction n using (well_founded_induction (Zwf.Zwf_well_founded 0)); intro.
-  rewrite chars_of_Z_eq, intr_eq.
+  rewrite chars_of_Z_eq intr_eq.
   destruct (n <=? 0) eqn: Hn; [apply Zle_bool_imp_le in Hn; lia|].
   simpl.
-  rewrite ?Zaux.Zdiv_eucl_unique in *.  (* Coq 8.15 and after *)
+  rewrite -> ?Zaux.Zdiv_eucl_unique in *.  (* Coq 8.15 and after *)
   destruct (n / 10 <=? 0) eqn: Hdiv.
   - apply Zle_bool_imp_le in Hdiv.
     assert (0 <= n / 10).
@@ -281,12 +281,11 @@ Proof.
   - subst.
     forward_call (Byte.repr char0, tr).
     { rewrite chars_of_Z_eq; simpl.
-      erewrite <- sepcon_emp at 1; apply sepcon_derives; [|cancel].
-      rewrite bind_ret'; apply derives_refl. }
-    entailer!!.
+      rewrite bind_ret' /char0; cancel. }
+    entailer!.
   - forward_call (i, tr).
-    { rewrite chars_of_Z_intr by lia; cancel. }
-    entailer!!.
+    { rewrite -> chars_of_Z_intr by lia; cancel. }
+    entailer!.
 Qed.
 
 Lemma read_sum_eq : forall n d, read_sum n d ≈
@@ -324,27 +323,27 @@ Proof.
   forward_call (fun c => read_sum 0 (Byte.unsigned c - char0)).
   Intros c.
   forward.
-  rewrite zero_ext_inrange by (pose proof (signed_char_unsigned c); rewrite Int.unsigned_repr; rep_lia).
-  set (Inv := EX n : Z, EX c : byte,
+  rewrite -> zero_ext_inrange by (pose proof (signed_char_unsigned c); rewrite Int.unsigned_repr; rep_lia).
+  set (Inv := ∃ n : Z, ∃ c : byte,
     PROP (0 <= n < 1009)
     LOCAL (temp _c (Vubyte c); temp _n (Vint (Int.repr n)))
     SEP (ITREE (read_sum n (Byte.unsigned c - char0)))).
   unfold Swhile; forward_loop Inv break: Inv.
-  { Exists 0 c; entailer!!. }
+  { unfold Inv; Exists 0 c; entailer!. }
   subst Inv.
   clear dependent c; Intros n c.
   forward_if.
   forward.
   forward_if.
   { forward.
-    Exists n c; entailer!!. }
+    Exists n c; entailer!. }
   forward.
   destruct (zlt (Byte.unsigned c) char0).
   { rewrite Int.unsigned_repr_eq in H1.
     rewrite <- Z_mod_plus_full with (b := 1), Zmod_small in H1; unfold char0 in *; rep_lia. }
-  rewrite Int.unsigned_repr in H1 by (unfold char0 in *; rep_lia).
+  rewrite -> Int.unsigned_repr in H1 by (unfold char0 in *; rep_lia).
   rewrite read_sum_eq.
-  rewrite if_true by auto.
+  rewrite -> if_true by auto.
   destruct (zlt _ _); [|unfold char0 in *; lia].
   forward_call (n + (Byte.unsigned c - char0),
     write stdout (Byte.repr newline);; c' <- read stdin;; read_sum (n + (Byte.unsigned c - char0)) (Byte.unsigned c' - char0)).
@@ -352,10 +351,10 @@ Proof.
   forward_call (fun c' => read_sum (n + (Byte.unsigned c - char0)) (Byte.unsigned c' - char0)).
   Intros c'.
   forward.
-  rewrite zero_ext_inrange by (pose proof (signed_char_unsigned c'); rewrite Int.unsigned_repr; rep_lia).
-  Exists (n + (Byte.unsigned c - char0)) c'; entailer!!.
+  rewrite -> zero_ext_inrange by (pose proof (signed_char_unsigned c'); rewrite Int.unsigned_repr; rep_lia).
+  Exists (n + (Byte.unsigned c - char0)) c'; entailer!.
   { forward.
-    Exists n c; entailer!!. }
+    Exists n c; entailer!. }
   subst Inv.
   Intros n c'.
   forward.
@@ -363,17 +362,18 @@ Qed.
 
 Definition ext_link := ext_link_prog prog.
 
-#[export] Instance Espec : OracleKind := IO_Espec ext_link.
+#[local] Instance IO_ext_spec : ext_spec IO_itree := IO_ext_spec ext_link.
 
 Lemma prog_correct:
   semax_prog prog main_itree Vprog Gprog.
 Proof.
 prove_semax_prog.
 semax_func_cons_ext.
-{ simpl; Intro i.
+{ simpl; monPred.unseal; Intro i.
   apply typecheck_return_value with (t := Xint16signed); auto. }
 semax_func_cons_ext.
-{ simpl; Intro i'.
+{ destruct x as (c, k).
+  simpl; monPred.unseal; Intro i'.
   apply typecheck_return_value with (t := Xint16signed); auto. }
 semax_func_cons body_getchar_blocking.
 semax_func_cons body_putchar_blocking.
@@ -382,8 +382,12 @@ semax_func_cons body_print_int.
 semax_func_cons body_main.
 Qed.
 
-Require Import VST.veric.SequentialClight.
-Require Import VST.progs.io_dry.
+End IO.
+
+Require Import VST.progs.os_combine.
+Require Import VST.progs.io_combine.
+Require Import VST.progs.io_os_specs.
+Require Import VST.progs.io_os_connection.
 
 Definition countfuns (prog: Clight.program) : nat :=
  length
@@ -417,38 +421,6 @@ Qed.
 
 Definition main_block := proj1_sig main_block_exists.
 
-Axiom (Jsub: forall ef se lv m t v m' (EFI : ef_inline ef = true) m1
-       (EFC : Events.external_call ef se lv m t v m'), juicy_mem.mem_sub m m1 ->
-       exists m1' (EFC1 : Events.external_call ef se lv m1 t v m1'),
-         juicy_mem.mem_sub m' m1' /\ proj1_sig (Clight_core.inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC1) =
-         proj1_sig (Clight_core.inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC)).
-
-Theorem prog_ext_correct : exists q,
-  semantics.initial_core (Clight_core.cl_core_sem (globalenv prog)) 0 init_mem q init_mem (Vptr main_block Ptrofs.zero) [] /\
-  forall n, @step_lemmas.dry_safeN _ _ _ _ semax.genv_symb_injective (Clight_core.cl_core_sem (globalenv prog))
-             (io_dry_spec ext_link) {| genv_genv := Genv.globalenv prog; genv_cenv := prog_comp_env prog |} n
-            main_itree q init_mem.
-Proof.
-  edestruct whole_program_sequential_safety_ext with (V := Vprog) as (b & q & Hb & Hq & Hsafe).
-  - repeat intro; hnf.
-    apply I.
-  - apply Jsub.
-  - apply add_funspecs_frame.
-  - apply juicy_dry_specs.
-  - apply dry_spec_mem.
-  - intros; apply I.
-  - apply CSHL_Sound.semax_prog_sound, prog_correct.
-  - apply (proj2_sig init_mem_exists).
-  - exists q.
-    rewrite (proj2_sig main_block_exists) in Hb; inv Hb.
-    split; auto.
-Qed.
-
-Require Import VST.progs.os_combine.
-Require Import VST.progs.io_combine.
-Require Import VST.progs.io_os_specs.
-Require Import VST.progs.io_os_connection.
-
 (* correctness down to OS traces, with relationship between syscall events and actual external reads/writes *)
 Theorem prog_OS_correct : forall {H : io_os_specs.ThreadsConfigurationOps},
   exists q,
@@ -459,9 +431,11 @@ Theorem prog_OS_correct : forall {H : io_os_specs.ThreadsConfigurationOps},
       valid_trace_user s.(io_log).
 Proof.
   intros.
-  edestruct IO_OS_ext with (V := Vprog) as (b & q & Hb & Hq & Hsafe).
-  - apply Jsub.
-  - apply prog_correct.
+  edestruct (IO_OS_ext prog) with (V := Vprog) as (b & q & Hb & Hq & Hsafe).
+  - intros ?? [<- | [<- | ?]]; last done;
+      rewrite /ext_link /ext_link_prog /prog /=; repeat (if_tac; first done); done.
+  - apply lifting.subG_VSTGpreS, subG_refl.
+  - intros; simple apply (@prog_correct _ VSTGS0).
   - apply (proj2_sig init_mem_exists).
   - exists q.
     rewrite (proj2_sig main_block_exists) in Hb; inv Hb.
diff --git a/progs/verif_io_mem.v b/progs/verif_io_mem.v
index 7650e9ebd7..628175d111 100644
--- a/progs/verif_io_mem.v
+++ b/progs/verif_io_mem.v
@@ -2,12 +2,17 @@ Require Import VST.progs.io_mem.
 Require Import VST.progs.io_mem_specs.
 Require Import VST.floyd.proofauto.
 Require Import VST.floyd.library.
+Require Import ITree.Core.ITreeDefinition.
 
 Local Open Scope itree_scope.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
+Section IO.
+
+Context `{!VSTGS (@IO_itree (IO_event(file_id := nat))) Σ}.
+
 Definition putchars_spec := DECLARE _putchars putchars_spec.
 Definition getchars_spec := DECLARE _getchars getchars_spec.
 
@@ -20,16 +25,19 @@ Proof.
   rewrite <- Nat2Z.inj_div by discriminate.
   rewrite !Nat2Z.id.
   apply Nat2Z.inj_lt.
-  rewrite Nat2Z.inj_div, Z2Nat.id by lia; simpl.
+  rewrite -> Nat2Z.inj_div, Z2Nat.id by lia; simpl.
   apply Z.div_lt; auto; lia.
 Qed.
 
+Local Obligation Tactic := unfold RelationClasses.complement, Equivalence.equiv;
+  Tactics.program_simpl.
+
 Program Fixpoint chars_of_Z (n : Z) { measure (Z.to_nat n) } : list byte :=
   let n' := n / 10 in
   match n' <=? 0 with true => [Byte.repr (n + char0)] | false => chars_of_Z n' ++ [Byte.repr (n mod 10 + char0)] end.
 Next Obligation.
 Proof.
-  rewrite ?Zaux.Zdiv_eucl_unique in *.  (* Coq 8.15 and after *)
+  rewrite -> ?Zaux.Zdiv_eucl_unique in *.  (* Coq 8.15 and after *)
   apply div_10_dec.
   symmetry in Heq_anonymous; apply Z.leb_nle in Heq_anonymous.
   eapply Z.lt_le_trans, Z_mult_div_ge with (b := 10); lia.
@@ -112,11 +120,7 @@ Proof.
   rewrite !Int.unsigned_repr; auto.
 Qed.
 
-(*Opaque bind.
-
-Opaque Nat.div Nat.modulo.*)
-
-Import Program.Wf. 
+Import Program.Wf.
   Program Lemma fix_sub_eq_ext :
    (* need to copy this from Coq standard library because it moved from
     one location to another between Coq 8.20 and Coq 8.21 *)
@@ -166,14 +170,14 @@ Proof.
   rewrite (intr_eq n).
   destruct (n <=? 0) eqn: Hn.
   { apply Zle_bool_imp_le in Hn; lia. }
-  rewrite Zlength_app, Zlength_cons, Zlength_nil; lia.
+  rewrite -> Zlength_app, Zlength_cons, Zlength_nil; lia.
 Qed.
 
 Lemma replace_list_nil : forall {X} i (l : list X), 0 <= i <= Zlength l -> replace_list i l [] = l.
 Proof.
   intros; unfold replace_list.
-  rewrite Zlength_nil, Z.add_0_r; simpl.
-  rewrite sublist_rejoin, sublist_same by lia; auto.
+  rewrite -> Zlength_nil, Z.add_0_r; simpl.
+  rewrite -> sublist_rejoin, sublist_same by lia; auto.
 Qed.
 
 Lemma replace_list_upd_snoc : forall {X} i (l l' : list X) x, 0 <= i -> i + Zlength l' < Zlength l ->
@@ -182,13 +186,13 @@ Proof.
   intros; unfold replace_list.
   rewrite upd_Znth_app2; rewrite ?Zlength_sublist; try rep_lia.
   f_equal.
-  rewrite Z.sub_0_r, Z.add_simpl_l, upd_Znth_app2; rewrite ?Zlength_sublist; try rep_lia.
-  rewrite Zminus_diag, Zlength_app, Zlength_cons, Zlength_nil, upd_Znth0_old, <- app_assoc; simpl; f_equal; f_equal.
-  rewrite Zlength_sublist by rep_lia.
-  rewrite sublist_sublist by rep_lia.
+  rewrite -> Z.sub_0_r, Z.add_simpl_l, upd_Znth_app2; rewrite ?Zlength_sublist; try rep_lia.
+  rewrite -> Zminus_diag, Zlength_app, Zlength_cons, Zlength_nil, upd_Znth0_old, <- app_assoc; simpl; f_equal; f_equal.
+  rewrite -> Zlength_sublist by rep_lia.
+  rewrite -> sublist_sublist by rep_lia.
   f_equal; lia.
   { rewrite Zlength_sublist; rep_lia. }
-  { rewrite Zlength_app, Zlength_sublist; rep_lia. }
+  { rewrite -> Zlength_app, Zlength_sublist; rep_lia. }
 Qed.
 
 Lemma body_print_intr: semax_body Vprog Gprog f_print_intr print_intr_spec.
@@ -199,43 +203,43 @@ Proof.
     LOCAL (temp _k (Vint (Int.repr (Zlength (intr i) - 1))))
     SEP (data_at sh (tarray tuchar (Zlength contents)) (replace_list 0 contents (map Vubyte (intr i))) buf)).
   - forward.
-    rewrite divu_repr by rep_lia.
+    rewrite -> divu_repr by rep_lia.
     forward.
     forward_call (sh, i / 10, buf, contents).
-    { rewrite intr_lt by lia; split; auto; try lia.
+    { rewrite -> intr_lt by lia; split; auto; try lia.
       assert (i / 10 < i).
       { apply Z.div_lt; lia. }
        split.
       apply Z.div_pos; lia. 
       rep_lia.
     }
-    rewrite modu_repr by (lia || computable).
+    rewrite -> modu_repr by (lia || computable).
     assert (repable_signed (Zlength (intr (i / 10)))).
     { split; try rep_lia.
       rewrite intr_lt; try lia. }
     forward.
-    { entailer!!.
+    { entailer!.
       split; try rep_lia.
       rewrite intr_lt; try lia. }
-    entailer!!.
-    { rewrite intr_lt by lia; auto. }
+    entailer!.
+    { rewrite -> intr_lt by lia; auto. }
     rewrite (intr_eq i).
     destruct (i <=? 0) eqn: Hi; [apply Zle_bool_imp_le in Hi; lia|].
     pose proof (Z_mod_lt i 10).
     rewrite <- (Zlength_map _ _ Vubyte), <- (Z.add_0_l (Zlength (map _ _))), replace_list_upd_snoc.
-    rewrite (zero_ext_inrange 8 (Int.repr (i mod 10))), add_repr.
-    rewrite zero_ext_inrange, map_app.
+    rewrite -> (zero_ext_inrange 8 (Int.repr (i mod 10))), add_repr.
+    rewrite -> zero_ext_inrange, map_app.
     unfold Vubyte at 3; simpl.
-    rewrite Byte.unsigned_repr by (unfold char0; rep_lia); apply derives_refl.
+    rewrite -> Byte.unsigned_repr by (unfold char0; rep_lia); apply derives_refl.
     { rewrite Int.unsigned_repr; simpl; rep_lia. }
     { rewrite Int.unsigned_repr; simpl; rep_lia. }
     { lia. }
-    { rewrite Zlength_map, intr_lt; rep_lia. }
+    { rewrite Zlength_map intr_lt; rep_lia. }
   - forward.
-    entailer!!.
-    rewrite replace_list_nil by rep_lia; auto.
+    entailer!.
+    rewrite -> replace_list_nil by rep_lia; auto.
   - forward.
-    rewrite Z.sub_simpl_r; entailer!!.
+    rewrite Z.sub_simpl_r; entailer!.
 Qed.
 
 Lemma chars_of_Z_eq : forall n, chars_of_Z n =
@@ -254,15 +258,15 @@ Proof.
   intros.
   destruct (Z.leb_spec n 0).
   { rewrite chars_of_Z_eq; simpl.
-  rewrite ?Zaux.Zdiv_eucl_unique in *.  (* Coq 8.15 and after *)
+    rewrite -> ?Zaux.Zdiv_eucl_unique in *.  (* Coq 8.15 and after *)
     apply Zdiv_le_compat_r with (p := 10) in H; try lia.
     rewrite Zdiv_0_l in H.
     destruct (Z.leb_spec (n / 10) 0); auto; lia. }
   induction n as [? IH] using (well_founded_induction (Zwf.Zwf_well_founded 0)).
-  rewrite chars_of_Z_eq, intr_eq.
+  rewrite chars_of_Z_eq intr_eq.
   destruct (n <=? 0) eqn: Hn; [apply Zle_bool_imp_le in Hn; lia|].
   simpl.
-  rewrite ?Zaux.Zdiv_eucl_unique in *.  (* Coq 8.15 and after *)
+  rewrite -> ?Zaux.Zdiv_eucl_unique in *.  (* Coq 8.15 and after *)
   destruct (n / 10 <=? 0) eqn: Hdiv.
   - apply Zle_bool_imp_le in Hdiv.
     assert (0 <= n / 10).
@@ -283,14 +287,14 @@ Proof.
   rewrite intr_eq.
   destruct (Z.leb_spec n 0); [rewrite Zlength_nil; lia|].
   rewrite Zlength_app.
-  assert (Zlength (intr (n / 10)) <= a - 1); [|rewrite Zlength_cons, Zlength_nil; lia].
+  assert (Zlength (intr (n / 10)) <= a - 1); [|rewrite Zlength_cons Zlength_nil; lia].
   assert (0 <= a - 1).
   { destruct (Z.eq_dec a 0); subst; simpl in *; lia. }
   apply H; auto.
   - split; try lia.
     apply Z.div_lt; auto; lia.
   - apply Zmult_lt_reg_r with 10; try lia.
-    rewrite (Z.mul_comm (10 ^ _)), <- Z.pow_succ_r by auto.
+    rewrite -> (Z.mul_comm (10 ^ _)), <- Z.pow_succ_r by auto.
     unfold Z.succ; rewrite Z.sub_simpl_r.
     eapply Z.le_lt_trans; eauto.
     rewrite Z.mul_comm; apply Z.mul_div_le; lia.
@@ -301,21 +305,21 @@ Proof.
   intros.
   rewrite chars_of_Z_intr.
   destruct (Z.leb_spec n 0); [|apply intr_length; lia].
-  rewrite Zlength_cons, Zlength_nil; lia.
+  rewrite Zlength_cons Zlength_nil; lia.
 Qed.
 
 Lemma body_print_int: semax_body Vprog Gprog f_print_int print_int_spec.
 Proof.
   start_function.
   forward_call (tarray tuchar 5, gv).
-  { split; auto; simpl; computable. }
+  { simpl; computable. }
   Intro buf.
   forward_if (buf <> nullval).
-  { if_tac; entailer!!. }
+  { if_tac; entailer!. }
   { forward_call 1; contradiction. }
   { forward.
-    entailer!!. }
-  Intros; rewrite if_false by auto.
+    entailer!. }
+  Intros; rewrite -> if_false by auto.
   forward_if (PROP ()
     LOCAL (temp _buf buf; gvars gv; temp _i (Vint (Int.repr i));
                  temp _k (Vint (Int.repr (Zlength (chars_of_Z i ++ [Byte.repr newline])))))
@@ -327,29 +331,28 @@ Proof.
     forward.
     forward.
     forward.
-    entailer!!.
+    entailer!.
   - Intros.
     sep_apply data_at__data_at.
     unfold default_val; simpl.
     assert (Zlength (intr i) <= 4).
     { apply intr_length; try lia. }
     forward_call (Ews, i, buf, [Vundef; Vundef; Vundef; Vundef; Vundef]).
-    { rewrite !Zlength_cons, Zlength_nil.
+    { rewrite -> !Zlength_cons, Zlength_nil.
       simpl; repeat (split; auto); rep_lia. }
     forward.
-    { entailer!!.
-      rewrite !Zlength_cons, Zlength_nil; rep_lia. }
+    { entailer!.
+      rewrite -> !Zlength_cons, Zlength_nil; rep_lia. }
     forward.
-    entailer!!.
-    { rewrite Zlength_app, Zlength_cons, Zlength_nil, chars_of_Z_intr.
+    entailer!.
+    { rewrite -> Zlength_app, Zlength_cons, Zlength_nil, chars_of_Z_intr.
       destruct (Z.leb_spec i 0); auto; lia. }
     unfold replace_list; simpl.
     rewrite (sublist_repeat _ _ 5 Vundef).
-    rewrite !Zlength_cons, Zlength_nil, Zlength_map; simpl.
+    rewrite -> !Zlength_cons, Zlength_nil, Zlength_map; simpl.
     rewrite upd_Znth_app2.
-    rewrite Zlength_map, Zminus_diag, upd_Znth0_old, sublist_repeat; try lia.
-    apply derives_refl'.
-    f_equal.
+    rewrite -> Zlength_map, Zminus_diag, upd_Znth0_old, sublist_repeat; try lia.
+    f_equiv.
     rewrite chars_of_Z_intr.
     destruct (Z.leb_spec i 0); try lia.
     rewrite zero_ext_inrange.
@@ -358,14 +361,14 @@ Proof.
     { simpl; rewrite Int.unsigned_repr; rep_lia. }
     { rewrite Zlength_repeat; lia. }
     { rewrite Zlength_repeat; lia. }
-    { rewrite Zlength_map, Zlength_repeat; lia. }
+    { rewrite Zlength_map Zlength_repeat; lia. }
     { rewrite Zlength_map; rep_lia. }
-    { rewrite !Zlength_cons, Zlength_nil, Zlength_map; lia. }
+    { rewrite -> !Zlength_cons, Zlength_nil, Zlength_map; lia. }
   - forward_call (Ews, buf, chars_of_Z i ++ [Byte.repr newline],
       5, repeat Vundef (Z.to_nat (4 - Zlength (chars_of_Z i))), tr).
-    { rewrite map_app, <- app_assoc; simpl; cancel. }
+    { rewrite -> map_app, <- app_assoc; simpl; cancel. }
     forward_call (tarray tuchar 5, buf, gv).
-    { rewrite if_false by auto; cancel. }
+    { rewrite -> if_false by auto; cancel. }
     forward.
 Qed.
 
@@ -383,13 +386,13 @@ Proof.
   rewrite bind_bind.
   apply eqit_bind; [reflexivity|].
   intros [].
-  - rewrite bind_ret_l, tau_eutt.
+  - rewrite bind_ret_l tau_eutt.
     rewrite unfold_iter.
-    rewrite bind_ret_l; reflexivity.
+    rewrite bind_ret_l //.
   - rewrite bind_bind.
     apply eqit_bind; [reflexivity|].
     intro.
-    rewrite bind_ret_l, tau_eutt; reflexivity.
+    rewrite bind_ret_l tau_eutt //.
 Qed.
 
 Lemma for_loop_eq : forall {file_id} i z body,
@@ -402,9 +405,9 @@ Proof.
   rewrite bind_bind.
   apply eqit_bind; [reflexivity|].
   intros [].
-  - rewrite bind_ret_l, tau_eutt, unfold_iter.
-    rewrite bind_ret_l; reflexivity.
-  - rewrite bind_ret_l, tau_eutt; reflexivity.
+  - rewrite bind_ret_l tau_eutt unfold_iter.
+    rewrite bind_ret_l //.
+  - rewrite bind_ret_l tau_eutt //.
 Qed.
 
 Lemma sum_Z_app : forall l1 l2, sum_Z (l1 ++ l2) = sum_Z l1 + sum_Z l2.
@@ -417,130 +420,129 @@ Lemma body_main: semax_body Vprog Gprog f_main main_spec.
 Proof.
   start_function.
   sep_apply (has_ext_ITREE(E := @IO_event nat)).
-  rewrite <- (emp_sepcon (ITREE _)); Intros.
+  rewrite <- (bi.emp_sep (ITREE _)); Intros.
   replace_SEP 0 (mem_mgr gv) by (go_lower; apply create_mem_mgr).
   forward.
   forward_call (tarray tuchar 4, gv).
-  { simpl; repeat (split; auto); rep_lia. }
+  { simpl; computable. }
   Intro buf.
   forward_if (buf <> nullval).
-  { if_tac; entailer!!. }
+  { if_tac; entailer!. }
   { forward_call 1; contradiction. }
   { forward.
     entailer!. }
-  Intros; rewrite if_false by auto.
+  Intros; rewrite -> if_false by auto.
   unfold main_itree.
   forward_call (Ews, buf, 4, fun lc => read_sum 0 lc).
   { simpl; cancel. }
   Intros lc.
-  set (Inv := EX n : Z, EX lc : list byte,
+  set (Inv := ∃ n : Z, ∃ lc : list byte,
     PROP (0 <= n < 1040)
     LOCAL (temp _i (Vint (Int.repr 4)); temp _buf buf; temp _n (Vint (Int.repr n)); gvars gv)
     SEP (ITREE (read_sum n lc); data_at Ews (tarray tuchar 4) (map Vubyte lc) buf;
       mem_mgr gv; malloc_token Ews (tarray tuchar 4) buf)).
   forward_while Inv.
-  { Exists 0 lc; entailer!!. }
-  { entailer!!. }
+  { Exists 0 lc; entailer!. }
+  { entailer!. }
   - clear dependent lc; rename lc0 into lc.
     rewrite read_sum_eq.
-    rewrite if_true by auto; simpl ITREE.
+    rewrite -> if_true by auto; simpl ITREE.
     set (nums := map (fun i => Byte.unsigned i - char0) lc).
     assert_PROP (Zlength lc = 4).
     { entailer!.
-      rewrite Zlength_map in *; auto. }
+      rewrite -> Zlength_map in *; auto. }
     assert (Zlength nums = 4) by (subst nums; rewrite Zlength_map; auto).
-    forward_for_simple_bound 4 (EX j : Z, PROP (0 <= n + sum_Z (sublist 0 j nums) < 1000 + 10 * j)
+    forward_for_simple_bound 4 (∃ j : Z, PROP (0 <= n + sum_Z (sublist 0 j nums) < 1000 + 10 * j)
      LOCAL (temp _i (Vint (Int.repr 4)); temp _buf buf; temp _n (Vint (Int.repr (n + sum_Z (sublist 0 j nums)))); gvars gv)
      SEP (ITREE (b <- for_loop j 4
          (read_sum_inner n nums) ;; if (b : bool) then Ret tt else lc' <- read_list stdin 4 ;; read_sum (n + sum_Z nums) lc');
              data_at Ews (tarray tuchar 4) (map Vubyte lc) buf; mem_mgr gv; malloc_token Ews (tarray tuchar 4) buf)).
-    + entailer!!. lia.
+    + entailer!.
     + simpl.
       forward.
       { entailer!.
         unfold Vubyte; simpl.
         rewrite Int.unsigned_repr; rep_lia. }
       forward.
-      rewrite Znth_map by lia; simpl.
+      rewrite -> Znth_map by lia; simpl.
       rewrite zero_ext_inrange.
       forward.
       unfold Int.sub.
-      rewrite !Int.unsigned_repr by rep_lia.
+      rewrite -> !Int.unsigned_repr by rep_lia.
       forward_if (0 <= Byte.unsigned (Znth i lc) - char0 < 10).
       { forward_call (tarray tuchar 4, buf, gv).
-        { rewrite if_false by auto; cancel. }
+        { rewrite -> if_false by auto; cancel. }
         forward.
-        entailer!!.
+        entailer!.
         rewrite for_loop_eq.
         destruct (Z.ltb_spec i 4); try lia.
         unfold read_sum_inner at 1.
         replace (_ || _)%bool with true.
         rewrite !bind_ret_l; auto.
         { symmetry; rewrite orb_true_iff.
-          subst nums; rewrite Znth_map by lia.
+          subst nums; rewrite -> Znth_map by lia.
           destruct (Z.ltb_spec (Byte.unsigned (Znth i lc) - char0) 0); auto.
-          rewrite Int.unsigned_repr in * by (unfold char0 in *; rep_lia).
+          rewrite -> Int.unsigned_repr in * by (unfold char0 in *; rep_lia).
           left; apply Z.leb_le; unfold char0 in *; lia. } }
       { forward.
-        entailer!!.
-        rewrite Int.unsigned_repr_eq in *.
+        entailer!.
+        rewrite -> Int.unsigned_repr_eq in *.
         destruct (zlt (Byte.unsigned (Znth i lc)) char0).
         { unfold char0 in *; rewrite <- Z_mod_plus_full with (b := 1), Zmod_small in *; rep_lia. }
-        unfold char0 in *; rewrite Zmod_small in *; rep_lia. }
+        unfold char0 in *; rewrite -> Zmod_small in *; rep_lia. }
       forward.
       rewrite add_repr.
       rewrite for_loop_eq.
       destruct (Z.ltb_spec i 4); try lia.
       unfold read_sum_inner at 1.
-      unfold nums; rewrite Znth_map by lia.
+      unfold nums; rewrite -> Znth_map by lia.
       assert (((10 <=? Byte.unsigned (Znth i lc) - char0) || (Byte.unsigned (Znth i lc) - char0 <? 0))%bool = false) as Hin.
       { rewrite orb_false_iff.
         split; [apply Z.leb_nle | apply Z.ltb_nlt]; lia. }
       rewrite Hin.
       assert (sublist 0 (i + 1) nums = sublist 0 i nums ++ [Byte.unsigned (Znth i lc) - char0]) as Hi.
-      { rewrite (sublist_split _ i (i + 1)), (sublist_one i (i + 1)) by lia.
+      { rewrite -> (sublist_split _ i (i + 1)), (sublist_one i (i + 1)) by lia.
         f_equal; subst nums.
-        rewrite Znth_map by lia; auto. }
+        rewrite -> Znth_map by lia; auto. }
       forward_call (gv, n + sum_Z (sublist 0 (i + 1) nums),
         b <- for_loop (i + 1) 4 (read_sum_inner n nums) ;; if (b : bool) then Ret tt else lc' <- read_list stdin 4 ;; read_sum (n + sum_Z nums) lc').
-      { entailer!!.
-        rewrite Hi, sum_Z_app; simpl.
-        rewrite Z.add_assoc, Z.add_0_r; auto. }
-      { rewrite sepcon_assoc; apply sepcon_derives; cancel.
+      { entailer!.
+        rewrite Hi sum_Z_app; simpl.
+        rewrite Z.add_assoc Z.add_0_r; auto. }
+      { apply bi.sep_mono; last cancel.
         rewrite !bind_bind.
         apply ITREE_impl.
         apply eqit_bind; [reflexivity|].
         intros [].
         rewrite bind_ret_l; reflexivity. }
-      { rewrite Hi, sum_Z_app; simpl; lia. }
-      entailer!!.
-      { rewrite Hi, sum_Z_app; simpl.
-        rewrite Z.add_0_r, Z.add_assoc; split; auto; lia. }
-      { rewrite Int.unsigned_repr by rep_lia.
+      { rewrite Hi sum_Z_app; simpl; lia. }
+      entailer!.
+      { rewrite Hi sum_Z_app; simpl.
+        rewrite Z.add_0_r Z.add_assoc; split; auto; lia. }
+      { rewrite -> Int.unsigned_repr by rep_lia.
         pose proof (Byte.unsigned_range (Znth i lc)) as [_ Hmax].
         unfold Byte.modulus, two_power_nat in Hmax; simpl in *; lia. }
     + rewrite for_loop_eq.
       destruct (Z.ltb_spec 4 4); try lia.
       forward_call (Ews, buf, 4, fun lc' => read_sum (n + sum_Z nums) lc').
-      { rewrite sepcon_assoc; apply sepcon_derives; cancel.
-        simpl; rewrite bind_ret_l; auto. }
+      { simpl; rewrite bind_ret_l; cancel. }
       Intros lc'.
       forward.
-      rewrite sublist_same in * by auto.
+      rewrite -> sublist_same in * by auto.
       Exists (n + sum_Z nums, lc'); entailer!.
       apply derives_refl.
   - subst Inv.
     forward_call (tarray tuchar 4, buf, gv).
-    { rewrite if_false by auto; cancel. }
+    { rewrite -> if_false by auto; cancel. }
     forward.
     cancel.
     rewrite read_sum_eq.
-    rewrite if_false; [auto | lia].
+    if_tac; auto; lia.
 Qed.
 
 Definition ext_link := ext_link_prog prog.
 
-#[export] Instance Espec : OracleKind := IO_Espec ext_link.
+#[local] Instance IO_ext_spec : ext_spec IO_itree := IO_ext_spec ext_link.
 
 Lemma prog_correct:
   semax_prog prog main_itree Vprog Gprog.
@@ -548,16 +550,21 @@ Proof.
 prove_semax_prog.
 semax_func_cons body_exit.
 semax_func_cons body_free.
-semax_func_cons body_malloc. apply semax_func_cons_malloc_aux.
+semax_func_cons body_malloc.
+{ destruct x; apply semax_func_cons_malloc_aux. }
 semax_func_cons_ext.
-{ simpl; Intro msg.
+{ simpl; destruct x as (((?, ?), ?), ?); monPred.unseal; Intro msg.
   apply typecheck_return_value with (t := Xint16signed); auto. }
 semax_func_cons_ext.
+{ simpl; destruct x as (((((?, ?), ?), ?), ?), ?).
+  apply typecheck_return_value with (t := Xint16signed); auto. }
 semax_func_cons body_print_intr.
 semax_func_cons body_print_int.
 semax_func_cons body_main.
 Qed.
 
+End IO.
+
 Require Import VST.veric.SequentialClight.
 Require Import VST.progs.io_mem_dry.
 
@@ -570,11 +577,16 @@ Ltac alloc_block m n := match n with
     destruct (dry_mem_lemmas.drop_alloc m) as [m' Hm']; alloc_block m' n'
   end.
 try first [
-  (* This version works in Coq 8.15, CompCert 3.10 *)
+  (* This version works in Coq 8.19, CompCert 3.15 *)
+  alloc_block Mem.empty 64%nat;
+  eexists; repeat match goal with H : ?a = _ |- match ?a with Some m' => _ | None => None end = _ => rewrite H end;
+  reflexivity
+ |
+  (* This version worked in Coq 8.15, CompCert 3.10 *)
   alloc_block Mem.empty 63%nat;
   eexists; repeat match goal with H : ?a = _ |- match ?a with Some m' => _ | None => None end = _ => rewrite H end;
   reflexivity
- | 
+ |
   (* This version worked in Coq 8.13, CompCert 3.9 *)
   alloc_block Mem.empty 61%nat;
   eexists; repeat match goal with H : ?a = _ |- match ?a with Some m' => _ | None => None end = _ => rewrite H end;
@@ -592,26 +604,19 @@ Qed.
 
 Definition main_block := proj1_sig main_block_exists.
 
-Axiom (Jsub: forall ef se lv m t v m' (EFI : ef_inline ef = true) m1
-       (EFC : Events.external_call ef se lv m t v m'), juicy_mem.mem_sub m m1 ->
-       exists m1' (EFC1 : Events.external_call ef se lv m1 t v m1'),
-         juicy_mem.mem_sub m' m1' /\ proj1_sig (Clight_core.inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC1) =
-         proj1_sig (Clight_core.inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC)).
-
 Theorem prog_toplevel : exists q,
   semantics.initial_core (Clight_core.cl_core_sem (globalenv prog)) 0 init_mem q init_mem (Vptr main_block Ptrofs.zero) [] /\
-  forall n, @step_lemmas.dry_safeN _ _ _ _ semax.genv_symb_injective (Clight_core.cl_core_sem (globalenv prog))
-             (io_dry_spec ext_link) {| genv_genv := Genv.globalenv prog; genv_cenv := prog_comp_env prog |} n
+  forall n, @step_lemmas.dry_safeN _ _ _ _ lifting.genv_symb_injective (Clight_core.cl_core_sem (globalenv prog))
+             io_dry_spec {| genv_genv := Genv.globalenv prog; genv_cenv := prog_comp_env prog |} n
             main_itree q init_mem.
 Proof.
-  edestruct whole_program_sequential_safety_ext with (V := Vprog) as (b & q & Hb & Hq & Hsafe).
-  - repeat intro; simpl. apply I.
-  - apply Jsub.
-  - apply add_funspecs_frame.
-  - apply juicy_dry_specs.
-  - apply dry_spec_mem.
-  - intros; apply I.
-  - apply CSHL_Sound.semax_prog_sound, prog_correct.
+  edestruct whole_program_sequential_safety_ext with (Espec := @IO_ext_spec (VSTΣ (@IO_itree (@IO_event nat))))(V := Vprog) as (b & q & Hb & Hq & Hsafe).
+  - apply lifting.subG_VSTGpreS, subG_refl.
+  - repeat intro; apply I.
+  - apply io_spec_sound.
+    intros ?? [<- | [<- | ?]]; last done;
+      rewrite /ext_link /ext_link_prog /prog /=; repeat (if_tac; first done); done.
+  - intros; eexists; apply CSHL_Sound.semax_prog_sound, prog_correct.
   - apply (proj2_sig init_mem_exists).
   - exists q.
     rewrite (proj2_sig main_block_exists) in Hb; inv Hb.
diff --git a/progs/verif_libglob.v b/progs/verif_libglob.v
index 457e74bf42..1c575c1b99 100644
--- a/progs/verif_libglob.v
+++ b/progs/verif_libglob.v
@@ -1,11 +1,10 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.libglob.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
-Local Open Scope logic.
-
 (*  The LG module has two global variables of its own:
 <<
 int LG_n = 3;
@@ -78,11 +77,9 @@ intros.
 unfold initialized_globals, data.
 rewrite !data_at_tuint_tint.
 entailer!.
-apply orp_right2.
+rewrite <- bi.or_intro_r.
 cancel.
 unfold_data_at (data_at _ (Tstruct _foo _) _ _).
-rewrite sepcon_comm.
-apply sepcon_derives.
 rewrite field_at_data_at.
 simpl.
 rewrite field_compatible_field_address
@@ -160,7 +157,7 @@ Definition main_spec :=
   DECLARE _main
   WITH gv : globals
   PRE  [] main_pre prog tt gv
-  POST [ tint ]  
+  POST [ tint ]
      PROP() 
      RETURN (Vint (Int.repr 5))
      SEP(TT).
@@ -169,32 +166,17 @@ Definition Gprog : funspecs :=
     ltac:(with_library prog [
     init_spec; bump_spec; get_spec; client_spec; main_spec]).
 
-Lemma orp_if_bool:
- forall {A} {NA: NatDed A} (P Q: A),
-   orp P Q = EX b: bool, if b then P else Q.
-Proof.
-intros.
-apply pred_ext.
-apply orp_left.
-Exists true; auto.
-Exists false; auto.
-Intros b.
-destruct b.
-apply orp_right1; auto.
-apply orp_right2; auto.
-Qed.
-
 Lemma body_init:  semax_body Vprog Gprog f_LG_init init_spec.
 Proof.
 start_function.
 unfold LG.data.
 unfold LG.data_ok.
-rewrite orp_if_bool.
+rewrite bi.or_alt.
 Intros b; destruct b.
 *
 Intros.
 forward.
-forward_if (PROP() LOCAL() SEP(LG.data_ok n gv)).
+forward_if.
 inv H0.
 forward.
 unfold LG.data_ok.
@@ -202,7 +184,7 @@ entailer!.
 *
 Intros.
 forward.
-forward_if (PROP() LOCAL() SEP(LG.data_ok n gv)).
+forward_if.
 forward.
 forward.
 unfold LG.data_ok.
@@ -224,7 +206,7 @@ forward.
 forward.
 entailer!!.
 unfold LG.data.
-apply orp_right1.
+rewrite <- bi.or_intro_l.
 unfold LG.data_ok.
 entailer!.
 Qed.
@@ -236,22 +218,20 @@ forward_call (n,gv).
 unfold LG.data_ok.
 Intros.
 forward.
-forward_if False.
+forward_if.
 *
 forward.
 unfold LG.data.
-apply orp_right1.
+rewrite <- bi.or_intro_l.
 unfold LG.data_ok.
 entailer!!.
 *
 forward.
 forward.
 unfold LG.data.
-apply orp_right1.
+rewrite <- bi.or_intro_l.
 unfold LG.data_ok.
 entailer!!.
-*
-Intros. contradiction.
 Qed.
 
 
@@ -272,4 +252,3 @@ sep_apply (LG.initial gv); auto.
 forward_call (3,gv).
 forward.
 Qed.
-
diff --git a/progs/verif_load_demo.v b/progs/verif_load_demo.v
index 65f96e0bf3..0a6304b70f 100644
--- a/progs/verif_load_demo.v
+++ b/progs/verif_load_demo.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.load_demo.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
@@ -160,7 +161,7 @@ forward_for_simple_bound (Int.unsigned (Int.shru (Int.repr tag) (Int.repr 10)))
   forward.
   entailer!.
   rewrite Znth_pos_cons by lia.
-  autorewrite with sublist. simpl.  
+  autorewrite with sublist. simpl.
   f_equal. rewrite Int.add_assoc. f_equal.
   rewrite (sublist_split 0 i (i+1)) by lia.
   rewrite sublist_len_1 by lia.
diff --git a/progs/verif_logical_compare.v b/progs/verif_logical_compare.v
index e015110a03..ec19adb1a6 100644
--- a/progs/verif_logical_compare.v
+++ b/progs/verif_logical_compare.v
@@ -1,6 +1,6 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.logical_compare.
-Import compcert.lib.Maps.
 
 #[export] Instance CompSpecs : compspecs. Proof. make_compspecs prog. Defined.
 
@@ -15,16 +15,16 @@ Definition logical_or_result v1 v2 : int :=
 Fixpoint quick_shortcut_logical (s: statement) : option ident :=
 match s with
 | Sifthenelse _
-     (Sset id (Econst_int _ (Tint I32 Signed {| attr_volatile := false; attr_alignas := None |})))
+     (Sset id (Econst_int _ (Tint I32 Signed {| attr_volatile := false; attr_alignas := None |} )))
      s2 => match quick_shortcut_logical s2 with None => None | Some id2 =>
                  if ident_eq id id2 then Some id else None
                 end
 | Sifthenelse _ s2
-     (Sset id (Econst_int _ (Tint I32 Signed {| attr_volatile := false; attr_alignas := None |})))
+     (Sset id (Econst_int _ (Tint I32 Signed {| attr_volatile := false; attr_alignas := None |} )))
       => match quick_shortcut_logical s2 with None => None | Some id2 =>
                  if ident_eq id id2 then Some id else None
             end
-| Sset id (Ecast _ (Tint IBool Unsigned {| attr_volatile := false; attr_alignas := None |})) =>
+| Sset id (Ecast _ (Tint IBool Unsigned {| attr_volatile := false; attr_alignas := None |} )) =>
         Some id
 | _ => None
 end.
@@ -33,7 +33,7 @@ Fixpoint shortcut_logical (eval: expr -> option val) (tid: ident) (s: statement)
             : option (int * list expr) :=
 match s with
 | Sifthenelse e1
-     (Sset id (Econst_int one (Tint I32 Signed {| attr_volatile := false; attr_alignas := None |})))
+     (Sset id (Econst_int one (Tint I32 Signed {| attr_volatile := false; attr_alignas := None |} )))
      s2 => if andb (eqb_ident id tid) (Int.eq one Int.one)
                 then match eval e1 with
                         | Some (Vint v1) =>
@@ -45,7 +45,7 @@ match s with
                         end
                 else None
 | Sifthenelse e1 s2
-     (Sset id (Econst_int zero (Tint I32 Signed {| attr_volatile := false; attr_alignas := None |})))
+     (Sset id (Econst_int zero (Tint I32 Signed {| attr_volatile := false; attr_alignas := None |} )))
       => if andb (eqb_ident id tid) (Int.eq zero Int.zero)
             then match eval e1 with
                      | Some (Vint v1) =>
@@ -56,7 +56,7 @@ match s with
                    | _ => None
                 end
             else None
-| Sset id (Ecast e (Tint IBool Unsigned {| attr_volatile := false; attr_alignas := None |})) =>
+| Sset id (Ecast e (Tint IBool Unsigned {| attr_volatile := false; attr_alignas := None |} )) =>
         if eqb_ident id tid
         then match eval (Ecast e tbool) with
                  | Some (Vint v) => Some (v, (Ecast e tbool :: nil))
@@ -67,14 +67,14 @@ match s with
 end.
 
 Lemma semax_shortcut_logical:
-  forall Espec {cs: compspecs} Delta P Q R tid s v Qtemp Qvar GV el,
+  forall Espec {cs: compspecs} E Delta P Q R tid s v Qtemp Qvar GV el,
    quick_shortcut_logical s = Some tid ->
    typeof_temp Delta tid = Some tint ->
    local2ptree Q = (Qtemp, Qvar, nil, GV) ->
-   Qtemp ! tid = None ->
+   Qtemp !! tid = None ->
    shortcut_logical (msubst_eval_expr Delta Qtemp Qvar GV) tid s = Some (v, el) ->
    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- fold_right (fun e q => tc_expr Delta e && q) TT el ->
-   @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R)))
+   semax(OK_spec := Espec)(C := cs) E Delta (PROPx P (LOCALx Q (SEPx R)))
           s (normal_ret_assert (PROPx P (LOCALx (temp tid (Vint v) :: Q) (SEPx R)))).
 Admitted.
 
@@ -120,7 +120,6 @@ Ltac do_semax_shortcut_logical :=
 Lemma body_do_or: semax_body Vprog Gprog f_do_or do_or_spec.
 Proof.
 start_function.
-
 eapply semax_seq'; [do_semax_shortcut_logical | abbreviate_semax].
 forward.
 destruct H,H0; subst; simpl; entailer!.
@@ -140,8 +139,6 @@ start_function.
 forward.
 Qed.
 
-#[export] Existing Instance NullExtension.Espec.
-
 Lemma prog_correct:
   semax_prog prog tt Vprog Gprog.
 Proof.
@@ -150,4 +147,3 @@ semax_func_cons body_do_or.
 semax_func_cons body_do_and.
 semax_func_cons body_main.
 Qed.
-
diff --git a/progs/verif_loop_minus1.v b/progs/verif_loop_minus1.v
index fd991392a1..19cc0d7c95 100644
--- a/progs/verif_loop_minus1.v
+++ b/progs/verif_loop_minus1.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.loop_minus1.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
diff --git a/progs/verif_merge.v b/progs/verif_merge.v
index 21525aed33..68a4fe4627 100644
--- a/progs/verif_merge.v
+++ b/progs/verif_merge.v
@@ -1,9 +1,8 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.merge.
 Require Import VST.progs.list_dt. Import LsegSpecial.
 
-Open Scope logic.
-
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
@@ -123,12 +122,12 @@ Lemma list_cell_field_at sh (v : val) p :
 Proof.
   unfold list_cell, withspacer, field_at; simpl.
   f_equal.
-  apply ND_prop_ext.
+  f_equal. apply prop_ext.
   unfold field_compatible, legal_nested_field, legal_field in *; simpl.
   intuition. repeat constructor.
 Qed.
 
-Lemma entail_rewrite A B : (A |-- B) -> A = A && B.
+Lemma entail_rewrite (A B : mpred) : (A |-- B) -> A ⊣⊢ A && B.
 Proof.
   intros I.
   apply pred_ext.
@@ -144,11 +143,7 @@ Lemma list_append_null (cs : compspecs)
   |-- lseg ls sh (ct1 ++ ct2) hd nullval.
 Proof.
   intros.
-  assert (AP : forall P Q, (P * emp |-- Q * emp) -> P |-- Q).
-    intros.
-    eapply derives_trans; [ eapply derives_trans; [ | eassumption] | ]; cancel.
-  apply AP; clear AP.
-  apply (@list_append _ _ _ _ sh ls _ _ _ _ _ (fun _ => emp)).
+  iIntros "H"; iDestruct (list_append _ _ _ _ _ (fun _ => emp) with "[$H]") as "($ & _)".
   intros; unfold lseg_cell.
   rewrite (entail_rewrite _ _ (field_at_ptr_neq_null _ _ _ _ _)).
   rewrite field_at_isptr.
@@ -294,19 +289,15 @@ Time entailer!.  (* 42.3 sec -> 13.9 sec -> 11.4 sec *)
 rewrite butlast_snoc. rewrite last_snoc.
 rewrite (snoc merged) at 3 by auto.
 rewrite map_app. simpl map.
-unfold_data_at (data_at _ _ _ c_). 
-unfold_data_at (data_at _ _ _ a_).
-match goal with |- ?B * ?C * ?D * ?E * ?F * ?G * (?H * ?A) |-- _ =>
- apply derives_trans with ((H * A * G * C) * (B * D * E * F));
-  [cancel | ]
-end.
-eapply derives_trans; [apply sepcon_derives; [ | apply derives_refl] | ].
-assert (LCR := lseg_cons_right_neq LS sh (map Vint (butlast merged)) begin (Vint (last merged)) c_ a_' a_);
-simpl in LCR. rewrite list_cell_field_at, emp_sepcon in LCR. apply LCR; auto.
-rewrite @lseg_cons_eq.
+iIntros "(? & Ha_tail & ? & ? & ? & lc & Hc)".
+iPoseProof (lseg_cons_right_neq LS sh (map Vint (butlast merged)) begin (Vint (last merged)) c_ a_' a_ with "[$Ha_tail Hc $lc]") as "($ & ?)"; first auto.
+{ rewrite list_cell_field_at.
+  unfold_data_at (data_at _ _ _ c_); iDestruct "Hc" as "($ & $)". }
+iStopProof.
+rewrite lseg_cons_eq.
 Exists b_'.
 rewrite list_cell_field_at.
-entailer!.
+unfold_data_at (data_at _ _ _ a_); entailer!.
 
 (* other branch of the if: contradiction *)
 rewrite H2 in HeqB; inversion HeqB.
@@ -390,17 +381,13 @@ Exists a_'.
 Time entailer!. (* 14.3 sec *)
 pattern merged at 3; rewrite snoc by auto.
 rewrite map_app. simpl map.
-assert (LCR := lseg_cons_right_neq LS sh (map Vint (butlast merged)) begin (Vint (last merged)) c_ b_' b_).
-simpl in LCR. rewrite emp_sepcon, list_cell_field_at in LCR.
-unfold_data_at (data_at _ _ _ c_).
-unfold_data_at (data_at _ _ _ b_).
-match goal with |- ?B * ?C * ?D * ?E * (?F * ?A) |-- _ =>
- apply derives_trans with ((F * A * E * D) * (B * C)); [cancel | ]
-end.
-eapply derives_trans; [apply sepcon_derives; [ | apply derives_refl] | ].
-apply LCR; auto.
+iIntros "(? & ? & Hb_tail & lc & Hc)".
+iPoseProof (lseg_cons_right_neq LS sh (map Vint (butlast merged)) begin (Vint (last merged)) c_ b_' b_ with "[$Hb_tail Hc $lc]") as "($ & ?)"; first auto.
+{ rewrite list_cell_field_at.
+  unfold_data_at (data_at _ _ _ c_); iDestruct "Hc" as "($ & $)". }
+iStopProof.
 rewrite list_cell_field_at.
-cancel.
+unfold_data_at (data_at _ _ _ b_); entailer!.
 
 (* After the if, putting boolean value into "cond" *)
 clear -SH.
@@ -486,7 +473,7 @@ remember (hmerge :: tmerge) as merged.
     destruct a; [ apply prop_right; reflexivity | ].
     simpl map; rewrite lseg_unfold.
     subst a_; entailer!.
-    elim H6; clear; intuition auto with *.
+    elim H6; clear; simpl; auto.
   }
  subst a.
 
@@ -521,7 +508,7 @@ remember (hmerge :: tmerge) as merged.
  (* when merged = [] *)
  assert (begin = c_) by intuition. subst c_.
  Exists ab_; entailer!.
- rewrite H; auto. apply derives_refl.
+ rewrite H; auto.
 
  (* when merged <> [] *)
  remember (hmerge :: tmerge) as merged.
@@ -529,31 +516,22 @@ remember (hmerge :: tmerge) as merged.
  clear hmerge tmerge Heqmerged.
  Exists begin; entailer.
 
- (* to match the specification from the invariant, we split it into three parts: *)
-
-  assert (AP : forall M1 R1 M2 M3 M13 M R, R1 |-- R -> M1 * M3 |-- M13
-            -> M2 * M13 |-- M -> M1 * R1 * M2 * M3 |-- M * R). {
-   clear; intros.
-   apply derives_trans with (M * R1); cancel; auto.
-   now apply derives_trans with (M2 * M13); cancel; auto.
-  }
- apply AP with (lseg LS sh (Vint (last merged) :: map Vint (merge a b)) c_ nullval); clear AP.
  cancel.
-
- (* part 2 : we join the middle element and the right part of the list *)
- idtac.
- rewrite (lseg_unfold LS _ _ c_).
- Exists ab_; entailer!.
- rewrite list_cell_field_at.
- unfold_data_at (data_at _ _ _ _).
- simpl. cancel.
-
- (* part 3 : left part of the list *)
+ iIntros "(ab & c & abc)".
+ iAssert (lseg LS sh (Vint (last merged) :: map Vint (merge a b)) c_ nullval) with "[ab abc]" as "?".
+ { rewrite (lseg_unfold LS _ _ c_).
+   iStopProof.
+   Exists ab_; entailer!.
+   rewrite list_cell_field_at.
+   unfold_data_at (data_at _ _ _ _).
+   simpl. cancel. }
+
+ (* finally: left part of the list *)
  rewrite H.
  replace (merged ++ merge a b)
  with (butlast merged ++ (last merged :: merge a b)).
  rewrite map_app.
- apply list_append_null.
+ iApply (list_append_null with "[-]"); first by iFrame.
  clear -Hm.
  change (butlast merged ++ ([last merged] ++ merge a b) = merged ++ merge a b).
  rewrite app_assoc.
diff --git a/progs/verif_message.v b/progs/verif_message.v
index 084abf13e2..030906a87d 100644
--- a/progs/verif_message.v
+++ b/progs/verif_message.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.message.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
@@ -8,7 +9,6 @@ Definition Vprog : varspecs. mk_varspecs prog. Defined.
    of _Program Logics for Certified Compilers_, by Appel et al., 2014 *)
 
 Local Open Scope Z.
-Local Open Scope logic.
 
 (*   mf_assert msgfmt sh buf len data  := the [data] is formatted into a message
          at most [len] bytes,  stored starting at address [buf] with share [sh] *)
@@ -58,7 +58,7 @@ Next Obligation.
 compute; split; congruence.
 Qed.
 Next Obligation.
-  entailer!!.
+  entailer!.
   change 8 with (sizeof (tarray tint 2)).
   apply data_at_memory_block.
 Qed.
@@ -106,8 +106,8 @@ Definition main_spec :=
 
 Definition message (sh: share) {t: type} (format: message_format t) (m: val) : mpred :=
   EX fg: val*val,
-          func_ptr' (serialize_spec format) (fst fg) *
-          func_ptr' (deserialize_spec format) (snd fg) *
+          func_ptr (serialize_spec format) (fst fg) *
+          func_ptr (deserialize_spec format) (snd fg) *
        data_at sh t_struct_message (Vint (Int.repr (mf_size format)), (fst fg, snd fg)) m.
 
 Definition Gprog : funspecs :=   ltac:(with_library prog [
@@ -161,7 +161,7 @@ forward. (* y = ((int * )buf)[1]; *)
 forward. (* p->x = x; *)
 forward. (* p->y = y; *)
 entailer!.
-split; simpl; auto.
+simpl; auto.
 unfold mf_assert.
 simpl.
 entailer!!.
@@ -178,7 +178,7 @@ make_func_ptr _intpair_serialize.
 set (des := gv _intpair_deserialize).
 set (ser := gv _intpair_serialize).
 match goal with 
- |- context [mapsto_zeros 4 Ews _] => 
+ |- context [mapsto_zeros 4 Ews _] =>
   (* 64-bit mode *)
   sep_apply mapsto_zeros_memory_block; auto;
   gather_SEP (mapsto _ _ _ (offset_val 0 des))
@@ -220,8 +220,7 @@ assert_PROP (align_compatible tint v_buf).
   econstructor; [reflexivity | apply Z.divide_0_r].
 forward_call (* len = ser(&p, buf); *)
       ((Vint (Int.repr 1), Vint (Int.repr 2)), v_p, v_buf, Tsh, Tsh).
-  split3; auto.
-  repeat split; auto.
+{ simpl; auto. }
 Intros rest.
 simpl.
 Intros. subst rest.
diff --git a/progs/verif_min.v b/progs/verif_min.v
index 21b234855c..37ec9f2b22 100644
--- a/progs/verif_min.v
+++ b/progs/verif_min.v
@@ -8,6 +8,7 @@
 *)
 
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.min.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs.  mk_varspecs prog. Defined.
@@ -153,28 +154,13 @@ pose (Inv d (f: Z->Prop) (i: Z) :=
           temp _a a; temp _i (Vint (Int.repr i));
           temp _n (Vint (Int.repr n)))
     SEP(data_at Ews (tarray tint n) (map Vint (map Int.repr al)) a)).
-forward_for (Inv 0 (fun _ => True)) continue: (Inv 1 (Z.gt n)).
+forward_for (Inv 0 (fun _ => True%type)) continue: (Inv 1 (Z.gt n)).
 *
 forward.
 Exists 0. unfold Inv; entailer!!.
 *
 entailer!!.
 *
-match goal with
-| P := @abbreviate ret_assert _ |- _ => unfold abbreviate in P; subst P
-end.
-match goal with
-| |- semax _ _ ?c ?P =>
-    tryif (is_sequential false false c)
-    then (apply sequential; simpl_ret_assert;
-          match goal with |- semax _ _ _ ?Q =>
-             abbreviate Q : ret_assert as POSTCONDITION
-          end)
-    else abbreviate P : ret_assert as POSTCONDITION
-end.
-
-force_sequential.
-abbreviate_semax.
 rename a0 into i.
  forward. (* j = a[i]; *)
  assert (repable_signed (Znth i al))
@@ -197,37 +183,6 @@ rename a0 into i.
  forward. (* skip; *)
  entailer!!. rewrite Z.min_l; auto; lia.
  +
- intros.
- subst POSTCONDITION; unfold abbreviate. (* TODO: some of these lines should all be done by forward_if *)
- simpl_ret_assert.
-
-Ltac go_lower ::=
-clear_Delta_specs;
-intros;
-match goal with
- | |- local _ && PROPx _ (LOCALx _ (SEPx ?R)) |-- _ => check_mpreds R
- | |- ENTAIL _, PROPx _ (LOCALx _ (SEPx ?R)) |-- _ => check_mpreds R
- | |- ENTAIL _, _ |-- _ => fail 10 "The left-hand-side of your entailment is  not in PROP/LOCAL/SEP form"
- | _ => fail 10 "go_lower requires a proof goal in the form of (ENTAIL _ , _ |-- _)"
-end;
-clean_LOCAL_canon_mix;
-repeat (simple apply derives_extract_PROP; intro_PROP);
-let rho := fresh "rho" in
-intro rho;
-first
-[ simple apply quick_finish_lower
-|          
- (let TC := fresh "TC" in apply finish_lower; intros TC ||
- match goal with
- | |- (_ && PROPx nil _) _ |-- _ => fail 1 "LOCAL part of precondition is not a concrete list (or maybe Delta is not concrete)"
- | |- _ => fail 1 "PROP part of precondition is not a concrete list"
- end);
-unfold fold_right_sepcon; fold fold_right_sepcon; rewrite ?sepcon_emp; (* for the left side *)
-unfold_for_go_lower;
-simpl tc_val; simpl msubst_denote_tc_assert;
-try clear dependent rho;
-clear_Delta
-].
 Exists i. apply ENTAIL_refl.
 *
  rename a0 into i.
@@ -319,6 +274,5 @@ forward_if.
  Intros x.
  autorewrite with sublist in *.
  forward. (* return *)
- Exists x.
- entailer!!.
+ Exists x; entailer!.
 Qed.
diff --git a/progs/verif_min64.v b/progs/verif_min64.v
index dfad32d372..6ecf5ed90a 100644
--- a/progs/verif_min64.v
+++ b/progs/verif_min64.v
@@ -5,6 +5,7 @@
 *)
 
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.min64.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs.  mk_varspecs prog. Defined.
diff --git a/progs/verif_nest2.v b/progs/verif_nest2.v
index 5201b69f1e..ee30410da9 100644
--- a/progs/verif_nest2.v
+++ b/progs/verif_nest2.v
@@ -1,11 +1,10 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.nest2.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
-Local Open Scope logic.
-
 Definition t_struct_b := Tstruct _b noattr.
 
 Definition get_spec :=
@@ -75,4 +74,3 @@ unfold_repinj.
 Time forward. (* 1.23 sec *)
 entailer!!.
 Time Qed.  (*  28 sec -> 3.45 sec *)
-
diff --git a/progs/verif_nest3.v b/progs/verif_nest3.v
index efa7958da6..534337278f 100644
--- a/progs/verif_nest3.v
+++ b/progs/verif_nest3.v
@@ -1,10 +1,9 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.nest3.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
-Local Open Scope logic.
-
 Definition t_struct_c := Tstruct _c noattr.
 
 Definition get_spec0 :=
diff --git a/progs/verif_object.v b/progs/verif_object.v
index a3c79d3367..0f604e9ac7 100644
--- a/progs/verif_object.v
+++ b/progs/verif_object.v
@@ -5,8 +5,11 @@ Require Import VST.progs.object.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
+Section Spec.
+
+Context  `{!default_VSTGS Σ}.
+
 Local Open Scope Z.
-Local Open Scope logic.
 
 Definition object_invariant := list Z -> val -> mpred.
 
@@ -29,39 +32,39 @@ Definition twiddle_spec (instance: object_invariant) :=
           PARAMS (self; Vint (Int.repr i))
           SEP (instance history self)
   POST [ tint ]
-      EX v: Z, 
+      ∃ v: Z, 
           PROP(2* fold_right Z.add 0 history < v <= 2* fold_right Z.add 0 (i::history))
           RETURN (Vint (Int.repr v))
           SEP(instance (i::history) self).
 
 Definition object_methods (instance: object_invariant) (mtable: val) : mpred :=
-  EX sh: share, EX reset: val, EX twiddle: val,
-  !! readable_share sh && 
-  func_ptr' (reset_spec instance) reset *
-  func_ptr' (twiddle_spec instance) twiddle *
+  ∃ (sh: share) (reset: val) (twiddle: val),
+  ⌜readable_share sh⌝ ∧
+  func_ptr (reset_spec instance) reset ∗
+  func_ptr (twiddle_spec instance) twiddle ∗
   data_at sh (Tstruct _methods noattr) (reset,twiddle) mtable.
 
 Lemma object_methods_local_facts: forall instance p,
-  object_methods instance p |-- !! isptr p.
+  object_methods instance p ⊢ ⌜isptr p⌝.
 Proof.
 intros.
 unfold object_methods.
 Intros sh reset twiddle.
 entailer!.
 Qed.
-#[export] Hint Resolve object_methods_local_facts : saturate_local.
+Hint Resolve object_methods_local_facts : saturate_local.
 
 Definition object_mpred (history: list Z) (self: val) : mpred :=
-  EX instance: object_invariant, EX mtable: val, 
-       (object_methods instance mtable *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable self*
+  ∃ (instance: object_invariant) (mtable: val), 
+       (object_methods instance mtable ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable self∗
      instance history self).
 
 Definition foo_invariant : object_invariant :=
   (fun (history: list Z) p =>
     withspacer Ews (sizeof size_t + sizeof tint) (2 * sizeof size_t) (field_at Ews (Tstruct _foo_object noattr) 
             [StructField _data] (Vint (Int.repr (2*fold_right Z.add 0 history)))) p
-      *  malloc_token Ews (Tstruct _foo_object noattr) p).
+      ∗  malloc_token Ews (Tstruct _foo_object noattr) p).
 
 Definition foo_reset_spec :=
  DECLARE _foo_reset (reset_spec foo_invariant).
@@ -76,7 +79,7 @@ Definition make_foo_spec :=
     PROP () PARAMS() GLOBALS (gv) 
     SEP (mem_mgr gv; object_methods foo_invariant (gv _foo_methods))
  POST [ tobject ]
-    EX p: val, PROP () RETURN (p)
+    ∃ p: val, PROP () RETURN (p)
      SEP (mem_mgr gv; object_mpred nil p; object_methods foo_invariant (gv _foo_methods)).
 
 Definition main_spec :=
@@ -84,21 +87,28 @@ Definition main_spec :=
   WITH gv: globals
   PRE  [] main_pre prog tt gv
   POST [ tint ]
-     EX i:Z, PROP(0<=i<=6) RETURN (Vint (Int.repr i)) SEP(TT).
+     ∃ i:Z, PROP(0<=i<=6) RETURN (Vint (Int.repr i)) SEP(True).
 
 Definition Gprog : funspecs :=   ltac:(with_library prog [
     foo_reset_spec; foo_twiddle_spec; make_foo_spec; main_spec]).
 
 Lemma object_mpred_i:
   forall (history: list Z) (self: val) (instance: object_invariant) (mtable: val),
-    object_methods instance mtable *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable self *
+    object_methods instance mtable ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable self ∗
      instance history self 
-    |-- object_mpred history self.
+    ⊢ object_mpred history self.
 Proof.
 intros. unfold object_mpred. Exists instance mtable; auto.
 Qed.
 
+
+Lemma bind_ret0_unfold:
+  forall Q, bind_ret None tvoid Q ⊣⊢ (assert_of (fun rho => Q (globals_only rho))).
+Proof.
+  rewrite /bind_ret; split => rho; monPred.unseal; done.
+Qed.
+
 Lemma body_foo_reset: semax_body Vprog Gprog f_foo_reset foo_reset_spec.
 Proof.
 unfold foo_reset_spec, foo_invariant, reset_spec.
@@ -128,30 +138,23 @@ simpl.
 Exists (2 * fold_right Z.add 0 history + i).
 simpl;
 entailer!!.
-rewrite Z.mul_add_distr_l, Z.add_comm.
+rewrite ->Z.mul_add_distr_l, Z.add_comm.
 unfold withspacer; simpl.
 entailer!!.
 Qed.
 
 Lemma split_object_methods:
   forall instance m, 
-    object_methods instance m |-- object_methods instance m * object_methods instance m.
+    object_methods instance m ⊢ object_methods instance m ∗ object_methods instance m.
 Proof.
 intros.
 unfold object_methods.
 Intros sh reset twiddle.
-
-Exists (fst (slice.cleave sh)) reset twiddle.
-Exists (snd (slice.cleave sh)) reset twiddle.
-rewrite (split_func_ptr' (reset_spec instance) reset) at 1.
-rewrite (split_func_ptr' (twiddle_spec instance) twiddle) at 1.
-entailer!!.
-split.
-apply slice.cleave_readable1; auto.
-apply slice.cleave_readable2; auto.
-rewrite (data_at_share_join (fst (slice.cleave sh)) (snd (slice.cleave sh)) sh).
-auto.
-apply slice.cleave_join.
+destruct (slice.split_readable_share sh) as (sh1 & sh2 & ? & ? & ?); [assumption|].
+Exists sh1 reset twiddle.
+Exists sh2 reset twiddle.
+rewrite <- (data_at_share_join sh1 sh2 sh) by assumption.
+iIntros "(#$ & #$ & $ & $)"; auto.
 Qed.
 
 Lemma body_make_foo: semax_body Vprog Gprog f_make_foo make_foo_spec.
@@ -174,7 +177,7 @@ if_tac; entailer!!.
 forward_call 1.
 contradiction.
 *
-rewrite if_false by auto.
+rewrite ->if_false by auto.
 Intros.
 forward.  (*  /*skip*/;  *)
 entailer!!.
@@ -194,9 +197,7 @@ unfold_data_at (field_at _ _ nil _ p).
 cancel.
 unfold withspacer; simpl.
 rewrite !field_at_data_at.
-simpl.
-apply derives_refl'.
-rewrite <- ?sepcon_assoc. (* needed if Archi.ptr64=true *)
+cancel.
 rewrite !field_compatible_field_address; auto with field_compatible.
 clear - H.
 (* TODO: simplify the following proof. *)
@@ -220,14 +221,13 @@ reflexivity.
 left; auto.
 Qed.
 
-
 Lemma make_object_methods:
-  forall sh instance reset twiddle mtable,
+  forall sh instance reset twiddle (mtable: val),
   readable_share sh ->
-  func_ptr' (reset_spec instance) reset *
-  func_ptr' (twiddle_spec instance) twiddle *
+  func_ptr (reset_spec instance) reset ∗
+  func_ptr (twiddle_spec instance) twiddle ∗
   data_at sh (Tstruct _methods noattr) (reset, twiddle) mtable
-  |-- object_methods instance mtable.
+  ⊢ object_methods instance mtable.
 Proof.
   intros.
   unfold object_methods.
@@ -238,7 +238,7 @@ Qed.
 Ltac method_call witness hist' result :=
 repeat apply seq_assoc1;
 match goal with 
-   |- semax _ (PROPx _ (LOCALx ?Q (SEPx ?R))) 
+   |- semax _ _ (PROPx _ (LOCALx ?Q (SEPx ?R))) 
             (Ssequence (Sset ?mt (Efield (Ederef (Etempvar ?x _)  _) _ _))
                  _) _  =>
     match Q with context [temp ?x ?x'] =>
@@ -252,7 +252,7 @@ match goal with
           forward;
           forward_call witness;
           [ .. | try Intros result;
-                  sep_apply (make_object_methods sh instance r t mtable); [ auto .. | ];
+                  sep_apply (make_object_methods sh instance r t mtable); first auto;
                   sep_apply (object_mpred_i hist' x' instance mtable);
                   deadvars; try clear dependent sh; try clear r; try clear t
            ]
@@ -273,8 +273,8 @@ replace_SEP 0 (data_at Ews (Tstruct _methods noattr)
   unfold_data_at (data_at _ (Tstruct _methods _) _ (gv _foo_methods)).
   rewrite <- mapsto_field_at with (gfs := [StructField _twiddle]) (v:= (gv _foo_twiddle))
   by  auto with field_compatible.
-  rewrite field_at_data_at.  rewrite !field_compatible_field_address by auto with field_compatible.
-  rewrite !isptr_offset_val_zero by auto.
+  rewrite field_at_data_at.  rewrite ->!field_compatible_field_address by auto with field_compatible.
+  rewrite ->!isptr_offset_val_zero by auto.
   cancel.
 }
 
@@ -293,11 +293,10 @@ assert_PROP (p<>Vundef) by entailer!.
    Method 1:  comment out lines AA and BB and the entire range CC-DD.
    Method 2:  comment out lines AA-BB, inclusive.
 *)
-
-(* AA *) try (tryif 
+(* AA *) try (tryif
   (method_call (p, @nil Z) (@nil Z) whatever;
-   method_call (p, 3, @nil Z) [3%Z] i;
-     [simpl; computable | ])
+   method_call (p, 3, @nil Z) [3%Z] i(*;
+     [simpl; computable | ]*))
 (* BB *)  then fail else fail 99)
   .
 
@@ -326,7 +325,7 @@ forward.   (* p_twiddle = mtable->twiddle; *)
 assert_PROP (p<>Vundef) by entailer!.
 forward_call (* i = p_twiddle(p,3); *)
       (p, 3, @nil Z).
-  simpl. computable.
+{ simpl; computable. }
 Intros i.
 simpl in H0.
 sep_apply (make_object_methods sh instance r0 t0 mtable0); auto.
@@ -341,7 +340,4 @@ forward.  (* return i; *)
 Exists i; entailer!!.
 Qed.
 
-
-
-
-
+End Spec.
diff --git a/progs/verif_objectSelf.v b/progs/verif_objectSelf.v
index 41a6ebb71f..f63dadffba 100644
--- a/progs/verif_objectSelf.v
+++ b/progs/verif_objectSelf.v
@@ -1,81 +1,85 @@
+Require Import iris.bi.lib.fixpoint.
 Require Import VST.floyd.proofauto.
 Require Import VST.floyd.library.
 Require Import VST.progs.objectSelf.
 
-Require Import VST.floyd.Funspec_old_Notation.
-
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
-Local Open Scope Z.
-Local Open Scope logic.
+Section mpred.
+
+Context `{!default_VSTGS Σ}.
 
 (*Andrew's definition
 Definition object_invariant := list Z -> val -> mpred.*)
 
-(*But the uncurried version is easier for the HOrec construction*)
+(*But the uncurried version is easier for the fixpoint construction*)
 Definition ObjInv : Type:= (list Z * val).
-Definition object_invariant := ObjInv -> mpred.
+Definition object_invariant := ObjInv -d> mpred.
 
 Definition tobject := tptr (Tstruct _object noattr).
 
 Definition reset_spec (instance: object_invariant) :=
   WITH hs:ObjInv (*modified*)
-  PRE [ _self OF tobject]
+  PRE [ tobject]
           PROP (isptr (snd hs) (*NEW*))
-          LOCAL (temp _self (snd hs))
+          PARAMS (snd hs)
           SEP (instance hs)
   POST [ tvoid ]
           PROP() LOCAL () SEP(instance (nil, snd hs)).
 
 Definition twiddle_spec (instance: object_invariant) :=
   WITH hs: ObjInv, i: Z (*modified*)
-  PRE [ _self OF tobject, _i OF tint]
+  PRE [ tobject, tint]
           PROP (0 < i <= Int.max_signed / 4;
-                0 <= fold_right Z.add 0 (fst hs) <= Int.max_signed / 4; 
+                0 <= fold_right Z.add 0 (fst hs) <= Int.max_signed / 4;
                isptr (snd hs) (*NEW*))
-          LOCAL (temp _self (snd hs); temp _i (Vint (Int.repr i)))
+          PARAMS (snd hs; Vint (Int.repr i))
           SEP (instance hs)
   POST [ tint ]
-      EX v: Z, 
+      ∃ v: Z,
           PROP(2* fold_right Z.add 0 (fst hs) < v <= 2* fold_right Z.add 0 (i::(fst hs)))
           LOCAL (temp ret_temp (Vint (Int.repr v))) 
           SEP(instance (i::(fst hs), snd hs)).
-(*
-Require Import VST.concurrency.conclib.
-Require Import VST.concurrency.semax_conc.
-Require Import VST.msl.seplog.
-Require Import VST.msl.predicates_hered.
-Lemma Contractive: forall Q R v, 
-  predicates_hered.allp (fun x : ObjInv => |> R x <=> |> Q x)
-  |-- func_ptr (reset_spec R) v <=> func_ptr (reset_spec Q) v.
-Proof. intros. rewrite fash_andp. apply andp_right. 
-+ red. intros n N. unfold func_ptr, func_ptr_si. apply subp_exp.
-Search seplog.imp fash. exp.
- red. intros r. simpl. apply subp_i1. Search fash seplog.imp. unfold func_ptr, func_ptr_si.
-apply eqp_exp. p_right. red.
-   *)
+
 Definition object_methods (instance: object_invariant) (mtable: val) : mpred :=
-  EX sh: share, EX reset: val, EX twiddle: val, EX twiddleR:val,
-  !! readable_share sh && 
-  func_ptr' (reset_spec instance) reset *
-  func_ptr' (twiddle_spec instance) twiddle *
-  func_ptr' (twiddle_spec instance) twiddleR *
+  ∃ sh: share, ∃ reset: val, ∃ twiddle: val, ∃ twiddleR:val,
+  ⌜readable_share sh⌝ ∧
+  func_ptr (reset_spec instance) reset ∗
+  func_ptr (twiddle_spec instance) twiddle ∗
+  func_ptr (twiddle_spec instance) twiddleR ∗
   data_at sh (Tstruct _methods noattr) (reset,(twiddle, twiddleR)) mtable.
 
+Global Instance reset_spec_ne : NonExpansive reset_spec.
+Proof.
+  intros ????.
+  unfold reset_spec, NDmk_funspec.
+  f_equiv; intros ??; simpl; by repeat f_equiv.
+Qed.
+
+Global Instance twiddle_spec_ne : NonExpansive twiddle_spec.
+Proof.
+  intros ????.
+  unfold twiddle_spec, NDmk_funspec.
+  f_equiv; intros ??; simpl; by repeat f_equiv.
+Qed.
+
+Global Instance object_methods_ne n : Proper (dist n ==> eq ==> dist n) object_methods.
+Proof. solve_proper. Qed.
+
 Lemma object_methods_local_facts: forall instance p,
-  object_methods instance p |-- !! isptr p.
+  object_methods instance p ⊢ ⌜isptr p⌝.
 Proof.
 intros.
 unfold object_methods.
 Intros sh reset twiddle twiddleR.
 entailer!.
 Qed.
-#[export] Hint Resolve object_methods_local_facts : saturate_local.
+Hint Resolve object_methods_local_facts : saturate_local.
 
 (*Andrew's definition
-Definition object_mpred (history: list Z) (self: val) : mpred :=
-  EX instance: object_invariant, EX mtable: val, 
+Definition obj_mpred (history: list Z) (self: val) : mpred :=
+  ∃ instance: object_invariant, ∃ mtable: val, 
        (object_methods instance mtable *
      field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable self*
      instance history self).*)
@@ -83,251 +87,57 @@ Definition object_mpred (history: list Z) (self: val) : mpred :=
 Section ObjMpred.
 Variable instance: object_invariant.
 
-Definition F (X: ObjInv -> mpred) (hs: ObjInv): mpred :=
-   ((EX mtable: val, !!(isptr mtable) (*This has to hold NOW, not ust LATER*)&&
-     (|> object_methods X mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   instance hs)%logic.
-
-Definition HOcontractive1 {A: Type}{NA: NatDed A}{IA: Indir A}{RI: RecIndir A}{X: Type}
-     (f: (X -> A) -> (X -> A)) := 
- forall P Q : X -> A,
- ALL x : X, |> fash (P x <--> Q x)
- |-- ALL x : X, fash (f P x --> f Q x).
-
-Lemma HOcontractive_i1:
- forall  (A: Type)(NA: NatDed A){IA: Indir A}{RI: RecIndir A}{X: Type}
-     (f: (X -> A) -> (X -> A)),
-  HOcontractive1 f -> HOcontractive f.
-Proof.
-intros.
-red in H|-*.
-intros.
-eapply derives_trans.
-apply andp_right.
-apply H.
-specialize (H Q P).
-eapply derives_trans.
-2: apply H.
-apply allp_derives; intros.
-apply later_derives.
-apply fash_derives.
-rewrite andp_comm.
-auto.
-apply allp_right; intro.
-rewrite fash_andp.
-apply andp_right.
-apply andp_left1.
-apply allp_left with v; auto.
-apply andp_left2.
-apply allp_left with v; auto.
-Qed.
+Definition F (X: ObjInv -d> mpred) : ObjInv -d> mpred := fun hs =>
+   ((∃ mtable: val, ⌜isptr mtable⌝ (*This has to hold NOW, not just LATER*)∧
+     (▷ object_methods X mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   instance hs)%I.
 
-Lemma HOcontrF
-     (*Need sth like this (HI: HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => instance x))*):
-      HOcontractive F.
+Local Instance F_contractive : Contractive F.
 Proof.
-unfold F.
-apply HOcontractive_i1.
-red; intros.
-apply allp_right; intro oi.
-apply subp_sepcon_mpred; [ | apply subp_refl].
-apply subp_exp; intro v.
-apply subp_sepcon_mpred; [ | apply subp_refl].
-clear oi.
-apply subp_andp; [ apply subp_refl | ].
-eapply derives_trans, subp_later1.
-rewrite <- later_allp.
-apply later_derives.
-unfold object_methods.
-apply subp_exp; intro sh.
-apply subp_exp; intro reset.
-apply subp_exp; intro twiddle.
-apply subp_exp; intro twiddleR.
-apply subp_sepcon_mpred; [ | apply subp_refl].
-repeat simple apply subp_sepcon_mpred;
-try (simple apply subp_andp; [simple apply subp_refl | ]).
-+
-unfold func_ptr'.
-apply subp_andp; [ | apply subp_refl].
-clear - instance.
-eapply derives_trans; [ | apply fash_func_ptr_ND].
-apply allp_right; intro oi.
-apply andp_right.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold convertPre.
-unfold PROPx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-rewrite prop_true_andp by tauto.
-subst zz.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with oi.
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left2. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold convertPre.
-unfold PROPx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-subst zz.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with ([], snd oi).
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left1. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-+
-unfold func_ptr'.
-apply subp_andp; [ | apply subp_refl].
-clear - instance.
-eapply derives_trans; [ | apply fash_func_ptr_ND].
-apply allp_right; intros [hs i].
-apply andp_right.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold convertPre.
-unfold PROPx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-rewrite prop_true_andp by tauto.
-subst zz.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with hs.
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left2. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold PROPx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-subst zz.
-apply exp_right with x.
-normalize.
-rewrite prop_true_andp by tauto.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with (i::fst hs, snd hs).
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left1. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-+
-unfold func_ptr'.
-apply subp_andp; [ | apply subp_refl].
-clear - instance.
-eapply derives_trans; [ | apply fash_func_ptr_ND].
-apply allp_right; intros [hs i].
-apply andp_right.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold convertPre.
-unfold PROPx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-rewrite prop_true_andp by tauto.
-subst zz.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with hs.
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left2. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold PROPx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-subst zz.
-apply exp_right with x.
-normalize.
-rewrite prop_true_andp by tauto.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with (i::fst hs, snd hs).
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left1. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
+  intros ?????.
+  unfold F.
+  do 5 f_equiv.
+  f_contractive.
+  rewrite H //.
 Qed.
 
-Definition obj_mpred:ObjInv -> mpred := (HORec F). (*ie same type as Andrew's object_mpred.*)
+Definition obj_mpred:ObjInv -> mpred := fixpoint F.
 
-Lemma ObjMpred_fold_unfold: 
-HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => instance x) ->
-obj_mpred = 
-fun hs => 
-  ((EX mtable: val,!!(isptr mtable) &&
-     (|> object_methods obj_mpred mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   instance hs)%logic.
+Lemma ObjMpred_fold_unfold:
+forall hs, obj_mpred hs ⊣⊢
+  ((∃ mtable: val,⌜isptr mtable⌝ ∧
+     (▷ object_methods obj_mpred mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   instance hs).
 Proof.
   intros; unfold obj_mpred at 1.
-  rewrite HORec_fold_unfold; [ reflexivity | apply HOcontrF]; trivial.
+  by rewrite (fixpoint_unfold F _).
 Qed.
-Lemma ObjMpred_fold_unfold' hs: 
-HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => instance x) ->
-obj_mpred hs = 
-  ((EX mtable: val, !!(isptr mtable) &&
-     (|> object_methods obj_mpred mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   instance hs)%logic.
+Lemma ObjMpred_fold_unfold' hs:
+obj_mpred hs ⊣⊢
+  ((∃ mtable: val, ⌜isptr mtable⌝ ∧
+     (▷ object_methods obj_mpred mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   instance hs).
 Proof.
-  intros. rewrite ObjMpred_fold_unfold, <- ObjMpred_fold_unfold; trivial. 
+  intros. rewrite ObjMpred_fold_unfold -ObjMpred_fold_unfold; trivial.
 Qed.
 
-Lemma ObjMpred_isptr
-   (H: HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => instance x))
-    hs: obj_mpred hs |-- !!(isptr (snd hs)).
-Proof. rewrite ObjMpred_fold_unfold' by trivial; Intros m. entailer!. Qed.
+Lemma ObjMpred_isptr hs: obj_mpred hs ⊢ ⌜isptr (snd hs)⌝.
+Proof. rewrite -> ObjMpred_fold_unfold' by trivial; Intros m. entailer!. Qed.
 
 End ObjMpred.
 
 Definition object_mpred: object_invariant := fun hs =>
-  EX instance, !!(HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => instance x)) &&
-               obj_mpred instance hs.
+  ∃ instance, obj_mpred instance hs.
 (*This now plays the role of Andrew's obj_mpred*)
 
-Lemma object_mpred_isptr hs: object_mpred hs |-- !!(isptr (snd hs)).
+Lemma object_mpred_isptr hs: object_mpred hs ⊢ ⌜isptr (snd hs)⌝.
 Proof. unfold object_mpred; Intros inst. apply ObjMpred_isptr; trivial. Qed.
 
-Lemma obj_mpred_entails_object_mpred inst hs
-  (H: HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => inst x)):
-  obj_mpred inst hs |-- object_mpred hs.
+Lemma obj_mpred_entails_object_mpred inst hs:
+  obj_mpred inst hs ⊢ object_mpred hs.
 Proof. unfold object_mpred. Exists inst. entailer!. Qed.
 
 (*Andrew's specs 
@@ -352,8 +162,8 @@ Definition make_foo_spec :=
     PROP () LOCAL (gvars gv) 
     SEP (mem_mgr gv; object_methods foo_invariant (gv _foo_methods))
  POST [ tobject ]
-    EX p: val, PROP () LOCAL (temp ret_temp p)
-     SEP (mem_mgr gv; object_mpred (*nil p*)(nil, p); object_methods foo_invariant (gv _foo_methods)).
+    ∃ p: val, PROP () LOCAL (temp ret_temp p)
+     SEP (mem_mgr gv; obj_mpred (*nil p*)(nil, p); object_methods foo_invariant (gv _foo_methods)).
 
 *)
 
@@ -362,44 +172,40 @@ Definition foo_data : object_invariant :=
   (fun (x:ObjInv) => 
     withspacer Ews (sizeof size_t + sizeof tint) (2 * sizeof size_t) (field_at Ews (Tstruct _foo_object noattr) 
             [StructField _data] (Vint (Int.repr (2*fold_right Z.add 0 (fst x))))) (snd x)
-      *  malloc_token Ews (Tstruct _foo_object noattr) (snd x)).
-Lemma foo_data_HOcontr: HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => foo_data x).
-Proof.
-  assert (predicates_rec.HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => foo_data x)). 2: constructor; apply H.
-  unfold foo_data.
-  unfold withspacer; simpl.
-  apply Trashcan.sepcon_HOcontractive.
-  apply Trashcan.const_HOcontractive.
-  apply Trashcan.const_HOcontractive.
-Qed.
+      ∗ malloc_token Ews (Tstruct _foo_object noattr) (snd x)).
 
 Definition foo_obj_invariant :object_invariant := obj_mpred foo_data.
 
 (*New lemma!*)
-Lemma foo_obj_invariant_fold_unfold: foo_obj_invariant =
+Lemma foo_obj_invariant_fold_unfold: foo_obj_invariant ≡
  fun hs =>
-  ((EX mtable: val, !!(isptr mtable) &&
-     (|>object_methods foo_obj_invariant  mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   foo_data hs)%logic.
+  ((∃ mtable: val, ⌜isptr mtable⌝ ∧
+     (▷object_methods foo_obj_invariant  mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   foo_data hs).
 Proof.
-  unfold foo_obj_invariant.
-  rewrite <- ObjMpred_fold_unfold. trivial. apply foo_data_HOcontr.
+  unfold foo_obj_invariant; intros ?.
+  rewrite <- ObjMpred_fold_unfold. trivial.
 Qed.
 
 (*Sometimes this variant is preferable, sometimes the one above*)
-Lemma foo_obj_invariant_fold_unfold' hs: foo_obj_invariant hs =
-  ((EX mtable: val, !!(isptr mtable) &&
-     (|>object_methods foo_obj_invariant  mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   foo_data hs)%logic.
-Proof. rewrite foo_obj_invariant_fold_unfold. rewrite <- foo_obj_invariant_fold_unfold; trivial. Qed.
-
-Lemma foo_data_isptr hs: foo_data hs = !!(isptr (snd hs)) && foo_data hs.
-apply pred_ext; entailer.
-unfold foo_data. entailer!. destruct (snd hs); simpl in *; trivial;  contradiction.
+Lemma foo_obj_invariant_fold_unfold' hs: foo_obj_invariant hs ⊣⊢
+  ((∃ mtable: val, ⌜isptr mtable⌝ ∧
+     (▷object_methods foo_obj_invariant  mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   foo_data hs).
+Proof. apply (foo_obj_invariant_fold_unfold hs). Qed.
+
+Lemma foo_data_isptr hs: foo_data hs ⊣⊢ ⌜isptr (snd hs)⌝ ∧ foo_data hs.
+Proof.
+  iSplit.
+  - iIntros; iSplit; last done.
+    unfold foo_data; iStopProof.
+    destruct (hs.2); entailer!.
+  - iIntros "(_ & $)".
 Qed.
 
+
 Definition foo_reset_spec :=
  DECLARE _foo_reset (reset_spec foo_obj_invariant).
 
@@ -413,10 +219,10 @@ Definition make_foo_spec :=
  DECLARE _make_foo
  WITH gv: globals
  PRE [ ]
-    PROP () LOCAL (gvars gv) 
+    PROP () PARAMS () GLOBALS (gv)
     SEP (mem_mgr gv; object_methods foo_obj_invariant (gv _foo_methods))
  POST [ tobject ]
-    EX p: val, PROP () LOCAL (temp ret_temp p)
+    ∃ p: val, PROP () LOCAL (temp ret_temp p)
      SEP (mem_mgr gv; object_mpred (nil,p); object_methods foo_obj_invariant (gv _foo_methods)).
 End NewSpecs.
 
@@ -425,24 +231,24 @@ Definition main_spec :=
   WITH gv: globals
   PRE  [] main_pre prog tt gv
   POST [ tint ]
-     EX i:Z, PROP(0<=i<=6) LOCAL (temp ret_temp (Vint (Int.repr i))) SEP(TT).
+     ∃ i:Z, PROP(0<=i<=6) LOCAL (temp ret_temp (Vint (Int.repr i))) SEP(True).
 
 Definition Gprog : funspecs :=   ltac:(with_library prog [
     foo_reset_spec; foo_twiddle_spec; foo_twiddleR_spec; make_foo_spec; main_spec]).
 
-(*Redundant given obj_mpred_entails_object_mpred and the fact that our funspecs yield a folded  obj_mpred.
-Lemma object_mpred_i:
+(*Redundant given obj_mpred_entails_obj_mpred and the fact that our funspecs yield a folded  obj_mpred.
+Lemma obj_mpred_i:
   forall (*(history: list Z) (self: val)*)(x:ObjInv) (instance: object_invariant) (mtable: val)
   ((*NEW*)CONTR: HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => instance x)),
-  match x with (history, self) => !!(isptr mtable) &&
-     (|>object_methods instance mtable) *
+  match x with (history, self) => ⌜isptr mtable) ∧
+     (▷object_methods instance mtable) *
      field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable self *
      instance (*history self*)x 
-    |-- object_mpred (*history self*)x
+    ⊢ obj_mpred (*history self*)x
   end.
 Proof.
-(*intros. unfold object_mpred. Exists instance mtable; auto.*)
-intros. destruct x as [history self]. unfold object_mpred. Exists instance. entailer!.
+(*intros. unfold obj_mpred. Exists instance mtable; auto.*)
+intros. destruct x as [history self]. unfold obj_mpred. Exists instance. entailer!.
 rewrite ObjMpred_fold_unfold by trivial.
 Exists mtable. simpl. entailer!.
 unfold object_methods. apply later_derives.
@@ -451,17 +257,17 @@ apply exp_derives; intros r.
 apply exp_derives; intros t.
 apply exp_derives; intros tR. entailer!.
 apply sepcon_derives. admit.
-apply func_ptr'_mono. clear - CONTR. do_funspec_sub.
+apply func_ptr_mono. clear - CONTR. do_funspec_sub.
  rewrite ObjMpred_fold_unfold by trivial.
 Exists w; destruct w; entailer!. unfold convertPre. Intros.
-Exists (EX mtable : val,
- !! isptr mtable && |> object_methods (obj_mpred instance) mtable *
+Exists (∃ mtable : val,
+ ⌜isptr mtable ∧ ▷ object_methods (obj_mpred instance) mtable *
  field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd o)).
 entailer!.
 intros. Exists mtable x0. entailer!. destruct w.
- Exists w (EX mtable : val,
-      !! isptr mtable &&
-      |> object_methods (obj_mpred instance) mtable *
+ Exists w (∃ mtable : val,
+      ⌜isptr mtable ∧
+      ▷ object_methods (obj_mpred instance) mtable *
       field_at Ews (Tstruct _object noattr) [
         StructField _mtable] mtable (snd hs)). entailer!.
   intros. destruct w as [hist i]. 
@@ -481,18 +287,18 @@ all: unfold withspacer; simpl; entailer!.  (* needed if Archi.ptr64=true *)
 Qed.*)
 Lemma body_foo_reset: semax_body Vprog Gprog f_foo_reset foo_reset_spec.
 Proof.
-start_function. 
-(*New:*) rewrite foo_obj_invariant_fold_unfold. Intros m; unfold foo_data.
+start_function.
+(*New:*) rewrite foo_obj_invariant_fold_unfold'. Intros m; unfold foo_data.
 unfold withspacer; simpl; Intros.
 forward.  (* self->data=0; *)
 entailer!!.
-(*New:*) rewrite foo_obj_invariant_fold_unfold, <- foo_obj_invariant_fold_unfold. Exists m; unfold foo_data.
+(*New:*) rewrite foo_obj_invariant_fold_unfold'. Exists m; unfold foo_data.
 all: unfold withspacer; simpl; entailer!.  (* needed if Archi.ptr64=true *)
 Qed.
 
-Lemma body_foo_reset_alternativeproof: semax_body Vprog Gprog f_foo_reset foo_reset_spec.
+(*Lemma body_foo_reset_alternativeproof: semax_body Vprog Gprog f_foo_reset foo_reset_spec.
 Proof.
-(*New*) unfold foo_reset_spec. rewrite foo_obj_invariant_fold_unfold; unfold reset_spec.
+(*New*) unfold foo_reset_spec. rewrite foo_obj_invariant_fold_unfold'; unfold reset_spec.
 start_function. 
 (*New:*) Intros m; unfold foo_data.
 unfold withspacer; simpl; Intros.
@@ -500,12 +306,13 @@ forward.  (* self->data=0; *)
 entailer!!.
 (*New:*) Exists m; unfold foo_data.
 all: unfold withspacer; simpl; entailer!!.  (* needed if Archi.ptr64=true *)
-Qed.
+Qed.*)
 
 Lemma body_foo_twiddle: semax_body Vprog Gprog f_foo_twiddle foo_twiddle_spec.
 Proof.
-(*New*) unfold foo_twiddle_spec. rewrite foo_obj_invariant_fold_unfold; unfold twiddle_spec.
+(*New*) unfold foo_twiddle_spec. unfold twiddle_spec.
 start_function.
+rewrite foo_obj_invariant_fold_unfold'.
 (*New:*) Intros m; unfold foo_data.
 unfold withspacer; simpl.
 Intros.
@@ -520,10 +327,11 @@ forward.  (* return d+i; *)
   forget (fold_right Z.add 0 (*history*)(fst hs)) as h.
   entailer!!. }
 Exists (2 * fold_right Z.add 0 (*history*)(fst hs) + i).
+rewrite foo_obj_invariant_fold_unfold'.
 (*New:*) Exists m; unfold foo_data.
 simpl;
 entailer!!.
-rewrite Z.mul_add_distr_l, Z.add_comm.
+rewrite Z.mul_add_distr_l Z.add_comm.
 unfold withspacer; simpl.
 entailer!!.
 Qed.
@@ -532,11 +340,11 @@ Qed.
 Lemma make_object_methods:
   forall sh instance reset twiddle twiddleR mtable,
   readable_share sh ->
-  func_ptr' (reset_spec instance) reset *
-  func_ptr' (twiddle_spec instance) twiddle *
-  func_ptr' (twiddle_spec instance) twiddleR * 
+  func_ptr (reset_spec instance) reset ∗
+  func_ptr (twiddle_spec instance) twiddle ∗
+  func_ptr (twiddle_spec instance) twiddleR ∗
   data_at sh (Tstruct _methods noattr) (reset, (twiddle, twiddleR)) mtable
-  |-- object_methods instance mtable.
+  ⊢ object_methods instance mtable.
 Proof.
   intros.
   unfold object_methods.
@@ -547,19 +355,20 @@ Qed.
 Lemma make_object_methods_later:
   forall sh instance reset twiddle twiddleR mtable,
   readable_share sh ->
-  func_ptr' (reset_spec instance) reset *
-  func_ptr' (twiddle_spec instance) twiddle *
-  func_ptr' (twiddle_spec instance) twiddleR * 
+  func_ptr (reset_spec instance) reset ∗
+  func_ptr (twiddle_spec instance) twiddle ∗
+  func_ptr (twiddle_spec instance) twiddleR ∗
   data_at sh (Tstruct _methods noattr) (reset, (twiddle, twiddleR)) mtable
-  |-- |> object_methods instance mtable.
+  ⊢ ▷ object_methods instance mtable.
 Proof.
-intros. eapply derives_trans. apply make_object_methods; trivial. apply now_later.
+intros. eapply derives_trans. apply make_object_methods; trivial. apply bi.later_intro.
 Qed.
 
 Lemma body_foo_twiddleR: semax_body Vprog Gprog f_foo_twiddleR foo_twiddleR_spec.
 Proof.
-(*New*) unfold foo_twiddleR_spec. rewrite foo_obj_invariant_fold_unfold; unfold twiddle_spec.
+(*New*) unfold foo_twiddleR_spec. unfold twiddle_spec.
 start_function.
+rewrite foo_obj_invariant_fold_unfold'.
 (*New:*) Intros m; unfold foo_data.
 unfold withspacer; simpl.
 Intros.
@@ -569,13 +378,13 @@ forward.  (* d = self->data; *)
 forward.
 unfold object_methods. Intros sh r t tR.
 forward. (*_s_reset = (_mtable -> _reset);*)
-forward_call hs. 
+forward_call hs.
 { rewrite foo_obj_invariant_fold_unfold'.
   Exists m. unfold foo_data, withspacer; simpl. entailer!!.
   sep_apply make_object_methods_later. cancel. }
 (*The spec has folded the object, so need to unfold again*)
 deadvars!. clear - H H0.
-rewrite foo_obj_invariant_fold_unfold. Intros m. unfold foo_data, withspacer; Intros; simpl.
+rewrite foo_obj_invariant_fold_unfold'. Intros m. unfold foo_data, withspacer; Intros; simpl.
 
 forward.  (* self -> data = d+2*i; *) 
 { set (j:= Int.max_signed / 4) in *; compute in j; subst j.
@@ -588,17 +397,18 @@ forward.  (* return d+i; *)
   forget (fold_right Z.add 0 (*history*)(fst hs)) as h.
   entailer!!. }
 Exists (2 * fold_right Z.add 0 (*history*)(fst hs) + i).
+rewrite foo_obj_invariant_fold_unfold'.
 (*New:*) Exists m; unfold foo_data.
 simpl;
 entailer!.
-rewrite Z.mul_add_distr_l, Z.add_comm.
+rewrite Z.mul_add_distr_l Z.add_comm.
 unfold withspacer; simpl.
 entailer!!.
 Qed.
 
 Lemma split_object_methods:
-  forall instance m, 
-    object_methods instance m |-- object_methods instance m * object_methods instance m.
+  forall instance m,
+    object_methods instance m ⊢ object_methods instance m ∗ object_methods instance m.
 Proof.
 intros.
 unfold object_methods.
@@ -606,16 +416,10 @@ Intros sh reset twiddle twiddleR.
 
 Exists (fst (slice.cleave sh)) reset twiddle twiddleR.
 Exists (snd (slice.cleave sh)) reset twiddle twiddleR.
-rewrite (split_func_ptr' (reset_spec instance) reset) at 1.
-rewrite (split_func_ptr' (twiddle_spec instance) twiddle) at 1.
-rewrite (split_func_ptr' (twiddle_spec instance) twiddleR) at 1.
-entailer!!.
-split.
-apply slice.cleave_readable1; auto.
-apply slice.cleave_readable2; auto.
-rewrite (data_at_share_join (fst (slice.cleave sh)) (snd (slice.cleave sh)) sh).
-auto.
-apply slice.cleave_join.
+iIntros "(#$ & #$ & #$ & H)".
+rewrite -(data_at_share_join (fst (slice.cleave sh)) (snd (slice.cleave sh)) sh); last apply slice.cleave_join.
+iDestruct "H" as "($ & $)".
+iPureIntro; repeat split; auto; apply slice.cleave_readable1 || apply slice.cleave_readable2; auto.
 Qed.
 
 (* Isolate a lemma from Andrew's proof of body_make_foo; TODO: simplify the following proof. *)
@@ -662,7 +466,7 @@ if_tac; entailer!!.
 forward_call 1.
 contradiction.
 *
-rewrite if_false by auto.
+rewrite -> if_false by auto.
 Intros.
 forward.  (*  /*skip*/;  *)
 entailer!!.
@@ -674,22 +478,21 @@ forward. (* return (struct object * ) p; *)
 Exists p.
 sep_apply (split_object_methods foo_obj_invariant (gv _foo_methods)).
 entailer!!.
-unfold object_mpred.
+unfold obj_mpred.
 
 (*slight variation of Andrew's proof from here on*)
-Exists foo_data. entailer!!. 1: solve [apply foo_data_HOcontr].
-rewrite ObjMpred_fold_unfold by (apply foo_data_HOcontr).
+Exists foo_data. entailer!!.
+rewrite -> ObjMpred_fold_unfold by (apply foo_data_HOcontr).
 Exists (gv _foo_methods). simpl. normalize.
-rewrite ! sepcon_assoc. apply sepcon_derives. apply now_later.
 unfold foo_data; simpl. unfold withspacer; simpl.
 cancel.
+apply bi.sep_mono; first apply bi.later_intro.
 unfold_data_at (field_at _ _ nil _ p).
 cancel.
 clear -H.
 rewrite !field_at_data_at.
 simpl.
-apply derives_refl'.
-rewrite <- ?sepcon_assoc. (* needed if Archi.ptr64=true *)
+f_equiv.
 rewrite !field_compatible_field_address; auto with field_compatible.
 apply MC_FC; trivial.
 Qed.
@@ -701,9 +504,9 @@ match goal with
             (Ssequence (Sset ?mt (Efield (Ederef (Etempvar ?x _)  _) _ _))
                  _) _  =>
     match Q with context [temp ?x ?x'] =>
-     match R with context [object_mpred _ x'] =>
+     match R with context [obj_mpred _ x'] =>
           let instance := fresh "instance" in let mtable := fresh "mtable" in
-          unfold object_mpred; Intros instance mtable;
+          unfold obj_mpred; Intros instance mtable;
           forward;
           unfold object_methods at 1; 
           let sh := fresh "sh" in let r := fresh "r" in let t := fresh "t" in
@@ -712,7 +515,7 @@ match goal with
           forward_call witness;
           [ .. | try Intros result;
                   sep_apply (make_object_methods sh instance r t mtable); [ auto .. | ];
-                  sep_apply (object_mpred_i hist' x' instance mtable);
+                  sep_apply (obj_mpred_i hist' x' instance mtable);
                   deadvars; try clear dependent sh; try clear r; try clear t
            ]
     end end
@@ -735,8 +538,8 @@ replace_SEP 0 (data_at Ews (Tstruct _methods noattr)
   by  auto with field_compatible. 
   rewrite <- mapsto_field_at with (gfs := [StructField _twiddleR]) (v:= (gv _foo_twiddleR))
   by  auto with field_compatible.
-  rewrite field_at_data_at. rewrite !field_compatible_field_address by auto with field_compatible.
-  rewrite !isptr_offset_val_zero by auto.
+  rewrite field_at_data_at. rewrite -> !field_compatible_field_address by auto with field_compatible.
+  rewrite -> !isptr_offset_val_zero by auto.
   cancel.
 }
 
@@ -768,11 +571,12 @@ assert_PROP (p<>Vundef) as pNotVundef by entailer!.
 
 (* CC *)
 (* 4. first method-call *)
+
 (*NEW*) assert_PROP (isptr p) as isptrP by (sep_apply object_mpred_isptr; entailer!).
 unfold object_mpred.
 
 (*WAS:Intros instance mtable0.*)
-(*Now*) Intros instance. rename H into HOC. rewrite ObjMpred_fold_unfold by trivial. Intros mtable0; simpl.
+(*Now*) Intros instance. rewrite -> ObjMpred_fold_unfold by trivial. Intros mtable0; simpl.
 
 forward. (*  mtable = p->mtable; *)
 unfold object_methods at 1.
@@ -782,11 +586,11 @@ forward_call (* p_reset(p); *)
       (@nil Z,p).
 { (*NEW subgoal*)
    sep_apply make_object_methods_later.
-   rewrite ObjMpred_fold_unfold, <- ObjMpred_fold_unfold by trivial.
-   Exists mtable0. entailer!!. } 
+   rewrite ObjMpred_fold_unfold.
+   Exists mtable0. entailer!!. }
 (* WAS (*Finish the method-call by regathering the object p back together *)
 sep_apply (make_object_methods sh instance r0 t0 mtable0); auto.
-sep_apply (object_mpred_i [] p instance mtable0).*)
+sep_apply (obj_mpred_i [] p instance mtable0).*)
 
 (*Now: folding partially done by forward_call (and the preceding new subgoal*)
 sep_apply obj_mpred_entails_object_mpred; simpl.
@@ -798,24 +602,23 @@ deadvars!. clear.
 unfold object_mpred.
 
 (*WAS:Intros instance mtable0.*)
-(*Now*) Intros instance. rename H into HOC. rewrite ObjMpred_fold_unfold by trivial. Intros mtable0; simpl.
+(*Now*) Intros instance. rewrite -> ObjMpred_fold_unfold by trivial. Intros mtable0; simpl.
 
 forward.  (* mtable = p->mtable; *)
 unfold object_methods at 1.
 Intros sh r0 t0 tR0.
 forward.   (* p_twiddle = mtable->twiddle; *)
-(*Now redundant: assert_PROP (p<>Vundef) by entailer!.*)
 forward_call (* i = p_twiddle(p,3); *)
       ((@nil Z,p), 3).
 { (*NEW subgoal*)
    sep_apply make_object_methods_later.
-   rewrite ObjMpred_fold_unfold, <- ObjMpred_fold_unfold by trivial.
+   rewrite ObjMpred_fold_unfold.
    Exists mtable0. entailer!!. }
-{ simpl. repeat split; try trivial; computable. }
+{ simpl; computable. }
 Intros i.
 simpl in H0. (*
 sep_apply (make_object_methods sh instance r0 t0 mtable0); auto.
-sep_apply (object_mpred_i [3] p instance mtable0).*)
+sep_apply (obj_mpred_i [3] p instance mtable0).*)
 sep_apply obj_mpred_entails_object_mpred; simpl.
 deadvars!.
 (*simpl in H1.*)
@@ -827,7 +630,4 @@ forward.  (* return i; *)
 Exists i; entailer!!.
 Qed.
 
-
-
-
-
+End mpred.
diff --git a/progs/verif_objectSelfFancy.v b/progs/verif_objectSelfFancy.v
index 55d5cb3d58..0669a2ed1b 100644
--- a/progs/verif_objectSelfFancy.v
+++ b/progs/verif_objectSelfFancy.v
@@ -2,17 +2,16 @@ Require Import VST.floyd.proofauto.
 Require Import VST.floyd.library.
 Require Import VST.progs.objectSelfFancy.
 
-(*Version 1 -- leave specs of foo methods unchanged, and require neither funcspec_sub nor 
-anything else. Just replictae the spec/proof structure of foo in fancy foo and see whether
+(*Version 1 -- leave specs of foo methods unchanged, and require neither funcspec_sub nor
+anything else. Just replicate the spec/proof structure of foo in fancy foo and see whether
 the client has enough knowledge to call the correct function*)
 
-(*Require Import VST.floyd.Funspec_old_Notation.*)
-
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
-Local Open Scope Z.
-Local Open Scope logic.
+Section mpred.
+
+Context `{!default_VSTGS Σ}.
 
 Section FOO.
 
@@ -21,7 +20,7 @@ Definition object_invariant := list Z -> val -> mpred.*)
 
 (*But the uncurried version is easier for the HOrec construction*)
 Definition ObjInv : Type:= (list Z * val).
-Definition object_invariant := ObjInv -> mpred.
+Definition object_invariant := ObjInv -d> mpred.
 
 Definition tobject := tptr (Tstruct _object noattr).
 
@@ -43,21 +42,38 @@ Definition twiddle_spec (instance: object_invariant) :=
           PARAMS (snd hs; Vint (Int.repr i)) GLOBALS ()
           SEP (instance hs)
   POST [ tint ]
-      EX v: Z, 
+      ∃ v: Z,
           PROP(2* fold_right Z.add 0 (fst hs) < v <= 2* fold_right Z.add 0 (i::(fst hs)))
           LOCAL (temp ret_temp (Vint (Int.repr v))) 
           SEP(instance (i::(fst hs), snd hs)).
 
 Definition object_methods (instance: object_invariant) (mtable: val) : mpred :=
-  EX sh: share, EX reset: val, EX twiddle: val, EX twiddleR:val,
-  !! readable_share sh && 
-  func_ptr' (reset_spec instance) reset *
-  func_ptr' (twiddle_spec instance) twiddle *
-  func_ptr' (twiddle_spec instance) twiddleR *
+  ∃ sh: share, ∃ reset: val, ∃ twiddle: val, ∃ twiddleR:val,
+  ⌜readable_share sh⌝ ∧
+  func_ptr (reset_spec instance) reset ∗
+  func_ptr (twiddle_spec instance) twiddle ∗
+  func_ptr (twiddle_spec instance) twiddleR ∗
   data_at sh (Tstruct _methods noattr) (reset,(twiddle, twiddleR)) mtable.
 
+Global Instance reset_spec_ne : NonExpansive reset_spec.
+Proof.
+  intros ????.
+  unfold reset_spec, NDmk_funspec.
+  f_equiv; intros ??; simpl; by repeat f_equiv.
+Qed.
+
+Global Instance twiddle_spec_ne : NonExpansive twiddle_spec.
+Proof.
+  intros ????.
+  unfold twiddle_spec, NDmk_funspec.
+  f_equiv; intros ??; simpl; by repeat f_equiv.
+Qed.
+
+Global Instance object_methods_ne n : Proper (dist n ==> eq ==> dist n) object_methods.
+Proof. solve_proper. Qed.
+
 Lemma object_methods_local_facts: forall instance p,
-  object_methods instance p |-- !! isptr p.
+  object_methods instance p ⊢ ⌜isptr p⌝.
 Proof.
 intros.
 unfold object_methods.
@@ -70,11 +86,11 @@ Local Hint Resolve object_methods_local_facts : saturate_local.
 Lemma make_object_methods:
   forall sh instance reset twiddle twiddleR mtable,
   readable_share sh ->
-  func_ptr' (reset_spec instance) reset *
-  func_ptr' (twiddle_spec instance) twiddle *
-  func_ptr' (twiddle_spec instance) twiddleR * 
+  func_ptr (reset_spec instance) reset ∗
+  func_ptr (twiddle_spec instance) twiddle ∗
+  func_ptr (twiddle_spec instance) twiddleR ∗
   data_at sh (Tstruct _methods noattr) (reset, (twiddle, twiddleR)) mtable
-  |-- object_methods instance mtable.
+  ⊢ object_methods instance mtable.
 Proof.
   intros.
   unfold object_methods.
@@ -85,18 +101,18 @@ Qed.
 Lemma make_object_methods_later:
   forall sh instance reset twiddle twiddleR mtable,
   readable_share sh ->
-  func_ptr' (reset_spec instance) reset *
-  func_ptr' (twiddle_spec instance) twiddle *
-  func_ptr' (twiddle_spec instance) twiddleR * 
+  func_ptr (reset_spec instance) reset ∗
+  func_ptr (twiddle_spec instance) twiddle ∗
+  func_ptr (twiddle_spec instance) twiddleR ∗
   data_at sh (Tstruct _methods noattr) (reset, (twiddle, twiddleR)) mtable
-  |-- |> object_methods instance mtable.
+  ⊢ ▷ object_methods instance mtable.
 Proof.
-intros. eapply derives_trans. apply make_object_methods; trivial. apply now_later.
+intros. eapply derives_trans. apply make_object_methods; trivial. apply bi.later_intro.
 Qed.
 
 (*Andrew's definition
 Definition object_mpred (history: list Z) (self: val) : mpred :=
-  EX instance: object_invariant, EX mtable: val, 
+  ∃ instance: object_invariant, ∃ mtable: val, 
        (object_methods instance mtable *
      field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable self*
      instance history self).*)
@@ -104,252 +120,58 @@ Definition object_mpred (history: list Z) (self: val) : mpred :=
 Section ObjMpred.
 Variable instance: object_invariant.
 
-Definition F (X: ObjInv -> mpred) (hs: ObjInv): mpred :=
-   ((EX mtable: val, !!(isptr mtable) (*This has to hold NOW, not ust LATER*)&&
-     (|> object_methods X mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   instance hs)%logic.
-
-Definition HOcontractive1 {A: Type}{NA: NatDed A}{IA: Indir A}{RI: RecIndir A}{X: Type}
-     (f: (X -> A) -> (X -> A)) := 
- forall P Q : X -> A,
- ALL x : X, |> fash (P x <--> Q x)
- |-- ALL x : X, fash (f P x --> f Q x).
-
-Lemma HOcontractive_i1:
- forall  (A: Type)(NA: NatDed A){IA: Indir A}{RI: RecIndir A}{X: Type}
-     (f: (X -> A) -> (X -> A)),
-  HOcontractive1 f -> HOcontractive f.
-Proof.
-intros.
-red in H|-*.
-intros.
-eapply derives_trans.
-apply andp_right.
-apply H.
-specialize (H Q P).
-eapply derives_trans.
-2: apply H.
-apply allp_derives; intros.
-apply later_derives.
-apply fash_derives.
-rewrite andp_comm.
-auto.
-apply allp_right; intro.
-rewrite fash_andp.
-apply andp_right.
-apply andp_left1.
-apply allp_left with v; auto.
-apply andp_left2.
-apply allp_left with v; auto.
-Qed.
+Definition F (X: ObjInv -d> mpred) : ObjInv -d> mpred := fun hs =>
+   ((∃ mtable: val, ⌜isptr mtable⌝ (*This has to hold NOW, not just LATER*)∧
+     (▷ object_methods X mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   instance hs).
 
-Lemma HOcontrF
-     (*Need sth like this (HI: HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => instance x))*):
-      HOcontractive F.
+Local Instance F_contractive : Contractive F.
 Proof.
-unfold F.
-apply HOcontractive_i1.
-red; intros.
-apply allp_right; intro oi.
-apply subp_sepcon_mpred; [ | apply subp_refl].
-apply subp_exp; intro v.
-apply subp_sepcon_mpred; [ | apply subp_refl].
-clear oi.
-apply subp_andp; [ apply subp_refl | ].
-eapply derives_trans, subp_later1.
-rewrite <- later_allp.
-apply later_derives.
-unfold object_methods.
-apply subp_exp; intro sh.
-apply subp_exp; intro reset.
-apply subp_exp; intro twiddle.
-apply subp_exp; intro twiddleR.
-apply subp_sepcon_mpred; [ | apply subp_refl].
-repeat simple apply subp_sepcon_mpred;
-try (simple apply subp_andp; [simple apply subp_refl | ]).
-+
-unfold func_ptr'.
-apply subp_andp; [ | apply subp_refl].
-clear - instance.
-eapply derives_trans; [ | apply fash_func_ptr_ND].
-apply allp_right; intro oi.
-apply andp_right.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold convertPre.
-unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-rewrite prop_true_andp by tauto.
-subst zz.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with oi.
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left2. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold convertPre.
-unfold PROPx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-subst zz.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with ([], snd oi).
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left1. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-+
-unfold func_ptr'.
-apply subp_andp; [ | apply subp_refl].
-clear - instance.
-eapply derives_trans; [ | apply fash_func_ptr_ND].
-apply allp_right; intros [hs i].
-apply andp_right.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold convertPre.
-unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-rewrite prop_true_andp by tauto.
-subst zz.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with hs.
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left2. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold PROPx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-subst zz.
-apply exp_right with x.
-normalize.
-rewrite prop_true_andp by tauto.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with (i::fst hs, snd hs).
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left1. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-+
-unfold func_ptr'.
-apply subp_andp; [ | apply subp_refl].
-clear - instance.
-eapply derives_trans; [ | apply fash_func_ptr_ND].
-apply allp_right; intros [hs i].
-apply andp_right.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold convertPre.
-unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-rewrite prop_true_andp by tauto.
-subst zz.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with hs.
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left2. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold PROPx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-subst zz.
-apply exp_right with x.
-normalize.
-rewrite prop_true_andp by tauto.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with (i::fst hs, snd hs).
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left1. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
+  intros ?????.
+  unfold F.
+  do 5 f_equiv.
+  f_contractive.
+  rewrite H //.
 Qed.
 
-Definition obj_mpred:ObjInv -> mpred := (HORec F). (*ie same type as Andrew's object_mpred.*)
+Definition obj_mpred:ObjInv -> mpred := fixpoint F.
 
-Lemma ObjMpred_fold_unfold: 
-HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => instance x) ->
-obj_mpred = 
-fun hs => 
-  ((EX mtable: val,!!(isptr mtable) &&
-     (|> object_methods obj_mpred mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   instance hs)%logic.
+Lemma ObjMpred_fold_unfold:
+forall hs, obj_mpred hs ⊣⊢
+  ((∃ mtable: val,⌜isptr mtable⌝ ∧
+     (▷ object_methods obj_mpred mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   instance hs).
 Proof.
   intros; unfold obj_mpred at 1.
-  rewrite HORec_fold_unfold; [ reflexivity | apply HOcontrF]; trivial.
+  by rewrite (fixpoint_unfold F _).
 Qed.
-Lemma ObjMpred_fold_unfold' hs: 
-HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => instance x) ->
-obj_mpred hs = 
-  ((EX mtable: val, !!(isptr mtable) &&
-     (|> object_methods obj_mpred mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   instance hs)%logic.
+Lemma ObjMpred_fold_unfold' hs:
+obj_mpred hs ⊣⊢
+  ((∃ mtable: val, ⌜isptr mtable⌝ ∧
+     (▷ object_methods obj_mpred mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   instance hs).
 Proof.
-  intros. rewrite ObjMpred_fold_unfold, <- ObjMpred_fold_unfold; trivial. 
+  intros. rewrite ObjMpred_fold_unfold -ObjMpred_fold_unfold; trivial.
 Qed.
 
-Lemma ObjMpred_isptr
-   (H: HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => instance x))
-    hs: obj_mpred hs |-- !!(isptr (snd hs)).
-Proof. rewrite ObjMpred_fold_unfold' by trivial; Intros m. entailer!. Qed.
+Lemma ObjMpred_isptr hs: obj_mpred hs ⊢ ⌜isptr (snd hs)⌝.
+Proof. rewrite -> ObjMpred_fold_unfold' by trivial; Intros m. entailer!. Qed.
 
 End ObjMpred.
 
 Definition object_mpred: object_invariant := fun hs =>
-  EX instance, !!(HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => instance x)) &&
-               obj_mpred instance hs.
+  ∃ instance, obj_mpred instance hs.
 (*This now plays the role of Andrew's obj_mpred*)
 
-Lemma object_mpred_isptr hs: object_mpred hs |-- !!(isptr (snd hs)).
+Lemma object_mpred_isptr hs: object_mpred hs ⊢ ⌜isptr (snd hs)⌝.
 Proof. unfold object_mpred; Intros inst. apply ObjMpred_isptr; trivial. Qed.
 
-Lemma obj_mpred_entails_object_mpred inst hs
-  (H: HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => inst x)):
-  obj_mpred inst hs |-- object_mpred hs.
-Proof. unfold object_mpred. Exists inst. entailer!!. Qed.
+Lemma obj_mpred_entails_object_mpred inst hs:
+  obj_mpred inst hs ⊢ object_mpred hs.
+Proof. unfold object_mpred. Exists inst. entailer!. Qed.
 
 (*Andrew's specs 
 Definition foo_invariant : object_invariant :=
@@ -373,7 +195,7 @@ Definition make_foo_spec :=
     PROP () LOCAL (gvars gv) 
     SEP (mem_mgr gv; object_methods foo_invariant (gv _foo_methods))
  POST [ tobject ]
-    EX p: val, PROP () LOCAL (temp ret_temp p)
+    ∃ p: val, PROP () LOCAL (temp ret_temp p)
      SEP (mem_mgr gv; object_mpred (*nil p*)(nil, p); object_methods foo_invariant (gv _foo_methods)).
 
 *)
@@ -383,42 +205,37 @@ Definition foo_data : object_invariant :=
   (fun (x:ObjInv) => 
     withspacer Ews (sizeof size_t + sizeof tint) (2 * sizeof size_t) (field_at Ews (Tstruct _foo_object noattr) 
             [StructField _data] (Vint (Int.repr (2*fold_right Z.add 0 (fst x))))) (snd x)
-      *  malloc_token Ews (Tstruct _foo_object noattr) (snd x)).
-Lemma foo_data_HOcontr: HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => foo_data x).
-Proof.
-  assert (predicates_rec.HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => foo_data x)). 2: constructor; apply H.
-  unfold foo_data.
-  unfold withspacer; simpl.
-  apply Trashcan.sepcon_HOcontractive.
-  apply Trashcan.const_HOcontractive.
-  apply Trashcan.const_HOcontractive.
-Qed.
+      ∗ malloc_token Ews (Tstruct _foo_object noattr) (snd x)).
 
-Definition foo_obj_invariant :object_invariant := obj_mpred foo_data.
+Definition foo_obj_invariant : object_invariant := obj_mpred foo_data.
 
 (*New lemma!*)
-Lemma foo_obj_invariant_fold_unfold: foo_obj_invariant =
+Lemma foo_obj_invariant_fold_unfold: foo_obj_invariant ≡
  fun hs =>
-  ((EX mtable: val, !!(isptr mtable) &&
-     (|>object_methods foo_obj_invariant  mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   foo_data hs)%logic.
+  ((∃ mtable: val, ⌜isptr mtable⌝ ∧
+     (▷object_methods foo_obj_invariant  mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   foo_data hs).
 Proof.
-  unfold foo_obj_invariant.
-  rewrite <- ObjMpred_fold_unfold. trivial. apply foo_data_HOcontr.
+  unfold foo_obj_invariant; intros ?.
+  rewrite <- ObjMpred_fold_unfold. trivial.
 Qed.
 
 (*Sometimes this variant is preferable, sometimes the one above*)
-Lemma foo_obj_invariant_fold_unfold' hs: foo_obj_invariant hs =
-  ((EX mtable: val, !!(isptr mtable) &&
-     (|>object_methods foo_obj_invariant  mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   foo_data hs)%logic.
-Proof. rewrite foo_obj_invariant_fold_unfold. rewrite <- foo_obj_invariant_fold_unfold; trivial. Qed.
-
-Lemma foo_data_isptr hs: foo_data hs = !!(isptr (snd hs)) && foo_data hs.
-apply pred_ext; entailer.
-unfold foo_data. entailer!. destruct (snd hs); simpl in *; trivial;  contradiction.
+Lemma foo_obj_invariant_fold_unfold' hs: foo_obj_invariant hs ⊣⊢
+  ((∃ mtable: val, ⌜isptr mtable⌝ ∧
+     (▷object_methods foo_obj_invariant  mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   foo_data hs).
+Proof. apply (foo_obj_invariant_fold_unfold hs). Qed.
+
+Lemma foo_data_isptr hs: foo_data hs ⊣⊢ ⌜isptr (snd hs)⌝ ∧ foo_data hs.
+Proof.
+  iSplit.
+  - iIntros; iSplit; last done.
+    unfold foo_data; iStopProof.
+    destruct (hs.2); entailer!.
+  - iIntros "(_ & $)".
 Qed.
 
 
@@ -438,7 +255,7 @@ Definition make_foo_spec :=
     PROP () PARAMS () GLOBALS (gv) 
     SEP (mem_mgr gv; object_methods foo_obj_invariant (gv _foo_methods))
  POST [ tobject ]
-    EX p: val, PROP () LOCAL (temp ret_temp p)
+    ∃ p: val, PROP () LOCAL (temp ret_temp p)
      SEP (mem_mgr gv; object_mpred (nil,p); object_methods foo_obj_invariant (gv _foo_methods)).
 End NewSpecs.
 
@@ -447,18 +264,18 @@ Definition FooGprog : funspecs :=   ltac:(with_library prog [
 
 Lemma body_foo_reset: semax_body Vprog FooGprog f_foo_reset foo_reset_spec.
 Proof.
-start_function. 
-(*New:*) rewrite foo_obj_invariant_fold_unfold. Intros m; unfold foo_data.
+start_function.
+(*New:*) rewrite foo_obj_invariant_fold_unfold'. Intros m; unfold foo_data.
 unfold withspacer; simpl; Intros.
 forward.  (* self->data=0; *)
 entailer!!.
-(*New:*) rewrite foo_obj_invariant_fold_unfold, <- foo_obj_invariant_fold_unfold. Exists m; unfold foo_data.
-all: unfold withspacer; simpl; entailer!!.  (* needed if Archi.ptr64=true *)
+(*New:*) rewrite foo_obj_invariant_fold_unfold'. Exists m; unfold foo_data.
+all: unfold withspacer; simpl; entailer!.  (* needed if Archi.ptr64=true *)
 Qed.
 
-Lemma body_foo_reset_alternativeproof: semax_body Vprog FooGprog f_foo_reset foo_reset_spec.
+(*Lemma body_foo_reset_alternativeproof: semax_body Vprog Gprog f_foo_reset foo_reset_spec.
 Proof.
-(*New*) unfold foo_reset_spec. rewrite foo_obj_invariant_fold_unfold; unfold reset_spec.
+(*New*) unfold foo_reset_spec. rewrite foo_obj_invariant_fold_unfold'; unfold reset_spec.
 start_function. 
 (*New:*) Intros m; unfold foo_data.
 unfold withspacer; simpl; Intros.
@@ -466,12 +283,13 @@ forward.  (* self->data=0; *)
 entailer!!.
 (*New:*) Exists m; unfold foo_data.
 all: unfold withspacer; simpl; entailer!!.  (* needed if Archi.ptr64=true *)
-Qed.
+Qed.*)
 
 Lemma body_foo_twiddle: semax_body Vprog FooGprog f_foo_twiddle foo_twiddle_spec.
 Proof.
-(*New*) unfold foo_twiddle_spec. rewrite foo_obj_invariant_fold_unfold; unfold twiddle_spec.
+(*New*) unfold foo_twiddle_spec. unfold twiddle_spec.
 start_function.
+rewrite foo_obj_invariant_fold_unfold'.
 (*New:*) Intros m; unfold foo_data.
 unfold withspacer; simpl.
 Intros.
@@ -486,18 +304,20 @@ forward.  (* return d+i; *)
   forget (fold_right Z.add 0 (*history*)(fst hs)) as h.
   entailer!!. }
 Exists (2 * fold_right Z.add 0 (*history*)(fst hs) + i).
+rewrite foo_obj_invariant_fold_unfold'.
 (*New:*) Exists m; unfold foo_data.
 simpl;
 entailer!!.
-rewrite Z.mul_add_distr_l, Z.add_comm.
+rewrite Z.mul_add_distr_l Z.add_comm.
 unfold withspacer; simpl.
 entailer!!.
 Qed.
 
 Lemma body_foo_twiddleR: semax_body Vprog FooGprog f_foo_twiddleR foo_twiddleR_spec.
 Proof.
-(*New*) unfold foo_twiddleR_spec. rewrite foo_obj_invariant_fold_unfold; unfold twiddle_spec.
+(*New*) unfold foo_twiddleR_spec. unfold twiddle_spec.
 start_function.
+rewrite foo_obj_invariant_fold_unfold'.
 (*New:*) Intros m; unfold foo_data.
 unfold withspacer; simpl.
 Intros.
@@ -507,13 +327,13 @@ forward.  (* d = self->data; *)
 forward.
 unfold object_methods. Intros sh r t tR.
 forward. (*_s_reset = (_mtable -> _reset);*)
-forward_call hs. 
+forward_call hs.
 { rewrite foo_obj_invariant_fold_unfold'.
   Exists m. unfold foo_data, withspacer; simpl. entailer!!.
   sep_apply make_object_methods_later. cancel. }
 (*The spec has folded the object, so need to unfold again*)
 deadvars!. clear - H H0.
-rewrite foo_obj_invariant_fold_unfold. Intros m. unfold foo_data, withspacer; Intros; simpl.
+rewrite foo_obj_invariant_fold_unfold'. Intros m. unfold foo_data, withspacer; Intros; simpl.
 
 forward.  (* self -> data = d+2*i; *) 
 { set (j:= Int.max_signed / 4) in *; compute in j; subst j.
@@ -526,17 +346,18 @@ forward.  (* return d+i; *)
   forget (fold_right Z.add 0 (*history*)(fst hs)) as h.
   entailer!!. }
 Exists (2 * fold_right Z.add 0 (*history*)(fst hs) + i).
+rewrite foo_obj_invariant_fold_unfold'.
 (*New:*) Exists m; unfold foo_data.
 simpl;
-entailer!!.
-rewrite Z.mul_add_distr_l, Z.add_comm.
+entailer!.
+rewrite Z.mul_add_distr_l Z.add_comm.
 unfold withspacer; simpl.
 entailer!!.
 Qed.
 
 Lemma split_object_methods:
-  forall instance m, 
-    object_methods instance m |-- object_methods instance m * object_methods instance m.
+  forall instance m,
+    object_methods instance m ⊢ object_methods instance m ∗ object_methods instance m.
 Proof.
 intros.
 unfold object_methods.
@@ -544,16 +365,10 @@ Intros sh reset twiddle twiddleR.
 
 Exists (fst (slice.cleave sh)) reset twiddle twiddleR.
 Exists (snd (slice.cleave sh)) reset twiddle twiddleR.
-rewrite (split_func_ptr' (reset_spec instance) reset) at 1.
-rewrite (split_func_ptr' (twiddle_spec instance) twiddle) at 1.
-rewrite (split_func_ptr' (twiddle_spec instance) twiddleR) at 1.
-entailer!!.
-split.
-apply slice.cleave_readable1; auto.
-apply slice.cleave_readable2; auto.
-rewrite (data_at_share_join (fst (slice.cleave sh)) (snd (slice.cleave sh)) sh).
-auto.
-apply slice.cleave_join.
+iIntros "(#$ & #$ & #$ & H)".
+rewrite -(data_at_share_join (fst (slice.cleave sh)) (snd (slice.cleave sh)) sh); last apply slice.cleave_join.
+iDestruct "H" as "($ & $)".
+iPureIntro; repeat split; auto; apply slice.cleave_readable1 || apply slice.cleave_readable2; auto.
 Qed.
 
 (* Isolate a lemma from Andrew's proof of body_make_foo; TODO: simplify the following proof. *)
@@ -564,7 +379,7 @@ destruct p; try contradiction.
 destruct H as [AL SZ].
 repeat split; auto.
 simpl in *.  unfold sizeof in *; simpl in *; lia.
-eapply align_compatible_rec_Tstruct; [reflexivity .. |].
+eapply align_compatible_rec_Tstruct; [reflexivity.. |].
 simpl co_members; intros.
 simpl in H.
 if_tac in H; [| inv H].
@@ -600,7 +415,7 @@ if_tac; entailer!!.
 forward_call 1.
 contradiction.
 *
-rewrite if_false by auto.
+rewrite -> if_false by auto.
 Intros.
 forward.  (*  /*skip*/;  *)
 entailer!!.
@@ -612,34 +427,32 @@ forward. (* return (struct object * ) p; *)
 Exists p.
 sep_apply (split_object_methods foo_obj_invariant (gv _foo_methods)).
 entailer!!.
-unfold object_mpred.
+unfold obj_mpred.
 
 (*slight variation of Andrew's proof from here on*)
-Exists foo_data. entailer!!. 1: solve [apply foo_data_HOcontr].
-rewrite ObjMpred_fold_unfold by (apply foo_data_HOcontr).
+Exists foo_data. entailer!!.
+rewrite -> ObjMpred_fold_unfold by (apply foo_data_HOcontr).
 Exists (gv _foo_methods). simpl. normalize.
-rewrite ! sepcon_assoc. apply sepcon_derives. apply now_later.
 unfold foo_data; simpl. unfold withspacer; simpl.
 cancel.
+apply bi.sep_mono; first apply bi.later_intro.
 unfold_data_at (field_at _ _ nil _ p).
 cancel.
 clear -H.
 rewrite !field_at_data_at.
 simpl.
-apply derives_refl'.
-rewrite <- ?sepcon_assoc. (* needed if Archi.ptr64=true *)
+f_equiv.
 rewrite !field_compatible_field_address; auto with field_compatible.
 apply MC_FC; trivial.
 Qed.
-
 End FOO.
 
 Section FancyFoo.
 
 Definition fObjInv : Type:= ((list Z * Z) * val).
-Definition fobject_invariant := fObjInv -> mpred.
+Definition fobject_invariant := fObjInv -d> mpred.
 
-(*not replcatedDefinition tobject := tptr (Tstruct _object noattr).*)
+(*not replicated: Definition tobject := tptr (Tstruct _object noattr).*)
 
 Definition freset_spec (instance: fobject_invariant) :=
   WITH hs:fObjInv (*modified*)
@@ -659,7 +472,7 @@ Definition ftwiddle_spec (instance: fobject_invariant) :=
           PARAMS (snd hs; Vint (Int.repr i)) GLOBALS ()
           SEP (instance hs)
   POST [ tint ]
-      EX v: Z, 
+      ∃ v: Z, 
           PROP(2* fold_right Z.add 0 (fst (fst hs)) < v <= 2* fold_right Z.add 0 (i::(fst (fst hs))))
           LOCAL (temp ret_temp (Vint (Int.repr v))) 
           SEP(instance ((i::(fst (fst hs)), snd(fst hs)), snd hs)).
@@ -683,34 +496,64 @@ Definition fgetcolor_spec (instance: fobject_invariant) :=
           PROP()
           LOCAL (temp ret_temp (Vint (Int.repr (snd(fst hs))))) 
           SEP(instance hs).
-Check reset_spec. Print ObjInv.
 
 Definition fobject_invariant_of_inv (INV:object_invariant):fobject_invariant.
 Proof. intros [[hs c] p]. apply (INV (hs,p)). Defined.
 
 Lemma reset_spec_local_sub INV: funspec_sub (reset_spec INV)
                                             (freset_spec (fobject_invariant_of_inv INV)).
-Proof. do_funspec_sub. destruct w as [[hs c] p]; simpl. Exists (hs,p) emp; simpl. entailer!. Qed.
+Proof. split; first done. intros ((hs, c), p) ?; simpl. rewrite -fupd_intro. Exists (hs,p) (emp : mpred); simpl. entailer!. Qed.
 
 Lemma twiddle_spec_local_sub INV: funspec_sub (twiddle_spec INV)
                                               (ftwiddle_spec (fobject_invariant_of_inv INV)).
-Proof. do_funspec_sub. destruct w as [[[hs c] p] i]; simpl. 
-  Exists ((hs,p),i) emp; entailer!!.
-  intros. Exists x0. entailer!!.
+Proof. split; first done. intros (((hs, c), p), i) ?; simpl.
+  rewrite -fupd_intro.
+  Exists ((hs,p),i) (emp : mpred); entailer!!; auto.
 Qed.
 
 Definition fobject_methods (instance: fobject_invariant) (mtable: val) : mpred :=
-  EX sh: share, EX reset: val, EX twiddle: val, EX twiddleR:val, EX setcol: val, EX getcol:val,
-  !! readable_share sh && 
-  func_ptr' (freset_spec instance) reset *
-  func_ptr' (ftwiddle_spec instance) twiddle *
-  func_ptr' (ftwiddle_spec instance) twiddleR *
-  func_ptr' (fsetcolor_spec instance) setcol *
-  func_ptr' (fgetcolor_spec instance) getcol *
+  ∃ sh: share, ∃ reset: val, ∃ twiddle: val, ∃ twiddleR:val, ∃ setcol: val, ∃ getcol:val,
+  ⌜readable_share sh⌝ ∧ 
+  func_ptr (freset_spec instance) reset ∗
+  func_ptr (ftwiddle_spec instance) twiddle ∗
+  func_ptr (ftwiddle_spec instance) twiddleR ∗
+  func_ptr (fsetcolor_spec instance) setcol ∗
+  func_ptr (fgetcolor_spec instance) getcol ∗
   data_at sh (Tstruct _fancymethods noattr) (reset,(twiddle, (twiddleR, (setcol, getcol)))) mtable.
 
+Global Instance freset_spec_ne : NonExpansive freset_spec.
+Proof.
+  intros ????.
+  unfold freset_spec, NDmk_funspec.
+  f_equiv; intros ??; simpl; by repeat f_equiv.
+Qed.
+
+Global Instance ftwiddle_spec_ne : NonExpansive ftwiddle_spec.
+Proof.
+  intros ????.
+  unfold ftwiddle_spec, NDmk_funspec.
+  f_equiv; intros ??; simpl; by repeat f_equiv.
+Qed.
+
+Global Instance fsetcolor_spec_ne : NonExpansive fsetcolor_spec.
+Proof.
+  intros ????.
+  unfold fsetcolor_spec, NDmk_funspec.
+  f_equiv; intros ??; simpl; by repeat f_equiv.
+Qed.
+
+Global Instance fgetcolor_spec_ne : NonExpansive fgetcolor_spec.
+Proof.
+  intros ????.
+  unfold fgetcolor_spec, NDmk_funspec.
+  f_equiv; intros ??; simpl; by repeat f_equiv.
+Qed.
+
+Global Instance fobject_methods_ne n : Proper (dist n ==> eq ==> dist n) fobject_methods.
+Proof. solve_proper. Qed.
+
 Lemma fobject_methods_local_facts: forall instance p,
-  fobject_methods instance p |-- !! isptr p.
+  fobject_methods instance p ⊢ ⌜isptr p⌝.
 Proof.
 intros.
 unfold fobject_methods.
@@ -722,13 +565,13 @@ Local Hint Resolve fobject_methods_local_facts : saturate_local.
 Lemma make_fobject_methods:
   forall sh instance reset twiddle twiddleR setcol getcol mtable,
   readable_share sh ->
-  func_ptr' (freset_spec instance) reset *
-  func_ptr' (ftwiddle_spec instance) twiddle *
-  func_ptr' (ftwiddle_spec instance) twiddleR * 
-  func_ptr' (fsetcolor_spec instance) setcol *
-  func_ptr' (fgetcolor_spec instance) getcol *
+  func_ptr (freset_spec instance) reset ∗
+  func_ptr (ftwiddle_spec instance) twiddle ∗
+  func_ptr (ftwiddle_spec instance) twiddleR ∗
+  func_ptr (fsetcolor_spec instance) setcol ∗
+  func_ptr (fgetcolor_spec instance) getcol ∗
   data_at sh (Tstruct _fancymethods noattr) (reset,(twiddle, (twiddleR, (setcol, getcol)))) mtable
-  |-- fobject_methods instance mtable.
+  ⊢ fobject_methods instance mtable.
 Proof.
   intros.
   unfold fobject_methods.
@@ -739,326 +582,72 @@ Qed.
 Lemma make_fobject_methods_later:
   forall sh instance reset twiddle twiddleR setcol getcol mtable,
   readable_share sh ->
-  func_ptr' (freset_spec instance) reset *
-  func_ptr' (ftwiddle_spec instance) twiddle *
-  func_ptr' (ftwiddle_spec instance) twiddleR * 
-  func_ptr' (fsetcolor_spec instance) setcol *
-  func_ptr' (fgetcolor_spec instance) getcol *
+  func_ptr (freset_spec instance) reset ∗
+  func_ptr (ftwiddle_spec instance) twiddle ∗
+  func_ptr (ftwiddle_spec instance) twiddleR ∗
+  func_ptr (fsetcolor_spec instance) setcol ∗
+  func_ptr (fgetcolor_spec instance) getcol ∗
   data_at sh (Tstruct _fancymethods noattr) (reset,(twiddle, (twiddleR, (setcol, getcol)))) mtable
-  |-- |> fobject_methods instance mtable.
+  ⊢ ▷ fobject_methods instance mtable.
 Proof.
-intros. eapply derives_trans. apply make_fobject_methods; trivial. apply now_later.
+intros. eapply derives_trans. apply make_fobject_methods; trivial. apply bi.later_intro.
 Qed.
 
 Section FObjMpred.
 Variable instance: fobject_invariant.
 
-Definition G (X: fObjInv -> mpred) (hs: fObjInv): mpred :=
-   ((EX mtable: val, !!(isptr mtable) (*This has to hold NOW, not ust LATER*)&&
-     (|> fobject_methods X mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   instance hs)%logic.
+Definition G (X: fObjInv -d> mpred) : fObjInv -d> mpred := fun hs =>
+   ((∃ mtable: val, ⌜isptr mtable⌝ (*This has to hold NOW, not ust LATER*)∧
+     (▷ fobject_methods X mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   instance hs).
 
-Lemma HOcontrG
-     (*Need sth like this (HI: HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => instance x))*):
-      HOcontractive G.
+Local Instance G_contractive : Contractive G.
 Proof.
-unfold F.
-apply HOcontractive_i1.
-red; intros.
-apply allp_right; intro oi.
-apply subp_sepcon_mpred; [ | apply subp_refl].
-apply subp_exp; intro v.
-apply subp_sepcon_mpred; [ | apply subp_refl].
-clear oi.
-apply subp_andp; [ apply subp_refl | ].
-eapply derives_trans, subp_later1.
-rewrite <- later_allp.
-apply later_derives.
-unfold fobject_methods.
-apply subp_exp; intro sh.
-apply subp_exp; intro reset.
-apply subp_exp; intro twiddle.
-apply subp_exp; intro twiddleR.
-apply subp_exp; intro setCol.
-apply subp_exp; intro getCol.
-apply subp_sepcon_mpred; [ | apply subp_refl].
-repeat simple apply subp_sepcon_mpred;
-try (simple apply subp_andp; [simple apply subp_refl | ]).
-+
-unfold func_ptr'.
-apply subp_andp; [ | apply subp_refl].
-clear - instance.
-eapply derives_trans; [ | apply fash_func_ptr_ND].
-apply allp_right; intro oi.
-apply andp_right.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold convertPre.
-unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-rewrite prop_true_andp by tauto.
-subst zz.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with oi.
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left2. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold convertPre.
-unfold PROPx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-subst zz.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with ([], snd (fst oi), snd oi).
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left1. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-+
-unfold func_ptr'.
-apply subp_andp; [ | apply subp_refl].
-clear - instance.
-eapply derives_trans; [ | apply fash_func_ptr_ND].
-apply allp_right; intros [hs i].
-apply andp_right.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold convertPre.
-unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-rewrite prop_true_andp by tauto.
-subst zz.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with hs.
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left2. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold PROPx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-subst zz.
-apply exp_right with x.
-normalize.
-rewrite prop_true_andp by tauto.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with (i :: fst (fst hs), snd (fst hs), snd hs).
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left1. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-+
-unfold func_ptr'.
-apply subp_andp; [ | apply subp_refl].
-clear - instance.
-eapply derives_trans; [ | apply fash_func_ptr_ND].
-apply allp_right; intros [hs i].
-apply andp_right.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold convertPre.
-unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-rewrite prop_true_andp by tauto.
-subst zz.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with hs.
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left2. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold PROPx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-subst zz.
-apply exp_right with x.
-normalize.
-rewrite prop_true_andp by tauto.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with (i :: fst (fst hs), snd (fst hs), snd hs).
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left1. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-+
-unfold func_ptr'.
-apply subp_andp; [ | apply subp_refl].
-clear - instance.
-eapply derives_trans; [ | apply fash_func_ptr_ND].
-apply allp_right; intros [hs i].
-apply andp_right.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold convertPre.
-unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-rewrite prop_true_andp by tauto.
-subst zz.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with hs.
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left2. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold PROPx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-subst zz. (*
-apply exp_right with x.
-normalize.
-rewrite prop_true_andp by tauto.*)
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with (fst (fst hs), i, snd hs).
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left1. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-+
-unfold func_ptr'.
-apply subp_andp; [ | apply subp_refl].
-clear - instance.
-eapply derives_trans; [ | apply fash_func_ptr_ND].
-apply allp_right; intros [hs i].
-apply andp_right.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold convertPre.
-unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-rewrite prop_true_andp by tauto.
-subst zz.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with (hs,i).
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left2. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold PROPx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-subst zz. (*
-apply exp_right with x.
-normalize.
-rewrite prop_true_andp by tauto.*)
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with (hs,i).
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left1. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
+  intros ?????.
+  unfold G.
+  do 5 f_equiv.
+  f_contractive.
+  rewrite H //.
 Qed.
 
-Definition fobj_mpred:fObjInv -> mpred := (HORec G). (*ie same type as Andrew's object_mpred.*)
+Definition fobj_mpred:fObjInv -> mpred := fixpoint G.
 
-Lemma fObjMpred_fold_unfold: 
-HOcontractive (fun (_ : fObjInv -> mpred) (x : fObjInv) => instance x) ->
-fobj_mpred = 
-fun hs => 
-  ((EX mtable: val,!!(isptr mtable) &&
-     (|> fobject_methods fobj_mpred mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   instance hs)%logic.
+Lemma fObjMpred_fold_unfold:
+forall hs, fobj_mpred hs ⊣⊢
+  ((∃ mtable: val,⌜isptr mtable⌝ ∧
+     (▷ fobject_methods fobj_mpred mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   instance hs).
 Proof.
   intros; unfold fobj_mpred at 1.
-  rewrite HORec_fold_unfold; [ reflexivity | apply HOcontrG]; trivial.
+  by rewrite (fixpoint_unfold G _).
 Qed.
-Lemma fObjMpred_fold_unfold' hs: 
-HOcontractive (fun (_ : fObjInv -> mpred) (x : fObjInv) => instance x) ->
-fobj_mpred hs = 
-  ((EX mtable: val, !!(isptr mtable) &&
-     (|> fobject_methods fobj_mpred mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   instance hs)%logic.
+Lemma fObjMpred_fold_unfold' hs:
+fobj_mpred hs ⊣⊢
+  ((∃ mtable: val, ⌜isptr mtable⌝ ∧
+     (▷ fobject_methods fobj_mpred mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   instance hs).
 Proof.
-  intros. rewrite fObjMpred_fold_unfold, <- fObjMpred_fold_unfold; trivial. 
+  intros. rewrite fObjMpred_fold_unfold -fObjMpred_fold_unfold; trivial.
 Qed.
 
-Lemma fObjMpred_isptr
-   (H: HOcontractive (fun (_ : fObjInv -> mpred) (x : fObjInv) => instance x))
-    hs: fobj_mpred hs |-- !!(isptr (snd hs)).
-Proof. rewrite fObjMpred_fold_unfold' by trivial; Intros m. entailer!. Qed.
+Lemma fObjMpred_isptr hs: fobj_mpred hs ⊢ ⌜isptr (snd hs)⌝.
+Proof. rewrite -> fObjMpred_fold_unfold' by trivial; Intros m. entailer!. Qed.
 
 End FObjMpred.
 
 Definition fobject_mpred: fobject_invariant := fun hs =>
-  EX instance, !!(HOcontractive (fun (_ : fObjInv -> mpred) (x : fObjInv) => instance x)) &&
-               fobj_mpred instance hs.
+  ∃ instance, fobj_mpred instance hs.
 (*This now plays the role of Andrew's obj_mpred*)
 
-Lemma fobject_mpred_isptr hs: fobject_mpred hs |-- !!(isptr (snd hs)).
+Lemma fobject_mpred_isptr hs: fobject_mpred hs ⊢ ⌜isptr (snd hs)⌝.
 Proof. unfold fobject_mpred; Intros inst. apply fObjMpred_isptr; trivial. Qed.
 
-Lemma fobj_mpred_entails_object_mpred inst hs
-  (H: HOcontractive (fun (_ : fObjInv -> mpred) (x : fObjInv) => inst x)):
-  fobj_mpred inst hs |-- fobject_mpred hs.
-Proof. unfold object_mpred. Exists inst. entailer!!. Qed.
+Lemma fobj_mpred_entails_object_mpred inst hs:
+  fobj_mpred inst hs ⊢ fobject_mpred hs.
+Proof. unfold fobject_mpred. Exists inst. entailer!!. Qed.
 
 Section FancySpecs.
 
@@ -1068,44 +657,39 @@ Definition fancyfoo_data : fobject_invariant :=
   (fun (x:fObjInv) => 
     withspacer Ews (sizeof size_t + sizeof tint) (2 * sizeof size_t) (field_at Ews (Tstruct _foo_object noattr) 
             [StructField _data] (Vint (Int.repr (2*fold_right Z.add 0 (fst (fst x)))))) (snd x) 
-   * withspacer Ews (sizeof size_t + 2*sizeof tint) (3 * sizeof size_t) (field_at Ews (Tstruct _fancyfoo_object noattr)
+   ∗ withspacer Ews (sizeof size_t + 2*sizeof tint) (3 * sizeof size_t) (field_at Ews (Tstruct _fancyfoo_object noattr)
             [StructField _color] (Vint (Int.repr (snd(fst x))))) (snd x)
-      *  malloc_token Ews (Tstruct _fancyfoo_object noattr) (snd x)).
-Lemma fancyfoo_data_HOcontr: HOcontractive (fun (_ : fObjInv -> mpred) (x : fObjInv) => fancyfoo_data x).
-Proof.
-  assert (predicates_rec.HOcontractive (fun (_ : fObjInv -> mpred) (x : fObjInv) => fancyfoo_data x)). 2: constructor; apply H.
-  unfold fancyfoo_data.
-  unfold withspacer; simpl.
-  apply Trashcan.sepcon_HOcontractive.
-  apply Trashcan.const_HOcontractive.
-  apply Trashcan.const_HOcontractive.
-Qed.
+      ∗ malloc_token Ews (Tstruct _fancyfoo_object noattr) (snd x)).
 
 Definition fancyfoo_obj_invariant :fobject_invariant := fobj_mpred fancyfoo_data.
 
 (*New lemma!*)
-Lemma fancyfoo_obj_invariant_fold_unfold: fancyfoo_obj_invariant =
+Lemma fancyfoo_obj_invariant_fold_unfold: fancyfoo_obj_invariant ≡
  fun hs =>
-  ((EX mtable: val, !!(isptr mtable) &&
-     (|>fobject_methods fancyfoo_obj_invariant  mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   fancyfoo_data hs)%logic.
+  ((∃ mtable: val, ⌜isptr mtable⌝ ∧
+     (▷fobject_methods fancyfoo_obj_invariant  mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   fancyfoo_data hs).
 Proof.
-  unfold fancyfoo_obj_invariant.
-  rewrite <- fObjMpred_fold_unfold. trivial. apply fancyfoo_data_HOcontr.
+  unfold fancyfoo_obj_invariant; intros ?.
+  rewrite <- fObjMpred_fold_unfold. trivial.
 Qed.
 
 (*Sometimes this variant is preferable, sometimes the one above*)
-Lemma fancyfoo_obj_invariant_fold_unfold' hs: fancyfoo_obj_invariant hs =
-  ((EX mtable: val, !!(isptr mtable) &&
-     (|>fobject_methods fancyfoo_obj_invariant  mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   fancyfoo_data hs)%logic.
-Proof. rewrite fancyfoo_obj_invariant_fold_unfold. rewrite <- fancyfoo_obj_invariant_fold_unfold; trivial. Qed.
-
-Lemma fancyfoo_data_isptr hs: fancyfoo_data hs = !!(isptr (snd hs)) && fancyfoo_data hs.
-apply pred_ext; entailer.
-unfold fancyfoo_data. entailer!. destruct (snd hs); simpl in *; trivial;  contradiction.
+Lemma fancyfoo_obj_invariant_fold_unfold' hs: fancyfoo_obj_invariant hs ⊣⊢
+  ((∃ mtable: val, ⌜isptr mtable⌝ ∧
+     (▷fobject_methods fancyfoo_obj_invariant  mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   fancyfoo_data hs).
+Proof. apply (fancyfoo_obj_invariant_fold_unfold hs). Qed.
+
+Lemma fancyfoo_data_isptr hs: fancyfoo_data hs ⊣⊢ ⌜isptr (snd hs)⌝ ∧ fancyfoo_data hs.
+Proof.
+  iSplit.
+  - iIntros; iSplit; last done.
+    unfold fancyfoo_data; iStopProof.
+    destruct (hs.2); entailer!.
+  - iIntros "(_ & $)".
 Qed.
 
 
@@ -1132,7 +716,7 @@ Definition make_fancyfoo_spec :=
     PROP () PARAMS (Vint(Int.repr c)) GLOBALS (gv) 
     SEP (mem_mgr gv; fobject_methods fancyfoo_obj_invariant (gv _fancyfoo_methods))
  POST [ tobject ]
-    EX p: val, PROP () LOCAL (temp ret_temp p)
+    ∃ p: val, PROP () LOCAL (temp ret_temp p)
      SEP (mem_mgr gv; fobject_mpred ((nil,c),p); fobject_methods fancyfoo_obj_invariant (gv _fancyfoo_methods)).
 
 Definition make_fancyfooTyped_spec :=
@@ -1142,7 +726,7 @@ Definition make_fancyfooTyped_spec :=
     PROP () PARAMS (Vint(Int.repr c)) GLOBALS (gv) 
     SEP (mem_mgr gv; fobject_methods fancyfoo_obj_invariant (gv _fancyfoo_methods))
  POST [ tptr (Tstruct _fancyfoo_object noattr) ]
-    EX p: val, PROP () LOCAL (temp ret_temp p)
+    ∃ p: val, PROP () LOCAL (temp ret_temp p)
      SEP (mem_mgr gv; fobject_mpred ((nil,c),p); fobject_methods fancyfoo_obj_invariant (gv _fancyfoo_methods)).
 
 End FancySpecs.
@@ -1154,19 +738,19 @@ Definition FancyGprog : funspecs :=   ltac:(with_library prog [
 
 Lemma body_fancyfoo_reset: semax_body Vprog FancyGprog f_foo_reset ffoo_reset_spec.
 Proof.
-start_function. 
-(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold. Intros m; unfold fancyfoo_data.
+start_function.
+(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold'. Intros m; unfold fancyfoo_data.
 unfold withspacer; simpl; Intros.
 forward.  (* self->data=0; *)
 entailer!!.
-(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold, <- fancyfoo_obj_invariant_fold_unfold. Exists m; unfold fancyfoo_data.
+(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold'. Exists m; unfold fancyfoo_data.
 all: unfold withspacer; simpl; entailer!!.  (* needed if Archi.ptr64=true *)
 Qed.
 
 Lemma body_fancyfoo_twiddle: semax_body Vprog FancyGprog f_foo_twiddle ffoo_twiddle_spec.
 Proof.
 start_function.
-(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold. Intros m; unfold fancyfoo_data.
+(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold'. Intros m; unfold fancyfoo_data.
 unfold withspacer; simpl.
 Intros.
 forward.  (* d = self->data; *)
@@ -1180,11 +764,11 @@ forward.  (* return d+i; *)
   forget (fold_right Z.add 0 (*(fst hs)*) (fst(fst hs))) as h.
   entailer!!. }
 Exists (2 * fold_right Z.add 0 (*(fst hs)*) (fst(fst hs)) + i).
-(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold, <- fancyfoo_obj_invariant_fold_unfold.
+(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold'.
 Exists m; unfold fancyfoo_data.
 simpl;
 entailer!!.
-rewrite Z.mul_add_distr_l, Z.add_comm.
+rewrite Z.mul_add_distr_l Z.add_comm.
 unfold withspacer; simpl.
 entailer!!.
 Qed.
@@ -1193,12 +777,12 @@ Qed.
 Lemma FC_fancymethods f m (L: legal_field (nested_field_type (Tstruct _methods noattr) []) (StructField f))
         (FC: field_compatible (Tstruct _fancymethods noattr) [StructField f] m):
         field_compatible (Tstruct _methods noattr) [StructField f] m.
-Proof. 
+Proof.
   destruct FC as [X1 [X2 [SZ [AL [X5 X6]]]]].
   destruct m; try inv X1. clear - L SZ AL.
   repeat split; auto.
   + simpl in *.  unfold sizeof in *; simpl in *; lia.
-  + clear L SZ. inv AL. inv H. inv H1. 
+  + clear L SZ. inv AL. inv H1.
     eapply align_compatible_rec_Tstruct; [reflexivity.. |].
     simpl co_members in *; intros. specialize (H4 i0 t0).
     simpl in H.
@@ -1225,7 +809,7 @@ Qed.
 Lemma body_fancyfoo_twiddleR: semax_body Vprog FancyGprog f_foo_twiddleR ffoo_twiddleR_spec.
 Proof.
 start_function.
-(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold. Intros m; unfold fancyfoo_data.
+(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold'. Intros m; unfold fancyfoo_data.
 unfold withspacer; simpl.
 Intros.
 forward.  (* d = self->data; *)
@@ -1242,19 +826,17 @@ replace_SEP 5 (field_at sh (Tstruct _methods noattr) [StructField _reset] r m).
   apply FC_fancymethods; trivial. left; auto. }
 
 forward. (*_s_reset = (_mtable -> _reset);*)
-forward_call hs. 
+forward_call hs.
 { (*NEW side condition - again a property of subclasses*)
   rewrite fancyfoo_obj_invariant_fold_unfold'.
   Exists m. unfold fancyfoo_data, withspacer; simpl. entailer!!.
-  eapply derives_trans. 
-  2:{ apply sepcon_derives.
-      apply ( make_fobject_methods_later sh fancyfoo_obj_invariant r t tR g s m); trivial.
-      apply derives_refl. } 
-  cancel. unfold_data_at (data_at sh (Tstruct _fancymethods noattr) _ _ ).
+  rewrite -make_fobject_methods_later; last done.
+  ecancel.
+  unfold_data_at (data_at sh (Tstruct _fancymethods noattr) _ _).
   cancel. unfold field_at; simpl; entailer!!. }
 (*The spec has folded the object, so need to unfold again*)
 deadvars!. clear - H H0.
-rewrite fancyfoo_obj_invariant_fold_unfold. Intros m. unfold fancyfoo_data, withspacer; Intros; simpl.
+rewrite fancyfoo_obj_invariant_fold_unfold'. Intros m. unfold fancyfoo_data, withspacer; Intros; simpl.
 
 forward.  (* self -> data = d+2*i; *) 
 { set (j:= Int.max_signed / 4) in *; compute in j; subst j.
@@ -1267,41 +849,41 @@ forward.  (* return d+i; *)
   forget (fold_right Z.add 0 (*(fst hs)*)(fst(fst hs))) as h.
   entailer!!. }
 Exists (2 * fold_right Z.add 0 (*(fst hs)*)(fst(fst hs)) + i).
-(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold, <- fancyfoo_obj_invariant_fold_unfold.
+(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold'.
 Exists m; unfold fancyfoo_data.
 simpl;
 entailer!!.
-rewrite Z.mul_add_distr_l, Z.add_comm.
+rewrite Z.mul_add_distr_l Z.add_comm.
 unfold withspacer; simpl.
 entailer!!.
 Qed.
 
 Lemma body_ffoo_setcolor: semax_body Vprog FancyGprog f_setcolor ffoo_setcolor_spec.
 Proof.
-start_function. 
-(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold. Intros m; unfold fancyfoo_data.
+start_function.
+(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold'. Intros m; unfold fancyfoo_data.
 unfold withspacer; simpl; Intros.
 forward.  (* self->color=0; *)
 entailer!!.
-(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold, <- fancyfoo_obj_invariant_fold_unfold. Exists m; unfold fancyfoo_data.
+(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold'. Exists m; unfold fancyfoo_data.
 all: unfold withspacer; simpl; entailer!!.  (* needed if Archi.ptr64=true *)
 Qed.
 
 Lemma body_ffoo_getcolor: semax_body Vprog FancyGprog f_getcolor ffoo_getcolor_spec.
 Proof.
-start_function. 
-(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold. Intros m; unfold fancyfoo_data.
+start_function.
+(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold'. Intros m; unfold fancyfoo_data.
 unfold withspacer; simpl; Intros.
 forward.  (* _t'1 = ((tptr (Tstruct _fancyfoo_object noattr)) _self -> _color); *)
 forward.
 entailer!!.
-(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold, <- fancyfoo_obj_invariant_fold_unfold. Exists m; unfold fancyfoo_data.
+(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold'. Exists m; unfold fancyfoo_data.
 all: unfold withspacer; simpl; entailer!!.  (* needed if Archi.ptr64=true *)
 Qed.
 
 Lemma split_fobject_methods:
-  forall instance m, 
-    fobject_methods instance m |-- fobject_methods instance m * fobject_methods instance m.
+  forall instance m,
+    fobject_methods instance m ⊢ fobject_methods instance m ∗ fobject_methods instance m.
 Proof.
 intros.
 unfold fobject_methods.
@@ -1309,18 +891,10 @@ Intros sh reset twiddle twiddleR setC getC.
 
 Exists (fst (slice.cleave sh)) reset twiddle twiddleR setC getC.
 Exists (snd (slice.cleave sh)) reset twiddle twiddleR setC getC.
-rewrite (split_func_ptr' (freset_spec instance) reset) at 1.
-rewrite (split_func_ptr' (ftwiddle_spec instance) twiddle) at 1.
-rewrite (split_func_ptr' (ftwiddle_spec instance) twiddleR) at 1.
-rewrite (split_func_ptr' (fsetcolor_spec instance) setC) at 1.
-rewrite (split_func_ptr' (fgetcolor_spec instance) getC) at 1.
-entailer!!.
-split.
-apply slice.cleave_readable1; auto.
-apply slice.cleave_readable2; auto.
-rewrite (data_at_share_join (fst (slice.cleave sh)) (snd (slice.cleave sh)) sh).
-auto.
-apply slice.cleave_join.
+iIntros "(#$ & #$ & #$ & #$ & #$ & H)".
+rewrite -(data_at_share_join (fst (slice.cleave sh)) (snd (slice.cleave sh)) sh); last apply slice.cleave_join.
+iDestruct "H" as "($ & $)".
+iPureIntro; repeat split; auto; apply slice.cleave_readable1 || apply slice.cleave_readable2; auto.
 Qed.
 
 Lemma body_make_fancyfoo: semax_body Vprog FancyGprog f_make_fancyfoo make_fancyfoo_spec.
@@ -1343,7 +917,7 @@ if_tac; entailer!!.
 forward_call 1.
 contradiction.
 *
-rewrite if_false by auto.
+rewrite -> if_false by auto.
 Intros.
 forward.  (*  /*skip*/;  *)
 entailer!!.
@@ -1359,36 +933,35 @@ entailer!!.
 unfold fobject_mpred.
 
 (*slight variation of Andrew's proof from here on*)
-Exists fancyfoo_data. entailer!!. 1: solve [apply fancyfoo_data_HOcontr].
-rewrite fObjMpred_fold_unfold by (apply fancyfoo_data_HOcontr).
-Exists (gv _fancyfoo_methods). simpl. normalize.
-rewrite ! sepcon_assoc. apply sepcon_derives. apply now_later.
+Exists fancyfoo_data. entailer!!.
+rewrite fObjMpred_fold_unfold.
+Exists (gv _fancyfoo_methods). entailer!.
+apply bi.sep_mono; first apply bi.later_intro.
 unfold fancyfoo_data; simpl. unfold withspacer; simpl.
 cancel.
 unfold_data_at (field_at _ _ nil _ p).
 cancel.
 assert_PROP (isptr p) by entailer!. destruct p; inv H2. entailer!.
-apply sepcon_derives.
+apply bi.sep_mono.
 + clear - H2. unfold field_at; simpl; entailer!!.
   - unfold field_compatible. destruct H2 as [_ [_ [SZ [AL _]]]].
     repeat split; trivial.
     ++ red. red in SZ. simpl sizeof in *. lia.
-    ++ clear SZ. inv AL. inv H.
+    ++ clear SZ. inv AL.
        eapply align_compatible_rec_Tstruct; [reflexivity.. | intros]. specialize (H4 i0).
-       simpl co_members in *; intros. inv H. 
+       simpl co_members in *; intros. inv H.
        if_tac in H5; inv H5.
        inv H0. inv H1. specialize (H4 _ 0 (eq_refl _) (eq_refl _)).
        inv H4. inv H. econstructor. reflexivity. trivial.
     ++ simpl. left; auto.
-  - unfold at_offset. entailer!!. unfold data_at_rec. simpl.
-    unfold mapsto; simpl. if_tac; entailer!!.
+  - unfold at_offset. entailer!!.
 + clear - H4. unfold field_at; simpl; entailer!!.
   - unfold field_compatible. destruct H4 as [_ [_ [SZ [AL _]]]].
     repeat split; trivial.
     ++ red. red in SZ. simpl sizeof in *. lia.
-    ++ clear SZ; inv AL. inv H.
+    ++ clear SZ; inv AL.
        eapply align_compatible_rec_Tstruct; [reflexivity.. | intros]. specialize (H4 i0).
-       simpl co_members in *; intros. inv H. 
+       simpl co_members in *; intros. inv H.
        if_tac in H5; inv H5.
        { inv H0. inv H1. specialize (H4 _ 0 (eq_refl _) (eq_refl _)).
           inv H4. inv H. econstructor. reflexivity. trivial. }
@@ -1399,7 +972,7 @@ apply sepcon_derives.
     ++ simpl. right; left; auto.
 Qed.
 
-(*EXACT SAME PROOF SCRIPT AS Lemma body_make_fancyfoo*)
+(*∃ACT SAME PROOF SCRIPT AS Lemma body_make_fancyfoo*)
 Lemma body_make_fancyfooTyped: semax_body Vprog FancyGprog f_make_fancyfooTyped make_fancyfooTyped_spec.
 Proof.
 unfold make_fancyfooTyped_spec.
@@ -1420,7 +993,7 @@ if_tac; entailer!!.
 forward_call 1.
 contradiction.
 *
-rewrite if_false by auto.
+rewrite -> if_false by auto.
 Intros.
 forward.  (*  /*skip*/;  *)
 entailer!!.
@@ -1436,10 +1009,10 @@ entailer!!.
 unfold fobject_mpred.
 
 (*slight variation of Andrew's proof from here on*)
-Exists fancyfoo_data. entailer!!. 1: solve [apply fancyfoo_data_HOcontr].
-rewrite fObjMpred_fold_unfold by (apply fancyfoo_data_HOcontr).
-Exists (gv _fancyfoo_methods). simpl. normalize.
-rewrite ! sepcon_assoc. apply sepcon_derives. apply now_later.
+Exists fancyfoo_data. entailer!!.
+rewrite fObjMpred_fold_unfold.
+Exists (gv _fancyfoo_methods). entailer!.
+apply bi.sep_mono; first apply bi.later_intro.
 unfold fancyfoo_data; simpl. unfold withspacer; simpl.
 cancel.
 unfold_data_at (field_at _ _ nil _ p).
@@ -1447,27 +1020,26 @@ cancel.
 
 (*TODO: There's at least one variation of Lemma MC_FC in here...*)
 assert_PROP (isptr p) by entailer!. destruct p; inv H2. entailer!.
-apply sepcon_derives.
+apply bi.sep_mono.
 + clear - H2. unfold field_at; simpl; entailer!!.
   - unfold field_compatible. destruct H2 as [_ [_ [SZ [AL _]]]].
     repeat split; trivial.
     ++ red. red in SZ. simpl sizeof in *. lia.
-    ++ clear SZ. inv AL. inv H.
+    ++ clear SZ. inv AL.
        eapply align_compatible_rec_Tstruct; [reflexivity.. | intros]. specialize (H4 i0).
-       simpl co_members in *; intros. inv H. 
+       simpl co_members in *; intros. inv H.
        if_tac in H5; inv H5.
        inv H0. inv H1. specialize (H4 _ 0 (eq_refl _) (eq_refl _)).
        inv H4. inv H. econstructor. reflexivity. trivial.
     ++ simpl. left; auto.
-  - unfold at_offset. entailer!!. unfold data_at_rec. simpl.
-    unfold mapsto; simpl. if_tac; entailer!!.
+  - unfold at_offset. entailer!!.
 + clear. unfold field_at; simpl; entailer!!.
   - unfold field_compatible. destruct H as [_ [_ [SZ [AL _]]]].
     repeat split; trivial.
     ++ red. red in SZ. simpl sizeof in *. lia.
-    ++ clear SZ; inv AL. inv H.
+    ++ clear SZ; inv AL.
        eapply align_compatible_rec_Tstruct; [reflexivity.. | intros]. specialize (H4 i0).
-       simpl co_members in *; intros. inv H. 
+       simpl co_members in *; intros. inv H.
        if_tac in H5; inv H5.
        { inv H0. inv H1. specialize (H4 _ 0 (eq_refl _) (eq_refl _)).
           inv H4. inv H. econstructor. reflexivity. trivial. }
@@ -1487,39 +1059,37 @@ Definition main_spec :=
   WITH gv: globals
   PRE  [] main_pre prog tt gv
   POST [ tint ]
-     EX i:Z, PROP(0<=i<=6) LOCAL (temp ret_temp (Vint (Int.repr (i+13)))) SEP(TT).
+     ∃ i:Z, PROP(0<=i<=6) LOCAL (temp ret_temp (Vint (Int.repr (i+13)))) SEP(True).
+
+Notation funspec := (@funspec Σ).
 
 Definition reset_intersection: funspec.
 Proof.
-eapply (binary_intersection' (reset_spec foo_obj_invariant) (freset_spec fancyfoo_obj_invariant)); reflexivity.
+eapply (binary_intersection'(A1 := ConstType _)(A2 := ConstType _) (reset_spec foo_obj_invariant) (freset_spec fancyfoo_obj_invariant)); reflexivity.
 Defined.
 Definition twiddle_intersection: funspec.
 Proof.
-eapply (binary_intersection' (twiddle_spec foo_obj_invariant) (ftwiddle_spec fancyfoo_obj_invariant)); reflexivity.
+eapply (binary_intersection'(A1 := ConstType _)(A2 := ConstType _) (twiddle_spec foo_obj_invariant) (ftwiddle_spec fancyfoo_obj_invariant)); reflexivity.
 Defined.
 
 Lemma reset_sub_foo: funspec_sub reset_intersection (reset_spec foo_obj_invariant).
 Proof.
-  rewrite funspec_sub_iff.
 apply (binaryintersection_sub (reset_spec foo_obj_invariant) (freset_spec fancyfoo_obj_invariant)).
 apply binary_intersection'_sound.
 Qed.
 Lemma reset_sub_fancy: funspec_sub reset_intersection (freset_spec fancyfoo_obj_invariant).
 Proof.
-  rewrite funspec_sub_iff.
 apply (binaryintersection_sub (reset_spec foo_obj_invariant) (freset_spec fancyfoo_obj_invariant)).
 apply binary_intersection'_sound.
 Qed.
 
 Lemma twiddle_sub_foo: funspec_sub twiddle_intersection (twiddle_spec foo_obj_invariant).
 Proof.
-  rewrite funspec_sub_iff.
 apply (binaryintersection_sub (twiddle_spec foo_obj_invariant) (ftwiddle_spec fancyfoo_obj_invariant)).
 apply binary_intersection'_sound.
 Qed.
 Lemma twiddle_sub_fancy: funspec_sub twiddle_intersection (ftwiddle_spec fancyfoo_obj_invariant).
 Proof.
-  rewrite funspec_sub_iff.
 apply (binaryintersection_sub (twiddle_spec foo_obj_invariant) (ftwiddle_spec fancyfoo_obj_invariant)).
 apply binary_intersection'_sound.
 Qed.
@@ -1550,8 +1120,8 @@ replace_SEP 0 (data_at Ews (Tstruct _methods noattr)
   by  auto with field_compatible. 
   rewrite <- mapsto_field_at with (gfs := [StructField _twiddleR]) (v:= (gv _foo_twiddleR))
   by  auto with field_compatible.
-  rewrite field_at_data_at. rewrite !field_compatible_field_address by auto with field_compatible.
-  rewrite !isptr_offset_val_zero by auto.
+  rewrite field_at_data_at. rewrite -> !field_compatible_field_address by auto with field_compatible.
+  rewrite -> !isptr_offset_val_zero by auto.
   cancel.
 }
 gather_SEP (mapsto _ _ (offset_val 16 (gv _fancyfoo_methods)) _) 
@@ -1571,8 +1141,8 @@ replace_SEP 0 (data_at Ews (Tstruct _fancymethods noattr)
   by  auto with field_compatible. 
   rewrite <- mapsto_field_at with (gfs := [StructField _getcolor]) (v:= (gv _getcolor))
   by  auto with field_compatible.
-  rewrite field_at_data_at. rewrite !field_compatible_field_address by auto with field_compatible.
-  rewrite !isptr_offset_val_zero by auto.
+  rewrite field_at_data_at. rewrite -> !field_compatible_field_address by auto with field_compatible.
+  rewrite -> !isptr_offset_val_zero by auto.
   cancel.
 }
 
@@ -1580,19 +1150,19 @@ replace_SEP 0 (data_at Ews (Tstruct _fancymethods noattr)
         fancymethods is a proper method table for fancyfoo-objects *)
 
 make_func_ptr _foo_reset.
-replace_SEP 0 (func_ptr' (reset_spec foo_obj_invariant) (gv _foo_reset) *
-               func_ptr' (freset_spec fancyfoo_obj_invariant) (gv _foo_reset)).
-{ entailer!. rewrite split_func_ptr'. apply sepcon_derives; apply func_ptr'_mono.
+replace_SEP 0 (func_ptr (reset_spec foo_obj_invariant) (gv _foo_reset) ∗
+               func_ptr (freset_spec fancyfoo_obj_invariant) (gv _foo_reset)).
+{ entailer!. iIntros "#?"; iSplit; iApply (func_ptr_mono with "[$]").
   apply reset_sub_foo. apply reset_sub_fancy. }
 make_func_ptr _foo_twiddle.
-replace_SEP 0 (func_ptr' (twiddle_spec foo_obj_invariant) (gv _foo_twiddle) *
-               func_ptr' (ftwiddle_spec fancyfoo_obj_invariant) (gv _foo_twiddle)).
-{ entailer!. rewrite split_func_ptr'. apply sepcon_derives; apply func_ptr'_mono.
+replace_SEP 0 (func_ptr (twiddle_spec foo_obj_invariant) (gv _foo_twiddle) ∗
+               func_ptr (ftwiddle_spec fancyfoo_obj_invariant) (gv _foo_twiddle)).
+{ entailer!. iIntros "#?"; iSplit; iApply (func_ptr_mono with "[$]").
   apply twiddle_sub_foo. apply twiddle_sub_fancy. }
 make_func_ptr _foo_twiddleR.
-replace_SEP 0 (func_ptr' (twiddle_spec foo_obj_invariant) (gv _foo_twiddleR) *
-               func_ptr' (ftwiddle_spec fancyfoo_obj_invariant) (gv _foo_twiddleR)).
-{ entailer!. rewrite split_func_ptr'. apply sepcon_derives; apply func_ptr'_mono.
+replace_SEP 0 (func_ptr (twiddle_spec foo_obj_invariant) (gv _foo_twiddleR) ∗
+               func_ptr (ftwiddle_spec fancyfoo_obj_invariant) (gv _foo_twiddleR)).
+{ entailer!. iIntros "#?"; iSplit; iApply (func_ptr_mono with "[$]").
   apply twiddle_sub_foo. apply twiddle_sub_fancy. }
 sep_apply (make_object_methods Ews foo_obj_invariant (gv _foo_reset) (gv _foo_twiddle) (gv _foo_twiddleR) (gv _foo_methods)); auto.
 
@@ -1630,7 +1200,7 @@ assert_PROP (p<>Vundef) as pNotVundef by entailer!.
 unfold object_mpred.
 
 (*WAS:Intros instance mtable0.*)
-(*Now*) Intros instance. rename H into HOC. rewrite ObjMpred_fold_unfold by trivial. Intros mtable0; simpl.
+(*Now*) Intros instance. rewrite ObjMpred_fold_unfold. Intros mtable0; simpl.
 
 forward. (*  mtable = p->mtable; *)
 unfold object_methods at 1.
@@ -1640,7 +1210,7 @@ forward_call (* p_reset(p); *)
       (@nil Z,p).
 { (*NEW subgoal*)
    sep_apply make_object_methods_later.
-   rewrite ObjMpred_fold_unfold, <- ObjMpred_fold_unfold by trivial.
+   rewrite ObjMpred_fold_unfold.
    Exists mtable0. entailer!!. } 
 (* WAS (*Finish the method-call by regathering the object p back together *)
 sep_apply (make_object_methods sh instance r0 t0 mtable0); auto.
@@ -1656,7 +1226,7 @@ deadvars!. clear.
 unfold fobject_mpred.
 
 (*WAS:Intros instance mtable0.*)
-(*Now*) Intros instance. rename H into HOC. rewrite fObjMpred_fold_unfold by trivial. Intros mtable0; simpl.
+(*Now*) Intros instance. rewrite fObjMpred_fold_unfold. Intros mtable0; simpl.
 
 forward. (*_t'9 = (_q -> _mtable);*)
 forward. (*_mtable = (tptr (Tstruct _fancymethods noattr)) _t'9;*)
@@ -1668,8 +1238,8 @@ forward_call (* q_reset(q); *)
       ((@nil Z,4),q).
 { (*NEW subgoal*)
    sep_apply make_fobject_methods_later.
-   rewrite fObjMpred_fold_unfold, <- fObjMpred_fold_unfold by trivial.
-   Exists mtable0. entailer!. } 
+   rewrite fObjMpred_fold_unfold.
+   Exists mtable0. entailer!. }
 (* WAS (*Finish the method-call by regathering the object p back together *)
 sep_apply (make_object_methods sh instance r0 t0 mtable0); auto.
 sep_apply (object_mpred_i [] p instance mtable0).*)
@@ -1684,7 +1254,7 @@ deadvars!. clear.
 unfold fobject_mpred.
 
 (*WAS:Intros instance mtable0.*)
-(*Now*) Intros instance. rename H into HOC. rewrite fObjMpred_fold_unfold by trivial. Intros mtable0; simpl.
+(*Now*) Intros instance. rewrite fObjMpred_fold_unfold. Intros mtable0; simpl.
 
 forward. (*_t'8 = (_q -> _mtable);*)
 forward. (*_mtable = (tptr (Tstruct _fancymethods noattr)) _t'8;*)
@@ -1696,7 +1266,7 @@ forward_call (* q_reset(q); *)
       ((@nil Z,4),q).
 { (*NEW subgoal*)
    sep_apply make_fobject_methods_later.
-   rewrite fObjMpred_fold_unfold, <- fObjMpred_fold_unfold by trivial.
+   rewrite fObjMpred_fold_unfold.
    Exists mtable0. entailer!. } 
 (* WAS (*Finish the method-call by regathering the object p back together *)
 sep_apply (make_object_methods sh instance r0 t0 mtable0); auto.
@@ -1712,7 +1282,7 @@ deadvars!. clear.
 unfold object_mpred.
 
 (*WAS:Intros instance mtable0.*)
-(*Now*) Intros instance. rename H into HOC. rewrite ObjMpred_fold_unfold by trivial. Intros mtable0; simpl.
+(*Now*) Intros instance. rewrite ObjMpred_fold_unfold. Intros mtable0; simpl.
 
 forward.  (* pmtable = p->mtable; *)
 unfold object_methods at 1.
@@ -1723,9 +1293,9 @@ forward_call (* i = p_twiddle(p,3); *)
       ((@nil Z,p), 3).
 { (*NEW subgoal*)
    sep_apply make_object_methods_later.
-   rewrite ObjMpred_fold_unfold, <- ObjMpred_fold_unfold by trivial.
+   rewrite ObjMpred_fold_unfold.
    Exists mtable0. entailer!. }
-{ simpl. repeat split; try trivial; computable. }
+{ simpl; computable. }
 Intros i.
 simpl in H0. (*
 sep_apply (make_object_methods sh instance r0 t0 mtable0); auto.
@@ -1745,7 +1315,7 @@ freeze [2;3] PQ. (*Hide the other objects p and q*)
 unfold fobject_mpred.
 
 (*WAS:Intros instance mtable0.*)
-(*Now*) Intros instance. rename H into HOC. rewrite fObjMpred_fold_unfold by trivial. Intros mtable0; simpl.
+(*Now*) Intros instance. rewrite fObjMpred_fold_unfold. Intros mtable0; simpl.
 
 forward. (*_t'7 = ((tptr (Tstruct _object noattr)) _u -> _mtable);*)
 forward. (* _umtable = (tptr (Tstruct _fancymethods noattr)) _t'7;*)
@@ -1757,8 +1327,8 @@ forward_call (* u_reset(u); *)
       ((@nil Z,9),u).
 { (*NEW subgoal*)
    sep_apply make_fobject_methods_later.
-   rewrite fObjMpred_fold_unfold, <- fObjMpred_fold_unfold by trivial.
-   Exists mtable0. entailer!!. } 
+   rewrite fObjMpred_fold_unfold.
+   Exists mtable0. entailer!!. }
 (* WAS (*Finish the method-call by regathering the object p back together *)
 sep_apply (make_object_methods sh instance r0 t0 mtable0); auto.
 sep_apply (object_mpred_i [] p instance mtable0).*)
@@ -1773,7 +1343,7 @@ deadvars!. clear -Hi.
 unfold fobject_mpred.
 
 (*WAS:Intros instance mtable0.*)
-(*Now*) Intros instance. rename H into HOC. rewrite fObjMpred_fold_unfold by trivial. Intros mtable0; simpl.
+(*Now*) Intros instance. rewrite fObjMpred_fold_unfold. Intros mtable0; simpl.
 
 forward. (*_t'7 = ((tptr (Tstruct _object noattr)) _u -> _mtable);*)
 forward. (* _umtable = (tptr (Tstruct _fancymethods noattr)) _t'7;*)
@@ -1785,8 +1355,8 @@ forward_call (* u_getcolor(u); *)
       ((@nil Z,9),u).
 { (*NEW subgoal*)
    sep_apply make_fobject_methods_later.
-   rewrite fObjMpred_fold_unfold, <- fObjMpred_fold_unfold by trivial.
-   Exists mtable0. entailer!. } 
+   rewrite fObjMpred_fold_unfold.
+   Exists mtable0. entailer!. }
 (* WAS (*Finish the method-call by regathering the object p back together *)
 sep_apply (make_object_methods sh instance r0 t0 mtable0); auto.
 sep_apply (object_mpred_i [] p instance mtable0).*)
@@ -1806,9 +1376,10 @@ Parameter QQ:mpred.
 Lemma funspec_sub_reset_foo_fancy: funspec_sub (reset_spec foo_obj_invariant) (freset_spec fancyfoo_obj_invariant).
 Proof. eapply funspec_sub_trans. apply reset_spec_local_sub. unfold fobject_invariant_of_inv.
  do_funspec_sub.
-  rewrite fancyfoo_obj_invariant_fold_unfold' at 1. (*foo_obj_invariant_fold_unfold;*) Intros m.
+  rewrite fancyfoo_obj_invariant_fold_unfold'. (*foo_obj_invariant_fold_unfold;*) Intros m.
+  rewrite -fupd_intro.
   Exists w QQ. destruct w as [[hs c] p]; simpl in *. entailer!.
- + intros. rewrite foo_obj_invariant_fold_unfold', fancyfoo_obj_invariant_fold_unfold'.
+ + intros. rewrite foo_obj_invariant_fold_unfold' fancyfoo_obj_invariant_fold_unfold'.
    normalize. Exists mtable. entailer!. unfold fancyfoo_data, foo_data, withspacer; simpl.
    cancel. (*QQ = field_at color, later funspecs for setC, getC*) admit.
  + rewrite foo_obj_invariant_fold_unfold'. Exists m.
@@ -1818,32 +1389,35 @@ Abort. (*same issue as below: method table needs to be co and contravariant*)
 (* entailment / "proof-theoretic behavioral subtyping' not suitable"*)
 
 Lemma funspec_sub_reset_foo_fancy: funspec_sub (reset_spec foo_obj_invariant) (freset_spec fancyfoo_obj_invariant).
-Proof. do_funspec_sub. simpl in H. inv H. inv H6.
-  destruct w as [[hs c] q]. 
-  rewrite fancyfoo_obj_invariant_fold_unfold' at 1. (*foo_obj_invariant_fold_unfold;*) Intros m.
+Proof. do_funspec_sub. simpl in H. inv H.
+  destruct w as [[hs c] q].
+  rewrite fancyfoo_obj_invariant_fold_unfold'. (*foo_obj_invariant_fold_unfold;*) Intros m.
   simpl in H0, H4.
+  rewrite -fupd_intro.
   Exists (hs, q). entailer.
   unfold fancyfoo_data, foo_data, withspacer; simpl. entailer!!.
-  unfold fobject_methods. 
-  rewrite later_exp'; normalize. rename x into sh.
-  rewrite later_exp'; normalize. rename x into r.
-  rewrite later_exp'; normalize. rename x into t.
-  rewrite later_exp'; normalize. rename x into tR.
-  rewrite later_exp'; normalize. rename x into sC.
-  rewrite later_exp'; normalize. rename x into gC.
+  unfold fobject_methods.
+  rewrite bi.later_exist; Intros sh.
+  rewrite bi.later_exist; Intros r.
+  rewrite bi.later_exist; Intros t.
+  rewrite bi.later_exist; Intros tR.
+  rewrite bi.later_exist; Intros sC.
+  rewrite bi.later_exist; Intros gC.
   Exists ((
-     field_at Ews (Tstruct _fancyfoo_object noattr) [StructField _color] (Vint (Int.repr c)) q *
-     (|> (func_ptr' (fsetcolor_spec fancyfoo_obj_invariant) sC *
-          func_ptr' (fgetcolor_spec fancyfoo_obj_invariant) gC))) * 
-     ((malloc_token Ews (Tstruct _foo_object noattr) q) -* malloc_token Ews (Tstruct _fancyfoo_object noattr) q)).
-  rewrite later_andp. rewrite ! later_sepcon. Intros.
-  entailer. apply andp_right.
+     field_at Ews (Tstruct _fancyfoo_object noattr) [StructField _color] (Vint (Int.repr c)) q ∗
+     (▷ (func_ptr (fsetcolor_spec fancyfoo_obj_invariant) sC ∗
+          func_ptr (fgetcolor_spec fancyfoo_obj_invariant) gC))) ∗
+     ((malloc_token Ews (Tstruct _foo_object noattr) q) -∗ malloc_token Ews (Tstruct _fancyfoo_object noattr) q)).
+  rewrite bi.later_and !bi.later_sep. Intros.
+  entailer. apply bi.and_intro.
   + entailer!!. intros. rewrite fancyfoo_obj_invariant_fold_unfold'; simpl.
     Exists m. entailer!!. (*
     sep_apply wand_frame_elim''. cancel.
-(*    eapply derives_trans. apply sepcon_derives. apply now_later. apply derives_refl.*)
+(*    eapply derives_trans. apply sepcon_derives. apply bi.later_intro. apply derives_refl.*)
     rewrite  <- ! later_sepcon. 
     apply later_derives. Exists sh r t tR sC gC. entailer!. admit. (*readable_share*)
     unfold object_methods. admit.
   + entailer!. cancel. normalize.*)
 Abort.
+
+End mpred.
diff --git a/progs/verif_objectSelfFancyOverriding.v b/progs/verif_objectSelfFancyOverriding.v
index 3fcf6dbf26..a6e6a59f3a 100644
--- a/progs/verif_objectSelfFancyOverriding.v
+++ b/progs/verif_objectSelfFancyOverriding.v
@@ -3,7 +3,7 @@ Require Import VST.floyd.library.
 Require Import VST.progs.objectSelfFancyOverriding.
 
 (*Version 1 -- leave specs of foo methods unchanged, and require neither funcspec_sub nor 
-anything else. Just replictae the spec/proof structure of foo in fancy foo and see whether
+anything else. Just replicate the spec/proof structure of foo in fancy foo and see whether
 the client has enough knowledge to call the correct function*)
 
 (*Require Import VST.floyd.Funspec_old_Notation.*)
@@ -11,17 +11,18 @@ the client has enough knowledge to call the correct function*)
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
-Local Open Scope Z.
-Local Open Scope logic.
+Section mpred.
+
+Context `{!default_VSTGS Σ}.
 
 Section FOO.
 
 (*Andrew's definition
 Definition object_invariant := list Z -> val -> mpred.*)
 
-(*But the uncurried version is easier for the HOrec construction*)
+(*But the uncurried version is easier for the fixpoint construction*)
 Definition ObjInv : Type:= (list Z * val).
-Definition object_invariant := ObjInv -> mpred.
+Definition object_invariant := ObjInv -d> mpred.
 
 Definition tobject := tptr (Tstruct _object noattr).
 
@@ -43,21 +44,39 @@ Definition twiddle_spec (instance: object_invariant) :=
           PARAMS (snd hs; Vint (Int.repr i)) GLOBALS ()
           SEP (instance hs)
   POST [ tint ]
-      EX v: Z, 
+      ∃ v: Z,
           PROP(2* fold_right Z.add 0 (fst hs) < v <= 2* fold_right Z.add 0 (i::(fst hs)))
-          LOCAL (temp ret_temp (Vint (Int.repr v))) 
+          LOCAL (temp ret_temp (Vint (Int.repr v)))
           SEP(instance (i::(fst hs), snd hs)).
 
 Definition object_methods (instance: object_invariant) (mtable: val) : mpred :=
-  EX sh: share, EX reset: val, EX twiddle: val, EX twiddleR:val,
-  !! readable_share sh && 
-  func_ptr' (reset_spec instance) reset *
-  func_ptr' (twiddle_spec instance) twiddle *
-  func_ptr' (twiddle_spec instance) twiddleR *
+  ∃ sh: share, ∃ reset: val, ∃ twiddle: val, ∃ twiddleR:val,
+  ⌜readable_share sh⌝ ∧
+  func_ptr (reset_spec instance) reset ∗
+  func_ptr (twiddle_spec instance) twiddle ∗
+  func_ptr (twiddle_spec instance) twiddleR ∗
   data_at sh (Tstruct _methods noattr) (reset,(twiddle, twiddleR)) mtable.
+Typeclasses Opaque object_methods.
+
+Global Instance reset_spec_ne : NonExpansive reset_spec.
+Proof.
+  intros ????.
+  unfold reset_spec, NDmk_funspec.
+  f_equiv; intros ??; simpl; by repeat f_equiv.
+Qed.
+
+Global Instance twiddle_spec_ne : NonExpansive twiddle_spec.
+Proof.
+  intros ????.
+  unfold twiddle_spec, NDmk_funspec.
+  f_equiv; intros ??; simpl; by repeat f_equiv.
+Qed.
+
+Global Instance object_methods_ne n : Proper (dist n ==> eq ==> dist n) object_methods.
+Proof. solve_proper. Qed.
 
 Lemma object_methods_local_facts: forall instance p,
-  object_methods instance p |-- !! isptr p.
+  object_methods instance p ⊢ ⌜isptr p⌝.
 Proof.
 intros.
 unfold object_methods.
@@ -70,11 +89,11 @@ Local Hint Resolve object_methods_local_facts : saturate_local.
 Lemma make_object_methods:
   forall sh instance reset twiddle twiddleR mtable,
   readable_share sh ->
-  func_ptr' (reset_spec instance) reset *
-  func_ptr' (twiddle_spec instance) twiddle *
-  func_ptr' (twiddle_spec instance) twiddleR * 
+  func_ptr (reset_spec instance) reset ∗
+  func_ptr (twiddle_spec instance) twiddle ∗
+  func_ptr (twiddle_spec instance) twiddleR ∗
   data_at sh (Tstruct _methods noattr) (reset, (twiddle, twiddleR)) mtable
-  |-- object_methods instance mtable.
+  ⊢ object_methods instance mtable.
 Proof.
   intros.
   unfold object_methods.
@@ -85,18 +104,18 @@ Qed.
 Lemma make_object_methods_later:
   forall sh instance reset twiddle twiddleR mtable,
   readable_share sh ->
-  func_ptr' (reset_spec instance) reset *
-  func_ptr' (twiddle_spec instance) twiddle *
-  func_ptr' (twiddle_spec instance) twiddleR * 
+  func_ptr (reset_spec instance) reset ∗
+  func_ptr (twiddle_spec instance) twiddle ∗
+  func_ptr (twiddle_spec instance) twiddleR ∗
   data_at sh (Tstruct _methods noattr) (reset, (twiddle, twiddleR)) mtable
-  |-- |> object_methods instance mtable.
+  ⊢ ▷ object_methods instance mtable.
 Proof.
-intros. eapply derives_trans. apply make_object_methods; trivial. apply now_later.
+intros. eapply derives_trans. apply make_object_methods; trivial. apply bi.later_intro.
 Qed.
 
 (*Andrew's definition
 Definition object_mpred (history: list Z) (self: val) : mpred :=
-  EX instance: object_invariant, EX mtable: val, 
+  ∃ instance: object_invariant, ∃ mtable: val, 
        (object_methods instance mtable *
      field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable self*
      instance history self).*)
@@ -104,252 +123,58 @@ Definition object_mpred (history: list Z) (self: val) : mpred :=
 Section ObjMpred.
 Variable instance: object_invariant.
 
-Definition F (X: ObjInv -> mpred) (hs: ObjInv): mpred :=
-   ((EX mtable: val, !!(isptr mtable) (*This has to hold NOW, not ust LATER*)&&
-     (|> object_methods X mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   instance hs)%logic.
-
-Definition HOcontractive1 {A: Type}{NA: NatDed A}{IA: Indir A}{RI: RecIndir A}{X: Type}
-     (f: (X -> A) -> (X -> A)) := 
- forall P Q : X -> A,
- ALL x : X, |> fash (P x <--> Q x)
- |-- ALL x : X, fash (f P x --> f Q x).
-
-Lemma HOcontractive_i1:
- forall  (A: Type)(NA: NatDed A){IA: Indir A}{RI: RecIndir A}{X: Type}
-     (f: (X -> A) -> (X -> A)),
-  HOcontractive1 f -> HOcontractive f.
-Proof.
-intros.
-red in H|-*.
-intros.
-eapply derives_trans.
-apply andp_right.
-apply H.
-specialize (H Q P).
-eapply derives_trans.
-2: apply H.
-apply allp_derives; intros.
-apply later_derives.
-apply fash_derives.
-rewrite andp_comm.
-auto.
-apply allp_right; intro.
-rewrite fash_andp.
-apply andp_right.
-apply andp_left1.
-apply allp_left with v; auto.
-apply andp_left2.
-apply allp_left with v; auto.
-Qed.
+Definition F (X: ObjInv -d> mpred) : ObjInv -d> mpred := fun hs =>
+   ((∃ mtable: val, ⌜isptr mtable⌝ (*This has to hold NOW, not just LATER*)∧
+     (▷ object_methods X mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   instance hs).
 
-Lemma HOcontrF
-     (*Need sth like this (HI: HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => instance x))*):
-      HOcontractive F.
+Local Instance F_contractive : Contractive F.
 Proof.
-unfold F.
-apply HOcontractive_i1.
-red; intros.
-apply allp_right; intro oi.
-apply subp_sepcon_mpred; [ | apply subp_refl].
-apply subp_exp; intro v.
-apply subp_sepcon_mpred; [ | apply subp_refl].
-clear oi.
-apply subp_andp; [ apply subp_refl | ].
-eapply derives_trans, subp_later1.
-rewrite <- later_allp.
-apply later_derives.
-unfold object_methods.
-apply subp_exp; intro sh.
-apply subp_exp; intro reset.
-apply subp_exp; intro twiddle.
-apply subp_exp; intro twiddleR.
-apply subp_sepcon_mpred; [ | apply subp_refl].
-repeat simple apply subp_sepcon_mpred;
-try (simple apply subp_andp; [simple apply subp_refl | ]).
-+
-unfold func_ptr'.
-apply subp_andp; [ | apply subp_refl].
-clear - instance.
-eapply derives_trans; [ | apply fash_func_ptr_ND].
-apply allp_right; intro oi.
-apply andp_right.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold convertPre.
-unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-rewrite prop_true_andp by tauto.
-subst zz.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with oi.
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left2. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold convertPre.
-unfold PROPx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-subst zz.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with ([], snd oi).
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left1. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-+
-unfold func_ptr'.
-apply subp_andp; [ | apply subp_refl].
-clear - instance.
-eapply derives_trans; [ | apply fash_func_ptr_ND].
-apply allp_right; intros [hs i].
-apply andp_right.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold convertPre.
-unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-rewrite prop_true_andp by tauto.
-subst zz.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with hs.
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left2. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold PROPx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-subst zz.
-apply exp_right with x.
-normalize.
-rewrite prop_true_andp by tauto.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with (i::fst hs, snd hs).
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left1. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-+
-unfold func_ptr'.
-apply subp_andp; [ | apply subp_refl].
-clear - instance.
-eapply derives_trans; [ | apply fash_func_ptr_ND].
-apply allp_right; intros [hs i].
-apply andp_right.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold convertPre.
-unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-rewrite prop_true_andp by tauto.
-subst zz.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with hs.
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left2. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold PROPx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-subst zz.
-apply exp_right with x.
-normalize.
-rewrite prop_true_andp by tauto.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with (i::fst hs, snd hs).
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left1. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
+  intros ?????.
+  unfold F.
+  do 5 f_equiv.
+  f_contractive.
+  rewrite H //.
 Qed.
 
-Definition obj_mpred:ObjInv -> mpred := (HORec F). (*ie same type as Andrew's object_mpred.*)
+Definition obj_mpred:ObjInv -> mpred := fixpoint F.
 
-Lemma ObjMpred_fold_unfold: 
-HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => instance x) ->
-obj_mpred = 
-fun hs => 
-  ((EX mtable: val,!!(isptr mtable) &&
-     (|> object_methods obj_mpred mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   instance hs)%logic.
+Lemma ObjMpred_fold_unfold:
+forall hs, obj_mpred hs ⊣⊢
+  ((∃ mtable: val,⌜isptr mtable⌝ ∧
+     (▷ object_methods obj_mpred mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   instance hs).
 Proof.
   intros; unfold obj_mpred at 1.
-  rewrite HORec_fold_unfold; [ reflexivity | apply HOcontrF]; trivial.
+  by rewrite (fixpoint_unfold F _).
 Qed.
-Lemma ObjMpred_fold_unfold' hs: 
-HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => instance x) ->
-obj_mpred hs = 
-  ((EX mtable: val, !!(isptr mtable) &&
-     (|> object_methods obj_mpred mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   instance hs)%logic.
+Lemma ObjMpred_fold_unfold' hs:
+obj_mpred hs ⊣⊢
+  ((∃ mtable: val, ⌜isptr mtable⌝ ∧
+     (▷ object_methods obj_mpred mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   instance hs).
 Proof.
-  intros. rewrite ObjMpred_fold_unfold, <- ObjMpred_fold_unfold; trivial. 
+  intros. rewrite ObjMpred_fold_unfold -ObjMpred_fold_unfold; trivial.
 Qed.
 
-Lemma ObjMpred_isptr
-   (H: HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => instance x))
-    hs: obj_mpred hs |-- !!(isptr (snd hs)).
-Proof. rewrite ObjMpred_fold_unfold' by trivial; Intros m. entailer!. Qed.
+Lemma ObjMpred_isptr hs: obj_mpred hs ⊢ ⌜isptr (snd hs)⌝.
+Proof. rewrite -> ObjMpred_fold_unfold' by trivial; Intros m. entailer!. Qed.
 
 End ObjMpred.
 
 Definition object_mpred: object_invariant := fun hs =>
-  EX instance, !!(HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => instance x)) &&
-               obj_mpred instance hs.
+  ∃ instance, obj_mpred instance hs.
 (*This now plays the role of Andrew's obj_mpred*)
 
-Lemma object_mpred_isptr hs: object_mpred hs |-- !!(isptr (snd hs)).
+Lemma object_mpred_isptr hs: object_mpred hs ⊢ ⌜isptr (snd hs)⌝.
 Proof. unfold object_mpred; Intros inst. apply ObjMpred_isptr; trivial. Qed.
 
-Lemma obj_mpred_entails_object_mpred inst hs
-  (H: HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => inst x)):
-  obj_mpred inst hs |-- object_mpred hs.
-Proof. unfold object_mpred. Exists inst. entailer!!. Qed.
+Lemma obj_mpred_entails_object_mpred inst hs:
+  obj_mpred inst hs ⊢ object_mpred hs.
+Proof. unfold object_mpred. Exists inst. entailer!. Qed.
 
 (*Andrew's specs 
 Definition foo_invariant : object_invariant :=
@@ -373,7 +198,7 @@ Definition make_foo_spec :=
     PROP () LOCAL (gvars gv) 
     SEP (mem_mgr gv; object_methods foo_invariant (gv _foo_methods))
  POST [ tobject ]
-    EX p: val, PROP () LOCAL (temp ret_temp p)
+    ∃ p: val, PROP () LOCAL (temp ret_temp p)
      SEP (mem_mgr gv; object_mpred (*nil p*)(nil, p); object_methods foo_invariant (gv _foo_methods)).
 
 *)
@@ -383,42 +208,37 @@ Definition foo_data : object_invariant :=
   (fun (x:ObjInv) => 
     withspacer Ews (sizeof size_t + sizeof tint) (2 * sizeof size_t) (field_at Ews (Tstruct _foo_object noattr) 
             [StructField _data] (Vint (Int.repr (2*fold_right Z.add 0 (fst x))))) (snd x)
-      *  malloc_token Ews (Tstruct _foo_object noattr) (snd x)).
-Lemma foo_data_HOcontr: HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => foo_data x).
-Proof.
-  assert (predicates_rec.HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => foo_data x)). 2: constructor; apply H.
-  unfold foo_data.
-  unfold withspacer; simpl.
-  apply Trashcan.sepcon_HOcontractive.
-  apply Trashcan.const_HOcontractive.
-  apply Trashcan.const_HOcontractive.
-Qed.
+      ∗ malloc_token Ews (Tstruct _foo_object noattr) (snd x)).
 
-Definition foo_obj_invariant :object_invariant := obj_mpred foo_data.
+Definition foo_obj_invariant : object_invariant := obj_mpred foo_data.
 
 (*New lemma!*)
-Lemma foo_obj_invariant_fold_unfold: foo_obj_invariant =
+Lemma foo_obj_invariant_fold_unfold: foo_obj_invariant ≡
  fun hs =>
-  ((EX mtable: val, !!(isptr mtable) &&
-     (|>object_methods foo_obj_invariant  mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   foo_data hs)%logic.
+  ((∃ mtable: val, ⌜isptr mtable⌝ ∧
+     (▷object_methods foo_obj_invariant  mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   foo_data hs).
 Proof.
-  unfold foo_obj_invariant.
-  rewrite <- ObjMpred_fold_unfold. trivial. apply foo_data_HOcontr.
+  unfold foo_obj_invariant; intros ?.
+  rewrite <- ObjMpred_fold_unfold. trivial.
 Qed.
 
 (*Sometimes this variant is preferable, sometimes the one above*)
-Lemma foo_obj_invariant_fold_unfold' hs: foo_obj_invariant hs =
-  ((EX mtable: val, !!(isptr mtable) &&
-     (|>object_methods foo_obj_invariant  mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   foo_data hs)%logic.
-Proof. rewrite foo_obj_invariant_fold_unfold. rewrite <- foo_obj_invariant_fold_unfold; trivial. Qed.
-
-Lemma foo_data_isptr hs: foo_data hs = !!(isptr (snd hs)) && foo_data hs.
-apply pred_ext; entailer.
-unfold foo_data. entailer!. destruct (snd hs); simpl in *; trivial;  contradiction.
+Lemma foo_obj_invariant_fold_unfold' hs: foo_obj_invariant hs ⊣⊢
+  ((∃ mtable: val, ⌜isptr mtable⌝ ∧
+     (▷object_methods foo_obj_invariant  mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   foo_data hs).
+Proof. apply (foo_obj_invariant_fold_unfold hs). Qed.
+
+Lemma foo_data_isptr hs: foo_data hs ⊣⊢ ⌜isptr (snd hs)⌝ ∧ foo_data hs.
+Proof.
+  iSplit.
+  - iIntros; iSplit; last done.
+    unfold foo_data; iStopProof.
+    destruct (hs.2); entailer!.
+  - iIntros "(_ & $)".
 Qed.
 
 
@@ -438,7 +258,7 @@ Definition make_foo_spec :=
     PROP () PARAMS () GLOBALS (gv) 
     SEP (mem_mgr gv; object_methods foo_obj_invariant (gv _foo_methods))
  POST [ tobject ]
-    EX p: val, PROP () LOCAL (temp ret_temp p)
+    ∃ p: val, PROP () LOCAL (temp ret_temp p)
      SEP (mem_mgr gv; object_mpred (nil,p); object_methods foo_obj_invariant (gv _foo_methods)).
 End NewSpecs.
 
@@ -447,18 +267,18 @@ Definition FooGprog : funspecs :=   ltac:(with_library prog [
 
 Lemma body_foo_reset: semax_body Vprog FooGprog f_foo_reset foo_reset_spec.
 Proof.
-start_function. 
-(*New:*) rewrite foo_obj_invariant_fold_unfold. Intros m; unfold foo_data.
+start_function.
+(*New:*) rewrite foo_obj_invariant_fold_unfold'. Intros m; unfold foo_data.
 unfold withspacer; simpl; Intros.
 forward.  (* self->data=0; *)
 entailer!!.
-(*New:*) rewrite foo_obj_invariant_fold_unfold, <- foo_obj_invariant_fold_unfold. Exists m; unfold foo_data.
-all: unfold withspacer; simpl; entailer!!.  (* needed if Archi.ptr64=true *)
+(*New:*) rewrite foo_obj_invariant_fold_unfold'. Exists m; unfold foo_data.
+all: unfold withspacer; simpl; entailer!.  (* needed if Archi.ptr64=true *)
 Qed.
 
-Lemma body_foo_reset_alternativeproof: semax_body Vprog FooGprog f_foo_reset foo_reset_spec.
+(*Lemma body_foo_reset_alternativeproof: semax_body Vprog Gprog f_foo_reset foo_reset_spec.
 Proof.
-(*New*) unfold foo_reset_spec. rewrite foo_obj_invariant_fold_unfold; unfold reset_spec.
+(*New*) unfold foo_reset_spec. rewrite foo_obj_invariant_fold_unfold'; unfold reset_spec.
 start_function. 
 (*New:*) Intros m; unfold foo_data.
 unfold withspacer; simpl; Intros.
@@ -466,12 +286,13 @@ forward.  (* self->data=0; *)
 entailer!!.
 (*New:*) Exists m; unfold foo_data.
 all: unfold withspacer; simpl; entailer!!.  (* needed if Archi.ptr64=true *)
-Qed.
+Qed.*)
 
 Lemma body_foo_twiddle: semax_body Vprog FooGprog f_foo_twiddle foo_twiddle_spec.
 Proof.
-(*New*) unfold foo_twiddle_spec. rewrite foo_obj_invariant_fold_unfold; unfold twiddle_spec.
+(*New*) unfold foo_twiddle_spec. unfold twiddle_spec.
 start_function.
+rewrite foo_obj_invariant_fold_unfold'.
 (*New:*) Intros m; unfold foo_data.
 unfold withspacer; simpl.
 Intros.
@@ -486,18 +307,20 @@ forward.  (* return d+i; *)
   forget (fold_right Z.add 0 (*history*)(fst hs)) as h.
   entailer!!. }
 Exists (2 * fold_right Z.add 0 (*history*)(fst hs) + i).
+rewrite foo_obj_invariant_fold_unfold'.
 (*New:*) Exists m; unfold foo_data.
 simpl;
 entailer!!.
-rewrite Z.mul_add_distr_l, Z.add_comm.
+rewrite Z.mul_add_distr_l Z.add_comm.
 unfold withspacer; simpl.
 entailer!!.
 Qed.
 
 Lemma body_foo_twiddleR: semax_body Vprog FooGprog f_foo_twiddleR foo_twiddleR_spec.
 Proof.
-(*New*) unfold foo_twiddleR_spec. rewrite foo_obj_invariant_fold_unfold; unfold twiddle_spec.
+(*New*) unfold foo_twiddleR_spec. unfold twiddle_spec.
 start_function.
+rewrite foo_obj_invariant_fold_unfold'.
 (*New:*) Intros m; unfold foo_data.
 unfold withspacer; simpl.
 Intros.
@@ -507,13 +330,13 @@ forward.  (* d = self->data; *)
 forward.
 unfold object_methods. Intros sh r t tR.
 forward. (*_s_reset = (_mtable -> _reset);*)
-forward_call hs. 
+forward_call hs.
 { rewrite foo_obj_invariant_fold_unfold'.
   Exists m. unfold foo_data, withspacer; simpl. entailer!!.
-  sep_apply make_object_methods_later. cancel. }
+  rewrite -make_object_methods_later //. ecancel. }
 (*The spec has folded the object, so need to unfold again*)
 deadvars!. clear - H H0.
-rewrite foo_obj_invariant_fold_unfold. Intros m. unfold foo_data, withspacer; Intros; simpl.
+rewrite foo_obj_invariant_fold_unfold'. Intros m. unfold foo_data, withspacer; Intros; simpl.
 
 forward.  (* self -> data = d+2*i; *) 
 { set (j:= Int.max_signed / 4) in *; compute in j; subst j.
@@ -526,17 +349,18 @@ forward.  (* return d+i; *)
   forget (fold_right Z.add 0 (*history*)(fst hs)) as h.
   entailer!!. }
 Exists (2 * fold_right Z.add 0 (*history*)(fst hs) + i).
+rewrite foo_obj_invariant_fold_unfold'.
 (*New:*) Exists m; unfold foo_data.
 simpl;
-entailer!!.
-rewrite Z.mul_add_distr_l, Z.add_comm.
+entailer!.
+rewrite Z.mul_add_distr_l Z.add_comm.
 unfold withspacer; simpl.
 entailer!!.
 Qed.
 
 Lemma split_object_methods:
-  forall instance m, 
-    object_methods instance m |-- object_methods instance m * object_methods instance m.
+  forall instance m,
+    object_methods instance m ⊢ object_methods instance m ∗ object_methods instance m.
 Proof.
 intros.
 unfold object_methods.
@@ -544,16 +368,10 @@ Intros sh reset twiddle twiddleR.
 
 Exists (fst (slice.cleave sh)) reset twiddle twiddleR.
 Exists (snd (slice.cleave sh)) reset twiddle twiddleR.
-rewrite (split_func_ptr' (reset_spec instance) reset) at 1.
-rewrite (split_func_ptr' (twiddle_spec instance) twiddle) at 1.
-rewrite (split_func_ptr' (twiddle_spec instance) twiddleR) at 1.
-entailer!.
-split.
-apply slice.cleave_readable1; auto.
-apply slice.cleave_readable2; auto.
-rewrite (data_at_share_join (fst (slice.cleave sh)) (snd (slice.cleave sh)) sh).
-auto.
-apply slice.cleave_join.
+iIntros "(#$ & #$ & #$ & H)".
+rewrite -(data_at_share_join (fst (slice.cleave sh)) (snd (slice.cleave sh)) sh); last apply slice.cleave_join.
+iDestruct "H" as "($ & $)".
+iPureIntro; repeat split; auto; apply slice.cleave_readable1 || apply slice.cleave_readable2; auto.
 Qed.
 
 (* Isolate a lemma from Andrew's proof of body_make_foo; TODO: simplify the following proof. *)
@@ -600,7 +418,7 @@ if_tac; entailer!!.
 forward_call 1.
 contradiction.
 *
-rewrite if_false by auto.
+rewrite -> if_false by auto.
 Intros.
 forward.  (*  /*skip*/;  *)
 entailer!!.
@@ -612,34 +430,32 @@ forward. (* return (struct object * ) p; *)
 Exists p.
 sep_apply (split_object_methods foo_obj_invariant (gv _foo_methods)).
 entailer!!.
-unfold object_mpred.
+unfold obj_mpred.
 
 (*slight variation of Andrew's proof from here on*)
-Exists foo_data. entailer!!. 1: solve [apply foo_data_HOcontr].
-rewrite ObjMpred_fold_unfold by (apply foo_data_HOcontr).
+Exists foo_data. entailer!!.
+rewrite -> ObjMpred_fold_unfold by (apply foo_data_HOcontr).
 Exists (gv _foo_methods). simpl. normalize.
-rewrite ! sepcon_assoc. apply sepcon_derives. apply now_later.
 unfold foo_data; simpl. unfold withspacer; simpl.
 cancel.
+apply bi.sep_mono; first apply bi.later_intro.
 unfold_data_at (field_at _ _ nil _ p).
 cancel.
 clear -H.
 rewrite !field_at_data_at.
 simpl.
-apply derives_refl'.
-rewrite <- ?sepcon_assoc. (* needed if Archi.ptr64=true *)
+f_equiv.
 rewrite !field_compatible_field_address; auto with field_compatible.
 apply MC_FC; trivial.
 Qed.
-
 End FOO.
 
 Section FancyFoo.
 
 Definition fObjInv : Type:= ((list Z * Z) * val).
-Definition fobject_invariant := fObjInv -> mpred.
+Definition fobject_invariant := fObjInv -d> mpred.
 
-(*not replcatedDefinition tobject := tptr (Tstruct _object noattr).*)
+(*not replicated: Definition tobject := tptr (Tstruct _object noattr).*)
 
 (*A new spec, not just the adpatation of reset_spec to fancy invariants*)
 Definition freset_spec (instance: fobject_invariant) :=
@@ -660,9 +476,9 @@ Definition ftwiddle_spec (instance: fobject_invariant) :=
           PARAMS (snd hs; Vint (Int.repr i)) GLOBALS ()
           SEP (instance hs)
   POST [ tint ]
-      EX v: Z, 
+      ∃ v: Z,
           PROP(2* fold_right Z.add 0 (fst (fst hs)) < v <= 2* fold_right Z.add 0 (i::(fst (fst hs))))
-          LOCAL (temp ret_temp (Vint (Int.repr v))) 
+          LOCAL (temp ret_temp (Vint (Int.repr v)))
           SEP(instance ((i::(fst (fst hs)), snd(fst hs)), snd hs)).
 
 (*A separate spec, since this method is affected by the overrising of reset*)
@@ -675,7 +491,7 @@ Definition ftwiddleR_spec (instance: fobject_invariant) :=
           PARAMS (snd hs; Vint (Int.repr i)) GLOBALS ()
           SEP (instance hs)
   POST [ tint ]
-      EX v: Z, 
+      ∃ v: Z, 
           PROP(2* fold_right Z.add 0 (fst (fst hs)) < v <= 2* fold_right Z.add 0 (i::(fst (fst hs))))
           LOCAL (temp ret_temp (Vint (Int.repr v))) 
           SEP(instance ((i::(fst (fst hs)), 0), snd hs)).
@@ -701,17 +517,55 @@ Definition fgetcolor_spec (instance: fobject_invariant) :=
           SEP(instance hs).
 
 Definition fobject_methods (instance: fobject_invariant) (mtable: val) : mpred :=
-  EX sh: share, EX reset: val, EX twiddle: val, EX twiddleR:val, EX setcol: val, EX getcol:val,
-  !! readable_share sh && 
-  func_ptr' (freset_spec instance) reset *
-  func_ptr' (ftwiddle_spec instance) twiddle *
-  func_ptr' (ftwiddleR_spec instance) twiddleR *
-  func_ptr' (fsetcolor_spec instance) setcol *
-  func_ptr' (fgetcolor_spec instance) getcol *
+  ∃ sh: share, ∃ reset: val, ∃ twiddle: val, ∃ twiddleR:val, ∃ setcol: val, ∃ getcol:val,
+  ⌜readable_share sh⌝ ∧ 
+  func_ptr (freset_spec instance) reset ∗
+  func_ptr (ftwiddle_spec instance) twiddle ∗
+  func_ptr (ftwiddleR_spec instance) twiddleR ∗
+  func_ptr (fsetcolor_spec instance) setcol ∗
+  func_ptr (fgetcolor_spec instance) getcol ∗
   data_at sh (Tstruct _fancymethods noattr) (reset,(twiddle, (twiddleR, (setcol, getcol)))) mtable.
 
+Global Instance freset_spec_ne : NonExpansive freset_spec.
+Proof.
+  intros ????.
+  unfold freset_spec, NDmk_funspec.
+  f_equiv; intros ??; simpl; by repeat f_equiv.
+Qed.
+
+Global Instance ftwiddle_spec_ne : NonExpansive ftwiddle_spec.
+Proof.
+  intros ????.
+  unfold ftwiddle_spec, NDmk_funspec.
+  f_equiv; intros ??; simpl; by repeat f_equiv.
+Qed.
+
+Global Instance ftwiddleR_spec_ne : NonExpansive ftwiddleR_spec.
+Proof.
+  intros ????.
+  unfold ftwiddleR_spec, NDmk_funspec.
+  f_equiv; intros ??; simpl; by repeat f_equiv.
+Qed.
+
+Global Instance fsetcolor_spec_ne : NonExpansive fsetcolor_spec.
+Proof.
+  intros ????.
+  unfold fsetcolor_spec, NDmk_funspec.
+  f_equiv; intros ??; simpl; by repeat f_equiv.
+Qed.
+
+Global Instance fgetcolor_spec_ne : NonExpansive fgetcolor_spec.
+Proof.
+  intros ????.
+  unfold fgetcolor_spec, NDmk_funspec.
+  f_equiv; intros ??; simpl; by repeat f_equiv.
+Qed.
+
+Global Instance fobject_methods_ne n : Proper (dist n ==> eq ==> dist n) fobject_methods.
+Proof. solve_proper. Qed.
+
 Lemma fobject_methods_local_facts: forall instance p,
-  fobject_methods instance p |-- !! isptr p.
+  fobject_methods instance p ⊢ ⌜isptr p⌝.
 Proof.
 intros.
 unfold fobject_methods.
@@ -723,13 +577,13 @@ Local Hint Resolve fobject_methods_local_facts : saturate_local.
 Lemma make_fobject_methods:
   forall sh instance reset twiddle twiddleR setcol getcol mtable,
   readable_share sh ->
-  func_ptr' (freset_spec instance) reset *
-  func_ptr' (ftwiddle_spec instance) twiddle *
-  func_ptr' (ftwiddleR_spec instance) twiddleR * 
-  func_ptr' (fsetcolor_spec instance) setcol *
-  func_ptr' (fgetcolor_spec instance) getcol *
+  func_ptr (freset_spec instance) reset ∗
+  func_ptr (ftwiddle_spec instance) twiddle ∗
+  func_ptr (ftwiddleR_spec instance) twiddleR ∗
+  func_ptr (fsetcolor_spec instance) setcol ∗
+  func_ptr (fgetcolor_spec instance) getcol ∗
   data_at sh (Tstruct _fancymethods noattr) (reset,(twiddle, (twiddleR, (setcol, getcol)))) mtable
-  |-- fobject_methods instance mtable.
+  ⊢ fobject_methods instance mtable.
 Proof.
   intros.
   unfold fobject_methods.
@@ -740,326 +594,72 @@ Qed.
 Lemma make_fobject_methods_later:
   forall sh instance reset twiddle twiddleR setcol getcol mtable,
   readable_share sh ->
-  func_ptr' (freset_spec instance) reset *
-  func_ptr' (ftwiddle_spec instance) twiddle *
-  func_ptr' (ftwiddleR_spec instance) twiddleR * 
-  func_ptr' (fsetcolor_spec instance) setcol *
-  func_ptr' (fgetcolor_spec instance) getcol *
+  func_ptr (freset_spec instance) reset ∗
+  func_ptr (ftwiddle_spec instance) twiddle ∗
+  func_ptr (ftwiddleR_spec instance) twiddleR ∗
+  func_ptr (fsetcolor_spec instance) setcol ∗
+  func_ptr (fgetcolor_spec instance) getcol ∗
   data_at sh (Tstruct _fancymethods noattr) (reset,(twiddle, (twiddleR, (setcol, getcol)))) mtable
-  |-- |> fobject_methods instance mtable.
+  ⊢ ▷ fobject_methods instance mtable.
 Proof.
-intros. eapply derives_trans. apply make_fobject_methods; trivial. apply now_later.
+intros. eapply derives_trans. apply make_fobject_methods; trivial. apply bi.later_intro.
 Qed.
 
 Section FObjMpred.
 Variable instance: fobject_invariant.
 
-Definition G (X: fObjInv -> mpred) (hs: fObjInv): mpred :=
-   ((EX mtable: val, !!(isptr mtable) (*This has to hold NOW, not ust LATER*)&&
-     (|> fobject_methods X mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   instance hs)%logic.
+Definition G (X: fObjInv -d> mpred) : fObjInv -d> mpred := fun hs =>
+   ((∃ mtable: val, ⌜isptr mtable⌝ (*This has to hold NOW, not ust LATER*)∧
+     (▷ fobject_methods X mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   instance hs).
 
-Lemma HOcontrG
-     (*Need sth like this (HI: HOcontractive (fun (_ : ObjInv -> mpred) (x : ObjInv) => instance x))*):
-      HOcontractive G.
+Local Instance G_contractive : Contractive G.
 Proof.
-unfold F.
-apply HOcontractive_i1.
-red; intros.
-apply allp_right; intro oi.
-apply subp_sepcon_mpred; [ | apply subp_refl].
-apply subp_exp; intro v.
-apply subp_sepcon_mpred; [ | apply subp_refl].
-clear oi.
-apply subp_andp; [ apply subp_refl | ].
-eapply derives_trans, subp_later1.
-rewrite <- later_allp.
-apply later_derives.
-unfold fobject_methods.
-apply subp_exp; intro sh.
-apply subp_exp; intro reset.
-apply subp_exp; intro twiddle.
-apply subp_exp; intro twiddleR.
-apply subp_exp; intro setCol.
-apply subp_exp; intro getCol.
-apply subp_sepcon_mpred; [ | apply subp_refl].
-repeat simple apply subp_sepcon_mpred;
-try (simple apply subp_andp; [simple apply subp_refl | ]).
-+
-unfold func_ptr'.
-apply subp_andp; [ | apply subp_refl].
-clear - instance.
-eapply derives_trans; [ | apply fash_func_ptr_ND].
-apply allp_right; intro oi.
-apply andp_right.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold convertPre.
-unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-rewrite prop_true_andp by tauto.
-subst zz.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with oi.
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left2. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold convertPre.
-unfold PROPx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-subst zz.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with ([], 0, snd oi).
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left1. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-+
-unfold func_ptr'.
-apply subp_andp; [ | apply subp_refl].
-clear - instance.
-eapply derives_trans; [ | apply fash_func_ptr_ND].
-apply allp_right; intros [hs i].
-apply andp_right.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold convertPre.
-unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-rewrite prop_true_andp by tauto.
-subst zz.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with hs.
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left2. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold PROPx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-subst zz.
-apply exp_right with x.
-normalize.
-rewrite prop_true_andp by tauto.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with (i :: fst (fst hs), snd (fst hs), snd hs).
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left1. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-+
-unfold func_ptr'.
-apply subp_andp; [ | apply subp_refl].
-clear - instance.
-eapply derives_trans; [ | apply fash_func_ptr_ND].
-apply allp_right; intros [hs i].
-apply andp_right.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold convertPre.
-unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-rewrite prop_true_andp by tauto.
-subst zz.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with hs.
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left2. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold PROPx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-subst zz.
-apply exp_right with x.
-normalize.
-rewrite prop_true_andp by tauto.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with (i :: fst (fst hs), 0, snd hs).
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left1. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-+
-unfold func_ptr'.
-apply subp_andp; [ | apply subp_refl].
-clear - instance.
-eapply derives_trans; [ | apply fash_func_ptr_ND].
-apply allp_right; intros [hs i].
-apply andp_right.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold convertPre.
-unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-rewrite prop_true_andp by tauto.
-subst zz.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with hs.
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left2. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold PROPx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-subst zz. (*
-apply exp_right with x.
-normalize.
-rewrite prop_true_andp by tauto.*)
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with (fst (fst hs), i, snd hs).
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left1. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-+
-unfold func_ptr'.
-apply subp_andp; [ | apply subp_refl].
-clear - instance.
-eapply derives_trans; [ | apply fash_func_ptr_ND].
-apply allp_right; intros [hs i].
-apply andp_right.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold convertPre.
-unfold PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-rewrite prop_true_andp by tauto.
-subst zz.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with (hs,i).
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left2. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
-*
-apply allp_right; intro rho.
-apply subp_i1.
-rewrite unfash_allp.
-set (zz := allp _).
-unfold PROPx, LOCALx, SEPx, local, lift1; simpl.
-unfold_lift.
-normalize.
-subst zz. (*
-apply exp_right with x.
-normalize.
-rewrite prop_true_andp by tauto.*)
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply allp_left with (hs,i).
-apply unfash_fash.
-eapply derives_trans.
-apply andp_derives.
-apply andp_left1. apply derives_refl. apply derives_refl.
-rewrite andp_comm. apply modus_ponens.
+  intros ?????.
+  unfold G.
+  do 5 f_equiv.
+  f_contractive.
+  rewrite H //.
 Qed.
 
-Definition fobj_mpred:fObjInv -> mpred := (HORec G). (*ie same type as Andrew's object_mpred.*)
+Definition fobj_mpred:fObjInv -> mpred := fixpoint G.
 
-Lemma fObjMpred_fold_unfold: 
-HOcontractive (fun (_ : fObjInv -> mpred) (x : fObjInv) => instance x) ->
-fobj_mpred = 
-fun hs => 
-  ((EX mtable: val,!!(isptr mtable) &&
-     (|> fobject_methods fobj_mpred mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   instance hs)%logic.
+Lemma fObjMpred_fold_unfold:
+forall hs, fobj_mpred hs ⊣⊢
+  ((∃ mtable: val,⌜isptr mtable⌝ ∧
+     (▷ fobject_methods fobj_mpred mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   instance hs).
 Proof.
   intros; unfold fobj_mpred at 1.
-  rewrite HORec_fold_unfold; [ reflexivity | apply HOcontrG]; trivial.
+  by rewrite (fixpoint_unfold G _).
 Qed.
-Lemma fObjMpred_fold_unfold' hs: 
-HOcontractive (fun (_ : fObjInv -> mpred) (x : fObjInv) => instance x) ->
-fobj_mpred hs = 
-  ((EX mtable: val, !!(isptr mtable) &&
-     (|> fobject_methods fobj_mpred mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   instance hs)%logic.
+Lemma fObjMpred_fold_unfold' hs:
+fobj_mpred hs ⊣⊢
+  ((∃ mtable: val, ⌜isptr mtable⌝ ∧
+     (▷ fobject_methods fobj_mpred mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   instance hs).
 Proof.
-  intros. rewrite fObjMpred_fold_unfold, <- fObjMpred_fold_unfold; trivial. 
+  intros. rewrite fObjMpred_fold_unfold -fObjMpred_fold_unfold; trivial.
 Qed.
 
-Lemma fObjMpred_isptr
-   (H: HOcontractive (fun (_ : fObjInv -> mpred) (x : fObjInv) => instance x))
-    hs: fobj_mpred hs |-- !!(isptr (snd hs)).
-Proof. rewrite fObjMpred_fold_unfold' by trivial; Intros m. entailer!. Qed.
+Lemma fObjMpred_isptr hs: fobj_mpred hs ⊢ ⌜isptr (snd hs)⌝.
+Proof. rewrite -> fObjMpred_fold_unfold' by trivial; Intros m. entailer!. Qed.
 
 End FObjMpred.
 
 Definition fobject_mpred: fobject_invariant := fun hs =>
-  EX instance, !!(HOcontractive (fun (_ : fObjInv -> mpred) (x : fObjInv) => instance x)) &&
-               fobj_mpred instance hs.
+  ∃ instance, fobj_mpred instance hs.
 (*This now plays the role of Andrew's obj_mpred*)
 
-Lemma fobject_mpred_isptr hs: fobject_mpred hs |-- !!(isptr (snd hs)).
+Lemma fobject_mpred_isptr hs: fobject_mpred hs ⊢ ⌜isptr (snd hs)⌝.
 Proof. unfold fobject_mpred; Intros inst. apply fObjMpred_isptr; trivial. Qed.
 
-Lemma fobj_mpred_entails_object_mpred inst hs
-  (H: HOcontractive (fun (_ : fObjInv -> mpred) (x : fObjInv) => inst x)):
-  fobj_mpred inst hs |-- fobject_mpred hs.
-Proof. unfold object_mpred. Exists inst. entailer!!. Qed.
+Lemma fobj_mpred_entails_object_mpred inst hs:
+  fobj_mpred inst hs ⊢ fobject_mpred hs.
+Proof. unfold fobject_mpred. Exists inst. entailer!!. Qed.
 
 Section FancySpecs.
 
@@ -1069,44 +669,39 @@ Definition fancyfoo_data : fobject_invariant :=
   (fun (x:fObjInv) => 
     withspacer Ews (sizeof size_t + sizeof tint) (2 * sizeof size_t) (field_at Ews (Tstruct _foo_object noattr) 
             [StructField _data] (Vint (Int.repr (2*fold_right Z.add 0 (fst (fst x)))))) (snd x) 
-   * withspacer Ews (sizeof size_t + 2*sizeof tint) (3 * sizeof size_t) (field_at Ews (Tstruct _fancyfoo_object noattr)
+   ∗ withspacer Ews (sizeof size_t + 2*sizeof tint) (3 * sizeof size_t) (field_at Ews (Tstruct _fancyfoo_object noattr)
             [StructField _color] (Vint (Int.repr (snd(fst x))))) (snd x)
-      *  malloc_token Ews (Tstruct _fancyfoo_object noattr) (snd x)).
-Lemma fancyfoo_data_HOcontr: HOcontractive (fun (_ : fObjInv -> mpred) (x : fObjInv) => fancyfoo_data x).
-Proof.
-  assert (predicates_rec.HOcontractive (fun (_ : fObjInv -> mpred) (x : fObjInv) => fancyfoo_data x)). 2: constructor; apply H.
-  unfold fancyfoo_data.
-  unfold withspacer; simpl.
-  apply Trashcan.sepcon_HOcontractive.
-  apply Trashcan.const_HOcontractive.
-  apply Trashcan.const_HOcontractive.
-Qed.
+      ∗ malloc_token Ews (Tstruct _fancyfoo_object noattr) (snd x)).
 
 Definition fancyfoo_obj_invariant :fobject_invariant := fobj_mpred fancyfoo_data.
 
 (*New lemma!*)
-Lemma fancyfoo_obj_invariant_fold_unfold: fancyfoo_obj_invariant =
+Lemma fancyfoo_obj_invariant_fold_unfold: fancyfoo_obj_invariant ≡
  fun hs =>
-  ((EX mtable: val, !!(isptr mtable) &&
-     (|>fobject_methods fancyfoo_obj_invariant  mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   fancyfoo_data hs)%logic.
+  ((∃ mtable: val, ⌜isptr mtable⌝ ∧
+     (▷fobject_methods fancyfoo_obj_invariant  mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   fancyfoo_data hs).
 Proof.
-  unfold fancyfoo_obj_invariant.
-  rewrite <- fObjMpred_fold_unfold. trivial. apply fancyfoo_data_HOcontr.
+  unfold fancyfoo_obj_invariant; intros ?.
+  rewrite <- fObjMpred_fold_unfold. trivial.
 Qed.
 
 (*Sometimes this variant is preferable, sometimes the one above*)
-Lemma fancyfoo_obj_invariant_fold_unfold' hs: fancyfoo_obj_invariant hs =
-  ((EX mtable: val, !!(isptr mtable) &&
-     (|>fobject_methods fancyfoo_obj_invariant  mtable) *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) *
-   fancyfoo_data hs)%logic.
-Proof. rewrite fancyfoo_obj_invariant_fold_unfold. rewrite <- fancyfoo_obj_invariant_fold_unfold; trivial. Qed.
-
-Lemma fancyfoo_data_isptr hs: fancyfoo_data hs = !!(isptr (snd hs)) && fancyfoo_data hs.
-apply pred_ext; entailer.
-unfold fancyfoo_data. entailer!. destruct (snd hs); simpl in *; trivial;  contradiction.
+Lemma fancyfoo_obj_invariant_fold_unfold' hs: fancyfoo_obj_invariant hs ⊣⊢
+  ((∃ mtable: val, ⌜isptr mtable⌝ ∧
+     (▷fobject_methods fancyfoo_obj_invariant  mtable) ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable (snd hs)) ∗
+   fancyfoo_data hs).
+Proof. apply (fancyfoo_obj_invariant_fold_unfold hs). Qed.
+
+Lemma fancyfoo_data_isptr hs: fancyfoo_data hs ⊣⊢ ⌜isptr (snd hs)⌝ ∧ fancyfoo_data hs.
+Proof.
+  iSplit.
+  - iIntros; iSplit; last done.
+    unfold fancyfoo_data; iStopProof.
+    destruct (hs.2); entailer!.
+  - iIntros "(_ & $)".
 Qed.
 
 
@@ -1135,7 +730,7 @@ Definition make_fancyfoo_spec :=
     PROP () PARAMS (Vint(Int.repr c)) GLOBALS (gv) 
     SEP (mem_mgr gv; fobject_methods fancyfoo_obj_invariant (gv _fancyfoo_methods))
  POST [ tobject ]
-    EX p: val, PROP () LOCAL (temp ret_temp p)
+    ∃ p: val, PROP () LOCAL (temp ret_temp p)
      SEP (mem_mgr gv; fobject_mpred ((nil,c),p); fobject_methods fancyfoo_obj_invariant (gv _fancyfoo_methods)).
 
 Definition make_fancyfooTyped_spec :=
@@ -1145,7 +740,7 @@ Definition make_fancyfooTyped_spec :=
     PROP () PARAMS (Vint(Int.repr c)) GLOBALS (gv) 
     SEP (mem_mgr gv; fobject_methods fancyfoo_obj_invariant (gv _fancyfoo_methods))
  POST [ tptr (Tstruct _fancyfoo_object noattr) ]
-    EX p: val, PROP () LOCAL (temp ret_temp p)
+    ∃ p: val, PROP () LOCAL (temp ret_temp p)
      SEP (mem_mgr gv; fobject_mpred ((nil,c),p); fobject_methods fancyfoo_obj_invariant (gv _fancyfoo_methods)).
 
 End FancySpecs.
@@ -1158,20 +753,20 @@ Definition FancyGprog : funspecs :=   ltac:(with_library prog [
 (*Now concerns the function f_fancy_reset*)
 Lemma body_fancyfoo_reset: semax_body Vprog FancyGprog f_fancy_reset ffoo_reset_spec.
 Proof.
-start_function. 
-(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold. Intros m; unfold fancyfoo_data.
+start_function.
+(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold'. Intros m; unfold fancyfoo_data.
 unfold withspacer; simpl; Intros.
 forward.  (* self->data=0; *)
 forward.  (* self->color=0; *)
 entailer!!.
-(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold, <- fancyfoo_obj_invariant_fold_unfold. Exists m; unfold fancyfoo_data.
+(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold'. Exists m; unfold fancyfoo_data.
 all: unfold withspacer; simpl; entailer!!.  (* needed if Archi.ptr64=true *)
 Qed.
 
 Lemma body_fancyfoo_twiddle: semax_body Vprog FancyGprog f_foo_twiddle ffoo_twiddle_spec.
 Proof.
 start_function.
-(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold. Intros m; unfold fancyfoo_data.
+(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold'. Intros m; unfold fancyfoo_data.
 unfold withspacer; simpl.
 Intros.
 forward.  (* d = self->data; *)
@@ -1185,11 +780,11 @@ forward.  (* return d+i; *)
   forget (fold_right Z.add 0 (*(fst hs)*) (fst(fst hs))) as h.
   entailer!!. }
 Exists (2 * fold_right Z.add 0 (*(fst hs)*) (fst(fst hs)) + i).
-(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold, <- fancyfoo_obj_invariant_fold_unfold.
+(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold'.
 Exists m; unfold fancyfoo_data.
 simpl;
 entailer!!.
-rewrite Z.mul_add_distr_l, Z.add_comm.
+rewrite Z.mul_add_distr_l Z.add_comm.
 unfold withspacer; simpl.
 entailer!!.
 Qed.
@@ -1203,7 +798,7 @@ Proof.
   destruct m; try inv X1. clear - L SZ AL.
   repeat split; auto.
   + simpl in *.  unfold sizeof in *; simpl in *; lia.
-  + inv AL. inv H. inv H1. 
+  + inv AL. inv H1.
     eapply align_compatible_rec_Tstruct; [reflexivity.. |].
     simpl co_members in *; intros. specialize (H4 i0 t0).
     simpl in H.
@@ -1212,13 +807,13 @@ Proof.
       inv H4. inv H0. inv H. simpl in H1.
       eapply align_compatible_rec_by_value.
       reflexivity. apply H1. }
-    clear H1. 
+    clear H1.
     if_tac in H.
     { inv H. specialize (H4 _ (eq_refl _) (eq_refl _)).
       inv H4. inv H0. inv H. simpl in H1.
       eapply align_compatible_rec_by_value.
       reflexivity. apply H1. }
-    clear H1. 
+    clear H1.
     if_tac in H.
     { inv H. specialize (H4 _ (eq_refl _) (eq_refl _)).
       inv H4. inv H0. inv H. simpl in H1.
@@ -1231,7 +826,7 @@ Qed.
 Lemma body_fancyfoo_twiddleR: semax_body Vprog FancyGprog f_foo_twiddleR ffoo_twiddleR_spec.
 Proof.
 start_function.
-(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold. Intros m; unfold fancyfoo_data.
+(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold'. Intros m; unfold fancyfoo_data.
 unfold withspacer; simpl.
 Intros.
 forward.  (* d = self->data; *)
@@ -1248,19 +843,17 @@ replace_SEP 5 (field_at sh (Tstruct _methods noattr) [StructField _reset] r m).
   apply FC_fancymethods; trivial. left; auto. }
 
 forward. (*_s_reset = (_mtable -> _reset);*)
-forward_call hs. 
+forward_call hs.
 { (*NEW side condition - again a property of subclasses*)
   rewrite fancyfoo_obj_invariant_fold_unfold'.
   Exists m. unfold fancyfoo_data, withspacer; simpl. entailer!!.
-  eapply derives_trans. 
-  2:{ apply sepcon_derives.
-      apply ( make_fobject_methods_later sh fancyfoo_obj_invariant r t tR g s m); trivial.
-      apply derives_refl. } 
-  cancel. unfold_data_at (data_at sh (Tstruct _fancymethods noattr) _ _ ).
-  cancel. unfold field_at; simpl; entailer!. }
+  rewrite -make_fobject_methods_later; last done.
+  ecancel.
+  unfold_data_at (data_at sh (Tstruct _fancymethods noattr) _ _).
+  cancel. unfold field_at; simpl; entailer!!. }
 (*The spec has folded the object, so need to unfold again*)
 deadvars!. clear - H H0.
-rewrite fancyfoo_obj_invariant_fold_unfold. Intros m. unfold fancyfoo_data, withspacer; Intros; simpl.
+rewrite fancyfoo_obj_invariant_fold_unfold'. Intros m. unfold fancyfoo_data, withspacer; Intros; simpl.
 
 forward.  (* self -> data = d+2*i; *) 
 { set (j:= Int.max_signed / 4) in *; compute in j; subst j.
@@ -1273,11 +866,11 @@ forward.  (* return d+i; *)
   forget (fold_right Z.add 0 (*(fst hs)*)(fst(fst hs))) as h.
   entailer!!. }
 Exists (2 * fold_right Z.add 0 (*(fst hs)*)(fst(fst hs)) + i).
-(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold, <- fancyfoo_obj_invariant_fold_unfold.
+(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold'.
 Exists m; unfold fancyfoo_data.
 simpl;
 entailer!.
-rewrite Z.mul_add_distr_l, Z.add_comm.
+rewrite Z.mul_add_distr_l Z.add_comm.
 unfold withspacer; simpl.
 entailer!!.
 Qed.
@@ -1285,30 +878,30 @@ Qed.
 Lemma body_ffoo_setcolor: semax_body Vprog FancyGprog f_setcolor ffoo_setcolor_spec.
 Proof.
 start_function. 
-(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold. Intros m; unfold fancyfoo_data.
+(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold'. Intros m; unfold fancyfoo_data.
 unfold withspacer; simpl; Intros.
 forward.  (* self->color=0; *)
 entailer!!.
-(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold, <- fancyfoo_obj_invariant_fold_unfold. Exists m; unfold fancyfoo_data.
+(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold'. Exists m; unfold fancyfoo_data.
 all: unfold withspacer; simpl; entailer!!.  (* needed if Archi.ptr64=true *)
 Qed.
 
 Lemma body_ffoo_getcolor: semax_body Vprog FancyGprog f_getcolor ffoo_getcolor_spec.
 Proof.
 start_function. 
-(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold. Intros m; unfold fancyfoo_data.
+(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold'. Intros m; unfold fancyfoo_data.
 unfold withspacer; simpl; Intros.
 forward.  (* _t'1 = ((tptr (Tstruct _fancyfoo_object noattr)) _self -> _color); *)
 forward.
 entailer!!.
-(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold, <- fancyfoo_obj_invariant_fold_unfold. Exists m; unfold fancyfoo_data.
+(*New:*) rewrite fancyfoo_obj_invariant_fold_unfold'. Exists m; unfold fancyfoo_data.
 all: unfold withspacer; simpl; entailer!!.  (* needed if Archi.ptr64=true *)
 Qed.
 
 (*TINY ADAPTATION IN PROOF*)
 Lemma split_fobject_methods:
-  forall instance m, 
-    fobject_methods instance m |-- fobject_methods instance m * fobject_methods instance m.
+  forall instance m,
+    fobject_methods instance m ⊢ fobject_methods instance m ∗ fobject_methods instance m.
 Proof.
 intros.
 unfold fobject_methods.
@@ -1316,18 +909,10 @@ Intros sh reset twiddle twiddleR setC getC.
 
 Exists (fst (slice.cleave sh)) reset twiddle twiddleR setC getC.
 Exists (snd (slice.cleave sh)) reset twiddle twiddleR setC getC.
-rewrite (split_func_ptr' (freset_spec instance) reset) at 1.
-rewrite (split_func_ptr' (ftwiddle_spec instance) twiddle) at 1.
-rewrite (split_func_ptr' (ftwiddleR_spec instance) twiddleR) at 1.
-rewrite (split_func_ptr' (fsetcolor_spec instance) setC) at 1.
-rewrite (split_func_ptr' (fgetcolor_spec instance) getC) at 1.
-entailer!!.
-split.
-apply slice.cleave_readable1; auto.
-apply slice.cleave_readable2; auto.
-rewrite (data_at_share_join (fst (slice.cleave sh)) (snd (slice.cleave sh)) sh).
-auto.
-apply slice.cleave_join.
+iIntros "(#$ & #$ & #$ & #$ & #$ & H)".
+rewrite -(data_at_share_join (fst (slice.cleave sh)) (snd (slice.cleave sh)) sh); last apply slice.cleave_join.
+iDestruct "H" as "($ & $)".
+iPureIntro; repeat split; auto; apply slice.cleave_readable1 || apply slice.cleave_readable2; auto.
 Qed.
 
 Lemma body_make_fancyfoo: semax_body Vprog FancyGprog f_make_fancyfoo make_fancyfoo_spec.
@@ -1350,7 +935,7 @@ if_tac; entailer!!.
 forward_call 1.
 contradiction.
 *
-rewrite if_false by auto.
+rewrite -> if_false by auto.
 Intros.
 forward.  (*  /*skip*/;  *)
 entailer!!.
@@ -1361,39 +946,38 @@ forward. (* p->data = 0; *)
 forward. (* p->color = c;*)
 forward. (* return (struct object * ) p; *)
 Exists p.
-sep_apply (split_fobject_methods fancyfoo_obj_invariant (gv _fancyfoo_methods)).
+match goal with |- _ ⊢ ?C => set (D := C); rewrite split_fobject_methods; subst D end.
 entailer!!.
 unfold fobject_mpred.
 
 (*slight variation of Andrew's proof from here on*)
-Exists fancyfoo_data. entailer!!. 1: solve [apply fancyfoo_data_HOcontr].
-rewrite fObjMpred_fold_unfold by (apply fancyfoo_data_HOcontr).
-Exists (gv _fancyfoo_methods). simpl. normalize.
-rewrite ! sepcon_assoc. apply sepcon_derives. apply now_later.
+Exists fancyfoo_data. entailer!!.
+rewrite fObjMpred_fold_unfold.
+Exists (gv _fancyfoo_methods).
+rewrite -bi.later_intro /fancyfoo_obj_invariant. entailer!.
 unfold fancyfoo_data; simpl. unfold withspacer; simpl.
 cancel.
 unfold_data_at (field_at _ _ nil _ p).
 cancel.
 assert_PROP (isptr p) by entailer!. destruct p; inv H2. entailer!.
-apply sepcon_derives.
+apply bi.sep_mono.
 + clear - H2. unfold field_at; simpl; entailer!!.
   - unfold field_compatible. destruct H2 as [_ [_ [SZ [AL _]]]].
     repeat split; trivial.
     ++ red. red in SZ. simpl sizeof in *. lia.
-    ++ clear SZ. inv AL. inv H.
+    ++ clear SZ. inv AL.
        eapply align_compatible_rec_Tstruct; [reflexivity.. | intros]. specialize (H4 i0).
-       simpl co_members in *; intros. inv H. 
+       simpl co_members in *; intros. inv H.
        if_tac in H5; inv H5.
        inv H0. inv H1. specialize (H4 _ 0 (eq_refl _) (eq_refl _)).
        inv H4. inv H. econstructor. reflexivity. trivial.
     ++ simpl. left; auto.
-  - unfold at_offset. entailer!. unfold data_at_rec. simpl.
-    unfold mapsto; simpl. if_tac; entailer!!.
+  - unfold at_offset. entailer!.
 + clear - H4. unfold field_at; simpl; entailer!!.
   - unfold field_compatible. destruct H4 as [_ [_ [SZ [AL _]]]].
     repeat split; trivial.
     ++ red. red in SZ. simpl sizeof in *. lia.
-    ++ clear SZ; inv AL. inv H.
+    ++ clear SZ; inv AL.
        eapply align_compatible_rec_Tstruct; [reflexivity.. | intros]. specialize (H4 i0).
        simpl co_members in *; intros. inv H. 
        if_tac in H5; inv H5.
@@ -1427,7 +1011,7 @@ if_tac; entailer!!.
 forward_call 1.
 contradiction.
 *
-rewrite if_false by auto.
+rewrite -> if_false by auto.
 Intros.
 forward.  (*  /*skip*/;  *)
 entailer!!.
@@ -1438,41 +1022,38 @@ forward. (* p->data = 0; *)
 forward. (* p->color = c;*)
 forward. (* return (struct object * ) p; *)
 Exists p.
-sep_apply (split_fobject_methods fancyfoo_obj_invariant (gv _fancyfoo_methods)).
+match goal with |- _ ⊢ ?C => set (D := C); rewrite split_fobject_methods; subst D end.
 entailer!!.
 unfold fobject_mpred.
 
 (*slight variation of Andrew's proof from here on*)
-Exists fancyfoo_data. entailer!. 1: solve [apply fancyfoo_data_HOcontr].
-rewrite fObjMpred_fold_unfold by (apply fancyfoo_data_HOcontr).
-Exists (gv _fancyfoo_methods). simpl. normalize.
-rewrite ! sepcon_assoc. apply sepcon_derives. apply now_later.
+Exists fancyfoo_data. entailer!!.
+rewrite fObjMpred_fold_unfold.
+Exists (gv _fancyfoo_methods).
+rewrite -bi.later_intro /fancyfoo_obj_invariant; entailer!.
 unfold fancyfoo_data; simpl. unfold withspacer; simpl.
 cancel.
 unfold_data_at (field_at _ _ nil _ p).
 cancel.
-
-(*TODO: There's at least one variation of Lemma MC_FC in here...*)
 assert_PROP (isptr p) by entailer!. destruct p; inv H2. entailer!.
-apply sepcon_derives.
+apply bi.sep_mono.
 + clear - H2. unfold field_at; simpl; entailer!!.
   - unfold field_compatible. destruct H2 as [_ [_ [SZ [AL _]]]].
     repeat split; trivial.
     ++ red. red in SZ. simpl sizeof in *. lia.
-    ++ clear SZ. inv AL. inv H.
+    ++ clear SZ. inv AL.
        eapply align_compatible_rec_Tstruct; [reflexivity.. | intros]. specialize (H4 i0).
-       simpl co_members in *; intros. inv H. 
+       simpl co_members in *; intros. inv H.
        if_tac in H5; inv H5.
        inv H0. inv H1. specialize (H4 _ 0 (eq_refl _) (eq_refl _)).
        inv H4. inv H. econstructor. reflexivity. trivial.
     ++ simpl. left; auto.
-  - unfold at_offset. entailer!!. unfold data_at_rec. simpl.
-    unfold mapsto; simpl. if_tac; entailer!!.
+  - unfold at_offset. entailer!.
 + clear - H4. unfold field_at; simpl; entailer!!.
   - unfold field_compatible. destruct H4 as [_ [_ [SZ [AL _]]]].
     repeat split; trivial.
     ++ red. red in SZ. simpl sizeof in *. lia.
-    ++ clear SZ; inv AL. inv H.
+    ++ clear SZ; inv AL.
        eapply align_compatible_rec_Tstruct; [reflexivity.. | intros]. specialize (H4 i0).
        simpl co_members in *; intros. inv H. 
        if_tac in H5; inv H5.
@@ -1489,13 +1070,15 @@ End FancyFoo.
 
 Section Putting_It_All_Together.
 
+Notation funspec := (@funspec Σ).
+
 (*Since the code calls reset on q and u before acessing their color, the result value is just 0*)
 Definition main_spec :=
  DECLARE _main
   WITH gv: globals
   PRE  [] main_pre prog tt gv
   POST [ tint ]
-     EX i:Z, PROP(0<=i<=6) LOCAL (temp ret_temp (Vint (Int.repr (i)))) SEP(TT).
+     ∃ i:Z, PROP(0<=i<=6) LOCAL (temp ret_temp (Vint (Int.repr (i)))) SEP(True).
 (*
 Definition reset_intersection: funspec.
 Proof.
@@ -1503,13 +1086,13 @@ eapply (binary_intersection' (reset_spec foo_obj_invariant) (freset_spec fancyfo
 Defined.*)
 Definition twiddle_intersection: funspec.
 Proof.
-eapply (binary_intersection' (twiddle_spec foo_obj_invariant) (ftwiddle_spec fancyfoo_obj_invariant)); reflexivity.
+eapply (binary_intersection'(A1 := ConstType _)(A2 := ConstType _) (twiddle_spec foo_obj_invariant) (ftwiddle_spec fancyfoo_obj_invariant)); reflexivity.
 Defined.
 
 (*New: for twiddleR, take intersection of twiidle_spec and ftwiddleR_spec*)
 Definition twiddleR_intersection: funspec.
 Proof.
-eapply (binary_intersection' (twiddle_spec foo_obj_invariant) (ftwiddleR_spec fancyfoo_obj_invariant)); reflexivity.
+eapply (binary_intersection'(A1 := ConstType _)(A2 := ConstType _) (twiddle_spec foo_obj_invariant) (ftwiddleR_spec fancyfoo_obj_invariant)); reflexivity.
 Defined.
 (*
 Lemma reset_sub_foo: funspec_sub reset_intersection (reset_spec foo_obj_invariant).
@@ -1525,13 +1108,11 @@ Qed.*)
 
 Lemma twiddle_sub_foo: funspec_sub twiddle_intersection (twiddle_spec foo_obj_invariant).
 Proof.
-  rewrite funspec_sub_iff.
 apply (binaryintersection_sub (twiddle_spec foo_obj_invariant) (ftwiddle_spec fancyfoo_obj_invariant)).
 apply binary_intersection'_sound.
 Qed.
 Lemma twiddle_sub_fancy: funspec_sub twiddle_intersection (ftwiddle_spec fancyfoo_obj_invariant).
 Proof.
-  rewrite funspec_sub_iff.
 apply (binaryintersection_sub (twiddle_spec foo_obj_invariant) (ftwiddle_spec fancyfoo_obj_invariant)).
 apply binary_intersection'_sound.
 Qed.
@@ -1539,13 +1120,11 @@ Qed.
 (*2 new lemmas for twiddleR*)
 Lemma twiddleR_sub_foo: funspec_sub twiddleR_intersection (twiddle_spec foo_obj_invariant).
 Proof.
-  rewrite funspec_sub_iff.
 apply (binaryintersection_sub (twiddle_spec foo_obj_invariant) (ftwiddleR_spec fancyfoo_obj_invariant)).
 apply binary_intersection'_sound.
 Qed.
 Lemma twiddleR_sub_fancy: funspec_sub twiddleR_intersection (ftwiddleR_spec fancyfoo_obj_invariant).
 Proof. 
-  rewrite funspec_sub_iff.
 apply (binaryintersection_sub (twiddle_spec foo_obj_invariant) (ftwiddleR_spec fancyfoo_obj_invariant)).
 apply binary_intersection'_sound.
 Qed.
@@ -1577,8 +1156,8 @@ replace_SEP 0 (data_at Ews (Tstruct _methods noattr)
   by  auto with field_compatible. 
   rewrite <- mapsto_field_at with (gfs := [StructField _twiddleR]) (v:= (gv _foo_twiddleR))
   by  auto with field_compatible.
-  rewrite field_at_data_at. rewrite !field_compatible_field_address by auto with field_compatible.
-  rewrite !isptr_offset_val_zero by auto.
+  rewrite field_at_data_at. rewrite -> !field_compatible_field_address by auto with field_compatible.
+  rewrite -> !isptr_offset_val_zero by auto.
   cancel.
 } 
 gather_SEP (mapsto _ _ (offset_val 16 (gv _fancyfoo_methods)) _) 
@@ -1598,8 +1177,8 @@ replace_SEP 0 (data_at Ews (Tstruct _fancymethods noattr)
   by  auto with field_compatible. 
   rewrite <- mapsto_field_at with (gfs := [StructField _getcolor]) (v:= (gv _getcolor))
   by  auto with field_compatible.
-  rewrite field_at_data_at. rewrite !field_compatible_field_address by auto with field_compatible.
-  rewrite !isptr_offset_val_zero by auto.
+  rewrite field_at_data_at. rewrite -> !field_compatible_field_address by auto with field_compatible.
+  rewrite -> !isptr_offset_val_zero by auto.
   cancel.
 }
 
@@ -1607,26 +1186,26 @@ replace_SEP 0 (data_at Ews (Tstruct _fancymethods noattr)
         fancymethods is a proper method table for fancyfoo-objects *)
 
 make_func_ptr _foo_reset. (*
-replace_SEP 0 (func_ptr' (reset_spec foo_obj_invariant) (gv _foo_reset)(* *
-               func_ptr' (freset_spec fancyfoo_obj_invariant) (gv _foo_reset)*)).
-{ entailer!. (*rewrite split_func_ptr'. apply sepcon_derives; *)apply func_ptr'_mono.
+replace_SEP 0 (func_ptr (reset_spec foo_obj_invariant) (gv _foo_reset)(* *
+               func_ptr (freset_spec fancyfoo_obj_invariant) (gv _foo_reset)*)).
+{ entailer!. (*rewrite split_func_ptr. apply sepcon_derives; *)apply func_ptr_mono.
   apply reset_sub_foo. (* apply reset_sub_fancy.*) }*)
 make_func_ptr _foo_twiddle.
-replace_SEP 0 (func_ptr' (twiddle_spec foo_obj_invariant) (gv _foo_twiddle) *
-               func_ptr' (ftwiddle_spec fancyfoo_obj_invariant) (gv _foo_twiddle)).
-{ entailer!. rewrite split_func_ptr'. apply sepcon_derives; apply func_ptr'_mono.
+replace_SEP 0 (func_ptr (twiddle_spec foo_obj_invariant) (gv _foo_twiddle) ∗
+               func_ptr (ftwiddle_spec fancyfoo_obj_invariant) (gv _foo_twiddle)).
+{ entailer!. iIntros "#?"; iSplit; iApply (func_ptr_mono with "[$]").
   apply twiddle_sub_foo. apply twiddle_sub_fancy. }
 make_func_ptr _foo_twiddleR.
-replace_SEP 0 (func_ptr' (twiddle_spec foo_obj_invariant) (gv _foo_twiddleR) *
-               func_ptr' (ftwiddleR_spec fancyfoo_obj_invariant) (gv _foo_twiddleR)).
-{ entailer!. rewrite split_func_ptr'. apply sepcon_derives; apply func_ptr'_mono.
+replace_SEP 0 (func_ptr (twiddle_spec foo_obj_invariant) (gv _foo_twiddleR) ∗
+               func_ptr (ftwiddleR_spec fancyfoo_obj_invariant) (gv _foo_twiddleR)).
+{ entailer!. iIntros "#?"; iSplit; iApply (func_ptr_mono with "[$]").
   apply twiddleR_sub_foo. apply twiddleR_sub_fancy. }
 sep_apply (make_object_methods Ews foo_obj_invariant (gv _foo_reset) (gv _foo_twiddle) (gv _foo_twiddleR) (gv _foo_methods)); auto.
 
 make_func_ptr _fancy_reset.
 make_func_ptr _setcolor.
 make_func_ptr _getcolor.
-sep_apply (make_fobject_methods Ews fancyfoo_obj_invariant (gv _fancy_reset) (gv _foo_twiddle) (gv _foo_twiddleR) (gv _setcolor) (gv _getcolor)(gv _fancyfoo_methods)); auto.
+sep_apply (make_fobject_methods Ews fancyfoo_obj_invariant (gv _fancy_reset) (gv _foo_twiddle) (gv _foo_twiddleR) (gv _setcolor) (gv _getcolor) (gv _fancyfoo_methods)); auto.
 
 (* 2. Build an instance of class [foo], called [p] *)
 forward_call (* p = make_foo(); *)
@@ -1637,7 +1216,7 @@ Intros p.
 forward_call (* q = make_fancyfoo(); *)
         (gv,4).
 Intros q.
-(*New*) freeze [0;2; 4;5 ] FR1. (*Hide the global method tables, memmgr, and the has_ext *)
+(*New*) freeze [0; 2; 4; 5] FR1. (*Hide the global method tables, memmgr, and the has_ext *)
 
 assert_PROP (p<>Vundef) as pNotVundef by entailer!.
 (* Illustration of an alternate method to prove the method calls.
@@ -1658,7 +1237,7 @@ assert_PROP (p<>Vundef) as pNotVundef by entailer!.
 unfold object_mpred.
 
 (*WAS:Intros instance mtable0.*)
-(*Now*) Intros instance. rename H into HOC. rewrite ObjMpred_fold_unfold by trivial. Intros mtable0; simpl.
+(*Now*) Intros instance. rewrite ObjMpred_fold_unfold. Intros mtable0; simpl.
 
 forward. (*  mtable = p->mtable; *)
 unfold object_methods at 1.
@@ -1668,8 +1247,8 @@ forward_call (* p_reset(p); *)
       (@nil Z,p).
 { (*NEW subgoal*)
    sep_apply make_object_methods_later.
-   rewrite ObjMpred_fold_unfold, <- ObjMpred_fold_unfold by trivial.
-   Exists mtable0. entailer!!. } 
+   rewrite ObjMpred_fold_unfold.
+   Exists mtable0. entailer!!. }
 (* WAS (*Finish the method-call by regathering the object p back together *)
 sep_apply (make_object_methods sh instance r0 t0 mtable0); auto.
 sep_apply (object_mpred_i [] p instance mtable0).*)
@@ -1684,7 +1263,7 @@ deadvars!. clear.
 unfold fobject_mpred.
 
 (*WAS:Intros instance mtable0.*)
-(*Now*) Intros instance. rename H into HOC. rewrite fObjMpred_fold_unfold by trivial. Intros mtable0; simpl.
+(*Now*) Intros instance. rewrite fObjMpred_fold_unfold. Intros mtable0; simpl.
 
 forward. (*_t'9 = (_q -> _mtable);*)
 forward. (*_mtable = (tptr (Tstruct _fancymethods noattr)) _t'9;*)
@@ -1696,8 +1275,8 @@ forward_call (* q_reset(q); *)
       ((@nil Z,4),q).
 { (*NEW subgoal*)
    sep_apply make_fobject_methods_later.
-   rewrite fObjMpred_fold_unfold, <- fObjMpred_fold_unfold by trivial.
-   Exists mtable0. entailer!. } 
+   rewrite fObjMpred_fold_unfold.
+   Exists mtable0. entailer!. }
 (* WAS (*Finish the method-call by regathering the object p back together *)
 sep_apply (make_object_methods sh instance r0 t0 mtable0); auto.
 sep_apply (object_mpred_i [] p instance mtable0).*)
@@ -1713,7 +1292,7 @@ deadvars!. clear.
 unfold fobject_mpred.
 
 (*WAS:Intros instance mtable0.*)
-(*Now*) Intros instance. rename H into HOC. rewrite fObjMpred_fold_unfold by trivial. Intros mtable0; simpl.
+(*Now*) Intros instance. rewrite fObjMpred_fold_unfold. Intros mtable0; simpl.
 
 forward. (*_t'8 = (_q -> _mtable);*)
 forward. (*_mtable = (tptr (Tstruct _fancymethods noattr)) _t'8;*)
@@ -1725,8 +1304,8 @@ forward_call (* q_reset(q); *)
       ((@nil Z,(*4*)0),q).
 { (*NEW subgoal*)
    sep_apply make_fobject_methods_later.
-   rewrite fObjMpred_fold_unfold, <- fObjMpred_fold_unfold by trivial.
-   Exists mtable0. entailer!!. } 
+   rewrite fObjMpred_fold_unfold.
+   Exists mtable0. entailer!!. }
 (* WAS (*Finish the method-call by regathering the object p back together *)
 sep_apply (make_object_methods sh instance r0 t0 mtable0); auto.
 sep_apply (object_mpred_i [] p instance mtable0).*)
@@ -1741,7 +1320,7 @@ deadvars!. clear.
 unfold object_mpred.
 
 (*WAS:Intros instance mtable0.*)
-(*Now*) Intros instance. rename H into HOC. rewrite ObjMpred_fold_unfold by trivial. Intros mtable0; simpl.
+(*Now*) Intros instance. rewrite ObjMpred_fold_unfold. Intros mtable0; simpl.
 
 forward.  (* pmtable = p->mtable; *)
 unfold object_methods at 1.
@@ -1752,9 +1331,9 @@ forward_call (* i = p_twiddle(p,3); *)
       ((@nil Z,p), 3).
 { (*NEW subgoal*)
    sep_apply make_object_methods_later.
-   rewrite ObjMpred_fold_unfold, <- ObjMpred_fold_unfold by trivial.
+   rewrite ObjMpred_fold_unfold.
    Exists mtable0. entailer!!. }
-{ simpl. repeat split; try trivial; computable. }
+{ simpl; computable. }
 Intros i.
 simpl in H0. (*
 sep_apply (make_object_methods sh instance r0 t0 mtable0); auto.
@@ -1774,7 +1353,7 @@ freeze [2;3] PQ. (*Hide the other objects p and q*)
 unfold fobject_mpred.
 
 (*WAS:Intros instance mtable0.*)
-(*Now*) Intros instance. rename H into HOC. rewrite fObjMpred_fold_unfold by trivial. Intros mtable0; simpl.
+(*Now*) Intros instance. rewrite fObjMpred_fold_unfold. Intros mtable0; simpl.
 
 forward. (*_t'7 = ((tptr (Tstruct _object noattr)) _u -> _mtable);*)
 forward. (* _umtable = (tptr (Tstruct _fancymethods noattr)) _t'7;*)
@@ -1786,8 +1365,8 @@ forward_call (* u_reset(u); *)
       ((@nil Z,9),u).
 { (*NEW subgoal*)
    sep_apply make_fobject_methods_later.
-   rewrite fObjMpred_fold_unfold, <- fObjMpred_fold_unfold by trivial.
-   Exists mtable0. entailer!!. } 
+   rewrite fObjMpred_fold_unfold.
+   Exists mtable0. entailer!!. }
 (* WAS (*Finish the method-call by regathering the object p back together *)
 sep_apply (make_object_methods sh instance r0 t0 mtable0); auto.
 sep_apply (object_mpred_i [] p instance mtable0).*)
@@ -1804,7 +1383,7 @@ deadvars!. clear -Hi.
 unfold fobject_mpred.
 
 (*WAS:Intros instance mtable0.*)
-(*Now*) Intros instance. rename H into HOC. rewrite fObjMpred_fold_unfold by trivial. Intros mtable0; simpl.
+(*Now*) Intros instance. rewrite fObjMpred_fold_unfold. Intros mtable0; simpl.
 
 forward. (*_t'7 = ((tptr (Tstruct _object noattr)) _u -> _mtable);*)
 forward. (* _umtable = (tptr (Tstruct _fancymethods noattr)) _t'7;*)
@@ -1816,8 +1395,8 @@ forward_call (* u_getcolor(u); *)
       ((@nil Z,(*9*)0),u).
 { (*NEW subgoal*)
    sep_apply make_fobject_methods_later.
-   rewrite fObjMpred_fold_unfold, <- fObjMpred_fold_unfold by trivial.
-   Exists mtable0. entailer!. } 
+   rewrite fObjMpred_fold_unfold.
+   Exists mtable0. entailer!. }
 (* WAS (*Finish the method-call by regathering the object p back together *)
 sep_apply (make_object_methods sh instance r0 t0 mtable0); auto.
 sep_apply (object_mpred_i [] p instance mtable0).*)
@@ -1850,17 +1429,19 @@ Proof. do_funspec_sub. simpl in H. inv H. inv H6.
   rewrite later_exp'; normalize. rename x into gC.
   Exists ((
      field_at Ews (Tstruct _fancyfoo_object noattr) [StructField _color] (Vint (Int.repr c)) q *
-     (|> (func_ptr' (fsetcolor_spec fancyfoo_obj_invariant) sC *
-          func_ptr' (fgetcolor_spec fancyfoo_obj_invariant) gC))) * 
+     (|> (func_ptr (fsetcolor_spec fancyfoo_obj_invariant) sC *
+          func_ptr (fgetcolor_spec fancyfoo_obj_invariant) gC))) * 
      ((malloc_token Ews (Tstruct _foo_object noattr) q) -* malloc_token Ews (Tstruct _fancyfoo_object noattr) q)).
   rewrite later_andp. rewrite ! later_sepcon. Intros.
   entailer. apply andp_right.
   + entailer!. intros. rewrite fancyfoo_obj_invariant_fold_unfold'; simpl.
     Exists m. entailer!.
     sep_apply wand_frame_elim''. cancel.
-(*    eapply derives_trans. apply sepcon_derives. apply now_later. apply derives_refl.*)
+(*    eapply derives_trans. apply sepcon_derives. apply bi.later_intro. apply derives_refl.*)
     rewrite  <- ! later_sepcon. 
     apply later_derives. Exists sh r t tR sC gC. entailer!. admit. (*readable_share*)
     unfold object_methods. admit.
   + entailer!. cancel. normalize.
 Abort.*)
+
+End mpred.
diff --git a/progs/verif_odd.v b/progs/verif_odd.v
index a4d5bfe1f4..b6e45f43bf 100644
--- a/progs/verif_odd.v
+++ b/progs/verif_odd.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.odd.
 Require Import VST.progs.verif_evenodd_spec.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
@@ -24,7 +25,7 @@ Qed.
 
 (* The Espec for odd is different from the Espec for even;
   the former has only "even" as an external function, and vice versa. *)
-Definition Espec := add_funspecs NullExtension.Espec (ext_link_prog odd.prog) Gprog.
+Definition Espec := add_funspecs_rec unit (ext_link_prog odd.prog) (void_spec _) Gprog.
 #[export] Existing Instance Espec.
 
 (* Can't prove   prog_correct: semax_prog prog Vprog Gprog
diff --git a/progs/verif_peel.v b/progs/verif_peel.v
index 50d9677586..cd50f3795a 100644
--- a/progs/verif_peel.v
+++ b/progs/verif_peel.v
@@ -18,11 +18,12 @@ Notice that the variable [a] is uninitialized until the middle of the first iter
 *)
 
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.peel.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs.  mk_varspecs prog. Defined.
 
-Definition f_spec : ident * funspec :=
+Definition f_spec :=
  DECLARE _f
   WITH b: Z
   PRE [ tint ]
@@ -152,6 +153,5 @@ eapply semax_while_peel.
 abbreviate_semax.
 Intros a.
 forward.
-Exists a.
-entailer!!.
+Exists a; entailer!!.
 Qed.
diff --git a/progs/verif_printf.v b/progs/verif_printf.v
index cf6dc667f8..67b91aca2b 100644
--- a/progs/verif_printf.v
+++ b/progs/verif_printf.v
@@ -9,11 +9,14 @@ Require Import ITree.Eq.
 #[export] Instance nat_id : FileId := { file_id := nat; stdin := 0%nat; stdout := 1%nat }.
 #[export] Instance file_struct : FileStruct := {| FILEid := ___sFILE64; reent := __reent; f_stdin := __stdin; f_stdout := __stdout |}.
 
+Section printf.
+
+Context `{!VSTGS (@IO_itree (@IO_event file_id)) Σ}.
+
 Definition main_spec :=
  DECLARE _main
   WITH gv : globals
-  PRE  [] main_pre prog (write_list stdout
-       (string2bytes "Hello, world!
+  PRE  [] main_pre prog (write_list stdout (string2bytes "Hello, world!
 ");; write_list stdout (string2bytes "This is line 2.
 "))%itree gv
   POST [ tint ] main_post prog gv.
@@ -24,19 +27,21 @@ Definition Gprog : funspecs :=
 Lemma body_main: semax_body Vprog Gprog f_main main_spec.
 Proof.
 start_function.
-make_stdio.
+make_stdio (@IO_event file_id).
 repeat do_string2bytes.
-repeat (sep_apply data_at_to_cstring; []).
-sep_apply (has_ext_ITREE(E := @IO_event file_id)).
+do 3 (sep_apply data_at_to_cstring; []).
+sep_apply (has_ext_ITREE).
 
 forward_printf tt (write_list stdout (string2bytes "This is line 2.
 ")).
-{ rewrite !sepcon_assoc; apply sepcon_derives; cancel.
-  apply derives_refl. }
+{ apply bi.sep_mono; first done.
+  cancel. }
 forward_call.
 forward.
 forward_fprintf outp ((Ers, string2bytes "line", gv ___stringlit_2), (Int.repr 2, tt)) (stdout, Ret tt : @IO_itree (@IO_event file_id)).
-{ rewrite 3sepcon_assoc, sepcon_comm, sepcon_assoc; apply sepcon_derives; cancel.
+{ rewrite !bi.sep_assoc (bi.sep_comm _ (ITREE _)) -!bi.sep_assoc; apply bi.sep_mono; [|cancel].
   rewrite bind_ret'; apply derives_refl. }
 forward.
 Qed.
+
+End printf.
diff --git a/progs/verif_ptr_compare.v b/progs/verif_ptr_compare.v
index 5b47ebd91d..2412e7f0f5 100644
--- a/progs/verif_ptr_compare.v
+++ b/progs/verif_ptr_compare.v
@@ -1,11 +1,10 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.ptr_compare.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
-Local Open Scope logic.
-
 Definition f_spec :=
  DECLARE _f
   WITH p: val, q:val, sh: share
diff --git a/progs/verif_queue.v b/progs/verif_queue.v
index 4a16da73a0..8e5870bae6 100644
--- a/progs/verif_queue.v
+++ b/progs/verif_queue.v
@@ -1,10 +1,9 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.library.
 Require Import VST.progs.list_dt. Import Links.
 Require Import VST.progs.queue.
 
-Open Scope logic.
-
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
@@ -16,7 +15,7 @@ Definition t_struct_fifo := Tstruct _fifo noattr.
 Proof. eapply mk_listspec; reflexivity. Defined.
 
 Lemma isnil: forall {T: Type} (s: list T), {s=nil}+{s<>nil}.
-Proof. intros. destruct s; [left|right]; auto. intro Hx; inv Hx. Qed.
+Proof. intros. destruct s; [left|right]; auto. Qed.
 
 Definition Qsh : share := fst (Share.split extern_retainer).
 Definition Qsh' := Share.lub (snd (Share.split extern_retainer)) Share.Rsh.
@@ -48,7 +47,6 @@ unfold Share.Lsh in *.
 destruct (Share.split Share.top) eqn:?H.
 simpl in *; subst.
 apply Share.split_nontrivial in H; auto.
-apply Share.nontrivial; auto.
 *
 apply leq_join_sub.
 apply Share.lub_upper2.
@@ -174,16 +172,16 @@ Lemma field_at_list_cell_weak:
   field_at sh list_struct [StructField _a] i p *
   field_at sh list_struct [StructField _b] j p *
   field_at_ sh list_struct [StructField _next] p
-  = list_cell QS sh (i,j) p *
+  ⊣⊢ list_cell QS sh (i,j) p *
   field_at_ sh list_struct [StructField _next] p.
 Proof.
 intros.
 (* new version of proof, for constructive definition of list_cell *)
-f_equal.
+f_equiv.
 unfold field_at, list_cell.
 autorewrite with gather_prop.
-f_equal.
-apply ND_prop_ext.
+f_equiv; last done.
+f_equiv.
 rewrite field_compatible_cons; simpl.
 rewrite field_compatible_cons; simpl.
 intuition.
@@ -193,7 +191,7 @@ Qed.
 
 Lemma make_unmake:
  forall a b p,
- data_at Ews t_struct_elem (Vint a, (Vint b, Vundef)) p =
+ data_at Ews t_struct_elem (Vint a, (Vint b, Vundef)) p ⊣⊢
  field_at Qsh' t_struct_elem [StructField _a] (Vint a) p *
  field_at Qsh' t_struct_elem [StructField _b] (Vint b) p *
  list_cell QS Qsh (Vundef, Vundef) p *
@@ -201,34 +199,23 @@ Lemma make_unmake:
 Proof.
 intros.
 unfold_data_at (data_at _ _ _ _).
-rewrite <- !sepcon_assoc.
-match goal with |- ?A = _ => set (J := A) end.
+match goal with |- ?A ⊣⊢ _ => set (J := A) end.
 unfold field_at_.
 change (default_val (nested_field_type t_struct_elem [StructField _next])) with Vundef.
 rewrite <- (field_at_share_join _ _ _ _ _ _ _ Qsh_Qsh').
-rewrite <- !sepcon_assoc.
+pull_left (field_at Qsh' t_struct_elem [StructField _next] Vundef p).
+rewrite sep_assoc.
 pull_left (field_at Qsh' t_struct_elem [StructField _next] Vundef p).
 pull_left (field_at Qsh' t_struct_elem [StructField _b] (Vint b) p).
 pull_left (field_at Qsh' t_struct_elem [StructField _a] (Vint a) p).
-rewrite field_at_list_cell_weak  by apply readable_share_Qsh'.
-match goal with |- _ = _ * _ * _ * ?A => change A
-  with (field_at_ Qsh t_struct_elem [StructField _next] p)
-end.
+rewrite field_at_list_cell_weak by apply readable_share_Qsh'.
 pull_left (list_cell QS Qsh (Vundef, Vundef) p).
 rewrite join_cell_link with (psh:=Ews) by (auto; try apply Qsh_Qsh'; apply readable_share_Qsh').
-subst J.
-match goal with |- _ * _ * ?A = _ => change A
-  with (field_at_ Ews t_struct_elem [StructField _next] p)
-end.
-rewrite field_at_list_cell_weak by auto.
-rewrite sepcon_assoc.
-f_equal.
-unfold field_at_.
-change (default_val (nested_field_type t_struct_elem [StructField _next])) with Vundef.
-rewrite sepcon_comm.
-symmetry.
-apply (field_at_share_join _ _ _ t_struct_elem [StructField _next]
-   _ p Qsh_Qsh').
+rewrite <- sep_assoc.
+change (field_at _ _ _ _ _) with (field_at_ Qsh t_struct_elem (DOT _next) p).
+rewrite field_at__share_join by (apply sepalg.join_comm, Qsh_Qsh').
+rewrite <- field_at_list_cell_weak by auto.
+rewrite <- sep_assoc; reflexivity.
 Qed.
 
 Definition surely_malloc_spec :=
@@ -257,7 +244,7 @@ Definition fifo_body (contents: list val) (hd tl: val) :=
               !!(contents = prefix++tl::nil)
             &&  (lseg QS Qsh Ews prefix hd tl
                    * list_cell QS Qsh (Vundef,Vundef) tl
-                   * field_at Ews t_struct_elem [StructField _next] nullval tl)))%logic.
+                   * field_at Ews t_struct_elem [StructField _next] nullval tl))).
 
 Definition fifo (contents: list val) (p: val) : mpred :=
   (EX ht: (val*val), let (hd,tl) := ht in
@@ -314,7 +301,7 @@ Definition make_elem_spec :=
         PARAMS (Vint a; Vint b) GLOBALS (gv) 
         SEP(mem_mgr gv)
   POST [ (tptr t_struct_elem) ]
-      @exp (environ->mpred) _ _ (fun p:val =>  (* EX notation doesn't work for some reason *)
+      ∃ p:val,
        PROP()
        RETURN (p)
        SEP (mem_mgr gv;
@@ -322,7 +309,7 @@ Definition make_elem_spec :=
               field_at Qsh' list_struct [StructField _b] (Vint b) p;
               list_cell QS Qsh (Vundef, Vundef) p;
               field_at_ Ews t_struct_elem [StructField _next] p;
-              malloc_token Ews t_struct_elem p)).
+              malloc_token Ews t_struct_elem p).
 
 Definition main_spec :=
  DECLARE _main
@@ -359,7 +346,8 @@ Proof.
     + forward. subst p. congruence.
     + Intros. forward. entailer!.
 *
-  forward. Exists p; entailer!.
+  forward.
+  Exists p; entailer!!.
 Qed.
 
 Lemma fifo_isptr: forall al q, fifo al q |-- !! isptr q.
@@ -427,8 +415,7 @@ Intros.
 forward. (* p->next = NULL; *)
 forward. (*   h = Q->head; *)
 
-forward_if
-  (PROP() LOCAL () SEP (fifo (contents ++ p :: nil) q))%assert.
+forward_if.
 * unfold fifo_body.
    if_tac. entailer!. Intros prefix. entailer!.
 * (* then clause *)
@@ -467,15 +454,9 @@ forward_if
      rewrite if_false by (clear; destruct prefix; simpl; congruence).
      Exists  (prefix ++ tl :: nil).
      entailer. (* do this to avoid canceling *)
-     match goal with
-     | |- _ |-- _ * _ * ?AA => remember AA as A
-     end.     (* prevent it from canceling! *)
-     simpl sizeof.
-     cancel. subst A.
-     eapply derives_trans; [ |
-       apply (lseg_cons_right_neq _ _ _ _ _ ((Vundef,Vundef) : elemtype QS));
-        auto ].
-     cancel.
+     iIntros "($ & $ & ? & ? & ? & $ & ?)".
+     iApply (lseg_cons_right_neq with "[-]"); [auto..|].
+     iFrame.
 Qed.
 
 Lemma body_fifo_get: semax_body Vprog Gprog f_fifo_get fifo_get_spec.
@@ -524,7 +505,7 @@ forward_call (*  p = surely_malloc(sizeof ( *p));  *)
   Exists p.
   entailer!.
   rewrite make_unmake.
-  apply derives_refl.
+  cancel.
 Qed.
 
 #[export] Hint Resolve readable_share_Qsh' : core.
@@ -557,19 +538,17 @@ forward_call (*  free(p, sizeof( *p)); *)
    (t_struct_elem, p', gv).
 {
  assert_PROP (isptr p'); [entailer! | rewrite if_false by (intro; subst; contradiction) ].
- sep_apply (eq_sym (make_unmake (Int.repr 1) (Int.repr 10) p')).
+ sep_apply (bi.equiv_entails_1_2 _ _ (make_unmake (Int.repr 1) (Int.repr 10) p')).
  cancel.
 }
 forward. (* return i+j; *)
 Qed.
 
-#[export] Existing Instance NullExtension.Espec.
-
 Lemma prog_correct:
   semax_prog prog tt Vprog Gprog.
 Proof.
-prove_semax_prog. 
-semax_func_cons body_malloc. apply semax_func_cons_malloc_aux.
+prove_semax_prog.
+semax_func_cons body_malloc. destruct x; apply semax_func_cons_malloc_aux.
 semax_func_cons body_free.
 semax_func_cons body_exit.
 semax_func_cons body_surely_malloc.
@@ -580,5 +559,3 @@ semax_func_cons body_fifo_get.
 semax_func_cons body_make_elem.
 semax_func_cons body_main.
 Qed.
-
-
diff --git a/progs/verif_queue2.v b/progs/verif_queue2.v
index 3535ff8103..d04349f8bc 100644
--- a/progs/verif_queue2.v
+++ b/progs/verif_queue2.v
@@ -1,10 +1,9 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.library.
 Require Import VST.progs.list_dt.  Import LsegSpecial.
 Require Import VST.progs.queue2.
 
-Open Scope logic.
-
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
@@ -15,21 +14,21 @@ Definition t_struct_fifo := Tstruct _fifo noattr.
 Proof. eapply mk_listspec; reflexivity. Defined.
 
 Lemma isnil: forall {T: Type} (s: list T), {s=nil}+{s<>nil}.
-Proof. intros. destruct s; [left|right]; auto. intro Hx; inv Hx. Qed.
+Proof. intros. destruct s; [left|right]; auto. Qed.
 
 Lemma field_at_list_cell:
   forall sh i v p,
   data_at sh t_struct_elem (i,v) p
-  = list_cell QS sh i p *
+  ⊣⊢ list_cell QS sh i p *
   field_at sh t_struct_elem [StructField _next] v p.
 Proof.
 intros.
 unfold_data_at (data_at _ _ _ _).
-f_equal.
+f_equiv.
 unfold field_at, list_cell.
 autorewrite with gather_prop.
-f_equal.
-apply ND_prop_ext.
+f_equiv; last done.
+f_equiv.
 rewrite field_compatible_cons; simpl.
 intuition.
 left; auto.
@@ -56,7 +55,7 @@ Definition fifo_body (contents: list val) (hd tl : val) :=
               !!(contents = prefix++last::nil)
             &&  (lseg QS Ews prefix hd tl
                    * malloc_token Ews t_struct_elem tl
-                   * data_at Ews t_struct_elem (last, nullval) tl)))%logic.
+                   * data_at Ews t_struct_elem (last, nullval) tl))).
 
 Definition fifo (contents: list val) (p: val) : mpred :=
   EX ht: (val*val), let (hd,tl) := ht in
@@ -154,7 +153,8 @@ Proof.
     + forward. subst p. congruence.
     + Intros. forward. entailer!.
 *
-  forward. Exists p; entailer!.
+  forward.
+  Exists p; entailer!!.
 Qed.
 
 Lemma fifo_isptr: forall al q, fifo al q |-- !! isptr q.
@@ -200,7 +200,6 @@ Qed.
 Lemma body_fifo_new: semax_body Vprog Gprog f_fifo_new fifo_new_spec.
 Proof.
   start_function.
-
   forward_call (* Q = surely_malloc(sizeof ( *Q)); *)
      (t_struct_fifo, gv).
   Intros q.
@@ -223,8 +222,7 @@ Intros ht; destruct ht as [hd tl].
 Intros.
 forward. (* p->next = NULL; *)
 forward. (*   h = Q->head; *)
-forward_if
-  (PROP() LOCAL () SEP (fifo (contents ++ last :: nil) q))%assert.
+forward_if.
 * unfold fifo_body; if_tac. entailer!. Intros prefix last0; entailer!.
 * (* then clause *)
   subst.
@@ -258,16 +256,12 @@ forward_if
      Exists  (prefix ++ last0 :: nil) last.
      entailer.   (* not entailer!, which would cancel *)
      rewrite (field_at_list_cell Ews last0 p).
-     unfold_data_at (@data_at CompSpecs Ews t_struct_elem (last,nullval) p).
+     unfold_data_at (data_at(cs := CompSpecs) Ews t_struct_elem (last,nullval) p).
      unfold_data_at (data_at _ _ _ p).
      simpl sizeof.
-     match goal with
-     | |- _ |-- _ * _ * (_ * ?AA) => remember AA as A
-     end.     (* prevent it from canceling! *)
-     cancel. subst A.
-     eapply derives_trans;
-        [ | apply (lseg_cons_right_neq QS Ews prefix hd last0 tl nullval p ); auto].
-     simpl sizeof.  cancel.
+     iIntros "($ & $ & ? & ? & ? & $ & $ & ?)".
+     iApply (lseg_cons_right_neq with "[-]"); [auto..|].
+     auto with iFrame.
 Qed.
 
 Lemma body_fifo_get: semax_body Vprog Gprog f_fifo_get fifo_get_spec.
@@ -313,8 +307,7 @@ Intros p.
 forward.  (*  p->data=i; *)
 simpl.
 forward. (* return p; *)
-Exists p.
-entailer!.
+Exists p; entailer!!.
 Qed.
 
 Lemma body_main:  semax_body Vprog Gprog f_main main_spec.
@@ -347,13 +340,11 @@ assert_PROP (isptr p3); [entailer! | rewrite if_false by (intro; subst; contradi
 forward. (* return i; *)
 Qed.
 
-#[export] Existing Instance NullExtension.Espec.
-
 Lemma prog_correct:
   semax_prog prog tt Vprog Gprog.
 Proof.
   prove_semax_prog.
-  semax_func_cons body_malloc. apply semax_func_cons_malloc_aux.
+  semax_func_cons body_malloc. destruct x; apply semax_func_cons_malloc_aux.
   semax_func_cons body_free.
   semax_func_cons body_exit.
   semax_func_cons body_surely_malloc.
@@ -364,4 +355,3 @@ Proof.
   semax_func_cons body_make_elem.
   semax_func_cons body_main.
 Qed.
-
diff --git a/progs/verif_revarray.v b/progs/verif_revarray.v
index 14c19734fa..da5159db36 100644
--- a/progs/verif_revarray.v
+++ b/progs/verif_revarray.v
@@ -1,10 +1,15 @@
+(* Do not edit this file, it was generated automatically *)
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat.
 Require Import VST.progs.revarray.
 Require Import VST.zlist.sublist.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
+Section GFUNCTORS.
+Context `{VSTGS_OK: !VSTGS OK_ty Σ}.
+
 Definition reverse_spec :=
  DECLARE _reverse
   WITH a0: val, sh : share, contents : list int, size: Z
@@ -16,20 +21,26 @@ Definition reverse_spec :=
      PROP() RETURN()
      SEP(data_at sh (tarray tint size) (map Vint (rev contents)) a0).
 
+Definition Gprog_internal : funspecs :=   [reverse_spec].
+
+End GFUNCTORS.
+
+Section LimitImport. Import NoOracle.
 Definition main_spec :=
   DECLARE _main
   WITH gv : globals
   PRE  [] main_pre prog tt gv
   POST [ tint ] main_post prog gv.
+End LimitImport.
 
-Definition Gprog : funspecs :=   ltac:(with_library prog [reverse_spec; main_spec]).
 
 Definition flip_ends {A} lo hi (contents: list A) :=
   sublist 0 lo (rev contents)
   ++ sublist lo hi contents
   ++ sublist hi (Zlength contents) (rev contents).
 
-Definition reverse_Inv a0 sh contents size :=
+Definition reverse_Inv `{VSGTS_OK: !VSTGS OK_ty Σ}
+   a0 sh contents size :=
  (EX j:Z,
   (PROP  (0 <= j; j <= size-j)
    LOCAL  (temp _a a0; temp _lo (Vint (Int.repr j)); temp _hi (Vint (Int.repr (size-j))))
@@ -110,7 +121,8 @@ pose proof (Zlength_rev _ al).
 list_solve.
 Qed.
 
-Lemma body_reverse: semax_body Vprog Gprog f_reverse reverse_spec.
+Lemma body_reverse `{!VSTGS OK_ty Σ}: 
+ semax_body Vprog Gprog_internal f_reverse reverse_spec.
 Proof.
 start_function.
 forward.  (* lo = 0; *)
@@ -154,8 +166,7 @@ forward. (* hi--; *)
  entailer!.
  f_equal; f_equal; lia.
  simpl.
- apply derives_refl'.
- unfold data_at.    f_equal.
+ f_equiv.
  clear - H0 HRE H1.
  unfold Z.succ.
  rewrite <- flip_fact_3 by auto with typeclass_instances.
@@ -166,16 +177,18 @@ forward. (* hi--; *)
 forward. (* return; *)
 entailer!!.
 rewrite map_rev. rewrite flip_fact_1; try lia; auto.
-cancel.
 Qed.
 
 Definition four_contents := [Int.repr 1; Int.repr 2; Int.repr 3; Int.repr 4].
 
+Section LimitImport. Import NoOracle.
+
+Definition Gprog : funspecs := 
+   main_spec :: Gprog_internal.
+
 Lemma body_main:  semax_body Vprog Gprog f_main main_spec.
 Proof. finish. Qed.
 
-#[export] Existing Instance NullExtension.Espec.
-
 Lemma prog_correct:
   semax_prog prog tt Vprog Gprog.
 Proof.
@@ -183,6 +196,7 @@ prove_semax_prog.
 semax_func_cons body_reverse.
 semax_func_cons body_main.
 Qed.
+End LimitImport.
 
 Module Alternate.
 
@@ -207,7 +221,11 @@ Ltac calc_Zlength_extra l ::=
 #[export] Hint Rewrite @Znth_rev using Zlength_solve : Znth.
 #[export] Hint Unfold flip_ends : list_solve_unfold.
 
-Lemma body_reverse: semax_body Vprog Gprog f_reverse reverse_spec.
+
+Section GFUNCTORS.
+Context `{VSTGS_OK: !VSTGS OK_ty Σ}.
+
+Lemma body_reverse: semax_body Vprog Gprog_internal f_reverse reverse_spec.
 Proof.
 start_function.
 fastforward.
@@ -216,7 +234,7 @@ assert_PROP (Zlength (map Vint contents) = size)
     as ZL by entailer!.
 forward_while (reverse_Inv a0 sh (map Vint contents) size).
 * (* Prove that current precondition implies loop invariant *)
-simpl (data_at _ _ _).
+unfold reverse_Inv.
 Time finish.
 * (* Prove that loop invariant implies typechecking condition *)
 Time finish.
@@ -230,10 +248,13 @@ Time finish.
 (* Finished transaction in 2.409 secs (2.379u,0.014s) (successful) *) 
 Time Qed.
 (* Finished transaction in 0.718 secs (0.714u,0.002s) (successful) *)
+End GFUNCTORS.
 
 Definition four_contents := [Int.repr 1; Int.repr 2; Int.repr 3; Int.repr 4].
 
+Section LimitImport. Import NoOracle.
 Lemma body_main:  semax_body Vprog Gprog f_main main_spec.
 Proof. finish. Qed.
+End LimitImport.
 
 End Alternate.
diff --git a/progs/verif_reverse.v b/progs/verif_reverse.v
index 6295c688e9..c5556cffb4 100644
--- a/progs/verif_reverse.v
+++ b/progs/verif_reverse.v
@@ -6,6 +6,7 @@
  ** includes the VeriC program logic and the MSL theory of separation logic
  **)
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 
 (** Import the theory of list segments.  This is not, strictly speaking,
  ** part of the Floyd system.  In principle, any user of Floyd can build
@@ -25,8 +26,6 @@ Require Import VST.progs.list_dt. Import LsegSpecial.
  **)
 Require Import VST.progs.reverse.
 
-Open Scope logic.
-
 (* The C programming language has a special namespace for struct
 ** and union identifiers, e.g., "struct foo {...}".  Some type-based operators
 ** in the program logic need access to an interpretation of this namespace,
@@ -96,7 +95,7 @@ Definition Gprog : funspecs :=   ltac:(with_library prog [
 Lemma list_cell_eq: forall sh i p ,
    sepalg.nonidentity sh ->
    field_compatible t_struct_list [] p ->
-   list_cell LS sh (Vint i) p =
+   list_cell LS sh (Vint i) p ⊣⊢
    field_at sh t_struct_list (DOT _head) (Vint i) p.
 Proof.
   intros.
@@ -200,7 +199,7 @@ Exists (h::cts1,r,v,y).
 entailer!.  (* smt_test verif_reverse_example2 *)
  - rewrite <- app_assoc. auto.
  - rewrite (lseg_unroll _ sh (h::cts1)).
-    apply orp_right2.
+    rewrite <- bi.or_intro_r.
    unfold lseg_cons.
    apply andp_right.
    + apply prop_right.
@@ -221,8 +220,6 @@ Qed.
  ** to have a nicer proof theory for reasoning about this kind of thing.
  **)
 
-Import compcert.lib.Maps.
-
 Lemma setup_globals:
  forall Delta gv,
   PTree.get _three (glob_types Delta) = Some (tarray t_struct_list 3) ->
@@ -249,20 +246,31 @@ Proof.
   assert_PROP (size_compatible tuint (gv _three) /\ align_compatible tuint (gv _three)) by (entailer!; clear - H5; hnf in H5; intuition).
   rewrite <- mapsto_data_at with (v := Vint(Int.repr 1)); try intuition. 
   clear H0.
-  rewrite <- (sepcon_emp (mapsto _ _ (offset_val 20 _) _)).
   assert (FC: field_compatible (tarray t_struct_list 3) [] (gv _three))
     by auto with field_compatible.
   match goal with |- ?A |-- _ => set (a:=A) end.
   replace (gv _three) with (offset_val 0 (gv _three)) by (autorewrite with norm; auto).
   subst a.
 
-  rewrite (sepcon_comm (has_ext tt)).
-  rewrite <- !sepcon_assoc. apply sepcon_derives; auto.
-  rewrite !sepcon_assoc.
-  rewrite (sepcon_emp (lseg _ _ _ _ _)).
-  rewrite sepcon_emp.
-
- repeat
+  cancel.
+  repeat match goal with |- _ * (mapsto _ _ _ ?q * _) |-- lseg _ _ _ (offset_val ?n _) _ =>
+    assert (FC': field_compatible t_struct_list [] (offset_val n (gv _three)));
+      [apply (@field_compatible_nested_field CompSpecs (tarray t_struct_list 3)
+         [ArraySubsc (n/8)] (gv _three));
+       simpl;
+       unfold field_compatible in FC |- *; simpl in FC |- *;
+       assert (0 <= n/8 < 3) by (cbv [Z.div]; simpl; lia);
+       tauto
+      |];
+    apply @lseg_unroll_nonempty1 with q;
+      [destruct (gv _three); try contradiction; intro Hx; inv Hx | auto; try reflexivity | ];
+    rewrite list_cell_eq by auto;
+    do 2 (apply sepcon_derives;
+      [ unfold field_at; rewrite prop_true_andp by auto with field_compatible;
+        unfold data_at_rec, at_offset; simpl; normalize; try apply derives_refl | ]);
+    clear FC'
+    end.
+  rewrite <- bi.sep_emp, <- bi.sep_assoc.
   match goal with |- _ * (mapsto _ _ _ ?q * _) |-- lseg _ _ _ (offset_val ?n _) _ =>
     assert (FC': field_compatible t_struct_list [] (offset_val n (gv _three)));
       [apply (@field_compatible_nested_field CompSpecs (tarray t_struct_list 3)
@@ -273,14 +281,14 @@ Proof.
        tauto
       |];
     apply @lseg_unroll_nonempty1 with q;
-      [destruct (gv _three); try contradiction; intro Hx; inv Hx | normalize; try reflexivity | ];
+      [destruct (gv _three); try contradiction; intro Hx; inv Hx | auto; try reflexivity | ];
     rewrite list_cell_eq by auto;
     do 2 (apply sepcon_derives;
       [ unfold field_at; rewrite prop_true_andp by auto with field_compatible;
         unfold data_at_rec, at_offset; simpl; normalize; try apply derives_refl | ]);
     clear FC'
     end.
-  rewrite mapsto_tuint_tptr_nullval; auto. apply derives_refl.
+  rewrite mapsto_tuint_tptr_nullval; auto.
   rewrite @lseg_nil_eq.
   entailer!.
 Qed.
@@ -303,8 +311,6 @@ forward_call  (* s = sumlist(r); *)
 forward.  (* return s; *)
 Qed.
 
-#[export] Existing Instance NullExtension.Espec.
-
 Lemma prog_correct:
   semax_prog prog tt Vprog Gprog.
 Proof.
@@ -313,5 +319,3 @@ semax_func_cons body_sumlist.
 semax_func_cons body_reverse.
 semax_func_cons body_main.
 Qed.
-
-
diff --git a/progs/verif_reverse2.v b/progs/verif_reverse2.v
index 70e5f00082..b477d5d4b3 100644
--- a/progs/verif_reverse2.v
+++ b/progs/verif_reverse2.v
@@ -26,14 +26,18 @@ Definition Vprog : varspecs. mk_varspecs prog. Defined.
 (** A convenience definition *)
 Definition t_struct_list := Tstruct _list noattr.
 
+Section mpred.
+
+Context `{!default_VSTGS Σ}.
+
 (** Inductive definition of linked lists *)
 Fixpoint listrep (sigma: list val) (x: val) : mpred :=
  match sigma with
  | h::hs => 
-    EX y:val, 
-      data_at Tsh t_struct_list (h,y) x  *  listrep hs y
+    ∃ y:val,
+      data_at Tsh t_struct_list (h,y) x ∗ listrep hs y
  | nil => 
-    !! (x = nullval) && emp
+    ⌜x = nullval⌝ ∧ emp
  end.
 
 Arguments listrep sigma x : simpl never.
@@ -48,8 +52,8 @@ Arguments listrep sigma x : simpl never.
 
 Lemma listrep_local_facts:
   forall sigma p,
-   listrep sigma p |--
-   !! (is_pointer_or_null p /\ (p=nullval <-> sigma=nil)).
+   listrep sigma p ⊢
+   ⌜is_pointer_or_null p /\ (p=nullval <-> sigma=nil)⌝.
 Proof.
 intros.
 revert p; induction sigma; 
@@ -58,21 +62,21 @@ Intros y. entailer!.
 split; intro. subst p. destruct H; contradiction. inv H2.
 Qed.
 
-#[export] Hint Resolve listrep_local_facts : saturate_local.
+#[local] Hint Resolve listrep_local_facts : saturate_local.
 
 Lemma listrep_valid_pointer:
   forall sigma p,
-   listrep sigma p |-- valid_pointer p.
+   listrep sigma p ⊢ valid_pointer p.
 Proof.
  destruct sigma; unfold listrep; fold listrep; intros; Intros; subst.
  auto with valid_pointer.
  Intros y.
  apply sepcon_valid_pointer1.
  apply data_at_valid_ptr; auto.
- simpl;  computable.
+ simpl; computable.
 Qed.
 
-#[export] Hint Resolve listrep_valid_pointer : valid_pointer.
+#[local] Hint Resolve listrep_valid_pointer : valid_pointer.
 
 (** Specification of the [reverse] function.  It characterizes
  ** the precondition required for calling the function,
@@ -86,7 +90,7 @@ Definition reverse_spec :=
      PARAMS (p)
      SEP (listrep sigma p)
   POST [ (tptr t_struct_list) ]
-    EX q:val,
+    ∃ q:val,
      PROP () RETURN (q)
      SEP (listrep(rev sigma) q).
 
@@ -112,10 +116,10 @@ start_function.
 forward.  (* w = NULL; *)
 forward.  (* v = p; *)
 (** To prove a while-loop, you must supply a loop invariant,
- ** in this case (EX s1  PROP(...)LOCAL(...)(SEP(...)).  *)
+ ** in this case (∃ s1  PROP(...)LOCAL(...)(SEP(...)).  *)
 forward_while
-   (EX s1: list val, EX s2 : list val, 
-    EX w: val, EX v: val,
+   (∃ s1: list val, ∃ s2 : list val, 
+    ∃ w: val, ∃ v: val,
      PROP (sigma = rev s1 ++ s2)
      LOCAL (temp _w w; temp _v v)
      SEP (listrep s1 w; listrep s2 v)).
@@ -130,7 +134,7 @@ entailer!.
 entailer!.
 * (* Prove that loop body preserves invariant *)
 destruct s2 as [ | h r].
- - unfold listrep at 2. 
+ - unfold listrep at 2.
    Intros. subst. contradiction.
  - unfold listrep at 2; fold listrep.
    Intros y.
@@ -148,17 +152,11 @@ destruct s2 as [ | h r].
 * (* after the loop *)
 forward.  (* return w; *)
 Exists w; entailer!.
-rewrite (proj1 H1) by auto.
+rewrite -> (proj1 H1) by auto.
 unfold listrep at 2; fold listrep.
 entailer!.
-rewrite app_nil_r, rev_involutive.
+rewrite app_nil_r rev_involutive.
 auto.
 Qed.
 
-(** See the file [progs/verif_reverse.v] for an alternate
- ** proof of this function, using a general theory of
- ** list segments.  That file also has proofs of the
- ** sumlist function, the main function, and the
- ** [semax_func] theorem that ties all the functions together
- **)
-
+End mpred.
diff --git a/progs/verif_reverse3.v b/progs/verif_reverse3.v
index dc9e216e0c..e09c83650c 100644
--- a/progs/verif_reverse3.v
+++ b/progs/verif_reverse3.v
@@ -3,6 +3,7 @@
 (** First, import the entire Floyd proof automation system, which includes
  ** the VeriC program logic and the MSL theory of separation logic**)
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 
 (** Import the [reverse.v] file, which is produced by CompCert's clightgen
  ** from reverse.c.   The file reverse.v defines abbreviations for identifiers
@@ -55,14 +56,11 @@ Lemma list_ind_in_logc: forall {A: Type} (P: mpred) (Q: list A -> mpred),
   P |-- ALL l: list A, Q l.
 Proof.
   intros.
-  apply allp_right; intro l.
+  apply bi.forall_intro; intro l.
   induction l; auto.
-  rewrite (add_andp _ _ IHl), (add_andp _ _ H0).
-  apply imp_andp_adjoint.
-  apply andp_left2.
-  apply (allp_left _ a).
-  apply (allp_left _ l).
-  auto.
+  trans (Q l && (Q l --> Q (a :: l))); [|apply bi.impl_elim_r].
+  apply bi.and_intro; auto.
+  rewrite H0; rewrite !bi.forall_elim; auto.
 Qed.
 
 (* application *)
@@ -70,33 +68,23 @@ Qed.
 Lemma listrep2lsegrec: forall l x,
   listrep l x |-- lsegrec l x nullval.
 Proof.
-  assert (emp |-- ALL l: list val, (ALL x: val, listrep l x -* lsegrec l x nullval)).
+  assert (emp |-- ALL l: list val, (ALL x: val, (listrep l x -* lsegrec l x nullval))).
   + apply list_ind_in_logc.
-    - apply allp_right; intros.
-      apply wand_sepcon_adjoint.
-      rewrite emp_sepcon.
-      simpl.
-      apply derives_refl.
-    - apply allp_right; intros a.
-      apply allp_right; intros l.
-      apply imp_andp_adjoint.
-      apply allp_right; intros x.
-      apply andp_left2.
-      apply wand_sepcon_adjoint.
+    - apply bi.forall_intro; intros.
+      auto.
+    - apply bi.forall_intro; intros a.
+      apply bi.forall_intro; intros l.
+      apply bi.impl_intro_r.
+      apply bi.forall_intro; intros x.
+      rewrite bi.and_elim_r.
+      apply bi.wand_intro_r.
       simpl.
       Intros y.
       Exists y.
-      apply wand_sepcon_adjoint.
-      apply (allp_left _ y).
-      apply wand_sepcon_adjoint.
       cancel.
-      apply wand_sepcon_adjoint.
-      apply derives_refl.
+      rewrite bi.forall_elim; apply bi.wand_elim_l.
   + intros.
-    rewrite <- (emp_sepcon (listrep _ _)).
-    apply wand_sepcon_adjoint.
-    eapply derives_trans; [exact H | clear H].
-    apply (allp_left _ l).
-    apply (allp_left _ x).
-    apply derives_refl.
+    rewrite <- (bi.emp_sep (listrep _ _)).
+    rewrite H.
+    rewrite !bi.forall_elim; apply bi.wand_elim_l.
 Qed.
diff --git a/progs/verif_reverse_client.v b/progs/verif_reverse_client.v
index 2176eaaee9..f7ace45151 100644
--- a/progs/verif_reverse_client.v
+++ b/progs/verif_reverse_client.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.reverse_client.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
diff --git a/progs/verif_rotate.v b/progs/verif_rotate.v
index 0bdf89ebec..cf03b7f18c 100644
--- a/progs/verif_rotate.v
+++ b/progs/verif_rotate.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.library.
 Require Import VST.progs.rotate.
 
@@ -95,7 +96,7 @@ Proof.
       data_at sh (tarray tint n) (map Vint (map Int.repr (sublist 0 i (sublist k n s ++ sublist 0 k s) ++ sublist i n s))) a
     )
   ).
-  { entailer!!. apply sepcon_derives; list_solve. }
+  { entailer!!. apply bi.sep_mono; list_solve. }
   { forward.
     forward.
     entailer!!.
diff --git a/progs/verif_stackframe_demo.v b/progs/verif_stackframe_demo.v
index 7ec24748f5..0428e2341c 100644
--- a/progs/verif_stackframe_demo.v
+++ b/progs/verif_stackframe_demo.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.stackframe_demo.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
@@ -40,4 +41,3 @@ Proof.
   (* Should it fail? Yes. Because the lvar clause are used in stackframe cancel.
      The error message? We'd Better improve it.  --- Qinxiang 2019.11.8 *)
 Abort.
-
diff --git a/progs/verif_store_demo.v b/progs/verif_store_demo.v
index fa01dd53c8..577e878aad 100644
--- a/progs/verif_store_demo.v
+++ b/progs/verif_store_demo.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.store_demo.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
diff --git a/progs/verif_strlib.v b/progs/verif_strlib.v
index 152279ab9a..0ba710e442 100644
--- a/progs/verif_strlib.v
+++ b/progs/verif_strlib.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.strlib.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
@@ -135,20 +136,18 @@ forward_loop (EX i : Z,
   }
 Qed.
 
-Open Scope logic.
-
 Lemma split_data_at_app_tschar:
- forall sh n (al bl: list val) p ,
+ forall sh n (al bl: list val) p,
    n = Zlength (al++bl) ->
-   data_at sh (tarray tschar n) (al++bl) p = 
-         data_at sh (tarray tschar (Zlength al)) al p
-        * data_at sh (tarray tschar (n - Zlength al)) bl
-                 (field_address0 (tarray tschar n) [ArraySubsc (Zlength al)] p).
+   data_at sh (tarray tschar n) (al++bl) p =
+         (data_at sh (tarray tschar (Zlength al)) al p
+          * data_at sh (tarray tschar (n - Zlength al)) bl
+                 (field_address0 (tarray tschar n) [ArraySubsc (Zlength al)] p)).
 Proof.
 intros.
-apply (split2_data_at_Tarray_app _ n  sh tschar al bl ); auto.
+apply (split2_data_at_Tarray_app _ n  sh tschar al bl); auto.
 rewrite Zlength_app in H.
-change ( Zlength bl = n - Zlength al); lia.
+change (Zlength bl = n - Zlength al); lia.
 Qed.
 
 Lemma body_strcat: semax_body Vprog Gprog f_strcat strcat_spec.
@@ -225,8 +224,7 @@ forward_loop (EX i : Z,
       cancel.
     assert (j = Zlength ls) by cstring; subst.
     autorewrite with sublist.
-    apply derives_refl'.
-    unfold data_at; f_equal. 
+    f_equiv.
     replace (n - (Zlength ld + Zlength ls))
      with (1 + (n - (Zlength ld + Zlength ls+1))) by rep_lia.
     rewrite <- repeat_app' by rep_lia.
@@ -534,7 +532,7 @@ forward_loop (EX i : Z,
            repeat Vundef (Z.to_nat (n - (Zlength ld + j)))) dest;
          data_at sh' (tarray tschar (Zlength ls + 1))
            (map Vbyte (ls ++ [Byte.zero])) src)).
- all: finish.
+  all: finish.
 Qed.
 
 Lemma body_strcmp: semax_body Vprog Gprog f_strcmp strcmp_spec.
diff --git a/progs/verif_structcopy.v b/progs/verif_structcopy.v
index 3120e70159..c5a7e9fe2a 100644
--- a/progs/verif_structcopy.v
+++ b/progs/verif_structcopy.v
@@ -1,10 +1,9 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.structcopy.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
-Local Open Scope logic.
-
 Definition tfoo := Tstruct _foo noattr.
 
 Definition f_spec :=
diff --git a/progs/verif_structerr.v b/progs/verif_structerr.v
index ebd956e1a0..2a85ea864e 100644
--- a/progs/verif_structerr.v
+++ b/progs/verif_structerr.v
@@ -8,7 +8,7 @@ Local Open Scope logic.
 
 Definition t_struct_foo := Tstruct _foo noattr.
 
-Definition f_spec : ident * funspec :=
+Definition f_spec :=
  DECLARE _f
   WITH u: unit
   PRE [ ]
@@ -20,7 +20,7 @@ Definition f_spec : ident * funspec :=
         PROP () LOCAL()
            SEP ().
 
-Definition g_spec : ident * funspec :=
+Definition g_spec :=
  DECLARE _g
   WITH ij: val
   PRE [ Tstruct _foo noattr ]
diff --git a/progs/verif_sumarray.v b/progs/verif_sumarray.v
index 805e0c3e0a..79fb869583 100644
--- a/progs/verif_sumarray.v
+++ b/progs/verif_sumarray.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto. (* Import the Verifiable C system *)
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.sumarray. (* Import the AST of this C program *)
 (* The next line is "boilerplate", always required after importing an AST. *)
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
@@ -13,15 +14,13 @@ Proof.
   intros. induction a; simpl; lia.
 Qed.
 
-Definition sumarray_spec : ident * funspec :=
+Definition sumarray_spec :=
  DECLARE _sumarray
   WITH a: val, sh : share, contents : list Z, size: Z
   PRE [ (tptr tuint), tint ]
           PROP  (readable_share sh; 0 <= size <= Int.max_signed;
                  Forall (fun x => 0 <= x <= Int.max_unsigned) contents)
           PARAMS (a; Vint (Int.repr size))
-          GLOBALS () (*TODO: make this line optional, ie insert GLOBALx nil during parsing of notation.
-                          Currently, omitting the line leads to failaure of start_function, specifically of compute_close_precondition_eq *)
           SEP   (data_at sh (tarray tuint size) (map Vint (map Int.repr contents)) a)
   POST [ tuint ]
         PROP () LOCAL(temp ret_temp  (Vint (Int.repr (sum_Z contents))))
@@ -36,8 +35,8 @@ Definition main_spec :=
  DECLARE _main
   WITH gv : globals
   PRE  [] main_pre prog tt gv
-  POST [ tint ]  
-     PROP() 
+  POST [ tint ]
+     PROP()
      LOCAL (temp ret_temp (Vint (Int.repr (1+2+3+4)))) 
      SEP(TT).
 
@@ -123,8 +122,6 @@ forward_call (*  s = sumarray(four,4); *)
 forward. (* return s; *)
 Qed.
 
-#[export] Existing Instance NullExtension.Espec.
-
 Lemma prog_correct:
   semax_prog prog tt Vprog Gprog.
 Proof.
diff --git a/progs/verif_sumarray2.v b/progs/verif_sumarray2.v
index 2086fa11f1..0859e722de 100644
--- a/progs/verif_sumarray2.v
+++ b/progs/verif_sumarray2.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto. (* Import the Verifiable C system *)
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.sumarray2. (* Import the AST of this C program *)
 
 (* The next line is "boilerplate", always required after importing an AST. *)
@@ -31,7 +32,7 @@ Definition main_spec :=
  DECLARE _main
   WITH gv: globals
   PRE  [] main_pre prog tt gv
-  POST [ tint ]  
+  POST [ tint ]
      PROP() 
      RETURN (Vint (Int.repr (3+4))) 
      SEP(TT).
@@ -123,8 +124,6 @@ forward_call (*  s = sumarray(four+2,2); *)
   forward. (* return *)
 Qed.
 
-#[export] Existing Instance NullExtension.Espec.
-
 Lemma prog_correct:
   semax_prog prog tt Vprog Gprog.
 Proof.
diff --git a/progs/verif_switch.v b/progs/verif_switch.v
index de9ddeeedb..15ff4e7c3f 100644
--- a/progs/verif_switch.v
+++ b/progs/verif_switch.v
@@ -1,17 +1,16 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import Recdef.
-#[export] Existing Instance NullExtension.Espec.
 Require Import VST.progs.switch.
-Require Export VST.floyd.Funspec_old_Notation.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
-Definition twice_spec :=
+Definition twice_spec : ident * funspec :=
   DECLARE _twice
     WITH n : Z
-    PRE [ _n OF tint ]
+    PRE [ tint ]
       PROP  (Int.min_signed <= n+n <= Int.max_signed)
-      LOCAL (temp _n (Vint (Int.repr n)))
+      PARAMS (Vint (Int.repr n))
       SEP ()
     POST [ tint ]
       PROP ()
@@ -19,12 +18,12 @@ Definition twice_spec :=
       SEP ().
 
 
-Definition f_spec :=
+Definition f_spec : ident * funspec :=
   DECLARE _f
     WITH x : Z
-    PRE [ _x OF tuint ]
+    PRE [ tuint ]
       PROP  (0 <= x <= Int.max_unsigned)
-      LOCAL (temp _x (Vint (Int.repr x)))
+      PARAMS (Vint (Int.repr x))
       SEP ()
     POST [ tint ]
       PROP ()
@@ -37,7 +36,7 @@ Definition Gprog : funspecs :=   ltac:(with_library prog [twice_spec]).
 Lemma body_twice: semax_body Vprog Gprog f_twice twice_spec.
 Proof.
 start_function.
-forward_if (PROP() LOCAL(temp _n (Vint (Int.repr (n+n)))) SEP()).
+forward_if (temp _n (Vint (Int.repr (n+n)))).
 repeat forward; entailer!!.
 repeat forward; entailer!!.
 repeat forward; entailer!!.
@@ -49,12 +48,10 @@ Qed.
 Lemma body_f: semax_body Vprog Gprog f_f f_spec.
 Proof.
 start_function.
-forward_if (@FF (environ->mpred) _).
+forward_if (FF : assert).
 forward.
 forward.
 forward.
 forward.
 forward.
 Qed.
-
-
diff --git a/progs/verif_tree.v b/progs/verif_tree.v
index 6b77c01909..83f6c580a8 100644
--- a/progs/verif_tree.v
+++ b/progs/verif_tree.v
@@ -1,10 +1,6 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.tree.
-Require Import VST.msl.iter_sepcon.
-Require Import VST.msl.wand_frame.
-Require Import VST.msl.wandQ_frame.
-
-Open Scope logic.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
@@ -41,9 +37,8 @@ Lemma list_rep_local_facts:
   forall l p, list_rep l p |-- !! (is_pointer_or_null p  /\ (p=nullval <-> l=nil)).
 Proof.
   intros.
-  destruct l; simpl; Intros; try Intros y; entailer!.
-  + split; auto.
-  + split; intros; subst; try congruence; try contradiction.
+  destruct l; simpl; Intros; try Intros y; entailer!. tauto.
+  split; intros; subst; try congruence; try contradiction.
 Qed.
 
 End LISTS.
@@ -82,10 +77,9 @@ Lemma tree_rep_local_facts:
   forall t p, tree_rep t p |-- !! (is_pointer_or_null p  /\ (p=nullval <-> t=E)).
 Proof.
   intros.
-  destruct t; simpl; Intros; try Intros x y; subst; entailer!.
-  + split; auto.
-  + split; intros; try congruence.
-    subst; inv Pp.
+  destruct t; simpl; Intros; try Intros x y; subst; entailer!. tauto.
+  split; intros; try congruence.
+  subst; inv Pp.
 Qed.
 
 End TREES.
@@ -104,12 +98,8 @@ Definition map_tree {V1 V2: Type} (f: V1 -> V2): tree V1 -> tree V2 :=
 
 Section IterTreeSepCon.
 
-  Context {A : Type}.
+  Context {A : bi}.
   Context {B : Type}.
-  Context {ND : NatDed A}.
-  Context {SL : SepLog A}.
-  Context {ClS: ClassicalSep A}.
-  Context {CoSL: CorableSepLog A}.
   Context (p : B -> A).
 
 Fixpoint iter_tree_sepcon (t1 : tree B) : A :=
@@ -122,15 +112,10 @@ End IterTreeSepCon.
 
 Section IterTreeSepCon2.
 
-  Context {A : Type}.
   Context {B1 B2 : Type}.
-  Context {ND : NatDed A}.
-  Context {SL : SepLog A}.
-  Context {ClS: ClassicalSep A}.
-  Context {CoSL: CorableSepLog A}.
-  Context (p : B1 -> B2 -> A).
+  Context (p : B1 -> B2 -> mpred).
 
-Fixpoint iter_tree_sepcon2 (t1 : tree B1) : tree B2 -> A :=
+Fixpoint iter_tree_sepcon2 (t1 : tree B1) : tree B2 -> mpred :=
     match t1 with
     | E => fun t2 =>
        match t2 with
@@ -145,7 +130,7 @@ Fixpoint iter_tree_sepcon2 (t1 : tree B1) : tree B2 -> A :=
   end.
 
 Lemma iter_tree_sepcon2_spec: forall tl1 tl2,
-  iter_tree_sepcon2 tl1 tl2 =
+  iter_tree_sepcon2 tl1 tl2 ⊣⊢
   EX tl: tree (B1 * B2),
   !! (tl1 = map_tree fst tl /\ tl2 = map_tree snd tl) &&
   iter_tree_sepcon (uncurry p) tl.
@@ -155,29 +140,25 @@ Proof.
   + revert tl2; induction tl1; intros; destruct tl2.
     - apply (exp_right E); simpl.
       apply andp_right; auto.
-      apply prop_right; auto.
     - simpl.
-      apply FF_left.
+      apply False_left.
     - simpl.
-      apply FF_left.
+      apply False_left.
     - simpl.
       specialize (IHtl1_1 tl2_1).
       specialize (IHtl1_2 tl2_2).
       eapply derives_trans; [apply sepcon_derives; [apply sepcon_derives |]; [apply derives_refl | apply IHtl1_1 | apply IHtl1_2] | clear IHtl1_1 IHtl1_2].
       Intros tl_2 tl_1; subst.
-      rewrite sepcon_andp_prop. apply derives_extract_prop; intros [? ?].
-      rewrite sepcon_andp_prop, sepcon_andp_prop'.
-      apply derives_extract_prop; intros [? ?].
       Exists (T tl_1 (v, b) tl_2).
       simpl.
       apply andp_right; [apply prop_right; subst; auto |].
       apply derives_refl.
-  + apply exp_left; intros tl. Intros; subst.
+  + Intros tl. subst.
     induction tl.
     - simpl. auto.
     - simpl.
       eapply derives_trans; [apply sepcon_derives; [apply sepcon_derives |]; [apply derives_refl | apply IHtl1 | apply IHtl2] | clear IHtl1 IHtl2].
-      apply derives_refl.
+      destruct v; simpl; cancel.
 Qed.
 
 End IterTreeSepCon2.
@@ -212,10 +193,9 @@ Lemma xtree_rep_local_facts:
   forall t p, xtree_rep t p |-- !! (is_pointer_or_null p /\ (p = nullval <-> t = XLeaf)).
 Proof.
 intros.
-destruct t; simpl; Intros; try Intros q;  entailer!.
-+ split; auto.
-+ split; intros; try congruence.
-  subst; destruct H as [? _]; inv H.
+destruct t; simpl; Intros; try Intros q; entailer!. tauto.
+split; intros; try congruence.
+subst; destruct H as [? _]; inv H.
 Qed.
 #[export] Hint Resolve xtree_rep_local_facts: saturate_local.
 
@@ -341,10 +321,9 @@ Lemma ytree_rep_local_facts:
   forall t p, ytree_rep t p |-- !! (is_pointer_or_null p /\ (p = nullval <-> t = YLeaf)).
 Proof.
 intros.
-destruct t; simpl; Intros; try Intros q; entailer!.
-+ split; auto.
-+ split; intros; try congruence.
-  subst; destruct H as [? _]; inv H.
+destruct t; simpl; Intros; try Intros q; entailer!. tauto.
+split; intros; try congruence.
+subst; destruct H as [? _]; inv H.
 Qed.
 #[export] Hint Resolve ytree_rep_local_facts: saturate_local.
 
@@ -565,16 +544,13 @@ Context {V: Type}.
 Variable listrep: list V -> val -> mpred.
 
 Definition lseg (contents: list V) (x z: val) : mpred :=
-  ALL tcontents: list V, listrep tcontents z -* listrep (contents ++ tcontents) x.
+  ALL tcontents: list V, (listrep tcontents z -* listrep (contents ++ tcontents) x).
 
 Lemma emp_lseg_nil: forall (x: val),
   emp |-- lseg nil x x.
 Proof.
-  intros.
-  apply allp_right; intros.
-  apply wand_sepcon_adjoint.
-  simpl.
-  entailer!.
+  unfold lseg.
+  auto.
 Qed.
 
 Lemma lseg_lseg: forall (s1 s2: list V) (x y z: val),
@@ -582,12 +558,8 @@ Lemma lseg_lseg: forall (s1 s2: list V) (x y z: val),
 Proof.
   intros.
   unfold lseg.
-  eapply derives_trans; [apply sepcon_derives; [apply derives_refl |] | apply wandQ_frame_ver].
-  eapply derives_trans; [apply (wandQ_frame_refine _ _ _ (app s2)) |].
-  apply derives_refl'.
-  f_equal; extensionality tcontents; simpl.
-  rewrite app_assoc.
-  auto.
+  iIntros "(H2 & H1)" (?) "H".
+  rewrite <- app_assoc; iApply "H1"; iApply "H2"; done.
 Qed.
 
 Lemma list_lseg: forall (s1 s2: list V) (x y: val),
@@ -595,13 +567,7 @@ Lemma list_lseg: forall (s1 s2: list V) (x y: val),
 Proof.
   intros.
   unfold lseg.
-  change (listrep s2 y) with ((fun s2 => listrep s2 y) s2).
-   change
-     (ALL tcontents : list V, listrep tcontents y -* listrep (s1 ++ tcontents) x)
-   with
-     (allp ((fun tcontents => listrep tcontents y) -* (fun tcontents => listrep (s1 ++ tcontents) x))).
-   change (listrep (s1 ++ s2) x) with ((fun s2 => listrep (s1 ++ s2) x) s2).
-   apply wandQ_frame_elim.
+  iIntros "(? & H)"; iApply "H"; done.
 Qed.
 
 End GeneralLseg.
@@ -614,8 +580,6 @@ Proof.
   {
     forward.
     entailer!.
-    simpl.
-    auto.
   }
   unfold Sfor.
   destruct t as [| tl v].
@@ -641,19 +605,19 @@ Proof.
       LOCAL (temp _q q)
       SEP (data_at Tsh t_struct_Xnode (q_root, Vint (Int.repr (v + 1))) p;
            GeneralLseg.lseg (list_rep (fun p n q : val => data_at Tsh t_struct_Xlist (p, n) q)) (map snd tl1) q_root q;
-           iter_sepcon (uncurry xtree_rep) tl1;
+           [∗ list] x ∈ tl1, uncurry xtree_rep x;
            list_rep (fun p n q : val => data_at Tsh t_struct_Xlist (p, n) q) (map snd tl2) q;
-           iter_sepcon (uncurry xtree_rep) tl2))%assert
+           [∗ list] x ∈ tl2, uncurry xtree_rep x))%assert
   break:
     ( PROP ()
       LOCAL ()
       SEP (data_at Tsh t_struct_Xnode (q_root, Vint (Int.repr (v + 1))) p;
            list_rep (fun p n q : val => data_at Tsh t_struct_Xlist (p, n) q) (map snd tl) q_root;
-           iter_sepcon (uncurry xtree_rep) (map (fun tp => (x_add1 (fst tp), snd tp)) tl)))%assert.
+           [∗ list] x ∈ (map (fun tp => (x_add1 (fst tp), snd tp)) tl), uncurry xtree_rep x))%assert.
   {
     Exists (@nil (XTree * val)) tl q_root.
     entailer!!.
-    apply GeneralLseg.emp_lseg_nil.
+    rewrite <- GeneralLseg.emp_lseg_nil; auto.
   }
   {
     Intros tl1 tl2 q.
@@ -666,7 +630,6 @@ Proof.
       simpl in H0; rewrite app_nil_r in H0.
       simpl map.
       sep_apply (GeneralLseg.list_lseg (list_rep (fun p0 n q : val => data_at Tsh t_struct_Xlist (p0, n) q)) (map snd tl1) nil q_root nullval).
-      sep_apply (eq_sym (iter_sepcon_app (uncurry xtree_rep) tl1 [])).
       rewrite !app_nil_r.
       rewrite <- H0, map_map.
       simpl. change (fun x : XTree * val => snd x) with (@snd XTree val).
@@ -678,7 +641,7 @@ Proof.
       Intros.
       contradiction.
     }
-    simpl list_rep; simpl iter_sepcon.
+    simpl list_rep; simpl big_opL.
     Intros q'.
     change (uncurry xtree_rep (t, p')) with (xtree_rep t p').
     forward.
@@ -688,16 +651,14 @@ Proof.
     entailer!!.
     + rewrite <- app_assoc; auto.
     + change (xtree_rep (x_add1 t) p') with (uncurry xtree_rep (x_add1 t, p')).
-      rewrite iter_sepcon_app; simpl.
+      rewrite big_sepL_app; simpl.
       cancel.
       eapply derives_trans; [| rewrite map_app; apply (GeneralLseg.lseg_lseg _ _ _ _ q)].
       cancel.
       clear.
       apply allp_right; intros.
-      apply wand_sepcon_adjoint.
-      simpl list_rep.
-      Exists q'.
-      cancel.
+      iIntros "??"; simpl.
+      iExists q'; iFrame.
   }
   entailer!!.
   Exists q_root. cancel.
@@ -705,7 +666,7 @@ Proof.
   cancel.
   rewrite iter_sepcon2_spec.
   Exists (map (fun tp : XTree * val => (x_add1 (fst tp), snd tp)) tl); cancel.
-  entailer!!.
+  entailer!!; auto.
   rewrite !map_map.
   split; f_equal.
 Qed.
@@ -820,14 +781,14 @@ Proof.
   replace_SEP 0 (lt_ytree_rep t' y).
   {
     unfold lt_ytree_rep.
-    entailer!!.
+    go_lower.
     Exists r; cancel.
   }
   forward_call (y, t').
   forward.
   clear.
   unfold lt_ytree_rep.
-  Intros r.
+  rewrite sep_exist_r; Intros r.
   Exists (v :: r).
   unfold y_list_rep; simpl.
   Exists y.
@@ -863,7 +824,7 @@ Proof.
   replace_SEP 0 (t_ytree_rep a pa).
   {
     unfold t_ytree_rep.
-    entailer!!.
+    go_lower.
     Exists s1; cancel.
   }
   forward_call (pa, a).
@@ -872,7 +833,7 @@ Proof.
   replace_SEP 0 (t_ytree_rep b pb).
   {
     unfold t_ytree_rep.
-    entailer!.
+    go_lower.
     Exists s2; cancel.
   }
   forward_call (pb, b).
@@ -892,8 +853,6 @@ Proof.
   forward.
 Qed.
 
-#[export] Existing Instance NullExtension.Espec.
-
 Lemma prog_correct:
   semax_prog prog tt Vprog Gprog.
 Proof.
@@ -905,5 +864,3 @@ semax_func_cons body_YTree_add.
 semax_func_cons body_Xfoo.
 semax_func_cons body_main.
 Qed.
-
-
diff --git a/progs/verif_union.v b/progs/verif_union.v
index e9af570bc9..95aedce8e3 100644
--- a/progs/verif_union.v
+++ b/progs/verif_union.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs.union.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
@@ -105,7 +106,7 @@ revert k H; induction p; simpl; intros.
 rewrite Pos2Z.inj_succ in H.
 specialize (IHp (k-1)).
 spec IHp; [lia | ].
-replace (2^(k-1)) with (2^1 * 2^(k-1-1)).
+replace (2^(k-1)) with (2^1 * 2^(k-1-1))%Z.
 2:{ rewrite <- Z.pow_add_r by lia. f_equal. lia. }
 rewrite Pos2Z.inj_xI.
 lia.
@@ -113,12 +114,12 @@ lia.
 rewrite Pos2Z.inj_succ in H.
 specialize (IHp (k-1)).
 spec IHp; [lia | ].
-replace (2^(k-1)) with (2^1 * 2^(k-1-1)).
+replace (2^(k-1)) with (2^1 * 2^(k-1-1))%Z.
 2:{ rewrite <- Z.pow_add_r by lia. f_equal. lia. }
 rewrite Pos2Z.inj_xO.
 lia.
 -
-replace (2^(k-1)) with (2^1 * 2^(k-1-1)).
+replace (2^(k-1)) with (2^1 * 2^(k-1-1))%Z.
 2:{ rewrite <- Z.pow_add_r by lia. f_equal. lia. }
 change (2^1) with 2.
 assert (0 < 2 ^ (k-1-1)).
@@ -127,7 +128,7 @@ lia.
 Qed.
 
 
-Definition abs_nan (any_nan: {x : Bits.binary32 | Binary.is_nan 24 128 x = true}) (f: Binary.binary_float 24 128)   :=
+Definition abs_nan (any_nan: {x : Bits.binary32 | Binary.is_nan 24 128 x = true} ) (f: Binary.binary_float 24 128)   :=
 match f with
 | @Binary.B754_nan _ _ _ p H =>
     exist (fun x : Binary.binary_float 24 128 => Binary.is_nan 24 128 x = true)
@@ -161,7 +162,7 @@ Qed.
 
 Lemma binary32_abs_lemma:
  forall (x : Bits.binary32)
-      (any_nan : {x : Bits.binary32 | Binary.is_nan 24 128 x = true}),
+      (any_nan : {x : Bits.binary32 | Binary.is_nan 24 128 x = true} ),
   Bits.b32_of_bits (Bits.bits_of_b32 x mod 2 ^ 31) =
   Binary.Babs 24 128 (abs_nan any_nan) x.
 Proof.
diff --git a/progs64/VSUpile/Makefile b/progs64/VSUpile/Makefile
index 25c4b6d758..308bcc7050 100644
--- a/progs64/VSUpile/Makefile
+++ b/progs64/VSUpile/Makefile
@@ -38,8 +38,8 @@ OFILES = $(patsubst %.c,%.o,$(CFILES))
 VOFILES = $(patsubst %.v,%.vo,$(CVFILES) $(VFILES))
 
 
-VST_DIRS= msl sepcomp veric zlist floyd
-VSTFLAGS= -R $(VST_LOC)/compcert compcert $(foreach d, $(VST_DIRS), -Q $(VST_LOC)/$(d) VST.$(d)) -R . pile
+VST_DIRS= msl shared sepcomp veric zlist floyd
+VSTFLAGS= -R $(VST_LOC)/compcert compcert -Q $(VST_LOC)/ora/theories iris_ora $(foreach d, $(VST_DIRS), -Q $(VST_LOC)/$(d) VST.$(d)) -R . pile
 
 
 target: _CoqProject verif_main.vo simple_verif_main.vo fast/verif_fastmain.vo
diff --git a/progs64/VSUpile/PileModel.v b/progs64/VSUpile/PileModel.v
index f805750ba8..977e514477 100644
--- a/progs64/VSUpile/PileModel.v
+++ b/progs64/VSUpile/PileModel.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 
 (*Model-level definitions and associated lemmas.*)
 
diff --git a/progs64/VSUpile/fast/link_fastpile.v b/progs64/VSUpile/fast/link_fastpile.v
index 99cf86d8bd..5c575438d7 100644
--- a/progs64/VSUpile/fast/link_fastpile.v
+++ b/progs64/VSUpile/fast/link_fastpile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import VST.floyd.VSU_addmain.
 Require Import verif_fastmain.
diff --git a/progs64/VSUpile/fast/spec_fastpile.v b/progs64/VSUpile/fast/spec_fastpile.v
index 2d02567019..07cd721e79 100644
--- a/progs64/VSUpile/fast/spec_fastpile.v
+++ b/progs64/VSUpile/fast/spec_fastpile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import fastpile.
 Require Import spec_stdlib.
 Require Import PileModel.
diff --git a/progs64/VSUpile/fast/spec_fastpile_concrete.v b/progs64/VSUpile/fast/spec_fastpile_concrete.v
index c85d7e8b02..d0dc749c8f 100644
--- a/progs64/VSUpile/fast/spec_fastpile_concrete.v
+++ b/progs64/VSUpile/fast/spec_fastpile_concrete.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import fastpile.
 Require Import spec_stdlib.
 
diff --git a/progs64/VSUpile/fast/spec_fastpile_private.v b/progs64/VSUpile/fast/spec_fastpile_private.v
index 8aa70e07bd..36f5cfecac 100644
--- a/progs64/VSUpile/fast/spec_fastpile_private.v
+++ b/progs64/VSUpile/fast/spec_fastpile_private.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import fastpile.
 Require Import spec_stdlib.
 Require Import spec_fastpile.
diff --git a/progs64/VSUpile/fast/subsume_fastpile.v b/progs64/VSUpile/fast/subsume_fastpile.v
index e7a3af42fa..06f1946703 100644
--- a/progs64/VSUpile/fast/subsume_fastpile.v
+++ b/progs64/VSUpile/fast/subsume_fastpile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import fastpile.
 Require Import spec_stdlib.
 Require Import spec_fastpile.
diff --git a/progs64/VSUpile/fast/verif_fastapile.v b/progs64/VSUpile/fast/verif_fastapile.v
index 01d27aad07..08bb45ce74 100644
--- a/progs64/VSUpile/fast/verif_fastapile.v
+++ b/progs64/VSUpile/fast/verif_fastapile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import fastapile.
 Require Import spec_stdlib.
@@ -74,7 +75,7 @@ forward_call (gv _a_pile, sigma).
 forward.
 Qed.
 
-Definition ApileVSU: @VSU NullExtension.Espec 
+Definition ApileVSU: VSU
       nil apile_imported_specs ltac:(QPprog prog) Apile_ASI (apile nil).
   Proof. 
     mkVSU prog apile_internal_specs.
diff --git a/progs64/VSUpile/fast/verif_fastcore.v b/progs64/VSUpile/fast/verif_fastcore.v
index 7b8d441bd6..10e2d2622b 100644
--- a/progs64/VSUpile/fast/verif_fastcore.v
+++ b/progs64/VSUpile/fast/verif_fastcore.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 
 Require Import spec_stdlib.
diff --git a/progs64/VSUpile/fast/verif_fastmain.v b/progs64/VSUpile/fast/verif_fastmain.v
index fd8963bb8e..6b86d67848 100644
--- a/progs64/VSUpile/fast/verif_fastmain.v
+++ b/progs64/VSUpile/fast/verif_fastmain.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.veric.initial_world.
 Require Import VST.floyd.VSU.
 
@@ -38,7 +39,7 @@ unfold APILE, M, ONEPILE.
 forward_call (i+1, decreasing(Z.to_nat i), gv).
 forward_call (i+1, decreasing(Z.to_nat i), gv).
 rewrite decreasing_inc by lia.
-entailer!.
+entailer!!.
 unfold APILE, M. simpl; cancel.
 -
 unfold APILE, M, ONEPILE.
@@ -50,7 +51,7 @@ forward_call (10,gv).
 forward.
 Qed.
 
-Definition MainComp:  MainCompType nil main_QPprog Core_VSU whole_prog (snd (main_spec whole_prog))  emp.
+Definition MainComp:  MainCompType nil main_QPprog Core_VSU whole_prog (snd (main_spec whole_prog)) (fun _ => emp).
 Proof.
 mkComponent prog.
 solve_SF_internal body_main.
diff --git a/progs64/VSUpile/fast/verif_fastonepile.v b/progs64/VSUpile/fast/verif_fastonepile.v
index ed39fffa9a..082e170d21 100644
--- a/progs64/VSUpile/fast/verif_fastonepile.v
+++ b/progs64/VSUpile/fast/verif_fastonepile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import onepile.
 Require Import spec_stdlib.
@@ -86,7 +87,7 @@ Proof. intros.
          rewrite sepcon_emp.
     destruct H as [b Hb]; rewrite Hb in *.
     eapply derives_trans. 
-    + apply mapsto_zeros_memory_block. apply writable_readable. apply writable_Ews.
+    + apply mapsto_zeros_memory_block.
     + rewrite <- memory_block_data_at_; simpl; trivial.
       apply headptr_field_compatible; trivial. exists b; trivial. cbv; trivial. simpl; rep_lia.
       econstructor. reflexivity. apply Z.divide_0_r.
@@ -95,7 +96,7 @@ Qed.
 Lemma onepile_Init: VSU_initializer prog (one_pile None).
 Proof. InitGPred_tac. unfold one_pile. normalize. apply data_at_data_at_. Qed.
 
-Definition OnepileVSU: @VSU NullExtension.Espec
+Definition OnepileVSU: VSU
       nil onepile_imported_specs ltac:(QPprog prog) Onepile_ASI (one_pile None).
   Proof.
     mkVSU prog onepile_internal_specs. 
diff --git a/progs64/VSUpile/fast/verif_fastpile.v b/progs64/VSUpile/fast/verif_fastpile.v
index 4d684dc897..3219baa66e 100644
--- a/progs64/VSUpile/fast/verif_fastpile.v
+++ b/progs64/VSUpile/fast/verif_fastpile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import fastpile.
 Require Import spec_stdlib.
@@ -72,7 +73,7 @@ forward.
 simpl pilerep; unfold fastprep. 
 simpl pile_freeable. unfold pfreeable.
 Exists p 0.
-entailer!.
+entailer!!.
 Qed.
 
 Lemma body_Pile_add: semax_body PileVprog PileGprog f_Pile_add (Pile_add_spec M PILE).
@@ -153,15 +154,16 @@ if_tac.
 { subst.
   forward_if False.
   - forward_call 1. contradiction.
-  - congruence. }
+  - congruence.
+  - Intros. contradiction. }
 forward_if True.
 + contradiction.
-+ forward. entailer!.
-+ forward. Exists p. entailer!.
++ forward. entailer!!.
++ forward. Exists p. entailer!!.
 Qed.
 
-  Definition PileVSU: @VSU NullExtension.Espec
-      nil pile_imported_specs ltac:(QPprog prog) Pile_ASI emp.
+  Definition PileVSU: VSU
+      nil pile_imported_specs ltac:(QPprog prog) Pile_ASI (fun _ => emp).
   Proof. 
     mkVSU prog pile_internal_specs.
     + solve_SF_internal body_surely_malloc.
@@ -171,8 +173,8 @@ Qed.
     + solve_SF_internal body_Pile_free.
   Qed.
 
-  Definition PilePrivateVSU: @VSU NullExtension.Espec
-      nil pile_imported_specs ltac:(QPprog prog) (FastpilePrivateASI M PILEPRIV) emp.
+  Definition PilePrivateVSU: VSU
+      nil pile_imported_specs ltac:(QPprog prog) (FastpilePrivateASI M PILEPRIV) (fun _ => emp).
   Proof. 
     mkVSU prog pile_internal_specs.
     + solve_SF_internal body_surely_malloc.
diff --git a/progs64/VSUpile/fast/verif_fastpile_concrete.v b/progs64/VSUpile/fast/verif_fastpile_concrete.v
index 1b8495056a..2f7cd4b838 100644
--- a/progs64/VSUpile/fast/verif_fastpile_concrete.v
+++ b/progs64/VSUpile/fast/verif_fastpile_concrete.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import fastpile.
 Require Import spec_stdlib.
diff --git a/progs64/VSUpile/fast/verif_fasttriang.v b/progs64/VSUpile/fast/verif_fasttriang.v
index b1c30f6f78..40da623162 100644
--- a/progs64/VSUpile/fast/verif_fasttriang.v
+++ b/progs64/VSUpile/fast/verif_fasttriang.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import triang.
 Require Import spec_stdlib.
@@ -31,10 +32,10 @@ forward_for_simple_bound n
 -
  entailer!.
 - forward_call (p, i+1, decreasing(Z.to_nat i), gv).
-entailer!.
+entailer!!.
 assert (Z.to_nat (i+1) = S (Z.to_nat i))
   by (rewrite <- Z2Nat.inj_succ by lia; f_equal).
-rewrite H2.
+rewrite H1.
 unfold decreasing; fold decreasing.
 rewrite inj_S.
 rewrite Z2Nat.id by lia.
@@ -44,7 +45,7 @@ forward_call (p, decreasing (Z.to_nat n)).
 apply sumlist_decreasing_bound; auto.
 forward_call (p, decreasing (Z.to_nat n), gv).
 forward.
-entailer!.
+entailer!!.
 f_equal; f_equal.
 clear.
 induction (Z.to_nat n).
@@ -52,8 +53,8 @@ reflexivity.
 simpl. congruence.
 Qed.
 
-  Definition TriangVSU: @VSU NullExtension.Espec
-      nil triang_imported_specs ltac:(QPprog prog) (TriangASI M) emp.
+  Definition TriangVSU: VSU
+      nil triang_imported_specs ltac:(QPprog prog) (TriangASI M) (fun _ => emp).
   Proof. 
     mkVSU prog triang_internal_specs.
     + solve_SF_internal body_Triang_nth.
diff --git a/progs64/VSUpile/incr/verif_incr.v b/progs64/VSUpile/incr/verif_incr.v
index 60a9b95540..3c6d96f543 100644
--- a/progs64/VSUpile/incr/verif_incr.v
+++ b/progs64/VSUpile/incr/verif_incr.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import incr.
 Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
@@ -32,9 +33,10 @@ Lemma sub_incr12:
   funspec_sub (snd incr2_spec)  (snd incr1_spec).
 Proof.
 do_funspec_sub. destruct w as [[[i a] sh] data]. clear H.
-Exists (i,a) (data_at sh (tarray tuint 10) data a). simpl; entailer!.
+rewrite <- fupd_intro.
+Exists (i,a) (data_at sh (tarray tuint 10) data a). simpl; entailer!!.
 intros tau ? ?. Exists data.
-entailer!.
+entailer!!.
 Qed.
 
 Definition incr3_spec :=
@@ -66,8 +68,9 @@ Lemma sub_incr34:
   funspec_sub (snd incr4_spec)  (snd incr3_spec).
 Proof.
 do_funspec_sub. destruct w as [[[i gv] sh] data]. clear H.
+rewrite <- fupd_intro.
 Exists i (data_at sh (tarray tuint 10) data (gv _global_auxdata)).
-simpl; entailer!.
+simpl; entailer!!.
 intros tau ? ?. Exists data.
-entailer!.
+entailer!!.
 Qed.
\ No newline at end of file
diff --git a/progs64/VSUpile/simple_spec_apile.v b/progs64/VSUpile/simple_spec_apile.v
index b8fdf2d541..c1c72e60ec 100644
--- a/progs64/VSUpile/simple_spec_apile.v
+++ b/progs64/VSUpile/simple_spec_apile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import apile.
 Require Import simple_spec_stdlib.
 Require Import simple_spec_pile.
diff --git a/progs64/VSUpile/simple_spec_main.v b/progs64/VSUpile/simple_spec_main.v
index 5928e79b10..cc798b6a1c 100644
--- a/progs64/VSUpile/simple_spec_main.v
+++ b/progs64/VSUpile/simple_spec_main.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.  (* Need this, otherwise get wrong version of main_pre *)
 Require Import main.
 
diff --git a/progs64/VSUpile/simple_spec_onepile.v b/progs64/VSUpile/simple_spec_onepile.v
index c194f216da..080b495ebe 100644
--- a/progs64/VSUpile/simple_spec_onepile.v
+++ b/progs64/VSUpile/simple_spec_onepile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import onepile.
 Require Import simple_spec_stdlib.
 Require Import simple_spec_pile.
diff --git a/progs64/VSUpile/simple_spec_pile.v b/progs64/VSUpile/simple_spec_pile.v
index 678795c842..6761de6ac1 100644
--- a/progs64/VSUpile/simple_spec_pile.v
+++ b/progs64/VSUpile/simple_spec_pile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import pile.
 Instance PileCompSpecs : compspecs. make_compspecs prog. Defined.
 Require Import simple_spec_stdlib.
diff --git a/progs64/VSUpile/simple_spec_stdlib.v b/progs64/VSUpile/simple_spec_stdlib.v
index bccc09b28a..221d3873c9 100644
--- a/progs64/VSUpile/simple_spec_stdlib.v
+++ b/progs64/VSUpile/simple_spec_stdlib.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import stdlib.
 
 
@@ -29,7 +30,7 @@ Lemma malloc_token_local_facts:  forall {cs: compspecs} sh t p,
       malloc_token sh t p |-- !! (field_compatible t [] p /\ malloc_compatible (sizeof t) p).
 Proof. intros.
  unfold malloc_token.
- normalize. rewrite prop_and.
+ normalize. rewrite pure_and.
  apply andp_right. apply prop_right; auto.
  apply malloc_token'_local_facts.
 Qed.
@@ -107,7 +108,8 @@ Lemma malloc_spec_sub:
    funspec_sub (snd malloc_spec') (snd (malloc_spec t)).
 Proof.
 do_funspec_sub. rename w into gv. clear H.
-Exists (sizeof t, gv) emp. simpl; entailer!.
+rewrite <- fupd_intro.
+Exists (sizeof t, gv) (emp: mpred). simpl; entailer!.
 intros tau ? ?. Exists (eval_id ret_temp tau).
 entailer!.
 if_tac; auto.
@@ -124,7 +126,8 @@ Lemma free_spec_sub:
    funspec_sub (snd free_spec') (snd (free_spec t)).
 Proof.
 do_funspec_sub. destruct w as [p gv]. clear H.
-Exists (sizeof t, p, gv) emp. simpl; entailer!.
+rewrite <- fupd_intro.
+Exists (sizeof t, p, gv) (emp: mpred). simpl; entailer!.
 if_tac; trivial.
 sep_apply data_at__memory_block_cancel.
 unfold malloc_token; entailer!.
diff --git a/progs64/VSUpile/simple_spec_triang.v b/progs64/VSUpile/simple_spec_triang.v
index 4bc6d8dbc9..69c8c24ed1 100644
--- a/progs64/VSUpile/simple_spec_triang.v
+++ b/progs64/VSUpile/simple_spec_triang.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import triang.
 Require Import simple_spec_stdlib.
 Require Import PileModel.
diff --git a/progs64/VSUpile/simple_verif_apile.v b/progs64/VSUpile/simple_verif_apile.v
index 764b679547..6f803c1e1d 100644
--- a/progs64/VSUpile/simple_verif_apile.v
+++ b/progs64/VSUpile/simple_verif_apile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import apile.
 Require Import simple_spec_stdlib.
@@ -8,13 +9,13 @@ Require Import simple_spec_apile.
 
 Lemma make_apile: forall gv, 
      globals_ok gv ->
-    @data_at APileCompSpecs Ews size_t nullval
+    data_at (cs:=APileCompSpecs) Ews size_t nullval
           (gv _a_pile) |-- apile nil gv.
 Proof.
 intros. unfold apile, pilerep.
 assert_PROP (headptr (gv _a_pile)) by entailer!.
 Exists nullval.
-unfold listrep. entailer!.
+unfold listrep. entailer!!.
 unfold_data_at (data_at _ tpile _ _).
 rewrite field_at_data_at. simpl.
 rewrite field_compatible_field_address
@@ -54,7 +55,7 @@ forward_call (gv _a_pile, sigma).
 forward.
 Qed. 
 
-  Definition ApileVSU: @VSU NullExtension.Espec 
+  Definition ApileVSU: VSU
       nil apile_imported_specs ltac:(QPprog prog) ApileASI (apile nil) .
   Proof. 
     mkVSU prog apile_internal_specs. 
diff --git a/progs64/VSUpile/simple_verif_main.v b/progs64/VSUpile/simple_verif_main.v
index 9b3f91395d..83cf5f98cd 100644
--- a/progs64/VSUpile/simple_verif_main.v
+++ b/progs64/VSUpile/simple_verif_main.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 
 Require Import PileModel. (*needed for decreasing etc*)
@@ -48,12 +49,12 @@ forward_for_simple_bound 10
           apile (decreasing (Z.to_nat i)) gv;
           mem_mgr gv; has_ext tt)).
 - 
- entailer!.
+ entailer!!.
 -
 forward_call (i+1, decreasing(Z.to_nat i), gv).
 forward_call (i+1, decreasing(Z.to_nat i), gv).
 rewrite decreasing_inc by lia.
-entailer!.
+entailer!!.
 -
 forward_call (decreasing (Z.to_nat 10), gv).
 compute; split; congruence.
@@ -63,7 +64,7 @@ forward_call (10,gv).
 forward.
 Qed.
 
-Definition MainComp:  MainCompType nil main_QPprog Core_VSU whole_prog (snd (main_spec whole_prog))  emp.
+Definition MainComp:  MainCompType nil main_QPprog Core_VSU whole_prog (snd (main_spec whole_prog)) (fun _ => emp).
 Proof.
 mkComponent prog.
 solve_SF_internal body_main.
diff --git a/progs64/VSUpile/simple_verif_onepile.v b/progs64/VSUpile/simple_verif_onepile.v
index c10a64347c..016df99637 100644
--- a/progs64/VSUpile/simple_verif_onepile.v
+++ b/progs64/VSUpile/simple_verif_onepile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import onepile.
 Require Import simple_spec_stdlib.
@@ -54,7 +55,7 @@ Lemma onepile_Init: VSU_initializer prog (onepile None).
 Proof. InitGPred_tac. normalize. apply data_at_data_at_. Qed.
 
 
-Definition OnepileVSU: @VSU NullExtension.Espec
+Definition OnepileVSU: VSU
       nil onepile_imported_specs ltac:(QPprog prog) OnepileASI (onepile None).
   Proof.
     mkVSU prog onepile_internal_specs. 
diff --git a/progs64/VSUpile/simple_verif_pile.v b/progs64/VSUpile/simple_verif_pile.v
index e1e6de4aca..d3580f2b2b 100644
--- a/progs64/VSUpile/simple_verif_pile.v
+++ b/progs64/VSUpile/simple_verif_pile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import pile.
 Require Import simple_spec_stdlib.
@@ -37,11 +38,12 @@ if_tac.
 { subst.
   forward_if False.
   - forward_call 1. contradiction.
-  - congruence. }
+  - congruence.
+  - Intros. contradiction. }
 forward_if True.
 + contradiction.
-+ forward. entailer!.
-+ forward. Exists p. entailer!.
++ forward. entailer!!.
++ forward. Exists p. entailer!!.
 Qed.
 
 Lemma body_Pile_new: semax_body PileVprog PileGprog f_Pile_new Pile_new_spec.
@@ -50,8 +52,6 @@ start_function.
 forward_call (tpile, gv).
 Intros p.
 repeat step!.
-unfold pilerep, listrep, pile_freeable.
-repeat step!.
 Qed.
 
 Lemma body_Pile_add: semax_body PileVprog PileGprog f_Pile_add Pile_add_spec.
@@ -69,7 +69,7 @@ unfold pilerep.
 Exists q.
 unfold listrep at 2; fold listrep.
 Exists head.
-entailer!; try apply derives_refl.
+entailer!!.
 Qed.
 
 Lemma body_Pile_count: semax_body PileVprog PileGprog f_Pile_count Pile_count_spec.
@@ -94,7 +94,7 @@ forward_loop (EX r:val, EX s2: list Z,
 -
 Exists head sigma.
 entailer!. rewrite Z.sub_diag. auto.
-apply wand_sepcon_adjoint. cancel.
+rewrite <- wand_sepcon_adjoint. cancel.
 -
 Intros r s2.
 forward_if (r<>nullval).
@@ -105,8 +105,8 @@ forward.
 entailer!.
 assert (s2=nil) by intuition; subst s2.
 simpl. rewrite Z.sub_0_r; auto.
-sep_apply (modus_ponens_wand (listrep s2 nullval)).
-cancel.
+rewrite sepcon_comm.
+apply modus_ponens_wand.
 Intros.
 destruct s2.
 assert_PROP False; [ | contradiction]. {
@@ -138,10 +138,11 @@ simpl in H0.
  }
  rep_lia.
  f_equal; f_equal; lia.
-apply -> wand_sepcon_adjoint.
-match goal with |- (_ * ?A * ?B * ?C)%logic |-- _ => 
- assert ((A * B * C)%logic |-- listrep (z::s2) r) end.
-unfold listrep at 2; fold listrep. Exists r'. entailer!.
+rewrite <- wand_sepcon_adjoint.
+rewrite <- !sepcon_assoc.
+match goal with |- (_ ∗ ?A ∗ ?B ∗ ?C) ⊢ _ => 
+ assert (A ∗ B ∗ C ⊢ listrep (z::s2) r) end.
+unfold listrep at 2; fold listrep. Exists r'. entailer!!.
 sep_apply H10.
 sep_apply modus_ponens_wand.
 auto.
@@ -188,8 +189,8 @@ unfold listrep.
 entailer!.
 Qed.
 
-Definition PileVSU: @VSU NullExtension.Espec 
-      nil pile_imported_specs ltac:(QPprog prog) PileASI emp.
+Definition PileVSU: VSU
+      nil pile_imported_specs ltac:(QPprog prog) PileASI (fun _ => emp).
   Proof. 
     mkVSU prog pile_internal_specs.
     + solve_SF_internal body_surely_malloc.
diff --git a/progs64/VSUpile/simple_verif_stdlib.v b/progs64/VSUpile/simple_verif_stdlib.v
index 142f161947..d19930eeab 100644
--- a/progs64/VSUpile/simple_verif_stdlib.v
+++ b/progs64/VSUpile/simple_verif_stdlib.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import VST.floyd.library. (*for body_lemma_of_funspec *)
 Require Import stdlib.
@@ -9,15 +10,12 @@ Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Axiom mem_mgr_rep: forall gv, emp |-- mem_mgr gv.
 
 Parameter body_malloc:
- forall {Espec: OracleKind} {cs: compspecs} ,
    VST.floyd.library.body_lemma_of_funspec EF_malloc (snd malloc_spec').
 
 Parameter body_free:
- forall {Espec: OracleKind} {cs: compspecs} ,
    VST.floyd.library.body_lemma_of_funspec EF_free (snd free_spec').
 
 Parameter body_exit:
- forall {Espec: OracleKind},
   VST.floyd.library.body_lemma_of_funspec
     (EF_external "exit" (mksignature (Xint :: nil) Xvoid cc_default))
     (snd (exit_spec)).
@@ -30,7 +28,7 @@ Definition placeholder_spec :=
  POST [ tint ]
    PROP() LOCAL() SEP().
 
-Definition MF_imported_specs:funspecs :=  nil.
+Definition MF_imported_specs: funspecs :=  nil.
 
 Definition MF_internal_specs: funspecs := placeholder_spec::MallocFreeASI.
 
@@ -55,30 +53,31 @@ Lemma semax_func_cons_malloc_aux {cs: compspecs} (gv: globals) (gx : genviron) (
     (make_ext_rval gx (rettype_of_type (tptr tvoid)) ret) |-- !! is_pointer_or_null (force_val ret).
 Proof.
  intros.
- rewrite exp_unfold. Intros p.
+ monPred.unseal. Intros p.
  rewrite <- insert_local.
- rewrite lower_andp.
- apply derives_extract_prop; intro.
+ monPred.unseal.
+ apply bi.pure_elim_l; intro.
  destruct H; unfold_lift in H.
  unfold_lift in H0. destruct ret; try contradiction.
  unfold eval_id in H. simpl in H. subst p.
  if_tac. rewrite H; entailer!.
- renormalize. entailer!.
+ renormalize. monPred.unseal. entailer!.
 Qed.
 
 Definition MF_E : funspecs := MallocFreeASI.
 
-Definition MallocFreeVSU: @VSU NullExtension.Espec
+Definition MallocFreeVSU: VSU
         MF_E MF_imported_specs ltac:(QPprog prog) MallocFreeASI mem_mgr.
   Proof. 
     mkVSU prog MF_internal_specs. 
     - solve_SF_internal body_placeholder.
-    - solve_SF_external (@body_malloc NullExtension.Espec CompSpecs). 
+    - solve_SF_external body_malloc. 
       Intros. eapply derives_trans.
+      destruct x as [n gv].
       apply (semax_func_cons_malloc_aux gv gx ret n).
       destruct ret; simpl; trivial.
-    - solve_SF_external (@body_free NullExtension.Espec CompSpecs).
-    - solve_SF_external (@body_exit NullExtension.Espec).
+    - solve_SF_external body_free.
+    - solve_SF_external body_exit.
     - apply MF_Init.
 Qed.
 
diff --git a/progs64/VSUpile/simple_verif_triang.v b/progs64/VSUpile/simple_verif_triang.v
index 4ca4d93d07..2a6855e17d 100644
--- a/progs64/VSUpile/simple_verif_triang.v
+++ b/progs64/VSUpile/simple_verif_triang.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import triang.
 Require Import simple_spec_stdlib.
@@ -22,12 +23,12 @@ forward_for_simple_bound n
    PROP() LOCAL(temp _p p; temp _n (Vint (Int.repr n)); gvars gv)
    SEP (pilerep (decreasing (Z.to_nat i)) p; pile_freeable p; mem_mgr gv)).
 -
- entailer!.
+ entailer!!.
 - forward_call (p, i+1, decreasing(Z.to_nat i), gv).
-entailer!.
+entailer!!.
 assert (Z.to_nat (i+1) = S (Z.to_nat i))
   by (rewrite <- Z2Nat.inj_succ by lia; f_equal).
-rewrite H2.
+rewrite H1.
 unfold decreasing; fold decreasing.
 rewrite inj_S.
 rewrite Z2Nat.id by lia.
@@ -37,7 +38,7 @@ forward_call (p, decreasing (Z.to_nat n)).
 apply sumlist_decreasing_bound; auto.
 forward_call (p, decreasing (Z.to_nat n), gv).
 forward.
-entailer!.
+entailer!!.
 f_equal; f_equal.
 clear.
 induction (Z.to_nat n).
@@ -45,8 +46,8 @@ reflexivity.
 simpl. congruence.
 Qed.
 
-Definition TriangVSU: @VSU NullExtension.Espec 
-      nil triang_imported_specs ltac:(QPprog prog) TriangASI emp.
+Definition TriangVSU: VSU 
+      nil triang_imported_specs ltac:(QPprog prog) TriangASI (fun _ => emp).
   Proof. 
     mkVSU prog triang_internal_specs. 
     + solve_SF_internal body_Triang_nth.
diff --git a/progs64/VSUpile/spec_apile.v b/progs64/VSUpile/spec_apile.v
index a606b849c8..a209364215 100644
--- a/progs64/VSUpile/spec_apile.v
+++ b/progs64/VSUpile/spec_apile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import apile.
 Require Import spec_stdlib.
 Require Import PileModel.
diff --git a/progs64/VSUpile/spec_main.v b/progs64/VSUpile/spec_main.v
index 7168f17a93..cd9c7f4433 100644
--- a/progs64/VSUpile/spec_main.v
+++ b/progs64/VSUpile/spec_main.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU. (* must have this or get wrong version of main_pre *)
 Require Import main.
 
diff --git a/progs64/VSUpile/spec_onepile.v b/progs64/VSUpile/spec_onepile.v
index 1727ce9b4a..87e7cc7a97 100644
--- a/progs64/VSUpile/spec_onepile.v
+++ b/progs64/VSUpile/spec_onepile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import onepile.
 Require Import spec_stdlib.
 Require Import PileModel.
diff --git a/progs64/VSUpile/spec_pile.v b/progs64/VSUpile/spec_pile.v
index e917609005..c71ebebddf 100644
--- a/progs64/VSUpile/spec_pile.v
+++ b/progs64/VSUpile/spec_pile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import pile.
 Require Import spec_stdlib.
 Require Import PileModel.
diff --git a/progs64/VSUpile/spec_pile_private.v b/progs64/VSUpile/spec_pile_private.v
index e229fa7379..201a904813 100644
--- a/progs64/VSUpile/spec_pile_private.v
+++ b/progs64/VSUpile/spec_pile_private.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import pile.
 Require Import spec_stdlib.
 Require Import spec_pile.
diff --git a/progs64/VSUpile/spec_stdlib.v b/progs64/VSUpile/spec_stdlib.v
index fb50c36b92..cf26c0526d 100644
--- a/progs64/VSUpile/spec_stdlib.v
+++ b/progs64/VSUpile/spec_stdlib.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import stdlib.
 
 Local Open Scope assert.
@@ -30,7 +31,7 @@ Lemma malloc_token_local_facts:  forall {cs: compspecs} M sh t p,
       malloc_token M sh t p |-- !! (field_compatible t [] p /\ malloc_compatible (sizeof t) p).
 Proof. intros.
  unfold malloc_token.
- normalize. rewrite prop_and.
+ normalize. rewrite pure_and.
  apply andp_right. apply prop_right; auto.
  apply malloc_token'_local_facts.
 Qed.
@@ -111,7 +112,8 @@ Lemma malloc_spec_sub:
    funspec_sub (snd malloc_spec') (snd (malloc_spec t)).
 Proof.
 do_funspec_sub. rename w into gv. clear H.
-Exists (sizeof t, gv) emp. simpl; entailer!.
+rewrite <- fupd_intro.
+Exists (sizeof t, gv) (emp: mpred). simpl; entailer!.
 intros tau ? ?. Exists (eval_id ret_temp tau).
 entailer!.
 if_tac; auto.
@@ -128,7 +130,8 @@ Lemma free_spec_sub:
    funspec_sub (snd free_spec') (snd (free_spec t)).
 Proof.
 do_funspec_sub. destruct w as [p gv]. clear H.
-Exists (sizeof t, p, gv) emp. simpl; entailer!.
+rewrite <- fupd_intro.
+Exists (sizeof t, p, gv) (emp:mpred). simpl; entailer!.
 if_tac; trivial.
 sep_apply data_at__memory_block_cancel.
 unfold malloc_token; entailer!.
diff --git a/progs64/VSUpile/spec_triang.v b/progs64/VSUpile/spec_triang.v
index b937e26212..b5ea992c84 100644
--- a/progs64/VSUpile/spec_triang.v
+++ b/progs64/VSUpile/spec_triang.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import triang.
 Require Import spec_stdlib.
 Require Import PileModel.
diff --git a/progs64/VSUpile/verif_apile.v b/progs64/VSUpile/verif_apile.v
index 248177a9b9..a188000859 100644
--- a/progs64/VSUpile/verif_apile.v
+++ b/progs64/VSUpile/verif_apile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import apile.
 Require Import spec_stdlib.
@@ -72,7 +73,7 @@ forward.
 entailer!. simpl. unfold apile. entailer!.
 Qed. 
 
-Definition ApileVSU: @VSU NullExtension.Espec
+Definition ApileVSU: VSU
       nil apile_imported_specs ltac:(QPprog prog) Apile_ASI (apile nil).
 Proof.
  mkVSU prog apile_internal_specs.
diff --git a/progs64/VSUpile/verif_core.v b/progs64/VSUpile/verif_core.v
index e4eb6772c7..876d436341 100644
--- a/progs64/VSUpile/verif_core.v
+++ b/progs64/VSUpile/verif_core.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 
 Require Import VST.floyd.linking.
diff --git a/progs64/VSUpile/verif_main.v b/progs64/VSUpile/verif_main.v
index 6f69c5873f..12f0e6b99c 100644
--- a/progs64/VSUpile/verif_main.v
+++ b/progs64/VSUpile/verif_main.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.veric.initial_world.
 Require Import VST.floyd.VSU.
 
@@ -36,7 +37,7 @@ forward_call (i+1, decreasing(Z.to_nat i), gv).
 unfold APILE, MEM_MGR, ONEPILE; cancel.
 forward_call (i+1, decreasing(Z.to_nat i), gv).
 rewrite decreasing_inc by lia.
-entailer!.
+entailer!!.
 unfold APILE, MEM_MGR, ONEPILE; simpl; cancel.
 -
 forward_call (decreasing (Z.to_nat 10), gv).
@@ -48,7 +49,7 @@ forward_call (10,gv).
 forward.
 Qed.
 
-Definition MainComp:  MainCompType nil main_QPprog Core_VSU whole_prog (snd (main_spec whole_prog))  emp.
+Definition MainComp:  MainCompType nil main_QPprog Core_VSU whole_prog (snd (main_spec whole_prog)) (fun _ => emp).
 Proof.
 mkComponent prog.
 solve_SF_internal body_main.
diff --git a/progs64/VSUpile/verif_onepile.v b/progs64/VSUpile/verif_onepile.v
index de3f5c1d54..6bd7364091 100644
--- a/progs64/VSUpile/verif_onepile.v
+++ b/progs64/VSUpile/verif_onepile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import onepile.
 Require Import spec_stdlib.
@@ -88,7 +89,7 @@ Qed.
          rewrite sepcon_emp.
     destruct H as [b Hb]; rewrite Hb in *.
     eapply derives_trans. 
-    + apply mapsto_zeros_memory_block. apply writable_readable. apply writable_Ews.
+    + apply mapsto_zeros_memory_block.
     + rewrite <- memory_block_data_at_; simpl; trivial.
       apply headptr_field_compatible; trivial. exists b; trivial. cbv; trivial. simpl; rep_lia.
       econstructor. reflexivity. apply Z.divide_0_r.
@@ -98,7 +99,7 @@ Qed.
   Lemma onepile_Init: VSU_initializer prog (one_pile None).
   Proof. InitGPred_tac. unfold one_pile. normalize. apply data_at_data_at_. Qed.
 
-Definition OnepileVSU: @VSU NullExtension.Espec
+Definition OnepileVSU: VSU
       nil onepile_imported_specs ltac:(QPprog prog) Onepile_ASI (one_pile None).
 Proof.
  mkVSU prog onepile_internal_specs.
diff --git a/progs64/VSUpile/verif_pile.v b/progs64/VSUpile/verif_pile.v
index 755f2227e8..edb03d8a85 100644
--- a/progs64/VSUpile/verif_pile.v
+++ b/progs64/VSUpile/verif_pile.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import pile.
 Require Import spec_stdlib.
@@ -96,11 +97,12 @@ if_tac.
 { subst.
   forward_if False.
   - forward_call 1. contradiction.
-  - congruence. }
+  - congruence.
+  - Intros. contradiction. }
 forward_if True.
 + contradiction.
-+ forward. entailer!.
-+ forward. Exists p. entailer!.
++ forward. entailer!!.
++ forward. Exists p. entailer!!.
 Qed.
 
 Lemma body_Pile_new: semax_body PileVprog PileGprog f_Pile_new (Pile_new_spec M PILE).
@@ -108,10 +110,11 @@ Proof.
 start_function.
 forward_call (tpile, gv).
 Intros p.
-repeat step!.
-simpl spec_pile.pilerep.
-unfold prep, listrep, pile_freeable.
-repeat step!.
+step. step. step.
+Exists p.
+entailer!!.
+simpl.
+unfold prep, listrep. Exists nullval. entailer!!. 
 Qed.
 
 Lemma body_Pile_add: semax_body PileVprog PileGprog f_Pile_add (Pile_add_spec M PILE).
@@ -129,7 +132,7 @@ simpl pilerep; unfold prep.
 Exists q.
 unfold listrep at 2; fold listrep.
 Exists head.
-entailer!; try apply derives_refl.
+entailer!!. apply derives_refl.
 Qed.
 
 Lemma body_Pile_count: semax_body PileVprog PileGprog f_Pile_count (Pile_count_spec PILE).
@@ -154,7 +157,7 @@ forward_loop (EX r:val, EX s2: list Z,
 -
 Exists head sigma.
 entailer!. rewrite Z.sub_diag. auto.
-apply wand_sepcon_adjoint. cancel.
+rewrite <- wand_sepcon_adjoint. cancel.
 -
 Intros r s2.
 forward_if (r<>nullval).
@@ -165,8 +168,7 @@ forward.
 entailer!.
 assert (s2=nil) by intuition; subst s2.
 simpl. rewrite Z.sub_0_r; auto.
-sep_apply (modus_ponens_wand (listrep M s2 nullval)).
-cancel.
+rewrite sepcon_comm. apply modus_ponens_wand.
 Intros.
 destruct s2.
 assert_PROP False; [ | contradiction]. {
@@ -198,9 +200,10 @@ simpl in H0.
  }
  rep_lia.
  f_equal; f_equal; lia.
-apply -> wand_sepcon_adjoint.
-match goal with |- (_ * ?A * ?B * ?C)%logic |-- _ => 
- assert ((A * B * C)%logic |-- listrep M (z::s2) r) end.
+rewrite <- wand_sepcon_adjoint.
+rewrite <- !sepcon_assoc.
+match goal with |- _ ∗ ?A ∗ ?B ∗ ?C ⊢ _ => 
+ assert (A ∗ B ∗ C ⊢ listrep M (z::s2) r) end.
 unfold listrep at 2; fold (listrep M). Exists r'. entailer!.
 sep_apply H10.
 sep_apply modus_ponens_wand.
@@ -249,8 +252,8 @@ entailer!.
 Qed.
 
 
-Definition PileVSU: @VSU NullExtension.Espec
-           nil pile_imported_specs ltac:(QPprog prog) Pile_ASI emp.
+Definition PileVSU: VSU
+           nil pile_imported_specs ltac:(QPprog prog) Pile_ASI (fun _ => emp).
  Proof. 
     mkVSU prog pile_internal_specs.
     + solve_SF_internal body_surely_malloc.
@@ -260,8 +263,8 @@ Definition PileVSU: @VSU NullExtension.Espec
     + solve_SF_internal body_Pile_free.
   Qed.
 
-Definition PilePrivateVSU: @VSU NullExtension.Espec
-      nil pile_imported_specs ltac:(QPprog prog) (PilePrivateASI M PILEPRIV) emp.
+Definition PilePrivateVSU: VSU
+      nil pile_imported_specs ltac:(QPprog prog) (PilePrivateASI M PILEPRIV) (fun _ => emp).
  Proof. 
     mkVSU prog pile_internal_specs.
     + solve_SF_internal body_surely_malloc.
diff --git a/progs64/VSUpile/verif_stdlib.v b/progs64/VSUpile/verif_stdlib.v
index 8969abeea2..6eb559487e 100644
--- a/progs64/VSUpile/verif_stdlib.v
+++ b/progs64/VSUpile/verif_stdlib.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import VST.floyd.library. (*for body_lemma_of_funspec *)
 Require Import stdlib.
@@ -11,15 +12,12 @@ Parameter M: MallocFreeAPD.
 Axiom mem_mgr_rep: forall gv, emp |-- mem_mgr M gv.
 
 Parameter body_malloc:
- forall {Espec: OracleKind} {cs: compspecs} ,
    VST.floyd.library.body_lemma_of_funspec EF_malloc (snd (malloc_spec' M)).
 
 Parameter body_free:
- forall {Espec: OracleKind} {cs: compspecs} ,
    VST.floyd.library.body_lemma_of_funspec EF_free (snd (free_spec' M)).
 
 Parameter body_exit:
- forall {Espec: OracleKind},
   VST.floyd.library.body_lemma_of_funspec
     (EF_external "exit" (mksignature (Xint :: nil) Xvoid cc_default))
     (snd (exit_spec)).
@@ -34,7 +32,7 @@ Definition placeholder_spec :=
 
   Definition MF_ASI: funspecs := MallocFreeASI M.
 
-  Definition MF_imported_specs:funspecs :=  nil.
+  Definition MF_imported_specs: funspecs :=  nil.
 
   Definition MF_internal_specs: funspecs := placeholder_spec::MF_ASI.
 
@@ -59,30 +57,30 @@ Lemma semax_func_cons_malloc_aux {cs: compspecs} (gv: globals) (gx : genviron) (
     (make_ext_rval gx (rettype_of_type (tptr tvoid)) ret) |-- !! is_pointer_or_null (force_val ret).
 Proof.
  intros.
- rewrite exp_unfold. Intros p.
+ monPred.unseal. Intros p.
  rewrite <- insert_local.
- rewrite lower_andp.
- apply derives_extract_prop; intro.
+ monPred.unseal.
+ apply bi.pure_elim_l; intro.
  destruct H; unfold_lift in H.
  unfold_lift in H0. destruct ret; try contradiction.
  unfold eval_id in H. simpl in H. subst p.
  if_tac. rewrite H; entailer!.
- renormalize. entailer!.
+ renormalize. monPred.unseal. entailer!.
 Qed.
 
-
 Definition MF_E : funspecs := MF_ASI.
 
-Definition MallocFreeVSU: @VSU NullExtension.Espec
+Definition MallocFreeVSU: VSU
          MF_E MF_imported_specs ltac:(QPprog prog) MF_ASI (mem_mgr M).
-  Proof. 
+  Proof.
     mkVSU prog MF_internal_specs.
     - solve_SF_internal body_placeholder.
-    - solve_SF_external (@body_malloc NullExtension.Espec CompSpecs). 
+    - solve_SF_external body_malloc. 
       Intros. eapply derives_trans.
+      destruct x as [n gv].
       apply (semax_func_cons_malloc_aux gv gx ret n).
       destruct ret; simpl; trivial.
-    - solve_SF_external (@body_free NullExtension.Espec CompSpecs).
-    - solve_SF_external (@body_exit NullExtension.Espec).
+    - solve_SF_external body_free.
+    - solve_SF_external body_exit.
     - apply MF_Init.
 Qed.
diff --git a/progs64/VSUpile/verif_triang.v b/progs64/VSUpile/verif_triang.v
index 472d735518..02c2161ad2 100644
--- a/progs64/VSUpile/verif_triang.v
+++ b/progs64/VSUpile/verif_triang.v
@@ -1,4 +1,5 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.floyd.VSU.
 Require Import triang.
 Require Import spec_stdlib.
@@ -31,10 +32,10 @@ forward_for_simple_bound n
 -
  entailer!.
 - forward_call (p, i+1, decreasing(Z.to_nat i), gv).
-entailer!.
+entailer!!.
 assert (Z.to_nat (i+1) = S (Z.to_nat i))
   by (rewrite <- Z2Nat.inj_succ by lia; f_equal).
-rewrite H2.
+rewrite H1.
 unfold decreasing; fold decreasing.
 rewrite inj_S.
 rewrite Z2Nat.id by lia.
@@ -44,7 +45,7 @@ forward_call (p, decreasing (Z.to_nat n)).
 apply sumlist_decreasing_bound; auto.
 forward_call (p, decreasing (Z.to_nat n), gv).
 forward.
-entailer!.
+entailer!!.
 f_equal; f_equal.
 clear.
 induction (Z.to_nat n).
@@ -53,8 +54,8 @@ simpl. congruence.
 Qed.
 
  
-Definition TriangVSU: @VSU NullExtension.Espec
-      nil triang_imported_specs ltac:(QPprog prog) (TriangASI M) emp.
+Definition TriangVSU: VSU
+      nil triang_imported_specs ltac:(QPprog prog) (TriangASI M) (fun _ => emp).
 Proof.
   mkVSU prog triang_internal_specs.
     + solve_SF_internal body_Triang_nth.
diff --git a/progs64/dry_mem_lemmas.v b/progs64/dry_mem_lemmas.v
index 1e7219d928..9c8fbab6f8 100644
--- a/progs64/dry_mem_lemmas.v
+++ b/progs64/dry_mem_lemmas.v
@@ -1,11 +1,8 @@
 Require Import VST.veric.juicy_mem.
-Require Import VST.veric.compcert_rmaps.
 Require Import VST.veric.initial_world.
-Require Import VST.veric.ghost_PCM.
 Require Import VST.veric.SequentialClight.
 Require Import VST.veric.mem_lessdef.
 Require Import VST.floyd.proofauto.
-Import Maps.
 
 (* functions on byte arrays and CompCert mems *)
 Lemma drop_alloc m : { m' | (let (m1, b) := Mem.alloc m 0 1 in Mem.drop_perm m1 b 0 1 Nonempty) = Some m' }.
@@ -37,414 +34,110 @@ Proof.
   if_tac; if_tac; constructor || contradiction.
 Qed.
 
-Lemma nth_nil : forall {A} n (d : A), nth n nil d = d.
-Proof.
-  destruct n; auto.
-Qed.
-
-Lemma ghost_join_nth : forall (a b c : ghost) n, join a b c ->
-  join (nth n a None) (nth n b None) (nth n c None).
-Proof.
-  intros; revert n; induction H; intro; rewrite ?nth_nil; try constructor.
-  destruct n; eauto.
-Qed.
-
-Lemma ext_ghost_join : forall {Z} (z : Z) (p : preds) b c, join (Some (ext_ghost z, p)) b c ->
-  (c = Some (ext_ghost z, p) /\ (forall d, join (Some (existT _ (ext_PCM Z) d, p)) b (Some (existT _ (ext_PCM Z) d, p)))) \/
-  (b = Some (ext_ref z, p) /\ c = Some (ext_both z, p)).
-Proof.
-  intros.
-  inv H; auto.
-  { left; split; auto.
-    intros; constructor. }
-  destruct a2, a3, H1 as (? & ? & ?); simpl in *; subst.
-  inv H.
-  inj_pair_tac.
-  destruct b0, c0, H4 as [J1 J2]; simpl in *.
-  assert (o0 = o) by (inv J2; auto); subst; clear J2.
-  destruct g as [(?, ?)|], g0 as [(?, ?)|]; try contradiction.
-  { destruct J1 as (? & ? & ?%join_Tsh & ?); tauto. }
-  inv J1.
-  destruct o.
-  - right.
-    destruct vc as (? & d & J); hnf in J.
-    destruct d as [(?, ?)|].
-    { exfalso; destruct J as (? & ? & ?%join_Tsh & ?); tauto. }
-    injection J as ?; subst.
-    unfold ext_ref, ext_both; split; repeat f_equal.
-  - left; split; [unfold ext_ghost; repeat f_equal|].
-    intros; repeat constructor; simpl.
-    destruct d; repeat constructor; simpl.
-    destruct x as ([(?, ?)|], ?); simpl; auto.
-Qed.
-
-(*Lemma has_ext_join : forall {Z} phi1 phi2 phi3 (z1 z2 : Z) (Hext : nth O (ghost_of phi1) None = Some (ext_ghost z1, NoneP))
-  (Hj : join phi1 phi2 phi3) (Hrest : joins (ghost_of phi3) [Some (ext_ref z2, NoneP)]),
-  z1 = z2 /\ nth O (ghost_of phi3) None = Some (ext_ghost z1, NoneP).
-Proof.
-  simpl; intros.
-  apply ghost_of_join, ghost_join_nth with (n := O) in Hj.
-  rewrite Hext in Hj.
-  destruct Hrest as [? Hrest].
-  apply ghost_join_nth with (n := O) in Hrest.
-  inv Hj.
-  - split; auto.
-    rewrite <- H2 in Hrest; inv Hrest.
-    destruct a3; inv H4; simpl in *.
-    inv H; repeat inj_pair_tac.
-    destruct c0; inv H8; simpl in *.
-    inv H4.
-    destruct g as [[]|]; try contradiction.
-    inv H.
-    destruct vc as (? & [[]|] & vc); hnf in vc; try congruence.
-    clear - vc; destruct vc as (? & ? & ?%join_Tsh & ?); tauto.
-  - rewrite <- H1 in Hrest; inv Hrest.
-    destruct a3, a4; inv H5; simpl in *.
-    inv H3.
-    destruct a2; inv H2; simpl in *.
-    inv H3; inj_pair_tac.
-    inv H; repeat inj_pair_tac.
-    destruct b0, c0; inv H9; simpl in *.
-    destruct c1; inv H8; simpl in *.
-    destruct g as [[]|], g0 as [[]|]; try contradiction.
-    { destruct H as (? & ? & ?%join_Tsh & ?); tauto. }
-    inv H.
-    inv H6; [|inv H8].
-    assert (o = None) by (inv H2; auto); subst.
-    destruct o1 as [[]|]; inv H3.
-    split.
-    + destruct vc0 as (? & [[]|] & vc0); hnf in vc0; try congruence.
-      clear - vc0; destruct vc0 as (? & ? & ?%join_Tsh & ?); tauto.
-    + unfold ext_ghost; simpl; repeat f_equal; apply proof_irr.
-Qed.*)
-
-Lemma no_two_ref : forall {Z} (a b : Z) (pa pb : preds),
-  ~joins (Some (ext_both a, pa)) (Some (ext_ref b, pb)).
-Proof.
-  intros ????? [? J].
-  inv J.
-  destruct H1 as [J _]; simpl in *.
-  inv J.
-  repeat inj_pair_tac.
-  destruct H0 as [_ J].
-  inv J.
-  inv H2.
-Qed.
-
-Lemma ghost_not_both : forall {Z} (a1 a2 : Z) (p1 p2 : preds),
-  Some (ext_ghost a1, p1) <> Some (ext_both a2, p2).
-Proof.
-  repeat intro.
-  assert (ext_ghost a1 = ext_both a2) as Heq by congruence.
-  unfold ext_ghost, ext_both in Heq; inj_pair_tac.
-  inv H0.
-Qed.
-
-Lemma change_ext : forall {Z} (a a' z : Z) (rest b c : ghost),
-  join (Some (ext_ghost a, NoneP) :: rest) b c ->
-  joins c [Some (ext_ref z, NoneP)] ->
-  join (Some (ext_ghost a', NoneP) :: rest) b (Some (ext_ghost a', NoneP) :: tl c).
-Proof.
-  intros.
-  inv H; [constructor|].
-  constructor; auto.
-  apply ext_ghost_join in H3 as [[]|[]]; subst; eauto.
-  destruct H0 as [? J]; inv J.
-  exfalso; eapply no_two_ref; eexists; eauto.
-Qed.
+Section mpred.
 
-Lemma change_has_ext : forall {Z} (a a' : Z) r rest H, app_pred (has_ext a) r ->
-  app_pred (has_ext a') (set_ghost r (Some (ext_ghost a', NoneP) :: rest) H).
-Proof.
-  intros; simpl in *.
-  destruct H0 as (p & ? & ?); exists p.
-  unfold set_ghost; rewrite resource_at_make_rmap, ghost_of_make_rmap.
-  split; auto.
-  exists (None :: rest); repeat constructor.
-  match goal with |- join ?a _ ?b => assert (a = b) as ->; [|constructor] end.
-  unfold ext_ghost; repeat f_equal.
-Qed.
+Context `{!VSTGS OK_ty Σ}.
 
-Lemma ext_ref_join : forall {Z} (z : Z), join (ext_ghost z) (ext_ref z) (ext_both z).
-Proof.
-  intros; repeat constructor.
-Qed.
-
-Lemma set_ghost_join : forall a c w1 w2 w (J : join w1 w2 w) H1 H,
-  join a (ghost_of w2) c ->
-  join (set_ghost w1 a H1) w2 (set_ghost w c H).
+Lemma has_ext_state : forall m (z z' : OK_ty),
+  state_interp m z ∗ <absorb> has_ext z' ⊢ ⌜z = z'⌝.
 Proof.
   intros.
-  destruct (join_level _ _ _ J).
-  apply resource_at_join2; unfold set_ghost; intros; rewrite ?level_make_rmap, ?resource_at_make_rmap, ?ghost_of_make_rmap; auto.
-  apply resource_at_join; auto.
+  iIntros "((_ & Hz) & >Hz')".
+  iDestruct (own_valid_2 with "Hz Hz'") as %?%@excl_auth_agree; done.
 Qed.
 
-Lemma age_rejoin : forall {Z} w1 w2 w w' (a a' z : Z) H (J : join w1 w2 w)
-  (Hc : joins (ghost_of w) [Some (ext_ref z, NoneP)])
-  (Hg1 : ghost_of w1 = Some (ext_ghost a, NoneP) :: tl (ghost_of w1))
-  (Hl' : (level w' <= level w)%nat)
-  (Hr' : forall l, w' @ l = resource_fmap (approx (level w')) (approx (level w')) (w @ l))
-  (Hg' : ghost_of w' = Some (ext_ghost a', NoneP) :: own.ghost_approx (level w') (tl (ghost_of w))),
-  join (age_to.age_to (level w') (set_ghost w1 (Some (ext_ghost a', NoneP) :: tl (ghost_of w1)) H)) (age_to.age_to (level w') w2) w'.
+Lemma change_ext_state : forall m (z z' : OK_ty),
+  state_interp m z ∗ has_ext z ⊢ |==> state_interp m z' ∗ has_ext z'.
 Proof.
   intros.
-  destruct (join_level _ _ _ J).
-  apply resource_at_join2.
-  - rewrite age_to.level_age_to; auto.
-    unfold set_ghost; rewrite level_make_rmap; lia.
-  - rewrite age_to.level_age_to; auto; lia.
-  - eapply age_to.age_to_join_eq in J; eauto.
-    intro loc; apply (resource_at_join _ _ _ loc) in J.
-    rewrite !age_to_resource_at.age_to_resource_at in *.
-    unfold set_ghost; rewrite resource_at_make_rmap.
-    rewrite Hr'; auto.
-  - rewrite !age_to_resource_at.age_to_ghost_of.
-    unfold set_ghost; rewrite ghost_of_make_rmap, Hg'.
-    apply ghost_of_join in J; rewrite Hg1 in J.
-    eapply change_ext in J; eauto.
-    apply ghost_fmap_join with (f := approx (level w'))(g := approx (level w')) in J.
-    apply J.
+  iIntros "(($ & Hz) & Hext)".
+  iMod (own_update_2 with "Hz Hext") as "($ & $)"; last done.
+  apply @excl_auth_update.
 Qed.
 
-Lemma memory_block_writable_perm : forall sh n b ofs r jm, writable_share sh ->
+Lemma memory_block_writable_perm : forall sh n b ofs m z, writable_share sh ->
   (0 <= ofs)%Z -> (Z.of_nat n + ofs < Ptrofs.modulus)%Z ->
-  app_pred (mapsto_memory_block.memory_block' sh n b ofs) r -> sepalg.join_sub r (m_phi jm) ->
-  Mem.range_perm (m_dry jm) b ofs (ofs + Z.of_nat n) Memtype.Cur Memtype.Writable.
+  state_interp m z ∗ <absorb> memory_block' sh n b ofs ⊢
+  ⌜Mem.range_perm m b ofs (ofs + Z.of_nat n) Memtype.Cur Memtype.Writable⌝.
 Proof.
   intros.
-  rewrite mapsto_memory_block.memory_block'_eq in H2 by auto.
-  unfold mapsto_memory_block.memory_block'_alt in H2.
-  destruct (readable_share_dec sh).
-  intros ??.
-  apply VALspec_range_e with (loc := (b, ofs0)) in H2 as [? Hb]; simpl; auto.
-  destruct H3 as [? J]; apply resource_at_join with (loc := (b, ofs0)) in J.
-  pose proof (juicy_mem_access jm (b, ofs0)) as Hperm.
-  rewrite Hb in J; inversion J; subst; simpl in *.
-  - rewrite <- H8 in Hperm; simpl in Hperm.
-    eapply access_at_writable, Hperm.
-    apply join_writable1 in RJ; auto.
-  - rewrite <- H8 in Hperm; simpl in Hperm.
-    eapply access_at_writable, Hperm.
-    apply join_writable1 in RJ; auto.
-  - apply shares.writable_readable in H; contradiction.
+  iIntros "((Hm & _) & >Hb)".
+  rewrite memory_block'_eq // /memory_block'_alt if_true; last auto.
+  destruct (eq_dec sh Share.top); first subst;
+    (iDestruct (VALspec_range_perm with "[$]") as %?; [by apply perm_of_freeable || by apply perm_of_writable|]);
+    simpl in *; iPureIntro; first eapply Mem.range_perm_implies; try done.
+  constructor.
 Qed.
 
-Lemma data_at__writable_perm : forall {cs : compspecs} sh t p r jm, writable_share sh ->
-  app_pred (@data_at_ cs sh t p) r -> sepalg.join_sub r (m_phi jm) ->
-  exists b ofs, p = Vptr b ofs /\
-    Mem.range_perm (m_dry jm) b (Ptrofs.unsigned ofs) (Ptrofs.unsigned ofs + sizeof t) Memtype.Cur Memtype.Writable.
+Local Transparent memory_block.
+
+Lemma data_at__writable_perm : forall {cs : compspecs} sh t p m z, writable_share sh ->
+  state_interp m z ∗ <absorb> data_at_ sh t p ⊢
+  ⌜exists b ofs, p = Vptr b ofs /\
+    Mem.range_perm m b (Ptrofs.unsigned ofs) (Ptrofs.unsigned ofs + sizeof t) Memtype.Cur Memtype.Writable⌝.
 Proof.
   intros.
-  rewrite data_at__memory_block in H0; destruct H0 as [[Hptr Hcompat] Hdata].
+  rewrite data_at__memory_block.
+  iIntros "(Hm & >((% & %) & Hp))".
   destruct p; try contradiction.
-  do 3 eexists; eauto.
-  destruct Hdata as [? Hblock].
-  eapply memory_block_writable_perm in Hblock; eauto;
-    rewrite ?Z2Nat.id, ?nat_of_Z_max, ?Z.max_l in * by (pose proof sizeof_pos t; lia); auto.
-  { apply Ptrofs.unsigned_range. }
-  { rewrite Z.add_comm; auto. }
-Qed.
-
-Lemma rebuild_same : forall jm,
-  juicy_mem_lemmas.rebuild_juicy_mem_fmap jm (m_dry jm) = resource_at (m_phi jm).
-Proof.
-  intros; extensionality l.
-  unfold juicy_mem_lemmas.rebuild_juicy_mem_fmap.
-  destruct (m_phi jm @ l) eqn: Hl; auto.
-  - if_tac; auto.
-    destruct jm; simpl in *.
-    rewrite (JMaccess l) in H.
-    rewrite Hl in H; simpl in H.
-    if_tac in H; inv H.
-  - destruct k; auto.
-    destruct jm; simpl in *.
-    if_tac.
-    + apply JMcontents in Hl as [-> ?]; subst; auto.
-    + contradiction H.
-      rewrite (JMaccess l), Hl; simpl.
-      unfold perm_of_sh.
-      if_tac; if_tac; try contradiction; constructor.
+  iExists _, _; iSplit; first done.
+  iDestruct "Hp" as "(% & Hp)".
+  iDestruct (memory_block_writable_perm with "[$Hm $Hp]") as %Hperm; [done | rep_lia..|].
+  rewrite Z2Nat.id in Hperm; auto.
+  pose proof (sizeof_pos t); lia.
 Qed.
 
-Lemma data_at__VALspec_range: forall {cs : compspecs} sh z b o (Hsh: readable_share sh),
-  @data_at_ cs sh (tarray tuchar z) (Vptr b o) |--
-  res_predicates.VALspec_range z sh (b, Ptrofs.unsigned o).
-Proof.
-  intros. rewrite derives_eq.
-  intros ? [(_ & _ & Hsize & _) H]; simpl in *.
-  rewrite data_at_rec_eq in H; simpl in H.
-  unfold default_val, unfold_reptype in H; simpl in H.
-  unfold at_offset in H; rewrite offset_val_zero_Vptr in H.
-  unfold Zrepeat in *.
-  destruct H as [_ H].
-  rewrite Z.sub_0_r, Z2Nat_max0 in H.
-  remember 0 as lo in H at 1.
-  remember (Z.to_nat z) as hi in H at 1.
-  remember (Z.to_nat z) as n in H.
-  assert (Z.to_nat lo + hi <= n)%nat by rep_lia.
-  assert (0 <= lo <= Ptrofs.max_unsigned) by rep_lia.
-  assert (Ptrofs.unsigned o + Z.of_nat n <= Ptrofs.max_unsigned).
-  { subst n; rewrite Z2Nat_id'; rep_lia. }
-  replace (Ptrofs.unsigned o) with (Ptrofs.unsigned o + lo) by lia.
-  clear Heqlo Heqn.
-  generalize dependent lo; generalize dependent z; revert a; induction hi; simpl in *.
-  - intros. setoid_rewrite res_predicates.emp_no in H. destruct b0 as (?, ?); if_tac; [|apply H; auto].
-    unfold adr_range in *. destruct (zlt 0 z); lia.
-  - intros.
-    destruct H as (? & ? & J & Hr1 & Hr2).
-    assert (lo < Z.of_nat n) by lia.
-    assert (z >= 1) by lia.
-    eapply IHhi with (z := z - 1) in Hr2.
-    instantiate (1 := b0) in Hr2.
-    rewrite data_at_rec_eq in Hr1; simpl in Hr1.
-    unfold unfold_reptype in Hr1; simpl in Hr1.
-    rewrite <- (Nat2Z.id n) in Hr1.
-    rewrite Znth_repeat_inrange in Hr1.
-    unfold mapsto in Hr1; simpl in Hr1.
-    rewrite if_true in Hr1 by auto.
-    destruct Hr1 as [[] | (_ & ? & ? & [? Hr1])]; [contradiction|].
-    rewrite Z.mul_1_l in *.
-    unfold Ptrofs.add in Hr1; rewrite !Ptrofs.unsigned_repr in Hr1; auto.
-    + rename b0 into l.
-        specialize (Hr1 l); simpl in *.
-        apply (resource_at_join _ _ _ l) in J.
-        destruct l as (b', o'); if_tac in Hr1; [|if_tac in Hr2].
-        * destruct H5; subst.
-          rewrite if_true.
-          destruct Hr1 as (? & Hr1); rewrite Hr1 in J.
-          rewrite if_false in Hr2.
-          apply join_comm, Hr2 in J; rewrite <- J; eauto.
-          { intros []; lia. }
-          { repeat split; auto; lia. }
-      * rewrite if_true.
-        apply Hr1 in J; rewrite <- J.
-        destruct Hr2 as (? & ? & ->); eauto.
-        { destruct H6; subst.
-          repeat split; auto; lia. }
-      * apply Hr1 in J as <-.
-        rewrite if_false; auto.
-        { fold (adr_range (b, Ptrofs.unsigned o + lo) z (b', o')).
-          replace z with (1 + (z - 1)) by lia.
-          intros X%adr_range_divide; try lia.
-          destruct X; try contradiction.
-          unfold Z.succ in *; rewrite Z.add_assoc in *; contradiction. }
-    + rewrite Ptrofs.unsigned_repr; auto; rep_lia.
-    + lia.
-    + lia.
-    + lia.
-    + lia.
-    + rep_lia.
-Qed.
-
-Lemma data_at_bytes : forall {CS : compspecs} sh z (bytes : list val) buf jm phi
-  (Hreadable : readable_share sh) (Hlen : z = Zlength bytes) (J : join_sub phi (m_phi jm))
-  (Hbuf : app_pred (data_at sh (tarray tuchar z) bytes buf) phi)
+Lemma data_at_bytes : forall {CS : compspecs} sh z (bytes : list val) buf m o
+  (Hreadable : readable_share sh) (Hlen : z = Zlength bytes)
   (Hdef : Forall (fun x => x <> Vundef) bytes),
-  match buf with
-  | Vptr b ofs =>
-      Mem.loadbytes (m_dry jm) b (Ptrofs.unsigned ofs) z =
-        Some (concat (map (encode_val Mint8unsigned) bytes))
-  | _ => False
- end.
+  state_interp m o ∗ <absorb> data_at sh (tarray tuchar z) bytes buf ⊢
+  ⌜match buf with
+   | Vptr b ofs =>
+       Mem.loadbytes m b (Ptrofs.unsigned ofs) z =
+         Some (concat (map (encode_val Mint8unsigned) bytes))
+   | _ => False
+   end⌝.
 Proof.
   intros.
-  destruct Hbuf as [(Hptr & _ & Hlim & _) Hbuf].
-  unfold at_offset in Hbuf.
-  destruct buf; try contradiction; simpl in Hbuf.
-  rewrite ptrofs_add_repr_0_r, data_at_rec_eq in Hbuf; simpl in Hbuf.
-  unfold unfold_reptype in *; simpl in *.
-  destruct Hbuf as [_ Hbuf].
-  rewrite Z.sub_0_r, Z.max_r in Hbuf by rep_lia.
-  clear Hptr.
-  erewrite <- (sublist_same _ _ bytes) by eauto.
-  rewrite <- (Z.add_0_r (Ptrofs.unsigned i)).
-  rewrite <- (Z.add_0_r z) at 2.
-  remember 0 as lo in |- *.
-  assert (0 <= lo) by lia.
-  rewrite <- Heqlo in Hbuf at 1.
-  remember (Z.to_nat z) as n.
-  rewrite <- (Z2Nat.id z), <- Heqn by rep_lia.
-  assert (lo + Z.of_nat n = Zlength bytes) by (subst; rewrite Z2Nat.id; rep_lia).
-  assert (Ptrofs.unsigned i + Zlength bytes < Ptrofs.modulus).
-  { rewrite Z.max_r in Hlim by rep_lia; lia. }
-  clear Heqlo Hlen.
-  clear dependent z.
-  generalize dependent phi; generalize dependent lo.
-  induction n; intros; subst.
-  - unfold sublist; simpl.
-    rewrite skipn_firstn,  Z.add_0_l, Nat.sub_diag.
-    apply Mem.loadbytes_empty; reflexivity.
-  - simpl in Hbuf.
-    destruct Hbuf as (phi0 & ? & J' & Hbyte & Hbytes).
-    rewrite Nat2Z.inj_succ in *.
-    apply IHn in Hbytes; try lia.
-    rewrite sublist_next by lia; simpl.
-    unfold Z.succ in *; rewrite (Z.add_comm _ 1) in *.
-    apply Mem.loadbytes_concat; try lia.
-    clear Hbytes.
-    unfold at_offset in Hbyte; simpl in Hbyte.
-    rewrite data_at_rec_eq in Hbyte; simpl in Hbyte.
-    unfold unfold_reptype, mapsto in Hbyte; simpl in Hbyte.
-    rewrite if_true in Hbyte by auto.
-    destruct Hbyte as [[? Hbyte] | [? Hbyte]].
-    destruct Hbyte as (mv & (? & Hdecode & _) & Hbyte); subst.
-    specialize (Hbyte (b, Ptrofs.unsigned i + lo)); simpl in Hbyte.
-    replace (Ptrofs.unsigned (Ptrofs.add _ _)) with (Ptrofs.unsigned i +lo) in Hbyte.
-    rewrite if_true in Hbyte by (split; auto; lia).
-    destruct Hbyte as [? Hval].
-    rewrite Z.sub_diag in Hval.
-    destruct mv; try discriminate.
-    unfold decode_val in Hdecode; simpl in *.
-    rewrite Z.sub_0_r in *.
-    apply (sublist.Forall_Znth _ _ lo) in Hdef; try lia.
-    setoid_rewrite <- Hdecode in Hdef.
-    destruct m; try contradiction; clear Hdef.
-    destruct mv; try discriminate; simpl in *.
-    setoid_rewrite <- Hdecode; simpl.
-    assert (join_sub phi0 (m_phi jm)) as [? J0].
-    { eapply join_sub_trans; [eexists|]; eauto. }
-    Transparent Mem.loadbytes.
-    unfold Mem.loadbytes.
-    Opaque Mem.loadbytes.
-    destruct jm; simpl in *.
-    assert (exists sh1 rsh1, phi1 @ (b, Ptrofs.unsigned i + lo) = YES sh1 rsh1 (VAL (Byte i0)) NoneP) as (? & ? & Hr).
-    { apply (resource_at_join _ _ _ (b, Ptrofs.unsigned i + lo)) in J0.
-      rewrite Hval in J0; inv J0; eauto. }
-    specialize (JMaccess (b, Ptrofs.unsigned i + lo)); rewrite Hr in JMaccess; simpl in JMaccess.
-    apply JMcontents in Hr as [Hr _].
-    rewrite if_true.
-    unfold contents_at in Hr; simpl in Hr.
-    rewrite Hr.
-    unfold decode_int; simpl.
-    rewrite rev_if_be_singleton; simpl.
-    assert (0 <= Byte.unsigned i0 <= Int.max_unsigned) by rep_lia.
-    rewrite Z.add_0_r, zero_ext_inrange, Int.unsigned_repr; auto.
-    unfold encode_int; simpl.
-    rewrite rev_if_be_singleton; simpl.
-    rewrite Byte.repr_unsigned; auto.
-    * rewrite Int.unsigned_repr by auto.
-      destruct (Byte.unsigned_range i0) as [_ Hmax].
-      unfold Byte.modulus in Hmax.
-      unfold Byte.wordsize, Wordsize_8.wordsize in Hmax.
-      rewrite two_power_nat_two_p in Hmax; simpl Z.of_nat in Hmax; lia.
-    * unfold Mem.range_perm; intros.
-      unfold Mem.perm.
-      assert (ofs = Ptrofs.unsigned i + lo) by lia; subst.
-      unfold access_at in JMaccess; simpl in JMaccess; rewrite JMaccess.
-      unfold perm_of_sh.
-      if_tac; if_tac; try constructor; contradiction.
-    * unfold Ptrofs.add.
-      setoid_rewrite Ptrofs.unsigned_repr at 2; [|rep_lia].
-      rewrite Ptrofs.unsigned_repr; rep_lia.
-    * apply (sublist.Forall_Znth _ _ (lo - 0)) in Hdef; try lia; contradiction.
-    * rewrite Z.add_assoc in *.
-      replace (1 + Z.of_nat n + lo) with (Z.of_nat n + (lo + 1)) by lia; auto.
-    * eapply join_sub_trans; [eexists|]; eauto.
+  assert_PROP (field_compatible (tarray tuchar z) [] buf).
+  { unfold data_at, field_at; iIntros "(_ & >($ & _))". }
+  destruct buf; try by destruct H.
+  remember (Z.to_nat z) as n; generalize dependent i; generalize dependent bytes; generalize dependent z; induction n; intros.
+  { assert (z = 0) as -> by rep_lia.
+    destruct bytes; last by autorewrite with sublist in *; rep_lia.
+    rewrite Mem.loadbytes_empty //; auto. }
+  rewrite (split2_data_at_Tarray_tuchar _ _ 1) // /=; last lia.
+  iIntros "(Hz & >(H & Hrest))".
+  destruct bytes; first by autorewrite with sublist in *; rep_lia.
+  inversion Hdef; clear Hdef.
+  autorewrite with sublist in Hlen.
+  rewrite /field_address0 if_true /=.
+  2: { rewrite field_compatible0_cons; split; auto; lia. }
+  rewrite sublist_1_cons (sublist_same _ (z - 1)) //; last lia.
+  iAssert ⌜field_compatible (tarray tuchar (z - 1)) [] (Vptr b (Ptrofs.add i (Ptrofs.repr 1)))⌝ with "[Hrest]" as %?.
+  { unfold data_at, field_at; iDestruct "Hrest" as "($ & _)". }
+  iDestruct (IHn with "[$Hz $Hrest]") as %Hrest; [lia || done..|].
+  iDestruct "Hz" as "(Hm & _)".
+  rewrite sublist_0_cons // sublist_nil data_at_tuchar_singleton_array_inv.
+  iAssert ⌜field_compatible tuchar [] (Vptr b i)⌝ with "[H]" as %?.
+  { unfold data_at, field_at; iDestruct "H" as "($ & _)". }
+  erewrite <-mapsto_data_at', mapsto_core_load by done.
+  iDestruct (core_load_load' with "[$Hm $H]") as %Hbyte.
+  apply Mem.load_loadbytes in Hbyte as (byte & Hbyte & ->); subst.
+  rewrite Ptrofs.add_unsigned !Ptrofs.unsigned_repr // in Hrest.
+  2: { destruct H as (? & ? & ? & ?); simpl in *; rep_lia. }
+  eapply Mem.loadbytes_concat in Hrest; eauto; [|lia..].
+  pose proof (Mem.loadbytes_length _ _ _ _ _ Hbyte) as Hlen; simpl in Hlen.
+  destruct byte as [|byte []]; [done | | done].
+  replace (encode_val _ (decode_val _ [byte])) with [byte].
+  replace (1 + (Z.succ (Zlength bytes) - 1)) with (Z.succ (Zlength bytes)) in Hrest by lia; done.
+  { destruct byte; try done.
+    rewrite decode_byte_val zero_ext_inrange /= Int.unsigned_repr; [|rep_lia..].
+    rewrite /encode_int /= Byte.repr_unsigned rev_if_be_singleton //. }
 Qed.
 
 (* up *)
-Lemma perm_order_antisym : forall p p', perm_order p p' -> perm_order p' p -> p = p'.
+Lemma perm_order_antisym' : forall p p', perm_order p p' -> perm_order p' p -> p = p'.
 Proof.
   inversion 1; auto; inversion 1; auto.
 Qed.
@@ -458,14 +151,14 @@ Proof.
   extensionality k.
   apply equal_f with b, equal_f with o, equal_f with k in Hperm.
   unfold access_at; simpl.
-  destruct (_ !! _).
+  destruct (_ !!! _).
   - pose proof (equal_f Hperm p) as Hp; simpl in *.
     pose proof (perm_refl p) as Hrefl; rewrite Hp in Hrefl.
-    destruct (_ !! _); [simpl in * | contradiction].
-    f_equal; apply perm_order_antisym; auto.
+    destruct (_ !!! _); [simpl in * | contradiction].
+    f_equal; apply perm_order_antisym'; auto.
     apply equal_f with p0 in Hperm.
     rewrite Hperm; apply perm_refl.
-  - destruct (_ !! _); auto.
+  - destruct (_ !!! _); auto.
     apply equal_f with p in Hperm; simpl in Hperm.
     pose proof (perm_refl p) as Hrefl; rewrite <- Hperm in Hrefl; contradiction.
 Qed.
@@ -480,7 +173,7 @@ Proof.
   Opaque Mem.loadbytes.
   apply equal_f with b, equal_f with o, equal_f with 1 in Hload.
   unfold contents_at; simpl.
-  rewrite 2if_true  in Hload.
+  rewrite !if_true in Hload.
   inv Hload; auto.
   { unfold Mem.range_perm.
     intros; assert (ofs = o) by lia; subst.
@@ -489,374 +182,103 @@ Proof.
     intros; assert (ofs = o) by lia; subst; auto. }
 Qed.
 
-Lemma mem_evolve_access : forall m1 m2, access_at m1 = access_at m2 -> mem_evolve m1 m2.
-Proof.
-  intros; unfold mem_evolve.
-  intro; rewrite H.
-  destruct (access_at _ _ _); auto.
-  destruct p; auto.
-Qed.
-
-Lemma mem_evolve_equiv1 : forall m1 m2 m1', mem_evolve m1 m2 -> mem_equiv m1 m1' -> mem_evolve m1' m2.
-Proof.
-  unfold mem_evolve; intros.
-  rewrite <- (mem_equiv_access _ _ H0); apply H.
-Qed.
-
-Lemma mem_evolve_equiv2 : forall m1 m2 m2', mem_evolve m1 m2 -> mem_equiv m2 m2' -> mem_evolve m1 m2'.
-Proof.
-  unfold mem_evolve; intros.
-  rewrite <- (mem_equiv_access _ _ H0); apply H.
-Qed.
-
-Definition mem_equiv_jm jm m (Heq : mem_equiv (m_dry jm) m) :
-  {jm' | level jm' = level jm /\ m_dry jm' = m /\ m_phi jm' = m_phi jm}.
-Proof.
-  destruct jm; simpl in *.
-  unshelve eexists (mkJuicyMem m phi _ _ _ _); simpl; auto.
-  - unfold contents_cohere in *; intros.
-    destruct (JMcontents _ _ _ _ _ H) as []; subst; split; auto.
-    symmetry; apply mem_equiv_contents; auto.
-    specialize (JMaccess loc).
-    rewrite H in JMaccess; simpl in JMaccess.
-    apply access_at_readable in JMaccess; auto.
-  - unfold access_cohere in *; intros.
-    erewrite <- JMaccess, <- mem_equiv_access; eauto.
-  - unfold max_access_cohere in *; intros.
-    unfold max_access_at in *.
-    erewrite <- mem_equiv_access; eauto.
-  - unfold alloc_cohere in *.
-    destruct Heq as (_ & _ & <-); auto.
-Defined.
-
-(* up *)
-Lemma has_ext_noat : forall {Z} (z : Z), has_ext z |-- ALL x : _, res_predicates.noat x.
-Proof.
-  intros; unfold has_ext, own.own.
-  change (@predicates_hered.exp rmap ag_rmap _) with (@exp mpred _).
-  apply exp_left; intro.
- unfold own.Own.
- change (@predicates_hered.andp rmap ag_rmap _) with (@andp mpred _).
-  apply andp_left1.
-  apply derives_refl.
-Qed.
-
-Lemma inflate_store_join1 : forall phi1 phi2 phi3 m (J : join phi1 phi2 phi3)
-  (Hno : app_pred (ALL x : _, res_predicates.noat x) phi1),
-  join phi1 (inflate_store m phi2) (inflate_store m phi3).
+Lemma mem_auth_equiv : forall m m' (Heq : mem_equiv m m'), mem_auth m ⊢ mem_auth m'.
 Proof.
   intros.
-  destruct (join_level _ _ _ J).
-  apply resource_at_join2; intros; unfold inflate_store;
-    rewrite ?level_make_rmap, ?resource_at_make_rmap, ?ghost_of_make_rmap; try apply ghost_of_join; auto.
-  apply (resource_at_join _ _ _ loc) in J.
-  specialize (Hno loc).
-  apply empty_NO in Hno as [Hno | (? & ? & Hno)]; rewrite Hno in *; inv J; try constructor; auto.
-  rewrite H0.
-  destruct k; constructor; auto.
-Qed.
-
-Lemma inflate_store_join : forall phi1 phi2 phi3 m (J : join phi1 phi2 phi3),
-  join (inflate_store m phi1) (inflate_store m phi2) (inflate_store m phi3).
-Proof.
-  intros.
-  destruct (join_level _ _ _ J) as [H1 H2].
-  apply resource_at_join2; intros; unfold inflate_store;
-    rewrite ?level_make_rmap, ?resource_at_make_rmap, ?ghost_of_make_rmap; try apply ghost_of_join; auto.
-  apply (resource_at_join _ _ _ loc) in J.
-  rewrite H1, H2.
-  inv J; try constructor; auto; destruct k; constructor; auto.
-Qed.
-
-Lemma rebuild_store : forall jm0 phi m m' b o lv phi0 phi1 loc
-  (Hlevel : (level phi <= level (m_phi jm0))%nat)
-  (Hrebuild : compcert_rmaps.R.resource_at phi =
-     compcert_rmaps.R.resource_fmap (compcert_rmaps.R.approx (level phi))
-       (compcert_rmaps.R.approx (level phi))
-     oo juicy_mem_lemmas.rebuild_juicy_mem_fmap jm0 m)
-  (Hstore : Mem.storebytes (m_dry jm0) b o lv = Some m') (Heq : mem_equiv m m')
-  (J : join phi0 phi1 (m_phi jm0))
-  (Hout1 : forall l sh rsh k p, phi1 @ l = YES sh rsh k p -> ~ adr_range (b, o) (Zlength lv) l),
-  join (age_to.age_to (level phi) (inflate_store m' phi0) @ loc)
-         (age_to.age_to (level phi) phi1 @ loc) (phi @ loc).
-Proof.
-  intros.
-  destruct (join_level _ _ _ J).
-  rewrite Hrebuild, !age_to_resource_at.age_to_resource_at.
-  unfold compose, inflate_store, juicy_mem_lemmas.rebuild_juicy_mem_fmap; rewrite !resource_at_make_rmap.
-  apply (resource_at_join _ _ _ loc) in J.
-  simpl.
-  inv J; try constructor.
-  - rewrite if_false; [constructor; auto|].
-    erewrite mem_equiv_access by eauto.
-    erewrite <- storebytes_access by eauto.
-    destruct jm0; simpl in *.
-    rewrite (JMaccess loc), <- H4; simpl.
-    if_tac; auto.
-    intro X; inv X.
-  - destruct k; try (rewrite resource_fmap_fmap, approx_oo_approx', approx'_oo_approx by lia; constructor; auto).
-    destruct jm0; simpl in *.
-    pose proof (JMaccess loc) as Haccess.
-    rewrite <- H4 in Haccess; simpl in Haccess.
-    erewrite storebytes_access, <- mem_equiv_access in Haccess by eauto.
-    destruct loc as (b', o').
-    erewrite <- mem_equiv_contents; eauto.
-    rewrite Haccess, if_true.
-    constructor; auto.
-    { unfold perm_of_sh.
-      if_tac; if_tac; constructor || contradiction. }
-    { eapply access_at_readable; eauto. }
-  - destruct k; try (constructor; auto).
-    pose proof (juicy_mem_access jm0 loc) as Haccess.
-    rewrite <- H4 in Haccess; simpl in Haccess.
-    erewrite storebytes_access, <- mem_equiv_access in Haccess by eauto.
-    rewrite Haccess, if_true.
-    destruct loc as (b', o').
-    erewrite mem_equiv_contents; eauto.
-    exploit (juicy_mem_contents jm0); eauto; intros []; subst.
-    erewrite (storebytes_phi_elsewhere_eq _ _ _ _ _ Hstore); eauto.
-    constructor; auto.
-    { eapply access_at_readable; eauto. }
-    { unfold perm_of_sh.
-      if_tac; if_tac; constructor || contradiction. }
-  - destruct k; try (rewrite resource_fmap_fmap, approx_oo_approx', approx'_oo_approx by lia; constructor; auto).
-    pose proof (juicy_mem_access jm0 loc) as Haccess.
-    rewrite <- H4 in Haccess; simpl in Haccess.
-    erewrite storebytes_access, <- mem_equiv_access in Haccess by eauto.
-    rewrite Haccess, if_true.
-    destruct loc as (b', o').
-    erewrite (mem_equiv_contents m); eauto.
-    exploit (juicy_mem_contents jm0); eauto; intros []; subst.
-    erewrite (storebytes_phi_elsewhere_eq _ _ _ _ _ Hstore); eauto.
-    constructor; auto.
-    { eapply access_at_readable; eauto. }
-    { unfold perm_of_sh.
-      if_tac; if_tac; constructor || contradiction. }
-Qed.
-
-Lemma rebuild_alloc : forall jm0 phi m len phi0 phi1 loc
-  (Hlevel : (level phi <= level (m_phi jm0))%nat)
-  (Hrebuild : compcert_rmaps.R.resource_at phi =
-     compcert_rmaps.R.resource_fmap (compcert_rmaps.R.approx (level phi))
-       (compcert_rmaps.R.approx (level phi))
-     oo juicy_mem_lemmas.rebuild_juicy_mem_fmap jm0 m)
-  (Hno : forall ofs : Z,
-      phi0 @ (Mem.nextblock (m_dry jm0), ofs) = NO Share.bot bot_unreadable)
-  (Heq : mem_equiv m (fst (Mem.alloc (m_dry jm0) 0 len)))
-  (J : join phi0 phi1 (m_phi jm0)),
-  join (age_to.age_to (level phi) (after_alloc 0 len (Mem.nextblock (m_dry jm0)) phi0 Hno) @ loc)
-         (age_to.age_to (level phi) phi1 @ loc) (phi @ loc).
+  rewrite /mem_auth.
+  apply bi.exist_mono; intros σ.
+  iIntros "(%Hcoh & $)"; iPureIntro; split; last done.
+  unfold coherent in *.
+  intros loc; specialize (Hcoh loc).
+  unfold coherent_loc, contents_cohere, access_cohere in *;
+    destruct Hcoh as (Hnext & Hcontents & Haccess); split3.
+  - destruct Heq as (_ & _ & <-); done.
+  - intros.
+    destruct loc as (b, o); erewrite <- mem_equiv_contents; eauto.
+    rewrite /resource_at /resR_to_resource in H Haccess.
+    destruct (σ !! (b, o))%stdpp eqn: Hloc; rewrite Hloc // /= in H Haccess.
+    destruct s; inv H.
+    simpl in *.
+    destruct dq as [[]|]; try done; rewrite H1 /= in Haccess.
+    + rewrite perm_access.
+      eapply perm_order''_trans; eauto.
+      by apply perm_of_readable_share.
+    + if_tac in Haccess; try done.
+      rewrite perm_access.
+      eapply perm_order''_trans; eauto.
+  - erewrite <- mem_equiv_access; eauto.
+Qed.
+
+Lemma storebytes_nil : forall m b o m', Mem.storebytes m b o [] = Some m' ->
+  mem_equiv m m'.
+Proof.
+  intros; split3.
+  - by symmetry; do 3 extensionality; eapply mem_lemmas.loadbytes_storebytes_nil.
+  - rewrite /Mem.perm.
+    by do 4 extensionality; erewrite <- Mem.storebytes_access.
+  - by erewrite <- Mem.nextblock_storebytes.
+Qed.
+
+Lemma data_at__storebytes : forall {CS : compspecs} m m' sh z b o lv (Hsh : writable_share sh)
+  (Hty : Forall (tc_val' tuchar) lv)
+  (Hstore : Mem.storebytes m b (Ptrofs.unsigned o) (concat (map (encode_val Mint8unsigned) lv)) = Some m')
+  (Hz : z = Zlength lv),
+  mem_auth m ∗ data_at_ sh (tarray tuchar z) (Vptr b o) ⊢ |==>
+  mem_auth m' ∗ data_at sh (tarray tuchar z) lv (Vptr b o).
 Proof.
   intros.
-  destruct (join_level _ _ _ J).
-  rewrite Hrebuild, !age_to_resource_at.age_to_resource_at.
-  unfold compose, after_alloc, juicy_mem_lemmas.rebuild_juicy_mem_fmap; rewrite !resource_at_make_rmap.
-  unfold after_alloc'.
-  apply (resource_at_join _ _ _ loc) in J.
-  assert (Mem.alloc (m_dry jm0) 0 len = (fst (Mem.alloc (m_dry jm0) 0 len), Mem.nextblock (m_dry jm0))) as Halloc.
-  { destruct (Mem.alloc (m_dry jm0) 0 len) eqn: Halloc; simpl; f_equal.
-      eapply Mem.alloc_result; eauto. }
-  if_tac.
-  - (* allocated block *)
-    edestruct alloc_dry_updated_on as [Haccess Hcontents]; eauto.
-    destruct loc, H1; subst.
-    destruct jm0; simpl in *.
-    rewrite JMalloc in * by (simpl; Lia.lia).
-    inv J.
-    rewrite if_true.
-    erewrite mem_equiv_contents, Hcontents; try apply Heq.
-    apply join_Bot in RJ as []; subst.
-    constructor; auto.
-    { destruct Heq as (_ & -> & _).
-      eapply Mem.perm_implies; [eapply Mem.perm_alloc_2; eauto; lia | constructor]. }
-    { erewrite mem_equiv_access, Haccess by apply Heq; constructor. }
-  - edestruct alloc_dry_unchanged_on as [Haccess Hcontents]; eauto.
-    simpl.
-    inv J; try constructor.
-    + rewrite if_false; [constructor; auto|].
-      erewrite mem_equiv_access by eauto.
-      rewrite <- Haccess.
-      destruct jm0; simpl in *.
-      rewrite (JMaccess loc), <- H5; simpl.
-      if_tac; auto.
-      intro X; inv X.
-    + destruct k; try (constructor; auto).
-      destruct jm0; simpl in *.
-      pose proof (JMaccess loc) as Haccess'.
-      rewrite <- H5 in Haccess'; simpl in Haccess'.
-      erewrite Haccess, <- mem_equiv_access in Haccess' by eauto.
-      destruct loc as (b', o').
-      assert (Mem.perm_order'' (perm_of_sh sh3) (Some Readable)).
-      { unfold perm_of_sh.
-        if_tac; if_tac; constructor || contradiction. }
-      erewrite mem_equiv_contents; eauto.
-      rewrite Haccess', <- Hcontents, if_true; auto.
-      symmetry in H5; apply JMcontents in H5 as []; subst.
-      constructor; auto.
-      { rewrite JMaccess, <- H5; simpl.
-        unfold perm_of_sh.
-        if_tac; if_tac; auto; discriminate. }
-      { rewrite perm_access, Haccess'; auto. }
-    + destruct k; try (constructor; auto).
-      pose proof (juicy_mem_access jm0 loc) as Haccess'.
-      rewrite <- H5 in Haccess'; simpl in Haccess'.
-      erewrite Haccess, <- mem_equiv_access in Haccess' by eauto.
-      assert (Mem.perm_order'' (perm_of_sh sh3) (Some Readable)).
-      { unfold perm_of_sh.
-        if_tac; if_tac; constructor || contradiction. }
-      rewrite Haccess', if_true; auto.
-      destruct loc as (b', o').
-      destruct jm0; simpl in *.
-      erewrite mem_equiv_contents; eauto.
-      rewrite <- Hcontents.
-      symmetry in H5; apply JMcontents in H5 as []; subst.
-      constructor; auto.
-      { rewrite JMaccess, <- H5; simpl.
-        unfold perm_of_sh.
-        if_tac; if_tac; auto; discriminate. }
-      { rewrite perm_access, Haccess'; auto. }
-  + destruct k; try (constructor; auto).
-      pose proof (juicy_mem_access jm0 loc) as Haccess'.
-      rewrite <- H5 in Haccess'; simpl in Haccess'.
-      erewrite Haccess, <- mem_equiv_access in Haccess' by eauto.
-      assert (Mem.perm_order'' (perm_of_sh sh3) (Some Readable)).
-      { unfold perm_of_sh.
-        if_tac; if_tac; constructor || contradiction. }
-      rewrite Haccess', if_true; auto.
-      destruct loc as (b', o').
-      destruct jm0; simpl in *.
-      erewrite mem_equiv_contents; eauto.
-      rewrite <- Hcontents.
-      symmetry in H5; apply JMcontents in H5 as []; subst.
-      constructor; auto.
-      { rewrite JMaccess, <- H5; simpl.
-        unfold perm_of_sh.
-        if_tac; if_tac; auto; discriminate. }
-      { rewrite perm_access, Haccess'; auto. }
-Qed.
-
-Lemma inflate_emp : forall m phi, app_pred emp phi -> app_pred emp (inflate_store m phi).
-Proof.
-  simpl; intros.
-  setoid_rewrite res_predicates.emp_no in H. setoid_rewrite res_predicates.emp_no.
-  intros l; unfold inflate_store; simpl. rewrite resource_at_make_rmap.
-  specialize (H l); simpl in H.
-  destruct (phi @ l); auto.
-  apply YES_not_identity in H; contradiction.
+  remember (Z.to_nat z) as n; generalize dependent o; generalize dependent lv; generalize dependent z; generalize dependent m; induction n; intros; subst.
+  { destruct lv; try done; simpl in *.
+    rewrite mem_auth_equiv; last by eapply storebytes_nil.
+    rewrite data_at__Tarray Zlength_nil Zrepeat_0; auto.
+    { rewrite Zlength_cons in Heqn; rep_lia. } }
+  assert_PROP (field_compatible (tarray tuchar (Zlength lv)) [] (Vptr b o)) by entailer!.
+  rewrite (split2_data_at__Tarray_tuchar _ _ 1) // /=; last lia.
+  iIntros "(Hm & H & Hrest)".
+  rewrite /field_address0 if_true /=.
+  2: { rewrite field_compatible0_cons; split; auto; lia. }
+  destruct lv; first done; simpl in *.
+  apply Mem.storebytes_split in Hstore as (? & Hstore1 & Hstore2).
+  apply Mem.storebytes_store in Hstore1; last by apply Z.divide_1_l.
+  rewrite data_at__eq data_at_tuchar_singleton_array_inv /=.
+  iAssert ⌜field_compatible tuchar [] (Vptr b o)⌝ with "[H]" as %?.
+  { unfold data_at, field_at; iDestruct "H" as "($ & _)". }
+  erewrite <- mapsto_data_at' by done.
+  inv Hty.
+  iMod (lifting.mapsto_store with "[$Hm $H]") as "(Hm & H)"; [eauto..|].
+  rewrite encode_val_length /= in Hstore2.
+  rewrite /Ptrofs.add Ptrofs.unsigned_repr //.
+  rewrite -> Zlength_cons in *.
+  iMod (IHn with "[$Hm $Hrest]") as "($ & Hrest)"; [lia || done..| |].
+  { rewrite Ptrofs.unsigned_repr //.
+    destruct H as (_ & _ & H & _); simpl in H; rep_lia. }
+  rewrite (split2_data_at_Tarray_tuchar _ (Z.succ (Zlength lv)) 1) // /=; try lia.
+  2: { apply Zlength_cons. }
+  rewrite sublist_0_cons // sublist_nil sublist_1_cons sublist_same //; last lia.
+  rewrite -data_at_tuchar_singleton_array.
+  erewrite mapsto_data_at' by done.
+  rewrite /field_address0 if_true /=.
+  by iFrame.
+  { rewrite field_compatible0_cons; split; auto; lia. }
 Qed.
 
 Lemma encode_vals_length : forall lv,
   length (concat (map (encode_val Mint8unsigned) lv)) = length lv.
 Proof.
   induction lv; auto; simpl.
-  rewrite app_length, IHlv.
-  unfold encode_val; simpl.
-  destruct a; auto.
+  rewrite app_length IHlv encode_val_length //.
 Qed.
 
-Lemma store_bytes_data_at : forall {CS : compspecs} phi m0 m sh lv b o
-  (Hsh : readable_share sh) (Hvals : Forall (fun v => exists i, v = Vint i /\ Int.unsigned i <= Byte.max_unsigned) lv)
-  (Hdata : app_pred (res_predicates.VALspec_range (Zlength lv) sh (b, Ptrofs.unsigned o)) phi)
-  (Hstore : Mem.storebytes m0 b (Ptrofs.unsigned o) (concat (map (encode_val Mint8unsigned) lv)) = Some m)
-  (Hbounds : Ptrofs.unsigned o + Zlength lv <= Ptrofs.max_unsigned),
-  app_pred (data_at sh (tarray tuchar (Zlength lv)) lv (Vptr b o)) (inflate_store m phi).
-Proof.
-  split.
-  { split; simpl; auto.
-    split; auto.
-    split; [rewrite Z.max_r by rep_lia; unfold Ptrofs.max_unsigned in Hbounds; lia|].
-    split; auto.
-    constructor.
-    intros; econstructor; simpl; eauto.
-    apply Z.divide_1_l. }
-  unfold at_offset; rewrite data_at_rec_eq; simpl.
-  rewrite Z.max_r by rep_lia.
-  rewrite ptrofs_add_repr_0_r.
-  unfold unfold_reptype; simpl.
-  split.
-  { rewrite Z.sub_0_r; reflexivity. }
-  rewrite Z.sub_0_r.
-  rewrite <- (Z.add_0_r (Ptrofs.unsigned o)) in Hdata.
-  remember 0 as lo.
-  assert (0 <= lo) by lia.
-  rewrite Heqlo; rewrite <- Heqlo at 1.
-  remember (Z.to_nat (Zlength lv)) as n.
-  replace (Zlength lv) with (Z.of_nat n) in Hdata by (subst; rewrite Z2Nat.id; rep_lia).
-  assert (lo + Z.of_nat n = Zlength lv) as Hlen.
-  { subst; rewrite Z2Nat.id; rep_lia. }
-  clear Heqlo Heqn.
-  generalize dependent lo; generalize dependent phi; induction n; intros.
-  - rewrite res_predicates.VALspec_range_0 in Hdata; simpl.
-    apply inflate_emp; auto.
-  - rewrite Nat2Z.inj_succ, res_predicates.VALspec_range_split2 with (n := 1)(m := Z.of_nat n) in Hdata by lia.
-    destruct Hdata as (phi1 & phi2 & J & Hval1 & Hval2).
-    rewrite Nat2Z.inj_succ in Hlen.
-    rewrite <- Z.add_assoc in Hval2; apply IHn in Hval2; try lia.
-    eexists _, _; split; [apply inflate_store_join; eauto|].
-    split; auto.
-    unfold at_offset.
-    rewrite data_at_rec_eq; simpl.
-    unfold unfold_reptype; simpl.
-    rewrite Z.sub_0_r.
-    unfold mapsto; simpl.
-    rewrite if_true by auto.
-    left.
-    apply Forall_Znth with (i := lo) in Hvals as (i & Hi & ?); try lia.
-    split.
-    { setoid_rewrite Hi; auto. }
-    unfold res_predicates.address_mapsto.
-    exists [Byte (Byte.repr (Int.unsigned i))].
-    split.
-    { split; auto.
-      setoid_rewrite Hi.
-      split; [|apply Z.divide_1_l].
-      unfold decode_val; simpl.
-      unfold decode_int; simpl.
-      rewrite rev_if_be_singleton; simpl.
-      rewrite Byte.unsigned_repr by rep_lia.
-      rewrite Z.add_0_r, Int.repr_unsigned.
-      rewrite zero_ext_inrange; auto. }
-    intro l; simpl.
-    unfold inflate_store; rewrite resource_at_make_rmap.
-    specialize (Hval1 l); simpl in Hval1.
-    unfold Ptrofs.add.
-    replace (Ptrofs.unsigned (Ptrofs.repr (1 * lo))) with lo
-      by (rewrite Ptrofs.unsigned_repr; rep_lia).
-    rewrite Ptrofs.unsigned_repr by rep_lia.
-    if_tac.
-    + destruct Hval1 as (mv & rsh & ->); exists rsh.
-      destruct l as (b', o'); destruct H1; subst.
-      assert (o' = Ptrofs.unsigned o + lo) by lia; subst; simpl.
-      rewrite Z.sub_diag; simpl; f_equal; f_equal.
-      Transparent Mem.storebytes.
-      unfold Mem.storebytes in Hstore.
-      Opaque Mem.storebytes.
-      if_tac in Hstore; inv Hstore; unfold contents_at; simpl.
-      rewrite PMap.gss.
-      replace lv with (sublist 0 lo lv ++ Znth lo lv :: sublist (lo + 1) (Zlength lv) lv).
-      rewrite map_app, concat_app; simpl.
-      rewrite Mem.setN_concat.
-      rewrite Hi; simpl.
-      unfold encode_int; simpl.
-      rewrite rev_if_be_singleton; simpl.
-      rewrite encode_vals_length, <- Zlength_correct.
-      rewrite Zlength_sublist, Mem.setN_outside by lia.
-      rewrite Z.sub_0_r, ZMap.gss; auto.
-      { rewrite <- sublist_next, sublist_rejoin, sublist_same by lia; auto. }
-  + destruct (phi1 @ l); auto.
-    apply YES_not_identity in Hval1; contradiction.
-Qed.
-
-Definition main_pre_dry {Z} (m : mem) (prog : Clight.program) (ora : Z)
-  (ts : list Type) (gv : globals) (z : Z) :=
+Definition main_pre_dry (m : mem) (prog : Clight.program) (ora : OK_ty)
+  (ts : list Type) (gv : globals) (z : OK_ty) :=
   Genv.globals_initialized (Genv.globalenv prog) (Genv.globalenv prog) m /\ z = ora.
 
-Definition main_post_dry {Z} (m0 m : mem) (prog : Clight.program) (ora : Z)
-  (ts : list Type) (gv : globals) (z : Z) := True. (* the desired postcondition might vary by program *)
+Definition main_post_dry (m0 m : mem) (prog : Clight.program) (ora : OK_ty)
+  (ts : list Type) (gv : globals) (z : OK_ty) : Prop := True. (* the desired postcondition might vary by program *)
 
 (* simulate funspec2pre/post *)
 
-Definition main_pre_juicy {Z} prog (ora : Z) gv (x' : rmap * {ts : list Type & unit})
+(*Definition main_pre_juicy {Z} prog (ora : Z) gv (x' : rmap * {ts : list Type & unit})
   (ge_s: extspec.injective_PTree block) args (z : Z) (m : juicy_mem) :=
     Val.has_type_list args [] /\
 (*    (exists phi0 phi1 : rmap,
@@ -878,58 +300,6 @@ Definition main_post_juicy {Z} prog (ora : Z) gv (x' : rmap * {ts : list Type &
          (m_phi m)(*phi0 /\
        necR (fst x') phi1*) /\ joins (ghost_of (m_phi m)) [Some (ext_ref z, NoneP)]).
 
-Lemma ext_compat_sub : forall {Z} (z : Z) a b, semax.ext_compat z b -> join_sub a b ->
-  semax.ext_compat z a.
-Proof.
-  unfold semax.ext_compat; intros.
-  eapply join_sub_joins_trans; eauto.
-  destruct H0; eexists; apply ghost_of_join; eauto.
-Qed.
-
-Lemma ext_ghost_join' : forall {Z} (z z' : Z) (p p' : preds) c, join (Some (ext_ghost z, p)) (Some (ext_ref z', p')) c ->
-  z = z' /\ p = p'.
-Proof.
-  intros.
-  apply ext_ghost_join in H as [[]|[]]; subst.
-  - assert (ghost.valid(Ghost := ext_PCM Z) (None, None)) as H.
-    { split; simpl; auto. }
-    specialize (H0 (exist _ (None, None) H)); inv H0.
-    destruct H4 as [J _]; simpl in *.
-    inv J.
-    repeat inj_pair_tac.
-    destruct H1 as [_ J]; inv J.
-  - assert (ext_ref z' = ext_ref z) as Heq by congruence.
-    unfold ext_ref in Heq; inj_pair_tac.
-    inv H0; inv H; auto.
-Qed.
-
-Lemma has_ext_compat : forall {Z} (z1 z2 : Z) a b, app_pred (has_ext z1) a ->
-  join_sub a b -> semax.ext_compat z2 b -> z1 = z2 /\
-    ghost_of a = (Some (ext_ghost z1, NoneP)) :: tl (ghost_of a) /\
-    ghost_of b = (Some (ext_ghost z1, NoneP)) :: tl (ghost_of b).
-Proof.
-  intros.
-  destruct H as [? [_ H]].
-  destruct H, H1, H0 as [? Hsub%ghost_of_join].
-  rewrite own.ghost_fmap_singleton in H; apply own.singleton_join_inv_gen in H as (? & (?, ?) & ? & ?).
-  rewrite H2 in *; unfold own.list_set in *; simpl in *.
-  match goal with H : join ?a _ _ |- _ => replace a with (Some (ext_ghost z1, NoneP)) in H
-    by (unfold ext_ghost; repeat f_equal) end.
-  apply ext_ghost_join in H as [[]|[]]; subst.
-  - inv H.
-    inv Hsub.
-    + rewrite <- H6 in H1; inv H1.
-      apply ext_ghost_join' in H10 as []; subst; auto.
-    + rewrite <- H6 in H1; inv H1.
-      apply ext_ghost_join in H7 as [[]|[]]; subst.
-      * apply ext_ghost_join' in H12 as []; subst; auto.
-      * exfalso; eapply no_two_ref; eexists; eauto.
-  - inv H3.
-    destruct (join_assoc (join_comm Hsub) H1) as (? & ? & ?).
-    inv H3.
-    exfalso; eapply no_two_ref; eexists; eauto.
-Qed.
-
 Lemma main_dry : forall {Z} prog (ora : Z) ts gv,
   (forall t b vl x jm,
   Genv.init_mem (program_of_program prog) = Some (m_dry jm) ->
@@ -958,4 +328,6 @@ Proof.
     eexists; constructor; constructor.
     instantiate (1 := (_, _)); constructor; simpl; [|constructor; auto].
     apply ext_ref_join.
-Qed.
+Qed.*)
+
+End mpred.
diff --git a/progs64/incr.c b/progs64/incr.c
index 2b2dea2608..a68f4759ad 100644
--- a/progs64/incr.c
+++ b/progs64/incr.c
@@ -1,7 +1,7 @@
 #include "../concurrency/threads.h"
 //#include <stdio.h>
 
-typedef struct counter { unsigned ctr; lock_t *lock; } counter;
+typedef struct counter { unsigned ctr; lock_t lock; } counter;
 counter c;
 
 void incr() {
@@ -21,16 +21,16 @@ int thread_func(void *thread_lock) {
   //Increment the counter
   incr();
   //Yield: 'ready to join'.
-  release((lock_t *)thread_lock);
+  release((lock_t)thread_lock);
   return 0;
 }
 
-int main(void)
+int compute2(void)
 {
   c.ctr = 0;
   c.lock = makelock();
   release(c.lock);
-  lock_t *thread_lock = makelock();
+  lock_t thread_lock = makelock();
   /* Spawn */
   spawn((void *)&thread_func, (void *)thread_lock);
 
@@ -49,3 +49,7 @@ int main(void)
 
   return t;
 }
+
+int main(void) {
+ return compute2();
+}
diff --git a/progs64/incr.v b/progs64/incr.v
index 0c72755d8f..b6b838ed33 100644
--- a/progs64/incr.v
+++ b/progs64/incr.v
@@ -10,24 +10,22 @@ Module Info.
   Definition build_number := "".
   Definition build_tag := "".
   Definition build_branch := "".
-  Definition arch := "aarch64".
-  Definition model := "default".
-  Definition abi := "apple".
+  Definition arch := "x86".
+  Definition model := "64".
+  Definition abi := "standard".
   Definition bitsize := 64.
   Definition big_endian := false.
   Definition source_file := "progs64/incr.c".
   Definition normalized := true.
 End Info.
 
+Definition ___builtin_ais_annot : ident := $"__builtin_ais_annot".
 Definition ___builtin_annot : ident := $"__builtin_annot".
 Definition ___builtin_annot_intval : ident := $"__builtin_annot_intval".
 Definition ___builtin_bswap : ident := $"__builtin_bswap".
 Definition ___builtin_bswap16 : ident := $"__builtin_bswap16".
 Definition ___builtin_bswap32 : ident := $"__builtin_bswap32".
 Definition ___builtin_bswap64 : ident := $"__builtin_bswap64".
-Definition ___builtin_cls : ident := $"__builtin_cls".
-Definition ___builtin_clsl : ident := $"__builtin_clsl".
-Definition ___builtin_clsll : ident := $"__builtin_clsll".
 Definition ___builtin_clz : ident := $"__builtin_clz".
 Definition ___builtin_clzl : ident := $"__builtin_clzl".
 Definition ___builtin_clzll : ident := $"__builtin_clzll".
@@ -47,6 +45,8 @@ Definition ___builtin_fnmsub : ident := $"__builtin_fnmsub".
 Definition ___builtin_fsqrt : ident := $"__builtin_fsqrt".
 Definition ___builtin_membar : ident := $"__builtin_membar".
 Definition ___builtin_memcpy_aligned : ident := $"__builtin_memcpy_aligned".
+Definition ___builtin_read16_reversed : ident := $"__builtin_read16_reversed".
+Definition ___builtin_read32_reversed : ident := $"__builtin_read32_reversed".
 Definition ___builtin_sel : ident := $"__builtin_sel".
 Definition ___builtin_sqrt : ident := $"__builtin_sqrt".
 Definition ___builtin_unreachable : ident := $"__builtin_unreachable".
@@ -54,6 +54,8 @@ Definition ___builtin_va_arg : ident := $"__builtin_va_arg".
 Definition ___builtin_va_copy : ident := $"__builtin_va_copy".
 Definition ___builtin_va_end : ident := $"__builtin_va_end".
 Definition ___builtin_va_start : ident := $"__builtin_va_start".
+Definition ___builtin_write16_reversed : ident := $"__builtin_write16_reversed".
+Definition ___builtin_write32_reversed : ident := $"__builtin_write32_reversed".
 Definition ___compcert_i64_dtos : ident := $"__compcert_i64_dtos".
 Definition ___compcert_i64_dtou : ident := $"__compcert_i64_dtou".
 Definition ___compcert_i64_sar : ident := $"__compcert_i64_sar".
@@ -73,22 +75,83 @@ Definition ___compcert_va_composite : ident := $"__compcert_va_composite".
 Definition ___compcert_va_float64 : ident := $"__compcert_va_float64".
 Definition ___compcert_va_int32 : ident := $"__compcert_va_int32".
 Definition ___compcert_va_int64 : ident := $"__compcert_va_int64".
+Definition ___stringlit_1 : ident := $"__stringlit_1".
+Definition ___stringlit_2 : ident := $"__stringlit_2".
+Definition ___stringlit_3 : ident := $"__stringlit_3".
+Definition ___stringlit_4 : ident := $"__stringlit_4".
+Definition __l : ident := $"_l".
+Definition _a : ident := $"a".
 Definition _acquire : ident := $"acquire".
+Definition _append : ident := $"append".
 Definition _atom_int : ident := $"atom_int".
+Definition _b : ident := $"b".
 Definition _c : ident := $"c".
+Definition _compute2 : ident := $"compute2".
 Definition _counter : ident := $"counter".
 Definition _ctr : ident := $"ctr".
+Definition _d : ident := $"d".
+Definition _delete : ident := $"delete".
+Definition _e : ident := $"e".
+Definition _f : ident := $"f".
+Definition _foo : ident := $"foo".
+Definition _four : ident := $"four".
+Definition _freeN : ident := $"freeN".
 Definition _freelock : ident := $"freelock".
+Definition _g : ident := $"g".
+Definition _h : ident := $"h".
+Definition _head : ident := $"head".
+Definition _hi : ident := $"hi".
+Definition _i : ident := $"i".
 Definition _incr : ident := $"incr".
+Definition _insert : ident := $"insert".
+Definition _j : ident := $"j".
+Definition _key : ident := $"key".
+Definition _l : ident := $"l".
+Definition _left : ident := $"left".
+Definition _list : ident := $"list".
+Definition _lo : ident := $"lo".
 Definition _lock : ident := $"lock".
+Definition _lookup : ident := $"lookup".
 Definition _main : ident := $"main".
 Definition _makelock : ident := $"makelock".
+Definition _mallocN : ident := $"mallocN".
+Definition _mid : ident := $"mid".
+Definition _p : ident := $"p".
+Definition _pa : ident := $"pa".
+Definition _pb : ident := $"pb".
+Definition _pushdown_left : ident := $"pushdown_left".
+Definition _q : ident := $"q".
+Definition _r : ident := $"r".
 Definition _read : ident := $"read".
 Definition _release : ident := $"release".
+Definition _right : ident := $"right".
+Definition _s : ident := $"s".
+Definition _search : ident := $"search".
 Definition _spawn : ident := $"spawn".
+Definition _sub1 : ident := $"sub1".
+Definition _sub2 : ident := $"sub2".
+Definition _sub3 : ident := $"sub3".
 Definition _t : ident := $"t".
+Definition _tail : ident := $"tail".
+Definition _tgt : ident := $"tgt".
 Definition _thread_func : ident := $"thread_func".
 Definition _thread_lock : ident := $"thread_lock".
+Definition _tree : ident := $"tree".
+Definition _tree_free : ident := $"tree_free".
+Definition _treebox_free : ident := $"treebox_free".
+Definition _treebox_new : ident := $"treebox_new".
+Definition _turn_left : ident := $"turn_left".
+Definition _u : ident := $"u".
+Definition _v : ident := $"v".
+Definition _val : ident := $"val".
+Definition _value : ident := $"value".
+Definition _x : ident := $"x".
+Definition _x1 : ident := $"x1".
+Definition _x2 : ident := $"x2".
+Definition _y : ident := $"y".
+Definition _y1 : ident := $"y1".
+Definition _y2 : ident := $"y2".
+Definition _z : ident := $"z".
 Definition _t'1 : ident := 128%positive.
 Definition _t'2 : ident := 129%positive.
 Definition _t'3 : ident := 130%positive.
@@ -108,19 +171,18 @@ Definition f_incr := {|
   fn_callconv := cc_default;
   fn_params := nil;
   fn_vars := nil;
-  fn_temps := ((_t'3, (tptr (tptr (Tstruct _atom_int noattr)))) ::
-               (_t'2, tuint) ::
-               (_t'1, (tptr (tptr (Tstruct _atom_int noattr)))) :: nil);
+  fn_temps := ((_t'3, (tptr (Tstruct _atom_int noattr))) :: (_t'2, tuint) ::
+               (_t'1, (tptr (Tstruct _atom_int noattr))) :: nil);
   fn_body :=
 (Ssequence
   (Ssequence
     (Sset _t'3
       (Efield (Evar _c (Tstruct _counter noattr)) _lock
-        (tptr (tptr (Tstruct _atom_int noattr)))))
+        (tptr (Tstruct _atom_int noattr))))
     (Scall None
       (Evar _acquire (Tfunction ((tptr (Tstruct _atom_int noattr)) :: nil)
                        tvoid cc_default))
-      ((Etempvar _t'3 (tptr (tptr (Tstruct _atom_int noattr)))) :: nil)))
+      ((Etempvar _t'3 (tptr (Tstruct _atom_int noattr))) :: nil)))
   (Ssequence
     (Ssequence
       (Sset _t'2 (Efield (Evar _c (Tstruct _counter noattr)) _ctr tuint))
@@ -130,11 +192,11 @@ Definition f_incr := {|
     (Ssequence
       (Sset _t'1
         (Efield (Evar _c (Tstruct _counter noattr)) _lock
-          (tptr (tptr (Tstruct _atom_int noattr)))))
+          (tptr (Tstruct _atom_int noattr))))
       (Scall None
         (Evar _release (Tfunction ((tptr (Tstruct _atom_int noattr)) :: nil)
                          tvoid cc_default))
-        ((Etempvar _t'1 (tptr (tptr (Tstruct _atom_int noattr)))) :: nil)))))
+        ((Etempvar _t'1 (tptr (Tstruct _atom_int noattr))) :: nil)))))
 |}.
 
 Definition f_read := {|
@@ -142,31 +204,30 @@ Definition f_read := {|
   fn_callconv := cc_default;
   fn_params := nil;
   fn_vars := nil;
-  fn_temps := ((_t, tuint) ::
-               (_t'2, (tptr (tptr (Tstruct _atom_int noattr)))) ::
-               (_t'1, (tptr (tptr (Tstruct _atom_int noattr)))) :: nil);
+  fn_temps := ((_t, tuint) :: (_t'2, (tptr (Tstruct _atom_int noattr))) ::
+               (_t'1, (tptr (Tstruct _atom_int noattr))) :: nil);
   fn_body :=
 (Ssequence
   (Ssequence
     (Sset _t'2
       (Efield (Evar _c (Tstruct _counter noattr)) _lock
-        (tptr (tptr (Tstruct _atom_int noattr)))))
+        (tptr (Tstruct _atom_int noattr))))
     (Scall None
       (Evar _acquire (Tfunction ((tptr (Tstruct _atom_int noattr)) :: nil)
                        tvoid cc_default))
-      ((Etempvar _t'2 (tptr (tptr (Tstruct _atom_int noattr)))) :: nil)))
+      ((Etempvar _t'2 (tptr (Tstruct _atom_int noattr))) :: nil)))
   (Ssequence
     (Sset _t (Efield (Evar _c (Tstruct _counter noattr)) _ctr tuint))
     (Ssequence
       (Ssequence
         (Sset _t'1
           (Efield (Evar _c (Tstruct _counter noattr)) _lock
-            (tptr (tptr (Tstruct _atom_int noattr)))))
+            (tptr (Tstruct _atom_int noattr))))
         (Scall None
           (Evar _release (Tfunction
                            ((tptr (Tstruct _atom_int noattr)) :: nil) tvoid
                            cc_default))
-          ((Etempvar _t'1 (tptr (tptr (Tstruct _atom_int noattr)))) :: nil)))
+          ((Etempvar _t'1 (tptr (Tstruct _atom_int noattr))) :: nil)))
       (Sreturn (Some (Etempvar _t tuint))))))
 |}.
 
@@ -184,120 +245,130 @@ Definition f_thread_func := {|
       (Evar _release (Tfunction ((tptr (Tstruct _atom_int noattr)) :: nil)
                        tvoid cc_default))
       ((Ecast (Etempvar _thread_lock (tptr tvoid))
-         (tptr (tptr (Tstruct _atom_int noattr)))) :: nil))
+         (tptr (Tstruct _atom_int noattr))) :: nil))
     (Sreturn (Some (Econst_int (Int.repr 0) tint)))))
 |}.
 
-Definition f_main := {|
+Definition f_compute2 := {|
   fn_return := tint;
   fn_callconv := cc_default;
   fn_params := nil;
   fn_vars := nil;
-  fn_temps := ((_thread_lock, (tptr (tptr (Tstruct _atom_int noattr)))) ::
+  fn_temps := ((_thread_lock, (tptr (Tstruct _atom_int noattr))) ::
                (_t, tuint) :: (_t'3, tuint) ::
                (_t'2, (tptr (Tstruct _atom_int noattr))) ::
                (_t'1, (tptr (Tstruct _atom_int noattr))) ::
-               (_t'6, (tptr (tptr (Tstruct _atom_int noattr)))) ::
-               (_t'5, (tptr (tptr (Tstruct _atom_int noattr)))) ::
-               (_t'4, (tptr (tptr (Tstruct _atom_int noattr)))) :: nil);
+               (_t'6, (tptr (Tstruct _atom_int noattr))) ::
+               (_t'5, (tptr (Tstruct _atom_int noattr))) ::
+               (_t'4, (tptr (Tstruct _atom_int noattr))) :: nil);
   fn_body :=
 (Ssequence
+  (Sassign (Efield (Evar _c (Tstruct _counter noattr)) _ctr tuint)
+    (Econst_int (Int.repr 0) tint))
   (Ssequence
-    (Sassign (Efield (Evar _c (Tstruct _counter noattr)) _ctr tuint)
-      (Econst_int (Int.repr 0) tint))
+    (Ssequence
+      (Scall (Some _t'1)
+        (Evar _makelock (Tfunction nil (tptr (Tstruct _atom_int noattr))
+                          cc_default)) nil)
+      (Sassign
+        (Efield (Evar _c (Tstruct _counter noattr)) _lock
+          (tptr (Tstruct _atom_int noattr)))
+        (Etempvar _t'1 (tptr (Tstruct _atom_int noattr)))))
     (Ssequence
       (Ssequence
-        (Scall (Some _t'1)
-          (Evar _makelock (Tfunction nil (tptr (Tstruct _atom_int noattr))
-                            cc_default)) nil)
-        (Sassign
+        (Sset _t'6
           (Efield (Evar _c (Tstruct _counter noattr)) _lock
-            (tptr (tptr (Tstruct _atom_int noattr))))
-          (Etempvar _t'1 (tptr (Tstruct _atom_int noattr)))))
+            (tptr (Tstruct _atom_int noattr))))
+        (Scall None
+          (Evar _release (Tfunction
+                           ((tptr (Tstruct _atom_int noattr)) :: nil) tvoid
+                           cc_default))
+          ((Etempvar _t'6 (tptr (Tstruct _atom_int noattr))) :: nil)))
       (Ssequence
         (Ssequence
-          (Sset _t'6
-            (Efield (Evar _c (Tstruct _counter noattr)) _lock
-              (tptr (tptr (Tstruct _atom_int noattr)))))
-          (Scall None
-            (Evar _release (Tfunction
-                             ((tptr (Tstruct _atom_int noattr)) :: nil) tvoid
-                             cc_default))
-            ((Etempvar _t'6 (tptr (tptr (Tstruct _atom_int noattr)))) :: nil)))
+          (Scall (Some _t'2)
+            (Evar _makelock (Tfunction nil (tptr (Tstruct _atom_int noattr))
+                              cc_default)) nil)
+          (Sset _thread_lock
+            (Etempvar _t'2 (tptr (Tstruct _atom_int noattr)))))
         (Ssequence
+          (Scall None
+            (Evar _spawn (Tfunction
+                           ((tptr (Tfunction ((tptr tvoid) :: nil) tint
+                                    cc_default)) :: (tptr tvoid) :: nil)
+                           tvoid cc_default))
+            ((Ecast
+               (Eaddrof
+                 (Evar _thread_func (Tfunction ((tptr tvoid) :: nil) tint
+                                      cc_default))
+                 (tptr (Tfunction ((tptr tvoid) :: nil) tint cc_default)))
+               (tptr tvoid)) ::
+             (Ecast (Etempvar _thread_lock (tptr (Tstruct _atom_int noattr)))
+               (tptr tvoid)) :: nil))
           (Ssequence
-            (Scall (Some _t'2)
-              (Evar _makelock (Tfunction nil
-                                (tptr (Tstruct _atom_int noattr)) cc_default))
-              nil)
-            (Sset _thread_lock
-              (Etempvar _t'2 (tptr (Tstruct _atom_int noattr)))))
-          (Ssequence
-            (Scall None
-              (Evar _spawn (Tfunction
-                             ((tptr (Tfunction ((tptr tvoid) :: nil) tint
-                                      cc_default)) :: (tptr tvoid) :: nil)
-                             tvoid cc_default))
-              ((Ecast
-                 (Eaddrof
-                   (Evar _thread_func (Tfunction ((tptr tvoid) :: nil) tint
-                                        cc_default))
-                   (tptr (Tfunction ((tptr tvoid) :: nil) tint cc_default)))
-                 (tptr tvoid)) ::
-               (Ecast
-                 (Etempvar _thread_lock (tptr (tptr (Tstruct _atom_int noattr))))
-                 (tptr tvoid)) :: nil))
+            (Scall None (Evar _incr (Tfunction nil tvoid cc_default)) nil)
             (Ssequence
-              (Scall None (Evar _incr (Tfunction nil tvoid cc_default)) nil)
+              (Scall None
+                (Evar _acquire (Tfunction
+                                 ((tptr (Tstruct _atom_int noattr)) :: nil)
+                                 tvoid cc_default))
+                ((Etempvar _thread_lock (tptr (Tstruct _atom_int noattr))) ::
+                 nil))
               (Ssequence
-                (Scall None
-                  (Evar _acquire (Tfunction
-                                   ((tptr (Tstruct _atom_int noattr)) :: nil)
-                                   tvoid cc_default))
-                  ((Etempvar _thread_lock (tptr (tptr (Tstruct _atom_int noattr)))) ::
-                   nil))
+                (Ssequence
+                  (Scall (Some _t'3)
+                    (Evar _read (Tfunction nil tuint cc_default)) nil)
+                  (Sset _t (Etempvar _t'3 tuint)))
                 (Ssequence
                   (Ssequence
-                    (Scall (Some _t'3)
-                      (Evar _read (Tfunction nil tuint cc_default)) nil)
-                    (Sset _t (Etempvar _t'3 tuint)))
+                    (Sset _t'5
+                      (Efield (Evar _c (Tstruct _counter noattr)) _lock
+                        (tptr (Tstruct _atom_int noattr))))
+                    (Scall None
+                      (Evar _acquire (Tfunction
+                                       ((tptr (Tstruct _atom_int noattr)) ::
+                                        nil) tvoid cc_default))
+                      ((Etempvar _t'5 (tptr (Tstruct _atom_int noattr))) ::
+                       nil)))
                   (Ssequence
+                    (Scall None
+                      (Evar _freelock (Tfunction
+                                        ((tptr (Tstruct _atom_int noattr)) ::
+                                         nil) tvoid cc_default))
+                      ((Etempvar _thread_lock (tptr (Tstruct _atom_int noattr))) ::
+                       nil))
                     (Ssequence
-                      (Sset _t'5
-                        (Efield (Evar _c (Tstruct _counter noattr)) _lock
-                          (tptr (tptr (Tstruct _atom_int noattr)))))
-                      (Scall None
-                        (Evar _acquire (Tfunction
-                                         ((tptr (Tstruct _atom_int noattr)) ::
-                                          nil) tvoid cc_default))
-                        ((Etempvar _t'5 (tptr (tptr (Tstruct _atom_int noattr)))) ::
-                         nil)))
-                    (Ssequence
-                      (Scall None
-                        (Evar _freelock (Tfunction
-                                          ((tptr (Tstruct _atom_int noattr)) ::
-                                           nil) tvoid cc_default))
-                        ((Etempvar _thread_lock (tptr (tptr (Tstruct _atom_int noattr)))) ::
-                         nil))
                       (Ssequence
-                        (Ssequence
-                          (Sset _t'4
-                            (Efield (Evar _c (Tstruct _counter noattr)) _lock
-                              (tptr (tptr (Tstruct _atom_int noattr)))))
-                          (Scall None
-                            (Evar _freelock (Tfunction
-                                              ((tptr (Tstruct _atom_int noattr)) ::
-                                               nil) tvoid cc_default))
-                            ((Etempvar _t'4 (tptr (tptr (Tstruct _atom_int noattr)))) ::
-                             nil)))
-                        (Sreturn (Some (Etempvar _t tuint))))))))))))))
+                        (Sset _t'4
+                          (Efield (Evar _c (Tstruct _counter noattr)) _lock
+                            (tptr (Tstruct _atom_int noattr))))
+                        (Scall None
+                          (Evar _freelock (Tfunction
+                                            ((tptr (Tstruct _atom_int noattr)) ::
+                                             nil) tvoid cc_default))
+                          ((Etempvar _t'4 (tptr (Tstruct _atom_int noattr))) ::
+                           nil)))
+                      (Sreturn (Some (Etempvar _t tuint))))))))))))))
+|}.
+
+Definition f_main := {|
+  fn_return := tint;
+  fn_callconv := cc_default;
+  fn_params := nil;
+  fn_vars := nil;
+  fn_temps := ((_t'1, tint) :: nil);
+  fn_body :=
+(Ssequence
+  (Ssequence
+    (Scall (Some _t'1) (Evar _compute2 (Tfunction nil tint cc_default)) nil)
+    (Sreturn (Some (Etempvar _t'1 tint))))
   (Sreturn (Some (Econst_int (Int.repr 0) tint))))
 |}.
 
 Definition composites : list composite_definition :=
 (Composite _counter Struct
    (Member_plain _ctr tuint ::
-    Member_plain _lock (tptr (tptr (Tstruct _atom_int noattr))) :: nil)
+    Member_plain _lock (tptr (Tstruct _atom_int noattr)) :: nil)
    noattr :: nil).
 
 Definition global_definitions : list (ident * globdef fundef type) :=
@@ -381,6 +452,12 @@ Definition global_definitions : list (ident * globdef fundef type) :=
                    (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
                      cc_default)) (tulong :: tulong :: nil) tulong
      cc_default)) ::
+ (___builtin_ais_annot,
+   Gfun(External (EF_builtin "__builtin_ais_annot"
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid
+                     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
+     ((tptr tschar) :: nil) tvoid
+     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
  (___builtin_bswap64,
    Gfun(External (EF_builtin "__builtin_bswap64"
                    (mksignature (AST.Xlong :: nil) AST.Xlong cc_default))
@@ -492,18 +569,16 @@ Definition global_definitions : list (ident * globdef fundef type) :=
    Gfun(External (EF_builtin "__builtin_expect"
                    (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
                      cc_default)) (tlong :: tlong :: nil) tlong cc_default)) ::
- (___builtin_cls,
-   Gfun(External (EF_builtin "__builtin_cls"
-                   (mksignature (AST.Xint :: nil) AST.Xint cc_default))
-     (tint :: nil) tint cc_default)) ::
- (___builtin_clsl,
-   Gfun(External (EF_builtin "__builtin_clsl"
-                   (mksignature (AST.Xlong :: nil) AST.Xint cc_default))
-     (tlong :: nil) tint cc_default)) ::
- (___builtin_clsll,
-   Gfun(External (EF_builtin "__builtin_clsll"
-                   (mksignature (AST.Xlong :: nil) AST.Xint cc_default))
-     (tlong :: nil) tint cc_default)) ::
+ (___builtin_fmax,
+   Gfun(External (EF_builtin "__builtin_fmax"
+                   (mksignature (AST.Xfloat :: AST.Xfloat :: nil) AST.Xfloat
+                     cc_default)) (tdouble :: tdouble :: nil) tdouble
+     cc_default)) ::
+ (___builtin_fmin,
+   Gfun(External (EF_builtin "__builtin_fmin"
+                   (mksignature (AST.Xfloat :: AST.Xfloat :: nil) AST.Xfloat
+                     cc_default)) (tdouble :: tdouble :: nil) tdouble
+     cc_default)) ::
  (___builtin_fmadd,
    Gfun(External (EF_builtin "__builtin_fmadd"
                    (mksignature
@@ -528,15 +603,24 @@ Definition global_definitions : list (ident * globdef fundef type) :=
                      (AST.Xfloat :: AST.Xfloat :: AST.Xfloat :: nil)
                      AST.Xfloat cc_default))
      (tdouble :: tdouble :: tdouble :: nil) tdouble cc_default)) ::
- (___builtin_fmax,
-   Gfun(External (EF_builtin "__builtin_fmax"
-                   (mksignature (AST.Xfloat :: AST.Xfloat :: nil) AST.Xfloat
-                     cc_default)) (tdouble :: tdouble :: nil) tdouble
+ (___builtin_read16_reversed,
+   Gfun(External (EF_builtin "__builtin_read16_reversed"
+                   (mksignature (AST.Xptr :: nil) AST.Xint16unsigned
+                     cc_default)) ((tptr tushort) :: nil) tushort
      cc_default)) ::
- (___builtin_fmin,
-   Gfun(External (EF_builtin "__builtin_fmin"
-                   (mksignature (AST.Xfloat :: AST.Xfloat :: nil) AST.Xfloat
-                     cc_default)) (tdouble :: tdouble :: nil) tdouble
+ (___builtin_read32_reversed,
+   Gfun(External (EF_builtin "__builtin_read32_reversed"
+                   (mksignature (AST.Xptr :: nil) AST.Xint cc_default))
+     ((tptr tuint) :: nil) tuint cc_default)) ::
+ (___builtin_write16_reversed,
+   Gfun(External (EF_builtin "__builtin_write16_reversed"
+                   (mksignature (AST.Xptr :: AST.Xint16unsigned :: nil)
+                     AST.Xvoid cc_default))
+     ((tptr tushort) :: tushort :: nil) tvoid cc_default)) ::
+ (___builtin_write32_reversed,
+   Gfun(External (EF_builtin "__builtin_write32_reversed"
+                   (mksignature (AST.Xptr :: AST.Xint :: nil) AST.Xvoid
+                     cc_default)) ((tptr tuint) :: tuint :: nil) tvoid
      cc_default)) ::
  (___builtin_debug,
    Gfun(External (EF_external "__builtin_debug"
@@ -568,27 +652,30 @@ Definition global_definitions : list (ident * globdef fundef type) :=
       (tptr tvoid) :: nil) tvoid cc_default)) :: (_c, Gvar v_c) ::
  (_incr, Gfun(Internal f_incr)) :: (_read, Gfun(Internal f_read)) ::
  (_thread_func, Gfun(Internal f_thread_func)) ::
- (_main, Gfun(Internal f_main)) :: nil).
+ (_compute2, Gfun(Internal f_compute2)) :: (_main, Gfun(Internal f_main)) ::
+ nil).
 
 Definition public_idents : list ident :=
-(_main :: _thread_func :: _read :: _incr :: _c :: _spawn :: _release ::
- _acquire :: _freelock :: _makelock :: ___builtin_debug :: ___builtin_fmin ::
- ___builtin_fmax :: ___builtin_fnmsub :: ___builtin_fnmadd ::
- ___builtin_fmsub :: ___builtin_fmadd :: ___builtin_clsll ::
- ___builtin_clsl :: ___builtin_cls :: ___builtin_expect ::
- ___builtin_unreachable :: ___builtin_va_end :: ___builtin_va_copy ::
- ___builtin_va_arg :: ___builtin_va_start :: ___builtin_membar ::
- ___builtin_annot_intval :: ___builtin_annot :: ___builtin_sel ::
- ___builtin_memcpy_aligned :: ___builtin_sqrt :: ___builtin_fsqrt ::
- ___builtin_fabsf :: ___builtin_fabs :: ___builtin_ctzll ::
- ___builtin_ctzl :: ___builtin_ctz :: ___builtin_clzll :: ___builtin_clzl ::
- ___builtin_clz :: ___builtin_bswap16 :: ___builtin_bswap32 ::
- ___builtin_bswap :: ___builtin_bswap64 :: ___compcert_i64_umulh ::
- ___compcert_i64_smulh :: ___compcert_i64_sar :: ___compcert_i64_shr ::
- ___compcert_i64_shl :: ___compcert_i64_umod :: ___compcert_i64_smod ::
- ___compcert_i64_udiv :: ___compcert_i64_sdiv :: ___compcert_i64_utof ::
- ___compcert_i64_stof :: ___compcert_i64_utod :: ___compcert_i64_stod ::
- ___compcert_i64_dtou :: ___compcert_i64_dtos :: ___compcert_va_composite ::
+(_main :: _compute2 :: _thread_func :: _read :: _incr :: _c :: _spawn ::
+ _release :: _acquire :: _freelock :: _makelock :: ___builtin_debug ::
+ ___builtin_write32_reversed :: ___builtin_write16_reversed ::
+ ___builtin_read32_reversed :: ___builtin_read16_reversed ::
+ ___builtin_fnmsub :: ___builtin_fnmadd :: ___builtin_fmsub ::
+ ___builtin_fmadd :: ___builtin_fmin :: ___builtin_fmax ::
+ ___builtin_expect :: ___builtin_unreachable :: ___builtin_va_end ::
+ ___builtin_va_copy :: ___builtin_va_arg :: ___builtin_va_start ::
+ ___builtin_membar :: ___builtin_annot_intval :: ___builtin_annot ::
+ ___builtin_sel :: ___builtin_memcpy_aligned :: ___builtin_sqrt ::
+ ___builtin_fsqrt :: ___builtin_fabsf :: ___builtin_fabs ::
+ ___builtin_ctzll :: ___builtin_ctzl :: ___builtin_ctz :: ___builtin_clzll ::
+ ___builtin_clzl :: ___builtin_clz :: ___builtin_bswap16 ::
+ ___builtin_bswap32 :: ___builtin_bswap :: ___builtin_bswap64 ::
+ ___builtin_ais_annot :: ___compcert_i64_umulh :: ___compcert_i64_smulh ::
+ ___compcert_i64_sar :: ___compcert_i64_shr :: ___compcert_i64_shl ::
+ ___compcert_i64_umod :: ___compcert_i64_smod :: ___compcert_i64_udiv ::
+ ___compcert_i64_sdiv :: ___compcert_i64_utof :: ___compcert_i64_stof ::
+ ___compcert_i64_utod :: ___compcert_i64_stod :: ___compcert_i64_dtou ::
+ ___compcert_i64_dtos :: ___compcert_va_composite ::
  ___compcert_va_float64 :: ___compcert_va_int64 :: ___compcert_va_int32 ::
  nil).
 
diff --git a/progs64/incrN.v b/progs64/incrN.v
index 69e8ed45f6..0980ed854f 100644
--- a/progs64/incrN.v
+++ b/progs64/incrN.v
@@ -6,7 +6,7 @@ Local Open Scope string_scope.
 Local Open Scope clight_scope.
 
 Module Info.
-  Definition version := "3.10".
+  Definition version := "3.15".
   Definition build_number := "".
   Definition build_tag := "".
   Definition build_branch := "".
@@ -19,6 +19,7 @@ Module Info.
   Definition normalized := true.
 End Info.
 
+Definition ___builtin_ais_annot : ident := $"__builtin_ais_annot".
 Definition ___builtin_annot : ident := $"__builtin_annot".
 Definition ___builtin_annot_intval : ident := $"__builtin_annot_intval".
 Definition ___builtin_bswap : ident := $"__builtin_bswap".
@@ -74,41 +75,87 @@ Definition ___compcert_va_composite : ident := $"__compcert_va_composite".
 Definition ___compcert_va_float64 : ident := $"__compcert_va_float64".
 Definition ___compcert_va_int32 : ident := $"__compcert_va_int32".
 Definition ___compcert_va_int64 : ident := $"__compcert_va_int64".
-Definition ___dummy : ident := $"__dummy".
-Definition ___pthread_t : ident := $"__pthread_t".
+Definition ___stringlit_1 : ident := $"__stringlit_1".
+Definition ___stringlit_2 : ident := $"__stringlit_2".
+Definition ___stringlit_3 : ident := $"__stringlit_3".
+Definition ___stringlit_4 : ident := $"__stringlit_4".
+Definition __l : ident := $"_l".
+Definition _a : ident := $"a".
 Definition _acquire : ident := $"acquire".
+Definition _append : ident := $"append".
 Definition _args : ident := $"args".
-Definition _atom_CAS : ident := $"atom_CAS".
 Definition _atom_int : ident := $"atom_int".
-Definition _atom_store : ident := $"atom_store".
 Definition _b : ident := $"b".
 Definition _c : ident := $"c".
+Definition _compute2 : ident := $"compute2".
 Definition _counter : ident := $"counter".
 Definition _ctr : ident := $"ctr".
+Definition _d : ident := $"d".
+Definition _delete : ident := $"delete".
 Definition _dest_ctr : ident := $"dest_ctr".
-Definition _exit : ident := $"exit".
-Definition _exit_thread : ident := $"exit_thread".
-Definition _expected : ident := $"expected".
+Definition _e : ident := $"e".
 Definition _f : ident := $"f".
-Definition _free_atomic : ident := $"free_atomic".
+Definition _foo : ident := $"foo".
+Definition _four : ident := $"four".
+Definition _freeN : ident := $"freeN".
 Definition _freelock : ident := $"freelock".
+Definition _g : ident := $"g".
+Definition _h : ident := $"h".
+Definition _head : ident := $"head".
+Definition _hi : ident := $"hi".
 Definition _i : ident := $"i".
 Definition _i__1 : ident := $"i__1".
 Definition _incr : ident := $"incr".
 Definition _init_ctr : ident := $"init_ctr".
+Definition _insert : ident := $"insert".
+Definition _j : ident := $"j".
+Definition _key : ident := $"key".
 Definition _l : ident := $"l".
+Definition _left : ident := $"left".
+Definition _list : ident := $"list".
+Definition _lo : ident := $"lo".
 Definition _lock : ident := $"lock".
+Definition _lookup : ident := $"lookup".
 Definition _main : ident := $"main".
-Definition _make_atomic : ident := $"make_atomic".
 Definition _makelock : ident := $"makelock".
+Definition _mallocN : ident := $"mallocN".
+Definition _mid : ident := $"mid".
+Definition _p : ident := $"p".
+Definition _pa : ident := $"pa".
+Definition _pb : ident := $"pb".
+Definition _pushdown_left : ident := $"pushdown_left".
+Definition _q : ident := $"q".
 Definition _r : ident := $"r".
+Definition _read : ident := $"read".
 Definition _release : ident := $"release".
+Definition _right : ident := $"right".
+Definition _s : ident := $"s".
+Definition _search : ident := $"search".
 Definition _spawn : ident := $"spawn".
+Definition _sub1 : ident := $"sub1".
+Definition _sub2 : ident := $"sub2".
+Definition _sub3 : ident := $"sub3".
 Definition _t : ident := $"t".
-Definition _thrd_create : ident := $"thrd_create".
-Definition _thrd_exit : ident := $"thrd_exit".
+Definition _tail : ident := $"tail".
+Definition _tgt : ident := $"tgt".
 Definition _thread_func : ident := $"thread_func".
 Definition _thread_lock : ident := $"thread_lock".
+Definition _tree : ident := $"tree".
+Definition _tree_free : ident := $"tree_free".
+Definition _treebox_free : ident := $"treebox_free".
+Definition _treebox_new : ident := $"treebox_new".
+Definition _turn_left : ident := $"turn_left".
+Definition _u : ident := $"u".
+Definition _v : ident := $"v".
+Definition _val : ident := $"val".
+Definition _value : ident := $"value".
+Definition _x : ident := $"x".
+Definition _x1 : ident := $"x1".
+Definition _x2 : ident := $"x2".
+Definition _y : ident := $"y".
+Definition _y1 : ident := $"y1".
+Definition _y2 : ident := $"y2".
+Definition _z : ident := $"z".
 Definition _t'1 : ident := 128%positive.
 Definition _t'2 : ident := 129%positive.
 Definition _t'3 : ident := 130%positive.
@@ -127,7 +174,7 @@ Definition f_init_ctr := {|
   fn_params := nil;
   fn_vars := nil;
   fn_temps := ((_t'1, (tptr (Tstruct _atom_int noattr))) ::
-               (_t'2, (tptr (Tstruct _atom_int noattr))) :: nil);
+               (_t'2, (tptr (tptr (Tstruct _atom_int noattr)))) :: nil);
   fn_body :=
 (Ssequence
   (Sassign (Efield (Evar _c (Tstruct _counter noattr)) _ctr tuint)
@@ -135,21 +182,20 @@ Definition f_init_ctr := {|
   (Ssequence
     (Ssequence
       (Scall (Some _t'1)
-        (Evar _makelock (Tfunction Tnil (tptr (Tstruct _atom_int noattr))
+        (Evar _makelock (Tfunction nil (tptr (Tstruct _atom_int noattr))
                           cc_default)) nil)
       (Sassign
         (Efield (Evar _c (Tstruct _counter noattr)) _lock
-          (tptr (Tstruct _atom_int noattr)))
+          (tptr (tptr (Tstruct _atom_int noattr))))
         (Etempvar _t'1 (tptr (Tstruct _atom_int noattr)))))
     (Ssequence
       (Sset _t'2
         (Efield (Evar _c (Tstruct _counter noattr)) _lock
-          (tptr (Tstruct _atom_int noattr))))
+          (tptr (tptr (Tstruct _atom_int noattr)))))
       (Scall None
-        (Evar _release (Tfunction
-                         (Tcons (tptr (Tstruct _atom_int noattr)) Tnil) tvoid
-                         cc_default))
-        ((Etempvar _t'2 (tptr (Tstruct _atom_int noattr))) :: nil)))))
+        (Evar _release (Tfunction ((tptr (Tstruct _atom_int noattr)) :: nil)
+                         tvoid cc_default))
+        ((Etempvar _t'2 (tptr (tptr (Tstruct _atom_int noattr)))) :: nil)))))
 |}.
 
 Definition f_dest_ctr := {|
@@ -157,28 +203,26 @@ Definition f_dest_ctr := {|
   fn_callconv := cc_default;
   fn_params := nil;
   fn_vars := nil;
-  fn_temps := ((_t'2, (tptr (Tstruct _atom_int noattr))) ::
-               (_t'1, (tptr (Tstruct _atom_int noattr))) :: nil);
+  fn_temps := ((_t'2, (tptr (tptr (Tstruct _atom_int noattr)))) ::
+               (_t'1, (tptr (tptr (Tstruct _atom_int noattr)))) :: nil);
   fn_body :=
 (Ssequence
   (Ssequence
     (Sset _t'2
       (Efield (Evar _c (Tstruct _counter noattr)) _lock
-        (tptr (Tstruct _atom_int noattr))))
+        (tptr (tptr (Tstruct _atom_int noattr)))))
     (Scall None
-      (Evar _acquire (Tfunction
-                       (Tcons (tptr (Tstruct _atom_int noattr)) Tnil) tvoid
-                       cc_default))
-      ((Etempvar _t'2 (tptr (Tstruct _atom_int noattr))) :: nil)))
+      (Evar _acquire (Tfunction ((tptr (Tstruct _atom_int noattr)) :: nil)
+                       tvoid cc_default))
+      ((Etempvar _t'2 (tptr (tptr (Tstruct _atom_int noattr)))) :: nil)))
   (Ssequence
     (Sset _t'1
       (Efield (Evar _c (Tstruct _counter noattr)) _lock
-        (tptr (Tstruct _atom_int noattr))))
+        (tptr (tptr (Tstruct _atom_int noattr)))))
     (Scall None
-      (Evar _freelock (Tfunction
-                        (Tcons (tptr (Tstruct _atom_int noattr)) Tnil) tvoid
-                        cc_default))
-      ((Etempvar _t'1 (tptr (Tstruct _atom_int noattr))) :: nil))))
+      (Evar _freelock (Tfunction ((tptr (Tstruct _atom_int noattr)) :: nil)
+                        tvoid cc_default))
+      ((Etempvar _t'1 (tptr (tptr (Tstruct _atom_int noattr)))) :: nil))))
 |}.
 
 Definition f_incr := {|
@@ -186,19 +230,19 @@ Definition f_incr := {|
   fn_callconv := cc_default;
   fn_params := nil;
   fn_vars := nil;
-  fn_temps := ((_t'3, (tptr (Tstruct _atom_int noattr))) :: (_t'2, tuint) ::
-               (_t'1, (tptr (Tstruct _atom_int noattr))) :: nil);
+  fn_temps := ((_t'3, (tptr (tptr (Tstruct _atom_int noattr)))) ::
+               (_t'2, tuint) ::
+               (_t'1, (tptr (tptr (Tstruct _atom_int noattr)))) :: nil);
   fn_body :=
 (Ssequence
   (Ssequence
     (Sset _t'3
       (Efield (Evar _c (Tstruct _counter noattr)) _lock
-        (tptr (Tstruct _atom_int noattr))))
+        (tptr (tptr (Tstruct _atom_int noattr)))))
     (Scall None
-      (Evar _acquire (Tfunction
-                       (Tcons (tptr (Tstruct _atom_int noattr)) Tnil) tvoid
-                       cc_default))
-      ((Etempvar _t'3 (tptr (Tstruct _atom_int noattr))) :: nil)))
+      (Evar _acquire (Tfunction ((tptr (Tstruct _atom_int noattr)) :: nil)
+                       tvoid cc_default))
+      ((Etempvar _t'3 (tptr (tptr (Tstruct _atom_int noattr)))) :: nil)))
   (Ssequence
     (Ssequence
       (Sset _t'2 (Efield (Evar _c (Tstruct _counter noattr)) _ctr tuint))
@@ -208,12 +252,11 @@ Definition f_incr := {|
     (Ssequence
       (Sset _t'1
         (Efield (Evar _c (Tstruct _counter noattr)) _lock
-          (tptr (Tstruct _atom_int noattr))))
+          (tptr (tptr (Tstruct _atom_int noattr)))))
       (Scall None
-        (Evar _release (Tfunction
-                         (Tcons (tptr (Tstruct _atom_int noattr)) Tnil) tvoid
-                         cc_default))
-        ((Etempvar _t'1 (tptr (Tstruct _atom_int noattr))) :: nil)))))
+        (Evar _release (Tfunction ((tptr (Tstruct _atom_int noattr)) :: nil)
+                         tvoid cc_default))
+        ((Etempvar _t'1 (tptr (tptr (Tstruct _atom_int noattr)))) :: nil)))))
 |}.
 
 Definition f_thread_func := {|
@@ -221,19 +264,19 @@ Definition f_thread_func := {|
   fn_callconv := cc_default;
   fn_params := ((_args, (tptr tvoid)) :: nil);
   fn_vars := nil;
-  fn_temps := ((_l, (tptr (Tstruct _atom_int noattr))) :: nil);
+  fn_temps := ((_l, (tptr (tptr (Tstruct _atom_int noattr)))) :: nil);
   fn_body :=
 (Ssequence
   (Sset _l
-    (Ecast (Etempvar _args (tptr tvoid)) (tptr (Tstruct _atom_int noattr))))
+    (Ecast (Etempvar _args (tptr tvoid))
+      (tptr (tptr (Tstruct _atom_int noattr)))))
   (Ssequence
-    (Scall None (Evar _incr (Tfunction Tnil tvoid cc_default)) nil)
+    (Scall None (Evar _incr (Tfunction nil tvoid cc_default)) nil)
     (Ssequence
       (Scall None
-        (Evar _release (Tfunction
-                         (Tcons (tptr (Tstruct _atom_int noattr)) Tnil) tvoid
-                         cc_default))
-        ((Etempvar _l (tptr (Tstruct _atom_int noattr))) :: nil))
+        (Evar _release (Tfunction ((tptr (Tstruct _atom_int noattr)) :: nil)
+                         tvoid cc_default))
+        ((Etempvar _l (tptr (tptr (Tstruct _atom_int noattr)))) :: nil))
       (Sreturn (Some (Econst_int (Int.repr 0) tint))))))
 |}.
 
@@ -241,17 +284,17 @@ Definition f_main := {|
   fn_return := tint;
   fn_callconv := cc_default;
   fn_params := nil;
-  fn_vars := ((_thread_lock, (tarray (tptr (Tstruct _atom_int noattr)) 5)) ::
-              nil);
+  fn_vars := ((_thread_lock,
+               (tarray (tptr (tptr (Tstruct _atom_int noattr))) 5)) :: nil);
   fn_temps := ((_i, tint) :: (_i__1, tint) :: (_t, tuint) ::
                (_t'1, (tptr (Tstruct _atom_int noattr))) ::
-               (_t'4, (tptr (Tstruct _atom_int noattr))) ::
-               (_t'3, (tptr (Tstruct _atom_int noattr))) ::
-               (_t'2, (tptr (Tstruct _atom_int noattr))) :: nil);
+               (_t'4, (tptr (tptr (Tstruct _atom_int noattr)))) ::
+               (_t'3, (tptr (tptr (Tstruct _atom_int noattr)))) ::
+               (_t'2, (tptr (tptr (Tstruct _atom_int noattr)))) :: nil);
   fn_body :=
 (Ssequence
   (Ssequence
-    (Scall None (Evar _init_ctr (Tfunction Tnil tvoid cc_default)) nil)
+    (Scall None (Evar _init_ctr (Tfunction nil tvoid cc_default)) nil)
     (Ssequence
       (Ssequence
         (Sset _i (Econst_int (Int.repr 0) tint))
@@ -264,40 +307,38 @@ Definition f_main := {|
             (Ssequence
               (Ssequence
                 (Scall (Some _t'1)
-                  (Evar _makelock (Tfunction Tnil
+                  (Evar _makelock (Tfunction nil
                                     (tptr (Tstruct _atom_int noattr))
                                     cc_default)) nil)
                 (Sassign
                   (Ederef
                     (Ebinop Oadd
-                      (Evar _thread_lock (tarray (tptr (Tstruct _atom_int noattr)) 5))
+                      (Evar _thread_lock (tarray (tptr (tptr (Tstruct _atom_int noattr))) 5))
                       (Etempvar _i tint)
-                      (tptr (tptr (Tstruct _atom_int noattr))))
-                    (tptr (Tstruct _atom_int noattr)))
+                      (tptr (tptr (tptr (Tstruct _atom_int noattr)))))
+                    (tptr (tptr (Tstruct _atom_int noattr))))
                   (Etempvar _t'1 (tptr (Tstruct _atom_int noattr)))))
               (Ssequence
                 (Sset _t'4
                   (Ederef
                     (Ebinop Oadd
-                      (Evar _thread_lock (tarray (tptr (Tstruct _atom_int noattr)) 5))
+                      (Evar _thread_lock (tarray (tptr (tptr (Tstruct _atom_int noattr))) 5))
                       (Etempvar _i tint)
-                      (tptr (tptr (Tstruct _atom_int noattr))))
-                    (tptr (Tstruct _atom_int noattr))))
+                      (tptr (tptr (tptr (Tstruct _atom_int noattr)))))
+                    (tptr (tptr (Tstruct _atom_int noattr)))))
                 (Scall None
                   (Evar _spawn (Tfunction
-                                 (Tcons
-                                   (tptr (Tfunction (Tcons (tptr tvoid) Tnil)
-                                           tint cc_default))
-                                   (Tcons (tptr tvoid) Tnil)) tvoid
-                                 cc_default))
+                                 ((tptr (Tfunction ((tptr tvoid) :: nil) tint
+                                          cc_default)) :: (tptr tvoid) ::
+                                  nil) tvoid cc_default))
                   ((Ecast
                      (Eaddrof
-                       (Evar _thread_func (Tfunction
-                                            (Tcons (tptr tvoid) Tnil) tint
-                                            cc_default))
-                       (tptr (Tfunction (Tcons (tptr tvoid) Tnil) tint
+                       (Evar _thread_func (Tfunction ((tptr tvoid) :: nil)
+                                            tint cc_default))
+                       (tptr (Tfunction ((tptr tvoid) :: nil) tint
                                cc_default))) (tptr tvoid)) ::
-                   (Ecast (Etempvar _t'4 (tptr (Tstruct _atom_int noattr)))
+                   (Ecast
+                     (Etempvar _t'4 (tptr (tptr (Tstruct _atom_int noattr))))
                      (tptr tvoid)) :: nil)))))
           (Sset _i
             (Ebinop Oadd (Etempvar _i tint) (Econst_int (Int.repr 1) tint)
@@ -316,36 +357,35 @@ Definition f_main := {|
                   (Sset _t'3
                     (Ederef
                       (Ebinop Oadd
-                        (Evar _thread_lock (tarray (tptr (Tstruct _atom_int noattr)) 5))
+                        (Evar _thread_lock (tarray (tptr (tptr (Tstruct _atom_int noattr))) 5))
                         (Etempvar _i__1 tint)
-                        (tptr (tptr (Tstruct _atom_int noattr))))
-                      (tptr (Tstruct _atom_int noattr))))
+                        (tptr (tptr (tptr (Tstruct _atom_int noattr)))))
+                      (tptr (tptr (Tstruct _atom_int noattr)))))
                   (Scall None
                     (Evar _acquire (Tfunction
-                                     (Tcons (tptr (Tstruct _atom_int noattr))
-                                       Tnil) tvoid cc_default))
-                    ((Etempvar _t'3 (tptr (Tstruct _atom_int noattr))) ::
+                                     ((tptr (Tstruct _atom_int noattr)) ::
+                                      nil) tvoid cc_default))
+                    ((Etempvar _t'3 (tptr (tptr (Tstruct _atom_int noattr)))) ::
                      nil)))
                 (Ssequence
                   (Sset _t'2
                     (Ederef
                       (Ebinop Oadd
-                        (Evar _thread_lock (tarray (tptr (Tstruct _atom_int noattr)) 5))
+                        (Evar _thread_lock (tarray (tptr (tptr (Tstruct _atom_int noattr))) 5))
                         (Etempvar _i__1 tint)
-                        (tptr (tptr (Tstruct _atom_int noattr))))
-                      (tptr (Tstruct _atom_int noattr))))
+                        (tptr (tptr (tptr (Tstruct _atom_int noattr)))))
+                      (tptr (tptr (Tstruct _atom_int noattr)))))
                   (Scall None
                     (Evar _freelock (Tfunction
-                                      (Tcons
-                                        (tptr (Tstruct _atom_int noattr))
-                                        Tnil) tvoid cc_default))
-                    ((Etempvar _t'2 (tptr (Tstruct _atom_int noattr))) ::
+                                      ((tptr (Tstruct _atom_int noattr)) ::
+                                       nil) tvoid cc_default))
+                    ((Etempvar _t'2 (tptr (tptr (Tstruct _atom_int noattr)))) ::
                      nil)))))
             (Sset _i__1
               (Ebinop Oadd (Etempvar _i__1 tint)
                 (Econst_int (Int.repr 1) tint) tint))))
         (Ssequence
-          (Scall None (Evar _dest_ctr (Tfunction Tnil tvoid cc_default)) nil)
+          (Scall None (Evar _dest_ctr (Tfunction nil tvoid cc_default)) nil)
           (Ssequence
             (Sset _t (Efield (Evar _c (Tstruct _counter noattr)) _ctr tuint))
             (Sreturn (Some (Etempvar _t tuint))))))))
@@ -355,293 +395,288 @@ Definition f_main := {|
 Definition composites : list composite_definition :=
 (Composite _counter Struct
    (Member_plain _ctr tuint ::
-    Member_plain _lock (tptr (Tstruct _atom_int noattr)) :: nil)
+    Member_plain _lock (tptr (tptr (Tstruct _atom_int noattr))) :: nil)
    noattr :: nil).
 
 Definition global_definitions : list (ident * globdef fundef type) :=
 ((___compcert_va_int32,
    Gfun(External (EF_runtime "__compcert_va_int32"
-                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
-     (Tcons (tptr tvoid) Tnil) tuint cc_default)) ::
+                   (mksignature (AST.Xptr :: nil) AST.Xint cc_default))
+     ((tptr tvoid) :: nil) tuint cc_default)) ::
  (___compcert_va_int64,
    Gfun(External (EF_runtime "__compcert_va_int64"
-                   (mksignature (AST.Tlong :: nil) AST.Tlong cc_default))
-     (Tcons (tptr tvoid) Tnil) tulong cc_default)) ::
+                   (mksignature (AST.Xptr :: nil) AST.Xlong cc_default))
+     ((tptr tvoid) :: nil) tulong cc_default)) ::
  (___compcert_va_float64,
    Gfun(External (EF_runtime "__compcert_va_float64"
-                   (mksignature (AST.Tlong :: nil) AST.Tfloat cc_default))
-     (Tcons (tptr tvoid) Tnil) tdouble cc_default)) ::
+                   (mksignature (AST.Xptr :: nil) AST.Xfloat cc_default))
+     ((tptr tvoid) :: nil) tdouble cc_default)) ::
  (___compcert_va_composite,
    Gfun(External (EF_runtime "__compcert_va_composite"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
-                     cc_default)) (Tcons (tptr tvoid) (Tcons tulong Tnil))
+                   (mksignature (AST.Xptr :: AST.Xlong :: nil) AST.Xptr
+                     cc_default)) ((tptr tvoid) :: tulong :: nil)
      (tptr tvoid) cc_default)) ::
  (___compcert_i64_dtos,
    Gfun(External (EF_runtime "__compcert_i64_dtos"
-                   (mksignature (AST.Tfloat :: nil) AST.Tlong cc_default))
-     (Tcons tdouble Tnil) tlong cc_default)) ::
+                   (mksignature (AST.Xfloat :: nil) AST.Xlong cc_default))
+     (tdouble :: nil) tlong cc_default)) ::
  (___compcert_i64_dtou,
    Gfun(External (EF_runtime "__compcert_i64_dtou"
-                   (mksignature (AST.Tfloat :: nil) AST.Tlong cc_default))
-     (Tcons tdouble Tnil) tulong cc_default)) ::
+                   (mksignature (AST.Xfloat :: nil) AST.Xlong cc_default))
+     (tdouble :: nil) tulong cc_default)) ::
  (___compcert_i64_stod,
    Gfun(External (EF_runtime "__compcert_i64_stod"
-                   (mksignature (AST.Tlong :: nil) AST.Tfloat cc_default))
-     (Tcons tlong Tnil) tdouble cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xfloat cc_default))
+     (tlong :: nil) tdouble cc_default)) ::
  (___compcert_i64_utod,
    Gfun(External (EF_runtime "__compcert_i64_utod"
-                   (mksignature (AST.Tlong :: nil) AST.Tfloat cc_default))
-     (Tcons tulong Tnil) tdouble cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xfloat cc_default))
+     (tulong :: nil) tdouble cc_default)) ::
  (___compcert_i64_stof,
    Gfun(External (EF_runtime "__compcert_i64_stof"
-                   (mksignature (AST.Tlong :: nil) AST.Tsingle cc_default))
-     (Tcons tlong Tnil) tfloat cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xsingle cc_default))
+     (tlong :: nil) tfloat cc_default)) ::
  (___compcert_i64_utof,
    Gfun(External (EF_runtime "__compcert_i64_utof"
-                   (mksignature (AST.Tlong :: nil) AST.Tsingle cc_default))
-     (Tcons tulong Tnil) tfloat cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xsingle cc_default))
+     (tulong :: nil) tfloat cc_default)) ::
  (___compcert_i64_sdiv,
    Gfun(External (EF_runtime "__compcert_i64_sdiv"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
-                     cc_default)) (Tcons tlong (Tcons tlong Tnil)) tlong
-     cc_default)) ::
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tlong :: tlong :: nil) tlong cc_default)) ::
  (___compcert_i64_udiv,
    Gfun(External (EF_runtime "__compcert_i64_udiv"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
-                     cc_default)) (Tcons tulong (Tcons tulong Tnil)) tulong
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tulong :: tulong :: nil) tulong
      cc_default)) ::
  (___compcert_i64_smod,
    Gfun(External (EF_runtime "__compcert_i64_smod"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
-                     cc_default)) (Tcons tlong (Tcons tlong Tnil)) tlong
-     cc_default)) ::
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tlong :: tlong :: nil) tlong cc_default)) ::
  (___compcert_i64_umod,
    Gfun(External (EF_runtime "__compcert_i64_umod"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
-                     cc_default)) (Tcons tulong (Tcons tulong Tnil)) tulong
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tulong :: tulong :: nil) tulong
      cc_default)) ::
  (___compcert_i64_shl,
    Gfun(External (EF_runtime "__compcert_i64_shl"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tlong
-                     cc_default)) (Tcons tlong (Tcons tint Tnil)) tlong
-     cc_default)) ::
+                   (mksignature (AST.Xlong :: AST.Xint :: nil) AST.Xlong
+                     cc_default)) (tlong :: tint :: nil) tlong cc_default)) ::
  (___compcert_i64_shr,
    Gfun(External (EF_runtime "__compcert_i64_shr"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tlong
-                     cc_default)) (Tcons tulong (Tcons tint Tnil)) tulong
-     cc_default)) ::
+                   (mksignature (AST.Xlong :: AST.Xint :: nil) AST.Xlong
+                     cc_default)) (tulong :: tint :: nil) tulong cc_default)) ::
  (___compcert_i64_sar,
    Gfun(External (EF_runtime "__compcert_i64_sar"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tlong
-                     cc_default)) (Tcons tlong (Tcons tint Tnil)) tlong
-     cc_default)) ::
+                   (mksignature (AST.Xlong :: AST.Xint :: nil) AST.Xlong
+                     cc_default)) (tlong :: tint :: nil) tlong cc_default)) ::
  (___compcert_i64_smulh,
    Gfun(External (EF_runtime "__compcert_i64_smulh"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
-                     cc_default)) (Tcons tlong (Tcons tlong Tnil)) tlong
-     cc_default)) ::
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tlong :: tlong :: nil) tlong cc_default)) ::
  (___compcert_i64_umulh,
    Gfun(External (EF_runtime "__compcert_i64_umulh"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
-                     cc_default)) (Tcons tulong (Tcons tulong Tnil)) tulong
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tulong :: tulong :: nil) tulong
      cc_default)) ::
+ (___builtin_ais_annot,
+   Gfun(External (EF_builtin "__builtin_ais_annot"
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid
+                     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
+     ((tptr tschar) :: nil) tvoid
+     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
  (___builtin_bswap64,
    Gfun(External (EF_builtin "__builtin_bswap64"
-                   (mksignature (AST.Tlong :: nil) AST.Tlong cc_default))
-     (Tcons tulong Tnil) tulong cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xlong cc_default))
+     (tulong :: nil) tulong cc_default)) ::
  (___builtin_bswap,
    Gfun(External (EF_builtin "__builtin_bswap"
-                   (mksignature (AST.Tint :: nil) AST.Tint cc_default))
-     (Tcons tuint Tnil) tuint cc_default)) ::
+                   (mksignature (AST.Xint :: nil) AST.Xint cc_default))
+     (tuint :: nil) tuint cc_default)) ::
  (___builtin_bswap32,
    Gfun(External (EF_builtin "__builtin_bswap32"
-                   (mksignature (AST.Tint :: nil) AST.Tint cc_default))
-     (Tcons tuint Tnil) tuint cc_default)) ::
+                   (mksignature (AST.Xint :: nil) AST.Xint cc_default))
+     (tuint :: nil) tuint cc_default)) ::
  (___builtin_bswap16,
    Gfun(External (EF_builtin "__builtin_bswap16"
-                   (mksignature (AST.Tint :: nil) AST.Tint16unsigned
-                     cc_default)) (Tcons tushort Tnil) tushort cc_default)) ::
+                   (mksignature (AST.Xint16unsigned :: nil)
+                     AST.Xint16unsigned cc_default)) (tushort :: nil) tushort
+     cc_default)) ::
  (___builtin_clz,
    Gfun(External (EF_builtin "__builtin_clz"
-                   (mksignature (AST.Tint :: nil) AST.Tint cc_default))
-     (Tcons tuint Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xint :: nil) AST.Xint cc_default))
+     (tuint :: nil) tint cc_default)) ::
  (___builtin_clzl,
    Gfun(External (EF_builtin "__builtin_clzl"
-                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
-     (Tcons tulong Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xint cc_default))
+     (tulong :: nil) tint cc_default)) ::
  (___builtin_clzll,
    Gfun(External (EF_builtin "__builtin_clzll"
-                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
-     (Tcons tulong Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xint cc_default))
+     (tulong :: nil) tint cc_default)) ::
  (___builtin_ctz,
    Gfun(External (EF_builtin "__builtin_ctz"
-                   (mksignature (AST.Tint :: nil) AST.Tint cc_default))
-     (Tcons tuint Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xint :: nil) AST.Xint cc_default))
+     (tuint :: nil) tint cc_default)) ::
  (___builtin_ctzl,
    Gfun(External (EF_builtin "__builtin_ctzl"
-                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
-     (Tcons tulong Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xint cc_default))
+     (tulong :: nil) tint cc_default)) ::
  (___builtin_ctzll,
    Gfun(External (EF_builtin "__builtin_ctzll"
-                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
-     (Tcons tulong Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xint cc_default))
+     (tulong :: nil) tint cc_default)) ::
  (___builtin_fabs,
    Gfun(External (EF_builtin "__builtin_fabs"
-                   (mksignature (AST.Tfloat :: nil) AST.Tfloat cc_default))
-     (Tcons tdouble Tnil) tdouble cc_default)) ::
+                   (mksignature (AST.Xfloat :: nil) AST.Xfloat cc_default))
+     (tdouble :: nil) tdouble cc_default)) ::
  (___builtin_fabsf,
    Gfun(External (EF_builtin "__builtin_fabsf"
-                   (mksignature (AST.Tsingle :: nil) AST.Tsingle cc_default))
-     (Tcons tfloat Tnil) tfloat cc_default)) ::
+                   (mksignature (AST.Xsingle :: nil) AST.Xsingle cc_default))
+     (tfloat :: nil) tfloat cc_default)) ::
  (___builtin_fsqrt,
    Gfun(External (EF_builtin "__builtin_fsqrt"
-                   (mksignature (AST.Tfloat :: nil) AST.Tfloat cc_default))
-     (Tcons tdouble Tnil) tdouble cc_default)) ::
+                   (mksignature (AST.Xfloat :: nil) AST.Xfloat cc_default))
+     (tdouble :: nil) tdouble cc_default)) ::
  (___builtin_sqrt,
    Gfun(External (EF_builtin "__builtin_sqrt"
-                   (mksignature (AST.Tfloat :: nil) AST.Tfloat cc_default))
-     (Tcons tdouble Tnil) tdouble cc_default)) ::
+                   (mksignature (AST.Xfloat :: nil) AST.Xfloat cc_default))
+     (tdouble :: nil) tdouble cc_default)) ::
  (___builtin_memcpy_aligned,
    Gfun(External (EF_builtin "__builtin_memcpy_aligned"
                    (mksignature
-                     (AST.Tlong :: AST.Tlong :: AST.Tlong :: AST.Tlong ::
-                      nil) AST.Tvoid cc_default))
-     (Tcons (tptr tvoid)
-       (Tcons (tptr tvoid) (Tcons tulong (Tcons tulong Tnil)))) tvoid
+                     (AST.Xptr :: AST.Xptr :: AST.Xlong :: AST.Xlong :: nil)
+                     AST.Xvoid cc_default))
+     ((tptr tvoid) :: (tptr tvoid) :: tulong :: tulong :: nil) tvoid
      cc_default)) ::
  (___builtin_sel,
    Gfun(External (EF_builtin "__builtin_sel"
-                   (mksignature (AST.Tint :: nil) AST.Tvoid
+                   (mksignature (AST.Xbool :: nil) AST.Xvoid
                      {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
-     (Tcons tbool Tnil) tvoid
+     (tbool :: nil) tvoid
      {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
  (___builtin_annot,
    Gfun(External (EF_builtin "__builtin_annot"
-                   (mksignature (AST.Tlong :: nil) AST.Tvoid
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid
                      {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
-     (Tcons (tptr tschar) Tnil) tvoid
+     ((tptr tschar) :: nil) tvoid
      {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
  (___builtin_annot_intval,
    Gfun(External (EF_builtin "__builtin_annot_intval"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tint
-                     cc_default)) (Tcons (tptr tschar) (Tcons tint Tnil))
-     tint cc_default)) ::
+                   (mksignature (AST.Xptr :: AST.Xint :: nil) AST.Xint
+                     cc_default)) ((tptr tschar) :: tint :: nil) tint
+     cc_default)) ::
  (___builtin_membar,
    Gfun(External (EF_builtin "__builtin_membar"
-                   (mksignature nil AST.Tvoid cc_default)) Tnil tvoid
+                   (mksignature nil AST.Xvoid cc_default)) nil tvoid
      cc_default)) ::
  (___builtin_va_start,
    Gfun(External (EF_builtin "__builtin_va_start"
-                   (mksignature (AST.Tlong :: nil) AST.Tvoid cc_default))
-     (Tcons (tptr tvoid) Tnil) tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid cc_default))
+     ((tptr tvoid) :: nil) tvoid cc_default)) ::
  (___builtin_va_arg,
    Gfun(External (EF_builtin "__builtin_va_arg"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tvoid
-                     cc_default)) (Tcons (tptr tvoid) (Tcons tuint Tnil))
-     tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: AST.Xint :: nil) AST.Xvoid
+                     cc_default)) ((tptr tvoid) :: tuint :: nil) tvoid
+     cc_default)) ::
  (___builtin_va_copy,
    Gfun(External (EF_builtin "__builtin_va_copy"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tvoid
-                     cc_default))
-     (Tcons (tptr tvoid) (Tcons (tptr tvoid) Tnil)) tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: AST.Xptr :: nil) AST.Xvoid
+                     cc_default)) ((tptr tvoid) :: (tptr tvoid) :: nil) tvoid
+     cc_default)) ::
  (___builtin_va_end,
    Gfun(External (EF_builtin "__builtin_va_end"
-                   (mksignature (AST.Tlong :: nil) AST.Tvoid cc_default))
-     (Tcons (tptr tvoid) Tnil) tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid cc_default))
+     ((tptr tvoid) :: nil) tvoid cc_default)) ::
  (___builtin_unreachable,
    Gfun(External (EF_builtin "__builtin_unreachable"
-                   (mksignature nil AST.Tvoid cc_default)) Tnil tvoid
+                   (mksignature nil AST.Xvoid cc_default)) nil tvoid
      cc_default)) ::
  (___builtin_expect,
    Gfun(External (EF_builtin "__builtin_expect"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
-                     cc_default)) (Tcons tlong (Tcons tlong Tnil)) tlong
-     cc_default)) ::
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tlong :: tlong :: nil) tlong cc_default)) ::
  (___builtin_fmax,
    Gfun(External (EF_builtin "__builtin_fmax"
-                   (mksignature (AST.Tfloat :: AST.Tfloat :: nil) AST.Tfloat
-                     cc_default)) (Tcons tdouble (Tcons tdouble Tnil))
-     tdouble cc_default)) ::
+                   (mksignature (AST.Xfloat :: AST.Xfloat :: nil) AST.Xfloat
+                     cc_default)) (tdouble :: tdouble :: nil) tdouble
+     cc_default)) ::
  (___builtin_fmin,
    Gfun(External (EF_builtin "__builtin_fmin"
-                   (mksignature (AST.Tfloat :: AST.Tfloat :: nil) AST.Tfloat
-                     cc_default)) (Tcons tdouble (Tcons tdouble Tnil))
-     tdouble cc_default)) ::
+                   (mksignature (AST.Xfloat :: AST.Xfloat :: nil) AST.Xfloat
+                     cc_default)) (tdouble :: tdouble :: nil) tdouble
+     cc_default)) ::
  (___builtin_fmadd,
    Gfun(External (EF_builtin "__builtin_fmadd"
                    (mksignature
-                     (AST.Tfloat :: AST.Tfloat :: AST.Tfloat :: nil)
-                     AST.Tfloat cc_default))
-     (Tcons tdouble (Tcons tdouble (Tcons tdouble Tnil))) tdouble
-     cc_default)) ::
+                     (AST.Xfloat :: AST.Xfloat :: AST.Xfloat :: nil)
+                     AST.Xfloat cc_default))
+     (tdouble :: tdouble :: tdouble :: nil) tdouble cc_default)) ::
  (___builtin_fmsub,
    Gfun(External (EF_builtin "__builtin_fmsub"
                    (mksignature
-                     (AST.Tfloat :: AST.Tfloat :: AST.Tfloat :: nil)
-                     AST.Tfloat cc_default))
-     (Tcons tdouble (Tcons tdouble (Tcons tdouble Tnil))) tdouble
-     cc_default)) ::
+                     (AST.Xfloat :: AST.Xfloat :: AST.Xfloat :: nil)
+                     AST.Xfloat cc_default))
+     (tdouble :: tdouble :: tdouble :: nil) tdouble cc_default)) ::
  (___builtin_fnmadd,
    Gfun(External (EF_builtin "__builtin_fnmadd"
                    (mksignature
-                     (AST.Tfloat :: AST.Tfloat :: AST.Tfloat :: nil)
-                     AST.Tfloat cc_default))
-     (Tcons tdouble (Tcons tdouble (Tcons tdouble Tnil))) tdouble
-     cc_default)) ::
+                     (AST.Xfloat :: AST.Xfloat :: AST.Xfloat :: nil)
+                     AST.Xfloat cc_default))
+     (tdouble :: tdouble :: tdouble :: nil) tdouble cc_default)) ::
  (___builtin_fnmsub,
    Gfun(External (EF_builtin "__builtin_fnmsub"
                    (mksignature
-                     (AST.Tfloat :: AST.Tfloat :: AST.Tfloat :: nil)
-                     AST.Tfloat cc_default))
-     (Tcons tdouble (Tcons tdouble (Tcons tdouble Tnil))) tdouble
-     cc_default)) ::
+                     (AST.Xfloat :: AST.Xfloat :: AST.Xfloat :: nil)
+                     AST.Xfloat cc_default))
+     (tdouble :: tdouble :: tdouble :: nil) tdouble cc_default)) ::
  (___builtin_read16_reversed,
    Gfun(External (EF_builtin "__builtin_read16_reversed"
-                   (mksignature (AST.Tlong :: nil) AST.Tint16unsigned
-                     cc_default)) (Tcons (tptr tushort) Tnil) tushort
+                   (mksignature (AST.Xptr :: nil) AST.Xint16unsigned
+                     cc_default)) ((tptr tushort) :: nil) tushort
      cc_default)) ::
  (___builtin_read32_reversed,
    Gfun(External (EF_builtin "__builtin_read32_reversed"
-                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
-     (Tcons (tptr tuint) Tnil) tuint cc_default)) ::
+                   (mksignature (AST.Xptr :: nil) AST.Xint cc_default))
+     ((tptr tuint) :: nil) tuint cc_default)) ::
  (___builtin_write16_reversed,
    Gfun(External (EF_builtin "__builtin_write16_reversed"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tvoid
-                     cc_default)) (Tcons (tptr tushort) (Tcons tushort Tnil))
-     tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: AST.Xint16unsigned :: nil)
+                     AST.Xvoid cc_default))
+     ((tptr tushort) :: tushort :: nil) tvoid cc_default)) ::
  (___builtin_write32_reversed,
    Gfun(External (EF_builtin "__builtin_write32_reversed"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tvoid
-                     cc_default)) (Tcons (tptr tuint) (Tcons tuint Tnil))
-     tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: AST.Xint :: nil) AST.Xvoid
+                     cc_default)) ((tptr tuint) :: tuint :: nil) tvoid
+     cc_default)) ::
  (___builtin_debug,
    Gfun(External (EF_external "__builtin_debug"
-                   (mksignature (AST.Tint :: nil) AST.Tvoid
+                   (mksignature (AST.Xint :: nil) AST.Xvoid
                      {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
-     (Tcons tint Tnil) tvoid
+     (tint :: nil) tvoid
      {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
  (_makelock,
    Gfun(External (EF_external "makelock"
-                   (mksignature nil AST.Tlong cc_default)) Tnil
+                   (mksignature nil AST.Xptr cc_default)) nil
      (tptr (Tstruct _atom_int noattr)) cc_default)) ::
  (_freelock,
    Gfun(External (EF_external "freelock"
-                   (mksignature (AST.Tlong :: nil) AST.Tvoid cc_default))
-     (Tcons (tptr (Tstruct _atom_int noattr)) Tnil) tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid cc_default))
+     ((tptr (Tstruct _atom_int noattr)) :: nil) tvoid cc_default)) ::
  (_acquire,
    Gfun(External (EF_external "acquire"
-                   (mksignature (AST.Tlong :: nil) AST.Tvoid cc_default))
-     (Tcons (tptr (Tstruct _atom_int noattr)) Tnil) tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid cc_default))
+     ((tptr (Tstruct _atom_int noattr)) :: nil) tvoid cc_default)) ::
  (_release,
    Gfun(External (EF_external "release"
-                   (mksignature (AST.Tlong :: nil) AST.Tvoid cc_default))
-     (Tcons (tptr (Tstruct _atom_int noattr)) Tnil) tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid cc_default))
+     ((tptr (Tstruct _atom_int noattr)) :: nil) tvoid cc_default)) ::
  (_spawn,
    Gfun(External (EF_external "spawn"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tvoid
+                   (mksignature (AST.Xptr :: AST.Xptr :: nil) AST.Xvoid
                      cc_default))
-     (Tcons (tptr (Tfunction (Tcons (tptr tvoid) Tnil) tint cc_default))
-       (Tcons (tptr tvoid) Tnil)) tvoid cc_default)) :: (_c, Gvar v_c) ::
+     ((tptr (Tfunction ((tptr tvoid) :: nil) tint cc_default)) ::
+      (tptr tvoid) :: nil) tvoid cc_default)) :: (_c, Gvar v_c) ::
  (_init_ctr, Gfun(Internal f_init_ctr)) ::
  (_dest_ctr, Gfun(Internal f_dest_ctr)) :: (_incr, Gfun(Internal f_incr)) ::
  (_thread_func, Gfun(Internal f_thread_func)) ::
@@ -662,13 +697,14 @@ Definition public_idents : list ident :=
  ___builtin_ctzll :: ___builtin_ctzl :: ___builtin_ctz :: ___builtin_clzll ::
  ___builtin_clzl :: ___builtin_clz :: ___builtin_bswap16 ::
  ___builtin_bswap32 :: ___builtin_bswap :: ___builtin_bswap64 ::
- ___compcert_i64_umulh :: ___compcert_i64_smulh :: ___compcert_i64_sar ::
- ___compcert_i64_shr :: ___compcert_i64_shl :: ___compcert_i64_umod ::
- ___compcert_i64_smod :: ___compcert_i64_udiv :: ___compcert_i64_sdiv ::
- ___compcert_i64_utof :: ___compcert_i64_stof :: ___compcert_i64_utod ::
- ___compcert_i64_stod :: ___compcert_i64_dtou :: ___compcert_i64_dtos ::
- ___compcert_va_composite :: ___compcert_va_float64 ::
- ___compcert_va_int64 :: ___compcert_va_int32 :: nil).
+ ___builtin_ais_annot :: ___compcert_i64_umulh :: ___compcert_i64_smulh ::
+ ___compcert_i64_sar :: ___compcert_i64_shr :: ___compcert_i64_shl ::
+ ___compcert_i64_umod :: ___compcert_i64_smod :: ___compcert_i64_udiv ::
+ ___compcert_i64_sdiv :: ___compcert_i64_utof :: ___compcert_i64_stof ::
+ ___compcert_i64_utod :: ___compcert_i64_stod :: ___compcert_i64_dtou ::
+ ___compcert_i64_dtos :: ___compcert_va_composite ::
+ ___compcert_va_float64 :: ___compcert_va_int64 :: ___compcert_va_int32 ::
+ nil).
 
 Definition prog : Clight.program := 
   mkprogram composites global_definitions public_idents _main Logic.I.
diff --git a/progs64/io_combine.v b/progs64/io_combine.v
index b6a3664486..0d36044d43 100644
--- a/progs64/io_combine.v
+++ b/progs64/io_combine.v
@@ -2,9 +2,6 @@ Require Import VST.floyd.proofauto.
 Require Import VST.sepcomp.extspec.
 Require Import VST.veric.semax_ext.
 Require Import VST.veric.juicy_mem.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.initial_world.
-Require Import VST.veric.ghost_PCM.
 Require Import VST.veric.SequentialClight.
 Require Import VST.veric.Clight_core.
 Require Import VST.concurrency.conclib.
@@ -18,9 +15,6 @@ Require Import VST.progs64.io_os_specs.
 Require Import VST.progs64.io_os_connection.
 Require Import VST.progs64.os_combine.
 Require Import VST.progs64.dry_mem_lemmas.
-Import Maps.
-
-Opaque eq_dec.eq_dec.
 
 Section IO_safety.
 
@@ -29,6 +23,8 @@ Variable (prog : Clight.program).
 
 Definition ext_link := ext_link_prog prog.
 
+Hypothesis ext_link_inj : forall s1 s2, List.In s1 ["getchar"; "putchar"] -> ext_link s1 = ext_link s2 -> s1 = s2.
+
 Definition sys_getc_wrap_spec (abd : RData) : option (RData * val * trace) :=
   match sys_getc_spec abd with
   | Some abd' => Some (abd', get_sys_ret abd', trace_of_ostrace (strip_common_prefix IOEvent_eq abd.(io_log) abd'.(io_log)))
@@ -80,70 +76,49 @@ Definition OS_mem (e : external_function) (args : list val) m (s : RData) : mem
   else ...
 *)
 
-Instance IO_Espec : OracleKind := IO_Espec ext_link.
-
-Hypothesis (Jsub: forall ef se lv m t v m' (EFI : ef_inline ef = true) m1
-       (EFC : Events.external_call ef se lv m t v m'), mem_sub m m1 ->
-       exists m1' (EFC1 : Events.external_call ef se lv m1 t v m1'),
-         mem_sub m' m1' /\ proj1_sig (inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC1) =
-         proj1_sig (inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC)).
-
-
-Definition extspec_frame (Espec : OracleKind) := forall e t b lt lv z jm w jm1, ext_spec_pre OK_spec e t b lt lv z jm ->
-        mem_sub (m_dry jm) (m_dry jm1) -> join (m_phi jm) w (m_phi jm1) -> semax.ext_compat z (m_phi jm1) ->
-        exists t1, ext_spec_pre OK_spec e t1 b lt lv z jm1 /\
-        forall ot v z' jm1', ext_spec_post OK_spec e t1 b ot v z' jm1' ->
-          exists jm', ext_spec_post OK_spec e t b ot v z' jm' /\ mem_sub (m_dry jm') (m_dry jm1') /\
-            join (m_phi jm') (age_to.age_to (level jm') w) (m_phi jm1').
-
+Notation IO_itree := (@IO_itree (@IO_event nat)).
 
 Theorem IO_OS_soundness:
- forall {CS: compspecs} (initial_oracle: OK_ty) V G m,
-   semax_prog prog initial_oracle V G ->
+ forall {CS: compspecs} `{!VSTGpreS IO_itree Σ} (initial_oracle: IO_itree) V (G : forall `{!VSTGS IO_itree Σ}, funspecs) m,
+   (forall {HH : VSTGS IO_itree Σ}, semax_prog(OK_spec := IO_ext_spec ext_link) prog initial_oracle V G) ->
    Genv.init_mem prog = Some m ->
    exists b, exists q,
      Genv.find_symbol (Genv.globalenv prog) (prog_main prog) = Some b /\
      initial_core (Clight_core.cl_core_sem (globalenv prog))
          0 m q m (Vptr b Ptrofs.zero) nil /\
-   forall n, exists traces, ext_safeN_trace(J := OK_spec) prog IO_ext_sem IO_inj_mem OS_mem valid_trace n TEnd traces initial_oracle q m /\
+   forall n, exists traces, ext_safeN_trace prog IO_ext_sem IO_inj_mem OS_mem valid_trace n TEnd traces initial_oracle q m /\
      forall t, In traces t -> exists z', consume_trace initial_oracle z' t.
 Proof.
-  intros; eapply OS_soundness with (dryspec := io_dry_spec ext_link); eauto.
+  intros; eapply OS_soundness with (dryspec := io_dry_spec); eauto.
   - unfold IO_ext_sem; intros; simpl in *.
     destruct H2 as [Hvalid Htrace].
     if_tac; [|if_tac; [|contradiction]].
-    + destruct w as (? & _ & ? & ?).
+    + destruct w as (? & ? & ?).
       destruct H1 as (? & ? & Hpre); subst.
       destruct s; simpl in *.
-      rewrite if_true in H3 by auto.
+      rewrite -> if_true in H3 by auto.
       destruct (get_sys_arg1 _) eqn:Harg; try discriminate.
       destruct (eq_dec _ _); subst; try discriminate.
       destruct (sys_putc_spec _) eqn:Hspec; inv H3.
-      assert (sig_res (ef_sig e) <> Xvoid).
-      { destruct e; inv H2; discriminate. }
-      eapply sys_putc_correct in Hspec as (? & -> & [? Hpost ?]); eauto.
-    + destruct w as (? & _ & ?).
+      eapply sys_putc_correct in Hspec as (? & -> & [? Hpost ?]); eauto 7.
+    + destruct w as (? & ?).
       destruct H1 as (? & ? & Hpre); subst.
       destruct s; simpl in *.
-      rewrite if_false in H3 by auto.
-      rewrite if_true in H3 by auto.
+      rewrite -> if_false in H3 by auto.
+      rewrite -> if_true in H3 by auto.
       unfold sys_getc_wrap_spec in *.
       destruct (sys_getc_spec) eqn:Hspec; inv H3.
-      assert (sig_res (ef_sig e) <> Xvoid).
-      { destruct e; inv H4; discriminate. }
       eapply (sys_getc_correct _ _ m) in Hspec as (? & -> & [? Hpost ? ?]); eauto.
       * split; auto; do 2 eexists; eauto.
         unfold getchar_post, getchar_post' in *.
-        destruct Hpost as [? Hpost]; split; auto; split; auto.
-        destruct Hpost as [[]|[-> ->]]; split; try (simpl in *; rep_lia).
-        -- rewrite if_false by lia; eauto.
-        -- rewrite if_true; auto.
+        eexists; repeat (split; first done).
+        destruct Hpost as (_ & [[]|[-> ->]]); split; try (simpl in *; auto; rep_lia).
+        rewrite -> if_false by lia; eauto.
       * unfold getchar_pre, getchar_pre' in *.
         apply Traces.sutt_trace_incl; auto.
+  - by apply io_spec_sound.
   - constructor.
-  - apply add_funspecs_frame.
-  - apply juicy_dry_specs.
-  - apply dry_spec_mem.
+  - apply H.
 Qed.
 
 (* relate to OS's external events *)
@@ -153,7 +128,7 @@ Definition trace_set := @trace (@io_events.IO_event nat) unit * RData -> Prop.
 
   Inductive OS_safeN_trace : nat -> @trace io_events.IO_event unit ->
                trace_set ->
-               OK_ty -> RData -> CC_core -> mem -> Prop :=
+               IO_itree -> RData -> CC_core -> mem -> Prop :=
   | OS_safeN_trace_0: forall t z s c m, OS_safeN_trace O t (fun x => x = (TEnd, s)) z s c m
   | OS_safeN_trace_step:
       forall n t traces z s c m c' m',
@@ -187,10 +162,10 @@ Definition trace_set := @trace (@io_events.IO_event nat) unit * RData -> Prop.
       cl_halted c <> None ->
       OS_safeN_trace n t (fun x => x = (TEnd, s)) z s c m.
 
-Lemma strip_all : forall {A} (A_eq : forall x y : A, {x = y} + {x <> y}) t, strip_common_prefix A_eq t t = [].
+Lemma strip_all : forall {A} (A_eq : forall x y : A, {x = y} + {x <> y} ) t, strip_common_prefix A_eq t t = [].
 Proof.
   intros; unfold strip_common_prefix.
-  rewrite common_prefix_full, Nat.leb_refl, skipn_exact_length; auto.
+  rewrite common_prefix_full Nat.leb_refl skipn_exact_length; auto.
 Qed.
 
 Local Ltac inj :=
@@ -222,7 +197,7 @@ Local Ltac destruct_spec Hspec :=
       destruct r1; cbn in *.
       eapply sys_putc_trace_case in Hspec as []; eauto.
       unfold get_sys_ret; cbn.
-      repeat (rewrite ZMap.gss in * || rewrite ZMap.gso in * by easy); subst; inj; reflexivity.
+      repeat (rewrite -> ZMap.gss in * || rewrite -> ZMap.gso in * by easy); subst; inj; reflexivity.
     - unfold sys_getc_wrap_spec.
       destruct sys_getc_spec eqn: Hgetc; inversion 1; subst; split; auto.
       pose proof Hgetc as Hspec.
@@ -232,9 +207,9 @@ Local Ltac destruct_spec Hspec :=
       destruct r1; cbn in *.
       eapply sys_getc_trace_case in Hspec as []; auto.
       unfold get_sys_ret; cbn.
-      repeat (rewrite ZMap.gss in * || rewrite ZMap.gso in * by easy); subst; inj; reflexivity.
+      repeat (rewrite -> ZMap.gss in * || rewrite -> ZMap.gso in * by easy); subst; inj; reflexivity.
     - inversion 1.
-      rewrite common_prefix_full, strip_all; auto.
+      rewrite common_prefix_full strip_all; auto.
   Qed.
 
   Lemma app_trace_end : forall t, app_trace (trace_of_ostrace t) TEnd = trace_of_ostrace t.
@@ -247,8 +222,8 @@ Local Ltac destruct_spec Hspec :=
   Lemma app_trace_strip : forall t1 t2, common_prefix IOEvent_eq t1 t2 = t1 ->
     app_trace (trace_of_ostrace t1) (trace_of_ostrace (strip_common_prefix IOEvent_eq t1 t2)) = trace_of_ostrace t2.
   Proof.
-    intros; rewrite (strip_common_prefix_correct IOEvent_eq t1 t2) at 2.
-    rewrite trace_of_ostrace_app, H; auto.
+    intros; rewrite {2}(strip_common_prefix_correct IOEvent_eq t1 t2).
+    rewrite trace_of_ostrace_app H; auto.
     { rewrite <- H, common_prefix_sym; apply common_prefix_length. }
   Qed.
 
@@ -258,8 +233,7 @@ Local Ltac destruct_spec Hspec :=
     forall t' sf, traces (t', sf) -> valid_trace sf /\ app_trace (trace_of_ostrace s0.(io_log)) t' = trace_of_ostrace sf.(io_log).
   Proof.
     induction n as [n IHn] using lt_wf_ind; intros; inv H.
-    - inv H0.
-      rewrite app_trace_end; auto.
+    - rewrite app_trace_end; auto.
     - eauto.
     - destruct (H3 _ H0) as (? & s' & ? & ? & ? & ? & ? & ? & Hinj & Hcall & ? & ? & ? & ? & ? & ? & ? & ? & Hsafe & ? & ? & ? & Heq).
       inv Heq.
@@ -267,10 +241,9 @@ Local Ltac destruct_spec Hspec :=
       apply IO_ext_sem_trace in Hcall as [Hprefix]; auto; subst.
       eapply IHn in Hsafe as [? Htrace']; eauto; try lia.
       split; auto.
-      rewrite Htrace, <- Htrace', <- app_trace_assoc, app_trace_strip; auto.
-      { rewrite Htrace, app_trace_strip; auto. }
-    - inv H0.
-      rewrite app_trace_end; auto.
+      rewrite -> Htrace, <- Htrace', <- app_trace_assoc, app_trace_strip; auto.
+      { rewrite Htrace app_trace_strip; auto. }
+    - rewrite app_trace_end; auto.
   Qed.
 
   Lemma init_log_valid : forall s, io_log s = [] -> console s = {| cons_buf := []; rpos := 0 |} -> valid_trace s.
@@ -283,7 +256,7 @@ Local Ltac destruct_spec Hspec :=
   Qed.
 
   Lemma OS_trace_correct : forall n traces z s0 c m
-    (Hinit : s0.(io_log) = []) (Hcon : s0.(console) = {| cons_buf := []; rpos := 0 |}),
+    (Hinit : s0.(io_log) = []) (Hcon : s0.(console) = {| cons_buf := []; rpos := 0 |} ),
     OS_safeN_trace n TEnd traces z s0 c m ->
     forall t sf, traces (t, sf) -> valid_trace sf /\ t = trace_of_ostrace sf.(io_log).
   Proof.
@@ -304,7 +277,7 @@ Local Ltac destruct_spec Hspec :=
     traces = traces'.
   Proof.
     induction n as [n IHn] using lt_wf_ind; inversion 1; inversion 1; subst; auto.
-    - eapply semax_lemmas.cl_corestep_fun in H0; eauto; inv H0; eauto.
+    - eapply Clight_core.cl_corestep_fun in H0; eauto; inv H0; eauto.
     - apply cl_corestep_not_at_external in H0; congruence.
     - apply (cl_corestep_not_halted _ _ _ _ _ Int.zero) in H0; contradiction.
     - erewrite cl_corestep_not_at_external in H0 by eauto; congruence.
@@ -328,7 +301,7 @@ Local Ltac destruct_spec Hspec :=
   Qed.
 
   Lemma ext_safe_OS_safe : forall n t traces z q m s0 (Hvalid : valid_trace s0),
-    ext_safeN_trace(J := OK_spec) prog IO_ext_sem IO_inj_mem OS_mem valid_trace n t traces z q m ->
+    ext_safeN_trace prog IO_ext_sem IO_inj_mem OS_mem valid_trace n t traces z q m ->
     exists traces', OS_safeN_trace n t traces' z s0 q m /\ forall t, traces t <-> exists s, traces' (t, s).
   Proof.
     induction n as [n IHn] using lt_wf_ind; intros; inv H.
@@ -367,8 +340,8 @@ Local Ltac destruct_spec Hspec :=
   Qed.
 
 Theorem IO_OS_ext:
- forall {CS: compspecs} (initial_oracle: OK_ty) V G m,
-   semax_prog prog initial_oracle V G ->
+ forall {CS: compspecs} `{!VSTGpreS IO_itree Σ} (initial_oracle: IO_itree) V (G : forall `{!VSTGS IO_itree Σ}, funspecs) m,
+   (forall `{!VSTGS IO_itree Σ}, semax_prog(OK_spec := IO_ext_spec ext_link) prog initial_oracle V G) ->
    Genv.init_mem prog = Some m ->
    exists b, exists q,
      Genv.find_symbol (Genv.globalenv prog) (AST.prog_main prog) = Some b /\
diff --git a/progs64/io_dry.v b/progs64/io_dry.v
index bb0eff3e26..a14d4e594b 100644
--- a/progs64/io_dry.v
+++ b/progs64/io_dry.v
@@ -3,18 +3,15 @@ Require Import VST.progs64.io.
 Require Import VST.floyd.proofauto.
 Require Import VST.sepcomp.extspec.
 Require Import VST.veric.semax_ext.
-Require Import VST.veric.juicy_mem.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.initial_world.
-Require Import VST.veric.ghost_PCM.
 Require Import VST.veric.SequentialClight.
-Require Import VST.concurrency.conclib.
 Require Import VST.progs64.dry_mem_lemmas.
 
 Section IO_Dry.
 
 Context {E : Type -> Type} {IO_E : @IO_event nat -< E}.
 
+Notation IO_itree := (@IO_itree E).
+
 Definition getchar_pre (m : mem) (witness : byte -> IO_itree) (z : IO_itree) :=
   let k := witness in (sutt eq (r <- read stdin;; k r) z).
 
@@ -30,172 +27,78 @@ Definition putchar_post (m0 m : mem) (r : int) (witness : byte * IO_itree) (z :
   (Int.signed r = -1 \/ Int.signed r = Byte.unsigned c) /\
   if eq_dec (Int.signed r) (-1) then sutt eq (write stdout c;; k) z else z = k.
 
-Context (ext_link : String.string -> ident).
-
-Instance Espec : OracleKind := IO_Espec ext_link.
+Existing Instance semax_lemmas.eq_dec_external_function.
 
-Definition io_ext_spec := OK_spec.
+Definition getchar_sig := {| sig_args := []; sig_res := Xint; sig_cc := cc_default |}.
+Definition putchar_sig := {| sig_args := [Xint]; sig_res := Xint; sig_cc := cc_default |}.
 
-Program Definition io_dry_spec : external_specification mem external_function (@IO_itree E).
+Program Definition io_dry_spec : external_specification mem external_function IO_itree.
 Proof.
   unshelve econstructor.
   - intro e.
-    pose (ext_spec_type io_ext_spec e) as T; simpl in T.
-    destruct (oi_eq_dec _ _); [|destruct (oi_eq_dec _ _); [|exact False]];
-      match goal with T := (_ * ?A)%type |- _ => exact (mem * A)%type end.
+    destruct (eq_dec e (EF_external "putchar" putchar_sig)).
+    { exact (mem * (byte * IO_itree))%type. }
+    destruct (eq_dec e (EF_external "getchar" getchar_sig)).
+    { exact (mem * (byte -> IO_itree))%type. }
+    exact False%type.
   - simpl; intros.
-    destruct (oi_eq_dec _ _); [|destruct (oi_eq_dec _ _); [|contradiction]].
-    + destruct X as (m0 & _ & w).
-      exact (X1 = [Vubyte (fst w)] /\ m0 = X3 /\ putchar_pre X3 w X2).
-    + destruct X as (m0 & _ & w).
-      exact (X1 = [] /\ m0 = X3 /\ getchar_pre X3 w X2).
+    if_tac in X; [|if_tac in X; last contradiction]; destruct X as (m & w).
+    + exact (X1 = [Vubyte (fst w)] /\ m = X3 /\ putchar_pre X3 w X2).
+    + exact (X1 = [] /\ m = X3 /\ getchar_pre X3 w X2).
   - simpl; intros ??? ot ???.
-    destruct (oi_eq_dec _ _); [|destruct (oi_eq_dec _ _); [|contradiction]].
-    + destruct X as (m0 & _ & w).
-      destruct X1; [|exact False].
-      destruct v; [exact False | | exact False | exact False | exact False | exact False].
-      exact (ot <> Xvoid /\ putchar_post m0 X3 i w X2).
-    + destruct X as (m0 & _ & w).
-      destruct X1; [|exact False].
-      destruct v; [exact False | | exact False | exact False | exact False | exact False].
-      exact (ot <> Xvoid /\ getchar_post m0 X3 i w X2).
-  - intros; exact True.
+    if_tac in X; [|if_tac in X; last contradiction]; destruct X as (m0 & w).
+    + exact (exists r, X1 = Some (Vint r) /\ ot <> Xvoid /\ putchar_post m0 X3 r w X2).
+    + exact (exists r, X1 = Some (Vint r) /\ ot <> Xvoid /\ getchar_post m0 X3 r w X2).
+  - intros; exact True%type.
 Defined.
 
-Definition dessicate : forall ef (jm : juicy_mem), ext_spec_type io_ext_spec ef -> ext_spec_type io_dry_spec ef.
-Proof.
-  simpl; intros.
-  destruct (oi_eq_dec _ _); [|destruct (oi_eq_dec _ _); [|assumption]].
-  - destruct X as [_ X]; exact (m_dry jm, X).
-  - destruct X as [_ X]; exact (m_dry jm, X).
-Defined.
+Context (ext_link : string -> ident)
+  (ext_link_inj : forall s1 s2, In s1 ["getchar"; "putchar"] -> ext_link s1 = ext_link s2 -> s1 = s2).
 
-Theorem juicy_dry_specs : juicy_dry_ext_spec _ io_ext_spec io_dry_spec dessicate.
-Proof.
-  split; [|split]; try reflexivity; simpl.
-  - unfold funspec2pre, dessicate; simpl.
-    intros ?; if_tac.
-    + intros; subst.
-      destruct t as (? & ? & (c, k)); simpl in *.
-      destruct H1 as (? & phi0 & phi1 & J & Hpre & Hr & Hext).
-      destruct e; inv H; simpl in *.
-      destruct vl; try contradiction; simpl in *.
-      destruct H0, vl; try contradiction.
-      unfold SEPx in Hpre; simpl in Hpre.
-      rewrite seplog.sepcon_emp in Hpre.
-      destruct Hpre as [_ [Hargs [_ [it [H8 Htrace]]]]].
-      assert (Harg: v = Vubyte c) by (inv Hargs; auto). clear Hargs.
-      rewrite Harg.
-      eapply has_ext_compat in Hext as []; eauto; subst; auto.
-      eexists; eauto.
-    + unfold funspec2pre; simpl.
-      if_tac; [|contradiction].
-      intros; subst.
-      destruct t as (? & ? & k); simpl in *.
-      destruct H2 as (? & phi0 & phi1 & J & Hpre & Hr & Hext).
-      destruct e; inv H0; simpl in *.
-      destruct vl; try contradiction.
-      unfold putchar_pre; split; auto; split; auto.
-      unfold SEPx in Hpre; simpl in Hpre.
-      rewrite seplog.sepcon_emp in Hpre.
-      destruct Hpre as [_ [Hargs [_ [it [H8 Htrace]]]]].
-      eapply has_ext_compat in Hext as []; eauto; subst; auto.
-      eexists; eauto.
-  - unfold funspec2pre, funspec2post, dessicate; simpl.
-    intros ?; if_tac.
-    + intros; subst.
-      destruct H0 as (_ & vl & z0 & ? & _ & phi0 & phi1' & J & Hpre & ? & ?).
-      destruct t as (phi1 & t); subst; simpl in *.
-      destruct t as (? & (c, k)); simpl in *.
-      unfold SEPx in Hpre; simpl in Hpre.
-      rewrite seplog.sepcon_emp in Hpre.
-      destruct Hpre as [_ [Hargs [_ [it [H8 Htrace]]]]].
-      edestruct (has_ext_compat _ z0 _ (m_phi jm0) Htrace) as (? & ? & ?); eauto; [eexists; eauto|]; subst.
-      destruct v; try contradiction.
-      destruct v; try contradiction.
-      destruct H4 as (? & Hmem & ? & Hw); simpl in Hw; subst.
-      rewrite <- Hmem in *.
-      rewrite rebuild_same in H2.
-      unshelve eexists (age_to.age_to (level jm) (set_ghost phi0 (Some (ext_ghost x, NoneP) :: tl (ghost_of phi0)) _)), (age_to.age_to (level jm) phi1'); auto.
-      { rewrite <- ghost_of_approx at 2; simpl.
-        destruct (ghost_of phi0); auto. }
-      split; [|split].
-      * eapply age_rejoin; eauto.
-        intro; rewrite H2; auto.
-      * exists i.
-        split3; simpl.
-        -- split; auto.
-        -- unfold_lift. split; auto. split; [|intro Hx; inv Hx].
-             unfold eval_id; simpl. unfold semax.make_ext_rval; simpl.
-             destruct ot; try contradiction; reflexivity.
-        -- unfold SEPx; simpl.
-           rewrite seplog.sepcon_emp.
-           unfold ITREE; exists x; split; [if_tac; auto|].
-           { subst; apply eutt_sutt, Reflexive_eqit_eq. }
-           eapply age_to.age_to_pred, change_has_ext; eauto.
-      * eapply necR_trans; eauto; apply age_to.age_to_necR.
-    + unfold funspec2pre, funspec2post, dessicate; simpl.
-      if_tac; [|contradiction].
-      clear H0.
-      intros; subst.
-      destruct H0 as (_ & vl & z0 & ? & _ & phi0 & phi1' & J & Hpre & ? & ?).
-      destruct t as (phi1 & t); subst; simpl in *.
-      destruct t as (? & k); simpl in *.
-      unfold SEPx in Hpre; simpl in Hpre.
-      rewrite seplog.sepcon_emp in Hpre.
-      destruct Hpre as [_ [Hargs [_ [it [H8 Htrace]]]]].
-      edestruct (has_ext_compat _ z0 _ (m_phi jm0) Htrace) as (? & ? & ?); eauto; [eexists; eauto|]; subst.
-      destruct v; try contradiction.
-      destruct v; try contradiction.
-      destruct H4 as (? & Hmem & ? & Hw); simpl in Hw; subst.
-      rewrite <- Hmem in *.
-      rewrite rebuild_same in H2.
-      unshelve eexists (age_to.age_to (level jm) (set_ghost phi0 (Some (ext_ghost x, NoneP) :: tl (ghost_of phi0)) _)), (age_to.age_to (level jm) phi1'); auto.
-      { rewrite <- ghost_of_approx at 2; simpl.
-        destruct (ghost_of phi0); auto. }
-      split; [|split].
-      * eapply age_rejoin; eauto.
-        intro; rewrite H2; auto.
-      * exists i.
-        split3; simpl.
-        -- split; auto.
-        -- unfold_lift. split; auto. split; [|intro Hx; inv Hx].
-             unfold eval_id; simpl. unfold semax.make_ext_rval; simpl.
-             destruct ot; try contradiction; reflexivity.
-        -- unfold SEPx; simpl.
-             rewrite seplog.sepcon_emp.
-             unfold ITREE; exists x; split; [if_tac; auto|].
-             { subst; apply eutt_sutt, Reflexive_eqit_eq. }
-             eapply age_to.age_to_pred, change_has_ext; eauto.
-      * eapply necR_trans; eauto; apply age_to.age_to_necR.
-Qed.
-
-Instance mem_evolve_refl : Reflexive mem_evolve.
-Proof.
-  repeat intro.
-  destruct (access_at x loc Cur); auto.
-  destruct p; auto.
-Qed.
+Arguments eq_dec : simpl never.
 
-Lemma dry_spec_mem : ext_spec_mem_evolve _ io_dry_spec.
+Theorem io_spec_sound : forall `{!VSTGS IO_itree Σ}, ext_spec_entails (IO_ext_spec ext_link) io_dry_spec.
 Proof.
-  intros ??????????? Hpre Hpost.
-  simpl in Hpre, Hpost.
-  simpl in *.
-  if_tac in Hpre.
-  - destruct w as (m0 & _ & w).
-    destruct Hpre as (_ & ? & Hpre); subst.
-    destruct v; try contradiction.
-    destruct v; try contradiction.
-    destruct Hpost as (? & ? & ?); subst.
-    reflexivity.
-  - if_tac in Hpre; [|contradiction].
-    destruct w as (m0 & _ & w).
-    destruct Hpre as (_ & ? & Hpre); subst.
-    destruct v; try contradiction.
-    destruct v; try contradiction.
-    destruct Hpost as (? & ? & ?); subst.
-    reflexivity.
+  intros; apply juicy_dry_spec; last done; intros.
+  destruct H as [H | [H | ?]]; last done; injection H as <-%ext_link_inj <-; simpl; auto.
+  - if_tac; last done; intros.
+    exists (m, w).
+    destruct w as (c, k).
+    iIntros "(Hz & _ & %Hargs & H)".
+    rewrite /SEPx; monPred.unseal.
+    iDestruct "H" as "(_ & (% & % & Hext) & _)".
+    iDestruct (has_ext_state with "[$Hz $Hext]") as %<-.
+    iSplit; first done.
+    iIntros (???? (r & -> & ? & -> & Hr & Hz')).
+    iMod (change_ext_state with "[$]") as "($ & ?)".
+    iIntros "!>"; iExists r.
+    iSplit; first done.
+    rewrite /local /= /lift1; unfold_lift.
+    iSplit.
+    { iPureIntro; destruct ty; done. }
+    iSplit; last done.
+    iExists z'; iFrame; iPureIntro.
+    split; last done.
+    if_tac; subst; done.
+  - if_tac; last done; intros.
+    exists (m, w).
+    iIntros "(Hz & _ & %Hargs & H)".
+    rewrite /SEPx; monPred.unseal.
+    iDestruct "H" as "(_ & (% & % & Hext) & _)".
+    iDestruct (has_ext_state with "[$Hz $Hext]") as %<-.
+    iSplit; first done.
+    iIntros (???? (r & -> & ? & -> & Hr & Hz')).
+    simpl in Hz'.
+    iMod (change_ext_state with "[$]") as "($ & ?)".
+    iIntros "!>"; iExists r.
+    iSplit; first done.
+    rewrite /local /= /lift1; unfold_lift.
+    iSplit.
+    { iPureIntro; destruct ty; done. }
+    iSplit; last done.
+    iExists z'; iFrame; iPureIntro.
+    split; last done.
+    if_tac; subst; done.
 Qed.
 
 End IO_Dry.
diff --git a/progs64/io_mem_dry.v b/progs64/io_mem_dry.v
index 74e53eaabc..1b5a7c789c 100644
--- a/progs64/io_mem_dry.v
+++ b/progs64/io_mem_dry.v
@@ -2,12 +2,7 @@ Require Import VST.progs64.io_mem_specs.
 Require Import VST.floyd.proofauto.
 Require Import VST.sepcomp.extspec.
 Require Import VST.veric.semax_ext.
-Require Import VST.veric.juicy_mem.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.initial_world.
-Require Import VST.veric.ghost_PCM.
 Require Import VST.veric.SequentialClight.
-Require Import VST.concurrency.conclib.
 Require Import VST.progs64.dry_mem_lemmas.
 Require Import VST.veric.mem_lessdef.
 
@@ -25,13 +20,15 @@ Qed.
 
 Context {E : Type -> Type} {IO_E : @IO_event nat -< E}.
 
+Notation IO_itree := (@IO_itree E).
+
 Definition getchars_pre (m : mem) (witness : share * val * Z * (list byte -> IO_itree)) (z : IO_itree) :=
   let '(sh, buf, len, k) := witness in (sutt eq (r <- read_list stdin (Z.to_nat len);; k r) z) /\
     match buf with Vptr b ofs =>
       Mem.range_perm m b (Ptrofs.unsigned ofs) (Ptrofs.unsigned ofs + Z.max 0 len) Memtype.Cur Memtype.Writable
       | _ => False end.
 
-Definition getchars_post (m0 m : mem) r (witness : share * val * Z * (list byte -> IO_itree)) (z : @IO_itree E) :=
+Definition getchars_post (m0 m : mem) r (witness : share * val * Z * (list byte -> IO_itree)) (z : IO_itree) :=
   let '(sh, buf, len, k) := witness in r = Int.repr len /\
     exists msg, Zlength msg = len /\ z = k msg /\
     match buf with Vptr b ofs => exists m', Mem.storebytes m0 b (Ptrofs.unsigned ofs) (bytes_to_memvals msg) = Some m' /\
@@ -45,281 +42,107 @@ Definition putchars_pre (m : mem) (witness : share * val * list byte * Z * list
       Some (bytes_to_memvals msg)
     | _ => False end.
 
-Definition putchars_post (m0 m : mem) r (witness : share * val * list byte * Z * list val * IO_itree) (z : @IO_itree E) :=
+Definition putchars_post (m0 m : mem) r (witness : share * val * list byte * Z * list val * IO_itree) (z : IO_itree) :=
   let '(sh, buf, msg, _, _, k) := witness in m0 = m /\ r = Int.repr (Zlength msg) /\ z = k.
 
-Context {CS : compspecs} (ext_link : String.string -> ident).
-
-Instance Espec : OracleKind := IO_Espec ext_link.
+Existing Instance semax_lemmas.eq_dec_external_function.
 
-Definition io_ext_spec := OK_spec.
+Definition getchars_sig := {| sig_args := [Xptr; Xint]; sig_res := Xint; sig_cc := cc_default |}.
+Definition putchars_sig := {| sig_args := [Xptr; Xint]; sig_res := Xint; sig_cc := cc_default |}.
 
-Program Definition io_dry_spec : external_specification mem external_function (@IO_itree E).
+Program Definition io_dry_spec : external_specification mem external_function IO_itree.
 Proof.
   unshelve econstructor.
   - intro e.
-    pose (ext_spec_type io_ext_spec e) as T; simpl in T.
-    destruct (oi_eq_dec _ _); [|destruct (oi_eq_dec _ _); [|exact False]];
-      match goal with T := (_ * ?A)%type |- _ => exact (mem * A)%type end.
+    destruct (eq_dec e (EF_external "putchars" putchars_sig)).
+    { exact (mem * (share * val * list byte * Z * list val * IO_itree))%type. }
+    destruct (eq_dec e (EF_external "getchars" getchars_sig)).
+    { exact (mem * (share * val * Z * (list byte -> IO_itree)))%type. }
+    exact False%type.
   - simpl; intros.
-    destruct (oi_eq_dec _ _); [|destruct (oi_eq_dec _ _); [|contradiction]].
-    + destruct X as (m0 & _ & w).
-      exact ((let '(_, buf, msg, _, _, _) := w in X1 = [buf; Vint (Int.repr (Zlength msg))]) /\ m0 = X3 /\ putchars_pre X3 w X2).
-    + destruct X as (m0 & _ & w).
-      exact ((let '(_, buf, len, _) := w in X1 = [buf; Vint (Int.repr len)]) /\ m0 = X3 /\ getchars_pre X3 w X2).
+    if_tac in X; [|if_tac in X; last contradiction]; destruct X as (m & w).
+    + exact ((let '(_, buf, msg, _, _, _) := w in X1 = [buf; Vint (Int.repr (Zlength msg))]) /\ m = X3 /\ putchars_pre X3 w X2).
+    + exact ((let '(_, buf, len, _) := w in X1 = [buf; Vint (Int.repr len)]) /\ m = X3 /\ getchars_pre X3 w X2).
   - simpl; intros ??? ot ???.
-    destruct (oi_eq_dec _ _); [|destruct (oi_eq_dec _ _); [|contradiction]].
-    + destruct X as (m0 & _ & w).
-      destruct X1; [|exact False].
-      destruct v; [exact False | | exact False | exact False | exact False | exact False].
-      exact (ot <> Xvoid /\ putchars_post m0 X3 i w X2).
-    + destruct X as (m0 & _ & w).
-      destruct X1; [|exact False].
-      destruct v; [exact False | | exact False | exact False | exact False | exact False].
-      exact (ot <> Xvoid /\ getchars_post m0 X3 i w X2).
-  - intros; exact True.
+    if_tac in X; [|if_tac in X; last contradiction]; destruct X as (m0 & w).
+    + exact (exists r, X1 = Some (Vint r) /\ ot <> Xvoid /\ putchars_post m0 X3 r w X2).
+    + exact (exists r, X1 = Some (Vint r) /\ ot <> Xvoid /\ getchars_post m0 X3 r w X2).
+  - intros; exact True%type.
 Defined.
 
-Definition dessicate : forall ef (jm : juicy_mem), ext_spec_type io_ext_spec ef -> ext_spec_type io_dry_spec ef.
-Proof.
-  simpl; intros.
-  destruct (oi_eq_dec _ _); [|destruct (oi_eq_dec _ _); [|assumption]].
-  - destruct X as [_ X]; exact (m_dry jm, X).
-  - destruct X as [_ X]; exact (m_dry jm, X).
-Defined.
+Context {CS : compspecs} (ext_link : string -> ident)
+  (ext_link_inj : forall s1 s2, In s1 ["getchars"; "putchars"] -> ext_link s1 = ext_link s2 -> s1 = s2).
 
-Theorem juicy_dry_specs : juicy_dry_ext_spec _ io_ext_spec io_dry_spec dessicate.
-Proof.
-  split; [|split]; try reflexivity; simpl.
-  - unfold funspec2pre, dessicate; simpl.
-    intros ?; if_tac.
-    + intros; subst.
-      destruct t as (? & ? & (((((sh, buf), msg), len), rest), k)); simpl in *.
-      destruct H1 as (? & phi0 & phi1 & J & Hpre & Hr & Hext).
-      destruct e; inv H; simpl in *.
-      destruct vl; try contradiction; simpl in *.
-      destruct H0, vl; try contradiction; simpl in *.
-      destruct H0, vl; try contradiction.
-      unfold SEPx in Hpre; simpl in Hpre.
-      rewrite seplog.sepcon_emp in Hpre.
-      destruct Hpre as [[Hreadable _] [Hargs [_ [? [? [? [Htrace Hbuf]]]]]]].
- (*     destruct Hpre as ([Hreadable _] & Hargs & ? & ? & J1 & (? & ? & Htrace) & Hbuf). *)
-(*      destruct Hargs as ([Harg1 _] & [Harg2 _] & _); hnf in Harg1, Harg2. *)
-      assert (Harg1: v = buf) by (inv Hargs; auto).
-      assert (Harg2: v0 = vint (Zlength msg)) by (inv Hargs; auto).
-      split; [rewrite Harg1, Harg2; auto|].
-      split; auto.
-     destruct Htrace as [? [J1 Htrace]].
-      eapply has_ext_compat in Htrace as [? Htrace]; eauto; [|eapply join_sub_trans; eexists; eauto]; subst.
-      split; auto.
-      assert (Z.max 0 len = Zlength msg + Zlength rest) as Hlen.
-      { apply data_array_at_local_facts in Hbuf as (_ & ? & _).
-        rewrite Zlength_app, Zlength_map in *; auto. }
-      destruct (zlt len 0).
-      { rewrite Z.max_l in Hlen by lia.
-        destruct msg; [|rewrite Zlength_cons in *; rep_lia].
-        destruct Hbuf as [[? _]]; destruct buf; try contradiction.
-        rewrite Zlength_nil; apply Mem.loadbytes_empty; auto; lia. }
-      rewrite Z.max_r in Hlen by lia; subst.
-      rewrite split2_data_at_Tarray_app with (mid := Zlength msg) in Hbuf.
-      destruct Hbuf as (? & ? & ? & Hbuf & _).
-      eapply data_at_bytes in Hbuf; eauto.
-      rewrite map_map in Hbuf; eauto.
-      { rewrite Zlength_map; auto. }
-      { eapply join_sub_trans; [|eexists; eauto].
-        eapply join_sub_trans; eexists; eauto. }
-      { apply Forall_map, Forall_forall; simpl; discriminate. }
-      { rewrite Zlength_map; auto. }
-      { rewrite Z.add_simpl_l; auto. }
-    + clear H.
-      unfold funspec2pre; simpl.
-      if_tac; [|contradiction].
-      intros; subst.
-      destruct t as (? & ? & (((sh, buf), len), k)); simpl in *.
-      destruct H1 as (? & phi0 & phi1 & J & Hpre & Hr & Hext).
-      destruct e; inv H; simpl in *.
-      destruct vl; try contradiction; simpl in *.
-      destruct H0, vl; try contradiction; simpl in *.
-      destruct H0, vl; try contradiction.
-      unfold SEPx in Hpre; simpl in Hpre.
-      rewrite seplog.sepcon_emp in Hpre.
-      destruct Hpre as [[Hwritable _] [Hargs [_ [? [? [? [[? [? Htrace]] Hbuf]]]]]]].
-      assert (Harg1: v = buf) by (inv Hargs; auto).
-      assert (Harg2: v0 = vint  len) by (inv Hargs; auto).
-      split; [rewrite Harg1, Harg2; auto|].
-      clear Harg1.
-      split; auto.
-      eapply has_ext_compat in Htrace as [? Htrace]; eauto; [|eapply join_sub_trans; eexists; eauto]; subst.
-      split; auto.
-      destruct (data_at__writable_perm _ _ _ _ jm Hwritable Hbuf) as (? & ? & ? & Hperm); subst; simpl.
-      { eapply sepalg.join_sub_trans; [|eexists; eauto].
-        eexists; eauto. }
-      simpl in Hperm.
-      rewrite Z.mul_1_l in Hperm; auto.
-  - unfold funspec2pre, funspec2post, dessicate; simpl.
-    intros ?; if_tac.
-    + intros; subst.
-      destruct H0 as (_ & vl & z0 & ? & _ & phi0 & phi1' & J & Hpre & ? & ?).
-      destruct t as (phi1 & t); subst; simpl in *.
-      destruct t as (? & (((((sh, buf), msg), len), rest), k)); simpl in *.
-      unfold SEPx in Hpre; simpl in Hpre.
-      rewrite seplog.sepcon_emp in Hpre.
-      destruct Hpre as [[Hwritable _] [_ [_ [phig [phir [J1 [[? [? Htrace]] Hbuf]]]]]]].
-      edestruct (has_ext_compat _ z0 _ phi0 Htrace) as (? & Hg & Hg0); eauto; [eexists; eauto | eapply ext_compat_sub; eauto; eexists; eauto|]; subst.
-      destruct v; try contradiction.
-      destruct v; try contradiction.
-      destruct H4 as (? & Hmem & ? & ?); subst.
-      rewrite <- Hmem in *.
-      rewrite rebuild_same in H2.
-      unshelve eexists (age_to.age_to (level jm) (set_ghost phi0 (Some (ext_ghost k, NoneP) :: tl (ghost_of phi0)) _)), (age_to.age_to (level jm) phi1'); auto.
-      { rewrite <- ghost_of_approx at 2; simpl.
-        destruct (ghost_of phi0); auto. }
-      destruct buf; try solve [destruct Hbuf as [[]]; contradiction].
-      destruct (join_level _ _ _ J).
-      split; [|split].
-      * eapply age_rejoin; eauto.
-        intro; rewrite H2; auto.
-      * split3; simpl.
-        { split; auto. }
-        { unfold_lift. split; auto. split; [|intro Hx; inv Hx].
-             unfold eval_id; simpl. unfold semax.make_ext_rval; simpl.
-             destruct ot; try contradiction; reflexivity. }
-        unfold SEPx; simpl.
-        rewrite seplog.sepcon_emp.
-        unshelve eexists (age_to.age_to _ (set_ghost phig (Some (ext_ghost k, NoneP) :: tl (ghost_of phig)) _)), (age_to.age_to _ phir);
-          try (split; [apply age_to.age_to_join_eq|]); try apply set_ghost_join; eauto.
-        { rewrite <- ghost_of_approx at 2.
-          destruct (ghost_of phig); auto. }
-        { apply ghost_of_join in J1.
-          rewrite Hg, Hg0 in J1; inv J1; constructor; auto.
-          apply ext_ghost_join in H13 as [[]|[]]; eauto; subst.
-          apply ghost_not_both in H10; contradiction. }
-        { unfold set_ghost; rewrite level_make_rmap; lia. }
-        split.
-        -- unfold ITREE; exists k; split; [apply eutt_sutt, Reflexive_eqit_eq|].
-             eapply age_to.age_to_pred, change_has_ext; eauto.
-        -- apply age_to.age_to_pred; auto.
-      * eapply necR_trans; eauto; apply age_to.age_to_necR.
-    + clear H.
-      unfold funspec2pre, funspec2post, dessicate; simpl.
-      if_tac; [|contradiction].
-      intros; subst.
-      destruct H0 as (_ & vl& z0 & ? & _ & phi0 & phi1' & J & Hpre & ? & ?).
-      destruct t as (phi1 & t); subst; simpl in *.
-      destruct t as (? & (((sh, buf), len), k)); simpl in *.
-      unfold SEPx in Hpre; simpl in Hpre.
-      rewrite seplog.sepcon_emp in Hpre.
-      destruct Hpre as [[Hwritable _] [_ [_ [phig [phir [J1 [[? [? Htrace]] Hbuf]]]]]]].
-      edestruct (has_ext_compat _ z0 _ phi0 Htrace) as (? & Hg & Hg0); eauto; [eexists; eauto | eapply ext_compat_sub; eauto; eexists; eauto|]; subst.
-      destruct v; try contradiction.
-      destruct v; try contradiction.
-      destruct H4 as (? & ? & msg & ? & ? & Hpost); subst.
-      destruct buf; try contradiction.
-      destruct Hpost as (m' & Hstore & Heq).
-      unshelve eexists (set_ghost (age_to.age_to (level jm) (inflate_store m' phi0)) (Some (ext_ghost (k msg), NoneP) :: own.ghost_approx (age_to.age_to (level jm) (inflate_store m' phi0)) (tl (ghost_of phi0))) _),
-        (age_to.age_to (level jm) phi1').
-      { simpl; rewrite ghost_fmap_fmap, approx_oo_approx; auto. }
-      destruct (join_level _ _ _ J).
-      assert (Ptrofs.unsigned i + Zlength msg <= Ptrofs.max_unsigned) as Hbound.
-      { destruct Hbuf as [(_ & _ & Hsize & _) _]; simpl in Hsize.
-        rewrite Z.max_r in Hsize; rep_lia. }
-      apply data_at__VALspec_range in Hbuf; auto.
-      assert (level (age_to.age_to (level (m_phi jm)) (inflate_store m' phi0)) = level (m_phi jm)) as Hl.
-      { apply age_to.level_age_to.
-        unfold inflate_store; rewrite level_make_rmap; lia. }
-      split.
-      * apply resource_at_join2; auto.
-        -- unfold set_ghost; rewrite level_make_rmap; auto.
-        -- rewrite age_to.level_age_to; auto.
-           rewrite level_juice_level_phi; lia.
-        -- intros.
-           unfold set_ghost; rewrite resource_at_make_rmap.
-           eapply rebuild_store; eauto.
-           intros (b', o') ???? Hr1 []; subst.
-           apply (resource_at_join _ _ _ (b', o')) in J; rewrite Hr1 in J.
-           apply VALspec_range_e with (loc := (b', o')) in Hbuf as [? Hr].
-           apply (resource_at_join _ _ _ (b', o')) in J1; rewrite Hr in J1.
-           inv J1; rewrite <- H15 in J; inv J; eapply join_writable_readable; eauto;
-             apply join_comm in RJ; eapply join_writable1; eauto.
-           { rewrite bytes_to_memvals_length in *; split; auto. }
-        -- unfold set_ghost; rewrite ghost_of_make_rmap, !age_to_resource_at.age_to_ghost_of.
-           rewrite H3.
-           apply ghost_of_join in J.
-           rewrite level_juice_level_phi, Hl.
-           rewrite Hg0 in J; inv J; constructor; auto.
-           destruct (ext_ghost_join _ _ _ _ H13) as [[]|[]]; eauto; subst.
-           inv H13; [constructor|].
-           destruct a0, H17 as (? & ? & ?); simpl in *; subst; eauto.
-           { unfold semax.ext_compat in H6; rewrite <- H12 in H6.
-             exfalso; destruct H6 as [? J]; inv J.
-             eapply no_two_ref; eauto. }
-           { apply ghost_fmap_join; auto. }
-      * split.
-        -- exists msg.
-           split3; simpl.
-           { split; auto. }
-           { unfold_lift. split; auto. split; [|intro Hx; inv Hx].
-             unfold eval_id; simpl. unfold semax.make_ext_rval; simpl.
-             destruct ot; try contradiction; reflexivity. }
-           unfold SEPx; simpl.
-           rewrite seplog.sepcon_emp.
-           unshelve eexists (set_ghost (age_to.age_to _ phig) (Some (ext_ghost (k msg), NoneP) :: own.ghost_approx (age_to.age_to (level jm) (inflate_store m' phi0)) (tl (ghost_of phig))) _), (age_to.age_to _ (inflate_store m' phir));
-             try (split3; [apply set_ghost_join; [apply age_to.age_to_join_eq | ..] | ..]).
-           ++ simpl; rewrite Hl, age_to.level_age_to, ghost_fmap_fmap, approx_oo_approx; auto.
-              apply join_level in J1 as []; lia.
-           ++ eapply inflate_store_join1; eauto.
-                 clear - Htrace. apply has_ext_noat in Htrace. auto.
-           ++ unfold inflate_store; rewrite level_make_rmap; lia.
-           ++ rewrite level_juice_level_phi, Hl.
-              rewrite age_to_resource_at.age_to_ghost_of.
-              unfold inflate_store; rewrite ghost_of_make_rmap.
-              apply ghost_of_join in J1; rewrite Hg, Hg0 in J1; inv J1; constructor; auto.
-              destruct (ext_ghost_join _ _ _ _ H13) as [[]|[]]; eauto; subst.
-              inv H13; [constructor|].
-              destruct a0, H17 as (? & ? & ?); simpl in *; subst; eauto.
-              apply ghost_not_both in H10; contradiction.
-              apply ghost_fmap_join; auto.
-           ++ unfold ITREE; exists (k msg); split; [apply eutt_sutt, Reflexive_eqit_eq|].
-              eapply change_has_ext, age_to.age_to_pred; eauto.
-           ++ apply age_to.age_to_pred.
-              rewrite <- (Zlength_map _ _ Vubyte).
-              eapply store_bytes_data_at; rewrite ?Zlength_map; auto.
-              { rewrite Forall_map, Forall_forall; simpl; intros.
-                exists (Int.repr (Byte.unsigned x)); split; auto.
-                rewrite Int.unsigned_repr; rep_lia. }
-              { rewrite map_map; eauto. }
-        -- eapply necR_trans; eauto; apply age_to.age_to_necR.
-Qed.
-
-Instance mem_evolve_refl : Reflexive mem_evolve.
-Proof.
-  repeat intro.
-  destruct (access_at x loc Cur); auto.
-  destruct p; auto.
-Qed.
+Arguments eq_dec : simpl never.
 
-Lemma dry_spec_mem : ext_spec_mem_evolve _ io_dry_spec.
+Theorem io_spec_sound : forall `{!VSTGS IO_itree Σ}, ext_spec_entails (IO_ext_spec ext_link) io_dry_spec.
 Proof.
-  intros ??????????? Hpre Hpost.
-  simpl in Hpre, Hpost.
-  simpl in *.
-  if_tac in Hpre.
-  - destruct w as (m0 & _ & (((((?, ?), ?), ?), ?), ?)).
-    destruct Hpre as (_ & ? & Hpre); subst.
-    destruct v; try contradiction.
-    destruct v; try contradiction.
-    destruct Hpost as (? & ? & ?); subst.
-    reflexivity.
-  - if_tac in Hpre; [|contradiction].
-    destruct w as (m0 & _ & (((?, ?), ?), ?)).
-    destruct Hpre as (_ & ? & Hpre); subst.
-    destruct v; try contradiction.
-    destruct v; try contradiction.
-    destruct Hpost as (? & ? & msg & ? & ? & Hpost); subst.
-    destruct v0; try contradiction.
-    destruct Hpost as (? & Hstore & ?).
-    eapply mem_evolve_equiv2; [|apply mem_equiv_sym; eauto].
-    eapply mem_evolve_access, storebytes_access; eauto.
+  intros; apply juicy_dry_spec; last done; intros.
+  destruct H as [H | [H | ?]]; last done; injection H as <-%ext_link_inj <-; simpl; auto.
+  - if_tac; last done; intros.
+    exists (m, w).
+    destruct w as (((((sh, buf), msg), len), rest), k).
+    iIntros "(Hz & (%Hsh & _) & %Hargs & H)".
+    rewrite /SEPx; monPred.unseal.
+    iDestruct "H" as "(_ & (% & % & Hext) & Hbuf & _)".
+    iDestruct (has_ext_state with "[$Hz $Hext]") as %<-.
+    iSplit.
+    + iDestruct (data_array_at_local_facts with "Hbuf") as %((? & ?) & Hlen & ?).
+      destruct (eq_dec msg []).
+      { destruct buf; try done.
+        iPureIntro; repeat (split; first done).
+        subst; simpl.
+        rewrite Mem.loadbytes_empty //. }
+      erewrite split2_data_at_Tarray_app; [| done |].
+      iDestruct "Hbuf" as "(Hmsg & _)".
+      iDestruct (data_at_bytes with "[$Hz $Hmsg]") as %Hmsg; [done.. | |].
+      { rewrite Forall_map Forall_forall //. }
+      iPureIntro; repeat (split; first done).
+      rewrite Zlength_map map_map // in Hmsg.
+      { rewrite -> Zlength_app, Z.max_r in Hlen.
+        subst. rewrite Z.add_simpl_l //.
+        { destruct msg; first done.
+          simpl in *; rewrite Zlength_cons in Hlen; rep_lia. } }
+    + iIntros (???? (r & -> & ? & -> & -> & <-)).
+      iMod (change_ext_state with "[$]") as "($ & ?)".
+      iIntros "!>".
+      iSplit; first done.
+      rewrite /local /= /lift1; unfold_lift.
+      iSplit.
+      { iPureIntro; destruct ty; done. }
+      iFrame; done.
+  - if_tac; last done; intros.
+    exists (m, w).
+    destruct w as (((sh, buf), len), k).
+    iIntros "(Hz & (%Hsh & _) & %Hargs & H)".
+    rewrite /SEPx; monPred.unseal.
+    iDestruct "H" as "(_ & (% & % & Hext) & Hbuf & _)".
+    iDestruct (has_ext_state with "[$Hz $Hext]") as %<-.
+    iSplit.
+    + iDestruct (data_at__writable_perm with "[$Hz $Hbuf]") as %(? & ? & -> & Hbuf); first done.
+      iPureIntro; repeat (split; first done).
+      simpl in *.
+      rewrite Z.mul_1_l // in Hbuf.
+    + iIntros (???? (r & -> & ? & -> & msg & <- & -> & Hstore)).
+      iDestruct "Hz" as "(Hm & Hz)".
+      rewrite /state_interp.
+      iMod (own_update_2 with "Hz Hext") as "($ & ?)".
+      { apply @excl_auth_update. }
+      destruct buf; try done.
+      destruct Hstore as (? & Hstore & Heq%mem_equiv_sym).
+      rewrite -(mem_auth_equiv _ m') //.
+      iMod (data_at__storebytes _ _ _ _ _ _ (map Vubyte msg) with "[$]") as "($ & ?)"; first done.
+      { rewrite Forall_map Forall_forall; intros byte ??; simpl.
+        rewrite Int.unsigned_repr; rep_lia. }
+      { rewrite map_map //. }
+      { rewrite Zlength_map //. }
+      iIntros "!>"; iExists msg.
+      iSplit; first done.
+      rewrite /local /= /lift1; unfold_lift.
+      iSplit.
+      { iPureIntro; destruct ty; done. }
+      iFrame.
+      iExists (k msg); iSplit; done.
 Qed.
 
 End IO_Dry.
diff --git a/progs64/io_mem_specs.v b/progs64/io_mem_specs.v
index 33ab396b14..78b1e722db 100644
--- a/progs64/io_mem_specs.v
+++ b/progs64/io_mem_specs.v
@@ -16,7 +16,7 @@ Notation "' p <- t1 ;; t2" :=
 
 Section specs.
 
-Context {E : Type -> Type} `{IO_event(file_id := nat) -< E}.
+Context {E : Type -> Type} `{IO_event(file_id := nat) -< E} `{!VSTGS (@IO_itree E) Σ}.
 
 Fixpoint read_list_aux f n d : itree E (list byte) :=
   match n with
@@ -49,18 +49,16 @@ Definition getchars_spec {CS : compspecs} :=
     PARAMS (buf; Vint (Int.repr len)) GLOBALS ()
     SEP (ITREE (r <- read_list stdin (Z.to_nat len) ;; k r); data_at_ sh (tarray tuchar len) buf)
   POST [ tint ]
-   EX msg : list byte,
+   ∃ msg : list byte,
     PROP ()
     LOCAL (temp ret_temp (Vint (Int.repr len)))
     SEP (ITREE (k msg); data_at sh (tarray tuchar len) (map Vubyte msg) buf).
 
 (* Build the external specification. *)
-Definition IO_void_Espec : OracleKind := ok_void_spec (@IO_itree E).
-
 Definition IO_specs {CS : compspecs} (ext_link : string -> ident) :=
   [(ext_link "putchars"%string, putchars_spec); (ext_link "getchars"%string, getchars_spec)].
 
-Definition IO_Espec {CS : compspecs} (ext_link : string -> ident) : OracleKind :=
-  add_funspecs IO_void_Espec ext_link (IO_specs ext_link).
+#[export] Instance IO_ext_spec {CS : compspecs} (ext_link : string -> ident) : ext_spec IO_itree :=
+  add_funspecs_rec IO_itree ext_link (void_spec IO_itree) (IO_specs ext_link).
 
 End specs.
diff --git a/progs64/io_os_connection.v b/progs64/io_os_connection.v
index a2f557da1f..80a5e3b3fb 100644
--- a/progs64/io_os_connection.v
+++ b/progs64/io_os_connection.v
@@ -731,9 +731,10 @@ Section Invariants.
       end) evs)).
   Proof.
     induction evs as [| ev evs]; cbn -[Zlength]; intros * Hall Hmax Hlen.
-    { cbn in *.
+    { rewrite app_nil_r.
+      cbn in *.
       replace (Zlength (compute_console' tr)) with CONS_BUFFER_MAX_CHARS by lia.
-      cbn; auto using app_nil_r.
+      cbn; auto.
     }
     rewrite Zlength_cons in Hlen.
     edestruct Hall as (? & ? & ? & ?); eauto; subst.
@@ -1987,6 +1988,6 @@ Import functional_base.
       admit.
     - (* trace_itree_match *)
       admit.
-  Admitted.
+  Abort.
 
 End SpecsCorrect.
diff --git a/progs64/io_specs.v b/progs64/io_specs.v
index 491c91e776..d1de35a5cf 100644
--- a/progs64/io_specs.v
+++ b/progs64/io_specs.v
@@ -4,19 +4,20 @@ Require Export VST.floyd.io_events.
 Require Export ITree.ITree.
 Require Export ITree.Eq.
 Require Export ITree.Eq.SimUpToTaus.
-(* Import ITreeNotations. *) (* one piece conflicts with subp notation *)
+(* Import ITreeNotations. *) (* notation conflict *)
 Notation "x <- t1 ;; t2" := (ITree.bind t1 (fun x => t2))
   (at level 100, t1 at next level, right associativity) : itree_scope.
 Notation "' p <- t1 ;; t2" :=
   (ITree.bind t1 (fun x_ => match x_ with p => t2 end))
 (at level 100, t1 at next level, p pattern, right associativity) : itree_scope.
-
 Definition stdin := 0%nat.
 Definition stdout := 1%nat.
 
 Section specs.
 
-Context {E : Type -> Type} `{IO_event(file_id := nat) -< E}.
+Context {E : Type -> Type} `{IO_event(file_id := nat) -< E} `{!VSTGS (@IO_itree E) Σ}.
+
+Notation IO_itree := (@IO_itree E).
 
 Definition putchar_spec :=
   WITH c : byte, k : IO_itree
@@ -25,7 +26,7 @@ Definition putchar_spec :=
     PARAMS (Vubyte c) GLOBALS()
     SEP (ITREE (write stdout c ;; k)%itree)
   POST [ tint ]
-   EX i : int,
+   ∃ i : int,
     PROP (Int.signed i = -1 \/ Int.signed i = Byte.unsigned c)
     LOCAL (temp ret_temp (Vint i))
     SEP (ITREE (if eq_dec (Int.signed i) (-1) then (write stdout c ;; k)%itree else k)).
@@ -37,17 +38,16 @@ Definition getchar_spec :=
     PARAMS () GLOBALS()
     SEP (ITREE (r <- read stdin ;; k r)%itree)
   POST [ tint ]
-   EX i : int,
+   ∃ i : int,
     PROP (-1 <= Int.signed i <= Byte.max_unsigned)
     LOCAL (temp ret_temp (Vint i))
     SEP (ITREE (if eq_dec (Int.signed i) (-1) then (r <- read stdin ;; k r)%itree else k (Byte.repr (Int.signed i)))).
 
 (* Build the external specification. *)
-Program Definition IO_void_Espec : OracleKind := ok_void_spec (@IO_itree E).
-
 Definition IO_specs (ext_link : string -> ident) :=
   [(ext_link "putchar"%string, putchar_spec); (ext_link "getchar"%string, getchar_spec)].
 
-Definition IO_Espec (ext_link : string -> ident) : OracleKind := add_funspecs IO_void_Espec ext_link (IO_specs ext_link).
+#[export] Instance IO_ext_spec (ext_link : string -> ident) : ext_spec IO_itree :=
+    add_funspecs_rec IO_itree ext_link (void_spec IO_itree) (IO_specs ext_link).
 
 End specs.
diff --git a/progs64/os_combine.v b/progs64/os_combine.v
index 631f81b75e..93ce2e0365 100644
--- a/progs64/os_combine.v
+++ b/progs64/os_combine.v
@@ -2,38 +2,36 @@ Require Import VST.floyd.proofauto.
 Require Import VST.sepcomp.extspec.
 Require Import VST.veric.semax_ext.
 Require Import VST.veric.juicy_mem.
-Require Import VST.veric.compcert_rmaps.
 Require Import VST.veric.initial_world.
-Require Import VST.veric.ghost_PCM.
 Require Import VST.veric.SequentialClight.
 Require Import VST.veric.Clight_core.
 Require Import VST.concurrency.conclib.
 Require Import VST.sepcomp.semantics.
 Require Import ITree.ITree.
-(* Import ITreeNotations. *) (* one piece conflicts with subp notation *)
 Notation "t1 >>= k2" := (ITree.bind t1 k2)
   (at level 50, left associativity) : itree_scope.
 Notation "x <- t1 ;; t2" := (ITree.bind t1 (fun x => t2))
   (at level 100, t1 at next level, right associativity) : itree_scope.
 Notation "t1 ;; t2" := (ITree.bind t1 (fun _ => t2))
-  (at level 100, right associativity) : itree_scope.
+  (at level 100, t2 at level 200, right associativity) : itree_scope.
 Notation "' p <- t1 ;; t2" :=
   (ITree.bind t1 (fun x_ => match x_ with p => t2 end))
 (at level 100, t1 at next level, p pattern, right associativity) : itree_scope.
 Require Import ITree.Interp.Traces.
 Require Import Ensembles.
 
+Arguments In {_} _ _.
+
 Section ext_trace.
 
-  Context {event : Type -> Type} {J : juicy_ext_spec (itree event unit)} {OS_state : Type}.
+  Context {event : Type -> Type} {OS_state : Type}.
   Variable prog : Clight.program.
   Variable ext_sem : external_function -> list val -> OS_state -> option (OS_state * option val * @trace event unit).
   Variable inj_mem : external_function -> list val -> mem -> @trace event unit -> OS_state -> Prop.
   Variable extr_mem : external_function -> list val -> mem -> OS_state -> mem.
   Variable OS_valid : OS_state -> Prop.
   Notation ge := (globalenv prog).
-
-  Instance Espec : OracleKind := Build_OracleKind (itree event unit) J.
+  Notation OK_ty := (itree event unit).
 
   (* For any trace that the new itree (z) allows, that trace prefixed with the
      OS-generated trace (t) is allowed by the old itree (z0). *)
@@ -59,8 +57,8 @@ Section ext_trace.
     rewrite app_trace_assoc; auto.
   Qed.
 
-  Inductive ext_safeN_trace : nat -> @trace event unit -> Ensemble (@trace event unit) -> OK_ty -> CC_core -> mem -> Prop :=
-  | ext_safeN_trace_0: forall z t c m, ext_safeN_trace O t (Singleton TEnd) z c m
+  Inductive ext_safeN_trace : nat -> @trace event unit -> Ensemble (@trace event unit) -> itree event unit -> CC_core -> mem -> Prop :=
+  | ext_safeN_trace_0: forall z t c m, ext_safeN_trace O t (Singleton _ TEnd) z c m
   | ext_safeN_trace_step:
       forall n t traces z c m c' m',
       cl_step ge c m c' m' ->
@@ -90,9 +88,9 @@ Section ext_trace.
       ext_safeN_trace (S n) t traces z c m
   | ext_safeN_trace_halted: forall n z t c m i,
       halted (cl_core_sem ge) c i ->
-      ext_safeN_trace n t (Singleton TEnd) z c m.
+      ext_safeN_trace n t (Singleton _ TEnd) z c m.
 
-  Variable dryspec : ext_spec OK_ty.
+  Variable dryspec : ext_spec (itree event unit).
   Hypothesis extcalls_correct : forall e w b tl args z m t s, ext_spec_pre dryspec e w b tl args z m ->
     inj_mem e args m t s ->
     forall s' ret t', Some (s', ret, t') = ext_sem e args s ->
@@ -101,7 +99,7 @@ Section ext_trace.
 
 
   Lemma dry_safe_ext_trace_safe : forall n t z q m,
-    step_lemmas.dry_safeN(genv_symb := semax.genv_symb_injective)
+    step_lemmas.dry_safeN(genv_symb := lifting.genv_symb_injective)
      (cl_core_sem (globalenv prog)) dryspec
      (Build_genv (Genv.globalenv prog) (prog_comp_env prog)) n z q m ->
     exists traces, ext_safeN_trace n t traces z q m.
@@ -125,32 +123,24 @@ Section ext_trace.
     - eexists; econstructor; eauto.
   Qed.
 
+  Variable Espec : forall `{!VSTGS OK_ty Σ}, ext_spec (itree event unit).
+  Hypothesis Hdry : forall `{!VSTGS OK_ty Σ}, ext_spec_entails Espec dryspec.
+
   Lemma safety_trace:
-   forall {CS: compspecs} (initial_oracle: OK_ty)
-     (EXIT: semax_prog.postcondition_allows_exit Espec tint)
-     (Jsub: forall ef se lv m t v m' (EFI : ef_inline ef = true) m1
-       (EFC : Events.external_call ef se lv m t v m'), mem_sub m m1 ->
-       exists m1' (EFC1 : Events.external_call ef se lv m1 t v m1'),
-         mem_sub m' m1' /\ proj1_sig (inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC1) =
-         proj1_sig (inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC))
-     (Jframe: extspec_frame OK_spec)
-     (dessicate : forall (ef : external_function) jm,
-               ext_spec_type OK_spec ef ->
-               ext_spec_type dryspec ef)
-     (JDE: juicy_dry_ext_spec _ (@JE_spec OK_ty OK_spec) dryspec dessicate)
-     (DME: ext_spec_mem_evolve _ dryspec)
-     (Esub: forall v z m m', ext_spec_exit dryspec v z m -> mem_sub m m' -> ext_spec_exit dryspec v z m')
-     V G m,
-     @semax_prog Espec CS prog initial_oracle V G ->
+    forall Σ {CS: compspecs} `{!VSTGpreS OK_ty Σ} (initial_oracle: OK_ty)
+     (EXIT: forall `{!VSTGS OK_ty Σ}, semax_prog.postcondition_allows_exit Espec tint)
+     V (G : forall `{!VSTGS OK_ty Σ}, funspecs) m,
+     (forall {HH : VSTGS OK_ty Σ}, semax_prog(OK_spec := Espec) prog initial_oracle V G) ->
      Genv.init_mem prog = Some m ->
      exists b, exists q,
        Genv.find_symbol (Genv.globalenv prog) (prog_main prog) = Some b /\
-       initial_core  (cl_core_sem (globalenv prog))
+       semantics.initial_core (cl_core_sem (globalenv prog))
            0 m q m (Vptr b Ptrofs.zero) nil /\
        forall n, exists traces, ext_safeN_trace n TEnd traces initial_oracle q m.
   Proof.
     intros.
-    eapply CSHL_Sound.semax_prog_sound, whole_program_sequential_safety_ext in H as (b & q & ? & ? & Hsafe); eauto.
+    eapply whole_program_sequential_safety_ext in EXIT as (b & q & ? & ? & Hsafe); eauto.
+    2: { intros. eexists.  apply CSHL_Sound.semax_prog_sound, H. }
     do 3 eexists; eauto; split; eauto; intros n.
     eapply dry_safe_ext_trace_safe; eauto.
   Qed.
@@ -173,26 +163,14 @@ Section ext_trace.
   Qed.
 
   Theorem OS_soundness:
-   forall {CS: compspecs} (initial_oracle: OK_ty)
-     (EXIT: semax_prog.postcondition_allows_exit Espec tint)
-     (Jsub: forall ef se lv m t v m' (EFI : ef_inline ef = true) m1
-       (EFC : Events.external_call ef se lv m t v m'), mem_sub m m1 ->
-       exists m1' (EFC1 : Events.external_call ef se lv m1 t v m1'),
-         mem_sub m' m1' /\ proj1_sig (inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC1) =
-         proj1_sig (inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC))
-     (Jframe: extspec_frame OK_spec)
-     (dessicate : forall (ef : external_function) jm,
-               ext_spec_type OK_spec ef ->
-               ext_spec_type dryspec ef)
-     (JDE: juicy_dry_ext_spec _ (@JE_spec OK_ty OK_spec) dryspec dessicate)
-     (DME: ext_spec_mem_evolve _ dryspec)
-     (Esub: forall v z m m', ext_spec_exit dryspec v z m -> mem_sub m m' -> ext_spec_exit dryspec v z m')
-     V G m,
-     @semax_prog Espec CS prog initial_oracle V G ->
+    forall Σ {CS: compspecs} `{!VSTGpreS OK_ty Σ} (initial_oracle: OK_ty)
+     (EXIT: forall `{!VSTGS OK_ty Σ}, semax_prog.postcondition_allows_exit Espec tint)
+     V (G : forall `{!VSTGS OK_ty Σ}, funspecs) m,
+     (forall {HH : VSTGS OK_ty Σ}, semax_prog(OK_spec := Espec) prog initial_oracle V G) ->
      Genv.init_mem prog = Some m ->
      exists b, exists q,
        Genv.find_symbol (Genv.globalenv prog) (prog_main prog) = Some b /\
-       initial_core  (cl_core_sem (globalenv prog))
+       semantics.initial_core (cl_core_sem (globalenv prog))
            0 m q m (Vptr b Ptrofs.zero) nil /\
        forall n, exists traces, ext_safeN_trace n TEnd traces initial_oracle q m /\
          forall t, In traces t -> exists z', consume_trace initial_oracle z' t.
diff --git a/progs64/ptr_cmp.v b/progs64/ptr_cmp.v
index 36e13a4f90..d67f994c07 100644
--- a/progs64/ptr_cmp.v
+++ b/progs64/ptr_cmp.v
@@ -1,15 +1,17 @@
 From Coq Require Import String List ZArith.
 From compcert Require Import Coqlib Integers Floats AST Ctypes Cop Clight Clightdefs.
+Import Clightdefs.ClightNotations.
 Local Open Scope Z_scope.
 Local Open Scope string_scope.
+Local Open Scope clight_scope.
 
 Module Info.
-  Definition version := "3.8".
+  Definition version := "3.15".
   Definition build_number := "".
   Definition build_tag := "".
   Definition build_branch := "".
   Definition arch := "x86".
-  Definition model := "32sse2".
+  Definition model := "64".
   Definition abi := "standard".
   Definition bitsize := 64.
   Definition big_endian := false.
@@ -17,6 +19,22 @@ Module Info.
   Definition normalized := true.
 End Info.
 
+Definition __IO_FILE : ident := $"_IO_FILE".
+Definition __IO_backup_base : ident := $"_IO_backup_base".
+Definition __IO_buf_base : ident := $"_IO_buf_base".
+Definition __IO_buf_end : ident := $"_IO_buf_end".
+Definition __IO_codecvt : ident := $"_IO_codecvt".
+Definition __IO_marker : ident := $"_IO_marker".
+Definition __IO_read_base : ident := $"_IO_read_base".
+Definition __IO_read_end : ident := $"_IO_read_end".
+Definition __IO_read_ptr : ident := $"_IO_read_ptr".
+Definition __IO_save_base : ident := $"_IO_save_base".
+Definition __IO_save_end : ident := $"_IO_save_end".
+Definition __IO_wide_data : ident := $"_IO_wide_data".
+Definition __IO_write_base : ident := $"_IO_write_base".
+Definition __IO_write_end : ident := $"_IO_write_end".
+Definition __IO_write_ptr : ident := $"_IO_write_ptr".
+Definition ___builtin_ais_annot : ident := $"__builtin_ais_annot".
 Definition ___builtin_annot : ident := $"__builtin_annot".
 Definition ___builtin_annot_intval : ident := $"__builtin_annot_intval".
 Definition ___builtin_bswap : ident := $"__builtin_bswap".
@@ -30,6 +48,7 @@ Definition ___builtin_ctz : ident := $"__builtin_ctz".
 Definition ___builtin_ctzl : ident := $"__builtin_ctzl".
 Definition ___builtin_ctzll : ident := $"__builtin_ctzll".
 Definition ___builtin_debug : ident := $"__builtin_debug".
+Definition ___builtin_expect : ident := $"__builtin_expect".
 Definition ___builtin_fabs : ident := $"__builtin_fabs".
 Definition ___builtin_fabsf : ident := $"__builtin_fabsf".
 Definition ___builtin_fmadd : ident := $"__builtin_fmadd".
@@ -45,6 +64,7 @@ Definition ___builtin_read16_reversed : ident := $"__builtin_read16_reversed".
 Definition ___builtin_read32_reversed : ident := $"__builtin_read32_reversed".
 Definition ___builtin_sel : ident := $"__builtin_sel".
 Definition ___builtin_sqrt : ident := $"__builtin_sqrt".
+Definition ___builtin_unreachable : ident := $"__builtin_unreachable".
 Definition ___builtin_va_arg : ident := $"__builtin_va_arg".
 Definition ___builtin_va_copy : ident := $"__builtin_va_copy".
 Definition ___builtin_va_end : ident := $"__builtin_va_end".
@@ -70,14 +90,168 @@ Definition ___compcert_va_composite : ident := $"__compcert_va_composite".
 Definition ___compcert_va_float64 : ident := $"__compcert_va_float64".
 Definition ___compcert_va_int32 : ident := $"__compcert_va_int32".
 Definition ___compcert_va_int64 : ident := $"__compcert_va_int64".
+Definition ___pad5 : ident := $"__pad5".
+Definition ___stringlit_1 : ident := $"__stringlit_1".
+Definition ___stringlit_2 : ident := $"__stringlit_2".
+Definition ___stringlit_3 : ident := $"__stringlit_3".
+Definition ___stringlit_4 : ident := $"__stringlit_4".
+Definition __chain : ident := $"_chain".
+Definition __codecvt : ident := $"_codecvt".
+Definition __cur_column : ident := $"_cur_column".
+Definition __fileno : ident := $"_fileno".
+Definition __flags : ident := $"_flags".
+Definition __flags2 : ident := $"_flags2".
+Definition __freeres_buf : ident := $"_freeres_buf".
+Definition __freeres_list : ident := $"_freeres_list".
+Definition __l : ident := $"_l".
+Definition __lock : ident := $"_lock".
+Definition __markers : ident := $"_markers".
+Definition __mode : ident := $"_mode".
+Definition __offset : ident := $"_offset".
+Definition __old_offset : ident := $"_old_offset".
+Definition __shortbuf : ident := $"_shortbuf".
+Definition __unused2 : ident := $"_unused2".
+Definition __vtable_offset : ident := $"_vtable_offset".
+Definition __wide_data : ident := $"_wide_data".
+Definition _a : ident := $"a".
+Definition _acquire : ident := $"acquire".
+Definition _append : ident := $"append".
+Definition _args : ident := $"args".
+Definition _atom_int : ident := $"atom_int".
+Definition _b : ident := $"b".
+Definition _buf : ident := $"buf".
+Definition _bufsize : ident := $"bufsize".
+Definition _c : ident := $"c".
+Definition _compute2 : ident := $"compute2".
+Definition _counter : ident := $"counter".
+Definition _ctr : ident := $"ctr".
+Definition _d : ident := $"d".
+Definition _data : ident := $"data".
+Definition _delete : ident := $"delete".
+Definition _des : ident := $"des".
+Definition _deserialize : ident := $"deserialize".
+Definition _dest_ctr : ident := $"dest_ctr".
+Definition _do_and : ident := $"do_and".
+Definition _do_or : ident := $"do_or".
+Definition _e : ident := $"e".
+Definition _exit : ident := $"exit".
+Definition _f : ident := $"f".
+Definition _foo : ident := $"foo".
+Definition _foo_methods : ident := $"foo_methods".
+Definition _foo_object : ident := $"foo_object".
+Definition _foo_reset : ident := $"foo_reset".
+Definition _foo_twiddle : ident := $"foo_twiddle".
+Definition _four : ident := $"four".
+Definition _fprintf : ident := $"fprintf".
+Definition _free : ident := $"free".
+Definition _freeN : ident := $"freeN".
+Definition _freelock : ident := $"freelock".
+Definition _g : ident := $"g".
+Definition _get : ident := $"get".
 Definition _get_branch : ident := $"get_branch".
+Definition _getchar : ident := $"getchar".
+Definition _getchar_blocking : ident := $"getchar_blocking".
+Definition _getchars : ident := $"getchars".
+Definition _h : ident := $"h".
+Definition _head : ident := $"head".
+Definition _hi : ident := $"hi".
+Definition _i : ident := $"i".
+Definition _i__1 : ident := $"i__1".
+Definition _incr : ident := $"incr".
+Definition _init_ctr : ident := $"init_ctr".
+Definition _insert : ident := $"insert".
+Definition _intpair : ident := $"intpair".
+Definition _intpair_deserialize : ident := $"intpair_deserialize".
+Definition _intpair_message : ident := $"intpair_message".
+Definition _intpair_serialize : ident := $"intpair_serialize".
+Definition _j : ident := $"j".
 Definition _k : ident := $"k".
+Definition _key : ident := $"key".
+Definition _l : ident := $"l".
 Definition _left : ident := $"left".
+Definition _len : ident := $"len".
+Definition _length : ident := $"length".
+Definition _list : ident := $"list".
+Definition _lo : ident := $"lo".
+Definition _lock : ident := $"lock".
+Definition _lookup : ident := $"lookup".
 Definition _main : ident := $"main".
+Definition _make_foo : ident := $"make_foo".
+Definition _makelock : ident := $"makelock".
+Definition _malloc : ident := $"malloc".
+Definition _mallocN : ident := $"mallocN".
+Definition _message : ident := $"message".
+Definition _methods : ident := $"methods".
+Definition _mid : ident := $"mid".
+Definition _min : ident := $"min".
+Definition _minimum : ident := $"minimum".
+Definition _mtable : ident := $"mtable".
+Definition _multi_command : ident := $"multi_command".
+Definition _multi_command_s : ident := $"multi_command_s".
+Definition _n : ident := $"n".
+Definition _object : ident := $"object".
 Definition _p : ident := $"p".
+Definition _p0 : ident := $"p0".
+Definition _p1 : ident := $"p1".
+Definition _p2 : ident := $"p2".
+Definition _p3 : ident := $"p3".
+Definition _p4 : ident := $"p4".
+Definition _p5 : ident := $"p5".
+Definition _p6 : ident := $"p6".
+Definition _p7 : ident := $"p7".
 Definition _p_fa : ident := $"p_fa".
+Definition _p_reset : ident := $"p_reset".
+Definition _p_twiddle : ident := $"p_twiddle".
+Definition _pa : ident := $"pa".
+Definition _pb : ident := $"pb".
+Definition _print_int : ident := $"print_int".
+Definition _print_intr : ident := $"print_intr".
+Definition _printf : ident := $"printf".
+Definition _pushdown_left : ident := $"pushdown_left".
+Definition _putchar : ident := $"putchar".
+Definition _putchar_blocking : ident := $"putchar_blocking".
+Definition _putchars : ident := $"putchars".
+Definition _q : ident := $"q".
+Definition _r : ident := $"r".
+Definition _read : ident := $"read".
+Definition _release : ident := $"release".
+Definition _reset : ident := $"reset".
 Definition _right : ident := $"right".
+Definition _s : ident := $"s".
+Definition _search : ident := $"search".
+Definition _self : ident := $"self".
+Definition _ser : ident := $"ser".
+Definition _serialize : ident := $"serialize".
+Definition _set : ident := $"set".
+Definition _spawn : ident := $"spawn".
+Definition _stdout : ident := $"stdout".
+Definition _sub1 : ident := $"sub1".
+Definition _sub2 : ident := $"sub2".
+Definition _sub3 : ident := $"sub3".
+Definition _t : ident := $"t".
+Definition _tail : ident := $"tail".
+Definition _tgt : ident := $"tgt".
+Definition _thread_func : ident := $"thread_func".
+Definition _thread_lock : ident := $"thread_lock".
 Definition _tree : ident := $"tree".
+Definition _tree_free : ident := $"tree_free".
+Definition _treebox_free : ident := $"treebox_free".
+Definition _treebox_new : ident := $"treebox_new".
+Definition _turn_left : ident := $"turn_left".
+Definition _twiddle : ident := $"twiddle".
+Definition _u : ident := $"u".
+Definition _v : ident := $"v".
+Definition _val : ident := $"val".
+Definition _value : ident := $"value".
+Definition _x : ident := $"x".
+Definition _x1 : ident := $"x1".
+Definition _x2 : ident := $"x2".
+Definition _y : ident := $"y".
+Definition _y1 : ident := $"y1".
+Definition _y2 : ident := $"y2".
+Definition _z : ident := $"z".
+Definition _z1 : ident := $"z1".
+Definition _z2 : ident := $"z2".
 Definition _t'1 : ident := 128%positive.
 
 Definition f_get_branch := {|
@@ -101,263 +275,268 @@ Definition f_get_branch := {|
 
 Definition composites : list composite_definition :=
 (Composite _tree Struct
-   ((_k, tuint) :: (_left, (tptr (Tstruct _tree noattr))) ::
-    (_right, (tptr (Tstruct _tree noattr))) :: nil)
+   (Member_plain _k tuint ::
+    Member_plain _left (tptr (Tstruct _tree noattr)) ::
+    Member_plain _right (tptr (Tstruct _tree noattr)) :: nil)
    noattr :: nil).
 
 Definition global_definitions : list (ident * globdef fundef type) :=
-((___builtin_bswap64,
+((___compcert_va_int32,
+   Gfun(External (EF_runtime "__compcert_va_int32"
+                   (mksignature (AST.Xptr :: nil) AST.Xint cc_default))
+     ((tptr tvoid) :: nil) tuint cc_default)) ::
+ (___compcert_va_int64,
+   Gfun(External (EF_runtime "__compcert_va_int64"
+                   (mksignature (AST.Xptr :: nil) AST.Xlong cc_default))
+     ((tptr tvoid) :: nil) tulong cc_default)) ::
+ (___compcert_va_float64,
+   Gfun(External (EF_runtime "__compcert_va_float64"
+                   (mksignature (AST.Xptr :: nil) AST.Xfloat cc_default))
+     ((tptr tvoid) :: nil) tdouble cc_default)) ::
+ (___compcert_va_composite,
+   Gfun(External (EF_runtime "__compcert_va_composite"
+                   (mksignature (AST.Xptr :: AST.Xlong :: nil) AST.Xptr
+                     cc_default)) ((tptr tvoid) :: tulong :: nil)
+     (tptr tvoid) cc_default)) ::
+ (___compcert_i64_dtos,
+   Gfun(External (EF_runtime "__compcert_i64_dtos"
+                   (mksignature (AST.Xfloat :: nil) AST.Xlong cc_default))
+     (tdouble :: nil) tlong cc_default)) ::
+ (___compcert_i64_dtou,
+   Gfun(External (EF_runtime "__compcert_i64_dtou"
+                   (mksignature (AST.Xfloat :: nil) AST.Xlong cc_default))
+     (tdouble :: nil) tulong cc_default)) ::
+ (___compcert_i64_stod,
+   Gfun(External (EF_runtime "__compcert_i64_stod"
+                   (mksignature (AST.Xlong :: nil) AST.Xfloat cc_default))
+     (tlong :: nil) tdouble cc_default)) ::
+ (___compcert_i64_utod,
+   Gfun(External (EF_runtime "__compcert_i64_utod"
+                   (mksignature (AST.Xlong :: nil) AST.Xfloat cc_default))
+     (tulong :: nil) tdouble cc_default)) ::
+ (___compcert_i64_stof,
+   Gfun(External (EF_runtime "__compcert_i64_stof"
+                   (mksignature (AST.Xlong :: nil) AST.Xsingle cc_default))
+     (tlong :: nil) tfloat cc_default)) ::
+ (___compcert_i64_utof,
+   Gfun(External (EF_runtime "__compcert_i64_utof"
+                   (mksignature (AST.Xlong :: nil) AST.Xsingle cc_default))
+     (tulong :: nil) tfloat cc_default)) ::
+ (___compcert_i64_sdiv,
+   Gfun(External (EF_runtime "__compcert_i64_sdiv"
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tlong :: tlong :: nil) tlong cc_default)) ::
+ (___compcert_i64_udiv,
+   Gfun(External (EF_runtime "__compcert_i64_udiv"
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tulong :: tulong :: nil) tulong
+     cc_default)) ::
+ (___compcert_i64_smod,
+   Gfun(External (EF_runtime "__compcert_i64_smod"
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tlong :: tlong :: nil) tlong cc_default)) ::
+ (___compcert_i64_umod,
+   Gfun(External (EF_runtime "__compcert_i64_umod"
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tulong :: tulong :: nil) tulong
+     cc_default)) ::
+ (___compcert_i64_shl,
+   Gfun(External (EF_runtime "__compcert_i64_shl"
+                   (mksignature (AST.Xlong :: AST.Xint :: nil) AST.Xlong
+                     cc_default)) (tlong :: tint :: nil) tlong cc_default)) ::
+ (___compcert_i64_shr,
+   Gfun(External (EF_runtime "__compcert_i64_shr"
+                   (mksignature (AST.Xlong :: AST.Xint :: nil) AST.Xlong
+                     cc_default)) (tulong :: tint :: nil) tulong cc_default)) ::
+ (___compcert_i64_sar,
+   Gfun(External (EF_runtime "__compcert_i64_sar"
+                   (mksignature (AST.Xlong :: AST.Xint :: nil) AST.Xlong
+                     cc_default)) (tlong :: tint :: nil) tlong cc_default)) ::
+ (___compcert_i64_smulh,
+   Gfun(External (EF_runtime "__compcert_i64_smulh"
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tlong :: tlong :: nil) tlong cc_default)) ::
+ (___compcert_i64_umulh,
+   Gfun(External (EF_runtime "__compcert_i64_umulh"
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tulong :: tulong :: nil) tulong
+     cc_default)) ::
+ (___builtin_ais_annot,
+   Gfun(External (EF_builtin "__builtin_ais_annot"
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid
+                     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
+     ((tptr tschar) :: nil) tvoid
+     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
+ (___builtin_bswap64,
    Gfun(External (EF_builtin "__builtin_bswap64"
-                   (mksignature (AST.Tlong :: nil) AST.Tlong cc_default))
-     (Tcons tulong Tnil) tulong cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xlong cc_default))
+     (tulong :: nil) tulong cc_default)) ::
  (___builtin_bswap,
    Gfun(External (EF_builtin "__builtin_bswap"
-                   (mksignature (AST.Tint :: nil) AST.Tint cc_default))
-     (Tcons tuint Tnil) tuint cc_default)) ::
+                   (mksignature (AST.Xint :: nil) AST.Xint cc_default))
+     (tuint :: nil) tuint cc_default)) ::
  (___builtin_bswap32,
    Gfun(External (EF_builtin "__builtin_bswap32"
-                   (mksignature (AST.Tint :: nil) AST.Tint cc_default))
-     (Tcons tuint Tnil) tuint cc_default)) ::
+                   (mksignature (AST.Xint :: nil) AST.Xint cc_default))
+     (tuint :: nil) tuint cc_default)) ::
  (___builtin_bswap16,
    Gfun(External (EF_builtin "__builtin_bswap16"
-                   (mksignature (AST.Tint :: nil) AST.Tint16unsigned
-                     cc_default)) (Tcons tushort Tnil) tushort cc_default)) ::
+                   (mksignature (AST.Xint16unsigned :: nil)
+                     AST.Xint16unsigned cc_default)) (tushort :: nil) tushort
+     cc_default)) ::
  (___builtin_clz,
    Gfun(External (EF_builtin "__builtin_clz"
-                   (mksignature (AST.Tint :: nil) AST.Tint cc_default))
-     (Tcons tuint Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xint :: nil) AST.Xint cc_default))
+     (tuint :: nil) tint cc_default)) ::
  (___builtin_clzl,
    Gfun(External (EF_builtin "__builtin_clzl"
-                   (mksignature (AST.Tint :: nil) AST.Tint cc_default))
-     (Tcons tuint Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xint cc_default))
+     (tulong :: nil) tint cc_default)) ::
  (___builtin_clzll,
    Gfun(External (EF_builtin "__builtin_clzll"
-                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
-     (Tcons tulong Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xint cc_default))
+     (tulong :: nil) tint cc_default)) ::
  (___builtin_ctz,
    Gfun(External (EF_builtin "__builtin_ctz"
-                   (mksignature (AST.Tint :: nil) AST.Tint cc_default))
-     (Tcons tuint Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xint :: nil) AST.Xint cc_default))
+     (tuint :: nil) tint cc_default)) ::
  (___builtin_ctzl,
    Gfun(External (EF_builtin "__builtin_ctzl"
-                   (mksignature (AST.Tint :: nil) AST.Tint cc_default))
-     (Tcons tuint Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xint cc_default))
+     (tulong :: nil) tint cc_default)) ::
  (___builtin_ctzll,
    Gfun(External (EF_builtin "__builtin_ctzll"
-                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
-     (Tcons tulong Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xint cc_default))
+     (tulong :: nil) tint cc_default)) ::
  (___builtin_fabs,
    Gfun(External (EF_builtin "__builtin_fabs"
-                   (mksignature (AST.Tfloat :: nil) AST.Tfloat cc_default))
-     (Tcons tdouble Tnil) tdouble cc_default)) ::
+                   (mksignature (AST.Xfloat :: nil) AST.Xfloat cc_default))
+     (tdouble :: nil) tdouble cc_default)) ::
  (___builtin_fabsf,
    Gfun(External (EF_builtin "__builtin_fabsf"
-                   (mksignature (AST.Tsingle :: nil) AST.Tsingle cc_default))
-     (Tcons tfloat Tnil) tfloat cc_default)) ::
+                   (mksignature (AST.Xsingle :: nil) AST.Xsingle cc_default))
+     (tfloat :: nil) tfloat cc_default)) ::
  (___builtin_fsqrt,
    Gfun(External (EF_builtin "__builtin_fsqrt"
-                   (mksignature (AST.Tfloat :: nil) AST.Tfloat cc_default))
-     (Tcons tdouble Tnil) tdouble cc_default)) ::
+                   (mksignature (AST.Xfloat :: nil) AST.Xfloat cc_default))
+     (tdouble :: nil) tdouble cc_default)) ::
  (___builtin_sqrt,
    Gfun(External (EF_builtin "__builtin_sqrt"
-                   (mksignature (AST.Tfloat :: nil) AST.Tfloat cc_default))
-     (Tcons tdouble Tnil) tdouble cc_default)) ::
+                   (mksignature (AST.Xfloat :: nil) AST.Xfloat cc_default))
+     (tdouble :: nil) tdouble cc_default)) ::
  (___builtin_memcpy_aligned,
    Gfun(External (EF_builtin "__builtin_memcpy_aligned"
                    (mksignature
-                     (AST.Tlong :: AST.Tlong :: AST.Tint :: AST.Tint :: nil)
-                     AST.Tvoid cc_default))
-     (Tcons (tptr tvoid)
-       (Tcons (tptr tvoid) (Tcons tuint (Tcons tuint Tnil)))) tvoid
+                     (AST.Xptr :: AST.Xptr :: AST.Xlong :: AST.Xlong :: nil)
+                     AST.Xvoid cc_default))
+     ((tptr tvoid) :: (tptr tvoid) :: tulong :: tulong :: nil) tvoid
      cc_default)) ::
  (___builtin_sel,
    Gfun(External (EF_builtin "__builtin_sel"
-                   (mksignature (AST.Tint :: nil) AST.Tvoid
-                     {|cc_vararg:=true; cc_unproto:=false; cc_structret:=false|}))
-     (Tcons tbool Tnil) tvoid
-     {|cc_vararg:=true; cc_unproto:=false; cc_structret:=false|})) ::
+                   (mksignature (AST.Xbool :: nil) AST.Xvoid
+                     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
+     (tbool :: nil) tvoid
+     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
  (___builtin_annot,
    Gfun(External (EF_builtin "__builtin_annot"
-                   (mksignature (AST.Tlong :: nil) AST.Tvoid
-                     {|cc_vararg:=true; cc_unproto:=false; cc_structret:=false|}))
-     (Tcons (tptr tschar) Tnil) tvoid
-     {|cc_vararg:=true; cc_unproto:=false; cc_structret:=false|})) ::
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid
+                     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
+     ((tptr tschar) :: nil) tvoid
+     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
  (___builtin_annot_intval,
    Gfun(External (EF_builtin "__builtin_annot_intval"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tint
-                     cc_default)) (Tcons (tptr tschar) (Tcons tint Tnil))
-     tint cc_default)) ::
+                   (mksignature (AST.Xptr :: AST.Xint :: nil) AST.Xint
+                     cc_default)) ((tptr tschar) :: tint :: nil) tint
+     cc_default)) ::
  (___builtin_membar,
    Gfun(External (EF_builtin "__builtin_membar"
-                   (mksignature nil AST.Tvoid cc_default)) Tnil tvoid
+                   (mksignature nil AST.Xvoid cc_default)) nil tvoid
      cc_default)) ::
  (___builtin_va_start,
    Gfun(External (EF_builtin "__builtin_va_start"
-                   (mksignature (AST.Tlong :: nil) AST.Tvoid cc_default))
-     (Tcons (tptr tvoid) Tnil) tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid cc_default))
+     ((tptr tvoid) :: nil) tvoid cc_default)) ::
  (___builtin_va_arg,
    Gfun(External (EF_builtin "__builtin_va_arg"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tvoid
-                     cc_default)) (Tcons (tptr tvoid) (Tcons tuint Tnil))
-     tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: AST.Xint :: nil) AST.Xvoid
+                     cc_default)) ((tptr tvoid) :: tuint :: nil) tvoid
+     cc_default)) ::
  (___builtin_va_copy,
    Gfun(External (EF_builtin "__builtin_va_copy"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tvoid
-                     cc_default))
-     (Tcons (tptr tvoid) (Tcons (tptr tvoid) Tnil)) tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: AST.Xptr :: nil) AST.Xvoid
+                     cc_default)) ((tptr tvoid) :: (tptr tvoid) :: nil) tvoid
+     cc_default)) ::
  (___builtin_va_end,
    Gfun(External (EF_builtin "__builtin_va_end"
-                   (mksignature (AST.Tlong :: nil) AST.Tvoid cc_default))
-     (Tcons (tptr tvoid) Tnil) tvoid cc_default)) ::
- (___compcert_va_int32,
-   Gfun(External (EF_external "__compcert_va_int32"
-                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
-     (Tcons (tptr tvoid) Tnil) tuint cc_default)) ::
- (___compcert_va_int64,
-   Gfun(External (EF_external "__compcert_va_int64"
-                   (mksignature (AST.Tlong :: nil) AST.Tlong cc_default))
-     (Tcons (tptr tvoid) Tnil) tulong cc_default)) ::
- (___compcert_va_float64,
-   Gfun(External (EF_external "__compcert_va_float64"
-                   (mksignature (AST.Tlong :: nil) AST.Tfloat cc_default))
-     (Tcons (tptr tvoid) Tnil) tdouble cc_default)) ::
- (___compcert_va_composite,
-   Gfun(External (EF_external "__compcert_va_composite"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tlong
-                     cc_default)) (Tcons (tptr tvoid) (Tcons tuint Tnil))
-     (tptr tvoid) cc_default)) ::
- (___compcert_i64_dtos,
-   Gfun(External (EF_runtime "__compcert_i64_dtos"
-                   (mksignature (AST.Tfloat :: nil) AST.Tlong cc_default))
-     (Tcons tdouble Tnil) tlong cc_default)) ::
- (___compcert_i64_dtou,
-   Gfun(External (EF_runtime "__compcert_i64_dtou"
-                   (mksignature (AST.Tfloat :: nil) AST.Tlong cc_default))
-     (Tcons tdouble Tnil) tulong cc_default)) ::
- (___compcert_i64_stod,
-   Gfun(External (EF_runtime "__compcert_i64_stod"
-                   (mksignature (AST.Tlong :: nil) AST.Tfloat cc_default))
-     (Tcons tlong Tnil) tdouble cc_default)) ::
- (___compcert_i64_utod,
-   Gfun(External (EF_runtime "__compcert_i64_utod"
-                   (mksignature (AST.Tlong :: nil) AST.Tfloat cc_default))
-     (Tcons tulong Tnil) tdouble cc_default)) ::
- (___compcert_i64_stof,
-   Gfun(External (EF_runtime "__compcert_i64_stof"
-                   (mksignature (AST.Tlong :: nil) AST.Tsingle cc_default))
-     (Tcons tlong Tnil) tfloat cc_default)) ::
- (___compcert_i64_utof,
-   Gfun(External (EF_runtime "__compcert_i64_utof"
-                   (mksignature (AST.Tlong :: nil) AST.Tsingle cc_default))
-     (Tcons tulong Tnil) tfloat cc_default)) ::
- (___compcert_i64_sdiv,
-   Gfun(External (EF_runtime "__compcert_i64_sdiv"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
-                     cc_default)) (Tcons tlong (Tcons tlong Tnil)) tlong
-     cc_default)) ::
- (___compcert_i64_udiv,
-   Gfun(External (EF_runtime "__compcert_i64_udiv"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
-                     cc_default)) (Tcons tulong (Tcons tulong Tnil)) tulong
-     cc_default)) ::
- (___compcert_i64_smod,
-   Gfun(External (EF_runtime "__compcert_i64_smod"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
-                     cc_default)) (Tcons tlong (Tcons tlong Tnil)) tlong
-     cc_default)) ::
- (___compcert_i64_umod,
-   Gfun(External (EF_runtime "__compcert_i64_umod"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
-                     cc_default)) (Tcons tulong (Tcons tulong Tnil)) tulong
-     cc_default)) ::
- (___compcert_i64_shl,
-   Gfun(External (EF_runtime "__compcert_i64_shl"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tlong
-                     cc_default)) (Tcons tlong (Tcons tint Tnil)) tlong
-     cc_default)) ::
- (___compcert_i64_shr,
-   Gfun(External (EF_runtime "__compcert_i64_shr"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tlong
-                     cc_default)) (Tcons tulong (Tcons tint Tnil)) tulong
-     cc_default)) ::
- (___compcert_i64_sar,
-   Gfun(External (EF_runtime "__compcert_i64_sar"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tlong
-                     cc_default)) (Tcons tlong (Tcons tint Tnil)) tlong
-     cc_default)) ::
- (___compcert_i64_smulh,
-   Gfun(External (EF_runtime "__compcert_i64_smulh"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
-                     cc_default)) (Tcons tlong (Tcons tlong Tnil)) tlong
-     cc_default)) ::
- (___compcert_i64_umulh,
-   Gfun(External (EF_runtime "__compcert_i64_umulh"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
-                     cc_default)) (Tcons tulong (Tcons tulong Tnil)) tulong
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid cc_default))
+     ((tptr tvoid) :: nil) tvoid cc_default)) ::
+ (___builtin_unreachable,
+   Gfun(External (EF_builtin "__builtin_unreachable"
+                   (mksignature nil AST.Xvoid cc_default)) nil tvoid
      cc_default)) ::
+ (___builtin_expect,
+   Gfun(External (EF_builtin "__builtin_expect"
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tlong :: tlong :: nil) tlong cc_default)) ::
  (___builtin_fmax,
    Gfun(External (EF_builtin "__builtin_fmax"
-                   (mksignature (AST.Tfloat :: AST.Tfloat :: nil) AST.Tfloat
-                     cc_default)) (Tcons tdouble (Tcons tdouble Tnil))
-     tdouble cc_default)) ::
+                   (mksignature (AST.Xfloat :: AST.Xfloat :: nil) AST.Xfloat
+                     cc_default)) (tdouble :: tdouble :: nil) tdouble
+     cc_default)) ::
  (___builtin_fmin,
    Gfun(External (EF_builtin "__builtin_fmin"
-                   (mksignature (AST.Tfloat :: AST.Tfloat :: nil) AST.Tfloat
-                     cc_default)) (Tcons tdouble (Tcons tdouble Tnil))
-     tdouble cc_default)) ::
+                   (mksignature (AST.Xfloat :: AST.Xfloat :: nil) AST.Xfloat
+                     cc_default)) (tdouble :: tdouble :: nil) tdouble
+     cc_default)) ::
  (___builtin_fmadd,
    Gfun(External (EF_builtin "__builtin_fmadd"
                    (mksignature
-                     (AST.Tfloat :: AST.Tfloat :: AST.Tfloat :: nil)
-                     AST.Tfloat cc_default))
-     (Tcons tdouble (Tcons tdouble (Tcons tdouble Tnil))) tdouble
-     cc_default)) ::
+                     (AST.Xfloat :: AST.Xfloat :: AST.Xfloat :: nil)
+                     AST.Xfloat cc_default))
+     (tdouble :: tdouble :: tdouble :: nil) tdouble cc_default)) ::
  (___builtin_fmsub,
    Gfun(External (EF_builtin "__builtin_fmsub"
                    (mksignature
-                     (AST.Tfloat :: AST.Tfloat :: AST.Tfloat :: nil)
-                     AST.Tfloat cc_default))
-     (Tcons tdouble (Tcons tdouble (Tcons tdouble Tnil))) tdouble
-     cc_default)) ::
+                     (AST.Xfloat :: AST.Xfloat :: AST.Xfloat :: nil)
+                     AST.Xfloat cc_default))
+     (tdouble :: tdouble :: tdouble :: nil) tdouble cc_default)) ::
  (___builtin_fnmadd,
    Gfun(External (EF_builtin "__builtin_fnmadd"
                    (mksignature
-                     (AST.Tfloat :: AST.Tfloat :: AST.Tfloat :: nil)
-                     AST.Tfloat cc_default))
-     (Tcons tdouble (Tcons tdouble (Tcons tdouble Tnil))) tdouble
-     cc_default)) ::
+                     (AST.Xfloat :: AST.Xfloat :: AST.Xfloat :: nil)
+                     AST.Xfloat cc_default))
+     (tdouble :: tdouble :: tdouble :: nil) tdouble cc_default)) ::
  (___builtin_fnmsub,
    Gfun(External (EF_builtin "__builtin_fnmsub"
                    (mksignature
-                     (AST.Tfloat :: AST.Tfloat :: AST.Tfloat :: nil)
-                     AST.Tfloat cc_default))
-     (Tcons tdouble (Tcons tdouble (Tcons tdouble Tnil))) tdouble
-     cc_default)) ::
+                     (AST.Xfloat :: AST.Xfloat :: AST.Xfloat :: nil)
+                     AST.Xfloat cc_default))
+     (tdouble :: tdouble :: tdouble :: nil) tdouble cc_default)) ::
  (___builtin_read16_reversed,
    Gfun(External (EF_builtin "__builtin_read16_reversed"
-                   (mksignature (AST.Tlong :: nil) AST.Tint16unsigned
-                     cc_default)) (Tcons (tptr tushort) Tnil) tushort
+                   (mksignature (AST.Xptr :: nil) AST.Xint16unsigned
+                     cc_default)) ((tptr tushort) :: nil) tushort
      cc_default)) ::
  (___builtin_read32_reversed,
    Gfun(External (EF_builtin "__builtin_read32_reversed"
-                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
-     (Tcons (tptr tuint) Tnil) tuint cc_default)) ::
+                   (mksignature (AST.Xptr :: nil) AST.Xint cc_default))
+     ((tptr tuint) :: nil) tuint cc_default)) ::
  (___builtin_write16_reversed,
    Gfun(External (EF_builtin "__builtin_write16_reversed"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tvoid
-                     cc_default)) (Tcons (tptr tushort) (Tcons tushort Tnil))
-     tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: AST.Xint16unsigned :: nil)
+                     AST.Xvoid cc_default))
+     ((tptr tushort) :: tushort :: nil) tvoid cc_default)) ::
  (___builtin_write32_reversed,
    Gfun(External (EF_builtin "__builtin_write32_reversed"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tvoid
-                     cc_default)) (Tcons (tptr tuint) (Tcons tuint Tnil))
-     tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: AST.Xint :: nil) AST.Xvoid
+                     cc_default)) ((tptr tuint) :: tuint :: nil) tvoid
+     cc_default)) ::
  (___builtin_debug,
    Gfun(External (EF_external "__builtin_debug"
-                   (mksignature (AST.Tint :: nil) AST.Tvoid
-                     {|cc_vararg:=true; cc_unproto:=false; cc_structret:=false|}))
-     (Tcons tint Tnil) tvoid
-     {|cc_vararg:=true; cc_unproto:=false; cc_structret:=false|})) ::
+                   (mksignature (AST.Xint :: nil) AST.Xvoid
+                     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
+     (tint :: nil) tvoid
+     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
  (_get_branch, Gfun(Internal f_get_branch)) :: nil).
 
 Definition public_idents : list ident :=
@@ -365,13 +544,7 @@ Definition public_idents : list ident :=
  ___builtin_write16_reversed :: ___builtin_read32_reversed ::
  ___builtin_read16_reversed :: ___builtin_fnmsub :: ___builtin_fnmadd ::
  ___builtin_fmsub :: ___builtin_fmadd :: ___builtin_fmin ::
- ___builtin_fmax :: ___compcert_i64_umulh :: ___compcert_i64_smulh ::
- ___compcert_i64_sar :: ___compcert_i64_shr :: ___compcert_i64_shl ::
- ___compcert_i64_umod :: ___compcert_i64_smod :: ___compcert_i64_udiv ::
- ___compcert_i64_sdiv :: ___compcert_i64_utof :: ___compcert_i64_stof ::
- ___compcert_i64_utod :: ___compcert_i64_stod :: ___compcert_i64_dtou ::
- ___compcert_i64_dtos :: ___compcert_va_composite ::
- ___compcert_va_float64 :: ___compcert_va_int64 :: ___compcert_va_int32 ::
+ ___builtin_fmax :: ___builtin_expect :: ___builtin_unreachable ::
  ___builtin_va_end :: ___builtin_va_copy :: ___builtin_va_arg ::
  ___builtin_va_start :: ___builtin_membar :: ___builtin_annot_intval ::
  ___builtin_annot :: ___builtin_sel :: ___builtin_memcpy_aligned ::
@@ -379,7 +552,14 @@ Definition public_idents : list ident :=
  ___builtin_fabs :: ___builtin_ctzll :: ___builtin_ctzl :: ___builtin_ctz ::
  ___builtin_clzll :: ___builtin_clzl :: ___builtin_clz ::
  ___builtin_bswap16 :: ___builtin_bswap32 :: ___builtin_bswap ::
- ___builtin_bswap64 :: nil).
+ ___builtin_bswap64 :: ___builtin_ais_annot :: ___compcert_i64_umulh ::
+ ___compcert_i64_smulh :: ___compcert_i64_sar :: ___compcert_i64_shr ::
+ ___compcert_i64_shl :: ___compcert_i64_umod :: ___compcert_i64_smod ::
+ ___compcert_i64_udiv :: ___compcert_i64_sdiv :: ___compcert_i64_utof ::
+ ___compcert_i64_stof :: ___compcert_i64_utod :: ___compcert_i64_stod ::
+ ___compcert_i64_dtou :: ___compcert_i64_dtos :: ___compcert_va_composite ::
+ ___compcert_va_float64 :: ___compcert_va_int64 :: ___compcert_va_int32 ::
+ nil).
 
 Definition prog : Clight.program := 
   mkprogram composites global_definitions public_idents _main Logic.I.
diff --git a/progs64/shift.v b/progs64/shift.v
index 12eeff091b..8d586d4b3a 100644
--- a/progs64/shift.v
+++ b/progs64/shift.v
@@ -1,89 +1,281 @@
 From Coq Require Import String List ZArith.
 From compcert Require Import Coqlib Integers Floats AST Ctypes Cop Clight Clightdefs.
+Import Clightdefs.ClightNotations.
 Local Open Scope Z_scope.
+Local Open Scope string_scope.
+Local Open Scope clight_scope.
 
 Module Info.
-  Definition version := "3.6"%string.
-  Definition build_number := ""%string.
-  Definition build_tag := ""%string.
-  Definition arch := "x86"%string.
-  Definition model := "32sse2"%string.
-  Definition abi := "standard"%string.
-  Definition bitsize := 32.
+  Definition version := "3.15".
+  Definition build_number := "".
+  Definition build_tag := "".
+  Definition build_branch := "".
+  Definition arch := "x86".
+  Definition model := "64".
+  Definition abi := "standard".
+  Definition bitsize := 64.
   Definition big_endian := false.
-  Definition source_file := "shift.c"%string.
+  Definition source_file := "progs64/shift.c".
   Definition normalized := true.
 End Info.
 
-Definition _N : ident := 63%positive.
-Definition ___builtin_annot : ident := 9%positive.
-Definition ___builtin_annot_intval : ident := 10%positive.
-Definition ___builtin_bswap : ident := 2%positive.
-Definition ___builtin_bswap16 : ident := 4%positive.
-Definition ___builtin_bswap32 : ident := 3%positive.
-Definition ___builtin_bswap64 : ident := 1%positive.
-Definition ___builtin_clz : ident := 35%positive.
-Definition ___builtin_clzl : ident := 36%positive.
-Definition ___builtin_clzll : ident := 37%positive.
-Definition ___builtin_ctz : ident := 38%positive.
-Definition ___builtin_ctzl : ident := 39%positive.
-Definition ___builtin_ctzll : ident := 40%positive.
-Definition ___builtin_debug : ident := 52%positive.
-Definition ___builtin_fabs : ident := 5%positive.
-Definition ___builtin_fmadd : ident := 43%positive.
-Definition ___builtin_fmax : ident := 41%positive.
-Definition ___builtin_fmin : ident := 42%positive.
-Definition ___builtin_fmsub : ident := 44%positive.
-Definition ___builtin_fnmadd : ident := 45%positive.
-Definition ___builtin_fnmsub : ident := 46%positive.
-Definition ___builtin_fsqrt : ident := 6%positive.
-Definition ___builtin_membar : ident := 11%positive.
-Definition ___builtin_memcpy_aligned : ident := 7%positive.
-Definition ___builtin_nop : ident := 51%positive.
-Definition ___builtin_read16_reversed : ident := 47%positive.
-Definition ___builtin_read32_reversed : ident := 48%positive.
-Definition ___builtin_sel : ident := 8%positive.
-Definition ___builtin_va_arg : ident := 13%positive.
-Definition ___builtin_va_copy : ident := 14%positive.
-Definition ___builtin_va_end : ident := 15%positive.
-Definition ___builtin_va_start : ident := 12%positive.
-Definition ___builtin_write16_reversed : ident := 49%positive.
-Definition ___builtin_write32_reversed : ident := 50%positive.
-Definition ___compcert_i64_dtos : ident := 20%positive.
-Definition ___compcert_i64_dtou : ident := 21%positive.
-Definition ___compcert_i64_sar : ident := 32%positive.
-Definition ___compcert_i64_sdiv : ident := 26%positive.
-Definition ___compcert_i64_shl : ident := 30%positive.
-Definition ___compcert_i64_shr : ident := 31%positive.
-Definition ___compcert_i64_smod : ident := 28%positive.
-Definition ___compcert_i64_smulh : ident := 33%positive.
-Definition ___compcert_i64_stod : ident := 22%positive.
-Definition ___compcert_i64_stof : ident := 24%positive.
-Definition ___compcert_i64_udiv : ident := 27%positive.
-Definition ___compcert_i64_umod : ident := 29%positive.
-Definition ___compcert_i64_umulh : ident := 34%positive.
-Definition ___compcert_i64_utod : ident := 23%positive.
-Definition ___compcert_i64_utof : ident := 25%positive.
-Definition ___compcert_va_composite : ident := 19%positive.
-Definition ___compcert_va_float64 : ident := 18%positive.
-Definition ___compcert_va_int32 : ident := 16%positive.
-Definition ___compcert_va_int64 : ident := 17%positive.
-Definition _a : ident := 55%positive.
-Definition _b : ident := 58%positive.
-Definition _free : ident := 54%positive.
-Definition _i : ident := 59%positive.
-Definition _i__1 : ident := 60%positive.
-Definition _i__2 : ident := 61%positive.
-Definition _k : ident := 57%positive.
-Definition _main : ident := 65%positive.
-Definition _malloc : ident := 53%positive.
-Definition _n : ident := 56%positive.
-Definition _shift : ident := 62%positive.
-Definition _sorted_shift : ident := 64%positive.
-Definition _t'1 : ident := 66%positive.
-Definition _t'2 : ident := 67%positive.
-Definition _t'3 : ident := 68%positive.
-Definition _t'4 : ident := 69%positive.
+Definition _N : ident := $"N".
+Definition _Q : ident := $"Q".
+Definition __IO_FILE : ident := $"_IO_FILE".
+Definition __IO_backup_base : ident := $"_IO_backup_base".
+Definition __IO_buf_base : ident := $"_IO_buf_base".
+Definition __IO_buf_end : ident := $"_IO_buf_end".
+Definition __IO_codecvt : ident := $"_IO_codecvt".
+Definition __IO_marker : ident := $"_IO_marker".
+Definition __IO_read_base : ident := $"_IO_read_base".
+Definition __IO_read_end : ident := $"_IO_read_end".
+Definition __IO_read_ptr : ident := $"_IO_read_ptr".
+Definition __IO_save_base : ident := $"_IO_save_base".
+Definition __IO_save_end : ident := $"_IO_save_end".
+Definition __IO_wide_data : ident := $"_IO_wide_data".
+Definition __IO_write_base : ident := $"_IO_write_base".
+Definition __IO_write_end : ident := $"_IO_write_end".
+Definition __IO_write_ptr : ident := $"_IO_write_ptr".
+Definition ___builtin_ais_annot : ident := $"__builtin_ais_annot".
+Definition ___builtin_annot : ident := $"__builtin_annot".
+Definition ___builtin_annot_intval : ident := $"__builtin_annot_intval".
+Definition ___builtin_bswap : ident := $"__builtin_bswap".
+Definition ___builtin_bswap16 : ident := $"__builtin_bswap16".
+Definition ___builtin_bswap32 : ident := $"__builtin_bswap32".
+Definition ___builtin_bswap64 : ident := $"__builtin_bswap64".
+Definition ___builtin_clz : ident := $"__builtin_clz".
+Definition ___builtin_clzl : ident := $"__builtin_clzl".
+Definition ___builtin_clzll : ident := $"__builtin_clzll".
+Definition ___builtin_ctz : ident := $"__builtin_ctz".
+Definition ___builtin_ctzl : ident := $"__builtin_ctzl".
+Definition ___builtin_ctzll : ident := $"__builtin_ctzll".
+Definition ___builtin_debug : ident := $"__builtin_debug".
+Definition ___builtin_expect : ident := $"__builtin_expect".
+Definition ___builtin_fabs : ident := $"__builtin_fabs".
+Definition ___builtin_fabsf : ident := $"__builtin_fabsf".
+Definition ___builtin_fmadd : ident := $"__builtin_fmadd".
+Definition ___builtin_fmax : ident := $"__builtin_fmax".
+Definition ___builtin_fmin : ident := $"__builtin_fmin".
+Definition ___builtin_fmsub : ident := $"__builtin_fmsub".
+Definition ___builtin_fnmadd : ident := $"__builtin_fnmadd".
+Definition ___builtin_fnmsub : ident := $"__builtin_fnmsub".
+Definition ___builtin_fsqrt : ident := $"__builtin_fsqrt".
+Definition ___builtin_membar : ident := $"__builtin_membar".
+Definition ___builtin_memcpy_aligned : ident := $"__builtin_memcpy_aligned".
+Definition ___builtin_read16_reversed : ident := $"__builtin_read16_reversed".
+Definition ___builtin_read32_reversed : ident := $"__builtin_read32_reversed".
+Definition ___builtin_sel : ident := $"__builtin_sel".
+Definition ___builtin_sqrt : ident := $"__builtin_sqrt".
+Definition ___builtin_unreachable : ident := $"__builtin_unreachable".
+Definition ___builtin_va_arg : ident := $"__builtin_va_arg".
+Definition ___builtin_va_copy : ident := $"__builtin_va_copy".
+Definition ___builtin_va_end : ident := $"__builtin_va_end".
+Definition ___builtin_va_start : ident := $"__builtin_va_start".
+Definition ___builtin_write16_reversed : ident := $"__builtin_write16_reversed".
+Definition ___builtin_write32_reversed : ident := $"__builtin_write32_reversed".
+Definition ___compcert_i64_dtos : ident := $"__compcert_i64_dtos".
+Definition ___compcert_i64_dtou : ident := $"__compcert_i64_dtou".
+Definition ___compcert_i64_sar : ident := $"__compcert_i64_sar".
+Definition ___compcert_i64_sdiv : ident := $"__compcert_i64_sdiv".
+Definition ___compcert_i64_shl : ident := $"__compcert_i64_shl".
+Definition ___compcert_i64_shr : ident := $"__compcert_i64_shr".
+Definition ___compcert_i64_smod : ident := $"__compcert_i64_smod".
+Definition ___compcert_i64_smulh : ident := $"__compcert_i64_smulh".
+Definition ___compcert_i64_stod : ident := $"__compcert_i64_stod".
+Definition ___compcert_i64_stof : ident := $"__compcert_i64_stof".
+Definition ___compcert_i64_udiv : ident := $"__compcert_i64_udiv".
+Definition ___compcert_i64_umod : ident := $"__compcert_i64_umod".
+Definition ___compcert_i64_umulh : ident := $"__compcert_i64_umulh".
+Definition ___compcert_i64_utod : ident := $"__compcert_i64_utod".
+Definition ___compcert_i64_utof : ident := $"__compcert_i64_utof".
+Definition ___compcert_va_composite : ident := $"__compcert_va_composite".
+Definition ___compcert_va_float64 : ident := $"__compcert_va_float64".
+Definition ___compcert_va_int32 : ident := $"__compcert_va_int32".
+Definition ___compcert_va_int64 : ident := $"__compcert_va_int64".
+Definition ___pad5 : ident := $"__pad5".
+Definition ___stringlit_1 : ident := $"__stringlit_1".
+Definition ___stringlit_2 : ident := $"__stringlit_2".
+Definition ___stringlit_3 : ident := $"__stringlit_3".
+Definition ___stringlit_4 : ident := $"__stringlit_4".
+Definition __chain : ident := $"_chain".
+Definition __codecvt : ident := $"_codecvt".
+Definition __cur_column : ident := $"_cur_column".
+Definition __fileno : ident := $"_fileno".
+Definition __flags : ident := $"_flags".
+Definition __flags2 : ident := $"_flags2".
+Definition __freeres_buf : ident := $"_freeres_buf".
+Definition __freeres_list : ident := $"_freeres_list".
+Definition __l : ident := $"_l".
+Definition __lock : ident := $"_lock".
+Definition __markers : ident := $"_markers".
+Definition __mode : ident := $"_mode".
+Definition __offset : ident := $"_offset".
+Definition __old_offset : ident := $"_old_offset".
+Definition __shortbuf : ident := $"_shortbuf".
+Definition __unused2 : ident := $"_unused2".
+Definition __vtable_offset : ident := $"_vtable_offset".
+Definition __wide_data : ident := $"_wide_data".
+Definition _a : ident := $"a".
+Definition _acquire : ident := $"acquire".
+Definition _append : ident := $"append".
+Definition _args : ident := $"args".
+Definition _atom_int : ident := $"atom_int".
+Definition _b : ident := $"b".
+Definition _buf : ident := $"buf".
+Definition _bufsize : ident := $"bufsize".
+Definition _c : ident := $"c".
+Definition _compute2 : ident := $"compute2".
+Definition _counter : ident := $"counter".
+Definition _ctr : ident := $"ctr".
+Definition _d : ident := $"d".
+Definition _data : ident := $"data".
+Definition _delete : ident := $"delete".
+Definition _des : ident := $"des".
+Definition _deserialize : ident := $"deserialize".
+Definition _dest_ctr : ident := $"dest_ctr".
+Definition _do_and : ident := $"do_and".
+Definition _do_or : ident := $"do_or".
+Definition _e : ident := $"e".
+Definition _elem : ident := $"elem".
+Definition _exit : ident := $"exit".
+Definition _f : ident := $"f".
+Definition _fifo : ident := $"fifo".
+Definition _fifo_empty : ident := $"fifo_empty".
+Definition _fifo_get : ident := $"fifo_get".
+Definition _fifo_new : ident := $"fifo_new".
+Definition _fifo_put : ident := $"fifo_put".
+Definition _foo : ident := $"foo".
+Definition _foo_methods : ident := $"foo_methods".
+Definition _foo_object : ident := $"foo_object".
+Definition _foo_reset : ident := $"foo_reset".
+Definition _foo_twiddle : ident := $"foo_twiddle".
+Definition _four : ident := $"four".
+Definition _fprintf : ident := $"fprintf".
+Definition _free : ident := $"free".
+Definition _freeN : ident := $"freeN".
+Definition _freelock : ident := $"freelock".
+Definition _g : ident := $"g".
+Definition _get : ident := $"get".
+Definition _get_branch : ident := $"get_branch".
+Definition _getchar : ident := $"getchar".
+Definition _getchar_blocking : ident := $"getchar_blocking".
+Definition _getchars : ident := $"getchars".
+Definition _h : ident := $"h".
+Definition _head : ident := $"head".
+Definition _hi : ident := $"hi".
+Definition _i : ident := $"i".
+Definition _i__1 : ident := $"i__1".
+Definition _i__2 : ident := $"i__2".
+Definition _incr : ident := $"incr".
+Definition _init_ctr : ident := $"init_ctr".
+Definition _insert : ident := $"insert".
+Definition _intpair : ident := $"intpair".
+Definition _intpair_deserialize : ident := $"intpair_deserialize".
+Definition _intpair_message : ident := $"intpair_message".
+Definition _intpair_serialize : ident := $"intpair_serialize".
+Definition _j : ident := $"j".
+Definition _k : ident := $"k".
+Definition _key : ident := $"key".
+Definition _l : ident := $"l".
+Definition _last_foo : ident := $"last_foo".
+Definition _left : ident := $"left".
+Definition _len : ident := $"len".
+Definition _length : ident := $"length".
+Definition _list : ident := $"list".
+Definition _lo : ident := $"lo".
+Definition _lock : ident := $"lock".
+Definition _lookup : ident := $"lookup".
+Definition _main : ident := $"main".
+Definition _make_elem : ident := $"make_elem".
+Definition _make_foo : ident := $"make_foo".
+Definition _makelock : ident := $"makelock".
+Definition _malloc : ident := $"malloc".
+Definition _mallocN : ident := $"mallocN".
+Definition _message : ident := $"message".
+Definition _methods : ident := $"methods".
+Definition _mid : ident := $"mid".
+Definition _min : ident := $"min".
+Definition _minimum : ident := $"minimum".
+Definition _mtable : ident := $"mtable".
+Definition _multi_command : ident := $"multi_command".
+Definition _multi_command_s : ident := $"multi_command_s".
+Definition _n : ident := $"n".
+Definition _next : ident := $"next".
+Definition _object : ident := $"object".
+Definition _p : ident := $"p".
+Definition _p0 : ident := $"p0".
+Definition _p1 : ident := $"p1".
+Definition _p2 : ident := $"p2".
+Definition _p3 : ident := $"p3".
+Definition _p4 : ident := $"p4".
+Definition _p5 : ident := $"p5".
+Definition _p6 : ident := $"p6".
+Definition _p7 : ident := $"p7".
+Definition _p_fa : ident := $"p_fa".
+Definition _p_reset : ident := $"p_reset".
+Definition _p_twiddle : ident := $"p_twiddle".
+Definition _pa : ident := $"pa".
+Definition _pb : ident := $"pb".
+Definition _print_int : ident := $"print_int".
+Definition _print_intr : ident := $"print_intr".
+Definition _printf : ident := $"printf".
+Definition _pushdown_left : ident := $"pushdown_left".
+Definition _putchar : ident := $"putchar".
+Definition _putchar_blocking : ident := $"putchar_blocking".
+Definition _putchars : ident := $"putchars".
+Definition _q : ident := $"q".
+Definition _r : ident := $"r".
+Definition _read : ident := $"read".
+Definition _release : ident := $"release".
+Definition _res : ident := $"res".
+Definition _reset : ident := $"reset".
+Definition _reverse : ident := $"reverse".
+Definition _right : ident := $"right".
+Definition _s : ident := $"s".
+Definition _search : ident := $"search".
+Definition _self : ident := $"self".
+Definition _ser : ident := $"ser".
+Definition _serialize : ident := $"serialize".
+Definition _set : ident := $"set".
+Definition _shift : ident := $"shift".
+Definition _sorted_shift : ident := $"sorted_shift".
+Definition _spawn : ident := $"spawn".
+Definition _stdout : ident := $"stdout".
+Definition _sub1 : ident := $"sub1".
+Definition _sub2 : ident := $"sub2".
+Definition _sub3 : ident := $"sub3".
+Definition _sumlist : ident := $"sumlist".
+Definition _surely_malloc : ident := $"surely_malloc".
+Definition _t : ident := $"t".
+Definition _tail : ident := $"tail".
+Definition _tgt : ident := $"tgt".
+Definition _thread_func : ident := $"thread_func".
+Definition _thread_lock : ident := $"thread_lock".
+Definition _three : ident := $"three".
+Definition _tree : ident := $"tree".
+Definition _tree_free : ident := $"tree_free".
+Definition _treebox_free : ident := $"treebox_free".
+Definition _treebox_new : ident := $"treebox_new".
+Definition _turn_left : ident := $"turn_left".
+Definition _twiddle : ident := $"twiddle".
+Definition _u : ident := $"u".
+Definition _v : ident := $"v".
+Definition _val : ident := $"val".
+Definition _value : ident := $"value".
+Definition _w : ident := $"w".
+Definition _x : ident := $"x".
+Definition _x1 : ident := $"x1".
+Definition _x2 : ident := $"x2".
+Definition _y : ident := $"y".
+Definition _y1 : ident := $"y1".
+Definition _y2 : ident := $"y2".
+Definition _z : ident := $"z".
+Definition _z1 : ident := $"z1".
+Definition _z2 : ident := $"z2".
+Definition _t'1 : ident := 128%positive.
+Definition _t'2 : ident := 129%positive.
+Definition _t'3 : ident := 130%positive.
+Definition _t'4 : ident := 131%positive.
 
 Definition f_shift := {|
   fn_return := tvoid;
@@ -97,8 +289,8 @@ Definition f_shift := {|
 (Ssequence
   (Ssequence
     (Scall (Some _t'1)
-      (Evar _malloc (Tfunction (Tcons tuint Tnil) (tptr tvoid) cc_default))
-      ((Ebinop Omul (Esizeof tint tuint) (Etempvar _n tint) tuint) :: nil))
+      (Evar _malloc (Tfunction (tulong :: nil) (tptr tvoid) cc_default))
+      ((Ebinop Omul (Esizeof tint tulong) (Etempvar _n tint) tulong) :: nil))
     (Sset _b (Etempvar _t'1 (tptr tvoid))))
   (Ssequence
     (Ssequence
@@ -170,7 +362,7 @@ Definition f_shift := {|
               (Ebinop Oadd (Etempvar _i__2 tint)
                 (Econst_int (Int.repr 1) tint) tint))))
         (Scall None
-          (Evar _free (Tfunction (Tcons (tptr tvoid) Tnil) tvoid cc_default))
+          (Evar _free (Tfunction ((tptr tvoid) :: nil) tvoid cc_default))
           ((Etempvar _b (tptr tint)) :: nil))))))
 |}.
 
@@ -184,8 +376,7 @@ Definition f_sorted_shift := {|
   fn_body :=
 (Ssequence
   (Scall None
-    (Evar _shift (Tfunction
-                   (Tcons (tptr tint) (Tcons tint (Tcons tint Tnil))) tvoid
+    (Evar _shift (Tfunction ((tptr tint) :: tint :: tint :: nil) tvoid
                    cc_default))
     ((Etempvar _a (tptr tint)) :: (Etempvar _n tint) :: (Etempvar _k tint) ::
      nil))
@@ -214,279 +405,289 @@ Definition composites : list composite_definition :=
 nil.
 
 Definition global_definitions : list (ident * globdef fundef type) :=
-((___builtin_bswap64,
-   Gfun(External (EF_builtin "__builtin_bswap64"
-                   (mksignature (AST.Tlong :: nil) (Some AST.Tlong)
-                     cc_default)) (Tcons tulong Tnil) tulong cc_default)) ::
- (___builtin_bswap,
-   Gfun(External (EF_builtin "__builtin_bswap"
-                   (mksignature (AST.Tint :: nil) (Some AST.Tint) cc_default))
-     (Tcons tuint Tnil) tuint cc_default)) ::
- (___builtin_bswap32,
-   Gfun(External (EF_builtin "__builtin_bswap32"
-                   (mksignature (AST.Tint :: nil) (Some AST.Tint) cc_default))
-     (Tcons tuint Tnil) tuint cc_default)) ::
- (___builtin_bswap16,
-   Gfun(External (EF_builtin "__builtin_bswap16"
-                   (mksignature (AST.Tint :: nil) (Some AST.Tint) cc_default))
-     (Tcons tushort Tnil) tushort cc_default)) ::
- (___builtin_fabs,
-   Gfun(External (EF_builtin "__builtin_fabs"
-                   (mksignature (AST.Tfloat :: nil) (Some AST.Tfloat)
-                     cc_default)) (Tcons tdouble Tnil) tdouble cc_default)) ::
- (___builtin_fsqrt,
-   Gfun(External (EF_builtin "__builtin_fsqrt"
-                   (mksignature (AST.Tfloat :: nil) (Some AST.Tfloat)
-                     cc_default)) (Tcons tdouble Tnil) tdouble cc_default)) ::
- (___builtin_memcpy_aligned,
-   Gfun(External (EF_builtin "__builtin_memcpy_aligned"
-                   (mksignature
-                     (AST.Tint :: AST.Tint :: AST.Tint :: AST.Tint :: nil)
-                     None cc_default))
-     (Tcons (tptr tvoid)
-       (Tcons (tptr tvoid) (Tcons tuint (Tcons tuint Tnil)))) tvoid
-     cc_default)) ::
- (___builtin_sel,
-   Gfun(External (EF_builtin "__builtin_sel"
-                   (mksignature (AST.Tint :: nil) None
-                     {|cc_vararg:=true; cc_unproto:=false; cc_structret:=false|}))
-     (Tcons tbool Tnil) tvoid
-     {|cc_vararg:=true; cc_unproto:=false; cc_structret:=false|})) ::
- (___builtin_annot,
-   Gfun(External (EF_builtin "__builtin_annot"
-                   (mksignature (AST.Tint :: nil) None
-                     {|cc_vararg:=true; cc_unproto:=false; cc_structret:=false|}))
-     (Tcons (tptr tschar) Tnil) tvoid
-     {|cc_vararg:=true; cc_unproto:=false; cc_structret:=false|})) ::
- (___builtin_annot_intval,
-   Gfun(External (EF_builtin "__builtin_annot_intval"
-                   (mksignature (AST.Tint :: AST.Tint :: nil) (Some AST.Tint)
-                     cc_default)) (Tcons (tptr tschar) (Tcons tint Tnil))
-     tint cc_default)) ::
- (___builtin_membar,
-   Gfun(External (EF_builtin "__builtin_membar"
-                   (mksignature nil None cc_default)) Tnil tvoid cc_default)) ::
- (___builtin_va_start,
-   Gfun(External (EF_builtin "__builtin_va_start"
-                   (mksignature (AST.Tint :: nil) None cc_default))
-     (Tcons (tptr tvoid) Tnil) tvoid cc_default)) ::
- (___builtin_va_arg,
-   Gfun(External (EF_builtin "__builtin_va_arg"
-                   (mksignature (AST.Tint :: AST.Tint :: nil) None
-                     cc_default)) (Tcons (tptr tvoid) (Tcons tuint Tnil))
-     tvoid cc_default)) ::
- (___builtin_va_copy,
-   Gfun(External (EF_builtin "__builtin_va_copy"
-                   (mksignature (AST.Tint :: AST.Tint :: nil) None
-                     cc_default))
-     (Tcons (tptr tvoid) (Tcons (tptr tvoid) Tnil)) tvoid cc_default)) ::
- (___builtin_va_end,
-   Gfun(External (EF_builtin "__builtin_va_end"
-                   (mksignature (AST.Tint :: nil) None cc_default))
-     (Tcons (tptr tvoid) Tnil) tvoid cc_default)) ::
- (___compcert_va_int32,
-   Gfun(External (EF_external "__compcert_va_int32"
-                   (mksignature (AST.Tint :: nil) (Some AST.Tint) cc_default))
-     (Tcons (tptr tvoid) Tnil) tuint cc_default)) ::
+((___compcert_va_int32,
+   Gfun(External (EF_runtime "__compcert_va_int32"
+                   (mksignature (AST.Xptr :: nil) AST.Xint cc_default))
+     ((tptr tvoid) :: nil) tuint cc_default)) ::
  (___compcert_va_int64,
-   Gfun(External (EF_external "__compcert_va_int64"
-                   (mksignature (AST.Tint :: nil) (Some AST.Tlong)
-                     cc_default)) (Tcons (tptr tvoid) Tnil) tulong
-     cc_default)) ::
+   Gfun(External (EF_runtime "__compcert_va_int64"
+                   (mksignature (AST.Xptr :: nil) AST.Xlong cc_default))
+     ((tptr tvoid) :: nil) tulong cc_default)) ::
  (___compcert_va_float64,
-   Gfun(External (EF_external "__compcert_va_float64"
-                   (mksignature (AST.Tint :: nil) (Some AST.Tfloat)
-                     cc_default)) (Tcons (tptr tvoid) Tnil) tdouble
-     cc_default)) ::
+   Gfun(External (EF_runtime "__compcert_va_float64"
+                   (mksignature (AST.Xptr :: nil) AST.Xfloat cc_default))
+     ((tptr tvoid) :: nil) tdouble cc_default)) ::
  (___compcert_va_composite,
-   Gfun(External (EF_external "__compcert_va_composite"
-                   (mksignature (AST.Tint :: AST.Tint :: nil) (Some AST.Tint)
-                     cc_default)) (Tcons (tptr tvoid) (Tcons tuint Tnil))
+   Gfun(External (EF_runtime "__compcert_va_composite"
+                   (mksignature (AST.Xptr :: AST.Xlong :: nil) AST.Xptr
+                     cc_default)) ((tptr tvoid) :: tulong :: nil)
      (tptr tvoid) cc_default)) ::
  (___compcert_i64_dtos,
    Gfun(External (EF_runtime "__compcert_i64_dtos"
-                   (mksignature (AST.Tfloat :: nil) (Some AST.Tlong)
-                     cc_default)) (Tcons tdouble Tnil) tlong cc_default)) ::
+                   (mksignature (AST.Xfloat :: nil) AST.Xlong cc_default))
+     (tdouble :: nil) tlong cc_default)) ::
  (___compcert_i64_dtou,
    Gfun(External (EF_runtime "__compcert_i64_dtou"
-                   (mksignature (AST.Tfloat :: nil) (Some AST.Tlong)
-                     cc_default)) (Tcons tdouble Tnil) tulong cc_default)) ::
+                   (mksignature (AST.Xfloat :: nil) AST.Xlong cc_default))
+     (tdouble :: nil) tulong cc_default)) ::
  (___compcert_i64_stod,
    Gfun(External (EF_runtime "__compcert_i64_stod"
-                   (mksignature (AST.Tlong :: nil) (Some AST.Tfloat)
-                     cc_default)) (Tcons tlong Tnil) tdouble cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xfloat cc_default))
+     (tlong :: nil) tdouble cc_default)) ::
  (___compcert_i64_utod,
    Gfun(External (EF_runtime "__compcert_i64_utod"
-                   (mksignature (AST.Tlong :: nil) (Some AST.Tfloat)
-                     cc_default)) (Tcons tulong Tnil) tdouble cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xfloat cc_default))
+     (tulong :: nil) tdouble cc_default)) ::
  (___compcert_i64_stof,
    Gfun(External (EF_runtime "__compcert_i64_stof"
-                   (mksignature (AST.Tlong :: nil) (Some AST.Tsingle)
-                     cc_default)) (Tcons tlong Tnil) tfloat cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xsingle cc_default))
+     (tlong :: nil) tfloat cc_default)) ::
  (___compcert_i64_utof,
    Gfun(External (EF_runtime "__compcert_i64_utof"
-                   (mksignature (AST.Tlong :: nil) (Some AST.Tsingle)
-                     cc_default)) (Tcons tulong Tnil) tfloat cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xsingle cc_default))
+     (tulong :: nil) tfloat cc_default)) ::
  (___compcert_i64_sdiv,
    Gfun(External (EF_runtime "__compcert_i64_sdiv"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil)
-                     (Some AST.Tlong) cc_default))
-     (Tcons tlong (Tcons tlong Tnil)) tlong cc_default)) ::
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tlong :: tlong :: nil) tlong cc_default)) ::
  (___compcert_i64_udiv,
    Gfun(External (EF_runtime "__compcert_i64_udiv"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil)
-                     (Some AST.Tlong) cc_default))
-     (Tcons tulong (Tcons tulong Tnil)) tulong cc_default)) ::
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tulong :: tulong :: nil) tulong
+     cc_default)) ::
  (___compcert_i64_smod,
    Gfun(External (EF_runtime "__compcert_i64_smod"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil)
-                     (Some AST.Tlong) cc_default))
-     (Tcons tlong (Tcons tlong Tnil)) tlong cc_default)) ::
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tlong :: tlong :: nil) tlong cc_default)) ::
  (___compcert_i64_umod,
    Gfun(External (EF_runtime "__compcert_i64_umod"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil)
-                     (Some AST.Tlong) cc_default))
-     (Tcons tulong (Tcons tulong Tnil)) tulong cc_default)) ::
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tulong :: tulong :: nil) tulong
+     cc_default)) ::
  (___compcert_i64_shl,
    Gfun(External (EF_runtime "__compcert_i64_shl"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil)
-                     (Some AST.Tlong) cc_default))
-     (Tcons tlong (Tcons tint Tnil)) tlong cc_default)) ::
+                   (mksignature (AST.Xlong :: AST.Xint :: nil) AST.Xlong
+                     cc_default)) (tlong :: tint :: nil) tlong cc_default)) ::
  (___compcert_i64_shr,
    Gfun(External (EF_runtime "__compcert_i64_shr"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil)
-                     (Some AST.Tlong) cc_default))
-     (Tcons tulong (Tcons tint Tnil)) tulong cc_default)) ::
+                   (mksignature (AST.Xlong :: AST.Xint :: nil) AST.Xlong
+                     cc_default)) (tulong :: tint :: nil) tulong cc_default)) ::
  (___compcert_i64_sar,
    Gfun(External (EF_runtime "__compcert_i64_sar"
-                   (mksignature (AST.Tlong :: AST.Tint :: nil)
-                     (Some AST.Tlong) cc_default))
-     (Tcons tlong (Tcons tint Tnil)) tlong cc_default)) ::
+                   (mksignature (AST.Xlong :: AST.Xint :: nil) AST.Xlong
+                     cc_default)) (tlong :: tint :: nil) tlong cc_default)) ::
  (___compcert_i64_smulh,
    Gfun(External (EF_runtime "__compcert_i64_smulh"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil)
-                     (Some AST.Tlong) cc_default))
-     (Tcons tlong (Tcons tlong Tnil)) tlong cc_default)) ::
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tlong :: tlong :: nil) tlong cc_default)) ::
  (___compcert_i64_umulh,
    Gfun(External (EF_runtime "__compcert_i64_umulh"
-                   (mksignature (AST.Tlong :: AST.Tlong :: nil)
-                     (Some AST.Tlong) cc_default))
-     (Tcons tulong (Tcons tulong Tnil)) tulong cc_default)) ::
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tulong :: tulong :: nil) tulong
+     cc_default)) ::
+ (___builtin_ais_annot,
+   Gfun(External (EF_builtin "__builtin_ais_annot"
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid
+                     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
+     ((tptr tschar) :: nil) tvoid
+     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
+ (___builtin_bswap64,
+   Gfun(External (EF_builtin "__builtin_bswap64"
+                   (mksignature (AST.Xlong :: nil) AST.Xlong cc_default))
+     (tulong :: nil) tulong cc_default)) ::
+ (___builtin_bswap,
+   Gfun(External (EF_builtin "__builtin_bswap"
+                   (mksignature (AST.Xint :: nil) AST.Xint cc_default))
+     (tuint :: nil) tuint cc_default)) ::
+ (___builtin_bswap32,
+   Gfun(External (EF_builtin "__builtin_bswap32"
+                   (mksignature (AST.Xint :: nil) AST.Xint cc_default))
+     (tuint :: nil) tuint cc_default)) ::
+ (___builtin_bswap16,
+   Gfun(External (EF_builtin "__builtin_bswap16"
+                   (mksignature (AST.Xint16unsigned :: nil)
+                     AST.Xint16unsigned cc_default)) (tushort :: nil) tushort
+     cc_default)) ::
  (___builtin_clz,
    Gfun(External (EF_builtin "__builtin_clz"
-                   (mksignature (AST.Tint :: nil) (Some AST.Tint) cc_default))
-     (Tcons tuint Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xint :: nil) AST.Xint cc_default))
+     (tuint :: nil) tint cc_default)) ::
  (___builtin_clzl,
    Gfun(External (EF_builtin "__builtin_clzl"
-                   (mksignature (AST.Tint :: nil) (Some AST.Tint) cc_default))
-     (Tcons tuint Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xint cc_default))
+     (tulong :: nil) tint cc_default)) ::
  (___builtin_clzll,
    Gfun(External (EF_builtin "__builtin_clzll"
-                   (mksignature (AST.Tlong :: nil) (Some AST.Tint)
-                     cc_default)) (Tcons tulong Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xint cc_default))
+     (tulong :: nil) tint cc_default)) ::
  (___builtin_ctz,
    Gfun(External (EF_builtin "__builtin_ctz"
-                   (mksignature (AST.Tint :: nil) (Some AST.Tint) cc_default))
-     (Tcons tuint Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xint :: nil) AST.Xint cc_default))
+     (tuint :: nil) tint cc_default)) ::
  (___builtin_ctzl,
    Gfun(External (EF_builtin "__builtin_ctzl"
-                   (mksignature (AST.Tint :: nil) (Some AST.Tint) cc_default))
-     (Tcons tuint Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xint cc_default))
+     (tulong :: nil) tint cc_default)) ::
  (___builtin_ctzll,
    Gfun(External (EF_builtin "__builtin_ctzll"
-                   (mksignature (AST.Tlong :: nil) (Some AST.Tint)
-                     cc_default)) (Tcons tulong Tnil) tint cc_default)) ::
+                   (mksignature (AST.Xlong :: nil) AST.Xint cc_default))
+     (tulong :: nil) tint cc_default)) ::
+ (___builtin_fabs,
+   Gfun(External (EF_builtin "__builtin_fabs"
+                   (mksignature (AST.Xfloat :: nil) AST.Xfloat cc_default))
+     (tdouble :: nil) tdouble cc_default)) ::
+ (___builtin_fabsf,
+   Gfun(External (EF_builtin "__builtin_fabsf"
+                   (mksignature (AST.Xsingle :: nil) AST.Xsingle cc_default))
+     (tfloat :: nil) tfloat cc_default)) ::
+ (___builtin_fsqrt,
+   Gfun(External (EF_builtin "__builtin_fsqrt"
+                   (mksignature (AST.Xfloat :: nil) AST.Xfloat cc_default))
+     (tdouble :: nil) tdouble cc_default)) ::
+ (___builtin_sqrt,
+   Gfun(External (EF_builtin "__builtin_sqrt"
+                   (mksignature (AST.Xfloat :: nil) AST.Xfloat cc_default))
+     (tdouble :: nil) tdouble cc_default)) ::
+ (___builtin_memcpy_aligned,
+   Gfun(External (EF_builtin "__builtin_memcpy_aligned"
+                   (mksignature
+                     (AST.Xptr :: AST.Xptr :: AST.Xlong :: AST.Xlong :: nil)
+                     AST.Xvoid cc_default))
+     ((tptr tvoid) :: (tptr tvoid) :: tulong :: tulong :: nil) tvoid
+     cc_default)) ::
+ (___builtin_sel,
+   Gfun(External (EF_builtin "__builtin_sel"
+                   (mksignature (AST.Xbool :: nil) AST.Xvoid
+                     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
+     (tbool :: nil) tvoid
+     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
+ (___builtin_annot,
+   Gfun(External (EF_builtin "__builtin_annot"
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid
+                     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
+     ((tptr tschar) :: nil) tvoid
+     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
+ (___builtin_annot_intval,
+   Gfun(External (EF_builtin "__builtin_annot_intval"
+                   (mksignature (AST.Xptr :: AST.Xint :: nil) AST.Xint
+                     cc_default)) ((tptr tschar) :: tint :: nil) tint
+     cc_default)) ::
+ (___builtin_membar,
+   Gfun(External (EF_builtin "__builtin_membar"
+                   (mksignature nil AST.Xvoid cc_default)) nil tvoid
+     cc_default)) ::
+ (___builtin_va_start,
+   Gfun(External (EF_builtin "__builtin_va_start"
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid cc_default))
+     ((tptr tvoid) :: nil) tvoid cc_default)) ::
+ (___builtin_va_arg,
+   Gfun(External (EF_builtin "__builtin_va_arg"
+                   (mksignature (AST.Xptr :: AST.Xint :: nil) AST.Xvoid
+                     cc_default)) ((tptr tvoid) :: tuint :: nil) tvoid
+     cc_default)) ::
+ (___builtin_va_copy,
+   Gfun(External (EF_builtin "__builtin_va_copy"
+                   (mksignature (AST.Xptr :: AST.Xptr :: nil) AST.Xvoid
+                     cc_default)) ((tptr tvoid) :: (tptr tvoid) :: nil) tvoid
+     cc_default)) ::
+ (___builtin_va_end,
+   Gfun(External (EF_builtin "__builtin_va_end"
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid cc_default))
+     ((tptr tvoid) :: nil) tvoid cc_default)) ::
+ (___builtin_unreachable,
+   Gfun(External (EF_builtin "__builtin_unreachable"
+                   (mksignature nil AST.Xvoid cc_default)) nil tvoid
+     cc_default)) ::
+ (___builtin_expect,
+   Gfun(External (EF_builtin "__builtin_expect"
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tlong :: tlong :: nil) tlong cc_default)) ::
  (___builtin_fmax,
    Gfun(External (EF_builtin "__builtin_fmax"
-                   (mksignature (AST.Tfloat :: AST.Tfloat :: nil)
-                     (Some AST.Tfloat) cc_default))
-     (Tcons tdouble (Tcons tdouble Tnil)) tdouble cc_default)) ::
+                   (mksignature (AST.Xfloat :: AST.Xfloat :: nil) AST.Xfloat
+                     cc_default)) (tdouble :: tdouble :: nil) tdouble
+     cc_default)) ::
  (___builtin_fmin,
    Gfun(External (EF_builtin "__builtin_fmin"
-                   (mksignature (AST.Tfloat :: AST.Tfloat :: nil)
-                     (Some AST.Tfloat) cc_default))
-     (Tcons tdouble (Tcons tdouble Tnil)) tdouble cc_default)) ::
+                   (mksignature (AST.Xfloat :: AST.Xfloat :: nil) AST.Xfloat
+                     cc_default)) (tdouble :: tdouble :: nil) tdouble
+     cc_default)) ::
  (___builtin_fmadd,
    Gfun(External (EF_builtin "__builtin_fmadd"
                    (mksignature
-                     (AST.Tfloat :: AST.Tfloat :: AST.Tfloat :: nil)
-                     (Some AST.Tfloat) cc_default))
-     (Tcons tdouble (Tcons tdouble (Tcons tdouble Tnil))) tdouble
-     cc_default)) ::
+                     (AST.Xfloat :: AST.Xfloat :: AST.Xfloat :: nil)
+                     AST.Xfloat cc_default))
+     (tdouble :: tdouble :: tdouble :: nil) tdouble cc_default)) ::
  (___builtin_fmsub,
    Gfun(External (EF_builtin "__builtin_fmsub"
                    (mksignature
-                     (AST.Tfloat :: AST.Tfloat :: AST.Tfloat :: nil)
-                     (Some AST.Tfloat) cc_default))
-     (Tcons tdouble (Tcons tdouble (Tcons tdouble Tnil))) tdouble
-     cc_default)) ::
+                     (AST.Xfloat :: AST.Xfloat :: AST.Xfloat :: nil)
+                     AST.Xfloat cc_default))
+     (tdouble :: tdouble :: tdouble :: nil) tdouble cc_default)) ::
  (___builtin_fnmadd,
    Gfun(External (EF_builtin "__builtin_fnmadd"
                    (mksignature
-                     (AST.Tfloat :: AST.Tfloat :: AST.Tfloat :: nil)
-                     (Some AST.Tfloat) cc_default))
-     (Tcons tdouble (Tcons tdouble (Tcons tdouble Tnil))) tdouble
-     cc_default)) ::
+                     (AST.Xfloat :: AST.Xfloat :: AST.Xfloat :: nil)
+                     AST.Xfloat cc_default))
+     (tdouble :: tdouble :: tdouble :: nil) tdouble cc_default)) ::
  (___builtin_fnmsub,
    Gfun(External (EF_builtin "__builtin_fnmsub"
                    (mksignature
-                     (AST.Tfloat :: AST.Tfloat :: AST.Tfloat :: nil)
-                     (Some AST.Tfloat) cc_default))
-     (Tcons tdouble (Tcons tdouble (Tcons tdouble Tnil))) tdouble
-     cc_default)) ::
+                     (AST.Xfloat :: AST.Xfloat :: AST.Xfloat :: nil)
+                     AST.Xfloat cc_default))
+     (tdouble :: tdouble :: tdouble :: nil) tdouble cc_default)) ::
  (___builtin_read16_reversed,
    Gfun(External (EF_builtin "__builtin_read16_reversed"
-                   (mksignature (AST.Tint :: nil) (Some AST.Tint) cc_default))
-     (Tcons (tptr tushort) Tnil) tushort cc_default)) ::
+                   (mksignature (AST.Xptr :: nil) AST.Xint16unsigned
+                     cc_default)) ((tptr tushort) :: nil) tushort
+     cc_default)) ::
  (___builtin_read32_reversed,
    Gfun(External (EF_builtin "__builtin_read32_reversed"
-                   (mksignature (AST.Tint :: nil) (Some AST.Tint) cc_default))
-     (Tcons (tptr tuint) Tnil) tuint cc_default)) ::
+                   (mksignature (AST.Xptr :: nil) AST.Xint cc_default))
+     ((tptr tuint) :: nil) tuint cc_default)) ::
  (___builtin_write16_reversed,
    Gfun(External (EF_builtin "__builtin_write16_reversed"
-                   (mksignature (AST.Tint :: AST.Tint :: nil) None
-                     cc_default)) (Tcons (tptr tushort) (Tcons tushort Tnil))
-     tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: AST.Xint16unsigned :: nil)
+                     AST.Xvoid cc_default))
+     ((tptr tushort) :: tushort :: nil) tvoid cc_default)) ::
  (___builtin_write32_reversed,
    Gfun(External (EF_builtin "__builtin_write32_reversed"
-                   (mksignature (AST.Tint :: AST.Tint :: nil) None
-                     cc_default)) (Tcons (tptr tuint) (Tcons tuint Tnil))
-     tvoid cc_default)) ::
- (___builtin_nop,
-   Gfun(External (EF_builtin "__builtin_nop"
-                   (mksignature nil None cc_default)) Tnil tvoid cc_default)) ::
+                   (mksignature (AST.Xptr :: AST.Xint :: nil) AST.Xvoid
+                     cc_default)) ((tptr tuint) :: tuint :: nil) tvoid
+     cc_default)) ::
  (___builtin_debug,
    Gfun(External (EF_external "__builtin_debug"
-                   (mksignature (AST.Tint :: nil) None
-                     {|cc_vararg:=true; cc_unproto:=false; cc_structret:=false|}))
-     (Tcons tint Tnil) tvoid
-     {|cc_vararg:=true; cc_unproto:=false; cc_structret:=false|})) ::
- (_malloc,
-   Gfun(External EF_malloc (Tcons tuint Tnil) (tptr tvoid) cc_default)) ::
- (_free, Gfun(External EF_free (Tcons (tptr tvoid) Tnil) tvoid cc_default)) ::
+                   (mksignature (AST.Xint :: nil) AST.Xvoid
+                     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
+     (tint :: nil) tvoid
+     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
+ (_malloc, Gfun(External EF_malloc (tulong :: nil) (tptr tvoid) cc_default)) ::
+ (_free, Gfun(External EF_free ((tptr tvoid) :: nil) tvoid cc_default)) ::
  (_shift, Gfun(Internal f_shift)) ::
  (_sorted_shift, Gfun(Internal f_sorted_shift)) :: nil).
 
 Definition public_idents : list ident :=
 (_sorted_shift :: _shift :: _free :: _malloc :: ___builtin_debug ::
- ___builtin_nop :: ___builtin_write32_reversed ::
- ___builtin_write16_reversed :: ___builtin_read32_reversed ::
- ___builtin_read16_reversed :: ___builtin_fnmsub :: ___builtin_fnmadd ::
- ___builtin_fmsub :: ___builtin_fmadd :: ___builtin_fmin ::
- ___builtin_fmax :: ___builtin_ctzll :: ___builtin_ctzl :: ___builtin_ctz ::
- ___builtin_clzll :: ___builtin_clzl :: ___builtin_clz ::
- ___compcert_i64_umulh :: ___compcert_i64_smulh :: ___compcert_i64_sar ::
- ___compcert_i64_shr :: ___compcert_i64_shl :: ___compcert_i64_umod ::
- ___compcert_i64_smod :: ___compcert_i64_udiv :: ___compcert_i64_sdiv ::
- ___compcert_i64_utof :: ___compcert_i64_stof :: ___compcert_i64_utod ::
- ___compcert_i64_stod :: ___compcert_i64_dtou :: ___compcert_i64_dtos ::
- ___compcert_va_composite :: ___compcert_va_float64 ::
- ___compcert_va_int64 :: ___compcert_va_int32 :: ___builtin_va_end ::
+ ___builtin_write32_reversed :: ___builtin_write16_reversed ::
+ ___builtin_read32_reversed :: ___builtin_read16_reversed ::
+ ___builtin_fnmsub :: ___builtin_fnmadd :: ___builtin_fmsub ::
+ ___builtin_fmadd :: ___builtin_fmin :: ___builtin_fmax ::
+ ___builtin_expect :: ___builtin_unreachable :: ___builtin_va_end ::
  ___builtin_va_copy :: ___builtin_va_arg :: ___builtin_va_start ::
  ___builtin_membar :: ___builtin_annot_intval :: ___builtin_annot ::
- ___builtin_sel :: ___builtin_memcpy_aligned :: ___builtin_fsqrt ::
- ___builtin_fabs :: ___builtin_bswap16 :: ___builtin_bswap32 ::
- ___builtin_bswap :: ___builtin_bswap64 :: nil).
+ ___builtin_sel :: ___builtin_memcpy_aligned :: ___builtin_sqrt ::
+ ___builtin_fsqrt :: ___builtin_fabsf :: ___builtin_fabs ::
+ ___builtin_ctzll :: ___builtin_ctzl :: ___builtin_ctz :: ___builtin_clzll ::
+ ___builtin_clzl :: ___builtin_clz :: ___builtin_bswap16 ::
+ ___builtin_bswap32 :: ___builtin_bswap :: ___builtin_bswap64 ::
+ ___builtin_ais_annot :: ___compcert_i64_umulh :: ___compcert_i64_smulh ::
+ ___compcert_i64_sar :: ___compcert_i64_shr :: ___compcert_i64_shl ::
+ ___compcert_i64_umod :: ___compcert_i64_smod :: ___compcert_i64_udiv ::
+ ___compcert_i64_sdiv :: ___compcert_i64_utof :: ___compcert_i64_stof ::
+ ___compcert_i64_utod :: ___compcert_i64_stod :: ___compcert_i64_dtou ::
+ ___compcert_i64_dtos :: ___compcert_va_composite ::
+ ___compcert_va_float64 :: ___compcert_va_int64 :: ___compcert_va_int32 ::
+ nil).
 
 Definition prog : Clight.program := 
   mkprogram composites global_definitions public_idents _main Logic.I.
diff --git a/progs64/verif_append2.v b/progs64/verif_append2.v
index c944f4accb..51b75299b7 100644
--- a/progs64/verif_append2.v
+++ b/progs64/verif_append2.v
@@ -6,54 +6,68 @@ Require Import VST.progs64.append.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 Definition t_struct_list := Tstruct _list noattr.
 
+Lemma not_bot_nonidentity : forall sh,  sh <> Share.bot -> sepalg.nonidentity sh.
+Proof.
+   intros.
+   unfold sepalg.nonidentity. unfold not.
+   intros. apply identity_share_bot in H0. contradiction.
+Qed.
+Lemma nonidentity_not_bot : forall sh, sepalg.nonidentity sh -> sh <> Share.bot.
+Proof.
+   intros. unfold sepalg.nonidentity. unfold not. intros. apply H. rewrite H0. apply bot_identity.    
+Qed.
+#[export] Hint Resolve not_bot_nonidentity : core.
+#[export] Hint Resolve nonidentity_not_bot : core.
+
+Section Spec.
+
+Context  `{!default_VSTGS Σ}.
 
 Fixpoint listrep (sh: share)
             (contents: list val) (x: val) : mpred :=
  match contents with
  | h::hs =>
-              EX y:val,
-                data_at sh t_struct_list (h,y) x * listrep sh hs y
- | nil => !! (x = nullval) && emp
+              ∃ y:val,
+                data_at sh t_struct_list (h,y) x ∗ listrep sh hs y
+ | nil => ⌜x = nullval⌝ ∧ emp
  end.
 
 Arguments listrep sh contents x : simpl never.
 
 Lemma listrep_local_facts:
   forall sh contents p,
-     listrep sh contents p |--
-     !! (is_pointer_or_null p /\ (p=nullval <-> contents=nil)).
+     listrep sh contents p ⊢
+     ⌜is_pointer_or_null p ∧ (p=nullval <-> contents=nil)⌝.
 Proof.
 intros.
 revert p; induction contents; 
-  unfold listrep; fold listrep; intros. entailer!. intuition.
+  unfold listrep; fold listrep; intros. entailer!. tauto.
 Intros y. entailer!.
 split; intro. subst p. destruct H; contradiction. inv H2.
 Qed.
 
-#[export] Hint Resolve listrep_local_facts : saturate_local.
+
 
 Lemma listrep_valid_pointer:
   forall sh contents p,
-   sepalg.nonidentity sh ->
-   listrep sh contents p |-- valid_pointer p.
+  sepalg.nonidentity sh ->
+   listrep sh contents p ⊢ valid_pointer p.
 Proof.
  destruct contents; unfold listrep; fold listrep; intros; Intros; subst.
  auto with valid_pointer.
  Intros y.
  apply sepcon_valid_pointer1.
  apply data_at_valid_ptr; auto.
- simpl;  computable.
+ simpl; computable.
 Qed.
 
-#[export] Hint Resolve listrep_valid_pointer : valid_pointer.
-
 Lemma listrep_null: forall sh contents,
-    listrep sh contents nullval = !! (contents=nil) && emp.
+    listrep sh contents nullval ⊣⊢ ⌜contents=nil⌝ ∧ emp.
 Proof.
 destruct contents; unfold listrep; fold listrep.
 autorewrite with norm. auto.
-apply pred_ext.
-Intros y. entailer. destruct H; contradiction.
+apply bi.equiv_entails_2.
+Intros y. entailer!. destruct H; contradiction.
 Intros. discriminate.
 Qed.
 
@@ -73,46 +87,48 @@ Definition append_spec :=
      PARAMS (x; y) GLOBALS()
      SEP (listrep sh s1 x; listrep sh s2 y)
   POST [ tptr t_struct_list ]
-    EX r: val,
+    ∃ r: val,
      PROP()
      RETURN (r)
      SEP (listrep sh (s1++s2) r).
 
 Definition Gprog : funspecs :=   ltac:(with_library prog [ append_spec ]).
 
-Module Proof1.
+Hint Resolve listrep_local_facts : saturate_local.
+Hint Extern 1 (listrep _ _ _ ⊢ valid_pointer _) =>
+    (simple apply listrep_valid_pointer; now auto) : valid_pointer.
 
-Definition lseg (sh: share) (contents: list val) (x z: val) : mpred :=
-  ALL cts2:list val, listrep sh cts2 z -* listrep sh (contents++cts2) x.
+Section Proof1.
 
 Lemma body_append: semax_body Vprog Gprog f_append append_spec.
 Proof.
 start_function.
 forward_if.
 *
- subst x. rewrite listrep_null.  Intros.  subst.
+ subst x.
  forward.
+ rewrite listrep_null. Intros; subst.
  Exists y.
  entailer!!.
  simpl; auto.
 *
  forward.
  destruct s1 as [ | v s1']; unfold listrep at 1; fold listrep.
- Intros.  contradiction.
+ { Intros. contradiction. }
  Intros u.
  remember (v::s1') as s1.
  forward.
  forward_while
-      ( EX a: val, EX s1b: list val, EX t: val, EX u: val,
+      (∃ a: val, ∃ s1b: list val, ∃ t: val, ∃ u: val,
             PROP ()
             LOCAL (temp _x x; temp _t t; temp _u u; temp _y y)
-            SEP (listrep sh (a::s1b++s2) t -* listrep sh (s1++s2) x;
+            SEP (listrep sh (a::s1b++s2) t -∗ listrep sh (s1++s2) x;
                    data_at sh t_struct_list (a,u) t;
                    listrep sh s1b u;
                    listrep sh s2 y))%assert.
 + (* current assertion implies loop invariant *)
    Exists v s1' x u.
-   subst s1. entailer!!. simpl. cancel_wand.
+   entailer!. simpl. cancel_wand.
 + (* loop test is safe to execute *)
    entailer!!.
 + (* loop body preserves invariant *)
@@ -124,14 +140,13 @@ forward_if.
    Exists (v,s1b,u0,z). unfold fst, snd.
    simpl app.
    entailer!!.
-   rewrite sepcon_comm.
-   apply RAMIF_PLAIN.trans''.
-   apply wand_sepcon_adjoint.
-   forget (v::s1b++s2) as s3.
-   unfold listrep; fold listrep; Exists u0; auto.
+   iIntros "[Ha Hb]". iIntros.
+   iApply "Ha".
+   unfold listrep; fold listrep. iExists u0; iFrame.
 + (* after the loop *)
    clear v s1' Heqs1.
    forward.
+   simpl. (* TODO this simpl wasn't needed. maybe store_tac_no_hint in forward1 is broken? *)
    forward.
    rewrite (proj1 H2 (eq_refl _)).
    Exists x.
@@ -139,28 +154,26 @@ forward_if.
    clear.
    entailer!!.
    unfold listrep at 3; fold listrep. Intros.
-   pull_right (listrep sh (a :: s2) t -* listrep sh (s1 ++ s2) x).
-   apply modus_ponens_wand'.
-   unfold listrep at 2; fold listrep. Exists y; cancel.
+   iIntros "(Ha & Hb & Hc & Hd)".
+   iApply "Ha".
+   unfold listrep at -1; fold listrep. iExists y; iFrame.
 Qed.
 
 End Proof1.
 
-Module Proof2.
+Section Proof2.
 
 Definition lseg (sh: share) (contents: list val) (x z: val) : mpred :=
-  ALL cts2:list val, listrep sh cts2 z -* listrep sh (contents++cts2) x.
+  ∀ cts2:list val, listrep sh cts2 z -∗ listrep sh (contents++cts2) x.
 
-Lemma body_append: semax_body Vprog Gprog f_append append_spec.
+Lemma body_append2: semax_body Vprog Gprog f_append append_spec.
 Proof.
 start_function.
 forward_if.
 *
- subst x. rewrite listrep_null. Intros; subst. 
+ subst x. rewrite listrep_null. Intros; subst.
  forward.
- Exists y.
- entailer!!.
- simpl; auto.
+ Exists y; simpl; entailer!.
 *
  forward.
  destruct s1 as [ | v s1']; unfold listrep; fold listrep. Intros; contradiction.
@@ -168,7 +181,7 @@ forward_if.
  remember (v::s1') as s1.
  forward.
  forward_while
-      (EX s1a: list val,  EX a: val, EX s1b: list val, EX t: val, EX u: val,
+      (∃ s1a: list val, ∃ a: val, ∃ s1b: list val, ∃ t: val, ∃ u: val,
             PROP (s1 = s1a ++ a :: s1b)
             LOCAL (temp _x x; temp _t t; temp _u u; temp _y y)
             SEP (lseg sh s1a x t;
@@ -177,7 +190,7 @@ forward_if.
                    listrep sh s2 y))%assert.
 + (* current assertion implies loop invariant *)
    Exists (@nil val) v s1' x u.  entailer!!.
-   unfold lseg. apply allp_right; intro. simpl. cancel_wand.
+   unfold lseg. iIntros. simpl. auto.
 + (* loop test is safe to execute *)
    entailer!!.
 + (* loop body preserves invariant *)
@@ -190,122 +203,114 @@ forward_if.
    rewrite <- !app_assoc. simpl app.
    entailer!!.
    unfold lseg.
-   rewrite sepcon_comm.
+   rewrite bi.sep_comm.
    clear.
-   apply RAMIF_Q.trans'' with (cons a).
-   extensionality cts; simpl; rewrite <- app_assoc; reflexivity.
-   apply allp_right; intro. apply wand_sepcon_adjoint.
-   unfold listrep at 2; fold listrep; Exists u0.  apply derives_refl.
+   iIntros "[H1 H2]".
+   iIntros (cts2) "H3".
+   iSpecialize ("H2" $! (a :: cts2)).
+   rewrite -app_assoc.
+   iApply ("H2").
+   unfold listrep at -1; fold listrep. iExists u0. iFrame.
  + (* after the loop *)
-   forward. forward.
+   forward. simpl. forward.
    Exists x. entailer!!.
    destruct H3 as [? _]. specialize (H3 (eq_refl _)). subst s1b.
    unfold listrep at 1.  Intros. autorewrite with norm.  rewrite H0. rewrite <- app_assoc. simpl app.
    unfold lseg.
-   rewrite sepcon_assoc.
-   eapply derives_trans; [apply allp_sepcon1 | ]. apply allp_left with (a::s2).
-   rewrite sepcon_comm.
-   eapply derives_trans; [ | apply modus_ponens_wand].
-   apply sepcon_derives; [ | apply derives_refl].
-   unfold listrep at 2; fold listrep. Exists y; auto.
+   iIntros "(H1 & H2 & H3)".
+   iApply ("H1" $! (a :: s2)).
+   unfold listrep at 2; fold listrep. iExists y; iFrame.
 Qed.
 
 End Proof2.
 
-Module Proof3.  (*************** inductive lseg *******************)
+Section Proof3.  (*************** inductive lseg *******************)
 
-Fixpoint lseg (sh: share)
+Fixpoint lseg2 (sh: share)
             (contents: list val) (x z: val) : mpred :=
  match contents with
- | h::hs => !! (x<>z) && 
-              EX y:val,
-                data_at sh t_struct_list (h,y) x * lseg sh hs y z
- | nil => !! (x = z /\ is_pointer_or_null x) && emp
+ | h::hs => ⌜x<>z⌝ ∧ 
+              ∃ y:val,
+                data_at sh t_struct_list (h,y) x ∗ lseg2 sh hs y z
+ | nil => ⌜x = z /\ is_pointer_or_null x⌝ ∧ emp
  end.
 
-Arguments lseg sh contents x z : simpl never.
+Arguments lseg2 sh contents x z : simpl never.
+Notation lseg := lseg2.
 
 Lemma lseg_local_facts:
   forall sh contents p q,
-     lseg sh contents p q |--
-     !! (is_pointer_or_null p /\ is_pointer_or_null q /\ (p=q <-> contents=nil)).
+     lseg sh contents p q ⊢
+     ⌜is_pointer_or_null p /\ is_pointer_or_null q /\ (p=q <-> contents=nil)⌝.
 Proof.
 intros.
-apply derives_trans with (lseg sh contents p q && !! (is_pointer_or_null p /\
-        is_pointer_or_null q /\ (p = q <-> contents = []))).
-2: entailer!.
 revert p; induction contents; intros; simpl; unfold lseg; fold lseg.
+{ normalize. }
+Intros y.
 entailer!.
-intuition.
-Intros y. Exists y.
-eapply derives_trans.
-apply sepcon_derives.
-apply derives_refl.
-apply IHcontents.
-entailer!.
-intuition congruence.
+intuition discriminate.
 Qed.
 
-#[export] Hint Resolve lseg_local_facts : saturate_local.
+Hint Resolve lseg_local_facts : saturate_local.
 
 Lemma lseg_valid_pointer:
   forall sh contents p ,
    sepalg.nonidentity sh ->
-   lseg sh contents p nullval |-- valid_pointer p.
+   lseg sh contents p nullval ⊢ valid_pointer p.
 Proof.
  destruct contents; unfold lseg; fold lseg; intros. entailer!.
  Intros *.
  auto with valid_pointer.
 Qed.
 
-#[export] Hint Resolve lseg_valid_pointer : valid_pointer.
+Hint Extern 1 (lseg _ _ _ nullval ⊢ valid_pointer _) =>
+    (simple apply lseg_valid_pointer; now auto) : valid_pointer.
 
 Lemma lseg_eq: forall sh contents x,
-    lseg sh contents x x = !! (contents=nil /\ is_pointer_or_null x) && emp.
+    lseg sh contents x x ⊣⊢ ⌜contents=nil /\ is_pointer_or_null x⌝ ∧ emp.
 Proof.
 intros.
 destruct contents; unfold lseg; fold lseg.
-f_equal. f_equal. f_equal. apply prop_ext; intuition.
-apply pred_ext.
-Intros y. contradiction.
-Intros. discriminate.
+- apply and_mono_iff; auto. apply bi.pure_iff. intuition.
+- iSplit. 
+  + iIntros "[%H1 H2]". contradiction.
+  + iIntros "[%H1 H2]". destruct H1. discriminate.
 Qed.
 
 Lemma lseg_null: forall sh contents,
-    lseg sh contents nullval nullval = !! (contents=nil) && emp.
+    lseg sh contents nullval nullval ⊣⊢ ⌜contents=nil⌝ ∧ emp.
 Proof.
 intros.
  rewrite lseg_eq.
- apply pred_ext.
- entailer!.
- entailer!.
+ apply and_mono_iff; auto.
+ apply bi.pure_iff; intuition.
 Qed.
 
-Lemma lseg_cons: forall sh (v u x: val) s,
+Lemma lseg_cons: forall sh (v u x: val) (s: list val),
    readable_share sh ->
- data_at sh t_struct_list (v, u) x * lseg sh s u nullval
- |-- lseg sh [v] x u * lseg sh s u nullval.
+ data_at sh t_struct_list (v, u) x ∗ lseg sh s u nullval
+ ⊢ lseg sh [v] x u ∗ lseg sh s u nullval.
 Proof.
 intros.
-     unfold lseg at 2. Exists u. 
+     unfold lseg at 2. Exists u.
      entailer.
      destruct s; unfold lseg at 1; fold lseg; entailer.
 Qed.
 
-Lemma lseg_cons': forall sh (v u x a b: val) ,
+Lemma lseg_cons': forall sh (v u x a b: val),
    readable_share sh ->
- data_at sh t_struct_list (v, u) x * data_at sh t_struct_list (a,b) u
- |-- lseg sh [v] x u * data_at sh t_struct_list (a,b) u.
+ data_at sh t_struct_list (v, u) x ∗ data_at sh t_struct_list (a,b) u
+ ⊢ lseg sh [v] x u ∗ data_at sh t_struct_list (a,b) u.
 Proof.
 intros.
-     unfold lseg. Exists u. 
+     unfold lseg. Exists u.
      entailer!.
 Qed.
 
 Lemma lseg_app': forall sh s1 s2 (a w x y z: val),
    readable_share sh ->
-   lseg sh s1 w x * lseg sh s2 x y * data_at sh t_struct_list (a,z) y |--
-   lseg sh (s1++s2) w y * data_at sh t_struct_list (a,z) y.
+   (lseg sh s1 w x ∗ lseg sh s2 x y) ∗ data_at sh t_struct_list (a,z) y ⊢
+   lseg sh (s1++s2) w y ∗ data_at sh t_struct_list (a,z) y.
 Proof.
  intros.
  revert w; induction s1; intro; simpl.
@@ -313,12 +318,12 @@ Proof.
  unfold lseg at 1 3; fold lseg. Intros j; Exists j.
  entailer.
  sep_apply (IHs1 j).
- cancel. 
+ cancel.
 Qed.
-
+ 
 Lemma lseg_app_null: forall sh s1 s2 (w x: val),
    readable_share sh ->
-   lseg sh s1 w x * lseg sh s2 x nullval |--
+   lseg sh s1 w x ∗ lseg sh s2 x nullval ⊢
    lseg sh (s1++s2) w nullval.
 Proof.
  intros.
@@ -332,38 +337,36 @@ Qed.
 
 Lemma lseg_app: forall sh s1 s2 a s3 (w x y z: val),
    readable_share sh ->
-   lseg sh s1 w x * lseg sh s2 x y * lseg sh (a::s3) y z |--
-   lseg sh (s1++s2) w y * lseg sh (a::s3) y z.
+   lseg sh s1 w x ∗ lseg sh s2 x y ∗ lseg sh (a::s3) y z ⊢
+   lseg sh (s1++s2) w y ∗ lseg sh (a::s3) y z.
 Proof.
  intros.
  unfold lseg at 3 5; fold lseg.
- Intros u; Exists u. rewrite prop_true_andp by auto.
+ Intros u; Exists u. rewrite prop_true_andp //.
  sep_apply (lseg_app' sh s1 s2 a w x y u); auto.
  cancel.
 Qed.
 
 Lemma listrep_lseg_null :
- listrep = fun sh s p => lseg sh s p nullval.
+ ∀ sh s p, listrep sh s p ⊣⊢ lseg sh s p nullval.
 Proof.
-extensionality sh s p.
+intros.
 revert p.
 induction s; intros.
-unfold lseg, listrep; apply pred_ext; entailer!.
+unfold lseg, listrep; apply bi.equiv_entails_2; entailer!.
 unfold lseg, listrep; fold lseg; fold listrep.
-apply pred_ext; Intros y; Exists y; rewrite IHs; entailer!.
+apply bi.equiv_entails_2; Intros y; Exists y; rewrite IHs; entailer!.
 Qed.
 
-Lemma body_append: semax_body Vprog Gprog f_append append_spec.
+Lemma body_append3: semax_body Vprog Gprog f_append append_spec.
 Proof.
 start_function.
-revert POSTCONDITION; rewrite listrep_lseg_null; intro.
+rewrite -> listrep_lseg_null in * |- *.
 forward_if.
 *
  subst x. rewrite lseg_null. Intros. subst.
  forward.
- Exists y.
- entailer!!.
- simpl; auto.
+ Exists y; simpl; entailer!.
 *
  forward.
  destruct s1 as [ | v s1']; unfold lseg at 1; fold lseg.
@@ -373,7 +376,7 @@ forward_if.
  remember (v::s1') as s1.
  forward.
  forward_while
-      (EX s1a: list val, EX a: val, EX s1b: list val, EX t: val, EX u: val,
+      (∃ s1a: list val, ∃ a: val, ∃ s1b: list val, ∃ t: val, ∃ u: val,
             PROP (s1 = s1a ++ a :: s1b)
             LOCAL (temp _x x; temp _t t; temp _u u; temp _y y)
             SEP (lseg sh s1a x t; 
@@ -382,7 +385,7 @@ forward_if.
                    lseg sh s2 y nullval))%assert.
  + (* current assertion implies loop invariant *)
      Exists (@nil val) v s1' x u.
-     subst s1. rewrite lseg_eq.
+     subst s1. rewrite lseg_eq listrep_lseg_null.
      entailer.
 (*     sep_apply (lseg_cons sh v u x s1'); auto. *)
  + (* loop test is safe to execute *)
@@ -404,13 +407,14 @@ forward_if.
     subst. rewrite lseg_eq. Intros. subst. 
     forward.
     forward.
-    Exists x. 
+    Exists x.
     entailer!!.
     sep_apply (lseg_cons sh a y t s2); auto.
     sep_apply (lseg_app_null sh [a] s2 t y); auto.
     rewrite <- app_assoc.
     sep_apply (lseg_app_null sh s1a ([a]++s2) x t); auto.
+    rewrite listrep_lseg_null //.
 Qed.
 
 End Proof3.
-
+End Spec.
diff --git a/progs64/verif_bin_search.v b/progs64/verif_bin_search.v
index 6ca00558f3..6db647800e 100644
--- a/progs64/verif_bin_search.v
+++ b/progs64/verif_bin_search.v
@@ -1,5 +1,6 @@
 (* Do not edit this file, it was generated automatically *)
 Require Import VST.floyd.proofauto. (* Import the Verifiable C system *)
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs64.bin_search. (* Import the AST of this C program *)
 
 (* The next line is "boilerplate", always required after importing an AST. *)
@@ -78,7 +79,7 @@ Proof.
   rewrite firstn_nil, skipn_nil; auto.
 Qed.
 
-Fixpoint sorted2 l :=
+Fixpoint sorted2 l : Prop :=
   match l with
   | [] => True
   | x :: rest => Forall (fun y => x <= y) rest /\ sorted2 rest
@@ -261,7 +262,7 @@ Qed.
 (* Contents of the extern global initialized array "_four" *)
 Definition four_contents := [1; 2; 3; 4].
 
-Lemma body_main:  semax_body Vprog Gprog f_main main_spec.
+Lemma body_main: semax_body Vprog Gprog f_main main_spec.
 Proof.
   start_function.
   forward_call (gv _four,Ews,four_contents,3,0,4).
@@ -271,8 +272,6 @@ Proof.
   Intro r; forward.
 Qed.
 
-#[export] Existing Instance NullExtension.Espec.
-
 Lemma prog_correct:
   semax_prog prog tt Vprog Gprog.
 Proof.
diff --git a/progs64/verif_bst.v b/progs64/verif_bst.v
index 4a9ac3dad5..f1992c4e91 100644
--- a/progs64/verif_bst.v
+++ b/progs64/verif_bst.v
@@ -1,5 +1,5 @@
 (* Do not edit this file, it was generated automatically *)
-Require Import VST.floyd.proofauto.
+Require Import VST.floyd.proofauto VST.floyd.compat. Import NoOracle.
 Require Import VST.progs64.bst.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
@@ -71,7 +71,7 @@ Definition treebox_rep (t: tree val) (b: val) :=
 
 (* TODO: seems not useful *)
 Lemma treebox_rep_spec: forall (t: tree val) (b: val),
-  treebox_rep t b =
+  treebox_rep t b ⊣⊢
   EX p: val, 
   match t with
   | E => !!(p=nullval) && data_at Tsh (tptr t_struct_tree) p b
@@ -86,20 +86,19 @@ Lemma treebox_rep_spec: forall (t: tree val) (b: val),
 Proof.
   intros.
   unfold treebox_rep at 1.
-  f_equal.
-  extensionality p.
+  f_equiv; intros p.
   destruct t; simpl.
   + apply pred_ext; entailer!!.
   + unfold treebox_rep.
     apply pred_ext; entailer!!.
     - Intros pa pb.
-      Exists pb pa.
+      Exists pa pb.
       unfold_data_at (data_at _ _ _ p).
       rewrite (field_at_data_at _ t_struct_tree [StructField _left]).
       rewrite (field_at_data_at _ t_struct_tree [StructField _right]).
       cancel.
     - Intros pa pb.
-      Exists pb pa.
+      Exists pa pb.
       unfold_data_at (data_at _ _ _ p).
       rewrite (field_at_data_at _ t_struct_tree [StructField _left]).
       rewrite (field_at_data_at _ t_struct_tree [StructField _right]).
@@ -271,23 +270,12 @@ Qed.
 
 #[export] Hint Resolve treebox_rep_saturate_local: saturate_local.
 
-Definition insert_inv (b0: val) (t0: tree val) (x: Z) (v: val): environ -> mpred :=
+Definition insert_inv (b0: val) (t0: tree val) (x: Z) (v: val): assert :=
   EX b: val, EX t: tree val,
   PROP()
   LOCAL(temp _t b; temp _x (Vint (Int.repr x));   temp _value v)
   SEP(treebox_rep t b;  (treebox_rep (insert x v t) b -* treebox_rep (insert x v t0) b0)).
 
-Open Scope logic.
-
-Lemma ramify_PPQQ {A: Type} {NA: NatDed A} {SA: SepLog A} {CA: ClassicalSep A}: forall P Q,
-  P |-- P * (Q -* Q).
-Proof.
-  intros.
-  apply RAMIF_PLAIN.solve with emp.
-  + rewrite sepcon_emp; auto.
-  + rewrite emp_sepcon; auto.
-Qed.
-
 Lemma tree_rep_nullval: forall t,
   tree_rep t nullval |-- !! (t = E).
 Proof.
@@ -324,17 +312,18 @@ Proof.
   rewrite (field_at_data_at _ t_struct_tree [StructField _left]).
   unfold treebox_rep at 1. Exists p1. cancel.
 
-  rewrite <- wand_sepcon_adjoint.
+  iIntros "(? & ? & ? & ?) Hleft".
   clear p1.
   unfold treebox_rep.
-  Exists p.
+  iExists p.
   simpl.
-  Intros p1.
-  Exists p1 p2.
-  entailer!!.
+  iDestruct "Hleft" as (p1) "(? & ?)".
+  iFrame.
+  iSplit; first done.
+  iExists p2.
   unfold_data_at (data_at _ _ _ p).
   rewrite (field_at_data_at _ t_struct_tree [StructField _left]).
-  cancel.
+  iStopProof; cancel.
 Qed.
 
 Lemma bst_right_entail: forall (t1 t2 t2': tree val) k (v p1 p2 p b: val),
@@ -353,26 +342,18 @@ Proof.
   rewrite (field_at_data_at _ t_struct_tree [StructField _right]).
   unfold treebox_rep at 1. Exists p2. cancel.
 
-  rewrite <- wand_sepcon_adjoint.
+  iIntros "(? & ? & ? & ?) Hright".
   clear p2.
   unfold treebox_rep.
-  Exists p.
+  iExists p.
   simpl.
-  Intros p2.
-  Exists p1 p2.
-  entailer!!.
+  iDestruct "Hright" as (p2) "(? & ?)".
+  iFrame.
+  iSplit; first done.
+  iExists p1.
   unfold_data_at (data_at _ _ _ p).
   rewrite (field_at_data_at _ t_struct_tree [StructField _right]).
-  cancel.
-Qed.
-
-Lemma modus_ponens_wand' {A}{ND: NatDed A}{SL: SepLog A}:
-  forall P Q R: A, (P |-- Q) -> P * (Q -* R) |-- R.
-Proof.
-  intros.
-  eapply derives_trans; [| apply modus_ponens_wand].
-  apply sepcon_derives; [| apply derives_refl].
-  auto.
+  iStopProof; cancel.
 Qed.
 
 Lemma if_trueb: forall {A: Type} b (a1 a2: A), b = true -> (if b then a1 else a2) = a1.
@@ -388,11 +369,11 @@ Lemma body_insert: semax_body Vprog Gprog f_insert insert_spec.
 Proof.
   start_function.
   eapply semax_pre; [
-    | apply (semax_loop _ (insert_inv b t x v) (insert_inv b t x v) )].
+    | apply (semax_loop _ _ (insert_inv b t x v) (insert_inv b t x v) )].
   * (* Precondition *)
     unfold insert_inv.
     Exists b t. entailer.
-    apply ramify_PPQQ.
+    iIntros "$ $".
   * (* Loop body *)
     unfold insert_inv at 1.
     Intros b1 t1.
@@ -413,8 +394,8 @@ Proof.
       subst t1. simpl tree_rep. rewrite !prop_true_andp by auto.
       forward. (* *t = p; *)
       forward. (* return; *)
-      apply modus_ponens_wand'.
-      apply treebox_rep_leaf; auto.
+      iIntros "(? & ? & H)"; iApply "H".
+      by iApply (treebox_rep_leaf with "[$]").
     + (* else clause *)
       destruct t1.
         { simpl tree_rep. Intros. contradiction. }
@@ -428,28 +409,18 @@ Proof.
         Exists (field_address t_struct_tree [StructField _left] p) t1_1.
         entailer!. simpl.
         simpl_compb.
-        (* TODO: SIMPLY THIS LINE 
-        replace (offset_val 8 p1)
-          with (field_address t_struct_tree [StructField _left] p1)
-          by (unfold field_address; simpl;
-              rewrite if_true by auto with field_compatible; auto).
-*)
-        apply RAMIF_PLAIN.trans'.
-        apply bst_left_entail; auto.
+        sep_apply (bst_left_entail t1_1 (insert x v t1_1)).
+        iIntros "(($ & H1) & Ht) ?".
+        iApply "Ht"; iApply "H1"; done.
       - (* Inner if, second branch:  k<x *)
         forward. (* t=&p->right *)
         unfold insert_inv.
         Exists (field_address t_struct_tree [StructField _right] p) t1_2.
         entailer!. simpl.
         simpl_compb; simpl_compb.
-        (* TODO: SIMPLY THIS LINE 
-        replace (offset_val 12 p1)
-          with (field_address t_struct_tree [StructField _right] p1)
-          by (unfold field_address; simpl;
-              rewrite if_true by auto with field_compatible; auto).
-*)
-        apply RAMIF_PLAIN.trans'.
-        apply bst_right_entail; auto.
+        sep_apply (bst_right_entail t1_1 t1_2 (insert x v t1_2)).
+        iIntros "(($ & H1) & Ht) ?".
+        iApply "Ht"; iApply "H1"; done.
       - (* Inner if, third branch: x=k *)
         assert (x=k) by lia.
         subst x.  clear H H1 H3.
@@ -458,15 +429,15 @@ Proof.
         (* TODO: SIMPLY THIS LINE *)
         simpl_compb.
         simpl_compb.
-        apply modus_ponens_wand'.
+        iIntros "(? & ? & ? & ? & H)"; iApply "H"; iStopProof.
         unfold treebox_rep. Exists p.
         simpl tree_rep. Exists pa pb. entailer!!.
   * (* After the loop *)
     forward.
-    apply andp_left2. auto.
+    auto.
 Qed.
 
-Definition lookup_inv (b0 p0: val) (t0: tree val) (x: Z): environ -> mpred :=
+Definition lookup_inv (b0 p0: val) (t0: tree val) (x: Z): assert :=
   EX p: val, EX t: tree val, 
   PROP(lookup nullval x t = lookup nullval x t0) 
   LOCAL(temp _p p; temp _x (Vint (Int.repr x)))
@@ -484,7 +455,7 @@ Proof.
   forward_while (lookup_inv b p t x).
   * (* precondition implies loop invariant *)
     Exists p t. entailer!.
-    apply -> wand_sepcon_adjoint. cancel.
+    auto.
   * (* type-check loop condition *)
     entailer!.
   * (* loop body preserves invariant *)
@@ -498,9 +469,7 @@ Proof.
       entailer!!.
       - rewrite <- H0; simpl.
         simpl_compb; auto.
-      - (* TODO: merge the following 2 lines *)
-        apply RAMIF_PLAIN.trans''.
-        apply -> wand_sepcon_adjoint.
+      - iIntros "(? & ? & H) ?"; iApply "H"; iStopProof.
         simpl. Exists pa pb; entailer!.
     + (* else-then clause: y<x *)
       forward. (* p=p<-right *)
@@ -508,9 +477,7 @@ Proof.
       entailer!!.
       - rewrite <- H0; simpl.
         simpl_compb; simpl_compb; auto.
-      - (* TODO: merge the following 2 lines *)
-        apply RAMIF_PLAIN.trans''.
-        apply -> wand_sepcon_adjoint.
+      - iIntros "(? & ? & H) ?"; iApply "H"; iStopProof.
         simpl. Exists pa pb; entailer!.
     + (* else-else clause: x=y *)
       assert (x=k) by lia. subst x. clear H H3 H4.
@@ -519,13 +486,12 @@ Proof.
       entailer!!.
       - rewrite <- H0. simpl.
         simpl_compb; simpl_compb; auto.
-      - (* TODO: merge the following 2 lines *)
-        apply modus_ponens_wand'.
+      - iIntros "(? & ? & ? & H)"; iApply "H"; iStopProof.
         Exists pa pb; entailer!!.
   * (* after the loop *)
     forward. (* return NULL; *)
     entailer!.
-    apply modus_ponens_wand.
+    iIntros "(? & H)"; iApply "H"; done.
 Qed.
 
 Lemma body_turn_left: semax_body Vprog Gprog f_turn_left turn_left_spec.
@@ -544,7 +510,7 @@ Proof.
   entailer!!.
 Qed.
 
-Definition pushdown_left_inv (b_res: val) (t_res: tree val): environ -> mpred :=
+Definition pushdown_left_inv (b_res: val) (t_res: tree val): assert :=
   EX b: val, EX ta: tree val, EX x: Z, EX v: val, EX tb: tree val,
   PROP  () 
   LOCAL (temp _t b)
@@ -552,7 +518,7 @@ Definition pushdown_left_inv (b_res: val) (t_res: tree val): environ -> mpred :=
          (treebox_rep (pushdown_left ta tb) b -* treebox_rep t_res b_res)).
 
 Lemma cancel_emp_spacer:
-  forall sh x y p, x=y -> 
+  forall sh x y p, x=y ->
     emp |-- spacer sh x y p.
 Proof.
 intros.
@@ -575,16 +541,16 @@ Lemma body_pushdown_left: semax_body Vprog Gprog f_pushdown_left pushdown_left_s
 Proof.
   start_function.
   eapply semax_pre; [
-    | apply (semax_loop _ (pushdown_left_inv b (pushdown_left ta tb))
+    | apply (semax_loop _ _ (pushdown_left_inv b (pushdown_left ta tb))
                          (pushdown_left_inv b (pushdown_left ta tb)))].
   + (* Precondition *)
     unfold pushdown_left_inv.
     Exists b ta x v tb.
     entailer!!.
-    eapply derives_trans; [| apply ramify_PPQQ].
     rewrite (treebox_rep_spec (T ta x v tb)).
     Exists p.
     entailer!!.
+    auto.
   + (* Loop body *)
     unfold pushdown_left_inv.
     clear x v H H0.
@@ -593,8 +559,6 @@ Proof.
     Intros p0.
     forward. (* skip *)
     forward. (* p = *t; *)
-      (* TODO entailer: The following should be solve automatically. satuate local does not work *)
- (*     1: rewrite (add_andp _ _ (tree_rep_saturate_local _ _)); entailer!. *)
     simpl tree_rep.
     Intros pa pbc.
     forward. (* q = p->right *)
@@ -612,8 +576,8 @@ Proof.
       }
       forward. (* return *)
       simpl.
-      apply modus_ponens_wand'.
-      Exists pa.
+      iIntros "(? & ? & ? & H)"; iApply "H"; iStopProof.
+      unfold treebox_rep; Exists pa.
       entailer!!.
     - destruct tbc0 as [| tb0 y vy tc0].
         { simpl tree_rep. Intros; contradiction. }
@@ -623,14 +587,14 @@ Proof.
       Exists (field_address t_struct_tree [StructField _left] pbc) ta0 x vx tb0.
       (* TODO entailer: not to simply too much in entailer? *)
       Opaque tree_rep. entailer!. Transparent tree_rep.
-        (* TODO: simplify this line *)
-      apply RAMIF_PLAIN.trans'.
-      apply bst_left_entail; auto.
+      sep_apply (bst_left_entail (T ta0 x vx tb0) (pushdown_left ta0 tb0)).
+      iIntros "(($ & H1) & Ht) ?".
+      iApply "Ht"; iApply "H1"; done.
   + forward. (* Sskip *)
-    apply andp_left2; auto.
+    auto.
 Qed.
 
-Definition delete_inv (b0: val) (t0: tree val) (x: Z): environ -> mpred :=
+Definition delete_inv (b0: val) (t0: tree val) (x: Z): assert :=
   EX b: val, EX t: tree val,
   PROP()
   LOCAL(temp _t b; temp _x (Vint (Int.repr x)))
@@ -640,11 +604,11 @@ Lemma body_delete: semax_body Vprog Gprog f_delete delete_spec.
 Proof.
   start_function.
   eapply semax_pre; [
-    | apply (semax_loop _ (delete_inv b t x) (delete_inv b t x) )].
+    | apply (semax_loop _ _ (delete_inv b t x) (delete_inv b t x) )].
   * (* Precondition *)
     unfold delete_inv.
     Exists b t. entailer.
-    apply ramify_PPQQ.
+    iIntros "$ $".
   * (* Loop body *)
     unfold delete_inv.
     Intros b1 t1.
@@ -658,7 +622,7 @@ Proof.
       subst t1. simpl tree_rep. rewrite !prop_true_andp by auto.
       forward. (* return; *)
       unfold treebox_rep at 1.
-      apply modus_ponens_wand'.
+      iIntros "(? & H)"; iApply "H"; iStopProof.
       Exists nullval.
       simpl tree_rep.
       entailer!!.
@@ -675,28 +639,16 @@ Proof.
         Exists (field_address t_struct_tree [StructField _left] p1) t1_1.
         entailer!. simpl.
         simpl_compb.
-        (* TODO: SIMPLY THIS LINE 
-        replace (offset_val 8 p1)
-          with (field_address t_struct_tree [StructField _left] p1)
-          by (unfold field_address; simpl;
-              rewrite if_true by auto with field_compatible; auto).
-*)
-        apply RAMIF_PLAIN.trans'.
-        apply bst_left_entail; auto.
+        sep_apply (bst_left_entail t1_1 (delete x t1_1)).
+        iIntros "(($ & H1) & Ht) ?"; iApply "Ht"; iApply "H1"; done.
       - (* Inner if, second branch:  k<x *)
         forward. (* t=&p->right *)
         unfold delete_inv.
         Exists (field_address t_struct_tree [StructField _right] p1) t1_2.
         entailer!. simpl.
         simpl_compb; simpl_compb.
-        (* TODO: SIMPLY THIS LINE 
-        replace (offset_val 12 p1)
-          with (field_address t_struct_tree [StructField _right] p1)
-          by (unfold field_address; simpl;
-              rewrite if_true by auto with field_compatible; auto).
-*)
-        apply RAMIF_PLAIN.trans'.
-        apply bst_right_entail; auto.
+        sep_apply (bst_right_entail t1_1 t1_2 (delete x t1_2)).
+        iIntros "(($ & H1) & Ht) ?"; iApply "Ht"; iApply "H1"; done.
       - (* Inner if, third branch: x=k *)
         assert (x=k) by lia.
         subst x.
@@ -726,10 +678,9 @@ Proof.
         simpl.
         simpl_compb.
         simpl_compb.
-        apply modus_ponens_wand'.
-        auto.
+        iIntros "(? & H)"; iApply "H"; done.
   * (* After the loop *)
-    forward. apply andp_left2; auto. 
+    forward. auto.
 Qed.
 
 Lemma body_treebox_new: semax_body Vprog Gprog f_treebox_new treebox_new_spec.
@@ -740,13 +691,13 @@ Proof.
   rewrite memory_block_data_at_ by auto.
   forward.
   forward.
-  Exists p. entailer!!.
+  Exists p; entailer!!.
 Qed.
 
 Lemma body_tree_free: semax_body Vprog Gprog f_tree_free tree_free_spec.
 Proof.
   start_function.
-  forward_if (PROP()LOCAL()SEP()).
+  forward_if.
   + destruct t; simpl tree_rep.
       1: Intros. contradiction.
     Intros pa pb.
@@ -764,7 +715,6 @@ Proof.
   + forward.
     subst.
     unfold tree_rep; entailer!.
-  + forward.
 Qed.
 
 Lemma body_treebox_free: semax_body Vprog Gprog f_treebox_free treebox_free_spec.
@@ -774,10 +724,10 @@ Proof.
   Intros p.
   forward.
   Time forward_call (t,p).
+  simpl.
   Time forward_call (b, sizeof (tptr t_struct_tree)).
-  entailer!.
-  rewrite memory_block_data_at_ by auto.
-  cancel.
+  saturate_local.
+  rewrite memory_block_data_at_ by auto; cancel.
   forward.
 Qed.
 
@@ -871,15 +821,17 @@ Lemma subsume_insert:
  funspec_sub (snd insert_spec) (snd abs_insert_spec).
 Proof.
 do_funspec_sub. destruct w as [[[b x] v] m]. simpl.
-unfold convertPre. Intros.
-destruct args. inv H1. 
+rewrite <- fupd_intro.
+Intros.
+destruct args. inv H1.
+destruct args. inv H1.
 destruct args. inv H1.
-destruct args. inv H1. 
 destruct args; inv H1. simpl in *.
 unfold env_set, eval_id in *. simpl in *. subst. 
 unfold tmap_rep.
 Intros t.
-Exists (b, x, v, t) emp. simpl. entailer!!.
+Exists (b, x, v, t) (emp : mpred). simpl.
+entailer!!.
 intros. Exists (insert x v t).
 entailer!!. apply insert_relate; trivial.
 Qed.
@@ -887,8 +839,10 @@ Qed.
 Lemma subsume_treebox_new:
  funspec_sub (snd treebox_new_spec) (snd abs_treebox_new_spec).
 Proof.
-do_funspec_sub. unfold convertPre. simpl; Intros.
-Exists emp. entailer!!.
+do_funspec_sub.
+rewrite <- fupd_intro.
+Intros.
+Exists (emp : mpred). entailer!!.
 intros tau ? ?. Exists (eval_id ret_temp tau). entailer!!.
 unfold tmap_rep.
 Exists (empty_tree val).
@@ -902,12 +856,14 @@ Qed.
 Lemma subsume_treebox_free:
  funspec_sub (snd treebox_free_spec) (snd abs_treebox_free_spec).
 Proof.
-do_funspec_sub. destruct w as [m p]. clear H. unfold convertPre. simpl; Intros.
+do_funspec_sub. destruct w as [m p]. clear H.
+rewrite <- fupd_intro.
+Intros.
 subst.
 unfold env_set, eval_id in *. simpl in *. 
 unfold tmap_rep.
 Intros t.
-Exists (t,p) emp. entailer!!.
+Exists (t,p) (emp : mpred). simpl. entailer!!.
 Qed.
 
 Lemma body_main: semax_body Vprog Gprog f_main main_spec.
@@ -926,7 +882,7 @@ forward_call subsume_insert (p, 1, gv ___stringlit_2, (t_update (t_empty nullval
 forward_call subsume_insert (p, 4, gv ___stringlit_3, (t_update
              (t_update (t_empty nullval) 3
                 (gv ___stringlit_1)) 1 (gv ___stringlit_2))).
-forward_call subsume_insert (p, 1, gv ___stringlit_4, 
+forward_call subsume_insert (p, 1, gv ___stringlit_4,
            (t_update
              (t_update
                 (t_update (t_empty nullval) 3
diff --git a/progs64/verif_field_loadstore.v b/progs64/verif_field_loadstore.v
index dc7cfe6ade..3c7280fec4 100644
--- a/progs64/verif_field_loadstore.v
+++ b/progs64/verif_field_loadstore.v
@@ -1,12 +1,11 @@
 (* Do not edit this file, it was generated automatically *)
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs64.field_loadstore.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
-Local Open Scope logic.
-
 Definition t_struct_b := Tstruct _b noattr.
 
 Definition sub_spec (sub_id: ident) :=
diff --git a/progs64/verif_float.v b/progs64/verif_float.v
index d6b1841bfe..0873aac071 100644
--- a/progs64/verif_float.v
+++ b/progs64/verif_float.v
@@ -1,12 +1,11 @@
 (* Do not edit this file, it was generated automatically *)
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs64.float.
 
 #[export] Instance CompSpecs : compspecs.
 Proof. make_compspecs prog. Defined.
 
-Local Open Scope logic.
-
 Definition main_spec :=
  DECLARE _main
   WITH gv: globals
diff --git a/progs64/verif_fptr_cmp.v b/progs64/verif_fptr_cmp.v
index 393de31e2a..a6496137b1 100644
--- a/progs64/verif_fptr_cmp.v
+++ b/progs64/verif_fptr_cmp.v
@@ -1,10 +1,11 @@
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs64.fptr_cmp.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
-Definition id_spec := 
+Definition id_spec :=
   DECLARE _id
   WITH x:Z
   PRE [tint] PROP () PARAMS (Vint (Int.repr x)) SEP ()
@@ -36,7 +37,7 @@ Definition test_fptr_spec (phi:funspec) :=
   DECLARE _test_fptr
   WITH f:val
   PRE [tptr (Tfunction (tint::nil) tint cc_default)] 
-      PROP () PARAMS (f) GLOBALS () SEP (func_ptr' phi f)
+      PROP () PARAMS (f) GLOBALS () SEP (func_ptr phi f)
   POST [tint] 
     PROP ()
     RETURN (Vint (Int.repr 1))
@@ -45,8 +46,8 @@ Definition test_fptr_spec (phi:funspec) :=
 Lemma verif_test_fptr phi: semax_body Vprog nil f_test_fptr (test_fptr_spec phi).
 Proof. start_function.
   forward_if.
-+ sep_apply func_ptr'_emp; forward.
-+ rewrite H. sep_apply func_ptr'_isptr. simpl; Intros. contradiction.
++ sep_apply func_ptr_emp; forward.
++ rewrite H. sep_apply func_ptr_isptr. simpl; Intros. contradiction.
 Qed.
 
 (*A little adhoc... *)
@@ -80,21 +81,21 @@ Proof. start_function.
   make_func_ptr _test_id2.
   unfold test_id1_spec. simpl.
   forward.
-  do 2 sep_apply func_ptr'_emp. simpl.
-  destruct (EqDec_val (gv _test_id1) (gv _test_id2)).
+  do 2 sep_apply func_ptr_emp. simpl.
+  destruct (eq_dec (gv _test_id1) (gv _test_id2)).
   - exfalso. apply (H _test_id1 _test_id2); trivial. intros N; inv N.
   - entailer!.
 Qed.
 
 Lemma verif_id: semax_body Vprog Gprog f_id id_spec.
-Proof. start_function. forward. Qed.  
+Proof. start_function. forward. Qed.
 
 Lemma verif_test_id1: semax_body Vprog Gprog f_test_id1 test_id1_spec.
 Proof. start_function.
   make_func_ptr _id.
   forward_if.
-+ sep_apply func_ptr'_emp; forward.
-+ rewrite H. sep_apply func_ptr'_isptr. simpl; Intros. contradiction.
++ sep_apply func_ptr_emp; forward.
++ rewrite H. sep_apply func_ptr_isptr. simpl; Intros. contradiction.
 Qed.
 
 Lemma verif_test_id2: semax_body Vprog Gprog f_test_id2 (_test_id2, snd test_id1_spec).
diff --git a/progs64/verif_global.v b/progs64/verif_global.v
index 34ba5bcece..bf34b9ceaa 100644
--- a/progs64/verif_global.v
+++ b/progs64/verif_global.v
@@ -1,5 +1,6 @@
 (* Do not edit this file, it was generated automatically *)
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs64.global.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
@@ -39,5 +40,3 @@ rewrite data_at_tuint_tint.
 forward_call gv.
 forward.
 Qed.
-
-
diff --git a/progs64/verif_incr.v b/progs64/verif_incr.v
index 40eff1de41..6b1a5d1e6a 100644
--- a/progs64/verif_incr.v
+++ b/progs64/verif_incr.v
@@ -1,127 +1,168 @@
 (* Do not edit this file, it was generated automatically *)
 Require Import VST.concurrency.conclib.
 Require Import VST.concurrency.lock_specs.
+Require Import VST.atomics.SC_atomics.
 Require Import VST.atomics.verif_lock.
-Require Import VST.concurrency.ghosts.
+Require Import iris_ora.algebra.ext_order.
+Require Import iris.algebra.lib.excl_auth.
 Require Import VST.progs64.incr.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
+Canonical Structure excl_authR A := inclR (excl_authR A).
+
+Section mpred.
+
+(* box up concurrentGS? *)
+Context `{!VSTGS unit Σ, !cinvG Σ, !inG Σ (excl_authR natO), !atomic_int_impl (Tstruct _atom_int noattr)}.
+#[local] Instance concurrent_ext_spec : ext_spec unit := concurrent_ext_spec _ (ext_link_prog prog).
+
 Definition spawn_spec := DECLARE _spawn spawn_spec.
 
 Definition t_counter := Tstruct _counter noattr.
 
-Definition cptr_lock_inv g1 g2 ctr := EX z : Z, field_at Ews t_counter [StructField _ctr] (Vint (Int.repr z)) ctr *
-  EX x : Z, EX y : Z, !!(z = x + y) && ghost_var gsh1 x g1 * ghost_var gsh1 y g2.
+Definition ghost_auth (g : gname) (n : nat) : mpred := own g (●E n : excl_authR natO).
+Definition ghost_frag (g : gname) (n : nat) : mpred := own g (◯E n : excl_authR natO).
+
+Definition cptr_lock_inv (g1 g2 : gname) (ctr : val) := ∃ z : nat, field_at Ews t_counter [StructField _ctr] (Vint (Int.repr z)) ctr ∗
+  ∃ x : nat, ∃ y : nat, ⌜(z = x + y)%nat⌝ ∧ ghost_auth g1 x ∗ ghost_auth g2 y.
 
 Definition incr_spec :=
  DECLARE _incr
-  WITH sh1 : share, sh : share, h : lock_handle, g1 : gname, g2 : gname, left : bool, n : Z, gv: globals
+  WITH sh1 : share, sh : Qp, h : lock_handle, g1 : gname, g2 : gname, left : bool, n : nat, gv: globals
   PRE [ ]
          PROP  (readable_share sh1)
          PARAMS () GLOBALS (gv)
-         SEP   (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c); lock_inv sh h (cptr_lock_inv g1 g2 (gv _c)); ghost_var gsh2 n (if left then g1 else g2))
+         SEP   (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c); lock_inv sh h (cptr_lock_inv g1 g2 (gv _c)); ghost_frag (if left then g1 else g2) n)
   POST [ tvoid ]
          PROP ()
          LOCAL ()
-         SEP (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c); lock_inv sh h (cptr_lock_inv g1 g2 (gv _c)); ghost_var gsh2 (n+1) (if left then g1 else g2)).
+         SEP (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c); lock_inv sh h (cptr_lock_inv g1 g2 (gv _c)); ghost_frag (if left then g1 else g2) (n+1)%nat).
 
 Definition read_spec :=
  DECLARE _read
-  WITH sh1 : share, sh : share, h : lock_handle, g1 : gname, g2 : gname, n1 : Z, n2 : Z, gv: globals
+  WITH sh1 : share, sh : Qp, h : lock_handle, g1 : gname, g2 : gname, n1 : nat, n2 : nat, gv: globals
   PRE [ ]
          PROP  (readable_share sh1)
          PARAMS () GLOBALS (gv)
-         SEP   (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c); lock_inv sh h (cptr_lock_inv g1 g2 (gv _c)); ghost_var gsh2 n1 g1; ghost_var gsh2 n2 g2)
+         SEP   (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c); lock_inv sh h (cptr_lock_inv g1 g2 (gv _c)); ghost_frag g1 n1; ghost_frag g2 n2)
   POST [ tuint ]
          PROP ()
-         RETURN (Vint (Int.repr (n1 + n2)))
-         SEP (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c); lock_inv sh h (cptr_lock_inv g1 g2 (gv _c)); ghost_var gsh2 n1 g1; ghost_var gsh2 n2 g2).
+         RETURN (Vint (Int.repr (n1 + n2)%nat))
+         SEP (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c); lock_inv sh h (cptr_lock_inv g1 g2 (gv _c)); ghost_frag g1 n1; ghost_frag g2 n2).
 
-Definition thread_lock_R sh1 sh h g1 g2 ctr :=
-  field_at sh1 t_counter [StructField _lock] (ptr_of h) ctr * lock_inv sh h (cptr_lock_inv g1 g2 ctr) * ghost_var gsh2 1 g1.
+Definition thread_lock_R sh1 (sh : Qp) h (g1 g2 : gname) (ctr : val) :=
+  field_at sh1 t_counter [StructField _lock] (ptr_of h) ctr ∗ lock_inv sh h (cptr_lock_inv g1 g2 ctr) ∗ ghost_frag g1 1.
 
 Definition thread_lock_inv sh1 sh h g1 g2 ctr ht :=
-  self_part sh ht * thread_lock_R sh1 sh h g1 g2 ctr.
+  self_part sh ht ∗ thread_lock_R sh1 sh h g1 g2 ctr.
 
 Definition thread_func_spec :=
  DECLARE _thread_func
-  WITH y : val, x : share * share * lock_handle * lock_handle * gname * gname * globals
+  WITH y : val, x : share * Qp * lock_handle * lock_handle * gname * gname * globals
   PRE [ tptr tvoid ]
          let '(sh1, sh, h, ht, g1, g2, gv) := x in
          PROP  (readable_share sh1; ptr_of ht = y)
          PARAMS (y) GLOBALS (gv)
          SEP   (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c);
                 lock_inv sh h (cptr_lock_inv g1 g2 (gv _c));
-                ghost_var gsh2 0 g1;
+                ghost_frag g1 0;
                 lock_inv sh ht (thread_lock_inv sh1 sh h g1 g2 (gv _c) ht))
   POST [ tint ]
          PROP ()
          RETURN (Vint Int.zero)
          SEP ().
 
+Definition compute2_spec :=
+ DECLARE _compute2
+ WITH gv: globals
+ PRE [] PROP() PARAMS() GLOBALS(gv)
+          SEP(library.mem_mgr gv;
+                data_at Ews t_counter (Vint (Int.repr 0), Vundef) (gv _c);
+                has_ext tt)
+ POST [ tint ] PROP() RETURN (Vint (Int.repr 2)) 
+                    SEP(library.mem_mgr gv; data_at_ Ews t_counter (gv _c); has_ext tt).
+
 Definition main_spec :=
  DECLARE _main
   WITH gv : globals
   PRE  [] main_pre prog tt gv
   POST [ tint ] main_post prog gv.
 
-Definition Gprog : funspecs :=   ltac:(with_library prog [acquire_spec; release_spec; makelock_spec; freelock_spec;
-  spawn_spec; incr_spec; read_spec; thread_func_spec; main_spec]).
+Definition Gprog : funspecs := ltac:(with_library prog [acquire_spec; release_spec; makelock_spec; freelock_spec;
+  spawn_spec; incr_spec; read_spec; thread_func_spec; compute2_spec; main_spec]).
 
 Lemma ctr_inv_exclusive : forall g1 g2 p,
   exclusive_mpred (cptr_lock_inv g1 g2 p).
 Proof.
   intros; unfold cptr_lock_inv.
-  eapply derives_exclusive, exclusive_sepcon1 with (Q := EX x : Z, EX y : Z, _),
-    field_at__exclusive with (sh := Ews)(t := t_counter); auto; simpl.
-  Intro z; apply sepcon_derives; [cancel|].
-  Intros x y; Exists x y; apply derives_refl.
+  iIntros "((% & ? & ?) & (% & ? & ?))".
+  rewrite !field_at_field_at_; iApply (field_at__conflict with "[$]"); auto.
   { simpl; lia. }
 Qed.
-#[export] Hint Resolve ctr_inv_exclusive : core.
+#[local] Hint Resolve ctr_inv_exclusive : core.
+
+Lemma thread_inv_exclusive : forall sh1 sh h g1 g2 p,
+  exclusive_mpred (thread_lock_R sh1 sh h g1 g2 p).
+Proof.
+  intros; unfold thread_lock_R.
+  iIntros "((? & ? & g1) & (? & ? & g2))".
+  iDestruct (own_valid_2 with "g1 g2") as %[]%@excl_auth_frag_op_valid.
+Qed.
+#[local] Hint Resolve thread_inv_exclusive : core.
+
+Lemma ghost_var_inj : forall g x y, ghost_auth g x ∗ ghost_frag g y ⊢ ⌜x = y⌝.
+Proof.
+  intros; iIntros "(a & f)".
+  iDestruct (own_valid_2 with "a f") as %H%@excl_auth_agree; done.
+Qed.
 
-Lemma ghost_var_incr : forall g1 g2 x y n (left : bool), ghost_var gsh1 x g1 * ghost_var gsh1 y g2 * ghost_var gsh2 n (if left then g1 else g2) |--
-  |==> !!((if left then x else y) = n) && ghost_var gsh1 (n+1) (if left then g1 else g2) * ghost_var gsh2 (n+1) (if left then g1 else g2) * ghost_var gsh1 (if left then y else x) (if left then g2 else g1).
+Lemma ghost_var_incr : forall g1 g2 x y n (left : bool), ghost_auth g1 x ∗ ghost_auth g2 y ∗ ghost_frag (if left then g1 else g2) n ⊢
+  |==> ⌜(if left then x else y) = n⌝ ∧ ghost_auth (if left then g1 else g2) (n+1)%nat ∗ ghost_frag (if left then g1 else g2) (n+1)%nat ∗
+       ghost_auth (if left then g2 else g1) (if left then y else x).
 Proof.
   destruct left.
-  - eapply derives_trans, bupd_frame_r; cancel.
-    rewrite sepcon_andp_prop'; apply ghost_var_update'.
-  - eapply derives_trans, bupd_frame_r; cancel.
-    rewrite sepcon_andp_prop'; apply ghost_var_update'.
+  - iIntros "(a & $ & f)".
+    iDestruct (ghost_var_inj with "[$a $f]") as %->.
+    iMod (own_update_2 with "a f") as "($ & $)"; last done.
+    apply @excl_auth_update.
+  - iIntros "($ & a & f)".
+    iDestruct (ghost_var_inj with "[$a $f]") as %->.
+    iMod (own_update_2 with "a f") as "($ & $)"; last done.
+    apply @excl_auth_update.
 Qed.
 
 Lemma body_incr: semax_body Vprog Gprog f_incr incr_spec.
 Proof.
   start_function.
   forward.
-  assert_PROP (sh <> Share.bot) by entailer!.
   forward_call (sh, h, cptr_lock_inv g1 g2 (gv _c)).
-  unfold cptr_lock_inv at 2. simpl.
+  unfold cptr_lock_inv at 2.
   Intros z x y.
   forward.
   forward.
 
-  gather_SEP (ghost_var _ x g1) (ghost_var _ y g2) (ghost_var _ n _).
-  rewrite sepcon_assoc.
-  viewshift_SEP 0 (!!((if left then x else y) = n) &&
-    ghost_var gsh1 (n+1) (if left then g1 else g2) *
-    ghost_var gsh2 (n+1) (if left then g1 else g2) *
-    ghost_var gsh1 (if left then y else x) (if left then g2 else g1)).
-  { go_lower.
-    eapply derives_trans, bupd_fupd.
-    rewrite <- sepcon_assoc; apply ghost_var_incr. }
+  gather_SEP (ghost_auth g1 x) (ghost_auth g2 y) (ghost_frag _ n).
+  viewshift_SEP 0 (⌜(if left then x else y) = n⌝ ∧
+    ghost_auth (if left then g1 else g2) (n+1)%nat ∗
+    ghost_frag (if left then g1 else g2) (n+1)%nat ∗
+    ghost_auth (if left then g2 else g1) (if left then y else x)).
+  { go_lowerx.
+    iIntros "(? & _)".
+    by iMod (ghost_var_incr with "[$]"). }
   Intros.
   forward.
   forward_call release_simple (sh, h, cptr_lock_inv g1 g2 (gv _c)).
   { lock_props.
-    unfold cptr_lock_inv; Exists (z + 1).
-    unfold Frame; instantiate (1 := [ghost_var gsh2 (n+1) (if left then g1 else g2);
+    unfold cptr_lock_inv; Exists (z + 1)%nat.
+    unfold Frame; instantiate (1 := [ghost_frag (if left then g1 else g2) (n+1)%nat;
       field_at sh1 t_counter (DOT _lock) (ptr_of h) (gv _c)]); simpl.
     destruct left.
-    - Exists (n+1) y; entailer!.
-    - Exists x (n+1); entailer!. }
+    - Exists (n+1)%nat y; subst; entailer!.
+      rewrite !Nat2Z.inj_add //.
+    - Exists x (n+1)%nat; entailer!.
+      rewrite !Nat2Z.inj_add //. }
   forward.
   cancel.
 Qed.
@@ -130,20 +171,20 @@ Lemma body_read : semax_body Vprog Gprog f_read read_spec.
 Proof.
   start_function.
   forward.
-  assert_PROP (sh <> Share.bot) by entailer!.
   forward_call (sh, h, cptr_lock_inv g1 g2 (gv _c)).
   unfold cptr_lock_inv at 2; simpl.
   Intros z x y.
   forward.
   assert_PROP (x = n1 /\ y = n2) as Heq.
-  { sep_apply (ghost_var_inj gsh1 gsh2 x); auto.
-    sep_apply (ghost_var_inj gsh1 gsh2 y); auto.
+  { sep_apply ghost_var_inj.
+    sep_apply (ghost_var_inj g2).
     entailer!. }
   forward.
   forward_call release_simple (sh, h, cptr_lock_inv g1 g2 (gv _c)).
   { lock_props.
     unfold cptr_lock_inv; Exists z x y; entailer!. }
-  destruct Heq; forward; cancel.
+  destruct Heq as [-> ->]; forward.
+  entailer!.
 Qed.
 
 Lemma body_thread_func : semax_body Vprog Gprog f_thread_func thread_func_spec.
@@ -152,72 +193,91 @@ Proof.
   forward_call (sh1, sh, h, g1, g2, true, 0, gv).
   simpl.
   forward_call release_self (sh, ht, thread_lock_R sh1 sh h g1 g2 (gv _c)).
-  { unfold thread_lock_inv, thread_lock_R; cancel. }
+  { lock_props.
+    unfold thread_lock_R at 2; unfold thread_lock_inv; cancel. }
   forward.
 Qed.
 
-Lemma body_main:  semax_body Vprog Gprog f_main main_spec.
+Lemma body_compute2:  semax_body Vprog Gprog f_compute2 compute2_spec.
 Proof.
   start_function.
   set (ctr := gv _c).
   forward.
-  ghost_alloc (ghost_var Tsh 0).
+  ghost_alloc (fun g => own g (●E O ⋅ ◯E O : excl_authR natO)).
+  { apply excl_auth_valid. }
   Intro g1.
-  ghost_alloc (ghost_var Tsh 0).
+  ghost_alloc (fun g => own g (●E O ⋅ ◯E O : excl_authR natO)).
+  { apply excl_auth_valid. }
   Intro g2.
-  sep_apply (library.create_mem_mgr gv).
   forward_call (gv, fun _ : lock_handle => cptr_lock_inv g1 g2 ctr).
   Intros lock.
   forward.
   forward.
-  forward_call release_simple (Tsh, lock, cptr_lock_inv g1 g2 ctr).
+  forward_call release_simple (1%Qp, lock, cptr_lock_inv g1 g2 ctr).
   { lock_props.
-    rewrite <- !(ghost_var_share_join gsh1 gsh2 Tsh) by auto with share.
-    unfold_data_at (data_at _ _ _ _).
-    unfold cptr_lock_inv; Exists 0 0 0; entailer!. }
+    rewrite !own_op /cptr_lock_inv /ghost_auth.
+    Exists O O O.
+    unfold_data_at (data_at _ _ _ _); entailer!. }
   (* need to split off shares for the locks here *)
   destruct split_Ews as (sh1 & sh2 & ? & ? & Hsh).
-  forward_call (gv, fun lockt => thread_lock_inv sh2 gsh2 lock g1 g2 ctr lockt).
+  forward_call (gv, fun lockt => thread_lock_inv sh2 (1/2)%Qp lock g1 g2 ctr lockt).
   Intros lockt.
   sep_apply lock_inv_isptr; Intros.
-  forward_spawn _thread_func (ptr_of lockt) (sh2, gsh2, lock, lockt, g1, g2, gv).
-  { erewrite <- lock_inv_share_join; try apply gsh1_gsh2_join; auto.
-    erewrite <- (lock_inv_share_join _ _ Tsh); try apply gsh1_gsh2_join; auto.
+  forward_spawn _thread_func (ptr_of lockt) (sh2, (1/2)%Qp, lock, lockt, g1, g2, gv).
+  { rewrite -{3}Qp.half_half -frac_op -lock_inv_share_join.
+    rewrite -{1}Qp.half_half -frac_op -lock_inv_share_join.
     erewrite <- field_at_share_join; try apply Hsh; auto.
     subst ctr; entailer!. }
   { simpl; auto. }
-  forward_call (sh1, gsh1, lock, g1, g2, false, 0, gv).
-  forward_call (gsh1, lockt, thread_lock_inv sh2 gsh2 lock g1 g2 (gv _c) lockt).
+  forward_call (sh1, (1/2)%Qp, lock, g1, g2, false, 0, gv).
+  forward_call ((1/2)%Qp, lockt, thread_lock_inv sh2 (1/2)%Qp lock g1 g2 (gv _c) lockt).
   unfold thread_lock_inv at 2; unfold thread_lock_R; Intros.
   simpl.
-  forward_call (sh1, gsh1, lock, g1, g2, 1, 1, gv).
+  forward_call (sh1, (1/2)%Qp, lock, g1, g2, 1, 1, gv).
   (* We've proved that t is 2! *)
   forward.
-  forward_call (gsh1, lock, cptr_lock_inv g1 g2 (gv _c)).
-  forward_call freelock_self (gsh1, gsh2, lockt, thread_lock_R sh2 gsh2 lock g1 g2 (gv _c)).
+  forward_call ((1/2)%Qp, lock, cptr_lock_inv g1 g2 (gv _c)).
+  forward_call freelock_self ((1/2)%Qp, (1/2)%Qp, lockt, thread_lock_R sh2 (1/2) lock g1 g2 (gv _c)).
   { unfold thread_lock_inv, selflock; cancel. }
+  { rewrite frac_op Qp.half_half //. }
   forward.
   forward_call freelock_simple (lock, cptr_lock_inv g1 g2 (gv _c)).
   { lock_props.
-    erewrite <- (lock_inv_share_join _ _ Tsh); try apply gsh1_gsh2_join; auto; subst ctr; cancel. }
+    rewrite -{2}Qp.half_half -frac_op -lock_inv_share_join.
+    subst ctr; cancel. }
   forward.
+  unfold_data_at (data_at_ _ _ _). simpl.
+  cancel.
+  unfold cptr_lock_inv; Intros z x y; cancel.
+  rewrite -(field_at_share_join _ _ Ews); [|eauto]; cancel.
+  by iIntros "(_ & _ & _ & _)".
 Qed.
 
-Definition extlink := ext_link_prog prog.
-Definition Espec := add_funspecs (Concurrent_Espec unit _ extlink) extlink Gprog.
-#[export] Existing Instance Espec.
+Lemma body_main:  semax_body Vprog Gprog f_main main_spec.
+Proof.
+  start_function.
+  sep_apply (library.create_mem_mgr gv).
+  forward_call.
+  { rewrite zero_val_eq.
+    repeat change (fold_reptype ?a) with a.
+    repeat unfold_data_at (data_at _ _ _ _); simpl.
+    rewrite zero_val_eq; cancel. }
+  forward.
+Qed.
 
 Lemma prog_correct:
   semax_prog prog tt Vprog Gprog.
 Proof.
 prove_semax_prog.
-repeat (apply semax_func_cons_ext_vacuous; [reflexivity | reflexivity | ]).
 semax_func_cons_ext.
 { simpl.
+  destruct x; simpl.
+  monPred.unseal.
   Intros h.
-  unfold PROPx, LOCALx, SEPx, local, lift1; simpl; unfold liftx; simpl; unfold lift; Intros.
+  unfold PROPx, LOCALx, SEPx, local, lift1; simpl; unfold liftx; simpl; unfold lift.
+  monPred.unseal; Intros.
   destruct ret; unfold eval_id in H0; simpl in H0; subst; simpl; [|contradiction].
-  saturate_local; apply prop_right; auto. }
+  saturate_local; auto. }
 semax_func_cons_ext.
 semax_func_cons_ext.
 semax_func_cons_ext.
@@ -225,5 +285,8 @@ semax_func_cons_ext.
 semax_func_cons body_incr.
 semax_func_cons body_read.
 semax_func_cons body_thread_func.
+semax_func_cons body_compute2.
 semax_func_cons body_main.
 Qed.
+
+End mpred.
diff --git a/progs64/verif_incr_atomic.v b/progs64/verif_incr_atomic.v
index c33b226600..4e6a48db2a 100644
--- a/progs64/verif_incr_atomic.v
+++ b/progs64/verif_incr_atomic.v
@@ -1,21 +1,33 @@
 Require Import VST.concurrency.conclib.
 Require Import VST.atomics.verif_lock_atomic.
-Require Import VST.concurrency.ghostsI.
+Require Import iris_ora.algebra.ext_order.
+Require Import iris.algebra.lib.excl_auth.
 Require Import VST.progs64.incr.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
+Canonical Structure excl_authR A := inclR (excl_authR A).
+
+Section mpred.
+
+(* box up concurrentGS? *)
+Context `{!VSTGS unit Σ, !cinvG Σ, !inG Σ (excl_authR natO), !atomic_int_impl (Tstruct _atom_int noattr)}.
+#[local] Instance concurrent_ext_spec : ext_spec unit := concurrent_ext_spec _ (ext_link_prog prog).
+
 Definition spawn_spec := DECLARE _spawn spawn_spec.
 
 Definition t_counter := Tstruct _counter noattr.
 
-Definition ctr_inv gv g := EX n : nat, field_at Ews t_counter [StructField _ctr] (vint (Z.of_nat n)) (gv _c) * ghost_var gsh2 n g.
-Definition ctr_state gv l g (n : nat) := ghost_var gsh1 n g * inv_for_lock l (ctr_inv gv g).
+Definition ghost_auth (g : gname) (n : nat) : mpred := own g (●E n : excl_authR natO).
+Definition ghost_frag (g : gname) (n : nat) : mpred := own g (◯E n : excl_authR natO).
+
+Definition ctr_inv gv g := ∃ n : nat, field_at Ews t_counter [StructField _ctr] (vint (Z.of_nat n)) (gv _c) ∗ ghost_auth g n.
+Definition ctr_state gv l g (n : nat) := ghost_frag g n ∗ inv_for_lock l (ctr_inv gv g).
 
 Program Definition incr_spec :=
  DECLARE _incr
-  ATOMIC TYPE (rmaps.ConstType (share * val * gname * globals)) OBJ n INVS ∅
+  ATOMIC TYPE (ConstType (share * val * gname * globals)) OBJ n INVS ∅
   WITH sh, l, g, gv
   PRE [ ]
          PROP  (readable_share sh; isptr l)
@@ -28,39 +40,49 @@ Program Definition incr_spec :=
 
 Program Definition read_spec :=
  DECLARE _read
-  ATOMIC TYPE (rmaps.ConstType (share * val * gname * globals)) OBJ n INVS ∅
+  ATOMIC TYPE (ConstType (share * val * gname * globals)) OBJ n INVS ∅
   WITH sh, l, g, gv
   PRE [ ]
          PROP  (readable_share sh; isptr l)
          PARAMS () GLOBALS (gv)
          SEP   (field_at sh t_counter [StructField _lock] l (gv _c)) | (ctr_state gv l g n)
   POST [ tuint ]
-    EX n' : nat,
+    ∃ n' : nat,
          PROP ()
          LOCAL (temp ret_temp (vint (Z.of_nat n')))
-         SEP (field_at sh t_counter [StructField _lock] l (gv _c)) | (!!(n' = n) && ctr_state gv l g n).
+         SEP (field_at sh t_counter [StructField _lock] l (gv _c)) | (⌜n' = n⌝ ∧ ctr_state gv l g n).
 
 Definition cptr_inv g g1 g2 :=
-  EX x y : nat, ghost_var gsh1 x g1 * ghost_var gsh1 y g2 * ghost_var gsh1 (x + y)%nat g.
+  ∃ x y : nat, ghost_auth g1 x ∗ ghost_auth g2 y ∗ ghost_frag g (x + y)%nat.
 
-Definition thread_lock_R sh1 sh gv l g g1 := lock_inv sh l (ctr_inv gv g) * field_at sh1 t_counter [StructField _lock] (ptr_of l) (gv _c) * ghost_var gsh2 1%nat g1.
+Definition thread_lock_R sh1 sh gv l g g1 := lock_inv sh l (ctr_inv gv g) ∗ field_at sh1 t_counter [StructField _lock] (ptr_of l) (gv _c) ∗ ghost_frag g1 1%nat.
 
 Definition thread_lock_inv sh1 sh gv l g g1 lockt := selflock (thread_lock_R sh1 sh gv l g g1) sh lockt.
 
 Definition thread_func_spec :=
  DECLARE _thread_func
-  WITH y : val, x : namespace * share * share * lock_handle * lock_handle * gname * gname * gname * globals
+  WITH y : val, x : namespace * share * Qp * lock_handle * lock_handle * gname * gname * gname * globals
   PRE [ tptr tvoid ]
          let '(i, sh1, sh, l, ht, g, g1, g2, gv) := x in
          PROP  (readable_share sh1; ptr_of ht = y; i ## name_of l)
          PARAMS (y) GLOBALS (gv)
          SEP   (inv i (cptr_inv g g1 g2); lock_inv sh l (ctr_inv gv g); field_at sh1 t_counter [StructField _lock] (ptr_of l) (gv _c);
-                ghost_var gsh2 O g1; lock_inv sh ht (thread_lock_inv sh1 sh gv l g g1 ht))
+                ghost_frag g1 O; lock_inv sh ht (thread_lock_inv sh1 sh gv l g g1 ht))
   POST [ tint ]
          PROP ()
          RETURN (Vint Int.zero)
          SEP ().
 
+Definition compute2_spec :=
+ DECLARE _compute2
+ WITH gv: globals
+ PRE [] PROP() PARAMS() GLOBALS(gv)
+          SEP(library.mem_mgr gv;
+                data_at Ews t_counter (Vint (Int.repr 0), Vundef) (gv _c);
+                has_ext tt)
+ POST [ tint ] PROP() RETURN (Vint (Int.repr 2)) 
+                    SEP(library.mem_mgr gv; data_at_ Ews t_counter (gv _c); has_ext tt).
+
 Definition main_spec :=
  DECLARE _main
   WITH gv : globals
@@ -68,40 +90,71 @@ Definition main_spec :=
   POST [ tint ] main_post prog gv.
 
 Definition Gprog : funspecs :=   ltac:(with_library prog [acquire_spec; release_spec; makelock_spec;
-  freelock_spec; spawn_spec; incr_spec; read_spec; thread_func_spec; main_spec]).
+  freelock_spec; spawn_spec; incr_spec; read_spec; thread_func_spec; compute2_spec; main_spec]).
 
 Lemma ctr_inv_exclusive : forall gv g, exclusive_mpred (ctr_inv gv g).
 Proof.
   intros; unfold ctr_inv.
-  eapply derives_exclusive, exclusive_sepcon1 with (Q := EX n : nat, _),
+  eapply derives_exclusive, exclusive_sepcon1 with (Q := ∃ n : nat, _),
     field_at__exclusive with (sh := Ews)(t := t_counter); auto; simpl; try lia.
-  Intro n; apply sepcon_derives; [cancel|].
+  Intro n; apply bi.sep_mono; [cancel|].
   Exists n; apply derives_refl.
   { simpl; lia. }
 Qed.
 #[local] Hint Resolve ctr_inv_exclusive : core.
 
+(* up *)
+Lemma ghost_var_inj : forall g x y, ghost_auth g x ∗ ghost_frag g y ⊢ ⌜x = y⌝.
+Proof.
+  intros; iIntros "(a & f)".
+  iDestruct (own_valid_2 with "a f") as %H%@excl_auth_agree; done.
+Qed.
+
+Lemma ghost_var_update' : forall g a b c,
+  ghost_frag g a ∗ ghost_auth g b ==∗ ⌜a = b⌝ ∧ ghost_frag g c ∗ ghost_auth g c.
+Proof.
+  intros.
+  iIntros "(f & a)".
+  iDestruct (ghost_var_inj with "[$a $f]") as %->.
+  iMod (own_update_2 with "a f") as "($ & $)"; last done.
+  apply @excl_auth_update.
+Qed.
+
+Lemma ghost_frag_excl : forall g, exclusive_mpred (ghost_frag g 1).
+Proof.
+  intros; iIntros "(g1 & g2)".
+  iDestruct (own_valid_2 with "g1 g2") as "%".
+  rewrite excl_auth_frag_op_valid // in H.
+Qed.
+
+Lemma thread_lock_exclusive : forall sh1 sh gv l g g1, exclusive_mpred (thread_lock_R sh1 sh gv l g g1).
+Proof.
+  intros; unfold thread_lock_R.
+  apply exclusive_sepcon2, exclusive_sepcon2, ghost_frag_excl.
+Qed.
+#[local] Hint Resolve thread_lock_exclusive : core.
+
 Lemma body_incr: semax_body Vprog Gprog f_incr incr_spec.
 Proof.
   start_function.
   forward.
   set (AS := atomic_shift _ _ _ _ _).
-  forward_call acquire_inv (l, ctr_inv gv g, AS).
-  { apply sepcon_derives; [|cancel].
+  forward_call acquire_inv (l, ctr_inv gv g, AS). (* need to patch to simplify rev_curry/tcurry? *)
+  { apply bi.sep_mono; [|cancel].
     unfold atomic_shift; iIntros "AU"; iAuIntro; unfold atomic_acc; simpl.
     iMod "AU" as (n) "[ctr_state Hclose]"; unfold ctr_state at 1.
     iExists tt; iDestruct "ctr_state" as "[g $]".
     iModIntro; iSplit.
     { (* tactic? *)
       iIntros "l"; iApply "Hclose"; iFrame. }
-    iIntros (_) "[inv _]".
+    iIntros (?) "[inv _]".
     iApply "Hclose"; iFrame. }
-  unfold ctr_inv; Intros n.
+  simpl; unfold ctr_inv; Intros n.
   forward.
   forward.
   forward.
   forward_call release_inv (l, ctr_inv gv g, Q).
-  { apply sepcon_derives; [|cancel].
+  { rewrite assoc assoc; apply bi.sep_mono; [|cancel].
     lock_props.
     unfold atomic_shift; iIntros "((AU & ctr) & g)"; iAuIntro; unfold atomic_acc; simpl.
     iMod "AU" as (n') "[ctr_state Hclose]"; unfold ctr_state at 1.
@@ -117,10 +170,10 @@ Proof.
       iMod (ghost_var_update' with "[$g1 $g2]") as "(% & g1 & $)"; subst.
       rewrite Nat2Z.inj_add; iFrame "f".
       iApply "Hclose"; iFrame. }
-    iIntros (_) "[l _]".
+    iIntros (?) "[l _]".
     iDestruct "Hclose" as "[_ Hclose]"; iApply ("Hclose" $! tt); simpl.
-    rewrite sepcon_emp; unfold ctr_state; iFrame. }
-  entailer!.
+    unfold ctr_state; iFrame. }
+  simpl; entailer!.
 Qed.
 
 Lemma body_read : semax_body Vprog Gprog f_read read_spec.
@@ -129,20 +182,20 @@ Proof.
   forward.
   set (AS := atomic_shift _ _ _ _ _).
   forward_call acquire_inv (l, ctr_inv gv g, AS).
-  { apply sepcon_derives; [|cancel].
+  { apply bi.sep_mono; [|cancel].
     unfold atomic_shift; iIntros "AU"; iAuIntro; unfold atomic_acc; simpl.
     iMod "AU" as (n) "[ctr_state Hclose]"; unfold ctr_state at 1.
     iExists tt; iDestruct "ctr_state" as "[g $]".
     iModIntro; iSplit.
     { (* tactic? *)
       iIntros "l"; iApply "Hclose"; iFrame. }
-    iIntros (_) "[inv _]".
+    iIntros (?) "[inv _]".
     iApply "Hclose"; iFrame. }
-  unfold ctr_inv; Intros n.
+  simpl; unfold ctr_inv; Intros n.
   forward.
   forward.
   forward_call release_inv (l, ctr_inv gv g, Q n).
-  { apply sepcon_derives; [|cancel].
+  { rewrite assoc assoc; apply bi.sep_mono; [|cancel].
     lock_props.
     unfold atomic_shift; iIntros "((AU & ctr) & g)"; iAuIntro; unfold atomic_acc; simpl.
     iMod "AU" as (n') "[ctr_state Hclose]"; unfold ctr_state at 1.
@@ -155,18 +208,20 @@ Proof.
       iDestruct "inv" as (?) "[f g2]".
       iDestruct (ghost_var_inj with "[$g' $g2]") as %?; auto; subst.
       iFrame "f g2"; iApply "Hclose"; iFrame. }
-    iIntros (_) "[l _]".
+    iIntros (?) "[l _]".
     iDestruct "Hclose" as "[_ Hclose]"; iApply "Hclose"; simpl.
-    rewrite sepcon_emp; iSplit; auto.
+    iSplit; auto; iSplit; auto.
     unfold ctr_state; iFrame. }
-  forward.
-  Exists n; entailer!.
+  simpl. forward.
+  Exists n; entailer!!.
 Qed.
 
 #[local] Instance ctr_inv_timeless : forall gv g, Timeless (ctr_inv gv g).
 Proof.
   intros; unfold ctr_inv.
-  apply bi.exist_timeless; intros []; apply _.
+  apply bi.exist_timeless; intros.
+  apply bi.sep_timeless; try apply _.
+  apply bi.and_timeless; apply _.
 Qed.
 
 (* In this client, the ctr_state is assembled from the combination of the counter's lock assertion
@@ -175,19 +230,19 @@ Qed.
 
 (* prove a lemma about our specific use pattern of incr *)
 Lemma incr_inv_shift : forall i gv sh g l g1 g2 gvar, (gvar = g1 \/ gvar = g2) -> i ## name_of l ->
-  lock_inv sh l (ctr_inv gv g) * inv i (cptr_inv g g1 g2) * ghost_var gsh2 0%nat gvar |--
+  lock_inv sh l (ctr_inv gv g) ∗ inv i (cptr_inv g g1 g2) ∗ ghost_frag gvar 0%nat ⊢
   atomic_shift (λ n : nat, ctr_state gv (ptr_of l) g n) (⊤ ∖ ∅) ∅
-      (λ (n : nat) (_ : ()), fold_right_sepcon [ctr_state gv (ptr_of l) g (n + 1)%nat]) (λ _ : (), lock_inv sh l (ctr_inv gv g) * ghost_var gsh2 1%nat gvar).
+      (λ (n : nat) (_ : ()), fold_right_sepcon [ctr_state gv (ptr_of l) g (n + 1)%nat]) (λ _ : (), lock_inv sh l (ctr_inv gv g) ∗ ghost_frag gvar 1%nat).
 Proof.
   intros.
-  unfold_lock_inv; Intros.
-  rewrite -> prop_true_andp by auto.
-  iIntros "[[[#inv0 sh] #inv] g]".
+  unfold_lock_inv. unfold atomic_lock_inv. Intros.
+  iIntros "([#inv0 sh] & #inv & g)".
   unfold atomic_shift; iAuIntro; rewrite /atomic_acc /=.
-  iMod (into_acc_cinv with "inv0 sh") as (_) "[[>i sh] Hclose0]". done.
-  iInv "inv" as (x y) ">[[g1 g2] c]" "Hclose"; auto.
+  iMod (into_acc_cinv with "inv0 sh") as (_) "[[>i sh] Hclose0]"; first done.
+  iInv "inv" as (x y) ">(g1 & g2 & c)" "Hclose"; auto.
   unfold ctr_state at 1.
   iExists (x + y)%nat; iFrame "c i sh inv0".
+  iFrame "%".
   iApply fupd_mask_intro; first by set_solver. iIntros "mask"; iSplit.
   - iIntros "[g' c]". iFrame "g".
     iMod "mask"; iMod ("Hclose" with "[g1 g2 g']").
@@ -195,12 +250,12 @@ Proof.
     iApply "Hclose0"; auto.
   - iIntros (_) "([g' c] & _)".
     destruct H; subst.
-    + iMod (ghost_var_update' with "[$g1 $g]") as "(% & g1 & $)"; subst.
+    + iMod (ghost_var_update' with "[$g1 $g]") as "(% & $ & g1)"; subst.
       iMod "mask"; iMod ("Hclose" with "[g1 g2 g']").
       { iExists 1%nat, y; iFrame; auto.
         rewrite Nat.add_0_l Nat.add_comm; auto. }
       iApply "Hclose0"; auto.
-    + iMod (ghost_var_update' with "[$g2 $g]") as "(% & g2 & $)"; subst.
+    + iMod (ghost_var_update' with "[$g2 $g]") as "(% & $ & g2)"; subst.
       iMod "mask"; iMod ("Hclose" with "[g1 g2 g']").
       { iExists x, 1%nat; iFrame; auto.
         rewrite Nat.add_0_r; auto. }
@@ -211,24 +266,37 @@ Lemma body_thread_func : semax_body Vprog Gprog f_thread_func thread_func_spec.
 Proof.
   start_function.
   sep_apply lock_inv_isptr; Intros.
-  forward_call (sh1, ptr_of l, g, gv, lock_inv sh l (ctr_inv gv g) * ghost_var gsh2 1%nat g1).
-  { sep_apply incr_inv_shift; auto; cancel. }
+  forward_call (sh1, ptr_of l, g, gv, lock_inv sh l (ctr_inv gv g) ∗ ghost_frag g1 1%nat); simpl.
+  { rewrite /rev_curry /=. sep_apply incr_inv_shift; auto; simpl; cancel. }
+  { auto. }
   forward_call release_self (sh, ht, thread_lock_R sh1 sh gv l g g1).
-  { unfold thread_lock_inv, thread_lock_R; cancel. }
+  { lock_props.
+    unfold thread_lock_inv, selflock; cancel.
+    unfold thread_lock_R; cancel. }
   forward.
 Qed.
 
-Lemma body_main : semax_body Vprog Gprog f_main main_spec.
+(* up *)
+Lemma ghost_auth_frag : forall g a b, own g (●E a ⋅ ◯E b : excl_authR natO) ⊣⊢ ghost_auth g a ∗ ghost_frag g b.
+Proof.
+  intros; rewrite own_op //.
+Qed.
+
+Opaque Qp.div.
+
+Lemma body_compute2 : semax_body Vprog Gprog f_compute2 compute2_spec.
 Proof.
   start_function.
   forward.
-  ghost_alloc (ghost_var Tsh O).
+  ghost_alloc (fun g => own g (●E O ⋅ ◯E O : excl_authR natO)).
+  { apply excl_auth_valid. }
   Intro g1.
-  ghost_alloc (ghost_var Tsh O).
+  ghost_alloc (fun g => own g (●E O ⋅ ◯E O : excl_authR natO)).
+  { apply excl_auth_valid. }
   Intro g2.
-  ghost_alloc (ghost_var Tsh O).
+  ghost_alloc (fun g => own g (●E O ⋅ ◯E O : excl_authR natO)).
+  { apply excl_auth_valid. }
   Intro g.
-  sep_apply (library.create_mem_mgr gv).
   (* We allocate the lock here, but give it an invariant later. *)
   forward_call (gv).
   Intros lockp.
@@ -238,100 +306,107 @@ Proof.
   forward_call release_nonatomic (lockp).
   (* make lock invariant *)
   unfold_data_at (data_at _ _ _ (gv _c)).
-  rewrite <- 3(ghost_var_share_join gsh1 gsh2 Tsh) by auto with share; Intros.
-  gather_SEP (atomic_int_at _ _ lockp) (field_at _ _ [StructField _ctr] _ _) (ghost_var gsh2 _ g);
-    viewshift_SEP 0 (EX lock, !!(ptr_of lock = lockp /\ name_of lock = nroot .@ "ctr") && lock_inv Tsh lock (ctr_inv gv g)).
-  { go_lower; eapply derives_trans, make_lock_inv_0.
+  rewrite !ghost_auth_frag; Intros.
+  gather_SEP (atomic_int_at _ _ lockp) (field_at _ _ [StructField _ctr] _ _) (ghost_auth g _);
+    viewshift_SEP 0 (∃ lock, ⌜ptr_of lock = lockp /\ name_of lock = nroot .@ "ctr"⌝ ∧ lock_inv 1 lock (ctr_inv gv g)).
+  { go_lowerx; eapply derives_trans, make_lock_inv_0.
     unfold ctr_inv; Exists O; cancel. }
   Intros lock.
   (* need to split off shares for the locks here *)
   destruct split_Ews as (sh1 & sh2 & ? & ? & Hsh).
-  forward_call makelock_inv (gv, nroot .@ "tlock", fun lockt => thread_lock_inv sh2 gsh2 gv lock g g1 lockt).
+  forward_call makelock_inv (gv, nroot .@ "tlock", fun lockt => thread_lock_inv sh2 (1/2) gv lock g g1 lockt).
   Intros lockt.
-  match goal with |-context[|={⊤}=> ?P] => viewshift_SEP 1 P by entailer! end.
+  match goal with |-context[|={⊤}=> ?P] => viewshift_SEP 1 P by (go_lowerx; entailer!) end.
   Intros ht.
   sep_apply lock_inv_isptr; Intros.
-  gather_SEP (ghost_var gsh1 _ g) (ghost_var gsh1 _ g1) (ghost_var gsh1 _ g2).
+  gather_SEP (ghost_frag g _) (ghost_auth g1 _) (ghost_auth g2 _).
   viewshift_SEP 0 (inv (nroot .@ "ctr_inv") (cptr_inv g g1 g2)).
-  { go_lower.
-    eapply derives_trans, inv_alloc.
-    eapply derives_trans, now_later.
+  { go_lowerx.
+    iIntros "((? & ? & ?) & _)"; iApply inv_alloc.
     unfold cptr_inv.
-    Exists O O; simpl; cancel. }
-  rewrite invariant_dup; Intros.
+    by iExists O, O; iFrame. }
+  rewrite (bi.persistent_sep_dup (inv _ _)); Intros.
   assert (nroot.@"ctr_inv" ## name_of lock) by (rewrite H0; solve_ndisj).
-  forward_spawn _thread_func (ptr_of ht) (nroot .@ "ctr_inv", sh2, gsh2, lock, ht, g, g1, g2, gv).
+  forward_spawn _thread_func (ptr_of ht) (nroot .@ "ctr_inv", sh2, (1/2)%Qp, lock, ht, g, g1, g2, gv).
   { entailer!.
-    erewrite <- lock_inv_share_join; try apply gsh1_gsh2_join; auto.
-    erewrite <- (lock_inv_share_join _ _ Tsh); try apply gsh1_gsh2_join; auto.
+    rewrite -{1}Qp.half_half -frac_op -lock_inv_share_join.
+    rewrite -{5}Qp.half_half -frac_op -lock_inv_share_join.
     erewrite <- field_at_share_join; try apply Hsh; auto.
     cancel. }
   { simpl; auto. }
-  rewrite invariant_dup; Intros.
-  forward_call (sh1, ptr_of lock, g, gv, lock_inv gsh1 lock (ctr_inv gv g) * ghost_var gsh2 1%nat g2).
-  { sep_apply incr_inv_shift; auto; cancel. }
-  forward_call acquire_inv_simple (gsh1, ht, thread_lock_inv sh2 gsh2 gv lock g g1 ht).
-  unfold thread_lock_inv at 2; unfold thread_lock_R; rewrite -> 3later_sepcon; Intros.
-  forward_call (sh1, ptr_of lock, g, gv, fun n => !!(n = 2)%nat && lock_inv gsh1 lock (ctr_inv gv g) * ghost_var gsh2 1%nat g1).
-  { iIntros "(((((((? & g1) & lock) & g2) & inv) & ?) & ?) & ?)"; iSplitL "g1 g2 inv lock"; [|iVST; cancel_frame].
-    unfold_lock_inv; iDestruct "lock" as "[[[% %] #inv0] sh]".
+  rewrite (bi.persistent_sep_dup (inv _ _)); Intros.
+  forward_call (sh1, ptr_of lock, g, gv, lock_inv (1/2) lock (ctr_inv gv g) ∗ ghost_frag g2 1%nat); simpl.
+  { rewrite /rev_curry /=. sep_apply incr_inv_shift; auto; simpl; cancel. }
+  { rewrite H //. }
+  forward_call acquire_inv_simple ((1/2)%Qp, ht, thread_lock_inv sh2 (1/2) gv lock g g1 ht).
+  unfold thread_lock_inv at 2; unfold thread_lock_R; rewrite !bi.later_sep; Intros.
+  forward_call (sh1, ptr_of lock, g, gv, fun n => ⌜n = 2⌝%nat ∧ lock_inv (1/2) lock (ctr_inv gv g) ∗ ghost_frag g1 1%nat ∗ ghost_frag g2 1%nat); simpl.
+  { iIntros "(? & ? & ? & ? & g1 & lock & g2 & inv & ?)"; iSplitL "g1 g2 inv lock"; [|iStopProof; cancel_frame].
+    unfold_lock_inv; iDestruct "lock" as "(% & #inv0 & sh)".
     iDestruct "inv" as "#inv".
+    unfold rev_curry; simpl.
     unfold atomic_shift; iAuIntro; rewrite /atomic_acc /=.
-    iMod (into_acc_cinv with "inv0 sh") as (_) "[[>i sh] Hclose0]". done.
-    iInv "inv" as (x y) ">[gs c]" "Hclose"; auto.
+    iMod (into_acc_cinv with "inv0 sh") as (_) "[[>i sh] Hclose0]"; first done.
+    iInv "inv" as (x y) ">(g1' & g2' & c)" "Hclose"; auto.
     iExists (x + y)%nat; iFrame "c i".
     iApply fupd_mask_intro; first set_solver.
     iFrame "sh".
     iIntros "mask"; iSplit.
     - unfold ctr_state. iIntros "[g i]".
-      iFrame "g1 g2"; iMod "mask"; iMod ("Hclose" with "[gs g]").
+      iFrame "g1 g2"; iMod "mask"; iMod ("Hclose" with "[g1' g2' g]").
       { iExists x, y; iFrame; auto. }
       iApply "Hclose0"; auto.
     - iIntros (z) "[[% [g i]] _]".
       iMod "mask" as "_".
-      iDestruct "gs" as "[g1' g2']".
-      iPoseProof (ghost_var_inj(A := nat) with "[$g1' $g1]") as "%"; auto with share; subst.
-      iPoseProof (ghost_var_inj(A := nat) with "[$g2' $g2]") as "%"; auto with share; subst.
-      iMod (ghost_var_update with "[g1' g1]") as "g1".
-      { rewrite <- (ghost_var_share_join gsh1 gsh2 Tsh) by auto with share; iFrame. }
-      iMod (ghost_var_update with "[g2' g2]") as "g2".
-      { rewrite <- (ghost_var_share_join gsh1 gsh2 Tsh) by auto with share; iFrame. }
-      rewrite <- (ghost_var_share_join gsh1 gsh2 Tsh) by auto with share.
+      iMod (ghost_var_update' with "[$g1' $g1]") as "(<- & $ & g1)".
+      iMod (ghost_var_update' with "[$g2' $g2]") as "(<- & $ & g2)".
       iFrame "inv0".
-      iDestruct "g1" as "[g1 $]".
-      rewrite <- (ghost_var_share_join gsh1 gsh2 Tsh) by auto with share.
-      iDestruct "g2" as "[g2 _]".
       iMod ("Hclose" with "[g1 g2 g]").
-      { iExists 1%nat, 1%nat; iFrame "g1 g2 g"; auto. }
+      { iExists 1%nat, 1%nat; iFrame; auto. }
       iMod ("Hclose0" with "i"); auto. }
   (* We've proved that t is 2! *)
+  { rewrite H //. }
   Intros v; subst.
   forward.
-  forward_call acquire_inv_simple (gsh1, lock, ctr_inv gv g).
+  forward_call acquire_inv_simple ((1/2)%Qp, lock, ctr_inv gv g).
   unfold thread_lock_inv.
-  forward_call freelock_self (gsh1, gsh2, ht, thread_lock_R sh2 gsh2 gv lock g g1).
+  forward_call freelock_self ((1/2)%Qp, (1/2)%Qp, ht, thread_lock_R sh2 (1/2) gv lock g g1).
+  { unfold selflock; cancel. }
+  { apply Qp.half_half. }
   forward.
   forward_call freelock_simple (lock, ctr_inv gv g).
   { lock_props.
-    erewrite <- (lock_inv_share_join gsh1 gsh2 Tsh); auto; cancel. }
+    rewrite -{3}Qp.half_half -frac_op -lock_inv_share_join; cancel. }
   forward.
+  unfold_data_at (data_at_ _ _ _). simpl.
+  cancel.
+  unfold ctr_inv; Intros n; cancel.
+  rewrite -(field_at_share_join _ _ Ews); [|eauto]; cancel.
+  by iIntros "(_ & _ & _)".
 Qed.
 
-Definition extlink := ext_link_prog prog.
-
-Definition Espec := add_funspecs (Concurrent_Espec unit _ extlink) extlink Gprog.
-#[export] Existing Instance Espec.
+Lemma body_main : semax_body Vprog Gprog f_main main_spec.
+Proof.
+  start_function.
+  sep_apply (library.create_mem_mgr gv).
+  forward_call.
+  { rewrite zero_val_eq.
+    repeat change (fold_reptype ?a) with a.
+    repeat unfold_data_at (data_at _ _ _ _); simpl.
+    rewrite zero_val_eq; cancel. }
+  forward.
+Qed.
 
 Lemma prog_correct:
   semax_prog prog tt Vprog Gprog.
 Proof.
 prove_semax_prog.
-repeat (apply semax_func_cons_ext_vacuous; [reflexivity | reflexivity | ]).
 semax_func_cons_ext.
-{ simpl; Intros p; unfold PROPx, LOCALx, SEPx, local; simpl; unfold liftx, lift1, lift; simpl; Intros; subst.
-  sep_apply atomic_int_isptr; Intros.
-  destruct ret; try contradiction.
-  unfold eval_id in *; simpl in *; apply prop_right; auto. }
+{ monPred.unseal; Intros p.
+  unfold PROPx, LOCALx, SEPx, local, lift1; simpl; unfold liftx; simpl; unfold lift.
+  monPred.unseal; Intros.
+  destruct ret; unfold eval_id in H0; simpl in H0; subst; simpl; [|contradiction].
+  saturate_local; auto. }
 semax_func_cons_ext.
 semax_func_cons_ext.
 semax_func_cons_ext.
@@ -339,5 +414,8 @@ semax_func_cons_ext.
 semax_func_cons body_incr.
 semax_func_cons body_read.
 semax_func_cons body_thread_func.
+semax_func_cons body_compute2.
 semax_func_cons body_main.
 Qed.
+
+End mpred.
diff --git a/progs64/verif_incr_gen.v b/progs64/verif_incr_gen.v
index c313e2716d..3f43e719cf 100644
--- a/progs64/verif_incr_gen.v
+++ b/progs64/verif_incr_gen.v
@@ -3,49 +3,33 @@
 
 Require Import VST.concurrency.conclib.
 Require Import VST.concurrency.lock_specs.
+Require Import VST.atomics.SC_atomics.
 Require Import VST.atomics.verif_lock.
-Require Import VST.concurrency.ghosts.
+Require Import iris_ora.algebra.frac_auth.
+Require Import iris.algebra.numbers.
+Require Import VST.zlist.sublist.
 Require Import VST.progs64.incrN.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
-Definition spawn_spec := DECLARE _spawn spawn_spec.
+Section proofs.
 
-#[local] Program Instance sum_ghost : Ghost :=
-  { G := nat; valid g := True; Join_G a b c := c = (a + b)%nat }.
-Next Obligation.
-Proof.
-  exists (fun _ => O).
-  - intros; hnf; auto.
-  - intros; eexists; hnf; eauto.
-  - auto.
-Defined.
-Next Obligation.
-Proof.
-  constructor.
-  - intros; hnf in *.
-    subst; auto.
-  - intros; hnf in *.
-    exists (b + c)%nat; split; hnf; lia.
-  - intros; hnf in *.
-    lia.
-  - intros; hnf in *.
-    lia.
-Qed.
+Context `{!VSTGS unit Σ, !cinvG Σ, !atomic_int_impl (Tstruct _atom_int noattr), !inG Σ (frac_authR natR)}.
+#[local] Instance concurrent_ext_spec : ext_spec _ := concurrent_ext_spec _ (ext_link_prog prog).
 
-#[local] Instance ctr_ghost : Ghost := ref_PCM sum_ghost.
+Definition spawn_spec := DECLARE _spawn spawn_spec.
 
-Definition ghost_ref n g := ghost_reference(P := sum_ghost) n g.
-Definition ghost_part sh n g := ghost_part(P := sum_ghost) sh n g.
-Definition ghost_both sh n1 n2 g := ghost_part_ref(P := sum_ghost) sh n1 n2 g.
+Definition ghost_ref n g := own g (●F n : frac_authR _).
+Definition ghost_part sh n g := own g (◯F{sh} n : frac_authR _).
+Definition ghost_both sh n1 n2 g := own g (●F n1 ⋅ ◯F{sh} n2 : frac_authR _).
 
 Definition t_counter := Tstruct _counter noattr.
 
 Definition cptr_lock_inv g ctr :=
-  EX z : nat, field_at Ews t_counter [StructField _ctr] (Vint (Int.repr (Z.of_nat z))) ctr * ghost_ref z g.
+  ∃ z : nat, field_at Ews t_counter [StructField _ctr] (Vint (Int.repr (Z.of_nat z))) ctr ∗ ghost_ref z g.
 
-Definition ctr_handle sh h g ctr n := lock_inv sh h (cptr_lock_inv g ctr) * ghost_part sh n g.
+Definition ctr_handle sh h g ctr n := lock_inv sh h (cptr_lock_inv g ctr) ∗ ghost_part sh n g.
 
 Definition init_ctr_spec :=
  DECLARE _init_ctr
@@ -56,12 +40,12 @@ Definition init_ctr_spec :=
          GLOBALS (gv)
          SEP   (library.mem_mgr gv; data_at_ Ews t_counter (gv _c))
   POST [ tvoid ]
-    EX h : lock_handle, EX g : gname,
+    ∃ h : lock_handle, ∃ g : gname,
          PROP ()
          LOCAL ()
          SEP (library.mem_mgr gv;
               field_at Ews t_counter [StructField _lock] (ptr_of h) (gv _c); spacer Ews 4 8 (gv _c);
-              ctr_handle Tsh h g (gv _c) O).
+              ctr_handle 1 h g (gv _c) O).
 
 Definition dest_ctr_spec :=
  DECLARE _dest_ctr
@@ -71,7 +55,7 @@ Definition dest_ctr_spec :=
          PARAMS ()
          GLOBALS (gv)
          SEP (field_at Ews t_counter [StructField _lock] (ptr_of h) (gv _c); spacer Ews 4 8 (gv _c);
-              ctr_handle Tsh h g (gv _c) v)
+              ctr_handle 1 h g (gv _c) v)
   POST [ tvoid ]
          PROP ()
          LOCAL ()
@@ -79,9 +63,9 @@ Definition dest_ctr_spec :=
 
 Definition incr_spec :=
  DECLARE _incr
-  WITH sh1 : share, sh : share, h : lock_handle, g : gname, n : nat, gv: globals
+  WITH sh1 : share, sh : Qp, h : lock_handle, g : gname, n : nat, gv: globals
   PRE [ ]
-         PROP  (readable_share sh1; sh <> Share.bot)
+         PROP  (readable_share sh1)
          PARAMS ()
          GLOBALS (gv)
          SEP (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c);
@@ -94,17 +78,17 @@ Definition incr_spec :=
 
 
 Definition thread_lock_R sh1 sh g ctr lockc :=
-  field_at sh1 t_counter [StructField _lock] (ptr_of lockc) ctr * ctr_handle sh lockc g ctr 1%nat.
+  field_at sh1 t_counter [StructField _lock] (ptr_of lockc) ctr ∗ ctr_handle sh lockc g ctr 1%nat.
 
 Definition thread_lock_inv sh1 tsh sh g ctr lockc lockt :=
   selflock (thread_lock_R sh1 sh g ctr lockc) tsh lockt.
 
 Definition thread_func_spec :=
  DECLARE _thread_func
-  WITH y : val, x : share * share * lock_handle * share * lock_handle * gname * globals
+  WITH y : val, x : share * Qp * lock_handle * Qp * lock_handle * gname * globals
   PRE [ tptr tvoid ]
          let '(sh1, tsh, ht, sh, h, g, gv) := x in
-         PROP  (readable_share sh1; tsh <> Share.bot; sh <> Share.bot; ptr_of ht = y)
+         PROP  (readable_share sh1; ptr_of ht = y)
          PARAMS (y)
          GLOBALS (gv)
          SEP   (field_at sh1 t_counter [StructField _lock] (ptr_of h) (gv _c); 
@@ -128,39 +112,45 @@ Lemma ctr_inv_exclusive : forall lg p,
   exclusive_mpred (cptr_lock_inv lg p).
 Proof.
   intros; unfold cptr_lock_inv.
-  eapply derives_exclusive, exclusive_sepcon1 with (Q := EX z : nat, _),
-    field_at__exclusive with (sh := Ews)(t := t_counter); auto; simpl; try lia.
-  Intro z; apply sepcon_derives; [cancel|].
-  Exists z; apply derives_refl.
+  iIntros "((% & ? & ?) & (% & ? & ?))".
+  rewrite !field_at_field_at_; iApply (field_at__conflict with "[$]"); auto.
+  { simpl; lia. }
+Qed.
+#[local] Hint Resolve ctr_inv_exclusive : core.
+
+Lemma thread_inv_exclusive : forall sh1 sh g p l,
+  sh1 <> Share.bot -> exclusive_mpred (thread_lock_R sh1 sh g p l).
+Proof.
+  intros; unfold thread_lock_R.
+  iIntros "((? & ? & ?) & (? & ? & ?))".
+  rewrite !field_at_field_at_; iApply (field_at__conflict with "[$]"); auto.
   { simpl; lia. }
 Qed.
-#[export] Hint Resolve ctr_inv_exclusive : core.
+#[local] Hint Resolve thread_inv_exclusive : core.
 
-Lemma ctr_handle_share_join : forall sh1 sh2 sh h g ctr v1 v2, sh1 <> Share.bot -> sh2 <> Share.bot -> sepalg.join sh1 sh2 sh ->
-  ctr_handle sh1 h g ctr v1 * ctr_handle sh2 h g ctr v2 = ctr_handle sh h g ctr (v1 + v2)%nat.
+Lemma ctr_handle_share_join : forall sh1 sh2 h g ctr v1 v2,
+  ctr_handle sh1 h g ctr v1 ∗ ctr_handle sh2 h g ctr v2 ⊣⊢ ctr_handle (sh1 ⋅ sh2) h g ctr (v1 + v2)%nat.
 Proof.
   intros; unfold ctr_handle.
-  erewrite (sepcon_comm (lock_inv _ _ _)), <- sepcon_assoc, (sepcon_assoc (ghost_part _ _ _)), lock_inv_share_join by eauto.
-  unfold ghost_part; erewrite (sepcon_comm (ghosts.ghost_part _ _ _)), sepcon_assoc, ghost_part_join; eauto.
-  reflexivity.
+  rewrite -lock_inv_share_join /ghost_part frac_auth_frag_op own_op.
+  apply bi.equiv_entails_2; cancel.
 Qed.
 
 Lemma body_init_ctr: semax_body Vprog Gprog f_init_ctr init_ctr_spec.
 Proof.
   start_function.
   forward.
-  ghost_alloc (ghost_both Tsh O O).
-  { split; auto.
-    apply (@self_completable sum_ghost). }
+  ghost_alloc (ghost_both 1 O O).
+  { by apply frac_auth_valid. }
   Intros g.
   forward_call (gv, fun _ : lock_handle => cptr_lock_inv g (gv _c)).
   Intros h.
   forward.
   forward.
-  forward_call release_simple (Tsh, h, cptr_lock_inv g (gv _c)).
+  forward_call release_simple (1%Qp, h, cptr_lock_inv g (gv _c)).
   { lock_props.
     unfold cptr_lock_inv.
-    unfold ghost_both; rewrite <- ghost_part_ref_join.
+    rewrite /ghost_both own_op.
     unfold_data_at (data_at _ _ _ _).
     unfold ghost_ref; Exists O; entailer!. }
   unfold ctr_handle, ghost_part; Exists h g; entailer!.
@@ -171,17 +161,17 @@ Proof.
   start_function.
   unfold ctr_handle; Intros.
   forward.
-  forward_call (Tsh, h, cptr_lock_inv g (gv _c)).
+  forward_call (1%Qp, h, cptr_lock_inv g (gv _c)).
   forward.
   forward_call freelock_simple (h, cptr_lock_inv g (gv _c)).
-  { lock_props. }
+  { lock_props; cancel. }
   unfold cptr_lock_inv.
   Intros z.
   entailer!.
-  unfold ghost_part, ghost_ref; sep_apply (ref_sub(P := sum_ghost)).
-  rewrite eq_dec_refl; Intros; subst.
-  unfold_data_at (data_at _ _ _ _); cancel.
-  rewrite <- sepcon_emp; apply sepcon_derives; apply own_dealloc.
+  iIntros "(? & ref & ? & ? & part)".
+  iDestruct (own_valid_2 with "ref part") as %Hv%frac_auth_agree.
+  inv Hv.
+  unfold_data_at (data_at _ _ _ _); iFrame.
 Qed.
 
 Lemma body_incr: semax_body Vprog Gprog f_incr incr_spec.
@@ -196,11 +186,11 @@ Proof.
   forward.
   forward.
   gather_SEP (ghost_part _ _ _) (ghost_ref _ _).
-  viewshift_SEP 0 (ghost_part sh (S n) g * ghost_ref (S z) g).
-  { go_lower.
-    unfold ghost_part, ghost_ref; rewrite !ghost_part_ref_join.
-    eapply derives_trans, bupd_fupd.
-    apply ref_add with (b := 1%nat); try (hnf; lia). }
+  viewshift_SEP 0 (ghost_part sh (S n) g ∗ ghost_ref (S z) g).
+  { go_lowerx.
+    iIntros "((part & ref) & _)".
+    iMod (own_update_2 with "ref part") as "($ & $)"; last done.
+    apply frac_auth_update, nat_local_update; lia. }
   Intros; forward_call release_simple (sh, h, cptr_lock_inv g (gv _c)).
   { lock_props.
     unfold cptr_lock_inv; Exists (S z).
@@ -217,11 +207,19 @@ Proof.
   forward.
   forward_call (sh1, sh, h, g, O, gv).
   forward_call release_self (tsh, ht, thread_lock_R sh1 sh g (gv _c) h).
-  { unfold thread_lock_inv, selflock, thread_lock_R; cancel. }
+  { lock_props.
+    unfold thread_lock_inv, selflock, thread_lock_R; cancel. }
   forward.
 Qed.
 
+Local Open Scope Z.
+
 Definition N := 5.
+Definition N_frac := (/ pos_to_Qp (Z.to_pos (N + 1)))%Qp.
+
+Global Instance namespace_inhabitant : Inhabitant namespace := nroot.
+
+Opaque Qp.div Qp.mul.
 
 Lemma body_main:  semax_body Vprog Gprog f_main main_spec.
 Proof.
@@ -233,143 +231,126 @@ Proof.
   (* need to split off shares for the locks and ghost here *)
   destruct split_Ews as (sh1 & sh2 & ? & ? & Hsh).
   destruct (split_shares (Z.to_nat N) Ews) as (sh0 & shs & ? & ? & ? & Hshs); auto.
-  destruct (split_shares (Z.to_nat N) Tsh) as (gsh0 & gshs & ? & ? & ? & Hgshs); auto.
-  rewrite Z2Nat.id in * by (unfold N; computable).
+  rewrite -> Z2Nat.id in * by (unfold N; lia).
   assert_PROP (field_compatible (tarray (tptr t_lock) N) [] v_thread_lock) by entailer!.
   assert (N <= Int.max_signed) by computable.
-  forward_for_simple_bound N (EX i : Z, EX sh : share, EX gsh : share, EX ll : list lock_handle,
+  forward_for_simple_bound N (∃ i : Z, ∃ sh : share, ∃ ll : list lock_handle,
     PROP (sepalg_list.list_join sh0 (sublist i N shs) sh;
-          sepalg_list.list_join gsh0 (sublist i N gshs) gsh;
           Zlength ll = i; Forall isptr (map ptr_of ll))
     LOCAL (lvar _thread_lock (tarray (tptr t_lock) N) v_thread_lock; gvars gv)
     SEP (library.mem_mgr gv; field_at sh t_counter (DOT _lock) (ptr_of h) (gv _c);
-         spacer Ews 4 8 (gv _c); ctr_handle gsh h g (gv _c) O;
-         iter_sepcon (fun j => lock_inv gsh1 (Znth j ll)
-           (thread_lock_inv (Znth j shs) gsh2 (Znth j gshs) g (gv _c) h (Znth j ll)))
-           (upto (Z.to_nat i));
+         spacer Ews 4 8 (gv _c); ctr_handle (pos_to_Qp (Z.to_pos (N - i + 1)) * N_frac)%Qp h g (gv _c) O;
+         [∗ list] j ∈ seq 0 (Z.to_nat i), lock_inv (1/2) (Znth (Z.of_nat j) ll)
+           (thread_lock_inv (Znth (Z.of_nat j) shs) (1/2) N_frac g (gv _c) h (Znth (Z.of_nat j) ll));
          data_at Tsh (tarray (tptr t_lock) N) (map ptr_of ll ++ repeat Vundef (Z.to_nat (N - i))) v_thread_lock; has_ext tt))%assert.
-  { Exists Ews Tsh (@nil lock_handle).
-    rewrite !sublist_same by auto; entailer!.
-    rewrite data_at__eq; apply derives_refl. }
+  { Exists Ews (@nil lock_handle).
+    rewrite -> !sublist_same by auto; rewrite Qp.mul_inv_r; entailer!. }
   { (* first loop *)
-    forward_call (gv, fun ht => thread_lock_inv (Znth i shs) gsh2 (Znth i gshs) g (gv _c) h ht).
+    forward_call (gv, fun ht => thread_lock_inv (Znth i shs) (1/2) N_frac g (gv _c) h ht).
     Intros ht.
     forward.
     assert_PROP (0 <= i < Zlength (map ptr_of ll ++ repeat Vundef (Z.to_nat (N - i)))) as Hi.
-    { entailer!. rewrite Zlength_app, Zlength_map, Zlength_repeat, Zplus_minus by lia; auto. }
+    { entailer!. rewrite -> Zlength_app, Zlength_map, Zlength_repeat, Zplus_minus by lia; auto. }
     forward.
-    { rewrite upd_Znth_same by auto; entailer!. }
-    rewrite upd_Znth_same by auto.
+    { rewrite -> upd_Znth_same by auto; entailer!. }
+    rewrite -> upd_Znth_same by auto.
     assert (readable_share (Znth (Zlength ll) shs)) as Hshi by (apply Forall_Znth; auto; lia).
-    rewrite sublist_next in H10, H11 by lia.
-    inv H10; inv H11.
-    destruct (sepalg_list.list_join_assoc1 (sepalg.join_comm H17) H19) as (sh' & ? & Hsh').
-    destruct (sepalg_list.list_join_assoc1 (sepalg.join_comm H15) H18) as (gsh' & ? & Hgsh').
-    assert (Znth (Zlength ll) gshs <> Share.bot).
-    { intro X; contradiction bot_unreadable.
-      rewrite <- X; apply Forall_Znth; auto; lia. }
-    assert (gsh' <> Share.bot).
-    { intro X; contradiction bot_unreadable.
-      rewrite <- X; eapply readable_share_list_join; eauto. }
+    rewrite -> sublist_next in H7 by lia; inv H7.
+    destruct (sepalg_list.list_join_assoc1 (sepalg.join_comm H13) H15) as (sh' & ? & Hsh').
     sep_apply lock_inv_isptr; Intros.
-    forward_spawn _thread_func (ptr_of ht) (Znth (Zlength ll) shs, gsh2, ht, Znth (Zlength ll) gshs, h, g, gv).
-    { erewrite <- lock_inv_share_join; try apply gsh1_gsh2_join; auto.
+    forward_spawn _thread_func (ptr_of ht) (Znth (Zlength ll) shs, (1/2)%Qp, ht, N_frac, h, g, gv).
+    { rewrite -{1}Qp.half_half -frac_op -lock_inv_share_join.
       erewrite <- field_at_share_join; try apply Hsh'.
-      change O with (O + O)%nat.
-      erewrite <- ctr_handle_share_join; try apply Hgsh'; auto; simpl.
-      entailer!. }
+      replace (pos_to_Qp (Z.to_pos _)) with (1 + pos_to_Qp (Z.to_pos (N - Zlength ll)))%Qp.
+      rewrite Qp.mul_add_distr_r Qp.mul_1_l -frac_op.
+      rewrite -(ctr_handle_share_join _ _ _ _ _ O O).
+      entailer!.
+      { rewrite -> (Z2Pos.inj_add _ 1) by lia.
+        rewrite !pos_to_Qp_add; f_equal; lia. } }
     { simpl; auto. }
-    Exists sh' gsh' (ll ++ [ht]); entailer!.
-    { split; [autorewrite with sublist; auto | rewrite map_app, Forall_app; repeat constructor; auto]. }
-    apply sepcon_derives.
-    - rewrite Z2Nat.inj_add, upto_app by lia.
-      rewrite iter_sepcon_app; simpl.
-      rewrite Z2Nat.id, Z.add_0_r, app_Znth2, Zminus_diag, Znth_0_cons by (tauto || lia); cancel.
-      rewrite Zlength_correct, Nat2Z.id; apply iter_sepcon_derives; intros ??%In_upto.
-      rewrite <- Zlength_correct in *; autorewrite with sublist; auto.
-    - rewrite upd_complete_gen' by tauto; autorewrite with sublist; apply derives_refl. }
-  rewrite !sublist_nil, Zminus_diag; Intros shx gshx ll.
-  inv H9; inv H10.
-  forward_for_simple_bound N (EX i : Z, EX sh : share, EX gsh : share,
-    PROP (sepalg_list.list_join shx (sublist 0 i shs) sh;
-          sepalg_list.list_join gshx (sublist 0 i gshs) gsh)
+    Exists sh' (ll ++ [ht]); entailer!.
+    { split; [autorewrite with sublist; auto | rewrite map_app Forall_app; repeat constructor; auto]. }
+    rewrite !sep_assoc; apply bi.sep_mono.
+    - unfold ctr_handle.
+      replace (Z.to_pos (N - (Zlength ll + 1) + 1)) with (Z.to_pos (N - Zlength ll)) by lia; cancel.
+      rewrite -> Z2Nat.inj_add by lia. rewrite Nat.add_comm seq_S big_sepL_app /=.
+      rewrite -> Z2Nat.id, app_Znth2, Zminus_diag, Znth_0_cons by (tauto || lia); cancel.
+      rewrite Zlength_correct Nat2Z.id; apply big_sepL_mono; intros ?? (-> & ?)%lookup_seq.
+      assert (Z.of_nat k < Zlength ll) by (rewrite Zlength_correct; apply inj_lt; auto).
+      rewrite app_Znth1 //.
+    - rewrite -> upd_complete_gen' by tauto; autorewrite with sublist; apply derives_refl. }
+  rewrite !sublist_nil Zminus_diag; Intros shx ll.
+  inv H6.
+  forward_for_simple_bound N (∃ i : Z, ∃ sh : share,
+    PROP (sepalg_list.list_join shx (sublist 0 i shs) sh)
     LOCAL (lvar _thread_lock (tarray (tptr t_lock) N) v_thread_lock; gvars gv)
     SEP (library.mem_mgr gv; field_at sh t_counter (DOT _lock) (ptr_of h) (gv _c);
-         spacer Ews 4 8 (gv _c); ctr_handle gsh h g (gv _c) (Z.to_nat i);
-         iter_sepcon (fun j => lock_inv gsh1 (Znth j ll)
-           (thread_lock_inv (Znth j shs) gsh2 (Znth j gshs) g (gv _c) h (Znth j ll)))
-           (sublist i N (upto (Z.to_nat N)));
+         spacer Ews 4 8 (gv _c); ctr_handle (pos_to_Qp (Z.to_pos (i + 1)) * N_frac)%Qp h g (gv _c) (Z.to_nat i);
+         [∗ list] j ∈ seq (Z.to_nat i) (Z.to_nat N - Z.to_nat i), lock_inv (1/2) (Znth (Z.of_nat j) ll)
+           (thread_lock_inv (Znth j shs) (1/2) N_frac g (gv _c) h (Znth j ll));
          data_at Tsh (tarray (tptr t_lock) N) (map ptr_of ll) v_thread_lock; has_ext tt))%assert.
-  { rewrite !sublist_nil, sublist_same, app_nil_r by (auto; lia).
-    Exists shx gshx; entailer!.
-    { split; constructor. }
+  { rewrite -> !sublist_nil, app_nil_r by (auto; lia).
+    Exists shx; entailer!.
+    { constructor. }
     apply derives_refl. }
   { (* second loop *)
     forward.
     { entailer!. apply isptr_is_pointer_or_null, Forall_Znth; auto.
       rewrite Zlength_map; simpl in *; replace (Zlength ll) with N; auto. }
     Opaque N.
-    rewrite sublist_next; auto; simpl.
-    rewrite Znth_upto by auto.
-    forward_call (gsh1, Znth i ll, thread_lock_inv (Znth i shs) gsh2 (Znth i gshs) g (gv _c) h (Znth i ll)).
-    { rewrite Znth_map by (simpl in *; lia); entailer!. }
+    destruct (Z.to_nat N - Z.to_nat i)%nat eqn: Hsub; [lia|].
+    rewrite -cons_seq /= Z2Nat.id; last lia.
+    forward_call ((1/2)%Qp, Znth i ll, thread_lock_inv (Znth i shs) (1/2) N_frac g (gv _c) h (Znth i ll)).
+    { rewrite -> Znth_map by (simpl in *; lia); entailer!. }
     { cancel. }
     unfold thread_lock_inv at 2; unfold thread_lock_R, selflock; Intros.
     forward.
     unfold thread_lock_inv.
-    forward_call freelock_self (gsh1, gsh2, Znth i ll, thread_lock_R (Znth i shs) (Znth i gshs) g (gv _c) h).
-    { rewrite Znth_map by (simpl in *; lia); entailer!. }
+    forward_call freelock_self ((1/2)%Qp, (1/2)%Qp, Znth i ll, thread_lock_R (Znth i shs) N_frac g (gv _c) h).
+    { rewrite -> Znth_map by (simpl in *; lia); entailer!. }
     { unfold selflock; cancel. }
+    { apply Qp.half_half. }
     erewrite <- sublist_same with (al := shs) in Hshs by eauto.
-    erewrite <- sublist_same with (al := gshs) in Hgshs by eauto.
-    rewrite sublist_split with (mid := i) in Hshs, Hgshs by lia.
-    rewrite sublist_next with (i := i) in Hshs by lia.
-    rewrite sublist_next with (i := i) in Hgshs by lia.
-    rewrite app_cons_assoc in Hshs, Hgshs.
+    rewrite -> sublist_split with (mid := i) in Hshs by lia.
+    rewrite -> sublist_next with (i := i) in Hshs by lia.
+    rewrite app_cons_assoc in Hshs.
     apply sepalg_list.list_join_unapp in Hshs as (sh' & Hshs1 & ?).
-    apply sepalg_list.list_join_unapp in Hgshs as (gsh' & Hgshs1 & ?).
     apply sepalg_list.list_join_unapp in Hshs1 as (? & J & J1).
-    apply sepalg_list.list_join_unapp in Hgshs1 as (? & Jg & Jg1).
-    apply list_join_eq with (c := sh) in J; auto; subst.
-    apply list_join_eq with (c := gsh) in Jg; auto; subst.
-    rewrite <- sepalg_list.list_join_1 in J1, Jg1.
-    rewrite !(sublist_split 0 i (i + 1)), !sublist_len_1 by lia.
-    Exists sh' gsh'; entailer!.
-    { split; eapply sepalg_list.list_join_app; eauto; econstructor; eauto; constructor. }
+    apply sepalg_list.list_join_eq with (c := sh) in J; auto; subst.
+    rewrite <- sepalg_list.list_join_1 in J1.
+    rewrite -> !(sublist_split 0 i (i + 1)), !sublist_len_1 by lia.
+    Exists sh'; entailer!.
+    { eapply sepalg_list.list_join_app; eauto; econstructor; eauto; constructor. }
     unfold thread_lock_R.
-    sep_eapply field_at_share_join; [apply sepalg.join_comm; eauto|].
-    sep_eapply ctr_handle_share_join; try (apply sepalg.join_comm; eauto).
-    { intros X; contradiction unreadable_bot; rewrite <- X; apply Forall_Znth; auto; lia. }
-    { intros X; contradiction unreadable_bot; rewrite <- X.
-      eapply readable_share_list_join; eauto. }
-    rewrite Z2Nat.inj_add, plus_comm by lia; simpl; unfold thread_lock_inv, thread_lock_R, selflock; cancel.
-    { rewrite Zlength_upto; lia. } }
-  Intros sh' gsh'.
-  eapply list_join_eq in Hshs; [|erewrite <- (sublist_same 0 N shs) by auto; eauto].
-  eapply list_join_eq in Hgshs; [|erewrite <- (sublist_same 0 N gshs) by auto; eauto].
+    rewrite -(field_at_share_join _ _ sh') //.
+    replace (pos_to_Qp (Z.to_pos (i + 1 + 1))) with (pos_to_Qp (Z.to_pos (i + 1)) + 1)%Qp.
+    rewrite Qp.mul_add_distr_r Qp.mul_1_l -frac_op Z2Nat.inj_add; [|lia..].
+    rewrite -ctr_handle_share_join Nat.add_comm /=.
+    replace (Z.to_nat N - S (Z.to_nat i))%nat with n by lia.
+    cancel; apply derives_refl.
+    { rewrite pos_to_Qp_add; f_equal; lia. } }
+  Intros sh'.
+  eapply sepalg_list.list_join_eq in Hshs; [|erewrite <- (sublist_same 0 N shs) by auto; eauto].
   subst.
+  rewrite Nat.sub_diag Qp.mul_inv_r.
   forward_call (h, g, Z.to_nat N, gv).
   forward.
-  rewrite Z2Nat.id by auto.
+  rewrite -> Z2Nat.id by auto.
   (* We've proved that t is N! *)
   forward.
   { repeat sep_apply data_at_data_at_; cancel. }
 Qed.
 
-Definition extlink := ext_link_prog prog.
-Definition Espec := add_funspecs (Concurrent_Espec unit _ extlink) extlink Gprog.
-#[export] Existing Instance Espec.
-
 Lemma prog_correct:
   semax_prog prog tt Vprog Gprog.
 Proof.
 prove_semax_prog.
 semax_func_cons_ext.
 { simpl.
-  Intros h.
-  unfold PROPx, LOCALx, SEPx, local, lift1; simpl; unfold liftx; simpl; unfold lift; Intros.
+  destruct x.
+  unfold PROPx, LOCALx, SEPx, local, lift1; monPred.unseal; simpl; unfold_lift; Intros h.
   destruct ret; unfold eval_id in H0; simpl in H0; subst; simpl; [|contradiction].
-  saturate_local; apply prop_right; auto. }
+  saturate_local; apply bi.pure_intro; auto. }
 do 4 semax_func_cons_ext.
 semax_func_cons body_init_ctr.
 semax_func_cons body_dest_ctr.
@@ -377,3 +358,5 @@ semax_func_cons body_incr.
 semax_func_cons body_thread_func.
 semax_func_cons body_main.
 Qed.
+
+End proofs.
diff --git a/progs64/verif_io.v b/progs64/verif_io.v
index d461b2c940..260a3a1b01 100644
--- a/progs64/verif_io.v
+++ b/progs64/verif_io.v
@@ -1,12 +1,17 @@
 Require Import VST.progs64.io.
 Require Import VST.progs64.io_specs.
 Require Import VST.floyd.proofauto.
+Require Import ITree.Core.ITreeDefinition.
 
 Local Open Scope itree_scope.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
+Section IO.
+
+Context `{!VSTGS (@IO_itree (IO_event(file_id := nat))) Σ}.
+
 Definition putchar_spec := DECLARE _putchar putchar_spec.
 Definition getchar_spec := DECLARE _getchar getchar_spec.
 
@@ -19,7 +24,7 @@ Definition getchar_blocking_spec :=
     GLOBALS ()
     SEP (ITREE (r <- read stdin;; k r))
   POST [ tint ]
-   EX i : byte,
+   ∃ i : byte,
     PROP ()
     LOCAL (temp ret_temp (Vubyte i))
     SEP (ITREE (k i)).
@@ -46,16 +51,19 @@ Proof.
   rewrite <- Nat2Z.inj_div by discriminate.
   rewrite !Nat2Z.id.
   apply Nat2Z.inj_lt.
-  rewrite Nat2Z.inj_div, Z2Nat.id by lia; simpl.
+  rewrite -> Nat2Z.inj_div, Z2Nat.id by lia; simpl.
   apply Z.div_lt; auto; lia.
 Qed.
 
+Local Obligation Tactic := unfold RelationClasses.complement, Equivalence.equiv;
+  Tactics.program_simpl.
+
 Program Fixpoint chars_of_Z (n : Z) { measure (Z.to_nat n) } : list byte :=
   let n' := n / 10 in
   match n' <=? 0 with true => [Byte.repr (n + char0)] | false => chars_of_Z n' ++ [Byte.repr (n mod 10 + char0)] end.
 Next Obligation.
 Proof.
-  rewrite ?Zaux.Zdiv_eucl_unique in *.  (* Coq 8.15 and after *)
+  rewrite -> ?Zaux.Zdiv_eucl_unique in *.  (* Coq 8.15 and after *)
   apply div_10_dec.
   symmetry in Heq_anonymous; apply Z.leb_nle in Heq_anonymous.
   eapply Z.lt_le_trans, Z_mult_div_ge with (b := 10); lia.
@@ -69,7 +77,6 @@ Program Fixpoint intr n { measure (Z.to_nat n) } : list byte :=
   end.
 Next Obligation.
 Proof.
-  rewrite ?Zaux.Zdiv_eucl_unique in *.  (* Coq 8.15 and after *)
   apply div_10_dec.
   symmetry in Heq_anonymous; apply Z.leb_nle in Heq_anonymous; lia.
 Defined.
@@ -164,14 +171,12 @@ Lemma body_getchar_blocking: semax_body Vprog Gprog f_getchar_blocking getchar_b
 Proof.
   start_function.
   forward.
-  forward_while (EX i : int, PROP (-1 <= Int.signed i <= two_p 8 - 1) LOCAL (temp _r (Vint i))
+  forward_while (∃ i : int, PROP (-1 <= Int.signed i <= two_p 8 - 1) LOCAL (temp _r (Vint i))
     SEP (ITREE (if eq_dec (Int.signed i) (-1) then (r <- read stdin;; k r) else k (Byte.repr (Int.signed i))))).
-  - Exists (Int.neg (Int.repr 1)); entailer!.
-    { simpl; lia. }
-    rewrite if_true; auto.
+  - Exists (Int.neg (Int.repr 1)); simpl; entailer!.
   - entailer!.
-  - subst; rewrite Int.signed_repr by rep_lia.
-    rewrite if_true by auto.
+  - subst; rewrite -> Int.signed_repr by rep_lia.
+    rewrite -> if_true by auto.
     forward_call k.
     Intros i.
     forward.
@@ -180,10 +185,10 @@ Proof.
     { intro X.
       apply f_equal with (f := Int.repr) in X.
       rewrite Int.repr_signed in X; auto. }
-    rewrite if_false by auto.
+    rewrite -> if_false by auto.
     forward.
     Exists (Byte.repr (Int.signed i)); entailer!.
-    unfold Vubyte; rewrite Byte.unsigned_repr, Int.repr_signed; auto.
+    unfold Vubyte; rewrite -> Byte.unsigned_repr, Int.repr_signed; auto.
     split; try lia.
     etransitivity; [apply H|].
     simpl; rep_lia.
@@ -193,13 +198,11 @@ Lemma body_putchar_blocking: semax_body Vprog Gprog f_putchar_blocking putchar_b
 Proof.
   start_function.
   forward.
-  forward_while (EX i : int, PROP (Int.signed i = -1 \/ Int.signed i = Byte.unsigned c) LOCAL (temp _r (Vint i); temp _c (Vubyte c))
+  forward_while (∃ i : int, PROP (Int.signed i = -1 \/ Int.signed i = Byte.unsigned c) LOCAL (temp _r (Vint i); temp _c (Vubyte c))
     SEP (ITREE (if eq_dec (Int.signed i) (-1) then (r <- write stdout c;; k) else k))).
-  - Exists (Int.neg (Int.repr 1)); entailer!.
-    rewrite if_true; auto.
+  - Exists (Int.neg (Int.repr 1)); simpl; entailer!.
   - entailer!.
-  - subst; rewrite Int.signed_repr by rep_lia.
-    rewrite if_true by auto.
+  - subst; rewrite -> if_true by auto.
     forward_call (c, k).
     Intros i.
     forward.
@@ -208,7 +211,7 @@ Proof.
     { intro X.
       apply f_equal with (f := Int.repr) in X.
       rewrite Int.repr_signed in X; auto. }
-    rewrite if_false by auto.
+    rewrite -> if_false by auto.
     destruct H; [contradiction | subst].
     forward.
     entailer!.
@@ -222,10 +225,10 @@ Proof.
   forward_if (PROP () LOCAL () SEP (ITREE tr)).
   - forward.
     forward.
-    rewrite modu_repr, divu_repr by (lia || computable).
+    rewrite -> modu_repr, divu_repr by (lia || computable).
     rewrite intr_eq.
     destruct (Z.leb_spec i 0); try lia.
-    rewrite write_list_app, bind_bind.
+    rewrite write_list_app bind_bind.
     forward_call (i / 10, write_list stdout [Byte.repr (i mod 10 + char0)];; tr).
     { split; [apply Z.div_pos; lia | apply Z.div_le_upper_bound; lia]. }
     simpl write_list.
@@ -233,13 +236,10 @@ Proof.
     { entailer!.
       unfold Vubyte; rewrite Byte.unsigned_repr; auto.
       pose proof (Z_mod_lt i 10); unfold char0; rep_lia. }
-    { rewrite <- sepcon_emp at 1; apply sepcon_derives; [|cancel].
-      rewrite bind_ret'; auto. }
+    { rewrite bind_ret'; cancel. }
     entailer!.
   - forward.
-    subst; entailer!.
-    simpl.
-    rewrite bind_ret_l; auto.
+    entailer!.
 Qed.
 
 Lemma chars_of_Z_eq : forall n, chars_of_Z n =
@@ -256,10 +256,10 @@ Lemma chars_of_Z_intr : forall n, 0 < n ->
   chars_of_Z n = intr n.
 Proof.
   induction n using (well_founded_induction (Zwf.Zwf_well_founded 0)); intro.
-  rewrite chars_of_Z_eq, intr_eq.
+  rewrite chars_of_Z_eq intr_eq.
   destruct (n <=? 0) eqn: Hn; [apply Zle_bool_imp_le in Hn; lia|].
   simpl.
-  rewrite ?Zaux.Zdiv_eucl_unique in *.  (* Coq 8.15 and after *)
+  rewrite -> ?Zaux.Zdiv_eucl_unique in *.  (* Coq 8.15 and after *)
   destruct (n / 10 <=? 0) eqn: Hdiv.
   - apply Zle_bool_imp_le in Hdiv.
     assert (0 <= n / 10).
@@ -281,11 +281,10 @@ Proof.
   - subst.
     forward_call (Byte.repr char0, tr).
     { rewrite chars_of_Z_eq; simpl.
-      erewrite <- sepcon_emp at 1; apply sepcon_derives; [|cancel].
-      rewrite bind_ret'; apply derives_refl. }
+      rewrite bind_ret' /char0; cancel. }
     entailer!.
   - forward_call (i, tr).
-    { rewrite chars_of_Z_intr by lia; cancel. }
+    { rewrite -> chars_of_Z_intr by lia; cancel. }
     entailer!.
 Qed.
 
@@ -324,13 +323,13 @@ Proof.
   forward_call (fun c => read_sum 0 (Byte.unsigned c - char0)).
   Intros c.
   forward.
-  rewrite zero_ext_inrange by (pose proof (signed_char_unsigned c); rewrite Int.unsigned_repr; rep_lia).
-  set (Inv := EX n : Z, EX c : byte,
+  rewrite -> zero_ext_inrange by (pose proof (signed_char_unsigned c); rewrite Int.unsigned_repr; rep_lia).
+  set (Inv := ∃ n : Z, ∃ c : byte,
     PROP (0 <= n < 1009)
     LOCAL (temp _c (Vubyte c); temp _n (Vint (Int.repr n)))
     SEP (ITREE (read_sum n (Byte.unsigned c - char0)))).
   unfold Swhile; forward_loop Inv break: Inv.
-  { Exists 0 c; entailer!. }
+  { unfold Inv; Exists 0 c; entailer!. }
   subst Inv.
   clear dependent c; Intros n c.
   forward_if.
@@ -342,9 +341,9 @@ Proof.
   destruct (zlt (Byte.unsigned c) char0).
   { rewrite Int.unsigned_repr_eq in H1.
     rewrite <- Z_mod_plus_full with (b := 1), Zmod_small in H1; unfold char0 in *; rep_lia. }
-  rewrite Int.unsigned_repr in H1 by (unfold char0 in *; rep_lia).
+  rewrite -> Int.unsigned_repr in H1 by (unfold char0 in *; rep_lia).
   rewrite read_sum_eq.
-  rewrite if_true by auto.
+  rewrite -> if_true by auto.
   destruct (zlt _ _); [|unfold char0 in *; lia].
   forward_call (n + (Byte.unsigned c - char0),
     write stdout (Byte.repr newline);; c' <- read stdin;; read_sum (n + (Byte.unsigned c - char0)) (Byte.unsigned c' - char0)).
@@ -352,7 +351,7 @@ Proof.
   forward_call (fun c' => read_sum (n + (Byte.unsigned c - char0)) (Byte.unsigned c' - char0)).
   Intros c'.
   forward.
-  rewrite zero_ext_inrange by (pose proof (signed_char_unsigned c'); rewrite Int.unsigned_repr; rep_lia).
+  rewrite -> zero_ext_inrange by (pose proof (signed_char_unsigned c'); rewrite Int.unsigned_repr; rep_lia).
   Exists (n + (Byte.unsigned c - char0)) c'; entailer!.
   { forward.
     Exists n c; entailer!. }
@@ -363,7 +362,7 @@ Qed.
 
 Definition ext_link := ext_link_prog prog.
 
-#[export] Instance Espec : OracleKind := IO_Espec ext_link.
+#[local] Instance IO_ext_spec : ext_spec IO_itree := IO_ext_spec ext_link.
 
 Lemma prog_correct:
   semax_prog prog main_itree Vprog Gprog.
@@ -371,10 +370,11 @@ Proof.
 prove_semax_prog.
 Import extcall_lemmas.
 semax_func_cons_ext.
-{ simpl; Intro i.
+{ simpl; monPred.unseal; Intro i.
   apply typecheck_return_value with (t := Xint16signed); auto. }
 semax_func_cons_ext.
-{ simpl; Intro i'.
+{ destruct x as (c, k).
+  simpl; monPred.unseal; Intro i'.
   apply typecheck_return_value with (t := Xint16signed); auto. }
 semax_func_cons body_getchar_blocking.
 semax_func_cons body_putchar_blocking.
@@ -383,8 +383,12 @@ semax_func_cons body_print_int.
 semax_func_cons body_main.
 Qed.
 
-Require Import VST.veric.SequentialClight.
-Require Import VST.progs64.io_dry.
+End IO.
+
+Require Import VST.progs64.os_combine.
+Require Import VST.progs64.io_combine.
+Require Import VST.progs64.io_os_specs.
+Require Import VST.progs64.io_os_connection.
 
 Lemma init_mem_exists : { m | Genv.init_mem prog = Some m }.
 Proof.
@@ -395,11 +399,16 @@ Ltac alloc_block m n := match n with
     destruct (dry_mem_lemmas.drop_alloc m) as [m' Hm']; alloc_block m' n'
   end.
 try first [
-  (* This version works in Coq 8.15, CompCert 3.10 *)
+  (* This version works in Coq 8.19, CompCert 3.15 *)
+  alloc_block Mem.empty 63%nat;
+  eexists; repeat match goal with H : ?a = _ |- match ?a with Some m' => _ | None => None end = _ => rewrite H end;
+  reflexivity
+ |
+  (* This version worked in Coq 8.15, CompCert 3.10 *)
   alloc_block Mem.empty 62%nat;
   eexists; repeat match goal with H : ?a = _ |- match ?a with Some m' => _ | None => None end = _ => rewrite H end;
   reflexivity
- | 
+ |
   (* This version worked in Coq 8.13, CompCert 3.9 *)
   alloc_block Mem.empty 60%nat;
   eexists; repeat match goal with H : ?a = _ |- match ?a with Some m' => _ | None => None end = _ => rewrite H end;
@@ -417,38 +426,6 @@ Qed.
 
 Definition main_block := proj1_sig main_block_exists.
 
-Axiom (Jsub: forall ef se lv m t v m' (EFI : ef_inline ef = true) m1
-       (EFC : Events.external_call ef se lv m t v m'), juicy_mem.mem_sub m m1 ->
-       exists m1' (EFC1 : Events.external_call ef se lv m1 t v m1'),
-         juicy_mem.mem_sub m' m1' /\ proj1_sig (Clight_core.inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC1) =
-         proj1_sig (Clight_core.inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC)).
-
-Theorem prog_ext_correct : exists q,
-  semantics.initial_core (Clight_core.cl_core_sem (globalenv prog)) 0 init_mem q init_mem (Vptr main_block Ptrofs.zero) [] /\
-  forall n, @step_lemmas.dry_safeN _ _ _ _ semax.genv_symb_injective (Clight_core.cl_core_sem (globalenv prog))
-             (io_dry_spec ext_link) {| genv_genv := Genv.globalenv prog; genv_cenv := prog_comp_env prog |} n
-            main_itree q init_mem.
-Proof.
-  edestruct whole_program_sequential_safety_ext with (V := Vprog) as (b & q & Hb & Hq & Hsafe).
-  - repeat intro; hnf.
-    apply I.
-  - apply Jsub.
-  - apply add_funspecs_frame.
-  - apply juicy_dry_specs.
-  - apply dry_spec_mem.
-  - intros; apply I.
-  - apply CSHL_Sound.semax_prog_sound, prog_correct.
-  - apply (proj2_sig init_mem_exists).
-  - exists q.
-    rewrite (proj2_sig main_block_exists) in Hb; inv Hb.
-    split; auto.
-Qed.
-
-Require Import VST.progs64.os_combine.
-Require Import VST.progs64.io_combine.
-Require Import VST.progs64.io_os_specs.
-Require Import VST.progs64.io_os_connection.
-
 (* correctness down to OS traces, with relationship between syscall events and actual external reads/writes *)
 Theorem prog_OS_correct : forall {H : io_os_specs.ThreadsConfigurationOps},
   exists q,
@@ -459,9 +436,11 @@ Theorem prog_OS_correct : forall {H : io_os_specs.ThreadsConfigurationOps},
       valid_trace_user s.(io_log).
 Proof.
   intros.
-  edestruct IO_OS_ext with (V := Vprog) as (b & q & Hb & Hq & Hsafe).
-  - apply Jsub.
-  - apply prog_correct.
+  edestruct (IO_OS_ext prog) with (V := Vprog) as (b & q & Hb & Hq & Hsafe).
+  - intros ?? [<- | [<- | ?]]; last done;
+      rewrite /ext_link /ext_link_prog /prog /=; repeat (if_tac; first done); done.
+  - apply lifting.subG_VSTGpreS, subG_refl.
+  - intros; simple apply (@prog_correct _ VSTGS0).
   - apply (proj2_sig init_mem_exists).
   - exists q.
     rewrite (proj2_sig main_block_exists) in Hb; inv Hb.
diff --git a/progs64/verif_io_mem.v b/progs64/verif_io_mem.v
index 0068890ec0..9904717eae 100644
--- a/progs64/verif_io_mem.v
+++ b/progs64/verif_io_mem.v
@@ -2,12 +2,17 @@ Require Import VST.progs64.io_mem.
 Require Import VST.progs64.io_mem_specs.
 Require Import VST.floyd.proofauto.
 Require Import VST.floyd.library.
+Require Import ITree.Core.ITreeDefinition.
 
 Local Open Scope itree_scope.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
+Section IO.
+
+Context `{!VSTGS (@IO_itree (IO_event(file_id := nat))) Σ}.
+
 Definition putchars_spec := DECLARE _putchars putchars_spec.
 Definition getchars_spec := DECLARE _getchars getchars_spec.
 
@@ -20,16 +25,19 @@ Proof.
   rewrite <- Nat2Z.inj_div by discriminate.
   rewrite !Nat2Z.id.
   apply Nat2Z.inj_lt.
-  rewrite Nat2Z.inj_div, Z2Nat.id by lia; simpl.
+  rewrite -> Nat2Z.inj_div, Z2Nat.id by lia; simpl.
   apply Z.div_lt; auto; lia.
 Qed.
 
+Local Obligation Tactic := unfold RelationClasses.complement, Equivalence.equiv;
+  Tactics.program_simpl.
+
 Program Fixpoint chars_of_Z (n : Z) { measure (Z.to_nat n) } : list byte :=
   let n' := n / 10 in
   match n' <=? 0 with true => [Byte.repr (n + char0)] | false => chars_of_Z n' ++ [Byte.repr (n mod 10 + char0)] end.
 Next Obligation.
 Proof.
-  rewrite ?Zaux.Zdiv_eucl_unique in *.  (* Coq 8.15 and after *)
+  rewrite -> ?Zaux.Zdiv_eucl_unique in *.  (* Coq 8.15 and after *)
   apply div_10_dec.
   symmetry in Heq_anonymous; apply Z.leb_nle in Heq_anonymous.
   eapply Z.lt_le_trans, Z_mult_div_ge with (b := 10); lia.
@@ -112,11 +120,7 @@ Proof.
   rewrite !Int.unsigned_repr; auto.
 Qed.
 
-(*Opaque bind.
-
-Opaque Nat.div Nat.modulo.*)
-
-Import Program.Wf. 
+Import Program.Wf.
   Program Lemma fix_sub_eq_ext :
    (* need to copy this from Coq standard library because it moved from
     one location to another between Coq 8.20 and Coq 8.21 *)
@@ -166,14 +170,14 @@ Proof.
   rewrite (intr_eq n).
   destruct (n <=? 0) eqn: Hn.
   { apply Zle_bool_imp_le in Hn; lia. }
-  rewrite Zlength_app, Zlength_cons, Zlength_nil; lia.
+  rewrite -> Zlength_app, Zlength_cons, Zlength_nil; lia.
 Qed.
 
 Lemma replace_list_nil : forall {X} i (l : list X), 0 <= i <= Zlength l -> replace_list i l [] = l.
 Proof.
   intros; unfold replace_list.
-  rewrite Zlength_nil, Z.add_0_r; simpl.
-  rewrite sublist_rejoin, sublist_same by lia; auto.
+  rewrite -> Zlength_nil, Z.add_0_r; simpl.
+  rewrite -> sublist_rejoin, sublist_same by lia; auto.
 Qed.
 
 Lemma replace_list_upd_snoc : forall {X} i (l l' : list X) x, 0 <= i -> i + Zlength l' < Zlength l ->
@@ -182,13 +186,13 @@ Proof.
   intros; unfold replace_list.
   rewrite upd_Znth_app2; rewrite ?Zlength_sublist; try rep_lia.
   f_equal.
-  rewrite Z.sub_0_r, Z.add_simpl_l, upd_Znth_app2; rewrite ?Zlength_sublist; try rep_lia.
-  rewrite Zminus_diag, Zlength_app, Zlength_cons, Zlength_nil, upd_Znth0_old, <- app_assoc; simpl; f_equal; f_equal.
-  rewrite Zlength_sublist by rep_lia.
-  rewrite sublist_sublist by rep_lia.
+  rewrite -> Z.sub_0_r, Z.add_simpl_l, upd_Znth_app2; rewrite ?Zlength_sublist; try rep_lia.
+  rewrite -> Zminus_diag, Zlength_app, Zlength_cons, Zlength_nil, upd_Znth0_old, <- app_assoc; simpl; f_equal; f_equal.
+  rewrite -> Zlength_sublist by rep_lia.
+  rewrite -> sublist_sublist by rep_lia.
   f_equal; lia.
   { rewrite Zlength_sublist; rep_lia. }
-  { rewrite Zlength_app, Zlength_sublist; rep_lia. }
+  { rewrite -> Zlength_app, Zlength_sublist; rep_lia. }
 Qed.
 
 Lemma body_print_intr: semax_body Vprog Gprog f_print_intr print_intr_spec.
@@ -199,17 +203,17 @@ Proof.
     LOCAL (temp _k (Vint (Int.repr (Zlength (intr i) - 1))))
     SEP (data_at sh (tarray tuchar (Zlength contents)) (replace_list 0 contents (map Vubyte (intr i))) buf)).
   - forward.
-    rewrite divu_repr by rep_lia.
+    rewrite -> divu_repr by rep_lia.
     forward.
     forward_call (sh, i / 10, buf, contents).
-    { rewrite intr_lt by lia; split; auto; try lia.
+    { rewrite -> intr_lt by lia; split; auto; try lia.
       assert (i / 10 < i).
       { apply Z.div_lt; lia. }
        split.
       apply Z.div_pos; lia. 
       rep_lia.
     }
-    rewrite modu_repr by (lia || computable).
+    rewrite -> modu_repr by (lia || computable).
     assert (repable_signed (Zlength (intr (i / 10)))).
     { split; try rep_lia.
       rewrite intr_lt; try lia. }
@@ -218,22 +222,22 @@ Proof.
       split; try rep_lia.
       rewrite intr_lt; try lia. }
     entailer!.
-    { rewrite intr_lt by lia; auto. }
+    { rewrite -> intr_lt by lia; auto. }
     rewrite (intr_eq i).
     destruct (i <=? 0) eqn: Hi; [apply Zle_bool_imp_le in Hi; lia|].
     pose proof (Z_mod_lt i 10).
     rewrite <- (Zlength_map _ _ Vubyte), <- (Z.add_0_l (Zlength (map _ _))), replace_list_upd_snoc.
-    rewrite (zero_ext_inrange 8 (Int.repr (i mod 10))), add_repr.
-    rewrite zero_ext_inrange, map_app.
+    rewrite -> (zero_ext_inrange 8 (Int.repr (i mod 10))), add_repr.
+    rewrite -> zero_ext_inrange, map_app.
     unfold Vubyte at 3; simpl.
-    rewrite Byte.unsigned_repr by (unfold char0; rep_lia); apply derives_refl.
+    rewrite -> Byte.unsigned_repr by (unfold char0; rep_lia); apply derives_refl.
     { rewrite Int.unsigned_repr; simpl; rep_lia. }
     { rewrite Int.unsigned_repr; simpl; rep_lia. }
     { lia. }
-    { rewrite Zlength_map, intr_lt; rep_lia. }
+    { rewrite Zlength_map intr_lt; rep_lia. }
   - forward.
     entailer!.
-    rewrite replace_list_nil by rep_lia; auto.
+    rewrite -> replace_list_nil by rep_lia; auto.
   - forward.
     rewrite Z.sub_simpl_r; entailer!.
 Qed.
@@ -254,15 +258,15 @@ Proof.
   intros.
   destruct (Z.leb_spec n 0).
   { rewrite chars_of_Z_eq; simpl.
-  rewrite ?Zaux.Zdiv_eucl_unique in *.  (* Coq 8.15 and after *)
+    rewrite -> ?Zaux.Zdiv_eucl_unique in *.  (* Coq 8.15 and after *)
     apply Zdiv_le_compat_r with (p := 10) in H; try lia.
     rewrite Zdiv_0_l in H.
     destruct (Z.leb_spec (n / 10) 0); auto; lia. }
   induction n as [? IH] using (well_founded_induction (Zwf.Zwf_well_founded 0)).
-  rewrite chars_of_Z_eq, intr_eq.
+  rewrite chars_of_Z_eq intr_eq.
   destruct (n <=? 0) eqn: Hn; [apply Zle_bool_imp_le in Hn; lia|].
   simpl.
-  rewrite ?Zaux.Zdiv_eucl_unique in *.  (* Coq 8.15 and after *)
+  rewrite -> ?Zaux.Zdiv_eucl_unique in *.  (* Coq 8.15 and after *)
   destruct (n / 10 <=? 0) eqn: Hdiv.
   - apply Zle_bool_imp_le in Hdiv.
     assert (0 <= n / 10).
@@ -283,14 +287,14 @@ Proof.
   rewrite intr_eq.
   destruct (Z.leb_spec n 0); [rewrite Zlength_nil; lia|].
   rewrite Zlength_app.
-  assert (Zlength (intr (n / 10)) <= a - 1); [|rewrite Zlength_cons, Zlength_nil; lia].
+  assert (Zlength (intr (n / 10)) <= a - 1); [|rewrite Zlength_cons Zlength_nil; lia].
   assert (0 <= a - 1).
   { destruct (Z.eq_dec a 0); subst; simpl in *; lia. }
   apply H; auto.
   - split; try lia.
     apply Z.div_lt; auto; lia.
   - apply Zmult_lt_reg_r with 10; try lia.
-    rewrite (Z.mul_comm (10 ^ _)), <- Z.pow_succ_r by auto.
+    rewrite -> (Z.mul_comm (10 ^ _)), <- Z.pow_succ_r by auto.
     unfold Z.succ; rewrite Z.sub_simpl_r.
     eapply Z.le_lt_trans; eauto.
     rewrite Z.mul_comm; apply Z.mul_div_le; lia.
@@ -301,21 +305,21 @@ Proof.
   intros.
   rewrite chars_of_Z_intr.
   destruct (Z.leb_spec n 0); [|apply intr_length; lia].
-  rewrite Zlength_cons, Zlength_nil; lia.
+  rewrite Zlength_cons Zlength_nil; lia.
 Qed.
 
 Lemma body_print_int: semax_body Vprog Gprog f_print_int print_int_spec.
 Proof.
   start_function.
   forward_call (tarray tuchar 5, gv).
-  { split; auto; simpl; computable. }
+  { simpl; computable. }
   Intro buf.
   forward_if (buf <> nullval).
   { if_tac; entailer!. }
   { forward_call 1; contradiction. }
   { forward.
     entailer!. }
-  Intros; rewrite if_false by auto.
+  Intros; rewrite -> if_false by auto.
   forward_if (PROP ()
     LOCAL (temp _buf buf; gvars gv; temp _i (Vint (Int.repr i));
                  temp _k (Vint (Int.repr (Zlength (chars_of_Z i ++ [Byte.repr newline])))))
@@ -334,22 +338,21 @@ Proof.
     assert (Zlength (intr i) <= 4).
     { apply intr_length; try lia. }
     forward_call (Ews, i, buf, [Vundef; Vundef; Vundef; Vundef; Vundef]).
-    { rewrite !Zlength_cons, Zlength_nil.
+    { rewrite -> !Zlength_cons, Zlength_nil.
       simpl; repeat (split; auto); rep_lia. }
     forward.
     { entailer!.
-      rewrite !Zlength_cons, Zlength_nil; rep_lia. }
+      rewrite -> !Zlength_cons, Zlength_nil; rep_lia. }
     forward.
     entailer!.
-    { rewrite Zlength_app, Zlength_cons, Zlength_nil, chars_of_Z_intr.
+    { rewrite -> Zlength_app, Zlength_cons, Zlength_nil, chars_of_Z_intr.
       destruct (Z.leb_spec i 0); auto; lia. }
     unfold replace_list; simpl.
     rewrite (sublist_repeat _ _ 5 Vundef).
-    rewrite !Zlength_cons, Zlength_nil, Zlength_map; simpl.
+    rewrite -> !Zlength_cons, Zlength_nil, Zlength_map; simpl.
     rewrite upd_Znth_app2.
-    rewrite Zlength_map, Zminus_diag, upd_Znth0_old, sublist_repeat; try lia.
-    apply derives_refl'.
-    f_equal.
+    rewrite -> Zlength_map, Zminus_diag, upd_Znth0_old, sublist_repeat; try lia.
+    f_equiv.
     rewrite chars_of_Z_intr.
     destruct (Z.leb_spec i 0); try lia.
     rewrite zero_ext_inrange.
@@ -358,14 +361,14 @@ Proof.
     { simpl; rewrite Int.unsigned_repr; rep_lia. }
     { rewrite Zlength_repeat; lia. }
     { rewrite Zlength_repeat; lia. }
-    { rewrite Zlength_map, Zlength_repeat; lia. }
+    { rewrite Zlength_map Zlength_repeat; lia. }
     { rewrite Zlength_map; rep_lia. }
-    { rewrite !Zlength_cons, Zlength_nil, Zlength_map; lia. }
+    { rewrite -> !Zlength_cons, Zlength_nil, Zlength_map; lia. }
   - forward_call (Ews, buf, chars_of_Z i ++ [Byte.repr newline],
       5, repeat Vundef (Z.to_nat (4 - Zlength (chars_of_Z i))), tr).
-    { rewrite map_app, <- app_assoc; simpl; cancel. }
+    { rewrite -> map_app, <- app_assoc; simpl; cancel. }
     forward_call (tarray tuchar 5, buf, gv).
-    { rewrite if_false by auto; cancel. }
+    { rewrite -> if_false by auto; cancel. }
     forward.
 Qed.
 
@@ -383,13 +386,13 @@ Proof.
   rewrite bind_bind.
   apply eqit_bind; [reflexivity|].
   intros [].
-  - rewrite bind_ret_l, tau_eutt.
+  - rewrite bind_ret_l tau_eutt.
     rewrite unfold_iter.
-    rewrite bind_ret_l; reflexivity.
+    rewrite bind_ret_l //.
   - rewrite bind_bind.
     apply eqit_bind; [reflexivity|].
     intro.
-    rewrite bind_ret_l, tau_eutt; reflexivity.
+    rewrite bind_ret_l tau_eutt //.
 Qed.
 
 Lemma for_loop_eq : forall {file_id} i z body,
@@ -402,9 +405,9 @@ Proof.
   rewrite bind_bind.
   apply eqit_bind; [reflexivity|].
   intros [].
-  - rewrite bind_ret_l, tau_eutt, unfold_iter.
-    rewrite bind_ret_l; reflexivity.
-  - rewrite bind_ret_l, tau_eutt; reflexivity.
+  - rewrite bind_ret_l tau_eutt unfold_iter.
+    rewrite bind_ret_l //.
+  - rewrite bind_ret_l tau_eutt //.
 Qed.
 
 Lemma sum_Z_app : forall l1 l2, sum_Z (l1 ++ l2) = sum_Z l1 + sum_Z l2.
@@ -417,23 +420,23 @@ Lemma body_main: semax_body Vprog Gprog f_main main_spec.
 Proof.
   start_function.
   sep_apply (has_ext_ITREE(E := @IO_event nat)).
-  rewrite <- (emp_sepcon (ITREE _)); Intros.
+  rewrite <- (bi.emp_sep (ITREE _)); Intros.
   replace_SEP 0 (mem_mgr gv) by (go_lower; apply create_mem_mgr).
   forward.
   forward_call (tarray tuchar 4, gv).
-  { simpl; repeat (split; auto); rep_lia. }
+  { simpl; computable. }
   Intro buf.
   forward_if (buf <> nullval).
   { if_tac; entailer!. }
   { forward_call 1; contradiction. }
   { forward.
     entailer!. }
-  Intros; rewrite if_false by auto.
+  Intros; rewrite -> if_false by auto.
   unfold main_itree.
   forward_call (Ews, buf, 4, fun lc => read_sum 0 lc).
   { simpl; cancel. }
   Intros lc.
-  set (Inv := EX n : Z, EX lc : list byte,
+  set (Inv := ∃ n : Z, ∃ lc : list byte,
     PROP (0 <= n < 1040)
     LOCAL (temp _i (Vint (Int.repr 4)); temp _buf buf; temp _n (Vint (Int.repr n)); gvars gv)
     SEP (ITREE (read_sum n lc); data_at Ews (tarray tuchar 4) (map Vubyte lc) buf;
@@ -443,33 +446,32 @@ Proof.
   { entailer!. }
   - clear dependent lc; rename lc0 into lc.
     rewrite read_sum_eq.
-    rewrite if_true by auto; simpl ITREE.
+    rewrite -> if_true by auto; simpl ITREE.
     set (nums := map (fun i => Byte.unsigned i - char0) lc).
     assert_PROP (Zlength lc = 4).
     { entailer!.
-      rewrite Zlength_map in *; auto. }
+      rewrite -> Zlength_map in *; auto. }
     assert (Zlength nums = 4) by (subst nums; rewrite Zlength_map; auto).
-    forward_for_simple_bound 4 (EX j : Z, PROP (0 <= n + sum_Z (sublist 0 j nums) < 1000 + 10 * j)
+    forward_for_simple_bound 4 (∃ j : Z, PROP (0 <= n + sum_Z (sublist 0 j nums) < 1000 + 10 * j)
      LOCAL (temp _i (Vint (Int.repr 4)); temp _buf buf; temp _n (Vint (Int.repr (n + sum_Z (sublist 0 j nums)))); gvars gv)
      SEP (ITREE (b <- for_loop j 4
          (read_sum_inner n nums) ;; if (b : bool) then Ret tt else lc' <- read_list stdin 4 ;; read_sum (n + sum_Z nums) lc');
              data_at Ews (tarray tuchar 4) (map Vubyte lc) buf; mem_mgr gv; malloc_token Ews (tarray tuchar 4) buf)).
     + entailer!.
-      { lia. }
     + simpl.
       forward.
       { entailer!.
         unfold Vubyte; simpl.
         rewrite Int.unsigned_repr; rep_lia. }
       forward.
-      rewrite Znth_map by lia; simpl.
+      rewrite -> Znth_map by lia; simpl.
       rewrite zero_ext_inrange.
       forward.
       unfold Int.sub.
-      rewrite !Int.unsigned_repr by rep_lia.
+      rewrite -> !Int.unsigned_repr by rep_lia.
       forward_if (0 <= Byte.unsigned (Znth i lc) - char0 < 10).
       { forward_call (tarray tuchar 4, buf, gv).
-        { rewrite if_false by auto; cancel. }
+        { rewrite -> if_false by auto; cancel. }
         forward.
         entailer!.
         rewrite for_loop_eq.
@@ -478,87 +480,91 @@ Proof.
         replace (_ || _)%bool with true.
         rewrite !bind_ret_l; auto.
         { symmetry; rewrite orb_true_iff.
-          subst nums; rewrite Znth_map by lia.
+          subst nums; rewrite -> Znth_map by lia.
           destruct (Z.ltb_spec (Byte.unsigned (Znth i lc) - char0) 0); auto.
-          rewrite Int.unsigned_repr in * by (unfold char0 in *; rep_lia).
+          rewrite -> Int.unsigned_repr in * by (unfold char0 in *; rep_lia).
           left; apply Z.leb_le; unfold char0 in *; lia. } }
       { forward.
         entailer!.
-        rewrite Int.unsigned_repr_eq in *.
+        rewrite -> Int.unsigned_repr_eq in *.
         destruct (zlt (Byte.unsigned (Znth i lc)) char0).
         { unfold char0 in *; rewrite <- Z_mod_plus_full with (b := 1), Zmod_small in *; rep_lia. }
-        unfold char0 in *; rewrite Zmod_small in *; rep_lia. }
+        unfold char0 in *; rewrite -> Zmod_small in *; rep_lia. }
       forward.
       rewrite add_repr.
       rewrite for_loop_eq.
       destruct (Z.ltb_spec i 4); try lia.
       unfold read_sum_inner at 1.
-      unfold nums; rewrite Znth_map by lia.
+      unfold nums; rewrite -> Znth_map by lia.
       assert (((10 <=? Byte.unsigned (Znth i lc) - char0) || (Byte.unsigned (Znth i lc) - char0 <? 0))%bool = false) as Hin.
       { rewrite orb_false_iff.
         split; [apply Z.leb_nle | apply Z.ltb_nlt]; lia. }
       rewrite Hin.
       assert (sublist 0 (i + 1) nums = sublist 0 i nums ++ [Byte.unsigned (Znth i lc) - char0]) as Hi.
-      { rewrite (sublist_split _ i (i + 1)), (sublist_one i (i + 1)) by lia.
+      { rewrite -> (sublist_split _ i (i + 1)), (sublist_one i (i + 1)) by lia.
         f_equal; subst nums.
-        rewrite Znth_map by lia; auto. }
+        rewrite -> Znth_map by lia; auto. }
       forward_call (gv, n + sum_Z (sublist 0 (i + 1) nums),
         b <- for_loop (i + 1) 4 (read_sum_inner n nums) ;; if (b : bool) then Ret tt else lc' <- read_list stdin 4 ;; read_sum (n + sum_Z nums) lc').
       { entailer!.
-        rewrite Hi, sum_Z_app; simpl.
-        rewrite Z.add_assoc, Z.add_0_r; auto. }
-      { rewrite sepcon_assoc; apply sepcon_derives; cancel.
+        rewrite Hi sum_Z_app; simpl.
+        rewrite Z.add_assoc Z.add_0_r; auto. }
+      { apply bi.sep_mono; last cancel.
         rewrite !bind_bind.
         apply ITREE_impl.
         apply eqit_bind; [reflexivity|].
         intros [].
         rewrite bind_ret_l; reflexivity. }
-      { rewrite Hi, sum_Z_app; simpl; lia. }
+      { rewrite Hi sum_Z_app; simpl; lia. }
       entailer!.
-      { rewrite Hi, sum_Z_app; simpl.
-        rewrite Z.add_0_r, Z.add_assoc; split; auto; lia. }
-      { rewrite Int.unsigned_repr by rep_lia.
+      { rewrite Hi sum_Z_app; simpl.
+        rewrite Z.add_0_r Z.add_assoc; split; auto; lia. }
+      { rewrite -> Int.unsigned_repr by rep_lia.
         pose proof (Byte.unsigned_range (Znth i lc)) as [_ Hmax].
         unfold Byte.modulus, two_power_nat in Hmax; simpl in *; lia. }
     + rewrite for_loop_eq.
       destruct (Z.ltb_spec 4 4); try lia.
       forward_call (Ews, buf, 4, fun lc' => read_sum (n + sum_Z nums) lc').
-      { rewrite sepcon_assoc; apply sepcon_derives; cancel.
-        simpl; rewrite bind_ret_l; auto. }
+      { simpl; rewrite bind_ret_l; cancel. }
       Intros lc'.
       forward.
-      rewrite sublist_same in * by auto.
+      rewrite -> sublist_same in * by auto.
       Exists (n + sum_Z nums, lc'); entailer!.
       apply derives_refl.
   - subst Inv.
     forward_call (tarray tuchar 4, buf, gv).
-    { rewrite if_false by auto; cancel. }
+    { rewrite -> if_false by auto; cancel. }
     forward.
     cancel.
     rewrite read_sum_eq.
-    rewrite if_false; [auto | lia].
+    if_tac; auto; lia.
 Qed.
 
 Definition ext_link := ext_link_prog prog.
 
-#[export] Instance Espec : OracleKind := IO_Espec ext_link.
+#[local] Instance IO_ext_spec : ext_spec IO_itree := IO_ext_spec ext_link.
 
 Lemma prog_correct:
   semax_prog prog main_itree Vprog Gprog.
 Proof.
 prove_semax_prog.
-semax_func_cons body_malloc. apply semax_func_cons_malloc_aux.
+semax_func_cons body_malloc.
+{ destruct x; apply semax_func_cons_malloc_aux. }
 semax_func_cons body_free.
 semax_func_cons body_exit.
 semax_func_cons_ext.
-{ simpl; Intro msg.
+{ simpl; destruct x as (((?, ?), ?), ?); monPred.unseal; Intro msg.
   apply typecheck_return_value with (t := Xint16signed); auto. }
 semax_func_cons_ext.
+{ simpl; destruct x as (((((?, ?), ?), ?), ?), ?).
+  apply typecheck_return_value with (t := Xint16signed); auto. }
 semax_func_cons body_print_intr.
 semax_func_cons body_print_int.
 semax_func_cons body_main.
 Qed.
 
+End IO.
+
 Require Import VST.veric.SequentialClight.
 Require Import VST.progs64.io_mem_dry.
 
@@ -571,11 +577,16 @@ Ltac alloc_block m n := match n with
     destruct (dry_mem_lemmas.drop_alloc m) as [m' Hm']; alloc_block m' n'
   end.
 try first [
-  (* This version works in Coq 8.15, CompCert 3.10 *)
+  (* This version works in Coq 8.19, CompCert 3.15 *)
+  alloc_block Mem.empty 64%nat;
+  eexists; repeat match goal with H : ?a = _ |- match ?a with Some m' => _ | None => None end = _ => rewrite H end;
+  reflexivity
+ |
+  (* This version worked in Coq 8.15, CompCert 3.10 *)
   alloc_block Mem.empty 63%nat;
   eexists; repeat match goal with H : ?a = _ |- match ?a with Some m' => _ | None => None end = _ => rewrite H end;
   reflexivity
- | 
+ |
   (* This version worked in Coq 8.13, CompCert 3.9 *)
   alloc_block Mem.empty 61%nat;
   eexists; repeat match goal with H : ?a = _ |- match ?a with Some m' => _ | None => None end = _ => rewrite H end;
@@ -593,26 +604,19 @@ Qed.
 
 Definition main_block := proj1_sig main_block_exists.
 
-Axiom (Jsub: forall ef se lv m t v m' (EFI : ef_inline ef = true) m1
-       (EFC : Events.external_call ef se lv m t v m'), juicy_mem.mem_sub m m1 ->
-       exists m1' (EFC1 : Events.external_call ef se lv m1 t v m1'),
-         juicy_mem.mem_sub m' m1' /\ proj1_sig (Clight_core.inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC1) =
-         proj1_sig (Clight_core.inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC)).
-
 Theorem prog_toplevel : exists q,
   semantics.initial_core (Clight_core.cl_core_sem (globalenv prog)) 0 init_mem q init_mem (Vptr main_block Ptrofs.zero) [] /\
-  forall n, @step_lemmas.dry_safeN _ _ _ _ semax.genv_symb_injective (Clight_core.cl_core_sem (globalenv prog))
-             (io_dry_spec ext_link) {| genv_genv := Genv.globalenv prog; genv_cenv := prog_comp_env prog |} n
+  forall n, @step_lemmas.dry_safeN _ _ _ _ lifting.genv_symb_injective (Clight_core.cl_core_sem (globalenv prog))
+             io_dry_spec {| genv_genv := Genv.globalenv prog; genv_cenv := prog_comp_env prog |} n
             main_itree q init_mem.
 Proof.
-  edestruct whole_program_sequential_safety_ext with (V := Vprog) as (b & q & Hb & Hq & Hsafe).
-  - repeat intro; simpl. apply I.
-  - apply Jsub.
-  - apply add_funspecs_frame.
-  - apply juicy_dry_specs.
-  - apply dry_spec_mem.
-  - intros; apply I.
-  - apply CSHL_Sound.semax_prog_sound, prog_correct.
+  edestruct whole_program_sequential_safety_ext with (Espec := @IO_ext_spec (VSTΣ (@IO_itree (@IO_event nat))))(V := Vprog) as (b & q & Hb & Hq & Hsafe).
+  - apply lifting.subG_VSTGpreS, subG_refl.
+  - repeat intro; apply I.
+  - apply io_spec_sound.
+    intros ?? [<- | [<- | ?]]; last done;
+      rewrite /ext_link /ext_link_prog /prog /=; repeat (if_tac; first done); done.
+  - intros; eexists; apply CSHL_Sound.semax_prog_sound, prog_correct.
   - apply (proj2_sig init_mem_exists).
   - exists q.
     rewrite (proj2_sig main_block_exists) in Hb; inv Hb.
diff --git a/progs64/verif_logical_compare.v b/progs64/verif_logical_compare.v
index 83987337d1..ccb72f2c4f 100644
--- a/progs64/verif_logical_compare.v
+++ b/progs64/verif_logical_compare.v
@@ -1,7 +1,7 @@
 (* Do not edit this file, it was generated automatically *)
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs64.logical_compare.
-Import compcert.lib.Maps.
 
 #[export] Instance CompSpecs : compspecs. Proof. make_compspecs prog. Defined.
 
@@ -16,16 +16,16 @@ Definition logical_or_result v1 v2 : int :=
 Fixpoint quick_shortcut_logical (s: statement) : option ident :=
 match s with
 | Sifthenelse _
-     (Sset id (Econst_int _ (Tint I32 Signed {| attr_volatile := false; attr_alignas := None |})))
+     (Sset id (Econst_int _ (Tint I32 Signed {| attr_volatile := false; attr_alignas := None |} )))
      s2 => match quick_shortcut_logical s2 with None => None | Some id2 =>
                  if ident_eq id id2 then Some id else None
                 end
 | Sifthenelse _ s2
-     (Sset id (Econst_int _ (Tint I32 Signed {| attr_volatile := false; attr_alignas := None |})))
+     (Sset id (Econst_int _ (Tint I32 Signed {| attr_volatile := false; attr_alignas := None |} )))
       => match quick_shortcut_logical s2 with None => None | Some id2 =>
                  if ident_eq id id2 then Some id else None
             end
-| Sset id (Ecast _ (Tint IBool Unsigned {| attr_volatile := false; attr_alignas := None |})) =>
+| Sset id (Ecast _ (Tint IBool Unsigned {| attr_volatile := false; attr_alignas := None |} )) =>
         Some id
 | _ => None
 end.
@@ -34,7 +34,7 @@ Fixpoint shortcut_logical (eval: expr -> option val) (tid: ident) (s: statement)
             : option (int * list expr) :=
 match s with
 | Sifthenelse e1
-     (Sset id (Econst_int one (Tint I32 Signed {| attr_volatile := false; attr_alignas := None |})))
+     (Sset id (Econst_int one (Tint I32 Signed {| attr_volatile := false; attr_alignas := None |} )))
      s2 => if andb (eqb_ident id tid) (Int.eq one Int.one)
                 then match eval e1 with
                         | Some (Vint v1) =>
@@ -46,7 +46,7 @@ match s with
                         end
                 else None
 | Sifthenelse e1 s2
-     (Sset id (Econst_int zero (Tint I32 Signed {| attr_volatile := false; attr_alignas := None |})))
+     (Sset id (Econst_int zero (Tint I32 Signed {| attr_volatile := false; attr_alignas := None |} )))
       => if andb (eqb_ident id tid) (Int.eq zero Int.zero)
             then match eval e1 with
                      | Some (Vint v1) =>
@@ -57,7 +57,7 @@ match s with
                    | _ => None
                 end
             else None
-| Sset id (Ecast e (Tint IBool Unsigned {| attr_volatile := false; attr_alignas := None |})) =>
+| Sset id (Ecast e (Tint IBool Unsigned {| attr_volatile := false; attr_alignas := None |} )) =>
         if eqb_ident id tid
         then match eval (Ecast e tbool) with
                  | Some (Vint v) => Some (v, (Ecast e tbool :: nil))
@@ -68,14 +68,14 @@ match s with
 end.
 
 Lemma semax_shortcut_logical:
-  forall Espec {cs: compspecs} Delta P Q R tid s v Qtemp Qvar GV el,
+  forall Espec {cs: compspecs} E Delta P Q R tid s v Qtemp Qvar GV el,
    quick_shortcut_logical s = Some tid ->
    typeof_temp Delta tid = Some tint ->
    local2ptree Q = (Qtemp, Qvar, nil, GV) ->
-   Qtemp ! tid = None ->
+   Qtemp !! tid = None ->
    shortcut_logical (msubst_eval_expr Delta Qtemp Qvar GV) tid s = Some (v, el) ->
    ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- fold_right (fun e q => tc_expr Delta e && q) TT el ->
-   @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R)))
+   semax(OK_spec := Espec)(C := cs) E Delta (PROPx P (LOCALx Q (SEPx R)))
           s (normal_ret_assert (PROPx P (LOCALx (temp tid (Vint v) :: Q) (SEPx R)))).
 Admitted.
 
@@ -121,7 +121,6 @@ Ltac do_semax_shortcut_logical :=
 Lemma body_do_or: semax_body Vprog Gprog f_do_or do_or_spec.
 Proof.
 start_function.
-
 eapply semax_seq'; [do_semax_shortcut_logical | abbreviate_semax].
 forward.
 destruct H,H0; subst; simpl; entailer!.
@@ -141,8 +140,6 @@ start_function.
 forward.
 Qed.
 
-#[export] Existing Instance NullExtension.Espec.
-
 Lemma prog_correct:
   semax_prog prog tt Vprog Gprog.
 Proof.
@@ -151,4 +148,3 @@ semax_func_cons body_do_or.
 semax_func_cons body_do_and.
 semax_func_cons body_main.
 Qed.
-
diff --git a/progs64/verif_message.v b/progs64/verif_message.v
index 883ad7494d..373156c0f0 100644
--- a/progs64/verif_message.v
+++ b/progs64/verif_message.v
@@ -1,5 +1,6 @@
 (* Do not edit this file, it was generated automatically *)
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs64.message.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
@@ -9,7 +10,6 @@ Definition Vprog : varspecs. mk_varspecs prog. Defined.
    of _Program Logics for Certified Compilers_, by Appel et al., 2014 *)
 
 Local Open Scope Z.
-Local Open Scope logic.
 
 (*   mf_assert msgfmt sh buf len data  := the [data] is formatted into a message
          at most [len] bytes,  stored starting at address [buf] with share [sh] *)
@@ -59,7 +59,7 @@ Next Obligation.
 compute; split; congruence.
 Qed.
 Next Obligation.
-  entailer!!.
+  entailer!.
   change 8 with (sizeof (tarray tint 2)).
   apply data_at_memory_block.
 Qed.
@@ -107,8 +107,8 @@ Definition main_spec :=
 
 Definition message (sh: share) {t: type} (format: message_format t) (m: val) : mpred :=
   EX fg: val*val,
-          func_ptr' (serialize_spec format) (fst fg) *
-          func_ptr' (deserialize_spec format) (snd fg) *
+          func_ptr (serialize_spec format) (fst fg) *
+          func_ptr (deserialize_spec format) (snd fg) *
        data_at sh t_struct_message (Vint (Int.repr (mf_size format)), (fst fg, snd fg)) m.
 
 Definition Gprog : funspecs :=   ltac:(with_library prog [
@@ -162,7 +162,7 @@ forward. (* y = ((int * )buf)[1]; *)
 forward. (* p->x = x; *)
 forward. (* p->y = y; *)
 entailer!.
-split; simpl; auto.
+simpl; auto.
 unfold mf_assert.
 simpl.
 entailer!!.
@@ -179,7 +179,7 @@ make_func_ptr _intpair_serialize.
 set (des := gv _intpair_deserialize).
 set (ser := gv _intpair_serialize).
 match goal with 
- |- context [mapsto_zeros 4 Ews _] => 
+ |- context [mapsto_zeros 4 Ews _] =>
   (* 64-bit mode *)
   sep_apply mapsto_zeros_memory_block; auto;
   gather_SEP (mapsto _ _ _ (offset_val 0 des))
@@ -221,8 +221,7 @@ assert_PROP (align_compatible tint v_buf).
   econstructor; [reflexivity | apply Z.divide_0_r].
 forward_call (* len = ser(&p, buf); *)
       ((Vint (Int.repr 1), Vint (Int.repr 2)), v_p, v_buf, Tsh, Tsh).
-  split3; auto.
-  repeat split; auto.
+{ simpl; auto. }
 Intros rest.
 simpl.
 Intros. subst rest.
diff --git a/progs64/verif_min.v b/progs64/verif_min.v
index 65a0970ddb..9bb405e5ae 100644
--- a/progs64/verif_min.v
+++ b/progs64/verif_min.v
@@ -9,6 +9,7 @@
 *)
 
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs64.min.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs.  mk_varspecs prog. Defined.
@@ -154,28 +155,13 @@ pose (Inv d (f: Z->Prop) (i: Z) :=
           temp _a a; temp _i (Vint (Int.repr i));
           temp _n (Vint (Int.repr n)))
     SEP(data_at Ews (tarray tint n) (map Vint (map Int.repr al)) a)).
-forward_for (Inv 0 (fun _ => True)) continue: (Inv 1 (Z.gt n)).
+forward_for (Inv 0 (fun _ => True%type)) continue: (Inv 1 (Z.gt n)).
 *
 forward.
 Exists 0. unfold Inv; entailer!!.
 *
 entailer!!.
 *
-match goal with
-| P := @abbreviate ret_assert _ |- _ => unfold abbreviate in P; subst P
-end.
-match goal with
-| |- semax _ _ ?c ?P =>
-    tryif (is_sequential false false c)
-    then (apply sequential; simpl_ret_assert;
-          match goal with |- semax _ _ _ ?Q =>
-             abbreviate Q : ret_assert as POSTCONDITION
-          end)
-    else abbreviate P : ret_assert as POSTCONDITION
-end.
-
-force_sequential.
-abbreviate_semax.
 rename a0 into i.
  forward. (* j = a[i]; *)
  assert (repable_signed (Znth i al))
@@ -198,37 +184,6 @@ rename a0 into i.
  forward. (* skip; *)
  entailer!!. rewrite Z.min_l; auto; lia.
  +
- intros.
- subst POSTCONDITION; unfold abbreviate. (* TODO: some of these lines should all be done by forward_if *)
- simpl_ret_assert.
-
-Ltac go_lower ::=
-clear_Delta_specs;
-intros;
-match goal with
- | |- local _ && PROPx _ (LOCALx _ (SEPx ?R)) |-- _ => check_mpreds R
- | |- ENTAIL _, PROPx _ (LOCALx _ (SEPx ?R)) |-- _ => check_mpreds R
- | |- ENTAIL _, _ |-- _ => fail 10 "The left-hand-side of your entailment is  not in PROP/LOCAL/SEP form"
- | _ => fail 10 "go_lower requires a proof goal in the form of (ENTAIL _ , _ |-- _)"
-end;
-clean_LOCAL_canon_mix;
-repeat (simple apply derives_extract_PROP; intro_PROP);
-let rho := fresh "rho" in
-intro rho;
-first
-[ simple apply quick_finish_lower
-|          
- (let TC := fresh "TC" in apply finish_lower; intros TC ||
- match goal with
- | |- (_ && PROPx nil _) _ |-- _ => fail 1 "LOCAL part of precondition is not a concrete list (or maybe Delta is not concrete)"
- | |- _ => fail 1 "PROP part of precondition is not a concrete list"
- end);
-unfold fold_right_sepcon; fold fold_right_sepcon; rewrite ?sepcon_emp; (* for the left side *)
-unfold_for_go_lower;
-simpl tc_val; simpl msubst_denote_tc_assert;
-try clear dependent rho;
-clear_Delta
-].
 Exists i. apply ENTAIL_refl.
 *
  rename a0 into i.
@@ -320,6 +275,5 @@ forward_if.
  Intros x.
  autorewrite with sublist in *.
  forward. (* return *)
- Exists x.
- entailer!!.
+ Exists x; entailer!.
 Qed.
diff --git a/progs64/verif_min64.v b/progs64/verif_min64.v
index 042abb535b..3a85dca48a 100644
--- a/progs64/verif_min64.v
+++ b/progs64/verif_min64.v
@@ -6,6 +6,7 @@
 *)
 
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs64.min64.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs.  mk_varspecs prog. Defined.
diff --git a/progs64/verif_nest2.v b/progs64/verif_nest2.v
index e4e6255b77..8190673c11 100644
--- a/progs64/verif_nest2.v
+++ b/progs64/verif_nest2.v
@@ -1,12 +1,11 @@
 (* Do not edit this file, it was generated automatically *)
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs64.nest2.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
-Local Open Scope logic.
-
 Definition t_struct_b := Tstruct _b noattr.
 
 Definition get_spec :=
@@ -76,4 +75,3 @@ unfold_repinj.
 Time forward. (* 1.23 sec *)
 entailer!!.
 Time Qed.  (*  28 sec -> 3.45 sec *)
-
diff --git a/progs64/verif_nest3.v b/progs64/verif_nest3.v
index d9166d4df2..5c02b810af 100644
--- a/progs64/verif_nest3.v
+++ b/progs64/verif_nest3.v
@@ -1,11 +1,10 @@
 (* Do not edit this file, it was generated automatically *)
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs64.nest3.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
-Local Open Scope logic.
-
 Definition t_struct_c := Tstruct _c noattr.
 
 Definition get_spec0 :=
diff --git a/progs64/verif_object.v b/progs64/verif_object.v
index 4660e3d35f..3799848f95 100644
--- a/progs64/verif_object.v
+++ b/progs64/verif_object.v
@@ -6,8 +6,11 @@ Require Import VST.progs64.object.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
+Section Spec.
+
+Context  `{!default_VSTGS Σ}.
+
 Local Open Scope Z.
-Local Open Scope logic.
 
 Definition object_invariant := list Z -> val -> mpred.
 
@@ -30,39 +33,39 @@ Definition twiddle_spec (instance: object_invariant) :=
           PARAMS (self; Vint (Int.repr i))
           SEP (instance history self)
   POST [ tint ]
-      EX v: Z, 
+      ∃ v: Z, 
           PROP(2* fold_right Z.add 0 history < v <= 2* fold_right Z.add 0 (i::history))
           RETURN (Vint (Int.repr v))
           SEP(instance (i::history) self).
 
 Definition object_methods (instance: object_invariant) (mtable: val) : mpred :=
-  EX sh: share, EX reset: val, EX twiddle: val,
-  !! readable_share sh && 
-  func_ptr' (reset_spec instance) reset *
-  func_ptr' (twiddle_spec instance) twiddle *
+  ∃ (sh: share) (reset: val) (twiddle: val),
+  ⌜readable_share sh⌝ ∧
+  func_ptr (reset_spec instance) reset ∗
+  func_ptr (twiddle_spec instance) twiddle ∗
   data_at sh (Tstruct _methods noattr) (reset,twiddle) mtable.
 
 Lemma object_methods_local_facts: forall instance p,
-  object_methods instance p |-- !! isptr p.
+  object_methods instance p ⊢ ⌜isptr p⌝.
 Proof.
 intros.
 unfold object_methods.
 Intros sh reset twiddle.
 entailer!.
 Qed.
-#[export] Hint Resolve object_methods_local_facts : saturate_local.
+Hint Resolve object_methods_local_facts : saturate_local.
 
 Definition object_mpred (history: list Z) (self: val) : mpred :=
-  EX instance: object_invariant, EX mtable: val, 
-       (object_methods instance mtable *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable self*
+  ∃ (instance: object_invariant) (mtable: val), 
+       (object_methods instance mtable ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable self∗
      instance history self).
 
 Definition foo_invariant : object_invariant :=
   (fun (history: list Z) p =>
     withspacer Ews (sizeof size_t + sizeof tint) (2 * sizeof size_t) (field_at Ews (Tstruct _foo_object noattr) 
             [StructField _data] (Vint (Int.repr (2*fold_right Z.add 0 history)))) p
-      *  malloc_token Ews (Tstruct _foo_object noattr) p).
+      ∗  malloc_token Ews (Tstruct _foo_object noattr) p).
 
 Definition foo_reset_spec :=
  DECLARE _foo_reset (reset_spec foo_invariant).
@@ -77,7 +80,7 @@ Definition make_foo_spec :=
     PROP () PARAMS() GLOBALS (gv) 
     SEP (mem_mgr gv; object_methods foo_invariant (gv _foo_methods))
  POST [ tobject ]
-    EX p: val, PROP () RETURN (p)
+    ∃ p: val, PROP () RETURN (p)
      SEP (mem_mgr gv; object_mpred nil p; object_methods foo_invariant (gv _foo_methods)).
 
 Definition main_spec :=
@@ -85,21 +88,28 @@ Definition main_spec :=
   WITH gv: globals
   PRE  [] main_pre prog tt gv
   POST [ tint ]
-     EX i:Z, PROP(0<=i<=6) RETURN (Vint (Int.repr i)) SEP(TT).
+     ∃ i:Z, PROP(0<=i<=6) RETURN (Vint (Int.repr i)) SEP(True).
 
 Definition Gprog : funspecs :=   ltac:(with_library prog [
     foo_reset_spec; foo_twiddle_spec; make_foo_spec; main_spec]).
 
 Lemma object_mpred_i:
   forall (history: list Z) (self: val) (instance: object_invariant) (mtable: val),
-    object_methods instance mtable *
-     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable self *
+    object_methods instance mtable ∗
+     field_at Ews (Tstruct _object noattr) [StructField _mtable] mtable self ∗
      instance history self 
-    |-- object_mpred history self.
+    ⊢ object_mpred history self.
 Proof.
 intros. unfold object_mpred. Exists instance mtable; auto.
 Qed.
 
+
+Lemma bind_ret0_unfold:
+  forall Q, bind_ret None tvoid Q ⊣⊢ (assert_of (fun rho => Q (globals_only rho))).
+Proof.
+  rewrite /bind_ret; split => rho; monPred.unseal; done.
+Qed.
+
 Lemma body_foo_reset: semax_body Vprog Gprog f_foo_reset foo_reset_spec.
 Proof.
 unfold foo_reset_spec, foo_invariant, reset_spec.
@@ -129,30 +139,23 @@ simpl.
 Exists (2 * fold_right Z.add 0 history + i).
 simpl;
 entailer!!.
-rewrite Z.mul_add_distr_l, Z.add_comm.
+rewrite ->Z.mul_add_distr_l, Z.add_comm.
 unfold withspacer; simpl.
 entailer!!.
 Qed.
 
 Lemma split_object_methods:
   forall instance m, 
-    object_methods instance m |-- object_methods instance m * object_methods instance m.
+    object_methods instance m ⊢ object_methods instance m ∗ object_methods instance m.
 Proof.
 intros.
 unfold object_methods.
 Intros sh reset twiddle.
-
-Exists (fst (slice.cleave sh)) reset twiddle.
-Exists (snd (slice.cleave sh)) reset twiddle.
-rewrite (split_func_ptr' (reset_spec instance) reset) at 1.
-rewrite (split_func_ptr' (twiddle_spec instance) twiddle) at 1.
-entailer!!.
-split.
-apply slice.cleave_readable1; auto.
-apply slice.cleave_readable2; auto.
-rewrite (data_at_share_join (fst (slice.cleave sh)) (snd (slice.cleave sh)) sh).
-auto.
-apply slice.cleave_join.
+destruct (slice.split_readable_share sh) as (sh1 & sh2 & ? & ? & ?); [assumption|].
+Exists sh1 reset twiddle.
+Exists sh2 reset twiddle.
+rewrite <- (data_at_share_join sh1 sh2 sh) by assumption.
+iIntros "(#$ & #$ & $ & $)"; auto.
 Qed.
 
 Lemma body_make_foo: semax_body Vprog Gprog f_make_foo make_foo_spec.
@@ -175,7 +178,7 @@ if_tac; entailer!!.
 forward_call 1.
 contradiction.
 *
-rewrite if_false by auto.
+rewrite ->if_false by auto.
 Intros.
 forward.  (*  /*skip*/;  *)
 entailer!!.
@@ -195,9 +198,7 @@ unfold_data_at (field_at _ _ nil _ p).
 cancel.
 unfold withspacer; simpl.
 rewrite !field_at_data_at.
-simpl.
-apply derives_refl'.
-rewrite <- ?sepcon_assoc. (* needed if Archi.ptr64=true *)
+cancel.
 rewrite !field_compatible_field_address; auto with field_compatible.
 clear - H.
 (* TODO: simplify the following proof. *)
@@ -221,14 +222,13 @@ reflexivity.
 left; auto.
 Qed.
 
-
 Lemma make_object_methods:
-  forall sh instance reset twiddle mtable,
+  forall sh instance reset twiddle (mtable: val),
   readable_share sh ->
-  func_ptr' (reset_spec instance) reset *
-  func_ptr' (twiddle_spec instance) twiddle *
+  func_ptr (reset_spec instance) reset ∗
+  func_ptr (twiddle_spec instance) twiddle ∗
   data_at sh (Tstruct _methods noattr) (reset, twiddle) mtable
-  |-- object_methods instance mtable.
+  ⊢ object_methods instance mtable.
 Proof.
   intros.
   unfold object_methods.
@@ -239,7 +239,7 @@ Qed.
 Ltac method_call witness hist' result :=
 repeat apply seq_assoc1;
 match goal with 
-   |- semax _ (PROPx _ (LOCALx ?Q (SEPx ?R))) 
+   |- semax _ _ (PROPx _ (LOCALx ?Q (SEPx ?R))) 
             (Ssequence (Sset ?mt (Efield (Ederef (Etempvar ?x _)  _) _ _))
                  _) _  =>
     match Q with context [temp ?x ?x'] =>
@@ -253,7 +253,7 @@ match goal with
           forward;
           forward_call witness;
           [ .. | try Intros result;
-                  sep_apply (make_object_methods sh instance r t mtable); [ auto .. | ];
+                  sep_apply (make_object_methods sh instance r t mtable); first auto;
                   sep_apply (object_mpred_i hist' x' instance mtable);
                   deadvars; try clear dependent sh; try clear r; try clear t
            ]
@@ -274,8 +274,8 @@ replace_SEP 0 (data_at Ews (Tstruct _methods noattr)
   unfold_data_at (data_at _ (Tstruct _methods _) _ (gv _foo_methods)).
   rewrite <- mapsto_field_at with (gfs := [StructField _twiddle]) (v:= (gv _foo_twiddle))
   by  auto with field_compatible.
-  rewrite field_at_data_at.  rewrite !field_compatible_field_address by auto with field_compatible.
-  rewrite !isptr_offset_val_zero by auto.
+  rewrite field_at_data_at.  rewrite ->!field_compatible_field_address by auto with field_compatible.
+  rewrite ->!isptr_offset_val_zero by auto.
   cancel.
 }
 
@@ -294,11 +294,10 @@ assert_PROP (p<>Vundef) by entailer!.
    Method 1:  comment out lines AA and BB and the entire range CC-DD.
    Method 2:  comment out lines AA-BB, inclusive.
 *)
-
-(* AA *) try (tryif 
+(* AA *) try (tryif
   (method_call (p, @nil Z) (@nil Z) whatever;
-   method_call (p, 3, @nil Z) [3%Z] i;
-     [simpl; computable | ])
+   method_call (p, 3, @nil Z) [3%Z] i(*;
+     [simpl; computable | ]*))
 (* BB *)  then fail else fail 99)
   .
 
@@ -327,7 +326,7 @@ forward.   (* p_twiddle = mtable->twiddle; *)
 assert_PROP (p<>Vundef) by entailer!.
 forward_call (* i = p_twiddle(p,3); *)
       (p, 3, @nil Z).
-  simpl. computable.
+{ simpl; computable. }
 Intros i.
 simpl in H0.
 sep_apply (make_object_methods sh instance r0 t0 mtable0); auto.
@@ -342,7 +341,4 @@ forward.  (* return i; *)
 Exists i; entailer!!.
 Qed.
 
-
-
-
-
+End Spec.
diff --git a/progs64/verif_printf.v b/progs64/verif_printf.v
index b3c6754894..4b6db20fab 100644
--- a/progs64/verif_printf.v
+++ b/progs64/verif_printf.v
@@ -9,6 +9,10 @@ Require Import ITree.Eq.
 #[export] Instance nat_id : FileId := { file_id := nat; stdin := 0%nat; stdout := 1%nat }.
 #[export] Instance file_struct : FileStruct := {| FILEid := ___sFILE64; reent := __reent; f_stdin := __stdin; f_stdout := __stdout |}.
 
+Section printf.
+
+Context `{!VSTGS (@IO_itree (@IO_event file_id)) Σ}.
+
 Definition main_spec :=
  DECLARE _main
   WITH gv : globals
@@ -23,19 +27,21 @@ Definition Gprog : funspecs :=
 Lemma body_main: semax_body Vprog Gprog f_main main_spec.
 Proof.
 start_function.
-make_stdio.
+make_stdio (@IO_event file_id).
 repeat do_string2bytes.
 repeat (sep_apply data_at_to_cstring; []).
-sep_apply (has_ext_ITREE(E := @IO_event file_id)).
+sep_apply (has_ext_ITREE).
 
 forward_printf tt (write_list stdout (string2bytes "This is line 2.
 ")).
-{ rewrite !sepcon_assoc; apply sepcon_derives; cancel.
-  apply derives_refl. }
+{ apply bi.sep_mono; first done.
+  cancel. }
 forward_call.
 forward.
 forward_fprintf outp ((Ers, string2bytes "line", gv ___stringlit_2), (Int.repr 2, tt)) (stdout, Ret tt : @IO_itree (@IO_event file_id)).
-{ rewrite 3sepcon_assoc, sepcon_comm, sepcon_assoc; apply sepcon_derives; cancel.
+{ rewrite !bi.sep_assoc (bi.sep_comm _ (ITREE _)) -!bi.sep_assoc; apply bi.sep_mono; [|cancel].
   rewrite bind_ret'; apply derives_refl. }
 forward.
-Qed.
\ No newline at end of file
+Qed.
+
+End printf.
diff --git a/progs64/verif_ptr_cmp.v b/progs64/verif_ptr_cmp.v
index 0eed276b4f..822c2c2453 100644
--- a/progs64/verif_ptr_cmp.v
+++ b/progs64/verif_ptr_cmp.v
@@ -4,6 +4,10 @@ Require Import VST.progs64.ptr_cmp.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
+Section Spec.
+
+Context  `{!default_VSTGS Σ}.
+
 Definition t_struct_tree := Tstruct _tree noattr.
 
 (** Some useful lemmas about comparing two pointers. 
@@ -17,43 +21,42 @@ Inductive Tree : Type :=
 Fixpoint tree_rep (t: Tree) (p p_lch p_rch: val): mpred :=
   match t with
   | T k lch rch   =>
-    EX p_lch_l: val, EX p_lch_r: val, 
-    EX p_rch_l: val, EX p_rch_r: val, 
+    ∃ (p_lch_l p_lch_r p_rch_l p_rch_r: val),
     data_at Tsh t_struct_tree 
       (Vint (Int.repr k), (p_lch, p_rch)) p
-    * tree_rep lch p_lch p_lch_l p_lch_r 
-    * tree_rep rch p_rch p_rch_l p_rch_r 
-  | E => !! (p = nullval) && emp 
+    ∗ tree_rep lch p_lch p_lch_l p_lch_r 
+    ∗ tree_rep rch p_rch p_rch_l p_rch_r 
+  | E => ⌜p = nullval⌝ ∧ emp 
   end.
 
 (** Representation of the parent-child relationship. *)
 Definition fa_rep (d: bool) (t: Tree) (p_ch p_fa: val) : mpred :=
   match d with
   | true    => 
-    EX p_oppo: val, tree_rep t p_fa p_ch p_oppo
+    ∃ p_oppo: val, tree_rep t p_fa p_ch p_oppo
   | false   =>
-    EX p_oppo: val, tree_rep t p_fa p_oppo p_ch
+    ∃ p_oppo: val, tree_rep t p_fa p_oppo p_ch
   end.
 
 (** Some basic lemmas. *)
 Lemma tree_rep_saturate_local:
-   forall t p p_lch p_rch, tree_rep t p p_lch p_rch |-- !! is_pointer_or_null p.
+   forall t p p_lch p_rch, tree_rep t p p_lch p_rch ⊢ ⌜is_pointer_or_null p⌝.
 Proof.
   destruct t; simpl; intros.
   entailer!.
   Intros p_lch_l p_lch_r p_rch_l p_rch_r. entailer!.
 Qed.
-#[export] Hint Resolve tree_rep_saturate_local: saturate_local.
+Hint Resolve tree_rep_saturate_local: saturate_local.
 
 Lemma tree_rep_valid_pointer:
-  forall t p p_lch p_rch, tree_rep t p p_lch p_rch |-- valid_pointer p.
+  forall t p p_lch p_rch, tree_rep t p p_lch p_rch ⊢ valid_pointer p.
 Proof.
   intros.
   destruct t. 
   - simpl. entailer!. 
   - simpl; normalize; auto with valid_pointer.
 Qed.
-#[export] Hint Resolve tree_rep_valid_pointer: valid_pointer.
+Hint Resolve tree_rep_valid_pointer: valid_pointer.
 
 Definition bool2int (d: bool) : Z :=
   match d with
@@ -79,7 +82,7 @@ Definition Gprog : funspecs :=
   ltac:(with_library prog [get_branch_spec]).
 
 (** Now try to prove this program. *)
-Theorem body_get_branch_old_fashion: semax_body Vprog Gprog f_get_branch get_branch_spec.
+Theorem body_get_branch_old_fashion: semax_body Vprog Gprog ⊤ f_get_branch get_branch_spec.
 Proof.
   start_function. 
   (* first eliminate the possibility that t is empty *)
@@ -127,11 +130,10 @@ Proof.
       (data_at_conflict Tsh t_struct_tree 
         (Vint (Int.repr k0), (p_lch_l, p_lch_r))
         (Vint (Int.repr k1), (p_rch_l, p_rch_r))
-        p_oppo top_share_nonidentity).
+        p_oppo Share.nontrivial).
       sep_apply H1.
-      sep_apply FF_local_facts.
       Intros.
-      destruct H2.
+      done.
     }
     {
       (* valid case *)
@@ -148,7 +150,7 @@ Qed.
 Lemma tree_rep_conflict :
   forall p t1 t2 p_ll p_lr p_rl p_rr, 
   p <> nullval ->
-  tree_rep t1 p p_ll p_lr * tree_rep t2 p p_rl p_rr |-- !! False.
+  tree_rep t1 p p_ll p_lr ∗ tree_rep t2 p p_rl p_rr ⊢ ⌜False⌝.
 Proof.
   intros.
   destruct t1. 
@@ -179,7 +181,7 @@ Ltac show_the_way d :=
   subst;
   try tree_rep_conflict. 
 
-Theorem body_get_branch_new_fashion: semax_body Vprog Gprog f_get_branch get_branch_spec.
+Theorem body_get_branch_new_fashion: semax_body Vprog Gprog ⊤ f_get_branch get_branch_spec.
 Proof.
 
   (** Now prove the theorem again, with the new tactics. *)
@@ -195,4 +197,6 @@ Proof.
   forward; simpl;
   Exists p_oppo p_lch_l p_lch_r p_rch_l p_rch_r;
   entailer!.
-Qed.
\ No newline at end of file
+Qed.
+
+End Spec.
\ No newline at end of file
diff --git a/progs64/verif_revarray.v b/progs64/verif_revarray.v
index 7ab6544f12..f6efeee210 100644
--- a/progs64/verif_revarray.v
+++ b/progs64/verif_revarray.v
@@ -1,11 +1,16 @@
 (* Do not edit this file, it was generated automatically *)
+(* Do not edit this file, it was generated automatically *)
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat.
 Require Import VST.progs64.revarray.
 Require Import VST.zlist.sublist.
 
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
+Section GFUNCTORS.
+Context `{VSTGS_OK: !VSTGS OK_ty Σ}.
+
 Definition reverse_spec :=
  DECLARE _reverse
   WITH a0: val, sh : share, contents : list int, size: Z
@@ -17,20 +22,26 @@ Definition reverse_spec :=
      PROP() RETURN()
      SEP(data_at sh (tarray tint size) (map Vint (rev contents)) a0).
 
+Definition Gprog_internal : funspecs :=   [reverse_spec].
+
+End GFUNCTORS.
+
+Section LimitImport. Import NoOracle.
 Definition main_spec :=
   DECLARE _main
   WITH gv : globals
   PRE  [] main_pre prog tt gv
   POST [ tint ] main_post prog gv.
+End LimitImport.
 
-Definition Gprog : funspecs :=   ltac:(with_library prog [reverse_spec; main_spec]).
 
 Definition flip_ends {A} lo hi (contents: list A) :=
   sublist 0 lo (rev contents)
   ++ sublist lo hi contents
   ++ sublist hi (Zlength contents) (rev contents).
 
-Definition reverse_Inv a0 sh contents size :=
+Definition reverse_Inv `{VSGTS_OK: !VSTGS OK_ty Σ}
+   a0 sh contents size :=
  (EX j:Z,
   (PROP  (0 <= j; j <= size-j)
    LOCAL  (temp _a a0; temp _lo (Vint (Int.repr j)); temp _hi (Vint (Int.repr (size-j))))
@@ -111,7 +122,8 @@ pose proof (Zlength_rev _ al).
 list_solve.
 Qed.
 
-Lemma body_reverse: semax_body Vprog Gprog f_reverse reverse_spec.
+Lemma body_reverse `{!VSTGS OK_ty Σ}: 
+ semax_body Vprog Gprog_internal f_reverse reverse_spec.
 Proof.
 start_function.
 forward.  (* lo = 0; *)
@@ -155,8 +167,7 @@ forward. (* hi--; *)
  entailer!.
  f_equal; f_equal; lia.
  simpl.
- apply derives_refl'.
- unfold data_at.    f_equal.
+ f_equiv.
  clear - H0 HRE H1.
  unfold Z.succ.
  rewrite <- flip_fact_3 by auto with typeclass_instances.
@@ -167,16 +178,18 @@ forward. (* hi--; *)
 forward. (* return; *)
 entailer!!.
 rewrite map_rev. rewrite flip_fact_1; try lia; auto.
-cancel.
 Qed.
 
 Definition four_contents := [Int.repr 1; Int.repr 2; Int.repr 3; Int.repr 4].
 
+Section LimitImport. Import NoOracle.
+
+Definition Gprog : funspecs := 
+   main_spec :: Gprog_internal.
+
 Lemma body_main:  semax_body Vprog Gprog f_main main_spec.
 Proof. finish. Qed.
 
-#[export] Existing Instance NullExtension.Espec.
-
 Lemma prog_correct:
   semax_prog prog tt Vprog Gprog.
 Proof.
@@ -184,6 +197,7 @@ prove_semax_prog.
 semax_func_cons body_reverse.
 semax_func_cons body_main.
 Qed.
+End LimitImport.
 
 Module Alternate.
 
@@ -208,7 +222,11 @@ Ltac calc_Zlength_extra l ::=
 #[export] Hint Rewrite @Znth_rev using Zlength_solve : Znth.
 #[export] Hint Unfold flip_ends : list_solve_unfold.
 
-Lemma body_reverse: semax_body Vprog Gprog f_reverse reverse_spec.
+
+Section GFUNCTORS.
+Context `{VSTGS_OK: !VSTGS OK_ty Σ}.
+
+Lemma body_reverse: semax_body Vprog Gprog_internal f_reverse reverse_spec.
 Proof.
 start_function.
 fastforward.
@@ -217,7 +235,7 @@ assert_PROP (Zlength (map Vint contents) = size)
     as ZL by entailer!.
 forward_while (reverse_Inv a0 sh (map Vint contents) size).
 * (* Prove that current precondition implies loop invariant *)
-simpl (data_at _ _ _).
+unfold reverse_Inv.
 Time finish.
 * (* Prove that loop invariant implies typechecking condition *)
 Time finish.
@@ -231,10 +249,13 @@ Time finish.
 (* Finished transaction in 2.409 secs (2.379u,0.014s) (successful) *) 
 Time Qed.
 (* Finished transaction in 0.718 secs (0.714u,0.002s) (successful) *)
+End GFUNCTORS.
 
 Definition four_contents := [Int.repr 1; Int.repr 2; Int.repr 3; Int.repr 4].
 
+Section LimitImport. Import NoOracle.
 Lemma body_main:  semax_body Vprog Gprog f_main main_spec.
 Proof. finish. Qed.
+End LimitImport.
 
 End Alternate.
diff --git a/progs64/verif_reverse2.v b/progs64/verif_reverse2.v
index bdc55f850a..46850eaf67 100644
--- a/progs64/verif_reverse2.v
+++ b/progs64/verif_reverse2.v
@@ -27,14 +27,18 @@ Definition Vprog : varspecs. mk_varspecs prog. Defined.
 (** A convenience definition *)
 Definition t_struct_list := Tstruct _list noattr.
 
+Section mpred.
+
+Context `{!default_VSTGS Σ}.
+
 (** Inductive definition of linked lists *)
 Fixpoint listrep (sigma: list val) (x: val) : mpred :=
  match sigma with
  | h::hs => 
-    EX y:val, 
-      data_at Tsh t_struct_list (h,y) x  *  listrep hs y
+    ∃ y:val,
+      data_at Tsh t_struct_list (h,y) x ∗ listrep hs y
  | nil => 
-    !! (x = nullval) && emp
+    ⌜x = nullval⌝ ∧ emp
  end.
 
 Arguments listrep sigma x : simpl never.
@@ -49,8 +53,8 @@ Arguments listrep sigma x : simpl never.
 
 Lemma listrep_local_facts:
   forall sigma p,
-   listrep sigma p |--
-   !! (is_pointer_or_null p /\ (p=nullval <-> sigma=nil)).
+   listrep sigma p ⊢
+   ⌜is_pointer_or_null p /\ (p=nullval <-> sigma=nil)⌝.
 Proof.
 intros.
 revert p; induction sigma; 
@@ -59,21 +63,21 @@ Intros y. entailer!.
 split; intro. subst p. destruct H; contradiction. inv H2.
 Qed.
 
-#[export] Hint Resolve listrep_local_facts : saturate_local.
+#[local] Hint Resolve listrep_local_facts : saturate_local.
 
 Lemma listrep_valid_pointer:
   forall sigma p,
-   listrep sigma p |-- valid_pointer p.
+   listrep sigma p ⊢ valid_pointer p.
 Proof.
  destruct sigma; unfold listrep; fold listrep; intros; Intros; subst.
  auto with valid_pointer.
  Intros y.
  apply sepcon_valid_pointer1.
  apply data_at_valid_ptr; auto.
- simpl;  computable.
+ simpl; computable.
 Qed.
 
-#[export] Hint Resolve listrep_valid_pointer : valid_pointer.
+#[local] Hint Resolve listrep_valid_pointer : valid_pointer.
 
 (** Specification of the [reverse] function.  It characterizes
  ** the precondition required for calling the function,
@@ -87,7 +91,7 @@ Definition reverse_spec :=
      PARAMS (p)
      SEP (listrep sigma p)
   POST [ (tptr t_struct_list) ]
-    EX q:val,
+    ∃ q:val,
      PROP () RETURN (q)
      SEP (listrep(rev sigma) q).
 
@@ -113,10 +117,10 @@ start_function.
 forward.  (* w = NULL; *)
 forward.  (* v = p; *)
 (** To prove a while-loop, you must supply a loop invariant,
- ** in this case (EX s1  PROP(...)LOCAL(...)(SEP(...)).  *)
+ ** in this case (∃ s1  PROP(...)LOCAL(...)(SEP(...)).  *)
 forward_while
-   (EX s1: list val, EX s2 : list val, 
-    EX w: val, EX v: val,
+   (∃ s1: list val, ∃ s2 : list val, 
+    ∃ w: val, ∃ v: val,
      PROP (sigma = rev s1 ++ s2)
      LOCAL (temp _w w; temp _v v)
      SEP (listrep s1 w; listrep s2 v)).
@@ -131,7 +135,7 @@ entailer!.
 entailer!.
 * (* Prove that loop body preserves invariant *)
 destruct s2 as [ | h r].
- - unfold listrep at 2. 
+ - unfold listrep at 2.
    Intros. subst. contradiction.
  - unfold listrep at 2; fold listrep.
    Intros y.
@@ -149,17 +153,11 @@ destruct s2 as [ | h r].
 * (* after the loop *)
 forward.  (* return w; *)
 Exists w; entailer!.
-rewrite (proj1 H1) by auto.
+rewrite -> (proj1 H1) by auto.
 unfold listrep at 2; fold listrep.
 entailer!.
-rewrite app_nil_r, rev_involutive.
+rewrite app_nil_r rev_involutive.
 auto.
 Qed.
 
-(** See the file [progs/verif_reverse.v] for an alternate
- ** proof of this function, using a general theory of
- ** list segments.  That file also has proofs of the
- ** sumlist function, the main function, and the
- ** [semax_func] theorem that ties all the functions together
- **)
-
+End mpred.
diff --git a/progs64/verif_strlib.v b/progs64/verif_strlib.v
index c4ad94c8ba..61d6aee25b 100644
--- a/progs64/verif_strlib.v
+++ b/progs64/verif_strlib.v
@@ -1,5 +1,6 @@
 (* Do not edit this file, it was generated automatically *)
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs64.strlib.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
@@ -136,20 +137,18 @@ forward_loop (EX i : Z,
   }
 Qed.
 
-Open Scope logic.
-
 Lemma split_data_at_app_tschar:
- forall sh n (al bl: list val) p ,
+ forall sh n (al bl: list val) p,
    n = Zlength (al++bl) ->
-   data_at sh (tarray tschar n) (al++bl) p = 
-         data_at sh (tarray tschar (Zlength al)) al p
-        * data_at sh (tarray tschar (n - Zlength al)) bl
-                 (field_address0 (tarray tschar n) [ArraySubsc (Zlength al)] p).
+   data_at sh (tarray tschar n) (al++bl) p =
+         (data_at sh (tarray tschar (Zlength al)) al p
+          * data_at sh (tarray tschar (n - Zlength al)) bl
+                 (field_address0 (tarray tschar n) [ArraySubsc (Zlength al)] p)).
 Proof.
 intros.
-apply (split2_data_at_Tarray_app _ n  sh tschar al bl ); auto.
+apply (split2_data_at_Tarray_app _ n  sh tschar al bl); auto.
 rewrite Zlength_app in H.
-change ( Zlength bl = n - Zlength al); lia.
+change (Zlength bl = n - Zlength al); lia.
 Qed.
 
 Lemma body_strcat: semax_body Vprog Gprog f_strcat strcat_spec.
@@ -226,8 +225,7 @@ forward_loop (EX i : Z,
       cancel.
     assert (j = Zlength ls) by cstring; subst.
     autorewrite with sublist.
-    apply derives_refl'.
-    unfold data_at; f_equal. 
+    f_equiv.
     replace (n - (Zlength ld + Zlength ls))
      with (1 + (n - (Zlength ld + Zlength ls+1))) by rep_lia.
     rewrite <- repeat_app' by rep_lia.
@@ -535,7 +533,7 @@ forward_loop (EX i : Z,
            repeat Vundef (Z.to_nat (n - (Zlength ld + j)))) dest;
          data_at sh' (tarray tschar (Zlength ls + 1))
            (map Vbyte (ls ++ [Byte.zero])) src)).
- all: finish.
+  all: finish.
 Qed.
 
 Lemma body_strcmp: semax_body Vprog Gprog f_strcmp strcmp_spec.
diff --git a/progs64/verif_sumarray.v b/progs64/verif_sumarray.v
index c4cf489d3c..227561b854 100644
--- a/progs64/verif_sumarray.v
+++ b/progs64/verif_sumarray.v
@@ -1,5 +1,6 @@
 (* Do not edit this file, it was generated automatically *)
 Require Import VST.floyd.proofauto. (* Import the Verifiable C system *)
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs64.sumarray. (* Import the AST of this C program *)
 (* The next line is "boilerplate", always required after importing an AST. *)
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
@@ -14,14 +15,13 @@ Proof.
   intros. induction a; simpl; lia.
 Qed.
 
-Definition sumarray_spec : ident * funspec :=
+Definition sumarray_spec :=
  DECLARE _sumarray
   WITH a: val, sh : share, contents : list Z, size: Z
   PRE [ (tptr tuint), tint ]
           PROP  (readable_share sh; 0 <= size <= Int.max_signed;
                  Forall (fun x => 0 <= x <= Int.max_unsigned) contents)
           PARAMS (a; Vint (Int.repr size))
-          GLOBALS ()
           SEP   (data_at sh (tarray tuint size) (map Vint (map Int.repr contents)) a)
   POST [ tuint ]
         PROP () LOCAL(temp ret_temp  (Vint (Int.repr (sum_Z contents))))
@@ -36,8 +36,8 @@ Definition main_spec :=
  DECLARE _main
   WITH gv : globals
   PRE  [] main_pre prog tt gv
-  POST [ tint ]  
-     PROP() 
+  POST [ tint ]
+     PROP()
      LOCAL (temp ret_temp (Vint (Int.repr (1+2+3+4)))) 
      SEP(TT).
 
@@ -123,8 +123,6 @@ forward_call (*  s = sumarray(four,4); *)
 forward. (* return s; *)
 Qed.
 
-#[export] Existing Instance NullExtension.Espec.
-
 Lemma prog_correct:
   semax_prog prog tt Vprog Gprog.
 Proof.
diff --git a/progs64/verif_switch.v b/progs64/verif_switch.v
index f3fbaf4f3f..6b8cb799f3 100644
--- a/progs64/verif_switch.v
+++ b/progs64/verif_switch.v
@@ -1,18 +1,17 @@
 (* Do not edit this file, it was generated automatically *)
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import Recdef.
-#[export] Existing Instance NullExtension.Espec.
 Require Import VST.progs64.switch.
-Require Export VST.floyd.Funspec_old_Notation.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
 
 Definition twice_spec :=
   DECLARE _twice
     WITH n : Z
-    PRE [ _n OF tint ]
+    PRE [ tint ]
       PROP  (Int.min_signed <= n+n <= Int.max_signed)
-      LOCAL (temp _n (Vint (Int.repr n)))
+      PARAMS (Vint (Int.repr n))
       SEP ()
     POST [ tint ]
       PROP ()
@@ -23,9 +22,9 @@ Definition twice_spec :=
 Definition f_spec :=
   DECLARE _f
     WITH x : Z
-    PRE [ _x OF tuint ]
+    PRE [ tuint ]
       PROP  (0 <= x <= Int.max_unsigned)
-      LOCAL (temp _x (Vint (Int.repr x)))
+      PARAMS (Vint (Int.repr x))
       SEP ()
     POST [ tint ]
       PROP ()
@@ -38,7 +37,7 @@ Definition Gprog : funspecs :=   ltac:(with_library prog [twice_spec]).
 Lemma body_twice: semax_body Vprog Gprog f_twice twice_spec.
 Proof.
 start_function.
-forward_if (PROP() LOCAL(temp _n (Vint (Int.repr (n+n)))) SEP()).
+forward_if (temp _n (Vint (Int.repr (n+n)))).
 repeat forward; entailer!!.
 repeat forward; entailer!!.
 repeat forward; entailer!!.
@@ -50,12 +49,10 @@ Qed.
 Lemma body_f: semax_body Vprog Gprog f_f f_spec.
 Proof.
 start_function.
-forward_if (@FF (environ->mpred) _).
+forward_if (False).
 forward.
 forward.
 forward.
 forward.
 forward.
 Qed.
-
-
diff --git a/progs64/verif_union.v b/progs64/verif_union.v
index cf371d09df..8aa846b794 100644
--- a/progs64/verif_union.v
+++ b/progs64/verif_union.v
@@ -1,5 +1,6 @@
 (* Do not edit this file, it was generated automatically *)
 Require Import VST.floyd.proofauto.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import VST.progs64.union.
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
@@ -106,7 +107,7 @@ revert k H; induction p; simpl; intros.
 rewrite Pos2Z.inj_succ in H.
 specialize (IHp (k-1)).
 spec IHp; [lia | ].
-replace (2^(k-1)) with (2^1 * 2^(k-1-1)).
+replace (2^(k-1)) with (2^1 * 2^(k-1-1))%Z.
 2:{ rewrite <- Z.pow_add_r by lia. f_equal. lia. }
 rewrite Pos2Z.inj_xI.
 lia.
@@ -114,12 +115,12 @@ lia.
 rewrite Pos2Z.inj_succ in H.
 specialize (IHp (k-1)).
 spec IHp; [lia | ].
-replace (2^(k-1)) with (2^1 * 2^(k-1-1)).
+replace (2^(k-1)) with (2^1 * 2^(k-1-1))%Z.
 2:{ rewrite <- Z.pow_add_r by lia. f_equal. lia. }
 rewrite Pos2Z.inj_xO.
 lia.
 -
-replace (2^(k-1)) with (2^1 * 2^(k-1-1)).
+replace (2^(k-1)) with (2^1 * 2^(k-1-1))%Z.
 2:{ rewrite <- Z.pow_add_r by lia. f_equal. lia. }
 change (2^1) with 2.
 assert (0 < 2 ^ (k-1-1)).
@@ -128,7 +129,7 @@ lia.
 Qed.
 
 
-Definition abs_nan (any_nan: {x : Bits.binary32 | Binary.is_nan 24 128 x = true}) (f: Binary.binary_float 24 128)   :=
+Definition abs_nan (any_nan: {x : Bits.binary32 | Binary.is_nan 24 128 x = true} ) (f: Binary.binary_float 24 128)   :=
 match f with
 | @Binary.B754_nan _ _ _ p H =>
     exist (fun x : Binary.binary_float 24 128 => Binary.is_nan 24 128 x = true)
@@ -162,7 +163,7 @@ Qed.
 
 Lemma binary32_abs_lemma:
  forall (x : Bits.binary32)
-      (any_nan : {x : Bits.binary32 | Binary.is_nan 24 128 x = true}),
+      (any_nan : {x : Bits.binary32 | Binary.is_nan 24 128 x = true} ),
   Bits.b32_of_bits (Bits.bits_of_b32 x mod 2 ^ 31) =
   Binary.Babs 24 128 (abs_nan any_nan) x.
 Proof.
diff --git a/refinedVST/lithium/all.v b/refinedVST/lithium/all.v
new file mode 100644
index 0000000000..e2cbaa0c64
--- /dev/null
+++ b/refinedVST/lithium/all.v
@@ -0,0 +1,5 @@
+From lithium Require Export normalize.
+From VST.lithium Require Export definitions simpl_classes simpl_instances proof_state interpreter solvers syntax instances lvar.
+
+(** This file reexports all files from Lithium except [hooks.v] such
+that the definitions from [hooks.v] don't accidentally override the redefinitions. *)
diff --git a/refinedVST/lithium/definitions.v b/refinedVST/lithium/definitions.v
new file mode 100644
index 0000000000..184ced84b6
--- /dev/null
+++ b/refinedVST/lithium/definitions.v
@@ -0,0 +1,146 @@
+From iris.proofmode Require Export tactics.
+From lithium Require Export base pure_definitions.
+
+(** Definitions that are used by the Lithium automation. *)
+
+(** * [iProp_to_Prop] *)
+#[projections(primitive)]
+Record iProp_to_Prop {PROP : bi} (P : PROP) : Type := i2p {
+  i2p_P :> PROP;
+  i2p_proof : i2p_P ⊢ P;
+}.
+Arguments i2p {_ _ _} _.
+Arguments i2p_P {_ _} _.
+Arguments i2p_proof {_ _} _.
+
+(** * Checking if a hyp in the context
+  The implementation can be found in interpreter.v *)
+Class CheckOwnInContext {PROP : bi} (P : PROP) : Prop := { check_own_in_context : True }.
+
+(** * [find_in_context] *)
+Record find_in_context_info {PROP : bi} : Type := {
+  fic_A : Type;
+  fic_Prop : fic_A → PROP;
+}.
+(* The nat n is necessary to allow different options, they are tried starting from 0. *)
+Definition find_in_context {PROP : bi} (fic : find_in_context_info) (T : fic.(fic_A) → PROP) : PROP :=
+  (∃ b, fic.(fic_Prop) b ∗ T b).
+Class FindInContext {PROP : bi} (fic : find_in_context_info) (key : Set) : Type :=
+  find_in_context_proof T: iProp_to_Prop (PROP:=PROP) (find_in_context fic T)
+.
+Global Hint Mode FindInContext + + - : typeclass_instances.
+Inductive FICSyntactic : Set :=.
+
+(** The instance for searching with [FindDirect] is in [instances.v].  *)
+Definition FindDirect {PROP : bi} {A} (P : A → PROP) := {| fic_A := A; fic_Prop := P; |}.
+Global Typeclasses Opaque FindDirect.
+
+(** ** [FindHypEqual]  *)
+(** [FindHypEqual] is called with find_in_context key [key], an
+hypothesis [Q] and a desired pattern [P], and then the instance
+(usually a tactic) should try to generate a new pattern [P'] equal to
+[P] that can be later unified with [Q]. *)
+Class FindHypEqual {PROP : bi} (key : Type) (Q P P' : PROP) := find_hyp_equal_equal: P = P'.
+Global Hint Mode FindHypEqual + + + ! - : typeclass_instances.
+
+(** * [RelatedTo] *)
+Class RelatedTo {PROP : bi} {A} (pat : A → PROP) : Type := {
+  rt_fic : find_in_context_info (PROP:=PROP);
+}.
+Global Hint Mode RelatedTo + + + : typeclass_instances.
+Global Arguments rt_fic {_ _ _} _.
+
+(** * [IntroPersistent] *)
+(** ** Definition *)
+Class IntroPersistent {PROP : bi} (P P' : PROP) := {
+  ip_persistent : P ⊢ □ P'
+}.
+Global Hint Mode IntroPersistent + + - : typeclass_instances.
+(** ** Instances *)
+Global Instance intro_persistent_intuit (PROP : bi) (P : PROP) : IntroPersistent (□ P) P.
+Proof. constructor. iIntros "$". Qed.
+
+(** * Simplification *)
+(* n:
+   None: no simplification
+   Some 0: simplification which is always safe
+   Some n: lower n: should be done before higher n (when compared with simplifyGoal)   *)
+Definition simplify_hyp {PROP : bi} (P : PROP) (T : PROP) : PROP :=
+  P -∗ T.
+Class SimplifyHyp {PROP : bi} (P : PROP) (n : option N) : Type :=
+  simplify_hyp_proof T : iProp_to_Prop (simplify_hyp P T).
+
+Definition simplify_goal {PROP : bi} (P : PROP) (T : PROP) : PROP :=
+  (P ∗ T).
+Class SimplifyGoal {PROP : bi} (P : PROP) (n : option N) : Type :=
+  simplify_goal_proof T : iProp_to_Prop (simplify_goal P T).
+
+Global Hint Mode SimplifyHyp + + - : typeclass_instances.
+Global Hint Mode SimplifyGoal + ! - : typeclass_instances.
+
+(** * Subsumption *)
+Definition subsume {PROP : bi} {A} (P1 : PROP) (P2 T : A → PROP) : PROP :=
+  P1 -∗ ∃ x, P2 x ∗ T x.
+Class Subsume {PROP : bi} {A} (P1 : PROP) (P2 : A → PROP) : Type :=
+  subsume_proof T : iProp_to_Prop (subsume P1 P2 T).
+Global Hint Mode Subsume + + + ! : typeclass_instances.
+
+(** * case distinction *)
+Definition case_if {PROP : bi} (P : Prop) (T1 T2 : PROP) : PROP :=
+  (<affine> ⌜P⌝ -∗ T1) ∧ (<affine> ⌜¬ P⌝ -∗ T2).
+
+Definition case_destruct {PROP : bi} {A} (a : A) (T : A → bool → PROP) : PROP :=
+  ∃ b, T a b.
+
+(** * [li_tactic] *)
+Class LiTactic {PROP : bi} {A} (t : (A → PROP) → PROP) := {
+  li_tactic_P : (A → PROP) → PROP;
+  li_tactic_proof T : li_tactic_P T ⊢ t T;
+}.
+Arguments li_tactic_proof {_ _ _} _ _.
+Arguments li_tactic_P {_ _ _} _ _.
+
+Definition li_tactic {PROP : bi} {A} (t : (A → PROP) → PROP) (T : A → PROP) : PROP :=
+  t T.
+Arguments li_tactic : simpl never.
+
+(** ** [li_vm_compute] *)
+Definition li_vm_compute {PROP : bi} {A B} (f : A → option B) (x : A) (T : B → PROP) : PROP :=
+  ∃ y, <affine> ⌜f x = Some y⌝ ∗ T y.
+Arguments li_vm_compute : simpl never.
+Global Typeclasses Opaque li_vm_compute.
+
+Program Definition li_vm_compute_hint {PROP : bi} {A B} (f : A → option B) x a :
+  f a = Some x →
+  LiTactic (li_vm_compute (PROP:=PROP) f a) := λ H, {|
+    li_tactic_P T := T x;
+|}.
+Next Obligation. move => ????????. iIntros "HT". iExists _. iFrame. iPureIntro. naive_solver. Qed.
+
+Global Hint Extern 10 (LiTactic (li_vm_compute _ _)) =>
+  eapply li_vm_compute_hint; evar_safe_vm_compute : typeclass_instances.
+
+(** * [accu] *)
+Definition accu {PROP : bi} (f : PROP → PROP) : PROP :=
+  ∃ P, P ∗ □ f P.
+Arguments accu : simpl never.
+Global Typeclasses Opaque accu.
+
+(** * trace *)
+Definition li_trace {PROP : bi} {A} (t : A) (T : PROP) : PROP := T.
+
+(** * [sep_list] *)
+(** sep_list_id is a marker to link a sep_list in the goal to a
+sep_list in the context. It also transfers the length between the two.
+Values of type sep_list_id should always be opaque during the proof. *)
+Record sep_list_id : Set := { sep_list_len : nat }.
+
+(* TODO: use Z instead of nat for f such that one avoids adding a
+Z.to_nat Z.of_nat roundtrip? It is a bit annoying since one needs to
+introduce Z.of_nat for the list insert. *)
+Definition sep_list {PROP : bi} (id : sep_list_id) A (ig : list nat) (l : list A) (f : nat → A → PROP) : PROP :=
+  <affine>⌜length l = sep_list_len id⌝ ∗ ([∗ list] i↦x∈l, if bool_decide (i ∈ ig) then <affine> True%I else <affine> f i x).
+Global Typeclasses Opaque sep_list.
+
+Definition FindSepList {PROP : bi} (id : sep_list_id) := {| fic_A := PROP; fic_Prop P := P; |}.
+Global Typeclasses Opaque FindSepList.
diff --git a/refinedVST/lithium/instances.v b/refinedVST/lithium/instances.v
new file mode 100644
index 0000000000..9e40ebf3db
--- /dev/null
+++ b/refinedVST/lithium/instances.v
@@ -0,0 +1,172 @@
+From lithium Require Export base.
+From VST.lithium Require Import syntax definitions proof_state.
+
+(** This file collects the default instances for the definitions in
+[definitions.v]. Note that these instances must be in a separate file
+since the instances are defined using the notation from
+[proof_state.v]. *)
+
+(** * [find_in_context] *)
+Lemma find_in_context_direct {prop:bi} {B} P (T : B → prop):
+  find_in_context (FindDirect P) T :- pattern: x, P x; return T x.
+Proof. done. Qed.
+Definition find_in_context_direct_inst := [instance @find_in_context_direct with FICSyntactic].
+Global Existing Instance find_in_context_direct_inst | 1.
+
+(** * Simplification *)
+Lemma simplify_hyp_id {prop:bi} (P : prop)  `{Affine prop P} (T : prop):
+  simplify_hyp P T :- return T.
+Proof. iIntros "HT Hl". iFrame. Qed.
+Definition simplify_hyp_id_inst (prop:bi) (P : prop) `{affine_p: Affine prop P}:=
+  [instance simplify_hyp_id P as SimplifyHyp P None].
+Global Existing Instance simplify_hyp_id_inst | 100.
+
+Lemma simplify_goal_id {prop:bi} (P : prop) T :
+  simplify_goal P T :- exhale P; return T.
+Proof. iIntros "$". Qed.
+Definition simplify_goal_id_inst (prop:bi) (P : prop) :=
+  [instance simplify_goal_id P as SimplifyGoal P None].
+Global Existing Instance simplify_goal_id_inst | 100.
+
+(** * Subsumption *)
+Lemma subsume_id {prop:bi} {A} (P : prop) (T : A → prop):
+  subsume P (λ _, P) T :- ∃ x, return T x.
+Proof. iIntros "[% ?] $". by iExists _. Qed.
+Definition subsume_id_inst := [instance @subsume_id].
+Global Existing Instance subsume_id_inst | 1.
+
+Lemma subsume_simplify {prop:bi} {A} (P1 : prop) (P2 : A → prop) o1 o2 T :
+  (* TCOneIsSome must be first here since [instance ...] reverse the order *)
+  ∀ `{!TCOneIsSome o1 o2} {SH : SimplifyHyp P1 o1} {SG : ∀ x, SimplifyGoal (P2 x) o2},
+    let GH := (SH (∃ x, P2 x ∗ T x)%I).(i2p_P) in
+    let GG := (P1 -∗ ∃ x, (SG x (T x)).(i2p_P))%I in
+    let G :=
+       match o1, o2 with
+     | Some n1, Some n2 => if (n2 ?= n1)%N is Lt then GG else GH
+     | Some n1, _ => GH
+     | _, _ => GG
+       end in
+    subsume P1 P2 T :- return G.
+Proof.
+  iIntros (???) "/= Hs Hl".
+  destruct o1 as [n1|], o2 as [n2|] => //. 1: case_match.
+  1,3,4: by iDestruct (i2p_proof with "Hs Hl") as "Hsub".
+  all: iDestruct ("Hs" with "Hl") as (?) "HSG"; iExists _.
+  all: iDestruct (i2p_proof with "HSG") as "$".
+Qed.
+Definition subsume_simplify_inst := [instance @subsume_simplify].
+Global Existing Instance subsume_simplify_inst | 1000.
+
+(** * sep_list *)
+
+Global Instance sep_list_related_to (prop:bi) A B id ig l f :
+  @RelatedTo prop _ (λ x : B, sep_list id A (ig x) (l x) (f x)) :=
+  {| rt_fic := FindSepList id |}.
+
+Lemma find_sep_list {prop:bi} id (T : _ → prop):
+  find_in_context (FindSepList id) T :-
+    pattern: A ig l f, sep_list id A ig l f; return T (sep_list id A ig l f).
+Proof. iIntros "(%&%&%&%&?&?)". iExists _. by iFrame. Qed.
+Definition find_sep_list_inst := [instance @find_sep_list with FICSyntactic].
+Global Existing Instance find_sep_list_inst | 1.
+
+Lemma subsume_sep_list_eq {prop:bi} {_:BiPositive prop} {B} A id ig (l1 : list A) (l2 : B → list A) f (T : B → prop) :
+  subsume (sep_list id A ig l1 f) (λ x : B, sep_list id A ig (l2 x) f) T :-
+    ∃ x, exhale <affine> ⌜list_subequiv ig l1 (l2 x)⌝; return T x.
+Proof.
+  unfold sep_list. iDestruct 1 as (b Hequiv) "HT".  iIntros "[%Hln Hl]". iExists b. iFrame "HT".
+  set (l2' := (l2 b)) in *. clearbody l2'; clear l2; rename l2' into l2.
+  have [Hlen _]:= Hequiv 0. iSplit; first by iPureIntro; congruence. clear Hln.
+  iInduction l1 as [|x l1] "IH" forall (f ig l2 Hlen Hequiv); destruct l2 => //=.
+  (* rewrite bi.affinely_sep. *)
+  iDestruct "Hl" as "[Hx Hl]". move: Hlen => /= [?].
+  iSplitL "Hx".
+  - case_bool_decide as Hb => //. have [_ /= Heq]:= Hequiv 0. by  move: (Heq Hb) => [->].
+  - iDestruct ("IH" $! (f ∘ S) (pred <$> (filter (λ x, x ≠ 0%nat) ig)) l2 with "[//] [%] [Hl]") as "Hl". {
+      move => i. split => // Hin. move: (Hequiv (S i)) => [_ /= {}Hequiv]. apply: Hequiv.
+      contradict Hin. apply elem_of_list_fmap. eexists (S i). split => //.
+        by apply elem_of_list_filter.
+    }
+    + iApply (big_sepL_impl with "Hl"). iIntros "!>" (k ??) "Hl".
+      case_bool_decide as Hb1; case_bool_decide as Hb2 => //.
+      contradict Hb2. apply elem_of_list_fmap. eexists (S k). split => //.
+      by apply elem_of_list_filter.
+    + iApply (big_sepL_impl with "Hl"). iIntros "!>" (k ??) "Hl".
+      case_bool_decide as Hb1; case_bool_decide as Hb2 => //.
+      contradict Hb2. move: Hb1 => /elem_of_list_fmap[[|?][? /elem_of_list_filter [??]]] //.
+      by simplify_eq/=.
+Qed.
+Definition subsume_sep_list_eq_inst := [instance @subsume_sep_list_eq].
+Global Existing Instance subsume_sep_list_eq_inst | 1000.
+
+Lemma subsume_sep_list_insert_in_ig {prop:bi} {B} A id ig i x (l1 : list A) (l2 : B → list A)
+  (f : nat → A → prop) (T : B → prop) :
+  subsume (sep_list id A ig (<[i := x]>l1) f) (λ x : B, sep_list id A ig (l2 x) f) T
+     where `{!CanSolve (i ∈ ig)} :-
+  return subsume (sep_list id A ig l1 f) (λ x : B, sep_list id A ig (l2 x) f) T.
+Proof.
+  unfold CanSolve, sep_list => ?. iIntros "Hsub [<- Hl]".
+  rewrite length_insert. iApply "Hsub". iSplit; [done|].
+  destruct (decide (i < length l1)%nat). 2: { by rewrite list_insert_ge; [|lia]. }
+  iDestruct (big_sepL_insert_acc with "Hl") as "[? Hl]". { by apply: list_lookup_insert. }
+  have [//|y ?]:= lookup_lt_is_Some_2 l1 i.
+  iDestruct ("Hl" $! y with "[]") as "Hl". { by case_decide. }
+  destruct (bool_decide (i∈ig)); by rewrite list_insert_insert list_insert_id.
+Qed.
+Definition subsume_sep_list_insert_in_ig_inst := [instance @subsume_sep_list_insert_in_ig].
+Global Existing Instance subsume_sep_list_insert_in_ig_inst.
+
+Lemma subsume_sep_list_insert_not_in_ig {prop:bi} A B id ig i x (l1 : list A) l2 (f : nat → A → prop) (T : B → prop) :
+  subsume (sep_list id A ig (<[i := x]>l1) f) (λ x : B, sep_list id A ig (l2 x) f) T
+    where `{!CanSolve (i ∉ ig)} :-
+      exhale <affine> ⌜i < length l1⌝%nat;
+      inhale <affine> f i x;
+      y ← (sep_list id A (i :: ig) l1 f) :>> (λ x : B, sep_list id A (i :: ig) (l2 x) f);
+      ∃ x2, exhale <affine> ⌜l2 y !! i = Some x2⌝;
+      exhale <affine> f i x2;
+      return T y.
+Proof.
+  unfold CanSolve, sep_list. iIntros (?) "[% Hsub] [<- Hl]". rewrite big_sepL_insert // length_insert.
+  iDestruct "Hl" as "[Hx Hl]". case_bool_decide => //.
+  iDestruct ("Hsub" with "Hx [Hl]") as "[% [[%Heq Hl] [% [% [? HT]]]]]". {
+    iSplit; [done|]. iApply (big_sepL_impl with "Hl"). iIntros "!>" (???) "?".
+    repeat case_decide => //; set_solver.
+  }
+  iExists _. iFrame. iSplit; [done|].
+  rewrite -{2}(list_insert_id (l2 _) i x2) // big_sepL_insert; [|lia]. case_bool_decide => //. iFrame.
+  iApply (big_sepL_impl with "Hl"). iIntros "!>" (???) "?".
+  repeat case_decide => //; set_solver.
+Qed.
+Definition subsume_sep_list_insert_not_in_ig_inst := [instance @subsume_sep_list_insert_not_in_ig].
+Global Existing Instance subsume_sep_list_insert_not_in_ig_inst.
+
+Lemma subsume_sep_list_trivial_eq {prop:bi} A B id ig (l : list A) (f : nat → A → prop) (T : B → prop) :
+  subsume (sep_list id A ig l f) (λ x : B, sep_list id A ig l f) T :- ∃ x, return T x.
+Proof. iIntros "[% ?] $". iExists _. by iFrame. Qed.
+Definition subsume_sep_list_trivial_eq_inst := [instance @subsume_sep_list_trivial_eq].
+Global Existing Instance subsume_sep_list_trivial_eq_inst | 5.
+
+Lemma subsume_sep_list_cons {prop:bi} A B id ig (x1 : A) (l1 : list A) l2 (f : nat → A → prop) (T : B → prop) :
+  subsume (sep_list id A ig (x1 :: l1) f) (λ y : B, sep_list id A ig (l2 y) f) T :-
+    exhale <affine> ⌜0 ∉ ig⌝;
+    ∀ id', inhale (<affine> f 0%nat x1);
+    inhale (sep_list id' A (pred <$> ig) l1 (λ i, f (S i)));
+    ∃ y x2 l2', exhale <affine> ⌜l2 y = x2 :: l2'⌝;
+    exhale (<affine> f 0%nat x2);
+    exhale (sep_list id' A (pred <$> ig) l2' (λ i, f (S i)));
+    return T y.
+Proof.
+  unfold sep_list. iIntros "[% Hs] [<- Hl]".
+  rewrite !big_sepL_cons /=. case_bool_decide => //. iDestruct "Hl" as "[H0 H]".
+  iDestruct ("Hs" $! {|sep_list_len := _|} with "H0 [H]") as (??? Heq1) "[? [[%Heq2 H] ?]]".
+  { iSplit; [simpl; done|]. iApply (big_sepL_impl with "H"); iIntros "!#" (???) "?".
+    case_bool_decide as Hx1 => //; case_bool_decide as Hx2 => //; contradict Hx2.
+    set_unfold. eexists _. split; [|done]. done. }
+  iExists _. iFrame. iSplit. { iPureIntro. rewrite Heq1 /=. by rewrite Heq2. }
+  rewrite Heq1 => /=. rewrite bool_decide_false //. iFrame.
+  iApply (big_sepL_impl with "H"); iIntros "!#" (???) "?".
+  case_bool_decide as Hx1 => //; case_bool_decide as Hx2 => //; contradict Hx2.
+  by move: Hx1 => /(elem_of_list_fmap_2 _ _ _)[[|?]//=[->?]].
+Qed.
+Definition subsume_sep_list_cons_inst := [instance @subsume_sep_list_cons].
+Global Existing Instance subsume_sep_list_cons_inst | 40.
diff --git a/refinedVST/lithium/interpreter.v b/refinedVST/lithium/interpreter.v
new file mode 100644
index 0000000000..906136fcb5
--- /dev/null
+++ b/refinedVST/lithium/interpreter.v
@@ -0,0 +1,1330 @@
+From iris.proofmode Require Import coq_tactics reduction.
+From lithium Require Import base hooks normalize solvers.
+From VST.lithium Require Import definitions simpl_classes proof_state syntax.
+From VST.lithium Require Import simpl_instances. (* required for tests *)
+Set Default Proof Using "Type".
+
+(** This file contains the main Lithium interpreter. *)
+
+(** * General proof state management tactics  *)
+(* The simpl is necessary since li_unfold_lets_in_context might provide new opportunities for simpl *)
+Ltac liShow := li_unfold_lets_in_context; simpl; try liToSyntaxGoal.
+
+Ltac liSimpl :=
+  (* simpl inserts a cast even if it does not do anything
+     (see https://coq.zulipchat.com/#narrow/stream/237656-Coq-devs.20.26.20plugin.20devs/topic/exact_no_check.2C.20repeated.20casts.20in.20proof.20terms/near/259371220 ) *)
+  try progress simpl.
+
+Ltac liUnfoldLetGoal :=
+  let do_unfold P :=
+    let H := get_head P in
+    is_var H;
+    unfold LET_ID in H;
+    liUnfoldLetGoal_hook H;
+    (* This unfold inserts a cast but that is not too bad for
+       performance since the goal is small at this point. *)
+    unfold H;
+    try clear H
+  in
+  lazymatch goal with
+  | |- envs_entails _ (∃ₗ _, ?P _ _ _ ∗ _) => do_unfold P
+  | |- envs_entails _ (∃ₗ _, ?P _ _ ∗ _) => do_unfold P
+  | |- envs_entails _ (∃ₗ _, ?P _ ∗ _) => do_unfold P
+  | |- envs_entails _ (?P ∗ _) => do_unfold P
+  | |- envs_entails _ (∃ₗ _, ?P _ _ _) => do_unfold P
+  | |- envs_entails _ (∃ₗ _, ?P _ _) => do_unfold P
+  | |- envs_entails _ (∃ₗ _, ?P _) => do_unfold P
+  | |- envs_entails _ ?P => do_unfold P
+  end.
+
+Ltac liUnfoldSyntax :=
+  lazymatch goal with
+  | |- envs_entails _ (li.all _) => liFromSyntax
+  | |- envs_entails _ (li.exist _) => liFromSyntax
+  | |- envs_entails _ (li.done) => liFromSyntax
+  | |- envs_entails _ (li.false) => liFromSyntax
+  | |- envs_entails _ (li.and _ _) => liFromSyntax
+  | |- envs_entails _ (li.and_map _ _) => liFromSyntax
+  | |- envs_entails _ (li.case_if _ _ _) => liFromSyntax
+  | |- envs_entails _ (li.ret) => liFromSyntax
+  | |- envs_entails _ (li.bind0 _ _) => liFromSyntax
+  | |- envs_entails _ (li.bind1 _ _) => liFromSyntax
+  | |- envs_entails _ (li.bind2 _ _) => liFromSyntax
+  | |- envs_entails _ (li.bind3 _ _) => liFromSyntax
+  | |- envs_entails _ (li.bind4 _ _) => liFromSyntax
+  | |- envs_entails _ (li.bind5 _ _) => liFromSyntax
+  | |- envs_entails _ (⎡li.all _⎤) => liFromSyntax
+  | |- envs_entails _ (⎡li.exist _⎤) => liFromSyntax
+  | |- envs_entails _ (⎡li.done⎤) => liFromSyntax
+  | |- envs_entails _ (⎡li.false⎤) => liFromSyntax
+  | |- envs_entails _ (⎡li.and _ _⎤) => liFromSyntax
+  | |- envs_entails _ (⎡li.and_map _ _⎤) => liFromSyntax
+  | |- envs_entails _ (⎡li.case_if _ _ _⎤) => liFromSyntax
+  | |- envs_entails _ (⎡li.ret⎤) => liFromSyntax
+  | |- envs_entails _ (⎡li.bind0 _ _⎤) => liFromSyntax
+  | |- envs_entails _ (⎡li.bind1 _ _⎤) => liFromSyntax
+  | |- envs_entails _ (⎡li.bind2 _ _⎤) => liFromSyntax
+  | |- envs_entails _ (⎡li.bind3 _ _⎤) => liFromSyntax
+  | |- envs_entails _ (⎡li.bind4 _ _⎤) => liFromSyntax
+  | |- envs_entails _ (⎡li.bind5 _ _⎤) => liFromSyntax
+  end.
+
+Ltac liEnsureInvariant := try let_bind_envs; try liUnfoldSyntax.
+
+Section coq_tactics.
+  Context {prop : bi}.
+
+  Lemma tac_fast_apply {Δ} {P1 P2 : prop} :
+    (P1 ⊢ P2) → envs_entails Δ P1 → envs_entails Δ P2.
+  Proof. by rewrite envs_entails_unseal => -> HP. Qed.
+End coq_tactics.
+
+(** ** [liInst] *)
+Section coq_tactics.
+  Context {prop : bi}.
+  Lemma tac_li_inst {A B} (P : (A *ₗ B) → Prop) Δ (G : _ → prop):
+    envs_entails Δ (∃ₗ x, <affine> ⌜P x⌝ ∗ G x) →
+    envs_entails Δ (∃ₗ x, G x).
+  Proof. apply tac_fast_apply. apply bi.exist_mono => ?. iIntros "[_ $]". Qed.
+  Lemma tac_li_inst_subsume {A B} (P : (A *ₗ B) → Prop) Δ P1 P2 (G : _ → prop):
+    envs_entails Δ (P1 -∗ ∃ₗ x, <affine> ⌜P x⌝ ∗ P2 x ∗ G x) →
+    envs_entails Δ (subsume P1 P2 G).
+  Proof.
+    apply tac_fast_apply. apply bi.wand_mono; [done|].
+    apply bi.exist_mono => ?. iIntros "[_ $]".
+  Qed.
+End coq_tactics.
+
+Tactic Notation "liInst" open_constr(P) :=
+  liFromSyntax;
+  lazymatch goal with
+  | |- envs_entails _ (∃ₗ _, _) => notypeclasses refine (tac_li_inst P _ _ _)
+  | |- envs_entails _ (subsume _ _ _) => notypeclasses refine (tac_li_inst_subsume P _ _ _ _ _)
+  end; try liToSyntax.
+
+(** ** [liExInst] *)
+Section coq_tactics.
+  Context {prop : bi}.
+  Lemma tac_li_ex_inst {A B} Δ (P : A → Prop) (Q : A → prop) (f : B → A) :
+    (∀ y, P (f y)) →
+    envs_entails Δ (∃ y, Q (f y)) →
+    envs_entails Δ (∃ x, <affine> ⌜P x⌝ ∗ Q x).
+  Proof. move => ?. apply tac_fast_apply. iIntros "[%a ?]". iExists _. iFrame. naive_solver. Qed.
+End coq_tactics.
+
+(* TODO: rename? *)
+Create HintDb solve_protected_eq_db discriminated.
+Global Hint Constants Opaque : solve_protected_eq_db.
+
+Ltac liExInst :=
+  let EX := fresh "EX" in
+  (* we use simple to not shelve any of the generated goals *)
+  simple refine (tac_li_ex_inst _ _ _ _ _ _);
+  (* create the function of the form (λ x, (_, .. , _, tt)ₗ) *)
+  [| refine (λ EX, _);
+     let x := lazymatch goal with | |- ?x => x end in
+     let rec go1 t x :=
+       lazymatch x with
+       | _ *ₗ ?B =>
+           let r := go1 t B in
+           uconstr:(li_pair _ r)
+       | unit => t
+       end in
+     let t := go1 uconstr:(tt) x in
+     refine t| |];
+  (* solve the sidecondition and try to instantiate evars *)
+  [..| intro EX; red_li_prod;
+   intros;
+   solve_protected_eq_hook;
+   (* TODO: Is the following necessary? If so, what is the best place to do it? *)
+   (* li_unfold_lets_in_context; *)
+   lazymatch goal with |- ?a = ?b => unify a b with solve_protected_eq_db end;
+   exact: eq_refl |];
+  (* create new existential quantifers for all evars that were not instantiated *)
+  [| let x := type of EX in
+     let rec go2 x t :=
+       lazymatch x with
+       | _ *ₗ ?B =>
+           let r := go2 B t in
+           uconstr:(r.nextₗ)
+       | _ => t
+       end in
+     let t := go2 x EX in
+     refine (t.1ₗ)..|];
+  (* Add unit at the end. *)
+  [exact unit|];
+  (* reduce the li_pair in the goal *)
+  red_li_prod.
+
+(** ** liEnsureSepHead *)
+Section coq_tactics.
+  Context {prop : bi}.
+  Lemma tac_ensure_sep_head {A B} Δ (P : prop) (Q : (A *ₗ B → prop)) :
+    envs_entails Δ (P ∗ ∃ₗ x, Q x) → envs_entails Δ (∃ₗ x, P ∗ Q x).
+  Proof. apply tac_fast_apply. by iIntros "[$ ?]". Qed.
+End coq_tactics.
+
+Ltac liEnsureSepHead :=
+  lazymatch goal with
+  | |- envs_entails ?Δ (bi_sep _ _) => idtac
+  | |- envs_entails ?Δ (∃ₗ _, bi_sep ?P _) =>
+      notypeclasses refine (tac_ensure_sep_head _ _ _ _)
+  end.
+
+
+(** * Main lithium tactics *)
+
+(** ** [liExtensible] *)
+Section coq_tactics.
+  Context {prop : bi}.
+
+  (* For some reason, replacing tac_fast_apply with more specialized
+  versions gives a 1-2% performance boost, see
+  https://coq-speed.mpi-sws.org/d/1QE_dqjiz/coq-compare?orgId=1&var-project=refinedc&var-branch1=master&var-commit1=05a3e8862ae4ab0041af67d1c02c552f99c4f35c&var-config1=build-coq.8.14.0-timing&var-branch2=master&var-commit2=998704f2a571385c65edfdd36332f6c3d014ec59&var-config2=build-coq.8.14.0-timing&var-metric=instructions&var-group=().*
+  TODO: investigate this more
+*)
+  Lemma tac_apply_i2p {Δ} {P : prop} (P' : iProp_to_Prop P) :
+    envs_entails Δ P'.(i2p_P) → envs_entails Δ P.
+  Proof. apply tac_fast_apply. apply i2p_proof. Qed.
+End coq_tactics.
+
+Ltac liExtensible_to_i2p P bind cont :=
+  lazymatch P with
+  | subsume ?P1 ?P2 ?T =>
+      bind T ltac:(fun H => uconstr:(subsume P1 P2 H));
+      cont uconstr:(((_ : Subsume _ _) _))
+  | _ => liExtensible_to_i2p_hook P bind cont
+  end.
+Ltac liExtensible :=
+  lazymatch goal with
+  | |- envs_entails ?Δ ?P =>
+      (* assert_succeeds (repeat lazymatch goal with | H := EVAR_ID _ |- _ => clear H end); *)
+      liExtensible_to_i2p P
+        ltac:(fun T tac => li_let_bind T (fun H => let X := tac H in constr:(envs_entails Δ X)))
+        ltac:(fun converted =>
+          simple notypeclasses refine (tac_apply_i2p converted _); [solve [refine _] |];
+          liExtensible_hook)
+  end.
+
+(** ** [liTrue] *)
+Section coq_tactics.
+  Context {prop : bi}.
+
+  Lemma tac_true Δ :
+    envs_entails Δ (True%I : prop).
+  Proof. rewrite envs_entails_unseal. by iIntros "_". Qed.
+End coq_tactics.
+
+Ltac liTrue :=
+  lazymatch goal with
+  | |- envs_entails _ True => notypeclasses refine (tac_true _)
+  end.
+
+(** ** [liFalse] *)
+Ltac liFalse :=
+  lazymatch goal with
+  | |- envs_entails _ False => exfalso; shelve_sidecond
+  | |- False => shelve_sidecond
+  end.
+
+(** ** [liForall] *)
+Section coq_tactics.
+  Context {prop : bi}.
+
+  Lemma tac_do_forall A Δ (P : A → prop) :
+    (∀ x, envs_entails Δ (P x)) → envs_entails Δ (∀ x : A, P x).
+  Proof.
+    rewrite envs_entails_unseal. intros HP. by apply bi.forall_intro.
+  Qed.
+
+  Lemma tac_do_exist_wand A Δ (P : A → prop) Q :
+    (∀ x, envs_entails Δ (P x -∗ Q)) → envs_entails Δ ((∃ x : A, P x) -∗ Q).
+  Proof.
+    rewrite envs_entails_unseal. iIntros (HP) "Henv". iDestruct 1 as (x) "HP".
+    by iApply (HP with "Henv HP").
+  Qed.
+End coq_tactics.
+
+Ltac liForall :=
+  (* n tells us how many quantifiers we should introduce with this name *)
+  let rec do_intro n name :=
+    lazymatch n with
+    | S ?n' =>
+      lazymatch goal with
+      (* relying on the fact that unification variables cannot contain
+         dependent variables to distinguish between dependent and non dependent forall *)
+      | |- ?P -> ?Q =>
+          lazymatch type of P with
+          | Prop => fail "implication, not forall"
+          | _ => (* just some unused variable, discard *) move => _
+          end
+      | |- forall _ : ?A, _ =>
+        (* When changing this, also change [prepare_initial_coq_context] in automation.v *)
+        lazymatch A with
+        | (prod _ _) => case; do_intro (S (S O)) name
+        | unit => case
+        | _ =>
+            first [
+                (* We match again since having e in the context when
+                calling fresh can mess up names. *)
+                lazymatch goal with
+                | |- forall e : ?A, @?P e =>
+                    let sn := open_constr:(_ : nat) in
+                    let p := constr:(_ : SimplForall A sn P _) in
+                    refine (@simpl_forall_proof _ _ _ _ p _);
+                    do_intro sn name
+                end
+              | let H := fresh name in intro H
+              ]
+        end
+      end;
+      do_intro n' name
+    | O => idtac
+    end
+  in
+  lazymatch goal with
+  | |- envs_entails _ (bi_forall (λ name, _)) =>
+      notypeclasses refine (tac_do_forall _ _ _ _); do_intro (S O) name
+  | |- envs_entails _ (bi_wand (bi_exist (λ name, _)) _) =>
+      notypeclasses refine (tac_do_exist_wand _ _ _ _ _); do_intro (S O) name
+  | |- (∃ name, _) → _ =>
+      case; do_intro (S O) name
+  | |- forall name, _ =>
+      do_intro (S O) name
+  | _ => fail "liForall: unknown goal"
+  end.
+
+(** ** [liExist] *)
+Section coq_tactics.
+  Context {prop : bi}.
+
+  Lemma tac_ex {A} Δ (P : A → prop) :
+    envs_entails Δ (∃ (x : A *ₗ unit), P x.1ₗ) →
+    envs_entails Δ (∃ x, P x).
+  Proof. apply tac_fast_apply. iIntros "[%a ?]". destruct a. iExists _. iFrame. Qed.
+
+  Lemma tac_ex_evar {A} Δ x (P : A → prop) :
+    envs_entails Δ (P x) →
+    envs_entails Δ (∃ x, P x).
+  Proof. apply tac_fast_apply. iIntros "?". iExists _. iFrame. Qed.
+
+  Lemma tac_li_ex_ex {A B C} Δ (P : _ → _ → prop) :
+    envs_entails Δ (∃ (x : C *ₗ A *ₗ B), P x.nextₗ x.1ₗ) →
+    envs_entails Δ (∃ (x : A *ₗ B), ∃ y : C, P x y).
+  Proof. apply tac_fast_apply. iIntros "[%a ?]". destruct a. iExists _, _. iFrame. Qed.
+
+  Lemma tac_li_ex_ex_evar {A B C} Δ y (P : _ → _ → prop) :
+    envs_entails Δ (∃ (x : A *ₗ B), P x y) →
+    envs_entails Δ (∃ (x : A *ₗ B), ∃ y : C, P x y).
+  Proof. apply tac_fast_apply. iIntros "[%a ?]". iExists _, _. iFrame. Qed.
+
+  Lemma tac_li_ex_li_ex {A B C D} Δ (P : _ → _ → prop) :
+    envs_entails Δ (∃ (x : C *ₗ A *ₗ B), ∃ y : D, P x.nextₗ (x.1ₗ, y)ₗ) →
+    envs_entails Δ (∃ (x : A *ₗ B), ∃ y : (C *ₗ D), P x y).
+  Proof. apply tac_fast_apply. iIntros "[%a [%b ?]]". destruct a. iExists _, _. iFrame. Qed.
+
+  Lemma tac_li_ex_ex_unused {A B C} Δ (P : (A *ₗ B) → prop) :
+    C →
+    envs_entails Δ (∃ₗ x, P x) →
+    envs_entails Δ (∃ₗ x, ∃ y : C, P x).
+  Proof.
+    move => x. apply tac_fast_apply. apply bi.exist_mono => ?.
+    iIntros "?". by iExists x.
+  Qed.
+
+  Lemma tac_ex_unused {C} Δ (P : prop) :
+    C →
+    envs_entails Δ (P) →
+    envs_entails Δ (∃ y : C, P).
+  Proof.
+    move => x. apply tac_fast_apply.
+    iIntros "?". by iExists x.
+  Qed.
+
+  Lemma tac_li_ex_simpl {A B C} Δ (P : (A *ₗ B) → C → prop) Q :
+    SimplExist C Q →
+    envs_entails Δ (∃ₗ x, Q (P x)) →
+    envs_entails Δ (∃ₗ x, ∃ y, P x y).
+  Proof.
+    unfold SimplExist. move => Hx. apply tac_fast_apply.
+    iIntros "[%a HQ]". iDestruct (Hx with "HQ") as (?) "?".
+    iExists _, _. iFrame.
+  Qed.
+
+  Lemma tac_ex_simpl {A} Δ (P : A → prop) Q :
+    SimplExist A Q →
+    envs_entails Δ (Q P) →
+    envs_entails Δ (∃ y, P y).
+  Proof. unfold SimplExist. move => Hx. by apply tac_fast_apply. Qed.
+End coq_tactics.
+
+Ltac liExist protect :=
+  lazymatch goal with
+  | |- envs_entails _ (∃ₗ _, ∃ₗ _, _) => repeat (refine (tac_li_ex_li_ex _ _ _)); red_li_prod
+  | |- envs_entails _ (∃ₗ _, ∃ _, ?P) =>
+          notypeclasses refine (tac_li_ex_ex_unused _ _ _ _);
+            [first [exact inhabitant | assumption | shelve] |]
+  | |- envs_entails _ (∃ₗ _, ∃ _, _) =>
+      first [
+          notypeclasses refine (tac_li_ex_simpl _ _ _ _ _); [solve [refine _] | cbv beta] |
+          lazymatch protect with
+          | true => refine (tac_li_ex_ex _ _ _)
+          | false => refine (tac_li_ex_ex_evar _ _ _ _)
+          end
+        ]
+  | |- envs_entails _ (∃ₗ _, ?P) =>
+      (* TODO: Should we split up the (_ *ₗ _) here? *)
+      notypeclasses refine (tac_ex_unused _ _ _ _);
+        [first [exact inhabitant | assumption | shelve] |]
+  | |- envs_entails _ (∃ₗ _, _) => fail "not handled by liExist"
+  | |- envs_entails _ (∃ _, ?P) =>
+          notypeclasses refine (tac_ex_unused _ _ _ _);
+            [first [exact inhabitant | assumption | shelve] |]
+  | |- envs_entails _ (∃ _, _) =>
+      first [
+          notypeclasses refine (tac_ex_simpl _ _ _ _ _); [solve [refine _] | cbv beta] |
+          lazymatch protect with
+          | true => refine (tac_ex _ _ _)
+          | false => refine (tac_ex_evar _ _ _ _)
+          end
+
+        ]
+  end.
+
+Tactic Notation "liExist" constr(c) := liExist c.
+Tactic Notation "liExist" := liExist true.
+
+Module liExist_tests.
+  Goal ∀ {prop : bi}, ∀ P : _ → _ → _ → _ → _ → _ → _ → prop,
+    ⊢ ∃ (x : Z * Z) (y : nat) (z : unit) (eq : 1 + 1 = 2) (A : Type), ∃ (a : (N *ₗ positive *ₗ positive *ₗ unit)),
+        P x y z (a.1ₗ) (a.2ₗ) eq A.
+    intros. iStartProof.
+    liExist.
+    liExist.
+    liExist.
+    liExist.
+    liExist.
+    liExist.
+    liExist.
+    liExist.
+    liExist.
+    lazymatch goal with
+    | |- envs_entails _ (∃ x : positive *ₗ positive *ₗ N *ₗ nat *ₗ Z *ₗ Z *ₗ (),
+               P (x.6ₗ, x.5ₗ) x.4ₗ () x.3ₗ x.2ₗ eq_refl _) => idtac
+    end.
+  Abort.
+End liExist_tests.
+
+(** ** [liImpl] *)
+Ltac liImpl :=
+  (* We pass false since [(∃ name, _) → _] is handled by [liForall]. *)
+  normalize_and_simpl_impl false.
+
+(** ** [liSideCond] *)
+Section coq_tactics.
+  Context {prop : bi}.
+  Lemma tac_sep_pure Δ (P : Prop) (Q : prop) :
+    P → envs_entails Δ Q → envs_entails Δ (⌜P⌝ ∗ Q).
+  Proof.
+    rewrite envs_entails_unseal => [HP HΔ].
+    iIntros "HΔ". iSplit => //. by iApply HΔ.
+  Qed.
+
+  Lemma tac_sep_affine_pure Δ (P : Prop) (Q : prop) :
+    P → envs_entails Δ Q → envs_entails Δ (<affine> ⌜P⌝ ∗ Q).
+  Proof.
+    rewrite envs_entails_unseal => [HP HΔ].
+    iIntros "HΔ". iSplit => //. by iApply HΔ.
+  Qed.
+
+  Lemma tac_sep_pure_and {A B} Δ (P1 P2 : _ → Prop) (Q : (A *ₗ B) → prop) :
+    envs_entails Δ (∃ₗ x, ⌜P1 x⌝ ∗ ⌜P2 x⌝ ∗ Q x) → envs_entails Δ (∃ₗ x, ⌜P1 x ∧ P2 x⌝ ∗ Q x).
+  Proof. apply tac_fast_apply. iIntros "[% [? [? ?]]]". iExists _. iFrame. iSplit; done. Qed.
+  Lemma tac_sep_affine_pure_and {A B} Δ (P1 P2 : _ → Prop) (Q : (A *ₗ B) → prop) :
+    envs_entails Δ (∃ₗ x, <affine> ⌜P1 x⌝ ∗ <affine> ⌜P2 x⌝ ∗ Q x) → envs_entails Δ (∃ₗ x, <affine> ⌜P1 x ∧ P2 x⌝ ∗ Q x).
+  Proof. apply tac_fast_apply. iIntros "[% [% [% ?]]]". iExists _. by iFrame. Qed.
+  Lemma tac_sep_pure_exist {A B} {C} Δ (P : _ → C → Prop) (Q : (A *ₗ B) → prop) :
+    envs_entails Δ (∃ₗ x, ∃ y, ⌜P x y⌝ ∗ Q x) → envs_entails Δ (∃ₗ x, ⌜∃ y, P x y⌝ ∗ Q x).
+  Proof. apply tac_fast_apply. iIntros "[% [% [? ?]]]". iExists _. iFrame. iExists _. done. Qed.
+  Lemma tac_sep_affine_pure_exist {A B} {C} Δ (P : _ → C → Prop) (Q : (A *ₗ B) → prop) :
+    envs_entails Δ (∃ₗ x, ∃ y, <affine> ⌜P x y⌝ ∗ Q x) → envs_entails Δ (∃ₗ x, <affine> ⌜∃ y, P x y⌝ ∗ Q x).
+  Proof. apply tac_fast_apply. iIntros "[%a [% [% ?]]]". iExists _. iFrame. naive_solver. Qed.
+
+  Lemma tac_normalize_goal_and_liex {A B} Δ (P1 P2 : _ → Prop) (Q : (A *ₗ B) → prop):
+    (∀ x, P1 x = P2 x) → envs_entails Δ (∃ₗ x, ⌜P2 x⌝ ∗ Q x) → envs_entails Δ (∃ₗ x, ⌜P1 x⌝ ∗ Q x).
+  Proof. move => HP. apply tac_fast_apply. iIntros "[%a ?]". rewrite -HP. iExists _. iFrame. Qed.
+
+  Lemma tac_normalize_goal_and_liex_affine {A B} Δ (P1 P2 : _ → Prop) (Q : (A *ₗ B) → prop):
+    (∀ x, P1 x = P2 x) → envs_entails Δ (∃ₗ x, <affine> ⌜P2 x⌝ ∗ Q x) → envs_entails Δ (∃ₗ x, <affine> ⌜P1 x⌝ ∗ Q x).
+  Proof. move => HP. apply tac_fast_apply. iIntros "[%a ?]". rewrite -HP. iExists _. iFrame. Qed.
+
+  Lemma tac_simpl_and_unsafe_envs {A B} Δ P1 P2 (Q : (A *ₗ B) → prop)
+    `{!∀ x, SimplAndUnsafe (P1 x) (P2 x)}:
+    envs_entails Δ (∃ₗ x, <affine> ⌜P2 x⌝ ∗ Q x) → envs_entails Δ (∃ₗ x, <affine> ⌜P1 x⌝ ∗ Q x).
+  Proof.
+    apply tac_fast_apply. unfold SimplAndUnsafe in *.
+    iIntros "[% [% ?]]". iExists _. iFrame. naive_solver.
+  Qed.
+
+  Lemma tac_simpl_and_unsafe_envs_affine {A B} Δ P1 P2 (Q : (A *ₗ B) → prop)
+    `{!∀ x, SimplAndUnsafe (P1 x) (P2 x)}:
+    envs_entails Δ (∃ₗ x, <affine> ⌜P2 x⌝ ∗ Q x) → envs_entails Δ (∃ₗ x, <affine> ⌜P1 x⌝ ∗ Q x).
+  Proof.
+    apply tac_fast_apply. unfold SimplAndUnsafe in *.
+    iIntros "[% [% ?]]". iExists _. iFrame. naive_solver.
+  Qed.
+
+End coq_tactics.
+
+Ltac liSideCond :=
+  try liEnsureSepHead;
+  lazymatch goal with
+
+  
+  | |- envs_entails ?Δ (bi_sep (⌜?P⌝) ?Q) =>
+  (* We use done instead of fast_done here because solving more
+     sideconditions here is a bigger performance win than the overhead
+     of done. *)
+      notypeclasses refine (tac_sep_pure _ _ _ _ _); [ first [ done | shelve_sidecond ] | ]
+  | |- envs_entails ?Δ (bi_sep (<affine> ⌜?P⌝) ?Q) =>
+      notypeclasses refine (tac_sep_affine_pure _ _ _ _ _); [ first [ done | shelve_sidecond ] | ]
+  | |- envs_entails ?Δ (∃ₗ x, bi_sep (⌜@?P x⌝) _) =>
+    (* TODO: Can we get something like the old shelve_hint? *)
+    (* TODO: figure out best order here *)
+    match P with
+    | _ => progress (notypeclasses refine (tac_normalize_goal_and_liex _ _ _ _ _ _);
+                      (* cbv beta is important to correctly detect progress *)
+                      [intros ?; normalize_hook|cbv beta])
+    | _ => liExInst
+    | (λ _, _ ∧ _)%type => notypeclasses refine (tac_sep_pure_and _ _ _ _ _)
+    | (λ _, ∃ _, _)%type => notypeclasses refine (tac_sep_pure_exist _ _ _ _)
+    | _ => notypeclasses refine (tac_simpl_and_unsafe_envs _ _ _ _ _); [solve [refine _] |]
+  end
+  | |- envs_entails ?Δ (∃ₗ x, bi_sep (<affine> ⌜@?P x⌝) _) =>
+      (* TODO: Can we get something like the old shelve_hint? *)
+      (* TODO: figure out best order here *)
+      match P with
+      | _ => progress (notypeclasses refine (tac_normalize_goal_and_liex_affine _ _ _ _ _ _);
+                       (* cbv beta is important to correctly detect progress *)
+                       [intros ?; normalize_hook|cbv beta])
+      | _ => liExInst
+      | (λ _, _ ∧ _)%type => notypeclasses refine (tac_sep_affine_pure_and _ _ _ _ _)
+      | (λ _, ∃ _, _)%type => notypeclasses refine (tac_sep_affine_pure_exist _ _ _ _)
+      | _ => notypeclasses refine (tac_simpl_and_unsafe_envs_affine _ _ _ _ _); [solve [refine _] |]
+      end
+  end.
+
+Module liSideCond_tests. Section test.
+  Variable REL : Z → Z → Prop.
+  Hypothesis (H : ∀ x y, SimplAndUnsafe (REL x y) (x = y)).
+
+
+  Goal ∀ prop:bi, ∀ P : _ → _ → prop,
+      ⊢ ∃ x y, <affine> ⌜1 = 1⌝ ∗ <affine>⌜1 = locked 1⌝ ∗ <affine>⌜x = 1 ∧ REL x y⌝ ∗ P x y.
+    intros. iStartProof. repeat liExist.
+    liSideCond.
+    liSideCond.
+    liSideCond.
+    liSideCond.
+    liSideCond. simpl.
+    liSideCond.
+    liExist.
+    lazymatch goal with
+    | |- envs_entails _ (P 1 (Z.of_nat 1)) => idtac
+    end.
+  Abort.
+End test. End liSideCond_tests.
+
+(** ** [liFindInContext] *)
+Section coq_tactics.
+  Context {prop : bi}.
+
+  Lemma tac_sep_true Δ (P : prop) :
+    envs_entails Δ P → envs_entails Δ (True ∗ P).
+  Proof. rewrite envs_entails_unseal => ->. by apply bi.True_sep_2. Qed.
+
+  Lemma tac_find_hyp_equal key (Q P P' R : prop) Δ `{!FindHypEqual key Q P P'}:
+    envs_entails Δ (P' ∗ R) →
+    envs_entails Δ (P ∗ R).
+  Proof. by revert select (FindHypEqual _ _ _ _) => ->. Qed.
+
+  Lemma tac_find_hyp Δ i p R (P : prop) :
+    envs_lookup i Δ = Some (p, P) →
+    envs_entails (envs_delete false i p Δ) R → envs_entails Δ (P ∗ R).
+  Proof.
+    rewrite envs_entails_unseal. intros ? HQ.
+    rewrite (envs_lookup_sound' _ false) // bi.intuitionistically_if_elim.
+      by apply bi.sep_mono_r.
+  Qed.
+
+  Lemma tac_find_hyp_affine Δ i R (P : prop) :
+    envs_lookup i Δ = Some (true, P) →
+    envs_entails Δ R → envs_entails Δ (<affine> P ∗ R).
+  Proof.
+    rewrite envs_entails_unseal. intros ? HQ.
+      rewrite (envs_lookup_intuitionistic_sound _ _ _ H) HQ.
+      apply bi.sep_mono_l.
+      apply bi.intuitionistically_affinely.
+  Qed.
+
+  Lemma tac_find_in_context {Δ} {fic} {T : _ → prop} key (F : FindInContext fic key) :
+    envs_entails Δ (F T).(i2p_P) → envs_entails Δ (find_in_context fic T).
+  Proof. rewrite envs_entails_unseal. etrans; [done|]. apply i2p_proof. Qed.
+
+  Lemma tac_ex_find_in_context {Δ A B} fic (T : (A *ₗ B) → _ → prop) :
+    envs_entails Δ (find_in_context fic (λ y, ∃ₗ x, T x y)%I) →
+    envs_entails Δ (∃ₗ x, find_in_context fic (T x)).
+  Proof.
+    apply tac_fast_apply. iDestruct 1 as (?) "[?[% ?]]".
+    iExists _, _. iFrame.
+  Qed.
+
+End coq_tactics.
+
+Ltac liFindHyp key :=
+  let rec go P Hs :=
+    lazymatch Hs with
+    | Esnoc ?Hs2 ?id ?Q => first [
+      lazymatch key with
+      | FICSyntactic =>
+          (* We try to unify using the opaquenes hints of
+             typeclass_instances. Directly doing exact: eq_refl
+             sometimes takes 30 seconds to fail (e.g. when trying
+             to unify GetMemberLoc for the same struct but with
+             different names.) TODO: investigate if constr_eq
+             could help even more
+             https://coq.inria.fr/distrib/current/refman/proof-engine/tactics.html#coq:tacn.constr-eq*)
+          first [unify Q P with typeclass_instances | 
+                 unify (bi_affinely Q) P with typeclass_instances (* for P of thes shape `<affine> _` *)]
+      | _ =>
+          notypeclasses refine (tac_find_hyp_equal key Q _ _ _ _ _); [solve [refine _]|];
+          lazymatch goal with
+          | |- envs_entails _ (?P' ∗ _) =>
+              unify Q P' with typeclass_instances
+          end
+      end;
+      (first [notypeclasses refine (tac_find_hyp_affine _ id _ _ _ _); [li_pm_reflexivity | li_pm_reduce] |
+              notypeclasses refine (tac_find_hyp _ id _ _ _ _ _); [li_pm_reflexivity | li_pm_reduce] 
+              ])
+      | go P Hs2 ]
+    end in
+  lazymatch goal with
+  | |- envs_entails _ (?P ∗ _) =>
+    let P := li_pm_reduce_val P in
+    let run_go P Hs Hi := first [go P Hs | go P Hi] in
+    lazymatch goal with
+    | |- envs_entails (Envs ?Hi ?Hs _) _ => run_go P Hs Hi
+    | H := (Envs ?Hi ?Hs _) |- _ => run_go P Hs Hi
+    end
+  end.
+
+Ltac liFindHypOrTrue key :=
+  first [
+      notypeclasses refine (tac_sep_true _ _ _)
+    | progress liFindHyp key
+  ].
+
+Ltac liFindInContext :=
+  lazymatch goal with
+  | |- envs_entails _ (∃ₗ _, find_in_context ?fic _) =>
+      notypeclasses refine (tac_ex_find_in_context _ _ _)
+  | |- _ => idtac
+  end;
+  lazymatch goal with
+  | |- envs_entails _ (find_in_context ?fic ?T) =>
+    let key := open_constr:(_) in
+    (* We exploit that [typeclasses eauto] is multi-success to enable
+    multiple implementations of [FindInContext]. They are tried in the
+    order of their priorities.
+    See https://coq.zulipchat.com/#narrow/stream/237977-Coq-users/topic/Multi-success.20TC.20resolution.20from.20ltac.3F/near/242759123 *)
+    once (simple notypeclasses refine (tac_find_in_context key _ _);
+      [ shelve | typeclasses eauto | simpl; repeat liExist false; liFindHypOrTrue key ])
+  end.
+
+
+(** ** [liDoneEvar] *)
+(** Internal goal to share evars between subgoals of and. Used by the
+[□ P ∗ G] goal. *)
+(* TODO: Use this more widely, e.g. for general ∧? *)
+
+(** [li_done_evar_type] is an opaque wrapper for the type of the
+shared evar since a hypothesis of type [?Goal] gets instantiated
+accidentally by various tactics. *)
+#[projections(primitive)] Record li_done_evar_type (A : Type) := { li_done_evar_val : A }.
+Global Arguments li_done_evar_val {_} _.
+
+Definition li_done_evar {prop:bi} {A X} (x : A) (y : li_done_evar_type X) (f : X → A) : prop :=
+  ⌜x = f (li_done_evar_val y)⌝.
+Section coq_tactics.
+  Context {prop : bi}.
+  Lemma tac_li_done_evar_ex {A X} (f : X → A) y Δ :
+    envs_entails Δ (∃ x', li_done_evar (prop := prop) (f x') y f).
+  Proof. rewrite envs_entails_unseal. iIntros "HΔ". by iExists _. Qed.
+
+  Lemma tac_li_done_evar {A} (x : A) y Δ :
+    envs_entails Δ (li_done_evar (prop := prop) x y (λ _ : unit, x)).
+  Proof. rewrite envs_entails_unseal. iIntros "HΔ". done. Qed.
+End coq_tactics.
+
+Ltac liDoneEvar :=
+  lazymatch goal with
+  | |- envs_entails ?Δ (∃ₗ x', li_done_evar (@?x x') ?y _) =>
+      notypeclasses refine (tac_li_done_evar_ex x y Δ)
+  | |- envs_entails ?Δ (li_done_evar ?x ?y _) =>
+      notypeclasses refine (tac_li_done_evar x y Δ)
+  end.
+
+(** ** [liSep] *)
+Section coq_tactics.
+  Context {prop : bi}.
+  Hypothesis BiPositive_prop : BiPositive prop.
+  Hypothesis BiPersistentlyForall_prop : BiPersistentlyForall prop.
+
+  Lemma tac_sep_sep_assoc Δ (P Q R : prop) :
+    envs_entails Δ (P ∗ Q ∗ R) → envs_entails Δ ((P ∗ Q) ∗ R).
+  Proof. apply tac_fast_apply. iIntros "($&$&$)". Qed.
+
+  Lemma tac_sep_sep_assoc_ex {A B} Δ (P Q R : (A *ₗ B) → prop) :
+    envs_entails Δ (∃ₗ x, P x ∗ Q x ∗ R x) → envs_entails Δ (∃ₗ x, (P x ∗ Q x) ∗ R x).
+  Proof. apply tac_fast_apply. iIntros "(%a&?&?&?)". iExists _. iFrame. Qed.
+
+  Lemma tac_sep_emp Δ (P : prop) :
+    envs_entails Δ P → envs_entails Δ (emp ∗ P).
+  Proof. apply tac_fast_apply. by apply bi.emp_sep_1. Qed.
+
+  Lemma tac_sep_exist_assoc {A} Δ (Φ : A → prop) (Q : prop):
+    envs_entails Δ (∃ a : A, Φ a ∗ Q) → envs_entails Δ ((∃ a : A, Φ a) ∗ Q).
+  Proof. by rewrite bi.sep_exist_r. Qed.
+
+  Lemma tac_sep_exist_assoc_ex {A B C} Δ (Φ : (B *ₗ C) → A → prop) (Q : _ → prop):
+    envs_entails Δ (∃ₗ x, ∃ a : A, Φ x a ∗ Q x) → envs_entails Δ (∃ₗ x, (∃ a : A, Φ x a) ∗ Q x).
+  Proof. apply tac_fast_apply. apply bi.exist_mono => ?. by rewrite bi.sep_exist_r. Qed.
+
+  Lemma tac_do_intro_intuit_sep Δ (P Q : prop) :
+    envs_entails Δ (□ (P ∗ True) ∧ Q) → envs_entails Δ (□ P ∗ Q).
+  Proof using BiPersistentlyForall_prop BiPositive_prop. apply tac_fast_apply. iIntros "[#[$ _] $]". Qed.
+
+  Lemma tac_do_intro_intuit_sep_ex {A B X} Δ (P Q : (A *ₗ B) → prop) (f : X → _) :
+    (∀ y, envs_entails Δ (□ (∃ₗ x, P x ∗ li_done_evar x y f))) →
+    envs_entails Δ (∃ y, Q (f y)) →
+    envs_entails Δ (∃ₗ x, □ (P x) ∗ Q x).
+  Proof using BiPersistentlyForall_prop BiPositive_prop.
+    rewrite envs_entails_unseal /li_done_evar. move => /bi.forall_intro HP HQ.
+    iIntros "HΔ". iDestruct (HP with "HΔ") as "#HP".
+    iDestruct (HQ with "HΔ") as (y) "HQ".
+    iDestruct ("HP" $! {|li_done_evar_val := y|}) as (?) "[#? ->]". simpl.
+    iExists _. iFrame "∗#".
+  Qed.
+
+  Lemma tac_do_simplify_goal Δ (n : N) (P : prop) T {SG : SimplifyGoal P (Some n)} :
+    envs_entails Δ (SG T).(i2p_P) → envs_entails Δ (P ∗ T).
+  Proof. apply tac_fast_apply. iIntros "HP". by iApply (i2p_proof with "HP"). Qed.
+
+  Lemma tac_do_simplify_goal_ex {A B} Δ (n : N) (P : (A *ₗ B) → prop) T
+    {SG : ∀ x, SimplifyGoal (P x) (Some n)} :
+    envs_entails Δ (∃ₗ x, (SG x (T x)).(i2p_P)) → envs_entails Δ (∃ₗ x, P x ∗ T x).
+  Proof.
+    apply tac_fast_apply. apply bi.exist_mono => ?.
+    iIntros "HP". by iApply (i2p_proof with "HP").
+  Qed.
+
+  Lemma tac_intro_subsume_related Δ P T {Hrel : RelatedTo (λ _ : unit, P)}:
+    envs_entails Δ (find_in_context Hrel.(rt_fic) (λ x,
+      @subsume prop unit (Hrel.(rt_fic).(fic_Prop) x) (λ _, P) (λ _, T))) →
+    envs_entails Δ (P ∗ T).
+  Proof.
+    apply tac_fast_apply. iDestruct 1 as (x) "[HP HT]".
+    iDestruct ("HT" with "HP") as (?) "$".
+  Qed.
+
+  Lemma tac_intro_subsume_related_ex Δ {A B} (P T : (A *ₗ B) → prop) {Hrel : RelatedTo P}:
+    envs_entails Δ (find_in_context Hrel.(rt_fic) (λ x,
+      @subsume prop _ (Hrel.(rt_fic).(fic_Prop) x) P T)) →
+    envs_entails Δ (∃ₗ x, P x ∗ T x).
+  Proof. apply tac_fast_apply. iDestruct 1 as (x) "[HP HT]". by iApply "HT". Qed.
+
+End coq_tactics.
+
+Ltac liSep :=
+  try liEnsureSepHead;
+  lazymatch goal with
+  | |- envs_entails ?Δ (bi_sep ?P ?Q) =>
+    lazymatch P with
+    | bi_sep _ _ => notypeclasses refine (tac_sep_sep_assoc _ _ _ _ _)
+    | bi_exist _ => notypeclasses refine (tac_sep_exist_assoc _ _ _ _)
+    | bi_emp => notypeclasses refine (tac_sep_emp _ _ _)
+    | (⌜_⌝)%I => fail "handled by liSideCond"
+    | (□ ?P)%I => notypeclasses refine (tac_do_intro_intuit_sep _ _ _ _ _ _)
+    | match ?x with _ => _ end => fail "should not have match in sep"
+    | ?P => first [
+        progress liFindHyp FICSyntactic
+      | simple notypeclasses refine (tac_do_simplify_goal _ 0%N _ _ _); [solve [refine _] |]
+      | simple notypeclasses refine (tac_intro_subsume_related _ _ _ _); [solve [refine _] |];
+        simpl; liFindInContext
+      | simple notypeclasses refine (tac_do_simplify_goal _ _ _ _ _); [| solve [refine _] |]
+      | fail "liSep: unknown sidecondition" P
+    ]
+    end
+  | |- envs_entails ?Δ (∃ₗ x, bi_sep (@?P x) _) =>
+    lazymatch P with
+    | (λ _, bi_sep _ _) => notypeclasses refine (tac_sep_sep_assoc_ex _ _ _ _ _)
+    | (λ _, bi_exist _) => notypeclasses refine (tac_sep_exist_assoc_ex _ _ _ _)
+    (* bi_emp cannot happen because it is independent of evars *)
+    | (λ _, (⌜_⌝)%I) => fail "handled by liSideCond"
+    | (λ _, (□ _)%I) => refine (tac_do_intro_intuit_sep_ex _ _ _ _ _ _ _ _)
+    (* The following is probably not necessary: *)
+    (* | match ?x with _ => _ end => fail "should not have match in sep" *)
+    | ?P => first [
+        (* We can't (and don't want to) cancel if there is an evar in the goal *)
+        (* progress liFindHyp FICSyntactic | *)
+        (* We use cbv beta to reduce the beta expansion in
+        SimplifyGoal such that we can match on proposition in the
+        pattern of Hint Extern. *)
+        simple notypeclasses refine (tac_do_simplify_goal_ex _ 0%N _ _ _); [intro; cbv beta; solve [refine _] |]
+      | simple notypeclasses refine (tac_intro_subsume_related_ex _ _ _ _); [solve [refine _] |];
+        simpl; liFindInContext
+      | simple notypeclasses refine (tac_do_simplify_goal_ex _ _ _ _ _); [|intro; cbv beta; solve [refine _] |]
+      | fail "liSep: unknown sidecondition" P
+    ]
+    end
+  end.
+
+Module liSep_tests. Section test.
+  Context {prop : bi}.
+  Hypothesis BiPositive_prop : BiPositive prop.
+  Hypothesis BiPersistentlyForall_prop : BiPersistentlyForall prop.
+
+  Variable A1 A2 A3 : Z → prop.
+
+  Hypothesis HA2 : ∀ (n : Z) G, (<affine> ⌜n = 1%Z⌝ ∗ G ⊢ simplify_goal (A2 n) G).
+  Definition HA2_inst := [instance HA2 with 0%N].
+  Local Existing Instance HA2_inst.
+
+  Definition FindA3 := {| fic_A := Z; fic_Prop := A3; |}.
+  Local Typeclasses Opaque FindA3.
+
+  Lemma find_in_context_A3 (T : Z → prop):
+    find_in_context (FindA3) T :- pattern: x, A3 x; return T x.
+  Proof. done. Qed.
+  Definition find_in_context_A3_inst := [instance @find_in_context_A3 with FICSyntactic].
+  Local Existing Instance find_in_context_A3_inst | 1.
+
+  Local Instance A3_related A n : RelatedTo (λ x : A, A3 (n x)) :=
+    {| rt_fic := FindA3 |}.
+
+  Lemma subsume_A3 A n m G:
+    subsume (A3 n) (λ x : A, A3 (m x)) G :- ∃ x, exhale <affine> ⌜n = m x⌝; return G x.
+  Proof. liFromSyntax. iDestruct 1 as (? ->) "?". iIntros "?". iExists _. iFrame. Qed.
+
+  Definition subsume_A3_inst := [instance subsume_A3].
+  Local Existing Instance subsume_A3_inst.
+
+
+  Goal ∀ P : Z → Z → prop,
+      ⊢ A1 1 -∗ A3 1 -∗ ∃ x y, (A1 1 ∗ ∃ z, A2 x ∗ A3 z ∗ <affine> ⌜z = y⌝) ∗ P x y.
+    intros. iStartProof. iIntros. repeat liExist.
+    liSep.
+    liSep.
+    liSep.
+    liExist.
+    liSep.
+    liSep. simpl.
+    liSideCond.
+    liSep.
+    liSep.
+    liExtensible. simpl. li_unfold_lets_in_context.
+    liSideCond.
+    liSideCond.
+    liExist.
+    lazymatch goal with
+    | |- envs_entails _ (P 1%Z 1%Z) => idtac
+    end.
+  Abort.
+
+  Goal  ∀ P : Z → Z → Z → prop,
+      ⊢ ∃ x y z, □ (<affine> ⌜x = 1%Z⌝ ∗ <affine> ⌜y = 2%Z⌝) ∗ <affine> ⌜z = 3%Z⌝ ∗ P x y z.
+    intros. iStartProof. iIntros. repeat liExist.
+    1: liSep.
+    1: liForall.
+    1: iModIntro.
+    1: liSep.
+    1: liSideCond.
+    1: liSideCond.
+    1: liDoneEvar.
+    1: liSideCond.
+    1: liExist.
+    lazymatch goal with
+    | |- envs_entails _ (P 1%Z 2%Z 3%Z) => idtac
+    end.
+  Abort.
+
+  Goal  ∀ P : Z → Z → Z → prop,
+      ⊢ ∃ x y z, □ (<affine> ⌜x = 1%Z⌝ ∗ □ <affine> ⌜y = 2%Z⌝) ∗ <affine> ⌜z = 3%Z⌝ ∗ P x y z.
+    intros. iStartProof. iIntros. repeat liExist.
+    1: liSep.
+    1: liForall.
+    1: iModIntro.
+    1: liSep.
+    1: liSideCond.
+    1: liSep.
+    1: liForall.
+    1: iModIntro.
+    1: liSideCond.
+    1: liDoneEvar.
+    1: liDoneEvar.
+    1: liSideCond.
+    1: liExist.
+    lazymatch goal with
+    | |- envs_entails _ (P 1%Z 2%Z 3%Z) => idtac
+    end.
+  Abort.
+
+  Goal  ∀ P : Z → Z → Z → prop,
+      ⊢ ∃ x y z, □ (<affine> ⌜x = 1%Z⌝ ∗ <affine> ⌜y = 2%Z⌝ ∗ <affine> ⌜z = 3%Z⌝) ∗ P x y z.
+    intros. iStartProof. iIntros. repeat liExist.
+    1: liSep.
+    1: liForall.
+    1: iModIntro.
+    1: liSep.
+    1: liSideCond.
+    1: liSep.
+    1: liSideCond.
+    1: liSideCond.
+    1: liExist.
+    1: liDoneEvar.
+    1: liExist.
+    1: liSimpl.
+    lazymatch goal with
+    | |- envs_entails _ (P 1%Z 2%Z 3%Z) => idtac
+    end.
+  Abort.
+
+  Goal  ∀ P : Z → prop,
+      ⊢ ∃ x, □ (const (<affine> True) x) ∗ <affine> ⌜x = 1%Z⌝ ∗ P x.
+    intros. iStartProof. iIntros. repeat liExist.
+    1: liSep.
+    1: liForall.
+    1: iModIntro. 1: simpl.
+    1: liSideCond.
+    1: liDoneEvar.
+    1: liSideCond.
+    1: liExist.
+    lazymatch goal with
+    | |- envs_entails _ (P 1%Z) => idtac
+    end.
+  Abort.
+
+End test. End liSep_tests.
+
+
+(** ** [liWand] *)
+Section coq_tactics.
+  Context {prop : bi}.
+  Hypothesis BiPositive_prop : BiPositive prop.
+  Hypothesis BiPersistentlyForall_prop : BiPersistentlyForall prop.
+
+  Lemma tac_do_intro_pure Δ (P : Prop) (Q : prop) :
+    (P → envs_entails Δ Q) → envs_entails Δ (<affine> ⌜P⌝ -∗ Q).
+  Proof.
+    rewrite envs_entails_unseal => HP. iIntros "HΔ %".  by iApply HP.
+  Qed.
+
+  Lemma tac_do_simplify_hyp (P : prop) (SH: SimplifyHyp P (Some 0%N)) Δ T :
+    envs_entails Δ (SH T).(i2p_P) →
+    envs_entails Δ (P -∗ T).
+  Proof.
+    rewrite envs_entails_unseal => HP. iIntros "Henv Hl".
+    iDestruct (HP with "Henv") as "HP".
+    iDestruct (i2p_proof with "HP Hl") as "$".
+  Qed.
+
+  Lemma tac_do_intro i n' (P : prop) n Γs Γp T :
+    env_lookup i Γs = None →
+    env_lookup i Γp = None →
+    envs_entails (Envs Γp (Esnoc Γs i P) n') T →
+    envs_entails (Envs Γp Γs n) (P -∗ T).
+  Proof.
+    rewrite envs_entails_unseal => Hs Hp HP. iIntros "Henv Hl".
+    rewrite (envs_app_sound (Envs Γp Γs n) (Envs Γp (Esnoc Γs i P) n) false (Esnoc Enil i P)) //; simplify_option_eq => //.
+    iApply HP. iApply "Henv". iFrame.
+  Qed.
+
+  Lemma tac_do_intro_intuit i n' (P P' : prop) T n Γs Γp (Hpers : IntroPersistent P P') :
+    env_lookup i Γs = None →
+    env_lookup i Γp = None →
+    envs_entails (Envs (Esnoc Γp i P') Γs n') T →
+    envs_entails (Envs Γp Γs n) (<affine> P -∗ T).
+  Proof.
+    rewrite envs_entails_unseal => Hs Hp HP. iIntros "Henv HP".
+    iDestruct (@ip_persistent _ _ _ Hpers with "HP") as "#HP'".
+    rewrite (envs_app_sound (Envs Γp Γs n) (Envs (Esnoc Γp i P') Γs n) true (Esnoc Enil i P')) //; simplify_option_eq => //.
+    iApply HP. iApply "Henv".
+    iModIntro. by iSplit.
+  Qed.
+
+  Lemma tac_wand_sep_assoc Δ (P Q R : prop) :
+    envs_entails Δ (P -∗ Q -∗ R) → envs_entails Δ ((P ∗ Q) -∗ R).
+  Proof. by rewrite bi.wand_curry. Qed.
+
+  Lemma tac_wand_emp Δ (P : prop) :
+    envs_entails Δ P → envs_entails Δ (emp -∗ P).
+  Proof. apply tac_fast_apply. by iIntros. Qed.
+
+  Lemma tac_wand_pers_sep Δ (P : prop) (Q1 Q2 : prop) :
+    envs_entails Δ ((□ Q1 ∗ □ Q2) -∗ P) → envs_entails Δ (□ (Q1 ∗ Q2) -∗ P).
+  Proof using BiPositive_prop. apply tac_fast_apply. iIntros "Hx #[? ?]". iApply "Hx". iFrame "#". Qed.
+
+  Lemma tac_wand_pers_exist A Δ (P : prop) (Q : A → prop) :
+    envs_entails Δ ((∃ x, □ Q x) -∗ P) → envs_entails Δ (□ (∃ x, Q x) -∗ P).
+  Proof. apply tac_fast_apply. iIntros "Hx #[% ?]". iApply "Hx". iExists _. iFrame "#". Qed.
+
+  Lemma tac_wand_pers_pure Δ (P : prop) Φ :
+    envs_entails Δ (⌜Φ⌝ -∗ P) → envs_entails Δ (□ ⌜Φ⌝ -∗ P).
+  Proof. apply tac_fast_apply. iIntros "HP %". by iApply "HP". Qed.
+End coq_tactics.
+
+Ltac liWand :=
+  let wand_intro P :=
+    first [
+      let SH := constr:(_ : SimplifyHyp P (Some 0%N)) in
+      simple notypeclasses refine (tac_do_simplify_hyp P SH _ _ _)
+    | let P' := open_constr:(_) in
+      let ip := constr:(_ : IntroPersistent P P') in
+      let n := lazymatch goal with | [ H := Envs _ _ ?n |- _ ] => n end in
+      let H := constr:(IAnon n) in
+      let n' := eval vm_compute in (Pos.succ n) in
+      simple notypeclasses refine (tac_do_intro_intuit H n' P P' _ _ _ _ ip _ _ _); [li_pm_reflexivity..|]
+    | let n := lazymatch goal with | [ H := Envs _ _ ?n |- _ ] => n end in
+      let H := constr:(IAnon n) in
+      let n' := eval vm_compute in (Pos.succ n) in
+      simple notypeclasses refine (tac_do_intro H n' P _ _ _ _ _ _ _); [li_pm_reflexivity..|]
+    ] in
+  lazymatch goal with
+  | |- envs_entails ?Δ (bi_wand ?P ?T) =>
+      lazymatch P with
+      | bi_sep _ _ =>
+          li_let_bind T (fun H => constr:(envs_entails Δ (bi_wand P H)));
+          notypeclasses refine (tac_wand_sep_assoc _ _ _ _ _)
+      | bi_exist _ => fail "handled by liForall"
+      | bi_emp => notypeclasses refine (tac_wand_emp _ _ _)
+      | bi_pure _ => notypeclasses refine (tac_do_intro_pure _ _ _ _)
+      | bi_intuitionistically (bi_sep _ _) => notypeclasses refine (tac_wand_pers_sep _ _ _ _ _)
+      | bi_intuitionistically (bi_exist _) => notypeclasses refine (tac_wand_pers_exist _ _ _ _ _)
+      | bi_intuitionistically (bi_pure _) => notypeclasses refine (tac_wand_pers_pure _ _ _ _)
+      | match ?x with _ => _ end => fail "should not have match in wand"
+      | _ => wand_intro P
+      end
+  end.
+
+(** ** [liAnd] *)
+Section coq_tactics.
+  Context {prop : bi}.
+
+  Lemma tac_do_split Δ (P1 P2 : prop):
+    envs_entails Δ P1 →
+    envs_entails Δ P2 →
+    envs_entails Δ (P1 ∧ P2).
+  Proof. rewrite envs_entails_unseal => HP1 HP2. by apply bi.and_intro. Qed.
+
+  Lemma tac_big_andM_insert Δ {A B} `{Countable A} (m : gmap A B) i n (Φ : _ → _→ prop) :
+    envs_entails Δ (<affine> ⌜m !! i = None⌝ ∗ (Φ i n ∧ [∧ map] k↦v∈m, Φ k v)) →
+    envs_entails Δ ([∧ map] k↦v∈<[i:=n]>m, Φ k v).
+  Proof. apply tac_fast_apply. iIntros "[% HT]". by rewrite big_andM_insert. Qed.
+
+  Lemma tac_big_andM_empty Δ {A B} `{Countable A} (Φ : _ → _→ prop) :
+    envs_entails Δ ([∧ map] k↦v∈(∅ : gmap A B), Φ k v).
+  Proof. rewrite envs_entails_unseal. iIntros "?". by rewrite big_andM_empty. Qed.
+End coq_tactics.
+
+Ltac liAnd :=
+  lazymatch goal with
+  | |- envs_entails _ (bi_and ?P _) =>
+    notypeclasses refine (tac_do_split _ _ _ _ _)
+  | |- envs_entails _ ([∧ map] _↦_∈<[_:=_]>_, _) =>
+    notypeclasses refine (tac_big_andM_insert _ _ _ _ _ _)
+  | |- envs_entails _ ([∧ map] _↦_∈∅, _) =>
+    notypeclasses refine (tac_big_andM_empty _ _)
+  end.
+
+(* TODO Ke: is not valid anymore because logic is linear? maybe to a weaker version where spatial context is empty? *)
+(* 
+(** ** [liPersistent] *)
+Section coq_tactics.
+  Context {prop : bi}.
+
+  Lemma tac_persistent Δ (P : prop) :
+    envs_entails (envs_clear_spatial Δ) P → envs_entails Δ (□ P).
+  Proof.
+    rewrite envs_entails_unseal => HP. iIntros "Henv".
+    iDestruct (envs_clear_spatial_sound with "Henv") as "[#Henv _]".
+    iModIntro. iApply (HP with "Henv").
+  Qed. 
+End coq_tactics.
+
+Ltac liPersistent :=
+  lazymatch goal with
+  | |- envs_entails ?Δ (bi_intuitionistically ?P) =>
+      notypeclasses refine (tac_persistent _ _ _); li_pm_reduce
+  end.
+*)
+
+(** ** [liCase] *)
+Section coq_tactics.
+  Context {prop : bi}.
+
+  Lemma tac_case_if Δ (P : Prop) T1 T2 :
+    (P → envs_entails Δ T1) →
+    (¬ P → envs_entails Δ T2) →
+    envs_entails Δ (@case_if prop P T1 T2).
+  Proof.
+    rewrite envs_entails_unseal => HT1 HT2.
+    iIntros "Henvs". iSplit; iIntros (?).
+    - by iApply HT1.
+    - by iApply HT2.
+  Qed.
+
+  Lemma tac_case_destruct_bool_decide Δ (P : Prop) `{!Decision P} T:
+    (P → envs_entails Δ (T true true)) →
+    (¬ P → envs_entails Δ (T false true)) →
+    envs_entails Δ (@case_destruct prop bool (bool_decide P) T).
+  Proof.
+    rewrite envs_entails_unseal => HP HnotP.
+    iIntros "Henvs". iExists true. case_bool_decide.
+    - by iApply HP.
+    - by iApply HnotP.
+  Qed.
+
+  Lemma tac_case_destruct {A} (b : bool) Δ a T:
+    envs_entails Δ (T a b) →
+    envs_entails Δ (@case_destruct prop A a T).
+  Proof. apply tac_fast_apply. iIntros "?". iExists _. iFrame. Qed.
+End coq_tactics.
+
+(* This tactic checks if destructing x would lead to multiple
+non-trivial subgoals. The main reason for it is that we don't want to
+destruct constructors like true as this would not be useful. *)
+Ltac non_trivial_destruct x :=
+  first [
+      have : (const False x); [ clear; case_eq x; intros => //; (*
+      check if there is only one goal remaining *) [ idtac ]; fail 1 "trivial destruct" |]
+    | idtac
+  ].
+
+Ltac liCase :=
+  lazymatch goal with
+  | |- @envs_entails ?prop ?Δ (case_if ?P ?T1 ?T2) =>
+      notypeclasses refine (tac_case_if _ _ _ _ _ _)
+  | |- @envs_entails ?prop ?Δ (case_destruct (@bool_decide ?P ?b) ?T) =>
+      notypeclasses refine (tac_case_destruct_bool_decide _ _ _ _ _)
+      (* notypeclasses refine (tac_case_destruct true _ _ _ _); *)
+      (* let H := fresh "H" in destruct_decide (@bool_decide_reflect P b) as H; revert H *)
+  | |- @envs_entails ?prop ?Δ (case_destruct ?x ?T) =>
+      tryif (non_trivial_destruct x) then
+        notypeclasses refine (tac_case_destruct true _ _ _ _);
+        case_eq x
+      else (
+        notypeclasses refine (tac_case_destruct false _ _ _ _)
+      )
+  end;
+  (* It is important that we prune branches this way because this way
+  we don't need to do normalization and simplification of hypothesis
+  that we introduce twice, which has a big impact on performance. *)
+  repeat (liForall || liImpl); try by [exfalso; can_solve].
+
+(** ** [liTactic] *)
+Section coq_tactics.
+  Context {prop : bi}.
+
+  Lemma tac_li_tactic {A} Δ t (th : LiTactic t) (Q : A → prop):
+    envs_entails Δ (th.(li_tactic_P) Q) →
+    envs_entails Δ (li_tactic t Q).
+  Proof. rewrite envs_entails_unseal => ?. etrans; [done|]. apply li_tactic_proof. Qed.
+End coq_tactics.
+
+Ltac liTactic :=
+  lazymatch goal with
+  | |- envs_entails _ (li_tactic _ _) =>
+      simple notypeclasses refine (tac_li_tactic _ _ _ _ _); [ solve [refine _] |]
+  end.
+
+(** ** [liAccu] *)
+Section coq_tactics.
+  Context {prop : bi}.
+
+  Lemma tac_do_accu Δ (f : prop → prop):
+    envs_entails (envs_clear_spatial Δ) (f (env_to_prop (env_spatial Δ))) →
+    envs_entails Δ (accu f).
+  Proof.
+    rewrite envs_entails_unseal => Henv. iIntros "Henv".
+    iDestruct (envs_clear_spatial_sound with "Henv") as "[#Henv Hs]".
+    iExists (env_to_prop (env_spatial Δ)).
+    rewrite -env_to_prop_sound. iFrame. iModIntro. by iApply (Henv with "Henv").
+  Qed.
+End coq_tactics.
+
+Ltac liAccu :=
+  lazymatch goal with
+  | |- envs_entails _ (accu _) =>
+    notypeclasses refine (tac_do_accu _ _ _); li_pm_reduce
+  end.
+
+(** ** [liTrace] *)
+Ltac liTrace :=
+  lazymatch goal with
+  | |- @envs_entails ?prop ?Δ (li_trace ?info ?T) =>
+    change_no_check (@envs_entails prop Δ T);
+    liTrace_hook info
+  end.
+
+(* too slow and too aggressive, for instance takes apart <affine> *)
+Ltac push_in_embed_hard :=
+  (rewrite ?embed_wand ?embed_wand_iff ?embed_forall ?embed_exist ?embed_and ?embed_or ?embed_impl
+                ?embed_iff ?embed_sep ?embed_pure ?embed_emp ?embed_affinely ?embed_persistently
+                ?embed_absorbingly -?embed_embed).
+
+From iris.bi Require Import monpred.
+Local Open Scope bi_scope.
+
+      (* FIXME this tactic is for rewriting under binders i.e. bi_exist.
+         rewrite is too aggresive; would be nice if we can pattern match under binder setoid_rewrite [lem] **)
+Ltac push_in_embed_setoid :=
+    (* try setoid_rewrite embed_wand;
+    try setoid_rewrite embed_wand_iff;
+    try setoid_rewrite embed_forall;
+    try setoid_rewrite embed_exist;
+    try setoid_rewrite embed_and;
+    try setoid_rewrite embed_or;
+    try setoid_rewrite embed_impl;
+    try setoid_rewrite embed_iff;
+    try setoid_rewrite embed_sep; *)
+    try setoid_rewrite embed_pure;
+    try setoid_rewrite embed_emp;
+    try setoid_rewrite embed_affinely;
+    (* try setoid_rewrite embed_persistently;
+    try setoid_rewrite embed_absorbingly;
+    try setoid_rewrite embed_embed;
+    try setoid_rewrite embed_bupd;
+    try setoid_rewrite embed_fupd;
+    try setoid_rewrite embed_intuitionistically;
+    try setoid_rewrite embed_except_0;
+    try setoid_rewrite embed_later;
+    try setoid_rewrite embed_laterN;
+    try setoid_rewrite embed_plainly;
+    try setoid_rewrite embed_plainly_if;
+    try setoid_rewrite embed_affinely_if;
+    try setoid_rewrite embed_persistently_if;
+    try setoid_rewrite embed_absorbingly_if;
+    try setoid_rewrite embed_intuitionistically_if;
+    try setoid_rewrite embed_internal_eq;
+    (* not sure how to deal with other forms in `bi_embed $ monPred_at ...`, add them when in need *)
+    try setoid_rewrite monPred_at_sep;
+    try setoid_rewrite monPred_at_affinely *)
+    idtac
+    .
+
+(* push_in_embed_hard test *)
+(* if head symbol of R is `embed _`, push the embed in.
+    do some ad hoc stuff with monPred_in as well *)
+Ltac push_in_embed R :=
+  lazymatch R with
+  | ⎡ ?R' ⎤ =>
+    lazymatch R' with
+    | bi_wand ?P ?Q => rewrite [R] (embed_wand P Q)
+    | bi_wand_iff ?P ?Q => rewrite [R] (embed_wand_iff P Q)
+    | bi_forall ?P => rewrite [R] (embed_forall _ P)
+    | bi_exist ?P => rewrite [R] (embed_exist _ P)
+    | bi_and ?P ?Q => rewrite [R] (embed_and P Q)
+    | bi_or ?P ?Q => rewrite [R] (embed_or P Q)
+    | bi_impl ?P ?Q => rewrite [R] (embed_impl P Q)
+    | bi_iff ?P ?Q => rewrite [R] (embed_iff P Q) 
+    | bi_sep ?P ?Q => rewrite [R] (embed_sep P Q)
+    | bi_pure ?P => rewrite [R] (embed_pure P)
+    | bi_emp => rewrite [R] (embed_emp)
+    | <affine> ?P => rewrite [R] (embed_affinely P)
+    | <pers> ?P => rewrite [R] (embed_persistently P)
+    | <absorb> ?P => rewrite [R] (embed_absorbingly P)
+    | ⎡ ?P ⎤ => rewrite - [R] (embed_embed P)
+    | |==> ?P => rewrite [R] (embed_bupd P)
+    | |={?E1,?E2}=> ?P => rewrite [R] (embed_fupd E1 E2 P)
+    | □ ?P => rewrite [R] (embed_intuitionistically P)
+    | ◇ ?P => rewrite [R] (embed_except_0 P)
+    | ▷ ?P => rewrite [R] (embed_later P)
+    | ▷^ ?n ?P => rewrite [R] (embed_laterN n P)
+    | ■ ?P => rewrite [R] (embed_plainly P)
+    | ■? ?p ?P => rewrite [R] (embed_plainly_if p P)
+    | <affine>? ?b ?P => rewrite [R] (embed_affinely_if P)
+    | <pers>? ?b ?P => rewrite [R] (embed_persistently_if P)
+    | <absorb>? ?b ?P => rewrite [R] (embed_absorbingly_if P)
+    | □? ?b ?P => rewrite [R] (embed_intuitionistically_if P)
+    | ?x ≡ ?y => rewrite [R] (embed_internal_eq x y)
+    (* not sure how to deal with other forms in `bi_embed $ monPred_at ...`, add them when in need *)
+    | monPred_at (?P ∗ ?Q ) _ => rewrite [R'] (monPred_at_sep _ P Q)
+    | monPred_at (<affine> ?P) _ => rewrite [R'] (monPred_at_affinely _ P)
+    end
+  end.
+
+(* TODO make sure rewrites happen in exactly the subterm R (like [R in (envs_entails _ (bi_wand R _))])
+   instead of any place matching R *)
+Ltac push_in_embed_for_head :=
+  let push_in_embed_inside_term H :=
+    match H with | context [@embed ?p1 ?p2 _ ?H] => push_in_embed (@embed p1 p2 _ H) end in
+  lazymatch goal with
+  | |- envs_entails ?Δ ?P =>
+    lazymatch P with
+    | embed ?H => push_in_embed (embed H)
+    | bi_wand ?H _ => push_in_embed_inside_term H
+    | bi_sep ?H _ => push_in_embed_inside_term H
+    | bi_exist ?H => idtac H; progress push_in_embed_setoid
+    (* | ?un_op ?H => idtac "unop" un_op; push_in_embed H
+    | ?bin_op ?H _ => idtac "binop" bin_op; push_in_embed H *)
+    end end.
+
+Ltac push_in_monPred :=
+  progress lazymatch goal with
+  | |- envs_entails ?Δ ?P =>
+    rewrite ?[in P]monPred_at_sep ?[in P]monPred_at_affinely ?[in P]monPred_at_embed
+  end.
+
+(** ** [liStep] *)
+Ltac liStep :=
+  first [
+    push_in_embed_for_head
+    | push_in_monPred
+    | liExtensible
+    | liSep
+    | liAnd
+    | liWand
+    | liExist
+    | liImpl
+    | liForall
+    | liSideCond
+    | liFindInContext
+    | liCase
+    | liTrace
+    | liTactic
+    (* | liPersistent *)
+    | liTrue
+    | liFalse
+    | liAccu
+    | liDoneEvar
+    | liUnfoldLetGoal
+    ].
+
+(* push_in_embed_for_head test *)
+Goal forall `{!BiEmbed prop1 prop2} (A B E: prop1) C D,
+  (⎡ A -∗ B ⎤ ⊢ ⎡ ∀ x:nat, C x -∗ D x -∗ E ⎤)%I.
+iIntros.
+liStep.
+liStep.
+liStep.
+
+(* liWand seems to require this tactic to put a copy of the envs into Coq context*)
+liEnsureInvariant.
+liStep.
+liStep.
+liEnsureInvariant.
+liStep.
+lazymatch goal with
+  | |- envs_entails _ (⎡E⎤) => idtac
+end.
+Abort.
\ No newline at end of file
diff --git a/refinedVST/lithium/lvar.v b/refinedVST/lithium/lvar.v
new file mode 100644
index 0000000000..22583d6529
--- /dev/null
+++ b/refinedVST/lithium/lvar.v
@@ -0,0 +1,25 @@
+From VST.lithium Require Import definitions simpl_classes proof_state.
+
+Inductive LVAR_HINT {A} (name : string) (x : A) : Prop := { lvar_locked : locked True }.
+Definition lvar (name : string) (A : Type) : Type := A.
+
+Definition set_lvar {prop:bi} {A} (name : string) (x : A) : prop := True.
+Global Typeclasses Opaque set_lvar.
+
+Notation "'lvar' id : v" := (LVAR_HINT id v) (at level 200, only printing).
+
+Lemma simplify_goal_set_lvar (prop:bi) A (x : A) name (T : prop) :
+  (<affine>⌜LVAR_HINT name x⌝ -∗ T) ⊢ simplify_goal (set_lvar name x) T.
+Proof.
+  iIntros "HT". rewrite /set_lvar. iSplit => //. iApply "HT".
+  iPureIntro. constructor. by unlock.
+Qed.
+Definition simplify_goal_set_lvar_inst := [instance simplify_goal_set_lvar with 0%N].
+Global Existing Instance simplify_goal_set_lvar_inst.
+
+Lemma simpl_exist_lvar (prop:bi) A (x : A) name :
+  LVAR_HINT name x →
+  @SimplExist prop (lvar name A) (λ P, P x)%I.
+Proof. move => ?. rewrite /SimplExist. iIntros (?) "?". iExists _. iFrame. Qed.
+Global Hint Extern 2 (SimplExist (lvar ?i _) _) =>
+         (notypeclasses refine (simpl_exist_lvar _ _ _ _ _); eassumption) : typeclass_instances.
diff --git a/refinedVST/lithium/proof_state.v b/refinedVST/lithium/proof_state.v
new file mode 100644
index 0000000000..6a3bb67008
--- /dev/null
+++ b/refinedVST/lithium/proof_state.v
@@ -0,0 +1,233 @@
+(* ORA/ouPred version of lithium/proof_state.v *)
+From iris.proofmode Require Import coq_tactics reduction.
+From lithium Require Export base.
+From lithium Require Import hooks.
+From VST.lithium Require Import definitions syntax.
+Set Default Proof Using "Type".
+
+(** This file contains some tactics for proof state management. *)
+
+(** * Management of shelved sideconditions  *)
+Definition SHELVED_SIDECOND (P : Prop) : Prop := P.
+Arguments SHELVED_SIDECOND : simpl never.
+Strategy expand [SHELVED_SIDECOND].
+
+Ltac shelve_sidecond :=
+  idtac;
+  lazymatch goal with
+  | |- ?G => change_no_check (SHELVED_SIDECOND G); shelve
+  end.
+
+Ltac unshelve_sidecond :=
+  idtac;
+  lazymatch goal with
+  | |- SHELVED_SIDECOND ?G => change_no_check G
+  | |- _ => shelve
+  end.
+
+(** * Generating typeclass instances *)
+(** [generate_i2p_instance print to_tc c] generates an instance for an
+[iProp_to_Prop]-based typeclass from the lemma c. The parameters not
+part of the arguments of the typeclass must come last in the same
+order as expected by the typeclass. This tactic tries to solve pure
+[Prop] assumptions via [eq_refl]. [to_tc] is a tactic that converts
+the conclusion of the lemma to the corresponding typeclass and is
+called with [arg]. [print] controls whether to output debug printing.
+*)
+Ltac generate_i2p_instance print to_tc arg c :=
+  let do_print t := tryif print then t else idtac in
+  let do_to_tc c :=
+    match c with
+    (* to_tc must be first to allow overriding of the cases below *)
+    | _ => to_tc arg c
+    | subsume ?x1 ?x2 => constr:(Subsume x1 x2)
+    | find_in_context ?x1 => constr:(FindInContext x1 arg)
+    | simplify_hyp ?x1 => constr:(SimplifyHyp x1 (Some arg))
+    | simplify_goal ?x1 => constr:(SimplifyGoal x1 (Some arg))
+    end in
+  let type_c := type of c in
+  let type_c := eval lazy zeta in type_c in
+  do_print ltac:(idtac "current:" c);
+  do_print ltac:(idtac "type:" type_c);
+  (* Try to find the typeclass *)
+  try (
+    let tc := lazymatch type_c with
+    | (∀ _ _ _ _ _ _ _ _ _ _, _ ⊢ ?Q _ _ _ _ _ _ _ _ _ _) => do_to_tc Q
+    | (∀ _ _ _ _ _ _ _ _ _, _ ⊢ ?Q _ _ _ _ _ _ _ _ _) => do_to_tc Q
+    | (∀ _ _ _ _ _ _ _ _, _ ⊢ ?Q _ _ _ _ _ _ _ _) => do_to_tc Q
+    | (∀ _ _ _ _ _ _ _, _ ⊢ ?Q _ _ _ _ _ _ _) => do_to_tc Q
+    | (∀ _ _ _ _ _ _, _ ⊢ ?Q _ _ _ _ _ _) => do_to_tc Q
+    | (∀ _ _ _ _ _, _ ⊢ ?Q _ _ _ _ _) => do_to_tc Q
+    | (∀ _ _ _ _, _ ⊢ ?Q _ _ _ _) => do_to_tc Q
+    | (∀ _ _ _, _ ⊢ ?Q _ _ _) => do_to_tc Q
+    | (∀ _ _, _ ⊢ ?Q _ _) => do_to_tc Q
+    | (∀ _, _ ⊢ ?Q _) => do_to_tc Q
+    end in
+    do_print ltac:(idtac "found typeclass:" tc);
+    notypeclasses refine (_ : tc));
+  (* Try to reorder hypothesis that don't occur in the goal to the
+  front (e.g. TCDone assumptions or similar). Note that this code
+  reverse the order if there are multiple such assumptions. *)
+  let c := match type_c with
+           | (∀ a1 a2 a3 a4 a5 _, _ ⊢ ?G) =>
+               eval lazy beta zeta in (λ b a1 a2 a3 a4 a5, c a1 a2 a3 a4 a5 b)
+           | (∀ a1 a2 a3 a4 _, _ ⊢ ?G) =>
+               eval lazy beta zeta in (λ b a1 a2 a3 a4, c a1 a2 a3 a4 b)
+           | (∀ a1 a2 a3 _, _ ⊢ ?G) =>
+               eval lazy beta zeta in (λ b a1 a2 a3, c a1 a2 a3 b)
+           | (∀ a1 a2 _, _ ⊢ ?G) =>
+               eval lazy beta zeta in (λ b a1 a2, c a1 a2 b)
+           | (∀ a1 _, _ ⊢ ?G) =>
+               eval lazy beta zeta in (λ b a1, c a1 b)
+           | _ => c
+           end in
+  let type_c := type of c in
+  let type_c := eval lazy zeta in type_c in
+  do_print ltac:(idtac "current after reorder:" c);
+  do_print ltac:(idtac "type after reorder:" type_c);
+  lazymatch type_c with
+  | ∀ (a : ?T), @?P a =>
+      (* Check if there is a sidecondition after the continuation, that we
+         can solve with eq_refl. *)
+      tryif (lazymatch type of T with | Prop => let x := constr:(eq_refl : T) in idtac end) then
+          do_print ltac:(idtac "solve with eq_refl:" T);
+          let x := constr:(eq_refl : T) in
+          let y := eval lazy beta zeta in (c x) in
+          generate_i2p_instance print to_tc arg y
+      else
+          lazymatch type of c with
+          | ∀ a, @?P a =>
+              let a := fresh a in
+              notypeclasses refine (λ a, _);
+              let y := eval lazy beta zeta in (c a) in
+              generate_i2p_instance print to_tc arg y
+          end
+  | ?P ⊢ ?G =>
+      (* Finish the instance. *)
+      let Q := liFromSyntaxTerm P in
+      (* Print rule in lithium syntax *)
+(*    assert_fails (
+          assert (⊢ Q); [
+            liToSyntax;
+            lazymatch goal with | |- ⊢ ?conv =>
+            let P' := eval unfold li.ret in P in
+            lazymatch conv with
+            | P' => idtac
+            | _ => idtac G ":-" conv
+            end end;
+            fail |] ); *)
+      do_print ltac:(idtac "rule:" Q "⊢" G "term:" c);
+      notypeclasses refine (@i2p _ G Q c)
+  end.
+
+Notation "'[instance' x ]" :=
+  ltac:(generate_i2p_instance ltac:(fail) ltac:(generate_i2p_instance_to_tc_hook)
+          constr:(tt) constr:(x)) (only parsing).
+Notation "'[instance?' x ]" :=
+  ltac:(generate_i2p_instance ltac:(idtac) ltac:(generate_i2p_instance_to_tc_hook)
+          constr:(tt) constr:(x)) (only parsing).
+Notation "'[instance' x 'with' y ]" :=
+  ltac:(generate_i2p_instance ltac:(fail) ltac:(generate_i2p_instance_to_tc_hook)
+          constr:(y) constr:(x)) (only parsing).
+Notation "'[instance?' x 'with' y ]" :=
+  ltac:(generate_i2p_instance ltac:(idtac) ltac:(generate_i2p_instance_to_tc_hook)
+          constr:(y) constr:(x)) (only parsing).
+Notation "'[instance' x 'as' y ]" :=
+  ltac:(generate_i2p_instance ltac:(fail) ltac:(fun _ _ => y)
+          constr:(tt) constr:(x)) (only parsing).
+Notation "'[instance?' x 'as' y ]" :=
+  ltac:(generate_i2p_instance ltac:(idtac) ltac:(fun _ _ => y)
+          constr:(tt) constr:(x)) (only parsing).
+
+(** * Optimization: Introduce let-bindings for environment *)
+Notation "'HIDDEN'" := (Envs _ _ _) (only printing).
+
+Ltac li_pm_reduce_val v :=
+  let v := li_pm_reduce_hook v in
+  let v := reduction.pm_eval v in v.
+Ltac li_pm_reduce :=
+  match goal with
+  | H := Envs _ _ _ |- ?u =>
+    let u := eval cbv [H] in u in
+    let u := li_pm_reduce_val u in
+    change u
+  | |- ?u =>
+    let u := li_pm_reduce_val u in
+    change u
+  end.
+Ltac li_pm_reflexivity := li_pm_reduce; exact eq_refl.
+
+Ltac let_bind_envs :=
+  lazymatch goal with
+  | |- @envs_entails ?PROP ?Δ ?P =>
+    let with_H tac :=
+      match goal with
+      | [ H := Envs _ _ _ |- _] =>
+        (** if we already have a binding, try to reuse it *)
+        lazymatch Δ with H => tac H | _ => unify Δ (H); tac H end
+      | [ H := Envs _ _ _ |- _] =>
+        (** if reusing does not work, create a new let-binding *)
+        lazymatch Δ with
+        | Envs _ _ _ =>
+          let H' := fresh "IPM_JANNO" in
+          pose (H' := Δ);
+          clear H;
+          rename H' into H
+        end;
+        tac H
+      | _ =>
+        (** otherwise, create a new binding *)
+        lazymatch Δ with
+        | Envs _ _ _ =>
+          let H := fresh "IPM_JANNO" in
+          pose (H := Δ);
+          hnf in (value of H);
+          tac H
+        end
+      end in
+    with_H ltac:(fun H => change_no_check (envs_entails H P))
+  end.
+
+(** * Checking if the context contains ownership of a certain assertion *)
+(** Note that this implementation requires that [let_bind_envs] has
+  been called previously when there was a envs_entails goal. *)
+Ltac check_own_in_context P :=
+  let rec go Hs :=
+      lazymatch Hs with
+      | Esnoc ?Hs2 ?id ?Q =>
+        first [ unify Q P with typeclass_instances | go Hs2 ]
+      end in
+  match goal with
+  | H := Envs ?Δi ?Δs _ |- _ =>
+      first [ go Δs | go Δi ]
+  end.
+Global Hint Extern 1 (CheckOwnInContext ?P) => (check_own_in_context P; constructor; exact: I) : typeclass_instances.
+
+(** * Optimization: Introduce let-bindings for subterms of the goal *)
+Definition LET_ID {A} (x : A) : A := x.
+Arguments LET_ID : simpl never.
+Notation "'HIDDEN'" := (LET_ID _) (only printing).
+Strategy expand [LET_ID].
+
+(* These tactics are prefixed with "li_" because they work with
+[LET_ID] and are a bit more specialized than one might expect. *)
+Tactic Notation "li_let_bind" constr(T) tactic3(tac) :=
+  try (assert_fails (is_var T);
+       let H := fresh "LET_GOAL" in
+       pose H := (LET_ID T);
+       let G := tac H in
+       change_no_check G).
+
+Ltac li_unfold_lets_containing H :=
+  repeat match goal with
+       | Hx := context [ H ] |- _ =>
+         unfold LET_ID in Hx;
+         unfold Hx in *;
+         clear Hx
+       end.
+
+Ltac li_unfold_lets_in_context :=
+  repeat match goal with
+  | H := LET_ID _ |- _ => unfold LET_ID in H; unfold H; clear H
+  | H := Envs _ _ _ |- _  => unfold H; clear H
+  end.
diff --git a/refinedVST/lithium/simpl_classes.v b/refinedVST/lithium/simpl_classes.v
new file mode 100644
index 0000000000..60a27bb72c
--- /dev/null
+++ b/refinedVST/lithium/simpl_classes.v
@@ -0,0 +1,79 @@
+From iris.bi Require Import bi.
+From lithium Require Export base.
+
+(** This file provides the classes for the simplification
+infrastructure for pure sideconditions. *)
+
+(** * [SimplExist] and [SimplForall] *)
+Class SimplExist {prop:bi} (A : Type) (Q : (A → prop) → prop) :=
+  simpl_exist P : Q P ⊢ ∃ x : A, P x.
+Global Hint Mode SimplExist + ! - : typeclass_instances.
+
+(* TODO: refactor similar to SimplExist? *)
+Class SimplForall (T : Type) (n : nat) (e : T → Prop) (Q: Prop) := simpl_forall_proof : Q → ∀ x, e x.
+
+(** * [SimplImpl] and [SimplAnd] *)
+
+(** ** [SimplImplUnsafe] and [SimplAndUnsafe] *)
+(** changed = false indicates that P should be introduced into the context in addition to Ps *)
+Class SimplImplUnsafe (changed : bool) (P : Prop) (Ps : Prop) := simpl_impl_unsafe : P → Ps.
+Class SimplAndUnsafe (P : Prop) (Ps : Prop) := simpl_and_unsafe: Ps → P.
+
+Lemma simpl_impl_unsafe_impl changed (P1 P2 T : Prop) `{!SimplImplUnsafe changed P1 P2} :
+  (if changed then (P2 → T) else (P1 → P2 → T)) → (P1 → T).
+Proof. unfold SimplImplUnsafe in *. destruct changed; naive_solver. Qed.
+Lemma simpl_and_unsafe_and (P1 P2 T : Prop) `{!SimplAndUnsafe P1 P2} :
+  P2 ∧ T → P1 ∧ T.
+Proof. unfold SimplAndUnsafe in *. naive_solver. Qed.
+
+Global Instance simpland_unsafe_not_neq {A} (x y : A) :
+  SimplAndUnsafe (¬ (x ≠ y)) (x = y) | 1000.
+Proof. move => ?. by eauto. Qed.
+
+(** ** [SimplImpl] and [SimplAnd] *)
+(** [SimplImpl] and [SimplAnd] are safe variants which ensure that no
+information is lost. *)
+Class SimplImpl (P : Prop) (Ps : Prop) := simpl_impl : Ps ↔ P.
+Class SimplAnd (P : Prop) (Ps : Prop) := simpl_and: Ps ↔ P.
+Global Instance simplimpl_simplunsafe P Ps {Hi: SimplImpl P Ps} :
+  SimplImplUnsafe true P Ps.
+Proof. unfold SimplImpl, SimplImplUnsafe in *. naive_solver. Qed.
+Global Instance simpland_simplunsafe P Ps {Hi: SimplAnd P Ps} :
+  SimplAndUnsafe P Ps.
+Proof. unfold SimplAnd, SimplAndUnsafe in *. naive_solver. Qed.
+
+(** ** [SimplImplRel] and [SimplAndRel] *)
+Class SimplImplRel {A} (R : relation A) (changed : bool) (x1 x2 : A) (Ps : Prop)
+  := simpl_impl_eq: Ps ↔ R x1 x2.
+Class SimplAndRel {A} (R : relation A) (x1 x2 : A) (Ps : Prop)
+  := simpl_and_eq: Ps ↔ R x1 x2.
+Global Instance simpl_impl_rel_inst1 {A} R (x1 x2 : A) Ps `{!SimplImplRel R c x1 x2 Ps} :
+  SimplImpl (R x1 x2) Ps.
+Proof. unfold SimplImplRel, SimplImpl in *. naive_solver. Qed.
+Global Instance simpl_impl_rel_inst2 {A} R (x1 x2 : A) Ps `{!SimplImplRel R c x2 x1 Ps} `{!Symmetric R} :
+  SimplImpl (R x1 x2) Ps.
+Proof. unfold SimplImplRel, SimplImpl in *. naive_solver. Qed.
+Global Instance simpl_and_rel_inst1 {A} R (x1 x2 : A) Ps `{!SimplAndRel R x1 x2 Ps} :
+  SimplAnd (R x1 x2) Ps.
+Proof. unfold SimplAndRel, SimplAnd in *. naive_solver. Qed.
+Global Instance simpl_and_rel_inst2 {A} R (x1 x2 : A) Ps `{!SimplAndRel R x2 x1 Ps} `{!Symmetric R} :
+  SimplAnd (R x1 x2) Ps.
+Proof. unfold SimplAndRel, SimplAnd in *. naive_solver. Qed.
+
+(** ** [SimplBoth] *)
+Class SimplBoth (P1 P2 : Prop) := simpl_both: P1 ↔ P2.
+Global Instance simpl_impl_both_inst P1 P2 {Hboth : SimplBoth P1 P2}:
+  SimplImpl P1 P2.
+Proof. unfold SimplBoth in Hboth. split; naive_solver. Qed.
+Global Instance simpl_and_both_inst P1 P2 {Hboth : SimplBoth P1 P2}:
+  SimplAnd P1 P2.
+Proof. unfold SimplBoth in Hboth. split; naive_solver. Qed.
+
+(** ** [SimplBothRel] *)
+Class SimplBothRel {A} (R : relation A) (x1 x2 : A) (P2 : Prop) := simpl_both_eq: R x1 x2 ↔ P2.
+Global Instance simpl_both_rel_inst1 {A} R (x1 x2 : A) P2 `{!SimplBothRel R x1 x2 P2}:
+  SimplBoth (R x1 x2) P2.
+Proof. unfold SimplBothRel, SimplBoth in *. naive_solver. Qed.
+Global Instance simpl_both_rel_inst2 {A} R (x1 x2 : A) P2 `{!SimplBothRel R x2 x1 P2} `{!Symmetric R}:
+  SimplBoth (R x1 x2) P2.
+Proof. unfold SimplBothRel, SimplBoth in *. naive_solver. Qed.
diff --git a/refinedVST/lithium/simpl_instances.v b/refinedVST/lithium/simpl_instances.v
new file mode 100644
index 0000000000..a96a71fabb
--- /dev/null
+++ b/refinedVST/lithium/simpl_instances.v
@@ -0,0 +1,547 @@
+From iris.base_logic.lib Require Import iprop.
+From iris.proofmode Require Import tactics.
+From lithium Require Import pure_definitions.
+From VST.lithium Require Import simpl_classes.
+
+(** This file provides the instances for the simplification
+infrastructure for sideconditions and quantifers. *)
+
+(** * SimplExist *)
+Global Instance simpl_exist_unit Σ : @SimplExist Σ unit (λ P, P tt).
+Proof. iIntros (?) "?". iExists _. iFrame. Qed.
+Lemma simpl_exist_prod Σ A B : @SimplExist Σ (A * B) (λ P, ∃ x y, P (x, y))%I.
+Proof. iIntros (?) "[%[% ?]]". iExists _. iFrame. Qed.
+(* We only want syntactic products. *)
+Global Hint Extern 2 (SimplExist (_ * _) _) =>
+   (notypeclasses refine (simpl_exist_prod _ _ _)) : typeclass_instances.
+Global Instance simpl_exist_sigT Σ A f : @SimplExist Σ (@sigT A f) (λ P, ∃ x y, P (existT x y))%I.
+Proof. iIntros (?) "[%[% ?]]". iExists _. iFrame. Qed.
+Global Instance simpl_exist_TCForall2 Σ A B (l1 : list A) (l2 : list B) P x : @SimplExist Σ (TCForall2 P l1 l2) (λ P, P x).
+Proof. iIntros (?) "?". iExists _. iFrame. Qed.
+Lemma simpl_exist_eq Σ A (x : A) : @SimplExist Σ (x = x) (λ P, P eq_refl).
+Proof. iIntros (?) "?". iExists _. iFrame. Qed.
+(* We only want syntactic equalities. *)
+Global Hint Extern 2 (SimplExist (_ = _) _) =>
+   (notypeclasses refine (simpl_exist_eq _ _ _)) : typeclass_instances.
+Lemma simpl_exist_type Σ A : @SimplExist Σ Type (λ P, P A)%I.
+Proof. iIntros (?) "?". iExists _. iFrame. Qed.
+(* We only want syntactic Type. The [shelve] shelves the evar created
+for the Type, which is necessary to make TC search succeed. *)
+Global Hint Extern 2 (SimplExist Type _) =>
+   (notypeclasses refine (simpl_exist_type _ _); shelve) : typeclass_instances.
+
+
+(** * SimplImpl and SimplAnd *)
+Local Open Scope Z_scope.
+
+Global Instance simpl_or_false1 P1 P2 `{!CanSolve (¬ P2)}:
+  SimplBoth (P1 ∨ P2) (P1).
+Proof. unfold CanSolve in *. split; naive_solver. Qed.
+Global Instance simpl_or_false2 P1 P2 `{!CanSolve (¬ P1)}:
+  SimplBoth (P1 ∨ P2) (P2).
+Proof. unfold CanSolve in *. split; naive_solver. Qed.
+
+Global Instance simpl_double_neg_elim_dec P `{!Decision P} :
+  SimplBoth (¬ ¬ P) P.
+Proof. split; destruct (decide P); naive_solver. Qed.
+
+Global Instance simpl_eq_pair_l A B (x : A) (y : B) (xy : A * B):
+  SimplAnd ((x, y) = xy) (x = xy.1 ∧ y = xy.2).
+Proof. destruct xy; split; naive_solver. Qed.
+
+Global Instance simpl_eq_pair_r A B (xy : A * B) (x : A) (y : B):
+  SimplAnd (xy = (x, y)) (xy.1 = x ∧ xy.2 = y).
+Proof. destruct xy; split; naive_solver. Qed.
+
+Global Instance simpl_to_cons_None A (l : list A) : SimplBothRel (=) (maybe2 cons l) None (l = nil).
+Proof. split; destruct l; naive_solver. Qed.
+Global Instance simpl_to_cons_Some A (l : list A) x : SimplBothRel (=) (maybe2 cons l) (Some x) (l = x.1::x.2).
+Proof. split; destruct l, x; naive_solver. Qed.
+
+Global Instance simpl_ex_neq_nil A (l : list A) `{!IsEx l} :
+  SimplBoth (l ≠ []) (∃ x l', l = x :: l').
+Proof. split; destruct l; naive_solver. Qed.
+
+Global Instance simpl_gt_0_neg n : SimplBoth (¬ (0 < n))%nat (n = 0%nat).
+Proof. split; destruct n; naive_solver lia. Qed.
+
+(* We want to do this for hyps (it allows simplification to take place), but not in the goal (as it might lead to evars which we cannot instantiate) *)
+Global Instance simpl_gt_0_impl n : SimplImpl (0 < n)%nat (∃ n', n = S n').
+Proof. split; destruct n; naive_solver lia. Qed.
+Global Instance simpl_gt_0_and n : SimplBoth (0 < S n)%nat True.
+Proof. split; naive_solver lia. Qed.
+
+Global Instance simpl_bool_decide_true P `{!Decision P} : SimplBothRel (=) (bool_decide P) true P.
+Proof. split; case_bool_decide; naive_solver. Qed.
+Global Instance simpl_bool_decide_false P `{!Decision P} : SimplBothRel (=) (bool_decide P) false (¬P).
+Proof. split; case_bool_decide; naive_solver. Qed.
+Global Instance simpl_bool_decide_eq P1 P2 `{!Decision P1} `{!Decision P2} : SimplBothRel (=) (bool_decide P1) (bool_decide P2) (P1 ↔ P2).
+Proof. split; repeat case_bool_decide; naive_solver. Qed.
+
+Global Instance simpl_if_bool_decide_true P x y `{!Decision P} `{!CanSolve P} : SimplBoth (if bool_decide P then x else y) x.
+Proof. unfold CanSolve in *. by rewrite bool_decide_true. Qed.
+Global Instance simpl_if_bool_decide_false P x y `{!Decision P} `{!CanSolve (¬ P)} : SimplBoth (if bool_decide P then x else y) y.
+Proof. unfold CanSolve in *. by rewrite bool_decide_false. Qed.
+
+Global Instance simpl_Is_true_true b : SimplBoth (Is_true b) (b = true).
+Proof. split; destruct b; naive_solver. Qed.
+Global Instance simpl_Is_true_false b : SimplBoth (¬ Is_true b) (b = false).
+Proof. split; destruct b; naive_solver. Qed.
+
+Global Instance simpl_negb_true b: SimplBothRel (=) (negb b) true (b = false).
+Proof. destruct b; done. Qed.
+Global Instance simpl_negb_false b: SimplBothRel (=) (negb b) false (b = true).
+Proof. destruct b; done. Qed.
+
+Global Instance simpl_eqb_true b1 b2: SimplBothRel (=) (eqb b1 b2) true (b1 = b2).
+Proof. destruct b1, b2; done. Qed.
+Global Instance simpl_eqb_false b1 b2: SimplBothRel (=) (eqb b1 b2) false (b1 = negb b2).
+Proof. destruct b1, b2; done. Qed.
+
+Global Instance simpl_min_glb_nat n1 n2 m : SimplBoth (m ≤ n1 `min` n2)%nat (m ≤ n1 ∧ m ≤ n2)%nat.
+Proof. rewrite /SimplBoth. lia. Qed.
+Global Instance simpl_min_glb n1 n2 m : SimplBoth (m ≤ n1 `min` n2) (m ≤ n1 ∧ m ≤ n2).
+Proof. rewrite /SimplBoth. lia. Qed.
+Global Instance simpl_max_glb_nat n1 n2 m : SimplBoth (n1 `max` n2 ≤ m)%nat (n1 ≤ m ∧ n2 ≤ m)%nat.
+Proof. rewrite /SimplBoth. lia. Qed.
+Global Instance simpl_max_glb n1 n2 m : SimplBoth (n1 `max` n2 ≤ m) (n1 ≤ m ∧ n2 ≤ m).
+Proof. rewrite /SimplBoth. lia. Qed.
+
+Global Instance simpl_gt_both (n1 n2 : nat) `{!CanSolve (n1 ≠ 0)%nat} : SimplBoth (n1 > n2 * n1) (n2 = 0%nat).
+Proof. unfold CanSolve in *; split; destruct n2; naive_solver lia. Qed.
+Global Instance simpl_ge_both (n1 n2 : nat) `{!CanSolve (n1 ≠ 0)%nat} : SimplBoth (n1 >= n2 * n1) (n2 = 0 ∨ n2 = 1)%nat.
+Proof. unfold CanSolve in *; split; destruct n2 as [|[]]; naive_solver lia. Qed.
+Global Instance simpl_ge_both_Z (n1 n2 : Z) `{!CanSolve (0 < n1)} : SimplBoth (n1 >= n2 * n1) (1 >= n2).
+Proof. unfold CanSolve in *; split; nia. Qed.
+Global Instance simpl_neq_ge_both_Z (n1 n2 : Z) `{!CanSolve (0 < n1)} : SimplBoth (¬ (n1 >= n2 * n1)) (n2 > 1).
+Proof. unfold CanSolve in *; split; nia. Qed.
+Global Instance simpl_gt_neq_0_both (n1 n2 : nat) `{!CanSolve (n1 ≠ 0)%nat} : SimplBoth (¬ n1 > n2 * n1) (n2 > 0)%nat.
+Proof. unfold CanSolve in *; split; destruct n2; try naive_solver lia. Qed.
+Global Instance simpl_ge_neq_0_both (n1 n2 : nat) `{!CanSolve (n1 ≠ 0)%nat} : SimplBoth (¬ n1 >= n2 * n1) (n2 > 1)%nat.
+Proof. unfold CanSolve in *; split; destruct n2 as [|[]]; naive_solver lia. Qed.
+Global Instance simpl_mult_0 n m : SimplBothRel (=) (n * m) (0) (n = 0 ∨ m = 0).
+Proof. split; destruct n, m; naive_solver lia. Qed.
+
+Global Instance simpl_nat_le_0 (n : nat) : SimplBoth (n ≤ 0)%nat (n = 0)%nat.
+Proof. split; lia. Qed.
+
+Global Instance simpl_mult_neq_0 n m : SimplBoth (n * m ≠ 0) (n ≠ 0 ∧ m ≠ 0).
+Proof. split; destruct n, m; naive_solver lia. Qed.
+Global Instance simpl_mult_le z1 z2:
+  SimplBoth (0 ≤ z1 * z2) ((0 ≤ z1 ∧ 0 ≤ z2) ∨ (z1 ≤ 0 ∧ z2 ≤ 0)).
+Proof. split; destruct z1, z2; naive_solver lia. Qed.
+
+Global Instance simpl_divides_impl a b:
+  SimplImpl (a | b) (∃ n, b = n * a).
+Proof. rewrite /Z.divide. split; naive_solver. Qed.
+
+Global Instance simpl_divides_and a b `{!CanSolve (a ≠ 0 ∧ b `mod` a = 0)}:
+  SimplAnd (a | b) (True).
+Proof. revert select (CanSolve _) => -[?]. rewrite Z.mod_divide //. Qed.
+Global Instance simpl_divides_and_mul_r a b:
+  SimplAnd (a | b * a) (True).
+Proof. rewrite /Z.divide. split; naive_solver. Qed.
+
+Global Instance simpl_nat_divides_and_mul_r a b:
+  SimplAnd (a | b * a)%nat (True).
+Proof. rewrite /divide. split; naive_solver. Qed.
+
+Global Instance simpl_is_power_of_two_mult n1 n2 :
+  SimplBoth (is_power_of_two (n1 * n2)) (is_power_of_two n1 ∧ is_power_of_two n2).
+Proof. by apply is_power_of_two_mult. Qed.
+
+(* TODO: This instance is quite specific and for mpool. *)
+Global Instance simpl_forall_eq_plus n x:
+  SimplBoth (x = n + x)%nat (n = 0)%nat.
+Proof. unfold SimplBoth. split; naive_solver lia. Qed.
+
+Global Instance simpl_n_mul_m_minus n m k `{!CanSolve (m ≠ 0)} : SimplBothRel (=) (n * m - m) (k * m) (n-1 = k).
+Proof. unfold CanSolve in *. split; last naive_solver lia. move => ?. apply (Z.mul_cancel_r _ _ m) => //. lia. Qed.
+(* TODO: unify these two instances *)
+Global Instance simpl_n_mul_m_minus_nat n m k `{!CanSolve (m ≠ 0)%nat} : SimplBothRel (=) (n * m - m)%nat (k * m)%nat (n-1 = k)%nat.
+Proof.
+  unfold CanSolve in *. split.
+  - move => ?. apply (Nat.mul_cancel_r _ _ m) => //. rewrite Nat.mul_sub_distr_r. lia.
+  - move => <-. rewrite Nat.mul_sub_distr_r. lia.
+Qed.
+Global Instance simpl_cancel_mult_nat n1 n2 m `{!CanSolve (m ≠ 0)%nat}:
+  SimplBothRel (=) (n1 * m)%nat (n2 * m)%nat (n1 = n2)%nat.
+Proof. unfold SimplBothRel. unfold CanSolve in *. by rewrite Nat.mul_cancel_r. Qed.
+Global Instance simpl_cancel_mult_nat_1 n m `{!CanSolve (m ≠ 0)%nat}:
+  SimplBothRel (=) (n * m)%nat m (n = 1)%nat.
+Proof. unfold SimplBothRel. unfold CanSolve in *. nia. Qed.
+Global Instance simpl_cancel_mult_le_nat n1 n2 m `{!CanSolve (0 < m)%nat}:
+  SimplBothRel (≤)%nat (n1 * m)%nat (n2 * m)%nat (n1 ≤ n2)%nat.
+Proof. unfold SimplBothRel. unfold CanSolve in *. nia. Qed.
+Global Instance simpl_cancel_mult_le n1 n2 m `{!CanSolve (0 < m)}:
+  SimplBothRel (≤) (n1 * m) (n2 * m) (n1 ≤ n2).
+Proof. unfold SimplBothRel. unfold CanSolve in *. by rewrite -Z.mul_le_mono_pos_r. Qed.
+Global Instance simpl_cancel_mult_eq n1 n2 m `{!CanSolve (0 ≠ m)}:
+  SimplBothRel (=) (n1 * m) (n2 * m) (n1 = n2).
+Proof. unfold SimplBothRel. unfold CanSolve in *. by rewrite Z.mul_cancel_r. Qed.
+Global Instance simpl_cancel_mult_neq n1 n2 m `{!CanSolve (0 ≠ m)}:
+  SimplBoth (n1 * m ≠ n2 * m) (n1 ≠ n2).
+Proof. unfold SimplBothRel. unfold CanSolve in *. split; by rewrite Z.mul_cancel_r. Qed.
+Global Instance simpl_cancel_mult_nat_Z n1 n2 m `{!CanSolve (m ≠ 0)%nat}:
+  SimplBothRel (=) (n1 * m) (n2 * m)%nat (n1 = n2).
+Proof. unfold SimplBothRel. unfold CanSolve in *. rewrite Nat2Z.inj_mul Z.mul_cancel_r; lia. Qed.
+Global Instance simpl_Zsub_to_nat (n m : nat) `{!CanSolve (n > 0)} : SimplBothRel (=) (n - 1) m ((n-1) = m)%nat.
+Proof. unfold CanSolve in *. split; naive_solver lia. Qed.
+Global Instance simpl_Zadd_to_nat (n m : nat) : SimplBothRel (=) (n + 1) m ((n+1) = m)%nat.
+Proof. unfold CanSolve in *. split; naive_solver lia. Qed.
+
+Global Instance simpl_n_add_sub_n_nat n m k : SimplBothRel (=) (n + m - n)%nat (k)%nat (m = k)%nat.
+Proof. split; naive_solver lia. Qed.
+
+Global Instance simpl_nat_sub_0 (n m : nat) : SimplBothRel (=) (m - 0)%nat n (n = m).
+Proof. split; naive_solver lia. Qed.
+
+(* TODO: add a more general impl? *)
+Global Instance simpl_eq_0 (n : nat) : SimplBothRel (=) (A := Z) n 0 (n = 0)%nat.
+Proof. split; naive_solver lia. Qed.
+Global Instance simpl_eq_1 (n : nat) : SimplBothRel (=) (A := Z) n 1 (n = 1)%nat.
+Proof. split; naive_solver lia. Qed.
+Global Instance simpl_eq_2 (n : nat) : SimplBothRel (=) (A := Z) n 2 (n = 2)%nat.
+Proof. split; naive_solver lia. Qed.
+Global Instance simpl_eq_3 (n : nat) : SimplBothRel (=) (A := Z) n 3 (n = 3)%nat.
+Proof. split; naive_solver lia. Qed.
+Global Instance simpl_eq_4 (n : nat) : SimplBothRel (=) (A := Z) n 4 (n = 4)%nat.
+Proof. split; naive_solver lia. Qed.
+Global Instance simpl_eq_5 (n : nat) : SimplBothRel (=) (A := Z) n 5 (n = 5)%nat.
+Proof. split; naive_solver lia. Qed.
+Global Instance simpl_eq_6 (n : nat) : SimplBothRel (=) (A := Z) n 6 (n = 6)%nat.
+Proof. split; naive_solver lia. Qed.
+Global Instance simpl_eq_7 (n : nat) : SimplBothRel (=) (A := Z) n 7 (n = 7)%nat.
+Proof. split; naive_solver lia. Qed.
+Global Instance simpl_eq_8 (n : nat) : SimplBothRel (=) (A := Z) n 8 (n = 8)%nat.
+Proof. split; naive_solver lia. Qed.
+Global Instance simpl_eq_9 (n : nat) : SimplBothRel (=) (A := Z) n 9 (n = 9)%nat.
+Proof. split; naive_solver lia. Qed.
+
+Global Instance simpl_eq_Ztonat (n m : nat) : SimplBothRel (=) (A := Z) n m (n = m).
+Proof. split; naive_solver lia. Qed.
+
+Global Instance simpl_bool_to_Z_0 (b : bool) : SimplBothRel (=) 0 (bool_to_Z b) (b = false).
+Proof. split; destruct b; naive_solver. Qed.
+Global Instance simpl_bool_to_Z_1 (b : bool) : SimplBothRel (=) 1 (bool_to_Z b) (b = true).
+Proof. split; destruct b; naive_solver. Qed.
+
+(* Using a SimplBothRel does not work since [x ≠ y] (i.e., [not (x = y)]) does
+not unify with [?R ?x ?y] (Coq's unification is too limited here). This can be
+seen by applying [simpl_both_rel_inst2], which given the following error:
+[Unable to unify "?Goal1 ?Goal2 ?Goal3" with "0 = bool_to_Z _b_ → False"] *)
+(*Global Instance simpl_Z_to_bool_nonzero b: SimplBothRel (≠) 0 (bool_to_Z b) (b = true).*)
+Global Instance simpl_bool_to_Z_nonzero_1 b : SimplBoth (bool_to_Z b ≠ 0) (b = true).
+Proof. by destruct b. Qed.
+Global Instance simpl_bool_to_Z_nonzero_2 b : SimplBoth (0 ≠ bool_to_Z b) (b = true).
+Proof. by destruct b. Qed.
+
+Global Instance simpl_add_eq_0 n m:
+  SimplBothRel (=) (n + m)%nat (0)%nat (n = 0%nat ∧ m = 0%nat).
+Proof. split; naive_solver lia. Qed.
+
+Global Instance simpl_and_S n m `{!ContainsEx n}:
+  SimplAndRel (=) (S n) (m) ((m > 0)%nat ∧ n = pred m).
+Proof. split; destruct n; naive_solver lia. Qed.
+Global Instance simpl_and_Z_of_nat n m `{!ContainsEx n}:
+  SimplAndRel (=) (Z.of_nat n) (m) (0 ≤ m ∧ n = Z.to_nat m).
+Proof. unfold CanSolve in *. split; naive_solver lia. Qed.
+
+Global Instance simpl_both_shiftl_nonneg z n:
+  SimplBoth (0 ≤ z ≪ n) (0 ≤ z).
+Proof. split; by rewrite Z.shiftl_nonneg. Qed.
+
+
+Global Instance simpl_in_nil {A} (x : A):
+  SimplBoth (x ∈ []) False.
+Proof. split; set_solver. Qed.
+Global Instance simpl_not_in_nil {A} (x : A):
+  SimplBoth (x ∉ []) True.
+Proof. split; set_solver. Qed.
+Global Instance simpl_in_cons {A} (x : A) y ys:
+  SimplBoth (x ∈ y :: ys) (x = y ∨ x ∈ ys).
+Proof. split; set_solver. Qed.
+Global Instance simpl_not_in_cons {A} (x : A) y ys:
+  SimplBoth (x ∉ y :: ys) (x ≠ y ∧ x ∉ ys).
+Proof. split; set_solver. Qed.
+
+Global Instance simpl_both_forall_nil {A} (f : A → Prop):
+  SimplBoth (Forall f []) (True).
+Proof. split; naive_solver. Qed.
+Global Instance simpl_both_forall_cons {A} f (x : A) xs:
+  SimplBoth (Forall f (x::xs)) (f x ∧ Forall f xs).
+Proof. split; [ by move => /(Forall_cons_1 _ _) | naive_solver]. Qed.
+
+Global Instance list_Forall_simpl_and {A} (P : nat → A → Prop) xs :
+  SimplAnd (list_Forall P xs) (∀ i x, xs !! i = Some x → P i x).
+Proof. done. Qed.
+
+Global Instance simpl_both_forall2_nil {A B} (f : A → B → Prop):
+  SimplBoth (Forall2 f [] []) (True).
+Proof. split; [by move => /(Forall2_nil_inv_l _ _)| naive_solver]. Qed.
+Global Instance simpl_both_forall2_cons {A B} f (x : A) (y : B) xs ys:
+  SimplBoth (Forall2 f (x::xs)(y::ys)) (f x y ∧ Forall2 f xs ys).
+Proof. split; [by move => /(Forall2_cons _ _ _ _)|naive_solver]. Qed.
+
+Global Instance simpl_length_0 {A} (l : list A):
+  SimplBothRel (=) (length l) (0%nat) (l = []).
+Proof. split; by destruct l. Qed.
+
+Global Instance simpl_length_S {A} (l : list A) (n : nat):
+  SimplAndRel (=) (length l) (S n) (∃ hd tl, l = hd :: tl ∧ length tl = n).
+Proof.
+  split.
+  - move => [hd [tl [-> <-]]] //.
+  - move => Hlen. destruct l as [|hd tl] => //.
+    eexists hd, tl. by inversion Hlen.
+Qed.
+
+Global Instance simpl_length_ex_add {A} (n m : nat) (p : list A) `{!ContainsEx p} `{!CanSolve (m ≤ n)%nat} :
+  SimplAndRel (=) (n) (length p + m)%nat ((n - m)%nat = length p).
+Proof.
+  unfold CanSolve in *. split.
+  - move => Heq. lia.
+  - move => ->. lia.
+Qed.
+
+Global Instance simpl_insert_list_subequiv {A} (l1 l2 : list A) j x1 `{!CanSolve (j < length l1)%nat} :
+  SimplBothRel (=) (<[j:=x1]>l1) l2 (list_subequiv [j] l1 l2 ∧ l2 !! j = Some x1).
+Proof. unfold CanSolve in *. split; rewrite list_insert_subequiv //; naive_solver. Qed.
+
+Global Instance simpl_insert_subequiv {A} (l1 l2 : list A) j x1 ig `{!CanSolve (j < length l1)%nat}:
+  SimplBothRel (list_subequiv ig) (<[j:=x1]>l1) l2 (if bool_decide (j ∈ ig) then list_subequiv ig l1 l2 else
+                                      list_subequiv (j :: ig) l1 l2 ∧ l2 !! j = Some x1).
+Proof.
+  unfold CanSolve in *. unfold SimplBothRel.
+  case_bool_decide; [rewrite list_subequiv_insert_in_l | rewrite list_subequiv_insert_ne_l ]; naive_solver.
+Qed.
+
+Global Instance simpl_ig_nil_subequiv {A} (l1 l2 : list A) :
+  SimplBothRel (list_subequiv []) l1 l2 (l1 = l2).
+Proof.
+  split; [|naive_solver] => Hl. apply: list_eq => i.
+  move: (Hl i) => [? ?]. set_solver.
+Qed.
+
+Global Instance simpl_nil_subequiv {A} (l : list A) ig :
+  SimplBothRel (list_subequiv ig) [] l (l = []).
+Proof. by split; rewrite list_subequiv_nil_l. Qed.
+
+Global Instance simpl_app_r_subequiv {A} (l1 l2 suffix : list A) ig :
+  SimplBothRel (list_subequiv ig) (l1 ++ suffix) (l2 ++ suffix) (list_subequiv ig l1 l2).
+Proof. apply: list_subequiv_app_r. Qed.
+
+(* The other direction requires `{!Inj (=) (=) f}, but we cannot prove
+it if f goes into type. Thus we use the AssumeInj typeclass such that
+the user can mark functions which are morally injective, but one
+cannot prove it. *)
+Global Instance simpl_fmap_fmap_subequiv_Unsafe {A B} (l1 l2 : list A) ig (f : A → B) `{!AssumeInj (=) (=) f}:
+  SimplAndUnsafe (list_subequiv ig (f <$> l1) (f <$> l2)) (list_subequiv ig l1 l2).
+Proof. move => ? Hs. by apply: list_subequiv_fmap. Qed.
+
+(* The other direction might not hold if ig contains indices which are
+out of bounds, but we don't care about that. *)
+Global Instance simpl_subequiv_ex {A} (l1 l2 : list A) ig `{!IsEx l2}:
+  SimplAndUnsafe (list_subequiv ig l1 l2) (
+    foldr (λ i f, (λ l', ∃ x, f (<[i:=x]> l'))) (λ l', l2 = l') ig l1).
+Proof.
+  (* TODO: add a lemma for list_subequiv such that this unfolding is not necessary anymore. *)
+  unfold_opaque @list_subequiv.
+  clear IsEx0. unfold SimplAndUnsafe in *. elim: ig l1 l2.
+  - move => ??/=. move => ?. naive_solver.
+  - move => i ig IH l1 l2/= [x /IH Hi ] i'.
+    move: (Hi i') => [<- Hlookup]. rewrite length_insert. split => //.
+    move => Hi'. rewrite -Hlookup ?list_lookup_insert_ne; set_solver.
+Qed.
+
+Global Instance simpl_fmap_nil {A B} (l : list A) (f : A → B) : SimplBothRel (=) (f <$> l) [] (l = []).
+Proof. split; destruct l; naive_solver. Qed.
+Global Instance simpl_fmap_cons_and {A B} x (l : list A) l2 (f : A → B):
+  SimplAndRel (=) (f <$> l) (x :: l2) (∃ x' l2', l = x' :: l2' ∧ f x' = x ∧ f <$> l2' = l2).
+Proof. split; first naive_solver. intros ?%fmap_cons_inv. naive_solver. Qed.
+Global Instance simpl_fmap_cons_impl {A B} x (l : list A) l2 (f : A → B):
+  SimplImplRel (=) true (f <$> l) (x :: l2) (∃ x' l2', l = x' :: l2' ∧ f x' = x ∧ f <$> l2' = l2).
+Proof. split; first naive_solver. intros ?%fmap_cons_inv. naive_solver. Qed.
+Global Instance simpl_fmap_app_and {A B} (l : list A) l1 l2 (f : A → B):
+  SimplAndRel (=) (f <$> l) (l1 ++ l2) (f <$> take (length l1) l = l1 ∧ f <$> drop (length l1) l = l2).
+Proof.
+  split.
+  - move => [Hl1 Hl2]; subst.
+    rewrite -Hl1 -fmap_app length_fmap length_take_le ?take_drop //.
+    rewrite -Hl1 length_fmap length_take. lia.
+  - move => /fmap_app_inv [? [? [? [? Hfmap]]]]; subst.
+    by rewrite length_fmap take_app_length drop_app_length.
+Qed.
+Global Instance simpl_fmap_assume_inj_Unsafe {A B} (l1 l2 : list A) (f : A → B) `{!AssumeInj (=) (=) f}:
+  SimplAndUnsafe (f <$> l1 = f <$> l2) (l1 = l2).
+Proof. move => ->. naive_solver. Qed.
+
+Global Instance simpl_replicate_app_and {A} (l1 l2 : list A) x n:
+  SimplAndRel (=) (replicate n x) (l1 ++ l2) (∃ n', l1 = replicate n' x ∧ l2 = replicate (n - n') x ∧ (n' ≤ n)%nat).
+Proof.
+  split.
+  - move => [n'[?[??]]]; subst.
+    have ->: (n = n' + (n - n'))%nat by lia. rewrite replicate_add. do 2 f_equal. lia.
+  - move => Hr.
+    have Hn: (n = length l1 + length l2)%nat by rewrite -(length_replicate n x) -app_length Hr.
+    move: Hr. rewrite Hn replicate_add => /app_inj_1[|<- <-]. 1: by rewrite length_replicate.
+    exists (length l1). repeat split => //.
+    + rewrite !length_replicate. f_equal. lia.
+    + rewrite !length_replicate. lia.
+Qed.
+
+Global Instance simpl_replicate_eq_nil {A} (x : A) n :
+  SimplBothRel (=) (replicate n x) [] (n = 0%nat).
+Proof. by destruct n. Qed.
+
+Global Instance simpl_replicate_cons {A} (l : list A) x x' n:
+  SimplBothRel (=) (replicate n x) (x' :: l) ((n > 0)%nat ∧ x' = x ∧ l = replicate (pred n) x).
+Proof. split; destruct n; naive_solver lia. Qed.
+
+Global Instance simpl_replicate_lookup {A} (x x' : A) n m :
+  SimplBothRel (=) (replicate n x !! m) (Some x') (x' = x ∧ (m < n)%nat).
+Proof. by apply: lookup_replicate. Qed.
+
+Global Instance simpl_replicate_eq {A} (x : A) n n' :
+  SimplBothRel (=) (replicate n x) (replicate n' x) (n = n').
+Proof.
+  split; last naive_solver. elim: n n'; first by case.
+  move => n IH []//= n' []. naive_solver.
+Qed.
+
+Global Instance simpl_replicate_elem_of {A} (x x' : A) n :
+  SimplBoth (x' ∈ replicate n x) (x' = x ∧ (n ≠ 0)%nat).
+Proof. unfold SimplBoth. by set_unfold. Qed.
+
+Global Instance simpl_filter_nil {A} P `{!∀ x, Decision (P x)} (l : list A) :
+  SimplBothRel (=) (filter P l) [] (∀ x, x ∈ l → ¬ P x).
+Proof. unfold SimplBothRel. by rewrite filter_nil_inv. Qed.
+
+Global Instance simpl_app_r_id {A} (l1 l2 : list A):
+  SimplBothRel (=) l2 (l1 ++ l2) (l1 = []).
+Proof.
+  split.
+  - move => H. assert (length (l1 ++ l2) = length l2) as Hlen by by rewrite -H.
+    rewrite app_length in Hlen. assert (length l1 = 0%nat) by lia. by destruct l1.
+  - by naive_solver.
+Qed.
+
+Global Instance simpl_app_l_id {A} (l1 l2 : list A):
+  SimplBothRel (=) l1 (l1 ++ l2) (l2 = []).
+Proof.
+  split.
+  - move => H. assert (length (l1 ++ l2) = length l1) as Hlen by by rewrite -H.
+    rewrite app_length in Hlen. assert (length l2 = 0%nat) by lia. by destruct l2.
+  - move => ->. by rewrite app_nil_r.
+Qed.
+
+(* TODO: make something more general *)
+Global Instance simpl_cons_app_eq {A} (l1 l2 l3 : list A) x:
+  SimplBothRel (=) (x :: l1 ++ l2) (l3 ++ l2) (x :: l1 = l3).
+Proof. split; try naive_solver. move => ?. by apply: app_inv_tail. Qed.
+
+
+Global Instance simpl_lookup_app {A} (l1 l2 : list A) i x:
+  SimplBothRel (=) ((l1 ++ l2) !! i) (Some x)
+               (if bool_decide (i < length l1)%nat then l1 !! i = Some x else l2 !! (i - length l1)%nat = Some x).
+Proof.
+  unfold SimplBothRel. case_bool_decide.
+  - by rewrite lookup_app_l.
+  - rewrite lookup_app_r //. lia.
+Qed.
+
+Global Instance simpl_rev_nil {A} (l : list A):
+  SimplBothRel (=) (rev l) [] (l = []).
+Proof.
+  split.
+  - move => H. destruct l; first done. simpl in H. by destruct (rev l).
+  - move => ->. done.
+Qed.
+
+Global Instance simpl_lookup_drop {A} (l : list A) n i x :
+  SimplBothRel (=) (drop n l !! i) (Some x) (l !! (n + i)%nat = Some x).
+Proof. by rewrite lookup_drop. Qed.
+
+Global Instance simpl_fmap_lookup_and {A B} (l : list A) i (f : A → B) x:
+  SimplAndRel (=) ((f <$> l) !! i) (Some x) (∃ y : A, x = f y ∧ l !! i = Some y).
+Proof.
+  split.
+  - move => [y [-> Hl]]. rewrite list_lookup_fmap Hl. naive_solver.
+  - move => Hf. have := list_lookup_fmap_inv _ _ _ _ Hf. naive_solver.
+Qed.
+Global Instance simpl_fmap_lookup_impl {A B} (l : list A) i (f : A → B) x:
+  SimplImplRel (=) true ((f <$> l) !! i) (Some x) (∃ y : A, x = f y ∧ l !! i = Some y).
+Proof.
+  split.
+  - move => [y [? Hl]]; subst. by rewrite list_lookup_fmap Hl.
+  - move => /(list_lookup_fmap_inv _ _ _ _)?. naive_solver.
+Qed.
+Global Instance simpl_lookup_insert_eq {A} (l : list A) i j x x' `{!CanSolve (i = j)}:
+  SimplBothRel (=) (<[i := x']> l !! j) (Some x) (x = x' ∧ (j < length l)%nat).
+Proof.
+  unfold SimplBothRel, CanSolve in *; subst.
+  rewrite list_lookup_insert_Some. naive_solver.
+Qed.
+Global Instance simpl_lookup_insert_neq {A} (l : list A) i j x x' `{!CanSolve (i ≠ j)}:
+  SimplBothRel (=) (<[i := x']> l !! j) (Some x) (l !! j = Some x).
+Proof.
+  unfold SimplBothRel, CanSolve in *; subst.
+  rewrite list_lookup_insert_Some. naive_solver.
+Qed.
+
+Global Instance simpl_and_lookup_ex {A} (l : list A) (i : nat) v `{!IsEx v} `{Inhabited A}:
+  SimplAndRel (=) (l !! i) (Some v) (i < length l ∧ v = l !!! i).
+Proof.
+  split.
+  - move => -[? ->]. apply: list_lookup_lookup_total_lt. lia.
+  - move => /list_lookup_alt ?. naive_solver lia.
+Qed.
+
+Global Instance simpl_and_lookup_lookup_total {A} (l : list A) (i : nat) `{Inhabited A}:
+  SimplBothRel (=) (l !! i) (Some (l !!! i)) (i < length l).
+Proof. rewrite /SimplBothRel list_lookup_alt. naive_solver lia. Qed.
+
+Global Instance simpl_learn_insert_some_len_impl {A} l i (x : A) :
+  (* The false is important here as we learn additional information,
+  but we don't want to remove the lookup. *)
+  SimplImplUnsafe false (l !! i = Some x) ((i < length l)%nat) | 100.
+Proof. move => ?. by apply: lookup_lt_Some. Qed.
+
+Global Instance simpl_is_Some_unfold {A} (o : option A):
+  SimplBoth (is_Some o) (∃ x, o = Some x) | 100.
+Proof. split; naive_solver. Qed.
+
+Global Instance simpl_Some {A} o (x x' : A) `{!TCFastDone (o = Some x)}:
+  SimplBothRel (=) (o) (Some x') (x = x') | 1.
+Proof. unfold TCFastDone in *; subst. split; naive_solver. Qed.
+
+Global Instance simpl_both_fmap_Some A B f (o : option A) (x : B): SimplBothRel (=) (f <$> o) (Some x) (∃ x', o = Some  x' ∧ x = f x').
+Proof. unfold SimplBothRel. rewrite fmap_Some. naive_solver. Qed.
+
+Global Instance simpl_both_option_fmap_None {A B} (f : A → B) (x : option A) :
+  SimplBothRel (=) (f <$> x) (None) (x = None).
+Proof. by split; rewrite fmap_None. Qed.
+Global Instance simpl_both_option_fmap_neq_None {A B} (f : A → B) (x : option A) :
+  SimplBoth (f <$> x ≠ None) (x ≠ None).
+Proof. by split; rewrite fmap_None. Qed.
+(* TODO: should this be SimplBoth? *)
+Global Instance simpl_impl_option_neq_None {A} (x : option A) :
+  SimplImpl (x ≠ None) (∃ y, x = Some y).
+Proof. split; destruct x; naive_solver. Qed.
+
+Global Instance simpl_both_rotate_lookup_Some A b l i (x : A): SimplBothRel (=) (rotate b l !! i) (Some x) (l !! rotate_nat_add b i (length l) = Some x ∧ (i < length l)%nat).
+Proof. unfold SimplBothRel. by rewrite lookup_rotate_r_Some. Qed.
+
+(* Unsafe because the other direction does not hold if base >= len.
+  But one should not use rotate nat in this case.
+   TODO: use CanSolve when it is able to prove base < len for slot_for_key_ref key len *)
+Global Instance simpl_rotate_nat_add_0_Unsafe base offset len:
+  SimplAndUnsafe (base = rotate_nat_add base offset len) ((base < len)%nat ∧ offset = 0%nat).
+Proof. move => [? ->]. rewrite rotate_nat_add_0 //. Qed.
+
+Global Instance simpl_rotate_nat_add_next_Unsafe (base offset1 offset2 len : nat) `{!CanSolve (0 < len)%nat}:
+  SimplAndUnsafe ((rotate_nat_add base offset1 len + 1) `rem` len = rotate_nat_add base offset2 len) (offset2 = S offset1).
+Proof.
+  unfold CanSolve in * => ->. rewrite rotate_nat_add_S // Nat2Z.inj_mod.
+  rewrite Z.rem_mod_nonneg //=; lia.
+Qed.
diff --git a/refinedVST/lithium/solvers.v b/refinedVST/lithium/solvers.v
new file mode 100644
index 0000000000..a307dd1a2f
--- /dev/null
+++ b/refinedVST/lithium/solvers.v
@@ -0,0 +1,242 @@
+From lithium Require Export base.
+From lithium Require Import hooks simpl_classes pure_definitions normalize.
+
+(** This file provides various pure solvers. *)
+
+(** * [refined_solver]
+    Version of naive_solver which fails faster. *)
+Tactic Notation "refined_solver" tactic(tac) :=
+  unfold iff, not in *;
+  repeat match goal with
+  | H : context [∀ _, _ ∧ _ ] |- _ =>
+    repeat setoid_rewrite forall_and_distr in H; revert H
+  | H : context [Is_true _ ] |- _ =>
+    repeat setoid_rewrite Is_true_eq in H
+  | |- Is_true _ => repeat setoid_rewrite Is_true_eq
+  end;
+  let rec go :=
+  repeat match goal with
+  (**i solve the goal *)
+  | |- _ => fast_done
+  (**i intros *)
+  | |- ∀ _, _ => intro
+  (**i simplification of assumptions *)
+  | H : False |- _ => destruct H
+  | H : _ ∧ _ |- _ =>
+     (* Work around bug https://coq.inria.fr/bugs/show_bug.cgi?id=2901 *)
+     let H1 := fresh in let H2 := fresh in
+     destruct H as [H1 H2]; try clear H
+  | H : ∃ _, _  |- _ =>
+     let x := fresh in let Hx := fresh in
+     destruct H as [x Hx]; try clear H
+  | H : ?P → ?Q, H2 : ?P |- _ => specialize (H H2)
+  (**i simplify and solve equalities *)
+  (* | |- _ => progress simplify_eq/= *)
+  | |- _ => progress subst; csimpl in *
+  (**i operations that generate more subgoals *)
+  | |- _ ∧ _ => split
+  (* | |- Is_true (bool_decide _) => apply (bool_decide_pack _) *)
+  (* | |- Is_true (_ && _) => apply andb_True; split *)
+  | H : _ ∨ _ |- _ =>
+     let H1 := fresh in destruct H as [H1|H1]; try clear H
+  (* | H : Is_true (_ || _) |- _ => *)
+     (* apply orb_True in H; let H1 := fresh in destruct H as [H1|H1]; try clear H *)
+  (**i solve the goal using the user supplied tactic *)
+  | |- _ => solve [tac]
+  end;
+  (**i use recursion to enable backtracking on the following clauses. *)
+  match goal with
+  (**i instantiation of the conclusion *)
+  | |- ∃ x, _ => no_new_unsolved_evars ltac:(eexists; go)
+  | |- _ ∨ _ => first [left; go | right; go]
+  (* | |- Is_true (_ || _) => apply orb_True; first [left; go | right; go] *)
+  | _ =>
+    (**i instantiations of assumptions. *)
+    match goal with
+    | H : ?P → ?Q |- _ =>
+      let H' := fresh "H" in
+      assert P as H'; [clear H; go|];
+      specialize (H H'); clear H'; go
+    end
+  end in go.
+Tactic Notation "refined_solver" := refined_solver eauto.
+
+(** * [normalize_and_simpl_goal] *)
+Ltac normalize_and_simpl_impl handle_exist :=
+  let do_intro :=
+    idtac;
+    match goal with
+    | |- (∃ _, _) → _ =>
+        lazymatch handle_exist with
+        | true => case
+        | false => fail 1 "exist not handled"
+        end
+    | |- (_ ∧ _) → _ => case
+    | |- (_ = _) → _ =>
+        check_injection_hook;
+        let Hi := fresh "Hi" in move => Hi; injection Hi; clear Hi
+    | |- False → _ => case
+    | |- ?P → _ => assert_is_not_trivial P; let H := fresh "H" in intros H; subst
+    | |- _ => move => _
+    end in
+  lazymatch goal with
+  (* relying on the fact that unification variables cannot contain
+  dependent variables to distinguish between dependent and non
+  dependent forall *)
+  | |- ?P -> ?Q =>
+    lazymatch type of P with
+    | Prop => first [
+        (* first check if the hyp is trivial *)
+        assert_is_trivial P; intros _
+      | progress normalize_goal_impl
+      | let changed := open_constr:(_) in
+        notypeclasses refine (simpl_impl_unsafe_impl changed P _ Q _); [solve [refine _] |];
+        (* We need to simpl here to make sure that we only introduce
+        fully simpl'd terms into the context (and do beta reduction
+        for the lemma application above). *)
+        simpl;
+        lazymatch changed with
+        | true => idtac
+        | false => do_intro
+        end
+      | do_intro
+      ]
+    (* just some unused variable, forget it *)
+    | _ => move => _
+    end
+  end.
+
+Lemma intro_and_True P :
+  (P ∧ True) → P.
+Proof. naive_solver. Qed.
+
+Ltac normalize_and_simpl_goal_step :=
+  first [
+      splitting_fast_done
+    | progress normalize_goal; simpl
+    | lazymatch goal with
+      | |- ∃ _, _ => fail 1 "normalize_and_simpl_goal stop in exist"
+      end
+    | lazymatch goal with
+      | |- _ ∧ _ => split
+      end
+    | notypeclasses refine (simpl_and_unsafe _); [solve [refine _] |]; simpl
+    | lazymatch goal with
+    (* relying on the fact that unification variables cannot contain
+       dependent variables to distinguish between dependent and non dependent forall *)
+      | |- ?P -> ?Q =>
+        normalize_and_simpl_impl true
+      | |- forall _ : ?P, _ =>
+        lazymatch P with
+        | (prod _ _) => case
+        | unit => case
+        | _ => intro
+        end
+    end ].
+
+Ltac normalize_and_simpl_goal := repeat normalize_and_simpl_goal_step.
+
+(** * [compute_map_lookup] *)
+Ltac compute_map_lookup :=
+  lazymatch goal with
+  | |- ?Q !! _ = Some _ => try (is_var Q; unfold Q)
+  | _ => fail "unknown goal for compute_map_lookup"
+  end;
+  solve [repeat lazymatch goal with
+  | |- <[?x:=?s]> ?Q !! ?y = Some ?res =>
+    lazymatch x with
+    | y => change_no_check (Some s = Some res); reflexivity
+    | _ => change_no_check (Q !! y = Some res)
+    end
+  end ].
+
+(** * Enriching the context for lia  *)
+Definition enrich_marker {A} (f : A) : A := f.
+Ltac enrich_context_base :=
+    repeat match goal with
+         | |- context C [ Z.quot ?a ?b ] =>
+           let G := context C[enrich_marker Z.quot a b] in
+           change_no_check G;
+           try have ?:=Z.quot_lt a b ltac:(lia) ltac:(lia);
+           try have ?:=Z.quot_pos a b ltac:(lia) ltac:(lia)
+         | |- context C [ Z.rem ?a ?b ] =>
+           let G := context C[enrich_marker Z.rem a b] in
+           change_no_check G;
+           try have ?:=Z.rem_bound_pos a b ltac:(lia) ltac:(lia)
+         | |- context C [ Z.modulo ?a ?b ] =>
+           let G := context C[enrich_marker Z.modulo a b] in
+           change_no_check G;
+           try have ?:=Z.mod_bound_pos a b ltac:(lia) ltac:(lia)
+         | |- context C [ length (filter ?P ?l) ] =>
+           let G := context C[enrich_marker length (filter P l)] in
+           change_no_check G;
+           pose proof (filter_length P l)
+           end.
+
+Ltac enrich_context :=
+  enrich_context_base;
+  enrich_context_hook;
+  unfold enrich_marker.
+
+Section enrich_test.
+  Local Open Scope Z_scope.
+  Goal ∀ n m, 0 < n → 1 < m → n `quot` m = n `rem` m.
+    move => n m ??. enrich_context.
+  Abort.
+End enrich_test.
+
+(** * Instantiate foralls using ideas from SMT triggers *)
+(** [trigger_foralls] instantiates [set_Forall P s] quantifiers in the
+context if it can find [x ∈ s]. *)
+
+Ltac hide_set_Forall :=
+  repeat lazymatch goal with
+    | H : set_Forall ?P ?s |- _  => change (set_Forall P s) with (tc_opaque set_Forall P s) in H
+    end.
+(** [set_unfold_trigger] is a version of [set_unfold] that is
+compatible with [trigger_foralls]. In particular, it does not unfold
+[set_Forall] in the context. *)
+Ltac set_unfold_trigger :=
+  (* For some reason, the [set_unfold] removes the [tc_opaque], so we
+  don't have to do that manually. *)
+  hide_set_Forall; set_unfold.
+
+Ltac trigger_foralls :=
+  repeat lazymatch goal with
+    | H : set_Forall _ (_ ∪ _) |- _ =>
+        pose proof (set_Forall_union_inv_1 _ _ _ H);
+        pose proof (set_Forall_union_inv_2 _ _ _ H);
+        clear H
+    end;
+  repeat lazymatch goal with
+    | H : set_Forall _ ({[_]}) |- _ => move/set_Forall_singleton in H end;
+  repeat match goal with
+    | H1 : set_Forall _ ?s, H2 : _ ∈ ?s |- _ => learn_hyp (H1 _ H2)
+    end;
+  repeat match goal with
+    | H1 : list_Forall _ ?l, H2 : ?l !! _ = Some _ |- _ => learn_hyp (H1 _ _ H2)
+    end;
+  lazy beta in *|-.
+
+(** * [solve_goal]  *)
+Ltac reduce_closed_Z :=
+  idtac;
+  reduce_closed_Z_hook;
+  repeat match goal with
+  | |- context [(?a * ?b)%nat] => progress reduce_closed (a * b)%nat
+  | H : context [(?a * ?b)%nat] |- _ => progress reduce_closed (a * b)%nat
+  | |- context [(?a ≪ ?b)%Z] => progress reduce_closed (a ≪ b)%Z
+  | H : context [(?a ≪ ?b)%Z] |- _ => progress reduce_closed (a ≪ b)%Z
+  | |- context [(?a ≫ ?b)%Z] => progress reduce_closed (a ≫ b)%Z
+  | H : context [(?a ≫ ?b)%Z] |- _ => progress reduce_closed (a ≫ b)%Z
+  end.
+
+
+Ltac solve_goal :=
+  simpl;
+  try fast_done;
+  solve_goal_prepare_hook;
+  normalize_and_simpl_goal;
+  solve_goal_normalized_prepare_hook; reduce_closed_Z; enrich_context;
+  repeat case_bool_decide => //; repeat case_decide => //; repeat case_match => //;
+  refined_solver lia.
diff --git a/refinedVST/lithium/syntax.v b/refinedVST/lithium/syntax.v
new file mode 100644
index 0000000000..fe5bb14a50
--- /dev/null
+++ b/refinedVST/lithium/syntax.v
@@ -0,0 +1,452 @@
+From lithium Require Export base.
+From VST.lithium Require Import definitions.
+From lithium Require Import hooks.
+
+Import environments.
+
+Module li.
+Section lithium.
+  Context {PROP : bi}.
+
+  (* Alternative names: prove, assert, consume *)
+  Definition exhale (P T : PROP) : PROP :=
+    P ∗ T.
+  (* Alternative names: intro, assume, produce *)
+  Definition inhale (P T : PROP) : PROP :=
+    P -∗ T.
+
+  Definition all {A} : (A → PROP) → PROP :=
+    bi_forall.
+  Definition exist {A} : (A → PROP) → PROP :=
+    bi_exist.
+
+  Definition done : PROP := emp.
+  Definition false : PROP := False.
+
+  Definition and : PROP → PROP → PROP :=
+    bi_and.
+  Definition and_map {K A} `{!EqDecision K} `{!Countable K}
+    (m : gmap K A) (Φ : K → A → PROP) : PROP :=
+    big_opM bi_and Φ m.
+
+  Definition find_in_context : ∀ fic : find_in_context_info, (fic.(fic_A) → PROP) → PROP :=
+    find_in_context.
+
+  Definition case_if : Prop → PROP → PROP → PROP :=
+    case_if.
+  Definition case_destruct {A} : A → (A → bool → PROP) → PROP :=
+    @case_destruct PROP A.
+
+  Definition drop_spatial : PROP → PROP :=
+    bi_intuitionistically.
+
+  Definition tactic {A} : ((A → PROP) → PROP) → (A → PROP) → PROP :=
+    @li_tactic PROP A.
+
+  Definition accu : (PROP → PROP) → PROP :=
+    accu.
+
+  Definition trace {A} : A → PROP → PROP :=
+    @li_trace PROP A.
+
+  Definition subsume {A} : PROP → (A → PROP) → (A → PROP) → PROP :=
+    subsume.
+  (* TODO: Should we also have a syntax for subsume list? *)
+
+  Definition ret (T : PROP) : PROP := T.
+  Definition iterate [A B] : (B → A → A) → A → list B → A :=
+    @foldr A B.
+
+  Definition bind0 (P : PROP → PROP) (T : PROP) : PROP := P T.
+  Definition bind1 {A1} (P : (A1 → PROP) → PROP) (T : A1 → PROP) : PROP := P T.
+  Definition bind2 {A1 A2} (P : (A1 → A2 → PROP) → PROP) (T : A1 → A2 → PROP) : PROP := P T.
+  Definition bind3 {A1 A2 A3} (P : (A1 → A2 → A3 → PROP) → PROP) (T : A1 → A2 → A3 → PROP) : PROP := P T.
+  Definition bind4 {A1 A2 A3 A4} (P : (A1 → A2 → A3 → A4 → PROP) → PROP) (T : A1 → A2 → A3 → A4 → PROP) : PROP := P T.
+  Definition bind5 {A1 A2 A3 A4 A5} (P : (A1 → A2 → A3 → A4 → A5 → PROP) → PROP) (T : A1 → A2 → A3 → A4 → A5 → PROP) : PROP := P T.
+End lithium.
+End li.
+
+Declare Scope lithium_scope.
+Delimit Scope lithium_scope with LI.
+Global Open Scope lithium_scope.
+
+Declare Custom Entry lithium.
+
+(* notation principle: notations that look like an application (e.g.
+return or inhale) don't have a colon after the name. More fancy
+notations have a colon after the first identifiers (e.g. pattern:).
+This might also be necessary to avoid registering keywords.*)
+Notation "'[{' e } ]" := e
+  (e custom lithium at level 200,
+    format "'[hv' [{  '[hv' e ']'  '/' } ] ']'") : lithium_scope.
+Notation "{ x }" := x (in custom lithium, x constr).
+
+Notation "'inhale' x" := (li.inhale x) (in custom lithium at level 0, x constr,
+                           format "'inhale'  '[' x ']'") : lithium_scope.
+Notation "'exhale' x" := (li.exhale x) (in custom lithium at level 0, x constr,
+                           format "'exhale'  '[' x ']'") : lithium_scope.
+
+Notation "∀ x .. y , P" := (li.all (λ x, .. (li.all (λ y, P)) ..))
+    (in custom lithium at level 100, x binder, y binder, P at level 100, right associativity,
+        format "'[' ∀  x  ..  y , ']'  '/' P") : lithium_scope.
+Notation "∃ x .. y , P" := (li.exist (λ x, .. (li.exist (λ y, P)) ..))
+    (in custom lithium at level 100, x binder, y binder, P at level 100, right associativity,
+        format "'[' ∃  x  ..  y , ']'  '/' P") : lithium_scope.
+
+Notation "'done'" := (li.done) (in custom lithium at level 0) : lithium_scope.
+Notation "'false'" := (li.false) (in custom lithium at level 0) : lithium_scope.
+
+(* Making this a recursive notation is tricky because it is not clear,
+where the and: would end, see
+https://coq.zulipchat.com/#narrow/stream/237977-Coq-users/topic/Problem.20with.20right.20associative.20recursive.20notation/near/365455519 *)
+Notation "'and:' | x | y" := (li.and x y)
+   (in custom lithium at level 100, x at level 100, y at level 100,
+       format "'[hv' and:  '/' |  '[hv' x ']'  '/' |  '[hv' y  ']' ']'") : lithium_scope.
+(* Notation "'and_map:' m | k v , P" := (li.and_map (λ k v, P) m) *)
+    (* (in custom lithium at level 100, k binder, v binder, m constr, P at level 100, *)
+        (* format "'[hv' 'and_map:'  m  '/' |  k  v ,  '[hv' P ']' ']'") : lithium_scope. *)
+Notation "'and_map' x" := (li.and_map x) (in custom lithium at level 0, x constr,
+                           format "'and_map'  '[' x ']'") : lithium_scope.
+
+Notation "'find_in_context' x" := (li.find_in_context x) (in custom lithium at level 0, x constr,
+                           format "'find_in_context'  '[' x ']'") : lithium_scope.
+
+Notation "'if:' P | G1 | G2" := (li.case_if P G1 G2)
+    (in custom lithium at level 100, P constr, G1, G2 at level 100,
+        format "'[hv' 'if:'  P  '/' |  '[hv' G1 ']'  '/' |  '[hv' G2 ']' ']'") : lithium_scope.
+Notation "'destruct' x" := (li.case_destruct x) (in custom lithium at level 0, x constr,
+                           format "'destruct'  '[' x ']'") : lithium_scope.
+
+Notation "'drop_spatial'" := (li.drop_spatial) (in custom lithium at level 0) : lithium_scope.
+
+Notation "'tactic' x" := (li.tactic x) (in custom lithium at level 0, x constr,
+                           format "'tactic'  '[' x ']'") : lithium_scope.
+
+Notation "'accu'" := (li.accu) (in custom lithium at level 0) : lithium_scope.
+
+Notation "'trace' x" := (li.trace x) (in custom lithium at level 0, x constr,
+                           format "'trace'  '[' x ']'") : lithium_scope.
+
+(* TODO: We cannot use :> here due to
+https://github.com/coq/coq/pull/16992/. Is there a good alternative
+syntax to use? *)
+Notation "x ':>>' y" := (li.subsume x y) (in custom lithium at level 0, x constr, y constr,
+                           format "'[' x ']'  ':>>'  '[' y ']'") : lithium_scope.
+
+Notation "'return' x" := (li.ret x) (in custom lithium at level 0, x constr,
+                           format "'return'  '[' x ']'") : lithium_scope.
+(* TODO: figure out if it makes sense to handle this to liToSyntax *)
+Notation "'iterate:' l '{{' x T , P } }" :=
+  (λ T, li.iterate (λ x T, P) T l)
+    (in custom lithium at level 0, l constr, x binder, T binder, P at level 100,
+        format "'[hv  ' 'iterate:'  l  '{{' x  T ,  '/' P } } ']'") : lithium_scope.
+Notation "'iterate:' l 'with' a1 '{{' x T x1 , P } }" :=
+  (λ T, li.iterate (λ x T x1, P) T l a1)
+    (in custom lithium at level 0, l constr, a1 constr, x binder, T binder, x1 binder,
+        P at level 100,
+        format "'[hv  ' 'iterate:'  l  'with'  a1  '{{' x  T  x1 ,  '/' P } } ']'") : lithium_scope.
+Notation "'iterate:' l 'with' a1 , a2 '{{' x T x1 x2 , P } }" :=
+  (λ T, li.iterate (λ x T x1 x2, P) T l a1 a2)
+    (in custom lithium at level 0, l constr, a1 constr, a2 constr, x binder, T binder,
+        x1 binder, x2 binder, P at level 100,
+        format "'[hv  ' 'iterate:'  l  'with'  a1 ,  a2  '{{' x  T  x1  x2 ,  '/' P } } ']'") : lithium_scope.
+Notation "'iterate:' l 'with' a1 , a2 , a3 '{{' x T x1 x2 x3 , P } }" :=
+  (λ T, li.iterate (λ x T x1 x2 x3, P) T l a1 a2 a3)
+    (in custom lithium at level 0, l constr, a1 constr, a2 constr, a3 constr, x binder, T binder,
+        x1 binder, x2 binder, x3 binder, P at level 100,
+        format "'[hv  ' 'iterate:'  l  'with'  a1 ,  a2 ,  a3  '{{' x  T  x1  x2  x3 ,  '/' P } } ']'") : lithium_scope.
+
+
+Notation "y ; z" := (li.bind0 y z)
+  (in custom lithium at level 100, z at level 100,
+      format "y ;  '/' z") : lithium_scope.
+Notation "x ← y ; z" := (li.bind1 y (λ x : _, z))
+  (in custom lithium at level 0, x name, y at level 99, z at level 100,
+      format "x  ←  y ;  '/' z") : lithium_scope.
+Notation "' x ← y ; z" := (li.bind1 y (λ x : _, z))
+  (in custom lithium at level 0, x strict pattern, y at level 99, z at level 100,
+      format "' x  ←  y ;  '/' z") : lithium_scope.
+Notation "x1 , x2 ← y ; z" := (li.bind2 y (λ x1 x2 : _, z))
+  (in custom lithium at level 0, y at level 99, z at level 100, x1 name, x2 name,
+      format "x1 ,  x2  ←  y ;  '/' z") : lithium_scope.
+Notation "x1 , ' x2 ← y ; z" := (li.bind2 y (λ x1 x2 : _, z))
+  (in custom lithium at level 0, y at level 99, z at level 100, x1 name, x2 strict pattern,
+      format "x1 ,  ' x2  ←  y ;  '/' z") : lithium_scope.
+Notation "x1 , x2 , x3 ← y ; z" := (li.bind3 y (λ x1 x2 x3 : _, z))
+  (in custom lithium at level 0, y at level 99, z at level 100, x1 name, x2 name, x3 name,
+      format "x1 ,  x2 ,  x3  ←  y ;  '/' z") : lithium_scope.
+Notation "x1 , x2 , x3 , x4 ← y ; z" := (li.bind4 y (λ x1 x2 x3 x4 : _, z))
+  (in custom lithium at level 0, y at level 99, z at level 100, x1 name, x2 name, x3 name, x4 name,
+      format "x1 ,  x2 ,  x3 ,  x4  ←  y ;  '/' z") : lithium_scope.
+Notation "x1 , x2 , x3 , x4 , x5 ← y ; z" := (li.bind5 y (λ x1 x2 x3 x4 x5 : _, z))
+  (in custom lithium at level 0, y at level 99, z at level 100, x1 name, x2 name, x3 name, x4 name, x5 name,
+      format "x1 ,  x2 ,  x3 ,  x4 ,  x5  ←  y ;  '/' z") : lithium_scope.
+
+Notation "P 'where' x1 .. xn ':-' Q" := (∀ x1, .. (∀ xn, Q ⊢ P) ..)
+   (at level 99, Q custom lithium at level 100, x1 binder, xn binder, only parsing) : stdpp_scope.
+Notation "P ':-' Q" := (Q ⊢ P)
+  (at level 99, Q custom lithium at level 100, only parsing) : stdpp_scope.
+
+(* for find_in_context: *)
+Notation "'pattern:' x .. y , P ; G" :=
+  (li.exist (λ x, .. (li.exist (λ y, li.bind0 (li.exhale P) G)) .. ))
+    (in custom lithium at level 100, x binder, y binder, P constr, G at level 100, only parsing) : lithium_scope.
+
+Declare Reduction liFromSyntax_eval :=
+  cbv [ li.exhale li.inhale li.all li.exist li.done li.false li.and li.and_map
+        li.find_in_context li.case_if li.case_destruct li.drop_spatial li.tactic
+        li.accu li.trace li.subsume li.ret li.iterate
+        li.bind0 li.bind1 li.bind2 li.bind3 li.bind4 li.bind5 ].
+
+Ltac liFromSyntaxTerm c :=
+  eval liFromSyntax_eval in c.
+
+Ltac liFromSyntax :=
+  match goal with
+  | |- ?P =>
+      let Q := liFromSyntaxTerm P in
+      change (Q)
+  end.
+
+Ltac liFromSyntaxGoal :=
+  match goal with
+  | |- @envs_entails ?PROP ?Δ ?P =>
+      let Q := liFromSyntaxTerm P in
+      change (envs_entails Δ Q)
+  end.
+
+Notation "'[type_from_syntax' x ]" :=
+    ltac:(let t := type of x in let t := liFromSyntaxTerm t in exact t) (only parsing).
+
+Definition liToSyntax_UNFOLD_MARKER {A} (x : A) : A := x.
+(* This tactic heurisitically converts the goal to the Lithium syntax.
+It is not perfect as it might convert occurences to Lithium syntax
+that should stay in Iris syntax, so it should only be used for
+debugging and pretty printing.
+TODO: Build a proper version using Ltac2, see
+https://coq.zulipchat.com/#narrow/stream/237977-Coq-users/topic/Controlling.20printing.20of.20patters.20in.20binders/near/363637321
+ *)
+Ltac liToSyntax :=
+  liFromSyntax; (* make sure that we are not adding things twice, especially around user-defined functions *)
+  liToSyntax_hook;
+  change (bi_sep ?a) with (li.bind0 (li.exhale (liToSyntax_UNFOLD_MARKER a)));
+  change (bi_wand ?a) with (li.bind0 (li.inhale (liToSyntax_UNFOLD_MARKER a)));
+  change (@bi_forall ?PROP ?A) with (@li.all PROP A);
+  change (@bi_exist ?PROP ?A) with (@li.exist PROP A);
+  change (@bi_pure ?PROP True) with (@li.done PROP);
+  change (@bi_pure ?PROP False) with (@li.false PROP);
+  repeat (progress change (big_opM bi_and ?f ?m) with (li.bind2 (li.and_map m) f));
+  change (@bi_and ?PROP) with (@li.and PROP);
+  change (find_in_context ?a) with (li.bind1 (li.find_in_context a));
+  change (@case_if ?PROP ?P) with (@li.case_if PROP P);
+  change (@case_destruct ?PROP ?A ?a) with (li.bind2 (@li.case_destruct PROP A a));
+  change (@bi_intuitionistically ?PROP) with (li.bind0 (@li.drop_spatial PROP));
+  change (li_tactic ?t) with (li.bind1 (li.tactic t));
+  change (@accu ?PROP) with (li.bind1 (@li.accu PROP));
+  change (@li_trace ?PROP ?A ?t) with (li.bind0 (@li.trace PROP A t));
+  (* TODO: check if the unfold marker for b works *)
+  change (subsume ?a ?b) with (li.bind1 (li.subsume (liToSyntax_UNFOLD_MARKER a) (liToSyntax_UNFOLD_MARKER b)));
+  (* Try to at least unfold some spurious conversions. *)
+  repeat (first [
+              progress change (liToSyntax_UNFOLD_MARKER (li.bind0 (@li.exhale ?Σ ?a) ?b))
+              with (a ∗ liToSyntax_UNFOLD_MARKER b)%I
+            | progress change (liToSyntax_UNFOLD_MARKER (li.bind0 (@li.drop_spatial ?Σ) ?b))
+              with (□ liToSyntax_UNFOLD_MARKER b)%I ]);
+  change (liToSyntax_UNFOLD_MARKER (@li.done ?PROP)) with (@bi_pure PROP True);
+  change (liToSyntax_UNFOLD_MARKER (@li.false ?PROP)) with (@bi_pure PROP False);
+  unfold liToSyntax_UNFOLD_MARKER.
+
+Ltac liToSyntaxGoal :=
+  iEval ( liToSyntax ).
+
+(* The following looses the printing of patterns and is extremely slow
+when going under many binders (e.g. typed_place). *)
+(*
+Ltac to_li c :=
+  lazymatch c with
+  | bi_sep ?P ?G =>
+      refine (li.bind0 (li.exhale P) _);
+      to_li G
+  | bi_wand ?P ?G =>
+      refine (li.bind0 (li.inhale P) _);
+      to_li G
+  | @bi_forall _ ?A (fun x => @?G x) =>
+      refine (@li.all _ A (λ x, _));
+      let y := eval lazy beta in (G x) in
+      to_li y
+  | @bi_exist _ ?A (fun x => @?G x) =>
+      refine (@li.exist _ A (λ x, _));
+      let y := eval lazy beta in (G x) in
+      to_li y
+  | @bi_exist _ ?A (fun x => @?G x) =>
+      refine (@li.exist _ A (λ x, _));
+      let y := eval lazy beta in (G x) in
+      to_li y
+  | True%I => refine (li.done)
+  | ?P (fun x => @?G x) =>
+      (* idtac x; *)
+      refine (li.bind1 P (λ x, _));
+      let y := eval lazy beta in (G x) in
+      (* idtac y; *)
+      to_li y
+  | match ?x with | (a, b) => @?G a b end =>
+      refine (match x with | (a, b) => _ end);
+      let y := eval lazy beta in (G a b) in
+      (* idtac y;       *)
+      to_li y
+  | ?G =>
+      refine (G)
+  end.
+
+Ltac goal_to_li :=
+  match goal with
+  | |- @envs_entails ?PROP ?Δ ?P =>
+      let x := fresh in
+      unshelve evar (x : bi_car PROP); [to_li P|];
+      change (envs_entails Δ x); unfold x; clear x
+  end.
+*)
+
+(** * Lemmas for working with [li.iterate] *)
+Lemma iterate_elim0 {PROP : bi} {A} INV (l : list A) F G:
+  ⊢@{PROP} [{ iterate: l {{ x T, return F x T }}; return G }] -∗
+  INV 0%nat -∗
+  □ (∀ i x T, <affine> ⌜l !! i = Some x⌝ -∗ INV i -∗ F x T -∗ INV (S i) ∗ T) -∗
+  INV (length l) ∗ G.
+Proof.
+  liFromSyntax.
+  iIntros "Hiter Hinv #HF".
+  iInduction l as [|? l] "IH" forall (INV) => /=. { iFrame. }
+  iDestruct ("HF" $! 0%nat with "[//] Hinv Hiter") as "[??]".
+  iDestruct ("IH" $! (λ i, INV (S i)) with "[] [$] [$]") as "$".
+  iIntros "!>" (????) "??". iApply ("HF" $! (S _) with "[//] [$] [$]").
+Qed.
+
+Lemma iterate_elim1 {PROP : bi} {A B} INV (l : list A) F G (a : B) :
+  ⊢@{PROP} [{ x ← iterate: l with a {{ x T a, return F x T a }}; return G x }] -∗
+  INV 0%nat a -∗
+  □ (∀ i x T a, <affine> ⌜l !! i = Some x⌝ -∗ INV i a -∗ F x T a -∗ ∃ a', INV (S i) a' ∗ T a') -∗
+  ∃ a', INV (length l) a' ∗ G a'.
+Proof.
+  liFromSyntax.
+  iIntros "Hiter Hinv #HF".
+  iInduction l as [|x l] "IH" forall (INV a) => /=. { iExists _. iFrame. }
+  iDestruct ("HF" $! 0%nat with "[//] Hinv Hiter") as (?) "[??]".
+  iDestruct ("IH" $! (λ i, INV (S i)) with "[] [$] [$]") as "$".
+  iIntros "!>" (?????) "??". iApply ("HF" $! (S _) with "[//] [$] [$]").
+Qed.
+
+Lemma iterate_elim2 {PROP : bi} {A B C} INV (l : list A) F G (a : B) (b : C) :
+  ⊢@{PROP} [{ x, y ← iterate: l with a, b {{ x T a b, return F x T a b }}; return G x y }] -∗
+  INV 0%nat a b -∗
+  □ (∀ i x T a b, <affine> ⌜l !! i = Some x⌝ -∗ INV i a b -∗ F x T a b -∗ ∃ a' b', INV (S i) a' b' ∗ T a' b') -∗
+  ∃ a' b', INV (length l) a' b' ∗ G a' b'.
+Proof.
+  liFromSyntax.
+  iIntros "Hiter Hinv #HF".
+  iInduction l as [|x l] "IH" forall (INV a b) => /=. { iExists _, _. iFrame. }
+  iDestruct ("HF" $! 0%nat with "[//] Hinv Hiter") as (??) "[??]".
+  iDestruct ("IH" $! (λ i, INV (S i)) with "[] [$] [$]") as "$".
+  iIntros "!>" (??????) "??". iApply ("HF" $! (S _) with "[//] [$] [$]").
+Qed.
+
+Lemma iterate_elim3 {PROP : bi} {A B C D} INV (l : list A) F G (a : B) (b : C) (c : D) :
+  ⊢@{PROP} [{ x, y, z ← iterate: l with a, b, c {{ x T a b c, return F x T a b c }}; return G x y z }] -∗
+  INV 0%nat a b c -∗
+  □ (∀ i x T a b c, <affine> ⌜l !! i = Some x⌝ -∗ INV i a b c -∗ F x T a b c -∗ ∃ a' b' c', INV (S i) a' b' c' ∗ T a' b' c') -∗
+  ∃ a' b' c', INV (length l) a' b' c' ∗ G a' b' c'.
+Proof.
+  liFromSyntax.
+  iIntros "Hiter Hinv #HF".
+  iInduction l as [|x l] "IH" forall (INV a b c) => /=. { iExists _, _, _. iFrame. }
+  iDestruct ("HF" $! 0%nat with "[//] Hinv Hiter") as (???) "[??]".
+  iDestruct ("IH" $! (λ i, INV (S i)) with "[] [$] [$]") as "$".
+  iIntros "!>" (???????) "??". iApply ("HF" $! (S _) with "[//] [$] [$]").
+Qed.
+
+
+Module li_test.
+Section test.
+
+  Context {PROP : bi}.
+  Parameter check_wp : ∀ (e : Z) (T : Z → PROP), PROP.
+  Parameter get_tuple : ∀ (T : (Z * Z * Z) → PROP), PROP.
+
+  Local Ltac liToSyntax_hook ::=
+    change (check_wp ?x) with (li.bind1 (check_wp x));
+    change (get_tuple) with (li.bind1 (get_tuple)).
+
+  Lemma ex1_1 :
+    ⊢ get_tuple (λ '(x1, x2, x3), ⌜x1 = 0⌝ ∗ subsume False (λ x : unit, False) (λ _, True)).
+  Proof.
+    iStartProof.
+    (* Important: '(...) syntax should be preserved *)
+    (* liToSyntax. *)
+    liFromSyntax.
+  Abort.
+
+
+  (* TODO: investigate why the () around False is necessary. *)
+  Lemma ex1_2 :
+    ⊢ [{ '(x1, _, _) ← {get_tuple}; exhale ⌜x1 = 0⌝; _ ← (False) :>> λ _ : (), [{ false }]; done }].
+  Proof.
+    iStartProof.
+    liFromSyntax.
+  Abort.
+
+  Lemma ex1_3 :
+    ⊢ ∀ n1 n2, (⌜n1 + Z.to_nat n2 > 0⌝ ∗ ⌜n2 = 1⌝) -∗
+     check_wp (n1 + 1) (λ v,
+       ∃ n' : nat, (⌜v = n'⌝ ∗ ⌜n' > 0⌝) ∗ li_trace 1 $ accu (λ P,
+       find_in_context (FindDirect (λ '(n, m), ⌜n =@{Z} m⌝)) (λ '(n, m), ⌜n = m⌝ ∗
+       get_tuple (λ '(x1, x2, x3), □ ⌜x1 = 0⌝ ∗ (P ∧
+         □ [∧ map] a↦'(b1, b2)∈{[1 := (1, 1)]}, ⌜a = b1⌝ ∗
+         case_if (n' = 1) (case_destruct n' (λ n'' b,
+          ⌜b = b⌝ ∗ ⌜n'' = 0⌝ ∗ subsume True (λ x : unit, True) (λ _, True ∗ True ∗ True ∗ True ∗ True ∗ True))) False))))).
+  Proof.
+    iStartProof.
+    (* liToSyntax. *)
+    liFromSyntax.
+  Abort.
+
+  Lemma iterate0 ls :
+    ⊢@{PROP} [{ iterate: ls {{x T,
+                         exhale ⌜x = 1⌝;
+                         return T}};
+         exhale ⌜[] = ls⌝;
+         done}].
+  Proof. Abort.
+
+  Lemma iterate1 (ls : list Z) :
+    ⊢@{PROP} [{ a ← iterate: ls with [] {{x T a,
+                         exhale ⌜a = []⌝;
+                         exhale ⌜a = []⌝;
+                         exhale ⌜a = []⌝;
+                         return T (a ++ [x])}};
+         exhale ⌜a = ls⌝;
+         done}].
+  Proof. Abort.
+
+  Lemma iterate2 (ls : list Z) :
+    ⊢@{PROP} [{ a, b ← iterate: ls with [], [] {{x T a b,
+                         exhale ⌜a = b⌝;
+                         exhale ⌜a = []⌝;
+                         exhale ⌜a = []⌝;
+                         return T (a ++ [x]) (b ++ [x])}};
+         exhale ⌜a = ls⌝;
+         done}].
+  Proof. Abort.
+
+  Lemma iterate3 (ls : list Z) :
+    ⊢@{PROP} [{ a, b, c ← iterate: ls with [], [], [] {{x T a b c,
+                         exhale ⌜a = b⌝;
+                         exhale ⌜a = c⌝;
+                         exhale ⌜a = []⌝;
+                         return T (a ++ [x]) (b ++ [x]) (c ++ [x])}};
+         exhale ⌜a = ls⌝;
+         exhale ⌜a = b⌝;
+         done}].
+  Proof. Abort.
+
+End test.
+End li_test.
diff --git a/refinedVST/overview.md b/refinedVST/overview.md
new file mode 100644
index 0000000000..503ec6670e
--- /dev/null
+++ b/refinedVST/overview.md
@@ -0,0 +1,6 @@
+This folder contains progress towards reimplementing [RefinedC](https://gitlab.mpi-sws.org/iris/refinedc/-/tree/master) on VST.
+
+The main tasks are:
+1. Extend the Clight parser (`clightgen`) to recognize RefinedC [annotations](https://gitlab.mpi-sws.org/iris/refinedc/-/blob/master/ANNOTATIONS.md), or else write a converter from RefinedC ASTs to Clight ASTs
+2. Port some or all of Lithium ([lithium](https://gitlab.mpi-sws.org/iris/refinedc/-/tree/master/theories/lithium) folder in RefinedC) to be generic in the type of proposition instead of using `iProp`, or where that is impossible, port it to use ORA props/`assert`s
+3. Port the implementation of RefinedC's type system ([typing](https://gitlab.mpi-sws.org/iris/refinedc/-/tree/master/theories/typing) folder in RefinedC) to VST's logic, and re-prove its typing rules.
diff --git a/refinedVST/reuse.md b/refinedVST/reuse.md
new file mode 100644
index 0000000000..8a1035e371
--- /dev/null
+++ b/refinedVST/reuse.md
@@ -0,0 +1,9 @@
+Files that we can safely import from `lithium` rather than `VST.lithium`:
+
+`base`
+
+`pure_definitions`
+
+`hooks`
+
+`normalize`
diff --git a/refinedVST/typing/adequacy.v b/refinedVST/typing/adequacy.v
new file mode 100644
index 0000000000..d867ed8c14
--- /dev/null
+++ b/refinedVST/typing/adequacy.v
@@ -0,0 +1,335 @@
+From iris.algebra Require Import csum excl auth cmra_big_op gmap.
+(*From iris.base_logic.lib Require Import ghost_map.*)
+From VST.veric Require Import Clight_core SequentialClight.
+From VST.typing Require Export type.
+From VST.typing Require Import programs function bytes globals int fixpoint.
+Set Default Proof Using "Type".
+
+(* Class typePreG Σ := PreTypeG {
+  type_invG                      :: invGpreS Σ;
+  type_heap_heap_inG             :: heapGpreS Σ;
+(*  type_heap_alloc_meta_map_inG  :: ghost_mapG Σ alloc_id (Z * nat * alloc_kind);
+  type_heap_alloc_alive_map_inG  :: ghost_mapG Σ alloc_id bool;
+  type_heap_fntbl_inG            :: ghost_mapG Σ addr function; *)
+}.
+
+Definition typeΣ : gFunctors :=
+  #[invΣ;
+   GFunctor (constRF (authR heapUR));
+   ghost_mapΣ alloc_id (Z * nat * alloc_kind);
+   ghost_mapΣ alloc_id bool;
+   ghost_mapΣ addr function].
+Global Instance subG_typePreG {Σ} : subG typeΣ Σ → typePreG Σ.
+Proof. solve_inG. Qed. *)
+
+Definition main_type `{!typeG Σ} {cs : compspecs} (P : iProp Σ) : unit → function.fn_params :=
+  fn(∀ () : (); P) → ∃ () : (), int.int tint; True.
+
+Global Instance VST_typeG `{!VSTGS OK_ty Σ} : typeG Σ := TypeG _ _.
+
+(* up *)
+Lemma var_sizes_ok_sub : forall c1 c2 vars (Hsub : cenv_sub c1 c2)
+  (Hcomplete : Forall (fun it : ident * Ctypes.type => complete_type c1 (snd it) = true) vars),
+  @var_sizes_ok c1 vars -> @var_sizes_ok c2 vars.
+Proof.
+  intros.
+  pose proof (List.Forall_and Hcomplete H) as H1.
+  eapply Forall_impl; first apply H1.
+  simpl; intros ? (? & ?).
+  rewrite (cenv_sub_sizeof Hsub) //.
+Qed.
+
+(* see believe_internal *)
+Definition typed_func `{!VSTGS OK_ty Σ} {Espec : ext_spec OK_ty} (V: varspecs) (G : funspecs) {C: compspecs}
+  (A : TypeTree) (t : dtfr A → function.fn_params)
+  (ge: Genv.t Clight.fundef Ctypes.type) (id: ident) :=
+  exists f, semax_body_params_ok f = true /\
+      Forall (fun it : ident * Ctypes.type =>
+          complete_type cenv_cs (snd it) = true) (fn_vars f) /\
+       list_norepet (map fst (fn_params f) ++ map fst (fn_temps f)) /\
+       list_norepet (map fst (fn_vars f)) /\
+       var_sizes_ok (f.(fn_vars)) /\
+       ∃ b, Genv.find_symbol ge id = Some b /\ Genv.find_funct_ptr ge b = Some (Internal f) /\
+      ⊢ Vptr b Ptrofs.zero ◁ᵥ (b, 0%Z) @ function_ptr Espec (nofunc_tycontext V G) (Build_genv ge cenv_cs) t.
+
+(* RefinedC assumes that typechecking main implicitly typechecks all functions it calls.
+   Can we do that too, or do we need to say that each function meets its specified type
+   (and convert G to a list of types for each function)? *)
+
+(* just main *)
+Definition typed_prog `{!VSTGS OK_ty Σ} {Espec : ext_spec OK_ty} {C : compspecs}
+       (prog: Clight.program) (ora: OK_ty) (V: varspecs) G : Prop :=
+compute_list_norepet (prog_defs_names prog) = true  /\
+all_initializers_aligned prog /\
+Maps.PTree.elements cenv_cs = Maps.PTree.elements (prog_comp_env prog) /\
+(*typed_func V G (Genv.globalenv prog) (prog_funct prog) G /\*)
+match_globvars (prog_vars prog) V = true /\
+  typed_func V G (ConstType unit) (main_type emp) (Genv.globalenv (program_of_program prog)) prog.(prog_main).
+
+(* Definition typed_prog `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {C: compspecs}
+       (prog: program) (ora: OK_ty) (V: varspecs) (G: funspecs) : Prop :=
+compute_list_norepet (prog_defs_names prog) = true  /\
+all_initializers_aligned prog /\
+Maps.PTree.elements cenv_cs = Maps.PTree.elements (prog_comp_env prog) /\
+typed_func V G (Genv.globalenv prog) (prog_funct prog) G /\
+match_globvars (prog_vars prog) V = true /\
+match find_id prog.(prog_main) G with
+| Some s => exists post,
+      s = main_spec_ext' prog ora post
+| None => False
+end. *)
+
+
+(*[∗ list] main ∈ thread_mains, ∃ P, main ◁ᵥ main @ function_ptr (main_type P) ∗ P*)
+
+(* mimicking semax_prog_rule for typed_prog *)
+
+Lemma typed_func_entry_point `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs}
+  V f G prog b id_fun args A t
+(*    (E: dtfr (MaskTT A))
+   (P: dtfr (ArgsTT A))
+   (Q: dtfr (AssertTT A)) *)
+  h z:
+  let retty := tint in
+  postcondition_allows_exit OK_spec retty ->
+  Maps.PTree.elements cenv_cs = Maps.PTree.elements (prog_comp_env prog) ->
+  typed_func V G A t (globalenv prog) id_fun ->
+  Genv.find_symbol (globalenv prog) id_fun = Some b ->
+  Genv.find_funct_ptr (globalenv prog) b = Some (Internal f) ->
+(*   find_id id_fun G =
+     Some (mk_funspec (params, retty) cc_default A E P Q) ->
+ *)  tc_vals (map snd f.(fn_params)) args ->
+  let gargs := (filter_genv (globalenv prog), args) in
+  { q : CC_core |
+   (forall m,
+(*     Forall (fun v => Val.inject (Mem.flat_inj (nextblock m)) v v)  args->*)
+(*     inject_neutral (nextblock m) m /\ *)
+(*     Coqlib.Ple (Genv.genv_next (Genv.globalenv prog)) (nextblock m) ->*)
+    exists m', semantics.initial_core (cl_core_sem (globalenv prog)) h
+    m q m' (Vptr b Ptrofs.zero) args) /\
+
+  forall (a: @dtfr Σ A),
+    fp_Pa (t a) ∗ ([∗ list] v;ty∈args;fp_atys (t a), v ◁ᵥ ty)
+    ⊢ jsafeN OK_spec (globalenv prog) ⊤ z q }.
+Proof.
+intro retty.
+intros EXIT CSEQ SP Findb Findf arg_p.
+assert (semax_body_params_ok f = true
+     ∧ Forall (λ it : ident * Ctypes.type, complete_type cenv_cs it.2 = true)
+         (fn_vars f)
+       ∧ list_norepet (map fst (fn_params f) ++ map fst (fn_temps f))
+       ∧ list_norepet (map fst (fn_vars f))
+       ∧ var_sizes_ok (fn_vars f)
+          ∧ (⊢ Vptr b Ptrofs.zero
+                   ◁ᵥ (b, 0%Z) @
+                      function_ptr OK_spec (nofunc_tycontext V G)
+                        {| genv_genv := globalenv prog; genv_cenv := cenv_cs |} t))%type as Hf.
+{ destruct SP as (? & ? & ? & ? & ? & ? & ? & Hb & Hf & ?).
+  rewrite Hb in Findb; inv Findb; auto 6. }
+clear SP; destruct Hf as (? & ? & Hparams & ? & Hsz & Hty).
+exists (Clight_core.Callstate (Internal f) args Kstop).
+split.
+{ intros m; exists m.
+  simpl.
+  rewrite Findf //. }
+intros.
+iIntros "(P & args)".
+iApply jsafe_step.
+rewrite /jstep_ex.
+iIntros (?) "(Hm & ?)".
+change (prog_comp_env prog) with (genv_cenv (globalenv prog)) in *.
+assert (HGG: cenv_sub (@cenv_cs CS) (globalenv prog)).
+ { clear - CSEQ. forget (@cenv_cs CS) as cs1.
+   forget (genv_cenv (globalenv prog)) as cs2.
+   hnf; intros; hnf.
+   destruct (cs1 !! i)%maps eqn:?H; auto.
+   apply Maps.PTree.elements_correct in H.
+   apply Maps.PTree.elements_complete. congruence.
+ }
+eapply var_sizes_ok_sub in Hsz; [|done..].
+iMod (alloc_stackframe with "Hm") as (m' ve' (? & ?)) "(Hm & Hstack)"; [done..|].
+iIntros "!>".
+iExists _, _; iSplit.
+{ iPureIntro; constructor.
+  constructor; eauto.
+  all: admit. }
+iFrame.
+(* This will be annoying to use because args are already values, not exprs. *)
+iPoseProof (type_call_fnptr _ _ _ _ (Evar id_fun (Tfunction (type_of_params (fn_params f)) (fn_return f) (fn_callconv f))) with "[Hstack]") as "Hty".
+{ simpl.
+  admit. (* use Hstack, args, Hty; also need an assumption that the input types are satisfied *) }
+rewrite /typed_call /=.
+admit.
+Admitted.
+
+Lemma typed_prog_rule `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs} :
+  forall V G prog m h z,
+     postcondition_allows_exit OK_spec tint ->
+     typed_prog(C := CS) prog z V G ->
+     Genv.init_mem prog = Some m ->
+     { b & { q : CC_core &
+       (Genv.find_symbol (globalenv prog) (prog_main prog) = Some b) *
+       (exists m', semantics.initial_core (cl_core_sem (globalenv prog)) h
+                       m q m' (Vptr b Ptrofs.zero) nil) *
+       (state_interp Mem.empty z ∗ funspec_auth ∅ ∗ has_ext z ⊢ |==> state_interp m z ∗ jsafeN OK_spec (globalenv prog) ⊤ z q)
+     } }%type.
+Proof.
+  intros until z. intro EXIT. intros ? H1.
+  generalize H; intros [? [AL [HGG [GV Hty]]]].
+  destruct (Genv.find_symbol (globalenv prog) (prog_main prog)) eqn: Hmain.
+  2: { exfalso; destruct Hty as (? & ? & ? & ? & ? & ? & ? & Hmain' & ?). rewrite Hmain in Hmain'; done. }
+  destruct (Genv.find_funct_ptr (globalenv prog) b) as [ [|] |] eqn: Hf;
+    [|exfalso; destruct Hty as (? & ? & ? & ? & ? & ? & ? & Hmain' & Hf' & ?); rewrite Hmain in Hmain'; inv Hmain'; rewrite Hf in Hf'; done..].
+  eapply typed_func_entry_point in Hty as (q & Hinit & Hsafe); eauto.
+  2: { (* no args *) admit. }
+  exists b, q; split; first auto.
+  specialize (Hsafe tt).
+  rewrite /main_type /= in Hsafe.
+  iIntros "((Hm & $) & Hf & Hz)".
+  apply compute_list_norepet_e in H0.
+  (* need a version of this without funspec_auth *)
+  iMod (initialize_mem' with "[$Hm $Hf]") as "($ & Hm & Hcore & Hmatch)"; [try done..|].
+  { admit. }
+  rewrite -Hsafe.
+Admitted.
+
+(* The G in typed_prog is pretty much arbitrary, and we could replace it with a
+   dummy that has default funspecs for every function in prog_funct prog, or work
+   around it entirely. *)
+
+(** * The main adequacy lemma *)
+Lemma refinedc_adequacy Σ `{!VSTGpreS OK_ty Σ} {Espec : forall `{VSTGS OK_ty Σ}, ext_spec OK_ty} {dryspec : ext_spec OK_ty} (initial_oracle: OK_ty)
+     (EXIT: forall `{!VSTGS OK_ty Σ}, semax_prog.postcondition_allows_exit Espec tint)
+     (Hdry : forall `{!VSTGS OK_ty Σ}, ext_spec_entails Espec dryspec)
+     prog V m :
+     (∃ (G : forall `{VSTGS OK_ty Σ}, funspecs), forall (HH : VSTGS OK_ty Σ), exists CS: compspecs,
+        typed_prog(Espec := Espec) prog initial_oracle V G) ->
+     Genv.init_mem prog = Some m ->
+     exists b, exists q,
+       Genv.find_symbol (Genv.globalenv prog) (prog_main prog) = Some b /\
+       semantics.initial_core (cl_core_sem (globalenv prog))
+           0 m q m (Vptr b Ptrofs.zero) nil /\
+       forall n,
+        @step_lemmas.dry_safeN _ _ _ OK_ty (genv_symb_injective)
+            (cl_core_sem (globalenv prog))
+            dryspec
+            (Build_genv (Genv.globalenv prog) (prog_comp_env prog))
+             n initial_oracle q m.
+Proof.
+  intros (G & H) Hm.
+  assert (forall n, exists b, exists q,
+       Genv.find_symbol (Genv.globalenv prog) (prog_main prog) = Some b /\
+       semantics.initial_core (cl_core_sem (globalenv prog))
+           0 m q m (Vptr b Ptrofs.zero) nil /\
+        @step_lemmas.dry_safeN _ _ _ OK_ty (genv_symb_injective)
+            (cl_core_sem (globalenv prog))
+            dryspec
+            (Build_genv (Genv.globalenv prog) (prog_comp_env prog))
+             n initial_oracle q m).
+  2: { destruct (H0 O) as (b0 & q0 & ? & (? & _) & _); eexists _, _; split; first done; split; first done.
+       intros n; destruct (H0 n) as (b & q & ? & (? & _) & Hsafe).
+       assert (b0 = b) as -> by congruence.
+       assert (q0 = q) as -> by congruence.
+       done. }
+  intros n; eapply ouPred.pure_soundness, (step_fupdN_soundness_no_lc' _ (S n) O); [apply _..|].
+  simpl; intros; iIntros "_".
+  iMod (@init_VST _ _ VSTGpreS0) as "H".
+  iDestruct ("H" $! Hinv) as (?? HE) "(H & ?)".
+  set (HH := Build_VSTGS _ _ (HeapGS _ _ _ _) HE).
+  specialize (H HH); specialize (EXIT HH); destruct H.
+  eapply (typed_prog_rule _ _ _ _ n) in H as (b & q & (? & ? & Hinit & ->) & Hsafe); [|done..].
+  iMod (Hsafe with "H") as "Hsafe".
+  iPoseProof (adequacy with "Hsafe") as "Hsafe".
+  iApply step_fupd_intro; first done; iNext.
+  iApply (step_fupdN_mono with "Hsafe"); apply bi.pure_mono; intros.
+  eapply ext_spec_entails_safe in H; eauto 6.
+Qed.
+
+(*Lemma refinedc_adequacy Σ `{!typePreG Σ} (thread_mains : list loc) (fns : gmap addr function) (gls : list loc) (gvs : list val.val) n t2 σ2 κs hs σ:
+  alloc_new_blocks initial_heap_state GlobalAlloc gls gvs hs →
+  σ = {| st_heap := hs; st_fntbl := fns; |} →
+  (∀ {HtypeG : typeG Σ}, ∃ gl gt,
+  let Hglobals : globalG Σ := {| global_locs := gl; global_initialized_types := gt; |} in
+    ([∗ list] l; v ∈ gls; gvs, l ↦ v) -∗
+    ([∗ map] k↦qs∈fns, fntbl_entry (fn_loc k) qs) ={⊤}=∗
+      [∗ list] main ∈ thread_mains, ∃ P, main ◁ᵥ main @ function_ptr (main_type P) ∗ P) →
+  nsteps (Λ := c_lang) n (initial_prog <$> thread_mains, σ) κs (t2, σ2) →
+  ∀ e2, e2 ∈ t2 → not_stuck e2 σ2.
+Proof.
+  move => Hnew -> Hwp. apply: wp_strong_adequacy. move => ?.
+  set h := to_heapUR ∅.
+  iMod (own_alloc (● h ⋅ ◯ h)) as (γh) "[Hh _]" => //.
+  { apply auth_both_valid_discrete. split => //. }
+  iMod (ghost_map_alloc fns) as (γf) "[Hf Hfm]".
+  iMod (ghost_map_alloc_empty (V:=(Z * nat * alloc_kind))) as (γr) "Hr".
+  iMod (ghost_map_alloc_empty (V:=bool)) as (γs) "Hs".
+  set (HheapG := HeapG _ _ γh _ γr _ γs _ γf).
+  set (HrefinedCG := RefinedCG _ _ HheapG).
+  set (HtypeG := TypeG _ HrefinedCG).
+  move: (Hwp HtypeG) => {Hwp} [gl [gt]].
+  set (Hglobals := {| global_locs := gl; global_initialized_types := gt; |}).
+  move => Hwp.
+  iMod (heap_alloc_new_blocks_upd with "[Hh Hr Hs]") as "[Hctx Hmt]" => //. {
+    rewrite /heap_state_ctx /alloc_meta_ctx /to_alloc_meta_map /alloc_alive_ctx /to_alloc_alive_map !fmap_empty.
+    by iFrame.
+  }
+  rewrite big_sepL2_sep. iDestruct "Hmt" as "[Hmt Hfree]".
+  iAssert (|==> [∗ map] k↦qs ∈ fns, fntbl_entry (fn_loc k) qs)%I with "[Hfm]" as ">Hfm". {
+    iApply big_sepM_bupd. iApply (big_sepM_impl with "Hfm").
+    iIntros "!>" (???) "Hm". rewrite fntbl_entry_eq.
+    iExists _. iSplitR; [done|]. by iApply ghost_map_elem_persist.
+  }
+  iMod (Hwp with "Hmt Hfm") as "Hmains".
+
+  iModIntro. iExists _, (replicate (length thread_mains) (λ _, True%I)), _, _.
+  iSplitL "Hctx Hf"; last first. 1: iSplitL "Hmains".
+  - rewrite big_sepL2_fmap_l. iApply big_sepL2_replicate_r; [done|]. iApply (big_sepL_impl with "Hmains").
+    iIntros "!#" (? main ?); iDestruct 1 as (P) "[Hmain HP]".
+    iApply (type_call with "[-]"). 2: { by iIntros (??) "??". }
+    iApply type_val. iApply type_val_context.
+    iExists (main @ function_ptr (main_type P))%I => /=. iFrame => /=.
+    iApply type_call_fnptr. iIntros "_". iExists () => /=. iFrame. by iIntros (v []) "Hv" => /=.
+  - iFrame. iIntros (?? _ _ ?) "_ _ _". iApply fupd_mask_intro_discard => //. iPureIntro. by eauto.
+  - by iFrame.
+Qed.
+
+(** * Helper functions for using the adequacy lemma *)
+Definition fn_lists_to_fns (addrs : list addr) (fns : list function) : gmap addr function :=
+  list_to_map (zip addrs fns).
+
+Lemma fn_lists_to_fns_cons `{!refinedcG Σ} addr fn addrs fns :
+  length addrs = length fns →
+  addr ∉ addrs →
+  ([∗ map] k↦qs ∈ fn_lists_to_fns (addr :: addrs) (fn :: fns), fntbl_entry (fn_loc k) qs) -∗
+  fntbl_entry (ProvFnPtr, addr) fn ∗ ([∗ map] k↦qs ∈ fn_lists_to_fns addrs fns, fntbl_entry (fn_loc k) qs).
+Proof.
+  move => Hnotin ?.
+  rewrite /fn_lists_to_fns /= big_sepM_insert. { by iIntros "?". }
+  apply not_elem_of_list_to_map_1. rewrite fst_zip => //; lia.
+Qed.*)
+
+(** * Tactics for solving conditions in an adequacy proof *)
+
+Ltac adequacy_intro_parameter :=
+  repeat lazymatch goal with
+         | |- ∀ _ : (), _ => case
+         | |- ∀ _ : (_ * _), _ => case
+         | |- ∀ _ : _, _ => move => ?
+         end.
+
+Ltac adequacy_unfold_equiv :=
+  lazymatch goal with
+  | |- type_fixpoint _ _ ≡ type_fixpoint _ _ => apply: type_fixpoint_proper; [|move => ??]
+  | |- ty_own_val _ _ ≡ ty_own_val _ _ => unfold ty_own_val => /=
+  | |-  _ =@{struct_layout} _ => apply: struct_layout_eq
+  end.
+
+Ltac adequacy_solve_equiv unfold_tac :=
+  first [ eassumption | fast_reflexivity | unfold_type_equiv | adequacy_unfold_equiv | f_contractive | f_equiv' | reflexivity | progress unfold_tac ].
+
+Ltac adequacy_solve_typed_function lemma unfold_tac :=
+  iApply typed_function_equiv; [
+    done |
+    adequacy_intro_parameter => /=; repeat (constructor; [done|]); by constructor |
+    | iApply lemma => //; iExists _; repeat iSplit => //];
+    adequacy_intro_parameter => /=; eexists eq_refl => /=; split_and!; [..|adequacy_intro_parameter => /=; split_and!];  repeat adequacy_solve_equiv unfold_tac.
diff --git a/refinedVST/typing/annotations.v b/refinedVST/typing/annotations.v
new file mode 100644
index 0000000000..21236c2e81
--- /dev/null
+++ b/refinedVST/typing/annotations.v
@@ -0,0 +1,27 @@
+From VST.typing Require Import base.
+
+Inductive to_uninit_annot : Type :=
+  ToUninit.
+
+Inductive stop_annot : Type :=
+  StopAnnot.
+
+Inductive share_annot : Type :=
+  ShareAnnot.
+
+Inductive unfold_once_annot : Type :=
+  UnfoldOnceAnnot.
+
+Inductive learn_annot : Type :=
+  LearnAnnot.
+
+Inductive learn_alignment_annot : Type :=
+  LearnAlignmentAnnot.
+
+Inductive LockAnnot : Type := LockA | UnlockA.
+
+Inductive reduce_annot : Type :=
+  ReduceAnnot.
+
+Inductive assert_annot : Type :=
+  AssertAnnot (s : string).
diff --git a/refinedVST/typing/atomic_bool.v b/refinedVST/typing/atomic_bool.v
new file mode 100644
index 0000000000..6d0fd27b67
--- /dev/null
+++ b/refinedVST/typing/atomic_bool.v
@@ -0,0 +1,201 @@
+From VST.typing Require Export type.
+From VST.typing Require Import programs boolean int.
+From VST.typing Require Import type_options.
+
+Definition atomic_boolN : namespace := nroot.@"atomic_boolN".
+Section atomic_bool.
+  Context `{!typeG Σ} {cs : compspecs}.
+
+  Program Definition atomic_bool (it : Ctypes.type) (PT PF : mpred) : type := {|
+    (* ty_has_op_type ot mt := is_bool_ot ot it StrictBool; *)
+    ty_has_op_type ot mt := (*is_bool_ot ot it stn*) ot = it;
+    ty_own β l :=
+      match β return _ with
+      | Own => ∃ b, l ◁ₗ b @ boolean it ∗ if b then PT else PF
+      | Shr => <affine> ⌜field_compatible it [] l⌝  ∗
+               inv atomic_boolN (∃ b, l ◁ₗ b @ boolean it ∗ if b then PT else PF)
+      end;
+    ty_own_val v := ∃ b, v ◁ᵥ b @ boolean it ∗ if b then PT else PF;
+  |}%I.
+  Next Obligation.
+    iIntros (??????) "H".
+    iDestruct "H" as (b) "(H1 & H2)".
+    Check with_refinement .
+    Check ty_aligned _ _ MCNone .
+    iDestruct (ty_aligned _ _ MCNone with "[$H1]") as %?; [done |].
+    iSplitR => //.
+    iApply inv_alloc. iNext. iExists b. iFrame.
+  Qed.
+  Next Obligation. iIntros (???????) "[% [Hb _]]". by iApply (ty_aligned with "Hb"). Qed.
+  Next Obligation.
+    iIntros (???????) "[% [Hb ?]]".
+    iDestruct (ty_deref with "Hb") as (?) "[? ?]"; [done|].
+    eauto with iFrame.
+  Qed.
+  Next Obligation.
+    iIntros (?????????) "Hl [%b [Hb ?]]".
+    iDestruct (ty_ref with "[] Hl Hb") as "?" => //.
+    iExists b. iFrame.
+  Qed.
+
+  (*
+  Global Instance alloc_alive_atomic_bool it β PT PF:
+    AllocAlive (atomic_bool it PT PF) β True.
+  Proof.
+    constructor. have ?:= bytes_per_int_gt_0 it. destruct β.
+    - iIntros (l) "? (%b&Hl&?)". by iApply (alloc_alive_alive with "[] Hl").
+    - iIntros (l) "? (%&Hl)".
+      iApply (heap_mapsto_alive_strong).
+      iInv "Hl" as "(%b&>Hb&?)" "Hclose".
+      iApply fupd_mask_intro; [set_solver|]. iIntros "_".
+      rewrite /ty_own/=.
+      iDestruct "Hb" as "(%v&%n&%&%&%&?)". iExists _, _. iFrame. iPureIntro.
+      erewrite val_to_Z_length; [|done]. lia.
+  Qed.
+*)
+  
+End atomic_bool.
+Notation "atomic_bool< it , PT , PF >" := (atomic_bool it PT PF)
+  (only printing, format "'atomic_bool<' it ,  PT ,  PF '>'") : printing_sugar.
+
+Section programs.
+  Context `{!typeG Σ} {cs : compspecs}.
+
+  Lemma subsume_atomic_bool_own_int A l n it PT PF T:
+    (l ◁ₗ n @ int it -∗ ∃ x b, l ◁ₗ b @ boolean it ∗ (if b then PT x else PF x) ∗ T x)
+    ⊢ subsume (l ◁ₗ n @ int it) (λ x : A, l ◁ₗ atomic_bool it (PT x) (PF x)) T.
+  Proof.
+    iIntros "HT Hl". iDestruct ("HT" with "Hl") as (??) "[? [? ?]]". by iFrame.
+  Qed.
+  Definition subsume_atomic_bool_own_int_inst := [instance subsume_atomic_bool_own_int].
+  Global Existing Instance subsume_atomic_bool_own_int_inst.
+
+  Lemma subsume_atomic_bool_own_bool A l (b : bool) it PT PF T:
+    (∃ x, (if b then PT x else PF x) ∗ T x)
+    ⊢ subsume (l ◁ₗ b @ boolean it) (λ x : A, l ◁ₗ atomic_bool it (PT x) (PF x)) T.
+  Proof. iIntros "[% [? ?]] Hl". by iFrame. Qed.
+  Definition subsume_atomic_bool_own_bool_inst := [instance subsume_atomic_bool_own_bool].
+  Global Existing Instance subsume_atomic_bool_own_bool_inst.
+
+  (*
+  Check typed_read_end .
+  Lemma type_read_atomic_bool l β it ot PT PF mc T:
+    (⌜match ot with | BoolOp => it = u8 | IntOp it' => it = it' | _ => False end⌝ ∗
+      ∀ b v,
+      case_destruct b (λ (b : bool) _,
+        (* TODO: Should this have a trace? *)
+        (if b then PT else PF) -∗
+        (if b then PT else PF) ∗
+        T v (atomic_bool it PT PF) (b @ boolean it)))
+    ⊢ typed_read_end true ⊤ l β (atomic_bool it PT PF) ot mc T.
+  Proof.
+    iIntros "[%Hot HT]".
+    iApply typed_read_end_mono_strong; [done|]. destruct β.
+    - iIntros "[%b [Hl Hif]] !>". iExists _, _, True%I. iFrame. iSplitR; [done|].
+      unshelve iApply (type_read_copy with "[HT Hif]"). { apply _. } simpl.
+      iSplit; [by destruct ot; simplify_eq/=|]. iSplit; [done|]. iIntros (v) "_ Hl Hv".
+      iDestruct ("HT" $! _ _) as (_) "HT".
+      iDestruct ("HT" with "Hif") as "[Hif HT]". iExists _, _. iFrame "HT Hv".
+      iExists _. by iFrame.
+    - iIntros "[%Hly #Hinv] !>".
+      iExists Own, tytrue, True%I. iSplit; [done|]. iSplit; [done|].
+      iInv "Hinv" as (b) "[>Hl Hif]".
+      iApply typed_read_end_mono_strong; [done|]. iIntros "_ !>".
+      iExists _, _, _. iFrame.
+      unshelve iApply (type_read_copy with "[-]"). { apply _. } simpl.
+      iSplit; [by destruct ot; simplify_eq/=|]. iSplit; [iPureIntro; solve_ndisj|].
+      iIntros (v) "Hif Hl #Hv !>".
+      iDestruct ("HT" $! _ _) as (_) "HT".
+      iDestruct ("HT" with "Hif") as "[Hif HT]". iExists tytrue, tytrue.
+      iSplit; [done|]. iSplit; [ done |]. iModIntro.
+      iSplitL "Hl Hif". { iExists _. by iFrame. }
+      iIntros "_ _ _ !>". iExists _, _. iFrame "∗Hv". by iSplit.
+  Qed.
+  Definition type_read_atomic_bool_inst := [instance type_read_atomic_bool].
+  Global Existing Instance type_read_atomic_bool_inst | 10.
+
+  Lemma type_write_atomic_bool l β it ot PT PF v ty T:
+    (v ◁ᵥ ty -∗
+     ⌜match ot with | BoolOp => it = u8 | IntOp it' => it = it' | _ => False end⌝ ∗
+     ∃ b, v ◁ᵥ b @ boolean it ∗ (if b then PT else PF) ∗ T (atomic_bool it PT PF))
+    ⊢ typed_write_end true ⊤ ot v ty l β (atomic_bool it PT PF) T.
+  Proof.
+    iIntros "HT". iApply typed_write_end_mono_strong; [done|].
+    iIntros "Hv Hl". iModIntro.
+    iDestruct ("HT" with "Hv") as "(%&%x&#Hnew&Hif_new&HT)".
+    destruct β.
+    - iDestruct "Hl" as "[%bold [Hl Hif_old]]".
+      iExists (_ @ boolean it)%I, _, _, True%I. iFrame "∗". iSplitR; [done|]. iSplitR; [done|].
+      iApply type_write_own_copy. { by destruct ot; simplify_eq/=. }
+      iSplit; [by destruct ot; simplify_eq/=|].
+      iIntros "Hv _ Hl !>". iExists _. iFrame "HT". iExists _. by iFrame.
+    - iExists tytrue, Own, tytrue, True%I. iSplit; [done|]. iSplit; [done|]. iSplit; [done|].
+      iDestruct "Hl" as (?) "#Hinv".
+      iInv "Hinv" as (b) "[>Hmt Hif]".
+      iApply typed_write_end_mono_strong; [done|]. iIntros "_ _". iModIntro.
+      iExists _, _, _, True%I. iFrame. iSplitR; [done|]. iSplitR; [done|].
+      iApply type_write_own_copy. { by destruct ot; simplify_eq/=. }
+      iSplit; [by destruct ot; simplify_eq/=|].
+      iIntros "Hv _ Hl !>". iExists tytrue. iSplit; [done|]. iModIntro.
+      iSplitL "Hif_new Hl". { iExists _. by iFrame. }
+      iIntros "_ _ !>". iExists _. iFrame "HT". by iSplit.
+  Qed.
+  Definition type_write_atomic_bool_inst := [instance type_write_atomic_bool].
+  Global Existing Instance type_write_atomic_bool_inst | 10.
+
+  Lemma type_cas_atomic_bool (l : loc) β ot it PT PF lexp Pexp vnew Pnew T:
+    (Pexp -∗ Pnew -∗ ⌜match ot with | BoolOp => it = u8 | IntOp it' => it = it' | _ => False end⌝ ∗
+      ∃ bexp bnew, lexp ◁ₗ bexp @ boolean it ∗ vnew ◁ᵥ bnew @ boolean it ∗
+          ⌜ly_size (ot_layout ot) ≤ bytes_per_addr⌝%nat ∗ (
+            ((if bexp then PT else PF) -∗
+             (if bnew then PT else PF) ∗ (
+                l ◁ₗ{β} atomic_bool it PT PF -∗ lexp ◁ₗ bexp @ boolean it -∗
+                T (val_of_bool true) (true @ builtin_boolean))) ∧
+            (l ◁ₗ{β} atomic_bool it PT PF -∗
+             lexp ◁ₗ negb bexp @ boolean it -∗
+             T (val_of_bool false) (false @ builtin_boolean))
+           )
+        )
+    ⊢ typed_cas ot l (l ◁ₗ{β} (atomic_bool it PT PF))%I lexp Pexp vnew Pnew T.
+  Proof.
+    iIntros "HT Hl Hlexp Hvnew".
+    iDestruct ("HT" with "Hlexp Hvnew") as "(%&%bexp&%bnew&Hlexp&#Hvnew&%&Hsub)".
+    iIntros (Φ) "HΦ". destruct β.
+    - iDestruct "Hl" as (b) "[Hb Hif]".
+      destruct (decide (b = bexp)); subst.
+      + iApply (wp_cas_suc_boolean with "Hb Hlexp") => //.
+        iIntros "!# Hb Hexp".
+        iDestruct "Hsub" as "[Hsub _]". iDestruct ("Hsub" with "Hif") as "[Hif HT]".
+        iApply "HΦ"; last first.
+        * iApply ("HT" with "[Hb Hif] Hexp"). iExists bnew. by iFrame.
+        * by iExists _.
+      + iApply (wp_cas_fail_boolean with "Hb Hlexp") => //.
+        iIntros "!# Hb Hexp". iDestruct "Hsub" as "[_ HT]".
+        iApply "HΦ"; last first.
+        * iApply ("HT" with "[Hb Hif]"). { iExists _. by iFrame. } by destruct b, bexp.
+        * by iExists _.
+    - iDestruct "Hl" as (?) "#Hinv".
+      iInv "Hinv" as "Hb".
+      iDestruct "Hb" as (b) "[>Hmt Hif]".
+      destruct (decide (b = bexp)); subst.
+      + iApply (wp_cas_suc_boolean with "Hmt Hlexp") => //.
+        iIntros "!# Hb Hexp".
+        iDestruct "Hsub" as "[Hsub _]". iDestruct ("Hsub" with "Hif") as "[Hif HT]".
+        iModIntro. iSplitL "Hb Hif". { iExists bnew. iFrame. }
+        iApply "HΦ"; last first.
+        * iApply ("HT" with "[] Hexp"). by iSplit.
+        * by iExists _.
+      + iApply (wp_cas_fail_boolean with "Hmt Hlexp") => //.
+        iIntros "!# Hb Hexp".
+        iDestruct "Hsub" as "[_ HT]".
+        iModIntro. iSplitL "Hb Hif". { by iExists b; iFrame; rewrite /i2v Hvnew. }
+        iApply "HΦ"; last first.
+        * iApply ("HT" with "[]"); first by iSplit. by destruct b, bexp.
+        * by iExists _.
+  Qed.
+  Definition type_cas_atomic_bool_inst := [instance type_cas_atomic_bool].
+  Global Existing Instance type_cas_atomic_bool_inst.
+*)
+End programs.
+
+Global Typeclasses Opaque atomic_bool.
diff --git a/refinedVST/typing/automation.v b/refinedVST/typing/automation.v
new file mode 100644
index 0000000000..1d58e6de4c
--- /dev/null
+++ b/refinedVST/typing/automation.v
@@ -0,0 +1,489 @@
+(* refinedC/typing/automation.v *)
+From iris.proofmode Require Import coq_tactics reduction.
+From lithium Require Import hooks normalize.
+From VST.floyd Require Import forward.
+From VST.lithium Require Export all.
+From VST.typing Require Export type.
+From VST.typing.automation Require Export proof_state (* solvers simplification  loc_eq. *).
+From VST.typing Require Import programs function singleton own (* struct *) bytes int.
+Set Default Proof Using "Type".
+Set Nested Proofs Allowed.
+(** * Defining extensions *)
+(** The [sidecond_hook] and [unsolved_sidecond_hook] hooks that get
+called for all sideconditions resp. all sideconditions that are not
+automatically solved using the default solver. *)
+Ltac sidecond_hook := idtac.
+Ltac unsolved_sidecond_hook := idtac.
+
+(** * Registering extensions *)
+(** We use autorewrite for the moment. *)
+Ltac normalize_hook ::= normalize_autorewrite.
+(* Goal ∀ l i (x : Z), *)
+(*     0 < length (<[i:=x]> $ <[i:=x]> (<[length (<[i:=x]>l) :=x]> l ++ <[length (<[i:=x]>l) :=x]> l)). *)
+(*   move => ???. normalize_goal. *)
+(* Abort. *)
+
+Ltac solve_protected_eq_hook ::=
+  lazymatch goal with
+  (* unfold constants for function types *)
+  | |- @eq (_ → fn_params) ?a (λ x, _) =>
+    lazymatch a with
+    | (λ x, _) => idtac
+    | _ =>
+      let h := get_head a in
+      unfold h;
+      (* necessary to reduce after unfolding because of the strict
+      opaqueness settings for unification *)
+      liSimpl
+    end
+  (* don't fail if nothing matches *)
+  | |- _ => idtac
+  end.
+
+Ltac liUnfoldLetGoal_hook H ::=
+  unfold RETURN_MARKER in H.
+
+Ltac can_solve_hook ::= solve_goal.
+
+Ltac liTrace_hook info ::= add_case_distinction_info info.
+
+Ltac liExtensible_to_i2p_hook P bind cont ::=
+  lazymatch P with
+  | typed_value ?v ?T =>
+      (* One could introduce more let-bindings as follows, but too
+      many let-bindings seem to hurt performance. *)
+      (* bind T ltac:(fun H => uconstr:(typed_value v H)); *)
+      cont uconstr:(((_ : TypedValue _) _))
+  | typed_bin_op ?v1 ?ty1 ?v2 ?ty2 ?o ?ot1 ?ot2 ?T =>
+      cont uconstr:(((_ : TypedBinOp _ _ _ _ _ _ _) _))
+  | typed_un_op ?v ?ty ?o ?ot ?T =>
+      cont uconstr:(((_ : TypedUnOp _ _ _ _) _))
+  (*
+  | typed_call ?v ?P ?vl ?tys ?T =>
+      cont uconstr:(((_ : TypedCall _ _ _ _) _))
+  | typed_copy_alloc_id ?v1 ?ty1 ?v2 ?ty2 ?ot ?T =>
+      cont uconstr:(((_ : TypedCopyAllocId _ _ _ _ _) _))
+  | typed_place ?P ?l1 ?β1 ?ty1 ?T =>
+      cont uconstr:(((_ : TypedPlace _ _ _ _) _))
+  *)    
+  | typed_if ?ot ?v ?P ?T1 ?T2 =>
+      cont uconstr:(((_ : TypedIf _ _ _) _ _))
+  (*
+  | typed_switch ?v ?ty ?it ?m ?ss ?def ?fn ?ls ?fr ?Q =>
+      cont uconstr:(((_ : TypedSwitch _ _ _) _ _ _ _ _ _ _))
+  | typed_assert ?ot ?v ?ty ?s ?fn ?ls ?fr ?Q =>
+      cont uconstr:(((_ : TypedAssert _ _ _) _ _ _ _ _))
+      *)
+  | typed_read_end ?a ?E ?l ?β ?ty ?ly ?mc ?T =>
+      cont uconstr:(((_ : TypedReadEnd _ _ _ _ _ _ _) _))
+  | typed_write_end ?a ?E ?ot ?v1 ?ty1 ?l2 ?β2 ?ty2 ?T =>
+      cont uconstr:(((_ : TypedWriteEnd _ _ _ _ _ _ _ _) _))
+  | typed_addr_of_end ?l ?β ?ty ?T =>
+      cont uconstr:(((_ : TypedAddrOfEnd _ _ _) _))
+  (*
+  | typed_cas ?ot ?v1 ?P1 ?v2 ?P2 ?v3 ?P3 ?T =>
+      cont uconstr:(((_ : TypedCas _ _ _ _ _ _ _) _))
+      *)
+  | typed_annot_expr ?n ?a ?v ?P ?T =>
+      cont uconstr:(((_ : TypedAnnotExpr _ _ _ _) _) )
+  | typed_annot_stmt ?a ?l ?P ?T =>
+      cont uconstr:(((_ : TypedAnnotStmt _ _ _) _))
+      (*
+  | typed_macro_expr ?m ?es ?T =>
+      cont uconstr:(((_ : TypedMacroExpr _ _) _))
+      *)
+  end.
+
+Ltac liToSyntax_hook ::=
+  unfold pop_location_info(*, LocInfoE*);
+  change (typed_value ?x1 ?x2) with (li.bind1 (typed_value x1 x2));
+  change (typed_bin_op ?x1 ?x2 ?x3 ?x4 ?x5 ?x6 ?x7) with (li.bind2 (typed_bin_op x1 x2 x3 x4 x5 x6 x7));
+  change (typed_un_op ?x1 ?x2 ?x3 ?x4) with (li.bind2 (typed_un_op x1 x2 x3 x4));
+  (* change (typed_call ?x1 ?x2 ?x3 ?x4) with (li.bind2 (typed_call x1 x2 x3 x4)); *)
+  (* change (typed_copy_alloc_id ?x1 ?x2 ?x3 ?x4 ?x5) with (li.bind2 (typed_copy_alloc_id x1 x2 x3 x4 x5)); *)
+  (* change (typed_place ?x1 ?x2 ?x3 ?x4) with (li.bind5 (typed_place x1 x2 x3 x4)); *)
+  change (typed_read ?x1 ?x2 ?x3 ?x4) with (li.bind2 (typed_read x1 x2 x3 x4));
+  change (typed_read_end ?x1 ?x2 ?x3 ?x4 ?x5 ?x6 ?x7) with (li.bind3 (typed_read_end x1 x2 x3 x4 x5 x6 x7));
+  change (typed_write ?x1 ?x2 ?x3 ?x4 ?x5) with (li.bind0 (typed_write x1 x2 x3 x4 x5));
+  change (typed_write_end ?x1 ?x2 ?x3 ?x4 ?x5 ?x6 ?x7 ?x8) with (li.bind1 (typed_write_end x1 x2 x3 x4 x5 x6 x7 x8));
+  change (typed_addr_of ?x1) with (li.bind3 (typed_addr_of x1));
+  change (typed_addr_of_end ?x1 ?x2 ?x3) with (li.bind3 (typed_addr_of_end x1 x2 x3));
+  (* change (typed_cas ?x1 ?x2 ?x3 ?x4 ?x5 ?x6 ?x7) with (li.bind2 (typed_cas x1 x2 x3 x4 x5 x6 x7)); *)
+  (* change (typed_annot_expr ?x1 ?x2 ?x3 ?x4) with (li.bind0 (typed_cas x1 x2 x3 x4)); *)
+  (* change (typed_macro_expr ?x1 ?x2) with (li.bind2 (typed_macro_expr x1 x2)); *)
+  change (typed_val_expr ?x1) with (li.bind2 (typed_val_expr x1))
+  (* no typed_if, typed_switch, typed_assert, typed_stmt, typed_annot_stmt *)
+.
+
+(* 
+(** * Main automation tactics *)
+Section automation.
+  Context `{!typeG Σ}.
+
+  Lemma tac_simpl_subst xs s fn ls Q R:
+    typed_stmt (W.to_stmt (W.subst_stmt xs s)) fn ls R Q
+    ⊢ typed_stmt (subst_stmt xs (W.to_stmt s)) fn ls R Q.
+  Proof. by rewrite W.to_stmt_subst. Qed.
+
+  Lemma tac_typed_single_block_rec P b Q fn ls R s:
+    Q !! b = Some s →
+    (P ∗ accu (λ A, typed_block (P ∗ A) b fn ls R Q -∗ P -∗ A -∗ typed_stmt s fn ls R Q))
+    ⊢ typed_stmt (Goto b) fn ls R Q.
+  Proof.
+    iIntros (HQ) "[HP Hs]". iIntros (Hls). unfold accu, typed_block.
+    iDestruct "Hs" as (A) "[HA #Hs]". iLöb as "Hl".
+    iApply wps_goto =>//. iModIntro. iApply ("Hs" with "[] HP HA") => //.
+    iIntros "!# [HP HA]". by iApply ("Hl" with "HP HA").
+  Qed.
+End automation. *)
+
+Ltac liRIntroduceLetInGoal :=
+  lazymatch goal with
+  | |- @envs_entails ?prop ?Δ ?P =>
+    lazymatch P with
+    | @typed_val_expr ?Σ ?tG ?cs ?e ?T =>
+      li_let_bind T (fun H => constr:(@envs_entails prop Δ (@typed_val_expr Σ tG cs e H)))
+    | @typed_write ?Σ ?tG ?cs ?b ?e ?ot ?v ?ty ?T =>
+      li_let_bind T (fun H => constr:(@envs_entails prop Δ (@typed_write Σ tG cs b e ot v ty H)))
+    (* | @typed_place ?Σ ?tG ?P ?l1 ?β1 ?ty1 ?T =>
+      li_let_bind T (fun H => constr:(@envs_entails prop Δ (@typed_place Σ tG P l1 β1 ty1 H))) *)
+    | @typed_bin_op ?Σ ?tG ?cs ?v1 ?P1 ?v2 ?P2 ?op ?ot1 ?ot2 ?T =>
+      li_let_bind T (fun H => constr:(@envs_entails prop Δ (@typed_bin_op Σ tG cs v1 P1 v2 P2 op ot1 ot2 H)))
+    end
+  end.
+
+Ltac liRStmt :=
+  lazymatch goal with
+  | |- envs_entails ?Δ (typed_stmt ?Espec ?ge ?s ?f ?T) =>
+    lazymatch s with
+    (* | LocInfo ?info ?s2 =>
+      update_loc_info (Some info);
+      change_no_check (envs_entails Δ (typed_stmt s2 fn ls fr Q)) *)
+    | _ => update_loc_info (None : option location_info)
+    end
+  end;
+  lazymatch goal with
+  | |- envs_entails ?Δ (typed_stmt ?Espec ?ge ?s ?f ?T) =>
+    lazymatch s with
+    (* | subst_stmt ?xs ?s =>
+      let s' := W.of_stmt s in
+      change (subst_stmt xs s) with (subst_stmt xs (W.to_stmt s'));
+      refine (tac_fast_apply (tac_simpl_subst _ _ _ _ _ _) _); simpl; unfold W.to_stmt, W.to_expr *)
+    | _ =>
+      let s' := s in
+      lazymatch s' with
+      | Sassign _ _ => notypeclasses refine (tac_fast_apply (type_assign _ _ _ _ _ _) _)
+      | Sset _ _ => notypeclasses refine (tac_fast_apply (type_set _ _ _ _ _ _) _)
+      | Ssequence _ _ => notypeclasses refine (tac_fast_apply (type_seq _ _ _ _ _ _) _)
+      | Sreturn $ Some _ => notypeclasses refine (tac_fast_apply (type_return_some _ _ _ _ _) _)
+      | Sreturn None => notypeclasses refine (tac_fast_apply (type_return_none _ _ _ _ _) _)
+      | _ => fail "do_stmt: unknown stmt" s
+      end
+    end
+  end.
+
+(* Ltac liRIntroduceTypedStmt :=
+  lazymatch goal with
+  | |- @envs_entails ?prop ?Δ (introduce_typed_stmt ?fn ?ls ?R) =>
+    iEval (rewrite /introduce_typed_stmt !fmap_insert fmap_empty; simpl_subst);
+      lazymatch goal with
+      | |- @envs_entails ?prop ?Δ (@typed_stmt ?Σ ?tG ?s ?fn ?ls ?R ?Q) =>
+        let HQ := fresh "Q" in
+        let HR := fresh "R" in
+        pose (HQ := (CODE_MARKER Q));
+        pose (HR := (RETURN_MARKER R));
+        change_no_check (@envs_entails prop Δ (@typed_stmt Σ tG s fn ls HR HQ));
+        iEval (simpl) (* To simplify f_init *)
+      end
+  end. *)
+
+Ltac liRPopLocationInfo :=
+  lazymatch goal with
+  (* TODO: don't hardcode this for two arguments *)
+  | |- envs_entails ?Δ (pop_location_info ?info ?T ?a1 ?a2) =>
+    update_loc_info [info; info];
+    change_no_check (envs_entails Δ (T a1 a2))
+  end.
+
+Ltac liRExpr :=
+  (* lazymatch goal with
+  | |- envs_entails ?Δ (typed_val_expr ?e ?T) =>
+    lazymatch e with
+    (* | LocInfo ?info ?e2 =>
+      update_loc_info [info];
+      change_no_check (envs_entails Δ (typed_val_expr e2 (pop_location_info info T))) *)
+    | _ => idtac
+    end
+  end; *)
+  lazymatch goal with
+  | |- envs_entails ?Δ (typed_val_expr ?e ?T) =>
+    lazymatch e with
+    | Ecast _ _ => notypeclasses refine (tac_fast_apply (type_Ecast_same_val _ _ _) _)
+    | Econst_int _ _ => notypeclasses refine (tac_fast_apply (type_const_int _ _ _) _)
+    | Ebinop _ _ _ _ => notypeclasses refine (tac_fast_apply (type_bin_op _ _ _ _ _) _)
+    | Etempvar _ _ => notypeclasses refine (tac_fast_apply (type_tempvar _ _ _ _ _) _)
+    | _ => fail "do_expr: unknown expr" e
+    end
+  | |- envs_entails ?Δ (typed_lvalue ?β ?e ?T) =>
+    lazymatch e with
+    | Evar _ _ => notypeclasses refine (tac_fast_apply (type_var_local _ _ _ _ _ _) _)
+    | _ => fail "do_expr: unknown expr" e
+    end
+  end.
+
+Ltac liRJudgement :=
+  lazymatch goal with
+    | |- envs_entails _ (typed_write _ _ _ _ _ _) => 
+      notypeclasses refine (tac_fast_apply (type_write_simple _ _ _ _ _ _ _) _)
+    | |- envs_entails _ (typed_read _ _ _ _ _) =>
+      fail "liRJudgement: type_read not implemented yet"
+      (* notypeclasses refine (tac_fast_apply (type_read _ _ _ _ _ _ _) _); [ solve [refine _ ] |] *)
+    | |- envs_entails _ (typed_addr_of _ _) =>
+      fail "liRJudgement: type_addr_of not implemented yet"
+      (* notypeclasses refine (tac_fast_apply (type_addr_of_place _ _ _ _) _); [solve [refine _] |] *)
+  end.
+
+(* deal with objective modalities. This is ad-hoc for now *)
+Ltac liObj :=
+  match goal with
+  | |- envs_entails _ (<obj> _) =>
+    iModIntro
+  end.
+
+(* This does everything *)
+Ltac liRStep :=
+ liEnsureInvariant;
+ try liRIntroduceLetInGoal;
+ first [
+   liRPopLocationInfo
+ | liRStmt
+ (* | liRIntroduceTypedStmt *)
+ | liRExpr
+ | liRJudgement
+ | liObj
+ | liStep
+]; liSimpl.
+
+Tactic Notation "liRStepUntil" open_constr(id) :=
+  repeat lazymatch goal with
+         | |- @environments.envs_entails _ _ ?P =>
+           lazymatch P with
+           | id _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ => fail
+           | id _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ => fail
+           | id _ _ _ _ _ _ _ _ _ _ _ _ _ _ => fail
+           | id _ _ _ _ _ _ _ _ _ _ _ _ _ => fail
+           | id _ _ _ _ _ _ _ _ _ _ _ _ => fail
+           | id _ _ _ _ _ _ _ _ _ _ _ => fail
+           | id _ _ _ _ _ _ _ _ _ _ => fail
+           | id _ _ _ _ _ _ _ _ _ => fail
+           | id _ _ _ _ _ _ _ _ => fail
+           | id _ _ _ _ _ _ _ => fail
+           | id _ _ _ _ _ _ => fail
+           | id _ _ _ _ _ => fail
+           | id _ _ _ _ => fail
+           | id _ _ => fail
+           | id _ => fail
+           | id => fail
+           | _  => liRStep
+           end
+         | _ => liRStep
+  end; liShow.
+
+
+(** * Tactics for starting a function *)
+Section coq_tactics.
+  Context {Σ : gFunctors}.
+
+  Lemma tac_split_big_sepM {K A} `{!EqDecision K} `{!Countable K} (m : gmap K A) i x Φ (P : iProp Σ):
+    m !! i = None →
+    (Φ i x -∗ ([∗ map] k↦x∈m, Φ k x) -∗ P) ⊢
+    ([∗ map] k↦x∈<[i := x]>m, Φ k x) -∗ P.
+  Proof.
+    move => Hin. rewrite big_sepM_insert //.
+    iIntros "HP [? Hm]". by iApply ("HP" with "[$]").
+  Qed.
+End coq_tactics.
+
+(* IMPORTANT: We need to make sure to never call simpl while the code
+(Q) is part of the goal, because simpl seems to take exponential time
+in the number of blocks! *)
+(* TODO: don't use i... tactics here *)
+(* FIXME for now the intropattern is just x for the entire array of arguments. *)
+(* was start_function in refinedc; name conflict with the floyd tactic *)
+Tactic Notation "type_function" constr(fnname) "(" simple_intropattern(x) ")" :=
+  intros;
+  repeat iIntros "#?";
+  rewrite /typed_function;
+  iIntros ( x );
+  (* computes the ofe_car in introduced arguments *)
+  match goal with | H: ofe_car _ |- _ => hnf in H; destruct H end;
+  iSplit; [iPureIntro; simpl; by [repeat constructor] || fail "in" fnname "argument types don't match layout of arguments" |];
+  let lsa := fresh "lsa" in let lsb := fresh "lsb" in
+  iIntros "!#" (lsa lsb); inv_vec lsb; inv_vec lsa;
+  iPureIntro;
+  iIntros "(?&?&?&?)";
+  cbn.
+
+Tactic Notation "prepare_parameters" "(" ident_list(i) ")" :=
+  revert i; repeat liForall.
+
+Ltac liRSplitBlocksIntro :=
+  repeat (
+      liEnsureInvariant;
+      first [
+          liSep
+        | liWand
+        | liImpl
+        | liForall
+        | liExist
+        | liUnfoldLetGoal]; liSimpl);
+        li_unfold_lets_in_context.
+(*
+(* TODO: don't use i... tactics here *)
+Ltac split_blocks Pfull Ps :=
+  (* cbn in *|- is important here to simplify the types of local
+  variables, otherwise unification gets confused later *)
+  cbn -[union] in * |-;
+  let rec pose_Ps Ps :=
+      lazymatch Ps with
+      | ?P::?m =>
+        let Hhint := fresh "Hhint" in
+        pose proof (I : P) as Hhint;
+        pose_Ps m
+      | nil => idtac
+      end
+  in
+  pose_Ps Ps;
+  let Hfull := fresh "Hfull" in
+  (* We must do this pose first since do_split_block_intro might call
+  subst and we want to subst in Ps as well. *)
+  pose (Hfull := Pfull);
+  liRSplitBlocksIntro;
+  liRIntroduceTypedStmt;
+  iApply (typed_block_rec Hfull); unfold Hfull; clear Hfull; last first; [|
+  repeat (iApply big_sepM_insert; [reflexivity|]; iSplitL); last by [iApply big_sepM_empty];
+  iExists _; (iSplitR; [iPureIntro; unfold_code_marker_and_compute_map_lookup|]); iModIntro ];
+  repeat (iApply tac_split_big_sepM; [reflexivity|]; iIntros "?"); iIntros "_".
+*)
+
+
+Section automation_tests.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  Opaque local locald_denote.
+
+   Set Ltac Backtrace.
+
+  Goal forall Espec ge f (_x:ident) (x:val),
+  <affine> (local $ locald_denote $ temp _x x)
+  ⊢ typed_stmt Espec ge (Sset _x (Ebinop Oadd (Econst_int (Int.repr 41) tint) (Econst_int (Int.repr 1) tint) tint)) f
+                           (λ v t, <affine> local (locald_denote (temp _x (Vint (Int.repr 42))))
+                                   ∗ ⎡ Vint (Int.repr 42) ◁ᵥ 42 @ int tint ⎤).
+  Proof.
+    iIntros.
+    repeat liRStep.
+    liShow; try done.
+  Qed.
+
+  Goal forall Espec ge f (_x:ident) b o (l:address) ty,
+  TCDone (ty_has_op_type ty tint MCNone) ->
+  ⊢ <affine> (local $ locald_denote $ lvar _x tint $ Vptr b o) -∗
+    ⎡ ty_own ty Own (b, Ptrofs.signed o) ⎤ -∗
+    typed_stmt Espec ge (Sassign (Evar _x tint) (Econst_int (Int.repr 1) tint)) f
+               (λ v t, ⎡ (b, Ptrofs.signed o) ◁ₗ Int.signed (Int.repr 1) @ int tint ⎤ ∗ True).
+  Proof.
+  iIntros.
+  liRStep.
+  liRStep.
+  liRStep.
+  (* usually Info level 0 is able to see the tactic applied *)
+  Info 0 liRStep. (* type_assign *)
+
+  Info 0 liRStep. (* type_Ecast_same_val *)
+  Info 0 liRStep. (* type_const_int *)
+  liRStep.
+  liRStep.
+  liRStep.
+  liRStep.
+  liRStep.
+  liRStep.
+  liRStep.
+  liRStep.
+  liRStep.
+  liRStep.
+  liRStep.
+  liRStep.
+
+  liRStep.
+  liRStep.
+  liRStep.
+  liRStep.
+
+  liRStep.
+  liRStep.
+Qed.
+End automation_tests.
+
+From VST.typing Require Import automation_test.
+
+Global Instance related_to_val_embed `{!typeG OK_ty Σ} {cs : compspecs} A v ty : RelatedTo (λ x : A, (⎡v ◁ᵥ ty x⎤:(monPredI environ_index (ouPredI (iResUR Σ)))))%I | 100
+:= {| rt_fic := FindVal v |}.
+Global Instance related_to_val_embed2 `{!typeG OK_ty Σ} {cs : compspecs} A v ty : RelatedTo (λ x : A, (⎡v ◁ᵥ ty⎤:(monPredI environ_index (ouPredI (iResUR Σ)))))%I | 100
+:= {| rt_fic := FindVal v |}.
+
+Arguments find_in_context : simpl never.
+Arguments subsume : simpl never.
+Arguments FindVal  : simpl never.
+Arguments local : simpl never.
+Arguments locald_denote : simpl never.
+
+Lemma simple_subsume_val_to_subsume_embed `{!typeG OK_ty Σ} `{compspecs} (A:Type) (v : val) (ty1 : type) (ty2 : A → type) (P:A->mpred)
+  `{!∀ (x:A), SimpleSubsumeVal ty1 (ty2 x) (P x)} (T: A-> assert) :
+   (∃ x, (@embed mpred assert _ $ P x) ∗ T x) ⊢@{assert} subsume (⎡v ◁ᵥ ty1⎤) (λ x : A, ⎡v ◁ᵥ ty2 x⎤) T.
+Proof.
+  iIntros "H".
+  iDestruct "H" as (x) "[HP HT]".
+  unfold subsume. iIntros. iExists x. iFrame.
+  iStopProof; go_lowerx.
+  iIntros "[HP Hv]".
+  iApply (@simple_subsume_val with "HP Hv").
+Qed.
+
+Definition simple_subsume_val_to_subsume_embed_inst `{!typeG OK_ty Σ} `{compspecs} := [instance simple_subsume_val_to_subsume_embed].
+Global Existing Instance simple_subsume_val_to_subsume_embed_inst.
+
+  Module f_test1.
+  Section f_test1.
+    Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+    Definition spec_f_ret_expr :=
+      fn(∀ () : (); emp) → ∃ z : Z, (z @ ( int tint )); ⌜z = 3⌝.
+    Local Instance CompSpecs : compspecs. make_compspecs prog. Defined.
+    Local Definition Vprog : varspecs. mk_varspecs prog. Defined.
+
+    Goal forall Espec ge, ⊢ typed_function(A := ConstType _) Espec ge f_f_ret_expr spec_f_ret_expr.
+    Proof.
+      type_function "f_ret_expr" ( x ).
+      repeat liRStep.
+    Qed.
+  End f_test1.
+  End f_test1.
+
+  Module f_test2.
+  Section f_test2.
+    Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+    Definition spec_f_temps :=
+      fn(∀ () : (); emp) → ∃ z : Z, (z @ (int tint)) ; ⌜z=42⌝.
+
+    Local Instance CompSpecs : compspecs. make_compspecs prog. Defined.
+    Local Definition Vprog : varspecs. mk_varspecs prog. Defined.
+
+    Goal forall Espec ge, ⊢ typed_function(A := ConstType _) Espec ge f_f_temps spec_f_temps.
+    Proof.
+      type_function "f_ret_expr" ( x ).
+      repeat liRStep.
+  Qed.
+
+  End f_test2.
+  End f_test2.
diff --git a/refinedVST/typing/automation/dune b/refinedVST/typing/automation/dune
new file mode 100644
index 0000000000..657d88d7cc
--- /dev/null
+++ b/refinedVST/typing/automation/dune
@@ -0,0 +1,8 @@
+(coq.theory
+ (name refinedc.typing.automation)
+ (package refinedc)
+ (flags :standard -w -notation-overridden -w -redundant-canonical-projection)
+ (synopsis "Lithium")
+ (theories caesium refinedc.typing
+    lithium ; removed by make prepare-install-refinedc
+  ))
diff --git a/refinedVST/typing/automation/enable_debug.v b/refinedVST/typing/automation/enable_debug.v
new file mode 100644
index 0000000000..bba1443402
--- /dev/null
+++ b/refinedVST/typing/automation/enable_debug.v
@@ -0,0 +1,86 @@
+From lithium Require Import hooks.
+From refinedc.typing Require Import typing.
+
+Ltac sidecond_hook ::= match goal with |- _ => idtac "SIDECOND" end.
+Ltac unsolved_sidecond_hook := match goal with |- _ => idtac "UNSOLVEDSIDECOND" end.
+Ltac unfold_instantiated_evar_hook H ::= idtac "EVAR".
+
+Ltac select_smaller_option o1 o2 H1 H2 cont :=
+  match o1 with
+  | None => cont o2 H2
+  | Some ?n1 =>
+    match o2 with
+    | None => cont o1 H1
+    | Some ?n2 =>
+      first [
+          assert_succeeds (assert (n1 ≤ n2)%N as _ by lia);
+          cont o1 H1
+        |
+        cont o2 H2
+        ]
+    end
+  end.
+
+Ltac liExtensible_hook ::=
+  let unfold_instance G := G in
+      (* eval unfold typed_un_op_val, subsume_place, simplify_goal_place, simplify_hyp_place, simplify_goal_val, simplify_hyp_val, subsume_val, subsume_place, typed_bin_op_val in G in *)
+  let rec get_head e :=
+  match e with
+  | ?h _ => get_head constr:(h)
+  | _    => constr:(e)
+  end in
+  match goal with
+  | |- environments.envs_entails _ (i2p_P ?G) =>
+    (* No idea why this is necessary here. *)
+    let G := unfold_instance G in
+    lazymatch G with
+    | @subsume_simplify_inst _ _ _ ?o1 ?o2 ?H1 ?H2 _ _ =>
+      select_smaller_option o1 o2 H1 H2 ltac:(fun _ used =>
+      let used := unfold_instance used in
+      let used := get_head used in
+      idtac "EXTENSIBLE" used)
+    (* | @simple_subsume_place_to_subsume_inst _ _ _ _ _ _ _ ?used _ => *)
+    (*   let used := unfold_instance used in *)
+    (*   let used := get_head used in *)
+    (*   idtac "EXTENSIBLE" used *)
+    | @typed_binop_simplify_inst _ _ _ _ _ _ ?o1 ?o2 _ _ ?H1 ?H2 _ _ _ =>
+      select_smaller_option o1 o2 H1 H2 ltac:(fun _ used =>
+      let used := unfold_instance used in
+      let used := get_head used in
+      idtac "EXTENSIBLE" used)
+    | @typed_unop_simplify_inst _ _ _ _ _ _ ?used _ _ =>
+      let used := unfold_instance used in
+      let used := get_head used in
+      idtac "EXTENSIBLE" used
+    | @typed_place_simpl_inst _ _ _ _ _ _ _ ?used _ =>
+      let used := unfold_instance used in
+      let used := get_head used in
+      idtac "EXTENSIBLE" used
+    | @typed_write_end_simpl_inst _ _ _ _ _ _ _ _ _ _ ?used _ =>
+      let used := unfold_instance used in
+      let used := get_head used in
+      idtac "EXTENSIBLE" used
+    | @typed_read_end_simpl_inst _ _ _ _ _ _ _ _ ?used _ =>
+      let used := unfold_instance used in
+      let used := get_head used in
+      idtac "EXTENSIBLE" used
+    | @typed_annot_expr_simplify_inst _ _ _ _ _ _ _ _ ?used _ =>
+      let used := unfold_instance used in
+      let used := get_head used in
+      idtac "EXTENSIBLE" used
+    | @typed_annot_stmt_simplify_inst _ _ _ _ _ _ _ ?used _ =>
+      let used := unfold_instance used in
+      let used := get_head used in
+      idtac "EXTENSIBLE" used
+    | @typed_cas_simplify_inst _ _ _ _ _ _ _ _ _ ?o1 ?o2 ?o3 ?H1 ?H2 ?H3 _ _ =>
+      select_smaller_option o1 o2 H1 H2 ltac:(fun o' H' =>
+      select_smaller_option o' o3 H' H3 ltac:(fun _ used =>
+      let used := unfold_instance used in
+      let used := get_head used in
+      idtac "EXTENSIBLE" used))
+    | _ =>
+      let G := unfold_instance G in
+      let G := get_head G in
+      idtac "EXTENSIBLE" G
+    end
+  end.
diff --git a/refinedVST/typing/automation/loc_eq.v b/refinedVST/typing/automation/loc_eq.v
new file mode 100644
index 0000000000..ea99fed05b
--- /dev/null
+++ b/refinedVST/typing/automation/loc_eq.v
@@ -0,0 +1,123 @@
+From lithium Require Import definitions.
+From caesium Require Import base lang.
+From refinedc.typing Require Import programs.
+
+(** This file contains a solver for location (semantic) equality based on [lia]
+and an [autorewrite] hint database [refinedc_loc_eq_rewrite] that the user can
+extend with more rewriting rules. *)
+
+(** * Hint database *)
+
+Create HintDb refinedc_loc_eq_rewrite discriminated.
+
+(** Rules to inject [nat] operations in to [Z]. *)
+#[export] Hint Rewrite Nat2Z.inj_mul : refinedc_loc_eq_rewrite.
+#[export] Hint Rewrite Nat2Z.inj_add : refinedc_loc_eq_rewrite.
+#[export] Hint Rewrite Nat2Z.inj_sub using lia : refinedc_loc_eq_rewrite.
+#[export] Hint Rewrite Z2Nat.id using lia : refinedc_loc_eq_rewrite.
+
+(** Rule to eliminate [Z.shiftl]. *)
+#[export] Hint Rewrite Z.shiftl_mul_pow2 using lia : refinedc_loc_eq_rewrite.
+
+(** * Tactics *)
+
+Lemma eq_loc (l1 l2 : loc): l1.1 = l2.1 → l1.2 = l2.2 → l1 = l2.
+Proof. destruct l1, l2 => /= -> -> //. Qed.
+
+(** Turns an equality over locations into an equality over physical addresses
+(in type [Z]) that has been simplified with [autorewrite]. This tactics only
+succeeds if the compared locations have convertible allocation ids. *)
+Ltac prepare_loc_eq :=
+  (* Sanity check on the goal. *)
+  lazymatch goal with
+  | |- @eq val (val_of_loc _) (val_of_loc _) => f_equal
+  | |- @eq ?A _ _ => unify A loc
+  | |- @eq _ _ _  => fail "[simpl_loc_eq]: goal not an equality between locations"
+  | |- _          => fail "[simpl_loc_eq]: goal not an equality"
+  end;
+  (* Remove all [offset_loc] and [shift_loc]. *)
+  rewrite ?/offset_loc ?shift_loc_assoc; rewrite ?/shift_loc;
+  (* Checking that both sides have the same [alloc_id]. *)
+  notypeclasses refine (eq_loc _ _ _ _); [ reflexivity | simpl ];
+  (* Unfold [addr] (useful if we use [ring]) and rewrite with the hints. *)
+  unfold addr in *; autorewrite with refinedc_loc_eq_rewrite.
+
+(** Solver for location equality. *)
+Ltac solve_loc_eq :=
+  (* We try [reflexivity] first since it very often suffices. *)
+  first [ reflexivity | prepare_loc_eq; lia ].
+
+Inductive FICLocSemantic : Set :=.
+Definition find_in_context_type_loc_semantic_inst :=
+  [instance @find_in_context_type_loc_id with FICLocSemantic].
+Global Existing Instance find_in_context_type_loc_semantic_inst | 20.
+Definition find_in_context_type_val_P_loc_semantic_inst :=
+  [instance @find_in_context_type_val_P_loc_id with FICLocSemantic].
+Global Existing Instance find_in_context_type_val_P_loc_semantic_inst | 20.
+Definition find_in_context_loc_in_bounds_semantic_inst :=
+  [instance @find_in_context_loc_in_bounds with FICLocSemantic].
+Global Existing Instance find_in_context_loc_in_bounds_semantic_inst | 20.
+Definition find_in_context_loc_in_bounds_type_semantic_inst :=
+  [instance @find_in_context_loc_in_bounds_loc with FICLocSemantic].
+Global Existing Instance find_in_context_loc_in_bounds_type_semantic_inst | 30.
+
+Lemma tac_solve_loc_eq `{!typeG Σ} l1 β1 ty1 l2 β2 ty2:
+  l1 = l2 →
+  FindHypEqual FICLocSemantic (l1 ◁ₗ{β1} ty1) (l2 ◁ₗ{β2} ty2) (l1 ◁ₗ{β2} ty2).
+Proof. by move => ->. Qed.
+
+Global Hint Extern 10 (FindHypEqual FICLocSemantic (_ ◁ₗ{_} _) (_ ◁ₗ{_} _) _) =>
+  (notypeclasses refine (tac_solve_loc_eq _ _ _ _ _ _ _); solve_loc_eq) : typeclass_instances.
+
+Lemma tac_loc_in_bounds_solve_loc_eq `{!typeG Σ} l1 l2 n1 n2:
+  l1 = l2 →
+  FindHypEqual FICLocSemantic (loc_in_bounds l1 n1) (loc_in_bounds l2 n2) (loc_in_bounds l1 n2).
+Proof. by move => ->. Qed.
+
+Global Hint Extern 10 (FindHypEqual FICLocSemantic (loc_in_bounds _ _) (loc_in_bounds _ _) _) =>
+  (notypeclasses refine (tac_loc_in_bounds_solve_loc_eq _ _ _ _ _); solve_loc_eq) : typeclass_instances.
+
+Section test.
+  Context (l : loc).
+  Context (id : prov).
+  Context (a : addr).
+  Context (n n1 n2 n3 : Z).
+  Context (i j : nat).
+  Context (PAGE_SIZE : Z := 4096).
+
+  Goal (l = l)%Z.
+  solve_loc_eq. Qed.
+
+  Goal (@eq loc (id, a) (id, a))%Z.
+  solve_loc_eq. Qed.
+
+  Goal ((l.1, l.2) = l)%Z.
+  solve_loc_eq. Qed.
+
+  Goal ((l.1, l.2 + n)%Z = l +ₗ n)%Z.
+  solve_loc_eq. Qed.
+
+  Goal ((l +ₗ n1 +ₗ n2) = (l +ₗ (n1 + n2)))%Z.
+  solve_loc_eq. Qed.
+
+  Goal ((l +ₗ 0%nat * n) = l)%Z.
+  solve_loc_eq. Qed.
+
+  Goal ((id, a + n1 + n2) = (id, a + (n1 + n2)))%Z.
+  solve_loc_eq. Qed.
+
+  Goal ((l +ₗ (n + (i + j)%nat)) = (l +ₗ (n + i + j)))%Z.
+  solve_loc_eq. Qed.
+
+  Goal ((l +ₗ (n * PAGE_SIZE + i ≪ 12)) = (l +ₗ (n + i) * PAGE_SIZE))%Z.
+  solve_loc_eq. Qed.
+
+  Goal ((l +ₗ (n1 + 0%nat) * n2) = (l +ₗ (n1 * n2)))%Z.
+  solve_loc_eq. Qed.
+
+  Goal ((l +ₗ (n1 + (i + j)%nat) * n2) = (l +ₗ (n1 + i + j) * n2))%Z.
+  solve_loc_eq. Qed.
+
+  Goal (l = (l.1, l.2 * 1))%Z.
+  solve_loc_eq. Qed.
+End test.
diff --git a/refinedVST/typing/automation/normalize.v b/refinedVST/typing/automation/normalize.v
new file mode 100644
index 0000000000..b67e00bf4f
--- /dev/null
+++ b/refinedVST/typing/automation/normalize.v
@@ -0,0 +1,11 @@
+From lithium Require Export normalize.
+From refinedc.typing Require Import type.
+
+#[export] Hint Rewrite ly_align_ly_with_align ly_align_ly_offset ly_align_ly_set_size : lithium_rewrite.
+#[export] Hint Rewrite ly_size_ly_set_size ly_size_ly_with_align : lithium_rewrite.
+
+(* The following lemma is a problem with Keyed Unification as it
+unfolds e.g. layout_of *)
+(* Lemma ly_size_of_mk_layout n : ly_size (mk_layout n) = n. *)
+(* Proof. done. Qed. *)
+(* Hint Rewrite ly_size_of_mk_layout : lithium_rewrite. *)
diff --git a/refinedVST/typing/automation/proof_state.v b/refinedVST/typing/automation/proof_state.v
new file mode 100644
index 0000000000..7c17c5d620
--- /dev/null
+++ b/refinedVST/typing/automation/proof_state.v
@@ -0,0 +1,213 @@
+From VST.lithium Require Import all.
+From lithium Require Import hooks. 
+From VST.typing Require Import type globals.
+(* From VST.lithium.automation Require Import solvers. *)
+
+
+
+(** Ke: use empty location_info for now; I guess it is for error messages like `proof failed in file x line y` *)
+Definition location_info : Type := Empty_set.
+
+(** * Markers for keeping track of the proof state *)
+Definition CURRENT_LOCATION (i : list location_info) (up_to_date : bool) : Set := unit.
+Arguments CURRENT_LOCATION : simpl never.
+Definition CASE_DISTINCTION_INFO {B} (info : B) (i : list location_info) : Set := unit.
+Arguments CASE_DISTINCTION_INFO : simpl never.
+
+Definition pop_location_info {A} (i : location_info) (a : A) : A := a.
+Arguments pop_location_info : simpl never.
+Global Typeclasses Opaque pop_location_info.
+
+Inductive BLOCK_PRECOND_HINT := | BLOCK_PRECOND (bid : label).
+Inductive ASSERT_COND_HINT := | ASSERT_COND (id : string).
+
+(* The `{!typeG Σ} is necessary to infer Σ if P is True. *)
+Definition IPROP_HINT `{!typeG OK_ty Σ} {A B} (a : A) (P : B → iProp Σ) : Prop := True.
+Arguments IPROP_HINT : simpl never.
+
+Notation "'block' bid : P" := (IPROP_HINT (BLOCK_PRECOND bid) (λ _ : unit, P)) (at level 200, only printing).
+Notation "'assert' id : P" := (IPROP_HINT (ASSERT_COND id) P) (at level 200, only printing).
+
+Definition CODE_MARKER (bs : gmap label statement) : gmap label statement := bs.
+Notation "'HIDDEN'" := (CODE_MARKER _) (only printing).
+Arguments CODE_MARKER : simpl never.
+Ltac unfold_code_marker_and_compute_map_lookup :=
+  unfold CODE_MARKER in *; solvers.compute_map_lookup.
+
+Definition RETURN_MARKER `{!typeG OK_ty Σ} {cs:compspecs} (R : val → type → iProp Σ) : val → type → iProp Σ := R.
+Notation "'HIDDEN'" := (RETURN_MARKER _) (only printing).
+
+
+(** * Tactics for manipulating location information *)
+Ltac get_loc_info cont :=
+  first [ lazymatch reverse goal with
+          | H : CURRENT_LOCATION ?icur _ |- _ => cont icur
+          end | cont constr:(@nil location_info)
+        ].
+
+Ltac update_loc_info i :=
+  first [
+      lazymatch reverse goal with
+      | H : CURRENT_LOCATION ?icur _ |- _ =>
+        lazymatch i with
+        | Some ?i2 =>
+          change (CURRENT_LOCATION _ _) with (CURRENT_LOCATION [i2] true) in H
+        (* Push *)
+        | [ ?i2 ] =>
+          change (CURRENT_LOCATION _ _) with (CURRENT_LOCATION (i2 :: icur) true) in H
+        (* Pop *)
+        | [ ?i2; _ ] =>
+          lazymatch icur with
+          | i2 :: ?iprevh :: ?iprevt =>
+            change (CURRENT_LOCATION _ _) with (CURRENT_LOCATION (iprevh :: iprevt) true) in H
+          | [i2] =>
+            change (CURRENT_LOCATION _ _) with (CURRENT_LOCATION ([i2]) false) in H
+          | _ =>
+            (* mismatched pop *)
+            change (CURRENT_LOCATION _ _) with (CURRENT_LOCATION ([i2]) false) in H
+          end
+        | None =>
+          change (CURRENT_LOCATION _ _) with (CURRENT_LOCATION icur false) in H
+        end
+      end
+    |
+    (* TODO: unify the first two branches *)
+    lazymatch i with
+    | Some ?i2 =>
+      let Hcur := fresh "HCURLOC" in
+      have Hcur := (() : CURRENT_LOCATION [i2] true)
+    | [?i2] =>
+      let Hcur := fresh "HCURLOC" in
+      have Hcur := (() : CURRENT_LOCATION [i2] true)
+    | None => idtac
+    end
+    ].
+
+Ltac add_case_distinction_info info :=
+    get_loc_info ltac:(fun icur =>
+    let Hcase := fresh "HCASE" in
+    have Hcase := (() : (CASE_DISTINCTION_INFO info icur))).
+
+(** * Tactics cleaning the proof state *)
+Ltac clear_unused_vars :=
+  repeat match goal with
+         | H : ?T |- _ =>
+           (* Keep current location and case distinction info. *)
+           lazymatch T with
+           | CURRENT_LOCATION _ _ => fail
+           | CASE_DISTINCTION_INFO _ _ => fail
+           | _ => idtac
+           end;
+           let ty := (type of T) in
+           match ty with | Type => clear H | Set => clear H end
+         end.
+
+Ltac prepare_sideconditions :=
+  li_unfold_lets_in_context;
+  repeat match goal with | H : IPROP_HINT _ _ |- _ => clear H end;
+  (* get rid of Q *)
+  repeat match goal with | H := CODE_MARKER _ |- _ => clear H end;
+  repeat match goal with | H := RETURN_MARKER _ |- _ => clear H end;
+  clear_unused_vars.
+
+Ltac solve_goal_prepare_hook ::=
+  prepare_sideconditions;
+  repeat match goal with | H : CASE_DISTINCTION_INFO _ _ |- _ => clear H end.
+
+(** * Tactics for showing failures to the user *)
+
+(** FIXME 
+Ltac print_current_location :=
+  try lazymatch reverse goal with
+      | H : CURRENT_LOCATION ?l ?up_to_date |- _ =>
+        let rec print_loc_info l :=
+            match l with
+            | ?i :: ?l =>
+              lazymatch eval unfold i in i with
+              | LocationInfo ?f ?ls ?cs ?le ?ce =>
+                let f := eval unfold f in f in
+                idtac "Location:" f "[" ls ":" cs "-" le ":" ce "]";
+                print_loc_info l
+              end
+            | [] => idtac "up to date:" up_to_date
+            end in
+        print_loc_info l;
+        clear H
+      end.
+*)
+
+Ltac print_case_distinction_info :=
+   repeat lazymatch reverse goal with
+          | H : CASE_DISTINCTION_INFO ?i ?l |- _ =>
+            lazymatch i with
+            | (?a, ?b) => idtac "Case distinction" a "->" b
+            | ?a => idtac "Case distinction" a
+            end;
+            (** FIXME
+            lazymatch l with
+            | ?i :: ?l =>
+              lazymatch eval unfold i in i with
+              | LocationInfo ?f ?ls ?cs ?le ?ce =>
+                let f := eval unfold f in f in
+                idtac "at" f "[" ls ":" cs "-" le ":" ce "]"
+              end
+            | [] => idtac 
+            end; *)
+            clear H
+          end.
+
+Ltac print_coq_hyps :=
+  try match reverse goal with
+  | H : ?X |- _ =>
+    lazymatch X with
+    | IPROP_HINT _ _ => fail
+    | gFunctors => fail
+    | typeG _ _ => fail
+    | globalG _ => fail
+    | _ => idtac H ":" X; fail
+    end
+  end.
+
+Ltac print_goal :=
+  (* FIXME print_current_location; *)
+  print_case_distinction_info;
+  idtac "Goal:";
+  print_coq_hyps;
+  idtac "---------------------------------------";
+  match goal with
+  | |- ?G => idtac G
+  end;
+  idtac "";
+  idtac "".
+
+Ltac print_typesystem_goal fn block :=
+  lazymatch goal with
+  (* TODO: Is something like the following useful? *)
+  (* | |- ?P ∧ ?Q => *)
+  (*   idtac "Cannot instantiate evar in" fn "in block" block "!"; *)
+  (*   print_current_location; *)
+  (*   print_case_distinction_info; *)
+  (*   idtac "Goal:"; *)
+  (*   print_coq_hyps; *)
+  (*   idtac "---------------------------------------"; *)
+  (*   idtac P; *)
+  (*   (* TODO: Should we print the continuation? It might confuse the user and *)
+  (*      it usually is not helpful. *) *)
+  (*   (* idtac ""; *) *)
+  (*   (* idtac "Continuation:"; *) *)
+  (*   (* idtac Q; *) *)
+  (*   idtac ""; *)
+  (*   idtac ""; *)
+  (*   admit *)
+  | |- _ =>
+    idtac "Type system got stuck in function" fn "in block" block "!";
+    print_goal; admit
+  end.
+
+Ltac print_sidecondition_goal fn :=
+  idtac "Cannot solve side condition in function" fn "!";
+  print_goal; admit.
+
+Ltac print_remaining_shelved_goal fn :=
+  idtac "Shelved goal remaining in " fn "!";
+  print_goal; admit.
diff --git a/refinedVST/typing/automation/simplification.v b/refinedVST/typing/automation/simplification.v
new file mode 100644
index 0000000000..1acfb4f37a
--- /dev/null
+++ b/refinedVST/typing/automation/simplification.v
@@ -0,0 +1,56 @@
+(** This file collects simplification instances specific to RefinedC *)
+From lithium Require Import simpl_classes.
+From refinedc.typing Require Import type.
+
+(** * int_type *)
+Global Instance simpl_it_elem_of (z : Z) (it : int_type) :
+  SimplBoth (z ∈ it) (min_int it ≤ z ∧ z ≤ max_int it).
+Proof. done. Qed.
+
+(** * layout *)
+Global Instance simpl_layout_eq ly1 ly2 : SimplAndRel (=) ly1 ly2 (ly1.(ly_size) = ly2.(ly_size) ∧ ly_align ly1 = ly_align ly2).
+Proof. split; rewrite -ly_align_log_ly_align_eq_iff; destruct ly1,ly2; naive_solver. Qed.
+
+Global Instance simpl_layout_leq ly1 ly2 : SimplBoth (ly1 ⊑ ly2) (ly1.(ly_size) ≤ ly2.(ly_size) ∧ ly_align ly1 ≤ ly_align ly2)%nat.
+Proof. split; rewrite /ly_align -Nat.pow_le_mono_r_iff //; lia. Qed.
+
+Global Instance ly_size_ly_offset_eq ly n m `{!CanSolve (n ≤ ly_size ly)%nat}:
+  SimplBothRel (=) (ly_size (ly_offset ly n)) m (ly_size ly = m + n)%nat.
+Proof. unfold CanSolve in *. rewrite {1}/ly_size/=. split; lia. Qed.
+
+Global Instance simpl_is_power_of_two_align ly :
+  SimplAnd (is_power_of_two (ly_align ly)) (True).
+Proof. split => ?; last naive_solver. by eexists _. Qed.
+
+(** * aligned_to *)
+Global Instance simpl_aligned_to_add1 l (n : nat) : SimplBoth ((l +ₗ n) `aligned_to` n) (l `aligned_to` n).
+Proof. rewrite -{1}(Z.mul_1_l n). apply aligned_to_add. Qed.
+Global Instance simpl_aligned_to_add l m (n : nat) : SimplBoth ((l +ₗ m * n) `aligned_to` n) (l `aligned_to` n).
+Proof. apply aligned_to_add. Qed.
+
+Global Instance simpl_learn_aligned_to_mult l o n1 n2
+  `{!CaesiumConfigEnforceAlignment} `{!CanSolve (l `aligned_to` n2)} `{!CanSolve (0 ≤ o)} :
+  SimplImplUnsafe false ((l +ₗ o) `aligned_to` (n1 * n2)) (∃ o' : nat, o = o' * n2) | 100.
+Proof.
+  unfold CanSolve in *. move => Halign.
+  odestruct (aligned_to_mult_eq l n1 n2 o) as [x ?] => //; subst.
+  eexists (Z.to_nat x). destruct x; lia.
+Qed.
+
+(** * location offset *)
+Global Instance simpl_offset_inj l1 l2 sl n : SimplBothRel (=) (l1 at{sl}ₗ n) (l2 at{sl}ₗ n) (l1 = l2).
+Proof. unfold GetMemberLoc. split; [apply shift_loc_inj1| naive_solver]. Qed.
+
+Global Instance simpl_shift_loc_eq l n : SimplBothRel (=) l (l +ₗ n) (n = 0).
+Proof. split; [by rewrite -{1}(shift_loc_0 l)=> /shift_loc_inj2 | move => ->; by rewrite shift_loc_0 ]. Qed.
+
+(** * NULL *)
+
+Global Instance simpl_to_NULL_val_of_loc (l : loc):
+  SimplAndRel (=) NULL (l) (l = NULL_loc).
+Proof. split; unfold NULL; naive_solver. Qed.
+
+(** * value representation *)
+Global Instance simpl_and_eq_val_of_loc l1 l2:
+  SimplAnd (val_of_loc l1 = val_of_loc l2) (l1 = l2).
+Proof. split; naive_solver. Qed.
diff --git a/refinedVST/typing/automation/solvers.v b/refinedVST/typing/automation/solvers.v
new file mode 100644
index 0000000000..b6f02f0d3a
--- /dev/null
+++ b/refinedVST/typing/automation/solvers.v
@@ -0,0 +1,30 @@
+From lithium Require Import hooks.
+From refinedc.typing Require Import type.
+(* Ke: TODO this one needs rework *)
+Ltac unfold_aligned_to :=
+  unfold aligned_to in *;
+  try rewrite ->caesium_config.enforce_alignment_value in *;
+  cbv [selected_config.enforce_alignment] in *.
+
+Ltac unfold_common_defs :=
+  unfold
+  (* Unfold [aligned_to] and [Z.divide] as lia can work with the underlying multiplication. *)
+    aligned_to, Z.divide,
+  (* Unfold [addr] since [lia] may get stuck due to [addr]/[Z] mismatches. *)
+    addr,
+  (* Layout *)
+    ly_size, ly_with_align, ly_align_log,
+  (* Integer bounds *)
+    max_int, min_int, int_half_modulus, int_modulus,
+    it_layout, bits_per_int, bytes_per_int,
+  (* Address bounds *)
+    max_alloc_end, min_alloc_start, bytes_per_addr,
+  (* Other byte-level definitions *)
+    bits_per_byte in *.
+
+(** * [solve_goal] without cleaning of the context  *)
+Ltac solve_goal_normalized_prepare_hook ::=
+  unfold_common_defs;
+  try rewrite ->caesium_config.enforce_alignment_value in *;
+  simpl in *;
+  rewrite /ly_size/ly_align_log //=.
diff --git a/refinedVST/typing/automation_test.c b/refinedVST/typing/automation_test.c
new file mode 100644
index 0000000000..0d82a2d066
--- /dev/null
+++ b/refinedVST/typing/automation_test.c
@@ -0,0 +1,11 @@
+int main() {
+}
+
+int f_ret_expr() {
+    return 1 + 2;
+}
+
+int f_temps() {
+    int a = 1;
+    return a + 41;
+}
\ No newline at end of file
diff --git a/refinedVST/typing/automation_test.v b/refinedVST/typing/automation_test.v
new file mode 100644
index 0000000000..ad90012b84
--- /dev/null
+++ b/refinedVST/typing/automation_test.v
@@ -0,0 +1,407 @@
+From Coq Require Import String List ZArith.
+From compcert Require Import Coqlib Integers Floats AST Ctypes Cop Clight Clightdefs.
+Import Clightdefs.ClightNotations.
+Local Open Scope Z_scope.
+Local Open Scope string_scope.
+Local Open Scope clight_scope.
+
+Module Info.
+  Definition version := "3.15".
+  Definition build_number := "".
+  Definition build_tag := "".
+  Definition build_branch := "".
+  Definition arch := "x86".
+  Definition model := "32sse2".
+  Definition abi := "standard".
+  Definition bitsize := 32.
+  Definition big_endian := false.
+  Definition source_file := "refinedVST/typing/automation_test.c".
+  Definition normalized := true.
+End Info.
+
+Definition ___builtin_ais_annot : ident := $"__builtin_ais_annot".
+Definition ___builtin_annot : ident := $"__builtin_annot".
+Definition ___builtin_annot_intval : ident := $"__builtin_annot_intval".
+Definition ___builtin_bswap : ident := $"__builtin_bswap".
+Definition ___builtin_bswap16 : ident := $"__builtin_bswap16".
+Definition ___builtin_bswap32 : ident := $"__builtin_bswap32".
+Definition ___builtin_bswap64 : ident := $"__builtin_bswap64".
+Definition ___builtin_clz : ident := $"__builtin_clz".
+Definition ___builtin_clzl : ident := $"__builtin_clzl".
+Definition ___builtin_clzll : ident := $"__builtin_clzll".
+Definition ___builtin_ctz : ident := $"__builtin_ctz".
+Definition ___builtin_ctzl : ident := $"__builtin_ctzl".
+Definition ___builtin_ctzll : ident := $"__builtin_ctzll".
+Definition ___builtin_debug : ident := $"__builtin_debug".
+Definition ___builtin_expect : ident := $"__builtin_expect".
+Definition ___builtin_fabs : ident := $"__builtin_fabs".
+Definition ___builtin_fabsf : ident := $"__builtin_fabsf".
+Definition ___builtin_fmadd : ident := $"__builtin_fmadd".
+Definition ___builtin_fmax : ident := $"__builtin_fmax".
+Definition ___builtin_fmin : ident := $"__builtin_fmin".
+Definition ___builtin_fmsub : ident := $"__builtin_fmsub".
+Definition ___builtin_fnmadd : ident := $"__builtin_fnmadd".
+Definition ___builtin_fnmsub : ident := $"__builtin_fnmsub".
+Definition ___builtin_fsqrt : ident := $"__builtin_fsqrt".
+Definition ___builtin_membar : ident := $"__builtin_membar".
+Definition ___builtin_memcpy_aligned : ident := $"__builtin_memcpy_aligned".
+Definition ___builtin_read16_reversed : ident := $"__builtin_read16_reversed".
+Definition ___builtin_read32_reversed : ident := $"__builtin_read32_reversed".
+Definition ___builtin_sel : ident := $"__builtin_sel".
+Definition ___builtin_sqrt : ident := $"__builtin_sqrt".
+Definition ___builtin_unreachable : ident := $"__builtin_unreachable".
+Definition ___builtin_va_arg : ident := $"__builtin_va_arg".
+Definition ___builtin_va_copy : ident := $"__builtin_va_copy".
+Definition ___builtin_va_end : ident := $"__builtin_va_end".
+Definition ___builtin_va_start : ident := $"__builtin_va_start".
+Definition ___builtin_write16_reversed : ident := $"__builtin_write16_reversed".
+Definition ___builtin_write32_reversed : ident := $"__builtin_write32_reversed".
+Definition ___compcert_i64_dtos : ident := $"__compcert_i64_dtos".
+Definition ___compcert_i64_dtou : ident := $"__compcert_i64_dtou".
+Definition ___compcert_i64_sar : ident := $"__compcert_i64_sar".
+Definition ___compcert_i64_sdiv : ident := $"__compcert_i64_sdiv".
+Definition ___compcert_i64_shl : ident := $"__compcert_i64_shl".
+Definition ___compcert_i64_shr : ident := $"__compcert_i64_shr".
+Definition ___compcert_i64_smod : ident := $"__compcert_i64_smod".
+Definition ___compcert_i64_smulh : ident := $"__compcert_i64_smulh".
+Definition ___compcert_i64_stod : ident := $"__compcert_i64_stod".
+Definition ___compcert_i64_stof : ident := $"__compcert_i64_stof".
+Definition ___compcert_i64_udiv : ident := $"__compcert_i64_udiv".
+Definition ___compcert_i64_umod : ident := $"__compcert_i64_umod".
+Definition ___compcert_i64_umulh : ident := $"__compcert_i64_umulh".
+Definition ___compcert_i64_utod : ident := $"__compcert_i64_utod".
+Definition ___compcert_i64_utof : ident := $"__compcert_i64_utof".
+Definition ___compcert_va_composite : ident := $"__compcert_va_composite".
+Definition ___compcert_va_float64 : ident := $"__compcert_va_float64".
+Definition ___compcert_va_int32 : ident := $"__compcert_va_int32".
+Definition ___compcert_va_int64 : ident := $"__compcert_va_int64".
+Definition _a : ident := $"a".
+Definition _f_ret_expr : ident := $"f_ret_expr".
+Definition _f_temps : ident := $"f_temps".
+Definition _main : ident := $"main".
+
+Definition f_main := {|
+  fn_return := tint;
+  fn_callconv := cc_default;
+  fn_params := nil;
+  fn_vars := nil;
+  fn_temps := nil;
+  fn_body :=
+(Sreturn (Some (Econst_int (Int.repr 0) tint)))
+|}.
+
+Definition f_f_ret_expr := {|
+  fn_return := tint;
+  fn_callconv := cc_default;
+  fn_params := nil;
+  fn_vars := nil;
+  fn_temps := nil;
+  fn_body :=
+(Sreturn (Some (Ebinop Oadd (Econst_int (Int.repr 1) tint)
+                 (Econst_int (Int.repr 2) tint) tint)))
+|}.
+
+Definition f_f_temps := {|
+  fn_return := tint;
+  fn_callconv := cc_default;
+  fn_params := nil;
+  fn_vars := nil;
+  fn_temps := ((_a, tint) :: nil);
+  fn_body :=
+(Ssequence
+  (Sset _a (Econst_int (Int.repr 1) tint))
+  (Sreturn (Some (Ebinop Oadd (Etempvar _a tint)
+                   (Econst_int (Int.repr 41) tint) tint))))
+|}.
+
+Definition composites : list composite_definition :=
+nil.
+
+Definition global_definitions : list (ident * globdef fundef type) :=
+((___compcert_va_int32,
+   Gfun(External (EF_runtime "__compcert_va_int32"
+                   (mksignature (AST.Xptr :: nil) AST.Xint cc_default))
+     ((tptr tvoid) :: nil) tuint cc_default)) ::
+ (___compcert_va_int64,
+   Gfun(External (EF_runtime "__compcert_va_int64"
+                   (mksignature (AST.Xptr :: nil) AST.Xlong cc_default))
+     ((tptr tvoid) :: nil) tulong cc_default)) ::
+ (___compcert_va_float64,
+   Gfun(External (EF_runtime "__compcert_va_float64"
+                   (mksignature (AST.Xptr :: nil) AST.Xfloat cc_default))
+     ((tptr tvoid) :: nil) tdouble cc_default)) ::
+ (___compcert_va_composite,
+   Gfun(External (EF_runtime "__compcert_va_composite"
+                   (mksignature (AST.Xptr :: AST.Xint :: nil) AST.Xptr
+                     cc_default)) ((tptr tvoid) :: tuint :: nil) (tptr tvoid)
+     cc_default)) ::
+ (___compcert_i64_dtos,
+   Gfun(External (EF_runtime "__compcert_i64_dtos"
+                   (mksignature (AST.Xfloat :: nil) AST.Xlong cc_default))
+     (tdouble :: nil) tlong cc_default)) ::
+ (___compcert_i64_dtou,
+   Gfun(External (EF_runtime "__compcert_i64_dtou"
+                   (mksignature (AST.Xfloat :: nil) AST.Xlong cc_default))
+     (tdouble :: nil) tulong cc_default)) ::
+ (___compcert_i64_stod,
+   Gfun(External (EF_runtime "__compcert_i64_stod"
+                   (mksignature (AST.Xlong :: nil) AST.Xfloat cc_default))
+     (tlong :: nil) tdouble cc_default)) ::
+ (___compcert_i64_utod,
+   Gfun(External (EF_runtime "__compcert_i64_utod"
+                   (mksignature (AST.Xlong :: nil) AST.Xfloat cc_default))
+     (tulong :: nil) tdouble cc_default)) ::
+ (___compcert_i64_stof,
+   Gfun(External (EF_runtime "__compcert_i64_stof"
+                   (mksignature (AST.Xlong :: nil) AST.Xsingle cc_default))
+     (tlong :: nil) tfloat cc_default)) ::
+ (___compcert_i64_utof,
+   Gfun(External (EF_runtime "__compcert_i64_utof"
+                   (mksignature (AST.Xlong :: nil) AST.Xsingle cc_default))
+     (tulong :: nil) tfloat cc_default)) ::
+ (___compcert_i64_sdiv,
+   Gfun(External (EF_runtime "__compcert_i64_sdiv"
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tlong :: tlong :: nil) tlong cc_default)) ::
+ (___compcert_i64_udiv,
+   Gfun(External (EF_runtime "__compcert_i64_udiv"
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tulong :: tulong :: nil) tulong
+     cc_default)) ::
+ (___compcert_i64_smod,
+   Gfun(External (EF_runtime "__compcert_i64_smod"
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tlong :: tlong :: nil) tlong cc_default)) ::
+ (___compcert_i64_umod,
+   Gfun(External (EF_runtime "__compcert_i64_umod"
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tulong :: tulong :: nil) tulong
+     cc_default)) ::
+ (___compcert_i64_shl,
+   Gfun(External (EF_runtime "__compcert_i64_shl"
+                   (mksignature (AST.Xlong :: AST.Xint :: nil) AST.Xlong
+                     cc_default)) (tlong :: tint :: nil) tlong cc_default)) ::
+ (___compcert_i64_shr,
+   Gfun(External (EF_runtime "__compcert_i64_shr"
+                   (mksignature (AST.Xlong :: AST.Xint :: nil) AST.Xlong
+                     cc_default)) (tulong :: tint :: nil) tulong cc_default)) ::
+ (___compcert_i64_sar,
+   Gfun(External (EF_runtime "__compcert_i64_sar"
+                   (mksignature (AST.Xlong :: AST.Xint :: nil) AST.Xlong
+                     cc_default)) (tlong :: tint :: nil) tlong cc_default)) ::
+ (___compcert_i64_smulh,
+   Gfun(External (EF_runtime "__compcert_i64_smulh"
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tlong :: tlong :: nil) tlong cc_default)) ::
+ (___compcert_i64_umulh,
+   Gfun(External (EF_runtime "__compcert_i64_umulh"
+                   (mksignature (AST.Xlong :: AST.Xlong :: nil) AST.Xlong
+                     cc_default)) (tulong :: tulong :: nil) tulong
+     cc_default)) ::
+ (___builtin_ais_annot,
+   Gfun(External (EF_builtin "__builtin_ais_annot"
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid
+                     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
+     ((tptr tschar) :: nil) tvoid
+     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
+ (___builtin_bswap64,
+   Gfun(External (EF_builtin "__builtin_bswap64"
+                   (mksignature (AST.Xlong :: nil) AST.Xlong cc_default))
+     (tulong :: nil) tulong cc_default)) ::
+ (___builtin_bswap,
+   Gfun(External (EF_builtin "__builtin_bswap"
+                   (mksignature (AST.Xint :: nil) AST.Xint cc_default))
+     (tuint :: nil) tuint cc_default)) ::
+ (___builtin_bswap32,
+   Gfun(External (EF_builtin "__builtin_bswap32"
+                   (mksignature (AST.Xint :: nil) AST.Xint cc_default))
+     (tuint :: nil) tuint cc_default)) ::
+ (___builtin_bswap16,
+   Gfun(External (EF_builtin "__builtin_bswap16"
+                   (mksignature (AST.Xint16unsigned :: nil)
+                     AST.Xint16unsigned cc_default)) (tushort :: nil) tushort
+     cc_default)) ::
+ (___builtin_clz,
+   Gfun(External (EF_builtin "__builtin_clz"
+                   (mksignature (AST.Xint :: nil) AST.Xint cc_default))
+     (tuint :: nil) tint cc_default)) ::
+ (___builtin_clzl,
+   Gfun(External (EF_builtin "__builtin_clzl"
+                   (mksignature (AST.Xint :: nil) AST.Xint cc_default))
+     (tuint :: nil) tint cc_default)) ::
+ (___builtin_clzll,
+   Gfun(External (EF_builtin "__builtin_clzll"
+                   (mksignature (AST.Xlong :: nil) AST.Xint cc_default))
+     (tulong :: nil) tint cc_default)) ::
+ (___builtin_ctz,
+   Gfun(External (EF_builtin "__builtin_ctz"
+                   (mksignature (AST.Xint :: nil) AST.Xint cc_default))
+     (tuint :: nil) tint cc_default)) ::
+ (___builtin_ctzl,
+   Gfun(External (EF_builtin "__builtin_ctzl"
+                   (mksignature (AST.Xint :: nil) AST.Xint cc_default))
+     (tuint :: nil) tint cc_default)) ::
+ (___builtin_ctzll,
+   Gfun(External (EF_builtin "__builtin_ctzll"
+                   (mksignature (AST.Xlong :: nil) AST.Xint cc_default))
+     (tulong :: nil) tint cc_default)) ::
+ (___builtin_fabs,
+   Gfun(External (EF_builtin "__builtin_fabs"
+                   (mksignature (AST.Xfloat :: nil) AST.Xfloat cc_default))
+     (tdouble :: nil) tdouble cc_default)) ::
+ (___builtin_fabsf,
+   Gfun(External (EF_builtin "__builtin_fabsf"
+                   (mksignature (AST.Xsingle :: nil) AST.Xsingle cc_default))
+     (tfloat :: nil) tfloat cc_default)) ::
+ (___builtin_fsqrt,
+   Gfun(External (EF_builtin "__builtin_fsqrt"
+                   (mksignature (AST.Xfloat :: nil) AST.Xfloat cc_default))
+     (tdouble :: nil) tdouble cc_default)) ::
+ (___builtin_sqrt,
+   Gfun(External (EF_builtin "__builtin_sqrt"
+                   (mksignature (AST.Xfloat :: nil) AST.Xfloat cc_default))
+     (tdouble :: nil) tdouble cc_default)) ::
+ (___builtin_memcpy_aligned,
+   Gfun(External (EF_builtin "__builtin_memcpy_aligned"
+                   (mksignature
+                     (AST.Xptr :: AST.Xptr :: AST.Xint :: AST.Xint :: nil)
+                     AST.Xvoid cc_default))
+     ((tptr tvoid) :: (tptr tvoid) :: tuint :: tuint :: nil) tvoid
+     cc_default)) ::
+ (___builtin_sel,
+   Gfun(External (EF_builtin "__builtin_sel"
+                   (mksignature (AST.Xbool :: nil) AST.Xvoid
+                     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
+     (tbool :: nil) tvoid
+     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
+ (___builtin_annot,
+   Gfun(External (EF_builtin "__builtin_annot"
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid
+                     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
+     ((tptr tschar) :: nil) tvoid
+     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
+ (___builtin_annot_intval,
+   Gfun(External (EF_builtin "__builtin_annot_intval"
+                   (mksignature (AST.Xptr :: AST.Xint :: nil) AST.Xint
+                     cc_default)) ((tptr tschar) :: tint :: nil) tint
+     cc_default)) ::
+ (___builtin_membar,
+   Gfun(External (EF_builtin "__builtin_membar"
+                   (mksignature nil AST.Xvoid cc_default)) nil tvoid
+     cc_default)) ::
+ (___builtin_va_start,
+   Gfun(External (EF_builtin "__builtin_va_start"
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid cc_default))
+     ((tptr tvoid) :: nil) tvoid cc_default)) ::
+ (___builtin_va_arg,
+   Gfun(External (EF_builtin "__builtin_va_arg"
+                   (mksignature (AST.Xptr :: AST.Xint :: nil) AST.Xvoid
+                     cc_default)) ((tptr tvoid) :: tuint :: nil) tvoid
+     cc_default)) ::
+ (___builtin_va_copy,
+   Gfun(External (EF_builtin "__builtin_va_copy"
+                   (mksignature (AST.Xptr :: AST.Xptr :: nil) AST.Xvoid
+                     cc_default)) ((tptr tvoid) :: (tptr tvoid) :: nil) tvoid
+     cc_default)) ::
+ (___builtin_va_end,
+   Gfun(External (EF_builtin "__builtin_va_end"
+                   (mksignature (AST.Xptr :: nil) AST.Xvoid cc_default))
+     ((tptr tvoid) :: nil) tvoid cc_default)) ::
+ (___builtin_unreachable,
+   Gfun(External (EF_builtin "__builtin_unreachable"
+                   (mksignature nil AST.Xvoid cc_default)) nil tvoid
+     cc_default)) ::
+ (___builtin_expect,
+   Gfun(External (EF_builtin "__builtin_expect"
+                   (mksignature (AST.Xint :: AST.Xint :: nil) AST.Xint
+                     cc_default)) (tint :: tint :: nil) tint cc_default)) ::
+ (___builtin_fmax,
+   Gfun(External (EF_builtin "__builtin_fmax"
+                   (mksignature (AST.Xfloat :: AST.Xfloat :: nil) AST.Xfloat
+                     cc_default)) (tdouble :: tdouble :: nil) tdouble
+     cc_default)) ::
+ (___builtin_fmin,
+   Gfun(External (EF_builtin "__builtin_fmin"
+                   (mksignature (AST.Xfloat :: AST.Xfloat :: nil) AST.Xfloat
+                     cc_default)) (tdouble :: tdouble :: nil) tdouble
+     cc_default)) ::
+ (___builtin_fmadd,
+   Gfun(External (EF_builtin "__builtin_fmadd"
+                   (mksignature
+                     (AST.Xfloat :: AST.Xfloat :: AST.Xfloat :: nil)
+                     AST.Xfloat cc_default))
+     (tdouble :: tdouble :: tdouble :: nil) tdouble cc_default)) ::
+ (___builtin_fmsub,
+   Gfun(External (EF_builtin "__builtin_fmsub"
+                   (mksignature
+                     (AST.Xfloat :: AST.Xfloat :: AST.Xfloat :: nil)
+                     AST.Xfloat cc_default))
+     (tdouble :: tdouble :: tdouble :: nil) tdouble cc_default)) ::
+ (___builtin_fnmadd,
+   Gfun(External (EF_builtin "__builtin_fnmadd"
+                   (mksignature
+                     (AST.Xfloat :: AST.Xfloat :: AST.Xfloat :: nil)
+                     AST.Xfloat cc_default))
+     (tdouble :: tdouble :: tdouble :: nil) tdouble cc_default)) ::
+ (___builtin_fnmsub,
+   Gfun(External (EF_builtin "__builtin_fnmsub"
+                   (mksignature
+                     (AST.Xfloat :: AST.Xfloat :: AST.Xfloat :: nil)
+                     AST.Xfloat cc_default))
+     (tdouble :: tdouble :: tdouble :: nil) tdouble cc_default)) ::
+ (___builtin_read16_reversed,
+   Gfun(External (EF_builtin "__builtin_read16_reversed"
+                   (mksignature (AST.Xptr :: nil) AST.Xint16unsigned
+                     cc_default)) ((tptr tushort) :: nil) tushort
+     cc_default)) ::
+ (___builtin_read32_reversed,
+   Gfun(External (EF_builtin "__builtin_read32_reversed"
+                   (mksignature (AST.Xptr :: nil) AST.Xint cc_default))
+     ((tptr tuint) :: nil) tuint cc_default)) ::
+ (___builtin_write16_reversed,
+   Gfun(External (EF_builtin "__builtin_write16_reversed"
+                   (mksignature (AST.Xptr :: AST.Xint16unsigned :: nil)
+                     AST.Xvoid cc_default))
+     ((tptr tushort) :: tushort :: nil) tvoid cc_default)) ::
+ (___builtin_write32_reversed,
+   Gfun(External (EF_builtin "__builtin_write32_reversed"
+                   (mksignature (AST.Xptr :: AST.Xint :: nil) AST.Xvoid
+                     cc_default)) ((tptr tuint) :: tuint :: nil) tvoid
+     cc_default)) ::
+ (___builtin_debug,
+   Gfun(External (EF_external "__builtin_debug"
+                   (mksignature (AST.Xint :: nil) AST.Xvoid
+                     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
+     (tint :: nil) tvoid
+     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
+ (_main, Gfun(Internal f_main)) ::
+ (_f_ret_expr, Gfun(Internal f_f_ret_expr)) ::
+ (_f_temps, Gfun(Internal f_f_temps)) :: nil).
+
+Definition public_idents : list ident :=
+(_f_temps :: _f_ret_expr :: _main :: ___builtin_debug ::
+ ___builtin_write32_reversed :: ___builtin_write16_reversed ::
+ ___builtin_read32_reversed :: ___builtin_read16_reversed ::
+ ___builtin_fnmsub :: ___builtin_fnmadd :: ___builtin_fmsub ::
+ ___builtin_fmadd :: ___builtin_fmin :: ___builtin_fmax ::
+ ___builtin_expect :: ___builtin_unreachable :: ___builtin_va_end ::
+ ___builtin_va_copy :: ___builtin_va_arg :: ___builtin_va_start ::
+ ___builtin_membar :: ___builtin_annot_intval :: ___builtin_annot ::
+ ___builtin_sel :: ___builtin_memcpy_aligned :: ___builtin_sqrt ::
+ ___builtin_fsqrt :: ___builtin_fabsf :: ___builtin_fabs ::
+ ___builtin_ctzll :: ___builtin_ctzl :: ___builtin_ctz :: ___builtin_clzll ::
+ ___builtin_clzl :: ___builtin_clz :: ___builtin_bswap16 ::
+ ___builtin_bswap32 :: ___builtin_bswap :: ___builtin_bswap64 ::
+ ___builtin_ais_annot :: ___compcert_i64_umulh :: ___compcert_i64_smulh ::
+ ___compcert_i64_sar :: ___compcert_i64_shr :: ___compcert_i64_shl ::
+ ___compcert_i64_umod :: ___compcert_i64_smod :: ___compcert_i64_udiv ::
+ ___compcert_i64_sdiv :: ___compcert_i64_utof :: ___compcert_i64_stof ::
+ ___compcert_i64_utod :: ___compcert_i64_stod :: ___compcert_i64_dtou ::
+ ___compcert_i64_dtos :: ___compcert_va_composite ::
+ ___compcert_va_float64 :: ___compcert_va_int64 :: ___compcert_va_int32 ::
+ nil).
+
+Definition prog : Clight.program := 
+  mkprogram composites global_definitions public_idents _main Logic.I.
+
+
diff --git a/refinedVST/typing/base.v b/refinedVST/typing/base.v
new file mode 100644
index 0000000000..af45f32926
--- /dev/null
+++ b/refinedVST/typing/base.v
@@ -0,0 +1,9 @@
+From stdpp Require Import coPset.
+From VST.lithium Require Export syntax definitions.
+From VST Require Export floyd.core_base shared.dshare.
+
+Class CoPsetFact (P : Prop) : Prop := copset_fact : P.
+(* clear for performance reasons as there can be many hypothesis and they should not be needed for the goals which occur *)
+Local Definition coPset_disjoint_empty_r := disjoint_empty_r (C:=coPset).
+Local Definition coPset_disjoint_empty_l := disjoint_empty_l (C:=coPset).
+Global Hint Extern 1 (CoPsetFact ?P) => (change P; clear; eauto using coPset_disjoint_empty_r, coPset_disjoint_empty_r with solve_ndisj) : typeclass_instances.
diff --git a/refinedVST/typing/boolean.v b/refinedVST/typing/boolean.v
new file mode 100644
index 0000000000..504bd17f4a
--- /dev/null
+++ b/refinedVST/typing/boolean.v
@@ -0,0 +1,305 @@
+From VST.typing Require Export type.
+From VST.typing Require Import programs.
+From VST.typing Require Import type_options.
+
+(** A [Strict] boolean can only have value 0 (false) or 1 (true). A [Relaxed]
+    boolean can have any value: 0 means false, anything else means true. *)
+Inductive bool_strictness := StrictBool | RelaxedBool.
+
+Definition represents_boolean (stn: bool_strictness) (n: Z) (b: bool) : Prop :=
+  match stn with
+  | StrictBool => n = bool_to_Z b
+  | RelaxedBool => bool_decide (n ≠ 0) = b
+  end.
+
+(* Not sure what this would correspond to.
+Definition is_bool_ot (ot : op_type) (it : int_type) (stn : bool_strictness) : Prop:=
+  match ot with
+  | BoolOp => it = u8 ∧ stn = StrictBool
+  | IntOp it' => it = it'
+  | UntypedOp ly => ly = it_layout it
+  | _ => False
+  end.*)
+
+Section is_bool_ot.
+  Context `{!typeG OK_ty Σ}.
+
+  Lemma represents_boolean_eq stn n b :
+    represents_boolean stn n b → bool_decide (n ≠ 0) = b.
+  Proof.
+    destruct stn => //=. move => ->. by destruct b.
+  Qed.
+
+(*  Lemma is_bool_ot_layout ot it stn:
+    is_bool_ot ot it stn → ot_layout ot = it.
+  Proof. destruct ot => //=; naive_solver. Qed.
+
+  Lemma mem_cast_compat_bool (P : val → iProp Σ) v ot stn it st mt:
+    is_bool_ot ot it stn →
+    (P v ⊢ ⌜∃ n b, val_to_Z v it = Some n ∧ represents_boolean stn n b⌝) →
+    (P v ⊢ match mt with | MCNone => True | MCCopy => P (mem_cast v ot st) | MCId => ⌜mem_cast_id v ot⌝ end).
+  Proof.
+    move => ? HT. apply: mem_cast_compat_Untyped => ?.
+    apply: mem_cast_compat_id. etrans; [done|]. iPureIntro => -[?[?[??]]].
+    destruct ot => //; simplify_eq/=; destruct_and?; simplify_eq/=.
+    - apply: mem_cast_id_bool. by apply val_to_bool_iff_val_to_Z.
+    - by apply: mem_cast_id_int.
+  Qed.*)
+End is_bool_ot.
+
+Section generic_boolean.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  Program Definition generic_boolean_type (stn: bool_strictness) (it: Ctypes.type) (b: bool) : type := {|
+    ty_has_op_type ot mt := (*is_bool_ot ot it stn*) ot = it;
+    ty_own β l :=
+      ∃ v n, ⌜tc_val it v⌝ ∧
+             ⌜val_to_Z v it = Some n⌝ ∧
+             ⌜represents_boolean stn n b⌝ ∧
+             ⌜field_compatible it [] l⌝ ∧
+             l ↦_it[β] v;
+      ty_own_val v := ∃ n, <affine> ⌜tc_val it v ∧ val_to_Z v it = Some n⌝ ∗ <affine> ⌜represents_boolean stn n b⌝;
+  |}%I.
+  Next Obligation.
+    iIntros (??????) "(%v&%n&%&%&%&%&Hl)". iExists v, n.
+    by iMod (heap_mapsto_own_state_share with "Hl") as "$".
+  Qed.
+  Next Obligation.
+    iIntros (??????->) "(%&%&_&_&_&H&_)" => //.
+  Qed.
+  Next Obligation.
+    iIntros (??????->) "(%&(%&%)&%)". iPureIntro. destruct v; try done.
+    - rewrite /has_layout_val /tc_val' =>?. destruct it; done.
+    - rewrite /has_layout_val /tc_val' =>?. destruct it; done.
+  Qed.
+  Next Obligation.
+    iIntros (??????->) "(%&%&%&%&%&%&?)". eauto with iFrame.
+  Qed.
+  Next Obligation.
+    iIntros (?????? v -> ?) "Hl (%n&(%&%)&%)". iExists v, n; eauto with iFrame.
+  Qed.
+(*  Next Obligation.
+    iIntros (????????). apply: mem_cast_compat_bool; [naive_solver|]. iPureIntro. naive_solver.
+  Qed.*)
+
+  Definition generic_boolean (stn: bool_strictness) (it: Ctypes.type) : rtype _ :=
+    RType (generic_boolean_type stn it).
+
+  Global Program Instance generic_boolean_copyable b stn it : Copyable (b @ generic_boolean stn it).
+  Next Obligation.
+    iIntros (????????) "(%v&%n&%&%&%&%&Hl)".
+    simpl in *; subst.
+    iMod (heap_mapsto_own_state_to_mt with "Hl") as (q) "[_ Hl]" => //.
+    iSplitR; first done; iExists q, v; eauto 9 with iFrame.
+  Qed.
+
+(*  Global Instance alloc_alive_generic_boolean b stn it β: AllocAlive (b @ generic_boolean stn it) β True.
+  Proof.
+    constructor. iIntros (l ?) "(%&%&%&%&%&Hl)".
+    iApply (heap_mapsto_own_state_alloc with "Hl").
+    erewrite val_to_Z_length; [|done]. have := bytes_per_int_gt_0 it. lia.
+  Qed.*)
+
+  Global Instance generic_boolean_timeless l b stn it:
+    Timeless (l ◁ₗ b @ generic_boolean stn it)%I.
+  Proof. apply _. Qed.
+
+End generic_boolean.
+Notation "generic_boolean< stn , it >" := (generic_boolean stn it)
+  (only printing, format "'generic_boolean<' stn ',' it '>'") : printing_sugar.
+
+Notation boolean := (generic_boolean StrictBool).
+Notation "boolean< it >" := (boolean it)
+  (only printing, format "'boolean<' it '>'") : printing_sugar.
+
+(* Type corresponding to [_Bool] (https://en.cppreference.com/w/c/types/boolean). *)
+Notation u8 := (Tint I8 Unsigned noattr).
+Notation builtin_boolean := (generic_boolean StrictBool u8).
+
+Section generic_boolean.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  Inductive trace_if_bool :=
+  | TraceIfBool (b : bool).
+
+  Lemma type_if_generic_boolean stn it (b : bool) v T1 T2 :
+     case_destruct b (λ b' _,
+     li_trace (TraceIfBool b, b') (if b' then T1 else T2))
+    ⊢ typed_if it v (v ◁ᵥ b @ generic_boolean stn it) T1 T2.
+  Proof.
+    unfold case_destruct, li_trace. iIntros "[% Hs] (%n&(%Hv&%)&%Hb)".
+    apply represents_boolean_eq in Hb as <-.
+    destruct it, v; try discriminate; eauto.
+  Qed.
+  Definition type_if_generic_boolean_inst := [instance type_if_generic_boolean].
+  Global Existing Instance type_if_generic_boolean_inst.
+
+(*  Lemma type_assert_generic_boolean v stn it (b : bool) s fn ls R Q :
+    (<affine> ⌜b⌝ ∗ typed_stmt s fn ls R Q)
+    ⊢ typed_assert it v (v ◁ᵥ b @ generic_boolean stn it) s fn ls R Q.
+  Proof.
+    iIntros "[% [% ?]] (%n&%&%Hb)". destruct b; last by exfalso.
+    destruct ot; destruct_and? => //; simplify_eq/=.
+    - iExists true. iFrame. iPureIntro. split; [|done]. by apply val_to_bool_iff_val_to_Z.
+    - iExists n. iFrame. iSplit; first done. iPureIntro.
+      by apply represents_boolean_eq, bool_decide_eq_true in Hb.
+  Qed.
+  Definition type_assert_generic_boolean_inst := [instance type_assert_generic_boolean].
+  Global Existing Instance type_assert_generic_boolean_inst.*)
+End generic_boolean.
+
+Section boolean.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  Lemma type_relop_boolean b1 b2 op b it v1 v2
+    (Hop : match op with
+           | Cop.Oeq => Some (eqb b1 b2)
+           | Cop.One => Some (negb (eqb b1 b2))
+           | _ => None
+           end = Some b) T:
+    T (i2v (bool_to_Z b) tint) (b @ boolean tint)
+    ⊢ typed_bin_op v1 ⎡v1 ◁ᵥ b1 @ boolean it⎤
+                 v2 ⎡v2 ◁ᵥ b2 @ boolean it⎤ op it it T.
+  Proof.
+    iIntros "HT (%n1&(%Hty1&%Hv1)&%Hb1) (%n2&(%Hty2&%Hv2)&%Hb2) %Φ HΦ".
+    rewrite /wp_binop.
+    (* some of this should move up to a wp rule in lifting_expr *)
+    iIntros "!>" (?) "$ !>".
+    iExists (i2v (bool_to_Z b) tint); iSplit.
+    - iStopProof; split => rho; monPred.unseal.
+      apply bi.pure_intro.
+      assert (classify_cmp it it = cmp_default) as Hclass.
+      { destruct it; try by destruct v1.
+        by destruct i. }
+      rewrite -val_of_bool_eq.
+      assert (eqb b1 b2 = int_eq v1 v2) as Heq.
+      { destruct it, v1; try done; destruct v2; try done; simpl in *.
+        * pose proof (Int.eq_spec i0 i1) as Heq.
+          destruct (Int.eq i0 i1).
+          -- subst; destruct s; inv Hv1; destruct b1, b2; simpl in *; congruence.
+          -- destruct s; inv Hv1; destruct (eqb_spec b1 b2); try done; subst.
+             ++ exploit (signed_inj i0 i1); congruence.
+             ++ rewrite -H0 in Hv2.
+                exploit (unsigned_eq_eq i0 i1); congruence.
+        * pose proof (Int64.eq_spec i i0) as Heq.
+          destruct (Int64.eq i i0).
+          -- subst; destruct s; inv Hv1; destruct b1, b2; simpl in *; congruence.
+          -- destruct s; inv Hv1; destruct b1, b2; try done;
+               by (exploit (signed_inj_64 i i0); congruence || exploit (unsigned_inj_64 i i0); congruence). }
+      destruct op; inv Hop; rewrite /= /Cop.sem_cmp Hclass /Cop.sem_binarith Heq.
+      + destruct it; try by destruct v1; simpl.
+        * destruct i, v1; try done; destruct v2; try done; destruct s; done.
+        * destruct v1; try done; destruct v2; try done; destruct s; done.
+      + destruct it; try by destruct v1; simpl.
+        * destruct i, v1; try done; destruct v2; try done; destruct s; done.
+        * destruct v1; try done; destruct v2; try done; destruct s; done.
+    - iApply "HΦ"; last done. iExists (bool_to_Z b).
+      iSplit; [by destruct b | done].
+  Qed.
+  Definition type_eq_boolean_inst b1 b2 :=
+    [instance type_relop_boolean b1 b2 Cop.Oeq (eqb b1 b2)].
+  Global Existing Instance type_eq_boolean_inst.
+  Definition type_ne_boolean_inst b1 b2 :=
+    [instance type_relop_boolean b1 b2 Cop.One (negb (eqb b1 b2))].
+  Global Existing Instance type_ne_boolean_inst.
+
+(*  (* TODO: replace this with a typed_cas once it is refactored to take E as an argument. *)
+  Lemma wp_cas_suc_boolean it ot b1 b2 bd l1 l2 vd Φ E:
+    ((ot_layout ot).(ly_size) ≤ bytes_per_addr)%nat →
+    match ot with | BoolOp => it = u8 | IntOp it' => it = it' | _ => False end →
+    b1 = b2 →
+    l1 ◁ₗ b1 @ boolean it -∗
+    l2 ◁ₗ b2 @ boolean it -∗
+    vd ◁ᵥ bd @ boolean it -∗
+    ▷ (l1 ◁ₗ bd @ boolean it -∗ l2 ◁ₗ b2 @ boolean it -∗ Φ (val_of_bool true)) -∗
+    wp NotStuck E (CAS ot (Val l1) (Val l2) (Val vd)) Φ.
+  Proof.
+    iIntros (? Hot ->) "(%v1&%n1&%&%&%&Hl1) (%v2&%n2&%&%&%&Hl2) (%n&%&%) HΦ/=".
+    iApply (wp_cas_suc with "Hl1 Hl2").
+    { by apply val_to_of_loc. }
+    { by apply val_to_of_loc. }
+    { by destruct ot; simplify_eq. }
+    { by destruct ot; simplify_eq. }
+    { apply: val_to_Z_ot_to_Z; [done|]. destruct ot; naive_solver. }
+    { apply: val_to_Z_ot_to_Z; [done|]. destruct ot; naive_solver. }
+    { etrans; [by eapply val_to_Z_length|]. by destruct ot; simplify_eq. }
+    { by simplify_eq/=. }
+    { by simplify_eq/=. }
+    iIntros "!# Hl1 Hl2". iApply ("HΦ" with "[Hl1] [Hl2]"); iExists _, _; by iFrame.
+  Qed.
+
+  Lemma wp_cas_fail_boolean ot it b1 b2 bd l1 l2 vd Φ E:
+    ((ot_layout ot).(ly_size) ≤ bytes_per_addr)%nat →
+    match ot with | BoolOp => it = u8 | IntOp it' => it = it' | _ => False end →
+    b1 ≠ b2 →
+    l1 ◁ₗ b1 @ boolean it -∗ l2 ◁ₗ b2 @ boolean it -∗ vd ◁ᵥ bd @ boolean it -∗
+    ▷ (l1 ◁ₗ b1 @ boolean it -∗ l2 ◁ₗ b1 @ boolean it -∗ Φ (val_of_bool false)) -∗
+    wp NotStuck E (CAS ot (Val l1) (Val l2) (Val vd)) Φ.
+  Proof.
+    iIntros (? Hot ?) "(%v1&%n1&%&%&%&Hl1) (%v2&%n2&%&%&%&Hl2) (%n&%&%) HΦ/=".
+    iApply (wp_cas_fail with "Hl1 Hl2").
+    { by apply val_to_of_loc. }
+    { by apply val_to_of_loc. }
+    { by destruct ot; simplify_eq. }
+    { by destruct ot; simplify_eq. }
+    { apply: val_to_Z_ot_to_Z; [done|]. destruct ot; naive_solver. }
+    { apply: val_to_Z_ot_to_Z; [done|]. destruct ot; naive_solver. }
+    { etrans; [by eapply val_to_Z_length|]. by destruct ot; simplify_eq. }
+    { by simplify_eq/=. }
+    { simplify_eq/=. by destruct b1, b2. }
+    iIntros "!# Hl1 Hl2". iApply ("HΦ" with "[Hl1] [Hl2]"); iExists _, _; by iFrame.
+  Qed.
+
+  Lemma type_cast_boolean b it1 it2 v T:
+    (∀ v, T v (b @ boolean it2))
+    ⊢ typed_un_op v (v ◁ᵥ b @ boolean it1)%I (CastOp (IntOp it2)) (IntOp it1) T.
+  Proof.
+    iIntros "HT (%n&%Hv&%Hb) %Φ HΦ". move: Hb => /= ?. subst n.
+    have [??] := val_of_Z_bool_is_Some (val_to_byte_prov v) it2 b.
+    iApply wp_cast_int => //. iApply ("HΦ" with "[] HT") => //.
+    iExists _. iSplit; last done. iPureIntro. by eapply val_to_of_Z.
+  Qed.
+  Definition type_cast_boolean_inst := [instance type_cast_boolean].
+  Global Existing Instance type_cast_boolean_inst.*)
+
+End boolean.
+
+Notation "'if' p " := (TraceIfBool p) (at level 100, only printing).
+
+Section builtin_boolean.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  Lemma type_val_builtin_boolean b T:
+    (T (b @ builtin_boolean)) ⊢ typed_value (Val.of_bool b) T.
+  Proof.
+    iIntros "HT". iExists _. iFrame. iPureIntro. exists (if b then 1 else 0); destruct b; simpl; done.
+  Qed.
+  Definition type_val_builtin_boolean_inst := [instance type_val_builtin_boolean].
+  Global Existing Instance type_val_builtin_boolean_inst.
+
+(*  Lemma type_cast_boolean_builtin_boolean b it v T:
+    (∀ v, T v (b @ builtin_boolean))
+    ⊢ typed_un_op v (v ◁ᵥ b @ boolean it)%I (CastOp BoolOp) (IntOp it) T.
+  Proof.
+    iIntros "HT (%n&%Hv&%Hb) %Φ HΦ". move: Hb => /= ?. subst n.
+    iApply wp_cast_int_bool => //. iApply ("HΦ" with "[] HT") => //.
+    iPureIntro => /=. exists (bool_to_Z b). by destruct b.
+  Qed.
+  Definition type_cast_boolean_builtin_boolean_inst := [instance type_cast_boolean_builtin_boolean].
+  Global Existing Instance type_cast_boolean_builtin_boolean_inst.
+
+  Lemma type_cast_builtin_boolean_boolean b it v T:
+    (∀ v, T v (b @ boolean it))
+    ⊢ typed_un_op v (v ◁ᵥ b @ builtin_boolean)%I (CastOp (IntOp it)) BoolOp T.
+  Proof.
+    iIntros "HT (%n&%Hv&%Hb) %Φ HΦ". move: Hb => /= ?. subst n.
+    have [??] := val_of_Z_bool_is_Some None it b.
+    iApply wp_cast_bool_int => //. { by apply val_to_bool_iff_val_to_Z. }
+    iApply ("HΦ" with "[] HT") => //.
+    iPureIntro => /=. eexists _. split;[|done]. by apply: val_to_of_Z.
+  Qed.
+  Definition type_cast_builtin_boolean_boolean_inst := [instance type_cast_builtin_boolean_boolean].
+  Global Existing Instance type_cast_builtin_boolean_boolean_inst.*)
+
+End builtin_boolean.
+Global Typeclasses Opaque generic_boolean_type generic_boolean.
diff --git a/refinedVST/typing/bytes.v b/refinedVST/typing/bytes.v
new file mode 100644
index 0000000000..468c741444
--- /dev/null
+++ b/refinedVST/typing/bytes.v
@@ -0,0 +1,298 @@
+From VST.typing Require Export type.
+From VST.typing Require Import programs int own.
+From VST.typing Require Import type_options.
+
+(* NOTE: we might want to have a type [bytes : list mbyte → type] one day,
+and the [bytewise] abstraction could be encoded on top of it. *)
+
+Section bytewise.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+  Implicit Types P : memval → Prop.
+
+  (* Because ty_own_val is at the val level, for now this is defined only for bytewise representations
+     of vals, rather than arbitrary byte arrays that happen to have the right layout. *)
+
+  Program Definition bytewise (P : memval → Prop) (ly : Ctypes.type) : type := {|
+    ty_has_op_type ot mt := ot = ly;
+    (* Does bytewise make sense for non-by-value types? Structs do have
+       defined layouts in memory, but we don't have a function for interpreting memvals as structs.
+       We could consider lifting the definition of ↦[β] all the way to data_at? *)
+    ty_own β l :=
+      ∃ v, <affine> ⌜field_compatible ly [] l⌝ ∗
+           <affine> ⌜∃ ch bl, access_mode ly = By_value ch ∧ encode_val ch v = bl ∧ Forall P bl⌝ ∗
+           l ↦_ly[β] v;
+    ty_own_val v := (<affine> ⌜∃ ch bl, access_mode ly = By_value ch ∧ encode_val ch v = bl ∧ Forall P bl⌝)%I;
+  |}%I.
+  Next Obligation.
+    iIntros (?????). iDestruct 1 as (?) "(?&?&Hl)".
+    iMod (heap_mapsto_own_state_share with "Hl") as "Hl".
+    eauto with iFrame.
+  Qed.
+  Next Obligation. iIntros (?????->). by iDestruct 1 as (???) "_". Qed.
+  Next Obligation. iIntros (?????->). Admitted.
+  Next Obligation. iIntros (?????->). iDestruct 1 as (???) "?". by eauto. Qed.
+  Next Obligation. iIntros (????? v -> ?) "? [%%]". iExists v. iFrame. eauto. Qed.
+(*   Next Obligation. iIntros (ly P v ot mt st ?). apply mem_cast_compat_Untyped. destruct ot; naive_solver. Qed. *)
+
+  Lemma bytewise_weaken l β P1 P2 ly:
+    (∀ b, P1 b → P2 b) →
+    l ◁ₗ{β} bytewise P1 ly -∗ l ◁ₗ{β} bytewise P2 ly.
+  Proof.
+    iIntros (?). iDestruct 1 as (?? HP) "H". iExists _; iFrame.
+    iPureIntro; split_and! => //. edestruct HP as (? & ? & ? & ? & ?%Forall_impl); eauto.
+  Qed.
+
+  (* To do this, ly should be something more flexible than a type, but I don't think VST has that.
+  Lemma split_bytewise n l β P ly:
+    (n ≤ sizeof ly)%nat →
+    l ◁ₗ{β} bytewise P ly -∗
+      l ◁ₗ{β} bytewise P (ly_set_size ly n) ∗
+      (l +ₗ n) ◁ₗ{β} bytewise P (ly_offset ly n).
+  Proof.
+    iIntros (?). iDestruct 1 as (v Hv Hl HP) "Hl".
+    rewrite -[v](take_drop n) heap_mapsto_own_state_app.
+    iDestruct "Hl" as "[Hl1 Hl2]". iSplitL "Hl1".
+    - iExists _. iFrame.
+      eapply Forall_take in HP. rewrite /has_layout_val in Hv.
+      by rewrite /has_layout_val take_length min_l // Hv.
+    - rewrite take_length_le ?Hv //. iExists _. iFrame.
+      eapply Forall_drop in HP. eapply has_layout_ly_offset in Hl.
+      by rewrite /has_layout_val drop_length Hv.
+  Qed.
+
+  Lemma merge_bytewise l β P ly1 ly2:
+    (ly1.(ly_size) ≤ ly2.(ly_size))%nat →
+    (ly_align ly2 ≤ ly_align ly1)%nat →
+    l ◁ₗ{β} bytewise P ly1 -∗
+    (l +ₗ ly1.(ly_size)) ◁ₗ{β} (bytewise P (ly_offset ly2 ly1.(ly_size))) -∗
+      l ◁ₗ{β} bytewise P ly2.
+  Proof.
+    iIntros (??).
+    iDestruct 1 as (v1 Hv1 Hl1 HP1) "Hl1".
+    iDestruct 1 as (v2 Hv2 Hl2 HP2) "Hl2".
+    iExists (v1 ++ v2).
+    rewrite heap_mapsto_own_state_app Hv1 /has_layout_val app_length Hv1 Hv2.
+    iFrame. iPureIntro. split_and!.
+    - rewrite {2}/ly_size/=. lia.
+    - by apply: has_layout_loc_trans'.
+    - by apply Forall_app.
+  Qed.
+
+  Lemma bytewise_loc_in_bounds l β P ly:
+    l ◁ₗ{β} bytewise P ly -∗ loc_in_bounds l (ly_size ly).
+  Proof.
+    iDestruct 1 as (v <-) "(_&_&?)".
+    by iApply heap_mapsto_own_state_loc_in_bounds.
+  Qed.
+
+  Global Instance loc_in_bounds_bytewise β P ly:
+    LocInBounds (bytewise P ly) β (ly_size ly).
+  Proof. constructor. iIntros (?). by iApply bytewise_loc_in_bounds. Qed. *)
+
+  Lemma subsume_bytewise_ex A l β P1 P2 ly1 ly2 T:
+    subsume (l ◁ₗ{β} bytewise P1 ly1) (λ x : A, l ◁ₗ{β} bytewise P2 (ly2 x)) T
+      where `{!∀ x, ContainsEx (ly2 x)} :-
+              exhale <affine> ⌜∀ b, P1 b → P2 b⌝; ∃ x, exhale <affine> ⌜ly1 = ly2 x⌝; return T x.
+  Proof.
+    liFromSyntax. iIntros (_) "[% [% [-> HT]]] Hl".
+    iExists _. iFrame "HT". by iApply bytewise_weaken.
+  Qed.
+  Definition subsume_bytewise_ex_inst := [instance subsume_bytewise_ex].
+  Global Existing Instance subsume_bytewise_ex_inst | 50.
+
+(*   Lemma subsume_bytewise_eq A l β P1 P2 ly1 ly2
+        `{!CanSolve (sizeof ly1 = sizeof ly2)} T:
+    <affine> ⌜∀ b, P1 b → P2 b⌝ ∗
+    (<affine> ⌜field_compatible ly1 [] (addr_to_val l)⌝ -∗ <affine> ⌜field_compatible ly2 [] l⌝ ∗ ∃ x, T x)
+    ⊢ subsume (l ◁ₗ{β} bytewise P1 ly1) (λ x : A, l ◁ₗ{β} bytewise P2 ly2) T.
+  Proof.
+    revert select (CanSolve _) => Hsz. unfold CanSolve in *.
+    iDestruct 1 as (HPs) "HT". iDestruct 1 as (?? (? & ? & ? & ? & HP)) "?".
+    apply (Forall_impl _ _ _ HP) in HPs.
+    iDestruct ("HT" with "[//]") as (??) "?". iFrame. rewrite /ty_own /=. eauto.
+  Qed.
+  Definition subsume_bytewise_eq_inst := [instance subsume_bytewise_eq].
+  Global Existing Instance subsume_bytewise_eq_inst | 5.
+
+  Lemma subsume_bytewise_merge A l β P1 P2 ly1 ly2
+        `{!CanSolve (ly1.(ly_size) ≤ ly2.(ly_size))%nat} T:
+    ⌜∀ b, P1 b → P2 b⌝ ∗
+    ⌜ly_align ly2 ≤ ly_align ly1⌝%nat ∗
+    ((l +ₗ ly1.(ly_size)) ◁ₗ{β} bytewise P2 (ly_offset ly2 ly1.(ly_size)) ∗ ∃ x, T x)
+    ⊢ subsume (l ◁ₗ{β} bytewise P1 ly1) (λ x : A, l ◁ₗ{β} bytewise P2 ly2) T.
+  Proof.
+    unfold CanSolve in *.
+    iIntros "(%&%&?&%&?) Hl".
+    iDestruct (bytewise_weaken with "Hl") as "Hl" => //.
+    iExists _. iFrame. iApply (merge_bytewise with "Hl") => //.
+  Qed.
+  Definition subsume_bytewise_merge_inst := [instance subsume_bytewise_merge].
+  Global Existing Instance subsume_bytewise_merge_inst | 10.
+
+  Lemma subsume_bytewise_split A l β P1 P2 ly1 ly2
+        `{!CanSolve (ly2.(ly_size) ≤ ly1.(ly_size))%nat} T:
+    ⌜∀ b, P1 b → P2 b⌝ ∗
+    ⌜ly_align ly2 ≤ ly_align ly1⌝%nat ∗
+    ((l +ₗ ly2.(ly_size)) ◁ₗ{β} bytewise P1 (ly_offset ly1 ly2.(ly_size)) -∗ ∃ x, T x)
+    ⊢ subsume (l ◁ₗ{β} bytewise P1 ly1) (λ x : A, l ◁ₗ{β} bytewise P2 ly2) T.
+  Proof.
+    unfold CanSolve in *.
+    iIntros "(%&%&HT) Hl".
+    iDestruct (split_bytewise with "Hl") as "[Hl1 Hl2]" => //.
+    iDestruct (bytewise_weaken with "Hl1") as "Hl1" => //.
+    iDestruct ("HT" with "Hl2") as (?) "?". iExists _. iFrame.
+    iDestruct "Hl1" as (????) "Hl1".
+    iExists _; iFrame. iPureIntro; split_and! => //.
+    by apply: has_layout_loc_trans'.
+  Qed.
+  Definition subsume_bytewise_split_inst := [instance subsume_bytewise_split].
+  Global Existing Instance subsume_bytewise_split_inst | 10. *)
+
+(* We could do this with the higher-level field offsets instead of direct pointer math.
+  Lemma type_add_bytewise v2 β P ly (p : loc) n it T:
+    (<affine> ⌜n ∈ it⌝ -∗
+      <affine> ⌜0 ≤ n⌝ ∗
+      <affine> ⌜n ≤ sizeof ly⌝ ∗
+      (p ◁ₗ{β} bytewise P (ly_set_size ly (Z.to_nat n)) -∗ v2 ◁ᵥ n @ int it -∗
+       T (val_of_loc (p +ₗ n)) ((p +ₗ n) @ &frac{β} (bytewise P (ly_offset ly (Z.to_nat n))))))
+    ⊢ typed_bin_op v2 (v2 ◁ᵥ n @ int it) p (p ◁ₗ{β} bytewise P ly) (PtrOffsetOp u8) (IntOp it) PtrOp T.
+  Proof.
+    unfold int; simpl_type.
+    iIntros "HT" (Hint) "Hp". iIntros (Φ) "HΦ".
+    move: (Hint) => /val_to_Z_in_range?.
+    iDestruct ("HT" with "[//]") as (??) "HT".
+    iDestruct (split_bytewise (Z.to_nat n) with "Hp") as "[H1 H2]"; [lia..|].
+    rewrite -!(offset_loc_sz1 u8)// Z2Nat.id; [|lia].
+    iDestruct (loc_in_bounds_in_bounds with "H2") as "#?".
+    iApply wp_ptr_offset; [ by apply val_to_of_loc | done | |].
+    { iApply loc_in_bounds_shorten; [|done]; lia. }
+    iModIntro. iApply ("HΦ" with "[H2]"). 2: iApply ("HT" with "H1 []").
+    - unfold frac_ptr; simpl_type. by iFrame.
+    - by iPureIntro.
+  Qed.
+  Definition type_add_bytewise_inst := [instance type_add_bytewise].
+  Global Existing Instance type_add_bytewise_inst. *)
+End bytewise.
+
+Notation "bytewise< P , ly >" := (bytewise P ly)
+  (only printing, format "'bytewise<' P ',' ly '>'") : printing_sugar.
+
+Global Typeclasses Opaque bytewise.
+
+Notation uninit := (bytewise (λ _, True%type)).
+
+Section uninit.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+(*   Context `{!externalGS OK_ty Σ}.
+  #[export] Instance VSTGS0 : VSTGS OK_ty Σ := Build_VSTGS _ _ _ _.
+
+  Lemma uninit_own_spec l ly:
+    (l ◁ₗ uninit ly)%I ≡ (data_at_ Tsh ly l)%I.
+  Proof.
+    rewrite /ty_own/=; iSplit.
+    - iDestruct 1 as (?? _) "Hl". rewrite /heap_mapsto_own_state. admit.
+    - iDestruct 1 as (?) "Hl". iExists v; iFrame. by rewrite Forall_forall.
+  Qed. *)
+
+(*   (* This only works for [Own] since [ty] might have interior mutability. *)
+  Lemma uninit_mono A l ty ly `{!TCDone (ty.(ty_has_op_type) ly MCNone)} T:
+    (∀ v, v ◁ᵥ ty -∗ ∃ x, T x)
+    ⊢ subsume (l ◁ₗ ty) (λ x : A, l ◁ₗ uninit ly) T.
+  Proof.
+    unfold TCDone in *; subst. iIntros "HT Hl".
+    iDestruct (ty_aligned with "Hl") as %?; [done|].
+    iDestruct (ty_deref with "Hl") as (v) "[Hl Hv]"; [done|].
+(*     iDestruct (ty_size_eq with "Hv") as %?; [done|]. *)
+    iDestruct ("HT" with "Hv") as (?) "?". iExists _. iFrame.
+    iExists v. iFrame. iSplit; first done. 
+  Qed.
+  (* This rule is handled with a definition and an [Hint Extern] (not
+  with an instance) since this rule should only apply ty is not uninit
+  as this case is covered by the rules for bytes and the CanSolve can
+  be quite expensive. *)
+  Definition uninit_mono_inst := [instance uninit_mono].
+ *)
+(*   (* Typing rule for [Return] (used in [theories/typing/automation.v]). *)
+  Lemma type_return Q e fn ls R:
+    typed_val_expr e (λ v ty,
+      foldr (λ (e : (loc * layout)) T, e.1 ◁ₗ uninit e.2 ∗ T)
+      (R v ty)
+      (zip ls (fn.(f_args) ++ fn.(f_local_vars)).*2))
+    ⊢ typed_stmt (Return e) fn ls R Q.
+  Proof.
+    iIntros "He" (Hls). wps_bind. iApply "He".
+    iIntros (v ty) "Hv HR". iApply wps_return.
+    rewrite /typed_stmt_post_cond. move: Hls. move: (f_args fn ++ f_local_vars fn) => lys {fn} Hlys.
+    iInduction ls as [|l ls] "IH" forall (lys Hlys); destruct lys as [|ly lys]=> //; csimpl in *; simplify_eq.
+    { iExists _. iFrame. }
+    iDestruct "HR" as "[Hl HR]".
+    iDestruct ("IH" with "[//] Hv HR") as (ty') "[?[??]]".
+    iExists _. iFrame.
+    rewrite /ty_own/=. iDestruct "Hl" as (????) "Hl".
+    iExists _. by iFrame.
+  Qed.
+
+  Lemma type_read_move_copy E l ty ot mc a `{!TCDone (ty.(ty_has_op_type) ot MCCopy)} T:
+    (∀ v, T v (uninit (ot_layout ot)) ty)
+    ⊢ typed_read_end a E l Own ty ot mc T.
+  Proof.
+    unfold TCDone in *. rewrite /typed_read_end. iIntros "HT Hl".
+    iApply fupd_mask_intro; [destruct a; solve_ndisj|]. iIntros "Hclose".
+    iDestruct (ty_aligned with "Hl") as %?; [done|].
+    iDestruct (ty_deref with "Hl") as (v) "[Hl Hv]"; [done|].
+    iDestruct (ty_size_eq with "Hv") as %?; [done|].
+    iExists _, _, _. iFrame. do 2 iSplit => //=.
+    iIntros "!# %st Hl Hv". iMod "Hclose". iModIntro.
+    iExists _, ty. iSplitL "Hv". { destruct mc => //. by iApply ty_memcast_compat_copy. }
+    iSplitR "HT"; [|done]. iExists _. iFrame. iPureIntro. split_and! => //. by apply: Forall_true.
+  Qed.
+  Definition type_read_move_copy_inst := [instance type_read_move_copy].
+  Global Existing Instance type_read_move_copy_inst | 70. *)
+End uninit.
+
+Notation "uninit< ly >" := (uninit ly) (only printing, format "'uninit<' ly '>'") : printing_sugar.
+
+(* (* See the definition of [uninit_mono_inst].
+   This hint should only apply ty is not uninit as this case is covered by the rules for bytes. *)
+Global Hint Extern 5 (Subsume (_ ◁ₗ ?ty) (λ _, _ ◁ₗ (uninit _))%I) =>
+  lazymatch ty with
+  | uninit _ => fail
+  | _ => unshelve notypeclasses refine (uninit_mono_inst _ _ _ _ _)
+  end
+  : typeclass_instances. *)
+
+Section void.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  Definition void : type := uninit Tvoid.
+
+(*   Lemma type_void T:
+    T void ⊢ typed_value Vundef T.
+  Proof. iIntros "HT". iExists _. iFrame. unfold void, bytewise; simpl_type. Qed.
+  Definition type_void_inst := [instance type_void].
+  Global Existing Instance type_void_inst. *)
+End void.
+
+Notation zeroed := (bytewise (λ b, b = Byte Byte.zero)).
+
+Section zeroed.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+(*  Lemma subsume_uninit_zeroed A p ly1 ly2 T:
+    ⌜ly_align ly1 = ly_align ly2⌝ ∗ ⌜ly_size ly2 = 0%nat⌝ ∗ (p ◁ₗ uninit ly1 -∗ ∃ x, T x)
+    ⊢ subsume (p ◁ₗ uninit ly1)%I (λ x : A, p ◁ₗ zeroed ly2)%I T.
+  Proof.
+    iDestruct 1 as (H1 H2) "HT". iIntros "Hp".
+    iDestruct (ty_aligned _ (UntypedOp _) MCNone with "Hp") as %Hal; [done|].
+    iDestruct (loc_in_bounds_in_bounds with "Hp") as "#Hlib".
+    iDestruct ("HT" with "Hp") as (?) "?". iExists _. iFrame.
+    iExists []. rewrite Forall_nil /has_layout_loc -H1. repeat iSplit => //.
+    rewrite /heap_mapsto_own_state heap_mapsto_eq /heap_mapsto_def /=.
+    iSplit => //. iApply (loc_in_bounds_shorten with "Hlib"). lia.
+  Qed.
+  Definition subsume_uninit_zeroed_inst := [instance subsume_uninit_zeroed].
+  Global Existing Instance subsume_uninit_zeroed_inst | 3.*)
+End zeroed.
+Notation "zeroed< ly >" := (zeroed ly)
+  (only printing, format "'zeroed<' ly '>'") : printing_sugar.
diff --git a/refinedVST/typing/constrained.v b/refinedVST/typing/constrained.v
new file mode 100644
index 0000000000..ed183d0be5
--- /dev/null
+++ b/refinedVST/typing/constrained.v
@@ -0,0 +1,175 @@
+From VST.typing Require Export type.
+From VST.typing Require Import programs optional.
+From VST.typing Require Import type_options.
+
+Class OwnConstraint `{!typeG Σ} {cs : compspecs} (P : own_state → mpred) : Prop := {
+  own_constraint_persistent : Persistent (P Shr);
+  own_constraint_share E : ↑shrN ⊆ E → P Own ={E}=∗ P Shr;
+}.
+
+Global Existing Instance own_constraint_persistent.
+
+Section own_constrained.
+  Context `{!typeG Σ} {cs : compspecs}.
+
+  Program Definition own_constrained (P : own_state → mpred) `{!OwnConstraint P} (ty : type) : type := {|
+    ty_has_op_type ot mt := ty.(ty_has_op_type) ot mt;
+    ty_own β l := (l ◁ₗ{β} ty ∗ P β)%I;
+     ty_own_val v := (v ◁ᵥ ty ∗ P Own)%I;
+  |}.
+  Next Obligation. iIntros (??????) "(H1 & H2)".
+                   iMod (ty_share with "[$H1]") as "$" => //.
+                   by iApply own_constraint_share.
+  Qed.
+  Next Obligation. iIntros (???????) "[? _]". by iApply ty_aligned. Qed.
+  Next Obligation. iIntros (???????) "(H & H1)". iFrame "H1". iApply (ty_deref with "[H]"); done. Qed.
+  Next Obligation. iIntros (?????????) "Hl [? $]". by iApply (ty_ref with "[//] [Hl]"). Qed.
+  
+  Global Instance own_constrained_rty_le P `{!OwnConstraint P} : Proper ((⊑) ==> (⊑)) (own_constrained P).
+  Proof. solve_type_proper. Qed.
+  Global Instance own_constrained_rty_proper P `{!OwnConstraint P} : Proper ((≡) ==> (≡)) (own_constrained P).
+  Proof. solve_type_proper. Qed.
+
+  (*
+  Global Instance own_constrained_loc_in_bounds ty β n P `{!OwnConstraint P} `{!LocInBounds ty β n} :
+    LocInBounds (own_constrained P ty) β n.
+  Proof.
+    constructor. iIntros (l) "[Hl _]". by iApply loc_in_bounds_in_bounds.
+  Qed.
+  *)
+  
+  Lemma copy_as_own_constrained l β P `{!OwnConstraint P} ty {HC: CopyAs l β ty} T:
+    (P β -∗ (HC T).(i2p_P)) ⊢ copy_as l β (own_constrained P ty) T.
+  Proof.
+    iIntros "HT [Hty HP]". iDestruct (i2p_proof with "(HT HP)") as "HT". by iApply "HT".
+  Qed.
+  Definition copy_as_own_constrained_inst := [instance copy_as_own_constrained].
+  Global Existing Instance copy_as_own_constrained_inst.
+
+  Lemma simplify_hyp_place_own_constrained P l β ty `{!OwnConstraint P} T:
+    (P β -∗ l ◁ₗ{β} ty -∗ T) ⊢ simplify_hyp (l◁ₗ{β} own_constrained P ty) T.
+  Proof. iIntros "HT [Hl HP]". by iApply ("HT" with "HP"). Qed.
+  Definition simplify_hyp_place_own_constrained_inst :=
+    [instance simplify_hyp_place_own_constrained with 0%N].
+  Global Existing Instance simplify_hyp_place_own_constrained_inst.
+
+  Lemma simplify_goal_place_own_constrained P l β ty `{!OwnConstraint P} T:
+    l ◁ₗ{β} ty ∗ P β ∗ T  ⊢ simplify_goal (l◁ₗ{β} own_constrained P ty) T.
+  Proof. iIntros "[$ [$ $]]". Qed.
+  Definition simplify_goal_place_own_constrained_inst :=
+    [instance simplify_goal_place_own_constrained with 0%N].
+  Global Existing Instance simplify_goal_place_own_constrained_inst.
+
+  Lemma simplify_hyp_val_own_constrained P v ty `{!OwnConstraint P} T:
+    (P Own -∗ v ◁ᵥ ty -∗ T) ⊢ simplify_hyp (v ◁ᵥ own_constrained P ty) T.
+  Proof. iIntros "HT [Hl HP]". by iApply ("HT" with "HP"). Qed.
+  Definition simplify_hyp_val_own_constrained_inst :=
+    [instance simplify_hyp_val_own_constrained with 0%N].
+  Global Existing Instance simplify_hyp_val_own_constrained_inst.
+
+  Lemma simplify_goal_val_own_constrained P v ty `{!OwnConstraint P} T:
+    v ◁ᵥ ty ∗ P Own ∗ T ⊢ simplify_goal (v ◁ᵥ own_constrained P ty) T.
+  Proof. iIntros "[$ [$ $]]". Qed.
+  Definition simplify_goal_val_own_constrained_inst :=
+    [instance simplify_goal_val_own_constrained with 0%N].
+  Global Existing Instance simplify_goal_val_own_constrained_inst.
+
+  Global Program Instance own_constrained_optional ty P optty ot1 ot2 `{!OwnConstraint P} `{!Optionable ty optty ot1 ot2} : Optionable (own_constrained P ty) optty ot1 ot2 := {|
+    opt_pre v1 v2 := opt_pre ty v1 v2
+  |}.
+  Next Obligation.
+    iIntros (???????[]?????) "Hpre H1 H2". 1: iDestruct "H1" as "[H1 _]".
+    - by iApply (opt_bin_op true with "Hpre H1 H2").
+    - by iApply (opt_bin_op false with "Hpre H1 H2").
+  Qed.
+
+  Global Instance optionable_agree_own_constrained P (ty2 : type) `{!OwnConstraint P} `{!OptionableAgree ty1 ty2} : OptionableAgree (own_constrained P ty1) ty2.
+  Proof. done. Qed.
+
+  Definition tyown_constraint (l : address) (ty : type) (β : own_state) : iProp Σ := l ◁ₗ{β} ty.
+
+  Global Program Instance tyown_constraint_own_constraint l ty: OwnConstraint (tyown_constraint l ty).
+  Next Obligation. move => ???. apply: ty_share. Qed.
+
+  Lemma simplify_hyp_place_tyown_constrained l β ty T:
+    (l ◁ₗ{β} ty -∗ T) ⊢ simplify_hyp (tyown_constraint l ty β) T.
+  Proof. iIntros "HT Hl". by iApply "HT". Qed.
+  Definition simplify_hyp_place_tyown_constrained_inst :=
+    [instance simplify_hyp_place_tyown_constrained with 0%N].
+  Global Existing Instance simplify_hyp_place_tyown_constrained_inst.
+
+  Lemma simplify_goal_place_tyown_constrained l β ty T:
+    l ◁ₗ{β} ty ∗ T ⊢ simplify_goal (tyown_constraint l ty β) T.
+  Proof. done. Qed.
+  Definition simplify_goal_place_tyown_constrained_inst :=
+    [instance simplify_goal_place_tyown_constrained with 0%N].
+  Global Existing Instance simplify_goal_place_tyown_constrained_inst.
+End own_constrained.
+Notation "own_constrained< P , ty >" := (own_constrained P ty)
+  (only printing, format "'own_constrained<' P ,  ty '>'") : printing_sugar.
+
+Global Typeclasses Opaque own_constrained tyown_constraint.
+Arguments tyown_constraint : simpl never.
+
+Section constrained.
+  Context `{!typeG Σ} {cs : compspecs}.
+
+  Definition persistent_own_constraint (P : mpred) (β : own_state) : mpred := □ P.
+
+  Global Instance persistent_own_constraint_inst P: OwnConstraint (persistent_own_constraint P).
+  Proof. constructor; [by apply _ | by iIntros (??) "H !>"]. Qed.
+
+  Lemma simplify_hyp_place_persistent_constrained P β T:
+    (P -∗ T) ⊢ simplify_hyp (persistent_own_constraint P β) T.
+  Proof. iIntros "HT #Hl". by iApply "HT". Qed.
+  Definition simplify_hyp_place_persistent_constrained_inst :=
+    [instance simplify_hyp_place_persistent_constrained with 0%N].
+  Global Existing Instance simplify_hyp_place_persistent_constrained_inst.
+
+  Lemma simplify_goal_place_persistent_constrained P `{!Persistent P} `{!Affine P} β T:
+    P ∗ T ⊢ simplify_goal (persistent_own_constraint P β) T.
+  Proof. iIntros "(H1 & H2)". iFrame "H2".
+         by iApply bi.intuitionistic.
+  Qed.
+  Definition simplify_goal_place_persistent_constrained_inst :=
+    [instance simplify_goal_place_persistent_constrained with 0%N].
+  Global Existing Instance simplify_goal_place_persistent_constrained_inst.
+End constrained.
+
+Global Typeclasses Opaque persistent_own_constraint.
+Arguments persistent_own_constraint : simpl never.
+
+Notation constrained ty P := (own_constrained (persistent_own_constraint P) ty).
+
+Notation "constrained< ty , P >" := (constrained ty P)
+  (only printing, format "'constrained<' ty ,  P '>'") : printing_sugar.
+
+Section nonshr_constrained.
+  Context `{!typeG Σ} {cs : compspecs}.
+
+  Definition nonshr_constraint (P : iProp Σ) (β : own_state) : iProp Σ :=
+    match β with | Own => P | Shr => True end.
+
+  Global Program Instance nonshr_constraint_own_constraint P: OwnConstraint (nonshr_constraint P).
+  Next Obligation. iIntros (???) "?". done. Qed.
+
+  Lemma simplify_hyp_place_nonshr_constrained P T:
+    (P -∗ T) ⊢ simplify_hyp (nonshr_constraint P Own) T.
+  Proof. iIntros "HT Hl". by iApply "HT". Qed.
+  Definition simplify_hyp_place_nonshr_constrained_inst :=
+    [instance simplify_hyp_place_nonshr_constrained with 0%N].
+  Global Existing Instance simplify_hyp_place_nonshr_constrained_inst.
+
+  Lemma simplify_goal_place_nonshr_constrained P T:
+    P ∗ T ⊢ simplify_goal (nonshr_constraint P Own) T.
+  Proof. done. Qed.
+  Definition simplify_goal_place_nonshr_constrained_inst :=
+    [instance simplify_goal_place_nonshr_constrained with 0%N].
+  Global Existing Instance simplify_goal_place_nonshr_constrained_inst.
+
+End nonshr_constrained.
+Notation "nonshr_constraint< P , β >" := (nonshr_constraint P β)
+  (only printing, format "'nonshr_constraint<' P ,  β '>'") : printing_sugar.
+
+Global Typeclasses Opaque nonshr_constraint.
+Arguments nonshr_constraint : simpl never.
diff --git a/refinedVST/typing/exist.v b/refinedVST/typing/exist.v
new file mode 100644
index 0000000000..b43b1507ee
--- /dev/null
+++ b/refinedVST/typing/exist.v
@@ -0,0 +1,116 @@
+From VST.typing Require Export type.
+From VST.typing Require Import programs optional.
+From VST.typing Require Import type_options.
+
+Definition ty_exists_rty_def `{!typeG Σ} {cs : compspecs} {A} (ty : A → type) (a : A) : type := ty a.
+Definition ty_exists_rty_aux : seal (@ty_exists_rty_def). by eexists. Qed.
+Definition ty_exists_rty := (ty_exists_rty_aux).(unseal).
+Definition ty_exists_rty_eq : ty_exists_rty = @ty_exists_rty_def := (ty_exists_rty_aux).(seal_eq).
+Arguments ty_exists_rty {_ _ _} _ _.
+
+Section tyexist.
+  Context `{!typeG Σ} {cs : compspecs} {A : Type}.
+  (* rty has to be sealed as unification goes crazy otherwise (it will
+  unify everything with tyexists). However rty_type must not use
+  opaque as it cannot be unified with A otherwise by typeclass
+  search. *)
+  Check ty_exists_rty.
+  Program Definition tyexists_type (ty : A → type) (x : A) : type := {|
+    ty_has_op_type := (ty x).(ty_has_op_type);
+    ty_own := (ty_exists_rty _ ty x).(ty_own); 
+    ty_own_val := (ty_exists_rty _ ty x).(ty_own_val); 
+  |}.
+  Next Obligation. move => *. rewrite ty_exists_rty_eq. by apply: ty_share. Qed.
+  Next Obligation. move => *. rewrite ty_exists_rty_eq. by apply: ty_aligned. Qed.
+  Next Obligation. move => *. rewrite ty_exists_rty_eq. by eapply ty_deref. Qed.
+  Next Obligation. move => *. rewrite ty_exists_rty_eq. by apply: ty_ref. Qed.
+
+  Definition tyexists (ty : A → type) : rtype _ := RType (tyexists_type ty).
+
+  Lemma tyexists_le_l ty (x : A) :
+    (x @ tyexists ty)%I ⊑ ty x.
+  Proof. rewrite /with_refinement/=/tyexists_type. by constructor => //=; simpl_type; rewrite ty_exists_rty_eq. Qed.
+  Lemma tyexists_le_r ty (x : A) :
+    ty x ⊑ (x @ tyexists ty)%I.
+  Proof. rewrite /with_refinement/=/tyexists_type. by constructor => //=; simpl_type; rewrite ty_exists_rty_eq. Qed.
+  Lemma tyexists_eq ty (x : A) :
+    (x @ tyexists ty)%I ≡@{type} ty x.
+  Proof. rewrite /with_refinement/=/tyexists_type. constructor => //=; simpl_type; by rewrite ty_exists_rty_eq. Qed.
+
+  Global Instance ty_exists_rty_le : Proper (pointwise_relation A (⊑) ==> (=) ==> (⊑)) tyexists_type.
+  Proof. move => ????? ->. etrans; [apply tyexists_le_l|]. etrans; [|apply tyexists_le_r]. done. Qed.
+  Global Instance ty_exists_rty_proper : Proper (pointwise_relation A (≡) ==> (=) ==> (≡)) tyexists_type.
+  Proof. move => ????? ->. etrans; [apply tyexists_eq|]. etrans; [|symmetry; apply tyexists_eq]. done. Qed.
+
+  (*
+  Global Instance tyexists_loc_in_bounds ty β n `{!∀ x, LocInBounds (ty x) β n} :
+    LocInBounds (tyexists ty) β n.
+  Proof.
+    constructor. iIntros (l) "Hl". unfold ty_of_rty; simpl_type. iDestruct "Hl" as (x) "Hl".
+    rewrite tyexists_eq. by iApply loc_in_bounds_in_bounds.
+  Qed.
+  *)
+End tyexist.
+
+Notation "'∃ₜ' x .. y , p" := (ty_of_rty (tyexists (fun x => .. (ty_of_rty (tyexists (fun y => p))) ..)))
+  (at level 200, x binder, right associativity,
+   format "'[' '∃ₜ'  '/  ' x  ..  y ,  '/  ' p ']'")
+  : bi_scope.
+
+Section tyexist.
+  Context `{!typeG Σ} {cs : compspecs} {A : Type}.
+
+  Lemma simplify_hyp_place_tyexists x l β (ty : A → _) T:
+    (l ◁ₗ{β} ty x -∗ T) ⊢ simplify_hyp (l◁ₗ{β} x @ tyexists ty) T.
+  Proof. iIntros "HT Hl". rewrite tyexists_eq. by iApply "HT". Qed.
+  
+  Definition simplify_hyp_place_tyexists_inst :=
+    [instance simplify_hyp_place_tyexists with 0%N].
+  Global Existing Instance simplify_hyp_place_tyexists_inst.
+
+  Lemma simplify_goal_place_tyexists x l β (ty : A → _) T:
+    l ◁ₗ{β} ty x ∗ T ⊢ simplify_goal (l◁ₗ{β} x @ tyexists ty) T.
+  Proof. iIntros "[? $]". by rewrite tyexists_eq. Qed.
+
+  Definition simplify_goal_place_tyexists_inst := [instance simplify_goal_place_tyexists with 0%N].
+  Global Existing Instance simplify_goal_place_tyexists_inst.
+
+  Lemma simplify_hyp_val_tyexists x v ty T :
+    (v ◁ᵥ ty x -∗ T) ⊢ simplify_hyp (v◁ᵥ x @ tyexists (A:=A) ty) T.
+  Proof. iIntros "HT Hl". rewrite tyexists_eq. by iApply "HT". Qed.
+
+  Definition simplify_hyp_val_tyexists_inst := [instance simplify_hyp_val_tyexists with 0%N].
+  Global Existing Instance simplify_hyp_val_tyexists_inst.
+
+  Lemma simplify_goal_val_tyexists x v ty T:
+    v ◁ᵥ ty x ∗ T ⊢ simplify_goal (v◁ᵥ x @ tyexists (A:=A) ty) T.
+  Proof. iIntros "[? $]". by rewrite tyexists_eq. Qed.
+
+  Definition simplify_goal_val_tyexists_inst := [instance simplify_goal_val_tyexists with 0%N].
+  Global Existing Instance simplify_goal_val_tyexists_inst.
+
+  Global Instance simple_subsume_place_tyexists_l (ty1 : A → _) x ty2
+    `{!SimpleSubsumePlace (ty1 x) ty2 P}:
+    SimpleSubsumePlace (x @ tyexists ty1) ty2 P.
+  Proof. iIntros (l β) "HP Hl". rewrite ! tyexists_eq. iApply (@simple_subsume_place with "HP Hl"). Qed.
+
+  Global Instance simple_subsume_place_tyexists_r (ty2 : A → _) x ty1
+    `{!SimpleSubsumePlace ty1 (ty2 x) P}:
+    SimpleSubsumePlace ty1 (x @ tyexists ty2) P.
+  Proof. iIntros (l β) "HP Hl". rewrite ! tyexists_eq. iApply (@simple_subsume_place with "HP Hl"). Qed.
+
+  Global Program Instance tyexist_optional x (ty : A → _) optty ot1 ot2
+    `{!∀ x, Optionable (ty x) optty ot1 ot2} : Optionable (x @ tyexists ty) optty ot1 ot2 := {|
+    opt_pre v1 v2 := opt_pre (ty x) v1 v2
+  |}.
+  Next Obligation.
+    move => ????????????. rewrite {1}/ty_own_val/= ty_exists_rty_eq /ty_has_op_type/ty_own_val. apply opt_bin_op.
+  Qed.
+  
+  Global Instance optionable_agree_tyexists (ty2 : A → type) ty1
+    `{!∀ x, OptionableAgree (ty2 x) ty1} : OptionableAgree (tyexists ty2) ty1.
+  Proof. done. Qed.
+
+End tyexist.
+
+Global Typeclasses Opaque tyexists_type tyexists.
diff --git a/refinedVST/typing/fixpoint.v b/refinedVST/typing/fixpoint.v
new file mode 100644
index 0000000000..5c7af502e3
--- /dev/null
+++ b/refinedVST/typing/fixpoint.v
@@ -0,0 +1,123 @@
+From VST.typing Require Export type.
+From VST.typing Require Import programs exist constrained.
+From VST.typing Require Import type_options.
+
+Definition type_fixpoint_def `{!typeG Σ} {cs : compspecs} {A} : ((A -> type) → (A -> type)) → (A → type) :=
+  λ T x, tyexists (λ ty, constrained (ty x) (⌜∀ x, ty x ⊑ T ty x⌝)).
+Definition type_fixpoint_aux : seal (@type_fixpoint_def). Proof. by eexists. Qed.
+Definition type_fixpoint := type_fixpoint_aux.(unseal).
+Global Arguments type_fixpoint {Σ _ _ A} _ _.
+Lemma type_fixpoint_unseal `{!typeG Σ} {cs : compspecs} {A} : type_fixpoint = @type_fixpoint_def Σ _ _ A.
+Proof. rewrite -type_fixpoint_aux.(seal_eq) //. Qed.
+
+Section fixpoint.
+  Context `{!typeG Σ} {cs : compspecs} {A : Type}.
+  Implicit Types (T : (A -> type) → (A -> type)).
+
+  Local Lemma type_fixpoint_own_eq T x l β :
+    l ◁ₗ{β} type_fixpoint T x ⊣⊢ ∃ ty, <affine>⌜∀ x, ty x ⊑ T ty x⌝ ∗ l ◁ₗ{β} ty x.
+  Proof.
+    rewrite type_fixpoint_unseal {1}/ty_own/=. f_equiv => ?.
+    rewrite tyexists_eq. rewrite /own_constrained/persistent_own_constraint; simpl_type.
+    iSplit.
+    - iIntros "($ & %H2)". by iApply bi.intuitionistically_elim.
+    - iIntros "(%H1 & $)". done.
+  Qed.
+
+  Local Lemma type_fixpoint_own_val_eq T x v :
+    v ◁ᵥ type_fixpoint T x ⊣⊢ ∃ ty, <affine>⌜∀ x, ty x ⊑ T ty x⌝ ∗ v ◁ᵥ ty x.
+  Proof.
+    rewrite type_fixpoint_unseal {1}/ty_own_val/=. f_equiv => ?.
+    rewrite tyexists_eq. rewrite /own_constrained/persistent_own_constraint; simpl_type.
+    iSplit.
+    - iIntros "($ & %H2)". by iApply bi.intuitionistically_elim.
+    - iIntros "(%H1 & $)". done.
+  Qed.
+
+  Lemma type_fixpoint_greatest T ty :
+    (∀ x, ty x ⊑ T ty x) →
+    ∀ x, ty x ⊑ type_fixpoint T x.
+  Proof.
+    move => Hle. constructor.
+    - iIntros (β l) "Hl". rewrite type_fixpoint_own_eq. iExists _. by iFrame.
+    - iIntros (v) "Hv". rewrite type_fixpoint_own_val_eq. iExists _. by iFrame.
+  Qed.
+
+  Lemma type_fixpoint_unfold_1 T `{!TypeMono T}:
+    ∀ x, type_fixpoint T x ⊑ T (type_fixpoint T) x.
+  Proof.
+    intros x. constructor => *.
+    - rewrite type_fixpoint_own_eq.
+      iIntros "Hle".
+      iDestruct "Hle" as (ty) "(%Hle & HA)".
+      destruct (Hle x) as [-> ?].
+      edestruct (TypeMono0 ty (type_fixpoint T)) as [Hown2 ?]; [|by iApply Hown2].
+      intros ?. by apply type_fixpoint_greatest.
+    - rewrite type_fixpoint_own_val_eq. iIntros "[%ty [%Hle HA]]".
+      destruct (Hle x) as [? ->].
+      edestruct (TypeMono0 ty (type_fixpoint T)) as [? Hown2]; [|by iApply Hown2].
+      intros ?. by apply type_fixpoint_greatest.
+  Qed.
+
+  Lemma type_fixpoint_unfold_2 T `{!TypeMono T} :
+    ∀ x, T (type_fixpoint T) x ⊑ type_fixpoint T x.
+  Proof.
+    intros x. constructor => *.
+    - rewrite type_fixpoint_own_eq. iIntros "?". iExists _. iSplit; [|done].
+      iPureIntro. intros. apply TypeMono0. intros ?. by apply type_fixpoint_unfold_1.
+    - rewrite type_fixpoint_own_val_eq. iIntros "?". iExists _. iSplit; [|done].
+      iPureIntro. intros. apply TypeMono0. intros ?. by apply type_fixpoint_unfold_1.
+  Qed.
+
+  Lemma type_fixpoint_unfold T x `{!TypeMono T} :
+    type_fixpoint T x ≡ T (type_fixpoint T) x.
+  Proof. apply (anti_symm (⊑)); [by apply type_fixpoint_unfold_1 | by apply type_fixpoint_unfold_2]. Qed.
+
+  Lemma type_fixpoint_unfold2 T x `{!TypeMono T}:
+    T (type_fixpoint T) x ≡ T (T (type_fixpoint T)) x.
+  Proof.
+    apply (anti_symm (⊑)); apply TypeMono0;
+      intros ?; [by apply type_fixpoint_unfold_1 | by apply type_fixpoint_unfold_2].
+  Qed.
+End fixpoint.
+
+Section fixpoint.
+  Context `{!typeG Σ} {cs : compspecs}.
+
+  Lemma type_fixpoint_proper {A} x1 x2 (T1 T2 : (A → type) → (A → type)) :
+    x1 = x2 → (∀ f x, T1 f x ≡ T2 f x) →
+    type_fixpoint T1 x1 ≡ type_fixpoint T2 x2.
+  Proof.
+    move => -> HT.
+    constructor => *.
+    - rewrite !type_fixpoint_own_eq. by setoid_rewrite HT.
+    - rewrite !type_fixpoint_own_val_eq. by setoid_rewrite HT.
+  Qed.
+End fixpoint.
+
+Global Typeclasses Opaque type_fixpoint.
+
+(*** Tests *)
+Local Set Default Proof Using "Type*".
+Section tests.
+  Context `{!typeG Σ} {cs : compspecs}.
+  Context (own_ptr : type → type) {HT: Proper ((⊑) ==> (⊑)) own_ptr}.
+
+  Definition fixpoint_test_rec : (nat → type) → (nat → type) := (λ self, λ n, own_ptr (self (S n))).
+  Arguments fixpoint_test_rec /.
+  Global Instance fixpoint_test_rec_ne : TypeMono fixpoint_test_rec.
+  Proof. solve_type_proper. Qed.
+
+  Definition fixpoint_test : rtype nat := {|
+    rty n := type_fixpoint fixpoint_test_rec n
+  |}.
+
+  Example test l :
+    l◁ₗ 0%nat @ fixpoint_test -∗ True.
+  Proof.
+    simpl. rewrite /with_refinement/= type_fixpoint_unfold/=.
+    change (type_fixpoint _ _) with (1%nat @ fixpoint_test)%I.
+    iIntros "H". done.
+  Qed.
+
+End tests.
diff --git a/refinedVST/typing/frontend_stuff/ANNOTATIONS.md b/refinedVST/typing/frontend_stuff/ANNOTATIONS.md
new file mode 100644
index 0000000000..25a36a29aa
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/ANNOTATIONS.md
@@ -0,0 +1,641 @@
+RefinedC type system annotation syntax
+======================================
+
+The RefinedC type system interfaces to the C language using:
+ - [C2X attributes](http://www.open-std.org/jtc1/sc22/wg14/www/docs/n2335.pdf)
+   of the form `[[rc::<ident>(<string>, ... ,<string>)]]`,
+ - macros defined in [`refinedc.h`](theories/examples/inc/refinedc.h) that are
+   provided as a shortcut for using certain specific attributes in the body of
+   functions,
+ - special comments of the form `//rc::<ident> <payload>?`.
+
+# Contents
+
+[[_TOC_]]
+
+# Valid attributes
+
+RefinedC attributes of the form `[[rc::<ident>(<string>, ... ,<string>)]]` can
+be placed on certain C constructs (e.g., on functions or on loops). Attributes
+of several kinds can be specified, they are distinguished using the identifier
+that they carry. Each specific kind of attribute is constrained as to where it
+may appear in the source code. For instance, postcondition attributes may only
+appear on a function definition or a function declaration. The following table
+gives information about every available kind of attributes, including how many
+arguments (i.e., strings) it may have, and what syntactic constructs it can be
+attached to.
+
+| Identifier     | Arguments   | Allowed on            | Syntax for the arguments                   |
+|----------------|-------------|-----------------------|--------------------------------------------|
+| `annot_args`   | One or more | Functions             | `<integer> ":" <integer> <coq_expr>`       |
+| `annot`        | Exactly one | Expressions           | Arbitrary Coq syntax                       |
+| `args`         | One or more | Functions             | `<type_expr>`                              |
+| `constraints`  | One or more | Structures, Loops     | `<constr>`                                 |
+| `ensures`      | One or more | Functions             | `<constr>`                                 |
+| `exists`       | One or more | Functions, Loops      | `<ident> ":" <coq_expr>`                   |
+| `let`          | One or more | Structures            | `<ident> {":" <coq_expr>`} "=" <coq_expr>  |
+| `field`        | Exactly one | Structure members     | `<type_expr>`                              |
+| `global`       | Exactly one | Global variables      | `<type_expr>`                              |
+| `immovable`    | None        | Structures            | N/A                                        |
+| `inv_vars`     | One or more | Loops                 | `<ident> ":" <type_expr>`                  |
+| `lemmas`       | One or more | Functions             | Argument for the Coq `apply:` tactic       |
+| `manual_proof` | Exactly one | Functions             | `<import_path> ":" <ident> "," <ident>`    |
+| `parameters`   | One or more | Functions, Structures | `<ident> ":" <coq_expr>`                   |
+| `typedef`      | Exactly one | Structures            | `<ident> ":" <type_expr>`                  |
+| `refined_by`   | One or more | Structures            | `<ident> ":" <coq_expr>`                   |
+| `requires`     | One or more | Functions             | `<constr>`                                 |
+| `returns`      | Exactly one | Functions             | `<type_expr>`                              |
+| `size`         | Exactly one | Structures            | `<coq_expr>`                               |
+| `skip`         | None        | Functions             | N/A                                        |
+| `tactics`      | One or more | Functions             | Arbitrary _Ltac_ tactic                    |
+| `tagged_union` | Exactly one | Structures            | `<coq_expr>`                               |
+| `trust_me`     | None        | Functions             | N/A                                        |
+| `union_tag`    | Exactly one | Union members         | `<ident> {"(" <ident> ":" <coq_expr> ")}*` |
+| `unfold_order` | Exactly one | Structures            | `<integer>`                                |
+
+Note that only the attributes requiring one or more arguments may be used more
+than once in the annotations for a particular C construct.
+
+**Remark:** the ordering of attributes does not matter except between those of
+the same kind. Having several attributes of a repeatable kind is equivalent to
+having a single one carrying all the combined arguments (in attributes order).
+As an example, the annotations on the following functions are equivalent.
+```c
+[[rc::parameters("i : Z")]]
+[[rc::args("int<i32>", "i @ int<i32>")]] // Spec for the two arguments.
+[[rc::returns("i @ int<i32>")]]
+int snd_0(int x, int y){
+  return y;
+}
+
+[[rc::parameters("i : Z")]]
+[[rc::args("int<i32>")]] // Spec for the first argument.
+[[rc::args("i @ int<i32>")]] // Spec for the second argument.
+[[rc::returns("i @ int<i32>")]]
+int snd_1(int x, int y){
+  return y;
+}
+
+[[rc::args("int<i32>")]] // Spec for the first argument.
+[[rc::parameters("i : Z")]]
+[[rc::args("i @ int<i32>")]] // Spec for the second argument.
+[[rc::returns("i @ int<i32>")]]
+int snd_2(int x, int y){
+  return y;
+}
+```
+
+**Remark:** attributes on functions may be placed either on its declaration or
+on its definition (or a combination of both).
+
+
+# Placement of attributes
+
+As show in the above examples, annotations on functions are placed immediately
+before their definitions and/or declarations. And things go similarly for most
+of the annotations, including those on loops, structure or union members. Note
+that in all these cases, there should be no blank line interleaved between the
+annotations themselves, or between the annotations and the element of C syntax
+to which they will be attached.
+
+In fact, there is only one kind of annotation for which the annotation must be
+given in a somewhat unexpected place: structures. On a structure attributes do
+not precede the declaration, they are placed right after the `struct` keyword.
+An example of this is given below.
+```c
+struct
+[[rc::refined_by("r : nat", "g : nat", "b : nat")]]
+color {
+  [[rc::field("r @ int<u8>")]]
+  uint8_t r;
+
+  [[rc::field("g @ int<u8>")]]
+  uint8_t g;
+
+  [[rc::field("b @ int<u8>")]]
+  uint8_t b;
+};
+```
+
+
+# Description of the attributes
+
+In the following we describe the syntax and semantics for the arguments of the
+supported attributes. The syntax will be described using a BNF-like format. We
+will rely on the grammar defined in the following section.
+
+## `rc::annot_args` (for advanced users)
+
+This annotation appears on functions only and has at least one argument. Every
+argument is of the following form.
+```
+<integer (as argument index)> ":" <integer (as payload)> <coq_expr (as payload)>
+```
+It contains a first integer, corresponding to the index of an argument (of the
+function), and an annotation payload built of a natural number and a Coq term.
+
+The annotation has the effect of attaching the specified payloads to effective
+arguments of the function when it is called.
+
+## `rc::annot` (for advanced users)
+
+This annotation appears on toplevel expressions (treated as statements) and it
+must only have a single, arbitrary string argument, that is interpreted as raw
+Coq code.
+
+The annotation has the effect of attaching the given payload to the expression
+it is attached to. Note that the `rc::annot` should only be use through macros
+defined in [`refinedc.h`](theories/examples/inc/refinedc.h).
+
+## `rc::args`
+
+This annotation appears on functions only, and requires one or more arguments.
+Each argument is of the following form
+```
+<type_expr (as argument type)>
+```
+and it specifies the refinement type that is associated with the corresponding
+argument of the function (in order). There must be exactly as many argument of
+`rc::args` annotations as there are arguments to the function.
+
+## `rc::constraints`
+
+This annotation may appear on structures and on loops, and it must have one or
+more arguments. Each argument is of the following form
+```
+<constr>
+```
+and it specifies a constraint that should be satisfied. On a structure, such a
+constraint is checked for all expressions of the corresponding structure type.
+On a loop, a constraint is part of the loop invariant and it must hold through
+the whole loop.
+
+## `rc::ensures`
+
+This annotation appears on functions only, and requires one or more arguments.
+Each argument is of the following form
+```
+<constr (as post-condition)>
+```
+and it specifies a post-condition (i.e., the constraint should hold after that
+the function has returned).
+
+## `rc::exists`
+
+This annotation may appear on functions, loops and structs. It should carry at least
+one argument, and its arguments should all be of the following form.
+```
+<ident (as variable name)> ":" <coq_expr (as Coq type)>
+```
+It corresponds to an existentially quantified variable with the given type. On
+a function, this variable can only appear in post-conditions and on the return
+type of the function (see `rc::ensures` and `rc::returns`). On the other hand,
+when used on a loop, the variable is bound in the whole invariant.
+
+## `rc::let`
+
+This annotation may appear on structures and should have at least one argument
+of the following form.
+```
+<ident (as variable name)> {":" <coq_expr (as Coq type)>} "=" <coq_expr>
+```
+It corresponds to a Coq let-binding with an optional type annotation. All such
+bindings are inserted in the type definition under the existentials (specified
+with `rc::exists`).
+
+## `rc::field`
+
+This annotation only appears on structure members, and it requires exactly one
+argument of the following form.
+```
+<type_expr (as field type)>
+```
+and it specifies the refinement type that corresponds to the structure member.
+Note that a `rc::field` annotation must be given for all structure fields that
+are involved in the definition of a refinement type.
+
+## `rc::global`
+
+This annotation appears only on global variable declarations, and it must have
+a single argument of the following form.
+```
+<type_expr (as global variable type)>
+```
+It gives the refinement type corresponding to the global variable.
+
+## `rc::immovable`
+
+This annotation appears only on structures, and it does not expect arguments.
+It makes the type as immovable, which prevents the generation of unfolding
+lemmas for value type assignments.
+
+## `rc::inv_vars`
+
+This annotation appears only on loops, and it carry one or more arguments. The
+arguments should all be of the following form.
+```
+<ident (as C local variable name)> ":" <type_expr (as the variable type)>
+```
+Here, the identifier should correspond to a local C variable (arguments of the
+current function are included), and the annotation specifies the corresponding
+refinement type for the variable during the loop.
+
+**Remark:** if a C function argument is not specified then it is automatically
+annotated with its type in the function specification (see `rc::args`). On the
+other hand, this behaviour is overridden when a specific type is specified.
+
+## `rc::lemmas`
+
+This annotation appears on functions exclusively, and it must have one or more
+arguments. Every argument is expected to be a valid parameter for the `apply:`
+Coq tactic, but the syntax is otherwise arbitrary. In general, this annotation
+can be used to specified lemmas that RefinedC's automation will try to use (to
+solve accumulated side-conditions).
+
+## `rc::manual_proof`
+
+This annotation appears on functions only, and requires a single argument. The
+argument should be of the following form.
+```
+<import_path> ":" <ident (as module name)> "," <ident (as theorem name)>
+```
+This annotation instructs the system that the function will be proved manually
+by the user. The argument gives the name of the user-written typing lemma (the
+last identifier), together with the qualification path and name for the module
+where it is defined.
+
+For example, `[[rc::manual_proof("x.y : z, thm")]]` will lead to the following
+Coq import to bring theorem `thm` in scope: `From x.y Require Import z.`.
+
+## `rc::parameters`
+
+This annotation can appear either on functions and on structures. It should be
+given at least one argument of the following form.
+```
+<ident (as variable name)> ":" <coq_expr (as Coq type)>
+```
+It corresponds to an universally quantified variable with the given type. When
+on a function, such a variable is bound in the whole specification. Similarly,
+on structures such variables are bound in the refinement type corresponding to
+the structure. (A refinement type is generated for all annotated structures.)
+
+## `rc::typedef`
+
+This annotation only appears on structures, and it expects one argument of the
+following form.
+```
+<ident (as pointer type name)> : <type_expr (as type wrapper containing an ellipsis)>
+```
+The identifier should correspond to the name defined (using a `typedef`) for a
+pointer to a structure in the C code. When given, this annotation instructs the
+system to generate a refinement type corresponding to the pointer type instead
+of the structure directly. The type expression specified inside the annotation
+should contain an ellipsis (i.e., a type expression of the form `...`), in the
+place where the type that would have been generated of the structure is put in
+the generated type.
+
+## `rc::refined_by`
+
+This annotation appears on structures exclusively, and it must be given one or
+more arguments of the following form.
+```
+<ident (as variable name)> : <coq_expr (as Coq type)>
+```
+When annotations are provided on a structure,  a corresponding refinement type
+is automatically generated. The idea is that an element of the structure has a
+refinement formed of (a tuple of) mathematical (i.e., Coq) values. Each of the
+arguments of the `rc::refined_by` annotation specify such a value, with a name
+and a type. The name is bound in constraints as also in field annotations (see
+`rc::field`) on the structure (and on nested structures).
+
+## `rc::requires`
+
+This annotation appears on functions only, and requires one or more arguments.
+Each argument is of the following form
+```
+<constr (as pre-condition)>
+```
+and it specifies a pre-condition (i.e., the constraint should hold at the call
+sites of the function).
+
+## `rc::returns`
+
+This annotation appears on functions only,  and it should be given exactly one
+argument of the following form.
+```
+<type_expr (as return type)>
+```
+The argument specifies the refinement type corresponding to the value returned
+by the function.
+
+## `rc::size`
+
+This annotation appears on structures exclusively, and it should carry exactly
+one argument of the following form.
+```
+<coq_expr (as RefinedC layout)>
+```
+The given Coq expression should correspond to a RefinedC layout. If `rc::size`
+is given on a structure, the produced type is considered to be padded so as to
+occupy the same space as the specified layout.
+
+## `rc::skip`
+
+This annotation can only appear on functions, and it expects no argument. When
+given, no specification nor proof script is generated for the function.
+
+**Remark:** This is the default behaviour when a function has no annotation.
+
+## `rc::tactics`
+
+This annotation appears on functions only, and requires one or more arguments.
+Each argument is expected to be valid _LTac_ that is inlined at the end of the
+proof script for the function (to prove remaining side-conditions).
+
+## `rc::tagged_union`
+
+This annotation appears on structures exclusively, and it should carry exactly
+one argument of the following form.
+```
+<coq_expr (as Coq inductive type)>
+```
+When given, this annotation marks the structure as representing a tagged union
+refined by a Coq expression of the specified inductive type.
+
+## `rc::trust_me`
+
+This annotation can only appear on functions, and it expects no argument. When
+given, no proof script is generated for the function and the system trusts the
+user that the function adheres to its specification.
+
+## `rc::union_tag`
+
+This annotation appears on union members only, and it should carry exactly one
+argument of the following form.
+```
+<ident (as variant name)> {"(" <ident (as variable name)> ":" <coq_expr (as Coq type)> ")}*
+```
+The identifier gives the name of the Coq variant that will refine the  current
+union member. Note that the annotation should also contain the type of all the
+arguments of the variant, together with a name. This name can be used to refer
+to the corresponding parameter in annotations on nested structures.
+
+## `rc::unfold_order`
+
+This annotation appears only on structures, and should carry exactly one integer
+argument. This integers specifies in which order this type should be unfolded
+relative to other types. Lower numbers are unfolded first and the default is 100.
+
+
+# Grammar for annotations
+
+The annotations described above rely on a custom syntax providing classes like
+constraints or type expressions (i.e., `<constr>` or `<type_expr>`). These new
+syntactic constructs will be presented here along with their semantics.
+
+## Basic tokens
+
+Our syntax makes use of the following regular expressions.
+
+```
+<ident>   ::= Regexp([A-Za-z_][A-Za-z_0-9]+) | "void*"
+<ty_name> ::= Regexp(&?[A-Za-z_][A-Za-z_0-9]+)
+<integer> ::= Regexp([0-9]+)
+```
+They range over general-purpose identifiers (for `<ident>`), over "type names"
+(for `<ty_name>`), and over positive integer respectively (for `<integer>`).
+
+We also define the following grammar for Coq import paths.
+
+```
+<import_path> ::= ident> {"." <ident>}*
+```
+They are currently only used in `rc::manual_proof` annotations.
+
+Some of the constructs for type expressions require a notion of pattern. It is
+defined as a tuple of variable name.
+```
+<pattern> ::=
+  | "(" ")"
+  | <ident (as variable name)>
+  | "(" <ident (as variable name)> {"," <ident (as variable name)>}+ ")"
+```
+
+## Embedded Coq syntax
+
+An important point about the syntax used in RefinedC annotations is that it is
+eventually compiled down to Coq. A consequence of this is that pure Coq syntax
+can (and sometimes must) be used among annotations. In particular, Coq is used
+to express mathematical properties that are themselves part of function specs.
+For example, you need to rely on Coq to express mathematical facts such as the
+following: `n + m ≠ 42 × k`, `l1 ++ l2 ≠ []`, `P x ∧ Q y`. Inside annotations,
+Coq syntax will be entered using different quotation mechanisms.
+```
+<pure_term> ::= "{" ... "}"    // (well-bracketed)
+<iris_term> ::= "[" ... "]"    // (well-bracketed)
+```
+In particular, pure Coq terms will often be entered by simply surrounding them
+with braces. No particular parsing is done for such terms, it is only enforced
+that they are well-bracketed for braces. As a consequence `{n + m = n + m}` or
+`{Α ∧ B}` are valid quoted Coq terms (if placed in a satisfactory scope). Note
+that it is also possible to quote Coq terms using square brackets, but in that
+case the wrapped Coq expression is expected to be an Iris proposition.
+
+As it is very common to use Coq identifiers (e.g., variable or type names), it
+is often not necessary to explicitly quote then using braces.
+```
+<coq_expr> ::=
+  | <ident>
+  | <pure_term>
+```
+
+## Type expressions
+
+RefinedC type expressions are one of the main syntactic categories that we use
+in annotations. They are defined as follows.
+```
+<type_expr> ::=
+  | <ident (as type name)> {"<" ">"}?
+  | <ty_name (as type name)> "<" <type_expr_arg> {"," <type_expr_arg>}* ">"
+  | <coq_expr (as Coq value)> "@" <type_expr>
+  | "∃" <ident (as variable name)> {":" <coq_expr (as Coq type)>}? "." <type_expr>
+  | <type_expr> "&" <constr>
+  | <pure_term (as type expression)>
+  | "..."
+  | "(" <tupe_expr> ")"
+```
+
+Note that type names include type constructors related to ownership. There are
+three forms of pointer types:
+ - owned pointers (of the form `&own<T>`),
+ - shared pointers (of the form `&shr<T>`),
+ - and fractional pointer (of the form `&frac<q, T>`).
+
+### Type constuctor application
+
+There are roughly eight different type expression constructors. The first one,
+which encompasses the first two rules of `<type_expr>` is the application of a
+defined type constructor to an arbitrary list of arguments (possibly zero, and
+in that case the angle brackets surrounding the arguments may be left out).
+
+Note that the arguments to defined type constructors are not type expressions,
+but type expressions arguments (of class `<type_expr_arg>`).
+```
+<type_expr_arg> ::=
+  | <type_expr>
+  | "λ" <pattern> {":" <coq_expr (as Coq type)>}? "." <type_expr_arg>
+```
+They include type expressions themselves, but also allow for parametrized type
+expressions, built using a λ-abstraction.
+
+**Remark:** there is some special support for certain type constructors. There
+is some discussion on that in a further section.
+
+### Refinements
+
+The fourth type expression constructor, of the form `v @ T`, is central to the
+refinement type approach of RefinedC. It roughly denotes a singleton type. For
+example, `{n} @ int<i32>` (or equivalently `n @ int<i32>`) denotes the type of
+32-bits (signed) integers that are refined by mathematical integer `n`.
+
+**Remark:** if type expression `T` is refined by a Coq value of (Coq) type `A`
+then `T` is equivalent to `∃ v. v @ T` (using an existential type).
+
+### Existential types
+
+The fifth type expression constructor corresponds to existential types. In the
+system, existential types can range over anything (including types). Note that
+the type of the domain of existential quantifiers can be annotated using a Coq
+type, but this is not mandatory (type inference often does a good job).
+
+### Constrained types
+
+The sixth type expression constructor corresponds to constrained types, having
+the form `T & C`, where `C` is a constraint (see the next sub-section). Values
+of type `T & C` are expected to both have type `T` and to satisfy `C`.
+
+### Other constructors
+
+The last three type expressions constructors respectively correspond to quoted
+Coq code (interpreted as a type expression), type ellipses, and parentheses. A
+type expression ellipsis is only meaningful in a `rc::typedef` annotation.
+
+**Note on parsing priorities:** Binders always have the largest possible scope
+and refinements (i.e., `@`) binds stronger than consrtains (i.e., `&`).
+
+## Constraints
+
+The syntax of constraints is defined below.
+```
+<constr> ::=
+  | <iris_term (as Iris proposition)>
+  | <pure_term (as Coq proposition)>
+  | "∃" <ident (as variable name)> {":" <coq_expr (as Coq type)>}? "." <constr>
+  | "own" <ident (as variable name)> ":" <type_expr>
+  | "shr" <ident (as variable name)> ":" <type_expr>
+  | "frac" <coq_expr (as ownstate)> <ident (as variable name)> ":" <type_expr>
+  | <ident (as variable name)> ":" <type_expr>
+  | "global" <ident (as C global variable name> ":" <type_expr>
+```
+A constraint can be formed using either:
+ - a (quoted) Iris proposition,
+ - a (quoted) Coq proposition,
+ - an existential quantifier,
+ - a pointer ownership statement (translated to a location type assignment),
+ - a location type assignment for an owned location,
+ - a location type assignment for a shared location,
+ - a location type assignment for a frac location,
+ - a value type assignment,
+ - a typing constraint for a global variable.
+
+**Remark:** a constraint of the form `{...}` is a short-hand for `[⌜...⌝]`, in
+which `⌜...⌝` is the notation used to inject Coq proposition into `iProp` (the
+type of Iris propositions).
+
+
+# Special support
+
+There is some special support for predefined type constructors:
+ - `optional<ty>` is syntactic sugar for `optional<ty, {null}>`.
+ - similarly, `optionalO<ty>` is syntactic sugar for  `optionalO<ty, {null}>`.
+ - `struct<{layout}, ty1, ..., tyN>` builds a structure type, using the layout
+   `layout` and the fields `ty1, ...,tyN`.
+
+# Annotations using macros
+
+The macro `rc_unfold_int(i)` can be used to extend the context with the
+hypothesis that some integer parameter `i` is in the appropriate range.
+Note that this is only useful if `i` has not yet been accessed, since the
+hypothesis is added to the context on the first access.
+
+# Annotations using comments
+
+Special comments can be used to import external Coq dependencies as well as
+for inlining Coq definitions in the generated code.
+
+## Importing dependencies
+
+To require a Coq module (`From <library> Require Import <modpath>`) in the
+generated files, the following annotation can be used.
+```c
+//@rc::import <modpath> from <library>
+```
+
+By default the import is done in all the specification and proof files, but a
+modifier can be used to only import the module in proof files, or only in the
+code file.
+```c
+//@rc::import <modpath> from <library> (for proofs only)
+//@rc::import <modpath> from <library> (for code only)
+```
+
+Note that it is not directly possible to import Coq modules from theories
+defined in the same RefinedC project. To do so, one must first use a directive
+like the following.
+```c
+//@rc::require <modpath>
+```
+
+## Context directive
+
+The Coq context (in spec and proof sections) using the following annotation:
+```c
+//@rc::context <context_item> ... <context_item>
+```
+
+## Inlined Coq code
+
+An arbitrary line of Coq code can be inlined in the generated specification
+file using the following syntax (for single of multiple lines).
+```c
+//@rc::inlined <code line>
+
+//@rc::inlined
+//@<code line 1>
+//@<code line 2>
+//@<code line 3>
+//@rc::end
+```
+With `rc::inlined`, the code is inserted at the beginning of the main section
+of the specification file.
+
+To inline Coq code at the beginning of the file (before the section) you can
+use the tag `rc::inlined_prelude` instead. This is typically useful when you
+want to define a notation (and want it to be available in proof files).
+
+To inline Coq code at the end of the file (after the section) you can use the
+tag `rc::inlined_final` instead.
+
+## Type definition
+
+A type definition without a struct can be made using the following syntax.
+```c
+//rc::typedef <ident> := <type_expr>
+```
+
+Refinements, parameters, and the `unfold_order` and `immovable` attributes
+can be given as well as follows. Note that the types `R`, `S`, `X`, and `Y` are
+parsed as `coq_expr`, so they might need to be wrapped in `{...}`.
+```c
+//rc::typedef (r:R, s:S) @ tree<x:X, y:Y> [unfold_order(90)] [immovable] := ...
+```
diff --git a/refinedVST/typing/frontend_stuff/FAQ.md b/refinedVST/typing/frontend_stuff/FAQ.md
new file mode 100644
index 0000000000..139d84f779
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/FAQ.md
@@ -0,0 +1,54 @@
+The type system gets stuck on a sidecondition which contains an existential quantifier, what should I do? 
+--------------------------------------------------------------------------------------------------------------
+
+See `tutorial/t02_evars.c` for an explanation how to RefinedC's
+mechanism for instantiating existential quantifiers works. This file
+also explains different strategies for guiding RefinedC towards the
+right instantiation of existential quantifiers.
+
+How do I add additional simplification rules?
+---------------------------------------------
+
+The simplification rules can be extended by the user through special
+typeclasses such as `SimplBoth`, `SimplAnd` and `SimplImpl`. See the
+file
+[theories/lithium/simpl_instances.v](theories/lithium/simpl_instances.v)
+for the definition and many instances. Keep in mind the simplification
+rules should in general be bi-implications to avoid accidentally
+turning a provable goal into an unprovable.
+
+
+How do I debug the simplification mechanism?
+--------------------------------------------
+When adding such simplification rules, the system may still get stuck and it
+may be useful to understand why. To this aim, you can step through the proof
+manually until it gets stuck
+```
+repeat liRStep; liShow.
+```
+and then enable typeclass debugging.
+```
+Set Typeclasses Debug.
+(*Set Typeclasses Debug Verbosity 2.*)
+try liRStep.
+```
+
+Why does `ContainsEx` contain an evar?
+----------------------------------------------
+
+Simplification rules will sometimes have an argument of the following form:
+```
+`{!ContainsEx (some coq term)}
+```
+Do not forget the `!` here. Otherwise weird things happen.
+
+Why don't I get as an hypothesis that an integer parameter is in range?
+-----------------------------------------------------------------------
+
+The hypotheses that the integer parameters are in range are only added to the
+context on the first time the parameter is accessed. If such an hypothesis is
+required prior to a first access, you can use the following macro to make it
+available.
+```c
+rc_unfold_int(i);
+```
diff --git a/refinedVST/typing/frontend_stuff/Makefile b/refinedVST/typing/frontend_stuff/Makefile
new file mode 100644
index 0000000000..a4654a1436
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/Makefile
@@ -0,0 +1,47 @@
+all:
+	@dune build _build/default/refinedc.install --display short
+.PHONY: all
+
+all_with_examples: generate_all
+	@dune build --display short
+.PHONY: all_with_examples
+
+install:
+	@dune install
+.PHONY: install
+
+uninstall:
+	@dune uninstall
+.PHONY: uninstall
+
+C_SRC = $(wildcard examples/*.c)
+
+%.c.gen: %.c phony
+	@dune exec -- refinedc check $<
+.PHONY: phony
+
+generate_all: $(addsuffix .gen, $(C_SRC))
+.PHONY: generate_all
+
+check_generate_all: generate_all
+	git diff --exit-code
+.PHONY: check_generate_all
+
+clean_generated:
+	@for FILE in ${C_SRC} ; do dune exec -- refinedc clean --soft $$FILE ; done
+	@rm -f $(addsuffix .gen, $(C_SRC))
+.PHONY: clean_generated
+
+clean: clean_generated
+	@dune clean
+.PHONY: clean
+
+# We cannot use builddep-pins as a dependency of builddep-opamfiles because the CI removes all pins.
+builddep-pins:
+	@opam pin add -n -y cerberus-lib "git+https://github.com/rems-project/cerberus.git#57c0e80af140651aad72e3514133229425aeb102"
+	@opam pin add -n -y cerberus "git+https://github.com/rems-project/cerberus.git#57c0e80af140651aad72e3514133229425aeb102"
+.PHONY: builddep-pins
+
+builddep-opamfiles: builddep/refinedc-builddep.opam
+	@true
+.PHONY: builddep-opamfiles
\ No newline at end of file
diff --git a/refinedVST/typing/frontend_stuff/coq-caesium-config-no-align.opam b/refinedVST/typing/frontend_stuff/coq-caesium-config-no-align.opam
new file mode 100644
index 0000000000..3104792032
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/coq-caesium-config-no-align.opam
@@ -0,0 +1,22 @@
+opam-version: "2.0"
+name: "coq-caesium-config-no-align"
+synopsis: "Configuration package to configure Caesium to not use alignment"
+description: """
+Installing this package instructs the refinedc package to disable alignment in the Caesium C semantics.
+"""
+license: "BSD-3-Clause"
+
+maintainer: ["Michael Sammler <msammler@mpi-sws.org>"]
+authors: ["Michael Sammler" "Rodolphe Lepigre" "Kayvan Memarian"]
+
+homepage: "https://plv.mpi-sws.org/refinedc"
+bug-reports: "https://gitlab.mpi-sws.org/iris/refinedc/issues"
+dev-repo: "git+https://gitlab.mpi-sws.org/iris/refinedc.git"
+
+conflict-class: [ "coq-caesium-config" ]
+
+depends: [
+]
+
+build: [
+]
diff --git a/refinedVST/typing/frontend_stuff/dune b/refinedVST/typing/frontend_stuff/dune
new file mode 100644
index 0000000000..737e0aedd2
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/dune
@@ -0,0 +1,13 @@
+; Add project-wide flags here.
+(env
+ (dev
+  (binaries (tools/coqc_timing.sh as coqc))
+  (flags :standard))
+ (release
+  (binaries (tools/coqc_timing.sh as coqc))
+  (flags :standard)))
+
+(install
+ (files FAQ.md ANNOTATIONS.md)
+ (section doc)
+ (package refinedc))
diff --git a/refinedVST/typing/frontend_stuff/dune-project b/refinedVST/typing/frontend_stuff/dune-project
new file mode 100644
index 0000000000..f198e1c989
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/dune-project
@@ -0,0 +1,5 @@
+(lang dune 3.8)
+(name refinedc)
+(package (name refinedc))
+(package (name coq-caesium-config-no-align) (allow_empty))
+(using coq 0.8)
diff --git a/refinedVST/typing/frontend_stuff/examples/test_f_temps.c b/refinedVST/typing/frontend_stuff/examples/test_f_temps.c
new file mode 100644
index 0000000000..ea57480471
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/examples/test_f_temps.c
@@ -0,0 +1,12 @@
+int main() {
+}
+
+// spec adapated from t02_evars.c
+[[rc::exists("n : Z")]]
+// this "int tint" annotation would be invalid in refinedc frontend; was "int<i32>"
+[[rc::returns("n @ int<tint>")]]
+[[rc::ensures("{n = 42}")]]
+int f_temps() {
+    int a = 1;
+    return a + 41;
+}
\ No newline at end of file
diff --git a/refinedVST/typing/frontend_stuff/frontend/ail_to_coq.ml b/refinedVST/typing/frontend_stuff/frontend/ail_to_coq.ml
new file mode 100644
index 0000000000..b317786238
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/frontend/ail_to_coq.ml
@@ -0,0 +1,1551 @@
+open Cerb_frontend
+open Extra
+open Panic
+open Coq_ast
+open Rc_annot
+
+type typed_ail = GenTypes.genTypeCategory AilSyntax.ail_program
+type ail_expr  = GenTypes.genTypeCategory AilSyntax.expression
+type c_type    = Ctype.ctype
+type i_type    = Ctype.integerType
+type type_cat  = GenTypes.typeCategory
+type loc       = Cerb_location.t
+
+let c_type_of_type_cat : type_cat -> c_type = fun tc ->
+  match tc with
+  | GenTypes.LValueType(_,c_ty,_) -> c_ty
+  | GenTypes.RValueType(c_ty)     -> c_ty
+
+let to_type_cat : GenTypes.genTypeCategory -> type_cat = fun tc ->
+  let loc = Cerb_location.unknown in
+  let impl = Ocaml_implementation.hafniumIntImpl in
+  let m_tc = GenTypesAux.interpret_genTypeCategory loc impl tc in
+  match ErrorMonad.runErrorMonad m_tc with
+  | Either.Right(tc) -> tc
+  | Either.Left(_,_) -> assert false (* FIXME possible here? *)
+
+let gen_type_to_c_type : GenTypes.genType -> c_type = fun gt ->
+  let loc = Cerb_location.unknown in
+  let impl = Ocaml_implementation.hafniumIntImpl in
+  let m_c_ty = GenTypesAux.interpret_genType loc impl gt in
+  match ErrorMonad.runErrorMonad m_c_ty with
+  | Either.Right(c_ty) -> c_ty
+  | Either.Left(_,_)   -> assert false (* FIXME possible here? *)
+
+let tc_of : ail_expr -> type_cat = fun e ->
+  let AilSyntax.AnnotatedExpression(ty,_,_,_) = e in to_type_cat ty
+
+let loc_of : ail_expr -> loc = fun e ->
+  let AilSyntax.AnnotatedExpression(_,_,loc,_) = e in loc
+
+let not_impl loc fmt = panic loc ("Not implemented: " ^^ fmt)
+
+let forbidden loc fmt = panic loc ("Forbidden: " ^^ fmt)
+
+(* Short names for common functions. *)
+let sym_to_str : Symbol.sym -> string =
+  Pp_symbol.to_string_pretty
+
+let id_to_str : Symbol.identifier -> string =
+  fun Symbol.(Identifier(_,id)) -> id
+
+let loc_of_id : Symbol.identifier -> loc =
+  fun Symbol.(Identifier(loc,_)) -> loc
+
+(* Register a location. *)
+let register_loc : Location.Pool.t -> loc -> Location.t = fun p loc ->
+  match Cerb_location.(get_filename loc, to_cartesian loc) with
+  | (Some(f), Some((l1,c1),(0 ,0 ))) -> Location.make f l1 c1 l1 c1 p
+  | (Some(f), Some((l1,c1),(l2,c2))) -> Location.make f l1 c1 l2 c2 p
+  | (_      , _                    ) -> Location.none coq_locs
+
+let register_str_loc : Location.Pool.t -> loc -> Location.t = fun p loc ->
+  match Cerb_location.(get_filename loc, to_cartesian loc) with
+  | (Some(f), Some((l1,c1),(l2,c2))) -> Location.make f l1 (c1+1) l2 (c2-1) p
+  | (_      , _                    ) -> Location.none coq_locs
+
+let mkloc elt loc = Location.{ elt ; loc }
+
+let noloc elt = mkloc elt (Location.none coq_locs)
+
+(* Extract attributes with namespace ["rc"]. *)
+let collect_rc_attrs : Annot.attributes -> rc_attr list =
+  let fn acc Annot.{attr_ns; attr_id; attr_args} =
+    match Option.map id_to_str attr_ns with
+    | Some("rc") ->
+        let rc_attr_id =
+          let Symbol.(Identifier(loc, id)) = attr_id in
+          mkloc id (register_loc rc_locs loc)
+        in
+        let rc_attr_args =
+          let fn (loc, s, pieces) =
+            let locate (loc, s) = mkloc s (register_str_loc rc_locs loc) in
+            let rc_attr_arg_value = mkloc s (register_str_loc rc_locs loc) in
+            let rc_attr_arg_pieces = List.map locate pieces in
+            {rc_attr_arg_value; rc_attr_arg_pieces}
+          in
+          List.map fn attr_args
+        in
+        {rc_attr_id; rc_attr_args} :: acc
+    | _          -> acc
+  in
+  fun (Annot.Attrs(attrs)) -> List.fold_left fn [] attrs
+
+let rec translate_int_type : loc -> i_type -> Coq_ast.int_type option =
+    fun loc i ->
+  let open Ctype in
+  let open Ocaml_implementation in
+  let size_of_base_type signed i =
+    match i with
+    (* Things defined in the standard libraries *)
+    | IntN_t(_)       -> not_impl loc "size_of_base_type (IntN_t)"
+    | Int_leastN_t(_) -> not_impl loc "size_of_base_type (Int_leastN_t)"
+    | Int_fastN_t(_)  -> not_impl loc "size_of_base_type (Int_fastN_t)"
+    | Intmax_t        -> not_impl loc "size_of_base_type (Intmax_t)"
+    | Intptr_t        -> ItIntptr_t(signed)
+    (* Normal integer types *)
+    | Ichar | Short | Int_ | Long | LongLong ->
+    let ity = if signed then Signed(i) else Unsigned i in
+    match HafniumImpl.impl.sizeof_ity ity with
+    | Some(1) -> ItI8(signed)
+    | Some(2) -> ItI16(signed)
+    | Some(4) -> ItI32(signed)
+    | Some(8) -> ItI64(signed)
+    | Some(p) -> not_impl loc "unknown integer precision: %i" p
+    | None    -> assert false
+  in
+  match i with
+  | Char        -> Some(size_of_base_type (hafniumIntImpl.impl_signed Char) Ichar)
+  | Bool        -> None
+  | Signed(i)   -> Some(size_of_base_type true  i)
+  | Unsigned(i) -> Some(size_of_base_type false i)
+  | Enum(s)     -> translate_int_type loc (HafniumImpl.impl.typeof_enum s)
+  (* Things defined in the standard libraries *)
+  | Wchar_t     -> not_impl loc "layout_of (Wchar_t)"
+  | Wint_t      -> not_impl loc "layout_of (Win_t)"
+  | Size_t      -> Some(ItSize_t(false))
+  | Ptrdiff_t   -> Some(ItPtrdiff_t)
+  | Ptraddr_t   -> not_impl loc "layout_of (Ptraddr_t)" (* NOTE: this is a CHERIC type *)
+
+(** [layout_of fa c_ty] translates the C type [c_ty] into a layout.  Note that
+    argument [fa] must be set to [true] when in function arguments, since this
+    requires a different tranlation for arrays (always pointers). *)
+let layout_of : bool -> c_type -> Coq_ast.layout = fun fa c_ty ->
+  let layout_of_int_type loc i =
+    match translate_int_type loc i with
+    | Some(it) -> LInt(it)
+    | None     -> LBool
+  in
+  let rec layout_of Ctype.(Ctype(annots, c_ty)) =
+    let loc = Annot.get_loc_ annots in
+    match c_ty with
+    | Void                  -> LVoid
+    | Basic(Integer(i))     -> layout_of_int_type loc i
+    | Basic(Floating(_))    -> not_impl loc "layout_of (Basic float)"
+    | Array(_,_) when fa    -> LPtr
+    | Array(c_ty,None )     -> LPtr
+    | Array(c_ty,Some(n))   -> LArray(layout_of c_ty, Z.to_string n)
+    | FunctionNoParams(_,_)
+    | Function(_,_,_)       -> LPtr
+    | Pointer(_,_)          -> LPtr
+    | Atomic(c_ty)          -> layout_of c_ty
+    | Struct(sym)           -> LStruct(sym_to_str sym, false)
+    | Union(sym)            -> LStruct(sym_to_str sym, true )
+  in
+  layout_of c_ty
+
+(* Hashtable of local variables to distinguish global ones. *)
+let local_vars = Hashtbl.create 17
+
+(* Hashtable of global variables used. *)
+let used_globals = Hashtbl.create 5
+
+(* Hashtable of used function. *)
+let used_functions = Hashtbl.create 5
+
+(* List of hints for the function. *)
+let hints = ref []
+
+let (fresh_block_id, reset_block_id) =
+  let counter = ref (-1) in
+  let fresh () = incr counter; Printf.sprintf "#%i" !counter in
+  let reset () = counter := -1 in
+  (fresh, reset)
+
+let (fresh_assert_id, reset_assert_id) =
+  let counter = ref (-1) in
+  let fresh () = incr counter; !counter in
+  let reset () = counter := -1 in
+  (fresh, reset)
+
+let is_atomic : c_type -> bool = AilTypesAux.is_atomic
+
+let is_atomic_tc : GenTypes.typeCategory -> bool = fun tc ->
+  is_atomic (c_type_of_type_cat tc)
+
+let is_const_0 (AilSyntax.AnnotatedExpression(_, _, _, e)) =
+  let open AilSyntax in
+  match e with
+  | AilEconst(c) ->
+      begin
+        match c with
+        | ConstantInteger(IConstant(i,_,_)) -> Z.equal Z.zero i
+        | _                                 -> false
+      end
+  | _            -> false
+
+type 'a macro_annot_arg =
+  | MacroString of string
+  | MacroExpr of ail_expr
+
+let rec macro_annot_to_list e =
+  let open AilSyntax in
+  let get_expr e =
+    match e with
+    | AnnotatedExpression(_, _, _, AilEarray_decay(AnnotatedExpression(_, _, _, AilEstr(_, strs)))) ->
+        MacroString(String.concat "" (List.concat (List.map snd strs)))
+    | _            -> MacroExpr(e)
+  in
+  match e with
+  | AnnotatedExpression(_, _, _, AilEbinary(e1, Comma, e2)) -> List.append (macro_annot_to_list e1) [get_expr e2]
+  | _            -> [get_expr e]
+
+let is_macro_annot e =
+  match macro_annot_to_list e with
+  | MacroString("rc_macro") :: _ -> true
+  | _ -> false
+
+let is_expr_annot e =
+  match macro_annot_to_list e with
+  | MacroString("rc_annot") :: _ -> true
+  | _ -> false
+
+
+(* Getting return and argument types for a function. *)
+let rec get_function_type loc Ctype.(Ctype(_, c_ty)) =
+  match c_ty with
+  | Pointer(_,c_ty)          -> get_function_type loc c_ty
+  | Function(c_ty,c_tys,_)   -> (snd c_ty, List.map (fun (_,x,_) -> x) c_tys)
+  | _                        -> panic loc "Not a function expression."
+
+let struct_data : ail_expr -> string * bool = fun e ->
+  let AilSyntax.AnnotatedExpression(gtc,_,_,_) = e in
+  let open GenTypes in
+  match gtc with
+  | GenRValueType(GenPointer(_,Ctype(_,Struct(s))))
+  | GenLValueType(_,Ctype(_,Struct(s)),_)           -> (sym_to_str s, false)
+  | GenRValueType(GenPointer(_,Ctype(_,Union(s) )))
+  | GenLValueType(_,Ctype(_,Union(s) ),_)           ->(sym_to_str s, true )
+  | GenRValueType(_                               ) -> assert false
+  | GenLValueType(_,_                 ,_)           -> assert false
+
+let struct_data_of_type : c_type -> string * bool = fun Ctype.(Ctype(_, c_ty)) ->
+  match c_ty with
+  | Struct(s) -> (sym_to_str s, false)
+  | Union(s)  -> (sym_to_str s, true)
+  | _         -> assert false
+
+let strip_expr (AilSyntax.AnnotatedExpression(_,_,_,e)) = e
+
+let rec function_decls decls =
+  let open AilSyntax in
+  match decls with
+  | []                                                           -> []
+  | (id, (_, attrs, Decl_function(_,(_,ty),args,_,_,_))) :: decls ->
+      (sym_to_str id, (ty, args, attrs)) :: function_decls decls
+  | (_ , (_, _    , Decl_object(_,_,_,_)                )) :: decls ->
+      function_decls decls
+
+let global_fun_decls = ref []
+let global_tag_defs = ref []
+
+let rec tag_def_data : loc -> string -> (string * op_type) list = fun loc id ->
+  let fs =
+    match List.find (fun (s,_) -> sym_to_str s = id) !global_tag_defs with
+    | (_, (_, Ctype.StructDef(fs,_)))
+    | (_, (_, Ctype.UnionDef(fs)   )) -> fs
+  in
+  let fn (s, (_, _, _, c_ty)) = (id_to_str s, op_type_of loc c_ty) in
+  List.map fn fs
+and op_type_of loc Ctype.(Ctype(_, c_ty)) =
+  let op_type_of_int_type loc i =
+    match translate_int_type loc i with
+    | Some(it) -> OpInt(it)
+    | None     -> OpBool
+  in
+  match c_ty with
+  | Void                  -> not_impl loc "op_type_of (Void)"
+  | Basic(Integer(i))     -> op_type_of_int_type loc i
+  | Basic(Floating(_))    -> not_impl loc "op_type_of (Basic float)"
+  | Array(_,_)            -> not_impl loc "op_type_of (Array)"
+  | FunctionNoParams(_,_)
+  | Function(_,_,_)       -> not_impl loc "op_type_of (Function)"
+  | Pointer(_,c_ty)       -> OpPtr(layout_of false c_ty)
+  | Atomic(c_ty)          ->
+      begin
+        match op_type_of loc c_ty with
+        | OpInt(_) as op_ty -> op_ty
+        | OpBool   as op_ty -> op_ty
+        | _                 -> not_impl loc "op_type_of (Atomic not an int)"
+      end
+  | Struct(sym)           ->
+     OpStruct(sym_to_str sym, List.map snd (tag_def_data loc (sym_to_str sym)))
+  | Union(_)              -> not_impl loc "op_type_of (Union)"
+
+(* Get an op_type under a pointer indirection in the type of [e]. *)
+let ptr_op_type_of : ail_expr -> Coq_ast.op_type = fun e ->
+  match c_type_of_type_cat (tc_of e) with
+  | Ctype(_, Pointer(_,c_ty)) -> op_type_of (loc_of e) c_ty
+  | _                         -> assert false
+
+let op_type_of_tc : loc -> type_cat -> Coq_ast.op_type = fun loc tc ->
+  op_type_of loc (c_type_of_type_cat tc)
+
+(* We need similar function returning options for casts. *)
+let rec op_type_opt loc Ctype.(Ctype(_, c_ty)) =
+  let op_type_of_int_type loc i =
+    match translate_int_type loc i with
+    | Some(it) -> OpInt(it)
+    | None     -> OpBool
+  in
+  match c_ty with
+  | Void                  -> None
+  | Basic(Integer(i))     -> Some(op_type_of_int_type loc i)
+  | Basic(Floating(_))    -> None
+  | Array(_,_)            -> None
+  | FunctionNoParams(_,_)
+  | Function(_,_,_)       -> None
+  | Pointer(_,c_ty)       -> Some(OpPtr(layout_of false c_ty))
+  | Atomic(c_ty)          ->
+      begin
+        match op_type_opt loc c_ty with
+        | Some(OpInt(_)) as op_ty -> op_ty
+        | Some(OpBool)   as op_ty -> op_ty
+        | _                       -> None
+      end
+  | Struct(_)             -> None
+  | Union(_)              -> None
+
+let op_type_tc_opt : loc -> type_cat -> Coq_ast.op_type option = fun loc tc ->
+  op_type_opt loc (c_type_of_type_cat tc)
+
+let rec align_of : c_type -> int = fun c_ty ->
+  let Ctype.(Ctype(annots, c_ty)) = c_ty in
+  let open Ocaml_implementation.HafniumImpl in
+  let unwrap o =
+    match o with Some(n) -> n | None ->
+    let loc = Annot.get_loc_ annots in
+    panic loc "Undefined alignment requirement."
+  in
+  match c_ty with
+  | Void                  -> 1
+  | Basic(Integer(i))     -> unwrap (impl.alignof_ity i)
+  | Basic(Floating(f))    -> unwrap (impl.alignof_fty f)
+  | Array(c_ty,_)         -> align_of c_ty
+  | FunctionNoParams(_,_)
+  | Function(_,_,_)       -> unwrap impl.alignof_pointer
+  | Pointer(_,_)          -> unwrap impl.alignof_pointer
+  | Atomic(c_ty)          -> align_of c_ty (* FIXME may not be the same? *)
+  | Struct(sym)           -> align_of_struct false sym
+  | Union(sym)            -> align_of_struct true  sym
+
+and align_of_struct : bool -> Symbol.sym -> int = fun is_union id ->
+  let id = sym_to_str id in
+  let fs =
+    match List.find (fun (s,_) -> sym_to_str s = id) !global_tag_defs with
+    | (_, (_, Ctype.StructDef(fs,_)))
+    | (_, (_, Ctype.UnionDef(fs)   )) -> fs
+  in
+  let fn acc (_, (_, _, _, c_ty)) = max acc (align_of c_ty) in
+  List.fold_left fn 1 fs
+
+let rec size_of : c_type -> int = fun c_ty ->
+  let Ctype.(Ctype(annots, c_ty)) = c_ty in
+  let open Ocaml_implementation.HafniumImpl in
+  let unwrap o =
+    match o with Some(n) -> n | None ->
+    let loc = Annot.get_loc_ annots in
+    panic loc "Undefined size."
+  in
+  match c_ty with
+  | Void                  -> 1
+  | Basic(Integer(i))     -> unwrap (impl.sizeof_ity i)
+  | Basic(Floating(f))    -> unwrap (impl.sizeof_fty f)
+  | Array(c_ty,None)      -> unwrap impl.sizeof_pointer
+  | Array(c_ty,Some(n))   -> size_of c_ty * Nat_big_num.to_int n
+  | Function(_,_,_)
+  | FunctionNoParams(_,_) -> unwrap impl.sizeof_pointer
+  | Pointer(_,_)          -> unwrap impl.sizeof_pointer
+  | Atomic(c_ty)          -> size_of c_ty (* FIXME may not be the same? *)
+  | Struct(sym)           -> size_of_struct false sym
+  | Union(sym)            -> size_of_struct true  sym
+
+and size_of_struct : bool -> Symbol.sym -> int = fun is_union s ->
+  let id = sym_to_str s in
+  let fs =
+    match List.find (fun (s,_) -> sym_to_str s = id) !global_tag_defs with
+    | (_, (_, Ctype.StructDef(fs,_)))
+    | (_, (_, Ctype.UnionDef(fs)   )) -> fs
+  in
+  let fn (_,(_,_,_,c_ty)) = (align_of c_ty, size_of c_ty) in
+  let data = List.map fn fs in
+  if is_union then
+    List.fold_left (fun acc (_, sz) -> max acc sz) 0 data
+  else
+    let fn acc (align, sz) =
+      let pad = if acc mod align = 0 then 0 else align - acc mod align in
+      acc + pad + sz
+    in
+    let size = List.fold_left fn 0 data in
+    let struct_align = align_of_struct is_union s in
+    if size mod struct_align = 0 then size
+    else size + (struct_align - size mod struct_align)
+
+let handle_invalid_annot : type a b. ?loc:loc -> b ->  (a -> b) -> a -> b =
+    fun ?loc default f a ->
+  try f a with Invalid_annot(err_loc, msg) ->
+  begin
+    match Location.get err_loc with
+    | None    ->
+        Panic.wrn loc "Invalid annotation (ignored).\n  → %s" msg
+    | Some(d) ->
+        Panic.wrn None "[%a] Invalid annotation (ignored).\n  → %s"
+          Location.pp_data d msg
+  end; default
+
+let memory_order_of_expr : ail_expr -> Cmm_csem.memory_order = fun e ->
+  let i =
+    match strip_expr e with
+    | AilEconst(ConstantInteger(IConstant(i,_,_))) -> i
+    | _                                            ->
+        Panic.panic (loc_of e) "Memory order is not an integer constant."
+  in
+  let i =
+    try Z.to_int i with Z.Overflow ->
+      Panic.panic (loc_of e) "Memory order is invalid (bad constant)."
+  in
+  match Builtins.decode_memory_order i with
+  | Some(mo) -> mo
+  | None     ->
+      Panic.panic (loc_of e) "Memory order is invalid (bad constant)."
+
+let integer_constant_to_string loc i =
+  let open AilSyntax in
+  let get_int_type loc it =
+    match translate_int_type loc it with
+    | Some(it) -> it
+    | None     -> assert false (* FIXME unreachable? *)
+  in
+  match i with
+  | IConstant(i,_,_) ->
+      (Z.to_string i, None)
+  | IConstantMax(it) ->
+      let it = get_int_type loc it in
+      Format.(fprintf str_formatter) "(max_int %a)" Coq_pp.pp_int_type it;
+      (Format.flush_str_formatter (), Some(it))
+  | IConstantMin(it) ->
+      let it = get_int_type loc it in
+      Format.(fprintf str_formatter) "(min_int %a)" Coq_pp.pp_int_type it;
+      (Format.flush_str_formatter (), Some(it))
+
+type _ call_place =
+  | In_Expr : expr call_place (* Nested call in expression. *)
+  | In_Stmt : stmt call_place (* Call at the top level. *)
+
+type _ call_res =
+  | Call_simple       : expr * expr list      -> 'a   call_place call_res
+  | Call_atomic_expr  : expr_aux              -> 'a   call_place call_res
+  | Call_atomic_store : op_type * expr * expr -> stmt call_place call_res
+
+let rec translate_expr : bool -> op_type option -> ail_expr -> expr =
+  fun lval goal_ty e ->
+  let open AilSyntax in
+  let res_ty = ref(op_type_tc_opt (loc_of e) (tc_of e)) in
+  let AnnotatedExpression(_, _, loc, e) = e in
+  let coq_loc = register_loc coq_locs loc in
+  let locate e = mkloc e coq_loc in
+  let translate = translate_expr lval None in
+  let e =
+    match e with
+    | AilEunary(Address,e)         ->
+        let e = translate_expr true None e in
+        locate (AddrOf(e))
+    | AilEunary(Indirection,e)     -> translate e
+    | AilEunary(Plus,e)            -> translate e
+    | AilEunary(op,e)              ->
+        let ty = op_type_of_tc (loc_of e) (tc_of e) in
+        let e = translate e in
+        let op =
+          match op with
+          | Address     -> assert false (* Handled above. *)
+          | Indirection -> assert false (* Handled above. *)
+          | Plus        -> assert false (* Handled above. *)
+          | Minus       -> NegOp
+          | Bnot        -> NotIntOp
+          | PostfixIncr -> forbidden loc "nested postfix increment"
+          | PostfixDecr -> forbidden loc "nested postfix decrement"
+        in
+        locate (UnOp(op, ty, e))
+    | AilEbinary(e1,op,e2)         ->
+        let ty1 = op_type_of_tc (loc_of e1) (tc_of e1) in
+        let ty2 = op_type_of_tc (loc_of e2) (tc_of e2) in
+        let arith_op = ref false in
+        let op =
+          match op with
+          | Eq             -> EqOp
+          | Ne             -> NeOp
+          | Lt             -> LtOp
+          | Gt             -> GtOp
+          | Le             -> LeOp
+          | Ge             -> GeOp
+          | And            -> LazyAndOp
+          | Or             -> LazyOrOp
+          | Comma          -> CommaOp
+          | Arithmetic(op) ->
+          arith_op := true;
+          match op with
+          | Mul  -> MulOp | Div  -> DivOp | Mod  -> ModOp | Add  -> AddOp
+          | Sub  -> SubOp | Shl  -> ShlOp | Shr  -> ShrOp | Band -> AndOp
+          | Bxor -> XorOp | Bor  -> OrOp
+        in
+        let (goal_ty, ty1, ty2) =
+          match (ty1, ty2, !res_ty) with
+          | (OpBool  , OpBool  , Some((OpInt(_) as res_ty)))
+          | (OpBool  , OpInt(_), Some((OpInt(_) as res_ty)))
+          | (OpInt(_), OpBool  , Some((OpInt(_) as res_ty)))
+          | (OpInt(_), OpInt(_), Some((OpInt(_) as res_ty))) ->
+              if !arith_op then (Some(res_ty), res_ty, res_ty) else
+              (* We build a type both operands can be casted to. *)
+              let c_ty1 = c_type_of_type_cat (tc_of e1) in
+              let c_ty2 = c_type_of_type_cat (tc_of e2) in
+              let ty1 = GenTypes.inject_type c_ty1 in
+              let ty2 = GenTypes.inject_type c_ty2 in
+              let gt = GenTypesAux.usual_arithmetic ty1 ty2 in
+              let c_ty = gen_type_to_c_type gt in
+              let ty = op_type_of loc c_ty in
+              (None, ty, ty)
+          | (_       , _       , _                         ) ->
+              (None        , ty1   , ty2   )
+        in
+        let e1 = translate_expr lval  (Some(ty1)) e1 in
+        let e2 = translate_expr false (Some(ty2)) e2 in
+        locate (BinOp(op, ty1, ty2, e1, e2))
+    | AilEassign(e1,e2)            -> forbidden loc "nested assignment"
+    | AilEcompoundAssign(e1,op,e2) -> not_impl loc "expr compound assign"
+    | AilEcond(e1,Some e2,e3) when is_const_0 e1 && is_macro_annot e2 ->
+       begin
+       match macro_annot_to_list e2 with
+       | _ :: MacroString(name) :: rest ->
+          let rec process_rest rest =
+            match rest with
+            | [_] -> ([], [])
+            | MacroString("ARG") :: MacroString(s) :: rest ->
+               let (args, es) = process_rest rest in
+               (s :: args, es)
+            | MacroString("EXPR") :: MacroExpr(e) :: rest ->
+               let (args, es) = process_rest rest in
+               let e = translate e in
+               (args, e :: es)
+            | _ -> not_impl loc "wrong macro args"
+          in
+          let (args, es) = process_rest rest in
+          let e3 = translate e3 in
+          locate (Macro(name, args, es, e3))
+       | _ -> not_impl loc "wrong macro"
+       end
+    | AilEcond(e1,Some e2,e3) when is_const_0 e1 && is_expr_annot e2 ->
+       begin
+       match macro_annot_to_list e2 with
+       | _ :: MacroString(name) :: _ ->
+          (* We need to override the res_ty as we ignore the
+             conditional. Note that Cerberus computes the type i32 for
+             (0 ? (unsigned short) 0 : (unsigned short) 0) instead of
+             u16 due to integer promotion rules. *)
+          res_ty := op_type_tc_opt (loc_of e3) (tc_of e3);
+          let e3 = translate e3 in
+          (* TODO: Allow customizing the 1 *)
+          locate (AnnotExpr(1, Coq_ident(name), e3))
+       | _ -> not_impl loc "wrong annot expr"
+       end
+    | AilEcond(e1,None,e3)           ->
+       not_impl loc "GNU :? operator not implemented"
+    | AilEcond(e1,Some e2,e3)           ->
+       let ty = op_type_of_tc (loc_of e1) (tc_of e1) in
+       let e1 = translate_expr lval None e1 in
+       let e2 = translate_expr lval (!res_ty) e2 in
+       let e3 = translate_expr lval (!res_ty) e3 in
+       locate (IfE(ty, e1, e2, e3))
+    | AilEcast(q,c_ty,e)           ->
+        begin
+          match c_ty with
+          | Ctype(_,Pointer(_,Ctype(_,Void))) when is_const_0 e ->
+              let AnnotatedExpression(_, _, loc, _) = e in
+              { elt = Val(Null) ; loc = register_loc coq_locs loc }
+          | _                                                   ->
+          let ty = op_type_of_tc (loc_of e) (tc_of e) in
+          let op_ty = op_type_of loc c_ty in
+          let new_lval =
+            begin
+              (* Casting a integer to a pointer turns an lexpression into
+                 an rexpression. *)
+              match ty, op_ty with
+              | OpInt _, OpPtr _ -> false
+              | _      , _       -> lval
+            end in
+          let e = translate_expr new_lval None e in
+          locate (UnOp(CastOp(op_ty), ty, e))
+        end
+    | AilEcall(e,es)               ->
+        let call = translate_call In_Expr loc lval e es in
+        begin
+          match call with
+          | Call_atomic_expr(e) -> locate e
+          | Call_simple(e, es)  ->
+             let e = locate (Call(e, es)) in
+             if lval then locate (LValue(e)) else e
+        end
+    | AilEassert(e)                -> not_impl loc "expr assert nested"
+    | AilEoffsetof(c_ty,is)        ->
+       let (struct_name, from_union) = struct_data_of_type c_ty in
+       locate (OffsetOf(struct_name,from_union, id_to_str is))
+    | AilEgeneric(e,gas)           -> not_impl loc "expr generic"
+    | AilEarray(b,c_ty,oes)        -> not_impl loc "expr array"
+    | AilEstruct(sym,fs) when lval -> not_impl loc "Struct initializer not supported in lvalue context"
+    | AilEstruct(sym,fs)           ->
+        let st_id = sym_to_str sym in
+        (* Map of types for the fields. *)
+        let map = try tag_def_data loc st_id with Not_found -> assert false in
+        let fs =
+          let fn (id, eo) = Option.map (fun e -> (id_to_str id, e)) eo in
+          List.filter_map fn fs
+        in
+        let fs =
+          let fn (id, e) =
+            let ty = try List.assoc id map with Not_found -> assert false in
+            (id, translate_expr lval (Some(ty)) e)
+          in
+          List.map fn fs
+        in
+        locate (Struct(st_id, fs))
+    | AilEunion(sym,id,eo)         -> not_impl loc "expr union"
+    | AilEcompound(q,c_ty,e)       -> translate e (* FIXME? *)
+    | AilEmemberof(e,id)           ->
+        if not lval then assert false;
+        let (struct_name, from_union) = struct_data e in
+        let e = translate e in
+        locate (GetMember(e, struct_name, from_union, id_to_str id))
+    | AilEmemberofptr(e,id)        ->
+        let (struct_name, from_union) = struct_data e in
+        let e = translate e in
+        locate (GetMember(e, struct_name, from_union, id_to_str id))
+    | AilEbuiltin(b)               -> not_impl loc "expr builtin"
+    | AilEstr(s)                   -> not_impl loc "expr str"
+    | AilEconst(c)                 ->
+        let c =
+          match c with
+          | ConstantIndeterminate(c_ty) -> assert false
+          | ConstantNull                -> Null
+          | ConstantInteger(i)          ->
+              let (i, it) =
+                let (i, ito) = integer_constant_to_string loc i in
+                let it =
+                  match (!res_ty, ito) with
+                  | (Some(OpInt(it)), Some(it_c)) -> assert (it = it_c); it
+                  | (Some(OpInt(it)), None      ) -> it
+                  | (_              , _         ) -> assert false
+                in
+                (i, it)
+              in
+              Int(i, it)
+          | ConstantFloating(_)         -> not_impl loc "constant float"
+          | ConstantCharacter(_)        -> not_impl loc "constant char"
+          | ConstantArray(_,_)          -> not_impl loc "constant array"
+          | ConstantStruct(_,_)         -> not_impl loc "constant struct"
+          | ConstantUnion(_,_,_)        -> not_impl loc "constant union"
+        in
+        locate (Val(c))
+    | AilEident(sym)               ->
+        let id = sym_to_str sym in
+        let global = not (Hashtbl.mem local_vars id) in
+        if global then Hashtbl.add used_globals id ();
+        locate (Var(Some(id), global))
+    | AilEsizeof(q,c_ty)           ->
+        locate (Val(SizeOf(layout_of false c_ty)))
+    | AilEsizeof_expr(e)           -> not_impl loc "expr sizeof_expr"
+    | AilEalignof(q,c_ty)          -> not_impl loc "expr alignof"
+    | AilEannot(c_ty,e)            -> not_impl loc "expr annot"
+    | AilEva_start(e,sym)          -> not_impl loc "expr va_start"
+    | AilEva_arg(e,c_ty)           -> not_impl loc "expr va_arg"
+    | AilEva_copy(e1,e2)           -> not_impl loc "expr va_copy"
+    | AilEva_end(e)                -> not_impl loc "expr va_end"
+    | AilEprint_type(e)            -> not_impl loc "expr print_type"
+    | AilEbmc_assume(e)            -> not_impl loc "expr bmc_assume"
+    | AilEreg_load(r)              -> not_impl loc "expr reg_load"
+    | AilErvalue(e)                ->
+        let res =
+          match e with
+          (* Struct initializers are lvalues for Ail, but rvalues for us. *)
+          | AnnotatedExpression(_, _, _, AilEcompound(_, _, _)) -> translate e
+          | _                                                   ->
+          let atomic = is_atomic_tc (tc_of e) in
+          let ty = op_type_of_tc (loc_of e) (tc_of e) in
+          let e = translate_expr true None e in
+          let gen =
+            if lval then Deref(atomic, ty, e)
+            else Use(atomic, ty, e)
+          in
+          locate gen
+        in res
+    | AilEarray_decay(e) when lval -> translate e
+    | AilEarray_decay(e)           ->
+        let e = translate_expr true None e in
+        locate (AddrOf(e))
+    | AilEfunction_decay(e)        ->
+        let res =
+          match e with
+          | AnnotatedExpression(_, _, _, AilEident(sym)) ->
+              let fun_id = sym_to_str sym in
+              Hashtbl.add used_functions fun_id ();
+              locate (Var(Some(fun_id), true))
+          | _                                            ->
+              not_impl loc "expr function_decay (not an ident)"
+        in res
+    | AilEatomic(e)                ->
+        (* conversion of a non-atomic value to an atomic value (e.g.
+           for a constant on the RHS of a store to an atomic
+           location). We don't do anything here at the moment. *)
+        translate e
+    | AilEgcc_statement _          ->
+        Panic.panic loc "Not implemented GCC statement expr." (* TODO *)
+  in
+  match (goal_ty, !res_ty) with
+  | (None         , _           )
+  | (_            , None        )                       -> e
+  | (Some(goal_ty), Some(res_ty)) when goal_ty = res_ty -> e
+  | (Some(goal_ty), Some(res_ty))                       ->
+      mkloc (UnOp(CastOp(goal_ty), res_ty, e)) e.loc
+
+and translate_call : type a. a call_place -> loc -> bool -> ail_expr
+    -> ail_expr list -> a call_place call_res =
+  fun place loc lval e es ->
+  let loc_e = register_loc coq_locs (loc_of e) in
+  match strip_expr e with
+  | AilEfunction_decay(e) -> translate_call place loc lval e es
+  | AilEident(sym)        ->
+      let fun_id = sym_to_str sym in
+      Hashtbl.add used_functions fun_id ();
+      let e = mkloc (Var(Some(fun_id), true)) loc_e in
+      let (_, args, attrs) = List.assoc fun_id !global_fun_decls in
+      let attrs = collect_rc_attrs attrs in
+      let annot_args =
+        handle_invalid_annot ~loc [] function_annot_args attrs
+      in
+      let nb_args = List.length es in
+      let check_useful (i, _, _) =
+        if i >= nb_args then
+          Panic.wrn (Some(loc))
+            "Argument annotation not usable (not enough arguments)."
+      in
+      List.iter check_useful annot_args;
+      let es =
+        let fn i e =
+          let (_, ty, _) = List.nth args i in
+          match op_type_opt Cerb_location.unknown ty with
+          | Some(OpInt(_)) as goal_ty -> translate_expr false goal_ty e
+          | Some(OpBool)   as goal_ty -> translate_expr false goal_ty e
+          | _                         -> translate_expr false None e
+        in
+        List.mapi fn es
+      in
+      let annotate i e =
+        let annot_args = List.filter (fun (n, _, _) -> n = i) annot_args in
+        let fn (_, k, coq_e) acc = mkloc (AnnotExpr(k, coq_e, e)) e.loc in
+        List.fold_right fn annot_args e
+      in
+      Call_simple(e, List.mapi annotate es)
+  | AilEbuiltin(b)        ->
+      begin
+        match b with
+        | AilBatomic(AilBAthread_fence)            ->
+            not_impl loc "call to builtin atomic (thread_fence)"
+        | AilBatomic(AilBAstore)                   ->
+            let (e1, e2, e3) =
+              match es with
+              | [e1; e2; e3] -> (e1, e2, e3)
+              | _            -> assert false
+            in
+            let op_type = ptr_op_type_of e1 in
+            let e1 = translate_expr true None e1 in
+            let e2 = translate_expr false (Some(op_type)) e2 in
+            let mo = memory_order_of_expr e3 in
+            if mo <> Cmm_csem.Seq_cst then
+              Panic.panic loc "Only the Seq_cst memory order is supported.";
+            begin
+              match place with
+              | In_Expr ->
+                  forbidden loc "nested (atomic) store"
+              | In_Stmt ->
+                  let e1 =
+                    match e1.elt with
+                    | AddrOf(e) -> e
+                    | _         -> forbidden loc "atomic store whose LHS is \
+                                     not of the form [&e]"
+                  in
+                  Call_atomic_store(op_type, e1, e2)
+            end
+        | AilBatomic(AilBAload)                    ->
+            let (e1, e2) =
+              match es with
+              | [e1; e2] -> (e1, e2)
+              | _        -> assert false
+            in
+            let op_type = ptr_op_type_of e1 in
+            let e1 = translate_expr true None e1 in
+            let mo = memory_order_of_expr e2 in
+            if mo <> Cmm_csem.Seq_cst then
+              Panic.panic loc "Only the Seq_cst memory order is supported.";
+            begin
+              ignore (e1, op_type);
+              match place with
+              | In_Expr ->
+                 let e1 =
+                   match e1.elt with
+                   | AddrOf(e) -> e
+                   | _         -> forbidden loc "atomic load whose RHS is \
+                                                 not of the form [&e]"
+                 in
+                 let gen =
+                   if lval then Deref(true, op_type, e1)
+                   else Use(true, op_type, e1)
+                 in
+                 Call_atomic_expr(gen)
+              | In_Stmt -> not_impl loc "call to builtin atomic (load)"
+            end
+        | AilBatomic(AilBAexchange)                ->
+            not_impl loc "call to builtin atomic (exchange)"
+        | AilBatomic(AilBAcompare_exchange_strong) ->
+            let (e1, e2, e3, e4, e5) =
+              match es with
+              | [e1; e2; e3; e4; e5] -> (e1, e2, e3, e4, e5)
+              | _                    -> assert false
+            in
+            let op_type = ptr_op_type_of e1 in
+            let e1 = translate_expr lval None e1 in
+            let e2 = translate_expr lval None e2 in
+            let e3 = translate_expr lval (Some(op_type)) e3 in
+            let mo1 = memory_order_of_expr e4 in
+            let mo2 = memory_order_of_expr e4 in
+            if mo1 <> Cmm_csem.Seq_cst || mo2 <> Cmm_csem.Seq_cst then
+              Panic.panic loc "Only the Seq_cst memory order is supported.";
+            let cas = CAS(op_type, e1, e2, e3) in
+            Call_atomic_expr(cas)
+        | AilBatomic(AilBAcompare_exchange_weak)   ->
+            not_impl loc "call to builtin atomic (compare_exchange_weak)"
+        | AilBatomic(AilBAfetch_key)               ->
+            not_impl loc "call to builtin atomic (fetch_key)"
+        | AilBlinux(AilBLfence)                    ->
+            not_impl loc "call to linux builtin (fence)"
+        | AilBlinux(AilBLread)                     ->
+            not_impl loc "call to linux builtin (read)"
+        | AilBlinux(AilBLwrite)                    ->
+            not_impl loc "call to linux builtin (write)"
+        | AilBlinux(AilBLrmw)                      ->
+            not_impl loc "call to linux builtin (rmw)"
+        | AilBcopy_alloc_id                        ->
+            let (e1, e2) =
+              match es with
+              | [e1; e2] -> (e1, e2)
+              | _        -> assert false
+            in
+            let ot = op_type_of_tc (loc_of e1) (tc_of e1) in
+            let e1 = translate_expr false None e1 in
+            let e2 = translate_expr false None e2 in
+            let e = CopyAID(ot, e1, e2) in
+            if lval then not_impl loc "copy_alloc_id as an lvalue";
+            Call_atomic_expr(e) (* FIXME constructor name confusing here. *)
+        | AilBCHERI _                              ->
+            not_impl loc "call to CHERI builtin"
+      end
+  | _                     ->
+      let (_, arg_tys) =
+        get_function_type (loc_of e) (c_type_of_type_cat (tc_of e))
+      in
+      let e = translate_expr false None e in
+      let es =
+        let fn i e =
+          let ty = List.nth arg_tys i in
+          match op_type_opt Cerb_location.unknown ty with
+          | Some(OpInt(_)) as goal_ty -> translate_expr false goal_ty e
+          | Some(OpBool)   as goal_ty -> translate_expr false goal_ty e
+          | _                         -> translate_expr false None e
+        in
+        List.mapi fn es
+      in
+      Call_simple(e, es)
+
+let add_block ?annots id s blocks =
+  if SMap.mem id blocks then assert false;
+  let annots =
+    match annots with
+    | None         -> BA_none
+    | Some(annots) -> BA_loop(annots)
+  in
+  SMap.add id (annots, s) blocks
+
+(* Insert local variables. *)
+let insert_bindings bindings =
+  let fn (id, ((loc, _, _), _, _, c_ty)) =
+    let id = sym_to_str id in
+    if Hashtbl.mem local_vars id then
+      not_impl loc "Variable name collision with [%s]." id;
+    Hashtbl.add local_vars id (true, c_ty)
+  in
+  List.iter fn bindings
+
+let collect_bindings () =
+  let fn id (is_var, c_ty) acc =
+    if is_var then (id, layout_of false c_ty) :: acc else acc
+  in
+  Hashtbl.fold fn local_vars []
+
+(* Insert hint. *)
+let insert_hint hint =
+  hints := (hint :: !hints)
+
+let warn_ignored_attrs so attrs =
+  let pp_rc ff {rc_attr_id = id; rc_attr_args = args} =
+    Format.fprintf ff "%s(" id.elt;
+    match args with
+    | arg :: args ->
+        let open Location in
+        Format.fprintf ff "%s" arg.rc_attr_arg_value.elt;
+        List.iter (fun arg ->
+          Format.fprintf ff ", %s" arg.rc_attr_arg_value.elt
+        ) args;
+        Format.fprintf ff ")"
+    | []          ->
+        Format.fprintf ff ")"
+  in
+  let fn attr =
+    let desc s =
+      let open AilSyntax in
+      match s with
+      | AilSblock(_,_)           -> "a block"
+      | AilSgoto(_)              -> "a goto"
+      | AilSreturnVoid
+      | AilSreturn(_)            -> "a return"
+      | AilSbreak                -> "a break"
+      | AilScontinue             -> "a continue"
+      | AilSskip                 -> "a skip"
+      | AilSexpr(_)              -> "an expression"
+      | AilSif(_,_,_)            -> "an if statement"
+      | AilSwhile(_,_,_)         -> "a while loop"
+      | AilSdo(_,_,_)            -> "a do-while loop"
+      | AilSswitch(_,_)          -> "a switch statement"
+      | AilScase(_,_)
+      | AilScase_rangeGNU(_,_,_) -> "a case statement"
+      | AilSdefault(_)           -> "a default statement"
+      | AilSlabel(_,_,_)         -> "a label"
+      | AilSdeclaration(_)       -> "a declaration"
+      | AilSpar(_)               -> "a par statement"
+      | AilSreg_store(_,_)       -> "a register store statement"
+      | AilSmarker(_,_)          -> assert false (* FIXME *)
+    in
+    let desc =
+      match so with
+      | Some(s) -> Printf.sprintf " (on %s)" (desc s)
+      | None    -> " (on an outer block)"
+    in
+    Panic.wrn None "Ignored attribute [%a]%s." pp_rc attr desc
+  in
+  List.iter fn attrs
+
+type stmto = stmt option
+
+type k_data =
+  { k_break    : stmto (* What to do in case of break. *)
+  ; k_continue : stmto (* What to do in case of break. *)
+  ; k_final    : stmto (* What to do at the end of control flow. *)
+  ; k_on_case  : bool (* Was this pushed for a case or default? *) }
+
+let k_push : stmto -> stmto -> stmto -> bool -> k_data list -> k_data list =
+  fun k_break k_continue k_final k_on_case l ->
+    { k_break ; k_continue ; k_final ; k_on_case } :: l
+
+let k_push_final : stmt -> k_data list -> k_data list = fun s l ->
+  k_push None None (Some(s)) false l
+
+let k_push_final_case : stmt -> k_data list -> k_data list = fun s l ->
+  k_push None None (Some(s)) true l
+
+let rec k_gen : (k_data -> stmto) -> k_data list -> stmt = fun f l ->
+  match l with
+  | []     -> assert false
+  | k :: l -> match f k with None -> k_gen f l | Some(s) -> s
+
+let k_break    = k_gen (fun k -> k.k_break   )
+let k_continue = k_gen (fun k -> k.k_continue)
+let k_final    = k_gen (fun k -> k.k_final   )
+
+let k_init : op_type option -> bool -> k_data list = fun ret_ty is_main ->
+  let ret_v =
+    match ret_ty with
+    (* Insert [return 0] in case of main with int type. *)
+    | Some(OpInt(ItI32(true))) when is_main -> Int("0", ItI32(true))
+    | _                                     -> Void
+  in
+  k_push_final (noloc (Return(noloc (Val(ret_v))))) []
+
+let rec k_pop_cases : k_data list -> k_data list = fun l ->
+  match l with
+  | []     -> []
+  | k :: l -> if k.k_on_case then k_pop_cases l else k :: l
+
+let debug = false
+
+let k_stack_print : out_channel -> k_data list -> unit = fun oc l ->
+  let to_str s =
+    match Location.(s.elt) with
+    | Goto(l)   -> l
+    | Return(_) -> "RET"
+    | _         -> "???"
+  in
+  let opt_to_str to_str o =
+    match o with
+    | None    -> "-"
+    | Some(e) -> to_str e
+  in
+  let print_data d =
+    Printf.fprintf oc " (%s,%s,%s,%s)"
+      (opt_to_str to_str d.k_break)
+      (opt_to_str to_str d.k_continue)
+      (opt_to_str to_str d.k_final)
+      (if d.k_on_case then "y" else "n")
+  in
+  Printf.fprintf oc "K-stack:";
+  List.iter print_data l;
+  Printf.fprintf oc "\n%!"
+
+let translate_block stmts blocks ret_ty is_main =
+  let translate_bool_expr id_cont then_goto else_goto e =
+    let ot = op_type_of_tc (loc_of e) (tc_of e) in
+    let e = translate_expr false None e in
+    mkloc (If(ot, id_cont, e, then_goto, else_goto)) e.loc
+  in
+  let rec trans extra_attrs swstk ks stmts blocks =
+    let open AilSyntax in
+    if debug then Printf.eprintf "[trans] %a" k_stack_print ks;
+    (* End of the block reached. *)
+    match stmts with
+    | []                                           ->
+        if debug then Printf.eprintf "End of [trans] with empty list\n%!";
+        let ks = k_pop_cases ks in
+        (k_final ks, blocks)
+    | (AnnotatedStatement(loc, attrs, s)) :: stmts ->
+    let coq_loc = register_loc coq_locs loc in
+    let locate e = mkloc e coq_loc in
+    let attrs = List.rev (collect_rc_attrs attrs) in
+    let attrs_used = ref false in
+    let add_loop_block loc id s attrs blocks =
+      let annots =
+        attrs_used := true;
+        let fn () =
+          let (full, sd) = loop_annot attrs in
+          match full with
+          | None
+          | Some true -> Some sd
+          | Some false ->
+             insert_hint ({ ht_kind = HK_block id; ht_annot = sd });
+             None
+        in
+        handle_invalid_annot ~loc None fn ()
+      in
+      add_block ?annots id s blocks
+    in
+    let res =
+      match s with
+      (* Nested block. *)
+      | AilSblock(bs, ss)   ->
+          insert_bindings bs;
+          attrs_used := true; (* Will be attach to the first loop we find. *)
+          trans (extra_attrs @ attrs) swstk ks (ss @ stmts) blocks
+      (* End of block stuff, assuming [stmts] is empty. *)
+      | AilSgoto(l)         ->
+          let (_, blocks) = trans extra_attrs swstk ks stmts blocks in
+          (locate (Goto(sym_to_str l)), blocks)
+      | AilSreturnVoid      ->
+          let (_, blocks) = trans extra_attrs swstk ks stmts blocks in
+          (locate (Return(noloc (Val(Void)))), blocks)
+      | AilSbreak           ->
+          (k_break ks, snd (trans extra_attrs swstk ks stmts blocks))
+      | AilScontinue        ->
+          (k_continue ks, snd (trans extra_attrs swstk ks stmts blocks))
+      | AilSreturn(e)       ->
+          let blocks = snd (trans extra_attrs swstk ks stmts blocks) in
+          let goal_ty =
+            match ret_ty with
+            | Some(OpInt(_)) -> ret_ty
+            | Some(OpBool)   -> ret_ty
+            | _              -> None
+          in
+          let e = translate_expr false goal_ty e in
+          (locate (Return(e)), blocks)
+      (* All the other constructors. *)
+      | AilSskip            ->
+          trans extra_attrs swstk ks stmts blocks
+      | AilSexpr(e)         ->
+          let (stmt, blocks) = trans extra_attrs swstk ks stmts blocks in
+          let incr_or_decr op = op = PostfixIncr || op = PostfixDecr in
+          let use_annots () =
+            attrs_used := true;
+            let fn () = raw_expr_annot attrs in
+            let cook_annot raw_annot =
+              match raw_annot with
+              | RawExprAnnot_annot s -> ExprAnnot_annot s
+              | RawExprAnnot_assert la ->
+                 let id = fresh_assert_id () in
+                 insert_hint ({ ht_kind = HK_assert id; ht_annot = la });
+                 ExprAnnot_assert id
+            in
+            Option.map cook_annot (handle_invalid_annot ~loc None fn ())
+          in
+          let stmt =
+            let loc_full = loc_of e in
+            match strip_expr e with
+            | AilEassert(e)                        ->
+                let ot = op_type_of_tc (loc_of e) (tc_of e) in
+                let e = translate_expr false None e in
+                locate (Assert(ot, e, stmt))
+            | AilEassign(e1,e2)                    ->
+                let atomic = is_atomic_tc (tc_of e1) in
+                let e1 = translate_expr true None e1 in
+                let ot = op_type_of_tc (loc_of e) (tc_of e) in
+                let goal_ty =
+                  let ty_opt = op_type_tc_opt (loc_of e) (tc_of e) in
+                  match ty_opt with
+                  | Some(OpInt(_)) -> ty_opt
+                  | Some(OpBool)   -> ty_opt
+                  | _              -> None
+                in
+                let e2 = translate_expr false goal_ty e2 in
+                locate (Assign(atomic, ot, e1, e2, stmt))
+            | AilEunary(op,e) when incr_or_decr op ->
+                let atomic = is_atomic_tc (tc_of e) in
+                let op_type = op_type_of_tc (loc_of e) (tc_of e) in
+                let (res_ty, int_ty) =
+                  let ty_opt = op_type_tc_opt (loc_of e) (tc_of e) in
+                  match ty_opt with
+                  | Some(OpInt(int_ty) as ty) -> (ty, int_ty     )
+                  | Some(OpPtr(_)      as ty) -> (ty, ItI32(true))
+                  | _                         -> assert false
+                in
+                let op = match op with PostfixIncr -> AddOp | _ -> SubOp in
+                let e1 = translate_expr true None e in
+                let e2 =
+                  let one = locate (Val(Int("1", int_ty))) in
+                  let use = locate (Use(atomic, op_type, e1)) in
+                  locate (BinOp(op, res_ty, OpInt(int_ty), use, one))
+                in
+                locate (Assign(atomic, op_type, e1, e2, stmt))
+            | AilEcall(e,es)                       ->
+                let call = translate_call In_Stmt loc_full false e es in
+                let stmt =
+                  match call with
+                  | Call_atomic_expr(e)             ->
+                      let annots = use_annots () in
+                      locate (ExprS(annots, locate e, stmt))
+                  | Call_simple(e,es)               ->
+                      let annots = use_annots () in
+                      locate (ExprS(annots, locate(Call(e, es)), stmt))
+                  | Call_atomic_store(layout,e1,e2) ->
+                      locate (Assign(true, layout, e1, e2, stmt))
+                in
+                stmt
+            | _                                    ->
+                let annots = use_annots () in
+                let e = translate_expr false None e in
+                locate (ExprS(annots, e, stmt))
+          in
+          (stmt, blocks)
+      | AilSif(e,s1,s2)     ->
+          warn_ignored_attrs None extra_attrs;
+          (* Translate the continuation. *)
+          let (blocks, id_cont, ks) =
+            if stmts = [] then (blocks, None, ks) else
+            let id_cont = fresh_block_id () in
+            let (s, blocks) = trans [] swstk ks stmts blocks in
+            let blocks = add_block id_cont s blocks in
+            (blocks, Some id_cont, k_push_final (mkloc (Goto(id_cont)) s.loc) ks)
+          in
+          (* Translate the two branches. *)
+          let (blocks, then_goto) =
+            let id_then = fresh_block_id () in
+            let (s, blocks) =
+              trans [] swstk ks [s1] blocks
+            in
+            let blocks = add_block id_then s blocks in
+            (blocks, mkloc (Goto(id_then)) s.loc)
+          in
+          let (blocks, else_goto) =
+            let id_else = fresh_block_id () in
+            let (s, blocks) =
+              trans [] swstk ks [s2] blocks
+            in
+            let blocks = add_block id_else s blocks in
+            (blocks, mkloc (Goto(id_else)) s.loc)
+          in
+          (translate_bool_expr id_cont then_goto else_goto e, blocks)
+      | AilSwhile(e,s,_)    ->
+          let attrs = extra_attrs @ attrs in
+          let id_cond = fresh_block_id () in
+          let id_body = fresh_block_id () in
+          (* Translate the continuation. *)
+          let (blocks, goto_cont) =
+            let id_cont = fresh_block_id () in
+            let (s, blocks) = trans [] swstk ks stmts blocks in
+            let blocks = add_block id_cont s blocks in
+            (blocks, mkloc (Goto(id_cont)) s.loc)
+          in
+          (* Translate the body. *)
+          let (blocks, goto_body) =
+            let break    = Some(goto_cont) in
+            let continue = Some(locate (Goto(id_cond))) in
+            let ks = k_push break continue continue false ks in
+            let (s, blocks) = trans [] swstk ks [s] blocks in
+            let blocks = add_block id_body s blocks in
+            (blocks, mkloc (Goto(id_body)) s.loc)
+          in
+          (* Translate the condition. *)
+          let s = translate_bool_expr None goto_body goto_cont e in
+          let blocks = add_loop_block loc id_cond s attrs blocks in
+          (locate (Goto(id_cond)), blocks)
+      | AilSdo(s,e,_)       ->
+          let attrs = extra_attrs @ attrs in
+          let id_cond = fresh_block_id () in
+          let id_body = fresh_block_id () in
+          (* Translate the continuation. *)
+          let (blocks, goto_cont) =
+            let id_cont = fresh_block_id () in
+            let (s, blocks) = trans [] swstk ks stmts blocks in
+            let blocks = add_block id_cont s blocks in
+            (blocks, mkloc (Goto(id_cont)) s.loc)
+          in
+          (* Translate the body. *)
+          let (blocks, goto_body) =
+            let break    = Some(goto_cont) in
+            let continue = Some(noloc (Goto(id_cond))) in (* FIXME loc *)
+            let ks = k_push break continue continue false ks in
+            if debug then Printf.eprintf "Entering do-while body\n%!";
+            let (s, blocks) = trans [] swstk ks [s] blocks in
+            if debug then Printf.eprintf "Done with do-while body\n%!";
+            let blocks = add_block id_body s blocks in
+            (blocks, locate (Goto(id_body)))
+          in
+          (* Translate the condition. *)
+          let s = translate_bool_expr None goto_body goto_cont e in
+          let blocks = add_loop_block loc id_cond s attrs blocks in
+          (locate (Goto(id_body)), blocks)
+      | AilSswitch(e,s)     ->
+          warn_ignored_attrs None extra_attrs;
+          (* Translate the continuation. *)
+          let (blocks, goto_cont) =
+            let id_cont = fresh_block_id () in
+            let (s, blocks) = trans [] swstk ks stmts blocks in
+            let blocks = add_block id_cont s blocks in
+            (blocks, mkloc (Goto(id_cont)) s.loc)
+          in
+          (* Figure out the integer type of [e]. *)
+          let it =
+            match op_type_of_tc (loc_of e) (tc_of e) with
+            | OpInt(it) -> it
+            | _         -> assert false (* Not reachable since well-typed. *)
+          in
+          (* Translate the body. *)
+          let (map, bs, def, blocks) =
+            (* We push a fresh entry on the switch data stack. *)
+            let swdata =
+              let cur_label = fresh_block_id () in
+              let next_label = fresh_block_id () in
+              let cases_map = [] in
+              let default = None in
+              ref (cases_map, cur_label, next_label, default)
+            in
+            let (_, blocks) =
+              let break = Some(goto_cont) in
+              let ks = k_push break None break false ks in
+              if debug then Printf.eprintf "Entering switch body\n%!";
+              trans [] (swdata :: swstk) ks [s] blocks
+            in
+            if debug then Printf.eprintf "Done with switch body\n%!";
+            (* Extract the accumulated data. *)
+            let (map, cur_label, _, default) = !swdata in
+            let (map, bs) = List.split (List.rev map) in
+            let map = List.mapi (fun i k -> (k, i)) map in
+            let bs =
+              let fn r = match !r with None -> assert false | Some s -> s in
+              List.map fn bs
+            in
+            let def =
+              match default with
+              | None    -> goto_cont
+              | Some(s) -> match !s with Some(s) -> s | None -> assert false
+            in
+            let blocks = add_block cur_label goto_cont blocks in
+            (map, bs, def, blocks)
+          in
+          (* Put everything together. *)
+          let e = translate_expr false None e in
+          (locate (Switch(it, e, map, bs, def)), blocks)
+      | AilScase(i,s)       ->
+          warn_ignored_attrs None extra_attrs;
+          (* Get the value of the current case. *)
+          let i = Z.to_string i in
+          (* Prepare the ref to eventually store the compiled [s]. *)
+          let (case_ref, cur_label, next_label) =
+            (* Obtain the state of the current switch. *)
+            let r = match swstk with [] -> assert false | r :: _ -> r in
+            let (map, cur_label, next_label, default) = !r in
+            if default <> None then assert false;
+            (* Register the current case. *)
+            let case_ref = ref None in
+            let map = (i, case_ref) :: map in
+            r := (map, next_label, fresh_block_id (), None);
+            (case_ref, cur_label, next_label)
+          in
+          (* Translate case body. *)
+          let (case_s, blocks) =
+            let ks = k_push_final_case (noloc (Goto(next_label))) ks in
+            if debug then Printf.eprintf "Entering case body (%s)\n%!" i;
+            trans [] swstk ks (s :: stmts) blocks
+          in
+          if debug then Printf.eprintf "Done with case body (%s)\n%!" i;
+          let (case_s, blocks) =
+            (locate (Goto(cur_label)), add_block cur_label case_s blocks)
+          in
+          (* Update the case ref. *)
+          case_ref := Some(case_s);
+          (case_s, blocks)
+      | AilScase_rangeGNU(_,_,_)       ->
+         not_impl loc "GNU range expression"
+      | AilSdefault(s)      ->
+          warn_ignored_attrs None extra_attrs;
+          (* Prepare the ref to eventually store the compiled [s]. *)
+          let (default_ref, cur_label, next_label) =
+            (* Obtain the state of the current switch. *)
+            let r = match swstk with [] -> assert false | r :: _ -> r in
+            let (map, cur_label, next_label, default) = !r in
+            if default <> None then assert false;
+            (* Register the default case. *)
+            let default_ref = ref None in
+            r := (map, next_label, fresh_block_id (), Some(default_ref));
+            (default_ref, cur_label, next_label)
+          in
+          (* Translate the default body. *)
+          let (default_s, blocks) =
+            let ks = k_push_final_case (noloc (Goto(next_label))) ks in
+            trans [] swstk ks (s :: stmts) blocks
+          in
+          let (default_s, blocks) =
+            (locate (Goto(cur_label)), add_block cur_label default_s blocks)
+          in
+          (* Update the default ref. *)
+          default_ref := Some(default_s);
+          (default_s, blocks)
+      | AilSlabel(l,s,_)    ->
+          let (s, blocks) = trans extra_attrs swstk ks (s :: stmts) blocks in
+          let blocks = add_block (sym_to_str l) s blocks in
+          (locate (Goto(sym_to_str l)), blocks)
+      | AilSdeclaration(ls) ->
+          let (stmt, blocks) = trans extra_attrs swstk ks stmts blocks in
+          let add_decl (id, e_opt) stmt =
+            match e_opt with
+            | None ->
+               (* FIXME: Technically, reaching a variable declaration
+                  should assign Poison to the variable each time the
+                  declaration is reached. See
+                  https://github.com/rems-project/cerberus/blob/master/tests/ci/0328-indeterminate_block_declaration.c *)
+               stmt
+            | Some e ->
+                let id = sym_to_str id in
+                let ty =
+                  try snd (Hashtbl.find local_vars id)
+                  with Not_found -> assert false
+                in
+                let atomic = is_atomic ty in
+                let goal_ty = op_type_of Cerb_location.unknown ty in
+                let e = translate_expr false (Some goal_ty) e in
+                let var = noloc (Var(Some(id), false)) in
+                noloc (Assign(atomic, goal_ty, var, e, stmt))
+          in
+          (List.fold_right add_decl ls stmt, blocks)
+      | AilSpar(_)          -> not_impl loc "statement par"
+      | AilSreg_store(_,_)  -> not_impl loc "statement store"
+      | AilSmarker(_,_)     -> assert false (* FIXME *)
+    in
+    if not !attrs_used then warn_ignored_attrs (Some(s)) attrs;
+    res
+  in
+  trans [] [] (k_init ret_ty is_main) stmts blocks
+
+(** [translate fname ail] translates typed Ail AST to Coq AST. *)
+let translate : string -> typed_ail -> Coq_ast.t = fun source_file ail ->
+  (* Get the entry point. *)
+  let (entry_point, sigma) =
+    match ail with
+    | (None    , sigma) -> (None               , sigma)
+    | (Some(id), sigma) -> (Some(sym_to_str id), sigma)
+  in
+
+  (* Extract the different parts of the AST. *)
+  let decls      = sigma.declarations         in
+  (*let obj_defs   = sigma.object_definitions   in*)
+  let fun_defs   = sigma.function_definitions in
+  (*let assertions = sigma.static_assertions    in*)
+  let tag_defs   = sigma.tag_definitions      in
+  (*let ext_idmap  = sigma.extern_idmap         in*)
+
+  (* Give global access to declarations. *)
+  let fun_decls = function_decls decls in
+  global_fun_decls := fun_decls;
+
+  (* Give global access to tag declarations *)
+  global_tag_defs := tag_defs;
+
+  (* Get the global variables. *)
+  let global_vars =
+    let fn (id, (_, attrs, decl)) acc =
+      match decl with
+      | AilSyntax.Decl_object _ ->
+         let annots = collect_rc_attrs attrs in
+         let fn () = global_annot annots in
+         let global_annot = handle_invalid_annot None fn () in
+         (sym_to_str id, global_annot) :: acc
+      | _                       -> acc
+    in
+    List.fold_right fn decls []
+  in
+
+  (* Get the definition of structs/unions. *)
+  let structs =
+    let build (id, (attrs, def)) =
+      let (fields, struct_is_union) =
+        match def with
+        | Ctype.StructDef(fields,_) -> (fields, false)
+        | Ctype.UnionDef(fields)    -> (fields, true )
+      in
+      let id = sym_to_str id in
+      let struct_annot =
+        let attrs = List.rev (collect_rc_attrs attrs) in
+        if struct_is_union && attrs <> [] then
+          Panic.wrn None "Attributes on unions like [%s] are ignored." id;
+        if struct_is_union then Some(SA_union) else
+        handle_invalid_annot None (fun _ -> Some(struct_annot attrs)) ()
+      in
+      let struct_members =
+        let fn (id, (attrs, _, loc, c_ty)) =
+          let annot =
+            let loc = loc_of_id id in
+            let annots = collect_rc_attrs attrs in
+            let fn () = Some(member_annot annots) in
+            handle_invalid_annot ~loc None fn ()
+          in
+          let align = align_of c_ty in
+          let size = size_of c_ty in
+          (id_to_str id, (annot, (align, size), layout_of false c_ty))
+        in
+        List.map fn fields
+      in
+      let struct_deps =
+        let fn acc (_, (_, _, layout)) =
+          let rec extend acc layout =
+            match layout with
+            | LVoid         -> acc
+            | LBool         -> acc
+            | LPtr          -> acc
+            | LStruct(id,_) -> id :: acc
+            | LInt(_)       -> acc
+            | LArray(l,_)   -> extend acc l
+          in
+          extend acc layout
+        in
+        let deps = List.rev (List.fold_left fn [] struct_members) in
+        List.filter (fun s -> s <> id) (List.sort_uniq String.compare deps)
+      in
+      let struct_ =
+        { struct_name = id ; struct_annot ; struct_deps
+        ; struct_is_union ; struct_members }
+      in
+      (id, struct_)
+    in
+    List.map build tag_defs
+  in
+
+  (* Get the definition of functions. *)
+  let functions =
+    let open AilSyntax in
+    let build (func_name, (ret_ty, args_decl, attrs)) =
+      (* Initialise all state. *)
+      Hashtbl.reset local_vars; reset_block_id ();
+      Hashtbl.reset used_globals; Hashtbl.reset used_functions;
+      hints := []; reset_assert_id ();
+      (* Fist parse that annotations. *)
+      let func_annot =
+        let fn () = Some(function_annot (collect_rc_attrs attrs)) in
+        handle_invalid_annot None fn ()
+      in
+      (* Then find out if the function is defined or just declared. *)
+      match List.find (fun (id, _) -> sym_to_str id = func_name) fun_defs with
+      | exception Not_found                                       ->
+          (* Function is only declared. *)
+          (func_name, FDec(func_annot))
+      | (_, (_, _, _, args, AnnotatedStatement(loc, s_attrs, stmt))) ->
+      (* Attributes on the function body are ignored. *)
+      warn_ignored_attrs None (List.rev (collect_rc_attrs s_attrs));
+      (* Function is defined. *)
+      let func_args =
+        let fn i (_, c_ty, _) =
+          let id = sym_to_str (List.nth args i) in
+          Hashtbl.add local_vars id (false, c_ty);
+          (id, layout_of true c_ty)
+        in
+        List.mapi fn args_decl
+      in
+      let (bindings, stmts) =
+        match stmt with
+        | AilSblock(bindings, stmts) -> (bindings, stmts)
+        | _                          -> not_impl loc "Body not a block."
+      in
+      (* Collection top level local variables. *)
+      insert_bindings bindings;
+      let func_init = fresh_block_id () in
+      let func_blocks =
+        let ret_ty = op_type_opt Cerb_location.unknown ret_ty in
+        let (stmt, blocks) =
+          let is_main = func_name = "main" in
+          translate_block stmts SMap.empty ret_ty is_main
+        in
+        add_block func_init stmt blocks
+      in
+      let func_hints = !hints in
+      let func_vars = collect_bindings () in
+      let func_deps =
+        let globals_used =
+          List.filter (Hashtbl.mem used_globals) (List.map fst global_vars)
+        in
+        let func_used =
+          let potential = List.map (fun (id, _) -> sym_to_str id) decls in
+          List.filter (Hashtbl.mem used_functions) potential
+        in
+        let sort = List.sort String.compare in
+        (sort globals_used, sort func_used)
+      in
+      let func =
+        { func_name ; func_annot ; func_args ; func_vars ; func_init
+        ; func_deps ; func_blocks ; func_hints }
+      in
+      (func_name, FDef(func))
+    in
+    List.map build fun_decls
+  in
+
+  { source_file ; entry_point ; global_vars ; structs ; functions }
diff --git a/refinedVST/typing/frontend_stuff/frontend/ail_to_coq.mli b/refinedVST/typing/frontend_stuff/frontend/ail_to_coq.mli
new file mode 100644
index 0000000000..5471533ed3
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/frontend/ail_to_coq.mli
@@ -0,0 +1,11 @@
+(** Entry point of the Cerberus typed Ail AST. *)
+type typed_ail =
+  Cerb_frontend.GenTypes.genTypeCategory Cerb_frontend.AilSyntax.ail_program
+
+(** [translate fname ail] translates the Cerberus typed Ail AST [ast] into our
+    Coq AST. The file name [fname] should correspond to the C source file that
+    lead to generating [ail].  In case of error an error message is displayed,
+    and the program fails with error code [-1]. Note that any invalid RefinedC
+    annotation is ignored (although a warning is displayed on [stderr]) but an
+    error will be triggered if one attempts to generate a spec file. *)
+val translate : string -> typed_ail -> Coq_ast.t
diff --git a/refinedVST/typing/frontend_stuff/frontend/cerb_wrapper.ml b/refinedVST/typing/frontend_stuff/frontend/cerb_wrapper.ml
new file mode 100644
index 0000000000..548732f7cb
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/frontend/cerb_wrapper.ml
@@ -0,0 +1,119 @@
+open Cerb_frontend
+open Cerb_backend
+open Pipeline
+
+type cpp_config =
+  { cpp_I        : string list
+  ; cpp_include  : string list
+  ; cpp_nostdinc : bool
+  ; cpp_D        : string list }
+
+let (>>=)  = Exception.except_bind
+let return = Exception.except_return
+
+let io : Pipeline.io_helpers =
+  let pass_message = let ref = ref 0 in fun str ->
+    Cerb_debug.print_success (Printf.sprintf "%i. %s" !ref str);
+    incr ref; return ()
+  in
+  let set_progress _ = return () in
+  let run_pp opts doc = run_pp opts doc; return () in
+  let print_endline str = print_endline str; return () in
+  let print_debug n mk_str = Cerb_debug.print_debug n [] mk_str; return () in
+  let warn ?(always=false) mk_str = Cerb_debug.warn ~always [] mk_str; return () in
+  {pass_message ; set_progress ; run_pp ; print_endline ; print_debug ; warn}
+
+let impl_name =
+  try Sys.getenv "IMPL_NAME" with Not_found ->
+    "gcc_4.9.0_x86_64-apple-darwin10.8.0"
+
+let set_cerb_conf () =
+  let open Cerb_global in
+  set_cerb_conf "RefinedC" false Random false Basic false false false false false
+
+let frontend cpp_cmd filename =
+  let conf =
+    { debug_level = 0 ; pprints = [] ; astprints = [] ; ppflags = []
+    ; typecheck_core = false ; rewrite_core = false
+    ; sequentialise_core = false ; cpp_cmd ; cpp_stderr = true }
+  in
+  set_cerb_conf ();
+  Ocaml_implementation.(set (HafniumImpl.impl));
+  load_core_stdlib () >>= fun stdlib ->
+  load_core_impl stdlib impl_name >>= fun impl ->
+  c_frontend (conf, io) (stdlib, impl) ~filename
+
+let run_cpp cpp_cmd filename =
+  let conf =
+    { debug_level = 0 ; pprints = [] ; astprints = [] ; ppflags = []
+    ; typecheck_core = false ; rewrite_core = false
+    ; sequentialise_core = false ; cpp_cmd ; cpp_stderr = true }
+  in
+  set_cerb_conf ();
+  cpp (conf, io) ~filename
+
+let cpp_cmd config =
+  let stdinc =
+    if config.cpp_nostdinc then []
+    else [Filename.concat (Cerb_runtime.runtime ()) "libc/include"]
+  in
+  let cpp_I = List.map (fun dir -> "-I" ^ dir) (stdinc @ config.cpp_I) in
+  let cpp_include =
+    List.map  (fun file -> "-include " ^ file) config.cpp_include
+  in
+  let macros =
+    ["__refinedc__"; "__cerb__"; "DEBUG"; "MAX_CPUS=4"; "MAX_VMS=2"; "HEAP_PAGES=10"]
+    @ config.cpp_D
+  in
+  let cpp_D = List.map (fun mac -> "-D" ^ mac) macros in
+  let opts = cpp_I @ cpp_include @ cpp_D in
+  let cmd = "cc -E -C -Werror -nostdinc -undef " ^ String.concat " " opts in
+  (* Printf.printf "CPP: %s\n%!" cmd; *) cmd
+
+(* A couple of things that the frontend does not seem to check. *)
+let source_file_check filename =
+  if not (Sys.file_exists filename) then
+    Panic.panic_no_pos "File [%s] does not exist." filename;
+  if Sys.is_directory filename then
+    Panic.panic_no_pos "A file was expected, [%s] is a directory." filename;
+  if not (Filename.check_suffix filename ".c") then
+    Panic.panic_no_pos "File [%s] does not have the [.c] extension." filename
+
+let c_file_to_ail config fname =
+  let open Exception in
+  source_file_check fname;
+  match frontend (cpp_cmd config) fname with
+  | Result(_, (_, ast)) -> ast
+  | Exception((loc,err))    ->
+  match err with
+  | CPP(_) -> Panic.panic_no_pos "Failed due to preprocessor error."
+  | _      ->
+  let err = Pp_errors.short_message err in
+  let (_, pos) =
+    try Cerb_location.head_pos_of_location loc with Invalid_argument(_) ->
+      ("", "(Cerberus position bug)")
+  in
+  Panic.panic loc "Frontend error.\n%s\n\027[0m%s%!" err pos
+
+let cpp_lines config fname =
+  source_file_check fname;
+  let str =
+    match run_cpp (cpp_cmd config) fname with
+    | Result(str)  -> str
+    | Exception(_) -> Panic.panic_no_pos "Failed due to preprocessor error."
+  in
+  String.split_on_char '\n' str
+
+let print_ail : Ail_to_coq.typed_ail -> unit = fun ast ->
+  match io.run_pp None (Pp_ail_ast.pp_program true false ast) with
+  | Result(_)            -> ()
+  | Exception((loc,err)) ->
+  match err with
+  | CPP(_) -> Panic.panic_no_pos "Failed due to preprocessor error."
+  | _      ->
+  let err = Pp_errors.short_message err in
+  let (_, pos) =
+    try Cerb_location.head_pos_of_location loc with Invalid_argument(_) ->
+      ("", "(Cerberus position bug)")
+  in
+  Panic.panic loc "Frontend error.\n%s\n\027[0m%s%!" err pos
diff --git a/refinedVST/typing/frontend_stuff/frontend/cerb_wrapper.mli b/refinedVST/typing/frontend_stuff/frontend/cerb_wrapper.mli
new file mode 100644
index 0000000000..5a972a6881
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/frontend/cerb_wrapper.mli
@@ -0,0 +1,21 @@
+(** Preprocessor configuration. *)
+type cpp_config =
+  { cpp_I        : string list (** Directories in the search path.    *)
+  ; cpp_include  : string list (** Add as includes in source file.    *)
+  ; cpp_nostdinc : bool        (** Do not search standard lib C dirs. *)
+  ; cpp_D        : string list (** Issue the given macro definition.  *) }
+
+(** [c_file_to_ail config fname] uses Cerberus to preprocess, parse, elaborate
+    and type-check the C source file [fname]. The given configuration [config]
+    is used to alter the behaviour of the preprocessor. In case of an error, a
+    message is displayed and the program exits with error code [-1]. *)
+val c_file_to_ail : cpp_config -> string -> Ail_to_coq.typed_ail
+
+(** [cpp_lines config fname] preprocesses the C file [fname] with Cerberus and
+    returns the obtained list of lines. The configuration [config] can be used
+    to alter the behaviour of the preprocessor. In case of an error, a message
+    is displayed and the program exits with error code [-1]. *)
+val cpp_lines : cpp_config -> string -> string list
+
+(** [print_ail ast] outputs the given Ail [ast] to standard output. *)
+val print_ail : Ail_to_coq.typed_ail -> unit
diff --git a/refinedVST/typing/frontend_stuff/frontend/comment_annot.ml b/refinedVST/typing/frontend_stuff/frontend/comment_annot.ml
new file mode 100644
index 0000000000..867a87b842
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/frontend/comment_annot.ml
@@ -0,0 +1,146 @@
+(** Support for annotations in special comments. *)
+
+type inlined_code =
+  { ic_prelude : string list
+  ; ic_section : string list
+  ; ic_final   : string list }
+
+type comment_annots =
+  { ca_inlined       : inlined_code
+  ; ca_requires      : string list
+  ; ca_imports       : (string * string) list
+  ; ca_proof_imports : (string * string) list
+  ; ca_code_imports  : (string * string) list
+  ; ca_context       : string list
+  ; ca_typedefs      : Rc_annot.typedef list }
+
+type annot_line =
+  | AL_annot of string * string option
+  | AL_comm  of string
+  | AL_none
+
+let read_line : string -> annot_line = fun s ->
+  (* First try to read an annotation comment. *)
+  let k_annot name n =
+    let payload = String.trim (String.sub s n (String.length s - n)) in
+    let payload = if payload = "" then None else Some(payload) in
+    AL_annot(name, payload)
+  in
+  try Scanf.sscanf s "//@rc::%s%n" k_annot
+  with End_of_file | Scanf.Scan_failure(_) ->
+  (* Then try to read a comment. *)
+  let k_comm n = AL_comm(String.sub s n (String.length s - n)) in
+  try Scanf.sscanf s "//@%n" k_comm
+  with End_of_file | Scanf.Scan_failure(_) ->
+  (* Line has no special meaning. *)
+  AL_none
+
+type where = Default | CodeOnly | ProofsOnly
+
+let read_import : string -> (string * string * where) option = fun s ->
+  let k proof_only mod_name from = Some(from, mod_name, proof_only) in
+  (* First try to read an import that is only for proofs. *)
+  try Scanf.sscanf s "%s from %s (for proofs only) %!" (k ProofsOnly)
+  with End_of_file | Scanf.Scan_failure(_) ->
+  (* Then try to read an import that is only for the code. *)
+  try Scanf.sscanf s "%s from %s (for code only) %!" (k CodeOnly)
+  with End_of_file | Scanf.Scan_failure(_) ->
+  (* Then try to read a general import. *)
+  try Scanf.sscanf s "%s from %s %!" (k Default)
+  with End_of_file | Scanf.Scan_failure(_) -> None
+
+let read_typedef : string -> Rc_annot.typedef option = fun s ->
+  let open Earley_core in
+  let parse_string = Earley.parse_string Rc_annot.typedef Blanks.default in
+  try Some(parse_string s) with Earley.Parse_error(_,_) -> None
+
+let parse_annots : string list -> comment_annots = fun ls ->
+  let error fmt =
+    Panic.panic_no_pos ("Comment annotation error: " ^^ fmt ^^ ".")
+  in
+  let imports = ref [] in
+  let requires = ref [] in
+  let inlined = ref [] in
+  let inlined_top = ref [] in
+  let inlined_end = ref [] in
+  let typedefs = ref [] in
+  let context = ref [] in
+  let read_block start_tag ls =
+    let rec read_block acc ls =
+      match ls with
+      | AL_comm(s)            :: ls -> read_block (s :: acc) ls
+      | AL_annot("end", None) :: ls -> (acc, ls)
+      | AL_annot("end", _   ) :: ls ->
+          error "[rc::end] does not expect a payload"
+      | AL_annot(_    , _   ) :: ls ->
+          error "unclosed [rc::%s] annotation" start_tag
+      | AL_none               :: ls ->
+          error "interrupted block"
+      | []                          ->
+          error "unclosed [rc::%s] annotation" start_tag
+    in
+    read_block [] ls
+  in
+  let rec loop ls =
+    match ls with
+    | []                  -> ()
+    | AL_none       :: ls -> loop ls
+    | AL_comm(_)    :: ls -> error "no block has been started"
+    | AL_annot(n,p) :: ls ->
+    let get_payload () =
+      match p with Some(s) -> s | None ->
+      error "annotation [rc::%s] expects a payload" n
+    in
+    let add_inlined r p ls =
+      let (lines, ls) =
+        match p with
+        | Some(s) -> ([s], ls)
+        | None    -> read_block n ls
+      in
+      r := lines @ !r; ls
+    in
+    match n with
+    | "inlined"         -> loop (add_inlined inlined p ls)
+    | "inlined_prelude" -> loop (add_inlined inlined_top p ls)
+    | "inlined_final"   -> loop (add_inlined inlined_end p ls)
+    | "end"     -> error "no block has been started"
+    | "import"  ->
+        begin
+          match (read_import (get_payload ())) with
+          | Some(i) -> imports := i :: !imports; loop ls
+          | None    -> error "invalid [rc::%s] annotation" n
+        end
+    | "require" ->
+        begin
+          let s = String.trim (get_payload ()) in
+          requires := s :: !requires; loop ls
+        end
+    | "typedef" ->
+        begin
+          match (read_typedef (get_payload ())) with
+          | Some(t) -> typedefs := t :: !typedefs; loop ls
+          | None    -> error ("invalid [rc::typedef] annotation")
+        end
+    | "context" ->
+        begin
+          context := get_payload () :: !context;
+          loop ls
+        end
+    | _         ->
+        error "unknown annotation [rc::%s]" n
+  in
+  loop (List.map read_line ls);
+  let imports = List.rev !imports in
+  let proof_imports = List.filter (fun (_,_,w) -> w = ProofsOnly) imports in
+  let code_imports  = List.filter (fun (_,_,w) -> w = CodeOnly  ) imports in
+  let imports       = List.filter (fun (_,_,w) -> w = Default   ) imports in
+  let ic_prelude = List.rev !inlined_top in
+  let ic_section = List.rev !inlined in
+  let ic_final   = List.rev !inlined_end in
+  { ca_inlined        = { ic_prelude ; ic_section ; ic_final }
+  ; ca_proof_imports  = List.map (fun (f,m,_) -> (f,m)) proof_imports
+  ; ca_code_imports   = List.map (fun (f,m,_) -> (f,m)) code_imports
+  ; ca_imports        = List.map (fun (f,m,_) -> (f,m)) imports
+  ; ca_requires       = List.rev !requires
+  ; ca_context        = List.rev !context
+  ; ca_typedefs       = List.rev !typedefs }
diff --git a/refinedVST/typing/frontend_stuff/frontend/coq_ast.ml b/refinedVST/typing/frontend_stuff/frontend/coq_ast.ml
new file mode 100644
index 0000000000..f9ba7c50fa
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/frontend/coq_ast.ml
@@ -0,0 +1,132 @@
+open Extra
+open Rc_annot
+
+type int_type =
+  | ItSize_t    of bool (* signed *)
+  | ItIntptr_t  of bool (* signed *)
+  | ItPtrdiff_t
+  | ItI8        of bool (* signed *)
+  | ItI16       of bool (* signed *)
+  | ItI32       of bool (* signed *)
+  | ItI64       of bool (* signed *)
+
+type layout =
+  | LVoid
+  | LBool
+  | LPtr
+  | LStruct of string * bool (* Union? *)
+  | LInt of int_type
+  | LArray of layout * string (* size *)
+
+type op_type =
+  | OpBool
+  | OpInt of int_type
+  | OpPtr of layout
+  | OpStruct of string * op_type list
+  | OpUntyped of layout
+
+type un_op =
+  | NotBoolOp
+  | NotIntOp
+  | NegOp
+  | CastOp of op_type
+
+type bin_op =
+  | AddOp | SubOp | MulOp | DivOp | ModOp | AndOp | OrOp | XorOp | ShlOp
+  | ShrOp | EqOp | NeOp | LtOp | GtOp | LeOp | GeOp | CommaOp
+  | LazyAndOp | LazyOrOp
+
+type value =
+  | Null
+  | Void
+  | Int of string * int_type
+  | SizeOf of layout
+
+let coq_locs : Location.Pool.t = Location.Pool.make ()
+
+type expr = expr_aux Location.located
+and expr_aux =
+  | Var       of string option * bool (* Global? *)
+  | Val       of value
+  | UnOp      of un_op * op_type * expr
+  | BinOp     of bin_op * op_type * op_type * expr * expr
+  | Deref     of bool (* Atomic? *) * op_type * expr
+  | CAS       of op_type * expr * expr * expr
+  | Call      of expr * expr list
+  | IfE       of op_type * expr * expr * expr
+  | SkipE     of expr
+  | Use       of bool (* Atomic? *) * op_type * expr
+  | AddrOf    of expr
+  | LValue    of expr
+  | GetMember of expr * string * bool (* From_union? *) * string
+  | OffsetOf  of string * bool (* From_union? *) * string
+  | AnnotExpr of int * coq_expr * expr
+  | Struct    of string * (string * expr) list
+  | Macro     of string * string list * expr list * expr
+  | CopyAID   of op_type * expr * expr
+
+type expr_annot =
+  | ExprAnnot_annot  of string
+  | ExprAnnot_assert of int
+
+type stmt = stmt_aux Location.located
+and stmt_aux =
+  | Goto   of string (* Block index in the [IMap.t]. *)
+  | Return of expr
+  | Switch of int_type * expr * (string * int) list * stmt list * stmt
+  | Assign of bool (* Atomic? *) * op_type * expr * expr * stmt
+  | SkipS  of stmt
+  | If     of op_type * string option (* join label *) * expr * stmt * stmt
+  | Assert of op_type * expr * stmt
+  | ExprS  of expr_annot option * expr * stmt
+
+(* The integers are respecively the alignment and the size. *)
+type field_data = member_annot option * (int * int) * layout
+
+type struct_decl =
+  { struct_name     : string
+  ; struct_annot    : struct_annot option
+  ; struct_deps     : string list
+  ; struct_is_union : bool
+  ; struct_members  : (string * field_data) list }
+
+type block_annot =
+  | BA_none
+  | BA_loop of state_descr
+
+type hint_kind =
+  | HK_block  of string
+  | HK_assert of int
+
+type hint =
+  { ht_kind  : hint_kind
+  ; ht_annot : state_descr }
+
+type func_def =
+  { func_name   : string
+  ; func_annot  : function_annot option
+  ; func_args   : (string * layout) list
+  ; func_vars   : (string * layout) list
+  ; func_init   : string
+  ; func_deps   : string list * string list (* global vars/functions used. *)
+  ; func_blocks : (block_annot * stmt) SMap.t
+  ; func_hints  : hint list }
+
+type func_def_or_decl =
+  | FDef of func_def
+  | FDec of function_annot option
+
+type t =
+  { source_file : string
+  ; entry_point : string option
+  ; global_vars : (string * global_annot option) list
+  ; structs     : (string * struct_decl) list
+  ; functions   : (string * func_def_or_decl) list }
+
+let proof_kind : func_def -> proof_kind = fun def ->
+  match def.func_annot with
+  | None        -> Proof_normal
+  | Some(annot) -> annot.fa_proof_kind
+
+let is_inlined : func_def -> bool = fun def ->
+  proof_kind def = Proof_inlined
diff --git a/refinedVST/typing/frontend_stuff/frontend/coq_path.ml b/refinedVST/typing/frontend_stuff/frontend/coq_path.ml
new file mode 100644
index 0000000000..d514b45b62
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/frontend/coq_path.ml
@@ -0,0 +1,83 @@
+open Extra
+
+type member = string
+
+let member_of_string : string -> member = fun s ->
+  let invalid r =
+    let f = "Name \"%s\" is invalid as a Coq path member: it " ^^ r ^^ "." in
+    invalid_arg f s
+  in
+  (* Empty string is invalid. *)
+  if String.length s = 0 then invalid "is empty";
+  (* Only accept characters, digits and underscores. *)
+  let check_char c =
+    match c with
+    | 'a'..'z' | 'A'..'Z' | '0'..'9' | '_' -> ()
+    | _ when Char.printable_ascii c        ->
+        invalid "contains '%c'" c;
+    | _                                    ->
+        invalid "uses non-printable ASCII characters" c;
+  in
+  String.iter check_char s;
+  (* Should not start with a letter. *)
+  match s.[0] with
+  | 'a'..'z' | 'A'..'Z' -> s
+  | c                   -> invalid "starts with '%c'" c
+
+let fixup_string_member : string -> string option = fun s ->
+  (* Remove non-ASCII characters. *)
+  let s = Ubase.from_utf8 ~malformed:"" ~strip:"" s in
+  (* Use underscores for invalid characters. *)
+  let fn c =
+    match c with
+    | 'a'..'z' | 'A'..'Z' | '0'..'9' -> c
+    | _                              -> '_'
+  in
+  let s = String.map fn s in
+  (* Remove leading underscores. *)
+  let s = String.trim_leading '_' s in
+  (* Check non-empty. *)
+  if String.length s = 0 then None else
+  (* Check starts with letter. *)
+  match s.[0] with
+  | 'a'..'z' | 'A'..'Z' -> Some(s)
+  | _                   -> None
+
+type path = Path of member * member list
+type t = path
+
+let path_of_members : member list -> path = fun ms ->
+  match ms with
+  | []    -> invalid_arg "Coq_path.path_of_members requires a non-empty list."
+  | m::ms -> Path(m, ms)
+
+let path_of_string : string -> path = fun s ->
+  let members = String.split_on_char '.' s in
+  try
+    match List.map member_of_string members with
+    | m :: ms -> Path(m, ms)
+    | []      -> invalid_arg "The empty module path is forbidden."
+  with Invalid_argument(msg) ->
+  invalid_arg "String \"%s\" is not a valid Coq module path.\n%s" s msg
+
+let fixup_string_path : string -> string option = fun s ->
+  let rec build ms acc =
+    match (ms, acc) with
+    | ([]     , []) -> None
+    | ([]     , _ ) -> Some(String.concat "." (List.rev acc))
+    | (m :: ms, _ ) ->
+    match fixup_string_member m with
+    | None    -> None
+    | Some(m) -> build ms (m :: acc)
+  in
+  build (String.split_on_char '.' s) []
+
+type suffix = member list
+
+let append : t -> suffix -> t = fun (Path(m, ms)) suff -> Path(m, ms @ suff)
+
+let to_string : path -> string = fun (Path(m, ms)) ->
+  String.concat "." (m :: ms)
+
+let pp : path pp = fun ff path ->
+  Format.pp_print_string ff (to_string path)
diff --git a/refinedVST/typing/frontend_stuff/frontend/coq_path.mli b/refinedVST/typing/frontend_stuff/frontend/coq_path.mli
new file mode 100644
index 0000000000..02b7a0d45f
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/frontend/coq_path.mli
@@ -0,0 +1,63 @@
+(** Management of Coq module paths.
+
+    Coq modules path identifiers and file names are restricted to be valid Coq
+    identifiers, with further restrictions (only ASCII letters, digits and the
+    underscore symbol). This module provides types that encapsulate components
+    of Coq module paths into abstract types, to enforces that they are valid.
+
+    Useful links:
+    - https://coq.inria.fr/refman/practical-tools/coq-commands.html
+    - https://coq.inria.fr/refman/language/core/basic.html#lexical-conventions
+*)
+
+open Extra
+
+(** Coq module path member. *)
+type member
+
+(** [member_of_string s] converts string [s] into a Coq module path member. If
+    the given string does not correspond to a valid path member, the exception
+    [Invalid_argument] is raised with an explanatory error message formed of a
+    full sentence, to be displayed directly (and ideally on its own line). *)
+val member_of_string : string -> member
+
+(** [fixup_string_member s] tries to build a resonable (valid) Coq module path
+    member name from the string [s]. This is done by replacing diacritic marks
+    by corresponding ASCII sequences if applicable, and by using ['_'] instead
+    of invalid characters like ['-']. If a result string is produced, applying
+    the [member_of_string] function to it is guaranteed to succeed. *)
+val fixup_string_member : string -> string option
+
+(** Coq module path. *)
+type path
+
+(** Short synonym for [path]. *)
+type t = path
+
+(** [path_of_members ms] turns the (non-empty) list of members [ms] into a Coq
+    module path. If [ms] is empty then [Invalid_argument] is raised. *)
+val path_of_members : member list -> path
+
+(** [path_of_string s] parses string [s] into a Coq module path. In case where
+    [s] does not denote a valid module path, then exception [Invalid_argument]
+    is raised with a full, explanatory error message. *)
+val path_of_string : string -> path
+
+(** [fixup_string_path s] is similar to [fixup_string_member] but for full Coq
+    module paths. If a result string is produced, applying [path_of_string] to
+    it it guaranteed to succeed (no exception is produced). *)
+val fixup_string_path : string -> string option
+
+(** Coq path suffix. *)
+type suffix = member list
+
+(** [append path suff] extends the Coq path [path] with suffix [suff]. *)
+val append : t -> suffix -> t
+
+(** [to_string path] converts the path [path] into a string directly usable as
+    the Coq representation of the path. *)
+val to_string : path -> string
+
+(** [pp ff path] prints the string representation of [path] (as obtained using
+    [to_string]) to the [ff] formatter. *)
+val pp : path pp
diff --git a/refinedVST/typing/frontend_stuff/frontend/coq_pp.ml b/refinedVST/typing/frontend_stuff/frontend/coq_pp.ml
new file mode 100644
index 0000000000..47c45c4692
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/frontend/coq_pp.ml
@@ -0,0 +1,1974 @@
+open Format
+open Extra
+open Panic
+open Coq_ast
+open Rc_annot
+open Comment_annot
+
+(* Flags set by CLI. *)
+let print_expr_locs = ref true
+let print_stmt_locs = ref true
+let no_mem_cast = ref false
+
+let pp_str = pp_print_string
+
+let pp_as_tuple : 'a pp -> 'a list pp = fun pp ff xs ->
+  match xs with
+  | []      -> pp_str ff "()"
+  | [x]     -> pp ff x
+  | x :: xs -> fprintf ff "(%a" pp x;
+               List.iter (fprintf ff ", %a" pp) xs;
+               pp_str ff ")"
+
+let pp_encoded_patt_name : bool -> string list pp = fun used ff xs ->
+  match xs with
+  | []  -> pp_str ff (if used then "unit__" else "_")
+  | [x] -> pp_str ff x
+  | _   -> pp_str ff "patt__"
+
+(* Print projection to get the [i]-th element of a tuple with [n] elements. *)
+let rec pp_projection : int -> int pp = fun n ff i ->
+  match n with
+  | 1                -> ()
+  | _ when i = n - 1 -> fprintf ff ".2"
+  | _                -> fprintf ff ".1%a" (pp_projection (n - 1)) i
+
+let pp_encoded_patt_bindings : string list pp = fun ff xs ->
+  let nb = List.length xs in
+  if nb <= 1 then () else
+  let pp_let i x =
+    fprintf ff "let %s := patt__%a in@;" x (pp_projection nb) i
+  in
+  List.iteri pp_let xs
+
+let pp_sep : string -> 'a pp -> 'a list pp = fun sep pp ff xs ->
+  match xs with
+  | []      -> ()
+  | x :: xs -> pp ff x; List.iter (fprintf ff "%s%a" sep pp) xs
+
+let pp_as_prod : 'a pp -> 'a list pp = fun pp ff xs ->
+  match xs with
+  | [] -> pp_str ff "()"
+  | _  -> pp_sep " * " pp ff xs
+
+let pp_id_args : bool -> string -> string list pp = fun need_paren id ff xs ->
+  if xs <> [] && need_paren then pp_str ff "(";
+  pp_str ff id; List.iter (fprintf ff " %s") xs;
+  if xs <> [] && need_paren then pp_str ff ")"
+
+let pp_simple_coq_expr wrap ff coq_e =
+  match coq_e with
+  | Coq_ident(x)             -> pp_str ff x
+  | Coq_all([Quot_plain(s)]) -> fprintf ff (if wrap then "(%s)" else "%s") s
+  | _                        ->
+  Panic.panic_no_pos "Antiquotation forbidden here." (* FIXME location *)
+
+let pp_int_type : Coq_ast.int_type pp = fun ff it ->
+  let pp fmt = Format.fprintf ff fmt in
+  match it with
+  | ItSize_t(true)      -> pp "ssize_t"
+  | ItSize_t(false)     -> pp "size_t"
+  | ItIntptr_t(true)    -> pp "intptr_t"
+  | ItIntptr_t(false)   -> pp "uintptr_t"
+  | ItPtrdiff_t         -> pp "ptrdiff_t"
+  | ItI8(true)          -> pp "i8"
+  | ItI8(false)         -> pp "u8"
+  | ItI16(true)         -> pp "i16"
+  | ItI16(false)        -> pp "u16"
+  | ItI32(true)         -> pp "i32"
+  | ItI32(false)        -> pp "u32"
+  | ItI64(true)         -> pp "i64"
+  | ItI64(false)        -> pp "u64"
+
+let rec pp_layout : bool -> Coq_ast.layout pp = fun wrap ff layout ->
+  let pp fmt = Format.fprintf ff fmt in
+  match layout with
+  | LVoid              -> pp "void_layout"
+  | LBool              -> pp "bool_layout"
+  | LPtr               -> pp "void*"
+  | _ when wrap        -> pp "(%a)" (pp_layout false) layout
+  | LStruct(id, false) -> pp "layout_of struct_%s" id
+  | LStruct(id, true ) -> pp "ul_layout union_%s" id
+  | LInt(i)            -> pp "it_layout %a" pp_int_type i
+  | LArray(layout, n)  -> pp "mk_array_layout %a %s"
+                            (pp_layout true) layout n
+
+let rec pp_op_type : Coq_ast.op_type pp = fun ff ty ->
+  let pp fmt = Format.fprintf ff fmt in
+  match ty with
+  | OpBool           -> pp "BoolOp"
+  | OpInt(i)         -> pp "IntOp %a" pp_int_type i
+  | OpPtr(_)         -> pp "PtrOp" (* FIXME *)
+  | OpStruct(id, os) -> pp "StructOp struct_%s ([ %a ])" id (pp_sep " ; " pp_op_type) os
+  | OpUntyped(ly)    -> pp "UntypedOp (%a)" (pp_layout false) ly
+
+let pp_un_op : Coq_ast.un_op pp = fun ff op ->
+  let pp fmt = Format.fprintf ff fmt in
+  match op with
+  | NotBoolOp  -> pp "NotBoolOp"
+  | NotIntOp   -> pp "NotIntOp"
+  | NegOp      -> pp "NegOp"
+  | CastOp(ty) -> pp "(CastOp $ %a)" pp_op_type ty
+
+let pp_bin_op : Coq_ast.bin_op pp = fun ff op ->
+  pp_str ff @@
+  match op with
+  | AddOp     -> "+"
+  | SubOp     -> "-"
+  | MulOp     -> "×"
+  | DivOp     -> "/"
+  | ModOp     -> "%"
+  | AndOp     -> "&"
+  | OrOp      -> "|"
+  | XorOp     -> "^"
+  | ShlOp     -> "<<"
+  | ShrOp     -> ">>"
+  | EqOp      -> "="
+  | NeOp      -> "!="
+  | LtOp      -> "<"
+  | GtOp      -> ">"
+  | LeOp      -> "≤"
+  | GeOp      -> "≥"
+  | CommaOp   -> ","
+  | LazyAndOp -> "&&"
+  | LazyOrOp  -> "||"
+
+let is_bool_result_op = fun op ->
+  match op with
+  | EqOp | NeOp | LtOp | GtOp | LeOp | GeOp -> true
+  | LazyAndOp | LazyOrOp -> true
+  | _ -> false
+
+let rec pp_expr : Coq_ast.expr pp = fun ff e ->
+  let pp fmt = Format.fprintf ff fmt in
+  let pp_expr_body ff e =
+    match Location.(e.elt) with
+    | Var(None   ,_)                ->
+        pp "\"_\""
+    | Var(Some(x),g)                ->
+        if g then fprintf ff "global_%s" x else fprintf ff "\"%s\"" x
+    | Val(Null)                     ->
+        pp "NULL"
+    | Val(Void)                     ->
+        pp "VOID"
+    | Val(Int(s,it))                ->
+        pp "i2v %s %a" s pp_int_type it
+    | Val(SizeOf(ly))               ->
+        pp "i2v (%a).(ly_size) %a" (pp_layout false) ly
+          pp_int_type (ItSize_t false)
+    | UnOp(op,ty,e)                 ->
+        pp "UnOp %a (%a) (%a)" pp_un_op op pp_op_type ty pp_expr e
+    | BinOp(op,ty1,ty2,e1,e2)       ->
+        begin
+          match (ty1, ty2, op) with
+          (* Comma operator. *)
+          | (_       , _       , CommaOp) ->
+              pp "(%a) %a{%a, %a} (%a)" pp_expr e1 pp_bin_op op
+                pp_op_type ty1 pp_op_type ty2 pp_expr e2
+          (* Pointer offset operations. *)
+          | (OpPtr(l), OpInt(_), AddOp  ) ->
+              pp "(%a) at_offset{%a, PtrOp, %a} (%a)" pp_expr e1
+                (pp_layout false) l pp_op_type ty2 pp_expr e2
+          | (OpPtr(l), OpInt(_), SubOp  ) ->
+              pp "(%a) at_neg_offset{%a, PtrOp, %a} (%a)" pp_expr e1
+                (pp_layout false) l pp_op_type ty2 pp_expr e2
+          (* Pointer difference. *)
+          | (OpPtr(l1), OpPtr(l2), SubOp) ->
+              pp "(%a) sub_ptr{%a, PtrOp, PtrOp} (%a)" pp_expr e1
+                (pp_layout false) l1 pp_expr e2
+          (* Pointer compared to 0 (Cerberus rejects non-0 integer values). *)
+          | (OpInt(_) , OpPtr(l) , (EqOp | NeOp)) ->
+              let e1 = {e1 with elt = UnOp(CastOp(ty2), ty1, e1)} in
+              pp "(%a) %a{PtrOp, PtrOp, i32} (%a)" pp_expr e1
+                pp_bin_op op pp_expr e2
+          | (OpPtr(l) , OpInt(_) , (EqOp | NeOp)) ->
+              let e2 = {e2 with elt = UnOp(CastOp(ty1), ty2, e2)} in
+              pp "(%a) %a{PtrOp, PtrOp, i32} (%a)" pp_expr e1
+                pp_bin_op op pp_expr e2
+          (* Invalid operations mixing an integer and a pointer. *)
+          | (OpPtr(_), OpInt(_), _      )
+          | (OpInt(_), OpPtr(_), _      ) ->
+              let loc = Location.to_cerb_loc e.loc in
+              panic loc "Invalid use of binary operation [%a]." pp_bin_op op
+          (* All other operations are defined. *)
+          | _                             ->
+              if is_bool_result_op op then
+                pp "(%a) %a{%a, %a, i32} (%a)" pp_expr e1 pp_bin_op op
+                  pp_op_type ty1 pp_op_type ty2 pp_expr e2
+              else
+                pp "(%a) %a{%a, %a} (%a)" pp_expr e1 pp_bin_op op
+                  pp_op_type ty1 pp_op_type ty2 pp_expr e2
+        end
+    | Deref(atomic,ty,e)            ->
+       if !no_mem_cast then
+         if atomic then
+           pp "!{%a, ScOrd, false} (%a)" pp_op_type ty pp_expr e
+         else
+           pp "!{%a, Na1Ord, false} (%a)" pp_op_type ty pp_expr e
+        else
+         if atomic then
+           pp "!{%a, ScOrd} (%a)" pp_op_type ty pp_expr e
+         else
+           pp "!{%a} (%a)" pp_op_type ty pp_expr e
+    | CAS(ty,e1,e2,e3)              ->
+        pp "CAS@ (%a)@ (%a)@ (%a)@ (%a)" pp_op_type ty
+          pp_expr e1 pp_expr e2 pp_expr e3
+    | Call(e,es)        ->
+      let pp_args _ es =
+        let n = List.length es in
+        let fn i e =
+          pp (if i = n - 1 then "%a" else "%a ;@;") pp_expr e
+        in
+        List.iteri fn es
+      in
+      pp "Call (%a) [@@{expr} %a ]" pp_expr e pp_args es
+    | IfE(ty,e1,e2,e3)              ->
+        pp "IfE@ (%a)@ (%a)@ (%a)@ (%a)" pp_op_type ty
+          pp_expr e1 pp_expr e2 pp_expr e3
+    | SkipE(e)                      ->
+        pp "SkipE (%a)" pp_expr e
+    | Use(atomic,ty,e)              ->
+       if !no_mem_cast then
+         if atomic then
+           pp "use{%a, ScOrd, false} (%a)" pp_op_type ty pp_expr e
+         else
+           pp "use{%a, Na1Ord, false} (%a)" pp_op_type ty pp_expr e
+       else
+         if atomic then
+           pp "use{%a, ScOrd} (%a)" pp_op_type ty pp_expr e
+         else
+           pp "use{%a} (%a)" pp_op_type ty pp_expr e
+    | AddrOf(e)                     ->
+        pp "&(%a)" pp_expr e
+    | LValue(e)                     ->
+        pp "LValue (%a)" pp_expr e
+    | GetMember(e,name,false,field) ->
+        pp "(%a) at{struct_%s} %S" pp_expr e name field
+    | GetMember(e,name,true ,field) ->
+        pp "(%a) at_union{union_%s} %S" pp_expr e name field
+    | OffsetOf(name,false,field)    ->
+        pp "(OffsetOf (struct_%s) (%S))" name field
+    | OffsetOf(name,true ,field)    ->
+        pp "(OffsetOfUnion (union_%s) (%S))" name field
+    | AnnotExpr(i,coq_e,e)          ->
+        pp "AnnotExpr %i%%nat %a (%a)" i
+          (pp_simple_coq_expr true) coq_e pp_expr e
+    | Struct(id, fs)                ->
+        pp "@[@[<hov 2>StructInit struct_%s [" id;
+        let fn i (id, e) =
+          let s = if i = List.length fs - 1 then "" else " ;" in
+          pp "@;(%S, %a : expr)%s" id pp_expr e s
+        in
+        List.iteri fn fs;
+        pp "@]@;]@]"
+    | Macro(name, args, es, e)      ->
+        pp "@[@[<hov 2>CheckedMacroE (%s %s) [" name (String.concat " " args);
+        let fn i e =
+          let s = if i = List.length es - 1 then "" else " ;" in
+          pp "@;(%a : expr)%s" pp_expr e s
+        in
+        List.iteri fn es;
+        pp "@]@;] (%a : expr)@]" pp_expr e
+    | CopyAID(ot2, e1, e2)          ->
+        pp "CopyAllocId (%a) (%a) (%a)" pp_op_type ot2 pp_expr e1 pp_expr e2
+  in
+  match Location.get e.loc with
+  | Some(d) when !print_expr_locs ->
+      pp "LocInfoE loc_%i (%a)" d.loc_key pp_expr_body e
+  | _                             ->
+      pp "%a" pp_expr_body e
+
+
+let pp_if_join : string option pp = fun ff opt ->
+  let pp fmt = Format.fprintf ff fmt in
+    match opt with
+    | None -> pp "None"
+    | Some lb -> pp "Some %S" lb
+
+let rec pp_stmt : Coq_ast.stmt pp = fun ff stmt ->
+  let pp fmt = Format.fprintf ff fmt in
+  if !print_stmt_locs then
+    begin
+      match Location.get stmt.loc with
+      | None    -> ()
+      | Some(d) -> pp "locinfo: loc_%i ;@;" d.loc_key
+    end;
+  match stmt.elt with
+  | Goto(id)                      ->
+      pp "Goto %S" id
+  | Return(e)                     ->
+      pp "Return @[<hov 0>(%a)@]" pp_expr e
+  | Switch(it,e,map,bs,def)       ->
+      pp "@[<v 2>Switch %a@;" pp_int_type it;
+      pp "(%a)@;" pp_expr e;
+      begin
+        match map with
+        | []         -> pp "∅@;"
+        | (k,v)::map ->
+        pp "@[<v 2>(@;<[ %s := %i%%nat ]> " k v;
+        List.iter (fun (k,v) -> pp "$@;<[ %s := %i%%nat ]> " k v) map;
+        pp "∅@]@;)@;"
+      end;
+      begin
+        match bs with
+        | []    -> pp "[]@;"
+        | b::bs ->
+        pp "@[<v 2>(@;(%a)" pp_stmt b;
+        List.iter (pp " ::@;(%a)" pp_stmt) bs;
+        pp " :: []@]@;)@;"
+      end;
+      pp "(%a)@]" pp_stmt def
+  | Assign(atomic,ot,e1,e2,stmt) ->
+      let order = if atomic then ", ScOrd" else "" in
+      pp "@[<hov 2>%a <-{ %a%s }@ %a ;@]@;%a"
+        pp_expr e1 pp_op_type ot order pp_expr e2 pp_stmt stmt
+  | SkipS(stmt)                   ->
+      pp_stmt ff stmt
+  | If(ot,lb_opt,e,stmt1,stmt2)   ->
+      pp "if{%a, %a}: @[<hov 0>%a@]@;then@;@[<v 2>%a@]@;else@;@[<v 2>%a@]"
+        pp_op_type ot pp_if_join lb_opt pp_expr e pp_stmt stmt1 pp_stmt stmt2
+  | Assert(ot,e,stmt)             ->
+      pp "assert{%a}: (%a) ;@;%a" pp_op_type ot pp_expr e pp_stmt stmt
+  | ExprS(annot, e, stmt)         ->
+      let pp_expr_annot annot =
+        match annot with
+        | ExprAnnot_annot s    -> pp "annot: (%s) ;@;" s
+        | ExprAnnot_assert(id) -> pp "annot: (AssertAnnot \"%i\") ;@;" id
+      in
+      Option.iter pp_expr_annot annot;
+      pp "expr: (%a) ;@;%a" pp_expr e pp_stmt stmt
+
+type import = string * string
+
+let pp_import ff (from, mod_name) =
+  Format.fprintf ff "From %s Require Import %s.@;" from mod_name
+
+let pp_code : string -> import list -> Coq_ast.t pp =
+    fun root_dir imports ff ast ->
+  (* Formatting utilities. *)
+  let pp fmt = Format.fprintf ff fmt in
+
+  (* Printing some header. *)
+  pp "@[<v 0>From caesium Require Export notation.@;";
+  pp "From caesium Require Import tactics.@;";
+  pp "From refinedc.typing Require Import annotations.@;";
+  List.iter (pp_import ff) imports;
+  pp "Set Default Proof Using \"Type\".@;@;";
+
+  (* Printing generation data in a comment. *)
+  pp "(* Generated from [%s]. *)@;" ast.source_file;
+
+  (* Opening the section. *)
+  pp "@[<v 2>Section code.";
+
+  (* Printing of location data. *)
+  if !print_expr_locs || !print_stmt_locs then
+    begin
+      let (all_locations, all_files) =
+        let open Location in
+        let locs = ref [] in
+        let files = ref [] in
+        let fn ({loc_file = file; _} as d) =
+          locs := d :: !locs;
+          if not (List.mem file !files) then files := file :: !files
+        in
+        Location.Pool.iter fn coq_locs;
+        let locs = List.sort (fun d1 d2 -> d1.loc_key - d2.loc_key) !locs in
+        let files = List.mapi (fun i s -> (s, i)) !files in
+        (locs, files)
+      in
+      let pp_file_def (file, key) =
+        let file =
+          try Filename.relative_path root_dir file
+          with Invalid_argument(_) -> file
+        in
+        fprintf ff "@;Definition file_%i : string := \"%s\"." key file
+      in
+      List.iter pp_file_def all_files;
+      let pp_loc_def d =
+        let open Location in
+        pp "@;Definition loc_%i : location_info := " d.loc_key;
+        pp "LocationInfo file_%i %i %i %i %i."
+          (List.assoc d.loc_file all_files)
+          d.loc_line1 d.loc_col1 d.loc_line2 d.loc_col2
+      in
+      List.iter pp_loc_def all_locations;
+    end;
+
+  (* Printing for struct/union members. *)
+  let pp_members members is_struct =
+    let nb_bytes = ref 0 in
+    let n = List.length members in
+    let fn i (id, (attrs, (align, size), layout)) =
+      (* Insert padding for field alignment (for structs). *)
+      if is_struct && !nb_bytes mod align <> 0 then
+        begin
+          let pad = align - !nb_bytes mod align in
+          pp "@;(None, Layout %i%%nat 0%%nat);" pad;
+          nb_bytes := !nb_bytes + pad;
+        end;
+      let sc = if i = n - 1 then "" else ";" in
+      let some = if is_struct then "Some " else "" in
+      pp "@;(%s%S, %a)%s" some id (pp_layout false) layout sc;
+      nb_bytes := !nb_bytes + size
+    in
+    List.iteri fn members;
+    (* Insert final padding if necessary. *)
+    if is_struct then
+      begin
+        let max_align =
+          let fn acc (_,(_,(align,_),_)) = max acc align in
+          List.fold_left fn 1 members
+        in
+        let r = !nb_bytes mod max_align in
+        if r <> 0 then pp ";@;(None, Layout %i%%nat 0%%nat)" (max_align - r)
+      end
+  in
+
+  (* Definition of structs/unions. *)
+  let pp_struct (id, decl) =
+    pp "\n@;(* Definition of struct [%s]. *)@;" id;
+    pp "@[<v 2>Program Definition struct_%s := {|@;" id;
+
+    pp "@[<v 2>sl_members := [";
+    pp_members decl.struct_members true;
+    pp "@]@;];@]@;|}.@;";
+    pp "Solve Obligations with solve_struct_obligations."
+  in
+  let pp_union (id, decl) =
+    pp "\n@;(* Definition of union [%s]. *)@;" id;
+    pp "@[<v 2>Program Definition union_%s := {|@;" id;
+
+    pp "@[<v 2>ul_members := [";
+    pp_members decl.struct_members false;
+    pp "@]@;];@]@;|}.@;";
+    pp "Solve Obligations with solve_struct_obligations."
+  in
+  let rec sort_structs found strs =
+    match strs with
+    | []                     -> []
+    | (id, s) as str :: strs ->
+    if List.for_all (fun id -> List.mem id found) s.struct_deps then
+      str :: sort_structs (id :: found) strs
+    else
+      sort_structs found (strs @ [str])
+  in
+  let pp_struct_union ((_, {struct_is_union; _}) as s) =
+    if struct_is_union then pp_union s else pp_struct s
+  in
+  List.iter pp_struct_union (sort_structs [] ast.structs);
+
+  (* Definition of functions. *)
+  let pp_function_def (id, def) =
+    let deps = fst def.func_deps @ snd def.func_deps in
+    pp "\n@;(* Definition of function [%s]. *)@;" id;
+    pp "@[<v 2>Definition impl_%s " id;
+    if deps <> [] then begin
+      pp "(";
+      List.iter (pp "global_%s ") deps;
+      pp ": loc)";
+    end;
+    pp ": function := {|@;";
+
+    pp "@[<v 2>f_args := [";
+    begin
+      let n = List.length def.func_args in
+      let fn i (id, layout) =
+        let sc = if i = n - 1 then "" else ";" in
+        pp "@;(%S, %a)%s" id (pp_layout false) layout sc
+      in
+      List.iteri fn def.func_args
+    end;
+    pp "@]@;];@;";
+
+    pp "@[<v 2>f_local_vars := [";
+    begin
+      let n = List.length def.func_vars in
+      let fn i (id, layout) =
+        let sc = if i = n - 1 then "" else ";" in
+        pp "@;(%S, %a)%s" id (pp_layout false) layout sc
+      in
+      List.iteri fn def.func_vars
+    end;
+    pp "@]@;];@;";
+
+    pp "f_init := \"#0\";@;";
+
+    pp "@[<v 2>f_code := (";
+    begin
+      let fn id (attrs, stmt) =
+        pp "@;@[<v 2><[ \"%s\" :=@;" id;
+
+        pp_stmt ff stmt;
+        pp "@]@;]> $";
+      in
+      SMap.iter fn def.func_blocks;
+      pp "∅"
+    end;
+    pp "@]@;)%%E";
+    pp "@]@;|}.";
+  in
+  let pp_function (id, def_or_decl) =
+    match def_or_decl with
+    | FDef(def) -> pp_function_def (id, def)
+    | _         -> ()
+  in
+  List.iter pp_function ast.functions;
+
+  (* Closing the section. *)
+  pp "@]@;End code.@]"
+
+let pp_code_vst : string -> import list -> Coq_ast.t pp =
+    fun root_dir imports ff ast ->
+  (* Formatting utilities. *)
+  let pp fmt = Format.fprintf ff fmt in
+
+  (* Printing some header. *)
+  pp "@[<v 0>From caesium Require Export notation.@;";
+  pp "From caesium Require Import tactics.@;";
+  pp "From VST.typing Require Import annotations.@;";
+  List.iter (pp_import ff) imports;
+  pp "Set Default Proof Using \"Type\".@;@;";
+
+  (* Printing generation data in a comment. *)
+  pp "(* Generated from [%s]. *)@;" ast.source_file;
+
+  (* Opening the section. *)
+  pp "@[<v 2>Section code.";
+
+  (* Printing of location data. *)
+  if !print_expr_locs || !print_stmt_locs then
+    begin
+      let (all_locations, all_files) =
+        let open Location in
+        let locs = ref [] in
+        let files = ref [] in
+        let fn ({loc_file = file; _} as d) =
+          locs := d :: !locs;
+          if not (List.mem file !files) then files := file :: !files
+        in
+        Location.Pool.iter fn coq_locs;
+        let locs = List.sort (fun d1 d2 -> d1.loc_key - d2.loc_key) !locs in
+        let files = List.mapi (fun i s -> (s, i)) !files in
+        (locs, files)
+      in
+      let pp_file_def (file, key) =
+        let file =
+          try Filename.relative_path root_dir file
+          with Invalid_argument(_) -> file
+        in
+        fprintf ff "@;Definition file_%i : string := \"%s\"." key file
+      in
+      List.iter pp_file_def all_files;
+      let pp_loc_def d =
+        let open Location in
+        pp "@;Definition loc_%i : location_info := " d.loc_key;
+        pp "LocationInfo file_%i %i %i %i %i."
+          (List.assoc d.loc_file all_files)
+          d.loc_line1 d.loc_col1 d.loc_line2 d.loc_col2
+      in
+      List.iter pp_loc_def all_locations;
+    end;
+
+  (* Printing for struct/union members. *)
+  let pp_members members is_struct =
+    let nb_bytes = ref 0 in
+    let n = List.length members in
+    let fn i (id, (attrs, (align, size), layout)) =
+      (* Insert padding for field alignment (for structs). *)
+      if is_struct && !nb_bytes mod align <> 0 then
+        begin
+          let pad = align - !nb_bytes mod align in
+          pp "@;(None, Layout %i%%nat 0%%nat);" pad;
+          nb_bytes := !nb_bytes + pad;
+        end;
+      let sc = if i = n - 1 then "" else ";" in
+      let some = if is_struct then "Some " else "" in
+      pp "@;(%s%S, %a)%s" some id (pp_layout false) layout sc;
+      nb_bytes := !nb_bytes + size
+    in
+    List.iteri fn members;
+    (* Insert final padding if necessary. *)
+    if is_struct then
+      begin
+        let max_align =
+          let fn acc (_,(_,(align,_),_)) = max acc align in
+          List.fold_left fn 1 members
+        in
+        let r = !nb_bytes mod max_align in
+        if r <> 0 then pp ";@;(None, Layout %i%%nat 0%%nat)" (max_align - r)
+      end
+  in
+
+  (* Definition of structs/unions. *)
+  let pp_struct (id, decl) =
+    pp "\n@;(* Definition of struct [%s]. *)@;" id;
+    pp "@[<v 2>Program Definition struct_%s := {|@;" id;
+
+    pp "@[<v 2>sl_members := [";
+    pp_members decl.struct_members true;
+    pp "@]@;];@]@;|}.@;";
+    pp "Solve Obligations with solve_struct_obligations."
+  in
+  let pp_union (id, decl) =
+    pp "\n@;(* Definition of union [%s]. *)@;" id;
+    pp "@[<v 2>Program Definition union_%s := {|@;" id;
+
+    pp "@[<v 2>ul_members := [";
+    pp_members decl.struct_members false;
+    pp "@]@;];@]@;|}.@;";
+    pp "Solve Obligations with solve_struct_obligations."
+  in
+  let rec sort_structs found strs =
+    match strs with
+    | []                     -> []
+    | (id, s) as str :: strs ->
+    if List.for_all (fun id -> List.mem id found) s.struct_deps then
+      str :: sort_structs (id :: found) strs
+    else
+      sort_structs found (strs @ [str])
+  in
+  let pp_struct_union ((_, {struct_is_union; _}) as s) =
+    if struct_is_union then pp_union s else pp_struct s
+  in
+  List.iter pp_struct_union (sort_structs [] ast.structs);
+
+  (* Definition of functions. *)
+  let pp_function_def (id, def) =
+    let deps = fst def.func_deps @ snd def.func_deps in
+    pp "\n@;(* Definition of function [%s]. *)@;" id;
+    pp "@[<v 2>Definition impl_%s " id;
+    if deps <> [] then begin
+      pp "(";
+      List.iter (pp "global_%s ") deps;
+      pp ": loc)";
+    end;
+    pp ": function := {|@;";
+
+    pp "@[<v 2>f_args := [";
+    begin
+      let n = List.length def.func_args in
+      let fn i (id, layout) =
+        let sc = if i = n - 1 then "" else ";" in
+        pp "@;(%S, %a)%s" id (pp_layout false) layout sc
+      in
+      List.iteri fn def.func_args
+    end;
+    pp "@]@;];@;";
+
+    pp "@[<v 2>f_local_vars := [";
+    begin
+      let n = List.length def.func_vars in
+      let fn i (id, layout) =
+        let sc = if i = n - 1 then "" else ";" in
+        pp "@;(%S, %a)%s" id (pp_layout false) layout sc
+      in
+      List.iteri fn def.func_vars
+    end;
+    pp "@]@;];@;";
+
+    pp "f_init := \"#0\";@;";
+
+    pp "@[<v 2>f_code := (";
+    begin
+      let fn id (attrs, stmt) =
+        pp "@;@[<v 2><[ \"%s\" :=@;" id;
+
+        pp_stmt ff stmt;
+        pp "@]@;]> $";
+      in
+      SMap.iter fn def.func_blocks;
+      pp "∅"
+    end;
+    pp "@]@;)%%E";
+    pp "@]@;|}.";
+  in
+  let pp_function (id, def_or_decl) =
+    match def_or_decl with
+    | FDef(def) -> pp_function_def (id, def)
+    | _         -> ()
+  in
+  List.iter pp_function ast.functions;
+
+  (* Closing the section. *)
+  pp "@]@;End code.@]"
+
+type rec_mode =
+  | Rec_none
+  | Rec_in_def of string
+  | Rec_in_lem of string
+
+let (reset_nroot_counter, with_uid) : (unit -> unit) * string pp =
+  let counter = ref (-1) in
+  let with_uid ff s = incr counter; fprintf ff "\"%s_%i\"" s !counter in
+  let reset _ = counter := -1 in
+  (reset, with_uid)
+
+let rec pp_quoted : type_expr pp -> type_expr quoted pp = fun pp_ty ff l ->
+  let pp_quoted_elt ff e =
+    match e with
+    | Quot_plain(s) -> pp_str ff s
+    | Quot_anti(ty) -> fprintf ff "(%a)" pp_ty ty
+  in
+  match l with
+  | []     -> assert false (* Unreachable. *)
+  | [e]    -> pp_quoted_elt ff e
+  | e :: l -> fprintf ff "%a " pp_quoted_elt e; pp_quoted pp_ty ff l
+
+and pp_coq_expr : bool -> type_expr pp -> coq_expr pp = fun wrap pp_ty ff e ->
+  match e with
+  | Coq_ident(x) -> pp_str ff x
+  | Coq_all(l)   ->
+      fprintf ff (if wrap then "(%a)" else "%a") (pp_quoted pp_ty) l
+
+and pp_type_annot : type_expr pp -> coq_expr option pp = fun pp_ty ff eo ->
+  Option.iter (fprintf ff " : %a" (pp_coq_expr false pp_ty)) eo
+
+and pp_constr_rec : unit pp option -> rec_mode -> bool -> constr pp =
+    fun pp_dots r wrap ff c ->
+  let pp_ty = pp_type_expr_rec pp_dots r in
+  let pp_coq_expr wrap = pp_coq_expr wrap pp_ty in
+  let pp_constr = pp_constr_rec pp_dots r in
+  let pp_kind ff k =
+    match k with
+    | Own     -> pp_str ff "◁ₗ"
+    | Shr     -> pp_str ff "◁ₗ{Shr}"
+    | Frac(e) -> fprintf ff "◁ₗ{%a}" (pp_coq_expr false) e
+  in
+  match c with
+  (* Needs no wrapping. *)
+  | Constr_Coq(e)       ->
+      fprintf ff "⌜%a⌝" (pp_coq_expr false) e
+  (* Apply wrapping. *)
+  | _ when wrap         ->
+      fprintf ff "(%a)" (pp_constr false) c
+  (* No need for wrappin now. *)
+  | Constr_Iris(l)      ->
+      pp_quoted pp_ty ff l
+  | Constr_exist(x,a,c) ->
+      fprintf ff "∃ %s%a, %a" x (pp_type_annot pp_ty) a (pp_constr false) c
+  | Constr_own(x,k,ty)  ->
+      fprintf ff "%s %a %a" x pp_kind k pp_ty ty
+  | Constr_val(x, ty)   ->
+      fprintf ff "%s ◁ᵥ %a" x pp_ty ty
+  | Constr_glob(x,ty)   ->
+      fprintf ff "global_with_type %S Own %a" x pp_ty ty
+
+and pp_type_expr_rec : unit pp option -> rec_mode -> type_expr pp =
+    fun pp_dots r ff ty ->
+  let pp_constr = pp_constr_rec pp_dots r in
+  let rec pp_ty_annot ff a =
+    pp_type_annot (pp false false) ff a
+  and pp wrap rfnd ff ty =
+    let pp_coq_expr wrap = pp_coq_expr wrap (pp false rfnd) in
+    match ty with
+    (* Don't need explicit wrapping. *)
+    | Ty_Coq(e)          -> (pp_coq_expr wrap) ff e
+    (* Remaining constructors (no need for explicit wrapping). *)
+    | Ty_dots            ->
+        begin
+          match pp_dots with
+          | None     -> Panic.panic_no_pos "Unexpected ellipsis."
+          | Some(pp) ->
+          fprintf ff (if wrap then "(@;  %a@;)" else "%a") pp ()
+        end
+    (* Insert wrapping if needed. *)
+    | _ when wrap        -> fprintf ff "(%a)" (pp false rfnd) ty
+    | Ty_refine(e,ty)    ->
+        begin
+          match (r, ty) with
+          | (Rec_in_def(s), Ty_params(c,tys)) when c = s ->
+              fprintf ff "self (%a" (pp_coq_expr true) e;
+              List.iter (fprintf ff ", %a" (pp_arg true)) tys;
+              fprintf ff ")"
+          | (Rec_in_lem(s), Ty_params(c,tys)) when c = s ->
+              fprintf ff "%a @@ " (pp_coq_expr true) e;
+              if tys <> [] then pp_str ff "(";
+              pp_str ff c;
+              List.iter (fprintf ff " %a" (pp_arg true)) tys;
+              if tys <> [] then pp_str ff ")"
+          | (_              , _               )            ->
+              fprintf ff "%a @@ %a" (pp_coq_expr true) e
+                (pp true true) ty
+        end
+    | Ty_exists(xs,a,ty) ->
+        fprintf ff "∃ₜ %a%a, %a%a" (pp_encoded_patt_name false) xs
+          pp_ty_annot a pp_encoded_patt_bindings xs
+          (pp false false) ty
+    | Ty_constr(ty,c)    ->
+        fprintf ff "constrained %a %a" (pp true false) ty
+          (pp_constr true) c
+    | Ty_params(id,tyas) ->
+        let default () =
+          pp_str ff id;
+          List.iter (fprintf ff " %a" (pp_arg true)) tyas
+        in
+        match r with
+        | Rec_in_def(s) when id = s ->
+           (* We cannot use the ∃ₜ notation here as it hard-codes a
+              rtype-to-type conversion.*)
+            fprintf ff "tyexists (λ rfmt__, ";
+            fprintf ff "self (rfmt__";
+            List.iter (fprintf ff ", %a" (pp_arg true)) tyas;
+            fprintf ff "))"
+        | Rec_in_lem(s) when id = s ->
+            fprintf ff "tyexists (λ rfmt__, ";
+            fprintf ff "rfmt__ @@ ";
+            default (); fprintf ff ")"
+        | _                           ->
+        match id with
+        | "&frac"                  ->
+            let (beta, ty) =
+              match tyas with
+              | [tya1; tya2] -> (tya1, tya2)
+              | _            ->
+                 Panic.panic_no_pos "[%s] expects two arguments." id
+            in
+            fprintf ff "&frac{%a} %a"
+              (pp_arg false) beta (pp_arg true) ty
+        | "optional" when not rfnd ->
+            let (tya1, tya2) =
+              match tyas with
+              | [tya]        -> (tya, Ty_arg_expr(Ty_Coq(Coq_ident("null"))))
+              | [tya1; tya2] -> (tya1, tya2)
+              | _            ->
+                 Panic.panic_no_pos "[%s] expects one or two arguments." id
+            in
+            let tya1 =
+              Ty_arg_lambda([], Some(Coq_ident("unit")), tya1)
+            in
+            fprintf ff "optionalO %a %a" (pp_arg true) tya1
+              (pp_arg true) tya2
+        | "optional" | "optionalO" ->
+           (match tyas with
+           | [tya]        ->
+               fprintf ff "%s %a null" id (pp_arg true) tya
+           | [tya1; tya2] ->
+               fprintf ff "%s %a %a" id (pp_arg true) tya1
+                 (pp_arg true) tya2
+           | _            ->
+               Panic.panic_no_pos "[%s] expects one or two arguments." id)
+        | "struct"                 ->
+            let (tya, tyas) =
+              match tyas with tya :: tyas -> (tya, tyas) | [] ->
+              Panic.panic_no_pos "[%s] expects at least one argument." id
+            in
+            fprintf ff "struct %a [@@{type} %a ]"
+              (pp_arg true) tya
+              (pp_sep " ; " (pp_arg false)) tyas
+        | _                        ->
+            default ()
+  and pp_arg wrap ff tya =
+    match tya with
+    | Ty_arg_expr(ty)         ->
+        pp wrap false ff ty
+    | Ty_arg_lambda(xs,a,tya) ->
+        fprintf ff "(λ %a%a,@;  @[<v 0>%a%a@]@;)"
+          (pp_encoded_patt_name false) xs
+          pp_ty_annot a pp_encoded_patt_bindings xs
+          (pp_arg false) tya
+  in
+  pp true false ff ty
+
+let pp_type_expr = pp_type_expr_rec None Rec_none
+let pp_constr = pp_constr_rec None Rec_none true
+
+let pp_constrs : constr list pp = fun ff cs ->
+  match cs with
+  | []      -> pp_str ff "True"
+  | c :: cs -> pp_constr ff c; List.iter (fprintf ff " ∗ %a" pp_constr) cs
+
+let gather_struct_fields id s =
+  let fn (x, (ty_opt, _, layout)) =
+    match ty_opt with
+    | Some(MA_field(ty)) -> (x, ty, layout)
+    | Some(MA_utag(_))
+    | Some(MA_none)      ->
+        Panic.panic_no_pos "Bad annotation on field [%s] of struct [%s]." x id
+    | None           ->
+        Panic.panic_no_pos "No annotation on field [%s] of struct [%s]." x id
+  in
+  List.map fn s.struct_members
+
+let rec pp_struct_def_np structs r annot fields ff id =
+  let pp fmt = fprintf ff fmt in
+  (* Print the part that may stand for dots in case of "typedef". *)
+  let pp_dots ff () =
+    (* Printing of the "exists". *)
+    pp "@[<v 0>";
+    if annot.st_exists <> [] then
+      begin
+        pp "∃ₜ";
+        let pp_exist (x, e) =
+          pp " (%s : %a)" x (pp_simple_coq_expr false) e
+        in
+        List.iter pp_exist annot.st_exists;
+        pp ",@;"
+      end;
+    (* Printing the let-bindings. *)
+    let pp_let (id, ty, def) =
+      let pp_coq = pp_simple_coq_expr false in
+      match ty with
+      | None    -> pp "let %s := %a in@;" id pp_coq def;
+      | Some ty -> pp "let %s : %a := %a in@;" id pp_coq ty pp_coq def;
+    in
+    List.iter pp_let annot.st_lets;
+    (* Opening the "constrained". *)
+    pp "@[<v 2>"; (* Open box for struct fields. *)
+    if annot.st_constrs <> [] then pp "constrained (";
+    let pp fmt = fprintf ff fmt in
+    (* Printing the "padded". *)
+    Option.iter (fun _ -> pp "padded (") annot.st_size;
+    (* Printing the struct fields. *)
+    pp "struct struct_%s [@@{type}" id;
+    let pp_field ff (_, ty, layout) =
+      match layout with
+      | LStruct(s_id, false) ->
+          let (s, structs) =
+            try (List.assoc s_id structs, List.remove_assoc s_id structs)
+            with Not_found -> Panic.panic_no_pos "Unknown struct [%s]." s_id
+          in
+          let annot =
+            match s.struct_annot with
+            | Some(annot) -> annot
+            | None        ->
+            Panic.panic_no_pos "Annotations on struct [%s] are invalid." s_id
+          in
+          begin
+            match annot with
+            | SA_union        ->
+                Panic.panic_no_pos "Annotations on struct [%s] are invalid \
+                  since it is not a union." s_id
+            | SA_tagged_u(_)  ->
+                Panic.panic_no_pos "Annotations on struct [%s] are invalid \
+                  since it is not a tagged union." s_id
+            | SA_basic(annot) ->
+            if annot = default_basic_struct_annot || basic_struct_annot_defines_type annot then
+              (* No annotation on struct, fall back to normal printing. *)
+              pp_type_expr_rec None r ff ty
+            else
+            let annot =
+              match annot.st_typedef with
+              | None    -> {annot with st_typedef = Some((s_id,ty))}
+              | Some(_) ->
+              Panic.panic_no_pos "[rc::typedef] in nested struct [%s]." s_id
+            in
+            let fields = gather_struct_fields s_id s in
+            pp "(%a)" (pp_struct_def_np structs Rec_none annot fields) s_id
+          end
+      | LStruct(_   , true ) -> assert false (* TODO *)
+      | _                    -> pp_type_expr_rec None r ff ty
+    in
+    begin
+      match fields with
+      | []              -> ()
+      | field :: fields ->
+      reset_nroot_counter ();
+      pp "@;%a" pp_field field;
+      List.iter (pp " ;@;%a" pp_field) fields
+    end;
+    pp "@]@;]"; (* Close box for struct fields. *)
+    let fn = pp ") struct_%s %a" id (pp_simple_coq_expr true) in
+    Option.iter fn annot.st_size;
+    (* Printing of constraints. *)
+    if annot.st_constrs <> [] then
+      begin
+        pp ") (@;  @[<v 0>";
+        let (c, cs) = (List.hd annot.st_constrs, List.tl annot.st_constrs) in
+        pp "%a" pp_constr c;
+        List.iter (pp " ∗@;%a" pp_constr) cs;
+        pp "@]@;)"
+      end;
+    pp "@]"
+  in
+  reset_nroot_counter ();
+  match annot.st_typedef with
+  | None        -> pp_dots ff ()
+  | Some(_, ty) -> pp_type_expr_rec (Some(pp_dots)) r ff ty
+
+let collect_invs : func_def -> (string * state_descr) list = fun def ->
+  let fn id (annot, _) acc =
+    match annot with
+    | BA_none     -> acc
+    | BA_loop(sd) -> (id, sd) :: acc
+  in
+  SMap.fold fn def.func_blocks []
+
+let pp_spec : Coq_path.t -> import list -> inlined_code ->
+      typedef list -> string list -> Coq_ast.t pp =
+    fun coq_path imports inlined typedefs ctxt ff ast ->
+
+  (* Formatting utilities. *)
+  let pp fmt = Format.fprintf ff fmt in
+
+  (* Print inlined code (starts with an empty line) *)
+  let pp_inlined extra_line_after descr ls =
+    if ls <> [] then pp "\n";
+    if ls <> [] then
+      begin
+        match descr with
+        | None        -> pp "@;(* Inlined code. *)\n"
+        | Some(descr) -> pp "@;(* Inlined code (%s). *)\n" descr
+      end;
+    List.iter (fun s -> if s = "" then pp "\n" else pp "@;%s" s) ls;
+    if extra_line_after && ls <> [] then pp "\n";
+  in
+
+  (* Printing some header. *)
+  pp "@[<v 0>From refinedc.typing Require Import typing.@;";
+  pp "From %a Require Import generated_code.@;" Coq_path.pp coq_path;
+  List.iter (pp_import ff) imports;
+  pp "Set Default Proof Using \"Type\".\n";
+
+  (* Printing generation data in a comment. *)
+  pp "@;(* Generated from [%s]. *)" ast.source_file;
+
+  (* Printing inlined code (from comments). *)
+  pp_inlined true (Some "prelude") inlined.ic_prelude;
+
+  (* Opening the section. *)
+  pp "@;@[<v 2>Section spec.@;";
+  pp "Context `{!typeG Σ} `{!globalG Σ}.";
+  List.iter (pp "@;%s.") ctxt;
+
+  (* Printing inlined code (from comments). *)
+  pp_inlined false None inlined.ic_section;
+
+  (* [Notation] data for printing sugar. *)
+  let sugar = ref [] in
+
+  (* [Typeclass Opaque] stuff that needs to be repeated after the section. *)
+  let opaque = ref [] in
+
+  (* Definition of types. *)
+  let pp_type id refs params movable unfold_order pp_body =
+    let refs = if refs = [] then [("x__", Coq_ident "unit")] else refs in
+    let (ref_names, ref_types) = List.split refs in
+    let (par_names, par_types) = List.split params in
+    let ref_and_par_names = ref_names @ par_names in
+    let ref_and_par_types = ref_types @ par_types in
+    let pp_params ff =
+      let fn (x,e) = fprintf ff "(%s : %a) " x (pp_simple_coq_expr false) e in
+      List.iter fn
+    in
+    pp "\n@;(* Definition of type [%s]. *)@;" id;
+    let pp_prod = pp_as_prod (pp_simple_coq_expr true) in
+    pp "@[<v 2>Definition %s_rec : (%a → type) → (%a → type) := " id
+      pp_prod ref_and_par_types pp_prod ref_and_par_types;
+    pp "(λ self %a,@;" (pp_encoded_patt_name false) ref_and_par_names;
+    pp_encoded_patt_bindings ff ref_and_par_names;
+    let r = Rec_in_def(id) in
+    pp_body r;
+    pp "@]@;)%%I.@;Global Typeclasses Opaque %s_rec.\n" id;
+    if par_names <> [] then sugar := !sugar @ [(id, par_names)];
+    opaque := !opaque @ [id ^ "_rec"; id];
+
+    pp "@;Global Instance %s_rec_le : TypeMono %s_rec." id id;
+    pp "@;Proof. solve_type_proper. Qed.\n@;";
+
+    pp "@[<v 2>Definition %s %a: rtype (%a) := {|@;" id pp_params params pp_prod ref_types;
+    pp "rty r__ := %s_rec (type_fixpoint %s) %a@]@;|}.\n" id (id ^ "_rec")
+      (pp_as_tuple pp_str) ("r__" :: par_names);
+
+    (* Generation of the unfolding lemma. *)
+    pp "@;@[<v 2>Lemma %s_unfold %a(%a : %a):@;" id pp_params params
+      (pp_encoded_patt_name true) ref_names
+      (pp_as_prod (pp_simple_coq_expr true)) ref_types;
+    pp "@[<v 2>(%a @@ %a)%%I ≡@@{type} (@;"
+      (pp_encoded_patt_name true) ref_names
+      (pp_id_args false id) par_names;
+    pp "%a" pp_encoded_patt_bindings ref_names;
+    let r = Rec_in_lem(id) in
+    pp_body r;
+    pp "@]@;)%%I.@]@;";
+    pp "Proof. apply: (type_fixpoint_unfold2 %s_rec). Qed.\n" id;
+
+    (* Generation of the global instances. *)
+    let pp_instance inst_name type_name =
+      pp "@;Definition %s_%s_inst_generated %apatt__ :=@;"
+        id inst_name pp_params params;
+      pp "  [instance %s_eq _ _ (%s_unfold %apatt__) with %i%%N].@;"
+        inst_name id pp_params params unfold_order;
+      pp "Global Existing Instance %s_%s_inst_generated." id inst_name;
+    in
+    pp_instance "simplify_hyp_place" "SimplifyHyp";
+    pp_instance "simplify_goal_place" "SimplifyGoal";
+    if movable then
+      begin
+        pp "\n";
+        pp_instance "simplify_hyp_val" "SimplifyHyp";
+        pp_instance "simplify_goal_val" "SimplifyGoal"
+      end
+  in
+  let pp_struct struct_id annot s =
+    (* Check if a type must be generated. *)
+    if not (basic_struct_annot_defines_type annot) then () else
+    (* Gather the field annotations. *)
+    let fields = gather_struct_fields struct_id s in
+    let id =
+      match annot.st_typedef with
+      | None       -> struct_id
+      | Some(id,_) -> id
+    in
+    let pp_body r =
+      pp_struct_def_np ast.structs r annot fields ff struct_id;
+    in
+    pp_type id annot.st_refined_by annot.st_parameters (not annot.st_immovable)
+      annot.st_unfold_order pp_body
+  in
+  let pp_tagged_union id tag_type_e s =
+    if s.struct_is_union then
+      Panic.panic_no_pos "Tagged union annotations used on [%s] should \
+        rather be placed on a struct definition." id;
+    (* Extract the two fields of the wrapping structure (tag and union). *)
+    let (tag_field, union_field) =
+      match s.struct_members with
+      | [tag_field ; union_field] -> (tag_field, union_field)
+      | _                         ->
+      Panic.panic_no_pos "Tagged union [%s] is ill-formed: it should have \
+        exactly two fields (tag and union)." id
+    in
+    (* Obtain the name of the tag field and check its type. *)
+    let tag_field =
+      let (tag_field, (annot, _, layout)) = tag_field in
+      if annot <> Some(MA_none) then
+        Panic.wrn None "Annotation ignored on the tag field [%s] of \
+          the tagged union [%s]." tag_field id;
+      if layout <> LInt(ItSize_t(false)) then
+        Panic.panic_no_pos "The tag field [%s] of tagged union [%s] does \
+          not have the expected [size_t] type." tag_field id;
+      tag_field
+    in
+    (* Obtain the name of the union field and the name of the actual union. *)
+    let (union_field, union_name) =
+      let (union_field, (annot, _, layout)) = union_field in
+      if annot <> Some(MA_none) then
+        Panic.wrn None "Annotation ignored on the union field [%s] of \
+          the tagged union [%s]." union_field id;
+      match layout with
+      | LStruct(union_name, true) -> (union_field, union_name)
+      | _                         ->
+      Panic.panic_no_pos "The union field [%s] of tagged union [%s] is \
+        expected to be a union." union_field id
+    in
+    (* Find the union and extract its fields and corresponding annotations. *)
+    let union_cases =
+      let union =
+        try List.assoc union_name ast.structs
+        with Not_found -> assert false (* Unreachable thanks to Cerberus. *)
+      in
+      (* Some sanity checks. *)
+      if not union.struct_is_union then
+        Panic.panic_no_pos "[%s] was expected to be a union." union_name;
+      assert (union.struct_annot = Some(SA_union));
+      (* Extracting data from the fields. *)
+      let fn (name, (annot, _, layout)) =
+        match annot with
+        | Some(MA_utag(ts)) ->
+            let id_struct =
+              match layout with
+              | LStruct(id, false) -> id
+              | _                  ->
+              Panic.panic_no_pos "Field [%s] of union [%s] is not a struct."
+                name union_name
+            in
+            (name, ts, id_struct)
+        | Some(MA_none    ) ->
+            Panic.panic_no_pos "Union tag annotation expected on field [%s] \
+              of union [%s]." name union_name
+        | Some(MA_field(_)) ->
+            Panic.panic_no_pos "Unexpected field annotation on [%s] in the \
+              union [%s]." name union_name
+        | None              ->
+            Panic.panic_no_pos "Invalid annotation on field [%s] in the \
+              union [%s]." name union_name
+      in
+      List.map fn union.struct_members
+    in
+    (* Starting to do the printing. *)
+    pp "\n@;(* Definition of type [%s] (tagged union). *)@;" id;
+    (* Definition of the tag function. *)
+    pp "@[<v 2>Definition %s_tag (c : %a) : nat :=@;"
+      id (pp_simple_coq_expr false) tag_type_e;
+    pp "match c with@;";
+    let pp_tag_case i (_, (c, args), _) =
+      pp "| %s" c; List.iter (fun _ -> pp " _") args; pp " => %i%%nat@;" i
+    in
+    List.iteri pp_tag_case union_cases;
+    pp "end.@]\n@;";
+    (* Simplifications hints for inversing the tag function. *)
+    let pp_inversion_hint i (_, (c, args), _) =
+      pp "Global Instance simpl_%s_tag_%s c :@;" id c;
+      pp "  SimplBothRel (=) (%s_tag c) %i%%nat (" id i;
+      if args <> [] then pp "∃";
+      let fn (x,e) = pp " (%s : %a)" x (pp_simple_coq_expr false) e in
+      List.iter fn args;
+      if args <> [] then pp ", ";
+      pp "c = %s" c; List.iter (fun (x,_) -> pp " %s" x) args; pp ").@;";
+      pp "Proof. split; destruct c; naive_solver. Qed.\n@;";
+    in
+    List.iteri pp_inversion_hint union_cases;
+    (* Definition for the tagged union info. *)
+    pp "@[<v 2>Program Definition %s_tunion_info : tunion_info %a := {|@;"
+      id (pp_simple_coq_expr true) tag_type_e;
+    pp "ti_base_layout := struct_%s;@;" id;
+    pp "ti_tag_field_name := \"%s\";@;" tag_field;
+    pp "ti_union_field_name := \"%s\";@;" union_field;
+    pp "ti_union_layout := union_%s;@;" union_name;
+    pp "ti_tag := %s_tag;@;" id;
+    pp "ti_type c :=@;";
+    pp "  match c with@;";
+    let fn (name, (c, args), struct_id) =
+      pp "  | %s" c; List.iter (fun (x,_) -> pp " %s" x) args;
+      pp " => struct struct_%s [@@{type} " name;
+      begin
+        let s =
+          try List.assoc struct_id ast.structs
+          with Not_found -> assert false (* Unreachable thanks to Cerberus. *)
+        in
+        let fields = gather_struct_fields struct_id s in
+        let pp_field ff (_, ty, _) = fprintf ff "%a" pp_type_expr ty in
+        match fields with
+        | []      -> ()
+        | f :: fs -> pp "%a" pp_field f; List.iter (pp "; %a" pp_field) fs
+      end;
+      pp "]%%I@;"
+    in
+    List.iter fn union_cases;
+    pp "  end;@]@;";
+    pp "|}.@;";
+    pp "Next Obligation. done. Qed.@;";
+    pp "Next Obligation. by case; eauto. Qed.\n@;";
+    (* Actual definition of the type. *)
+    pp "Program Definition %s : rtype _ := tunion %s_tunion_info." id id
+  in
+  let pp_struct_or_tagged_union (id, s) =
+    match s.struct_annot with
+    | Some(SA_basic(annot)) -> pp_struct id annot s
+    | Some(SA_tagged_u(e))  -> pp_tagged_union id e s
+    | Some(SA_union)        -> ()
+    | None                  ->
+        Panic.panic_no_pos "Annotations on struct [%s] are invalid." id
+  in
+  List.iter pp_struct_or_tagged_union ast.structs;
+
+  (* Type definitions (from comments). *)
+  let pp_typedef td =
+    let pp_body r =
+      pp_type_expr_rec None r ff td.td_body
+    in
+    pp_type td.td_id td.td_refinements td.td_parameters (not td.td_immovable)
+      td.td_unfold_order pp_body
+  in
+  List.iter pp_typedef typedefs;
+
+  (* Function specs. *)
+  let pp_spec (id, def_or_decl) =
+    let annot =
+      match def_or_decl with
+      | FDef({func_annot=Some(annot); _}) -> annot
+      | FDec(Some(annot))                 -> annot
+      | _                                 ->
+      Panic.panic_no_pos "Annotations on function [%s] are invalid." id
+    in
+    match annot.fa_proof_kind with
+    | Proof_inlined ->
+        ()
+    | Proof_skipped ->
+        pp "\n@;(* Function [%s] has been skipped. *)" id
+    | _             ->
+    pp "\n@;(* Specifications for function [%s]. *)" id;
+    let (param_names, param_types) = List.split annot.fa_parameters in
+    let (exist_names, exist_types) = List.split annot.fa_exists in
+    let pp_args ff tys =
+      match tys with
+      | [] -> ()
+      | _  -> pp "; "; pp_sep ", " pp_type_expr ff tys
+    in
+    pp "@;Definition type_of_%s :=@;  @[<hov 2>" id;
+    let pp_prod = pp_as_prod (pp_simple_coq_expr true) in
+    pp "fn(∀ %a : %a%a; %a)@;→ ∃ %a : %a, %a; %a.@]"
+      (pp_as_tuple pp_str) param_names pp_prod param_types
+      pp_args annot.fa_args pp_constrs annot.fa_requires (pp_as_tuple pp_str)
+      exist_names pp_prod exist_types pp_type_expr
+      annot.fa_returns pp_constrs annot.fa_ensures
+  in
+  List.iter pp_spec ast.functions;
+
+  (* Closing the section. *)
+  pp "@]@;End spec.";
+
+  (* [Notation] stuff (printing sugar). *)
+  if !sugar <> [] then pp "@;";
+  let pp_sugar (id, params) =
+    pp "@;Notation \"%s< %a >\"" id (pp_sep " , " pp_print_string) params;
+    pp " := (%s %a)@;  " id (pp_sep " " pp_print_string) params;
+    pp "(only printing, format \"'%s<' %a '>'\") : printing_sugar." id
+      (pp_sep " ,  " pp_print_string) params
+  in
+  List.iter pp_sugar !sugar;
+
+  (* [Typeclass Opaque] stuff. *)
+  if !opaque <> [] then pp "@;";
+  let pp_opaque = pp "@;Global Typeclasses Opaque %s." in
+  List.iter pp_opaque !opaque;
+
+  (* Printing inlined code (from comments). *)
+  pp_inlined false (Some "final") inlined.ic_final;
+  pp "@]"
+
+let pp_spec_vst : Coq_path.t -> import list -> inlined_code ->
+      typedef list -> string list -> Coq_ast.t pp =
+    fun coq_path imports inlined typedefs ctxt ff ast ->
+
+  (* Formatting utilities. *)
+  let pp fmt = Format.fprintf ff fmt in
+
+  (* Print inlined code (starts with an empty line) *)
+  let pp_inlined extra_line_after descr ls =
+    if ls <> [] then pp "\n";
+    if ls <> [] then
+      begin
+        match descr with
+        | None        -> pp "@;(* Inlined code. *)\n"
+        | Some(descr) -> pp "@;(* Inlined code (%s). *)\n" descr
+      end;
+    List.iter (fun s -> if s = "" then pp "\n" else pp "@;%s" s) ls;
+    if extra_line_after && ls <> [] then pp "\n";
+  in
+
+  (* Printing some header. *)
+  pp "@[<v 0>From VST.typing Require Import typing.@;";
+  pp "From %a Require Import generated_code_vst.@;" Coq_path.pp coq_path;
+  List.iter (pp_import ff) imports;
+  pp "Set Default Proof Using \"Type\".\n";
+  pp "Notation int := VST.typing.int.int.\n";
+
+  (* Printing generation data in a comment. *)
+  pp "@;(* Generated from [%s]. *)" ast.source_file;
+
+  (* Printing inlined code (from comments). *)
+  pp_inlined true (Some "prelude") inlined.ic_prelude;
+
+  (* Opening the section. *)
+  pp "@;@[<v 2>Section spec.@;";
+  pp "Context `{!typeG Σ} {cs : compspecs} `{!externalGS OK_ty Σ}.";
+  List.iter (pp "@;%s.") ctxt;
+
+  (* Printing inlined code (from comments). *)
+  pp_inlined false None inlined.ic_section;
+
+  (* [Notation] data for printing sugar. *)
+  let sugar = ref [] in
+
+  (* [Typeclass Opaque] stuff that needs to be repeated after the section. *)
+  let opaque = ref [] in
+
+  (* Definition of types. *)
+  let pp_type id refs params movable unfold_order pp_body =
+    let refs = if refs = [] then [("x__", Coq_ident "unit")] else refs in
+    let (ref_names, ref_types) = List.split refs in
+    let (par_names, par_types) = List.split params in
+    let ref_and_par_names = ref_names @ par_names in
+    let ref_and_par_types = ref_types @ par_types in
+    let pp_params ff =
+      let fn (x,e) = fprintf ff "(%s : %a) " x (pp_simple_coq_expr false) e in
+      List.iter fn
+    in
+    pp "\n@;(* Definition of type [%s]. *)@;" id;
+    let pp_prod = pp_as_prod (pp_simple_coq_expr true) in
+    pp "@[<v 2>Definition %s_rec : (%a → type) → (%a → type) := " id
+      pp_prod ref_and_par_types pp_prod ref_and_par_types;
+    pp "(λ self %a,@;" (pp_encoded_patt_name false) ref_and_par_names;
+    pp_encoded_patt_bindings ff ref_and_par_names;
+    let r = Rec_in_def(id) in
+    pp_body r;
+    pp "@]@;)%%I.@;Global Typeclasses Opaque %s_rec.\n" id;
+    if par_names <> [] then sugar := !sugar @ [(id, par_names)];
+    opaque := !opaque @ [id ^ "_rec"; id];
+
+    pp "@;Global Instance %s_rec_le : TypeMono %s_rec." id id;
+    pp "@;Proof. solve_type_proper. Qed.\n@;";
+
+    pp "@[<v 2>Definition %s %a: rtype (%a) := {|@;" id pp_params params pp_prod ref_types;
+    pp "rty r__ := %s_rec (type_fixpoint %s) %a@]@;|}.\n" id (id ^ "_rec")
+      (pp_as_tuple pp_str) ("r__" :: par_names);
+
+    (* Generation of the unfolding lemma. *)
+    pp "@;@[<v 2>Lemma %s_unfold %a(%a : %a):@;" id pp_params params
+      (pp_encoded_patt_name true) ref_names
+      (pp_as_prod (pp_simple_coq_expr true)) ref_types;
+    pp "@[<v 2>(%a @@ %a)%%I ≡@@{type} (@;"
+      (pp_encoded_patt_name true) ref_names
+      (pp_id_args false id) par_names;
+    pp "%a" pp_encoded_patt_bindings ref_names;
+    let r = Rec_in_lem(id) in
+    pp_body r;
+    pp "@]@;)%%I.@]@;";
+    pp "Proof. apply: (type_fixpoint_unfold2 %s_rec). Qed.\n" id;
+
+    (* Generation of the global instances. *)
+    let pp_instance inst_name type_name =
+      pp "@;Definition %s_%s_inst_generated %apatt__ :=@;"
+        id inst_name pp_params params;
+      pp "  [instance %s_eq _ _ (%s_unfold %apatt__) with %i%%N].@;"
+        inst_name id pp_params params unfold_order;
+      pp "Global Existing Instance %s_%s_inst_generated." id inst_name;
+    in
+    pp_instance "simplify_hyp_place" "SimplifyHyp";
+    pp_instance "simplify_goal_place" "SimplifyGoal";
+    if movable then
+      begin
+        pp "\n";
+        pp_instance "simplify_hyp_val" "SimplifyHyp";
+        pp_instance "simplify_goal_val" "SimplifyGoal"
+      end
+  in
+  let pp_struct struct_id annot s =
+    (* Check if a type must be generated. *)
+    if not (basic_struct_annot_defines_type annot) then () else
+    (* Gather the field annotations. *)
+    let fields = gather_struct_fields struct_id s in
+    let id =
+      match annot.st_typedef with
+      | None       -> struct_id
+      | Some(id,_) -> id
+    in
+    let pp_body r =
+      pp_struct_def_np ast.structs r annot fields ff struct_id;
+    in
+    pp_type id annot.st_refined_by annot.st_parameters (not annot.st_immovable)
+      annot.st_unfold_order pp_body
+  in
+  let pp_tagged_union id tag_type_e s =
+    if s.struct_is_union then
+      Panic.panic_no_pos "Tagged union annotations used on [%s] should \
+        rather be placed on a struct definition." id;
+    (* Extract the two fields of the wrapping structure (tag and union). *)
+    let (tag_field, union_field) =
+      match s.struct_members with
+      | [tag_field ; union_field] -> (tag_field, union_field)
+      | _                         ->
+      Panic.panic_no_pos "Tagged union [%s] is ill-formed: it should have \
+        exactly two fields (tag and union)." id
+    in
+    (* Obtain the name of the tag field and check its type. *)
+    let tag_field =
+      let (tag_field, (annot, _, layout)) = tag_field in
+      if annot <> Some(MA_none) then
+        Panic.wrn None "Annotation ignored on the tag field [%s] of \
+          the tagged union [%s]." tag_field id;
+      if layout <> LInt(ItSize_t(false)) then
+        Panic.panic_no_pos "The tag field [%s] of tagged union [%s] does \
+          not have the expected [size_t] type." tag_field id;
+      tag_field
+    in
+    (* Obtain the name of the union field and the name of the actual union. *)
+    let (union_field, union_name) =
+      let (union_field, (annot, _, layout)) = union_field in
+      if annot <> Some(MA_none) then
+        Panic.wrn None "Annotation ignored on the union field [%s] of \
+          the tagged union [%s]." union_field id;
+      match layout with
+      | LStruct(union_name, true) -> (union_field, union_name)
+      | _                         ->
+      Panic.panic_no_pos "The union field [%s] of tagged union [%s] is \
+        expected to be a union." union_field id
+    in
+    (* Find the union and extract its fields and corresponding annotations. *)
+    let union_cases =
+      let union =
+        try List.assoc union_name ast.structs
+        with Not_found -> assert false (* Unreachable thanks to Cerberus. *)
+      in
+      (* Some sanity checks. *)
+      if not union.struct_is_union then
+        Panic.panic_no_pos "[%s] was expected to be a union." union_name;
+      assert (union.struct_annot = Some(SA_union));
+      (* Extracting data from the fields. *)
+      let fn (name, (annot, _, layout)) =
+        match annot with
+        | Some(MA_utag(ts)) ->
+            let id_struct =
+              match layout with
+              | LStruct(id, false) -> id
+              | _                  ->
+              Panic.panic_no_pos "Field [%s] of union [%s] is not a struct."
+                name union_name
+            in
+            (name, ts, id_struct)
+        | Some(MA_none    ) ->
+            Panic.panic_no_pos "Union tag annotation expected on field [%s] \
+              of union [%s]." name union_name
+        | Some(MA_field(_)) ->
+            Panic.panic_no_pos "Unexpected field annotation on [%s] in the \
+              union [%s]." name union_name
+        | None              ->
+            Panic.panic_no_pos "Invalid annotation on field [%s] in the \
+              union [%s]." name union_name
+      in
+      List.map fn union.struct_members
+    in
+    (* Starting to do the printing. *)
+    pp "\n@;(* Definition of type [%s] (tagged union). *)@;" id;
+    (* Definition of the tag function. *)
+    pp "@[<v 2>Definition %s_tag (c : %a) : nat :=@;"
+      id (pp_simple_coq_expr false) tag_type_e;
+    pp "match c with@;";
+    let pp_tag_case i (_, (c, args), _) =
+      pp "| %s" c; List.iter (fun _ -> pp " _") args; pp " => %i%%nat@;" i
+    in
+    List.iteri pp_tag_case union_cases;
+    pp "end.@]\n@;";
+    (* Simplifications hints for inversing the tag function. *)
+    let pp_inversion_hint i (_, (c, args), _) =
+      pp "Global Instance simpl_%s_tag_%s c :@;" id c;
+      pp "  SimplBothRel (=) (%s_tag c) %i%%nat (" id i;
+      if args <> [] then pp "∃";
+      let fn (x,e) = pp " (%s : %a)" x (pp_simple_coq_expr false) e in
+      List.iter fn args;
+      if args <> [] then pp ", ";
+      pp "c = %s" c; List.iter (fun (x,_) -> pp " %s" x) args; pp ").@;";
+      pp "Proof. split; destruct c; naive_solver. Qed.\n@;";
+    in
+    List.iteri pp_inversion_hint union_cases;
+    (* Definition for the tagged union info. *)
+    pp "@[<v 2>Program Definition %s_tunion_info : tunion_info %a := {|@;"
+      id (pp_simple_coq_expr true) tag_type_e;
+    pp "ti_base_layout := struct_%s;@;" id;
+    pp "ti_tag_field_name := \"%s\";@;" tag_field;
+    pp "ti_union_field_name := \"%s\";@;" union_field;
+    pp "ti_union_layout := union_%s;@;" union_name;
+    pp "ti_tag := %s_tag;@;" id;
+    pp "ti_type c :=@;";
+    pp "  match c with@;";
+    let fn (name, (c, args), struct_id) =
+      pp "  | %s" c; List.iter (fun (x,_) -> pp " %s" x) args;
+      pp " => struct struct_%s [@@{type} " name;
+      begin
+        let s =
+          try List.assoc struct_id ast.structs
+          with Not_found -> assert false (* Unreachable thanks to Cerberus. *)
+        in
+        let fields = gather_struct_fields struct_id s in
+        let pp_field ff (_, ty, _) = fprintf ff "%a" pp_type_expr ty in
+        match fields with
+        | []      -> ()
+        | f :: fs -> pp "%a" pp_field f; List.iter (pp "; %a" pp_field) fs
+      end;
+      pp "]%%I@;"
+    in
+    List.iter fn union_cases;
+    pp "  end;@]@;";
+    pp "|}.@;";
+    pp "Next Obligation. done. Qed.@;";
+    pp "Next Obligation. by case; eauto. Qed.\n@;";
+    (* Actual definition of the type. *)
+    pp "Program Definition %s : rtype _ := tunion %s_tunion_info." id id
+  in
+  let pp_struct_or_tagged_union (id, s) =
+    match s.struct_annot with
+    | Some(SA_basic(annot)) -> pp_struct id annot s
+    | Some(SA_tagged_u(e))  -> pp_tagged_union id e s
+    | Some(SA_union)        -> ()
+    | None                  ->
+        Panic.panic_no_pos "Annotations on struct [%s] are invalid." id
+  in
+  List.iter pp_struct_or_tagged_union ast.structs;
+
+  (* Type definitions (from comments). *)
+  let pp_typedef td =
+    let pp_body r =
+      pp_type_expr_rec None r ff td.td_body
+    in
+    pp_type td.td_id td.td_refinements td.td_parameters (not td.td_immovable)
+      td.td_unfold_order pp_body
+  in
+  List.iter pp_typedef typedefs;
+
+  (* Function specs. *)
+  let pp_spec (id, def_or_decl) =
+    let annot =
+      match def_or_decl with
+      | FDef({func_annot=Some(annot); _}) -> annot
+      | FDec(Some(annot))                 -> annot
+      | _                                 ->
+      Panic.panic_no_pos "Annotations on function [%s] are invalid." id
+    in
+    match annot.fa_proof_kind with
+    | Proof_inlined ->
+        ()
+    | Proof_skipped ->
+        pp "\n@;(* Function [%s] has been skipped. *)" id
+    | _             ->
+    pp "\n@;(* Specifications for function [%s]. *)" id;
+    let (param_names, param_types) = List.split annot.fa_parameters in
+    let (exist_names, exist_types) = List.split annot.fa_exists in
+    let pp_args ff tys =
+      match tys with
+      | [] -> ()
+      | _  -> pp "; "; pp_sep ", " pp_type_expr ff tys
+    in
+    pp "@;Definition type_of_%s :=@;  @[<hov 2>" id;
+    let pp_prod = pp_as_prod (pp_simple_coq_expr true) in
+    pp "fn(∀ %a : %a%a; %a)@;→ ∃ %a : %a, %a; %a.@]"
+      (pp_as_tuple pp_str) param_names pp_prod param_types
+      pp_args annot.fa_args pp_constrs annot.fa_requires (pp_as_tuple pp_str)
+      exist_names pp_prod exist_types pp_type_expr
+      annot.fa_returns pp_constrs annot.fa_ensures
+  in
+  List.iter pp_spec ast.functions;
+
+  (* Closing the section. *)
+  pp "@]@;End spec.";
+
+  (* [Notation] stuff (printing sugar). *)
+  if !sugar <> [] then pp "@;";
+  let pp_sugar (id, params) =
+    pp "@;Notation \"%s< %a >\"" id (pp_sep " , " pp_print_string) params;
+    pp " := (%s %a)@;  " id (pp_sep " " pp_print_string) params;
+    pp "(only printing, format \"'%s<' %a '>'\") : printing_sugar." id
+      (pp_sep " ,  " pp_print_string) params
+  in
+  List.iter pp_sugar !sugar;
+
+  (* [Typeclass Opaque] stuff. *)
+  if !opaque <> [] then pp "@;";
+  let pp_opaque = pp "@;Global Typeclasses Opaque %s." in
+  List.iter pp_opaque !opaque;
+
+  (* Printing inlined code (from comments). *)
+  pp_inlined false (Some "final") inlined.ic_final;
+  pp "@]"
+
+let pp_proof : Coq_path.t -> func_def -> import list -> string list
+    -> proof_kind -> Coq_ast.t pp =
+    fun coq_path def imports ctxt proof_kind ff ast ->
+  (* Formatting utilities. *)
+  let pp fmt = Format.fprintf ff fmt in
+
+  (* Only print a comment if the function is trusted. *)
+  match proof_kind with
+  | Proof_trusted ->
+      pp "(* Let's skip that, you seem to have some faith. *)"
+  | Proof_skipped ->
+      pp "(* You were too lazy to even write a spec for this function. *)"
+  | _             ->
+
+  (* Add the extra import in case of manual proof. *)
+  let imports =
+    match proof_kind with
+    | Proof_manual(from,file,_) -> imports @ [(from,file)]
+    | _                         -> imports
+  in
+
+  (* Printing some header. *)
+  pp "@[<v 0>From VST.typing Require Import typing.@;";
+  (* FIXME should use the refinedC to Clight AST convertor *)
+  pp "From %a Require Import generated_code_vst_clight.@;" Coq_path.pp coq_path;
+  pp "From %a Require Import generated_spec_vst.@;" Coq_path.pp coq_path;
+  List.iter (pp_import ff) imports;
+  pp "Set Default Proof Using \"Type\".@;@;";
+
+  (* Printing generation data in a comment. *)
+  pp "(* Generated from [%s]. *)@;" ast.source_file;
+
+  (* Opening the section. *)
+  pp "@[<v 2>Section proof_%s.@;" def.func_name;
+  pp " Context `{!typeG Σ} {cs : compspecs} `{!externalGS OK_ty Σ}.";
+  List.iter (pp "@;%s.") ctxt;
+
+  (* Statement of the typing proof. *)
+  let func_annot =
+    match def.func_annot with
+    | Some(annot) -> annot
+    | None        -> assert false (* Unreachable. *)
+  in
+  if List.length def.func_args <> List.length func_annot.fa_args then
+    Panic.panic_no_pos "Argument number missmatch between code and spec.";
+  pp "\n@;(* Typing proof for [%s]. *)@;" def.func_name;
+  (* Get all globals, including those needed for inlined functions. *)
+  let (used_globals, used_functions) =
+    let merge (g1, f1) (g2, f2) =
+      let dedup = List.dedup String.compare in
+      (dedup (g1 @ g2), dedup (f1 @ f2))
+    in
+    let fn acc f =
+      match List.assoc_opt f ast.functions with
+      | Some(FDef(def)) when is_inlined def -> merge acc def.func_deps
+      | _                                   -> acc
+    in
+    List.fold_left fn def.func_deps (snd def.func_deps)
+  in
+  let deps = used_globals @ used_functions in
+  let pp_args ff xs =
+    let xs = List.map (fun s -> "global_" ^ s) xs in
+    match xs with
+    | [] -> ()
+    | _  -> fprintf ff " (%a : loc)" (pp_sep " " pp_str) xs
+  in
+  pp "@[<v 2>Lemma type_%s%a Espec Delta :@;" def.func_name pp_args deps;
+  begin
+    let prefix = if used_functions = [] then "⊢ " else "" in
+    let pp_impl ff def =
+      let (used_globals, used_functions) = def.func_deps in
+      let wrap = used_globals <> [] || used_functions <> [] in
+      if wrap then fprintf ff "(";
+      (* FIXME this is the clight name; change it back to impl_%s when AST convertor is fixed *)
+      fprintf ff "f_%s" def.func_name;
+      List.iter (fprintf ff " global_%s") used_globals;
+      List.iter (fprintf ff " global_%s") used_functions;
+      if wrap then fprintf ff ")"
+    in
+    let pp_global f = pp "global_locs !! \"%s\" = Some global_%s →@;" f f in
+    List.iter pp_global used_globals;
+    let pp_prod = pp_as_prod (pp_simple_coq_expr true) in
+    let pp_global_type f =
+      match List.assoc_opt f ast.global_vars with
+      | Some(Some(global_type)) ->
+          let (param_names, param_types) =
+            List.split global_type.ga_parameters
+          in
+          pp "global_initialized_types !! \"%s\" = " f;
+          pp "Some (GT (%a) (λ '%a, %a : type)%%I) →@;" pp_prod param_types
+            (pp_as_tuple pp_str) param_names
+            (pp_type_expr_rec None Rec_none) global_type.ga_type
+      | _                       -> ()
+    in
+    List.iter pp_global_type used_globals;
+    let pp_dep f =
+      let inlined_def =
+        match List.assoc_opt f ast.functions with
+        | Some(FDef(def)) when is_inlined def -> Some(def)
+        | _                                   -> None
+      in
+      pp "global_%s ◁ᵥ global_%s @@ " f f;
+      begin
+        match inlined_def with
+        | Some(def) -> pp "inline_function_ptr %a" pp_impl def
+        | None      -> pp "function_ptr type_of_%s" f
+      end;
+      pp " -∗@;"
+    in
+    List.iter pp_dep used_functions;
+    pp "%styped_function(A := ConstType _) Espec Delta %a type_of_%s.@]@;" prefix pp_impl def def.func_name
+  end;
+
+  (* We have a manual proof. *)
+  match proof_kind with
+  | Proof_manual(_,_,thm) ->
+      pp "Proof. refine %s. Qed." thm;
+      pp "@]@;End proof_%s.@]" def.func_name (* Section closing. *)
+  | _                     ->
+
+  (* We output a normal proof. *)
+  let _pp_intros ff xs =
+    let pp_intro ff (x,_) = pp_str ff x in
+    match xs with
+    | []      -> fprintf ff "[]"
+    | [x]     -> pp_intro ff x
+    | x :: xs -> List.iter (fun _ -> pp_str ff "[") xs;
+                 pp_intro ff x;
+                 List.iter (fprintf ff " %a]" pp_intro) xs
+  in
+  pp "@[<v 2>Proof.@;";
+  pp "Local Open Scope printing_sugar.@;";
+  (* FIXME the intro pattern in type function is currently just x, the entire argument array *)
+  pp "type_function \"%s\" ( x )" def.func_name
+    (*pp_intros func_annot.fa_parameters *);
+  (* FIXME same as above *)
+  (* if def.func_vars <> [] || def.func_args <> [] then
+    begin
+      pp " =>";
+      List.iter (fun (x,_) -> pp " arg_%s" x) def.func_args;
+      List.iter (fun (x,_) -> pp " local_%s" x) def.func_vars
+    end; *)
+  pp ".@;";
+  if func_annot.fa_parameters <> [] then
+    begin
+      let pp_var ff (x, _) = pp_print_string ff x in
+      pp "prepare_parameters (%a).@;" (pp_sep " " pp_var) func_annot.fa_parameters;
+    end;
+
+  let pp_state_descr print_unused print_exist sd =
+    (* Printing the existentials. *)
+    begin
+      if print_exist then
+        let pp_exists (id, e) =
+          pp "@;∃ %s : %a," id (pp_simple_coq_expr false) e
+        in
+        List.iter pp_exists sd.sd_exists;
+      else ()
+    end;
+    (* Compute the used and unused arguments and variables. *)
+    let used =
+      let fn (id, ty) =
+        (* Check if [id_var] is a function argument. *)
+        try
+          let layout = List.assoc id def.func_args in
+          (* Check for name clash with local variables. *)
+          if List.mem_assoc id def.func_vars then
+            Panic.panic_no_pos "[%s] denotes both an argument and a local \
+              variable of function [%s]." id def.func_name;
+          (* Check if the type is different for the toplevel one. *)
+          let toplevel_ty =
+            try
+              let i = List.find_index (fun (s,_) -> s = id) def.func_args in
+              List.nth func_annot.fa_args i
+            with Not_found | Failure(_) -> assert false (* Unreachable. *)
+          in
+          if ty = toplevel_ty then
+            Panic.wrn None "Useless annotation for argument [%s]." id;
+          ("arg_" ^ id, (layout, Some(ty)))
+        with Not_found ->
+        (* Not a function argument, check that it is a local variable. *)
+        try
+          let layout = List.assoc id def.func_vars in
+          ("local_" ^ id, (layout, Some(ty)))
+        with Not_found ->
+          Panic.panic_no_pos "[%s] is neither a local variable nor an \
+            argument." id
+      in
+      List.map fn sd.sd_inv_vars
+    in
+    let unused =
+      let unused_args =
+        let pred (id, _) =
+          let id = "arg_" ^ id in
+          List.for_all (fun (id_var, _) -> id <> id_var) used
+        in
+        let args = List.filter pred def.func_args in
+        let fn (id, layout) =
+          let ty =
+            try
+              let i = List.find_index (fun (s,_) -> s = id) def.func_args in
+              List.nth func_annot.fa_args i
+            with Not_found | Failure(_) -> assert false (* Unreachable. *)
+          in
+          ("arg_" ^ id, (layout, Some(ty)))
+        in
+        List.map fn args
+      in
+      let unused_vars =
+        let pred (id, _) =
+          let id = "local_" ^ id in
+          List.for_all (fun (id_var, _) -> id <> id_var) used
+        in
+        let vars = List.filter pred def.func_vars in
+        List.map (fun (id, layout) -> ("local_" ^ id, (layout, None))) vars
+      in
+      unused_args @ unused_vars
+    in
+    let all_vars = if print_unused then unused @ used else used in
+    let first = ref true in
+    let pp_sep ff _ = if !first then first := false else fprintf ff " ∗" in
+    let pp_var ff (id, (layout, ty_opt)) =
+      match ty_opt with
+      | None     ->
+         fprintf ff "%a@;%s ◁ₗ uninit %a" pp_sep () id (pp_layout true) layout
+      | Some(ty) -> fprintf ff "%a@;%s ◁ₗ %a" pp_sep () id pp_type_expr ty
+    in
+    begin
+      match (all_vars, sd.sd_constrs) with
+      | ([], []) -> pp "True"
+      | (vs , cs) ->
+          List.iter (pp "%a" pp_var) vs;
+          List.iter (pp "%a@;%a" pp_sep () pp_constr) cs
+    end;
+  in
+  let _pp_inv (id, annot) =
+    (* Opening a box and printing the existentials. *)
+    pp "@;  @[<v 2><[ \"%s\" :=" id;
+    pp_state_descr true true annot;
+    (* Closing the box. *)
+    pp "@]@;]> $"
+  in
+  let _pp_hint hint =
+    (* Opening a box. *)
+    pp "@;  @[<v 2>IPROP_HINT ";
+    begin match hint.ht_kind with
+    | HK_block bid ->
+       pp "(BLOCK_PRECOND \"%s\") (λ _ : unit," bid;
+       pp_state_descr false true hint.ht_annot
+    | HK_assert id ->
+       let (exist_idents, exist_types) = List.split hint.ht_annot.sd_exists in
+       pp "(ASSERT_COND \"%i\") (λ %a : %a,@;%a" id
+         (pp_encoded_patt_name false) exist_idents
+         (pp_as_prod (pp_simple_coq_expr true)) exist_types
+         pp_encoded_patt_bindings exist_idents;
+       pp_state_descr false false hint.ht_annot;
+    end;
+    (* Closing the box. *)
+    pp "@;)%%I ::@]"
+  in
+  
+  let invs = collect_invs def in
+  (* No basic blocks to split in VST it seems *)
+  (* pp "split_blocks ((";
+  List.iter pp_inv invs;
+  pp "@;  ∅@;)%%I : gmap label (iProp Σ)) (";
+  List.iter pp_hint def.func_hints;
+  pp "@;  @nil Prop@;)."; *)
+  let pp_do_step id =
+    pp "@;- repeat liRStep; liShow.";
+    pp "@;  all: print_typesystem_goal \"%s\" \"%s\"." def.func_name id
+  in
+  List.iter pp_do_step (List.cons "#0" (List.map fst invs));
+  pp "@;Unshelve. all: unshelve_sidecond; sidecond_hook; prepare_sideconditions; ";
+  pp "normalize_and_simpl_goal; try solve_goal; unsolved_sidecond_hook.";
+  let tactics_items =
+    let is_all t =
+      let is_selector s =
+        s = "all" ||
+        let ok c = ('0' <= c && c <= '9') || List.mem c [' '; ','; '-'] in
+        String.for_all ok s
+      in
+      match String.split_on_char ':' t with
+      | []     -> false
+      | s :: _ -> is_selector (String.trim s)
+    in
+    let rec pp_tactics_all tactics =
+      match tactics with
+      | t :: ts when is_all t -> pp "@;%s" t; pp_tactics_all ts
+      | ts                    -> ts
+    in
+    pp_tactics_all func_annot.fa_tactics
+  in
+  List.iter (pp "@;+ %s") tactics_items;
+  pp "@;all: print_sidecondition_goal \"%s\"." def.func_name;
+  pp "@;Unshelve. all: try done; try apply: inhabitant; print_remaining_shelved_goal \"%s\"." def.func_name;
+  pp "@]@;Qed.";
+
+  (* Closing the section. *)
+  pp "@]@;End proof_%s.@]" def.func_name
+
+type mode =
+  | Code of string * import list
+  | CodeVST of string * import list
+  | Spec of Coq_path.t * import list * inlined_code * typedef list * string list
+  | SpecVST of Coq_path.t * import list * inlined_code * typedef list * string list
+  | Fprf of Coq_path.t * func_def * import list * string list * proof_kind
+
+let write : mode -> string -> Coq_ast.t -> unit = fun mode fname ast ->
+  let pp =
+    match mode with
+    | Code(root_dir,imports)                 ->
+        pp_code root_dir imports
+    | CodeVST(root_dir,imports)              ->
+        pp_code_vst root_dir imports
+    | Spec(coq_path,imports,inlined,tydefs,ctxt) ->
+        pp_spec coq_path imports inlined tydefs ctxt
+    | SpecVST(coq_path,imports,inlined,tydefs,ctxt) ->
+        pp_spec_vst coq_path imports inlined tydefs ctxt
+    | Fprf(coq_path,def,imports,ctxt,kind)       ->
+        pp_proof coq_path def imports ctxt kind
+  in
+  (* We write to a buffer. *)
+  let buffer = Buffer.create 4096 in
+  Format.fprintf (Format.formatter_of_buffer buffer) "%a@." pp ast;
+  (* Check if we should write the file (inexistent / contents different). *)
+  let must_write =
+    try Buffer.contents (Buffer.from_file fname) <> Buffer.contents buffer
+    with Sys_error(_) -> true
+  in
+  if must_write then Buffer.to_file fname buffer
diff --git a/refinedVST/typing/frontend_stuff/frontend/dune b/refinedVST/typing/frontend_stuff/frontend/dune
new file mode 100644
index 0000000000..76302a02bd
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/frontend/dune
@@ -0,0 +1,16 @@
+(executable
+ (name main)
+ (public_name refinedc)
+ (package refinedc)
+ (preprocess (per_module ((action (run pa_ocaml %{input-file})) rc_annot)))
+ (flags (:standard -w -27))
+ (foreign_stubs (language c) (names stubs))
+ (libraries cmdliner str unix toml ubase earley.core cerberus-lib.frontend
+  cerberus-lib.backend_common cerberus-lib.mem.concrete cerberus-lib.util))
+
+(rule
+ (targets version.ml)
+ (action
+  (with-stdout-to version.ml
+    (run ocaml unix.cma %{dep:tools/gen_version.ml})))
+ (mode fallback))
diff --git a/refinedVST/typing/frontend_stuff/frontend/extra.ml b/refinedVST/typing/frontend_stuff/frontend/extra.ml
new file mode 100644
index 0000000000..03ca176c4e
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/frontend/extra.ml
@@ -0,0 +1,239 @@
+(** Standard library extension (mostly). *)
+
+(** Short name for the type of a pretty-printing function. *)
+type 'a pp = Format.formatter -> 'a -> unit
+
+(** Short name for the type of an equality function. *)
+type 'a eq = 'a -> 'a -> bool
+
+(** Short name for the type of a comparison function. *)
+type 'a cmp = 'a -> 'a -> int
+
+module Int =
+  struct
+    type t = int
+    let compare = (-)
+  end
+
+module Char =
+  struct
+    include Char
+
+    let printable_ascii : char -> bool = fun c ->
+      ' ' <= c && c <= '~'
+  end
+
+module Option =
+  struct
+    type 'a t = 'a option
+
+    let map : ('a -> 'b) -> 'a t -> 'b t = fun f o ->
+      match o with
+      | None    -> None
+      | Some(e) -> Some(f e)
+
+    let map_default : ('a -> 'b) -> 'b -> 'a option -> 'b = fun f d o ->
+      match o with
+      | None    -> d
+      | Some(e) -> f e
+
+    let iter : ('a -> unit) -> 'a t -> unit = fun f o ->
+      match o with
+      | None    -> ()
+      | Some(e) -> f e
+
+    let get : 'a -> 'a option -> 'a = fun d o ->
+      match o with
+      | None    -> d
+      | Some(e) -> e
+
+    let equal : 'a eq -> 'a option eq = fun eq o1 o2 ->
+      match (o1, o2) with
+      | (None    , None    ) -> true
+      | (Some(e1), Some(e2)) -> eq e1 e2
+      | (_       , _       ) -> false
+
+    let pp : 'a pp -> 'a option pp = fun pp_elt oc o ->
+      match o with
+      | None   -> ()
+      | Some e -> pp_elt oc e
+  end
+
+module Filename =
+  struct
+    include Filename
+
+    (** [realpath path] returns the absolute canonical path to file [path]. If
+        [path] is invalid (i.e., it does not describe an existing file),  then
+        the exception [Invalid_argument] is raised. *)
+    external realpath : string -> string = "c_realpath"
+
+    (** [iter_files ?ignored_dirs dir f] recursively traverses directory [dir]
+        and calls function [f] on each file, using as first argument a boolean
+        indicating whether the file is a directory, and as second arugment the
+        full path to the file. The traversal ignores directories whose name is
+        contained in [ignored_dirs], as well as their contents. *)
+    let iter_files : ?ignored_dirs:string list -> string
+        -> (bool -> string -> unit) -> unit = fun ?(ignored_dirs=[]) dir f ->
+      let rec iter dirs =
+        match dirs with
+        | []                  -> ()
+        | (dir, base) :: dirs ->
+        let file = Filename.concat dir base in
+        let is_dir = Sys.is_directory file in
+        (* Ignore if necessary. *)
+        match is_dir && List.mem base ignored_dirs with
+        | true  -> iter dirs
+        | false ->
+        (* Run the action on the current file. *)
+        f is_dir file;
+        (* Compute remaining files. *)
+        if is_dir then
+          let files = Sys.readdir file in
+          let fn name dirs = (file, name) :: dirs in
+          iter (Array.fold_right fn files dirs)
+        else
+          iter dirs
+      in
+      iter [(Filename.dirname dir, Filename.basename dir)]
+
+    (** [relative_path root file] computes a relative filepath for [file] with
+        its origin at [root]. The exception [Invalid_argument] is raised if an
+        error occurs. *)
+    let relative_path : string -> string -> string = fun root file ->
+      let root = realpath root in
+      let file = realpath file in
+      if root = file then "." else
+      let root_len = String.length root in
+      let full_len = String.length file in
+      if root_len > full_len then
+        invalid_arg "Extra.Filename.relative_path";
+      let file_root = String.sub file 0 root_len in
+      if file_root <> root then
+        invalid_arg "Extra.Filename.relative_path";
+      String.sub file (root_len + 1) (full_len - root_len - 1)
+  end
+
+module SMap = Map.Make(String)
+module IMap = Map.Make(Int)
+
+module List =
+  struct
+    include List
+
+    (** [filter_map f l] applies function [f] to the elements of [l], and then
+        filters out then [None]. *)
+    let rec filter_map : ('a -> 'b option) -> 'a list -> 'b list = fun f l ->
+      match l with
+      | []     -> []
+      | h :: t ->
+          match f h with
+          | Some(x) -> x :: filter_map f t
+          | None    -> filter_map f t
+
+    let find_index : ('a -> bool) -> 'a list -> int = fun p l ->
+      let rec find i l =
+        match l with
+        | []     -> raise Not_found
+        | x :: l -> if p x then i else find (i+1) l
+      in
+      find 0 l
+
+    (** [dedup cmp l] filters out dupplicates from list [l] using the function
+        [cmp] to compare elements. It is assumed to be a valid function to use
+        in the instantiation of the [Set.Make] functor. *)
+    let dedup : type a. (a -> a -> int) -> a list -> a list = fun cmp l ->
+      let module S =
+        Set.Make(struct
+          type t = a
+          let compare = cmp
+        end)
+      in
+      let rec dedup elts l =
+        match l with
+        | []                       -> []
+        | x :: l when S.mem x elts -> dedup elts l
+        | x :: l                   -> x :: dedup (S.add x elts) l
+      in
+      dedup S.empty l
+  end
+
+module Buffer =
+  struct
+    include Buffer
+
+    let add_full_channel : t -> in_channel -> unit = fun buf ic ->
+      try
+        while true do
+          add_char buf (input_char ic)
+        done
+      with End_of_file -> ()
+
+    let add_file : t -> string -> unit = fun buf fname ->
+      let ic = open_in fname in
+      add_full_channel buf ic;
+      close_in ic
+
+    let from_file : string -> t = fun fname ->
+      let buf = create 4096 in
+      add_file buf fname; buf
+
+    let to_file : string -> t -> unit = fun fname buf ->
+      let oc = open_out fname in
+      output_buffer oc buf;
+      close_out oc
+  end
+
+module String =
+  struct
+    include String
+
+    let for_all : (char -> bool) -> string -> bool = fun p s ->
+      try iter (fun c -> if not (p c) then raise Exit) s; true
+      with Exit -> false
+
+    let sub_from : string -> int -> string = fun s i ->
+      sub s i (length s - i)
+
+    let trim_leading : char -> string -> string = fun c s ->
+      let len = length s in
+      let index = ref 0 in
+      while !index < len && s.[!index] = '_' do incr index done;
+      sub_from s !index
+  end
+
+(** [outut_lines oc ls] prints the lines [ls] to the output channel [oc]. Note
+    that a newline character is added at the end of each line. *)
+let output_lines : out_channel -> string list -> unit = fun oc ls ->
+  List.iter (Printf.fprintf oc "%s\n") ls
+
+(** [write_file fname ls] writes the lines [ls] to file [fname]. All lines are
+    terminated with a newline character. *)
+let write_file : string -> string list -> unit = fun fname ls ->
+  let oc = open_out fname in
+  output_lines oc ls; close_out oc
+
+(** [append_file fname ls] writes the lines [ls] at the end of file [fname]. A
+    newline terminates each inserted lines. The file must exist. *)
+let append_file : string -> string list -> unit = fun fname ls ->
+  let oc = open_out_gen [Open_append] 0 fname in
+  output_lines oc ls; close_out oc
+
+(** [read_file fname] returns the list of the lines of file [fname]. Note that
+    the trailing newlines are removed. *)
+let read_file : string -> string list = fun fname ->
+  let ic = open_in fname in
+  let lines = ref [] in
+  try
+    while true do lines := input_line ic :: !lines done;
+    assert false (* Unreachable. *)
+  with End_of_file -> close_in ic; List.rev !lines
+
+(** Short name for a standard formatter with continuation. *)
+type ('a,'b) koutfmt = ('a, Format.formatter, unit, unit, unit, 'b) format6
+
+(** [invalid_arg fmt ...] raises [Invalid_argument] with the given message. It
+    can be formed using the standard formatter syntax. *)
+let invalid_arg : ('a, 'b) koutfmt -> 'a = fun fmt ->
+  let cont _ = invalid_arg (Format.flush_str_formatter ()) in
+  Format.kfprintf cont Format.str_formatter fmt
diff --git a/refinedVST/typing/frontend_stuff/frontend/location.ml b/refinedVST/typing/frontend_stuff/frontend/location.ml
new file mode 100644
index 0000000000..a20178ba51
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/frontend/location.ml
@@ -0,0 +1,71 @@
+open Extra
+
+type loc_data =
+  { loc_key   : int
+  ; loc_file  : string
+  ; loc_line1 : int
+  ; loc_col1  : int
+  ; loc_line2 : int
+  ; loc_col2  : int }
+
+module Pool =
+  struct
+    type t =
+      { htbl        : (int, loc_data) Hashtbl.t
+      ; key_counter : int ref }
+
+    let make : unit -> t = fun _ ->
+      { htbl        = Hashtbl.create 97
+      ; key_counter = ref (-1) }
+
+    let fresh : (int -> loc_data option) -> t -> int = fun c pool ->
+      let key = incr pool.key_counter; !(pool.key_counter) in
+      Option.iter (fun data -> Hashtbl.add pool.htbl key data) (c key); key
+
+    let get : t -> int -> loc_data option = fun pool key ->
+      try Some(Hashtbl.find pool.htbl key) with Not_found -> None
+
+    let iter : (loc_data -> unit) -> t -> unit = fun f pool ->
+      Hashtbl.iter (fun _ data -> f data) pool.htbl
+  end
+
+type t = int * Pool.t
+
+let none : Pool.t -> t = fun pool ->
+  (Pool.fresh (fun _ -> None) pool, pool)
+
+let make : string -> int -> int -> int -> int -> Pool.t -> t =
+    fun f l1 c1 l2 c2 pool ->
+  let data key =
+    { loc_key = key; loc_file = f
+    ; loc_line1 = l1+1 ; loc_col1 = c1
+    ; loc_line2 = l2+1 ; loc_col2 = c2 }
+  in
+  (Pool.fresh (fun key -> Some(data key)) pool, pool)
+
+let get : t -> loc_data option = fun (key, pool) ->
+  Pool.get pool key
+
+let pp_data : loc_data pp = fun ff data ->
+  let (l1, c1) = (data.loc_line1, data.loc_col1) in
+  let (l2, c2) = (data.loc_line2, data.loc_col2) in
+  Format.fprintf ff "%s %i:%i" data.loc_file l1 c1;
+  if l1 = l2 && c1 <> c2 then Format.fprintf ff "-%i" c2;
+  if l1 <> l2 then Format.fprintf ff "-%i:%i" l2 c2
+
+let pp_loc : t pp = fun ff (key, pool) ->
+  match Pool.get pool key with
+  | Some(d) -> pp_data ff d
+  | None    -> Format.fprintf ff "unknown"
+
+type 'a located = { elt : 'a ; loc : t }
+
+let to_cerb_loc : t -> Cerb_location.t = fun (key, pool) ->
+  match Pool.get pool key with
+  | None    -> Cerb_location.unknown
+  | Some(d) ->
+  let pos_fname = d.loc_file in
+  let {loc_line1=l1; loc_col1=c1; loc_line2=l2; loc_col2=c2; _} = d in
+  let p1 = Lexing.{pos_fname; pos_lnum=l1; pos_bol=0; pos_cnum=c1} in
+  let p2 = Lexing.{pos_fname; pos_lnum=l2; pos_bol=0; pos_cnum=c2} in
+  Cerb_location.region (p1, p2) NoCursor
diff --git a/refinedVST/typing/frontend_stuff/frontend/location.mli b/refinedVST/typing/frontend_stuff/frontend/location.mli
new file mode 100644
index 0000000000..b536995401
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/frontend/location.mli
@@ -0,0 +1,30 @@
+open Extra
+
+type t
+
+type loc_data =
+  { loc_key   : int
+  ; loc_file  : string
+  ; loc_line1 : int
+  ; loc_col1  : int
+  ; loc_line2 : int
+  ; loc_col2  : int }
+
+module Pool :
+  sig
+    type t
+
+    val make : unit -> t
+    val iter : (loc_data -> unit) -> t -> unit
+  end
+
+val none : Pool.t -> t
+val make : string -> int -> int -> int -> int -> Pool.t -> t
+val get : t -> loc_data option
+
+val pp_data : loc_data pp
+val pp_loc : t pp
+
+type 'a located = { elt : 'a ; loc : t }
+
+val to_cerb_loc : t -> Cerb_location.t
diff --git a/refinedVST/typing/frontend_stuff/frontend/main.ml b/refinedVST/typing/frontend_stuff/frontend/main.ml
new file mode 100644
index 0000000000..7e8a859a09
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/frontend/main.ml
@@ -0,0 +1,705 @@
+open Cmdliner
+open Extra
+open Panic.Simple
+open Project
+open Version
+
+(* Standard file and directory names. *)
+
+let rc_project_file   = "rc-project.toml"
+let dune_proj_file    = "dune-project"
+let coq_project_file  = "_CoqProject"
+let rc_dir_name       = "proofs"
+
+let code_file_name    = "generated_code.v"
+let code_file_name_vst = "generated_code_vst.v"
+let spec_file_name    = "generated_spec.v"
+let spec_file_name_vst = "generated_spec_vst.v"
+let proof_file_name   = Printf.sprintf "generated_proof_vst_%s.v"
+(* let proof_file_name_vst = Printf.sprintf "generated_proof_%s_vst.v" *)
+let proofs_file_name  = "proof_files"
+(* let proofs_file_name_vst = "proof_files_vst" *)
+
+(* Default Coq root prefix. *)
+
+let default_coq_root_prefix = ["refinedc"; "project"]
+
+(* The default Coq root is the above prefix followed by the project name. *)
+let default_coq_root : Coq_path.member -> Coq_path.t =
+  let default_coq_root_prefix =
+    try List.map Coq_path.member_of_string default_coq_root_prefix
+    with Invalid_argument(_) -> assert false (* Should never fail. *)
+  in
+  fun base -> Coq_path.path_of_members (default_coq_root_prefix @ [base])
+
+(* RefinedC include directory (containing [refinedc.h]). *)
+let refinedc_include : string option =
+  try
+    let opam_prefix = Sys.getenv "OPAM_SWITCH_PREFIX" in
+    Some(Filename.concat opam_prefix "lib/refinedc/include")
+  with Not_found -> None
+
+(* The RefinedC tooling assumes a specific structure of the working directory.
+   It is organized in a "RefinedC project", that can be set up with a provided
+   command. Further actions maintain several invariants, like the existence of
+   certain files.
+
+   A RefinedC project, when it is initialized, contains the following files in
+   its root directory:
+    - [rc_project_file] containing certain project metadata,
+    - [dune_proj_file] containing the build system setup for Coq,
+    - [coq_project_file] containing editor setup for Coq.
+   These files are generated, and should not be modified directly. These files
+   all have special, reserved names, that should not be used for other files.
+
+   When checking a C source file, say ["src/dir/file.c"], RefinedC creates the
+   special directory ["src/dir/" ^ rc_dir_name] if it does not already exists,
+   and it also creates a directory ["file"] inside it (having the same name as
+   the C source file, without the extension). This directory then contains all
+   the generated (Coq) files corresponding to ["src/dir/file.c"]. For example,
+   it would contain the code file [code_file_name].
+
+   When checking another file of the same directory, a similar directory (with
+   the base name of the file) is created under the special RefinedC directory.
+   For example, the project source tree may look like the following:
+   [{|
+     .
+     ├── _CoqProject
+     ├── dune-project
+     ├── lib
+     │   ├── proofs
+     │   │   └── socket
+     │   │       ├── generated_code.v
+     │   │       └── generated_spec.v
+     │   └── socket.c
+     ├── rc-project.toml
+     └── src
+         ├── client
+         │   ├── client.c
+         │   ├── lib.c
+         │   └── proofs
+         │       ├── client
+         │       │   ├── generated_code.v
+         │       │   └── generated_spec.v
+         │       └── lib
+         │           ├── generated_code.v
+         │           └── generated_spec.v
+         └── server
+             ├── proofs
+             │   └── server
+             │       ├── generated_code.v
+             │       └── generated_spec.v
+             └── server.c
+   |}]
+   The Coq qualification for each source file is determined by the Coq logical
+   directory chosen at project creation (which defaults to something using the
+   directory name if possible). Using the example above, and assuming that the
+   Coq logical directory name of the project is ["refinedc.project.my_server"]
+   then ["src/client/proofs/client/generated_code.v"] is mapped to module name
+   ["refinedc.project.my_server.src.client.generated_code"] in Coq.
+
+   A directory corresponding to the generated code of a C source file also has
+   a ["dune"] file, that controls its building. It is automatically generated,
+   and automatically updated in case of changes.
+
+   The user can freely add Coq files (provided they do not have reserved names
+   like [code_file_name], [spec_file_name] or [proof_file_name s] where [s] is
+   a potential C function name) to directories corresponding to any C file.
+
+   TODO Find a better way, with a specific directory?
+
+   RefinedC relies on file [proofs_file_name], placed next to generated files,
+   to identify the currently valid proof files. When the user removes or moves
+   a function spec, a proof file may no longer correspond to anything. In that
+   case it is deleted by RefinedC automatically upon generation. *)
+
+(** Metadata associated to a C file. *)
+type c_file_data = {
+  orig_path : string; (** Path given by the user on the command line. *)
+  file_path : string; (** Absolute, normalised file path. *)
+  file_dir  : string; (** Directory holding the file. *)
+  base_name : string; (** Base name of the file, without extension. *)
+  root_dir  : string; (** Absolute path to the RefinedVST frontend root. *)
+  vst_dir   : string; (** Absolute path to the VST project root. *)
+  rel_path  : string list; (** Relative path to the parent directory. *)
+  proj_cfg  : project_config; (** Associated project configuration. *)
+}
+
+(** [get_c_file_data path] computes various metadata for the C file pointed to
+    by the given [path]. It includes, for instance, the path to the associated
+    RefinedC project directory. In case of error a suitable message is printed
+    and the program is terminated. *)
+let get_c_file_data : string -> c_file_data = fun c_file ->
+  (* Original file path. *)
+  let orig_path = c_file in
+  (* Absolute, normalised file path. *)
+  let file_path =
+    try Filename.realpath c_file with Invalid_argument(_) ->
+      panic "File \"%s\" disappeared..." c_file
+  in
+  (* Directoru, base name and extension. *)
+  let file_dir = Filename.dirname file_path in
+  let base_name = Filename.basename file_path in
+  let base_name = Filename.remove_extension base_name in
+  (* Root directory and relative path. *)
+  let (root_dir, rel_path) =
+    let rec find acc dir =
+      let rc_project = Filename.concat dir rc_project_file in
+      if Sys.file_exists rc_project then (dir, acc) else
+      let parent = Filename.dirname dir in
+      if parent = dir then raise Not_found;
+      find (Filename.basename dir :: acc) parent
+    in
+    try find [] file_dir with Not_found ->
+      panic "No RefinedC project can be located for file \"%s\"." orig_path
+  in
+  let vst_dir =
+    let rec find acc dir =
+      let vst_project = Filename.concat dir coq_project_file in
+      Printf.printf "try: %s\n" dir;
+      if Sys.file_exists vst_project then dir else
+      let parent = Filename.dirname dir in
+      if parent = dir then raise Not_found;
+      find (Filename.basename dir :: acc) parent
+    in
+    try find [] file_dir with Not_found ->
+      panic "No RefinedC project can be located for file \"%s\"." orig_path
+  in
+  Printf.printf "root_dir: %s\n" root_dir;
+  (* Reading the project configuration. *)
+  let proj_cfg =
+    let project_file = Filename.concat root_dir rc_project_file in
+    try
+      if Sys.is_directory project_file then
+        panic "Invalid project file \"%s\" (directory)." project_file;
+      read_project_file project_file
+    with Sys_error(_) ->
+      panic "Error while reading the project file \"%s\"." project_file
+  in
+  {orig_path; file_path; file_dir; base_name; root_dir; vst_dir; rel_path; proj_cfg}
+
+(** Command line configuration for the ["check"] command. *)
+type config =
+  { cpp_config  : Cerb_wrapper.cpp_config
+  ; no_locs     : bool
+  ; no_analysis : bool
+  ; no_build    : bool
+  ; no_mem_cast : bool }
+
+(** Entry point for the ["check"] command. *)
+let run : config -> string -> unit = fun cfg c_file ->
+  (* Set the printing flags. *)
+  if cfg.no_locs then
+    begin
+      Coq_pp.print_expr_locs := false;
+      Coq_pp.print_stmt_locs := false
+    end;
+  if cfg.no_mem_cast then
+    begin
+      Coq_pp.no_mem_cast := true
+    end;
+  (* Obtain the metadata for the input C file. *)
+  let c_file = get_c_file_data c_file in
+  (* Compute the base Coq logical path for the files. *)
+  let path =
+    let suffix =
+      let suffix = c_file.rel_path @ [c_file.base_name] in
+      try List.map Coq_path.member_of_string suffix
+      with Invalid_argument(msg) ->
+        panic "File \"%s\" does not correspond to a valid Coq module path.\n\
+              The obtained module path segment is \"%s\".\n%s"
+              c_file.orig_path (String.concat "." suffix) msg
+    in
+    Coq_path.append c_file.proj_cfg.project_coq_root suffix
+  in
+  (* Prepare the output folder if need be. *)
+  let file_rc_dir = Filename.concat c_file.file_dir rc_dir_name in
+  if not (Sys.file_exists file_rc_dir) then Unix.mkdir file_rc_dir 0o755;
+  let output_dir = Filename.concat file_rc_dir c_file.base_name in
+  if not (Sys.file_exists output_dir) then
+    begin
+      Unix.mkdir output_dir 0o755;
+      (* Add the mapping to the Coq project file for editors. *)
+      let dune_dir_path =
+        let relative_path =
+          Filename.relative_path c_file.root_dir c_file.file_dir
+        in
+        let path =
+          if relative_path = Filename.current_dir_name then "_build/default"
+          else Filename.concat "_build/default" relative_path
+        in
+        let path = Filename.concat path rc_dir_name in
+        Filename.concat path c_file.base_name
+      in
+      let coq_proj_path = Filename.concat c_file.vst_dir coq_project_file in
+      Printf.printf "coq_proj_path: %s\n" coq_proj_path;
+      let new_line =
+        Printf.sprintf "-Q %s %s" dune_dir_path (Coq_path.to_string path)
+      in
+      let lines = try read_file coq_proj_path with Sys_error(_) -> [] in
+      if not (List.mem new_line lines) then
+        append_file coq_proj_path [new_line]
+    end;
+  (* Paths to the output files. *)
+  let code_file = Filename.concat output_dir code_file_name in
+  let code_file_vst = Filename.concat output_dir code_file_name_vst in
+  let spec_file = Filename.concat output_dir spec_file_name in
+  let spec_file_vst = Filename.concat output_dir spec_file_name_vst in
+  let proof_of_file id = Filename.concat output_dir (proof_file_name id) in
+  (* let proof_of_file_vst id = Filename.concat output_dir (proof_file_name_vst id) in *)
+  let proof_files_file = Filename.concat output_dir proofs_file_name in
+  (* let proof_files_file_vst = Filename.concat output_dir proofs_file_name_vst in *)
+  let dune_file = Filename.concat output_dir "dune" in
+  (* Prepare the CPP configuration. *)
+  let cpp_config =
+    let cpp_I =
+      let proj_include =
+        let incl = c_file.proj_cfg.project_cpp_include in
+        List.map (Filename.concat c_file.root_dir) incl
+      in
+      let cpp_include = cfg.cpp_config.cpp_I @ proj_include in
+      match (refinedc_include, c_file.proj_cfg.project_cpp_with_rc) with
+      | (_      , false) -> cpp_include
+      | (Some(d), true ) -> d :: cpp_include
+      | (None   , true ) ->
+          panic "Unable to locate the RefinedC include directory."
+    in
+    {cfg.cpp_config with cpp_I}
+  in
+  (* Parse the comment annotations. *)
+  let open Comment_annot in
+  let ca =
+    let lines = Cerb_wrapper.cpp_lines cpp_config c_file.file_path in
+    parse_annots lines
+  in
+  let ctxt = List.map (fun s -> "Context " ^ s) ca.ca_context in
+  (* Do the translation to Ail, analyse, and generate our AST. *)
+  Sys.chdir c_file.root_dir; (* Move to the root to get relative paths. *)
+  let c_file_rel = Filename.relative_path c_file.root_dir c_file.file_path in
+  let ail_ast = Cerb_wrapper.c_file_to_ail cpp_config c_file_rel in
+  if not cfg.no_analysis then Warn.warn_file ail_ast;
+  let coq_ast = Ail_to_coq.translate c_file_rel ail_ast in
+  (* Generate the code file. *)
+  let open Coq_pp in
+  let mode = Code(c_file.root_dir, ca.ca_code_imports) in
+  write mode code_file coq_ast;
+  let mode = CodeVST(c_file.root_dir, ca.ca_code_imports) in
+  write mode code_file_vst coq_ast;
+  (* Generate the spec file. *)
+  let mode = Spec(path, ca.ca_imports, ca.ca_inlined, ca.ca_typedefs, ctxt) in
+  write mode spec_file coq_ast;
+  let mode = SpecVST(path, ca.ca_imports, ca.ca_inlined, ca.ca_typedefs, ctxt) in
+  write mode spec_file_vst coq_ast;
+  (* Compute the list of proof files to generate. *)
+  let to_generate =
+    let not_inlined (_, def_or_decl) =
+      let open Coq_ast in
+      match def_or_decl with
+      | FDef(def) when is_inlined def -> false
+      | _                             -> true
+    in
+    let fs = List.filter not_inlined coq_ast.functions in
+    let files = List.map (fun (id, _) -> proof_of_file id) fs in
+    List.sort_uniq String.compare files
+  in
+  (* Delete obsolete proof files. *)
+  let already_generated =
+    let files = try read_file proof_files_file with Sys_error(_) -> [] in
+    List.map (Filename.concat output_dir) files
+  in
+  let delete_when_obsolete fname =
+    if not (List.mem fname to_generate) then
+      try Sys.remove fname with Sys_error(_) -> ()
+  in
+  List.iter delete_when_obsolete already_generated;
+  (* Write the new list of proof files. *)
+  write_file proof_files_file (List.map Filename.basename to_generate);
+  (* Generate the proof files. *)
+  let proof_imports = ca.ca_imports @ ca.ca_proof_imports in
+  let write_proof (id, def_or_decl) =
+    let open Coq_ast in
+    match def_or_decl with
+    | FDec(_)                       -> ()
+    | FDef(def) when is_inlined def -> ()
+    | FDef(def)                     ->
+    let mode = Fprf(path, def, proof_imports, ctxt, proof_kind def) in
+    write mode (proof_of_file id) coq_ast
+  in
+  List.iter write_proof coq_ast.functions;
+  (* Generate the dune file. *)
+  (* let theories =
+    let default_theories = ["refinedc.typing"; "refinedc.typing.automation"; "caesium"; "lithium";
+                            "iris"; "stdpp"; "Ltac2"; "RecordUpdate"] in
+    let glob = List.map Coq_path.to_string c_file.proj_cfg.project_theories in
+    let imports = ca.ca_imports @ ca.ca_proof_imports @ ca.ca_code_imports in
+    let imports = List.sort_uniq Stdlib.compare imports in
+    ignore imports; (* TODO some dependency analysis based on [imports]. *)
+    let theories =
+      let path = Coq_path.to_string path in
+      List.filter (fun s -> s <> path) (ca.ca_requires @ glob @ default_theories)
+    in
+    List.sort_uniq String.compare theories
+  in *)
+  Printf.printf "theories: %s \n" dune_file;
+  Printf.printf "vst_dir: %s\n" c_file.vst_dir;
+  Printf.printf "spec: %s\n" spec_file_vst;
+  Printf.printf "code: %s\n" code_file_vst;
+  (* write_file dune_file [
+    "; Generated by [refinedc], do not edit.";
+    "(coq.theory";
+    " (flags :standard -w -notation-overridden \
+                       -w -redundant-canonical-projection)";
+    Printf.sprintf " (name %s)" (Coq_path.to_string path);
+    Printf.sprintf " (theories %s))" (String.concat " " theories);
+  ]; *)
+  (* Run Coq type-checking. *)
+  if not (cfg.no_build || c_file.proj_cfg.project_no_build) then
+    begin
+      Sys.chdir c_file.vst_dir;
+      match Sys.command ("(set -x; make " ^ code_file_vst ^ "o)") with
+      | 0           ->
+          info "File \"%s\" successfully checked.\n%!" c_file.orig_path
+      | i           ->
+          panic "The call to [dune] returned with error code %i." i
+      | exception _ ->
+          panic "The call to [dune] failed for some reason."
+    end;
+  Printf.printf "done\n"
+
+let cpp_I =
+  let doc =
+    "Add the directory $(docv) to the list of directories to be searched for \
+     header files during preprocessing."
+  in
+  let i = Arg.(info ["I"] ~docv:"DIR" ~doc) in
+  Arg.(value & opt_all dir [] & i)
+
+let cpp_include =
+  let doc =
+    "Add an include for the file $(docv) at the beginning of the source file."
+  in
+  let i = Arg.(info ["include"] ~docv:"FILE" ~doc) in
+  Arg.(value & opt_all file [] & i)
+
+
+let cpp_nostdinc =
+  let doc =
+    "Do not search the standard system directories for header files. Only \
+     the directories explicitly specified with $(b,-I) options are searched."
+  in
+  Arg.(value & flag & info ["nostdinc"] ~doc)
+
+let cpp_D =
+  let doc =
+    "Do not search the standard system directories for header files. Only \
+     the directories explicitly specified with $(b,-I) options are searched."
+  in
+  let i = Arg.(info ["D"] ~docv:"MACRODEF" ~doc) in
+  Arg.(value & opt_all string [] & i)
+
+let cpp_config =
+  let build cpp_I cpp_include cpp_nostdinc cpp_D =
+    Cerb_wrapper.{cpp_I; cpp_include; cpp_nostdinc; cpp_D}
+  in
+  Term.(const build $ cpp_I $ cpp_include $ cpp_nostdinc $ cpp_D)
+
+let no_analysis =
+  let doc =
+    "Disable the extra analyses (and the corresponding warnings) that are \
+     performed on the source code by default. There are two such analyses. \
+     (1) A warning is issued when the address of a local variable whose \
+     scope is not that of the function is taken. Indeed, if that happens \
+     then variables can potentially escape their lifetime (which is only \
+     active in the block they are defined in) since all local variable are \
+     hoisted to the function scope by RefiendC. (2) A warning is issued when \
+     there is potential non-determinism in evaluation of expressions. This \
+     is a problem since C has a loose ordering of expression evaluation, \
+     while RefiendC has a fixed left-to-right evaluation order. Note that \
+     these two analyses are over-approximations."
+  in
+  Arg.(value & flag & info ["no-extra-analysis"] ~doc)
+
+let no_locs =
+  let doc =
+    "Do not output any location information in the generated Coq files."
+  in
+  Arg.(value & flag & info ["no-locs"] ~doc)
+
+let no_build =
+  let doc =
+    "Do not build Coq object files after generation."
+  in
+  Arg.(value & flag & info ["no-build"] ~doc)
+
+let no_mem_cast =
+  let doc =
+    "Disable mem cast on loads from memory."
+  in
+  Arg.(value & flag & info ["no-mem-cast"] ~doc)
+
+let opts : config Term.t =
+  let build cpp_config no_analysis no_locs no_build no_mem_cast =
+    { cpp_config ; no_analysis ; no_locs ; no_build ; no_mem_cast }
+  in
+  Term.(const build $ cpp_config $ no_analysis $ no_locs $ no_build $ no_mem_cast)
+
+let c_file =
+  let doc = "C language source file." in
+  Arg.(required & pos 0 (some non_dir_file) None & info [] ~docv:"FILE" ~doc)
+
+let check_cmd =
+  let open Term in
+  let term = const run $ opts $ c_file in
+  let doc = "Run RefiendC on the given C file." in
+  Cmd.(v (info "check" ~version ~doc) term)
+
+(* Preprocessing command (useful for debugging). *)
+
+let run_cpp config c_file =
+  output_lines stdout (Cerb_wrapper.cpp_lines config c_file);
+  flush stdout
+
+let cpp_cmd =
+  let doc = "Print the result of the Cerberus preprocessor to stdout." in
+  Cmd.(v (info "cpp" ~version ~doc) Term.(const run_cpp $ cpp_config $ c_file))
+
+(* Ail printing command (useful for debugging). *)
+
+let run_ail config c_file =
+  let ail_ast = Cerb_wrapper.c_file_to_ail config c_file in
+  Cerb_wrapper.print_ail ail_ast
+
+let ail_cmd =
+  let doc = "Print the Cerberus Ail AST of the given C file to stdout." in
+  Cmd.(v (info "ail" ~version ~doc) Term.(const run_ail $ cpp_config $ c_file))
+
+(* Cleaning command. *)
+
+let run_clean : bool -> string -> unit = fun soft c_file ->
+  (* Obtain the metadata for the input C file. *)
+  let c_file = get_c_file_data c_file in
+  (* Compute the relevant directory and file paths. *)
+  let rc_dir = Filename.concat c_file.file_dir rc_dir_name in
+  let gen_dir = Filename.concat rc_dir c_file.base_name in
+  let dune_file = Filename.concat gen_dir "dune" in
+  let proofs_file = Filename.concat gen_dir proofs_file_name in
+  let code_file = Filename.concat gen_dir code_file_name in
+  let spec_file = Filename.concat gen_dir spec_file_name in
+  let proof_files =
+    let files = try read_file proofs_file with Sys_error(_) -> [] in
+    List.map (Filename.concat gen_dir) files
+  in
+  (* Compute the list of files to delete, and delete them. *)
+  let all = [code_file; spec_file; dune_file; proofs_file] @ proof_files in
+  List.iter (fun f -> try Sys.remove f with Sys_error(_) -> ()) all;
+  (* Check if the generated directories are empty and if so delete them. *)
+  let all_dirs = [gen_dir; rc_dir] in
+  let rmdir dir =
+    let files = try Sys.readdir dir with Sys_error(_) -> [||] in
+    if Array.length files = 0 then
+      ignore (Sys.command (Printf.sprintf "rm -rf %s" dir))
+  in
+  List.iter rmdir all_dirs;
+  (* Delete the Coq project mapping for the file. *)
+  if not soft then
+  (* Compute the base Coq logical path for the files. *)
+  let path =
+    let suffix =
+      let suffix = c_file.rel_path @ [c_file.base_name] in
+      try List.map Coq_path.member_of_string suffix
+      with Invalid_argument(msg) ->
+        panic "File \"%s\" does not correspond to a valid Coq module path.\n\
+              The obtained module path segment is \"%s\".\n%s"
+              c_file.orig_path (String.concat "." suffix) msg
+    in
+    Coq_path.append c_file.proj_cfg.project_coq_root suffix
+  in
+  let dune_dir_path =
+    let rel_path = Filename.relative_path c_file.root_dir c_file.file_dir in
+    let path = Filename.concat "_build/default" rel_path in
+    let path = Filename.concat path rc_dir_name in
+    Filename.concat path c_file.base_name
+  in
+  let coq_project_path = Filename.concat c_file.vst_dir coq_project_file in
+  Printf.printf "coq_project_path: %s\n" coq_project_path;
+  let line =
+    let path = Coq_path.to_string path in
+    Printf.sprintf "-Q %s %s" dune_dir_path path
+  in
+  let lines = try read_file coq_project_path with Sys_error(_) -> [] in
+  if List.mem line lines then
+    begin
+      let new_lines = List.filter (fun s -> s <> line) lines in
+      write_file coq_project_path new_lines
+    end
+
+let soft =
+  let doc =
+    "Do not remove the corresponding entry from the `_CoqProject' file."
+  in
+  Arg.(value & flag & info ["soft"] ~doc)
+
+let clean_cmd =
+  let doc = "Delete all the generated files for the given C source file." in
+  Cmd.(v (info "clean" ~version ~doc) Term.(const run_clean $ soft $ c_file))
+
+(* Project initialization command. *)
+
+let init : string option -> unit = fun coq_path ->
+  (* Read the current working directory. *)
+  let wd =
+    try Filename.realpath (Sys.getcwd ()) with Invalid_argument(_) ->
+      panic "Error while reading the current working directory."
+  in
+  (* Files to generate. *)
+  let rc_project_path = Filename.concat wd rc_project_file in
+  let dune_project_path = Filename.concat wd dune_proj_file in
+  let coq_project_path = Filename.concat wd coq_project_file in
+  (* Check for an existing project. *)
+  if Sys.file_exists rc_project_path then
+    panic "A RefinedC project already exists here.";
+  (* Check for conflicting project files in subdirectories. *)
+  let file_check is_dir path =
+    let dir = Filename.dirname path in
+    let base = Filename.basename path in
+    if base = rc_project_file then
+      if is_dir then
+        panic "Subdirectory \"%s\" uses a reserved name." path
+      else
+        panic "A RefinedC project exists in directory \"%s\"." dir
+    else if base = dune_proj_file then
+      if is_dir then
+        panic "Subdirectory \"%s\" uses a reserved name." path
+      else
+        panic "A \"%s\" file exists in directory \"%s\"." dune_proj_file dir
+    else if base = coq_project_file then
+      if is_dir then
+        panic "Subdirectory \"%s\" uses a reserved name." path
+      else
+        panic "A \"%s\" file exists in directory \"%s\"." dune_proj_file dir
+    else if base = rc_dir_name then
+      if is_dir then
+        panic "Directory \"%s\" uses a reserved name." path
+      else
+        panic "File \"%s\" uses a reserved name." path
+    else ()
+  in
+  Filename.iter_files ~ignored_dirs:[".git"; "_build"; "_opam"] wd file_check;
+  (* Check for conflicting projects in parent directories. *)
+  let rec check_parents dir =
+    let check_dir dir =
+      (* Avoid nested RefinedC projects for sanity. *)
+      let file = Filename.concat dir rc_project_file in
+      if Sys.file_exists file then begin
+        if Sys.is_directory file then
+          panic "Parent directory \"%s\" has a reserved name." file;
+        panic "Nested under RefinedC project \"%s\"." file
+      end;
+      (* Avoid nested dune workspaces, leads to problems. *)
+      let file = Filename.concat dir dune_proj_file in
+      if Sys.file_exists file then begin
+        if Sys.is_directory file then
+          panic "Parent directory \"%s\" has a reserved name." file;
+        panic "Nested under RefinedC project \"%s\"." file
+      end
+      (* Coq project files should be OK. *)
+    in
+    let parent = Filename.dirname dir in
+    if parent <> dir then (check_dir parent; check_parents parent)
+  in
+  check_parents wd;
+  (* Build the Coq root path, using a possible CLI argument. *)
+  let coq_path =
+    let parse_coq_path d =
+      try Coq_path.path_of_string d with Invalid_argument(msg) ->
+      let example =
+        let d =
+          match Coq_path.fixup_string_path d with Some(d) -> d | None ->
+          String.concat "." (default_coq_root_prefix @ ["my_project"])
+        in
+        try Coq_path.path_of_string d with Invalid_argument(msg) ->
+          assert false (* Cannot happen. *)
+      in
+      panic "%s\nRetry using option \"--coq-path=%a\" or similar."
+        msg Coq_path.pp example
+    in
+    match coq_path with
+    | Some(d) -> parse_coq_path d
+    | None    ->
+    let base =
+      let base = Filename.basename wd in
+      try Coq_path.member_of_string base with Invalid_argument(msg) ->
+      let example =
+        let base =
+          match Coq_path.fixup_string_member base with
+          | Some(id) -> id
+          | None     -> "my_project"
+        in
+        try default_coq_root (Coq_path.member_of_string base)
+        with Invalid_argument(_) -> assert false (* Cannot happen. *)
+      in
+      panic "Current directory name \"%s\" cannot be used to build a Coq \
+            module path.\n%s\nRetry using option \"--coq-path=%a\" or \
+            similar." base msg Coq_path.pp example
+    in
+    default_coq_root base
+  in
+  (* Now we are safe, generate the project files. *)
+  write_project_file rc_project_path (default_project_config coq_path);
+  write_file dune_project_path [
+    "(lang dune 3.8)";
+    "(using coq 0.8)";
+    "; Generated by [refinedc], do not edit.";
+  ];
+  write_file coq_project_path [
+    "# Generated by [refinedc], do not edit.";
+    "-arg -w -arg -notation-overridden";
+    "-arg -w -arg -redundant-canonical-projection";
+  ];
+  (* Reporting. *)
+  info "Initialized a RefinedC project in \"%s\".\n" wd;
+  info "Using Coq root module path [%a].\n%!" Coq_path.pp coq_path
+
+let coq_path =
+  let doc =
+    "Specify the Coq module path under which the created verification \
+    project is to be placed. The argument is expected to be a dot-sperated \
+    list of identifiers formed of letters and underscores (but not in first \
+    position). If no explicit Coq directory is given then it defaults to \
+    [refinedc.project.DIRNAME], where DIRNAME is the current directory name. \
+    If DIRNAME is not a valid identifier then the command fails."
+  in
+  let i = Arg.(info ["coq-path"] ~docv:"COQDIR" ~doc) in
+  Arg.(value & opt (some string) None & i)
+
+let init_cmd =
+  let doc = "Create a new RefinedC project in the current directory." in
+  Cmd.(v (info "init" ~version ~doc) Term.(const init $ coq_path))
+
+(* A few trivial commands. *)
+
+let print_version () =
+  info "RefinedC version: %s\nRelying on Cerberus version: %s\n%!"
+    Version.version Cerb_frontend.Version.version
+
+let version_cmd =
+  let doc = "Show detailed version information for RefinedC." in
+  Cmd.(v (info "version" ~version ~doc) Term.(const print_version $ const ()))
+
+let help_cmd =
+  let doc = "Show the main help page for RefinedC." in
+  Cmd.(v (info "help" ~version ~doc) Term.(ret (const (`Help (`Pager, None)))))
+
+let (default_cmd, default_info) =
+  let doc = "RefinedC program verification framework." in
+  Term.(ret (const (`Help(`Pager, None)))),
+  Cmd.info "refinedc" ~version ~doc
+
+(* Entry point. *)
+let _ =
+  let cmds =
+    [ init_cmd ; cpp_cmd ; ail_cmd ; check_cmd ; clean_cmd
+    ; help_cmd ; version_cmd ]
+  in
+  (* Term.(exit (eval_choice default_cmd cmds)) *)
+  Stdlib.exit (Cmd.eval (Cmd.group default_info ~default:default_cmd cmds))
diff --git a/refinedVST/typing/frontend_stuff/frontend/panic.ml b/refinedVST/typing/frontend_stuff/frontend/panic.ml
new file mode 100644
index 0000000000..b25f1d6bf8
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/frontend/panic.ml
@@ -0,0 +1,57 @@
+(** Output and debugging utilities. *)
+
+open Extra
+
+type loc = Cerb_location.t
+
+let pp_loc : loc pp = fun oc loc ->
+  Format.pp_print_string oc (Cerb_location.location_to_string loc)
+
+let pp_loc_opt : loc option pp = fun oc lopt ->
+  Option.iter (Format.fprintf oc "[%a] " pp_loc) lopt
+
+(** Short name for a standard formatter. *)
+type 'a outfmt = ('a, Format.formatter, unit) format
+
+(** Short name for a standard formatter with continuation. *)
+type ('a, 'b) koutfmt = ('a, Format.formatter, unit, unit, unit, 'b) format6
+
+(** Format transformers (colors). *)
+let with_color k fmt = "\027[" ^^ k ^^ "m" ^^ fmt ^^ "\027[0m%!"
+
+let red fmt = with_color "31" fmt
+let gre fmt = with_color "32" fmt
+let yel fmt = with_color "33" fmt
+let blu fmt = with_color "34" fmt
+let mag fmt = with_color "35" fmt
+let cya fmt = with_color "36" fmt
+
+let info : 'a outfmt -> 'a = Format.printf
+
+(** [wrn loc_opt fmt] outputs a waning to [stderr] using [Format] format [fmt]
+    and the correponding arguments. If [loc_opt] is [Some(loc)], then location
+    [loc] is shown as a prefix of the warning. Note that a newline is added to
+    the end of the message automatically, and that [stderr] is flushed. *)
+let wrn : loc option -> 'a outfmt -> 'a = fun lopt fmt ->
+  Format.eprintf (yel ("%a" ^^ fmt ^^ "\n")) pp_loc_opt lopt
+
+(** [panic loc fmt] interrupts the program with [exit 1], after displaying the
+    error message described by [Format] format [fmt].  Location [loc] is shown
+    as a prefix of the error message,  and a newline is automatically inserted
+    at its end ([stderr] is also flushed) *)
+let panic : loc -> ('a, 'b) koutfmt -> 'a = fun loc fmt ->
+  let fmt = red ("[%a] " ^^ fmt ^^ "\n") in
+  Format.kfprintf (fun _ -> exit 1) Format.err_formatter fmt pp_loc loc
+
+(** [panic_no_pos fmt] is similar to [panic _ fmt], but has no location. *)
+let panic_no_pos : ('a,'b) koutfmt -> 'a = fun fmt ->
+  let fmt = red (fmt ^^ "\n") in
+  Format.kfprintf (fun _ -> exit 1) Format.err_formatter fmt
+
+(** Simpler interface for when there is no precise position. *)
+module Simple =
+  struct
+    let panic : ('a,'b) koutfmt -> 'a = panic_no_pos
+    let wrn   : 'a outfmt -> 'a = fun fmt -> wrn None fmt
+    let info  : 'a outfmt -> 'a = info
+  end
diff --git a/refinedVST/typing/frontend_stuff/frontend/project.ml b/refinedVST/typing/frontend_stuff/frontend/project.ml
new file mode 100644
index 0000000000..cb5086b179
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/frontend/project.ml
@@ -0,0 +1,120 @@
+open Extra
+open Panic.Simple
+
+(** Project configuration (read from and written to a Toml file). *)
+type project_config =
+  { project_coq_root    : Coq_path.t (** Coq root path for the project. *)
+  ; project_theories    : Coq_path.t list (** Extra Coq (dune) theories. *)
+  ; project_cpp_include : string list (** CPP include directories. *)
+  ; project_cpp_with_rc : bool (** Use global RefinedC include directory? *)
+  ; project_no_build    : bool (** Do not run the Coq compilation. *) }
+
+(** [default_project_config coq_root] builds a default configuration for a new
+    RefinedC project under Coq logical directory [coq_root]. *)
+let default_project_config : Coq_path.t -> project_config = fun coq_root ->
+  { project_coq_root    = coq_root
+  ; project_theories    = []
+  ; project_cpp_include = []
+  ; project_cpp_with_rc = true
+  ; project_no_build    = false }
+
+(** [read_project_file fname] reads a RefinedC project configuration from file
+    [fname] (in Toml format). The function may raise [Sys_error] in case of an
+    error when reading the configuration file. If the file is invalid then the
+    program fails with exit code [1] after printing an explanation. *)
+let read_project_file : string -> project_config = fun file ->
+  let panic fmt = panic ("Broken project file [%s].\n" ^^ fmt) file in
+  let toml =
+    match Toml.Parser.from_filename file with
+    | `Ok(table)     -> table
+    | `Error(msg, _) -> panic "%s." msg
+  in
+  let coq_root = ref None in
+  let theories = ref None in
+  let cpp_include = ref None in
+  let cpp_with_rc = ref None in
+  let no_build = ref None in
+  let handle_entry key value =
+    let open Toml.Types in
+    let section = Table.Key.to_string key in
+    match (section, value) with
+    | ("coq_root", TString(s)) -> coq_root := Some(s)
+    | ("no_build", TBool(b)  ) -> no_build := Some(b)
+    | ("coq"     , TTable(t) ) ->
+        let handle_entry key value =
+          let key = Table.Key.to_string key in
+          match (key, value) with
+          | ("extra_theories", TArray(NodeString(l))) -> theories := Some(l)
+          | ("extra_theories", TArray(NodeEmpty)    ) -> theories := Some([])
+          | ("extra_theories", _                    ) ->
+              panic "Key [%s] should contain an array of strings." key
+          | (_               , _                    ) ->
+              panic "Key [%s] is invalid in section [%s]." key section
+        in
+        Table.iter handle_entry t
+    | ("cpp"     , TTable(t) ) ->
+        let handle_entry key value =
+          let key = Table.Key.to_string key in
+          match (key, value) with
+          | ("include", TArray(NodeString(l))) -> cpp_include := Some(l)
+          | ("include", TArray(NodeEmpty)    ) -> cpp_include := Some([])
+          | ("include", _                    ) ->
+              panic "Key [%s] should contain an array of strings." key
+          | ("use_rc_include", TBool(b)      ) -> cpp_with_rc := Some(b)
+          | ("use_rc_include", _             ) ->
+              panic "Key [%s] should contain a boolean." key
+          | (_               , _             ) ->
+              panic "Key [%s] is invalid in section [%s]." key section
+        in
+        Table.iter handle_entry t
+    | ("coq_root", _         ) ->
+        panic "Key [%s] should contain a string" section
+    | ("no_build", _         ) ->
+        panic "Key [%s] should contain a boolean" section
+    | ("coq"     , _         ) ->
+        panic "Key [%s] should be a section." section
+    | ("cpp"     , _         ) ->
+        panic "Key [%s] should be a section." section
+    | (_         , _         ) ->
+        panic "Invalid section [%s]." section
+  in
+  Toml.Types.Table.iter handle_entry toml;
+  let project_coq_root =
+    try Coq_path.path_of_string "VST.typing" with Invalid_argument(msg) ->
+      panic "Ill-formed [coq_root] entry.\n%s" msg
+  in
+  let project_theories =
+    try List.map Coq_path.path_of_string (Option.get [] !theories)
+    with Invalid_argument(msg) ->
+      panic "Ill-formed entry in [coq.extra_theories].\n%s" msg
+  in
+  let project_cpp_include = Option.get [] !cpp_include in
+  let project_cpp_with_rc = Option.get true !cpp_with_rc in
+  let project_no_build = Option.get false !no_build in
+  { project_coq_root ; project_theories ; project_cpp_include
+  ; project_cpp_with_rc ; project_no_build }
+
+(** [write_project_file config fname] writes the configuration [config] to the
+    file [fname]. The function can raise [Sys_error] in case of a problem when
+    opening the file for writing. *)
+let write_project_file : string -> project_config -> unit = fun file pc ->
+  let open Toml.Types in
+  let coq_root = TString(Coq_path.to_string pc.project_coq_root) in
+  let theories =
+    TArray(NodeString(List.map Coq_path.to_string pc.project_theories))
+  in
+  let cpp_include = TArray(NodeString(pc.project_cpp_include)) in
+  let cpp_with_rc = TBool(pc.project_cpp_with_rc) in
+  let to_str v = Toml.Printer.string_of_value v in
+  write_file file [
+    "# Generated by [refinedc init].";
+    "";
+    "coq_root = " ^ to_str coq_root;
+    "";
+    "[cpp]";
+    "include = " ^ to_str cpp_include;
+    "use_rc_include = " ^ to_str cpp_with_rc;
+    "";
+    "[coq]";
+    "extra_theories = " ^ to_str theories;
+  ]
diff --git a/refinedVST/typing/frontend_stuff/frontend/rc_annot.ml b/refinedVST/typing/frontend_stuff/frontend/rc_annot.ml
new file mode 100644
index 0000000000..656ab29232
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/frontend/rc_annot.ml
@@ -0,0 +1,793 @@
+open Earley_core
+open Earley
+open Extra
+
+(** {3 Combinators and utilities} *)
+
+type 'a quot_elt =
+  | Quot_plain of string
+  | Quot_anti  of 'a
+
+type 'a quoted = 'a quot_elt list
+
+(** [well_bracketed c_op c_cl anti_gr] is a grammar accepting strings starting
+    with character [c_op], and ending with character [c_cl]. Moreover, strings
+    with non-well-bracketed occurences of characters [c_op] / [c_cl] and ['{']
+    / ['}'] are rejected. A sequence of the form ["!{text}"] is interpreted as
+    an antiquotation. Its contents (here, ["text"]) is parsed using [anti_gr],
+    an it should itself be well-bracketed in terms of ['{'] / ['}']. Note that
+    the produced semantic value is a list of elements that can be either plain
+    text (using the [Quot_plain(s)] constructor) or an anti-quotation (using a
+    [Quot_anti(e)] constructor). *)
+let well_bracketed : char -> char -> 'a grammar -> 'a quoted grammar =
+    fun c_op c_cl anti_gr ->
+  let fn buf pos =
+    let elts = ref [] in
+    let str = Buffer.create 20 in
+    let flush_plain () =
+      elts := (Quot_plain(Buffer.contents str)) :: !elts;
+      Buffer.clear str
+    in
+    let flush_anti () =
+      (*Printf.eprintf "PARSING ANTIQUOTATION\n%!";*)
+      let text = Buffer.contents str in
+      let anti =
+        let parse = Earley.parse_string anti_gr Blanks.default in
+        try parse text with Earley.Parse_error(_,_) ->
+          assert false (* FIXME fail correctly *)
+      in
+      elts := (Quot_anti(anti)) :: !elts;
+      Buffer.clear str
+    in
+    let rec loop state buf pos =
+      let (c, next_buf, next_pos) = Input.read buf pos in
+      (*
+      begin
+        Printf.eprintf "READING [%c] IN STATE " c;
+        match state with
+        | `Init(i)   -> Printf.eprintf "Init(%i)\n%!" i
+        | `Bang(i)   -> Printf.eprintf "Bang(%i)\n%!" i
+        | `Anti(k,i) -> Printf.eprintf "Anti(%i,%i)\n%!" k i
+      end;
+      *)
+      match (c, state) with
+      | ('\255', _       )               -> (* EOF, error. *)
+          Earley.give_up ()
+      | ('\\'  , _       )               -> (* Escape sequence. *)
+          let c = Input.get next_buf next_pos in
+          if not (List.mem c ['\255'; '"'; '\\']) then Earley.give_up ();
+          (* We only need to remove the [`\\`] here. *)
+          loop state next_buf next_pos;
+      | (_     , `Init(i)  ) when c = c_op -> (* Normal mode opening. *)
+          Buffer.add_char str c; loop (`Init(i+1)) next_buf next_pos
+      | (_     , `Init(1)  ) when c = c_cl -> (* Normal mode final closing. *)
+          flush_plain (); (next_buf, next_pos)
+      | (_     , `Init(i)  ) when c = c_cl -> (* Normal mode closing. *)
+          Buffer.add_char str c; loop (`Init(i-1)) next_buf next_pos
+      | ('!'   , `Init(i)  )               -> (* Potential antiquotation. *)
+          loop (`Bang(i)) next_buf next_pos
+      | ('{'   , `Bang(i)  )               -> (* Actual antiquotation. *)
+          flush_plain (); loop (`Anti(1,i)) next_buf next_pos
+      | (_     , `Bang(i)  )               -> (* No antiquot. after all. *)
+          Buffer.add_char str '!'; loop (`Init(i)) buf pos
+      | ('{'   , `Anti(k,i))               -> (* Antiquot. operning. *)
+          Buffer.add_char str c; loop (`Anti(k+1,i)) next_buf next_pos
+      | ('}'   , `Anti(1,i))               -> (* Antiquot. final closing. *)
+          flush_anti (); loop (`Init(i)) next_buf next_pos
+      | ('}'   , `Anti(k,i))               -> (* Antiquot. closing. *)
+          Buffer.add_char str '}'; loop (`Anti(k-1,i)) next_buf next_pos
+      | (_     , _         )               -> (* Normal character. *)
+          Buffer.add_char str c; loop state next_buf next_pos
+    in
+    let (buf, pos) = loop (`Init(1)) buf (pos + 1) in
+    (List.rev !elts, buf, pos)
+  in
+  let name = Printf.sprintf "<%cwell-bracketed%c>" c_op c_cl in
+  Earley.black_box fn (Charset.singleton c_op) false name
+
+(** {3 Annotations AST} *)
+
+type ident   = string
+type pattern = ident list
+
+type coq_term  = type_expr quoted
+
+and  iris_term = type_expr quoted
+
+and coq_expr =
+  | Coq_ident of string
+  | Coq_all   of coq_term
+
+and constr =
+  | Constr_Iris  of iris_term
+  | Constr_exist of string * coq_expr option * constr
+  | Constr_own   of string * ptr_kind * type_expr
+  | Constr_val   of string * type_expr
+  | Constr_Coq   of coq_expr
+  | Constr_glob  of string * type_expr
+
+and ptr_kind = Own | Shr | Frac of coq_expr
+
+and type_expr =
+  | Ty_refine of coq_expr * type_expr
+  | Ty_dots
+  | Ty_exists of pattern * coq_expr option * type_expr
+  | Ty_constr of type_expr * constr
+  | Ty_params of ident * type_expr_arg list
+  | Ty_Coq    of coq_expr
+
+and type_expr_arg =
+  | Ty_arg_expr   of type_expr
+  | Ty_arg_lambda of pattern * coq_expr option * type_expr_arg
+
+type annot_arg = int * int * coq_expr
+
+(** {3 Main grammar defintions} *)
+
+(** Identifier token (regexp ["[A-Za-z_]+"]). *)
+let base_ident : ident Earley.grammar =
+  let cs_first = Charset.from_string "A-Za-z_" in
+  let cs = Charset.from_string "A-Za-z_0-9" in
+  let fn buf pos =
+    let nb = ref 1 in
+    while Charset.mem cs (Input.get buf (pos + !nb)) do incr nb done;
+    (String.sub (Input.line buf) pos !nb, buf, pos + !nb)
+  in
+  Earley.black_box fn cs_first false "<ident>"
+
+let no_star =
+  let fn buf pos = ((), Input.get buf pos <> '*') in
+  Earley.test Charset.full fn
+
+let parser ident =
+  | id:base_ident no_star -> id
+  | "void*"               -> "void*"
+
+let parser ty_name =
+  | id:base_ident       -> id
+  | '&' - id:base_ident -> "&" ^ id
+
+(** Integer token (regexp ["[0-9]+"]). *)
+let integer : int Earley.grammar =
+  let cs = Charset.from_string "0-9" in
+  let fn buf pos =
+    let nb = ref 1 in
+    while Charset.mem cs (Input.get buf (pos + !nb)) do incr nb done;
+    (int_of_string (String.sub (Input.line buf) pos !nb), buf, pos + !nb)
+  in
+  Earley.black_box fn cs false "<integer>"
+
+let parser pattern =
+  | "(" ")"                         -> []
+  | x:ident                         -> [x]
+  | "(" x:ident xs:{"," ident}+ ")" -> x :: xs
+
+(** Arbitrary ("well-bracketed") string delimited by ['{'] and ['}']. *)
+let parser coq_term  = (well_bracketed '{' '}' (type_expr `Full))
+
+(** Arbitrary ("well-bracketed") string delimited by ['['] and [']']. *)
+and parser iris_term = (well_bracketed '[' ']' (type_expr `Full))
+
+and parser coq_expr =
+  | x:ident    -> Coq_ident(x)
+  | s:coq_term -> Coq_all(s)
+
+and parser constr =
+  | s:iris_term                                   -> Constr_Iris(s)
+  | "∃" x:ident a:{":" coq_expr}? "." c:constr    -> Constr_exist(x,a,c)
+  | c:coq_expr                                    -> Constr_Coq(c)
+  | "global" x:ident ':' ty:(type_expr `Full)     -> Constr_glob(x,ty)
+  | k:ptr_kind x:ident ':' ty:(type_expr `Full)   -> Constr_own(x, k ,ty)
+  | x:ident ':' ty:(type_expr `Full)              -> Constr_val(x, ty)
+
+and parser ptr_kind =
+  | "own"             -> Own
+  | "shr"             -> Shr
+  | "frac" e:coq_expr -> Frac(e)
+
+and parser typedef =
+  | "&own<" ty:(type_expr `Full) ">"                 -> (Own    , ty)
+  | "&shr<" ty:(type_expr `Full) ">"                 -> (Shr    , ty)
+  | "&frac<" e:coq_expr "," ty:(type_expr `Full) ">" -> (Frac(e), ty)
+
+and parser type_expr @(p : [`Atom | `Cstr | `Full]) =
+  | c:coq_expr ty:{"@" (type_expr `Atom)}?
+      when p >= `Atom ->
+        begin
+          match (c, ty) with
+          | (Coq_ident(x), None    ) -> Ty_params(x,[])
+          | (_           , None    ) -> Ty_Coq(c)
+          | (_           , Some(ty)) -> Ty_refine(c,ty)
+        end
+  | id:ty_name "<" tys:type_args ">"
+      when p >= `Atom -> Ty_params(id,tys)
+  | "..."
+      when p >= `Atom -> Ty_dots
+  | "∃" p:pattern a:{":" coq_expr}? "." ty:(type_expr `Full)
+      when p >= `Full -> Ty_exists(p,a,ty)
+  | ty:(type_expr `Cstr) "&" c:constr
+      when p >= `Cstr -> Ty_constr(ty,c)
+  | "(" ty:(type_expr `Full) ")"
+      when p >= `Atom -> ty
+
+and parser type_expr_arg =
+  | ty:(type_expr `Full)
+      -> Ty_arg_expr(ty)
+  | "λ" p:pattern a:{":" coq_expr}? "." tya:type_expr_arg
+      -> Ty_arg_lambda(p,a,tya)
+
+and parser type_args =
+  | EMPTY                                   -> []
+  | e:type_expr_arg es:{"," type_expr_arg}* -> e::es
+
+let type_expr = type_expr `Full
+
+(** {3 Entry points} *)
+
+(** {4 Annotations on type definitions} *)
+
+let parser annot_parameter : (ident * coq_expr) Earley.grammar =
+  | id:ident ":" s:coq_expr
+
+let parser annot_refine : (ident * coq_expr) Earley.grammar =
+  | id:ident ":" s:coq_expr
+
+let parser annot_typedef : (ident * type_expr) Earley.grammar =
+  | id:ident ":" ty:type_expr
+
+let parser annot_type : ident Earley.grammar =
+  | id:ident
+
+(** {4 Annotations on structs} *)
+
+let parser annot_size : coq_expr Earley.grammar =
+  | c:coq_expr
+
+let parser annot_exist : (ident * coq_expr) Earley.grammar =
+  | id:ident ":" s:coq_expr
+
+let parser annot_constr : constr Earley.grammar =
+  | c:constr
+
+let parser annot_let : (ident * coq_expr option * coq_expr) Earley.grammar =
+  | id:ident ty:{":" coq_expr}? "=" def:coq_expr
+
+let parser annot_unfold_order : int Earley.grammar =
+  | i:integer
+
+(** {4 Annotations on tagged unions} *)
+
+type tag_spec = string * (string * coq_expr) list
+
+let tagged_union : coq_expr Earley.grammar = coq_expr
+
+let parser union_tag : tag_spec Earley.grammar =
+  | c:ident l:{"(" ident ":" coq_expr ")"}*
+
+(** {4 Annotations on fields} *)
+
+let parser annot_field : type_expr Earley.grammar =
+  | ty:type_expr
+
+(** {4 Annotations on global variables} *)
+
+let parser annot_global : type_expr Earley.grammar =
+  | ty:type_expr
+
+(** {4 Annotations on functions} *)
+
+let parser annot_arg : type_expr Earley.grammar =
+  | ty:type_expr
+
+let parser annot_requires : constr Earley.grammar =
+  | c:constr
+
+let parser annot_returns : type_expr Earley.grammar =
+  | ty:type_expr
+
+let parser annot_ensures : constr Earley.grammar =
+  | c:constr
+
+let parser annot_args : annot_arg Earley.grammar =
+  | integer ":" integer coq_expr
+
+type manual_proof = string * string * string (* Load path, module, lemma. *)
+
+let parser annot_manual : manual_proof Earley.grammar =
+  | f:ident fs:{"." ident}* ":" file:ident "," thm:ident ->
+      (String.concat "." (f :: fs), file, thm)
+
+(** {4 Annotations on statement expressions (ExprS)} *)
+
+(*
+let parser annot : ... Earley.grammar =
+*)
+
+(** {4 Annotations on blocks} *)
+
+let parser annot_inv_var : (ident * type_expr) Earley.grammar =
+  | id:ident ":" ty:type_expr
+
+(** {4 Type definition (in comments)} *)
+
+let default_unfold_order : int = 100
+
+type typedef =
+  { td_id           : string
+  ; td_refinements  : (ident * coq_expr) list
+  ; td_parameters   : (ident * coq_expr) list
+  ; td_body         : type_expr
+  ; td_immovable    : bool
+  ; td_unfold_order : int
+  }
+
+let parser typedef_ref = ident ":" coq_expr
+
+let parser typedef_refs =
+  | EMPTY                                 -> []
+  | r:typedef_ref refs:{"," typedef_ref}* -> r :: refs
+
+let parser typedef_arg = ident ":" coq_expr
+
+let parser typedef_args =
+  | EMPTY                                   -> []
+  | arg:typedef_arg args:{"," typedef_arg}* -> arg :: args
+
+let parser typedef : typedef Earley.grammar =
+  | refs:{"(" typedef_refs ")" "@"}?[[]] id:ident args:{"<" typedef_args ">"}?[[]]
+      unfold_order:{"[" "unfold_order" "(" integer ")"  "]"}?
+      immovable:{"[" "immovable" "]"}?
+      ":=" ty:type_expr ->
+    { td_id = id
+    ; td_refinements = refs
+    ; td_parameters = args
+    ; td_body = ty
+    ; td_immovable = immovable <> None
+    ; td_unfold_order = Option.get default_unfold_order unfold_order }
+
+(** {3 Parsing of attributes} *)
+
+type annot =
+  | Annot_parameters   of (ident * coq_expr) list
+  | Annot_refined_by   of (ident * coq_expr) list
+  | Annot_typedef      of (ident * type_expr)
+  | Annot_size         of coq_expr
+  | Annot_exist        of (ident * coq_expr) list
+  | Annot_lets         of (ident * coq_expr option * coq_expr) list
+  | Annot_constraint   of constr list
+  | Annot_immovable
+  | Annot_tagged_union of coq_expr
+  | Annot_union_tag    of tag_spec
+  | Annot_field        of type_expr
+  | Annot_global       of type_expr
+  | Annot_args         of type_expr list
+  | Annot_requires     of constr list
+  | Annot_returns      of type_expr
+  | Annot_ensures      of constr list
+  | Annot_annot        of string
+  | Annot_assert
+  | Annot_inv_vars     of (ident * type_expr) list
+  | Annot_annot_args   of annot_arg list
+  | Annot_tactics      of string list
+  | Annot_trust_me
+  | Annot_skip
+  | Annot_manual       of manual_proof
+  | Annot_block
+  | Annot_full_block
+  | Annot_inlined
+  | Annot_unfold_order of int
+
+let annot_lemmas : string list -> string list =
+  List.map (Printf.sprintf "all: try by apply: %s; solve_goal.")
+
+let rc_locs : Location.Pool.t = Location.Pool.make ()
+
+exception Invalid_annot of Location.t * string
+
+let invalid_annot : type a. Location.t -> string -> a = fun loc msg ->
+  raise (Invalid_annot(loc, msg))
+
+let invalid_annot_no_pos : type a. string -> a = fun msg ->
+  invalid_annot (Location.none rc_locs) msg
+
+type rc_attr_arg =
+  { rc_attr_arg_value  : string Location.located
+  ; rc_attr_arg_pieces : string Location.located list }
+
+let loc_of_pos : rc_attr_arg -> int -> Location.t = fun arg pos ->
+  let open Location in
+  let rec find pos pieces =
+    match pieces with
+    | []          -> assert false
+    | p :: pieces ->
+        if pos < String.length p.elt then (pos, p.loc)
+        else find (pos - String.length p.elt) pieces
+  in
+  let (i, loc) = find pos arg.rc_attr_arg_pieces in
+  match Location.get loc with
+  | None    -> Location.none rc_locs
+  | Some(d) ->
+  let file = d.loc_file in
+  let line = d.loc_line1 in
+  let col = d.loc_col1 in
+  (* FIXME unicode offset. *)
+  Location.make file (line - 1) (col + i) (line - 1) (col + i) rc_locs
+
+type rc_attr =
+  { rc_attr_id   : string Location.located
+  ; rc_attr_args : rc_attr_arg list }
+
+let parse_attr : rc_attr -> annot = fun attr ->
+  let {rc_attr_id = id; rc_attr_args = args} = attr in
+  let error msg =
+    invalid_annot id.loc (Printf.sprintf "Annotation [%s] %s." id.elt msg)
+  in
+
+  let parse : type a.a grammar -> rc_attr_arg -> a = fun gr arg ->
+    let s = arg.rc_attr_arg_value in
+    let parse_string = Earley.parse_string gr Blanks.default in
+    try parse_string s.elt with Earley.Parse_error(buf,pos) ->
+      let loc = loc_of_pos arg pos in
+      invalid_annot loc "No parse in annotation."
+  in
+
+  let single_arg : type a.a grammar -> (a -> annot) -> annot = fun gr c ->
+    match args with
+    | [s] -> c (parse gr s)
+    | _   -> error "should have exactly one argument"
+  in
+
+  let many_args : type a.a grammar -> (a list -> annot) -> annot = fun gr c ->
+    match args with
+    | [] -> error "should have at least one argument"
+    | _  -> c (List.map (parse gr) args)
+  in
+
+  let raw_single_arg : (string -> annot) -> annot = fun c ->
+    match args with
+    | [a] -> c a.rc_attr_arg_value.elt
+    | _   -> error "should have exactly one argument"
+  in
+
+  let raw_many_args : (string list -> annot) -> annot = fun c ->
+    match args with
+    | [] -> error "should have at least one argument"
+    | _  -> c (List.map (fun a -> Location.(a.rc_attr_arg_value.elt)) args)
+  in
+
+  let no_args : annot -> annot = fun c ->
+    match args with
+    | [] -> c
+    | _  -> error "should not have arguments"
+  in
+
+  match id.elt with
+  | "parameters"   -> many_args annot_parameter (fun l -> Annot_parameters(l))
+  | "refined_by"   -> many_args annot_refine (fun l -> Annot_refined_by(l))
+  | "typedef"      -> single_arg annot_typedef (fun e -> Annot_typedef(e))
+  | "size"         -> single_arg annot_size (fun e -> Annot_size(e))
+  | "exists"       -> many_args annot_exist (fun l -> Annot_exist(l))
+  | "let"          -> many_args annot_let (fun l -> Annot_lets(l))
+  | "constraints"  -> many_args annot_constr (fun l -> Annot_constraint(l))
+  | "immovable"    -> no_args Annot_immovable
+  | "tagged_union" -> single_arg tagged_union (fun e -> Annot_tagged_union(e))
+  | "union_tag"    -> single_arg union_tag (fun t -> Annot_union_tag(t))
+  | "field"        -> single_arg annot_field (fun e -> Annot_field(e))
+  | "global"       -> single_arg annot_global (fun e -> Annot_global(e))
+  | "args"         -> many_args annot_arg (fun l -> Annot_args(l))
+  | "requires"     -> many_args annot_requires (fun l -> Annot_requires(l))
+  | "returns"      -> single_arg annot_returns (fun e -> Annot_returns(e))
+  | "ensures"      -> many_args annot_ensures (fun l -> Annot_ensures(l))
+  | "annot"        -> raw_single_arg (fun e -> Annot_annot(e))
+  | "asrt"         -> no_args Annot_assert
+  | "inv_vars"     -> many_args annot_inv_var (fun l -> Annot_inv_vars(l))
+  | "annot_args"   -> many_args annot_args (fun l -> Annot_annot_args(l))
+  | "tactics"      -> raw_many_args (fun l -> Annot_tactics(l))
+  | "lemmas"       -> raw_many_args (fun l -> Annot_tactics(annot_lemmas l))
+  | "trust_me"     -> no_args Annot_trust_me
+  | "skip"         -> no_args Annot_skip
+  | "manual_proof" -> single_arg annot_manual (fun e -> Annot_manual(e))
+  | "block"        -> no_args Annot_block
+  | "full_block"   -> no_args Annot_full_block
+  | "inlined"      -> no_args Annot_inlined
+  | "unfold_order" -> single_arg annot_unfold_order (fun i -> Annot_unfold_order(i))
+  | _              -> error "undefined"
+
+(** {3 High level parsing of attributes} *)
+
+type proof_kind =
+  | Proof_normal
+  | Proof_skipped (* Not even a spec is generated. *)
+  | Proof_trusted
+  | Proof_manual of manual_proof
+  | Proof_inlined
+
+type function_annot =
+  { fa_parameters : (ident * coq_expr) list
+  ; fa_args       : type_expr list
+  ; fa_returns    : type_expr
+  ; fa_exists     : (ident * coq_expr) list
+  ; fa_requires   : constr list
+  ; fa_ensures    : constr list
+  ; fa_tactics    : string list
+  ; fa_proof_kind : proof_kind }
+
+let function_annot : rc_attr list -> function_annot = fun attrs ->
+  let parameters = ref [] in
+  let args = ref [] in
+  let exists = ref [] in
+  let returns = ref None in
+  let requires = ref [] in
+  let ensures = ref [] in
+  let tactics = ref [] in
+  let proof = ref Proof_normal in
+  let inlined = ref false in
+
+  let nb_attrs = ref 0 in
+  let handle_attr ({rc_attr_id = id; _} as attr) =
+    let error msg =
+      invalid_annot id.loc (Printf.sprintf "Annotation [%s] %s." id.elt msg)
+    in
+    if !inlined then error "should be the only attribute";
+    incr nb_attrs;
+    match (parse_attr attr, !returns) with
+    | (_                  , _   ) when !proof = Proof_skipped ->
+        error "a skipped function should not have other annotations";
+    | (Annot_skip         , _   ) ->
+        if !proof <> Proof_normal then error "proof mode already specified";
+        if !nb_attrs <> 1 then error "other annotations are given";
+        proof := Proof_skipped
+    | (Annot_trust_me     , _   ) ->
+        if !proof <> Proof_normal then error "proof mode already specified";
+        proof := Proof_trusted
+    | (Annot_manual(cfg)  , _   ) ->
+        if !proof <> Proof_normal then error "proof mode already specified";
+        proof := Proof_manual(cfg)
+    | (Annot_parameters(l), _   ) -> parameters := !parameters @ l
+    | (Annot_args(l)      , _   ) -> args := !args @ l
+    | (Annot_returns(ty)  , None) -> returns := Some(ty)
+    | (Annot_returns(_)   , _   ) -> error "already specified"
+    | (Annot_requires(l)  , _   ) -> requires := !requires @ l
+    | (Annot_ensures(l)   , _   ) -> ensures := !ensures @ l
+    | (Annot_exist(l)     , _   ) -> exists := !exists @ l
+    | (Annot_annot_args(_), _   ) -> () (* Handled separately. *)
+    | (Annot_tactics(l)   , _   ) -> tactics := !tactics @ l
+    | (Annot_inlined      , _   ) ->
+        if !nb_attrs <> 1 then error "should be the only attribute";
+        proof := Proof_inlined;
+        inlined := true
+    | (_                  , _   ) -> error "is invalid for a function"
+  in
+  List.iter handle_attr attrs;
+
+  (* When no annotations are given, the function is skipped. *)
+  if !nb_attrs = 0 then proof := Proof_skipped;
+
+  { fa_parameters = !parameters
+  ; fa_args       = !args
+  ; fa_returns    = Option.get (Ty_params("void", [])) !returns
+  ; fa_exists     = !exists
+  ; fa_requires   = !requires
+  ; fa_ensures    = !ensures
+  ; fa_tactics    = !tactics
+  ; fa_proof_kind = !proof }
+
+let function_annot_args : rc_attr list -> annot_arg list = fun attrs ->
+  let annot_args = ref [] in
+
+  let handle_attr ({rc_attr_id = id; _} as attr) =
+    if id.elt <> "annot_args" then () else
+    match parse_attr attr with
+    | Annot_annot_args(l) -> annot_args := !annot_args @ l
+    | _                   -> assert false (* Unreachable. *)
+  in
+  List.iter handle_attr attrs;
+
+  !annot_args
+
+type member_annot =
+  | MA_none
+  | MA_field of type_expr
+  | MA_utag  of tag_spec
+
+let member_annot : rc_attr list -> member_annot = fun attrs ->
+  let annot = ref MA_none in
+
+  let handle_attr ({rc_attr_id = id; _} as attr) =
+    let error msg =
+      invalid_annot id.loc (Printf.sprintf "Annotation [%s] %s." id.elt msg)
+    in
+    match (parse_attr attr, !annot) with
+    | (Annot_field(ty)   , MA_none) -> annot := MA_field(ty)
+    | (Annot_field(_)    , _      ) -> error "already specified"
+    | (Annot_union_tag(s), MA_none) -> annot := MA_utag(s)
+    | (Annot_union_tag(_), _      ) -> error "already specified"
+    | (_                 , _      ) -> error "is invalid for a field"
+  in
+  List.iter handle_attr attrs; !annot
+
+type basic_struct_annot =
+  { st_parameters   : (ident * coq_expr) list
+  ; st_refined_by   : (ident * coq_expr) list
+  ; st_exists       : (ident * coq_expr) list
+  ; st_lets         : (ident * coq_expr option * coq_expr) list
+  ; st_constrs      : constr list
+  ; st_size         : coq_expr option
+  ; st_typedef      : (ident * type_expr) option
+  ; st_immovable    : bool
+  ; st_unfold_order : int }
+
+let default_basic_struct_annot : basic_struct_annot =
+  { st_parameters   = []
+  ; st_refined_by   = []
+  ; st_exists       = []
+  ; st_lets         = []
+  ; st_constrs      = []
+  ; st_size         = None
+  ; st_typedef      = None
+  ; st_immovable    = false
+  ; st_unfold_order = default_unfold_order }
+
+(* Decides whether the annotation on the structure should lead to the
+   definition of a RefinedC type. *)
+let basic_struct_annot_defines_type : basic_struct_annot -> bool = fun annot ->
+  annot.st_refined_by <> [] || annot.st_typedef <> None
+
+type struct_annot =
+  | SA_union
+  | SA_basic    of basic_struct_annot
+  | SA_tagged_u of coq_expr
+
+let struct_annot : rc_attr list -> struct_annot = fun attrs ->
+  let parameters = ref [] in
+  let refined_by = ref [] in
+  let exists = ref [] in
+  let lets = ref [] in
+  let constrs = ref [] in
+  let size = ref None in
+  let ptr = ref None in
+  let immovable = ref false in
+  let tagged_union = ref None in
+  let unfold_order = ref None in
+
+  let handle_attr ({rc_attr_id = id; _} as attr) =
+    let error msg =
+      invalid_annot id.loc (Printf.sprintf "Annotation [%s] %s." id.elt msg)
+    in
+    let check_and_set r v =
+      if !r <> None then error "already specified";
+      r := Some(v)
+    in
+    match (parse_attr attr, !tagged_union) with
+    (* Tagged union stuff. *)
+    | (Annot_tagged_union(e), None   ) -> tagged_union := Some(e)
+    | (Annot_tagged_union(e), Some(_)) -> error "already specified"
+    (* Normal struct stuff. *)
+    | (Annot_parameters(l)  , None   ) -> parameters := !parameters @ l
+    | (Annot_refined_by(l)  , None   ) -> refined_by := !refined_by @ l
+    | (Annot_exist(l)       , None   ) -> exists := !exists @ l
+    | (Annot_lets(l)        , None   ) -> lets := !lets @ l
+    | (Annot_constraint(l)  , None   ) -> constrs := !constrs @ l
+    | (Annot_size(s)        , None   ) -> check_and_set size s
+    | (Annot_typedef(e)     , None   ) -> check_and_set ptr e
+    | (Annot_immovable      , None   ) ->
+        if !immovable then error "already specified";
+        immovable := true
+    | (Annot_unfold_order(i), None   ) ->
+         begin
+           match !unfold_order with
+           | Some _ ->  error "already specified"
+           | None -> unfold_order := Some(i)
+         end
+    | (Annot_parameters(_)  , _      )
+    | (Annot_refined_by(_)  , _      )
+    | (Annot_exist(_)       , _      )
+    | (Annot_constraint(_)  , _      )
+    | (Annot_size(_)        , _      )
+    | (Annot_typedef(_)     , _      )
+    | (Annot_immovable      , _      ) ->
+        error "is invalid for tagged unions"
+    | (_                    , _      ) ->
+        error "is invalid for a struct or a tagged union"
+  in
+  List.iter handle_attr attrs;
+
+  match !tagged_union with
+  | Some(e) -> SA_tagged_u(e)
+  | None    ->
+  let basic_annot =
+    { st_parameters   = !parameters
+    ; st_refined_by   = !refined_by
+    ; st_exists       = !exists
+    ; st_lets         = !lets
+    ; st_constrs      = !constrs
+    ; st_size         = !size
+    ; st_typedef      = !ptr
+    ; st_immovable    = !immovable
+    ; st_unfold_order = Option.get default_unfold_order !unfold_order }
+  in
+  SA_basic(basic_annot)
+
+type state_descr =
+  { sd_exists   : (ident * coq_expr) list
+  ; sd_constrs  : constr list
+  ; sd_inv_vars : (ident * type_expr) list }
+
+let loop_annot : rc_attr list -> bool option * state_descr = fun attrs ->
+  let exists = ref [] in
+  let constrs = ref [] in
+  let vars = ref [] in
+  let full_block = ref None in
+
+  let handle_attr ({rc_attr_id = id; _} as attr) =
+    let error msg =
+      invalid_annot id.loc (Printf.sprintf "Annotation [%s] %s." id.elt msg)
+    in
+    let set_full_block b =
+      match !full_block with
+      | Some(_) -> error "mode already specified"
+      | None    -> full_block := Some(b)
+    in
+    match parse_attr attr with
+    | Annot_exist(l)      -> exists := !exists @ l
+    | Annot_constraint(l) -> constrs := !constrs @ l
+    | Annot_inv_vars(l)   -> vars := !vars @ l
+    | Annot_block         -> set_full_block false
+    | Annot_full_block    -> set_full_block true
+    | _                   -> error "is invalid (wrong kind)"
+  in
+  List.iter handle_attr attrs;
+
+  (!full_block, {sd_exists = !exists; sd_constrs = !constrs; sd_inv_vars = !vars})
+
+type raw_expr_annot =
+  | RawExprAnnot_annot  of string
+  | RawExprAnnot_assert of state_descr
+
+let raw_expr_annot : rc_attr list -> raw_expr_annot option = fun attrs ->
+  let error msg =
+    invalid_annot_no_pos (Printf.sprintf "Expression annotation %s." msg)
+  in
+  match attrs with
+  | []      -> None
+  | [attr]  -> begin
+     match parse_attr attr with
+     | Annot_annot(s) -> Some(RawExprAnnot_annot s)
+     | _              -> error "is invalid (wrong kind)"
+    end
+  | _       ->
+     let filtered_attrs = List.filter (fun attr -> parse_attr attr <> Annot_assert) attrs in
+     if List.length attrs = List.length filtered_attrs then
+       (* if this is not an assert_annotation, only one attribute is allowed *)
+       error "carries more than one attribute"
+     else
+       let (full, sd) = loop_annot filtered_attrs in
+       if full <> None then
+         error "has block annotation"
+       else
+         Some (RawExprAnnot_assert(sd))
+
+
+type global_annot =
+  { ga_parameters : (ident * coq_expr) list
+  ; ga_type       : type_expr }
+
+let global_annot : rc_attr list -> global_annot option = fun attrs ->
+  let typ = ref None in
+  let parameters = ref [] in
+
+  let handle_attr ({rc_attr_id = id; _} as attr) =
+    let error msg =
+      invalid_annot id.loc (Printf.sprintf "Annotation [%s] %s." id.elt msg)
+    in
+    match (parse_attr attr, !typ) with
+    | (Annot_global(e)    , None) -> typ := Some e
+    | (Annot_parameters(l), _   ) -> parameters := !parameters @ l
+    | (Annot_global(_)    , _   ) -> error "already specified"
+    | (_                  , _   ) -> error "is invalid for a global"
+  in
+  List.iter handle_attr attrs;
+
+  match !typ with
+  | Some(ty) -> Some {ga_parameters = !parameters; ga_type = ty}
+  | None -> None
diff --git a/refinedVST/typing/frontend_stuff/frontend/stubs.c b/refinedVST/typing/frontend_stuff/frontend/stubs.c
new file mode 100644
index 0000000000..0eb73fb4aa
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/frontend/stubs.c
@@ -0,0 +1,44 @@
+#include <limits.h>
+#include <stdlib.h>
+#include <errno.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+
+CAMLprim value c_realpath(value v) {
+  // Conversion of the argument to a C value, and performing the C call.
+  const char *input_path = String_val(v);
+  char *output_path = realpath(input_path, NULL);
+
+  // Checking for error.
+  if (output_path == NULL){
+    switch(errno){
+      case EACCES:
+        caml_invalid_argument("Extra.Filename.realpath (EACCESS)\0");
+      case EINVAL:
+        caml_invalid_argument("Extra.Filename.realpath (EINVAL)\0");
+      case EIO:
+        caml_invalid_argument("Extra.Filename.realpath (EIO)\0");
+      case ELOOP:
+        caml_invalid_argument("Extra.Filename.realpath (ELOOP)\0");
+      case ENAMETOOLONG:
+        caml_invalid_argument("Extra.Filename.realpath (ENAMETOOLONG)\0");
+      case ENOENT:
+        caml_invalid_argument("Extra.Filename.realpath (ENOENT)\0");
+      case ENOMEM:
+        caml_invalid_argument("Extra.Filename.realpath (ENOMEM)\0");
+      case ENOTDIR:
+        caml_invalid_argument("Extra.Filename.realpath (ENOTDIR)\0");
+      default:
+        // Should not be reachable.
+        caml_invalid_argument("Extra.Filename.realpath (unknown)\0");
+    }
+  }
+
+  // Preparing the result value.
+  value res = caml_copy_string(output_path);
+
+  // Free the memory allocated by [realpath] before returning.
+  free(output_path);
+  return res;
+}
diff --git a/refinedVST/typing/frontend_stuff/frontend/tools/gen_version.ml b/refinedVST/typing/frontend_stuff/frontend/tools/gen_version.ml
new file mode 100644
index 0000000000..7c466be5cd
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/frontend/tools/gen_version.ml
@@ -0,0 +1,20 @@
+let version =
+  (* Trick to check whether the watermark has been substituted. *)
+  if "%%VERSION%%" <> "%%" ^ "VERSION%%" then "%%VERSION%%" else
+  (* If not, we fallback to git version. *)
+  let cmd = "git describe --dirty --always" in 
+  let (oc, ic, ec) = Unix.open_process_full cmd (Unix.environment ()) in
+  let version =
+    try Printf.sprintf "dev-%s" (input_line oc)
+    with End_of_file -> "unknown"
+  in
+  match Unix.close_process_full (oc, ic, ec) with
+  | Unix.WEXITED(0) -> version
+  | _               -> "unknown"
+
+let _ =
+  let line fmt = Printf.printf (fmt ^^ "\n%!") in
+  line "(** Version informations. *)";
+  line "";
+  line "(** [version] gives a version description. *)";
+  line "let version : string = \"%s\"" version
diff --git a/refinedVST/typing/frontend_stuff/frontend/warn.ml b/refinedVST/typing/frontend_stuff/frontend/warn.ml
new file mode 100644
index 0000000000..46fed2fb66
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/frontend/warn.ml
@@ -0,0 +1,833 @@
+open Cerb_frontend
+open AilSyntax
+
+module Scopes = struct
+  module C2A_eff = Cabs_to_ail_effect
+  type scope = C2A_eff.scope
+
+  let scopeEqual =
+    C2A_eff.scopeEqual
+
+  let string_of_scope =
+    C2A_eff.string_of_scope
+
+  type table = (scope, Symbol.sym, unit) Scope_table.t3
+
+  let dict: Symbol.sym Lem_pervasives.mapKeyType_class = {
+    mapKeyCompare_method=  Symbol.instance_Basic_classes_Ord_Symbol_sym_dict.compare_method
+  }
+
+  let empty: table =
+    []
+
+  let register sym (tbl: table) =
+    Scope_table.register dict sym () tbl
+
+  let create_scope scope (tbl: table) =
+    Scope_table.create_scope dict scope tbl
+
+  let resolve sym (tbl: table) =
+    Scope_table.resolve dict sym tbl
+
+  let current_scope_is tbl =
+    Scope_table.current_scope_is tbl
+end
+
+
+
+
+type env = {
+  counter: int;
+  block_depth: int;
+  scopes: (Cabs_to_ail_effect.scope, Symbol.sym, unit) Scope_table.t3;
+}
+
+
+let eq_sym sym1 sym2 =
+  Symbol.instance_Basic_classes_Eq_Symbol_sym_dict.isEqual_method sym1 sym2
+
+let show_sym sym =
+  Pp_utils.to_plain_string (Pp_ail.pp_id sym)
+
+
+type pointsto =
+  | Current of ail_identifier
+  | Local of Cabs_to_ail_effect.scope * ail_identifier
+  | Funptr of ail_identifier
+  | Global of ail_identifier
+  | Wild
+  | PTRVAL of pointsto
+
+
+(* TODO: debug *)
+let foo z =
+  Lem_show.stringFromList begin
+    let rec aux = function
+      | Global sym ->
+          "global: " ^ show_sym sym
+      | Funptr sym ->
+          "funptr: " ^ show_sym sym
+      | Current sym ->
+          "current: " ^ show_sym sym
+      | Local (scope, sym) ->
+          "local(scope: " ^ Scopes.string_of_scope scope ^ "): " ^ show_sym sym
+      | Wild ->
+          "wild"
+      | PTRVAL pt ->
+          "PTRVAL[" ^ aux pt ^ "]" in
+    aux
+  end z
+
+let rec strip_PTRVAL = function
+  | PTRVAL z ->
+      strip_PTRVAL z
+  | z ->
+      z
+
+(* returns [[true]] iff pt1 extends (strictly) further than pt2 *)
+let gt_pointsto (pt1: pointsto) (pt2: pointsto) =
+  let open Cabs_to_ail_effect in
+  (* removing the PTRVAL, we know we are dealing with an rvalue *)
+  let pt2 = strip_PTRVAL pt2 in
+  match pt1, pt2 with
+  | Current _, _ ->
+      false
+  | Local (Scope_block n1, _), Local (Scope_block n2, _) ->
+      n1 < n2
+  | Local _, Local _ ->
+      (* TODO: remove the scopes and only have block id *)
+      assert false
+  | Funptr _, _
+  | _, Funptr _ ->
+      (* TODO: this doesn't match the spec, but does correspond to no escape *)
+      false
+  | Global _, (Current _ | Local _) ->
+      true
+  | Local _, Current _ ->
+      true
+  | _, Wild ->
+      false
+  | Wild, _ ->
+      true
+  | _ ->
+      false
+
+
+let classify sigm env sym =
+  match List.assoc_opt sym sigm.declarations with
+    | Some (_, _, Decl_object _) ->
+        Global sym
+    | Some (_, _, Decl_function _) ->
+        Funptr sym
+    | None ->
+        begin match Scopes.resolve sym env.scopes with
+          | None ->
+              assert false
+          | Some (scope, ()) ->
+              if Scopes.(scopeEqual scope (current_scope_is env.scopes)) then
+                Current sym
+              else
+                Local (scope, sym)
+        end
+
+
+let get_ctype (AnnotatedExpression(gtc,_,_,_)) : Ctype.ctype =
+  (* TODO: these are taken from ail_to_coq.ml (should we just export them in the .mli ?) *)
+  let c_type_of_type_cat = function
+    | GenTypes.LValueType(_,c_ty,_) -> c_ty
+    | GenTypes.RValueType(c_ty)     -> c_ty in
+  let to_type_cat tc =
+    let loc = Cerb_location.unknown in
+    let impl = Ocaml_implementation.hafniumIntImpl in
+    let m_tc = GenTypesAux.interpret_genTypeCategory loc impl tc in
+    match ErrorMonad.runErrorMonad m_tc with
+      | Either.Right(tc) -> tc
+      | Either.Left(_,_) -> assert false (* FIXME possible here? *) in
+  c_type_of_type_cat (to_type_cat gtc)
+
+
+let ptr_taints : ((ail_identifier * pointsto list) list) ref =
+  ref []
+
+
+let get_ptr_taints xs =
+  List.fold_left (fun acc pt ->
+    match pt with
+    | Current sym
+    | Local (_, sym)
+    | Global sym ->
+        begin match List.assoc_opt sym !ptr_taints with
+          | Some z ->
+              z
+          | None ->
+              [ Wild ]
+        end
+    | Funptr _
+    | Wild ->
+        acc
+    | PTRVAL _ ->
+        acc (* TODO: assignment to an lvalue resulting from a deref already gives
+               a warning, so we can ignore this case here *)
+  ) [] xs
+
+let points_to classify expr =
+  let is_lvalue =
+    match expr with
+      | AnnotatedExpression (GenTypes.GenLValueType _, _, _, _) ->
+          true
+      | AnnotatedExpression (GenTypes.GenRValueType _, _, _, _) ->
+          false in
+
+  let rec aux (AnnotatedExpression (_, _, loc, expr_)) =
+    match expr_ with
+      | AilEbuiltin _
+      | AilEstr _
+      | AilEconst _
+      | AilEsizeof _
+      | AilEalignof _
+      | AilEreg_load _
+      | AilEsizeof_expr _
+      | AilEoffsetof _
+      | AilEassert _ ->
+          []
+      | AilEident sym ->
+          [classify sym]
+      | AilEunary (Address, e) ->
+          List.map (fun z -> PTRVAL z) (aux e)
+
+      | AilEunary (Indirection, e) ->
+          let pts = aux e in
+          let pts_deref =
+            List.fold_left (fun acc pt ->
+              match pt with
+                | PTRVAL pt' ->
+                    pt' :: acc
+                | _ ->
+                    acc
+              ) [] pts in
+          begin match AilTypesAux.referenced_type (get_ctype e) with
+            | Some ref_ty when AilTypesAux.is_pointer ref_ty ->
+                if pts <> [] && List.for_all (function PTRVAL _ -> true | _ -> false) pts then
+                  (* the lvalue can only point to a known object, so we can stay precise *)
+                  get_ptr_taints pts_deref
+                else
+                  [ Wild ]
+            | _ ->
+                if is_lvalue then
+                  if pts <> [] && List.for_all (function PTRVAL _ -> true | _ -> false) pts then
+                    (* the lvalue can only point to a known object, so we can stay precise *)
+                    pts_deref
+                  else
+                    [ Wild ]
+                else
+                  pts_deref
+          end
+      | AilEunary (_, e) ->
+          aux e
+      | AilEcast (_, _, e) ->
+          aux e
+      | AilEcompound (_, _, e) ->
+          []
+      | AilEmemberof (e, _) ->
+          aux e
+      | AilEmemberofptr (e, _) ->
+          aux e
+      | AilEannot (_, e) ->
+          aux e
+
+      | AilEva_start _
+      | AilEva_arg _
+      | AilEva_end _
+      | AilEva_copy _ ->
+          []
+
+      | AilEprint_type e
+      | AilEbmc_assume e ->
+          aux e
+
+      | AilErvalue e ->
+          if AilTypesAux.is_pointer (get_ctype e) then
+            (* if we read the value of a pointer, this can point to anything that has
+               been stored on that pointer *)
+            get_ptr_taints (aux e)
+          else
+            []
+      | AilEarray_decay e ->
+          []
+      | AilEfunction_decay e ->
+          []
+      | AilEbinary (e1, _, e2) ->
+          aux e1 @ aux e2
+      | AilEassign (e1, e2) ->
+          aux e2
+      | AilEcompoundAssign (e1, _, e2) ->
+          aux e2
+      | AilEcond (_, None, e3) ->
+          aux e3
+      | AilEcond (_, Some e2, e3) ->
+          aux e2 @ aux e3
+
+      | AilEcall (e, es) ->
+          []
+
+      | AilEgeneric (e ,gas) ->
+          []
+      | AilEarray (_, _, xs) ->
+          []
+      | AilEstruct (_, xs) ->
+          []
+      | AilEunion (_, _, e_opt) ->
+          []
+      | AilEatomic e ->
+          aux e
+      | AilEgcc_statement _ ->
+          Panic.panic loc "Not implemented GCC statement expr." (* TODO *)
+  in
+  aux expr
+
+
+(* ************************************************************************** *)
+(* Warning for unsequenced function calls *)
+
+type unseq_status =
+    (* HACK: empty list is for the occurence of at least one wild call *)
+  | HAS_CALLS of ail_identifier list
+  | NO_CALL
+
+let merge_status xs =
+  let rec aux acc = function
+    | [] ->
+        if acc = [] then
+          NO_CALL
+        else
+          HAS_CALLS acc
+    | NO_CALL :: xs ->
+        aux acc xs
+    | HAS_CALLS calls :: xs ->
+        aux (calls @ acc) xs
+  in aux [] xs
+
+
+let is_unseq = function
+  | Comma | And | Or ->
+      false
+  | Arithmetic _
+  | Lt | Gt | Le | Ge | Eq | Ne ->
+      true
+
+let merge_pointsto xss =
+(*
+  let eq pt1 pt2 =
+    match pt1, pt2 with
+      | `Current sym1, `Current sym2
+      | `Local (_, sym1), `Local (_, sym2)
+      | `Funptr sym1, `Funptr sym2
+      | `Global sym1, `Global sym2 ->
+          eq_sym sym1 sym2
+      | `Wild, `Wild ->
+          true
+      | _ ->
+          false in
+  List.fold_left (fun acc pts ->
+    let pts' =
+      List.filter (fun pt -> not (List.exists (fun z -> eq pt z) acc)) pts in
+      pts' @ acc
+  ) [] xss
+*)
+  List.concat xss
+
+
+type taint =
+  [ `LOAD of pointsto | `STORE of pointsto | `CALL_WILD | `CALL of ail_identifier ]
+
+
+let potential_races : ((Cerb_location.t * taint list * taint list) list) ref =
+  ref []
+
+
+let rec taint_expr points_to (AnnotatedExpression (_, _, loc, expr_)) =
+  let self = taint_expr points_to in
+  match expr_ with
+    | AilErvalue e ->
+        List.map (fun z -> `LOAD z) (points_to e)
+
+    | AilEoffsetof _
+    | AilEbuiltin _
+    | AilEstr _
+    | AilEconst _
+    | AilEident _
+    | AilEsizeof _
+    | AilEalignof _
+    | AilEreg_load _
+    | AilEunion (_, _, None) ->
+        []
+
+    | AilEunary (_, e)
+    | AilEcast (_, _, e)
+    | AilEassert e
+    | AilEcompound (_, _, e)
+    | AilEmemberof (e, _)
+    | AilEmemberofptr (e, _)
+    | AilEsizeof_expr e
+    | AilEannot (_, e)
+    | AilEva_start (e, _)
+    | AilEva_arg (e, _)
+    | AilEva_end e
+    | AilEprint_type e
+    | AilEbmc_assume e
+    | AilEarray_decay e
+    | AilEfunction_decay e
+    | AilEunion (_, _, Some e)
+    | AilEatomic e ->
+        self e
+
+    | AilEbinary (e1, _, e2) ->
+        begin match self e1, self e2 with
+          | [], xs
+          | xs, [] ->
+              xs
+          | xs1, xs2 ->
+              potential_races := (loc, xs1, xs2) :: !potential_races;
+              merge_pointsto [xs1; xs2]
+        end
+
+    | AilEassign (e1, e2)
+    | AilEcompoundAssign (e1, _, e2) ->
+        merge_pointsto [List.map (fun z -> `STORE z) (points_to e1); self e1; self e2]
+
+    | AilEcond (e1, None, e3) ->
+          merge_pointsto [self e1; self e3]
+    | AilEcond (e1, Some e2, e3) ->
+          merge_pointsto [self e1; self e2; self e3]
+    | AilEcall (e, es) ->
+        begin match e with
+          | AnnotatedExpression (_, _, _, AilEfunction_decay (AnnotatedExpression (_, _, _, AilEident f))) ->
+              `CALL f
+          | _ ->
+              `CALL_WILD
+        end :: merge_pointsto (List.map self es)
+    | AilEgeneric (e, gas) ->
+        merge_pointsto begin
+          self e ::
+          List.map (function
+            | AilGAtype (_, e)
+            | AilGAdefault e ->
+                self e) gas
+        end
+    | AilEarray (_, _, xs) ->
+        merge_pointsto (List.map (function Some e -> self e | None -> []) xs)
+    | AilEstruct (_, xs) ->
+       merge_pointsto (List.map (function (_, Some e) -> self e | (_, None) -> []) xs)
+    | AilEva_copy (e1, e2) ->
+        merge_pointsto [self e1; self e2]
+    | AilEgcc_statement _ ->
+        Panic.panic loc "Not implemented GCC statement expr." (* TODO *)
+
+let taints_of_functions sigm =
+  List.fold_left (fun acc (sym_decl, (_, _, decl)) ->
+    match decl with
+      | Decl_object _ ->
+          acc
+      | Decl_function _ ->
+          begin match List.assoc_opt sym_decl sigm.function_definitions with
+            | None ->
+                (* no definition for this function, assuming wild taint *)
+                (sym_decl, [`STORE Wild]) :: acc
+            | Some (_, _, _, params, stmt) ->
+                let fun_scopes =
+                  List.fold_left (fun acc sym ->
+                    Scopes.register sym acc
+                ) (Scopes.(create_scope (Cabs_to_ail_effect.Scope_block 0) empty)) params in
+                let rec fold_stmt env (AnnotatedStatement (_, _, stmt_)) =
+                  let taint_expr e = taint_expr (points_to (classify sigm env)) e in
+                  match stmt_ with
+                    | AilSskip
+                    | AilSbreak
+                    | AilScontinue
+                    | AilSreturnVoid
+                    | AilSgoto _ ->
+                        [] (* points to nothing *)
+                    | AilSexpr e
+                    | AilSreturn e
+                    | AilSreg_store (_, e) ->
+                        taint_expr e
+                    | AilSblock (bs, ss) ->
+                        let new_scopes =
+                          List.fold_left (fun acc (sym, _) ->
+                            Scopes.register sym acc
+                          ) (Scopes.create_scope (Cabs_to_ail_effect.Scope_block env.counter) env.scopes) bs in
+                        let env' = {
+                          counter= env.counter + 1;
+                          block_depth= env.block_depth + 1;
+                          scopes = new_scopes;
+                        } in
+                        merge_pointsto (List.map (fold_stmt env') ss)
+                    | AilSif (e, s1, s2) ->
+                        merge_pointsto [taint_expr e; fold_stmt env s1; fold_stmt env s2]
+                    | AilSwhile (e, s, _)
+                    | AilSdo (s, e, _)
+                    | AilSswitch (e, s) ->
+                        merge_pointsto [taint_expr e; fold_stmt env s]
+                    | AilScase (_, s)
+                    | AilScase_rangeGNU (_, _, s)
+                    | AilSdefault s
+                    | AilSlabel (_, s, _) ->
+                        fold_stmt env s
+                    | AilSdeclaration xs ->
+                        merge_pointsto (List.filter_map (fun (_, e_opt) -> Option.map taint_expr e_opt) xs)
+                    | AilSpar ss ->
+                        merge_pointsto (List.map (fold_stmt env) ss)
+                    | AilSmarker(_,_) -> assert false (* FIXME *)
+                in
+                (sym_decl, fold_stmt { counter= 1; block_depth= 0; scopes= fun_scopes } stmt) :: acc
+          end
+  ) [] sigm.declarations
+
+
+let resolve_calls xs =
+  List.map (fun (fsym, pts) ->
+    let pts' = List.fold_left (fun acc pt ->
+      match pt with
+        | `CALL sym ->
+            if sym = fsym then
+              acc
+            else
+              merge_pointsto [List.assoc sym xs; acc]
+        | `CALL_WILD ->
+            [`STORE Wild]
+        | z ->
+            z :: acc
+    ) [] pts in
+    (fsym, pts')
+  ) xs
+
+
+let may_alias pts1 pts2 =
+  List.exists (fun (pt1, pt2) ->
+    match pt1, pt2 with
+      | `LOAD _, `LOAD _ ->
+          false
+      | `STORE z1, `STORE z2
+      | `STORE z1, `LOAD z2
+      | `LOAD z1, `STORE z2 ->
+          begin match z1, z2 with
+            | Wild, _
+            | _, Wild ->
+                true
+            | Current sym1, Current sym2
+            | Local (_, sym1), Local (_, sym2)
+            | Funptr sym1, Funptr sym2
+            | Global sym1, Global sym2 ->
+                eq_sym sym1 sym2
+            | _, _ ->
+                false
+          end
+      | _ ->
+          assert false (* shouldn't happen after CALLs resolution *)
+  ) (Utils.product_list pts1 pts2)
+
+
+let warn_unseq taints_map expr =
+  let rec aux (AnnotatedExpression (_, _, loc, expr_)) =
+    match expr_ with
+      | AilEoffsetof _
+      | AilEbuiltin _
+      | AilEstr _
+      | AilEconst _
+      | AilEident _
+      | AilEsizeof _
+      | AilEalignof _
+      | AilEreg_load _
+      | AilEunion (_, _, None) ->
+          NO_CALL
+
+      | AilEunary (_, e)
+      | AilEcast (_, _, e)
+      | AilEassert e
+      | AilEcompound (_, _, e)
+      | AilEmemberof (e, _)
+      | AilEmemberofptr (e, _)
+      | AilEsizeof_expr e
+      | AilEannot (_, e)
+      | AilEva_start (e, _)
+      | AilEva_arg (e, _)
+      | AilEva_end e
+      | AilEprint_type e
+      | AilEbmc_assume e
+      | AilErvalue e
+      | AilEarray_decay e
+      | AilEfunction_decay e
+      | AilEunion (_, _, Some e)
+      | AilEatomic e ->
+          aux e
+
+      | AilEbinary (e1, bop, e2) when is_unseq bop ->
+          begin match aux e1, aux e2 with
+            | HAS_CALLS calls1, HAS_CALLS calls2 ->
+                HAS_CALLS (calls1 @ calls2)
+            | NO_CALL, HAS_CALLS calls
+            | HAS_CALLS calls, NO_CALL ->
+                HAS_CALLS calls
+            | NO_CALL, NO_CALL ->
+                NO_CALL
+          end
+
+      | AilEbinary (e1, _, e2)
+      | AilEassign (e1, e2)
+      | AilEcompoundAssign (e1, _, e2) ->
+          merge_status [aux e1; aux e2]
+
+      | AilEcond (e1, None, e3) ->
+          merge_status [aux e1; aux e3]
+      | AilEcond (e1, Some e2, e3) ->
+          merge_status [aux e1; aux e2; aux e3]
+
+      | AilEcall (e, es) ->
+          merge_status (begin match e with
+            | AnnotatedExpression (_, _, _, AilEfunction_decay (AnnotatedExpression (_, _, _, AilEident f))) ->
+                [HAS_CALLS [f]]
+            | _ ->
+                [HAS_CALLS []]
+          end @ (List.map aux es))
+
+      | AilEgeneric (e, gas) ->
+          merge_status begin
+            aux e ::
+            List.map (function
+              | AilGAtype (_, e)
+              | AilGAdefault e ->
+                  aux e) gas
+          end
+      | AilEarray (_, _, xs) ->
+          merge_status (List.map (function Some e -> aux e | None -> NO_CALL) xs)
+      | AilEstruct (_, xs) ->
+          merge_status (List.map (function (_, Some e) -> aux e | (_, None) -> NO_CALL) xs)
+      | AilEva_copy (e1, e2) ->
+          merge_status [aux e1; aux e2]
+      | AilEgcc_statement _ ->
+          Panic.panic loc "Not implemented GCC statement expr." (* TODO *)
+  in
+  ignore (aux expr)
+
+
+
+(* ************************************************************************** *)
+(* Driver *)
+let warn_file (_, sigm) =
+  let taints_map = resolve_calls (taints_of_functions sigm) in
+
+  let rec aux_expr env (AnnotatedExpression (_, _, loc, expr_)) =
+    let self = aux_expr env in
+    match expr_ with
+      | AilEbuiltin _
+      | AilEstr _
+      | AilEconst _
+      | AilEident _
+      | AilEsizeof _
+      | AilEalignof _
+      | AilEreg_load _ ->
+          ()
+
+      | AilEassign (e1, e2)
+      | AilEcompoundAssign (e1, _, e2) ->
+          (* Warn if [[e2]] points to objects whose scope is smaller than the scope of
+             the object referred by the lvalue [[e1]] *)
+          let xs1 = points_to (classify sigm env) e1 in
+          let xs2 = points_to (classify sigm env) e2 in
+
+          let sym_of = function
+            | Current sym
+            | Local (_, sym)
+            | Global sym ->
+                Some sym
+            | Funptr _
+            | Wild
+            | PTRVAL _ -> (* TODO: check this one *)
+                None in
+          List.iter (fun pt ->
+            match sym_of pt with
+              | Some sym ->
+                  let old =
+                    begin match List.assoc_opt sym !ptr_taints with
+                      | None    -> []
+                      | Some xs -> xs
+                    end in
+                  ptr_taints := (sym, (xs2 @ old)) :: List.remove_assoc sym !ptr_taints (* TODO: use a map ... *)
+              | None ->
+                  ()
+          ) xs1;
+
+          if xs2 <> [] && List.exists (fun (x, y) -> gt_pointsto x y) (Utils.product_list xs1 xs2) then
+            Panic.wrn (Some loc) "the address of a block-scoped variable may be escaping";
+(*
+(*          else *)
+            Printf.printf "%sASSIGN[%s] ==> lvalue: %s -- e2: %s\x1b[0m\n"
+              (if List.exists (fun (x, y) -> gt_pointsto x y) (Utils.product_list xs1 xs2) then "\x1b[31m" else "")
+              (Cerb_location.location_to_string loc)
+              (foo xs1)
+              (foo xs2);
+*)
+
+
+      | AilEunary (_, e)
+      | AilEcast (_, _, e)
+      | AilEassert e
+      | AilEcompound (_, _, e)
+      | AilEmemberof (e, _)
+      | AilEmemberofptr (e, _)
+      | AilEsizeof_expr e
+      | AilEannot (_, e)
+      | AilEva_start (e, _)
+      | AilEva_arg (e, _)
+      | AilEva_end e
+      | AilEprint_type e
+      | AilEbmc_assume e
+      | AilErvalue e
+      | AilEarray_decay e
+      | AilEfunction_decay e
+      | AilEatomic e ->
+          self e
+      | AilEbinary (e1, _, e2)
+      | AilEva_copy (e1, e2) ->
+          self e1;
+          self e2
+      | AilEcond (e1, None, e3) ->
+          self e1;
+          self e3
+      | AilEcond (e1, Some e2, e3) ->
+          self e1;
+          self e2;
+          self e3
+      | AilEcall (e, es) ->
+          self e;
+          List.iter self es
+      | AilEoffsetof _ ->
+          ()
+      | AilEgeneric (e ,gas) ->
+          self e;
+          List.iter (function
+            | AilGAtype (_, e)
+            | AilGAdefault e ->
+                self e
+          ) gas
+      | AilEarray (_, _, xs) ->
+          List.iter (function
+            | Some e ->
+                self e
+            | None ->
+                ()
+          ) xs
+      | AilEstruct (_, xs) ->
+          List.iter (function
+            | (_, Some e) ->
+                self e
+            | (_, None) ->
+                ()
+          ) xs
+      | AilEunion (_, _, e_opt) ->
+          begin match e_opt with
+            | Some e ->
+                self e
+            | None ->
+                ()
+          end
+      | AilEgcc_statement _ ->
+          Panic.panic loc "Not implemented GCC statement expr." (* TODO *)
+  in
+  let rec aux env (AnnotatedStatement (loc, _, stmt_)) =
+    let self = aux env in
+    let warn_unseq e = warn_unseq taints_map e in
+    match stmt_ with
+      | AilSskip ->
+          ()
+      | AilSexpr e
+      | AilSreturn e ->
+          aux_expr env e;
+          warn_unseq e
+      | AilSblock (bs, ss) ->
+          let new_scopes =
+            List.fold_left (fun acc (sym, _) ->
+              Scopes.register sym acc
+            ) (Scopes.create_scope (Cabs_to_ail_effect.Scope_block env.counter) env.scopes) bs in
+          let env' = {
+            counter= env.counter + 1;
+            block_depth= env.block_depth + 1;
+            scopes = new_scopes;
+          } in
+          List.iter (aux env') ss
+      | AilSif (e, s1, s2) ->
+          aux_expr env e;
+          warn_unseq e;
+          self s1;
+          self s2
+      | AilSwhile (e, s, _) ->
+          self s;
+          aux_expr env e;
+          warn_unseq e
+      | AilSdo (s, e, _) ->
+          aux_expr env e;
+          warn_unseq e;
+          self s
+      | AilSbreak
+      | AilScontinue
+      | AilSreturnVoid ->
+          ()
+      | AilSswitch (e, s) ->
+          aux_expr env e;
+          warn_unseq e;
+          self s
+      | AilScase (_, s)
+      | AilScase_rangeGNU (_, _, s)
+      | AilSdefault s
+      | AilSlabel (_, s, _) ->
+          self s
+      | AilSgoto _ ->
+          ()
+      | AilSdeclaration xs ->
+          List.iter (fun (sym, e_opt) ->
+            match e_opt with
+              | None -> ()
+              | Some e ->
+                  (* We need to record the tainting if [[sym]] is a pointer *)
+                  let pts = points_to (classify sigm env) e in
+                  let old =
+                    begin match List.assoc_opt sym !ptr_taints with
+                      | None    -> []
+                      | Some xs -> xs
+                    end in
+                  ptr_taints := (sym, (pts @ old)) :: List.remove_assoc sym !ptr_taints; (* TODO: use a map ... *)
+                  aux_expr env e;
+                  warn_unseq e;
+          ) xs
+      | AilSpar ss ->
+          List.iter (aux { env with block_depth= 0 }) ss
+      | AilSreg_store (_, e) ->
+          aux_expr env e;
+          warn_unseq e
+      | AilSmarker(_,_) -> assert false (* FIXME *)
+  in
+  List.iter (fun (fsym, (_, _, _, params, stmt)) ->
+    (* NOTE: following (§6.2.1#4), the function parameters are placed in a block scope *)
+    let fun_scopes =
+      List.fold_left (fun acc sym ->
+        Scopes.register sym acc
+      ) (Scopes.(create_scope (Cabs_to_ail_effect.Scope_block 0) empty)) params in
+    aux { counter= 1; block_depth= 0; scopes= fun_scopes } stmt;
+    flush_all ()
+  ) sigm.function_definitions;
+
+  let resolve_calls2 pts =
+    List.fold_left (fun acc pt ->
+      match pt with
+      | `CALL sym ->
+          merge_pointsto [List.assoc sym taints_map; acc]
+      | `CALL_WILD ->
+          [`STORE Wild]
+      | z ->
+          z :: acc
+    ) [] pts in
+  (* This display the warning for potential nondeterminism from unsequenced calls *)
+  List.iter (fun (loc, xs1, xs2) ->
+    if may_alias (resolve_calls2 xs1) (resolve_calls2 xs2) then
+      Panic.wrn (Some loc) "a function call potentially introduces non-determinism"
+  ) (List.rev !potential_races)
diff --git a/refinedVST/typing/frontend_stuff/include/assume.h b/refinedVST/typing/frontend_stuff/include/assume.h
new file mode 100644
index 0000000000..b245e2a6a9
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/include/assume.h
@@ -0,0 +1,21 @@
+#ifndef ASSUME_H
+#define ASSUME_H
+
+#include <assert.h>
+
+// TODO: Add void op_type and let this return void instead of int
+[[rc::ensures("False")]]
+static inline int safe_exit() {
+#if defined (__refinedc__)
+  while(1){}
+#else
+  // TODO: Should this be something else?
+  assert(0);
+#endif
+  return 0;
+}
+
+// TODO: use gcc statement expressions with ({ }) here?
+#define assume(x) ((!x) ? safe_exit(), 0 : 0)
+
+#endif
diff --git a/refinedVST/typing/frontend_stuff/include/dune b/refinedVST/typing/frontend_stuff/include/dune
new file mode 100644
index 0000000000..8516fba2df
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/include/dune
@@ -0,0 +1,6 @@
+(install
+ (files (refinedc.h as include/refinedc.h)
+        (refinedc_builtins_specs.h as include/refinedc_builtins_specs.h)
+        (assume.h as include/assume.h))
+ (section lib)
+ (package refinedc))
diff --git a/refinedVST/typing/frontend_stuff/include/refinedc.h b/refinedVST/typing/frontend_stuff/include/refinedc.h
new file mode 100644
index 0000000000..0ca92bfc3d
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/include/refinedc.h
@@ -0,0 +1,70 @@
+#ifndef REFINEDC_H
+#define REFINEDC_H
+
+// Required for copy_alloc_id.
+#include <stdint.h>
+
+#if defined (__refinedc__)
+#include "refinedc_builtins_specs.h"
+#endif
+
+#define rc_unfold(e)                                     \
+    _Pragma("GCC diagnostic push")                       \
+    _Pragma("GCC diagnostic ignored \"-Wunused-value\"") \
+    &(e);                                                \
+    _Pragma("GCC diagnostic pop")
+
+#define rc_unfold_int(e)                                 \
+    _Pragma("GCC diagnostic push")                       \
+    _Pragma("GCC diagnostic ignored \"-Wunused-value\"") \
+    e + 0;                                               \
+    _Pragma("GCC diagnostic pop")
+
+#define rc_annot(e, ...)                                 \
+    _Pragma("GCC diagnostic push")                       \
+    _Pragma("GCC diagnostic ignored \"-Wunused-value\"") \
+    [[rc::annot(__VA_ARGS__)]] &(e);                     \
+    _Pragma("GCC diagnostic pop")
+
+#define rc_assert                                        \
+    _Pragma("GCC diagnostic push")                       \
+    _Pragma("GCC diagnostic ignored \"-Wunused-value\"") \
+    [[rc::asrt]] 0;                                  \
+    _Pragma("GCC diagnostic pop")
+
+#define rc_annot_expr(e, ...) (0 ? ("rc_annot", __VA_ARGS__, (e)) : (e))
+
+#define rc_unlock(e) rc_annot(e, "UnlockA")
+#define rc_to_uninit(e) rc_annot(e, "ToUninit")
+#define rc_stop(e) rc_annot(e, "StopAnnot")
+#define rc_share(e) rc_annot(e, "ShareAnnot")
+#define rc_unfold_once(e) rc_annot(e, "UnfoldOnceAnnot")
+#define rc_learn(e) rc_annot(e, "LearnAnnot")
+#define rc_learn_alignment(e) rc_annot(e, "LearnAlignmentAnnot")
+#define rc_reduce_expr(e) rc_annot_expr(e, "ReduceAnnot")
+
+#ifdef RC_ENABLE_FOCUS
+#define RC_FOCUS ,rc::trust_me
+#define RC_FOCUS_X
+#else
+#define RC_FOCUS
+#define RC_FOCUS_X
+#endif
+
+#define RC_MACRO_ARG(arg) "ARG", #arg
+#define RC_MACRO_EXPR(expr) "EXPR", expr
+#define RC_MACRO(name, m, ...) (0 ? ("rc_macro", #name, __VA_ARGS__, (m)) : (m))
+
+// Note that copy_alloc_id exposes the provenance of [from] by casting it
+// to an integer (throwing away the result).
+[[rc::inlined]]
+static inline void *copy_alloc_id(uintptr_t to, void *from) {
+#if defined (__cerb__)
+  return __cerbvar_copy_alloc_id((to), (from));
+#else
+  (uintptr_t) from;
+  return (void*) to;
+#endif
+}
+
+#endif
diff --git a/refinedVST/typing/frontend_stuff/include/refinedc_builtins_specs.h b/refinedVST/typing/frontend_stuff/include/refinedc_builtins_specs.h
new file mode 100644
index 0000000000..1fabbf8f2e
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/include/refinedc_builtins_specs.h
@@ -0,0 +1,22 @@
+//@rc::import builtins_specs from caesium
+
+/**
+ * GCC-builtins declaration.
+ */
+#ifndef REFINEDC_BUILTINS_SPECS_H
+#define REFINEDC_BUILTINS_SPECS_H
+
+/**
+ * https://gcc.gnu.org/onlinedocs/gcc/Other-Builtins.html
+ *
+ * This built-in function returns one plus the index of the least significant 1-bit of x,
+ * or if x is zero, returns zero.
+ *
+ * Reference implementation: return log2(x & -x);
+ */
+[[rc::parameters("x : Z")]]
+[[rc::args("x @ int<u64>")]]
+[[rc::returns("{(Z_least_significant_one x + 1)%Z} @ int<i32>")]]
+int __builtin_ffsll(unsigned long long x);
+
+#endif
diff --git a/refinedVST/typing/frontend_stuff/include/refinedc_malloc.h b/refinedVST/typing/frontend_stuff/include/refinedc_malloc.h
new file mode 100644
index 0000000000..dd1d1b4bc1
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/include/refinedc_malloc.h
@@ -0,0 +1,38 @@
+
+/**
+ * RefinedC support for malloc
+ */
+#ifndef REFINEDC_MALLOC_H
+#define REFINEDC_MALLOC_H
+
+#include <stddef.h>
+#include <assume.h>
+
+//@rc::import malloc from refinedc.typing
+
+//@rc::context `{!mallocG Σ}
+
+/** Specifications for standard library allocation and deallocation functions */
+[[rc::parameters("n : Z")]]
+[[rc::args("n @ int<size_t>")]]
+[[rc::returns("optional<&own<malloced<n, uninit<{ly_max_align (Z.to_nat n)}>>>, null>")]]
+void *malloc(size_t sz);
+
+// TODO: In theory we can weaken [ly_max_align (Z.to_nat n)] to
+// [ly_with_align (Z.to_nat n) 1] since [malloc_block] guarantees the
+// alignment of the location, but the automation currently does not like that
+[[rc::parameters("n : Z")]]
+[[rc::args("&own<malloced_early<n, uninit<{ly_max_align (Z.to_nat n)}>>>")]]
+void free(void *p);
+
+/** Commonly used wrappers for malloc and free */
+[[rc::parameters("n : Z")]]
+[[rc::args("n @ int<size_t>")]]
+[[rc::returns("&own<malloced<n, uninit<{ly_max_align (Z.to_nat n)}>>>")]]
+void *xmalloc(size_t sz) {
+  void *p = malloc(sz);
+  if(p == NULL) { safe_exit(); }
+  return p;
+}
+
+#endif
diff --git a/refinedVST/typing/frontend_stuff/rc-project.toml b/refinedVST/typing/frontend_stuff/rc-project.toml
new file mode 100644
index 0000000000..7d7514468e
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/rc-project.toml
@@ -0,0 +1,11 @@
+# Custom RefinedC project file for the examples in the repository.
+
+coq_root = "refinedc"
+no_build = true
+
+[cpp]
+include = [ "include", "examples/include"]
+use_rc_include = false
+
+[coq]
+extra_theories = []
diff --git a/refinedVST/typing/frontend_stuff/refinedc.opam b/refinedVST/typing/frontend_stuff/refinedc.opam
new file mode 100644
index 0000000000..d1e470e4ec
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/refinedc.opam
@@ -0,0 +1,42 @@
+opam-version: "2.0"
+name: "refinedc"
+synopsis: "RefinedC verification framework"
+description: """
+RefinedC is a framework for verifying idiomatic, low-level C code using a
+combination of refinement types and ownership types.
+"""
+license: "BSD-3-Clause"
+
+maintainer: ["Michael Sammler <msammler@mpi-sws.org>"
+             "Rodolphe Lepigre <lepigre@mpi-sws.org>"]
+authors: ["Michael Sammler" "Rodolphe Lepigre" "Kayvan Memarian"]
+
+homepage: "https://plv.mpi-sws.org/refinedc"
+bug-reports: "https://gitlab.mpi-sws.org/iris/refinedc/issues"
+dev-repo: "git+https://gitlab.mpi-sws.org/iris/refinedc.git"
+
+depends: [
+  "cerberus" {= "~dev"}
+  "cmdliner" {>= "1.1.0"}
+  "sexplib0" {>= "v0.14.0"}
+  "earley" {= "3.0.0"}
+  "toml" {>= "6.0.0"}
+  "ubase" {>= "0.04"}
+]
+
+depopts: [
+  "coq-caesium-config-no-align"
+]
+
+build: [
+  [make "prepare-install-refinedc"]
+  [make "config"] {!coq-caesium-config-no-align:installed}
+  [make "config-no-align"] {coq-caesium-config-no-align:installed}
+  ["dune" "subst"] {pinned}
+  ["dune" "build" "-p" name "-j" jobs]
+]
+
+messages: [
+  "with default configuration" {!coq-caesium-config-no-align:installed}
+  "with no-align configuration" {coq-caesium-config-no-align:installed}
+]
diff --git a/refinedVST/typing/frontend_stuff/test/generated_code.v b/refinedVST/typing/frontend_stuff/test/generated_code.v
new file mode 100644
index 0000000000..8c97dff6b9
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/test/generated_code.v
@@ -0,0 +1,77 @@
+From caesium Require Export notation.
+From caesium Require Import tactics.
+From refinedc.typing Require Import annotations.
+Set Default Proof Using "Type".
+
+(* Generated from [tutorial/test.c]. *)
+Section code.
+  Definition file_0 : string := "include/refinedc.h".
+  Definition file_1 : string := "tutorial/test.c".
+  Definition loc_2 : location_info := LocationInfo file_0 63 2 63 47.
+  Definition loc_3 : location_info := LocationInfo file_0 63 9 63 46.
+  Definition loc_4 : location_info := LocationInfo file_0 63 9 63 32.
+  Definition loc_5 : location_info := LocationInfo file_0 63 33 63 37.
+  Definition loc_6 : location_info := LocationInfo file_0 63 33 63 37.
+  Definition loc_7 : location_info := LocationInfo file_0 63 39 63 45.
+  Definition loc_8 : location_info := LocationInfo file_0 63 39 63 45.
+  Definition loc_13 : location_info := LocationInfo file_1 12 4 12 14.
+  Definition loc_14 : location_info := LocationInfo file_1 13 4 13 15.
+  Definition loc_15 : location_info := LocationInfo file_1 14 4 14 17.
+  Definition loc_16 : location_info := LocationInfo file_1 14 11 14 16.
+  Definition loc_17 : location_info := LocationInfo file_1 14 11 14 12.
+  Definition loc_18 : location_info := LocationInfo file_1 14 11 14 12.
+  Definition loc_19 : location_info := LocationInfo file_1 14 15 14 16.
+  Definition loc_20 : location_info := LocationInfo file_1 14 15 14 16.
+  Definition loc_21 : location_info := LocationInfo file_1 13 12 13 14.
+  Definition loc_24 : location_info := LocationInfo file_1 12 12 12 13.
+
+  (* Definition of function [copy_alloc_id]. *)
+  Definition impl_copy_alloc_id : function := {|
+    f_args := [
+      ("to", it_layout uintptr_t);
+      ("from", void*)
+    ];
+    f_local_vars := [
+    ];
+    f_init := "#0";
+    f_code := (
+      <[ "#0" :=
+        locinfo: loc_2 ;
+        Return (LocInfoE loc_3 (CopyAllocId (IntOp uintptr_t) (LocInfoE loc_5 (use{IntOp uintptr_t} (LocInfoE loc_6 ("to")))) (LocInfoE loc_7 (use{PtrOp} (LocInfoE loc_8 ("from"))))))
+      ]> $∅
+    )%E
+  |}.
+
+  (* Definition of function [main]. *)
+  Definition impl_main : function := {|
+    f_args := [
+    ];
+    f_local_vars := [
+    ];
+    f_init := "#0";
+    f_code := (
+      <[ "#0" :=
+        Return (i2v 0 i32)
+      ]> $∅
+    )%E
+  |}.
+
+  (* Definition of function [f_temps]. *)
+  Definition impl_f_temps : function := {|
+    f_args := [
+    ];
+    f_local_vars := [
+      ("b", it_layout i32);
+      ("a", it_layout i32)
+    ];
+    f_init := "#0";
+    f_code := (
+      <[ "#0" :=
+        "a" <-{ IntOp i32 } LocInfoE loc_24 (i2v 1 i32) ;
+        "b" <-{ IntOp i32 } LocInfoE loc_21 (i2v 41 i32) ;
+        locinfo: loc_15 ;
+        Return (LocInfoE loc_16 ((LocInfoE loc_17 (use{IntOp i32} (LocInfoE loc_18 ("a")))) +{IntOp i32, IntOp i32} (LocInfoE loc_19 (use{IntOp i32} (LocInfoE loc_20 ("b"))))))
+      ]> $∅
+    )%E
+  |}.
+End code.
diff --git a/refinedVST/typing/frontend_stuff/test/generated_proof_f_temps.v b/refinedVST/typing/frontend_stuff/test/generated_proof_f_temps.v
new file mode 100644
index 0000000000..0f863a95d1
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/test/generated_proof_f_temps.v
@@ -0,0 +1,28 @@
+From refinedc.typing Require Import typing.
+From refinedc.tutorial.test Require Import generated_code.
+From refinedc.tutorial.test Require Import generated_spec.
+From caesium Require Import builtins_specs.
+Set Default Proof Using "Type".
+
+(* Generated from [tutorial/test.c]. *)
+Section proof_f_temps.
+  Context `{!typeG Σ} `{!globalG Σ}.
+
+  (* Typing proof for [f_temps]. *)
+  Lemma type_f_temps :
+    ⊢ typed_function impl_f_temps type_of_f_temps.
+  Proof.
+    Local Open Scope printing_sugar.
+    start_function "f_temps" ([]) => local_b local_a.
+    split_blocks ((
+      ∅
+    )%I : gmap label (iProp Σ)) (
+      @nil Prop
+    ).
+    - repeat liRStep; liShow.
+      all: print_typesystem_goal "f_temps" "#0".
+    Unshelve. all: unshelve_sidecond; sidecond_hook; prepare_sideconditions; normalize_and_simpl_goal; try solve_goal; unsolved_sidecond_hook.
+    all: print_sidecondition_goal "f_temps".
+    Unshelve. all: try done; try apply: inhabitant; print_remaining_shelved_goal "f_temps".
+  Qed.
+End proof_f_temps.
diff --git a/refinedVST/typing/frontend_stuff/test/generated_proof_f_temps_VSTver.v b/refinedVST/typing/frontend_stuff/test/generated_proof_f_temps_VSTver.v
new file mode 100644
index 0000000000..d9af70f131
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/test/generated_proof_f_temps_VSTver.v
@@ -0,0 +1,15 @@
+(* The VST proof would look like this *)
+From VST.typing Require Import automation.
+Set Default Proof Using "Type".
+
+(* Generated from [tutorial/test.c]. *)
+Section proof_f_temps.
+  Context `{!typeG Σ} {cs : compspecs} `{!externalGS OK_ty Σ}.
+
+  (* Typing proof for [f_temps]. *)
+  Lemma type_f_temps :
+    ⊢ typed_function(A := ConstType _) Espec Delta (rc_func_to_cl_func impl_f_temps) type_of_f_temps.
+  Proof.
+    (* TBD *)
+  Qed.
+End proof_f_temps.
diff --git a/refinedVST/typing/frontend_stuff/test/generated_proof_main.v b/refinedVST/typing/frontend_stuff/test/generated_proof_main.v
new file mode 100644
index 0000000000..7afb1f35aa
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/test/generated_proof_main.v
@@ -0,0 +1 @@
+(* You were too lazy to even write a spec for this function. *)
diff --git a/refinedVST/typing/frontend_stuff/test/generated_spec.v b/refinedVST/typing/frontend_stuff/test/generated_spec.v
new file mode 100644
index 0000000000..848b49d771
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/test/generated_spec.v
@@ -0,0 +1,20 @@
+From refinedc.typing Require Import typing.
+From refinedc.tutorial.test Require Import generated_code.
+From caesium Require Import builtins_specs.
+Set Default Proof Using "Type".
+
+(* Generated from [tutorial/test.c]. *)
+Section spec.
+  Context `{!typeG Σ} `{!globalG Σ}.
+
+  (* Specifications for function [__builtin_ffsll]. *)
+  Definition type_of___builtin_ffsll :=
+    fn(∀ x : Z; (x @ (int (u64))); True)
+      → ∃ () : (), (((Z_least_significant_one x + 1)%Z) @ (int (i32))); True.
+
+  (* Function [main] has been skipped. *)
+
+  (* Specifications for function [f_temps]. *)
+  Definition type_of_f_temps :=
+    fn(∀ () : (); True) → ∃ n : Z, (n @ (int (tint))); ⌜n = 42⌝.
+End spec.
diff --git a/refinedVST/typing/frontend_stuff/test/generated_spec_VSTver.v b/refinedVST/typing/frontend_stuff/test/generated_spec_VSTver.v
new file mode 100644
index 0000000000..d0ac07ccd3
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/test/generated_spec_VSTver.v
@@ -0,0 +1,21 @@
+(* The VST spec would look like this *)
+From VST.typing Require Import automation.
+From VST.typing Require Import automation_test.
+Set Default Proof Using "Type".
+From VST.typing Require Import function.
+(* Generated from [tutorial/test.c]. *)
+Section spec.
+  Context `{!typeG Σ} `{!globalG Σ}.
+
+  (* Ke: don't mind this one *)
+  (* Specifications for function [__builtin_ffsll]. *)
+  Definition type_of___builtin_ffsll :=
+    fn(∀ x : Z; (x @ (int (u64))); True)
+      → ∃ () : (), (((Z_least_significant_one x + 1)%Z) @ (int (i32))); True.
+
+  (* Function [main] has been skipped. *)
+
+  (* Specifications for function [f_temps]. *)
+  Definition type_of_f_temps :=
+    fn(∀ () : (); emp) → ∃ n : Z, (n @ (int (tint))); ⌜n = 42⌝.
+End spec.
diff --git a/refinedVST/typing/frontend_stuff/test/proof_files b/refinedVST/typing/frontend_stuff/test/proof_files
new file mode 100644
index 0000000000..529f0ee280
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/test/proof_files
@@ -0,0 +1,3 @@
+generated_proof___builtin_ffsll.v
+generated_proof_f_temps.v
+generated_proof_main.v
diff --git a/refinedVST/typing/frontend_stuff/tools/coqc_timing.sh b/refinedVST/typing/frontend_stuff/tools/coqc_timing.sh
new file mode 100755
index 0000000000..23656e7280
--- /dev/null
+++ b/refinedVST/typing/frontend_stuff/tools/coqc_timing.sh
@@ -0,0 +1,19 @@
+#!/bin/bash
+
+set -e
+
+# Wrapper for coqc that is used when running the perf script in the CI.
+# Variable TIMECMD is expected to contain an absolute path to the perf script.
+# If TIMECMD is not set (or empty), fallback to just calling coqc.
+# we need to use opam exec -- coqc to get the coqc installed by opam, not this script
+# If PROFILE is set, generate a profile in the $PROFILE file (relative to the root of the repo).
+
+# This file is in "_build/default/tools"
+REPO_DIR="$(dirname $(readlink -f $0))/../../../"
+
+PROFILE_ARG=()
+if [[ ! -z "$PROFILE" ]]; then
+    PROFILE_ARG=("-profile" "$REPO_DIR/$PROFILE")
+fi
+
+opam exec -- ${TIMECMD} coqc "${PROFILE_ARG[@]}" "$@"
diff --git a/refinedVST/typing/function.v b/refinedVST/typing/function.v
new file mode 100644
index 0000000000..96b85f064c
--- /dev/null
+++ b/refinedVST/typing/function.v
@@ -0,0 +1,527 @@
+Require Import VST.veric.Clight_core.
+From VST.typing Require Export type.
+From VST.typing Require Import programs bytes.
+From VST.typing Require Import type_options.
+
+(* Can we just use typed_stmt fn_body?
+Definition introduce_typed_stmt {Σ} `{!typeG Σ} (fn : function) (ls : list loc) (R : val → type → iProp Σ) : iProp Σ :=
+  let Q := (subst_stmt (zip (fn.(f_args).*1 ++ fn.(f_local_vars).*1)
+                            (val_of_loc <$> ls))) <$> fn.(f_code) in
+  typed_stmt (Goto fn.(f_init)) fn ls R Q.
+Global Typeclasses Opaque introduce_typed_stmt.
+Arguments introduce_typed_stmt : simpl never.
+
+Section introduce_typed_stmt.
+  Context `{!typeG Σ}.
+
+  Lemma introduce_typed_stmt_wand R1 R2 fn locs :
+    introduce_typed_stmt fn locs R1 -∗
+    (∀ v ty, R1 v ty -∗ R2 v ty) -∗
+    introduce_typed_stmt fn locs R2.
+  Proof.
+    rewrite /introduce_typed_stmt. iIntros "HR1 Hwand" (Hlen).
+    iApply (wps_wand with "[HR1]"). { by iApply "HR1". }
+    iIntros (v) "(%ty & Hty & Hargs & Hret)".
+    iExists ty. iFrame. by iApply "Hwand".
+  Qed.
+End introduce_typed_stmt. *)
+
+Section function.
+  Context `{!typeG OK_ty Σ} {cs : compspecs} {A : TypeTree}. (* should we fix this to ConstType? *)
+  Record fn_ret := FR {
+    (* return type (rc::returns) *)
+    fr_rty : type;
+    (* postcondition (rc::ensures) *)
+    fr_R : iProp Σ;
+  }.
+  Definition mk_FR (rty : type) (R : iProp Σ) := FR rty R.
+
+
+  (* The specification of a function is given by [A → fn_params].
+     The full specification roughly looks like the following:
+     ∀ x : A, args ◁ᵥ fp_atys ∗ fp_Pa → ∃ y : fp_rtype, ret ◁ᵥ fr_rty ∗ fr_R
+ *)
+  Record fn_params := FP {
+    (* types of arguments (rc::args) *)
+    fp_atys : list type;
+    (* precondition (rc::requires) *)
+    fp_Pa : iProp Σ;
+    (* type of the existential quantifier (rc::exists) *)
+    fp_rtype : Type;
+    (* return type and postcondition (rc::returns and rc::ensures) *)
+    fp_fr: fp_rtype → fn_ret;
+  }.
+
+  Definition opt_ty_own_val t o :=
+    match o with Some v => v ◁ᵥ t | None => emp end.
+
+  Global Instance opt_ty_own_val_proper : Proper (equiv ==> eq ==> equiv) opt_ty_own_val.
+  Proof. intros ??? [|] ??; subst; simpl; by rewrite ?H. Qed.
+
+  Definition fn_ret_prop {B} (fr : B → fn_ret) : option val → type → assert :=
+    (λ v ty, ⎡opt_ty_own_val ty v⎤ -∗ ∃ x, ⎡opt_ty_own_val (fr x).(fr_rty) v⎤ ∗ ⎡(fr x).(fr_R)⎤ ∗ True)%I.
+
+  Definition FP_wf {B} (atys : list type) Pa (fr : B → fn_ret)  :=
+    FP atys Pa B fr.
+
+  Context (Espec : ext_spec OK_ty) (ge : genv).
+
+  Definition typed_function (fn : function) (fp : @dtfr Σ A → fn_params) : iProp Σ :=
+    (∀ x, <affine> ⌜Forall2 (λ (ty : type) '(_, p), ty.(ty_has_op_type) p MCNone) (fp x).(fp_atys) (Clight.fn_params fn)⌝ ∗
+      <affine> ⌜∀ (lsa : vec val (length (fp x).(fp_atys))) (lsv : vec address (length (fn_vars fn))),
+          ⎡[∗ list] v;t∈lsa;(fp x).(fp_atys), v ◁ᵥ t⎤ ∗
+          ([∗ list] '(i,_);v ∈ (Clight.fn_params fn);lsa, <affine> local (locald_denote (temp i v))) ∗
+          ([∗ list] '(i,t);v ∈ fn_vars fn;lsv, (<affine> local (locald_denote (lvar i t (adr2val v)))) ∗ ⎡v ◁ₗ uninit t⎤) ∗
+          ⎡(fp x).(fp_Pa)⎤ ⊢
+          typed_stmt Espec ge (fn.(fn_body)) fn (fn_ret_prop (fp x).(fp_fr))⌝
+    )%I.
+
+  Global Instance typed_function_persistent fn fp : Persistent (typed_function fn fp) := _.
+
+  (* up? *)
+  Global Instance leibniz_val : Equiv val := equivL.
+
+  Import EqNotations.
+  Lemma typed_function_equiv fn1 fn2 (fp1 fp2 : @dtfr Σ A → _) :
+    fn1 = fn2 →
+    ((∀ x, Forall2 (λ ty '(_, p), ty_has_op_type ty p MCNone) (fp_atys (fp2 x)) (Clight.fn_params fn2)) →
+    (* TODO: replace the following with an equivalenve relation for fn_params? *)
+    (∀ x, ∃ Heq : (fp1 x).(fp_rtype) = (fp2 x).(fp_rtype),
+          (fp1 x).(fp_atys) ≡ (fp2 x).(fp_atys) ∧
+          (fp1 x).(fp_Pa) ≡ (fp2 x).(fp_Pa) ∧
+          (∀ y, ((fp1 x).(fp_fr) y).(fr_rty) ≡ ((fp2 x).(fp_fr) (rew [λ x : Type, x] Heq in y)).(fr_rty) ∧
+                ((fp1 x).(fp_fr) y).(fr_R) ≡ ((fp2 x).(fp_fr) (rew [λ x : Type, x] Heq in y)).(fr_R))) →
+    typed_function fn1 fp1 ⊢ typed_function fn2 fp2)%type.
+  Proof.
+    iIntros (-> Hly Hfn) "HT".
+    rewrite /typed_function.
+    iIntros (x). iDestruct ("HT" $! x) as ([Hlen Hall]%Forall2_same_length_lookup) "%HT".
+    have [Heq [Hatys [HPa Hret]]] := Hfn x.
+    iSplit; [done|].
+    iPureIntro; intros. iIntros "(Ha & Hparams & stack)". rewrite -HPa.
+    have [|lsa' Hlsa]:= vec_cast _ lsa (length (fp_atys (fp1 x))). { by rewrite Hatys. }
+    iApply typed_stmt_mono; last iApply (HT lsa').
+    - iIntros (v ?) "HR Hty".
+      iDestruct ("HR" with "Hty") as (y) "[?[??]]".
+      have [-> ->]:= Hret y.
+      iExists (rew [λ x : Type, x] Heq in y). iFrame.
+    - iFrame. rewrite Hlsa; iFrame.
+      iStopProof. split => rho; monPred.unseal.
+      apply bi.equiv_entails_1_1, big_sepL2_proper_2; [done..|].
+      intros ??????? Hy. inv Hy.
+      move: Hatys => /list_equiv_lookup Hatys.
+      intros Haty2 Haty1.
+      have := Hatys k. rewrite Haty1 Haty2=> /(Some_equiv_eq _ _)[?[? [? Heqv]]] ?.
+      rewrite -Heqv. by simplify_eq.
+  Qed.
+
+  (* The design of this in RefinedC is to associate a function pointer with actual function code,
+     and then prove that that code has the desired type spec (typed_function fn fp). For VST, maybe
+     typed_function should instead relate a funspec to a type spec. *)
+  (* On the other hand, we don't really want to require the user to provide both a funspec
+     and a type signature for every function. Can we derive the funspec from the type? *)
+(*  Import EqNotations.
+  Definition typed_funspec (fs : funspec) (fp : dtfr A → fn_params) : iProp Σ :=
+    match fs, fp with
+    | mk_funspec (tys, retty) _ B E P Q, fsp => believe_internal ∗
+      ∃ Heq : B = A,
+      ∀ x : dtfr B, let x' := rew [λ x, dtfr x] Heq in x in
+      <affine> ⌜Forall2 (λ (ty : type) p, ty.(ty_has_op_type) p MCNone) (fsp x').(fp_atys) tys⌝ ∗
+      □ ∀ args : list val,
+        let Qinit := ([∗list] v;t∈args;(fsp x').(fp_atys), v ◁ᵥ t) in
+        Qinit -∗ ∀ rho, P x (ge_of rho, args) ∗
+          (∀ ret, bind_ret ret retty (assert_of (Q x)) rho -∗ fn_ret_prop (fsp x').(fp_fr) (force_val ret))
+    end.
+
+  Global Instance typed_function_persistent fs fp : Persistent (typed_funspec fs fp).
+  Proof.
+    rewrite /typed_funspec.
+    destruct fs as [[]]; apply _.
+  Qed.*)
+
+  Definition fntbl_entry f fn : iProp Σ := <affine> ⌜exists b, f = Vptr b Ptrofs.zero /\ Genv.find_funct_ptr ge b = Some (Internal fn) /\
+    (* function decl is wellformed *)
+    Forall (λ it : ident * Ctypes.type, complete_type ge it.2 = true) (fn_vars fn) /\
+    list_norepet (map fst (Clight.fn_params fn) ++ map fst (fn_temps fn)) /\
+    list_norepet (map fst (fn_vars fn)) /\ @var_sizes_ok (genv_cenv ge) (fn_vars fn)⌝.
+
+  Program Definition function_ptr_type (fp : dtfr A → fn_params) (f : address) : type := {|
+    ty_has_op_type ot mt := (∃ t, ot = tptr t)%type;
+    ty_own β l := (∃ fn, <affine> ⌜field_compatible (tptr tvoid) [] l⌝ ∗ l ↦_(tptr tvoid)[β] (adr2val f) ∗ fntbl_entry f fn ∗ ▷ typed_function fn fp)%I;
+    ty_own_val v := (∃ fn, <affine> ⌜v = adr2val f⌝ ∗ fntbl_entry f fn ∗ ▷ typed_function fn fp)%I;
+  |}.
+  Next Obligation. iDestruct 1 as (fn) "[? [H [? ?]]]". iExists _. iFrame. by iApply heap_mapsto_own_state_share. Qed.
+  Next Obligation. iIntros (fp f ot mt l (? & ->)). rewrite /has_layout_loc singleton.field_compatible_tptr. by iDestruct 1 as (??) "?". Qed.
+  Next Obligation. iIntros (fp f ot mt l (? & ->)). iDestruct 1 as (? ->) "_"; iPureIntro. intros ?; hnf; simple_if_tac; done. Qed.
+  Next Obligation. iIntros (fp f ot mt v (? & ->)). iDestruct 1 as (??) "(?&?)". unfold mapsto. erewrite singleton.mapsto_tptr. eauto with iFrame. Qed.
+  Next Obligation. iIntros (fp f ot mt v ? (? & ->) ?) "?". iDestruct 1 as (? ->) "?". rewrite /has_layout_loc singleton.field_compatible_tptr in H; unfold mapsto; erewrite singleton.mapsto_tptr; by iFrame. Qed.
+(*   Next Obligation.
+    iIntros (fp f v ot mt st ?). apply mem_cast_compat_loc; [done|].
+    iIntros "[%fn [-> ?]]". iPureIntro. naive_solver.
+  Qed. *)
+
+  Definition function_ptr (fp : dtfr A → fn_params) : rtype _ :=
+    RType (function_ptr_type fp).
+
+  Global Program Instance copyable_function_ptr p fp : Copyable (p @ function_ptr fp).
+  Next Obligation.
+  Admitted.
+  Next Obligation.
+    iIntros (p fp E ly l ? (? & ->)). iDestruct 1 as (fn Hl) "(Hl&?&?)".
+    iMod (heap_mapsto_own_state_to_mt with "Hl") as (q) "[_ Hl]" => //.
+    erewrite singleton.mapsto_tptr. iFrame. iModIntro. unfold has_layout_loc. rewrite singleton.field_compatible_tptr. do 2 iSplit => //. by iIntros "_".
+  Qed.
+
+  (* up *)
+  Lemma monPred_at_big_sepL2 {BI : bi} {I : biIndex} {B C} i (Φ : nat → B → C → monPred I BI) l m :
+    ([∗ list] k↦x;y ∈ l;m, Φ k x y) i ⊣⊢ [∗ list] k↦x;y ∈ l;m, Φ k x y i.
+  Proof. rewrite !big_sepL2_alt. monPred.unseal; rewrite monPred_at_big_sepL //. Qed.
+
+  Lemma type_call_fnptr l e el fp tys T:
+    match typeof e with Tfunction tl retty cc =>
+    (typed_exprs el tl (λ vl tl, ⌜tl = tys⌝ ∧ ∃ x,
+      ([∗ list] v;ty∈vl; (fp x).(fp_atys), ⎡v ◁ᵥ ty⎤) ∗
+      ⎡(fp x).(fp_Pa)⎤ ∗ ∀ v x',
+      ⎡((fp x).(fp_fr) x').(fr_R)⎤ -∗
+      T v ((fp x).(fp_fr) x').(fr_rty)))
+    | _ => False end
+    ⊢ typed_call Espec ge e (typed_val_expr e (λ v _, ⎡v ◁ᵥ l @ function_ptr fp⎤)) el tys T.
+  Proof.
+    rewrite /typed_exprs /typed_call.
+    destruct (typeof e) eqn: Hargty; try by iIntros "[]".
+    iIntros "HT" (f) "He".
+    iApply wp_call.
+    iApply "He".
+    iIntros (??) "Hty Hfp".
+    iDestruct "Hfp" as (? -> (b & Hl & Hb & Hwf)) "Hfp".
+    assert (typeof e = Tfunction (type_of_params (Clight.fn_params fn)) (fn_return fn) (fn_callconv fn)) as Hsig.
+    { rewrite Hargty /=.
+      admit. (* Clight does a runtime check that the function is being called at its
+                  declared type, which is awkward in this framework. *) }
+    rewrite Hargty in Hsig; inv Hsig.
+    iExists fn; iSplit.
+    { iPureIntro.
+      exists b; split3; auto; split; auto.
+      rewrite Hargty //. }
+    iApply "HT".
+    iIntros (??) "Hvl (-> & Hpre)".
+    iDestruct "Hpre" as (x) "(Hargs & Hpre & Hret)".
+    iStopProof.
+    split => rho; monPred.unseal.
+    rewrite !monPred_at_big_sepL2.
+    iIntros "(Hl & Hf & Htys & Hatys & HP & Hpost)".
+    iSplit. { admit. }
+    iIntros "!>" (?) "Hstack !>".
+    rewrite /typed_function.
+    iSpecialize ("Hf" $! x).
+    iDestruct "Hf" as %(? & Hf).
+(*    iSpecialize ("Hf" $! (Vector.of_list vl) with "[-]").
+    { iFrame.
+      iSplitL "Hatys".
+      { 
+iPoseProof (monPred_at_big_sepL rho with "Hatys") as "?".
+
+rewrite /Qinit.
+      admit. }*)
+
+(*    
+
+    iIntros "HT (%fn&->&He&Hfn) Htys" (Φ) "HΦ".
+    iDestruct ("HT" with "Htys") as "(%x&Hvl&HPa&Hr)".
+    iDestruct ("Hfn" $! x) as "[>%Hl #Hfn]".
+    iAssert ⌜Forall2 has_layout_val vl (f_args fn).*2⌝%I as %Hall. {
+      iClear "Hfn HPa Hr".
+      move: Hl. move: (fp_atys (fp x)) => atys Hl.
+      iInduction (fn.(f_args)) as [|[??]] "IH" forall (vl atys Hl).
+      { move: Hl => /Forall2_nil_inv_r ->. destruct vl => //=. }
+      move: Hl. intros (?&?&Heq&?&->)%Forall2_cons_inv_r.
+      destruct vl => //=. iDestruct "Hvl" as "[Hv Hvl]".
+      iDestruct ("IH" with "[//] He HΦ Hvl") as %?.
+      iDestruct (ty_size_eq with "Hv") as %?; [done|].
+      iPureIntro. constructor => //.
+    }
+    iApply (wp_call with "He") => //. { by apply val_to_of_loc. }
+    iIntros "!#" (lsa lsv Hly) "Ha Hv".
+    iDestruct (big_sepL2_length with "Ha") as %Hlen1.
+    iDestruct (big_sepL2_length with "Hv") as %Hlen2.
+    iDestruct (big_sepL2_length with "Hvl") as %Hlen3.
+    have [lsa' ?]: (∃ (ls : vec loc (length (fp_atys (fp x)))), lsa = ls) by rewrite -Hlen3 -Hlen1; eexists (list_to_vec _); symmetry; apply vec_to_list_to_vec. subst.
+    have [lsv' ?]: (∃ (ls : vec loc (length (f_local_vars fn))), lsv = ls) by rewrite -Hlen2; eexists (list_to_vec _); symmetry; apply vec_to_list_to_vec. subst.
+
+    iDestruct ("Hfn" $! lsa' lsv') as "#Hm". iClear "Hfn". unfold introduce_typed_stmt.
+    iExists _. iSplitR "Hr HΦ" => /=.
+    - iFrame. iApply ("Hm" with "[-]"). 2:{
+        iPureIntro. rewrite !app_length. f_equal => //. rewrite Hlen1 Hlen3. by eapply Forall2_length.
+      } iClear "Hm". iFrame.
+      move: Hlen1 Hly. move: (lsa' : list _) => lsa'' Hlen1 Hly. clear lsa' Hall.
+      move: Hlen3 Hl. move: (fp_atys (fp x)) => atys Hlen3 Hl.
+      move: Hly Hl. move: (f_args fn) => alys Hly Hl.
+      iInduction (vl) as [|v vl] "IH" forall (atys lsa'' alys Hlen1 Hly Hlen3 Hl).
+      { destruct atys, lsa'' => //. iSplitR => //. iApply (big_sepL2_mono with "Hv").
+        iIntros (?????) => /=. iDestruct 1 as (??) "[%?]".
+        iExists _. iFrame. by rewrite Forall_forall. }
+      destruct atys, lsa'' => //.
+      move: Hl => /(Forall2_cons_inv_l _ _)[[??][?[?[??]]]]; simplify_eq. csimpl in *.
+      move: Hly => /(Forall2_cons _ _ _ _)[??].
+      iDestruct "Hvl" as "[Hvl ?]".
+      iDestruct "Ha" as "[Ha ?]".
+      iDestruct (ty_ref with "[] Ha Hvl") as "$"; [done..|].
+      by iApply ("IH" with "[] [] [] [] [$] [$]").
+    - iIntros (v). iDestruct 1 as (x') "[Hv [Hls HPr]]".
+      iDestruct (big_sepL2_app_inv with "Hls") as "[$ $]".
+      { rewrite Hlen1 Hlen3. left. by eapply Forall2_length. }
+      iDestruct ("HPr" with "Hv") as (?) "[Hty [HR _]]".
+      iApply ("HΦ" with "Hty").
+      by iApply ("Hr" with "HR").
+  Qed.*) Admitted.
+  Definition type_call_fnptr_inst := [instance type_call_fnptr].
+(*  Global Existing Instance type_call_fnptr_inst. *)
+
+  Lemma subsume_fnptr_val_ex B v l1 l2 (fnty1 : dtfr A → fn_params) fnty2 `{!∀ x, ContainsEx (fnty2 x)} T:
+    (∃ x, <affine> ⌜l1 = l2 x⌝ ∗ <affine> ⌜fnty1 = fnty2 x⌝ ∗ T x)
+    ⊢ subsume (v ◁ᵥ l1 @ function_ptr fnty1) (λ x : B, v ◁ᵥ (l2 x) @ function_ptr (fnty2 x)) T.
+  Proof. iIntros "H".
+         iDestruct "H" as (x) "(% & (-> & ?))".
+         rewrite /subsume.
+         iIntros "H".
+         iExists x. rewrite H0. iFrame.
+  Qed.
+  Definition subsume_fnptr_val_ex_inst := [instance subsume_fnptr_val_ex].
+  Global Existing Instance subsume_fnptr_val_ex_inst | 5.
+
+  (* TODO: split this in an ex and no_ex variant as for values *)
+  Lemma subsume_fnptr_loc B l l1 l2  (fnty1 : dtfr A → fn_params) fnty2 T:
+    (∃ x, <affine> ⌜l1 = l2 x⌝ ∗ <affine> ⌜fnty1 = fnty2 x⌝ ∗ T x)
+      ⊢ subsume (l ◁ₗ l1 @ function_ptr fnty1) (λ x : B, l ◁ₗ (l2 x)  @ function_ptr (fnty2 x))  T .
+  Proof.
+    iIntros "H". iDestruct "H" as (x) "(% & (% & ?))".
+    iIntros "H". iExists x. rewrite H0 H. iFrame.
+  Qed.
+  Definition subsume_fnptr_loc_inst := [instance subsume_fnptr_loc].
+  Global Existing Instance subsume_fnptr_loc_inst | 5.
+End function.
+Arguments fn_ret_prop _ _ _ /.
+
+(* We need start a new section since the following rules use multiple different A. *)
+Section function_extra.
+  Context `{!typeG OK_ty Σ}.
+ 
+  (*
+  Lemma subsume_fnptr_no_ex A A1 A2 v l1 l2 (fnty1 : { A1 : TypeTree & (dtfr A1 → fn_params)%type}) (fnty2 : { A2 : TypeTree & (dtfr A2 → fn_params)%type})
+    `{!Inhabited A1} T:
+    subsume (v ◁ᵥ l1 @ function_ptr fnty1) (λ x : A, v ◁ᵥ (l2 x) @ function_ptr fnty2) T :-
+      and:
+      | drop_spatial;
+        ∀ a2,
+        (* We need to use an implication here since we don't have
+        access to the layouts of the function otherwise. If this is a
+        problem, we could also add the argument layouts as part of the
+        function pointer type. *)
+        exhale ⌜Forall2 (λ ty1 ty2,
+                    ∀ p, ty1.(ty_has_op_type) (UntypedOp p) MCNone →
+                         ty2.(ty_has_op_type) (UntypedOp p) MCNone)
+                  (fnty1 (inhabitant)).(fp_atys) (fnty2 a2).(fp_atys)⌝;
+        inhale (fp_Pa (fnty2 a2));
+        ls ← iterate: fp_atys (fnty2 a2) with [] {{ ty T ls,
+               ∀ l, inhale (l ◁ₗ ty); return T (ls ++ [l]) }};
+        ∃ a1,
+        exhale ⌜length (fp_atys (fnty1 a1)) = length (fp_atys (fnty2 a2))⌝%I;
+        iterate: zip ls (fp_atys (fnty1 a1)) {{ e T, exhale (e.1 ◁ₗ e.2); return T }};
+        exhale (fp_Pa (fnty1 a1));
+        ∀ ret1 ret_val,
+        inhale (ret_val ◁ᵥ fr_rty (fp_fr (fnty1 a1) ret1));
+        inhale (fr_R (fp_fr (fnty1 a1) ret1));
+        ∃ ret2,
+        exhale (ret_val ◁ᵥ fr_rty (fp_fr (fnty2 a2) ret2));
+        exhale (fr_R (fp_fr (fnty2 a2) ret2)); done
+      | ∃ x, exhale ⌜l1 = l2 x⌝; return T x.
+  Proof.
+    iIntros "(#Hsub & (%x & -> & HT))".
+    iIntros "(%fn & -> & #Hfn & #Htyp_f1)".
+    iExists x; iFrame. unfold function_ptr; simpl_type.
+    iExists fn; iSplit => //; iFrame "#"; iNext.
+    rewrite /typed_function. iIntros (a2).
+    iDestruct ("Htyp_f1" $! inhabitant) as "(%Hlayouts1 & _)".
+    iDestruct ("Hsub" $! a2) as "{Hsub} (%Hlayouts2 & Hsub)".
+    iSplit; [iPureIntro|iModIntro].
+    { move: Hlayouts1 Hlayouts2 => /Forall2_same_length_lookup[Hlen1 Hlookup1] /Forall2_same_length_lookup[Hlen2 Hlookup2] .
+      apply Forall2_same_length_lookup. split; [lia|].
+      move => i ty [name ly] ? Hlookup.
+      have Hlen := lookup_lt_Some _ _ _ Hlookup.
+      move: Hlen; rewrite -Hlen1 => /(lookup_lt_is_Some_2 _ _)[ty' Hty'].
+      apply: Hlookup2  => //.
+      by apply (Hlookup1 i _ (name, ly)).
+    }
+    iIntros (lsa lsv) "(Hargs & Hlocals & HP)".
+    iSpecialize ("Hsub" with "HP").
+    pose (INV := (λ i ls', ⌜ls' = take i lsa⌝ ∗
+      [∗ list] l;t ∈ drop i lsa;drop i (fp_atys (fnty2 a2)), l ◁ₗ t)%I).
+    iDestruct (iterate_elim1 INV with "Hsub [Hargs] [#]") as (ls') "((-> & ?) & (%a1 & %Hlen & Hsub))"; unfold INV; clear INV.
+    { rewrite take_0 !drop_0. by iFrame. }
+    { iIntros "!>" (i x2 ? ls' ?). iIntros "[-> Hinv] HT".
+      have [|??]:= lookup_lt_is_Some_2 lsa i. {
+        rewrite vec_to_list_length. by apply: lookup_lt_Some. }
+      erewrite drop_S; [|done]. erewrite (drop_S _ _ i); [|done] => /=.
+      iDestruct "Hinv" as "[Hl $]". iDestruct ("HT" with "[$]") as "HT". iExists _. iFrame.
+      by erewrite take_S_r.
+    }
+    pose (INV := (λ i,
+      [∗ list] l;t ∈ take i lsa;take i (fp_atys (fnty1 a1)), l ◁ₗ t)%I).
+    iDestruct (iterate_elim0 INV with "Hsub [] [#]") as "[Hinv [Hpre1 Hsub]]"; unfold INV; clear INV.
+    { by rewrite !take_0. } {
+      iIntros "!>" (i ? ? (?&?&?&Hvs&?)%lookup_zip_with_Some); simplify_eq/=.
+      iIntros "Hinv [? $]". rewrite lookup_take in Hvs.
+      2: { rewrite -Hlen. by apply: lookup_lt_Some. }
+      erewrite take_S_r; [|done]. erewrite take_S_r; [|done].
+      rewrite big_sepL2_snoc. iFrame.
+    }
+    rewrite -Hlen in lsa *.
+    iDestruct ("Htyp_f1" $! a1) as "{Htyp_f1} (_ & #Htyp_f1)".
+    iSpecialize ("Htyp_f1" $! lsa lsv).
+    rewrite !zip_with_length !take_ge ?vec_to_list_length; [|lia..].
+    iSpecialize ("Htyp_f1" with "[$]").
+    iApply (introduce_typed_stmt_wand with "Htyp_f1").
+    iIntros (v ty) "Hret1 Hty" => /=.
+    iDestruct ("Hret1" with "Hty") as "(%ret1 & Hty1 & Hpost1 & _)".
+    iDestruct ("Hsub" $! ret1 v with "Hty1 Hpost1") as "(%ret2 & Hty2 & Hpost2 & _)".
+    iExists ret2; iFrame.
+  Qed.
+  Definition subsume_fnptr_no_ex_inst := [instance subsume_fnptr_no_ex].
+  Global Existing Instance subsume_fnptr_no_ex_inst | 10.
+*)
+End function_extra.
+
+Notation "'fn(∀' x ':' A ';' T1 ',' .. ',' TN ';' Pa ')' '→' '∃' y ':' B ',' rty ';' Pr" :=
+  ((fun x => FP_wf (B:=B) (@cons type T1%I .. (@cons type TN%I (@nil type)) ..) Pa%I (λ y, mk_FR rty%I Pr%I)) : A → fn_params)
+  (at level 99, Pr at level 200, x pattern, y pattern,
+   format "'fn(∀'  x  ':'  A ';' '/'  T1 ','  .. ','  TN ';' '/'  Pa ')'  '→' '/'  '∃'  y  ':'  B ','  rty  ';'  Pr") : stdpp_scope.
+
+Notation "'fn(∀' x ':' A ';' Pa ')' '→' '∃' y ':' B ',' rty ';' Pr" :=
+  ((λ x, FP_wf (B:=B) (@nil type) Pa%I (λ y, mk_FR rty%I Pr%I)) : A → fn_params)
+  (at level 99, Pr at level 200, x pattern, y pattern,
+   format "'fn(∀'  x  ':'  A ';' '/'  Pa ')'  '→' '/'  '∃'  y  ':'  B ','  rty  ';'  Pr") : stdpp_scope.
+
+(*
+Global Typeclasses Opaque typed_function.
+Global Typeclasses Opaque function_ptr_type function_ptr.
+*)
+
+Section inline_function.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}. 
+
+  Program Definition inline_function_ptr_type (fn : funspec) (f : address) : type := {|
+    ty_has_op_type ot mt := (∃ t, ot = tptr t)%type;
+    ty_own β l := (<affine> ⌜field_compatible (tptr tvoid) [] l⌝ ∗
+                              l ↦_(tptr tvoid)[β] (adr2val f) ∗ func_ptr fn f)%I;
+    ty_own_val v := (<affine> ⌜v = adr2val f⌝ ∗ func_ptr fn f)%I;
+  |}.
+  Next Obligation. iDestruct 1 as "[% [H ?]]". iFrame.
+                   iMod (heap_mapsto_own_state_share with "[$H]") as "H". iFrame "H". done. Qed.
+  Next Obligation. iIntros (fn f ot mt l ?). destruct H as (t & ->).
+                   rewrite /has_layout_loc singleton.field_compatible_tptr.
+                   by iDestruct 1 as "(% & ?)". Qed.
+  Next Obligation. iIntros (fn f ot mt l ?). destruct H as (t & ->).
+                   iDestruct 1 as "(-> & _)". iPureIntro; intros ?; hnf; simple_if_tac; done. Qed.
+  Next Obligation. iIntros (fn f ot mt v ?). destruct H as (t & ->).
+                   iIntros "(% & (? & ?))".
+                   iExists f.
+                   rewrite /heap_mapsto_own_state. erewrite singleton.mapsto_tptr. by iFrame. Qed.
+  Next Obligation. iIntros (fn f ot mt l v ? ?) "? (% & ?)". destruct H as (t & ->).
+                   rewrite /heap_mapsto_own_state.
+                   erewrite singleton.mapsto_tptr. rewrite <- H1. iFrame.
+                   iPureIntro.
+                   by rewrite <- singleton.field_compatible_tptr. Qed.
+
+  Definition inline_function_ptr (fn : funspec) : rtype _ :=
+    RType (inline_function_ptr_type fn).
+
+  Global Program Instance copyable_inline_function_ptr p fn : Copyable (p @ inline_function_ptr fn).
+  Next Obligation.
+    iIntros (p fp E ly l ? (? & ->)). iDestruct 1 as "(%&Hl&?)".
+    iMod (heap_mapsto_own_state_to_mt with "Hl") as (q) "[_ Hl]" => //.
+    erewrite singleton.mapsto_tptr. iFrame. iModIntro. rewrite /has_layout_loc singleton.field_compatible_tptr. do 2 iSplit => //. by iIntros "_".
+  Qed.
+
+
+(*  Lemma type_call_inline_fnptr l v vl tys fn T:
+    (⌜Forall2 (λ ty '(_, p), ty.(ty_has_op_type) (UntypedOp p) MCNone) tys (f_args fn)⌝ ∗
+      foldr (λ '(v, ty) T lsa, ∀ l, l ◁ₗ ty -∗ T (lsa ++ [l]))
+      (λ lsa, foldr (λ ly T lsv, ∀ l, l ◁ₗ uninit ly -∗ T (lsv ++ [l]))
+                    (λ lsv,
+                     introduce_typed_stmt fn (lsa ++ lsv) T)
+                    fn.(f_local_vars).*2 [])
+      (zip vl tys)
+      [])
+    ⊢ typed_call v (v ◁ᵥ l @ inline_function_ptr fn) vl tys T.
+  Proof.
+    iIntros "[%Hl HT] (->&Hfn) Htys" (Φ) "HΦ".
+    iAssert ⌜Forall2 has_layout_val vl (f_args fn).*2⌝%I as %Hall. {
+      iClear "Hfn HT HΦ".
+      iInduction (fn.(f_args)) as [|[??]] "IH" forall (vl tys Hl).
+      { move: Hl => /Forall2_nil_inv_r ->. destruct vl => //=. }
+      move: Hl. intros (?&?&Heq&?&->)%Forall2_cons_inv_r.
+      destruct vl => //=. iDestruct "Htys" as "[Hv Hvl]".
+      iDestruct ("IH" with "[//] Hvl") as %?.
+      iDestruct (ty_size_eq with "Hv") as %?; [done|].
+      iPureIntro. constructor => //.
+    }
+    iApply (wp_call with "Hfn") => //. { by apply val_to_of_loc. }
+    iIntros "!#" (lsa lsv Hly) "Ha Hv".
+    iAssert ⌜length lsa = length (f_args fn)⌝%I as %Hlen1. {
+      iDestruct (big_sepL2_length with "Ha") as %->.
+      iPureIntro. move: Hall => /Forall2_length ->. by rewrite fmap_length.
+    }
+    iDestruct (big_sepL2_length with "Hv") as %Hlen2.
+    move: Hl Hall Hly. move: {1 2 3}(f_args fn) => alys Hl Hall Hly.
+    have : lsa = [] ++ lsa by done.
+    move: {1 5}([]) => lsr.
+    move: {1 3 4}(lsa) Hly => lsa' Hly Hr.
+    iInduction vl as [|v vl] "IH" forall (tys lsa' alys lsr Hr Hly Hl Hall) => /=. 2: {
+       iDestruct (big_sepL2_cons_inv_r with "Ha") as (???) "[Hmt ?]".
+       iDestruct (big_sepL2_cons_inv_l with "Htys") as (???) "[Hv' ?]". simplify_eq/=.
+       move: Hl => /(Forall2_cons_inv_l _ _ _ _)[[??][?[?[??]]]]. simplify_eq/=.
+       move: Hly => /(Forall2_cons _ _ _ _)[??].
+       move: Hall => /(Forall2_cons _ _ _ _)[??].
+       iDestruct (ty_ref with "[] Hmt Hv'") as "Hl"; [done..|].
+       iSpecialize ("HT" with "Hl").
+       iApply ("IH" with "[%] [//] [//] [//] HT [$] [$] [$] [$]").
+       by rewrite -app_assoc/=.
+    }
+    iDestruct (big_sepL2_nil_inv_r with "Ha") as %?. subst.
+    move: {1 2}(f_local_vars fn) => vlys.
+    have : lsv = [] ++ lsv by done.
+    move: {1 3}([]) => lvr.
+    move: {2 3}(lsv) => lsv' Hr.
+    iInduction lsv' as [|lv lsv'] "IH" forall (vlys lvr Hr) => /=. 2: {
+       iDestruct (big_sepL2_cons_inv_l with "Hv") as (???) "[(%x&%&%&Hl) ?]". simplify_eq/=.
+       iSpecialize ("HT" $! lv with "[Hl]"). { iExists _. iFrame. iPureIntro. split_and! => //. by apply: Forall_true. }
+       iApply ("IH" with "[%] HT [$] [$] [$] [$]").
+       by rewrite -app_assoc/=.
+    }
+    iDestruct (big_sepL2_nil_inv_l with "Hv") as %?. subst.
+    simplify_eq/=.
+    rewrite /introduce_typed_stmt !right_id_L.
+    iExists _. iSplitR "HΦ" => /=.
+    - iFrame. iApply ("HT" with "[-]"). iPureIntro. rewrite !app_length -Hlen1 -Hlen2 !app_length/=. lia.
+    - iIntros (v). iDestruct 1 as (x') "[Hv [Hls HPr]]".
+      iDestruct (big_sepL2_app_inv with "Hls") as "[$ $]".
+      { left. by rewrite -Hlen1 right_id_L.  }
+      by iApply ("HΦ" with "Hv HPr").
+  Qed.
+  Definition type_call_inline_fnptr_inst := [instance type_call_inline_fnptr].
+  Global Existing Instance type_call_inline_fnptr_inst.*)
+End inline_function.
+
+Global Typeclasses Opaque inline_function_ptr_type inline_function_ptr.
+
+(*** Tests *)
+Section test.
+  Context  `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  Local Definition test_fn := fn(∀ () : (); (uninit size_t); True) → ∃ () : (), void; True.
+  Local Definition test_fn2 := fn(∀ () : (); True) → ∃ () : (), void; True.
+  Local Definition test_fn3 := fn(∀ (n1, n2, n3, n4, n5, n6, n7) : Z * Z * Z * Z * Z * Z * Z; uninit size_t, uninit size_t, uninit size_t, uninit size_t, uninit size_t, uninit size_t, uninit size_t, uninit size_t; True ∗ True ∗ True ∗ True ∗ True ∗ True ∗ True ∗ True ∗ True ∗ True ∗ True ∗ True ∗ True) → ∃ (n1, n2, n3, n4, n5, n6, n7) : Z * Z * Z * Z * Z * Z * Z, uninit size_t; True%I.
+
+  Goal ∀ Espec ge (l : address) fn, l ◁ᵥ l @ function_ptr(A := ConstType _) Espec ge test_fn2 -∗ typed_function(A := ConstType _) Espec ge fn test_fn.
+  Abort.
+End test.
diff --git a/refinedVST/typing/globals.v b/refinedVST/typing/globals.v
new file mode 100644
index 0000000000..65ebcc1877
--- /dev/null
+++ b/refinedVST/typing/globals.v
@@ -0,0 +1,121 @@
+From VST.typing Require Export type.
+From VST.typing Require Import programs.
+From VST.typing Require Import type_options.
+
+Record global_type `{!typeG OK_ty Σ} {cs : compspecs} := GT {
+  gt_A : Type;
+  gt_type : gt_A → type;
+}.
+Arguments GT {_ _ _} _ _.
+
+Class globalG `{!typeG OK_ty Σ} {cs : compspecs} := {
+  global_locs : gmap string address;
+  global_initialized_types : gmap string global_type;
+}.
+Arguments globalG _ _ {_ _}.
+
+Section globals.
+  Context `{!typeG OK_ty Σ} {cs : compspecs} `{!globalG OK_ty Σ}.
+  Import EqNotations.
+
+  Definition global_with_type (name : string) (β : own_state) (ty : type) : iProp Σ :=
+    (∃ l, <affine> ⌜global_locs !! name = Some l⌝ ∗ l ◁ₗ{β} ty)%I.
+
+  (* A version of initialized that does not depend on globalG. This is
+  a work-around to allow the type of one global to refer to another as
+  long as there are no cycles (see t_adequacy). The proper solution
+  would be to use higher-order ghost state instead of globalG. *)
+  Definition initialized_raw {A} (name : string) (x : A) (l' : option address) (ty' : option global_type)  : iProp Σ :=
+    (∃ l ty, <affine> ⌜l' = Some l⌝ ∗ <affine> ⌜ty' = Some ty⌝ ∗
+          ∃ Heq : A = ty.(gt_A), l ◁ₗ{Shr} ty.(gt_type) (rew [λ x, x] Heq in x))%I.
+
+  Definition initialized {A} (name : string) (x : A) : iProp Σ :=
+    initialized_raw name x (global_locs !! name) (global_initialized_types !! name).
+
+  Global Instance initialized_persistent A name (x : A) : Persistent (initialized name x).
+  Proof. apply _. Qed.
+
+  Global Instance initialized_intro_persistent A name (x : A) `{!Affine (initialized name x)}:
+    IntroPersistent (initialized name x) (initialized name x).
+  Proof. constructor.
+         iIntros "H". 
+         iApply bi.intuitionistically_intro; try done.
+         apply _.
+  Qed.
+
+  Lemma simplify_global_with_type_hyp name β ty T:
+    (∀ l, <affine> ⌜global_locs !! name = Some l⌝ -∗ l ◁ₗ{β} ty -∗ T)
+    ⊢ simplify_hyp (global_with_type name β ty) T.
+  Proof. iIntros "HT". iDestruct 1 as (l) "(% & Hl)". by iApply "HT". Qed.
+  Definition simplify_global_with_type_hyp_inst :=
+    [instance simplify_global_with_type_hyp with 0%N].
+  Global Existing Instance simplify_global_with_type_hyp_inst.
+
+  Lemma simplify_global_with_type_goal name β ty l `{!TCFastDone (global_locs !! name = Some l)} T:
+    l ◁ₗ{β} ty ∗ T
+    ⊢ simplify_goal (global_with_type name β ty) T.
+  Proof. unfold TCFastDone in *. iIntros "[? $]". iExists _. by iFrame. Qed.
+  Definition simplify_global_with_type_goal_inst := [instance simplify_global_with_type_goal with 0%N].
+  Global Existing Instance simplify_global_with_type_goal_inst.
+
+  Lemma simplify_initialized_hyp A (x : A) name ty l
+    `{!TCFastDone (global_locs !! name = Some l)}
+    `{!TCFastDone (global_initialized_types !! name = Some ty)} T:
+    (∃ (Heq : A = ty.(gt_A)), l ◁ₗ{Shr} ty.(gt_type) (rew [λ x, x] Heq in x) -∗ T)
+    ⊢ simplify_hyp (initialized name x) T.
+  Proof.
+    unfold TCFastDone in *. iDestruct 1 as (?) "HT". iDestruct 1 as (l' ??? Heq2) "Hl". simplify_eq. iApply "HT" => /=.
+    (** HERE WE USE AXIOM K! *)
+    by rewrite (UIP_refl _ _ Heq2).
+  Qed.
+  Definition simplify_initialized_hyp_inst := [instance simplify_initialized_hyp with 0%N].
+  Global Existing Instance simplify_initialized_hyp_inst.
+
+  Lemma initialized_intro A ty name l (x : A) :
+    global_locs !! name = Some l →
+    global_initialized_types !! name = Some ty →
+    (∃ (Heq : A = ty.(gt_A)), l ◁ₗ{Shr} ty.(gt_type) (rew [λ x, x] Heq in x)) -∗
+    initialized name x.
+  Proof. iIntros (??) "Hl". iExists _, _. by iFrame. Qed.
+
+  Lemma simplify_initialized_goal A (x : A) name l ty
+    `{!TCFastDone (global_locs !! name = Some l)}
+    `{!TCFastDone (global_initialized_types !! name = Some ty)} T:
+    (∃ (Heq : A = ty.(gt_A)), l ◁ₗ{Shr} ty.(gt_type) (rew [λ x, x] Heq in x) ∗ T)
+    ⊢ simplify_goal (initialized name x) T.
+  Proof.
+    unfold TCFastDone in *. iIntros "[% [? $]]".
+    iApply initialized_intro; [done..|]. by iExists _.
+  Qed.
+  Definition simplify_initialized_goal_inst := [instance simplify_initialized_goal with 0%N].
+  Global Existing Instance simplify_initialized_goal_inst.
+
+
+  (** Subsumption *)
+  Definition FindInitialized (name : string) (A : Type) :=
+    {| fic_A := A; fic_Prop x := (initialized name x); |}.
+  Global Instance related_to_initialized B name A (x : B → A) :
+    RelatedTo (λ y : B, initialized name (x y)) :=
+    {| rt_fic := FindInitialized name A |}.
+
+  Lemma find_in_context_initialized name A T:
+    (∃ x, initialized name x ∗ T x)
+    ⊢ find_in_context (FindInitialized name A) T.
+  Proof. iDestruct 1 as (x) "[Hinit HT]". iExists _. iFrame. Qed.
+  Definition find_in_context_initialized_inst :=
+    [instance find_in_context_initialized with FICSyntactic].
+  Global Existing Instance find_in_context_initialized_inst | 1.
+
+  Lemma subsume_initialized B name A (x1 : A) x2 T:
+    (∃ y, <affine> ⌜x1 = x2 y⌝ ∗ T y)
+    ⊢ subsume (initialized name x1) (λ y : B, initialized name (x2 y)) T.
+  Proof. iIntros "H".
+         iDestruct "H" as (y) "(-> & H)".
+         iIntros "Hi". iExists _. iFrame. Qed.
+  Definition subsume_initialized_inst := [instance subsume_initialized].
+  Global Existing Instance subsume_initialized_inst.
+
+End globals.
+
+Global Typeclasses Opaque FindInitialized.
+Global Typeclasses Opaque initialized global_with_type.
diff --git a/refinedVST/typing/immovable.v b/refinedVST/typing/immovable.v
new file mode 100644
index 0000000000..61af8e3df2
--- /dev/null
+++ b/refinedVST/typing/immovable.v
@@ -0,0 +1,34 @@
+From VST.typing Require Export type.
+From VST.typing Require Import programs.
+From VST.typing Require Import type_options.
+
+Section immovable.
+  Context `{!typeG Σ} {cs: compspecs}.
+
+  Program Definition immovable (ty : address → type) : type := {|
+    ty_own q l := (ty l).(ty_own) q l;
+    ty_has_op_type _ _ := false;
+    ty_own_val _ := True;
+  |}.
+  Solve Obligations with try done.
+  Next Obligation. iIntros (????). by iApply ty_share. Qed.
+
+  Global Instance immovable_le : Proper (pointwise_relation address (⊑) ==> (⊑)) immovable.
+  Proof. solve_type_proper. Qed.
+  Global Instance immovable_proper : Proper (pointwise_relation address (≡) ==> (≡)) immovable.
+  Proof. solve_type_proper. Qed.
+
+  Lemma simplify_hyp_place_immovable l β ty T:
+    (l ◁ₗ{β} ty l -∗ T) ⊢ simplify_hyp (l◁ₗ{β} immovable ty) T.
+  Proof. iIntros "HT Hl". by iApply "HT". Qed.
+  Definition simplify_hyp_place_immovable_inst := [instance simplify_hyp_place_immovable with 0%N].
+  Global Existing Instance simplify_hyp_place_immovable_inst.
+
+  Lemma simplify_goal_place_immovable l β ty T:
+    (l ◁ₗ{β} ty l) ∗ T ⊢ simplify_goal (l◁ₗ{β} immovable ty) T.
+  Proof. iIntros "[$ $]". Qed.
+  Definition simplify_goal_place_immovable_inst := [instance simplify_goal_place_immovable with 0%N].
+  Global Existing Instance simplify_goal_place_immovable_inst.
+End immovable.
+
+Global Typeclasses Opaque immovable.
diff --git a/refinedVST/typing/int.v b/refinedVST/typing/int.v
new file mode 100644
index 0000000000..ba75f49532
--- /dev/null
+++ b/refinedVST/typing/int.v
@@ -0,0 +1,1019 @@
+From VST.typing Require Export type.
+From VST.typing Require Import programs boolean.
+From VST.typing Require Import type_options.
+
+Open Scope Z.
+
+Lemma bitsize_small : forall sz, sz ≠ I32 -> Z.pow 2 (bitsize_intsize sz) ≤ Int.half_modulus.
+Proof.
+  destruct sz; simpl; first [rep_lia | contradiction].
+Qed.
+
+Definition is_signed t :=
+  match t with
+  | Tint IBool _ _ => false (* no such thing as signed boolean *)
+  | Tint _ Signed _ | Tlong Signed _ => true
+  | _ => false
+  end.
+
+Definition min_int t :=
+  match t with
+  | Tint sz Signed _ => - Z.pow 2 (bitsize_intsize sz - 1)
+  | Tlong Signed _ => Int64.min_signed
+  | _ => 0
+  end.
+
+Definition int_size t :=
+  match t with
+  | Tint sz _ _ => bitsize_intsize sz
+  | Tlong _ _ => 64
+  | _ => 0
+  end.
+
+Lemma bitsize_wordsize : forall sz, bitsize_intsize sz <= Int.zwordsize.
+Proof.
+  destruct sz; simpl; rep_lia.
+Qed.
+
+(* assuming n ∈ it; see also https://gitlab.mpi-sws.org/iris/refinedc/-/blob/master/theories/caesium/lifting.v?ref_type=heads#L555 *)
+Definition int_arithop_sidecond (it : Ctypes.type) (n1 n2 n : Z) op : Prop :=
+  match op with
+  | Oshl => 0 ≤ n2 < int_size it ∧ 0 ≤ n1
+  | Oshr => 0 ≤ n2 < int_size it ∧ 0 ≤ n1 (* Result of shifting negative numbers is implementation defined. *)
+  | Odiv => n2 ≠ 0
+  | Omod => n2 ≠ 0 ∧ ¬(n1 = min_int it ∧ n2 = -1)(* divergence from Caesium: according to https://en.cppreference.com/w/c/language/operator_arithmetic,
+                               INT_MIN%-1 is undefined *)
+  | _     => True
+  end.
+
+Lemma testbit_add_over: forall x n m, 0 <= n < m ->
+  Z.testbit (x + 2^m) n = Z.testbit x n.
+Proof.
+  intros.
+  rewrite !Z.testbit_eqb; [|lia..].
+  replace m with ((m - n) + n) by lia.
+  rewrite Z.pow_add_r; [|lia..].
+  rewrite Z.div_add; last lia.
+  rewrite Z.add_mod // Zpow_facts.Zpower_mod // Z_mod_same_full Zplus_mod_idemp_l Z.pow_0_l; lia.
+Qed.
+
+Lemma testbit_unsigned_signed: forall x n, 0 <= n < Z.of_nat Int.wordsize ->
+  Z.testbit (Int.unsigned x) n = Z.testbit (Int.signed x) n.
+Proof.
+  intros.
+  rewrite Int.unsigned_signed /Int.lt; if_tac; last done.
+  rewrite /Int.modulus two_power_nat_equiv testbit_add_over //.
+Qed.
+
+Lemma testbit_unsigned_signed_64: forall x n, 0 <= n < Z.of_nat Int64.wordsize ->
+  Z.testbit (Int64.unsigned x) n = Z.testbit (Int64.signed x) n.
+Proof.
+  intros.
+  rewrite Int64.unsigned_signed /Int64.lt; if_tac; last done.
+  rewrite /Int64.modulus two_power_nat_equiv testbit_add_over //.
+Qed.
+
+Lemma and_signed:
+  forall x y, Int.and x y = Int.repr (Z.land (Int.signed x) (Int.signed y)).
+Proof.
+  intros; unfold Int.and. apply Int.eqm_samerepr, Zbits.eqmod_same_bits; intros.
+  rewrite !Z.land_spec !testbit_unsigned_signed //.
+Qed.
+
+Lemma or_signed:
+  forall x y, Int.or x y = Int.repr (Z.lor (Int.signed x) (Int.signed y)).
+Proof.
+  intros; unfold Int.or. apply Int.eqm_samerepr, Zbits.eqmod_same_bits; intros.
+  rewrite !Z.lor_spec !testbit_unsigned_signed //.
+Qed.
+
+Lemma xor_signed:
+  forall x y, Int.xor x y = Int.repr (Z.lxor (Int.signed x) (Int.signed y)).
+Proof.
+  intros; unfold Int.xor. apply Int.eqm_samerepr, Zbits.eqmod_same_bits; intros.
+  rewrite !Z.lxor_spec !testbit_unsigned_signed //.
+Qed.
+
+Lemma and_signed_64:
+  forall x y, Int64.and x y = Int64.repr (Z.land (Int64.signed x) (Int64.signed y)).
+Proof.
+  intros; unfold Int64.and. apply Int64.eqm_samerepr, Zbits.eqmod_same_bits; intros.
+  rewrite !Z.land_spec !testbit_unsigned_signed_64 //.
+Qed.
+
+Lemma or_signed_64:
+  forall x y, Int64.or x y = Int64.repr (Z.lor (Int64.signed x) (Int64.signed y)).
+Proof.
+  intros; unfold Int64.or. apply Int64.eqm_samerepr, Zbits.eqmod_same_bits; intros.
+  rewrite !Z.lor_spec !testbit_unsigned_signed_64 //.
+Qed.
+
+Lemma xor_signed_64:
+  forall x y, Int64.xor x y = Int64.repr (Z.lxor (Int64.signed x) (Int64.signed y)).
+Proof.
+  intros; unfold Int64.xor. apply Int64.eqm_samerepr, Zbits.eqmod_same_bits; intros.
+  rewrite !Z.lxor_spec !testbit_unsigned_signed_64 //.
+Qed.
+
+Section int.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  (* Separate definition such that we can make it typeclasses opaque
+  later. We cannot call it int_type since that already exists.  *)
+  Program Definition int_inner_type (it : Ctypes.type) (n : Z) : type := {|
+    ty_has_op_type ot mt := (*is_bool_ot ot it stn*) ot = it;
+    ty_own β l := ∃ v, <affine> ⌜tc_val it v⌝ ∗ <affine> ⌜val_to_Z v it = Some n⌝ ∗ <affine> ⌜l `has_layout_loc` it⌝ ∗ l ↦_it[β] v;
+    ty_own_val v := <affine> ⌜tc_val it v ∧ val_to_Z v it = Some n⌝;
+  |}%I.
+  Next Obligation.
+    iIntros (it n l ??) "(%v&%&%Hv&%Hl&H)". iExists v.
+    by iMod (heap_mapsto_own_state_share with "H") as "$".
+  Qed.
+  Next Obligation. iIntros (????? ->) "(%&%&%&$&_)". Qed.
+  Next Obligation. iIntros (????? -> (? & ?)). rewrite /has_layout_val /tc_val'; done. Qed.
+  Next Obligation. iIntros (????? ->) "(%v&%&%&%&Hl)". eauto with iFrame. Qed.
+  Next Obligation. iIntros (????? v -> ?) "Hl (% & %)". iExists v. eauto with iFrame. Qed.
+(*   Next Obligation. iIntros (???????). apply: mem_cast_compat_int; [naive_solver|]. iPureIntro. naive_solver. Qed. *)
+
+  Definition int (it : Ctypes.type) : rtype _ := RType (int_inner_type it).
+
+(*   Lemma int_loc_in_bounds l β n it:
+     l ◁ₗ{β} n @ int it -∗ loc_in_bounds l (bytes_per_int it).
+  Proof.
+    iIntros "(%&%Hv&%&Hl)". move: Hv => /val_to_Z_length <-.
+    by iApply heap_mapsto_own_state_loc_in_bounds.
+  Qed.
+  Global Instance loc_in_bounds_int n it β: LocInBounds (n @ int it) β (bytes_per_int it).
+  Proof.
+    constructor. iIntros (l) "Hl".
+    iDestruct (int_loc_in_bounds with "Hl") as "Hlib".
+    iApply loc_in_bounds_shorten; last done. lia.
+  Qed.
+
+  Global Instance alloc_alive_int n it β: AllocAlive (n @ int it) β True.
+  Proof.
+    constructor. iIntros (l ?) "(%&%&%&Hl)".
+    iApply (heap_mapsto_own_state_alloc with "Hl").
+    erewrite val_to_Z_length; [|done]. have := bytes_per_int_gt_0 it. lia.
+  Qed.
+
+  Global Program Instance learn_align_int β it n
+    : LearnAlignment β (n @ int it) (Some (ly_align it)).
+  Next Obligation. by iIntros (β it n ?) "(%&%&%&?)". Qed. *)
+
+  Lemma ty_own_int_in_range l β n it : l ◁ₗ{β} n @ int it -∗ ⌜n ∈ it⌝.
+  Proof.
+    iIntros "Hl". destruct β.
+    - iDestruct (ty_deref _ _ MCNone with "Hl") as (?) "[_ (% & %)]"; [done|].
+      iPureIntro. by eapply val_to_Z_in_range.
+    - iDestruct "Hl" as (?) "(% & % & _)".
+      iPureIntro. by eapply val_to_Z_in_range.
+  Qed.
+
+  (* TODO: make a simple type as in lambda rust such that we do not
+  have to reprove this everytime? *)
+  Global Program Instance int_copyable x it : Copyable (x @ int it).
+  Next Obligation.
+    iIntros (???????) "(%v&%Hv&%&%Hl&Hl)".
+    simpl in *; subst.
+    iMod (heap_mapsto_own_state_to_mt with "Hl") as (q) "[_ Hl]" => //.
+    iSplitR => //. iExists q, v. iFrame. iModIntro. eauto with iFrame.
+  Qed.
+
+  Global Instance int_timeless l z it:
+    Timeless (l ◁ₗ z @ int it)%I.
+  Proof. Admitted.
+End int.
+(* Typeclasses Opaque int. *)
+Notation "int< it >" := (int it) (only printing, format "'int<' it '>'") : printing_sugar.
+
+Definition unsigned_op sz sg :=
+  match sz, sg with
+  | I32, Unsigned => true
+  | _, _ => false
+  end.
+
+Definition int_lt it v1 v2 :=
+  match it, v1, v2 with
+  | Tint I32 Unsigned _, Vint i1, Vint i2 => Int.ltu i1 i2
+  | Tint _ _ _, Vint i1, Vint i2 => Int.lt i1 i2
+  | Tlong Unsigned _, Vlong i1, Vlong i2 => Int64.ltu i1 i2
+  | Tlong Signed _, Vlong i1, Vlong i2 => Int64.lt i1 i2
+  | _, _, _ => false
+  end.
+
+Section programs.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  (*** int *)
+  Lemma type_val_int n it T :
+    typed_value (i2v n it) T :-
+      exhale (<affine> ⌜n ∈ it⌝);
+      return T (n @ (int it)).
+  Proof.
+    iIntros "[%Hn HT]".
+    iExists _. iFrame. iPureIntro.
+    split; [by apply in_range_i2v | by apply i2v_to_Z].
+  Qed.
+  Definition type_val_int_inst := [instance type_val_int].
+  Global Existing Instance type_val_int_inst.
+
+  Lemma type_val_int_i32 (n:Integers.int) T :
+    typed_value (Vint n) T :-
+      exhale (<affine> ⌜(Int.signed n) ∈ tint⌝);
+      return T ((Int.signed n) @ (int tint)).
+  Proof.
+    iIntros "[%Hn HT]".
+    iExists _. iFrame. by iPureIntro.
+  Qed.
+  Definition type_val_int_i32_inst := [instance type_val_int_i32].
+  Global Existing Instance type_val_int_i32_inst.
+
+  Lemma Int_modulus_Z_pow_pos : Int.modulus = Z.pow_pos 2 32.
+  Proof.
+    rep_lia.
+  Qed.
+
+  (** Ke: TODO this rule should have a different triggering condition *)
+  (* Lemma type_val_int_u32 (n:Integers.int) T :
+    typed_value (Vint n) T :-
+      exhale (<affine> ⌜(Int.unsigned n) ∈ tuint⌝);
+      return T ((Int.unsigned n) @ (int tuint)).
+  Proof.
+    iIntros "[%Hn HT]".
+    iExists _. iFrame.  iPureIntro. simpl.
+    rewrite -Int_modulus_Z_pow_pos.
+    pose proof (Int.unsigned_range n).
+    erewrite zlt_true. -done. - lia.
+  Qed.
+
+  Definition type_val_int_u32_inst := [instance type_val_int_u32].
+  Global Existing Instance type_val_int_u32_inst. *)
+
+  (* TODO: instead of adding it_in_range to the context here, have a
+  SimplifyPlace/Val instance for int which adds it to the context if
+  it does not yet exist (using check_hyp_not_exists)?! *)
+  Lemma type_relop_int_int n1 n2 op b it v1 v2 T :
+    match op with
+    | Cop.Oeq => Some (bool_decide (n1 = n2))
+    | Cop.One => Some (bool_decide (n1 ≠ n2))
+    | Cop.Olt => Some (bool_decide (n1 < n2))
+    | Cop.Ogt => Some (bool_decide (n1 > n2))
+    | Cop.Ole => Some (bool_decide (n1 <= n2))
+    | Cop.Oge => Some (bool_decide (n1 >= n2))
+    | _ => None
+    end = Some b →
+    (⌜n1 ∈ it⌝ -∗ ⌜n2 ∈ it⌝ -∗ T (i2v (bool_to_Z b) tint) (b @ boolean tint))
+    ⊢ typed_bin_op v1 ⎡v1 ◁ᵥ n1 @ int it⎤ v2 ⎡v2 ◁ᵥ n2 @ int it⎤ op it it T.
+  Proof.
+    iIntros "%Hop HT (% & %Hv1) (% & %Hv2) %Φ HΦ".
+    iDestruct ("HT" with "[] []" ) as "HT".
+    1-2: iPureIntro; by apply: val_to_Z_in_range.
+    rewrite /wp_binop.
+    iIntros "!>" (?) "$ !>".
+    iExists (i2v (bool_to_Z b) tint); iSplit.
+    - iStopProof; split => rho; monPred.unseal.
+      apply bi.pure_intro.
+      assert (classify_cmp it it = cmp_default) as Hclass.
+      { destruct it; try by destruct v1.
+        by destruct i. }
+      rewrite -val_of_bool_eq.
+      destruct op; inv Hop; rewrite /= /Cop.sem_cmp Hclass /Cop.sem_binarith (* Heq *).
+      + assert (bool_decide (n1 = n2) = int_eq v1 v2) as ->.
+        { destruct it, v1; try done; destruct v2; try done; simpl in *.
+          * pose proof (Int.eq_spec i0 i1) as Heq.
+            destruct (Int.eq i0 i1).
+            -- subst; destruct s; inv Hv1; case_bool_decide; simpl in *; congruence.
+            -- destruct s; inv Hv1; case_bool_decide; try done.
+               ++ exploit (signed_inj i0 i1); congruence.
+               ++ exploit (unsigned_eq_eq i0 i1); congruence.
+          * pose proof (Int64.eq_spec i i0) as Heq.
+            destruct (Int64.eq i i0).
+            -- subst; destruct s; inv Hv1; case_bool_decide; simpl in *; congruence.
+            -- destruct s; inv Hv1; case_bool_decide; try done;
+                 by (exploit (signed_inj_64 i i0); congruence || exploit (unsigned_inj_64 i i0); congruence). }
+        destruct it; try by destruct v1; simpl.
+        * destruct i, v1; try done; destruct v2; try done; destruct s; done.
+        * destruct v1; try done; destruct v2; try done; destruct s; done.
+      + assert (bool_decide (n1 ≠ n2) = negb (int_eq v1 v2)) as ->.
+        { destruct it, v1; try done; destruct v2; try done; simpl in *.
+          * pose proof (Int.eq_spec i0 i1) as Heq.
+            destruct (Int.eq i0 i1).
+            -- subst; destruct s; inv Hv1; case_bool_decide; simpl in *; congruence.
+            -- destruct s; inv Hv1; case_bool_decide; try done.
+               ++ exploit (signed_inj i0 i1); congruence.
+               ++ exploit (unsigned_eq_eq i0 i1); congruence.
+          * pose proof (Int64.eq_spec i i0) as Heq.
+            destruct (Int64.eq i i0).
+            -- subst; destruct s; inv Hv1; case_bool_decide; simpl in *; congruence.
+            -- destruct s; inv Hv1; case_bool_decide; try done;
+                 by (exploit (signed_inj_64 i i0); congruence || exploit (unsigned_inj_64 i i0); congruence). }
+        destruct it; try by destruct v1; simpl.
+        * destruct i, v1; try done; destruct v2; try done; destruct s; done.
+        * destruct v1; try done; destruct v2; try done; destruct s; done.
+      + assert (bool_decide (n1 < n2) = int_lt it v1 v2) as ->.
+        { destruct it, v1; try done; destruct v2; try done; simpl in *.
+          * destruct (unsigned_op i s) eqn: Hs.
+            -- destruct i; try done; destruct s; inv Hv1.
+               rewrite /Int.ltu; if_tac; case_bool_decide; done.
+            -- trans (Int.lt i0 i1); last by destruct i, s.
+               destruct s; inv Hv1; rewrite /Int.lt; try by if_tac; case_bool_decide.
+               lapply (bitsize_small i); last by intros ->.
+               intros; rewrite !Int.signed_eq_unsigned; [if_tac; case_bool_decide; done | destruct i; try done; try rep_lia..].
+               { destruct H0; subst; [rewrite Int.unsigned_zero | rewrite Int.unsigned_one]; rep_lia. }
+               { destruct H; subst; [rewrite Int.unsigned_zero | rewrite Int.unsigned_one]; rep_lia. }
+          * destruct s; inv Hv1.
+            -- rewrite /Int64.lt; if_tac; case_bool_decide; done.
+            -- rewrite /Int64.ltu; if_tac; case_bool_decide; done. }
+        destruct it; try by destruct v1; simpl.
+        * destruct i, v1; try done; destruct v2; try done; destruct s; done.
+        * destruct v1; try done; destruct v2; try done; destruct s; done.
+      + assert (bool_decide (n1 > n2) = int_lt it v2 v1) as ->.
+        { destruct it, v1; try done; destruct v2; try done; simpl in *.
+          * destruct (unsigned_op i s) eqn: Hs.
+            -- destruct i; try done; destruct s; inv Hv1.
+               rewrite /Int.ltu; if_tac; case_bool_decide; lia.
+            -- trans (Int.lt i1 i0); last by destruct i, s.
+               destruct s; inv Hv1; rewrite /Int.lt; try by if_tac; case_bool_decide; lia.
+               lapply (bitsize_small i); last by intros ->.
+               intros; rewrite !Int.signed_eq_unsigned; [if_tac; case_bool_decide; lia | destruct i; try done; try rep_lia..].
+               { destruct H; subst; [rewrite Int.unsigned_zero | rewrite Int.unsigned_one]; rep_lia. }
+               { destruct H0; subst; [rewrite Int.unsigned_zero | rewrite Int.unsigned_one]; rep_lia. }
+          * destruct s; inv Hv1.
+            -- rewrite /Int64.lt; if_tac; case_bool_decide; lia.
+            -- rewrite /Int64.ltu; if_tac; case_bool_decide; lia. }
+        destruct it; try by destruct v1; simpl.
+        * destruct i, v1; try done; destruct v2; try done; destruct s; done.
+        * destruct v1; try done; destruct v2; try done; destruct s; done.
+      + assert (bool_decide (n1 ≤ n2) = negb (int_lt it v2 v1)) as ->.
+        { destruct it, v1; try done; destruct v2; try done; simpl in *.
+          * destruct (unsigned_op i s) eqn: Hs.
+            -- destruct i; try done; destruct s; inv Hv1.
+               rewrite /Int.ltu; if_tac; case_bool_decide; lia.
+            -- trans (negb (Int.lt i1 i0)); last by destruct i, s.
+               destruct s; inv Hv1; rewrite /Int.lt; try by if_tac; case_bool_decide; lia.
+               lapply (bitsize_small i); last by intros ->.
+               intros; rewrite !Int.signed_eq_unsigned; [if_tac; case_bool_decide; lia | destruct i; try done; try rep_lia..].
+               { destruct H; subst; [rewrite Int.unsigned_zero | rewrite Int.unsigned_one]; rep_lia. }
+               { destruct H0; subst; [rewrite Int.unsigned_zero | rewrite Int.unsigned_one]; rep_lia. }
+          * destruct s; inv Hv1.
+            -- rewrite /Int64.lt; if_tac; case_bool_decide; lia.
+            -- rewrite /Int64.ltu; if_tac; case_bool_decide; lia. }
+        destruct it; try by destruct v1; simpl.
+        * destruct i, v1; try done; destruct v2; try done; destruct s; done.
+        * destruct v1; try done; destruct v2; try done; destruct s; done.
+      + assert (bool_decide (n1 >= n2) = negb (int_lt it v1 v2)) as ->.
+        { destruct it, v1; try done; destruct v2; try done; simpl in *.
+          * destruct (unsigned_op i s) eqn: Hs.
+            -- destruct i; try done; destruct s; inv Hv1.
+               rewrite /Int.ltu; if_tac; case_bool_decide; lia.
+            -- trans (negb (Int.lt i0 i1)); last by destruct i, s.
+               destruct s; inv Hv1; rewrite /Int.lt; try by if_tac; case_bool_decide; lia.
+               lapply (bitsize_small i); last by intros ->.
+               intros; rewrite !Int.signed_eq_unsigned; [if_tac; case_bool_decide; lia | destruct i; try done; try rep_lia..].
+               { destruct H0; subst; [rewrite Int.unsigned_zero | rewrite Int.unsigned_one]; rep_lia. }
+               { destruct H; subst; [rewrite Int.unsigned_zero | rewrite Int.unsigned_one]; rep_lia. }
+          * destruct s; inv Hv1.
+            -- rewrite /Int64.lt; if_tac; case_bool_decide; lia.
+            -- rewrite /Int64.ltu; if_tac; case_bool_decide; lia. }
+        destruct it; try by destruct v1; simpl.
+        * destruct i, v1; try done; destruct v2; try done; destruct s; done.
+        * destruct v1; try done; destruct v2; try done; destruct s; done.
+    - iApply "HΦ"; last done. iExists (bool_to_Z b).
+      iSplit; [by destruct b | done].
+  Qed.
+
+  Definition type_eq_int_int_inst n1 n2 :=
+    [instance type_relop_int_int n1 n2 Cop.Oeq (bool_decide (n1 = n2))].
+  Global Existing Instance type_eq_int_int_inst.
+  Definition type_ne_int_int_inst n1 n2 :=
+    [instance type_relop_int_int n1 n2 Cop.One (bool_decide (n1 ≠ n2))].
+  Global Existing Instance type_ne_int_int_inst.
+  Definition type_lt_int_int_inst n1 n2 :=
+    [instance type_relop_int_int n1 n2 Cop.Olt (bool_decide (n1 < n2))].
+  Global Existing Instance type_lt_int_int_inst.
+  Definition type_gt_int_int_inst n1 n2 :=
+    [instance type_relop_int_int n1 n2 Cop.Ogt (bool_decide (n1 > n2))].
+  Global Existing Instance type_gt_int_int_inst.
+  Definition type_le_int_int_inst n1 n2 :=
+    [instance type_relop_int_int n1 n2 Cop.Ole (bool_decide (n1 ≤ n2))].
+  Global Existing Instance type_le_int_int_inst.
+  Definition type_ge_int_int_inst n1 n2 :=
+    [instance type_relop_int_int n1 n2 Cop.Oge (bool_decide (n1 >= n2))].
+  Global Existing Instance type_ge_int_int_inst.
+
+  Lemma type_arithop_int_int n1 n2 n op it v1 v2
+    (Hop : match op with
+    | Oadd => Some (n1 + n2)
+    | Osub => Some (n1 - n2)
+    | Omul => Some (n1 * n2)
+    | Odiv => Some (n1 `quot` n2)
+    | Omod => Some (n1 `rem` n2)
+    | Oand => Some (Z.land n1 n2)
+    | Oor => Some (Z.lor n1 n2)
+    | Oxor => Some (Z.lxor n1 n2)
+    | Oshl => Some (n1 ≪ n2)
+    | Oshr => Some (n1 ≫ n2)
+    | _ => None
+    end = Some n) T :
+    (<affine> ⌜n1 ∈ it⌝ -∗ <affine> ⌜n2 ∈ it⌝ -∗ <affine> ⌜in_range n it ∧ int_arithop_sidecond it n1 n2 n op⌝ ∗ T (i2v n it) (n @ int it))
+    ⊢ typed_bin_op v1 ⎡v1 ◁ᵥ n1 @ int it⎤ v2 ⎡v2 ◁ᵥ n2 @ int it⎤ op it it T.
+  Proof.
+    iIntros "HT (% & %Hv1) (% & %Hv2) %Φ HΦ".
+    iDestruct ("HT" with "[] []" ) as ((Hin & Hsc)) "HT".
+    1-2: iPureIntro; by apply: val_to_Z_in_range.
+    rewrite /wp_binop.
+    iIntros "!>" (?) "$ !>".
+    iExists (i2v n it); iSplit.
+    - iStopProof; split => rho; monPred.unseal.
+      apply bi.pure_intro.
+      destruct op; inv Hop; rewrite /=.
+      + rewrite /Cop.sem_add.
+        replace (classify_add it it) with add_default by (destruct it; try done; destruct i; done).
+        rewrite /Cop.sem_binarith; destruct it, v1; try done; destruct v2; try done.
+        * destruct (unsigned_op i s) eqn: Hs.
+          -- destruct i; try done; destruct s; try done; simpl in *.
+             by inv Hv1.
+          -- replace (classify_binarith _ _) with (bin_case_i Signed) by (destruct i, s; done); simpl in *.
+             change Archi.ptr64 with true.
+             destruct s.
+             ++ inv Hv1.
+                rewrite Int.add_signed //.
+             ++ by inv Hv1.
+        * rewrite /Cop.sem_cast /=.
+          destruct s; simpl in *; inv Hv1.
+          -- change Archi.ptr64 with true.
+             rewrite /= Int64.add_signed //.
+          -- done.
+      + rewrite /Cop.sem_sub.
+        replace (classify_sub it it) with sub_default by (destruct it, v1; try done; destruct i; done).
+        rewrite /Cop.sem_binarith; destruct it, v1; try done; destruct v2; try done.
+        * destruct (unsigned_op i s) eqn: Hs.
+          -- destruct i; try done; destruct s; try done; simpl in *.
+             by inv Hv1.
+          -- replace (classify_binarith _ _) with (bin_case_i Signed) by (destruct i, s; done); simpl in *.
+             destruct s.
+             ++ inv Hv1.
+                change Archi.ptr64 with true.
+                rewrite /= Int.sub_signed //.
+             ++ by inv Hv1.
+        * rewrite /Cop.sem_cast /=.
+          destruct s; simpl in *; inv Hv1.
+          -- change Archi.ptr64 with true.
+             rewrite /= Int64.sub_signed //.
+          -- done.
+      + rewrite /Cop.sem_mul /Cop.sem_binarith; destruct it, v1; try done; destruct v2; try done.
+        * destruct (unsigned_op i s) eqn: Hs.
+          -- destruct i; try done; destruct s; try done; simpl in *.
+             by inv Hv1.
+          -- replace (classify_binarith _ _) with (bin_case_i Signed) by (destruct i, s; done); simpl in *.
+             destruct s.
+             ++ inv Hv1.
+                change Archi.ptr64 with true.
+                rewrite /= Int.mul_signed //.
+             ++ by inv Hv1.
+        * rewrite /Cop.sem_cast /=.
+          destruct s; simpl in *; inv Hv1.
+          -- change Archi.ptr64 with true.
+             rewrite /= Int64.mul_signed //.
+          -- done.
+      + rewrite /Cop.sem_div /Cop.sem_binarith; destruct it, v1; try done; destruct v2; try done.
+        * destruct (unsigned_op i s) eqn: Hs.
+          -- destruct i; try done; destruct s; try done; simpl in *.
+             inv Hv1.
+             change Archi.ptr64 with true.
+             rewrite /Int.eq; if_tac.
+             { rewrite Int.unsigned_zero in H1; tauto. }
+             rewrite /Int.divu Zquot.Zquot_Zdiv_pos //; rep_lia.
+          -- replace (classify_binarith _ _) with (bin_case_i Signed) by (destruct i, s; done); simpl in *.
+             change Archi.ptr64 with true.
+             rewrite /= /Int.eq; if_tac; simpl.
+             { apply unsigned_eq_eq in H1; subst; rewrite Int.signed_zero Int.unsigned_zero in Hv2.
+               destruct s; inv Hv2; tauto. }
+             destruct (_ && _) eqn: Hm.
+             { repeat (if_tac in Hm; try done).
+               apply unsigned_eq_eq in H2; apply unsigned_eq_eq in H3; subst.
+               destruct s.
+               ** inv Hv1. contradict Hin. rewrite Int.signed_mone Int.signed_repr; pose proof (bitsize_half_max i); destruct i; rep_lia.
+               ** rewrite Int.unsigned_mone in Hv2; inv Hv2.
+                lapply (bitsize_small i); last by intros ->. intros; destruct i; try done.
+                destruct H0; done.
+                }
+             destruct s.
+             ++ inv Hv1; done.
+             ++ inv Hv1.
+                rewrite /Int.divs.
+                lapply (bitsize_small i); last by intros ->. intros.
+                rewrite !Int.signed_eq_unsigned //; destruct i; try done; try rep_lia.
+                { destruct H0; subst; computable. }
+                { destruct H; subst; computable. }
+        * rewrite /Cop.sem_cast /=.
+          destruct s; simpl in *; inv Hv1; change Archi.ptr64 with true; simpl.
+          -- rewrite /Int64.eq; if_tac.
+             { apply unsigned_inj_64 in H1; subst; rewrite Int64.signed_zero in Hsc; tauto. }
+             destruct (_ && _) eqn: Hm.
+             { repeat (if_tac in Hm; try done).
+               apply unsigned_inj_64 in H3; apply unsigned_inj_64 in H2; subst.
+               inv Hin. }
+             done.
+          -- rewrite /Int64.eq; if_tac.
+             { apply unsigned_inj_64 in H1; subst; rewrite Int64.unsigned_zero in Hsc; tauto. }
+             rewrite /Int.divu Zquot.Zquot_Zdiv_pos //; rep_lia.
+      + rewrite /Cop.sem_mod /Cop.sem_binarith; destruct it, v1; try done; destruct v2; try done.
+        * destruct (unsigned_op i s) eqn: Hs.
+          -- destruct i; try done; destruct s; try done; simpl in *.
+             inv Hv1.
+             change Archi.ptr64 with true.
+             rewrite /= /Int.eq; if_tac.
+             { rewrite Int.unsigned_zero in H1; tauto. }
+             rewrite /Int.modu Zquot.Zrem_Zmod_pos //; rep_lia.
+          -- replace (classify_binarith _ _) with (bin_case_i Signed) by (destruct i, s; done); simpl in *.
+             change Archi.ptr64 with true.
+             rewrite /= /Int.eq; if_tac; simpl.
+             { apply unsigned_eq_eq in H1; subst; rewrite Int.signed_zero Int.unsigned_zero in Hv2.
+               destruct s; inv Hv2; tauto. }
+             destruct (_ && _) eqn: Hm.
+             { repeat (if_tac in Hm; try done).
+               apply unsigned_eq_eq in H3; apply unsigned_eq_eq in H2; subst.
+               destruct s.
+               ** inv Hv1. rewrite Int.signed_mone Int.signed_repr // in Hsc.
+                  rewrite Int.signed_repr // in H.
+                  destruct i.
+                  { rep_lia. }
+                  { rewrite two_power_pos_equiv in H; rep_lia. }
+                  { tauto. }
+                  { by destruct H. }
+               ** rewrite Int.unsigned_mone in Hv2; inv Hv2.
+                  lapply (bitsize_small i); last by intros ->. intros; destruct i; try done; try rep_lia.
+                  destruct H0; done. }
+             destruct s.
+             ++ inv Hv1; done.
+             ++ inv Hv1.
+                rewrite /Int.mods.
+                lapply (bitsize_small i); last by intros ->. intros.
+                rewrite !Int.signed_eq_unsigned //; destruct i; try done; try rep_lia.
+                { destruct H0; subst; computable. }
+                { destruct H; subst; computable. }
+        * rewrite /Cop.sem_cast /=.
+          destruct s; simpl in *; inv Hv1; change Archi.ptr64 with true; simpl.
+          -- rewrite /Int64.eq; if_tac.
+             { apply unsigned_inj_64 in H1; subst; rewrite Int64.signed_zero in Hsc; tauto. }
+             destruct (_ && _) eqn: Hm.
+             { repeat (if_tac in Hm; try done).
+               apply unsigned_inj_64 in H3; apply unsigned_inj_64 in H2; subst.
+               rewrite Int64.signed_mone Int64.signed_repr in Hsc; rep_lia. }
+             done.
+          -- rewrite /Int64.eq; if_tac.
+             { apply unsigned_inj_64 in H1; subst; rewrite Int64.unsigned_zero in Hsc; tauto. }
+             rewrite /Int.modu Zquot.Zrem_Zmod_pos //; rep_lia.
+      + rewrite /Cop.sem_and /Cop.sem_binarith; destruct it, v1; try done; destruct v2; try done.
+        * destruct (unsigned_op i s) eqn: Hs.
+          -- destruct i; try done; destruct s; try done; simpl in *.
+             by inv Hv1.
+          -- replace (classify_binarith _ _) with (bin_case_i Signed) by (destruct i, s; done); simpl in *.
+             destruct s.
+             ++ inv Hv1.
+                change Archi.ptr64 with true.
+                rewrite /= and_signed //.
+             ++ by inv Hv1.
+        * rewrite /Cop.sem_cast /=.
+          destruct s; simpl in *; inv Hv1.
+          -- change Archi.ptr64 with true.
+             rewrite /= and_signed_64 //.
+          -- done.
+      + rewrite /Cop.sem_or /Cop.sem_binarith; destruct it, v1; try done; destruct v2; try done.
+        * destruct (unsigned_op i s) eqn: Hs.
+          -- destruct i; try done; destruct s; try done; simpl in *.
+             by inv Hv1.
+          -- replace (classify_binarith _ _) with (bin_case_i Signed) by (destruct i, s; done); simpl in *.
+             destruct s.
+             ++ inv Hv1.
+                change Archi.ptr64 with true.
+                rewrite /= or_signed //.
+             ++ by inv Hv1.
+        * rewrite /Cop.sem_cast /=.
+          destruct s; simpl in *; inv Hv1.
+          -- change Archi.ptr64 with true.
+             rewrite /= or_signed_64 //.
+          -- done.
+      + rewrite /Cop.sem_xor /Cop.sem_binarith; destruct it, v1; try done; destruct v2; try done.
+        * destruct (unsigned_op i s) eqn: Hs.
+          -- destruct i; try done; destruct s; try done; simpl in *.
+             by inv Hv1.
+          -- replace (classify_binarith _ _) with (bin_case_i Signed) by (destruct i, s; done); simpl in *.
+             destruct s.
+             ++ inv Hv1.
+                change Archi.ptr64 with true.
+                rewrite /= xor_signed //.
+             ++ by inv Hv1.
+        * rewrite /Cop.sem_cast /=.
+          destruct s; simpl in *; inv Hv1.
+          -- change Archi.ptr64 with true.
+             rewrite /= xor_signed_64 //.
+          -- done.
+      + rewrite /Cop.sem_shl /Cop.sem_shift; destruct it, v1; try done; destruct v2; try done.
+        * assert (n1 = Int.unsigned i0) as ->.
+          { destruct s; simpl in *.
+            ** inv Hv1. apply Int.signed_eq_unsigned, Int.signed_positive; lia.
+            ** inv Hv1; done. }
+          assert (n2 = Int.unsigned i1) as ->.
+          { destruct s; simpl in *.
+            ** inv Hv2. apply Int.signed_eq_unsigned, Int.signed_positive; lia.
+            ** inv Hv2; done. }
+          rewrite /Int.ltu; if_tac.
+          2: { rewrite Int.unsigned_repr_wordsize in H1; simpl in *.
+               pose proof (bitsize_wordsize i); rep_lia. }
+          destruct i, s; done.
+        * simpl in *.
+          assert (n1 = Int64.unsigned i) as ->.
+          { destruct s; inv Hv1; try done.
+            apply Int64.signed_eq_unsigned, Int64.signed_positive; lia. }
+          assert (n2 = Int64.unsigned i0) as ->.
+          { destruct s; inv Hv2; try done.
+            apply Int64.signed_eq_unsigned, Int64.signed_positive; lia. }
+          rewrite /Int64.ltu; if_tac.
+          2: { rewrite Int64.unsigned_repr_wordsize in H1; simpl in *; rep_lia. }
+          destruct i, s; done.
+      + rewrite /Cop.sem_shr /Cop.sem_shift; destruct it, v1; try done; destruct v2; try done.
+        * assert (n2 = Int.unsigned i1) as Heq.
+          { destruct s; simpl in *.
+            ** inv Hv2. apply Int.signed_eq_unsigned, Int.signed_positive; lia.
+            ** inv Hv2; done. }
+          rewrite /Int.ltu; if_tac.
+          2: { rewrite Int.unsigned_repr_wordsize in H1; simpl in *.
+               pose proof (bitsize_wordsize i); rep_lia. }
+          destruct (unsigned_op i s) eqn: Hs.
+          -- destruct i; try done; destruct s; try done; simpl in *.
+             by inv Hv1.
+          -- replace (classify_shift _ _) with (shift_case_ii Signed) by (destruct i, s; done); simpl in *.
+             destruct s.
+             ++ inv Hv1; done.
+             ++ inv Hv1.
+                rewrite /Int.shr Int.signed_eq_unsigned //.
+                { lapply (bitsize_small i); last by intros ->; intros.
+                  destruct i; try done; try rep_lia.
+                  intros; destruct H; subst; computable. }
+        * simpl in *.
+          assert (n2 = Int64.unsigned i0) as Heq.
+          { destruct s; inv Hv2; try done.
+            apply Int64.signed_eq_unsigned, Int64.signed_positive; lia. }
+          rewrite /Int64.ltu; if_tac.
+          2: { rewrite Int64.unsigned_repr_wordsize in H1; simpl in *; rep_lia. }
+          destruct s; inv Hv1; done.
+    - iApply ("HΦ" with "[] HT").
+      iPureIntro. split; [by apply in_range_i2v | by apply i2v_to_Z].
+  Qed.
+  Definition type_add_int_int_inst n1 n2 := [instance type_arithop_int_int n1 n2 (n1 + n2) Oadd].
+  Global Existing Instance type_add_int_int_inst.
+  Definition type_sub_int_int_inst n1 n2 := [instance type_arithop_int_int n1 n2 (n1 - n2) Osub].
+  Global Existing Instance type_sub_int_int_inst.
+  Definition type_mul_int_int_inst n1 n2 := [instance type_arithop_int_int n1 n2 (n1 * n2) Omul].
+  Global Existing Instance type_mul_int_int_inst.
+  Definition type_div_int_int_inst n1 n2 := [instance type_arithop_int_int n1 n2 (n1 `quot` n2) Odiv].
+  Global Existing Instance type_div_int_int_inst.
+  Definition type_mod_int_int_inst n1 n2 := [instance type_arithop_int_int n1 n2 (n1 `rem` n2) Omod].
+  Global Existing Instance type_mod_int_int_inst.
+  Definition type_and_int_int_inst n1 n2 := [instance type_arithop_int_int n1 n2 (Z.land n1 n2) Oand].
+  Global Existing Instance type_and_int_int_inst.
+  Definition type_or_int_int_inst n1 n2 := [instance type_arithop_int_int n1 n2 (Z.lor n1 n2) Oor].
+  Global Existing Instance type_or_int_int_inst.
+  Definition type_xor_int_int_inst n1 n2 := [instance type_arithop_int_int n1 n2 (Z.lxor n1 n2) Oxor].
+  Global Existing Instance type_xor_int_int_inst.
+  Definition type_shl_int_int_inst n1 n2 := [instance type_arithop_int_int n1 n2 (n1 ≪ n2) Oshl].
+  Global Existing Instance type_shl_int_int_inst.
+  Definition type_shr_int_int_inst n1 n2 := [instance type_arithop_int_int n1 n2 (n1 ≫ n2) Oshr].
+  Global Existing Instance type_shr_int_int_inst.
+
+  Inductive trace_if_int :=
+  | TraceIfInt (n : Z).
+
+  Lemma type_if_int it (n : Z) v T1 T2:
+    case_if (n ≠ 0)
+      (li_trace (TraceIfInt n, true) T1)
+      (li_trace (TraceIfInt n, false) T2)
+    ⊢ typed_if it v (v ◁ᵥ n @ int it) T1 T2.
+  Proof.
+    iIntros "Hs (% & %Hb)".
+    destruct it, v; try discriminate; iExists n; iSplit; auto;
+      simpl; (case_bool_decide;
+        [iDestruct "Hs" as "[Hs _]"; by iApply "Hs" | iDestruct "Hs" as "[_ Hs]"; iApply "Hs"; naive_solver]).
+  Qed.
+  Definition type_if_int_inst := [instance type_if_int].
+  Global Existing Instance type_if_int_inst.
+
+(*  Lemma type_assert_int it n v s fn ls R Q :
+    (⌜n ≠ 0⌝ ∗ typed_stmt s fn ls R Q)
+    ⊢ typed_assert (IntOp it) v (v ◁ᵥ n @ int it) s fn ls R Q.
+  Proof. iIntros "[% Hs] %Hb". iExists _. by iFrame. Qed.
+  Definition type_assert_int_inst := [instance type_assert_int].
+  Global Existing Instance type_assert_int_inst.
+
+  Inductive trace_switch_int :=
+  | TraceSwitchIntCase (n : Z)
+  | TraceSwitchIntDefault.
+
+  Lemma type_switch_int v n it m ss def fn ls R Q:
+    ([∧ map] i↦mi ∈ m, li_trace (TraceSwitchIntCase i) (
+             ⌜n = i⌝ -∗ ∃ s, ⌜ss !! mi = Some s⌝ ∗ typed_stmt s fn ls R Q)) ∧
+    (li_trace (TraceSwitchIntDefault) (
+                     ⌜n ∉ (map_to_list m).*1⌝ -∗ typed_stmt def fn ls R Q))
+    ⊢ typed_switch v (n @ int it) it m ss def fn ls R Q.
+  Proof.
+    unfold li_trace. iIntros "HT %Hv". iExists n. iSplit; first done.
+    iInduction m as [] "IH" using map_ind; simplify_map_eq => //.
+    { iDestruct "HT" as "[_ HT]". iApply "HT". iPureIntro.
+      rewrite map_to_list_empty. set_solver. }
+    rewrite big_andM_insert //. destruct (decide (n = i)); subst.
+    - rewrite lookup_insert. iDestruct "HT" as "[[HT _] _]". by iApply "HT".
+    - rewrite lookup_insert_ne//. iApply "IH". iSplit; first by iDestruct "HT" as "[[_ HT] _]".
+      iIntros (Hn). iDestruct "HT" as "[_ HT]". iApply "HT". iPureIntro.
+      rewrite map_to_list_insert //. set_solver.
+  Qed.
+  Definition type_switch_int_inst := [instance type_switch_int].
+  Global Existing Instance type_switch_int_inst. *)
+
+  Lemma type_neg_int n it v T:
+    (⌜n ∈ it⌝ -∗ <affine> ⌜is_signed it⌝ ∗ <affine> ⌜n ≠ min_int it⌝ ∗ T (i2v (-n) it) ((-n) @ int it))
+    ⊢ typed_un_op v ⎡v ◁ᵥ n @ int it⎤%I Oneg it T.
+  Proof.
+    iIntros "HT (% & %Hv) %Φ HΦ". pose proof (val_to_Z_in_range _ _ _ Hv H) as Hin.
+    iDestruct ("HT" with "[//]") as (Hs Hn) "HT".
+    rewrite /wp_unop.
+    iIntros "!>" (?) "$ !>".
+    iExists (i2v (- n) it); iSplit.
+    - iStopProof; split => rho; monPred.unseal.
+      apply bi.pure_intro.
+      destruct it; try done; destruct s; try done; simpl in *.
+      + rewrite /Cop.sem_neg.
+        replace (classify_neg _) with (neg_case_i Signed) by (destruct i; done).
+        destruct v; inv Hv.
+        rewrite -Int.neg_repr Int.repr_signed //.
+      + destruct i; done.
+      + rewrite /Cop.sem_neg /=.
+        destruct v; inv Hv.
+        rewrite -Int64.neg_repr Int64.repr_signed //.
+    - iApply "HΦ"; last done. iPureIntro.
+      assert (in_range (- n) it).
+      { hnf in Hin; destruct it; try done.
+        * destruct i; try done; destruct s; simpl in *; rep_lia.
+        * destruct s; simpl in *; rep_lia. }
+      split; [by apply in_range_i2v | by apply i2v_to_Z].
+  Qed.
+  Definition type_neg_int_inst := [instance type_neg_int].
+  Global Existing Instance type_neg_int_inst.
+
+  (* up *)
+  Lemma wp_Ecast : forall E e Φ ct, wp_expr E e (λ v, ∃ v', ∀ m, <affine> ⌜Some v' = Cop.sem_cast v (typeof e) ct m⌝ ∗ Φ v')
+    ⊢ wp_expr E (Ecast e ct) Φ.
+  Proof.
+  intros.
+  rewrite /wp_expr.
+  iIntros ">H !>" (?) "Hm".
+  iMod ("H" with "Hm") as "(%v & H1 & Hm & %v' & H)".
+  iDestruct ("H" $! m) as "[%Hcast HΦ]".
+  iExists _; iFrame; iModIntro.
+  iStopProof; split => rho; monPred.unseal.
+  rewrite !monPred_at_affinely /local /lift1 /=.
+  iIntros "%H1"; iPureIntro.
+  split; auto; intros; econstructor; eauto.
+  Qed.
+
+(* Ke: the equivalent to Caesium's CastOp is Clight's Ecast, so use typed_val_expr *)
+  Lemma type_Ecast_same_val e it2 T:
+    typed_val_expr e (λ v ty,
+      ∀ m (* Ke: for now only handle cases where m is irrelevant *),
+        <affine>⌜Some v = Cop.sem_cast v (typeof e) it2 m⌝ ∗
+        T v ty)
+    ⊢ typed_val_expr (Ecast e it2) T.
+  Proof.
+    iIntros "typed %Φ HΦ".
+    iApply wp_Ecast.
+    unfold typed_val_expr.
+    iApply "typed".
+    iIntros (v ty) "own_v Hcast".
+    iExists v. iIntros (m).
+    iDestruct ("Hcast" $! m) as "(Hcast & T)". iFrame.
+    iApply ("HΦ" with "[own_v]"); done.
+  Qed.
+
+(*  Lemma type_cast_int n it1 it2 v T:
+    (⌜n ∈ it1⌝ -∗ ⌜n ∈ it2⌝ ∗ ∀ v, T v (n @ int it2))
+    ⊢ typed_un_op v (v ◁ᵥ n @ int it1)%I (CastOp (IntOp it2)) (IntOp it1) T.
+  Proof.
+    iIntros "HT %Hv %Φ HΦ".
+    iDestruct ("HT" with "[]") as ([v' Hv']%(val_of_Z_is_Some (val_to_byte_prov v))) "HT".
+    { iPureIntro. by apply: val_to_Z_in_range. }
+    iApply wp_cast_int => //. iApply ("HΦ" with "[] HT") => //.
+    iPureIntro. by apply: val_to_of_Z.
+  Qed.
+  Definition type_cast_int_inst := [instance type_cast_int].
+  Global Existing Instance type_cast_int_inst. *)
+
+(*  Lemma type_not_int n1 it v1 T:
+    let n := if is_signed it then Z.lnot n1 else Z_lunot (int_size it) n1 in
+    (⌜n1 ∈ it⌝ -∗ T (i2v n it) (n @ int it))
+    ⊢ typed_un_op v1 ⎡v1 ◁ᵥ n1 @ int it⎤%I Onotint it T.
+  Proof.
+    iIntros "%n HT (% & %Hv1) %Φ HΦ". pose proof (val_to_Z_in_range _ _ _ Hv1 H) as Hin.
+    assert (n ∈ it).
+    { admit. }
+    rewrite /wp_unop.
+    iIntros "!>" (?) "$ !>".
+    iExists (i2v n it); iSplit.
+    - iStopProof; split => rho; monPred.unseal.
+      apply bi.pure_intro.
+      destruct it; try done; destruct s; try done; simpl in *.
+      + rewrite /Cop.sem_neg.
+        replace (classify_neg _) with (neg_case_i Signed) by (destruct i; done).
+        destruct v; inv Hv.
+        rewrite -Int.neg_repr Int.repr_signed //.
+      + destruct i; done.
+      + rewrite /Cop.sem_neg /=.
+        destruct v; inv Hv.
+        rewrite -Int64.neg_repr Int64.repr_signed //.
+    - iApply "HΦ"; last done. iPureIntro.
+      assert (in_range (- n) it).
+      { hnf in Hin; destruct it; try done.
+        * destruct i; try done; destruct s; simpl in *; rep_lia.
+        * destruct s; simpl in *; rep_lia. }
+      split; [by apply in_range_i2v | by apply i2v_to_Z].
+  Qed.
+  Definition type_not_int_inst := [instance type_not_int].
+  Global Existing Instance type_not_int_inst.  Abort.*)
+
+(*  (* TODO: replace this with a typed_cas once it is refactored to take E as an argument. *)
+  Lemma wp_cas_suc_int it z1 z2 zd l1 l2 vd Φ E:
+    (bytes_per_int it ≤ bytes_per_addr)%nat →
+    z1 = z2 →
+    l1 ◁ₗ z1 @ int it -∗ l2 ◁ₗ z2 @ int it -∗ vd ◁ᵥ zd @ int it -∗
+    ▷ (l1 ◁ₗ zd @ int it -∗ l2 ◁ₗ z2 @ int it -∗ Φ (val_of_bool true)) -∗
+    wp NotStuck E (CAS (IntOp it) (Val l1) (Val l2) (Val vd)) Φ.
+  Proof.
+    iIntros (? ->) "(%v1&%&%&Hl1) (%v2&%&%&Hl2) % HΦ/=".
+    iApply (wp_cas_suc with "Hl1 Hl2") => //.
+    { by apply val_to_of_loc. }
+    { by apply val_to_of_loc. }
+    { by eapply val_to_Z_length. }
+    iIntros "!# Hl1 Hl2". iApply ("HΦ" with "[Hl1] [Hl2]"); iExists _; by iFrame.
+  Qed.
+
+  Lemma wp_cas_fail_int it z1 z2 zd l1 l2 vd Φ E:
+    (bytes_per_int it ≤ bytes_per_addr)%nat →
+    z1 ≠ z2 →
+    l1 ◁ₗ z1 @ int it -∗ l2 ◁ₗ z2 @ int it -∗ vd ◁ᵥ zd @ int it -∗
+    ▷ (l1 ◁ₗ z1 @ int it -∗ l2 ◁ₗ z1 @ int it -∗ Φ (val_of_bool false)) -∗
+    wp NotStuck E (CAS (IntOp it) (Val l1) (Val l2) (Val vd)) Φ.
+  Proof.
+    iIntros (? ?) "(%v1&%&%&Hl1) (%v2&%&%&Hl2) % HΦ/=".
+    iApply (wp_cas_fail with "Hl1 Hl2") => //.
+    { by apply val_to_of_loc. }
+    { by apply val_to_of_loc. }
+    { by eapply val_to_Z_length. }
+    iIntros "!# Hl1 Hl2". iApply ("HΦ" with "[Hl1] [Hl2]"); iExists _; by iFrame.
+  Qed. *)
+
+  (*** int <-> bool *)
+  Lemma subsume_int_boolean_place A l β n b it T:
+    (∃ x, <affine> ⌜n = bool_to_Z (b x)⌝ ∗ T x)
+    ⊢ subsume (l ◁ₗ{β} n @ int it) (λ x : A, l ◁ₗ{β} (b x) @ boolean it) T.
+  Proof.
+    iIntros "[% [-> ?]] Hint". iExists _. iFrame. iDestruct "Hint" as (????) "?".
+    iExists _, _. iFrame. iSplit; first done. iSplit; last done. by destruct b.
+  Qed.
+  Definition subsume_int_boolean_place_inst := [instance subsume_int_boolean_place].
+  Global Existing Instance subsume_int_boolean_place_inst.
+
+  Lemma subsume_int_boolean_val A v n b it T:
+    (∃ x, <affine> ⌜n = bool_to_Z (b x)⌝ ∗ T x)
+    ⊢ subsume (v ◁ᵥ n @ int it) (λ x : A, v ◁ᵥ (b x) @ boolean it) T.
+  Proof.
+    iIntros "[%x [-> ?]] %". iExists _. iFrame. unfold boolean; simpl_type.
+    iExists (bool_to_Z (b x)). iSplit; first done. by destruct b. Qed.
+  Definition subsume_int_boolean_val_inst := [instance subsume_int_boolean_val].
+  Global Existing Instance subsume_int_boolean_val_inst.
+
+  Lemma type_binop_boolean_int it1 it2 it3 it4 v1 b1 v2 n2 op T:
+    typed_bin_op v1 ⎡v1 ◁ᵥ (bool_to_Z b1) @ int it1⎤ v2 ⎡v2 ◁ᵥ n2 @ int it2⎤ op it3 it4 T
+    ⊢ typed_bin_op v1 ⎡v1 ◁ᵥ b1 @ boolean it1⎤ v2 ⎡v2 ◁ᵥ n2 @ int it2⎤ op it3 it4 T.
+  Proof.
+    iIntros "HT H1 H2". iApply ("HT" with "[H1] H2"). unfold boolean; simpl_type.
+    iDestruct "H1" as "(%&(%&%H1)&%H2)". iPureIntro.
+    move: H1 H2 => /= -> ->. done.
+  Qed.
+  Definition type_binop_boolean_int_inst := [instance type_binop_boolean_int].
+  Global Existing Instance type_binop_boolean_int_inst.
+
+  Lemma type_binop_int_boolean it1 it2 it3 it4 v1 b1 v2 n2 op T:
+    typed_bin_op v1 ⎡v1 ◁ᵥ n2 @ int it2⎤ v2 ⎡v2 ◁ᵥ (bool_to_Z b1) @ int it1⎤ op it3 it4 T
+    ⊢ typed_bin_op v1 ⎡v1 ◁ᵥ n2 @ int it2⎤ v2 ⎡v2 ◁ᵥ b1 @ boolean it1⎤ op it3 it4 T.
+  Proof.
+    iIntros "HT H1 H2". iApply ("HT" with "H1 [H2]"). unfold boolean; simpl_type.
+    iDestruct "H2" as "(%&(%&%H1)&%H2)". iPureIntro.
+    move: H1 H2 => /= -> ->. done.
+  Qed.
+  Definition type_binop_int_boolean_inst := [instance type_binop_int_boolean].
+  Global Existing Instance type_binop_int_boolean_inst.
+
+(*  Lemma type_cast_int_builtin_boolean n it v T:
+    (∀ v, T v ((bool_decide (n ≠ 0)) @ builtin_boolean))
+    ⊢ typed_un_op v (v ◁ᵥ n @ int it)%I (CastOp BoolOp) (IntOp it) T.
+  Proof.
+    iIntros "HT %Hn %Φ HΦ". iApply wp_cast_int_bool => //.
+    iApply ("HΦ" with "[] HT") => //=. unfold boolean; simpl_type. iPureIntro. naive_solver.
+  Qed.
+  Definition type_cast_int_builtin_boolean_inst := [instance type_cast_int_builtin_boolean].
+  Global Existing Instance type_cast_int_builtin_boolean_inst. *)
+
+  Lemma annot_reduce_int v n it T:
+    (li_tactic (li_vm_compute Some n) (λ n', v ◁ᵥ n' @ int it -∗ T))
+    ⊢ typed_annot_expr 1 (ReduceAnnot) v (v ◁ᵥ n @ int it) T.
+  Proof.
+    unfold li_tactic, li_vm_compute.
+    iIntros "[%y [% HT]] Hv"; simplify_eq. iApply step_fupd_intro => //. iModIntro.
+    by iApply "HT".
+  Qed.
+  Definition annot_reduce_int_inst := [instance annot_reduce_int].
+  Global Existing Instance annot_reduce_int_inst.
+
+End programs.
+Global Typeclasses Opaque int_inner_type int.
+
+Notation "'if' p ≠ 0 " := (TraceIfInt p) (at level 100, only printing).
+(* Notation "'case' n " := (TraceSwitchIntCase n) (at level 100, only printing).
+Notation "'default'" := (TraceSwitchIntDefault) (at level 100, only printing). *)
+
+Section offsetof.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  (*** OffsetOf *)
+  Program Definition offsetof (s : members) (m : ident) : type := {|
+    ty_has_op_type ot mt := ot = size_t;
+    ty_own β l := ∃ n, <affine> ⌜fieldlist.in_members m s /\ fieldlist.field_offset _ m s = n⌝ ∗ l ◁ₗ{β} n @ int size_t;
+    ty_own_val v := ∃ n, <affine> ⌜fieldlist.in_members m s /\ fieldlist.field_offset _ m s = n⌝ ∗ v ◁ᵥ n @ int size_t;
+  |}%I.
+  Next Obligation.
+    iIntros (s m l E ?). iDestruct 1 as (n Hn) "H". iExists _. iSplitR => //. by iApply ty_share.
+  Qed.
+  Next Obligation. iIntros (s m ot mt l ?). iDestruct 1 as (??) "Hn". by iDestruct (ty_aligned with "Hn") as "$". Qed.
+  Next Obligation. iIntros (s m ot mt l ->). iDestruct 1 as (??) "Hn". by iApply (ty_size_eq _ _ mt with "Hn"). Qed.
+  Next Obligation.
+    iIntros (s m ot mt l ?). iDestruct 1 as (??)"Hn".
+    iDestruct (ty_deref with "Hn") as (v) "[Hl Hi]"; [done|]. iExists _. iFrame.
+    eauto with iFrame.
+  Qed.
+  Next Obligation.
+    iIntros (s m ? l v ???) "Hl". iDestruct 1 as (??)"Hn".
+    iExists _. iSplit => //. by iApply (@ty_ref with "[] Hl").
+  Qed.
+
+  Global Program Instance offsetof_copyable s m : Copyable (offsetof s m).
+  Next Obligation.
+    iIntros (s m E l ?). iDestruct 1 as (n Hn) "Hl".
+    iMod (copy_shr_acc with "Hl") as (???) "(Hl&H2&H3)" => //.
+    iModIntro. iSplitR => //. iExists _, _. iFrame.
+    iModIntro. done.
+  Qed.
+
+(*  Lemma type_offset_of s m T:
+    ⌜Some m ∈ s.(sl_members).*1⌝ ∗ (∀ v, T v (offsetof s m))
+    ⊢ typed_val_expr (OffsetOf s m) T.
+  Proof.
+    iIntros "[%Hin HT] %Φ HΦ". move: Hin => /offset_of_from_in [n Hn].
+    iApply wp_offset_of => //. iIntros "%v %Hv". iApply "HΦ" => //.
+    iExists _. iSplit; first done. unfold int; simpl_type. iPureIntro. by eapply val_to_of_Z.
+  Qed. *)
+
+End offsetof.
+Global Typeclasses Opaque offsetof.
+
+(*** Tests *)
+Section tests.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  Definition Econst_size_t z := if Archi.ptr64 then Econst_long (Int64.repr z) size_t else Econst_int (Int.repr z) size_t .
+  Definition Vsize_t z := if Archi.ptr64 then Vlong (Int64.repr z) else Vint (Int.repr z).
+
+  Lemma type_const_size_t z T:
+    typed_value (i2v z size_t) (T (i2v z size_t))
+    ⊢ typed_val_expr (Econst_size_t z) T.
+  Proof.
+    rewrite /Econst_size_t /size_t; simple_if_tac; [apply type_const_long | apply type_const_int].
+  Qed.
+
+  Example type_eq n1 n3 T:
+    n1 ∈ size_t →
+    n3 ∈ size_t →
+    ⊢ typed_val_expr (Ebinop Oeq (Ebinop Oadd (Econst_size_t n1) (Econst_size_t 0) size_t) (Econst_size_t n3) tint) T.
+  Proof.
+    move => Hn1 Hn2.
+    iApply type_bin_op.
+    iApply type_bin_op.
+    iApply type_const_size_t. iApply type_val_int. iSplit => //.
+    iApply type_const_size_t. iApply type_val_int. iSplit => //.
+    iApply type_arithop_int_int => //. iIntros (??). iSplit. {
+      iPureIntro. (*unfold int_arithop_sidecond, elem_of, int_elem_of_it, min_int, max_int in *; lia.*) rewrite Z.add_0_r //.
+    }
+    iApply type_const_size_t. iApply type_val_int. iSplit => //.
+    iApply type_relop_int_int => //.
+  Abort.
+End tests.
diff --git a/refinedVST/typing/locked.v b/refinedVST/typing/locked.v
new file mode 100644
index 0000000000..7aeb1b3452
--- /dev/null
+++ b/refinedVST/typing/locked.v
@@ -0,0 +1,192 @@
+From iris.algebra Require Import csum excl auth cmra_big_op.
+From iris.algebra Require Import big_op gset frac agree.
+From VST.typing Require Import programs.
+From VST.typing Require Import type_options.
+From iris_ora.algebra Require Import frac_auth ext_order.
+
+Definition lockN : namespace := nroot.@"lockN".
+Definition lock_id := gname.
+
+(** Registering the necessary ghost state. *)
+
+Canonical Structure gset_disjUR_authR := inclR(iris.algebra.auth.authR (gset_disjUR string)).
+
+Class lockG Σ := LockG {
+   lock_inG :: inG Σ (gset_disjUR_authR);
+   lock_excl_inG :: inG Σ (iris.algebra.excl.exclR unitO);
+}.
+
+Definition lockΣ : gFunctors :=
+  #[GFunctor (OraconstRF (gset_disjUR_authR));
+    GFunctor (OraconstRF (exclR unitO))].
+Global Instance subG_lockG {Σ} : subG lockΣ Σ → lockG Σ.
+Proof. solve_inG. Qed.
+
+Section type.
+  Context `{!lockG Σ} `{!typeG Σ} {cs : compspecs} .
+
+  Definition lock_token (γ : lock_id) (l : list string) : mpred :=
+    ∃ s : gset string, ⌜l ≡ₚ elements s⌝ ∧ own  γ (● (GSet s) : gset_disjUR_authR).
+
+  Global Instance lock_token_timeless γ l : Timeless (lock_token γ l).
+  Proof. apply _. Qed.
+
+  Theorem lock_token_exclusive (γ : gname) (l1 l2 : list string):
+    lock_token γ l1 -∗ lock_token γ l2 -∗ False.
+  Proof.
+    iIntros "H1 H2".
+    iDestruct "H1" as (?) "[_ H1]".
+    iDestruct "H2" as (?) "[_ H2]".
+    iDestruct (own_valid_2 with "H1 H2") as %Hown. exfalso.
+    by apply auth_auth_op_valid in Hown.
+  Qed.
+  
+  Theorem alloc_lock_token :
+    ⊢ |==> ∃ γ, lock_token γ [].
+  Proof.
+    iMod (own_alloc (● (GSet ∅): gset_disjUR_authR)) as (γ) "Hγ"; first by apply auth_auth_valid.
+    iModIntro. iExists γ, ∅. by iFrame.
+  Qed.
+
+  Program Definition tylocked_ex {A} (γ : lock_id) (n : string) (x : A) (ty : A → type) : type := {|
+    ty_has_op_type ot mt := (ty x).(ty_has_op_type) ot mt;
+    ty_own β l := (match β return _ with
+                  | Own => l ◁ₗ ty x
+                  | Shr => ∃ γ', inv lockN ((∃ x', l ◁ₗ ty x' ∗
+                                                    own γ' (Excl ())) ∨ own γ (◯ (GSet {[ n ]}): gset_disjUR_authR))
+                  end)%I;
+    ty_own_val v := (v ◁ᵥ (ty x))%I;
+  |}.
+  Next Obligation.
+    iIntros (A γ n x ty l E HE) "Hl".
+    iMod (own_alloc (Excl ())) as (γ') "Hown" => //.
+    iExists _. iApply inv_alloc. iIntros "!#". iLeft. iExists _. by iFrame.
+  Qed.
+  Next Obligation. iIntros (A γ n x ty ot mt v ?) "Hl". by iApply ty_aligned. Qed.
+  Next Obligation. iIntros (A γ n x ty ot mt v ?) "Hl". by iApply ty_deref. Qed.
+  Next Obligation. iIntros (A γ n x ty ot mt l ? ?) "Hl". by iApply ty_ref. Qed.
+
+  Lemma tylocked_simplify_hyp_place A γ n x (ty : A → type) l T:
+    (l ◁ₗ ty x -∗ T)
+    ⊢ simplify_hyp (l ◁ₗ tylocked_ex γ n x ty) T. done. Qed.
+
+  Definition tylocked_simplify_hyp_place_inst := [instance tylocked_simplify_hyp_place with 0%N].
+  Global Existing Instance tylocked_simplify_hyp_place_inst.
+
+  Lemma tylocked_simplify_goal_place A γ n x (ty : A → type) l T:
+    l ◁ₗ ty x ∗ T
+    ⊢ simplify_goal (l ◁ₗ tylocked_ex γ n x ty) T.
+  Proof. iIntros "[$ $]". Qed.
+  Definition tylocked_simplify_goal_place_inst := [instance tylocked_simplify_goal_place with 0%N].
+  Global Existing Instance tylocked_simplify_goal_place_inst.
+
+  Lemma tylocked_subsume A B γ n x1 x2 (ty : A → type) l β T:
+    (∃ y, ⌜β = Own → x1 = x2 y⌝ ∧ T y)
+    ⊢ subsume (l ◁ₗ{β} tylocked_ex γ n x1 ty) (λ y : B, l ◁ₗ{β} tylocked_ex γ n (x2 y) ty) T.
+  Proof.
+    iIntros "H". iDestruct "H" as (?) "(%H & ?)".
+    iIntros "Hl".
+    iExists _. iFrame. by destruct β; naive_solver. Qed.
+  Definition tylocked_subsume_inst := [instance tylocked_subsume].
+  Global Existing Instance tylocked_subsume_inst | 10.
+
+  Definition tylocked_ex_token {A} (γ : lock_id) (n : string) (l : address) (β : own_state) (ty : A → type):=
+    (∀ E x, <affine> ⌜↑lockN ⊆ E⌝ -∗ l ◁ₗ ty x ={E}=∗ l ◁ₗ{β} tylocked_ex γ n x ty ∗
+                                                      own γ (◯ (GSet {[ n ]}) : gset_disjUR_authR))%I.
+
+  Lemma locked_open A n s l γ (x : A) ty β E:
+    n ∉ s → ↑lockN ⊆ E →
+    l ◁ₗ{β} tylocked_ex γ n x ty -∗
+      lock_token γ s ={E}=∗
+      ▷ ∃ x', l ◁ₗ ty x' ∗ lock_token γ (n :: s) ∗ tylocked_ex_token γ n l β ty ∗ <affine> ⌜β = Own → x = x'⌝.
+  Proof.
+    iIntros (Hnotin ?) "Hl Hown".
+    iDestruct "Hown" as (st Hperm) "Hown". rewrite ->Hperm in Hnotin.
+    iMod (own_update with "Hown") as "[Hown Hs]". { eapply auth_update_alloc.
+      apply (gset_disj_alloc_empty_local_update st {[n]}). set_solver. }
+    rewrite {1}/ty_own /=.
+    iAssert (lock_token γ (n :: s)) with "[Hown]" as "$". {
+      iExists _. iFrame. iPureIntro. rewrite Hperm elements_union_singleton //. set_solver.
+    }
+    destruct β.
+    { iIntros "!# !#". iExists _. iFrame. iSplit => //.
+      iIntros (? ?) "H1 Hl !>". done. 
+    }
+    iDestruct "Hl" as (γ') "#Hinv".
+    iInv "Hinv" as "[Hl|>Hn]" "Hc"; last first.
+    - iDestruct (own_valid_2 with "Hs Hn") as %Hown. exfalso. move: Hown.
+      rewrite -auth_frag_op auth_frag_valid gset_disj_valid_op. set_solver.
+    - iMod ("Hc" with "[Hs]") as "_"; [by iRight|].
+      iIntros "!# !#". iDestruct "Hl" as (x') "[Hl Hexcl]".
+      iExists _. iFrame. iSplitL => //.
+      (** locked_token *)
+      iIntros (E' x'' ?) "Hl".
+      iInv "Hinv" as "[H|>$]" "Hc".
+      + have ? : Inhabited A by apply (populate x).
+        iDestruct "H" as (?) "(H1 & >He)".
+        by iDestruct (own_valid_2 with "Hexcl He") as %Hown%exclusive_l.
+      + iMod ("Hc" with "[Hl Hexcl]") as "_"; last first. { by iExists _. }
+        iModIntro. iLeft. iExists _. iFrame.
+  Qed.
+  
+  Lemma locked_close A n s l γ (x : A) ty β E:
+    ↑lockN ⊆ E →
+    tylocked_ex_token γ n l β ty -∗ l ◁ₗ ty x -∗ lock_token γ (n :: s) ={E}=∗
+    lock_token γ s ∗ l ◁ₗ{β} tylocked_ex γ n x ty.
+  Proof.
+    iIntros (HE) "Hlocked Hl Hlock".
+    iMod ("Hlocked" with "[//] Hl") as "[$ Hn]".
+    iDestruct "Hlock" as (st Hst) "Htok".
+    iExists (st ∖ {[n]}).
+    iMod (own_update γ (● GSet st ⋅ ◯ GSet {[n]} : gset_disjUR_authR) (● GSet (st ∖ {[n]}))
+           with "[Htok Hn]") as "H".
+    - eapply auth_update_dealloc, gset_disj_dealloc_local_update.
+    - rewrite own_op. iFrame.
+    - iModIntro. iFrame. iPureIntro. split; auto.
+      move: (Hst). rewrite {1}(union_difference_L {[n]} st).
+      + rewrite ->elements_union_singleton => ?; last set_solver.
+        by eapply Permutation.Permutation_cons_inv.
+      + set_unfold => ??. subst. apply elem_of_elements. rewrite -Hst. set_solver.
+   Qed.
+
+  Lemma annot_unlock A l β γ n ty (x : A) T:
+    (find_in_context (FindDirect (lock_token γ)) (λ s : list string, ⌜n∉s⌝ ∗ (∀ x',
+        lock_token γ (n :: s) -∗ tylocked_ex_token γ n l β ty -∗ ⌜β = Own → x = x'⌝ -∗
+                       l ◁ₗ ty x' -∗ T)))
+    ⊢ typed_annot_stmt UnlockA l (l ◁ₗ{β} tylocked_ex γ n x ty) T.
+  Proof.
+    iDestruct 1 as (s) "(Hs&%&HT)". iIntros "Hlocked".
+    iMod (locked_open with "Hlocked Hs") as "Htok" => //.
+    iApply step_fupd_intro => //. iModIntro.
+    iDestruct "Htok" as (x') "(Hl&Hs&Htok&%)".
+    by iApply ("HT" with "Hs Htok [//] Hl").
+  Qed. 
+  
+  Definition annot_unlock_inst := [instance annot_unlock].
+  Global Existing Instance annot_unlock_inst.
+
+  Class WithLockId (ty : type) (γ : lock_id) := with_lock_id : True.
+
+  Lemma type_annot_lock (l : address) β ty γ `{!WithLockId ty γ} T:
+    (find_in_context (FindDirect (lock_token γ)) (λ s : list string, foldr (λ t T,
+        find_in_context (FindDirect (λ '(existT A (l2, ty)), tylocked_ex_token (A:=A) γ t l2 β ty)) (λ '(existT A (l2, ty)), ∃ x,
+          l2 ◁ₗ ty x ∗ (l2 ◁ₗ{β} tylocked_ex γ t x ty -∗ T))) (l ◁ₗ{β} ty -∗ lock_token γ [] -∗ T) s))
+    ⊢ typed_annot_expr 1%nat LockA l (l ◁ₗ{β} ty) T.
+  Proof.
+    iIntros "H Hty".
+    iDestruct "H" as (s) "[Htok Hs]".
+    iApply step_fupd_intro => //. iModIntro.
+    iInduction s as [|t s] "IH" => /=. 1: by iApply ("Hs" with "Hty Htok").
+    iDestruct "Hs" as ([A [l2 ty2]]) "[Hlt H]".
+    iDestruct "H" as (x) "[Hl HT]".
+    iMod (locked_close with "Hlt Hl Htok") as "[Htok Hl]" => //.
+    iApply ("IH" with "Htok [HT Hl] Hty"). by iApply "HT".
+  Qed.
+  Definition type_annot_lock_inst := [instance type_annot_lock].
+  Global Existing Instance type_annot_lock_inst.
+End type.
+
+(* TODO: Do something stronger, e.g. sealing? *)
+Global Typeclasses Opaque tylocked_ex lock_token tylocked_ex_token.
+Notation tylocked γ n ty := (tylocked_ex γ n tt (λ _, ty)).
+Notation tylocked_token γ n l β ty := (tylocked_ex_token γ n l β (λ _ : unit, ty)).
diff --git a/refinedVST/typing/optional.v b/refinedVST/typing/optional.v
new file mode 100644
index 0000000000..6da017705d
--- /dev/null
+++ b/refinedVST/typing/optional.v
@@ -0,0 +1,480 @@
+From VST.typing Require Export type.
+From VST.typing Require Import programs boolean int.
+From VST.typing Require Import type_options.
+
+(** We need to use this unbundled approach to ensure that ROptionable
+uses the same instances as Optionable.
+  TODO: findout if there is a better way, maybe using Canonical Structures?
+ *)
+
+Class Optionable `{!typeG OK_ty Σ} {cs : compspecs} (ty : type) (optty : type) (ot1 ot2 : Ctypes.type) := {
+  opt_pre : val → val → iProp Σ;
+  opt_bin_op (bty beq : bool) v1 v2 σ v :
+    (⊢ opt_pre v1 v2 -∗ (if bty then v1 ◁ᵥ ty else v1 ◁ᵥ optty) -∗ v2 ◁ᵥ optty -∗ juicy_mem.mem_auth σ -∗
+      ⌜sem_binary_operation _ (if beq then Cop.Oeq else Cop.One) v1 ot1 v2 ot2 σ = Some v ↔ Vint (Int.repr (bool_to_Z (xorb bty beq))) = v⌝);
+}.
+Arguments opt_pre {_ _ _ _} _ {_ _ _ _} _ _.
+
+Class OptionableAgree `{!typeG OK_ty Σ} {cs : compspecs} (ty1 ty2 : type) : Prop :=
+  optionable_dist : True.
+
+Section optional.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  Global Program Instance optionable_ty_of_rty A (r : rtype A) `{!Inhabited A} optty ot1 ot2
+    `{!∀ x, Optionable (x @ r) optty ot1 ot2}: Optionable r optty ot1 ot2 := {|
+    opt_pre v1 v2 := (∀ x, opt_pre (x @ r) v1 v2)%I
+  |}.
+  Next Obligation.
+    iIntros(A r????? bty beq v1 v2 σ v) "Hpre Hv1 Hv2".
+    unfold ty_of_rty; simpl_type.
+    destruct bty. 1: iDestruct "Hv1" as (y) "Hv1".
+    all: iApply (opt_bin_op with "Hpre [Hv1] Hv2") => /= //.
+    Unshelve.
+    apply inhabitant.
+  Qed.
+
+  Global Instance optionable_agree_wr1 A (ty1 : rtype A) p ty2 `{!OptionableAgree ty1 ty2} : OptionableAgree (p @ ty1) ty2.
+  Proof. done. Qed.
+  Global Instance optionable_agree_wr2 A (ty2 : rtype A) p ty1 `{!OptionableAgree ty1 ty2} : OptionableAgree ty1 (p @ ty2).
+  Proof. done. Qed.
+  Global Instance optionable_agree_id ty : OptionableAgree ty ty.
+  Proof. done. Qed.
+
+  (* Separate definition such that we can make it typeclasses opaque later. *)
+  Program Definition optional_type (ty : type) (optty : type) (b : Prop) : type := {|
+      ty_has_op_type ot mt := (ty.(ty_has_op_type) ot mt ∧ optty.(ty_has_op_type) ot mt)%type;
+      ty_own β l := (<affine> ⌜b⌝ ∗ l◁ₗ{β}ty ∨ <affine> ⌜¬b⌝ ∗ l◁ₗ{β}optty)%I;
+      ty_own_val v := (<affine> ⌜b⌝ ∗ v ◁ᵥ ty ∨ <affine> ⌜¬b⌝ ∗ v ◁ᵥ optty)%I
+  |}.
+  Next Obligation.
+    iIntros (??????).
+    by iDestruct 1 as "[[% H]|[% H]]";iMod (ty_share with "H") => //; iModIntro; [iLeft | iRight ]; iFrame.
+  Qed.
+  Next Obligation.
+    iIntros (ty?????[??]). by iDestruct 1 as "[[% Hv]|[% Hv]]";iDestruct (ty_aligned with "Hv") as %?.
+  Qed.
+  Next Obligation.
+    iIntros (ty?????[??]). by iDestruct 1 as "[[% Hv]|[% Hv]]";iDestruct (ty_size_eq with "Hv") as %?.
+  Qed.
+  Next Obligation.
+    iIntros (ty optty ????[??]) "Hl".
+    iDestruct "Hl" as "[[% Hl]|[% Hl]]"; iDestruct (ty_deref with "Hl") as (?) "[? ?]"; eauto with iFrame.
+  Qed.
+  Next Obligation.
+    iIntros (ty optty ?????[??]?) "Hl Hv".
+    iDestruct "Hv" as "[[% Hv]|[% Hv]]"; iDestruct (ty_ref with "[] Hl Hv") as "H"; rewrite -?opt_alt_sz//;
+       [iLeft | iRight]; by iFrame.
+  Qed.
+(*   Next Obligation.
+    iIntros (ty optty b v ot mt st [??]) "[[% Hv]|[% Hv]]".
+    all: iDestruct (ty_memcast_compat with "Hv") as "Hv" => //.
+    all: case_match => //. 1: iLeft. 2: iRight.
+    all: by iFrame.
+  Qed. *)
+
+  Global Instance optional_type_le : Proper ((⊑) ==> (⊑) ==> (=) ==> (⊑)) optional_type.
+  Proof. solve_type_proper. Qed.
+  Global Instance optional_type_proper : Proper ((≡) ==> (≡) ==> (=) ==> (≡)) optional_type.
+  Proof. solve_type_proper. Qed.
+
+  (* Never use optional without the refinement! This will fail
+  horribly since the implicit refinement might not be decidable! Use
+  optionalO with () instead. *)
+  Definition optional (ty : type) (optty : type) : rtype _ := RType (optional_type ty optty).
+
+(*   Global Instance optional_loc_in_bounds ty e ot β n `{!LocInBounds ty β n} `{!LocInBounds ot β n}:
+    LocInBounds (e @ optional ty ot) β n.
+  Proof.
+    constructor. rewrite /with_refinement /=. iIntros (l) "Hl".
+    iDestruct "Hl" as "[[_ Hl]|[_ Hl]]"; by iApply (loc_in_bounds_in_bounds with "Hl").
+  Qed.
+ *)
+  (* We could add rules like *)
+  (* Lemma simplify_optional_goal ty optty l β T b `{!Decision b}: *)
+  (*   T (if decide b then l◁ₗ{β}ty else l◁ₗ{β}optty) -∗ *)
+  (*   simplify_goal (l◁ₗ{β} b @ optional ty optty) T. *)
+  (* but that would lead to the automation doing a case split out of
+  despair which is not a good user experience. Thus you should make
+  sure that the other rules in this file work for you, which don't
+  cause unnecssary case splits. *)
+
+  (* TODO: should be allow different opttys? *)
+  Global Instance simple_subsume_place_optional ty1 ty2 optty b1 b2 `{!Affine P} `{!SimpleSubsumePlace ty1 ty2 P}:
+    SimpleSubsumePlace (b1 @ optional ty1 optty) (b2 @ optional ty2 optty) (<affine> ⌜b1 ↔ b2⌝ ∗ P).
+  Proof.
+    iIntros (l β) "HP Hl". iDestruct "HP" as (Hequiv) "HP".
+    iDestruct "Hl" as "[[% Hl]|[% Hl]]"; [iLeft | iRight]; rewrite -Hequiv. 2: by iFrame.
+    iSplit => //. iApply (@simple_subsume_place with "HP Hl").
+  Qed.
+
+  Global Instance simple_subsume_val_optional ty1 ty2 optty b1 b2
+       `{!Affine P} `{!SimpleSubsumeVal ty1 ty2 P}:
+    SimpleSubsumeVal (b1 @ optional ty1 optty) (b2 @ optional ty2 optty) (<affine> ⌜b1 ↔ b2⌝ ∗ P).
+  Proof.
+    iIntros (v) "[Heq P] H". rewrite /ty_own_val /=. iDestruct "Heq" as %->.
+    iDestruct "H" as "[[?H] | [??]]"; last (iRight; by iFrame).
+    iLeft. iFrame. iApply (@simple_subsume_val with "P H").
+  Qed.
+
+  Lemma subsume_optional_optty_ref A b ty optty l β T:
+    (∃ x, <affine> ⌜¬ (b x)⌝ ∗ T x) ⊢ subsume (l ◁ₗ{β} optty) (λ x : A, l ◁ₗ{β} (b x) @ optional (ty x) optty) T.
+  Proof. iIntros "[% [Hb ?]] Hl". iExists _. iFrame. iRight. by iFrame. Qed.
+  Definition subsume_optional_optty_ref_inst := [instance subsume_optional_optty_ref].
+  Global Existing Instance subsume_optional_optty_ref_inst.
+
+  Lemma subsume_optional_ty_ref A b (ty : A → type) ty' optty l β
+    `{!∀ x, OptionableAgree (ty x) ty'} T:
+    (l ◁ₗ{β} ty' -∗ ∃ x, l ◁ₗ{β} ty x ∗ <affine> ⌜b x⌝ ∗ T x)
+    ⊢ subsume (l ◁ₗ{β} ty') (λ x : A, l ◁ₗ{β} (b x) @ optional (ty x) (optty x)) T.
+  Proof.
+    iIntros "Hsub Hl". iDestruct ("Hsub" with "Hl") as (?) "[? [% ?]]".
+    iExists _. iFrame. iLeft. by iFrame.
+  Qed.
+  Definition subsume_optional_ty_ref_inst := [instance subsume_optional_ty_ref].
+  Global Existing Instance subsume_optional_ty_ref_inst.
+
+  Lemma subsume_optional_val_optty_ref A b ty optty v T:
+    (∃ x, <affine> ⌜¬ b x⌝ ∗ T x) ⊢ subsume (v ◁ᵥ optty) (λ x : A, v ◁ᵥ (b x) @ optional (ty x) optty) T.
+  Proof. iIntros "[% [Hb ?]] Hl". iExists _. iFrame. iRight. by iFrame. Qed.
+  Definition subsume_optional_val_optty_ref_inst := [instance subsume_optional_val_optty_ref].
+  Global Existing Instance subsume_optional_val_optty_ref_inst.
+
+  Lemma subsume_optional_val_ty_ref A b ty ty' optty v `{!∀ x, OptionableAgree (ty x) ty'} T:
+    (v ◁ᵥ ty' -∗ ∃ x, v ◁ᵥ ty x ∗ <affine> ⌜b x⌝ ∗ T x)
+    ⊢ subsume (v ◁ᵥ ty') (λ x : A, v ◁ᵥ (b x) @ optional (ty x) (optty x)) T.
+  Proof.
+    iIntros "Hsub Hl". iDestruct ("Hsub" with "Hl") as (?) "[? [% ?]]".
+    iExists _. iFrame. iLeft. by iFrame.
+  Qed.
+  Definition subsume_optional_val_ty_ref_inst := [instance subsume_optional_val_ty_ref].
+  Global Existing Instance subsume_optional_val_ty_ref_inst.
+
+  Inductive trace_optional :=
+  | TraceOptionalEq (P : Prop)
+  | TraceOptionalNe (P : Prop).
+
+  Lemma type_eq_optional_refined v1 v2 ty optty ot1 ot2 `{!Optionable ty optty ot1 ot2} `{!Affine (v2 ◁ᵥ optty)} b (T : _ → _ → assert)
+    (* We'll throw away any ownership associated with v2 (e.g. through an ownership type), so it needs to be affine.
+       We could require T to be absorbing instead. *)  :
+    ⎡opt_pre ty v1 v2⎤ ∧
+    case_if b
+      (li_trace (TraceOptionalEq b) (⎡v1 ◁ᵥ ty⎤ -∗ T (i2v (bool_to_Z false) tint) (false @ boolean tint)))
+      (li_trace (TraceOptionalEq (¬ b)) (⎡v1 ◁ᵥ optty⎤ -∗ T (i2v (bool_to_Z true) tint) (true @ boolean tint)))
+    ⊢ typed_bin_op v1 ⎡v1 ◁ᵥ b @ (optional ty optty)⎤ v2 ⎡v2 ◁ᵥ optty⎤ Oeq ot1 ot2 T.
+  Proof.
+    iIntros "HT Hv1 Hv2" (Φ) "HΦ".
+    iDestruct "Hv1" as "[[% Hv1]|[% Hv1]]".
+    - iIntros "!>" (?) "Hctx !>".
+      iExists (i2v (bool_to_Z false) tint).
+      iSplit. {
+        iStopProof; split => rho; monPred.unseal.
+        iIntros "([Hpre _] & Hv1 & Hv2 & _ & Hctx)".
+        iDestruct (opt_bin_op true true with "Hpre Hv1 Hv2 Hctx") as %Hiff.
+        iPureIntro; intros. simpl in Hiff. rewrite Hiff //.
+      }
+      iDestruct "HT" as "[_ [HT _]]". iFrame.
+      iDestruct ("HT" with "[//] Hv1") as "HT".
+      iApply ("HΦ" with "[] HT"). by iExists _.
+    - iIntros "!>" (?) "Hctx !>".
+      iExists (i2v (bool_to_Z true) tint).
+      iSplit. {
+        iStopProof; split => rho; monPred.unseal.
+        iIntros "([Hpre _] & Hv1 & Hv2 & _ & Hctx)".
+        iDestruct (opt_bin_op false true with "Hpre Hv1 Hv2 Hctx") as %Hiff.
+        iPureIntro; intros. simpl in Hiff. rewrite Hiff //.
+      }
+      iDestruct "HT" as "[_ [_ HT]]". iFrame.
+      iDestruct ("HT" with "[//] Hv1") as "HT".
+      iApply ("HΦ" with "[] HT"). by iExists _.
+  Qed.
+  Definition type_eq_optional_refined_inst := [instance type_eq_optional_refined].
+  Global Existing Instance type_eq_optional_refined_inst.
+
+  Lemma type_eq_optional_neq v1 v2 ty optty ot1 ot2 `{!Optionable ty optty ot1 ot2} `{!Affine (v2 ◁ᵥ optty)} T :
+    ⎡opt_pre ty v1 v2⎤ ∧ (∀ v, ⎡v1 ◁ᵥ ty⎤ -∗ T v (false @ boolean tint))
+    ⊢ typed_bin_op v1 ⎡v1 ◁ᵥ ty⎤ v2 ⎡v2 ◁ᵥ optty⎤ Oeq ot1 ot2 T.
+  Proof.
+    iIntros "HT Hv1 Hv2". iIntros (Φ) "HΦ".
+    iIntros "!>" (?) "Hctx !>".
+    iExists (i2v (bool_to_Z false) tint).
+    iSplit. {
+        iStopProof; split => rho; monPred.unseal.
+        iIntros "([Hpre _] & Hv1 & Hv2 & _ & Hctx)".
+        iDestruct (opt_bin_op true true with "Hpre Hv1 Hv2 Hctx") as %Hiff.
+        iPureIntro; intros. simpl in Hiff. rewrite Hiff //.
+    }
+    iDestruct ("HT" with "Hv1") as "HT". iFrame.
+    iApply "HΦ" => //. iExists _. iSplit; iPureIntro; done.
+  Qed.
+  Definition type_eq_optional_neq_inst := [instance type_eq_optional_neq].
+  Global Existing Instance type_eq_optional_neq_inst.
+
+  Lemma type_neq_optional v1 v2 ty optty ot1 ot2 `{!Optionable ty optty ot1 ot2} `{!Affine (v2 ◁ᵥ optty)} b T :
+    ⎡opt_pre ty v1 v2⎤ ∧
+    case_if b
+      (li_trace (TraceOptionalNe b) (⎡v1 ◁ᵥ ty⎤ -∗ T (i2v (bool_to_Z true) tint) (true @ boolean tint)))
+      (li_trace (TraceOptionalNe (¬ b)) (⎡v1 ◁ᵥ optty⎤ -∗ T (i2v (bool_to_Z false) tint) (false @ boolean tint)))
+    ⊢ typed_bin_op v1 ⎡v1 ◁ᵥ b @ (optional ty optty)⎤ v2 ⎡v2 ◁ᵥ optty⎤ Cop.One ot1 ot2 T.
+  Proof.
+    unfold li_trace. iIntros "HT Hv1 Hv2" (Φ) "HΦ".
+    iDestruct "Hv1" as "[[% Hv1]|[% Hv1]]".
+    - iIntros "!>" (?) "Hctx !>".
+      iExists (i2v (bool_to_Z true) tint).
+      iSplit. {
+        iStopProof; split => rho; monPred.unseal.
+        iIntros "([Hpre _] & Hv1 & Hv2 & _ & Hctx)".
+        iDestruct (opt_bin_op true false with "Hpre Hv1 Hv2 Hctx") as %Hiff.
+        iPureIntro; intros. simpl in Hiff. rewrite Hiff //.
+      }
+      iDestruct "HT" as "[_ [HT _]]". iFrame.
+      iDestruct ("HT" with "[//] Hv1") as "HT".
+      iApply ("HΦ" with "[] HT"). by iExists _.
+    - iIntros "!>" (?) "Hctx !>".
+      iExists (i2v (bool_to_Z false) tint).
+      iSplit. {
+        iStopProof; split => rho; monPred.unseal.
+        iIntros "([Hpre _] & Hv1 & Hv2 & _ & Hctx)".
+        iDestruct (opt_bin_op false false with "Hpre Hv1 Hv2 Hctx") as %Hiff.
+        iPureIntro; intros. simpl in Hiff. rewrite Hiff //.
+      }
+      iDestruct "HT" as "[_ [_ HT]]". iFrame.
+      iDestruct ("HT" with "[//] Hv1") as "HT".
+      iApply ("HΦ" with "[] HT"). by iExists _.
+  Qed.
+  Definition type_neq_optional_inst := [instance type_neq_optional].
+  Global Existing Instance type_neq_optional_inst.
+
+  Global Program Instance optional_copyable b ty optty `{!Copyable ty} `{!Copyable optty} : Copyable (b @ optional ty optty).
+  Next Obligation.
+    iIntros (b ty optty ? ? E ly l ? [??]) "[[% Hl]|[% Hl]]".
+    all: iMod (copy_shr_acc with "Hl") as (?? ?) "[?[??]]" => //.
+    all: iModIntro; iSplit => //; rewrite /=?opt_alt_sz => //; iExists _, _; iFrame.
+    - by iLeft; iFrame.
+    - by iRight; iFrame.
+  Qed.
+
+End optional.
+Global Typeclasses Opaque optional_type optional.
+Notation "optional< ty , optty >" := (optional ty optty)
+  (only printing, format "'optional<' ty ,  optty '>'") : printing_sugar.
+
+Notation "'optional' == ... : P" := (TraceOptionalEq P) (at level 100, only printing).
+Notation "'optional' != ... : P" := (TraceOptionalNe P) (at level 100, only printing).
+
+Section optionalO.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+    (* Separate definition such that we can make it typeclasses opaque later. *)
+  Program Definition optionalO_type {A : Type} (ty : A → type) (optty : type) (b : option A) : type := {|
+      ty_has_op_type ot mt := ((∀ x, (ty x).(ty_has_op_type) ot mt) ∧ optty.(ty_has_op_type) ot mt)%type;
+      ty_own β l := (if b is Some x return _ then l◁ₗ{β}(ty x) else l◁ₗ{β}optty)%I;
+      ty_own_val v := (if b is Some x return _ then v ◁ᵥ (ty x) else v ◁ᵥ optty)%I
+  |}.
+  Next Obligation.
+    iIntros (A ty? [x|]); apply ty_share.
+  Qed.
+  Next Obligation.
+    iIntros (A ty? [x|] ???[Hty ?]) "Hv";iDestruct (ty_aligned with "Hv") as %Ha => //.
+  Qed.
+  Next Obligation.
+    iIntros (A ty? [x|] ???[??]) "Hv";iDestruct (ty_size_eq with "Hv") as %Ha => //.
+  Qed.
+  Next Obligation.
+    iIntros (A ty optty [] ?? l[??]) "Hl"; rewrite /with_refinement/ty_own/=; iDestruct (ty_deref with "Hl") as (?) "[? ?]"; eauto with iFrame.
+  Qed.
+  Next Obligation.
+    iIntros (A ty optty [] ?? l v [??]?) "Hl Hv"; iApply (ty_ref with "[] Hl Hv") => //.
+  Qed.
+(*   Next Obligation.
+    iIntros (A ty optty [x|] v ot mt st [??]) "Hl".
+    all: by iDestruct (ty_memcast_compat with "Hl") as "Hl".
+  Qed. *)
+
+  Global Instance optionalO_type_le A : Proper (pointwise_relation A (⊑) ==> (⊑) ==> (eq) ==> (⊑)) optionalO_type.
+  Proof. solve_type_proper. Qed.
+  Global Instance optionalO_type_proper A : Proper (pointwise_relation A (≡) ==> (≡) ==> (eq) ==> (≡)) optionalO_type.
+  Proof. solve_type_proper. Qed.
+
+  Definition optionalO {A : Type} (ty : A → type) (optty : type) : rtype _ := RType (optionalO_type ty optty).
+
+(*   Global Instance optionalO_loc_in_bounds A (ty : A → type) e ot β n `{!∀ x, LocInBounds (ty x) β n} `{!LocInBounds ot β n}:
+    LocInBounds (e @ optionalO ty ot) β n.
+  Proof.
+    constructor. iIntros (l) "Hl". unfold optionalO; simpl_type.
+    destruct e; by iApply (loc_in_bounds_in_bounds with "Hl").
+  Qed. *)
+
+  (* TODO: should be allow different opttys? *)
+  Global Instance simple_subsume_place_optionalO A (ty1 : A → _) ty2 optty b
+    `{!Affine P} `{!∀ x, SimpleSubsumePlace (ty1 x) (ty2 x) P}:
+    SimpleSubsumePlace (b @ optionalO ty1 optty) (b @ optionalO ty2 optty) P.
+  Proof.
+    iIntros (l β) "HP Hl". destruct b. 2: by iFrame.
+    unfold optionalO; simpl_type. iApply (@simple_subsume_place with "HP Hl").
+  Qed.
+
+  (* TODO: Should we have more instances like this? E.g. for the goal? *)
+  Lemma simpl_hyp_optionalO_Some A (ty : A → type) optty l β x T:
+    (l ◁ₗ{β} ty x -∗ T) ⊢ simplify_hyp (l ◁ₗ{β} Some x @ optionalO ty optty) T.
+  Proof. iIntros "HT Hl". by iApply "HT". Qed.
+  Definition simpl_hyp_optionalO_Some_inst := [instance simpl_hyp_optionalO_Some with 0%N].
+  Global Existing Instance simpl_hyp_optionalO_Some_inst.
+  Lemma simpl_hyp_optionalO_None A (ty : A → type) optty l β T:
+    (l ◁ₗ{β} optty -∗ T) ⊢ simplify_hyp (l ◁ₗ{β} None @ optionalO ty optty) T.
+  Proof. iIntros "HT Hl". by iApply "HT". Qed.
+  Definition simpl_hyp_optionalO_None_inst := [instance simpl_hyp_optionalO_None with 0%N].
+  Global Existing Instance simpl_hyp_optionalO_None_inst.
+  Lemma simpl_hyp_optionalO_Some_val A (ty : A → type) optty v x T:
+    (v ◁ᵥ ty x -∗ T) ⊢ simplify_hyp (v ◁ᵥ Some x @ optionalO ty optty) T.
+  Proof. iIntros "HT Hl". by iApply "HT". Qed.
+  Definition simpl_hyp_optionalO_Some_val_inst := [instance simpl_hyp_optionalO_Some_val with 0%N].
+  Global Existing Instance simpl_hyp_optionalO_Some_val_inst.
+  Lemma simpl_hyp_optionalO_None_val A (ty : A → type) optty v T:
+    (v ◁ᵥ optty -∗ T) ⊢ simplify_hyp (v ◁ᵥ None @ optionalO ty optty) T.
+  Proof. iIntros "HT Hl". by iApply "HT". Qed.
+  Definition simpl_hyp_optionalO_None_val_inst := [instance simpl_hyp_optionalO_None_val with 0%N].
+  Global Existing Instance simpl_hyp_optionalO_None_val_inst.
+
+  Lemma subsume_optionalO_optty B A (ty : B → A → type) optty l β b T:
+    (∃ x, <affine> ⌜b x = None⌝ ∗ T x)
+    ⊢ subsume (l ◁ₗ{β} optty) (λ x : B, l ◁ₗ{β} (b x) @ optionalO (ty x) optty) T.
+  Proof. iIntros "[% [%Heq ?]] Hl". iExists _. iFrame. by rewrite Heq. Qed.
+  Definition subsume_optionalO_optty_inst := [instance subsume_optionalO_optty].
+  Global Existing Instance subsume_optionalO_optty_inst.
+
+  Lemma subsume_optionalO_ty B A (ty : B → A → type) optty l β b ty'
+    `{!∀ x y, OptionableAgree (ty y x) ty'} T:
+    (l ◁ₗ{β} ty' -∗ ∃ y x, <affine> ⌜b y = Some x⌝ ∗ l ◁ₗ{β} ty y x ∗ T y)
+    ⊢ subsume (l ◁ₗ{β} ty') (λ y : B, l ◁ₗ{β} (b y) @ optionalO (ty y) (optty y)) T.
+  Proof.
+    iIntros "Hsub Hl". iDestruct ("Hsub" with "Hl") as (?? Heq) "[??]".
+    iExists _. iFrame. by rewrite Heq.
+  Qed.
+  Definition subsume_optionalO_ty_inst := [instance subsume_optionalO_ty].
+  Global Existing Instance subsume_optionalO_ty_inst.
+
+  Lemma subsume_optionalO_optty_val B A (ty : B → A → type) optty v b T:
+    (∃ x, <affine> ⌜b x = None⌝ ∗ T x) ⊢ subsume (v ◁ᵥ optty) (λ x : B, v ◁ᵥ (b x) @ optionalO (ty x) optty) T.
+  Proof. iIntros "[% [%Heq ?]] Hl". iExists _. iFrame. by rewrite Heq. Qed.
+  Definition subsume_optionalO_optty_val_inst := [instance subsume_optionalO_optty_val].
+  Global Existing Instance subsume_optionalO_optty_val_inst.
+
+  Lemma subsume_optionalO_ty_val B A (ty : B → A → type) optty v b ty'
+    `{!∀ y x, OptionableAgree (ty y x) ty'} T:
+    (v ◁ᵥ ty' -∗ ∃ y x, <affine> ⌜b y = Some x⌝ ∗ v ◁ᵥ ty y x ∗ T y)
+    ⊢ subsume (v ◁ᵥ ty') (λ y : B, v ◁ᵥ (b y) @ optionalO (ty y) (optty y)) T.
+  Proof.
+    iIntros "Hsub Hl". iDestruct ("Hsub" with "Hl") as (?? Heq) "[??]".
+    iExists _. iFrame. by rewrite Heq.
+  Qed.
+  Definition subsume_optionalO_ty_val_inst := [instance subsume_optionalO_ty_val].
+  Global Existing Instance subsume_optionalO_ty_val_inst.
+
+  Lemma subsume_optional_optionalO_val B ty optty b v T:
+    (∃ x, T x) ⊢
+    subsume (v ◁ᵥ b @ optional ty optty) (λ x : B, v ◁ᵥ optionalO (λ _ : (), ty) optty) T.
+  Proof.
+    unfold optional; simpl_type. iIntros "[% ?] [[% ?]|[% ?]]";
+      iExists _; iFrame; [iExists (Some ())|iExists None]; iFrame.
+  Qed.
+  Definition subsume_optional_optionalO_val_inst := [instance subsume_optional_optionalO_val].
+  Global Existing Instance subsume_optional_optionalO_val_inst.
+
+  Inductive trace_optionalO :=
+  | TraceOptionalO.
+
+  Lemma type_eq_optionalO A v1 v2 (ty : A → type) optty ot1 ot2 `{!∀ x, Optionable (ty x) optty ot1 ot2}
+    `{!Affine (v2 ◁ᵥ optty)} b `{!Inhabited A} T :
+    ⎡opt_pre (ty (default inhabitant b)) v1 v2⎤ ∧
+    case_destruct b (λ b _,
+      li_trace (TraceOptionalO, b) (∀ v, ⎡if b is Some x then v1 ◁ᵥ ty x else v1 ◁ᵥ optty⎤ -∗
+         T v ((if b is Some x then false else true) @ boolean tint)))
+    ⊢ typed_bin_op v1 ⎡v1 ◁ᵥ b @ optionalO ty optty⎤ v2 ⎡v2 ◁ᵥ optty⎤ Oeq ot1 ot2 T.
+  Proof.
+    unfold li_trace. iIntros "HT Hv1 Hv2". iIntros (Φ) "HΦ".
+    destruct b.
+    - iIntros "!>" (?) "Hctx !>".
+      iExists (i2v (bool_to_Z false) tint).
+      iSplit. {
+        iStopProof; split => rho; monPred.unseal.
+        iIntros "([Hpre _] & Hv1 & Hv2 & _ & Hctx)".
+        iDestruct (opt_bin_op true true with "Hpre [$Hv1] [$Hv2] Hctx") as %Hiff.
+        iPureIntro; intros. simpl in Hiff. rewrite Hiff //.
+      }
+      iDestruct "HT" as "[_ [% HT]]".
+      iDestruct ("HT" with "Hv1") as "HT". iFrame.
+      iApply "HΦ" => //. iExists _. iSplit; iPureIntro; done.
+    - iIntros "!>" (?) "Hctx !>".
+      iExists (i2v (bool_to_Z true) tint).
+      iSplit. {
+        iStopProof; split => rho; monPred.unseal.
+        iIntros "([Hpre _] & Hv1 & Hv2 & _ & Hctx)".
+        iDestruct (opt_bin_op false true with "Hpre [$Hv1] [$Hv2] Hctx") as %Hiff.
+        iPureIntro; intros. simpl in Hiff. rewrite Hiff //.
+      }
+      iDestruct "HT" as "[_ [% HT]]".
+      iDestruct ("HT" with "Hv1") as "HT". iFrame.
+      iApply "HΦ" => //. iExists _. iSplit; iPureIntro; done.
+  Qed.
+  Definition type_eq_optionalO_inst := [instance type_eq_optionalO].
+  Global Existing Instance type_eq_optionalO_inst.
+
+  Lemma type_neq_optionalO A v1 v2 (ty : A → type) optty ot1 ot2 `{!∀ x, Optionable (ty x) optty ot1 ot2}
+    `{!Affine (v2 ◁ᵥ optty)} b `{!Inhabited A} T :
+    ⎡opt_pre (ty (default inhabitant b)) v1 v2⎤ ∧
+    case_destruct b (λ b _,
+      li_trace (TraceOptionalO, b) (∀ v, ⎡if b is Some x then v1 ◁ᵥ ty x else v1 ◁ᵥ optty⎤ -∗ T v ((if b is Some x then true else false) @ boolean tint)))
+    ⊢ typed_bin_op v1 ⎡v1 ◁ᵥ b @ optionalO ty optty⎤ v2 ⎡v2 ◁ᵥ optty⎤ Cop.One ot1 ot2 T.
+  Proof.
+    unfold li_trace. iIntros "HT Hv1 Hv2". iIntros (Φ) "HΦ".
+    destruct b.
+    - iIntros "!>" (?) "Hctx !>".
+      iExists (i2v (bool_to_Z true) tint).
+      iSplit. {
+        iStopProof; split => rho; monPred.unseal.
+        iIntros "([Hpre _] & Hv1 & Hv2 & _ & Hctx)".
+        iDestruct (opt_bin_op true false with "Hpre [$Hv1] [$Hv2] Hctx") as %Hiff.
+        iPureIntro; intros. simpl in Hiff. rewrite Hiff //.
+      }
+      iDestruct "HT" as "[_ [% HT]]".
+      iDestruct ("HT" with "Hv1") as "HT". iFrame.
+      iApply "HΦ" => //. iExists _. iSplit; iPureIntro; done.
+    - iIntros "!>" (?) "Hctx !>".
+      iExists (i2v (bool_to_Z false) tint).
+      iSplit. {
+        iStopProof; split => rho; monPred.unseal.
+        iIntros "([Hpre _] & Hv1 & Hv2 & _ & Hctx)".
+        iDestruct (opt_bin_op false false with "Hpre [$Hv1] [$Hv2] Hctx") as %Hiff.
+        iPureIntro; intros. simpl in Hiff. rewrite Hiff //.
+      }
+      iDestruct "HT" as "[_ [% HT]]".
+      iDestruct ("HT" with "Hv1") as "HT". iFrame.
+      iApply "HΦ" => //. iExists _. iSplit; iPureIntro; done.
+  Qed.
+  Definition type_neq_optionalO_inst := [instance type_neq_optionalO].
+  Global Existing Instance type_neq_optionalO_inst.
+
+  (* FIX ME: We don't have typed_read_end *)
+(*
+  Lemma read_optionalO_case A E l b (ty : A → type) optty ly mc a (T : val → type → _):
+    case_destruct b (λ b _, li_trace (TraceOptionalO, b)
+     (typed_read_end a E l Own (if b is Some x then ty x else optty) ly mc T))
+    ⊢ typed_read_end a E l Own (b @ optionalO ty optty) ly mc T.
+  Proof. iDestruct 1 as (_) "?". by destruct b. Qed.
+  (* This should be tried very late *)
+  Definition read_optionalO_case_inst := [instance read_optionalO_case].
+  Global Existing Instance read_optionalO_case_inst | 1001.
+*)
+  Global Program Instance optionalO_copyable A (ty : A → type) optty x `{!∀ x, Copyable (ty x)} `{!Copyable optty} : Copyable (x @ optionalO ty optty).
+  Next Obligation. Admitted.
+  Next Obligation.
+    iIntros (A ty optty x ? ? E ly l ? [Hty ?]). unfold optionalO; simpl_type. destruct x.
+    all: iIntros "Hl".
+    all: iMod (copy_shr_acc with "Hl") as (Hl ? ?) "[?[??]]" => //; try apply: Hty.
+    all: iModIntro; iSplit => //=.
+    all: iExists _, _; iFrame.
+  Qed.
+End optionalO.
+Global Typeclasses Opaque optionalO_type optionalO.
+Notation "optionalO< ty , optty >" := (optionalO ty optty)
+  (only printing, format "'optionalO<' ty ,  optty '>'") : printing_sugar.
diff --git a/refinedVST/typing/own.v b/refinedVST/typing/own.v
new file mode 100644
index 0000000000..ea99322c83
--- /dev/null
+++ b/refinedVST/typing/own.v
@@ -0,0 +1,736 @@
+From VST.typing Require Export type.
+From VST.typing Require Import programs optional boolean int singleton.
+From VST.typing Require Import type_options.
+
+Section own.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  Local Typeclasses Transparent place.
+
+  (* Separate definition such that we can make it typeclasses opaque later. *)
+  Program Definition frac_ptr_type (β : own_state) (ty : type) (l' : address) : type := {|
+    ty_has_op_type ot mt := (∃ t, ot = tptr t)%type;
+    ty_own β' l := (<affine> ⌜field_compatible (tptr tvoid) [] l⌝ ∗ l ↦_(tptr tvoid)[β'] l' ∗ (l' ◁ₗ{own_state_min β' β} ty))%I;
+    ty_own_val v := (<affine> ⌜v = adr2val l'⌝ ∗ l' ◁ₗ{β} ty)%I;
+  |}.
+  Next Obligation.
+    iIntros (β ?????) "($&Hl&H)". rewrite left_id.
+    iMod (heap_mapsto_own_state_share with "Hl") as "$".
+    destruct β => //=. by iApply ty_share.
+  Qed.
+  Next Obligation. iIntros (β ty l ot mt l' (? & ->)). unfold has_layout_loc. rewrite !field_compatible_tptr. by iDestruct 1 as (?) "_". Qed.
+  Next Obligation. iIntros (β ty l ot mt l' (? & ->)).
+    iIntros "(-> & ?)"; iPureIntro. intros ?; hnf. simple_if_tac; done. Qed.
+  Next Obligation. iIntros (β ty l ot mt l' (? & ->)) "(%&Hl&Hl')". rewrite left_id. unfold heap_mapsto_own_state. erewrite mapsto_tptr. eauto with iFrame. Qed.
+  Next Obligation. iIntros (β ty l ot mt l' v (? & ->) ?) "Hl [-> Hl']". unfold has_layout_loc in *. rewrite field_compatible_tptr in H. unfold heap_mapsto_own_state. erewrite mapsto_tptr. by iFrame. Qed.
+(*   Next Obligation.
+    iIntros (β ty l v ot mt st ?). apply: mem_cast_compat_loc; [done|].
+    iIntros "[-> ?]". iPureIntro. naive_solver.
+  Qed. *)
+  Global Instance frac_ptr_type_le : Proper ((=) ==> (⊑) ==> (=) ==> (⊑)) frac_ptr_type.
+  Proof. solve_type_proper. Qed.
+  Global Instance frac_ptr_type_proper : Proper ((=) ==> (≡) ==> (=) ==> (≡)) frac_ptr_type.
+  Proof. solve_type_proper. Qed.
+
+  Definition frac_ptr (β : own_state) (ty : type) : rtype _ := RType (frac_ptr_type β ty).
+
+(*   Global Instance frac_ptr_loc_in_bounds l ty β1 β2 : LocInBounds (l @ frac_ptr β1 ty) β2 bytes_per_addr.
+  Proof.
+    constructor. iIntros (?) "(_&Hl&_)".
+    iDestruct (heap_mapsto_own_state_loc_in_bounds with "Hl") as "Hb".
+    iApply loc_in_bounds_shorten; last done. by rewrite /val_of_loc.
+  Qed. *)
+
+  Lemma frac_ptr_mono A ty1 ty2 l β β' p p' T:
+    (p ◁ₗ{own_state_min β β'} ty1 -∗ ∃ x, <affine> ⌜p = p' x⌝ ∗ p ◁ₗ{own_state_min β β'} (ty2 x) ∗ T x)
+    ⊢ subsume (l ◁ₗ{β} p @ frac_ptr β' ty1) (λ x : A, l ◁ₗ{β} (p' x) @ frac_ptr β' (ty2 x)) T.
+  Proof.
+    iIntros "HT [% [? Hl]]". iDestruct ("HT" with "Hl") as (? ->) "[??]".
+    iExists _. by iFrame.
+  Qed.
+  Definition frac_ptr_mono_inst := [instance frac_ptr_mono].
+  Global Existing Instance frac_ptr_mono_inst.
+
+  Global Instance frac_ptr_simple_mono ty1 ty2 p β P `{!SimpleSubsumePlace ty1 ty2 P}:
+    SimpleSubsumePlace (p @ frac_ptr β ty1) (p @ frac_ptr β ty2) P.
+  Proof. iIntros (l β') "HP [$ [$ Hl]]". iApply (@simple_subsume_place with "HP Hl"). Qed.
+
+(*   Lemma type_place_frac p β K β1 ty1 l mc T:
+    typed_place K p (own_state_min β1 β) ty1 (λ l2 β2 ty2 typ, T l2 β2 ty2 (λ t, (p @ (frac_ptr β (typ t)))))
+    ⊢ typed_place (DerefPCtx Na1Ord PtrOp mc :: K) l β1 (p @ (frac_ptr β ty1)) T.
+  Proof.
+    iIntros "HP" (Φ) "(%&Hm&Hl) HΦ" => /=.
+    iMod (heap_mapsto_own_state_to_mt with "Hm") as (q Hq) "Hm" => //.
+    iApply (wp_deref with "Hm") => //; [naive_solver| by apply val_to_of_loc|].
+    iIntros "!# %st Hm". iExists p. rewrite mem_cast_id_loc. iSplit; [by destruct mc|].
+    iApply ("HP" with "Hl"). iIntros (l' ty2 β2 typ R) "Hl' Htyp HT".
+    iApply ("HΦ" with "Hl' [-HT] HT"). iIntros (ty') "Hl'".
+    iMod ("Htyp" with "Hl'") as "[? $]". iFrame. iSplitR => //.
+    by iApply heap_mapsto_own_state_from_mt.
+  Qed.
+  Definition type_place_frac_inst := [instance type_place_frac].
+  Global Existing Instance type_place_frac_inst. *)
+
+(*   Lemma type_addr_of e ot (T : val → _):
+    typed_addr_of e (λ l β ty, T l (l @ frac_ptr β ty))
+    ⊢ typed_val_expr (Eaddrof e ot) T.
+  Proof.
+    iIntros "Haddr" (Φ) "HΦ". rewrite /AddrOf.
+    iApply "Haddr". iIntros (l β ty) "Hl HT".
+    iApply ("HΦ" with "[Hl] HT").
+    iSplit => //.
+  Qed. *)
+
+  Lemma simplify_frac_ptr (v : val) (p : address) ty β T:
+    (<affine> ⌜v = p⌝ -∗ p ◁ₗ{β} ty -∗ T)
+    ⊢ simplify_hyp (v◁ᵥ p @ frac_ptr β ty) T.
+  Proof. iIntros "HT Hl". iDestruct "Hl" as (->) "Hl". by iApply "HT". Qed.
+  Definition simplify_frac_ptr_inst := [instance simplify_frac_ptr with 0%N].
+  Global Existing Instance simplify_frac_ptr_inst.
+
+  Lemma simplify_goal_frac_ptr_val ty (v : val) β (p : address) T:
+    <affine> ⌜v = p⌝ ∗ p ◁ₗ{β} ty ∗ T
+    ⊢ simplify_goal (v ◁ᵥ p @ frac_ptr β ty) T.
+  Proof. by iIntros "[-> [$ $]]". Qed.
+  Definition simplify_goal_frac_ptr_val_inst := [instance simplify_goal_frac_ptr_val with 0%N].
+  Global Existing Instance simplify_goal_frac_ptr_val_inst.
+
+  Lemma simplify_goal_frac_ptr_val_unrefined ty (v : val) β T:
+    (∃ p : address, <affine> ⌜v = p⌝ ∗ p ◁ₗ{β} ty ∗ T)
+    ⊢ simplify_goal (v ◁ᵥ frac_ptr β ty) T.
+  Proof. iIntros "[% [-> [? $]]]". iExists _. by iSplit. Qed.
+  Definition simplify_goal_frac_ptr_val_unrefined_inst :=
+    [instance simplify_goal_frac_ptr_val_unrefined with 0%N].
+  Global Existing Instance simplify_goal_frac_ptr_val_unrefined_inst.
+
+  Lemma simplify_frac_ptr_place_shr_to_own l p1 p2 β T:
+    (⌜p1 = p2⌝ -∗ l ◁ₗ{β} p1 @ frac_ptr Own (place p2) -∗ T)
+    ⊢ simplify_hyp (l ◁ₗ{β} p1 @ frac_ptr Shr (place p2)) T.
+  Proof. iIntros "HT (%&Hl&%)". subst. iApply "HT" => //. by iFrame. Qed.
+  Definition simplify_frac_ptr_place_shr_to_own_inst :=
+    [instance simplify_frac_ptr_place_shr_to_own with 50%N].
+  Global Existing Instance simplify_frac_ptr_place_shr_to_own_inst.
+
+  (*
+  TODO: revisit this comment
+  Ideally we would like to have this version:
+  Lemma own_val_to_own_place v l ty β T:
+    val_to_loc v = Some l →
+    l ◁ₗ{β} ty ∗ T
+    ⊢ v ◁ᵥ l @ frac_ptr β ty ∗ T.
+  Proof. by iIntros (->%val_of_to_loc) "[$ $]". Qed.
+  But the sidecondition is a problem since solving it requires
+  calling apply which triggers https://github.com/coq/coq/issues/6583
+  and can make the application of this lemma fail if it tries to solve
+  a Movable (tc_opaque x) in the context. *)
+
+  Lemma own_val_to_own_place (l : address) ty β T:
+    l ◁ₗ{β} ty ∗ T
+    ⊢ l ◁ᵥ l @ frac_ptr β ty ∗ T.
+  Proof. by iIntros "[$ $]". Qed.
+
+  Lemma own_val_to_own_place_singleton (l : address) β T:
+    T
+    ⊢ l ◁ᵥ l @ frac_ptr β (place l) ∗ T.
+  Proof. by iIntros "$". Qed.
+
+(*   Lemma type_offset_of_sub v1 l s m P ly t T:
+    ⌜ly_size ly = 1%nat⌝ ∗ (
+      (P -∗ loc_in_bounds l 0 ∗ True) ∧ (P -∗ T (val_of_loc l) (l @ frac_ptr Own (place l))))
+    ⊢ typed_bin_op v1 (v1 ◁ᵥ offsetof s m) (l at{s}ₗ m) P (PtrNegOffsetOp ly) size_t (tptr t) T.
+  Proof.
+    iDestruct 1 as (Hly) "HT". unfold offsetof, int, int_inner_type; simpl_type.
+    iIntros ([n [Ho Hi]]) "HP". iIntros (Φ) "HΦ".
+    iAssert (loc_in_bounds l 0) as "#Hlib".
+    { iDestruct "HT" as "[HT _]". by iDestruct ("HT" with "HP") as "[$ _]". }
+    iDestruct "HT" as "[_ HT]".
+    iApply wp_ptr_neg_offset; [by apply val_to_of_loc|done|..].
+    all: rewrite offset_loc_sz1 // /GetMemberLoc shift_loc_assoc Ho /= Z.add_opp_diag_r shift_loc_0.
+    1: done.
+    iModIntro. iApply "HΦ"; [ | by iApply "HT"]. done.
+  Qed.
+  Definition type_offset_of_sub_inst := [instance type_offset_of_sub].
+  Global Existing Instance type_offset_of_sub_inst. *)
+
+(*   Lemma type_cast_ptr_ptr p β ty T:
+    (T (addr_to_val p) (p @ frac_ptr β ty))
+    ⊢ typed_un_op p (p ◁ₗ{β} ty) (CastOp PtrOp) PtrOp T.
+  Proof.
+    iIntros "HT Hp" (Φ) "HΦ".
+    iApply wp_cast_loc; [by apply val_to_of_loc|].
+    iApply ("HΦ" with "[Hp] HT") => //. by iFrame.
+  Qed.
+  Definition type_cast_ptr_ptr_inst := [instance type_cast_ptr_ptr].
+  Global Existing Instance type_cast_ptr_ptr_inst. *)
+
+  Lemma type_if_ptr_own l β ty t T1 T2:
+    (l ◁ₗ{β} ty -∗ (*(loc_in_bounds l 0 ∗ True) ∧*) T1)
+    ⊢ typed_if (tptr t) l (l ◁ₗ{β} ty) T1 T2.
+  Proof.
+    iIntros "HT1 Hl".
+    iDestruct ("HT1" with "Hl") as "HT".
+    rewrite /adr2val /sem_cast /=.
+    rewrite andb_false_r /=.
+    eauto.
+  Qed.
+  Definition type_if_ptr_own_inst := [instance type_if_ptr_own].
+  Global Existing Instance type_if_ptr_own_inst.
+
+(*   Lemma type_assert_ptr_own l β ty t s fn ls R Q:
+    (l ◁ₗ{β} ty -∗ (*(loc_in_bounds l 0 ∗ True) ∧*) typed_stmt s fn ls R Q)
+    ⊢ typed_assert (tptr t) l (l ◁ₗ{β} ty) s fn ls R Q.
+  Proof.
+    iIntros "HT1 Hl".
+    iDestruct ("HT1" with "Hl") as "[[#Hlib _] HT]".
+    iDestruct (loc_in_bounds_has_alloc_id with "Hlib") as %[? H].
+    iExists l. iSplit; first by rewrite val_to_of_loc.
+    iSplit. { iPureIntro. move: l H => [??] /= -> //. }
+    iSplitR. { by iApply wp_if_precond_alloc. }
+    by iApply "HT".
+  Qed.
+  Definition type_assert_ptr_own_inst := [instance type_assert_ptr_own].
+  Global Existing Instance type_assert_ptr_own_inst.
+
+  Lemma type_place_cast_ptr_ptr K l ty β T:
+    typed_place K l β ty T
+    ⊢ typed_place (UnOpPCtx (CastOp PtrOp) :: K) l β ty T.
+  Proof.
+    iIntros "HP" (Φ) "Hl HΦ" => /=.
+    iApply wp_cast_loc. { by apply val_to_of_loc. }
+    iIntros "!#". iExists _. iSplit => //.
+    iApply ("HP" with "Hl"). iIntros (l' ty2 β2 typ R) "Hl' Htyp HT".
+    iApply ("HΦ" with "Hl' [-HT] HT"). iIntros (ty') "Hl'".
+    iMod ("Htyp" with "Hl'") as "[? $]". by iFrame.
+  Qed.
+  Definition type_place_cast_ptr_ptr_inst := [instance type_place_cast_ptr_ptr].
+  Global Existing Instance type_place_cast_ptr_ptr_inst.
+
+  Lemma type_cast_int_ptr n v it T:
+    (⌜n ∈ it⌝ -∗ ∀ oid, T (val_of_loc (oid, n)) ((oid, n) @ frac_ptr Own (place (oid, n))))
+    ⊢ typed_un_op v (v ◁ᵥ n @ int it) (CastOp PtrOp) (IntOp it) T.
+  Proof.
+    unfold int; simpl_type.
+    iIntros "HT" (Hn Φ) "HΦ".
+    iDestruct ("HT" with "[%]") as "HT".
+    { by apply: val_to_Z_in_range. }
+    iApply wp_cast_int_ptr_weak => //.
+    iIntros (i') "!>". by iApply ("HΦ" with "[] HT").
+  Qed.
+  Definition type_cast_int_ptr_inst := [instance type_cast_int_ptr].
+  Global Existing Instance type_cast_int_ptr_inst | 50.
+
+  Lemma type_copy_aid v a it l β ty T:
+    (l ◁ₗ{β} ty -∗
+      (loc_in_bounds (l.1, a) 0 ∗ True) ∧
+      (alloc_alive_loc l ∗ True) ∧
+      T (val_of_loc (l.1, a)) ((l.1, a) @ frac_ptr Own (place (l.1, a))))
+    ⊢ typed_copy_alloc_id v (v ◁ᵥ a @ int it) l (l ◁ₗ{β} ty) (IntOp it) T.
+  Proof.
+    unfold int; simpl_type.
+    iIntros "HT %Hv Hl" (Φ) "HΦ". iDestruct ("HT" with "Hl") as "HT".
+    rewrite !right_id. iDestruct "HT" as "[#Hlib HT]".
+    iApply wp_copy_alloc_id; [ done | by rewrite val_to_of_loc | done | ].
+    iSplit; [by iDestruct "HT" as "[$ _]" |].
+    iDestruct "HT" as "[_ HT]".
+    by iApply ("HΦ" with "[] HT").
+  Qed.
+  Definition type_copy_aid_inst := [instance type_copy_aid].
+  Global Existing Instance type_copy_aid_inst. *)
+
+  Open Scope Z.
+
+  (* TODO: Is it a good idea to have this general rule or would it be
+  better to have more specialized rules? *)
+  Lemma type_relop_ptr_ptr (l1 l2 : address) op b β1 β2 ty1 ty2 t1 t2
+    (Hop : match op with
+           | Olt => Some (bool_decide (l1.2 < l2.2))
+           | Ogt => Some (bool_decide (l1.2 > l2.2))
+           | Ole => Some (bool_decide (l1.2 <= l2.2))
+           | Oge => Some (bool_decide (l1.2 >= l2.2))
+           | _ => None
+           end = Some b) T:
+    (⎡l1 ◁ₗ{β1} ty1⎤ -∗ ⎡l2 ◁ₗ{β2} ty2⎤ -∗ <affine> ⌜l1.1 = l2.1⌝ ∗ (
+      ⌜0 ≤ l1.2 ≤ Ptrofs.max_unsigned ∧ 0 ≤ l2.2 ≤ Ptrofs.max_unsigned⌝ ∧
+      ⎡expr.weak_valid_pointer l1⎤ ∧ ⎡expr.weak_valid_pointer l2⎤ ∧
+      T (i2v (bool_to_Z b) tint) (b @ boolean tint)))
+    ⊢ typed_bin_op l1 ⎡l1 ◁ₗ{β1} ty1⎤ l2 ⎡l2 ◁ₗ{β2} ty2⎤ op (tptr t1) (tptr t2) T.
+  Proof.
+    iIntros "HT Hl1 Hl2". iIntros (Φ) "HΦ". iDestruct ("HT" with "Hl1 Hl2") as (Heq (? & ?)) "HT".
+    iIntros "!>" (?) "Hm !>".
+    iDestruct (binop_lemmas4.weak_valid_pointer_dry with "[$Hm HT]") as %H1.
+    { iDestruct "HT" as "($ & _)". }
+    iDestruct (binop_lemmas4.weak_valid_pointer_dry with "[$Hm HT]") as %H2.
+    { iDestruct "HT" as "(_ & $ & _)". }
+    iFrame; iExists (i2v (bool_to_Z b) tint); iSplit.
+    - iStopProof; split => rho; monPred.unseal.
+      apply bi.pure_intro.
+      assert (classify_cmp (tptr t1) (tptr t2) = cmp_case_pp) as Hclass by done.
+      rewrite -val_of_bool_eq.
+      destruct op => //; simplify_eq; simpl; rewrite /Cop.sem_cmp Hclass /cmp_ptr /= if_true // H1 H2 /=.
+      + rewrite /Ptrofs.ltu !Ptrofs.unsigned_repr //.
+      + rewrite /Ptrofs.ltu !Ptrofs.unsigned_repr //.
+        case_bool_decide; destruct (zlt _ _); (done || lia).
+      + rewrite /Ptrofs.ltu !Ptrofs.unsigned_repr //.
+        case_bool_decide; destruct (zlt _ _); (done || lia).
+      + rewrite /Ptrofs.ltu !Ptrofs.unsigned_repr //.
+        case_bool_decide; destruct (zlt _ _); (done || lia).
+    - iDestruct "HT" as "(_ & _ & HT)".
+      iApply ("HΦ" with "[] HT") => //.
+      iExists _; iSplit; iPureIntro; try done.
+      by destruct b.
+  Qed.
+  Definition type_lt_ptr_ptr_inst l1 l2 :=
+    [instance type_relop_ptr_ptr l1 l2 Olt (bool_decide (l1.2 < l2.2))].
+  Global Existing Instance type_lt_ptr_ptr_inst.
+  Definition type_gt_ptr_ptr_inst l1 l2 :=
+    [instance type_relop_ptr_ptr l1 l2 Ogt (bool_decide (l1.2 > l2.2))].
+  Global Existing Instance type_gt_ptr_ptr_inst.
+  Definition type_le_ptr_ptr_inst l1 l2 :=
+    [instance type_relop_ptr_ptr l1 l2 Ole (bool_decide (l1.2 <= l2.2))].
+  Global Existing Instance type_le_ptr_ptr_inst.
+  Definition type_ge_ptr_ptr_inst l1 l2 :=
+    [instance type_relop_ptr_ptr l1 l2 Oge (bool_decide (l1.2 >= l2.2))].
+  Global Existing Instance type_ge_ptr_ptr_inst.
+
+
+  (* Lemma type_roundup_frac_ptr v2 β ty P2 T p: *)
+  (*   (P2 -∗ T (val_of_loc p) (t2mt (p @ frac_ptr β ty))) ⊢ *)
+  (*     typed_bin_op p (p ◁ₗ{β} ty) v2 P2 RoundUpOp T. *)
+  (* Proof. *)
+  (*   iIntros "HT Hv1 Hv2". iIntros (Φ) "HΦ". *)
+  (*   iApply wp_binop_det. by move => h /=; rewrite val_to_of_loc. *)
+  (*   iApply ("HΦ" with "[Hv1]"); last by iApply "HT". *)
+  (*   by iFrame. *)
+  (* Qed. *)
+  (* Global Instance type_roundup_frac_ptr_inst v2 β ty P2 T (p : address) : *)
+  (*   TypedBinOp p (p ◁ₗ{β} ty) v2 P2 RoundUpOp T := *)
+  (*   i2p (type_roundup_frac_ptr v2 β ty P2 T p). *)
+
+  (* Lemma type_rounddown_frac_ptr v2 β ty P2 T p: *)
+  (*   (P2 -∗ T (val_of_loc p) (t2mt (p @ frac_ptr β ty))) ⊢ *)
+  (*     typed_bin_op p (p ◁ₗ{β} ty) v2 P2 RoundDownOp T. *)
+  (* Proof. *)
+  (*   iIntros "HT Hv1 Hv2". iIntros (Φ) "HΦ". *)
+  (*   iApply wp_binop_det. by move => h /=; rewrite val_to_of_loc. *)
+  (*   iApply ("HΦ" with "[Hv1]"); last by iApply "HT". *)
+  (*   by iFrame. *)
+  (* Qed. *)
+  (* Global Instance type_rounddown_frac_ptr_inst v2 β ty P2 T (p : address) : *)
+  (*   TypedBinOp p (p ◁ₗ{β} ty) v2 P2 RoundDownOp T := *)
+  (*   i2p (type_rounddown_frac_ptr v2 β ty P2 T p). *)
+
+  Global Program Instance shr_copyable p ty : Copyable (p @ frac_ptr Shr ty).
+  Next Obligation.
+  Admitted.
+  Next Obligation.
+    iIntros (p ty E ot l ? (t & ->)) "(%&#Hmt&#Hty)".
+    iMod (heap_mapsto_own_state_to_mt with "Hmt") as (q) "[_ Hl]" => //.
+    unfold has_layout_loc.
+    rewrite field_compatible_tptr; erewrite mapsto_tptr; iSplitR => //.
+    iExists _, _. iFrame. iModIntro. iSplit => //.
+    - iIntros "!>"; by iSplit.
+    - by iIntros "_".
+  Qed.
+
+  Lemma find_in_context_type_loc_own l T:
+    (∃ l1 β1 β ty, l1 ◁ₗ{β1} (l @ frac_ptr β ty) ∗ (l1 ◁ₗ{β1} (l @ frac_ptr β (place l)) -∗
+      T (own_state_min β1 β, ty)))
+    ⊢ find_in_context (FindLoc l) T.
+  Proof.
+    iDestruct 1 as (l1 β1 β ty) "[[% [Hmt Hl]] HT]".
+    iExists (_, _) => /=. iFrame. iApply "HT".
+    iSplit => //. by iFrame.
+  Qed.
+  Definition find_in_context_type_loc_own_inst :=
+    [instance find_in_context_type_loc_own with FICSyntactic].
+  Global Existing Instance find_in_context_type_loc_own_inst | 10.
+
+  Lemma find_in_context_type_val_own l T:
+    (∃ ty : type, ⎡l ◁ₗ ty⎤ ∗ T (l @ frac_ptr Own ty))
+    ⊢ find_in_context (FindVal l) T.
+  Proof. iDestruct 1 as (ty) "[Hl HT]". iExists _ => /=. by iFrame. Qed.
+  Definition find_in_context_type_val_own_inst :=
+    [instance find_in_context_type_val_own with FICSyntactic].
+  Global Existing Instance find_in_context_type_val_own_inst | 10.
+
+  Lemma find_in_context_type_val_own_singleton (l : address) T:
+    (emp ∗ T (l @ frac_ptr Own (place l)))
+    ⊢ find_in_context (FindVal l) T.
+  Proof. iIntros "[_ HT]". iExists _ => /=. iFrame "HT". simpl. done. Qed.
+  Definition find_in_context_type_val_own_singleton_inst :=
+    [instance find_in_context_type_val_own_singleton with FICSyntactic].
+  Global Existing Instance find_in_context_type_val_own_singleton_inst | 20.
+
+  (* We cannot use place here as it can easily lead to an infinite
+  loop during type checking. Thus, we define place' that is not
+  unfolded as eagerly as place. You probably should not add typing
+  rules for place', but for place instead. *)
+  Definition place' (l : address) : type := place l.
+  Lemma find_in_context_type_val_P_own_singleton (l : address) T:
+    (emp ∗ T (l ◁ₗ place' l))
+    ⊢ find_in_context (FindValP l) T.
+  Proof. rewrite /place'. iIntros "[_ HT]". iExists _. iFrame "HT" => //=. Qed.
+  Definition find_in_context_type_val_P_own_singleton_inst :=
+    [instance find_in_context_type_val_P_own_singleton with FICSyntactic].
+  Global Existing Instance find_in_context_type_val_P_own_singleton_inst | 30.
+End own.
+Global Typeclasses Opaque place'.
+Notation "place'< l >" := (place' l) (only printing, format "'place'<' l '>'") : printing_sugar.
+
+Notation "&frac{ β }" := (frac_ptr β) (format "&frac{ β }") : bi_scope.
+Notation "&own" := (frac_ptr Own) (format "&own") : bi_scope.
+Notation "&shr" := (frac_ptr Shr) (format "&shr") : bi_scope.
+
+Notation "&frac< β , ty >" := (frac_ptr β ty) (only printing, format "'&frac<' β ,  ty '>'") : printing_sugar.
+Notation "&own< ty >" := (frac_ptr Own ty) (only printing, format "'&own<' ty '>'") : printing_sugar.
+Notation "&shr< ty >" := (frac_ptr Shr ty) (only printing, format "'&shr<' ty '>'") : printing_sugar.
+
+Section ptr.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  (* Should loc_in_bounds be replaced with valid_pointer'? But that would take a piece of ownership of l'. *)
+  Program Definition ptr_type (n : nat) (l' : address) : type := {|
+    ty_has_op_type ot mt := (∃ t, ot = tptr t)%type;
+    ty_own β l := (<affine> ⌜field_compatible (tptr tvoid) [] l⌝ ∗ (*loc_in_bounds l' n ∗*) l ↦_(tptr tvoid)[β] l')%I;
+    ty_own_val v := (<affine> ⌜v = adr2val l'⌝ (*∗ loc_in_bounds l' n*))%I;
+  |}.
+  Next Obligation. iIntros (????). iDestruct 1 as "[$ ?]". by iApply heap_mapsto_own_state_share. Qed.
+  Next Obligation. iIntros (n l ot mt l' (? & ->)). iDestruct 1 as (?) "_". rewrite /has_layout_loc field_compatible_tptr //. Qed.
+  Next Obligation. iIntros (n l ot mt l' (? & ->) ->). iPureIntro. intros ?; hnf. simple_if_tac; done. Qed.
+  Next Obligation. iIntros (n l ot mt v (? & ->)) "[? Hl]". unfold heap_mapsto_own_state. erewrite mapsto_tptr. eauto with iFrame. Qed.
+  Next Obligation. iIntros (n l ot mt l' v (? & ->) ?) "Hl ->". rewrite /has_layout_loc field_compatible_tptr in H; unfold heap_mapsto_own_state; erewrite mapsto_tptr; by iFrame. Qed.
+(*   Next Obligation.
+    iIntros (n l v ot mt st ?). apply mem_cast_compat_loc; [done|].
+    iIntros "[-> ?]". iPureIntro. naive_solver.
+  Qed. *)
+
+  Definition ptr (n : nat) : rtype _ := RType (ptr_type n).
+
+(*   Instance ptr_loc_in_bounds l n β : LocInBounds (l @ ptr n) β bytes_per_addr.
+  Proof.
+    constructor. iIntros (?) "[_ [_ Hl]]".
+    iDestruct (heap_mapsto_own_state_loc_in_bounds with "Hl") as "Hb".
+    iApply loc_in_bounds_shorten; last done. by rewrite /val_of_loc.
+  Qed. *)
+
+   Lemma simplify_ptr_hyp_place (p:address) l t n T:
+    ((*loc_in_bounds p n -∗*) l ◁ₗ value (tptr t) (adr2val p) -∗ T)
+    ⊢ simplify_hyp (l ◁ₗ p @ ptr n) T.
+  Proof.
+    iIntros "HT [% Hl]". iApply "HT". unfold value; simpl_type.
+    rewrite /heap_mapsto_own_state.
+    rewrite field_compatible_tptr; erewrite mapsto_tptr.
+    repeat iSplit => //. iPureIntro. rewrite /tc_val' /= andb_false_r //.
+  Qed.
+  Definition simplify_ptr_hyp_place_inst := [instance simplify_ptr_hyp_place with 0%N].
+  Global Existing Instance simplify_ptr_hyp_place_inst.
+
+  Lemma simplify_ptr_goal_val (p:address) l n T:
+    <affine> ⌜l = p⌝ ∗ (*loc_in_bounds l n ∗*) T  ⊢ simplify_goal (p ◁ᵥ l @ ptr n) T.
+  Proof. by iIntros "[-> $]". Qed.
+  Definition simplify_ptr_goal_val_inst := [instance simplify_ptr_goal_val with 10%N].
+  Global Existing Instance simplify_ptr_goal_val_inst.
+
+  Lemma subsume_own_ptr A p l1 l2 ty n T:
+    (l1 ◁ₗ ty -∗ ∃ x, <affine> ⌜l1 = l2 x⌝ ∗ (*loc_in_bounds l1 (n x) ∗*) T x)
+    ⊢ subsume (p ◁ₗ l1 @ &own ty)%I (λ x : A, p ◁ₗ (l2 x) @ ptr (n x))%I T.
+  Proof.
+    iIntros "HT Hp".
+    iDestruct (ty_aligned _ (tptr tvoid) MCNone with "Hp") as %?; [eexists; eauto|].
+    iDestruct (ty_deref _ (tptr tvoid) MCNone with "Hp") as (v) "[Hp [-> Hl]]"; [eexists; eauto|].
+    iDestruct ("HT" with "Hl") as (? ->) "?". iExists _. by iFrame "∗".
+  Qed.
+  Definition subsume_own_ptr_inst := [instance subsume_own_ptr].
+  Global Existing Instance subsume_own_ptr_inst.
+
+(*   Lemma type_copy_aid_ptr v1 a it v2 l n T:
+    (v1 ◁ᵥ a @ int it -∗
+      v2 ◁ᵥ l @ ptr n -∗
+      ⌜l.2 ≤ a ≤ l.2 + n⌝ ∗
+      (alloc_alive_loc l ∗ True) ∧
+      T (val_of_loc (l.1, a)) (value PtrOp (val_of_loc (l.1, a))))
+    ⊢ typed_copy_alloc_id v1 (v1 ◁ᵥ a @ int it) v2 (v2 ◁ᵥ l @ ptr n) (IntOp it) T.
+  Proof.
+    unfold int; simpl_type.
+    iIntros "HT %Hv1 Hv2" (Φ) "HΦ". iDestruct "Hv2" as "[-> #Hlib]".
+    iDestruct ("HT" with "[//] [$Hlib]") as ([??]) "HT"; [done|].
+    rewrite !right_id.
+    iApply wp_copy_alloc_id; [ done | by rewrite val_to_of_loc |  | ].
+    { iApply (loc_in_bounds_offset with "Hlib"); simpl; [done | done | etrans; [|done]; lia ]. }
+    iSplit; [by iDestruct "HT" as "[$ _]" |].
+    iDestruct "HT" as "[_ HT]". iApply ("HΦ" with "[] HT"). unfold value; simpl_type.
+    iSplit => //. iPureIntro. apply: mem_cast_id_loc.
+  Qed.
+  Definition type_copy_aid_ptr_inst := [instance type_copy_aid_ptr].
+  Global Existing Instance type_copy_aid_ptr_inst. *)
+End ptr.
+
+Section null.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+  Program Definition null : type := {|
+    ty_has_op_type ot mt := (∃ t, ot = tptr t)%type;
+    ty_own β l := (<affine> ⌜field_compatible (tptr tvoid) [] l⌝ ∗ l ↦_(tptr tvoid)[β] nullval)%I;
+    ty_own_val v := <affine> ⌜v = nullval⌝%I;
+  |}.
+  Next Obligation. iIntros (???). iDestruct 1 as "[$ ?]". by iApply heap_mapsto_own_state_share. Qed.
+  Next Obligation. iIntros (???(? & ->)) "[% _]". rewrite /has_layout_loc field_compatible_tptr //. Qed.
+  Next Obligation. iIntros (???(? & ->) ->). iPureIntro; intros ?; hnf. simple_if_tac; done. Qed.
+  Next Obligation. iIntros (???(? & ->)) "[% ?]". iExists _. unfold mapsto. erewrite mapsto_tptr. by iFrame. Qed.
+  Next Obligation. iIntros (????(? & ->)?) "? ->". rewrite /has_layout_loc field_compatible_tptr in H; unfold mapsto; erewrite mapsto_tptr. by iFrame. Qed.
+(*   Next Obligation. iIntros (v ot mt st ?). apply mem_cast_compat_loc; [done|]. iPureIntro. naive_solver. Qed. *)
+
+(*   Global Instance null_loc_in_bounds β : LocInBounds null β bytes_per_addr.
+  Proof.
+    constructor. iIntros (l) "[_ Hl]".
+    iDestruct (heap_mapsto_own_state_loc_in_bounds with "Hl") as "Hb".
+    by iApply loc_in_bounds_shorten.
+  Qed. *)
+
+  Lemma type_null T :
+    T null
+    ⊢ typed_value nullval T.
+  Proof. iIntros "HT". iExists  _. iFrame. done. Qed.
+  Definition type_null_inst := [instance type_null].
+  Global Existing Instance type_null_inst.
+
+  Global Program Instance null_copyable : Copyable (null).
+  Next Obligation.
+    iIntros (E l ??(? & ->)) "[% Hl]".
+    rewrite /has_layout_loc field_compatible_tptr.
+    iMod (heap_mapsto_own_state_to_mt with "Hl") as (q) "[_ Hl]" => //. iSplitR => //.
+    iExists _, _. erewrite mapsto_tptr. iFrame. iModIntro. iSplit => //.
+    by iIntros "_".
+  Qed.
+
+  Definition heap_loc_eq l1 l2 m :=
+    if Archi.ptr64 then Val.cmplu_bool (Mem.valid_pointer m) Ceq l1 l2
+    else Val.cmpu_bool (Mem.valid_pointer m) Ceq l1 l2.
+
+  Lemma eval_bin_op_ptr_cmp ce l1 l2 t1 t2 op h v b:
+    match op with | Cop.Oeq | Cop.One => True | _ =>  False end →
+    heap_loc_eq l1 l2 h = Some b →
+    sem_binary_operation ce op l1 (tptr t1) l2 (tptr t2) h = Some v
+     ↔ Val.of_bool (if op is Cop.Oeq then b else negb b) = v.
+  Proof.
+    rewrite /heap_loc_eq /=. move => ? Heq.
+    rewrite /sem_binary_operation; destruct op => //; rewrite /Cop.sem_cmp /= /cmp_ptr /=.
+    - rewrite Heq /=; split; congruence.
+    - rewrite /Val.cmpu_bool /Val.cmplu_bool in Heq |- *; destruct l1 => //; destruct l2 => //; simpl in *; simple_if_tac; simpl;
+        first [inv Heq; split; congruence | try if_tac in Heq; destruct (_ && _); inv Heq; simpl; split; congruence].
+  Qed.
+
+  Lemma type_binop_null_null v1 v2 t1 t2 op T:
+    (<affine> ⌜match op with | Cop.Oeq | Cop.One => True | _ => False end⌝ ∗ ∀ v,
+          T v ((if op is Cop.Oeq then true else false) @ boolean tint))
+    ⊢ typed_bin_op v1 ⎡v1 ◁ᵥ null⎤ v2 ⎡v2 ◁ᵥ null⎤ op (tptr t1) (tptr t2) T.
+  Proof.
+    iIntros "[% HT]" (-> -> Φ) "HΦ".
+    iIntros "!>" (?) "$ !>".
+    iExists (Val.of_bool (if op is Oeq then true else false)); iSplit.
+    - iStopProof; split => rho; monPred.unseal.
+      apply bi.pure_intro.
+      intros; eapply eval_bin_op_ptr_cmp; done.
+    - iApply "HΦ" => //. iExists _. iSplit; iPureIntro => //. by destruct op.
+  Qed.
+  Definition type_binop_null_null_inst := [instance type_binop_null_null].
+  Global Existing Instance type_binop_null_null_inst.
+
+(* need Mem.valid_pointer for this
+  Lemma type_binop_ptr_null v op (l : address) t1 t2 ty β (*n `{!LocInBounds ty β n}*) T:
+    (<affine> ⌜match op with Oeq | One => True | _ => False end⌝ ∗ ∀ v, ⎡l ◁ₗ{β} ty⎤ -∗
+          T v ((if op is Oeq then false else true) @ boolean tint))
+    ⊢ typed_bin_op l ⎡l ◁ₗ{β} ty⎤ v ⎡v ◁ᵥ null⎤ op (tptr t1) (tptr t2) T.
+  Proof.
+    iIntros "[% HT] Hl" (-> Φ) "HΦ".
+    iIntros (?) "$".
+    iExists (Val.of_bool (if op is Oeq then false else true)); iSplit.
+    - iStopProof; split => rho; monPred.unseal.
+      apply bi.pure_intro.
+      intros; eapply (eval_bin_op_ptr_cmp _ _ _ _ _ _ _ _ false); try done.
+      rewrite /heap_loc_eq /=.
+    - iApply "HΦ" => //. iExists _. iSplit; iPureIntro => //. by destruct op.
+  Qed.
+  Definition type_binop_ptr_null_inst := [instance type_binop_ptr_null].
+  Global Existing Instance type_binop_ptr_null_inst.
+
+  Lemma type_binop_null_ptr v op (l : address) ty β n `{!LocInBounds ty β n} T:
+    (⌜match op with EqOp rit | NeOp rit => rit = tint | _ => False end⌝ ∗ ∀ v, l ◁ₗ{β} ty -∗
+          T v (((if op is EqOp _ then false else true) @ boolean tint)))
+    ⊢ typed_bin_op v (v ◁ᵥ null) l (l ◁ₗ{β} ty) op PtrOp PtrOp T.
+  Proof.
+    iIntros "[% HT] -> Hl %Φ HΦ".
+    iDestruct (loc_in_bounds_in_bounds with "Hl") as "#Hb".
+    iDestruct (loc_in_bounds_shorten _ _ 0 with "Hb") as "#Hb0"; first by lia.
+    have ?:= val_of_Z_bool (if op is EqOp _ then false else true) tint.
+    iApply (wp_binop_det (i2v (bool_to_Z (if op is EqOp _ then false else true)) tint)).
+    iIntros (σ) "Hctx". iApply fupd_mask_intro; [set_solver|]. iIntros "HE".
+    iDestruct (loc_in_bounds_has_alloc_id with "Hb") as %[??].
+    iDestruct (wp_if_precond_heap_loc_eq with "[] Hctx") as %Heq. { by iApply wp_if_precond_alloc. }
+    rewrite heap_loc_eq_symmetric in Heq.
+    iSplit.
+    { iPureIntro => ?. rewrite eval_bin_op_ptr_cmp //. case_bool_decide => //; simplify_eq. naive_solver. }
+    iModIntro. iMod "HE". iModIntro. iFrame.
+    iApply "HΦ". 2: by iApply "HT". iExists _. iSplit; iPureIntro => //; by destruct op.
+  Qed.
+  Definition type_binop_null_ptr_inst := [instance type_binop_null_ptr].
+  Global Existing Instance type_binop_null_ptr_inst. *)
+
+(*  Lemma type_cast_null_int it v T:
+    (T (i2v 0 it) (0 @ int it))
+    ⊢ typed_un_op v (v ◁ᵥ null) (CastOp (IntOp it)) PtrOp T.
+  Proof.
+    iIntros "HT" (-> Φ) "HΦ".
+    iApply wp_cast_null_int.
+    { by apply: (val_of_Z_bool false). }
+    iModIntro. iApply ("HΦ" with "[] HT").
+    unfold int; simpl_type. iPureIntro. apply: (i2v_bool_Some false).
+  Qed.
+  Definition type_cast_null_int_inst := [instance type_cast_null_int].
+  Global Existing Instance type_cast_null_int_inst.
+
+  Lemma type_cast_zero_ptr v it T:
+    (T (val_of_loc NULL_loc) null)
+    ⊢ typed_un_op v (v ◁ᵥ 0 @ int it) (CastOp PtrOp) (IntOp it) T.
+  Proof.
+    unfold int; simpl_type.
+    iIntros "HT" (Hv Φ) "HΦ".
+    iApply wp_cast_int_null; first done.
+    iModIntro. by iApply ("HΦ" with "[] HT").
+  Qed.
+  Definition type_cast_zero_ptr_inst := [instance type_cast_zero_ptr].
+  Global Existing Instance type_cast_zero_ptr_inst | 10.
+
+  Lemma type_cast_null_ptr v T:
+    (T v null)
+    ⊢ typed_un_op v (v ◁ᵥ null) (CastOp PtrOp) PtrOp T.
+  Proof.
+    iIntros "HT" (-> Φ) "HΦ".
+    iApply wp_cast_loc; [by apply val_to_of_loc|].
+    by iApply ("HΦ" with "[] HT").
+  Qed.
+  Definition type_cast_null_ptr_inst := [instance type_cast_null_ptr].
+  Global Existing Instance type_cast_null_ptr_inst. *)
+
+  Lemma type_if_null v t T1 T2:
+    T2
+    ⊢ typed_if (tptr t) v (v ◁ᵥ null) T1 T2.
+  Proof.
+    iIntros "HT2 -> /=". iExists (Vint Int.zero); iFrame; iPureIntro.
+    rewrite /sem_cast /= andb_false_r //.
+  Qed.
+  Definition type_if_null_inst := [instance type_if_null].
+  Global Existing Instance type_if_null_inst.
+End null.
+
+Section optionable.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  Global Program Instance frac_ptr_optional p ty β t1 t2: Optionable (p @ frac_ptr β ty) null (tptr t1) (tptr t2) := {|
+    opt_pre v1 v2 := (p ◁ₗ{β} ty -∗ expr.valid_pointer p)%I
+  |}.
+  Next Obligation.
+    intros.
+    iIntros "Hpre H1 -> Hctx".
+    destruct bty; [ iDestruct "H1" as (->) "Hty" | iDestruct "H1" as %-> ].
+    - iDestruct ("Hpre" with "Hty") as "Hlib".
+      iDestruct (expr_lemmas4.valid_pointer_dry0 with "[$Hctx $Hlib]") as %Hvalid; iPureIntro.
+      destruct beq => /=; rewrite /Cop.sem_cmp /= /cmp_ptr /nullval /=; change Archi.ptr64 with true; rewrite /= Hvalid /= /Vtrue /Vfalse /Int.zero /Int.one; split; congruence.
+    - rewrite eval_bin_op_ptr_cmp // /= ?Int.eq_true ?Int64.eq_true; destruct beq => //.
+  Qed.
+  Global Program Instance frac_ptr_optional_agree ty1 ty2 β : OptionableAgree (frac_ptr β ty1) (frac_ptr β ty2).
+  Next Obligation. done. Qed.
+
+
+  (* Global Program Instance ptr_optional : ROptionable ptr null PtrOp PtrOp := {| *)
+  (*   ropt_opt x := {| opt_alt_sz := _ |} *)
+  (* |}. *)
+  (* Next Obligation. move => ?. done. Qed. *)
+  (* Next Obligation. *)
+  (*   iIntros (p bty beq v1 v2 σ v) "H1 -> Hctx". *)
+  (*   destruct bty; [ iDestruct "H1" as %-> | iDestruct "H1" as %-> ]; iPureIntro. *)
+  (*   - admit. (*by etrans; first apply (eval_bin_op_ptr_null (negb beq)); destruct beq => //.*) *)
+  (*   - by etrans; first apply (eval_bin_op_null_null beq); destruct beq => //. *)
+  (* Admitted. *)
+
+  Lemma subsume_optional_place_val_null A ty l β b ty' T:
+    (l ◁ₗ{β} ty' -∗ ∃ x, <affine> ⌜b x⌝ ∗ l ◁ᵥ (ty x) ∗ T x)
+    ⊢ subsume (l ◁ₗ{β} ty') (λ x : A, l ◁ᵥ (b x) @ optional (ty x) null) T.
+  Proof.
+    iIntros "Hsub Hl". iDestruct ("Hsub" with "Hl") as (??) "[Hl ?]".
+    iExists _. iFrame. unfold optional; simpl_type. iLeft. by iFrame.
+  Qed.
+  Definition subsume_optional_place_val_null_inst := [instance subsume_optional_place_val_null].
+  Global Existing Instance subsume_optional_place_val_null_inst | 20.
+
+  Lemma subsume_optionalO_place_val_null B A (ty : B → A → type) l β b ty' T:
+    (l ◁ₗ{β} ty' -∗ ∃ y x, <affine> ⌜b y = Some x⌝ ∗ l ◁ᵥ ty y x ∗ T y)
+    ⊢ subsume (l ◁ₗ{β} ty') (λ y, l ◁ᵥ (b y) @ optionalO (ty y) null) T.
+  Proof.
+    iIntros "Hsub Hl". iDestruct ("Hsub" with "Hl") as (?? Heq) "[? ?]".
+    iExists _. iFrame. rewrite Heq. unfold optionalO; simpl_type. done.
+  Qed.
+  Definition subsume_optionalO_place_val_null_inst := [instance subsume_optionalO_place_val_null].
+  Global Existing Instance subsume_optionalO_place_val_null_inst | 20.
+
+(*   (* TODO: generalize this with a IsLoc typeclass or similar *)
+  Lemma type_cast_optional_own_ptr b v β ty T:
+    (T v (b @ optional (&frac{β} ty) null))
+    ⊢ typed_un_op v (v ◁ᵥ b @ optional (&frac{β} ty) null) (CastOp PtrOp) PtrOp T.
+  Proof.
+    iIntros "HT Hv" (Φ) "HΦ". unfold optional, ty_of_rty at 2; simpl_type.
+    iDestruct "Hv" as "[[% [%l [% Hl]]]|[% ->]]"; subst.
+    all: iApply wp_cast_loc; [by apply val_to_of_loc|].
+    - iApply ("HΦ" with "[Hl] HT"). simpl_type. iLeft. iSplitR; [done|]. iExists _. by iFrame.
+    - iApply ("HΦ" with "[] HT"). simpl_type. by iRight.
+  Qed.
+  Definition type_cast_optional_own_ptr_inst := [instance type_cast_optional_own_ptr].
+  Global Existing Instance type_cast_optional_own_ptr_inst.
+
+  Lemma type_cast_optionalO_own_ptr A (b : option A) v β ty T:
+    (T v (b @ optionalO (λ x, &frac{β} (ty x)) null))
+    ⊢ typed_un_op v (v ◁ᵥ b @ optionalO (λ x, &frac{β} (ty x)) null) (CastOp PtrOp) PtrOp T.
+  Proof.
+    iIntros "HT Hv" (Φ) "HΦ". unfold optionalO; simpl_type.
+    destruct b as [?|].
+    - unfold ty_of_rty at 2; simpl_type. iDestruct "Hv" as "[%l [% Hl]]"; subst.
+      iApply wp_cast_loc; [by apply val_to_of_loc|].
+      iApply ("HΦ" with "[Hl] HT"). simpl_type. iExists _. by iFrame.
+    - iDestruct "Hv" as "->".
+      iApply wp_cast_loc; [by apply val_to_of_loc|].
+      iApply ("HΦ" with "[] HT"). simpl_type. done.
+  Qed.
+  Definition type_cast_optionalO_own_ptr_inst := [instance type_cast_optionalO_own_ptr].
+  Global Existing Instance type_cast_optionalO_own_ptr_inst. *)
+End optionable.
+
+Global Typeclasses Opaque ptr_type ptr.
+Global Typeclasses Opaque frac_ptr_type frac_ptr.
+Global Typeclasses Opaque null.
+
+Section optional_null.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  Local Typeclasses Transparent optional_type optional.
+
+(*   Lemma type_place_optional_null K l β1 b ty T:
+    ⌜b⌝ ∗ typed_place K l β1 ty T
+    ⊢ typed_place K l β1 (b @ optional ty null) T.
+  Proof.
+    iIntros "[% H]" (Φ) "[[_ Hl]|[% _]] HH"; last done.
+    by iApply ("H" with "Hl").
+  Qed.
+  (* This should have a lower priority than type_place_id *)
+  Definition type_place_optional_null_inst := [instance type_place_optional_null].
+  Global Existing Instance type_place_optional_null_inst | 100.
+
+  Lemma type_place_optionalO_null A K l β1 b (ty : A → _) T:
+    ⌜is_Some b⌝ ∗ (∀ x, ⌜b = Some x⌝ -∗ typed_place K l β1 (ty x) T)
+    ⊢ typed_place K l β1 (b @ optionalO ty null) T.
+  Proof.
+    iDestruct 1 as ([? ->]) "Hwp".
+    iIntros (Φ) "Hx". by iApply "Hwp".
+  Qed.
+  (* This should have a lower priority than type_place_id *)
+  Definition type_place_optionalO_null_inst := [instance type_place_optionalO_null].
+  Global Existing Instance type_place_optionalO_null_inst | 100. *)
+End optional_null.
diff --git a/refinedVST/typing/programs.v b/refinedVST/typing/programs.v
new file mode 100644
index 0000000000..7a1b39a334
--- /dev/null
+++ b/refinedVST/typing/programs.v
@@ -0,0 +1,1987 @@
+From compcert.cfrontend Require Import Clight.
+From VST.veric Require Import lifting.
+From VST.lithium Require Export proof_state.
+From lithium Require Import hooks.
+From VST.typing Require Export type.
+From VST.typing Require Import type_options.
+From VST.floyd Require Import globals_lemmas.
+
+Open Scope Z.
+
+(* int infrastructure *)
+Global Instance intsize_eq_dec : EqDecision intsize.
+Proof. rewrite /RelDecision /Decision. decide equality. Qed.
+
+Definition val_to_Z (v : val) (t : Ctypes.type) : option Z :=
+  match v, t with
+  | Vint i, Tint _ Signed _ => Some (Int.signed i)
+  | Vint i, Tint sz Unsigned _ => Some (Int.unsigned i)
+  | Vlong i, Tlong Signed _ => Some (Int64.signed i)
+  | Vlong i, Tlong Unsigned _ => Some (Int64.unsigned i)
+  | _, _ => None
+  end.
+
+Lemma bitsize_max : forall sz, Z.pow 2 (bitsize_intsize sz) ≤ Int.modulus.
+Proof.
+  destruct sz; simpl; rep_lia.
+Qed.
+
+Lemma bitsize_half_max : forall sz, Z.pow 2 (bitsize_intsize sz - 1) ≤ Int.half_modulus.
+Proof.
+  destruct sz; simpl; rep_lia.
+Qed.
+
+Definition i2v n t :=
+  match t with
+  | Tint _ _ _ => Vint (Int.repr n)
+  | Tlong _ _ => Vlong (Int64.repr n)
+  | _ => Vundef
+  end.
+
+Definition in_range (n:Z) (t: Ctypes.type) : Prop :=
+  match t with
+  | Tint IBool _ _ => 0 <= n < 2
+  | Tint sz Signed _ => - Z.pow 2 (bitsize_intsize sz - 1) <= n < Z.pow 2 (bitsize_intsize sz - 1)
+  | Tint sz Unsigned _ => 0 <= n < Z.pow 2 (bitsize_intsize sz)
+  | Tlong Signed _ => Int64.min_signed <= n <= Int64.max_signed
+  | Tlong Unsigned _ => 0 <= n <= Int64.max_unsigned
+  | _ => False
+  end.
+
+Lemma in_range_i2v : forall n t, in_range n t -> tc_val t (i2v n t).
+Proof.
+  intros; destruct t; try done; simpl in *.
+  destruct i; simpl in *; try done.
+  - destruct s.
+    + rewrite Int.signed_repr; rep_lia.
+    + rewrite Int.unsigned_repr; rep_lia.
+  - destruct s.
+    + rewrite two_power_pos_equiv Int.signed_repr; rep_lia.
+    + rewrite Int.unsigned_repr; rep_lia.
+  - destruct (decide (n = 0)); subst; auto.
+    assert (n = 1) as -> by lia; auto.
+Qed.
+
+Definition int_eq v1 v2 :=
+  match v1, v2 with
+  | Vint i1, Vint i2 => Int.eq i1 i2
+  | Vlong i1, Vlong i2 => Int64.eq i1 i2
+  | _, _ => false
+  end.
+
+Global Instance repable_signed_dec i : Decision (repable_signed i).
+refine (repable_signed_dec _). Defined.
+
+Global Instance elem_of_type : ElemOf Z Ctypes.type := in_range.
+Global Instance elem_of_type_dec (i : Z) (t:Ctypes.type) : Decision (i ∈ t).
+Proof.
+  unfold elem_of, elem_of_type.
+  destruct t; try solve [
+    refine (right _ );  unfold not; intros; inv H].
+  - destruct i0; (apply _ || destruct s; apply _).
+  - destruct s; apply _.
+Qed.
+
+(* Global Instance int_elem_of_type : ElemOf Integers.int Ctypes.type :=
+  λ i t, Int.intval i ∈ t. *)
+
+Lemma i2v_to_Z : forall n t, in_range n t -> val_to_Z (i2v n t) t = Some n.
+Proof.
+  intros.
+  destruct t; try done; rewrite /val_to_Z /i2v; destruct s; simpl in H. 
+  - rewrite Int.signed_repr //.
+    pose proof (bitsize_half_max i).
+    destruct i; rep_lia.
+  - rewrite Int.unsigned_repr //.
+    pose proof (bitsize_max i); destruct i; rep_lia.
+  - rewrite Int64.signed_repr //.
+  - rewrite Int64.unsigned_repr //.
+Qed.
+
+Lemma val_to_Z_in_range : forall t v n, val_to_Z v t = Some n -> tc_val t v -> n ∈ t.
+Proof.
+  destruct v; try done; destruct t; try done; simpl; intros.
+  - destruct i0; [destruct s; inv H; hnf; simpl; try rep_lia..|].
+    + rewrite two_power_pos_equiv in H0; lia.
+    + destruct H0, s; inv H; hnf.
+      * by rewrite Int.signed_zero.
+      * by rewrite Int.unsigned_zero.
+      * by rewrite Int.signed_one.
+      * by rewrite Int.unsigned_one.
+  - destruct s; inv H; hnf; rep_lia.
+Qed.
+
+Lemma signed_inj_64 : forall i1 i2, Int64.signed i1 = Int64.signed i2 -> i1 = i2.
+Proof.
+  intros ?? H%(f_equal Int64.repr).
+  by rewrite !Int64.repr_signed in H.
+Qed.
+
+Lemma unsigned_inj_64 : forall i1 i2, Int64.unsigned i1 = Int64.unsigned i2 -> i1 = i2.
+Proof.
+  intros ?? H%(f_equal Int64.repr).
+  by rewrite !Int64.repr_unsigned in H.
+Qed.
+
+Lemma val_of_bool_eq : forall b, Val.of_bool b = Vint (Int.repr (bool_to_Z b)).
+Proof.
+  intros; rewrite /Val.of_bool /bool_to_Z.
+  simple_if_tac; auto.
+Qed.
+
+Section judgements.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  Class Learnable (P : iProp Σ) := {
+    learnable_data : iProp Σ;
+    learnable_learn : P ⊢ □ learnable_data;
+  }.
+
+(*  Class LearnAlignment (β : own_state) (ty : type) (n : option nat) :=
+    learnalign_learn l : l ◁ₗ{β} ty ⊢ ⌜if n is Some n' then l `aligned_to` n' else True⌝
+  .*)
+
+  (* Variants of Subsume which don't need the continuation. P is an
+  additional sidecondition. Not via iProp_to_Prop since there is no
+  continuation. *)
+  Class SimpleSubsumePlace (ty1 ty2 : type) (P : iProp Σ) : Prop :=
+    simple_subsume_place l β: P ⊢ l ◁ₗ{β} ty1 -∗ l ◁ₗ{β} ty2.
+  (* TODO: add infrastructure like SimpleSubsumePlaceR to
+  SimpleSubsumeVal. Not sure if it would work because of the movable
+  instance. *)
+  Class SimpleSubsumeVal (ty1 ty2 : type) (P : iProp Σ) : Prop :=
+    simple_subsume_val v: P ⊢ v ◁ᵥ ty1 -∗ v ◁ᵥ ty2.
+
+  (* This is similar to simplify hyp place (Some 0), but targeted at
+  Copy and applying all simplifications at once instead of step by
+  step. We need this because copying duplicates a type and we want to
+  make it as specific as we can before we do the duplication (e.g.
+  destruct all existentials in it). *)
+  Definition copy_as (l : address) (β : own_state) (ty : type) (T : type → iProp Σ) : iProp Σ :=
+    l ◁ₗ{β} ty -∗ ∃ ty', l ◁ₗ{β} ty' ∗ <affine> ⌜Copyable ty'⌝ ∗ T ty'.
+  Class CopyAs (l : address) (β : own_state) (ty : type) : Type :=
+    copy_as_proof T : iProp_to_Prop (copy_as l β ty T).
+
+  (* A is the annotation from the code *)
+  Definition typed_annot_expr (n : nat) {A} (a : A) (v : val) (P : iProp Σ) (T : iProp Σ) : iProp Σ :=
+    (P ={⊤}[∅]▷=∗^n |={⊤}=> T).
+  Class TypedAnnotExpr (n : nat) {A} (a : A) (v : val) (P : iProp Σ) : Type :=
+    typed_annot_expr_proof T : iProp_to_Prop (typed_annot_expr n a v P T).
+
+  Definition typed_annot_stmt {A} (a : A) (l : address) (P : iProp Σ) (T : iProp Σ) : iProp Σ :=
+    (P ={⊤}[∅]▷=∗ T).
+  Class TypedAnnotStmt {A} (a : A) (l : address) (P : iProp Σ) : Type :=
+    typed_annot_stmt_proof T : iProp_to_Prop (typed_annot_stmt a l P T).
+
+  Definition typed_if {B : bi} (ot : Ctypes.type) (v : val) (P : B) (T1 T2 : B) : B :=
+    (P -∗ match ot with
+          | Tint _ _ _ | Tlong _ _ => ∃ z, <affine> ⌜val_to_Z v ot = Some z⌝ ∗ (if bool_decide (z ≠ 0) then T1 else T2)
+          | _ => ∃ b, <affine> ⌜sem_cast ot tbool v = Some b⌝ ∗ (if eq_dec b (Vint Int.zero) then T2 else T1) end).
+  Class TypedIf {B : bi} (ot : Ctypes.type) (v : val) (P : B) : Type :=
+    typed_if_proof T1 T2 : iProp_to_Prop (typed_if ot v P T1 T2).
+
+  (*** statements *)
+(*  Definition typed_stmt_post_cond (fn : function) (ls : list address) (R : val → type → iProp Σ) (v : val) : iProp Σ :=
+    (∃ ty, v ◁ᵥ ty ∗ ([∗ list] l;v ∈ ls;(fn.(f_args) ++ fn.(f_local_vars)), l ↦|v.2|) ∗ R v ty)%I. *)
+  Context (OK_spec : ext_spec OK_ty) (ge : genv).
+
+  (* Possibly we will want break-types, continue-types, etc. For now, using option to distinguish between
+     fallthrough (normal) type and return type. *)
+  Definition typed_stmt_post_cond (R : option val → type → assert) : ret_assert :=
+    {| RA_normal := R None tytrue;
+       RA_break := False;
+       RA_continue := False;
+       RA_return ret := let v := force_val ret in ∃ ty, ⎡v ◁ᵥ ty⎤ ∗ R (Some v) ty |}.
+  Definition typed_stmt s f (R : option val → type → assert) : assert :=
+    wp OK_spec ge ⊤ f s (typed_stmt_post_cond R)%I.
+  Global Arguments typed_stmt _ _ _%_I.
+
+  Lemma typed_stmt_mono s f R1 R2 : (∀ v t, R1 v t ⊢ R2 v t) →
+    typed_stmt s f R1 ⊢ typed_stmt s f R2.
+  Proof.
+    intros; apply wp_conseq; intros; simpl; rewrite ?H; auto.
+    iIntros "(% & ? & ?)"; rewrite H; eauto with iFrame.
+  Qed.
+
+(*  Definition typed_block (P : iProp Σ) (b : label) (fn : function) (ls : list address) (R : val → type → iProp Σ) (Q : gmap label stmt) : iProp Σ :=
+    (wps_block P b Q (typed_stmt_post_cond fn ls R)).
+
+  Definition typed_switch (v : val) (ty : type) (it : int_type) (m : gmap Z nat) (ss : list stmt) (def : stmt) (fn : function) (ls : list address) (R : val → type → iProp Σ) (Q : gmap label stmt) : iProp Σ :=
+    (v ◁ᵥ ty -∗ ∃ z, ⌜val_to_Z v it = Some z⌝ ∗
+      match m !! z with
+      | Some i => ∃ s, ⌜ss !! i = Some s⌝ ∗ typed_stmt s fn ls R Q
+      | None   => typed_stmt def fn ls R Q
+      end).
+  Class TypedSwitch (v : val) (ty : type) (it : int_type) : Type :=
+    typed_switch_proof m ss def fn ls R Q : iProp_to_Prop (typed_switch v ty it m ss def fn ls R Q).*)
+
+(*  Definition typed_assert (ot : Ctypes.type) (v : val) (P : iProp Σ) (s : stmt) (fn : function) (ls : list address) (R : val → type → iProp Σ) (Q : gmap label stmt) : iProp Σ :=
+    (P -∗
+       match ot with
+       | BoolOp   => ∃ b, ⌜val_to_bool v = Some b⌝ ∗ ⌜b = true⌝ ∗ typed_stmt s fn ls R Q
+       | IntOp it => ∃ z, ⌜val_to_Z v it = Some z⌝ ∗ ⌜z ≠ 0⌝ ∗ typed_stmt s fn ls R Q
+       | PtrOp    => ∃ l, ⌜val_to_loc v = Some l⌝ ∗ ⌜l ≠ NULL_loc⌝ ∗ wp_if_precond l ∗ typed_stmt s fn ls R Q
+       | _        => False
+       end)%I.
+  Class TypedAssert (ot : op_type) (v : val) (P : iProp Σ) : Type :=
+    typed_assert_proof s fn ls R Q : iProp_to_Prop (typed_assert ot v P s fn ls R Q).*)
+
+  (*** expressions *)
+
+  (* worked out with Arnaud Daby-Seesaram; not used, but inspiration for wp_expr
+  Definition eval_rel (*(t : type)*) (e : expr) (v : val) (rho : environ)
+    : iProp Σ :=
+    ∀ m, juicy_mem.mem_auth m -∗
+           ⌜forall ge ve te,
+              cenv_sub cenv_cs (genv_cenv ge) ->
+              rho = construct_rho (filter_genv ge) ve te ->
+              Clight.eval_expr ge ve te m e v (*/\ typeof e = t /\ tc_val t v*)⌝.*)
+
+  Definition typed_val_expr (e : expr) (T : val → type → assert) : assert :=
+    (∀ Φ, (∀ v (ty : type), ⎡v ◁ᵥ ty⎤ -∗ T v ty -∗ Φ v) -∗ wp_expr ⊤ e Φ).
+  Global Arguments typed_val_expr _ _%_I.
+
+  (* FIXME sounds like typed_addr_of, although typed_addr_of is for typing `&e`; are they the same?  *)
+  Definition typed_lvalue β e T : assert :=
+    (∀ Φ:address->assert, 
+      (∀ (l:address) (ty : type),
+        ⎡l ◁ₗ{β} ty⎤ (* typed_write_end has this so maybe here needs it too? *) 
+        -∗ T l β ty -∗ Φ l)
+      -∗ wp_lvalue ⊤ e Φ).
+  Global Arguments typed_lvalue _ _ _%_I.
+  Class TypedLvalue β (e : expr) : Type :=
+    typed_lvalue_proof T : iProp_to_Prop (typed_lvalue β e T).
+
+  Definition typed_value (v : val) (T : type → assert) : assert :=
+    (∃ (ty: type), ⎡v ◁ᵥ ty⎤ ∗ T ty).
+  Class TypedValue (v : val) : Type :=
+    typed_value_proof T : iProp_to_Prop (typed_value v T).
+
+  Definition typed_val_binop op t1 v1 t2 v2 (T : val → type → assert) : assert :=
+    (∀ Φ, (∀ v (ty : type), ⎡v ◁ᵥ ty⎤ -∗ T v ty -∗ Φ v) -∗ wp_binop ⊤ op t1 v1 t2 v2 Φ).
+  Global Arguments typed_val_binop _ _ _ _ _ _%_I.
+
+  Definition typed_bin_op (v1 : val) (P1 : assert) (v2 : val) (P2 : assert) (o : Cop.binary_operation) (t1 t2 : Ctypes.type) (T : val → type → assert) : assert :=
+    (P1 -∗ P2 -∗ typed_val_binop o t1 v1 t2 v2 T)%I.
+
+  Class TypedBinOp (v1 : val) (P1 : assert) (v2 : val) (P2 : assert) (o : Cop.binary_operation) (ot1 ot2 : Ctypes.type) : Type :=
+    typed_bin_op_proof T : iProp_to_Prop (typed_bin_op v1 P1 v2 P2 o ot1 ot2 T).
+
+  Definition typed_val_unop op t v (T : val → type → assert) : assert :=
+    (∀ Φ, (∀ v (ty : type), ⎡v ◁ᵥ ty⎤ -∗ T v ty -∗ Φ v) -∗ wp_unop ⊤ op t v Φ).
+  Global Arguments typed_val_unop _ _ _ _%_I.
+
+  Definition typed_un_op (v : val) (P : assert) (o : Cop.unary_operation) (ot : Ctypes.type) (T : val → type → assert) : assert :=
+    (P -∗ typed_val_unop o ot v T)%I.
+
+  Class TypedUnOp (v : val) (P : assert) (o : Cop.unary_operation) (ot : Ctypes.type) : Type :=
+    typed_un_op_proof T : iProp_to_Prop (typed_un_op v P o ot T).
+
+  Definition typed_exprs (el : list expr) (tl : list Ctypes.type) (T : list val → list type → assert) : assert :=
+    (∀ Φ, (∀ vl (tys : list type), ([∗ list] v;ty∈vl;tys, ⎡v ◁ᵥ ty⎤) -∗ T vl tys -∗ Φ vl) -∗ wp_exprs el tl Φ).
+  Global Arguments typed_exprs _ _ _%_I.
+
+  (* can we rewrite this to take vals directly after all? We'd have to replace typed_stmt with sufficient
+     conditions for a call to be safe. *)
+  Definition typed_call (e : expr) (P : assert) (el : list expr) (tys : list type) (T : option val → type → assert) : assert :=
+    match typeof e with
+    | Tfunction ts _ _ => (∀ f, P -∗ (*(typed_exprs el ts (λ _ tl, <affine> ⌜tl = tys⌝)) -∗*) typed_stmt (Scall None e el) f T)%I
+    | _ => False
+    end.
+  Class TypedCall (e : expr) (P : assert) (el : list expr) (tys : list type) : Type :=
+    typed_call_proof T : iProp_to_Prop (typed_call e P el tys T).
+
+(* There does not seem to be a copy stmt in Clight, just Sassign 
+  Definition typed_copy_alloc_id (v1 : val) (P1 : iProp Σ) (v2 : val) (P2 : iProp Σ) (ot : op_type) (T : val → type → iProp Σ) : iProp Σ :=
+    (P1 -∗ P2 -∗ typed_val_expr (CopyAllocId ot v1 v2) T).
+
+  Class TypedCopyAllocId (v1 : val) (P1 : iProp Σ) (v2 : val) (P2 : iProp Σ) (ot : op_type) : Type :=
+    typed_copy_alloc_id_proof T : iProp_to_Prop (typed_copy_alloc_id v1 P1 v2 P2 ot T).
+*)
+
+(*
+  Definition typed_cas (ot : op_type) (v1 : val) (P1 : iProp Σ) (v2 : val) (P2 : iProp Σ) (v3 : val) (P3 : iProp Σ)  (T : val → type → iProp Σ) : iProp Σ :=
+    (P1 -∗ P2 -∗ P3 -∗ typed_val_expr (CAS ot v1 v2 v3) T).
+  Class TypedCas (ot : op_type) (v1 : val) (P1 : iProp Σ) (v2 : val) (P2 : iProp Σ) (v3 : val) (P3 : iProp Σ) : Type :=
+    typed_cas_proof T : iProp_to_Prop (typed_cas ot v1 P1 v2 P2 v3 P3 T).
+*)
+
+  (* This does not allow overloading the macro based on the type of
+  es. Is this a problem? There is a work around where the rule inserts
+  another judgment that allows type-based overloading. *)
+(*  Definition typed_macro_expr (m : list expr → expr) (es : list expr) (T : val → type → iProp Σ) : iProp Σ :=
+    (typed_val_expr (m es) T).
+  Class TypedMacroExpr (m : list expr → expr) (es : list expr) : Type :=
+    typed_macro_expr_proof T : iProp_to_Prop (typed_macro_expr m es T).*)
+
+  (*** places *)
+  (** [typed_write atomic e ot v ty] typechecks a write with op_type
+  ot of value [v] of type [ty] to the expression [e]. [atomic] says
+  whether the write is an atomic write. The typing rule for [typed_write]
+  typechecks [e] and then dispatches to [typed_write_end]. *)
+ (* Ke: probably for SAssign. TODO add a rule for Sset? *)
+ (* Ke: for RefinedC mapsto, use ⎡VST.mapsto_memory_block.mapsto q ot l v⎤ 
+        which is basically RefinedC.mapsto l v + l aligns according to ot + v fits in size of ot *)
+
+  Definition typed_write (atomic : bool) (e : expr) (ot : Ctypes.type) (v : val) (ty : type) (T : assert) : assert :=
+    let E := if atomic then ∅ else ⊤ in
+    (∀ (Φ: address->assert),
+        (∀ (l:address), (⎡v ◁ᵥ ty⎤ ={⊤, E}=∗
+                <affine> ⌜v `has_layout_val` ot⌝ ∗ ⎡ l ↦|ot| - ⎤ ∗
+                (* Ke : maybe we need later afterall because write is only done a write statement after? *)
+                ▷(⎡ l ↦|ot| v ⎤ ={E, ⊤}=∗ T))
+              -∗ Φ l) -∗
+       wp_lvalue ⊤ e Φ)%I.
+
+  (** [typed_read atomic e ot memcast] typechecks a read with op_type
+  ot of the expression [e]. [atomic] says whether the read is an
+  atomic read and [memcast] says whether a memcast is performed during
+  the read. The typing rule for [typed_read] typechecks [e] and then
+  dispatches to [typed_read_end] *)
+  (* FIXME cast need whole memory? *)
+Definition typed_read (atomic : bool) (e : expr) (ot : Ctypes.type) (memcast : bool) (m: mem) (T : val → type → assert) : assert :=
+    let E := if atomic then ∅ else ⊤ in
+    (∀ (Φ: val->assert),
+       (∀ (l:address), 
+          (|={⊤, E}=> ∃ v q (ty : type), ⌜l `has_layout_loc` ot⌝ ∗ ⌜v `has_layout_val` ot⌝ ∗
+                        ⎡ l ↦{q} |ot| v ⎤ ∗ ▷ ⎡v ◁ᵥ ty⎤ ∗ 
+                        ▷ (∀ st, ⎡ l ↦{q} |ot| v ⎤ -∗ ⎡v ◁ᵥ ty⎤ ={E, ⊤}=∗ 
+                        ∃ (ty' : type) v', 
+                          ⌜Some v'=if memcast then Cop.sem_cast v ot st m else Some v⌝ ∧
+                          ⎡v' ◁ᵥ ty'⎤ ∗
+                          T v' ty')) 
+        -∗ Φ l) -∗
+     wp_expr ⊤ e Φ)%I.
+
+  (** [typed_addr_of e] typechecks an address of operation on the expression [e].
+  The typing rule for [typed_addr_of] typechecks [e] and then dispatches to [typed_addr_of_end]*)
+  Definition typed_addr_of (e : expr) (T : address → own_state → type → assert) : assert :=
+    ∀ (Φ: val->assert),
+       (∀ (l : address) β ty, ⎡l ◁ₗ{β} ty⎤ -∗ T l β ty -∗ Φ l) -∗
+       wp_expr ⊤ e Φ.
+
+  (** [typed_read_end atomic E l β ty ot memcast] typechecks a read with op_type
+  ot of the location [l] with type [l ◁ₗ{β} ty]. [atomic] says whether the read is an
+  atomic read, [E] gives the current mask, and [memcast] says whether a memcast is
+  performed during the read. *)
+  Definition typed_read_end (atomic : bool) (E : coPset) (l : address) (β : own_state) (ty : type) (ot : Ctypes.type) (memcast : bool) (m:mem) (T : val → type → type → assert) : assert :=
+    (let E' := if atomic then ∅ else E in
+    ⎡l◁ₗ{β}ty⎤ ={E, E'}=∗ ∃ q v (ty2 : type),
+    ⌜l `has_layout_loc` ot⌝ ∗ ⌜v `has_layout_val` ot⌝ ∗
+    ⎡l↦{q}|ot|v⎤ ∗ ▷ ⎡v ◁ᵥ ty2⎤ ∗
+         ▷ (∀ st, ⎡l↦{q}|ot|v⎤ -∗ ⎡v ◁ᵥ ty2⎤ ={E', E}=∗
+            ∃ ty' (ty3 : type) (v':val), ⌜Some v'=if memcast then Cop.sem_cast v ot st m else Some v⌝ ∧
+              ⎡v' ◁ᵥ ty3⎤ ∗ ⎡l◁ₗ{β} ty'⎤ ∗ T v' ty' ty3))%I.
+
+  Class TypedReadEnd (atomic : bool) (E : coPset) (l : address) (β : own_state) (ty : type) (ot : Ctypes.type) (m:mem) (memcast : bool) : Type :=
+    typed_read_end_proof T : iProp_to_Prop (typed_read_end atomic E l β ty ot memcast m T).
+
+  (** [typed_write atomic E ot v1 ty1 l2 β2 ty2] typechecks a write with op_type
+  ot of value [v1] of type [ty1] to the location [l2] with type [l2 ◁ₗ{β2} ty].
+  [atomic] says whether the write is an atomic write and [E] gives the current mask. *)
+  Definition typed_write_end (atomic : bool) (E : coPset) (ot : Ctypes.type) (v1 : val) (ty1 : type) (l2 : address) (β2 : own_state) (ty2 : type) (T : type → assert) : assert :=
+    let E' := if atomic then ∅ else E in
+    (⎡l2 ◁ₗ{β2} ty2⎤ -∗ 
+    (⎡v1 ◁ᵥ ty1⎤ ={E, E'}=∗
+       <affine> ⌜v1 `has_layout_val` ot⌝ ∗
+      ⎡ l2↦|ot| - ⎤ ∗ 
+      ▷ (⎡ l2 ↦|ot| v1 ⎤ ={E', E}=∗ ∃ ty3, ⎡l2 ◁ₗ{β2} ty3⎤ ∗ T ty3)))%I.
+  Class TypedWriteEnd (atomic : bool) (E : coPset) (ot : Ctypes.type) (v1 : val) (ty1 : type) (l2 : address) (β2 : own_state) (ty2 : type) : Type :=
+    typed_write_end_proof T : iProp_to_Prop (typed_write_end atomic E ot v1 ty1 l2 β2 ty2 T).
+
+  (** [typed_addr_of_end l β ty] typechecks an address of operation on the location [l]
+  with type [l ◁ₗ{β} ty]. *)
+  Definition typed_addr_of_end (l : address) (β : own_state) (ty : type) (T : own_state → type → type → assert) : assert :=
+    (⎡l◁ₗ{β}ty⎤ ={⊤}=∗ ∃ β2 ty2 ty', ⎡l◁ₗ{β2}ty2⎤ ∗ ⎡l◁ₗ{β}ty'⎤ ∗ T β2 ty2 ty')%I.
+  Class TypedAddrOfEnd (l : address) (β : own_state) (ty : type) : Type :=
+    typed_addr_of_end_proof T : iProp_to_Prop (typed_addr_of_end l β ty T).
+
+  (*** typed places *)
+  (* This defines what place expressions can contain. We cannot reuse
+  W.ectx_item because of BinOpPCtx since there the root of the place
+  expression is not in evaluation position. *)
+  (* TODO: Should we track location information here? *)
+(*  Inductive place_ectx_item :=
+  | DerefPCtx (o : order) (ot : op_type) (memcast : bool)
+  | GetMemberPCtx (s : struct_layout) (m : var_name)
+  | GetMemberUnionPCtx (ul : union_layout) (m : var_name)
+  | AnnotExprPCtx (n : nat) {A} (x : A)
+    (* for PtrOffsetOp, second ot must be PtrOp *)
+  | BinOpPCtx (op : bin_op) (ot : op_type) (v : val) (ty : type)
+    (* for ptr-to-ptr casts, ot must be PtrOp *)
+  | UnOpPCtx (op : un_op)
+  .
+
+  (* Computes the WP one has to prove for the place ectx_item Ki
+  applied to the location l. *)
+  Definition place_item_to_wp (Ki : place_ectx_item) (Φ : loc → iProp Σ) (l : loc) : iProp Σ :=
+    match Ki with
+    | DerefPCtx o ot mc => WP !{ot, o, mc} l {{ v, ∃ l' : loc, ⌜v = val_of_loc l'⌝ ∗ Φ l' }}
+    | GetMemberPCtx sl m => WP l at{sl} m {{ v, ∃ l' : loc, ⌜v = val_of_loc l'⌝ ∗ Φ l' }}
+    | GetMemberUnionPCtx ul m => WP l at_union{ul} m {{ v, ∃ l' : loc, ⌜v = val_of_loc l'⌝ ∗ Φ l' }}
+    | AnnotExprPCtx n x => WP AnnotExpr n x l {{ v, ∃ l' : loc, ⌜v = val_of_loc l'⌝ ∗ Φ l' }}
+    (* we have proved typed_val_expr e1 before so we can use v ◁ᵥ ty here *)
+    | BinOpPCtx op ot v ty => v ◁ᵥ ty -∗ WP BinOp op ot PtrOp v l {{ v, ∃ l' : loc, ⌜v = val_of_loc l'⌝ ∗ Φ l' }}
+    | UnOpPCtx op => WP UnOp op PtrOp l {{ v, ∃ l' : loc, ⌜v = val_of_loc l'⌝ ∗ Φ l' }}
+    end%I.
+  Definition place_to_wp (K : list place_ectx_item) (Φ : loc → iProp Σ) : (loc → iProp Σ) := foldr place_item_to_wp Φ K.
+  Lemma place_to_wp_app (K1 K2 : list place_ectx_item) Φ : place_to_wp (K1 ++ K2) Φ = place_to_wp K1 (place_to_wp K2 Φ).
+  Proof. apply foldr_app. Qed.
+
+  Lemma place_item_to_wp_mono K Φ1 Φ2 l:
+    place_item_to_wp K Φ1 l -∗ (∀ l, Φ1 l -∗ Φ2 l) -∗ place_item_to_wp K Φ2 l.
+  Proof.
+    iIntros "HP HΦ". move: K => [o ot mc|sl m|ul m|n A x|op ot v ty|op]//=.
+    5: iIntros "Hv".
+    1-4,6: iApply (@wp_wand with "HP").
+    6: iApply (@wp_wand with "[Hv HP]"); first by iApply "HP".
+    all: iIntros (?); iDestruct 1 as (l' ->) "HΦ1".
+    all: iExists _; iSplit => //; by iApply "HΦ".
+  Qed.
+
+  Lemma place_to_wp_mono K Φ1 Φ2 l:
+    place_to_wp K Φ1 l -∗ (∀ l, Φ1 l -∗ Φ2 l) -∗ place_to_wp K Φ2 l.
+  Proof.
+    iIntros "HP HΦ".
+    iInduction (K) as [] "IH" forall (l) => /=. 1: by iApply "HΦ".
+    iApply (place_item_to_wp_mono with "HP").
+    iIntros (l') "HP". by iApply ("IH" with "HP HΦ").
+  Qed.
+
+  Fixpoint find_place_ctx (e : W.expr) : option ((list place_ectx_item → loc → iProp Σ) → iProp Σ) :=
+    match e with
+    | W.Loc l => Some (λ T, T [] l)
+    | W.Deref o ot mc e => T' ← find_place_ctx e; Some (λ T, T' (λ K l, T (K ++ [DerefPCtx o ot mc]) l))
+    | W.GetMember e sl m => T' ← find_place_ctx e; Some (λ T, T' (λ K l, T (K ++ [GetMemberPCtx sl m]) l))
+    | W.GetMemberUnion e ul m => T' ← find_place_ctx e; Some (λ T, T' (λ K l, T (K ++ [GetMemberUnionPCtx ul m]) l))
+    | W.AnnotExpr n x e => T' ← find_place_ctx e; Some (λ T, T' (λ K l, T (K ++ [AnnotExprPCtx n x]) l))
+    | W.LocInfoE a e => find_place_ctx e
+    (* Here we use the power of having a continuation available to add
+    a typed_val_expr. It is important that this happens before we get
+    to place_to_wp_mono since we will need to give up ownership of the
+    root of the place expression once we hit it. This allows us to
+    support e.g. a[a[0]]. *)
+    | W.BinOp op ot PtrOp e1 e2 => T' ← find_place_ctx e2; Some (λ T, typed_val_expr (W.to_expr e1) (λ v ty, T' (λ K l, T (K ++ [BinOpPCtx op ot v ty]) l)))
+    | W.UnOp op PtrOp e => T' ← find_place_ctx e; Some (λ T, T' (λ K l, T (K ++ [UnOpPCtx op]) l))
+    (* TODO: Is the existential quantifier here a good idea or should this be a fullblown judgment? *)
+    | W.UnOp op (IntOp it) e => Some (λ T, typed_val_expr (UnOp op (IntOp it) (W.to_expr e)) (λ v ty, v ◁ᵥ ty -∗ ∃ l, ⌜v = val_of_loc l⌝ ∗ T [] l)%I)
+    | W.LValue e => Some (λ T, typed_val_expr (W.to_expr e) (λ v ty, v ◁ᵥ ty -∗ ∃ l, ⌜v = val_of_loc l⌝ ∗ T [] l)%I)
+    | _ => None
+    end.
+
+  Class IntoPlaceCtx (e : expr) (T : (list place_ectx_item → loc → iProp Σ) → iProp Σ) :=
+    into_place_ctx Φ Φ': (⊢ T Φ' -∗ (∀ K l, Φ' K l -∗ place_to_wp K (Φ ∘ val_of_loc) l) -∗ WP e {{ Φ }}).
+
+  Section find_place_ctx_correct.
+  Arguments W.to_expr : simpl nomatch.
+  Lemma find_place_ctx_correct e T:
+    find_place_ctx e = Some T →
+    IntoPlaceCtx (W.to_expr e) T.
+  Proof.
+    elim: e T => //= *.
+    all: iIntros (Φ Φ') "HT HΦ'".
+    2,3: case_match.
+    all: try match goal with
+    |  H : ?x ≫= _ = Some _ |- _ => destruct x as [?|] eqn:Hsome
+    end; simplify_eq/=.
+    all: try match goal with
+    |  H : context [IntoPlaceCtx _ _] |- _ => rename H into IH
+    end.
+    1: iApply @wp_value; by iApply ("HΦ'" with "HT").
+    1: {
+      iApply "HT". iIntros (v ty) "Hv HT".
+      iDestruct ("HT" with "Hv") as (l ?) "HT". subst.
+        by iApply ("HΦ'" $! []).
+    }
+    4: {
+      rewrite /LValue. iApply "HT". iIntros (v ty) "Hv HT".
+      iDestruct ("HT" with "Hv") as (l ?) "HT". subst.
+      by iApply ("HΦ'" $! []).
+    }
+    2: wp_bind; rewrite -!/(W.to_expr _).
+    2: iApply "HT"; iIntros (v ty) "Hv HT".
+    2: iDestruct (IH with "HT") as "HT" => //.
+    1, 3-6: iDestruct (IH with "HT") as " HT" => //.
+    all: wp_bind; iApply "HT".
+    all: iIntros (K l) "HT" => /=.
+    all: iDestruct ("HΦ'" with "HT") as "HΦ"; rewrite place_to_wp_app /=.
+    all: iApply (place_to_wp_mono with "HΦ"); iIntros (l') "HWP" => /=.
+    6: iApply (@wp_wand with "[Hv HWP]"); first by iApply "HWP".
+    1-5: iApply (@wp_wand with "HWP").
+    all: iIntros (?); by iDestruct 1 as (? ->) "$".
+  Qed.
+  End find_place_ctx_correct.
+*)
+
+  (* TODO: have something like typed_place_cond which uses a fraction? Seems *)
+  (* tricky since stating that they have the same size requires that ty1 *)
+  (* and ty2 are movable (which they might not be) *)
+  (* Ke: ignoring typed_place_context for now, might need it later *)
+  (* Definition typed_place (l1 : address) (β1 : own_state) (ty1 : type) (T : address → own_state → type → (type → type) → (type → assert) → assert) : assert :=
+    (∀ Φ, ⎡l1 ◁ₗ{β1} ty1⎤ -∗
+       (∀ (l2 : address) β2 ty2 typ R, ⎡l2 ◁ₗ{β2} ty2⎤ -∗ (∀ ty', ⎡l2 ◁ₗ{β2} ty'⎤ ={⊤}=∗ ⎡l1 ◁ₗ{β1} typ ty'⎤ ∗ R ty') -∗ T l2 β2 ty2 typ R -∗ Φ l2) -∗ (wp_expr (EConst l) Φ))%I.
+  Class TypedPlace  (l1 : address) (β1 : own_state) (ty1 : type) : Type :=
+    typed_place_proof T : iProp_to_Prop (typed_place l1 β1 ty1 T). *)
+
+End judgements.
+
+(*Ltac solve_into_place_ctx :=
+  match goal with
+  | |- IntoPlaceCtx ?e ?T =>
+      let e' := W.of_expr e in
+      change_no_check (IntoPlaceCtx (W.to_expr e') T);
+      refine (find_place_ctx_correct _ _ _); rewrite/=/W.to_expr/=; done
+  end.
+Global Hint Extern 0 (IntoPlaceCtx _ _) => solve_into_place_ctx : typeclass_instances.*)
+
+Global Hint Mode Learnable + + : typeclass_instances.
+(*Global Hint Mode LearnAlignment + + + + - : typeclass_instances.*)
+Global Hint Mode CopyAs + + + + + + + : typeclass_instances.
+Global Hint Mode SimpleSubsumePlace + + + + + ! - : typeclass_instances.
+Global Hint Mode SimpleSubsumeVal + + + + ! ! - : typeclass_instances.
+Global Hint Mode TypedIf + + + + : typeclass_instances.
+(* Global Hint Mode TypedAssert + + + + + + : typeclass_instances. *)
+Global Hint Mode TypedValue + + + + + : typeclass_instances.
+Global Hint Mode TypedBinOp + + + + + + + + + + + : typeclass_instances.
+Global Hint Mode TypedUnOp + + + + + + + + : typeclass_instances.
+Global Hint Mode TypedCall + + + + + + + + + + : typeclass_instances.
+(*Global Hint Mode TypedCopyAllocId + + + + + + + : typeclass_instances. *)
+Global Hint Mode TypedReadEnd + + + + + + + + + + + + : typeclass_instances.
+Global Hint Mode TypedWriteEnd + + + + + + + + + + + + : typeclass_instances.
+Global Hint Mode TypedAddrOfEnd + + + + + + + : typeclass_instances.
+(* Global Hint Mode TypedPlace + + + + + + : typeclass_instances. *)
+Global Hint Mode TypedAnnotExpr + + + + + + + + : typeclass_instances.
+Global Hint Mode TypedAnnotStmt + + + + + + + : typeclass_instances.
+(* Global Hint Mode TypedMacroExpr + + + + : typeclass_instances. *)
+Arguments typed_annot_expr : simpl never.
+Arguments typed_annot_stmt : simpl never.
+(* Arguments typed_macro_expr : simpl never. *)
+Arguments learnable_data {_ _} _.
+(*Arguments learnalign_learn {_ _ _ _ _} _.*)
+
+Section proper.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  Lemma simplify_hyp_place_eq ty1 ty2 (Heq : ty1 ≡@{type} ty2) l β T:
+    (l ◁ₗ{β} ty2 -∗ T) ⊢ simplify_hyp (l◁ₗ{β} ty1) T.
+  Proof. iIntros "HT ?". rewrite Heq. by iApply "HT". Qed.
+
+  Lemma simplify_goal_place_eq ty1 ty2 (Heq : ty1 ≡@{type} ty2) l β T:
+    l ◁ₗ{β} ty2 ∗ T ⊢ simplify_goal (l◁ₗ{β} ty1) T.
+  Proof. rewrite Heq. iIntros "$". Qed.
+
+  Lemma simplify_hyp_val_eq ty1 ty2 (Heq : ty1 ≡@{type} ty2) v T:
+    (v ◁ᵥ ty2 -∗ T) ⊢ simplify_hyp (v ◁ᵥ ty1) T.
+  Proof. iIntros "HT ?". rewrite Heq. by iApply "HT". Qed.
+
+  Lemma simplify_goal_val_eq ty1 ty2 (Heq : ty1 ≡@{type} ty2) v T:
+    v ◁ᵥ ty2 ∗ T ⊢ simplify_goal (v ◁ᵥ ty1) T.
+  Proof. rewrite Heq. iIntros "$". Qed.
+
+(*  Lemma typed_place_subsume' P l ty1 β T :
+    (l ◁ₗ{β} ty1 -∗ ∃ ty2, l ◁ₗ{β} ty2 ∗ typed_place P l β ty2 T) ⊢ typed_place P l β ty1 T.
+  Proof.
+    iIntros "Hsub" (Φ) "Hl HΦ". iDestruct ("Hsub" with "Hl") as (ty2) "[Hl HP]". by iApply ("HP" with "Hl").
+  Qed.
+
+  Lemma typed_place_subsume P l ty1 ty2 β T :
+    subsume (l ◁ₗ{β} ty1) (λ _ : unit, l ◁ₗ{β} ty2) (λ _, typed_place P l β ty2 T) ⊢ typed_place P l β ty1 T.
+  Proof.
+    iIntros "Hsub". iApply typed_place_subsume'.
+    iIntros "Hl". iExists _. iDestruct ("Hsub" with "Hl") as (_) "$".
+  Qed.*)
+
+  (** wand lemmas *)
+  Lemma typed_val_expr_wand e T1 T2:
+    typed_val_expr e T1 -∗
+    (∀ v ty, T1 v ty -∗ T2 v ty) -∗
+    typed_val_expr e T2.
+  Proof.
+    iIntros "He HT" (Φ) "HΦ".
+    iApply "He". iIntros (v ty) "Hv Hty".
+    iApply ("HΦ" with "Hv"). by iApply "HT".
+  Qed.
+
+  Lemma typed_if_wand ot v (P : iProp Σ) T1 T2 T1' T2':
+    typed_if ot v P T1 T2 -∗
+    ((T1 -∗ T1') ∧ (T2 -∗ T2')) -∗
+    typed_if ot v P T1' T2'.
+  Proof.
+    iIntros "Hif HT Hv". iDestruct ("Hif" with "Hv") as "Hif".
+    destruct ot; iDestruct "Hif" as (b ?) "HC"; iExists b; (iSplit; first done); (case_bool_decide || if_tac;
+      (iDestruct "HT" as "[_ HT]"; by iApply "HT") || (iDestruct "HT" as "[HT _]"; by iApply "HT")).
+  Qed.
+
+  Lemma typed_bin_op_wand v1 P1 Q1 v2 P2 Q2 op ot1 ot2 T:
+    typed_bin_op v1 Q1 v2 Q2 op ot1 ot2 T -∗
+    (P1 -∗ Q1) -∗
+    (P2 -∗ Q2) -∗
+    typed_bin_op v1 P1 v2 P2 op ot1 ot2 T.
+  Proof.
+    iIntros "H Hw1 Hw2 H1 H2".
+    iApply ("H" with "[Hw1 H1]"); [by iApply "Hw1"|by iApply "Hw2"].
+  Qed.
+
+  Lemma typed_un_op_wand v P Q op ot T:
+    typed_un_op v Q op ot T -∗
+    (P -∗ Q) -∗
+    typed_un_op v P op ot T.
+  Proof.
+    iIntros "H Hw HP". iApply "H". by iApply "Hw".
+  Qed.
+
+  Lemma type_val_expr_mono_strong e T :
+    typed_val_expr e (λ v ty,
+      ∃ ty', subsume ⎡v ◁ᵥ ty⎤ (λ _ : unit, ⎡v ◁ᵥ ty'⎤) (λ _, T v ty'))%I
+    -∗ typed_val_expr e T.
+  Proof.
+    iIntros "HT". iIntros (Φ) "HΦ".
+    iApply "HT". iIntros (v ty) "Hv HT".
+    iDestruct "HT" as (ty') "HT".
+    iPoseProof ("HT" with "Hv") as (?) "[Hv HT']".
+    iApply ("HΦ" with "Hv HT'").
+  Qed.
+
+
+(*
+  (** typed_read_end *)
+  Lemma typed_read_end_mono_strong (a : bool) E1 E2 l β ty ot mc T:
+    (if a then ∅ else E2) = (if a then ∅ else E1) →
+    (l ◁ₗ{β} ty ={E1, E2}=∗ ∃ β' ty' P, l ◁ₗ{β'} ty' ∗ ▷ P ∗
+       typed_read_end a E2 l β' ty' ot mc (λ v ty2 ty3,
+          P -∗ l ◁ₗ{β'} ty2 -∗ v ◁ᵥ ty3 ={E2, E1}=∗
+          ∃ ty2' ty3', l ◁ₗ{β} ty2' ∗ v ◁ᵥ ty3' ∗ T v ty2' ty3')) -∗
+    typed_read_end a E1 l β ty ot mc T.
+  Proof.
+    iIntros (Ha) "HT Hl". iMod ("HT" with "Hl") as (β' ty' P) "(Hl&HP&HT)".
+    iMod ("HT" with " Hl") as (?????) "(Hl&Hv&HT)". rewrite Ha.
+    iModIntro. iExists _, _, _.
+    iFrame "Hl Hv". iSplit; [done|]. iSplit; [done|].
+    iIntros "!> %st Hl Hv". iMod ("HT" with "Hl Hv") as (? ty3) "(Hcast&Hl&HT)".
+    iMod ("HT" with "HP Hl Hcast") as (ty2' ty3') "(?&?&?)". iExists _, _. by iFrame.
+  Qed.
+
+  Lemma typed_read_end_wand (a : bool) E l β ty ot mc T T':
+    typed_read_end a E l β ty ot mc T' -∗
+    (∀ v ty1 ty2, T' v ty1 ty2 -∗ T v ty1 ty2) -∗
+    typed_read_end a E l β ty ot mc T.
+  Proof.
+    iIntros "HT Hw Hl". iMod ("HT" with "Hl") as (???) "(%&%&Hl&Hv&HT)".
+    iModIntro. iExists _, _, _.
+    iFrame "Hl Hv". iSplit; [done|]. iSplit; [done|].
+    iIntros "!> %st Hl Hv". iMod ("HT" with "Hl Hv") as (? ty3) "(Hcast&Hl&HT)".
+    iExists _, _. iFrame. by iApply "Hw".
+  Qed.
+
+  Lemma fupd_typed_read_end a E l β ty ot mc T:
+    (|={E}=> typed_read_end a E l β ty ot mc T)
+    ⊢ typed_read_end a E l β ty ot mc T.
+  Proof. iIntros ">H". by iApply "H". Qed.
+
+  (* TODO: can this be Global? *)
+  Local Typeclasses Opaque typed_read_end.
+  Global Instance elim_modal_fupd_typed_read_end p a E l β ty ot mc T P :
+    ElimModal True p false (|={E}=> P) P (typed_read_end a E l β ty ot mc T) (typed_read_end a E l β ty ot mc T).
+  Proof.
+    iIntros (?) "[HP HT]".
+    rewrite bi.intuitionistically_if_elim -{2}fupd_typed_read_end.
+    iMod "HP". by iApply "HT".
+  Qed.
+
+  Global Instance is_except_0_typed_read_end a E l β ty ot mc T : IsExcept0 (typed_read_end a E l β ty ot mc T).
+  Proof. by rewrite /IsExcept0 -{2}fupd_typed_read_end -except_0_fupd -fupd_intro. Qed.
+
+  Global Instance elim_modal_fupd_typed_read_end_atomic p E1 E2 l β ty ot mc T P:
+    ElimModal True p false
+            (|={E1,E2}=> P) P
+            (typed_read_end true  E1 l β ty ot mc T)
+            (typed_read_end true E2 l β ty ot mc (λ v ty ty', |={E2,E1}=> T v ty ty'))%I
+            | 100.
+  Proof.
+    iIntros (?) "[HP HT]". rewrite bi.intuitionistically_if_elim.
+    iApply typed_read_end_mono_strong; [done|]. iIntros "Hl". iMod "HP". iModIntro.
+    iExists _, _, True%I. iFrame. iSplit; [done|].
+    iApply (typed_read_end_wand with "(HT HP)").
+    iIntros (v ty1 ty2) "HT _ Hl Hv". iMod "HT". iModIntro. iExists _, _. iFrame.
+  Qed.
+
+  Global Instance elim_acc_typed_read_end_atomic {X} E1 E2 α β γ l b ty ot mc T :
+    ElimAcc (X:=X) True
+            (fupd E1 E2) (fupd E2 E1)
+            α β γ
+            (typed_read_end true E1 l b ty ot mc T)
+            (λ x, typed_read_end true E2 l b ty ot mc (λ v ty ty', |={E2}=> β x ∗ (γ x -∗? T v ty ty')))%I | 100.
+  Proof.
+    iIntros (?) "Hinner Hacc".
+    iMod "Hacc" as (x) "[Hα Hclose]".
+    iApply (typed_read_end_wand with "(Hinner Hα)").
+    iIntros (v ty1 ty2) ">[Hβ HT]". iMod ("Hclose" with "Hβ"). by iApply "HT".
+  Qed.
+
+  (** typed_write_end *)
+  Lemma typed_write_end_mono_strong (a : bool) E1 E2 ot v1 ty1 l2 β2 ty2 T:
+    (if a then ∅ else E2) = (if a then ∅ else E1) →
+    (v1 ◁ᵥ ty1 -∗ l2 ◁ₗ{β2} ty2 ={E1, E2}=∗ ∃ ty1' β2' ty2' P,
+       v1 ◁ᵥ ty1' ∗ l2 ◁ₗ{β2'} ty2' ∗ ▷ P ∗
+       typed_write_end a E2 ot v1 ty1' l2 β2' ty2' (λ ty3,
+          P -∗ l2 ◁ₗ{β2'} ty3 ={E2, E1}=∗
+          ∃ ty3', l2 ◁ₗ{β2} ty3' ∗ T ty3')) -∗
+    typed_write_end a E1 ot v1 ty1 l2 β2 ty2 T.
+  Proof.
+    iIntros (Ha) "HT Hl Hv". iMod ("HT" with "Hv Hl") as (ty1' β2' ty2' P) "(Hv&Hl&HP&HT)".
+    iMod ("HT" with "Hl Hv") as (?) "(?&HT)". rewrite Ha.
+    iModIntro. iSplit; [done|]. iFrame. iIntros "!> Hl". iMod ("HT" with "Hl") as (ty3) "(Hl&HT)".
+    iMod ("HT" with "HP Hl") as (ty3') "(?&?)". iExists  _. by iFrame.
+  Qed.
+
+  Lemma typed_write_end_wand a E v1 ty1 l2 β2 ty2 ot T T':
+    typed_write_end a E ot v1 ty1 l2 β2 ty2 T' -∗
+    (∀ ty3, T' ty3 -∗ T ty3) -∗
+    typed_write_end a E ot v1 ty1 l2 β2 ty2 T.
+  Proof.
+    iIntros "HT Hw Hl Hv". iMod ("HT" with "Hl Hv") as (?) "(?&HT)".
+    iModIntro. iFrame. iSplit; [done|].
+    iIntros "!> Hl". iMod ("HT" with "Hl") as (ty3) "(Hl&HT)".
+    iExists _. iFrame. by iApply "Hw".
+  Qed.
+
+  Lemma fupd_typed_write_end a E v1 ty1 l2 β2 ty2 ot T:
+    (|={E}=> typed_write_end a E ot v1 ty1 l2 β2 ty2 T)
+    ⊢ typed_write_end a E ot v1 ty1 l2 β2 ty2 T.
+  Proof. iIntros ">H". by iApply "H". Qed.
+
+  (* TODO: can this be Global? *)
+  Local Typeclasses Opaque typed_write_end.
+  Global Instance elim_modal_fupd_typed_write_end P p a E v1 ty1 l2 β2 ty2 ot T:
+    ElimModal True p false (|={E}=> P) P (typed_write_end a E ot v1 ty1 l2 β2 ty2 T) (typed_write_end a E ot v1 ty1 l2 β2 ty2 T).
+  Proof.
+    iIntros (?) "[HP HT]".
+    rewrite bi.intuitionistically_if_elim -{2}fupd_typed_write_end.
+    iMod "HP". by iApply "HT".
+  Qed.
+
+  Global Instance is_except_0_typed_write_end a E v1 ty1 l2 β2 ty2 ot T : IsExcept0 (typed_write_end a E ot v1 ty1 l2 β2 ty2 T).
+  Proof. by rewrite /IsExcept0 -{2}fupd_typed_write_end -except_0_fupd -fupd_intro. Qed.
+
+  Global Instance elim_modal_fupd_typed_write_end_atomic p E1 E2 v1 ty1 l2 β2 ty2 ot T P:
+    ElimModal True p false
+            (|={E1,E2}=> P) P
+            (typed_write_end true E1 ot v1 ty1 l2 β2 ty2 T)
+            (typed_write_end true E2 ot v1 ty1 l2 β2 ty2 (λ ty3, |={E2,E1}=> T ty3))%I
+            | 100.
+  Proof.
+    iIntros (?) "[HP HT]". rewrite bi.intuitionistically_if_elim.
+    iApply typed_write_end_mono_strong; [done|]. iIntros "Hv Hl". iMod "HP". iModIntro.
+    iExists _, _, _, True%I. iFrame. iSplit; [done|].
+    iApply (typed_write_end_wand with "(HT HP)").
+    iIntros (ty3) "HT _ Hl". iMod "HT". iModIntro. iExists _. iFrame.
+  Qed.
+
+  Global Instance elim_acc_typed_write_end_atomic {X} E1 E2 α β γ v1 ty1 l2 β2 ty2 ot T :
+    ElimAcc (X:=X) True
+            (fupd E1 E2) (fupd E2 E1)
+            α β γ
+            (typed_write_end true E1 ot v1 ty1 l2 β2 ty2 T)
+            (λ x, typed_write_end true E2 ot v1 ty1 l2 β2 ty2 (λ ty3, |={E2}=> β x ∗ (γ x -∗? T ty3)))%I | 100.
+  Proof.
+    iIntros (?) "Hinner Hacc".
+    iMod "Hacc" as (x) "[Hα Hclose]".
+    iApply (typed_write_end_wand with "(Hinner Hα)").
+    iIntros (ty3) ">[Hβ HT]". iMod ("Hclose" with "Hβ"). by iApply "HT".
+  Qed.
+*)
+End proper.
+(*Global Typeclasses Opaque typed_read_end.
+Global Typeclasses Opaque typed_write_end.*)
+
+Definition FindLoc `{!typeG OK_ty Σ} {cs : compspecs} (l : address) :=
+  {| fic_A := own_state * type; fic_Prop '(β, ty):= (l ◁ₗ{β} ty)%I; |}.
+Definition FindVal `{!typeG OK_ty Σ} {cs : compspecs} (v : val) : @find_in_context_info assert :=
+  {| fic_A := type; fic_Prop ty := ⎡v ◁ᵥ ty⎤%I; |}.
+Definition FindValP {B : bi} (v : val) :=
+  {| fic_A := B; fic_Prop P := P; |}.
+Definition FindValOrLoc {Σ} (v : val) (l : address) :=
+  {| fic_A := iProp Σ; fic_Prop P := P; |}.
+Definition FindLocInBounds {Σ} (l : address) :=
+  {| fic_A := iProp Σ; fic_Prop P := P |}.
+Definition FindAllocAlive {Σ} (l : address) :=
+  {| fic_A := iProp Σ; fic_Prop P := P |}.
+Global Typeclasses Opaque FindLoc FindVal FindValP FindValOrLoc FindLocInBounds FindAllocAlive.
+
+(** setup instance generation *)
+Ltac generate_i2p_instance_to_tc_hook arg c ::=
+  lazymatch c with
+  | typed_value ?x => constr:(TypedValue x)
+  | typed_bin_op ?x1 ?x2 ?x3 ?x4 ?x5 ?x6 ?x7 => constr:(TypedBinOp x1 x2 x3 x4 x5 x6 x7)
+  | typed_un_op ?x1 ?x2 ?x3 ?x4 => constr:(TypedUnOp x1 x2 x3 x4)
+(*  | typed_call ?x1 ?x2 ?x3 ?x4 => constr:(TypedCall x1 x2 x3 x4)
+  | typed_copy_alloc_id ?x1 ?x2 ?x3 ?x4 ?x5 => constr:(TypedCopyAllocId x1 x2 x3 x4 x5)
+  | typed_place ?x1 ?x2 ?x3 ?x4 => constr:(TypedPlace x1 x2 x3 x4)
+  | typed_read_end ?x1 ?x2 ?x3 ?x4 ?x5 ?x6 ?x7 => constr:(TypedReadEnd x1 x2 x3 x4 x5 x6 x7) *)
+  | typed_write_end ?x1 ?x2 ?x3 ?x4 ?x5 ?x6 ?x7 ?x8 => constr:(TypedWriteEnd x1 x2 x3 x4 x5 x6 x7 x8) 
+  | typed_addr_of_end ?x1 ?x2 ?x3 => constr:(TypedAddrOfEnd x1 x2 x3)
+(*   | typed_cas ?x1 ?x2 ?x3 ?x4 ?x5 ?x6 ?x7 => constr:(TypedCas x1 x2 x3 x4 x5 x6 x7) *)
+  | typed_annot_expr ?x1 ?x2 ?x3 ?x4 => constr:(TypedAnnotExpr x1 x2 x3 x4)
+(*   | typed_macro_expr ?x1 ?x2 => constr:(TypedMacroExpr x1 x2) *)
+  | typed_if ?x1 ?x2 ?x3 => constr:(TypedIf x1 x2 x3)
+(*   | typed_assert ?x1 ?x2 ?x3 => constr:(TypedAssert x1 x2 x3) *)
+(*   | typed_switch ?x1 ?x2 ?x3 => constr:(TypedSwitch x1 x2 x3) *)
+  | typed_annot_stmt ?x1 ?x2 ?x3 => constr:(TypedAnnotStmt x1 x2 x3)
+  | copy_as ?x1 ?x2 ?x3 => constr:(CopyAs x1 x2 x3)
+  | _ => fail "unknown judgement" c
+  end.
+
+Section typing.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  Lemma find_in_context_type_loc_id l T:
+    (∃ β ty, l ◁ₗ{β} ty ∗ T (β, ty))
+    ⊢ find_in_context (FindLoc l) T.
+  Proof. iDestruct 1 as (β ty) "[Hl HT]". iExists (_, _) => /=. iFrame. Qed.
+  Definition find_in_context_type_loc_id_inst :=
+    [instance find_in_context_type_loc_id with FICSyntactic].
+  Global Existing Instance find_in_context_type_loc_id_inst | 1.
+
+  Lemma find_in_context_type_val_id v T:
+    (∃ ty, ⎡v ◁ᵥ ty⎤ ∗ T ty)
+    ⊢ find_in_context (FindVal v) T.
+  Proof. iDestruct 1 as (ty) "[Hl HT]". iExists _ => /=. iFrame. Qed.
+  Definition find_in_context_type_val_id_inst :=
+    [instance find_in_context_type_val_id with FICSyntactic].
+  Global Existing Instance find_in_context_type_val_id_inst | 1.
+
+  Lemma find_in_context_type_val_P_id v T:
+    (∃ ty, v ◁ᵥ ty ∗ T (v ◁ᵥ ty))
+    ⊢ find_in_context (FindValP v) T.
+  Proof. iDestruct 1 as (ty) "[Hl HT]". iExists (ty_own_val ty _) => /=. iFrame. Qed.
+  Definition find_in_context_type_val_P_id_inst :=
+    [instance find_in_context_type_val_P_id with FICSyntactic].
+  Global Existing Instance find_in_context_type_val_P_id_inst | 1.
+
+  Lemma find_in_context_type_val_P_loc_id l T:
+    (∃ β ty, l ◁ₗ{β} ty ∗ T (l ◁ₗ{β} ty))
+    ⊢ find_in_context (FindValP l) T.
+  Proof. iDestruct 1 as (β ty) "[Hl HT]". iExists (ty_own _ _ _) => /=. iFrame. Qed.
+  Definition find_in_context_type_val_P_loc_id_inst :=
+    [instance find_in_context_type_val_P_loc_id with FICSyntactic].
+  Global Existing Instance find_in_context_type_val_P_loc_id_inst | 10.
+
+  Lemma find_in_context_type_val_or_loc_P_id_val (v : val) (l : address) T:
+    (∃ ty, v ◁ᵥ ty ∗ T (v ◁ᵥ ty))
+    ⊢ find_in_context (FindValOrLoc v l) T.
+  Proof. iDestruct 1 as (ty) "[Hl HT]". iExists (ty_own_val ty _) => /=. iFrame. Qed.
+  Definition find_in_context_type_val_or_loc_P_id_val_inst :=
+    [instance find_in_context_type_val_or_loc_P_id_val with FICSyntactic].
+  Global Existing Instance find_in_context_type_val_or_loc_P_id_val_inst | 1.
+
+  Lemma find_in_context_type_val_or_loc_P_val_loc (lv l : address) T:
+    (∃ β ty, lv ◁ₗ{β} ty ∗ T (lv ◁ₗ{β} ty))
+    ⊢ find_in_context (FindValOrLoc lv l) T.
+  Proof. iDestruct 1 as (β ty) "[Hl HT]". iExists _. by iFrame. Qed.
+  Definition find_in_context_type_val_or_loc_P_val_loc_inst :=
+    [instance find_in_context_type_val_or_loc_P_val_loc with FICSyntactic].
+  Global Existing Instance find_in_context_type_val_or_loc_P_val_loc_inst | 10.
+
+  Lemma find_in_context_type_val_or_loc_P_id_loc (v : val) (l : address) T:
+    (∃ β ty, l ◁ₗ{β} ty ∗ T (l ◁ₗ{β} ty))
+    ⊢ find_in_context (FindValOrLoc v l) T.
+  Proof. iDestruct 1 as (β ty) "[Hl HT]". iExists (l ◁ₗ{β} ty)%I => /=. iFrame. Qed.
+  Definition find_in_context_type_val_or_loc_P_id_loc_inst :=
+    [instance find_in_context_type_val_or_loc_P_id_loc with FICSyntactic].
+  Global Existing Instance find_in_context_type_val_or_loc_P_id_loc_inst | 20.
+
+(*  Lemma find_in_context_loc_in_bounds l T :
+    (∃ n, loc_in_bounds l n ∗ T (loc_in_bounds l n))
+    ⊢ find_in_context (FindLocInBounds l) T.
+  Proof. iDestruct 1 as (n) "[??]". iExists (loc_in_bounds _ _) => /=. iFrame. Qed.
+  Definition find_in_context_loc_in_bounds_inst :=
+    [instance find_in_context_loc_in_bounds with FICSyntactic].
+  Global Existing Instance find_in_context_loc_in_bounds_inst | 1.
+
+  Lemma find_in_context_loc_in_bounds_loc l T :
+    (∃ β ty, l ◁ₗ{β} ty ∗ T (l ◁ₗ{β} ty))
+    ⊢ find_in_context (FindLocInBounds l) T.
+  Proof. iDestruct 1 as (β ty) "[??]". iExists (ty_own _ _ _) => /=. iFrame. Qed.
+  Definition find_in_context_loc_in_bounds_loc_inst :=
+    [instance find_in_context_loc_in_bounds_loc with FICSyntactic].
+  Global Existing Instance find_in_context_loc_in_bounds_loc_inst | 10.
+
+  Lemma find_in_context_alloc_alive_global l T :
+    (alloc_global l ∗ T (alloc_global l))
+    ⊢ find_in_context (FindAllocAlive l) T.
+  Proof. iDestruct 1 as "?". iExists _ => /=. iFrame. Qed.
+  Definition find_in_context_alloc_alive_global_inst :=
+    [instance find_in_context_alloc_alive_global with FICSyntactic].
+  Global Existing Instance find_in_context_alloc_alive_global_inst | 1.*)
+
+  Lemma find_in_context_alloc_alive_loc l T :
+    (∃ β ty, l ◁ₗ{β} ty ∗ T (l ◁ₗ{β} ty))
+    ⊢ find_in_context (FindAllocAlive l) T.
+  Proof. iDestruct 1 as (β ty) "[??]". iExists (ty_own _ _ _) => /=. iFrame. Qed.
+  Definition find_in_context_alloc_alive_loc_inst :=
+    [instance find_in_context_alloc_alive_loc with FICSyntactic].
+  Global Existing Instance find_in_context_alloc_alive_loc_inst | 10.
+
+  Global Instance related_to_loc A l β ty : RelatedTo (λ x : A, l ◁ₗ{β x} ty x)%I | 100
+    := {| rt_fic := FindLoc l |}.
+  Global Instance related_to_val A v ty : RelatedTo (λ x : A, v ◁ᵥ ty x)%I | 100
+    := {| rt_fic := FindValP v |}.
+(*  Global Instance related_to_loc_in_bounds A l n : RelatedTo (λ x : A, loc_in_bounds l (n x)) | 100
+    := {| rt_fic := FindLocInBounds l |}.
+  Global Instance related_to_alloc_alive A l : RelatedTo (λ x : A, alloc_alive_loc l) | 100
+    := {| rt_fic := FindAllocAlive l |}.
+
+  Global Program Instance learnalignment_none β ty : LearnAlignment β ty None | 1000.
+  Next Obligation. iIntros (???) "?". done. Qed.
+
+  Lemma subsume_loc_in_bounds A ty β l (n m : nat) `{!LocInBounds ty β m} T :
+    (l ◁ₗ{β} ty -∗ ⌜n ≤ m⌝ ∗ ∃ x, T x)
+    ⊢ subsume (l ◁ₗ{β} ty) (λ x : A, loc_in_bounds l n) T.
+  Proof.
+    iIntros "HT Hl".
+    iDestruct (loc_in_bounds_in_bounds with "Hl") as "#?".
+    iDestruct ("HT" with "Hl") as (??) "?". iExists _. iFrame.
+    iApply loc_in_bounds_shorten; last done. lia.
+  Qed.
+  Definition subsume_loc_in_bounds_inst := [instance subsume_loc_in_bounds].
+  Global Existing Instance subsume_loc_in_bounds_inst | 10.
+
+  Lemma subsume_loc_in_bounds_evar A ty β l (n : A → nat) (m : nat)
+    `{!LocInBounds ty β m} T :
+    (l ◁ₗ{β} ty -∗ ∃ x, ⌜n x = m⌝ ∗ T x)
+    ⊢ subsume (l ◁ₗ{β} ty) (λ x, loc_in_bounds l (n x)) T.
+  Proof.
+    iIntros "HT Hl".
+    iDestruct (loc_in_bounds_in_bounds with "Hl") as "#?".
+    iDestruct ("HT" with "Hl") as (??) "?". iExists _. iFrame.
+    iApply loc_in_bounds_shorten; last done. lia.
+  Qed.
+  Definition subsume_loc_in_bounds_evar_inst := [instance subsume_loc_in_bounds_evar].
+  Global Existing Instance subsume_loc_in_bounds_evar_inst | 20.
+
+  Lemma subsume_alloc_alive_global A l T :
+    (∃ x, T x)
+    ⊢ subsume (alloc_global l) (λ x : A, alloc_alive_loc l) T.
+  Proof. iIntros "[% ?] Hl". iExists _. iFrame. by iApply (alloc_global_alive). Qed.
+  Definition subsume_alloc_alive_global_inst := [instance subsume_alloc_alive_global].
+  Global Existing Instance subsume_alloc_alive_global_inst.
+
+  Lemma subsume_alloc_alive A ty β l P `{!AllocAlive ty β P} T :
+    (* You don't get l ◁ₗ{β} ty back because alloc_alive is not persistent. *)
+    (P ∗ ∃ x, T x)
+    ⊢ subsume (l ◁ₗ{β} ty) (λ x : A, alloc_alive_loc l) T.
+  Proof. iIntros "[HP [% ?]] Hl". iExists _. iFrame. by iApply (alloc_alive_alive with "HP"). Qed.
+  Definition subsume_alloc_alive_inst := [instance subsume_alloc_alive].
+  Global Existing Instance subsume_alloc_alive_inst | 5.
+
+  Lemma subsume_alloc_alive_type_alive A ty β l `{!CheckOwnInContext (type_alive ty β)} T :
+    (type_alive ty β ∗ ∃ x, T x)
+    ⊢ subsume (l ◁ₗ{β} ty) (λ x : A, alloc_alive_loc l) T.
+  Proof. iIntros "[Ha [% ?]] Hl". rewrite /type_alive. iExists _. iFrame. by iApply "Ha". Qed.
+  Definition subsume_alloc_alive_type_alive_inst := [instance subsume_alloc_alive_type_alive].
+  Global Existing Instance subsume_alloc_alive_type_alive_inst | 10.
+
+  Lemma simplify_goal_type_alive ty β P `{!AllocAlive ty β P} T :
+    □ P ∗ T
+    ⊢ simplify_goal (type_alive ty β) T.
+  Proof.
+    iIntros "[#HP HT]". iFrame. rewrite /type_alive. iIntros "!>" (?) "Hl".
+      by iApply (alloc_alive_alive with "HP Hl").
+  Qed.
+  Definition simplify_goal_type_alive_inst := [instance simplify_goal_type_alive with 0%N].
+  Global Existing Instance simplify_goal_type_alive_inst.
+
+  Lemma subsume_loc_in_bounds_leq A (l : loc) (n1 n2 : nat) T :
+    (⌜n2 ≤ n1⌝%nat ∗ ∃ x, T x)
+    ⊢ subsume (loc_in_bounds l n1) (λ x : A, loc_in_bounds l n2) T.
+  Proof. iIntros "[% [% ?]] #?". iExists _. iFrame. by iApply loc_in_bounds_shorten. Qed.
+  Definition subsume_loc_in_bounds_leq_inst := [instance subsume_loc_in_bounds_leq].
+  Global Existing Instance subsume_loc_in_bounds_leq_inst | 10.
+
+  Lemma subsume_loc_in_bounds_leq_evar A (l : loc) (n1 : nat) (n2 : A → nat) T :
+    (∃ x, ⌜n2 x = n1⌝%nat ∗ T x)
+    ⊢ subsume (loc_in_bounds l n1) (λ x, loc_in_bounds l (n2 x)) T.
+  Proof. iIntros "[% [% ?]] #?". iExists _. iFrame. iApply loc_in_bounds_shorten; [|done]. lia. Qed.
+  Definition subsume_loc_in_bounds_leq_evar_inst := [instance subsume_loc_in_bounds_leq_evar].
+  Global Existing Instance subsume_loc_in_bounds_leq_evar_inst | 20.*)
+
+  Lemma apply_subsume_place_true l1 β1 ty1 l2 β2 ty2:
+    l1 ◁ₗ{β1} ty1 -∗
+    subsume (l1 ◁ₗ{β1} ty1) (λ _ : unit, l2 ◁ₗ{β2} ty2) (λ _, emp) -∗
+    l2 ◁ₗ{β2} ty2.
+  Proof. iIntros "Hl1 Hsub". iDestruct ("Hsub" with "Hl1") as (?) "[$ _]". Qed.
+
+  Lemma apply_subsume_place l ty2 T:
+    (find_in_context (FindDirect (λ '(β, ty), l◁ₗ{β}ty)) (λ '(β, ty),
+         subsume (l◁ₗ{β} ty) (λ _ : unit, l◁ₗ{β} ty2) (λ _, l◁ₗ{β}ty2 -∗ T))) -∗ T.
+  Proof.
+    iDestruct 1 as ([β ty1]) "[Hl Hsub]".
+    iDestruct ("Hsub" with "Hl") as (?) "[Hl HT]". by iApply "HT".
+  Qed.
+
+  Lemma simplify_place_refine_l A (ty : rtype A) l β T:
+    (∀ x, l ◁ₗ{β} x @ ty -∗ T) ⊢ simplify_hyp (l◁ₗ{β}ty) T.
+  Proof.
+    iIntros "HT Hl". unfold ty_of_rty; simpl_type. iDestruct "Hl" as (x) "Hv". by iApply "HT".
+  Qed.
+  Definition simplify_place_refine_l_inst := [instance simplify_place_refine_l with 0%N].
+  Global Existing Instance simplify_place_refine_l_inst.
+
+  Lemma simplify_val_refine_l A (ty : rtype A) v T:
+    (∀ x, v ◁ᵥ (x @ ty) -∗ T) ⊢ simplify_hyp (v ◁ᵥ ty) T.
+  Proof.
+    iIntros "HT Hl". unfold ty_of_rty; simpl_type. iDestruct "Hl" as (x) "Hv". by iApply "HT".
+  Qed.
+  Definition simplify_val_refine_l_inst := [instance simplify_val_refine_l with 0%N].
+  Global Existing Instance simplify_val_refine_l_inst.
+
+  (* This is forced since it can create evars in places where we don't
+  want them. We might first want to try subtyping without the evar (see e.g. optional ) *)
+  Lemma simplify_goal_place_refine_r A (ty : rtype A) l β T:
+    (∃ x, l ◁ₗ{β} x @ ty ∗ T) ⊢ simplify_goal (l◁ₗ{β}ty) T.
+  Proof. iDestruct 1 as (x) "[Hl $]". by iExists _. Qed.
+  Definition simplify_goal_place_refine_r_inst := [instance simplify_goal_place_refine_r with 10%N].
+  Global Existing Instance simplify_goal_place_refine_r_inst.
+
+  Lemma simplify_goal_val_refine_r A (ty : rtype A) v T :
+    (∃ x, v ◁ᵥ (x @ ty) ∗ T) ⊢ simplify_goal (v ◁ᵥ ty) T.
+  Proof. iDestruct 1 as (x) "[? $]". by iExists _. Qed.
+  Definition simplify_goal_val_refine_r_inst := [instance simplify_goal_val_refine_r with 10%N].
+  Global Existing Instance simplify_goal_val_refine_r_inst.
+
+  (* This rule is complete as [LocInBounds] implies that the location cannot be NULL. *)
+(*  Lemma simplify_goal_NULL_loc_in_bounds β ty n `{!LocInBounds ty β n} T:
+    False
+    ⊢ simplify_goal (NULL_loc ◁ₗ{β} ty) T.
+  Proof. by iIntros (?). Qed.
+  Definition simplify_goal_NULL_loc_in_bounds_inst := [instance simplify_goal_NULL_loc_in_bounds with 0%N].
+  Global Existing Instance simplify_goal_NULL_loc_in_bounds_inst.*)
+
+  Global Instance simple_subsume_place_id ty : SimpleSubsumePlace ty ty emp | 1.
+  Proof. iIntros (??) "_ $". Qed.
+  Global Instance simple_subsume_val_id ty : SimpleSubsumeVal ty ty emp | 1.
+  Proof. iIntros (?) "_ $". Qed.
+  Global Instance simple_subsume_place_refinement_id A ty (x1 x2 : A) :
+    SimpleSubsumePlace (x1 @ ty) (x2 @ ty) (<affine> ⌜x1 = x2⌝) | 100.
+  Proof. iIntros (?? ->) "$". Qed.
+  Global Instance simple_subsume_val_refinement_id A ty (x1 x2 : A) :
+    SimpleSubsumeVal (x1 @ ty) (x2 @ ty) (<affine> ⌜x1 = x2⌝) | 100.
+  Proof. iIntros (? ->) "$". Qed.
+
+  Global Instance simple_subsume_place_rty_to_ty_l A (ty1 : rtype A) P `{!∀ x, SimpleSubsumePlace (x @ ty1) ty2 P} :
+    SimpleSubsumePlace ty1 ty2 P.
+  Proof.
+    iIntros (l β) "HP Hl". unfold ty_of_rty; simpl_type. iDestruct "Hl" as (x) "Hl".
+    iApply (@simple_subsume_place with "HP Hl").
+  Qed.
+  Global Instance simple_subsume_place_rty_to_ty_r A (ty1 ty2 : rtype A) x P `{!SimpleSubsumePlace (x @ ty1) (x @ ty2) P} :
+    SimpleSubsumePlace (x @ ty1) ty2 P.
+  Proof. iIntros (l β) "HP Hl". iExists (x). iApply (@simple_subsume_place with "HP Hl"). Qed.
+
+  Lemma simple_subsume_place_to_subsume A l β ty1 ty2 P
+    `{!∀ x, SimpleSubsumePlace ty1 (ty2 x) (P x)} T:
+    (∃ x, P x ∗ T x) ⊢ subsume (l ◁ₗ{β} ty1) (λ x : A, l ◁ₗ{β} ty2 x) T.
+  Proof. iIntros "[% [HP ?]] Hl". iExists _. iFrame. iApply (@simple_subsume_place with "HP Hl"). Qed.
+  Definition simple_subsume_place_to_subsume_inst := [instance simple_subsume_place_to_subsume].
+  Global Existing Instance simple_subsume_place_to_subsume_inst.
+
+  Lemma simple_subsume_val_to_subsume A v ty1 ty2 P `{!∀ x, SimpleSubsumeVal ty1 (ty2 x) (P x)} T:
+    (∃ x, P x ∗ T x) ⊢ subsume (v ◁ᵥ ty1) (λ x : A, v ◁ᵥ ty2 x) T.
+  Proof. iIntros "[% [HP ?]] Hv". iExists _. iFrame. iApply (@simple_subsume_val with "HP Hv"). Qed.
+  Definition simple_subsume_val_to_subsume_inst := [instance simple_subsume_val_to_subsume].
+  Global Existing Instance simple_subsume_val_to_subsume_inst.
+
+  Lemma subsume_place_own_ex A ty1 ty2 l β1 β2 T:
+    subsume (l ◁ₗ{β1} ty1) (λ x : A, l ◁ₗ{β2 x} ty2 x) T :-
+      inhale (l ◁ₗ{β1} ty1); ∃ x, exhale (<affine> ⌜β2 x = β1⌝); exhale (l ◁ₗ{β2 x} ty2 x); return T x.
+  Proof. iIntros "HT Hl". iDestruct ("HT" with "Hl") as "[% [<- [??]]]". iExists _. iFrame. Qed.
+  (* This lemma is applied via Hint Extern instead of declared as an instance with a `{!∀ x,
+  IsEx (β x)} precondition for better performance. *)
+  Definition subsume_place_own_ex_inst := [instance subsume_place_own_ex].
+
+  Lemma subsume_place_ty_ex A ty1 ty2 l β T:
+    subsume (l ◁ₗ{β} ty1) (λ x : A, l ◁ₗ{β} ty2 x) T :-
+      ∃ x, exhale (<affine> ⌜ty2 x = ty1⌝); return T x.
+  Proof. iIntros "[% [<- ?]] ?". iExists _. iFrame. Qed.
+  (* This lemma is applied via Hint Extern instead of declared as an instance with a `{!∀ x,
+  IsEx (ty2 x)} precondition for better performance. *)
+  Definition subsume_place_ty_ex_inst := [instance subsume_place_ty_ex].
+
+  Lemma subtype_var {A B} (ty : A → type) x y l β T:
+    (∃ z, <affine> ⌜x = y z⌝ ∗ T z)
+    ⊢ subsume (l ◁ₗ{β} ty x) (λ z : B, l ◁ₗ{β} ty (y z)) T.
+  Proof. iIntros "[% [-> ?]] ?". iExists _. iFrame. Qed.
+  (* This must be an Hint Extern because an instance would be a big slowdown. *)
+  Definition subtype_var_inst := [instance @subtype_var].
+
+  Lemma typed_binop_simplify v1 P1 v2 P2 o1 o2 ot1 ot2 {SH1 : SimplifyHyp P1 o1} {SH2 : SimplifyHyp P2 o2} `{!TCOneIsSome o1 o2} op T:
+    let G1 := (SH1 (find_in_context (FindValP v1) (λ P, typed_bin_op v1 P v2 P2 op ot1 ot2 T))).(i2p_P) in
+    let G2 := (SH2 (find_in_context (FindValP v2) (λ P, typed_bin_op v1 P1 v2 P op ot1 ot2 T))).(i2p_P) in
+    let G :=
+       match o1, o2 with
+     | Some n1, Some n2 => if (n2 ?= n1)%N is Lt then G2 else G1
+     | Some n1, _ => G1
+     | _, _ => G2
+       end in
+    G
+    ⊢ typed_bin_op v1 P1 v2 P2 op ot1 ot2 T.
+  Proof.
+    iIntros "/= Hs Hv1 Hv2".
+    destruct o1 as [n1|], o2 as [n2|] => //. 1: case_match.
+    1,3,4: iDestruct (i2p_proof with "Hs Hv1") as (P) "[Hv Hsub]".
+    4,5,6: iDestruct (i2p_proof with "Hs Hv2") as (P) "[Hv Hsub]".
+    all: by simpl in *; iApply ("Hsub" with "[$]").
+  Qed.
+  Definition typed_binop_simplify_inst := [instance typed_binop_simplify].
+  Global Existing Instance typed_binop_simplify_inst | 1000.
+
+(*  Lemma typed_binop_comma v1 v2 P (ty : type) ot1 ot2 T:
+    (P -∗ T v2 ty)
+    ⊢ typed_bin_op v1 P v2 (v2 ◁ᵥ ty) Comma ot1 ot2 T.
+  Proof.
+    iIntros "HT H1 H2" (Φ) "HΦ". iApply (wp_binop_det_pure v2).
+    { split; [ by inversion 1 | move => ->; constructor ]. }
+    iDestruct ("HT" with "H1") as "HT". iApply ("HΦ" $! v2 ty with "H2 HT").
+  Qed.
+  Definition typed_binop_comma_inst := [instance typed_binop_comma].
+  Global Existing Instance typed_binop_comma_inst. *)
+
+  Lemma typed_unop_simplify v P n ot {SH : SimplifyHyp P (Some n)} op T:
+    (SH (find_in_context (FindValP v) (λ P, typed_un_op v P op ot T))).(i2p_P)
+    ⊢ typed_un_op v P op ot T.
+  Proof.
+    iIntros "Hs Hv". iDestruct (i2p_proof with "Hs Hv") as (P') "[Hv Hsub]". simpl in *. by iApply ("Hsub" with "[$]").
+  Qed.
+  Definition typed_unop_simplify_inst := [instance typed_unop_simplify].
+  Global Existing Instance typed_unop_simplify_inst | 1000.
+
+(*  Lemma typed_copy_alloc_id_simplify v1 P1 v2 P2 o1 o2 ot {SH1 : SimplifyHyp P1 o1} {SH2 : SimplifyHyp P2 o2} `{!TCOneIsSome o1 o2} T:
+    let G1 := (SH1 (find_in_context (FindValP v1) (λ P, typed_copy_alloc_id v1 P v2 P2 ot T))).(i2p_P) in
+    let G2 := (SH2 (find_in_context (FindValP v2) (λ P, typed_copy_alloc_id v1 P1 v2 P ot T))).(i2p_P) in
+    let G :=
+       match o1, o2 with
+     | Some n1, Some n2 => if (n2 ?= n1)%N is Lt then G2 else G1
+     | Some n1, _ => G1
+     | _, _ => G2
+       end in
+    G
+    ⊢ typed_copy_alloc_id v1 P1 v2 P2 ot T.
+  Proof.
+    iIntros "/= Hs Hv1 Hv2".
+    destruct o1 as [n1|], o2 as [n2|] => //. 1: case_match.
+    1,3,4: iDestruct (i2p_proof with "Hs Hv1") as (P) "[Hv Hsub]".
+    4,5,6: iDestruct (i2p_proof with "Hs Hv2") as (P) "[Hv Hsub]".
+    all: by simpl in *; iApply ("Hsub" with "[$]").
+  Qed.
+  Definition typed_copy_alloc_id_simplify_inst := [instance typed_copy_alloc_id_simplify].
+  Global Existing Instance typed_copy_alloc_id_simplify_inst | 1000.
+
+  Lemma typed_cas_simplify v1 P1 v2 P2 v3 P3 ot o1 o2 o3 {SH1 : SimplifyHyp P1 o1} {SH2 : SimplifyHyp P2 o2} {SH3 : SimplifyHyp P3 o3} `{!TCOneIsSome3 o1 o2 o3} T:
+    let G1 := (SH1 (find_in_context (FindValP v1) (λ P, typed_cas ot v1 P v2 P2 v3 P3 T))).(i2p_P) in
+    let G2 := (SH2 (find_in_context (FindValP v2) (λ P, typed_cas ot v1 P1 v2 P v3 P3 T))).(i2p_P) in
+    let G3 := (SH3 (find_in_context (FindValP v3) (λ P, typed_cas ot v1 P1 v2 P2 v3 P T))).(i2p_P) in
+    let min o1 o2 :=
+       match o1.1, o2.1 with
+     | Some n1, Some n2 => if (n2 ?= n1)%N is Lt then o2 else o1
+     | Some n1, _ => o1
+     | _, _ => o2
+       end in
+    let G := (min (o1, G1) (min (o2, G2) (o3, G3))).2 in
+    G
+    ⊢ typed_cas ot v1 P1 v2 P2 v3 P3 T.
+  Proof.
+    iIntros "/= Hs Hv1 Hv2 Hv3".
+    destruct o1 as [n1|], o2 as [n2|], o3 as [n3|] => //=; repeat case_match => /=.
+    all: try iDestruct (i2p_proof with "Hs Hv1") as (P) "[Hv Hsub]".
+    all: try iDestruct (i2p_proof with "Hs Hv2") as (P) "[Hv Hsub]".
+    all: try iDestruct (i2p_proof with "Hs Hv3") as (P) "[Hv Hsub]".
+    all: by simpl in *; iApply ("Hsub" with "[$] [$]").
+  Qed.
+  Definition typed_cas_simplify_inst := [instance typed_cas_simplify].
+  Global Existing Instance typed_cas_simplify_inst | 1000.*)
+
+  Lemma typed_annot_stmt_simplify A (a : A) l P n {SH : SimplifyHyp P (Some n)} T:
+    (SH (find_in_context (FindLoc l) (λ '(β1, ty1),
+       typed_annot_stmt a l (l ◁ₗ{β1} ty1) T))).(i2p_P)
+    ⊢ typed_annot_stmt a l P T.
+  Proof.
+    iIntros "Hs Hv". iDestruct (i2p_proof with "Hs Hv") as ([β1 ty1]) "[Hl Hannot]" => /=.
+      by iApply ("Hannot" with "[$]").
+  Qed.
+  Definition typed_annot_stmt_simplify_inst := [instance typed_annot_stmt_simplify].
+  Global Existing Instance typed_annot_stmt_simplify_inst | 1000.
+
+  Lemma typed_annot_expr_simplify A m (a : A) v P n {SH : SimplifyHyp P (Some n)} T:
+    (SH (find_in_context (FindValP v) (λ Q,
+       typed_annot_expr m a v Q T))).(i2p_P)
+    ⊢ typed_annot_expr m a v P T.
+  Proof.
+    iIntros "Hs Hv". iDestruct (i2p_proof with "Hs Hv") as ([β1 ty1]) "[Hl Hannot]" => /=.
+      by iApply ("Hannot" with "[$]").
+  Qed.
+  Definition typed_annot_expr_simplify_inst := [instance typed_annot_expr_simplify].
+  Global Existing Instance typed_annot_expr_simplify_inst | 1000.
+
+  Lemma typed_if_simplify ot v (P : iProp Σ) n {SH : SimplifyHyp P (Some n)} T1 T2:
+    (SH (find_in_context (FindValP v) (λ Q,
+       typed_if ot v Q T1 T2))).(i2p_P)
+    ⊢ typed_if ot v P T1 T2.
+  Proof.
+    iIntros "Hs Hv". iDestruct (i2p_proof with "Hs Hv") as (Q) "[HQ HT]" => /=. simpl in *.
+    iApply ("HT" with "HQ").
+  Qed.
+  Definition typed_if_simplify_inst := [instance typed_if_simplify].
+  Global Existing Instance typed_if_simplify_inst | 1000.
+
+(*  Lemma typed_assert_simplify ot v P n {SH : SimplifyHyp P (Some n)} s fn ls R Q:
+    (SH (find_in_context (FindValP v) (λ P',
+       typed_assert ot v P' s fn ls R Q))).(i2p_P)
+    ⊢ typed_assert ot v P s fn ls R Q.
+  Proof.
+    iIntros "Hs Hv". iDestruct (i2p_proof with "Hs Hv") as (P') "[HP' HT]" => /=. simpl in *.
+    iApply ("HT" with "HP'").
+  Qed.
+  Definition typed_assert_simplify_inst := [instance typed_assert_simplify].
+  Global Existing Instance typed_assert_simplify_inst | 1000. *)
+
+  (*** statements *)
+
+  Global Instance elim_modal_bupd_typed_stmt p Espec ge s f R P :
+    ElimModal True%type p false (|==> P) P (typed_stmt Espec ge s f R) (typed_stmt Espec ge s f R).
+  Proof.
+    rewrite /ElimModal bi.intuitionistically_if_elim (bupd_fupd ⊤) fupd_frame_r bi.wand_elim_r.
+    iIntros "_ Hs". iMod "Hs". by iApply "Hs".
+  Qed.
+
+  Global Instance elim_modal_fupd_typed_stmt p Espec ge s f R P :
+    ElimModal True%type p false (|={⊤}=> P) P (typed_stmt Espec ge s f R) (typed_stmt Espec ge s f R).
+  Proof.
+    rewrite /ElimModal bi.intuitionistically_if_elim fupd_frame_r bi.wand_elim_r.
+    iIntros "_ Hs". iMod "Hs". by iApply "Hs".
+  Qed.
+
+(*  Lemma type_goto Q b fn ls R s:
+    Q !! b = Some s →
+    typed_stmt s fn ls R Q
+    ⊢ typed_stmt (Sgoto b) fn ls R Q.
+  Proof.
+    iIntros (HQ) "Hs". iIntros (Hls). iApply wps_goto => //.
+    iModIntro. by iApply "Hs".
+  Qed.
+
+  Lemma type_goto_precond P Q b fn ls R:
+    (typed_block P b fn ls R Q ∗ P ∗ True)
+    ⊢ typed_stmt (Goto b) fn ls R Q.
+  Proof.
+    iIntros "[Hblock [HP _]]" (Hls).
+    by iApply "Hblock".
+  Qed.
+
+*)
+
+  (* Ke: possible way to handle cast: dispatch type checking rules to 
+     type_Ecast, and only cover cases where it doesn't need memory.
+     similar to lithium.theories.typing.int, have one rule for each 
+     concrete (t1, t2) in (Ecast t1 t2) *)
+  Lemma type_assign Espec ge f e1 e2 (T: option val -> type -> assert):
+    typed_val_expr (Ecast e2 (typeof e1)) (λ v ty,
+      <affine> ⌜v `has_layout_val` typeof e1⌝ ∗
+       typed_write false e1 (typeof e1) v ty (T None tytrue))
+    ⊢ typed_stmt Espec ge (Sassign e1 e2) f T.
+  Proof.
+    unfold typed_stmt.
+    rewrite -wp_store.
+    iIntros "H". iApply "H".
+    iIntros (v ty) "H [% ty_write]".
+    iSplit; [done|].
+    iApply wp_lvalue_mono.
+    { intros; apply derives_refl. }
+    iApply "ty_write".
+    iIntros ((b, o)) "upd".
+    iMod ("upd" with "H") as "(%Hot & Hl & upd)"; iModIntro.
+    iExists Tsh.
+    iSplit; [auto|].
+    iSplitR "upd".
+    - rewrite /mapsto_layout /mapsto.
+      iDestruct "Hl" as (???) "Hl".
+      rewrite mapsto_mapsto_ //.
+    - iIntros "!> l↦".
+      iMod ("upd" with "[l↦]"); done.
+  Qed.
+
+  Lemma type_set Espec ge f (id:ident) e (T: option val -> type -> assert):
+    typed_val_expr e (λ v ty, <affine> ⌜v ≠ Vundef⌝ ∗ <obj> (<affine> (local $ locald_denote $ temp id v) -∗ ⎡v ◁ᵥ ty⎤ -∗ T None tytrue))%I
+      ⊢ typed_stmt Espec ge (Sset id e) f T.
+  Proof.
+    iIntros "He".
+    iApply wp_set.
+    iApply "He".
+    iIntros (??) "? [% ?]".
+    rewrite /typed_stmt_post_cond /RA_normal.
+    iStopProof; split => rho; monPred.unseal.
+    rewrite /local /lift1 /subst.
+    iIntros "(? & HT)".
+    unfold_lift.
+    iApply "HT"; try done.
+    rewrite monPred_at_affinely.
+    iPureIntro.
+    split; auto.
+    symmetry; apply eval_id_same.
+  Qed.
+
+  Lemma type_return_some Espec ge f e (T : option val → type -> assert):
+   typed_val_expr e (λ v, T (Some v))
+   ⊢ typed_stmt Espec ge (Sreturn $ Some e) f T.
+  Proof.
+    unfold typed_stmt.
+    iIntros "H".
+    iApply wp_return_Some. iApply "H".
+    iIntros; iFrame.
+  Qed.
+
+  Lemma type_return_none Espec ge f (T : option val → type -> assert) ty:
+    ⎡Vundef ◁ᵥ ty⎤ ∗ T (Some Vundef) ty
+    ⊢ typed_stmt Espec ge (Sreturn $ None) f T.
+  Proof.
+    unfold typed_stmt.
+    iIntros "H".
+    iApply wp_return_None. iExists ty; iFrame.
+  Qed.
+
+  Lemma type_if Espec ge f e s1 s2 R:
+    typed_val_expr e (λ v ty, typed_if (typeof e) v ⎡v ◁ᵥ ty⎤
+          (typed_stmt Espec ge s1 f R) (typed_stmt Espec ge s2 f R))
+    ⊢ typed_stmt Espec ge (Sifthenelse e s1 s2) f R.
+  Proof.
+    iIntros "He".
+    iApply wp_if.
+    iApply "He". iIntros (v ty) "Hv Hs".
+    iDestruct ("Hs" with "Hv") as "Hs". destruct (typeof e) eqn: Ht; iDestruct "Hs" as (b Hv) "Hs"; try done.
+    - destruct v; try done.
+      iSplit; first done; iFrame.
+      simpl in *.
+      destruct (Int.eq i0 Int.zero) eqn: Heq.
+      + apply Int.same_if_eq in Heq as ->.
+        destruct s; inv Hv; done.
+      + case_bool_decide; try done.
+        subst; destruct s; inv Hv.
+        * apply (val_lemmas.signed_inj _ Int.zero) in H0 as ->.
+          rewrite Int.eq_true // in Heq.
+        * apply (client_lemmas.unsigned_eq_eq _ Int.zero) in H0 as ->.
+          rewrite Int.eq_true // in Heq.
+    - destruct v; try done.
+      iSplit; first done; iFrame.
+      simpl in *.
+      destruct (Int64.eq i Int64.zero) eqn: Heq.
+      + apply Int64.same_if_eq in Heq as ->.
+        destruct s; inv Hv; done.
+      + case_bool_decide; try done.
+        subst; destruct s; inv Hv.
+        * apply (signed_inj_64 _ Int64.zero) in H0 as ->.
+          rewrite Int64.eq_true // in Heq.
+        * apply (unsigned_inj_64 _ Int64.zero) in H0 as ->.
+          rewrite Int64.eq_true // in Heq.
+    - rewrite /sem_cast /= in Hv.
+      destruct f0, v; try done; inv Hv; (iSplit; first done); iExists _; (iSplit; first done); simpl;
+        [destruct Float32.cmp | destruct Float.cmp]; done.
+    - rewrite /sem_cast /sem_cast_l2bool /sem_cast_i2bool /= in Hv; rewrite /bool_val /bool_val_p /=.
+      revert Hv; simple_if_tac; first done; destruct Archi.ptr64 eqn: ?; try done; intros.
+      destruct v; inv Hv; simpl; (iSplit; [try done | iExists _; iSplit; try done]).
+      + destruct (Int64.eq _ _); done.
+      + (* only valid pointers can be cast to true; should change typed_if *) admit.
+    - rewrite /sem_cast /sem_cast_l2bool /sem_cast_i2bool /= in Hv; rewrite /bool_val /bool_val_p /=.
+  Admitted.
+
+(*  Lemma type_switch Q it e m ss def fn ls R:
+    typed_val_expr e (λ v ty, typed_switch v ty it m ss def fn ls R Q)
+    ⊢ typed_stmt (Switch it e m ss def) fn ls R Q.
+  Proof.
+    iIntros "He" (Hls).
+    have -> : (Switch it e m ss def) = (W.to_stmt (W.Switch it (W.Expr e) m (W.Stmt <$> ss) (W.Stmt def)))
+      by rewrite /W.to_stmt/= -!list_fmap_compose list_fmap_id.
+    iApply tac_wps_bind; first done.
+    rewrite /W.to_expr /W.to_stmt /= -list_fmap_compose list_fmap_id.
+
+    iApply "He". iIntros (v ty) "Hv Hs".
+    iDestruct ("Hs" with "Hv") as (z Hn) "Hs".
+    iAssert (⌜∀ i : nat, m !! z = Some i → is_Some (ss !! i)⌝%I) as %?. {
+      iIntros (i ->). iDestruct "Hs" as (s ->) "_"; by eauto.
+    }
+    iApply wps_switch; [done|done|..].
+    destruct (m !! z) => /=.
+    - iDestruct "Hs" as (s ->) "Hs". by iApply "Hs".
+    - by iApply "Hs".
+  Qed.
+
+  Lemma type_assert Q ot e s fn ls R:
+    typed_val_expr e (λ v ty, typed_assert ot v (v ◁ᵥ ty) s fn ls R Q)
+    ⊢ typed_stmt (assert{ot}: e; s) fn ls R Q.
+  Proof.
+    iIntros "He" (Hls). wps_bind.
+    iApply "He". iIntros (v ty) "Hv Hs".
+    iDestruct ("Hs" with "Hv") as "Hs".
+    destruct ot => //.
+    - iDestruct "Hs" as (???) "Hs".
+      iApply wps_assert_bool; [done|done|..]. by iApply "Hs".
+    - iDestruct "Hs" as (???) "Hs".
+      iApply wps_assert_int; [done|done|..]. by iApply "Hs".
+    - iDestruct "Hs" as (???) "[Hpre Hs]".
+      iApply (wps_assert_ptr with "Hpre"); [done..|]. by iApply "Hs".
+  Qed.
+
+  Lemma type_exprs s e fn ls R Q:
+    (typed_val_expr e (λ v ty, v ◁ᵥ ty -∗ typed_stmt s fn ls R Q))
+    ⊢ typed_stmt (ExprS e s) fn ls R Q.
+  Proof.
+    iIntros "Hs ?". wps_bind. iApply "Hs". iIntros (v ty) "Hv Hs".
+    iApply wps_exprs. iApply step_fupd_intro => //. iModIntro.
+    by iApply ("Hs" with "Hv").
+  Qed.
+
+  Lemma type_skips Espec Delta s R:
+    (|={⊤}[∅]▷=> typed_stmt Espec Delta s R) ⊢ typed_stmt (Sskip s) fn ls R Q.
+  Proof.
+    iIntros "Hs ?". iApply wps_skip. iApply (step_fupd_wand with "Hs"). iIntros "Hs". by iApply "Hs".
+  Qed.
+
+  Lemma type_skips' s fn ls Q R:
+    typed_stmt s fn ls R Q ⊢ typed_stmt (SkipS s) fn ls R Q.
+  Proof. iIntros "Hs". iApply type_skips. by iApply step_fupd_intro. Qed.
+
+  Lemma type_annot_stmt {A} p (a : A) s fn ls Q R:
+    (typed_addr_of p (λ l β ty, typed_annot_stmt a l (l ◁ₗ{β} ty) (typed_stmt s fn ls R Q)))
+    ⊢ typed_stmt (annot: a; expr: &p; s) fn ls R Q.
+  Proof.
+    iIntros "Hs ?". iApply wps_annot => /=.
+    wps_bind. rewrite /AddrOf. iApply "Hs".
+    iIntros (l β ty) "Hl Ha". iApply wps_exprs.
+      by iApply ("Ha" with "Hl").
+  Qed.
+
+  Lemma type_annot_stmt_assert {A} P id s fn ls R Q:
+    (∃ a : A, P a ∗ (P a -∗ (typed_stmt s fn ls R Q)))
+    ⊢ typed_stmt (annot: (AssertAnnot id); s) fn ls R Q.
+  Proof. iIntros "[%a [HP Hcont]] ?". iApply wps_annot => /=. by iApply ("Hcont" with "HP"). Qed.
+
+  Lemma typed_block_rec Ps Q fn ls R s:
+    ([∗ map] b ↦ P ∈ Ps, ∃ s, ⌜Q !! b = Some s⌝ ∗ □(([∗ map] b ↦ P ∈ Ps, typed_block P b fn ls R Q) -∗ P -∗ typed_stmt s fn ls R Q)) -∗
+    (([∗ map] b ↦ P ∈ Ps, typed_block P b fn ls R Q) -∗ typed_stmt s fn ls R Q) -∗
+    typed_stmt s fn ls R Q.
+  Proof.
+    iIntros "HQ Hs" (Hls).
+    iApply ("Hs" with "[HQ]"); last done.
+    iApply wps_block_rec.
+    iApply (big_sepM_mono with "HQ").
+    move => b P Hb /=.
+    repeat f_equiv. iIntros "Hs". by iApply "Hs".
+  Qed.*)
+
+  (*** expressions *)
+  Lemma type_val_context v T:
+    (find_in_context (FindVal v) T)
+    ⊢ typed_value v T.
+  Proof.
+    iDestruct 1 as (ty) "[Hv HT]". simpl in *.
+    iExists _. iFrame.
+  Qed.
+  Definition type_val_context_inst := [instance type_val_context].
+  Global Existing Instance type_val_context_inst | 100.
+
+  Lemma type_const_int i t T:
+    typed_value (Vint i) (T (Vint i))
+    ⊢ typed_val_expr (Econst_int i t) T.
+  Proof.
+    iIntros "HP" (Φ) "HΦ".
+    iDestruct "HP" as (ty) "[Hv HT]".
+    by iApply wp_const_int; iApply ("HΦ" with "[$]").
+  Qed.
+
+  Lemma type_const_long i t T:
+    typed_value (Vlong i) (T (Vlong i))
+    ⊢ typed_val_expr (Econst_long i t) T.
+  Proof.
+    iIntros "HP" (Φ) "HΦ".
+    iDestruct "HP" as (ty) "[Hv HT]".
+    by iApply wp_const_long; iApply ("HΦ" with "[$]").
+  Qed.
+
+  Lemma type_const_float i t T:
+    typed_value (Vfloat i) (T (Vfloat i))
+    ⊢ typed_val_expr (Econst_float i t) T.
+  Proof.
+    iIntros "HP" (Φ) "HΦ".
+    iDestruct "HP" as (ty) "[Hv HT]".
+    by iApply wp_const_float; iApply ("HΦ" with "[$]").
+  Qed.
+
+  Lemma type_const_single i t T:
+    typed_value (Vsingle i) (T (Vsingle i))
+    ⊢ typed_val_expr (Econst_single i t) T.
+  Proof.
+    iIntros "HP" (Φ) "HΦ".
+    iDestruct "HP" as (ty) "[Hv HT]".
+    by iApply wp_const_single; iApply ("HΦ" with "[$]").
+  Qed.
+
+  Lemma type_bin_op o e1 e2 ot T:
+    typed_val_expr e1 (λ v1 ty1, typed_val_expr e2 (λ v2 ty2, typed_bin_op v1 ⎡v1 ◁ᵥ ty1⎤ v2 ⎡v2 ◁ᵥ ty2⎤ o (typeof e1) (typeof e2) T))
+    ⊢ typed_val_expr (Ebinop o e1 e2 ot) T.
+  Proof.
+    iIntros "He1" (Φ) "HΦ".
+    iApply wp_binop_rule. iApply "He1". iIntros (v1 ty1) "Hv1 He2".
+    iApply "He2". iIntros (v2 ty2) "Hv2 Hop".
+    by iApply ("Hop" with "Hv1 Hv2").
+  Qed.
+
+  Lemma type_un_op o e ot T:
+    typed_val_expr e (λ v ty, typed_un_op v ⎡v ◁ᵥ ty⎤ o (typeof e) T)
+    ⊢ typed_val_expr (Eunop o e ot) T.
+  Proof.
+    iIntros "He" (Φ) "HΦ".
+    iApply wp_unop_rule. iApply "He". iIntros (v ty) "Hv Hop".
+    rewrite /typed_un_op /typed_val_unop.
+    by iApply ("Hop" with "Hv").
+  Qed.
+
+  Lemma type_tempvar _x v c_ty T ty:
+    <affine> (local $ locald_denote $ temp _x v) ∗ ⎡ v ◁ᵥ ty ⎤ ∗ T v ty
+    ⊢ typed_val_expr (Etempvar _x c_ty) T.
+  Proof.
+    iIntros "(? & ? & ?)" (Φ) "HΦ".
+    iApply wp_tempvar_local. iFrame.
+    by iApply ("HΦ" with "[$]").
+  Qed.
+
+  Lemma exploit_local (P:environ->Prop) (Q:Prop):
+    (forall rho, P rho->Q) ->
+    (⊢ local P) ->
+    Q.
+  Proof.
+    intros H1 H2.
+    assert (local P ⊢ ⌜Q⌝).
+    { go_lowerx. intros. iPureIntro. intros. apply (H1 _ H). }
+    rewrite H in H2.
+    eapply  ouPred.pure_soundness. 
+    destruct H2 as [H2].
+    pose proof environ_inhabited. inversion X as [x].
+    specialize (H2 x).
+    rewrite monPred_at_pure monPred_at_emp in H2.
+    done.
+  Qed.
+
+  Lemma tac_exploit_local (P:environ->Prop) (Q:Prop):
+    (forall rho, P rho->Q) ->
+    local P -∗ <absorb> ⌜Q⌝.
+  Proof.
+    intro H.
+    go_lowerx. iIntros "_" (??) "H".
+    rewrite monPred_at_absorbingly.
+    simpl.
+    iDestruct "H" as "%".
+    iPureIntro. eapply H. done.  
+  Qed.
+
+
+  Lemma type_var_local _x (lv:val) β ty c_ty (T: address -> own_state -> type -> assert) :
+    <affine> (local $ locald_denote $ lvar _x c_ty lv) ∗
+    (∃ l, <affine> ⌜Some l = val2address lv⌝ ∗
+    ⎡ l ◁ₗ{β} ty ⎤ ∗
+    T l β ty)
+    ⊢ typed_lvalue β (Evar _x c_ty) T.
+  Proof.
+    iIntros "(Hlvar & (%l & %Hl & Hl_own & HT))" (Φ) "HΦ".
+    iApply (wp_var_local _ _ _).
+    (* iPoseProof (tac_exploit_local with "Hlvar") as "%H";[apply lvar_isptr|]. *)
+    iFrame.
+    destruct lv eqn:Heql; try done.
+    iExists _.
+    iSplit;[done|].
+    iApply ("HΦ" with "[$]"). done.
+  Qed.
+
+(*  Lemma type_call_syn T ef es:
+    typed_val_expr (Call ef es) T :-
+      vf, tyf ← {typed_val_expr ef};
+      vl, tys ← iterate: es with [], [] {{e T vl tys,
+                  v, ty ← {typed_val_expr e};
+                  return T (vl ++ [v]) (tys ++ [ty])}};
+      {typed_call vf (vf ◁ᵥ tyf) vl tys T}.
+  Proof.
+    iIntros "He". iIntros (Φ) "HΦ".
+    iApply wp_call_bind. iApply "He". iIntros (vf tyf) "Hvf HT".
+    iAssert ([∗ list] v;ty∈[];[], v ◁ᵥ ty)%I as "-#Htys". { done. }
+    move: {2 3 5}[] => vl. move: {2 3}(@nil type) => tys.
+    iInduction es as [|e es] "IH" forall (vl tys) => /=. 2: {
+      iApply "HT". iIntros (v ty) "Hv Hnext". iApply ("IH" with "HΦ Hvf Hnext"). by iFrame.
+    }
+    by iApply ("HT" with "Hvf Htys").
+  Qed.
+  Lemma type_call : [type_from_syntax type_call_syn].
+  Proof. exact type_call_syn. Qed.
+
+  Lemma type_copy_alloc_id e1 e2 ot T:
+    typed_val_expr e1 (λ v1 ty1, typed_val_expr e2 (λ v2 ty2, typed_copy_alloc_id v1 (v1 ◁ᵥ ty1) v2 (v2 ◁ᵥ ty2) ot T))
+    ⊢ typed_val_expr (CopyAllocId ot e1 e2) T.
+  Proof.
+    iIntros "He1" (Φ) "HΦ".
+    wp_bind. iApply "He1". iIntros (v1 ty1) "Hv1 He2".
+    wp_bind. iApply "He2". iIntros (v2 ty2) "Hv2 Hop".
+    by iApply ("Hop" with "Hv1 Hv2").
+  Qed.
+
+  Lemma type_cas ot e1 e2 e3 T:
+    typed_val_expr e1 (λ v1 ty1, typed_val_expr e2 (λ v2 ty2, typed_val_expr e3 (λ v3 ty3, typed_cas ot v1 (v1 ◁ᵥ ty1) v2 (v2 ◁ᵥ ty2) v3 (v3 ◁ᵥ ty3) T)))
+    ⊢ typed_val_expr (CAS ot e1 e2 e3) T.
+  Proof.
+    iIntros "He1" (Φ) "HΦ".
+    wp_bind. iApply "He1". iIntros (v1 ty1) "Hv1 He2".
+    wp_bind. iApply "He2". iIntros (v2 ty2) "Hv2 He3".
+    wp_bind. iApply "He3". iIntros (v3 ty3) "Hv3 Hop".
+    by iApply ("Hop" with "Hv1 Hv2 Hv3").
+  Qed.
+
+  Lemma type_ife ot e1 e2 e3 T:
+    typed_val_expr e1 (λ v ty, typed_if ot v (v ◁ᵥ ty) (typed_val_expr e2 T) (typed_val_expr e3 T))
+    ⊢ typed_val_expr (IfE ot e1 e2 e3) T.
+  Proof.
+    iIntros "He1" (Φ) "HΦ".
+    wp_bind. iApply "He1". iIntros (v1 ty1) "Hv1 Hif".
+    iDestruct ("Hif" with "Hv1") as "HT". destruct ot => //.
+    all: iDestruct "HT" as (zorl ?) "HT".
+    - iApply wp_if_bool; [done|..]. by destruct zorl; iApply "HT".
+    - iApply wp_if_int; [done|..]. by case_decide; iApply "HT".
+    - case_bool_decide; iDestruct "HT" as "[Hpre HT]".
+      + iApply (wp_if_ptr with "Hpre"); rewrite ?bool_decide_true //. by iApply "HT".
+      + iApply (wp_if_ptr with "Hpre"); rewrite ?bool_decide_false //; try eauto. by iApply "HT".
+  Qed.
+
+  Lemma type_logical_and ot1 ot2 e1 e2 T:
+    typed_val_expr e1 (λ v1 ty1, typed_if ot1 v1 (v1 ◁ᵥ ty1)
+       (typed_val_expr e2 (λ v2 ty2, typed_if ot2 v2 (v2 ◁ᵥ ty2)
+           (typed_value (i2v 1 i32) (T (i2v 1 i32))) (typed_value (i2v 0 i32) (T (i2v 0 i32)))))
+       (typed_value (i2v 0 i32) (T (i2v 0 i32))))
+    ⊢ typed_val_expr (e1 &&{ot1, ot2, i32} e2) T.
+  Proof.
+    iIntros "HT". rewrite /LogicalAnd. iApply type_ife.
+    iApply (typed_val_expr_wand with "HT"). iIntros (v ty) "HT".
+    iApply (typed_if_wand with "HT"). iSplit; iIntros "HT".
+    2: { by iApply type_val. }
+    iApply type_ife.
+    iApply (typed_val_expr_wand with "HT"). iIntros (v2 ty2) "HT".
+    iApply (typed_if_wand with "HT"). iSplit; iIntros "HT"; by iApply type_val.
+  Qed.
+
+  Lemma type_logical_or ot1 ot2 e1 e2 T:
+    typed_val_expr e1 (λ v1 ty1, typed_if ot1 v1 (v1 ◁ᵥ ty1)
+      (typed_value (i2v 1 i32) (T (i2v 1 i32)))
+      (typed_val_expr e2 (λ v2 ty2, typed_if ot2 v2 (v2 ◁ᵥ ty2)
+        (typed_value (i2v 1 i32) (T (i2v 1 i32))) (typed_value (i2v 0 i32) (T (i2v 0 i32))))))
+    ⊢ typed_val_expr (e1 ||{ot1, ot2, i32} e2) T.
+  Proof.
+    iIntros "HT". rewrite /LogicalOr. iApply type_ife.
+    iApply (typed_val_expr_wand with "HT"). iIntros (v ty) "HT".
+    iApply (typed_if_wand with "HT"). iSplit; iIntros "HT".
+    1: { by iApply type_val. }
+    iApply type_ife.
+    iApply (typed_val_expr_wand with "HT"). iIntros (v2 ty2) "HT".
+    iApply (typed_if_wand with "HT"). iSplit; iIntros "HT"; by iApply type_val.
+  Qed.
+
+  Lemma type_skipe e T:
+    typed_val_expr e (λ v ty, |={⊤}[∅]▷=> T v ty) ⊢ typed_val_expr (SkipE e) T.
+  Proof.
+    iIntros "He" (Φ) "HΦ".
+    wp_bind. iApply "He". iIntros (v ty) "Hv HT".
+    iApply (wp_step_fupd with "HT") => //.
+    iApply wp_skip. iIntros "!> HT !>".
+    by iApply ("HΦ" with "Hv HT").
+  Qed.
+
+  Lemma type_skipe' e T:
+    typed_val_expr e T ⊢ typed_val_expr (SkipE e) T.
+  Proof.
+    iIntros "He" (Φ) "HΦ".
+    wp_bind. iApply "He". iIntros (v ty) "Hv HT".
+    iApply wp_skip. by iApply ("HΦ" with "Hv HT").
+  Qed.
+
+  Lemma type_annot_expr n {A} (a : A) e T:
+    typed_val_expr e (λ v ty, typed_annot_expr n a v (v ◁ᵥ ty) (find_in_context (FindVal v) (λ ty, T v ty)))
+    ⊢ typed_val_expr (AnnotExpr n a e) T.
+  Proof.
+    iIntros "He" (Φ) "HΦ".
+    wp_bind. iApply "He". iIntros (v ty) "Hv HT". iDestruct ("HT" with "Hv") as "HT".
+    iInduction n as [|n] "IH" forall (Φ). {
+      rewrite /AnnotExpr/=.
+      iApply fupd_wp.
+      iMod "HT" as (?) "[HT ?] /=". iApply wp_value.
+      iApply ("HΦ" with "[$] [$]").
+    }
+    rewrite annot_expr_S_r. wp_bind.
+    iApply (wp_step_fupd with "HT") => //.
+    iApply wp_skip. iIntros "!> HT !>".
+    by iApply ("IH" with "HΦ HT").
+  Qed.
+
+  Lemma type_macro_expr m es T:
+    typed_macro_expr m es T
+    ⊢ typed_val_expr (MacroE m es) T.
+  Proof. done. Qed.
+
+  Lemma type_use ot T e o mc:
+    ⌜if o is Na2Ord then False else True⌝ ∗ typed_read (if o is ScOrd then true else false) e ot mc T
+    ⊢ typed_val_expr (use{ot, o, mc} e) T.
+  Proof.
+    iIntros "[% Hread]" (Φ) "HΦ".
+    wp_bind. iApply "Hread".
+    iIntros (l) "Hl". rewrite /Use.
+    destruct o => //.
+    1: iApply wp_atomic.
+    2: iApply fupd_wp; iApply wp_fupd.
+    all: iMod "Hl" as (v q ty Hly Hv) "(Hl&Hv&HT)"; iModIntro.
+    all: iApply (wp_deref with "Hl") => //; try by eauto using val_to_of_loc.
+    all: iIntros "!# %st Hl".
+    all: iMod ("HT" with "Hl Hv") as (ty') "[Hv HT]"; iModIntro.
+    all: by iApply ("HΦ" with "Hv HT").
+  Qed.
+
+  Lemma type_read T T' e ot (a : bool) mc:
+    IntoPlaceCtx e T' →
+    T' (λ K l, find_in_context (FindLoc l) (λ '(β1, ty1),
+      typed_place K l β1 ty1 (λ l2 β2 ty2 typ R,
+          typed_read_end a ⊤ l2 β2 ty2 ot mc (λ v ty2' ty3,
+            l ◁ₗ{β1} typ ty2' -∗ R ty2' -∗ T v ty3))))
+    ⊢ typed_read a e ot mc T.
+  Proof.
+    iIntros (HT') "HT'". iIntros (Φ) "HΦ".
+    iApply (HT' with "HT'").
+    iIntros (K l). iDestruct 1 as ([β ty]) "[Hl HP]".
+    iApply ("HP" with "Hl").
+    iIntros (l' β2 ty2 typ R) "Hl' Hc HT" => /=. iApply "HΦ".
+    rewrite /typed_read_end. iMod ("HT" with "Hl'") as (q v ty3 Hly Hv) "(Hl&Hv&HT)".
+    iModIntro. iExists _,_,_. iFrame "Hl Hv". iSplitR => //. iSplit => //.
+    iIntros "!# %st Hl Hv".
+    iMod ("HT" with "Hl Hv") as (ty' ty4) "(Hv&Hl&HT)".
+    iMod ("Hc" with "Hl") as "[? ?]". iExists _. iFrame. by iApply ("HT" with "[$]").
+  Qed.
+
+  Lemma type_read_copy a β l ty ly E mc {HC: CopyAs l β ty} T:
+    ((HC (λ ty', ⌜ty'.(ty_has_op_type) ly MCCopy⌝ ∗ ⌜mtE ⊆ E⌝ ∗ ∀ v, T v (ty' : type) ty')).(i2p_P))
+    ⊢ typed_read_end a E l β ty ly mc T.
+  Proof.
+    rewrite /typed_read_end. iIntros "Hs Hl". iDestruct (i2p_proof with "Hs Hl") as (ty') "(Hl&%&%&%&HT)".
+    destruct β.
+    - iApply fupd_mask_intro; [destruct a; solve_ndisj|]. iIntros "Hclose".
+      iDestruct (ty_aligned with "Hl") as %?; [done|].
+      iDestruct (ty_deref with "Hl") as (v) "[Hl #Hv]"; [done|].
+      iDestruct (ty_size_eq with "Hv") as %?; [done|].
+      iExists _, _, _. iFrame "∗Hv". do 2 iSplitR => //=.
+      iIntros "!# %st Hl _". iMod "Hclose". iModIntro.
+      iExists _, _. iDestruct (ty_ref with "[//] Hl Hv") as "$"; [done|]. iSplitR "HT" => //.
+      destruct mc => //.
+      by iApply (ty_memcast_compat_copy with "Hv").
+    - iRevert "Hl". iIntros "#Hl".
+      iMod (copy_shr_acc with "Hl") as (? q' v) "[Hmt [Hv Hc]]" => //.
+      iDestruct (ty_size_eq with "Hv") as "#>%"; [done|].
+      iApply fupd_mask_intro; [destruct a; solve_ndisj|]. iIntros "Hclose".
+      iExists _, _, _. iFrame. do 2 iSplit => //=.
+      iIntros "!# %st Hmt Hv". iMod "Hclose". iModIntro.
+      iExists _, _. iFrame "Hl". iSplitR "HT"; [|done].
+      destruct mc => //.
+      by iApply (ty_memcast_compat_copy with "Hv").
+  Qed.
+  Definition type_read_copy_inst := [instance type_read_copy].
+  Global Existing Instance type_read_copy_inst | 10.
+*)
+
+  (* for expr `e:=v` => eval_expr e = l ∧ typed l v  *)
+  (* typed_lvalue e (typed_write_end ...)   *)
+
+  (* Ke: a simple version of type_write that treat typed_place as just typed_val_expr. 
+         Not so sure about what's inside typed_val_expr outside of typed_write_end. *)
+  Lemma type_write_simple β1 (a : bool) ty T e v ot:
+    (typed_lvalue β1 e (λ l β2 ty1,
+      typed_write_end a ⊤ ot v ty l β2 ty1 (λ ty3:type, ⎡l ◁ₗ{β1} ty3⎤ -∗ T)))%I
+    ⊢ typed_write a e ot v ty T.
+  Proof.
+    iIntros "typed_e".
+    iIntros (Φ) "HΦ".
+    unfold typed_lvalue.
+    iApply "typed_e". iIntros (l ty1) "Hv typed_write_end".
+    iApply "HΦ".
+    iIntros "own_v".
+    unfold typed_write_end.
+    iMod ("typed_write_end" with "Hv own_v") as "($ & $ & H)". iModIntro. iModIntro.
+    iIntros "l↦". iMod ("H" with "l↦") as (ty3) "[own_l T]".
+    by iApply "T".
+  Qed.
+
+  Lemma type_write_own_copy a E ty l2 ty2 v ot (T:type->assert):
+    typed_write_end a E ot v ty l2 Own ty2 T where
+    `{!Copyable ty}
+    `{!TCDone (ty2.(ty_has_op_type) ot MCNone)} :-
+      exhale <affine> ⌜ty.(ty_has_op_type) ot MCNone⌝;
+      inhale ⎡v ◁ᵥ ty⎤;
+      ∀ v', inhale ⎡v' ◁ᵥ ty2⎤; (* FIXME this is probably not needed; can we not inhale this? *)
+      return T ty.
+  Proof.
+    unfold typed_write_end, TCDone => ??. iDestruct 1 as (?) "HT".
+    iIntros "Hl #Hv".
+    iDestruct (ty_aligned with "Hl") as %?; [done|].
+    iDestruct (ty_deref with "Hl") as (v') "[Hl Hv']"; [done|].
+    iDestruct (ty_size_eq with "Hv'") as %?; [done|].
+    iDestruct (ty_size_eq with "Hv") as %?; [done|].
+    iApply fupd_mask_intro; [destruct a; solve_ndisj|]. iIntros "Hmask".
+    iSplit; [done|]. iSplitL "Hl". { iExists _. by iFrame. }
+    iIntros "!# Hl". iMod "Hmask". iModIntro.
+    iExists _.
+     iDestruct ("HT" with "Hv") as "HT".
+     iDestruct ("HT" $! v' with "Hv'") as "$".
+     by iApply (ty_ref with "[] Hl Hv").
+  Qed.
+  Definition type_write_own_copy_inst := [instance type_write_own_copy].
+  Global Existing Instance type_write_own_copy_inst | 20.
+  (*
+
+  (* Note that there is also [type_write_own] in singleton.v which applies if one can prove MCId. *)
+  Lemma type_write_own_move a E ty l2 ty2 v ot T:
+    typed_write_end a E ot v ty l2 Own ty2 T where
+    `{!TCDone (ty2.(ty_has_op_type) (UntypedOp (ot_layout ot)) MCNone)} :-
+      exhale ⌜ty.(ty_has_op_type) (UntypedOp (ot_layout ot)) MCNone⌝;
+      ∀ v', inhale v' ◁ᵥ ty2; return T ty.
+  Proof.
+    unfold TCDone, typed_write_end => ?. iDestruct 1 as (?) "HT". iIntros "Hl Hv".
+    iDestruct (ty_aligned with "Hl") as %?; [done|].
+    iDestruct (ty_deref with "Hl") as (v') "[Hl Hv']"; [done|].
+    iDestruct (ty_size_eq with "Hv") as %?; [done|].
+    iDestruct (ty_size_eq with "Hv'") as %?; [done|].
+    iApply fupd_mask_intro; [destruct a; solve_ndisj|]. iIntros "Hmask".
+    iSplit; [done|]. iSplitL "Hl". { iExists _. by iFrame. }
+    iIntros "!# Hl". iMod "Hmask". iModIntro.
+    iDestruct (ty_ref with "[] Hl Hv") as "?"; [done..|].
+    iExists _. iFrame. by iApply "HT".
+  Qed.
+  Definition type_write_own_move_inst := [instance type_write_own_move].
+  Global Existing Instance type_write_own_move_inst | 70.
+
+  Lemma type_addr_of_place T T' e:
+    IntoPlaceCtx e T' →
+    T' (λ K l, find_in_context (FindLoc l) (λ '(β1, ty1),
+      typed_place K l β1 ty1 (λ l2 β2 ty2 typ R,
+                              typed_addr_of_end l2 β2 ty2 (λ β3 ty3 ty',
+                  l ◁ₗ{β1} typ ty' -∗ R ty' -∗ T l2 β3 ty3))))
+    ⊢ typed_addr_of e T.
+  Proof.
+    iIntros (HT') "HT'". iIntros (Φ) "HΦ".
+    iApply @wp_fupd. iApply (HT' with "HT'").
+    iIntros (K l). iDestruct 1 as ([β ty]) "[Hl HP]".
+    iApply ("HP" with "Hl"). iIntros (l2 β2 ty2 typ R) "Hl' Hc HT".
+    iMod ("HT" with "Hl'") as (β3 ty3 ty') "[Hty3 [Hty' HT]]".
+    iMod ("Hc" with "Hty'") as "[Hc ?]". iModIntro.
+    iApply ("HΦ" with "Hty3").
+    by iApply ("HT" with "[$]").
+  Qed.
+*)
+(*
+  Lemma type_place_id l ty β T:
+    T l β ty id (λ _, True)
+    ⊢ typed_place l β ty T.
+  Proof.
+    unfold typed_place.
+    iIntros  "HT Hl" (l2 β2 ty2 typ R) "Hl2". iApply ("HΦ" with "Hl [] HT").  by iIntros (ty') "$".
+  Qed.s
+  Definition type_place_id_inst := [instance type_place_id].
+  Global Existing Instance type_place_id_inst | 20.
+
+  Lemma copy_as_id l β ty `{!Copyable ty} T:
+    T ty ⊢ copy_as l β ty T.
+  Proof. iIntros "HT Hl". iExists _. by iFrame. Qed.
+  Definition copy_as_id_inst := [instance copy_as_id].
+  Global Existing Instance copy_as_id_inst | 1000.
+
+  Lemma copy_as_refinement A l β (ty : rtype A) {HC: ∀ x, CopyAs l β (x @ ty)} T:
+    (∀ x, (HC x T).(i2p_P)) ⊢ copy_as l β ty T.
+  Proof.
+    iIntros "HT Hl". unfold ty_of_rty; simpl_type. iDestruct "Hl" as (x) "Hl".
+    iSpecialize ("HT" $! x). iDestruct (i2p_proof with "HT") as "HT". by iApply "HT".
+  Qed.
+  Definition copy_as_refinement_inst := [instance copy_as_refinement].
+  Global Existing Instance copy_as_refinement_inst.
+
+  Lemma annot_share l ty T:
+    (l ◁ₗ{Shr} ty -∗ T)
+    ⊢ typed_annot_stmt (ShareAnnot) l (l ◁ₗ ty) T.
+  Proof.
+    iIntros "HT Hl". iMod (ty_share with "Hl") => //.
+    iApply step_fupd_intro => //. iModIntro. by iApply "HT".
+  Qed.
+  Definition annot_share_inst := [instance annot_share].
+  Global Existing Instance annot_share_inst.
+
+  Definition STOPPED : iProp Σ := False.
+  Lemma annot_stop l β ty T:
+    (l ◁ₗ{β} ty -∗ STOPPED)
+    ⊢ typed_annot_stmt (StopAnnot) l (l ◁ₗ{β} ty) T.
+  Proof. iIntros "HT Hl". iDestruct ("HT" with "Hl") as %[]. Qed.
+  Definition annot_stop_inst := [instance annot_stop].
+  Global Existing Instance annot_stop_inst.
+
+  Lemma annot_unfold_once l β ty n {SH : SimplifyHyp (l ◁ₗ{β} ty) (Some (Npos n))} T:
+    (SH T).(i2p_P)
+    ⊢ typed_annot_stmt UnfoldOnceAnnot l (l ◁ₗ{β} ty) T.
+  Proof.
+    iIntros "Hs Hv". iDestruct (i2p_proof with "Hs Hv") as "HT" => /=.
+    by iApply step_fupd_intro.
+  Qed.
+  Definition annot_unfold_once_inst := [instance annot_unfold_once].
+  Global Existing Instance annot_unfold_once_inst.
+
+  Lemma annot_learn l β ty {L : Learnable (l ◁ₗ{β} ty)} T:
+    (learnable_data L ∗ l ◁ₗ{β} ty -∗ T)
+    ⊢ typed_annot_stmt (LearnAnnot) l (l ◁ₗ{β} ty) T.
+  Proof.
+    iIntros "HT Hl". iApply step_fupd_intro => //.
+    iDestruct (learnable_learn with "Hl") as "#H".
+    iApply "HT". by iFrame.
+  Qed.
+  Definition annot_learn_inst := [instance annot_learn].
+  Global Existing Instance annot_learn_inst.
+
+(*  Lemma annot_learn_aligment l β ty n `{!LearnAlignment β ty (Some n)} T:
+    (⌜l `aligned_to` n⌝ -∗ l ◁ₗ{β} ty -∗ T)
+    ⊢ typed_annot_stmt (LearnAlignmentAnnot) l (l ◁ₗ{β} ty) T.
+  Proof.
+    iIntros "HT Hl". iApply step_fupd_intro => //. iModIntro.
+    iDestruct (learnalign_learn with "Hl") as %?.
+    by iApply "HT".
+  Qed.
+  Definition annot_learn_aligment_inst := [instance annot_learn_aligment].
+  Global Existing Instance annot_learn_aligment_inst.*)
+End typing.
+
+(* This must be an Hint Extern because an instance would be a big slowdown . *)
+Global Hint Extern 50 (Subsume (_ ◁ₗ{_} ?ty _) (λ _, _ ◁ₗ{_} ?ty2 _)%I) =>
+  match ty with | ty2 => is_var ty; class_apply subtype_var_inst end : typeclass_instances.
+
+Global Hint Extern 5 (Subsume (_ ◁ₗ{_} _) (λ _, _ ◁ₗ{_.1ₗ} _)%I) =>
+  (class_apply subsume_place_own_ex_inst) : typeclass_instances.
+
+Global Hint Extern 5 (Subsume (_ ◁ₗ{_} _) (λ _, _ ◁ₗ{_} _.1ₗ)%I) =>
+  (class_apply subsume_place_ty_ex_inst) : typeclass_instances.
+
+
+(*Global Typeclasses Opaque typed_block.
+*)
+*)
+
+  Lemma type_seq Espec ge f s1 s2 T:
+    typed_stmt Espec ge s1 f (λ v ty, match v with None => typed_stmt Espec ge s2 f T
+                                       | _ => T v ty end)
+    ⊢ typed_stmt Espec ge (Ssequence s1 s2) f T.
+  Proof.
+    iIntros "H". unfold typed_stmt.
+    rewrite -wp_seq /=.
+    iApply (wp_conseq with "H"); auto.
+  Qed.
+
+End typing.
diff --git a/refinedVST/typing/singleton.v b/refinedVST/typing/singleton.v
new file mode 100644
index 0000000000..f2871ce2b0
--- /dev/null
+++ b/refinedVST/typing/singleton.v
@@ -0,0 +1,304 @@
+From VST.typing Require Export type.
+From VST.typing Require Import programs.
+From VST.typing Require Import type_options.
+
+Section value.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  Program Definition value (ot : Ctypes.type) (v : val) : type := {|
+    ty_has_op_type ot' mt := ot' = ot;
+    ty_own β l := (<affine> ⌜field_compatible ot [] l⌝ ∗ <affine> ⌜tc_val' ot v⌝ ∗ (*⌜mem_cast_id v ot⌝ ∗*) l ↦_ot[β] v)%I;
+    ty_own_val v' := (<affine> ⌜tc_val' ot v⌝ ∗ <affine> ⌜v' = v⌝)%I;
+  |}.
+  Next Obligation. iIntros (?????) "[$ [$ ?]]". by iApply heap_mapsto_own_state_share. Qed.
+  Next Obligation. iIntros (ot v ot' mt l ->) "[%?]". done. Qed.
+  Next Obligation. iIntros (ot v ot' mt l ->) "[% ->]". done. Qed.
+  Next Obligation. iIntros (ot v ot' mt l ->) "(%&%&?)". eauto with iFrame. Qed.
+  Next Obligation. iIntros (ot v ot' mt l v' -> ?) "Hl [? ->]". by iFrame. Qed.
+(*  Next Obligation. iIntros (ot v v' ot' mt st ?). apply: mem_cast_compat_id. iPureIntro.
+    move => [?[? ->]]. by destruct ot' => //; simplify_eq/=.
+  Qed.*)
+
+  Lemma value_simplify v ot p T:
+    (<affine> ⌜v = p⌝ -∗ <affine> ⌜tc_val' ot v⌝ -∗ T)
+    ⊢ simplify_hyp (v ◁ᵥ value ot p) T.
+  Proof. iIntros "HT [% ->]". by iApply "HT". Qed.
+  Definition value_simplify_inst := [instance value_simplify with 0%N].
+  Global Existing Instance value_simplify_inst.
+
+  (* might restore this if we find an analogue to memcast *)
+(*   Lemma value_subsume_goal A v v' ly ty T:
+    (<affine> ⌜ty.(ty_has_op_type) ly MCId⌝ ∗ (v ◁ᵥ ty -∗ ∃ x, <affine> ⌜v = v' x⌝ ∗ T x))
+    ⊢ subsume (v ◁ᵥ ty) (λ x : A, v ◁ᵥ value ly (v' x)) T.
+  Proof.
+    iIntros "[% HT] Hty". (* iDestruct (ty_size_eq with "Hty") as %Hly; [done|]. *)
+(*     iDestruct (ty_memcast_compat_id with "Hty") as %?; [done|]. *)
+    iDestruct ("HT" with "Hty") as (? ->) "?". iExists _. by iFrame.
+  Qed. *)
+  Lemma value_subsume_goal A v v' ly ty T:
+    (<affine> ⌜tc_val' ly v⌝ ∗ (v ◁ᵥ ty -∗ ∃ x, <affine> ⌜v = v' x⌝ ∗ T x))
+    ⊢ subsume (v ◁ᵥ ty) (λ x : A, v ◁ᵥ value ly (v' x)) T.
+  Proof.
+    iIntros "[% HT] Hty". (* iDestruct (ty_size_eq with "Hty") as %Hly; [done|]. *)
+(*     iDestruct (ty_memcast_compat_id with "Hty") as %?; [done|]. *)
+    iDestruct ("HT" with "Hty") as (? ->) "?". iExists _. by iFrame.
+  Qed.
+  Definition value_subsume_goal_inst := [instance value_subsume_goal].
+  Global Existing Instance value_subsume_goal_inst.
+
+(*   Lemma value_subsume_goal_loc A l v' ot ty T:
+    (<affine> ⌜ty.(ty_has_op_type) ot MCId⌝ ∗ ∀ v, v ◁ᵥ ty -∗ ∃ x, <affine> ⌜v = (v' x)⌝ ∗ T x)
+    ⊢ subsume (l ◁ₗ ty) (λ x : A, l ◁ₗ value ot (v' x)) T.
+  Proof.
+    iIntros "[% HT] Hty".
+    iDestruct (ty_aligned with "Hty") as %Hal; [done|].
+    iDestruct (ty_deref with "Hty") as (v) "[Hmt Hty]"; [done|].
+(*     iDestruct (ty_size_eq with "Hty") as %Hly; [done|].
+    iDestruct (ty_memcast_compat_id with "Hty") as %?; [done|]. *)
+    iDestruct ("HT" with "Hty") as (? ->) "?". iExists _. by iFrame.
+  Qed.
+  Definition value_subsume_goal_loc_inst := [instance value_subsume_goal_loc].
+  Global Existing Instance value_subsume_goal_loc_inst. *)
+
+(*   Lemma value_subsume_own_ptrop A l β (v' : A → val) ty T:
+    (l ◁ₗ{β} ty -∗ ∃ x, ⌜v' x = l⌝ ∗ T x)
+    ⊢ subsume (l ◁ₗ{β} ty) (λ x : A, l ◁ᵥ value PtrOp (v' x)) T.
+  Proof.
+    iIntros "HT Hty". iDestruct ("HT" with "Hty") as (? Heq) "?". iExists _. iFrame.
+    rewrite Heq. iPureIntro. split_and!; [|done..]. apply mem_cast_id_loc.
+  Qed.
+  Definition value_subsume_own_ptrop_inst := [instance value_subsume_own_ptrop].
+  Global Existing Instance value_subsume_own_ptrop_inst. *)
+
+(*   Lemma value_merge v l ot T:
+    find_in_context (FindVal v) (λ ty:type, ⌜ty.(ty_has_op_type) (UntypedOp (ot_layout ot)) MCNone⌝ ∗ (l ◁ₗ ty -∗ T))
+    ⊢ simplify_hyp (l ◁ₗ value ot v) T.
+  Proof.
+    iDestruct 1 as (ty) "[Hv [% HT]]".
+    iIntros "[% [% [% Hl]]]". iApply "HT". by iApply (ty_ref with "[] Hl Hv").
+  Qed.
+  Definition value_merge_inst := [instance value_merge with 50%N].
+  Global Existing Instance value_merge_inst | 20. *)
+
+(*   Lemma type_read_move l ty ot a E mc `{!TCDone (ty.(ty_has_op_type) ot MCId)} T:
+    (∀ v, T v (value ot v) ty)
+    ⊢ typed_read_end a E l Own ty ot mc T.
+  Proof.
+    unfold TCDone, typed_read_end in *. iIntros "HT Hl".
+    iApply fupd_mask_intro; [destruct a; solve_ndisj|]. iIntros "Hclose".
+    iDestruct (ty_aligned with "Hl") as %?; [done|].
+    iDestruct (ty_deref with "Hl") as (v) "[Hl Hv]"; [done|].
+    iDestruct (ty_size_eq with "Hv") as %?; [done|].
+    iDestruct (ty_memcast_compat_id with "Hv") as %Hid; [done|].
+    iExists _, _, _. iFrame. do 2 iSplit => //=.
+    iIntros "!# %st Hl Hv". iMod "Hclose".
+    iExists _, ty. rewrite Hid. have -> : (if mc then v else v) = v by destruct mc.
+    iFrame "Hv". iSplitR "HT" => //. by iFrame.
+  Qed.
+  Definition type_read_move_inst := [instance type_read_move].
+  Global Existing Instance type_read_move_inst | 50.
+
+  (* TODO: this constraint on the layout is too strong, we only need
+  that the length is the same and the alignment is lower. Adapt when necessary. *)
+  Lemma type_write_own a ty E l2 ty2 v ot T:
+    typed_write_end a E ot v ty l2 Own ty2 T where
+    `{!TCDone (ty.(ty_has_op_type) ot MCId ∧
+               ty2.(ty_has_op_type) (UntypedOp (ot_layout ot)) MCNone)} :-
+      ∀ v', inhale v ◁ᵥ ty; inhale v' ◁ᵥ ty2; return T (value ot v).
+  Proof.
+    unfold TCDone, typed_write_end => -[??]. iIntros "HT Hl Hv".
+    iDestruct (ty_aligned with "Hl") as %?; [done|].
+    iDestruct (ty_deref with "Hl") as (v') "[Hl Hv']"; [done|].
+    iDestruct (ty_size_eq with "Hv") as %?; [done|].
+    iDestruct (ty_size_eq with "Hv'") as %?; [done|].
+    iDestruct (ty_memcast_compat_id with "Hv") as %Hid; [done|].
+    iApply fupd_mask_intro; [destruct a; solve_ndisj|]. iIntros "Hmask".
+    iSplit; [done|]. iSplitL "Hl". { iExists _. by iFrame. }
+    iIntros "!# Hl". iMod "Hmask". iModIntro.
+    iExists _. iDestruct ("HT" with "Hv Hv'") as "$". by iFrame.
+  Qed.
+  Definition type_write_own_inst := [instance type_write_own].
+  Global Existing Instance type_write_own_inst | 50. *)
+End value.
+Global Typeclasses Opaque value.
+Notation "value< ot , v >" := (value ot v) (only printing, format "'value<' ot ',' v '>'") : printing_sugar.
+
+Section at_value.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  (* up *)
+  Lemma field_compatible_tptr : forall p a b, field_compatible (Tpointer a b) [] p ↔ field_compatible (tptr tvoid) [] p.
+  Proof.
+    intros.
+    split; intros (? & ? & ? & Ha & ?); split3; auto; split3; auto;
+      destruct p; try done; simpl in *;
+      inv Ha; econstructor; eauto.
+  Qed.
+
+  Lemma mapsto_tptr:
+    forall sh t1 t2, mapsto_memory_block.mapsto sh (tptr t1) = mapsto_memory_block.mapsto sh (tptr t2).
+  Proof.
+    intros.
+    unfold mapsto_memory_block.mapsto.
+    extensionality v1 v2.
+    unfold tc_val', tc_val. simpl.
+    rewrite !andb_false_r //.
+  Qed.
+
+  (* The type of the pointer really doesn't matter; maybe this means we're using the wrong level of type here. *)
+  Lemma value_tptr l t1 t2 v' : l ◁ₗ value (tptr t1) v' ⊣⊢ l ◁ₗ value (tptr t2) v'.
+  Proof.
+    rewrite /ty_own /=.
+    rewrite /tc_val' /tc_val /=.
+    rewrite !field_compatible_tptr !andb_false_r.
+    rewrite /heap_mapsto_own_state; erewrite mapsto_tptr; done.
+  Qed.
+
+  Lemma value_tptr_val v t1 t2 v' : v ◁ᵥ value (tptr t1) v' = v ◁ᵥ value (tptr t2) v'.
+  Proof.
+    rewrite /ty_own_val /=.
+    rewrite /tc_val' /tc_val /=.
+    rewrite !andb_false_r //.
+  Qed.
+
+  (* TODO: At the moment this is hard-coded for PtrOp. Generalize it to other layouts as well. *)
+  Program Definition at_value (v : val) (ty : type) : type := {|
+    ty_has_op_type ot mt := (∃ t, ot = tptr t)%type;
+    ty_own β l := (if β is Own then ∃ t, l ◁ₗ value (tptr t) v ∗ v ◁ᵥ ty else True)%I;
+    ty_own_val v' := (∃ t, v' ◁ᵥ value (tptr t) v ∗ v ◁ᵥ ty)%I;
+  |}.
+  Next Obligation. by iIntros (?????) "?". Qed.
+  Next Obligation. iIntros (v ty ot mt l (? & ->)) "(% & [Hv ?])". iDestruct (ty_aligned _ _ MCId with "Hv") as %?; first done. iPureIntro. unfold has_layout_loc in *. rewrite !field_compatible_tptr // in H |- *. Qed.
+  Next Obligation. iIntros (v ty ot mt l (? & ->)) "(% & [Hv ?])".
+    iPoseProof (ty_size_eq _ _ mt with "Hv") as "%Hl"; first done.
+    unfold has_layout_val, tc_val' in *; simpl in *.
+    by rewrite !andb_false_r in Hl |- *.
+  Qed.
+  Next Obligation. iIntros (v ty ot mt l (? & ->)) "(% & [Hv $])". iDestruct (ty_deref _ _ MCId with "Hv") as "(% & ? & ?)"; first done. unfold mapsto. erewrite mapsto_tptr; iFrame. Qed.
+  Next Obligation. iIntros (v ty ot mt l v' (? & ->) ?) "Hl (% & [Hv $])". unfold mapsto. erewrite mapsto_tptr. iExists _; iApply (ty_ref _ _ MCId with "[] Hl Hv"); first done. iPureIntro. unfold has_layout_loc in *. rewrite !field_compatible_tptr // in H |- *. Qed.
+(*   Next Obligation.
+    iIntros (v ty v' ot mt st ?) "[Hv ?]".
+    iDestruct (ty_memcast_compat with "Hv") as "?"; [done|]. destruct mt => //. iFrame.
+  Qed. *)
+
+
+  Lemma at_value_simplify_hyp_val v v' t ty T:
+    (v ◁ᵥ value (tptr t) v' -∗ v' ◁ᵥ ty -∗ T)
+    ⊢ simplify_hyp (v ◁ᵥ at_value v' ty) T.
+  Proof. iIntros "HT (% & [??])". erewrite value_tptr_val. by iApply ("HT" with "[$] [$]"). Qed.
+  Definition at_value_simplify_hyp_val_inst := [instance at_value_simplify_hyp_val with 0%N].
+  Global Existing Instance at_value_simplify_hyp_val_inst.
+
+  Lemma at_value_simplify_goal_val v v' t ty T:
+    v ◁ᵥ value (tptr t) v' ∗ v' ◁ᵥ ty ∗ T
+    ⊢ simplify_goal (v ◁ᵥ at_value v' ty) T.
+  Proof. iIntros "[$ [$ $]]". Qed.
+  Definition at_value_simplify_goal_val_inst := [instance at_value_simplify_goal_val with 0%N].
+  Global Existing Instance at_value_simplify_goal_val_inst.
+
+  Lemma at_value_simplify_hyp_loc l v' t ty T:
+    (l ◁ₗ value (tptr t) v' -∗ v' ◁ᵥ ty -∗ T)
+    ⊢ simplify_hyp (l ◁ₗ at_value v' ty) T.
+  Proof. iIntros "HT (% & [??])". erewrite value_tptr. by iApply ("HT" with "[$] [$]"). Qed.
+  Definition at_value_simplify_hyp_loc_inst := [instance at_value_simplify_hyp_loc with 0%N].
+  Global Existing Instance at_value_simplify_hyp_loc_inst.
+
+  Lemma at_value_simplify_goal_loc l v' t ty T:
+    l ◁ₗ value (tptr t) v' ∗ v' ◁ᵥ ty ∗ T
+    ⊢ simplify_goal (l ◁ₗ at_value v' ty) T.
+  Proof. iIntros "[$ [$ $]]". Qed.
+  Definition at_value_simplify_goal_loc_inst := [instance at_value_simplify_goal_loc with 0%N].
+  Global Existing Instance at_value_simplify_goal_loc_inst.
+
+End at_value.
+Global Typeclasses Opaque at_value.
+Notation "at_value< v , ty >" := (at_value v ty) (only printing, format "'at_value<' v ',' ty '>'") : printing_sugar.
+
+Section place.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  Program Definition place (l : address) : type := {|
+    ty_own β l' := (<affine> ⌜l = l'⌝)%I;
+    ty_has_op_type _ _ := False%type;
+    ty_own_val _ := emp;
+  |}.
+  Solve Obligations with try done.
+  Next Obligation. by iIntros (????) "$". Qed.
+
+  Lemma place_simplify l β p T:
+    (<affine> ⌜l = p⌝ -∗ T)
+    ⊢ simplify_hyp (l◁ₗ{β} place p) T.
+  Proof. iIntros "HT ->". by iApply "HT". Qed.
+  Definition place_simplify_inst := [instance place_simplify with 0%N].
+  Global Existing Instance place_simplify_inst.
+
+  Lemma place_simplify_goal l β p T:
+    <affine> ⌜l = p⌝ ∗ T
+    ⊢ simplify_goal (l◁ₗ{β} place p) T.
+  Proof. by iIntros "[-> $]". Qed.
+  Definition place_simplify_goal_inst := [instance place_simplify_goal with 0%N].
+  Global Existing Instance place_simplify_goal_inst.
+
+  Lemma simplify_goal_ex_place l β ty T:
+    simplify_goal (l ◁ₗ{β} ty) T :- exhale (<affine> ⌜ty = place l⌝); return T.
+  Proof. iIntros "[-> $]". done. Qed.
+  (* This is applied with Hint Extern for better performance. *)
+  Definition simplify_goal_ex_place_inst := [instance simplify_goal_ex_place with 99%N].
+
+  Lemma type_addr_of_singleton l β ty T:
+    T β ty (place l)
+    ⊢ typed_addr_of_end l β ty T.
+  Proof. iIntros "HT Hl !#". iExists _, _, _. iFrame "HT". by iFrame. Qed.
+  Definition type_addr_of_singleton_inst := [instance type_addr_of_singleton].
+  Global Existing Instance type_addr_of_singleton_inst.
+
+(*   Lemma typed_place_simpl P l ty1 β1 n {SH:SimplifyHyp (l ◁ₗ{β1} ty1) (Some n)} T:
+    (SH (find_in_context (FindLoc l) (λ '(β2, ty2),
+        typed_place P l β2 ty2 (λ l3 β3 ty3 typ R,
+           T l3 β3 ty3 (λ _, place l) (λ ty', l ◁ₗ{β2} typ ty' ∗ R ty' ))))).(i2p_P)
+    ⊢ typed_place P l β1 ty1 T.
+  Proof.
+    iIntros "SH" (Φ) "Hl HΦ".
+    iDestruct (i2p_proof with "SH Hl") as ([β2 ty2]) "[Hl HP]".
+    iApply ("HP" with "Hl").
+    iIntros (l3 β3 ty3 typ R) "Hl Hc HT".
+    iApply ("HΦ" with "Hl [Hc] HT").
+    iIntros (ty') "Hl3". by iMod ("Hc" with "Hl3") as "[$ $]".
+  Qed.
+  Definition typed_place_simpl_inst := [instance typed_place_simpl].
+  Global Existing Instance typed_place_simpl_inst | 1000.
+
+  Lemma typed_read_end_simpl E l β ty ly n mc {SH:SimplifyHyp (l ◁ₗ{β} ty) (Some n)} a T:
+    (SH (find_in_context (FindLoc l) (λ '(β2, ty2),
+        typed_read_end a E l β2 ty2 ly mc (λ v ty' ty3, l ◁ₗ{β2} ty' -∗ T v (place l) ty3)))).(i2p_P)
+    ⊢ typed_read_end a E l β ty ly mc T.
+  Proof.
+    iIntros "SH". iApply typed_read_end_mono_strong; [done|]. iIntros "Hl !>".
+    iDestruct (i2p_proof with "SH Hl") as ([β2 ty2]) "[Hl HP]" => /=.
+    iExists _, _, True%I. iFrame. iSplit; [done|].
+    iApply (typed_read_end_wand with "HP"). iIntros (v ty1 ty2') "HT _ Hl Hv !>".
+    iExists (place l), _. iFrame. iSplit; [done|]. by iApply "HT".
+  Qed.
+  Definition typed_read_end_simpl_inst := [instance typed_read_end_simpl].
+  Global Existing Instance typed_read_end_simpl_inst | 1000.
+
+  Lemma typed_write_end_simpl b E ot v ty1 l β ty2 n {SH:SimplifyHyp (l ◁ₗ{β} ty2) (Some n)} T:
+    (SH (find_in_context (FindLoc l) (λ '(β3, ty3),
+        typed_write_end b E ot v ty1 l β3 ty3 (λ ty', l ◁ₗ{β3} ty' -∗ T (place l))))).(i2p_P)
+    ⊢ typed_write_end b E ot v ty1 l β ty2 T.
+  Proof.
+    iIntros "SH". iApply typed_write_end_mono_strong; [done|]. iIntros "Hv Hl !>".
+    iDestruct (i2p_proof with "SH Hl") as ([β2' ty2']) "[Hl HP]" => /=.
+    iExists _, _, _, True%I. iFrame. iSplit; [done|].
+    iApply (typed_write_end_wand with "HP"). iIntros (ty3) "HT _ Hl !>".
+    iExists (place l). iSplit; [done|]. by iApply "HT".
+  Qed.
+  Definition typed_write_end_simpl_inst := [instance typed_write_end_simpl].
+  Global Existing Instance typed_write_end_simpl_inst | 1000. *)
+
+End place.
+Global Typeclasses Opaque place.
+Notation "place< l >" := (place l) (only printing, format "'place<' l '>'") : printing_sugar.
+
+Global Hint Extern 99 (SimplifyGoal (_ ◁ₗ{_} _.1ₗ) _) =>
+  (class_apply simplify_goal_ex_place_inst) : typeclass_instances.
diff --git a/refinedVST/typing/tyfold.v b/refinedVST/typing/tyfold.v
new file mode 100644
index 0000000000..44408c38f9
--- /dev/null
+++ b/refinedVST/typing/tyfold.v
@@ -0,0 +1,116 @@
+From VST.typing Require Export type.
+From VST.typing Require Import programs singleton optional constrained exist.
+From VST.typing Require Import type_options.
+
+Section tyfold.
+  Context `{!typeG Σ} {cs : compspecs}.
+
+  Program Definition tyfold_type (tys : list (type → type)) (base : type) (ls : list address) : type :=   {|
+    ty_own β l := <affine>⌜length ls = length tys⌝ ∗
+            ([∗ list] i ↦ ty ∈ tys, ∃ l1 l2, <affine>⌜(l::ls) !! i = Some l1⌝ ∗
+                                             <affine>⌜ls !! i = Some l2⌝ ∗
+           l1 ◁ₗ{β} ty (place l2)) ∗ (default l (last ls)) ◁ₗ{β} base;
+    ty_has_op_type _ _ := False%type;
+    ty_own_val _ := True;
+  |}%I.
+  Solve Obligations with try done.
+  Next Obligation.
+    iIntros (tys base ls l E ?).
+    iDestruct 1 as "(%Hlen & (Htys & Hb))". 
+    iMod (ty_share with "Hb") as "$" => //=.
+    iSplitR => //.
+    iInduction (tys) as [|ty tys] "IH" forall (l ls Hlen) => //.
+    destruct ls as [|l' ls] => //=. move: Hlen => /= [Hlen].
+    iDestruct "Htys" as "(Hty & Htys)".
+    iDestruct "Hty" as (l1 l2 [=->] [=->]) "Hty".
+    iMod (ty_share with "Hty") as "Hty" => //.
+    iSplitL "Hty". 1: { iExists _, _; by iFrame. }
+    by iApply "IH".
+  Qed.
+
+  Definition tyfold (tys : list (type → type)) (base : type) : rtype _ :=
+    RType (tyfold_type tys base).
+
+  Local Typeclasses Transparent own_constrained persistent_own_constraint.
+  Lemma simplify_hyp_place_tyfold_optional l β ls tys b T:
+    (l ◁ₗ{β} (maybe2 cons tys) @ optionalO (λ '(ty, tys), tyexists (λ l2, tyexists (λ ls2,
+       constrained (
+       own_constrained (tyown_constraint l2 (ls2 @ tyfold tys b)) (ty (place l2))) (⌜ls = l2::ls2⌝)))) b -∗ T)
+    ⊢ simplify_hyp (l◁ₗ{β} ls @ tyfold tys b) T.
+  Proof.
+    iIntros "HT Hl". iApply "HT".
+    iDestruct "Hl" as "(% & (Hl & Hd))".
+    destruct tys  as [|ty tys], ls as [ |l' ls] => //=.
+    iDestruct "Hl" as "[H1 Hty2]".
+    iDestruct "H1" as (l1 l2 ??) "H1". simplify_eq.
+    iExists l2. rewrite tyexists_eq. iExists ls. rewrite tyexists_eq. iSplit => //; last first; auto.
+    iSplitL "H1" => //=. rewrite /tyown_constraint. iSplit => //. iFrame.
+    iStopProof. f_equiv. destruct ls =>//=. by apply default_last_cons.
+  Qed.
+  
+  Definition simplify_hyp_place_tyfold_optional_inst :=
+    [instance simplify_hyp_place_tyfold_optional with 50%N].
+  Global Existing Instance simplify_hyp_place_tyfold_optional_inst.
+
+  Lemma simplify_goal_place_tyfold_nil l β ls b T:
+    <affine> ⌜ls = []⌝ ∗ l ◁ₗ{β} b ∗ T ⊢ simplify_goal (l◁ₗ{β} ls @ tyfold [] b) T.
+  Proof. iIntros "[-> [Hl $]]". repeat iSplit => //=. Qed.
+
+  Definition simplify_goal_place_tyfold_nil_inst := [instance simplify_goal_place_tyfold_nil with 0%N].
+  Global Existing Instance simplify_goal_place_tyfold_nil_inst.
+
+  Lemma simplify_goal_place_tyfold_cons l β ls ty tys b T:
+    (∃ l2 ls2, <affine> ⌜ls = l2::ls2⌝ ∗ l ◁ₗ{β} ty (place l2) ∗ l2 ◁ₗ{β} ls2 @ tyfold tys b ∗ T)
+    ⊢ simplify_goal (l◁ₗ{β} ls @ tyfold (ty :: tys) b) T.
+  Proof.
+    iDestruct 1 as (l1 l2) "(% & (H1 & ((% & H3) & $)))".
+    iSplit => /=. 1: iPureIntro; f_equal. { rewrite H //=; auto. }
+     { iDestruct "H3" as "(Hl & Hd)". rewrite H /=. iFrame.
+       iSplit; last first; try done.
+       iStopProof. f_equiv. destruct l2 => //=.
+       apply default_last_cons.
+     }
+  Qed.
+
+  Definition simplify_goal_place_tyfold_cons_inst := [instance simplify_goal_place_tyfold_cons with 0%N].
+  Global Existing Instance simplify_goal_place_tyfold_cons_inst.
+
+  Lemma subsume_tyfold_eq A l β ls1 ls2 tys b1 b2 T :
+    (default l (last ls1) ◁ₗ{β} b1 -∗ ∃ x, <affine> ⌜ls1 = ls2 x⌝ ∗
+                                           (default l (last ls1) ◁ₗ{β} b2 x) ∗ T x)
+    ⊢ subsume (l ◁ₗ{β} ls1 @ tyfold tys b1) (λ x : A, l ◁ₗ{β} (ls2 x) @ tyfold tys (b2 x)) T.
+  Proof.
+    iIntros "HT".
+    iDestruct 1 as "(%Hlen & (Hb1 & Hb))".
+    iDestruct ("HT" with "Hb") as (? ->) "[? ?]".
+    iExists _. by iFrame.
+  Qed.
+  
+  Definition subsume_tyfold_eq_inst := [instance subsume_tyfold_eq].
+  Global Existing Instance subsume_tyfold_eq_inst.
+
+  Lemma subsume_tyfold_snoc A B l β f ls1 ls2 tys (ty : B → A) b1 b2 T :
+    (default l (last ls1) ◁ₗ{β} b1 -∗ ∃ x l2, <affine> ⌜ls2 x = ls1 ++ [l2]⌝ ∗
+         default l (last ls1) ◁ₗ{β} f (ty x) (place l2) ∗ l2 ◁ₗ{β} (b2 x) ∗ T x)
+    ⊢ subsume (l ◁ₗ{β} ls1 @ tyfold (f <$> tys) b1)
+        (λ x : B, l ◁ₗ{β} (ls2 x) @ tyfold (f <$> (tys ++ [ty x])) (b2 x)) T.
+  Proof.
+    iIntros "HT".
+    iDestruct 1 as "(%Hlen & (Hb1 & Hb))".
+    iDestruct ("HT" with "Hb") as (? ?) "(% & (Heq1 & (Heq2 & Heq3)))".
+    iExists _. iFrame.
+    rewrite fmap_app. rewrite H. simpl.
+    iSplit.
+    { iPureIntro. by rewrite !app_length Hlen fmap_length. }
+    rewrite last_snoc /=. iFrame. iSplitL "Hb1" => /=.
+    - iApply (big_sepL_mono with "Hb1") => k y /(lookup_lt_Some _ _ _). rewrite -Hlen => Hl /=.
+      rewrite ?app_comm_cons !lookup_app_l//=. lia.
+    - iSplit => //. rewrite Nat.add_0_r !lookup_app_r -?Hlen ?Nat.sub_diag /=; try lia.
+      iPureIntro. split; auto.
+      rewrite ?app_comm_cons lookup_app_l /=; try lia.
+      by apply list_lookup_length_default_last.
+  Qed.
+  Definition subsume_tyfold_snoc_inst := [instance subsume_tyfold_snoc].
+  Global Existing Instance subsume_tyfold_snoc_inst.
+End tyfold.
+Global Typeclasses Opaque tyfold_type tyfold.
diff --git a/refinedVST/typing/type.v b/refinedVST/typing/type.v
new file mode 100644
index 0000000000..c6f70cd3f2
--- /dev/null
+++ b/refinedVST/typing/type.v
@@ -0,0 +1,801 @@
+From lithium Require Import simpl_classes.
+From VST.typing Require Export base annotations.
+Set Default Proof Using "Type".
+
+Class typeG OK_ty Σ := TypeG {
+  type_heapG :: VSTGS OK_ty Σ;
+}.
+
+(*** type *)
+(** There are different for how to model ownership in this type system
+and there does not seem to be a perfect one. The options explored so
+far are: (ty_own : own_state → loc → iProp Σ )
+
+Owned and shared references:
+Inductive own_state : Type := | Own | Shr.
+ty_own Own l ={⊤\↑shrN}=∗ ty_own Shr l
+Persistent (ty_own Shr l)
+
+This is the simplest option but also the most restrictive:
+Once a type is shared it is never possible to unshare it. This might
+be enough for Hafnium though. But it seems hard to type e.g. RWLocks with this
+model of types. This model is simple because there is no need for recombining
+things which is a big source of problems in the other models.
+
+guarded ty:
+ Own: ▷ l ◁ₗ{Own} ty
+ Shr: □ {|={⊤, ⊤\↑shrN}▷=> l ◁ₗ{Shr} ty
+ This could work via the delayed sharing trick of Rustbelt
+Lock ty:
+ Own: l ↦ b ∗ (l +ₗ 1) ◁ₗ{Own} ty
+ Shr: inv lockN (∃ b, l ↦ b ∗ if b then True else (l +ₗ 1) ◁ₗ{Own} ty)
+LockGuard ty:
+ Own: l ◁ₗ{Shr} Lock ty ∗ (l +ₗ 1) ◁ₗ{Own} ty
+ Shr: False ???
+
+Distinct owned and fractional references:
+Inductive own_state : Type :=
+| Own | Frac (q : Qp).
+Definition own_state_to_frac (β : own_state) : Qp :=
+  match β with
+  | Own => 1%Qp
+  | Frac q => q
+  end.
+Definition own_state_min (β1 β2 : own_state) : own_state :=
+  match β1, β2 with
+  | Own, Own => Own
+  | Frac q, Own => Frac q
+  | Own, Frac q => Frac q
+  | Frac q, Frac q' => Frac (q * q')
+  end.
+ty_own Own l ={⊤}=∗ ty_own (Frac 1%Qp) l;
+(* ={⊤,∅}▷=∗ would be too strong as we cannot prove it for structs *)
+(* maybe you want ={⊤,⊤}▷=∗ here (to strip of the later when going from a frac lock to a owned lock) *
+ I think that you actually want the later here since conceptually fractional is one later than the original one (see RustBelt)
+ probably you don't want the viewshift after the later, only before it (see inheritance in RustBelt and cancellation of cancellable invariants invariants)*)
+ty_own (Frac 1%Qp) l ={⊤}=∗ ty_own Own l;
+Fractional (λ q, ty_own (Frac q) l)
+
+Conceptually this seems like the right thing but the splitting of the fractional when combined by the
+viewshift and laters causes big problems. Especially it does not seem clear how to define the guarded
+type such that it fulfills all the axioms:
+guarded ty:
+ Own: ▷ l ◁ₗ{Own} ty
+ -> does not work because we don't have the viewshift for the frac to own direction
+
+ β: ▷ |={⊤}=> l ◁ₗ{β} ty
+ -> does not work because we cannot prove one direction of the Fractional:
+ ▷ |={⊤}=> l ◁ₗ{Frac q + p} ty -∗ (▷ |={⊤}=> l ◁ₗ{Frac q} ty) ∗ (▷ |={⊤}=> l ◁ₗ{Frac p} ty)
+ -> we don't have a viewshift after stripping the later
+ -> a viewshift instead of the entailment does not help either as it does not commute with the later
+
+Only fractional references:
+Definition own_state : Type := Qp.
+Definition own : own_state := 1%Qp.
+Fractional (λ q, ty_own q l)
+
+guarded ty: ▷ l ◁ₗ{q} ty -> should work since ∗ commutes with ▷ in both directions
+Lock: exists i, l meta is i and cinv_own i q and inv lock ...
+
+Problem: Lock would not be movable (cannot get the pointsto out without aa viewshift)
+Maybe we could add a viewshift when going from own to own val or back
+but might not be such a big problem since one could transform it into a movable lock with one step
+
+
+Other problem with all the Fractional based approaches: you ahve to merge existential quantifiers, which
+can come from e.g. refinements.
+
+The right lemma which you want to prove seems to be
+∀ q1 q2 x y, P q1 x -∗ P q2 y -∗ P q1 x ∗ P q2 x
+This should be provable for most types (e.g. optional assuming l◁ₗ{β} ty -∗ l◁ₗ{β} optty -∗ False)
+and it should commute with separating conjuction (necessary for e.g. struct )
+
+We will also probably need a meta like thing in heap lang to associate gnames with locations to ensure that things agree (e.g. gnames used in cancellable invariants lock).
+
+See also http://www0.cs.ucl.ac.uk/staff/J.Brotherston/CAV20/SL_hybrid_perms.pdf
+
+
+
+Insight: All approaches above are probably doomed.
+Notes:
+An additional parameter to shared references is necessary to ensure that you only try to merge related fractions (similar to lifetimes).
+
+This parameter can be used to fix existential quantifiers and the choice inside option. These won't be able to be changed when shared (but when owned).
+
+Owned to shared is a viewshift which creates the value of this parameter.
+
+Question: what should the type of this parameter be? The easiest would be if it is defined by the type but that would probably break fixpoints.
+Other option: gname
+Other option: Something more complicated like lifetime
+
+Maybe merging and splitting fractions will need a step
+We will need an additional parameter
+
+ *)
+
+Definition adr2val (l : address) := Vptr l.1 (Ptrofs.repr l.2).
+Coercion adr2val : address >-> val.
+
+(* overwrites res_predicates.val2address; unsgined seem to make more sense *)
+Definition val2adr (v: val) : option address := 
+  match v with Vptr b ofs => Some (b, Ptrofs.unsigned ofs) | _ => None end.
+  
+(* Ptrofs.intval Ptrofs.repr *)
+Definition norm_adr (l:address) : address := (l.1, (Ptrofs.unsigned $ Ptrofs.repr l.2)).
+
+Lemma val2adr2val_id l : val2adr $ adr2val (norm_adr l) = Some $ norm_adr l.
+Proof.
+  destruct l; try done.
+  rewrite  /norm_adr /= Ptrofs.unsigned_repr //.
+  apply Ptrofs.unsigned_range_2.
+Qed.
+
+Definition shrN : namespace := nroot.@"shrN".
+Definition mtN : namespace := nroot.@"mtN".
+Definition mtE : coPset := ↑mtN.
+Inductive own_state : Type :=
+| Own | Shr.
+Definition own_state_min (β1 β2 : own_state) : own_state :=
+  match β1 with
+  | Own => β2
+  | _ => Shr
+  end.
+(* Should this be lower (e.g., no type and memval, and a single ↦ instead of mapsto)? *)
+Definition heap_mapsto_own_state `{!typeG OK_ty Σ} (t : type) (l : address) (β : own_state) (v : val) : iProp Σ :=
+  match β with
+  | Own => mapsto Tsh t l v
+  | Shr => inv mtN (∃ q, mapsto q t l v)
+  end.
+Notation "l ↦_ t [ β ] v" := (heap_mapsto_own_state t l β v)
+  (at level 20, t at level 0, β at level 50, format "l  ↦_ t [ β ]  v") : bi_scope.
+Definition heap_mapsto_own_state_type `{!typeG OK_ty Σ} (t : type) (l : address) (β : own_state) : iProp Σ :=
+  (∃ v, l ↦_t[β] v).
+Notation "l ↦[ β ]| t |" := (heap_mapsto_own_state_type t l β)
+  (at level 20, β at level 50, format "l  ↦[ β ]| t |") : bi_scope.
+
+Section own_state.
+  Context `{!typeG OK_ty Σ}.
+  Global Instance own_state_min_left_id : LeftId (=) Own own_state_min.
+  Proof. by move => []. Qed.
+  Global Instance own_state_min_right_id : RightId (=) Own own_state_min.
+  Proof. by move => []. Qed.
+
+  Global Instance heap_mapsto_own_state_shr_persistent t l v : Persistent (l ↦_t[ Shr ] v).
+  Proof. apply _. Qed.
+
+(* Caesium uses a ghost heap to track the bounds of each allocation (block) persistently.
+   We don't have anything analogous; when it would be required, we use valid_pointer, but
+   that's not a persistent assertion and actually owns part of the memory. *)
+
+(*  Lemma heap_mapsto_own_state_loc_in_bounds l β v :
+    l ↦[β] v ⊢ loc_in_bounds l (length v).
+  Proof.
+    destruct β; last by iIntros "[$ _]".
+    iIntros "Hl". by iApply heap_mapsto_loc_in_bounds.
+  Qed.*)
+
+(*  Lemma heap_mapsto_own_state_nil l β:
+    l ↦[β] [] ⊣⊢ loc_in_bounds l 0.
+  Proof. destruct β; [ by apply heap_mapsto_nil | by rewrite /= right_id ]. Qed.*)
+
+  Lemma heap_mapsto_own_state_to_mt t l v E β:
+    ↑mtN ⊆ E → l ↦_t[β] v ={E}=∗ ∃ q, ⌜β = Own → q = Tsh⌝ ∗ mapsto q t l v.
+  Proof.
+    iIntros (?) "Hl".
+    destruct β; simpl; eauto with iFrame.
+    iInv "Hl" as ">H". iDestruct "H" as (q) "H".
+    pose proof (slice.cleave_join q) as Hq.
+    rewrite -mapsto_share_join //.
+    iDestruct "H" as "(H1 & H2)"; iSplitL "H1"; iExists _; by iFrame.
+  Qed.
+
+  Lemma heap_mapsto_own_state_from_mt t (l : address) v E β q:
+    (β = Own → q = Tsh) → mapsto q t l v ={E}=∗ l ↦_t[β] v.
+  Proof.
+    iIntros (Hb) "Hl" => /=.
+    destruct β => /=; first by rewrite Hb.
+    iApply inv_alloc. iModIntro. iExists _. iFrame.
+  Qed.
+
+(*  Lemma heap_mapsto_own_state_alloc l β v :
+    length v ≠ 0%nat →
+    l ↦[β] v -∗ alloc_alive_loc l.
+  Proof.
+    iIntros (?) "Hl".
+    destruct β; [ by iApply heap_mapsto_alive|].
+    iApply heap_mapsto_alive_strong.
+    iMod (heap_mapsto_own_state_to_mt with "Hl") as (? ?) "?"; [done|].
+    iApply fupd_mask_intro; [done|]. iIntros "_". iExists _, _. by iFrame.
+  Qed.*)
+
+  Lemma heap_mapsto_own_state_share t l v E:
+    l ↦_t[Own] v ={E}=∗ l ↦_t[Shr] v.
+  Proof. by apply heap_mapsto_own_state_from_mt. Qed.
+
+  Lemma heap_mapsto_own_state_exist_share t l E:
+    l ↦[Own]|t| ={E}=∗ l ↦[Shr]|t|.
+  Proof.
+    iDestruct 1 as (v) "Hl". iMod (heap_mapsto_own_state_share with "Hl").
+    iExists _. by iFrame.
+  Qed.
+
+(*  Lemma heap_mapsto_own_state_app l v1 v2 β:
+    l ↦[β] (v1 ++ v2) ⊣⊢ l ↦[β] v1 ∗ (adr_add l (length v1)) ↦[β] v2.
+  Proof.
+    destruct β; rewrite /= ?heap_mapsto_app //.
+    - rewrite big_sepL_app. app_length -loc_in_bounds_split.
+    setoid_rewrite shift_loc_assoc_nat.
+    iSplit; iIntros "[[??][??]]"; iFrame.
+  Qed.
+
+  Lemma heap_mapsto_own_state_layout_alt l β ly:
+    l ↦[β]|ly| ⊣⊢ ⌜l `has_layout_loc` ly⌝ ∗ ∃ v, ⌜v `has_layout_val` ly⌝ ∗ l↦[β] v.
+  Proof. iSplit; iDestruct 1 as (???) "?"; eauto with iFrame. iExists _. by iFrame. Qed.*)
+End own_state.
+Arguments heap_mapsto_own_state : simpl never.
+
+(* Not sure what the equivalent to memcast is in VST. *)
+(** [memcast_compat_type] describes how a type can transfered via a
+mem_cast (see also [ty_memcast_compat] below):
+- MCNone: The type cannot be transferred across a mem_cast.
+- MCCopy: The value type can be transferred to a mem_casted value.
+- MCId: mem_cast on a value of this type is the identity.
+
+MCId implies the other two and MCCopy implies MCNone.
+  *)
+Inductive memcast_compat_type : Set :=
+| MCNone | MCCopy | MCId.
+
+
+Local Open Scope Z.
+Section CompatRefinedC.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  (* refinedC only checks if `v` fits in the size of ot *)
+  Definition has_layout_val (v:val) (ot:Ctypes.type) : Prop := tc_val' ot v.
+  Arguments has_layout_val : simpl never.
+
+  Global Typeclasses Opaque has_layout_val.
+    
+  (*  NOTE maybe change this with field_compatible? *)
+  Definition has_layout_loc (l:address) (ot:Ctypes.type) : Prop :=
+    field_compatible ot [] (adr2val l).
+
+  Arguments has_layout_loc : simpl never.
+  Global Typeclasses Opaque has_layout_loc.
+
+  Definition mapsto (l : address) (q : Share.t) (ot : Ctypes.type) (v : val) : mpred := mapsto q ot l v.
+
+  (* TODO maybe use `mapsto_` ?*)
+  Definition mapsto_layout (l : address) (q : Share.t) (ot : Ctypes.type) : mpred :=
+    (∃ v,  <affine>⌜has_layout_val v ot⌝ ∗ <affine>⌜has_layout_loc l ot⌝ ∗ mapsto l q ot v).
+  Definition mapsto_layout_ (l : address) (q : Share.t) (ot : Ctypes.type) : mpred :=
+    (∃ v, mapsto l q ot v).
+  
+  (* Ke: refinedC does not have this; is our maspto too strong? *)
+  Lemma maptso_has_layout_val l q ot (v:val) :
+    mapsto l q ot v ⊢ ⌜has_layout_val v ot⌝.
+  Proof.
+    unfold mapsto, mapsto_memory_block.mapsto.
+    iIntros "H".
+    destruct (access_mode ot) eqn:Hot; try done.
+    destruct (type_is_volatile ot) eqn:Hotv; try done.
+    destruct l eqn:Hl; try done.
+    destruct (readable_share_dec q) eqn:Hq; unfold has_layout_val, tc_val'.
+    - rewrite bi.pure_impl.  iIntros "%". iDestruct "H" as "[[$ _]|[% _]]". done.
+    - iDestruct "H" as "[[$ _] _]".
+  Qed.
+
+  (* Lemma maptso_layout_has_layout_loc (l:address) q ot (v:val) :
+    mapsto l q ot v ⊢ ⌜has_layout_loc l ot⌝.
+  Proof.
+    unfold mapsto, mapsto_memory_block.mapsto, has_layout_loc.
+    iIntros "H".
+    destruct (access_mode ot) eqn:Hot; try done.
+    destruct (type_is_volatile ot) eqn:Hotv; try done.
+    destruct (adr2val l) eqn:Hl; try done.
+    destruct (readable_share_dec q) eqn:Hq.
+    - iDestruct "H" as "[[% H]|[% H]]".
+      + Search field_compatible mapsto_memory_block.mapsto .
+         unfold address_mapsto.
+        inv Hl.
+        iDestruct "H" as (ms) "((% & % & %) & ?)".
+        unfold field_compatible.
+      + unfold address_mapsto.
+        inv Hl.
+        iDestruct "H" as (??) "((% & % & $) & ?)".  
+    -  iDestruct "H" as "[[_ %] _]"; iPureIntro.
+       inv Hl.
+       done.
+  Qed. *)
+
+  (* Lemma mapsto_layout_equiv l q ot :
+    mapsto_layout l q ot ⊣⊢ mapsto_layout_ l q ot.
+  Proof.
+    rewrite /mapsto_layout /mapsto_layout_.
+    apply bi.equiv_entails_2; apply bi.exist_mono => v.
+    - iIntros "(? & ? & $)".
+    - iIntros "H".
+      iSplit. { rewrite maptso_layout_has_layout_val //. iDestruct "H" as "%". iPureIntro; done. }
+      iSplit. { rewrite maptso_layout_has_layout_loc //. iDestruct "H" as "%". iPureIntro; done. }
+      done.
+  Qed. *)
+
+End CompatRefinedC.
+
+Notation "v `has_layout_val` ot" := (has_layout_val v ot) (at level 50) : stdpp_scope.
+Notation "l `has_layout_loc` ot" := (has_layout_loc l ot) (at level 50) : stdpp_scope.
+Notation "l ↦{ sh '}' '|' ot '|' v" := (mapsto l sh ot v)
+  (at level 20, sh at level 50, format "l ↦{ sh '}' '|' ot '|' v") : bi_scope.
+Notation "l ↦| ot | v" := (mapsto l Tsh ot v)
+  (at level 20, format "l  ↦| ot | v") : bi_scope.
+Notation "l ↦{ sh '}' '|' ot '|' '_'" := (mapsto_layout l sh ot)
+  (at level 20, sh at level 50, format "l ↦{ sh '}' '|' ot '|' _") : bi_scope.
+Notation "l ↦| ot '|' '-'" := (mapsto_layout l Tsh ot)
+  (at level 20, format "l ↦| ot '|' '-'") : bi_scope.
+
+(* In Caesium, all values are lists of bytes in memory, and structured data is just an
+   assertion on top of that. What do we want the values that appear in our types to be? *)
+Record type `{!typeG OK_ty Σ} {cs : compspecs} := {
+  (** [ty_has_op_type ot mt] describes in which cases [l ◁ₗ ty] can be
+      turned into [∃ v. l ↦ v ∗ v ◁ᵥ ty]. The op_type [ot] gives the
+      requested layout for the location and [mt] describes how the
+      value of [v ◁ᵥ ty] is changed by a memcast (i.e. when read from
+      memory). [ty_has_op_type] should be written such that it
+      computes well and can be solved by [done]. Also [ty_has_op_type]
+      should be defined for [UntypedOp]. *)
+  (* TODO: add
+   ty_has_op_type ot mt → ty_has_op_type (UntypedOp (ot_layout ot)) mt
+   This property is never used explicitly, but relied on by some typing rules *)
+  ty_has_op_type : Ctypes.type → memcast_compat_type → Prop;
+  (** [ty_own β l ty], also [l ◁ₗ{β} ty], states that the location [l]
+  has type [ty]. [β] determines whether the location is fully owned
+  [Own] or shared [Shr] (shared is mainly used for global variables). *)
+  ty_own : own_state → address → iProp Σ;
+  (** [ty_own v ty], also [v ◁ᵥ ty], states that the value [v] has type [ty]. *)
+  ty_own_val : val → iProp Σ;
+  (** [ty_share] states that full ownership can always be turned into shared ownership. *)
+  ty_share l E : ↑shrN ⊆ E → ty_own Own l ={E}=∗ ty_own Shr l;
+  (** [ty_shr_pers] states that shared ownership is persistent. *)
+  ty_shr_pers l : Persistent (ty_own Shr l);
+  (** [ty_aligned] states that from [l ◁ₗ{β} ty] follows that [l] is
+  aligned according to [ty_has_op_type]. *)
+  ty_aligned ot mt l : ty_has_op_type ot mt → ty_own Own l -∗ <absorb> ⌜l `has_layout_loc` ot⌝;
+  (** [ty_size_eq] states that from [v ◁ᵥ ty] follows that [v] has a
+  size according to [ty_has_op_type]. *)
+  ty_size_eq ot mt v : ty_has_op_type ot mt → ty_own_val v -∗ <absorb> ⌜v `has_layout_val` ot⌝;
+  (** [ty_deref] states that [l ◁ₗ ty] can be turned into [v ◁ᵥ ty] and a points-to
+  according to [ty_has_op_type]. *)
+  ty_deref ot mt l : ty_has_op_type ot mt → ty_own Own l -∗ ∃ v, mapsto l Tsh ot v ∗ ty_own_val v;
+  (** [ty_ref] states that [v ◁ₗ ty] and a points-to for a suitable location [l ◁ₗ ty]
+  according to [ty_has_op_type]. *)
+  ty_ref ot mt (l : address) v : ty_has_op_type ot mt → <affine> ⌜l `has_layout_loc` ot⌝ -∗ mapsto l Tsh ot v -∗ ty_own_val v -∗ ty_own Own l;
+  (** [ty_memcast_compat] describes how a value of type [ty] is
+  transformed by memcast. [MCNone] means there is no information about
+  the new value, [MCCopy] means the value can change, but it still has
+  type [ty], and [MCId] means the value does not change. *)
+(*  ty_memcast_compat v ot mt st:
+    ty_has_op_type ot mt →
+    (* TODO: Should this be a -∗ for consistency with the other properties?
+    We currently use ⊢ because it makes applying some lemmas easier. *)
+    ty_own_val v ⊢
+    match mt with
+    | MCNone => True
+    | MCCopy => ty_own_val (mem_cast v ot st)
+    | MCId => ⌜mem_cast_id v ot⌝ (* This could be tc_val' ot v *)
+    end;*)
+}.
+Arguments ty_own : simpl never.
+Arguments ty_has_op_type {_ _ _ _} _.
+Arguments ty_own_val {_ _ _ _} _ : simpl never.
+Global Existing Instance ty_shr_pers.
+
+(*Section memcast.
+  Context `{!typeG Σ}.
+
+  Lemma ty_memcast_compat_copy v ot ty st:
+    ty.(ty_has_op_type) ot MCCopy →
+    ty.(ty_own_val) v ⊢ ty.(ty_own_val) (mem_cast v ot st).
+  Proof. move => ?. by apply: (ty_memcast_compat _ _ _ MCCopy). Qed.
+
+  Lemma ty_memcast_compat_id v ot ty:
+    ty.(ty_has_op_type) ot MCId →
+    ty.(ty_own_val) v ⊢ ⌜mem_cast_id v ot⌝.
+  Proof. move => ?. by apply: (ty_memcast_compat _ _ _ MCId inhabitant). Qed.
+
+  Lemma mem_cast_compat_id (P : val → iProp Σ) v ot st mt:
+    (P v ⊢ ⌜mem_cast_id v ot⌝) →
+    (P v ⊢ match mt with | MCNone => True | MCCopy => P (mem_cast v ot st) | MCId => ⌜mem_cast_id v ot⌝ end).
+  Proof. iIntros (HP) "HP". iDestruct (HP with "HP") as %Hm. rewrite Hm. by destruct mt. Qed.
+
+  Lemma mem_cast_compat_Untyped (P : val → iProp Σ) v ot st mt:
+    ((if ot is UntypedOp _ then False else True) → P v ⊢ match mt with | MCNone => True | MCCopy => P (mem_cast v ot st) | MCId => ⌜mem_cast_id v ot⌝ end) →
+    P v ⊢ match mt with | MCNone => True | MCCopy => P (mem_cast v ot st) | MCId => ⌜mem_cast_id v ot⌝ end.
+  Proof. move => Hot. destruct ot; try by apply: Hot. apply: mem_cast_compat_id. by iIntros "?". Qed.
+
+  (* It is important this this computes well so that it can be solved automatically. *)
+  Definition is_int_ot (ot : op_type) (it : int_type) : Prop:=
+    match ot with | IntOp it' => it = it' | UntypedOp ly => ly = it_layout it | _ => False end.
+  Definition is_ptr_ot (ot : op_type) : Prop:=
+    match ot with | PtrOp => True | UntypedOp ly => ly = void* | _ => False end.
+  Definition is_value_ot (ot : op_type) (ot' : op_type) :=
+    if ot' is UntypedOp ly then ly = ot_layout ot else ot' = ot.
+
+  Lemma is_int_ot_layout it ot:
+    is_int_ot ot it → ot_layout ot = it.
+  Proof. by destruct ot => //= ->. Qed.
+
+  Lemma is_ptr_ot_layout ot:
+    is_ptr_ot ot → ot_layout ot = void*.
+  Proof. by destruct ot => //= ->. Qed.
+
+  Lemma is_value_ot_layout ot ot':
+    is_value_ot ot ot' → ot_layout ot' = ot_layout ot.
+  Proof. by destruct ot' => //= <-. Qed.
+
+  Lemma mem_cast_compat_int (P : val → iProp Σ) v ot st mt it:
+    is_int_ot ot it →
+    (P v ⊢ ⌜∃ z, val_to_Z v it = Some z⌝) →
+    (P v ⊢ match mt with | MCNone => True | MCCopy => P (mem_cast v ot st) | MCId => ⌜mem_cast_id v ot⌝ end).
+  Proof.
+    move => ? HT. apply: mem_cast_compat_Untyped => ?.
+    apply: mem_cast_compat_id. destruct ot => //; simplify_eq/=.
+    etrans; [done|]. iPureIntro => -[??]. by apply: mem_cast_id_int.
+  Qed.
+
+  Lemma mem_cast_compat_loc (P : val → iProp Σ) v ot st mt:
+    is_ptr_ot ot →
+    (P v ⊢ ⌜∃ l, v = val_of_loc l⌝) →
+    (P v ⊢ match mt with | MCNone => True | MCCopy => P (mem_cast v ot st) | MCId => ⌜mem_cast_id v ot⌝ end).
+  Proof.
+    move => ? HT. apply: mem_cast_compat_Untyped => ?.
+    apply: mem_cast_compat_id. destruct ot => //; simplify_eq/=.
+    etrans; [done|]. iPureIntro => -[? ->]. by apply: mem_cast_id_loc.
+  Qed.
+End memcast.*)
+
+Class Copyable `{!typeG OK_ty Σ} {cs : compspecs} (ty : type) := {
+  copy_own_persistent v : Persistent (ty.(ty_own_val) v);
+  copy_own_affine v : Affine (ty.(ty_own_val) v);
+  copy_shr_acc E ot l :
+    mtE ⊆ E → ty.(ty_has_op_type) ot MCCopy →
+    ty.(ty_own) Shr l ={E}=∗ <affine> ⌜l `has_layout_loc` ot⌝ ∗
+       (* TODO: the closing conjuct does not make much sense with True *)
+       ∃ q' vl, mapsto l q' ot vl ∗ ▷ ty.(ty_own_val) vl ∗ (▷mapsto l q' ot vl ={E}=∗ True)
+}.
+Global Existing Instance copy_own_persistent.
+Global Existing Instance copy_own_affine.
+
+(*Class LocInBounds `{!typeG Σ} (ty : type) (β : own_state) (n : nat) := {
+  loc_in_bounds_in_bounds l : ty.(ty_own) β l -∗ loc_in_bounds l n
+}.
+Arguments loc_in_bounds_in_bounds {_ _} _ _ _ {_} _.
+Global Hint Mode LocInBounds + + + + - : typeclass_instances.
+
+Section loc_in_bounds.
+  Context `{!typeG Σ}.
+
+  Lemma movable_loc_in_bounds ty l ot mt:
+    ty.(ty_has_op_type) ot mt →
+    ty.(ty_own) Own l -∗ loc_in_bounds l (ly_size (ot_layout ot)).
+  Proof.
+    iIntros (?) "Hl". iDestruct (ty_deref with "Hl") as (v) "[Hl Hv]"; [done|].
+    iDestruct (ty_size_eq with "Hv") as %<-; [done|]. by iApply heap_mapsto_loc_in_bounds.
+  Qed.
+
+  Global Instance intro_persistent_loc_in_bounds l n:
+    IntroPersistent (loc_in_bounds l n) (loc_in_bounds l n).
+  Proof. constructor. by iIntros "#H !>". Qed.
+End loc_in_bounds.
+
+Class AllocAlive `{!typeG Σ} (ty : type) (β : own_state) (P : iProp Σ) := {
+  alloc_alive_alive l : P -∗ ty.(ty_own) β l -∗ alloc_alive_loc l
+}.
+Arguments alloc_alive_alive {_ _} _ _ _ {_} _.
+Global Hint Mode AllocAlive + + + + - : typeclass_instances.
+
+Definition type_alive `{!typeG Σ} (ty : type) (β : own_state) : iProp Σ :=
+  □ (∀ l, ty.(ty_own) β l -∗ alloc_alive_loc l).
+Notation type_alive_own ty := (type_alive ty Own).
+
+Section alloc_alive.
+  Context `{!typeG Σ}.
+
+  Lemma movable_alloc_alive ty l ot mt :
+    (ot_layout ot).(ly_size) ≠ 0%nat →
+    ty.(ty_has_op_type) ot mt →
+    ty.(ty_own) Own l -∗ alloc_alive_loc l.
+  Proof.
+    iIntros (??) "Hl". iDestruct (ty_deref with "Hl") as (v) "[Hl Hv]"; [done|].
+    iDestruct (ty_size_eq with "Hv") as %Hv; [done|].
+    iApply heap_mapsto_alive => //. by rewrite Hv.
+  Qed.
+
+  Global Instance intro_persistent_alloc_global l:
+    IntroPersistent (alloc_global l) (alloc_global l).
+  Proof. constructor. by iIntros "#H !>". Qed.
+
+  Global Instance intro_persistent_type_alive ty β:
+    IntroPersistent (type_alive ty β) (type_alive ty β).
+  Proof. constructor. by iIntros "#H !>". Qed.
+
+  Global Instance AllocAlive_simpl_and ty β P P' `{!AllocAlive ty β P'} `{!IsEx P} :
+    SimplAndUnsafe (AllocAlive ty β P) (P = P').
+  Proof. by move => ->. Qed.
+End alloc_alive.
+
+Global Typeclasses Opaque type_alive.*)
+
+Notation "l ◁ₗ{ β } ty" := (ty_own ty β l) (at level 15, format "l  ◁ₗ{ β }  ty") : bi_scope.
+Notation "l ◁ₗ ty" := (ty_own ty Own l) (at level 15) : bi_scope.
+Notation "v ◁ᵥ ty" := (ty_own_val ty v) (at level 15) : bi_scope.
+
+Declare Scope printing_sugar.
+Notation "'frac' { β } l ∶ ty" := (ty_own ty β l) (at level 100, only printing) : printing_sugar.
+Notation "'own' l ∶ ty" := (ty_own ty Own l) (at level 100, only printing) : printing_sugar.
+Notation "'shr' l ∶ ty" := (ty_own ty Shr l) (at level 100, only printing) : printing_sugar.
+Notation "v ∶ ty" := (ty_own_val ty v) (at level 200, only printing) : printing_sugar.
+
+(*** tytrue *)
+Section true.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+  (** tytrue is a dummy type that all values and locations have. *)
+  Program Definition tytrue : type := {|
+    ty_own _ _ := True%I;
+    ty_has_op_type _ _ := False%type;
+    ty_own_val _ := emp;
+  |}.
+  Solve Obligations with try done.
+  Next Obligation. iIntros (???) "?". done. Qed.
+End true.
+Global Instance inhabited_type `{!typeG OK_ty Σ} {cs : compspecs} : Inhabited type := populate tytrue.
+(* tytrue is not opaque because we don't have typing rules for it. *)
+(* Global Typeclasses Opaque tytrue. *)
+
+(*** refinement types *)
+Record rtype `{!typeG OK_ty Σ} {cs : compspecs} (A : Type) := RType {
+  rty : A → type;
+}.
+Arguments RType {_ _ _ _ _} _.
+Arguments rty {_ _ _ _ _} _.
+Add Printing Constructor rtype.
+
+Bind Scope bi_scope with type.
+Bind Scope bi_scope with rtype.
+
+Definition with_refinement `{!typeG OK_ty Σ} {cs : compspecs} {A} (r : rtype A) (x : A) : type := r.(rty) x.
+Notation "x @ r" := (with_refinement r x) (at level 14) : bi_scope.
+Arguments with_refinement : simpl never.
+
+Program Definition ty_of_rty `{!typeG OK_ty Σ} {cs : compspecs} {A} (r : rtype A) : type := {|
+  ty_own q l := (∃ x, (x @ r).(ty_own) q l)%I;
+  ty_has_op_type ot mt := forall x, (x @ r).(ty_has_op_type) ot mt;
+  ty_own_val v := (∃ x, (x @ r).(ty_own_val) v)%I;
+|}.
+Next Obligation. iDestruct 1 as (?) "H". iExists _. by iMod (ty_share with "H") as "$". Qed.
+Next Obligation.
+  iIntros (Σ ?? A r β mt l Hly). iDestruct 1 as (x) "Hv". by iDestruct (ty_aligned with "Hv") as %Hv; [done|].
+Qed.
+Next Obligation.
+  iIntros (Σ ?? A r ot mt v Hly). iDestruct 1 as (x) "Hv". 
+ by iDestruct (ty_size_eq with "Hv") as %Hv.
+Qed.
+Next Obligation.
+  iIntros (Σ ?? A r ot mt l Hly). iDestruct 1 as (x) "Hl".
+  iDestruct (ty_deref with "Hl") as (v) "[Hl Hv]"; [done|].
+  eauto with iFrame.
+Qed.
+Next Obligation.
+  iIntros (? Σ ?? A r ot mt l v Hly ?) "Hl". iDestruct 1 as (x) "Hv".
+  iDestruct (ty_ref with "[] Hl Hv") as "Hl"; [done..|].
+  iExists _. iFrame.
+Qed.
+(*Next Obligation.
+  iIntros (Σ ?? A r v ot mt st Hot) "[%x Hv]".
+  iDestruct (ty_memcast_compat with "Hv") as "?"; [done|].
+  case_match => //. iExists _. iFrame.
+Qed.*)
+
+Coercion ty_of_rty : rtype >-> type.
+(* TODO: somehow this instance does not work*)
+(* Global Instance assume_inj_with_refinement `{!typeG Σ} ty : AssumeInj (=) (=) (with_refinement ty). *)
+(* Proof. done. Qed. *)
+
+(* TODO: remove the following? *)
+(* Record refined `{!typeG Σ} := { *)
+(*   r_type : Type; *)
+(*   r_rty : rtype; *)
+(*   r_fn : r_type → r_rty.(rty_type); *)
+(* }. *)
+(* Program Definition rty_of_refined `{!typeG Σ} (r : refined) : rtype := {| *)
+(*   rty_type := r.(r_type); *)
+(*   rty x := r.(r_rty).(rty) (r.(r_fn) x) *)
+(* |}. *)
+(* Coercion rty_of_refined : refined >-> rtype. *)
+
+Section rmovable.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  Global Program Instance copyable_ty_of_rty A r `{!∀ x : A, Copyable (x @ r)} : Copyable r.
+  Next Obligation.
+    iIntros (A r ? E ly l ??). iDestruct 1 as (x) "Hl".
+    iMod (copy_shr_acc with "Hl") as (? q' vl) "(?&?&?)" => //.
+    iSplitR => //. iExists _, _. iFrame. auto.
+  Qed.
+End rmovable.
+
+Notation "l `at_type` ty" := (with_refinement ty <$> l) (at level 50) : bi_scope.
+(* Must be an Hint Extern instead of an Instance since simple apply is not able to apply the instance. *)
+Global Hint Extern 1 (AssumeInj (=) (=) (with_refinement _)) => exact: I : typeclass_instances.
+
+(*** Monotonicity *)
+Section mono.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  Inductive type_le' (ty1 ty2 : type) : Prop :=
+    Type_le :
+      (* We omit [ty_has_op_type] on purpose as it is not preserved by fixpoints. *)
+      (∀ β l, ty1.(ty_own) β l ⊢ ty2.(ty_own) β l) →
+      (∀ v, ty1.(ty_own_val) v ⊢ ty2.(ty_own_val) v) →
+      type_le' ty1 ty2.
+  Global Instance type_le : SqSubsetEq type := type_le'.
+
+  Inductive type_equiv' (ty1 ty2 : type) : Prop :=
+    Type_equiv :
+      (* We omit [ty_has_op_type] on purpose as it is not preserved by fixpoints. *)
+      (∀ β l, ty1.(ty_own) β l ≡ ty2.(ty_own) β l) →
+      (∀ v, ty1.(ty_own_val) v ≡ ty2.(ty_own_val) v) →
+      type_equiv' ty1 ty2.
+  Global Instance type_equiv : Equiv type := type_equiv'.
+
+  Global Instance type_equiv_antisym :
+    AntiSymm (≡@{type} ) (⊑).
+  Proof. move => ?? [??] [??]. split; intros; by apply (anti_symm (⊢)). Qed.
+
+  Global Instance type_le_preorder : PreOrder (⊑@{type} ).
+  Proof.
+    constructor.
+    - done.
+    - move => ??? [??] [??].
+      constructor => *; (etrans; [match goal with | H : _ |- _ => apply H end|]; done).
+  Qed.
+
+  Global Instance type_equivalence : Equivalence (≡@{type} ).
+  Proof.
+    constructor.
+    - done.
+    - move => ?? [??]. constructor => *; by symmetry.
+    - move => ??? [??] [??].
+      constructor => *; (etrans; [match goal with | H : _ |- _ => apply H end|]; done).
+  Qed.
+
+  Global Instance ty_le_proper : Proper ((≡) ==> (≡) ==> iff) (⊑@{type} ).
+  Proof.
+    move => ?? [Hl1 Hv1] ?? [Hl2 Hv2].
+    split; move => [??]; constructor; intros.
+    - by rewrite -Hl1 -Hl2.
+    - by rewrite -Hv1 -Hv2.
+    - by rewrite Hl1 Hl2.
+    - by rewrite Hv1 Hv2.
+  Qed.
+
+  Lemma type_le_equiv_list (f : list type → type) :
+    Proper (Forall2 (⊑) ==> (⊑)) f →
+    Proper (Forall2 (≡) ==> (≡)) f.
+  Proof.
+    move => HP ?? Heq. apply (anti_symm (⊑)); apply HP.
+    2: symmetry in Heq.
+    all: by apply: Forall2_impl; [done|] => ?? ->.
+  Qed.
+
+  Global Instance ty_own_le : Proper ((⊑) ==> eq ==> eq ==> (⊢)) ty_own.
+  Proof. intros ?? EQ ??-> ??->. apply EQ. Qed.
+  Global Instance ty_own_proper : Proper ((≡) ==> eq ==> eq ==> (≡)) ty_own.
+  Proof. intros ?? EQ ??-> ??->. apply EQ. Qed.
+  Lemma ty_own_entails `{!typeG OK_ty Σ} ty1 ty2 β l:
+    ty1 ≡@{type} ty2 →
+    ty_own ty1 β l ⊢ ty_own ty2 β l.
+  Proof. by move => [-> ?]. Qed.
+
+  Global Instance ty_own_val_le : Proper ((⊑) ==> eq ==> (⊢)) ty_own_val.
+  Proof. intros ?? EQ ??->. apply EQ. Qed.
+  Global Instance ty_own_val_proper : Proper ((≡) ==> eq ==> (≡)) ty_own_val.
+  Proof. intros ?? EQ ??->. apply EQ. Qed.
+
+  Lemma ty_of_rty_le A rty1 rty2 :
+    (∀ x : A, (x @ rty1)%I ⊑ (x @ rty2)%I) →
+    ty_of_rty rty1 ⊑ ty_of_rty rty2.
+  Proof.
+    destruct rty1, rty2; simpl in *. rewrite /with_refinement/=.
+    move => Hle. constructor => /=.
+    - move => ??. rewrite /ty_own/=. f_equiv => ?. apply Hle.
+    - move => ?. rewrite /ty_own_val/=. f_equiv => ?. apply Hle.
+  Qed.
+  Lemma ty_of_rty_proper A rty1 rty2 :
+    (∀ x : A, (x @ rty1)%I ≡ (x @ rty2)%I) →
+    ty_of_rty rty1 ≡ ty_of_rty rty2.
+  Proof.
+    destruct rty1, rty2; simpl in *. rewrite /with_refinement/=.
+    move => Heq. constructor => /=.
+    - move => ??. rewrite /ty_own/=. f_equiv => ?. apply Heq.
+    - move => ?. rewrite /ty_own_val/=. f_equiv => ?. apply Heq.
+  Qed.
+End mono.
+
+Notation TypeMono T := (Proper (pointwise_relation _ (⊑) ==> pointwise_relation _ (⊑)) T).
+
+Global Typeclasses Opaque ty_own ty_own_val ty_of_rty with_refinement.
+
+Ltac simpl_type :=
+  simpl;
+  repeat match goal with
+        | |- context C [ty_own {| ty_own := ?f |}] => let G := context C [f] in change G
+        | |- context C [ty_own_val {| ty_own_val := ?f |}] => let G := context C [f] in change G
+        | |- context C [ty_own (?x @ {| rty := ?f |} )] =>
+            let G := context C [let '({| ty_own := y |} ) := (f x) in y ] in
+            change G
+        | |- context C [ty_own_val (?x @ {| rty := ?f |} )] =>
+            let G := context C [let '({| ty_own_val := y |} ) := (f x) in y ] in
+            change G
+     end; simpl.
+
+Ltac unfold_type_equiv :=
+  lazymatch goal with
+  | |- Forall2 _ (_ <$> _) (_ <$> _) => apply list_fmap_Forall2_proper
+  | |- (?a @ ?ty1)%I ⊑ (?b @ ?ty2)%I => change (rty ty1 a ⊑ rty ty2 b); simpl
+  | |- (?a @ ?ty1)%I ≡ (?b @ ?ty2)%I => change (rty ty1 a ≡ rty ty2 b); simpl
+  | |- ty_of_rty _ ⊑ ty_of_rty _ => simple refine (ty_of_rty_le _ _ _ _) => ? /=
+  | |- ty_of_rty _ ≡ ty_of_rty _ => simple refine (ty_of_rty_proper _ _ _ _) => ? /=
+  | |- {| ty_own := _ |} ⊑ {| ty_own := _ |} =>
+      constructor => *; simpl_type
+  | |- {| ty_own := _ |} ≡ {| ty_own := _ |} =>
+      constructor => *; simpl_type
+  | |- context [let '_ := ?x in _] => destruct x
+  end.
+
+(* A version of f_equiv which performs better for the kinds of goals
+we see in this development (e.g. mpool_spec). *)
+Ltac f_equiv' :=
+  match goal with
+  | |- pointwise_relation _ _ _ _ => intros ?
+  | |- prod_relation _ _ ?p _ => is_var p; destruct p
+  (* We support matches on both sides, *if* they concern the same variable, or *)
+     (* variables in some relation. *)
+  | |- ?R (match ?x with _ => _ end) (match ?x with _ => _ end) =>
+    destruct x
+  | H : ?R ?x ?y |- ?R2 (match ?x with _ => _ end) (match ?y with _ => _ end) =>
+     destruct H
+  | |- _ = _ => reflexivity
+
+  | |- ?R (?f _) _ => simple apply (_ : Proper (R ==> R) f)
+  | |- ?R (?f _ _) _ => simple apply (_ : Proper (R ==> R ==> R) f)
+  | |- ?R (?f _ _ _) _ => simple apply (_ : Proper (R ==> R ==> R ==> R) f)
+  | |- ?R (?f _ _ _ _) _ => simple apply (_ : Proper (R ==> R ==> R ==> R ==> R) f)
+  | |- ?R (?f _ _ _ _) _ => simple apply (_ : Proper (_ ==> _ ==> _ ==> _ ==> R) f)
+  | |- ?R (?f _ _ _) _ => simple apply (_ : Proper (_ ==> _ ==> _ ==> R) f)
+  | |- ?R (?f _ _) _ => simple apply (_ : Proper (_ ==> _ ==> R) f)
+  | |- ?R (?f _) _ => simple apply (_ : Proper (_ ==> R) f)
+  (* In case the function symbol differs, but the arguments are the same, *)
+     (* maybe we have a pointwise_relation in our context. *)
+  (* TODO: If only some of the arguments are the same, we could also *)
+  (*    query for "pointwise_relation"'s. But that leads to a combinatorial *)
+  (*    explosion about which arguments are and which are not the same. *)
+  | H : pointwise_relation _ ?R ?f ?g |- ?R (?f ?x) (?g ?x) => simple apply H
+  | H : pointwise_relation _ (pointwise_relation _ ?R) ?f ?g |- ?R (?f ?x ?y) (?g ?x ?y) => simple apply H
+  end.
+
+Ltac solve_type_proper :=
+  solve_proper_core ltac:(fun _ => first [ fast_reflexivity | unfold_type_equiv | f_contractive | f_equiv' | reflexivity ]).
+(* for debugging use
+   solve_proper_prepare.
+   first [ eassumption | fast_reflexivity | unfold_type_equiv | f_contractive | f_equiv' | reflexivity ].
+*)
+
+
+(*** Tests *)
+Section tests.
+  Context `{!typeG OK_ty Σ} {cs : compspecs}.
+
+  Example binding l (r : Z → rtype N) v x T : True -∗ l ◁ₗ x @ r v ∗ T. Abort.
+
+End tests.
diff --git a/refinedVST/typing/type_options.v b/refinedVST/typing/type_options.v
new file mode 100644
index 0000000000..7c1bd04d03
--- /dev/null
+++ b/refinedVST/typing/type_options.v
@@ -0,0 +1,14 @@
+From VST.typing Require Import type.
+
+(** This file collects options for files with type definitions.
+
+    WARNING: Never export this file and don't import this file in
+ files that use the automation! *)
+
+(** These definitions are opaque by default to improve typeclass
+search for the automation. We make them transparent for type
+definitions such that iDestruct and friends work when proving lemmas. *)
+#[export] Typeclasses Transparent ty_own ty_own_val with_refinement.
+
+(* TODO: move this somewhere else? *)
+#[export] Set Default Proof Using "Type".
diff --git a/refinedVST/typing/typing.v b/refinedVST/typing/typing.v
new file mode 100644
index 0000000000..6b16f7cd63
--- /dev/null
+++ b/refinedVST/typing/typing.v
@@ -0,0 +1,3 @@
+From VST.typing Require Export int programs type boolean  (*intptr*) function bytes own (*struct*) optional singleton (*fixpoint*) automation (*padded*) (*exist*) (*immovable*) (*constrained*) (*union*) (*array*) (*wand*) globals (*tyfold*) (*atomic_bool*) (*locked*) (*tagged_ptr*) (*bitfield*).
+
+#[global] Notation int := VST.typing.int.int.
diff --git a/refinedVST/typing/wand.v b/refinedVST/typing/wand.v
new file mode 100644
index 0000000000..345b31e393
--- /dev/null
+++ b/refinedVST/typing/wand.v
@@ -0,0 +1,157 @@
+From VST.typing Require Export type.
+From VST.typing Require Import programs.
+From VST.typing Require Import type_options.
+
+Section wand.
+  Context `{!typeG Σ} {cs : compspecs}.
+
+  Context {A : Type}.
+  Implicit Types (P : A → iProp Σ).
+
+  Program Definition wand_ex P (ty : A → type) : type := {|
+    ty_own β l := match β return _ with
+                  | Own => ∀ x, P x -∗ l ◁ₗ (ty x)
+                  | Shr => True
+                  end;
+    ty_has_op_type _ _ := False%type;
+    ty_own_val _ := True;
+  |}%I.
+  Solve Obligations with try done.
+  Next Obligation. iIntros (?????) "H". done. Qed.
+  
+  Lemma subsume_wand B l P1 (P2 : B → A → iProp Σ) ty1 ty2 T:
+    (* The trick is that we prove the wand at the very end so it can
+    use all leftover resources. This only works if there is at most
+    one wand per block (but this is enough for iterating over linked
+    lists). *)
+    (∃ z, T z ∗ (∀ x, P2 z x -∗ ∃ y, P1 y ∗ (l ◁ₗ ty1 y -∗ l ◁ₗ ty2 z x ∗ <affine> True)))
+    ⊢ subsume (l ◁ₗ wand_ex P1 ty1) (λ z : B, l ◁ₗ wand_ex (P2 z) (ty2 z)) T.
+  Proof.
+    iIntros "(%&?&Hwand) Hwand2". iExists _. iFrame.
+    iIntros (x) "HP2". iDestruct ("Hwand" with "HP2") as (y) "[HP1 Hty]".
+    iDestruct ("Hwand2" with "HP1") as "Hty1".
+    iDestruct ("Hty" with "[$Hty1]") as "H".
+    iDestruct "H" as "(H & ?)". iFrame.
+  Qed.
+
+  Definition subsume_wand_inst := [instance subsume_wand].
+  Global Existing Instance subsume_wand_inst.
+
+  Lemma simplify_hyp_resolve_wand l (P : A → _) ty T:
+    (∃ x, P x ∗ (l ◁ₗ ty x -∗ T))
+    ⊢ simplify_hyp (l ◁ₗ wand_ex P ty) T.
+  Proof. iDestruct 1 as (x) "[HP HT]". iIntros "Hwand". iApply "HT". by iApply "Hwand". Qed.
+  (* must be before [simplify_goal_place_refine_r] *)
+  Definition simplify_hyp_resolve_wand_inst := [instance simplify_hyp_resolve_wand with 9%N].
+  Global Existing Instance simplify_hyp_resolve_wand_inst.
+
+  Lemma simplify_goal_wand l P ty T:
+    simplify_goal (l ◁ₗ wand_ex P ty) T :-
+    and:
+    | drop_spatial; ∀ x, inhale P x; exhale l ◁ₗ ty x; done
+    | return T.
+  Proof. iIntros "[#Hwand $]".
+         liFromSyntax.
+         iIntros (?) "H1".
+         iDestruct ("Hwand" with "[$H1]") as "H".
+         iDestruct "H" as "(? & ?)". iFrame.
+  Qed.
+  Definition simplify_goal_wand_inst := [instance simplify_goal_wand with 50%N].
+  Global Existing Instance simplify_goal_wand_inst | 50.
+
+End wand.
+Global Typeclasses Opaque wand_ex.
+Notation wand P ty := (wand_ex (A:=unit) (λ _, P) (λ _, ty)).
+Notation "wand< P , ty >" := (wand P ty)
+  (only printing, format "'wand<' P ,  ty '>'") : printing_sugar.
+
+Section wand_val.
+  Context `{!typeG Σ} {cs : compspecs}.
+
+  Context {A : Type}.
+  Implicit Types (P : A → iProp Σ).
+
+  Program Definition wand_val_ex ly P (ty : A → type) : type := {|
+    ty_has_op_type ot mt := ot = ly; 
+    ty_own β l :=
+      ∃ v,  <affine> ⌜field_compatible ly [] l⌝ ∗
+                        <affine> ⌜field_compatible ly [] v ⌝ ∗ l ↦_ly[β] v ∗
+        match β return _ with
+        | Own => ∀ x, P x -∗ v ◁ᵥ (ty x)
+        | Shr => True
+        end;
+     ty_own_val v := (<affine> ⌜field_compatible ly [] v⌝ ∗ ∀ x, P x -∗ v ◁ᵥ (ty x))%I;
+  |}%I.
+  Next Obligation.
+    iIntros (??????) "H". iDestruct "H" as (v) "(Hly1&Hly2&Hl&_)".
+    iMod (heap_mapsto_own_state_share with "Hl") as "Hl". eauto with iFrame.
+  Qed. 
+  Next Obligation. iIntros (??????->) "Hl". iDestruct "Hl" as (?) "[$ _]". Qed.
+  Next Obligation. iIntros (???????) "Hl".
+                   iDestruct "Hl" as (v) "(% & % & Hl1 & Hl2)".
+                   rewrite / heap_mapsto_own_state.
+                   iExists _. iFrame.
+                   simpl in H. rewrite H. by iFrame. Qed.
+  Next Obligation. iIntros (?????????) "Hl".
+                   iIntros "(% & H3)".
+                   rewrite /heap_mapsto_own_state.
+                   iExists _. iFrame.
+                   simpl in H.
+                   rewrite H. iFrame.
+                   iPureIntro.
+                   split; auto.
+                   subst. done. Qed.
+
+  (*
+  Global Instance wand_val_loc_in_bounds P ly β (ty : A → type):
+    LocInBounds (wand_val_ex ly P ty) β (ly_size ly).
+  Proof.
+    constructor. iIntros (l) "Hl". iDestruct "Hl" as (?) "(_&Hly&Hl&_)".
+    iDestruct (heap_mapsto_own_state_loc_in_bounds with "Hl") as "H".
+    by iDestruct "Hly" as %->.
+  Qed.
+  *)
+  
+  Lemma subsume_wand_val B v ly1 ly2 P1 (P2 : B → A → iProp Σ) ty1 ty2 T:
+    (* The trick is that we prove the wand at the very end so it can
+    use all leftover resources. This only works if there is at most
+    one wand per block (but this is enough for iterating over linked
+    lists). *)
+    (∃ z, <affine> ⌜ly1 = ly2 z⌝ ∗ T z ∗ (∀ x, P2 z x -∗ ∃ y, P1 y ∗ (v ◁ᵥ ty1 y -∗ v ◁ᵥ ty2 z x ∗ <affine> True)))
+    ⊢ subsume (v ◁ᵥ wand_val_ex ly1 P1 ty1) (λ z : B, v ◁ᵥ wand_val_ex (ly2 z) (P2 z) (ty2 z)) T.
+  Proof.
+    iIntros "(%&->&?&Hwand) (%&Hty1)". iExists _. iFrame. iSplit; [done|].
+    iIntros (x) "HP2". iDestruct ("Hwand" with "HP2") as (y) "[HP1 Hwand]".
+    iDestruct ("Hty1" with "HP1") as "Hty1". iDestruct ("Hwand" with "Hty1") as "[$ _]". 
+  Qed.
+  Definition subsume_wand_val_inst := [instance subsume_wand_val].
+  Global Existing Instance subsume_wand_val_inst.
+
+  Lemma simplify_hyp_resolve_wand_val v ly P ty T:
+    (∃ x, P x ∗ (v ◁ᵥ ty x -∗ T))
+    ⊢ simplify_hyp (v ◁ᵥ wand_val_ex ly P ty) T.
+  Proof.
+    iDestruct 1 as (x) "[HP HT]". iIntros "[_ Hwand]".
+    iApply "HT". by iApply "Hwand".
+  Qed.
+  (* must be before [simplify_goal_place_refine_r] *)
+  Definition simplify_hyp_resolve_wand_val_inst := [instance simplify_hyp_resolve_wand_val with 9%N].
+  Global Existing Instance simplify_hyp_resolve_wand_val_inst.
+
+  Lemma simplify_goal_wand_val v P ly ty T:
+    simplify_goal (v ◁ᵥ wand_val_ex ly P ty) T :-
+    and:
+    | drop_spatial; ∀ x, inhale P x; exhale v ◁ᵥ ty x; done
+    | exhale (<affine> ⌜field_compatible ly [] v⌝); return T.
+  Proof.
+    iIntros "[#Hwand [% $]]". iSplit; [done|].
+    iIntros (?) "?". iDestruct ("Hwand" with "[$]") as "[H1 H2]". iFrame "H1".
+  Qed.
+  Definition simplify_goal_wand_val_inst := [instance simplify_goal_wand_val with 50%N].
+  Global Existing Instance simplify_goal_wand_val_inst | 50.
+
+End wand_val.
+Global Typeclasses Opaque wand_val_ex.
+Notation wand_val ly P ty := (wand_val_ex (A:=unit) ly (λ _, P) (λ _, ty)).
+Notation "wand_val< ly , P , ty >" := (wand_val ly P ty)
+  (only printing, format "'wand_val<' ly ,  P ,  ty '>'") : printing_sugar.
diff --git a/sepcomp/extspec.v b/sepcomp/extspec.v
index 1eaec1cd28..0b27568e1f 100644
--- a/sepcomp/extspec.v
+++ b/sepcomp/extspec.v
@@ -12,20 +12,20 @@ Definition PTree_injective {A} (t: PTree.t A) : Prop :=
 
 Definition injective_PTree A := sig (@PTree_injective A).
 
-Structure external_specification (M E Z : Type) :=
+Class external_specification (M E Z : Type) :=
   { ext_spec_type : E -> Type
   ; ext_spec_pre: forall e: E,
     ext_spec_type e -> injective_PTree block -> list typ -> list val -> Z -> M -> Prop
   ; ext_spec_post: forall e: E,
     ext_spec_type e -> injective_PTree block -> xtype -> option val -> Z -> M ->  Prop
-  ; ext_spec_exit: option val -> Z -> M ->  Prop }.
+  ; ext_spec_exit: option val -> Z -> M -> Prop }.
 
 Arguments ext_spec_type {M E Z} _ _.
 Arguments ext_spec_pre {M E Z} _ _ _ _ _ _ _ _.
 Arguments ext_spec_post {M E Z} _ _ _ _ _ _ _ _.
 Arguments ext_spec_exit {M E Z} _ _ _ _.
 
-Definition ext_spec := external_specification mem external_function.
+Notation ext_spec := (external_specification mem external_function).
 
 Lemma extfunct_eqdec (ef1 ef2 : external_function) : {ef1=ef2} + {~ef1=ef2}.
 Proof.
diff --git a/sha/call_memcpy.v b/sha/call_memcpy.v
index c914de0a69..0119c0a39a 100644
--- a/sha/call_memcpy.v
+++ b/sha/call_memcpy.v
@@ -4,9 +4,7 @@ Require Import sha.SHA256.
 Require Import sha.spec_sha.
 Require Import sha.sha_lemmas.
 Local Open Scope nat.
-Local Open Scope logic.
 Import LiftNotation.
-Import compcert.lib.Maps.
 
 Lemma Zlength_repeat:
   forall {A} n (x:A), Zlength (repeat x (Z.to_nat n)) = Z.max 0 n.
@@ -21,8 +19,6 @@ rewrite Z.max_r by lia.
 auto.
 Qed.
 
-Import field_at_wand.SegmentHole.
-
 Lemma splice_into_list_simplify0:
   forall {A} n (src dst: list A),
     Zlength src = n ->
@@ -129,7 +125,7 @@ intros. subst tb. apply JMeq_eq in H0. subst lb. auto.
 Qed.
 
  Definition fsig_of_funspec (fs: funspec)  :=
-  match fs with mk_funspec fsig _ _ _ _ _ _=> fsig end.
+  match fs with mk_funspec fsig _ _ _ _ _=> fsig end.
 
 Lemma part1_splice_into_list:
   forall {A} lo hi (al bl: list A),
@@ -190,25 +186,26 @@ Local Arguments nested_field_type cs t gfs : simpl never.
 
 Lemma semax_call_id0_alt:
  forall Espec {cs: compspecs} Delta P Q R id bl argsig tfun retty cc A x Pre Post
-   (GLBL: (var_types Delta) ! id = None),
-       (glob_specs Delta) ! id = Some (NDmk_funspec (argsig, retty) cc A Pre Post) ->
-       (glob_types Delta) ! id = Some (type_of_funspec (NDmk_funspec (argsig, retty) cc A Pre Post)) ->
+   (GLBL: (var_types Delta) !! id = None),
+       (glob_specs Delta) !! id = Some (NDmk_funspec (argsig, retty) cc A Pre Post) ->
+       (glob_types Delta) !! id = Some (type_of_funspec (NDmk_funspec (argsig, retty) cc A Pre Post)) ->
    (*tfun = type_of_params argsig ->*)tfun = argsig ->
-  @semax cs Espec Delta (tc_exprlist Delta argsig bl
-                  && |>((fun rho : environ =>
+  semax(OK_spec := Espec)(C := cs) ⊤ Delta (tc_exprlist Delta argsig bl
+                  && |>(assert_of (fun rho : environ =>
                Pre x (ge_of rho, eval_exprlist argsig bl rho)) *
               PROPx P (LOCALx Q (SEPx R))))
     (Scall None (Evar id (Tfunction tfun retty cc)) bl)
     (normal_ret_assert
-       ((ifvoid retty (`(Post x) (make_args nil nil))
-           (EX v:val, `(Post x) (make_args (ret_temp::nil) (v::nil))))
-         * PROPx P (LOCALx Q (SEPx R)))).
+       ((ifvoid retty (assert_of (`(Post x : environ -> mpred) (make_args nil nil)))
+           (EX v:val, (assert_of (`(Post x : environ -> mpred) (make_args (ret_temp::nil) (v::nil))))))
+         ∗ PROPx P (LOCALx Q (SEPx R)))).
 Proof.
 intros.
 subst tfun.
-eapply (@semax_call_id0 Espec cs Delta P Q R id bl (NDmk_funspec (argsig, retty) cc A Pre Post)
-           argsig retty cc (rmaps.ConstType A) nil x
-                  (fun _ => Pre) (fun _ => Post)); eauto. 
+eapply (semax_call_id0 Delta P Q R id bl (NDmk_funspec (argsig, retty) cc A Pre Post)
+           argsig retty cc (ConstType A) (λne _, ⊤)
+           (λne a : leibnizO A, monPred_at (Pre a) : argsEnviron -d> mpred)
+           (λne a : leibnizO A, monPred_at (Post a) : environ -d> mpred) x); eauto.
 apply funspec_sub_refl.
 Qed.
 
@@ -225,9 +222,9 @@ Lemma call_memcpy_tuchar:  (* Uses CompSpecs from sha. *)
       typeof e_p = tptr tuchar ->
       typeof e_q = tptr tuchar ->
       typeof e_n = tuint ->
-      (var_types Delta) ! _memcpy = None ->
-     (glob_specs Delta) ! _memcpy = Some (snd memcpy_spec) ->
-     (glob_types Delta) ! _memcpy = Some (type_of_funspec (snd memcpy_spec)) ->
+      (var_types Delta) !! _memcpy = None ->
+     (glob_specs Delta) !! _memcpy = Some (snd memcpy_spec) ->
+     (glob_types Delta) !! _memcpy = Some (type_of_funspec (snd memcpy_spec)) ->
      writable_share shp ->  readable_share shq ->
      nested_field_type tp pathp = tarray tuchar np ->
      nested_field_type tq pathq = tarray tuchar nq ->
@@ -245,7 +242,7 @@ Lemma call_memcpy_tuchar:  (* Uses CompSpecs from sha. *)
          local (`(eq (Vint (Int.repr len))) (eval_expr e_n)) &&
          PROP () (LOCALx Q (SEPx (field_at shp tp pathp vp p ::
                                                  field_at shq tq pathq vq q :: R'))) ->
-   @semax _ Espec Delta
+   semax(OK_spec := Espec) ⊤ Delta
     (PROPx P (LOCALx Q (SEPx R)))
     (Scall None
              (Evar _memcpy
@@ -259,7 +256,7 @@ Lemma call_memcpy_tuchar:  (* Uses CompSpecs from sha. *)
 Proof.
 intros until R.
 intros TCp TCq TCn Hvar Hspec Hglob ? SHq ? ? Hlop Hlen Hnp Hloq Hnq; intros.
-assert_PROP (fold_right and True P); [ go_lowerx; entailer! | ].
+assert_PROP (fold_right and True%type P); [ go_lowerx; entailer! | ].
 apply semax_post' with
    (PROPx nil   (LOCALx Q
            (SEPx
@@ -303,89 +300,83 @@ pose (witness := ((shq,shp),
                               field_address0 tq (ArraySubsc loq :: pathq) q,
                               len,  sublist loq (loq+len) contents)).
 pose (Frame :=
-        array_with_hole shq tuchar loq (loq + len) nq (map Vint contents) (field_address tq pathq q)
-          :: array_with_hole shp tuchar lop (lop + len) np vp' (field_address tp pathp p) :: R').
+        array_with_segment_hole shq tuchar loq (loq + len) nq (map Vint contents) (field_address tq pathq q)
+          :: array_with_segment_hole shp tuchar lop (lop + len) np vp' (field_address tp pathp p) :: R').
 eapply semax_pre_post';
   [ | | eapply semax_call_id0_alt with (x:=witness)(P:=nil)(Q:=Q);
        try eassumption;
        try (rewrite ?Hspec, ?Hglob; reflexivity)].
 
 * unfold convertPre. simpl fst; simpl snd.
- rewrite <- (andp_dup (local (tc_environ _))), andp_assoc.
- eapply derives_trans; [ apply andp_derives; [apply derives_refl | apply Hpre] | ].
- rewrite !andp_assoc.
- apply andp_right; [apply andp_left2, andp_left1, derives_refl |].
- eapply derives_trans; [ | apply now_later].
- assert_PROP (field_address0 tp (pathp SUB lop) p <> Vundef) as DEFp.
- {
+  iIntros "(#TC & H)".
+  iPoseProof (Hpre with "[$]") as "H".
+  iSplit; first by rewrite !bi.and_elim_l.
+  iNext.
+  iAssert ⌜field_address0 tp (pathp SUB lop) p <> Vundef⌝ as %DEFp.
+  {
    unfold tc_exprlist.
    simpl typecheck_exprlist.
    rewrite !denote_tc_assert_andp.
-   apply derives_trans with (local (tc_environ Delta) && denote_tc_assert (typecheck_expr Delta e_p) && local ((` (eq (field_address0 tp (pathp SUB lop) p))) (eval_expr e_p))); [solve_andp |].
-   go_lowerx.
+   iAssert (denote_tc_assert (typecheck_expr Delta e_p) && local ((` (eq (field_address0 tp (pathp SUB lop) p))) (eval_expr e_p))) with "[H]" as "H".
+   { iClear "TC"; iStopProof; solve_andp. }
+   iDestruct "TC" as "-#TC".
+   iCombine "TC" "H" as "?".
+   rewrite <- bi.persistent_and_affinely_sep_l by apply _.
+   iStopProof.
+   go_lowerx; simpl.
    eapply derives_trans; [apply typecheck_expr_sound; auto |].
-   apply prop_derives; intros.
+   apply bi.pure_mono; intros.
    rewrite <- H7 in H8.
    intro.
    rewrite H9 in H8.
    revert H8; apply tc_val_Vundef.
  }
- assert_PROP (field_address0 tq (pathq SUB loq) q <> Vundef) as DEFq.
+ iAssert ⌜field_address0 tq (pathq SUB loq) q <> Vundef⌝ as %DEFq.
  {
    unfold tc_exprlist.
    simpl typecheck_exprlist.
    rewrite !denote_tc_assert_andp.
-   apply derives_trans with (local (tc_environ Delta) && denote_tc_assert (typecheck_expr Delta e_q) && local ((` (eq (field_address0 tq (pathq SUB loq) q))) (eval_expr e_q))); [solve_andp |].
+   iAssert (denote_tc_assert (typecheck_expr Delta e_q) && local ((` (eq (field_address0 tq (pathq SUB loq) q))) (eval_expr e_q))) with "[H]" as "H".
+   { iClear "TC"; iStopProof; solve_andp. }
+   iDestruct "TC" as "-#TC".
+   iCombine "TC" "H" as "?".
+   rewrite <- bi.persistent_and_affinely_sep_l by apply _.
+   iStopProof.
    go_lowerx.
    eapply derives_trans; [apply typecheck_expr_sound; auto |].
-   apply prop_derives; intros.
+   apply bi.pure_mono; intros.
    rewrite <- H7 in H8.
    intro.
    rewrite H9 in H8.
    revert H8; apply tc_val_Vundef.
  }
- apply andp_left2, andp_left2.
  subst witness. cbv beta iota. simpl @fst; simpl @snd.
  clear Hpre.
- autorewrite with norm1 norm2. 
- instantiate (1:=Frame). simpl. unfold env_set, local, lift1, liftx, lift. simpl. intros tau. entailer!. 
-
-(* rewrite PROP_combine.*)
-(* unfold app at 1.*)
-(* instantiate (1:=Frame).
- unfold app at 2.
- go_lowerx.
- apply andp_right.
- apply prop_right.
- unfold make_args'. simpl.
- unfold eval_id, env_set.*)
+ instantiate (1:=Frame).
+ iDestruct "TC" as "-#TC".
+ iCombine "TC" "H" as "?".
+ rewrite <- bi.persistent_and_affinely_sep_l by apply _.
+ iStopProof.
+ unfold env_set, PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx; split => tau; monPred.unseal; unfold lift1; unfold_lift.
  rewrite TCp, TCq, TCn.  simpl.
- unfold_lift; simpl.
- (*rewrite <- H6, <- H7, <- H8.*)
- normalize. unfold PROPx, LOCALx, SEPx, local, liftx, lift1, lift. simpl. unfold liftx, lift. simpl. normalize.
  
  try rewrite sem_cast_i2i_correct_range by (rewrite <- H8; auto).
-(* split3; try (repeat split; auto; congruence).*)
- apply andp_right.
- { apply prop_right; split3; auto. repeat split; trivial.  congruence.  }
- subst Frame.
+ entailer!!.
+ rewrite bi.and_elim_r.
  cancel.
  rewrite !field_at_data_at.
  rewrite (data_at_type_changable _ _ _ _ _ H0 H3).
  rewrite (data_at_type_changable _ _ _ _ _ H1 H2).
- sep_apply (array_with_hole_intro shp tuchar lop (lop + len) (*np*)(Zlength vp') vp' (field_address tp pathp p)); [lia | ].
- sep_apply (array_with_hole_intro shq tuchar loq (loq + len) (*nq*)(Zlength contents)  (map Vint contents) (field_address tq pathq q)); [lia | ].
+ sep_apply (array_with_segment_hole_intro shp tuchar lop (lop + len) (*np*)(Zlength vp') vp' (field_address tp pathp p)); [lia | ].
+ sep_apply (array_with_segment_hole_intro shq tuchar loq (loq + len) (*nq*)(Zlength contents)  (map Vint contents) (field_address tq pathq q)); [lia | ].
  cancel.
  apply sepcon_derives.
- - apply derives_refl'.
-   rewrite <- H1.
+ - rewrite <- H1.
    rewrite <- field_address0_app by congruence.
    simpl app.
-   apply equal_f.
-   apply data_at_type_changable.
-   + f_equal; clear; lia.
-   + rewrite <- sublist_map.
-     apply JMeq_sublist; auto.
+   replace (loq + len - loq)%Z with len by lia.
+   rewrite sublist_map.
+   auto.
  - replace (memory_block shp len) with
      (memory_block shp (sizeof (nested_field_array_type tp pathp lop (lop + len)))).
    2: {
@@ -401,7 +392,7 @@ eapply semax_pre_post';
    rewrite nested_field_type_ind, H0.
    apply data_at_data_at_.
  *
- intros. apply andp_left2.
+ intros. rewrite bi.and_elim_r.
  go_lowerx. unfold_lift.
  simpl.
  Intros x. rewrite prop_true_andp by auto.
@@ -410,7 +401,7 @@ eapply semax_pre_post';
  normalize in H7.
  subst x.
  simpl.
- clear Hpre H6 P Q rho .
+ clear Hpre H6 P Q rho.
 assert (exists (vpy : list (reptype (nested_field_type tp (ArraySubsc 0 :: pathp)))),
                   JMeq vp'' vpy)
   by (rewrite H99; eauto).
@@ -436,24 +427,20 @@ erewrite (data_at_type_changable shq _ (tarray tuchar (loq + len - loq)));
 [| f_equal; lia | apply JMeq_refl].
 erewrite (data_at_type_changable shp _ (tarray tuchar (lop + len - lop)));
 [| f_equal; lia | apply JMeq_refl].
-sep_apply (array_with_hole_elim shp tuchar lop (lop + len) np (sublist loq (loq + len) (map Vint contents)) vp' (field_address tp pathp p)).
-sep_apply (array_with_hole_elim shq tuchar loq (loq + len) nq (sublist loq (loq + len) (map Vint contents)) (map Vint contents) (field_address tq pathq q)).
+sep_apply (array_with_segment_hole_elim shp tuchar lop (lop + len) np (sublist loq (loq + len) (map Vint contents)) vp' (field_address tp pathp p)).
+sep_apply (array_with_segment_hole_elim shq tuchar loq (loq + len) nq (sublist loq (loq + len) (map Vint contents)) (map Vint contents) (field_address tq pathq q)).
 rewrite !field_at_data_at.
-rewrite sepcon_comm.
+rewrite <- sepcon_comm.
 apply sepcon_derives.
-- apply derives_refl'.
-  apply equal_f.
-  apply data_at_type_changable; auto.
-- apply derives_refl'.
-  apply equal_f.
-  apply data_at_type_changable; auto.
+- erewrite data_at_type_changable; auto.
+- erewrite data_at_type_changable; auto.
   eapply JMeq_trans; [| apply JMeq_sym, H2].
   apply eq_JMeq.
   apply splice_into_list_self.
   { lia. }
   { autorewrite with sublist. lia. }
 Qed.
-     
+
 Lemma call_memset_tuchar:
   forall (shp : share) (tp: type) (pathp: list gfield) (lop: Z) (vp': list val) (p: val)
            (c: int) (len : Z)
@@ -465,9 +452,9 @@ Lemma call_memset_tuchar:
    (TCp : typeof e_p = tptr tuchar)
    (TCc : typeof e_c = tint)
    (TCn : typeof e_n = Tint I32 s noattr)
-   (Hvar : (var_types Delta) ! _memset = None)
-   (Hspec : (glob_specs Delta) ! _memset = Some (snd memset_spec))
-   (Hglob : (glob_types Delta) ! _memset =
+   (Hvar : (var_types Delta) !! _memset = None)
+   (Hspec : (glob_specs Delta) !! _memset = Some (snd memset_spec))
+   (Hglob : (glob_types Delta) !! _memset =
         Some (type_of_funspec (snd memset_spec)))
    (H:  writable_share shp)
    (Hlop : (0 <= lop)%Z)
@@ -482,7 +469,7 @@ Lemma call_memset_tuchar:
          local (`(eq (Vint c)) (eval_expr e_c)) &&
          local (`(eq (Vint (Int.repr len))) (eval_expr e_n)) &&
          PROP () (LOCALx Q (SEPx (field_at shp tp pathp vp p :: R')))),
-   @semax _ Espec Delta
+   semax(OK_spec := Espec) ⊤ Delta
     (PROPx P (LOCALx Q (SEPx R)))
     (Scall None
              (Evar _memset
@@ -494,7 +481,7 @@ Lemma call_memset_tuchar:
      (SEPx (field_at shp tp pathp vp'' p :: R'))))).
 Proof.
 intros.
-assert_PROP (fold_right and True P)
+assert_PROP (fold_right and True%type P)
   by (go_lowerx; entailer!).
 apply semax_post' with
    (PROPx nil   (LOCALx Q
@@ -557,51 +544,41 @@ eapply semax_pre_post';
        try eassumption;
        try (rewrite ?Hspec, ?Hglob; reflexivity)].
 * unfold convertPre. simpl fst; simpl snd.
- rewrite <- (andp_dup (local (tc_environ _))), andp_assoc.
- eapply derives_trans; [ apply andp_derives; [apply derives_refl | apply Hpre] | ].
- rewrite !andp_assoc.
- apply andp_right; [apply andp_left2, andp_left1, derives_refl |].
- eapply derives_trans; [ | apply now_later].
- assert_PROP (field_address0 tp (pathp SUB lop) p <> Vundef) as DEFp.
+ iIntros "(#TC & ?)".
+ iPoseProof (Hpre with "[$]") as "H".
+ iSplit; first by rewrite !bi.and_elim_l.
+ iNext.
+ iAssert ⌜field_address0 tp (pathp SUB lop) p <> Vundef⌝ as %DEFp.
  {
    unfold tc_exprlist.
    simpl typecheck_exprlist.
    rewrite !denote_tc_assert_andp.
+   iDestruct "TC" as "-#TC".
+   iStopProof; rewrite <- bi.persistent_and_affinely_sep_r by apply _.
    apply derives_trans with (local (tc_environ Delta) && denote_tc_assert (typecheck_expr Delta e_p) && local ((` (eq (field_address0 tp (pathp SUB lop) p))) (eval_expr e_p))); [solve_andp |].
    go_lowerx.
    eapply derives_trans; [apply typecheck_expr_sound; auto |].
-   apply prop_derives; intros.
-   rewrite <- H2 in H6.
+   apply bi.pure_mono; intros.
+   rewrite <- H1 in H6.
    intro.
    rewrite H7 in H6.
    revert H6; apply tc_val_Vundef.
  }
- apply andp_left2, andp_left2.
+ iDestruct "TC" as "-#TC".
+ iStopProof; rewrite <- bi.persistent_and_affinely_sep_r by apply _.
  subst witness. cbv beta iota. simpl @fst; simpl @snd.
  clear Hpre.
  autorewrite with norm1 norm2.
 
- instantiate (1:=Frame). simpl. unfold env_set, local, lift1, liftx, lift. simpl. intros tau. entailer!.
-
-(* rewrite PROP_combine.*)
-(* unfold app at 1.*)
-(* instantiate (1:=Frame).
- unfold app at 2.
- go_lowerx.
- apply andp_right.
- apply prop_right.
- unfold make_args'. simpl.
- unfold eval_id, env_set.*)
+ instantiate (1:=Frame). simpl.
+ unfold env_set, PROPx, PARAMSx, GLOBALSx, LOCALx, SEPx; split => tau; monPred.unseal; unfold lift1; unfold_lift.
  rewrite TCp, TCc, TCn.  simpl.
- (*rewrite <- H6, <- H7, <- H8.*)
- unfold PROPx, LOCALx, SEPx, local, liftx, lift1, lift. simpl. unfold liftx, lift. simpl. normalize.
  
 (* split3; try (repeat split; auto; congruence).*)
  try rewrite sem_cast_i2i_correct_range by (rewrite <- H2; auto).
  try rewrite sem_cast_i2i_correct_range by (rewrite <- H6; auto).
- apply andp_right.
- { apply prop_right; split3; auto. repeat split; trivial; congruence. }
- subst Frame.
+ entailer!!.
+ rewrite bi.and_elim_r.
  cancel. (*
  rewrite !field_at_data_at.
  rewrite (data_at_type_changable _ _ _ _ _ H0 H3).
@@ -627,7 +604,7 @@ eapply semax_pre_post';
  rewrite array_at_data_at' by  (try solve [clear - FC; intuition]; lia).
  eapply derives_trans; [apply data_at_data_at_ | ].
  eapply derives_trans; [apply data_at__memory_block_cancel | ].
- apply derives_refl'; f_equal.
+ f_equiv.
   unfold nested_field_array_type.
    rewrite nested_field_type_ind, H0. simpl.
   rewrite Z.max_r by lia. lia.
@@ -637,12 +614,8 @@ eapply semax_pre_post';
  Intros v. subst witness. cbv beta zeta iota.
  clear Hpre.
  autorewrite with norm1 norm2.
- rewrite PROP_combine.
- unfold app at 1.
  subst Frame.
- simpl map.
- go_lowerx. normalize.
- cancel.
+ go_lowerx. entailer!!.
  clear H1 H2.
  assert (H2: exists (vpy : list (reptype (nested_field_type tp (ArraySubsc 0 :: pathp)))),
                   JMeq vp'' vpy).
@@ -652,6 +625,7 @@ erewrite field_at_Tarray; try eassumption; auto; try lia.
 apply (JMeq_trans (JMeq_sym H4)) in H8.
 clear dependent vp''. clear dependent e_c. clear dependent e_p. clear dependent e_n.
 clear dependent Delta.
+remember (Zlength vp') as np eqn: Hvp'.
 assert (Zlength vpy = np). {
 clear - H0 H8 Hvp' Hnp Hlop Hlen.
 generalize dependent vpy.
@@ -689,8 +663,7 @@ rewrite Zlength_repeat. rewrite Z.max_r by lia. lia.
 } 
 cancel.
  rewrite array_at_data_at' by  (try solve [clear - FC; intuition]; lia).
-   apply derives_refl'.
-   apply equal_f. apply data_at_type_changable.
+   erewrite data_at_type_changable; eauto.
    unfold nested_field_array_type.
    rewrite nested_field_type_ind, H0.
    unfold tarray; f_equal. clear; lia.
@@ -700,4 +673,3 @@ cancel.
    unfold splice_into_list.
    autorewrite with sublist. auto.
 Qed.
-
diff --git a/sha/protocol_spec_hmac.v b/sha/protocol_spec_hmac.v
index 6ae14f91ac..15a9d1f7e6 100644
--- a/sha/protocol_spec_hmac.v
+++ b/sha/protocol_spec_hmac.v
@@ -1,6 +1,5 @@
 Require Import VST.floyd.proofauto.
 Import ListNotations.
-Local Open Scope logic.
 
 Require Import sha.spec_sha.
 Require Import sha.sha_lemmas.
@@ -76,12 +75,12 @@ Definition hmac_reset_spec :=
   DECLARE _HMAC_Init (*Naphat: you'll probably have DECLARE mbedtls_hmac_reset here, and the
                        body of your wrapper function is a call to hmac_init with key==null.*)
    WITH c : val, sh: share, l:Z, key:list byte, gv: globals
-   PRE [ _ctx OF tptr t_struct_hmac_ctx_st,
-         _key OF tptr tuchar,
-         _len OF tint ]
+   PRE [ tptr t_struct_hmac_ctx_st,
+         tptr tuchar,
+         tint ]
          PROP (writable_share sh)
-         LOCAL (temp _ctx c; temp _key nullval; temp _len (Vint (Int.repr l));
-                gvars gv)
+         PARAMS (c; nullval; Vint (Int.repr l))
+         GLOBALS (gv)
          SEP (FULL sh key c; K_vector gv)
   POST [ tvoid ] 
      PROP ()
@@ -92,14 +91,14 @@ Definition hmac_starts_spec :=
   DECLARE _HMAC_Init (*Naphat: you'll probably have DECLARE mbedtls_hmac_starts here, and the
                        body of your wrapper function is a call to hmac_init with the nonnull key*)
    WITH c : val, sh: share, l:Z, key:list byte, b:block, i:ptrofs, shk: share, gv: globals
-   PRE [ _ctx OF tptr t_struct_hmac_ctx_st,
-         _key OF tptr tuchar,
-         _len OF tint ]
+   PRE [ tptr t_struct_hmac_ctx_st,
+         tptr tuchar,
+         tint ]
          PROP (writable_share sh; readable_share shk; has_lengthK l key)
-         LOCAL (temp _ctx c; temp _key (Vptr b i); temp _len (Vint (Int.repr l));
-                gvars gv)
+         PARAMS (c; Vptr b i; Vint (Int.repr l))
+         GLOBALS (gv)
          SEP (EMPTY sh c; data_block shk key (Vptr b i); K_vector gv)
-  POST [ tvoid ] 
+  POST [ tvoid ]
      PROP ()
      LOCAL ()
      SEP (REP sh (hABS key nil) c; data_block shk key (Vptr b i); K_vector gv).
@@ -107,17 +106,17 @@ Definition hmac_starts_spec :=
 Definition hmac_update_spec :=
   DECLARE _HMAC_Update
    WITH key: list byte, c : val, shc: share, d:val, shd: share, data:list byte, data1:list byte, gv:globals
-   PRE [ _ctx OF tptr t_struct_hmac_ctx_st, 
-         _data OF tptr tvoid, 
-         _len OF tuint]
+   PRE [ tptr t_struct_hmac_ctx_st, 
+         tptr tvoid, 
+         tuint]
          PROP (writable_share shc; readable_share shd;
                    0 <= Zlength data1 <= Int.max_unsigned /\
                Zlength data1 + Zlength data + 64 < two_power_pos 61) 
-         LOCAL (temp _ctx c; temp _data d; temp  _len (Vint (Int.repr (Zlength data1)));
-                gvars gv)
+         PARAMS (c; d; Vint (Int.repr (Zlength data1)))
+         GLOBALS (gv)
          SEP(REP shc (hABS key data) c; data_block shd data1 d; K_vector gv)
-  POST [ tvoid ] 
-          PROP () 
+  POST [ tvoid ]
+          PROP ()
           LOCAL ()
           SEP(REP shc (hABS key (data++data1)) c; 
               data_block shd data1 d; K_vector gv).
@@ -125,15 +124,15 @@ Definition hmac_update_spec :=
 Definition hmac_final_spec :=
   DECLARE _HMAC_Final
    WITH data:list byte, key:list byte, c : val, sh: share, md:val, shmd: share, gv:globals
-   PRE [ _ctx OF tptr t_struct_hmac_ctx_st,
-         _md OF tptr tuchar ]
+   PRE [ tptr t_struct_hmac_ctx_st,
+         tptr tuchar ]
        PROP (writable_share sh; writable_share shmd) 
-       LOCAL (temp _md md; temp _ctx c;
-              gvars gv)
+       PARAMS (c; md)
+       GLOBALS (gv)
        SEP(REP sh (hABS key data) c; K_vector gv;
            memory_block shmd 32 md)
-  POST [ tvoid ] 
-          PROP () 
+  POST [ tvoid ]
+          PROP ()
           LOCAL ()
           SEP(K_vector gv; FULL sh key c;
               data_block shmd (HMAC256 data key) md).
@@ -142,12 +141,12 @@ Definition hmac_final_spec :=
 Definition hmac_cleanup_spec :=
   DECLARE _HMAC_cleanup
    WITH key: list byte, c : val, sh: share
-   PRE [ _ctx OF tptr t_struct_hmac_ctx_st ]
+   PRE [ tptr t_struct_hmac_ctx_st ]
          PROP (writable_share sh) 
-         LOCAL (temp _ctx c)
+         PARAMS (c)
          SEP(FULL sh key c)
-  POST [ tvoid ]  
-          PROP () 
+  POST [ tvoid ]
+          PROP ()
           LOCAL ()
           SEP(EMPTY sh c).
 
@@ -156,27 +155,25 @@ Definition hmac_crypto_spec :=
    WITH md: val, KEY:DATA, shk: share,
         msg: val, MSG:DATA, shm: share,
         shmd: share, b:block, i:ptrofs, gv: globals
-   PRE [ _key OF tptr tuchar,
-         _key_len OF tint,
-         _d OF tptr tuchar,
-         _n OF tint,
-         _md OF tptr tuchar ]
+   PRE [ tptr tuchar,
+         tint,
+         tptr tuchar,
+         tint,
+         tptr tuchar ]
          PROP (readable_share shk; readable_share shm; writable_share shmd; 
                has_lengthK (LEN KEY) (CONT KEY);
                has_lengthD 512 (LEN MSG) (CONT MSG))
-         LOCAL (temp _md md; temp _key (Vptr b i);
-                temp _key_len (Vint (Int.repr (LEN KEY)));
-                temp _d msg; temp _n (Vint (Int.repr (LEN MSG)));
-                gvars gv)
-         SEP(data_block shk (CONT KEY) (Vptr b i); 
-             data_block shm (CONT MSG) msg; 
+         PARAMS (Vptr b i; Vint (Int.repr (LEN KEY)); msg; Vint (Int.repr (LEN MSG)); md)
+         GLOBALS (gv)
+         SEP(data_block shk (CONT KEY) (Vptr b i);
+             data_block shm (CONT MSG) msg;
              memory_block shmd 32 md;
              K_vector gv)
-  POST [ tptr tuchar ] 
+  POST [ tptr tuchar ]
          EX digest:_,
           PROP (digest= HMAC256 (CONT MSG) (CONT KEY) /\
-                ByteBitRelations.bytesToBits digest = 
-                verif_hmac_crypto.bitspec KEY MSG /\ 
+                ByteBitRelations.bytesToBits digest =
+                verif_hmac_crypto.bitspec KEY MSG /\
                 forall A Awf, CRYPTO A Awf)
           LOCAL (temp ret_temp md)
           SEP(K_vector gv;
@@ -207,7 +204,7 @@ End HMAC_ABSTRACT_SPEC.
 
 
 Lemma haslengthK_simple: forall l, 0 < l <= Int.max_signed -> l * 8 < two_p 64.
-intros. 
+intros.
 assert (l < Int.half_modulus). unfold Int.max_signed in H. lia. clear H.
 rewrite Int.half_modulus_power in H0. 
 assert (Int.zwordsize = 32) by reflexivity. rewrite H in *; clear H. simpl in *.
@@ -270,7 +267,7 @@ Proof. unfold REP, FULL. Intros r.
   Exists (hmacUpdate data (hmacInit key)) r (fst r).
   apply andp_right.
     apply prop_right. simpl. intuition.
-  apply derives_refl'. f_equal. destruct r as [md [IS OS]]. simpl. reflexivity.
+  f_equiv. destruct r as [md [IS OS]]. simpl. reflexivity.
 Qed.
 
 Lemma FULL_EMPTY sh key c: FULL sh key c |-- EMPTY sh c.
@@ -302,14 +299,14 @@ Qed.
 Definition hmac_reset_spec :=
   DECLARE _HMAC_Init
    WITH c : val, sh: share, l:Z, key:list byte, gv: globals (*, d:list Z*)
-   PRE [ _ctx OF tptr t_struct_hmac_ctx_st,
-         _key OF tptr tuchar,
-         _len OF tint ]
+   PRE [ tptr t_struct_hmac_ctx_st,
+         tptr tuchar,
+         tint ]
          PROP (writable_share sh)
-         LOCAL (temp _ctx c; temp _key nullval; temp _len (Vint (Int.repr l));
-                gvars gv)
+         PARAMS (c; nullval; Vint (Int.repr l))
+         GLOBALS (gv)
          SEP (FULL sh key c; K_vector gv)
-  POST [ tvoid ] 
+  POST [ tvoid ]
      PROP ()
      LOCAL ()
      SEP (REP sh (hABS key nil) c; K_vector gv).
@@ -317,14 +314,14 @@ Definition hmac_reset_spec :=
 Definition hmac_starts_spec :=
   DECLARE _HMAC_Init
    WITH c : val, sh: share, l:Z, key:list byte, b:block, i:ptrofs, shk: share, gv: globals
-   PRE [ _ctx OF tptr t_struct_hmac_ctx_st,
-         _key OF tptr tuchar,
-         _len OF tint ]
+   PRE [ tptr t_struct_hmac_ctx_st,
+         tptr tuchar,
+         tint ]
          PROP (writable_share sh; readable_share shk; has_lengthK l key)
-         LOCAL (temp _ctx c; temp _key (Vptr b i); temp _len (Vint (Int.repr l));
-                gvars gv)
+         PARAMS (c; Vptr b i; Vint (Int.repr l))
+         GLOBALS (gv)
          SEP (EMPTY sh c; data_block shk key (Vptr b i); K_vector gv)
-  POST [ tvoid ] 
+  POST [ tvoid ]
      PROP ()
      LOCAL ()
      SEP (REP sh (hABS key nil) c; data_block shk key (Vptr b i); K_vector gv).
@@ -332,17 +329,17 @@ Definition hmac_starts_spec :=
 Definition hmac_update_spec :=
   DECLARE _HMAC_Update
    WITH key: list byte, c : val, shc: share, d:val, shd: share, data:list byte, data1:list byte, gv: globals
-   PRE [ _ctx OF tptr t_struct_hmac_ctx_st, 
-         _data OF tptr tvoid, 
-         _len OF tuint]
+   PRE [ tptr t_struct_hmac_ctx_st,
+         tptr tvoid, 
+         tuint]
          PROP (writable_share shc; readable_share shd;
                0 <= Zlength data1 <= Int.max_unsigned /\
-               Zlength data1 + Zlength data + 64 < two_power_pos 61) 
-         LOCAL (temp _ctx c; temp _data d; temp  _len (Vint (Int.repr (Zlength data1)));
-                gvars gv)
+               Zlength data1 + Zlength data + 64 < two_power_pos 61)
+         PARAMS (c; d; Vint (Int.repr (Zlength data1)))
+         GLOBALS (gv)
          SEP(REP shc (hABS key data) c; data_block shd data1 d; K_vector gv)
-  POST [ tvoid ] 
-          PROP () 
+  POST [ tvoid ]
+          PROP ()
           LOCAL ()
           SEP(REP shc (hABS key (data++data1)) c; 
               data_block shd data1 d; K_vector gv).
@@ -350,15 +347,15 @@ Definition hmac_update_spec :=
 Definition hmac_final_spec :=
   DECLARE _HMAC_Final
    WITH data:list byte, key:list byte, c : val, sh: share, md:val, shmd: share, gv: globals
-   PRE [ _ctx OF tptr t_struct_hmac_ctx_st,
-         _md OF tptr tuchar ]
-       PROP (writable_share sh; writable_share shmd) 
-       LOCAL (temp _md md; temp _ctx c;
-              gvars gv)
+   PRE [ tptr t_struct_hmac_ctx_st,
+         tptr tuchar ]
+       PROP (writable_share sh; writable_share shmd)
+       PARAMS (c; md)
+       GLOBALS (gv)
        SEP(REP sh (hABS key data) c; K_vector gv;
            memory_block shmd 32 md)
-  POST [ tvoid ] 
-          PROP () 
+  POST [ tvoid ]
+          PROP ()
           LOCAL ()
           SEP(K_vector gv;
               FULL sh key c;
@@ -367,12 +364,12 @@ Definition hmac_final_spec :=
 Definition hmac_cleanup_spec :=
   DECLARE _HMAC_cleanup
    WITH key: list byte, c : val, sh: share
-   PRE [ _ctx OF tptr t_struct_hmac_ctx_st ]
+   PRE [ tptr t_struct_hmac_ctx_st ]
          PROP (writable_share sh) 
-         LOCAL (temp _ctx c)
+         PARAMS (c)
          SEP(FULL sh key c)
-  POST [ tvoid ]  
-          PROP () 
+  POST [ tvoid ]
+          PROP ()
           LOCAL ()
           SEP(EMPTY sh c).
 
@@ -381,27 +378,27 @@ Definition hmac_crypto_spec :=
    WITH md: val, KEY:DATA, shk: share,
         msg: val, MSG:DATA, shm: share,
         shmd: share, b:block, i:ptrofs, gv: globals
-   PRE [ _key OF tptr tuchar,
-         _key_len OF tint,
-         _d OF tptr tuchar,
-         _n OF tint,
-         _md OF tptr tuchar ]
+   PRE [ tptr tuchar,
+         tint,
+         tptr tuchar,
+         tint,
+         tptr tuchar ]
          PROP (readable_share shk; readable_share shm; writable_share shmd; 
                has_lengthK (LEN KEY) (CONT KEY);
                has_lengthD 512 (LEN MSG) (CONT MSG))
-         LOCAL (temp _md md; temp _key (Vptr b i);
-                temp _key_len (Vint (Int.repr (LEN KEY)));
-                temp _d msg; temp _n (Vint (Int.repr (LEN MSG)));
-                gvars gv)
-         SEP(data_block shk (CONT KEY) (Vptr b i); 
-             data_block shm (CONT MSG) msg; 
+         PARAMS (Vptr b i;
+                Vint (Int.repr (LEN KEY));
+                msg; Vint (Int.repr (LEN MSG)); md)
+         GLOBALS (gv)
+         SEP(data_block shk (CONT KEY) (Vptr b i);
+             data_block shm (CONT MSG) msg;
              memory_block shmd 32 md;
              K_vector gv)
-  POST [ tptr tuchar ] 
+  POST [ tptr tuchar ]
          EX digest:_,
           PROP (digest= HMAC256 (CONT MSG) (CONT KEY) /\
-                ByteBitRelations.bytesToBits digest = 
-                verif_hmac_crypto.bitspec KEY MSG /\ 
+                ByteBitRelations.bytesToBits digest =
+                verif_hmac_crypto.bitspec KEY MSG /\
                 forall A Awf, CRYPTO A Awf)
           LOCAL (temp ret_temp md)
           SEP(K_vector gv;
@@ -473,7 +470,7 @@ unfold REP, abs_relate. Intros r.
 destruct H as [mREL [iREL [oREL [iLEN oLEN]]]].
 eapply semax_pre_post.
   6: apply (finalbodyproof Espec c md sh shmd gv buf (hmacUpdate data (hmacInit key)) SH SH0).
-  
+
   apply andp_left2. unfold hmacstate_. Exists r. go_lowerx. entailer!.
 +
   intros. apply andp_left2.
@@ -512,7 +509,7 @@ eapply semax_pre_post.
   rewrite Zlength_app, Zlength_mkArgZ, mkKey_length, Nat.min_id.
   simpl. rewrite (Z.add_comm 64), <- Z.mul_add_distr_r, Z.add_assoc. 
   assert (Tpp: (two_power_pos 64 = two_power_pos 61 * 8)%Z) by reflexivity.
-  rewrite Tpp.  
+  rewrite Tpp.
   apply Zmult_lt_compat_r. lia. trivial. 
 Qed.  
 
@@ -554,13 +551,14 @@ eapply semax_pre_post.
   subst POSTCONDITION; unfold abbreviate; simpl_ret_assert.
   Opaque repeat. go_lowerx. Transparent repeat.
   normalize.
-  unfold EMPTY. 
+  cancel.
+  unfold EMPTY.
   rewrite <- memory_block_data_at_.  unfold data_block.
   clear. simpl. apply data_at_memory_block.
   trivial.
 + simpl_ret_assert; normalize.
 + simpl_ret_assert; normalize.
 + simpl_ret_assert; normalize.
-Qed. 
+Qed.
 
 End OPENSSL_HMAC_ABSTRACT_SPEC.
diff --git a/sha/sha_lemmas.v b/sha/sha_lemmas.v
index 3831f93c15..074f8fb67a 100644
--- a/sha/sha_lemmas.v
+++ b/sha/sha_lemmas.v
@@ -7,8 +7,6 @@ Require Export sha.general_lemmas.
 Require Export sha.vst_lemmas.
 Export ListNotations.
 
-Local Open Scope logic.
-
 Global Opaque K256.
 
 Transparent peq.
@@ -17,14 +15,14 @@ Lemma mapsto_tc_val:
   forall sh t p v,
   readable_share sh ->
   v <> Vundef ->
-  mapsto sh t p v = !! tc_val t v && mapsto sh t p v .
+  mapsto sh t p v ⊣⊢ !! tc_val t v && mapsto sh t p v .
 Proof.
 intros.
 apply pred_ext; [ | normalize].
 apply andp_right; auto.
 unfold mapsto; simpl.
 destruct (access_mode t); try apply FF_left.
-destruct (attr_volatile (attr_of_type t)); try apply FF_left.
+destruct (type_is_volatile t); try apply FF_left.
 destruct p; try apply FF_left.
 if_tac; try contradiction. apply orp_left.
 normalize.
@@ -98,7 +96,6 @@ rewrite firstn_intlist_to_bytelist.
 rewrite intlist_to_bytelist_to_intlist.
 clear H0.
 revert bl H; induction i; destruct bl; simpl; intros; inv H; auto.
-rewrite (IHi _ H1). reflexivity.
 Qed.
 
 Lemma Znth_big_endian_integer:
@@ -134,9 +131,9 @@ Fixpoint rsequence (cs: list statement) s :=
  end.
 
 Lemma sequence_rsequence:
- forall Espec CS Delta P cs s0 s R,
-    @semax CS Espec Delta P (Ssequence s0 (sequence cs s)) R  <->
-  @semax CS Espec Delta P (Ssequence (rsequence (rev cs) s0) s) R.
+ forall Espec CS E Delta P cs s0 s R,
+    semax(OK_spec := Espec)(C := CS) E Delta P (Ssequence s0 (sequence cs s)) R  <->
+  semax E Delta P (Ssequence (rsequence (rev cs) s0) s) R.
 Proof.
 intros.
 revert Delta P R s0 s; induction cs; intros.
@@ -151,12 +148,11 @@ rewrite IHl. auto.
 Qed.
 
 Lemma seq_assocN:
-  forall {Espec: OracleKind} CS,
-   forall Q Delta P cs s R,
-        @semax CS Espec Delta P (sequence cs Sskip) (normal_ret_assert Q) ->
-         @semax CS Espec
-       Delta  Q s R ->
-        @semax CS Espec Delta P (sequence cs s) R.
+  forall {Espec} CS,
+   forall Q E Delta P cs s R,
+        semax(OK_spec := Espec)(C := CS) E Delta P (sequence cs Sskip) (normal_ret_assert Q) ->
+         semax E Delta Q s R ->
+         semax E Delta P (sequence cs s) R.
 Proof.
 intros.
 rewrite semax_skip_seq.
@@ -227,8 +223,6 @@ Ltac MyOmega :=
 
 Local Open Scope Z.
 
-Local Open Scope logic.
-
 Lemma sizeof_tarray_tuchar:
  forall (n:Z), (n>=0)%Z -> (sizeof (tarray tuchar n) =  n)%Z.
 Proof. intros.
diff --git a/sha/spec_hmac.v b/sha/spec_hmac.v
index 2339a5c964..20ad258d4d 100644
--- a/sha/spec_hmac.v
+++ b/sha/spec_hmac.v
@@ -1,6 +1,5 @@
 Require Import VST.floyd.proofauto.
 Import ListNotations.
-Local Open Scope logic.
 
 Require Import sha.spec_sha.
 Require Import sha.sha_lemmas.
@@ -359,9 +358,9 @@ Definition HmacFunSpecs : funspecs :=
 
 Definition HMS : hmacstate := default_val t_struct_hmac_ctx_st.
 
-Lemma change_compspecs_data_block: forall sh v,
-  @data_block spec_sha.CompSpecs sh v =
-  @data_block CompSpecs sh v.
+Lemma change_compspecs_data_block: forall sh v p,
+  @data_block spec_sha.CompSpecs sh v p ⊣⊢
+  @data_block CompSpecs sh v p.
 Proof.
   intros.
   unfold data_block.
@@ -371,10 +370,10 @@ Qed.
 Ltac change_compspecs' cs cs' ::=
   match goal with
   | |- context [@data_block cs'] => rewrite change_compspecs_data_block
-  | |- context [@data_at cs' ?sh ?t ?v1] => erewrite (@data_at_change_composite cs' cs _ sh t); [| apply JMeq_refl | reflexivity]
-  | |- context [@field_at cs' ?sh ?t ?gfs ?v1] => erewrite (@field_at_change_composite cs' cs _ sh t gfs); [| apply JMeq_refl | reflexivity]
-  | |- context [@data_at_ cs' ?sh ?t] => erewrite (@data_at__change_composite cs' cs _ sh t); [| reflexivity]
-  | |- context [@field_at_ cs' ?sh ?t ?gfs] => erewrite (@field_at__change_composite cs' cs _ sh t gfs); [| reflexivity]
+  | |- context [data_at(cs := cs') ?sh ?t ?v1] => erewrite (data_at_change_composite(cs_from := cs')(cs_to := cs) sh t); [| apply JMeq_refl | reflexivity]
+  | |- context [field_at(cs := cs') ?sh ?t ?gfs ?v1] => erewrite (field_at_change_composite(cs_from := cs')(cs_to := cs) sh t gfs); [| apply JMeq_refl | reflexivity]
+  | |- context [data_at_(cs := cs') ?sh ?t] => erewrite (data_at__change_composite(cs_from := cs')(cs_to := cs) sh t); [| reflexivity]
+  | |- context [field_at_(cs := cs') ?sh ?t ?gfs] => erewrite (field_at__change_composite (cs_from := cs')(cs_to := cs) sh t gfs); [| reflexivity]
   | |- context [?A cs'] => change (A cs') with (A cs)
   | |- context [?A cs' ?B] => change (A cs' B) with (A cs B)
   | |- context [?A cs' ?B ?C] => change (A cs' B C) with (A cs B C)
@@ -384,18 +383,17 @@ Ltac change_compspecs' cs cs' ::=
  end.
 
 (* TODO: maybe this lemma is not needed any more. *)
-Lemma change_compspecs_t_struct_SHA256state_st:
-  @data_at spec_sha.CompSpecs Ews t_struct_SHA256state_st =
-  @data_at CompSpecs Ews t_struct_SHA256state_st.
+Lemma change_compspecs_t_struct_SHA256state_st: forall v p,
+  data_at(cs := spec_sha.CompSpecs) Ews t_struct_SHA256state_st v p ⊣⊢
+  data_at(cs := CompSpecs) Ews t_struct_SHA256state_st v p.
 Proof.
-  extensionality gfs v.
   (* TODO: simplify this proof. *)
-  unfold data_at, field_at.
-  f_equal.
+  intros; unfold data_at, field_at.
+  f_equiv; last done.
   unfold field_compatible.
-  apply ND_prop_ext.
-  assert (@align_compatible spec_sha.CompSpecs t_struct_SHA256state_st v <-> @align_compatible CompSpecs t_struct_SHA256state_st v); [| tauto].
-  destruct v; unfold align_compatible; try tauto.
+  f_equiv.
+  assert (@align_compatible spec_sha.CompSpecs t_struct_SHA256state_st p <-> @align_compatible CompSpecs t_struct_SHA256state_st p); [| tauto].
+  destruct p; unfold align_compatible; try tauto.
   split; intros.
   + eapply align_compatible_rec_Tstruct; [reflexivity.. | simpl co_members].
     intros.
@@ -452,4 +450,3 @@ Proof.
 Qed.
 
 #[export] Hint Rewrite change_compspecs_t_struct_SHA256state_st : norm.
-
diff --git a/sha/spec_sha.v b/sha/spec_sha.v
index 3f3c5e7508..02e50af3a3 100644
--- a/sha/spec_sha.v
+++ b/sha/spec_sha.v
@@ -1,15 +1,15 @@
+Require Import sha.sha.
+(* The variable data_ gets transformed into the identifier _data_ by clightgen, but
+   _data_ is a reserved identifier in ssreflect, so we have to give it an alias here. *)
+Notation data_ := (_data_).
 Require Import VST.floyd.proofauto.
 Import ListNotations.
-Require Import sha.sha.
 Require Import sha.general_lemmas.
 Require Import sha.vst_lemmas.
 Require Import sha.SHA256.
 
-Require Import VST.floyd.Funspec_old_Notation.
-
 #[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.
 Definition Vprog : varspecs. mk_varspecs prog. Defined.
-Open Scope logic.
 
 Definition s256state := (list val * (val * (val * (list val * val))))%type.
 Definition s256_h (s: s256state) := fst s.
@@ -60,9 +60,9 @@ Definition _x : ident := 82%positive.
 Definition __builtin_read32_reversed_spec :=
  DECLARE ___builtin_read32_reversed
   WITH p: val, sh: share, contents: list byte
-  PRE [ _ptr OF tptr tuint ]
+  PRE [ tptr tuint ]
         PROP  (Zlength contents >= 4)
-        LOCAL (temp _ptr p)
+        PARAMS (p)
         SEP   (data_at sh (tarray tuchar 4) (map Vubyte contents) p)
   POST [ tuint ]
      PROP() LOCAL (temp ret_temp  (Vint (big_endian_integer contents)))
@@ -71,11 +71,10 @@ Definition __builtin_read32_reversed_spec :=
 Definition __builtin_write32_reversed_spec :=
  DECLARE ___builtin_write32_reversed
   WITH p: val, sh: share, contents: list byte
-  PRE [ _ptr OF tptr tuint, _x OF tuint ]
+  PRE [ tptr tuint, tuint ]
         PROP  (writable_share sh;
                Zlength contents >= 4)
-        LOCAL (temp _ptr p;
-               temp _x (Vint(big_endian_integer contents)))
+        PARAMS (p; Vint(big_endian_integer contents))
         SEP   (memory_block sh 4 p)
   POST [ tvoid ]
      PROP() LOCAL()
@@ -84,9 +83,9 @@ Definition __builtin_write32_reversed_spec :=
 Definition memcpy_spec :=
   DECLARE _memcpy
    WITH qsh : share, psh: share, p: val, q: val, n: Z, contents: list int
-   PRE [ 1%positive OF tptr tvoid, 2%positive OF tptr tvoid, 3%positive OF tuint ]
+   PRE [ tptr tvoid, tptr tvoid, tuint ]
        PROP (readable_share qsh; writable_share psh; 0 <= n <= Int.max_unsigned)
-       LOCAL (temp 1%positive p; temp 2%positive q; temp 3%positive (Vint (Int.repr n)))
+       PARAMS (p; q; Vint (Int.repr n))
        SEP (data_at qsh (tarray tuchar n) (map Vint contents) q;
               memory_block psh n p)
     POST [ tptr tvoid ]
@@ -97,10 +96,9 @@ Definition memcpy_spec :=
 Definition memset_spec :=
   DECLARE _memset
    WITH sh : share, p: val, n: Z, c: int
-   PRE [ 1%positive OF tptr tvoid, 2%positive OF tint, 3%positive OF tuint ]
+   PRE [ tptr tvoid, tint, tuint ]
        PROP (writable_share sh; 0 <= n <= Int.max_unsigned)
-       LOCAL (temp 1%positive p; temp 2%positive (Vint c);
-                   temp 3%positive (Vint (Int.repr n)))
+       PARAMS (p; Vint c; Vint (Int.repr n))
        SEP (memory_block sh n p)
     POST [ tptr tvoid ]
        PROP() LOCAL(temp ret_temp p)
@@ -112,10 +110,11 @@ Definition K_vector (gv: globals) : mpred :=
 Definition sha256_block_data_order_spec :=
   DECLARE _sha256_block_data_order
     WITH regs: list int, b: list int, ctx : val, wsh: share, data: val, sh: share, gv: globals
-   PRE [ _ctx OF tptr t_struct_SHA256state_st, _in OF tptr tvoid ]
+   PRE [ tptr t_struct_SHA256state_st, tptr tvoid ]
          PROP(Zlength regs = 8; Zlength b = LBLOCKz; 
                   writable_share wsh; readable_share sh)
-         LOCAL (temp _ctx ctx; temp _in data; gvars gv)
+         PARAMS (ctx; data)
+         GLOBALS (gv)
          SEP (field_at wsh t_struct_SHA256state_st [StructField _h] (map Vint regs) ctx;
                 data_block sh (intlist_to_bytelist b) data;
                 K_vector gv)
@@ -128,10 +127,10 @@ Definition sha256_block_data_order_spec :=
 Definition SHA256_addlength_spec :=
  DECLARE _SHA256_addlength
  WITH len : Z, c: val, sh: share, n: Z
- PRE [ _c OF tptr t_struct_SHA256state_st , _len OF tuint ]
+ PRE [ tptr t_struct_SHA256state_st, tuint ]
    PROP (writable_share sh;
              0 <= n+len*8 < two_p 64; 0 <= len <= Int.max_unsigned; 0 <= n)
-   LOCAL (temp _len (Vint (Int.repr len)); temp _c c)
+   PARAMS (c; Vint (Int.repr len))
    SEP (field_at sh t_struct_SHA256state_st [StructField _Nl] (Vint (lo_part n)) c;
           field_at sh t_struct_SHA256state_st [StructField _Nh] (Vint (hi_part n)) c)
  POST [ tvoid ]
@@ -142,8 +141,8 @@ Definition SHA256_addlength_spec :=
 Definition SHA256_Init_spec :=
   DECLARE _SHA256_Init
    WITH c : val, sh: share
-   PRE [ _c OF tptr t_struct_SHA256state_st ]
-         PROP (writable_share sh) LOCAL (temp _c c)
+   PRE [ tptr t_struct_SHA256state_st ]
+         PROP (writable_share sh) PARAMS (c)
          SEP(data_at_ sh t_struct_SHA256state_st c)
   POST [ tvoid ]
          PROP() LOCAL() SEP(sha256state_ sh nil c).
@@ -151,12 +150,12 @@ Definition SHA256_Init_spec :=
 Definition SHA256_Update_spec :=
   DECLARE _SHA256_Update
    WITH a: s256abs, data: list byte, c : val, wsh: share, d: val, sh: share, len : Z, gv: globals
-   PRE [ _c OF tptr t_struct_SHA256state_st, _data_ OF tptr tvoid, _len OF tuint ]
+   PRE [ tptr t_struct_SHA256state_st, tptr tvoid, tuint ]
          PROP (writable_share wsh; readable_share sh; 
                    len <= Zlength data; 0 <= len <= Int.max_unsigned;
                    (s256a_len a + len * 8 < two_p 64)%Z)
-         LOCAL (temp _c c; temp _data_ d; temp _len (Vint (Int.repr len));
-                     gvars gv)
+         PARAMS (c; d; Vint (Int.repr len))
+         GLOBALS (gv)
          SEP(K_vector gv;
                sha256state_ wsh a c; data_block sh data d)
   POST [ tvoid ]
@@ -169,10 +168,10 @@ Definition SHA256_Update_spec :=
 Definition SHA256_Final_spec :=
   DECLARE _SHA256_Final
    WITH a: s256abs, md: val, c : val,  wsh: share, shmd: share, gv : globals
-   PRE [ _md OF tptr tuchar, _c OF tptr t_struct_SHA256state_st ]
+   PRE [ tptr tuchar, tptr t_struct_SHA256state_st ]
          PROP (writable_share wsh; writable_share shmd)
-         LOCAL (temp _md md; temp _c c;
-                      gvars gv)
+         PARAMS (md; c)
+         GLOBALS (gv)
          SEP(K_vector gv;
                sha256state_ wsh a c;
                memory_block shmd 32 md)
@@ -185,12 +184,11 @@ Definition SHA256_Final_spec :=
 Definition SHA256_spec :=
   DECLARE _SHA256
    WITH d: val, len: Z, dsh: share, msh: share, data: list byte, md: val, gv: globals
-   PRE [ _d OF tptr tuchar, _n OF tuint, _md OF tptr tuchar ]
-         PROP (readable_share dsh; writable_share msh; 
+   PRE [ tptr tuchar, tuint, tptr tuchar ]
+         PROP (readable_share dsh; writable_share msh;
                    Zlength data * 8 < two_p 64; Zlength data <= Int.max_unsigned)
-         LOCAL (temp _d d; temp _n (Vint (Int.repr (Zlength data)));
-                     temp _md md;
-                      gvars gv)
+         PARAMS (d; Vint (Int.repr (Zlength data)); md)
+         GLOBALS (gv)
          SEP(K_vector gv;
                data_block dsh data d; memory_block msh 32 md)
   POST [ tvoid ]
@@ -210,7 +208,7 @@ Definition Gprog : funspecs :=
 Fixpoint do_builtins (n: nat) (defs : list (ident * globdef Clight.fundef type)) : funspecs :=
  match n, defs with
   | S n', (id, Gfun (External (EF_builtin _ sig) argtys resty cc_default))::defs' =>
-     (id, NDmk_funspec ((*iota_formals 1%positive*) argtys, resty) cc_default unit FF FF)
+     (id, NDmk_funspec ((*iota_formals 1%positive*) argtys, resty) cc_default unit (fun _ => FF) (fun _ => FF))
       :: do_builtins n' defs'
   | _, _ => nil
  end.
diff --git a/sha/verif_SHA256.v b/sha/verif_SHA256.v
index 6e5da50402..48a2819d0f 100644
--- a/sha/verif_SHA256.v
+++ b/sha/verif_SHA256.v
@@ -4,8 +4,6 @@ Require Import sha.SHA256.
 Require Import sha.spec_sha.
 Require Import sha.sha_lemmas.
 
-Local Open Scope logic.
-
 Lemma body_SHA256: semax_body Vprog Gtot f_SHA256 SHA256_spec.
 Proof.
 start_function.
diff --git a/sha/verif_addlength.v b/sha/verif_addlength.v
index 0a94377693..a6f2c20257 100644
--- a/sha/verif_addlength.v
+++ b/sha/verif_addlength.v
@@ -4,8 +4,6 @@ Require Import sha.SHA256.
 Require Import sha.sha_lemmas.
 Require Import sha.spec_sha.
 
-Local Open Scope logic.
-
 Lemma int_unsigned_mod:
  forall i, Int.unsigned i mod Int.modulus = Int.unsigned i.
 Proof.
@@ -211,14 +209,14 @@ forward_if (temp _cNh (Vint (Int.repr (Int.unsigned (hi_part n) + carry)))).
  entailer!. (* return; *)
  subst carry.
  clear - MN BOUND H Hn.
- apply derives_refl'; f_equal.
- + f_equal. f_equal.
+ f_equiv.
+ + f_equiv. f_equal.
     unfold lo_part.
     apply Int.eqm_samerepr.
     apply Int.eqm_add.
     apply Int.eqm_sym; apply Int.eqm_unsigned_repr.
     apply Int.eqm_refl.
- + f_equal. f_equal.
+ + f_equiv. f_equal.
      unfold hi_part.
   rename Hn into Hn';
     assert (Hn: 0 <= n < two_p 64) by lia;
diff --git a/sha/verif_hmac_cleanup.v b/sha/verif_hmac_cleanup.v
index f75bcb014d..0c1ad1fd91 100644
--- a/sha/verif_hmac_cleanup.v
+++ b/sha/verif_hmac_cleanup.v
@@ -2,7 +2,6 @@ Require Import VST.floyd.proofauto.
 Import ListNotations.
 Require sha.sha.
 Require Import sha.SHA256.
-Local Open Scope logic.
 
 Require Import sha.spec_sha.
 Require Import sha.sha_lemmas.
@@ -33,9 +32,9 @@ rewrite !map_repeat.
 Qed.
 
 (*Here's the proof for the alternative specification:*)
-Lemma cleanupbodyproof1 Espec wsh c h 
+Lemma cleanupbodyproof1 Espec wsh c h
   (Hwsh: writable_share wsh):
-@semax CompSpecs Espec (func_tycontext f_HMAC_cleanup HmacVarSpecs HmacFunSpecs nil)
+semax(OK_spec := Espec)(C := CompSpecs) ⊤ (func_tycontext f_HMAC_cleanup HmacVarSpecs HmacFunSpecs nil)
   (PROP  ()
    LOCAL  (temp _ctx c)
    SEP  (EX  key : list byte, hmacstate_PreInitNull wsh key h c))
diff --git a/sha/verif_hmac_crypto.v b/sha/verif_hmac_crypto.v
index 45b7dd1e60..ed0e58c3c1 100644
--- a/sha/verif_hmac_crypto.v
+++ b/sha/verif_hmac_crypto.v
@@ -1,6 +1,5 @@
 Require Import VST.floyd.proofauto.
 Import ListNotations.
-Require Export VST.floyd.Funspec_old_Notation.
 Require Import FCF.Blist.
 
 Require Import sha.vst_lemmas.
@@ -9,7 +8,6 @@ Require Import sha.ByteBitRelations.
 
 Require sha.sha.
 Require Import sha.SHA256.
-Local Open Scope logic.
 
 Require Import sha.spec_sha.
 Require Import sha.sha_lemmas.
@@ -36,7 +34,7 @@ rewrite bytesToBits_len. exists (length l). trivial.
 Qed.
 
 Definition bitspec KEY MSG :=
-  Vector.to_list ( HMAC_spec.HMAC EQ.h_v iv_v (HMAC_spec_abstract.HMAC_Abstract.wrappedSAP _ _ splitAndPad_v)
+  Vector.to_list (HMAC_spec.HMAC EQ.h_v iv_v (HMAC_spec_abstract.HMAC_Abstract.wrappedSAP _ _ splitAndPad_v)
                       fpad_v EQ.opad_v EQ.ipad_v
                       (of_list_length _ (key_vector (CONT KEY)))
                       (mkCont (CONT MSG))).
@@ -60,23 +58,23 @@ Definition HMAC_crypto :=
    WITH keyVal: val, KEY:DATA,
         msgVal: val, MSG:DATA,
         shk: share, shm: share, shmd: share, md: val, gv: globals
-   PRE [ _key OF tptr tuchar,
-         _key_len OF tint,
-         _d OF tptr tuchar,
-         _n OF tint,
-         _md OF tptr tuchar ]
+   PRE [ tptr tuchar,
+         tint,
+         tptr tuchar,
+         tint,
+         tptr tuchar ]
          PROP (readable_share shk; readable_share shm; writable_share shmd;
                has_lengthK (LEN KEY) (CONT KEY);
                has_lengthD 512 (LEN MSG) (CONT MSG))
-         LOCAL (temp _md md; temp _key keyVal;
-                temp _key_len (Vint (Int.repr (LEN KEY)));
-                temp _d msgVal; temp _n (Vint (Int.repr (LEN MSG)));
-                gvars gv)
+         PARAMS (keyVal;
+                 Vint (Int.repr (LEN KEY));
+                 msgVal; Vint (Int.repr (LEN MSG)); md)
+         GLOBALS (gv)
          SEP(data_block shk (CONT KEY) keyVal;
              data_block shm (CONT MSG) msgVal;
              K_vector gv;
              memory_block shmd 32 md)
-  POST [ tptr tuchar ] 
+  POST [ tptr tuchar ]
          EX digest:_,
           PROP (digest= HMAC256 (CONT MSG) (CONT KEY) /\
                 bytesToBits digest = bitspec KEY MSG /\ 
@@ -91,7 +89,7 @@ Lemma hmacbodycryptoproof Espec k KEY msg  MSG gv shk shm shmd md buf
       (Hshk: readable_share shk) (Hshm: readable_share shm) (SH : writable_share shmd) 
       (KL: has_lengthK (LEN KEY) (CONT KEY))
       (DL: has_lengthD 512 (LEN MSG) (CONT MSG)):
-@semax CompSpecs Espec (func_tycontext f_HMAC HmacVarSpecs HmacFunSpecs nil)
+semax(OK_spec := Espec)(C := CompSpecs) ⊤ (func_tycontext f_HMAC HmacVarSpecs HmacFunSpecs nil)
   (PROP  ()
    LOCAL  (lvar _c (Tstruct _hmac_ctx_st noattr) buf; temp _md md;
      temp _key k; temp _key_len (Vint (Int.repr (LEN KEY)));
@@ -150,25 +148,24 @@ destruct RES as [h2 dig].
 simpl.
 
 forward_call (Tsh, h2,buf).
-freeze FR1 := - . 
+freeze FR1 := - .
+assert (forall A Awf, CRYPTO A Awf). (* if we don't assert this in advance, we hit a unification loop *)
+{ intros ? X.
+  unfold CRYPTO; intros. apply HMAC256_isPRF; assumption. }
 forward.
 (*assert_PROP (field_compatible (tarray tuchar (sizeof t_struct_hmac_ctx_st)) nil buf).
 { unfold data_block at 1. unfold Zlength. simpl. apply prop_right. assumption. }
 rename H5 into FBUF.*)
 specialize (hmac_sound key data). unfold hmac.
 rewrite <- HeqRES. simpl; intros.
-Exists dig. thaw FR1.  entailer!. 
-{ subst.
-       split. unfold bitspec. simpl. rewrite Equivalence.
-         f_equal. unfold HMAC_spec_abstract.HMAC_Abstract.Message2Blist.
-         remember (mkCont data) as dd. destruct dd. destruct a; subst x.
-         rewrite ByteBitRelations.bytes_bits_bytes_id.
-         rewrite HMAC_equivalence.of_length_proof_irrel.
-         rewrite ByteBitRelations.bytes_bits_bytes_id. reflexivity.
-           intros ? X. apply X.
-       (*split; trivial. split; trivial. *)
-       intros ? X.
-        unfold CRYPTO; intros. apply HMAC256_isPRF; assumption. }
+Exists dig. thaw FR1. entailer!.
+{ unfold bitspec. simpl. rewrite Equivalence.
+  f_equal. unfold HMAC_spec_abstract.HMAC_Abstract.Message2Blist.
+  remember (mkCont data) as dd. destruct dd. destruct a; subst x.
+  rewrite ByteBitRelations.bytes_bits_bytes_id.
+  rewrite HMAC_equivalence.of_length_proof_irrel.
+  rewrite ByteBitRelations.bytes_bits_bytes_id. reflexivity.
+  intros ? X. apply X. }
 unfold data_block.
   rewrite Zlength_correct; simpl.
   rewrite <- memory_block_data_at_; trivial.
diff --git a/sha/verif_hmac_double.v b/sha/verif_hmac_double.v
index 74d6912db2..5829f407ab 100644
--- a/sha/verif_hmac_double.v
+++ b/sha/verif_hmac_double.v
@@ -7,7 +7,6 @@ Require Import VST.floyd.proofauto.
 Import ListNotations.
 Require sha.sha.
 Require Import sha.SHA256.
-Local Open Scope logic.
 
 Require Import sha.spec_sha.
 Require Import sha.sha_lemmas.
diff --git a/sha/verif_hmac_final.v b/sha/verif_hmac_final.v
index cac798b93a..fa1944b020 100644
--- a/sha/verif_hmac_final.v
+++ b/sha/verif_hmac_final.v
@@ -3,7 +3,6 @@ Require Import VST.floyd.proofauto.
 Import ListNotations.
 Require sha.sha.
 Require sha.SHA256.
-Local Open Scope logic.
 
 Require Import sha.spec_sha.
 Require Import sha.sha_lemmas.
@@ -24,7 +23,7 @@ Qed.
 Lemma finalbodyproof Espec c md wsh shmd gv buf (h1 : hmacabs)
       (Hwsh: writable_share wsh)
       (SH : writable_share shmd):
-@semax CompSpecs Espec (func_tycontext f_HMAC_Final HmacVarSpecs HmacFunSpecs nil)
+semax(OK_spec := Espec)(C := CompSpecs) ⊤ (func_tycontext f_HMAC_Final HmacVarSpecs HmacFunSpecs nil)
   (PROP  ()
    LOCAL  (lvar _buf (tarray tuchar 32) buf; gvars gv; temp _ctx c; temp _md md
 (*lvar _buf (tarray tuchar 32) buf; temp _md md;
@@ -79,16 +78,12 @@ Time forward_call (ctx, buf, Vptr b i, wsh, Tsh, gv). (*3.6 versus 9.5*)
    cancel.
   }
 
-(*VST Issue: calls to forward-call with type-incorrect WITH-list instantiations simply succeed immediately,
-  without doing anything. Instead, they should fail with a meaningful error message.*)
-
 (*Coq (8.4?) Issue: type equality between
     @reptype CompSpecs t_struct_SHA256state_st * (s256state * s256state)
 and @reptype CompSpecs t_struct_hmac_ctx_st
   is not corrrectly identified here: instead of the pose l:=...; assert (exists l':..., ...);
    use l' in data_at c, we'd really like to simply write
   data_at Tsh t_struct_hmac_ctx_st (default_val t_struct_SHA256state_st, (iCTX, oCTX)) c.*)
-
 pose  (l:=(default_val t_struct_SHA256state_st, (iCTX, oCTX))).
 assert (exists l':@reptype CompSpecs t_struct_hmac_ctx_st, l'=l).
   exists l. trivial.
@@ -102,7 +97,7 @@ apply semax_pre with (P':=
      data_block Tsh (SHA256.SHA_256 ctx) buf;
      memory_block shmd 32 md))).
 { Time entailer!. (*5.2versus 11.7*)
-      unfold_data_at (@data_at CompSpecs _ t_struct_hmac_ctx_st _ _). thaw FR1.
+      unfold_data_at (data_at(cs := CompSpecs) _ t_struct_hmac_ctx_st _ _). thaw FR1.
       rewrite (field_at_data_at wsh t_struct_hmac_ctx_st [StructField _md_ctx]).
       rewrite field_address_offset by auto with field_compatible.
       simpl. rewrite Ptrofs.add_zero.
@@ -112,8 +107,8 @@ apply semax_pre with (P':=
       Time cancel. (*0.9*)
 }
 subst l'. clear FR1.
-freeze FR2 := - (@data_at CompSpecs _ _ _ (Vptr b i)).
-unfold_data_at (@data_at CompSpecs _ _ _ (Vptr b i)).
+freeze FR2 := - (data_at(cs := CompSpecs) _ _ _ (Vptr b i)).
+unfold_data_at (data_at(cs := CompSpecs) _ _ _ (Vptr b i)).
 rewrite (field_at_data_at _ _ [StructField _o_ctx]).
 rewrite (field_at_data_at _ _ [StructField _md_ctx]).
 rewrite field_address_offset by auto with field_compatible.
@@ -125,7 +120,7 @@ replace_SEP 1 (memory_block wsh 108 (Vptr b i)).
     eapply derives_trans. apply data_at_data_at_.
     rewrite <- (memory_block_data_at_ wsh _ _ H). apply derives_refl.
   }
-freeze FR3 := - (memory_block _ _ (Vptr b i)) (@data_at CompSpecs _ _ _ (Vptr b (Ptrofs.add i (Ptrofs.repr 216)))).
+freeze FR3 := - (memory_block _ _ (Vptr b i)) (data_at(cs := CompSpecs) _ _ _ (Vptr b (Ptrofs.add i (Ptrofs.repr 216)))).
 Time forward_call (wsh, wsh, Vptr b i, Vptr b (Ptrofs.add i (Ptrofs.repr 216)),
               mkTrep t_struct_SHA256state_st oCTX, 108). (*5 versus 8.7*)
 (* Time solve [simpl; cancel]. (*0.1 versus 1*) *)
@@ -146,7 +141,7 @@ Time forward_call (oSha, SHA256.SHA_256 ctx, Vptr b i, wsh, buf, Tsh, Z.of_nat S
 *)
      Time cancel. (*0.2 versus 1.6*) }
   { unfold SHA256.DigestLength.
-    rewrite oShaLen. simpl; intuition auto with *. }
+    rewrite oShaLen. simpl. unfold two_power_pos; simpl; lia. }
 simpl.
 rewrite sublist_same; try lia.
 unfold sha256state_. Intros updShaST.
@@ -164,15 +159,14 @@ Time forward_call (updSha, md, Vptr b i, wsh, shmd, gv). (*4.2 versus 21 SLOW*)
 (*    change (@data_block spec_sha.CompSpecs shmd (SHA256.SHA_256 updShaST) md)
      with (@data_block CompSpecs shmd (SHA256.SHA_256 updShaST) md).
      Time cancel. (*0.5*)*)
-(*change_compspecs CompSpecs.*)
-unfold data_block. simpl. rewrite SFL. intros tau.
-unfold PROPx, LOCALx, SEPx, local, liftx, lift1, lift; simpl; unfold liftx, lift. simpl.
-
-Time (normalize; cancel). (*5.5*)
-unfold stackframe_of. simpl. cancel.
-eapply derives_trans. 
-2:{  apply sepcon_derives.  apply derives_refl. 
-     apply (var_block_lvar0 _ _ Delta); trivial. apply H0. }
+change_compspecs CompSpecs.
+unfold data_block. simpl. rewrite SFL.
+unfold PROPx, LOCALx, SEPx, local, liftx, lift1, lift; simpl; split => tau; monPred.unseal.
+
+entailer!.
+unfold stackframe_of. simpl.
+rewrite bi.sep_emp.
+rewrite <- (var_block_lvar0 _ _ Delta) by (trivial; apply H0).
 cancel.
 
 unfold hmacstate_PostFinal, hmac_relate_PostFinal.
@@ -181,9 +175,7 @@ Exists (updShaST, (iCTX, oCTX)). rewrite prop_true_andp by (split3; auto).
 match goal with |- _ |-- data_at _ _ ?A _ =>
 change A with (default_val t_struct_SHA256state_st, (iCTX, oCTX))
 end.
-subst c.
-change_compspecs CompSpecs.
-Time unfold_data_at (@data_at CompSpecs _ _ _ (Vptr b i)).
+Time unfold_data_at (data_at(cs := CompSpecs) _ _ _ (Vptr b i)).
 Time assert_PROP (field_compatible t_struct_SHA256state_st [] (Vptr b i)) as FC by entailer!. (*1.2*)
 Time cancel. (*0.7*)
 unfold data_at_, field_at_.
@@ -194,7 +186,7 @@ rewrite field_address_offset by auto with field_compatible.
 simpl snd. simpl fst.
 rewrite field_at_data_at.
 rewrite field_address_offset by auto with field_compatible. subst; simpl.  apply derives_refl.
-Time Qed. (*VST 2.0: 6s*) 
+Time Qed. (*VST 2.0: 6s*)
 
 Lemma body_hmac_final: semax_body HmacVarSpecs HmacFunSpecs
        f_HMAC_Final HMAC_Final_spec.
diff --git a/sha/verif_hmac_init.v b/sha/verif_hmac_init.v
index f99a06488d..bd3617389a 100644
--- a/sha/verif_hmac_init.v
+++ b/sha/verif_hmac_init.v
@@ -2,7 +2,6 @@ Require Import VST.floyd.proofauto.
 Import ListNotations.
 Require sha.sha.
 Require Import sha.SHA256.
-Local Open Scope logic.
 
 Require Import sha.spec_sha.
 Require Import sha.sha_lemmas.
@@ -39,7 +38,7 @@ Qed.*)
 Lemma initbodyproof Espec c k l wsh sh key gv h1 pad ctxkey
   (Hwsh: writable_share wsh)
   (Hsh: readable_share sh):
-@semax CompSpecs Espec (func_tycontext f_HMAC_Init HmacVarSpecs HmacFunSpecs nil)
+semax(OK_spec := Espec)(C := CompSpecs) ⊤ (func_tycontext f_HMAC_Init HmacVarSpecs HmacFunSpecs nil)
   (PROP  ()
    LOCAL (lvar _ctx_key (tarray tuchar 64) ctxkey;
    lvar _pad (tarray tuchar 64) pad; gvars gv; temp _ctx c; 
@@ -52,11 +51,11 @@ Lemma initbodyproof Espec c k l wsh sh key gv h1 pad ctxkey
                    (PROP ( )
                     LOCAL ()
                     SEP (hmacstate_ wsh (hmacInit key) c;
-                    initPostKey sh k key; 
+                    initPostKey sh k key;
                     K_vector gv) *
                     stackframe_of f_HMAC_Init)).
 Proof. abbreviate_semax.
-simpl. 
+simpl.
 Time forward. (*0.8 versus 1.3*)
 
 Time assert_PROP (isptr ctxkey) as Pckey by entailer!. (*0.7*)
@@ -69,17 +68,17 @@ forward_if (PostKeyNull c k pad gv h1 l wsh sh key ckb ckoff).
     clear H.
     remember (Int.eq i Int.zero). destruct b.
      apply binop_lemmas2.int_eq_true in Heqb. rewrite Heqb; auto with valid_pointer. entailer!.
-     entailer!. apply sepcon_valid_pointer2. apply @data_block_valid_pointer. auto.
+     Intros. rewrite @data_block_valid_pointer; auto. iIntros "(_ & _ & _ & _ & $)".
      red in H2. lia.
      apply valid_pointer_null. }
 
   { (* THEN*)
     simpl.
     unfold initPre.
-    destruct k; try solve [eapply semax_pre; try eapply semax_ff; entailer].
+    destruct k; try solve [eapply semax_pre; try eapply semax_ff; entailer!].
     (*key' is integer, ie Null*)
       remember (Int.eq i Int.zero) as d.
-      destruct d; try solve [eapply semax_pre; try eapply semax_ff; entailer].
+      destruct d; try solve [eapply semax_pre; try eapply semax_ff; go_lower; iIntros "(_ & _ & _ & [])"].
       apply binop_lemmas2.int_eq_true in Heqd. simpl in *. elim H. subst; reflexivity.
     (*key' is ptr*)
     Intros. clear H. rename H0 into keyLen.
@@ -197,21 +196,21 @@ forward_if (EX shaStates:_ ,
               lvar _pad (Tarray tuchar 64 noattr) (Vptr pb pofs);
               temp _ctx (Vptr cb cofs); temp _key (Vptr b i);
               temp _len (Vint (Int.repr l)); gvars gv)
-       SEP  (@data_at CompSpecs wsh t_struct_hmac_ctx_st HMS (Vptr cb cofs);
-             @data_at CompSpecs Tsh (tarray tuchar 64)
+       SEP  (data_at(cs := CompSpecs) wsh t_struct_hmac_ctx_st HMS (Vptr cb cofs);
+             data_at(cs := CompSpecs) Tsh (tarray tuchar 64)
                   (@map byte val Vubyte(HMAC_SHA256.mkKey key))
                   (Vptr ckb ckoff);
-            @data_at CompSpecs sh (tarray tuchar (@Zlength byte key))
+            data_at(cs := CompSpecs) sh (tarray tuchar (@Zlength byte key))
                   (@map byte val Vubyte key) (Vptr b i);
-            @field_at_ CompSpecs Tsh (Tarray tuchar 64 noattr) [] (Vptr pb pofs);
+            field_at_(cs := CompSpecs) Tsh (Tarray tuchar 64 noattr) [] (Vptr pb pofs);
             K_vector gv)).
     { clear POSTCONDITION.
       unfold initPostKeyNullConditional.
       go_lower. ent_iter. (* Issue: we just want these two parts of entailer here... *)
       destruct k; try contradiction.
-      Time simple_if_tac; entailer!. (* 0.92 *)
+      simple_if_tac; iIntros "(? & [] & ?)".
       Exists b i.
-      entailer!. simpl; entailer!. }
+      simpl; entailer!. }
     Intros kb kofs.
     rename H into H0.
        assert (ZZ: exists HMS':reptype t_struct_hmac_ctx_st, HMS'=HMS). exists HMS. trivial.
@@ -223,8 +222,8 @@ forward_if (EX shaStates:_ ,
     { (*ipad loop*)
       (*semax_subcommand HmacVarSpecs HmacFunSpecs f_HMAC_Init.*)
        eapply semax_pre.
-       2:{ eapply (ipad_loop Espec pb pofs cb cofs ckb ckoff kb kofs l key gv myPred); try eassumption. }
-       subst HMS'. clear - HeqmyPred.  Time entailer!; apply derives_refl. 
+       2:{ eapply (ipad_loop Espec _ pb pofs cb cofs ckb ckoff kb kofs l key gv myPred); try eassumption. }
+       subst HMS'. clear - HeqmyPred.  Time entailer!; apply derives_refl.
     }
     subst myPred HMS'.
 
@@ -233,7 +232,7 @@ forward_if (EX shaStates:_ ,
     freeze FR1 := - (K_vector _) (data_at _ _ _ (Vptr cb _)).
     Time (assert_PROP (field_compatible t_struct_hmac_ctx_st [] (Vptr cb cofs)) as FC_C
        by entailer!). (*1.9 versus 6.5*)
-    Time unfold_data_at (@data_at CompSpecs _ _ _ _).
+    Time unfold_data_at (data_at(cs := CompSpecs) _ _ _ _).
     freeze FR2 := - (field_at _ _ [StructField _md_ctx] _ (Vptr cb _))
                              (field_at _ _ [StructField _i_ctx] _ (Vptr cb _)).
     rewrite (field_at_data_at  wsh t_struct_hmac_ctx_st [StructField _i_ctx]).
@@ -259,7 +258,7 @@ forward_if (EX shaStates:_ ,
       rewrite FR; clear FR Frame.
       simpl. Time cancel. (*0.3*)
       unfold data_block. rewrite  ZLI, HeqIPADcont.
-      simpl. Time entailer!. (*0.9*)
+      simpl. change_compspecs CompSpecs. Time entailer!. (*0.9*)
     }
     simpl.
     rewrite sublist_same; try rewrite ZLI; trivial.
@@ -267,12 +266,12 @@ forward_if (EX shaStates:_ ,
 
     (*essentially the same for opad*)
     thaw FR3.
+    change_compspecs CompSpecs.
     freeze FR4 := - (sha256state_ _ _ _) (data_block _ _ _) (data_at _ _ _ (Vptr ckb _)).
     forward_seq.
     { (*opad loop*)
       eapply semax_pre.
-      2: apply (opadloop Espec pb pofs cb cofs ckb ckoff kb kofs l wsh key gv (FRZL FR4) Hwsh IPADcont) with (ipadSHAabs:=ipadSHAabs); try reflexivity; subst ipadSHAabs; try assumption.
-      change_compspecs CompSpecs.
+      2: apply (opadloop Espec _ pb pofs cb cofs ckb ckoff kb kofs l wsh key gv (FRZL FR4) Hwsh IPADcont) with (ipadSHAabs:=ipadSHAabs); try reflexivity; subst ipadSHAabs; try assumption.
       entailer!.
     }
 
@@ -290,19 +289,20 @@ forward_if (EX shaStates:_ ,
     unfold MORE_COMMANDS, abbreviate.
 
     Time forward_call (Vptr cb (Ptrofs.add cofs (Ptrofs.repr 216)), wsh). (*6.4 versus 10.6*)
-    change_compspecs CompSpecs; cancel.
+    { change_compspecs CompSpecs; cancel. }
+
     (* Call to sha_update*)
     thaw FR6.
     Time forward_call (@nil byte,
             HMAC_SHA256.mkArg (HMAC_SHA256.mkKey key) Opad,
-            Vptr cb (Ptrofs.add cofs (Ptrofs.repr 216)), wsh, 
+            Vptr cb (Ptrofs.add cofs (Ptrofs.repr 216)), wsh,
             Vptr pb pofs, Tsh, 64, gv). (*4.5*)
     { assert (FR : Frame = [FRZL FR5]).
         subst Frame; reflexivity.
       rewrite FR; clear FR Frame.
       unfold data_block. simpl.
       rewrite ZLO; trivial.
-      Time entailer!. (*1.5*)
+      change_compspecs CompSpecs; time entailer!. (*1.5*)
     }
 
     rewrite sublist_same; try rewrite ZLO; trivial.
@@ -310,12 +310,12 @@ forward_if (EX shaStates:_ ,
     Time entailer!. (*4.7 *)
     thaw FR5. unfold sha256state_, data_block.
     rewrite ZLO. (*superfluous...subst ipadSHAabs.*)
-    Intros oUpd iUpd.
+    Intros iUpd oUpd.
     change_compspecs CompSpecs.
     Exists (innerShaInit (HMAC_SHA256.mkKey key),(iUpd,(outerShaInit (HMAC_SHA256.mkKey key),oUpd))).
-    simpl. rewrite !prop_true_andp by (auto; intuition).
+    simpl. rewrite !prop_true_andp by (intuition; auto).
     Time cancel. (*5 versus 4*)
-    unfold_data_at (@data_at CompSpecs _ t_struct_hmac_ctx_st _ (Vptr cb _)).
+    unfold_data_at (data_at(cs := CompSpecs) _ t_struct_hmac_ctx_st _ (Vptr cb _)).
     rewrite (field_at_data_at wsh t_struct_hmac_ctx_st [StructField _i_ctx]).
     rewrite (field_at_data_at wsh t_struct_hmac_ctx_st [StructField _o_ctx]).
     rewrite field_address_offset by auto with field_compatible.
@@ -325,17 +325,17 @@ forward_if (EX shaStates:_ ,
   { (*ELSE*)
     Time forward. (*0.2*)
     subst. unfold initPostKeyNullConditional. go_lower. (*Time entailer!.  (*6.5*)*)
-    destruct R; subst; [clear H |discriminate]. 
-    Time destruct k; try solve[entailer]. (*2.9*)
+    destruct R; subst; [clear H |discriminate].
+    destruct k; try solve[iIntros "(? & [] & ?)"].
     unfold hmacstate_PreInitNull, hmac_relate_PreInitNull; simpl.
-    Time simple_if_tac; [ | entailer!].
+    simple_if_tac; [ | iIntros "(? & [] & ?)"].
     Intros v x. destruct h1.
     Exists (iSha, (iCtx v, (oSha, oCtx v))). simpl.
     unfold hmacstate_PreInitNull, hmac_relate_PreInitNull; simpl.
     Exists v x.
     change (Tarray tuchar 64 noattr) with (tarray tuchar 64).
     rewrite !prop_true_andp by (auto; intuition). cancel.
-   } 
+   }
 
 { (*Continuation after if (reset*)
   apply extract_exists_pre; intros [iSA [iS [oSA oS]]]. simpl.
@@ -344,7 +344,7 @@ forward_if (EX shaStates:_ ,
   { (*Case key==null*)
     subst i.
     destruct R; subst r; simpl.
-    2: solve [apply semax_pre with (P':=FF); try entailer!; try apply semax_ff].
+    2: solve [eapply semax_pre, semax_ff; go_lower; iIntros "(? & ? & [] & ?)"].
     freeze FR2 := - (hmacstate_PreInitNull _ _ _ _).
     Intros.
     rename H0 into InnerRelate.
@@ -370,10 +370,10 @@ forward_if (EX shaStates:_ ,
      assert (FC_cb_md: field_compatible t_struct_hmac_ctx_st [StructField _md_ctx] (Vptr cb cofs)).
      { red in FC_cb. repeat split; try solve [apply FC_cb]. left. reflexivity. }
 
-     Time unfold_data_at (@data_at CompSpecs _ _ _ _).
+     Time unfold_data_at (data_at(cs := CompSpecs) _ _ _ _).
      rewrite (field_at_data_at _ _ [StructField _i_ctx]).
      (*VST Issue: why does rewrite field_at_data_at at 2 FAIL, but focus_SEP 3; rewrite field_at_data_at at 1. SUCCEED???
-        Answer: instead of using "at 2", use the field-specificer in the line above.*)
+        Answer: instead of using "at 2", use the field-specifier in the line above.*)
      rewrite field_address_offset by auto with field_compatible.
 
      freeze FR3 := - (field_at _ _ [StructField _md_ctx] _ _) (data_at _ _ _ (offset_val _ (Vptr cb _))).
@@ -383,11 +383,11 @@ forward_if (EX shaStates:_ ,
              mkTrep t_struct_SHA256state_st iS,
              @sizeof CompSpecs t_struct_SHA256state_st).
      (*5.9 versus 13*)
-     { rewrite sepcon_comm.
+     { rewrite <- sepcon_comm.
        rewrite (field_at_data_at _ _ [StructField _md_ctx]).
        rewrite field_address_offset by auto with field_compatible.
        apply sepcon_derives.
-         eapply derives_trans. apply data_at_memory_block. apply derives_refl'. f_equal.
+         eapply derives_trans. apply data_at_memory_block. f_equiv.
          apply isptr_offset_val_zero; simpl; trivial.
        Time cancel. (*0 versus 2*)
      }
@@ -413,19 +413,19 @@ forward_if (EX shaStates:_ ,
   { (*k is Vptr, key!=NULL*)
     freeze FR5 := - (initPostResetConditional _ _ _ _ _ _ _ _ _).
     destruct R as [R | R]; rewrite R; simpl.
-    solve [apply semax_pre with (P':=FF); try entailer; try apply semax_ff].
+    solve [eapply semax_pre, semax_ff; go_lower; iIntros "(_ & [])"].
     Intros.
     rename H0 into InnerRelate.
     rename H2 into OuterRelate.
     unfold postResetHMS. simpl.
-    freeze FR6 := - (@data_at CompSpecs _ _ _ (Vptr cb _)).
+    freeze FR6 := - (data_at(cs := CompSpecs) _ _ _ (Vptr cb _)).
     Time assert_PROP (field_compatible t_struct_hmac_ctx_st [] (Vptr cb cofs)) as FC_cb by entailer!. (*2.8*)
     assert (FC_cb_ictx: field_compatible t_struct_hmac_ctx_st [StructField _i_ctx] (Vptr cb cofs)).
     { red in FC_cb. repeat split; try solve [apply FC_cb]. right; left; reflexivity. }
     assert (FC_cb_md: field_compatible t_struct_hmac_ctx_st [StructField _md_ctx] (Vptr cb cofs)).
     { red in FC_cb. repeat split; try solve [apply FC_cb]. left; reflexivity. }
 
-    unfold_data_at (@data_at CompSpecs _ _ _ _).
+    unfold_data_at (data_at(cs := CompSpecs) _ _ _ _).
     freeze FR7 := - (field_at _ _ [StructField _md_ctx] _ _) (field_at _ _ [StructField _i_ctx] _ _).
     rewrite (field_at_data_at _ t_struct_hmac_ctx_st [StructField _i_ctx]).
     rewrite (field_at_data_at _ t_struct_hmac_ctx_st [StructField _md_ctx]).
@@ -439,7 +439,7 @@ forward_if (EX shaStates:_ ,
              mkTrep t_struct_SHA256state_st iS,
              @sizeof CompSpecs t_struct_SHA256state_st).
     (* 4.7 versus 14.7 *)
-    { rewrite sepcon_comm.
+    { rewrite <- sepcon_comm.
       apply sepcon_derives.
           eapply derives_trans. apply data_at_memory_block. apply derives_refl.
           Time cancel. (*0 versus 2*)
@@ -449,14 +449,14 @@ forward_if (EX shaStates:_ ,
     simpl.
     unfold data_block, hmacstate_, hmac_relate.
     Exists (iS, (iS, oS)).
-    change (@data_at spec_sha.CompSpecs sh (tarray tuchar (@Zlength byte key)))
-       with (@data_at CompSpecs sh (tarray tuchar (@Zlength byte key))).
+    change (data_at(cs := spec_sha.CompSpecs) sh (tarray tuchar (@Zlength byte key)))
+       with (data_at(cs := CompSpecs) sh (tarray tuchar (@Zlength byte key))).
     change (Tarray tuchar 64 noattr) with (tarray tuchar 64). simpl.
     Time entailer!. (*2.9*)
       unfold s256a_len, innerShaInit, outerShaInit.
            rewrite !Zlength_mkArgZ.
            rewrite mkKey_length. split; reflexivity.
-    unfold_data_at (@data_at CompSpecs _ _ _ (Vptr cb cofs)).
+    unfold_data_at (data_at(cs := CompSpecs) _ _ _ (Vptr cb cofs)).
       rewrite (field_at_data_at _ _ [StructField _md_ctx]).
       rewrite (field_at_data_at _ _ [StructField _i_ctx]).
     rewrite field_address_offset by auto with field_compatible.
@@ -464,11 +464,11 @@ forward_if (EX shaStates:_ ,
     simpl; rewrite Ptrofs.add_zero.
     thaw FR8. thaw FR7. thaw FR6. thaw FR5.
       change (Tarray tuchar 64 noattr) with (tarray tuchar 64).
-    Time cancel. (*1.7 versus 1.2 penalty when melting*)
+    Time cancel. (*1.7 versus 1.2 penalty when thawing*)
   }
 }
 }
-Time Qed. (*VST 2.0: 10.7s*) 
+Time Qed. (*VST 2.0: 10.7s*)
 
 Lemma body_hmac_init: semax_body HmacVarSpecs HmacFunSpecs
        f_HMAC_Init HMAC_Init_spec.
diff --git a/sha/verif_hmac_init_part1.v b/sha/verif_hmac_init_part1.v
index a73152ca41..237b463c26 100644
--- a/sha/verif_hmac_init_part1.v
+++ b/sha/verif_hmac_init_part1.v
@@ -2,7 +2,6 @@ Require Import VST.floyd.proofauto.
 Import ListNotations.
 Require sha.sha.
 Require Import sha.SHA256.
-Local Open Scope logic.
 
 Require Import sha.spec_sha.
 Require Import sha.sha_lemmas.
@@ -15,15 +14,15 @@ Require Import sha.hmac_pure_lemmas.
 Require Import sha.hmac_common_lemmas.
 Require Import sha.spec_hmac.
 
-Lemma change_compspecs_t_struct_SHA256state_st':
-  @data_at_ spec_sha.CompSpecs Ews t_struct_SHA256state_st =
-  @data_at_ CompSpecs Ews t_struct_SHA256state_st.
+Lemma change_compspecs_t_struct_SHA256state_st': forall v,
+  data_at_(cs := spec_sha.CompSpecs) Ews t_struct_SHA256state_st v ⊣⊢
+  data_at_(cs := CompSpecs) Ews t_struct_SHA256state_st v.
 Proof.
-  extensionality v.
-  change (@data_at_ spec_sha.CompSpecs Ews t_struct_SHA256state_st v) with
-      (@data_at spec_sha.CompSpecs Ews t_struct_SHA256state_st (default_val _) v).
-  change (@data_at_ CompSpecs Ews t_struct_SHA256state_st v) with
-      (@data_at CompSpecs Ews t_struct_SHA256state_st (default_val _) v).
+  intros.
+  change (data_at_(cs := spec_sha.CompSpecs) Ews t_struct_SHA256state_st v) with
+      (data_at(cs := spec_sha.CompSpecs) Ews t_struct_SHA256state_st (default_val _) v).
+  change (data_at_(cs := CompSpecs) Ews t_struct_SHA256state_st v) with
+      (data_at(cs :=  CompSpecs) Ews t_struct_SHA256state_st (default_val _) v).
   rewrite change_compspecs_t_struct_SHA256state_st.
   auto.
 Qed.
@@ -47,7 +46,7 @@ Definition initPostKeyNullConditional r (c:val) (k: val) h wsh sh key ctxkey: mp
   | _ => FF
   end.
 
-Definition PostKeyNull c k pad gv h1 l wsh sh key ckb ckoff: environ -> mpred :=
+Definition PostKeyNull c k pad gv h1 l wsh sh key ckb ckoff: assert :=
                  EX  cb : block,
                  (EX  cofs : ptrofs,
                   (EX  r : Z,
@@ -76,7 +75,7 @@ Lemma Init_part1_j_lt_len Espec (kb ckb cb: block) (kofs ckoff cofs: ptrofs)
               (Vptr cb cofs))
 (FC_cxtkey : field_compatible (Tarray tuchar 64 noattr) [] (Vptr ckb ckoff))
 (lt_64_l : 64 < l),
-@semax CompSpecs Espec
+semax(OK_spec := Espec)(C := CompSpecs) ⊤
        (func_tycontext f_HMAC_Init HmacVarSpecs HmacFunSpecs nil)
   (PROP  ()
    LOCAL  (temp _j (Vint (Int.repr 64)); temp _reset (Vint (Int.repr 1));
@@ -157,7 +156,7 @@ Proof. intros. abbreviate_semax.
       freeze FR1 := - (K_vector _) (data_at_ _ _ (Vptr cb _)).
       unfold data_at_ at 1. unfold field_at_ at 1.
       simpl.
-      Time unfold_data_at (@field_at CompSpecs _ _ _ _ _). (*7.7*)
+      Time unfold_data_at (field_at(cs := CompSpecs) _ _ _ _ _). (*7.7*)
       rewrite (field_at_data_at wsh t_struct_hmac_ctx_st [StructField _md_ctx]).
       rewrite field_address_offset by auto with field_compatible.
       simpl. rewrite Ptrofs.add_zero.
@@ -178,7 +177,7 @@ Proof. intros. abbreviate_semax.
       thaw FR1.
       freeze FR4 := - (sha256state_ _ _ _) (data_at _ _ _ (Vptr kb _)) (K_vector _).
       Time forward_call (@nil byte, key, Vptr cb cofs, wsh, Vptr kb kofs, sh, l, gv). (*4.5*)
-      change_compspecs CompSpecs. cancel.
+      { change_compspecs CompSpecs. cancel. }
      (*call Final*)
      thaw FR4. simpl.
      freeze FR5 := - (K_vector _) (sha256state_ _ _ _) (data_at_ _ _ (Vptr ckb _)).
@@ -252,7 +251,7 @@ Proof. intros. abbreviate_semax.
        Time entailer!. (*2.1*)
        thaw FR5.
        unfold data_at_, field_at_, tarray, data_block.
-       unfold_data_at (@data_at CompSpecs _ _ _ (Vptr cb cofs)). simpl. Time cancel. (*0.7*)
+       unfold_data_at (data_at(cs := CompSpecs) _ _ _ (Vptr cb cofs)). simpl. Time cancel. (*0.7*)
        Time (normalize; cancel). (*0.6*)
        rewrite field_at_data_at, field_address_offset by auto with field_compatible.
        rewrite field_at_data_at, field_address_offset by auto with field_compatible.
@@ -274,7 +273,7 @@ Lemma Init_part1_len_le_j Espec (kb ckb cb: block) (kofs ckoff cofs:ptrofs)
               (Vptr cb cofs))
 (FC_cxtkey : field_compatible (Tarray tuchar 64 noattr) [] (Vptr ckb ckoff))
 (ge_64_l : 64 >= l),
-@semax CompSpecs Espec
+semax(OK_spec := Espec)(C := CompSpecs) ⊤
        (func_tycontext f_HMAC_Init HmacVarSpecs HmacFunSpecs nil)
   (PROP  ()
    LOCAL  (temp _j (Vint (Int.repr 64)); temp _reset (Vint (Int.repr 1));
@@ -330,8 +329,8 @@ Proof. intros.
      { unfold tarray. unfold field_at_ at 1. rewrite field_at_data_at.
        rewrite field_address_offset by auto with field_compatible; simpl. rewrite Ptrofs.add_zero.
        rewrite (split2_data_at_Tarray_tuchar _ _ l); trivial. 2: lia.
-       rewrite sepcon_comm.
-       rewrite sepcon_assoc.
+       rewrite <- sepcon_comm.
+       rewrite <- sepcon_assoc.
        apply sepcon_derives. eapply derives_trans. apply data_at_memory_block.
            simpl. rewrite Z.max_r. rewrite Z.mul_1_l.  apply derives_refl. lia.
        Time cancel. (*0.1 versus 2.4*) }
@@ -341,11 +340,11 @@ Proof. intros.
      remember (map Vubyte key) as KCONT.
 
      (*call memset*)
-     freeze FR2 := - (@data_at CompSpecs _ _ _ (@field_address0 CompSpecs _ _ (Vptr ckb _))).
+     freeze FR2 := - (data_at(cs := CompSpecs) _ _ _ (field_address0(cs := CompSpecs) _ _ (Vptr ckb _))).
      Time forward_call (Tsh, Vptr ckb (Ptrofs.add ckoff (Ptrofs.repr (Zlength key))), l64, Int.zero). (*6.4 versus 10.4*)
      { entailer!. }
      { rewrite <- KL1.
-       rewrite sepcon_comm. Time apply sepcon_derives; [ | cancel]. (*0.1 versus 1.2*)
+       rewrite <- sepcon_comm. Time apply sepcon_derives; [ | cancel]. (*0.1 versus 1.2*)
        unfold at_offset. simpl.
          eapply derives_trans; try apply data_at_memory_block.
                rewrite sizeof_Tarray. trivial.
diff --git a/sha/verif_hmac_init_part2.v b/sha/verif_hmac_init_part2.v
index ec1b985850..f80a18d9de 100644
--- a/sha/verif_hmac_init_part2.v
+++ b/sha/verif_hmac_init_part2.v
@@ -2,7 +2,6 @@ Require Import VST.floyd.proofauto.
 Import ListNotations.
 Require sha.sha.
 Require Import sha.SHA256.
-Local Open Scope logic.
 
 Require Import sha.spec_sha.
 Require Import sha.sha_lemmas.
@@ -202,7 +201,7 @@ Definition initPostResetConditional r (c:val) (k: val) h wsh sh key iS oS: mpred
   | _ => FF
   end.
 
-Lemma ipad_loop Espec pb pofs cb cofs ckb ckoff kb kofs l key gv (FR:mpred): forall
+Lemma ipad_loop Espec E pb pofs cb cofs ckb ckoff kb kofs l key gv (FR:mpred): forall
 (IPADcont : list val)
 (HeqIPADcont : IPADcont =
               map Vubyte
@@ -210,7 +209,7 @@ Lemma ipad_loop Espec pb pofs cb cofs ckb ckoff kb kofs l key gv (FR:mpred): for
 (ZLI : Zlength
         (HMAC_SHA256.mkArg (HMAC_SHA256.mkKey key) Ipad) =
       64),
-@semax CompSpecs Espec
+semax(OK_spec := Espec)(C := CompSpecs) E
   (func_tycontext f_HMAC_Init HmacVarSpecs HmacFunSpecs nil)
   (PROP  ()
    LOCAL  (temp _reset (Vint (Int.repr 1));
@@ -295,7 +294,7 @@ Proof. intros. abbreviate_semax.
             repeat rewrite map_nth. rewrite Qb. trivial.
           }
 
-        Time freeze FR1 := - (@data_at CompSpecs _ _ _ (Vptr ckb _)).
+        Time freeze FR1 := - (data_at(cs := CompSpecs) _ _ _ (Vptr ckb _)).
 (*
         Time forward; [ | forward]; (*6.7 versus 9*)
 *)
@@ -344,7 +343,7 @@ drop_LOCAL 0%nat. apply derives_refl.
 subst IPADcont; rewrite Zlength_map. rewrite ZLI; trivial.
 Time Qed. (*VST 2.0: 0.4s*) (*11.1 versus 16.8*) (*FIXME NOW 39*)
 
-Lemma opadloop Espec pb pofs cb cofs ckb ckoff kb kofs l wsh key gv (FR:mpred): forall
+Lemma opadloop Espec E pb pofs cb cofs ckb ckoff kb kofs l wsh key gv (FR:mpred): forall
 (Hwsh: writable_share wsh)
 (IPADcont : list val)
 (HeqIPADcont : IPADcont =
@@ -358,7 +357,7 @@ Lemma opadloop Espec pb pofs cb cofs ckb ckoff kb kofs l wsh key gv (FR:mpred):
 (ZLO : Zlength (HMAC_SHA256.mkArg (HMAC_SHA256.mkKey key) Opad) = 64)
 (*Delta := abbreviate : tycontext*)
 (ipadSHAabs : s256abs),
-@semax CompSpecs Espec
+semax(OK_spec := Espec)(C := CompSpecs) E
   (func_tycontext f_HMAC_Init HmacVarSpecs HmacFunSpecs nil)
   (PROP  ()
    LOCAL  (temp _reset (Vint (Int.repr 1));
@@ -454,7 +453,7 @@ freeze FR1 := - (data_at _ _ _ (Vptr ckb _)) (data_block _ _ _).
            with a residual subgoal thats more complex to discharge*)
         Time forward. (*5.8 versus 4.8*) (*FIXME NOW: 19 secs*)
         Time entailer!. (*4.2 versus 5.6*)
-        apply derives_refl'. f_equal.
+        f_equiv.
         set (y := nth (Z.to_nat i) (HMAC_SHA256.mkKey key) Byte.zero).
 (*        rewrite <- (isbyte_zeroExt8 (Byte.unsigned _)) by rep_lia.*)
         unfold Int.xor. rewrite !Int.unsigned_repr by rep_lia.
diff --git a/sha/verif_hmac_simple.v b/sha/verif_hmac_simple.v
index 7e7846caed..07d07d2791 100644
--- a/sha/verif_hmac_simple.v
+++ b/sha/verif_hmac_simple.v
@@ -2,7 +2,6 @@ Require Import VST.floyd.proofauto.
 Import ListNotations.
 Require sha.sha.
 Require Import sha.SHA256.
-Local Open Scope logic.
 
 Require Import sha.spec_sha.
 Require Import sha.sha_lemmas.
@@ -45,7 +44,7 @@ Time forward_if  (
 Time normalize. (*0.8*)
 freeze FR1 := - (data_at_ _ _ c) (data_block _ _ k) (K_vector _).
 assert_PROP (isptr k) as isPtrK.
-{ unfold data_block. Time normalize. (*1.6 versus 2.2*) rewrite data_at_isptr with (p:=k). Time entailer!. (*1.6 versus 2.5*) }
+{ unfold data_block. entailer!. }
 
 Time forward_call (Tsh, shk, c, k, kl, key, HMACabs nil nil nil, gv). (*3*)
  { apply isptrD in isPtrK. destruct isPtrK as [kb [kofs HK]]. rewrite HK.
diff --git a/sha/verif_hmac_update.v b/sha/verif_hmac_update.v
index a3801cd8ab..8304134d00 100644
--- a/sha/verif_hmac_update.v
+++ b/sha/verif_hmac_update.v
@@ -2,7 +2,6 @@ Require Import VST.floyd.proofauto.
 Import ListNotations.
 Require sha.sha.
 Require sha.SHA256.
-Local Open Scope logic.
 
 Require Import sha.spec_sha.
 Require Import sha.sha_lemmas.
@@ -17,7 +16,7 @@ Lemma updatebodyproof Espec wsh sh c d len data gv (h1 : hmacabs)
       (H : has_lengthD (s256a_len (absCtxt h1)) len data)
    (Hwsh: writable_share wsh)
    (Hsh: readable_share sh):
-@semax CompSpecs Espec (func_tycontext f_HMAC_Update HmacVarSpecs HmacFunSpecs nil)
+semax(OK_spec := Espec)(C := CompSpecs) ⊤ (func_tycontext f_HMAC_Update HmacVarSpecs HmacFunSpecs nil)
   (PROP  ()
    LOCAL  (gvars gv; temp _ctx c; temp _data d;
            temp _len (Vint (Int.repr len)))
@@ -44,7 +43,7 @@ assert (FC_md_ctx: field_compatible t_struct_hmac_ctx_st [StructField _md_ctx] c
  {red in FC_c. repeat split; try solve [apply FC_c]. constructor; trivial. }
 assert (FC_i_ctx: field_compatible t_struct_hmac_ctx_st [StructField _i_ctx] c).
  {red in FC_c. repeat split; try solve [apply FC_c]. simpl. right; left; reflexivity. }
-unfold_data_at (@data_at CompSpecs _ _ _ c). 
+unfold_data_at (data_at(cs := CompSpecs) _ _ _ c). 
 freeze FR := - (K_vector _) (field_at _ _ [StructField _md_ctx] _ _) (data_block _ _ d).
 rewrite (field_at_data_at _ _ [StructField _md_ctx]).
 rewrite field_address_offset by auto with field_compatible.
@@ -71,7 +70,7 @@ unfold hmacstate_, sha256state_, hmac_relate.
 Intros r.  Exists (r,(iCtx ST, oCtx ST)).
 Time entailer!. (*2.1*)
 thaw FR.
-unfold_data_at (@data_at CompSpecs _ _ _ (Vptr b i)).
+unfold_data_at (data_at(cs := CompSpecs) _ _ _ (Vptr b i)).
 destruct ST as [ST1 [ST2 ST3]]. simpl in *.
 Time cancel. (*0.5*)
 rewrite (field_at_data_at _ _ [StructField _md_ctx]).
diff --git a/sha/verif_sha_bdo.v b/sha/verif_sha_bdo.v
index d6339c5012..c39fc9d3a3 100644
--- a/sha/verif_sha_bdo.v
+++ b/sha/verif_sha_bdo.v
@@ -7,7 +7,6 @@ Require Import sha.bdo_lemmas.
 Require Import sha.verif_sha_bdo4.
 Require Import sha.verif_sha_bdo7.
 Require Import sha.verif_sha_bdo8.
-Local Open Scope logic.
 
 Lemma body_sha256_block_data_order: semax_body Vprog Gtot f_sha256_block_data_order sha256_block_data_order_spec.
 Proof.
@@ -16,7 +15,7 @@ rename v_X into Xv.
 assert (Lregs: length regs = 8%nat)
  by (change 8%nat with (Z.to_nat 8); rewrite <- Zlength_length; auto).
 forward. (* data = in; *)
- match goal with |- semax _ _ ?c _ =>
+ match goal with |- semax _ _ _ ?c _ =>
   eapply seq_assocN with (cs := sequenceN 8 c)
  end. {
  semax_frame [ lvar _X (tarray tuint 16) Xv  ]
@@ -36,7 +35,7 @@ eapply semax_seq'. {
   semax_frame  [ ]
         [field_at wsh t_struct_SHA256state_st [StructField _h] (map Vint regs) ctx;
          data_block sh (intlist_to_bytelist b) data].
-  match goal with |- semax _ _ ?c _ => change c with block_data_order_loop2 end.
+  match goal with |- semax _ _ _ ?c _ => change c with block_data_order_loop2 end.
   eapply sha256_block_data_order_loop2_proof; eassumption.
 }
 eapply seq_assocN with (cs := add_them_back). {
@@ -44,7 +43,7 @@ eapply seq_assocN with (cs := add_them_back). {
              [K_vector gv;
              data_at_ Tsh (tarray tuint LBLOCKz) Xv;
              data_block sh (intlist_to_bytelist b) data].
-  simple apply (add_them_back_proof _ regs (Round regs (nthi b) 63) ctx); try assumption.
+  simple apply (add_them_back_proof _ _ regs (Round regs (nthi b) 63) ctx); try assumption.
   apply length_Round; auto.
 }
 simpl; abbreviate_semax.
@@ -52,13 +51,3 @@ forward. (* return; *)
 fold (hash_block regs b).
 entailer!.
 Qed.
-
-
-
-
-
-
-
-
-
-
diff --git a/sha/verif_sha_bdo4.v b/sha/verif_sha_bdo4.v
index e1a699b450..b1fc8c0679 100644
--- a/sha/verif_sha_bdo4.v
+++ b/sha/verif_sha_bdo4.v
@@ -4,7 +4,6 @@ Require Import sha.SHA256.
 Require Import sha.spec_sha.
 Require Import sha.sha_lemmas.
 Require Import sha.bdo_lemmas.
-Local Open Scope logic.
 
 Lemma rearrange_aux:
  forall h f c k l,
@@ -37,12 +36,12 @@ Definition block_data_order_loop1 :=
    (nth 0 (loops (fn_body f_sha256_block_data_order)) Sskip).
 
 Lemma sha256_block_data_order_loop1_proof:
-  forall (Espec : OracleKind) (sh: share)
+  forall Espec (sh: share)
      (b: list int) ctx (data: val) (regs: list int) gv Xv
      (Hregs: length regs = 8%nat)
      (Hsh: readable_share sh),
      Zlength b = LBLOCKz ->
-     semax (func_tycontext f_sha256_block_data_order Vprog Gtot nil)
+     semax(OK_spec := Espec) ⊤ (func_tycontext f_sha256_block_data_order Vprog Gtot nil)
   (PROP  ()
    LOCAL  (temp _a (Vint (nthi regs 0)); temp _b (Vint (nthi regs 1));
                 temp _c (Vint (nthi regs 2)); temp _d (Vint (nthi regs 3));
@@ -99,7 +98,7 @@ forward_for_simple_bound 16
  entailer!.
  all: simpl; cancel.  (* Needed in Coq 8.16 and before *)
 * (* loop body & loop condition preserves loop invariant *)
-assert_PROP (data_block sh (intlist_to_bytelist b) data =
+assert_PROP (data_block sh (intlist_to_bytelist b) data ⊣⊢
    array_at sh (tarray tuchar (Zlength b * 4)) [] 0 (i * 4)
        (sublist 0 (i * 4) (map Vubyte (intlist_to_bytelist b)))
        data *
@@ -119,12 +118,12 @@ assert_PROP (data_block sh (intlist_to_bytelist b) data =
    rewrite (split2_array_at _ _ _ (i*4) (i*4+4)) by (autorewrite with sublist; lia).
    autorewrite with sublist.
   rewrite <- !sepcon_assoc.
-  f_equal. f_equal.
+  f_equiv; auto. f_equiv; auto.
   rewrite Zlength_intlist_to_bytelist in H5.
   rewrite array_at_data_at' by (auto with field_compatible; lia).
   simpl.
   autorewrite with sublist.
-  fold (tarray tuchar 4). f_equal.
+  fold (tarray tuchar 4). f_equiv.
    rewrite <- sublist_map.
   rewrite Z.add_comm, Z.mul_add_distr_r.
   reflexivity.
@@ -139,7 +138,7 @@ forward_call (* l = __builtin_read32_reversed(_data) *)
  autorewrite with sublist; lia.
 gather_SEP (array_at _ _ _ 0 _ _ data) (data_at _ _ _ (offset_val (i*4) data)) (array_at _ _ _ (i*4+4) _ _ data).
  match goal with |- context [SEPx (?A::_)] =>
-  replace A with (data_block sh (intlist_to_bytelist b) data);
+  setoid_replace A with (data_block sh (intlist_to_bytelist b) data);
    (* next line needed only before Coq 8.19 *)
    try solve [rewrite H1,<- !sepcon_assoc; auto]
  end.
@@ -168,7 +167,7 @@ replace (M i) with (W M i)
 assert_PROP (isptr data) as H3 by entailer!.
 change (data_at Tsh (tarray tuint  (Zlength K256)) (map Vint K256) (gv _K256)) with (K_vector gv).
 change (tarray tuint LBLOCKz) with (tarray tuint 16).
-match goal with |- semax _ (PROPx _ (LOCALx _ (SEPx ?R))) _ _ =>
+match goal with |- semax _ _ (PROPx _ (LOCALx _ (SEPx ?R))) _ _ =>
   semax_frame [  ] R
 end.
 clear b H1 H.
diff --git a/sha/verif_sha_bdo7.v b/sha/verif_sha_bdo7.v
index 3bee00c095..1a8c0118eb 100644
--- a/sha/verif_sha_bdo7.v
+++ b/sha/verif_sha_bdo7.v
@@ -4,7 +4,6 @@ Require Import sha.SHA256.
 Require Import sha.spec_sha.
 Require Import sha.sha_lemmas.
 Require Import sha.bdo_lemmas.
-Local Open Scope logic.
 
 Definition block_data_order_loop2 :=
    nth 1 (loops (fn_body f_sha256_block_data_order)) Sskip.
@@ -170,11 +169,11 @@ Qed.
 
 
 Lemma sha256_block_data_order_loop2_proof:
-  forall (Espec : OracleKind)
+  forall Espec E
      (b: list int) ctx (regs: list int) gv Xv
      (Hregs: length regs = 8%nat),
      Zlength b = LBLOCKz ->
-     semax (func_tycontext f_sha256_block_data_order Vprog Gtot nil)
+     semax(OK_spec := Espec) E (func_tycontext f_sha256_block_data_order Vprog Gtot nil)
  (PROP ()
    LOCAL (temp _ctx ctx; temp _i (Vint (Int.repr 16));
                temp _a (Vint (nthi (Round regs (nthi b) (LBLOCKz-1)) 0));
diff --git a/sha/verif_sha_bdo8.v b/sha/verif_sha_bdo8.v
index 8b0046a5f6..9727324f45 100644
--- a/sha/verif_sha_bdo8.v
+++ b/sha/verif_sha_bdo8.v
@@ -4,7 +4,6 @@ Require Import sha.SHA256.
 Require Import sha.spec_sha.
 Require Import sha.sha_lemmas.
 Require Import sha.bdo_lemmas.
-Local Open Scope logic.
 
 Definition load8 id ofs :=
  (Sset id
@@ -31,11 +30,11 @@ apply Nat2Z.inj_lt in H; auto.
 Qed.
 
 Lemma sha256_block_load8:
-  forall (Espec : OracleKind)
+  forall Espec E
      (data: val) (r_h: list int) (ctx: val) gv (wsh: share)
    (Hwsh: writable_share wsh)
    (H5 : length r_h = 8%nat),
-     semax
+     semax(OK_spec := Espec) E
          (func_tycontext f_sha256_block_data_order Vprog Gtot nil)
   (PROP  ()
    LOCAL  (temp _data data; gvars gv; temp _ctx ctx; temp _in data)
@@ -290,11 +289,11 @@ simpl; auto.
 Qed.
 
 Lemma add_them_back_proof:
-  forall (Espec : OracleKind)
+  forall Espec E
      (regs regs': list int) (ctx: val) gv (wsh: share) (Hwsh: writable_share wsh),
      length regs = 8%nat ->
      length regs' = 8%nat ->
-     semax  (func_tycontext f_sha256_block_data_order Vprog Gtot nil)
+     semax(OK_spec := Espec) E (func_tycontext f_sha256_block_data_order Vprog Gtot nil)
    (PROP  ()
    LOCAL  (temp _ctx ctx;
                 temp _a  (Vint (nthi regs' 0));
@@ -359,6 +358,3 @@ simpl upd_Znth; rewrite ADD_S by (try reflexivity; clear; lia).
 rewrite (add_upto_8 _ _ H H0).
 entailer!.
 Qed.
-
-
-
diff --git a/sha/verif_sha_final.v b/sha/verif_sha_final.v
index 3c2ab4337f..6e1ad542f1 100644
--- a/sha/verif_sha_final.v
+++ b/sha/verif_sha_final.v
@@ -5,7 +5,6 @@ Require Import sha.spec_sha.
 Require Import sha.sha_lemmas.
 Require Import sha.verif_sha_final2.
 Require Import sha.verif_sha_final3.
-Local Open Scope logic.
 
 
 Lemma upd_Znth_append:
@@ -137,13 +136,16 @@ autorewrite with sublist.
 cancel.
 rewrite array_at_data_at'; auto; try apply derives_refl; lia.
 +
-subst POSTCONDITION; unfold abbreviate; simpl_ret_assert; normalize.
+subst POSTCONDITION; unfold abbreviate; simpl_ret_assert.
 rewrite hashed_data_recombine by auto.
+go_lowerx; cancel.
 auto.
 +
-subst POSTCONDITION; unfold abbreviate; simpl_ret_assert; normalize.
+subst POSTCONDITION; unfold abbreviate; simpl_ret_assert.
+iIntros "(_ & [] & _)".
 +
-subst POSTCONDITION; unfold abbreviate; simpl_ret_assert; normalize.
+subst POSTCONDITION; unfold abbreviate; simpl_ret_assert.
+iIntros "(_ & [] & _)".
 +
 intros. subst POSTCONDITION; unfold abbreviate; simpl_ret_assert.
 rewrite hashed_data_recombine by auto.
@@ -154,4 +156,3 @@ unfold s256a_len.
 autorewrite with sublist.
 auto.
 Qed.  (*02/21/2020:2.6s versus 40.5 sec (14.375u) *)
-
diff --git a/sha/verif_sha_final2.v b/sha/verif_sha_final2.v
index be93f5164a..0d67edf899 100644
--- a/sha/verif_sha_final2.v
+++ b/sha/verif_sha_final2.v
@@ -5,7 +5,6 @@ Require Import sha.spec_sha.
 Require Import sha.sha_lemmas.
 Require Import sha.call_memcpy.
 Local Open Scope Z.
-Local Open Scope logic.
 
 Lemma cancel_field_at_array_partial_undef:
  forall {cs: compspecs} sh t t1 n gfs p (al bl: list (reptype t)) blen v1 v2,
@@ -59,8 +58,7 @@ rewrite (split2_array_at _ _ _ 0 (Zlength al) (Zlength (al++bl))).
 apply (JMeq_trans (JMeq_sym H3)) in H1.
 apply (JMeq_trans (JMeq_sym H4)) in H2.
 apply sepcon_derives.
-apply derives_refl'.
-f_equal.
+f_equiv.
 rewrite Z.sub_0_r.
 clear - H1 H2 H5 H.
 revert v1' v2' H1 H2.
@@ -73,8 +71,7 @@ rewrite <- H1. rewrite <- H2.
 autorewrite with sublist. auto.
 eapply derives_trans; [apply array_at_array_at_ | ].
 unfold array_at_.
-apply derives_refl'.
-f_equal.
+f_equiv.
 rewrite Z.sub_0_r.
 clear - H2 H5 H.
 revert v2' H2.
@@ -116,11 +113,11 @@ reflexivity.
 Qed.
 
 Lemma final_if1:
-forall (Espec : OracleKind)  (a : s256abs) (md c : val) (wsh shmd : share) (gv : globals) (r_data : list val)
+forall Espec (a : s256abs) (md c : val) (wsh shmd : share) (gv : globals) (r_data : list val)
  (Hwsh: writable_share wsh),
 sublist 0 (Zlength (s256a_data a)) r_data = map Vubyte (s256a_data a) ->
 Zlength r_data = CBLOCKz ->
-semax (func_tycontext f_SHA256_Final Vprog Gtot nil)
+semax(OK_spec := Espec) ⊤ (func_tycontext f_SHA256_Final Vprog Gtot nil)
   (PROP ( )
    LOCAL (temp _n (Vint (Int.repr (Zlength (s256a_data a) + 1)));
    temp _p (field_address t_struct_SHA256state_st [StructField _data] c); 
@@ -142,9 +139,7 @@ semax (func_tycontext f_SHA256_Final Vprog Gtot nil)
            (Ebinop Omul (Econst_int (Int.repr 16) tint) (Econst_int (Int.repr 4) tint) tint)
            (Econst_int (Int.repr 8) tint) tint) tint) Body_final_if1 Sskip)
   (normal_ret_assert (
-   @exp (environ -> mpred) _ _ (fun hashed': list int =>
-   @exp (environ -> mpred) _ _ (fun dd': list byte =>
-   @exp (environ -> mpred) _ _ (fun pad: Z =>
+   EX hashed': list int, EX dd': list byte, EX pad: Z,
    PROP  (pad=0%Z \/ dd'=nil;
               Zlength dd' + 8 <= CBLOCKz;
               0 <= pad < 8;
@@ -166,7 +161,7 @@ semax (func_tycontext f_SHA256_Final Vprog Gtot nil)
                Vundef))))
            c;
            K_vector gv;
-           memory_block shmd 32 md)))))).
+           memory_block shmd 32 md))).
 Proof.
 intros.
 assert (H3 := s256a_data_Zlength_less a).
@@ -220,23 +215,22 @@ set (fill_len := (64 - (ddlen + 1))).
  unfold Body_final_if1; abbreviate_semax.
 change CBLOCKz with 64 in Hddlen.
 unfold_data_at (data_at _ _ _ _).
+freeze FR1 := -(field_at wsh t_struct_SHA256state_st (DOT _data) _ c).
 eapply semax_seq'.
-evar (Frame: list mpred).
-evar (V: list val).
   eapply (call_memset_tuchar wsh
    (*dst*) t_struct_SHA256state_st [StructField _data] (ddlen+1)
-                V c
+                _ c
    (*src*) Int.zero
    (*len*) (CBLOCKz - (ddlen+1))
-        Frame); try reflexivity; try lia; auto.
+   [FRZL FR1]); try reflexivity; try lia; auto.
  split; try lia. change CBLOCKz with 64; rep_lia.
  change CBLOCKz with 64; lia.
- subst V.
  entailer!. {
  rewrite field_address0_offset by auto with field_compatible.
  rewrite field_address_offset by auto with field_compatible.
  simpl. normalize.
 }
+thaw' FR1; simpl; Intros.
  abbreviate_semax.
 replace (ddlen + 1 + (CBLOCKz - (ddlen + 1))) with CBLOCKz by (clear; lia).
 change 64 with CBLOCKz.
@@ -255,7 +249,7 @@ replace (splice_into_list (ddlen + 1) CBLOCKz
  unfold splice_into_list.
  change CBLOCKz with 64 in *.
  autorewrite with sublist. reflexivity. 
-} 
+}
 pose (ddzw := bytelist_to_intlist ddz).
 assert (H0': Zlength ddz = CBLOCKz). {
   clear - Hddlen H3. subst ddz ddlen.
@@ -281,19 +275,11 @@ forward_call (* sha256_block_data_order (c,p); *)
     field_address t_struct_SHA256state_st [StructField _data] c,
     wsh, gv).
 {
-  repeat rewrite sepcon_assoc; apply sepcon_derives; [ | cancel].
+  apply sepcon_derives; [ | cancel].
   unfold data_block.
   autorewrite with sublist.
   rewrite H1', <- HU. change (LBLOCKz*4)%Z with 64.
-  apply derives_refl'. clear Frame. f_equal.
-  subst ddz fill_len ddlen.
-  change CBLOCKz with 64.
-  rewrite !map_app.
-  unfold splice_into_list.
-  autorewrite with sublist.
-  rewrite (app_assoc (map Vubyte dd)).
-  autorewrite with sublist.
-  reflexivity.
+  cancel.
 }
  rewrite hash_blocks_last by auto.
  set (pad := (CBLOCKz - (ddlen+1))%Z) in *.
@@ -301,7 +287,7 @@ forward_call (* sha256_block_data_order (c,p); *)
  entailer!.
 *
 split.
- + rewrite initial_world.Zlength_app.
+ + rewrite Zlength_app.
   apply Z.divide_add_r; auto. rewrite H1'.
   apply Z.divide_refl.
  +
diff --git a/sha/verif_sha_final3.v b/sha/verif_sha_final3.v
index b7e1aed6cf..4daf6f6292 100644
--- a/sha/verif_sha_final3.v
+++ b/sha/verif_sha_final3.v
@@ -3,7 +3,6 @@ Require Import sha.sha.
 Require Import sha.SHA256.
 Require Import sha.spec_sha.
 Require Import sha.sha_lemmas.
-Local Open Scope logic.
 
 Definition final_loop :=
  Sfor (Sset _xn (Econst_int (Int.repr 0) tint))
@@ -116,14 +115,14 @@ apply Z.divide_1_l.
 Qed.
 
 Lemma sha_final_part3:
-forall (Espec : OracleKind) (md c : val) (wsh shmd : share)
+forall Espec (md c : val) (wsh shmd : share)
   (hashed lastblock: list int) msg gv
  (Hwsh: writable_share wsh)
  (Hshmd: writable_share shmd),
  (LBLOCKz | Zlength hashed) ->
  Zlength lastblock = LBLOCKz ->
  generate_and_pad msg = hashed++lastblock ->
-semax
+semax(OK_spec := Espec) ⊤
      (func_tycontext f_SHA256_Final Vprog Gtot nil)
   (PROP  ()
    LOCAL  (temp _p (field_address t_struct_SHA256state_st [StructField _data] c);
@@ -206,7 +205,7 @@ Proof.
  unfold final_loop.
 
  forward_for_simple_bound 8
-   (@exp (environ -> mpred) _ _ (fun i: Z =>
+   (EX i: Z,
    PROP  ()
    LOCAL  (temp _md (offset_val (i * 4) md);
                 temp _c c)
@@ -218,7 +217,7 @@ Proof.
     data_at shmd (tarray tuchar 32)
          (map Vubyte (intlist_to_bytelist (sublist 0 i hashedmsg))
            ++ repeat Vundef (Z.to_nat (32 - WORD*i))) md)
-     )).
+     ).
 *
  entailer!.
  change 32%Z with (sizeof (tarray tuchar 32)) at 1.
@@ -270,7 +269,7 @@ Proof.
   + sep_apply (array_at_memory_block shmd (tarray tuchar N32) nil (i*4)).
     lia. simpl. normalize. replace  (i * 4 + 4 - i * 4) with 4 by lia.
     cancel.
-  + subst bytes. autorewrite with sublist. clear; lia.
+  + unfold bytes; autorewrite with sublist; clear; lia.
   + forward. (* md += 4; *)
     replace (32 - WORD * (i+1)) with (N32 - i*4-WORD)
       by  (subst N32; change WORD with 4; lia).
@@ -301,8 +300,7 @@ Proof.
     rewrite !array_at_data_at' by (auto with field_compatible; lia).
     simpl.
     autorewrite with sublist.
-    apply derives_refl'.
-    f_equal.
+    f_equiv.
     rewrite field_address0_offset by auto with field_compatible.
     normalize.
 * change 64%Z with CBLOCKz.
@@ -314,7 +312,7 @@ Proof.
 Time Qed. (*02/21/20: 1.9s (WAS: 64 sec) *)
 
 Lemma final_part2:
-forall (Espec : OracleKind) (hashed : list int) (md c : val) (wsh shmd : share) gv
+forall Espec (hashed : list int) (md c : val) (wsh shmd : share) gv
 (Hwsh: writable_share wsh),
 writable_share shmd ->
 forall bitlen (dd : list byte),
@@ -328,7 +326,7 @@ forall (hashed': list int) (dd' : list byte) (pad : Z),
 (LBLOCKz | Zlength hashed') ->
 intlist_to_bytelist hashed' ++ dd' =
 intlist_to_bytelist hashed ++ dd ++ [Byte.repr 128%Z] ++ repeat Byte.zero (Z.to_nat pad) ->
-semax
+semax(OK_spec := Espec) ⊤
      (func_tycontext f_SHA256_Final Vprog Gtot nil)
   (PROP  ()
       LOCAL
@@ -368,10 +366,6 @@ Proof.
 
   Time forward. (* cNh=c->Nh; *) (*3.5*)
 
-  match goal with |- semax _ (PROPx _ (LOCALx _ (SEPx (?A :: _)))) _ _ =>
-    pattern A;
-    match goal with |- ?F A => set (GOAL := F) end
-  end.
   erewrite field_at_Tarray;
    [ | apply compute_legal_nested_field_spec'; repeat constructor; auto; lia
    | reflexivity | lia | apply JMeq_refl].
@@ -381,6 +375,10 @@ Proof.
    rewrite (split3seg_array_at _ _ _ 0 56 60) by (autorewrite with sublist; rep_lia).
    rewrite !app_assoc.
    assert (CBZ := CBLOCKz_eq).
+  match goal with |- semax _ _ (PROPx _ (LOCALx _ (SEPx (?A :: _)))) _ _ =>
+    pattern A;
+    match goal with |- ?F A => set (GOAL := F) end
+  end.
    Time autorewrite with sublist. (*7*)
     clear CBZ.
   subst GOAL. cbv beta. Intros.
@@ -389,7 +387,7 @@ Proof.
                     [ArraySubsc 56; StructField _data] c,
       wsh, hibytes). (*9*)
   { apply prop_right; repeat constructor; hnf; simpl.
-    rewrite (nth_big_endian_integer 0 [hi_part bitlen]) at 1 by reflexivity.
+    rewrite (nth_big_endian_integer 0 [hi_part bitlen] (hi_part bitlen)) by reflexivity.
     rewrite field_address_offset.
     rewrite field_address0_offset by auto with field_compatible; reflexivity.
     red in FC; red. simpl in FC; simpl. intuition. }
@@ -406,14 +404,14 @@ Proof.
                     [ArraySubsc 60; StructField _data] c,
      wsh, lobytes). (*8.8*)
   { apply prop_right; repeat constructor; hnf; simpl.
-    rewrite (nth_big_endian_integer 0 [lo_part bitlen]) at 1 by reflexivity.
+    rewrite (nth_big_endian_integer 0 [lo_part bitlen] (lo_part bitlen)) by reflexivity.
     rewrite field_address0_offset by auto with field_compatible.
     rewrite field_address_offset by (pose proof CBLOCKz_eq; auto with field_compatible).
     reflexivity. }
   { clear; compute; congruence. }
 
   match goal with |- context [SEPx (?A :: _)] =>
-   replace A with (array_at wsh t_struct_SHA256state_st [StructField _data] 60 64
+   setoid_replace A with (array_at wsh t_struct_SHA256state_st [StructField _data] 60 64
                            (map Vubyte lobytes) c)
   by (clear - FC;
         rewrite array_at_data_at' by auto with field_compatible;
@@ -476,4 +474,3 @@ Proof.
      assumption.
   * eapply generate_and_pad_lemma1; eassumption.
 Time Qed. (*VST2.0: 3.1s *)
-
diff --git a/sha/verif_sha_init.v b/sha/verif_sha_init.v
index c7c005a5b5..d7b8cc7fb7 100644
--- a/sha/verif_sha_init.v
+++ b/sha/verif_sha_init.v
@@ -4,12 +4,10 @@ Require Import sha.SHA256.
 Require Import sha.sha_lemmas.
 Require Import sha.spec_sha.
 Local Open Scope nat.
-Local Open Scope logic.
 
 Lemma body_SHA256_Init: semax_body Vprog Gtot f_SHA256_Init SHA256_Init_spec.
 Proof.
 start_function.
-name c_ _c.
 unfold data_at_.
 (* BEGIN: without these lines, the "do 8 forward" takes 40 times as long. *)
 unfold field_at_.
@@ -28,8 +26,7 @@ Time entailer!. (* 5.2 sec *)
 repeat split; auto.
 unfold s256_h, fst, s256a_regs.
 rewrite hash_blocks_equation. reflexivity.
-unfold data_at. apply derives_refl'; f_equal.
-f_equal.
+unfold data_at. f_equiv.
 simpl.
 repeat (apply f_equal2; [f_equal; apply int_eq_e; compute; reflexivity | ]); auto.
 Time Qed. (* 33.6 sec *)
diff --git a/sha/verif_sha_update.v b/sha/verif_sha_update.v
index ece454f568..d75e026497 100644
--- a/sha/verif_sha_update.v
+++ b/sha/verif_sha_update.v
@@ -7,7 +7,6 @@ Require Import sha.verif_sha_update3.
 Require Import sha.verif_sha_update4.
 Require Import sha.call_memcpy.
 Local Open Scope Z.
-Local Open Scope logic.
 
 Lemma body_SHA256_Update: semax_body Vprog Gtot f_SHA256_Update SHA256_Update_spec.
 Proof.
@@ -85,7 +84,7 @@ assert_PROP (field_address t_struct_SHA256state_st [StructField _data] c = offse
   entailer!.
   normalize.
 rewrite <- H0.
-clear H0; pose (H0:=True).
+clear H0; pose (H0:=True%type).
 apply semax_seq with (sha_update_inv wsh sh (s256a_hashed a) len c d (s256a_data a) data gv false).
 * semax_subcommand Vprog Gtot f_SHA256_Update (@nil (ident * Annotation)).
  eapply semax_post_flipped.
@@ -102,7 +101,7 @@ apply semax_seq with (sha_update_inv wsh sh (s256a_hashed a) len c d (s256a_data
 + intros; simpl_ret_assert.
  rewrite S256abs_recombine by auto.
  apply andp_left2.
- normalize.
+ apply bi.sep_mono; last cancel.
  apply bind_ret_derives.
  Intros a'.
  apply derives_extract_PROP'; intro. (* this should be done a better way *)
@@ -159,12 +158,12 @@ forward_if (   PROP  ()
     assert (H2: len - b4d = Zlength dd')
       by (unfold dd'; autorewrite with sublist; MyOmega).
     make_sequential.
+    unfold_data_at (data_at _ _ _ c).
+    freeze FR1 := -(field_at(cs := CompSpecs) wsh t_struct_SHA256state_st (DOT _data) (repeat Vundef (Z.to_nat CBLOCKz)) c)
+      (data_at sh (tarray tuchar (Zlength data)) (map Vubyte data) d).
     eapply semax_post_flipped3.
-  -
-    assert_PROP (field_compatible0 (tarray tuchar (Zlength data)) [ArraySubsc b4d] d)
+  - assert_PROP (field_compatible0 (tarray tuchar (Zlength data)) [ArraySubsc b4d] d)
       by (entailer!; auto with field_compatible).
- evar (Frame: list mpred).
-  unfold_data_at (data_at _ _ _ c).
   eapply(call_memcpy_tuchar
    (*dst*) wsh t_struct_SHA256state_st [StructField _data] 0
                    (repeat Vundef (Z.to_nat CBLOCKz)) c
@@ -172,11 +171,11 @@ forward_if (   PROP  ()
                    (map Int.repr (map Byte.unsigned data))
                    d
    (*len*) (len - b4d)
-        Frame); try reflexivity; auto; try MyOmega.
+        [FRZL FR1]); try reflexivity; auto; try MyOmega.
   entailer!.
   rewrite map_Vubyte_eq'. cancel.
  -
- simpl tc_environ.
+ thaw' FR1; simpl.
  subst POSTCONDITION; unfold abbreviate. simpl_ret_assert.
  pose proof CBLOCKz_eq.
  unfold splice_into_list; autorewrite with sublist.
diff --git a/sha/verif_sha_update3.v b/sha/verif_sha_update3.v
index f0224e426a..5d2ece5d58 100644
--- a/sha/verif_sha_update3.v
+++ b/sha/verif_sha_update3.v
@@ -4,7 +4,6 @@ Require Import sha.SHA256.
 Require Import sha.spec_sha.
 Require Import sha.sha_lemmas.
 Require Import sha.call_memcpy.
-Local Open Scope logic.
 
 Definition update_inner_if_then :=
  (Ssequence
@@ -71,7 +70,7 @@ Definition inv_at_inner_if wsh sh hashed len c d dd data gv :=
  (PROP ()
   (LOCAL (temp _fragment (Vint (Int.repr (64 - Zlength dd)));
    temp _p (field_address t_struct_SHA256state_st [StructField _data] c);
-   temp _n (Vint (Int.repr (Zlength dd))); temp _data d; gvars gv; temp _c c; temp _data_ d;
+   temp _n (Vint (Int.repr (Zlength dd))); temp _data d; gvars gv; temp _c c; temp data_ d;
    temp _len (Vint (Int.repr len)))
    SEP  (data_at wsh t_struct_SHA256state_st
                  (map Vint (hash_blocks init_registers hashed),
@@ -84,9 +83,8 @@ Definition inv_at_inner_if wsh sh hashed len c d dd data gv :=
      data_block sh data d))).
 
 Definition sha_update_inv wsh sh hashed len c d (dd: list byte) (data: list byte) gv (done: bool)
-    : environ -> mpred :=
-   (*EX blocks:list int,*)  (* this line doesn't work; bug in Coq 8.4pl3 thru 8.4pl6?  *)
-   @exp (environ->mpred) _ _  (fun blocks:list int =>
+    : assert :=
+   EX blocks:list int,
    PROP  ((len >= Zlength blocks*4 - Zlength dd)%Z;
               (LBLOCKz | Zlength blocks);
               intlist_to_bytelist blocks = dd ++ sublist 0  (Zlength blocks * 4 - Zlength dd) data;
@@ -99,27 +97,26 @@ Definition sha_update_inv wsh sh hashed len c d (dd: list byte) (data: list byte
                 temp _len (Vint (Int.repr (len- (Zlength blocks*4 - Zlength dd))));
                 gvars gv)
    SEP  (K_vector gv;
-           @data_at CompSpecs wsh t_struct_SHA256state_st
+           data_at(cs := CompSpecs) wsh t_struct_SHA256state_st
                  ((map Vint (hash_blocks init_registers (hashed++blocks)),
                   (Vint (lo_part (bitlength hashed dd + len*8)),
                    (Vint (hi_part (bitlength hashed dd + len*8)),
                     (repeat Vundef (Z.to_nat CBLOCKz), Vundef)))) : reptype t_struct_SHA256state_st)
                c;
-            data_block sh data d)).
+            data_block sh data d).
 
 Lemma data_block_data_field:
  forall sh dd dd' c,
   (Zlength dd = CBLOCKz)%Z ->
   JMeq (map Vubyte dd) dd' ->
-  data_block sh dd (field_address t_struct_SHA256state_st [StructField _data] c) =
+  data_block sh dd (field_address t_struct_SHA256state_st [StructField _data] c) ⊣⊢
   field_at sh t_struct_SHA256state_st [StructField _data] dd' c.
 Proof.
 intros.
 unfold data_block.
 erewrite field_at_data_at by reflexivity.
 repeat rewrite prop_true_andp by auto.
-apply equal_f.
-apply data_at_type_changable; auto.
+erewrite data_at_type_changable; auto.
 rewrite H; reflexivity.
 Qed.
 
@@ -209,7 +206,7 @@ rewrite !map_map. f_equal.
 Qed.
 
 Lemma update_inner_if_proof:
- forall (Espec: OracleKind) (hashed: list int) (dd data: list byte)
+ forall Espec (hashed: list int) (dd data: list byte)
             (c d: val) (wsh sh: share) (len: Z) gv
  (H: (0 <= len <= Zlength data)%Z)
  (Hwsh: writable_share wsh)
@@ -218,7 +215,7 @@ Lemma update_inner_if_proof:
  (H3 : (Zlength dd < CBLOCKz)%Z)
  (H4 : (LBLOCKz | Zlength hashed))
  (Hlen : (len <= Int.max_unsigned)%Z),
-semax (func_tycontext f_SHA256_Update Vprog Gtot nil)
+semax(OK_spec := Espec) ⊤ (func_tycontext f_SHA256_Update Vprog Gtot nil)
   (inv_at_inner_if wsh sh hashed len c d dd data gv)
   update_inner_if
   (overridePost (sha_update_inv wsh sh hashed len c d dd data gv false)
@@ -245,6 +242,9 @@ forward_if.
  unfold k.
  clear - H H1 H3 H4 Hlen Hwsh Hsh H0 H2.
  unfold update_inner_if_then.
+ unfold_data_at (data_at _ _ _ c).
+ freeze FR1 := - (field_at(cs := CompSpecs) wsh t_struct_SHA256state_st (DOT _data)
+            (map Vubyte dd ++ repeat Vundef (Z.to_nat _)) c) (data_at sh (tarray tuchar (Zlength data)) _ d).
  eapply semax_seq'.
   *
    assert_PROP (field_address (tarray tuchar (Zlength data)) [ArraySubsc 0] d = d). {
@@ -253,7 +253,6 @@ forward_if.
      normalize.
    }
   rename H5 into Hd.
-  evar (Frame: list mpred).
   eapply(call_memcpy_tuchar
    (*dst*) wsh t_struct_SHA256state_st [StructField _data] (Zlength dd)
               (map Vubyte dd
@@ -261,15 +260,15 @@ forward_if.
                c
    (*src*) sh (tarray tuchar (Zlength data)) [ ] 0 (map Int.repr (map Byte.unsigned data))  d
    (*len*) k
-        Frame);
+        [FRZL FR1]);
   try reflexivity; auto; try lia.
-  unfold_data_at (data_at _ _ _ c).
+  thaw' FR1.
   entailer!.
   rewrite field_address_offset by auto.
   rewrite !field_address0_offset by (subst k; auto with field_compatible).
   simpl.
-  normalize. rewrite map_Vubyte_eq'; cancel.
-  *
+  rewrite map_Vubyte_eq'; entailer!!.
+  * thaw' FR1; simpl; Intros.
   replace (Zlength dd + k)%Z with 64%Z by Omega1.
   subst k.
   unfold splice_into_list; autorewrite with sublist.
@@ -298,14 +297,15 @@ forward_if.
  forward. (* data  += fragment; *)
  forward. (* len -= fragment; *)
  normalize_postcondition.
+ freeze FR1 := - (data_block wsh (intlist_to_bytelist (bytelist_to_intlist (dd ++ sublist 0 k data)))
+     (field_address t_struct_SHA256state_st (DOT _data) c)).
  eapply semax_post_flipped3.
- evar (Frame: list mpred).
  eapply(call_memset_tuchar
    (*dst*) wsh t_struct_SHA256state_st [StructField _data] 0
                 (map Vubyte (dd ++ sublist 0 k data)) c
    (*src*) Int.zero
    (*len*) 64
-        Frame); try reflexivity; auto.
+        [FRZL FR1]); try reflexivity; auto.
   rewrite <- (data_block_data_field _ (dd ++ sublist 0 k data));
    [
    | rewrite Zlength_app; rewrite Zlength_sublist; MyOmega
@@ -315,6 +315,7 @@ forward_if.
    [ | exists LBLOCKz; rewrite H5; reflexivity
    ].
   entailer!.
+  thaw' FR1; simpl fold_right_sepcon; Intros.
   Exists (bytelist_to_intlist (dd ++ sublist 0 k data)).
   erewrite Zlength_bytelist_to_intlist
      by (instantiate (1:=LBLOCKz); assumption).
@@ -331,7 +332,7 @@ forward_if.
   entailer!.
   rewrite field_address0_offset
     by (pose proof LBLOCKz_eq; subst k; auto with field_compatible).
-  f_equal. f_equal. unfold k. simpl. Omega1.
+  f_equal. unfold k. simpl. Omega1.
   unfold data_block.
   unfold_data_at (data_at _ _ _ c).
   rewrite map_Vubyte_eq'; cancel.
@@ -347,22 +348,25 @@ forward_if.
      rewrite field_address0_offset by auto with field_compatible.
      normalize.
    }
+  unfold_data_at (data_at _ _ _ c).
+  freeze FR1 := - (field_at(cs := CompSpecs) wsh t_struct_SHA256state_st (DOT _data)
+            (map Vubyte dd ++ repeat Vundef (Z.to_nat _)) c) (data_at sh (tarray tuchar (Zlength data)) _ d).
   eapply semax_seq'.
-  evar (Frame: list mpred).
   eapply(call_memcpy_tuchar
    (*dst*) wsh t_struct_SHA256state_st [StructField _data] (Zlength dd)
                      (map Vubyte dd ++
          repeat Vundef (Z.to_nat (CBLOCKz - Zlength dd))) c
    (*src*) sh (tarray tuchar (Zlength data)) [ ] 0 (map Int.repr (map Byte.unsigned data))  d
    (*len*) (len)
-        Frame);
+        [FRZL FR1]);
     try reflexivity; auto; try lia.
   entailer!.
   rewrite field_address_offset by auto with field_compatible.
   rewrite field_address0_offset by
    (subst k; auto with field_compatible).
   rewrite offset_offset_val; simpl. rewrite Z.mul_1_l; auto.
-  unfold_data_at (data_at _ _ _ c). rewrite map_Vubyte_eq'. cancel.
+  rewrite map_Vubyte_eq'. cancel.
+  thaw' FR1; simpl; Intros.
   abbreviate_semax.
   autorewrite with sublist.
   unfold splice_into_list.
@@ -385,8 +389,7 @@ forward_if.
   subst k.
   rewrite (prop_true_andp);
      [ | apply update_inner_if_update_abs; auto; lia ].
- rewrite (sepcon_comm (K_vector gv)).
- apply sepcon_derives; [ | auto].
- rewrite map_Vubyte_eq'. 
- simple eapply update_inner_if_sha256_state_; eauto.
+ cancel.
+ rewrite map_Vubyte_eq'.
+ rewrite <- update_inner_if_sha256_state_; eauto; cancel.
 Qed.
diff --git a/sha/verif_sha_update4.v b/sha/verif_sha_update4.v
index c7db314716..46b156ac68 100644
--- a/sha/verif_sha_update4.v
+++ b/sha/verif_sha_update4.v
@@ -5,7 +5,6 @@ Require Import sha.spec_sha.
 Require Import sha.sha_lemmas.
 Require Import sha.verif_sha_update3.
 Local Open Scope Z.
-Local Open Scope logic.
 
 Lemma Hblocks_lem:
  forall {blocks: list int} {frag: list byte} {data},
@@ -52,7 +51,7 @@ Definition update_outer_if :=
         Sskip.
 
 Lemma update_outer_if_proof:
- forall  (Espec : OracleKind) (hashed : list int)
+ forall  Espec (hashed : list int)
            (dd data : list byte) (c d : val) (wsh sh : share) (len : Z) gv
    (H : 0 <= len <= Zlength data)
    (Hwsh: writable_share wsh)
@@ -61,12 +60,12 @@ Lemma update_outer_if_proof:
    (H3 : Zlength dd < CBLOCKz)
    (H4 : (LBLOCKz | Zlength hashed))
    (Hlen : len <= Int.max_unsigned),
-semax
+semax(OK_spec := Espec) ⊤
      (func_tycontext f_SHA256_Update Vprog Gtot nil)
   (PROP  ()
    LOCAL (temp _p (field_address t_struct_SHA256state_st [StructField _data] c);
    temp _n (Vint (Int.repr (Zlength dd))); temp _data d; gvars gv; temp _c c; 
-   temp _data_ d; temp _len (Vint (Int.repr len)))
+   temp data_ d; temp _len (Vint (Int.repr len)))
    (*LOCAL
    (temp _p (field_address t_struct_SHA256state_st [StructField _data] c);
     temp _n (Vint (Int.repr (Zlength dd)));
@@ -130,37 +129,11 @@ simpl. normalize.
   with automatic cancel...
 *)
 
-Tactic Notation "unfold_data_atx" uconstr(a) :=
- tryif (is_nat_uconstr a)
- then (
-    idtac "Warning: unfold_data_at with numeric argument is deprecated";
-     let x := constr:(a) in unfold_data_at_tac x
-   )
- else
- (let x := fresh "x" in set (x := a : mpred);
-  lazymatch goal with
-  | x := ?D : mpred |- _ =>
-    match D with
-     | (@data_at_ ?cs ?sh ?t ?p) =>
-            change D with (@field_at_mark cs sh t (@nil gfield) (@default_val cs (@nested_field_type cs t nil)) p) in x
-     | (@data_at ?cs ?sh ?t ?v ?p) =>
-            change D with (@field_at_mark cs sh t (@nil gfield) v p) in x
-     | (@field_at_ ?cs ?sh ?t ?gfs ?p) =>
-            change D with (@field_at_mark cs sh t gfs (@default_val cs (@nested_field_type cs t gfs)) p) in x
-     | (@field_at ?cs ?sh ?t ?gfs ?v ?p) =>
-            change D with (@field_at_mark cs sh t gfs v p) in x
-     end;
-        subst x;  unfold_field_at';
-idtac (*
-   repeat match goal with |- context [@field_at ?cs ?sh ?t ?gfs (@default_val ?cs' ?t') ?p] => 
-       change (@field_at cs sh t gfs (default_val cs' t') p) with (@field_at_ cs sh t gfs p)
-    end*)
-end).
  match goal with |- ?A |-- ?B => unfold_data_at A; unfold_data_at B; cancel end.
 Time Qed. (*5.4*)
 
 Lemma update_while_proof:
- forall (Espec : OracleKind) (hashed : list int) (dd data: list byte) gv
+ forall Espec (hashed : list int) (dd data: list byte) gv
     (c d : val) (wsh sh : share) (len : Z)
   (H : 0 <= len <= Zlength data)
    (Hwsh: writable_share wsh)
@@ -169,7 +142,7 @@ Lemma update_while_proof:
   (H3 : Zlength dd < CBLOCKz)
   (H4 : (LBLOCKz | Zlength hashed))
   (Hlen : len <= Int.max_unsigned),
- semax
+ semax(OK_spec := Espec) ⊤
        (func_tycontext f_SHA256_Update Vprog Gtot nil)
   (sha_update_inv wsh sh hashed len c d dd data gv false)
   (Swhile
@@ -237,9 +210,9 @@ assert (Zlength bl = LBLOCKz). {
        data_block sh (sublist lo (lo+CBLOCKz) data)
          (field_address0 (tarray tuchar (Zlength data)) [ArraySubsc lo] d) *
        data_block sh (sublist (lo+CBLOCKz) (Zlength data) data)
-         (field_address0 (tarray tuchar (Zlength data)) [ArraySubsc (lo+CBLOCKz)] d)).
+         (field_address0 (tarray tuchar (Zlength data)) [ArraySubsc (lo+CBLOCKz)] d))%I.
   { Time entailer!. (*2.5*)
-   rewrite (split3_data_block lo (lo+CBLOCKz) sh data); auto;
+   rewrite (split3_data_block lo (lo+CBLOCKz) sh data); first cancel; auto;
      subst lo; Omega1.
   }
  rewrite H6.
diff --git a/sha/vst_lemmas.v b/sha/vst_lemmas.v
index e0ebe71475..2ed3a41e2a 100644
--- a/sha/vst_lemmas.v
+++ b/sha/vst_lemmas.v
@@ -1,15 +1,16 @@
 (* Additional lemmas / proof rules about VST stack *)
 
 Require Import VST.floyd.proofauto.
+Require Export VST.floyd.compat. Export NoOracle.
 Require Export sha.general_lemmas.
 
 Definition data_block {cs: compspecs} (sh: share) (contents: list byte) :=
-  @data_at cs sh (tarray tuchar (Zlength contents)) (map Vubyte contents).
+  data_at(cs := cs) sh (tarray tuchar (Zlength contents)) (map Vubyte contents).
 
 Lemma data_block_local_facts:
  forall {cs: compspecs} sh f data,
   data_block sh f data |--
-   prop (field_compatible (tarray tuchar (Zlength f)) [] data).
+   !! (field_compatible (tarray tuchar (Zlength f)) [] data).
 Proof.
 intros. unfold data_block, array_at.
 simpl.
@@ -28,10 +29,10 @@ Qed.
 Lemma split2_data_block:
   forall  {cs: compspecs}  n sh data d,
   (0 <= n <= Zlength data)%Z ->
-  data_block sh data d =
+  data_block sh data d ⊣⊢
   (data_block sh (sublist 0 n data) d *
    data_block sh (sublist n (Zlength data) data)
-   (field_address0 (tarray tuchar (Zlength data)) [ArraySubsc n] d))%logic.
+   (field_address0 (tarray tuchar (Zlength data)) [ArraySubsc n] d)).
 Proof.
   intros.
   unfold data_block. simpl. normalize.
@@ -46,12 +47,12 @@ Lemma split3_data_block:
   forall  {cs: compspecs} lo hi sh data d,
   0 <= lo <= hi ->
   hi <= Zlength data  ->
-  data_block sh data d =
+  data_block sh data d ⊣⊢
   (data_block sh (sublist 0 lo data) d *
    data_block sh (sublist lo hi data)
    (field_address0 (tarray tuchar (Zlength data)) [ArraySubsc lo] d) *
    data_block sh (sublist hi (Zlength data) data)
-   (field_address0 (tarray tuchar (Zlength data)) [ArraySubsc hi] d))%logic.
+   (field_address0 (tarray tuchar (Zlength data)) [ArraySubsc hi] d)).
 Proof.
   intros.
   unfold data_block. 
@@ -59,7 +60,7 @@ Proof.
   unfold tarray.
   rewrite split3_data_at_Tarray_tuchar with (n1:=lo)(n2:=hi) by (autorewrite with sublist; auto).
   autorewrite with sublist.
-  reflexivity.
+  rewrite assoc; auto; apply _.
 Qed.
 
 Lemma force_lengthn_long {A}: forall n (l:list A) d, (n <= length l)%nat -> force_lengthn n l d = firstn n l.
@@ -76,7 +77,7 @@ Lemma skipn_force_lengthn_app {A} n (l m:list A) a:
   rewrite force_lengthn_length_n; lia.
 Qed.
 
-Lemma data_at_triv {cs} sh t v v': v=v' -> @data_at cs sh t v |-- @data_at cs sh t v'.
+Lemma data_at_triv {cs} sh t v v' p: v=v' -> data_at(cs := cs) sh t v p |-- data_at sh t v' p.
 Proof. intros; subst. auto. Qed.
 
 Lemma sizeof_Tarray {cs: compspecs} k: Z.max 0 k = k -> sizeof (Tarray tuchar k noattr) = k.
@@ -118,7 +119,7 @@ Proof. intros. destruct v; try contradiction. exists b, i; trivial. Qed.
 Ltac myframe_SEP'' L :=  (* this should be generalized to permit framing on LOCAL part too *)
  grab_indexes_SEP L;
  match goal with
- | |- @semax _ _ (PROPx _ (LOCALx ?Q (SEPx ?R))) _ _ =>
+ | |- semax _ _ (PROPx _ (LOCALx ?Q (SEPx ?R))) _ _ =>
   rewrite <- (firstn_skipn (length L) R);
   rewrite <- (firstn_skipn (length Q) Q);
     simpl length; unfold firstn, skipn;
diff --git a/shared/dshare.v b/shared/dshare.v
new file mode 100644
index 0000000000..aad352b673
--- /dev/null
+++ b/shared/dshare.v
@@ -0,0 +1,291 @@
+(* modified from iris.algebra.dfrac *)
+(* It would be interesting to unify this with dfrac as a generic "discardable" functor, but
+   even the base datatype is slightly different, so I'm not sure it's possible. *)
+
+From stdpp Require Import countable.
+From iris.algebra Require Export cmra.
+From iris.algebra Require Import updates proofmode_classes.
+Set Warnings "-notation-overridden,-hiding-delimiting-key".
+From iris_ora.algebra Require Export ora.
+From iris.prelude Require Import options.
+Require Export VST.shared.share_alg.
+Set Warnings "notation-overridden,hiding-delimiting-key".
+
+(** Since shares have a unit, we use DfracBoth Share.bot as the persistent fraction. *)
+Inductive dfrac `{ShareType} :=
+  | DfracOwn : share_car → dfrac (* Would it make sense to have a separate constructor for unreadable shares? *)
+  | DfracBoth : share_car → dfrac.
+
+Definition DfracDiscarded `{ShareType} := DfracBoth (Share share_bot).
+
+(* This notation is intended to be used as a component in other notations that
+   include discardable fractions. The notation provides shorthands for the
+   constructors and the commonly used full fraction. For an example
+   demonstrating how this can be used see the notation in [ghost_map.v]. *)
+Declare Custom Entry dfrac.
+Notation "{ dq }" := (dq) (in custom dfrac at level 1, dq constr).
+Notation "□" := DfracDiscarded (in custom dfrac).
+Notation "{# q }" := (DfracOwn (Share q)) (in custom dfrac at level 1, q constr).
+Notation "" := (DfracOwn (Share share_top)) (in custom dfrac).
+
+Section dfrac.
+
+Context `{ST : ShareType}.
+Set Warnings "-redundant-canonical-projection".
+  Canonical Structure dfracO := leibnizO dfrac.
+Set Warnings "redundant-canonical-projection".
+
+  Implicit Types p q : share_car.
+  Implicit Types dp dq : dfrac.
+
+  Global Instance dfrac_inhabited : Inhabited dfrac := populate DfracDiscarded.
+(*  Global Instance dfrac_eq_dec : EqDecision dfrac.
+  Proof. solve_decision. Defined.*)
+(*  Global Instance dfrac_countable : Countable dfrac.
+  Proof.
+    set (enc dq := match dq with
+      | DfracOwn q => inl q
+      | DfracDiscarded => inr (inl ())
+      | DfracBoth q => inr (inr q)
+      end).
+    set (dec y := Some match y with
+      | inl q => DfracOwn q
+      | inr (inl ()) => DfracDiscarded
+      | inr (inr q) => DfracBoth q
+      end).
+    refine (inj_countable enc dec _). by intros [].
+  Qed.*)
+
+  Global Instance DfracOwn_inj : Inj (=) (=) DfracOwn.
+  Proof. by injection 1. Qed.
+  Global Instance DfracBoth_inj : Inj (=) (=) DfracBoth.
+  Proof. by injection 1. Qed.
+
+  Local Instance dfrac_valid_instance : Valid dfrac := λ dq,
+    match dq with
+    | DfracOwn q => ✓ q
+    | DfracBoth q => ∃ sh, q = Share sh ∧ ¬share_writable sh
+    end%Qp.
+
+  Local Instance dfrac_pcore_instance : PCore dfrac := λ dq, Some
+    match dq with
+    | DfracOwn q => DfracOwn (core q)
+    | DfracBoth q => DfracBoth (core q)
+    end.
+
+  Local Instance dfrac_op_instance : Op dfrac := λ dq dp,
+    match dq, dp with
+    | DfracOwn q, DfracOwn q' => DfracOwn (q ⋅ q')
+    | DfracOwn q, DfracBoth q' => DfracBoth (q ⋅ q')
+    | DfracBoth q, DfracOwn q' => DfracBoth (q ⋅ q')
+    | DfracBoth q, DfracBoth q' => DfracBoth (q ⋅ q')
+    end.
+
+  Lemma dfrac_op_own q p : DfracOwn p ⋅ DfracOwn q = DfracOwn (p ⋅ q).
+  Proof. done. Qed.
+
+  Lemma dfrac_op_discarded :
+    DfracDiscarded ⋅ DfracDiscarded = DfracDiscarded.
+  Proof. rewrite /op /dfrac_op_instance /= left_id //. Qed.
+
+  Lemma dfrac_op_own_discarded q : DfracOwn q ⋅ DfracDiscarded = DfracBoth q.
+  Proof. rewrite /op /= right_id //. Qed.
+
+  Lemma dfrac_op_both_discarded q : DfracBoth q ⋅ DfracDiscarded = DfracBoth q.
+  Proof. rewrite /op /= right_id //. Qed.
+
+  Lemma dfrac_included_eq dq dp : dq ≼ dp ↔ match dq, dp with
+    | DfracOwn q, DfracOwn p | DfracOwn q, DfracBoth p | DfracBoth q, DfracBoth p => q ≼ p
+    | _, _ => False
+    end.
+  Proof.
+    destruct dq as [q|q], dp as [p|p].
+    - split; last by (intros [o ->]; exists (DfracOwn o)).
+      intros [[?|?] [= ->]]; by eexists.
+    - split; last by (intros [o ->]; exists (DfracBoth o)).
+      intros [[?|?] [= ->]]; try done.
+    - split; last done.
+      intros [[?|?] [= ->]]; done.
+    - split; last by (intros [o ->]; exists (DfracOwn o)).
+      intros [[?|?] [= ->]]; try done; by eexists.
+  Qed.
+
+  Definition dfrac_ra_mixin : RAMixin dfrac.
+  Proof.
+    apply ra_total_mixin; try apply _; try done.
+    - intros [?|?] [?|?] [?|?];
+        rewrite /op /dfrac_op_instance 1?(assoc_L(A := shareR)); done.
+    - intros [?|?] [?|?];
+        rewrite /op /dfrac_op_instance 1?(comm_L(A := shareR)); done.
+    - intros [?|?]; rewrite /core /pcore /dfrac_pcore_instance /=;
+        rewrite /op /dfrac_op_instance ?cmra_core_l //.
+    - intros [?|?]; rewrite /core /pcore /dfrac_pcore_instance /= ?cmra_core_idemp //.
+    - intros [?|?] [?|?]; rewrite !dfrac_included_eq /=; try done; apply (cmra_core_mono(A := shareR)).
+    - intros [q|q] [q'|q']; rewrite /op /dfrac_op_instance /valid /dfrac_valid_instance //.
+      + apply cmra_valid_op_l.
+      + intros (? & H & ?); eapply cmra_valid_op_l; setoid_rewrite H; done.
+      + intros (? & (? & ? & -> & -> & J)%share_op_join & ?).
+        eexists; split; first done.
+        intros X; apply writable_mono in J; auto.
+      + intros (? & (? & ? & -> & -> & J)%share_op_join & ?).
+        eexists; split; first done.
+        intros X; apply writable_mono in J; auto.
+  Qed.
+Set Warnings "-redundant-canonical-projection".
+  Canonical Structure dfracC := discreteR dfrac dfrac_ra_mixin.
+Set Warnings "redundant-canonical-projection".
+
+  Global Instance dfrac_cmra_total : CmraTotal dfracC.
+  Proof. hnf; eauto. Qed.
+  Global Instance dfrac_cmra_discrete : CmraDiscrete dfracC.
+  Proof. apply discrete_cmra_discrete. Qed.
+
+  Global Instance dfrac_cancelable q : Cancelable (DfracOwn q).
+  Proof.
+    apply: discrete_cancelable.
+    intros [q1|q1] [q2|q2] ? [=]; simplify_eq/=; try done.
+    - by apply (share_cancelable _ 0) in H1 as ->.
+    - destruct H as (? & J & ?).
+      apply (share_cancelable _ 0) in H1 as ->; try done.
+      rewrite J; hnf; eauto.
+  Qed.
+
+  Local Instance dfrac_unit : Unit dfrac := DfracOwn (Share share_bot).
+
+  Lemma dfrac_full_exclusive : ∀ dq, ✓ (DfracOwn (Share share_top) ⋅ dq) → dq = ε.
+  Proof.
+    intros [q|q]; rewrite /op /=.
+    - intros (? & ? & ? & [=] & -> & ? & J)%share_valid2_joins; subst.
+      rewrite share_op_comm in J; apply share_op_top' in J as (-> & ->); done.
+    - intros (? & (? & ? & [=] & -> & J)%share_op_join & ?); subst.
+      rewrite share_op_comm in J; apply share_op_top' in J as (-> & ->).
+      contradiction H; apply writable_top; auto.
+  Qed.
+
+  Global Instance dfrac_full_cancelable : Cancelable (DfracOwn (Share share_top)).
+  Proof.
+    intros ??? ->%dfrac_full_exclusive H.
+    destruct z; last done.
+    rewrite /op /cmra_op /= right_id in H; injection H as H.
+    symmetry in H; apply share_op_join in H as (? & ? & [=] & ? & J); subst.
+    rewrite share_op_comm in J; apply share_op_top' in J as (_ & ->); done.
+  Qed.
+
+  Definition dfrac_ucmra_mixin : UcmraMixin dfrac.
+  Proof.
+    split; try done.
+    intros [|]; rewrite /op /dfrac_op_instance /= left_id //.
+  Qed.
+Set Warnings "-redundant-canonical-projection".
+  Canonical Structure dfracUC := Ucmra dfrac dfrac_ucmra_mixin.
+Set Warnings "redundant-canonical-projection".
+
+  Lemma dfrac_valid_own_1 : ✓ DfracOwn (Share share_top).
+  Proof. hnf; eauto. Qed.
+
+(*  Lemma dfrac_valid_own_r dq q : ✓ (dq ⋅ DfracOwn q) → exists sh, q = Some sh ∧ sh ≠ share_top.
+  Proof.
+    destruct dq as [q'| |q'].
+    - intros (? & ? & ? & -> & -> & ? & J)%share_valid2_joins.
+      eexists; split; first done; intros ->.
+      rewrite share_op_comm, share_op_top in J as [].
+    - intros [H ?]; split; intros ?; subst; try done.
+      contradiction H; by apply writable_writable0.
+    - intros [? (? & ? & J)%share_valid2_joins].
+      split; auto; intros ->.
+      rewrite share_op_comm, share_op_top in J as []; contradiction.
+  Qed.
+
+  Lemma dfrac_valid_own_l dq q : ✓ (DfracOwn q ⋅ dq) → q ≠ share_top /\ q ≠ Share.bot.
+  Proof. rewrite comm. apply dfrac_valid_own_r. Qed.*)
+
+  Lemma dfrac_valid_discarded : ✓ DfracDiscarded.
+  Proof.
+    hnf.
+    eexists; split; first done.
+    intros ?%writable_readable; contradiction unreadable_bot.
+  Qed.
+
+  Lemma dfrac_valid_own_discarded q :
+    ✓ (DfracOwn q ⋅ DfracDiscarded) ↔ ∃ sh, q = Share sh ∧ ~share_writable sh.
+  Proof.
+    rewrite /op /= /valid /=.
+    rewrite right_id //.
+  Qed.
+
+  Definition readable_dfrac (dq : dfrac) :=
+    match dq with DfracOwn (Share sh) => share_readable sh | DfracBoth (Share _) => True | _ => False end.
+
+  Lemma dfrac_valid_own_readable dq q : readable_dfrac dq ->
+    ✓ (dq ⋅ DfracOwn q) → ∃ sh, q = Share sh ∧ ¬share_writable sh.
+  Proof.
+    intros Hdq; destruct dq as [q'|q']; try done.
+    - intros (? & ? & ? & -> & -> & ? & J)%share_valid2_joins.
+      eexists; split; first done.
+      intros ?; rewrite share_op_comm writable_readable_conflict // in J.
+    - intros (? & (? & ? & -> & -> & J)%share_op_join & ?).
+      eexists; split; first done.
+      intros X; rewrite share_op_comm in J; contradiction H; eapply writable_mono; eauto.
+  Qed.
+
+  Global Instance dfrac_is_op q q1 q2 :
+    @IsOp shareR q q1 q2 →
+    IsOp' (DfracOwn q) (DfracOwn q1) (DfracOwn q2).
+  Proof. rewrite /IsOp' /IsOp dfrac_op_own=>-> //. Qed.
+
+  (** Discarding a fraction is a frame preserving update. *)
+  Lemma dfrac_discard_update dq : readable_dfrac dq -> dq ~~> DfracDiscarded.
+  Proof.
+    intros H n [[q'|q']|]; rewrite -!cmra_discrete_valid_iff //=.
+    - intros; rewrite comm dfrac_valid_own_discarded.
+      by eapply dfrac_valid_own_readable.
+    - intros ?%cmra_valid_op_r.
+      rewrite comm dfrac_op_both_discarded //.
+    - intros; apply dfrac_valid_discarded.
+  Qed.
+
+  Local Instance dfrac_order : OraOrder dfrac := λ a b, a = b ∨ a ⋅ DfracDiscarded = b.
+
+  Local Instance discard_increasing : Increasing DfracDiscarded.
+  Proof.
+    intros [|]; [right | left].
+    - rewrite (comm op) //.
+    - rewrite (comm op) dfrac_op_both_discarded //.
+  Qed.
+
+  Definition dfrac_ora_mixin : DORAMixin dfrac.
+  Proof.
+    apply dora_total_mixin; try done.
+    - intros [|]; inversion 1; subst; try apply _.
+      intros ?.
+      rewrite left_id; by left.
+    - inversion 1; hnf; auto.
+    - intros ?? [?|?]; subst.
+      + by left.
+      + right; destruct x; rewrite /op /= left_id //.
+    - intros ??? [?|?] [?|?]; subst; hnf; auto.
+      right; destruct x; rewrite !dfrac_op_both_discarded //.
+    - intros ??? [?|?]; subst; hnf; auto.
+      right; by rewrite -assoc (comm _ y) assoc.
+    - intros ??? [?|?]; subst; auto.
+      eapply cmra_valid_op_l; eauto.
+    - destruct x; inversion 1 as [?? Hcore|]; subst; rewrite -Hcore; destruct y; eexists; split; hnf; eauto.
+      rewrite dfrac_op_own_discarded //.
+  Qed.
+
+Set Warnings "-redundant-canonical-projection".
+  Canonical Structure dfracR := discreteOra dfrac dfrac_ora_mixin.
+  Canonical Structure dfracUR := Uora dfrac dfrac_ucmra_mixin.
+Set Warnings "redundant-canonical-projection".
+
+  Global Instance dfrac_discarded_oracore_id : OraCoreId DfracDiscarded.
+  Proof. by constructor. Qed.
+
+  Global Instance dfrac_ora_total : OraTotal dfracR.
+  Proof. hnf; eauto. Qed.
+  Global Instance dfrac_ora_discrete : OraDiscrete dfracR.
+  Proof. apply discrete_ora_discrete. Qed.
+
+End dfrac.
+
+#[global] Hint Resolve dfrac_valid_own_1 : core.
diff --git a/shared/gen_heap.v b/shared/gen_heap.v
new file mode 100644
index 0000000000..3d6ce10008
--- /dev/null
+++ b/shared/gen_heap.v
@@ -0,0 +1,518 @@
+(* modified from iris.base_logic.lib.gen_heap *)
+
+From stdpp Require Export namespaces.
+From iris.algebra Require Import reservation_map.
+From iris.algebra Require Import agree.
+Set Warnings "-notation-overridden,-hiding-delimiting-key".
+From iris_ora.algebra Require Import agree ext_order.
+From iris.proofmode Require Import proofmode.
+From iris_ora.logic Require Export logic own ghost_map.
+From VST.shared Require Import shared resource_map.
+From VST.shared Require Export dshare.
+Set Warnings "notation-overridden,hiding-delimiting-key".
+From iris.prelude Require Import options.
+
+(** This file defines the language-level points-to
+connective [l ↦{dq} v] reflecting the physical heap.  This library is designed to
+be used as a singleton (i.e., with only a single instance existing in any
+proof), with the [gen_heapGS] typeclass providing the ghost names of that unique
+instance.  That way, [mapsto] does not need an explicit [gname] parameter.
+This mechanism can be plugged into a language and related to the physical heap
+by using [gen_heap_interp σ] in the state interpretation of the weakest
+precondition. See heap-lang for an example.
+
+This library is generic in the type [V] for values and
+supports fractional permissions.  Next to the point-to connective [l ↦{dq} v],
+which keeps track of the value [v] of a location [l], this library also provides
+a way to attach "meta" or "ghost" data to locations. This is done as follows:
+
+- When one allocates a location, in addition to the point-to connective [l ↦ v],
+  one also obtains the token [meta_token l ⊤]. This token is an exclusive
+  resource that denotes that no meta data has been associated with the
+  namespaces in the mask [⊤] for the location [l].
+- Meta data tokens can be split w.r.t. namespace masks, i.e.
+  [meta_token l (E1 ∪ E2) ⊣⊢ meta_token l E1 ∗ meta_token l E2] if [E1 ## E2].
+- Meta data can be set using the update [meta_token l E ==∗ meta l N x] provided
+  [↑N ⊆ E], and [x : A] for any countable [A]. The [meta l N x] connective is
+  persistent and denotes the knowledge that the meta data [x] has been
+  associated with namespace [N] to the location [l].
+
+To make the mechanism as flexible as possible, the [x : A] in [meta l N x] can
+be of any countable type [A]. This means that you can associate e.g. single
+ghost names, but also tuples of ghost names, etc.
+
+To further increase flexibility, the [meta l N x] and [meta_token l E]
+connectives are annotated with a namespace [N] and mask [E]. That way, one can
+assign a map of meta information to a location. This is particularly useful when
+building abstractions, then one can gradually assign more ghost information to a
+location instead of having to do all of this at once. We use namespaces so that
+these can be matched up with the invariant namespaces. *)
+
+(** To implement this mechanism, we use three resource algebras:
+
+- A [gmap_view L V], which keeps track of the values of locations.
+- A [gmap_view L gname], which keeps track of the meta information of
+  locations. More specifically, this RA introduces an indirection: it keeps
+  track of a ghost name for each location.
+- The ghost names in the aforementioned authoritative RA refer to namespace maps
+  [reservation_map (agree positive)], which store the actual meta information.
+  This indirection is needed because we cannot perform frame preserving updates
+  in an authoritative fragment without owning the full authoritative element
+  (in other words, without the indirection [meta_set] would need [gen_heap_interp]
+  as a premise).
+ *)
+
+(** The ORAs we need, and the global ghost names we are using. *)
+
+(* is this right? *)
+Canonical Structure reservation_mapR := inclR (reservation_mapR (agreeR positiveO)).
+
+Global Instance reservation_map_data_core_id k (a : agreeR positiveO) :
+    OraCoreId a → OraCoreId(A := reservation_mapR) (reservation_map_data(A := agreeR positiveO) k a).
+Proof. do 2 constructor; simpl; auto. apply core_id_core, _. Qed.
+
+Global Instance reservation_map_ora_discrete : OraDiscrete reservation_mapR.
+Proof.
+  split; first apply _.
+  - intros [m [E|]]; rewrite reservation_map_validN_eq reservation_map_valid_eq //=.
+    by intros [?%cmra_discrete_valid ?].
+  - intros ?? [? [H1 H2]] ?.
+    apply gmap_cmra_discrete in H1; last apply _.
+    eexists; split; eauto.
+    by apply equiv_dist.
+Qed.
+
+Class gen_heapGpreS (S L V : Type) (Σ : gFunctors) `{ShareType S} `{Countable L} := {
+  gen_heapGpreS_heap : resource_mapG Σ S L V;
+  gen_heapGpreS_meta : ghost_mapG Σ L gname;
+  gen_heapGpreS_meta_data : inG Σ reservation_mapR;
+}.
+Local Existing Instances gen_heapGpreS_meta_data gen_heapGpreS_heap gen_heapGpreS_meta.
+
+Class gen_heapGS (S L V : Type) (Σ : gFunctors) `{ShareType S} `{Countable L} := GenHeapGS {
+  gen_heap_inG : gen_heapGpreS S L V Σ;
+  gen_heap_name : gname;
+  gen_meta_name : gname
+}.
+Local Existing Instance gen_heap_inG.
+Global Arguments GenHeapGS S L V Σ {_ _ _ _} _ _.
+Global Arguments gen_heap_name {S L V Σ _ _ _} _ : assert.
+Global Arguments gen_meta_name {S L V Σ _ _ _} _ : assert.
+
+Definition gen_heapΣ (S L V : Type) `{ShareType S} `{Countable L} : gFunctors := #[
+  resource_mapΣ S L V;
+  ghost_mapΣ L gname;
+  GFunctor reservation_mapR
+].
+
+Global Instance subG_gen_heapGpreS {Σ S L V} `{ShareType S} `{Countable L} :
+  subG (gen_heapΣ S L V) Σ → gen_heapGpreS S L V Σ.
+Proof.
+  rewrite /gen_heapΣ => Hsub.
+  repeat apply subG_inv in Hsub as (?%subG_inG & Hsub); simpl in *.
+  repeat split; assumption.
+Qed.
+
+Section definitions.
+  Context {S} `{ShareType S, Countable L, hG : !gen_heapGS S L V Σ}.
+
+  Definition gen_heap_interp σ : iProp Σ := ∃ m : gmap L gname,
+(*    (* The [⊆] is used to avoid assigning ghost information to the locations in
+    the initial heap (see [gen_heap_init]). *)
+    ⌜ dom m ⊆ dom σ ⌝ ∧ *)
+    resource_map_auth (gen_heap_name hG) 1 σ ∗
+    ghost_map_auth (gen_meta_name hG) 1 m.
+
+  Local Definition mapsto_def (l : L) (dq : dfrac) (v: V) : iProp Σ :=
+    l ↪[gen_heap_name hG]{dq} v.
+  Local Definition mapsto_aux : seal (@mapsto_def). Proof. by eexists. Qed.
+  Definition mapsto := mapsto_aux.(unseal).
+  Local Definition mapsto_unseal : @mapsto = @mapsto_def := mapsto_aux.(seal_eq).
+
+  Local Definition mapsto_no_def (l : L) (sh : S) : iProp Σ :=
+    resource_map_elem_no (gen_heap_name hG) l sh.
+  Local Definition mapsto_no_aux : seal (@mapsto_no_def). Proof. by eexists. Qed.
+  Definition mapsto_no := mapsto_no_aux.(unseal).
+  Local Definition mapsto_no_unseal : @mapsto_no = @mapsto_no_def := mapsto_no_aux.(seal_eq).
+
+  Local Definition meta_token_def (l : L) (E : coPset) : iProp Σ :=
+    ∃ γm, ghost_map_elem (gen_meta_name hG) l dfrac.DfracDiscarded γm ∗ own(A := reservation_mapR) γm (reservation_map_token E).
+  Local Definition meta_token_aux : seal (@meta_token_def). Proof. by eexists. Qed.
+  Definition meta_token := meta_token_aux.(unseal).
+  Local Definition meta_token_unseal :
+    @meta_token = @meta_token_def := meta_token_aux.(seal_eq).
+
+  (** TODO: The use of [positives_flatten] violates the namespace abstraction
+  (see the proof of [meta_set]. *)
+  Local Definition meta_def `{Countable A} (l : L) (N : namespace) (x : A) : iProp Σ :=
+    ∃ γm, ghost_map_elem (gen_meta_name hG) l dfrac.DfracDiscarded γm ∗
+          own(A := reservation_mapR) γm (reservation_map_data (positives_flatten N) (to_agree (encode x))).
+  Local Definition meta_aux : seal (@meta_def). Proof. by eexists. Qed.
+  Definition meta := meta_aux.(unseal).
+  Local Definition meta_unseal : @meta = @meta_def := meta_aux.(seal_eq).
+End definitions.
+Global Arguments meta {S _ L _ _ V Σ _ A _ _} l N x.
+
+Local Notation "l ↦ dq v" := (mapsto l dq v)
+  (at level 20, dq custom dfrac at level 1, format "l  ↦ dq  v") : bi_scope.
+
+Section gen_heap.
+  Context {S L V} `{ShareType S, Countable L, !gen_heapGS S L V Σ}.
+  Implicit Types P Q : iProp Σ.
+  Implicit Types Φ : V → iProp Σ.
+  Implicit Types σ : rmapUR S L (leibnizO V).
+  Implicit Types m : gmap L gname.
+  Implicit Types l : L.
+  Implicit Types v : V.
+
+  (** General properties of mapsto *)
+  Global Instance mapsto_timeless l dq (rsh : readable_dfrac dq) v : Timeless (l ↦{dq} v).
+  Proof. rewrite mapsto_unseal. apply _. Qed.
+(*  Global Instance mapsto_fractional l v : Fractional (λ q, l ↦{#q} v)%I.
+  Proof. rewrite mapsto_unseal. apply _. Qed.
+  Global Instance mapsto_as_fractional l q v :
+    AsFractional (l ↦{#q} v) (λ q, l ↦{#q} v)%I q.
+  Proof. rewrite mapsto_unseal. apply _. Qed. *)
+  Global Instance mapsto_persistent l v : Persistent (l ↦□ v).
+  Proof. rewrite mapsto_unseal. apply _. Qed.
+  Global Instance mapsto_affine l v : Affine (l ↦□ v).
+  Proof. rewrite mapsto_unseal. apply _. Qed.
+  Global Instance mapsto_no_persistent l : Persistent (mapsto_no l share_bot).
+  Proof. rewrite mapsto_no_unseal. apply _. Qed.
+  Global Instance mapsto_no_affine l : Affine (mapsto_no l share_bot).
+  Proof. rewrite mapsto_no_unseal. apply _. Qed.
+
+  Lemma mapsto_valid l dq v : l ↦{dq} v -∗ ⌜✓ dq ∧ readable_dfrac dq⌝%Qp.
+  Proof. rewrite mapsto_unseal. apply resource_map_elem_valid. Qed.
+  Lemma mapsto_valid_2 l dq1 dq2 v1 v2 : l ↦{dq1} v1 -∗ l ↦{dq2} v2 -∗ ⌜✓ (dq1 ⋅ dq2) ∧ readable_dfrac (dq1 ⋅ dq2) ∧ v1 = v2⌝.
+  Proof. rewrite mapsto_unseal. apply resource_map_elem_valid_2. Qed.
+  (** Almost all the time, this is all you really need. *)
+  Lemma mapsto_agree l dq1 dq2 v1 v2 : l ↦{dq1} v1 -∗ l ↦{dq2} v2 -∗ ⌜v1 = v2⌝.
+  Proof. rewrite mapsto_unseal. apply resource_map_elem_agree. Qed.
+
+  Global Instance mapsto_combine_sep_gives l dq1 dq2 v1 v2 : 
+    CombineSepGives (l ↦{dq1} v1) (l ↦{dq2} v2) ⌜✓ (dq1 ⋅ dq2) ∧ readable_dfrac (dq1 ⋅ dq2) ∧ v1 = v2⌝ | 30.
+  Proof.
+    rewrite /CombineSepGives. iIntros "[H1 H2]".
+    iDestruct (mapsto_valid_2 with "H1 H2") as %?. eauto.
+  Qed.
+
+  Lemma mapsto_no_valid l dq : mapsto_no l dq -∗ ⌜~share_readable dq⌝%Qp.
+  Proof. rewrite mapsto_no_unseal. apply resource_map_elem_no_valid. Qed.
+  Lemma mapsto_no_valid_2 l dq1 dq2 : mapsto_no l dq1 -∗ mapsto_no l dq2 -∗ ⌜✓ (Share dq1 ⋅ Share dq2) ∧ ~readable_share' (Share dq1 ⋅ Share dq2)⌝.
+  Proof. rewrite mapsto_no_unseal. apply resource_map_elem_no_valid_2. Qed.
+  Lemma mapsto_no_mapsto_valid_2 l dq1 dq2 v : mapsto_no l dq1 -∗ l ↦{dq2} v -∗ ⌜✓ (DfracOwn (Share dq1) ⋅ dq2) ∧ readable_dfrac (DfracOwn (Share dq1) ⋅ dq2)⌝.
+  Proof. rewrite mapsto_no_unseal mapsto_unseal. apply resource_map_elem_no_elem_valid_2. Qed.
+
+  Global Instance mapsto_no_combine_sep_gives l dq1 dq2 : 
+    CombineSepGives (mapsto_no l dq1) (mapsto_no l dq2) ⌜✓ (Share dq1 ⋅ Share dq2) ∧ ~readable_share' (Share dq1 ⋅ Share dq2)⌝ | 30.
+  Proof.
+    rewrite /CombineSepGives. iIntros "[H1 H2]".
+    iDestruct (mapsto_no_valid_2 with "H1 H2") as %?. eauto.
+  Qed.
+
+  Lemma mapsto_combine l dq1 dq2 v1 v2 :
+    l ↦{dq1} v1 -∗ l ↦{dq2} v2 -∗ l ↦{dq1 ⋅ dq2} v1 ∧ ⌜v1 = v2⌝.
+  Proof. rewrite mapsto_unseal. apply resource_map_elem_combine. Qed.
+
+  Global Instance mapsto_combine_as l dq1 dq2 v1 v2 :
+    CombineSepAs (l ↦{dq1} v1) (l ↦{dq2} v2) (l ↦{dq1 ⋅ dq2} v1) | 60.
+    (* higher cost than the Fractional instance, which kicks in for #qs *)
+  Proof.
+    rewrite /CombineSepAs. iIntros "[H1 H2]".
+    iDestruct (mapsto_combine with "H1 H2") as "($ & _)".
+  Qed.
+
+  Lemma mapsto_split l dq1 dq2 (rsh1 : readable_dfrac dq1) (rsh2 : readable_dfrac dq2) v :
+    l ↦{dq1 ⋅ dq2} v ⊣⊢ l ↦{dq1} v ∗ l ↦{dq2} v.
+  Proof. rewrite mapsto_unseal. by apply resource_map_elem_split. Qed.
+
+  Lemma mapsto_no_mapsto_combine l dq1 dq2 v2 :
+    mapsto_no l dq1 -∗ l ↦{dq2} v2 -∗ l ↦{DfracOwn (Share dq1) ⋅ dq2} v2.
+  Proof. rewrite mapsto_unseal mapsto_no_unseal. apply resource_map_elem_no_elem_combine. Qed.
+
+  Global Instance mapsto_no_mapsto_combine_as l dq1 dq2 v2 :
+    CombineSepAs (mapsto_no l dq1) (l ↦{dq2} v2) (l ↦{DfracOwn (Share dq1) ⋅ dq2} v2) | 60.
+    (* higher cost than the Fractional instance, which kicks in for #qs *)
+  Proof.
+    rewrite /CombineSepAs. iIntros "[H1 H2]".
+    iApply (mapsto_no_mapsto_combine with "H1 H2").
+  Qed.
+
+  Lemma mapsto_split_no l dq1 dq2 (rsh1 : ~share_readable dq1) (rsh2 : readable_dfrac dq2) v :
+    l ↦{DfracOwn (Share dq1) ⋅ dq2} v ⊣⊢ mapsto_no l dq1 ∗ l ↦{dq2} v.
+  Proof. rewrite mapsto_unseal mapsto_no_unseal. by apply resource_map_elem_split_no. Qed.
+
+  Lemma mapsto_no_split l sh1 sh2 (rsh1 : ~share_readable sh1) (rsh2 : ~share_readable sh2) sh
+    (J : share_op sh1 sh2 = Some sh) :
+    mapsto_no l sh ⊣⊢ mapsto_no l sh1 ∗ mapsto_no l sh2.
+  Proof. rewrite mapsto_no_unseal. by apply resource_map_elem_no_split. Qed.
+
+  Lemma mapsto_frac_ne l1 l2 dq1 dq2 v1 v2 :
+    ¬ ✓(dq1 ⋅ dq2) → l1 ↦{dq1} v1 -∗ l2 ↦{dq2} v2 -∗ ⌜l1 ≠ l2⌝.
+  Proof. rewrite mapsto_unseal. apply resource_map_elem_frac_ne. Qed.
+(*  Lemma mapsto_ne l1 l2 dq2 v1 v2 : l1 ↦ v1 -∗ l2 ↦{dq2} v2 -∗ ⌜l1 ≠ l2⌝.
+  Proof. rewrite mapsto_unseal. apply resource_map_elem_ne. Qed. *)
+
+(*  (** Permanently turn any points-to predicate into a persistent
+      points-to predicate. *)
+  Lemma mapsto_persist l dq v : l ↦{dq} v ==∗ l ↦□ v.
+  Proof. rewrite mapsto_unseal. apply resource_map_elem_persist. Qed.
+
+  Lemma mapsto_bot l dq v : l ↦{dq} v ==∗ mapsto_no l share_bot.
+  Proof. rewrite mapsto_unseal mapsto_no_unseal. apply resource_map_elem_bot. Qed.
+
+  Lemma mapsto_no_bot l sh : mapsto_no l sh ==∗ mapsto_no l share_bot.
+  Proof. rewrite mapsto_no_unseal. apply resource_map_elem_no_bot. Qed.*)
+
+  (** Framing support *)
+(*  Global Instance frame_mapsto p l v q1 q2 RES :
+    FrameFractionalHyps p (l ↦{#q1} v) (λ q, l ↦{#q} v)%I RES q1 q2 →
+    Frame p (l ↦{#q1} v) (l ↦{#q2} v) RES | 5.
+  Proof. apply: frame_fractional. Qed. *)
+
+  (** General properties of [meta] and [meta_token] *)
+  Global Instance meta_token_timeless l N : Timeless (meta_token l N).
+  Proof. rewrite meta_token_unseal. apply _. Qed.
+  Global Instance meta_timeless `{Countable A} l N (x : A) : Timeless (meta l N x).
+  Proof. rewrite meta_unseal. apply _. Qed.
+  Global Instance meta_persistent `{Countable A} l N (x : A) : Persistent (meta l N x).
+  Proof. rewrite meta_unseal. apply _. Qed.
+
+  Lemma meta_token_union_1 l E1 E2 :
+    E1 ## E2 → meta_token l (E1 ∪ E2) -∗ meta_token l E1 ∗ meta_token l E2.
+  Proof.
+    rewrite meta_token_unseal /meta_token_def. intros ?. iDestruct 1 as (γm1) "[#Hγm Hm]".
+    rewrite reservation_map_token_union //. iDestruct "Hm" as "[Hm1 Hm2]".
+    iSplitL "Hm1"; eauto.
+  Qed.
+  Lemma meta_token_union_2 l E1 E2 :
+    meta_token l E1 -∗ meta_token l E2 -∗ meta_token l (E1 ∪ E2).
+  Proof.
+    rewrite meta_token_unseal /meta_token_def.
+    iIntros "(%γm1 & #Hγm1 & Hm1) (%γm2 & #Hγm2 & Hm2)".
+    iDestruct (ghost_map_elem_valid_2 with "Hγm1 Hγm2") as %[_ ->].
+    iDestruct (own_valid_2 with "Hm1 Hm2") as %?%reservation_map_token_valid_op.
+    iExists γm2. iFrame "Hγm2". rewrite reservation_map_token_union //. by iSplitL "Hm1".
+  Qed.
+  Lemma meta_token_union l E1 E2 :
+    E1 ## E2 → meta_token l (E1 ∪ E2) ⊣⊢ meta_token l E1 ∗ meta_token l E2.
+  Proof.
+    intros; iSplit; first by iApply meta_token_union_1.
+    iIntros "[Hm1 Hm2]". by iApply (meta_token_union_2 with "Hm1 Hm2").
+  Qed.
+
+  Lemma meta_token_difference l E1 E2 :
+    E1 ⊆ E2 → meta_token l E2 ⊣⊢ meta_token l E1 ∗ meta_token l (E2 ∖ E1).
+  Proof.
+    intros. rewrite {1}(union_difference_L E1 E2) //.
+    by rewrite meta_token_union; last set_solver.
+  Qed.
+
+  Lemma meta_agree `{Countable A} l i (x1 x2 : A) :
+    meta l i x1 -∗ meta l i x2 -∗ ⌜x1 = x2⌝.
+  Proof.
+    rewrite meta_unseal /meta_def.
+    iIntros "(%γm1 & Hγm1 & Hm1) (%γm2 & Hγm2 & Hm2)".
+    iDestruct (ghost_map_elem_valid_2 with "Hγm1 Hγm2") as %[_ ->].
+    iDestruct (own_valid_2 with "Hm1 Hm2") as %Hγ; iPureIntro.
+    move: Hγ. rewrite -reservation_map_data_op reservation_map_data_valid.
+    move=> /to_agree_op_inv_L. naive_solver.
+  Qed.
+  Lemma meta_set `{Countable A} E l (x : A) N :
+    ↑ N ⊆ E → meta_token l E ==∗ meta l N x.
+  Proof.
+    rewrite meta_token_unseal meta_unseal /meta_token_def /meta_def.
+    iDestruct 1 as (γm) "[Hγm Hm]". iExists γm. iFrame "Hγm".
+    iApply (own_update with "Hm").
+    apply reservation_map_alloc; last done.
+    cut (positives_flatten N ∈@{coPset} ↑N); first by set_solver.
+    (* TODO: Avoid unsealing here. *)
+    rewrite namespaces.nclose_unseal. apply elem_coPset_suffixes.
+    exists 1%positive. by rewrite left_id_L.
+  Qed.
+
+  (** Update lemmas *)
+  (*Lemma gen_heap_alloc σ l v :
+    σ !! l = None →
+    gen_heap_interp σ ==∗ gen_heap_interp (<[l:=v]>σ) ∗ l ↦ v ∗ meta_token l ⊤.
+  Proof.
+    iIntros (Hσl). rewrite /gen_heap_interp mapsto_unseal /mapsto_def meta_token_unseal /meta_token_def /=.
+    iDestruct 1 as (m Hσm) "[Hσ Hm]".
+    iMod (ghost_map_insert l with "Hσ") as "[Hσ Hl]".
+    iMod (own_alloc(A := reservation_mapR) (reservation_map_token ⊤)) as (γm) "Hγm".
+    { apply reservation_map_token_valid. }
+    iMod (ghost_map_insert_persist l with "Hm") as "[Hm Hlm]".
+    { move: Hσl. rewrite -!not_elem_of_dom. set_solver. }
+    iModIntro. iFrame "Hl". iSplitL "Hσ Hm"; last by eauto with iFrame.
+    iExists (<[l:=γm]> m). iFrame. iPureIntro.
+    rewrite !dom_insert_L. set_solver.
+  Qed.
+
+  Lemma gen_heap_alloc_big σ σ' :
+    σ' ##ₘ σ →
+    gen_heap_interp σ ==∗
+    gen_heap_interp (σ' ∪ σ) ∗ ([∗ map] l ↦ v ∈ σ', l ↦ v) ∗ ([∗ map] l ↦ _ ∈ σ', meta_token l ⊤).
+  Proof.
+    revert σ; induction σ' as [| l v σ' Hl IH] using map_ind; iIntros (σ Hdisj) "Hσ".
+    { rewrite left_id_L !big_sepM_empty. auto. }
+    iMod (IH with "Hσ") as "[Hσ'σ Hσ']"; first by eapply map_disjoint_insert_l.
+    decompose_map_disjoint.
+    rewrite !big_opM_insert // -insert_union_l //.
+    by iMod (gen_heap_alloc with "Hσ'σ") as "($ & $ & $)";
+      first by apply lookup_union_None.
+  Qed.*)
+
+  Lemma gen_heap_set (σ : rmapUR S L (leibnizO V)) (Hvalid : ✓ σ) :
+    resource_map_auth (gen_heap_name _) 1 ∅ ⊢ |==> resource_map_auth (gen_heap_name _) 1 σ ∗
+    ([∗ map] l ↦ x ∈ σ, match x with
+                        | (shared.YES dq _ v) => l ↦{dq} (proj1_sig (elem_of_agree v))
+                        | (shared.NO (Share sh) _) => mapsto_no l sh
+                        | _ => False
+                        end).
+  Proof. rewrite mapsto_unseal mapsto_no_unseal; by apply resource_map_set. Qed.
+
+  Lemma mapsto_lookup {q σ k dq v} :
+    resource_map_auth (gen_heap_name _) q σ -∗ k ↦{dq} v -∗ ⌜∃ dq', ∃ rsh : readable_dfrac dq', ✓ dq' ∧ dq ≼ dq' ∧
+      σ !! k ≡ Some (shared.YES (V := leibnizO V) dq' rsh (to_agree v))⌝.
+  Proof. rewrite mapsto_unseal. apply resource_map_lookup. Qed.
+
+  Lemma mapsto_no_lookup {q σ k sh} :
+    resource_map_auth (gen_heap_name _) q σ -∗ mapsto_no k sh -∗ ⌜∃ s, ✓ s ∧ σ !! k = Some s ∧ DfracOwn (Share sh) ≼ dfrac_of s⌝.
+  Proof. rewrite mapsto_no_unseal. apply resource_map_no_lookup. Qed.
+
+  Lemma mapsto_insert {σ} k v :
+    σ !! k = None →
+    resource_map_auth (gen_heap_name _) 1 σ ⊢ |==> resource_map_auth (gen_heap_name _) 1 (<[k := (YES (V := leibnizO V) (DfracOwn (Share share_top)) readable_top (to_agree v))]> σ) ∗ k ↦ v.
+  Proof. rewrite mapsto_unseal. apply resource_map_insert. Qed.
+
+  Lemma mapsto_insert_persist {σ}  k v :
+    σ !! k = None →
+    resource_map_auth (gen_heap_name _) 1 σ ⊢ |==> resource_map_auth (gen_heap_name _) 1 (<[k := (YES (V := leibnizO V) DfracDiscarded I (to_agree v))]> σ) ∗ k ↦□ v.
+  Proof. rewrite mapsto_unseal. apply resource_map_insert_persist. Qed.
+
+  Lemma mapsto_delete {σ k v} :
+    resource_map_auth (gen_heap_name _) 1 σ -∗ k ↦ v ==∗ resource_map_auth (gen_heap_name _) 1 (<[k := ε]>σ).
+  Proof. rewrite mapsto_unseal. apply resource_map_delete. Qed.
+
+  Lemma mapsto_update {σ k sh v} (Hsh : share_writable sh) w :
+    resource_map_auth (gen_heap_name _) 1 σ -∗ k ↦{#sh} v ==∗ ∃ dq' rsh', ⌜✓ dq' ∧ DfracOwn (Share sh) ≼ dq' ∧
+      σ !! k ≡ Some (YES (V := leibnizO V) dq' rsh' (to_agree v))⌝ ∧
+    resource_map_auth (gen_heap_name _) 1 (<[k := (YES dq' rsh' (to_agree w))]> σ) ∗ k ↦{#sh} w.
+  Proof. rewrite mapsto_unseal. by apply resource_map_update. Qed.
+
+  Lemma mapsto_lookup_big {q σ} dq (σ0 : gmap L V) :
+    resource_map_auth (gen_heap_name _) q σ -∗
+    ([∗ map] k↦v ∈ σ0, k ↦{dq} v) -∗
+    ⌜map_Forall (fun k v => ∃ dq', ∃ rsh : readable_dfrac dq', ✓ dq' ∧ dq ≼ dq' ∧
+            σ !! k ≡ Some (YES (V := leibnizO V) dq' rsh (to_agree v))) σ0⌝.
+  Proof. rewrite mapsto_unseal. apply resource_map_lookup_big. Qed.
+
+  Lemma mapsto_insert_big {σ} (σ' : gmap L V) :
+    dom σ' ## dom σ →
+    resource_map_auth (gen_heap_name _) 1 σ ⊢ |==>
+    resource_map_auth (gen_heap_name _) 1 (((λ v, (YES (V := leibnizO V) (DfracOwn (Share share_top)) readable_top (to_agree v))) <$> σ') ∪ σ) ∗ ([∗ map] k ↦ v ∈ σ', k ↦ v).
+  Proof. rewrite mapsto_unseal. apply resource_map_insert_big. Qed.
+
+  Lemma mapsto_insert_persist_big {σ} (σ' : gmap L V) :
+    dom σ' ## dom σ →
+    resource_map_auth (gen_heap_name _) 1 σ ⊢ |==>
+    resource_map_auth (gen_heap_name _) 1 (((λ v, (YES (V := leibnizO V) DfracDiscarded I (to_agree v))) <$> σ') ∪ σ) ∗ ([∗ map] k ↦ v ∈ σ', k ↦□ v).
+  Proof. rewrite mapsto_unseal. apply resource_map_insert_persist_big. Qed.
+
+  Lemma mapsto_delete_big {σ} (σ0 : gmap L V) :
+    resource_map_auth (gen_heap_name _) 1 σ -∗
+    ([∗ map] k↦v ∈ σ0, k ↦ v) ==∗
+    resource_map_auth (gen_heap_name _) 1 (((λ _, ε) <$> σ0) ∪ σ).
+  Proof. rewrite mapsto_unseal. apply resource_map_delete_big. Qed.
+
+  Lemma mapsto_update_big {σ} sh (Hsh : share_writable sh) (σ0 σ1 : gmap L V) :
+    dom σ0 = dom σ1 →
+    resource_map_auth (gen_heap_name _) 1 σ -∗
+    ([∗ map] k↦v ∈ σ0, k ↦{#sh} v) ==∗
+    resource_map_auth (gen_heap_name _) 1 (union(Union := map_union) (map_imap (λ k v, match σ !! k with
+      | Some (YES dq' rsh _) => Some (YES (V := leibnizO V) dq' rsh (to_agree v))
+      | _ => None end) σ1) σ) ∗
+        [∗ map] k↦v ∈ σ1, k ↦{#sh} v.
+  Proof. rewrite mapsto_unseal. by apply resource_map_update_big. Qed.
+
+End gen_heap.
+
+(*
+(** This variant of [gen_heap_init] should only be used when absolutely needed.
+The key difference to [gen_heap_init] is that the [inG] instances in the new
+[gen_heapGS] instance are related to the original [gen_heapGpreS] instance,
+whereas [gen_heap_init] forgets about that relation. *)
+Lemma gen_heap_init_names `{!gen_heapGpreS V Σ} σ :
+  ⊢ |==> ∃ γh γm : gname,
+    let hG := GenHeapGS L V Σ γh γm in
+    gen_heap_interp σ ∗ ([∗ map] l ↦ v ∈ σ, l ↦ v) ∗ ([∗ map] l ↦ _ ∈ σ, meta_token l ⊤).
+Proof.
+  iMod (ghost_map_alloc_empty (K:=L) (V:=V)) as (γh) "Hh".
+  iMod (ghost_map_alloc_empty (K:=L) (V:=gname)) as (γm) "Hm".
+  iExists γh, γm.
+  iAssert (gen_heap_interp (hG:=GenHeapGS _ _ _ γh γm) ∅) with "[Hh Hm]" as "Hinterp".
+  { iExists ∅; simpl. iFrame "Hh Hm". by rewrite dom_empty_L. }
+  iMod (gen_heap_alloc_big with "Hinterp") as "(Hinterp & $ & $)".
+  { apply map_disjoint_empty_r. }
+  rewrite right_id_L. done.
+Qed.
+
+Lemma gen_heap_init `{!gen_heapGpreS V Σ} σ :
+  ⊢ |==> ∃ _ : gen_heapGS V Σ,
+    gen_heap_interp σ ∗ ([∗ map] l ↦ v ∈ σ, l ↦ v) ∗ ([∗ map] l ↦ _ ∈ σ, meta_token l ⊤).
+Proof.
+  iMod (gen_heap_init_names σ) as (γh γm) "Hinit".
+  iExists (GenHeapGS _ _ _ γh γm).
+  done.
+Qed.
+*)
+
+Lemma gen_heap_init_names {S} `{!@gen_heapGpreS S L V Σ H1 H2 H3} σ (Hvalid : ✓ σ) :
+  ⊢ |==> ∃ γh γm,
+    let hG := GenHeapGS S L V Σ γh γm in
+    resource_map_auth (gen_heap_name _) 1 σ ∗
+    ([∗ map] l ↦ x ∈ σ, match x with
+                       | (shared.YES dq _ v) => l ↦{dq} (proj1_sig (elem_of_agree v))
+                       | (shared.NO (Share sh) _) => mapsto_no l sh
+                       | _ => False
+                       end) ∗ ghost_map_auth (gen_meta_name _) 1 ∅.
+Proof.
+  iMod (resource_map_alloc ∅) as (γh) "(Hm & _)".
+  { done. }
+  iMod (resource_map_set _ σ with "Hm") as "(? & ?)"; first done.
+  iMod (ghost_map_alloc_empty) as (γm) "?".
+  iExists γh, γm; iFrame.
+  rewrite mapsto_unseal mapsto_no_unseal //.
+Qed.
+
+Corollary gen_heap_init_names_empty {S} `{!@gen_heapGpreS S L V Σ H1 H2 H3} :
+  ⊢ |==> ∃ γh γm,
+    let hG := GenHeapGS S L V Σ γh γm in
+    resource_map_auth (gen_heap_name _) 1 ∅ ∗ ghost_map_auth (gen_meta_name _) 1 ∅.
+Proof.
+  iDestruct (gen_heap_init_names ∅) as ">(% & % & ? & _ & ?)".
+  { done. }
+  by iExists _, _; iFrame.
+Qed.
+
+Lemma gen_heap_init {S} `{!@gen_heapGpreS S L V Σ H1 H2 H3} σ (Hvalid : ✓ σ) :
+  ⊢ |==> ∃ _ : gen_heapGS S L V Σ, resource_map_auth (gen_heap_name _) 1 σ ∗
+    ([∗ map] l ↦ x ∈ σ, match x with
+                        | (shared.YES dq _ v) => l ↦{dq} (proj1_sig (elem_of_agree v))
+                        | (shared.NO (Share sh) _) => mapsto_no l sh
+                        | _ => False
+                        end) ∗ ghost_map_auth (gen_meta_name _) 1 ∅.
+Proof.
+  iMod (gen_heap_init_names σ) as (γh γm) "Hinit"; first done.
+  iExists (GenHeapGS _ _ _ _ γh γm).
+  done.
+Qed.
+
+Corollary gen_heap_init_empty {S} `{!@gen_heapGpreS S L V Σ H1 H2 H3} :
+  ⊢ |==> ∃ _ : gen_heapGS S L V Σ, resource_map_auth (gen_heap_name _) 1 ∅ ∗ ghost_map_auth (gen_meta_name _) 1 ∅.
+Proof.
+  iMod gen_heap_init_names_empty as (γh γm) "Hinit".
+  iExists (GenHeapGS _ _ _ _ γh γm).
+  done.
+Qed.
diff --git a/shared/resource_map.v b/shared/resource_map.v
new file mode 100644
index 0000000000..d7dd27c8cf
--- /dev/null
+++ b/shared/resource_map.v
@@ -0,0 +1,659 @@
+(* modified from iris.base_logic.lib.ghost_map *)
+
+(** A "resource map" (or "resource heap") with a proposition controlling authoritative
+ownership of the entire heap, and a "points-to-like" proposition for (mutable,
+fractional, or persistent read-only) ownership of individual elements. *)
+From iris.proofmode Require Import proofmode.
+From iris.algebra Require Export auth csum gmap.
+Set Warnings "-notation-overridden,-hiding-delimiting-key".
+From iris_ora.algebra Require Export osum gmap view auth.
+From iris_ora.logic Require Export logic own algebra.
+From VST.shared Require Export share_alg.
+From VST.shared Require Import shared.
+Set Warnings "notation-overridden,hiding-delimiting-key".
+From iris.prelude Require Import options.
+
+Section shared.
+  Context `{ST : ShareType} {M : uora} {V : ofe}.
+
+  Lemma shared_validI (x : shared V) : ✓ x ⊣⊢ match x return ouPred M with
+                                 | YES dq _ v => ⌜✓ dq⌝ ∧ ✓ v
+                                 | NO sh _ => ⌜✓ sh⌝
+                                 end.
+  Proof.
+    ouPred.unseal. by destruct x.
+  Qed.
+
+  Lemma shared_order_includedN n (x y : shared V) : ✓{n} y → x ≼ₒ{n} y → x ≼{n} y.
+  Proof.
+    intros Hvalid [|(Hd & Hv)].
+    - exists y; rewrite H comm shared_err_absorb //.
+    - apply shared_includedN'; first done.
+      split.
+      + destruct Hd as [<-|<-]; [|eexists]; done.
+      + rewrite option_includedN_total.
+        apply shared_validN in Hvalid as [_ Hvalid].
+        destruct (val_of x); last by auto.
+        destruct (val_of y); last done.
+        rewrite Some_orderN in Hv.
+        right; eexists _, _; split; first done; split; first done.
+        apply agree_order_dist in Hv as ->; done.
+  Qed.
+
+End shared.
+
+Definition rmapUR (S : Type) `{ShareType S} (K : Type) `{Countable K} (V : ofe) : uora := gmapUR K (sharedR V).
+
+Lemma rmap_order_includedN S `{ShareType S} K `{Countable K} V n (x y : rmapUR _ K V) : ✓{n} y → x ≼ₒ{n} y → x ≼{n} y.
+Proof.
+  intros Hvalid Hord. rewrite lookup_includedN; intros i.
+  specialize (Hvalid i); specialize (Hord i); rewrite option_includedN.
+  destruct (x !! i) as [a|] eqn: Hx; last by auto.
+  rewrite Hx in Hord |- *; clear Hx.
+  destruct (_ !! _) as [b|]; last done.
+  right; eexists _, _; split; first done; split; first done.
+  apply shared_order_includedN in Hord; eauto.
+Qed.
+
+Canonical Structure rmap_authR S `{ShareType S} K `{Countable K} V := authR _ (rmap_order_includedN S K V).
+Set Warnings "-redundant-canonical-projection".
+Canonical Structure rmap_authUR S `{ShareType S} `{Countable K} V := authUR _ (rmap_order_includedN S K V).
+Set Warnings "redundant-canonical-projection".
+
+Global Instance rmap_frag_core_id `{ShareType} {K} `{Countable K} {V} (a : rmapUR _ K V) : OraCoreId a → OraCoreId (◯ a).
+Proof. apply @auth_frag_core_id. Qed.
+
+Class resource_mapG Σ S `{ShareType S} K `{Countable K} (V : Type) := ResourceMapG {
+  resource_map_inG : inG Σ (rmap_authR _ K (leibnizO V));
+}.
+Local Existing Instance resource_map_inG.
+
+Definition resource_mapΣ S `{ShareType S} K `{Countable K} (V : Type) : gFunctors :=
+  #[ GFunctor (rmap_authR S K (leibnizO V)) ].
+
+Global Instance subG_resource_mapΣ Σ S `{ShareType S} K `{Countable K} (V : Type) :
+  subG (resource_mapΣ S K V) Σ → resource_mapG Σ S K V.
+Proof. solve_inG. Qed.
+
+Section definitions.
+  Context {S} `{resource_mapG Σ S K V}.
+
+  Local Definition resource_map_auth_def
+      (γ : gname) (q : Qp) m : iProp Σ :=
+    own γ (●{dfrac.DfracOwn q} m).
+  Local Definition resource_map_auth_aux : seal (@resource_map_auth_def).
+  Proof. by eexists. Qed.
+  Definition resource_map_auth := resource_map_auth_aux.(unseal).
+  Local Definition resource_map_auth_unseal :
+    @resource_map_auth = @resource_map_auth_def := resource_map_auth_aux.(seal_eq).
+
+  Local Definition resource_map_elem_def
+      (γ : gname) (k : K) (dq : dfrac) (v : V) : iProp Σ :=
+    ∃ rsh, own γ (◯ {[k := (YES (V := leibnizO V) dq rsh (to_agree v))]}).
+  Local Definition resource_map_elem_aux : seal (@resource_map_elem_def).
+  Proof. by eexists. Qed.
+  Definition resource_map_elem := resource_map_elem_aux.(unseal).
+  Local Definition resource_map_elem_unseal :
+    @resource_map_elem = @resource_map_elem_def := resource_map_elem_aux.(seal_eq).
+
+  Local Definition resource_map_elem_no_def
+      (γ : gname) (k : K) (sh : S) : iProp Σ :=
+    ∃ rsh, own γ (◯ {[k := (NO (V := leibnizO V) (Share sh) rsh)]}).
+  Local Definition resource_map_elem_no_aux : seal (@resource_map_elem_no_def).
+  Proof. by eexists. Qed.
+  Definition resource_map_elem_no := resource_map_elem_no_aux.(unseal).
+  Local Definition resource_map_elem_no_unseal :
+    @resource_map_elem_no = @resource_map_elem_no_def := resource_map_elem_no_aux.(seal_eq).
+
+End definitions.
+
+Notation "k ↪[ γ ] dq v" := (resource_map_elem γ k dq v)
+  (at level 20, γ at level 50, dq custom dfrac at level 1,
+   format "k  ↪[ γ ] dq  v") : bi_scope.
+
+(* no notation for no right now *)
+
+Local Ltac unseal := rewrite
+  ?resource_map_auth_unseal /resource_map_auth_def
+  ?resource_map_elem_unseal /resource_map_elem_def
+  ?resource_map_elem_no_unseal /resource_map_elem_no_def.
+
+Section lemmas.
+  Context {S} `{ShareType S} `{Countable K} `{!resource_mapG Σ S K V}.
+  Implicit Types (k : K) (v : V) (dq : dfrac) (q : Qp).
+
+  (** * Lemmas about the map elements *)
+  Global Instance resource_map_elem_timeless k γ dq v : Timeless (k ↪[γ]{dq} v).
+  Proof. unseal. apply _. Qed.
+  Global Instance resource_map_elem_persistent k γ v : Persistent (k ↪[γ]□ v).
+  Proof. unseal. apply _. Qed.
+(*  Global Instance resource_map_elem_fractional k γ v : Fractional (λ q, k ↪[γ]{#q} v)%I.
+  Proof. unseal. intros p q. rewrite -own_op juicy_view_frag_add //. Qed.
+  Global Instance resource_map_elem_as_fractional k γ q v :
+    AsFractional (k ↪[γ]{#q} v) (λ q, k ↪[γ]{#q} v)%I q.
+  Proof. split; first done. apply _. Qed.*)
+  Global Instance resource_map_elem_affine k γ v : Affine (k ↪[γ]□ v).
+  Proof. unseal. apply _. Qed.
+  Global Instance resource_map_elem_no_persistent k γ : Persistent (resource_map_elem_no γ k share_bot).
+  Proof. unseal. apply _. Qed.
+  Global Instance resource_map_elem_no_affine k γ : Affine (resource_map_elem_no γ k share_bot).
+  Proof. unseal. apply _. Qed.
+
+  Local Lemma resource_map_elems_unseal γ m dq (rsh : readable_dfrac dq) :
+    ([∗ map] k ↦ v ∈ m, k ↪[γ]{dq} v) ==∗
+    own γ ([^op map] k↦v ∈ m, ◯ {[k := (YES (V := leibnizO V) dq rsh (to_agree v))]}).
+  Proof.
+    unseal. destruct (decide (m = ∅)) as [->|Hne].
+    - rewrite !big_opM_empty. iIntros "_". iApply own_unit.
+    - rewrite big_opM_own //. iIntros "? !>".
+      iApply (big_sepM_mono with "[$]").
+      intros; iIntros "(% & ?)".
+      iApply (own_proper with "[$]").
+      f_equiv.
+      eapply @singletonM_proper; first apply _.
+      done.
+  Qed.
+
+  Lemma resource_map_elem_valid k γ dq v : k ↪[γ]{dq} v -∗ ⌜✓ dq ∧ readable_dfrac dq⌝.
+  Proof.
+    unseal. iIntros "[% Helem]".
+    iPoseProof (own_valid with "Helem") as "H".
+    rewrite auth_frag_validI singleton_validI shared_validI.
+    iDestruct "H" as "(% & _)"; done.
+  Qed.
+  Lemma resource_map_elem_valid_2 k γ dq1 dq2 v1 v2 :
+    k ↪[γ]{dq1} v1 -∗ k ↪[γ]{dq2} v2 -∗ ⌜✓ (dq1 ⋅ dq2) ∧ readable_dfrac (dq1 ⋅ dq2) ∧ v1 = v2⌝.
+  Proof.
+    unseal. iIntros "[% H1] [% H2]".
+    iDestruct (own_valid_2 with "H1 H2") as "H".
+    unshelve rewrite auth_frag_validI singleton_op singleton_validI /= YES_op'.
+    destruct (readable_dfrac_dec _); rewrite shared_validI; last done.
+    rewrite to_agree_op_validI.
+    iDestruct "H" as "(% & %)"; done.
+  Qed.
+  Lemma resource_map_elem_agree k γ dq1 dq2 v1 v2 :
+    k ↪[γ]{dq1} v1 -∗ k ↪[γ]{dq2} v2 -∗ ⌜v1 = v2⌝.
+  Proof.
+    iIntros "Helem1 Helem2".
+    iDestruct (resource_map_elem_valid_2 with "Helem1 Helem2") as %(_ & _ & ?).
+    done.
+  Qed.
+
+  Global Instance resource_map_elem_combine_gives γ k v1 dq1 v2 dq2 :
+    CombineSepGives (k ↪[γ]{dq1} v1) (k ↪[γ]{dq2} v2) ⌜✓ (dq1 ⋅ dq2) ∧ readable_dfrac (dq1 ⋅ dq2) ∧ v1 = v2⌝.
+  Proof.
+    rewrite /CombineSepGives. iIntros "[H1 H2]".
+    iDestruct (resource_map_elem_valid_2 with "H1 H2") as %[??].
+    eauto.
+  Qed.
+
+  Lemma resource_map_elem_combine k γ dq1 dq2 v1 v2 :
+    k ↪[γ]{dq1} v1 -∗ k ↪[γ]{dq2} v2 -∗ k ↪[γ]{dq1 ⋅ dq2} v1 ∧ ⌜v1 = v2⌝.
+  Proof.
+    iIntros "Hl1 Hl2". iDestruct (resource_map_elem_valid_2 with "Hl1 Hl2") as %(? & Hv & ->); iSplit; last done.
+    unseal. iDestruct "Hl1" as (?) "Hl1"; iDestruct "Hl2" as (?) "Hl2"; iExists Hv. iCombine "Hl1 Hl2" as "Hl". rewrite -own_op -auth_frag_op singleton_op YES_op agree_idemp //.
+  Qed.
+
+  Global Instance resource_map_elem_combine_as k γ dq1 dq2 v1 v2 :
+    CombineSepAs (k ↪[γ]{dq1} v1) (k ↪[γ]{dq2} v2) (k ↪[γ]{dq1 ⋅ dq2} v1) | 60. 
+    (* higher cost than the Fractional instance [combine_sep_fractional_bwd],
+       which kicks in for #qs *)
+  Proof.
+    rewrite /CombineSepAs. iIntros "[H1 H2]".
+    iDestruct (resource_map_elem_combine with "H1 H2") as "($ & _)".
+  Qed.
+
+  Lemma resource_map_elem_split k γ dq1 dq2 (rsh1 : readable_dfrac dq1) (rsh2 : readable_dfrac dq2) v :
+    k ↪[γ]{dq1 ⋅ dq2} v ⊣⊢ k ↪[γ]{dq1} v ∗ k ↪[γ]{dq2} v.
+  Proof.
+    iSplit; last by iIntros "[A B]"; iCombine "A B" as "H".
+    unseal. iIntros "[% ?]".
+    rewrite bi.sep_exist_r; iExists rsh1.
+    rewrite bi.sep_exist_l; iExists rsh2.
+    rewrite -own_op -auth_frag_op singleton_op YES_op agree_idemp //.
+  Qed.
+
+  Lemma resource_map_elem_no_valid k γ sh :
+    resource_map_elem_no γ k sh -∗ ⌜~share_readable sh⌝.
+  Proof.
+    unseal. iIntros "[% H]"; done.
+  Qed.
+
+  Lemma resource_map_elem_no_elem_valid_2 k γ sh1 dq2 v2 :
+    resource_map_elem_no γ k sh1 -∗ k ↪[γ]{dq2} v2 -∗ ⌜✓ (DfracOwn (Share sh1) ⋅ dq2) ∧ readable_dfrac (DfracOwn (Share sh1) ⋅ dq2)⌝.
+  Proof.
+    unseal. iIntros "[% H1] [% H2]".
+    iDestruct (own_valid_2 with "H1 H2") as "H".
+    rewrite -auth_frag_op singleton_op NO_YES_op' auth_frag_validI singleton_validI.
+    destruct (readable_dfrac_dec _); rewrite shared_validI; last done.
+    iDestruct "H" as "(% & _)"; done.
+  Qed.
+
+  Lemma resource_map_elem_no_valid_2 k γ sh1 sh2 :
+    resource_map_elem_no γ k sh1 -∗ resource_map_elem_no γ k sh2 -∗ ⌜✓ (Share sh1 ⋅ Share sh2) ∧ ~readable_share' (Share sh1 ⋅ Share sh2)⌝.
+  Proof.
+    unseal. iIntros "[% H1] [% H2]".
+    iDestruct (own_valid_2 with "H1 H2") as "H".
+    rewrite -auth_frag_op singleton_op auth_frag_validI singleton_validI shared_validI /=.
+    iDestruct "H" as %Hv; iPureIntro.
+    split; first done.
+    apply share_valid2_joins in Hv as (? & ? & ? & [=] & [=] & Heq & ?); subst; rewrite Heq.
+    by eapply join_unreadable.
+  Qed.
+
+  Lemma resource_map_elem_no_elem_combine k γ sh1 dq2 v2 :
+    resource_map_elem_no γ k sh1 -∗ k ↪[γ]{dq2} v2 -∗ k ↪[γ]{DfracOwn (Share sh1) ⋅ dq2} v2.
+  Proof.
+    iIntros "Hl1 Hl2". iDestruct (resource_map_elem_no_elem_valid_2 with "Hl1 Hl2") as %[? Hv].
+    unseal. iDestruct "Hl1" as (?) "Hl1"; iDestruct "Hl2" as (?) "Hl2"; iExists Hv. iCombine "Hl1 Hl2" as "Hl". rewrite -own_op -auth_frag_op singleton_op NO_YES_op //.
+  Qed.
+
+  Lemma resource_map_elem_no_combine k γ sh1 sh2 :
+    resource_map_elem_no γ k sh1 -∗ resource_map_elem_no γ k sh2 -∗ ∃ sh, ⌜share_op sh1 sh2 = Some sh⌝ ∧ resource_map_elem_no γ k sh.
+  Proof.
+    iIntros "Hl1 Hl2". iDestruct (resource_map_elem_no_valid_2 with "Hl1 Hl2") as %[J Hv].
+    unseal. iDestruct "Hl1" as "[% Hl1]"; iDestruct "Hl2" as "[% Hl2]"; iCombine "Hl1 Hl2" as "Hl".
+    apply share_valid2_joins in J as (? & ? & sh & [=] & [=] & Heq & J); subst.
+    iExists sh; iSplit; first done.
+    rewrite -Heq; iExists Hv; rewrite -own_op -auth_frag_op singleton_op.
+    iApply (own_proper with "Hl"); f_equiv.
+    eapply @singletonM_proper; first apply _.
+    done.
+  Qed.
+
+  Lemma resource_map_elem_split_no k γ sh1 dq2 (rsh1 : ~share_readable sh1) (rsh2 : readable_dfrac dq2) v :
+    k ↪[γ]{DfracOwn (Share sh1) ⋅ dq2} v ⊣⊢ resource_map_elem_no γ k sh1 ∗ k ↪[γ]{dq2} v.
+  Proof.
+    iSplit; last by iIntros "[A B]"; iApply (resource_map_elem_no_elem_combine with "A B").
+    unseal. iIntros "[% ?]".
+    rewrite bi.sep_exist_r; iExists rsh1.
+    rewrite bi.sep_exist_l; iExists rsh2.
+    rewrite -own_op -auth_frag_op singleton_op NO_YES_op //.
+  Qed.
+
+  Lemma resource_map_elem_no_split k (γ : gname) sh1 sh2 (rsh1 : ~share_readable sh1) (rsh2 : ~share_readable sh2) sh
+    (J : share_op sh1 sh2 = Some sh) :
+    resource_map_elem_no γ k sh ⊣⊢ resource_map_elem_no γ k sh1 ∗ resource_map_elem_no γ k sh2.
+  Proof.
+    iSplit.
+    - unseal.
+      assert (Share sh1 ⋅ Share sh2 = Share sh) as Heq by (apply share_op_join; eauto).
+      rewrite -Heq; iIntros "(% & ?)".
+      rewrite bi.sep_exist_r; iExists rsh1.
+      rewrite bi.sep_exist_l; iExists rsh2.
+      rewrite -own_op -auth_frag_op singleton_op.
+      iApply (own_proper with "[$]"); f_equiv.
+      eapply @singletonM_proper; first apply _.
+      done.
+    - iIntros "[A B]"; iDestruct (resource_map_elem_no_combine with "A B") as (? J') "?".
+      rewrite J' in J; inversion J; subst; done.
+  Qed.
+
+  Lemma resource_map_elem_frac_ne γ k1 k2 dq1 dq2 v1 v2 :
+    ¬ ✓ (dq1 ⋅ dq2) → k1 ↪[γ]{dq1} v1 -∗ k2 ↪[γ]{dq2} v2 -∗ ⌜k1 ≠ k2⌝.
+  Proof.
+    iIntros (?) "H1 H2"; iIntros (->).
+    by iDestruct (resource_map_elem_valid_2 with "H1 H2") as %[??].
+  Qed.
+(*  Lemma resource_map_elem_ne γ k1 k2 dq2 v1 v2 :
+    k1 ↪[γ] v1 -∗ k2 ↪[γ]{dq2} v2 -∗ ⌜k1 ≠ k2⌝.
+  Proof. apply resource_map_elem_frac_ne. apply: exclusive_l. Qed.*)
+
+(** Make an element read-only. This is a memory leak.
+  Lemma resource_map_elem_persist k γ dq v :
+    k ↪[γ]{dq} v ==∗ k ↪[γ]□ v.
+  Proof. unseal. iIntros "[% ?]"; iExists I. iApply (own_update with "[$]"). apply view_update_frag. Qed.
+
+  Lemma resource_map_elem_bot k γ dq v :
+    k ↪[γ]{dq} v ==∗ resource_map_elem_no γ k share_bot.
+  Proof. unseal. iIntros "[% ?]"; iExists bot_unreadable. iApply (own_update with "[$]"). apply juicy_view_frag_bot. Qed.
+
+  Lemma resource_map_elem_no_bot k γ sh :
+    resource_map_elem_no γ k sh ==∗ resource_map_elem_no γ k share_bot.
+  Proof. unseal. iIntros "[% ?]"; iExists bot_unreadable. iApply (own_update with "[$]"). apply juicy_view_frag_no_bot. Qed.*)
+
+  (** * Lemmas about [resource_map_auth] *)
+  Lemma resource_map_alloc_strong P (m : rmapUR S K (leibnizO V)) :
+    pred_infinite P → ✓ m →
+    ⊢ |==> ∃ γ, ⌜P γ⌝ ∧ resource_map_auth γ 1 m ∗ own γ (◯ m).
+  Proof.
+    unseal. intros.
+    setoid_rewrite <- own_op.
+    iApply own_alloc_strong; first done.
+    apply auth_both_valid_2; done.
+  Qed.
+  Lemma resource_map_alloc_strong_empty P :
+    pred_infinite P →
+    ⊢ |==> ∃ γ, ⌜P γ⌝ ∧ resource_map_auth γ 1 ∅.
+  Proof.
+    unseal. intros.
+    iApply own_alloc_strong; first done.
+    by apply auth_auth_valid.
+  Qed.
+  Lemma resource_map_alloc (m : rmapUR S K (leibnizO V)) :
+    ✓ m →
+    ⊢ |==> ∃ γ, resource_map_auth γ 1 m ∗ own γ (◯ m).
+  Proof.
+    intros; iMod (resource_map_alloc_strong (λ _, True) m) as (γ) "[_ Hmap]"; [|done|].
+    - by apply pred_infinite_True.
+    - eauto.
+  Qed.
+  Lemma resource_map_alloc_empty :
+    ⊢ |==> ∃ γ, resource_map_auth γ 1 ∅.
+  Proof.
+    iMod (resource_map_alloc_strong_empty (λ _, True)) as (γ) "[_ Hmap]".
+    - by apply pred_infinite_True.
+    - eauto.
+  Qed.
+
+  Global Instance resource_map_auth_timeless γ q m : Timeless (resource_map_auth γ q m).
+  Proof. unseal. apply _. Qed.
+(*  Global Instance resource_map_auth_fractional γ m : Fractional (λ q, resource_map_auth γ q m)%I.
+  Proof. intros p q. unseal. rewrite -own_op -juicy_view_auth_dfrac_op //. Qed.
+  Global Instance resource_map_auth_as_fractional γ q m :
+    AsFractional (resource_map_auth γ q m) (λ q, resource_map_auth γ q m)%I q.
+  Proof. split; first done. apply _. Qed.*)
+
+  Lemma resource_map_auth_valid γ q m : resource_map_auth γ q m -∗ ⌜✓ q ∧ ✓ m⌝.
+  Proof.
+    unseal. iIntros "Hauth".
+    iDestruct (own_valid with "Hauth") as "H".
+    rewrite auth_auth_dfrac_validI; iDestruct "H" as "(% & %)"; done.
+  Qed.
+  Lemma resource_map_auth_valid_2 γ q1 q2 m1 m2 :
+    resource_map_auth γ q1 m1 -∗ resource_map_auth γ q2 m2 -∗ ⌜✓ (q1 ⋅ q2) ∧ m1 ≡ m2⌝.
+  Proof.
+    unseal. iIntros "H1 H2".
+    iDestruct (own_valid_2 with "H1 H2") as "H".
+    rewrite auth_auth_dfrac_op_validI.
+    iDestruct "H" as "(% & % & _)"; done.
+  Qed.
+  Lemma resource_map_auth_agree γ q1 q2 m1 m2 :
+    resource_map_auth γ q1 m1 -∗ resource_map_auth γ q2 m2 -∗ m1 ≡ m2.
+  Proof.
+    iIntros "H1 H2".
+    iDestruct (resource_map_auth_valid_2 with "H1 H2") as %[_ ?].
+    done.
+  Qed.
+
+  (** * Lemmas about the interaction of [resource_map_auth] with the elements *)
+  Lemma resource_map_lookup {γ q m k dq v} :
+    resource_map_auth γ q m -∗ k ↪[γ]{dq} v -∗ ⌜∃ dq', ∃ rsh : readable_dfrac dq', ✓ dq' ∧ dq ≼ dq' ∧
+      m !! k ≡ Some (YES (V := leibnizO V) dq' rsh (to_agree v))⌝.
+  Proof.
+    unseal. iIntros "Hauth [% Hel]".
+    iDestruct (own_valid_2 with "Hauth Hel") as "H".
+    rewrite auth_both_dfrac_validI.
+    iDestruct "H" as (? (m' & Hm)) "Hv".
+    rewrite gmap_validI; iSpecialize ("Hv" $! k).
+    specialize (Hm k).
+    rewrite lookup_op lookup_singleton Some_op_opM in Hm; inversion Hm as [x ? Hk Heq|]; subst.
+    rewrite ouPred.option_validI -Heq.
+    clear Hm Heq.
+    subst; rewrite shared_validI.
+    destruct (_ !! _) as [|]; simpl in Hk.
+    - pose proof (shared_op_alt _ (YES (V := leibnizO V) dq rsh (to_agree v)) c) as Hop.
+      simpl in Hop; destruct (readable_dfrac_dec _).
+      + destruct Hop as (? & Hv & Hop); rewrite Hop in Hk.
+        destruct x; last done.
+        iDestruct "Hv" as "(% & %Hvv)".
+        iPureIntro; exists dq0, rsh0.
+        rewrite Some_op_opM in Hv; inversion Hv; subst; clear Hv.
+        destruct Hk as [-> Hv]; rewrite Hv in Hvv |- *.
+        split; first done; split; first by eexists.
+        f_equiv; split; first done.
+        destruct (val_of c); last done.
+        apply agree_op_inv in Hvv as <-.
+        rewrite /= agree_idemp //.
+      + destruct (dfrac_error _); last by destruct Hop as (? & ? & ? & ? & ? & ?).
+        rewrite Hop in Hk; destruct x; inversion Hk; subst; done.
+    - destruct x; last done.
+      destruct Hk as [-> Hv].
+      iDestruct "Hv" as "(% & _)".
+      iPureIntro; exists dq, rsh; split; first done; split; first done.
+      f_equiv; split; done.
+  Qed.
+
+  Global Instance resource_map_lookup_combine_gives_1 {γ q m k dq v} :
+    CombineSepGives (resource_map_auth γ q m) (k ↪[γ]{dq} v) ⌜∃ dq', ∃ rsh : readable_dfrac dq', ✓ dq' ∧ dq ≼ dq' ∧
+      m !! k ≡ Some (YES (V := leibnizO V) dq' rsh (to_agree v))⌝.
+  Proof.
+    rewrite /CombineSepGives. iIntros "[H1 H2]".
+    iDestruct (resource_map_lookup with "H1 H2") as %?. eauto.
+  Qed.
+
+  Global Instance resource_map_lookup_combine_gives_2 {γ q m k dq v} :
+    CombineSepGives (k ↪[γ]{dq} v) (resource_map_auth γ q m) ⌜∃ dq', ∃ rsh : readable_dfrac dq', ✓ dq' ∧ dq ≼ dq' ∧
+      m !! k ≡ Some (YES (V := leibnizO V) dq' rsh (to_agree v))⌝.
+  Proof.
+    rewrite /CombineSepGives comm. apply resource_map_lookup_combine_gives_1.
+  Qed.
+
+  Lemma resource_map_no_lookup {γ q m k sh} :
+    resource_map_auth γ q m -∗ resource_map_elem_no γ k sh -∗ ⌜∃ s, ✓ s ∧ m !! k = Some s ∧ DfracOwn (Share sh) ≼ dfrac_of s⌝.
+  Proof.
+    unseal. iIntros "Hauth [% Hel]".
+    iDestruct (own_valid_2 with "Hauth Hel") as "H".
+    rewrite auth_both_dfrac_validI.
+    iDestruct "H" as (? (m' & Hm)) "Hv".
+    rewrite gmap_validI; iSpecialize ("Hv" $! k).
+    specialize (Hm k).
+    rewrite lookup_op lookup_singleton Some_op_opM in Hm; inversion Hm as [x ? Hk Heq|]; subst.
+    rewrite ouPred.option_validI -Heq.
+    clear Hm Heq.
+    iDestruct "Hv" as %Hvalid.
+    iPureIntro; eexists; split; first done; split; first done.
+    erewrite (dfrac_of_ne _ O); last by apply equiv_dist.
+    destruct (m' !! k) as [|] eqn: Hk'; rewrite Hk' /= // in Hk |- *.
+    rewrite Hk in Hvalid; apply shared_valid in Hvalid as [Hd _].
+    rewrite dfrac_of_op' in Hd |- *.
+    destruct (dfrac_error _); first done.
+    by eexists.
+  Qed.
+
+  Lemma resource_map_insert {γ m} k v :
+    m !! k = None →
+    resource_map_auth γ 1 m ⊢ |==> resource_map_auth γ 1 (<[k := (YES (V := leibnizO V) (DfracOwn (Share share_top)) readable_top (to_agree v))]> m) ∗ k ↪[γ] v.
+  Proof.
+    unseal. intros ?.
+    iIntros "H"; rewrite bi.sep_exist_l.
+    iExists readable_top.
+    rewrite -own_op.
+    iApply (own_update with "H").
+    apply auth_update_alloc, alloc_singleton_local_update; done.
+  Qed.
+  Lemma resource_map_insert_persist {γ m} k v :
+    m !! k = None →
+    resource_map_auth γ 1 m ⊢ |==> resource_map_auth γ 1 (<[k := (YES (V := leibnizO V) DfracDiscarded I (to_agree v))]> m) ∗ k ↪[γ]□ v.
+  Proof.
+    unseal. intros ?.
+    iIntros "H"; rewrite bi.sep_exist_l.
+    iExists I.
+    rewrite -own_op.
+    iApply (own_update with "H").
+    apply auth_update_alloc, alloc_singleton_local_update; try done.
+    split; try done; apply dfrac_valid_discarded.
+  Qed.
+
+  Lemma resource_map_delete {γ m k v} :
+    resource_map_auth γ 1 m -∗ k ↪[γ] v ==∗ resource_map_auth γ 1 (<[k := ε]>m).
+  Proof.
+    iIntros "Hm H".
+    iDestruct (resource_map_lookup with "Hm H") as %(? & rsh0 & Hv & Hd & Hk).
+    unseal.
+    iDestruct "H" as (?) "H".
+    iPoseProof (own_update_2 with "Hm H") as ">H".
+    { apply auth_update, singleton_local_update_any.
+      intros ? Hk'; rewrite Hk' in Hk; inversion Hk as [?? Heq|].
+      subst; rewrite Heq.
+      destruct Hd as (? & Hd); rewrite Hd in Hv; apply dfrac_full_exclusive in Hv as ->.
+      rewrite right_id in Hd; inversion Hd; subst; clear Hd.
+      rewrite -{1}(uora_unit_right_id (YES _ _ _)).
+      assert (YES (V := leibnizO V) (DfracOwn (Share share_top)) rsh0 (to_agree v) ≡ YES (V := leibnizO V) (DfracOwn (Share share_top)) rsh (to_agree v)) as -> by done.
+      apply cancel_local_update_unit, _. }
+    rewrite own_op; iDestruct "H" as "($ & _)"; done.
+  Qed.
+
+  Lemma resource_map_update {γ m k sh v} (Hsh : share_writable sh) w :
+    resource_map_auth γ 1 m -∗ k ↪[γ]{#sh} v ==∗ ∃ dq' rsh', ⌜✓ dq' ∧ DfracOwn (Share sh) ≼ dq' ∧
+      m !! k ≡ Some (YES (V := leibnizO V) dq' rsh' (to_agree v))⌝ ∧
+    resource_map_auth γ 1 (<[k := (YES dq' rsh' (to_agree w))]> m) ∗ k ↪[γ]{#sh} w.
+  Proof.
+    iIntros "Hm H".
+    iDestruct (resource_map_lookup with "Hm H") as %(dq' & rsh' & Hv & Hd & Hk).
+    unseal.
+    iDestruct "H" as "(% & H)".
+    iExists dq', rsh'.
+    rewrite bi.pure_True // bi.True_and.
+    rewrite bi.sep_exist_l; iExists rsh.
+    rewrite -own_op; iApply (own_update_2 with "Hm H").
+    apply auth_update, singleton_local_update_any.
+    intros ? Hk'; rewrite Hk' in Hk; inversion Hk as [?? Heq|].
+    subst; rewrite Heq.
+    intros ??; simpl; intros Hv' Hc'.
+    split; first done.
+    destruct mz; last by destruct Hc' as [-> ?].
+    rewrite !shared_dist' /= !dfrac_of_op' !val_of_op' in Hc' |- *.
+    destruct Hc' as [-> Hval'].
+    destruct (dfrac_error _) eqn: Herr; try done.
+    destruct c; try done.
+    simpl in *.
+    rewrite comm in Hv; apply dfrac_valid_own_readable in Hv as (? & [=] & ?); subst; done.
+  Qed.
+
+  (** Big-op versions of above lemmas *)
+  Lemma resource_map_lookup_big {γ q m} dq m0 :
+    resource_map_auth γ q m -∗
+    ([∗ map] k↦v ∈ m0, k ↪[γ]{dq} v) -∗
+    ⌜map_Forall (fun k v => ∃ dq', ∃ rsh : readable_dfrac dq', ✓ dq' ∧ dq ≼ dq' ∧
+            m !! k ≡ Some (YES (V := leibnizO V) dq' rsh (to_agree v))) m0⌝.
+  Proof.
+    iIntros "Hauth Hfrag" (k v Hk).
+    rewrite big_sepM_lookup_acc; last done.
+    iDestruct "Hfrag" as "[Hfrag ?]".
+    iApply (resource_map_lookup with "Hauth Hfrag").
+  Qed.
+
+  Lemma big_sepM_exist : ∀ {PROP : bi} {A} (P : K -> V -> A -> PROP) m, (∃ y, [∗ map] k↦x ∈ m, P k x y) ⊢ [∗ map] k↦x ∈ m, ∃ y, P k x y.
+  Proof.
+    intros; iIntros "(% & H)".
+    iApply (big_sepM_mono with "H"); eauto.
+  Qed.
+
+  Lemma resource_map_insert_big {γ m} m' :
+    dom m' ## dom m →
+    resource_map_auth γ 1 m ⊢ |==>
+    resource_map_auth γ 1 (((λ v, (YES (V := leibnizO V) (DfracOwn (Share share_top)) readable_top (to_agree v))) <$> m') ∪ m) ∗ ([∗ map] k ↦ v ∈ m', k ↪[γ] v).
+  Proof.
+    revert m; induction m' as [|k v m' Hk IH] using map_ind; decompose_map_disjoint; intros ? Hdisj.
+    { rewrite fmap_empty big_opM_empty.
+      unseal. rewrite own_proper; first by iIntros "$".
+      f_equiv; intros i; rewrite lookup_union lookup_empty option_union_left_id //. }
+  rewrite dom_insert in Hdisj; apply disjoint_union_l in Hdisj as [Hout%disjoint_singleton_l ?].
+  rewrite big_sepM_insert // IH //.
+  iIntros ">(H & $)".
+  rewrite fmap_insert -insert_union_l.
+  iApply (resource_map_insert with "H").
+  rewrite lookup_union lookup_fmap Hk /=.
+  eapply @not_elem_of_dom_1 in Hout as ->; last apply _; done.
+  Qed.
+  Lemma resource_map_insert_persist_big {γ m} m' :
+    dom m' ## dom m →
+    resource_map_auth γ 1 m ⊢ |==>
+    resource_map_auth γ 1 (((λ v, (YES (V := leibnizO V) DfracDiscarded I (to_agree v))) <$> m') ∪ m) ∗ ([∗ map] k ↦ v ∈ m', k ↪[γ]□ v).
+  Proof.
+    induction m' as [|k v m' Hk IH] using map_ind; decompose_map_disjoint; intros Hdisj.
+    { rewrite fmap_empty big_opM_empty.
+      unseal. rewrite own_proper; first by iIntros "$".
+      f_equiv; intros i; rewrite lookup_union lookup_empty option_union_left_id //. }
+    rewrite dom_insert in Hdisj; apply disjoint_union_l in Hdisj as [Hout%disjoint_singleton_l ?].
+    rewrite big_sepM_insert // IH //.
+    iIntros ">(H & $)".
+    rewrite fmap_insert -insert_union_l.
+    iApply (resource_map_insert_persist with "H").
+    rewrite lookup_union lookup_fmap Hk /=.
+    eapply @not_elem_of_dom_1 in Hout as ->; last apply _; done.
+  Qed.
+
+  Lemma resource_map_delete_big {γ m} m0 :
+    resource_map_auth γ 1 m -∗
+    ([∗ map] k↦v ∈ m0, k ↪[γ] v) ==∗
+    resource_map_auth γ 1 (((λ _, ε) <$> m0) ∪ m).
+  Proof.
+    induction m0 as [|k v m' ? IH] using map_ind.
+    { rewrite fmap_empty big_opM_empty !left_id; auto. }
+    rewrite big_sepM_insert //.
+    iIntros "Hm (Hk & Hrest)"; iMod (IH with "Hm Hrest") as "Hm".
+    iMod (resource_map_delete with "Hm Hk").
+    rewrite fmap_insert -insert_union_l //.
+  Qed.
+
+  Lemma resource_map_update_big {γ m} sh (Hsh : share_writable sh) m0 m1 :
+    dom m0 = dom m1 →
+    resource_map_auth γ 1 m -∗
+    ([∗ map] k↦v ∈ m0, k ↪[γ]{#sh} v) ==∗
+    resource_map_auth γ 1 (union(Union := map_union) (map_imap (λ k v, match m !! k with
+      | Some (YES dq' rsh _) => Some (YES (V := leibnizO V) dq' rsh (to_agree v))
+      | _ => None end) m1) m) ∗
+        [∗ map] k↦v ∈ m1, k ↪[γ]{#sh} v.
+  Proof.
+    revert m1; induction m0 as [|k v m' ? IH] using map_ind; intros ? Hdom.
+    { rewrite dom_empty_L in Hdom.
+      symmetry in Hdom; apply dom_empty_inv_L in Hdom as ->.
+      rewrite !big_opM_empty map_imap_empty !left_id; auto. }
+    rewrite dom_insert_L in Hdom.
+    rewrite big_sepM_insert //.
+    iIntros "Hm (Hk & Hrest)"; iMod (IH (delete k m1) with "Hm Hrest") as "(Hm & Hrest)".
+    { rewrite dom_delete_L -Hdom difference_union_distr_l_L difference_diag_L left_id_L difference_disjoint_L //.
+      apply disjoint_singleton_r, not_elem_of_dom_2; done. }
+    assert (k ∈ dom m1) as (v1 & Hm1)%elem_of_dom by set_solver.
+    iMod (resource_map_update with "Hm Hk") as (?? (? & ? & Hmk)) "(Hm & Hk)"; first done.
+    iCombine "Hk Hrest" as "Hm1".
+    rewrite -(big_sepM_insert_delete (λ k v, k ↪[γ]{#sh} v))%I insert_id //; iFrame.
+    rewrite -{2}(insert_delete _ _ _ Hm1) map_imap_insert.
+    rewrite lookup_union map_lookup_imap lookup_delete left_id in Hmk.
+    inversion Hmk as [?? Heq Hk|]; subst; rewrite -Hk.
+    destruct x; last done.
+    destruct Heq; subst.
+    iIntros "!>"; iStopProof; apply bi.equiv_entails_1_1.
+    unseal; f_equiv; f_equiv.
+    rewrite insert_union_l; f_equiv; f_equiv; done.
+  Qed.
+
+  Definition elem_of_agree {A} (x : agree A) : { a | a ∈ agree_car x}.
+  Proof. destruct x as [[|a ?] ?]; [done | exists a; apply elem_of_cons; auto]. Qed.
+
+  Theorem resource_map_set γ σ (Hvalid : ✓ σ) :
+    resource_map_auth γ 1 ∅ ⊢ |==> resource_map_auth γ 1 σ ∗
+    ([∗ map] l ↦ x ∈ σ, match x with
+                        | (YES dq _ v) => l ↪[γ]{dq} (proj1_sig (elem_of_agree v))
+                        | (NO (Share sh) _) => resource_map_elem_no γ l sh
+                        | _ => False
+                        end).
+  Proof.
+    unseal. iIntros "H".
+    iMod (own_update with "H") as "($ & ?)".
+    { apply auth_update_alloc.
+      intros ??; simpl.
+      eapply cmra_valid_validN in Hvalid.
+      destruct mz; simpl; last done.
+      rewrite left_id; intros _ <-; rewrite right_id //. }
+    rewrite -{1}(big_opM_singletons σ) big_opM_auth_frag.
+    iPoseProof (big_opM_own_1 with "[-]") as "?"; first done.
+    iApply big_sepM_mono; last done; intros ?? Hk.
+    specialize (Hvalid k); rewrite Hk in Hvalid.
+    destruct x.
+    - iIntros "H"; iExists rsh.
+      iApply (own_proper with "H").
+      f_equiv; eapply @singletonM_proper; first apply _.
+      split; first done.
+      destruct Hvalid as [_ Hvalid].
+      destruct (elem_of_agree v); simpl.
+      intros n.
+      specialize (Hvalid n); rewrite agree_validN_def in Hvalid.
+      split=> b /=; setoid_rewrite elem_of_list_singleton; eauto.
+    - destruct sh; try done.
+      iIntros "?"; iExists rsh; done.
+  Qed.
+
+End lemmas.
diff --git a/shared/share_alg.v b/shared/share_alg.v
new file mode 100644
index 0000000000..7cdf0dde7b
--- /dev/null
+++ b/shared/share_alg.v
@@ -0,0 +1,166 @@
+(* modified from iris.algebra.frac *)
+
+From iris.algebra Require Export cmra.
+From iris.algebra Require Import proofmode_classes.
+From iris.prelude Require Import options.
+
+(* parameterize by a type of shares with bot, top, readable and writable; axioms determined by need *)
+(* It should be possible to instantiate this with both tree shares and nonnegative fractions. *)
+Class ShareType share_type := { share_bot : share_type; share_top : share_type;
+  share_op : share_type -> share_type -> option share_type;
+  share_op_comm : Comm eq share_op;
+  share_op_assoc a b c d e : share_op a b = Some d -> share_op c d = Some e ->
+    exists f, share_op a c = Some f /\ share_op f b = Some e;
+  share_op_fail a b c d : share_op a b = Some d -> share_op c d = None <->
+    share_op c a = None \/ share_op c b = None;
+  share_op_bot a : share_op share_bot a = Some a;
+  share_op_cancel a b c d : share_op a b = Some d -> share_op a c = Some d -> b = c;
+  share_op_top a b : share_op a share_top = Some b -> b = share_top;
+  share_writable : share_type -> Prop;
+  share_readable : share_type -> Prop;
+  readable_dec a : {share_readable a} + {~share_readable a};
+  writable_mono a b c : share_writable a -> share_op a b = Some c -> share_writable c;
+  readable_mono a b c : share_readable a -> share_op a b = Some c -> share_readable c;
+  writable_readable a : share_writable a -> share_readable a;
+  writable_readable_conflict a b : share_writable a -> share_readable b -> share_op a b = None;
+  unreadable_bot : ~share_readable share_bot;
+  writable_top : share_writable share_top;
+  join_unreadable a b c : share_op a b = Some c -> ~share_readable a -> ~share_readable b -> ~share_readable c }.
+
+(*Global Instance share_eq_dec : EqDecision share.
+Proof. intros ??. by destruct (eq_dec x y); [left | right]. Defined.*)
+
+Inductive share_car `{ShareType} :=
+| Share (sh : share_type)
+| ShareBot.
+
+Section share.
+
+  Context `{ST : ShareType}.
+
+  Lemma share_op_top' a b : share_op a share_top = Some b -> b = share_top /\ a = share_bot.
+  Proof.
+    intros.
+    pose proof (share_op_top _ _ H) as ->.
+    rewrite share_op_comm in H; eapply share_op_cancel in H as <-; last by rewrite share_op_comm; apply share_op_bot.
+    done.
+  Qed.
+
+  Lemma readable_top : share_readable share_top.
+  Proof. apply writable_readable, writable_top. Qed.
+
+Set Warnings "-redundant-canonical-projection".
+  Canonical Structure shareO := leibnizO share_car.
+Set Warnings "redundant-canonical-projection".
+
+  Global Instance share_car_inhabited : Inhabited share_car := populate ShareBot.
+(*  Global Instance share_car_eq_dec : EqDecision share_car.
+  Proof. solve_decision. Defined.*)
+
+  Local Instance share_valid_instance : Valid share_car := λ x, match x with Share _ => True | _ => False end.
+  Local Instance share_pcore_instance : PCore share_car := λ _, Some (Share share_bot).
+  Local Instance share_op_instance : Op share_car := λ a b, match a, b with
+    | Share a, Share b => match share_op a b with Some c => Share c | _ => ShareBot end
+    | _, _ => ShareBot
+    end.
+
+  Lemma share_op_eq : forall a b, a ⋅ b = match a, b with
+    | Share a, Share b => match share_op a b with Some c => Share c | _ => ShareBot end
+    | _, _ => ShareBot
+    end.
+  Proof. reflexivity. Qed.
+
+  Lemma share_op_join : forall a b z, a ⋅ b = Share z <-> exists x y, a = Share x /\ b = Share y /\ share_op x y = Some z.
+  Proof.
+    intros; rewrite share_op_eq; split.
+    - destruct a, b; try done.
+      destruct (share_op _ _) eqn: ?; try done.
+      inversion 1; subst.
+      by repeat eexists.
+    - intros (? & ? & ? & ? & H); subst.
+      rewrite H //.
+  Qed.
+
+  Lemma share_valid2_joins : forall a b, valid (a ⋅ b) <-> exists x y z, a = Share x /\ b = Share y /\ a ⋅ b = Share z /\ share_op x y = Some z.
+  Proof.
+    split.
+    - destruct (a ⋅ b) eqn: J; last done.
+      eapply share_op_join in J as (? & ? & ? & ? & ?); subst.
+      repeat (eexists; eauto).
+    - intros (? & ? & ? & ? & ? & Heq & J); subst.
+      rewrite Heq //.
+  Qed.
+
+  Lemma share_op_equiv : forall x y z, x ⋅ y = z <->
+    match z with Share c => exists a b, x = Share a /\ y = Share b /\ share_op a b = Some c
+    | ShareBot => match x, y with
+              | Share a, Share b => share_op a b = None
+              | _, _ => True
+              end
+    end.
+  Proof.
+    intros; destruct z; first by apply share_op_join.
+    rewrite share_op_eq.
+    destruct x, y; try done.
+    destruct (share_op _ _); done.
+  Qed.
+
+  Definition share_ra_mixin : RAMixin share_car.
+  Proof.
+    apply ra_total_mixin; try apply _; try done.
+    - intros [x|] [y|] [z|]; try done; rewrite !share_op_eq; last by destruct (share_op _ _).
+      destruct (share_op y z) eqn: Hyz, (share_op x _) eqn: Hx; try done.
+      * eapply share_op_assoc in Hx as (? & Hxy & Hz); last done.
+        rewrite share_op_comm in Hxy; rewrite Hxy Hz //.
+      * destruct (share_op x y) eqn: Hxy; try done.
+        eapply share_op_fail in Hx as [? | ?]; try done.
+        { congruence. }
+        rewrite share_op_comm.
+        unshelve erewrite (proj2 (share_op_fail _ _ _ _ Hxy)); first done.
+        rewrite share_op_comm; auto.
+      * destruct (share_op s z) eqn: Hz; try done.
+        rewrite share_op_comm in Hz; rewrite share_op_comm in Hx.
+        eapply share_op_assoc in Hz as (? & ? & ?); last done; congruence.
+    - intros [x|] [y|]; try done.
+      rewrite !share_op_eq share_op_comm //.
+    - intros [|]; try done.
+      rewrite leibniz_equiv_iff share_op_join.
+      repeat eexists.
+      apply share_op_bot.
+    - intros; exists (Share share_bot).
+      symmetry; rewrite leibniz_equiv_iff share_op_join.
+      repeat eexists.
+      apply share_op_bot.
+    - intros ?? (? & ? & ? & -> & -> & ? & ?)%share_valid2_joins; hnf; eauto.
+  Qed.
+  Canonical Structure shareR := discreteR share_car share_ra_mixin.
+
+  Global Instance share_cmra_total : CmraTotal shareR.
+  Proof. hnf; eauto. Qed.
+  Global Instance share_cmra_discrete : CmraDiscrete shareR.
+  Proof. apply discrete_cmra_discrete. Qed.
+  Global Instance share_cancelable (q : shareR) : Cancelable q.
+  Proof.
+    apply: discrete_cancelable.
+    intros p1 p2 Hv Heq.
+    destruct ((proj1 (share_valid2_joins _ _) Hv)) as (? & ? & ? & -> & -> & Hop & J).
+    rewrite Heq in Hop; apply share_op_join in Hop as (? & ? & [=] & -> & J'); subst.
+    eapply share_op_cancel in J; last done; by subst.
+  Qed.
+
+  Local Instance share_unit_instance : Unit share_car := Share share_bot.
+
+  Definition share_ucmra_mixin : UcmraMixin share_car.
+  Proof.
+    split; try done.
+    intros [|]; last done.
+    rewrite leibniz_equiv_iff share_op_join.
+    repeat eexists.
+    apply share_op_bot.
+  Qed.
+  Canonical Structure shareUR := Ucmra share_car share_ucmra_mixin.
+
+  Lemma share_core_unit (x : shareO) : core x = ε.
+  Proof. done. Qed.
+
+End share.
diff --git a/shared/shared.v b/shared/shared.v
new file mode 100644
index 0000000000..a28460e48e
--- /dev/null
+++ b/shared/shared.v
@@ -0,0 +1,890 @@
+(* An algebra of share-annotated values, where shares may be readable or unreadable,
+   but unreadable shares don't give access to the value. *)
+
+From iris.algebra Require Export agree.
+From iris.algebra Require Import updates local_updates proofmode_classes big_op.
+Set Warnings "-notation-overridden,-hiding-delimiting-key".
+From VST.shared Require Export share_alg dshare.
+From iris_ora.algebra Require Export ora agree.
+Set Warnings "notation-overridden,hiding-delimiting-key".
+From iris.prelude Require Import options.
+
+Section shared.
+
+Context `{ST : ShareType}.
+
+Definition readable_share' (s : shareO) := match s with Share sh => share_readable sh | _ => False end.
+
+Definition readable_dfrac_dec dq : { readable_dfrac dq } + { ¬readable_dfrac dq }.
+destruct dq; simpl.
+- destruct s; last by right; intros [].
+  apply readable_dec.
+- destruct s; last by right; intros [].
+  by left.
+Defined.
+
+Context (V : ofe).
+
+Inductive shared :=
+| YES (dq : dfrac) (rsh : readable_dfrac dq) (v : agree V)
+| NO (sh : shareO) (rsh : ¬readable_share' sh).
+
+Definition dfrac_of (s : shared) := match s with
+| YES dq _ _ => dq
+| NO sh _ => DfracOwn sh
+end.
+
+Local Instance shared_dist : Dist shared := λ n x y,
+  match x, y with
+  | YES dqx _ vx, YES dqy _ vy => dqx = dqy ∧ vx ≡{n}≡ vy
+  | NO shx _, NO shy _ => shx = shy
+  | _, _ => False
+  end.
+Local Instance shared_equiv : Equiv shared := λ x y,
+  match x, y with
+  | YES dqx _ vx, YES dqy _ vy => dqx = dqy ∧ vx ≡ vy
+  | NO shx _, NO shy _ => shx = shy
+  | _, _ => False
+  end.
+
+Definition shared_ofe_mixin : OfeMixin shared.
+Proof.
+  split.
+  - destruct x, y; intuition; try split; try pose proof (H 0) as H'; try destruct H; try destruct H'; try done.
+    + intros n; specialize (H n); destruct H; done.
+    + apply O.
+  - intros n; split; rewrite /dist /shared_dist.
+    + intros x; destruct x; done.
+    + intros [|] [|]; try done.
+      by intros [-> ->].
+    + intros [|] [|] [|]; try done.
+      * by intros [-> ->].
+      * by intros ->.
+  - intros ?? [|] [|]; try done.
+    intros [??]; split; first done.
+    eapply dist_lt; eauto.
+Qed.
+Canonical Structure sharedO := Ofe shared shared_ofe_mixin.
+
+Global Instance YES_ne dq rsh : NonExpansive (YES dq rsh).
+Proof. done. Qed.
+
+Global Instance YES_proper dq rsh : Proper (equiv ==> equiv) (YES dq rsh).
+Proof. done. Qed.
+
+Lemma YES_irrel dq rsh1 rsh2 v : YES dq rsh1 v ≡ YES dq rsh2 v.
+Proof. done. Qed.
+
+(* CMRA *)
+
+Local Instance shared_validN_instance : ValidN shared := λ n x,
+  match x with
+  | YES dq _ v => ✓ dq ∧ ✓{n} v
+  | NO sh _ => ✓ sh
+  end.
+Local Instance shared_valid_instance : Valid shared := λ x,
+  match x with
+  | YES dq _ v => ✓ dq ∧ ✓ v
+  | NO sh _ => ✓ sh
+  end.
+
+Local Instance shared_unit_instance : Unit shared := NO ε unreadable_bot.
+
+Local Definition err := NO ShareBot id.
+
+Lemma op_unreadable_shares : forall sh1 sh2, ~readable_share' sh1 -> ~readable_share' sh2 -> ~readable_share' (sh1 ⋅ sh2).
+Proof.
+  intros.
+  intros X.
+  destruct (sh1 ⋅ sh2) eqn: Hop; last done.
+  apply share_op_join in Hop as (? & ? & -> & -> & J).
+  eapply join_unreadable; eauto.
+Qed.
+
+Local Instance shared_op_instance : Op shared := λ x y,
+  match x, y with
+  | YES dqx _ vx, YES dqy _ vy =>
+      match readable_dfrac_dec (dqx ⋅ dqy) with
+      | left rsh => YES (dqx ⋅ dqy) rsh (vx ⋅ vy)
+      | right _ => err
+      end
+  | YES dq _ v, NO sh _ | NO sh _, YES dq _ v =>
+      match readable_dfrac_dec (dq ⋅ DfracOwn sh) with
+      | left rsh => YES (dq ⋅ DfracOwn sh) rsh v
+      | right _ => err
+      end
+  | NO shx rshx, NO shy rshy => NO (shx ⋅ shy) (op_unreadable_shares _ _ rshx rshy)
+  end.
+
+Definition dfrac_error df := match df with DfracOwn ShareBot | DfracBoth ShareBot => true | _ => false end.
+
+Lemma share_op_readable' : forall sh1 sh2, readable_share' sh1 \/ readable_share' sh2 -> ✓(sh1 ⋅ sh2) -> readable_share' (sh1 ⋅ sh2).
+Proof.
+  intros ??? (? & ? & ? & -> & -> & Hop & J)%share_valid2_joins.
+  rewrite Hop; destruct H; eapply readable_mono; eauto; rewrite share_op_comm //.
+Qed.
+
+Lemma share_op_readable : forall sh1 sh2, readable_share' sh1 \/ readable_share' sh2 -> ~readable_share' (sh1 ⋅ sh2) -> sh1 ⋅ sh2 = ShareBot.
+Proof.
+  intros.
+  destruct (sh1 ⋅ sh2) eqn: Hop; last done.
+  contradiction H0; rewrite -Hop; apply share_op_readable'; auto.
+  rewrite Hop //.
+Qed.
+
+Lemma dfrac_op_readable' : forall d1 d2, readable_dfrac d1 \/ readable_dfrac d2 -> ✓(d1 ⋅ d2) -> readable_dfrac (d1 ⋅ d2).
+Proof.
+  intros ??? Hvalid.
+  destruct d1, d2; simpl in *; try by destruct Hvalid as (? & -> & ?).
+  apply share_op_readable'; auto.
+Qed.
+
+Lemma dfrac_op_readable : forall d1 d2, readable_dfrac d1 \/ readable_dfrac d2 -> ~readable_dfrac (d1 ⋅ d2) -> dfrac_error (d1 ⋅ d2) = true.
+Proof.
+  destruct d1 as [[|]|[|]], d2 as [[|]|[|]]; simpl; try done; destruct (_ ⋅ _) eqn: Hop; try done.
+  intros H ?; apply (share_op_readable (Share _) (Share _)) in H.
+  - rewrite H // in Hop.
+  - rewrite Hop //.
+Qed.
+
+Lemma op_dfrac_error : forall d1 d2, dfrac_error d2 = true -> dfrac_error (d1 ⋅ d2) = true.
+Proof.
+  destruct d1 as [[|]|[|]], d2 as [[|]|[|]]; done.
+Qed.
+
+Lemma dfrac_error_unreadable : forall d, dfrac_error d = true -> ~readable_dfrac d.
+Proof.
+  destruct d as [[|]|[|]]; try done; simpl; tauto.
+Qed.
+
+Definition val_of s := match s with YES _ _ v => Some v | _ => None end.
+
+Lemma shared_validN : forall n x, ✓{n} x ↔ ✓ dfrac_of x ∧ ✓{n} val_of x.
+Proof.
+  intros ? [|]; try done.
+  by intuition.
+Qed.
+
+Lemma shared_valid : forall x, ✓ x ↔ ✓ dfrac_of x ∧ ✓ val_of x.
+Proof.
+  intros [|]; try done.
+  by intuition.
+Qed.
+
+Lemma dfrac_error_invalid : forall d, dfrac_error d = true -> ~ ✓ d.
+Proof.
+  destruct d as [[|]|[|]]; try done; simpl; intros ? Hv; try done.
+  by destruct Hv as (? & ? & ?).
+Qed.
+
+Lemma YES_op' : forall dq1 dq2 rsh1 rsh2 v1 v2, YES dq1 rsh1 v1 ⋅ YES dq2 rsh2 v2 =
+  match readable_dfrac_dec (dq1 ⋅ dq2) with
+      | left rsh => YES (dq1 ⋅ dq2) rsh (v1 ⋅ v2)
+      | right _ => err
+      end.
+Proof. done. Qed.
+
+Lemma YES_op : forall dq1 dq2 rsh1 rsh2 rsh v1 v2, YES dq1 rsh1 v1 ⋅ YES dq2 rsh2 v2 ≡ YES (dq1 ⋅ dq2) rsh (v1 ⋅ v2).
+Proof.
+  intros; rewrite YES_op'.
+  by destruct (readable_dfrac_dec _).
+Qed.
+
+Lemma NO_YES_op' : forall sh1 dq2 rsh1 rsh2 v2, NO sh1 rsh1 ⋅ YES dq2 rsh2 v2 =
+  match readable_dfrac_dec (DfracOwn sh1 ⋅ dq2) with
+      | left rsh => YES (DfracOwn sh1 ⋅ dq2) rsh v2
+      | right _ => err
+      end.
+Proof.
+  intros. rewrite {1}/op /shared_op_instance.
+  rewrite (comm _ dq2) //.
+Qed.
+
+Lemma NO_YES_op : forall sh1 dq2 rsh1 rsh2 rsh v2, NO sh1 rsh1 ⋅ YES dq2 rsh2 v2 ≡ YES (DfracOwn sh1 ⋅ dq2) rsh v2.
+Proof.
+  intros; rewrite NO_YES_op'.
+  by destruct (readable_dfrac_dec _).
+Qed.
+
+Lemma shared_op_alt : forall x y, match readable_dfrac_dec (dfrac_of x ⋅ dfrac_of y) with
+  | left rsh => exists v, val_of x ⋅ val_of y = Some v /\ x ⋅ y = YES (dfrac_of x ⋅ dfrac_of y) rsh v
+  | right rsh => if dfrac_error (dfrac_of x ⋅ dfrac_of y) then x ⋅ y ≡ err
+      else exists shx shy rshx rshy, x = NO shx rshx /\ y = NO shy rshy /\ x ⋅ y = NO (shx ⋅ shy) (op_unreadable_shares _ _ rshx rshy) /\ ✓ (shx ⋅ shy)
+  end.
+Proof.
+  intros [|] [|]; rewrite /op /shared_op_instance.
+  - destruct (readable_dfrac_dec _); eauto.
+    apply dfrac_op_readable in n; auto.
+    rewrite n //.
+  - destruct (readable_dfrac_dec _); eauto.
+    apply dfrac_op_readable in n; auto.
+    rewrite n //.
+  - rewrite comm; destruct (readable_dfrac_dec _); eauto.
+    apply dfrac_op_readable in n; auto.
+    rewrite n //.
+  - destruct (readable_dfrac_dec _).
+    { exfalso; eapply op_unreadable_shares, r; auto. }
+    destruct (dfrac_error _) eqn: Herr.
+    { hnf; simpl in Herr.
+      destruct (_ ⋅ _); done. }
+    eexists _, _, _, _; repeat (split; first done).
+    simpl in Herr.
+    destruct (_ ⋅ _) eqn: Hop; try done.
+    setoid_rewrite Hop; done.
+Qed.
+
+Lemma dfrac_of_op' : forall x y, dfrac_of (x ⋅ y) = if dfrac_error (dfrac_of x ⋅ dfrac_of y) then DfracOwn ShareBot else dfrac_of x ⋅ dfrac_of y.
+Proof.
+  intros; pose proof (shared_op_alt x y) as Hop.
+  destruct (readable_dfrac_dec _).
+  - destruct Hop as (? & ? & ->).
+    destruct (dfrac_error _) eqn: Herr; last done.
+    exfalso; eapply dfrac_error_unreadable; eauto.
+  - destruct (dfrac_error _); first by destruct (x ⋅ y); inversion Hop; subst.
+    destruct Hop as (? & ? & ? & ? & -> & -> & -> & ?); done.
+Qed.
+
+Lemma dfrac_of_op : forall x y, (dfrac_error (dfrac_of x ⋅ dfrac_of y) = true ∧ dfrac_of (x ⋅ y) = DfracOwn ShareBot) ∨ (dfrac_of (x ⋅ y) = dfrac_of x ⋅ dfrac_of y).
+Proof.
+  intros.
+  rewrite dfrac_of_op'.
+  destruct (dfrac_error _); auto.
+Qed.
+
+Lemma shared_dist_implies : forall n x y, x ≡{n}≡ y -> dfrac_of x = dfrac_of y ∧ val_of x ≡{n}≡ val_of y.
+Proof.
+  intros ? [|] [|]; inversion 1; subst; try done.
+  by split; last constructor.
+Qed.
+
+Lemma shared_dist' : forall n x y, x ≡{n}≡ y <-> dfrac_of x = dfrac_of y ∧ val_of x ≡{n}≡ val_of y.
+Proof.
+  split; first apply shared_dist_implies.
+  destruct x, y; simpl; intros [[=] Hv]; subst; try done.
+  by apply Some_dist_inj in Hv.
+Qed.
+
+Lemma shared_includedN : forall n x y, x ≼{n} y -> y ≡ err ∨ (dfrac_of x ≼{n} dfrac_of y ∧ val_of x ≼{n} val_of y).
+Proof.
+  intros ??? [z H].
+  pose proof (shared_op_alt x z) as Hop.
+  destruct (readable_dfrac_dec _); [|destruct (dfrac_error _)].
+  - destruct Hop as (? & Hval & Heq); rewrite Heq in H.
+    destruct y; try done.
+    destruct H as [-> Hv]; right; split.
+    + by eexists.
+    + rewrite /= Hv -Hval; by eexists.
+  - rewrite Hop in H; destruct y; inversion H; subst; auto.
+  - destruct Hop as (? & ? & ? & ? & -> & -> & Heq & ?).
+    destruct y; inversion H; subst.
+    right; split; auto.
+    by eexists (DfracOwn _).
+Qed.
+
+Lemma shared_included : forall x y, x ≼ y -> y ≡ err ∨ (dfrac_of x ≼ dfrac_of y ∧ val_of x ≼ val_of y).
+Proof.
+  intros ?? [z H].
+  pose proof (shared_op_alt x z) as Hop.
+  destruct (readable_dfrac_dec _); [|destruct (dfrac_error _)].
+  - destruct Hop as (? & Hval & Heq); rewrite Heq in H.
+    destruct y; try done.
+    destruct H as [-> Hv]; right; split.
+    + by eexists.
+    + rewrite /= Hv -Hval; by eexists.
+  - rewrite Hop in H; destruct y; inversion H; subst; auto.
+  - destruct Hop as (? & ? & ? & ? & -> & -> & Heq & ?).
+    destruct y; inversion H; subst.
+    right; split; auto.
+    by eexists (DfracOwn _).
+Qed.
+
+Local Instance shared_err_absorb rsh : LeftAbsorb equiv (NO ShareBot rsh) op.
+Proof.
+  intros x.
+  rewrite /op /shared_op_instance /=.
+  destruct x; try done.
+  destruct (readable_dfrac_dec _); try done.
+  destruct dq as [[|]|[|]]; done.
+Qed.
+
+Lemma YES_incl_NO : forall n dq rsh v sh nsh, YES dq rsh v ≼{n} NO sh nsh -> sh = ShareBot.
+Proof.
+  intros; apply shared_includedN in H as [H | [_ H]]; first by inversion H; subst.
+  apply option_includedN in H as [? | (? & ? & ? & ? & ?)]; done.
+Qed.
+
+Lemma YES_incl_YES : forall n dq1 rsh1 v1 dq2 rsh2 v2, YES dq1 rsh1 v1 ≼{n} YES dq2 rsh2 v2 ->
+  dq1 ≼ dq2 ∧ v1 ≼{n} v2.
+Proof.
+  intros; apply shared_includedN in H as [H | [??]]; try done.
+  rewrite -Some_includedN_total //.
+Qed.
+
+Lemma val_of_op' : forall x y, val_of (x ⋅ y) = if dfrac_error (dfrac_of x ⋅ dfrac_of y) then None else val_of x ⋅ val_of y.
+Proof.
+  intros.
+  pose proof (shared_op_alt x y) as Hop.
+  destruct (readable_dfrac_dec _).
+  - destruct Hop as (? & -> & ->).
+    destruct (dfrac_error _) eqn: Herr; last done.
+    exfalso; eapply dfrac_error_unreadable, r; auto.
+  - destruct (dfrac_error _) eqn: Herr; first by destruct (x ⋅ y); inversion Hop; subst.
+    by destruct Hop as (? & ? & ? & ? & -> & -> & -> & ?).
+Qed.
+
+Lemma val_of_op : forall x y, dfrac_error (dfrac_of x ⋅ dfrac_of y) = false -> val_of (x ⋅ y) = val_of x ⋅ val_of y.
+Proof.
+  intros.
+  rewrite val_of_op' H //.
+Qed.
+
+Lemma dfrac_error_op : forall x y, dfrac_error (dfrac_of x ⋅ dfrac_of y) = dfrac_error (dfrac_of (x ⋅ y)).
+Proof.
+  intros.
+  pose proof (shared_op_alt x y) as Hop.
+  destruct (readable_dfrac_dec _).
+  - by destruct Hop as (? & ? & ->).
+  - destruct (dfrac_error _) eqn: Herr.
+    + hnf in Hop.
+      destruct (x ⋅ y); try done; simpl in *.
+      by subst.
+    + by destruct Hop as (? & ? & ? & ? & -> & -> & -> & ?).
+Qed.
+
+Local Instance shared_pcore_instance : PCore shared := λ x,
+  Some (match x with
+  | YES (DfracBoth _) rsh v => YES DfracDiscarded I v
+  | NO sh _ => match sh with ShareBot => err | _ => ε end
+  | _ => ε
+  end).
+
+(*Lemma pcore_YES : forall dq rsh v cx, pcore (YES dq rsh v) = Some cx ↔
+  pcore dq = Some DfracDiscarded /\ cx = YES DfracDiscarded I v.
+Proof.
+  intros; destruct dq; intuition; subst; try done; try by inversion H; subst.
+Qed.
+
+Lemma pcore_NO : forall sh rsh cx, pcore (NO sh rsh) = Some cx ↔
+  sh = Share.bot /\ cx = NO sh rsh.
+Proof.
+  rewrite /pcore /shared_pcore_instance.
+  intuition; subst; try by (if_tac in H; inversion H; subst).
+  apply eq_dec_refl.
+Qed.*)
+
+Lemma dfrac_error_assoc : forall x y z, dfrac_error (dfrac_of (x ⋅ y) ⋅ dfrac_of z) = dfrac_error (dfrac_of x ⋅ dfrac_of (y ⋅ z)).
+Proof.
+  intros.
+  destruct (dfrac_of_op x y) as [[??] | ->], (dfrac_of_op y z) as [[??] | ->].
+  - rewrite (comm _ _ (dfrac_of z)) op_dfrac_error; last by rewrite -dfrac_error_op.
+    rewrite op_dfrac_error //; last by rewrite -dfrac_error_op.
+  - rewrite assoc !(comm _ _ (dfrac_of z)) op_dfrac_error; last by rewrite -dfrac_error_op.
+    rewrite op_dfrac_error //.
+  - rewrite -assoc op_dfrac_error; last done.
+    rewrite op_dfrac_error //; last by rewrite -dfrac_error_op.
+  - rewrite assoc //.
+Qed.
+
+Global Instance NO_discrete sh rsh : Discrete (NO sh rsh).
+Proof. intros [|] ?; done. Qed.
+
+Lemma dfrac_error_discarded : forall x, dfrac_error (DfracDiscarded ⋅ x) = dfrac_error x.
+Proof.
+  destruct x; simpl; rewrite left_id //.
+Qed.
+
+Lemma share_op_None : forall (s : shareO), s ⋅ ShareBot = ShareBot.
+Proof.
+  by destruct s.
+Qed.
+
+Local Instance shared_unit_left_id : LeftId equiv (ε : shared) op.
+Proof.
+  intros [|]; rewrite /op /=.
+  - rewrite right_id.
+    destruct (readable_dfrac_dec _); done.
+  - hnf; rewrite left_id //.
+Qed.
+
+Definition shared_cmra_mixin : CmraMixin shared.
+Proof.
+  apply cmra_total_mixin; try done.
+  - intros [|] ? [|] [|]; try done.
+    + intros [-> H]; hnf.
+      rewrite /op /shared_op_instance.
+      destruct (readable_dfrac_dec _); rewrite ?H //.
+    + intros H; hnf in H; subst; done.
+    + intros [-> H]; hnf.
+      rewrite /op /shared_op_instance.
+      destruct (readable_dfrac_dec _); rewrite ?H //.
+    + intros H; hnf in H; subst; done.
+  - intros ? [|] [|]; try done.
+    + intros [<- ?]; destruct dq; done.
+    + intros [=]; subst.
+      destruct sh0; done.
+  - intros n [|] [|]; try done.
+    + intros [-> H] [??]; split; by rewrite -?H.
+    + intros H; hnf in H; subst; done.
+  - intros [|]; intuition.
+    + by destruct H.
+    + split; apply cmra_valid_validN, H.
+    + apply (H 0).
+  - intros ? [|]; try done.
+    intros [??]; split; last apply cmra_validN_S; done.
+  - intros ???.
+    pose proof (shared_op_alt x (y ⋅ z)) as Hop1.
+    pose proof (shared_op_alt (x ⋅ y) z) as Hop2.
+    destruct (readable_dfrac_dec _); [|destruct (dfrac_error _) eqn: Herr].
+    + destruct Hop1 as (v1 & Hval1 & ->).
+      assert (dfrac_error (dfrac_of y ⋅ dfrac_of z) = false) as Hyz.
+      { rewrite dfrac_error_op.
+        destruct (dfrac_error (dfrac_of (y ⋅ z))) eqn: Herr; try done.
+        exfalso; eapply dfrac_error_unreadable, r; apply op_dfrac_error; done. }
+      destruct (dfrac_of_op y z) as [[??] | Hyz']; first congruence.
+      assert (dfrac_error (dfrac_of x ⋅ dfrac_of y) = false) as Hxy.
+      { rewrite Hyz' assoc in r.
+        destruct (dfrac_error (dfrac_of x ⋅ dfrac_of y)) eqn: Herr; try done.
+        exfalso; eapply dfrac_error_unreadable, r; rewrite (comm _ _ (dfrac_of z)); apply op_dfrac_error; done. }
+      destruct (dfrac_of_op x y) as [[??] | Hxy']; first congruence.
+      assert (dfrac_of x ⋅ dfrac_of (y ⋅ z) = (dfrac_of (x ⋅ y) ⋅ dfrac_of z)) as Heq.
+      { rewrite Hxy' Hyz' assoc //. }
+      destruct (readable_dfrac_dec _); [|exfalso; rewrite Heq // in r].
+      destruct Hop2 as (v2 & Hval2 & ->).
+      rewrite !val_of_op in Hval1 Hval2; try done.
+      split.
+      * rewrite Hxy' Hyz' assoc //.
+      * assert (Some v1 ≡ Some v2) as Hv by (rewrite -Hval1 -Hval2 assoc //).
+        by inversion Hv; subst.
+    + rewrite Hop1.
+      rewrite -dfrac_error_assoc in Herr.
+      destruct (readable_dfrac_dec _).
+      { exfalso; eapply dfrac_error_unreadable; eauto. }
+      rewrite Herr in Hop2; rewrite Hop2 //.
+    + destruct Hop1 as (? & shyz & ? & ? & -> & Hyz & Hxyz & ?).
+      pose proof (shared_op_alt y z) as Hop3; rewrite Hyz in Hop3.
+      destruct (readable_dfrac_dec (dfrac_of y ⋅ dfrac_of z)); first by destruct Hop3 as (? & ? & ?).
+      rewrite dfrac_error_op Hyz /= in Hop3.
+      destruct shyz; last by rewrite share_op_None in H; destruct H.
+      destruct Hop3 as (? & ? & ? & ? & -> & -> & [=] & ?); simpl in *; subst.
+      rewrite /op /shared_op_instance; hnf.
+      apply (@cmra_assoc shareR).
+  - intros ??.
+    pose proof (shared_op_alt x y) as Hop1.
+    pose proof (shared_op_alt y x) as Hop2.
+    rewrite comm in Hop2.
+    destruct (readable_dfrac_dec _).
+    + destruct Hop1 as (v1 & Hval1 & ->), Hop2 as (v2 & Hval2 & ->).
+      split; auto.
+      assert (Some v1 ≡ Some v2) as Hv by (rewrite -Hval1 -Hval2 comm //).
+      by inversion Hv; subst.
+    + destruct (dfrac_error _) eqn: Herr; first by rewrite Hop1 Hop2.
+      destruct Hop1 as (? & ? & ? & ? & -> & -> & -> & ?), Hop2 as (? & ? & ? & ? & [=] & [=] & -> & ?); subst.
+      hnf; by rewrite (@cmra_comm shareR).
+  - intros [|].
+    + rewrite /op /shared_op_instance /core /pcore /shared_pcore_instance /=.
+      destruct dq.
+      * rewrite /ε /shared_unit_instance right_id.
+        destruct (readable_dfrac_dec _); done.
+      * rewrite comm dfrac_op_both_discarded.
+        destruct (readable_dfrac_dec _); try done.
+        split; first done.
+        apply agree_idemp.
+    + destruct sh; try done; simpl.
+      rewrite left_id //.
+  - intros [|].
+    + destruct dq; done.
+    + destruct sh; done.
+  - intros ?? (z & H).
+    pose proof (shared_op_alt x z) as Hop.
+    rewrite /core /=; destruct x.
+    + destruct dq; first by eexists; rewrite left_id.
+      simpl in Hop.
+      destruct (readable_dfrac_dec _).
+      * destruct Hop as (? & Hval & Hop).
+        rewrite Hop in H; destruct y; try done.
+        destruct H as [-> H].
+        destruct (_ ⋅ _) eqn: Hz.
+        { destruct z as [[|]|]; done. }
+        exists (YES DfracDiscarded I v0).
+        unshelve rewrite YES_op /=; last split; rewrite ?dfrac_op_both_discarded //.
+        rewrite -agree_included H -Some_included_total -Hval; eexists; done.
+      * destruct (dfrac_error _) eqn: Herr; last by destruct Hop as (? & ? & ? & ? & ? & ?).
+        rewrite Hop in H; destruct y; inversion H; subst.
+        exists err; done.
+    + destruct sh; first by eexists; rewrite left_id.
+      destruct (readable_dfrac_dec _).
+      { exfalso; clear Hop; destruct (dfrac_of z); done. }
+      destruct (dfrac_error _) eqn: Herr.
+      * rewrite Hop in H; destruct y; inversion H; subst.
+        exists err; done.
+      * by destruct (dfrac_of z).
+  - intros.
+    destruct x; hnf.
+    + rewrite /op /shared_op_instance in H.
+      destruct y.
+      * destruct (readable_dfrac_dec _); last by destruct H.
+        destruct H; split; [eapply cmra_valid_op_l | eapply cmra_validN_op_l]; eauto.
+      * destruct (readable_dfrac_dec _); last by destruct H.
+        destruct H; split; auto; eapply cmra_valid_op_l; eauto.
+    + destruct sh; eauto.
+      rewrite /op /shared_op_instance in H.
+      destruct y; try done.
+      destruct (readable_dfrac_dec _); last by destruct H.
+      destruct dq as [[|]|[|]]; done.
+  - intros ????? Hop.
+    assert (y1 ⋅ y2 ≠ err) as Hfail.
+    { intros X; rewrite X in Hop; destruct x; inversion Hop; subst; done. }
+    rewrite /op /shared_op_instance in Hop Hfail.
+    destruct y1, y2.
+    + destruct (readable_dfrac_dec _); try done.
+      destruct x; try done.
+      destruct Hop as [Hd Hv].
+      destruct H; subst.
+      apply cmra_extend in Hv as (vz1 & vz2 & ? & ? & ?); last done.
+      exists (YES dq rsh vz1), (YES dq0 rsh0 vz2); repeat (split; try done).
+      rewrite {2}/op /shared_op_instance.
+      destruct (readable_dfrac_dec _); done.
+    + destruct (readable_dfrac_dec _); try done.
+      destruct x; try done.
+      destruct Hop as [-> ?].
+      eexists (YES dq rsh v0), _; split; last done.
+      rewrite {2}/op /shared_op_instance.
+      destruct (readable_dfrac_dec _); done.
+    + destruct (readable_dfrac_dec _); try done.
+      destruct x; try done.
+      destruct Hop as [-> ?].
+      eexists _, (YES dq rsh0 v0); split; last done.
+      rewrite {2}/op /shared_op_instance.
+      destruct (readable_dfrac_dec _); done.
+    + eexists _, _; split; last done.
+      symmetry; rewrite discrete_iff //.
+Qed.
+Canonical Structure sharedC : cmra := Cmra shared shared_cmra_mixin.
+
+Definition shared_ucmra_mixin : UcmraMixin shared.
+Proof.
+  split; try done; apply _.
+Qed.
+Canonical Structure sharedUC : ucmra := Ucmra shared shared_ucmra_mixin.
+
+(* updates *)
+Lemma writable_update : forall sh rsh v v', share_writable sh -> ✓ v' ->
+  YES (DfracOwn (Share sh)) rsh v ~~> YES (DfracOwn (Share sh)) rsh v'.
+Proof.
+  intros; intros ? [|] Hvalid; simpl in *; last by destruct Hvalid.
+  pose proof (shared_op_alt (YES (DfracOwn (Share sh)) rsh v) c) as Hop.
+  pose proof (shared_op_alt (YES (DfracOwn (Share sh)) rsh v') c) as Hop'.
+  repeat destruct (readable_dfrac_dec _); try done.
+  - destruct Hop as (? & ? & Hop); rewrite Hop /= in Hvalid; destruct Hvalid as [Hsh Hv].
+    destruct c; try done.
+    { rewrite comm in Hsh; apply dfrac_valid_own_readable in Hsh as (? & [=] & ?); subst; done. }
+    destruct Hop' as (? & Hval & Hop'); rewrite Hop' /=.
+    split; try done.
+    rewrite -Some_validN -Hval /= Some_validN //.
+  - simpl in *; destruct (dfrac_error _); first by rewrite Hop in Hvalid; destruct Hvalid.
+    by destruct Hop as (? & ? & ? & ? & ? & ?).
+Qed.
+
+Lemma shared_includedN' : forall n x y, ✓{n} y -> dfrac_of x ≼{n} dfrac_of y ∧ val_of x ≼{n} val_of y -> x ≼{n} y.
+Proof.
+  intros ??? Hvalid [(d & Hd) (v & Hv)].
+  destruct (readable_dfrac_dec d).
+  - destruct y; simpl in *.
+    + exists (YES d r v0).
+      pose proof (shared_op_alt x (YES d r v0)).
+      rewrite -Hd in H; destruct (readable_dfrac_dec dq); last done.
+      destruct H as (? & Hv' & ->).
+      destruct x; inversion Hv'; subst; last done.
+      rewrite Some_op_opM in Hv; apply Some_dist_inj in Hv as ->.
+      rewrite -cmra_op_opM_assoc agree_idemp //.
+    + assert (dfrac_error (DfracOwn sh) = true).
+      { rewrite Hd; eapply dfrac_op_readable; auto.
+        rewrite -Hd //. }
+      destruct sh; done.
+  - destruct d as [sh | sh]; try done.
+    + exists (NO sh n0).
+      pose proof (shared_op_alt x (NO sh n0)).
+      rewrite -Hd in H.
+      destruct (readable_dfrac_dec (dfrac_of y)).
+      * destruct H as (? & Hv' & ->).
+        destruct y; try done.
+        split; first done.
+        apply shared_validN in Hvalid as [? Hvv].
+        simpl in *.
+        destruct x; inversion Hv'; subst.
+        symmetry; eapply agree_valid_includedN; try done.
+        rewrite -Some_includedN_total Hv /=.
+        by exists v.
+      * destruct y; try done; simpl in *.
+        destruct sh0; try done.
+        destruct H as (? & ? & ? & ? & -> & [=] & -> & ?); subst.
+        injection Hd; auto.
+    + destruct sh; try done.
+      apply shared_validN in Hvalid as [Hvalid _]; rewrite Hd in Hvalid.
+      apply cmra_valid_op_r in Hvalid as (? & ? & ?); done.
+Qed.
+
+Global Instance dfrac_of_ne n : Proper (dist n ==> eq) dfrac_of.
+Proof.
+  intros [|] [|]; inversion 1; subst; done.
+Qed.
+
+Global Instance YES_share_top_cancelable rsh v : Cancelable (YES (DfracOwn (Share share_top)) rsh v).
+Proof.
+  intros ??? (Hd & Hv)%shared_validN ?.
+  destruct (dfrac_of_op (YES (DfracOwn (Share share_top)) rsh v) y) as [(_ & Hop)|Hop]; rewrite Hop // in Hd.
+  pose proof (dfrac_full_exclusive _ Hd) as He.
+  destruct y; simpl in *; subst; first contradiction unreadable_bot.
+  inversion He; subst.
+  rewrite H in Hop.
+  apply (cancelable _ _ (dfrac_of z)) in Hd; first by destruct z; simpl in *; inversion Hd; subst.
+  rewrite -Hop dfrac_of_op' in Hd |- *.
+  destruct (dfrac_error _); done.
+Qed.
+
+Local Instance shared_orderN : OraOrderN shared := λ n x y, y ≡ err ∨ dfrac_of x ≼ₒ dfrac_of y ∧ val_of x ≼ₒ{n} val_of y.
+
+Local Instance shared_order : OraOrder shared := λ x y, y ≡ err ∨ dfrac_of x ≼ₒ dfrac_of y ∧ val_of x ≼ₒ val_of y.
+
+Lemma dfrac_error_fail : forall x y, dfrac_error (dfrac_of x ⋅ dfrac_of y) = true -> x ⋅ y ≡ err.
+Proof.
+  intros; pose proof (shared_op_alt x y) as Hop.
+  rewrite H in Hop.
+  destruct (readable_dfrac_dec _); try done.
+  exfalso; eapply dfrac_error_unreadable; eauto.
+Qed.
+
+Local Instance YES_discard_increasing rsh v : Increasing (YES DfracDiscarded rsh v).
+Proof.
+  intros ?; hnf; simpl; right.
+  destruct (dfrac_error (DfracDiscarded ⋅ dfrac_of y)) eqn: Herr.
+  - pose proof (dfrac_error_fail (YES DfracDiscarded rsh v) y Herr) as Hfail.
+    destruct (YES _ _ _ ⋅ _) eqn: Heq; inversion Hfail; subst.
+    rewrite dfrac_error_discarded in Herr.
+    destruct y; first by exfalso; eapply dfrac_error_unreadable; eauto.
+    simpl in Herr.
+    destruct sh; done.
+  - edestruct dfrac_of_op as [(Herr' & _) | ->]; first by rewrite Herr' // in Herr.
+    rewrite val_of_op // /= Some_op_opM.
+    split; [apply discard_increasing|].
+    destruct y; apply agree_increasing.
+Qed.
+
+Local Instance shared_err_increasing rsh : Increasing (NO ShareBot rsh).
+Proof.
+  intros ?; hnf; simpl; left.
+  apply shared_err_absorb.
+Qed.
+
+Local Instance shared_unit_increasing : Increasing ε.
+Proof.
+  intros ?; hnf.
+  rewrite dfrac_of_op' val_of_op'; simpl.
+  destruct (dfrac_error _) eqn: Herr; [left | right].
+  - by apply dfrac_error_fail.
+  - rewrite !left_id //.
+Qed.
+
+Lemma readable_dfrac_order : forall dq dq', dq ≼ₒ dq' -> readable_dfrac dq -> readable_dfrac dq'.
+Proof.
+  intros ?? [-> | <-]; try done.
+  destruct dq as [[|]|[|]]; try done; simpl; rewrite right_id //.
+Qed.
+
+Lemma dfrac_error_order : forall dq dq', dq ≼ₒ dq' -> dfrac_error dq = dfrac_error dq'.
+Proof.
+  intros ?? [-> | <-]; try done.
+  rewrite (comm _ dq) dfrac_error_discarded //.
+Qed.
+
+Lemma shared_orderN_op : ∀ (n : nat) (x x' y : shared), x ≼ₒ{n} x' → x ⋅ y ≼ₒ{n} x' ⋅ y.
+Proof.
+  intros.
+  destruct H as [H | [??]].
+  - destruct x'; inversion H; subst.
+    left; by rewrite shared_err_absorb.
+  - right.
+    rewrite !dfrac_of_op' !val_of_op'.
+    erewrite dfrac_error_order; last by apply ora_order_op.
+    destruct (dfrac_error _); last by split; [apply ora_order_op | apply ora_orderN_op].
+    split; hnf; auto.
+Qed.
+
+Definition shared_ora_mixin : OraMixin shared.
+Proof.
+  apply ora_total_mixin; try done.
+  - intros x; rewrite /core /=; destruct x.
+    + destruct dq; apply _.
+    + destruct sh; try apply _.
+      apply shared_err_increasing.
+  - intros ??? H Hord z.
+    destruct Hord as [Hno | [Hdy Hvy]].
+    { destruct y; inversion Hno; subst.
+      left; by rewrite shared_err_absorb. }
+    pose proof (H z) as Hxz.
+    pose proof (shared_op_alt x z) as Hop.
+    destruct (readable_dfrac_dec _); [|destruct (dfrac_error _) eqn: Herr].
+    + destruct Hop as (? & Hv1 & Hz); rewrite Hz in Hxz.
+      destruct Hxz as [? | [Hd Hv]]; first done; simpl in *.
+      pose proof (shared_op_alt y z) as Hop.
+      destruct (readable_dfrac_dec _); last by contradiction n0; eapply readable_dfrac_order, r; apply ora_order_op.
+      destruct Hop as (? & Hv2 & ->).
+      right; split.
+      * etrans; first done.
+        by eapply ora_order_op.
+      * rewrite /= -Hv2.
+        destruct (val_of y), (val_of z); try done; apply agree_increasing.
+    + left; apply dfrac_error_fail.
+      erewrite <- dfrac_error_order; first done.
+      by apply ora_order_op.
+    + destruct Hop as (? & shz & ? & rshz & -> & -> & Hno & Hvalid); simpl in *.
+      destruct Hxz as [Herr' | [Hd Hv]]; first by (rewrite Hno in Herr'; inversion Herr' as [Heq]; rewrite Heq in Hvalid; destruct Hvalid); simpl in *.
+      pose proof (shared_op_alt y (NO shz rshz)) as Hop.
+      destruct (readable_dfrac_dec _).
+      * destruct Hop as (? & Hv2 & ->).
+        right; simpl; split; last apply agree_increasing.
+        destruct Hdy as [<- | <-]; try done.
+        etrans; first done.
+        rewrite (comm _ _ DfracDiscarded) -assoc (comm _ DfracDiscarded); right; done.
+      * destruct (dfrac_error _) eqn: Herr'; first by left; rewrite Hop.
+        destruct Hop as (? & ? & ? & ? & -> & [=] & -> & Hvalid'); subst.
+        destruct Hd as [Hd | ?]; try done.
+        destruct Hdy as [Hdy | ?]; try done.
+        inversion Hdy; subst.
+        right; split; try done.
+        by left.
+  - intros ??? [H | [Hd Hv]].
+    { destruct y; inversion H; subst; left; done. }
+    rewrite /core /=; destruct x, y; try done; simpl in *.
+    + right; destruct Hd as [<- | <-], dq; rewrite ?dfrac_op_own_discarded ?dfrac_op_both_discarded // /=.
+      split.
+      * right; rewrite left_id //.
+      * apply agree_increasing.
+    + right; destruct Hd as [<- | <-]; try done.
+      rewrite dfrac_op_own_discarded.
+      destruct sh; split; try done.
+      right; rewrite left_id //.
+    + destruct Hd as [[=] | ?]; subst; try done.
+      destruct sh0; [right | left]; done.
+  - intros ???? Hvalid [? | [Hd Hv]].
+    { eexists _, _; split; first left; done. }
+    pose proof (shared_op_alt y1 y2) as Hop.
+    rewrite dfrac_of_op' in Hd; rewrite val_of_op' in Hv.
+    destruct (dfrac_error (dfrac_of y1 ⋅ dfrac_of y2)) eqn: Herr.
+    { destruct (readable_dfrac_dec _).
+      { exfalso; by eapply dfrac_error_unreadable, r. }
+      eexists _, _; split; last done.
+      destruct (y1 ⋅ y2); inversion Hop; subst; simpl in *.
+      by right. }
+    destruct (readable_dfrac_dec _).
+    + destruct Hop as (? & Hval & H).
+      apply shared_validN in Hvalid as [??].
+      apply ora_op_extend in Hv as (v1 & v2 & ? & Hv1 & Hv2); last done.
+      destruct y1, y2; try done; inversion Hv1; subst; inversion Hv2; subst.
+      * exists (YES dq rsh x1), (YES dq0 rsh0 x2); split; last done.
+        right; rewrite YES_op'; destruct (readable_dfrac_dec _); done.
+      * eexists (YES dq rsh x1), _; split; last done.
+        right; rewrite /op /shared_op_instance.
+        destruct (readable_dfrac_dec _); done.
+      * eexists _, (YES dq rsh0 x1); split; last done.
+        right; rewrite NO_YES_op'.
+        destruct (readable_dfrac_dec _); done.
+    + destruct Hop as (? & ? & ? & ? & -> & -> & H & ?).
+      eexists _, _; split; last done.
+      rewrite H; right; done.
+  - intros ??? Hvalid [? | [Hd Hv]].
+    { destruct x; inversion H; subst; destruct Hvalid; done. }
+    apply shared_validN in Hvalid as [??].
+    apply ora_extend in Hv as (? & ? & Hval); last done.
+    destruct y; inversion Hval; subst.
+    + exists (YES dq rsh x1); split; first right; done.
+    + eexists; split; first right; done.
+  - intros ??? [Hd Hv]%shared_dist_implies.
+    right; split; [hnf; auto | by apply ora_dist_orderN].
+  - intros ??? [H | [? ?%ora_orderN_S]].
+    + destruct y; inversion H; subst; by left.
+    + by right.
+  - intros ???? Hord [H | [Hd Hv]].
+    { destruct z; inversion H; subst; by left. }
+    destruct Hord as [Hy | [??]].
+    { destruct y; inversion Hy; subst; simpl in *.
+      left; destruct Hd.
+      * destruct z; simpl in *; subst; try done.
+        inversion H; subst; done.
+      * destruct z; simpl in *; subst; done. }
+    right; split; etrans; eauto.
+  - apply shared_orderN_op.
+  - intros ??? H [Hno | [??]]; first by rewrite Hno in H; destruct H.
+    rewrite !shared_validN in H |- *; destruct H.
+    split; first apply ora_discrete_valid; by eapply ora_validN_orderN.
+  - split.
+    + intros [? | [??]] ?; first by left.
+      right; split; last apply ora_order_orderN; done.
+    + intros H; pose proof (H 0) as H0; destruct H0 as [? | [??]]; first by left.
+      right; split; try done.
+      apply ora_order_orderN; intros n1.
+      destruct (H n1) as [? | [??]]; first destruct y; done.
+  - intros ??? Hcore; pose proof (shared_op_alt x y) as Hop.
+    inversion Hcore as [?? Heq Hcore'|]; subst.
+    rewrite /pcore /shared_pcore_instance; eexists; split; first done.
+    destruct (readable_dfrac_dec _).
+    + destruct Hop as (? & Hv & ->).
+      destruct x; simpl in *.
+      * right; destruct dq, cx; inversion Heq; subst; simpl.
+        -- destruct (_ ⋅ _); try done.
+           split; first by right; rewrite left_id.
+           apply agree_increasing.
+        -- destruct (dfrac_of y); split; simpl; try done; rewrite -H0 -Hv Some_op_opM Some_order; destruct (val_of y); try done; rewrite /= comm; apply agree_increasing.
+      * destruct sh, cx; inversion Heq; subst; simpl.
+        -- right; destruct (_ ⋅ _); try done; simpl.
+           split; first by right; rewrite left_id.
+           apply agree_increasing.
+        -- destruct (dfrac_of y); done.
+    + destruct (dfrac_error _) eqn: Herr; first by destruct (x ⋅ y); inversion Hop; subst; left.
+      destruct Hop as (shx & shy & ? & ? & -> & -> & -> & Hv).
+      destruct shx, cx; inversion Heq; subst.
+      * destruct (Share sh ⋅ shy) eqn: Hop; rewrite Hop // in Hv |- *.
+        right; done.
+      * destruct shy, Hv; done.
+Qed.
+
+Canonical Structure sharedR : ora := Ora shared shared_ora_mixin.
+Canonical Structure sharedUR : uora := Uora shared shared_ucmra_mixin.
+
+Global Instance shared_total : OraTotal sharedR.
+Proof. hnf; eauto. Qed.
+
+Global Instance shared_discrete : OfeDiscrete V -> OraDiscrete sharedR.
+Proof.
+  intros ?; split.
+  - intros [|] [|]; try done.
+    intros [??]; split; try done.
+    by apply agree_cmra_discrete.
+  - intros [|]; try done.
+    intros [??]; split; try done.
+    by apply agree_cmra_discrete.
+  - intros [|] [|]; try done.
+    intros [Hno | [??]]; first by inversion Hno; subst.
+    by right; split; last apply agree_ora_discrete.
+Qed.
+
+Global Instance discarded_core_id rsh v : OraCoreId (YES DfracDiscarded rsh v).
+Proof.
+  hnf.
+  rewrite /pcore /ora_pcore /=.
+  constructor; apply YES_irrel.
+Qed.
+
+Global Instance bot_core_id rsh : OraCoreId (NO (Share share_bot) rsh).
+Proof.
+  hnf.
+  rewrite /pcore /ora_pcore /=.
+  constructor; done.
+Qed.
+
+End shared.
+
+Arguments YES {_ _ _} _ _ _.
+Arguments NO {_ _ _} _ _.
+Arguments dfrac_of {_ _ _} _.
+Arguments val_of {_ _ _} _.
diff --git a/tweetnacl20140427/spec_salsa.v b/tweetnacl20140427/spec_salsa.v
index 947ea97f1b..d306d54e34 100644
--- a/tweetnacl20140427/spec_salsa.v
+++ b/tweetnacl20140427/spec_salsa.v
@@ -1,10 +1,8 @@
 Require Import Recdef.
 Require Import VST.floyd.proofauto.
-Local Open Scope logic.
 Require Import List. Import ListNotations.
 Require Import sha.general_lemmas.
 Require Import ZArith.
-Local Open Scope Z.
 Require Import tweetnacl20140427.Salsa20.
 Require Import tweetnacl20140427.tweetNaclBase.
 Require Export tweetnacl20140427.verif_salsa_base.
@@ -19,7 +17,7 @@ Definition CoreInSEP (data : SixteenByte * SixteenByte * (SixteenByte * SixteenB
                      (v: val * val * val) : mpred :=
   match data with (Nonce, C, K) =>
   match v with (n, c, k) =>
-   ((SByte Nonce n) * (SByte C c) * (ThirtyTwoByte K k))%logic
+   ((SByte Nonce n) * (SByte C c) * (ThirtyTwoByte K k))
   end end.
 
 Definition prepare_data
@@ -64,7 +62,7 @@ Proof. unfold Snuffle20, bind; intros. remember (Snuffle 20 s).
       apply (Snuffle_length _ _ _ Heqo H0). inv H.
 Qed.
 
-Definition fcore_result h data l :=
+Definition fcore_result h data l : Prop :=
   match Snuffle20 (prepare_data data)
   with None => False
      | Some x =>
@@ -88,7 +86,7 @@ Definition OutLen h := if Int.eq (Int.repr h) Int.zero then 64 else 32.
 
 Definition fcorePOST_SEP h data d l out :=
   (CoreInSEP data d *
-  data_at Tsh (tarray tuchar (OutLen h)) l out)%logic.
+  data_at Tsh (tarray tuchar (OutLen h)) l out).
 
 Definition f_core_POST d out h (data: SixteenByte * SixteenByte * (SixteenByte * SixteenByte) ) :=
 EX l:_,
@@ -132,7 +130,7 @@ Definition st32_spec :=
      LOCAL ()
      SEP (QByte (littleendian_invert u) x).
 
-Definition L32_spec :=
+Definition L32_spec : ident * funspec :=
   DECLARE _L32
    WITH x : int, c: int
    PRE [ tuint, tint ]
@@ -535,7 +533,7 @@ Definition crypto_stream_xor_postsep b (Nonce:SixteenByte) K mCont cLen nonce c
                 /\  ContSpec b SIGMA K m mCont zbytes COUT end)
            && data_at Tsh (Tarray tuchar cLen noattr) (Bl2VL COUT) c))
                     * SByte Nonce nonce
-                    * message_at mCont m)%logic.
+                    * message_at mCont m).
 
 (*Precondition length mCont = Int64.unsigned b comes from textual spec in
   https://download.libsodium.org/doc/advanced/salsa20.html
diff --git a/tweetnacl20140427/split_array_lemmas.v b/tweetnacl20140427/split_array_lemmas.v
index de69524733..5ce46d9676 100644
--- a/tweetnacl20140427/split_array_lemmas.v
+++ b/tweetnacl20140427/split_array_lemmas.v
@@ -1,8 +1,7 @@
 Require Import VST.floyd.proofauto.
-Local Open Scope logic.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import List. Import ListNotations.
 Require Import ZArith.
-Local Open Scope Z.
 
 (*generalizes Lemma data_at_lemmas.memory_block_data_at__aux1*)
 Lemma unsigned_add: forall i pos, 0 <= pos -> Ptrofs.unsigned (Ptrofs.add i (Ptrofs.repr pos)) = (Ptrofs.unsigned i + pos) mod Ptrofs.modulus.
@@ -107,29 +106,29 @@ Lemma sizeof_Zlength_nonneg {A} {ge: compspecs} t (d:list A): 0 <= sizeof t * Zl
   apply Z.mul_nonneg_nonneg; lia.
 Qed.
 (*
-Lemma data_at_ext {cs} sh t v v' p: v=v' -> @data_at cs sh t v p |-- @data_at cs sh t v' p.
+Lemma data_at_ext {cs} sh t v v' p: v=v' -> data_at(cs := cs) sh t v p |-- data_at(cs := cs) sh t v' p.
 Proof. intros; subst. trivial. Qed.
 
-Lemma data_at_ext_derives {cs} sh t v v' p q: v=v' -> p=q -> @data_at cs sh t v p |-- @data_at cs sh t v' q.
+Lemma data_at_ext_derives {cs} sh t v v' p q: v=v' -> p=q -> data_at(cs := cs) sh t v p |-- data_at(cs := cs) sh t v' q.
 Proof. intros; subst. trivial. Qed.
 
-Lemma data_at_ext_eq {cs} sh t v v' p q: v=v' -> p=q -> @data_at cs sh t v p = @data_at cs sh t v' q.
+Lemma data_at_ext_eq {cs} sh t v v' p q: v=v' -> p=q -> data_at(cs := cs) sh t v p = data_at(cs := cs) sh t v' q.
 Proof. intros; subst. trivial. Qed.
 
 (*From sha_lemmas, but repeated here to avoid specialization to sha.CompSpecs*)
 Lemma data_at_type_changable {cs}: forall (sh: Share.t) (t1 t2: type) v1 v2,
   t1 = t2 ->
   JMeq v1 v2 ->
-  @data_at cs sh t1 v1 = data_at sh t2 v2.
+  data_at(cs := cs) sh t1 v1 = data_at sh t2 v2.
 Proof.
   intros.
   subst. apply JMeq_eq in H0. subst v2. reflexivity.
 Qed.
 
 Lemma split2_data_at_Tarray_at_tuchar_unfold {cs} sh n n1 v p: 0 <= n1 <= n ->
-  @data_at cs sh (Tarray tuchar n noattr) v p |--
-  (@data_at cs sh (Tarray tuchar n1 noattr) (sublist 0 n1 v) p *
-   at_offset (@data_at cs sh (Tarray tuchar (n - n1) noattr) (sublist n1 (Zlength v) v)) n1 p)%logic.
+  data_at(cs := cs) sh (Tarray tuchar n noattr) v p |--
+  (data_at(cs := cs) sh (Tarray tuchar n1 noattr) (sublist 0 n1 v) p *
+   at_offset (data_at(cs := cs) sh (Tarray tuchar (n - n1) noattr) (sublist n1 (Zlength v) v)) n1 p).
 Proof.
   rewrite data_at_isptr at 1.
   unfold data_at at 1. intros; simpl; normalize.
@@ -151,10 +150,10 @@ Proof.
   rewrite isptr_offset_val_zero, Zplus_0_l, Zmult_1_l; trivial.
 Qed.
 Lemma split2_data_at_Tarray_at_tuchar_unfold_with_fc {cs} sh n n1 v p: 0 <= n1 <= n ->
-  @data_at cs sh (Tarray tuchar n noattr) v p |--
+  data_at(cs := cs) sh (Tarray tuchar n noattr) v p |--
   !!(field_compatible (Tarray tuchar n noattr) [] p) &&
-  (@data_at cs sh (Tarray tuchar n1 noattr) (sublist 0 n1 v) p *
-   at_offset (@data_at cs sh (Tarray tuchar (n - n1) noattr) (sublist n1 (Zlength v) v)) n1 p)%logic.
+  (data_at(cs := cs) sh (Tarray tuchar n1 noattr) (sublist 0 n1 v) p *
+   at_offset (data_at(cs := cs) sh (Tarray tuchar (n - n1) noattr) (sublist n1 (Zlength v) v)) n1 p).
 Proof.
   intros. apply andp_right. entailer.
   apply split2_data_at_Tarray_at_tuchar_unfold; trivial.
@@ -164,7 +163,7 @@ Lemma array_at_data_at1 {cs} : forall sh t gfs lo hi v p,
    field_compatible0 t (gfs SUB lo) p ->
    field_compatible0 t (gfs SUB hi) p ->
   @array_at cs sh t gfs lo hi v p =
-  at_offset (@data_at cs sh (nested_field_array_type t gfs lo hi)
+  at_offset (data_at(cs := cs) sh (nested_field_array_type t gfs lo hi)
                 (@fold_reptype _ (nested_field_array_type t gfs lo hi)  v))
                (nested_field_offset2 t (ArraySubsc lo :: gfs)) p.
 Proof.
@@ -173,10 +172,10 @@ Qed.
 
 Lemma split2_data_at_Tarray_at_tuchar_fold {cs} sh n n1 v p: 0 <= n1 <= n -> n = Zlength v -> n < Int.modulus ->
    field_compatible (Tarray tuchar n noattr) [] p ->
-  (@data_at cs sh (Tarray tuchar n1 noattr) (sublist 0 n1 v) p *
-   at_offset (@data_at cs sh (Tarray tuchar (n - n1) noattr) (sublist n1 (Zlength v) v)) n1 p)%logic
+  (data_at(cs := cs) sh (Tarray tuchar n1 noattr) (sublist 0 n1 v) p *
+   at_offset (data_at(cs := cs) sh (Tarray tuchar (n - n1) noattr) (sublist n1 (Zlength v) v)) n1 p)
 |--
-  @data_at cs sh (Tarray tuchar n noattr) v p.
+  data_at(cs := cs) sh (Tarray tuchar n noattr) v p.
 Proof. intros.
   rewrite data_at_isptr at 1. unfold at_offset. intros; normalize.
   rewrite (data_at_isptr sh (Tarray tuchar (n - n1) noattr) (sublist n1 (Zlength v) v) (offset_val (Int.repr n1) p)).
@@ -218,9 +217,9 @@ Qed.
 
 Lemma split2_data_at_Tarray_at_tuchar {cs} sh n n1 v p: 0 <= n1 <= n -> n = Zlength v -> n < Int.modulus ->
    field_compatible (Tarray tuchar n noattr) [] p ->
-@data_at cs sh (Tarray tuchar n noattr) v p
-= (@data_at cs sh (Tarray tuchar n1 noattr) (sublist 0 n1 v) p *
-   at_offset (@data_at cs sh (Tarray tuchar (n - n1) noattr) (sublist n1 (Zlength v) v)) n1 p)%logic.
+data_at(cs := cs) sh (Tarray tuchar n noattr) v p
+= (data_at(cs := cs) sh (Tarray tuchar n1 noattr) (sublist 0 n1 v) p *
+   at_offset (data_at(cs := cs) sh (Tarray tuchar (n - n1) noattr) (sublist n1 (Zlength v) v)) n1 p).
 Proof. intros. apply pred_ext.
   apply (split2_data_at_Tarray_at_tuchar_unfold sh n n1); trivial.
   apply (split2_data_at_Tarray_at_tuchar_fold sh n n1); trivial.
@@ -229,9 +228,9 @@ Qed.
 Lemma append_split2_data_at_Tarray_at_tuchar {cs} sh n data1 data2 p: Zlength (data1++data2) < Int.modulus ->
    n = Zlength (data1++data2) ->
    field_compatible (Tarray tuchar n noattr) [] p ->
-@data_at cs sh (Tarray tuchar n noattr) (data1++data2) p
-= (@data_at cs sh (Tarray tuchar (Zlength data1) noattr) data1 p *
-   at_offset (@data_at cs sh (Tarray tuchar (Zlength data2) noattr) data2) (Zlength data1) p)%logic.
+data_at(cs := cs) sh (Tarray tuchar n noattr) (data1++data2) p
+= (data_at(cs := cs) sh (Tarray tuchar (Zlength data1) noattr) data1 p *
+   at_offset (data_at(cs := cs) sh (Tarray tuchar (Zlength data2) noattr) data2) (Zlength data1) p).
 Proof. intros. subst n.
   specialize (Zlength_nonneg data1).  specialize (Zlength_nonneg data2). intros.
   erewrite (split2_data_at_Tarray_at_tuchar sh _ (Zlength data1)); rewrite Zlength_app in *; try lia; trivial.
@@ -248,11 +247,11 @@ Lemma split_offset_Tarray_at cs:
   legal_alignas_type t = true ->
   (Z.of_nat n <= Zlength contents)%Z ->
   (Z.of_nat n <= len)%Z ->
-  @data_at cs sh (Tarray t len noattr) contents v =
+  data_at(cs := cs) sh (Tarray t len noattr) contents v =
   (!! (offset_in_range (sizeof t * 0) v) &&
    !! (offset_in_range (sizeof t * len) v) &&
   (data_at sh (Tarray t (Z.of_nat n) noattr) (firstn n contents) v *
-    data_at sh (Tarray t (len- Z.of_nat n) noattr) (skipn n contents) (offset_val (Int.repr (sizeof t * Z.of_nat n)) v)))%logic.
+    data_at sh (Tarray t (len- Z.of_nat n) noattr) (skipn n contents) (offset_val (Int.repr (sizeof t * Z.of_nat n)) v))).
 Proof. apply split_offset_array_at. Qed.
 *)
 (*
@@ -283,10 +282,10 @@ split3_array_at:
 
 Lemma split3_data_at_Tarray_at_tuchar_unfold {cs} sh n lo hi v p:
   0 <= lo <= hi -> hi <= n <= Zlength v ->
-  @data_at cs sh (Tarray tuchar n noattr) v p |--
-  (@data_at cs sh (Tarray tuchar lo noattr) (sublist 0 lo v) p *
-   at_offset (@data_at cs sh (Tarray tuchar (hi - lo) noattr) (sublist lo hi v)) lo p *
-   at_offset (@data_at cs sh (Tarray tuchar (n - hi) noattr) (sublist hi (Zlength v) v)) hi p)%logic.
+  data_at(cs := cs) sh (Tarray tuchar n noattr) v p |--
+  (data_at(cs := cs) sh (Tarray tuchar lo noattr) (sublist 0 lo v) p *
+   at_offset (data_at(cs := cs) sh (Tarray tuchar (hi - lo) noattr) (sublist lo hi v)) lo p *
+   at_offset (data_at(cs := cs) sh (Tarray tuchar (n - hi) noattr) (sublist hi (Zlength v) v)) hi p).
 Proof. intros.
   eapply derives_trans.
   apply (split2_data_at_Tarray_at_tuchar_unfold sh n hi); try lia.
@@ -299,10 +298,10 @@ Proof. intros.
 Qed.
 Lemma split3_data_at_Tarray_at_tuchar_unfold' {cs} sh n n1 n2 v p:
   n2 + n1 <= n <= Zlength v-> 0<= n1 -> 0<= n2 ->
-  @data_at cs sh (Tarray tuchar n noattr) v p |--
-  (@data_at cs sh (Tarray tuchar n1 noattr) (sublist 0 n1 v) p *
-   at_offset (@data_at cs sh (Tarray tuchar n2 noattr) (sublist n1 (n2 + n1) v)) n1 p *
-   at_offset (@data_at cs sh (Tarray tuchar (Zlength v - (n2 + n1)) noattr) (sublist (n2 + n1) (Zlength v) v)) (n2 + n1)  p)%logic.
+  data_at(cs := cs) sh (Tarray tuchar n noattr) v p |--
+  (data_at(cs := cs) sh (Tarray tuchar n1 noattr) (sublist 0 n1 v) p *
+   at_offset (data_at(cs := cs) sh (Tarray tuchar n2 noattr) (sublist n1 (n2 + n1) v)) n1 p *
+   at_offset (data_at(cs := cs) sh (Tarray tuchar (Zlength v - (n2 + n1)) noattr) (sublist (n2 + n1) (Zlength v) v)) (n2 + n1)  p).
 Proof. intros.
   assert_PROP (Zlength v = Z.max 0 n). entailer. rewrite Z.max_r in H2. 2: lia.
   eapply derives_trans.
@@ -313,11 +312,11 @@ Qed.
 Lemma split3_data_at_Tarray_at_tuchar_fold {cs} sh n lo hi v p:
   0 <= lo <= hi -> hi <= n -> n = Zlength v -> n < Int.modulus ->
   field_compatible (Tarray tuchar n noattr) [] p ->
-(@data_at cs sh (Tarray tuchar lo noattr) (sublist 0 lo v) p *
-   at_offset (@data_at cs sh (Tarray tuchar (hi - lo) noattr) (sublist lo hi v)) lo p *
-   at_offset (@data_at cs sh (Tarray tuchar (n - hi) noattr) (sublist hi (Zlength v) v)) hi p)%logic
+(data_at(cs := cs) sh (Tarray tuchar lo noattr) (sublist 0 lo v) p *
+   at_offset (data_at(cs := cs) sh (Tarray tuchar (hi - lo) noattr) (sublist lo hi v)) lo p *
+   at_offset (data_at(cs := cs) sh (Tarray tuchar (n - hi) noattr) (sublist hi (Zlength v) v)) hi p)
 |--
-  @data_at cs sh (Tarray tuchar n noattr) v p.
+  data_at(cs := cs) sh (Tarray tuchar n noattr) v p.
 Proof. intros. subst n.
   assert_PROP (isptr p). entailer. rename H1 into Pp.
   eapply derives_trans. Focus 2.
@@ -349,11 +348,11 @@ Lemma split3_data_at_Tarray_at_tuchar_fold' {cs} sh n n1 n2 v p:
   n2 + n1 <= n -> 0<= n1 -> 0<= n2 ->
   n=Zlength v -> n < Int.modulus ->
   field_compatible (Tarray tuchar n noattr) [] p ->
-(@data_at cs sh (Tarray tuchar n1 noattr) (sublist 0 n1 v) p *
-   at_offset (@data_at cs sh (Tarray tuchar n2 noattr) (sublist n1 (n2 + n1) v)) n1 p *
-   at_offset (@data_at cs sh (Tarray tuchar (Zlength v - (n2 + n1)) noattr) (sublist (n2+n1) (Zlength v) v)) (n2+n1) p)%logic
+(data_at(cs := cs) sh (Tarray tuchar n1 noattr) (sublist 0 n1 v) p *
+   at_offset (data_at(cs := cs) sh (Tarray tuchar n2 noattr) (sublist n1 (n2 + n1) v)) n1 p *
+   at_offset (data_at(cs := cs) sh (Tarray tuchar (Zlength v - (n2 + n1)) noattr) (sublist (n2+n1) (Zlength v) v)) (n2+n1) p)
 |--
-  @data_at cs sh (Tarray tuchar n noattr) v p.
+  data_at(cs := cs) sh (Tarray tuchar n noattr) v p.
 Proof. intros.
   eapply derives_trans.
   2: apply (split3_data_at_Tarray_at_tuchar_fold sh n n1 (n2+n1)); trivial; try lia.
@@ -364,10 +363,10 @@ Lemma split3_data_at_Tarray_at_tuchar {cs} sh n n1 n2 v p:
   n2 + n1 <= n -> 0<= n1 -> 0<= n2 ->
   n=Zlength v -> n < Int.modulus ->
   field_compatible (Tarray tuchar n noattr) [] p ->
-@data_at cs sh (Tarray tuchar n noattr) v p =
-(@data_at cs sh (Tarray tuchar n1 noattr) (sublist 0 n1 v) p *
-   at_offset (@data_at cs sh (Tarray tuchar n2 noattr) (sublist n1 (n2 + n1) v)) n1 p *
-   at_offset (@data_at cs sh (Tarray tuchar (Zlength v - (n2 + n1)) noattr) (sublist (n2+n1) (Zlength v) v)) (n2+n1) p)%logic.
+data_at(cs := cs) sh (Tarray tuchar n noattr) v p =
+(data_at(cs := cs) sh (Tarray tuchar n1 noattr) (sublist 0 n1 v) p *
+   at_offset (data_at(cs := cs) sh (Tarray tuchar n2 noattr) (sublist n1 (n2 + n1) v)) n1 p *
+   at_offset (data_at(cs := cs) sh (Tarray tuchar (Zlength v - (n2 + n1)) noattr) (sublist (n2+n1) (Zlength v) v)) (n2+n1) p).
 Proof. intros. apply pred_ext.
   apply (split3_data_at_Tarray_at_tuchar_unfold' sh n n1 n2); trivial. subst n; trivial. clear - H. lia.
   apply (split3_data_at_Tarray_at_tuchar_fold' sh n n1 n2); trivial.
@@ -377,10 +376,10 @@ Lemma append_split3_data_at_Tarray_at_tuchar {cs} sh n data1 data2 data3 p:
    n = Zlength (data1++data2++data3) ->
    n < Int.modulus ->
    field_compatible (Tarray tuchar n noattr) [] p ->
-@data_at cs sh (Tarray tuchar n noattr) (data1++data2++data3) p
-= (@data_at cs sh (Tarray tuchar (Zlength data1) noattr) data1 p *
-   at_offset (@data_at cs sh (Tarray tuchar (Zlength data2) noattr) data2) (Zlength data1) p *
-   at_offset (@data_at cs sh (Tarray tuchar (Zlength data3) noattr) data3) (Zlength data2 + Zlength data1) p)%logic.
+data_at(cs := cs) sh (Tarray tuchar n noattr) (data1++data2++data3) p
+= (data_at(cs := cs) sh (Tarray tuchar (Zlength data1) noattr) data1 p *
+   at_offset (data_at(cs := cs) sh (Tarray tuchar (Zlength data2) noattr) data2) (Zlength data1) p *
+   at_offset (data_at(cs := cs) sh (Tarray tuchar (Zlength data3) noattr) data3) (Zlength data2 + Zlength data1) p).
 Proof. intros.
   specialize (Zlength_nonneg data1). specialize (Zlength_nonneg data2). specialize (Zlength_nonneg data3). intros.
   rewrite (split3_data_at_Tarray_at_tuchar sh n (Zlength data1) (Zlength data2)); try lia; trivial.
@@ -405,10 +404,10 @@ Lemma append_split3_data_at_Tarray_at_tuchar' {cs} sh data data1 data2 data3 p:
    data = data1++data2++data3 ->
    Zlength data < Int.modulus ->
    field_compatible (Tarray tuchar (Zlength data) noattr) [] p ->
-@data_at cs sh (Tarray tuchar (Zlength data) noattr) data p
-= (@data_at cs sh (Tarray tuchar (Zlength data1) noattr) data1 p *
-   at_offset (@data_at cs sh (Tarray tuchar (Zlength data2) noattr) data2) (Zlength data1) p *
-   at_offset (@data_at cs sh (Tarray tuchar (Zlength data3) noattr) data3) (Zlength data2 + Zlength data1) p)%logic.
+data_at(cs := cs) sh (Tarray tuchar (Zlength data) noattr) data p
+= (data_at(cs := cs) sh (Tarray tuchar (Zlength data1) noattr) data1 p *
+   at_offset (data_at(cs := cs) sh (Tarray tuchar (Zlength data2) noattr) data2) (Zlength data1) p *
+   at_offset (data_at(cs := cs) sh (Tarray tuchar (Zlength data3) noattr) data3) (Zlength data2 + Zlength data1) p).
 Proof. intros. subst.
   apply append_split3_data_at_Tarray_at_tuchar; trivial.
 Qed.
@@ -423,7 +422,7 @@ Lemma split3_data_at_Tarray_at_tuchar:
   (data_at sh (tarray t (Z.of_nat lo)) (firstn lo data) d *
   data_at sh (tarray t (Z.of_nat n)) (firstn n (skipn lo data)) (offset_val (Int.repr (sizeof t * Z.of_nat lo)) d) *
   data_at sh (tarray t (Zlength data - Z.of_nat (lo+n)))
-             (skipn (lo+n) data)  (offset_val (Int.repr (sizeof t * Z.of_nat (lo+n))) d)))%logic.
+             (skipn (lo+n) data)  (offset_val (Int.repr (sizeof t * Z.of_nat (lo+n))) d))).
 Proof.
   fold reptype in *.
   assert (Arith1: Zlength (firstn (lo + n) data) = Z.of_nat (lo + n)).
@@ -433,7 +432,7 @@ Proof.
     (* by
     (rewrite firstn_length; rewrite Min.min_l by lia; lia).*)
   assert (!!offset_in_range (sizeof t * Zlength data) d |--
-    !! offset_in_range (sizeof t * Zlength (firstn (lo + n) data)) d)%logic.
+    !! offset_in_range (sizeof t * Zlength (firstn (lo + n) data)) d).
     remember (sizeof t) as ST; normalize; subst ST.
     apply offset_in_range_mid with (lo := 0%Z) (hi := Zlength data); try assumption.
     rewrite !Zlength_correct.
@@ -467,7 +466,7 @@ Lemma split3_offset_array_at
   (data_at sh (tarray t (Z.of_nat lo)) (firstn lo data) d *
   data_at sh (tarray t (Z.of_nat n)) (firstn n (skipn lo data)) (offset_val (Int.repr (sizeof t * Z.of_nat lo)) d) *
   data_at sh (tarray t (Zlength data - Z.of_nat (lo+n)))
-             (skipn (lo+n) data)  (offset_val (Int.repr (sizeof t * Z.of_nat (lo+n))) d)))%logic.
+             (skipn (lo+n) data)  (offset_val (Int.repr (sizeof t * Z.of_nat (lo+n))) d))).
 Proof.
   fold reptype in *.
   assert (Arith1: Zlength (firstn (lo + n) data) = Z.of_nat (lo + n)).
@@ -477,7 +476,7 @@ Proof.
     (* by
     (rewrite firstn_length; rewrite Min.min_l by lia; lia).*)
   assert (!!offset_in_range (sizeof t * Zlength data) d |--
-    !! offset_in_range (sizeof t * Zlength (firstn (lo + n) data)) d)%logic.
+    !! offset_in_range (sizeof t * Zlength (firstn (lo + n) data)) d).
     remember (sizeof t) as ST; normalize; subst ST.
     apply offset_in_range_mid with (lo := 0%Z) (hi := Zlength data); try assumption.
     rewrite !Zlength_correct.
@@ -511,7 +510,7 @@ Lemma split3_offset_Tarray_at
   (data_at sh (Tarray t (Z.of_nat lo) noattr) (firstn lo data) d *
   data_at sh (Tarray t (Z.of_nat n) noattr) (firstn n (skipn lo data)) (offset_val (Int.repr (sizeof t * Z.of_nat lo)) d) *
   data_at sh (Tarray t (Zlength data - Z.of_nat (lo+n)) noattr)
-             (skipn (lo+n) data)  (offset_val (Int.repr (sizeof t * Z.of_nat (lo+n))) d)))%logic.
+             (skipn (lo+n) data)  (offset_val (Int.repr (sizeof t * Z.of_nat (lo+n))) d))).
 Proof. apply split3_offset_array_at; trivial. Qed.
 *)(*
 Lemma append_split_Tarray_at:
@@ -523,7 +522,7 @@ Lemma append_split_Tarray_at:
    !! offset_in_range (sizeof t * (Zlength data)) d &&
   (data_at sh (Tarray t (Zlength data1) noattr) data1 d *
    data_at sh (Tarray t (Zlength data2) noattr) data2
-             (offset_val (Int.repr (sizeof t * Zlength data1)) d)))%logic.
+             (offset_val (Int.repr (sizeof t * Zlength data1)) d))).
 intros. subst.
 rewrite (split_offset_Tarray_at (length data1) sh t (Zlength (data1++data2))
          (data1 ++ data2) d H); repeat rewrite Zlength_correct.
@@ -544,7 +543,7 @@ Lemma append_split3_Tarray_at
    data_at sh (Tarray t (Zlength data2) noattr) data2
              (offset_val (Int.repr (sizeof t * Zlength data1)) d) *
    data_at sh (Tarray t (Zlength data3) noattr) data3
-             (offset_val (Int.repr (sizeof t * (Zlength data1 + Zlength data2))) d)))%logic.
+             (offset_val (Int.repr (sizeof t * (Zlength data1 + Zlength data2))) d))).
 Proof.
   subst.
   erewrite (split3_offset_Tarray_at t A (length data1) (length data2)).
@@ -565,21 +564,21 @@ Qed.
 *)
 
 Definition Select_at {cs} sh n (data2: list val) d :=
-   @data_at cs sh (Tarray tuchar (Zlength data2) noattr) data2
+   data_at(cs := cs) sh (Tarray tuchar (Zlength data2) noattr) data2
              (offset_val n d).
 
 Definition Unselect_at {cs} sh (data1 data2 data3: list val) d :=
-  (@data_at cs sh (Tarray tuchar (Zlength data1) noattr) data1 d *
-   @data_at cs sh (Tarray tuchar (Zlength data3) noattr) data3
-             (offset_val (Zlength data2 + Zlength data1) d))%logic.
+  (data_at(cs := cs) sh (Tarray tuchar (Zlength data1) noattr) data1 d *
+   data_at(cs := cs) sh (Tarray tuchar (Zlength data3) noattr) data3
+             (offset_val (Zlength data2 + Zlength data1) d)).
 
 Lemma Select_Unselect_Tarray_at {cs} l d sh (data1 data2 data3 data: list val)
   (DATA: (data1 ++ data2 ++ data3) = data)
   (L: l = Zlength data)
   (F: @field_compatible cs (Tarray tuchar (Zlength (data1 ++ data2 ++ data3)) noattr) [] d)
   (ZL: Zlength (data1 ++ data2 ++ data3) < Int.modulus):
-  @data_at cs sh (Tarray tuchar l noattr) data d =
-  (@Select_at cs sh (Zlength data1) data2 d * @Unselect_at cs sh data1 data2 data3 d)%logic.
+  data_at(cs := cs) sh (Tarray tuchar l noattr) data d =
+  (@Select_at cs sh (Zlength data1) data2 d * @Unselect_at cs sh data1 data2 data3 d).
 Proof.
   subst l. subst data.
   specialize (Zlength_nonneg data1). intros.
@@ -588,16 +587,18 @@ Proof.
   rewrite split3_data_at_Tarray_tuchar with (n1:=Zlength data1)(n2:=Zlength data2 +Zlength data1); try lia.
   autorewrite with sublist.
   unfold Select_at, Unselect_at. simpl.
-  unfold offset_val. red in F. destruct d; intuition auto with *.
+  unfold offset_val. red in F.
+  destruct d; try solve [unfold data_at, field_at; normalize; rewrite !prop_false_andp; auto;
+      intros ((Hptr & ?) & _); unfold field_address0 in Hptr; try if_tac in Hptr; done].
   rewrite field_address0_offset. simpl.
   rewrite field_address0_offset. simpl.
-  rewrite (sepcon_comm (data_at sh (Tarray tuchar (Zlength data2) noattr) data2
+  rewrite (sepcon_comm _ (data_at sh (Tarray tuchar (Zlength data2) noattr) data2
   (Vptr b (Ptrofs.add i (Ptrofs.repr (Zlength data1)))))).
-  repeat rewrite sepcon_assoc.
+  repeat rewrite <- sepcon_assoc.
   f_equal. repeat rewrite Z.mul_1_l. rewrite sepcon_comm. f_equal.
   repeat rewrite Zlength_app in *.
   red; simpl. intuition lia.
   repeat rewrite Zlength_app in *.
   red; simpl. intuition lia.
   repeat rewrite Zlength_app in *. lia.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/tweetnacl20140427/tweetNaclBase.v b/tweetnacl20140427/tweetNaclBase.v
index 56925092f6..c94e31d0fb 100644
--- a/tweetnacl20140427/tweetNaclBase.v
+++ b/tweetnacl20140427/tweetNaclBase.v
@@ -1,12 +1,11 @@
 Require Import Recdef.
 Require Import VST.floyd.proofauto.
-Local Open Scope logic.
+Require Export VST.floyd.compat. Export NoOracle.
 Require Import List. Import ListNotations.
 Require Import sha.general_lemmas.
 
 (*Require Import tweetnacl20140427.split_array_lemmas.*)
 Require Import ZArith.
-Local Open Scope Z.
 
 Lemma Zlength_repeat' {A} n (v:A): Zlength (repeat v n) = Z.of_nat n.
 Proof. rewrite Zlength_correct, repeat_length; trivial. Qed.
@@ -334,7 +333,7 @@ Proof. induction l; simpl; intros.
   destruct (IHl _ LL' _ _ M H2); subst. split; trivial.
 Qed.
 
-Lemma list_eq_dec_app {A} (eq_dec: forall x y : A, {x = y} + {x <> y}):
+Lemma list_eq_dec_app {A} (eq_dec: forall x y : A, {x = y} + {x <> y} ):
   forall l m l' m'
   (L:Zlength l = Zlength l') (M: Zlength m = Zlength m'),
   ((if list_eq_dec eq_dec (l++m) (l'++m') then true else false) =
diff --git a/tweetnacl20140427/verif_crypto_core.v b/tweetnacl20140427/verif_crypto_core.v
index b2e0f1413a..038919e27b 100644
--- a/tweetnacl20140427/verif_crypto_core.v
+++ b/tweetnacl20140427/verif_crypto_core.v
@@ -1,10 +1,9 @@
 Require Import VST.floyd.proofauto.
-Local Open Scope logic.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import List. Import ListNotations.
 Require Import tweetnacl20140427.Snuffle.
 Require Import tweetnacl20140427.Salsa20.
 Require Import ZArith.
-Local Open Scope Z.
 
 Require Import tweetnacl20140427.tweetnaclVerifiableC.
 Require Import tweetnacl20140427.spec_salsa.
@@ -69,7 +68,7 @@ unfold fcorePOST_SEP; cancel.
   destruct Nonce as [[[N1 N2] N3] N4].
   destruct K as [[[K1 K2] K3] K4].
   destruct L as [[[L1 L2] L3] L4].
-apply derives_refl'. f_equal.
+f_equiv.
   do 8 rewrite X2 in H by (try lia; reflexivity).
   apply H.
 Time Qed. (*2.8*)
\ No newline at end of file
diff --git a/tweetnacl20140427/verif_crypto_stream.v b/tweetnacl20140427/verif_crypto_stream.v
index 1465a79930..f4e9d25f89 100644
--- a/tweetnacl20140427/verif_crypto_stream.v
+++ b/tweetnacl20140427/verif_crypto_stream.v
@@ -1,5 +1,5 @@
 Require Import VST.floyd.proofauto.
-Local Open Scope logic.
+Require Import VST.floyd.compat. Import NoOracle.
 Require Import Coq.Lists.List. Import ListNotations.
 Require Import sha.general_lemmas.
 
@@ -59,12 +59,7 @@ destruct H0 as [HSalsaRes HS]. rewrite HS.
 forward_call (c, v_s, offset_val 16 nonce, d, Nonce2, HSalsaRes, gv).
 { unfold SByte, Sigma_vector, ThirtyTwoByte.
   destruct HSalsaRes as [q1 q2].
-  replace (@field_at CompSpecs Tsh
-  (Tarray tuchar (Int64.unsigned d) noattr) [])
-  with (@data_at CompSpecs Tsh
-  (Tarray tuchar (Int64.unsigned d) noattr)).
-  cancel.
-  unfold data_at. extensionality z. reflexivity. }
+  cancel. }
 forward.
 unfold ThirtyTwoByte. entailer.
  Exists HSalsaRes. entailer. cancel.
diff --git a/tweetnacl20140427/verif_crypto_stream_salsa20_xor.v b/tweetnacl20140427/verif_crypto_stream_salsa20_xor.v
index a87a258a78..c4908c9eb4 100644
--- a/tweetnacl20140427/verif_crypto_stream_salsa20_xor.v
+++ b/tweetnacl20140427/verif_crypto_stream_salsa20_xor.v
@@ -1,11 +1,9 @@
 Require Import VST.floyd.proofauto.
-Local Open Scope logic.
 Require Import Coq.Lists.List. Import ListNotations.
 Require Import sha.general_lemmas.
 
 Require Import tweetnacl20140427.split_array_lemmas.
 Require Import ZArith.
-Local Open Scope Z. 
 From tweetnacl20140427
  Require Import tweetNaclBase Salsa20 verif_salsa_base 
       tweetnaclVerifiableC Snuffle spec_salsa 
@@ -65,7 +63,7 @@ forward_for_simple_bound 16 (EX i:Z,
   (PROP  ()
    LOCAL  (lvar _x (tarray tuchar 64) v_x; lvar _z (tarray tuchar 16) v_z;
    temp _c c; temp _m m; temp _b (Vlong b); temp _n nonce; temp _k k; gvars gv)
-   SEP  (FRZL FR1; EX l:_, !!(Zlength l + i = 16) && data_at Tsh (tarray tuchar 16) 
+   SEP  (FRZL FR1; EX l:_, !!(Zlength l + i = 16)%Z && data_at Tsh (tarray tuchar 16) 
           ((Zrepeat (Vint Int.zero) i) ++ l) v_z))).
 {Exists  (default_val (tarray tuchar 16)). simpl app. entailer!!. }
 { rename H into I. Intros l. rename H into LI16.
@@ -186,8 +184,8 @@ assert(INT64SUB: Int64.sub bInit (Int64.repr (r64 + 64)) =
 } 
 
 rewrite SNR.
-forward_seq. 
-apply (loop1 Espec (FRZL FR3) v_x v_z c mInit (Vlong (Int64.sub bInit (Int64.repr r64))) k m sr_bytes mCont).
+forward_seq.
+apply (loop1 Espec _ (FRZL FR3) v_x v_z c mInit (Vlong (Int64.sub bInit (Int64.repr r64))) k m sr_bytes mCont).
     eassumption.
     clear - SRL R64next R64old HRE Heqr64 MLEN; lia. lia.
 
@@ -201,7 +199,7 @@ thaw FR3. unfold CoreInSEP. repeat flatten_sepcon_in_SEP.
 freeze [1;2;3;4;5;6;7] FR4.
 unfold SByte. 
 forward_seq. rewrite D.
-  apply (For_i_8_16_loop Espec (FRZL FR4) v_x v_z c m 
+  apply (For_i_8_16_loop Espec _ (FRZL FR4) v_x v_z c m 
            (Vlong (Int64.sub bInit (Int64.repr r64))) k zbytesR gv).
 freeze [0;1] FR5.
 forward.
@@ -231,10 +229,10 @@ forward_if (EX m:_,
             (Vptr b (Ptrofs.add i (Ptrofs.repr (Z.of_nat rounds * 64))))). {
         unfold message_at. eapply derives_trans. apply data_at_memory_block.
         eapply derives_trans. apply memory_block_valid_pointer. simpl.
-        3: apply derives_refl'. 3: reflexivity. rep_lia.
-        apply top_share_nonidentity.
+        3: f_equiv. 3: reflexivity. rep_lia.
+        auto.
    }
-  auto 50 with valid_pointer.
+  auto 50 with nocore valid_pointer.
 }
 { forward.
   Exists (force_val (sem_add_ptr_int tuchar Signed m (Vint (Int.repr 64)))).
@@ -245,8 +243,8 @@ forward_if (EX m:_,
 { forward. Exists m. entailer!!. destruct mInit; simpl in M; try contradiction.
   simpl. apply M. inv M. }
 intros.
-thaw FR5. thaw FR4.
 Intros x.
+thaw FR5. thaw FR4.
 destruct cInit; try solve [destruct FC as [? _]; contradiction].
 Exists (S rounds, x, snd (ZZ (ZCont rounds zbytes) 8), srbytes ++ xorlist).
 unfold fst, snd.
@@ -256,8 +254,6 @@ assert_PROP (field_compatible0
       (SUB 64) (Vptr b (Ptrofs.add i (Ptrofs.repr r64))))
    as FC2 by (entailer!; auto with field_compatible).
 entailer!!.
-rewrite INT64SUB.
-split; auto.
 specialize (CONTCONT _ _ _ _ _ _ _ _ CONT); intros; subst zbytesR.
  assert (Hx := CONT_succ SIGMA K mInit mCont zbytes rounds _ _ CONT _ D
     _ _ _ Snuff SNR XOR).
@@ -332,7 +328,7 @@ forward_if (IfPost v_z v_x bInit (N0, N1, N2, N3) K mCont (Int64.unsigned bInit)
      rep_lia. 
   rewrite SNR, <- RR.
   eapply semax_post_flipped'.
-  eapply (loop2 Espec (FRZL FR1) v_x v_z c mInit); try eassumption; try lia.
+  eapply (loop2 Espec _ (FRZL FR1) v_x v_z c mInit); try eassumption; try lia.
   unfold IfPost.
   Intros l.
  (* unfold typed_true in BR. inversion BR; clear BR.*)
diff --git a/tweetnacl20140427/verif_crypto_stream_salsa20_xor1.v b/tweetnacl20140427/verif_crypto_stream_salsa20_xor1.v
index 6299255bfc..99809c0d1c 100644
--- a/tweetnacl20140427/verif_crypto_stream_salsa20_xor1.v
+++ b/tweetnacl20140427/verif_crypto_stream_salsa20_xor1.v
@@ -1,11 +1,9 @@
 Require Import VST.floyd.proofauto.
-Local Open Scope logic.
 Require Import Coq.Lists.List. Import ListNotations.
 Require Import sha.general_lemmas.
 
 Require Import tweetnacl20140427.split_array_lemmas.
 Require Import ZArith.
-Local Open Scope Z. 
 Require Import tweetnacl20140427.tweetNaclBase.
 Require Import tweetnacl20140427.Salsa20.
 Require Import tweetnacl20140427.verif_salsa_base.
@@ -143,7 +141,6 @@ rewrite Z.sub_add.
 rewrite nth_skipn.
 replace (Z.to_nat (hi-lo) + Z.to_nat lo)%nat with (Z.to_nat hi).
 f_equal.
-lia.
 apply firstn_same.
 rewrite <- ZtoNat_Zlength.
 apply Z_to_nat_monotone; auto.
@@ -168,38 +165,41 @@ Proof. intros H; symmetry in H.
   apply combinelist_length in H. rewrite Zlength_correct, H. rewrite Zlength_correct; reflexivity.
 Qed. 
 
+Lemma Tarray_0_emp_iff sh c: field_compatible (Tarray tuchar 0 noattr) [] c ->
+  data_at sh (Tarray tuchar 0 noattr) nil c = emp.
+Proof.
+  intros. unfold data_at, field_at, at_offset. rewrite prop_true_andp by auto.
+  rewrite data_at_rec_eq; simpl.
+  unfold array_pred, unfold_reptype, aggregate_pred.array_pred; simpl.
+  rewrite prop_true_andp by auto; reflexivity.
+Qed.
 Lemma Tarray_0_emp sh v c: data_at sh (Tarray tuchar 0 noattr) v c |--  emp.
 Proof.
   unfold data_at. unfold field_at, data_at_rec, at_offset; simpl.
   unfold array_pred, unfold_reptype, aggregate_pred.array_pred. entailer.
-Qed. 
+Qed.
 Lemma Tarray_0_emp' sh c: field_compatible (Tarray tuchar 0 noattr) nil c ->
   emp |-- data_at sh (Tarray tuchar 0 noattr) nil c.
-Proof. intros.
-  unfold data_at. unfold field_at, data_at_rec, at_offset; simpl.
-  unfold array_pred, unfold_reptype, aggregate_pred.array_pred. simpl.
-  entailer.
-Qed. 
-Lemma Tarray_0_emp_iff sh c: field_compatible (Tarray tuchar 0 noattr) [] c ->
-  data_at sh (Tarray tuchar 0 noattr) nil c = emp.
-Proof. intros. apply pred_ext. apply Tarray_0_emp. apply Tarray_0_emp'; trivial.
+Proof.
+  intros; rewrite Tarray_0_emp_iff; auto.
 Qed.
 
+Lemma Tarray_0_emp_iff_ sh c: field_compatible (Tarray tuchar 0 noattr) [] c ->
+  data_at_ sh (Tarray tuchar 0 noattr) c = emp.
+Proof.
+  intros. unfold data_at_, field_at_, field_at, at_offset. rewrite prop_true_andp by auto.
+  rewrite data_at_rec_eq; simpl.
+  unfold array_pred, unfold_reptype, aggregate_pred.array_pred; simpl.
+  rewrite prop_true_andp by auto; reflexivity.
+Qed.
 Lemma Tarray_0_emp_ sh c: data_at_ sh (Tarray tuchar 0 noattr) c |--  emp.
 Proof.
-  unfold data_at_. unfold field_at_, field_at, data_at_rec, at_offset; simpl.
-  unfold array_pred, unfold_reptype, aggregate_pred.array_pred. entailer.
-Qed. 
+  saturate_local. rewrite Tarray_0_emp_iff_; auto.
+Qed.
 Lemma Tarray_0_emp'_ sh c: field_compatible (Tarray tuchar 0 noattr) nil c ->
   emp |-- data_at_ sh (Tarray tuchar 0 noattr) c.
-Proof. intros.
-  unfold data_at_, field_at_, field_at, data_at_rec, at_offset; simpl.
-  unfold array_pred, unfold_reptype, aggregate_pred.array_pred. simpl.
-  entailer.
-Qed. 
-Lemma Tarray_0_emp_iff_ sh c: field_compatible (Tarray tuchar 0 noattr) [] c ->
-  data_at_ sh (Tarray tuchar 0 noattr) c = emp.
-Proof. intros. apply pred_ext. apply Tarray_0_emp_. apply Tarray_0_emp'_; trivial.
+Proof.
+  intros; rewrite Tarray_0_emp_iff_; auto.
 Qed.
 
 Lemma bxorlist_app xs2 ys2: forall xs1 ys1 zs1 zs2,
@@ -243,7 +243,7 @@ Proof. induction n; simpl; intros.
   destruct (Byte.unsigned_range_2 b). 
   rewrite Int.shru_div_two_p. rewrite (Int.unsigned_repr 8) by rep_lia.
   assert (B3: 0 <= Int.unsigned i + Byte.unsigned b <= Int.max_unsigned).
-    split. lia. rep_lia. 
+    split. lia. rep_lia.
   assert (0 <= (Int.unsigned i + Byte.unsigned b) / two_p 8 < 256).
     split. apply Z_div_pos. cbv; trivial. lia.
     apply Zdiv_lt_upper_bound. cbv; trivial. lia. 
@@ -251,7 +251,7 @@ Proof. induction n; simpl; intros.
 Qed.
 
 
-Definition i_8_16_inv F x z c b m k zbytes gv: environ -> mpred := 
+Definition i_8_16_inv F x z c b m k zbytes gv: assert := 
 EX i:_,
   (PROP  ()
    LOCAL  (temp _u (Vint (fst (ZZ zbytes (Z.to_nat (i-8)))));
@@ -260,7 +260,7 @@ EX i:_,
      temp _b b; temp _k k; gvars gv)
    SEP  (F; data_at Tsh (Tarray tuchar 16 noattr) (Bl2VL (snd (ZZ zbytes (Z.to_nat (i-8))))) z)).
 
-Definition for_loop_statement:=
+Definition for_loop_statement :=
 Sfor (Sset _i (Econst_int (Int.repr 8) tint))
      (Ebinop Olt (Etempvar _i tuint) (Econst_int (Int.repr 16) tint) tint)
      (Ssequence
@@ -284,8 +284,8 @@ Sfor (Sset _i (Econst_int (Int.repr 8) tint))
      (Sset _i
         (Ebinop Oadd (Etempvar _i tuint) (Econst_int (Int.repr 1) tint) tuint)).
 
-Lemma For_i_8_16_loop Espec F x z c m b k zbytes gv:
-@semax CompSpecs Espec 
+Lemma For_i_8_16_loop Espec E F x z c m b k zbytes gv:
+semax(C := CompSpecs)(OK_spec := Espec) E
   (func_tycontext f_crypto_stream_salsa20_tweet_xor SalsaVarSpecs SalsaFunSpecs nil)
   (PROP  ()
    LOCAL  (temp _u (Vint (Int.repr 1)); lvar _x (Tarray tuchar 64 noattr) x;
@@ -294,11 +294,11 @@ Lemma For_i_8_16_loop Espec F x z c m b k zbytes gv:
    SEP  (F; data_at Tsh (Tarray tuchar 16 noattr) (Bl2VL zbytes) z))
  for_loop_statement
  (normal_ret_assert 
-  ( PROP ()
-    LOCAL (lvar _x (Tarray tuchar 64 noattr) x;
-           lvar _z (Tarray tuchar 16 noattr) z; temp _c c; temp _m m;
-           temp _b b; temp _k k; gvars gv)
-    SEP (F; data_at Tsh (Tarray tuchar 16 noattr) (Bl2VL (snd (ZZ zbytes 8))) z))).
+  (PROP ()
+   LOCAL (lvar _x (Tarray tuchar 64 noattr) x;
+          lvar _z (Tarray tuchar 16 noattr) z; temp _c c; temp _m m;
+          temp _b b; temp _k k; gvars gv)
+   SEP (F; data_at Tsh (Tarray tuchar 16 noattr) (Bl2VL (snd (ZZ zbytes 8))) z))).
 Proof.
 unfold for_loop_statement.
 forward_for_simple_bound 16 (i_8_16_inv F x z c b m k zbytes gv).
@@ -329,7 +329,7 @@ forward_for_simple_bound 16 (i_8_16_inv F x z c b m k zbytes gv).
      rewrite W. f_equal.
      unfold Int.add. rewrite Int_unsigned_repr_byte. trivial.
 
-  apply derives_refl'. f_equal.
+  f_equiv.
   clear H2. unfold Bl2VL.
   rewrite Q; simpl; rewrite <- HeqX.
   rewrite upd_Znth_map. f_equal. simpl.
@@ -350,7 +350,7 @@ Opaque ZZ.
 entailer!!.
 Qed.
 
-Definition null_or_offset x q y :=
+Definition null_or_offset x q y : Prop :=
 match x with 
   Vint i => i=Int.zero /\ y=nullval
 | Vptr _ _ => y=offset_val q x
@@ -417,10 +417,10 @@ Sfor (Sset _i (Econst_int (Int.repr 0) tint))
      (Sset _i
         (Ebinop Oadd (Etempvar _i tuint) (Econst_int (Int.repr 1) tint) tuint)).
 
-Lemma loop1 Espec F x z c mInit b k m xbytes mbytes gv cLen 
+Lemma loop1 Espec E F x z c mInit b k m xbytes mbytes gv cLen 
       q (M: null_or_offset mInit q m)
       (Q: 0 <= q <= (Zlength mbytes) - 64) (CL: 64 <= cLen):
-@semax CompSpecs Espec 
+semax(C := CompSpecs)(OK_spec := Espec) E
   (func_tycontext f_crypto_stream_salsa20_tweet_xor SalsaVarSpecs SalsaFunSpecs nil)
   (PROP  ()
    LOCAL  (lvar _x (Tarray tuchar 64 noattr) x;
@@ -448,7 +448,7 @@ loop1_statement
             (Bl2VL l ++ repeat Vundef (Z.to_nat (cLen - 64))) c))).
 Proof. intros.
 Intros.
-unfold loop1_statement.       
+unfold loop1_statement.
 forward_for_simple_bound 64 (EX i:Z, 
   (PROP  ()
    LOCAL  (lvar _x (Tarray tuchar 64 noattr) x;
@@ -485,7 +485,7 @@ rename H into I.
         eapply derives_trans. apply memory_block_valid_pointer.
         3: apply derives_refl.
         simpl. rewrite Z.max_r. lia. apply Zlength_nonneg.
-        apply top_share_nonidentity.
+        auto.
     + apply valid_pointer_null. }
   { unfold Bl2VL in *.
     destruct mInit; simpl in *; try contradiction.
@@ -501,8 +501,7 @@ rename H into I.
     2:{ elim n; clear n. apply field_compatible0_cons. simpl. split; trivial. lia. }
     assert (X: 0 + 1 * q = q) by lia. rewrite X; clear X. 
     forward; unfold Bl2VL; autorewrite with sublist. 
-    + entailer!!. 
-        apply Byte.unsigned_range_2.
+    + entailer!!.
     + forward. erewrite (split2_data_at_Tarray_tuchar _ (Zlength mbytes) q).
       2: lia. 2: unfold Bl2VL; repeat rewrite Zlength_map; trivial. 
       unfold field_address0. entailer!. simpl.
@@ -542,10 +541,10 @@ rename H into I.
                        (Znth (Zlength l) xbytes)) as mybyte.
     Exists (l++ [mybyte]). cancel.
     apply andp_right.
-    + apply prop_right. 
+    + apply prop_right.
       eapply (bxorlist_snoc mInit q m mybyte l); trivial; lia.
     + autorewrite with sublist.
-      apply derives_refl'. f_equal. unfold Bl2VL. subst mybyte. clear.
+       f_equiv. unfold Bl2VL. subst mybyte. clear.
       repeat rewrite map_app. rewrite <- app_assoc. f_equal. simpl.
       f_equal.
       repeat rewrite zero_ext_inrange; try rewrite xor_byte_int; try rewrite Int.unsigned_repr; trivial;
@@ -557,8 +556,8 @@ rename H into I.
 apply andp_left2. apply derives_refl.
 Qed.
 
-Definition loop2Inv F x z c mInit m b k gv q xbytes mbytes cLen: environ -> mpred:=
-EX i:Z, 
+Definition loop2Inv F x z c mInit m b k gv q xbytes mbytes cLen: assert :=
+EX i:Z,
   (PROP  ()
    LOCAL  (lvar _x (Tarray tuchar 64 noattr) x;
    lvar _z (Tarray tuchar 16 noattr) z; temp _c c; temp _m m;
@@ -573,7 +572,7 @@ EX i:Z,
          && data_at Tsh (Tarray tuchar cLen noattr)
                         (Bl2VL l ++ repeat Vundef (Z.to_nat (cLen - i))) c)).
 
-Definition loop2_statement:=
+Definition loop2_statement :=
 Sfor (Sset _i (Econst_int (Int.repr 0) tint))
      (Ebinop Olt (Etempvar _i tuint) (Etempvar _b tulong) tint)
      (Ssequence
@@ -598,10 +597,10 @@ Sfor (Sset _i (Econst_int (Int.repr 0) tint))
      (Sset _i
         (Ebinop Oadd (Etempvar _i tuint) (Econst_int (Int.repr 1) tint) tuint)).
 
-Lemma loop2 Espec F x z c mInit m b k xbytes mbytes gv
+Lemma loop2 Espec E F x z c mInit m b k xbytes mbytes gv
       q (M: null_or_offset mInit q m) (Q: 0 <= q) (QB: q+Int64.unsigned b = Zlength mbytes) (*(CL: 64 > cLen) *) (*should be b <= cLen or so?*)
       (B: Int64.unsigned b < 64):
-@semax CompSpecs Espec
+semax(C := CompSpecs)(OK_spec := Espec) E
   (func_tycontext f_crypto_stream_salsa20_tweet_xor SalsaVarSpecs SalsaFunSpecs nil)
   (PROP  ()
    LOCAL  (lvar _x (Tarray tuchar 64 noattr) x;
@@ -655,7 +654,7 @@ forward_for_simple_bound (Int64.unsigned b)
         eapply derives_trans. apply memory_block_valid_pointer.
         3: apply derives_refl.
         simpl. rewrite Z.max_r. lia. apply Zlength_nonneg.
-        apply top_share_nonidentity.
+        auto.
     + apply valid_pointer_null. }
   { unfold Bl2VL in *.
     destruct mInit; try contradiction; simpl in M. 
@@ -671,8 +670,7 @@ forward_for_simple_bound (Int64.unsigned b)
     2:{ elim n; clear n. apply field_compatible0_cons. simpl. split; trivial. lia. }
     assert (X: 0 + 1 * q = q) by lia. rewrite X; clear X.
     forward; unfold Bl2VL; autorewrite with sublist.
-    { entailer!!.
-      apply Byte.unsigned_range_2.  }
+    { entailer!!. }
     forward. entailer!!.
     erewrite (split2_data_at_Tarray_tuchar _ (Zlength mbytes) q).
       2: lia. 2: unfold Bl2VL; repeat rewrite Zlength_map; trivial. 
@@ -716,7 +714,7 @@ forward_for_simple_bound (Int64.unsigned b)
     - apply prop_right. 
       eapply (bxorlist_snoc mInit q m mybyte l); trivial; lia.
     - autorewrite with sublist.
-      apply derives_refl'. f_equal. unfold Bl2VL. subst mybyte. clear.
+      f_equiv. unfold Bl2VL. subst mybyte. clear.
       repeat rewrite map_app. rewrite <- app_assoc. f_equal. simpl.
       f_equal.
       repeat rewrite zero_ext_inrange; try rewrite xor_byte_int; try rewrite Int.unsigned_repr; trivial;
diff --git a/tweetnacl20140427/verif_fcore.v b/tweetnacl20140427/verif_fcore.v
index 73c003a4f9..55a813bae6 100644
--- a/tweetnacl20140427/verif_fcore.v
+++ b/tweetnacl20140427/verif_fcore.v
@@ -5,7 +5,6 @@
    Lennart Beringer, June 2015*)
 (*Processing time for this file: approx 13mins*)
 Require Import VST.floyd.proofauto.
-Local Open Scope logic.
 Require Import List. Import ListNotations.
 (*Require Import general_lemmas.
 
@@ -118,7 +117,7 @@ destruct intsums; simpl in H. lia. rename i into v13.
 destruct intsums; simpl in H. lia. rename i into v14.
 destruct intsums; simpl in H. lia. rename i into v15.
 destruct intsums; simpl in H. 2: lia. clear H. simpl.
-unfold Znth. simpl.
+unfold Znth. Time simpl.
 destruct OUT; simpl in H0. lia. rename v into u0.
 destruct OUT; simpl in H0. lia. rename v into u1.
 destruct OUT; simpl in H0. lia. rename v into u2.
@@ -231,13 +230,13 @@ LOCAL (lvar _t (tarray tuint 4) t;
                  (map Vint (hPosLoop2 4 intsums C Nonce)) x))
 end. 
 
-Opaque Snuffle. Opaque hPosLoop2. Opaque hPosLoop3. 
+Opaque Snuffle. Opaque hPosLoop2. Opaque hPosLoop3.
 
 Lemma HTruePOST F t y x w nonce out c k h snuffleRes l data OUT:
       Snuffle 20 l = Some snuffleRes ->
       Int.eq (Int.repr h) Int.zero = false ->
       l = prepare_data data ->
-      F |-- (data_at_ Tsh (tarray tuint 4) t * data_at_ Tsh (tarray tuint 16) w)%logic ->
+      (F |-- (data_at_ Tsh (tarray tuint 4) t * data_at_ Tsh (tarray tuint 16) w)%I) ->
       HTruePostCond F t y x w nonce out c k h snuffleRes l data OUT
 |-- fcore_EpiloguePOST t y x w nonce out c k h OUT data.
 Proof. intros.
@@ -245,7 +244,7 @@ unfold HTruePostCond, fcore_EpiloguePOST.
 destruct data as [[? ?] [? ?]].
 Exists snuffleRes l.
 rewrite H0, <- H1, H. clear - H2.
-Time normalize. (*1.4*)
+Intros intsums.
  Exists intsums.
  go_lowerx. (* must do this explicitly because it's not an ENTAIL *)
  Time entailer!; auto. (*6.8*)
@@ -255,8 +254,8 @@ Lemma HFalsePOST F t y x w nonce out c k h snuffleRes l data OUT:
       Snuffle 20 l = Some snuffleRes ->
       Int.eq (Int.repr h) Int.zero = true ->
       l = prepare_data data ->
-      F |-- ((CoreInSEP data (nonce, c,k) * data_at_ Tsh (tarray tuint 4) t *
-             data_at_ Tsh (tarray tuint 16) w))%logic ->
+      (F |-- ((CoreInSEP data (nonce, c,k) * data_at_ Tsh (tarray tuint 4) t *
+             data_at_ Tsh (tarray tuint 16) w))%I) ->
       HFalsePostCond F t y x w nonce out c k h snuffleRes l
      |-- fcore_EpiloguePOST t y x w nonce out c k h OUT data.
 Proof. intros.
@@ -264,9 +263,10 @@ unfold HFalsePostCond, fcore_EpiloguePOST.
 destruct data as [[? ?] [? ?]].
 Exists snuffleRes l.
 rewrite H0, <- H1, H. clear - H2.
+Opaque CoreInSEP.
 go_lowerx. (* must do this explicitly because it's not an ENTAIL *)
 Time entailer!. (*3.4*)
-Intros intsums. Exists intsums; entailer!. apply H2.
+Intros intsums. Exists intsums; entailer!. rewrite H2; cancel.
 Qed.
 
 Opaque HTruePostCond. Opaque HFalsePostCond.
@@ -292,7 +292,7 @@ Intros xInit. red in H. rename H into XInit.
 thaw FR2. freeze [0;2;3;5] FR3.
 subst MORE_COMMANDS; unfold abbreviate.
 eapply semax_seq.
-apply (f_core_loop2 _ (FRZL FR3) c k h nonce out w x y t data); trivial.
+apply (f_core_loop2 _ _ (FRZL FR3) c k h nonce out w x y t data); trivial.
     (* mkConciseDelta SalsaVarSpecs SalsaFunSpecs f_core Delta.*)
 
     Intros YS.
@@ -364,7 +364,7 @@ apply (f_core_loop2 _ (FRZL FR3) c k h nonce out w x y t data); trivial.
         destruct (HFalse_inv16_char _ _ _ H99) as [sums [SUMS1 SUMS2]].
           rewrite Zlength_correct, L; reflexivity. trivial.
         rewrite <- SUMS1, <- SUMS2. rewrite hh. auto.
-        unfold fcorePOST_SEP, OutLen.  
+        unfold fcorePOST_SEP, OutLen.
         rewrite hh. auto.
   +  Intros intsums.   unfold fcorePOST_SEP.
       Exists (hPosLoop3 4 (hPosLoop2 4 intsums C Nonce) OUT).
@@ -384,4 +384,4 @@ apply (f_core_loop2 _ (FRZL FR3) c k h nonce out w x y t data); trivial.
         rewrite Zlength_correct, L; reflexivity.
         rewrite Zlength_correct, prepare_data_length; reflexivity.
      unfold OutLen. rewrite hh. auto.
-Time Qed. (*20 versus 58*)
\ No newline at end of file
+Time Qed. (*20 versus 58*)
diff --git a/tweetnacl20140427/verif_fcore_epilogue_hfalse.v b/tweetnacl20140427/verif_fcore_epilogue_hfalse.v
index 89f209c2b5..35e96b9a77 100644
--- a/tweetnacl20140427/verif_fcore_epilogue_hfalse.v
+++ b/tweetnacl20140427/verif_fcore_epilogue_hfalse.v
@@ -1,8 +1,6 @@
 Require Import VST.floyd.proofauto.
-Local Open Scope logic.
 Require Import List. Import ListNotations.
 Require Import ZArith.
-Local Open Scope Z.
 Require Import tweetnacl20140427.tweetNaclBase.
 Require Import tweetnacl20140427.Salsa20.
 Require Import tweetnacl20140427.verif_salsa_base.
@@ -30,7 +28,7 @@ PROP  ()
  EX  l : list val,
    !!HFalse_inv l 16 xs ys && data_at Tsh (tarray tuchar 64) l out).
 
-Definition epilogue_hfalse_statement:=
+Definition epilogue_hfalse_statement :=
 Sfor (Sset _i (Econst_int (Int.repr 0) tint))
      (Ebinop Olt (Etempvar _i tint) (Econst_int (Int.repr 16) tint) tint)
      (Ssequence
@@ -55,7 +53,7 @@ Sfor (Sset _i (Econst_int (Int.repr 0) tint))
         (Ebinop Oadd (Etempvar _i tint) (Econst_int (Int.repr 1) tint) tint)).
 
 Lemma verif_fcore_epilogue_hfalse Espec FR t y x w nonce out c k h OUT xs ys:
-@semax CompSpecs Espec
+semax(C := CompSpecs)(OK_spec := Espec) ⊤
   (func_tycontext f_core SalsaVarSpecs SalsaFunSpecs nil)
   (PROP  ()
    LOCAL  (lvar _t (tarray tuint 4) t; lvar _y (tarray tuint 16) y;
@@ -75,9 +73,9 @@ Proof. intros. abbreviate_semax.
    lvar _w (tarray tuint 16) w; temp _out out; temp _in nonce; temp _k k; temp _c c;
    temp _h (Vint (Int.repr h)))
    SEP
-   (FR; @data_at CompSpecs Tsh (tarray tuint 16) (map Vint xs) x;
-   @data_at CompSpecs Tsh (tarray tuint 16) (map Vint ys) y;
-   EX l:_, !!HFalse_inv l i xs ys && @data_at CompSpecs Tsh (tarray tuchar 64) l out))).
+   (FR; data_at(cs := CompSpecs) Tsh (tarray tuint 16) (map Vint xs) x;
+   data_at(cs := CompSpecs) Tsh (tarray tuint 16) (map Vint ys) y;
+   EX l:_, !!HFalse_inv l i xs ys && data_at(cs := CompSpecs) Tsh (tarray tuchar 64) l out))).
   (*1.9*)
  * Exists OUT. Time entailer!. (*4.2*)
     split; trivial; intros. lia.
@@ -104,7 +102,7 @@ Proof. intros. abbreviate_semax.
     repeat flatten_sepcon_in_SEP.
 
     freeze [0;1;3] FR4.
-    rewrite Znth_map in Xi, Yi; try lia. 
+    rewrite Znth_map in Xi, Yi; try lia.
     inv Xi; inv Yi.
     Time forward_call (Vptr b (Ptrofs.add z (Ptrofs.repr (1 * (4 * i)))), Int.add (Znth i xs) (Znth i ys)). (*3.6*)
     { replace (4 + 4 * i - 4 * i) with 4 by lia. cancel. }
diff --git a/tweetnacl20140427/verif_fcore_epilogue_htrue.v b/tweetnacl20140427/verif_fcore_epilogue_htrue.v
index 6307fd2508..b355652a09 100644
--- a/tweetnacl20140427/verif_fcore_epilogue_htrue.v
+++ b/tweetnacl20140427/verif_fcore_epilogue_htrue.v
@@ -1,11 +1,9 @@
 Require Import VST.floyd.proofauto.
-Local Open Scope logic.
 Require Import List. Import ListNotations.
 Require Import sha.general_lemmas.
 
 Require Import tweetnacl20140427.split_array_lemmas.
 Require Import ZArith.
-Local Open Scope Z.
 Require Import tweetnacl20140427.tweetNaclBase.
 Require Import tweetnacl20140427.Salsa20.
 Require Import tweetnacl20140427.tweetnaclVerifiableC.
@@ -61,8 +59,8 @@ Proof.
   auto.
 Qed.
 
-Lemma HTrue_loop1 Espec (FR:mpred) t y x w nonce out c k h (xs ys: list int):
-@semax CompSpecs Espec
+Lemma HTrue_loop1 Espec E (FR:mpred) t y x w nonce out c k h (xs ys: list int):
+semax(C := CompSpecs)(OK_spec := Espec) E
   (func_tycontext f_core SalsaVarSpecs SalsaFunSpecs nil)
   (PROP  ()
    LOCAL  (temp _i (Vint (Int.repr 20)); lvar _t (tarray tuint 4) t;
@@ -206,7 +204,7 @@ Fixpoint hPosLoop2 (n:nat) (sumlist: list int) (C Nonce: SixteenByte): list int
        end.
 
 Lemma HTrue_loop2 Espec (FR:mpred) t y x w nonce out c k h intsums Nonce C K:
-@semax CompSpecs Espec
+semax(C := CompSpecs)(OK_spec := Espec) ⊤
   (func_tycontext f_core SalsaVarSpecs SalsaFunSpecs nil)
   (PROP  ()
    LOCAL  (lvar _t (tarray tuint 4) t;
@@ -269,7 +267,7 @@ Proof. intros. abbreviate_semax.
        simpl. rewrite app_nil_r. simpl.
     flatten_sepcon_in_SEP.
     freeze [0;1;3] FR2.
-    freeze [0;2] FR3. 
+    freeze [0;2] FR3.
     Time forward_call ((Vptr cb (Ptrofs.add coff (Ptrofs.repr (4 * i)))),
                       Select16Q C i). (*2.4 versus 10.3*)
       assert (PL2length: forall n, (0<=n<4)%nat -> Zlength (hPosLoop2 n intsums C Nonce) = 16).
@@ -336,7 +334,7 @@ Proof. intros. abbreviate_semax.
 *)
      entailer!. simpl.
      (*rewrite Uj. simpl.*)
-     repeat rewrite <- sepcon_assoc.
+     repeat rewrite sepcon_assoc.
      apply sepcon_derives.
      + unfold SByte, QByte. (*subst c nonce.*)
        erewrite (Select_Unselect_Tarray_at 16); try reflexivity; try assumption.
@@ -345,7 +343,7 @@ Proof. intros. abbreviate_semax.
        2: rewrite SSS; reflexivity.
        unfold Select_at. repeat rewrite QuadChunk2ValList_ZLength. (*rewrite FL, FLN. *)
        rewrite Zmult_1_r. simpl.
-        repeat rewrite app_nil_r. rewrite FN; cancel.       
+        repeat rewrite app_nil_r. rewrite FN; cancel.
        rewrite <- SSS, <- C16; trivial.
        rewrite <- SSS, <- C16. cbv; trivial.
        rewrite <- NNN, <- N16; trivial.
@@ -499,7 +497,7 @@ Sfor (Sset _i (Econst_int (Int.repr 0) tint))
         (Ebinop Oadd (Etempvar _i tint) (Econst_int (Int.repr 1) tint) tint)).
 
 Lemma HTrue_loop3 Espec (FR:mpred) t y x w nonce out c k h (OUT: list val) xs (*ys Nonce C K*):
-@semax CompSpecs Espec
+semax(C := CompSpecs)(OK_spec := Espec) ⊤
   (func_tycontext f_core SalsaVarSpecs SalsaFunSpecs nil)
   (PROP  ()
    LOCAL  (lvar _t (tarray tuint 4) t;
@@ -553,7 +551,7 @@ Proof. intros. abbreviate_semax.
     unfold offset_val; simpl.
     repeat flatten_sepcon_in_SEP.
     freeze [0;1;3] FR3.
-    rewrite Znth_map in Xi; try lia. 
+    rewrite Znth_map in Xi; try lia.
     inversion Xi; clear Xi; subst xi.
     Time forward_call (offset_val (4 * i) (Vptr ob ooff), (Znth (5 * i) xs)).
     1: solve [autorewrite with sublist; entailer!]. 
@@ -586,7 +584,7 @@ deadvars!.
       rewrite sublist_app2; autorewrite with sublist; try lia.
       rewrite sublist_app2; try rewrite <- QuadByteValList_ZLength; try lia.
       autorewrite with sublist. rewrite Zplus_comm.
-      apply derives_refl'. f_equal. f_equal. lia. }
+      f_equiv. f_equal. lia. }
 
     destruct (Znth_mapVint xs (6+i)) as [zi Zi]. lia.
     freeze [0;1] FR4.
@@ -632,7 +630,7 @@ deadvars!.
       autorewrite with sublist. Time cancel. (*0.6*)
       rewrite sublist_app2; autorewrite with sublist; try lia.
       rewrite sublist_app2; try rewrite <- QuadByteValList_ZLength; try lia.
-      autorewrite with sublist. rewrite Zplus_comm. apply derives_refl'. f_equal. f_equal; lia. }
+      autorewrite with sublist. rewrite Zplus_comm. f_equiv. f_equal; lia. }
   Time entailer!. (*3.7 versus 12.8*) (*With temp _i (Vint (Int.repr 4)) in LOCAL of HTruePostCondL apply derives_refl.*)
 Time Qed. (*June 4th, 2017 (laptop): Finished transaction in 3.433 secs (2.936u,0.008s) (successful)*)
 
@@ -768,7 +766,7 @@ Definition epilogue_htrue_statement:=
 Opaque hPosLoop2. Opaque hPosLoop3.
 
 Lemma verif_fcore_epilogue_htrue Espec (FR:mpred) t y x w nonce out c k h (OUT: list val) xs ys data:
-@semax CompSpecs Espec
+semax(C := CompSpecs)(OK_spec := Espec) ⊤
   (func_tycontext f_core SalsaVarSpecs SalsaFunSpecs nil)
   (PROP  ()
    LOCAL  (temp _i (Vint (Int.repr 20)); lvar _t (tarray tuint 4) t;
diff --git a/tweetnacl20140427/verif_fcore_jbody.v b/tweetnacl20140427/verif_fcore_jbody.v
index a887578d1b..b3a645881c 100644
--- a/tweetnacl20140427/verif_fcore_jbody.v
+++ b/tweetnacl20140427/verif_fcore_jbody.v
@@ -1,12 +1,10 @@
 Require Import Recdef.
 Require Import VST.floyd.proofauto.
-Local Open Scope logic.
 Require Import List. Import ListNotations.
 Require Import sha.general_lemmas.
 
 Require Import tweetnacl20140427.split_array_lemmas.
 Require Import ZArith.
-Local Open Scope Z.
 Require Import tweetnacl20140427.tweetNaclBase.
 Require Import tweetnacl20140427.Salsa20.
 Require Import tweetnacl20140427.verif_salsa_base.
@@ -104,9 +102,9 @@ Definition array_copy1_statement :=
                  (tptr tuint)) tuint) (Etempvar _t'33 tuint)))
      (Sset _m
         (Ebinop Oadd (Etempvar _m tint) (Econst_int (Int.repr 1) tint) tint))).
-Lemma array_copy1: forall (Espec: OracleKind) j t x (xs:list int)
+Lemma array_copy1: forall Espec E j t x (xs:list int)
   (J:0<=j<4),
- semax (func_tycontext f_core SalsaVarSpecs SalsaFunSpecs nil)
+ semax(OK_spec := Espec) E (func_tycontext f_core SalsaVarSpecs SalsaFunSpecs nil)
   (PROP  ()
    LOCAL  (temp _j (Vint (Int.repr j));
    lvar _t (tarray tuint 4) t;
@@ -348,7 +346,7 @@ Definition Jbody_statement :=
                        (Ebinop Oadd (Etempvar _m tint)
                           (Econst_int (Int.repr 1) tint) tint)))))))).
 
-Lemma Jbody (Espec : OracleKind) FR c k h nonce out w x y t i j xs
+Lemma Jbody Espec FR c k h nonce out w x y t i j xs
   (I : 0 <= i < 20)
   (J : 0 <= j < 4)
   wlist
@@ -357,7 +355,7 @@ Lemma Jbody (Espec : OracleKind) FR c k h nonce out w x y t i j xs
   (T1: Znth ((5*j+4*1) mod 16) (map Vint  xs) = Vint t1)
   (T2: Znth ((5*j+4*2) mod 16) (map Vint xs) = Vint t2)
   (T3: Znth ((5*j+4*3) mod 16) (map Vint xs) = Vint t3):
-@semax CompSpecs Espec
+semax(C := CompSpecs)(OK_spec := Espec) ⊤
   (func_tycontext f_core SalsaVarSpecs SalsaFunSpecs nil)
   (PROP  ()
    LOCAL  (temp _j (Vint (Int.repr j)); temp _i (Vint (Int.repr i));
@@ -428,7 +426,7 @@ Ltac compute_upd_Znth :=
 deadvars!.
   (*pattern1*)
   forward. compute_Znth.
-  forward. compute_Znth. 
+  forward. compute_Znth.
   forward_call (Int.add t0 t3, Int.repr 7).
   forward. compute_Znth.
   forward.
@@ -506,7 +504,8 @@ deadvars!.
    unfold Int.mods. rewrite (Int.signed_repr (j+m)) by rep_lia.
    change (Int.signed (Int.repr 4)) with 4. 
    rewrite Int.signed_repr by rep_lia.
-   split. rep_lia. intros [? H9]; inv H9.  }
+   repeat split; try rep_lia.
+   intros [? H9]; inv H9.  }
   { apply prop_right.
     unfold Int.mods. (*rewrite ! mul_repr, add_repr.*)
     rewrite ! Int.signed_repr by rep_lia(*, add_repr, Int.signed_repr*).
@@ -545,4 +544,3 @@ subst.
 rewrite <- Z0, <- Z1, <- Z2, <- Z3.
 reflexivity.
 Time Qed. (*VST 2.0: 4.9s*) (*June 4th,2017 (laptop):Finished transaction in 9.528 secs (8.024u,0.02s) (successful)*)
-
diff --git a/tweetnacl20140427/verif_fcore_loop1.v b/tweetnacl20140427/verif_fcore_loop1.v
index c9417dbb9d..6550f83763 100644
--- a/tweetnacl20140427/verif_fcore_loop1.v
+++ b/tweetnacl20140427/verif_fcore_loop1.v
@@ -1,11 +1,9 @@
 Require Import Recdef.
 Require Import VST.floyd.proofauto.
-Local Open Scope logic.
 Require Import List. Import ListNotations.
 
 Require Import tweetnacl20140427.split_array_lemmas.
 Require Import ZArith.
-Local Open Scope Z.
 Require Import tweetnacl20140427.tweetNaclBase.
 Require Import tweetnacl20140427.Salsa20.
 Require Import tweetnacl20140427.tweetnaclVerifiableC.
@@ -48,10 +46,10 @@ Qed.
   2. In the master-branch, we actually could write the lemma using Delta :=,
      so this is really an issue ith the new_compcert branch*)
 
-Lemma f_core_loop1 (Espec : OracleKind) FR c k h nonce out w x y t
+Lemma f_core_loop1 Espec FR c k h nonce out w x y t
 (data : SixteenByte * SixteenByte * (SixteenByte * SixteenByte))
 (*(Delta := func_tycontext f_core SalsaVarSpecs SalsaFunSpecs) *):
-@semax CompSpecs Espec
+semax(C := CompSpecs)(OK_spec := Espec) ⊤
   (func_tycontext f_core SalsaVarSpecs SalsaFunSpecs nil) (*Delta*)
   (PROP  ()
    LOCAL  (lvar _t (tarray tuint 4) t; lvar _y (tarray tuint 16) y;
@@ -176,7 +174,6 @@ Time forward_for_simple_bound 4 (EX i:Z,
 
   (*Issue this is where the call fails if we use abbreviation Delta := ... in the statement of the lemma*)
 
-
   Time forward_call (offset_val (4 * i) (Vptr cb coff), Select16Q C i). (*3.4 versus 15.4*)
   (*{ goal automatically discharged versus 4.2 }*)
 
diff --git a/tweetnacl20140427/verif_fcore_loop2.v b/tweetnacl20140427/verif_fcore_loop2.v
index cd3bdd00da..6620685b5f 100644
--- a/tweetnacl20140427/verif_fcore_loop2.v
+++ b/tweetnacl20140427/verif_fcore_loop2.v
@@ -1,9 +1,7 @@
 (*Require Import Recdef.*)
 Require Import VST.floyd.proofauto.
-Local Open Scope logic.
 Require Import List. Import ListNotations.
 Require Import ZArith.
-Local Open Scope Z.
 Require Import tweetnacl20140427.tweetNaclBase.
 Require Import tweetnacl20140427.Salsa20.
 Require Import tweetnacl20140427.verif_salsa_base.
@@ -23,12 +21,12 @@ intros.
 induction n; simpl in *. contradiction. destruct H; auto.
 Qed.
 
-Lemma f_core_loop2: forall (Espec : OracleKind) FR c k h nonce out w x y t
+Lemma f_core_loop2: forall Espec E FR c k h nonce out w x y t
   (data : SixteenByte * SixteenByte * (SixteenByte * SixteenByte))
   (Delta := func_tycontext f_core SalsaVarSpecs SalsaFunSpecs nil)
   (xInit : list val)
   (XInit : xInit = upd_upto data 4 (repeat Vundef 16)),
-@semax CompSpecs Espec
+semax(C := CompSpecs)(OK_spec := Espec) E
 Delta
   (PROP  ()
    LOCAL  (temp _i (Vint (Int.repr 4)); lvar _t (tarray tuint 4) t;
diff --git a/tweetnacl20140427/verif_fcore_loop3.v b/tweetnacl20140427/verif_fcore_loop3.v
index 09b964dfa1..562e8db234 100644
--- a/tweetnacl20140427/verif_fcore_loop3.v
+++ b/tweetnacl20140427/verif_fcore_loop3.v
@@ -1,8 +1,6 @@
 Require Import VST.floyd.proofauto.
-Local Open Scope logic.
 Require Import List. Import ListNotations.
 Require Import ZArith.
-Local Open Scope Z.
 Require Import tweetnacl20140427.tweetNaclBase.
 Require Import tweetnacl20140427.Salsa20.
 Require Import tweetnacl20140427.verif_salsa_base.
@@ -126,7 +124,7 @@ Lemma array_copy3 Espec:
 forall FR c k h nonce out
        i w x y t (xlist wlist:list val)
        (WZ: forall m, 0<=m<16 -> exists mval, Znth m wlist =Vint mval),
-@semax CompSpecs Espec
+semax(C := CompSpecs)(OK_spec := Espec) ⊤
   (func_tycontext f_core SalsaVarSpecs SalsaFunSpecs nil)
   (PROP  ()
    LOCAL  (temp _j (Vint (Int.repr 4)); temp _i (Vint (Int.repr i)); lvar _t (tarray tuint 4) t;
@@ -178,9 +176,9 @@ Time forward_for_simple_bound 16 (EX m:Z,
 { Time entailer!. (*1.8 versus 4.3*)
   Intros mlist.
   assert_PROP (Zlength mlist = 16) as ML by entailer.
-  apply derives_refl'. f_equal.
-  eapply Znth_extensional. lia.
-  intros kk K. apply H2. lia. }
+  f_equiv.
+  eapply Znth_extensional. simpl in *; lia.
+  intros kk K. apply H2. simpl in *; lia. }
 Time Qed. (*June 4th, 2017 (laptop): 1s*)
 
 Definition f_core_loop3_statement :=
@@ -403,9 +401,9 @@ Sfor (Sset _i (Econst_int (Int.repr 0) tint))
      (Sset _i
         (Ebinop Oadd (Etempvar _i tint) (Econst_int (Int.repr 1) tint) tint)).
 
-Lemma f_core_loop3: forall (Espec : OracleKind) FR
+Lemma f_core_loop3: forall Espec FR
 c k h nonce out w x y t (xI:list int),
-@semax CompSpecs Espec
+semax(C := CompSpecs)(OK_spec := Espec) ⊤
   (func_tycontext f_core SalsaVarSpecs SalsaFunSpecs nil)
   (PROP  ()
    LOCAL  (temp _i (Vint (Int.repr 16)); lvar _t (tarray tuint 4) t;
diff --git a/tweetnacl20140427/verif_ld_st.v b/tweetnacl20140427/verif_ld_st.v
index b8de8276be..c4e375ae7b 100644
--- a/tweetnacl20140427/verif_ld_st.v
+++ b/tweetnacl20140427/verif_ld_st.v
@@ -1,8 +1,6 @@
 Require Import VST.floyd.proofauto.
-Local Open Scope logic.
 Require Import tweetnacl20140427.split_array_lemmas.
 Require Import ZArith.
-Local Open Scope Z.
 Require Import tweetnacl20140427.tweetNaclBase.
 Require Import tweetnacl20140427.Salsa20.
 Require Import tweetnacl20140427.tweetnaclVerifiableC.
@@ -18,8 +16,8 @@ Lemma L32_spec_ok: semax_body SalsaVarSpecs SalsaFunSpecs
        f_L32 L32_spec.
 Proof.
 start_function.
-Time forward. (*8.8*)   
-entailer!. 
+Time forward. (*8.8*)
+entailer!.
 - 
  change (Int.unsigned Int.iwordsize) with 32.
  split.
@@ -104,16 +102,12 @@ assert (RNG2:= Byte.unsigned_range_2 b2).
 assert (RNG1:= Byte.unsigned_range_2 b1).
 assert (RNG0:= Byte.unsigned_range_2 b0).
 Time forward. (*1.8*)
-Time entailer!; lia. (*1.1*)
 Time forward. (*2*)
-Time entailer!; lia. (*1.1*)
 Time forward. (*1.1*)
 Time forward. (*2.2*)
-Time entailer!; lia. (*1.3*)
 Time forward. (*1.5*)
 drop_LOCAL 1%nat.
 Time forward.
-Time entailer!; lia. (*1.3*)
 Time forward. (*5.2*)
 Time entailer!.
   assert (WS: Int.zwordsize = 32). reflexivity.
@@ -229,9 +223,7 @@ forward_for_simple_bound 8 (EX i:Z,
                  Byte.unsigned c0; Byte.unsigned c1; Byte.unsigned c2; Byte.unsigned c3] 
           = Byte.unsigned (Znth i [b0; b1; b2; b3; c0; c1; c2; c3])).
   solve [erewrite <- (Znth_map _ Byte.unsigned); [ reflexivity | apply I ] ].
-  forward. 
-  + entailer!. rewrite HH. 
-     apply Byte.unsigned_range_2.
+  forward.
   + simpl; rewrite HH. forward.
     entailer!. clear H1 H0 H. f_equal.
     rewrite <- (sublist_rejoin 0 i (i+1)) by Zlength_solve.
@@ -414,7 +406,7 @@ Proof. unfold iter64Shr8'.
    unfold Int64.max_unsigned; simpl; lia.
    unfold Int64.min_signed, Int64.max_signed; simpl; lia.
    unfold Int64.min_signed, Int64.max_signed; simpl; lia.
- - rewrite W. unfold Int64.ltu. rewrite if_true; trivial. normalize. computable.
+ - rewrite W. unfold Int64.ltu. rewrite if_true; trivial. normalize.
  - rewrite W. unfold Int64.ltu. rewrite Int64.mul_signed, Int64.add_signed, if_true; trivial.
    rewrite (Int64.signed_repr 8). 
    2: unfold Int64.min_signed, Int64.max_signed; simpl; lia.
diff --git a/tweetnacl20140427/verif_salsa_base.v b/tweetnacl20140427/verif_salsa_base.v
index 8f211e64d2..da039d6c78 100644
--- a/tweetnacl20140427/verif_salsa_base.v
+++ b/tweetnacl20140427/verif_salsa_base.v
@@ -1,12 +1,10 @@
 Require Import Recdef.
 Require Import VST.floyd.proofauto.
-Local Open Scope logic.
 Require Import Coq.Lists.List. Import ListNotations.
 Require Import sha.general_lemmas.
 
 Require Import tweetnacl20140427.split_array_lemmas.
 Require Import ZArith.
-Local Open Scope Z.
 Require Import tweetnacl20140427.Salsa20.
 Require Import tweetnacl20140427.tweetnaclVerifiableC.
 Require Import tweetnacl20140427.tweetNaclBase.
@@ -54,7 +52,7 @@ Qed.
 
 Definition ThirtyTwoByte (q:SixteenByte * SixteenByte) (v:val) : mpred :=
   match q with (q1, q2) =>
-    @data_at CompSpecs Tsh (Tarray tuchar 32 noattr) ((SixteenByte2ValList q1) ++ (SixteenByte2ValList q2)) v
+    data_at(cs := CompSpecs) Tsh (Tarray tuchar 32 noattr) ((SixteenByte2ValList q1) ++ (SixteenByte2ValList q2)) v
   end.
 
 Definition QByte (q:QuadByte) (v:val) : mpred :=
@@ -83,22 +81,22 @@ Lemma SixteenByte2ValList_Zlength C: 16 = Zlength (SixteenByte2ValList C).
   reflexivity. Qed.
 
 Definition SByte (q:SixteenByte) (v:val) : mpred :=
-  @data_at CompSpecs Tsh (Tarray tuchar 16 noattr) (SixteenByte2ValList q) v.
+  data_at(cs := CompSpecs) Tsh (Tarray tuchar 16 noattr) (SixteenByte2ValList q) v.
 
 Lemma ThirtyTwoByte_split16 q v:
   field_compatible (Tarray tuchar 32 noattr) [] v ->
   ThirtyTwoByte q v =
-  (SByte (fst q) v * SByte (snd q) (offset_val 16 v))%logic.
+  (SByte (fst q) v * SByte (snd q) (offset_val 16 v)).
 Proof. destruct q as [s1 s2]. simpl; intros. unfold SByte.
   rewrite split2_data_at_Tarray_tuchar with (n1:= Zlength (SixteenByte2ValList s1));
      try rewrite Zlength_app; repeat rewrite <- SixteenByte2ValList_Zlength; try lia.
-  unfold offset_val. red in H. destruct v; intuition auto with *.
+  unfold offset_val. red in H. destruct v; try (destruct H; contradiction).
   rewrite field_address0_offset. simpl.
   rewrite sublist_app1; try rewrite <- SixteenByte2ValList_Zlength; try lia.
   rewrite sublist_app2; try rewrite <- SixteenByte2ValList_Zlength; try lia.
   rewrite sublist_same; try rewrite <- SixteenByte2ValList_Zlength; trivial.
   rewrite sublist_same; try rewrite <- SixteenByte2ValList_Zlength; trivial.
-  red; intuition auto with *.
+  red. intuition auto with field_compatible.
 Qed.
 
 Lemma QuadByte2ValList_firstn4 q l:
diff --git a/tweetnacl20140427/verif_verify.v b/tweetnacl20140427/verif_verify.v
index 544d95961e..6a631182b9 100644
--- a/tweetnacl20140427/verif_verify.v
+++ b/tweetnacl20140427/verif_verify.v
@@ -1,5 +1,4 @@
 Require Import VST.floyd.proofauto.
-Local Open Scope logic.
 Require Import List. Import ListNotations.
 Require Import tweetnacl20140427.tweetnaclVerifiableC.
 Require Import tweetnacl20140427.spec_salsa.
@@ -31,9 +30,7 @@ forward_for_simple_bound n
 { Intros. rename H0 into I. rename H1 into B. rename d into b.
   rewrite 3 Zlength_map in LenX, LenY. 
   forward.
-  { entailer!. rep_lia. }
   forward.
-  { entailer!. rep_lia. }
   forward. entailer!. clear H3 H6 H4 H7.
   rewrite <- (sublist_rejoin 0 i (i+1) xcont), sublist_len_1; try lia.
   rewrite <- (sublist_rejoin 0 i (i+1) ycont), sublist_len_1; try lia.
diff --git a/veric/Clight_Cop2.v b/veric/Clight_Cop2.v
index 572c416d69..24a63cf5b2 100644
--- a/veric/Clight_Cop2.v
+++ b/veric/Clight_Cop2.v
@@ -19,7 +19,9 @@
 
 Require Export VST.veric.Cop2.
 Require Import VST.veric.Clight_base.
+Set Warnings "-custom-entry-overridden".
 Require Import VST.veric.tycontext.
+Set Warnings "custom-entry-overridden".
 
 (** * Type classification and semantics of operators. *)
 
diff --git a/veric/Clight_aging_lemmas.v b/veric/Clight_aging_lemmas.v
deleted file mode 100644
index 5d4f40325f..0000000000
--- a/veric/Clight_aging_lemmas.v
+++ /dev/null
@@ -1,27 +0,0 @@
-Require Import compcert.common.Memory.
-Require Import VST.msl.seplog.
-Require Import VST.msl.ageable.
-Require Import VST.msl.age_to.
-Require Import VST.veric.coqlib4.
-Require Import VST.veric.juicy_mem.
-Require Import VST.veric.compcert_rmaps. 
-Require Import VST.veric.semax.
-Require Import VST.veric.juicy_extspec.
-
-Require Import VST.veric.mem_lessdef.
-Require Import VST.veric.age_to_resource_at.
-
-Require Import VST.veric.aging_lemmas.
-
-Lemma jsafeN_age Z Jspec ge ora q jm jmaged :
-  ext_spec_stable age (JE_spec _ Jspec) ->
-  age jm jmaged ->
-  @jsafeN Z Jspec ge ora q jm ->
-  @jsafeN Z Jspec ge ora q jmaged.
-Proof. intros. eapply jsafeN__age; eauto. Qed.
-
-Lemma jsafeN_age_to Z Jspec ge ora q l jm :
-  ext_spec_stable age (JE_spec _ Jspec) ->
-  @jsafeN Z Jspec ge ora q jm ->
-  @jsafeN Z Jspec ge ora q (age_to l jm).
-Proof. intros. eapply jsafeN__age_to; eauto. Qed.
diff --git a/veric/Clight_assert_lemmas.v b/veric/Clight_assert_lemmas.v
index c0685835bb..7775faf6f9 100644
--- a/veric/Clight_assert_lemmas.v
+++ b/veric/Clight_assert_lemmas.v
@@ -1,167 +1,124 @@
 Require Export VST.veric.base.
-Require Import VST.veric.compcert_rmaps.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Export VST.veric.res_predicates.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.Clight_seplog.
 Require Export VST.veric.assert_lemmas.
 
 Require Import VST.veric.tycontext.
 Require Import VST.veric.expr2.
 Require Import VST.veric.extend_tc.
-Import compcert.lib.Maps.
 
-Local Open Scope pred.
+Section mpred.
 
-Lemma corable_funassert:
-  forall G rho, corable (funassert G rho).
-Proof.
-  intros. eapply corable_funspecs_assert.
-Qed.
-
-#[export] Hint Resolve corable_funassert : core.
-
-Section invs.
-
-Context {inv_names : invariants.invG}.
-
-Definition allp_fun_id (Delta : tycontext) (rho : environ): pred rmap :=
- ALL id : ident , ALL fs : funspec ,
-  !! ((glob_specs Delta) ! id = Some fs) -->
-  (EX b : block, !! (Map.get (ge_of rho) id = Some b) && func_ptr_si fs (Vptr b Ptrofs.zero)).
+Context `{!heapGS Σ}.
 
-Definition allp_fun_id_sigcc (Delta : tycontext) (rho : environ): pred rmap :=
-(ALL id : ident ,
- (ALL fs : funspec ,
-  !! ((glob_specs Delta) ! id = Some fs) -->
-  (EX b : block, !! (Map.get (ge_of rho) id = Some b) && 
-    match fs with
-    mk_funspec sig cc _ _ _ _ _ => sigcc_at sig cc (b, 0)
-    end))).
+Definition allp_fun_id (Delta : tycontext) : assert :=
+assert_of (fun rho =>
+ ∀ id : ident, ∀ fs : funspec,
+  ⌜Maps.PTree.get id (glob_specs Delta) = Some fs⌝ →
+  (∃ b : block, ⌜Map.get (ge_of rho) id = Some b⌝ ∧ func_ptr_si fs (Vptr b Ptrofs.zero))).
 
-Lemma allp_fun_id_ex_implies_allp_fun_sigcc Delta rho: 
-  allp_fun_id Delta rho |--  allp_fun_id_sigcc Delta rho.
+Global Instance allp_fun_id_persistent Delta : Persistent (allp_fun_id Delta).
 Proof.
-  apply allp_derives; intros id.
-  apply allp_derives; intros fs.
-  apply imp_derives; trivial.
-  apply exp_derives; intros b.
-  apply andp_derives; trivial.
-  unfold func_ptr. intros w [bb [H [gs [GS F]]]].
-  simpl in H; inv H. destruct gs; destruct fs; destruct GS as [[? ?] ?]; subst.
-  simpl. eexists; rewrite F; clear F. reflexivity.
+  apply monPred_persistent, _.
 Qed.
 
-Lemma corable_allp_fun_id: forall Delta rho,
-  corable (allp_fun_id Delta rho).
-Proof.
-  intros.
-  apply corable_allp; intros id.
-  apply corable_allp; intros fs.
-  apply corable_imp; [apply corable_prop |].
-  apply corable_exp; intros b.
-  apply corable_andp; [apply corable_prop |].
-  apply corable_func_ptr_si.
-Qed.
+Definition allp_fun_id_sigcc (Delta : tycontext) : assert :=
+assert_of (fun rho =>
+(∀ id : ident ,
+ (∀ fs : funspec ,
+  ⌜Maps.PTree.get id (glob_specs Delta) = Some fs⌝ →
+  (∃ b : block, ⌜Map.get (ge_of rho) id = Some b⌝ ∧ 
+    match fs with
+    mk_funspec sig cc _ _ _ _ => sigcc_at sig cc (b, 0)
+    end)))).
 
-Lemma corable_allp_fun_id_sigcc: forall Delta rho,
-  corable (allp_fun_id_sigcc Delta rho).
+Lemma allp_fun_id_ex_implies_allp_fun_sigcc Delta rho:
+  allp_fun_id Delta rho ⊢ allp_fun_id_sigcc Delta rho.
 Proof.
-  intros.
-  apply corable_allp; intros id.
-  apply corable_allp; intros fs.
-  apply corable_imp; [apply corable_prop |].
-  apply corable_exp; intros b.
-  apply corable_andp; [apply corable_prop |].
-  destruct fs. apply corable_exp; intros cc. apply corable_pureat.
+  rewrite /allp_fun_id /allp_fun_id_sigcc.
+  apply bi.forall_mono; intros id.
+  apply bi.forall_mono; intros fs.
+  apply bi.impl_mono; first done.
+  apply bi.exist_mono; intros b.
+  apply bi.and_mono; first done.
+  rewrite /func_ptr_si.
+  iIntros "H"; iDestruct "H" as (? Heq ?) "[#H1 H2]"; inv Heq.
+  rewrite /func_at /sigcc_at /funspec_sub_si.
+  destruct fs, gs; iDestruct "H1" as "[(-> & ->) _]"; eauto.
 Qed.
 
 Lemma allp_fun_id_sigcc_sub: forall Delta Delta' rho,
   tycontext_sub Delta Delta' ->
-  allp_fun_id_sigcc Delta' rho |-- allp_fun_id_sigcc Delta rho.
+  allp_fun_id_sigcc Delta' rho ⊢ allp_fun_id_sigcc Delta rho.
 Proof.
   intros.
-  apply allp_derives; intros id.
-  intros w W fs u ? WU EU FS.
-  destruct H as [_ [_ [_ [_ [? _]]]]].
-  specialize (H id).
-  hnf in H.
-  rewrite FS in H. destruct H as [gs [GSA GSB]]. specialize (GSB u I).
-  destruct (W gs u _ WU EU GSA) as [b [B1 B2]].
-  exists b; split; [trivial | destruct fs; destruct gs].
-  destruct GSB as [[GSBa GCBb] _]. subst c0 t0. trivial.
+  apply bi.forall_mono; intros id.
+  iIntros "H" (fs Hid).
+  destruct H as (_ & _ & _ & _ & Hg & _).
+  specialize (Hg id); rewrite Hid /= in Hg.
+  destruct Hg as (gs & Hid' & Hsub).
+  iDestruct ("H" with "[%]") as (??) "H"; first done.
+  iExists b; iFrame "%".
+  iPoseProof Hsub as "Hsub".
+  rewrite /funspec_sub_si.
+  by destruct fs, gs; iDestruct "Hsub" as "[(-> & ->) _]".
 Qed.
 
 Lemma allp_fun_id_sub: forall Delta Delta' rho,
   tycontext_sub Delta Delta' ->
-  allp_fun_id Delta' rho |-- allp_fun_id Delta rho.
+  allp_fun_id Delta' rho ⊢ allp_fun_id Delta rho.
 Proof.
   intros.
-  apply allp_derives; intros id.
-  intros w W fs u ? WU EU FS.
-  destruct H as [_ [_ [_ [_ [? _]]]]].
-  specialize (H id).
-  hnf in H.
-  rewrite FS in H. destruct H as [gs [GSA GSB]]. specialize (GSB u I).
-  destruct (W gs u _ WU EU GSA) as [b [B1 [bb [X [hs [HS B2]]]]]]; clear W.
-  simpl in X; inv X.
-  exists bb; split; [trivial | ]. exists bb; split; [ reflexivity |].
-  exists hs; split; trivial. eapply funspec_sub_si_trans; split. apply HS. eapply pred_upclosed, GSB; auto.
+  apply bi.forall_mono; intros id.
+  iIntros "H" (fs Hid).
+  destruct H as (_ & _ & _ & _ & Hg & _).
+  specialize (Hg id); rewrite Hid /= in Hg.
+  destruct Hg as (gs & Hid' & Hsub).
+  iDestruct ("H" with "[%]") as (??) "H"; first done.
+  iExists b; iFrame "%".
+  rewrite /func_ptr_si.
+  iDestruct "H" as (???) "[#? ?]"; iExists _; iSplit; first auto; iExists _; iSplit; last done.
+  iApply funspec_sub_si_trans; eauto.
 Qed.
 
-Lemma funassert_allp_fun_id Delta rho: funassert Delta rho |-- allp_fun_id Delta rho.
-Proof. apply andp_left1.
-  apply allp_derives; intros id.
-  apply allp_derives; intros fs.
-  apply imp_derives; trivial.
-  apply exp_derives; intros b.
-  apply andp_derives; trivial.
-  eapply exp_right with (x:=b).
-  apply prop_andp_right; trivial.
-  eapply exp_right with (x:=fs).
-  apply andp_right; trivial.
-  eapply derives_trans. 2: apply funspec_sub_si_refl. trivial.
+Lemma funassert_allp_fun_id Delta rho: funassert Delta rho ⊢ <affine> allp_fun_id Delta rho ∗ funassert Delta rho.
+Proof.
+  iIntros "H"; iSplit; last done.
+  iDestruct "H" as "[H _]".
+  iIntros "!> !>" (???).
+  iDestruct ("H" with "[%]") as (??) "H"; first done.
+  iExists b; iSplit; first auto.
+  iExists b; iSplit; first auto.
+  iExists fs; iFrame.
+  iPoseProof (funspec_sub_si_refl) as "?"; auto.
 Qed.
 
 Lemma funassert_allp_fun_id_sub: forall Delta Delta' rho,
   tycontext_sub Delta Delta' ->
-  funassert Delta' rho |-- allp_fun_id Delta rho.
+  funassert Delta' rho ⊢ <affine> allp_fun_id Delta rho ∗ funassert Delta' rho.
 Proof.
-  intros. eapply derives_trans. apply funassert_allp_fun_id.
-  apply allp_fun_id_sub; trivial.
+  intros. rewrite {1}funassert_allp_fun_id.
+  apply bi.sep_mono; last done.
+  apply bi.affinely_mono, allp_fun_id_sub; trivial.
 Qed.
 
 Lemma funassert_allp_fun_id_sigcc Delta rho:
-  funassert Delta rho |-- allp_fun_id_sigcc Delta rho.
+  funassert Delta rho ⊢ <affine> allp_fun_id_sigcc Delta rho ∗ funassert Delta rho.
 Proof.
-eapply derives_trans. apply funassert_allp_fun_id.
-apply allp_fun_id_ex_implies_allp_fun_sigcc.
+  intros. rewrite {1}(funassert_allp_fun_id ⊤).
+  apply bi.sep_mono; last done.
+  apply bi.affinely_mono, allp_fun_id_ex_implies_allp_fun_sigcc.
 Qed.
 
 Lemma funassert_allp_fun_id_sigcc_sub: forall Delta Delta' rho,
   tycontext_sub Delta Delta' ->
-  funassert Delta' rho |-- allp_fun_id_sigcc Delta rho.
+  funassert Delta' rho ⊢ <affine> allp_fun_id_sigcc Delta rho ∗ funassert Delta' rho.
 Proof.
-  intros. eapply derives_trans. apply funassert_allp_fun_id_sigcc.
-  apply allp_fun_id_sigcc_sub; trivial.
-Qed.
-
-(*
-Lemma corable_jam: forall {B} {S': B -> Prop} (S: forall l, {S' l}+{~ S' l}) (P Q: B -> pred rmap),
-    (forall loc, corable (P loc)) ->
-    (forall loc, corable (Q loc)) ->
-    forall b, corable (jam S P Q b).
-Proof.
-intros.
-intro.
-unfold jam.
-simpl.
-if_tac.
-apply H.
-apply H0.
-Qed.
-*)
-Lemma prop_derives {A}{H: ageable A}{EO: Ext_ord A}:
- forall (P Q: Prop), (P -> Q) -> prop P |-- prop Q.
-Proof.
-intros. intros w ?; apply H0; auto.
+  intros. rewrite {1}funassert_allp_fun_id_sigcc.
+  apply bi.sep_mono; last done.
+  eapply bi.affinely_mono, allp_fun_id_sigcc_sub; eauto.
 Qed.
 
 Section STABILITY.
@@ -169,161 +126,117 @@ Variable CS: compspecs.
 Variables Delta Delta': tycontext.
 Hypothesis extends: tycontext_sub Delta Delta'.
 
-Lemma tc_bool_e_sub: forall b b' err rho phi,
+Lemma tc_bool_e_sub: forall b b' err rho,
   (b = true -> b' = true) ->
-  denote_tc_assert (tc_bool b err) rho phi ->
-  denote_tc_assert (tc_bool b' err) rho phi.
+  denote_tc_assert (tc_bool b err) rho ⊢
+  denote_tc_assert (tc_bool b' err) rho.
 Proof.
   intros.
   destruct b.
-  + specialize (H eq_refl); subst.
-    simpl; exact I.
-  + inversion H0.
-Qed.
-
-Lemma tc_bool_e_i:
-  forall b c rho phi,
-   b = true ->
-  app_pred (denote_tc_assert (tc_bool b c) rho) phi.
-Proof.
-intros.
-subst. apply I.
+  + rewrite H; auto.
+  + iIntros "[]".
 Qed.
 
 Lemma tc_expr_lvalue_sub: forall rho,
   typecheck_environ Delta rho ->
   forall e,
-    (tc_expr Delta e rho |-- tc_expr Delta' e rho) /\
-    (tc_lvalue Delta e rho |-- tc_lvalue Delta' e rho).
+    (tc_expr Delta e rho ⊢ tc_expr Delta' e rho) ∧
+    (tc_lvalue Delta e rho ⊢ tc_lvalue Delta' e rho).
 Proof.
-  rename extends into H.
   intros rho HHH.
-  induction e; unfold tc_expr, tc_lvalue; split; intro w; unfold prop;
-  simpl; auto;
-  try solve [destruct t as [  | [| | |] |  | [|] | | | | |]; auto].
-* destruct (access_mode t) eqn:?; auto.
-  destruct (get_var_type Delta i) eqn:?; [ | contradiction].
-  destruct H as [_ [? [_ [? _]]]].
-  assert (H8: get_var_type Delta' i = Some t0); [ | rewrite H8; unfold tc_bool; simple_if_tac; auto].
-  unfold get_var_type in *. rewrite <- H.
-  destruct ((var_types Delta)!i); auto.
-  destruct ((glob_types Delta) ! i) eqn:?; inv Heqo.
-  specialize (H0 i). hnf in H0. rewrite Heqo0 in H0. rewrite H0.
-  auto.
-* destruct (get_var_type Delta i) eqn:?; [ | contradiction].
-  destruct H as [_ [? [_ [? _]]]].
-  assert (H8: get_var_type Delta' i = Some t0); [ | rewrite H8; unfold tc_bool; simple_if_tac; auto].
-  unfold get_var_type in *. rewrite <- H.
-  destruct ((var_types Delta)!i); auto.
-  destruct ((glob_types Delta) ! i) eqn:?; inv Heqo.
-  specialize (H0 i). hnf in H0. rewrite Heqo0 in H0. rewrite H0.
-  auto.
-* destruct ((temp_types Delta)!i) as [? |] eqn:H1; [ | contradiction].
-  destruct H as [H _]. specialize (H i); hnf in H. rewrite H1 in H.
-  destruct ((temp_types Delta')!i) as [? |] eqn:H2; [ | contradiction].
-  simpl @fst; simpl @snd. subst t1; auto.
-* destruct (access_mode t) eqn:?H; intro HH; try inversion HH.
-  rewrite !denote_tc_assert_andp in HH |- *.
-  destruct HH as [[? ?] ?].
-  destruct IHe as [? _].
-  repeat split.
-  + unfold tc_expr in H1.
-    apply (H4 w).
-    simpl.
-    tauto.
-  + unfold tc_bool in H2 |- *; simple_if_tac; tauto.
-  + pose proof (H4 w H1).
-    simpl in H3 |- *.
-    unfold_lift in H3; unfold_lift.
-    exact H3.
-* destruct IHe.
-  repeat rewrite denote_tc_assert_andp.
-  intros [[? ?] ?].
-  repeat split.
-  + unfold tc_expr in H0.
-    apply (H0 w); unfold prop; auto.
-  + unfold tc_bool in *; simple_if_tac; tauto.
-  + pose proof (H0 w H2).
-    simpl in H4 |- *.
-    unfold_lift in H4; unfold_lift.
-    exact H4.
-* repeat rewrite denote_tc_assert_andp; intros [? ?]; repeat split.
-  + destruct IHe. apply (H3 w); auto.
-  + unfold tc_bool in *; simple_if_tac; tauto.
-* repeat rewrite denote_tc_assert_andp; intros [? ?]; repeat split; auto.
-  destruct IHe. apply (H2 w); auto.
-* repeat rewrite denote_tc_assert_andp; intros [[? ?] ?]; repeat split; auto.
-  + destruct IHe1 as [H8 _]; apply (H8 w); auto.
-  + destruct IHe2 as [H8 _]; apply (H8 w); auto.
-* repeat rewrite denote_tc_assert_andp; intros [? ?]; repeat split; auto.
-  + destruct IHe as [H8 _]; apply (H8 w); auto.
-* destruct (access_mode t) eqn:?; try solve [intro HH; inv HH].
-  repeat rewrite denote_tc_assert_andp. intros [? ?]; repeat split; auto.
-  + destruct IHe. apply (H3 w); auto.
-* repeat rewrite denote_tc_assert_andp; intros [? ?]; repeat split; auto.
-  + destruct IHe as [_ H8]; apply (H8 w); auto.
+  induction e; unfold tc_expr, tc_lvalue; split; auto; simpl in *.
+* unfold typecheck_expr.
+  destruct (access_mode t); try iIntros "[]".
+  destruct (get_var_type Delta i) eqn:?; [ | iIntros "[]"].
+  destruct extends as (_ & Hv & _ & Hg & _).
+  assert (get_var_type Delta' i = Some t0) as ->; auto.
+  unfold get_var_type in *. rewrite <- Hv.
+  destruct ((var_types Delta) !! i) eqn: Hi; rewrite ?Hi in Heqo |- *; auto.
+  specialize (Hg i).
+  destruct ((glob_types Delta) !! i) eqn: Hi'; rewrite ?Hi' in Hg Heqo |- *; inv Heqo.
+  by rewrite Hg.
+* unfold typecheck_lvalue.
+  destruct (get_var_type Delta i) eqn:?; [ | iIntros "[]"].
+  destruct extends as (_ & Hv & _ & Hg & _).
+  assert (get_var_type Delta' i = Some t0) as ->; auto.
+  unfold get_var_type in *. rewrite <- Hv.
+  destruct ((var_types Delta) !! i) eqn: Hi; rewrite ?Hi in Heqo |- *; auto.
+  specialize (Hg i).
+  destruct ((glob_types Delta) !! i) eqn: Hi'; rewrite ?Hi' in Hg Heqo |- *; inv Heqo.
+  by rewrite Hg.
+* unfold typecheck_expr.
+  destruct ((temp_types Delta) !! i) as [? |] eqn:H1; [ | iIntros "[]"].
+  destruct extends as [H _]. specialize (H i); hnf in H. rewrite H1 in H.
+  destruct ((temp_types Delta') !! i) as [? |] eqn:H2; subst; done.
+* unfold typecheck_expr; fold typecheck_expr.
+  destruct (access_mode t) eqn:?H; try iIntros "[]".
+  rewrite !denote_tc_assert_andp.
+  by destruct IHe as [-> _].
+* unfold typecheck_lvalue; fold typecheck_expr.
+  rewrite !denote_tc_assert_andp.
+  by destruct IHe as [-> _].
+* unfold typecheck_expr; fold typecheck_lvalue.
+  rewrite !denote_tc_assert_andp.
+  by destruct IHe as [_ ->].
+* unfold typecheck_expr; fold typecheck_expr.
+  rewrite !denote_tc_assert_andp.
+  by destruct IHe as [-> _].
+* unfold typecheck_expr; fold typecheck_expr.
+  rewrite !denote_tc_assert_andp.
+  by destruct IHe1 as [-> _], IHe2 as [-> _].
+* unfold typecheck_expr; fold typecheck_expr.
+  rewrite !denote_tc_assert_andp.
+  by destruct IHe as [-> _].
+* unfold typecheck_expr; fold typecheck_lvalue.
+  destruct (access_mode t) eqn:?H; try iIntros "[]".
+  rewrite !denote_tc_assert_andp.
+  by destruct IHe as [_ ->].
+* unfold typecheck_lvalue; fold typecheck_lvalue.
+  rewrite !denote_tc_assert_andp.
+  by destruct IHe as [_ ->].
 Qed.
 
 Lemma tc_expr_sub:
-    forall e rho, typecheck_environ Delta rho -> tc_expr Delta e rho |-- tc_expr Delta' e rho.
+    forall e rho, typecheck_environ Delta rho -> tc_expr Delta e rho ⊢ tc_expr Delta' e rho.
 Proof. intros. apply tc_expr_lvalue_sub; auto. Qed.
 
 Lemma tc_lvalue_sub:
-    forall e rho, typecheck_environ Delta rho -> tc_lvalue Delta e rho |-- tc_lvalue Delta' e rho.
+    forall e rho, typecheck_environ Delta rho -> tc_lvalue Delta e rho ⊢ tc_lvalue Delta' e rho.
 Proof. intros. apply tc_expr_lvalue_sub; auto. Qed.
 
 Lemma tc_temp_id_sub:
     forall id t e rho,
-   tc_temp_id id t Delta e rho |-- tc_temp_id id t Delta' e rho.
+   tc_temp_id id t Delta e rho ⊢ tc_temp_id id t Delta' e rho.
 Proof.
-rename extends into H.
 unfold tc_temp_id; intros.
 unfold typecheck_temp_id.
-intros w ?.  hnf in H0|-*.
-destruct H as [? _]. specialize (H id).
-destruct ((temp_types Delta)! id); try contradiction.
-destruct ((temp_types Delta')! id); try contradiction.
-destruct H; subst.
-rewrite !denote_tc_assert_andp in H0 |- *.
-split.
-+ eapply tc_bool_e_sub; [| exact (proj1 H0)].
-  exact (fun x => x).
-+ destruct H0 as [? _].
-  apply tc_bool_e in H.
-  eapply neutral_isCastResultType.
-  exact H.
+destruct extends as (? & _); specialize (H id).
+destruct (_ !! _); try iIntros "[]".
+destruct (_ !! _); subst; done.
 Qed.
 
 Lemma tc_temp_id_load_sub:
    forall id t v rho,
-   tc_temp_id_load id t Delta v rho |--    tc_temp_id_load id t Delta' v rho.
+   tc_temp_id_load id t Delta v rho ⊢ tc_temp_id_load id t Delta' v rho.
 Proof.
-rename extends into H.
-unfold tc_temp_id_load; simpl; intros.
-intros w [tto [? ?]]; exists tto.
-destruct H as [H _].
-specialize (H id); hnf in H.
-rewrite H0 in H.
-destruct ((temp_types Delta')! id); try contradiction.
-destruct H; subst; auto.
+unfold tc_temp_id_load; intros.
+apply bi.pure_mono; intros (? & Hid & ?).
+destruct extends as (He & _); specialize (He id); rewrite Hid in He.
+clear Hid; destruct (_ !! _); [subst; eauto | contradiction].
 Qed.
 
 Lemma tc_exprlist_sub:
-  forall e t rho, typecheck_environ Delta rho -> tc_exprlist Delta e t rho |-- tc_exprlist Delta' e t rho.
+  forall e t rho, typecheck_environ Delta rho -> tc_exprlist Delta e t rho ⊢ tc_exprlist Delta' e t rho.
 Proof.
   intros.
-  revert t; induction e; destruct t;  simpl; auto.
-  specialize (IHe t).
-  unfold tc_exprlist.
-  intro w; unfold prop.
-  simpl.
-  repeat rewrite denote_tc_assert_andp.
-  intros [[? ?] ?]; repeat split; auto.
-  + apply (tc_expr_sub _ _ H w H0); auto.
+  revert t; induction e; destruct t; auto.
+  unfold tc_exprlist, typecheck_exprlist; fold typecheck_exprlist.
+  setoid_rewrite denote_tc_assert_andp.
+  by setoid_rewrite IHe; setoid_rewrite tc_expr_sub.
 Qed.
 
 Definition typeof_temp (Delta: tycontext) (id: ident) : option type :=
- match (temp_types Delta) ! id with
+ match (temp_types Delta) !! id with
  | Some t => Some t
  | None => None
  end.
@@ -337,11 +250,10 @@ intros.
 destruct extends as [? _].
 specialize (H0 i).
 unfold typeof_temp in *.
-destruct ((temp_types Delta) ! i); inv H.
-destruct ((temp_types Delta') ! i); try contradiction.
-destruct H0; subst; auto.
+destruct (_ !! _); inv H.
+destruct (_ !! _); subst; done.
 Qed.
 
 End STABILITY.
 
-End invs.
+End mpred.
diff --git a/veric/Clight_base.v b/veric/Clight_base.v
index d82393d734..00b4c466d9 100644
--- a/veric/Clight_base.v
+++ b/veric/Clight_base.v
@@ -3,7 +3,7 @@ Require Export compcert.export.Clightdefs.
 Require Export VST.veric.base.
 Require Export compcert.cfrontend.Ctypes.
 Require Export compcert.cfrontend.Cop.
-Require Export compcert.cfrontend.Clight. 
+Require Export compcert.cfrontend.Clight.
 
 Require Export EqNat.  (* do we need this? *)
 
diff --git a/veric/Clight_core.v b/veric/Clight_core.v
index eb1bc621e1..357f89854b 100644
--- a/veric/Clight_core.v
+++ b/veric/Clight_core.v
@@ -335,14 +335,70 @@ Program Definition cl_core_sem (ge: genv) :
   @CoreSemantics CC_core mem :=
   @Build_CoreSemantics _ _
     (*deprecated cl_init_mem*)
-    (fun _ m c m' v args => cl_initial_core ge v args = Some c(* /\ Mem.arg_well_formed args m /\ m' = m *))
+    (fun _ m c m' v args => cl_initial_core ge v args = Some c(* /\ Mem.arg_well_formed args m *) /\ m' = m)
     (fun c _ => cl_at_external c)
     (fun ret c _ => cl_after_external ret c)
-    (fun c _ =>  cl_halted c <> None)
+    (fun c _ =>  cl_halted c <> None) (* Why don't we use the int argument of halted? *)
     (cl_step ge)
     (cl_corestep_not_halted ge)
     (cl_corestep_not_at_external ge).
 
+Ltac fun_tac :=
+  match goal with
+  | H: ?A = Some _, H': ?A = Some _ |- _ => inversion2 H H'
+  | H: Clight.eval_expr ?ge ?e ?le ?m ?A _,
+    H': Clight.eval_expr ?ge ?e ?le ?m ?A _ |- _ =>
+        apply (eval_expr_fun H) in H'; subst
+  | H: Clight.eval_exprlist ?ge ?e ?le ?m ?A ?ty _,
+    H': Clight.eval_exprlist ?ge ?e ?le ?m ?A ?ty _ |- _ =>
+        apply (eval_exprlist_fun H) in H'; subst
+  | H: Clight.eval_lvalue ?ge ?e ?le ?m ?A _ _ _,
+    H': Clight.eval_lvalue ?ge ?e ?le ?m ?A _ _ _ |- _ =>
+        apply (eval_lvalue_fun H) in H'; inv H'
+  | H: Clight.assign_loc ?ge ?ty ?m ?b ?ofs ?bf ?v _,
+    H': Clight.assign_loc ?ge ?ty ?m ?b ?ofs ?bf ?v _ |- _ =>
+        apply (assign_loc_fun H) in H'; inv H'
+  | H: Clight.deref_loc ?ty ?m ?b ?ofs _,
+    H': Clight.deref_loc ?ty ?m ?b ?ofs _ |- _ =>
+        apply (deref_loc_fun H) in H'; inv H'
+  | H: Clight.alloc_variables ?ge ?e ?m ?vl _ _,
+    H': Clight.alloc_variables ?ge ?e ?m ?vl _ _ |- _ =>
+        apply (alloc_variables_fun H) in H'; inv H'
+  | H: Clight.bind_parameters ?ge ?e ?m ?p ?vl _,
+    H': Clight.bind_parameters ?ge ?e ?m ?p ?vl _ |- _ =>
+        apply (bind_parameters_fun H) in H'; inv H'
+  | H: Senv.find_symbol ?ge _ = Some ?b,
+    H': Senv.find_symbol ?ge _ = Some ?b |- _ =>
+       apply (inv_find_symbol_fun H) in H'; inv H'
+  | H: Events.eventval_list_match ?ge _ ?t ?v,
+    H': Events.eventval_list_match ?ge _ ?t ?v |- _ =>
+       apply (eventval_list_match_fun H) in H'; inv H'
+ end.
+Lemma cl_corestep_fun: forall ge m q m1 q1 m2 q2,
+    cl_step ge q m q1 m1 ->
+    cl_step ge q m q2 m2 ->
+    (q1,m1)=(q2,m2).
+Proof.
+intros.
+inv H; inv H0; repeat fun_tac; auto;
+repeat match goal with H: _ = _ \/ _ = _ |- _ => destruct H; try discriminate end;
+try contradiction.
+-
+inversion2 H1 H16; fun_tac; auto.
+-
+rewrite andb_true_iff in H15; destruct H15.
+pose proof (ef_deterministic_fun _ H0 _ _ _ _ _ _ _ _ _ H3 H17).
+inv H4; auto.
+-
+inv H1. inv H8.
+fun_tac.
+pose proof (alloc_variables_fun H3 H7). inv H8. auto.
+-
+rewrite andb_true_iff in H1; destruct H1.
+pose proof (ef_deterministic_fun _ H0 _ _ _ _ _ _ _ _ _ H2 H13).
+inv H1; auto.
+Qed.
+
 (*Clight_core is also a memsem!*)
 Lemma alloc_variables_mem_step: forall cenv vars m e e2 m'
       (M: alloc_variables cenv e m vars e2 m'), mem_step m m'.
diff --git a/veric/Clight_evsem.v b/veric/Clight_evsem.v
index 6b947f3bb8..5e528fdfbb 100644
--- a/veric/Clight_evsem.v
+++ b/veric/Clight_evsem.v
@@ -3,14 +3,14 @@
 (* Event semantics for ClightCore *)
 
 Require Import compcert.common.Memory.
-Require Import VST.veric.compcert_rmaps.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.res_predicates.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key". 
 
 Require Import List. Import ListNotations.
-Import compcert.lib.Maps.
 
-Import Ctypes. 
+Import Ctypes.
 Require Import compcert.cfrontend.Clight.
 Import Cop.
 Arguments sizeof {env} !t / .
@@ -20,6 +20,8 @@ Require Import VST.veric.Clight_core.
 Require Import VST.sepcomp.semantics.
 Require Import VST.sepcomp.event_semantics.
 
+Open Scope Z.
+
 Lemma extcall_malloc_sem_inv: forall g v m t res m2 (E:Events.extcall_malloc_sem g v m t res m2),
   exists m1 b (sz : ptrofs), v=[Vptrofs sz] /\ t= Events.E0 /\ res=Vptr b Ptrofs.zero /\
                            Mem.alloc m (- size_chunk Mptr) (Ptrofs.unsigned sz) = (m1, b) /\
@@ -96,13 +98,13 @@ Proof.
   - inv H. intuition. subst. apply deref_locT_bitfield; constructor; auto.
 Qed.
 
-Inductive alloc_variablesT (g: genv): PTree.t (block * type) -> mem -> list (ident * type) ->
-                                      PTree.t (block * type) -> mem -> (list mem_event) -> Prop :=
+Inductive alloc_variablesT (g: genv): Maps.PTree.t (block * type) -> mem -> list (ident * type) ->
+                                      Maps.PTree.t (block * type) -> mem -> (list mem_event) -> Prop :=
     alloc_variablesT_nil : forall e m, alloc_variablesT g e m nil e m nil
   | alloc_variablesT_cons :
       forall e m id ty vars m1 b1 m2 e2 T,
         Mem.alloc m 0 (@sizeof g ty) = (m1, b1) ->
-        alloc_variablesT g (PTree.set id (b1, ty) e) m1 vars e2 m2 T ->
+        alloc_variablesT g (Maps.PTree.set id (b1, ty) e) m1 vars e2 m2 T ->
         alloc_variablesT g e m ((id, ty) :: vars) e2 m2 (Alloc b1 0 (@sizeof g ty) :: T).
 
 Lemma alloc_variablesT_ax1 g: forall e m l e' m' T (A:alloc_variablesT g e m l e' m' T),
@@ -145,7 +147,7 @@ Variable e: env.
 Variable le: temp_env.
 Variable m: mem.
 
-Inductive eval_exprT: expr -> val -> list mem_event-> Prop :=
+Inductive eval_exprT: expr -> val -> list mem_event -> Prop :=
   | evalT_Econst_int:   forall i ty,
       eval_exprT (Econst_int i ty) (Vint i) nil
   | evalT_Econst_float:   forall f ty,
@@ -155,7 +157,7 @@ Inductive eval_exprT: expr -> val -> list mem_event-> Prop :=
   | evalT_Econst_long:   forall i ty,
       eval_exprT (Econst_long i ty) (Vlong i) nil
   | evalT_Etempvar:  forall id ty v,
-      le!id = Some v ->
+      le!!id = Some v ->
       eval_exprT (Etempvar id ty) v nil
   | evalT_Eaddrof: forall a ty loc ofs T,
       eval_lvalueT a loc ofs Full T ->
@@ -186,10 +188,10 @@ Inductive eval_exprT: expr -> val -> list mem_event-> Prop :=
 
 with eval_lvalueT: expr -> block -> ptrofs -> bitfield -> list mem_event-> Prop :=
   | evalT_Evar_local:   forall id l ty,
-      e!id = Some(l, ty) ->
+      e!!id = Some(l, ty) ->
       eval_lvalueT (Evar id ty) l Ptrofs.zero Full nil
   | evalT_Evar_global: forall id l ty,
-      e!id = None ->
+      e!!id = None ->
       Genv.find_symbol g id = Some l ->
       eval_lvalueT (Evar id ty) l Ptrofs.zero Full nil
   | evalT_Ederef: forall a ty l ofs T,
@@ -198,13 +200,13 @@ with eval_lvalueT: expr -> block -> ptrofs -> bitfield -> list mem_event-> Prop
  | evalT_Efield_struct:   forall a i ty l ofs id co att delta bf T,
       eval_exprT a (Vptr l ofs) T ->
       typeof a = Tstruct id att ->
-      g.(genv_cenv)!id = Some co ->
+      g.(genv_cenv)!!id = Some co ->
       field_offset g i (co_members co) = Errors.OK (delta, bf) ->
       eval_lvalueT (Efield a i ty) l (Ptrofs.add ofs (Ptrofs.repr delta)) bf T
  | evalT_Efield_union:   forall a i ty l ofs id co att delta bf T,
       eval_exprT a (Vptr l ofs) T ->
       typeof a = Tunion id att ->
-      g.(genv_cenv)!id = Some co ->
+      g.(genv_cenv)!!id = Some co ->
       union_field_offset g i (co_members co) = Errors.OK (delta, bf) ->
       eval_lvalueT (Efield a i ty) l (Ptrofs.add ofs (Ptrofs.repr delta)) bf T.
 
@@ -219,7 +221,7 @@ Inductive eval_exprTlist: list expr -> list type -> list val -> list mem_event->
       eval_exprT a v1 T1 ->
       sem_cast v1 (typeof a) ty m = Some v2 ->
       eval_exprTlist bl tyl vl T2 ->
-      eval_exprTlist (a :: bl) (ty:: tyl) (v2 :: vl) (T1++T2).
+      eval_exprTlist (a :: bl) (ty :: tyl) (v2 :: vl) (T1++T2).
 
 Lemma eval_exprT_ax1: forall a v T, eval_exprT a v T -> eval_expr g e le m a v
 with eval_lvalueT_ax1: forall a b z bf T, eval_lvalueT a b z bf T -> eval_lvalue g e le m a b z bf.
@@ -311,8 +313,8 @@ Lemma eval_exprTlist_fun: forall es ts vs1 T1 (E1:eval_exprTlist es ts vs1 T1)
                           vs2 T2 (E2:eval_exprTlist es ts vs2 T2), (vs1,T1)=(vs2,T2).
 Proof.
   intros es ts vs1 T1 E; induction E; simpl; intros; inv E2; trivial.
-  exploit eval_exprT_fun. apply H. apply H5. intros X; inv X. rewrite H8 in H0; inv H0.
-  apply IHE in H9; congruence. 
+  exploit eval_exprT_fun. apply H. apply H5. intros X; inv X.
+  apply IHE in H9; congruence.
 Qed.
 
 End EXPR_T.
@@ -452,7 +454,7 @@ Inductive cl_evstep (ge: Clight.genv): forall (q: CC_core) (m: mem) (T:list mem_
   | evstep_set:   forall f id a k e le m v T,
       eval_exprT ge e le m a v T ->
       cl_evstep ge (State f (Sset id a) k e le) m T
-              (State f Sskip k e (PTree.set id v le)) m
+              (State f Sskip k e (Maps.PTree.set id v le)) m
 
   | evstep_call:   forall f optid a al k e le m tyargs tyres cconv vf vargs fd T1 T2,
       classify_fun (typeof a) = fun_case_f tyargs tyres cconv ->
@@ -644,7 +646,6 @@ Qed.
          induction K; simpl; intros; try solve [ inv K'; eauto ].
  - inv K'. exploit eval_exprT_fun. apply H14. apply H0. intros X; inv X.
     exploit eval_lvalueT_fun. apply H13. apply H. intros X; inv X.
-    rewrite H15 in H1; inv H1.
     exploit assign_locT_fun. apply H16. apply H2. intros X; inv X; trivial.
    destruct H12; discriminate.
    destruct H12; discriminate.
@@ -655,7 +656,6 @@ Qed.
     + rewrite H15 in H; inv H.
       exploit eval_exprT_fun. eassumption. apply H0. intros X; inv X.
       exploit eval_exprTlist_fun. eassumption. apply H1. intros X; inv X.
-      rewrite H18 in H2; inv H2.
       rewrite H19 in H3; inv H3. auto.
     + destruct H13; discriminate.
     + destruct H13; discriminate.
@@ -671,7 +671,7 @@ Qed.
     destruct H10; discriminate.
  - destruct H; subst x; inv K'; auto. contradiction.
  - inv K'; auto; contradiction.
- - inv K'; try solve [destruct H9; discriminate]. inversion2 H H8. auto.
+ - inv K'; try solve [destruct H9; discriminate]. inversion H. auto.
  - inv K'; try solve [destruct H11; discriminate].
     exploit eval_exprT_fun. eassumption. eapply H. intros X; inv X. auto.
  - inv K'; try contradiction. auto.
@@ -698,7 +698,7 @@ Qed.
       eapply ev_elim_app; eauto.
   + apply eval_exprTlist_elim in H0.
       eapply ev_elim_app; eauto.
-      apply proj2_sig.
+      by destruct (inline_external_call_mem_events).
   + eexists; split; eauto. reflexivity.
   + apply eval_exprT_elim in H.
       eapply ev_elim_app; eauto.
@@ -779,23 +779,22 @@ Proof.
   destruct Archi.ptr64 eqn: H64.
   - assert (Int64.unsigned (Ptrofs.to_int64 o1) = Int64.unsigned (Ptrofs.to_int64 o2)) by congruence.
     unfold Ptrofs.to_int64 in *.
-    rewrite Ptrofs.modulus_eq64 in * by auto.
-    rewrite !Int64.unsigned_repr in * by (unfold Int64.max_unsigned; lia); auto.
+    rewrite -> Ptrofs.modulus_eq64 in * by auto.
+    rewrite -> !Int64.unsigned_repr in * by (unfold Int64.max_unsigned; lia); auto.
   - assert (Int.unsigned (Ptrofs.to_int o1) = Int.unsigned (Ptrofs.to_int o2)) by congruence.
     unfold Ptrofs.to_int in *.
-    rewrite Ptrofs.modulus_eq32 in * by auto.
-    rewrite !Int.unsigned_repr in * by (unfold Int.max_unsigned; lia); auto.
+    rewrite -> Ptrofs.modulus_eq32 in * by auto.
+    rewrite -> !Int.unsigned_repr in * by (unfold Int.max_unsigned; lia); auto.
 Qed.
 
 Lemma builtin_event_determ ef m vargs T1 (BE1: builtin_event ef m vargs T1) T2 (BE2: builtin_event ef m vargs T2): T1=T2.
-inversion BE1; inv BE2; try discriminate; try contradiction; simpl in *; trivial.
+inversion BE1; inversion BE2; subst; try discriminate; try contradiction; simpl in *; trivial.
 + assert (Vptrofs n0 = Vptrofs n) as H by congruence.
-  rewrite H; rewrite (Vptrofs_inj _ _ H) in *.
-  rewrite ALLOC0 in ALLOC; inv ALLOC; trivial.
+  rewrite H; rewrite -> (Vptrofs_inj _ _ H) in *.
+  rewrite ALLOC0 in ALLOC; inversion ALLOC; trivial.
 + inv H5.
-  rewrite LB0 in LB; inv LB. rewrite <- SZ in SZ0. rewrite (Vptrofs_inj _ _ SZ0); trivial.
-+ inv H3; inv H5.
-  rewrite LB0 in LB; inv LB; trivial.
+  rewrite <- SZ in SZ0. rewrite (Vptrofs_inj _ _ SZ0); trivial.
++ inv H3; trivial.
 Qed.
 
 Inductive ev_star ge: state -> mem -> _ -> state -> mem -> Prop :=
@@ -901,7 +900,7 @@ Proof.
   unfold Mem.storebytes; intros.
   destruct H as (? & ? & ?).
   if_tac in H0; inv H0.
-  rewrite if_true by (intros ??; auto).
+  rewrite -> if_true by (intros ??; auto).
   do 2 eexists; eauto.
   split; auto; simpl.
   rewrite H; auto.
@@ -921,7 +920,7 @@ Proof.
   injection Halloc1; injection Halloc2; intros; subst.
   destruct H as (? & ? & ?).
   do 2 eexists; eauto.
-  split; [|split]; simpl; rewrite ?H, ?H0; auto.
+  split; [|split]; simpl; rewrite ?H ?H0; auto.
   intros.
   pose H2 as Hperm; eapply Mem.perm_alloc_inv in Hperm; eauto.
   if_tac in Hperm.
@@ -945,12 +944,12 @@ Proof.
   destruct H as (? & ? & ?).
   pose proof Hfree1 as Hfree; unfold Mem.free in Hfree |- *.
   if_tac in Hfree; inv Hfree.
-  rewrite if_true by (intros ??; auto).
+  rewrite -> if_true by (intros ??; auto).
   do 2 eexists; eauto.
   split; auto; split; auto; intros.
   pose proof (Mem.perm_free_3 _ _ _ _ _ Hfree1 _ _ _ _ H3) as Hperm.
   apply H1 in Hperm.
-  eapply Mem.perm_free_inv in Hperm; [|unfold Mem.free; rewrite if_true by (intros ??; eauto); eauto].
+  eapply Mem.perm_free_inv in Hperm; [|unfold Mem.free; rewrite -> if_true by (intros ??; eauto); eauto].
   destruct Hperm as [[] | ?]; auto; subst.
   exfalso; eapply Mem.perm_free_2; eauto.
 Qed.
diff --git a/veric/Clight_initial_world.v b/veric/Clight_initial_world.v
index cefa8e2937..3407488a71 100644
--- a/veric/Clight_initial_world.v
+++ b/veric/Clight_initial_world.v
@@ -1,51 +1,30 @@
+Require Import VST.zlist.sublist.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.juicy_base.
+Require Import VST.veric.external_state.
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.juicy_mem_lemmas.
-
 Require Import VST.veric.extend_tc.
 Require Import VST.veric.Clight_seplog.
 Require Import VST.veric.Clight_assert_lemmas.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.tycontext.
 Require Import VST.veric.expr2.
 Require Import VST.veric.expr_lemmas.
 
 Require Export VST.veric.initial_world.
-Import compcert.lib.Maps.
 
 Import Clight.
 
-Local Open Scope pred.
-
 #[local] Obligation Tactic := idtac.
 
-Notation initial_core' := (initial_core' function).
-
-(* This version starts with an empty ghost. 
-Program Definition initial_core (ge: Genv.t fundef type) (G: funspecs) (n: nat): rmap :=
-  proj1_sig (make_rmap (initial_core' ge G n) nil n _ eq_refl).
-Next Obligation.
-intros.
-extensionality loc; unfold compose, initial_core'.
-if_tac; [ | simpl; auto].
-destruct (Genv.invert_symbol ge (fst loc)); [ | simpl; auto].
-destruct (find_id i G); [ | simpl; auto].
-destruct f.
-unfold resource_fmap.
-f_equal.
-simpl.
-f_equal.
-change R.approx with approx.
-extensionality i0 ts b rho.
-rewrite fmap_app.
-pattern (approx n) at 7 8 9.
-rewrite <- approx_oo_approx.
-auto.
-Qed.*)
-Notation initial_core := (@initial_core function).
+Notation initial_core m := (initial_core m (F := function)).
+Notation prog_funct := (@prog_funct function).
+Notation prog_vars := (@prog_vars function).
 
-Notation initial_core_ext := (@initial_core_ext  function).
+Section mpred.
 
-Notation prog_funct := (@prog_funct function).
+Context `{!heapGS Σ}.
 
 Inductive match_fdecs: list  (ident * Clight.fundef) -> funspecs -> Prop :=
 | match_fdecs_nil: match_fdecs nil nil
@@ -72,7 +51,7 @@ revert G; induction dl; simpl; intros.
 inv H0. inv H.
 destruct a as [i' [?|?]].
 inv H0.
-simpl in H; if_tac in H. subst i'; inv H.
+simpl in H2; if_tac in H2. subst i'; inv H2.
 eauto.
 destruct (IHdl G0) as [fd [? ?]]; auto.
 exists fd; split; auto.
@@ -84,612 +63,282 @@ exists fd; split; auto.
 *)
 Qed.
 
-Lemma initial_core_ok: forall (prog: program) G n m,
-      list_norepet (prog_defs_names prog) ->
-      match_fdecs (prog_funct prog) G ->
-      Genv.init_mem prog = Some m ->
-     initial_rmap_ok m (initial_core (Genv.globalenv prog) G n).
+(*Lemma initial_jm_without_locks prog m:
+  Genv.init_mem prog = Some m ->
+  (* mem_auth m ∗ *) inflate_initial_mem m ⊢ no_locks.
 Proof.
-intros.
-rename H1 into Hm.
-intros [b z]. simpl.
-unfold initial_core; simpl.
-rewrite <- core_resource_at.
-rewrite resource_at_make_rmap.
-unfold initial_core'.
-simpl in *.
-change fcore with (@core _ _ (fsep_sep Sep_resource)).
-if_tac; [ | rewrite core_NO; auto].
-case_eq (@Genv.invert_symbol (Ctypes.fundef function) type
-       (@Genv.globalenv (Ctypes.fundef function) type prog) b);
-   intros;  try now (rewrite core_NO; auto).
-case_eq (find_id i G); intros; [ | rewrite core_NO; auto].
-apply Genv.invert_find_symbol in H2.
-pose proof (Genv.find_symbol_not_fresh _ _ Hm H2).
-unfold valid_block in H4.
-split; intros.
-contradiction.
-destruct (match_fdecs_exists_Gfun _ _ _ _ H3 H0) as [fd [? _]].
-destruct f.
-split; auto.
-subst z.
-destruct (find_symbol_globalenv _ _ _ H H2) as [RANGE [d ?]].
-assert (d = Gfun fd). {
-  clear - H H5 H1.
-  unfold prog_defs_names in H.
-  change (AST.prog_defs prog) with (prog_defs prog) in H.
-  forget (prog_defs prog) as dl. forget (Z.to_nat (Z.pos b-1)) as n.
-  revert dl H H5 H1; induction n; simpl; intros.
-  destruct dl; inv H1.
-  inv H. simpl in H5.
-  destruct H5. inv H; auto.
-  apply (in_map (@fst ident (globdef fundef type))) in H. simpl in H;  contradiction.
-  destruct dl; inv H1. inv H.
-  simpl in H5. destruct H5. subst.
-  clear - H2 H3. apply nth_error_in in H2.
-  apply (in_map (@fst ident (globdef fundef type))) in H2. simpl in *;  contradiction.
-  apply (IHn dl); auto.
-} (* end assert d = Gfun fd *)
-subst d.
-clear H5.
-clear - RANGE H2 H1 H Hm.
-unfold Genv.init_mem in Hm.
-forget (Genv.globalenv prog) as ge.
-change (AST.prog_defs prog) with (prog_defs prog) in Hm.
-forget (prog_defs prog) as dl.
-rewrite <- (rev_involutive dl) in H1,Hm.
-rewrite nth_error_rev in H1.
-2 : { rewrite rev_length. clear - RANGE.
-      destruct RANGE.
-      apply inj_lt_iff. rewrite Z2Nat.id by lia. lia. }
-rename H1 into H5.
-replace (length (rev dl) - Z.to_nat (Z.pos b - 1) - 1)%nat
- with (length (rev dl) - Z.to_nat (Z.pos b))%nat in H5.
-2 : { rewrite rev_length.
-      clear - RANGE.
-      replace (Z.to_nat (Z.pos b-1)) with (Z.to_nat (Z.pos b) - 1)%nat.
-      assert (Z.to_nat (Z.pos b) <= length dl)%nat.
-      destruct RANGE.
-      apply inj_le_iff. rewrite Z2Nat.id by lia. auto.
-      assert (Z.to_nat (Z.pos b) > 0)%nat. apply inj_gt_iff.
-      rewrite Z2Nat.id by lia.  simpl. lia.
-      lia. destruct RANGE as [? _].
-      apply nat_of_Z_lem1.
-      assert (Z.to_nat (Z.pos b) > 0)%nat. apply inj_gt_iff. simpl.
-      pose proof (Pos2Nat.is_pos b); lia.
-      lia. }
-assert (0 < Z.to_nat (Z.pos b) <= length dl)%nat.
-{ clear - RANGE. lia. }
-clear RANGE; rename H0 into RANGE.
-rewrite Z2Nat.inj_pos in *.
-rewrite <- rev_length in RANGE.
-forget (rev dl) as dl'; clear dl; rename dl' into dl.
-destruct RANGE.
-rewrite alloc_globals_rev_eq in Hm.
-revert m Hm H1 H5; induction dl; intros.
-inv H5.
-simpl in H1,Hm.
-invSome.
-specialize (IHdl _ Hm).
-destruct (eq_dec (Pos.to_nat b) (S (length dl))).
-+ rewrite e, Nat.sub_diag in H5. simpl in H5.
-  inversion H5; clear H5; subst a.
-  apply alloc_globals_rev_nextblock in Hm.
-  rewrite Zlength_correct in Hm.
-  rewrite <- inj_S in Hm. rewrite <- e in Hm.
-  rewrite positive_nat_Z in Hm.  rewrite Pos2Z.id in Hm.
-  subst b.
-  clear IHdl H1 H0. clear dl e.
-  unfold Genv.alloc_global in H6.
-  revert H6; case_eq (alloc m0 0 1); intros.
-  unfold drop_perm in H6.
-  destruct (range_perm_dec m1 b 0 1 Cur Freeable).
-  unfold max_access_at, access_at; inv H6.
-  simpl. apply alloc_result in H0. subst b.
-  rewrite PMap.gss.
-  simpl. auto.
-  inv H6.
-+ destruct IHdl.
-  lia.
-  replace (length (a::dl) - Pos.to_nat b)%nat with (S (length dl - Pos.to_nat b))%nat in H5.
-  apply H5.
-  simpl. destruct (Pos.to_nat b); lia.
-  assert (b < nextblock m0)%positive.
-  apply alloc_globals_rev_nextblock in Hm.
-  rewrite Zlength_correct in Hm. clear - Hm n H1.
-  rewrite Hm.
-  apply Pos2Nat.inj_lt.
-  pattern Pos.to_nat at 1; rewrite <- Z2Nat.inj_pos.
-  rewrite Z2Pos.id by lia.
-  rewrite Z2Nat.inj_succ by lia.
-  rewrite Nat2Z.id. lia.
-  destruct (alloc_global_old _ _ _ _ H6 (b,0)) as [? ?]; auto.
-  unfold max_access_at.
-  rewrite <- H8.
-  split; auto.
+  rewrite /initial_mem /no_locks.
+  iIntros "(%m & %Hinit & Hm)" (?????).
+  iApply (bi.impl_intro_r with "Hm"); iIntros "H".
+Abort.*)
+
+(* How to relate Gamma to funspecs in memory, once we are outside the
+   semax proofs?  We define 'matchfunspecs' which will be satisfied by
+   the initial memory, and preserved under steps. *)
+
+Definition matchfunspecs (ge : genv) (G : funspecs) : mpred :=
+  ∀ b:block, ∀ fs: funspec,
+  func_at fs (b,0%Z) -∗
+  ∃ id:ident, ∃ fs0: funspec, 
+   ⌜Genv.find_symbol ge id = Some b /\ find_id id G = Some fs0⌝ ∧
+     ◇ funspec_sub_si fs0 fs.
+
+Lemma init_funspecs_matchfunspecs prog m G:
+  funspec_auth (init_funspecs m (globalenv prog) G) ⊢ matchfunspecs (globalenv prog) G.
+Proof.
+  rewrite /matchfunspecs.
+  iIntros "H" (??) "f".
+  iPoseProof (func_at_auth with "H f") as "H".
+  rewrite option_equivI init_funspecs_lookup /funspec_of_loc /=.
+  destruct (Pos.ltb_spec0 b (nextblock m)); last done.
+  destruct (Genv.invert_symbol _ _) eqn: Hinv; last done.
+  apply Genv.invert_find_symbol in Hinv.
+  destruct (find_id _ _) eqn: Hfind; last done.
+  iExists _, _; iSplit; first done.
+  by iApply funspec_sub_si_ne.
 Qed.
 
-Definition initial_jm (prog: program) m (G: funspecs) (n: nat)
-        (H: Genv.init_mem prog = Some m)
-        (H1: list_norepet (prog_defs_names prog))
-        (H2: match_fdecs (prog_funct prog) G) : juicy_mem :=
-  initial_mem m (initial_core (Genv.globalenv prog) G n)
-           (initial_core_ok _ _ _ m H1 H2 H).
+Lemma prog_funct'_incl : forall {F V} (l : list (ident * globdef F V)), incl (map fst (prog_funct' l)) (map fst l).
+Proof.
+  induction l; simpl.
+  - apply incl_nil_l.
+  - destruct a, g; simpl.
+    + by apply incl_same_head.
+    + by apply incl_tl.
+Qed.
 
-Lemma initial_jm_age (prog: program) m (G: funspecs) (n : nat)
-        (H: Genv.init_mem prog = Some m)
-        (H1: list_norepet (prog_defs_names prog))
-        (H2: match_fdecs (prog_funct prog) G) :
-age
-    (initial_mem m (initial_core (Genv.globalenv prog) G (S n)) (initial_core_ok _ _ _ m H1 H2 H))
-    (initial_mem m (initial_core (Genv.globalenv prog) G    n ) (initial_core_ok _ _ _ m H1 H2 H)).
+Lemma prog_funct_norepet : forall (prog : program), list_norepet (prog_defs_names prog) -> list_norepet (map fst (prog_funct prog)).
 Proof.
-apply age1_juicy_mem_unpack''; [ | reflexivity].
-simpl.
-unfold inflate_initial_mem in *.
-match goal with |- context [ proj1_sig ?x ] => destruct x as (r & lev & bah & Hg1); simpl end.
-match goal with |- context [ proj1_sig ?x ] => destruct x as (r' & lev' & bah' & Hg2); simpl end.
-apply rmap_age_i.
-rewrite lev,lev'.
-unfold initial_core; simpl.
-rewrite !level_make_rmap. auto.
-intro loc.
-rewrite bah, bah'.
-unfold inflate_initial_mem'.
-destruct (access_at m loc Cur); [ | reflexivity].
-destruct p; unfold resource_fmap; f_equal; try apply preds_fmap_NoneP.
-unfold initial_core.
-rewrite !resource_at_make_rmap.
-unfold initial_core'.
-if_tac; auto.
-unfold fundef.
-destruct (Genv.invert_symbol (Genv.globalenv (program_of_program prog))
-        (fst loc)); auto.
-destruct (find_id i G); auto.
-destruct f; auto.
-f_equal.
-simpl.
-f_equal.
-rewrite lev'.
-unfold initial_core.
-rewrite level_make_rmap.
-extensionality ts x b rho.
-rewrite fmap_app.
-match goal with
-| |- ?A (?B ?C) = _ => change (A (B C)) with ((A oo B) C)
-end.
-rewrite approx_oo_approx' by lia.
-rewrite approx'_oo_approx by lia.
-auto.
-rewrite Hg1, Hg2.
-unfold initial_core; rewrite !ghost_of_make_rmap; auto.
+  destruct prog; rewrite /prog_funct /prog_defs_names /=.
+  clear; induction prog_defs; auto; simpl.
+  inversion 1; subst.
+  destruct a, g; auto; simpl.
+  constructor; auto.
+  intros ?%prog_funct'_incl; done.
 Qed.
 
-Lemma initial_core_ext_ok: forall {Z} (ora : Z) (prog: program) G n m,
-      list_norepet (prog_defs_names prog) ->
-      match_fdecs (prog_funct prog) G ->
-      Genv.init_mem prog = Some m ->
-     initial_rmap_ok m (initial_core_ext ora (Genv.globalenv prog) G n).
+Lemma match_ids : forall fs G i, match_fdecs fs G -> In i (map fst fs) ↔ In i (map fst G).
 Proof.
-intros.
-rename H1 into Hm.
-intros [b z]. simpl.
-unfold initial_core_ext; simpl.
-rewrite <- core_resource_at.
-rewrite resource_at_make_rmap.
-unfold initial_core'.
-simpl in *.
-change fcore with (@core _ _ (fsep_sep Sep_resource)).
-if_tac; [ | rewrite core_NO; auto].
-case_eq (@Genv.invert_symbol (Ctypes.fundef function) type (@Genv.globalenv (Ctypes.fundef function) type prog) b);
-   intros;  try now (rewrite core_NO; auto).
-case_eq (find_id i G); intros; [ | rewrite core_NO; auto].
-apply Genv.invert_find_symbol in H2.
-pose proof (Genv.find_symbol_not_fresh _ _ Hm H2).
-unfold valid_block in H4.
-split; intros.
-contradiction.
-destruct (match_fdecs_exists_Gfun _ _ _ _ H3 H0) as [fd [? _]].
-destruct f.
-split; auto.
-subst z.
-destruct (find_symbol_globalenv _ _ _ H H2) as [RANGE [d ?]].
-assert (d = Gfun fd).
-clear - H H5 H1.
-unfold prog_defs_names in H.
-change (AST.prog_defs prog) with (prog_defs prog) in H.
-forget (prog_defs prog) as dl. forget (Z.to_nat (Z.pos b-1)) as n.
-revert dl H H5 H1; induction n; simpl; intros.
-destruct dl; inv H1.
-inv H. simpl in H5.
-destruct H5. inv H; auto.
-apply (in_map (@fst ident (globdef fundef type))) in H. simpl in H;  contradiction.
-destruct dl; inv H1. inv H.
-simpl in H5. destruct H5. subst.
-clear - H2 H3. apply nth_error_in in H2.
-apply (in_map (@fst ident (globdef fundef type))) in H2. simpl in *;  contradiction.
-apply (IHn dl); auto.
-(* end assert d = Gfun fd *)
-subst d.
-clear H5.
-clear - RANGE H2 H1 H Hm.
-unfold Genv.init_mem in Hm.
-forget (Genv.globalenv prog) as ge.
-change (AST.prog_defs prog) with (prog_defs prog) in Hm.
-forget (prog_defs prog) as dl.
-rewrite <- (rev_involutive dl) in H1,Hm.
-rewrite nth_error_rev in H1.
-2 : {
-  rewrite rev_length. clear - RANGE.
-  destruct RANGE.
-  apply inj_lt_iff. rewrite Z2Nat.id by lia. lia. }
-rename H1 into H5.
-replace (length (rev dl) - Z.to_nat (Z.pos b - 1) - 1)%nat
-  with (length (rev dl) - Z.to_nat (Z.pos b))%nat in H5.
-2 : { rewrite rev_length.
-  clear - RANGE.
-  replace (Z.to_nat (Z.pos b-1)) with (Z.to_nat (Z.pos b) - 1)%nat.
-  assert (Z.to_nat (Z.pos b) <= length dl)%nat.
-  destruct RANGE.
-  apply inj_le_iff. rewrite Z2Nat.id by lia. auto.
-  assert (Z.to_nat (Z.pos b) > 0)%nat. apply inj_gt_iff.
-  rewrite Z2Nat.id by lia.  simpl. lia.
-  lia. destruct RANGE as [? _].
-  apply nat_of_Z_lem1.
-  assert (Z.to_nat (Z.pos b) > 0)%nat. apply inj_gt_iff. simpl.
-  pose proof (Pos2Nat.is_pos b); lia.
-  lia. }
-assert (0 < Z.to_nat (Z.pos b) <= length dl)%nat.
-{ clear - RANGE. lia. }
-clear RANGE; rename H0 into RANGE.
-rewrite Z2Nat.inj_pos in *.
-rewrite <- rev_length in RANGE.
-forget (rev dl) as dl'; clear dl; rename dl' into dl.
-destruct RANGE.
-rewrite alloc_globals_rev_eq in Hm.
-revert m Hm H1 H5; induction dl; intros.
-inv H5.
-simpl in H1,Hm.
-invSome.
-specialize (IHdl _ Hm).
-destruct (eq_dec (Pos.to_nat b) (S (length dl))).
-+ rewrite e, Nat.sub_diag in H5. simpl in H5.
-  inversion H5; clear H5; subst a.
-  apply alloc_globals_rev_nextblock in Hm.
-  rewrite Zlength_correct in Hm.
-  rewrite <- inj_S in Hm. rewrite <- e in Hm.
-  rewrite positive_nat_Z in Hm.  rewrite Pos2Z.id in Hm.
-  subst b.
-  clear IHdl H1 H0. clear dl e.
-  unfold Genv.alloc_global in H6.
-  revert H6; case_eq (alloc m0 0 1); intros.
-  unfold drop_perm in H6.
-  destruct (range_perm_dec m1 b 0 1 Cur Freeable).
-  unfold max_access_at, access_at; inv H6.
-  simpl. apply alloc_result in H0. subst b.
-  rewrite PMap.gss.
-  simpl. auto.
-  inv H6.
-+ destruct IHdl.
-  lia.
-  replace (length (a::dl) - Pos.to_nat b)%nat with (S (length dl - Pos.to_nat b))%nat in H5.
-  apply H5.
-  simpl. destruct (Pos.to_nat b); lia.
-  assert (b < nextblock m0)%positive.
-  { apply alloc_globals_rev_nextblock in Hm.
-    rewrite Zlength_correct in Hm. clear - Hm n H1.
-    rewrite Hm.
-    apply Pos2Nat.inj_lt.
-    pattern Pos.to_nat at 1; rewrite <- Z2Nat.inj_pos.
-    rewrite Z2Pos.id by lia.
-    rewrite Z2Nat.inj_succ by lia.
-    rewrite Nat2Z.id. lia. }
-  destruct (alloc_global_old _ _ _ _ H6 (b,0)) as [? ?]; auto.
-  unfold max_access_at.
-  rewrite <- H8.
-  split; auto.
+  induction 1; simpl; first done.
+  rewrite IHmatch_fdecs //.
 Qed.
 
-Definition initial_jm_ext {Z} (ora : Z) (prog: program) m (G: funspecs) (n: nat)
-        (H: Genv.init_mem prog = Some m)
-        (H1: list_norepet (prog_defs_names prog))
-        (H2: match_fdecs (prog_funct prog) G) : juicy_mem :=
-  initial_mem m (initial_core_ext ora (Genv.globalenv prog) G n)
-           (initial_core_ext_ok _ _ _ _ m H1 H2 H).
+Lemma match_fdecs_norepet : forall fs G, match_fdecs fs G -> list_norepet (map fst fs) ↔ list_norepet (map fst G).
+Proof.
+  induction 1; simpl; first done.
+  split; inversion 1; subst; constructor; try tauto; by [rewrite -match_ids | rewrite match_ids].
+Qed.
 
-Require Import VST.veric.ghost_PCM.
+(* compute the size of blocks allocated by Genv.alloc_globals *)
+Fixpoint globals_bounds {F V} b (gl : list (ident * globdef F V)) :=
+  match gl with
+  | [] => fun _ => (0, O)
+  | g :: gl' => let bounds' := globals_bounds (b + 1)%positive gl' in
+      fun c => if eq_dec c b then
+        match g.2 with
+        | Gfun _ => (0, 0%nat)
+        | Gvar v => let init := gvar_init v in
+                    let sz := init_data_list_size init in
+                    (0, Z.to_nat sz)
+        end else bounds' c
+  end.
 
-Import Clight.
+Definition block_bounds {F V} (p : AST.program F V) := globals_bounds 1%positive (AST.prog_defs p).
 
-Lemma initial_jm_ext_eq : forall {Z} (ora : Z) (prog: program) m (G: funspecs) (n: nat)
-        (H: Genv.init_mem prog = Some m)
-        (H1: list_norepet (prog_defs_names prog))
-        (H2: match_fdecs (prog_funct prog) G),
-  join (m_phi (initial_jm prog m G n H H1 H2))
-       (set_ghost (core (m_phi (initial_jm prog m G n H H1 H2))) (Some (ext_ghost ora, NoneP) :: nil) eq_refl)
-       (m_phi (initial_jm_ext ora prog m G n H H1 H2)).
+Lemma globals_bounds_min : forall {F V} b0 (gl : list (ident * globdef F V)) b, (b < b0)%positive ->
+  globals_bounds b0 gl b = (0, 0%nat).
 Proof.
-  intros.
-  apply resource_at_join2.
-  - simpl.
-    rewrite !inflate_initial_mem_level.
-    unfold initial_core, initial_core_ext; rewrite !level_make_rmap; auto.
-  - unfold set_ghost; rewrite level_make_rmap.
-    rewrite level_core.
-    simpl.
-    rewrite !inflate_initial_mem_level.
-    unfold initial_core, initial_core_ext; rewrite !level_make_rmap; auto.
-  - intros.
-    unfold set_ghost; rewrite resource_at_make_rmap, <- core_resource_at.
-    simpl.
-    unfold initial_core, initial_core_ext, inflate_initial_mem.
-    rewrite !resource_at_make_rmap.
-    unfold inflate_initial_mem'.
-    rewrite !resource_at_make_rmap.
-    change fcore with (@core _ _ (fsep_sep Sep_resource)).
-    apply join_comm, core_unit.
-  - unfold set_ghost; rewrite ghost_of_make_rmap.
-    simpl.
-    unfold initial_core, initial_core_ext, inflate_initial_mem.
-    rewrite !ghost_of_make_rmap.
-    constructor.
+  intros until gl; revert b0; induction gl; simpl; intros; first done.
+  rewrite if_false; last lia.
+  apply IHgl; lia.
 Qed.
 
-Lemma initial_jm_wsat : forall {Z} (ora : Z) (prog: program) m (G: funspecs) (n: nat)
-        (H: Genv.init_mem prog = Some m)
-        (H1: list_norepet (prog_defs_names prog))
-        (H2: match_fdecs (prog_funct prog) G),
-  exists z, join (m_phi (initial_jm_ext ora prog m G n H H1 H2)) (wsat_rmap (m_phi (initial_jm_ext ora prog m G n H H1 H2))) (m_phi z) /\
-    ext_order (initial_jm_ext ora prog m G n H H1 H2) z.
+Lemma globals_bounds_app1 : forall {F V} b0 (gl1 gl2 : list (ident * globdef F V)) b,
+  (Pos.to_nat b < Pos.to_nat b0 + length gl1)%nat -> globals_bounds b0 (gl1 ++ gl2) b = globals_bounds b0 gl1 b.
 Proof.
-  intros.
-  destruct (make_rmap _ (Some (ext_ghost ora, NoneP) :: tl wsat_ghost) (level (initial_core_ext ora (Genv.globalenv prog) G n))
-    (inflate_initial_mem'_fmap m _)) as (z & Hl & Hr & Hg); auto.
-  destruct (juicy_mem_resource (initial_jm_ext ora prog m G n H H1 H2) z) as (jz & ? & ?); unfold initial_jm_ext; simpl; subst.
-  { rewrite Hr. unfold inflate_initial_mem; rewrite resource_at_make_rmap. auto. }
-  exists jz; split. apply resource_at_join2; rewrite ?inflate_initial_mem_level, ?Hl, ?Hr, ?Hg; auto.
-  - unfold wsat_rmap; rewrite level_make_rmap, inflate_initial_mem_level; auto.
-  - intros; unfold inflate_initial_mem, wsat_rmap; rewrite !resource_at_make_rmap.
-    rewrite <- core_resource_at, resource_at_make_rmap.
-    apply join_comm, core_unit.
-  - unfold inflate_initial_mem, wsat_rmap; rewrite !ghost_of_make_rmap.
-    unfold initial_core_ext; rewrite ghost_of_make_rmap.
-    repeat constructor.
-  - split; auto. apply rmap_order.
-    rewrite Hl, Hr, Hg.
-    unfold inflate_initial_mem; rewrite level_make_rmap, resource_at_make_rmap, ghost_of_make_rmap.
-    split; auto; split; auto.
-    unfold initial_core_ext; rewrite ghost_of_make_rmap.
-    eexists; repeat constructor.
+  intros; generalize dependent b0; induction gl1; simpl; intros.
+  { apply globals_bounds_min; lia. }
+  if_tac; first done.
+  apply IHgl1; lia.
 Qed.
 
-Notation prog_vars := (@prog_vars function).
+Lemma globals_bounds_nth : forall {F V} b0 (gl : list (ident * globdef F V)) b i g (Hb0 : (b0 <= b)%positive),
+  nth_error gl (Pos.to_nat b - Pos.to_nat b0) = Some (i, g) ->
+  globals_bounds b0 gl b = match g with
+                           | Gfun _ => (0, 0%nat)
+                           | Gvar v => let init := gvar_init v in let sz := init_data_list_size init in (0, Z.to_nat sz)
+                           end.
+Proof.
+  intros; generalize dependent b0; induction gl; simpl; intros.
+  - rewrite nth_error_nil // in H.
+  - destruct (Pos.to_nat b - Pos.to_nat b0)%nat eqn: Hn; simpl in H.
+    + inv H.
+      rewrite if_true //; lia.
+    + rewrite if_false; last lia.
+      apply IHgl; try lia.
+      replace (_ - _)%nat with n by lia; done.
+Qed.
 
-Lemma initial_jm_without_locks prog m G n H H1 H2:
-  no_locks (m_phi (initial_jm prog m G n H H1 H2)).
+Lemma block_bounds_nth : forall {F V} (prog : AST.program F V) b i g,
+  nth_error (AST.prog_defs prog) (Z.to_nat (Z.pos b - 1)) = Some (i, g) ->
+  block_bounds prog b = match g with
+                           | Gfun _ => (0, 0%nat)
+                           | Gvar v => let init := gvar_init v in let sz := init_data_list_size init in (0, Z.to_nat sz)
+                           end.
 Proof.
-  simpl.
-  unfold inflate_initial_mem; simpl.
-  match goal with |- context [ proj1_sig ?a ] => destruct a as (phi & lev & E & ?) end; simpl.
-  unfold inflate_initial_mem' in E.
-  unfold resource_at in E.
-  unfold no_locks, "@"; intros.
-  rewrite E.
-  destruct (access_at m addr); [ |congruence].
-  destruct p; try congruence.
-  destruct (fst ((snd (unsquash (initial_core (Genv.globalenv prog) G n)))) addr);
-  congruence.
+  intros; eapply globals_bounds_nth; first lia.
+  by rewrite Z2Nat.inj_sub // Z2Nat.inj_pos in H.
 Qed.
 
-Lemma initial_jm_ext_without_locks {Z} (ora : Z) prog m G n H H1 H2:
-  no_locks (m_phi (initial_jm_ext ora prog m G n H H1 H2)).
+Lemma alloc_globals_block : forall {F} prog_pub (ge : Genv.t (Ctypes.fundef F) type) b gl l m m'
+  (Hl : list_norepet (map fst (gl ++ l)))
+  (Hge : ge = Genv.add_globals (Genv.empty_genv (Ctypes.fundef F) type prog_pub) (gl ++ l))
+  (Hlen : Pos.to_nat (nextblock m') - 1 = length gl), Genv.alloc_globals ge m gl = Some m' ->
+  (nextblock m <= b < nextblock m')%positive ->
+  exists id g, In (id, g) gl /\ Genv.find_symbol ge id = Some b.
 Proof.
-  simpl.
-  unfold inflate_initial_mem; simpl.
-  match goal with |- context [ proj1_sig ?a ] => destruct a as (phi & lev & E & ?) end; simpl.
-  unfold inflate_initial_mem' in E.
-  unfold resource_at in E.
-  unfold no_locks, "@"; intros.
-  rewrite E.
-  destruct (access_at m addr); try congruence.
-  destruct p; try congruence.
-  destruct (fst ((snd (unsquash (initial_core_ext ora (Genv.globalenv prog) G n)))) addr);
-   congruence.
+  induction gl as [| a] using rev_ind; simpl; intros.
+  { inv H; lia. }
+  apply alloc_globals_app in H as (m1 & ? & H).
+  simpl in H.
+  destruct (Genv.alloc_global _ _ _) eqn: Halloc; inv H.
+  pose proof (Genv.alloc_global_nextblock _ _ _ Halloc).
+  destruct (plt b (nextblock m1)).
+  - rewrite <- app_assoc in *.
+    edestruct IHgl as (? & ? & ? & ?); eauto.
+    { rewrite app_length /= in Hlen; lia. }
+    { unfold Plt in *; lia. }
+    eexists _, _; rewrite in_app_iff; eauto.
+  - assert (b = nextblock m1) as -> by (unfold Plt in *; lia).
+    destruct a; eexists _, _; rewrite in_app_iff; split; first by simpl; eauto.
+    set (gl' := ((_ ++ _) ++ _)).
+    assert (Pos.to_nat (nextblock m1) <= length gl').
+    { subst gl'; rewrite app_length; lia. }
+    rewrite (add_globals_hack (rev _)); [| | rewrite rev_involutive // |].
+    + rewrite nth_error_map nth_error_rev rev_length; last lia.
+      replace (_ - (_ - Pos.to_nat (nextblock m1)))%nat with (Pos.to_nat (nextblock m1)) by lia.
+      subst gl'; rewrite nth_error_app1; last lia.
+      rewrite app_length /= in Hlen; rewrite nth_error_app2; last lia.
+      replace (_ - _)%nat with O by lia; done.
+    + subst gl'.
+      rewrite map_rev list_norepet_rev //.
+    + rewrite Zlength_rev Zlength_correct; lia.
 Qed.
 
-Definition matchfunspecs (ge : genv) (G : funspecs) : pred rmap :=
-  ALL b:block, ALL fs: funspec,
-  func_at fs (b,0%Z) -->
-  EX id:ident, EX fs0: funspec, 
-   !! (Genv.find_symbol ge id = Some b /\ find_id id G = Some fs0) &&
-     funspec_sub_si fs0 fs.
+Lemma init_mem_all : forall (prog: program) m b
+  (Hnorepet : list_norepet (prog_defs_names prog)), Genv.init_mem prog = Some m -> (b < nextblock m)%positive ->
+  exists id g, In (id, g) (AST.prog_defs prog) /\ Genv.find_symbol (globalenv prog) id = Some b.
+Proof.
+  intros; eapply alloc_globals_block; eauto.
+  - instantiate (1 := []); rewrite app_nil_r //.
+  - rewrite app_nil_r //.
+  - apply Genv.init_mem_genv_next in H as <-.
+    rewrite Genv.genv_next_add_globals /= advance_next_length; lia.
+  - simpl; lia.
+Qed.
 
-Lemma approx_min: forall i j, approx i oo approx j = approx (min i j).
+Lemma In_prog_funct : forall prog i f, In (i, Gfun f) (prog_defs prog) -> In (i, f) (prog_funct prog).
 Proof.
-intros.
-extensionality a.
-unfold compose.
-apply pred_ext.
-intros ? [? [? ?]].
-split; auto.
-apply Nat.min_glb_lt; auto.
-intros ? [? ?].
-apply Nat.min_glb_lt_iff in H.
-destruct H.
-split; auto.
-split; auto.
+  intros; rewrite /prog_funct; induction (prog_defs prog); simpl in *; first done.
+  destruct H as [-> | ?]; first by simpl; auto.
+  destruct a as (?, [|]); simpl; auto.
 Qed.
 
-Lemma initial_jm_matchfunspecs prog m G n H H1 H2:
-  matchfunspecs (globalenv prog) G (m_phi (initial_jm prog m G n H H1 H2)).
+Lemma initialize_mem' :
+  forall (prog: program) G m
+      (Hnorepet : list_norepet (prog_defs_names prog))
+      (Hmatch : match_fdecs (prog_funct prog) G)
+      (Hm : Genv.init_mem prog = Some m),
+  mem_auth Mem.empty ∗ funspec_auth ∅ ⊢
+  |==> mem_auth m ∗ inflate_initial_mem m (block_bounds prog) (globalenv prog) G ∗ initial_core m (globalenv prog) G ∗
+      matchfunspecs (globalenv prog) G.
 Proof.
-  intros b  [fsig cc A P Q ? ?].
-  simpl m_phi.
-  intros phi' ? H0 Hext FAT.
-  simpl in FAT.
-  apply rmap_order in Hext as (Hl & Hr & _).
-  rewrite <- Hr in FAT; clear Hr.
-  assert (H3 := proj2 (necR_PURE' _ _ (b,0) (FUN fsig cc) H0)).
-  spec H3. eauto.
-  destruct H3 as [pp H3].
-  unfold inflate_initial_mem at 1 in H3. rewrite resource_at_make_rmap in H3.
-  unfold inflate_initial_mem' in H3. 
-  destruct (access_at m (b,0) Cur) eqn:Haccess; [ | inv H3].
-  destruct p; try discriminate H3.
-  destruct (initial_core (Genv.globalenv prog) G n @ (b, 0)) eqn:?H; try discriminate H3.
-  inv H3.
-  assert (H3: inflate_initial_mem m (initial_core (Genv.globalenv prog) G n) @ (b,0) = PURE (FUN fsig cc) pp).
-  unfold inflate_initial_mem. rewrite resource_at_make_rmap.
-  unfold inflate_initial_mem'. rewrite H4. rewrite Haccess. auto.
-  unfold initial_core in H4. rewrite resource_at_make_rmap in H4.
-  unfold initial_world.initial_core' in H4. simpl in H4.
-  destruct (Genv.invert_symbol (Genv.globalenv prog) b) eqn:?H; try discriminate.
-  destruct (find_id i G) eqn:?H; try discriminate.
-  destruct f; inv H4.
-  assert (H8 := necR_PURE _ _ _ _ _ H0 H3). clear H0 H3.
-  rewrite FAT in H8.
-  injection H8; intro. subst A0.
-  apply PURE_inj in H8. destruct H8 as [_ H8].
-  simpl in H8.
-  do 2 eexists. split. split. 
-  apply Genv.invert_find_symbol; eauto. eauto.
-  split. split; auto.
-  clear H6 H5 i.
-  rewrite later_unfash.
-  do 3 red.
-  clear FAT. forget (level phi') as n'. rewrite <- Hl in *. clear phi'. clear dependent a''.
-  intros n1' Hn1'. apply laterR_nat in Hn1'.
-  intros ts ftor garg.
-  intros phi Hphi phi' phi'' Hphi' Hext'.
-  apply necR_level in Hphi'. apply ext_level in Hext'.
-  assert (n' > level phi'')%nat by lia.
-  clear n1' Hphi phi Hphi' Hn1' phi' Hext'.
-  rename phi'' into phi.
-  intros [_ ?].
-  assert (approx n' (P ts ftor garg) phi).
-  split; auto.
-  clear H3.
-  apply fupd.fupd_intro.
-  exists ts.
-  assert (H5 := equal_f_dep (equal_f_dep H8 ts) ftor). clear H8.
-  simpl in H5.
-  assert (HP := equal_f (equal_f_dep H5 true) garg).
-  assert (HQ := equal_f_dep H5 false).
-  clear H5.
-   simpl in HP, HQ.
-   rewrite P_ne in H4. rewrite HP in H4. clear HP.
-   change (approx _ (approx _ ?A) _) with ((approx n' oo approx n) A phi) in H4.
-   rewrite fmap_app in H4.
-   rewrite fmap_app in HQ.
-   change (approx _ (approx _ ?A)) with ((approx n' oo approx n) A) in HQ.
-   exists (fmap (dependent_type_functor_rec ts A) (approx n oo approx n')
-             (approx n' oo approx n) ftor).
-  rewrite (approx_min n' n) in *.
-  exists emp. rewrite !emp_sepcon.
-  destruct H4.
-  split. auto.
-  intro rho.
-  pose proof (equal_f HQ rho). simpl in H5.
-  intros phi' Hphi'.
-  rewrite emp_sepcon.
-  intros ? phi'' Hphi'' Hext''.
-  intros [_ ?].
-  rewrite (approx_min n n') in *.
-  rewrite (Nat.min_comm n n') in *.
-  assert (approx (min n' n) (Q0 ts
-       (fmap (dependent_type_functor_rec ts A) (approx (Init.Nat.min n' n))
-          (approx (Init.Nat.min n' n)) ftor) rho) phi'').
-  split; auto.
-  apply necR_level in Hphi''; apply ext_level in Hext''; lia.
-  rewrite <- H5 in H7; clear H5.
-  rewrite <- Q_ne in H7.
-  destruct H7.
-  auto.
+  intros.
+  assert (list_norepet (map fst G)).
+  { rewrite -match_fdecs_norepet //; by apply prog_funct_norepet. }
+  assert (∀ b, (b < nextblock m)%positive → match funspec_of_loc (globalenv prog) G (b, 0) with
+    | Some _ => access_at m (b, 0) Cur = Some Nonempty | None => True end).
+  { intros ? Hb.
+    eapply init_mem_all in Hb as (id & g & Hin & Hb); eauto.
+    pose proof (prog_defmap_norepet _ _ _ Hnorepet Hin) as Hdef.
+    apply Genv.find_def_symbol in Hdef as (b' & Hb' & Hdef); assert (b' = b) as -> by (rewrite Hb' in Hb; inv Hb; done).
+    apply Genv.init_mem_characterization_gen in Hm.
+    specialize (Hm b _ Hdef).
+    rewrite /funspec_of_loc /=.
+    erewrite Genv.find_invert_symbol by done.
+    destruct g.
+    + apply In_prog_funct in Hin.
+      assert (In id (map fst (prog_funct prog))) as Hin' by (rewrite in_map_iff; eexists (_, _); eauto).
+      rewrite match_ids // in_map_iff in Hin'; destruct Hin' as ((?, ?) & ? & ?); simpl in *; subst.
+      erewrite find_id_i by done.
+      destruct Hm as (Hperm & Hmax).
+      apply perm_mem_access in Hperm as (? & Hperm & Haccess).
+      destruct (Hmax _ _ _ (access_perm _ _ _ _ _ Haccess)); subst; done.
+    + destruct (find_id id G) eqn: Hfind; last done.
+      eapply match_fdecs_exists_Gfun in Hfind as (? & Hin' & ?); last done.
+      eapply list_norepet_In_In in Hin; eauto; done. }
+  rewrite initialize_mem; last done. rewrite initial_mem_initial_core //. rewrite -init_funspecs_matchfunspecs. by iIntros ">($ & $ & $)".
+  - intros ? Hb.
+    eapply init_mem_all in Hb as (id & g & Hin & Hb); eauto.
+    apply find_symbol_globalenv in Hb as (? & g' & ?); last done.
+    erewrite block_bounds_nth by done.
+    destruct g'; try done; simpl; lia.
+  - rewrite /funspec_of_loc /=.
+    intros ?? Hfind; destruct (Genv.invert_symbol _ _) eqn: Hb; try done.
+    apply Genv.invert_find_symbol in Hb.
+    apply find_symbol_globalenv in Hb as (? & g' & Hnth); last done.
+    erewrite block_bounds_nth by done.
+    apply nth_error_In in Hnth.
+    eapply match_fdecs_exists_Gfun in Hfind as (? & Hin & ?); last done.
+    eapply list_norepet_In_In in Hnth; eauto; subst; done.
 Qed.
 
-Lemma initial_jm_ext_matchfunspecs {Z} (ora : Z) prog m G n H H1 H2:
-  matchfunspecs (globalenv prog) G (m_phi (initial_jm_ext ora prog m G n H H1 H2)).
+Lemma initial_core_funassert :
+  forall (prog: program) V G m ve te
+      (Hnorepet : list_norepet (prog_defs_names prog))
+      (Hmatch : match_fdecs (prog_funct prog) G)
+      (Hm : Genv.init_mem prog = Some m),
+  initial_core m (globalenv prog) G ∗ matchfunspecs (globalenv prog) G ⊢ funassert (nofunc_tycontext V G) (mkEnviron (filter_genv (globalenv prog)) ve te).
 Proof.
-  intros b  [fsig cc A P Q ? ?].
-  simpl m_phi.
-  intros ? phi' H0 Hext FAT.
-  simpl in FAT.
-  apply rmap_order in Hext as (Hl & Hr & _).
-  rewrite <- Hr in FAT; clear Hr.
-  assert (H3 := proj2 (necR_PURE' _ _ (b,0) (FUN fsig cc) H0)).
-  spec H3. eauto.
-  destruct H3 as [pp H3].
-  unfold inflate_initial_mem at 1 in H3. rewrite resource_at_make_rmap in H3.
-  unfold inflate_initial_mem' in H3. 
-  destruct (access_at m (b,0) Cur) eqn:Haccess; [ | inv H3].
-  destruct p; try discriminate H3.
-  destruct (initial_core_ext ora (Genv.globalenv prog) G n @ (b, 0)) eqn:?H; try discriminate H3.
-  inv H3.
-  assert (H3: inflate_initial_mem m (initial_core_ext ora (Genv.globalenv prog) G n) @ (b,0) = PURE (FUN fsig cc) pp).
-  unfold inflate_initial_mem. rewrite resource_at_make_rmap.
-  unfold inflate_initial_mem'. rewrite H4. rewrite Haccess. auto.
-  unfold initial_core_ext in H4. rewrite resource_at_make_rmap in H4.
-  unfold initial_world.initial_core' in H4. simpl in H4.
-  destruct (Genv.invert_symbol (Genv.globalenv prog) b) eqn:?H; try discriminate.
-  destruct (find_id i G) eqn:?H; try discriminate.
-  destruct f; inv H4.
-  assert (H8 := necR_PURE _ _ _ _ _ H0 H3). clear H0 H3.
-  rewrite FAT in H8.
-  injection H8; intro. subst A0.
-  apply PURE_inj in H8. destruct H8 as [_ H8].
-  simpl in H8.
-  do 2 eexists. split. split. 
-  apply Genv.invert_find_symbol; eauto. eauto.
-  split. split; auto.
-  clear H6 H5 i.
-  rewrite later_unfash.
-  do 3 red.
-  clear FAT. forget (level phi') as n'. clear phi'. rewrite Hl in *. clear dependent a'.
-  intros n1' Hn1'. apply laterR_nat in Hn1'.
-  intros ts ftor garg.
-  intros phi Hphi ? phi' Hphi' Hext'.
-  apply necR_level in Hphi'. apply ext_level in Hext'.
-  assert (n' > level phi')%nat by lia.
-  clear n1' Hphi phi Hphi' Hn1' a' Hext'.
-  rename phi' into phi.
-  intros [_ ?].
-  assert (approx n' (P ts ftor garg) phi).
-  split; auto.
-  clear H3.
-  apply fupd.fupd_intro.
-  exists ts.
-  assert (H5 := equal_f_dep (equal_f_dep H8 ts) ftor). clear H8.
-  simpl in H5.
-  assert (HP := equal_f (equal_f_dep H5 true) garg).
-  assert (HQ := equal_f_dep H5 false).
-  clear H5.
-   simpl in HP, HQ.
-   rewrite P_ne in H4. rewrite HP in H4. clear HP.
-   change (approx _ (approx _ ?A) _) with ((approx n' oo approx n) A phi) in H4.
-   rewrite fmap_app in H4.
-   rewrite fmap_app in HQ.
-   change (approx _ (approx _ ?A)) with ((approx n' oo approx n) A) in HQ.
-   exists (fmap (dependent_type_functor_rec ts A) (approx n oo approx n')
-             (approx n' oo approx n) ftor).
-  rewrite (approx_min n' n) in *.
-  exists emp. rewrite !emp_sepcon.
-  destruct H4.
-  split. auto.
-  intro rho.
-  pose proof (equal_f HQ rho). simpl in H5.
-  intros phi' Hphi'.
-  rewrite emp_sepcon.
-  intros ? phi'' Hphi'' Hext''.
-  intros [_ ?].
-  rewrite (approx_min n n') in *.
-  rewrite (Nat.min_comm n n') in *.
-  assert (approx (min n' n) (Q0 ts
-       (fmap (dependent_type_functor_rec ts A) (approx (Init.Nat.min n' n))
-          (approx (Init.Nat.min n' n)) ftor) rho) phi'').
-  split; auto.
-  apply necR_level in Hphi''; apply ext_level in Hext''; lia.
-  rewrite <- H5 in H7; clear H5.
-  rewrite <- Q_ne in H7.
-  destruct H7.
-  auto.
+  intros; iIntros "(#H & match)"; iSplitL ""; rewrite /initial_world.initial_core /Map.get /filter_genv /=.
+  - iIntros "!>" (?? Hid); simpl in *.
+    rewrite make_tycontext_s_find_id in Hid.
+    edestruct match_fdecs_exists_Gfun as (? & Hid' & ?); [done.. |].
+    apply (Genv.find_symbol_exists (program_of_program _)) in Hid' as (b & Hfind); rewrite Hfind.
+    iExists _; iSplit; first done.
+    unshelve erewrite (big_sepL_lookup _ _ (Pos.to_nat b - 1)); last (apply lookup_seq; split; first done).
+    replace (Pos.of_nat _) with b by lia.
+    rewrite /funspec_of_loc /=.
+    erewrite Genv.find_invert_symbol by done.
+    rewrite Hid //.
+    { left; intros; destruct (funspec_of_loc _ _ _); apply _. }
+    { eapply Genv.find_symbol_not_fresh in Hfind; last done.
+      unfold valid_block, Plt in Hfind; lia. }
+  - iIntros (???) "Hsig".
+    rewrite /sigcc_at.
+    iDestruct "Hsig" as (????) "Hfun".
+    iDestruct ("match" with "Hfun") as (?? (? & ?)) "Hfun".
+    iPureIntro; setoid_rewrite make_tycontext_s_find_id; eauto.
 Qed.
+
+End mpred.
+
+(*Require Import VST.veric.wsat.
+
+(* This is provable, but we probably don't want to use it: we should set up the proof infrastructure
+   (heapGS, etc.) first, and then allocate the initial memory in a later step. *)
+Lemma alloc_initial_state  `{!inG Σ (excl_authR (leibnizO Z))} `{!wsatGpreS Σ} `{!gen_heapGpreS (@resource' Σ) Σ} :
+  forall (prog: program) G z m
+      (Hnorepet : list_norepet (prog_defs_names prog))
+      (Hmatch : match_fdecs (prog_funct prog) G)
+      (Hm : Genv.init_mem prog = Some m),
+  ⊢ |==> ∃ _ : externalGS Z Σ, ∃ _ : heapGS Σ,
+    ext_auth z ∗ has_ext z ∗ wsat ∗ ownE ⊤ ∗ mem_auth m ∗ inflate_initial_mem m (block_bounds prog) (globalenv prog) G ∗ initial_core m (globalenv prog) G
+    ∗ ghost_map.ghost_map_auth(H0 := gen_heapGpreS_meta) (gen_meta_name _) 1 ∅.
+Proof.
+  intros; iIntros.
+  iMod (ext_alloc z) as (?) "(? & ?)".
+  iMod (alloc_initial_mem Mem.empty (fun _ => (0%Z, O)) (globalenv prog) G) as (?) "(? & ? & Hm & _ & ?)".
+  iMod (initialize_mem' with "Hm") as "(? & ? & ?)".
+  iExists _, _; by iFrame.
+Qed.*)
diff --git a/veric/Clight_mapsto_memory_block.v b/veric/Clight_mapsto_memory_block.v
index b8df56c14b..afe3cbcaa2 100644
--- a/veric/Clight_mapsto_memory_block.v
+++ b/veric/Clight_mapsto_memory_block.v
@@ -1,9 +1,7 @@
-Require Import VST.msl.log_normalize.
-Require Import VST.msl.alg_seplog.
 Require Import VST.veric.base.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.res_predicates. 
-
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Import VST.veric.res_predicates.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.Clight_lemmas.
 Require Import VST.veric.tycontext.
 Require Import VST.veric.expr2.
@@ -18,206 +16,97 @@ Require Import VST.veric.mpred.
 Require Import VST.veric.Cop2.
 Require Export VST.veric.mapsto_memory_block.
 
-Local Open Scope pred.
+Require Import compcert.export.Clightdefs.
+
+Section mpred.
+
+Context `{!heapGS Σ}.
+
+Lemma address_mapsto_unsigned_signed:
+ forall sign1 sign2 sh sz l i ch1 ch2
+  (Hch1 : access_mode (Tint sz sign1 noattr) = By_value ch1)
+  (Hch2 : access_mode (Tint sz sign2 noattr) = By_value ch2)
+  (Hsize : size_chunk_nat ch1 = size_chunk_nat ch2)
+  (Halign : align_chunk ch1 = align_chunk ch2),
+  address_mapsto ch1 (Vint (Cop.cast_int_int sz sign1 i)) sh l ⊣⊢
+  address_mapsto ch2 (Vint (Cop.cast_int_int sz sign2 i)) sh l.
+Proof.
+  intros; rewrite /address_mapsto.
+  apply bi.exist_proper; intros bl.
+  rewrite Hsize Halign; apply bi.and_proper; try done.
+  apply bi.pure_proper.
+  rewrite /decode_val /Cop.cast_int_int.
+  destruct sz; try solve [inv Hch1; inv Hch2; auto]; destruct sign1, sign2; inv Hch1; inv Hch2; auto.
+  * destruct bl; try (intuition; discriminate); destruct bl; try (intuition; discriminate); simpl.
+    destruct m; try (intuition; discriminate).
+    split; [rewrite <- (Int.zero_ext_sign_ext _ (Int.repr _)), <- (Int.zero_ext_sign_ext _ i) by lia
+          | rewrite <- (Int.sign_ext_zero_ext _ (Int.repr _)), <- (Int.sign_ext_zero_ext _ i) by lia]; intuition; congruence.
+  * destruct bl; try (intuition; discriminate); destruct bl; try (intuition; discriminate); simpl.
+    destruct m; try (intuition; discriminate).
+    split; [rewrite <- (Int.sign_ext_zero_ext _ (Int.repr _)), <- (Int.sign_ext_zero_ext _ i) by lia
+          | rewrite <- (Int.zero_ext_sign_ext _ (Int.repr _)), <- (Int.zero_ext_sign_ext _ i) by lia]; intuition; congruence.
+  * destruct bl; try (split; intros [??]; discriminate); destruct bl; try (split; intros [??]; discriminate); destruct bl; try (split; intros [??]; discriminate); simpl.
+    destruct m; try (split; intros [?[??]]; discriminate); destruct m0; try (split; intros [?[??]]; discriminate).
+    split; [rewrite <- (Int.zero_ext_sign_ext _ (Int.repr _)), <- (Int.zero_ext_sign_ext _ i) by lia
+          | rewrite <- (Int.sign_ext_zero_ext _ (Int.repr _)), <- (Int.sign_ext_zero_ext _ i) by lia]; intuition; congruence.
+  * destruct bl; try (split; intros [??]; discriminate); destruct bl; try (split; intros [??]; discriminate); destruct bl; try (split; intros [??]; discriminate); simpl.
+    destruct m; try (split; intros [?[??]]; discriminate); destruct m0; try (split; intros [?[??]]; discriminate).
+    split; [rewrite <- (Int.sign_ext_zero_ext _ (Int.repr _)), <- (Int.sign_ext_zero_ext _ i) by lia
+           | rewrite <- (Int.zero_ext_sign_ext _ (Int.repr _)), <- (Int.zero_ext_sign_ext _ i) by lia]; intuition; congruence.
+Qed.
 
 Lemma mapsto_unsigned_signed:
  forall sign1 sign2 sh sz v i,
-  mapsto sh (Tint sz sign1 noattr) v (Vint (Cop.cast_int_int sz sign1 i)) =
+  mapsto sh (Tint sz sign1 noattr) v (Vint (Cop.cast_int_int sz sign1 i)) ⊣⊢
   mapsto sh (Tint sz sign2 noattr) v (Vint (Cop.cast_int_int sz sign2 i)).
 Proof.
- intros.
- unfold mapsto.
- unfold address_mapsto, res_predicates.address_mapsto.
- simpl.
- destruct sz; auto;
- destruct sign1, sign2;
- [auto | | | auto | auto | |  | auto];
- (destruct v; [auto | auto | auto | auto | auto | ]);
- simpl Cop.cast_int_int;
- repeat rewrite (prop_true_andp (_ <= _ <= _)) by
-  first [ apply (expr_lemmas3.sign_ext_range' 8 i); compute; split; congruence
+  intros.
+  unfold mapsto.
+  assert (exists ch1 ch2, access_mode (Tint sz sign1 noattr) = By_value ch1 /\ access_mode (Tint sz sign2 noattr) = By_value ch2 /\
+    size_chunk_nat ch1 = size_chunk_nat ch2 /\ align_chunk ch1 = align_chunk ch2) as (ch1 & ch2 & Hch1 & Hch2 & Hsize & Halign).
+  { destruct sz; simpl; eauto 7; destruct sign1, sign2; eauto 7. }
+  rewrite /type_is_volatile Hch1 Hch2 /=.
+  destruct v; auto.
+  if_tac; auto.
+  - apply bi.or_proper; [apply bi.and_proper|].
+    + apply bi.pure_proper; destruct sz; try done; rewrite /Cop.cast_int_int; destruct sign1, sign2; try done; split; intros;
+        first [ apply (expr_lemmas3.sign_ext_range' 8 i); compute; split; congruence
           | apply (expr_lemmas3.sign_ext_range' 16 i); compute; split; congruence
-          ];
- repeat rewrite (prop_true_andp (_ <= _)) by
-  first [ apply (expr_lemmas3.zero_ext_range' 8 i); compute; split; congruence
+          | apply (expr_lemmas3.zero_ext_range' 8 i); compute; split; congruence
           | apply (expr_lemmas3.zero_ext_range' 16 i); compute; split; congruence
-          ];
- simpl;
- repeat rewrite (prop_true_andp True) by auto;
- repeat rewrite (prop_false_andp  (Vint _ = Vundef) ) by (intro; discriminate);
- cbv beta;
- repeat first [rewrite @FF_orp | rewrite @orp_FF].
-*
- f_equal. if_tac; clear H.
- 2:{
-   f_equal.
-   apply pred_ext; intros ?; hnf; simpl;
-   intros; (split; [| tauto]).
-   + intros _.
-     simpl.
-     destruct (zero_ext_range' 8 i); [split; cbv; intros; congruence |].
-     exact H1.
-   + intros _.
-     simpl.
-     destruct (sign_ext_range' 8 i); [split; cbv; intros; congruence |].
-     exact (conj H0 H1).
- }
- f_equal. f_equal; extensionality bl.
- f_equal. f_equal.
- simpl;  apply prop_ext; intuition.
- destruct bl; inv H0. destruct bl; inv H.
- unfold Memdata.decode_val in *. simpl in *.
- destruct m; try congruence.
- unfold Memdata.decode_int in *.
- rewrite rev_if_be_1 in *. simpl in *.
- apply Vint_inj in H1. f_equal.
- rewrite <- (Int.zero_ext_sign_ext _ (Int.repr _)) by lia.
-  rewrite <- (Int.zero_ext_sign_ext _ i) by lia.
- f_equal; auto.
- inv H3.
- destruct bl; inv H0. destruct bl; inv H3.
- unfold Memdata.decode_val in *. simpl in *.
- destruct m; try congruence.
- unfold Memdata.decode_int in *.
- rewrite rev_if_be_1 in *. simpl in *.
- apply Vint_inj in H. f_equal.
- rewrite <- (Int.sign_ext_zero_ext _ (Int.repr _)) by lia.
- rewrite <- (Int.sign_ext_zero_ext _ i) by lia.
- f_equal; auto.
-*
- f_equal.
- if_tac; clear H.
- 2:{
-   f_equal.
-   apply pred_ext; intros ?; hnf; simpl;
-   intros; (split; [| tauto]).
-   + intros _.
-     simpl.
-     destruct (sign_ext_range' 8 i); [split; cbv; intros; congruence |].
-     exact (conj H0 H1).
-   + intros _.
-     simpl.
-     destruct (zero_ext_range' 8 i); [split; cbv; intros; congruence |].
-     exact H1.
- }
- f_equal; f_equal; extensionality bl.
- f_equal. f_equal.
- simpl;  apply prop_ext; intuition.
- destruct bl; inv H0. destruct bl; inv H3.
- unfold Memdata.decode_val in *. simpl in *.
- destruct m; try congruence.
- unfold Memdata.decode_int in *.
- rewrite rev_if_be_1 in *. simpl in *.
- apply Vint_inj in H. f_equal.
- rewrite <- (Int.sign_ext_zero_ext _ (Int.repr _)) by lia.
- rewrite <- (Int.sign_ext_zero_ext _ i) by lia.
- f_equal; auto.
- destruct bl; inv H0. destruct bl; inv H3.
- unfold Memdata.decode_val in *. simpl in *.
- destruct m; try congruence.
- unfold Memdata.decode_int in *.
- rewrite rev_if_be_1 in *. simpl in *.
- apply Vint_inj in H. f_equal.
- rewrite <- (Int.zero_ext_sign_ext _ (Int.repr _)) by lia.
-  rewrite <- (Int.zero_ext_sign_ext _ i) by lia.
- f_equal; auto.
-*
- f_equal.
-  if_tac; [| auto]; clear H.
- 2:{
-   f_equal.
-   apply pred_ext; intros ?; hnf; simpl;
-   intros; (split; [| tauto]).
-   + intros _.
-     simpl.
-     destruct (zero_ext_range' 16 i); [split; cbv; intros; congruence |].
-     exact H1.
-   + intros _.
-     simpl.
-     destruct (sign_ext_range' 16 i); [split; cbv; intros; congruence |].
-     exact (conj H0 H1).
- }
- apply equal_f. apply f_equal. apply f_equal. extensionality bl.
- apply equal_f. apply f_equal. apply f_equal.
- simpl;  apply prop_ext; intuition.
- destruct bl; inv H0. destruct bl; inv H3. destruct bl; inv H1.
- unfold Memdata.decode_val in *. simpl in *.
- destruct m; try congruence.
- destruct m0; try congruence.
- unfold Memdata.decode_int in *.
- apply Vint_inj in H. f_equal.
- rewrite <- (Int.zero_ext_sign_ext _ (Int.repr _)) by lia.
-  rewrite <- (Int.zero_ext_sign_ext _ i) by lia.
- f_equal; auto.
- destruct bl; inv H0. destruct bl; inv H3. destruct bl; inv H1.
- unfold Memdata.decode_val in *. simpl in *.
- destruct m; try congruence.
- destruct m0; try congruence.
- unfold Memdata.decode_int in *.
- apply Vint_inj in H. f_equal.
- rewrite <- (Int.sign_ext_zero_ext _ (Int.repr _)) by lia.
- rewrite <- (Int.sign_ext_zero_ext _ i) by lia.
- f_equal; auto.
-*
- f_equal.
-  if_tac; [| auto]; clear H.
- 2:{
-   f_equal.
-   apply pred_ext; intros ?; hnf; simpl;
-   intros; (split; [| tauto]).
-   + intros _.
-     simpl.
-     destruct (sign_ext_range' 16 i); [split; cbv; intros; congruence |].
-     exact (conj H0 H1).
-   + intros _.
-     simpl.
-     destruct (zero_ext_range' 16 i); [split; cbv; intros; congruence |].
-     exact H1.
- }
- apply equal_f. apply f_equal. apply f_equal. extensionality bl.
- apply equal_f. apply f_equal. apply f_equal.
- simpl;  apply prop_ext; intuition.
- destruct bl; inv H0. destruct bl; inv H3. destruct bl; inv H1.
- unfold Memdata.decode_val in *. simpl in *.
- destruct m; try congruence.
- destruct m0; try congruence.
- unfold Memdata.decode_int in *.
- apply Vint_inj in H. f_equal.
- rewrite <- (Int.sign_ext_zero_ext _ (Int.repr _)) by lia.
- rewrite <- (Int.sign_ext_zero_ext _ i) by lia.
- f_equal; auto.
- destruct bl; inv H0. destruct bl; inv H3. destruct bl; inv H1.
- unfold Memdata.decode_val in *. simpl in *.
- destruct m; try congruence.
- destruct m0; try congruence.
- unfold Memdata.decode_int in *.
- apply Vint_inj in H. f_equal.
- rewrite <- (Int.zero_ext_sign_ext _ (Int.repr _)) by lia.
-  rewrite <- (Int.zero_ext_sign_ext _ i) by lia.
- f_equal; auto.
+          ].
+    + apply address_mapsto_unsigned_signed; auto.
+    + rewrite -> !(bi.pure_False (Vint _ = Vundef)) by discriminate; by rewrite !bi.False_and.
+  - apply bi.and_proper.
+    + apply bi.pure_proper; rewrite Halign; destruct sz; try done; rewrite /Cop.cast_int_int; destruct sign1, sign2; try reflexivity; split; intros [TC ?]; (split; [|assumption]); intros _; specialize (TC ltac:(discriminate));
+        first [ apply (expr_lemmas3.sign_ext_range' 8 i); compute; split; congruence
+          | apply (expr_lemmas3.sign_ext_range' 16 i); compute; split; congruence
+          | apply (expr_lemmas3.zero_ext_range' 8 i); compute; split; congruence
+          | apply (expr_lemmas3.zero_ext_range' 16 i); compute; split; congruence
+          ].
+    + by rewrite !size_chunk_conv Hsize.
 Qed.
 
-Require Import compcert.export.Clightdefs.
-
 Lemma mapsto_tuint_tint:
   forall sh, mapsto sh tuint = mapsto sh tint.
 Proof.
 intros. apply mapsto_tuint_tint.
 Qed.
 
+Lemma mapsto_null_mapsto_pointer:
+  forall t sh v,
+   Archi.ptr64 = false -> 
+             mapsto sh tint v nullval ⊣⊢
+             mapsto sh (tptr t) v nullval.
+Proof.
+  exact mapsto_null_mapsto_pointer.
+Qed.
+
+End mpred.
+
 Lemma tc_val_pointer_nullval:
  forall t, tc_val (tptr t) nullval.
 Proof.
  intros. apply tc_val_pointer_nullval.
 Qed.
 #[export] Hint Resolve tc_val_pointer_nullval : core.
-
-
-Lemma mapsto_null_mapsto_pointer:
-  forall t sh v,
-   Archi.ptr64 = false -> 
-             mapsto sh tint v nullval =
-             mapsto sh (tptr t) v nullval.
-Proof.
-  intros. apply mapsto_null_mapsto_pointer; trivial.
-Qed.
\ No newline at end of file
diff --git a/veric/Clight_mem_lessdef.v b/veric/Clight_mem_lessdef.v
index aad96c2315..a6a3ed4a7f 100644
--- a/veric/Clight_mem_lessdef.v
+++ b/veric/Clight_mem_lessdef.v
@@ -3,11 +3,15 @@ Require Import compcert.cfrontend.Cop.
 Require Import compcert.cfrontend.Clight.
 Require Import VST.msl.base.
 Require Import VST.veric.base.
+Set Warnings "-custom-entry-overridden".
 Require Import VST.veric.juicy_mem.
+Set Warnings "custom-entry-overridden".
 Require Import VST.veric.mem_lessdef.
 
 Transparent intsize_eq.
 
+Global Instance EqDec_type: EqDec type := type_eq.
+
 Lemma mem_lessdef_sem_cast:
   forall m1 m2, mem_lessdef m1 m2 ->
   forall v1 v1', Val.lessdef v1 v1' ->
diff --git a/veric/Clight_seplog.v b/veric/Clight_seplog.v
index 551ed32360..282787d039 100644
--- a/veric/Clight_seplog.v
+++ b/veric/Clight_seplog.v
@@ -1,10 +1,7 @@
-Require Import VST.msl.log_normalize.
-Require Import VST.msl.alg_seplog.
 Require Export VST.veric.base.
-Require Import VST.veric.rmaps.
-Require Import VST.veric.compcert_rmaps.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.res_predicates.
-
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.mpred.
 Require Import VST.veric.address_conflict.
 Require Export VST.veric.shares.
@@ -13,16 +10,11 @@ Require Export VST.veric.seplog.
 
 Require Export VST.veric.mapsto_memory_block.
 
-Local Open Scope pred.
-
-Require Import compcert.cfrontend.Clight. 
+Require Import compcert.cfrontend.Clight.
 Require Import VST.veric.tycontext.
 Require Import VST.veric.expr2.
 Require Import VST.veric.binop_lemmas2.
 Require Export VST.veric.Clight_mapsto_memory_block.
-Import compcert.lib.Maps.
-
-Local Open Scope pred.
 
 Definition mkEnv g ids vals : environ := 
       let n := Nat.min (length ids) (length vals) in
@@ -42,30 +34,23 @@ Definition eval_lvar (id: ident) (ty: type) (rho: environ) :=
 | None => Vundef
 end.
 
-Definition var_block (sh: Share.t) {cs: compspecs} (idt: ident * type) (rho: environ): mpred :=
-  !! (sizeof (snd idt) <= Ptrofs.max_unsigned) &&
-  (memory_block sh (sizeof (snd idt))) (eval_lvar (fst idt) (snd idt) rho).
+Section mpred.
 
-Definition stackframe_of {cs: compspecs} (f: Clight.function) : assert :=
-  fold_right (fun P Q rho => P rho * Q rho) (fun rho => emp) (map (fun idt => var_block Share.top idt) (Clight.fn_vars f)).
+Context `{!heapGS Σ}.
 
-Lemma stackframe_of_eq : forall {cs: compspecs}, stackframe_of =
-        fun f rho => fold_right sepcon emp (map (fun idt => var_block Share.top idt rho) (Clight.fn_vars f)).
-Proof.
-  intros.
- extensionality f rho.
- unfold stackframe_of.
- forget (fn_vars f) as vl.
- induction vl; simpl; auto.
- rewrite IHvl; auto.
-Qed.
+Local Notation assert := (@assert Σ).
+
+Definition var_block (sh: Share.t) {cs: compspecs} (idt: ident * type): assert :=
+  ⌜sizeof (snd idt) <= Ptrofs.max_unsigned⌝ ∧
+  assert_of (fun rho => (memory_block sh (sizeof (snd idt))) (eval_lvar (fst idt) (snd idt) rho)).
 
-Lemma  subst_derives:
- forall a v P Q, (forall rho, P rho |-- Q rho) -> forall rho, subst a v P rho |-- subst a v Q rho.
+Definition stackframe_of {cs: compspecs} (f: Clight.function) : assert :=
+  fold_right bi_sep emp (map (fun idt => var_block Share.top idt) (Clight.fn_vars f)).
+
+Lemma subst_derives:
+ forall a v (P Q : assert), (P ⊢ Q) -> assert_of (subst a v P) ⊢ assert_of (subst a v Q).
 Proof.
-unfold subst, derives.
-simpl;
-auto.
+  exact subst_extens.
 Qed.
 
 Definition tc_formals (formals: list (ident * type)) : environ -> Prop :=
@@ -74,53 +59,59 @@ Definition tc_formals (formals: list (ident * type)) : environ -> Prop :=
 (*This definition, and some lemmas below, could be moved to general_seplog*)
 
 Definition close_precondition (bodyparams: list ident) 
-    (P: argsEnviron -> mpred) (rho:environ) : mpred :=
- EX vals,
-   !!(map (Map.get (te_of rho)) bodyparams = map Some vals /\
-      Forall (fun v : val => v <> Vundef) vals) &&
-   P (ge_of rho, vals).
+    (P: argsassert) : assert :=
+ assert_of (fun rho => ∃ vals,
+   ⌜map (Map.get (te_of rho)) bodyparams = map Some vals /\
+      Forall (fun v : val => v <> Vundef) vals⌝ ∧
+   P (ge_of rho, vals)).
 
-Definition precondition_closed (fs: list (ident*type)) {A: TypeTree}
-  (P: forall ts, dependent_type_functor_rec ts (AssertTT A) mpred) : Prop :=
- forall ts x,
-  closed_wrt_vars (not_a_param fs) (P ts x) /\
-  closed_wrt_lvars (fun _ => True) (P ts x).
+Definition precondition_closed (fs: list (ident*type)) {A}
+  (P: A -> assert) : Prop :=
+ forall x,
+  closed_wrt_vars (not_a_param fs) (P x) /\
+  closed_wrt_lvars (fun _ => True%type) (P x).
 
 Lemma close_precondition_e':
-   forall al (P: argsEnviron -> pred rmap) (rho: environ) ,
-   close_precondition al P rho |-- 
-   exp (fun vals =>
-     !!(map (Map.get (te_of rho)) al = map Some vals/\
-        Forall (fun v : val => v <> Vundef) vals) &&
-   P (ge_of rho, vals)).
-Proof. intros. intros u p. simpl in p. simpl; trivial. Qed.
+   forall al (P: argsassert) (rho: environ),
+   close_precondition al P rho ⊢
+   ∃ vals,
+     ⌜map (Map.get (te_of rho)) al = map Some vals /\
+        Forall (fun v : val => v <> Vundef) vals⌝ ∧
+   P (ge_of rho, vals).
+Proof. trivial. Qed.
+
+Global Instance close_precondition_proper p : Proper (base.equiv ==> base.equiv) (close_precondition p).
+Proof.
+  intros ?? H.
+  split => rho; solve_proper.
+Qed.
 
 Lemma Forall_eval_id_get: forall {vals: list val} (V:Forall (fun v : val => v = Vundef -> False) vals), 
   forall ids rho, map (Map.get (te_of rho)) ids = map Some vals <-> map (fun i : ident => eval_id i rho) ids = vals.
 Proof.
 induction vals; simpl; intros; split; intros; destruct ids; inv H; simpl in *; trivial.
 + inv V. destruct (IHvals H4 ids rho) as [X _]. rewrite (X H2); clear X H2. f_equal.
-  unfold eval_id; rewrite H1; simpl; trivial. 
+  unfold eval_id; rewrite H1; simpl; trivial.
 + inv V. destruct (IHvals H2 ids rho) as [_ X]. rewrite X; clear X; trivial. f_equal.
   clear - H1. unfold eval_id, force_val in *.
   destruct (Map.get (te_of rho) p); trivial. elim H1; trivial.
 Qed.
 
 Lemma close_precondition_eval_id ids P rho:
-   close_precondition ids P rho = 
-   EX vals:_,
-     !!(map (fun i => eval_id i rho) ids = vals /\
-        Forall (fun v : val => v <> Vundef) vals) &&
+   close_precondition ids P rho ⊣⊢
+   ∃ vals:_,
+     ⌜map (fun i => eval_id i rho) ids = vals /\
+        Forall (fun v : val => v <> Vundef) vals⌝ ∧
    P (ge_of rho, vals).
 Proof.
-unfold close_precondition. apply pred_ext; apply exp_derives; intros vals m M; simpl in *; intuition.
-apply (Forall_eval_id_get H2); trivial.
-apply (Forall_eval_id_get H2); trivial.
+unfold close_precondition.
+apply bi.exist_proper; intros vals; apply bi.and_proper; last done; apply bi.pure_proper; intuition;
+  apply (Forall_eval_id_get); trivial.
 Qed.
 
-Definition bind_args (bodyparams: list (ident * type)) (P: genviron * list val -> pred rmap) : assert :=
-  fun rho => !! tc_formals bodyparams rho 
-     && close_precondition (map fst bodyparams) P rho.
+Definition bind_args (bodyparams: list (ident * type)) (P: argsassert) : assert :=
+  local (tc_formals bodyparams)
+     ∧ close_precondition (map fst bodyparams) P.
 
 Definition ret_temp : ident := 1%positive.
 
@@ -135,10 +126,10 @@ Definition get_result (ret: option ident) : environ -> environ :=
 
 Definition bind_ret (vl: option val) (t: type) (Q: assert) : assert :=
      match vl, t with
-     | None, Tvoid => fun rho => Q (make_args nil nil rho)
-     | Some v, _ => fun rho => !! (tc_val t v) &&
-                               Q (make_args (ret_temp::nil) (v::nil) rho)
-     | _, _ => fun rho => FF
+     | None, Tvoid => assert_of (fun rho => Q (make_args nil nil rho))
+     | Some v, _ => ⌜tc_val t v⌝ ∧
+                               assert_of (fun rho => Q (make_args (ret_temp::nil) (v::nil) rho))
+     | _, _ => False
      end.
 
 Definition funassert (Delta: tycontext): assert := funspecs_assert (glob_specs Delta).
@@ -151,9 +142,9 @@ Definition funassert (Delta: tycontext): assert := funspecs_assert (glob_specs D
 
 Definition proj_ret_assert (Q: ret_assert) (ek: exitkind) (vl: option val) : assert :=
  match ek with
- | EK_normal => fun rho => !! (vl=None) && RA_normal Q rho
- | EK_break => fun rho => !! (vl=None) && RA_break Q rho
- | EK_continue => fun rho => !! (vl=None) && RA_continue Q rho
+ | EK_normal => ⌜vl=None⌝ ∧ RA_normal Q
+ | EK_break => ⌜vl=None⌝ ∧ RA_break Q
+ | EK_continue => ⌜vl=None⌝ ∧ RA_continue Q
  | EK_return => RA_return Q vl
  end.
 
@@ -164,91 +155,103 @@ Definition overridePost  (Q: assert)  (R: ret_assert) :=
  end.
 
 Definition existential_ret_assert {A: Type} (R: A -> ret_assert) :=
-  {| RA_normal := fun rho => EX x:A, (R x).(RA_normal) rho;
-     RA_break := fun rho => EX x:A, (R x).(RA_break) rho;
-     RA_continue := fun rho => EX x:A, (R x).(RA_continue) rho;
-     RA_return := fun vl rho => EX x:A, (R x).(RA_return) vl rho
+  {| RA_normal := ∃ x:A, (R x).(RA_normal);
+     RA_break := ∃ x:A, (R x).(RA_break);
+     RA_continue := ∃ x:A, (R x).(RA_continue);
+     RA_return := fun vl => ∃ x:A, (R x).(RA_return) vl
    |}.
 
 Definition normal_ret_assert (Q: assert) : ret_assert :=
-  {| RA_normal := Q; RA_break := seplog.FF; RA_continue := seplog.FF; RA_return := fun _ => seplog.FF |}.
+  {| RA_normal := Q; RA_break := False; RA_continue := False; RA_return := fun _ => False |}.
 
 Definition frame_ret_assert (R: ret_assert) (F: assert) : ret_assert :=
  match R with 
   {| RA_normal := n; RA_break := b; RA_continue := c; RA_return := r |} =>
-  {| RA_normal := fun rho => n rho * F rho; 
-     RA_break := fun rho => b rho * F rho; 
-     RA_continue := fun rho => c rho * F rho;
-     RA_return := fun vl rho => r vl rho * F rho |}
+  {| RA_normal := n ∗ F;
+     RA_break := b ∗ F;
+     RA_continue := c ∗ F;
+     RA_return := fun vl => r vl ∗ F |}
  end.
 
 Definition conj_ret_assert (R: ret_assert) (F: assert) : ret_assert :=
  match R with 
   {| RA_normal := n; RA_break := b; RA_continue := c; RA_return := r |} =>
-  {| RA_normal := fun rho => n rho && F rho; 
-     RA_break := fun rho => b rho && F rho; 
-     RA_continue := fun rho => c rho && F rho;
-     RA_return := fun vl rho => r vl rho && F rho |}
+  {| RA_normal := n ∧ F;
+     RA_break := b ∧ F;
+     RA_continue := c ∧ F;
+     RA_return := fun vl => r vl ∧ F |}
  end.
 
 Definition switch_ret_assert (R: ret_assert) : ret_assert :=
  match R with 
   {| RA_normal := n; RA_break := b; RA_continue := c; RA_return := r |} =>
-  {| RA_normal := seplog.FF; 
+  {| RA_normal := False; 
      RA_break := n; 
      RA_continue := c;
      RA_return := r |}
  end.
 
-Require Import VST.msl.normalize.
-
 Lemma normal_ret_assert_derives:
- forall P Q rho,
-  (P rho |-- Q rho) ->
-  forall ek vl, proj_ret_assert (normal_ret_assert P) ek vl rho 
-            |-- proj_ret_assert (normal_ret_assert Q) ek vl rho.
+ forall P Q,
+  (P ⊢ Q) ->
+  forall ek vl, proj_ret_assert (normal_ret_assert P) ek vl
+            ⊢ proj_ret_assert (normal_ret_assert Q) ek vl.
 Proof.
- intros.
- destruct ek; simpl; normalize.
+  intros.
+  destruct ek; simpl; auto.
+  rewrite H //.
 Qed.
-#[export] Hint Resolve normal_ret_assert_derives : core.
 
-Lemma normal_ret_assert_FF:
-  forall ek vl rho, proj_ret_assert (normal_ret_assert (fun rho => FF)) ek vl rho = FF.
+Lemma normal_ret_assert_False:
+  forall ek vl, proj_ret_assert (normal_ret_assert False) ek vl ⊣⊢ False.
 Proof.
 intros.
-destruct ek; simpl; normalize.
+destruct ek; simpl; auto; by rewrite bi.and_False.
+Qed.
+
+(* Do we care about the kind of equivalence? Should this be an assert? *)
+Global Instance ret_assert_equiv : Equiv (ret_assert) := fun a b =>
+  (RA_normal a ⊣⊢ RA_normal b) /\ (RA_break a ⊣⊢ RA_break b) /\
+  (RA_continue a ⊣⊢ RA_continue b) /\ (forall v, RA_return a v ⊣⊢ RA_return b v).
+
+Global Instance ret_assert_equivalence : Equivalence (@base.equiv ret_assert _).
+Proof.
+  split.
+  - intros ?; hnf; auto.
+  - intros ?? (? & ? & ? & ?); split3; last split; intros; auto.
+    rewrite -H2 //.
+  - intros ??? (? & ? & ? & ?) (? & ? & ? & ?); split3; last split; intros; etrans; eauto.
 Qed.
 
 Lemma frame_normal:
-  forall P F,
-   frame_ret_assert (normal_ret_assert P) F = normal_ret_assert (fun rho => P rho * F rho).
+  forall P F, base.equiv (frame_ret_assert (normal_ret_assert P) F) (normal_ret_assert (P ∗ F)).
 Proof.
 intros.
 unfold normal_ret_assert; simpl.
-f_equal; simpl; try solve [extensionality rho; normalize].
-extensionality vl rho; normalize.
+split3; last split; simpl; auto; intros; rewrite bi.sep_False //.
+Qed.
+
+Lemma pure_and_sep_assoc: forall {PROP} P (Q R : bi_car PROP), ⌜P⌝ ∧ Q ∗ R ⊣⊢ (⌜P⌝ ∧ Q) ∗ R.
+Proof.
+  intros; apply bi.persistent_and_sep_assoc; apply _.
 Qed.
 
 Lemma proj_frame:
   forall P F ek vl,
-    proj_ret_assert (frame_ret_assert P F) ek vl = fun rho => F rho * proj_ret_assert P ek vl rho.
+    proj_ret_assert (frame_ret_assert P F) ek vl ⊣⊢ F ∗ proj_ret_assert P ek vl.
 Proof.
   intros.
-  extensionality rho.
-  rewrite sepcon_comm.
-  destruct ek; simpl; destruct P; auto;
-  normalize.
+  rewrite bi.sep_comm.
+  destruct ek; simpl; destruct P; rewrite ?pure_and_sep_assoc //.
 Qed.
 
 Lemma proj_conj:
   forall P F ek vl,
-    proj_ret_assert (conj_ret_assert P F) ek vl = fun rho => F rho && proj_ret_assert P ek vl rho.
+    proj_ret_assert (conj_ret_assert P F) ek vl ⊣⊢ F ∧ proj_ret_assert P ek vl.
 Proof.
   intros.
-  extensionality rho.
-  rewrite andp_comm.
-  destruct ek; simpl; destruct P; auto; simpl; normalize; rewrite andp_assoc; auto.
+  rewrite bi.and_comm.
+  destruct ek; simpl; destruct P; rewrite /= ?assoc //.
 Qed.
 
 Definition loop1_ret_assert (Inv: assert) (R: ret_assert) : ret_assert :=
@@ -265,27 +268,26 @@ Definition loop2_ret_assert (Inv: assert) (R: ret_assert) : ret_assert :=
   {| RA_normal := n; RA_break := b; RA_continue := c; RA_return := r |} =>
   {| RA_normal := Inv;
      RA_break := n;
-     RA_continue := seplog.FF;
+     RA_continue := False;
      RA_return := r |}
  end.
 
 Lemma frame_for1:
   forall Q R F,
-   frame_ret_assert (loop1_ret_assert Q R) F =
-   loop1_ret_assert (fun rho => Q rho * F rho) (frame_ret_assert R F).
+   (frame_ret_assert (loop1_ret_assert Q R) F =
+    loop1_ret_assert (Q ∗ F) (frame_ret_assert R F))%stdpp.
 Proof.
 intros.
-destruct R; simpl; auto.
+destruct R; reflexivity.
 Qed.
 
 Lemma frame_loop1:
   forall Q R F,
-   frame_ret_assert (loop2_ret_assert Q R) F =
-   loop2_ret_assert (fun rho => Q rho * F rho) (frame_ret_assert R F).
+   (frame_ret_assert (loop2_ret_assert Q R) F ≡
+    loop2_ret_assert (Q ∗ F) (frame_ret_assert R F))%stdpp.
 Proof.
-intros.
-destruct R; simpl; auto.
-f_equal; extensionality; normalize.
+destruct R; split3; last split; try done; simpl.
+apply bi.sep_False.
 Qed.
 
 Lemma overridePost_normal:
@@ -295,17 +297,41 @@ intros; unfold overridePost, normal_ret_assert.
 f_equal.
 Qed.
 
-#[export] Hint Rewrite normal_ret_assert_FF frame_normal frame_for1 frame_loop1
-                 overridePost_normal: normalize.
-
 Definition function_body_ret_assert (ret: type) (Q: assert) : ret_assert :=
  {| RA_normal := bind_ret None ret Q;
-    RA_break := seplog.FF; 
-    RA_continue := seplog.FF;
+    RA_break := False; 
+    RA_continue := False;
     RA_return := fun vl => bind_ret vl ret Q |}.
 
 Lemma same_glob_funassert:
   forall Delta1 Delta2,
-     (forall id, (glob_specs Delta1) ! id = (glob_specs Delta2) ! id) ->
-              funassert Delta1 = funassert Delta2.
-Proof. intros; eapply same_FS_funspecs_assert; trivial. Qed.
+     (forall id, (glob_specs Delta1) !! id = (glob_specs Delta2) !! id) ->
+              funassert Delta1 ⊣⊢ funassert Delta2.
+Proof. intros; apply @same_FS_funspecs_assert; trivial. Qed.
+
+Global Instance bind_ret_proper vl t : Proper (base.equiv ==> base.equiv) (bind_ret vl t).
+Proof.
+  intros ???; destruct vl; simpl.
+  - split => rho; monPred.unseal; rewrite /= H //.
+  - destruct t; try done.
+    split => rho; rewrite /= H //.
+Qed.
+
+Global Instance function_body_ret_assert_proper ret : Proper (base.equiv ==> base.equiv) (function_body_ret_assert ret).
+Proof.
+  intros ???; split3; last split; simpl; try done.
+  - destruct ret; try done.
+    split => rho; rewrite /= H //.
+  - intros; rewrite H //.
+Qed.
+
+Global Instance normal_ret_assert_proper : Proper (base.equiv ==> base.equiv) normal_ret_assert.
+Proof.
+  intros ???; split3; last split; simpl; try done.
+Qed.
+
+End mpred.
+
+#[export] Hint Resolve normal_ret_assert_derives : core.
+#[export] Hint Rewrite @normal_ret_assert_False @frame_normal @frame_for1 @frame_loop1
+                 @overridePost_normal: normalize.
diff --git a/veric/Clightcore_coop.v b/veric/Clightcore_coop.v
index cd65ae5893..e7263a6bea 100644
--- a/veric/Clightcore_coop.v
+++ b/veric/Clightcore_coop.v
@@ -13,12 +13,13 @@ Proof. intros.
     eapply semantics.mem_step_alloc; eassumption. eassumption.
 Qed.
 
-Lemma assign_loc_mem_step g t m b z v m' (A:assign_loc g t m b z v m'):
+Lemma assign_loc_mem_step g t m b z f v m' (A:assign_loc g t m b z f v m'):
     mem_step m m'.
 Proof.
   inv A.
   { simpl in H0. eapply mem_step_storebytes. eapply Mem.store_storebytes; eauto. }
   { eapply mem_step_storebytes; eauto. }
+  { inv H. eapply mem_step_storebytes. eapply Mem.store_storebytes; eauto. }
 Qed.
 
 Lemma bind_parameters_mem_step: forall cenv e m pars vargs m'
@@ -41,23 +42,34 @@ Lemma extcall_sem_mem_step: forall name sg g vargs m t vres m' (E:Events.externa
   mem_step m m'.
 Admitted. (*Maybe include mem_step in Events.extcall_properties.?*)
 
+Lemma known_builtin_mem_step: forall name sg vargs m t vres m' (E:Events.known_builtin_sem name sg vargs m t vres m'),
+  mem_step m m'.
+Admitted. (*Maybe include mem_step in Events.extcall_properties.?*)
+
+Lemma extcall_builtin_mem_step: forall name sg g vargs m t vres m' (E:Events.builtin_or_external_sem name sg g vargs m t vres m'),
+  mem_step m m'.
+Proof.
+  unfold Events.builtin_or_external_sem; intros.
+  destruct (Builtins.lookup_builtin_function); [eapply known_builtin_mem_step | eapply extcall_sem_mem_step]; eauto.
+Qed.
+
 Lemma extcall_mem_step g: forall ef vargs m t vres m' (E:Events.external_call ef g vargs m t vres m'),
   mem_step m m'.
 Proof.
   destruct ef; simpl; intros; try solve [inv E; apply mem_step_refl].
   { eapply extcall_sem_mem_step; eassumption. }
-  { eapply extcall_sem_mem_step; eassumption. }
-  { eapply extcall_sem_mem_step; eassumption. }
+  { eapply extcall_builtin_mem_step; eassumption. }
+  { eapply extcall_builtin_mem_step; eassumption. }
   { inv E. inv H. eapply mem_step_refl.
     apply Mem.store_storebytes in H1. eapply mem_step_storebytes. eassumption. }
   { inv E. apply Mem.store_storebytes in H0.
     eapply mem_step_trans. eapply mem_step_alloc; eassumption.
     eapply mem_step_storebytes; eassumption. }
-  { inv E. eapply mem_step_free; eassumption. }
+  { inv E. eapply mem_step_free; eassumption. apply mem_step_refl. }
   { inv E. eapply mem_step_storebytes. eassumption. }
   { eapply inline_assembly_memstep; eassumption. }
 Qed.
-  
+
 Lemma CLC_corestep_mem:
   forall (g : genv) c (m : mem) c'  (m' : mem),
     semantics.corestep (cl_core_sem g) c m c' m' ->
@@ -65,6 +77,7 @@ Lemma CLC_corestep_mem:
 Proof. simpl; intros. inv H; simpl in *;
   try apply mem_step_refl.
    eapply assign_loc_mem_step; eauto.
+   eapply extcall_mem_step; eauto.
    eapply mem_step_freelist; eauto.
    eapply mem_step_freelist; eauto.
    eapply mem_step_freelist; eauto.
diff --git a/veric/GeneralSeparationLogicSoundness.v b/veric/GeneralSeparationLogicSoundness.v
index b106297f72..6674136529 100644
--- a/veric/GeneralSeparationLogicSoundness.v
+++ b/veric/GeneralSeparationLogicSoundness.v
@@ -1,30 +1,24 @@
 Require Import VST.sepcomp.semantics.
 
-Require Import VST.veric.juicy_base. 
+Require Import VST.veric.juicy_base.
 
-Require Import VST.veric.juicy_mem.  
+Require Import VST.veric.juicy_mem.
 Require Import VST.sepcomp.extspec.
-Require Import VST.veric.ghost_PCM.
 Require Import VST.veric.juicy_extspec.
 
 Require Import VST.veric.res_predicates.
+Require Import VST.veric.external_state.
 Require Import VST.veric.mpred.
 Require Import VST.veric.seplog.
 
 (*********copied from initial_world***********)
-Fixpoint find_id (id: ident) (G: funspecs) : option funspec  :=
+Fixpoint find_id {Σ} (id: ident) (G: funspecs) : option (@funspec Σ) :=
  match G with
  | (id', f)::G' => if eq_dec id id' then Some f else find_id id G'
  | nil => None
  end.
 
-Definition cond_approx_eq n A P1 P2 :=
-  (forall ts,
-      fmap (dependent_type_functor_rec ts (AssertTT A)) (approx n) (approx n) (P1 ts) =
-      fmap (dependent_type_functor_rec ts (AssertTT A)) (approx n) (approx n) (P2 ts)).
-
-Definition func_at'' fsig cc A P Q :=
-  pureat (SomeP (SpecTT A) (packPQ P Q)) (FUN fsig cc).
+Definition func_at'' `{!heapGS Σ} fsig cc A P Q := func_at (mk_funspec fsig cc A P Q).
 (*also copy lemmas on these from initial_world? or isolate in general file?*)
 
 (**********************************************)
@@ -44,24 +38,25 @@ Parameter C: Type.
 Parameter Sem: genv -> CoreSemantics C Memory.mem.
 Parameter genv_symb_injective: genv -> extspec.injective_PTree block.
 
-Definition jsafeN {Z} (Hspec : juicy_ext_spec Z) (ge: genv) :=
-  @jsafeN_ genv _ _ genv_symb_injective (*(genv_symb := fun ge: genv => Genv.genv_symb ge)*)
-           (Sem ge) Hspec ge.
+Section logic.
+
+Context {Z : Type} `{!gen_heapGS address resource Σ} `{!externalGS Z Σ} `{!invGS_gen hlc Σ}.
+
+
+Definition jsafeN (Hspec : ext_spec Z) (ge: genv) :=
+  jsafe(Σ := Σ)(genv_symb := genv_symb_injective) (Sem ge) Hspec ge.
 
 Definition matchfunspecs (ge : genv) (G : funspecs) (Phi : rmap) :=
-forall (b : block) (fsig : compcert_rmaps.funsig)
+forall (b : block) (fsig : funsig)
   (cc : calling_convention) (A : TypeTree)
   (P
-   Q : forall ts : list Type,
-       (dependent_type_functor_rec ts (AssertTT A)) (pred rmap)),
+   Q : dtfr (AssertTT A)),
 (func_at'' fsig cc A P Q (b, 0)) Phi ->
 exists
   (id : ident) (P'
-                Q' : forall ts : list Type,
-                     (dependent_type_functor_rec ts (AssertTT A)) mpred) 
-(P'_ne : super_non_expansive P') (Q'_ne : super_non_expansive Q'),
+                Q' : dtfr (AssertTT A)),
   Genv.find_symbol ge id = Some b /\
-  find_id id G = Some (mk_funspec fsig cc A P' Q' P'_ne Q'_ne) /\
+  find_id id G = Some (mk_funspec fsig cc A P' Q') /\
   cond_approx_eq (level Phi) A P P' /\ cond_approx_eq (level Phi) A Q Q'.
 
 Definition EPoint_sound {Espec: OracleKind} FS m (h:nat) (entryPT:ident) (g:genv) :=
diff --git a/veric/NullExtension.v b/veric/NullExtension.v
index 4667c2254c..430292fb58 100644
--- a/veric/NullExtension.v
+++ b/veric/NullExtension.v
@@ -1,14 +1,21 @@
 Require Import VST.sepcomp.extspec.
 Require Import VST.sepcomp.step_lemmas.
 Require Import VST.veric.base.
+Set Warnings "-custom-entry-overridden".
 Require Import VST.veric.juicy_extspec.
+Set Warnings "custom-entry-overridden".
 Require Import VST.veric.juicy_mem.
+Require Import VST.veric.mpred.
+Set Warnings "-hiding-delimiting-key,-notation-overridden".
+Require Import VST.veric.external_state.
+Set Warnings "hiding-delimiting-key,notation-overridden".
+Require Import VST.veric.lifting.
 Require Import VST.veric.compspecs.
 Require Import VST.veric.semax_prog.
-Require Import VST.veric.SequentialClight2.
+Require Import VST.veric.SequentialClight.
 
-Definition juicyspec : external_specification juicy_mem external_function unit
-  := Build_external_specification juicy_mem external_function unit
+#[export] Instance extspec : external_specification mem external_function unit
+  := Build_external_specification mem external_function unit
      (*ext_spec_type*)
      (fun ef => False)
      (*ext_spec_pre*)
@@ -18,87 +25,52 @@ Definition juicyspec : external_specification juicy_mem external_function unit
      (*ext_spec_exit*)
      (fun rv m z => True).
 
-Definition Espec : OracleKind.
- refine (Build_OracleKind unit (Build_juicy_ext_spec _ juicyspec _ _ _ _ _ _)).
-Proof.
-simpl; intros; contradiction.
-simpl; intros; contradiction.
-simpl; intros; intros ? ? ? ?; contradiction.
-simpl; intros; contradiction.
-repeat intro; auto.
-repeat intro; auto.  
-Defined.
-
-Definition dryspec := juicy_dry_ext_spec_make _ juicyspec.
-
 Lemma NullExtension_whole_program_sequential_safety:
-   forall {CS: compspecs}
-     (Jsub: forall ef se lv m t v m' (EFI : ef_inline ef = true) m1
-       (EFC : Events.external_call ef se lv m t v m'), mem_sub m m1 ->
-       exists m1' (EFC1 : Events.external_call ef se lv m1 t v m1'),
-         mem_sub m' m1' /\ proj1_sig (Clight_core.inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC1) =
-         proj1_sig (Clight_core.inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC))
+   forall {CS: compspecs} `{!VSTGpreS unit Σ}
      (prog: Clight.program) V G m,
-     @semax_prog Espec CS prog tt V G ->
+     (forall {HH : lifting.VSTGS unit Σ}, semax_prog extspec prog tt V G) ->
      Genv.init_mem prog = Some m ->
      exists b, exists q, exists m',
        Genv.find_symbol (Genv.globalenv prog) (prog_main prog) = Some b /\
        semantics.initial_core  (Clight_core.cl_core_sem (Clight.globalenv prog))
            0 m q m' (Vptr b Ptrofs.zero) nil /\
        forall n,
-        @dry_safeN _ _ _ unit (semax.genv_symb_injective)
-          (Clight_core.cl_core_sem (Clight.globalenv prog)) dryspec
+        @dry_safeN _ _ _ unit (lifting.genv_symb_injective)
+          (Clight_core.cl_core_sem (Clight.globalenv prog)) extspec
            (Clight.genv_genv 
             (Clight.Build_genv (Genv.globalenv prog) (Ctypes.prog_comp_env prog)) )
              n tt q m'.
 Proof.
 intros.
-assert (dessicate : forall ef : external_function,
-                   juicy_mem ->
-                   @ext_spec_type juicy_mem external_function
-                     (@OK_ty NullExtension.Espec) (@OK_spec NullExtension.Espec) ef ->
-                   @ext_spec_type mem external_function 
-                     (@OK_ty NullExtension.Espec) dryspec ef). {
-  intros. assumption.
-}
-apply (@whole_program_sequential_safety CS NullExtension.Espec
- tt dryspec dessicate) with (V:=V) (G:=G); auto.
--
-intros ??; contradiction.
--
-split; intros; try assumption; try contradiction.
-split; intros; try assumption.
-split; repeat intro; auto.
-split; repeat intro; auto.
--
-hnf; intros; contradiction.
--
-repeat intro; auto.
-hnf. auto.
-- intros ????????; auto.
+eapply whole_program_sequential_safety_ext in H0 as (? & ? & ?); eauto.
+- intros ?????; apply I.
+- intros; apply ext_spec_entails_refl.
+- intros; exists CS; apply H.
 Qed.
 
-Lemma module_sequential_safety : (*TODO*)
-   forall {CS: compspecs} (prog: Clight.program) (V: mpred.varspecs) 
-      (G: mpred.funspecs) ora m f f_id f_b f_body args,
+(*Lemma module_sequential_safety : (*TODO*)
+   forall {CS: compspecs} `{!VSTGpreS unit Σ} (prog: Clight.program) (V: varspecs) 
+      (G: funspecs) ora m f f_id f_b f_body args,
      let ge := Genv.globalenv prog in
      let ext_link := SeparationLogic.ext_link_prog prog in
-     let spec := SeparationLogic.add_funspecs NullExtension.Espec ext_link G in
+     (* this requires the heapGS and externalGS to be set up already -- would we want to fix
+        the same one for each module? *)
+     let spec := semax_ext.add_funspecs_rec _ ext_link (@OK_spec Espec) G in
      let tys := sig_args (ef_sig f) in
      let rty := sig_res (ef_sig f) in
-     let sem := juicy_core_sem (Clight_core.cl_core_sem (Clight.Build_genv ge (prog_comp_env prog))) in
-     @semax_prog spec CS prog ora V G ->
+     let sem := Clight_core.cl_core_sem (Clight.globalenv prog) in
+     (forall {HH : heapGS Σ} {HE : externalGS OK_ty Σ}, @semax_prog _ HH Espec HE CS prog tt V G) ->
      fun_id ext_link f = Some f_id ->
      Genv.find_symbol ge f_id = Some f_b ->
      Genv.find_funct  ge (Vptr f_b Ptrofs.zero) = Some f_body ->
-     forall x : ext_spec_type (@OK_spec spec) f,
-     ext_spec_pre (@OK_spec spec) f x (semax.genv_symb_injective ge) (map proj_xtype tys) args ora m ->
+     forall x : ext_spec_type spec f,
+     ext_spec_pre spec f x (genv_symb_injective ge) (map proj_xtype tys) args ora m ->
      exists q,
        semantics.initial_core sem 
          0 (*additional temporary argument - TODO (Santiago): FIXME*)
              m q m
               (Vptr f_b Ptrofs.zero) args /\
-       forall n, safeN_(genv_symb := @semax.genv_symb_injective _ _)(Hrel := fun _ => juicy_extspec.Hrel)
-            sem  (upd_exit (@OK_spec spec) x (semax.genv_symb_injective ge)) 
+       forall n, safeN_(genv_symb := @genv_symb_injective _ _)(Hrel := fun _ _ _ => True)
+            sem  (upd_exit spec _ x (genv_symb_injective ge)) 
            ge n ora q m.
-Abort.
\ No newline at end of file
+Abort.*)
diff --git a/veric/SeparationLogic.v b/veric/SeparationLogic.v
index 88b7b882cc..71b9a2bf82 100644
--- a/veric/SeparationLogic.v
+++ b/veric/SeparationLogic.v
@@ -3,488 +3,68 @@ Require Export compcert.lib.Axioms.
 Require Import compcert.lib.Coqlib.
 Require Export compcert.lib.Integers.
 Require Export compcert.lib.Floats.
-Require Import compcert.lib.Maps.
 Require Export compcert.common.AST.
 Require Export compcert.common.Values.
 Require Export compcert.cfrontend.Ctypes.
 Require Export compcert.cfrontend.Clight.
 Require Export VST.sepcomp.Address.
+Require Export VST.sepcomp.extspec.
 Require Export VST.msl.eq_dec.
 Require Export VST.msl.shares.
-Require Export VST.msl.predicates_rec.
-Require Export VST.msl.contractive.
-Require Export VST.msl.seplog.
-Require Export VST.msl.ghost_seplog.
-Require Export VST.msl.alg_seplog.
-Require Export VST.msl.log_normalize.
-Require Export VST.msl.wand_frame.
-Require Export VST.msl.wandQ_frame.
-Require Export VST.msl.ramification_lemmas.
+Require Export VST.veric.log_normalize.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Export VST.veric.tycontext.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Export VST.veric.change_compspecs.
 Require Export VST.veric.mpred.
 Require Export VST.veric.expr.
+Require Export VST.veric.expr2.
+Require Export VST.veric.expr_lemmas.
 Require Export VST.veric.Clight_lemmas.
 Require Export VST.veric.composite_compute.
 Require Export VST.veric.align_mem.
 Require Export VST.veric.shares.
 Require Export VST.veric.seplog.
-Require VST.veric.Clight_seplog.
-Require VST.veric.Clight_assert_lemmas.
+Require Export VST.veric.Clight_seplog.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Export VST.veric.Clight_assert_lemmas.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
+Require Export VST.veric.extend_tc.
 Require Import VST.msl.Coqlib2.
 Require Import VST.veric.juicy_extspec.
-Require Import VST.veric.valid_pointer.
-Require Import VST.veric.own.
-Require VST.veric.semax_prog.
-Require VST.veric.semax_ext.
-Import FashNotation.
+Require Export VST.veric.mapsto_memory_block.
+Require Export VST.veric.valid_pointer.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Export VST.veric.external_state.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
+Require Export VST.veric.Clight_initial_world.
+Require Export VST.veric.initialize.
+Require Export VST.veric.semax.
+Require Export VST.veric.juicy_mem_lemmas.
+Require Export VST.veric.semax_straight.
+Require Export VST.veric.semax_call.
+Require Export VST.veric.semax_prog.
+Require Export VST.veric.semax_ext.
 Import LiftNotation.
-Import Ctypes Clight expr.
+Import Ctypes Clight.
+Export expr.
 
-#[export] Existing Instance EqDec_ident. 
+#[export] Existing Instance EqDec_ident.
 #[export] Existing Instance EqDec_byte.
 #[export] Existing Instance EqDec_memval.
 #[export] Existing Instance EqDec_quantity.
 
-#[export] Instance Nveric: NatDed mpred := algNatDed compcert_rmaps.RML.R.rmap.
-#[export] Instance Sveric: SepLog mpred := algSepLog compcert_rmaps.RML.R.rmap.
-#[export] Instance Cveric: ClassicalSep mpred := algClassicalSep compcert_rmaps.RML.R.rmap.
-#[export] Instance Iveric: Indir mpred := algIndir compcert_rmaps.RML.R.rmap.
-#[export] Instance Rveric: RecIndir mpred := algRecIndir compcert_rmaps.RML.R.rmap.
-#[export] Instance SIveric: SepIndir mpred := algSepIndir compcert_rmaps.RML.R.rmap.
-#[export] Instance CSLveric: CorableSepLog mpred := algCorableSepLog compcert_rmaps.RML.R.rmap.
-#[export] Instance CIveric: CorableIndir mpred := algCorableIndir compcert_rmaps.RML.R.rmap.
-#[export] Instance SRveric: SepRec mpred := algSepRec compcert_rmaps.RML.R.rmap.
-
-Lemma derives_eq : @derives _ Nveric = predicates_hered.derives(A := compcert_rmaps.RML.R.rmap)(AG := _)(EO := _).
-Proof.
-  do 2 extensionality; apply prop_ext; split.
-  - inversion 1; auto.
-  - constructor; auto.
-Qed.
-
-Ltac unseal_derives := rewrite derives_eq in *.
-
-#[local] Obligation Tactic := idtac.
-
-#[export] Program Instance Bveric: BupdSepLog mpred gname compcert_rmaps.RML.R.preds :=
-  { bupd := bupd; own := @own }.
-Next Obligation.
-Proof.
-  apply fresh_nat.
-Qed.
-Next Obligation.
-Proof.
-  constructor; apply bupd_intro.
-Qed.
-Next Obligation.
-Proof.
-  unseal_derives; apply bupd_mono.
-Qed.
-Next Obligation.
-Proof.
-  constructor; apply bupd_trans.
-Qed.
-Next Obligation.
-Proof.
-  constructor; apply bupd_frame_r.
-Qed.
-Next Obligation.
-Proof.
-  constructor; apply ghost_alloc_strong; auto.
-Qed.
-Next Obligation.
-Proof.
-  apply @ghost_op.
-Qed.
-Next Obligation.
-Proof.
-  constructor; apply @ghost_valid_2.
-Qed.
-Next Obligation.
-Proof.
-  constructor; apply @ghost_update_ND; auto.
-Qed.
-Next Obligation.
-Proof.
-  constructor; apply @ghost_dealloc.
-Qed.
-
-#[export] Program Instance Fveric: FupdSepLog mpred gname compcert_rmaps.RML.R.preds nat :=
-  { fupd := fupd.fupd }.
-Next Obligation.
-Proof.
-  unseal_derives; apply fupd.fupd_mask_union; auto.
-Qed.
-Next Obligation.
-Proof.
-  unseal_derives; apply fupd.except_0_fupd.
-Qed.
-Next Obligation.
-Proof.
-  unseal_derives; apply fupd.fupd_mono; auto.
-Qed.
-Next Obligation.
-Proof.
-  unseal_derives; apply fupd.fupd_trans.
-Qed.
-Next Obligation.
-Proof.
-  unseal_derives; apply fupd.fupd_mask_frame_r'.
-Qed.
-Next Obligation.
-Proof.
-  unseal_derives; apply fupd.fupd_frame_r.
-Qed.
-Next Obligation.
-Proof.
-  unseal_derives; apply fupd.bupd_fupd.
-Qed.
-
-#[export] Instance LiftNatDed' T {ND: NatDed T}: NatDed (LiftEnviron T) := LiftNatDed _ _.
-#[export] Instance LiftSepLog' T {ND: NatDed T}{SL: SepLog T}: SepLog (LiftEnviron T) := LiftSepLog _ _.
-#[export] Instance LiftClassicalSep' T {ND: NatDed T}{SL: SepLog T}{CS: ClassicalSep T} :
-           ClassicalSep (LiftEnviron T) := LiftClassicalSep _ _.
-#[export] Instance LiftIndir' T {ND: NatDed T}{SL: SepLog T}{IT: Indir T} :
-           Indir (LiftEnviron T) := LiftIndir _ _.
-#[export] Instance LiftSepIndir' T {ND: NatDed T}{SL: SepLog T}{IT: Indir T}{SI: SepIndir T} :
-           SepIndir (LiftEnviron T) := LiftSepIndir _ _.
-#[export] Instance LiftCorableSepLog' T {ND: NatDed T}{SL: SepLog T}{CSL: CorableSepLog T} :
-           CorableSepLog (LiftEnviron T) := LiftCorableSepLog _ _.
-#[export] Instance LiftCorableIndir' T {ND: NatDed T}{SL: SepLog T}{IT: Indir T}{SI: SepIndir T}{CSL: CorableSepLog T}{CI: CorableIndir T} :
-           CorableIndir (LiftEnviron T) := LiftCorableIndir _ _.
-
-Definition local:  (environ -> Prop) -> environ->mpred :=  lift1 prop.
-
-Global Opaque mpred Nveric Sveric Cveric Iveric Rveric Sveric SIveric CSLveric CIveric SRveric Bveric Fveric.
-
 #[export] Hint Resolve any_environ : typeclass_instances.
 
-Local Open Scope logic.
-
-Transparent mpred Nveric Sveric Cveric Iveric Rveric Sveric SIveric CSLveric CIveric SRveric Bveric Fveric.
-
-Definition argsHaveTyps (vals:list val) (types: list type): Prop:=
-  Forall2 (fun v t => v<>Vundef -> Val.has_type v t) vals (map typ_of_type types).
-
-Definition funspec_sub_si (f1 f2 : funspec):mpred :=
-match f1 with
-| mk_funspec tpsig1 cc1 A1 P1 Q1 _ _ =>
-    match f2 with
-    | mk_funspec tpsig2 cc2 A2 P2 Q2 _ _ =>
-        !!(tpsig1=tpsig2 /\ cc1=cc2) &&
-        (|> ! (ALL ts2 :_, ALL x2:functors.MixVariantFunctor._functor 
-                              (rmaps.dependent_type_functor_rec ts2 A2) mpred,
-             ALL gargs:genviron * list val,
-        ((!!(argsHaveTyps(snd gargs)(fst tpsig1)) && P2 ts2 x2 gargs)
-         >=> ghost_seplog.fupd Ensembles.Full_set Ensembles.Full_set (EX ts1:_,  EX x1:_, EX F:_, 
-            (F * (P1 ts1 x1 gargs)) &&
-            ALL rho':_, (     !( ((!!(ve_of rho' = Map.empty (block * type))) && (F * (Q1 ts1 x1 rho')))
-                         >=> (Q2 ts2 x2 rho')))))))
-    end
-end.
+Definition argsassert2assert `{heapGS Σ} (ids: list ident) (M:argsassert):assert :=
+  assert_of (fun rho => M (ge_of rho, map (fun i => eval_id i rho) ids)).
 
-Definition funspec_sub (f1 f2 : funspec): Prop :=
-match f1 with
-| mk_funspec tpsig1 cc1 A1 P1 Q1 _ _ =>
-    match f2 with
-    | mk_funspec tpsig2 cc2 A2 P2 Q2 _ _ =>
-        (tpsig1=tpsig2 /\ cc1=cc2) /\
-        forall ts2 x2 (gargs:argsEnviron),
-        ((!! (argsHaveTyps(snd gargs)(fst tpsig1)) && P2 ts2 x2 gargs)
-         |-- ghost_seplog.fupd Ensembles.Full_set Ensembles.Full_set (EX ts1:_,  EX x1:_, EX F:_, 
-                           (F * (P1 ts1 x1 gargs)) &&
-                               (!! (forall rho',
-                                           ((!!(ve_of rho' = Map.empty (block * type))) &&
-                                                 (F * (Q1 ts1 x1 rho')))
-                                         |-- (Q2 ts2 x2 rho')))))
-    end
-end.
+Section mpred.
 
-Lemma derives_eq':
-  @derives (functors.MixVariantFunctor._functor
-              functors.MixVariantFunctorGenerator.fidentity mpred) Nveric =
-  predicates_hered.derives(A := compcert_rmaps.RML.R.rmap)(AG := _)(EO := _).
-Proof.
-  do 2 extensionality; apply prop_ext; split.
-  - inversion 1; auto.
-  - constructor; auto.
-Qed.
-
-Lemma funspec_sub_iff: forall f1 f2, funspec_sub f1 f2 <-> seplog.funspec_sub f1 f2.
-Proof. intros. unfold funspec_sub. now rewrite derives_eq'. Qed.
-
-Lemma funspec_sub_refl f: funspec_sub f f.
-Proof.
-  rewrite funspec_sub_iff.
-  apply funspec_sub_refl.
-Qed.
-
-(*Redefining this lemma ensures that is uses @derives mpred Nveric, not @derives rmap...
-  Maybe do this with other lemmas, too?*)
-Lemma funspec_sub_sub_si f1 f2: funspec_sub f1 f2 -> TT |-- funspec_sub_si f1 f2.
-Proof. rewrite funspec_sub_iff. unseal_derives. apply funspec_sub_sub_si. Qed.
+Context `{!VSTGS OK_ty Σ}.
 
-Lemma funspec_sub_si_refl f: TT |-- funspec_sub_si f f.
-Proof.
-  apply funspec_sub_sub_si. apply funspec_sub_refl.
-Qed.
-
-Lemma funspec_sub_trans f1 f2 f3: funspec_sub f1 f2 -> 
-      funspec_sub f2 f3 -> funspec_sub f1 f3.
-Proof. rewrite !funspec_sub_iff. apply funspec_sub_trans. Qed.
-
-Lemma type_of_funspec_sub:
-  forall fs1 fs2, funspec_sub fs1 fs2 ->
-  type_of_funspec fs1 = type_of_funspec fs2.
-Proof.
-intros.
-destruct fs1, fs2; destruct H as [[? ?] _]. subst; simpl; auto.
-Qed.
-
-Lemma type_of_funspec_sub_si fs1 fs2:
-  funspec_sub_si fs1 fs2 |-- !!(type_of_funspec fs1 = type_of_funspec fs2).
-Proof.
-unseal_derives. intros w W.
-destruct fs1, fs2. destruct W as [[? ?] _]. subst; simpl; auto.
-Qed.
-
-Definition close_precondition (bodyparams: list ident) 
-    (P: argsEnviron -> mpred) (rho:environ) : mpred :=
- EX vals,
-   !!(map (Map.get (te_of rho)) bodyparams = map Some vals /\
-      Forall (fun v : val => v <> Vundef) vals) &&
-   P (ge_of rho, vals).
-
-Lemma close_precondition_e':
-   forall al (P: argsEnviron -> mpred) (rho: environ) ,
-   close_precondition al P rho |-- 
-   exp (fun vals =>
-   !!(map (Map.get (te_of rho)) al = map Some vals /\
-      Forall (fun v : val => v <> Vundef) vals) &&
-   P (ge_of rho, vals)).
-Proof. intros. unseal_derives. intros u p. simpl in p. simpl; trivial. Qed.
-
-Definition argsassert2assert (ids: list ident) (M:argsassert):assert :=
-  fun rho => M (ge_of rho, map (fun i => eval_id i rho) ids).
-
-Lemma close_argsassert f P rho vals (LNR: list_norepet (map fst (fn_params f) ++ map fst (fn_temps f))):
-  (!!(typecheck_temp_environ (te_of rho) (make_tycontext_t (fn_params f) (fn_temps f)) /\
-      map (Map.get (te_of rho)) (map fst (fn_params f)) = map Some vals /\
-      tc_vals (map snd (fn_params f)) vals)
-   && argsassert2assert (map fst (fn_params f))  P rho)
- |-- close_precondition (map fst (fn_params f))  P rho.
-Proof.
-  unfold close_precondition, argsassert2assert. normalize; destruct H as [TCE [EVAL TCV]].
-  unseal_derives.
-exists (map (fun i : ident => eval_id i rho) (map fst (fn_params f))).
-split; simpl; trivial. clear - LNR TCV TCE EVAL. 
-specialize (semax_prog.typecheck_temp_environ_eval_id LNR TCE); intros X.
-split; trivial. apply (@semax_call.tc_vals_Vundef _ (map snd (fn_params f))).
-rewrite X in EVAL; clear X. apply semax_prog.map_Some_inv in EVAL. rewrite EVAL; trivial.
-Qed.
-
-(* BEGIN from expr2.v *)
-Definition denote_tc_iszero v : mpred :=
-         match v with
-         | Vint i => prop (is_true (Int.eq i Int.zero))
-         | Vlong i => prop (is_true (Int64.eq i Int64.zero))
-         | _ => FF
-         end.
-
-Definition denote_tc_nonzero v : mpred :=
-         match v with
-         | Vint i => prop (i <> Int.zero)
-         | Vlong i =>prop (i <> Int64.zero)
-         | _ => FF end.
-
-Definition denote_tc_igt i v : mpred :=
-     match v with
-     | Vint i1 => prop (Int.unsigned i1 < Int.unsigned i)
-     | _ => FF
-     end.
-
-Definition denote_tc_lgt l v : mpred :=
-     match v with
-     | Vlong l1 => prop (Int64.unsigned l1 < Int64.unsigned l)
-     | _ => FF
-     end.
-
-Definition Zoffloat (f:float): option Z := (**r conversion to Z *)
-  match f with
-    | IEEE754.Binary.B754_finite s m (Zpos e) _ =>
-       Some (Zaux.cond_Zopp s (Zpos m) * Zpower_pos 2 e)%Z
-    | IEEE754.Binary.B754_finite s m 0 _ => Some (Zaux.cond_Zopp s (Zpos m))
-    | IEEE754.Binary.B754_finite s m (Zneg e) _ => Some (Zaux.cond_Zopp s (Zpos m / Zpower_pos 2 e))
-    | IEEE754.Binary.B754_zero _ => Some 0
-    | _ => None
-  end.  (* copied from CompCert 2.3, because it's missing in CompCert 2.4,
-             then adapted after CompCert 3.5 when Flocq was rearranged *)
-
-Definition Zofsingle (f: float32): option Z := (**r conversion to Z *)
-  match f with
-    | IEEE754.Binary.B754_finite s m (Zpos e) _ =>
-       Some (Zaux.cond_Zopp s (Zpos m) * Zpower_pos 2 e)%Z
-    | IEEE754.Binary.B754_finite s m 0 _ => Some (Zaux.cond_Zopp s (Zpos m))
-    | IEEE754.Binary.B754_finite s m (Zneg e) _ => Some (Zaux.cond_Zopp s (Zpos m / Zpower_pos 2 e))
-    | IEEE754.Binary.B754_zero _ => Some 0
-    | _ => None
-  end. 
-
-Definition denote_tc_Zge z v : mpred :=
-          match v with
-                     | Vfloat f => match Zoffloat f with
-                                    | Some n => prop (z >= n)
-                                    | None => FF
-                                   end
-                     | Vsingle f => match Zofsingle f with
-                                    | Some n => prop (z >= n)
-                                    | None => FF
-                                   end
-                     | _ => FF
-                  end.
-
-Definition denote_tc_Zle z v : mpred :=
-          match v with
-                     | Vfloat f => match Zoffloat f with
-                                    | Some n => prop (z <= n)
-                                    | None => FF
-                                   end
-                     | Vsingle f => match Zofsingle f with
-                                    | Some n => prop (z <= n)
-                                    | None => FF
-                                   end
-                     | _ => FF
-                  end.
-
-Definition sameblock v1 v2 : bool :=
-         match v1, v2 with
-          | Vptr b1 _, Vptr b2 _ => peq b1 b2
-          | _, _ => false
-         end.
-
-Definition denote_tc_samebase v1 v2 : mpred :=
-       prop (is_true (sameblock v1 v2)).
-
-(** Case for division of int min by -1, which would cause overflow **)
-Definition denote_tc_nodivover v1 v2 : mpred :=
-match v1, v2 with
-          | Vint n1, Vint n2 => prop (~(n1 = Int.repr Int.min_signed /\ n2 = Int.mone))
-          | Vlong n1, Vlong n2 => prop (~(n1 = Int64.repr Int64.min_signed /\ n2 = Int64.mone))
-          | Vint n1, Vlong n2 => TT
-          | Vlong n1, Vint n2 => prop (~ (n1 = Int64.repr Int64.min_signed  /\ n2 = Int.mone))
-          | _ , _ => FF
-        end.
-
-Definition denote_tc_nosignedover (op: Z->Z->Z) (s: signedness) v1 v2 : mpred :=
- match v1,v2 with
- | Vint n1, Vint n2 => 
-   prop (Int.min_signed <= op (Int.signed n1) (Int.signed n2) <= Int.max_signed)
- | Vlong n1, Vlong n2 =>
-   prop (Int64.min_signed <= op (Int64.signed n1) (Int64.signed n2) <= Int64.max_signed)
- | Vint n1, Vlong n2 =>
-   prop (Int64.min_signed <= op ((if s then Int.signed else Int.unsigned) n1) (Int64.signed n2) <= Int64.max_signed)
- | Vlong n1, Vint n2 =>
-   prop (Int64.min_signed <= op (Int64.signed n1) ((if s then Int.signed else Int.unsigned)  n2) <= Int64.max_signed)
- | _, _ => FF
- end.
-
-Definition denote_tc_initialized id ty rho : mpred :=
-    prop (exists v, Map.get (te_of rho) id = Some v
-               /\ tc_val ty v).
-
-Definition denote_tc_isptr v : mpred :=
-  prop (isptr v).
-
-Definition denote_tc_isint v : mpred :=
-  prop (is_int I32 Signed v).
-
-Definition denote_tc_islong v : mpred :=
-  prop (is_long v).
-
-Definition test_eq_ptrs v1 v2 : mpred :=
-  if sameblock v1 v2
-  then (andp (weak_valid_pointer v1) (weak_valid_pointer v2))
-  else (andp (valid_pointer v1) (valid_pointer v2)).
-
-Definition test_order_ptrs v1 v2 : mpred :=
-  if sameblock v1 v2
-  then (andp (weak_valid_pointer v1) (weak_valid_pointer v2))
-  else FF.
-
-Definition denote_tc_test_eq v1 v2 : mpred :=
- match v1, v2 with
- | Vint i, Vint j => 
-     if Archi.ptr64 then FF else andp (prop (i = Int.zero)) (prop (j = Int.zero))
- | Vlong i, Vlong j => 
-     if Archi.ptr64 then andp (prop (i = Int64.zero)) (prop (j = Int64.zero)) else FF
- | Vint i, Vptr _ _ =>
-      if Archi.ptr64 then FF else andp (prop (i = Int.zero)) (weak_valid_pointer v2)
- | Vlong i, Vptr _ _ =>
-      if Archi.ptr64 then andp (prop (i = Int64.zero)) (weak_valid_pointer v2) else FF
- | Vptr _ _, Vint i =>
-      if Archi.ptr64 then FF else andp (prop (i = Int.zero)) (weak_valid_pointer v1)
- | Vptr _ _, Vlong i =>
-      if Archi.ptr64 then andp (prop (i = Int64.zero)) (weak_valid_pointer v1) else FF
- | Vptr _ _, Vptr _ _ =>
-      test_eq_ptrs v1 v2
- | _, _ => FF
- end.
-
-Definition denote_tc_test_order v1 v2 : mpred :=
- match v1, v2 with
- | Vint i, Vint j => if Archi.ptr64 then FF else andp (prop (i = Int.zero)) (prop (j = Int.zero))
- | Vlong i, Vlong j => if Archi.ptr64 then andp (prop (i = Int64.zero)) (prop (j = Int64.zero)) else FF
- | Vptr _ _, Vptr _ _ =>
-      test_order_ptrs v1 v2
- | _, _ => FF
- end.
-
-Definition typecheck_error (e: tc_error) : Prop := False.
-Global Opaque typecheck_error.
-
-(* Somehow, this fixes a universe collapse issue that will occur if fool is not defined. *)
-Definition fool := @map _ Type (fun it : ident * type => mpred).
-
-Fixpoint denote_tc_assert {CS: compspecs} (a: tc_assert) : environ -> mpred :=
-  match a with
-  | tc_FF msg => `(prop (typecheck_error msg))
-  | tc_TT => TT
-  | tc_andp' b c => fun rho => andp (denote_tc_assert b rho) (denote_tc_assert c rho)
-  | tc_orp' b c => `orp (denote_tc_assert b) (denote_tc_assert c)
-  | tc_nonzero' e => `denote_tc_nonzero (eval_expr e)
-  | tc_isptr e => `denote_tc_isptr (eval_expr e)
-  | tc_isint e => `denote_tc_isint (eval_expr e)
-  | tc_islong e => `denote_tc_islong (eval_expr e)
-  | tc_test_eq' e1 e2 => `denote_tc_test_eq (eval_expr e1) (eval_expr e2)
-  | tc_test_order' e1 e2 => `denote_tc_test_order (eval_expr e1) (eval_expr e2)
-  | tc_ilt' e i => `(denote_tc_igt i) (eval_expr e)
-  | tc_llt' e i => `(denote_tc_lgt i) (eval_expr e)
-  | tc_Zle e z => `(denote_tc_Zge z) (eval_expr e)
-  | tc_Zge e z => `(denote_tc_Zle z) (eval_expr e)
-  | tc_samebase e1 e2 => `denote_tc_samebase (eval_expr e1) (eval_expr e2)
-  | tc_nodivover' v1 v2 => `denote_tc_nodivover (eval_expr v1) (eval_expr v2)
-  | tc_initialized id ty => denote_tc_initialized id ty
-  | tc_iszero' e => `denote_tc_iszero (eval_expr e)
-  | tc_nosignedover op e1 e2 => 
-     match typeof e1, typeof e2 with
-     | Tlong _ _, Tint _ Unsigned _ => `(denote_tc_nosignedover op Unsigned) (eval_expr e1) (eval_expr e2)
-     | Tint _ Unsigned _, Tlong _ _ => `(denote_tc_nosignedover op Unsigned) (eval_expr e1) (eval_expr e2)
-     | _, _ =>  `(denote_tc_nosignedover op Signed) (eval_expr e1) (eval_expr e2)
-     end
- end.
-
-Definition fool' := @map _ Type (fun it : ident * type => mpred).
-
-Opaque mpred Nveric Sveric Cveric Iveric Rveric Sveric SIveric CSLveric CIveric SRveric Bveric.
-
-(* END from expr2.v *)
-
-Definition cast_pointer_to_bool t1 t2 :=
- match t1 with (Tpointer _ _ | Tarray _ _ _ | Tfunction _ _ _) => 
-           match t2 with Tint IBool _ _ => true | _ => false end
- | _ => false
-end.
+(* Somehow, this fixes a universe collapse issue that will occur if fool is not defined.
+Definition fool := @map _ Type (fun it : ident * type => mpred).*)
 
 Fixpoint ext_link_prog' (dl: list (ident * globdef fundef type)) (s: String.string) : option ident :=
  match dl with
@@ -504,857 +84,115 @@ Fixpoint ext_link_prog' (dl: list (ident * globdef fundef type)) (s: String.stri
 Definition ext_link_prog (p: program) (s: String.string) : ident :=
   match ext_link_prog' (prog_defs p) s with Some id => id | None => 1%positive end.
 
-Definition closed_wrt_vars {B} (S: ident -> Prop) (F: environ -> B) : Prop :=
-  forall rho te',
-     (forall i, S i \/ Map.get (te_of rho) i = Map.get te' i) ->
-     F rho = F (mkEnviron (ge_of rho) (ve_of rho) te').
-
-Definition closed_wrt_lvars {B} (S: ident -> Prop) (F: environ -> B) : Prop :=
-  forall rho ve',
-     (forall i, S i \/ Map.get (ve_of rho) i = Map.get ve' i) ->
-     F rho = F (mkEnviron (ge_of rho) ve' (te_of rho)).
-
-Definition not_a_param (params: list (ident * type)) (i : ident) : Prop :=
-  ~ In i (map (@fst _ _) params).
-
-Definition precondition_closed (fs: list (ident*type)) {A: rmaps.TypeTree}
-  (P: forall ts, functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts (AssertTT A)) mpred) : Prop :=
- forall ts x,
-  closed_wrt_vars (not_a_param fs) (P ts x) /\
-  closed_wrt_lvars (fun _ => True) (P ts x).
-
-Definition typed_true (t: type) (v: val)  : Prop :=  strict_bool_val v t
-= Some true.
-
-Definition typed_false (t: type)(v: val) : Prop :=  strict_bool_val v t =
-Some false.
-
-Definition substopt {A} (ret : option ident) (v : environ -> val) (P : environ -> A):=
-match ret with
-| Some id => subst id v P
-| None => P
-end.
-
-Definition cast_expropt {CS: compspecs} (e: option expr) t : environ -> option val :=
- match e with Some e' => `Some (eval_expr (Ecast e' t))  | None => `None end.
-
-Definition typecheck_tid_ptr_compare
-Delta id :=
-match (temp_types Delta) ! id with
-| Some t => is_int_type t
-| None => false
-end.
-
-Definition mapsto (sh: Share.t) (t: type) (v1 v2 : val): mpred :=
-  match access_mode t with
-  | By_value ch =>
-   match type_is_volatile t with
-   | false =>
-    match v1 with
-     | Vptr b ofs =>
-       if readable_share_dec sh
-       then @orp mpred _ 
-            (@andp mpred _ (!!tc_val t v2)
-             (res_predicates.address_mapsto ch v2 sh (b, Ptrofs.unsigned ofs)))
-            (@andp mpred _ (!! (v2 = Vundef))
-             (@exp mpred _ val (fun v2' =>res_predicates.address_mapsto ch v2' sh (b, Ptrofs.unsigned ofs))))
-       else @andp mpred _ 
-              (!! (tc_val' t v2 /\ (Memdata.align_chunk ch | Ptrofs.unsigned ofs)))
-              (res_predicates.nonlock_permission_bytes sh (b, Ptrofs.unsigned ofs) (Memdata.size_chunk ch))
-     | _ => FF
-    end
-    | _ => FF
-    end
-  | _ => FF
-  end.
-
- 
-Definition mapsto_ sh t v1 := mapsto sh t v1 Vundef.
-
-Definition mapsto_zeros (n: Z) (sh: share) (a: val) : mpred :=
- match a with
-  | Vptr b z => 
-    !! (0 <= Ptrofs.unsigned z  /\ n + Ptrofs.unsigned z < Ptrofs.modulus)%Z &&
-    mapsto_memory_block.address_mapsto_zeros sh (Z.to_nat n) (b, Ptrofs.unsigned z)
-  | _ => FF
- end.
-
-Definition globals := ident -> val.
-
-Definition init_data2pred (gv: globals) (d: init_data)  (sh: share) (a: val)  : mpred :=
- match d with
-  | Init_int8 i => mapsto sh (Tint I8 Unsigned noattr) a (Vint (Int.zero_ext 8 i))
-  | Init_int16 i => mapsto sh (Tint I16 Unsigned noattr) a (Vint (Int.zero_ext 16 i))
-  | Init_int32 i => mapsto sh (Tint I32 Unsigned noattr) a (Vint i)
-  | Init_int64 i => mapsto sh (Tlong Unsigned noattr) a (Vlong i)
-  | Init_float32 r =>  mapsto sh (Tfloat F32 noattr) a (Vsingle r)
-  | Init_float64 r =>  mapsto sh (Tfloat F64 noattr) a (Vfloat r)
-  | Init_space n => mapsto_zeros n sh a
-  | Init_addrof symb ofs =>
-       match gv symb with
-       | Vptr b i => mapsto sh (Tpointer Tvoid noattr) a (Vptr b (Ptrofs.add i ofs))
-       | _ => mapsto_ sh (Tpointer Tvoid noattr) a
-       end
- end.
-
-Definition init_data_size (i: init_data) : Z :=
-  match i with
-  | Init_int8 _ => 1
-  | Init_int16 _ => 2
-  | Init_int32 _ => 4
-  | Init_int64 _ => 8
-  | Init_float32 _ => 4
-  | Init_float64 _ => 8
-  | Init_addrof _ _ => if Archi.ptr64 then 8 else 4
-  | Init_space n => Z.max n 0
-  end.
-
-Fixpoint init_data_list_size (il: list init_data) {struct il} : Z :=
-  match il with
-  | nil => 0
-  | i :: il' => init_data_size i + init_data_list_size il'
-  end.
-
-Fixpoint init_data_list2pred  (gv: globals)  (dl: list init_data)
-                           (sh: share) (v: val)  : mpred :=
-  match dl with
-  | d::dl' => sepcon (init_data2pred gv d sh v) 
-                  (init_data_list2pred gv dl' sh (offset_val (init_data_size d) v))
-  | nil => emp
- end.
-
-Definition readonly2share (rdonly: bool) : share :=
-  if rdonly then Ers else Ews.
-
-Definition globvar2pred (gv: ident->val) (idv: ident * globvar type) : mpred :=
-   if (gvar_volatile (snd idv))
-                       then  TT
-                       else    init_data_list2pred gv (gvar_init (snd idv))
-                                   (readonly2share (gvar_readonly (snd idv))) (gv (fst idv)).
-
-Definition globals_of_env (rho: environ) (i: ident) : val := 
-  match Map.get (ge_of rho) i with Some b => Vptr b Ptrofs.zero | None => Vundef end.
-
-Definition globals_of_genv (g : genviron) (i : ident):=
-  match Map.get g i with
-| Some b => Vptr b Ptrofs.zero
-| None => Vundef
-end.
-
-Lemma globals_of_genv_char {rho}: globals_of_genv (ge_of rho) = globals_of_env rho.
-Proof. reflexivity. Qed.
-
-Definition globvars2pred (gv: globals)  (vl: list (ident * globvar type)): mpred :=
-  fold_right sepcon emp (map (globvar2pred gv) vl).
-
-Definition initializer_aligned (z: Z) (d: init_data) : bool :=
-  match d with
-  | Init_int16 n => Zeq_bool (z mod 2) 0
-  | Init_int32 n => Zeq_bool (z mod 4) 0
-  | Init_int64 n => Zeq_bool (z mod 8) 0
-  | Init_float32 n =>  Zeq_bool (z mod 4) 0
-  | Init_float64 n =>  Zeq_bool (z mod 8) 0
-  | Init_addrof symb ofs =>  Zeq_bool (z mod (size_chunk Mptr)) 0
-  | _ => true
-  end.
-
-Fixpoint initializers_aligned (z: Z) (dl: list init_data) : bool :=
-  match dl with
-  | nil => true
-  | d::dl' => andb (initializer_aligned z d) (initializers_aligned (z + init_data_size d) dl')
-  end.
-
-Definition funsig := (list (ident*type) * type)%type. (* argument and result signature *)
-
-Definition memory_block (sh: share) (n: Z) (v: val) : mpred :=
- match v with
- | Vptr b ofs => (!! (Ptrofs.unsigned ofs + n < Ptrofs.modulus)) && mapsto_memory_block.memory_block' sh (Z.to_nat n) b (Ptrofs.unsigned ofs)
- | _ => FF
- end.
-
-Lemma memory_block_zero_Vptr: forall sh b z, memory_block sh 0 (Vptr b z) = emp.
-Proof. exact mapsto_memory_block.memory_block_zero_Vptr. Qed.
-
-Lemma mapsto_mapsto_: forall sh t v v', mapsto sh t v v' |-- mapsto_ sh t v.
-Proof. constructor; apply mapsto_memory_block.mapsto_mapsto_. Qed.
-
-Lemma mapsto_tc_val': forall sh t p v, mapsto sh t p v |-- !! tc_val' t v.
-Proof. constructor; apply mapsto_memory_block.mapsto_tc_val'. Qed.
-
-Lemma memory_block_split:
-  forall (sh : share) (b : block) (ofs n m : Z),
-  0 <= n ->
-  0 <= m ->
-  n + m <= n + m + ofs < Ptrofs.modulus ->
-  memory_block sh (n + m) (Vptr b (Ptrofs.repr ofs)) =
-  memory_block sh n (Vptr b (Ptrofs.repr ofs)) *
-  memory_block sh m (Vptr b (Ptrofs.repr (ofs + n))).
-Proof. exact mapsto_memory_block.memory_block_split. Qed.
-
-Lemma mapsto_share_join:
- forall sh1 sh2 sh t p v,
-   sepalg.join sh1 sh2 sh ->
-   mapsto sh1 t p v * mapsto sh2 t p v = mapsto sh t p v.
-Proof.
-intros.
-apply  mapsto_memory_block.mapsto_share_join; auto.
-Qed.
-
-Lemma memory_block_share_join:
-  forall sh1 sh2 sh n p,
-   sepalg.join sh1 sh2 sh ->
-   memory_block sh1 n p * memory_block sh2 n p = memory_block sh n p.
-Proof.
-intros.
-apply  mapsto_memory_block.memory_block_share_join; auto.
-Qed.
-
-Lemma mapsto_conflict:
-  forall sh t v v2 v3,
-  sepalg.nonunit sh ->
-  mapsto sh t v v2 * mapsto sh t v v3 |-- FF.
-Proof.
-constructor; intros.
-apply mapsto_memory_block.mapsto_conflict; auto.
-Qed.
-
-Lemma memory_block_conflict: forall sh n m p,
-  sepalg.nonunit sh ->
-  0 < n <= Ptrofs.max_unsigned -> 0 < m <= Ptrofs.max_unsigned ->
-  memory_block sh n p * memory_block sh m p |-- FF.
-Proof.
-constructor; intros.
-apply mapsto_memory_block.memory_block_conflict; auto.
-Qed.
-
 (* TODO: merge size_compatible and align_compatible *)
 Definition align_compatible {C: compspecs} t p :=
   match p with
   | Vptr b i_ofs => align_compatible_rec cenv_cs t (Ptrofs.unsigned i_ofs)
-  | _ => True
-  end.
-
-Definition size_compatible {C: compspecs} t p :=
-  match p with
-  | Vptr b i_ofs => Ptrofs.unsigned i_ofs + sizeof t < Ptrofs.modulus
-  | _ => True
+  | _ => True%type
   end.
 
-Lemma mapsto_valid_pointer: forall {cs: compspecs} sh t p v i,
-  size_compatible t p ->
-  0 <= i < sizeof t ->
-  sepalg.nonidentity sh ->
-  mapsto sh t p v |-- valid_pointer (offset_val i p).
-Proof. constructor; eapply @mapsto_valid_pointer; auto. Qed.
-
-Lemma memory_block_valid_pointer: forall {cs: compspecs} sh n p i,
-  0 <= i < n ->
-  sepalg.nonidentity sh ->
-  memory_block sh n p |-- valid_pointer (offset_val i p).
-Proof. constructor; apply @memory_block_valid_pointer; auto. Qed.
-
-Lemma memory_block_weak_valid_pointer: forall {cs: compspecs} sh n p i,
-  0 <= i <= n -> 0 < n -> sepalg.nonidentity sh ->
-  memory_block sh n p |-- weak_valid_pointer (offset_val i p).
-Proof. constructor; apply @memory_block_weak_valid_pointer; auto. Qed.
-
-Lemma mapsto_zeros_memory_block: forall sh n p,
-  readable_share sh ->
-  mapsto_zeros n sh p |--
-  memory_block sh n p.
-Proof. constructor; apply mapsto_memory_block.mapsto_zeros_memory_block; auto. Qed.
-
-Lemma mapsto_pointer_void:
-  forall sh t a, 
-    eqb_type (Tpointer t a) int_or_ptr_type = false ->
-    eqb_type (Tpointer Tvoid a) int_or_ptr_type = false ->
-    mapsto sh (Tpointer t a) = mapsto sh (Tpointer Tvoid a).
-Proof. exact mapsto_memory_block.mapsto_pointer_void. Qed.
-
-Lemma mapsto_unsigned_signed:
- forall sign1 sign2 sh sz v i,
-  mapsto sh (Tint sz sign1 noattr) v (Vint (Cop.cast_int_int sz sign1 i)) =
-  mapsto sh (Tint sz sign2 noattr) v (Vint (Cop.cast_int_int sz sign2 i)).
-Proof. exact Clight_mapsto_memory_block.mapsto_unsigned_signed. Qed.
-
-Lemma mapsto_tuint_tint:
-  forall sh, mapsto sh tuint = mapsto sh tint.
-Proof. exact Clight_mapsto_memory_block.mapsto_tuint_tint. Qed.
-
-Lemma mapsto_tuint_tptr_nullval:
-  forall sh p t, 
-  mapsto sh (Tpointer t noattr) p nullval = mapsto sh size_t p nullval.
-Proof.  exact mapsto_memory_block.mapsto_tuint_tptr_nullval. Qed.
-
-Lemma mapsto_size_t_tptr_nullval:
-  forall sh p t, mapsto sh (Tpointer t noattr) p nullval = mapsto sh size_t p nullval.
-Proof. exact mapsto_memory_block.mapsto_tuint_tptr_nullval. Qed.
-
-Definition is_int32_noattr_type t :=
- match t with
- | Tint I32 _ {| attr_volatile := false; attr_alignas := None |} => True
- | _ => False
- end.
-
-Lemma mapsto_mapsto_int32:
-  forall sh t1 t2 p v,
-   is_int32_noattr_type t1 ->
-   is_int32_noattr_type t2 ->
-   mapsto sh t1 p v |-- mapsto sh t2 p v.
-Proof. constructor; apply mapsto_memory_block.mapsto_mapsto_int32; auto. Qed.
-
-Lemma mapsto_mapsto__int32:
-  forall sh t1 t2 p v,
-   is_int32_noattr_type t1 ->
-   is_int32_noattr_type t2 ->
-   mapsto sh t1 p v |-- mapsto_ sh t2 p.
-Proof. constructor; apply mapsto_memory_block.mapsto_mapsto__int32; auto. Qed.
-
-Lemma mapsto_null_mapsto_pointer:
-  forall t sh v,
-       Archi.ptr64 = false ->
-             mapsto sh tint v nullval =
-             mapsto sh (tptr t) v nullval.
-Proof. exact Clight_mapsto_memory_block.mapsto_null_mapsto_pointer. Qed.
-
-Definition eval_lvar (id: ident) (ty: type) (rho: environ) :=
- match Map.get (ve_of rho) id with
-| Some (b, ty') => if eqb_type ty ty' then Vptr b Ptrofs.zero else Vundef
-| None => Vundef
-end.
-
-Definition var_block (sh: Share.t) {cs: compspecs} (idt: ident * type) : environ -> mpred :=
-  !! (sizeof (snd idt) <= Ptrofs.max_unsigned) &&
-  `(memory_block sh (sizeof (snd idt)))
-             (eval_lvar (fst idt) (snd idt)).
-
-Definition stackframe_of {cs: compspecs} (f: Clight.function) : environ->mpred :=
-  fold_right sepcon emp (map (var_block Tsh) (fn_vars f)).
-
-Lemma  subst_derives {A}{NA: NatDed A}:
- forall a v (P Q: environ -> A), (P |-- Q) -> subst a v P |-- subst a v Q.
-Proof.
-unfold subst, derives.
-simpl;
-auto.
-Qed.
-
-(*We're exporting the step-indexed version so that semax_fun_id does syntatically not change*)
+(*We're exporting the step-indexed version so that semax_fun_id doesn't syntactically change*)
 Definition func_ptr (f: funspec) (v: val): mpred := seplog.func_ptr_si f v.
 
 (*veric.seplog has a lemma that weakens the hypothesis here to funspec_sub_si*)
-Lemma func_ptr_mono fs gs v (H:funspec_sub fs gs): func_ptr fs v |-- func_ptr gs v.
-Proof. constructor; apply funspec_sub_implies_func_prt_si_mono.
-       now rewrite <- funspec_sub_iff.
-Qed.
+Lemma func_ptr_mono fs gs v (H:funspec_sub fs gs): func_ptr fs v ⊢ func_ptr gs v.
+Proof. apply funspec_sub_implies_func_prt_si_mono; done. Qed.
 
-Lemma corable_func_ptr: forall f v, corable (func_ptr f v).
-Proof.
-  intros. apply assert_lemmas.corable_func_ptr_si.
-Qed.
-
-Lemma func_ptr_isptr: forall spec f, func_ptr spec f |-- !! isptr f.
-Proof. constructor; apply seplog.func_ptr_si_isptr.
-Qed.
-
-Lemma func_ptr_si_valid_pointer: forall spec f, func_ptr_si spec f |-- valid_pointer f.
-Proof. constructor. apply (@func_ptr_si_valid_pointer _ spec f). Qed.
-
-Lemma func_ptr_valid_pointer: forall spec f, func_ptr spec f |-- valid_pointer f.
-Proof. constructor. unfold func_ptr. apply func_ptr_si_valid_pointer. Qed.
-
-Definition NDmk_funspec (f: compcert_rmaps.typesig) (cc: calling_convention)
-  (A: Type) (Pre: A -> argsEnviron -> mpred) (Post: A -> environ -> mpred): funspec :=
-  mk_funspec f cc (rmaps.ConstType A) (fun _ => Pre) (fun _ => Post)
-    (args_const_super_non_expansive _ _) (const_super_non_expansive _ _).
-
-Lemma approx_func_ptr: forall (A: Type) sig cc P Q (v: val) (n: nat),
-  compcert_rmaps.RML.R.approx (S n) (func_ptr_si (NDmk_funspec sig cc A P Q) v) =
-  compcert_rmaps.RML.R.approx (S n) (func_ptr_si (NDmk_funspec sig cc A (fun a rho => compcert_rmaps.RML.R.approx n (P a rho)) (fun a rho => compcert_rmaps.RML.R.approx n (Q a rho))) v).
-Proof. exact seplog.approx_func_ptr_si. Qed.
+Lemma func_ptr_isptr: forall spec f, func_ptr spec f ⊢ ⌜isptr f⌝.
+Proof. apply seplog.func_ptr_si_isptr. Qed.
 
-Definition allp_fun_id (Delta : tycontext) (rho : environ): mpred :=
-ALL id : ident, ALL fs : funspec ,
-  !! ((glob_specs Delta) ! id = Some fs) -->
-  (EX b : block, !! (Map.get (ge_of rho) id = Some b) && func_ptr fs (Vptr b Ptrofs.zero)).
-
-Lemma corable_allp_fun_id: forall Delta rho,
-  corable (allp_fun_id Delta rho).
-Proof.
-  intros.
-  apply corable_allp; intros id.
-  apply corable_allp; intros fs.
-  apply corable_imp; [apply corable_prop |].
-  apply corable_exp; intros b.
-  apply corable_andp; [apply corable_prop |].
-  apply corable_func_ptr.
-Qed.
+Lemma func_ptr_valid_pointer fs v : func_ptr fs v ⊢ valid_pointer v.
+Proof. apply func_ptr_si_valid_pointer; done. Qed.
 
 Definition type_of_funsig (fsig: funsig) :=
    Tfunction (type_of_params (fst fsig)) (snd fsig) cc_default.
-Definition fn_funsig (f: function) : funsig := (fn_params f, fn_return f).
-
-Definition tc_fn_return (Delta: tycontext) (ret: option ident) (t: type) :=
- match ret with
- | None => True
- | Some i => match (temp_types Delta) ! i with Some t' => t=t' | _ => False end
- end.
-
-Definition globals_only (rho: environ) : environ :=
-    mkEnviron (ge_of rho) (Map.empty _) (Map.empty _).
-
-Fixpoint make_args (il: list ident) (vl: list val) (rho: environ)  :=
-  match il, vl with
-  | nil, nil => globals_only rho
-  | i::il', v::vl' => env_set (make_args il' vl' rho) i v
-   | _ , _ => rho
- end.
-Definition make_args' (fsig: funsig) args rho :=
-   make_args (map (@fst _ _) (fst fsig)) (args rho) rho.
-
-Definition ret_temp : ident := 1%positive.
-
-Definition get_result1 (ret: ident) (rho: environ) : environ :=
-   make_args (ret_temp::nil) (eval_id ret rho :: nil) rho.
-
-Definition get_result (ret: option ident) : environ -> environ :=
- match ret with
- | None => make_args nil nil
- | Some x => get_result1 x
- end.
-
-Definition maybe_retval (Q: assert) retty ret :=
- match ret with
- | Some id => fun rho => !!(tc_val' retty (eval_id id rho)) && Q (get_result1 id rho)
- | None =>
-    match retty with
-    | Tvoid => (fun rho => Q (globals_only rho))
-    | _ => fun rho => EX v: val, !!(tc_val' retty v) && Q (make_args (ret_temp::nil) (v::nil) rho)
-    end
- end.
-
-Definition bind_ret (vl: option val) (t: type) (Q: environ -> mpred) : environ -> mpred :=
-     match vl, t with
-     | None, Tvoid =>`Q (make_args nil nil)
-     | Some v, _ => @andp (environ->mpred) _ (!! tc_val t v)
-                             (`Q (make_args (ret_temp::nil) (v::nil)))
-     | _, _ => FF
-     end.
-
-Definition overridePost  (Q: environ->mpred)  (R: ret_assert) :=
- match R with 
-  {| RA_normal := _; RA_break := b; RA_continue := c; RA_return := r |} =>
-  {| RA_normal := Q; RA_break := b; RA_continue := c; RA_return := r |}
- end.
-
-Definition existential_ret_assert {A: Type} (R: A -> ret_assert) :=
-  {| RA_normal := fun rho => EX x:A, (R x).(RA_normal) rho;
-     RA_break := fun rho => EX x:A, (R x).(RA_break) rho;
-     RA_continue := fun rho => EX x:A, (R x).(RA_continue) rho;
-     RA_return := fun vl rho => EX x:A, (R x).(RA_return) vl rho
-   |}.
-
-Definition normal_ret_assert (Q: environ->mpred) : ret_assert :=
-  {| RA_normal := Q; RA_break := seplog.FF; RA_continue := seplog.FF; RA_return := fun _ => seplog.FF |}.
-
-Definition frame_ret_assert (R: ret_assert) (F: environ->mpred) : ret_assert :=
- match R with 
-  {| RA_normal := n; RA_break := b; RA_continue := c; RA_return := r |} =>
-  {| RA_normal := n * F; 
-     RA_break := b * F; 
-     RA_continue := c * F;
-     RA_return := fun vl => r vl * F |}
- end.
-
-Definition switch_ret_assert (R: ret_assert) : ret_assert :=
- match R with 
-  {| RA_normal := n; RA_break := b; RA_continue := c; RA_return := r |} =>
-  {| RA_normal := FF; 
-     RA_break := n; 
-     RA_continue := c;
-     RA_return := r |}
- end.
 
 Definition with_ge (ge: genviron) (G: environ->mpred) : mpred :=
      G (mkEnviron ge (Map.empty _) (Map.empty _)).
 
-
-Fixpoint prog_funct' {F V} (l: list (ident * globdef F V)) : list (ident * F) :=
- match l with nil => nil | (i,Gfun f)::r => (i,f):: prog_funct' r | _::r => prog_funct' r
- end.
-
-Definition prog_funct (p: program) := prog_funct' (prog_defs p).
-
-Fixpoint prog_vars' {F V} (l: list (ident * globdef F V)) : list (ident * globvar V) :=
- match l with nil => nil | (i,Gvar v)::r => (i,v):: prog_vars' r | _::r => prog_vars' r
- end.
-
-Definition prog_vars (p: program) := prog_vars' (prog_defs p).
-
-Definition all_initializers_aligned (prog: program) :=
-  forallb (fun idv => andb (initializers_aligned 0 (gvar_init (snd idv)))
-                                 (Zlt_bool (init_data_list_size (gvar_init (snd idv))) Ptrofs.modulus))
-                      (prog_vars prog) = true.
-
-Definition loop1_ret_assert (Inv: environ->mpred) (R: ret_assert) : ret_assert :=
- match R with 
-  {| RA_normal := n; RA_break := b; RA_continue := c; RA_return := r |} =>
-  {| RA_normal := Inv;
-     RA_break := n; 
-     RA_continue := Inv;
-     RA_return := r |}
- end.
-
-Definition loop2_ret_assert (Inv: environ->mpred) (R: ret_assert) : ret_assert :=
- match R with 
-  {| RA_normal := n; RA_break := b; RA_continue := c; RA_return := r |} =>
-  {| RA_normal := Inv;
-     RA_break := n;
-     RA_continue := seplog.FF;
-     RA_return := r |}
- end.
-
-Definition function_body_ret_assert (ret: type) (Q: environ->mpred) : ret_assert :=
- {| RA_normal := bind_ret None ret Q;
-    RA_break := seplog.FF; 
-    RA_continue := seplog.FF;
-    RA_return := fun vl => bind_ret vl ret Q |}.
-
-Definition loop_nocontinue_ret_assert (Inv: environ->mpred) (R: ret_assert) : ret_assert :=
- match R with 
-  {| RA_normal := n; RA_break := b; RA_continue := c; RA_return := r |} =>
-  {| RA_normal := Inv;
-     RA_break := n; 
-     RA_continue := seplog.FF;
-     RA_return := r |}
- end.
-
-Definition tc_environ (Delta: tycontext) : environ -> Prop :=
-   fun rho => typecheck_environ Delta rho.
-
-Definition tc_temp_id  (id: ident)  (ty: type) {CS: compspecs} (Delta: tycontext)
-                       (e:expr): environ -> mpred :=
-      denote_tc_assert (typecheck_temp_id id ty Delta e).
-
-(* TODO: remove this kind of definitions. *)
-Definition typeof_temp (Delta: tycontext) (id: ident) : option type :=
- match (temp_types Delta) ! id with
- | Some t => Some t
- | None => None
- end.
-
-Definition tc_expr {CS: compspecs} (Delta: tycontext) (e: expr) : environ -> mpred :=
-    denote_tc_assert (typecheck_expr Delta e).
-
-Definition tc_exprlist {CS: compspecs} (Delta: tycontext) (t: list type) (e: list expr)  : environ -> mpred :=
-      denote_tc_assert (typecheck_exprlist Delta t e).
-
-Definition tc_lvalue {CS: compspecs} (Delta: tycontext) (e: expr) : environ -> mpred :=
-     denote_tc_assert (typecheck_lvalue Delta e).
-
-Definition tc_expropt {CS: compspecs} Delta (e: option expr) (t: type) : environ -> mpred :=
-   match e with None => `!!(t=Tvoid)
-                     | Some e' => tc_expr Delta (Ecast e' t)
-   end.
-
-Definition is_comparison op :=
-match op with
-  | Cop.Oeq | Cop.One | Cop.Olt | Cop.Ogt | Cop.Ole | Cop.Oge => true
-  | _ => false
-end.
-
-Definition blocks_match op v1 v2  :=
-match op with Cop.Olt | Cop.Ogt | Cop.Ole | Cop.Oge =>
-  match v1, v2 with
-    Vptr b _, Vptr b2 _ => b=b2
-    | _, _ => False
-  end
-| _ => True
-end.
-
-Definition cmp_ptr_no_mem c v1 v2  :=
-match v1, v2 with
-Vptr b o, Vptr b1 o1 =>
-  if peq b b1 then
-    Val.of_bool (Ptrofs.cmpu c o o1)
-  else
-    match Val.cmp_different_blocks c with
-    | Some b => Val.of_bool b
-    | None => Vundef
-    end
-| _, _ => Vundef
-end.
-
-Definition op_to_cmp cop :=
-match cop with
-| Cop.Oeq => Ceq | Cop.One =>  Cne
-| Cop.Olt => Clt | Cop.Ogt =>  Cgt
-| Cop.Ole => Cle | Cop.Oge =>  Cge
-| _ => Ceq (*doesn't matter*)
-end.
-
 Fixpoint arglist (n: positive) (tl: list type) : list (ident*type) :=
  match tl with
   | nil => nil
-  | cons t tl' => (n,t):: arglist (n+1)%positive tl'
+  | t :: tl' => (n,t):: arglist (n+1)%positive tl'
  end.
 
-Definition closed_wrt_modvars c (F: environ->mpred) : Prop :=
-    closed_wrt_vars (modifiedvars c) F.
-
-Definition initblocksize (V: Type)  (a: ident * globvar V)  : (ident * Z) :=
- match a with (id,l) => (id , init_data_list_size (gvar_init l)) end.
-
-Definition main_pre {Z} (prog: program) (ora: Z) : (ident->val) -> argsassert :=
-(fun gv gvals => !!(gv = initialize.genviron2globals (fst gvals) /\snd gvals=nil) 
-       && globvars2pred gv (prog_vars prog) * has_ext ora).
-
-Definition main_post (prog: program) : (ident->val) -> assert :=
-(fun _ _ => TT).
-
-Definition main_spec_ext' {Z} (prog: program) (ora: Z)
-(post: (ident->val) -> environ -> mpred): funspec :=
-NDmk_funspec (nil, tint) cc_default (ident->val) (main_pre prog ora) post.
-
-Definition main_spec_ext {Z} (prog: program) (ora: Z): funspec :=
-NDmk_funspec (nil, tint) cc_default (ident->val) (main_pre prog ora) (main_post prog).
-
-Fixpoint match_globvars (gvs: list (ident * globvar type)) (V: varspecs) : bool :=
- match V with
- | nil => true
- | (id,t)::V' => match gvs with
-                       | nil => false
-                       | (j,g)::gvs' => if eqb_ident id j
-                                              then andb (eqb_type t (gvar_info g)) (match_globvars gvs' V')
-                                              else match_globvars gvs' V
-                      end
-  end.
-
-Definition int_range (sz: intsize) (sgn: signedness) (i: int) :=
- match sz, sgn with
- | I8, Signed => -128 <= Int.signed i < 128
- | I8, Unsigned => 0 <= Int.unsigned i < 256
- | I16, Signed => -32768 <= Int.signed i < 32768
- | I16, Unsigned => 0 <= Int.unsigned i < 65536
- | I32, Signed => -2147483648 <= Int.signed i < 2147483648
- | I32, Unsigned => 0 <= Int.unsigned i < 4294967296
- | IBool, _ => 0 <= Int.unsigned i < 256
-end.
-
-Lemma mapsto_value_range:
- forall sh v sz sgn i,
-   readable_share sh ->
-   mapsto sh (Tint sz sgn noattr) v (Vint i) =
-    !! int_range sz sgn i && mapsto sh (Tint sz sgn noattr) v (Vint i).
-Proof. exact mapsto_memory_block.mapsto_value_range. Qed.
-
-Definition semax_body_params_ok f : bool :=
-   andb
-        (compute_list_norepet (map (@fst _ _) (fn_params f) ++ map (@fst _ _) (fn_temps f)))
-        (compute_list_norepet (map (@fst _ _) (fn_vars f))).
-
-Definition var_sizes_ok {cs: compspecs} (vars: list (ident*type)) :=
-   Forall (fun var : ident * type => sizeof (snd var) <= Ptrofs.max_unsigned)%Z vars.
-
-Definition make_ext_rval  (gx: genviron) (tret: xtype) (v: option val):=
-  match tret with Xvoid => mkEnviron gx (Map.empty _) (Map.empty _) 
- | _ => 
-  match v with
-  | Some v' =>  mkEnviron gx (Map.empty _)
-                              (Map.set 1%positive v' (Map.empty _))
-  | None => mkEnviron gx (Map.empty _) (Map.empty _)
-  end end.
-
-Definition tc_option_val (sig: type) (ret: option val) :=
-  match sig, ret with
-    | Tvoid, _ => True
-    | ty, Some v => tc_val ty v
-    | _, _ => False
-  end.
-
-Fixpoint zip_with_tl {A : Type} (l1 : list A) (l2 : list type) : list (A*type) :=
-  match l1, l2 with
-    | a::l1', b :: l2' => (a,b)::zip_with_tl l1' l2'
-    | _, _ => nil
-  end.
-
-Definition  funspecs_norepeat (fs : funspecs) := list_norepet (map fst fs).
-
-Require VST.veric.semax_ext.
-
-Definition add_funspecs (Espec : OracleKind)
-         (ext_link: Strings.String.string -> ident)
-         (fs : funspecs) : OracleKind :=
-   veric.semax_ext.add_funspecs Espec ext_link fs.
-
-Definition funsig2signature (s : funsig) cc : signature :=
-  mksignature (map argtype_of_type (map snd (fst s))) (rettype_of_type (snd s)) cc.
-
-
-Definition decode_encode_val_ok (chunk1 chunk2: memory_chunk) : Prop :=
-  match chunk1, chunk2 with
-  | Mbool, Mbool => True
-  | Mint8signed, Mint8signed => True
-  | Mint8unsigned, Mint8signed => True
-  | Mint8signed, Mint8unsigned => True
-  | Mint8unsigned, Mint8unsigned => True
-  | Mint16signed, Mint16signed => True
-  | Mint16unsigned, Mint16signed => True
-  | Mint16signed, Mint16unsigned => True
-  | Mint16unsigned, Mint16unsigned => True
-  | Mint32, Mfloat32 => True
-  | Many32, Many32 => True
-  | Many64, Many64 => True
-  | Mint32, Mint32 => True
-  | Mint64, Mint64 => True
-  | Mint64, Mfloat64 => True
-  | Mfloat64, Mfloat64 =>  True
-  | Mfloat64, Mint64 =>  True
-  | Mfloat32, Mfloat32 =>  True
-  | Mfloat32, Mint32 =>  True
-  | _,_ => False
-  end.
-
-Definition numeric_type (t: type) : bool :=
-match t with
-| Tint IBool _ _ => false
-| Tint _ _ _ => true
-| Tlong _ _ => true
-| Tfloat _ _ => true
-| _ => false
-end.
-
-Transparent mpred Nveric Sveric Cveric Iveric Rveric Sveric SIveric SRveric Bveric.
+Definition loop_nocontinue_ret_assert := loop2_ret_assert.
 
 (* Misc lemmas *)
-Lemma typecheck_lvalue_sound {CS: compspecs} :
+Lemma typecheck_lvalue_sound {CS: compspecs} `{!heapGS Σ}:
   forall Delta rho e,
     typecheck_environ Delta rho ->
-    tc_lvalue Delta e rho |-- !! is_pointer_or_null (eval_lvalue e rho).
+    tc_lvalue Delta e rho ⊢ ⌜is_pointer_or_null (eval_lvalue e rho)⌝.
 Proof.
-constructor; intros.
-intros ? ?.
-eapply expr_lemmas4.typecheck_lvalue_sound; eauto.
+  exact expr_lemmas4.typecheck_lvalue_sound.
 Qed.
 
-Lemma typecheck_expr_sound {CS: compspecs} :
+Lemma typecheck_expr_sound {CS: compspecs}  `{!heapGS Σ}:
   forall Delta rho e,
     typecheck_environ Delta rho ->
-    tc_expr Delta e rho |-- !! tc_val (typeof e) (eval_expr e rho).
+    tc_expr Delta e rho ⊢ ⌜tc_val (typeof e) (eval_expr e rho)⌝.
 Proof.
-constructor; intros.
-intros ? ?.
-simpl.
-eapply expr_lemmas4.typecheck_expr_sound; eauto.
+  exact expr_lemmas4.typecheck_expr_sound.
 Qed.
 
-Lemma fash_func_ptr_ND:
- forall fsig cc (A: Type) 
-             (Pre Pre': A -> argsEnviron -> mpred) (Post Post': A -> environ -> mpred) v,
-   ALL a:A,
-         (ALL rho:argsEnviron, fash (Pre' a rho --> Pre a rho)) &&
-         (ALL rho:environ, fash (Post a rho --> Post' a rho))
-   |-- fash (func_ptr_si (NDmk_funspec fsig cc A Pre Post) v --> 
-                  func_ptr_si (NDmk_funspec fsig cc A Pre' Post') v).
-Proof. constructor. apply seplog.fash_func_ptr_ND. Qed.
 
 (***************LENB: ADDED THESE LEMMAS IN INTERFACE************************************)
 
-Lemma tc_expr_eq CS Delta e: @tc_expr CS Delta e = @extend_tc.tc_expr CS Delta e.
-Proof. reflexivity. Qed.
-
-Lemma denote_tc_assert_andp: (* from typecheck_lemmas *)
-  forall {CS: compspecs} (a b : tc_assert),
-  denote_tc_assert (tc_andp a b) = andp (denote_tc_assert a) (denote_tc_assert b).
-Proof.
-  intros.
-  extensionality rho.
-  simpl.
-  apply expr2.denote_tc_assert_andp.
-Qed.
-
 Lemma tc_expr_cspecs_sub: forall {CS CS'} (CSUB: cspecs_sub  CS CS') Delta e rho,
   tc_environ Delta rho ->
-  @tc_expr CS Delta e rho |-- @tc_expr CS' Delta e rho.
-Proof. intros. destruct CSUB as [CSUB _]. rewrite tc_expr_eq. constructor; intros w W. apply (extend_tc.tc_expr_cenv_sub CSUB e rho Delta). trivial. Qed.
-
-Lemma tc_expropt_char {CS} Delta e t: @tc_expropt CS Delta e t =
-                                      match e with None => `!!(t=Tvoid)
-                                              | Some e' => @tc_expr CS Delta (Ecast e' t)
-                                      end.
-Proof. reflexivity. Qed.
-
-Lemma tc_expropt_cenv_sub {CS CS'} (CSUB: cspecs_sub CS CS') Delta rho (D:typecheck_environ Delta rho) ret t:
-  @tc_expropt CS Delta ret t rho |-- @tc_expropt CS' Delta ret t rho.
-Proof.
-  destruct ret; simpl. 2: constructor; apply  predicates_hered.derives_refl.
-  apply (tc_expr_cspecs_sub CSUB Delta (Ecast e t) rho D). 
-Qed.
+  tc_expr(CS := CS) Delta e rho ⊢ tc_expr (CS := CS') Delta e rho.
+Proof. intros. destruct CSUB as [CSUB _]. apply (extend_tc.tc_expr_cenv_sub CSUB e rho Delta). Qed.
 
 Lemma tc_lvalue_cspecs_sub: forall {CS CS'} (CSUB: cspecs_sub  CS CS') Delta e rho,
   tc_environ Delta rho ->
-  @tc_lvalue CS Delta e rho |-- @tc_lvalue CS' Delta e rho.
-Proof. intros; simpl. destruct CSUB as [CSUB _]. constructor; red; intros. apply (extend_tc.tc_lvalue_cenv_sub CSUB e rho Delta). apply H0. Qed.
+  tc_lvalue (CS := CS) Delta e rho ⊢ tc_lvalue (CS := CS') Delta e rho.
+Proof. intros; simpl. destruct CSUB as [CSUB _]. apply (extend_tc.tc_lvalue_cenv_sub CSUB e rho Delta). Qed.
 
-Lemma tc_exprlist_cspecs_sub {CS CS'} (CSUB: cspecs_sub  CS CS') Delta rho: forall types e,
+Lemma tc_exprlist_cspecs_sub {CS CS'} (CSUB: cspecs_sub CS CS') Delta rho: forall types e,
   tc_environ Delta rho ->
-  @tc_exprlist CS Delta types e rho |-- @tc_exprlist CS' Delta types e rho.
-Proof. intros. destruct CSUB as [CSUB _]. constructor; intros w W. apply (extend_tc.tc_exprlist_cenv_sub CSUB Delta rho w types e W). Qed.
+  tc_exprlist (CS := CS) Delta types e rho ⊢ tc_exprlist (CS := CS') Delta types e rho.
+Proof. intros. destruct CSUB as [CSUB _]. apply (extend_tc.tc_exprlist_cenv_sub CSUB Delta rho). Qed.
 
-Lemma eval_exprlist_cspecs_sub {CS CS'} (CSUB: cspecs_sub  CS CS') Delta rho (TCD: tc_environ Delta rho):
+Lemma eval_exprlist_cspecs_sub {CS CS'} (CSUB: cspecs_sub CS CS') Delta rho (TCD: tc_environ Delta rho):
   forall types e,
-  @tc_exprlist CS Delta types e rho |-- !! (@eval_exprlist CS types e rho = @eval_exprlist CS' types e rho).
-Proof. intros. destruct CSUB as [CSUB _]. constructor; intros w W. eapply (expr_lemmas.typecheck_exprlist_sound_cenv_sub CSUB); eassumption. Qed.
+  tc_exprlist (CS := CS) Delta types e rho ⊢ ⌜@eval_exprlist CS types e rho = @eval_exprlist CS' types e rho⌝.
+Proof. intros. destruct CSUB as [CSUB _]. eapply (expr_lemmas.typecheck_exprlist_sound_cenv_sub CSUB); eassumption. Qed.
 
 Lemma denote_tc_assert_tc_bool_cs_invariant {CS CS'} b E:
-  @denote_tc_assert CS (tc_bool b E) = @denote_tc_assert CS' (tc_bool b E).
+  denote_tc_assert (CS := CS) (tc_bool b E) = denote_tc_assert (CS := CS') (tc_bool b E).
 Proof. unfold tc_bool. destruct b; reflexivity. Qed.
 
-Lemma tc_temp_id_cspecs_sub {CS CS'} (CSUB: cspecs_sub  CS CS') Delta rho e i:
-  tc_environ Delta rho -> @tc_temp_id i (typeof e) CS Delta e rho |-- @tc_temp_id i (typeof e) CS' Delta e rho.
+Lemma tc_temp_id_cspecs_sub {CS CS'} (CSUB: cspecs_sub CS CS') Delta rho e i:
+  tc_environ Delta rho -> tc_temp_id i (typeof e) (CS := CS) Delta e rho ⊢ tc_temp_id i (typeof e) (CS := CS') Delta e rho.
 Proof.
-  intros. constructor; unfold tc_temp_id, typecheck_temp_id; intros w W.
-  destruct ((temp_types Delta)! i); [| apply W].
-  rewrite denote_tc_assert_andp in W.
-  rewrite denote_tc_assert_andp; destruct W as [W1 W2];  split.
-+ rewrite (@denote_tc_assert_tc_bool_cs_invariant CS' CS). exact W1. 
-+ apply expr2.tc_bool_e in W1. eapply expr2.neutral_isCastResultType.
-  exact W1.
-Qed. 
-
-(*Proof exists in semax_call under name RA_eturn_castexpropt_cenv_sub -- repeat here for the exposed def of castexprof?*)
+  intros. unfold tc_temp_id, typecheck_temp_id; simpl.
+  destruct (Maps.PTree.get i (temp_types Delta)); last done.
+  rewrite !denote_tc_assert_andp.
+  iIntros "H"; iSplit.
+  + iDestruct "H" as "[H _]"; rewrite (@denote_tc_assert_tc_bool_cs_invariant CS' CS) //.
+  + rewrite tc_bool_e; iDestruct "H" as (?) "?".
+    by iApply (expr2.neutral_isCastResultType with "[$]").
+Qed.
+
 Lemma castexpropt_cenv_sub {CS CS'} (CSUB: cspecs_sub CS CS') Delta rho (D:typecheck_environ Delta rho) ret t:
-  @tc_expropt CS Delta ret t rho |-- !!(@cast_expropt CS ret t rho = @cast_expropt CS' ret t rho).
+  tc_expropt (CS := CS) Delta ret t rho ⊢ ⌜@cast_expropt CS ret t rho = @cast_expropt CS' ret t rho⌝.
 Proof.
-  constructor; intros w W. destruct CSUB as [CSUB _]. rewrite tc_expropt_char in W. destruct ret; [ | reflexivity].
-  specialize (expr_lemmas.typecheck_expr_sound_cenv_sub CSUB Delta rho D w (Ecast e t) W); clear W; intros H.
-  hnf. unfold cast_expropt. simpl; simpl in H. 
-  unfold force_val1, force_val, sem_cast, liftx, lift; simpl.
-  unfold force_val1, force_val, sem_cast, liftx, lift in H; simpl in H. rewrite H; trivial.
+  destruct CSUB; apply RA_return_castexpropt_cenv_sub; done.
 Qed.
 
-Lemma RA_return_cast_expropt_cspecs_sub: forall {CS CS'} (CSUB: cspecs_sub  CS CS') Delta e t R rho,
+Lemma RA_return_cast_expropt_cspecs_sub: forall {CS CS'} (CSUB: cspecs_sub CS CS') Delta e t R rho,
   tc_environ Delta rho ->
-  @tc_expropt CS Delta e t rho && RA_return R (@cast_expropt CS e t rho) (id rho)
-  |-- RA_return R (@cast_expropt CS' e t rho) (id rho).
+  tc_expropt (CS := CS) Delta e t rho ∧ RA_return R (@cast_expropt CS e t rho) (id rho)
+  ⊢ RA_return R (@cast_expropt CS' e t rho) (id rho).
 Proof.
-  intros. constructor; intros w [W1 W2].
-  pose proof (castexpropt_cenv_sub CSUB _ _ H e t) as H1. unseal_derives.
-  rewrite (H1 w W1) in W2. apply W2.
+  intros. rewrite castexpropt_cenv_sub //.
+  iIntros "(-> & $)".
 Qed.
 
 (********************************************* LENB: END OF ADDED LEMMAS********************)
 
 (* End misc lemmas *)
 
-Global Opaque mpred Nveric Sveric Cveric Iveric Rveric Sveric SIveric SRveric Bveric.
-
-(* Don't know why this next Hint doesn't work unless fully instantiated;
-   perhaps because one needs both "contractive" and "typeclass_instances"
-   Hint databases if this next line is not added. *)
-Definition subp_sepcon_mpred := @subp_sepcon mpred Nveric Iveric Sveric SIveric Rveric SRveric.
-#[export] Hint Resolve subp_sepcon_mpred: contractive.
-
 Fixpoint unfold_Ssequence c :=
   match c with
   | Ssequence c1 c2 => unfold_Ssequence c1 ++ unfold_Ssequence c2
@@ -1375,54 +213,46 @@ with nocontinue_ls sl :=
  match sl with LSnil => true | LScons _ s sl' => if nocontinue s then nocontinue_ls sl' else false
  end.
 
-Definition withtype_empty (A: rmaps.TypeTree) : Prop :=
-  forall ts : list Type,
- functors.MixVariantFunctor._functor
-   (rmaps.dependent_type_functor_rec ts A)
-   (predicates_hered.pred compcert_rmaps.RML.R.rmap) -> False.
+End mpred.
 
 Module Type CLIGHT_SEPARATION_HOARE_LOGIC_DEF.
 
-Parameter semax: forall {CS: compspecs} {Espec: OracleKind},
-    tycontext -> (environ->mpred) -> statement -> ret_assert -> Prop.
+Parameter semax: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {C : compspecs},
+  coPset → tycontext → assert → statement → ret_assert → Prop.
 
-Parameter semax_func:
-    forall {Espec: OracleKind},
-    forall (V: varspecs) (G: funspecs) {C: compspecs} (ge: Genv.t fundef type) (fdecs: list (ident * fundef)) (G1: funspecs), Prop.
+Parameter semax_func: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} (V : varspecs) (G : funspecs(Σ := Σ)) {C : compspecs},
+  Genv.t fundef type → list (ident * fundef) → funspecs(Σ := Σ) → Prop.
 
-Parameter semax_external: forall {Hspec: OracleKind} (ef: external_function) (A : rmaps.TypeTree)
-       (P: forall ts : list Type, functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts (ArgsTT A)) mpred)
-       (Q: forall ts : list Type, functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts (AssertTT A)) mpred), Prop.
+Parameter semax_external: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty}, external_function →
+  ∀ A : TypeTree, (@dtfr Σ (MaskTT A)) → (@dtfr Σ (ArgsTT A)) → (@dtfr Σ (AssertTT A)) → mpred.
 
 End CLIGHT_SEPARATION_HOARE_LOGIC_DEF.
 
 Module DerivedDefs (Def: CLIGHT_SEPARATION_HOARE_LOGIC_DEF).
 
-Local Open Scope pred.
-
-Definition semax_body
+Definition semax_body `{!VSTGS OK_ty Σ}
    (V: varspecs) (G: funspecs) {C: compspecs} (f: function) (spec: ident * funspec): Prop :=
-match spec with (_, mk_funspec fsig cc A P Q _ _) =>
-  fst fsig = map snd (fst (fn_funsig f)) /\ 
+match spec with (_, mk_funspec fsig cc A E P Q) =>
+  fst fsig = map snd (fst (fn_funsig f)) /\
   snd fsig = snd (fn_funsig f) /\
-forall Espec ts x,
-  @Def.semax C Espec (func_tycontext f V G nil)
-      (fun rho => close_precondition (map fst f.(fn_params)) (P ts x) rho * stackframe_of f rho)
+forall OK_spec (x:dtfr A),
+  Def.semax(OK_spec := OK_spec) (E x) (func_tycontext f V G nil)
+      (close_precondition (map fst f.(fn_params)) (argsassert_of (P x)) ∗ stackframe_of f)
        f.(fn_body)
-      (frame_ret_assert (function_body_ret_assert (fn_return f) (Q ts x)) (stackframe_of f))
+      (frame_ret_assert (function_body_ret_assert (fn_return f) (assert_of (Q x))) (stackframe_of f))
 end.
 
-Definition semax_prog {Espec: OracleKind}{C: compspecs}
-       (prog: program) (z: OK_ty) (V: varspecs) (G: funspecs) : Prop :=
+Definition semax_prog `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {C: compspecs}
+       (prog: program) (ora: OK_ty) (V: varspecs) (G: funspecs) : Prop :=
 compute_list_norepet (prog_defs_names prog) = true  /\
 all_initializers_aligned prog /\
-PTree.elements cenv_cs = PTree.elements (prog_comp_env prog) /\
-  @Def.semax_func Espec V G C (Genv.globalenv prog)  (prog_funct prog) G /\
-  match_globvars (prog_vars prog) V = true /\
-  match initial_world.find_id prog.(prog_main) G with
-  | Some s => exists post,
-             s = main_spec_ext' prog z post
-  | None => False
+Maps.PTree.elements cenv_cs = Maps.PTree.elements (prog_comp_env prog) /\
+Def.semax_func V G (Genv.globalenv prog) (prog_funct prog) G /\
+match_globvars (prog_vars prog) V = true /\
+match find_id prog.(prog_main) G with
+| Some s => exists post,
+      s = main_spec_ext' prog ora post
+| None => False
 end.
 
 End DerivedDefs.
@@ -1438,18 +268,23 @@ Import CSHL_Defs.
 
 (***************** SEMAX_LEMMAS ****************)
 
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs}.
+
+Axiom semax_mask_mono:
+  forall E E' Delta P c R, E ⊆ E' -> semax E Delta P c R -> semax E' Delta P c R.
+
 Axiom semax_extract_exists:
-  forall {CS: compspecs} {Espec: OracleKind},
-  forall (A : Type) (P : A -> environ->mpred) c (Delta: tycontext) (R: ret_assert),
-  (forall x, @semax CS Espec Delta (P x) c R) ->
-   @semax CS Espec Delta (EX x:A, P x) c R.
-  
-Axiom semax_func_nil:   forall {Espec: OracleKind},
-        forall V G C ge, @semax_func Espec V G C ge nil nil.
+  forall (A : Type) (P : A -> assert) c E (Delta: tycontext) (R: ret_assert),
+  (forall x, semax E Delta (P x) c R) ->
+   semax E Delta (∃ x:A, P x) c R.
+
+Axiom semax_func_nil:
+        forall V G ge, semax_func V G ge nil nil.
 
 Axiom semax_func_cons:
-  forall {Espec: OracleKind},
-     forall fs id f fsig cc A P Q NEP NEQ (V: varspecs) (G G': funspecs) {C: compspecs} ge b,
+     forall fs id f fsig cc E A P Q (V: varspecs) (G G': funspecs) ge b,
   andb (id_in_list id (map (@fst _ _) G))
   (andb (negb (id_in_list id (map (@fst ident Clight.fundef) fs)))
     (semax_body_params_ok f)) = true ->
@@ -1457,339 +292,319 @@ Axiom semax_func_cons:
      (fun it : ident * type =>
       complete_type cenv_cs (snd it) =
       true) (fn_vars f) ->
-   var_sizes_ok (f.(fn_vars)) ->
+   var_sizes_ok cenv_cs (f.(fn_vars)) ->
    f.(fn_callconv) = cc ->
    Genv.find_symbol ge id = Some b -> 
    Genv.find_funct_ptr ge b = Some (Internal f) -> 
-  semax_body V G f (id, mk_funspec fsig cc A P Q NEP NEQ) ->
+  semax_body V G f (id, mk_funspec fsig cc E A P Q) ->
   semax_func V G ge fs G' ->
   semax_func V G ge ((id, Internal f)::fs)
-       ((id, mk_funspec fsig cc A P Q NEP NEQ)  :: G').
+       ((id, mk_funspec fsig cc E A P Q)  :: G').
 
-Axiom semax_func_cons_ext: forall {Espec:OracleKind} (V: varspecs) (G: funspecs) 
-     {C: compspecs} ge fs id ef argsig retsig A P Q NEP NEQ
+Axiom semax_func_cons_ext: forall (V: varspecs) (G: funspecs) 
+     {C: compspecs} ge fs id ef argsig retsig A E (P: dtfr (ArgsTT A)) (Q: dtfr (AssertTT A))
       (G': funspecs) cc b,
   ef_sig ef = mksignature (map argtype_of_type argsig) (rettype_of_type retsig) cc ->
   id_in_list id (map (@fst _ _) fs) = false ->
-  (ef_inline ef = false \/ withtype_empty A) ->
-  (forall gx ts x (ret : option val),
-     (Q ts x (make_ext_rval gx (rettype_of_type retsig) ret)
-        && !!Builtins0.val_opt_has_rettype ret (rettype_of_type retsig)
-        |-- !!tc_option_val retsig ret)) ->
+  (ef_inline ef = false \/ @withtype_empty Σ A) ->
+  (forall gx x (ret : option val),
+     (Q x (make_ext_rval gx (rettype_of_type retsig) ret)
+        ∧ ⌜Builtins0.val_opt_has_rettype ret (rettype_of_type retsig)⌝
+        ⊢ ⌜tc_option_val retsig ret⌝)) ->
   Genv.find_symbol ge id = Some b -> Genv.find_funct_ptr ge b = Some (External ef argsig retsig cc) ->
-  @semax_external Espec ef A P Q ->
+  (⊢semax_external ef A E P Q) ->
   semax_func V G ge fs G' ->
   semax_func V G ge ((id, External ef argsig retsig cc)::fs)
-       ((id, mk_funspec (argsig, retsig) cc A P Q NEP NEQ)  :: G').
+       ((id, mk_funspec (argsig, retsig) cc A E P Q)  :: G').
 
-Axiom semax_func_mono: forall  {Espec CS CS'} (CSUB: cspecs_sub CS CS') ge ge'
+Axiom semax_func_mono: forall {CS'} (CSUB: cspecs_sub CS CS') ge ge'
   (Gfs: forall i,  sub_option (Genv.find_symbol ge i) (Genv.find_symbol ge' i))
   (Gffp: forall b, sub_option (Genv.find_funct_ptr ge b) (Genv.find_funct_ptr ge' b))
-  V G fdecs G1 (H: @semax_func Espec V G CS ge fdecs G1), @semax_func Espec V G CS' ge' fdecs G1.
+  V G fdecs G1 (H: semax_func V G (C := CS) ge fdecs G1), semax_func V G (C := CS') ge' fdecs G1.
 
 Axiom semax_func_app:
-  forall Espec ge cs V H funs1 funs2 G1 G2
-         (SF1: @semax_func Espec V H cs ge funs1 G1) (SF2: @semax_func Espec V H cs ge funs2 G2)
+  forall ge V H funs1 funs2 G1 G2
+         (SF1: semax_func V H ge funs1 G1) (SF2: semax_func V H ge funs2 G2)
          (L:length funs1 = length G1),
-    @semax_func Espec V H cs ge (funs1 ++ funs2) (G1++G2).
+    semax_func V H ge (funs1 ++ funs2) (G1++G2).
   
 Axiom semax_func_subsumption:
-  forall Espec ge cs V V' F F'
+  forall ge V V' F F'
          (SUB: tycontext_sub (nofunc_tycontext V F) (nofunc_tycontext V F'))
-         (HV: forall id, sub_option (make_tycontext_g V F) ! id (make_tycontext_g V' F') ! id),
-  forall funs G (SF: @semax_func Espec V F cs ge funs G),  @semax_func Espec V' F' cs ge funs G.
-  
+         (HV: forall id, sub_option ((make_tycontext_g V F) !! id) ((make_tycontext_g V' F') !! id)),
+  forall funs G (SF: semax_func V F ge funs G),  semax_func V' F' ge funs G.
+
 Axiom semax_func_join:
-  forall {Espec cs ge V1 H1 V2 H2 V funs1 funs2 G1 G2 H}
-  (SF1: @semax_func Espec V1 H1 cs ge funs1 G1) (SF2: @semax_func Espec V2 H2 cs ge funs2 G2)
+  forall {ge V1 H1 V2 H2 V funs1 funs2 G1 G2 H}
+  (SF1: semax_func V1 H1 ge funs1 G1) (SF2: semax_func V2 H2 ge funs2 G2)
 
-  (K1: forall i, sub_option ((make_tycontext_g V1 H1) ! i) ((make_tycontext_g V1 H) ! i))
-  (K2: forall i, subsumespec ((make_tycontext_s H1) ! i) ((make_tycontext_s H) ! i))
-  (K3: forall i, sub_option ((make_tycontext_g V1 H) ! i) ((make_tycontext_g V H) ! i))
+  (K1: forall i, sub_option ((make_tycontext_g V1 H1) !! i) ((make_tycontext_g V1 H) !! i))
+  (K2: forall i, subsumespec ((make_tycontext_s H1) !! i) ((make_tycontext_s H) !! i))
+  (K3: forall i, sub_option ((make_tycontext_g V1 H) !! i) ((make_tycontext_g V H) !! i))
+
+  (N1: forall i, sub_option ((make_tycontext_g V2 H2) !! i) ((make_tycontext_g V2 H) !! i))
+  (N2: forall i, subsumespec ((make_tycontext_s H2) !! i) ((make_tycontext_s H) !! i))
+  (N3: forall i, sub_option ((make_tycontext_g V2 H) !! i) ((make_tycontext_g V H) !! i)),
+semax_func V H ge (funs1 ++ funs2) (G1++G2).
 
-  (N1: forall i, sub_option ((make_tycontext_g V2 H2) ! i) ((make_tycontext_g V2 H) ! i))
-  (N2: forall i, subsumespec ((make_tycontext_s H2) ! i) ((make_tycontext_s H) ! i))
-  (N3: forall i, sub_option ((make_tycontext_g V2 H) ! i) ((make_tycontext_g V H) ! i)),
-  @semax_func Espec V H cs ge (funs1 ++ funs2) (G1++G2).
-  
 Axiom semax_func_firstn:
-  forall {Espec cs ge H V n funs G} (SF: @semax_func Espec V H cs ge funs G),
-    @semax_func Espec V H cs ge (firstn n funs) (firstn n G).
-  
+  forall {ge H V n funs G} (SF: semax_func V H ge funs G),
+    semax_func V H ge (firstn n funs) (firstn n G).
+
 Axiom semax_func_skipn:
-  forall {Espec cs ge H V funs G} (HV:list_norepet (map fst funs))
-         (SF: @semax_func Espec V H cs ge funs G) n,
-    @semax_func Espec V H cs ge (skipn n funs) (skipn n G).
+  forall {ge H V funs G} (HV: list_norepet (map fst funs)) (SF: semax_func V H ge funs G) n,
+    semax_func V H ge (skipn n funs) (skipn n G).
 
-Axiom semax_body_subsumption: forall cs V V' F F' f spec
-      (SF: @semax_body V F cs f spec)
+Axiom semax_body_subsumption: forall V V' F F' f spec
+      (SF: semax_body V F f spec)
       (TS: tycontext_sub (func_tycontext f V F nil) (func_tycontext f V' F' nil)),
-  @semax_body V' F' cs f spec.
+  semax_body V' F' f spec.
   
-Axiom semax_body_cenv_sub: forall {CS CS'} (CSUB: cspecs_sub CS CS') V G f spec
+Axiom semax_body_cenv_sub: forall {CS'} (CSUB: cspecs_sub CS CS') V G f spec
       (COMPLETE : Forall (fun it : ident * type => complete_type (@cenv_cs CS) (snd it) = true) (fn_vars f)),
-  @semax_body V G CS f spec -> @semax_body V G CS' f spec.
+  semax_body V G (C := CS) f spec -> semax_body V G (C := CS') f spec.
 
 (* THESE RULES FROM semax_loop *)
 
 Axiom semax_ifthenelse :
-  forall {CS: compspecs} {Espec: OracleKind},
-   forall Delta P (b: expr) c d R,
+   forall E Delta P (b: expr) c d R,
       bool_type (typeof b) = true ->
-     @semax CS Espec Delta (P && local (`(typed_true (typeof b)) (eval_expr b))) c R ->
-     @semax CS Espec Delta (P && local (`(typed_false (typeof b)) (eval_expr b))) d R ->
-     @semax CS Espec Delta (|> (tc_expr Delta (Eunop Cop.Onotbool b (Tint I32 Signed noattr)) && P)) (Sifthenelse b c d) R.
+     semax E Delta (P ∧ local (expr_true b)) c R ->
+     semax E Delta (P ∧ local (expr_false b)) d R ->
+     semax E Delta (▷ (tc_expr Delta (Eunop Cop.Onotbool b (Tint I32 Signed noattr)) ∧ P)) (Sifthenelse b c d) R.
 
 Axiom semax_seq:
-  forall{CS: compspecs} {Espec: OracleKind},
-forall Delta R P Q h t,
-    @semax CS Espec Delta P h (overridePost Q R) ->
-    @semax CS Espec Delta Q t R ->
-    @semax CS Espec Delta P (Ssequence h t) R.
+  forall E Delta (R: ret_assert) P Q h t,
+  semax E Delta P h (overridePost Q R) ->
+  semax E Delta Q t R ->
+  semax E Delta P (Clight.Ssequence h t) R.
 
 Axiom semax_break:
-  forall {CS: compspecs} {Espec: OracleKind},
-   forall Delta Q,    @semax CS Espec Delta (RA_break Q) Sbreak Q.
+   forall E Delta Q,    semax E Delta (RA_break Q) Sbreak Q.
 
 Axiom semax_continue:
-  forall {CS: compspecs} {Espec: OracleKind},
-   forall Delta Q,    @semax CS Espec Delta (RA_continue Q) Scontinue Q.
+   forall E Delta Q,    semax E Delta (RA_continue Q) Scontinue Q.
 
 Axiom semax_loop :
-  forall{CS: compspecs} {Espec: OracleKind},
-forall Delta Q Q' incr body R,
-     @semax CS Espec Delta  Q body (loop1_ret_assert Q' R) ->
-     @semax CS Espec Delta Q' incr (loop2_ret_assert Q R) ->
-     @semax CS Espec Delta Q (Sloop body incr) R.
+forall E Delta (Q Q' : assert) incr body R,
+     semax E Delta Q body (loop1_ret_assert Q' R) ->
+     semax E Delta Q' incr (loop2_ret_assert Q R) ->
+     semax E Delta Q (Sloop body incr) R.
 
 (* THIS RULE FROM semax_switch *)
 
 Axiom semax_switch: 
-  forall{CS: compspecs} {Espec: OracleKind},
-  forall Delta (Q: environ->mpred) a sl R,
+  forall E Delta (Q: assert) a sl R,
      is_int_type (typeof a) = true ->
-     (forall rho, Q rho |-- tc_expr Delta a rho) ->
+     (Q ⊢ tc_expr Delta a) ->
      (forall n,
-     @semax CS Espec Delta 
-               (local (`eq (eval_expr a) `(Vint n)) &&  Q)
+     semax E Delta 
+               (local (`eq (eval_expr a) `(Vint n)) ∧ Q)
                (seq_of_labeled_statement (select_switch (Int.unsigned n) sl))
                (switch_ret_assert R)) ->
-     @semax CS Espec Delta Q (Sswitch a sl) R.
+     semax E Delta Q (Sswitch a sl) R.
 
 (* THESE RULES FROM semax_call *)
 
-Axiom semax_call: forall {CS Espec},
-  forall Delta (A: rmaps.TypeTree) P Q
-  (NEP: args_super_non_expansive P) (NEQ: super_non_expansive Q)
-  (ts: list Type) x
+Axiom semax_call:
+  forall E Delta A (Ef : dtfr (MaskTT A)) P Q x
    F ret argsig retsig cc a bl,
+           Ef x ⊆ E ->
            Cop.classify_fun (typeof a) =
            Cop.fun_case_f argsig retsig cc ->
             (retsig = Tvoid -> ret = None) ->
           tc_fn_return Delta ret retsig ->
-  @semax CS Espec Delta
-          ((((tc_expr Delta a) && (tc_exprlist Delta argsig bl)))  &&
-         (`(func_ptr (mk_funspec  (argsig,retsig) cc A P Q NEP NEQ)) (eval_expr a) &&
-          (|>(F * (fun rho => P ts x (ge_of rho, eval_exprlist argsig bl rho))))))
+  semax E Delta
+          ((tc_expr Delta a ∧ tc_exprlist Delta argsig bl) ∧
+         (assert_of (fun rho => func_ptr (mk_funspec (argsig,retsig) cc A Ef P Q) (eval_expr a rho)) ∗
+          (▷(F ∗ assert_of (fun rho => P x (ge_of rho, eval_exprlist argsig bl rho))))))
          (Scall ret a bl)
          (normal_ret_assert
-          (EX old:val, substopt ret (`old) F * maybe_retval (Q ts x) retsig ret)).
+          (∃ old:val, assert_of (substopt ret (`old) F) ∗ maybe_retval (assert_of (Q x)) retsig ret)).
 
 Axiom  semax_return :
-  forall {CS: compspecs} {Espec: OracleKind},
-   forall Delta (R: ret_assert) ret ,
-      @semax CS Espec Delta
-                ( (tc_expropt Delta ret (ret_type Delta)) &&
-                `(RA_return R : option val -> environ -> mpred) (cast_expropt ret (ret_type Delta)) (@id environ))
+   forall E Delta (R: ret_assert) ret,
+      semax E Delta
+                (tc_expropt Delta ret (ret_type Delta) ∧
+                (assert_of (`(RA_return R : option val -> environ -> mpred) (cast_expropt ret (ret_type Delta)) (@id environ))))
                 (Sreturn ret)
                 R.
 
 (* THESE RULES FROM semax_straight *)
 
 Axiom semax_set_forward :
-  forall {CS: compspecs} {Espec: OracleKind},
-forall (Delta: tycontext) (P: environ->mpred) id e,
-    @semax CS Espec Delta
-        (|> ( (tc_expr Delta e) &&
-             (tc_temp_id id (typeof e) Delta e) &&
+forall E (Delta: tycontext) (P: assert) id e,
+    semax E Delta
+        (▷ ( (tc_expr Delta e) ∧
+             (tc_temp_id id (typeof e) Delta e) ∧
           P))
           (Sset id e)
         (normal_ret_assert
-          (EX old:val, local (`eq (eval_id id) (subst id (`old) (eval_expr e))) &&
-                            subst id (`old) P)).
+          (∃ old:val, local (`eq (eval_id id) (subst id (`old) (eval_expr e))) ∧
+                            assert_of (subst id (`old) P))).
 
 Axiom semax_ptr_compare :
-forall{CS: compspecs} {Espec: OracleKind},
-forall (Delta: tycontext) P id cmp e1 e2 ty sh1 sh2,
-    sepalg.nonidentity sh1 -> sepalg.nonidentity sh2 ->
+forall E (Delta: tycontext) (P: assert) id cmp e1 e2 ty sh1 sh2,
+   sh1 <> Share.bot -> sh2 <> Share.bot ->
    is_comparison cmp = true  ->
    eqb_type (typeof e1) int_or_ptr_type = false ->
    eqb_type (typeof e2) int_or_ptr_type = false ->
    typecheck_tid_ptr_compare Delta id = true ->
-   @semax CS Espec Delta
-        ( |> ( (tc_expr Delta e1) &&
-              (tc_expr Delta e2)  &&
-
-          local (`(blocks_match cmp) (eval_expr e1) (eval_expr e2)) &&
-          (`(mapsto_ sh1 (typeof e1)) (eval_expr e1) * TT) &&
-          (`(mapsto_ sh2 (typeof e2)) (eval_expr e2) * TT) &&
+   semax E Delta
+        (▷ ((tc_expr Delta e1) ∧ (tc_expr Delta e2)  ∧
+          local (`(blocks_match cmp) (eval_expr e1) (eval_expr e2)) ∧
+          <absorb> assert_of (`(mapsto_ sh1 (typeof e1)) (eval_expr e1)) ∧
+          <absorb> assert_of (`(mapsto_ sh2 (typeof e2)) (eval_expr e2)) ∧
           P))
           (Sset id (Ebinop cmp e1 e2 ty))
         (normal_ret_assert
-          (EX old:val,
+          (∃ old:val,
                  local (`eq (eval_id id)  (subst id `(old)
-                     (eval_expr (Ebinop cmp e1 e2 ty)))) &&
-                            subst id `(old) P)).
+                     (eval_expr (Ebinop cmp e1 e2 ty)))) ∧
+                            assert_of (subst id `(old) P))).
 
 Axiom semax_load :
-  forall {CS: compspecs} {Espec: OracleKind},
-forall (Delta: tycontext) sh id P e1 t2 (v2: val),
+forall E (Delta: tycontext) sh id P e1 t2 (v2: val),
     typeof_temp Delta id = Some t2 ->
     is_neutral_cast (typeof e1) t2 = true ->
     readable_share sh ->
-    (local (tc_environ Delta) && P |-- `(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2) * TT) ->
-    @semax CS Espec Delta
-       (|> ( (tc_lvalue Delta e1) &&
-       local (`(tc_val (typeof e1) v2)) &&
+    (local (tc_environ Delta) ∧ P ⊢ <absorb> assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2))) ->
+    semax E Delta
+       (▷ (tc_lvalue Delta e1 ∧
+       ⌜tc_val (typeof e1) v2⌝ ∧
           P))
        (Sset id e1)
-       (normal_ret_assert (EX old:val, local (`eq (eval_id id) (`v2)) &&
-                                          (subst id (`old) P))).
+       (normal_ret_assert (∃ old:val, local (`eq (eval_id id) (`v2)) ∧
+                                          assert_of (subst id (`old) P))).
 
 Axiom semax_cast_load :
-  forall {CS: compspecs} {Espec: OracleKind},
-forall (Delta: tycontext) sh id P e1 t1 (v2: val),
+forall E (Delta: tycontext) sh id P e1 t1 (v2: val),
     typeof_temp Delta id = Some t1 ->
    cast_pointer_to_bool (typeof e1) t1 = false ->
     readable_share sh ->
-    (local (tc_environ Delta) && P |-- `(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2) * TT) ->
-    @semax CS Espec Delta
-       (|> ( (tc_lvalue Delta e1) &&
-       local (`(tc_val t1) (`(eval_cast (typeof e1) t1 v2))) &&
+    (local (tc_environ Delta) ∧ P ⊢ <absorb> assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2))) ->
+    semax E Delta
+       (▷ ( (tc_lvalue Delta e1) ∧
+       local (`(tc_val t1) (`(eval_cast (typeof e1) t1 v2))) ∧
           P))
        (Sset id (Ecast e1 t1))
-       (normal_ret_assert (EX old:val, local (`eq (eval_id id) (`(eval_cast (typeof e1) t1 v2))) &&
-                                          (subst id (`old) P))).
+       (normal_ret_assert (∃ old:val, local (`eq (eval_id id) (`(eval_cast (typeof e1) t1 v2))) ∧
+                                          assert_of (subst id (`old) P))).
 
 Axiom semax_store:
-  forall {CS: compspecs} {Espec: OracleKind},
- forall Delta e1 e2 sh P,
+ forall E Delta e1 e2 sh (P: assert),
    writable_share sh ->
-   @semax CS Espec Delta
-          (|> ( (tc_lvalue Delta e1) &&  (tc_expr Delta (Ecast e2 (typeof e1)))  &&
-             (`(mapsto_ sh (typeof e1)) (eval_lvalue e1) * P)))
+   semax E Delta
+          (▷ ((tc_lvalue Delta e1 ∧ tc_expr Delta (Ecast e2 (typeof e1)))  ∧
+             (assert_of (`(mapsto_ sh (typeof e1)) (eval_lvalue e1)) ∗ P)))
           (Sassign e1 e2)
           (normal_ret_assert
-               (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`force_val (`(sem_cast (typeof e2) (typeof e1)) (eval_expr e2))) * P)).
+               (assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`force_val (`(sem_cast (typeof e2) (typeof e1)) (eval_expr e2)))) ∗ P)).
 
 Axiom semax_store_union_hack:
-     forall {cs: compspecs} {Espec:OracleKind}
-          (Delta : tycontext) (e1 e2 : expr) (t2: type) (ch ch' : memory_chunk) (sh : share) (P : LiftEnviron mpred),
+     forall E (Delta : tycontext) (e1 e2 : expr) (t2: type) (ch ch' : memory_chunk) (sh : share) (P : assert),
        (numeric_type (typeof e1) && numeric_type t2)%bool = true ->
        access_mode (typeof e1) = By_value ch ->
        access_mode t2 = By_value ch' ->
        decode_encode_val_ok ch ch' ->
        writable_share sh ->
-       semax Delta
-         (|> (tc_lvalue Delta e1 && tc_expr Delta (Ecast e2 (typeof e1)) &&
-              ((`(mapsto_ sh (typeof e1)) (eval_lvalue e1) 
-                && `(mapsto_ sh t2) (eval_lvalue e1))
-               * P)))
+       semax E Delta
+         (▷ ((tc_lvalue Delta e1 ∧ tc_expr Delta (Ecast e2 (typeof e1))) ∧
+              ((assert_of (`(mapsto_ sh (typeof e1)) (eval_lvalue e1))
+                ∧ assert_of (`(mapsto_ sh t2) (eval_lvalue e1)))
+               ∗ P)))
          (Sassign e1 e2)
          (normal_ret_assert
-            (EX v':val, 
-              andp (local  ((`decode_encode_val )
-                         ((` force_val) ((`(sem_cast (typeof e2) (typeof e1))) (eval_expr e2))) (`ch) (`ch') (`v') ))
-              ((` (mapsto sh t2)) (eval_lvalue e1) (`v') * P))).
+            (∃ v':val,
+              (local  ((`decode_encode_val )
+                         ((` force_val) ((`(sem_cast (typeof e2) (typeof e1))) (eval_expr e2))) (`ch) (`ch') (`v') )) ∧
+              (assert_of ((` (mapsto sh t2)) (eval_lvalue e1) (`v')) ∗ P))).
 
 (* THESE RULES FROM semax_lemmas *)
 
 Axiom semax_skip:
-  forall {CS: compspecs} {Espec: OracleKind},
-   forall Delta P, @semax CS Espec Delta P Sskip (normal_ret_assert P).
+   forall E Delta (P : assert), semax E Delta P Sskip (normal_ret_assert P).
 
 Axiom semax_conseq:
-  forall {CS: compspecs} {Espec: OracleKind},
-  forall Delta (P' : environ -> mpred) (R': ret_assert) P c (R: ret_assert) ,
-    (local (tc_environ Delta) && ((allp_fun_id Delta) && P) |-- (|={Ensembles.Full_set}=> P')) ->
-    (local (tc_environ Delta) && ((allp_fun_id Delta) && RA_normal R') |-- (|={Ensembles.Full_set}=> RA_normal R)) ->
-    (local (tc_environ Delta) && ((allp_fun_id Delta) && RA_break R') |-- (|={Ensembles.Full_set}=> RA_break R)) ->
-    (local (tc_environ Delta) && ((allp_fun_id Delta) && RA_continue R') |-- (|={Ensembles.Full_set}=> RA_continue R)) ->
-    (forall vl, local (tc_environ Delta) && ((allp_fun_id Delta) && RA_return R' vl) |-- (RA_return R vl)) ->
-   @semax CS Espec Delta P' c R' -> @semax CS Espec Delta P c R.
+  forall E Delta (P' : assert) (R': ret_assert) P c (R: ret_assert),
+    (local (tc_environ Delta) ∧ (<affine> (allp_fun_id Delta) ∗ P) ⊢ (|={E}=> P')) ->
+    (local (tc_environ Delta) ∧ (<affine> (allp_fun_id Delta) ∗ RA_normal R') ⊢ (|={E}=> RA_normal R)) ->
+    (local (tc_environ Delta) ∧ (<affine> (allp_fun_id Delta) ∗ RA_break R') ⊢ (|={E}=> RA_break R)) ->
+    (local (tc_environ Delta) ∧ (<affine> (allp_fun_id Delta) ∗ RA_continue R') ⊢ (|={E}=> RA_continue R)) ->
+    (forall vl, local (tc_environ Delta) ∧ (<affine> (allp_fun_id Delta) ∗ RA_return R' vl) ⊢ (RA_return R vl)) ->
+   semax E Delta P' c R' -> semax E Delta P c R.
 
 Axiom semax_Slabel:
-   forall {cs:compspecs} {Espec: OracleKind},
-     forall Delta (P:environ -> mpred) (c:statement) (Q:ret_assert) l,
-   @semax cs Espec Delta P c Q -> @semax cs Espec Delta P (Slabel l c) Q.
+     forall E Delta (P:assert) (c:statement) (Q:ret_assert) l,
+   semax E Delta P c Q -> semax E Delta P (Slabel l c) Q.
 
 (* THESE RULES FROM semax_ext *)
 
 (*TODO: What's the preferred way to expose these defs in the SL interface?*)
 Axiom semax_ext:
-  forall  (Espec : OracleKind)
-         (ext_link: Strings.String.string -> ident)
-         (id : Strings.String.string) (sig : compcert_rmaps.typesig) (sig' : signature)
-         cc A P Q NEP NEQ (fs : funspecs),
-  let f := mk_funspec sig cc A P Q NEP NEQ in
+  forall {ext_spec0} (ext_link: Strings.String.string -> ident)
+         (id : Strings.String.string) (sig : typesig) (sig' : signature)
+         cc A E P Q (fs : funspecs),
+  let f := mk_funspec sig cc A E P Q in
   In (ext_link id,f) fs ->
   funspecs_norepeat fs ->
   sig' = semax_ext.typesig2signature sig cc ->
-  @semax_external (add_funspecs Espec ext_link fs) (EF_external id sig') _ P Q.
+  ⊢ semax_external (OK_spec := add_funspecs_rec OK_ty ext_link ext_spec0 fs) (EF_external id sig') _ E P Q.
 
 Axiom semax_external_FF:
- forall Espec ef A,
-  @semax_external Espec ef A (fun _ _ => FF) (fun _ _ => FF).
+ forall ef A E,
+ ⊢ semax_external ef A E (λne _, monPred_at(I := argsEnviron_index) False : _ -d> _) (λne _, monPred_at(I := environ_index) False : _ -d> _).
 
 Axiom semax_external_binaryintersection: 
-forall {Espec ef A1 P1 Q1 P1ne Q1ne A2 P2 Q2 P2ne Q2ne 
-      A P Q P_ne Q_ne sig cc}
-  (EXT1: @semax_external Espec ef A1 P1 Q1)
-  (EXT2: @semax_external Espec ef A2 P2 Q2)
-  (BI: binary_intersection (mk_funspec sig cc A1 P1 Q1 P1ne Q1ne) 
-                      (mk_funspec sig cc A2 P2 Q2 P2ne Q2ne) =
-     Some (mk_funspec sig cc A P Q P_ne Q_ne))
+forall {ef A1 E1 P1 Q1 A2 E2 P2 Q2
+      A E P Q sig cc}
+  (EXT1: ⊢ semax_external ef A1 E1 P1 Q1)
+  (EXT2: ⊢ semax_external ef A2 E2 P2 Q2)
+  (BI: binary_intersection (mk_funspec sig cc A1 E1 P1 Q1)
+                      (mk_funspec sig cc A2 E2 P2 Q2) =
+     Some (mk_funspec sig cc A E P Q))
   (LENef: length (fst sig) = length (sig_args (ef_sig ef))),
-  @semax_external Espec ef A P Q.
+  ⊢ semax_external ef A E P Q.
 
 Axiom semax_external_funspec_sub: forall 
-  (DISABLE: False) {Espec argtypes rtype cc ef A1 P1 Q1 P1ne Q1ne A P Q Pne Qne}
-  (Hsub: funspec_sub (mk_funspec (argtypes, rtype) cc A1 P1 Q1 P1ne Q1ne) 
-                   (mk_funspec (argtypes, rtype) cc A P Q Pne Qne))
+  {argtypes rtype cc ef A1 E1 P1 Q1 A E P Q}
+  (Hsub: funspec_sub (mk_funspec (argtypes, rtype) cc A1 E1 P1 Q1)
+                   (mk_funspec (argtypes, rtype) cc A E P Q))
   (HSIG: ef_sig ef = 
          mksignature (map argtype_of_type argtypes)
-                     (rettype_of_type rtype) cc)
-  (SE: @semax_external Espec ef A1 P1 Q1),
-  @semax_external Espec ef A P Q.
+                     (rettype_of_type rtype) cc),
+  semax_external ef A1 E1 P1 Q1 ⊢ semax_external ef A E P Q.
 
 Axiom semax_body_binaryintersection:
-forall {V G cs} f sp1 sp2 phi
-  (SB1: @semax_body V G cs f sp1) (SB2: @semax_body V G cs f sp2)
+forall {V G} f sp1 sp2 phi
+  (SB1: semax_body V G f sp1) (SB2: semax_body V G f sp2)
   (BI: binary_intersection (snd sp1) (snd sp2) = Some phi),
-  @semax_body V G cs f (fst sp1, phi).
+  semax_body V G f (fst sp1, phi).
 
 Axiom semax_body_generalintersection:
 forall {V G cs f iden I sig cc} {phi : I -> funspec}
         (H1: forall i : I, typesig_of_funspec (phi i) = sig)
-        (H2: forall i : I, callingconvention_of_funspec (phi i) = cc) (HI: inhabited I)
-  (H: forall i, @semax_body V G cs f (iden, phi i)),
-  @semax_body V G cs f (iden, @general_intersection I sig cc phi H1 H2).
+        (H2: forall i : I, callingconvention_of_funspec (phi i) = cc)
+        (HI: inhabited I)
+  (H: forall i, semax_body(C := cs) V G f (iden, phi i)),
+  semax_body V G f (iden, general_intersection phi H1 H2).
 
-Axiom semax_body_funspec_sub: forall {V G cs f i phi phi'} 
-  (SB: @semax_body V G cs f (i, phi)) (Sub: funspec_sub phi phi')
+Axiom semax_body_funspec_sub: forall {V G f i phi phi'} 
+  (SB: semax_body V G f (i, phi)) (Sub: funspec_sub phi phi')
   (LNR: list_norepet (map fst (fn_params f) ++ map fst (fn_temps f))),
-  @semax_body V G cs f (i, phi').
+  semax_body V G f (i, phi').
 
 Axiom general_intersection_funspec_subIJ: forall I (HI: inhabited I) J
-      sig cc phi1 ToF1 CoF1 phi2 ToF2 CoF2
+      sig cc phi1 ToF1 CoF1 phi2 ToF2 CoF2 
       (H: forall i, exists j, funspec_sub (phi1 j) (phi2 i)),
-   funspec_sub (@general_intersection J sig cc phi1 ToF1 CoF1) (@general_intersection I sig cc phi2 ToF2 CoF2).
+   funspec_sub (@general_intersection _ _ J sig cc phi1 ToF1 CoF1) (@general_intersection _ _ I sig cc phi2 ToF2 CoF2).
 
 Axiom semax_Delta_subsumption:
-  forall {CS: compspecs} {Espec: OracleKind},
-  forall Delta Delta' P c R,
+  forall E Delta Delta' P c R,
        tycontext_sub Delta Delta' ->
-       @semax CS Espec Delta P c R -> @semax CS Espec Delta' P c R.
+       semax E Delta P c R -> semax E Delta' P c R.
+
+End mpred.
 
 End MINIMUM_CLIGHT_SEPARATION_HOARE_LOGIC.
 
@@ -1800,134 +615,122 @@ Declare Module CSHL_MinimumLogic: MINIMUM_CLIGHT_SEPARATION_HOARE_LOGIC.
 Import CSHL_MinimumLogic.CSHL_Def.
 Import CSHL_MinimumLogic.CSHL_Defs.
 
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs}.
+
 Axiom semax_set :
-  forall {CS: compspecs} {Espec: OracleKind},
-forall (Delta: tycontext) (P: environ->mpred) id e,
-    @semax CS Espec Delta
-        (|> ( (tc_expr Delta e) &&
-             (tc_temp_id id (typeof e) Delta e) &&
-             subst id (eval_expr e) P))
+forall E (Delta: tycontext) (P: assert) id e,
+    semax E Delta
+        (▷ ( (tc_expr Delta e) ∧
+             (tc_temp_id id (typeof e) Delta e) ∧
+             assert_of (subst id (eval_expr e) P)))
           (Sset id e) (normal_ret_assert P).
 
 Axiom semax_fun_id:
-  forall {CS: compspecs} {Espec: OracleKind},
-      forall id f Delta P Q c,
-    (var_types Delta) ! id = None ->
-    (glob_specs Delta) ! id = Some f ->
-    (glob_types Delta) ! id = Some (type_of_funspec f) ->
-    @semax CS Espec Delta (P && `(func_ptr f) (eval_var id (type_of_funspec f)))
+      forall id f E Delta P Q c,
+    (var_types Delta) !! id = None ->
+    (glob_specs Delta) !! id = Some f ->
+    (glob_types Delta) !! id = Some (type_of_funspec f) ->
+    semax E Delta (P ∗ assert_of (fun rho => func_ptr f (eval_var id (type_of_funspec f) rho)))
                   c Q ->
-    @semax CS Espec Delta P c Q.
+    semax E Delta P c Q.
 
-Axiom semax_unfold_Ssequence: forall {CS: compspecs} {Espec: OracleKind} c1 c2,
+Axiom semax_unfold_Ssequence: forall c1 c2,
   unfold_Ssequence c1 = unfold_Ssequence c2 ->
-  (forall P Q Delta, @semax CS Espec Delta P c1 Q -> @semax CS Espec Delta P c2 Q).
+  (forall P Q E Delta, semax E Delta P c1 Q -> semax E Delta P c2 Q).
 
 Axiom seq_assoc:
-  forall {CS: compspecs} {Espec: OracleKind},
-   forall Delta P s1 s2 s3 R,
-        @semax CS Espec Delta P (Ssequence s1 (Ssequence s2 s3)) R <->
-        @semax CS Espec Delta P (Ssequence (Ssequence s1 s2) s3) R.
+   forall E Delta P s1 s2 s3 R,
+        semax E Delta P (Ssequence s1 (Ssequence s2 s3)) R <->
+        semax E Delta P (Ssequence (Ssequence s1 s2) s3) R.
 
 Axiom semax_seq_skip:
-  forall {CS: compspecs} {Espec: OracleKind},
-  forall Delta P s Q,
-    @semax CS Espec Delta P s Q <-> @semax CS Espec Delta P (Ssequence s Sskip) Q.
+  forall E Delta P s Q,
+    semax E Delta P s Q <-> semax E Delta P (Ssequence s Sskip) Q.
 
 Axiom semax_skip_seq:
-  forall {CS: compspecs} {Espec: OracleKind},
-  forall Delta P s Q,
-    @semax CS Espec Delta P s Q <-> @semax CS Espec Delta P (Ssequence Sskip s) Q.
+  forall E Delta P s Q,
+    semax E Delta P s Q <-> semax E Delta P (Ssequence Sskip s) Q.
 
 Axiom semax_loop_nocontinue1:
-  forall CS Espec Delta Pre s1 s2 s3 Post,
+  forall E Delta Pre s1 s2 s3 Post,
   nocontinue s1 = true ->
   nocontinue s2 = true ->
   nocontinue s3 = true ->
-   @semax CS Espec Delta Pre (Sloop (Ssequence s1 (Ssequence s2 s3)) Sskip) Post ->
-    @semax CS Espec Delta Pre (Sloop (Ssequence s1 s2) s3) Post.
+   semax E Delta Pre (Sloop (Ssequence s1 (Ssequence s2 s3)) Sskip) Post ->
+    semax E Delta Pre (Sloop (Ssequence s1 s2) s3) Post.
 
 Axiom semax_loop_nocontinue:
-  forall {CS: compspecs} {Espec: OracleKind},
- forall Delta P body incr R,
- @semax CS Espec Delta P (Ssequence body incr) (loop_nocontinue_ret_assert P R) ->
- @semax CS Espec Delta P (Sloop body incr) R.
+ forall E Delta P body incr R,
+ semax E Delta P (Ssequence body incr) (loop_nocontinue_ret_assert P R) ->
+ semax E Delta P (Sloop body incr) R.
 
 Axiom semax_convert_for_while':
- forall CS Espec Delta Pre s1 e2 s3 s4 s5 Post,
+ forall E Delta Pre s1 e2 s3 s4 s5 Post,
   nocontinue s4 = true ->
   nocontinue s3 = true -> 
-  @semax CS Espec Delta Pre 
+  semax E Delta Pre 
     (Ssequence s1 (Ssequence (Swhile e2 (Ssequence s4 s3)) s5)) Post ->
-  @semax CS Espec Delta Pre (Ssequence (Sfor s1 e2 s4 s3) s5) Post.
+  semax E Delta Pre (Ssequence (Sfor s1 e2 s4 s3) s5) Post.
 
 Axiom semax_loop_unroll1:
-  forall {CS: compspecs} {Espec: OracleKind} Delta P P' Q body incr R,
-  @semax CS Espec Delta P body (loop1_ret_assert P' R) ->
-  @semax CS Espec Delta P' incr (loop2_ret_assert Q R) ->
-  @semax CS Espec Delta Q (Sloop body incr) R ->
-  @semax CS Espec Delta P (Sloop body incr) R.
+  forall E Delta P P' Q body incr R,
+  semax E Delta P body (loop1_ret_assert P' R) ->
+  semax E Delta P' incr (loop2_ret_assert Q R) ->
+  semax E Delta Q (Sloop body incr) R ->
+  semax E Delta P (Sloop body incr) R.
 
 Axiom semax_if_seq:
- forall {CS: compspecs} {Espec: OracleKind} Delta P e c1 c2 c Q,
- semax Delta P (Sifthenelse e (Ssequence c1 c) (Ssequence c2 c)) Q ->
- semax Delta P (Ssequence (Sifthenelse e c1 c2) c) Q.
+ forall E Delta P e c1 c2 c Q,
+ semax E Delta P (Sifthenelse e (Ssequence c1 c) (Ssequence c2 c)) Q ->
+ semax E Delta P (Ssequence (Sifthenelse e c1 c2) c) Q.
 
 Axiom semax_seq_Slabel:
-   forall {cs:compspecs} {Espec: OracleKind},
-     forall Delta (P:environ -> mpred) (c1 c2:statement) (Q:ret_assert) l,
-   @semax cs Espec Delta P (Ssequence (Slabel l c1) c2) Q <-> 
-   @semax cs Espec Delta P (Slabel l (Ssequence c1 c2)) Q.
+     forall E Delta (P:assert) (c1 c2:statement) (Q:ret_assert) l,
+   semax E Delta P (Ssequence (Slabel l c1) c2) Q <-> 
+   semax E Delta P (Slabel l (Ssequence c1 c2)) Q.
 
 (**************** END OF stuff from semax_rules ***********)
 
 Axiom semax_frame:
-  forall {CS: compspecs} {Espec: OracleKind},
-  forall Delta P s R F,
+  forall E Delta (P : assert) s R (F : assert),
    closed_wrt_modvars s F ->
-  @semax CS Espec Delta P s R ->
-    @semax CS Espec Delta (P * F) s (frame_ret_assert R F).
+  semax E Delta P s R ->
+    semax E Delta (P ∗ F) s (frame_ret_assert R F).
 
 Axiom semax_extract_prop:
-  forall {CS: compspecs} {Espec: OracleKind},
-  forall Delta (PP: Prop) P c Q,
-           (PP -> @semax CS Espec Delta P c Q) ->
-           @semax CS Espec Delta (!!PP && P) c Q.
+  forall E Delta (PP: Prop) (P : assert) c Q,
+           (PP -> semax E Delta P c Q) ->
+           semax E Delta (⌜PP⌝ ∧ P) c Q.
 
 Axiom semax_extract_later_prop:
-  forall {CS: compspecs} {Espec: OracleKind},
-  forall Delta (PP: Prop) P c Q,
-           (PP -> @semax CS Espec Delta P c Q) ->
-           @semax CS Espec Delta ((|> !!PP) && P) c Q.
-
-Axiom semax_adapt_frame: forall {cs Espec} Delta c (P P': assert) (Q Q' : ret_assert)
-   (H: forall rho,  derives (!!(typecheck_environ Delta rho) && (allp_fun_id Delta rho && P rho))
-                   (EX F: assert, (!!(closed_wrt_modvars c F) && (|={Ensembles.Full_set}=> P' rho * F rho) &&
-                         !!(forall rho, (local (tc_environ Delta) rho) && ((allp_fun_id Delta rho)) && RA_normal (frame_ret_assert Q' F) rho |-- (|={Ensembles.Full_set}=> RA_normal Q rho)) &&
-                         !!(forall rho, (local (tc_environ Delta) rho) && ((allp_fun_id Delta rho)) && RA_break (frame_ret_assert Q' F) rho |-- (|={Ensembles.Full_set}=> RA_break Q rho)) &&
-                         !!(forall rho, (local (tc_environ Delta) rho) && ((allp_fun_id Delta rho)) && RA_continue (frame_ret_assert Q' F) rho |-- (|={Ensembles.Full_set}=> RA_continue Q rho)) &&
-                         !!(forall vl rho, (local (tc_environ Delta) rho) && ((allp_fun_id Delta rho)) && RA_return (frame_ret_assert Q' F) vl rho |-- (RA_return Q vl rho)))))
-   (SEM: @semax cs Espec Delta P' c Q'),
-   @semax cs Espec Delta P c Q.
-
-Axiom semax_adapt: forall {cs Espec} Delta c (P P': assert) (Q Q' : ret_assert)
-   (H: forall rho,  !!(typecheck_environ Delta rho) && (allp_fun_id Delta rho && P rho)
-                   |-- ((|={Ensembles.Full_set}=> P' rho) &&
-                        !!(forall rho, RA_normal Q' rho |-- (|={Ensembles.Full_set}=> RA_normal Q rho)) &&
-                        !!(forall rho, RA_break Q' rho |-- (|={Ensembles.Full_set}=> RA_break Q rho)) &&
-                        !!(forall rho, RA_continue Q' rho |-- (|={Ensembles.Full_set}=> RA_continue Q rho)) &&
-                        !!(forall vl rho, RA_return Q' vl rho |-- (RA_return Q vl rho))))
-   (SEM: @semax cs Espec Delta P' c Q'),
-   @semax cs Espec Delta P c Q.
+  forall E Delta (PP: Prop) (P : assert) c Q,
+           (PP -> semax E Delta P c Q) ->
+           semax E Delta ((▷ ⌜PP⌝) ∧ P) c Q.
+
+Axiom semax_adapt_frame: forall E Delta c (P P': assert) (Q Q' : ret_assert)
+   (H: local (typecheck_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢
+                   ∃ F: assert, (⌜closed_wrt_modvars c F⌝ ∧ |={E}=> (P' ∗ F) ∧
+                         ⌜local (tc_environ Delta) ∧ <affine> allp_fun_id Delta ∗ RA_normal (frame_ret_assert Q' F) ⊢ |={E}=> RA_normal Q⌝ ∧
+                         ⌜local (tc_environ Delta) ∧ <affine> allp_fun_id Delta ∗ RA_break (frame_ret_assert Q' F) ⊢ |={E}=> RA_break Q⌝ ∧
+                         ⌜local (tc_environ Delta) ∧ <affine> allp_fun_id Delta ∗ RA_continue (frame_ret_assert Q' F) ⊢ |={E}=> RA_continue Q⌝ ∧
+                         ⌜forall vl, local (tc_environ Delta) ∧ <affine> allp_fun_id Delta ∗ RA_return (frame_ret_assert Q' F) vl ⊢ RA_return Q vl⌝))
+   (SEM: semax E Delta P' c Q'),
+   semax E Delta P c Q.
+
+Axiom semax_adapt: forall E Delta c (P P': assert) (Q Q' : ret_assert)
+   (H: local (typecheck_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢
+                   (|={E}=> P' ∧
+                        ⌜RA_normal Q' ⊢ |={E}=> RA_normal Q⌝ ∧
+                        ⌜RA_break Q' ⊢ |={E}=> RA_break Q⌝ ∧
+                        ⌜RA_continue Q' ⊢ |={E}=> RA_continue Q⌝ ∧
+                        ⌜forall vl, RA_return Q' vl ⊢ RA_return Q vl⌝))
+   (SEM: semax E Delta P' c Q'),
+   semax E Delta P c Q.
+
+End mpred.
 
 End PRACTICAL_CLIGHT_SEPARATION_HOARE_LOGIC.
 
-Require Import Coq.Classes.Morphisms.
-
-#[export] Instance prop_Proper:
-  Proper (iff ==> (@eq mpred)) (prop).
-Proof.
-  intros ? ? ?.
-  apply ND_prop_ext.
-  auto.
-Defined.
+Arguments var_sizes_ok {_} _.
diff --git a/veric/SeparationLogicSoundness.v b/veric/SeparationLogicSoundness.v
index deaade3f72..d19db58172 100644
--- a/veric/SeparationLogicSoundness.v
+++ b/veric/SeparationLogicSoundness.v
@@ -1,7 +1,8 @@
 Require Import VST.sepcomp.semantics.
-
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.juicy_base.
-Require Import VST.veric.juicy_mem VST.veric.juicy_mem_lemmas VST.veric.juicy_mem_ops.
+Require Import VST.veric.juicy_mem VST.veric.juicy_mem_lemmas.
+Require Import VST.veric.external_state.
 Require Import VST.veric.res_predicates.
 Require Import VST.veric.extend_tc.
 Require Import VST.veric.Clight_seplog.
@@ -24,8 +25,8 @@ Require Import VST.veric.semax_switch.
 Require Import VST.veric.semax_prog.
 Require Import VST.veric.semax_ext.
 Require Import VST.veric.SeparationLogic.
-
-Require Import VST.veric.ghost_PCM.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
+Import LiftNotation.
 
 Module Type SEPARATION_HOARE_LOGIC_SOUNDNESS.
 
@@ -37,31 +38,23 @@ Import CSHL_Def.
 Import CSHL_Defs.
 
 Axiom semax_prog_sound :
-  forall {Espec: OracleKind}{CS: compspecs} prog z Vspec Gspec,
-  @semax_prog Espec CS prog z Vspec Gspec ->
-  @semax_prog.semax_prog Espec CS prog z Vspec Gspec.
+  forall `{H : !VSTGS OK_ty Σ}{OK_spec: ext_spec OK_ty}{CS: compspecs} prog z Vspec Gspec,
+  semax_prog prog z Vspec Gspec ->
+  semax_prog.semax_prog OK_spec prog z Vspec Gspec.
 
 Axiom semax_prog_rule :
-  forall {Espec: OracleKind}{CS: compspecs},
+  forall `{H : !VSTGS OK_ty Σ}{OK_spec: ext_spec OK_ty}{CS: compspecs},
   forall V G prog m h z,
-     postcondition_allows_exit Espec tint ->
-     @semax_prog Espec CS prog z V G ->
+     postcondition_allows_exit OK_spec tint ->
+     semax_prog prog z V G ->
      Genv.init_mem prog = Some m ->
      { b : block & { q : CC_core &
        (Genv.find_symbol (globalenv prog) (prog_main prog) = Some b) *
-       (forall jm, m_dry jm = m -> exists jm',
-                    semantics.initial_core (juicy_core_sem (cl_core_sem (globalenv prog))) h
-                       jm q jm' (Vptr b Ptrofs.zero) nil) *
-       forall n,
-         { jm |
-           m_dry jm = m /\ level jm = n /\
-           nth_error (ghost_of (m_phi jm)) 0 = Some (Some (ext_ghost z, NoneP)) /\
-           (exists z, join (m_phi jm) (wsat_rmap (m_phi jm)) (m_phi z) /\ ext_order jm z) /\
-           jsafeN (@OK_spec Espec) (globalenv prog) z q jm /\
-           no_locks (m_phi jm) /\
-           matchfunspecs (globalenv prog) G (m_phi jm) /\
-           app_pred (funassert (nofunc_tycontext V G) (empty_environ (globalenv prog))) (m_phi jm)
-     } } }%type.
+       (exists m', semantics.initial_core (cl_core_sem (globalenv prog)) h
+                       m q m' (Vptr b Ptrofs.zero) nil) *
+       (state_interp Mem.empty z ∗ funspec_auth ∅ ∗ has_ext z ⊢ |==> state_interp m z ∗ jsafeN OK_spec (globalenv prog) ⊤ z q ∧
+           (*no_locks ∧*) matchfunspecs (globalenv prog) G (*∗ funassert (nofunc_tycontext V G) (empty_environ (globalenv prog))*))
+     } }%type.
 
 End SEPARATION_HOARE_LOGIC_SOUNDNESS.
 
@@ -83,8 +76,7 @@ Definition semax := @semax.
 
 Definition semax_func := @semax_func.
 
-Definition semax_external {Espec: OracleKind} ef A P Q :=
-  forall n, semax_external Espec ef A P Q n.
+Definition semax_external := @semax_external.
 
 End VericDef.
 
@@ -93,7 +85,14 @@ Module VericMinimumSeparationLogic: MINIMUM_CLIGHT_SEPARATION_HOARE_LOGIC with M
 Module CSHL_Def := VericDef.
 Module CSHL_Defs := DerivedDefs (VericDef).
 
+Lemma semax_mask_mono : forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS : compspecs} E E' Delta P c R,
+  E ⊆ E' -> semax OK_spec E Delta P c R -> semax OK_spec E' Delta P c R.
+Proof.
+  intros; rewrite /semax -semax_mask_mono //.
+Qed.
+
 Definition semax_extract_exists := @extract_exists_pre.
+
 Definition semax_body := @semax_body.
 Definition semax_prog := @semax_prog.
 Definition semax_func_nil := @semax_func_nil.
@@ -101,86 +100,75 @@ Definition semax_func_cons := @semax_func_cons.
 Definition make_ext_rval := veric.semax.make_ext_rval.
 Definition tc_option_val := veric.semax.tc_option_val.
 
-Lemma semax_func_cons_ext: forall {Espec:OracleKind} (V: varspecs) (G: funspecs)
-     {C: compspecs} ge fs id ef argsig retsig A P Q NEP NEQ
+Lemma semax_func_cons_ext: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} (V: varspecs) (G: funspecs)
+     {C: compspecs} ge fs id ef argsig retsig A E P (Q: dtfr (AssertTT A))
       (G': funspecs) cc b,
   ef_sig ef = mksignature (map argtype_of_type argsig) (rettype_of_type retsig) cc ->
   id_in_list id (map (@fst _ _) fs) = false ->
-  (ef_inline ef = false \/ withtype_empty A) ->
-  (forall gx ts x (ret : option val),
-      (seplog.derives (seplog.andp
-                         (Q ts x (make_ext_rval gx (rettype_of_type retsig) ret))
-                         (!! Builtins0.val_opt_has_rettype ret (rettype_of_type retsig)))
-                      (!!tc_option_val retsig ret))) ->
+  (ef_inline ef = false \/ @withtype_empty Σ A) ->
+  (forall gx x (ret : option val),
+      Q x (make_ext_rval gx (rettype_of_type retsig) ret) ∧
+      ⌜Builtins0.val_opt_has_rettype ret (rettype_of_type retsig)⌝ ⊢
+      ⌜tc_option_val retsig ret⌝) ->
   Genv.find_symbol ge id = Some b ->
   Genv.find_funct_ptr ge b = Some (Ctypes.External ef argsig retsig cc) ->
-  @CSHL_Def.semax_external Espec ef A P Q ->
-  CSHL_Def.semax_func Espec V G C ge fs G' ->
-  CSHL_Def.semax_func Espec V G C ge ((id, Ctypes.External ef argsig retsig cc)::fs)
-             ((id, mk_funspec (argsig, retsig) cc A P Q NEP NEQ)  :: G').
-Proof. intros. eapply semax_func_cons_ext; eauto. intros. apply H2. Qed.
+  (⊢ CSHL_Def.semax_external _ _ _ OK_spec ef A E P Q) ->
+  CSHL_Def.semax_func _ _ _ OK_spec V G C ge fs G' ->
+  CSHL_Def.semax_func _ _ _ OK_spec V G C ge ((id, Ctypes.External ef argsig retsig cc)::fs)
+             ((id, mk_funspec (argsig, retsig) cc A E P Q) :: G').
+Proof. intros. eapply semax_func_cons_ext; eauto. Qed.
 
 Definition semax_Delta_subsumption := @semax_lemmas.semax_Delta_subsumption.
 
-Lemma semax_external_binaryintersection: forall
- {Espec ef A1 P1 Q1 P1ne Q1ne A2 P2 Q2 P2ne Q2ne A P Q P_ne Q_ne sig cc}
-  (EXT1: @CSHL_Def.semax_external Espec ef A1 P1 Q1)
-  (EXT2: @CSHL_Def.semax_external Espec ef A2 P2 Q2)
-  (BI: binary_intersection (mk_funspec sig cc A1 P1 Q1 P1ne Q1ne) 
-                      (mk_funspec sig cc A2 P2 Q2 P2ne Q2ne) =
-     Some (mk_funspec sig cc A P Q P_ne Q_ne))
-  (LEN: length (fst sig) = length (sig_args (ef_sig ef))),
-  @CSHL_Def.semax_external Espec ef A P Q. 
-Proof. intros. intros n. eapply semax_external_binaryintersection. apply EXT1. apply EXT2. apply BI. trivial. Qed.
-
-Lemma semax_external_funspec_sub: forall 
-  (DISABLE: False) {Espec argtypes rtype cc ef A1 P1 Q1 P1ne Q1ne A P Q Pne Qne}
-  (Hsub: funspec_sub (mk_funspec (argtypes, rtype) cc A1 P1 Q1 P1ne Q1ne) 
-                   (mk_funspec (argtypes, rtype) cc A P Q Pne Qne))
-  (HSIG: ef_sig ef = 
+Definition semax_external_binaryintersection := @semax_external_binaryintersection.
+
+Lemma semax_external_funspec_sub: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty}
+  {argtypes rtype cc ef A1 E1 P1 Q1 A E P Q}
+  (Hsub: funspec_sub (mk_funspec (argtypes, rtype) cc A1 E1 P1 Q1)
+                   (mk_funspec (argtypes, rtype) cc A E P Q))
+  (HSIG: ef_sig ef =
          mksignature (map argtype_of_type argtypes)
-                     (rettype_of_type rtype) cc)
-  (SE: @CSHL_Def.semax_external Espec ef A1 P1 Q1),
-  @CSHL_Def.semax_external Espec ef A P Q.
+                     (rettype_of_type rtype) cc),
+  CSHL_Def.semax_external _ _ _ OK_spec ef A1 E1 P1 Q1 ⊢
+  CSHL_Def.semax_external _ _ _ OK_spec ef A E P Q.
 Proof.
-  intros. intros n. eapply semax_external_funspec_sub.
-  assumption.
-  rewrite <- funspec_sub_iff. apply Hsub. trivial. trivial.
+  intros. eapply semax_external_funspec_sub; eauto.
 Qed.
 
-Lemma general_intersection_funspec_subIJ I (HI: inhabited I) J
+Lemma general_intersection_funspec_subIJ `{!VSTGS OK_ty Σ} I (HI: inhabited I) J
       sig cc phi1 ToF1 CoF1 phi2 ToF2 CoF2
       (H: forall i, exists j, funspec_sub (phi1 j) (phi2 i)):
-    funspec_sub (@general_intersection J sig cc phi1 ToF1 CoF1) (@general_intersection I sig cc phi2 ToF2 CoF2).
-Proof. apply funspec_sub_iff.
-  apply (@generalintersection_sub3 juicy_extspec.inv_names I sig cc HI phi2 ToF2 CoF2 _ (eq_refl _)).
+    funspec_sub (@general_intersection _ _ J sig cc phi1 ToF1 CoF1) (@general_intersection _ _ I sig cc phi2 ToF2 CoF2).
+Proof.
+  apply (@generalintersection_sub3 _ _ I sig cc HI phi2 ToF2 CoF2 _ (eq_refl _)).
   intros i. destruct (H i) as [j Hj]. eapply seplog.funspec_sub_trans.
-  apply (@generalintersection_sub juicy_extspec.inv_names J sig cc phi1 ToF1 CoF1 _ (eq_refl _)).
-  apply funspec_sub_iff; apply Hj.
+  apply (@generalintersection_sub _ _ J sig cc phi1 ToF1 CoF1 _ (eq_refl _)).
+  apply Hj.
 Qed.
 
 Definition semax_body_binaryintersection := @semax_body_binaryintersection.
 Definition semax_body_generalintersection := @semax_body_generalintersection.
 
-Definition semax_func_mono := semax_func_mono.
-Definition semax_func_app := semax_func_app.
-Definition semax_func_subsumption := semax_func_subsumption.
-Definition semax_func_join  := semax_func_join.
-Definition semax_func_firstn := semax_func_firstn.
-Definition semax_func_skipn := semax_func_skipn.
-Definition semax_body_subsumption:= semax_body_subsumption.
-Definition semax_body_cenv_sub:= @semax_body_cenv_sub.
-
-Lemma semax_body_funspec_sub:
-  forall (V : varspecs) (G : funspecs) (cs : compspecs) (f : function) 
+Definition semax_func_mono := @semax_func_mono.
+Definition semax_func_app := @semax_func_app.
+Definition semax_func_subsumption := @semax_func_subsumption.
+Definition semax_func_join  := @semax_func_join.
+Definition semax_func_firstn := @semax_func_firstn.
+Definition semax_func_skipn := @semax_func_skipn.
+Definition semax_body_subsumption := @semax_body_subsumption.
+Definition semax_body_cenv_sub := @semax_body_cenv_sub.
+Definition semax_body_funspec_sub := @semax_body_funspec_sub.
+
+(*Lemma semax_body_funspec_sub:
+  forall `{!heapGS Σ} {OK_spec : OracleKind} `{!externalGS OK_ty Σ} (cs : compspecs) (V : varspecs) (G : funspecs) E (f : function) 
    (i : ident) (phi phi' : funspec),
- CSHL_Defs.semax_body V G f (i, phi) ->
- funspec_sub phi phi' ->
+ CSHL_Defs.semax_body V G E f (i, phi) ->
+ funspec_sub E phi phi' ->
  list_norepet (map fst (fn_params f) ++ map fst (fn_temps f)) ->
- CSHL_Defs.semax_body V G f (i, phi').
+ CSHL_Defs.semax_body V G E f (i, phi').
 Proof.
-  intros. eapply semax_body_funspec_sub; eauto. now rewrite <- funspec_sub_iff.
-Qed.
+  intros. eapply semax_body_funspec_sub; eauto.
+Qed.*)
 
 Definition semax_seq := @semax_seq.
 Definition semax_break := @semax_break.
@@ -192,78 +180,44 @@ Definition semax_set_forward := @semax_set_forward.
 Definition semax_ifthenelse := @semax_ifthenelse.
 Definition semax_return := @semax_return.
 
-Import VST.msl.seplog VST.veric.lift.
-
-Lemma semax_call {CS Espec}:
-  forall Delta (A: TypeTree)
-  (P : forall ts, dependent_type_functor_rec ts (ArgsTT A) mpred)
-  (Q : forall ts, dependent_type_functor_rec ts (AssertTT A) mpred)
-  (NEP: args_super_non_expansive P) (NEQ: super_non_expansive Q)
-  (ts: list Type) (x : dependent_type_functor_rec ts A mpred)
+(* Why are the implicits so inconsistent here? *)
+Lemma semax_call `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS : compspecs}:
+  forall E Delta A
+  (Ef : dtfr (MaskTT A))
+  (P : dtfr (ArgsTT A))
+  (Q : dtfr (AssertTT A))
+  (x : dtfr A)
    F ret argsig retsig cc a bl,
+           Ef x ⊆ E ->
            Cop.classify_fun (typeof a) =
            Cop.fun_case_f argsig retsig cc ->
             (retsig = Ctypes.Tvoid -> ret = None) ->
           tc_fn_return Delta ret retsig ->
-  @semax CS Espec Delta
-       (fun rho => ((tc_expr Delta a rho && tc_exprlist Delta argsig bl rho))  &&
-           (func_ptr (mk_funspec (argsig,retsig) cc A P Q NEP NEQ) (eval_expr a rho) &&
-          (|>(F rho * P ts x (ge_of rho, eval_exprlist argsig bl rho)))))%pred
+  semax OK_spec E Delta
+       ((tc_expr Delta a ∧ tc_exprlist Delta argsig bl) ∧
+         (assert_of (fun rho => func_ptr (mk_funspec (argsig,retsig) cc A Ef P Q) (eval_expr a rho)) ∗
+          (▷(F ∗ assert_of (fun rho => P x (ge_of rho, eval_exprlist argsig bl rho))))))
          (Scall ret a bl)
-         (normal_ret_assert
-            (@exp
-               (forall _ : environ,
-                functors.MixVariantFunctor._functor functors.MixVariantFunctorGenerator.fidentity
-                  mpred)
-               (@LiftNatDed'
-                  (functors.MixVariantFunctor._functor
-                     functors.MixVariantFunctorGenerator.fidentity mpred) Nveric) val
-               (fun old : val =>
-                @sepcon
-                  (forall _ : environ,
-                   functors.MixVariantFunctor._functor
-                     functors.MixVariantFunctorGenerator.fidentity mpred)
-                  (@LiftNatDed'
-                     (functors.MixVariantFunctor._functor
-                        functors.MixVariantFunctorGenerator.fidentity mpred) Nveric)
-                  (@LiftSepLog'
-                     (functors.MixVariantFunctor._functor
-                        functors.MixVariantFunctorGenerator.fidentity mpred) Nveric Sveric)
-                  (@substopt
-                     (functors.MixVariantFunctor._functor
-                        functors.MixVariantFunctorGenerator.fidentity mpred) ret
-                     (@liftx (LiftEnviron val) old) F) (maybe_retval (Q ts x) retsig ret)))).
+         (normal_ret_assert (∃ old:val, assert_of (substopt ret (`old) F) ∗ maybe_retval (assert_of (Q x)) retsig ret)).
 Proof.
-  intros. specialize (@semax_call_si CS Espec Delta A P Q NEP NEQ ts x F ret argsig retsig cc a bl H H0 H1); intros X.
-  eapply semax_pre; [| apply X].
-  intros. simpl. intros w [TC [W1 W2]]; split; trivial.
-  eapply predicates_hered.now_later. rewrite <- tc_expr_eq; apply W1.
-Qed. 
-
-Lemma semax_store:forall (CS : compspecs) (Espec : OracleKind) 
-         (Delta : tycontext) (e1 e2 : expr) (sh : share)
-         (P : environ -> pred rmap),
+  intros. eapply semax_pre_post, semax_call_si; try done; [| by intros; rewrite bi.and_elim_r..].
+  intros; rewrite bi.and_elim_r; apply bi.and_mono; [apply bi.later_intro | done].
+Qed.
+
+Lemma semax_store: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS : compspecs}
+         E (Delta : tycontext) (e1 e2 : expr) (sh : share)
+         (P : assert),
        writable_share sh ->
-       semax Espec Delta
-         (fun rho : environ =>
-          (|> (extend_tc.tc_lvalue Delta e1 rho &&
-               extend_tc.tc_expr Delta (Ecast e2 (typeof e1)) rho &&
-               (mapsto_memory_block.mapsto_ sh 
-                  (typeof e1) (eval_lvalue e1 rho) * 
-                P rho)))%pred) (Sassign e1 e2)
-         (Clight_seplog.normal_ret_assert
-            (fun rho : environ =>
-             (mapsto_memory_block.mapsto sh (typeof e1)
-                (eval_lvalue e1 rho)
-                (force_val
-                   (sem_cast (typeof e2) (typeof e1) (eval_expr e2 rho))) *
-              P rho)%pred)).
+       semax OK_spec E Delta
+         (▷ ((tc_lvalue Delta e1 ∧ tc_expr Delta (Ecast e2 (typeof e1))) ∧
+             (assert_of (`(mapsto_ sh (typeof e1)) (eval_lvalue e1)) ∗ P))) (Sassign e1 e2)
+         (normal_ret_assert
+            (assert_of (`(mapsto_memory_block.mapsto sh (typeof e1)) (eval_lvalue e1) (`force_val (`(sem_cast (typeof e2) (typeof e1)) (eval_expr e2)))) ∗ P)).
 Proof.
-intros; apply semax_store; auto.
+  intros; apply semax_store; auto.
 Qed.
 
 Definition semax_store_union_hack := @semax_store_union_hack.
-
 Definition semax_load := @semax_load.
 Definition semax_cast_load := @semax_cast_load.
 Definition semax_skip := @semax_skip.
@@ -272,8 +226,6 @@ Definition semax_conseq := @semax_conseq.
 Definition semax_ptr_compare := @semax_ptr_compare.
 Definition semax_external_FF := @semax_external_FF.
 
-Definition juicy_ext_spec := juicy_ext_spec.
-
 Definition semax_ext := @semax_ext.
 
 End VericMinimumSeparationLogic.
@@ -284,9 +236,9 @@ Module CSHL_Def := VericDef.
 Module CSHL_Defs := DerivedDefs (VericDef).
 
 Lemma semax_prog_sound :
-  forall {Espec}{CS} prog z Vspec Gspec,
-  @CSHL_Defs.semax_prog Espec CS prog z Vspec Gspec ->
-  @semax_prog.semax_prog Espec CS prog z Vspec Gspec.
+  forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS : compspecs} prog z Vspec Gspec,
+  CSHL_Defs.semax_prog prog z Vspec Gspec ->
+  semax_prog.semax_prog OK_spec prog z Vspec Gspec.
 Proof.
   intros; apply H.
 Qed.
@@ -294,4 +246,3 @@ Qed.
 Definition semax_prog_rule := @semax_prog_rule.
 
 End VericSound.
-
diff --git a/veric/SeparationLogic_Rel.v b/veric/SeparationLogic_Rel.v
deleted file mode 100644
index 56dfe367e1..0000000000
--- a/veric/SeparationLogic_Rel.v
+++ /dev/null
@@ -1,151 +0,0 @@
-Require Import VST.veric.SeparationLogic.
-Require Export VST.veric.xexpr_rel.
-
-(*
-
-Inductive rel_r_value' {CS: compspecs} (rho: environ) (phi: rmap): r_value -> val -> Prop :=
- | rel_r_value'_const: forall v,
-                 rel_r_value' rho phi (R_const v) v
- | rel_r_value'_tempvar: forall id v,
-                 Map.get (te_of rho) id = Some v ->
-                 rel_r_value' rho phi (R_tempvar id) v
- | rel_r_value'_addrof: forall a v,
-                 rel_l_value' rho phi a v ->
-                 rel_r_value' rho phi (R_addrof a) v
- | rel_r_value'_unop: forall a ta v1 v op,
-                 rel_r_value' rho phi a v1 ->
-                 (forall m, Cop.sem_unary_operation op v1 ta m = Some v) ->
-                 rel_r_value' rho phi (R_unop op a ta) v
- | rel_r_value'_binop: forall a1 ta1 a2 ta2 v1 v2 v op,
-                 rel_r_value' rho phi a1 v1 ->
-                 rel_r_value' rho phi a2 v2 ->
-                 (forall m, Cop.sem_binary_operation cenv_cs op v1 ta1 v2 ta2 m = Some v) ->
-                 rel_r_value' rho phi (R_binop op a1 ta1 a2 ta2) v
- | rel_r_value'_cast: forall a ta v1 v ty,
-                 rel_r_value' rho phi a v1 ->
-                 Cop.sem_cast v1 ta ty = Some v ->
-                 rel_r_value' rho phi (R_cast a ta ty) v
- | rel_r_value'_byref: forall a v1,
-                 rel_l_value' rho phi a v1 ->
-                 rel_r_value' rho phi (R_byref a) v1
- | rel_r_value'_load: forall a ty sh v1 v2,
-                 rel_l_value' rho phi a v1 ->
-                 app_pred ((mapsto sh ty v1 v2) * TT) phi ->
-                 v2 <> Vundef ->
-                 readable_share sh ->
-                 rel_r_value' rho phi (R_load a ty) v2
-with rel_l_value' {CS: compspecs} (rho: environ) (phi: rmap): l_value -> val -> Prop :=
- | rel_r_value'_local: forall id ty b,
-                 Map.get (ve_of rho) id = Some (b,ty) ->
-                 rel_l_value' rho phi (L_var id ty) (Vptr  b Int.zero)
- | rel_r_value'_global: forall id ty b,
-                 Map.get (ve_of rho) id = None ->
-                 Map.get (ge_of rho) id = Some b ->
-                 rel_l_value' rho phi (L_var id ty) (Vptr b Int.zero)
- | rel_l_value'_deref: forall a b z,
-                 rel_r_value' rho phi a (Vptr b z) ->
-                 rel_l_value' rho phi (L_deref a) (Vptr b z)
- | rel_l_value'_field_struct: forall i a ta b z id co att delta,
-                 rel_l_value' rho phi a (Vptr b z) ->
-                 ta = Tstruct id att ->
-                 cenv_cs ! id = Some co ->
-                 field_offset cenv_cs i (co_members co) = Errors.OK delta ->
-                 rel_l_value' rho phi (L_field a ta i) (Vptr b (Int.add z (Int.repr delta))).
-Inductive l_value : Type :=
-  | L_var : ident -> type -> l_value
-  | L_deref : r_value -> l_value
-  | L_field : l_value -> type -> ident -> l_value
-  | L_ilegal : expr -> l_value
-with r_value : Type :=
-  | R_const : val -> r_value
-  | R_tempvar : ident -> r_value
-  | R_addrof : l_value -> r_value
-  | R_unop : Cop.unary_operation -> r_value -> type -> r_value
-  | R_binop : Cop.binary_operation -> r_value -> type -> r_value -> type -> r_value
-  | R_cast : r_value -> type -> type -> r_value
-  | R_byref : l_value -> r_value
-  | R_load : l_value -> type -> r_value
-  | R_ilegal : expr -> r_value.
-
-
-*)
-
-Transparent mpred Nveric Sveric Cveric Iveric Rveric Sveric SIveric SRveric.
-
-Lemma rel_r_value_const: forall {CS: compspecs} v P rho,
-  P |-- rel_r_value (R_const v) v rho.
-Proof. intros. intros ? ?. constructor. Qed.
-
-Lemma rel_r_value_tempvar: forall {CS: compspecs} id v P rho,
-  Map.get (te_of rho) id = Some v ->
-  P |-- rel_r_value (R_tempvar id) v rho.
-Proof. intros. intros ? ?. constructor; auto. Qed.
-
-Lemma rel_r_value_addrof: forall {CS: compspecs} l v P rho,
-  P |-- rel_l_value l v rho ->
-  P |-- rel_r_value (R_addrof l) v rho.
-Proof. intros. intros ? ?. constructor. apply H; auto. Qed.
-
-Lemma rel_r_value_unop: forall {CS: compspecs} op r t v0 P v rho,
-  P |-- rel_r_value r v0 rho ->
-  sem_unary_operation op t v0 = Some v ->
-  P |-- rel_r_value (R_unop op r t) v rho.
-Proof.
-  intros.
-  intros ? ?.
-  econstructor; [apply H; auto |].
-  intros.
-  destruct op; simpl in H0 |- *.
-  + clear - H0.
-    unfold Cop.sem_notbool; unfold sem_notbool in H0.
-    destruct (Cop.classify_bool t), v0; try solve [simpl in H0 |- *; congruence].
-    admit.
-  + clear - H0.
-    unfold Cop.sem_notint; unfold sem_notint in H0.
-    destruct (Cop.classify_notint t), v0; try solve [simpl in H0 |- *; congruence].
-  + clear - H0.
-    unfold Cop.sem_neg; unfold sem_neg in H0.
-    destruct (Cop.classify_neg t), v0; try solve [simpl in H0 |- *; congruence].
-  + clear - H0.
-    unfold Cop.sem_absfloat; unfold sem_absfloat in H0.
-    destruct (Cop.classify_neg t), v0; try solve [simpl in H0 |- *; congruence].
-Qed.
-
-(*
-Check sem_binary_operation'.
-Print typecheck_lvalue.
-Print isUnOpResultType.
-Print tc_comparable.
-Print denote_tc_assert.
-Lemma rel_r_value_binop: forall {CS: compspecs} op r1 t1 r2 t2 v1 v2 P v rho vp,
-  P |-- rel_r_value r1 v1 rho ->
-  P |-- rel_r_value r2 v2 rho ->
-  sem_binary_operation' op t1 t2 vp v1 v2 = Some v ->
-  P |-- rel_r_value (R_binop op r1 t1 r2 t2) v rho.
-Proof.
-  intros.
-  intros ? ?.
-SearchAbout sem_binary_operation'.
-Print isBinOpResultType.
-  econstructor; [apply H; auto | apply H0; auto |].
-  intros.
-  destruct op; simpl in H1 |- *.
-  + clear - H1.
-    unfold Cop.sem_add; unfold sem_add in H1.
-    destruct (Cop.classify_add t1 t2), v1 , v2; try solve [simpl in H1 |- *; congruence].
-unfold sem_add_default in H1; auto.
-    admit.
-  + clear - H0.
-    unfold Cop.sem_notint; unfold sem_notint in H0.
-    destruct (Cop.classify_notint t), v0; try solve [simpl in H0 |- *; congruence].
-  + clear - H0.
-    unfold Cop.sem_neg; unfold sem_neg in H0.
-    destruct (Cop.classify_neg t), v0; try solve [simpl in H0 |- *; congruence].
-  + clear - H0.
-    unfold Cop.sem_absfloat; unfold sem_absfloat in H0.
-    destruct (Cop.classify_neg t), v0; try solve [simpl in H0 |- *; congruence].
-Qed.
-
-*)
-
-Opaque mpred Nveric Sveric Cveric Iveric Rveric Sveric SIveric SRveric Bveric.
diff --git a/veric/SequentialClight.v b/veric/SequentialClight.v
index 742d89ff02..ee19eea2fc 100644
--- a/veric/SequentialClight.v
+++ b/veric/SequentialClight.v
@@ -1,17 +1,19 @@
 Require Import VST.sepcomp.semantics.
-
 Require Import VST.veric.Clight_base.
 Require Import VST.veric.Clight_core.
 Require Import VST.veric.Clight_lemmas.
 Require Import VST.sepcomp.step_lemmas.
 Require Import VST.sepcomp.event_semantics.
+Set Warnings "-hiding-delimiting-key,-custom-entry-overridden,-notation-overridden".
 Require Import VST.veric.Clight_evsem.
 Require Import VST.veric.SeparationLogic.
 Require Import VST.veric.juicy_extspec.
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.SeparationLogicSoundness.
+Require Import iris_ora.logic.wsat.
+Require Import iris_ora.logic.fancy_updates.
+Set Warnings "hiding-delimiting-key,custom-entry-overridden,notation-overridden".
 Require Import VST.sepcomp.extspec.
-Require Import VST.msl.msl_standard.
 
 Import VericSound.
 Import VericMinimumSeparationLogic.
@@ -19,1028 +21,84 @@ Import VericMinimumSeparationLogic.CSHL_Def.
 Import VericMinimumSeparationLogic.CSHL_Defs.
 Import Clight.
 
-Definition ignores_juice Z (J: external_specification juicy_mem external_function Z) : Prop :=
-  (forall e t b tl vl x jm jm',
-     m_dry jm = m_dry jm' ->
-    ext_spec_pre J e t b tl vl x jm ->
-    ext_spec_pre J e t b tl vl x jm') /\
- (forall ef t b ot v x jm jm',
-     m_dry jm = m_dry jm' ->
-    ext_spec_post J ef t b ot v x jm ->
-    ext_spec_post J ef t b ot v x jm') /\
- (forall v x jm jm',
-     m_dry jm = m_dry jm' ->
-     ext_spec_exit J v x jm ->
-     ext_spec_exit J v x jm').
-
-Import VST.veric.compcert_rmaps.R.
-
-Definition mem_evolve (m m': mem) : Prop :=
-   (* dry version of resource_decay *)
- forall loc,
- match access_at m loc Cur, access_at m' loc Cur with
- | None, None => True
- | None, Some Freeable => True
- | Some Freeable, None => True
- | Some Writable, Some p' => p' = Writable
- | Some p, Some p' => p=p' /\ access_at m loc Max = access_at m' loc Max
- | _, _ => False
- end.
-
-#[export] Instance mem_evolve_refl : RelationClasses.Reflexive mem_evolve.
-Proof.
-  repeat intro.
-  destruct (access_at x loc Cur); auto.
-  destruct p; auto.
-Qed.
-
-Lemma access_Freeable_max : forall m l, access_at m l Cur = Some Freeable -> access_at m l Max = Some Freeable.
-Proof.
-  intros.
-  pose proof (access_cur_max m l) as Hperm; rewrite H in Hperm; simpl in Hperm.
-  destruct (access_at m l Max); try contradiction.
-  inv Hperm; auto.
-Qed.
-
-#[export] Instance mem_evolve_trans : RelationClasses.Transitive mem_evolve.
-Proof.
-  repeat intro.
-  specialize (H loc); specialize (H0 loc).
-  destruct (access_at x loc Cur) eqn: Hx; [destruct p|]; destruct (access_at y loc Cur) eqn: Hy; subst; auto; try contradiction.
-  - destruct H; subst.
-    destruct (access_at z loc Cur); congruence.
-  - destruct (access_at z loc Cur) eqn: Hz; auto.
-    destruct p; try contradiction.
-    apply access_Freeable_max in Hx; apply access_Freeable_max in Hz.
-    rewrite Hx, Hz; auto.
-  - destruct H; subst.
-    destruct (access_at z loc Cur); congruence.
-  - destruct H; subst.
-    destruct (access_at z loc Cur); congruence.
-  - destruct p; try contradiction.
-    destruct (access_at z loc Cur); auto.
-    destruct H0; subst; auto.
-Qed.
-
-Definition ext_spec_mem_evolve (Z: Type)
-  (D: external_specification mem external_function Z) :=
- forall ef w b tl vl ot v z m z' m',
-    ext_spec_pre D ef w b tl vl z m ->
-    ext_spec_post D ef w b ot v z' m' ->
-    mem_evolve m m'.
-
-Definition juicy_dry_ext_spec (Z: Type)
-   (J: external_specification juicy_mem external_function Z)
-   (D: external_specification mem external_function Z)
-   (dessicate: forall ef jm, ext_spec_type J ef -> ext_spec_type D ef) :=
-  (forall e t t' b tl vl x jm,
-    dessicate e jm t = t' ->
-    ext_spec_pre J e t b tl vl x jm ->
-    ext_spec_pre D e t' b tl vl x (m_dry jm)) /\
- (forall ef t t' b ot v x jm0 jm,
-    (exists tl vl x0, dessicate ef jm0 t = t' /\ ext_spec_pre J ef t b tl vl x0 jm0) ->
-    (level jm <= level jm0)%nat ->
-    resource_at (m_phi jm) = resource_fmap (approx (level jm)) (approx (level jm)) oo juicy_mem_lemmas.rebuild_juicy_mem_fmap jm0 (m_dry jm) ->
-    ghost_of (m_phi jm) = Some (ghost_PCM.ext_ghost x, compcert_rmaps.RML.R.NoneP) :: ghost_fmap (approx (level jm)) (approx (level jm)) (tl (ghost_of (m_phi jm0))) ->
-    (ext_spec_post D ef t' b ot v x (m_dry jm) ->
-     ext_spec_post J ef t b ot v x jm)) /\
- (forall v x jm,
-     ext_spec_exit J v x jm <->
-     ext_spec_exit D v x (m_dry jm)).
-
-(* This will probably never be useful, since the witness from semax_ext
-   always includes a frame rmap, which doesn't make sense in the witness
-   of a dry spec.*)
-Definition juicy_dry_ext_spec_make (Z: Type)
-   (J: external_specification juicy_mem external_function Z) :
-   external_specification mem external_function Z.
-destruct J.
-apply Build_external_specification with ext_spec_type.
-intros e t b tl vl x m.
-apply (forall jm, m_dry jm = m -> ext_spec_pre e t b tl vl x jm).
-intros e t b ot v x m.
-apply (forall jm, m_dry jm = m -> ext_spec_post e t b ot v x jm).
-intros v x m.
-apply (forall jm, m_dry jm = m -> ext_spec_exit v x jm).
-Defined.
-
-
-Definition dessicate_id Z
-   (J: external_specification juicy_mem external_function Z) :
-   forall ef (jm : juicy_mem), ext_spec_type J ef ->
-       ext_spec_type (juicy_dry_ext_spec_make Z J) ef.
-intros.
-destruct J; simpl in *. apply X.
-Defined.
-
-Lemma jdes_make_lemma:
-  forall Z J, ignores_juice Z J ->
-    juicy_dry_ext_spec Z J (juicy_dry_ext_spec_make Z J)
-     (dessicate_id Z J).
-Proof.
-intros.
-destruct H as [? [? ?]], J; split; [ | split3]; simpl in *; intros; auto.
--
-subst t'.
-eapply H. symmetry; eassumption.  auto.
--
-destruct H2 as (? & ? & ? & ? & ?).
-subst t'.
-eapply H0; auto.
--
-eapply H1. symmetry; eassumption. auto.
-Qed.
-
-Definition mem_rmap_cohere m phi :=
-  contents_cohere m phi /\
-  access_cohere m phi /\
-  max_access_cohere m phi /\ alloc_cohere m phi.
-
-Lemma age_to_cohere:
- forall m phi n,
-    mem_rmap_cohere m phi -> mem_rmap_cohere m (age_to.age_to n phi).
-Proof.
-intros.
-destruct H as [? [? [? ?]]].
-split; [ | split3]; hnf; intros.
--
-hnf in H.
-rewrite age_to_resource_at.age_to_resource_at in H3.
-destruct (phi @ loc) eqn:?H; inv H3.
-destruct (H _ _ _ _ _ H4); split; subst; auto.
--
-rewrite age_to_resource_at.age_to_resource_at .
-specialize (H0 loc).
-rewrite H0.
-destruct (phi @ loc); simpl; auto.
--
-rewrite age_to_resource_at.age_to_resource_at .
-specialize (H1 loc).
-destruct (phi @ loc); simpl; auto.
--
-rewrite age_to_resource_at.age_to_resource_at .
-specialize (H2 loc H3).
-rewrite H2.
-reflexivity.
-Qed.
-
-Lemma set_ghost_cohere:
- forall m phi g H,
-    mem_rmap_cohere m phi ->
-   mem_rmap_cohere m (initial_world.set_ghost phi g H).
-Proof.
-intros.
-unfold initial_world.set_ghost.
-rename H into Hg. rename H0 into H.
-destruct H as [? [? [? ?]]].
-split; [ | split3]; hnf; intros.
--
-hnf in H.
-rewrite resource_at_make_rmap in H3.
-destruct (phi @ loc) eqn:?H; inv H3.
-destruct (H _ _ _ _ _ H4); split; subst; auto.
--
-rewrite resource_at_make_rmap.
-specialize (H0 loc).
-rewrite H0.
-destruct (phi @ loc); simpl; auto.
--
-rewrite resource_at_make_rmap.
-specialize (H1 loc).
-destruct (phi @ loc); simpl; auto.
--
-rewrite resource_at_make_rmap.
-specialize (H2 loc H3).
-rewrite H2.
-reflexivity.
-Qed.
-
-Lemma mem_evolve_cohere:
-  forall jm m' phi',
-   mem_evolve (m_dry jm) m' ->
-   compcert_rmaps.RML.R.resource_at phi' =
-     juicy_mem_lemmas.rebuild_juicy_mem_fmap jm m' ->
-   mem_rmap_cohere m' phi'.
-Proof.
-intros.
-destruct jm.
-simpl in *.
-unfold  juicy_mem_lemmas.rebuild_juicy_mem_fmap in H0.
-simpl in H0.
-split; [ | split3].
--
-hnf; intros; specialize (H loc).
-rewrite (JMaccess loc) in *.
-rewrite H0 in *; clear H0; simpl in *.
-destruct (phi @ loc) eqn:?H.
-simpl in H. if_tac in H.
-if_tac in H1.
-inv H1; auto.
-inv H1.
-if_tac in H1.
-inv H1; auto.
-inv H1.
-destruct k; simpl in *.
-destruct (perm_of_sh sh0) as [[ | | | ] | ] eqn:?H; try contradiction ;auto.
-destruct (access_at m' loc Cur) as [[ | | | ] | ]  eqn:?H; try contradiction; try discriminate; auto.
-if_tac in H1; inv H1; auto.
-if_tac in H1; inv H1; auto.
-if_tac in H1; inv H1; auto.
-if_tac in H1; inv H1; auto.
-if_tac in H1; inv H1; auto.
-if_tac in H1; inv H1; auto.
-if_tac in H1; inv H1; auto.
-inv H1; auto.
-inv H1; auto.
-inv H1; auto.
--
-hnf; intros; specialize (H loc).
-rewrite H0; clear H0.
-rewrite (JMaccess loc) in *.
-destruct (phi @ loc) eqn:?H.
-simpl in H. if_tac in H.
-destruct (access_at m' loc Cur) as [[ | | | ] | ] eqn:?H; try contradiction; try discriminate; simpl; auto.
-unfold perm_of_sh. rewrite if_true by auto. rewrite if_true by auto. auto.
-subst. rewrite if_true by auto; auto.
-destruct (access_at m' loc Cur) as [[ | | | ] | ] eqn:?H; try contradiction; try discriminate; simpl; auto.
-destruct H; discriminate.
-destruct H; discriminate.
-destruct H; discriminate.
-rewrite if_false by auto; auto.
-destruct k; simpl in *; auto.
-destruct (perm_of_sh sh) as [[ | | | ] | ] eqn:?H; try contradiction ;auto.
-destruct (access_at m' loc Cur) as [[ | | | ] | ]  eqn:?H; try solve [contradiction]; try discriminate; auto.
-destruct H; discriminate.
-destruct H; discriminate.
-destruct H; discriminate.
-simpl. rewrite if_true; auto.
-destruct (access_at m' loc Cur) as [[ | | | ] | ]  eqn:?H; try solve [contradiction]; try discriminate; auto.
-destruct (access_at m' loc Cur) as [[ | | | ] | ]  eqn:?H; try solve [contradiction]; try discriminate; auto.
-destruct (access_at m' loc Cur) as [[ | | | ] | ]  eqn:?H; try solve [contradiction]; try discriminate; auto.
-destruct H; discriminate.
-destruct H; discriminate.
-destruct H; discriminate.
-exfalso; clear - r H1.
-unfold perm_of_sh in H1. if_tac in H1. if_tac in H1; inv H1.
-rewrite if_true in H1 by auto. inv H1.
-destruct (access_at m' loc Cur) as [[ | | | ] | ]  eqn:?H; try solve [contradiction]; try discriminate; auto.
-unfold perm_of_sh in H1. if_tac in H1. if_tac in H1; inv H1.
-rewrite if_true in H1 by auto. inv H1.
-unfold perm_of_sh in H1. if_tac in H1. if_tac in H1; inv H1.
-rewrite if_true in H1 by auto.
-inv H1.
-destruct (access_at m' loc Cur) as [[ | | | ] | ]  eqn:?H; try solve [contradiction]; try discriminate; auto.
-destruct H; discriminate.
-destruct H; discriminate.
-destruct H; discriminate.
-destruct (access_at m' loc Cur) as [[ | | | ] | ]  eqn:?H; try solve [contradiction]; try discriminate; auto.
-destruct H; discriminate.
-destruct H; discriminate.
-destruct H; discriminate.
-destruct (access_at m' loc Cur) as [[ | | | ] | ]  eqn:?H; try solve [contradiction]; try discriminate; auto.
-simpl in H; destruct H; discriminate.
-simpl in H; destruct H; discriminate.
-simpl in H; destruct H; discriminate.
--
-hnf; intros; specialize (H loc).
-rewrite H0; clear H0.
-rewrite (JMaccess loc) in *.
-destruct (phi @ loc) eqn:?H.
-simpl in H. if_tac in H.
-destruct (access_at m' loc Cur) as [[ | | | ] | ] eqn:?H; try contradiction; try discriminate; simpl; auto.
-eapply perm_order''_trans; [apply access_cur_max | ].
-rewrite H2.
-unfold perm_of_sh. rewrite if_true by auto. rewrite if_true by auto. constructor.
-subst sh. rewrite if_true by auto.
-apply po_None.
-destruct (access_at m' loc Cur) as [[ | | | ] | ] eqn:?H; try contradiction; try discriminate; simpl; auto.
-destruct H; discriminate.
-destruct H; discriminate.
-destruct H; discriminate.
-rewrite if_false by auto.
-eapply perm_order''_trans; [apply access_cur_max | ].
-rewrite H2. constructor.
-destruct k; simpl in *; auto.
-destruct (perm_of_sh sh) as [[ | | | ] | ] eqn:?H; try contradiction ;auto.
-eapply perm_order''_trans; [apply access_cur_max | ].
-destruct (access_at m' loc Cur). destruct H; subst.
-match goal with |- Mem.perm_order'' _ ?A =>
-  destruct A; try constructor
-end.
-simpl.
-rewrite if_true by auto. auto.
-eapply perm_order''_trans; [apply access_cur_max | ].
-destruct (access_at m' loc Cur). destruct H; subst.
-rewrite if_true. simpl. rewrite H1. apply perm_refl.
-clear - r H1.
-unfold perm_of_sh in H1.
-if_tac in H1. if_tac in H1. inv H1; constructor.
-inv H1; constructor.
-rewrite if_true in H1 by auto. inv H1; constructor.
-contradiction.
-eapply perm_order''_trans; [apply access_cur_max | ].
-destruct (access_at m' loc Cur). destruct H; subst.
-rewrite if_true. simpl. rewrite H1. apply perm_refl.
-clear - r H1.
-unfold perm_of_sh in H1.
-if_tac in H1. if_tac in H1. inv H1; constructor.
-inv H1; constructor.
-rewrite if_true in H1 by auto. inv H1; constructor.
-contradiction.
-eapply perm_order''_trans; [apply access_cur_max | ].
-destruct (access_at m' loc Cur). destruct H; subst.
-rewrite if_true. simpl. rewrite H1. apply perm_refl.
-clear - r H1.
-unfold perm_of_sh in H1.
-if_tac in H1. if_tac in H1. inv H1; constructor.
-inv H1; constructor.
-rewrite if_true in H1 by auto. inv H1; constructor.
-contradiction.
-eapply perm_order''_trans; [apply access_cur_max | ].
-destruct (access_at m' loc Cur). destruct p0; try contradiction.
-match goal with |- Mem.perm_order'' _ ?A =>
-  destruct A; try constructor
-end.
-exfalso.
-clear - H1 r.
-unfold perm_of_sh in H1.
-if_tac in H1. if_tac in H1. inv H1; constructor.
-inv H1; constructor.
-rewrite if_true in H1 by auto. inv H1; constructor.
-destruct (access_at m' loc Cur); try contradiction.
-destruct H; subst p0.
-specialize (JMmax_access loc).
-rewrite H0 in JMmax_access.
-simpl in JMmax_access.
-unfold max_access_at in *.
-rewrite <- H1. auto.
-destruct (access_at m' loc Cur); try contradiction.
-destruct H; subst p0.
-specialize (JMmax_access loc).
-rewrite H0 in JMmax_access.
-simpl in JMmax_access.
-unfold max_access_at in *.
-rewrite <- H1. auto.
-simpl in H.
-destruct (access_at m' loc Cur); try contradiction.
-destruct H; subst.
-simpl.
-specialize (JMmax_access loc).
-rewrite H0 in JMmax_access.
-simpl in JMmax_access.
-unfold max_access_at in *.
-rewrite <- H1. auto.
--
-hnf; intros; specialize (H loc).
-rewrite H0; clear H0.
-specialize (JMalloc loc).
-rewrite (JMaccess loc) in *.
-destruct (phi @ loc) eqn:?H.
-simpl in H. if_tac in H.
-destruct loc as [b z].
-rewrite nextblock_access_empty in *by auto.
-subst.
-simpl.
-f_equal. apply proof_irr.
-destruct loc as [b z].
-rewrite nextblock_access_empty in * by auto.
-contradiction.
-destruct loc as [b z].
-rewrite nextblock_access_empty in * by auto.
-simpl.
-destruct k; auto; try contradiction H.
-simpl in H.
-destruct loc as [b z].
-rewrite nextblock_access_empty in * by auto.
-contradiction.
-Qed.
-
-Lemma mem_step_evolve : forall m m', mem_step m m' -> mem_evolve m m'.
-Proof.
-  induction 1; intros loc.
-  - rewrite <- (storebytes_access _ _ _ _ _ H); destruct (access_at m loc Cur); auto.
-    destruct p; auto.
-  - destruct (adr_range_dec (b', lo) (hi - lo) loc).
-    + destruct (alloc_dry_updated_on _ _ _ _ _ loc H) as [->]; auto.
-      pose proof (Mem.alloc_result _ _ _ _ _ H); subst.
-      destruct loc, a; subst.
-      rewrite nextblock_access_empty; auto; lia.
-    + eapply alloc_dry_unchanged_on in n as [Heq _]; eauto.
-      rewrite <- Heq.
-      destruct (access_at m loc Cur); auto.
-      destruct p; auto.
-  - generalize dependent m; induction l; simpl; intros.
-    + inv H; destruct (access_at m' loc Cur); auto.
-      destruct p; auto.
-    + destruct a as ((b, lo), hi).
-      destruct (Mem.free m b lo hi) eqn: Hfree; inv H.
-      apply IHl in H1.
-      destruct (adr_range_dec (b, lo) (hi - lo) loc).
-      * destruct loc, a; subst.
-        eapply free_access in Hfree as [Hfree H2]; [rewrite Hfree | lia].
-        pose proof (access_cur_max m0 (b0, z)) as Hperm; rewrite H2 in Hperm; simpl in Hperm.
-        destruct (access_at m0 (b0, z) Cur); try contradiction.
-        destruct (access_at m' (b0, z) Cur) eqn: Hm'; auto.
-        destruct p; try contradiction.
-        apply access_Freeable_max in Hfree; apply access_Freeable_max in Hm'; rewrite Hfree, Hm'; auto.
-      * destruct loc; eapply free_nadr_range_eq in n as [->]; eauto.
-  - eapply mem_evolve_trans; eauto.
-Qed.
-
-Fixpoint in_alloc_trace b ofs T :=
-  match T with
-  | nil => false
-  | Alloc b' lo hi :: rest => adr_range_dec (b', lo) (hi - lo) (b, ofs) || in_alloc_trace b ofs rest
-  | _ :: rest => in_alloc_trace b ofs rest
-  end.
-
-Lemma ev_elim_perm_inv : forall l k T m m', ev_elim m T m' ->
-  (in_free_list_trace (fst l) (snd l) T /\ access_at m' l k = None) \/
-  ~in_free_list_trace (fst l) (snd l) T /\ ((in_alloc_trace (fst l) (snd l) T = true /\
-   (fst l >= Mem.nextblock m)%positive /\ access_at m' l k = Some Freeable) \/
-  (in_alloc_trace (fst l) (snd l) T = false /\
-   access_at m' l k = access_at m l k)).
-Proof.
-  induction T; simpl; intros; subst; auto.
-  destruct a.
-  - destruct H as (? & ? & ?%IHT).
-    rewrite (storebytes_access _ _ _ _ _ H), <- (Mem.nextblock_storebytes _ _ _ _ _ H); auto.
-  - destruct H as (? & ?%IHT); auto.
-  - destruct H as (? & ? & Hrest%IHT).
-    destruct Hrest as [? | [? Hrest]]; auto.
-    right; split; auto.
-    destruct (adr_range_dec _ _ _); simpl.
-    + left; split; auto.
-      destruct a; subst.
-      split; [apply Mem.alloc_result in H; lia|].
-      destruct Hrest as [(? & ? & ?) | (? & ->)]; auto.
-      destruct l; simpl in *; eapply alloc_access_same; eauto; lia.
-    + destruct Hrest as [(? & Hge & ?) | (? & ?)]; [left | right]; split; auto.
-      * split; auto.
-        erewrite Mem.nextblock_alloc in Hge by eauto; lia.
-      * destruct l; simpl in *; rewrite (alloc_access_other _ _ _ _ _ H); auto; lia.
-  - destruct H as (? & ? & Hrest%IHT).
-    destruct Hrest as [[] | [? Hrest]]; auto.
-    destruct (in_free_list_dec (fst l) (snd l) l0).
-    + left; split; auto.
-      edestruct freelist_access_2'; eauto.
-      destruct Hrest as [(? & ? & ?) | [_ ->]].
-      * unfold Mem.valid_block, Plt in *; lia.
-      * unfold access_at; auto.
-    + right; split; [tauto|].
-      destruct Hrest as [(? & Hge & ?) | (? & ?)]; [left | right]; split; auto.
-      * split; auto.
-        erewrite mem_lemmas.nextblock_freelist in Hge by eauto; lia.
-      * unfold access_at at 2; rewrite <- (freelist_access_1 _ _ _ _ n _ _ H); auto.
-Qed.
-
-Lemma ev_elim_alloc : forall l k T m m', ev_elim m T m' ->
-  in_alloc_trace (fst l) (snd l) T = true -> ~ in_free_list_trace (fst l) (snd l) T ->
-  access_at m' l k = Some Freeable.
-Proof.
-  induction T; [discriminate|]; simpl; intros.
-  destruct a.
-  - destruct H as (? & ? & ?%IHT); auto.
-  - destruct H as (? & ?%IHT); auto.
-  - destruct H as (? & ? & Helim).
-    unfold proj_sumbool in *.
-    apply orb_true_iff in H0 as [Hin | ?]; eauto.
-    if_tac in Hin; inv Hin.
-    destruct H0; subst.
-    eapply ev_elim_perm_inv in Helim as [[] | [_ Hcase]]; [contradiction H1; eauto|].
-    destruct Hcase as [(? & ? & ?) | (? & ->)]; eauto.
-    destruct l; simpl in *; eapply alloc_access_same; eauto; lia.
-  - destruct H as (? & ? & ?%IHT); auto.
-Qed.
-
-Lemma ev_elim_alloc_new : forall b lo sz T m m', ev_elim m T m' ->
-  In (Alloc b lo sz) T -> (b >= Mem.nextblock m)%positive.
-Proof.
-  induction T; simpl; [contradiction|]; intros.
-  destruct H0.
-  - subst.
-    destruct H as (? & ? & ?).
-    apply Mem.alloc_result in H; subst; lia.
-  - destruct a; (destruct H as (? & ? & Helim) || destruct H as (? & Helim)); eapply IHT in Helim; eauto.
-    + erewrite <- Mem.nextblock_storebytes; eauto.
-    + erewrite Mem.nextblock_alloc in Helim; eauto; lia.
-    + erewrite <- mem_lemmas.nextblock_freelist; eauto.
-Qed.
-
-Fixpoint in_write_trace b ofs T :=
-  match T with
-  | nil => false
-  | Write b' z lv :: rest => adr_range_dec (b', z) (Zlength lv) (b, ofs) || in_write_trace b ofs rest
-  | _ :: rest => in_write_trace b ofs rest
-  end.
-
-Lemma perm_order_total : forall p1 p2, ~perm_order p1 p2 -> perm_order p2 p1.
-Proof.
-  destruct p1, p2; try constructor; intros H; contradiction H; constructor.
-Qed.
-
-Lemma pmax_l : forall p1 p2 q : option permission,
-  Mem.perm_order'' (pmax p1 p2) q <-> Mem.perm_order'' p1 q \/ Mem.perm_order'' p2 q.
-Proof.
-  intros; unfold pmax.
-  destruct p1, p2; simpl in *; try solve [destruct q; tauto].
-  if_tac; [|apply perm_order_total in H]; destruct q; simpl; split; auto; intros [? | ?]; auto; eapply perm_order_trans; eauto.
-Qed.
-
-Lemma in_write_trace_perm : forall b ofs T, in_write_trace b ofs T = true ->
-  (exists z sz, In (Alloc b z sz) T) \/ Mem.perm_order' (cur_perm (b, ofs) T) Writable.
-Proof.
-  induction T; simpl; [discriminate|]; intros.
-  rewrite mem_lemmas.po_oo in *.
-  destruct a.
-  - rewrite pmax_l; destruct (adr_range_dec _ _ _); simpl in *; [|apply IHT in H as [(? & ? & ?) | ?]; eauto].
-    destruct a; subst.
-    right; left; setoid_rewrite if_true; auto; [|lia]; simpl.
-    destruct (zle _ _); try lia; constructor.
-  - rewrite pmax_l; apply IHT in H as [(? & ? & ?) | ?]; eauto.
-  - if_tac; [|apply IHT in H as [(? & ? & ?) | ?]; eauto].
-    subst; eauto.
-  - apply IHT in H as [(? & ? & ?) | ?]; eauto.
-    right.
-    induction l; auto; simpl.
-    destruct a as ((?, ?), ?); simple_if_tac; auto; constructor.
-Qed.
-
-Lemma free_contents : forall m b lo hi m', Mem.free m b lo hi = Some m' ->
-  contents_at m' = contents_at m.
-Proof.
-  intros; apply Mem.free_result in H; subst; auto.
-Qed.
-
-Lemma free_list_contents : forall l m m', Mem.free_list m l = Some m' ->
-  contents_at m' = contents_at m.
-Proof.
-  induction l; simpl; intros.
-  { inv H; auto. }
-  destruct a as ((?, ?), ?).
-  destruct (Mem.free _ _ _ _) eqn: Hfree; inv H.
-  apply free_contents in Hfree as <-; auto.
-Qed.
-
-Lemma ev_elim_nostore : forall l T m m', ev_elim m T m' ->
-  in_write_trace (fst l) (snd l) T = false ->
-  (exists z sz, In (Alloc (fst l) z sz) T) \/ contents_at m' l = contents_at m l.
-Proof.
-  induction T; simpl; intros; subst; auto.
-  destruct a.
-  - destruct (adr_range_dec _ _ _); [discriminate|].
-    destruct H as (? & ? & Helim).
-    apply IHT in Helim as [(? & ? & ?) | ->]; eauto.
-    unfold contents_at; erewrite Mem.storebytes_mem_contents by eauto.
-    destruct (eq_block b (fst l)).
-    + subst; rewrite Maps.PMap.gss, Mem.setN_outside; auto.
-      rewrite <- Zlength_correct.
-      unfold adr_range in n.
-      destruct (zlt (snd l) ofs); auto.
-      destruct (zlt (snd l) (ofs + Zlength bytes)); auto; lia.
-    + rewrite Maps.PMap.gso; auto.
-  - destruct H as (? & Helim).
-    apply IHT in Helim as [(? & ? & ?) | ->]; eauto.
-  - destruct H as (? & ? & Helim).
-    apply IHT in Helim as [(? & ? & ?) | ->]; eauto.
-    destruct (eq_block b (fst l)); subst; eauto.
-    unfold contents_at; erewrite mem_lemmas.AllocContentsOther; eauto.
-  - destruct H as (? & ? & Helim).
-    apply IHT in Helim as [(? & ? & ?) | ->]; eauto.
-    erewrite free_list_contents; eauto.
-Qed.
-
-Lemma ev_elim_contents' : forall l T m m', ev_elim m T m' -> (fst l < Mem.nextblock m)%positive ->
-  ~Mem.perm m (fst l) (snd l) Cur Writable ->
-  (forall m1 m1', ev_elim m1 T m1' -> contents_at m1' l = contents_at m1 l).
-Proof.
-  intros.
-  destruct (in_write_trace (fst l) (snd l) T) eqn: Hwrite.
-  - apply in_write_trace_perm in Hwrite as [(? & ? & Halloc) | ?].
-    { eapply (ev_elim_alloc_new _ _ _ _ _ _ H) in Halloc; eauto; lia. }
-    eapply ev_perm in H.
-    unfold Mem.perm in *.
-    rewrite mem_lemmas.po_oo in *; eapply mem_lemmas.po_trans in H3; eauto; contradiction.
-  - eapply ev_elim_nostore in Hwrite as [(? & ? & Halloc) | ?]; eauto.
-    eapply (ev_elim_alloc_new _ _ _ _ _ _ H) in Halloc; eauto.
-    apply Pos.lt_nle in H0; apply Pos.ge_le in Halloc; contradiction.
-Qed.
-
-Lemma join_ev_elim_commut : forall jm1 x jm2 T jm1' m2', join (m_phi jm1) x (m_phi jm2) ->
-  mem_sub (m_dry jm1) (m_dry jm2) -> ev_elim (m_dry jm1) T (m_dry jm1') -> mem_sub (m_dry jm1') m2' ->
-  resource_decay (Mem.nextblock (m_dry jm1)) (m_phi jm1) (m_phi jm1') -> ev_elim (m_dry jm2) T m2' ->
-  forall l, join (m_phi jm1' @ l)
-    (compcert_rmaps.RML.R.resource_fmap (compcert_rmaps.RML.R.approx (level jm1')) (compcert_rmaps.RML.R.approx (level jm1')) (x @ l))
-    (compcert_rmaps.RML.R.resource_fmap (compcert_rmaps.RML.R.approx (level jm1')) (compcert_rmaps.RML.R.approx (level jm1')) (juicy_mem_lemmas.rebuild_juicy_mem_fmap jm2 m2' l)).
-Proof.
-  intros ?????? J Hmem Helim1 Hmem' Hdecay Helim2 l.
-  unfold juicy_mem_lemmas.rebuild_juicy_mem_fmap.
-  apply (compcert_rmaps.RML.resource_at_join _ _ _ l) in J.
-  edestruct ev_elim_perm_inv as [[? Hnone] | [? [(? & ? & Hnew) | (? & Hsame)]]]; eauto.
-  - (* location was freed *)
-    rewrite Hnone; simpl.
-    destruct jm1'; simpl in *.
-    specialize (JMaccess l).
-    eapply ev_elim_free_1 in H as (Hcase & Hnone1 & ? & ?); [|apply Helim1].
-    unfold access_at in JMaccess; rewrite Hnone1 in JMaccess.
-    unfold perm_of_res in JMaccess.
-    destruct (phi @ l); try discriminate.
-    if_tac in JMaccess; inv JMaccess.
-    destruct Hcase as [Hm1 | Hm1].
-    + destruct l; simpl in *.
-      rewrite perm_access, (juicy_mem_access jm1) in Hm1.
-      assert (perm_of_res (m_phi jm1 @ (b, z)) = Some Freeable) as Hperm1
-        by (destruct (perm_of_res _); inv Hm1; auto).
-      apply semax_call.perm_of_res_val in Hperm1 as (? & ? & Hp); rewrite Hp in J.
-      inv J.
-      * apply join_Tsh in RJ as []; subst.
-        constructor; auto.
-      * apply join_Tsh in RJ as []; subst.
-        contradiction bot_unreadable.
-    + assert (fst l >= Mem.nextblock (m_dry jm2))%positive.
-      { destruct Hmem as (_ & <- & _); auto. }
-      rewrite (juicy_mem_alloc_cohere jm2) in * by auto.
-      inv J; constructor.
-      apply join_Bot in RJ as []; subst; auto.
-    + destruct k; try discriminate.
-      unfold perm_of_sh in JMaccess; repeat if_tac in JMaccess; try discriminate; subst.
-      contradiction.
-  - (* location was newly allocated and not freed *)
-    rewrite Hnew; simpl.
-    rewrite (juicy_mem_alloc_cohere jm2) in * by auto.
-    inv J; simpl.
-    apply join_Bot in RJ as []; subst.
-    eapply ev_elim_alloc in Helim1; eauto.
-    rewrite juicy_mem_access in Helim1.
-    apply semax_call.perm_of_res_val in Helim1 as (? & ? & Hp); rewrite Hp.
-    apply juicy_mem_contents in Hp as []; subst.
-    unfold contents_at; destruct Hmem' as [-> _].
-    constructor; auto.
-  - (* location was only read and written *)
-    rewrite Hsame, juicy_mem_access.
-    destruct (ev_elim_perm_inv l Cur _ _ _ Helim1) as [[? ?] | [_ [(? & ? & Hnew) | (_ & Hsame1)]]].
-    { contradiction H; eauto. }
-    { congruence. }
-    pose proof (juicy_mem_access jm1' l) as Hperm; rewrite Hsame1, juicy_mem_access in Hperm.
-    destruct Hdecay as [_ Hdecay]; specialize (Hdecay l); destruct Hdecay as [_ Hdecay].
-    inv J; rewrite <- H2 in Hperm, Hdecay; simpl in *.
-    + rewrite if_false by (if_tac; simpl; auto; intros X; inv X).
-      destruct (m_phi jm1' @ l); try discriminate; simpl in Hperm.
-      destruct Hdecay as [Heq | [(? & ? & ? & ? & ? & ?) | [(? & ? & ?) | (? & ? & ? & ?)]]]; try discriminate; inv Heq.
-      constructor; auto.
-      { destruct Hdecay as [? | [(? & ? & ? & ? & ? & ?) | [(? & ? & Heq) | (? & ? & ? & ?)]]]; try discriminate; inv Heq.
-        rewrite perm_of_freeable in Hperm; if_tac in Hperm; discriminate. }
-      { destruct Hdecay as [Heq | [(? & ? & ? & ? & ? & ?) | [(? & ? & ?) | (? & ? & ? & ?)]]]; discriminate. }
-    + destruct (Pos.ltb_spec (fst l) (Mem.nextblock (m_dry jm1))).
-      destruct k.
-      rewrite if_true by (unfold perm_of_sh; if_tac; if_tac; try contradiction; constructor).
-      unfold perm_of_sh in Hperm; rewrite (if_true _ _ _ _ _ rsh1) in Hperm.
-      destruct (m_phi jm1' @ l) eqn: H1'; simpl in Hperm; try (repeat if_tac in Hperm; discriminate).
-      destruct k; try (repeat if_tac in Hperm; discriminate).
-      apply juicy_mem_contents in H1' as []; subst.
-      unfold contents_at; destruct Hmem' as (-> & _ & _).
-      constructor.
-      destruct Hdecay as [Heq | [(? & ? & ? & ? & Heq & Heq1) | [(? & ? & Heq) | (? & ? & ? & ?)]]]; try discriminate; inv Heq; try inv Heq1; auto.
-      rewrite perm_of_freeable in Hperm; repeat if_tac in Hperm; try discriminate; subst; auto.
-      { destruct Hdecay as [<- | [(? & ? & ? & ? & ? & ?) | [(? & ? & ?) | (? & ? & ? & ?)]]]; try discriminate; try lia; constructor; auto. }
-      { destruct Hdecay as [<- | [(? & ? & ? & ? & ? & ?) | [(? & ? & ?) | (? & ? & ? & ?)]]]; try discriminate; try lia; constructor; auto. }
-      { rewrite juicy_mem_alloc_cohere in H2 by (apply Pos.le_ge; auto). inv H2. }
-    + destruct Hdecay as [Heq | [(? & ? & ? & ? & Heq & Heq1) | [(? & ? & Heq) | (? & ? & ? & ?)]]]; try discriminate.
-      rewrite <- Heq.
-      destruct k; try constructor; auto.
-      rewrite if_true by (unfold perm_of_sh; if_tac; if_tac; try contradiction; constructor).
-      rewrite (juicy_mem_access jm1'), <- Hperm in Hsame1.
-      eapply (ev_elim_contents' _ _ _ _ Helim1) in Helim2 as ->; auto.
-      symmetry in H4; apply juicy_mem_contents in H4 as []; subst.
-      constructor; auto.
-      { destruct (Pos.ltb_spec (fst l) (Mem.nextblock (m_dry jm1))); auto.
-        erewrite juicy_mem_alloc_cohere in H4. inv H4.
-        destruct Hmem as (_ & <- & _); apply Pos.le_ge; auto. }
-      { unfold Mem.perm; unfold access_at in Hsame1.
-        setoid_rewrite <- Hsame1.
-        if_tac; intros X; inv X. }
-      { erewrite juicy_mem_alloc_cohere in H4. inv H4.
-        destruct Hmem as (_ & <- & _); auto. }
-    + destruct (Pos.ltb_spec (fst l) (Mem.nextblock (m_dry jm1))).
-      destruct k.
-      rewrite if_true by (unfold perm_of_sh; if_tac; if_tac; try contradiction; constructor).
-      unfold perm_of_sh in Hperm; rewrite (if_true _ _ _ _ _ rsh1) in Hperm.
-      destruct (m_phi jm1' @ l) eqn: H1'; simpl in Hperm; try (repeat if_tac in Hperm; discriminate).
-      destruct k; try (repeat if_tac in Hperm; discriminate).
-      rewrite (juicy_mem_access jm1'), H1' in Hsame1.
-      apply juicy_mem_contents in H1' as []; subst.
-      unfold contents_at; destruct Hmem' as (-> & _ & _).
-      fold (contents_at m2' l).
-      eapply (ev_elim_contents' _ _ _ _ Helim1) in Helim2 as ->; auto.
-      symmetry in H4; apply juicy_mem_contents in H4 as []; subst.
-      constructor; auto.
-      { destruct Hdecay as [Heq | [(? & ? & ? & ? & Heq & Heq1) | [(? & ? & Heq) | (? & ? & ? & ?)]]]; try discriminate; inv Heq; try inv Heq1; auto; lia. }
-      { unfold Mem.perm. unfold access_at in Hsame1; setoid_rewrite <- Hsame1; simpl.
-        rewrite <- Hperm; if_tac; [|intros X; inv X].
-        apply join_writable0_readable in RJ; auto. }
-      { destruct Hdecay as [<- | [(? & ? & ? & ? & ? & ?) | [(? & ? & ?) | (? & ? & ? & ?)]]]; try discriminate; try lia; constructor; auto. }
-      { destruct Hdecay as [<- | [(? & ? & ? & ? & ? & ?) | [(? & ? & ?) | (? & ? & ? & ?)]]]; try discriminate; try lia; constructor; auto. }
-      { rewrite juicy_mem_alloc_cohere in H2 by (apply Pos.le_ge; auto). inv H2. }
-    + destruct Hdecay as [<- | [(? & ? & ? & ? & ? & ?) | [(? & ? & ?) | (? & ? & ? & ?)]]]; try discriminate.
-      constructor; auto.
-      erewrite juicy_mem_alloc_cohere in H4. inv H4.
-      destruct Hmem as (_ & <- & _); auto.
-Qed.
-
-Lemma join_sub_pures_eq : forall a b, join_sub a b -> juicy_safety.pures_eq a b.
-Proof.
-  intros ?? [? J]; unfold juicy_safety.pures_eq, juicy_safety.pures_sub.
-  split; intros l; apply (compcert_rmaps.RML.resource_at_join _ _ _ l) in J; inv J; eauto.
-  rewrite H2, <- compcert_rmaps.RML.resource_at_approx, <- H2; reflexivity.
-Qed.
-
-Lemma pures_eq_sym : forall a b, level a = level b -> juicy_safety.pures_eq a b -> juicy_safety.pures_eq b a.
-Proof.
-  unfold juicy_safety.pures_eq, juicy_safety.pures_sub; intros.
-  destruct H0 as [H1 H2]; split; intros l; specialize (H1 l); specialize (H2 l); destruct (a @ l) eqn: Ha, (b @ l) eqn: Hb; try congruence; eauto.
-  - destruct H2; discriminate.
-  - destruct H2; discriminate.
-  - destruct H2 as [? H2]; inv H2; inv H1.
-    rewrite <- Ha, <- compcert_rmaps.RML.resource_at_approx, Ha.
-    rewrite compcert_rmaps.RML.preds_fmap_fmap, H, compcert_rmaps.RML.approx_oo_approx; reflexivity.
-Qed.
-
-(* frame property for juicy extspecs *)
-Definition extspec_frame {Z} (JE : juicy_ext_spec Z) := forall e t b lt lv z jm w jm1, ext_spec_pre JE e t b lt lv z jm ->
-        mem_sub (m_dry jm) (m_dry jm1) -> join (m_phi jm) w (m_phi jm1) -> semax.ext_compat z (m_phi jm1) ->
-        exists t1, ext_spec_pre JE e t1 b lt lv z jm1 /\
-        forall ot v z' jm1', ext_spec_post JE e t1 b ot v z' jm1' ->
-          exists jm', ext_spec_post JE e t b ot v z' jm' /\ mem_sub (m_dry jm') (m_dry jm1') /\
-            join (m_phi jm') (age_to.age_to (level jm') w) (m_phi jm1').
-
-Lemma funspec2jspec_frame : forall {Z} (JE : juicy_ext_spec Z) extlink f,
-  extspec_frame JE -> extspec_frame (semax_ext.funspec2jspec _ JE extlink f).
-Proof.
-  unfold semax_ext.funspec2jspec, semax_ext.funspec2extspec, extspec_frame; simpl; intros.
-  destruct f as (?, []), t0; simpl in *.
-  unfold semax_ext.funspec2pre, semax_ext.funspec2post in *; if_tac; [|eauto].
-  destruct t as (frame, t); simpl in *.
-  destruct H0 as (? & ? & ? & J & ? & ? & ?).
-  destruct (join_assoc J H2) as (frame' & Jframe & ?).
-  exists (frame', t); simpl; split; eauto 7.
-  intros ???? (? & ? & J' & ? & ?).
-  eapply join_comm, nec_join2 in Jframe as (? & frame1 & Jframe & Hnecw & ?); eauto.
-  destruct (join_assoc (join_comm Jframe) (join_comm J')) as (? & J1 & J1').
-  destruct (join_assoc J1 (join_comm J1')) as (? & J'' & Jtop%join_comm).
-  edestruct juicy_mem_sub as (? & ? & ?); [eexists; eauto | subst].
-  eexists; split; [do 3 eexists; [apply J''|]|]; split; auto.
-  - eapply rt_trans; eauto.
-  - pose proof (necR_level _ _ Hnecw).
-    apply age_to.necR_age_to in Hnecw; rewrite Hnecw in Jtop.
-    destruct (join_level _ _ _ Jtop) as [-> <-].
-    rewrite age_to.level_age_to; auto.
-Qed.
-
-Lemma add_funspecs_frame' : forall {Espec : OracleKind} extlink fs,
-  extspec_frame OK_spec -> extspec_frame (@OK_spec (add_funspecs Espec extlink fs)).
-Proof.
-  destruct Espec; simpl; intros.
-  generalize dependent OK_spec; induction fs; simpl; auto; intros.
-  destruct a; apply funspec2jspec_frame; auto.
-Qed.
-
-Lemma void_spec_frame : forall {Z}, extspec_frame (@OK_spec (ok_void_spec Z)).
-Proof.
-  unfold ok_void_spec; simpl; repeat intro; contradiction.
-Qed.
-
-Lemma add_funspecs_frame : forall {Z} extlink fs,
-  extspec_frame (@OK_spec (add_funspecs (ok_void_spec Z) extlink fs)).
-Proof.
-  intros; apply add_funspecs_frame', void_spec_frame.
+Definition sig_of_funspec `{!heapGS Σ} (f : funspec) := typesig2signature (typesig_of_funspec f) (callingconvention_of_funspec f).
+
+Lemma juicy_dry_spec : forall `{!VSTGS OK_ty Σ} ext_link fs es
+  (Hspecs : forall s f, In (ext_link s, f) fs -> match f with mk_funspec ts cc E A P Q =>
+     let e := EF_external s (typesig2signature ts cc) in
+     forall w p tys args m z, exists x,
+       state_interp m z ∗ P w (filter_genv (symb2genv p), args) ⊢ ⌜ext_spec_pre es e x p tys args z m⌝ ∧
+         ∀ ty ret z' m', ⌜ext_spec_post es e x p ty ret z' m'⌝ → |==>
+           state_interp m' z' ∗ Q w (make_ext_rval (filter_genv (symb2genv p)) ty ret)
+   end)
+  (Hexit : forall v z m, ext_spec_exit es v z m),
+  ext_spec_entails (add_funspecs_rec OK_ty ext_link (void_spec OK_ty) fs) es.
+Proof.
+  intros; constructor; last done; clear Hexit.
+  intros *; intros Hpre; induction fs; simpl; first done.
+  destruct a as (i, [[]]); simpl in *.
+  rewrite /funspec2pre in Hpre; rewrite /funspec2post; if_tac.
+  - clear IHfs.
+    destruct e; inv H.
+    specialize (Hspecs _ _ ltac:(eauto)).
+    destruct x1 as ((n, phi), w).
+    specialize (Hspecs w); edestruct Hspecs as (x & Hspec).
+    exists x.
+    destruct Hpre as (Hvalid & Hty & HP).
+    eapply Hspec in HP; last done.
+    revert HP; ouPred.unseal; intros (Hpre & Hpost).
+    split; first apply Hpre.
+    intros ???? Hpost'; eapply Hpost; auto.
+  - apply IHfs; auto.
+    intros; apply Hspecs; auto.
 Qed.
 
 Lemma whole_program_sequential_safety_ext:
-   forall {CS: compspecs} {Espec: OracleKind} (initial_oracle: OK_ty)
-     (EXIT: semax_prog.postcondition_allows_exit Espec tint)
-     (Jsub: forall ef se lv m t v m' (EFI : ef_inline ef = true) m1
-       (EFC : Events.external_call ef se lv m t v m'), mem_sub m m1 ->
-       exists m1' (EFC1 : Events.external_call ef se lv m1 t v m1'),
-         mem_sub m' m1' /\ proj1_sig (inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC1) =
-         proj1_sig (inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC))
-     (Jframe: extspec_frame OK_spec)
-     (dryspec: ext_spec OK_ty)
-     (dessicate : forall (ef : external_function) jm,
-               ext_spec_type OK_spec ef ->
-               ext_spec_type dryspec ef)
-     (JDE: juicy_dry_ext_spec _ (@JE_spec OK_ty OK_spec) dryspec dessicate)
-     (DME: ext_spec_mem_evolve _ dryspec)
-     (Esub: forall v z m m', ext_spec_exit dryspec v z m -> mem_sub m m' -> ext_spec_exit dryspec v z m')
-     prog V G m,
-     @semax_prog Espec CS prog initial_oracle V G ->
+   forall Σ `{!VSTGpreS OK_ty Σ} {Espec : forall `{VSTGS OK_ty Σ}, ext_spec OK_ty} {dryspec : ext_spec OK_ty} (initial_oracle: OK_ty)
+     (EXIT: forall `{!VSTGS OK_ty Σ}, semax_prog.postcondition_allows_exit Espec tint)
+     (Hdry : forall `{!VSTGS OK_ty Σ}, ext_spec_entails Espec dryspec)
+     prog V (G : forall `{VSTGS OK_ty Σ}, funspecs) m,
+     (forall {HH : VSTGS OK_ty Σ}, exists CS: compspecs, semax_prog(OK_spec := Espec) prog initial_oracle V G) ->
      Genv.init_mem prog = Some m ->
      exists b, exists q,
        Genv.find_symbol (Genv.globalenv prog) (prog_main prog) = Some b /\
-       initial_core  (cl_core_sem (globalenv prog))
+       semantics.initial_core (cl_core_sem (globalenv prog))
            0 m q m (Vptr b Ptrofs.zero) nil /\
        forall n,
-        @dry_safeN _ _ _ OK_ty (semax.genv_symb_injective)
+        @dry_safeN _ _ _ OK_ty (genv_symb_injective)
             (cl_core_sem (globalenv prog))
             dryspec
             (Build_genv (Genv.globalenv prog) (prog_comp_env prog))
              n initial_oracle q m.
 Proof.
- intros.
- destruct (@semax_prog_rule Espec CS _ _ _ _
-     0 (*additional temporary argument - TODO (Santiago): FIXME*)
-     initial_oracle EXIT H H0) as [b [q [[H1 H2] H3]]].
- destruct (H3 O) as [jmx [H4x [H5x [H6x [H6'x [H7x _]]]]]].
- destruct (H2 jmx H4x) as [jmx' [H8x H8y]].
- exists b, q.
- split3; auto.
- rewrite H4x in H8y. auto.
- subst. simpl.
- clear H5x H6x H6'x H7x H8y.
- forget (m_dry jmx) as m. clear jmx.
- intro n.
- specialize (H3 n).
- destruct H3 as [jm [? [? [? [Hwsat [? _]]]]]].
- unfold semax.jsafeN in H6.
- subst m.
- destruct Hwsat as (z & Jz & Hdry & Hz).
- (* safety uses all the resources, including the ones we put inside
-    invariants (since there's no take-from-invariant step in Clight) *)
- rewrite Hdry.
- assert (joins (compcert_rmaps.RML.R.ghost_of (m_phi z))
-   (Some (ghost_PCM.ext_ref initial_oracle, compcert_rmaps.RML.R.NoneP) :: nil)) as J.
- { apply compcert_rmaps.RML.ghost_of_join in Jz.
-   unfold initial_world.wsat_rmap in Jz; rewrite ghost_of_make_rmap in Jz.
-   inv Jz.
-   { rewrite <- H7 in H5; discriminate. }
-   rewrite <- H3 in H5; inv H5; inv H10.
-   eexists; constructor; constructor.
-   instantiate (1 := (_, _)); split; simpl; [|hnf; eauto].
-   apply semax_prog.ext_ref_join. }
- assert (exists w, join (m_phi jm) w (m_phi z) /\
-   (invariants.wsat * invariants.ghost_set invariants.g_en Ensembles.Full_set)%pred w) as Hwsat.
- { do 2 eexists; eauto; apply initial_world.wsat_rmap_wsat. }
- assert (mem_sub (m_dry jm) (m_dry z)) as Hmem.
- { rewrite Hdry; repeat (split; auto). }
- clear - Jsub Jframe Esub JDE DME H4 J H6 Hwsat Hmem.
-  rewrite <- H4.
- assert (level jm <= n)%nat by lia.
- clear H4; rename H into H4.
- forget initial_oracle as ora.
- revert ora jm z q H4 J Hwsat Hmem H6; induction n; intros.
- assert (level jm = 0%nat) by lia. rewrite H; constructor.
- inv H6.
- - rewrite H; constructor.
- - (* in the juicy semantics, we took a step with jm *)
-   destruct H as (?&?&Hl&Hg).
-   (* so we can take the same step with the full memory z *)
-   destruct (CLC_evsem (globalenv prog)) eqn: Hevsem; inv Hevsem.
-   destruct (CLC_memsem (globalenv prog)) eqn: Hmemsem; inv Hmemsem.
-   simpl in ev_step_ax1, ev_step_ax2.
-   apply ev_step_ax2 in H as [T H].
-   pose proof (ev_step_elim _ _ _ _ _ H) as Helim.
-   eapply cl_evstep_extends in H as (m1' & H & Hmem'); eauto.
-   pose proof (ev_step_elim _ _ _ _ _ H) as Helim1; clear ev_step_elim.
-   apply ev_step_ax1 in H.
-   rewrite Hl; eapply safeN_step.
-   + red. red. fold (globalenv prog). eassumption.
-   + destruct Hwsat as (w & Jw & Hw).
-     (* the new full memory can be broken into the memory we got from the step,
-        and the memory we left in the invariant *)
-     assert (exists z', join (m_phi m') (age_to.age_to (level m') w) (m_phi z') /\ m_dry z' = m1') as (z' & J' & ?); subst.
-     { apply corestep_mem, mem_step_evolve in H.
-       destruct (juicy_mem_lemmas.rebuild_juicy_mem_rmap z m1') as (? & ? & Hr' & Hg').
-       eapply mem_evolve_cohere in H; [|eauto].
-       apply (age_to_cohere _ _ (level m')) in H as (A & B & C & D).
-       exists (mkJuicyMem _ _ A B C D); split; auto; simpl.
-       apply compcert_rmaps.RML.resource_at_join2; auto.
-       * apply join_level in Jw as []. rewrite !level_juice_level_phi in *. rewrite age_to.level_age_to; auto; lia.
-       * apply join_level in Jw as []. rewrite !level_juice_level_phi in *. rewrite !age_to.level_age_to; auto; lia.
-       * intros; rewrite !age_to_resource_at.age_to_resource_at, Hr'.
-         eapply join_ev_elim_commut; eauto.
-       * rewrite !age_to_resource_at.age_to_ghost_of, Hg, Hg'.
-         rewrite <- level_juice_level_phi; apply compcert_rmaps.RML.ghost_fmap_join, compcert_rmaps.RML.ghost_of_join; auto. }
-     assert ((invariants.wsat * invariants.ghost_set invariants.g_en Ensembles.Full_set)%pred
-       (age_to.age_to (level m') w)).
-     { eapply pred_nec_hereditary, Hw; apply age_to.age_to_necR. }
-     assert (joins (compcert_rmaps.RML.R.ghost_of (m_phi z'))
-       (compcert_rmaps.RML.R.ghost_fmap
-         (compcert_rmaps.RML.R.approx (level z'))
-         (compcert_rmaps.RML.R.approx (level z'))
-        (Some (ghost_PCM.ext_ref ora, compcert_rmaps.RML.R.NoneP) :: nil))).
-     { assert (join (ghost_of (m_phi m')) (ghost_of (age_to.age_to (level m') w))
-         (ghost_of (age_to.age_to (level m') (m_phi z)))) as J1.
-       { rewrite Hg, !age_to_resource_at.age_to_ghost_of.
-         apply compcert_rmaps.RML.ghost_fmap_join, compcert_rmaps.RML.ghost_of_join; auto. }
-       eapply join_eq in J1; [|apply compcert_rmaps.RML.ghost_of_join; eauto].
-       rewrite J1. rewrite age_to_resource_at.age_to_ghost_of.
-       destruct J as [? J]; eapply compcert_rmaps.RML.ghost_fmap_join in J; simpl in *; eexists; apply J. }
-     edestruct H0 as (? & ? & Hz' & Hsafe); eauto.
-     { apply join_sub_refl. }
-     assert (level x = level m') as Hl'.
-     { destruct Hz' as (? & ? & ?); apply join_level in J' as [];
-         rewrite <- !level_juice_level_phi in *; lia. }
-     destruct Hsafe as [Hsafe | (m2 & ? & ? & ? & ? & Hsafe)].
-     { rewrite <- Hl', Hsafe; constructor. }
-     (* after accessing invariants, we have a new sub-memory m2, which
-        completes to the same full memory *)
-     assert (level m' = level m2) as Hl2 by (apply join_level in H6 as []; rewrite <- !level_juice_level_phi in *; lia).
-     rewrite Hl2.
-     destruct Hz' as [<- ?].
-     apply IHn; eauto. lia.
- -
-   unfold extspec_frame in Jframe.
-   destruct dryspec as [ty pre post exit].
-   destruct JE_spec as [ty' pre' post' exit'].
-   change (level (m_phi jm)) with (level jm) in *.
-   destruct JDE as [JDE1 [JDE2 JDE3]].
-   destruct (level jm) eqn: Hl; [constructor|].
-   destruct Hwsat as (w & Jw & Hw).
-   edestruct Jframe as (x' & H0' & Hpost); eauto.
-   eapply safeN_external.
-   { eassumption. }
-   { eapply JDE1; eauto. }
-   simpl. intros.
-   assert (level jm = level z) as Hlz.
-   { apply join_level in Jw as []; rewrite <- !level_juice_level_phi in *; lia. }
-   (* We need to reconstruct the full jm, then find a sub-memory s.t.
-      join sub w jm'. *)
-   assert (H20: exists jm', m_dry jm' = m'
-                    /\ (level jm' = n')%nat
-                    /\ juicy_safety.pures_eq (m_phi z) (m_phi jm')
-                    /\ resource_at (m_phi jm') = resource_fmap (approx (level jm')) (approx (level jm')) oo juicy_mem_lemmas.rebuild_juicy_mem_fmap z (m_dry jm')
-                    /\ compcert_rmaps.RML.R.ghost_of (m_phi jm') = Some (ghost_PCM.ext_ghost z', compcert_rmaps.RML.R.NoneP) :: ghost_fmap (approx (level jm')) (approx (level jm')) (tl (ghost_of (m_phi z)))). {
-     destruct (juicy_mem_lemmas.rebuild_juicy_mem_rmap z m')
-          as [phi [? [? ?]]].
-     assert (own.ghost_approx phi (Some (ghost_PCM.ext_ghost z', NoneP) :: tl (compcert_rmaps.RML.R.ghost_of phi)) =
-        Some (ghost_PCM.ext_ghost z', NoneP) :: tl (compcert_rmaps.RML.R.ghost_of phi)) as Happrox.
-     { simpl; f_equal.
-        rewrite <- compcert_rmaps.RML.ghost_of_approx at 2.
-        destruct (compcert_rmaps.RML.R.ghost_of phi); auto. }
-     set (phi1 := initial_world.set_ghost _ _ Happrox).
-     assert (level phi1 = level phi /\ resource_at phi1 = resource_at phi) as [Hl1 Hr1].
-     { subst phi1; unfold initial_world.set_ghost; rewrite level_make_rmap, resource_at_make_rmap; auto. }
-     pose (phi' := age_to.age_to n' phi1).
-     assert (mem_rmap_cohere m' phi') as H10. {
-       clear - H0' Hr1 Hl1 H8 H7 H5 H2 Hmem DME JDE1.
-       eapply JDE1 in H0'; eauto.
-       specialize (DME e _ _ _ _ _ _ _ _ _ _ H0' H5).
-       subst phi'.
-       apply age_to_cohere.
-       subst phi1.
-       apply set_ghost_cohere.
-       eapply mem_evolve_cohere; eauto.
-     }
-     destruct H10 as [H10 [H11 [H12 H13]]].
-     pose (jm' := mkJuicyMem _ _ H10 H11 H12 H13).
-     exists jm'.
-     assert (n' <= level phi1)%nat by lia.
-     split; [ | split3].
-     * subst jm'; simpl; auto.
-     * subst jm' phi'; simpl. apply age_to.level_age_to; auto.
-     * unfold juicy_safety.pures_eq, juicy_safety.pures_sub. subst jm' phi'; simpl.
-       split; intros; rewrite age_to_resource_at.age_to_resource_at, Hr1, H7;
-         unfold juicy_mem_lemmas.rebuild_juicy_mem_fmap; destruct (m_phi z @ _); simpl; eauto;
-         try solve [try (destruct k; auto); if_tac; auto].
-       rewrite age_to.level_age_to; auto.
-     * subst jm' phi'; simpl. split.
-       { extensionality. rewrite age_to_resource_at.age_to_resource_at, Hr1, H7.
-         rewrite age_to.level_age_to; auto. }
-       rewrite age_to_resource_at.age_to_ghost_of, age_to.level_age_to; auto.
-       subst phi1.
-       unfold initial_world.set_ghost; rewrite ghost_of_make_rmap, H8; auto.
-   }
-   destruct H20 as [jm' [H26 [H27 [H28 [H29 Hg']]]]].
-   subst m'; eapply JDE2 in H5; eauto 7; [|lia].
-   apply Hpost in H5 as (jm1 & ? & ? & Jw').
-   specialize (H1 ret jm1 z' Hargsty Hretty).
-   assert (level jm1 = level jm') as Hl1 by (apply join_level in Jw' as []; rewrite <- !level_juice_level_phi in *; lia).
-   spec H1.
-   { split; [lia|].
-     eapply juicy_safety.pures_eq_trans, juicy_safety.pures_eq_trans; [| apply join_sub_pures_eq; eexists; eauto | | eauto |];
-       rewrite <- ?level_juice_level_phi; try lia.
-     apply pures_eq_sym, join_sub_pures_eq; [|eexists; eauto].
-     rewrite <- !level_juice_level_phi; auto. }
-   spec H1. assumption.
-   destruct H1 as [c' [H2a H2b]]; exists c'; split; auto.
-   (* eliminate fupd *)
-   assert (app_pred (invariants.wsat * invariants.ghost_set invariants.g_en Ensembles.Full_set)%pred
-         (age_to.age_to (level jm1) w)).
-   { eapply pred_nec_hereditary, Hw; apply age_to.age_to_necR. }
-   edestruct H2b as (x1 & ? & Hz' & Hsafe); eauto.
-   { apply join_sub_refl. }
-   { rewrite Hg'; eexists; do 2 constructor; simpl.
-     instantiate (1 := (_, _)); split; simpl; [apply semax_prog.ext_ref_join | repeat constructor]. }
-   assert (level x1 = level jm') as Hl'.
-   { destruct Hz' as (? & ? & ?); lia. }
-   subst n'; destruct Hsafe as [Hsafe | (m2 & ? & ? & ? & ? & Hsafe)].
-   { rewrite <- Hl', Hsafe; constructor. }
-   assert (level jm' = level m2) as Hl2 by (apply join_level in H8 as []; rewrite <- !level_juice_level_phi in *; lia).
-   rewrite Hl2.
-   destruct Hz' as [<- ?].
-   apply IHn; eauto. lia.
- - eapply safeN_halted; eauto.
-   eapply Esub; eauto.
-   apply JDE; auto.
+  intros.
+  assert (forall n, exists b, exists q,
+       Genv.find_symbol (Genv.globalenv prog) (prog_main prog) = Some b /\
+       semantics.initial_core (cl_core_sem (globalenv prog))
+           0 m q m (Vptr b Ptrofs.zero) nil /\
+        @dry_safeN _ _ _ OK_ty (genv_symb_injective)
+            (cl_core_sem (globalenv prog))
+            dryspec
+            (Build_genv (Genv.globalenv prog) (prog_comp_env prog))
+             n initial_oracle q m).
+  2: { destruct (H1 O) as (b0 & q0 & ? & (? & _) & _); eexists _, _; split; first done; split; first done.
+       intros n; destruct (H1 n) as (b & q & ? & (? & _) & Hsafe).
+       assert (b0 = b) as -> by congruence.
+       assert (q0 = q) as -> by congruence.
+       done. }
+  intros n; eapply ouPred.pure_soundness, (step_fupdN_soundness_no_lc' _ (S n) O); [apply _..|].
+  simpl; intros; iIntros "_".
+  iMod (@init_VST _ _ VSTGpreS0) as "H".
+  iDestruct ("H" $! Hinv) as (?? HE) "(H & ?)".
+  set (HH := Build_VSTGS _ _ (HeapGS _ _ _ _) HE).
+  specialize (H HH); specialize (EXIT HH); destruct H.
+  eapply (semax_prog_rule _ _ _ _ n) in H as (b & q & (? & ? & Hinit & ->) & Hsafe); [|done..].
+  iMod (Hsafe with "H") as "Hsafe".
+  rewrite bi.and_elim_l.
+  iPoseProof (adequacy with "Hsafe") as "Hsafe".
+  iApply step_fupd_intro; first done; iNext.
+  iApply (step_fupdN_mono with "Hsafe"); apply bi.pure_mono; intros.
+  eapply ext_spec_entails_safe in H; eauto 6.
 Qed.
 
 Definition fun_id (ext_link: Strings.String.string -> ident) (ef: external_function) : option ident :=
diff --git a/veric/SequentialClight2.v b/veric/SequentialClight2.v
deleted file mode 100644
index 39378bd6dd..0000000000
--- a/veric/SequentialClight2.v
+++ /dev/null
@@ -1,1043 +0,0 @@
-Require Import VST.sepcomp.semantics.
-
-Require Import VST.veric.Clight_base.
-Require Import VST.veric.Clight_core.
-Require Import VST.veric.Clight_lemmas.
-Require Import VST.sepcomp.step_lemmas.
-Require Import VST.sepcomp.event_semantics.
-Require Import VST.veric.Clight_evsem.
-Require Import VST.veric.SeparationLogic.
-Require Import VST.veric.juicy_extspec.
-Require Import VST.veric.juicy_mem.
-(*Require VST.veric.NullExtension. *)
-Require Import VST.veric.SeparationLogicSoundness.
-Require Import VST.sepcomp.extspec.
-Require Import VST.msl.msl_standard.
-
-Import VericSound.
-Import VericMinimumSeparationLogic.
-Import VericMinimumSeparationLogic.CSHL_Def.
-Import VericMinimumSeparationLogic.CSHL_Defs.
-
-Definition ignores_juice Z (J: external_specification juicy_mem external_function Z) : Prop :=
-  (forall e t b tl vl x jm jm',
-     m_dry jm = m_dry jm' ->
-    ext_spec_pre J e t b tl vl x jm ->
-    ext_spec_pre J e t b tl vl x jm') /\
- (forall ef t b ot v x jm jm',
-     m_dry jm = m_dry jm' ->
-    ext_spec_post J ef t b ot v x jm ->
-    ext_spec_post J ef t b ot v x jm') /\
- (forall v x jm jm',
-     m_dry jm = m_dry jm' ->
-     ext_spec_exit J v x jm ->
-     ext_spec_exit J v x jm').
-
-Import VST.veric.compcert_rmaps.R.
-
-Definition mem_evolve (m m': mem) : Prop :=
-   (* dry version of resource_decay *)
- forall loc,
- match access_at m loc Cur, access_at m' loc Cur with
- | None, None => True
- | None, Some Freeable => True
- | Some Freeable, None => True
- | Some Writable, Some p' => p' = Writable
- | Some p, Some p' => p=p' /\ access_at m loc Max = access_at m' loc Max
- | _, _ => False
- end.
-
-#[export] Instance mem_evolve_refl : RelationClasses.Reflexive mem_evolve.
-Proof.
-  repeat intro.
-  destruct (access_at x loc Cur); auto.
-  destruct p; auto.
-Qed.
-
-Lemma access_Freeable_max : forall m l, access_at m l Cur = Some Freeable -> access_at m l Max = Some Freeable.
-Proof.
-  intros.
-  pose proof (access_cur_max m l) as Hperm; rewrite H in Hperm; simpl in Hperm.
-  destruct (access_at m l Max); try contradiction.
-  inv Hperm; auto.
-Qed.
-
-#[export] Instance mem_evolve_trans : RelationClasses.Transitive mem_evolve.
-Proof.
-  repeat intro.
-  specialize (H loc); specialize (H0 loc).
-  destruct (access_at x loc Cur) eqn: Hx; [destruct p|]; destruct (access_at y loc Cur) eqn: Hy; subst; auto; try contradiction.
-  - destruct H; subst.
-    destruct (access_at z loc Cur); congruence.
-  - destruct (access_at z loc Cur) eqn: Hz; auto.
-    destruct p; try contradiction.
-    apply access_Freeable_max in Hx; apply access_Freeable_max in Hz.
-    rewrite Hx, Hz; auto.
-  - destruct H; subst.
-    destruct (access_at z loc Cur); congruence.
-  - destruct H; subst.
-    destruct (access_at z loc Cur); congruence.
-  - destruct p; try contradiction.
-    destruct (access_at z loc Cur); auto.
-    destruct H0; subst; auto.
-Qed.
-
-Definition ext_spec_mem_evolve (Z: Type)
-  (D: external_specification mem external_function Z) :=
- forall ef w b tl vl ot v z m z' m',
-    ext_spec_pre D ef w b tl vl z m ->
-    ext_spec_post D ef w b ot v z' m' ->
-    mem_evolve m m'.
-
-Definition juicy_dry_ext_spec (Z: Type)
-   (J: external_specification juicy_mem external_function Z)
-   (D: external_specification mem external_function Z)
-   (dessicate: forall ef jm, ext_spec_type J ef -> ext_spec_type D ef) :=
-  (forall e t t' b tl vl x jm,
-    dessicate e jm t = t' ->
-    (ext_spec_pre J e t b tl vl x jm ->
-    ext_spec_pre D e t' b tl vl x (m_dry jm))) /\
- (forall ef t t' b ot v x jm0 jm,
-    (exists tl vl x0, dessicate ef jm0 t = t' /\ ext_spec_pre J ef t b tl vl x0 jm0) ->
-(*    Hrel n jm0 jm ->*)
-    resource_at (m_phi jm) = resource_fmap (approx (level jm)) (approx (level jm)) oo juicy_mem_lemmas.rebuild_juicy_mem_fmap jm0 (m_dry jm) ->
-    (ext_spec_post D ef t' b ot v x (m_dry jm) ->
-     ext_spec_post J ef t b ot v x jm)) /\
- (forall v x jm,
-     ext_spec_exit J v x jm <->
-     ext_spec_exit D v x (m_dry jm)).
-
-Definition juicy_dry_ext_spec_make (Z: Type)
-   (J: external_specification juicy_mem external_function Z) :
-   external_specification mem external_function Z.
-destruct J.
-apply Build_external_specification with ext_spec_type.
-intros e t b tl vl x m.
-apply (forall jm, m_dry jm = m -> (* external ghost matches x -> *) ext_spec_pre e t b tl vl x jm).
-intros e t b ot v x m.
-apply (forall jm, m_dry jm = m -> ext_spec_post e t b ot v x jm).
-intros v x m.
-apply (forall jm, m_dry jm = m -> ext_spec_exit v x jm).
-Defined.
-
-
-Definition dessicate_id Z
-   (J: external_specification juicy_mem external_function Z) :
-   forall ef (jm : juicy_mem), ext_spec_type J ef ->
-       ext_spec_type (juicy_dry_ext_spec_make Z J) ef.
-intros.
-destruct J; simpl in *. apply X.
-Defined.
-
-(*Lemma jdes_make_lemma:
-  forall Z J, ignores_juice Z J ->
-    juicy_dry_ext_spec Z J (juicy_dry_ext_spec_make Z J)
-     (dessicate_id Z J) ().
-Proof.
-intros.
-destruct H as [? [? ?]], J; split; [ | split3]; simpl in *; intros; auto.
--
-subst t'.
-eapply H. symmetry; eassumption.  auto.
--
-destruct H2 as (? & ? & ? & ? & ?).
-subst t'.
-eapply H0; auto.
--
-eapply H1. symmetry; eassumption. auto.
-Qed.*)
-
-Definition mem_rmap_cohere m phi :=
-  contents_cohere m phi /\
-  access_cohere m phi /\
-  max_access_cohere m phi /\ alloc_cohere m phi.
-
-Lemma age_to_cohere:
- forall m phi n,
-    mem_rmap_cohere m phi -> mem_rmap_cohere m (age_to.age_to n phi).
-Proof.
-intros.
-destruct H as [? [? [? ?]]].
-split; [ | split3]; hnf; intros.
--
-hnf in H.
-rewrite age_to_resource_at.age_to_resource_at in H3.
-destruct (phi @ loc) eqn:?H; inv H3.
-destruct (H _ _ _ _ _ H4); split; subst; auto.
--
-rewrite age_to_resource_at.age_to_resource_at .
-specialize (H0 loc).
-rewrite H0.
-destruct (phi @ loc); simpl; auto.
--
-rewrite age_to_resource_at.age_to_resource_at .
-specialize (H1 loc).
-destruct (phi @ loc); simpl; auto.
--
-rewrite age_to_resource_at.age_to_resource_at .
-specialize (H2 loc H3).
-rewrite H2.
-reflexivity.
-Qed.
-
-Lemma set_ghost_cohere:
- forall m phi g H,
-    mem_rmap_cohere m phi ->
-   mem_rmap_cohere m (initial_world.set_ghost phi g H).
-Proof.
-intros.
-unfold initial_world.set_ghost.
-rename H into Hg. rename H0 into H.
-destruct H as [? [? [? ?]]].
-split; [ | split3]; hnf; intros.
--
-hnf in H.
-rewrite resource_at_make_rmap in H3.
-destruct (phi @ loc) eqn:?H; inv H3.
-destruct (H _ _ _ _ _ H4); split; subst; auto.
--
-rewrite resource_at_make_rmap.
-specialize (H0 loc).
-rewrite H0.
-destruct (phi @ loc); simpl; auto.
--
-rewrite resource_at_make_rmap.
-specialize (H1 loc).
-destruct (phi @ loc); simpl; auto.
--
-rewrite resource_at_make_rmap.
-specialize (H2 loc H3).
-rewrite H2.
-reflexivity.
-Qed.
-
-Lemma mem_evolve_cohere:
-  forall jm m' phi',
-   mem_evolve (m_dry jm) m' ->
-   compcert_rmaps.RML.R.resource_at phi' =
-     juicy_mem_lemmas.rebuild_juicy_mem_fmap jm m' ->
-   mem_rmap_cohere m' phi'.
-Proof.
-intros.
-destruct jm.
-simpl in *.
-unfold  juicy_mem_lemmas.rebuild_juicy_mem_fmap in H0.
-simpl in H0.
-split; [ | split3].
--
-hnf; intros; specialize (H loc).
-rewrite (JMaccess loc) in *.
-rewrite H0 in *; clear H0; simpl in *.
-destruct (phi @ loc) eqn:?H.
-simpl in H. if_tac in H.
-if_tac in H1.
-inv H1; auto.
-inv H1.
-if_tac in H1.
-inv H1; auto.
-inv H1.
-destruct k; simpl in *.
-destruct (perm_of_sh sh0) as [[ | | | ] | ] eqn:?H; try contradiction ;auto.
-destruct (access_at m' loc Cur) as [[ | | | ] | ]  eqn:?H; try contradiction; try discriminate; auto.
-if_tac in H1; inv H1; auto.
-if_tac in H1; inv H1; auto.
-if_tac in H1; inv H1; auto.
-if_tac in H1; inv H1; auto.
-if_tac in H1; inv H1; auto.
-if_tac in H1; inv H1; auto.
-if_tac in H1; inv H1; auto.
-inv H1; auto.
-inv H1; auto.
-inv H1; auto.
--
-hnf; intros; specialize (H loc).
-rewrite H0; clear H0.
-rewrite (JMaccess loc) in *.
-destruct (phi @ loc) eqn:?H.
-simpl in H. if_tac in H.
-destruct (access_at m' loc Cur) as [[ | | | ] | ] eqn:?H; try contradiction; try discriminate; simpl; auto.
-unfold perm_of_sh. rewrite if_true by auto. rewrite if_true by auto. auto.
-subst. rewrite if_true by auto; auto.
-destruct (access_at m' loc Cur) as [[ | | | ] | ] eqn:?H; try contradiction; try discriminate; simpl; auto.
-destruct H; discriminate.
-destruct H; discriminate.
-destruct H; discriminate.
-rewrite if_false by auto; auto.
-destruct k; simpl in *; auto.
-destruct (perm_of_sh sh) as [[ | | | ] | ] eqn:?H; try contradiction ;auto.
-destruct (access_at m' loc Cur) as [[ | | | ] | ]  eqn:?H; try solve [contradiction]; try discriminate; auto.
-destruct H; discriminate.
-destruct H; discriminate.
-destruct H; discriminate.
-simpl. rewrite if_true; auto.
-destruct (access_at m' loc Cur) as [[ | | | ] | ]  eqn:?H; try solve [contradiction]; try discriminate; auto.
-destruct (access_at m' loc Cur) as [[ | | | ] | ]  eqn:?H; try solve [contradiction]; try discriminate; auto.
-destruct (access_at m' loc Cur) as [[ | | | ] | ]  eqn:?H; try solve [contradiction]; try discriminate; auto.
-destruct H; discriminate.
-destruct H; discriminate.
-destruct H; discriminate.
-exfalso; clear - r H1.
-unfold perm_of_sh in H1. if_tac in H1. if_tac in H1; inv H1.
-rewrite if_true in H1 by auto. inv H1.
-destruct (access_at m' loc Cur) as [[ | | | ] | ]  eqn:?H; try solve [contradiction]; try discriminate; auto.
-unfold perm_of_sh in H1. if_tac in H1. if_tac in H1; inv H1.
-rewrite if_true in H1 by auto. inv H1.
-unfold perm_of_sh in H1. if_tac in H1. if_tac in H1; inv H1.
-rewrite if_true in H1 by auto.
-inv H1.
-destruct (access_at m' loc Cur) as [[ | | | ] | ]  eqn:?H; try solve [contradiction]; try discriminate; auto.
-destruct H; discriminate.
-destruct H; discriminate.
-destruct H; discriminate.
-destruct (access_at m' loc Cur) as [[ | | | ] | ]  eqn:?H; try solve [contradiction]; try discriminate; auto.
-destruct H; discriminate.
-destruct H; discriminate.
-destruct H; discriminate.
-destruct (access_at m' loc Cur) as [[ | | | ] | ]  eqn:?H; try solve [contradiction]; try discriminate; auto.
-simpl in H; destruct H; discriminate.
-simpl in H; destruct H; discriminate.
-simpl in H; destruct H; discriminate.
--
-hnf; intros; specialize (H loc).
-rewrite H0; clear H0.
-rewrite (JMaccess loc) in *.
-destruct (phi @ loc) eqn:?H.
-simpl in H. if_tac in H.
-destruct (access_at m' loc Cur) as [[ | | | ] | ] eqn:?H; try contradiction; try discriminate; simpl; auto.
-eapply perm_order''_trans; [apply access_cur_max | ].
-rewrite H2.
-unfold perm_of_sh. rewrite if_true by auto. rewrite if_true by auto. constructor.
-subst sh. rewrite if_true by auto.
-apply po_None.
-destruct (access_at m' loc Cur) as [[ | | | ] | ] eqn:?H; try contradiction; try discriminate; simpl; auto.
-destruct H; discriminate.
-destruct H; discriminate.
-destruct H; discriminate.
-rewrite if_false by auto.
-eapply perm_order''_trans; [apply access_cur_max | ].
-rewrite H2. constructor.
-destruct k; simpl in *; auto.
-destruct (perm_of_sh sh) as [[ | | | ] | ] eqn:?H; try contradiction ;auto.
-eapply perm_order''_trans; [apply access_cur_max | ].
-destruct (access_at m' loc Cur). destruct H; subst.
-match goal with |- Mem.perm_order'' _ ?A =>
-  destruct A; try constructor
-end.
-simpl.
-rewrite if_true by auto. auto.
-eapply perm_order''_trans; [apply access_cur_max | ].
-destruct (access_at m' loc Cur). destruct H; subst.
-rewrite if_true. simpl. rewrite H1. apply perm_refl.
-clear - r H1.
-unfold perm_of_sh in H1.
-if_tac in H1. if_tac in H1. inv H1; constructor.
-inv H1; constructor.
-rewrite if_true in H1 by auto. inv H1; constructor.
-contradiction.
-eapply perm_order''_trans; [apply access_cur_max | ].
-destruct (access_at m' loc Cur). destruct H; subst.
-rewrite if_true. simpl. rewrite H1. apply perm_refl.
-clear - r H1.
-unfold perm_of_sh in H1.
-if_tac in H1. if_tac in H1. inv H1; constructor.
-inv H1; constructor.
-rewrite if_true in H1 by auto. inv H1; constructor.
-contradiction.
-eapply perm_order''_trans; [apply access_cur_max | ].
-destruct (access_at m' loc Cur). destruct H; subst.
-rewrite if_true. simpl. rewrite H1. apply perm_refl.
-clear - r H1.
-unfold perm_of_sh in H1.
-if_tac in H1. if_tac in H1. inv H1; constructor.
-inv H1; constructor.
-rewrite if_true in H1 by auto. inv H1; constructor.
-contradiction.
-eapply perm_order''_trans; [apply access_cur_max | ].
-destruct (access_at m' loc Cur). destruct p0; try contradiction.
-match goal with |- Mem.perm_order'' _ ?A =>
-  destruct A; try constructor
-end.
-exfalso.
-clear - H1 r.
-unfold perm_of_sh in H1.
-if_tac in H1. if_tac in H1. inv H1; constructor.
-inv H1; constructor.
-rewrite if_true in H1 by auto. inv H1; constructor.
-destruct (access_at m' loc Cur); try contradiction.
-destruct H; subst p0.
-specialize (JMmax_access loc).
-rewrite H0 in JMmax_access.
-simpl in JMmax_access.
-unfold max_access_at in *.
-rewrite <- H1. auto.
-destruct (access_at m' loc Cur); try contradiction.
-destruct H; subst p0.
-specialize (JMmax_access loc).
-rewrite H0 in JMmax_access.
-simpl in JMmax_access.
-unfold max_access_at in *.
-rewrite <- H1. auto.
-simpl in H.
-destruct (access_at m' loc Cur); try contradiction.
-destruct H; subst.
-simpl.
-specialize (JMmax_access loc).
-rewrite H0 in JMmax_access.
-simpl in JMmax_access.
-unfold max_access_at in *.
-rewrite <- H1. auto.
--
-hnf; intros; specialize (H loc).
-rewrite H0; clear H0.
-specialize (JMalloc loc).
-rewrite (JMaccess loc) in *.
-destruct (phi @ loc) eqn:?H.
-simpl in H. if_tac in H.
-destruct loc as [b z].
-rewrite nextblock_access_empty in *by auto.
-subst.
-simpl.
-f_equal. apply proof_irr.
-destruct loc as [b z].
-rewrite nextblock_access_empty in * by auto.
-contradiction.
-destruct loc as [b z].
-rewrite nextblock_access_empty in * by auto.
-simpl.
-destruct k; auto; try contradiction H.
-simpl in H.
-destruct loc as [b z].
-rewrite nextblock_access_empty in * by auto.
-contradiction.
-Qed.
-
-Lemma mem_step_evolve : forall m m', mem_step m m' -> mem_evolve m m'.
-Proof.
-  induction 1; intros loc.
-  - rewrite <- (storebytes_access _ _ _ _ _ H); destruct (access_at m loc Cur); auto.
-    destruct p; auto.
-  - destruct (adr_range_dec (b', lo) (hi - lo) loc).
-    + destruct (alloc_dry_updated_on _ _ _ _ _ loc H) as [->]; auto.
-      pose proof (Mem.alloc_result _ _ _ _ _ H); subst.
-      destruct loc, a; subst.
-      rewrite nextblock_access_empty; auto; lia.
-    + eapply alloc_dry_unchanged_on in n as [Heq _]; eauto.
-      rewrite <- Heq.
-      destruct (access_at m loc Cur); auto.
-      destruct p; auto.
-  - generalize dependent m; induction l; simpl; intros.
-    + inv H; destruct (access_at m' loc Cur); auto.
-      destruct p; auto.
-    + destruct a as ((b, lo), hi).
-      destruct (Mem.free m b lo hi) eqn: Hfree; inv H.
-      apply IHl in H1.
-      destruct (adr_range_dec (b, lo) (hi - lo) loc).
-      * destruct loc, a; subst.
-        eapply free_access in Hfree as [Hfree H2]; [rewrite Hfree | lia].
-        pose proof (access_cur_max m0 (b0, z)) as Hperm; rewrite H2 in Hperm; simpl in Hperm.
-        destruct (access_at m0 (b0, z) Cur); try contradiction.
-        destruct (access_at m' (b0, z) Cur) eqn: Hm'; auto.
-        destruct p; try contradiction.
-        apply access_Freeable_max in Hfree; apply access_Freeable_max in Hm'; rewrite Hfree, Hm'; auto.
-      * destruct loc; eapply free_nadr_range_eq in n as [->]; eauto.
-  - eapply mem_evolve_trans; eauto.
-Qed.
-
-Fixpoint in_alloc_trace b ofs T :=
-  match T with
-  | nil => false
-  | Alloc b' lo hi :: rest => adr_range_dec (b', lo) (hi - lo) (b, ofs) || in_alloc_trace b ofs rest
-  | _ :: rest => in_alloc_trace b ofs rest
-  end.
-
-Lemma ev_elim_perm_inv : forall l k T m m', ev_elim m T m' ->
-  (in_free_list_trace (fst l) (snd l) T /\ access_at m' l k = None) \/
-  ~in_free_list_trace (fst l) (snd l) T /\ ((in_alloc_trace (fst l) (snd l) T = true /\
-   (fst l >= Mem.nextblock m)%positive /\ access_at m' l k = Some Freeable) \/
-  (in_alloc_trace (fst l) (snd l) T = false /\
-   access_at m' l k = access_at m l k)).
-Proof.
-  induction T; simpl; intros; subst; auto.
-  destruct a.
-  - destruct H as (? & ? & ?%IHT).
-    rewrite (storebytes_access _ _ _ _ _ H), <- (Mem.nextblock_storebytes _ _ _ _ _ H); auto.
-  - destruct H as (? & ?%IHT); auto.
-  - destruct H as (? & ? & Hrest%IHT).
-    destruct Hrest as [? | [? Hrest]]; auto.
-    right; split; auto.
-    destruct (adr_range_dec _ _ _); simpl.
-    + left; split; auto.
-      destruct a; subst.
-      split; [apply Mem.alloc_result in H; lia|].
-      destruct Hrest as [(? & ? & ?) | (? & ->)]; auto.
-      destruct l; simpl in *; eapply alloc_access_same; eauto; lia.
-    + destruct Hrest as [(? & Hge & ?) | (? & ?)]; [left | right]; split; auto.
-      * split; auto.
-        erewrite Mem.nextblock_alloc in Hge by eauto; lia.
-      * destruct l; simpl in *; rewrite (alloc_access_other _ _ _ _ _ H); auto; lia.
-  - destruct H as (? & ? & Hrest%IHT).
-    destruct Hrest as [[] | [? Hrest]]; auto.
-    destruct (in_free_list_dec (fst l) (snd l) l0).
-    + left; split; auto.
-      edestruct freelist_access_2'; eauto.
-      destruct Hrest as [(? & ? & ?) | [_ ->]].
-      * unfold Mem.valid_block, Plt in *; lia.
-      * unfold access_at; auto.
-    + right; split; [tauto|].
-      destruct Hrest as [(? & Hge & ?) | (? & ?)]; [left | right]; split; auto.
-      * split; auto.
-        erewrite mem_lemmas.nextblock_freelist in Hge by eauto; lia.
-      * unfold access_at at 2; rewrite <- (freelist_access_1 _ _ _ _ n _ _ H); auto.
-Qed.
-
-Lemma ev_elim_alloc : forall l k T m m', ev_elim m T m' ->
-  in_alloc_trace (fst l) (snd l) T = true -> ~ in_free_list_trace (fst l) (snd l) T ->
-  access_at m' l k = Some Freeable.
-Proof.
-  induction T; [discriminate|]; simpl; intros.
-  destruct a.
-  - destruct H as (? & ? & ?%IHT); auto.
-  - destruct H as (? & ?%IHT); auto.
-  - destruct H as (? & ? & Helim).
-    unfold proj_sumbool in *.
-    apply orb_true_iff in H0 as [Hin | ?]; eauto.
-    if_tac in Hin; inv Hin.
-    destruct H0; subst.
-    eapply ev_elim_perm_inv in Helim as [[] | [_ Hcase]]; [contradiction H1; eauto|].
-    destruct Hcase as [(? & ? & ?) | (? & ->)]; eauto.
-    destruct l; simpl in *; eapply alloc_access_same; eauto; lia.
-  - destruct H as (? & ? & ?%IHT); auto.
-Qed.
-
-Lemma ev_elim_alloc_new : forall b lo sz T m m', ev_elim m T m' ->
-  In (Alloc b lo sz) T -> (b >= Mem.nextblock m)%positive.
-Proof.
-  induction T; simpl; [contradiction|]; intros.
-  destruct H0.
-  - subst.
-    destruct H as (? & ? & ?).
-    apply Mem.alloc_result in H; subst; lia.
-  - destruct a; (destruct H as (? & ? & Helim) || destruct H as (? & Helim)); eapply IHT in Helim; eauto.
-    + erewrite <- Mem.nextblock_storebytes; eauto.
-    + erewrite Mem.nextblock_alloc in Helim; eauto; lia.
-    + erewrite <- mem_lemmas.nextblock_freelist; eauto.
-Qed.
-
-Fixpoint in_write_trace b ofs T :=
-  match T with
-  | nil => false
-  | Write b' z lv :: rest => adr_range_dec (b', z) (Zlength lv) (b, ofs) || in_write_trace b ofs rest
-  | _ :: rest => in_write_trace b ofs rest
-  end.
-
-Lemma perm_order_total : forall p1 p2, ~perm_order p1 p2 -> perm_order p2 p1.
-Proof.
-  destruct p1, p2; try constructor; intros H; contradiction H; constructor.
-Qed.
-
-Lemma pmax_l : forall p1 p2 q : option permission,
-  Mem.perm_order'' (pmax p1 p2) q <-> Mem.perm_order'' p1 q \/ Mem.perm_order'' p2 q.
-Proof.
-  intros; unfold pmax.
-  destruct p1, p2; simpl in *; try solve [destruct q; tauto].
-  if_tac; [|apply perm_order_total in H]; destruct q; simpl; split; auto; intros [? | ?]; auto; eapply perm_order_trans; eauto.
-Qed.
-
-Lemma in_write_trace_perm : forall b ofs T, in_write_trace b ofs T = true ->
-  (exists z sz, In (Alloc b z sz) T) \/ Mem.perm_order' (cur_perm (b, ofs) T) Writable.
-Proof.
-  induction T; simpl; [discriminate|]; intros.
-  rewrite mem_lemmas.po_oo in *.
-  destruct a.
-  - rewrite pmax_l; destruct (adr_range_dec _ _ _); simpl in *; [|apply IHT in H as [(? & ? & ?) | ?]; eauto].
-    destruct a; subst.
-    right; left; setoid_rewrite if_true; auto; [|lia]; simpl.
-    destruct (zle _ _); try lia; constructor.
-  - rewrite pmax_l; apply IHT in H as [(? & ? & ?) | ?]; eauto.
-  - if_tac; [|apply IHT in H as [(? & ? & ?) | ?]; eauto].
-    subst; eauto.
-  - apply IHT in H as [(? & ? & ?) | ?]; eauto.
-    right.
-    induction l; auto; simpl.
-    destruct a as ((?, ?), ?); simple_if_tac; auto; constructor.
-Qed.
-
-Lemma free_contents : forall m b lo hi m', Mem.free m b lo hi = Some m' ->
-  contents_at m' = contents_at m.
-Proof.
-  intros; apply Mem.free_result in H; subst; auto.
-Qed.
-
-Lemma free_list_contents : forall l m m', Mem.free_list m l = Some m' ->
-  contents_at m' = contents_at m.
-Proof.
-  induction l; simpl; intros.
-  { inv H; auto. }
-  destruct a as ((?, ?), ?).
-  destruct (Mem.free _ _ _ _) eqn: Hfree; inv H.
-  apply free_contents in Hfree as <-; auto.
-Qed.
-
-Lemma ev_elim_nostore : forall l T m m', ev_elim m T m' ->
-  in_write_trace (fst l) (snd l) T = false ->
-  (exists z sz, In (Alloc (fst l) z sz) T) \/ contents_at m' l = contents_at m l.
-Proof.
-  induction T; simpl; intros; subst; auto.
-  destruct a.
-  - destruct (adr_range_dec _ _ _); [discriminate|].
-    destruct H as (? & ? & Helim).
-    apply IHT in Helim as [(? & ? & ?) | ->]; eauto.
-    unfold contents_at; erewrite Mem.storebytes_mem_contents by eauto.
-    destruct (eq_block b (fst l)).
-    + subst; rewrite Maps.PMap.gss, Mem.setN_outside; auto.
-      rewrite <- Zlength_correct.
-      unfold adr_range in n.
-      destruct (zlt (snd l) ofs); auto.
-      destruct (zlt (snd l) (ofs + Zlength bytes)); auto; lia.
-    + rewrite Maps.PMap.gso; auto.
-  - destruct H as (? & Helim).
-    apply IHT in Helim as [(? & ? & ?) | ->]; eauto.
-  - destruct H as (? & ? & Helim).
-    apply IHT in Helim as [(? & ? & ?) | ->]; eauto.
-    destruct (eq_block b (fst l)); subst; eauto.
-    unfold contents_at; erewrite mem_lemmas.AllocContentsOther; eauto.
-  - destruct H as (? & ? & Helim).
-    apply IHT in Helim as [(? & ? & ?) | ->]; eauto.
-    erewrite free_list_contents; eauto.
-Qed.
-
-Lemma ev_elim_contents' : forall l T m m', ev_elim m T m' -> (fst l < Mem.nextblock m)%positive ->
-  ~Mem.perm m (fst l) (snd l) Cur Writable ->
-  (forall m1 m1', ev_elim m1 T m1' -> contents_at m1' l = contents_at m1 l).
-Proof.
-  intros.
-  destruct (in_write_trace (fst l) (snd l) T) eqn: Hwrite.
-  - apply in_write_trace_perm in Hwrite as [(? & ? & Halloc) | ?].
-    { eapply (ev_elim_alloc_new _ _ _ _ _ _ H) in Halloc; eauto; lia. }
-    eapply ev_perm in H.
-    unfold Mem.perm in *.
-    rewrite mem_lemmas.po_oo in *; eapply mem_lemmas.po_trans in H3; eauto; contradiction.
-  - eapply ev_elim_nostore in Hwrite as [(? & ? & Halloc) | ?]; eauto.
-    eapply (ev_elim_alloc_new _ _ _ _ _ _ H) in Halloc; eauto.
-    apply Pos.lt_nle in H0; apply Pos.ge_le in Halloc; contradiction.
-Qed.
-
-Lemma join_ev_elim_commut : forall jm1 x jm2 T jm1' m2', join (m_phi jm1) x (m_phi jm2) ->
-  mem_sub (m_dry jm1) (m_dry jm2) -> ev_elim (m_dry jm1) T (m_dry jm1') -> mem_sub (m_dry jm1') m2' ->
-  resource_decay (Mem.nextblock (m_dry jm1)) (m_phi jm1) (m_phi jm1') -> ev_elim (m_dry jm2) T m2' ->
-  forall l, join (m_phi jm1' @ l)
-    (compcert_rmaps.RML.R.resource_fmap (compcert_rmaps.RML.R.approx (level jm1')) (compcert_rmaps.RML.R.approx (level jm1')) (x @ l))
-    (compcert_rmaps.RML.R.resource_fmap (compcert_rmaps.RML.R.approx (level jm1')) (compcert_rmaps.RML.R.approx (level jm1')) (juicy_mem_lemmas.rebuild_juicy_mem_fmap jm2 m2' l)).
-Proof.
-  intros ?????? J Hmem Helim1 Hmem' Hdecay Helim2 l.
-  unfold juicy_mem_lemmas.rebuild_juicy_mem_fmap.
-  apply (compcert_rmaps.RML.resource_at_join _ _ _ l) in J.
-  edestruct ev_elim_perm_inv as [[? Hnone] | [? [(? & ? & Hnew) | (? & Hsame)]]]; eauto.
-  - (* location was freed *)
-    rewrite Hnone; simpl.
-    destruct jm1'; simpl in *.
-    specialize (JMaccess l).
-    eapply ev_elim_free_1 in H as (Hcase & Hnone1 & ? & ?); [|apply Helim1].
-    unfold access_at in JMaccess; rewrite Hnone1 in JMaccess.
-    unfold perm_of_res in JMaccess.
-    destruct (phi @ l); try discriminate.
-    if_tac in JMaccess; inv JMaccess.
-    destruct Hcase as [Hm1 | Hm1].
-    + destruct l; simpl in *.
-      rewrite perm_access, (juicy_mem_access jm1) in Hm1.
-      assert (perm_of_res (m_phi jm1 @ (b, z)) = Some Freeable) as Hperm1
-        by (destruct (perm_of_res _); inv Hm1; auto).
-      apply semax_call.perm_of_res_val in Hperm1 as (? & ? & Hp); rewrite Hp in J.
-      inv J.
-      * apply join_Tsh in RJ as []; subst.
-        constructor; auto.
-      * apply join_Tsh in RJ as []; subst.
-        contradiction bot_unreadable.
-    + assert (fst l >= Mem.nextblock (m_dry jm2))%positive.
-      { destruct Hmem as (_ & <- & _); auto. }
-      rewrite (juicy_mem_alloc_cohere jm2) in * by auto.
-      inv J; constructor.
-      apply join_Bot in RJ as []; subst; auto.
-    + destruct k; try discriminate.
-      unfold perm_of_sh in JMaccess; repeat if_tac in JMaccess; try discriminate; subst.
-      contradiction.
-  - (* location was newly allocated and not freed *)
-    rewrite Hnew; simpl.
-    rewrite (juicy_mem_alloc_cohere jm2) in * by auto.
-    inv J; simpl.
-    apply join_Bot in RJ as []; subst.
-    eapply ev_elim_alloc in Helim1; eauto.
-    rewrite juicy_mem_access in Helim1.
-    apply semax_call.perm_of_res_val in Helim1 as (? & ? & Hp); rewrite Hp.
-    apply juicy_mem_contents in Hp as []; subst.
-    unfold contents_at; destruct Hmem' as [-> _].
-    constructor; auto.
-  - (* location was only read and written *)
-    rewrite Hsame, juicy_mem_access.
-    destruct (ev_elim_perm_inv l Cur _ _ _ Helim1) as [[? ?] | [_ [(? & ? & Hnew) | (_ & Hsame1)]]].
-    { contradiction H; eauto. }
-    { congruence. }
-    pose proof (juicy_mem_access jm1' l) as Hperm; rewrite Hsame1, juicy_mem_access in Hperm.
-    destruct Hdecay as [_ Hdecay]; specialize (Hdecay l); destruct Hdecay as [_ Hdecay].
-    inv J; rewrite <- H2 in Hperm, Hdecay; simpl in *.
-    + rewrite if_false by (if_tac; simpl; auto; intros X; inv X).
-      destruct (m_phi jm1' @ l); try discriminate; simpl in Hperm.
-      destruct Hdecay as [Heq | [(? & ? & ? & ? & ? & ?) | [(? & ? & ?) | (? & ? & ? & ?)]]]; try discriminate; inv Heq.
-      constructor; auto.
-      { destruct Hdecay as [? | [(? & ? & ? & ? & ? & ?) | [(? & ? & Heq) | (? & ? & ? & ?)]]]; try discriminate; inv Heq.
-        rewrite perm_of_freeable in Hperm; if_tac in Hperm; discriminate. }
-      { destruct Hdecay as [Heq | [(? & ? & ? & ? & ? & ?) | [(? & ? & ?) | (? & ? & ? & ?)]]]; discriminate. }
-    + destruct (Pos.ltb_spec (fst l) (Mem.nextblock (m_dry jm1))).
-      destruct k.
-      rewrite if_true by (unfold perm_of_sh; if_tac; if_tac; try contradiction; constructor).
-      unfold perm_of_sh in Hperm; rewrite (if_true _ _ _ _ _ rsh1) in Hperm.
-      destruct (m_phi jm1' @ l) eqn: H1'; simpl in Hperm; try (repeat if_tac in Hperm; discriminate).
-      destruct k; try (repeat if_tac in Hperm; discriminate).
-      apply juicy_mem_contents in H1' as []; subst.
-      unfold contents_at; destruct Hmem' as (-> & _ & _).
-      constructor.
-      destruct Hdecay as [Heq | [(? & ? & ? & ? & Heq & Heq1) | [(? & ? & Heq) | (? & ? & ? & ?)]]]; try discriminate; inv Heq; try inv Heq1; auto.
-      rewrite perm_of_freeable in Hperm; repeat if_tac in Hperm; try discriminate; subst; auto.
-      { destruct Hdecay as [<- | [(? & ? & ? & ? & ? & ?) | [(? & ? & ?) | (? & ? & ? & ?)]]]; try discriminate; try lia; constructor; auto. }
-      { destruct Hdecay as [<- | [(? & ? & ? & ? & ? & ?) | [(? & ? & ?) | (? & ? & ? & ?)]]]; try discriminate; try lia; constructor; auto. }
-      { rewrite juicy_mem_alloc_cohere in H2 by (apply Pos.le_ge; auto). inv H2. }
-    + destruct Hdecay as [Heq | [(? & ? & ? & ? & Heq & Heq1) | [(? & ? & Heq) | (? & ? & ? & ?)]]]; try discriminate.
-      rewrite <- Heq.
-      destruct k; try constructor; auto.
-      rewrite if_true by (unfold perm_of_sh; if_tac; if_tac; try contradiction; constructor).
-      rewrite (juicy_mem_access jm1'), <- Hperm in Hsame1.
-      eapply (ev_elim_contents' _ _ _ _ Helim1) in Helim2 as ->; auto.
-      symmetry in H4; apply juicy_mem_contents in H4 as []; subst.
-      constructor; auto.
-      { destruct (Pos.ltb_spec (fst l) (Mem.nextblock (m_dry jm1))); auto.
-        erewrite juicy_mem_alloc_cohere in H4. inv H4.
-        destruct Hmem as (_ & <- & _); apply Pos.le_ge; auto. }
-      { unfold Mem.perm; unfold access_at in Hsame1.
-        setoid_rewrite <- Hsame1.
-        if_tac; intros X; inv X. }
-      { erewrite juicy_mem_alloc_cohere in H4. inv H4.
-        destruct Hmem as (_ & <- & _); auto. }
-    + destruct (Pos.ltb_spec (fst l) (Mem.nextblock (m_dry jm1))).
-      destruct k.
-      rewrite if_true by (unfold perm_of_sh; if_tac; if_tac; try contradiction; constructor).
-      unfold perm_of_sh in Hperm; rewrite (if_true _ _ _ _ _ rsh1) in Hperm.
-      destruct (m_phi jm1' @ l) eqn: H1'; simpl in Hperm; try (repeat if_tac in Hperm; discriminate).
-      destruct k; try (repeat if_tac in Hperm; discriminate).
-      rewrite (juicy_mem_access jm1'), H1' in Hsame1.
-      apply juicy_mem_contents in H1' as []; subst.
-      unfold contents_at; destruct Hmem' as (-> & _ & _).
-      fold (contents_at m2' l).
-      eapply (ev_elim_contents' _ _ _ _ Helim1) in Helim2 as ->; auto.
-      symmetry in H4; apply juicy_mem_contents in H4 as []; subst.
-      constructor; auto.
-      { destruct Hdecay as [Heq | [(? & ? & ? & ? & Heq & Heq1) | [(? & ? & Heq) | (? & ? & ? & ?)]]]; try discriminate; inv Heq; try inv Heq1; auto; lia. }
-      { unfold Mem.perm. unfold access_at in Hsame1; setoid_rewrite <- Hsame1; simpl.
-        rewrite <- Hperm; if_tac; [|intros X; inv X].
-        apply join_writable0_readable in RJ; auto. }
-      { destruct Hdecay as [<- | [(? & ? & ? & ? & ? & ?) | [(? & ? & ?) | (? & ? & ? & ?)]]]; try discriminate; try lia; constructor; auto. }
-      { destruct Hdecay as [<- | [(? & ? & ? & ? & ? & ?) | [(? & ? & ?) | (? & ? & ? & ?)]]]; try discriminate; try lia; constructor; auto. }
-      { rewrite juicy_mem_alloc_cohere in H2 by (apply Pos.le_ge; auto). inv H2. }
-    + destruct Hdecay as [<- | [(? & ? & ? & ? & ? & ?) | [(? & ? & ?) | (? & ? & ? & ?)]]]; try discriminate.
-      constructor; auto.
-      erewrite juicy_mem_alloc_cohere in H4. inv H4.
-      destruct Hmem as (_ & <- & _); auto.
-Qed.
-
-Lemma join_sub_pures_eq : forall a b, join_sub a b -> juicy_safety.pures_eq a b.
-Proof.
-  intros ?? [? J]; unfold juicy_safety.pures_eq, juicy_safety.pures_sub.
-  split; intros l; apply (compcert_rmaps.RML.resource_at_join _ _ _ l) in J; inv J; eauto.
-  rewrite H2, <- compcert_rmaps.RML.resource_at_approx, <- H2; reflexivity.
-Qed.
-
-Lemma pures_eq_sym : forall a b, level a = level b -> juicy_safety.pures_eq a b -> juicy_safety.pures_eq b a.
-Proof.
-  unfold juicy_safety.pures_eq, juicy_safety.pures_sub; intros.
-  destruct H0 as [H1 H2]; split; intros l; specialize (H1 l); specialize (H2 l); destruct (a @ l) eqn: Ha, (b @ l) eqn: Hb; try congruence; eauto.
-  - destruct H2; discriminate.
-  - destruct H2; discriminate.
-  - destruct H2 as [? H2]; inv H2; inv H1.
-    rewrite <- Ha, <- compcert_rmaps.RML.resource_at_approx, Ha.
-    rewrite compcert_rmaps.RML.preds_fmap_fmap, H, compcert_rmaps.RML.approx_oo_approx; reflexivity.
-Qed.
-
-(* frame property for juicy extspecs *)
-Definition extspec_frame {Z} (JE : juicy_ext_spec Z) := forall e t b lt lv z jm w jm1, ext_spec_pre JE e t b lt lv z jm ->
-        mem_sub (m_dry jm) (m_dry jm1) -> join (m_phi jm) w (m_phi jm1) -> semax.ext_compat z (m_phi jm1) ->
-        exists t1, ext_spec_pre JE e t1 b lt lv z jm1 /\
-        forall ot v z' jm1', ext_spec_post JE e t1 b ot v z' jm1' ->
-          exists jm', ext_spec_post JE e t b ot v z' jm' /\ mem_sub (m_dry jm') (m_dry jm1') /\
-            join (m_phi jm') (age_to.age_to (level jm') w) (m_phi jm1').
-
-Lemma funspec2jspec_frame : forall {Z} (JE : juicy_ext_spec Z) extlink f,
-  extspec_frame JE -> extspec_frame (semax_ext.funspec2jspec _ JE extlink f).
-Proof.
-  unfold semax_ext.funspec2jspec, semax_ext.funspec2extspec, extspec_frame; simpl; intros.
-  destruct f as (?, []), t0; simpl in *.
-  unfold semax_ext.funspec2pre, semax_ext.funspec2post in *; if_tac; [|eauto].
-  destruct t as (frame, t); simpl in *.
-  destruct H0 as (? & ? & ? & J & ? & ? & ?).
-  destruct (join_assoc J H2) as (frame' & Jframe & ?).
-  exists (frame', t); simpl; split; eauto 7.
-  intros ???? (? & ? & J' & ? & ?).
-  eapply join_comm, nec_join2 in Jframe as (? & frame1 & Jframe & Hnecw & ?); eauto.
-  destruct (join_assoc (join_comm Jframe) (join_comm J')) as (? & J1 & J1').
-  destruct (join_assoc J1 (join_comm J1')) as (? & J'' & Jtop%join_comm).
-  edestruct juicy_mem_sub as (? & ? & ?); [eexists; eauto | subst].
-  eexists; split; [do 3 eexists; [apply J''|]|]; split; auto.
-  - eapply rt_trans; eauto.
-  - pose proof (necR_level _ _ Hnecw).
-    apply age_to.necR_age_to in Hnecw; rewrite Hnecw in Jtop.
-    destruct (join_level _ _ _ Jtop) as [-> <-].
-    rewrite age_to.level_age_to; auto.
-Qed.
-
-Lemma add_funspecs_frame' : forall {Espec : OracleKind} extlink fs,
-  extspec_frame OK_spec -> extspec_frame (@OK_spec (add_funspecs Espec extlink fs)).
-Proof.
-  destruct Espec; simpl; intros.
-  generalize dependent OK_spec; induction fs; simpl; auto; intros.
-  destruct a; apply funspec2jspec_frame; auto.
-Qed.
-
-Lemma void_spec_frame : forall {Z}, extspec_frame (@OK_spec (ok_void_spec Z)).
-Proof.
-  unfold ok_void_spec; simpl; repeat intro; contradiction.
-Qed.
-
-Lemma add_funspecs_frame : forall {Z} extlink fs,
-  extspec_frame (@OK_spec (add_funspecs (ok_void_spec Z) extlink fs)).
-Proof.
-  intros; apply add_funspecs_frame', void_spec_frame.
-Qed.
-
-Lemma whole_program_sequential_safety:
-   forall {CS: compspecs} {Espec: OracleKind} (initial_oracle: OK_ty)
-     (dryspec: ext_spec OK_ty)
-     (dessicate : forall (ef : external_function) jm,
-               ext_spec_type OK_spec ef ->
-               ext_spec_type dryspec ef)
-     (Jsub: forall ef se lv m t v m' (EFI : ef_inline ef = true) m1
-       (EFC : Events.external_call ef se lv m t v m'), mem_sub m m1 ->
-       exists m1' (EFC1 : Events.external_call ef se lv m1 t v m1'),
-         mem_sub m' m1' /\ proj1_sig (inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC1) =
-         proj1_sig (inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC))
-     (Jframe: extspec_frame OK_spec)
-     (JDE: juicy_dry_ext_spec _ (@JE_spec OK_ty OK_spec) dryspec dessicate)
-     (DME: ext_spec_mem_evolve _ dryspec)
-     (PAE: semax_prog.postcondition_allows_exit Espec tint)
-     (Esub: forall v z m m', ext_spec_exit dryspec v z m -> mem_sub m m' -> ext_spec_exit dryspec v z m')
-     (prog: Clight.program) V G m,
-     @semax_prog Espec CS prog initial_oracle V G ->
-     Genv.init_mem prog = Some m ->
-     exists b, exists q, exists m',
-       Genv.find_symbol (Genv.globalenv prog) (prog_main prog) = Some b /\
-       initial_core  (cl_core_sem (globalenv prog))
-           0 m q m' (Vptr b Ptrofs.zero) nil /\
-       forall n,
-        @dry_safeN _ _ _ OK_ty (semax.genv_symb_injective)
-          (cl_core_sem (globalenv prog)) dryspec
-            (Build_genv (Genv.globalenv prog) (prog_comp_env prog))
-             n initial_oracle q m'.
-Proof.
- intros.
- destruct (@semax_prog_rule Espec CS _ _ _ _
-     0 (*additional temporary argument - TODO (Santiago): FIXME*)
-     initial_oracle PAE H H0) as [b [q [[H1 H2] H3]]].
- destruct (H3 O) as [jmx [H4x [H5x [H6x [H6'x [H7x _]]]]]].
- destruct (H2 jmx H4x) as [jmx' [H8x H8y]].
- exists b, q, (m_dry jmx').
- split3; auto.
- rewrite H4x in H8y. auto.
- subst. simpl.
- clear H5x H6x H6'x H7x H8y.
- forget (m_dry jmx) as m. clear jmx.
- intro n.
- specialize (H3 n).
- destruct H3 as [jm [? [? [? [Hwsat [? _]]]]]].
- unfold semax.jsafeN in H6.
- subst m.
- destruct Hwsat as (z & Jz & Hdry & Hz).
- (* safety uses all the resources, including the ones we put inside
-    invariants (since there's no take-from-invariant step in Clight) *)
- rewrite Hdry.
- assert (joins (compcert_rmaps.RML.R.ghost_of (m_phi z))
-   (Some (ghost_PCM.ext_ref initial_oracle, compcert_rmaps.RML.R.NoneP) :: nil)) as J.
- { apply compcert_rmaps.RML.ghost_of_join in Jz.
-   unfold initial_world.wsat_rmap in Jz; rewrite ghost_of_make_rmap in Jz.
-   inv Jz.
-   { rewrite <- H7 in H5; discriminate. }
-   rewrite <- H3 in H5; inv H5; inv H10.
-   eexists; constructor; constructor.
-   instantiate (1 := (_, _)); split; simpl; [|hnf; eauto].
-   apply semax_prog.ext_ref_join. }
- assert (exists w, join (m_phi jm) w (m_phi z) /\
-   (invariants.wsat * invariants.ghost_set invariants.g_en Ensembles.Full_set)%pred w) as Hwsat.
- { do 2 eexists; eauto; apply initial_world.wsat_rmap_wsat. }
- assert (mem_sub (m_dry jm) (m_dry z)) as Hmem.
- { rewrite Hdry; repeat (split; auto). }
- clear - Jsub Jframe Esub JDE DME H4 J H6 Hwsat Hmem.
-  rewrite <- H4.
- assert (level jm <= n)%nat by lia.
- clear H4; rename H into H4.
- forget initial_oracle as ora.
- revert ora jm z q H4 J Hwsat Hmem H6; induction n; intros.
- assert (level jm = 0%nat) by lia. rewrite H; constructor.
- inv H6.
- - rewrite H; constructor.
- - (* in the juicy semantics, we took a step with jm *)
-   destruct H as (?&?&Hl&Hg).
-   (* so we can take the same step with the full memory z *)
-   destruct (CLC_evsem (globalenv prog)) eqn: Hevsem; inv Hevsem.
-   destruct (CLC_memsem (globalenv prog)) eqn: Hmemsem; inv Hmemsem.
-   simpl in ev_step_ax1, ev_step_ax2.
-   apply ev_step_ax2 in H as [T H].
-   pose proof (ev_step_elim _ _ _ _ _ H) as Helim.
-   eapply cl_evstep_extends in H as (m1' & H & Hmem'); eauto.
-   pose proof (ev_step_elim _ _ _ _ _ H) as Helim1; clear ev_step_elim.
-   apply ev_step_ax1 in H.
-   rewrite Hl; eapply safeN_step.
-   + red. red. fold (globalenv prog). eassumption.
-   + destruct Hwsat as (w & Jw & Hw).
-     (* the new full memory can be broken into the memory we got from the step,
-        and the memory we left in the invariant *)
-     assert (exists z', join (m_phi m') (age_to.age_to (level m') w) (m_phi z') /\ m_dry z' = m1') as (z' & J' & ?); subst.
-     { apply corestep_mem, mem_step_evolve in H.
-       destruct (juicy_mem_lemmas.rebuild_juicy_mem_rmap z m1') as (? & ? & Hr' & Hg').
-       eapply mem_evolve_cohere in H; [|eauto].
-       apply (age_to_cohere _ _ (level m')) in H as (A & B & C & D).
-       exists (mkJuicyMem _ _ A B C D); split; auto; simpl.
-       apply compcert_rmaps.RML.resource_at_join2; auto.
-       * apply join_level in Jw as []. rewrite !level_juice_level_phi in *. rewrite age_to.level_age_to; auto; lia.
-       * apply join_level in Jw as []. rewrite !level_juice_level_phi in *. rewrite !age_to.level_age_to; auto; lia.
-       * intros; rewrite !age_to_resource_at.age_to_resource_at, Hr'.
-         eapply join_ev_elim_commut; eauto.
-       * rewrite !age_to_resource_at.age_to_ghost_of, Hg, Hg'.
-         rewrite <- level_juice_level_phi; apply compcert_rmaps.RML.ghost_fmap_join, compcert_rmaps.RML.ghost_of_join; auto. }
-     assert ((invariants.wsat * invariants.ghost_set invariants.g_en Ensembles.Full_set)%pred
-       (age_to.age_to (level m') w)).
-     { eapply pred_nec_hereditary, Hw; apply age_to.age_to_necR. }
-     assert (joins (compcert_rmaps.RML.R.ghost_of (m_phi z'))
-       (compcert_rmaps.RML.R.ghost_fmap
-         (compcert_rmaps.RML.R.approx (level z'))
-         (compcert_rmaps.RML.R.approx (level z'))
-        (Some (ghost_PCM.ext_ref ora, compcert_rmaps.RML.R.NoneP) :: nil))).
-     { assert (join (ghost_of (m_phi m')) (ghost_of (age_to.age_to (level m') w))
-         (ghost_of (age_to.age_to (level m') (m_phi z)))) as J1.
-       { rewrite Hg, !age_to_resource_at.age_to_ghost_of.
-         apply compcert_rmaps.RML.ghost_fmap_join, compcert_rmaps.RML.ghost_of_join; auto. }
-       eapply join_eq in J1; [|apply compcert_rmaps.RML.ghost_of_join; eauto].
-       rewrite J1. rewrite age_to_resource_at.age_to_ghost_of.
-       destruct J as [? J]; eapply compcert_rmaps.RML.ghost_fmap_join in J; simpl in *; eexists; apply J. }
-     edestruct H0 as (? & ? & Hz' & Hsafe); eauto.
-     { apply join_sub_refl. }
-     assert (level x = level m') as Hl'.
-     { destruct Hz' as (? & ? & ?); apply join_level in J' as [];
-         rewrite <- !level_juice_level_phi in *; lia. }
-     destruct Hsafe as [Hsafe | (m2 & ? & ? & ? & ? & Hsafe)].
-     { rewrite <- Hl', Hsafe; constructor. }
-     (* after accessing invariants, we have a new sub-memory m2, which
-        completes to the same full memory *)
-     assert (level m' = level m2) as Hl2 by (apply join_level in H6 as []; rewrite <- !level_juice_level_phi in *; lia).
-     rewrite Hl2.
-     destruct Hz' as [<- ?].
-     apply IHn; eauto. lia.
- -
-   unfold extspec_frame in Jframe.
-   destruct dryspec as [ty pre post exit].
-   destruct JE_spec as [ty' pre' post' exit'].
-   change (level (m_phi jm)) with (level jm) in *.
-   destruct JDE as [JDE1 [JDE2 JDE3]].
-   destruct (level jm) eqn: Hl; [constructor|].
-   destruct Hwsat as (w & Jw & Hw).
-   edestruct Jframe as (x' & H0' & Hpost); eauto.
-   eapply safeN_external.
-   { eassumption. }
-   { eapply JDE1; eauto. }
-   simpl. intros.
-   assert (level jm = level z) as Hlz.
-   { apply join_level in Jw as []; rewrite <- !level_juice_level_phi in *; lia. }
-   (* We need to reconstruct the full jm, then find a sub-memory s.t.
-      join sub w jm'. *)
-   assert (H20: exists jm', m_dry jm' = m'
-                    /\ (level jm' = n')%nat
-                    /\ juicy_safety.pures_eq (m_phi z) (m_phi jm')
-                    /\ resource_at (m_phi jm') = resource_fmap (approx (level jm')) (approx (level jm')) oo juicy_mem_lemmas.rebuild_juicy_mem_fmap z (m_dry jm')
-                    /\ compcert_rmaps.RML.R.ghost_of (m_phi jm') = Some (ghost_PCM.ext_ghost z', compcert_rmaps.RML.R.NoneP) :: ghost_fmap (approx (level jm')) (approx (level jm')) (tl (ghost_of (m_phi z)))). {
-     destruct (juicy_mem_lemmas.rebuild_juicy_mem_rmap z m')
-          as [phi [? [? ?]]].
-     assert (own.ghost_approx phi (Some (ghost_PCM.ext_ghost z', NoneP) :: tl (compcert_rmaps.RML.R.ghost_of phi)) =
-        Some (ghost_PCM.ext_ghost z', NoneP) :: tl (compcert_rmaps.RML.R.ghost_of phi)) as Happrox.
-     { simpl; f_equal.
-        rewrite <- compcert_rmaps.RML.ghost_of_approx at 2.
-        destruct (compcert_rmaps.RML.R.ghost_of phi); auto. }
-     set (phi1 := initial_world.set_ghost _ _ Happrox).
-     assert (level phi1 = level phi /\ resource_at phi1 = resource_at phi) as [Hl1 Hr1].
-     { subst phi1; unfold initial_world.set_ghost; rewrite level_make_rmap, resource_at_make_rmap; auto. }
-     pose (phi' := age_to.age_to n' phi1).
-     assert (mem_rmap_cohere m' phi') as H10. {
-       clear - H0' Hr1 Hl1 H8 H7 H5 H2 Hmem DME JDE1.
-       eapply JDE1 in H0'; eauto.
-       specialize (DME e _ _ _ _ _ _ _ _ _ _ H0' H5).
-       subst phi'.
-       apply age_to_cohere.
-       subst phi1.
-       apply set_ghost_cohere.
-       eapply mem_evolve_cohere; eauto.
-     }
-     destruct H10 as [H10 [H11 [H12 H13]]].
-     pose (jm' := mkJuicyMem _ _ H10 H11 H12 H13).
-     exists jm'.
-     assert (n' <= level phi1)%nat by lia.
-     split; [ | split3].
-     * subst jm'; simpl; auto.
-     * subst jm' phi'; simpl. apply age_to.level_age_to; auto.
-     * unfold juicy_safety.pures_eq, juicy_safety.pures_sub. subst jm' phi'; simpl.
-       split; intros; rewrite age_to_resource_at.age_to_resource_at, Hr1, H7;
-         unfold juicy_mem_lemmas.rebuild_juicy_mem_fmap; destruct (m_phi z @ _); simpl; eauto;
-         try solve [try (destruct k; auto); if_tac; auto].
-       rewrite age_to.level_age_to; auto.
-     * subst jm' phi'; simpl. split.
-       { extensionality. rewrite age_to_resource_at.age_to_resource_at, Hr1, H7.
-         rewrite age_to.level_age_to; auto. }
-       rewrite age_to_resource_at.age_to_ghost_of, age_to.level_age_to; auto.
-       subst phi1.
-       unfold initial_world.set_ghost; rewrite ghost_of_make_rmap, H8; auto.
-   }
-   destruct H20 as [jm' [H26 [H27 [H28 [H29 Hg']]]]].
-   subst m'; eapply JDE2 in H5; eauto 7.
-   apply Hpost in H5 as (jm1 & ? & ? & Jw').
-   specialize (H1 ret jm1 z' Hargsty Hretty).
-   assert (level jm1 = level jm') as Hl1 by (apply join_level in Jw' as []; rewrite <- !level_juice_level_phi in *; lia).
-   spec H1.
-   { split; [lia|].
-     eapply juicy_safety.pures_eq_trans, juicy_safety.pures_eq_trans; [| apply join_sub_pures_eq; eexists; eauto | | eauto |];
-       rewrite <- ?level_juice_level_phi; try lia.
-     apply pures_eq_sym, join_sub_pures_eq; [|eexists; eauto].
-     rewrite <- !level_juice_level_phi; auto. }
-   spec H1. assumption.
-   destruct H1 as [c' [H2a H2b]]; exists c'; split; auto.
-   (* eliminate fupd *)
-   assert (app_pred (invariants.wsat * invariants.ghost_set invariants.g_en Ensembles.Full_set)%pred
-         (age_to.age_to (level jm1) w)).
-   { eapply pred_nec_hereditary, Hw; apply age_to.age_to_necR. }
-   edestruct H2b as (x1 & ? & Hz' & Hsafe); eauto.
-   { apply join_sub_refl. }
-   { rewrite Hg'; eexists; do 2 constructor; simpl.
-     instantiate (1 := (_, _)); split; simpl; [apply semax_prog.ext_ref_join | repeat constructor]. }
-   assert (level x1 = level jm') as Hl'.
-   { destruct Hz' as (? & ? & ?); lia. }
-   subst n'; destruct Hsafe as [Hsafe | (m2 & ? & ? & ? & ? & Hsafe)].
-   { rewrite <- Hl', Hsafe; constructor. }
-   assert (level jm' = level m2) as Hl2 by (apply join_level in H8 as []; rewrite <- !level_juice_level_phi in *; lia).
-   rewrite Hl2.
-   destruct Hz' as [<- ?].
-   apply IHn; eauto. lia.
- - eapply safeN_halted; eauto.
-   eapply Esub; eauto.
-   apply JDE; auto.
-Qed.
-Require Import VST.veric.juicy_safety.
-
-Definition fun_id (ext_link: Strings.String.string -> ident) (ef: external_function) : option ident :=
-  match ef with EF_external id sig => Some (ext_link id) | _ => None end.
diff --git a/veric/age_to_resource_at.v b/veric/age_to_resource_at.v
deleted file mode 100644
index b12676f0d2..0000000000
--- a/veric/age_to_resource_at.v
+++ /dev/null
@@ -1,129 +0,0 @@
-Require Import compcert.common.Memory.
-Require Import VST.msl.Coqlib2.
-Require Import VST.msl.eq_dec.
-Require Import VST.msl.ageable.
-Require Import VST.msl.age_to.
-Require Import VST.veric.coqlib4.
-Require Import VST.veric.compcert_rmaps.
-
-Set Bullet Behavior "Strict Subproofs".
-
-Lemma pred_hered {A} {_ : ageable A} {EO : Ext_ord A} (P : pred A) : hereditary age (app_pred P).
-Proof.
-  destruct P as (? & ? & ?); auto.
-Qed.
-
-Lemma hereditary_necR {phi phi' : rmap} {P} :
-  necR phi phi' ->
-  hereditary age P ->
-  P phi -> P phi'.
-Proof.
-  intros N H; induction N; auto.
-  apply H; auto.
-Qed.
-
-Lemma anti_hereditary_necR {phi phi' : rmap} {P} :
-  necR phi phi' ->
-  hereditary (fun x y => age y x) P ->
-  P phi' -> P phi.
-Proof.
-  intros N H; induction N; auto.
-  apply H; auto.
-Qed.
-
-Lemma app_pred_age {R} {phi phi' : rmap} :
-  age phi phi' ->
-  app_pred R phi ->
-  app_pred R phi'.
-Proof.
-  destruct R as [R HR]; simpl.
-  apply HR.
-Qed.
-
-Lemma age_yes_sat {Phi Phi' phi phi' l z z' sh sh'} (R : pred rmap) :
-  level Phi = level phi ->
-  age Phi Phi' ->
-  age phi phi' ->
-  app_pred R phi ->
-  Phi  @ l = YES sh sh' (LK z z') (SomeP rmaps.Mpred (fun _ => R)) ->
-  app_pred (approx (S (level phi')) R) phi' /\
-  Phi' @ l = YES sh sh' (LK z z') (SomeP rmaps.Mpred (fun _ => approx (level Phi') R)).
-Proof.
-  intros L A Au SAT AT.
-  pose proof (app_pred_age Au SAT) as SAT'.
-  split.
-  - split.
-    + apply age_level in A; apply age_level in Au. lia.
-    + apply SAT'.
-  - apply (necR_YES _ Phi') in AT.
-    + rewrite AT.
-      reflexivity.
-    + constructor. assumption.
-Qed.
-
-Lemma age_to_resource_at phi n loc : age_to n phi @ loc = resource_fmap (approx n) (approx n) (phi @ loc).
-Proof.
-  assert (D : (n <= level phi \/ n >= level phi)%nat) by lia.
-  destruct D as [D | D]; swap 1 2.
-  - rewrite age_to_ge; auto.
-    rewrite <-resource_at_approx.
-    match goal with
-      |- _ = ?map ?f1 ?f2 (?map ?g1 ?g2 ?r) => transitivity (map (f1 oo g1) (g2 oo f2) r)
-    end; swap 1 2.
-    + destruct (phi @ loc); unfold "oo"; simpl; auto.
-      * destruct p; auto.
-        rewrite preds_fmap_fmap; auto.
-      * destruct p; auto.
-        rewrite preds_fmap_fmap; auto.
-    + f_equal. rewrite approx'_oo_approx; auto.
-      rewrite approx_oo_approx'; auto.
-  - generalize (age_to_ageN n phi).
-    generalize (age_to n phi); intros phi'.
-    replace n with (level phi - (level phi - n))%nat at 2 3 by lia.
-    generalize (level phi - n)%nat; intros k. clear n D.
-    revert phi phi'; induction k; intros phi phi'.
-    + unfold ageN in *; simpl.
-      injection 1 as <-.
-      simpl; replace (level phi - 0)%nat with (level phi) by lia.
-      symmetry.
-      apply resource_at_approx.
-    + change (ageN (S k) phi) with
-      (match age1 phi with Some w' => ageN k w' | None => None end).
-      destruct (age1 phi) as [o|] eqn:Eo. 2:congruence.
-      intros A; specialize (IHk _ _ A).
-      rewrite IHk.
-      pose proof age_resource_at Eo (loc := loc) as R.
-      rewrite R.
-      clear A R.
-      rewrite (age_level _ _ Eo).
-      simpl.
-      match goal with
-        |- ?map ?f1 ?f2 (?map ?g1 ?g2 ?r) = _ => transitivity (map (f1 oo g1) (g2 oo f2) r)
-      end.
-      * destruct (phi @ loc); unfold "oo"; simpl; auto.
-        -- destruct p; auto.
-           rewrite preds_fmap_fmap; auto.
-        -- destruct p; auto.
-           rewrite preds_fmap_fmap; auto.
-      * f_equal. rewrite approx_oo_approx'; auto.
-        lia.
-        rewrite approx'_oo_approx; auto.
-        lia.
-Qed.
-
-Lemma age_to_ghost_of phi n : ghost_of (age_to n phi) = ghost_fmap (approx n) (approx n) (ghost_of phi).
-Proof.
-  pose proof (age_to_ageN n phi).
-  forget (age_to n phi) as phi'.
-  remember (level phi - n) as n'.
-  generalize dependent n; generalize dependent phi; induction n'; intros.
-  - inv H.
-    rewrite <- ghost_of_approx, ghost_fmap_fmap, approx'_oo_approx, approx_oo_approx' by lia; auto.
-  - change (ageN (S n') phi) with
-      (match age1 phi with Some w' => ageN n' w' | None => None end) in H.
-    destruct (age1 phi) eqn: Hage; [|discriminate].
-    pose proof (age_level _ _ Hage) as Hl.
-    assert (n' = level r - n). lia.
-    rewrite (IHn' _ H n), (age1_ghost_of _ _ Hage) by (auto; lia).
-    rewrite ghost_fmap_fmap, approx_oo_approx', approx'_oo_approx by lia; auto.
-Qed.
diff --git a/veric/aging_lemmas.v b/veric/aging_lemmas.v
deleted file mode 100644
index f676e767d6..0000000000
--- a/veric/aging_lemmas.v
+++ /dev/null
@@ -1,155 +0,0 @@
-Require Import compcert.common.Memory.
-Require Import VST.msl.Coqlib2.
-Require Import VST.msl.eq_dec.
-Require Import VST.msl.ageable.
-Require Import VST.msl.age_to.
-Require Import VST.veric.coqlib4.
-Require Import VST.veric.juicy_mem.
-Require Import VST.veric.compcert_rmaps. 
-Require Import VST.veric.seplog.
-Require Import VST.veric.juicy_extspec.
-Require Import VST.veric.mem_lessdef.
-Require Import VST.veric.age_to_resource_at.
-
-Set Bullet Behavior "Strict Subproofs".
-
-Ltac hered :=
-  match goal with
-    H : ?P ?x |- ?P ?y => revert H
-  end;
-  match goal with
-    |- ?P ?x -> ?P ?y =>
-    cut (hereditary age P);
-    [ let h := fresh "h" in intros h; apply h; auto | ]
-  end.
-
-Ltac agejoinhyp :=
-  match goal with
-    H : sepalg.join _ _ ?m, A : age ?m _ |- _ =>
-    pose proof age1_join2 _ H A; clear H
-  end.
-
-Ltac agehyps :=
-  match goal with
-    H : age ?x ?y, HH : ?P ?x |- _ =>
-    cut (P y);
-    [ clear HH; intros HH
-    | hered;
-      try apply pred_hered;
-      try apply predicates_hered.exactly_obligation_1]
-  end.
-
-(** * Aging and predicates *)
-
-Lemma hereditary_func_at' loc fs :
-  hereditary age (func_at' fs loc).
-Proof.
-  apply pred_hered.
-Qed.
-
-Lemma anti_hereditary_func_at' loc fs :
-  hereditary (fun x y => age y x) (func_at' fs loc).
-Proof.
-  intros x y a; destruct fs as [f cc A P Q]; simpl.
-  intros [pp E].
-  destruct (proj2 (age1_PURE _ _ loc (FUN f cc) a)) as [pp' Ey]; eauto.
-  pose proof resource_at_approx y loc as H.
-  rewrite Ey in H at 1; simpl in H.
-  rewrite <-H.
-  exists pp'.
-  reflexivity.
-Qed.
-
-Lemma pures_eq_unage {phi1 phi1' phi2}:
-  ge (level phi1') (level phi2) ->
-  age phi1 phi1' ->
-  juicy_safety.pures_eq phi1' phi2 ->
-  juicy_safety.pures_eq phi1 phi2.
-Proof.
-  intros L A [S P]; split; intros loc; [clear P; autospec S | clear S; autospec P ].
-  - rewrite (age_resource_at A) in S.
-    destruct (phi1 @ loc) eqn:E; auto.
-    simpl in S.
-    rewrite S.
-    rewrite preds_fmap_fmap.
-    rewrite approx_oo_approx'; auto.
-    rewrite approx'_oo_approx; auto.
-  - destruct (phi2 @ loc) eqn:E; auto.
-    revert P.
-    eapply age1_PURE. auto.
-Qed.
-
-(** * Aging and operational steps *)
-
-Lemma jstep_age_sim {C} {csem : @semantics.CoreSemantics C mem} {c c' jm1 jm2 jm1'} :
-  age jm1 jm2 ->
-  jstep csem c jm1 c' jm1' ->
-  level jm2 <> O ->
-  exists jm2',
-    age jm1' jm2' /\
-    jstep csem c jm2 c' jm2'.
-Proof.
-  intros A [step [rd [lev Hg]]] nz.
-  destruct (age1 jm1') as [jm2'|] eqn:E.
-  - exists jm2'. split; auto.
-    split; [|split; [|split]]; auto.
-    + exact_eq step.
-      f_equal; apply age_jm_dry; auto.
-    + eapply (age_resource_decay _ (m_phi jm1) (m_phi jm1')).
-      * exact_eq rd.
-        f_equal. f_equal. apply age_jm_dry; auto.
-      * apply age_jm_phi; auto.
-      * apply age_jm_phi; auto.
-      * rewrite level_juice_level_phi in *. auto.
-    + apply age_level in E.
-      apply age_level in A.
-      lia.
-    + rewrite (age1_ghost_of _ _ (age_jm_phi A)), (age1_ghost_of _ _ (age_jm_phi E)), Hg.
-      apply age_level in A; rewrite A in lev; inv lev.
-      rewrite !level_juice_level_phi; congruence.
-  - apply age1_level0 in E.
-    apply age_level in A.
-    lia.
-Qed.
-
-Lemma jsafeN__age {G C Z HH Sem Jspec ge ora q} jm jmaged :
-  ext_spec_stable age (JE_spec _ Jspec) ->
-  age jm jmaged ->
-  @jsafeN_ G Z C HH Sem Jspec ge ora q jm ->
-  @jsafeN_ G Z C HH Sem Jspec ge ora q jmaged.
-Proof.
-  intros; eapply age_safe; eauto.
-Qed.
-
-Lemma jsafeN__age_to {G C Z HH Sem Jspec ge ora q} l jm :
-  ext_spec_stable age (JE_spec _ Jspec) ->
-  @jsafeN_ G Z C HH Sem Jspec ge ora q jm ->
-  @jsafeN_ G Z C HH Sem Jspec ge ora q (age_to l jm).
-Proof.
-  intros Stable nl.
-  apply age_to_ind_refined; auto.
-  intros x y H L.
-  apply jsafeN__age; auto.
-Qed.
-
-Lemma m_dry_age_to n jm : m_dry (age_to n jm) = m_dry jm.
-Proof.
-  remember (m_dry jm) as m eqn:E; symmetry; revert E.
-  apply age_to_ind; auto.
-  intros x y H E ->. rewrite E; auto. clear E.
-  apply age_jm_dry; auto.
-Qed.
-
-Lemma m_phi_age_to n jm : m_phi (age_to n jm) = age_to n (m_phi jm).
-Proof.
-  unfold age_to.
-  rewrite level_juice_level_phi.
-  generalize (level (m_phi jm) - n)%nat; clear n.
-  intros n; induction n. reflexivity.
-  simpl. rewrite <- IHn.
-  clear IHn. generalize (age_by n jm); clear jm; intros jm.
-  unfold age1'.
-  destruct (age1 jm) as [jm'|] eqn:e.
-  - rewrite (age1_juicy_mem_Some _ _ e). easy.
-  - rewrite (age1_juicy_mem_None1 _ e). easy.
-Qed.
\ No newline at end of file
diff --git a/veric/assert_lemmas.v b/veric/assert_lemmas.v
index 7fad107622..add1600159 100644
--- a/veric/assert_lemmas.v
+++ b/veric/assert_lemmas.v
@@ -1,36 +1,26 @@
 Require Export VST.veric.base.
-Require Import VST.veric.compcert_rmaps.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.res_predicates.
+Require Import VST.veric.juicy_mem.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import compcert.cfrontend.Ctypes.
 Require Import VST.veric.mpred.
 Require Import VST.veric.seplog.
 
-Require Import VST.msl.normalize.
-Import compcert.lib.Maps.
+Section mpred.
 
-Local Open Scope pred.
+Context `{!heapGS Σ}.
 
-Lemma mapsto_core_load: forall ch v sh loc m, 
-  (address_mapsto ch v sh loc * TT)%pred m -> core_load ch loc v m.
+Lemma mapsto_core_load: forall ch v sh loc, readable_share sh ->
+  address_mapsto ch v sh loc ⊢ core_load ch loc v.
 Proof.
 unfold address_mapsto, core_load.
-intros until m; intros H.
-destruct H as [phi0 [phi1 [Hjoin [[bl [[Hlen [Hdec Halign]] H]] ?]]]].
-unfold allp, jam in *.
-exists bl.
-repeat split; auto.
-hnf. intro b; specialize (H b).
-hnf in H|-*.
-if_tac.
-hnf in H|-*.
-destruct H as [p ?].
-apply (resource_at_join _ _ _ b) in Hjoin.
-rewrite H in Hjoin; clear H.
-repeat rewrite preds_fmap_NoneP in Hjoin.
-inv Hjoin.
-do 3 econstructor; try reflexivity.
-do 2 econstructor; reflexivity.
-auto.
+intros; iIntros "H".
+iDestruct "H" as (bl ?) "H"; iExists bl; iFrame "%".
+iIntros "!>".
+iApply (big_sepL_mono with "H"); intros.
+iIntros "H"; iExists _; iFrame; simpl.
+iPureIntro; split; auto; by apply perm_of_readable_share.
 Qed.
 
 Lemma nth_error_in_bounds: forall {A} (l: list A) i, (O <= i < length l)%nat
@@ -56,7 +46,7 @@ induction i; destruct l; destruct l'; intros; simpl in *;
 rewrite (IHi l l'); try solve [auto|lia].
 Qed.
 
-Lemma core_load_fun: forall ch m loc v1 v2,
+(*Lemma core_load_fun: forall ch m loc v1 v2,
    core_load ch loc v1 m -> core_load ch loc v2 m -> v1=v2.
 Proof.
 intros until v2; intros H H0.
@@ -118,39 +108,7 @@ split; auto.
 cut (0 <= Z_of_nat i < Z_of_nat (length bl)). intro H6.
 2: lia.
 lia.
-Qed.
-
-Lemma assert_truth:  forall {A} `{ageable A} {EO: Ext_ord A} (P:  Prop), P -> forall (Q: pred A), Q |-- (!! P) && Q.
-Proof.
-intros.
-intros st ?.
-split; auto.
-Qed.
-
-Lemma rmap_unage_age:
-  forall r, age (rmap_unage r) r.
-Proof.
-intros; unfold age, rmap_unage; simpl.
-case_eq (unsquash r); intros.
-change ag_rmap with R.ag_rmap.
-rewrite rmap_age1_eq.
-rewrite unsquash_squash.
-f_equal.
-apply unsquash_inj.
-rewrite H.
-rewrite unsquash_squash.
-f_equal.
-generalize (equal_f (rmap_fmap_comp (approx (S n)) (approx (S n)) (approx n) (approx n)) r0); intro.
-unfold compose at 1 in H0.
-rewrite H0.
-rewrite approx_oo_approx'; auto.
-rewrite approx'_oo_approx; auto.
-clear - H.
-generalize (unsquash_squash n r0); intros.
-rewrite <- H in H0.
-rewrite squash_unsquash in H0.
-congruence.
-Qed.
+Qed.*)
 
 Lemma adr_range_split_lem1: forall n m r loc loc',
   r = n + m -> n >= 0 -> m >= 0 -> adr_range loc n loc' -> adr_range loc r loc'.
@@ -187,162 +145,4 @@ apply H3.
 split; auto||lia.
 Qed.
 
-Lemma prop_imp_i {A}{agA: ageable A}{EO: Ext_ord A}:
-  forall (P: Prop) Q w, (P -> app_pred Q w) -> (!!P --> Q) w.
-Proof.
- intros. intros w' ? ? ? H1. apply H in H1. eapply pred_upclosed, pred_nec_hereditary; eauto.
-Qed.
-
-Lemma or_pred_ext {A} `{agA : ageable A}{EO: Ext_ord A}: forall P Q P' Q',
-       (P <--> P') && (Q <--> Q') |--  (P || Q) <--> (P' || Q').
-Proof.
-intros.
-intros w [? ?].
-split; intros w' ??? [?|?].
-left. destruct H; eauto.
-right. destruct H0; eauto.
-left. destruct H; eauto.
-right. destruct H0; eauto.
-Qed.
-
-Lemma corable_unfash:
-  forall (A : Type) (JA : Join A) (PA : Perm_alg A) (SA : Sep_alg A) (agA : ageable A) 
-    (AgeA : Age_alg A) (EO : Ext_ord A) (EA : Ext_alg A) (P : pred nat), corable (! P).
-Proof.
-  unfold corable; simpl; intros.
-  destruct H0 as [[? J] | [[? J] | E]]; try (apply join_level in J as []; congruence).
-  apply ext_level in E; congruence.
-Qed.
-
-Section invs.
-
-Context {inv_names : invariants.invG}.
-
-Lemma corable_funspec_sub_si f g: corable (funspec_sub_si f g).
-Proof.
- unfold funspec_sub_si; intros.
- destruct f, g. apply corable_andp; [apply corable_prop|].
- eapply corable_later, corable_unfash; typeclasses eauto.
-Qed.
-
-Lemma ext_join_sub : forall (a b : rmap), ext_order a b -> join_sub a b.
-Proof.
-  intros.
-  rewrite rmap_order in H.
-  destruct H as (? & ? & g & ?).
-  destruct (make_rmap (resource_at (core a)) (own.ghost_approx a g) (level a)) as (c & Hl & Hr & Hg).
-  { extensionality l; unfold compose.
-    rewrite <- level_core.
-    apply resource_at_approx. }
-  { rewrite ghost_fmap_fmap, approx_oo_approx; auto. }
-  exists c; apply resource_at_join2; auto.
-  - congruence.
-  - intros; rewrite Hr, <- core_resource_at, H0.
-    apply join_comm, core_unit.
-  - rewrite Hg, <- (ghost_of_approx a), <- (ghost_of_approx b), <- H.
-    apply ghost_fmap_join; auto.
-Qed.
-
-Lemma corable_cases : forall (P : mpred), (forall w, P w -> forall w', join_sub w w' \/ join_sub w' w -> P w') ->
-  corable P.
-Proof.
-  repeat intro.
-  destruct H1 as [? | [? | ?]]; eauto.
-  apply ext_join_sub in H1; eauto.
-Qed.
-
-Lemma corable_pureat: forall pp k loc, corable (pureat pp k loc).
-Proof.
-  intros; apply corable_cases.
-  unfold pureat; simpl; intros.
-  destruct H0 as [[? J] | [? J]]; destruct (join_level _ _ _ J) as [Hl _];
-    apply resource_at_join with (loc := loc) in J; rewrite H in J; inv J; rewrite Hl; auto.
-Qed.
-
-Lemma corable_func_at: forall f l, corable (func_at f l).
-Proof.
-  intros.
-  unfold func_at.
-  destruct f as [fsig0 cc A P Q]. apply corable_pureat.
-Qed.
-
-Lemma corable_func_at': forall f l, corable (func_at' f l).
-Proof.
-  intros.
-  unfold func_at'.
-  destruct f as [fsig0 cc A P Q].
-  apply corable_exp; intro.
-  apply corable_pureat.
-Qed.
-
-Lemma corable_sigcc: forall f c b, corable (sigcc_at f c (pair b Z0)).
-Proof. 
-  intros.
-  unfold sigcc_at.
-  apply corable_exp; intro.
-  apply corable_pureat.
-Qed.
-
-Lemma corable_func_ptr_si : forall f v, corable (func_ptr_si f v).
-Proof.
-  intros.
-  unfold func_ptr_si.
-  apply corable_exp; intro.
-  apply corable_andp; auto.
-  apply corable_exp; intro.
-  apply corable_andp. apply corable_funspec_sub_si.
-  apply corable_func_at.
-Qed.
-
-Lemma corable_func_ptr : forall f v, corable (func_ptr f v).
-Proof.
-  intros.
-  unfold func_ptr.
-  apply corable_exp; intro.
-  apply corable_andp; auto.
-  apply corable_exp; intro.
-  apply corable_andp. apply corable_prop.
-  apply corable_func_at.
-Qed.
-
-End invs.
-
-#[export] Hint Resolve corable_func_ptr corable_func_ptr_si : core.
-
-Lemma corable_funspecs_assert:
-  forall FS rho, corable (funspecs_assert FS rho).
-Proof.
- intros.
- unfold funspecs_assert.
- repeat
- first [
-   apply corable_andp|
-   apply corable_exp; intro|
-   apply corable_allp; intro|
-   apply corable_prop|
-   apply corable_imp].
- + apply corable_func_at.
- + destruct b2; apply corable_pureat.
-Qed.
-
-#[export] Hint Resolve corable_funspecs_assert : core.
-
-Lemma corable_jam: forall {B} {S': B -> Prop} (S: forall l, {S' l}+{~ S' l}) (P Q: B -> pred rmap),
-    (forall loc, corable (P loc)) ->
-    (forall loc, corable (Q loc)) ->
-    forall b, corable (jam S P Q b).
-Proof.
-intros.
-intro.
-unfold jam.
-simpl.
-if_tac.
-apply H.
-apply H0.
-Qed.
-
-Lemma prop_derives {A}{H: ageable A}{EO: Ext_ord A}:
- forall (P Q: Prop), (P -> Q) -> prop P |-- prop Q.
-Proof.
-intros. intros w ?; apply H0; auto.
-Qed.
+End mpred.
diff --git a/veric/base.v b/veric/base.v
index a50069efc1..d830d6ab16 100644
--- a/veric/base.v
+++ b/veric/base.v
@@ -13,7 +13,7 @@ Require Export compcert.common.Memory.
 Require Export compcert.common.Globalenvs.
 
 
-Require Export VST.msl.Coqlib2. 
+Require Export VST.msl.Coqlib2.
 Require Export VST.veric.coqlib4.
 
 (* Lemmas about ident lists *)
diff --git a/veric/bi.v b/veric/bi.v
deleted file mode 100644
index 1dfddf84cb..0000000000
--- a/veric/bi.v
+++ /dev/null
@@ -1,548 +0,0 @@
-From iris.bi Require Import interface.
-From iris.proofmode Require Export tactics.
-
-(* undo some "simpl never" settings from std++ *)
-#[global] Arguments Pos.of_nat : simpl nomatch.
-#[global] Arguments Pos.to_nat !x / .
-#[global] Arguments N.add : simpl nomatch.
-#[global] Arguments Z.of_nat : simpl nomatch.
-#[global] Arguments Z.to_nat : simpl nomatch.
-
-(* Conflicting notations:
-
-  !!   PMap.get (level 1) vs lookup (level 20), fixed for now by not exporting compcert.lib.Maps
-  |==> VST bupd (level 62) vs Iris bupd (level 99), fixed for now by changing to match Iris precedence
-    (this is a bit annoying because of the difference in precedence of derives)
-*)
-
-From VST.veric Require Import compcert_rmaps SeparationLogic.
-
-Notation "'emp'" := seplog.emp.
-
-Section cofe.
-  #[local] Instance mpred_equiv : Equiv mpred := eq.
-  #[local] Instance mpred_dist : Dist mpred := fun n P Q => approx (S n) P = approx (S n) Q.
-
-  Lemma dist_equiv : forall (P Q : pred rmap), (∀ n : nat, P ≡{n}≡ Q) -> P = Q.
-  Proof.
-    intros; apply predicates_hered.pred_ext; repeat intro.
-    - specialize (H (level a)); hnf in H.
-      assert (approx (S (level a)) P a) as HP' by (split; auto).
-      rewrite H in HP'; apply HP'.
-    - specialize (H (level a)); hnf in H.
-      assert (approx (S (level a)) Q a) as HP' by (split; auto).
-      rewrite <- H in HP'; apply HP'.
-  Qed.
-
-  Definition mpred_ofe_mixin : OfeMixin mpred.
-  Proof.
-    split.
-    - intros P Q; split.
-      + intros HPQ n; hnf in *; subst; auto.
-      + apply dist_equiv.
-    - intros n; split; auto.
-      congruence.
-    - intros ? P Q ?; hnf in *.
-      apply predicates_hered.pred_ext; intros ? []; split; auto.
-      + assert (approx (S (S n)) P a) as HP by (split; auto; lia).
-        rewrite H in HP; apply HP.
-      + assert (approx (S (S n)) Q a) as HP by (split; auto; lia).
-        rewrite <- H in HP; apply HP.
-  Qed.
-  Canonical Structure mpredC : ofe := Ofe mpred mpred_ofe_mixin.
-
-  Program Definition mpred_compl : Compl mpredC := fun c w => c (level w) w.
-  Next Obligation.
-  Proof.
-    split; repeat intro; simpl in *.
-    eapply pred_hereditary in H0; eauto.
-    assert (approx (S (level a')) (c (level a)) a') as Ha by (split; auto).
-    rewrite chain_cauchy in Ha; [apply Ha | apply age_level in H; lia].
-
-    eapply pred_upclosed in H0; eauto.
-    apply ext_level in H as <-; auto.
-  Qed.
-  Global Program Instance mpred_cofe : Cofe mpredC := {| compl := mpred_compl |}.
-  Next Obligation.
-    intros; hnf.
-    apply predicates_hered.pred_ext; intros ? []; split; auto; simpl in *.
-    - assert (approx (S (level a)) (c (level a)) a) as Ha by (split; auto).
-      rewrite <- (chain_cauchy c (level a) n) in Ha; [apply Ha | lia].
-    - assert (approx (S (level a)) (c n) a) as Ha by (split; auto).
-      rewrite chain_cauchy in Ha; [apply Ha | lia].
-  Qed.
-End cofe.
-Arguments mpredC : clear implicits.
-
-Lemma approx_imp : forall n P Q, approx n (P --> Q)%pred = approx n (approx n P --> approx n Q)%pred.
-Proof.
-  intros; apply predicates_hered.pred_ext; intros ? (? & Himp); split; auto; intros ? ? Ha' Hext HP.
-  - destruct HP; split; eauto.
-  - eapply Himp; eauto; split; auto.
-    pose proof (necR_level _ _ Ha'); apply ext_level in Hext; lia.
-Qed.
-
-Lemma core_ext_ord : forall (a b : rmap), join_sub a b -> ext_order (core a) (core b).
-Proof.
-  intros.
-  destruct H as [? J%join_core_sub].
-  destruct J; rewrite rmap_order.
-  split; [apply join_level in H as []; auto|].
-  split.
-  - extensionality l; apply (resource_at_join _ _ _ l) in H.
-    eapply join_sub_same_identity; try apply resource_at_core_identity;
-      try (rewrite <- core_resource_at; apply core_duplicable).
-    rewrite !core_resource_at; eexists; eauto.
-  - eexists; apply ghost_of_join; eauto.
-Qed.
-
-Lemma ext_ord_core : forall (a b : rmap), ext_order a b -> ext_order (core a) (core b).
-Proof.
-  intros.
-  apply core_ext_ord, assert_lemmas.ext_join_sub; auto.
-Qed.
-
-Program Definition persistently (P : mpred) : mpred := fun w => P (core w).
-Next Obligation.
-Proof.
-  split; repeat intro.
-  eapply pred_hereditary; eauto.
-  apply age_core; auto.
-
-  eapply pred_upclosed, H0.
-  apply ext_ord_core; auto.
-Qed.
-
-Lemma approx_persistently: forall P n, approx n (persistently P) = persistently (approx n P).
-Proof.
-  intros; apply predicates_hered.pred_ext; intros ??; simpl in *; intros.
-  - rewrite level_core; auto.
-  - rewrite -> level_core in H; auto.
-Qed.
-
-Lemma persistently_derives: forall P Q, P |-- Q -> persistently P |-- persistently Q.
-Proof.
-  intros.
-  unseal_derives; unfold persistently; intros ??.
-  apply H; auto.
-Qed.
-
-Lemma persistently_persists : forall P, persistently P |-- persistently (persistently P).
-Proof.
-  intros.
-  unseal_derives; unfold persistently; intros ??; simpl.
-  rewrite core_idem; auto.
-Qed.
-
-Lemma mpred_bi_mixin :
-  BiMixin
-    derives emp prop andp orp imp (@allp _ _) (@exp _ _) sepcon wand persistently.
-Proof.
-  split.
-  - constructor; auto. intro. apply derives_trans.
-  - split; intros.
-    + hnf in H; subst; auto.
-    + apply pred_ext; tauto.
-  - intros ????; hnf.
-    f_equal; f_equal.
-    apply prop_ext; auto.
-  - intros ???????; hnf in *.
-    rewrite !approx_andp; congruence.
-  - intros ???????; hnf in *.
-    rewrite !approx_orp; congruence.
-  - intros ???????; hnf in *.
-    rewrite approx_imp (approx_imp _ y). congruence.
-  - intros ?? P Q ?; hnf in *.
-    apply predicates_hered.pred_ext.
-    + intros ? [? HP]; split; auto.
-      change ((predicates_hered.allp Q) a).
-      intro z; specialize (HP z).
-      assert (approx (S n) (P z) a) as HP' by (split; auto).
-      rewrite H in HP'; apply HP'.
-    + intros ? [? HP]; split; auto.
-      change ((predicates_hered.allp P) a).
-      intro z; specialize (HP z).
-      assert (approx (S n) (Q z) a) as HP' by (split; auto).
-      rewrite <- H in HP'; apply HP'.
-  - intros ?? P Q ?; hnf in *.
-    rewrite !approx_exp; f_equal; extensionality.
-    apply H.
-  - intros ???????; hnf in *.
-    rewrite !approx_sepcon; congruence.
-  - intros ? P Q ????; hnf in *.
-    rewrite wand_nonexpansive (wand_nonexpansive Q); congruence.
-  - intros ????; hnf in *.
-    rewrite !approx_persistently H; auto.
-  - apply prop_right.
-  - intros.
-    apply prop_left; intro.
-    eapply derives_trans; eauto.
-  - intros; apply andp_left1, derives_refl.
-  - intros; apply andp_left2, derives_refl.
-  - intros; apply andp_right; auto.
-  - intros; apply orp_right1, derives_refl.
-  - intros; apply orp_right2, derives_refl.
-  - apply orp_left.
-  - apply imp_andp_adjoint.
-  - apply imp_andp_adjoint.
-  - intros; apply allp_right; auto.
-  - intros; eapply allp_left, derives_refl.
-  - intros; eapply exp_right, derives_refl.
-  - intros; apply exp_left; auto.
-  - intros; apply sepcon_derives; auto.
-  - intros; rewrite emp_sepcon; auto.
-  - intros; rewrite emp_sepcon; auto.
-  - intros; rewrite sepcon_comm; auto.
-  - intros; rewrite sepcon_assoc; auto.
-  - intros; rewrite <- wand_sepcon_adjoint; auto.
-  - intros; rewrite wand_sepcon_adjoint; auto.
-  - intros; apply persistently_derives; auto.
-  - intros; apply persistently_persists.
-  - unfold persistently.
-    unseal_derives; intros ??; simpl.
-    setoid_rewrite res_predicates.emp_no; intros l.
-    apply resource_at_core_identity.
-  - unfold persistently; intros.
-    unseal_derives; intros ??; auto.
-  - intros.
-    unseal_derives; intros ??; simpl in *.
-    destruct H as [b ?].
-    exists b; auto.
-  - intros.
-    unseal_derives; intros ? (? & ? & J & ? & ?); simpl in *.
-    eapply pred_upclosed, H.
-    apply core_ext_ord; eexists; eauto.
-  - intros.
-    unseal_derives; intros ? []; simpl in *.
-    exists (core a), a; repeat (split; auto).
-    apply core_unit.
-Qed.
-
-Lemma approx_later : forall n P, approx (S n) (|> P)%pred = seplog.later (approx n P).
-Proof.
-  intros; apply predicates_hered.pred_ext.
-  - intros ? [].
-    change ((|> approx n P)%pred a); intros ??; split; auto.
-    apply laterR_level in H1; lia.
-  - intros ??.
-    destruct (level a) eqn: Hl.
-    + split; [rewrite Hl; lia|].
-      intros ??.
-      apply laterR_level in H0; lia.
-    + destruct (levelS_age _ _ (eq_sym Hl)) as (a' & ? & ?); subst.
-      destruct (H a').
-      { constructor; auto. }
-      split; [lia|].
-      intros ? HL; apply (H _ HL).
-Qed.
-
-Lemma approx_0 : forall P, approx 0 P = FF.
-Proof.
-  intros; apply predicates_hered.pred_ext.
-  - intros ? []; lia.
-  - intros ??; contradiction.
-Qed.
-
-Lemma mpred_bi_later_mixin : BiLaterMixin
-  derives prop orp imp (@allp _ _) (@exp _ _) sepcon persistently seplog.later.
-Proof.
-  split.
-  - repeat intro. hnf. rewrite !approx_later. destruct n.
-    + rewrite !approx_0; auto.
-    + apply dist_S in H; f_equal; auto.
-  - intros; apply later_derives; auto.
-  - apply now_later.
-  - intros. rewrite seplog.later_allp; auto.
-  - intros. eapply derives_trans; [eapply (seplog.later_exp'')|].
-    apply orp_left; [apply orp_right2 | apply orp_right1]; auto.
-    apply later_derives, FF_left.
-  - intros; rewrite later_sepcon; auto.
-  - intros; rewrite later_sepcon; auto.
-  - intros.
-    unseal_derives; intros ??; simpl in *.
-    match goal with |- context[(|> ?Q)%logic] => change (|>Q)%logic with (box laterM Q) end.
-    intros ? Hlater.
-    apply unlaterR_core in Hlater as (? & Hlater & ?); subst.
-    apply (H _ Hlater).
-  - intros.
-    unseal_derives; intros ??; simpl in *.
-    match goal with |- context[(|> ?Q)%logic] => change (|>Q)%logic with (box laterM Q) end.
-    intros ? Hlater.
-    apply laterR_core in Hlater.
-    apply (H _ Hlater).
-  - intros.
-    unseal_derives.
-    change (predicates_hered.derives (box laterM P)
-      (box laterM (prop False) || predicates_hered.imp (box laterM (prop False)) P)%pred).
-    repeat intro; simpl in *.
-    destruct (level a) eqn: Ha.
-    + left; intros ??%laterR_level; lia.
-    + right; intros.
-      eapply pred_upclosed; eauto.
-      apply H.
-      apply nec_refl_or_later in H0 as [|]; auto; subst.
-      symmetry in Ha; apply levelS_age in Ha as (? & ? & ?); exfalso.
-      eapply ext_age_compat in H1 as (? & ? & ?); eauto.
-      eapply H2.
-      constructor; eauto.
-Qed.
-
-Canonical Structure mpredI : bi :=
-  {| bi_ofe_mixin := mpred_ofe_mixin; bi_bi_mixin := mpred_bi_mixin;
-     bi_bi_later_mixin := mpred_bi_later_mixin |}.
-
-(* an Iris extension that is satisfied by most but not all BI instances *)
-Global Instance mpred_later_contractive : BiLaterContractive mpredI.
-Proof.
-  intros ????.
-  unfold dist_later in H; change (approx (S n) (|> x) = approx (S n) (|> y))%logic.
-  rewrite !approx_later.
-  destruct n.
-  - rewrite !approx_0; auto.
-  - rewrite H; auto.
-Qed.
-
-(* updates *)
-Lemma mpred_bupd_mixin : BiBUpdMixin mpredI ghost_seplog.bupd.
-Proof.
-  split.
-  - repeat intro; hnf in *.
-    rewrite !approx_bupd; congruence.
-  - exact: bupd_intro.
-  - exact: bupd_mono.
-  - exact: bupd_trans.
-  - exact: bupd_frame_r.
-Qed.
-Global Instance mpred_bi_bupd : BiBUpd mpredI := {| bi_bupd_mixin := mpred_bupd_mixin |}.
-
-Definition coPset_to_Ensemble (E : coPset.coPset) : Ensembles.Ensemble nat := fun x => elem_of (Pos.of_nat (S x)) E.
-
-Lemma coPset_to_Ensemble_union : forall E1 E2,
-  coPset_to_Ensemble (E1 ∪ E2) = Ensembles.Union (coPset_to_Ensemble E1) (coPset_to_Ensemble E2).
-Proof.
-  intros.
-  unfold coPset_to_Ensemble.
-  extensionality; apply prop_ext; split; intro X.
-  - apply elem_of_union in X as [|]; [left | right]; auto.
-  - inv X; [apply elem_of_union_l | apply elem_of_union_r]; auto.
-Qed.
-
-Lemma coPset_to_Ensemble_disjoint : forall E1 E2,
-  Ensembles.Disjoint (coPset_to_Ensemble E1) (coPset_to_Ensemble E2) <-> E1 ## E2.
-Proof.
-  split; intros.
-  - inv H.
-    intros x ??; contradiction (H0 (Nat.pred (Pos.to_nat x))); constructor; unfold Ensembles.In, coPset_to_Ensemble;
-      rewrite -> Nat.succ_pred_pos, Pos2Nat.id by lia; auto.
-  - constructor; intros ? X; inv X.
-    unfold Ensembles.In, coPset_to_Ensemble in *.
-    contradiction (H _ H0).
-Qed.
-
-Lemma mpred_fupd_mixin : BiFUpdMixin mpredI (fun E1 E2 => ghost_seplog.fupd (coPset_to_Ensemble E1) (coPset_to_Ensemble E2)).
-Proof.
-  split.
-  - repeat intro; hnf in *.
-    rewrite fupd_nonexpansive; setoid_rewrite fupd_nonexpansive at 2.
-    rewrite H; auto.
-  - intros; unfold updates.fupd.
-    apply subseteq_disjoint_union_L in H as (E1' & ? & ?); subst.
-    rewrite coPset_to_Ensemble_union invariants.Union_comm.
-    apply fupd_mask_union, coPset_to_Ensemble_disjoint.
-    symmetry; auto.
-  - intros; apply except_0_fupd.
-  - intros; apply fupd_mono; auto.
-  - intros; apply fupd_trans.
-  - intros; unfold updates.fupd.
-    iIntros "H".
-    rewrite !coPset_to_Ensemble_union.
-    rewrite <- coPset_to_Ensemble_disjoint in H |- *.
-    iApply fupd_mask_frame_r'; auto.
-  - intros; apply fupd_frame_r.
-Qed.
-Global Instance mpred_bi_fupd : BiFUpd mpredI := {| bi_fupd_mixin := mpred_fupd_mixin |}.
-
-Global Instance mpred_bi_bupd_fupd : BiBUpdFUpd mpredI.
-Proof.
-  hnf.
-  intros; apply bupd_fupd.
-Qed.
-
-(*(* Lifted instance *)
-Section lifted_cofe.
-  #[local] Instance env_mpred_equiv : Equiv (environ -> mpred) := eq.
-  #[local] Instance env_mpred_dist : Dist (environ -> mpred) := fun n P Q => forall rho, approx (S n) (P rho) = approx (S n) (Q rho).
-
-  Lemma lift_dist_equiv : forall (P Q : environ -> pred rmap), (∀ n : nat, P ≡{n}≡ Q) -> P = Q.
-  Proof.
-    intros; extensionality rho.
-    apply dist_equiv; intros.
-    apply H.
-  Qed.
-
-  Definition env_mpred_ofe_mixin : OfeMixin (environ -> mpred).
-  Proof.
-    split.
-    - intros P Q; split.
-      + intros HPQ n; hnf in *; subst; auto.
-      + apply lift_dist_equiv.
-    - intros n; constructor; repeat intro; auto.
-      congruence.
-    - intros ? P Q ? rho.
-      apply (mixin_dist_S _ mpred_ofe_mixin), H.
-  Qed.
-  Canonical Structure env_mpredC : ofeT := OfeT (environ -> mpred) env_mpred_ofe_mixin.
-
-  Program Definition env_mpred_compl : Compl env_mpredC := fun c rho w => c (level w) rho w.
-  Next Obligation.
-  Proof.
-    repeat intro.
-    eapply pred_hereditary in H0; eauto.
-    assert (approx (S (level a')) (c (level a) rho) a') as Ha by (split; auto).
-    rewrite chain_cauchy in Ha; [apply Ha | apply age_level in H; lia].
-  Qed.
-  Global Program Instance env_mpred_cofe : Cofe env_mpredC := {| compl := env_mpred_compl |}.
-  Next Obligation.
-    intros; hnf; intro rho.
-    apply predicates_hered.pred_ext; intros ? []; split; auto; simpl in *.
-    - assert (approx (S (level a)) (c (level a) rho) a) as Ha by (split; auto).
-      rewrite <- (chain_cauchy c (level a) n) in Ha; [apply Ha | lia].
-    - assert (approx (S (level a)) (c n rho) a) as Ha by (split; auto).
-      rewrite chain_cauchy in Ha; [apply Ha | lia].
-  Qed.
-End lifted_cofe.
-Arguments env_mpredC : clear implicits.
-
-Lemma env_mpred_bi_mixin :
-  BiMixin(PROP := environ -> mpred)
-    derives emp prop andp orp imp (@allp _ _) (@exp _ _) sepcon wand (lift persistently).
-Proof.
-  split.
-  - constructor; auto. intro. apply derives_trans.
-  - split; intros.
-    + hnf in H; subst; auto.
-    + apply pred_ext; tauto.
-  - intros ????; hnf; intro rho.
-    f_equal; f_equal.
-    apply prop_ext; auto.
-  - intros ????????; hnf in *.
-    rewrite !approx_andp; congruence.
-  - intros ????????; hnf in *.
-    rewrite !approx_orp; congruence.
-  - intros ????????; hnf in *; simpl.
-    rewrite approx_imp (approx_imp _ (y rho)). congruence.
-  - intros ?? P Q ??; hnf in *; simpl.
-    apply (bi_mixin_forall_ne _ _ _ _ _ _ _ _ _ _ _ mpred_bi_mixin); hnf; intros.
-    apply H.
-  - intros ?? P Q ??; hnf in *.
-    rewrite !approx_exp; f_equal; extensionality.
-    apply H.
-  - intros ????????; hnf in *.
-    rewrite !approx_sepcon; congruence.
-  - intros ? P Q ?????; hnf in *; simpl.
-    rewrite wand_nonexpansive (wand_nonexpansive (Q rho)); congruence.
-  - intros ?????; hnf in *.
-    unfold lift.
-    rewrite !approx_persistently H; auto.
-  - apply prop_right.
-  - intros.
-    apply prop_left; intro.
-    eapply derives_trans; eauto.
-  - intros; rewrite prop_forall; auto.
-  - intros; apply andp_left1, derives_refl.
-  - intros; apply andp_left2, derives_refl.
-  - intros; apply andp_right; auto.
-  - intros; apply orp_right1, derives_refl.
-  - intros; apply orp_right2, derives_refl.
-  - apply orp_left.
-  - apply imp_andp_adjoint.
-  - apply imp_andp_adjoint.
-  - intros; apply allp_right; auto.
-  - intros; eapply allp_left, derives_refl.
-  - intros; eapply exp_right, derives_refl.
-  - intros; apply exp_left; auto.
-  - intros; apply sepcon_derives; auto.
-  - intros; rewrite emp_sepcon; auto.
-  - intros; rewrite emp_sepcon; auto.
-  - intros; rewrite sepcon_comm; auto.
-  - intros; rewrite sepcon_assoc; auto.
-  - intros; rewrite <- wand_sepcon_adjoint; auto.
-  - intros; rewrite wand_sepcon_adjoint; auto.
-  - intros; unfold lift; simpl.
-    intro; apply persistently_derives; auto.
-  - intros; unfold lift; simpl.
-    intro; apply persistently_persists.
-  - unfold persistently, lift; intro rho.
-    unseal_derives; intros ??; simpl.
-    apply core_identity.
-  - intros; intro rho.
-    unfold lift; simpl; apply (bi_mixin_persistently_forall_2 _ _ _ _ _ _ _ _ _ _ _ mpred_bi_mixin).
-  - intros; intro rho.
-    unfold lift; simpl; apply (bi_mixin_persistently_exist_1 _ _ _ _ _ _ _ _ _ _ _ mpred_bi_mixin).
-  - intros; intro rho.
-    unfold lift; simpl; apply (bi_mixin_persistently_absorbing _ _ _ _ _ _ _ _ _ _ _ mpred_bi_mixin).
-  - intros; intro rho.
-    unfold lift; simpl; apply (bi_mixin_persistently_and_sep_elim _ _ _ _ _ _ _ _ _ _ _ mpred_bi_mixin).
-Qed.
-
-Lemma env_mpred_sbi_mixin : SbiMixin(PROP := environ -> mpred)
-  derives prop orp imp (@allp _ _) (@exp _ _) sepcon (lift persistently) (fun a b c _ => @internal_eq a b c) seplog.later.
-Proof.
-  split.
-  - repeat intro; hnf.
-    simpl; apply (sbi_mixin_later_contractive _ _ _ _ _ _ _ _ _ _ mpred_sbi_mixin).
-    destruct n; simpl in *; hnf; auto.
-  - repeat intro; apply (sbi_mixin_internal_eq_ne _ _ _ _ _ _ _ _ _ _ mpred_sbi_mixin); auto.
-  - intros; intro rho.
-    apply (sbi_mixin_internal_eq_refl _ _ _ _ _ _ _ _ _ _ mpred_sbi_mixin).
-  - intros; intro rho; simpl.
-    match goal with |- ?P |-- (?A --> ?B)%logic =>
-      change (predicates_hered.derives P (predicates_hered.imp A B)) end.
-    repeat intro; simpl in *.
-    assert ((approx (S (level a')) (Ψ b rho)) a') as []; auto.
-    rewrite <- H; [split; eauto|].
-    eapply dist_le; eauto.
-    apply necR_level in H1; lia.
-  - intros; intro rho.
-    unseal_derives; repeat intro.
-    specialize (H x); auto.
-  - intros; intro rho.
-    unseal_derives; repeat intro.
-    apply H.
-  - intros; intro rho.
-    unseal_derives; repeat intro; simpl in *.
-    rewrite discrete_iff; apply H0.
-  - intros; intro rho.
-    apply (sbi_mixin_later_eq_1 _ _ _ _ _ _ _ _ _ _ mpred_sbi_mixin).
-  - intros; intro rho.
-    apply (sbi_mixin_later_eq_2 _ _ _ _ _ _ _ _ _ _ mpred_sbi_mixin).
-  - intros; apply later_derives; auto.
-  - apply now_later.
-  - intros. rewrite seplog.later_allp; auto.
-  - intros. eapply derives_trans; [eapply (seplog.later_exp'')|].
-    apply orp_left; [apply orp_right2 | apply orp_right1]; auto.
-    apply later_derives, FF_left.
-  - intros; rewrite later_sepcon; auto.
-  - intros; rewrite later_sepcon; auto.
-  - intros; intro rho; unfold lift; simpl.
-    apply (sbi_mixin_later_persistently_1 _ _ _ _ _ _ _ _ _ _ mpred_sbi_mixin).
-  - intros; intro rho; unfold lift; simpl.
-    apply (sbi_mixin_later_persistently_2 _ _ _ _ _ _ _ _ _ _ mpred_sbi_mixin).
-  - intros; intro rho; unfold lift; simpl.
-    apply (sbi_mixin_later_false_em _ _ _ _ _ _ _ _ _ _ mpred_sbi_mixin).
-Qed.
-
-Canonical Structure env_mpredI : bi :=
-  {| bi_ofe_mixin := env_mpred_ofe_mixin; bi_bi_mixin := env_mpred_bi_mixin |}.
-Canonical Structure env_mpredSI : sbi :=
-  {| sbi_ofe_mixin := env_mpred_ofe_mixin;
-     sbi_bi_mixin := env_mpred_bi_mixin; sbi_sbi_mixin := env_mpred_sbi_mixin |}.*)
-
-(* Return from IPM to VST entailment. *)
-Ltac iVST := iStopProof; repeat change (bi_car mpredI) with mpred; match goal with |-bi_entails ?P ?Q => change (P |-- Q) end;
-  repeat match goal with |-context[bi_sep ?P ?Q] => change (bi_sep P Q) with (P * Q)%logic end.
-
-Global Close Scope logic_upd. (* hide non-Iris update notation *)
-Global Open Scope Z.
-Global Open Scope logic.
-Global Open Scope bi_scope.
diff --git a/veric/binop_lemmas.v b/veric/binop_lemmas.v
index 9a4e38c780..9c85bc947c 100644
--- a/veric/binop_lemmas.v
+++ b/veric/binop_lemmas.v
@@ -1,7 +1,9 @@
-Require Import VST.msl.msl_standard.
 Require Import VST.veric.Clight_base.
-Require Import VST.veric.compcert_rmaps.
 Require Import VST.veric.Clight_lemmas.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Import VST.veric.res_predicates.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
+Require Import VST.veric.juicy_mem.
 Require Import VST.veric.mpred.
 Require Import VST.veric.tycontext.
 Require Import VST.veric.expr2.
@@ -11,15 +13,18 @@ Require Import VST.veric.binop_lemmas3.
 Require Import VST.veric.binop_lemmas4.
 Require Import VST.veric.binop_lemmas5.
 Require Import VST.veric.binop_lemmas6.
-Import Cop.
+
+Section mpred.
+
+Context `{!heapGS Σ}.
 
 Lemma typecheck_binop_sound:
-forall op {CS: compspecs} (rho : environ) m (e1 e2 : expr) (t : type)
-   (IBR: denote_tc_assert (isBinOpResultType op e1 e2 t) rho m)
+forall op {CS: compspecs} (rho : environ) (e1 e2 : expr) (t : type)
    (TV2: tc_val (typeof e2) (eval_expr e2 rho))
    (TV1: tc_val (typeof e1) (eval_expr e1 rho)),
-   tc_val t
-     (eval_binop op (typeof e1) (typeof e2) (eval_expr e1 rho) (eval_expr e2 rho)).
+   denote_tc_assert (isBinOpResultType op e1 e2 t) rho ⊢
+   ⌜tc_val t
+     (eval_binop op (typeof e1) (typeof e2) (eval_expr e1 rho) (eval_expr e2 rho))⌝.
 Proof.
   intros.
   destruct op;
@@ -35,3 +40,320 @@ Proof.
     | eapply typecheck_Otest_order_sound; solve [eauto]].
 Qed.
 
+Lemma force_val_Some : forall o v, o = Some v -> force_val o = v.
+Proof. intros; subst; auto. Qed.
+
+Lemma ints_to_64 : forall i, 0 <= Int.signed i <= Ptrofs.max_unsigned -> Ptrofs.to_int64 (Ptrofs.of_ints i) = Int64.repr (Int.signed i).
+Proof.
+  intros; rewrite /Ptrofs.to_int64 /Ptrofs.of_ints.
+  rewrite Ptrofs.unsigned_repr; auto.
+Qed.
+
+Lemma intu_to_64 : forall i, 0 <= Int.unsigned i <= Ptrofs.max_unsigned -> Ptrofs.to_int64 (Ptrofs.of_intu i) = Int64.repr (Int.unsigned i).
+Proof.
+  intros; rewrite /Ptrofs.to_int64 /Ptrofs.of_intu /Ptrofs.of_int.
+  rewrite Ptrofs.unsigned_repr; auto.
+Qed.
+
+Lemma sem_cmp_relate : forall {CS} b e1 e2 ty m rho
+  (TC1 : tc_val (typeof e1) (eval_expr e1 rho))
+  (TC2 : tc_val (typeof e2) (eval_expr e2 rho))
+  (Hcmp : is_comparison b = true),
+  mem_auth m ∗ denote_tc_assert (isBinOpResultType b e1 e2 ty) rho ⊢
+  ⌜sem_binary_operation cenv_cs b (eval_expr(CS := CS) e1 rho) (typeof e1) (eval_expr e2 rho) (typeof e2) m =
+   Some (eval_binop b  (typeof e1) (typeof e2) (eval_expr e1 rho) (eval_expr e2 rho))⌝.
+Proof.
+  intros.
+  iIntros "[Hm H]"; iDestruct (typecheck_binop_sound b rho e1 e2 with "H") as %TC; [done..|].
+  rewrite /eval_binop /force_val2 in TC |- *.
+  destruct (sem_binary_operation' _ _ _ _ _) eqn: Heval; last by apply tc_val_Vundef in TC.
+  rewrite /sem_binary_operation' in Heval.
+  rewrite den_isBinOpR /= /sem_binary_operation -classify_cmp_eq.
+  forget (op_result_type (Ebinop b e1 e2 ty)) as err.
+  forget (arg_type (Ebinop b e1 e2 ty)) as err0.
+  pose proof (classify_cmp_reflect (typeof e1) (typeof e2)) as Hclass; rewrite -classify_cmp_eq in Hclass.
+  rewrite !tc_val_tc_val_PM' in TC1 TC2.
+  rewrite -(force_val_Some _ _ Heval).
+  inv Hclass.
+  - destruct b; try discriminate; rewrite /Cop.sem_cmp /sem_cmp; simpl; rewrite -H0 /=; unfold_lift;
+      rewrite /tc_int_or_ptr_type !tc_bool_e -?bi.pure_and ?negb_true_iff /=; iDestruct "H" as "([-> ->] & H & %)";
+      ((iApply (test_eq_relate' with "[$]"); auto) || iApply (test_order_relate' with "[$]")).
+  - inv TC2; rewrite Ht in Hty2; try discriminate.
+    destruct (eval_expr e2 rho) eqn: Hv; try contradiction.
+    destruct b; try discriminate; rewrite /Cop.sem_cmp /sem_cmp /sem_cmp_pi; simpl; rewrite -H0 /=; unfold_lift;
+      rewrite Ht Hv sem_cast_int_intptr_lemma /tc_int_or_ptr_type !tc_bool_e ?negb_true_iff /=; iDestruct "H" as "(-> & H & %)";
+      first [rewrite test_eq_fiddle_signed_xx; iApply (test_eq_relate' with "[$]"); auto |
+       rewrite test_order_fiddle_signed_xx; iApply (test_order_relate' with "[$]")].
+  - inv TC1; rewrite Ht in Hty1; try discriminate.
+    destruct (eval_expr e1 rho) eqn: Hv; try contradiction.
+    destruct b; try discriminate; rewrite /Cop.sem_cmp /sem_cmp /sem_cmp_ip; simpl; rewrite -H0 /=; unfold_lift;
+      rewrite Ht Hv sem_cast_int_intptr_lemma /tc_int_or_ptr_type !tc_bool_e ?negb_true_iff /=; iDestruct "H" as "(-> & H & %)";
+      first [rewrite test_eq_fiddle_signed_yy; iApply (test_eq_relate' with "[$]"); auto |
+       rewrite test_order_fiddle_signed_yy; iApply (test_order_relate' with "[$]")].
+  - inv TC2; rewrite Ht in Hty2; try destruct sz; inv Hty2.
+    destruct (typeof e2) eqn: Ht2; try destruct i; inv Ht.
+    destruct (eval_expr e2 rho) eqn: Hv; try contradiction.
+    destruct b; try discriminate; rewrite /Cop.sem_cmp /sem_cmp /sem_cmp_pl; simpl; rewrite -H0 /=; unfold_lift;
+      rewrite Ht2 Hv sem_cast_long_intptr_lemma /tc_int_or_ptr_type !tc_bool_e ?negb_true_iff /=; iDestruct "H" as "(-> & H & %)";
+      ((iApply (test_eq_relate' with "[$]"); auto) || iApply (test_order_relate' with "[$]")).
+  - inv TC1; rewrite Ht in Hty1; try destruct sz; inv Hty1.
+    destruct (typeof e1) eqn: Ht1; try destruct i; inv Ht.
+    destruct (eval_expr e1 rho) eqn: Hv; try contradiction.
+    destruct b; try discriminate; rewrite /Cop.sem_cmp /sem_cmp /sem_cmp_pl; simpl; rewrite -H0 /=; unfold_lift;
+      rewrite Ht1 Hv sem_cast_long_intptr_lemma /tc_int_or_ptr_type !tc_bool_e ?negb_true_iff /=; iDestruct "H" as "(-> & H & %)";
+      ((iApply (test_eq_relate' with "[$]"); auto) || iApply (test_order_relate' with "[$]")).
+  - rewrite Heval /=; rewrite -!tc_val_tc_val_PM' in TC1 TC2; destruct b; try discriminate; rewrite /Cop.sem_cmp /sem_cmp in Heval |- *; simpl; rewrite /= -!H0 /= in Heval |- *; unfold_lift;
+      rewrite !tc_bool_e /=; iDestruct "H" as %?; iPureIntro;
+      destruct (typeof e1); try discriminate; destruct (typeof e2); try discriminate;
+      apply sem_binarith_relate; rewrite ?bool2val_eq; auto; simpl in *; try discriminate; try (destruct i; discriminate); try (destruct i0; discriminate).
+Qed.
+
+Lemma sem_div_relate : forall {CS} e1 e2 ty m rho
+  (TC1 : tc_val (typeof e1) (eval_expr(CS := CS) e1 rho))
+  (TC2 : tc_val (typeof e2) (eval_expr e2 rho)),
+  denote_tc_assert (isBinOpResultType Odiv e1 e2 ty) rho ⊢
+  ⌜sem_binary_operation cenv_cs Odiv (eval_expr e1 rho) (typeof e1) (eval_expr e2 rho) (typeof e2) m =
+   Some (eval_binop Odiv (typeof e1) (typeof e2) (eval_expr e1 rho) (eval_expr e2 rho))⌝.
+Proof.
+  intros.
+  iIntros "H"; iDestruct (typecheck_binop_sound with "H") as %TC; [done..|].
+  rewrite /eval_binop /force_val2 in TC |- *.
+  destruct (sem_binary_operation' _ _ _ _ _) eqn: Heval; last by apply tc_val_Vundef in TC.
+  rewrite /sem_binary_operation' in Heval.
+  rewrite den_isBinOpR /= /sem_binary_operation.
+  forget (op_result_type (Ebinop Odiv e1 e2 ty)) as err.
+  forget (arg_type (Ebinop Odiv e1 e2 ty)) as err0.
+  pose proof (classify_binarith_reflect (typeof e1) (typeof e2)) as Hclass.
+  rewrite !tc_val_tc_val_PM' in TC1 TC2.
+  rewrite /Cop.sem_div /sem_div in Heval |- *.
+  inv Hclass; try iDestruct "H" as "[]";
+  repeat match goal with
+  | H : stupid_typeconv ?t = Tint _ _ _, Hty : tc_val_PM' ?t _ |- _ => inv Hty; rewrite ?Ht ?Ht0 in H; inv H
+  | H : stupid_typeconv ?t = Tlong _ _, Hty : tc_val_PM' ?t _ |- _ => destruct t eqn: ?Ht; try destruct i; inv H; inv Hty; try discriminate;
+      try match goal with H: stupid_typeconv (Tlong _ _) = Tlong _ _ |- _ => inv H end
+  | H : stupid_typeconv ?t = Tfloat _ _, Hty : tc_val_PM' ?t _ |- _ => destruct t eqn: ?Ht; try destruct i; inv H; inv Hty; try discriminate;
+      try match goal with H: stupid_typeconv (Tfloat _ _) = Tfloat _ _ |- _ => inv H end
+  | H : stupid_typeconv ?t = Tpointer _ _, Hty : tc_val_PM' ?t _ |- _ =>
+      inv Hty; rewrite ?Ht ?Ht0 in H; simpl in H; try match goal with H : match ?sz with _ => _ end = Tpointer _ _ |- _=> destruct sz end; inv H
+  end;
+  rewrite ?Ht ?Ht0 in H0 |- *;
+  repeat match goal with
+  | H: eqb_type _ _ = _ |- _ => rewrite -> H in *; clear H
+  | H: typecheck_error _ |- _ => contradiction H
+  | H: andb _ _ = true |- _ => rewrite andb_true_iff in H; destruct H
+  | H: isptr ?A |- _ => destruct (isptr_e H) as [?b [?ofs ?He]]; clear H
+  | H: is_int _ _ ?A |- _ => destruct (is_int_e' H) as [?i ?He]; clear H
+  | H: is_long ?A |- _ =>  destruct (is_long_e H) as [?i ?He]; clear H
+  | H: is_single ?A |- _ => destruct (is_single_e H) as [?f ?He]; clear H
+  | H: is_float ?A |- _ => destruct (is_float_e H) as [?f ?He]; clear H
+  | H: is_true (sameblock _ _) |- _ => apply sameblock_eq_block in H; subst;
+                                                          rewrite ?eq_block_lem'
+  | H: is_numeric_type _ = true |- _  => inv H
+  end; rewrite ?He ?He0; try destruct s; try destruct s1; try destruct s2; repeat rewrite -denote_tc_assert_andp' denote_tc_assert_andp; simpl; unfold_lift; rewrite ?He ?He0 ?denote_tc_nodivover_e' ?denote_tc_nonzero_e' ?(denote_tc_nodivover_e64_li' sg)
+    ?denote_tc_nodivover_e64_ll' ?denote_tc_nonzero_e64' ?tc_bool_e /Cop.sem_binarith classify_binarith_eq;
+  rewrite /sem_binarith classify_binarith_eq ?Ht ?Ht0 ?He ?He0 /both_int /both_long /both_single /both_float in Heval; rewrite -!H0 /binarith_type in Heval |- *; unfold_lift;
+  destruct Archi.ptr64 eqn: Hp; try discriminate;
+  rewrite -> ?sem_cast_relate, ?sem_cast_relate_long, ?sem_cast_relate_int_long;
+  rewrite -> ?sem_cast_int_lemma, ?sem_cast_long_lemma, ?sem_cast_int_long_lemma;
+  rewrite ?denote_tc_nodivover_e64_il';
+  try (iDestruct "H" as %?; iPureIntro; repeat match goal with H : _ /\ _ |- _ => let H1 := fresh "H" in let H2 := fresh "H" in destruct H as [H1 H2]; rewrite ?H1 ?H2 end;
+    rewrite -> ?Int64_eq_repr_int_nonzero' by auto; auto).
+Qed.
+
+Lemma sem_mod_relate : forall {CS} e1 e2 ty m rho
+  (TC1 : tc_val (typeof e1) (eval_expr(CS := CS) e1 rho))
+  (TC2 : tc_val (typeof e2) (eval_expr e2 rho)),
+  denote_tc_assert (isBinOpResultType Omod e1 e2 ty) rho ⊢
+  ⌜sem_binary_operation cenv_cs Omod (eval_expr e1 rho) (typeof e1) (eval_expr e2 rho) (typeof e2) m =
+   Some (eval_binop Omod (typeof e1) (typeof e2) (eval_expr e1 rho) (eval_expr e2 rho))⌝.
+Proof.
+  intros.
+  iIntros "H"; iDestruct (typecheck_binop_sound with "H") as %TC; [done..|].
+  rewrite /eval_binop /force_val2 in TC |- *.
+  destruct (sem_binary_operation' _ _ _ _ _) eqn: Heval; last by apply tc_val_Vundef in TC.
+  rewrite /sem_binary_operation' in Heval.
+  rewrite den_isBinOpR /= /sem_binary_operation.
+  forget (op_result_type (Ebinop Omod e1 e2 ty)) as err.
+  forget (arg_type (Ebinop Omod e1 e2 ty)) as err0.
+  pose proof (classify_binarith_reflect (typeof e1) (typeof e2)) as Hclass.
+  rewrite !tc_val_tc_val_PM' in TC1 TC2.
+  rewrite /Cop.sem_mod /sem_mod in Heval |- *.
+  inv Hclass; try iDestruct "H" as "[]";
+  repeat match goal with
+  | H : stupid_typeconv ?t = Tint _ _ _, Hty : tc_val_PM' ?t _ |- _ => inv Hty; rewrite ?Ht ?Ht0 in H; inv H
+  | H : stupid_typeconv ?t = Tlong _ _, Hty : tc_val_PM' ?t _ |- _ => destruct t eqn: ?Ht; try destruct i; inv H; inv Hty; try discriminate;
+      try match goal with H: stupid_typeconv (Tlong _ _) = Tlong _ _ |- _ => inv H end
+  | H : stupid_typeconv ?t = Tfloat _ _, Hty : tc_val_PM' ?t _ |- _ => destruct t eqn: ?Ht; try destruct i; inv H; inv Hty; try discriminate;
+      try match goal with H: stupid_typeconv (Tfloat _ _) = Tfloat _ _ |- _ => inv H end
+  | H : stupid_typeconv ?t = Tpointer _ _, Hty : tc_val_PM' ?t _ |- _ =>
+      inv Hty; rewrite ?Ht ?Ht0 in H; simpl in H; try match goal with H : match ?sz with _ => _ end = Tpointer _ _ |- _=> destruct sz end; inv H
+  end;
+  rewrite ?Ht ?Ht0 in H0 |- *;
+  repeat match goal with
+  | H: eqb_type _ _ = _ |- _ => rewrite -> H in *; clear H
+  | H: typecheck_error _ |- _ => contradiction H
+  | H: andb _ _ = true |- _ => rewrite andb_true_iff in H; destruct H
+  | H: isptr ?A |- _ => destruct (isptr_e H) as [?b [?ofs ?He]]; clear H
+  | H: is_int _ _ ?A |- _ => destruct (is_int_e' H) as [?i ?He]; clear H
+  | H: is_long ?A |- _ =>  destruct (is_long_e H) as [?i ?He]; clear H
+  | H: is_single ?A |- _ => destruct (is_single_e H) as [?f ?He]; clear H
+  | H: is_float ?A |- _ => destruct (is_float_e H) as [?f ?He]; clear H
+  | H: is_true (sameblock _ _) |- _ => apply sameblock_eq_block in H; subst;
+                                                          rewrite ?eq_block_lem'
+  | H: is_numeric_type _ = true |- _  => inv H
+  end; rewrite ?He ?He0; try destruct s; try destruct s1; try destruct s2; repeat rewrite -denote_tc_assert_andp' denote_tc_assert_andp; simpl; unfold_lift; rewrite ?He ?He0 ?denote_tc_nodivover_e' ?denote_tc_nonzero_e' ?(denote_tc_nodivover_e64_li' sg)
+    ?denote_tc_nodivover_e64_ll' ?denote_tc_nonzero_e64' ?tc_bool_e /Cop.sem_binarith classify_binarith_eq;
+  rewrite /sem_binarith classify_binarith_eq ?Ht ?Ht0 ?He ?He0 /both_int /both_long /both_single /both_float in Heval; rewrite -!H0 /binarith_type in Heval |- *; unfold_lift;
+  destruct Archi.ptr64 eqn: Hp; try discriminate;
+  rewrite -> ?sem_cast_relate, ?sem_cast_relate_long, ?sem_cast_relate_int_long;
+  rewrite -> ?sem_cast_int_lemma, ?sem_cast_long_lemma, ?sem_cast_int_long_lemma;
+  rewrite ?denote_tc_nodivover_e64_il';
+  try (iDestruct "H" as %?; iPureIntro; repeat match goal with H : _ /\ _ |- _ => let H1 := fresh "H" in let H2 := fresh "H" in destruct H as [H1 H2]; rewrite ?H1 ?H2 end;
+    rewrite -> ?Int64_eq_repr_int_nonzero' by auto; auto).
+Qed.
+
+Global Instance binop_eq_dec : EqDec Cop.binary_operation.
+Proof. hnf. decide equality. Qed.
+
+Lemma eval_binop_relate':
+ forall {CS: compspecs} (ge: genv) te ve rho b e1 e2 t m
+    (Hcenv: cenv_sub (@cenv_cs CS) (genv_cenv ge))
+    (H1: Clight.eval_expr ge ve te m e1 (eval_expr e1 rho))
+    (H2: Clight.eval_expr ge ve te m e2 (eval_expr e2 rho))
+    (TC1 : tc_val (typeof e1) (eval_expr e1 rho))
+    (TC2 : tc_val (typeof e2) (eval_expr e2 rho)),
+  mem_auth m ∗ denote_tc_assert (isBinOpResultType b e1 e2 t) rho ⊢
+⌜Clight.eval_expr ge ve te m (Ebinop b e1 e2 t)
+  (force_val2 (sem_binary_operation' b (typeof e1) (typeof e2))
+     (eval_expr e1 rho) (eval_expr e2 rho))⌝.
+Proof.
+intros; iIntros "[Hm H]".
+iDestruct (sem_binary_operation_stable CS (genv_cenv ge) with "H") as %Hstable.
+{ clear - Hcenv.
+hnf in Hcenv.
+intros.
+specialize (Hcenv id). hnf in Hcenv. rewrite H in Hcenv. auto.
+}
+rewrite -bi.pure_mono'; [|econstructor; [apply H1 | apply H2 | apply Hstable; eassumption]].
+clear - TC1 TC2.
+destruct (is_comparison b) eqn: Hcmp.
+{ by iApply (sem_cmp_relate with "[$]"). }
+destruct (eq_dec b Odiv).
+{ by subst; iApply (sem_div_relate with "H"). }
+destruct (eq_dec b Omod).
+{ by subst; iApply (sem_mod_relate with "H"). }
+iDestruct (typecheck_binop_sound b rho e1 e2 with "H") as %TC; [done..|].
+rewrite /eval_binop /force_val2 in TC |- *.
+destruct (sem_binary_operation' _ _ _ _ _) eqn: Heval; last by apply tc_val_Vundef in TC.
+rewrite /sem_binary_operation' in Heval.
+rewrite -(force_val_Some _ _ Heval) /=.
+rewrite den_isBinOpR /=.
+forget (op_result_type (Ebinop b e1 e2 t)) as err.
+forget (arg_type (Ebinop b e1 e2 t)) as err0.
+cbv beta iota zeta delta [
+  sem_binary_operation sem_binary_operation' 
+   binarithType'
+ ] in Heval |- *.
+destruct b; try discriminate; try contradiction;
+repeat lazymatch goal with
+| |-context [classify_add'] => pose proof (classify_add_reflect (typeof e1) (typeof e2)) as Hrel; inv Hrel;
+   match goal with H : _ = classify_add' _ _ |- _ => let C := fresh "C" in symmetry in H; rename H into C end
+| |-context [classify_sub'] => pose proof (classify_sub_reflect (typeof e1) (typeof e2)) as Hrel; inv Hrel;
+   match goal with H : _ = classify_sub' _ _ |- _ => let C := fresh "C" in symmetry in H; rename H into C end
+| |-context [classify_binarith'] => 
+   pose proof (classify_binarith_rel (typeof e1) (typeof e2)) as Hrel; inv Hrel;
+   match goal with H : _ = classify_binarith' _ _ |- _ => let C := fresh "C" in symmetry in H; rename H into C end;
+   try destruct s
+| |-context [classify_shift'] => pose proof (classify_shift_reflect (typeof e1) (typeof e2)) as Hrel; inv Hrel;
+   match goal with H : _ = classify_shift' _ _ |- _ => let C := fresh "C" in symmetry in H; rename H into C end
+| |-context [classify_cmp'] => pose proof (classify_cmp_reflect (typeof e1) (typeof e2)) as Hrel; inv Hrel;
+   match goal with H : _ = classify_cmp' _ _ |- _ => let C := fresh "C" in symmetry in H; rename H into C end
+| _ => idtac
+end;
+simpl; rewrite ?tc_andp_sound /=; super_unfold_lift;
+unfold tc_int_or_ptr_type in *; rewrite ?tc_bool_e;
+forget (eval_expr e1 rho) as v1;
+forget (eval_expr e2 rho) as v2;
+try clear rho;
+try clear err err0;
+try rewrite <- ?classify_add_eq, <- ?classify_sub_eq, <- ?classify_cmp_eq, <- ?classify_shift_eq, <- ?classify_binarith_eq in *;
+ rewrite -> ?sem_cast_long_intptr_lemma in *;
+ rewrite -> ?sem_cast_int_intptr_lemma in *;
+  cbv beta iota zeta delta [
+  sem_binary_operation sem_binary_operation' 
+   Cop.sem_add sem_add Cop.sem_sub sem_sub Cop.sem_div
+   Cop.sem_mod sem_mod Cop.sem_shl Cop.sem_shift 
+   sem_shl sem_shift sem_add_ptr_long sem_add_ptr_int
+   sem_add_long_ptr sem_add_int_ptr
+   Cop.sem_shr sem_shr Cop.sem_cmp sem_cmp
+   sem_cmp_pp sem_cmp_pl sem_cmp_lp
+   binarith_type 
+   sem_shift_ii sem_shift_ll sem_shift_il sem_shift_li
+    sem_sub_pp sem_sub_pi sem_sub_pl 
+   force_val2 typeconv remove_attributes change_attributes
+   sem_add_ptr_int force_val both_int both_long force_val2
+    Cop.sem_add_ptr_int
+ ] in Heval |- *;
+ try rewrite C in Heval |- *; try rewrite C0 in Heval |- *; try rewrite C1 in Heval |- *;
+ try (iDestruct "H" as %?);
+ repeat match goal with
+            | H: _ /\ _ |- _ => destruct H
+            | H: complete_type _ _ = _ |- _ => rewrite H; clear H
+            | H: negb (eqb_type ?A ?B) = true |- _ =>
+                rewrite negb_true_iff in H; try rewrite H in *
+            | H: eqb_type _ _ = _ |- _ => rewrite H
+            end;
+ try clear CS; try clear m;
+ try contradiction;
+ try solve [destruct (classify_binarith _ _) eqn: Hbin; rewrite Heval; try iDestruct "H" as "([] & _)";
+     iPureIntro; apply sem_binarith_relate; auto; destruct (typeof e1); try discriminate; destruct (typeof e2); try discriminate;
+     simpl in *; auto; try discriminate; try destruct s; try destruct s0; try discriminate; try (destruct i; discriminate); try (destruct i0; discriminate); try (destruct f; discriminate)];
+(* unfold Cop.sem_binarith, sem_binarith in *;
+ try match goal with
+ | |-context [classify_binarith] => destruct (classify_binarith (typeof e1) (typeof e2)) eqn:?C; try destruct s
+ end;
+ simpl; super_unfold_lift; rewrite ?tc_bool_e; try (iDestruct "H" as "[H %]"); *)
+ rewrite !tc_val_tc_val_PM' in TC1, TC2;
+ try match goal with
+ | H : stupid_typeconv ?t = Tint _ _ _, Hty : tc_val_PM' ?t _ |- _ => inv Hty; rewrite Ht in H; inv H
+ | H : stupid_typeconv ?t = Tlong _ _, Hty : tc_val_PM' ?t _ |- _ => destruct t; try destruct i; inv H; inv Hty; try discriminate
+ | H : stupid_typeconv ?t = Tpointer _ _, Hty : tc_val_PM' ?t _ |- _ =>
+     inv Hty; rewrite Ht in H; simpl in H; try match goal with H : match ?sz with _ => _ end = Tpointer _ _ |- _ => destruct sz end; inv H
+ end;
+ try match goal with
+ | H : stupid_typeconv ?t = Tint _ _ _, Hty : tc_val_PM' _ _ |- _ => inv Hty; rewrite Ht in H; inv H
+ | H : stupid_typeconv ?t = Tlong _ _, Hty : tc_val_PM' _ _ |- _ => destruct t; try destruct i; inv H; inv Hty; try discriminate
+ | H : stupid_typeconv ?t = Tpointer _ _, Hty : tc_val_PM' _ _ |- _ =>
+     inv Hty; rewrite ?Ht ?Ht0 in H; simpl in H; try match goal with H : match ?sz with _ => _ end = Tpointer _ _ |- _=> destruct sz end; inv H
+ end;
+ rewrite ?Ht ?Ht0;
+ repeat match goal with
+ | H: eqb_type _ _ = _ |- _ => rewrite -> H in *; clear H
+ | H: typecheck_error _ |- _ => contradiction H
+ | H: andb _ _ = true |- _ => rewrite andb_true_iff in H; destruct H
+ | H: isptr ?A |- _ => destruct (isptr_e H) as [?b [?ofs ?]]; clear H; subst A
+ | H: is_int _ _ ?A |- _ => destruct (is_int_e' H) as [?i ?]; clear H; subst A
+ | H: is_long ?A |- _ =>  destruct (is_long_e H) as [?i ?]; clear H; subst A
+ | H: is_single ?A |- _ => destruct (is_single_e H) as [?f ?]; clear H; subst A
+ | H: is_float ?A |- _ => destruct (is_float_e H) as [?f ?]; clear H; subst A
+ | H: is_true (sameblock _ _) |- _ => apply sameblock_eq_block in H; subst;
+                                                         rewrite ?eq_block_lem'
+ | H: is_numeric_type _ = true |- _  => inv H
+ end; try done;
+ rewrite ?bool2val_eq;
+ try done;
+ rewrite -> ?sem_cast_long_intptr_lemma in *;
+ rewrite -> ?sem_cast_int_intptr_lemma in *;
+ rewrite -> ?sem_cast_relate, ?sem_cast_relate_long, ?sem_cast_relate_int_long;
+ rewrite -> ?sem_cast_int_lemma, ?sem_cast_long_lemma, ?sem_cast_int_long_lemma;
+ rewrite -> ?if_true by auto;
+ rewrite -> ?sizeof_range_true by auto;
+ rewrite ?denote_tc_igt_e' ?denote_tc_lgt_e';
+ rewrite -> ?cast_int_long_nonzero by eassumption;
+ rewrite -> ?(proj2 (eqb_type_false _ _)) by auto 1;
+ repeat match goal with H: (if ?A then _ else _) = Some _ |- _ => destruct A eqn: ?Hcond; try discriminate end;
+ try (iDestruct "H" as "(-> & %)"; iPureIntro);
+ try done; try solve [destruct v1; inv Heval; auto].
+Qed.
+
+End mpred.
diff --git a/veric/binop_lemmas2.v b/veric/binop_lemmas2.v
index 2853df8a74..6f01d83f8d 100644
--- a/veric/binop_lemmas2.v
+++ b/veric/binop_lemmas2.v
@@ -1,13 +1,13 @@
-Require Import VST.msl.msl_standard.
 Require Import VST.veric.Clight_base.
-Require Import VST.veric.compcert_rmaps.
 Require Import VST.veric.Clight_lemmas.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Import VST.veric.res_predicates.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.mpred.
 Require Import VST.veric.tycontext.
 Require Import VST.veric.expr2.
 Require Import VST.veric.Clight_Cop2.
 Import Cop.
-Import compcert.lib.Maps.
 
 Lemma eval_expr_any:
   forall {CS: compspecs} rho e v,
@@ -49,13 +49,13 @@ Proof.
    try destruct u;
    destruct (typeof e) as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ];
    try reflexivity
-  | rewrite (IHe _ (eq_refl _)) by congruence; auto ..
+  | rewrite -> (IHe _ (eq_refl _)) by congruence; auto ..
   ].
   simpl. unfold Cop2.bool_val; simple_if_tac; reflexivity.
 *
   destruct (eval_expr e1 any_environ) eqn:?; simpl in *;
   [ exfalso; apply H0; clear
-  | rewrite (IHe1 _ (eq_refl _)) by congruence; auto .. ].
+  | rewrite -> (IHe1 _ (eq_refl _)) by congruence; auto .. ].
  {
   destruct b;
    destruct (typeof e1) as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ];
@@ -83,7 +83,7 @@ Proof.
  }
 all:  destruct (eval_expr e2 any_environ) eqn:?; simpl in *;
   [ exfalso; apply H0; clear
-  | rewrite (IHe2 _ (eq_refl _)) by congruence; auto .. ];
+  | rewrite -> (IHe2 _ (eq_refl _)) by congruence; auto .. ];
    destruct b;
    destruct (typeof e1) as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ];
    destruct (typeof e2) as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ];
@@ -111,12 +111,12 @@ all:  destruct (eval_expr e2 any_environ) eqn:?; simpl in *;
    destruct (typeof e) as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ];
   (destruct (eval_expr e any_environ) eqn:?; simpl in *;
   [exfalso; apply H0; clear
-  | try rewrite (IHe _ (eq_refl _)) by congruence;
+  | try rewrite -> (IHe _ (eq_refl _)) by congruence;
      auto .. ]); auto;
   try (unfold Clight_Cop2.sem_cast, Clight_Cop2.classify_cast; repeat simple_if_tac; reflexivity).
 * destruct (typeof e) as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ];
    simpl in *; unfold always; auto;
-   destruct (cenv_cs ! i0) as [co |]; auto.
+   destruct (cenv_cs !! i0) as [co |]; auto.
  -
    destruct (field_offset cenv_cs i (co_members co)) as [[? [|]]|]; auto.
    f_equal.
@@ -126,7 +126,7 @@ all:  destruct (eval_expr e2 any_environ) eqn:?; simpl in *;
    destruct (union_field_offset cenv_cs i (co_members co)) as [[? [|]]|]; auto.
    destruct (eval_lvalue e any_environ) eqn:?; simpl in *;
    try congruence.
-   rewrite (eval_lvalue_any _ _ _ _ Heqv); auto. congruence.
+   rewrite (eval_lvalue_any _ _ _ _ Heqv); auto.
 }
 { clear eval_lvalue_any.
  intro.
@@ -138,7 +138,7 @@ all:  destruct (eval_expr e2 any_environ) eqn:?; simpl in *;
   apply eval_expr_any; auto.
   * destruct (typeof e) as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ];
     simpl in *; unfold always; auto;
-    destruct (cenv_cs ! i0) as [co |]; auto.
+    destruct (cenv_cs !! i0) as [co |]; auto.
    -
     destruct (field_offset cenv_cs i (co_members co)) as [[? [|]]|]; auto.
     f_equal.
@@ -148,15 +148,18 @@ all:  destruct (eval_expr e2 any_environ) eqn:?; simpl in *;
     destruct (union_field_offset cenv_cs i (co_members co)) as [[? [|]]|]; auto.
     destruct (eval_lvalue e any_environ) eqn:?; simpl in *;
     try congruence.
-    rewrite (IHe _ (eq_refl _)); auto. congruence.
+    rewrite (IHe _ (eq_refl _)); auto.
 }
 Qed.
 
+Section mpred.
+
+Context `{!heapGS Σ}.
+
 Lemma denote_tc_assert_ilt':
-  forall {CS: compspecs} e j, denote_tc_assert (tc_ilt e j) = denote_tc_assert (tc_ilt' e j).
+  forall {CS: compspecs} e j rho, denote_tc_assert (tc_ilt e j) rho ⊣⊢ denote_tc_assert (tc_ilt' e j) rho.
 Proof.
   intros.
-extensionality rho.
  unfold tc_ilt; simpl.
  unfold_lift.
  destruct (eval_expr e any_environ) eqn:?; simpl; auto.
@@ -164,16 +167,15 @@ extensionality rho.
  rewrite Heqv; simpl.
  destruct (Int.ltu i j) eqn:?; simpl; 
  unfold_lift; simpl; rewrite ?Heqv; simpl; auto.
- apply pred_ext; intuition.
+ iSplit; auto; iPureIntro.
  apply Int.ltu_inv in Heqb.
- intros  ? ?. simpl. destruct Heqb. auto.
+ destruct Heqb. auto.
 Qed.
 
 Lemma denote_tc_assert_llt':
-  forall {CS: compspecs} e j, denote_tc_assert (tc_llt e j) = denote_tc_assert (tc_llt' e j).
+  forall {CS: compspecs} e j rho, denote_tc_assert (tc_llt e j) rho ⊣⊢ denote_tc_assert (tc_llt' e j) rho.
 Proof.
   intros.
-extensionality rho.
  unfold tc_llt; simpl.
  unfold_lift.
  destruct (eval_expr e any_environ) eqn:?; simpl; auto.
@@ -181,9 +183,9 @@ extensionality rho.
  rewrite Heqv; simpl.
  destruct (Int64.ltu i j) eqn:?; simpl; 
  unfold_lift; simpl; rewrite ?Heqv; simpl; auto.
- apply pred_ext; intuition.
+ iSplit; auto; iPureIntro.
  apply Int64.ltu_inv in Heqb.
- intros  ? ?. simpl. destruct Heqb. auto.
+ destruct Heqb. auto.
 Qed.
 
 Lemma tc_val_void:
@@ -192,7 +194,7 @@ Proof.
 destruct v; simpl; tauto.
 Qed.
 
-Definition denote_tc_assert' {CS: compspecs} (a: tc_assert) (rho: environ) : mpred.
+(*Definition denote_tc_assert' {CS: compspecs} (a: tc_assert) (rho: environ) : mpred.
 pose (P := denote_tc_assert a rho).
 unfold denote_tc_assert in P.
 super_unfold_lift.
@@ -204,7 +206,7 @@ Lemma denote_tc_assert'_eq{CS: compspecs}:
 Proof.
 extensionality a rho.
 destruct a; reflexivity.
-Qed.
+Qed.*)
 
 Lemma int_eq_true : forall x y,
 true = Int.eq x y -> x = y.
@@ -231,52 +233,39 @@ Proof. intros; unfold tc_andp.  destruct e; reflexivity. Qed.
 Lemma tc_andp_TT1:  forall e, tc_andp tc_TT e = e.
 Proof. intros; unfold tc_andp; reflexivity. Qed.
 
-Lemma tc_orp_sound : forall {CS: compspecs} a1 a2 rho m,
-    denote_tc_assert (tc_orp a1 a2) rho m <->
-    denote_tc_assert (tc_orp' a1 a2) rho m.
+Lemma tc_orp_sound : forall {CS: compspecs} a1 a2 rho,
+    denote_tc_assert (tc_orp a1 a2) rho ⊣⊢
+    denote_tc_assert (tc_orp' a1 a2) rho.
 Proof.
 intros.
  unfold tc_orp.
-  assert (forall a t, 
-  denote_tc_assert (tc_orp' a (tc_FF t)) rho m <-> denote_tc_assert a rho m)
-   by (intros; destruct a; simpl; unfold typecheck_error; tauto).
-  assert (forall a t, 
-  denote_tc_assert (tc_orp' (tc_FF t) a) rho m <-> denote_tc_assert a rho m)
-   by (intros; destruct a; simpl; unfold typecheck_error; tauto).
-  assert (forall a, 
-  denote_tc_assert (tc_orp' a tc_TT) rho m <-> denote_tc_assert tc_TT rho m)
-   by (intros; destruct a; simpl; unfold typecheck_error; tauto).
-  assert (forall a, 
-  denote_tc_assert (tc_orp' tc_TT a) rho m <-> denote_tc_assert tc_TT rho m)
-   by (intros; destruct a; simpl; unfold typecheck_error; tauto).
- destruct a1,a2; 
-  rewrite ?H, ?H0, ?H1, ?H2; apply iff_refl.
+ destruct a1,a2; simpl; unfold_lift;
+  rewrite ?bi.or_False ?bi.False_or ?bi.or_True ?bi.True_or; reflexivity.
 Qed.
 
 Lemma denote_tc_assert_orp: forall {CS: compspecs} x y rho,
-  denote_tc_assert (tc_orp x y) rho =
-   orp (denote_tc_assert x rho) (denote_tc_assert y rho).
+  denote_tc_assert (tc_orp x y) rho ⊣⊢
+  (denote_tc_assert x rho) ∨ (denote_tc_assert y rho).
 Proof.
- intros.
- apply pred_ext; intro m; rewrite tc_orp_sound; intro; assumption.
+ intros; apply tc_orp_sound.
 Qed.
 
-Lemma is_true_true: is_true true = True.
-Proof. apply prop_ext; intuition. Qed.
-Lemma is_true_false: is_true false = False.
-Proof. apply prop_ext; intuition. Qed.
+Lemma is_true_true: is_true true = True%type.
+Proof. apply Axioms.prop_ext; intuition. Qed.
+Lemma is_true_false: is_true false = False%type.
+Proof. apply Axioms.prop_ext; intuition. Qed.
 
 Lemma denote_tc_assert_iszero: forall {CS: compspecs} e rho,
   denote_tc_assert (tc_iszero e) rho =
   match (eval_expr e rho) with
-  | Vint i => prop (is_true (Int.eq i Int.zero))
-  | Vlong i => prop (is_true (Int64.eq i Int64.zero))
-   | _ => FF end.
+  | Vint i => ⌜is_true (Int.eq i Int.zero)⌝
+  | Vlong i => ⌜is_true (Int64.eq i Int64.zero)⌝
+   | _ => False end.
 Proof.
  intros.
  unfold tc_iszero.
  destruct (eval_expr e any_environ) eqn:?; simpl; auto;
- rewrite (eval_expr_any rho e _ Heqv) by congruence.
+ rewrite -> (eval_expr_any rho e _ Heqv) by congruence.
  destruct (Int.eq i Int.zero); reflexivity.
  destruct (Int64.eq i Int64.zero); reflexivity.
 Qed.
@@ -291,42 +280,41 @@ reflexivity.
 Qed.
 
 Lemma denote_tc_assert_nonzero: forall {CS: compspecs} e rho,
-  denote_tc_assert (tc_nonzero e) rho =
+  denote_tc_assert (tc_nonzero e) rho ⊣⊢
   match (eval_expr e rho) with
-  | Vint i => prop (i <> Int.zero)
-  | Vlong i =>prop (i <> Int64.zero)
-  | _ => FF end.
+  | Vint i => ⌜i <> Int.zero⌝
+  | Vlong i =>⌜i <> Int64.zero⌝
+  | _ => False end.
 Proof.
   intros.
   unfold tc_nonzero.
   destruct (eval_expr e any_environ) eqn:?; simpl; auto;
-  try rewrite (eval_expr_any rho e _ Heqv) by congruence;
+  try rewrite -> (eval_expr_any rho e _ Heqv) by congruence;
   unfold_lift.
   + destruct (Int.eq i Int.zero) eqn:?; simpl; unfold_lift; unfold denote_tc_nonzero; simpl;
-         rewrite ?(eval_expr_any rho e _ Heqv) by congruence; auto.
-         apply pred_ext; auto; intros ? ? ?; subst; inv Heqb.
+         rewrite -> ?(eval_expr_any rho e _ Heqv) by congruence; auto.
+         iSplit; auto; iPureIntro; intros ? ->; inv Heqb.
   + destruct (Int64.eq i Int64.zero) eqn:?; simpl; unfold_lift; unfold denote_tc_nonzero; simpl;
-         rewrite ?(eval_expr_any rho e _ Heqv) by congruence; auto.
-         apply pred_ext; auto; intros ? ? ?; subst; inv Heqb.
+         rewrite -> ?(eval_expr_any rho e _ Heqv) by congruence; auto.
+         iSplit; auto; iPureIntro; intros ? ->; inv Heqb.
 Qed.
 
-Lemma denote_tc_assert_nonzero': forall {CS: compspecs} e,
-  denote_tc_assert (tc_nonzero e) = denote_tc_assert (tc_nonzero' e).
+Lemma denote_tc_assert_nonzero': forall {CS: compspecs} e rho,
+  denote_tc_assert (tc_nonzero e) rho ⊣⊢ denote_tc_assert (tc_nonzero' e) rho.
 Proof.
 intros.
-extensionality rho.
 rewrite denote_tc_assert_nonzero.
-simpl.  unfold_lift. destruct (eval_expr e rho); simpl; auto.
+simpl. unfold_lift. destruct (eval_expr e rho); simpl; auto.
 Qed.
 
 Lemma denote_tc_assert_nodivover: forall {CS: compspecs} e1 e2 rho,
-  denote_tc_assert (tc_nodivover e1 e2) rho =
+  denote_tc_assert (tc_nodivover e1 e2) rho ⊣⊢
          match eval_expr e1 rho, eval_expr e2 rho with
-          | Vint n1, Vint n2 => prop (~(n1 = Int.repr Int.min_signed /\ n2 = Int.mone))
-          | Vlong n1, Vlong n2 => prop (~(n1 = Int64.repr Int64.min_signed /\ n2 = Int64.mone))
-          | Vint n1, Vlong n2 => TT
-          | Vlong n1, Vint n2 => prop (~ (n1 = Int64.repr Int64.min_signed  /\ n2 = Int.mone))
-          | _ , _ => FF
+          | Vint n1, Vint n2 => ⌜~(n1 = Int.repr Int.min_signed /\ n2 = Int.mone)⌝
+          | Vlong n1, Vlong n2 => ⌜~(n1 = Int64.repr Int64.min_signed /\ n2 = Int64.mone)⌝
+          | Vint n1, Vlong n2 => True
+          | Vlong n1, Vint n2 => ⌜~ (n1 = Int64.repr Int64.min_signed  /\ n2 = Int.mone)⌝
+          | _ , _ => False
         end.
 Proof.
   intros.
@@ -334,65 +322,64 @@ Proof.
   destruct (eval_expr e1 any_environ) eqn:?;
   destruct (eval_expr e2 any_environ) eqn:?;
   simpl; auto;
-    rewrite (eval_expr_any rho e1 _ Heqv) by congruence;
-    rewrite (eval_expr_any rho e2 _ Heqv0) by congruence;
+    rewrite -> (eval_expr_any rho e1 _ Heqv) by congruence;
+    rewrite -> (eval_expr_any rho e2 _ Heqv0) by congruence;
     auto.
  +
     destruct (negb (Int.eq i (Int.repr Int.min_signed) && Int.eq i0 Int.mone)) eqn:?.
-    simpl; unfold_lift; apply pred_ext; auto; intros ? ? [? ?]; subst; inv Heqb.
+    simpl; unfold_lift; iSplit; auto; iPureIntro; intros ? [? ?]; subst; inv Heqb.
     simpl; unfold_lift; 
-    rewrite (eval_expr_any rho e1 _ Heqv) by congruence;
-    rewrite (eval_expr_any rho e2 _ Heqv0) by congruence; reflexivity.
+    rewrite -> (eval_expr_any rho e1 _ Heqv) by congruence;
+    rewrite -> (eval_expr_any rho e2 _ Heqv0) by congruence; reflexivity.
  +
     destruct (negb (Int64.eq i (Int64.repr Int64.min_signed) && Int.eq i0 Int.mone)) eqn:?.
-    simpl; unfold_lift; apply pred_ext; auto; intros ? ? [? ?]; subst; inv Heqb.
+    simpl; unfold_lift; iSplit; auto; iPureIntro; intros ? [? ?]; subst; inv Heqb.
     simpl; unfold_lift; 
-    rewrite (eval_expr_any rho e1 _ Heqv) by congruence;
-    rewrite (eval_expr_any rho e2 _ Heqv0) by congruence; reflexivity.
+    rewrite -> (eval_expr_any rho e1 _ Heqv) by congruence;
+    rewrite -> (eval_expr_any rho e2 _ Heqv0) by congruence; reflexivity.
  +
     destruct (negb (Int64.eq i (Int64.repr Int64.min_signed) && Int64.eq i0 Int64.mone)) eqn:?.
-    simpl; unfold_lift; apply pred_ext; auto; intros ? ? [? ?]; subst; inv Heqb.
+    simpl; unfold_lift; iSplit; auto; iPureIntro; intros ? [? ?]; subst; inv Heqb.
     simpl; unfold_lift; 
-    rewrite (eval_expr_any rho e1 _ Heqv) by congruence;
-    rewrite (eval_expr_any rho e2 _ Heqv0) by congruence; reflexivity.
+    rewrite -> (eval_expr_any rho e1 _ Heqv) by congruence;
+    rewrite -> (eval_expr_any rho e2 _ Heqv0) by congruence; reflexivity.
 Qed.
 
-Lemma denote_tc_assert_nodivover': forall {CS: compspecs} e1 e2,
-  denote_tc_assert (tc_nodivover e1 e2) = denote_tc_assert (tc_nodivover' e1 e2).
+Lemma denote_tc_assert_nodivover': forall {CS: compspecs} e1 e2 rho,
+  denote_tc_assert (tc_nodivover e1 e2) rho ⊣⊢ denote_tc_assert (tc_nodivover' e1 e2) rho.
 Proof.
 intros.
-extensionality rho.
 rewrite denote_tc_assert_nodivover; reflexivity.
 Qed.
 
 Lemma denote_tc_assert_andp'':
   forall {CS: compspecs} a b rho, denote_tc_assert (tc_andp' a b) rho =
-            andp (denote_tc_assert a rho) (denote_tc_assert b rho).
+            ((denote_tc_assert a rho) ∧ (denote_tc_assert b rho)).
 Proof.
  intros. reflexivity. Qed.
 
 Lemma denote_tc_assert_orp'':
   forall {CS: compspecs} a b rho, denote_tc_assert (tc_orp' a b) rho =
-             orp (denote_tc_assert a rho) (denote_tc_assert b rho).
+             ((denote_tc_assert a rho) ∨ (denote_tc_assert b rho)).
 Proof.
  intros. reflexivity. Qed.
 
 Lemma denote_tc_assert_andp':
-  forall {CS: compspecs} a b, denote_tc_assert (tc_andp a b) =
-                        denote_tc_assert (tc_andp' a b).
-Proof. intros. extensionality rho. apply denote_tc_assert_andp. Qed.
+  forall {CS: compspecs} a b rho, denote_tc_assert (tc_andp a b) rho ⊣⊢
+                        denote_tc_assert (tc_andp' a b) rho.
+Proof. intros. apply denote_tc_assert_andp. Qed.
 
 Lemma denote_tc_assert_orp':
-  forall {CS: compspecs} a b, denote_tc_assert (tc_orp a b) =
-                        denote_tc_assert (tc_orp' a b).
-Proof. intros. extensionality rho. apply denote_tc_assert_orp. Qed.
+  forall {CS: compspecs} a b rho, denote_tc_assert (tc_orp a b) rho ⊣⊢
+                        denote_tc_assert (tc_orp' a b) rho.
+Proof. intros. apply denote_tc_assert_orp. Qed.
 
 Lemma denote_tc_assert_test_eq':
-  forall {CS: compspecs} a b,
-    denote_tc_assert (tc_test_eq a b) =
-    denote_tc_assert (tc_test_eq' a b).
+  forall {CS: compspecs} a b rho,
+    denote_tc_assert (tc_test_eq a b) rho ⊣⊢
+    denote_tc_assert (tc_test_eq' a b) rho.
 Proof.
-  intros; extensionality rho.
+  intros.
   unfold tc_test_eq.
   simpl; unfold_lift;  unfold denote_tc_test_eq.
  destruct (Val.eq (eval_expr a any_environ) Vundef);
@@ -405,59 +392,57 @@ Proof.
  destruct (eval_expr a rho) eqn:Ha; simpl; unfold_lift; try rewrite Ha;
   try reflexivity;
  destruct (eval_expr b rho) eqn:Hb; simpl; unfold_lift; 
-   rewrite ?Ha, ?Hb;
+   rewrite ?Ha ?Hb;
   try reflexivity.
 *
   destruct Archi.ptr64 eqn:Hp; simpl; unfold_lift.
   +
-  rewrite Ha,Hb; simpl; rewrite Hp; reflexivity.
+  rewrite Ha Hb; simpl; rewrite Hp; reflexivity.
   +
   pose proof (Int.eq_spec i Int.zero); destruct (Int.eq i Int.zero).
   pose proof (Int.eq_spec i0 Int.zero); destruct (Int.eq i0 Int.zero).
-  simpl. rewrite !prop_true_andp by auto.
-  unfold_lift. unfold TT. apply f_equal. apply prop_ext; intuition.
-  simpl. unfold_lift. rewrite Ha,Hb. simpl. rewrite Hp. auto.
-  simpl. unfold_lift. rewrite Ha,Hb. simpl. rewrite Hp. auto.
+  simpl. iSplit; auto.
+  simpl. unfold_lift. rewrite Ha Hb /= Hp. auto.
+  simpl. unfold_lift. rewrite Ha Hb /= Hp. auto.
 *
   destruct Archi.ptr64 eqn:Hp; simpl; unfold_lift.
   +
   pose proof (Int64.eq_spec i Int64.zero); destruct (Int64.eq i Int64.zero).
   pose proof (Int64.eq_spec i0 Int64.zero); destruct (Int64.eq i0 Int64.zero).
-  simpl. rewrite !prop_true_andp by auto.
-  unfold_lift. unfold TT. apply f_equal. apply prop_ext; intuition.
-  simpl. unfold_lift. rewrite Ha,Hb. simpl. rewrite Hp. auto.
-  simpl. unfold_lift. rewrite Ha,Hb. simpl. rewrite Hp. auto.
+  simpl. iSplit; auto.
+  simpl. unfold_lift. rewrite Ha Hb /= Hp. auto.
+  simpl. unfold_lift. rewrite Ha Hb /= Hp. auto.
  +
-  rewrite Ha,Hb; simpl; rewrite Hp; reflexivity.
+  rewrite Ha Hb /= Hp; reflexivity.
 Qed.
 
 Lemma denote_tc_assert_test_order':
-  forall {CS: compspecs} a b,
-    denote_tc_assert (tc_test_order a b) =
-    denote_tc_assert (tc_test_order' a b).
+  forall {CS: compspecs} a b rho,
+    denote_tc_assert (tc_test_order a b) rho ⊣⊢
+    denote_tc_assert (tc_test_order' a b) rho.
 Proof.
-  intros; extensionality rho.
+  intros.
   unfold tc_test_order.
   simpl; unfold_lift;  unfold denote_tc_test_order.
   destruct (eval_expr a rho) eqn:Ha;
   destruct (eval_expr a any_environ) eqn:Ha';
   simpl; unfold_lift;  unfold denote_tc_test_order;
-  rewrite ?Ha, ?Ha'; simpl; auto;
+  rewrite ?Ha ?Ha'; simpl; auto;
   try solve [
-    rewrite (eval_expr_any rho a _ Ha') in Ha by congruence;
+    rewrite -> (eval_expr_any rho a _ Ha') in Ha by congruence;
     inv Ha];
   destruct (eval_expr b rho) eqn:Hb;
   destruct (eval_expr b any_environ) eqn:Hb';
   simpl; unfold_lift;  unfold denote_tc_test_eq;
-  rewrite ?Ha, ?Ha', ?Hb, ?Hb'; simpl; auto;
-  rewrite (eval_expr_any rho b _ Hb') in Hb by congruence; inv Hb;
-  rewrite (eval_expr_any rho a _ Ha') in Ha by congruence; inv Ha.
+  rewrite ?Ha ?Ha' ?Hb ?Hb'; simpl; auto;
+  rewrite -> (eval_expr_any rho b _ Hb') in Hb by congruence; inv Hb;
+  rewrite -> (eval_expr_any rho a _ Ha') in Ha by congruence; inv Ha.
 *
   destruct Archi.ptr64 eqn:Hp.
  +
   simpl. unfold_lift.
-  rewrite (eval_expr_any rho b _ Hb') by congruence;
-  rewrite (eval_expr_any rho a _ Ha') by congruence.
+  rewrite -> (eval_expr_any rho b _ Hb') by congruence;
+  rewrite -> (eval_expr_any rho a _ Ha') by congruence.
   simpl. rewrite Hp. auto.
  +
   simpl. {
@@ -466,19 +451,16 @@ Proof.
     subst. rewrite Int.eq_true.
     destruct (Int.eq_dec i1 Int.zero).
     - subst. rewrite Int.eq_true.
-      simpl.
-      rewrite !prop_true_andp by auto.
-      super_unfold_lift.
-      unfold TT. f_equal. apply prop_ext; intuition.
-    - rewrite Int.eq_false by auto. simpl.
+      simpl. iSplit; auto.
+    - rewrite -> Int.eq_false by auto. simpl.
       simpl; unfold_lift;  unfold denote_tc_test_eq.
-      rewrite (eval_expr_any rho a _ Ha')  by congruence.
-      rewrite (eval_expr_any rho _ _ Hb')  by congruence.
+      rewrite -> (eval_expr_any rho a _ Ha')  by congruence.
+      rewrite -> (eval_expr_any rho _ _ Hb')  by congruence.
       simpl. rewrite Hp. auto.
-  + rewrite Int.eq_false by auto. simpl.
+  + rewrite -> Int.eq_false by auto. simpl.
     simpl; unfold_lift;  unfold denote_tc_test_eq.
-    rewrite (eval_expr_any rho a _ Ha')  by congruence.
-    rewrite (eval_expr_any rho _ _ Hb')  by congruence.
+    rewrite -> (eval_expr_any rho a _ Ha')  by congruence.
+    rewrite -> (eval_expr_any rho _ _ Hb')  by congruence.
     simpl. rewrite Hp.
     auto.
   }
@@ -491,64 +473,60 @@ Proof.
     subst. rewrite Int64.eq_true.
     destruct (Int64.eq_dec i1 Int64.zero).
     - subst. rewrite Int64.eq_true.
-      simpl.
-      rewrite !prop_true_andp by auto.
-      super_unfold_lift.
-      unfold TT. f_equal. apply prop_ext; intuition.
-    - rewrite Int64.eq_false by auto. simpl.
+      simpl. iSplit; auto.
+    - rewrite -> Int64.eq_false by auto. simpl.
       simpl; unfold_lift;  unfold denote_tc_test_eq.
-      rewrite (eval_expr_any rho a _ Ha')  by congruence.
-      rewrite (eval_expr_any rho _ _ Hb')  by congruence.
+      rewrite -> (eval_expr_any rho a _ Ha')  by congruence.
+      rewrite -> (eval_expr_any rho _ _ Hb')  by congruence.
       simpl. rewrite Hp.
       auto.
-  + rewrite Int64.eq_false by auto. simpl.
+  + rewrite -> Int64.eq_false by auto. simpl.
     simpl; unfold_lift;  unfold denote_tc_test_eq.
-    rewrite (eval_expr_any rho a _ Ha')  by congruence.
-    rewrite (eval_expr_any rho _ _ Hb')  by congruence.
+    rewrite -> (eval_expr_any rho a _ Ha')  by congruence.
+    rewrite -> (eval_expr_any rho _ _ Hb')  by congruence.
     simpl. rewrite Hp.
     auto.
   }
  +
   simpl. unfold_lift.
-  rewrite (eval_expr_any rho b _ Hb') by congruence;
-  rewrite (eval_expr_any rho a _ Ha') by congruence.
+  rewrite -> (eval_expr_any rho b _ Hb') by congruence;
+  rewrite -> (eval_expr_any rho a _ Ha') by congruence.
   simpl. rewrite Hp. auto.
 Qed.
 
 Lemma denote_tc_assert_andp_andp'_eq:
- forall {CS: compspecs} x y x' y', 
-   denote_tc_assert x = denote_tc_assert x' ->
-   denote_tc_assert y = denote_tc_assert y' ->
-   denote_tc_assert (tc_andp x y) = denote_tc_assert (tc_andp' x' y').
+ forall {CS: compspecs} x y x' y' rho,
+   (denote_tc_assert x rho ⊣⊢ denote_tc_assert x' rho) ->
+   (denote_tc_assert y rho ⊣⊢ denote_tc_assert y' rho) ->
+   denote_tc_assert (tc_andp x y) rho ⊣⊢ denote_tc_assert (tc_andp' x' y') rho.
 Proof. intros. rewrite denote_tc_assert_andp'.
- extensionality rho. simpl. unfold liftx, lift. simpl. congruence. 
+ simpl. unfold_lift. by rewrite H H0.
 Qed.
 
 Lemma denote_tc_assert_andp'_eq:
- forall {CS: compspecs} x y x' y', 
-   denote_tc_assert x = denote_tc_assert x' ->
-   denote_tc_assert y = denote_tc_assert y' ->
-   denote_tc_assert (tc_andp' x y) = denote_tc_assert (tc_andp' x' y').
-Proof. intros. 
- extensionality rho. simpl. unfold liftx, lift. simpl. congruence. 
+ forall {CS: compspecs} x y x' y' rho,
+   (denote_tc_assert x rho ⊣⊢ denote_tc_assert x' rho) ->
+   (denote_tc_assert y rho ⊣⊢ denote_tc_assert y' rho) ->
+   denote_tc_assert (tc_andp' x y) rho ⊣⊢ denote_tc_assert (tc_andp' x' y') rho.
+Proof. intros. simpl. unfold_lift. by rewrite H H0.
 Qed.
 
 Lemma denote_tc_assert_orp_orp'_eq:
- forall {CS: compspecs} x y x' y', 
-   denote_tc_assert x = denote_tc_assert x' ->
-   denote_tc_assert y = denote_tc_assert y' ->
-   denote_tc_assert (tc_orp x y) = denote_tc_assert (tc_orp' x' y').
+ forall {CS: compspecs} x y x' y' rho,
+   (denote_tc_assert x rho ⊣⊢ denote_tc_assert x' rho) ->
+   (denote_tc_assert y rho ⊣⊢ denote_tc_assert y' rho) ->
+   denote_tc_assert (tc_orp x y) rho ⊣⊢ denote_tc_assert (tc_orp' x' y') rho.
 Proof. intros. rewrite denote_tc_assert_orp'.
- extensionality rho. simpl. unfold liftx, lift. simpl. congruence. 
+ simpl. unfold_lift. by rewrite H H0.
 Qed.
 
 Lemma denote_tc_assert_orp'_eq:
- forall {CS: compspecs} x y x' y', 
-   denote_tc_assert x = denote_tc_assert x' ->
-   denote_tc_assert y = denote_tc_assert y' ->
-   denote_tc_assert (tc_orp' x y) = denote_tc_assert (tc_orp' x' y').
-Proof. intros. 
- extensionality rho. simpl. unfold liftx, lift. simpl. congruence. 
+ forall {CS: compspecs} x y x' y' rho,
+   (denote_tc_assert x rho ⊣⊢ denote_tc_assert x' rho) ->
+   (denote_tc_assert y rho ⊣⊢ denote_tc_assert y' rho) ->
+   denote_tc_assert (tc_orp' x y) rho ⊣⊢ denote_tc_assert (tc_orp' x' y') rho.
+Proof. intros.
+ simpl. unfold_lift. by rewrite H H0.
 Qed.
 
 Local Hint Resolve 
@@ -566,6 +544,17 @@ match ty with
 | _ => ty
 end.
 
+Lemma classify_cast_eq : forall t1 t2, eqb_type t1 int_or_ptr_type = false -> eqb_type t2 int_or_ptr_type = false ->
+  Cop.classify_cast t1 t2 = Clight_Cop2.classify_cast t1 t2.
+Proof.
+  intros; unfold classify_cast, Clight_Cop2.classify_cast.
+  destruct t2; auto.
+  - destruct i; auto.
+    destruct t1; auto.
+    rewrite H; reflexivity.
+  - destruct t1; auto; rewrite H0; reflexivity.
+Qed.
+
 Definition classify_sub' ty1 ty2 :=
 match stupid_typeconv ty1 with
 | Tpointer ty a =>
@@ -586,6 +575,23 @@ try destruct i,s; auto;
 try destruct i0,s0; auto.
 Qed.
 
+Inductive classify_sub_rel (ty1 ty2 : type) : classify_sub_cases -> Prop :=
+| classify_sub_pp t1 t2 a1 a2 (Hty1 : stupid_typeconv ty1 = Tpointer t1 a1) (Hty2 : stupid_typeconv ty2 = Tpointer t2 a2) :
+  classify_sub_rel ty1 ty2 (sub_case_pp t1)
+| classify_sub_pi t1 a1 sz si a2 (Hty1 : stupid_typeconv ty1 = Tpointer t1 a1) (Hty2 : stupid_typeconv ty2 = Tint sz si a2) :
+  classify_sub_rel ty1 ty2 (sub_case_pi t1 si)
+| classify_sub_pl t1 a1 si a2 (Hty1 : stupid_typeconv ty1 = Tpointer t1 a1) (Hty2 : stupid_typeconv ty2 = Tlong si a2) :
+  classify_sub_rel ty1 ty2 (sub_case_pl t1)
+| classify_sub_default (Hdefault : forall t1 a1, stupid_typeconv ty1 = Tpointer t1 a1 -> match stupid_typeconv ty2 with Tpointer _ _ | Tint _ _ _ | Tlong _ _ => False | _ => True end) :
+  classify_sub_rel ty1 ty2 sub_default.
+
+Lemma classify_sub_reflect : forall ty1 ty2, classify_sub_rel ty1 ty2 (classify_sub' ty1 ty2).
+Proof.
+  intros; unfold classify_sub'.
+  destruct (stupid_typeconv ty1) eqn: Hty1, (stupid_typeconv ty2) eqn: Hty2;
+    econstructor; rewrite ?Hty1 ?Hty2; done.
+Qed.
+
 Definition classify_cmp' ty1 ty2 :=
   match stupid_typeconv ty1, stupid_typeconv ty2 with
   | Tpointer _ _ , Tpointer _ _ => cmp_case_pp
@@ -604,6 +610,27 @@ try destruct i,s; auto;
 try destruct i0,s0; auto.
 Qed.
 
+Inductive classify_cmp_rel (ty1 ty2 : type) : classify_cmp_cases -> Prop :=
+| classify_cmp_pp t1 t2 a1 a2 (Hty1 : stupid_typeconv ty1 = Tpointer t1 a1) (Hty2 : stupid_typeconv ty2 = Tpointer t2 a2) :
+  classify_cmp_rel ty1 ty2 cmp_case_pp
+| classify_cmp_pi t1 a1 sz si a2 (Hty1 : stupid_typeconv ty1 = Tpointer t1 a1) (Hty2 : stupid_typeconv ty2 = Tint sz si a2) :
+  classify_cmp_rel ty1 ty2 (cmp_case_pi si)
+| classify_cmp_ip a1 sz si t2 a2 (Hty1 : stupid_typeconv ty1 = Tint sz si a1) (Hty2 : stupid_typeconv ty2 = Tpointer t2 a2) :
+  classify_cmp_rel ty1 ty2 (cmp_case_ip si)
+| classify_cmp_pl t1 a1 si a2 (Hty1 : stupid_typeconv ty1 = Tpointer t1 a1) (Hty2 : stupid_typeconv ty2 = Tlong si a2) :
+  classify_cmp_rel ty1 ty2 cmp_case_pl
+| classify_cmp_lp a1 si t2 a2 (Hty1 : stupid_typeconv ty1 = Tlong si a1) (Hty2 : stupid_typeconv ty2 = Tpointer t2 a2) :
+  classify_cmp_rel ty1 ty2 cmp_case_lp
+| classify_cmp_default (Hdefault : forall t1 a1, stupid_typeconv ty1 = Tpointer t1 a1 -> match stupid_typeconv ty2 with Tpointer _ _ | Tint _ _ _ | Tlong _ _ => False | _ => True end) :
+  classify_cmp_rel ty1 ty2 cmp_default.
+
+Lemma classify_cmp_reflect : forall ty1 ty2, classify_cmp_rel ty1 ty2 (classify_cmp' ty1 ty2).
+Proof.
+  intros; unfold classify_cmp'.
+  destruct (stupid_typeconv ty1) eqn: Hty1, (stupid_typeconv ty2) eqn: Hty2;
+    econstructor; rewrite ?Hty1 ?Hty2; done.
+Qed.
+
 Definition classify_add' ty1 ty2 :=
  match stupid_typeconv ty1 with
  | Tint _ si _ =>
@@ -633,6 +660,26 @@ try destruct i,s; auto;
 try destruct i0,s0; auto.
 Qed.
 
+Inductive classify_add_rel (ty1 ty2 : type) : classify_add_cases -> Prop :=
+| classify_add_pi t1 a1 sz si a2 (Hty1 : stupid_typeconv ty1 = Tpointer t1 a1) (Hty2 : stupid_typeconv ty2 = Tint sz si a2) :
+  classify_add_rel ty1 ty2 (add_case_pi t1 si)
+| classify_add_ip a1 sz si t2 a2 (Hty1 : stupid_typeconv ty1 = Tint sz si a1) (Hty2 : stupid_typeconv ty2 = Tpointer t2 a2) :
+  classify_add_rel ty1 ty2 (add_case_ip si t2)
+| classify_add_pl t1 a1 si a2 (Hty1 : stupid_typeconv ty1 = Tpointer t1 a1) (Hty2 : stupid_typeconv ty2 = Tlong si a2) :
+  classify_add_rel ty1 ty2 (add_case_pl t1)
+| classify_add_lp a1 si t2 a2 (Hty1 : stupid_typeconv ty1 = Tlong si a1) (Hty2 : stupid_typeconv ty2 = Tpointer t2 a2) :
+  classify_add_rel ty1 ty2 (add_case_lp t2)
+| classify_add_default (Hdefault1 : forall t1 a1, stupid_typeconv ty1 = Tpointer t1 a1 -> match stupid_typeconv ty2 with Tint _ _ _ | Tlong _ _ => False | _ => True end)
+  (Hdefault2 : forall t2 a2, stupid_typeconv ty2 = Tpointer t2 a2 -> match stupid_typeconv ty1 with Tint _ _ _ | Tlong _ _ => False | _ => True end) :
+  classify_add_rel ty1 ty2 add_default.
+
+Lemma classify_add_reflect : forall ty1 ty2, classify_add_rel ty1 ty2 (classify_add' ty1 ty2).
+Proof.
+  intros; unfold classify_add'.
+  destruct (stupid_typeconv ty1) eqn: Hty1, (stupid_typeconv ty2) eqn: Hty2;
+    econstructor; rewrite ?Hty1 ?Hty2; done.
+Qed.
+
 Definition classify_shift' (ty1: type) (ty2: type) :=
   match stupid_typeconv ty1, stupid_typeconv ty2 with
   | Tint sz sg _, Tint _ _ _ => shift_case_ii
@@ -658,6 +705,33 @@ try destruct i,s; auto;
 try destruct i0,s0; auto.
 Qed.
 
+Definition is_integer_type t := match t with Tint _ _ _ | Tlong _ _ => true | _ => false end.
+
+Inductive classify_shift_rel (ty1 ty2 : type) : classify_shift_cases -> Prop :=
+| classify_shift_iiu sz2 sg2 a1 a2 (Hty1 : stupid_typeconv ty1 = Tint I32 Unsigned a1) (Hty2 : stupid_typeconv ty2 = Tint sz2 sg2 a2) :
+  classify_shift_rel ty1 ty2 (shift_case_ii Unsigned)
+| classify_shift_iis sz1 sz2 sg1 sg2 a1 a2 (Hty1 : stupid_typeconv ty1 = Tint sz1 sg1 a1) (Hty2 : stupid_typeconv ty2 = Tint sz2 sg2 a2)
+    (Hsigned : sz1 <> I32 \/ sg1 = Signed) :
+  classify_shift_rel ty1 ty2 (shift_case_ii Signed)
+| classify_shift_ilu sg2 a1 a2 (Hty1 : stupid_typeconv ty1 = Tint I32 Unsigned a1) (Hty2 : stupid_typeconv ty2 = Tlong sg2 a2) :
+  classify_shift_rel ty1 ty2 (shift_case_il Unsigned)
+| classify_shift_ils sz1 sg1 sg2 a1 a2 (Hty1 : stupid_typeconv ty1 = Tint sz1 sg1 a1) (Hty2 : stupid_typeconv ty2 = Tlong sg2 a2)
+    (Hsigned : sz1 <> I32 \/ sg1 = Signed) :
+  classify_shift_rel ty1 ty2 (shift_case_il Signed)
+| classify_shift_li sz2 sg1 sg2 a1 a2 (Hty1 : stupid_typeconv ty1 = Tlong sg1 a1) (Hty2 : stupid_typeconv ty2 = Tint sz2 sg2 a2) :
+  classify_shift_rel ty1 ty2 (shift_case_li sg1)
+| classify_shift_ll sg1 sg2 a1 a2 (Hty1 : stupid_typeconv ty1 = Tlong sg1 a1) (Hty2 : stupid_typeconv ty2 = Tlong sg2 a2) :
+  classify_shift_rel ty1 ty2 (shift_case_ll sg1)
+| classify_shift_default (Hdefault : is_integer_type (stupid_typeconv ty1) = false \/ is_integer_type (stupid_typeconv ty2) = false) :
+  classify_shift_rel ty1 ty2 shift_default.
+
+Lemma classify_shift_reflect : forall ty1 ty2, classify_shift_rel ty1 ty2 (classify_shift' ty1 ty2).
+Proof.
+  intros; unfold classify_shift'.
+  destruct (stupid_typeconv ty1) eqn: Hty1, (stupid_typeconv ty2) eqn: Hty2;
+    try (econstructor; rewrite ?Hty1 ?Hty2; auto); destruct i, s; try (econstructor; rewrite ?Hty1 ?Hty2; auto).
+Qed.
+
 Definition classify_binarith' (ty1: type) (ty2: type) :=
   match stupid_typeconv ty1, stupid_typeconv ty2 with
   | Tint i1 s1 _, Tint i2 s2 _ => bin_case_i 
@@ -708,9 +782,63 @@ Proof.
   auto.
 Qed.
 
+Inductive classify_binarith_rel (ty1 ty2 : type) : binarith_cases -> Prop :=
+| classify_binarith_i_un i1 i2 s1 s2 a1 a2 (Hty1 : stupid_typeconv ty1 = Tint i1 s1 a1) (Hty2 : stupid_typeconv ty2 = Tint i2 s2 a2)
+    (Hunsigned : (i1 = I32 /\ s1 = Unsigned) \/ (i2 = I32 /\ s2 = Unsigned)) :
+  classify_binarith_rel ty1 ty2 (bin_case_i Unsigned)
+| classify_binarith_i_si i1 i2 s1 s2 a1 a2 (Hty1 : stupid_typeconv ty1 = Tint i1 s1 a1) (Hty2 : stupid_typeconv ty2 = Tint i2 s2 a2)
+    (Hsigned : ~(i1 = I32 /\ s1 = Unsigned) /\ ~(i2 = I32 /\ s2 = Unsigned)) :
+  classify_binarith_rel ty1 ty2 (bin_case_i Signed)
+| classify_binarith_il i1 s1 a1 s2 a2 (Hty1 : stupid_typeconv ty1 = Tint i1 s1 a1) (Hty2 : stupid_typeconv ty2 = Tlong s2 a2) :
+  classify_binarith_rel ty1 ty2 (bin_case_l s2)
+| classify_binarith_li s1 a1 i2 s2 a2 (Hty1 : stupid_typeconv ty1 = Tlong s1 a1) (Hty2 : stupid_typeconv ty2 = Tint i2 s2 a2) :
+  classify_binarith_rel ty1 ty2 (bin_case_l s1)
+| classify_binarith_l_si a1 a2 (Hty1 : stupid_typeconv ty1 = Tlong Signed a1) (Hty2 : stupid_typeconv ty2 = Tlong Signed a2) :
+  classify_binarith_rel ty1 ty2 (bin_case_l Signed)
+| classify_binarith_l_un s1 s2 a1 a2 (Hty1 : stupid_typeconv ty1 = Tlong s1 a1) (Hty2 : stupid_typeconv ty2 = Tlong s2 a2)
+    (Hunsigned : s1 <> Signed \/ s2 <> Signed) :
+  classify_binarith_rel ty1 ty2 (bin_case_l Unsigned)
+| classify_binarith_ss a1 a2 (Hty1 : stupid_typeconv ty1 = Tfloat F32 a1) (Hty2 : stupid_typeconv ty2 = Tfloat F32 a2) :
+  classify_binarith_rel ty1 ty2 bin_case_s
+| classify_binarith_ff s1 s2 a1 a2 (Hty1 : stupid_typeconv ty1 = Tfloat s1 a1) (Hty2 : stupid_typeconv ty2 = Tfloat s2 a2)
+    (Hfloat : s1 <> F32 \/ s2 <> F32) :
+  classify_binarith_rel ty1 ty2 bin_case_f
+| classify_binarith_fi s2 i2 a1 a2 (Hty1 : stupid_typeconv ty1 = Tfloat F64 a1) (Hty2 : stupid_typeconv ty2 = Tint i2 s2 a2) :
+  classify_binarith_rel ty1 ty2 bin_case_f
+| classify_binarith_fl s2 a1 a2 (Hty1 : stupid_typeconv ty1 = Tfloat F64 a1) (Hty2 : stupid_typeconv ty2 = Tlong s2 a2) :
+  classify_binarith_rel ty1 ty2 bin_case_f
+| classify_binarith_if i1 s1 a1 a2 (Hty1 : stupid_typeconv ty1 = Tint i1 s1 a1) (Hty2 : stupid_typeconv ty2 = Tfloat F64 a2) :
+  classify_binarith_rel ty1 ty2 bin_case_f
+| classify_binarith_lf s1 a1 a2 (Hty1 : stupid_typeconv ty1 = Tlong s1 a1) (Hty2 : stupid_typeconv ty2 = Tfloat F64 a2) :
+  classify_binarith_rel ty1 ty2 bin_case_f
+| classify_binarith_si s2 i2 a1 a2 (Hty1 : stupid_typeconv ty1 = Tfloat F32 a1) (Hty2 : stupid_typeconv ty2 = Tint i2 s2 a2) :
+  classify_binarith_rel ty1 ty2 bin_case_s
+| classify_binarith_sl s2 a1 a2 (Hty1 : stupid_typeconv ty1 = Tfloat F32 a1) (Hty2 : stupid_typeconv ty2 = Tlong s2 a2) :
+  classify_binarith_rel ty1 ty2 bin_case_s
+| classify_binarith_is i1 s1 a1 a2 (Hty1 : stupid_typeconv ty1 = Tint i1 s1 a1) (Hty2 : stupid_typeconv ty2 = Tfloat F32 a2) :
+  classify_binarith_rel ty1 ty2 bin_case_s
+| classify_binarith_ls s1 a1 a2 (Hty1 : stupid_typeconv ty1 = Tlong s1 a1) (Hty2 : stupid_typeconv ty2 = Tfloat F32 a2) :
+  classify_binarith_rel ty1 ty2 bin_case_s
+| classify_binarith_default (Hdefault : is_numeric_type (stupid_typeconv ty1) = false \/ is_numeric_type (stupid_typeconv ty2) = false) :
+  classify_binarith_rel ty1 ty2 bin_default.
 
-Lemma den_isBinOpR: forall {CS: compspecs} op a1 a2 ty,
-  denote_tc_assert (isBinOpResultType op a1 a2 ty) =
+Lemma classify_binarith_reflect : forall ty1 ty2, classify_binarith_rel ty1 ty2 (classify_binarith' ty1 ty2).
+Proof.
+  intros; unfold classify_binarith'.
+  destruct (stupid_typeconv ty1) eqn: Hty1, (stupid_typeconv ty2) eqn: Hty2;
+    try solve [try destruct f; econstructor; rewrite ?Hty1 ?Hty2 /=; auto].
+  - destruct i, i0; try (econstructor; rewrite ?Hty1 ?Hty2 /=; auto; intuition; try done);
+      destruct s0; try (econstructor; rewrite ?Hty1 ?Hty2 /=; auto; intuition; try done);
+      destruct s; try (econstructor; rewrite ?Hty1 ?Hty2 /=; auto; intuition; try done).
+  - destruct s, s0; [eapply classify_binarith_l_si | eapply classify_binarith_l_un ..];
+      rewrite ?Hty1 ?Hty2 /=; auto.
+  - destruct f, f0; econstructor; eauto.
+Qed.
+
+Opaque stupid_typeconv.
+
+Lemma den_isBinOpR: forall {CS: compspecs} op a1 a2 ty rho,
+  denote_tc_assert (isBinOpResultType op a1 a2 ty) rho ⊣⊢
 let e := (Ebinop op a1 a2 ty) in
 let reterr := op_result_type e in
 let deferr := arg_type e in
@@ -833,28 +961,24 @@ match op with
                           tc_andp' (tc_int_or_ptr_type (typeof a2))
                           (check_pp_int' (Ecast a1 size_t) a2 op ty e)
                    end
-  end.
+  end rho.
 Proof.
   intros.
  rewrite <- classify_add_eq. rewrite <- classify_sub_eq.
  rewrite <- classify_shift_eq. rewrite <- classify_cmp_eq.
  rewrite <- classify_binarith_eq. rewrite <- binarithType_eq.
- unfold isBinOpResultType, classify_add, classify_sub, classify_binarith, classify_shift,
-  classify_cmp, check_pp_int, check_pp_int',
-  typeconv,
-  remove_attributes, change_attributes;
-  destruct op; auto;
- destruct (typeof a1) as [ | [ | | | ] [ | ] ? | [ | ] ? | [ | ] ? | | | | | ];
- destruct (typeof a2) as [ | [ | | | ] [ | ] ? | [ | ] ? | [ | ] ? | | | | | ];
-  auto 50 with dtca.
+ unfold isBinOpResultType;
+  destruct op; auto; match goal with |-context[match ?A with _ => _ end] => destruct A end;
+    rewrite ?denote_tc_assert_andp ?denote_tc_assert_ilt' ?denote_tc_assert_llt' ?denote_tc_assert_test_eq' ?denote_tc_assert_test_order'; try reflexivity;
+    destruct s; rewrite !denote_tc_assert_andp !denote_tc_assert_nonzero' ?denote_tc_assert_nodivover'; reflexivity.
 Qed.
 
-Lemma denote_tc_assert'_andp'_e:
+(*Lemma denote_tc_assert'_andp'_e:
  forall {CS: compspecs} a b rho m, denote_tc_assert' (tc_andp' a b) rho m ->
     denote_tc_assert' a rho m /\ denote_tc_assert' b rho m.
 Proof. intros.
  rewrite denote_tc_assert'_eq in *. apply H.
-Qed.
+Qed.*)
 
 Lemma cast_int_long_nonzero:
   forall s i, Int.eq i Int.zero = false ->
@@ -873,11 +997,11 @@ rewrite Int64.signed_repr in H.
 rewrite <- (Int.repr_signed i).
 rewrite H. reflexivity.
 pose proof (Int64.signed_range Int64.zero).
-rewrite Int64.signed_zero in H1.
+rewrite Int64.signed_zero in H.
 auto.
 pose proof (Int.signed_range i).
-clear - H1.
-destruct H1.
+clear - H.
+destruct H.
 split.
 apply Z.le_trans with Int.min_signed; auto.
 compute; congruence.
@@ -891,8 +1015,8 @@ rewrite <- (Int.repr_unsigned i).
 rewrite H. reflexivity.
 split; compute; congruence.
 pose proof (Int.unsigned_range i).
-clear - H1.
-destruct H1.
+clear - H.
+destruct H.
 split; auto.
 unfold Int64.max_unsigned.
 apply Z.le_trans with Int.modulus.
@@ -908,6 +1032,17 @@ Definition tc_numeric_val (v: val) (t: type) : Prop :=
  | _, _ => False
  end.
 
+Inductive tc_numeric_rel : val -> type -> Prop :=
+| tc_numeric_int i sz si a : tc_numeric_rel (Vint i) (Tint sz si a)
+| tc_numeric_long i si a : tc_numeric_rel (Vlong i) (Tlong si a)
+| tc_numeric_float i a : tc_numeric_rel (Vfloat i) (Tfloat F64 a).
+
+Lemma tc_numeric_reflect : forall v t, tc_numeric_val v t <-> tc_numeric_rel v t.
+Proof.
+  destruct v, t; simpl; split; try done; try solve [by inversion 1]; try constructor.
+  destruct f0; try done; constructor.
+Qed.
+
 Lemma tc_val_of_bool:
  forall x i3 s3 a3, tc_val (Tint i3 s3 a3) (Val.of_bool x).
 Proof.
@@ -1085,4 +1220,4 @@ unfold Clight_Cop2.sem_cmp, classify_cmp, typeconv,
 Transparent tc_val.
 Abort.
 
-
+End mpred.
diff --git a/veric/binop_lemmas3.v b/veric/binop_lemmas3.v
index 1ffd18d462..3076b0bb47 100644
--- a/veric/binop_lemmas3.v
+++ b/veric/binop_lemmas3.v
@@ -1,7 +1,8 @@
-Require Import VST.msl.msl_standard.
 Require Import VST.veric.Clight_base.
-Require Import VST.veric.compcert_rmaps.
 Require Import VST.veric.Clight_lemmas.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Import VST.veric.res_predicates.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.mpred.
 Require Import VST.veric.tycontext.
 Require Import VST.veric.expr2.
@@ -9,65 +10,63 @@ Require Import VST.veric.Clight_Cop2.
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.binop_lemmas2.
 
+Section mpred.
+
+Context `{!heapGS Σ}.
+
+Open Scope bi_scope.
+
 Lemma denote_tc_nonzero_e:
- forall i m, app_pred (denote_tc_nonzero (Vint i)) m -> i <> Int.zero.
-Proof.
-simpl; auto .
-Qed.
+ forall i, denote_tc_nonzero (Vint i) ⊢ ⌜i <> Int.zero⌝.
+Proof. auto. Qed.
 
 Lemma denote_tc_nodivover_e:
- forall i j m, app_pred (denote_tc_nodivover (Vint i) (Vint j)) m ->
-   ~ (i =Int.repr Int.min_signed /\ j = Int.mone).
-Proof.
-simpl; auto.
-Qed.
+ forall i j, denote_tc_nodivover (Vint i) (Vint j) ⊢
+   ⌜~ (i =Int.repr Int.min_signed /\ j = Int.mone)⌝.
+Proof. auto. Qed.
 
 Lemma denote_tc_nonzero_e64:
- forall i m, app_pred (denote_tc_nonzero (Vlong i)) m -> i <> Int64.zero.
-Proof.
-simpl; auto.
-Qed.
+ forall i, denote_tc_nonzero (Vlong i) ⊢ ⌜i <> Int64.zero⌝.
+Proof. auto. Qed.
 
 Lemma denote_tc_nodivover_e64_ll:
- forall i j m, app_pred (denote_tc_nodivover (Vlong i) (Vlong j)) m ->
-   ~ (i =Int64.repr Int64.min_signed /\ j = Int64.mone).
-Proof.
-simpl; auto.
-Qed.
+ forall i j, denote_tc_nodivover (Vlong i) (Vlong j) ⊢
+   ⌜~ (i =Int64.repr Int64.min_signed /\ j = Int64.mone)⌝.
+Proof. auto. Qed.
 
 Lemma denote_tc_nodivover_e64_il:
   (* This is a rather vacuous lemma, since the premise is simply True *)
- forall s i j m, app_pred (denote_tc_nodivover (Vint i) (Vlong j)) m ->
-   ~ (cast_int_long s i = Int64.repr Int64.min_signed /\ j = Int64.mone).
+ forall s i j , denote_tc_nodivover (Vint i) (Vlong j) ⊢
+   ⌜~ (cast_int_long s i = Int64.repr Int64.min_signed /\ j = Int64.mone)⌝.
 Proof.
 simpl; intros.
-intros [? ?].
+iPureIntro; intros _ [H0 ?].
 subst.
 destruct s; simpl in *.
 *
-pose proof (@f_equal _ _ Int64.signed _ _ H0).
+pose proof (@f_equal _ _ Int64.signed _ _ H0) as H1.
 rewrite Int64.signed_repr in H1.
 rewrite Int64.signed_repr in H1.
-pose proof (Int.signed_range i).
+pose proof (Int.signed_range i) as H2.
 rewrite H1 in H2.
-destruct H2.
+destruct H2 as [H2 ?].
 compute in H2. apply H2; auto.
 compute; split; congruence.
-pose proof (Int.signed_range i).
+pose proof (Int.signed_range i) as H2.
 clear - H2. forget (Int.signed i) as a.
 destruct H2.
 split; eapply Z.le_trans; try eassumption.
 compute; congruence.
 compute; congruence.
 *
-pose proof (@f_equal _ _ Int64.unsigned _ _ H0).
+pose proof (@f_equal _ _ Int64.unsigned _ _ H0) as H1.
 rewrite Int64.unsigned_repr in H1.
 replace (Int64.repr Int64.min_signed) 
   with (Int64.repr (Int64.modulus + Int64.min_signed)) in H1.
 rewrite Int64.unsigned_repr in H1.
-pose proof (Int.unsigned_range i).
+pose proof (Int.unsigned_range i) as H2.
 rewrite H1 in H2.
-destruct H2.
+destruct H2 as [H2 ?].
 compute in H2. apply H2; auto.
 compute; split; congruence.
 apply Int64.eqm_samerepr.
@@ -85,11 +84,11 @@ lia.
 Qed.
 
 Lemma denote_tc_nodivover_e64_li:
- forall s i j m, app_pred (denote_tc_nodivover (Vlong i) (Vint j)) m ->
-   ~ (i = Int64.repr Int64.min_signed /\ cast_int_long s j = Int64.mone).
+ forall s i j, denote_tc_nodivover (Vlong i) (Vint j) ⊢
+   ⌜~ (i = Int64.repr Int64.min_signed /\ cast_int_long s j = Int64.mone)⌝.
 Proof.
 simpl; intros.
-contradict H.
+iPureIntro; intros H; contradict H.
 destruct H; split; auto.
 clear - H0.
 destruct s; simpl in *.
@@ -101,7 +100,6 @@ rewrite Int64.signed_repr in H.
 change (Int.signed j = -1) in H.
 rewrite <- (Int.repr_signed j).
 rewrite H. reflexivity.
-clear H.
 pose proof (Int.signed_range j).
 destruct H.
 split; eapply Z.le_trans; try eassumption.
@@ -115,7 +113,7 @@ change (Int.unsigned j = -1) in H.
 pose proof (Int.unsigned_range j).
 rewrite H in H0.
 destruct H0. compute in H0. congruence.
-pose proof (Int.unsigned_range j).
+pose proof (Int.unsigned_range j) as H0.
 destruct H0.
 split.
 eapply Z.le_trans; try eassumption.
@@ -138,10 +136,10 @@ rewrite Int64.signed_repr in H.
 rewrite Int64.signed_repr in H.
 rewrite <- (Int.repr_signed i).
 rewrite H. reflexivity.
-pose proof (Int64.signed_range Int64.zero).
+pose proof (Int64.signed_range Int64.zero) as H1.
 rewrite Int64.signed_zero in H1.
 auto.
-pose proof (Int.signed_range i).
+pose proof (Int.signed_range i) as H1.
 clear - H1.
 destruct H1.
 split.
@@ -165,7 +163,7 @@ rewrite Int64.unsigned_repr in H.
 rewrite <- (Int.repr_unsigned i).
 rewrite H. reflexivity.
 split; compute; congruence.
-pose proof (Int.unsigned_range i).
+pose proof (Int.unsigned_range i) as H1.
 clear - H1.
 destruct H1.
 split; auto.
@@ -186,21 +184,21 @@ Proof.
 Qed.
 
 Lemma denote_tc_igt_e:
-  forall m i j, app_pred (denote_tc_igt j (Vint i)) m ->
-        Int.unsigned i < Int.unsigned j.
+  forall i j, denote_tc_igt j (Vint i) ⊢
+        ⌜Int.unsigned i < Int.unsigned j⌝.
 Proof. auto. Qed.
 
 Lemma denote_tc_lgt_e:
-  forall m i j, app_pred (denote_tc_lgt j (Vlong i)) m ->
-        Int64.unsigned i < Int64.unsigned j.
+  forall i j, denote_tc_lgt j (Vlong i) ⊢
+        ⌜Int64.unsigned i < Int64.unsigned j⌝.
 Proof. auto. Qed.
 
 Lemma denote_tc_iszero_long_e:
- forall m i,
-  app_pred (denote_tc_iszero (Vlong i)) m -> i = Int64.zero.
+ forall i,
+  denote_tc_iszero (Vlong i) ⊢ ⌜i = Int64.zero⌝.
 Proof.
-intros.
-hnf in H.
+intros; simpl.
+iPureIntro; intros.
 pose proof (Int64.eq_spec i Int64.zero).
 destruct (Int64.eq i Int64.zero); try contradiction.
 auto.
@@ -217,9 +215,9 @@ change Byte.min_signed with (-128).
 change Byte.max_signed with 127.
 clear. lia.
 clear.
-simpl. 
+simpl.
 change (Int.signed Int.one) with 1.
-lia.
+by compute.
 Qed.
 
 Lemma int_type_tc_val_Vfalse:
@@ -232,7 +230,7 @@ change (Int.signed Int.zero) with 0.
 change Byte.min_signed with (-128).
 change Byte.max_signed with 127.
 clear. lia.
-clear. simpl. lia.
+clear. by compute.
 Qed.
 
 
@@ -250,7 +248,7 @@ change (Int.unsigned (Int.repr 0)) with 0;
 change Byte.min_signed with (-128);
 change Byte.max_signed with 127;
 change Byte.max_unsigned with 255;
-try lia;
+try solve [by compute];
 intro Hx; inv Hx.
 Qed.
 
@@ -337,18 +335,17 @@ Proof.
 Qed.
 
 Inductive tc_val_PM': type -> val -> Prop :=
-| tc_val_PM'_Tint: forall t0 sz sg a v, t0 = Tint sz sg a -> is_int sz sg v -> tc_val_PM' t0 v
-| tc_val_PM'_Tlong: forall t0 s a v, stupid_typeconv t0 = Tlong s a -> is_long v -> tc_val_PM' t0 v
-| tc_val_PM'_Tfloat_single: forall t0 a v, stupid_typeconv t0 = Tfloat F32 a -> is_single v -> tc_val_PM' t0 v
-| tc_val_PM'_Tfloat_double: forall t0 a v, stupid_typeconv t0 = Tfloat F64 a -> is_float v -> tc_val_PM' t0 v
-| tc_val_PM'_Tpointer: forall t0 t a v, 
-  stupid_typeconv t0 = Tpointer t a -> 
+| tc_val_PM'_Tint: forall t0 sz sg a v (Ht : t0 = Tint sz sg a), is_int sz sg v -> tc_val_PM' t0 v
+| tc_val_PM'_Tlong: forall t0 s a v (Ht : stupid_typeconv t0 = Tlong s a), is_long v -> tc_val_PM' t0 v
+| tc_val_PM'_Tfloat_single: forall t0 a v (Ht : stupid_typeconv t0 = Tfloat F32 a), is_single v -> tc_val_PM' t0 v
+| tc_val_PM'_Tfloat_double: forall t0 a v (Ht : stupid_typeconv t0 = Tfloat F64 a), is_float v -> tc_val_PM' t0 v
+| tc_val_PM'_Tpointer: forall t0 t a v (Ht : stupid_typeconv t0 = Tpointer t a),
   (if eqb_type t0 int_or_ptr_type
            then is_pointer_or_integer
            else is_pointer_or_null) v -> 
   tc_val_PM' t0 v
-| tc_val_PM'_Tstruct: forall t0 i a v, stupid_typeconv t0 = Tstruct i a -> isptr v -> tc_val_PM' t0 v
-| tc_val_PM'_Tunion: forall t0 i a v, stupid_typeconv t0 = Tunion i a -> isptr v -> tc_val_PM' t0 v.
+| tc_val_PM'_Tstruct: forall t0 i a v (Ht : stupid_typeconv t0 = Tstruct i a), isptr v -> tc_val_PM' t0 v
+| tc_val_PM'_Tunion: forall t0 i a v (Ht : stupid_typeconv t0 = Tunion i a), isptr v -> tc_val_PM' t0 v.
 
 Lemma tc_val_tc_val_PM': forall t v, tc_val t v <-> tc_val_PM' t v.
 Proof.
@@ -365,14 +362,14 @@ Proof.
     - eapply tc_val_PM'_Tstruct; eauto; reflexivity.
     - eapply tc_val_PM'_Tunion; eauto; reflexivity.
   + inversion H; subst; auto;
-    destruct t as [| | | [ | ] ? | | | | |]; try (inv H0);
+    destruct t as [| | | [ | ] ? | | | | |]; try (inv Ht);
     auto.
-    destruct i; inv H3.
-    destruct i; inv H3.
-    destruct i; inv H3.
-    destruct i; inv H3.
-    destruct i0; inv H3.
-    destruct i0; inv H3.
+    destruct i; inv H2.
+    destruct i; inv H2.
+    destruct i; inv H2.
+    destruct i; inv H2.
+    destruct i0; inv H2.
+    destruct i0; inv H2.
 Qed.
 
 Ltac solve_tc_val H :=
@@ -381,27 +378,27 @@ Ltac solve_tc_val H :=
 Ltac solve_tc_val' H :=
   rewrite tc_val_tc_val_PM' in H; inv H.
 
-Lemma tc_val_sem_binarith': forall {CS: compspecs} sem_int sem_long sem_float sem_single t1 t2 t v1 v2 deferr reterr rho m
+Lemma tc_val_sem_binarith': forall {CS: compspecs} sem_int sem_long sem_float sem_single t1 t2 t v1 v2 deferr reterr rho
   (TV2: tc_val t2 v2)
   (TV1: tc_val t1 v1),
-  (denote_tc_assert (binarithType' t1 t2 t deferr reterr) rho) m ->
-  tc_val t
+  denote_tc_assert (binarithType' t1 t2 t deferr reterr) rho ⊢
+  ⌜tc_val t
     (force_val
       (Clight_Cop2.sem_binarith
         (fun s n1 n2 => Some (Vint (sem_int s n1 n2)))
         (fun s n1 n2 => Some (Vlong (sem_long s n1 n2)))
         (fun n1 n2 => Some (Vfloat (sem_float n1 n2)))
         (fun n1 n2 => Some (Vsingle (sem_single n1 n2)))
-        t1 t2 v1 v2)).
+        t1 t2 v1 v2))⌝.
 Proof.
   intros.
-  unfold binarithType' in H.
+  unfold binarithType'.
   unfold Clight_Cop2.sem_binarith.
   rewrite classify_binarith_eq.
-  destruct (classify_binarith' t1 t2) eqn:?H;
-  try solve [inv H]; apply tc_bool_e in H;
-  destruct t1 as [|  [| | |] [|] | | [ | ] ? | | | | |]; try discriminate H0;
-  destruct t2 as [|  [| | |] [|] | | [ | ] ? | | | | |]; try inv H0;
+  pose proof (classify_binarith_reflect t1 t2) as Hbin; inv Hbin; simpl;
+  try solve [iIntros "[]"]; iIntros "H"; iDestruct (tc_bool_e with "H") as %H; iPureIntro;
+  destruct t1 as [|  [| | |] [|] | | [ | ] ? | | | | |]; try discriminate;
+  destruct t2 as [|  [| | |] [|] | | [ | ] ? | | | | |]; try discriminate;
   try contradiction;
   destruct v1; try solve [inv TV1];
   destruct v2; try solve [inv TV2];
@@ -427,63 +424,55 @@ Proof.
   destruct t; inv H1.
   unfold Clight_Cop2.sem_binarith.
   rewrite classify_binarith_eq.
-  destruct (classify_binarith' t1 t2) eqn:?H.
-1,2,3,4:
-  destruct t1 as [|  [| | |] [|] | | [ | ] ? | | | | |]; try discriminate H0;
-  destruct t2 as [|  [| | |] [|] | | [ | ] ? | | | | |]; try inv H0;
+  pose proof (classify_binarith_reflect t1 t2) as Hbin; inv Hbin; simpl;
+  destruct t1 as [|  [| | |] [|] | | [ | ] ? | | | | |]; try discriminate;
+  destruct t2 as [|  [| | |] [|] | | [ | ] ? | | | | |]; try discriminate;
   try contradiction;
   destruct v1; try solve [inv TV1];
   destruct v2; try solve [inv TV2];
-  inv H1;
   simpl;
   apply tc_bool2val; auto.
-  destruct t1 as [|  [| | |] [|] | | [ | ] ? | | | | |]; inv H;
-  destruct t2 as [|  [| | |] [|] | | [ | ] ? | | | | |]; inv H0;
-  inv H1.
 Qed.
 
 Lemma negb_true: forall a, negb a = true -> a = false.
 Proof.  intros; destruct a; auto; inv H. Qed.
 
 Lemma typecheck_Oadd_sound:
-forall {CS: compspecs} (rho : environ) m (e1 e2 : expr) (t : type)
-   (IBR: denote_tc_assert (isBinOpResultType Oadd e1 e2 t) rho m)
+forall {CS: compspecs} (rho : environ) (e1 e2 : expr) (t : type)
    (TV2: tc_val (typeof e2) (eval_expr e2 rho))
    (TV1: tc_val (typeof e1) (eval_expr e1 rho)),
-   tc_val t
+   denote_tc_assert (isBinOpResultType Oadd e1 e2 t) rho ⊢
+   ⌜tc_val t
      (eval_binop Oadd (typeof e1) (typeof e2)
-       (eval_expr e1 rho) (eval_expr e2 rho)).
+       (eval_expr e1 rho) (eval_expr e2 rho))⌝.
 Proof.
   intros.
-  rewrite den_isBinOpR in IBR. 
-  unfold tc_int_or_ptr_type, eval_binop, sem_binary_operation', isBinOpResultType, Clight_Cop2.sem_add in IBR |- *.
+  rewrite den_isBinOpR.
+  unfold tc_int_or_ptr_type, eval_binop, sem_binary_operation', isBinOpResultType, Clight_Cop2.sem_add.
   rewrite classify_add_eq.
-  destruct (classify_add' (typeof e1) (typeof e2)) eqn:?H;
+  destruct (classify_add' (typeof e1) (typeof e2)) eqn:H;
   unfold force_val2, force_val;
-  rewrite tc_val_tc_val_PM in TV1,TV2|-*;
-  unfold classify_add' in H; simpl in IBR;
+  rewrite !tc_val_tc_val_PM in TV1,TV2|-*;
+  unfold classify_add' in H; simpl; unfold_lift; try (rewrite !tc_bool_e; iIntros "[[[%H0 %H3] %H2] %H1]"; iPureIntro;
     repeat match goal with
-    | H: _ /\ _ |- _ => destruct H
-    | H: app_pred (denote_tc_assert (tc_bool _ _) _) _ |- _ => 
-                      apply tc_bool_e in H
     | H: negb (eqb_type ?A ?B) = true |- _ =>
              let J := fresh "J" in
-              destruct (eqb_type A B) eqn:J; [inv H | clear H]              
+              destruct (eqb_type A B) eqn:J; [inv H | clear H]
     end;
-  try (unfold sem_add_ptr_int, sem_add_ptr_long,
-              sem_add_int_ptr, sem_add_long_ptr; simpl; rewrite H3).
+  unfold sem_add_ptr_int, sem_add_ptr_long,
+         sem_add_int_ptr, sem_add_long_ptr; simpl; rewrite H3).
 all:  try solve [
     unfold is_pointer_type in H1;
     destruct (typeof e1) as [| [| | |] ? ? | | [|] | | | | |]; inv TV1;
     destruct (typeof e2) as [| [| | |] ? ? | | [|] | | | | |]; inv TV2;
     simpl in H; inv H;
-    try rewrite J in *; clear J;
+    try rewrite -> J in *; clear J;
     destruct (eval_expr e1 rho), (eval_expr e2 rho);
      simpl in *; try contradiction;
     destruct t; try solve [inv H1];
     try solve [constructor; try rewrite (negb_true _ H1); apply I]
   ].
-  rewrite denote_tc_assert_andp in IBR. destruct IBR.
+  rewrite denote_tc_assert_andp bi.and_elim_l.
   rewrite <- tc_val_tc_val_PM in TV1,TV2|-*.
   eapply tc_val_sem_binarith'; eauto.
 Qed.
@@ -497,145 +486,135 @@ Lemma peq_eq_block:
  Qed.
 
 Lemma typecheck_Osub_sound:
-forall {CS: compspecs} (rho : environ) m (e1 e2 : expr) (t : type)
-   (IBR: denote_tc_assert (isBinOpResultType Osub e1 e2 t) rho m)
+forall {CS: compspecs} (rho : environ) (e1 e2 : expr) (t : type)
    (TV2: tc_val (typeof e2) (eval_expr e2 rho))
    (TV1: tc_val (typeof e1) (eval_expr e1 rho)),
-   tc_val t
+   denote_tc_assert (isBinOpResultType Osub e1 e2 t) rho ⊢
+   ⌜tc_val t
      (eval_binop Osub (typeof e1) (typeof e2)
-       (eval_expr e1 rho) (eval_expr e2 rho)).
+       (eval_expr e1 rho) (eval_expr e2 rho))⌝.
 Proof.
   intros.
-  rewrite den_isBinOpR in IBR.
-  unfold tc_int_or_ptr_type, eval_binop, sem_binary_operation', isBinOpResultType, Clight_Cop2.sem_sub in IBR |- *.
+  rewrite den_isBinOpR.
+  unfold tc_int_or_ptr_type, eval_binop, sem_binary_operation', isBinOpResultType, Clight_Cop2.sem_sub.
   rewrite classify_sub_eq.
-  destruct (classify_sub' (typeof e1) (typeof e2)) eqn:?H;
+  destruct (classify_sub' (typeof e1) (typeof e2)) eqn:H;
   unfold force_val2, force_val;
-  rewrite tc_val_tc_val_PM in TV1,TV2|-*;
-  unfold classify_sub' in H; simpl in IBR;
+  rewrite !tc_val_tc_val_PM in TV1,TV2|-*;
+  unfold classify_sub' in H; simpl; unfold_lift; try (rewrite !tc_bool_e; iIntros "%"; iPureIntro;
     repeat match goal with
     | H: _ /\ _ |- _ => destruct H
-    | H: app_pred (denote_tc_assert (tc_bool _ _) _) _ |- _ => 
-                      apply tc_bool_e in H
     | H: negb (eqb_type ?A ?B) = true |- _ =>
              let J := fresh "J" in
-              destruct (eqb_type A B) eqn:J; [inv H | clear H]              
-    end.
+              destruct (eqb_type A B) eqn:J; [inv H | clear H]
+    end).
 all:  try (unfold sem_sub_pi, sem_sub_pp, sem_sub_pl; simpl;
       match goal with H: complete_type _ _ = _ |- _ => rewrite H end).
 1,3: solve [
     unfold is_pointer_type in H1;
     destruct (typeof e1); inv TV1; destruct (typeof e2) as [| [| | |] [|] | | | | | | |]; inv TV2;
     simpl in H; inv H;
-    try rewrite J in *; clear J;
+    try rewrite -> J in *; clear J;
     destruct (eval_expr e1 rho), (eval_expr e2 rho);
      simpl in *; try contradiction;
     destruct t; try solve [inv H1];
     try solve [constructor; try rewrite (negb_true _ H1); apply I]
   ].
- + 
+ +
     change (Ctypes.sizeof ty) with (sizeof ty).
     destruct (typeof e1); inv TV1; destruct (typeof e2); inv TV2;
     simpl in H; inv H;
-    rewrite ?J, ?J0 in *; clear J J0;
+    rewrite -> ?J, ?J0 in *; clear J J0;
     destruct (eval_expr e1 rho), (eval_expr e2 rho);
      simpl in *; try contradiction;
     destruct t as [| [| | |] [|] | | | | | | |]; inv H4;
     simpl; constructor;
-    try (rewrite peq_eq_block by auto; 
-           rewrite sizeof_range_true by auto);
+    try (rewrite -> peq_eq_block by auto;
+           rewrite -> sizeof_range_true by auto);
     try discriminate;
     try apply I.
  +
   rewrite <- tc_val_tc_val_PM in TV1,TV2|-*.
-  rewrite denote_tc_assert_andp in IBR. destruct IBR.
+  rewrite denote_tc_assert_andp bi.and_elim_l.
   eapply tc_val_sem_binarith'; eauto.
 Qed.
 
 Lemma typecheck_Omul_sound:
-forall {CS: compspecs} (rho : environ) m (e1 e2 : expr) (t : type)
-   (IBR: denote_tc_assert (isBinOpResultType Omul e1 e2 t) rho m)
+forall {CS: compspecs} (rho : environ) (e1 e2 : expr) (t : type)
    (TV2: tc_val (typeof e2) (eval_expr e2 rho))
    (TV1: tc_val (typeof e1) (eval_expr e1 rho)),
-   tc_val t
+   denote_tc_assert (isBinOpResultType Omul e1 e2 t) rho ⊢
+   ⌜tc_val t
      (eval_binop Omul (typeof e1) (typeof e2)
-       (eval_expr e1 rho) (eval_expr e2 rho)).
+       (eval_expr e1 rho) (eval_expr e2 rho))⌝.
 Proof.
   intros.
-  rewrite den_isBinOpR in IBR. 
-  unfold eval_binop, sem_binary_operation', isBinOpResultType, Clight_Cop2.sem_mul in IBR |- *.
-  rewrite denote_tc_assert_andp in IBR. destruct IBR.
+  rewrite den_isBinOpR.
+  unfold eval_binop, sem_binary_operation', isBinOpResultType, Clight_Cop2.sem_mul.
+  rewrite denote_tc_assert_andp bi.and_elim_l.
   unfold force_val2, force_val.
   eapply tc_val_sem_binarith'; eauto.
 Qed.
 
 Lemma typecheck_Odiv_sound:
-forall {CS: compspecs} (rho : environ) m (e1 e2 : expr) (t : type)
-   (IBR: denote_tc_assert (isBinOpResultType Odiv e1 e2 t) rho m)
+forall {CS: compspecs} (rho : environ) (e1 e2 : expr) (t : type)
    (TV2: tc_val (typeof e2) (eval_expr e2 rho))
    (TV1: tc_val (typeof e1) (eval_expr e1 rho)),
-   tc_val t
+   denote_tc_assert (isBinOpResultType Odiv e1 e2 t) rho ⊢
+   ⌜tc_val t
      (eval_binop Odiv (typeof e1) (typeof e2)
-       (eval_expr e1 rho) (eval_expr e2 rho)).
+       (eval_expr e1 rho) (eval_expr e2 rho))⌝.
 Proof.
   intros.
-  rewrite den_isBinOpR in IBR.
-  unfold eval_binop, sem_binary_operation', isBinOpResultType, Clight_Cop2.sem_mul in IBR |- *.
+  rewrite den_isBinOpR.
+  unfold eval_binop, sem_binary_operation', isBinOpResultType, Clight_Cop2.sem_mul.
   unfold force_val2, force_val.
-  eapply (tc_val_sem_binarith' _ _ _ _ _ _ _ _ _ _ _ rho m); eauto.
+  iIntros "IBR"; iApply tc_val_sem_binarith'; [done..|].
   unfold binarithType'.
   destruct (classify_binarith' (typeof e1) (typeof e2)); eauto.
-  + destruct s; destruct IBR; eauto.
-  + destruct s; destruct IBR; eauto.
+  + destruct s; simpl; unfold_lift; by rewrite bi.and_elim_r.
+  + destruct s; simpl; unfold_lift; by rewrite bi.and_elim_r.
 Qed.
 
 Lemma typecheck_Omod_sound:
-forall {CS: compspecs} (rho : environ) m (e1 e2 : expr) (t : type)
-   (IBR: denote_tc_assert (isBinOpResultType Omod e1 e2 t) rho m)
+forall {CS: compspecs} (rho : environ) (e1 e2 : expr) (t : type)
    (TV2: tc_val (typeof e2) (eval_expr e2 rho))
    (TV1: tc_val (typeof e1) (eval_expr e1 rho)),
-   tc_val t
+   denote_tc_assert (isBinOpResultType Omod e1 e2 t) rho ⊢
+   ⌜tc_val t
      (eval_binop Omod (typeof e1) (typeof e2)
-       (eval_expr e1 rho) (eval_expr e2 rho)).
+       (eval_expr e1 rho) (eval_expr e2 rho))⌝.
 Proof.
   intros.
-  rewrite den_isBinOpR in IBR.
-  unfold eval_binop, sem_binary_operation', isBinOpResultType, Clight_Cop2.sem_mod in IBR |- *.
+  rewrite den_isBinOpR.
+  unfold eval_binop, sem_binary_operation', isBinOpResultType, Clight_Cop2.sem_mod.
   unfold force_val2, force_val.
   unfold Clight_Cop2.sem_binarith.
   rewrite classify_binarith_eq.
-  destruct (classify_binarith' (typeof e1) (typeof e2)) eqn:?H.
+  destruct (classify_binarith' (typeof e1) (typeof e2)) eqn:H; try solve [iIntros "[]"].
   + solve_tc_val TV1;
     solve_tc_val TV2;
     rewrite <- H2, <- H0 in H;
     try solve [inv H];
     try solve [destruct sz,sg; inv H].
-    destruct s; destruct IBR as [?IBR ?IBR].
-    - destruct IBR as [?IBR ?IBR].
-      apply tc_bool_e in IBR0.
-      simpl in IBR, IBR1 |- *; unfold_lift in IBR; unfold_lift in IBR1.
-      destruct (eval_expr e1 rho), (eval_expr e2 rho);
-      try solve [inv H1 | inv H3 | inv IBR].
+    destruct s; simpl; unfold_lift; rewrite tc_bool_e; iIntros "[IBR %IBR0]".
+    - destruct (eval_expr e1 rho), (eval_expr e2 rho);
+      try solve [inv H1 | inv H3].
       unfold both_int; simpl.
-      apply denote_tc_nonzero_e in IBR; try rewrite IBR.
-      apply denote_tc_nodivover_e in IBR1; try rewrite IBR1.
-      simpl.
+      iDestruct "IBR" as %[IBR IBR1]; iPureIntro.
       destruct t as [| [| | |] ? ? | | | | | | |]; try solve [inv IBR0];
       simpl; auto.
       unfold Clight_Cop2.sem_cast, Clight_Cop2.classify_cast.
-      unfold  sem_cast_pointer.
+      unfold sem_cast_pointer.
       destruct Archi.ptr64; reflexivity.
-    - apply tc_bool_e in IBR0.
-      simpl in IBR |- *; unfold_lift in IBR.
-      destruct (eval_expr e1 rho), (eval_expr e2 rho);
-      try solve [inv H1 | inv H3 | inv IBR].
+    - destruct (eval_expr e1 rho), (eval_expr e2 rho);
+      try solve [inv H1 | inv H3].
       unfold both_int; simpl.
-      apply denote_tc_nonzero_e in IBR; try rewrite IBR.
-      simpl.
+      iDestruct "IBR" as %IBR; iPureIntro.
       destruct t as [| [| | |] ? ? | | | | | | |]; try solve [inv IBR0];
       simpl; auto.
       unfold Clight_Cop2.sem_cast, Clight_Cop2.classify_cast.
-      unfold  sem_cast_pointer.
+      unfold sem_cast_pointer.
       destruct Archi.ptr64; reflexivity.
   + solve_tc_val TV1;
     solve_tc_val TV2;
@@ -643,87 +622,60 @@ Proof.
     try solve [inv H];
     try solve [destruct sz,sg; try destruct sz0,sg0; inv H].
     - (* int long *)
-      destruct s; destruct IBR as [?IBR ?IBR].
-      * destruct IBR as [?IBR ?IBR].
-        apply tc_bool_e in IBR0.
-        simpl in IBR, IBR1 |- *; unfold_lift in IBR; unfold_lift in IBR1.
-        destruct (eval_expr e1 rho), (eval_expr e2 rho);
+      destruct s; simpl; unfold_lift; rewrite tc_bool_e; iIntros "[IBR %IBR0]".
+      * destruct (eval_expr e1 rho), (eval_expr e2 rho);
           try solve [inv H1 | inv H3].
         unfold both_long; simpl.
-        apply denote_tc_nonzero_e64 in IBR; try rewrite IBR.
-        apply (denote_tc_nodivover_e64_il sg) in IBR1; try rewrite IBR1.
-        simpl.
+        iDestruct "IBR" as %[IBR IBR1].
         destruct t as [| [| | |] ? ? | | | | | | |]; try solve [inv IBR0];
         simpl; auto.
-      * apply tc_bool_e in IBR0.
-        simpl in IBR |- *; unfold_lift in IBR.
-        destruct (eval_expr e1 rho), (eval_expr e2 rho);
-        try solve [inv H1 | inv H3 | inv IBR].
+      * destruct (eval_expr e1 rho), (eval_expr e2 rho);
+        try solve [inv H1 | inv H3].
         unfold both_long; simpl.
-        apply denote_tc_nonzero_e64 in IBR; try rewrite IBR.
+        iDestruct "IBR" as %IBR.
         destruct t as [| [| | |] ? ? | | | | | | |]; try solve [inv IBR0];
         simpl; auto.
     - (* long int *)
-      destruct s; destruct IBR as [?IBR ?IBR].
-      * destruct IBR as [?IBR ?IBR].
-        apply tc_bool_e in IBR0.
-        simpl in IBR, IBR1 |- *; unfold_lift in IBR; unfold_lift in IBR1.
-        destruct (eval_expr e1 rho), (eval_expr e2 rho);
+      destruct s; simpl; unfold_lift; rewrite tc_bool_e; iIntros "[IBR %IBR0]".
+      * destruct (eval_expr e1 rho), (eval_expr e2 rho);
           try solve [inv H1 | inv H3].
         unfold both_long; simpl.
-        apply denote_tc_nonzero_e, (Int64_eq_repr_int_nonzero sg) in IBR; try rewrite IBR.
-        apply (denote_tc_nodivover_e64_li sg) in IBR1; try rewrite IBR1.
-        simpl.
+        iDestruct "IBR" as %[IBR IBR1].
         destruct t as [| [| | |] ? ? | | | | | | |]; try solve [inv IBR0];
         simpl; auto.
-      * apply tc_bool_e in IBR0.
-        simpl in IBR |- *; unfold_lift in IBR.
-        destruct (eval_expr e1 rho), (eval_expr e2 rho);
-        try solve [inv H1 | inv H3 | inv IBR].
+      * destruct (eval_expr e1 rho), (eval_expr e2 rho);
+        try solve [inv H1 | inv H3].
         unfold both_long; simpl.
-        apply denote_tc_nonzero_e, (Int64_eq_repr_int_nonzero sg) in IBR; try rewrite IBR.
+        iDestruct "IBR" as %IBR.
         destruct t as [| [| | |] ? ? | | | | | | |]; try solve [inv IBR0];
         simpl; auto.
     - (* long long *)
-      destruct s; destruct IBR as [?IBR ?IBR].
-      * destruct IBR as [?IBR ?IBR].
-        apply tc_bool_e in IBR0.
-        simpl in IBR, IBR1 |- *; unfold_lift in IBR; unfold_lift in IBR1.
-        destruct (eval_expr e1 rho), (eval_expr e2 rho);
+      destruct s; simpl; unfold_lift; rewrite tc_bool_e; iIntros "[IBR %IBR0]".
+      * destruct (eval_expr e1 rho), (eval_expr e2 rho);
           try solve [inv H1 | inv H3].
         unfold both_long; simpl.
-        apply denote_tc_nonzero_e64 in IBR; try rewrite IBR.
-        apply denote_tc_nodivover_e64_ll in IBR1; try rewrite IBR1.
-        simpl.
+        iDestruct "IBR" as %[IBR IBR1].
         destruct t as [| [| | |] ? ? | | | | | | |]; try solve [inv IBR0];
         simpl; auto.
-      * apply tc_bool_e in IBR0.
-        simpl in IBR |- *; unfold_lift in IBR.
-        destruct (eval_expr e1 rho), (eval_expr e2 rho);
+      * destruct (eval_expr e1 rho), (eval_expr e2 rho);
         try solve [inv H1 | inv H3 | inv IBR].
         unfold both_long; simpl.
-        apply denote_tc_nonzero_e64 in IBR; try rewrite IBR.
+        iDestruct "IBR" as %IBR.
         destruct t as [| [| | |] ? ? | | | | | | |]; try solve [inv IBR0];
         simpl; auto.
-  + inv IBR.
-  + inv IBR.
-  + inv IBR.
 Qed.
 
 Lemma typecheck_Oshift_sound:
- forall op {CS: compspecs} (rho : environ) m (e1 e2 : expr) (t : type)
-   (IBR: denote_tc_assert (isBinOpResultType op e1 e2 t) rho m)
+ forall op {CS: compspecs} (rho : environ) (e1 e2 : expr) (t : type)
    (TV2: tc_val (typeof e2) (eval_expr e2 rho))
    (TV1: tc_val (typeof e1) (eval_expr e1 rho))
    (OP: op = Oshl \/ op = Oshr),
-   tc_val t
-     (eval_binop op (typeof e1) (typeof e2) (eval_expr e1 rho) (eval_expr e2 rho)).
+   denote_tc_assert (isBinOpResultType op e1 e2 t) rho ⊢
+   ⌜tc_val t
+     (eval_binop op (typeof e1) (typeof e2) (eval_expr e1 rho) (eval_expr e2 rho))⌝.
 Proof.
   intros.
-  replace
-    ((denote_tc_assert (isBinOpResultType op e1 e2 t) rho) m)
-  with
-    ((denote_tc_assert
+  trans (denote_tc_assert
            match classify_shift' (typeof e1) (typeof e2) with
            | shift_case_ii _ =>
                tc_andp' (tc_ilt' e2 Int.iwordsize)
@@ -738,14 +690,11 @@ Proof.
                tc_andp' (tc_llt' e2 Int64.iwordsize)
                  (tc_bool (is_long_type t) (op_result_type (Ebinop op e1 e2 t)))
            | _ => tc_FF (arg_type (Ebinop op e1 e2 t))
-           end rho) m)
-  in IBR
-  by (rewrite den_isBinOpR; destruct OP; subst; auto).
-  destruct (classify_shift' (typeof e1) (typeof e2)) eqn:?H; try solve [inv IBR].
+           end rho).
+  { rewrite den_isBinOpR; destruct OP; subst; auto. }
+  destruct (classify_shift' (typeof e1) (typeof e2)) eqn:?H; try solve [iIntros "[]"]; simpl; unfold_lift.
   + (* shift_ii *)
-    destruct IBR as [?IBR ?IBR].
-    apply tc_bool_e in IBR0.
-    simpl in IBR; unfold_lift in IBR.
+    rewrite tc_bool_e; iIntros "[IBR %IBR0]".
     solve_tc_val TV1;
     solve_tc_val TV2;
     rewrite <- H0, <- H2 in H;
@@ -756,14 +705,12 @@ Proof.
     destruct OP; subst; auto;
     simpl;
     unfold force_val, Clight_Cop2.sem_shift;
-    rewrite classify_shift_eq, H;
+    rewrite classify_shift_eq H;
     simpl.
     - destruct t as [| [| | |] ? ? | | | | | | |]; try solve [inv IBR0]; simpl; auto.
     - destruct t as [| [| | |] ? ? | | | | | | |]; try solve [inv IBR0]; simpl; auto.
   + (* shift_ll *)
-    destruct IBR as [?IBR ?IBR].
-    apply tc_bool_e in IBR0.
-    simpl in IBR; unfold_lift in IBR.
+    rewrite tc_bool_e; iIntros "[IBR %IBR0]".
     solve_tc_val TV1;
     solve_tc_val TV2;
     rewrite <- H0, <- H2 in H;
@@ -774,9 +721,7 @@ Proof.
     destruct OP; subst; auto;
     simpl; destruct t as [| [| | |] ? ? | | | | | | |]; try solve [inv IBR0]; simpl; auto.
   + (* shift_il *)
-    destruct IBR as [?IBR ?IBR].
-    apply tc_bool_e in IBR0.
-    simpl in IBR; unfold_lift in IBR.
+    rewrite tc_bool_e; iIntros "[IBR %IBR0]".
     solve_tc_val TV1;
     solve_tc_val TV2;
     rewrite <- H0, <- H2 in H;
@@ -787,13 +732,11 @@ Proof.
     destruct OP; subst; auto;
     simpl;
     unfold force_val, Clight_Cop2.sem_shift;
-    rewrite classify_shift_eq, H;
+    rewrite classify_shift_eq H;
     simpl;
     destruct t as [| [| | |] ? ? | | | | | | |]; try solve [inv IBR0]; simpl; auto.
   + (* shift_li *)
-    destruct IBR as [?IBR ?IBR].
-    apply tc_bool_e in IBR0.
-    simpl in IBR; unfold_lift in IBR.
+    rewrite tc_bool_e; iIntros "[IBR %IBR0]".
     solve_tc_val TV1;
     solve_tc_val TV2;
     rewrite <- H0, <- H2 in H;
@@ -804,36 +747,31 @@ Proof.
     destruct OP; subst; auto;
     simpl;
     unfold force_val, Clight_Cop2.sem_shift;
-    rewrite classify_shift_eq, H;
+    rewrite classify_shift_eq H;
     simpl;
     destruct t as [| [| | |] ? ? | | | | | | |]; try solve [inv IBR0]; simpl; auto.
 Qed.
 
 Lemma typecheck_Obin_sound:
- forall op {CS: compspecs} (rho : environ) m (e1 e2 : expr) (t : type)
-   (IBR: denote_tc_assert (isBinOpResultType op e1 e2 t) rho m)
+ forall op {CS: compspecs} (rho : environ) (e1 e2 : expr) (t : type)
    (TV2: tc_val (typeof e2) (eval_expr e2 rho))
    (TV1: tc_val (typeof e1) (eval_expr e1 rho))
    (OP: op = Oand \/ op = Oor \/ op = Oxor),
-   tc_val t
-     (eval_binop op (typeof e1) (typeof e2) (eval_expr e1 rho) (eval_expr e2 rho)).
+   denote_tc_assert (isBinOpResultType op e1 e2 t) rho ⊢
+   ⌜tc_val t
+     (eval_binop op (typeof e1) (typeof e2) (eval_expr e1 rho) (eval_expr e2 rho))⌝.
 Proof.
   intros.
-  replace
-    ((denote_tc_assert (isBinOpResultType op e1 e2 t) rho) m)
-  with
-    ((denote_tc_assert
+  trans (denote_tc_assert
            match classify_binarith' (typeof e1) (typeof e2) with
            | bin_case_i _ => tc_bool (is_int32_type t) (op_result_type (Ebinop op e1 e2 t))
            | bin_case_l _ => tc_bool (is_long_type t) (op_result_type (Ebinop op e1 e2 t))
            | _ => tc_FF (arg_type (Ebinop op e1 e2 t))
-           end rho) m)
-  in IBR
-  by (rewrite den_isBinOpR; destruct OP as [| [ | ]]; subst; auto).
-  destruct (classify_binarith' (typeof e1) (typeof e2)) eqn:?H; try solve [inv IBR].
+           end rho).
+  { rewrite den_isBinOpR; destruct OP as [| [ | ]]; subst; auto. }
+  destruct (classify_binarith' (typeof e1) (typeof e2)) eqn:?H; try solve [iIntros "[]"]; simpl; unfold_lift.
   + (* bin_case_i *)
-    apply tc_bool_e in IBR.
-    simpl in IBR; unfold_lift in IBR.
+    rewrite tc_bool_e; iIntros (IBR).
     solve_tc_val TV1;
     solve_tc_val TV2;
     rewrite <- H0, <- H2 in H;
@@ -845,14 +783,13 @@ Proof.
     destruct OP as [| [|]]; subst; auto;
     simpl;
     unfold force_val, Clight_Cop2.sem_and, Clight_Cop2.sem_or, Clight_Cop2.sem_xor, Clight_Cop2.sem_binarith;
-    rewrite classify_binarith_eq, H;
+    rewrite classify_binarith_eq H;
     simpl;
     destruct t as [| [| | |] ? ? | | | | | | |]; try solve [inv IBR]; simpl; auto;
     unfold both_int, Clight_Cop2.sem_cast, Clight_Cop2.classify_cast, sem_cast_pointer;
    destruct Archi.ptr64; reflexivity.
   + (* bin_case_l *)
-    apply tc_bool_e in IBR.
-    simpl in IBR; unfold_lift in IBR.
+    rewrite tc_bool_e; iIntros (IBR).
     solve_tc_val TV1;
     solve_tc_val TV2;
     rewrite <- H0, <- H2 in H;
@@ -863,7 +800,7 @@ Proof.
       destruct OP as [| [|]]; subst; auto;
       simpl;
       unfold force_val, Clight_Cop2.sem_and, Clight_Cop2.sem_or, Clight_Cop2.sem_xor, Clight_Cop2.sem_binarith;
-      rewrite classify_binarith_eq, H;
+      rewrite classify_binarith_eq H;
       simpl;
       destruct t as [| [| | |] ? ? | | | | | | |]; try solve [inv IBR]; simpl; auto.
     - destruct (eval_expr e1 rho), (eval_expr e2 rho);
@@ -871,7 +808,7 @@ Proof.
       destruct OP as [| [|]]; subst; auto;
       simpl;
       unfold force_val, Clight_Cop2.sem_and, Clight_Cop2.sem_or, Clight_Cop2.sem_xor, Clight_Cop2.sem_binarith;
-      rewrite classify_binarith_eq, H;
+      rewrite classify_binarith_eq H;
       simpl;
       destruct t as [| [| | |] ? ? | | | | | | |]; try solve [inv IBR]; simpl; auto.
     - destruct (eval_expr e1 rho), (eval_expr e2 rho);
@@ -879,8 +816,9 @@ Proof.
       destruct OP as [| [|]]; subst; auto;
       simpl;
       unfold force_val, Clight_Cop2.sem_and, Clight_Cop2.sem_or, Clight_Cop2.sem_xor, Clight_Cop2.sem_binarith;
-      rewrite classify_binarith_eq, H;
+      rewrite classify_binarith_eq H;
       simpl;
       destruct t as [| [| | |] ? ? | | | | | | |]; try solve [inv IBR]; simpl; auto.
 Qed.
 
+End mpred.
diff --git a/veric/binop_lemmas4.v b/veric/binop_lemmas4.v
index 098d1adc3d..0fbe4f647b 100644
--- a/veric/binop_lemmas4.v
+++ b/veric/binop_lemmas4.v
@@ -1,7 +1,8 @@
-Require Import VST.msl.msl_standard.
 Require Import VST.veric.Clight_base.
-Require Import VST.veric.compcert_rmaps.
 Require Import VST.veric.Clight_lemmas.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Import VST.veric.res_predicates.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.tycontext.
 Require Import VST.veric.expr2.
 Require Import VST.veric.Clight_Cop2.
@@ -12,24 +13,27 @@ Require Import VST.veric.juicy_mem.
 Import Cop.
 Import Cop2.
 Import Clight_Cop2.
-Import compcert.lib.Maps.
 
-Lemma denote_tc_test_eq_Vint_l: forall m i v,
-  (denote_tc_test_eq (Vint i) v) m ->
-  i = Int.zero.
+Section mpred.
+
+Context `{!heapGS Σ}.
+
+Lemma denote_tc_test_eq_Vint_l: forall i v,
+  denote_tc_test_eq (Vint i) v ⊢
+  ⌜i = Int.zero⌝.
 Proof.
   intros.
-  unfold denote_tc_test_eq in H; simpl in H.
-  destruct Archi.ptr64, v; try solve [inv H]; simpl in H; tauto.
+  unfold denote_tc_test_eq; simpl.
+  destruct Archi.ptr64, v; try solve [iIntros "[]"]; simpl; by iIntros "[% _]".
 Qed.
 
-Lemma denote_tc_test_eq_Vint_r: forall m i v,
-  (denote_tc_test_eq v (Vint i)) m ->
-  i = Int.zero.
+Lemma denote_tc_test_eq_Vint_r: forall i v,
+  denote_tc_test_eq v (Vint i) ⊢
+  ⌜i = Int.zero⌝.
 Proof.
   intros.
-  unfold denote_tc_test_eq in H; simpl in H.
-  destruct Archi.ptr64, v; try solve [inv H]; simpl in H; tauto.
+  unfold denote_tc_test_eq; simpl.
+  destruct Archi.ptr64, v; try solve [iIntros "[]"]; simpl; by iIntros "[% ?]".
 Qed.
 
 
@@ -40,172 +44,141 @@ Proof.
  simpl; intros. destruct (peq p q); auto. inv H.
 Qed.
 
-Lemma denote_tc_test_eq_Vint_l': forall m i v,
-  (denote_tc_test_eq (Vint i) v) m ->
-  Int.eq i Int.zero = true.
+Lemma denote_tc_test_eq_Vint_l': forall i v,
+  denote_tc_test_eq (Vint i) v ⊢
+  ⌜Int.eq i Int.zero = true⌝.
 Proof.
   intros.
-  unfold denote_tc_test_eq in H; simpl in H.
-  destruct v; try solve [inv H]; destruct Archi.ptr64; try solve [inv H];
-   simpl in H; destruct H; subst;
-   apply Int.eq_true.
+  unfold denote_tc_test_eq; simpl.
+  destruct v; try solve [iIntros "[]"]; destruct Archi.ptr64; try solve [iIntros "[]"];
+    iIntros "[-> _]"; iPureIntro; apply Int.eq_true.
 Qed.
 
-Lemma denote_tc_test_eq_Vint_r': forall m i v,
-  (denote_tc_test_eq v (Vint i)) m ->
-  Int.eq i Int.zero = true.
+Lemma denote_tc_test_eq_Vint_r': forall i v,
+  denote_tc_test_eq v (Vint i) ⊢
+  ⌜Int.eq i Int.zero = true⌝.
 Proof.
   intros.
-  unfold denote_tc_test_eq in H; simpl in H.
-  destruct v; try solve [inv H];  destruct Archi.ptr64; try solve [inv H];
-  simpl in H; destruct H; subst;
-   apply Int.eq_true.
+  unfold denote_tc_test_eq; simpl.
+  destruct v; try solve [iIntros "[]"]; destruct Archi.ptr64; try solve [iIntros "[]"];
+    (iIntros "[_ ->]" || iIntros "[-> _]"); iPureIntro; apply Int.eq_true.
 Qed.
 
-Lemma denote_tc_test_eq_Vlong_l': forall m i v,
-  (denote_tc_test_eq (Vlong i) v) m ->
-  Int64.eq i Int64.zero = true.
+Lemma denote_tc_test_eq_Vlong_l': forall i v,
+  denote_tc_test_eq (Vlong i) v ⊢
+  ⌜Int64.eq i Int64.zero = true⌝.
 Proof.
   intros.
-  unfold denote_tc_test_eq in H; simpl in H.
-  destruct v; try solve [inv H]; destruct Archi.ptr64; try solve [inv H];
-   simpl in H; destruct H; subst;
-   try apply Int.eq_true; apply Int64.eq_true.
+  unfold denote_tc_test_eq; simpl.
+  destruct v; try solve [iIntros "[]"]; destruct Archi.ptr64; try solve [iIntros "[]"];
+    iIntros "[-> _]"; iPureIntro; apply Int64.eq_true.
 Qed.
 
-Lemma denote_tc_test_eq_Vlong_r': forall m i v,
-  (denote_tc_test_eq v (Vlong i)) m ->
-  Int64.eq i Int64.zero = true.
+Lemma denote_tc_test_eq_Vlong_r': forall i v,
+  denote_tc_test_eq v (Vlong i) ⊢
+  ⌜Int64.eq i Int64.zero = true⌝.
 Proof.
   intros.
-  unfold denote_tc_test_eq in H; simpl in H.
-  destruct v; try solve [inv H];  destruct Archi.ptr64; try solve [inv H];
-  simpl in H; destruct H; subst;
-   try apply Int.eq_true; apply Int64.eq_true.
+  unfold denote_tc_test_eq; simpl.
+  destruct v; try solve [iIntros "[]"]; destruct Archi.ptr64; try solve [iIntros "[]"];
+    (iIntros "[_ ->]" || iIntros "[-> _]"); iPureIntro; apply Int64.eq_true.
 Qed.
 
 Lemma denote_tc_test_order_eqblock:
-  forall phi b0 i0 b i,
-   app_pred (denote_tc_test_order (Vptr b0 i0) (Vptr b i)) phi ->
-     b0 = b.
+  forall b0 i0 b i,
+   denote_tc_test_order (Vptr b0 i0) (Vptr b i) ⊢
+   ⌜b0 = b⌝.
 Proof.
 intros.
-unfold denote_tc_test_order in H; simpl in H.
-unfold test_order_ptrs in H.
-simpl in H. destruct (peq b0 b); auto. contradiction H.
+unfold denote_tc_test_order; simpl.
+unfold test_order_ptrs; simpl.
+destruct (peq b0 b); auto.
 Qed.
 
 Lemma valid_pointer_dry:
-  forall b ofs d m, app_pred (valid_pointer' (Vptr b ofs) d) (m_phi m) ->
-           Mem.valid_pointer (m_dry m) b (Ptrofs.unsigned ofs + d) = true.
+  forall b ofs d m, mem_auth m ∗ valid_pointer' (Vptr b ofs) d ⊢
+         ⌜Mem.valid_pointer m b (Ptrofs.unsigned ofs + d) = true⌝.
 Proof.
 intros.
-simpl in H.
-destruct (m_phi m @ (b, Ptrofs.unsigned ofs + d)) eqn:?H; try contradiction.
-*
-pose proof (juicy_mem_access m (b, Ptrofs.unsigned ofs + d)).
-rewrite H0 in H1.
-unfold access_at in H1.
-unfold perm_of_res in H1.
-simpl in H1. clear H0.
-rewrite if_false in H1.
-assert (exists x, (Mem.mem_access (m_dry m)) !! b (Ptrofs.unsigned ofs + d) Cur = Some x).
-destruct ((Mem.mem_access (m_dry m)) !! b (Ptrofs.unsigned ofs + d) Cur); inv H1; eauto.
-destruct H0.
-apply perm_order'_dec_fiddle with x.
-auto.
-intro; subst sh. apply H; auto.
-*
-subst.
-pose proof (juicy_mem_access m (b, Ptrofs.unsigned ofs + d)).
-rewrite H0 in H1.
-unfold access_at in H1.
-unfold perm_of_res in H1.
-simpl in H1. clear H0 H.
-unfold Mem.valid_pointer.
-unfold Mem.perm_dec.
-destruct k.
-+
-assert (exists x, (Mem.mem_access (m_dry m)) !! b (Ptrofs.unsigned ofs + d) Cur = Some x).
-rewrite H1. unfold perm_of_sh. repeat if_tac; try contradiction; eauto.
-destruct H as [x H]; apply perm_order'_dec_fiddle with x; auto.
-+
-assert (exists x, (Mem.mem_access (m_dry m)) !! b (Ptrofs.unsigned ofs + d) Cur = Some x).
-rewrite H1. unfold perm_of_sh. repeat if_tac; try contradiction; eauto.
-destruct H as [x H]; apply perm_order'_dec_fiddle with x; auto.
-+
-assert (exists x, (Mem.mem_access (m_dry m)) !! b (Ptrofs.unsigned ofs + d) Cur = Some x).
-rewrite H1. unfold perm_of_sh. repeat if_tac; try contradiction; eauto.
-destruct H as [x H]; apply perm_order'_dec_fiddle with x; auto.
-* (*new case:Pure*) 
-unfold Mem.valid_pointer. destruct m. simpl in *.
-Search access_cohere.
-specialize (JMaccess (b, Ptrofs.unsigned ofs + d)).
-remember (Mem.perm_dec m b (Ptrofs.unsigned ofs + d) Cur Nonempty) as q; destruct q; simpl in *; trivial.
-exfalso; apply n; clear n Heqq.
-apply perm_access. rewrite JMaccess, H0. apply perm_refl.
+iIntros "[Hm >H]".
+iAssert ⌜∃ dq r, ✓ dq ∧ dq ≠ ε ∧ coherent_loc m (b, Ptrofs.unsigned ofs + d)%Z (dq, r)⌝ with "[-]" as %(dq & r & Hdq & ? & H).
+{ iDestruct "H" as "[(% & % & H) | (% & % & H)]"; [iDestruct (mapsto_lookup with "Hm H") as %(? & ? & ? & ?) |
+    iDestruct (mapsto_no_lookup with "Hm H") as %(? & ? & ?)]; iPureIntro.
+  - eexists _, _; split; first done; split; last done.
+    intros ->; contradiction bot_unreadable.
+  - eexists (DfracOwn (Share sh)), _; split; first done; split; last done.
+    intros [=]; done. }
+iPureIntro.
+rewrite Mem.valid_pointer_nonempty_perm /Mem.perm.
+destruct H as (_ & H).
+rewrite /access_cohere /access_at in H.
+destruct (Maps.PMap.get _ _ _ _); try constructor.
+destruct (perm_of_res_cases dq r) as [(? & -> & Hperm) | (? & Hperm)]; setoid_rewrite Hperm in H; clear Hperm.
+- destruct (perm_of_dfrac dq) eqn: Hp; first done.
+  apply perm_of_dfrac_None in Hp as [-> | ->]; done.
+- rewrite !if_false // in H.
+  intros ->; done.
 Qed.
 
 Lemma weak_valid_pointer_dry:
-  forall b ofs m, app_pred (weak_valid_pointer (Vptr b ofs)) (m_phi m) ->
-           (Mem.valid_pointer (m_dry m) b (Ptrofs.unsigned ofs)
-           || Mem.valid_pointer (m_dry m) b (Ptrofs.unsigned ofs - 1))%bool = true.
+  forall b ofs m, mem_auth m ∗ weak_valid_pointer (Vptr b ofs) ⊢
+           ⌜(Mem.valid_pointer m b (Ptrofs.unsigned ofs)
+            || Mem.valid_pointer m b (Ptrofs.unsigned ofs - 1))%bool = true⌝.
 Proof.
 intros.
-rewrite orb_true_iff.
-destruct H; [left  | right].
-rewrite <- (Z.add_0_r (Ptrofs.unsigned ofs)).
-apply valid_pointer_dry; auto.
-rewrite <- Z.add_opp_r.
-apply valid_pointer_dry; auto.
+rewrite orb_true_iff /weak_valid_pointer.
+iIntros "[Hm [H | H]]".
+- iLeft; rewrite <- (Z.add_0_r (Ptrofs.unsigned ofs)).
+  iApply valid_pointer_dry; iFrame.
+- iRight; rewrite <- Z.add_opp_r.
+  iApply valid_pointer_dry; iFrame.
 Qed.
 
 Lemma test_eq_relate':
-  forall v1 v2 op m
-    (OP: op = Ceq \/ op = Cne),
-     (denote_tc_test_eq v1 v2) (m_phi m) ->
-     cmp_ptr (m_dry m) op v1 v2 = 
-     Some (force_val (sem_cmp_pp op v1 v2)).
+  forall v1 v2 op
+    (OP: op = Ceq \/ op = Cne) m,
+     mem_auth m ∗ denote_tc_test_eq v1 v2 ⊢
+     ⌜cmp_ptr m op v1 v2 = 
+     Some (force_val (sem_cmp_pp op v1 v2))⌝.
 Proof.
-intros.
+intros; iIntros "[Hm H]".
 unfold cmp_ptr, sem_cmp_pp.
-unfold denote_tc_test_eq in H.
+unfold denote_tc_test_eq.
  rewrite bool2val_eq.
- destruct v1; try contradiction; auto;
- destruct v2; try contradiction; auto.
+ destruct v1; try done; auto;
+ destruct v2; try done; auto.
 *
  simpl.
- destruct Archi.ptr64; try contradiction.
- destruct H.  hnf in H. subst i; rewrite ?Int.eq_true, ?Int64.eq_true. simpl.
- apply weak_valid_pointer_dry in H0.
- rewrite H0.
+ destruct Archi.ptr64; try done.
+ iDestruct "H" as "[-> H]".
+ rewrite ?Int.eq_true ?Int64.eq_true /=.
+ iDestruct (weak_valid_pointer_dry with "[$Hm $H]") as %->.
  destruct OP; subst; simpl; auto.
 *
  simpl.
- destruct Archi.ptr64; try contradiction.
- destruct H.  hnf in H. subst; rewrite ?Int.eq_true, ?Int64.eq_true. simpl.
- apply weak_valid_pointer_dry in H0.
- rewrite H0.
+ destruct Archi.ptr64; try done.
+ iDestruct "H" as "[-> H]".
+ rewrite ?Int.eq_true ?Int64.eq_true /=.
+ iDestruct (weak_valid_pointer_dry with "[$Hm $H]") as %->.
  destruct OP; subst; simpl; auto.
 *
  simpl.
- unfold test_eq_ptrs in *.
- unfold sameblock in H.
+ unfold test_eq_ptrs.
+ unfold sameblock.
  destruct (peq b b0);
-  simpl proj_sumbool in H; cbv iota in H;
- [rewrite !if_true by auto | rewrite !if_false by auto].
- destruct H.
- apply weak_valid_pointer_dry in H.
- apply weak_valid_pointer_dry in H0.
- rewrite H. rewrite H0.
- simpl.
- reflexivity.
- destruct H.
- apply valid_pointer_dry in H.
- apply valid_pointer_dry in H0.
- rewrite Z.add_0_r in H,H0.
- rewrite H. rewrite H0.
- destruct OP; subst;  reflexivity.
+  simpl proj_sumbool; cbv iota;
+ [rewrite -> !if_true by auto | rewrite -> !if_false by auto].
+ - iDestruct (weak_valid_pointer_dry with "[-]") as %->.
+   { iDestruct "H" as "[$ _]"; iFrame. }
+   iDestruct (weak_valid_pointer_dry with "[-]") as %->.
+   { iDestruct "H" as "[_ $]"; iFrame. }
+   done.
+ - iDestruct (valid_pointer_dry with "[-]") as %H.
+   { iDestruct "H" as "[$ _]"; iFrame. }
+   iDestruct (valid_pointer_dry with "[-]") as %H0.
+   { iDestruct "H" as "[_ $]"; iFrame. }
+   rewrite -> Z.add_0_r in H,H0; rewrite H H0.
+   destruct OP; subst; done.
 Qed.
 
 Lemma sem_cast_relate:
@@ -261,29 +234,29 @@ auto.
 Qed.
 
 Lemma denote_tc_test_eq_xx:
- forall v si i phi,
- app_pred (denote_tc_test_eq v (Vint i)) phi ->
- app_pred (denote_tc_test_eq v (Vptrofs (ptrofs_of_int si i))) phi.
+ forall v si i,
+ denote_tc_test_eq v (Vint i) ⊢
+ denote_tc_test_eq v (Vptrofs (ptrofs_of_int si i)).
 Proof.
 intros.
-unfold denote_tc_test_eq in *.
-destruct v; try contradiction;
-unfold Vptrofs, ptrofs_of_int; simpl;
-destruct Archi.ptr64; try contradiction;
-destruct H; hnf in *; subst; destruct si; split; hnf; auto.
+unfold denote_tc_test_eq.
+destruct v; try (iIntros "[]");
+unfold Vptrofs, ptrofs_of_int;
+destruct Archi.ptr64 eqn: H; try done; iIntros "(% & H)"; try iFrame; iFrame "%"; try iDestruct "H" as %?; subst;
+destruct si; auto.
 Qed.
 
 Lemma denote_tc_test_eq_yy:
- forall v si i phi,
- app_pred (denote_tc_test_eq (Vint i) v) phi ->
- app_pred (denote_tc_test_eq (Vptrofs (ptrofs_of_int si i)) v) phi.
+ forall v si i,
+ denote_tc_test_eq (Vint i) v ⊢
+ denote_tc_test_eq (Vptrofs (ptrofs_of_int si i)) v.
 Proof.
 intros.
-unfold denote_tc_test_eq in *.
-destruct v; try contradiction;
-unfold Vptrofs, ptrofs_of_int; simpl;
-destruct Archi.ptr64; try contradiction;
-destruct H; hnf in *; subst; destruct si; split; hnf; auto.
+unfold denote_tc_test_eq .
+destruct v; try (iIntros "[]");
+unfold Vptrofs, ptrofs_of_int;
+destruct Archi.ptr64 eqn: H; try done; iIntros "(% & H)"; try iFrame; iFrame "%"; try iDestruct "H" as %?; subst;
+destruct si; auto.
 Qed.
 
 Lemma sem_cast_long_intptr_lemma:
@@ -302,27 +275,25 @@ Qed.
 
 Lemma test_order_relate':
   forall v1 v2 op m,
-     (denote_tc_test_order v1 v2) (m_phi m) ->
-   cmp_ptr (m_dry m) op v1 v2 = Some (force_val (sem_cmp_pp op v1 v2)).
+     mem_auth m ∗ denote_tc_test_order v1 v2 ⊢
+   ⌜cmp_ptr m op v1 v2 = Some (force_val (sem_cmp_pp op v1 v2))⌝.
 Proof.
-  intros.
-  unfold denote_tc_test_order in H.
-  destruct v1; try contradiction; auto;
-  destruct v2; try contradiction; auto;
+  intros; iIntros "[Hm H]".
+  unfold denote_tc_test_order.
+  destruct v1; try done; auto;
+  destruct v2; try done; auto;
   unfold cmp_ptr, sem_cmp_pp; simpl;
   rewrite bool2val_eq; auto.
-  unfold test_order_ptrs in *.
-  unfold sameblock in H.
+  unfold test_order_ptrs.
+  unfold sameblock.
   destruct (peq b b0);
-  simpl proj_sumbool in H; cbv iota in H;
-    [rewrite !if_true by auto | rewrite !if_false by auto].
-  + destruct H.
-    apply weak_valid_pointer_dry in H.
-    apply weak_valid_pointer_dry in H0.
-    rewrite H. rewrite H0.
-    simpl.
-    reflexivity.
-  + inv H.
+  simpl proj_sumbool; cbv iota;
+    [rewrite -> !if_true by auto | rewrite -> !if_false by auto; done].
+  iDestruct (weak_valid_pointer_dry with "[-]") as %->.
+  { iDestruct "H" as "[$ _]"; iFrame. }
+  iDestruct (weak_valid_pointer_dry with "[-]") as %->.
+  { iDestruct "H" as "[_ $]"; iFrame. }
+  done.
 Qed.
 
 Lemma sem_cast_int_intptr_lemma:
@@ -338,7 +309,7 @@ intros.
  unfold Ptrofs.to_int64.
  unfold Ptrofs.of_ints.
  f_equal.
- rewrite (Ptrofs.agree64_repr Hp), Int64.repr_unsigned. auto.
+ rewrite (Ptrofs.agree64_repr Hp) Int64.repr_unsigned. auto.
  f_equal.
  unfold Ptrofs.to_int64.
  unfold Ptrofs.of_intu. unfold Ptrofs.of_int.
@@ -353,29 +324,28 @@ intros.
   simpl; f_equal;
   unfold Ptrofs.to_int, ptrofs_of_int, Ptrofs.of_ints, Ptrofs.of_intu, Ptrofs.of_int;
   destruct si;
-  rewrite ?(Ptrofs.agree32_repr Hp),
-    ?Int.repr_unsigned, ?Int.repr_signed; auto).
+  rewrite ?(Ptrofs.agree32_repr Hp)
+    ?Int.repr_unsigned ?Int.repr_signed; auto).
 Qed.
 
 Lemma test_eq_fiddle_signed_xx:
- forall si si' v i phi, 
-app_pred (denote_tc_test_eq v (Vptrofs (ptrofs_of_int si i))) phi ->
-app_pred (denote_tc_test_eq v (Vptrofs (ptrofs_of_int si' i))) phi.
+ forall si si' v i, 
+denote_tc_test_eq v (Vptrofs (ptrofs_of_int si i)) ⊢
+denote_tc_test_eq v (Vptrofs (ptrofs_of_int si' i)).
 Proof.
 intros.
-unfold denote_tc_test_eq in *.
-unfold Vptrofs, ptrofs_of_int in *.
-destruct v; try contradiction;
-destruct Archi.ptr64 eqn:Hp; try contradiction; subst.
+unfold denote_tc_test_eq.
+unfold Vptrofs, ptrofs_of_int.
+destruct v; try (iIntros "[]");
+destruct Archi.ptr64 eqn:Hp; try (iIntros "[]"); subst.
 -
-destruct H; split; auto.
+iPureIntro; intros [??]; split; auto.
 clear H.
-hnf in H0|-*.
 destruct si; auto.
 *
 unfold Ptrofs.of_ints in *.
 unfold Ptrofs.to_int, Ptrofs.to_int64 in *.
-rewrite ?Ptrofs.agree32_repr, ?Ptrofs.agree64_repr,
+rewrite -> ?Ptrofs.agree32_repr, ?Ptrofs.agree64_repr,
              ?Int.repr_unsigned, ?Int64.repr_unsigned in H0 by auto.
 assert (i=Int.zero)
   by first [apply Int64repr_Intsigned_zero; solve [auto]
@@ -386,7 +356,7 @@ destruct si'; auto.
 destruct si'; auto.
 unfold Ptrofs.of_intu in H0.
 try ( (* Archi.ptr64=false case *)
- rewrite Ptrofs.to_int_of_int in H0 by auto;
+ rewrite -> Ptrofs.to_int_of_int in H0 by auto;
  subst;
  unfold Ptrofs.of_ints;
  rewrite Int.signed_zero;
@@ -404,9 +374,8 @@ rewrite Ptrofs.unsigned_repr in H0;
      by (unfold Ptrofs.max_unsigned, Ptrofs.modulus, Ptrofs.wordsize, Wordsize_Ptrofs.wordsize; rewrite Hp; compute; auto);
     lia]).
 -
-destruct H.
+iIntros "[% $]"; iPureIntro.
 split; auto.
-hnf in H|-*. clear H0.
 destruct si, si'; auto.
 *
 unfold Ptrofs.of_ints, Ptrofs.of_intu in *.
@@ -423,36 +392,34 @@ rewrite Int64.repr_unsigned in H.
 apply Int64repr_Intunsigned_zero in H. subst.
 reflexivity.
 -
-destruct H.
-split; auto.
-hnf in H|-*. clear H0.
+iIntros "[% $]"; iPureIntro.
 destruct si, si'; auto;
 unfold Ptrofs.to_int, Ptrofs.of_intu, Ptrofs.of_ints, Ptrofs.of_int in *;
 rewrite (Ptrofs.agree32_repr Hp) in H;
 rewrite (Ptrofs.agree32_repr Hp);
-rewrite Int.repr_unsigned in *;
-rewrite Int.repr_signed in *; rewrite Int.repr_unsigned in *; auto.
+rewrite -> Int.repr_unsigned in *;
+rewrite -> Int.repr_signed in *; rewrite -> Int.repr_unsigned in *; auto.
 Qed.
 
 Lemma test_eq_fiddle_signed_yy:
- forall si si' v i phi, 
-app_pred (denote_tc_test_eq (Vptrofs (ptrofs_of_int si i)) v) phi ->
-app_pred (denote_tc_test_eq (Vptrofs (ptrofs_of_int si' i)) v) phi.
+ forall si si' v i,
+denote_tc_test_eq (Vptrofs (ptrofs_of_int si i)) v ⊢
+denote_tc_test_eq (Vptrofs (ptrofs_of_int si' i)) v.
 Proof.
 intros.
-unfold denote_tc_test_eq in *.
-unfold Vptrofs, ptrofs_of_int in *.
-destruct v; try contradiction;
-destruct Archi.ptr64 eqn:Hp; try contradiction; subst.
+unfold denote_tc_test_eq.
+unfold Vptrofs, ptrofs_of_int.
+destruct v; try (iIntros "[]");
+destruct Archi.ptr64 eqn:Hp; try (iIntros "[]"); subst.
 -
-destruct H; split; auto.
+iPureIntro; intros [??]; split; auto.
 clear H0.
 hnf in H|-*.
 destruct si; auto.
 *
 unfold Ptrofs.of_ints in *.
 unfold Ptrofs.to_int, Ptrofs.to_int64 in *.
-rewrite ?Ptrofs.agree32_repr, ?Ptrofs.agree64_repr,
+rewrite -> ?Ptrofs.agree32_repr, ?Ptrofs.agree64_repr,
              ?Int.repr_unsigned, ?Int64.repr_unsigned in H by auto.
 assert (i=Int.zero)
   by first [apply Int64repr_Intsigned_zero; solve [auto]
@@ -463,7 +430,7 @@ destruct si'; auto.
 destruct si'; auto.
 unfold Ptrofs.of_intu in H.
 try ( (* Archi.ptr64=false case *)
- rewrite Ptrofs.to_int_of_int in H by auto;
+ rewrite -> Ptrofs.to_int_of_int in H by auto;
  subst;
  unfold Ptrofs.of_ints;
  rewrite Int.signed_zero;
@@ -481,9 +448,8 @@ rewrite Ptrofs.unsigned_repr in H;
      by (unfold Ptrofs.max_unsigned, Ptrofs.modulus, Ptrofs.wordsize, Wordsize_Ptrofs.wordsize; rewrite Hp; compute; auto);
     lia]).
 -
-destruct H.
+iIntros "[% $]"; iPureIntro.
 split; auto.
-hnf in H|-*. clear H0.
 destruct si, si'; auto.
 *
 unfold Ptrofs.of_ints, Ptrofs.of_intu in *.
@@ -500,112 +466,112 @@ rewrite Int64.repr_unsigned in H.
 apply Int64repr_Intunsigned_zero in H. subst.
 reflexivity.
 -
-destruct H.
-split; auto.
-hnf in H|-*. clear H0.
+iIntros "[% $]"; iPureIntro.
 destruct si, si'; auto;
 unfold Ptrofs.to_int, Ptrofs.of_intu, Ptrofs.of_ints, Ptrofs.of_int in *;
 rewrite (Ptrofs.agree32_repr Hp) in H;
 rewrite (Ptrofs.agree32_repr Hp);
-rewrite Int.repr_unsigned in *;
-rewrite Int.repr_signed in *; rewrite Int.repr_unsigned in *; auto.
+rewrite -> Int.repr_unsigned in *;
+rewrite -> Int.repr_signed in *; rewrite -> Int.repr_unsigned in *; auto.
 Qed.
 
 
 Lemma test_order_fiddle_signed_xx:
- forall si si' v i phi, 
-app_pred (denote_tc_test_order v (Vptrofs (ptrofs_of_int si i))) phi ->
-app_pred (denote_tc_test_order v (Vptrofs (ptrofs_of_int si' i))) phi.
+ forall si si' v i,
+denote_tc_test_order v (Vptrofs (ptrofs_of_int si i)) ⊢
+denote_tc_test_order v (Vptrofs (ptrofs_of_int si' i)).
 Proof.
 intros.
-unfold denote_tc_test_order in *.
-unfold Vptrofs, ptrofs_of_int in *.
-destruct v; try contradiction;
-destruct Archi.ptr64 eqn:Hp; try contradiction; subst.
-destruct H; split; auto.
+unfold denote_tc_test_order.
+unfold Vptrofs, ptrofs_of_int.
+destruct v; try (iIntros "[]");
+destruct Archi.ptr64 eqn:Hp; try (iIntros "[]"); subst.
+iPureIntro; intros [??]; split; auto.
 clear H.
-hnf in H0|-*.
 destruct si, si'; auto;
 try ( (* Archi.ptr64 = false *)
 unfold Ptrofs.to_int, Ptrofs.of_intu, Ptrofs.of_ints, Ptrofs.of_int in *;
 rewrite (Ptrofs.agree32_repr Hp) in H0;
 rewrite (Ptrofs.agree32_repr Hp);
-rewrite Int.repr_unsigned in *;
-rewrite Int.repr_signed in *; rewrite Int.repr_unsigned in *; auto);
+rewrite -> Int.repr_unsigned in *;
+rewrite -> Int.repr_signed in *; rewrite -> Int.repr_unsigned in *; auto);
 try ((* Archi.ptr64 = true *)
   unfold Ptrofs.to_int, Ptrofs.of_intu, Ptrofs.of_ints, Ptrofs.of_int in *;
   unfold Ptrofs.to_int64 in *;
-  rewrite Ptrofs.unsigned_repr_eq in *;
+  rewrite -> Ptrofs.unsigned_repr_eq in *;
   change Ptrofs.modulus with Int64.modulus in *;
   rewrite <- Int64.unsigned_repr_eq in *;
-  rewrite Int64.repr_unsigned in *;
+  rewrite -> Int64.repr_unsigned in *;
   first [apply Int64repr_Intsigned_zero in H0 
           |apply Int64repr_Intunsigned_zero in H0];
   subst i; reflexivity).
 Qed.
 
 Lemma test_order_fiddle_signed_yy:
- forall si si' v i phi, 
-app_pred (denote_tc_test_order (Vptrofs (ptrofs_of_int si i)) v) phi ->
-app_pred (denote_tc_test_order (Vptrofs (ptrofs_of_int si' i)) v) phi.
+ forall si si' v i,
+denote_tc_test_order (Vptrofs (ptrofs_of_int si i)) v ⊢
+denote_tc_test_order (Vptrofs (ptrofs_of_int si' i)) v.
 Proof.
 intros.
-unfold denote_tc_test_order in *.
-unfold Vptrofs, ptrofs_of_int in *.
-destruct v; try contradiction;
-destruct Archi.ptr64 eqn:Hp; try contradiction; subst.
-destruct H; split; auto.
+unfold denote_tc_test_order.
+unfold Vptrofs, ptrofs_of_int.
+destruct v; try iIntros "[]";
+destruct Archi.ptr64 eqn:Hp; try iIntros "[]"; subst.
+iPureIntro; intros [??]; split; auto.
 clear H0.
-hnf in H|-*.
 destruct si, si'; auto;
 try ( (* Archi.ptr64 = false *)
 unfold Ptrofs.to_int, Ptrofs.of_intu, Ptrofs.of_ints, Ptrofs.of_int in *;
 rewrite (Ptrofs.agree32_repr Hp) in H;
 rewrite (Ptrofs.agree32_repr Hp);
-rewrite Int.repr_unsigned in *;
-rewrite Int.repr_signed in *; rewrite Int.repr_unsigned in *; auto);
+rewrite -> Int.repr_unsigned in *;
+rewrite -> Int.repr_signed in *; rewrite -> Int.repr_unsigned in *; auto);
 try ((* Archi.ptr64 = true *)
   unfold Ptrofs.to_int, Ptrofs.of_intu, Ptrofs.of_ints, Ptrofs.of_int in *;
   unfold Ptrofs.to_int64 in *;
-  rewrite Ptrofs.unsigned_repr_eq in *;
+  rewrite -> Ptrofs.unsigned_repr_eq in *;
   change Ptrofs.modulus with Int64.modulus in *;
   rewrite <- Int64.unsigned_repr_eq in *;
-  rewrite Int64.repr_unsigned in *;
+  rewrite -> Int64.repr_unsigned in *;
   first [apply Int64repr_Intsigned_zero in H 
           |apply Int64repr_Intunsigned_zero in H];
   subst i; reflexivity).
 Qed.
 
 Lemma denote_tc_nonzero_e':
- forall i m, app_pred (denote_tc_nonzero (Vint i)) m -> Int.eq i Int.zero = false.
+ forall i, denote_tc_nonzero (Vint i) ⊢ ⌜Int.eq i Int.zero = false⌝.
 Proof.
-simpl; intros; apply Int.eq_false; auto.
+simpl; intros; iPureIntro; apply Int.eq_false.
 Qed.
 
 Lemma denote_tc_nodivover_e':
- forall i j m, app_pred (denote_tc_nodivover (Vint i) (Vint j)) m ->
-   Int.eq i (Int.repr Int.min_signed) && Int.eq j Int.mone = false.
+ forall i j, denote_tc_nodivover (Vint i) (Vint j) ⊢
+   ⌜Int.eq i (Int.repr Int.min_signed) && Int.eq j Int.mone = false⌝.
 Proof.
-simpl; intros.
+simpl; intros; iPureIntro.
 rewrite andb_false_iff.
-apply Classical_Prop.not_and_or in H.
-destruct H; [left|right]; apply Int.eq_false; auto.
+destruct (Int.eq j Int.mone) eqn: Hj; auto.
+apply Int.same_if_eq in Hj as ->.
+destruct (Int.eq) eqn: Hi; auto.
+apply Int.same_if_eq in Hi as ->; tauto.
 Qed.
 
 Lemma denote_tc_nonzero_e64':
- forall i m, app_pred (denote_tc_nonzero (Vlong i)) m -> Int64.eq i Int64.zero = false.
+ forall i, denote_tc_nonzero (Vlong i) ⊢ ⌜Int64.eq i Int64.zero = false⌝.
 Proof.
-simpl; intros; apply Int64.eq_false; auto.
+simpl; intros; iPureIntro; apply Int64.eq_false.
 Qed.
 
 Lemma denote_tc_nodivover_e64_ll':
- forall i j m, app_pred (denote_tc_nodivover (Vlong i) (Vlong j)) m ->
-   Int64.eq i (Int64.repr Int64.min_signed) && Int64.eq j Int64.mone = false.
+ forall i j, denote_tc_nodivover (Vlong i) (Vlong j) ⊢
+   ⌜Int64.eq i (Int64.repr Int64.min_signed) && Int64.eq j Int64.mone = false⌝.
 Proof.
-simpl; intros.
+simpl; intros; iPureIntro.
 rewrite andb_false_iff.
-apply Classical_Prop.not_and_or in H.
-destruct H; [left|right]; apply Int64.eq_false; auto.
+destruct (Int64.eq j Int64.mone) eqn: Hj; auto.
+apply Int64.same_if_eq in Hj as ->.
+destruct (Int64.eq) eqn: Hi; auto.
+apply Int64.same_if_eq in Hi as ->; tauto.
 Qed.
 
 Lemma denote_tc_nodivover_e64_il':
@@ -613,20 +579,26 @@ Lemma denote_tc_nodivover_e64_il':
    Int64.eq (cast_int_long s i) (Int64.repr Int64.min_signed) && Int64.eq j Int64.mone = false.
 Proof.
 intros.
-assert (app_pred (denote_tc_nodivover (Vint i) (Vlong j)) (empty_rmap O)) by apply I.
+assert (⊢denote_tc_nodivover (Vint i) (Vlong j)) as H by auto.
+rewrite (denote_tc_nodivover_e64_il s) in H.
+apply ouPred.pure_soundness in H.
 rewrite andb_false_iff.
-destruct (Classical_Prop.not_and_or _ _ (denote_tc_nodivover_e64_il s _ _ _ H)); [left|right];
- apply Int64.eq_false; auto.
+destruct (Int64.eq j Int64.mone) eqn: Hj; auto.
+apply Int64.same_if_eq in Hj as ->.
+destruct (Int64.eq) eqn: Hi; auto.
+apply Int64.same_if_eq in Hi; tauto.
 Qed.
 
 Lemma denote_tc_nodivover_e64_li':
- forall s i j m, app_pred (denote_tc_nodivover (Vlong i) (Vint j)) m ->
-   Int64.eq i (Int64.repr Int64.min_signed) && Int64.eq (cast_int_long s j) Int64.mone = false.
+ forall s i j, denote_tc_nodivover (Vlong i) (Vint j) ⊢
+   ⌜Int64.eq i (Int64.repr Int64.min_signed) && Int64.eq (cast_int_long s j) Int64.mone = false⌝.
 Proof.
 intros.
-rewrite andb_false_iff.
-destruct (Classical_Prop.not_and_or _ _ (denote_tc_nodivover_e64_li s _ _ _ H)); [left|right];
- apply Int64.eq_false; auto.
+rewrite andb_false_iff (denote_tc_nodivover_e64_li s); iPureIntro.
+destruct (Int64.eq i _) eqn: Hi; auto.
+apply Int64.same_if_eq in Hi as ->.
+destruct (Int64.eq) eqn: Hj; auto.
+apply Int64.same_if_eq in Hj; tauto.
 Qed.
 
 Lemma Int64_eq_repr_signed32_nonzero':
@@ -660,26 +632,26 @@ apply Int64.eq_false; auto.
 Qed.
 
 Lemma denote_tc_igt_e':
-  forall m i j, app_pred (denote_tc_igt j (Vint i)) m ->
-        Int.ltu i j = true.
+  forall i j, denote_tc_igt j (Vint i) ⊢
+        ⌜Int.ltu i j = true⌝.
 Proof.
-intros. unfold Int.ltu. rewrite if_true by (apply (denote_tc_igt_e _ _ _ H)); auto.
+intros. rewrite /Int.ltu denote_tc_igt_e; iPureIntro.
+intros; rewrite if_true; auto.
 Qed.
 
 Lemma denote_tc_lgt_e':
-  forall m i j, app_pred (denote_tc_lgt j (Vlong i)) m ->
-        Int64.ltu i j = true.
-Proof.
-intros. unfold Int64.ltu. rewrite if_true by (apply (denote_tc_lgt_e _ _ _ H)); auto.
+  forall i j, denote_tc_lgt j (Vlong i) ⊢
+        ⌜Int64.ltu i j = true⌝.
+intros. rewrite /Int64.ltu denote_tc_lgt_e; iPureIntro.
+intros; rewrite if_true; auto.
 Qed.
 
 Lemma denote_tc_iszero_long_e':
- forall m i,
-  app_pred (denote_tc_iszero (Vlong i)) m ->
-  Int64.eq (Int64.repr (Int64.unsigned i)) Int64.zero = true.
+ forall i,
+  denote_tc_iszero (Vlong i) ⊢
+  ⌜Int64.eq (Int64.repr (Int64.unsigned i)) Int64.zero = true⌝.
 Proof.
-intros.
-hnf in H.
+intros; simpl; iPureIntro.
 pose proof (Int64.eq_spec i Int64.zero).
 destruct (Int64.eq i Int64.zero);
   try contradiction.
@@ -689,32 +661,37 @@ Qed.
 
 Lemma sem_binary_operation_stable: 
   forall (cs1: compspecs) cs2 
-   (CSUB: forall id co, (@cenv_cs cs1)!id = Some co -> cs2!id = Some co)
-   b v1 e1 v2 e2 phi m v t rho,
-   app_pred
-       (@denote_tc_assert cs1 (@isBinOpResultType cs1 b e1 e2 t) rho) phi ->
-   sem_binary_operation  (@cenv_cs cs1) b v1 (typeof e1) v2 (typeof e2) m = Some v ->
-   sem_binary_operation cs2 b v1 (typeof e1) v2 (typeof e2) m = Some v.
+   (CSUB: forall id co, (@cenv_cs cs1)!!id = Some co -> cs2!!id = Some co)
+   b v1 e1 v2 e2 m v t rho,
+   (* mem_auth m ∗ *) denote_tc_assert(CS := cs1) (isBinOpResultType(CS := cs1) b e1 e2 t) rho ⊢
+   ⌜sem_binary_operation (@cenv_cs cs1) b v1 (typeof e1) v2 (typeof e2) m = Some v ->
+    sem_binary_operation cs2 b v1 (typeof e1) v2 (typeof e2) m = Some v⌝.
 Proof.
 intros.
 assert (CONSIST:= @cenv_consistent cs1).
-rewrite den_isBinOpR in H.
-simpl in H.
+rewrite den_isBinOpR /=.
 forget (op_result_type (Ebinop b e1 e2 t)) as err.
 forget (arg_type (Ebinop b e1 e2 t)) as err0.
-destruct b; simpl in *; auto;
-unfold Cop.sem_add, Cop.sem_sub in *;
-rewrite ?classify_add_eq, ?classify_sub_eq in *;
-match goal with |- match ?A with _ => _ end = _ => destruct A eqn:?HC end; auto;
-destruct (typeof e1)  as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ]; try discriminate HC;
-destruct (typeof e2)  as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ]; try discriminate HC;
-simpl in *; decompose [and] H; clear H;
-repeat match goal with H: app_pred (denote_tc_assert (tc_bool _ _) _) _ |- _ =>
-    apply tc_bool_e in H 
-end;
+destruct b; simpl; auto;
+unfold Cop.sem_add, Cop.sem_sub, binarithType';
+rewrite ?classify_add_eq ?classify_sub_eq;
+repeat lazymatch goal with
+| |-context [classify_add'] => pose proof (classify_add_reflect (typeof e1) (typeof e2)) as Hrel; inv Hrel;
+   match goal with H : _ = classify_add' _ _ |- _ => let C := fresh "C" in symmetry in H; rename H into HC end
+| |-context [classify_sub'] => pose proof (classify_sub_reflect (typeof e1) (typeof e2)) as Hrel; inv Hrel;
+   match goal with H : _ = classify_sub' _ _ |- _ => let C := fresh "C" in symmetry in H; rename H into HC end
+| |-context [classify_binarith'] => 
+   pose proof (classify_binarith_rel (typeof e1) (typeof e2)) as Hrel; inv Hrel;
+   match goal with H : _ = classify_binarith' _ _ |- _ => let C := fresh "C" in symmetry in H; rename H into HC end;
+   try destruct s
+| |-context [classify_shift'] => pose proof (classify_shift_reflect (typeof e1) (typeof e2)) as Hrel; inv Hrel;
+   match goal with H : _ = classify_shift' _ _ |- _ => let C := fresh "C" in symmetry in H; rename H into HC end
+| |-context [classify_cmp'] => pose proof (classify_cmp_reflect (typeof e1) (typeof e2)) as Hrel; inv Hrel;
+   match goal with H : _ = classify_cmp' _ _ |- _ => let C := fresh "C" in symmetry in H; rename H into HC end
+end; simpl; unfold_lift; rewrite ?tc_bool_e ?tc_andp_sound; first [iIntros (H) || auto]; iPureIntro; decompose [and] H;
 unfold Cop.sem_add_ptr_int, Cop.sem_add_ptr_long in *;
 simpl in *;
-rewrite <- (sizeof_stable _ _ CSUB) in H0 by auto; auto.
+rewrite -> (sizeof_stable _ _ CSUB) by auto; auto.
 Qed.
 
 Lemma eq_block_lem':
@@ -742,147 +719,97 @@ Proof. destruct v; try contradiction; eauto. Qed.
 Lemma is_float_e: forall {v}, is_float v -> exists f, v = Vfloat f.
 Proof. destruct v; try contradiction; eauto. Qed.
 
-Lemma eval_binop_relate':
- forall {CS: compspecs} (ge: genv) te ve rho b e1 e2 t m
-    (Hcenv: cenv_sub (@cenv_cs CS) (genv_cenv ge))
-    (H1: Clight.eval_expr ge ve te (m_dry m) e1 (eval_expr e1 rho))
-    (H2: Clight.eval_expr ge ve te (m_dry m) e2 (eval_expr e2 rho))
-    (H3: app_pred (denote_tc_assert (isBinOpResultType b e1 e2 t) rho) (m_phi m))
-    (TC1 : tc_val (typeof e1) (eval_expr e1 rho))
-    (TC2 : tc_val (typeof e2) (eval_expr e2 rho)),
-Clight.eval_expr ge ve te (m_dry m) (Ebinop b e1 e2 t)
-  (force_val2 (sem_binary_operation' b (typeof e1) (typeof e2))
-     (eval_expr e1 rho) (eval_expr e2 rho)).
-Proof.
-intros.
-econstructor; try eassumption; clear H1 H2.
-assert (sem_binary_operation (@cenv_cs CS) b (@eval_expr CS e1 rho) 
-  (typeof e1) (@eval_expr CS e2 rho) (typeof e2) (m_dry m) =
-@Some val
-  (force_val2 (@sem_binary_operation' CS b (typeof e1) (typeof e2))
-     (@eval_expr CS e1 rho) (@eval_expr CS e2 rho))).
-2:{
-eapply sem_binary_operation_stable; try eassumption.
-clear - Hcenv.
-hnf in Hcenv.
-intros.
-specialize (Hcenv id). hnf in Hcenv. rewrite H in Hcenv. auto.
-}
-clear Hcenv ge.
-rewrite den_isBinOpR in H3.
-simpl in H3.
-forget (op_result_type (Ebinop b e1 e2 t)) as err.
-forget (arg_type (Ebinop b e1 e2 t)) as err0.
-cbv beta iota zeta delta [
-  sem_binary_operation sem_binary_operation' 
-   binarithType' 
- ] in *.
-clear ve te.
-destruct b;
-repeat lazymatch type of H3 with
-| context [classify_add'] => destruct (classify_add' (typeof e1) (typeof e2)) eqn:?C
-| context [classify_sub'] => destruct (classify_sub' (typeof e1) (typeof e2)) eqn:?C
-| context [classify_binarith'] => 
-   destruct (classify_binarith' (typeof e1) (typeof e2)) eqn:?C; try destruct s
-| context [classify_shift'] => destruct (classify_shift' (typeof e1) (typeof e2)) eqn:?C
-| context [classify_cmp'] => destruct (classify_cmp' (typeof e1) (typeof e2)) eqn:?C
-| _ => idtac
-end;
-simpl in H3; super_unfold_lift;
-unfold tc_int_or_ptr_type in *;
-repeat match goal with
- |  H: _ /\ _ |- _ => destruct H
- |  H: app_pred (denote_tc_assert (tc_bool _ _) _) _ |- _ =>
-       apply tc_bool_e in H
-end;
-forget (eval_expr e1 rho) as v1;
-forget (eval_expr e2 rho) as v2;
-try clear rho;
-try clear err err0;
-repeat match goal with
- | H: negb (eqb_type ?A ?B) = true |- _ =>
-             rewrite negb_true_iff in H; try rewrite H in *
- | H: eqb_type ?A ?B = true |- _ =>
-             try rewrite H in *
-end;
-try rewrite <- ?classify_add_eq , <- ?classify_sub_eq, <- ?classify_cmp_eq, <- ?classify_binarith_eq in *;
- rewrite ?sem_cast_long_intptr_lemma in *;
- rewrite ?sem_cast_int_intptr_lemma in *;
-  cbv beta iota zeta delta [
-  sem_binary_operation sem_binary_operation' 
-   Cop.sem_add sem_add Cop.sem_sub sem_sub Cop.sem_div
-   Cop.sem_mod sem_mod Cop.sem_shl Cop.sem_shift 
-   sem_shl sem_shift sem_add_ptr_long sem_add_ptr_int
-   sem_add_long_ptr sem_add_int_ptr
-   Cop.sem_shr sem_shr Cop.sem_cmp sem_cmp
-   sem_cmp_pp sem_cmp_pl sem_cmp_lp 
-   Cop.sem_binarith sem_binarith
-   binarith_type 
-   sem_shift_ii sem_shift_ll sem_shift_il sem_shift_li
-    sem_sub_pp sem_sub_pi sem_sub_pl 
-   force_val2 typeconv remove_attributes change_attributes
-   sem_add_ptr_int force_val both_int both_long force_val2
-    Cop.sem_add_ptr_int
- ];
- try rewrite C; try rewrite C0; try rewrite C1;
- repeat match goal with
-            | H: complete_type _ _ = _ |- _ => rewrite H; clear H
-            | H: eqb_type _ _ = _ |- _ => rewrite H
-            end;
- try clear CS; try clear m;
- try change (Ctypes.sizeof ty) with (sizeof ty).
-all: try abstract (
-red in TC1,TC2;
-destruct (typeof e1)  as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ];
-try discriminate C;
-try solve [contradiction];
-destruct (typeof e2)  as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ];
-try solve [contradiction];
-try discriminate C; try discriminate C0;
-repeat match goal with
- | H: typecheck_error _ |- _ => contradiction H
- | H: andb _ _ = true |- _ => rewrite andb_true_iff in H; destruct H
- | H: isptr ?A |- _ => destruct (isptr_e H) as [?b [?ofs ?]]; clear H; subst A
- | H: is_int _ _ ?A |- _ => destruct (is_int_e' H) as [?i ?]; clear H; subst A
- | H: is_long ?A |- _ =>  destruct (is_long_e H) as [?i ?]; clear H; subst A
- | H: is_single ?A |- _ => destruct (is_single_e H) as [?f ?]; clear H; subst A
- | H: is_float ?A |- _ => destruct (is_float_e H) as [?f ?]; clear H; subst A
- | H: is_true (sameblock _ _) |- _ => apply sameblock_eq_block in H; subst;
-                                                         rewrite ?eq_block_lem'
- | H: is_numeric_type _ = true |- _  => inv H
- end;
- rewrite ?bool2val_eq;
- try simple apply eq_refl;
- rewrite ?sem_cast_long_intptr_lemma in *;
- rewrite ?sem_cast_int_intptr_lemma in *;
- rewrite ?sem_cast_relate, ?sem_cast_relate_long, ?sem_cast_relate_int_long;
- rewrite ?sem_cast_int_lemma, ?sem_cast_long_lemma, ?sem_cast_int_long_lemma;
- rewrite ?if_true by auto;
- rewrite ?sizeof_range_true by auto;
- erewrite ?denote_tc_nodivover_e' by eassumption;
- erewrite ?denote_tc_nonzero_e' by eassumption;
- rewrite ?cast_int_long_nonzero by (eapply denote_tc_nonzero_e'; eassumption);
- rewrite ?(proj2 (eqb_type_false _ _)) by auto 1;
- try reflexivity;
- try solve [simple apply test_eq_relate'; auto;
-               try (simple apply denote_tc_test_eq_xx; assumption);
-               try (simple apply denote_tc_test_eq_yy; assumption);
-               try (simple eapply test_eq_fiddle_signed_xx; eassumption);
-               try (simple eapply test_eq_fiddle_signed_yy; eassumption)];
- try solve [simple apply test_order_relate'; auto; 
-               try (eapply test_order_fiddle_signed_xx; eassumption);
-               try (eapply test_order_fiddle_signed_yy; eassumption)];
- erewrite ?(denote_tc_nodivover_e64_li' Signed) by eassumption;
- erewrite ?(denote_tc_nodivover_e64_il' Signed) by eassumption;
- erewrite ?(denote_tc_nodivover_e64_li' Unsigned) by eassumption;
- erewrite ?(denote_tc_nodivover_e64_il' Unsigned) by eassumption;
- erewrite ?denote_tc_nodivover_e64_ll' by eassumption;
- erewrite ?denote_tc_nonzero_e64' by eassumption;
- erewrite ?denote_tc_igt_e' by eassumption;
- erewrite ?denote_tc_lgt_e' by eassumption;
- erewrite ?denote_tc_test_eq_Vint_l' by eassumption;
- erewrite ?denote_tc_test_eq_Vint_r' by eassumption;
- erewrite ?denote_tc_test_eq_Vlong_l' by eassumption;
- erewrite ?denote_tc_test_eq_Vlong_r' by eassumption;
- reflexivity).
-Time Qed.  (* 31.5 sec *)
+Definition weak_valid_pointer' m v :=
+  match v with Vptr b o => Mem.weak_valid_pointer m b (Ptrofs.unsigned o) | _ => false end.
+
+Lemma sem_cast_relate' : forall ty1 ty2 v v' m
+  (Hty1 : eqb_type ty1 int_or_ptr_type = false) (Hty2 : eqb_type ty2 int_or_ptr_type = false)
+  (Hv : tc_val ty1 v) (Hvalid : forall t a, stupid_typeconv ty1 = Tpointer t a -> weak_valid_pointer' m v = true),
+  sem_cast ty1 ty2 v = Some v' ->
+  Cop.sem_cast v ty1 ty2 m = Some v'.
+Proof.
+  unfold sem_cast, Cop.sem_cast; intros.
+  rewrite -> classify_cast_eq by auto.
+  destruct (classify_cast ty1 ty2) eqn: Hclass; auto.
+  - inv H.
+    unfold classify_cast in Hclass.
+    destruct ty1, ty2; try destruct i; try destruct f; try destruct i0; try destruct f0; try rewrite -> Hty1 in *; try rewrite -> Hty2 in *; try discriminate;
+      unfold tc_val in Hv; rewrite ?Hty1 in Hv; destruct v'; try contradiction; auto.
+  - destruct v; try discriminate; try solve [inv H; reflexivity].
+    unfold weak_valid_pointer' in Hvalid.
+    simpl in H.
+    simple_if_tac; inv H.
+    unfold classify_cast in Hclass; unfold tc_val in Hv.
+    destruct ty1, ty2; try destruct i; try destruct f; try destruct i0; try destruct f0; try rewrite -> Hty1 in *; try rewrite -> Hty2 in *; try discriminate; try contradiction; try (destruct i1; discriminate);
+      erewrite Hvalid; eauto.
+Qed.
+
+Lemma sem_binarith_relate : forall sem_int sem_long sem_float sem_single ty1 ty2 v1 v2 v m
+  (Hty1 : eqb_type ty1 int_or_ptr_type = false) (Hty2 : eqb_type ty2 int_or_ptr_type = false)
+  (Hv1 : tc_val ty1 v1) (Hvalid1 : forall t a, stupid_typeconv ty1 = Tpointer t a -> weak_valid_pointer' m v1 = true)
+  (Hv2 : tc_val ty2 v2) (Hvalid2 : forall t a, stupid_typeconv ty2 = Tpointer t a -> weak_valid_pointer' m v2 = true),
+  sem_binarith sem_int sem_long sem_float sem_single ty1 ty2 v1 v2 = Some v ->
+  Cop.sem_binarith sem_int sem_long sem_float sem_single v1 ty1 v2 ty2 m = Some v.
+Proof.
+  unfold sem_binarith, Cop.sem_binarith; intros.
+  destruct (classify_binarith ty1 ty2) eqn: Hclass; auto.
+  - unfold both_int in H.
+    destruct (sem_cast ty1 _ _) eqn: Hcast1; try discriminate.
+    destruct v0; try discriminate.
+    destruct (sem_cast ty2 _ _) eqn: Hcast2; try discriminate.
+    destruct v0; try discriminate.
+    eapply sem_cast_relate' in Hcast1 as ->; auto.
+    eapply sem_cast_relate' in Hcast2 as ->; auto.
+  - unfold both_long in H.
+    destruct (sem_cast ty1 _ _) eqn: Hcast1; try discriminate.
+    destruct v0; try discriminate.
+    destruct (sem_cast ty2 _ _) eqn: Hcast2; try discriminate.
+    destruct v0; try discriminate.
+    eapply sem_cast_relate' in Hcast1 as ->; auto.
+    eapply sem_cast_relate' in Hcast2 as ->; auto.
+  - unfold both_float in H.
+    destruct (sem_cast ty1 _ _) eqn: Hcast1; try discriminate.
+    destruct v0; try discriminate.
+    destruct (sem_cast ty2 _ _) eqn: Hcast2; try discriminate.
+    destruct v0; try discriminate.
+    eapply sem_cast_relate' in Hcast1 as ->; auto.
+    eapply sem_cast_relate' in Hcast2 as ->; auto.
+  - unfold both_single in H.
+    destruct (sem_cast ty1 _ _) eqn: Hcast1; try discriminate.
+    destruct v0; try discriminate.
+    destruct (sem_cast ty2 _ _) eqn: Hcast2; try discriminate.
+    destruct v0; try discriminate.
+    eapply sem_cast_relate' in Hcast1 as ->; auto.
+    eapply sem_cast_relate' in Hcast2 as ->; auto.
+Qed.
+
+Lemma sem_shift_relate : forall sem_int sem_long ty1 ty2 v1 v2 v
+  (Hnoover : match classify_shift ty1 ty2 with
+            | shift_case_ii _ => match v2 with Vint i2 => Int.unsigned i2 < Int.unsigned Int.iwordsize | _ => True end
+            | shift_case_ll _ => match v2 with Vlong i2 => Int64.unsigned i2 < Int64.unsigned Int64.iwordsize | _ => True end
+            | shift_case_il _ => match v2 with Vlong i2 => Int64.unsigned i2 < 32 | _ => True end
+            | shift_case_li _ => match v2 with Vint i2 => Int.unsigned i2 < Int.unsigned Int64.iwordsize' | _ => True end
+            | _ => True
+            end),
+  sem_shift ty1 ty2 sem_int sem_long v1 v2 = Some v ->
+  Cop.sem_shift sem_int sem_long v1 ty1 v2 ty2 = Some v.
+Proof.
+  unfold sem_shift, Cop.sem_shift; intros.
+  destruct (classify_shift ty1 ty2) eqn: Hclass; auto.
+  - unfold sem_shift_ii in H.
+    destruct v2; auto.
+    unfold Int.ltu; if_tac; auto; lia.
+  - unfold sem_shift_ii in H.
+    destruct v2; auto.
+    unfold Int64.ltu; if_tac; auto; lia.
+  - unfold sem_shift_il in H.
+    destruct v2; auto.
+    unfold Int64.ltu; if_tac; auto.
+    rewrite -> Int64.unsigned_repr in *; try lia.
+    by compute.
+  - unfold sem_shift_li in H.
+    destruct v2; auto.
+    unfold Int.ltu; if_tac; auto; lia.
+Qed.
+
+End mpred.
diff --git a/veric/binop_lemmas5.v b/veric/binop_lemmas5.v
index 470dc3533f..ca5103c2b3 100644
--- a/veric/binop_lemmas5.v
+++ b/veric/binop_lemmas5.v
@@ -1,7 +1,8 @@
-Require Import VST.msl.msl_standard.
 Require Import VST.veric.Clight_base.
-Require Import VST.veric.compcert_rmaps.
 Require Import VST.veric.Clight_lemmas.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Import VST.veric.res_predicates.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.mpred.
 Require Import VST.veric.tycontext.
 Require Import VST.veric.expr2.
@@ -12,20 +13,21 @@ Import Cop.
 
 Transparent intsize_eq.
 
+Section mpred.
+
+Context `{!heapGS Σ}.
+
 Lemma typecheck_Otest_eq_sound:
- forall op {CS: compspecs} (rho : environ) m (e1 e2 : expr) (t : type)
-   (IBR: denote_tc_assert (isBinOpResultType op e1 e2 t) rho m)
+ forall op {CS: compspecs} (rho : environ) (e1 e2 : expr) (t : type)
    (TV2: tc_val (typeof e2) (eval_expr e2 rho))
    (TV1: tc_val (typeof e1) (eval_expr e1 rho))
    (OP: op = Oeq \/ op = One),
-   tc_val t
-     (eval_binop op (typeof e1) (typeof e2) (eval_expr e1 rho) (eval_expr e2 rho)).
+   denote_tc_assert (isBinOpResultType op e1 e2 t) rho ⊢
+   ⌜tc_val t
+     (eval_binop op (typeof e1) (typeof e2) (eval_expr e1 rho) (eval_expr e2 rho))⌝.
 Proof.
   intros.
-  replace
-    ((denote_tc_assert (isBinOpResultType op e1 e2 t) rho) m)
-  with
-    ((denote_tc_assert
+  trans (denote_tc_assert
            match classify_cmp' (typeof e1) (typeof e2) with
               | Cop.cmp_default =>
                            tc_bool (is_numeric_type (typeof e1)
@@ -48,9 +50,8 @@ Proof.
               | Cop.cmp_case_lp => 
                      tc_andp' (tc_int_or_ptr_type (typeof e2))
                     (check_pp_int' (Ecast e1 size_t) e2 op t (Ebinop op e1 e2 t))
-           end rho) m)
-  in IBR
-  by (rewrite den_isBinOpR; destruct OP as [|]; subst; auto).
+           end rho);
+  first by (rewrite den_isBinOpR; destruct OP as [|]; subst; auto).
   replace
     (tc_val t (eval_binop op (typeof e1) (typeof e2) (eval_expr e1 rho) (eval_expr e2 rho)))
   with
@@ -76,70 +77,53 @@ Proof.
          | cmp_default => sem_cmp_default (op_to_cmp op) (typeof e1) (typeof e2)
          end (eval_expr e1 rho) (eval_expr e2 rho))))
   by (destruct OP as [|]; subst; rewrite <- classify_cmp_eq; auto).
-  unfold tc_int_or_ptr_type, eval_binop, sem_binary_operation', isBinOpResultType, Clight_Cop2.sem_add in IBR |- *.
+  unfold tc_int_or_ptr_type, eval_binop, sem_binary_operation', isBinOpResultType, Clight_Cop2.sem_add.
   unfold force_val;
-  rewrite tc_val_tc_val_PM in TV1,TV2.
+  rewrite !tc_val_tc_val_PM' in TV1,TV2.
   replace (check_pp_int' e1 e2 op t (Ebinop op e1 e2 t))
     with (tc_andp' (tc_test_eq' e1 e2)
                    (tc_bool (is_int_type t) (op_result_type (Ebinop op e1 e2 t))))
-    in IBR
     by (unfold check_pp_int'; destruct OP; subst; auto).
-  replace (check_pp_int' e1 (Ecast e2 (Tint I32 Unsigned noattr)) op t (Ebinop op e1 e2 t))
-    with (tc_andp' (tc_test_eq' e1 (Ecast e2 (Tint I32 Unsigned noattr)))
+  replace (check_pp_int' e1 (Ecast e2 size_t) op t (Ebinop op e1 e2 t))
+    with (tc_andp' (tc_test_eq' e1 (Ecast e2 size_t))
                    (tc_bool (is_int_type t) (op_result_type (Ebinop op e1 e2 t))))
-    in IBR
     by (unfold check_pp_int'; destruct OP; subst; auto).
-  replace (check_pp_int' (Ecast e1 (Tint I32 Unsigned noattr)) e2 op t (Ebinop op e1 e2 t))
-    with (tc_andp' (tc_test_eq' (Ecast e1 (Tint I32 Unsigned noattr)) e2)
+  replace (check_pp_int' (Ecast e1 size_t) e2 op t (Ebinop op e1 e2 t))
+    with (tc_andp' (tc_test_eq' (Ecast e1 size_t) e2)
                    (tc_bool (is_int_type t) (op_result_type (Ebinop op e1 e2 t))))
-    in IBR
     by (unfold check_pp_int'; destruct OP; subst; auto).
-Time (* 71 sec *)
-  destruct Archi.ptr64 eqn:Hp;
-  destruct (classify_cmp' (typeof e1) (typeof e2)) eqn:?H; try solve [inv IBR];
-try abstract (
-  destruct OP; subst op;
+  destruct Archi.ptr64 eqn:Hp; try discriminate;
+  pose proof (classify_cmp_reflect (typeof e1) (typeof e2)) as Hcmp; inv Hcmp; simpl; unfold_lift;
+    rewrite !tc_bool_e;
+  last (by rewrite -!tc_val_tc_val_PM' in TV1,TV2; rewrite !andb_true_iff; iPureIntro; intros ((? & ?) & ?); apply tc_val_sem_cmp_binarith'; auto);
+  try (destruct OP; subst op;
+  iIntros "(% & H & %)";
     repeat match goal with
-    |  H: app_pred (denote_tc_assert  (tc_andp' _ _) _) _ |- _ => 
-                                destruct H
-    | H:  app_pred   (denote_tc_assert
-          (check_pp_int' _ _ _ _ _) _) _ |- _ => unfold check_pp_int' in H
     | H: _ /\ _ |- _ => destruct H
-    | H: app_pred (denote_tc_assert (tc_bool _ _) _) _ |- _ => 
-                      apply tc_bool_e in H
     | H: negb (eqb_type ?A ?B) = true |- _ =>
              let J := fresh "J" in
               destruct (eqb_type A B) eqn:J; [inv H | clear H]
-    | H: app_pred (denote_tc_assert (tc_test_eq' _ _) _) _ |- _ =>
-           simpl in H; super_unfold_lift; simpl in H;
-            unfold Clight_Cop2.sem_cast, Clight_Cop2.classify_cast, size_t, sem_cast_pointer in H;
-            simpl in H; rewrite ?Hp in H; simpl in H
-   end;
-  unfold denote_tc_test_eq, sem_cast_i2l, sem_cast_l2l, cast_int_long, force_val in H1;
-  rewrite Hp in H1;
-
-    destruct (typeof e1) as [| [| | |] [|] | | | | | | |]; inv TV1; 
-    destruct (typeof e2) as [| [| | |] [|] | | | | | | |]; inv TV2;
-    simpl in H; inv H;
-    try (rewrite J in *; clear J);
-    try (rewrite J0 in *; clear J0);
-    destruct (eval_expr e1 rho), (eval_expr e2 rho);
-    try contradiction;
-    repeat match goal with
-    | H: app_pred (andp _ _) _ |- _ => destruct H
-    | H: app_pred (prop _) _ |- _ => do 3 red in H; subst
+    | |-context[denote_tc_test_eq _ _] =>
+           unfold Clight_Cop2.sem_cast, Clight_Cop2.classify_cast, size_t, sem_cast_pointer;
+           simpl; rewrite ?Hp; simpl
     end;
+  unfold denote_tc_test_eq, sem_cast_i2l, sem_cast_l2l, sem_cast_l2i, cast_int_long, cast_int_int, force_val;
+  rewrite ?Hp; inv TV1; try (rewrite Ht in Hty1; try solve [destruct sz; inv Hty1]; try solve [destruct sz0; inv Hty1]; inv Hty1);
+  inv TV2; try (rewrite Ht0 in Hty2; try solve [destruct sz; inv Hty2]; try solve [destruct sz0; inv Hty2]; inv Hty2);
+  rewrite -> ?J, ?J0 in *;
+  destruct (eval_expr e1 rho); try contradiction; try iDestruct "H" as "[]";
+  destruct (eval_expr e2 rho); try iDestruct "H" as "[]"; try iDestruct "H" as "[-> ->]"; try iDestruct "H" as "[-> H]"; try done;
+    repeat match goal with
+    | H:  _ /\ _ |- _ => destruct H
+    end; subst;
     simpl; unfold Vptrofs, sem_cmp_pi, sem_cmp_ip, sem_cmp_pl, sem_cmp_lp, sem_cmp_pp; simpl; rewrite ?Hp; simpl;
     rewrite ?Hp; simpl;
-    try (rewrite (Ptrofs_to_of64_lemma Hp); 
-           unfold cast_int_int in H; rewrite H, Int.eq_true);
-    try (apply int_type_tc_val_Vtrue; auto);
-    try (apply int_type_tc_val_Vfalse; auto);
-    try (apply int_type_tc_val_of_bool; auto);
+    rewrite ?(Ptrofs_to_of64_lemma Hp);
    try match goal with
     | H: Int64.repr (Int.signed _) = Int64.zero |- _ => apply Int64repr_Intsigned_zero in H; subst
     | H: Int64.repr (Int.unsigned _) = Int64.zero |- _ => apply Int64repr_Intunsigned_zero in H; subst
     end;
+  try (destruct si; simpl);
   try match goal with
      | |- context [Int64.eq (Ptrofs.to_int64 (Ptrofs.of_ints Int.zero)) Int64.zero] =>
        change (Int64.eq (Ptrofs.to_int64 (Ptrofs.of_ints Int.zero)) Int64.zero) with true;
@@ -147,46 +131,22 @@ try abstract (
      | |- context [Int64.eq (Ptrofs.to_int64 (Ptrofs.of_intu Int.zero)) Int64.zero] =>
        change (Int64.eq (Ptrofs.to_int64 (Ptrofs.of_intu Int.zero)) Int64.zero) with true;
        simpl
+     | |- context [Int.eq (Ptrofs.to_int (Ptrofs.of_ints Int.zero)) Int.zero] =>
+       change (Int.eq (Ptrofs.to_int (Ptrofs.of_ints Int.zero)) Int.zero) with true;
+       simpl
+     | |- context [Int.eq (Ptrofs.to_int (Ptrofs.of_intu Int.zero)) Int.zero] =>
+       change (Int.eq (Ptrofs.to_int (Ptrofs.of_intu Int.zero)) Int.zero) with true;
+       simpl
     end;
-    try solve [if_tac; apply int_type_tc_val_of_bool; auto];
-   try solve [apply int_type_tc_val_Vfalse; auto];
-   try solve [apply int_type_tc_val_Vtrue; auto]).
-
-1,4:
- apply tc_bool_e in IBR;
- repeat rewrite andb_true_iff in IBR; destruct IBR as [[? ?] ?];
-    destruct (typeof e1) as [| [| | |] [|] | | | | | | |]; inv TV1; inv H0;
-    destruct (typeof e2) as [| [| | |] [|] | | | | | | |]; inv TV2; inv H1;
-    simpl in H; inv H;
-    destruct (eval_expr e1 rho), (eval_expr e2 rho);
-    try contradiction;
-   destruct OP; subst op; try destruct s; try destruct s0;
-  unfold sem_cmp_default, op_to_cmp,
- Clight_Cop2.sem_binarith, classify_binarith, both_int, both_long, Clight_Cop2.sem_cast,
-  Clight_Cop2.classify_cast, binarith_type; rewrite ?Hp;
-  simpl; rewrite ?Hp;
-    try (apply int_type_tc_val_Vtrue; auto);
-    try (apply int_type_tc_val_Vfalse; auto);
-    try (apply int_type_tc_val_of_bool; auto).
+   try solve [iPureIntro; apply int_type_tc_val_of_bool; auto];
+   try solve [iPureIntro; if_tac; apply int_type_tc_val_of_bool; auto];
+   try solve [iPureIntro; apply int_type_tc_val_Vfalse; auto];
+   try solve [iPureIntro; apply int_type_tc_val_Vtrue; auto]);
+  match goal with |- context [match typeof e1 with _ => _ end] => destruct (typeof e1); try discriminate; try iDestruct "H" as "[]"
+                | |- context [match typeof e2 with _ => _ end] => destruct (typeof e2); try discriminate; try iDestruct "H" as "[]" end;
+  try iDestruct "H" as "[-> _]";
+  try (destruct s; iDestruct "H" as "[%Hs _]"; (apply Int64repr_Intsigned_zero in Hs as -> || apply Int64repr_Intunsigned_zero in Hs as ->));
+  try solve [iPureIntro; apply int_type_tc_val_of_bool; auto].
+Qed.
 
-all:
-destruct IBR as [IBR ?];
-apply tc_bool_e in IBR;
-rewrite negb_true_iff in IBR;
-unfold sem_cmp_pl, sem_cmp_lp, sem_cmp_pp, Val.cmplu_bool, Val.cmpu_bool;
-rewrite IBR, Hp;
-destruct (typeof e1) as [| [| | |] [|] | | | | | | |] eqn:He1;  inv TV1;
-destruct (typeof e2) as [| [| | |] [|] | | | | | | |] eqn:He2; inv TV2; inv H;
-try rewrite IBR in *;
-unfold check_pp_int' in H0;
-destruct OP; subst op; simpl; destruct H0 as [H0 H2]; apply tc_bool_e in H2;
-simpl in H0; unfold_lift in H0;
-unfold denote_tc_test_eq in H0;
-unfold Vptrofs; rewrite Hp;
-destruct (eval_expr e1 rho); try contradiction;
-destruct (eval_expr e2 rho); try contradiction;
-unfold size_t in H0; rewrite ?Hp,?He1,?He2 in H0; simpl in H0; destruct H0; subst; simpl;
-try solve [apply int_type_tc_val_of_bool; auto];
-rewrite Ptrofs_to_of64_lemma by assumption; rewrite  H; 
-apply int_type_tc_val_of_bool; auto.
-Time Qed.  (* 23.5 sec *)
+End mpred.
diff --git a/veric/binop_lemmas6.v b/veric/binop_lemmas6.v
index ac56e4c9b9..fe57a8723c 100644
--- a/veric/binop_lemmas6.v
+++ b/veric/binop_lemmas6.v
@@ -1,7 +1,8 @@
-Require Import VST.msl.msl_standard.
 Require Import VST.veric.Clight_base.
-Require Import VST.veric.compcert_rmaps.
 Require Import VST.veric.Clight_lemmas.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Import VST.veric.res_predicates.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.mpred.
 Require Import VST.veric.tycontext.
 Require Import VST.veric.expr2.
@@ -10,20 +11,21 @@ Require Import VST.veric.binop_lemmas2.
 Require Import VST.veric.binop_lemmas3.
 Import Cop.
 
+Section mpred.
+
+Context `{!heapGS Σ}.
+
 Lemma typecheck_Otest_order_sound:
- forall op {CS: compspecs} (rho : environ) m (e1 e2 : expr) (t : type)
-   (IBR: denote_tc_assert (isBinOpResultType op e1 e2 t) rho m)
+ forall op {CS: compspecs} (rho : environ) (e1 e2 : expr) (t : type)
    (TV2: tc_val (typeof e2) (eval_expr e2 rho))
    (TV1: tc_val (typeof e1) (eval_expr e1 rho))
    (OP: op = Ole \/ op = Olt \/ op = Oge \/ op = Ogt),
-   tc_val t
-     (eval_binop op (typeof e1) (typeof e2) (eval_expr e1 rho) (eval_expr e2 rho)).
+   denote_tc_assert (isBinOpResultType op e1 e2 t) rho ⊢
+   ⌜tc_val t
+     (eval_binop op (typeof e1) (typeof e2) (eval_expr e1 rho) (eval_expr e2 rho))⌝.
 Proof.
   intros.
-  replace
-    ((denote_tc_assert (isBinOpResultType op e1 e2 t) rho) m)
-  with
-    ((denote_tc_assert
+  trans (denote_tc_assert
             match classify_cmp' (typeof e1) (typeof e2) with
               | Cop.cmp_default =>
                            tc_bool (is_numeric_type (typeof e1)
@@ -46,9 +48,8 @@ Proof.
               | Cop.cmp_case_lp => 
                      tc_andp' (tc_int_or_ptr_type (typeof e2))
                     (check_pp_int' (Ecast e1 size_t) e2 op t (Ebinop op e1 e2 t))
-              end rho) m)
-  in IBR
-  by (rewrite den_isBinOpR; destruct OP as [| [| [|]]]; subst; auto).
+              end rho);
+  first by (rewrite den_isBinOpR; destruct OP as [| [| [|]]]; subst; auto).
   replace
     (tc_val t (eval_binop op (typeof e1) (typeof e2) (eval_expr e1 rho) (eval_expr e2 rho)))
   with
@@ -74,43 +75,37 @@ Proof.
          | cmp_default => sem_cmp_default (op_to_cmp op) (typeof e1) (typeof e2)
          end (eval_expr e1 rho) (eval_expr e2 rho))))
   by (destruct OP as [| [| [|]]]; subst; rewrite <- classify_cmp_eq; auto).
-  unfold tc_int_or_ptr_type in IBR.
-    replace (check_pp_int' e1 e2 op t (Ebinop op e1 e2 t))
+  unfold tc_int_or_ptr_type.
+  replace (check_pp_int' e1 e2 op t (Ebinop op e1 e2 t))
     with (tc_andp' (tc_test_order' e1 e2)
                    (tc_bool (is_int_type t) (op_result_type (Ebinop op e1 e2 t))))
-    in IBR
     by (unfold check_pp_int'; destruct OP as [| [| [|]]]; subst; auto).
-    replace (check_pp_int' e1 (Ecast e2 (Tint I32 Unsigned noattr)) op t (Ebinop op e1 e2 t))
-    with (tc_andp' (tc_test_order' e1 (Ecast e2 (Tint I32 Unsigned noattr)))
+  replace (check_pp_int' e1 (Ecast e2 size_t) op t (Ebinop op e1 e2 t))
+    with (tc_andp' (tc_test_order' e1 (Ecast e2 size_t))
                    (tc_bool (is_int_type t) (op_result_type (Ebinop op e1 e2 t))))
-    in IBR
     by (unfold check_pp_int'; destruct OP as [| [| [|]]]; subst; auto).
-    replace (check_pp_int' (Ecast e1 (Tint I32 Unsigned noattr)) e2 op t (Ebinop op e1 e2 t))
-    with (tc_andp' (tc_test_order' (Ecast e1 (Tint I32 Unsigned noattr)) e2)
+  replace (check_pp_int' (Ecast e1 size_t) e2 op t (Ebinop op e1 e2 t))
+    with (tc_andp' (tc_test_order' (Ecast e1 size_t) e2)
                    (tc_bool (is_int_type t) (op_result_type (Ebinop op e1 e2 t))))
-    in IBR
     by (unfold check_pp_int'; destruct OP as [| [| [|]]]; subst; auto).
 
- destruct Archi.ptr64 eqn:Hp;
-  destruct (classify_cmp' (typeof e1) (typeof e2)) eqn:?H; try solve [inv IBR];
+  destruct Archi.ptr64 eqn:Hp; try discriminate;
+  pose proof (classify_cmp_reflect (typeof e1) (typeof e2)) as Hbin; inv Hbin; try iIntros "[]";
+    simpl; unfold_lift; rewrite !tc_bool_e;
+  last (by rewrite !andb_true_iff; iPureIntro; intros ((? & ?) & ?); apply tc_val_sem_cmp_binarith'; auto);
+  iIntros "(% & H & %)";
     repeat match goal with
-    |  H: app_pred (denote_tc_assert  (tc_andp' _ _) _) _ |- _ => 
-                                destruct H
-    | H:  app_pred   (denote_tc_assert
-          (check_pp_int' _ _ _ _ _) _) _ |- _ => unfold check_pp_int' in H
     | H: _ /\ _ |- _ => destruct H
-    | H: app_pred (denote_tc_assert (tc_bool _ _) _) _ |- _ => 
-                      apply tc_bool_e in H
     | H: negb (eqb_type ?A ?B) = true |- _ =>
              let J := fresh "J" in
               destruct (eqb_type A B) eqn:J; [inv H | clear H]
-    | H: app_pred (denote_tc_assert (tc_test_eq' _ _) _) _ |- _ =>
-           simpl in H; super_unfold_lift; simpl in H;
-            unfold Clight_Cop2.sem_cast, Clight_Cop2.classify_cast, size_t, sem_cast_pointer in H;
-            simpl in H; rewrite ?Hp in H; simpl in H
-    | H: app_pred (denote_tc_assert (tc_test_order' _ _) _) _ |- _ =>
-            simpl in H; unfold_lift in H; unfold denote_tc_test_order in H; rewrite ?Hp in H
-    | H: app_pred (denote_tc_assert match op with _ => _ end _) m |- _ =>
+    | |-context[denote_tc_test_eq _ _] =>
+           simpl; super_unfold_lift; simpl;
+            unfold Clight_Cop2.sem_cast, Clight_Cop2.classify_cast, size_t, sem_cast_pointer;
+            simpl; rewrite ?Hp; simpl
+    | |-context[denote_tc_test_order _ _] =>
+            simpl; unfold_lift; unfold denote_tc_test_order; rewrite ?Hp
+(*    | |-context[denote_tc_assert match op with _ => _ end _] =>
           match type of H with ?A =>
              first [replace A with (app_pred (denote_tc_assert (tc_andp' (tc_test_order' e1 (Ecast e2 size_t))
               (tc_bool (is_int_type t) (op_result_type (Ebinop op e1 e2 t)))) rho) m) in H
@@ -118,50 +113,32 @@ Proof.
          | replace A with (app_pred (denote_tc_assert (tc_andp' (tc_test_order' (Ecast e1 size_t) e2)
               (tc_bool (is_int_type t) (op_result_type (Ebinop op e1 e2 t)))) rho) m) in H
           by (clear - OP H; destruct OP as [| [| [|]]]; subst op; try contradiction; reflexivity)]
-         end
+         end*)
    end;
     simpl;
     unfold sem_cmp_pi, sem_cmp_ip, sem_cmp_pl, sem_cmp_lp,
                      sem_cmp_pp, Val.cmplu_bool, Val.cmpu_bool; rewrite ?Hp.
-Time (* 27.5 sec *)
-all: try (
-    destruct (typeof e1) as [| [| | |] [|] | | | | | | |];
-    destruct (typeof e2) as [| [| | |] [|] | | | | | | |];
-    simpl in H; inv H; hnf in TV1,TV2;
-    try (rewrite J in *; clear J);
-    try (rewrite J0 in *; clear J0);
-    destruct (eval_expr e1 rho), (eval_expr e2 rho);
-    try contradiction;
-    repeat match goal with
-    | H: app_pred (denote_tc_test_eq _ _) _ |- _ => 
-            destruct H as [? _]
-    | H: app_pred (prop _) _ |- _ => do 3 red in H; subst
-    end;
+
+all: rewrite !tc_val_tc_val_PM' in TV1, TV2; inv TV1; try (rewrite Ht in Hty1; try solve [destruct sz; inv Hty1]; try solve [destruct sz0; inv Hty1]; inv Hty1);
+  inv TV2; try (rewrite Ht0 in Hty2; try solve [destruct sz; inv Hty2]; try solve [destruct sz0; inv Hty2]; inv Hty2);
+  rewrite -> ?J, ?J0 in *;
+  destruct (eval_expr e1 rho); try contradiction; try iDestruct "H" as "[]";
+  destruct (eval_expr e2 rho); try iDestruct "H" as "[]"; try iDestruct "H" as "[-> ->]"; try iDestruct "H" as "[-> H]"; try done;
     simpl; unfold Vptrofs, sem_cmp_pi, sem_cmp_ip, sem_cmp_pl, sem_cmp_lp,
-                     sem_cmp_pp; simpl; rewrite ?Hp; simpl;
-    rewrite ?Hp; simpl;
+                     sem_cmp_pp, Clight_Cop2.sem_cast, size_t; simpl; rewrite ?H ?H3 ?Hp; simpl;
+    try iDestruct "H" as "[]";
     try (rewrite (Ptrofs_to_of64_lemma Hp); 
-           unfold cast_int_int in H; rewrite H, Int.eq_true);
+           unfold cast_int_int in H; rewrite H Int.eq_true);
     try (apply int_type_tc_val_Vtrue; auto);
     try (apply int_type_tc_val_Vfalse; auto);
     try (apply int_type_tc_val_of_bool; auto);
-    try solve [if_tac; apply int_type_tc_val_of_bool; auto];
-  
-   simpl in H1; unfold test_order_ptrs, sameblock in H1;
-   destruct (peq b b0); try contradiction; subst b0; clear H1;
-   rewrite if_true by auto; apply int_type_tc_val_of_bool; auto).
+    try solve [iPureIntro; apply int_type_tc_val_of_bool; auto];
+    try solve [if_tac; iPureIntro; apply int_type_tc_val_of_bool; auto];
 
-Time (* 3.0 sec *)
-all:
- repeat rewrite andb_true_iff in IBR; destruct IBR as [[? ?] ?];
- destruct (typeof e1) as [|  [| | |] [|] | [|] | [ | ] ? | | | | |]; inv H0;
- destruct (typeof e2) as [|  [| | |] [|] | [|] | [ | ] ? | | | | |]; inv H1;
- inv H;
- simpl; unfold both_int, both_long;
- destruct (eval_expr e1 rho); try contradiction; 
- destruct (eval_expr e2 rho); try contradiction;
- unfold Clight_Cop2.sem_cast, Clight_Cop2.classify_cast; rewrite ?Hp; simpl; rewrite ?Hp; simpl;
-    try (apply int_type_tc_val_Vtrue; auto);
-    try (apply int_type_tc_val_Vfalse; auto);
-    try (apply int_type_tc_val_of_bool; auto).
-Time Qed. (* 11.08 sec *)
+   try (simpl; unfold test_order_ptrs, sameblock;
+   destruct (peq b b0); simpl; try iDestruct "H" as "[]"; subst b0; iPureIntro;
+   rewrite -> if_true by auto; apply int_type_tc_val_of_bool; auto).
+all: match goal with |- context [match typeof ?e with _ => _ end] => destruct (typeof e); try discriminate; try iDestruct "H" as "[]" end.
+Qed.
+
+End mpred.
diff --git a/veric/change_compspecs.v b/veric/change_compspecs.v
index 91ca1b557b..2900489b8c 100644
--- a/veric/change_compspecs.v
+++ b/veric/change_compspecs.v
@@ -6,7 +6,9 @@ Require Import VST.veric.Clight_lemmas.
 Require Import VST.veric.type_induction.
 Require Import VST.veric.composite_compute.
 Require Import VST.veric.align_mem.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.tycontext.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.Cop2.
 Require Import VST.veric.expr.
 Import compcert.lib.Maps.
diff --git a/veric/compcert_rmaps.v b/veric/compcert_rmaps.v
deleted file mode 100644
index 77a2339209..0000000000
--- a/veric/compcert_rmaps.v
+++ /dev/null
@@ -1,843 +0,0 @@
-Require Export VST.msl.msl_standard.
-Require Import VST.veric.base.
-Require Import compcert.cfrontend.Ctypes.
-Require Import VST.veric.shares.
-Require Import VST.veric.rmaps.
-Require Import VST.veric.rmaps_lemmas.
-Require Export VST.veric.Memory. (*for address, and eq_dec memval*)
-
-Global Instance EqDec_type: EqDec type := type_eq.
-
-Definition funsig := (list (ident*type) * type)%type. (* argument and result signature *)
-
-Definition typesig := (list type * type)%type. (*funsig without the identifiers*)
-Definition typesig_of_funsig (f:funsig):typesig := (map snd (fst f), snd f).
-
-Inductive kind : Type := VAL : memval -> kind
-                                   | LK : forall n i : Z, kind
-                                   | FUN: typesig -> calling_convention -> kind.
-
-
-Definition isVAL (k: kind) := match k with | VAL _ => True | _ => False end.
-Definition isFUN (k: kind) := match k with | FUN _ _ => True | _ => False end.
-
-Lemma isVAL_i: forall v, isVAL (VAL v).
-Proof. intros; simpl; auto. Qed.
-Global Hint Resolve isVAL_i : core.
-
-Lemma isVAL_dec: forall k, {isVAL k}+{~isVAL k}.
-Proof.
-intros; destruct k; auto.
-Qed.
-
-Module CompCert_AV <: ADR_VAL.
-
-Definition address := address.
-Definition some_address : address := (xH,0).
-Definition kind := kind.
-
-End CompCert_AV.
-
-Lemma getVAL: forall k, {v : memval & k = VAL v}  + {~isVAL k}.
-Proof.
-intros.
-destruct k;
-  try solve [simpl; right; tauto].
-left.
-eauto.
-Qed.
-
-Lemma VAL_inj: forall v v', VAL v = VAL v' -> v = v'.
-Proof.
-intros.
-inv H; auto.
-Qed.
-
-Global Instance EqDec_calling_convention: EqDec calling_convention.
-Proof.
-  hnf. decide equality.
-  destruct cc_structret, cc_structret0; subst; try tauto; right; congruence.
-  destruct cc_unproto, cc_unproto0;  subst; try tauto; right; congruence.
-  destruct cc_vararg, cc_vararg0; subst; try tauto.
-  destruct (zeq z0 z); subst; [left|right]; congruence.
-  right; congruence.
-  right; congruence.
-Qed.
-
-Global Instance EqDec_kind: EqDec kind.
-Proof.
-  hnf. decide equality; try apply eq_dec; try apply zeq; try apply signature_eq.
-Qed.
-
-Module R := Rmaps (CompCert_AV).
-Module RML := Rmaps_Lemmas(R).
-
-Export RML.
-Export R.
-
-Definition mk_rshare: forall p: Share.t, pure_readable_share p -> rshare := exist pure_readable_share.
-Definition rshare_sh (p: rshare) : Share.t := proj1_sig p.
-
-Lemma mk_rshare_sh: forall (p:rshare) (H: pure_readable_share (rshare_sh p)),
-  mk_rshare (rshare_sh p) H = p.
-Proof.
-  intros.
-  unfold mk_rshare.
-  destruct p; simpl.
-  auto with extensionality.
-Qed.
-
-Definition fixup_splitting
-  (a:address -> Share.t) (z: address -> option (rshare * kind)) : address -> option (rshare * kind) :=
-  fun l => 
-    match z l with
-    | Some (sh, k) =>
-       match dec_readable (a l) with
-       | left p => Some (readable_part p,  k)
-       | right _ => None
-       end
-    | None => None
-    end.
-
-Definition share_of (x: option (rshare * kind)) : Share.t :=
-  match x with Some (p,_) => proj1_sig p | None => Share.bot end.
-
-Definition Join_pk := (Join_lower (Join_prod rshare _ kind (Join_equiv _))).
-
-Lemma share_of_Some: forall p: rshare * AV.kind, readable_share (share_of (Some p)).
-Proof.
- intros. destruct p as [[? ?] ?]; simpl.
- auto.
- destruct p; auto.
-Qed.
-
-Lemma join_sub_same_k:
- forall {a a' : rshare} {k k': AV.kind},
-      @join_sub _ Join_pk (Some (a,k)) (Some (a',k')) -> k=k'.
-Proof.
-  intros. destruct H. inv H; auto. inv H3. simpl in H0. inv H0; congruence.
-Qed.
-
-Lemma pure_readable_glb_Rsh:
- forall sh, pure_readable_share sh -> Share.glb Share.Rsh sh = sh.
-Proof.
- intros.
- destruct H.
- rewrite (comp_parts comp_Lsh_Rsh sh) at 2. rewrite H.
- rewrite Share.lub_commute, Share.lub_bot; auto.
-Qed.
-
-Lemma join_glb_Rsh:  
-  forall a b c : Share.t,
-  join a b c ->
-  join (Share.glb Share.Rsh a) (Share.glb Share.Rsh b) (Share.glb Share.Rsh c).
-Proof.
-intros.
-apply (join_comp_parts comp_Lsh_Rsh). auto.
-Qed.
-
-Lemma pure_readable_share_glb:
-  forall a, pure_readable_share a -> Share.glb Share.Rsh a = a.
-Proof.
- intros. destruct H.
- rewrite (comp_parts comp_Lsh_Rsh a) at 2. rewrite H.
- rewrite Share.lub_commute, Share.lub_bot. auto.
-Qed.
-
-Lemma glb_Rsh_bot_unreadable:
-  forall a, Share.glb Share.Rsh a = Share.bot -> ~readable_share a.
-Proof.
- intros. unfold readable_share. rewrite H. intro. apply H0.
- apply bot_identity.
-Qed.
-
-Lemma fixup_join : forall a (ac ad: address -> Share.t)  z,
-  (forall x, @join_sub _ Join_pk (a x) (z x)) ->
-  (forall x, join (ac x) (ad x) (share_of (a x))) ->
-  (forall x,
-    @join _ Join_pk
-    (fixup_splitting ac z x)
-    (fixup_splitting ad z x)
-    (a x)).
-Proof.
- do 2  pose proof I.
-  intros.
-  unfold fixup_splitting.
-
-Ltac glb_Rsh_tac :=
- repeat
- match goal with
- | |- Some _ = None => exfalso
- | |- None = Some _ => exfalso
- | |- join (Some _) _ None => exfalso
- | |- join _ (Some _) None => exfalso
- | |- join _ None _ => apply join_unit2; [ apply None_unit |]
- | |- join None _ _ => apply join_unit1; [ apply None_unit |]
- | |- Some (_,_) = Some(_,_) => do 2 f_equal; try apply exist_ext; auto
- | H: ~readable_share ?X, H1: join (Share.glb Share.Rsh ?X) _ _ |- _ =>
-         rewrite (not_readable_Rsh_part H) in H1;
-         apply join_unit1_e in H1; [ | apply bot_identity];
-         rewrite ?H1 in *
- | H: ~readable_share ?X, H1: join _ (Share.glb Share.Rsh ?X) _ |- _ =>
-         rewrite (not_readable_Rsh_part H) in H1;
-         apply join_unit2_e in H1; [ | apply bot_identity];
-         rewrite ?H1 in *
- | H: identity ?A, H1: readable_share ?A |- _ =>
-    apply (readable_not_identity A _ H1 H)
- | H: pure_readable_share ?A |- Share.glb Share.Rsh ?A = ?A =>
-     apply pure_readable_glb_Rsh; auto
- | H: join ?A ?B Share.bot |- _ =>
-     let H1 := fresh in 
-         assert (H1 := identity_share_bot _ (split_identity _ _ H bot_identity));
-         rewrite ?H1 in *;
-     let H2 := fresh in 
-         assert (H2 := identity_share_bot _ (split_identity _ _ (join_comm H) bot_identity));
-         rewrite ?H2 in *;
-     clear H
- | H: readable_share Share.bot |- _ => contradiction bot_unreadable
- | H: join_sub None _ |- _ => clear H
- | H: join_sub (Some(_,?A)) (Some (_,?B)) |- _ =>
-      unify A B || 
-      (is_var A; pose proof (join_sub_same_k H); subst A)
- | |- _ => rewrite Share.glb_bot in *
- | H: Share.glb Share.Rsh _ = Share.bot |- _ => 
-          apply glb_Rsh_bot_unreadable in H; try contradiction
- | H: pure_readable_share ?A |- _ => rewrite (pure_readable_share_glb _ H) in *
- | |- _ => assumption
- end;
- auto.
-
-  case_eq (z x); intros; [destruct p | ].
-*
-  specialize (H1 x); specialize (H2 x).
-  clear H H0. rewrite H3 in *. clear z H3.
-  destruct (dec_readable (ac x)).
- +
-  destruct (dec_readable (ad x)).
- -
-  destruct (a x) as [[[? ?] ?] | ]; simpl in *.
-  constructor.
-  pose proof (join_sub_same_k H1); subst k.
-  constructor; auto. simpl.
-  red. red. simpl.
-  apply join_glb_Rsh in H2.
-  glb_Rsh_tac.
-  glb_Rsh_tac.
-  -
-  apply join_glb_Rsh in H2.
-  glb_Rsh_tac.
-  destruct (a x) as [[[? ?] ?]|]; simpl in *.
-  glb_Rsh_tac.
-  glb_Rsh_tac.
-+
-  glb_Rsh_tac.
-  apply join_glb_Rsh in H2.
-  destruct (a x) as [[[? ?] ?]|]; simpl in *.
-  glb_Rsh_tac.
-  destruct (dec_readable (ad x)).
-  glb_Rsh_tac.
-  glb_Rsh_tac.
-  apply n0.
-  unfold readable_share. rewrite H2. destruct p. intro.
-  glb_Rsh_tac.
-  glb_Rsh_tac.
-  destruct (dec_readable (ad x)).
-  glb_Rsh_tac.
-  glb_Rsh_tac.
-*
- specialize (H1 x). rewrite H3 in H1.
- destruct H1.
- inv H1. constructor. rewrite H7; constructor.
-Qed.
-
-Lemma join_share_of: forall a b c,
-     @join _ Join_pk a b c -> join (share_of a) (share_of b) (share_of c).
-Proof.
-  intros. inv H; simpl. apply join_unit1; auto. apply join_unit2; auto.
-  destruct a1; destruct a2; destruct a3.
-  destruct r,r0,r1; simpl.
-  destruct H0. simpl in *. do 3 red in H. simpl in H. auto.
-Qed.
-
-#[export] Instance Cross_rmap_aux: Cross_alg (AV.address -> option (rshare * AV.kind)).
-Proof.
- hnf. intros a b c d z ? ?.
- destruct (cross_split_fun Share.t _ address share_cross_split
-                   (share_of oo a) (share_of oo b) (share_of oo c) (share_of oo d) (share_of oo z))
-  as [[[[ac ad] bc] bd] [? [? [? ?]]]].
- intro x. specialize (H x). unfold compose.
- clear - H. inv H; simpl in *. apply join_unit1; auto. apply join_unit2; auto.
- destruct a1; destruct a2; destruct a3; apply H3.
- intro x. specialize (H0 x). unfold compose.
- clear - H0. inv H0; simpl in *. apply join_unit1; auto. apply join_unit2; auto.
- destruct a1; destruct a2; destruct a3; apply H3.
- exists (fixup_splitting ac z, 
-            fixup_splitting ad z, 
-            fixup_splitting bc z, 
-            fixup_splitting bd z).
- split3; [ | | split];  do 2 red; simpl; intro;
- apply fixup_join; auto; intros.
- exists (b x0); apply H.
- exists (a x0); apply join_comm; apply H.
- exists (d x0); apply H0.
- exists (c x0); apply join_comm; apply H0.
-Qed.
-
-#[export] Instance Disj_resource: Disj_alg resource.
-Proof.
-intros ?? J.
-inv J.
-- apply join_self, identity_share_bot in RJ; subst.
-  apply NO_identity.
-- apply join_self, identity_share_bot in RJ; subst.
-  apply bot_unreadable in rsh0 as [].
-- apply PURE_identity.
-Qed.
-
-#[export] Instance Trip_resource: Trip_alg resource.
-Proof.
-intro; intros.
-destruct a as [ra | ra sa ka pa | ka pa].
-destruct b as [rb | rb sb kb pb | kb pb]; try solve [exfalso; inv H].
-destruct ab as [rab | rab sab kab pab | kab pab]; try solve [exfalso; inv H].
-destruct c as [rc | rc sc kc pc | kc pc]; try solve [exfalso; inv H0].
-destruct bc as [rbc | rbc sbc kbc pbc | kbc pbc]; try solve [exfalso; inv H0].
-destruct ac as [rac | rac sac kac pac | kac pac]; try solve [exfalso; inv H1].
-destruct (triple_join_exists_share ra rb rc rab rbc rac) as [rabc ?];
-  [inv H | inv H0 | inv H1 | ] ; auto.
-assert (n5 := join_unreadable_shares j n1 n2).
-exists (NO rabc n5); constructor; auto.
-destruct bc as [rbc | rbc sbc kbc pbc | kbc pbc]; try solve [exfalso; inv H0].
-destruct ac as [rac | rac sac kac pac | kac pac]; try solve [exfalso; inv H1].
-destruct (triple_join_exists_share ra rb rc rab rbc rac) as [rabc ?];
-  [inv H | inv H0 | inv H1 | ] ; auto.
-assert (sabc := join_readable2 j sc).
-exists (YES rabc sabc kc pc); constructor; auto.
-destruct ab as [rab | rab sab kab pab | kab pab]; try solve [exfalso; inv H].
-destruct c as [rc | rc sc kc pc | kc pc]; try solve [exfalso; inv H0].
-destruct bc as [rbc | rbc sbc kbc pbc | kbc pbc]; try solve [exfalso; inv H0].
-destruct ac as [rac | rac sac kac pac | kac pac]; try solve [exfalso; inv H1].
-destruct (triple_join_exists_share ra rb rc rab rbc rac) as [rabc ?];
-  [inv H | inv H0 | inv H1 | ] ; auto.
-assert (sabc := join_readable1 j sab).
-exists (YES rabc sabc kab pab); constructor; auto.
-destruct bc as [rbc | rbc sbc kbc pbc | kbc pbc]; try solve [exfalso; inv H0].
-destruct ac as [rac | rac sac kac pac | kac pac]; try solve [exfalso; inv H1].
-destruct (triple_join_exists_share ra rb rc rab rbc rac) as [rabc ?];
-  [inv H | inv H0 | inv H1 | ] ; auto.
-assert (sabc := join_readable1 j sab).
-exists (YES rabc sabc kbc pbc). inv H0; inv H; inv H1; constructor; auto.
-destruct b as [rb | rb sb kb pb | kb pb]; try solve [exfalso; inv H].
-destruct ab as [rab | rab sab kab pab | kab pab]; try solve [exfalso; inv H].
-destruct c as [rc | rc sc kc pc | kc pc]; try solve [exfalso; inv H0].
-destruct bc as [rbc | rbc sbc kbc pbc | kbc pbc]; try solve [exfalso; inv H0].
-destruct ac as [rac | rac sac kac pac | kac pac]; try solve [exfalso; inv H1].
-destruct (triple_join_exists_share ra rb rc rab rbc rac) as [rabc ?];
-  [inv H | inv H0 | inv H1 | ] ; auto.
-assert (sabc := join_readable1 j sab).
-exists (YES rabc sabc kab pab); constructor; auto.
-destruct bc as [rbc | rbc sbc kbc pbc | kbc pbc]; try solve [exfalso; inv H0].
-destruct ac as [rac | rac sac kac pac | kac pac]; try solve [exfalso; inv H1].
-destruct (triple_join_exists_share ra rb rc rab rbc rac) as [rabc ?];
-  [inv H | inv H0 | inv H1 | ] ; auto.
-assert (sabc := join_readable1 j sab).
-exists (YES rabc sabc kac pac).  inv H; inv H0; inv H1; constructor; auto.
-destruct ab as [rab | rab sab kab pab | kab pab]; try solve [exfalso; inv H].
-destruct c as [rc | rc sc kc pc | kc pc]; try solve [exfalso; inv H0].
-destruct bc as [rbc | rbc sbc kbc pbc | kbc pbc]; try solve [exfalso; inv H0].
-destruct ac as [rac | rac sac kac pac | kac pac]; try solve [exfalso; inv H1].
-destruct (triple_join_exists_share ra rb rc rab rbc rac) as [rabc ?];
-  [inv H | inv H0 | inv H1 | ] ; auto.
-assert (sabc := join_readable1 j sab).
-exists (YES rabc sabc kab pab); constructor; auto.
-destruct bc as [rbc | rbc sbc kbc pbc | kbc pbc]; try solve [exfalso; inv H0].
-destruct ac as [rac | rac sac kac pac | kac pac]; try solve [exfalso; inv H1].
-destruct (triple_join_exists_share ra rb rc rab rbc rac) as [rabc ?];
-  [inv H | inv H0 | inv H1 | ] ; auto.
-assert (sabc := join_readable1 j sab).
-exists (YES rabc sabc kc pc).
- inv H. inv H1. inv H0.
-constructor; auto.
- exists ab. inv H. inv H1. inv H0. constructor.
-Qed.
-
-Lemma pure_readable_share_i:
-  forall sh, readable_share sh -> (pure_readable_share (Share.glb Share.Rsh sh)).
-Proof.
-intros. split. rewrite <- Share.glb_assoc. rewrite glb_Lsh_Rsh.
-rewrite Share.glb_commute. apply Share.glb_bot.
-do 3 red in H|-*. contradict H.
-rewrite glb_twice in H. auto.
-Qed.
-
-(* Do we need this?
-#[export] Instance Trip_rmap : Trip_alg rmap.
-Proof.
-intro; intros.
-pose (f loc := @Trip_resource _ _ _ _ _ _
-                 (resource_at_join _ _ _ loc H)
-                 (resource_at_join _ _ _ loc H0)
-                 (resource_at_join _ _ _ loc H1)).
-assert (CompCert_AV.valid (res_option oo (fun l => proj1_sig (f l)))).
-intros b' z'.
-unfold compose. simpl.
-destruct (f (b',z')); simpl.
-destruct x; simpl; auto.
-destruct k; simpl; auto.
-intros.
-destruct (f (b',z'+i)). simpl.
-case_eq (ab @ (b', z')); case_eq (c @ (b', z')); intros; try solve [rewrite H3 in j; inv j];
-  try solve [rewrite H4 in j; inv j].
-rewrite H3 in j; rewrite H4 in j. inv j.
-rename H3 into H6.
-pose proof (rmap_valid_e1 c b' z' _ _ H2 (readable_part r0)).
-rewrite H4 in j; rewrite H6 in j.
-assert (k = LK z) by (inv j; auto). subst.
-assert (p0 = p) by (inv j; auto). subst.
-spec H3; [rewrite H6; auto|].
-inv j. rename RJ into j.
-destruct (c @ (b',z'+i)); inv H3.
-case_eq (ab @ (b', z' + i)); intros.
-*
-rewrite H3 in j0; inv j0.
-simpl. f_equal; f_equal.
-clear f nsh2 rsh4 rsh0 H2 H4 H6 H3 p.
-clear rsh1 i p0 nsh0.
-apply exist_ext.
-  apply join_glb_Rsh in RJ.
-  apply join_glb_Rsh in j.
-  glb_Rsh_tac.
-*
-assert (H9 := pure_readable_share_i _ r2).
-generalize (rmap_valid_e2 ab b' z' i (mk_rshare _ H9)); intro.
-rewrite H3 in *. clear H3.
-simpl in H5.
-spec H5. inv j0. do 2 f_equal. apply exist_ext. auto.
-destruct H5 as [nx [? ?]].
-rewrite H4 in H5. inv H5.
-*
-intros.
-rewrite H3 in j0. inv j0.
-*
-rewrite H4 in j. inv j.
-assert (H99 := pure_readable_share_i _ r0).
-pose proof (rmap_valid_e1 ab b' z' _ _ H2 (mk_rshare _ H99)).
-rewrite H4 in H5.
-spec H5. simpl. f_equal. f_equal. apply exist_ext; reflexivity.
-destruct (ab @ (b',z'+i)); inv H5.
-rewrite H3 in H9; inv H9.
-inv j0. simpl.  repeat f_equal. apply exist_ext.
-  apply join_glb_Rsh in RJ.
-  apply join_glb_Rsh in RJ0.
-  glb_Rsh_tac.
- simpl. do 2 f_equal. apply exist_ext.
-assert (H98 := pure_readable_share_i _ rsh3).
- pose proof (rmap_valid_e2 c b' z' i  (mk_rshare _ H98)).
- rewrite <- H10 in H5.
- spec H5. simpl. do 2 f_equal. apply exist_ext. auto.
-destruct H5 as [nx [? ?]]; auto. rewrite H3 in H6. inv H6.
- congruence.
-*
-rewrite H3 in j. rewrite H4 in j. inv j.
-assert (H99 := pure_readable_share_i _ r0).
-pose proof (rmap_valid_e1 c b' z' _ _ H2 (mk_rshare _ H99)).
-spec H5.  rewrite H3. simpl. repeat f_equal. apply exist_ext; auto.
-assert (H98 := pure_readable_share_i _ r1).
-pose proof (rmap_valid_e1 ab b' z' _ _ H2 (mk_rshare _ H98)).
-spec H6.  rewrite H4. simpl. repeat f_equal. apply exist_ext; auto.
-destruct (c @ (b',z'+i)); inv H5.
-destruct (ab @ (b',z'+i)); inv H6.
-inv j0. simpl. repeat f_equal. apply exist_ext.
-apply join_glb_Rsh in RJ.
-apply join_glb_Rsh in RJ0.
-rewrite H8 in *; rewrite H7 in *.
-eapply join_eq;  eauto.
-* (**)
-destruct (f (b',z'-z)).
-simpl.
-case_eq (ab @ (b', z')); case_eq (c @ (b', z')); intros; try solve [rewrite H2, H3 in j; inv j].
-+
-rewrite H2 in j; rewrite H3 in j; inv j.
-rename H2 into H5.
-symmetry in H3.
-assert (H99 := pure_readable_share_i _ r0).
-pose proof (rmap_valid_e2 c b' (z'-z) z  (mk_rshare _ H99)).
-rewrite Z.sub_add, H5 in H2.
-spec H2.  simpl. repeat f_equal. apply exist_ext. auto.
-destruct H2 as [nx [? ?]]; exists nx; split; auto.
-destruct (c @ (b',z'-z)); inv H4.
-inv j0. simpl. repeat f_equal. apply exist_ext.
-apply join_glb_Rsh in RJ.
-apply join_glb_Rsh in RJ0.
-glb_Rsh_tac.
-assert (H98 := pure_readable_share_i _ rsh2).
-pose proof (rmap_valid_e1 ab b' (z'-z) _ _ H2 (mk_rshare _ H98)).
-spec H4. rewrite <- H6. simpl. repeat f_equal. apply exist_ext. auto.
-rewrite Z.sub_add in H4.
-rewrite <- H3 in H4; inv H4.
-+
-rewrite H2 in j; inv j. rewrite H3 in H5; inv H5.
-assert (H99 := pure_readable_share_i _ r0).
-pose proof (rmap_valid_e2 ab b' (z'-z) z (mk_rshare _ H99)).
-spec H4. rewrite Z.sub_add. rewrite H3. simpl. repeat f_equal. apply exist_ext. auto.
-rename H4 into H2'; rename H2 into H4; rename H2' into H2.
-rename H3 into H5.
-destruct H2 as [nx [? ?]]; exists nx; split; auto.
-destruct (ab @ (b',z'-z)); inv H3.
-inv j0; try reflexivity.
-simpl; repeat f_equal; apply exist_ext.
-apply join_glb_Rsh in RJ.
-apply join_glb_Rsh in RJ0.
-glb_Rsh_tac.
-simpl; repeat f_equal. 
-assert (H98 := pure_readable_share_i _ rsh3).
-pose proof (rmap_valid_e1 c b' (z'-z) _ _ H2 (mk_rshare _ H98)).
-spec H3. rewrite <- H10. simpl. repeat f_equal; apply exist_ext. auto.
-rewrite Z.sub_add in H3. 
-rewrite H4 in H3; inv H3.
-+
-rewrite H3 in j; rewrite H2 in j; inv j.
-assert (H99 := pure_readable_share_i _ r0).
-pose proof (rmap_valid_e2 c b' (z'-z) z (mk_rshare _ H99)).
-spec H4. rewrite Z.sub_add. rewrite H2. simpl. repeat f_equal; apply exist_ext; auto.
-destruct H4 as [n [? ?]]; exists n; split; auto.
-destruct (c @ (b',z'-z)); inv H5.
-assert (H98 := pure_readable_share_i _ r1).
-pose proof (rmap_valid_e2 ab b' (z'-z) z  (mk_rshare _ H98)).
-spec H5. rewrite Z.sub_add. rewrite H3. simpl; repeat f_equal; apply exist_ext; auto.
-destruct H5 as [n' [? ?]].
-destruct (ab @ (b',z'-z)); inv j0; inv H6.
-simpl. do 2 f_equal. apply exist_ext.
-apply join_glb_Rsh in RJ.
-apply join_glb_Rsh in RJ0.
-rewrite H9 in *; rewrite H7 in *.
-eapply join_eq; eauto.
-*
-destruct (make_rmap _ _ H2 (level a)) as [abc [? ?]].
-extensionality loc. unfold compose; simpl.
-destruct (f loc); simpl.
-destruct x; simpl; auto.
-f_equal.
-generalize (resource_at_join _ _ _ loc H);
-generalize (resource_at_join _ _ _ loc H0);
-generalize (resource_at_join _ _ _ loc H1);
-inv j; intros.
-inv H7.
-generalize (resource_at_approx a loc); rewrite <- H9;  intro.
-injection (YES_inj _ _ _ _ _ _ _ _ H7); auto.
-replace (level a) with (level b).
- 2:  clear - H; apply join_level in H; destruct H; congruence.
-generalize (resource_at_approx b loc); rewrite <- H10;  intro.
-injection (YES_inj _ _ _ _ _ _ _ _ H7); auto.
-generalize (resource_at_approx a loc); rewrite <- H9;  intro.
-injection (YES_inj _ _ _ _ _ _ _ _ H7); auto.
-replace (level a) with (level c).
- 2:  clear - H1; apply join_level in H1; destruct H1; congruence.
-generalize (resource_at_approx c loc); rewrite <- H5;  intro.
-injection (YES_inj _ _ _ _ _ _ _ _ H8); auto.
-replace (level a) with (level c).
- 2:  clear - H1; apply join_level in H1; destruct H1; congruence.
-generalize (resource_at_approx c loc); rewrite <- H5;  intro.
-injection (YES_inj _ _ _ _ _ _ _ _ H8); auto.
-inv j.
-replace (level a) with (level c).
- 2:  clear - H1; apply join_level in H1; destruct H1; congruence.
-generalize (resource_at_approx c loc); rewrite <- H5;  intro.
-auto.
-exists abc.
-apply resource_at_join2.
-rewrite H3. clear - H. apply join_level in H; destruct H; auto.
-rewrite H3. clear - H1; apply join_level in H1; destruct H1; congruence.
-intro loc.
-rewrite H4.
-destruct (f loc).
-simpl.
-auto.
-Qed.*)
-
-#[local] Obligation Tactic := Tactics.program_simpl.
-
-Lemma pure_readable_Rsh: pure_readable_share Share.Rsh.
-Proof.
-split. apply glb_Lsh_Rsh. intro. rewrite Share.glb_idem in H.
-pose proof (Share.split_nontrivial Share.Lsh Share.Rsh Share.top).
-spec H0.
-unfold Share.Lsh, Share.Rsh.
-destruct (Share.split Share.top); auto.
-apply identity_share_bot in H.
-spec H0; auto.
-contradiction Share.nontrivial.
-Qed.
-
-Definition rfullshare : rshare := mk_rshare _ pure_readable_Rsh.
-
-Program Definition writable (l: address): pred rmap :=
- fun phi =>
-  match phi @ l with
-    | YES sh _ k lp => writable0_share sh /\ isVAL k
-    | _ => False
-  end.
- Next Obligation.
-  split; intro; intros.
-  generalize (age1_res_option a a' l H); intro.
-  destruct (a @ l); try contradiction.
-  simpl in H1.
-  destruct (a' @ l); inv H1; auto.
-  destruct H0; split; auto.
-  unfold writable0_share in *.
-  clear - H3 H0.
-  apply leq_join_sub in H0.
-  apply leq_join_sub.
-  apply Share.ord_spec2 in H0. rewrite <- H0 in H3.
-  rewrite Share.glb_absorb in H3.
-  clear H0.
-  rewrite H3.
-  apply Share.glb_lower2.
-
-  rewrite rmap_order in H; destruct H as (? & <- & ?); auto.
-Qed.
-
-Program Definition readable (loc: address) : pred rmap :=
-   fun phi => match phi @ loc with YES _ _ k _ => isVAL k | _ => False end.
- Next Obligation.
-  split; intro; intros.
-  generalize (age1_res_option a a' loc H); intro.
-  destruct (a @ loc); try contradiction.
-  simpl in H1.
-  destruct (a' @ loc); inv H1; auto.
-
-  rewrite rmap_order in H; destruct H as (? & <- & ?); auto.
- Qed.
-
-Lemma readable_join:
-  forall phi1 phi2 phi3 loc, join phi1 phi2 phi3 ->
-            readable loc phi1 -> readable loc phi3.
-Proof.
-unfold readable; intros until loc.
-intros.
-simpl in *.
-generalize (resource_at_join _ _ _ loc H); clear H; intros.
-revert H0 H; destruct (phi1 @ loc); intros; try contradiction.
-inv H; auto.
-Qed.
-
-Lemma readable_writable_join:
-forall phi1 phi2 l, readable l phi1 -> writable l phi2 -> joins phi1 phi2 -> False.
-Proof.
-intros.
-unfold readable, writable in *.
-simpl in H, H0.
-destruct H1 as [phi ?].
-generalize (resource_at_join _ _ _ l H1); clear H1; revert H H0.
-destruct (phi1 @ l); intros; try contradiction.
-destruct (phi2 @ l); try contradiction.
-inv H1.
-destruct H0.
-clear - RJ H0 r.
-unfold readable_share, writable0_share in *.
-destruct H0.
-destruct (join_assoc (join_comm H) (join_comm RJ)) as [a [? ?]].
-clear - r H0.
-apply r; clear r.
-destruct H0.
-rewrite H. auto.
-Qed.
-
-Lemma writable0_join_sub:
-  forall sh sh', join_sub sh sh' -> writable0_share sh -> writable0_share sh'.
-Proof.
-intros.
-destruct H.
-destruct H0 as [b ?].
-destruct (join_assoc H0 H) as [c [? ?]].
-exists c; auto.
-Qed.
-
-Lemma writable_join: forall loc phi1 phi2, join_sub phi1 phi2 ->
-            writable loc phi1 -> writable loc phi2.
-Proof.
-unfold writable; intros.
-simpl in *.
-destruct H; generalize (resource_at_join _ _ _ loc H); clear H.
-revert H0; destruct (phi1 @ loc); intros; try contradiction.
-destruct H0; subst.
-inv H; split; auto; eapply writable0_join_sub; eauto; eexists; eauto.
-Qed.
-
-Lemma writable_readable: forall loc m, writable loc m -> readable loc m.
-Proof.
- unfold writable, readable.
- intros ? ?. simpl.  destruct (m @ loc); auto. intros [? ?]. auto.
-Qed.
-
-Lemma writable_e: forall loc m, 
-   writable loc m -> 
-   exists sh, exists rsh, exists v, exists p, 
-     m @ loc = YES sh rsh (VAL v) p /\ writable0_share sh.
-Proof.
-unfold writable; simpl; intros; destruct (m@loc); try contradiction.
-destruct H.
-destruct k; try solve [inversion H0].
-exists sh, r, m0, p; split; auto.
-Qed.
-Arguments writable_e [loc] [m] _.
-
-Lemma readable_e: forall loc m, 
-   readable loc m -> 
-  exists sh, exists rsh, exists v, exists p, m @ loc = YES sh rsh (VAL v) p.
-Proof.
-unfold readable; simpl; intros; destruct (m@loc); try contradiction.
-destruct k; try solve [inversion H].
-subst.
-econstructor; eauto.
-Qed.
-Arguments readable_e [loc] [m] _.
-
-Definition bytes_writable (loc: address) (size: Z) (phi: rmap) : Prop :=
-  forall i, (0 <= i < size) -> writable (adr_add loc i) phi.
-
-Definition bytes_readable (loc: address) (size: Z) (phi: rmap) : Prop :=
-  forall i, (0 <= i < size) -> readable (adr_add loc i) phi.
-
-Lemma readable_dec (loc: address) (phi: rmap) : {readable loc phi} + {~readable loc phi}.
-Proof. intros.
-unfold readable. simpl.
-case (phi @ loc); intros; auto.
-apply isVAL_dec.
-Qed.
-
-Lemma writable_dec: forall loc phi, {writable loc phi}+{~writable loc phi}.
-Proof.
-intros.
-unfold writable. simpl.
-destruct (phi @ loc); auto.
-destruct (isVAL_dec k).
-destruct (writable0_share_dec sh).
-left; auto.
-right; auto. contradict n; auto.
-destruct n; auto.
-right; contradict n; destruct n; auto.
-Qed.
-
-Lemma bytes_writable_dec:
-   forall loc n m, {bytes_writable loc n m}+{~bytes_writable loc n m}.
-Proof.
-intros.
-destruct n.
-left; intro; intros; lia.
-2: generalize (Zlt_neg_0 p); intro; left; intro; intros; lia.
-rewrite Zpos_eq_Z_of_nat_o_nat_of_P.
-remember (nat_of_P p) as n.
-clear.
-destruct loc as [b z].
-revert z;
-induction n; intros.
-left; intro; intros.
-simpl in H; lia.
-rewrite inj_S.
-destruct (IHn (z+1)).
-destruct (writable_dec (b,z) m).
-left.
-intro; intros.
-unfold adr_add; simpl.
-destruct (zeq i 0).
-subst.
-replace (z+0) with z by lia.
-auto.
-replace (z+i) with (z+1+(i-1)) by lia.
-apply b0.
-lia.
-right.
-contradict n0.
-specialize ( n0 0).
-unfold adr_add in n0; simpl in n0.
-replace (z+0) with z in n0.
-apply n0.
-lia.
-lia.
-right.
-contradict n0.
-intro; intros.
-unfold adr_add; simpl.
-replace (z+1+i) with (z+(1+i)) by lia.
-apply n0.
-lia.
-Qed.
-
-Lemma bytes_readable_dec:
-   forall loc n m, {bytes_readable loc n m}+{~bytes_readable loc n m}.
-Proof.
-intros.
-destruct n.
-left; intro; intros; lia.
-2: generalize (Zlt_neg_0 p); intro; left; intro; intros; lia.
-rewrite Zpos_eq_Z_of_nat_o_nat_of_P.
-remember (nat_of_P p) as n.
-clear.
-destruct loc as [b z].
-revert z;
-induction n; intros.
-left; intro; intros.
-simpl in H; lia.
-rewrite inj_S.
-destruct (IHn (z+1)).
-destruct (readable_dec (b,z) m).
-left.
-intro; intros.
-unfold adr_add; simpl.
-destruct (zeq i 0).
-subst.
-replace (z+0) with z by lia.
-auto.
-replace (z+i) with (z+1+(i-1)) by lia.
-apply b0.
-lia.
-right.
-contradict n0.
-specialize ( n0 0).
-unfold adr_add in n0; simpl in n0.
-replace (z+0) with z in n0.
-apply n0.
-lia.
-lia.
-right.
-contradict n0.
-intro; intros.
-unfold adr_add; simpl.
-replace (z+1+i) with (z+(1+i)) by lia.
-apply n0.
-lia.
-Qed.
-
-Lemma bytes_writable_readable:
-  forall m loc n, bytes_writable m loc n -> bytes_readable m loc n.
-Proof.
-unfold bytes_writable, bytes_readable; intros.
-apply writable_readable; auto.
-Qed.
-
-Global Hint Resolve bytes_writable_readable : mem.
-
-Lemma rmap_age_i:
- forall w w' : rmap,
-    level w = S (level w') ->
-   (forall l, resource_fmap (approx (level w')) (approx (level w')) (w @ l) = w' @ l) ->
-    ghost_fmap (approx (level w')) (approx (level w')) (ghost_of w) = ghost_of w' ->
-    age w w'.
-Proof.
-intros.
-hnf.
-destruct (levelS_age1 _ _ H).
-assert (x=w'); [ | subst; auto].
-assert (level x = level w')
-  by (apply age_level in H2; lia).
-apply rmap_ext; auto.
-intros.
-specialize (H0 l).
-rewrite (age1_resource_at w x H2 l (w@l)).
-rewrite H3.
-apply H0.
-symmetry; apply resource_at_approx.
-erewrite age1_ghost_of; eauto.
-rewrite H3; apply H1.
-Qed.
diff --git a/veric/environ_lemmas.v b/veric/environ_lemmas.v
index 4bbf733d5e..726f081fdc 100644
--- a/veric/environ_lemmas.v
+++ b/veric/environ_lemmas.v
@@ -1,11 +1,11 @@
-Require Import VST.msl.msl_standard.
 Require Import VST.veric.Clight_base.
-Require Import VST.veric.compcert_rmaps.
 Require Import VST.veric.Clight_lemmas.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Import VST.veric.res_predicates.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.mpred.
 Require Import VST.veric.tycontext.
 Require Import VST.veric.expr2.
-Import compcert.lib.Maps.
 
 Require Import VST.veric.seplog. (*For definition of tycontext*)
 
@@ -31,17 +31,21 @@ clear IHl. destruct (split l). simpl. auto. destruct (split l). destruct a. simp
 right. apply IHl. eauto.
 Qed.
 
+Section mpred.
+
+Context `{!heapGS Σ}.
+
 Definition tycontext_evolve (Delta Delta' : tycontext) :=
- (forall id, match (temp_types Delta) ! id, (temp_types Delta') ! id with
+ (forall id, match (temp_types Delta) !! id, (temp_types Delta') !! id with
                 | Some t, Some t' => t=t'
                 | None, None => True
                 | _, _ => False
                end)
- /\ (forall id, (var_types Delta) ! id = (var_types Delta') ! id)
+ /\ (forall id, (var_types Delta) !! id = (var_types Delta') !! id)
  /\ ret_type Delta = ret_type Delta'
- /\ (forall id, (glob_types Delta) ! id = (glob_types Delta') ! id)
- /\ (forall id, (glob_specs Delta) ! id = (glob_specs Delta') ! id)
- /\ (forall id, (annotations Delta) ! id = (annotations Delta') ! id).
+ /\ (forall id, (glob_types Delta) !! id = (glob_types Delta') !! id)
+ /\ (forall id, (glob_specs Delta) !! id = (glob_specs Delta') !! id)
+ /\ (forall id, (annotations Delta) !! id = (annotations Delta') !! id).
 
 Lemma tycontext_evolve_trans: forall Delta1 Delta2 Delta3,
    tycontext_evolve Delta1 Delta2 ->
@@ -55,15 +59,15 @@ intros [A B C D E] [A1 B1 C1 D1 E1] [A2 B2 C2 D2 E2]
  try congruence.
  clear - S1 T1.
  intro id; specialize (S1 id); specialize (T1 id).
- destruct (A!id) as [?|].
- destruct (A1!id) as [?|]; [ | contradiction]. subst t0.
- destruct (A2!id) as [?|]; [ | contradiction]. subst t0.
+ destruct (A!!id) as [?|].
+ destruct (A1!!id) as [?|]; [ | contradiction]. subst t0.
+ destruct (A2!!id) as [?|]; [ | contradiction]. subst t0.
  auto.
- destruct (A1!id) as [?|]; [ contradiction| ].
+ destruct (A1!!id) as [?|]; [ contradiction| ].
  auto.
 Qed.
 
-Lemma tc_val_ptr_lemma {CS: compspecs} :
+(*Lemma tc_val_ptr_lemma {CS: compspecs} :
    forall rho m Delta id t a,
    typecheck_environ Delta rho ->
    denote_tc_assert (typecheck_expr Delta (Etempvar id (Tpointer t a))) rho m ->
@@ -79,11 +83,11 @@ destruct (eval_id id rho); try congruence.
   destruct (Int64.eq i Int64.zero); try congruence.
 +
    simple_if_tac; simpl; auto.
-Qed.
+Qed.*)
 
 Lemma typecheck_environ_put_te : forall ge te ve Delta id v ,
   typecheck_environ Delta (mkEnviron ge ve te) ->
-  (forall t , ((temp_types Delta) ! id = Some t ->
+  (forall t , ((temp_types Delta) !! id = Some t ->
      tc_val' t v)) ->
   typecheck_environ Delta (mkEnviron ge ve (Map.set id v te)).
 Proof.
@@ -99,7 +103,7 @@ Qed.
 
 Lemma typecheck_environ_put_te' : forall ge te ve Delta id v ,
  typecheck_environ  Delta (mkEnviron ge ve te) ->
-(forall t , ((temp_types Delta) ! id = Some t -> tc_val' t v)) ->
+(forall t , ((temp_types Delta) !! id = Some t -> tc_val' t v)) ->
 typecheck_environ Delta (mkEnviron ge ve (Map.set id v te)).
 Proof.
 intros.
@@ -114,5 +118,7 @@ Lemma tycontext_evolve_refl : forall Delta, tycontext_evolve Delta Delta.
 Proof.
 intros.
 split; auto.
-intros. destruct ((temp_types Delta)!id); auto.
+intros. destruct ((temp_types Delta)!!id); auto.
 Qed.
+
+End mpred.
diff --git a/veric/expr.v b/veric/expr.v
index b28d8cba56..904790127e 100644
--- a/veric/expr.v
+++ b/veric/expr.v
@@ -1,13 +1,13 @@
-Require Import VST.msl.msl_standard.
 Require Import VST.veric.Clight_base.
-Require Import VST.veric.compcert_rmaps.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Import VST.veric.res_predicates.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.mpred.
 Require Import VST.veric.tycontext.
 Require Import VST.veric.Clight_lemmas.
 Require Export VST.veric.lift. Import LiftNotation.
 Require Export VST.veric.Clight_Cop2.
 Require Export VST.veric.val_lemmas.
-Import compcert.lib.Maps.
 
 Require Import VST.veric.seplog. (*For definition of tycontext*)
 
@@ -47,7 +47,7 @@ Arguments eval_cast t1 t2 / v.
 Definition eval_field {CS: compspecs} (ty: type) (fld: ident) : val -> val :=
           match ty with
              | Tstruct id att =>
-                 match cenv_cs ! id with
+                 match cenv_cs !! id with
                  | Some co =>
                          match field_offset cenv_cs fld (co_members co) with
                          | Errors.OK (delta, Full) => offset_val delta
@@ -56,7 +56,7 @@ Definition eval_field {CS: compspecs} (ty: type) (fld: ident) : val -> val :=
                  | _ => always Vundef
                  end
              | Tunion id att =>
-                 match cenv_cs ! id with
+                 match cenv_cs !! id with
                  | Some co => 
                          match union_field_offset cenv_cs fld (co_members co) with
                          | Errors.OK (delta, Full) => offset_val delta
@@ -189,6 +189,10 @@ match ty with
 | _ => false
 end.
 
+Section mpred.
+
+Context `{!heapGS Σ}.
+
 Inductive tc_error :=
 | op_result_type : expr -> tc_error
 | arg_type : expr -> tc_error
@@ -227,7 +231,7 @@ Inductive tc_assert :=
 | tc_Zge: expr -> Z -> tc_assert
 | tc_samebase: expr -> expr -> tc_assert
 | tc_nodivover': expr -> expr -> tc_assert
-| tc_initialized: PTree.elt -> type -> tc_assert
+| tc_initialized: Maps.PTree.elt -> type -> tc_assert
 | tc_nosignedover: (Z->Z->Z) -> expr -> expr -> tc_assert.
 
 Definition tc_noproof := tc_FF miscellaneous_typecheck_error.
@@ -646,10 +650,10 @@ Definition is_neutral_cast t1 t2 :=
  | _, _ => false
  end.
 
-Definition get_var_type (Delta : tycontext) id : option type :=
-match (var_types Delta) ! id with
+Definition get_var_type (Delta : tycontext) (id : ident) : option type :=
+match (var_types Delta) !! id with
 | Some ty => Some ty
-| None => match (glob_types Delta) ! id with
+| None => match (glob_types Delta) !! id with
          | Some g => Some g
          | None => None
            end
@@ -676,7 +680,7 @@ match e with
  | Econst_float _ (Tfloat F64 _) => tc_TT
  | Econst_single _ (Tfloat F32 _) => tc_TT
  | Etempvar id ty =>
-                       match (temp_types Delta)!id with
+                       match (temp_types Delta)!!id with
                          | Some ty' => if is_neutral_cast ty' ty || same_base_type ty' ty then
                                          tc_initialized id ty'
                                        else tc_FF (mismatch_context_type ty ty')
@@ -700,7 +704,7 @@ match e with
                          | By_reference =>
                             tc_andp (typecheck_lvalue Delta a) (match typeof a with
                             | Tstruct id att =>
-                               match cenv_cs ! id with
+                               match cenv_cs !! id with
                                | Some co =>
                                   match field_offset cenv_cs i (co_members co) with
                                   | Errors.OK (delta,Full) => tc_TT
@@ -709,7 +713,7 @@ match e with
                                | _ => tc_FF (invalid_composite_name id)
                                end
                             | Tunion id att =>
-                               match cenv_cs ! id with
+                               match cenv_cs !! id with
                                | Some co => 
                                    match union_field_offset cenv_cs i (co_members co) with
                                      | Errors.OK (0, Full) => tc_TT
@@ -752,7 +756,7 @@ match e with
                          (typecheck_lvalue Delta a)
                          (match typeof a with
                             | Tstruct id att =>
-                              match cenv_cs ! id with
+                              match cenv_cs !! id with
                               | Some co =>
                                    match field_offset cenv_cs i (co_members co) with
                                      | Errors.OK (delta, Full) => tc_TT
@@ -761,7 +765,7 @@ match e with
                               | _ => tc_FF (invalid_composite_name id)
                               end
                             | Tunion id att =>
-                              match cenv_cs ! id with
+                              match cenv_cs !! id with
                               | Some co => 
                                    match union_field_offset cenv_cs i (co_members co) with
                                      | Errors.OK (0, Full) => tc_TT
@@ -781,7 +785,7 @@ Definition implicit_deref (t: type) : type :=
   end.
 
 Definition typecheck_temp_id {CS: compspecs}id ty Delta a : tc_assert :=
-  match (temp_types Delta)!id with
+  match (temp_types Delta)!!id with
   | Some t =>
       tc_andp (tc_bool (is_neutral_cast (implicit_deref ty) t) (invalid_cast ty t))
                   (isCastResultType (implicit_deref ty) t a)
@@ -819,164 +823,6 @@ match tl,el with
 | _, _ => tc_FF wrong_signature
 end.
 
-(** Environment typechecking functions **)
-
-Lemma typecheck_var_environ_None: forall ve vt,
-  typecheck_var_environ ve vt ->
-  forall i,
-  vt ! i = None <-> Map.get ve i = None.
-Proof.
-  intros.
-  destruct (vt ! i) eqn:?H, (Map.get ve i) eqn:?H; try (split; congruence).
-  + apply H in H0.
-    destruct H0; congruence.
-  + destruct p.
-    assert (vt ! i = Some t) by (apply H; eauto).
-    congruence.
-Qed.
-
-(* This naming is for the purpose when VST's developers do "Search typecheck_var_environ." *)
-Lemma WARNING___________you_should_use_tactic___destruct_var_types___instead:
-  forall (ve : venviron) (vt : PTree.t type), typecheck_var_environ ve vt -> forall i : positive,
-     match vt ! i with
-     | Some t => exists b, Map.get ve i = Some (b, t)
-     | None => Map.get ve i = None
-     end.
-Proof.
-  intros.
-  pose proof (H i).
-  destruct (vt ! i) eqn:?H.
-  + specialize (H0 t).
-    destruct H0 as [? _].
-    specialize (H0 eq_refl).
-    auto.
-  + eapply typecheck_var_environ_None; eauto.
-Qed.
-
-(* This naming is for the purpose when VST's developers do "Search typecheck_glob_environ." *)
-Lemma WARNING___________you_should_use_tactic___destruct_glob_types___instead:
-  forall (ge : genviron) (gt : PTree.t type), typecheck_glob_environ ge gt -> forall i : positive,
-     match gt ! i with
-     | Some t => exists b, Map.get ge i = Some b
-     | None => True
-     end.
-Proof.
-  intros.
-  pose proof (H i).
-  destruct (gt ! i).
-  + specialize (H0 t).
-    specialize (H0 eq_refl).
-    auto.
-  + auto.
-Qed.
-
-Ltac _destruct_var_types i Heq_vt Heq_ve t b :=
-  let HH := fresh "H" in
-  match goal with
-  | H: typecheck_var_environ _ _ |- _ =>
-      pose proof WARNING___________you_should_use_tactic___destruct_var_types___instead _ _ H i as HH
-  | H: typecheck_environ _ _ |- _ =>
-      pose proof WARNING___________you_should_use_tactic___destruct_var_types___instead _ _ (proj1 (proj2 H)) i as HH
-  end;
-  match type of HH with
-  | match ?o with _ => _ end =>
-      match goal with
-      | H: o = Some _ |- _ =>
-          rewrite H in HH
-      | H: Some _ = o |- _ =>
-          rewrite <- H in HH
-      | H: o = None |- _ =>
-          rewrite H in HH
-      | H: None = o |- _ =>
-          rewrite <- H in HH
-      | _ =>
-          let HH' := fresh "H" in
-          pose proof eq_refl o as HH';
-          destruct o as [t |] in HH, HH' at 2;
-          pose proof HH' as Heq_vt; clear HH'
-      end
-  end;
-  match type of HH with
-  | ex _ =>
-      pose proof HH as [b Heq_ve]
-  | _ =>
-      pose proof HH as Heq_ve
-  end;
-  clear HH.
-
-Tactic Notation "destruct_var_types" constr(i) :=
-  let Heq_vt := fresh "Heqo" in
-  let Heq_ve := fresh "Heqo" in
-  let t := fresh "t" in
-  let b := fresh "b" in
-  _destruct_var_types i Heq_vt Heq_ve t b.
-
-Tactic Notation "destruct_var_types" constr(i) "as" "[" ident(t) ident(b) "]" :=
-  let Heq_vt := fresh "Heqo" in
-  let Heq_ve := fresh "Heqo" in
-  _destruct_var_types i Heq_vt Heq_ve t b.
-
-Tactic Notation "destruct_var_types" constr(i) "eqn" ":" simple_intropattern(Heq_vt) "&" simple_intropattern(Heq_ve) :=
-  let t := fresh "t" in
-  let b := fresh "b" in
-  _destruct_var_types i Heq_vt Heq_ve t b.
-
-Tactic Notation "destruct_var_types" constr(i) "as" "[" ident(t) ident(b) "]" "eqn" ":" simple_intropattern(Heq_vt) "&" simple_intropattern(Heq_ve) :=
-  _destruct_var_types i Heq_vt Heq_ve t b.
-
-Ltac _destruct_glob_types i Heq_gt Heq_ge t b :=
-  let HH := fresh "H" in
-  match goal with
-  | H: typecheck_glob_environ _ _ |- _ =>
-      pose proof WARNING___________you_should_use_tactic___destruct_glob_types___instead _ _ H i as HH
-  | H: typecheck_environ _ _ |- _ =>
-      pose proof WARNING___________you_should_use_tactic___destruct_glob_types___instead _ _ (proj2 (proj2 H)) i as HH
-  end;
-  match type of HH with
-  | match ?o with _ => _ end =>
-      match goal with
-      | H: o = Some _ |- _ =>
-          rewrite H in HH
-      | H: Some _ = o |- _ =>
-          rewrite <- H in HH
-      | H: o = None |- _ =>
-          rewrite H in HH
-      | H: None = o |- _ =>
-          rewrite <- H in HH
-      | _ =>
-          let HH' := fresh "H" in
-          pose proof eq_refl o as HH';
-          destruct o as [t |] in HH, HH' at 2;
-          pose proof HH' as Heq_gt; clear HH'
-      end
-  end;
-  match type of HH with
-  | ex _ =>
-      pose proof HH as [b Heq_ge]
-  | _ =>
-      idtac
-  end;
-  clear HH.
-
-Tactic Notation "destruct_glob_types" constr(i) :=
-  let Heq_gt := fresh "Heqo" in
-  let Heq_ge := fresh "Heqo" in
-  let t := fresh "t" in
-  let b := fresh "b" in
-  _destruct_glob_types i Heq_gt Heq_ge t b.
-
-Tactic Notation "destruct_glob_types" constr(i) "as" "[" ident(t) ident(b) "]" :=
-  let Heq_gt := fresh "Heqo" in
-  let Heq_ge := fresh "Heqo" in
-  _destruct_glob_types i Heq_gt Heq_ge t b.
-
-Tactic Notation "destruct_glob_types" constr(i) "eqn" ":" simple_intropattern(Heq_gt) "&" simple_intropattern(Heq_ge) :=
-  let t := fresh "t" in
-  let b := fresh "b" in
-  _destruct_glob_types i Heq_gt Heq_ge t b.
-
-Tactic Notation "destruct_glob_types" constr(i) "as" "[" ident(t) ident(b) "]" "eqn" ":" simple_intropattern(Heq_gt) "&" simple_intropattern(Heq_ge) :=
-  _destruct_glob_types i Heq_gt Heq_ge t b.
 (** Type-checking of function parameters **)
 
 Fixpoint match_fsig_aux (bl: list expr) (tl: list (ident*type)) : bool :=
@@ -1025,7 +871,7 @@ Definition lvalue_closed_wrt_vars {CS: compspecs}(S: ident -> Prop) (e: expr) :
      (forall i, S i \/ Map.get (te_of rho) i = Map.get te' i) ->
      eval_lvalue e rho = eval_lvalue e (mkEnviron (ge_of rho) (ve_of rho) te').
 
-                                                                           
+
 Definition typecheck_store e1 :=
 (is_int_type (typeof e1) = true -> typeof e1 = Tint I32 Signed noattr) /\
 (is_float_type (typeof e1) = true -> typeof e1 = Tfloat F64 noattr).
@@ -1056,90 +902,52 @@ intros.
 remember (b&&c). destruct b0; symmetry in Heqb0; 
 try rewrite andb_true_iff in *; try rewrite andb_false_iff in *;
 simple_if_tac; auto; intuition auto;
-destruct c; auto; intuition congruence.
+destruct c; auto; simpl in *; intuition congruence.
 Qed.
 
-Program Definition valid_pointer' (p: val) (d: Z) : mpred :=
+Open Scope bi_scope.
+
+Definition valid_pointer' (p: val) (d: Z) : mpred :=
  match p with
- | Vint i => if Archi.ptr64 then FF else prop (i = Int.zero)
- | Vlong i => if Archi.ptr64 then prop (i=Int64.zero) else FF
- | Vptr b ofs =>
-  fun m =>
-    match m @ (b, Ptrofs.unsigned ofs + d) with
-    | YES _ _ _ pp => True
-    | NO sh _ => nonidentity sh
-    | _ => True (*using 'True' here enables Lemma func_at_valid_pointer below, and hence func_ptr_valid_pointer*)
-    end
- | _ => FF
+ | Vint i => if Archi.ptr64 then False else ⌜i = Int.zero⌝
+ | Vlong i => if Archi.ptr64 then ⌜i = Int64.zero⌝ else False
+ | Vptr b ofs => <absorb> ((∃dq r, (b, Ptrofs.unsigned ofs + d) ↦{dq} r) ∨ (∃ sh, ⌜sh ≠ Share.bot⌝ ∧ mapsto_no (b, Ptrofs.unsigned ofs + d) sh))
+ | _ => False
  end.
-Next Obligation.
-split; intros; congruence.
-Qed.
-Next Obligation.
-split; simpl; repeat intro.
-+ destruct (a@(b,Ptrofs.unsigned ofs + d)) eqn:?; try contradiction.
-  - (*NO*) rewrite (necR_NO a a') in Heqr.
-    * rewrite Heqr; auto.
-    * constructor; auto.
-  - (*YES*) subst.
-    apply (necR_YES a a') in Heqr; [ | constructor; auto].
-    rewrite Heqr.
-    auto.
-  - (*new case, PURE*)
-     destruct (a'@(b,Ptrofs.unsigned ofs + d)) eqn:?; try contradiction; trivial.
-     specialize (@age_resource_at _ _  (b, Ptrofs.unsigned ofs + d) H).
-     rewrite Heqr0, Heqr; simpl; congruence.
-+ apply rmap_order in H as (_ & <- & _); auto.
-Qed.
-Next Obligation.
-split3; intros; congruence.
-Qed.
-Next Obligation.
-split3; intros; congruence.
-Qed.
-Next Obligation.
-split3; intros; congruence.
-Qed.
+
+Global Instance valid_pointer'_absorbing p d : Absorbing (valid_pointer' p d).
+Proof. destruct p; apply _. Qed.
 
 Definition valid_pointer (p: val) : mpred :=
  (valid_pointer' p 0).
 
 Definition weak_valid_pointer (p: val) : mpred :=
- orp (valid_pointer' p 0) (valid_pointer' p (-1)).
-
-Lemma func_at_valid_pointer {phi  b z} (Hz: 0 <= z <= Ptrofs.max_unsigned):
-      func_at phi (b,z) |-- valid_pointer (Vptr b (Ptrofs.repr z)).
-Proof. unfold func_at. destruct phi.
-unfold res_predicates.pureat. red; intros. simpl in *.
-rewrite Zplus_0_r, Ptrofs.unsigned_repr, H; clear H; trivial.
+ (valid_pointer' p 0) ∨ (valid_pointer' p (-1)).
+
+Lemma func_at_valid_pointer {phi b z} (Hz: 0 <= z <= Ptrofs.max_unsigned):
+      func_at phi (b,z) ⊢ valid_pointer (Vptr b (Ptrofs.repr z)).
+Proof. unfold func_at, valid_pointer, valid_pointer'.
+  iIntros "(? & _)"; iLeft.
+  rewrite Z.add_0_r Ptrofs.unsigned_repr //.
+  iFrame.
 Qed.
 
-Lemma func_at'_valid_pointer {phi  b z} (Hz: 0 <= z <= Ptrofs.max_unsigned):
-      func_at' phi (b,z) |-- valid_pointer (Vptr b (Ptrofs.repr z)).
-Proof. unfold func_at'. destruct phi.
-unfold res_predicates.pureat. red; intros. simpl in *.
-destruct H.
-rewrite Zplus_0_r, Ptrofs.unsigned_repr, H; clear H; trivial.
+Lemma func_at'_valid_pointer {phi b z} (Hz: 0 <= z <= Ptrofs.max_unsigned):
+      func_at' phi (b,z) ⊢ valid_pointer (Vptr b (Ptrofs.repr z)).
+Proof. unfold func_at'; destruct phi.
+  iIntros "(% & % & % & % & ?)"; iApply func_at_valid_pointer; done.
 Qed.
 
-Lemma func_ptr_si_valid_pointer {G phi v}: @func_ptr_si G phi v |-- valid_pointer v.
+Lemma func_ptr_si_valid_pointer {phi v}: func_ptr_si phi v ⊢ valid_pointer v.
 Proof.
-  unfold func_ptr_si. apply exp_left; intros.
-  apply prop_andp_left; intros; subst v.
-  apply exp_left; intros psi.
-  apply andp_left2.
-  apply func_at_valid_pointer.
-  specialize (Ptrofs.unsigned_range_2 (Ptrofs.zero)); lia.
+  unfold func_ptr_si.
+  iIntros "(% & -> & % & _ & ?)"; iApply func_at_valid_pointer; done.
 Qed.
 
-Lemma func_ptr_valid_pointer {G phi v}: @func_ptr G phi v |-- valid_pointer v.
+Lemma func_ptr_valid_pointer {phi v}: func_ptr phi v ⊢ valid_pointer v.
 Proof.
-  unfold func_ptr. apply exp_left; intros.
-  apply prop_andp_left; intros; subst v.
-  apply exp_left; intros psi.
-  apply andp_left2.
-  apply func_at_valid_pointer.
-  specialize (Ptrofs.unsigned_range_2 (Ptrofs.zero)). lia.
+  unfold func_ptr_si.
+  iIntros "(% & -> & % & _ & ?)"; iApply func_at_valid_pointer; done.
 Qed.
 
 (********************SUBSUME****************)
@@ -1151,18 +959,15 @@ Lemma binary_intersection_retty {phi1 phi2 phi} (BI : binary_intersection phi1 p
       xtype_of_funspec phi1 = xtype_of_funspec phi.
 Proof. unfold xtype_of_funspec. rewrite (binary_intersection_typesig BI); trivial. Qed.
 
-Section invs.
-
-Context {inv_names : invariants.invG}.
-
 (* If we were to require that a non-void-returning function must,
    at a function call, have its result assigned to a temp,
    then we could change "ret0_tycon" to "ret_tycon" in this
    definition (and in NDfunspec_sub). *)
-Definition subsumespec x y:=
+
+Definition subsumespec x y :=
 match x with
-| Some hspec => exists gspec, y = Some gspec /\ (TT |-- funspec_sub_si gspec hspec) (*contravariance!*)
-| None => True
+| Some hspec => exists gspec, y = Some gspec /\ (⊢ funspec_sub_si gspec hspec) (*contravariance!*)
+| None => Logic.True
 end. 
 
 Lemma subsumespec_trans x y z (SUB1: subsumespec x y) (SUB2: subsumespec y z):
@@ -1170,8 +975,7 @@ Lemma subsumespec_trans x y z (SUB1: subsumespec x y) (SUB2: subsumespec y z):
 Proof. unfold subsumespec in *.
  destruct x; trivial. destruct SUB1 as [? [? ?]]; subst.
  destruct SUB2 as [? [? ?]]; subst. exists x0; split; trivial.
- intros w W.
- eapply funspec_sub_si_trans; split; eauto.
+ iIntros; iApply funspec_sub_si_trans; auto.
 Qed.
 
 Lemma subsumespec_refl x: subsumespec x x.
@@ -1180,18 +984,18 @@ Proof. unfold subsumespec.
 Qed.
 
 Definition tycontext_sub (Delta Delta' : tycontext) : Prop :=
- (forall id, match (temp_types Delta) ! id,  (temp_types Delta') ! id with
+ (forall id : ident, match (temp_types Delta) !! id,  (temp_types Delta') !! id with
                  | None, _ => True
                  | Some t, None => False
                  | Some t, Some t' => t=t'
                 end)
- /\ (forall id, (var_types Delta) ! id = (var_types Delta') ! id)
+ /\ (forall id, (var_types Delta) !! id = (var_types Delta') !! id)
  /\ ret_type Delta = ret_type Delta'
- /\ (forall id, sub_option ((glob_types Delta) ! id) ((glob_types Delta') ! id))
+ /\ (forall id, sub_option ((glob_types Delta) !! id) ((glob_types Delta') !! id))
 
- /\ (forall id, subsumespec ((glob_specs Delta) ! id) ((glob_specs Delta') ! id))
+ /\ (forall id, subsumespec ((glob_specs Delta) !! id) ((glob_specs Delta') !! id))
 
- /\ (forall id, Annotation_sub ((annotations Delta) ! id) ((annotations Delta') ! id)).
+ /\ (forall id, Annotation_sub ((annotations Delta) !! id) ((annotations Delta') !! id)).
 
 
 Lemma tycontext_sub_trans:
@@ -1199,13 +1003,13 @@ Lemma tycontext_sub_trans:
   tycontext_sub Delta1 Delta2 -> tycontext_sub Delta2 Delta3 ->
   tycontext_sub Delta1 Delta3.
 Proof.
-  intros ? ? ? [G1 [G2 [G3 [G4 [G5 G6]]]]] [H1 [H2 [H3 [H4 [H5 H6]]]]].
+  intros ??? [G1 [G2 [G3 [G4 [G5 G6]]]]] [H1 [H2 [H3 [H4 [H5 H6]]]]].
   repeat split.
   * intros. specialize (G1 id); specialize (H1 id).
-    destruct ((temp_types Delta1) ! id); auto.
-    destruct ((temp_types Delta2) ! id);
+    destruct ((temp_types Delta1) !! id); auto.
+    destruct ((temp_types Delta2) !! id);
       try contradiction.
-    destruct ((temp_types Delta3) ! id); try contradiction.
+    destruct ((temp_types Delta3) !! id); try contradiction.
     destruct G1, H1; split; subst; auto.
   * intros. specialize (G2 id); specialize (H2 id); congruence.
   * congruence.
@@ -1217,20 +1021,18 @@ Qed.
 Lemma tycontext_sub_refl Delta: tycontext_sub Delta Delta.
 Proof.
   repeat split; trivial.
-  * intros. destruct ((temp_types Delta) ! id); trivial. 
+  * intros. destruct ((temp_types Delta) !! id); trivial. 
   * intros. apply sub_option_refl. 
   * intros. apply subsumespec_refl.
   * intros. eapply Annotation_sub_refl.
 Qed.
 
-End invs.
-
 (*************************************)
 
 
 
 (*Could weaken and say that only the data components of the composite need to identical, not the proofs*)
-Definition cenv_sub (ce ce':composite_env) := forall i, sub_option (ce!i) (ce'!i).
+Definition cenv_sub (ce ce':composite_env) := forall i, sub_option (ce!!i) (ce'!!i).
 
 Lemma cenv_sub_refl {ce}: cenv_sub ce ce.
 Proof. intros i; apply sub_option_refl. Qed.
@@ -1238,7 +1040,7 @@ Proof. intros i; apply sub_option_refl. Qed.
 Lemma cenv_sub_trans {ce ce' ce''}: cenv_sub ce ce' -> cenv_sub ce' ce'' -> cenv_sub ce ce''.
 Proof. intros X X' i; specialize (X i); specialize (X' i). eapply sub_option_trans; eassumption. Qed.
 
-Definition ha_env_cs_sub (t t': PTree.t Z) := forall i, sub_option (t!i) (t'!i).
+Definition ha_env_cs_sub (t t': Maps.PTree.t Z) := forall i, sub_option (t!!i) (t'!!i).
 
 Lemma ha_env_cs_refl {ce}: ha_env_cs_sub ce ce.
 Proof. intros i; apply sub_option_refl. Qed.
@@ -1246,8 +1048,8 @@ Proof. intros i; apply sub_option_refl. Qed.
 Lemma ha_env_cs_sub_trans {ce ce' ce''}: ha_env_cs_sub ce ce' -> ha_env_cs_sub ce' ce'' -> ha_env_cs_sub ce ce''.
 Proof. intros X X' i; specialize (X i); specialize (X' i). eapply sub_option_trans; eassumption. Qed.
 
-Definition la_env_cs_sub (t t': PTree.t align_mem.LegalAlignasFacts.LegalAlignas.legal_alignas_obs) :=
-  forall i, sub_option (t!i) (t'!i).
+Definition la_env_cs_sub (t t': Maps.PTree.t align_mem.LegalAlignasFacts.LegalAlignas.legal_alignas_obs) :=
+  forall i, sub_option (t!!i) (t'!!i).
 
 Lemma la_env_cs_refl {ce}: la_env_cs_sub ce ce.
 Proof. intros i; apply sub_option_refl. Qed.
@@ -1271,5 +1073,169 @@ Proof.
 Qed.
 
 Lemma valid_pointer_is_pointer_or_null p:
-      valid_pointer p |-- !!(is_pointer_or_null p).
-Proof. intros m. destruct p; simpl; trivial. Qed.
\ No newline at end of file
+      valid_pointer p ⊢ ⌜is_pointer_or_null p⌝.
+Proof. destruct p; simpl; auto. Qed.
+
+End mpred.
+
+Global Arguments typecheck_expr {_ _ _} _ !e / : simpl nomatch.
+Global Arguments typecheck_lvalue {_ _ _} _ !e / : simpl nomatch.
+
+(** Environment typechecking functions **)
+
+Lemma typecheck_var_environ_None: forall ve vt,
+  typecheck_var_environ ve vt ->
+  forall i,
+  vt !! i = None <-> Map.get ve i = None.
+Proof.
+  intros.
+  destruct (vt !! i) eqn:?H, (Map.get ve i) eqn:?H; try (split; congruence).
+  + apply H in H0.
+    destruct H0; congruence.
+  + destruct p.
+    assert (vt !! i = Some t) by (apply H; eauto).
+    congruence.
+Qed.
+
+(* This naming is for the purpose when VST's developers do "Search typecheck_var_environ." *)
+Lemma WARNING___________you_should_use_tactic___destruct_var_types___instead:
+  forall (ve : venviron) (vt : Maps.PTree.t type), typecheck_var_environ ve vt -> forall i : ident,
+     match vt !! i with
+     | Some t => exists b, Map.get ve i = Some (b, t)
+     | None => Map.get ve i = None
+     end.
+Proof.
+  intros.
+  pose proof (H i).
+  destruct (vt !! i) eqn:?H.
+  + specialize (H0 t).
+    destruct H0 as [? _].
+    specialize (H0 eq_refl).
+    auto.
+  + eapply typecheck_var_environ_None; eauto.
+Qed.
+
+(* This naming is for the purpose when VST's developers do "Search typecheck_glob_environ." *)
+Lemma WARNING___________you_should_use_tactic___destruct_glob_types___instead:
+  forall (ge : genviron) (gt : Maps.PTree.t type), typecheck_glob_environ ge gt -> forall i : ident,
+     match gt !! i with
+     | Some t => exists b, Map.get ge i = Some b
+     | None => True
+     end.
+Proof.
+  intros.
+  pose proof (H i).
+  destruct (gt !! i).
+  + specialize (H0 t).
+    specialize (H0 eq_refl).
+    auto.
+  + auto.
+Qed.
+
+Ltac _destruct_var_types i Heq_vt Heq_ve t b :=
+  let HH := fresh "H" in
+  match goal with
+  | H: typecheck_var_environ _ _ |- _ =>
+      pose proof WARNING___________you_should_use_tactic___destruct_var_types___instead _ _ H i as HH
+  | H: typecheck_environ _ _ |- _ =>
+      pose proof WARNING___________you_should_use_tactic___destruct_var_types___instead _ _ (proj1 (proj2 H)) i as HH
+  end;
+  match type of HH with
+  | match ?o with _ => _ end =>
+      match goal with
+      | H: o = Some _ |- _ =>
+          rewrite H in HH
+      | H: Some _ = o |- _ =>
+          rewrite <- H in HH
+      | H: o = None |- _ =>
+          rewrite H in HH
+      | H: None = o |- _ =>
+          rewrite <- H in HH
+      | _ =>
+          let HH' := fresh "H" in
+          pose proof eq_refl o as HH';
+          destruct o as [t |] in HH, HH' at 2;
+          pose proof HH' as Heq_vt; clear HH'
+      end
+  end;
+  match type of HH with
+  | ex _ =>
+      pose proof HH as [b Heq_ve]
+  | _ =>
+      pose proof HH as Heq_ve
+  end;
+  clear HH.
+
+Tactic Notation "destruct_var_types" constr(i) :=
+  let Heq_vt := fresh "Heqo" in
+  let Heq_ve := fresh "Heqo" in
+  let t := fresh "t" in
+  let b := fresh "b" in
+  _destruct_var_types i Heq_vt Heq_ve t b.
+
+Tactic Notation "destruct_var_types" constr(i) "as" "[" ident(t) ident(b) "]" :=
+  let Heq_vt := fresh "Heqo" in
+  let Heq_ve := fresh "Heqo" in
+  _destruct_var_types i Heq_vt Heq_ve t b.
+
+Tactic Notation "destruct_var_types" constr(i) "eqn" ":" simple_intropattern(Heq_vt) "&" simple_intropattern(Heq_ve) :=
+  let t := fresh "t" in
+  let b := fresh "b" in
+  _destruct_var_types i Heq_vt Heq_ve t b.
+
+Tactic Notation "destruct_var_types" constr(i) "as" "[" ident(t) ident(b) "]" "eqn" ":" simple_intropattern(Heq_vt) "&" simple_intropattern(Heq_ve) :=
+  _destruct_var_types i Heq_vt Heq_ve t b.
+
+Ltac _destruct_glob_types i Heq_gt Heq_ge t b :=
+  let HH := fresh "H" in
+  match goal with
+  | H: typecheck_glob_environ _ _ |- _ =>
+      pose proof WARNING___________you_should_use_tactic___destruct_glob_types___instead _ _ H i as HH
+  | H: typecheck_environ _ _ |- _ =>
+      pose proof WARNING___________you_should_use_tactic___destruct_glob_types___instead _ _ (proj2 (proj2 H)) i as HH
+  end;
+  match type of HH with
+  | match ?o with _ => _ end =>
+      match goal with
+      | H: o = Some _ |- _ =>
+          rewrite H in HH
+      | H: Some _ = o |- _ =>
+          rewrite <- H in HH
+      | H: o = None |- _ =>
+          rewrite H in HH
+      | H: None = o |- _ =>
+          rewrite <- H in HH
+      | _ =>
+          let HH' := fresh "H" in
+          pose proof eq_refl o as HH';
+          destruct o as [t |] in HH, HH' at 2;
+          pose proof HH' as Heq_gt; clear HH'
+      end
+  end;
+  match type of HH with
+  | ex _ =>
+      pose proof HH as [b Heq_ge]
+  | _ =>
+      idtac
+  end;
+  clear HH.
+
+Tactic Notation "destruct_glob_types" constr(i) :=
+  let Heq_gt := fresh "Heqo" in
+  let Heq_ge := fresh "Heqo" in
+  let t := fresh "t" in
+  let b := fresh "b" in
+  _destruct_glob_types i Heq_gt Heq_ge t b.
+
+Tactic Notation "destruct_glob_types" constr(i) "as" "[" ident(t) ident(b) "]" :=
+  let Heq_gt := fresh "Heqo" in
+  let Heq_ge := fresh "Heqo" in
+  _destruct_glob_types i Heq_gt Heq_ge t b.
+
+Tactic Notation "destruct_glob_types" constr(i) "eqn" ":" simple_intropattern(Heq_gt) "&" simple_intropattern(Heq_ge) :=
+  let t := fresh "t" in
+  let b := fresh "b" in
+  _destruct_glob_types i Heq_gt Heq_ge t b.
+
+Tactic Notation "destruct_glob_types" constr(i) "as" "[" ident(t) ident(b) "]" "eqn" ":" simple_intropattern(Heq_gt) "&" simple_intropattern(Heq_ge) :=
+  _destruct_glob_types i Heq_gt Heq_ge t b.
diff --git a/veric/expr2.v b/veric/expr2.v
index 7556777818..e25dd9039c 100644
--- a/veric/expr2.v
+++ b/veric/expr2.v
@@ -1,7 +1,8 @@
-Require Import VST.msl.msl_standard.
 Require Import VST.veric.Clight_base.
-Require Import VST.veric.compcert_rmaps.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Import VST.veric.res_predicates.
 Require Import VST.veric.tycontext.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.Clight_lemmas.
 Require Export VST.veric.expr.
 Require Import VST.veric.mpred.
@@ -143,31 +144,37 @@ destruct t1 as [ | [ | | | ] [ | ] | | [ | ] | | | | | ],
  apply I.
 Qed.
 
+Section mpred.
+
+Context `{!heapGS Σ}.
+
+Open Scope bi_scope.
+
 (** Denotation functions for each of the assertions that can be produced by the typechecker **)
 
 Definition denote_tc_iszero v : mpred :=
          match v with
-         | Vint i => prop (is_true (Int.eq i Int.zero))
-         | Vlong i => prop (is_true (Int64.eq i Int64.zero))
-         | _ => FF
+         | Vint i => ⌜is_true (Int.eq i Int.zero)⌝
+         | Vlong i => ⌜is_true (Int64.eq i Int64.zero)⌝
+         | _ => False
          end.
 
 Definition denote_tc_nonzero v : mpred :=
          match v with
-         | Vint i => prop (i <> Int.zero)
-         | Vlong i =>prop (i <> Int64.zero)
-         | _ => FF end.
+         | Vint i => ⌜i <> Int.zero⌝
+         | Vlong i =>⌜i <> Int64.zero⌝
+         | _ => False end.
 
 Definition denote_tc_igt i v : mpred :=
      match v with
-     | Vint i1 => prop (Int.unsigned i1 < Int.unsigned i)
-     | _ => FF
+     | Vint i1 => ⌜Int.unsigned i1 < Int.unsigned i⌝
+     | _ => False
      end.
 
 Definition denote_tc_lgt l v : mpred :=
      match v with
-     | Vlong l1 => prop (Int64.unsigned l1 < Int64.unsigned l)
-     | _ => FF
+     | Vlong l1 => ⌜Int64.unsigned l1 < Int64.unsigned l⌝
+     | _ => False
      end.
 
 Definition Zoffloat (f:float): option Z := (**r conversion to Z *)
@@ -195,27 +202,27 @@ Definition Zofsingle (f: float32): option Z := (**r conversion to Z *)
 Definition denote_tc_Zge z v : mpred :=
           match v with
                      | Vfloat f => match Zoffloat f with
-                                    | Some n => prop (z >= n)
-                                    | None => FF
+                                    | Some n => ⌜z >= n⌝
+                                    | None => False
                                    end
                      | Vsingle f => match Zofsingle f with
-                                    | Some n => prop (z >= n)
-                                    | None => FF
+                                    | Some n => ⌜z >= n⌝
+                                    | None => False
                                    end
-                     | _ => FF
+                     | _ => False
                   end.
 
 Definition denote_tc_Zle z v : mpred :=
           match v with
                      | Vfloat f => match Zoffloat f with
-                                    | Some n => prop (z <= n)
-                                    | None => FF
+                                    | Some n => ⌜z <= n⌝
+                                    | None => False
                                    end
                      | Vsingle f => match Zofsingle f with
-                                    | Some n => prop (z <= n)
-                                    | None => FF
+                                    | Some n => ⌜z <= n⌝
+                                    | None => False
                                    end
-                     | _ => FF
+                     | _ => False
                   end.
 
 Definition sameblock v1 v2 : bool :=
@@ -225,92 +232,90 @@ Definition sameblock v1 v2 : bool :=
          end.
 
 Definition denote_tc_samebase v1 v2 : mpred :=
-       prop (is_true (sameblock v1 v2)).
+       ⌜is_true (sameblock v1 v2)⌝.
 
 (** Case for division of int min by -1, which would cause overflow **)
 Definition denote_tc_nodivover v1 v2 : mpred :=
 match v1, v2 with
-          | Vint n1, Vint n2 => prop (~(n1 = Int.repr Int.min_signed /\ n2 = Int.mone))
-          | Vlong n1, Vlong n2 => prop (~(n1 = Int64.repr Int64.min_signed /\ n2 = Int64.mone))
-          | Vint n1, Vlong n2 => TT
-          | Vlong n1, Vint n2 => prop (~ (n1 = Int64.repr Int64.min_signed  /\ n2 = Int.mone))
-          | _ , _ => FF
+          | Vint n1, Vint n2 => ⌜~(n1 = Int.repr Int.min_signed /\ n2 = Int.mone)⌝
+          | Vlong n1, Vlong n2 => ⌜~(n1 = Int64.repr Int64.min_signed /\ n2 = Int64.mone)⌝
+          | Vint n1, Vlong n2 => True
+          | Vlong n1, Vint n2 => ⌜~ (n1 = Int64.repr Int64.min_signed  /\ n2 = Int.mone)⌝
+          | _ , _ => False
         end.
 
 Definition denote_tc_nosignedover (op: Z->Z->Z) (s: signedness) v1 v2 : mpred :=
  match v1,v2 with
  | Vint n1, Vint n2 => 
-   prop (Int.min_signed <= op (Int.signed n1) (Int.signed n2) <= Int.max_signed)
+   ⌜Int.min_signed <= op (Int.signed n1) (Int.signed n2) <= Int.max_signed⌝
  | Vlong n1, Vlong n2 =>
-   prop (Int64.min_signed <= op (Int64.signed n1) (Int64.signed n2) <= Int64.max_signed)
+   ⌜Int64.min_signed <= op (Int64.signed n1) (Int64.signed n2) <= Int64.max_signed⌝
  | Vint n1, Vlong n2 =>
-   prop (Int64.min_signed <= op ((if s then Int.signed else Int.unsigned) n1) (Int64.signed n2) <= Int64.max_signed)
+   ⌜Int64.min_signed <= op ((if s then Int.signed else Int.unsigned) n1) (Int64.signed n2) <= Int64.max_signed⌝
  | Vlong n1, Vint n2 =>
-   prop (Int64.min_signed <= op (Int64.signed n1) ((if s then Int.signed else Int.unsigned)  n2) <= Int64.max_signed)
- | _, _ => FF
+   ⌜Int64.min_signed <= op (Int64.signed n1) ((if s then Int.signed else Int.unsigned)  n2) <= Int64.max_signed⌝
+ | _, _ => False
  end.
 
 Definition denote_tc_initialized id ty rho : mpred :=
-    prop (exists v, Map.get (te_of rho) id = Some v
-               /\ tc_val ty v).
+    ⌜exists v, Map.get (te_of rho) id = Some v
+               /\ tc_val ty v⌝.
 
 Definition denote_tc_isptr v : mpred :=
-  prop (isptr v).
+  ⌜isptr v⌝.
 
 Definition denote_tc_isint v : mpred :=
-  prop (is_int I32 Signed v).
+  ⌜is_int I32 Signed v⌝.
 
 Definition denote_tc_islong v : mpred :=
-  prop (is_long v).
+  ⌜is_long v⌝.
 
 Definition test_eq_ptrs v1 v2 : mpred :=
   if sameblock v1 v2
-  then (andp (weak_valid_pointer v1) (weak_valid_pointer v2))
-  else (andp (valid_pointer v1) (valid_pointer v2)).
+  then ((weak_valid_pointer v1) ∧ (weak_valid_pointer v2))
+  else ((valid_pointer v1) ∧ (valid_pointer v2)).
 
 Definition test_order_ptrs v1 v2 : mpred :=
   if sameblock v1 v2
-  then (andp (weak_valid_pointer v1) (weak_valid_pointer v2))
-  else FF.
+  then ((weak_valid_pointer v1) ∧ (weak_valid_pointer v2))
+  else False.
 
 Definition denote_tc_test_eq v1 v2 : mpred :=
  match v1, v2 with
  | Vint i, Vint j => 
-     if Archi.ptr64 then FF else andp (prop (i = Int.zero)) (prop (j = Int.zero))
+     if Archi.ptr64 then False else bi_and (⌜i = Int.zero⌝) (⌜j = Int.zero⌝)
  | Vlong i, Vlong j => 
-     if Archi.ptr64 then andp (prop (i = Int64.zero)) (prop (j = Int64.zero)) else FF
+     if Archi.ptr64 then bi_and (⌜i = Int64.zero⌝) (⌜j = Int64.zero⌝) else False
  | Vint i, Vptr _ _ =>
-      if Archi.ptr64 then FF else andp (prop (i = Int.zero)) (weak_valid_pointer v2)
+      if Archi.ptr64 then False else bi_and (⌜i = Int.zero⌝) (weak_valid_pointer v2)
  | Vlong i, Vptr _ _ =>
-      if Archi.ptr64 then andp (prop (i = Int64.zero)) (weak_valid_pointer v2) else FF
+      if Archi.ptr64 then bi_and (⌜i = Int64.zero⌝) (weak_valid_pointer v2) else False
  | Vptr _ _, Vint i =>
-      if Archi.ptr64 then FF else andp (prop (i = Int.zero)) (weak_valid_pointer v1)
+      if Archi.ptr64 then False else bi_and (⌜i = Int.zero⌝) (weak_valid_pointer v1)
  | Vptr _ _, Vlong i =>
-      if Archi.ptr64 then andp (prop (i = Int64.zero)) (weak_valid_pointer v1) else FF
+      if Archi.ptr64 then bi_and (⌜i = Int64.zero⌝) (weak_valid_pointer v1) else False
  | Vptr _ _, Vptr _ _ =>
       test_eq_ptrs v1 v2
- | _, _ => FF
+ | _, _ => False
  end.
 
 Definition denote_tc_test_order v1 v2 : mpred :=
  match v1, v2 with
- | Vint i, Vint j => if Archi.ptr64 then FF else andp (prop (i = Int.zero)) (prop (j = Int.zero))
- | Vlong i, Vlong j => if Archi.ptr64 then andp (prop (i = Int64.zero)) (prop (j = Int64.zero)) else FF
+ | Vint i, Vint j => if Archi.ptr64 then False else bi_and (⌜i = Int.zero⌝) (⌜j = Int.zero⌝)
+ | Vlong i, Vlong j => if Archi.ptr64 then bi_and (⌜i = Int64.zero⌝) (⌜j = Int64.zero⌝) else False
  | Vptr _ _, Vptr _ _ =>
       test_order_ptrs v1 v2
- | _, _ => FF
+ | _, _ => False
  end.
 
 Definition typecheck_error (e: tc_error) : Prop := False.
 
-Search (type->bool).
-
 Fixpoint denote_tc_assert {CS: compspecs}(a: tc_assert) : environ -> mpred :=
   match a with
-  | tc_FF msg => `(prop (typecheck_error msg))
-  | tc_TT => `TT
-  | tc_andp' b c => `andp (denote_tc_assert b) (denote_tc_assert c)
-  | tc_orp' b c => `orp (denote_tc_assert b) (denote_tc_assert c)
+  | tc_FF msg => `(⌜typecheck_error msg⌝)
+  | tc_TT => `True
+  | tc_andp' b c => `bi_and (denote_tc_assert b) (denote_tc_assert c)
+  | tc_orp' b c => `bi_or (denote_tc_assert b) (denote_tc_assert c)
   | tc_nonzero' e => `denote_tc_nonzero (eval_expr e)
   | tc_isptr e => `denote_tc_isptr (eval_expr e)
   | tc_isint e => `denote_tc_isint (eval_expr e)
@@ -333,80 +338,73 @@ Fixpoint denote_tc_assert {CS: compspecs}(a: tc_assert) : environ -> mpred :=
      end
  end.
 
-Lemma and_False: forall x, (x /\ False) = False.
+Lemma and_False: forall x, (x /\ False) = Logic.False.
 Proof.
-intros; apply prop_ext; intuition.
+intros; apply Axioms.prop_ext; intuition.
 Qed.
 
 Lemma and_True: forall x, (x /\ True) = x.
 Proof.
-intros; apply prop_ext; intuition.
+intros; apply Axioms.prop_ext; intuition.
 Qed.
 
 Lemma True_and: forall x, (True /\ x) = x.
 Proof.
-intros; apply prop_ext; intuition.
+intros; apply Axioms.prop_ext; intuition.
 Qed.
 
-Lemma False_and: forall x, (False /\ x) = False.
+Lemma False_and: forall x, (False /\ x) = Logic.False.
 Proof.
-intros; apply prop_ext; intuition.
+intros; apply Axioms.prop_ext; intuition.
 Qed.
 
-Lemma tc_andp_sound : forall {CS: compspecs} a1 a2 rho m,
-    denote_tc_assert  (tc_andp a1 a2) rho m <->
-    denote_tc_assert  (tc_andp' a1 a2) rho m.
+Lemma tc_andp_sound : forall {CS: compspecs} a1 a2 rho,
+    denote_tc_assert  (tc_andp a1 a2) rho ⊣⊢
+    denote_tc_assert  (tc_andp' a1 a2) rho.
 Proof.
 intros.
  unfold tc_andp.
  destruct a1; simpl; unfold_lift;
- repeat first [rewrite False_and | rewrite True_and
-                    | rewrite and_False | rewrite and_True ];
-  try apply iff_refl;
+ repeat first [rewrite bi.False_and | rewrite bi.True_and
+                    | rewrite bi.and_False | rewrite bi.and_True ];
+  try reflexivity;
   destruct a2; simpl in *; unfold_lift;
- repeat first [rewrite False_and | rewrite True_and
-                    | rewrite and_False | rewrite and_True ];
-  try apply iff_refl.
+  repeat first [rewrite bi.False_and | rewrite bi.True_and
+                    | rewrite bi.and_False | rewrite bi.and_True ];
+  try reflexivity.
 Qed.
 
 Lemma denote_tc_assert_andp:
-  forall {CS: compspecs} a b rho, denote_tc_assert (tc_andp a b) rho =
-             andp (denote_tc_assert a rho) (denote_tc_assert b rho).
-Proof.
- intros.
- apply pred_ext.
- intro m. rewrite tc_andp_sound. intros [? ?]; split; auto.
- intros m [? ?]. rewrite tc_andp_sound; split; auto.
-Qed.
+  forall {CS: compspecs} a b rho, denote_tc_assert (tc_andp a b) rho ⊣⊢
+             bi_and (denote_tc_assert a rho) (denote_tc_assert b rho).
+Proof. intros; apply tc_andp_sound. Qed.
 
 Lemma neutral_isCastResultType:
-  forall {CS: compspecs} t t' v rho,
+  forall {CS: compspecs} P t t' v rho,
    is_neutral_cast t' t = true ->
-   forall m, denote_tc_assert (isCastResultType t' t v) rho m.
+   P ⊢ denote_tc_assert (isCastResultType t' t v) rho.
 Proof.
 intros.
   unfold isCastResultType.
   unfold is_neutral_cast in H; simpl classify_cast.
   destruct t'  as [ | [ | | | ] [ | ] | | [ | ] | | | | |],
    t  as [ | [ | | | ] [ | ] | | [ | ] | | | | |];
-   try solve [inv H; try apply I; simpl; simple_if_tac; apply I];
-  try (rewrite denote_tc_assert_andp; split);
+   try solve [inv H; auto; simpl; simple_if_tac; auto];
+  try (rewrite denote_tc_assert_bi_and; split);
   try solve [unfold eval_cast, sem_cast, classify_cast,
      sem_cast_pointer, sem_cast_i2bool, sem_cast_l2bool;
-      destruct Archi.ptr64; simpl; try simple_if_tac; try apply I].
+      destruct Archi.ptr64; simpl; try simple_if_tac; auto].
   apply orb_true_iff in H.
   unfold classify_cast.
   destruct (Bool.eqb (eqb_type (Tpointer t a0) int_or_ptr_type)
          (eqb_type (Tpointer t' a) int_or_ptr_type)) eqn:J.
-  destruct (eqb_type (Tpointer t' a) (Tpointer t a0)) eqn:?H.
-  apply I.
+  destruct (eqb_type (Tpointer t' a) (Tpointer t a0)) eqn:?H; first by auto.
   destruct H. inv H.
   apply andb_true_iff in H. destruct H.
   rewrite eqb_true_iff in J.
   unfold is_pointer_type.
   rewrite <- J in *. apply eqb_type_false in H0.
-  destruct (eqb_type (Tpointer t a0) int_or_ptr_type); inv H.
-  apply I.
+  destruct (eqb_type (Tpointer t a0) int_or_ptr_type); inv H; by auto.
   destruct H.
   apply eqb_type_true in H. rewrite <- H in *.
   rewrite eqb_reflx in J. inv J.
@@ -418,10 +416,12 @@ Lemma is_true_e: forall b, is_true b -> b=true.
 Proof. intros. destruct b; try contradiction; auto.
 Qed.
 
-Lemma tc_bool_e: forall {CS: compspecs} b a rho m,
-  app_pred (denote_tc_assert (tc_bool b a) rho) m ->
-  b = true.
+Lemma tc_bool_e: forall {CS: compspecs} b a rho,
+  denote_tc_assert (tc_bool b a) rho ⊢
+  ⌜b = true⌝.
 Proof.
 intros.
-destruct b; simpl in H; auto.
+destruct b; simpl; auto.
 Qed.
+
+End mpred.
diff --git a/veric/expr_lemmas.v b/veric/expr_lemmas.v
index 910aa172b0..213d64e897 100644
--- a/veric/expr_lemmas.v
+++ b/veric/expr_lemmas.v
@@ -1,7 +1,8 @@
 Require Import VST.veric.Clight_base.
-Require Import VST.msl.msl_standard.
-Require Import VST.veric.compcert_rmaps.
 Require Import VST.veric.Clight_lemmas.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Import VST.veric.res_predicates.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.mpred.
 Require Import VST.veric.tycontext.
 Require Import VST.veric.expr2.
@@ -20,7 +21,6 @@ Import Cop2.
 Import Clight_Cop2.
 Import Ctypes.
 Import LiftNotation.
-Import compcert.lib.Maps.
 
 Transparent intsize_eq.
 
@@ -48,9 +48,9 @@ Proof.
   { destruct t; auto.
     apply negb_true; auto. }
   destruct t, v; auto; try solve [destruct f; auto]; simpl in *; unfold bool_val in *;
-    simpl in *; rewrite ?Hf in *; auto; try discriminate; simpl in *; try contradiction.
+    simpl in *; rewrite -> ?Hf in *; auto; try discriminate; simpl in *; try contradiction.
   destruct Archi.ptr64; inv H1.
-  rewrite ?Int.eq_true, ?Int64.eq_true; auto.
+  rewrite -> ?Int.eq_true, ?Int64.eq_true; auto.
 Qed.
 
 Lemma bool_val_Cop: forall t v m b b', bool_val t v = Some b -> Cop.bool_val v t m = Some b' ->
@@ -63,219 +63,128 @@ Proof.
   try solve [revert H0; repeat simple_if_tac; intros; congruence].
 Qed.
 
-Lemma map_ptree_rel : forall id v te, Map.set id v (make_tenv te) = make_tenv (PTree.set id v te).
-intros. unfold Map.set. unfold make_tenv. extensionality. rewrite PTree.gsspec; auto.
+Lemma map_ptree_rel : forall id v te, Map.set id v (make_tenv te) = make_tenv (Maps.PTree.set id v te).
+intros. unfold Map.set. unfold make_tenv. extensionality. rewrite Maps.PTree.gsspec; auto.
 Qed.
 
-Lemma cast_exists : forall {CS: compspecs} Delta e2 t rho phi
+Section mpred.
+
+Context `{!heapGS Σ}.
+
+Lemma cast_exists : forall {CS: compspecs} Delta e2 t rho
 (TC: typecheck_environ Delta rho),
-denote_tc_assert (typecheck_expr Delta e2) rho phi ->
-denote_tc_assert (isCastResultType (typeof e2) t e2)
-  rho phi ->
-sem_cast (typeof e2) t (eval_expr e2 rho)  =
-Some (force_val (sem_cast (typeof e2) t (eval_expr e2 rho))).
+denote_tc_assert (typecheck_expr Delta e2) rho ∧
+denote_tc_assert (isCastResultType (typeof e2) t e2) rho ⊢
+⌜sem_cast (typeof e2) t (eval_expr e2 rho) =
+Some (force_val (sem_cast (typeof e2) t (eval_expr e2 rho)))⌝.
 Proof.
 intros.
-assert (exists v, sem_cast (typeof e2) t (eval_expr e2 rho) = Some v). {
-apply typecheck_expr_sound in H; [ | auto ].
-rewrite isCastR in H0.
-unfold sem_cast.
-rename t into t0.
-remember (typeof e2); remember (eval_expr e2 rho).
-unfold sem_cast.
-destruct Archi.ptr64 eqn:Hp.
-*
-destruct (eqb_type t int_or_ptr_type) eqn:J.
- +
-  apply eqb_type_true in J. rewrite J in *.
-  exists v.
-  hnf in H; rewrite eqb_type_refl in H; unfold is_pointer_or_integer in H;
-  rewrite Hp in H.
-  destruct v; try contradiction;
-  unfold classify_cast in *;
-  destruct t0 as [ | [ | | | ] [ | ] ? | i2 ? | [ | ] ? | | | | | ];
-  rewrite ?Hp in *; try contradiction;
-  simpl in H0 |- *; auto.
-+
- unfold sem_cast_pointer, classify_cast in *. rewrite Hp, J in *.
- destruct (eqb_type t0 int_or_ptr_type) eqn:J0.
- -
-  apply eqb_type_true in J0. subst t0.
-  unfold int_or_ptr_type at 1 in H0. unfold int_or_ptr_type at 1.
-  destruct (is_int_type t) eqn:?HH.
-  ** destruct t; try inv HH.
-     inv H0.
-  ** 
-    destruct t as [ | [ | | | ] [ | ] a | i a | [ | ] a | | | | | ]; destruct v; try contradiction; try inv HH;
-    eauto.
- -
- destruct t0 as [ | [ | | | ] [ | ] ? | ? ? | [ | ] ? | | | | | ]; try contradiction; rewrite ?J0; eauto;
-  destruct t as [ | [ | | | ] [ | ] ? | ? ? | [ | ] ? | | | | | ]; try contradiction; 
-    destruct v; try contradiction; 
-  simpl in *; rewrite ?J in *; rewrite ?J0 in *;
-  try solve [eexists; simpl; eauto];
- try contradiction;
- try solve [
-  unfold_lift in H0; simpl in H0; rewrite <- Heqv in H0; simpl in H0; 
-  match type of H0 with (app_pred match ?ZZ with Some _ => _ | None => _ end _ /\ _) =>
-    destruct ZZ eqn:H5
- end;
- destruct H0 as [H0 H0']; do 3 red in H0, H0';
- try contradiction;
- simpl;
- first [rewrite (float_to_int_ok _ _ H5)
-        | rewrite (float_to_intu_ok _ _ H5)
-        | rewrite (single_to_int_ok _ _ H5)
-        | rewrite (single_to_intu_ok _ _ H5)
-        ] ;
-    [ eexists; reflexivity
-    | split; lia ]].
- all: try (unfold is_pointer_or_null in H; rewrite Hp in H; contradiction).
-all:  try (rewrite Hp; eexists; reflexivity).
-*
-destruct (eqb_type t int_or_ptr_type) eqn:J.
- +
-  apply eqb_type_true in J. rewrite J in *.
-  exists v.
-  hnf in H; rewrite eqb_type_refl in H; unfold is_pointer_or_integer in H;
-  rewrite Hp in H.
-  destruct v; try contradiction;
-  unfold classify_cast in *;
-  destruct t0 as [ | [ | | | ] [ | ] ? | i2 ? | [ | ] ? | | | | | ];
-  rewrite ?Hp in *; try contradiction;
-  simpl in H0 |- *; auto.
-+
- unfold sem_cast_pointer, classify_cast in *. rewrite Hp, J in *.
- destruct (eqb_type t0 int_or_ptr_type) eqn:J0.
- -
-  apply eqb_type_true in J0. subst t0.
-  unfold int_or_ptr_type at 1 in H0. unfold int_or_ptr_type at 1.
-  destruct t as [ | [ | | | ] [ | ] a | i a | [ | ] a | | | | | ]; destruct v; try contradiction; eauto.
- -
- simpl in *.
- destruct t0 as [ | [ | | | ] [ | ] ? | ? ? | [ | ] ? | | | | | ]; try contradiction; rewrite ?J0; eauto;
-  destruct t as [ | [ | | | ] [ | ] ? | ? ? | [ | ] ? | | | | | ]; try contradiction; simpl in *;
-    destruct v; try contradiction; 
-  try solve [eexists; simpl; rewrite ?Hp; eauto];
- try (rewrite J in H); 
- try contradiction;
- try solve [
-  unfold_lift in H0; simpl in H0; rewrite <- Heqv in H0; simpl in H0; 
-  match type of H0 with (app_pred match ?ZZ with Some _ => _ | None => _ end _ /\ _) =>
-    destruct ZZ eqn:H5
- end;
- destruct H0 as [H0 H0']; do 3 red in H0,H0';
- try contradiction;
- simpl;
-
- first [rewrite (float_to_int_ok _ _ H5)
-        | rewrite (float_to_intu_ok _ _ H5)
-        | rewrite (single_to_int_ok _ _ H5)
-        | rewrite (single_to_intu_ok _ _ H5)
-        ] ;
-    [ eexists; reflexivity | lia];
-  simpl; rewrite Hp; eauto];
-  (hnf in H; rewrite Hp in H; contradiction H).
-}
-Opaque liftx.
-destruct H1. rewrite H1. auto.
+iIntros "H".
+iDestruct (typecheck_expr_sound _ _ (Ecast e2 t) with "[H]") as %H; first done.
+{ unfold typecheck_expr at 2; fold typecheck_expr.
+  by rewrite denote_tc_assert_andp. }
+simpl in H.
+unfold force_val1 in H; super_unfold_lift.
+destruct (sem_cast _ _ _); [auto | apply tc_val_Vundef in H; contradiction].
 Qed.
 
+End mpred.
+
 Definition func_tycontext_t_denote :=
 forall p t id ty ,  list_norepet (map fst p ++ map fst t ) ->
-((make_tycontext_t p t) ! id = Some ty <-> (In (id,ty) p \/ In (id,ty) t)).
+((make_tycontext_t p t) !! id = Some ty <-> (In (id,ty) p \/ In (id,ty) t)).
 
 Definition func_tycontext_v_denote :=
 forall v id ty, list_norepet (map fst v) ->
-((make_tycontext_v v) ! id = Some ty <-> In (id,ty) v).
+((make_tycontext_v v) !! id = Some ty <-> In (id,ty) v).
 
 Lemma func_tycontext_v_sound : func_tycontext_v_denote.
 unfold func_tycontext_v_denote. intros.
 split; intros; induction v. simpl in *.
-rewrite PTree.gempty in *. congruence.
+setoid_rewrite Maps.PTree.gempty in H0. congruence.
 
-simpl in *. destruct a. inv H. rewrite PTree.gsspec in *. if_tac in H0.
+simpl in *. destruct a. inv H. setoid_rewrite Maps.PTree.gsspec in H0. if_tac in H0.
 inv H0. auto. tauto.
 
 inv H0.
 
-simpl in *. destruct a. simpl in *. rewrite PTree.gsspec. destruct H0.
+simpl in *. destruct a. simpl in *. setoid_rewrite Maps.PTree.gsspec. destruct H0.
 inv H0. if_tac. auto. tauto. inv H. if_tac. subst.
-clear - H0 H3. rewrite in_map_iff in *. destruct H3. exists (i,ty). auto.
+clear - H0 H3. rewrite in_map_iff in H3. destruct H3. exists (i,ty). auto.
 apply IHv; auto.
 Qed.
 
 
-Lemma set_inside : forall i0 t1 t p id,
+(*Lemma set_inside : forall i0 t1 t p id,
 list_disjoint (map fst p) (i0 :: map fst t) ->
 (fold_right
           (fun param : ident * type =>
-           PTree.set (fst param) (snd param, true))
-          (PTree.set i0 (t1, false)
+           Maps.PTree.set (fst param) (snd param, true))
+          (Maps.PTree.set i0 (t1, false)
              (fold_right
-                (fun (temp : ident * type) (tenv : PTree.t (type * bool)) =>
-                 let (id, ty) := temp in PTree.set id (ty, false) tenv)
-                (PTree.empty (type * bool)) t)) p) ! id =
-(PTree.set i0 (t1, false) (
+                (fun (temp : ident * type) (tenv : Maps.PTree.t (type * bool)) =>
+                 let (id, ty) := temp in Maps.PTree.set id (ty, false) tenv)
+                (Maps.PTree.empty (type * bool)) t)) p) !! id =
+(Maps.PTree.set i0 (t1, false) (
 (fold_right
           (fun param : ident * type =>
-           PTree.set (fst param) (snd param, true))
+           Maps.PTree.set (fst param) (snd param, true))
                 (fold_right
-                (fun (temp : ident * type) (tenv : PTree.t (type * bool)) =>
-                 let (id, ty) := temp in PTree.set id (ty, false) tenv)
-                (PTree.empty (type * bool)) t)) p)) ! id
+                (fun (temp : ident * type) (tenv : Maps.PTree.t (type * bool)) =>
+                 let (id, ty) := temp in Maps.PTree.set id (ty, false) tenv)
+                (Maps.PTree.empty (type * bool)) t)) p)) !! id
 .
 Proof.
 intros.
 induction t.
-  simpl in *. rewrite PTree.gsspec.
+  simpl in *. setoid_rewrite Maps.PTree.gsspec.
   if_tac.
     subst.
     induction p.
-      simpl in *. rewrite PTree.gsspec. rewrite peq_true. auto.
+      simpl in *. setoid_rewrite Maps.PTree.gsspec. rewrite peq_true. auto.
 
-      simpl in *. rewrite PTree.gsspec. if_tac. subst.
+      simpl in *. setoid_rewrite Maps.PTree.gsspec. if_tac. subst.
       clear - H. unfold list_disjoint in *. specialize (H (fst a) (fst a)).
-      exfalso; apply H; simpl; auto.
+      contradiction H; simpl; auto.
       apply IHp. unfold list_disjoint in *. intros.
       apply H; simpl in *; auto.
 
     induction p.
-       simpl in *. rewrite PTree.gsspec. if_tac. tauto.
+       simpl in *. setoid_rewrite Maps.PTree.gsspec. if_tac. tauto.
        auto.
 
-       simpl in *.  repeat rewrite PTree.gsspec in *. destruct a.
-       simpl in *. if_tac. auto. rewrite IHp.  auto. unfold list_disjoint in *.
+       simpl in *. setoid_rewrite Maps.PTree.gsspec. destruct a.
+       simpl in *. if_tac. auto. setoid_rewrite IHp. auto. unfold list_disjoint in *.
        intros. apply H; simpl in *; auto.
 
-  simpl in *. rewrite PTree.gsspec in *. if_tac.
+  simpl in *. setoid_rewrite Maps.PTree.gsspec. if_tac.
     subst.
     induction p.
-      simpl in *. rewrite PTree.gsspec in *. rewrite peq_true in *.
+      simpl in *. setoid_rewrite Maps.PTree.gsspec. rewrite -> peq_true in *.
       auto.
 
-      simpl in *. rewrite PTree.gsspec in *. destruct a0 as (i,t0). simpl in *.
-      if_tac. subst. clear - H. specialize (H i i).
-      exfalso; apply H; simpl; auto.
+      simpl in *. setoid_rewrite Maps.PTree.gsspec. setoid_rewrite Maps.PTree.gsspec in IHp. setoid_rewrite Maps.PTree.gsspec in IHt. rewrite Maps.PTree.gsspec in IHt.
+      destruct a0 as (i,t0). simpl in *.
+      if_tac. subst. clear - H. specialize (H i i). contradiction H; simpl; auto.
       apply IHp.
       unfold list_disjoint in *. intros. apply H; simpl in *; auto.
-      intros. apply IHt. unfold list_disjoint in *. intros; simpl in *; apply H;      auto.
+      intros. apply IHt. unfold list_disjoint in *. intros; simpl in *; apply H;  auto.
       auto. auto. tauto.
 
     destruct a. simpl in *. induction p.
-      simpl in *. rewrite PTree.gsspec. if_tac; subst. tauto.
-      repeat rewrite PTree.gsspec. auto.
+      simpl in *. setoid_rewrite Maps.PTree.gsspec. if_tac; subst. tauto.
+      repeat setoid_rewrite Maps.PTree.gsspec. auto.
 
       simpl in *. destruct a. simpl in *.
       spec IHt. unfold list_disjoint in *. intros; apply H; simpl in *; auto.
       tauto.
-      repeat rewrite PTree.gsspec in *. if_tac.
+      setoid_rewrite Maps.PTree.gsspec. setoid_rewrite Maps.PTree.gsspec in IHp. if_tac.
         subst.  auto.
 
         apply IHp. unfold list_disjoint in *.   intros. apply H. simpl in *.
-        auto.  auto. intros. auto.
+        auto. auto. intros. rewrite if_false; auto. rewrite /lookup /ptree_lookup. reflexivity.
 
-Qed.
+Qed.*)
 
 Lemma func_tycontext_t_sound : func_tycontext_t_denote.
 Proof.
@@ -284,18 +193,18 @@ Proof.
   unfold make_tycontext_t in *;
   apply list_norepet_app in H; destruct H as [? [? ?]].
   + induction t; induction p; simpl in *.
-    - rewrite PTree.gempty in *; congruence.
+    - setoid_rewrite Maps.PTree.gempty in H0; congruence.
     - left.
-      destruct a; simpl in *. rewrite PTree.gsspec in *. if_tac in H0.
+      destruct a; simpl in *. setoid_rewrite Maps.PTree.gsspec in H0. if_tac in H0.
       inv H0. auto.
       inv H.  destruct IHp; auto. unfold list_disjoint.  intros. inv H4.
       destruct H.
     - right.
-      destruct a. simpl in *. rewrite PTree.gsspec in *.
+      destruct a. simpl in *. setoid_rewrite Maps.PTree.gsspec in H0.
       if_tac in H0. subst. inv H0. auto. destruct IHt. inv H1; auto.
       unfold list_disjoint in *. intros. inv H4. auto. tauto. tauto.
     - simpl in *.
-      rewrite PTree.gsspec in *.
+      setoid_rewrite Maps.PTree.gsspec in H0. setoid_rewrite Maps.PTree.gsspec in IHt.
       if_tac in H0.
       * destruct a0. simpl in *.
         subst. inv H0. tauto.
@@ -317,17 +226,17 @@ Proof.
         ++ right. auto.
   + induction t; induction p; simpl in *.
     - tauto.
-    - rewrite PTree.gsspec. if_tac.
+    - setoid_rewrite Maps.PTree.gsspec. if_tac.
       * subst. destruct a. simpl in *.
         destruct H0; [destruct H0 |].
        ++ inv H0. auto.
        ++ subst.
-          clear - H H0. inv H. rewrite in_map_iff in *. destruct H3.
+          clear - H H0. inv H. rewrite in_map_iff in H3. destruct H3.
           exists (i,ty). auto.
        ++ inv H0.
       * destruct H0.
        ++ destruct a. destruct H0.
-         -- subst. inv H0. tauto.
+         -- subst. inv H0.
          -- simpl in *. apply IHp.
            ** inv H; auto.
            ** intro. intros. inv H5.
@@ -336,10 +245,10 @@ Proof.
     - destruct H0; [| destruct H0].
       * inv H0.
       * destruct a. simpl in *. inv H0; subst.
-        rewrite PTree.gsspec. rewrite peq_true. auto.
-      * destruct a. simpl in *. rewrite PTree.gsspec.
+        setoid_rewrite Maps.PTree.gsspec. rewrite peq_true. auto.
+      * destruct a. simpl in *. setoid_rewrite Maps.PTree.gsspec.
         if_tac.
-       ++ subst. clear -H0 H1. inv H1. rewrite in_map_iff in *.
+       ++ subst. clear -H0 H1. inv H1. rewrite in_map_iff in H3.
           destruct H3. exists (i,ty); auto.
        ++ apply IHt. inv H1; auto.
           intro; auto. right. auto.
@@ -351,18 +260,18 @@ Proof.
       * simpl in *.
         destruct H0.
        ++ inv H0.
-          rewrite PTree.gsspec in *. rewrite peq_true. auto.
+          setoid_rewrite Maps.PTree.gsspec. rewrite peq_true. auto.
        ++ subst.
-          rewrite PTree.gsspec in *. if_tac.
+          setoid_rewrite Maps.PTree.gsspec. setoid_rewrite Maps.PTree.gsspec in IHt. if_tac.
          -- subst. inv H. rewrite in_map_iff in H5.
             destruct H5. exists (i0,ty); auto.
          -- spec IHp. auto. spec IHp; auto.
-      * simpl in *. rewrite PTree.gsspec. if_tac.
+      * simpl in *. setoid_rewrite Maps.PTree.gsspec. if_tac.
        ++ subst. destruct H0.
          -- inv H0. specialize (H2 i0 i0). destruct H2; simpl; auto.
          -- subst.
             spec IHt; [auto |].
-            rewrite PTree.gsspec in *. rewrite peq_true in *. auto.
+            setoid_rewrite Maps.PTree.gsspec in IHt. rewrite -> peq_true in *. auto.
        ++ destruct H0.
          -- inv H0.
             spec IHp; [auto |].
@@ -377,7 +286,7 @@ Proof.
             spec IHp; [auto |].
             spec IHp; [| auto].
             spec IHt; [auto |].
-            rewrite PTree.gsspec in *.
+            setoid_rewrite Maps.PTree.gsspec in IHt.
             if_tac in IHt.
            ** tauto.
            ** intros. auto.
@@ -410,104 +319,53 @@ Proof.
   simpl in *; try congruence; auto.
 Qed.
 
-Lemma tc_exprlist_length : forall {CS: compspecs} Delta tl el rho phi,
-denote_tc_assert (typecheck_exprlist Delta tl el) rho phi ->
-length tl = length el.
+Section mpred.
+
+Context `{!heapGS Σ}.
+
+Lemma tc_exprlist_length : forall {CS: compspecs} Delta tl el rho,
+denote_tc_assert (typecheck_exprlist Delta tl el) rho ⊢
+⌜length tl = length el⌝.
 Proof.
-intros. generalize dependent el. induction tl; intros. simpl in *. destruct el. inv H. auto.
-inv H. simpl in H. destruct el; try solve [inv H]. simpl in *.
-rewrite !denote_tc_assert_andp in H.
-f_equal; apply IHtl.
-destruct H; auto.
+intros. generalize dependent el. induction tl; intros. simpl in *. destruct el; auto.
+simpl. destruct el; try iIntros "[]". simpl.
+rewrite !denote_tc_assert_andp IHtl.
+by iIntros "(_ & ->)".
 Qed.
 
-Lemma neutral_cast_tc_val : forall {CS: compspecs} e t rho phi Delta,
+Lemma neutral_cast_tc_val : forall {CS: compspecs} e t rho Delta,
 true = is_neutral_cast (implicit_deref (typeof e)) t ->
-denote_tc_assert (isCastResultType (implicit_deref (typeof e)) t  e) rho phi ->
-denote_tc_assert (typecheck_expr Delta e) rho phi ->
 typecheck_environ Delta rho ->
-tc_val t (eval_expr e rho).
+denote_tc_assert (typecheck_expr Delta e) rho ⊢
+⌜tc_val t (eval_expr e rho)⌝.
 Proof.
 intros.
-rewrite isCastR in H0.
-apply typecheck_expr_sound in H1; auto.
-pose (AA := typeof e).
-pose (BB := t).
-Transparent Int.repr.
-unfold classify_cast in *.
-unfold tc_val, is_neutral_cast, implicit_deref, is_pointer_type, is_int_type in *.
-destruct (typeof e)  as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ] ;
-destruct t as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ]; 
-try congruence;
-repeat match goal with |- context [eqb_type ?A ?B] =>
-  let J := fresh "J" in destruct (eqb_type A B) eqn:J;
-  try rewrite J in *
-end;
-try solve [
- simpl in H; simpl in H0;
-try congruence; 
-remember (eval_expr e rho); destruct v;
-simpl in H0; try congruence; auto;
-simpl in *; try congruence; super_unfold_lift;
-try rewrite <- Heqv in *;  try unfold denote_tc_iszero in *;
-try change Byte.min_signed with (-128) in *;
-try change Byte.max_signed with 127 in *;
-try change (Z.neg (shift_pos 15 1)) with (-32768);
-try change Byte.max_unsigned with 255 in *;
-try lia;
-try apply H0;
-try solve [destruct H1; subst; try split; compute; congruence]
-].
-change (negb true) with false in H.
-rewrite andb_false_r in H. rewrite orb_false_r in H.
-symmetry in H.
-rewrite H in *.
-apply eqb_type_true in H. rewrite H in *.
-rewrite J in *.
-simpl in H0. auto.
-change (negb false) with true in H.
-rewrite andb_true_r in H.
-symmetry in H.
-apply orb_true_iff in H.
-destruct H.
-apply eqb_type_true in H. rewrite H in *.
-rewrite J in *.
-rewrite eqb_type_refl in *.
-auto.
-destruct (eqb_type (Tpointer t0 a) int_or_ptr_type) eqn:?J; inv H.
-auto.
+rewrite typecheck_expr_sound; last done.
+iIntros (?); iPureIntro; eapply neutral_cast_subsumption'; eauto.
 Qed.
 
-Opaque Int.repr.
-
 Definition typecheck_tid_ptr_compare
-Delta id :=
-match (temp_types Delta) ! id with
+Delta (id : ident) :=
+match (temp_types Delta) !! id with
 | Some t => is_int_type t
 | None => false
 end.
 
-Section invs.
-
-Context {inv_names : invariants.invG}.
-
 Lemma typecheck_tid_ptr_compare_sub:
    forall Delta Delta',
     tycontext_sub Delta Delta' ->
-    forall id, typecheck_tid_ptr_compare Delta id = true ->
+    forall id : ident, typecheck_tid_ptr_compare Delta id = true ->
                 typecheck_tid_ptr_compare Delta' id = true.
 Proof.
 unfold typecheck_tid_ptr_compare;
 intros.
 destruct H as [? _].
 specialize (H id).
-destruct ((temp_types Delta) ! id) as [? |]; try discriminate.
-destruct ((temp_types Delta') ! id) as [? |]; try contradiction.
+destruct ((temp_types Delta) !! id) as [? |]; try discriminate.
+destruct ((temp_types Delta') !! id) as [? |]; try contradiction.
  destruct H; subst; auto.
 Qed.
 
-End invs.
-
 Lemma int64_eq_e:
  forall i j, Int64.eq i j = true -> i=j.
 Proof.
@@ -516,147 +374,16 @@ pose proof (Int64.eq_spec i j). rewrite H in H0; auto.
 Qed.
 
 Lemma tc_val_sem_cast:
-  forall {CS: compspecs} t2 e2 rho phi Delta,
+  forall {CS: compspecs} t2 e2 rho Delta,
       typecheck_environ Delta rho ->
-      denote_tc_assert (typecheck_expr Delta e2) rho phi ->
-      denote_tc_assert (isCastResultType (typeof e2) t2  e2) rho phi ->
-      tc_val t2 (force_val (sem_cast (typeof e2) t2 (eval_expr e2 rho))).
+      denote_tc_assert (typecheck_expr Delta e2) rho ∧
+      denote_tc_assert (isCastResultType (typeof e2) t2 e2) rho ⊢
+      ⌜tc_val t2 (force_val (sem_cast (typeof e2) t2 (eval_expr e2 rho)))⌝.
 Proof.
-intros ? ? ? ? ? ? H2 H5 H6.
-assert (H7 := cast_exists _ _ _ _ phi H2 H5 H6).
-assert (H8 := typecheck_expr_sound _ _ _ _ H2 H5).
-clear - H7 H6 H8.
-Transparent liftx.
-revert H7; case_eq (sem_cast (typeof e2) t2 (eval_expr e2 rho) ); intros; inv H7.
-simpl.
-rewrite isCastR in H6.
-unfold tc_val, sem_cast, classify_cast in *.
-destruct (eqb_type t2 int_or_ptr_type) eqn:J.
-{
-apply eqb_type_true in J; subst t2.
-destruct (eqb_type (typeof e2) int_or_ptr_type) eqn:J0;
-  [| destruct Archi.ptr64 eqn:Hp;
-     [ try solve [inv Hp]; destruct (is_long_type (typeof e2)) eqn:?HH
-     | try solve [inv Hp]; destruct (is_int_type (typeof e2)) eqn:?HH];
-[| destruct (is_pointer_type (typeof e2)) eqn:?HH] ].
-{
-apply eqb_type_true in J0; rewrite J0 in *.
-simpl in *.
-destruct (eval_expr e2 rho); inv H; auto.
-}
-{
-destruct (typeof e2); try solve [inv HH].
-simpl in H6.
-rewrite N.eqb_refl in H6.
-try inv H.
-simpl in H6.
-destruct (eval_expr e2 rho); auto.
-}
-{
-unfold is_pointer_type in *.
-rewrite J0 in *.
-rewrite eqb_type_refl in H6.
-simpl in *.
-destruct (typeof e2); try solve [inv HH0];
-try inv H;
-destruct (eval_expr e2 rho); auto.
-}
-
-{
-unfold is_pointer_type in *.
-rewrite J0 in *.
-rewrite eqb_type_refl in H6.
-simpl in *.
-destruct (typeof e2) as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ];
-inv HH; inv HH0; try inv H6; try inv H8; try inv H2; auto.
-}
-
-}
-destruct (eqb_type (typeof e2) int_or_ptr_type) eqn:J0.
-{
-unfold is_pointer_type in *.
-rewrite J0 in *.
-apply eqb_type_true in J0; rewrite J0, ?J in *.
-rewrite (eqb_type_sym int_or_ptr_type t2), J in *.
-simpl in *.
-destruct t2 as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ]; try contradiction;
-destruct Archi.ptr64; simpl in *; inv H; try inv H6; destruct (eval_expr e2 rho); inv H6; auto.
-}
-unfold sem_cast_pointer in *;
-destruct t2 as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ] eqn:T2;
-destruct Archi.ptr64 eqn:Hp;
-try rewrite denote_tc_assert_andp in H6;
-try contradiction;
-destruct (typeof e2) as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ] eqn:Te2;
-auto; try contradiction;  repeat rewrite if_true in * by auto;
-    repeat match goal with
-    | H: app_pred (denote_tc_assert (tc_bool _ _) _) _ |- _ => 
-                      apply tc_bool_e in H
-   end;
- try solve [
-destruct (eval_expr e2 rho); simpl in H6,H8,H|-*;
- try inv H8; try inv H;
- try contradiction;
- try match goal with
-    H: match ?A with Some _ => _ | None => _ end = _ |- _ => 
-          destruct A eqn:?; inv H
-    end;
- try apply I;
- try match goal with
-  | |- context [if ?A then _ else _] =>
-     destruct A; simpl; auto; try apply I
-  | |- context [Int.sign_ext ?n ?i] =>
-  apply (sign_ext_range' n i);  compute; split; congruence
-  | |- context [Int.zero_ext ?n ?i] =>
-  apply (zero_ext_range' n i);  compute; split; congruence
-  end].
-
-all: try solve [clear H6; simpl in H; destruct (eval_expr e2 rho); inv H; assumption].
-
-all: try (
-unfold is_pointer_type in H6; rewrite ?J,?J0 in H6; simpl in H6;
-simpl in H6; rewrite denote_tc_assert_iszero' in H6; simpl in H6;
-unfold denote_tc_iszero in H6; unfold_lift in H6;
-destruct (eval_expr e2 rho); try contradiction; inv H; apply I).
-
-
-all:
-try (
-unfold is_pointer_type in H6; rewrite ?J,?J0 in H6; simpl in H6;
-simpl in H6; rewrite denote_tc_assert_iszero' in H6; simpl in H6; 
-unfold denote_tc_iszero in H6; unfold_lift in H6;
-destruct (eval_expr e2 rho); try contradiction; inv H;
-apply is_true_e in H6; first [apply int_eq_e in H6 | apply int64_eq_e in H6; rewrite Int64.repr_unsigned in H6]; subst;
-hnf; rewrite Hp; solve [auto]).
-
-all:
-try (
-unfold is_pointer_type in H6; rewrite ?J,?J0 in H6; simpl in H6;
-simpl in H6; rewrite denote_tc_assert_iszero' in H6; simpl in H6;
-unfold denote_tc_iszero in H6; unfold_lift in H6;
-destruct (eval_expr e2 rho); try contradiction; inv H;
-simpl in H8; rewrite Hp in H8; try contradiction H8;
-apply is_true_e in H6; first [apply int_eq_e in H6 | apply int64_eq_e in H6; rewrite Int64.repr_unsigned in H6]; subst;
-inv H8).
-
-all:
-try (unfold is_pointer_type in H6; rewrite ?J,?J0 in H6; simpl in H6;
-simpl in H6; rewrite denote_tc_assert_iszero' in H6; simpl in H6; 
-unfold denote_tc_iszero in H6; unfold_lift in H6;
-destruct (eval_expr e2 rho); try contradiction; inv H;
-apply is_true_e in H6; first [apply int_eq_e in H6 | apply int64_eq_e in H6; rewrite Int64.repr_unsigned in H6]; subst;
-simpl in H8; rewrite Hp in H8; inv H8).
-
-all: 
-try (simpl eqb_type in H6; cbv iota in H6;
-unfold is_pointer_type in H6; rewrite J in H6; simpl in H6;
-rewrite denote_tc_assert_iszero' in H6; simpl in H6;
-unfold denote_tc_iszero in H6; unfold_lift in H6;
-inv H; destruct (eval_expr e2 rho); try contradiction;
-do 3 red in H6;
-apply is_true_e in H6; apply int64_eq_e in H6; subst; hnf; rewrite Hp; auto).
-
-all: try (inv H1; reflexivity).
+intros.
+iIntros "H"; iApply (typecheck_expr_sound _ _ (Ecast e2 t2)); first done.
+unfold typecheck_expr at 2; fold typecheck_expr.
+by rewrite denote_tc_assert_andp.
 Qed.
 
 Section CENV_SUB.
@@ -675,7 +402,7 @@ Qed.
 
 Lemma cenv_sub_e:
   forall env1 env2, cenv_sub env1 env2 ->
-    forall i c,  env1 ! i = Some c -> env2 ! i = Some c.
+    forall i c,  env1 !! i = Some c -> env2 !! i = Some c.
 Proof.
 intros.
 specialize (H i).
@@ -771,7 +498,7 @@ all: try (
   exfalso; apply H; clear H;
   unfold eval_field;
   destruct (typeof e); auto;
-  destruct ((@cenv_cs CS) ! i0) eqn:?H; auto;
+  destruct ((@cenv_cs CS) !! i0) eqn:?H; auto;
   destruct (field_offset (@cenv_cs CS) i (co_members c)) as [ [? [|]] | ] eqn:?H; auto;
   destruct (union_field_offset (@cenv_cs CS) i (co_members c)) as [ [? [|]] | ] eqn:?H; auto;
   clear - e0;
@@ -782,7 +509,7 @@ all: try (
    unfold eval_field in *.
    destruct (typeof e); auto.
    ++
-   destruct ((@cenv_cs CS) ! i0) eqn:?H; auto;
+   destruct ((@cenv_cs CS) !! i0) eqn:?H; auto;
      [ |  contradiction H; destruct (@eval_lvalue CS e rho); reflexivity].
    assert (H1 := CSUB i0); hnf in H1; rewrite H0 in H1; rewrite H1.
    destruct (field_offset (@cenv_cs CS) i (co_members c)) as [[? [|]] | ] eqn:H2;
@@ -793,7 +520,7 @@ all: try (
     intros. specialize (CSUB id). hnf in CSUB; rewrite H3 in CSUB; auto.
      apply co_consistent_complete;  apply (cenv_consistent i0); auto. 
   ++
-    destruct ((@cenv_cs CS) ! i0) eqn:?H; auto;
+    destruct ((@cenv_cs CS) !! i0) eqn:?H; auto;
      [ |  contradiction H; destruct (@eval_lvalue CS e rho); reflexivity].
    assert (H1 := CSUB i0); hnf in H1; rewrite H0 in H1; rewrite H1.
    destruct (union_field_offset (@cenv_cs CS) i (co_members c)) as [[? [|]] | ] eqn:H2;
@@ -808,9 +535,9 @@ all: try (
   clear.
   unfold eval_field.
   destruct (typeof e); simpl; auto.
-  destruct ((@cenv_cs CS) ! i0); auto.
+  destruct ((@cenv_cs CS) !! i0); auto.
   destruct (field_offset (@cenv_cs CS) i (co_members c)) as [[? [|]] | ] ; auto.
-  destruct ((@cenv_cs CS) ! i0); auto.
+  destruct ((@cenv_cs CS) !! i0); auto.
   destruct (union_field_offset (@cenv_cs CS) i (co_members c)) as [[? [|]] | ] ; auto.
  + unfold expr.sizeof.
    destruct (complete_type (@cenv_cs CS) t) eqn:?H.
@@ -833,10 +560,10 @@ all: try (
     contradict H.
     simpl; unfold_lift.
   destruct (typeof e); simpl; auto.
-  destruct ((@cenv_cs CS) ! i0); auto.
+  destruct ((@cenv_cs CS) !! i0); auto.
   destruct (field_offset (@cenv_cs CS) i (co_members c)) as [[? [|]] | ] ; auto.
    rewrite H; auto.
-  destruct ((@cenv_cs CS) ! i0); auto.
+  destruct ((@cenv_cs CS) !! i0); auto.
   destruct (union_field_offset (@cenv_cs CS) i (co_members c)) as [[? [|]] | ] ; auto.
    rewrite H; auto.
   }
@@ -844,7 +571,7 @@ all: try (
   rewrite <- IHe.
   unfold eval_field.
   destruct (typeof e) eqn:H9; simpl; auto;
-  destruct ((@cenv_cs CS) ! i0) eqn:?H; auto;
+  destruct ((@cenv_cs CS) !! i0) eqn:?H; auto;
    try solve [contradiction H; simpl; unfold_lift; rewrite H9; simpl; rewrite H1; reflexivity];
   rewrite (cenv_sub_e _ _ CSUB _ _ H1).
   destruct (field_offset (@cenv_cs CS) i (co_members c))  as [[? [|]] | ] eqn:?H; auto;
@@ -885,26 +612,26 @@ Lemma eval_expr_cenv_sub_Vsingle {CS CS'} (CSUB: cenv_sub (@cenv_cs CS) (@cenv_c
  rewrite <- (@eval_expr_cenv_sub_eq _ _ CSUB rho e); auto; congruence.
 Qed.
 
-Lemma denote_tc_iszero_eval_expr_cenv_sub {CS CS'} (CSUB : cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho w e
-    (E : (` denote_tc_iszero) (@eval_expr CS e) rho w):
-  (` denote_tc_iszero) (@eval_expr CS' e) rho w.
+Lemma denote_tc_iszero_eval_expr_cenv_sub {CS CS'} (CSUB : cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho e:
+  (` denote_tc_iszero) (@eval_expr CS e) rho ⊢
+  (` denote_tc_iszero) (@eval_expr CS' e) rho.
 Proof.
   unfold denote_tc_iszero, liftx, lift in *; simpl in *.
   remember (@eval_expr CS e rho) as v; symmetry in Heqv.
-  destruct v; simpl in E; try contradiction.
-  rewrite (eval_expr_cenv_sub_Vint CSUB _ _ _ Heqv); apply E.
-  rewrite (eval_expr_cenv_sub_Vlong CSUB _ _ _ Heqv); apply E.
+  destruct v; simpl; try iIntros "[]".
+  by rewrite (eval_expr_cenv_sub_Vint CSUB _ _ _ Heqv).
+  by rewrite (eval_expr_cenv_sub_Vlong CSUB _ _ _ Heqv).
 Qed.
 
-Lemma denote_tc_nonzero_eval_expr_cenv_sub {CS CS'} (CSUB : cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho w e
-    (E : (` denote_tc_nonzero) (@eval_expr CS e) rho w):
-  (` denote_tc_nonzero) (@eval_expr CS' e) rho w.
+Lemma denote_tc_nonzero_eval_expr_cenv_sub {CS CS'} (CSUB : cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho e:
+    (` denote_tc_nonzero) (@eval_expr CS e) rho ⊢
+    (` denote_tc_nonzero) (@eval_expr CS' e) rho.
 Proof.
   unfold denote_tc_nonzero, liftx, lift in *; simpl in *.
   remember (@eval_expr CS e rho) as v; symmetry in Heqv.
-  destruct v; simpl in E; try contradiction.
-  rewrite (eval_expr_cenv_sub_Vint CSUB _ _ _ Heqv); apply E.
-  rewrite (eval_expr_cenv_sub_Vlong CSUB _ _ _ Heqv); apply E.
+  destruct v; simpl; try iIntros "[]".
+  by rewrite (eval_expr_cenv_sub_Vint CSUB _ _ _ Heqv).
+  by rewrite (eval_expr_cenv_sub_Vlong CSUB _ _ _ Heqv).
 Qed.
 
 Lemma isptr_eval_expr_cenv_sub {CS CS'} (CSUB : cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho e
@@ -934,78 +661,78 @@ Proof.
   rewrite (eval_expr_cenv_sub_Vlong CSUB _ _ _ Heqv); trivial. 
 Qed.
 
-Lemma denote_tc_test_eq_eval_expr_cenv_sub {CS CS'} (CSUB : cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho e1 e2 w
-    (E: (` denote_tc_test_eq) (@eval_expr CS e1) (@eval_expr CS e2) rho w):
-  (` denote_tc_test_eq) (@eval_expr CS' e1) (@eval_expr CS' e2) rho w.
+Lemma denote_tc_test_eq_eval_expr_cenv_sub {CS CS'} (CSUB : cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho e1 e2:
+    (` denote_tc_test_eq) (@eval_expr CS e1) (@eval_expr CS e2) rho ⊢
+    (` denote_tc_test_eq) (@eval_expr CS' e1) (@eval_expr CS' e2) rho.
 Proof.
   unfold liftx, lift in *; simpl in *.
   remember (@eval_expr CS e1 rho) as v1; symmetry in Heqv1.
   remember (@eval_expr CS e2 rho) as v2; symmetry in Heqv2.
-  destruct v1; destruct v2; simpl in E; try contradiction; simpl;
+  destruct v1; destruct v2; simpl; try iIntros "[]"; simpl;
   rewrite
-     ?(eval_expr_cenv_sub_Vint CSUB _ _ _ Heqv1),
-     ?(eval_expr_cenv_sub_Vlong CSUB _ _ _ Heqv1),
-     ?(eval_expr_cenv_sub_Vint CSUB _ _ _ Heqv2),
-     ?(eval_expr_cenv_sub_Vlong CSUB _ _ _ Heqv2),
-     ?(eval_expr_cenv_sub_Vptr CSUB _ _ _ _ Heqv1),
+     ?(eval_expr_cenv_sub_Vint CSUB _ _ _ Heqv1)
+     ?(eval_expr_cenv_sub_Vlong CSUB _ _ _ Heqv1)
+     ?(eval_expr_cenv_sub_Vint CSUB _ _ _ Heqv2)
+     ?(eval_expr_cenv_sub_Vlong CSUB _ _ _ Heqv2)
+     ?(eval_expr_cenv_sub_Vptr CSUB _ _ _ _ Heqv1)
      ?(eval_expr_cenv_sub_Vptr CSUB _ _ _ _ Heqv2); simpl; trivial.
 Qed. 
-  
-Lemma denote_tc_test_order_eval_expr_cenv_sub {CS CS'} (CSUB : cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho e1 e2 w
-    (E: (` denote_tc_test_order) (@eval_expr CS e1) (@eval_expr CS e2) rho w):
-  (` denote_tc_test_order) (@eval_expr CS' e1) (@eval_expr CS' e2) rho w.
+
+Lemma denote_tc_test_order_eval_expr_cenv_sub {CS CS'} (CSUB : cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho e1 e2:
+    (` denote_tc_test_order) (@eval_expr CS e1) (@eval_expr CS e2) rho ⊢
+    (` denote_tc_test_order) (@eval_expr CS' e1) (@eval_expr CS' e2) rho.
 Proof.
   unfold liftx, lift in *; simpl in *.
   remember (@eval_expr CS e1 rho) as v1; symmetry in Heqv1.
   remember (@eval_expr CS e2 rho) as v2; symmetry in Heqv2.
-  destruct v1; destruct v2; simpl in E; try contradiction; simpl;
+  destruct v1; destruct v2; simpl; try iIntros "[]"; simpl;
   rewrite
-     ?(eval_expr_cenv_sub_Vint CSUB _ _ _ Heqv1),
-     ?(eval_expr_cenv_sub_Vlong CSUB _ _ _ Heqv1),
-     ?(eval_expr_cenv_sub_Vint CSUB _ _ _ Heqv2),
-     ?(eval_expr_cenv_sub_Vlong CSUB _ _ _ Heqv2),
-     ?(eval_expr_cenv_sub_Vptr CSUB _ _ _ _ Heqv1),
+     ?(eval_expr_cenv_sub_Vint CSUB _ _ _ Heqv1)
+     ?(eval_expr_cenv_sub_Vlong CSUB _ _ _ Heqv1)
+     ?(eval_expr_cenv_sub_Vint CSUB _ _ _ Heqv2)
+     ?(eval_expr_cenv_sub_Vlong CSUB _ _ _ Heqv2)
+     ?(eval_expr_cenv_sub_Vptr CSUB _ _ _ _ Heqv1)
      ?(eval_expr_cenv_sub_Vptr CSUB _ _ _ _ Heqv2); simpl; trivial.
 Qed.
 
-Lemma denote_tc_igt_eval_expr_cenv_sub {CS CS'} (CSUB : cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho e w i
-    (E: (` denote_tc_igt i) (@eval_expr CS e) rho w):
-  (` denote_tc_igt i) (@eval_expr CS' e) rho w.
+Lemma denote_tc_igt_eval_expr_cenv_sub {CS CS'} (CSUB : cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho e i:
+    (` denote_tc_igt i) (@eval_expr CS e) rho ⊢
+    (` denote_tc_igt i) (@eval_expr CS' e) rho.
 Proof.
   unfold liftx, lift in *; simpl in *.
   remember (@eval_expr CS e rho) as v; symmetry in Heqv.
-  destruct v; simpl in E; try contradiction; simpl.
+  destruct v; simpl; try iIntros "[]"; simpl.
   rewrite (eval_expr_cenv_sub_Vint CSUB _ _ _ Heqv); simpl; trivial.
 Qed.
 
-Lemma denote_tc_lgt_eval_expr_cenv_sub {CS CS'} (CSUB : cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho e w i
-    (E: (` denote_tc_lgt i) (@eval_expr CS e) rho w):
-  (` denote_tc_lgt i) (@eval_expr CS' e) rho w.
+Lemma denote_tc_lgt_eval_expr_cenv_sub {CS CS'} (CSUB : cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho e i:
+    (` denote_tc_lgt i) (@eval_expr CS e) rho ⊢
+    (` denote_tc_lgt i) (@eval_expr CS' e) rho.
 Proof.
   unfold liftx, lift in *; simpl in *.
   remember (@eval_expr CS e rho) as v; symmetry in Heqv.
-  destruct v; simpl in E; try contradiction; simpl.
+  destruct v; simpl; try iIntros "[]"; simpl.
   rewrite (eval_expr_cenv_sub_Vlong CSUB _ _ _ Heqv); simpl; trivial.
 Qed.
 
-Lemma denote_tc_Zge_eval_expr_cenv_sub {CS CS'} (CSUB : cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho e w z
-    (E: (` denote_tc_Zge z) (@eval_expr CS e) rho w):
-  (` denote_tc_Zge z) (@eval_expr CS' e) rho w.
+Lemma denote_tc_Zge_eval_expr_cenv_sub {CS CS'} (CSUB : cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho e z:
+    (` denote_tc_Zge z) (@eval_expr CS e) rho ⊢
+    (` denote_tc_Zge z) (@eval_expr CS' e) rho.
 Proof.
   unfold liftx, lift in *; simpl in *.
   remember (@eval_expr CS e rho) as v; symmetry in Heqv.
-  destruct v; simpl in E; try contradiction; simpl.
+  destruct v; simpl; try iIntros "[]"; simpl.
   + rewrite (eval_expr_cenv_sub_Vfloat CSUB _ _ _ Heqv); simpl; trivial.
   + rewrite (eval_expr_cenv_sub_Vsingle CSUB _ _ _ Heqv); simpl; trivial.
 Qed.
 
-Lemma denote_tc_Zle_eval_expr_cenv_sub {CS CS'} (CSUB : cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho e w z
-    (E: (` denote_tc_Zle z) (@eval_expr CS e) rho w):
-  (` denote_tc_Zle z) (@eval_expr CS' e) rho w.
+Lemma denote_tc_Zle_eval_expr_cenv_sub {CS CS'} (CSUB : cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho e z:
+    (` denote_tc_Zle z) (@eval_expr CS e) rho ⊢
+    (` denote_tc_Zle z) (@eval_expr CS' e) rho.
 Proof.
   unfold liftx, lift in *; simpl in *.
   remember (@eval_expr CS e rho) as v; symmetry in Heqv.
-  destruct v; simpl in E; try contradiction; simpl.
+  destruct v; simpl; try iIntros "[]"; simpl.
   + rewrite (eval_expr_cenv_sub_Vfloat CSUB _ _ _ Heqv); simpl; trivial.
   + rewrite (eval_expr_cenv_sub_Vsingle CSUB _ _ _ Heqv); simpl; trivial.
 Qed.
@@ -1017,70 +744,64 @@ Proof.
   unfold is_true, sameblock in *; simpl in *.
   remember (@eval_expr CS e1 rho) as v1; symmetry in Heqv1.
   remember (@eval_expr CS e2 rho) as v2; symmetry in Heqv2.
-  destruct v1; destruct v2; simpl in E; try contradiction; simpl.
+  destruct v1; destruct v2; simpl in E; try contradiction; simpl;
   try rewrite (eval_expr_cenv_sub_Vptr CSUB _ _ _ _ Heqv1);
   try rewrite (eval_expr_cenv_sub_Vptr CSUB _ _ _ _ Heqv2); simpl; trivial.
 Qed.
 
-Lemma denote_tc_nodivover_eval_expr_cenv_sub {CS CS'} (CSUB : cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho e1 e2 w 
-      (E: (` denote_tc_nodivover) (@eval_expr CS e1) (@eval_expr CS e2) rho w):
-(` denote_tc_nodivover) (@eval_expr CS' e1) (@eval_expr CS' e2) rho w.
+Lemma denote_tc_nodivover_eval_expr_cenv_sub {CS CS'} (CSUB : cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho e1 e2:
+      (` denote_tc_nodivover) (@eval_expr CS e1) (@eval_expr CS e2) rho ⊢
+      (` denote_tc_nodivover) (@eval_expr CS' e1) (@eval_expr CS' e2) rho.
 Proof.
   unfold liftx, lift, denote_tc_nodivover in *; simpl in *.
   remember (@eval_expr CS e1 rho) as v1; symmetry in Heqv1.
   remember (@eval_expr CS e2 rho) as v2; symmetry in Heqv2.
-  destruct v1; destruct v2; simpl in E; try contradiction; simpl;
+  destruct v1; destruct v2; simpl; try iIntros "[]"; simpl;
   try rewrite (eval_expr_cenv_sub_Vint CSUB _ _ _ Heqv1);
   try rewrite (eval_expr_cenv_sub_Vlong CSUB _ _ _ Heqv1);
   try rewrite (eval_expr_cenv_sub_Vint CSUB _ _ _ Heqv2);
   try rewrite (eval_expr_cenv_sub_Vlong CSUB _ _ _ Heqv2); simpl; trivial.
 Qed.
 
-Lemma denote_tc_nosignedover_eval_expr_cenv_sub {CS CS'} (CSUB : cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho e1 e2 w (z:Z -> Z -> Z) (s: signedness)
-      (E: @app_pred rmap ag_rmap Ext_rmap
-        (@liftx (Tarrow val (Tarrow val (LiftEnviron mpred)))
-           (denote_tc_nosignedover z s) (@eval_expr CS e1) 
-           (@eval_expr CS e2) rho) w):
-  @app_pred rmap ag_rmap Ext_rmap
-        (@liftx (Tarrow val (Tarrow val (LiftEnviron mpred)))
-           (denote_tc_nosignedover z s) (@eval_expr CS' e1) 
-           (@eval_expr CS' e2) rho) w.
+Lemma denote_tc_nosignedover_eval_expr_cenv_sub {CS CS'} (CSUB : cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho e1 e2 (z:Z -> Z -> Z) (s: signedness):
+      liftx (denote_tc_nosignedover z s) (@eval_expr CS e1) (@eval_expr CS e2) rho ⊢
+      liftx (denote_tc_nosignedover z s) (@eval_expr CS' e1) (@eval_expr CS' e2) rho.
 Proof.
   unfold liftx, lift, denote_tc_nodivover in *; simpl in *.
   remember (@eval_expr CS e1 rho) as v1; symmetry in Heqv1.
   remember (@eval_expr CS e2 rho) as v2; symmetry in Heqv2.
-  destruct v1; destruct v2; simpl in E; try contradiction; simpl;
+  destruct v1; destruct v2; simpl; try iIntros "[]"; simpl;
   try rewrite (eval_expr_cenv_sub_Vint CSUB _ _ _ Heqv1);
   try rewrite (eval_expr_cenv_sub_Vlong CSUB _ _ _ Heqv1);
   try rewrite (eval_expr_cenv_sub_Vint CSUB _ _ _ Heqv2);
   try rewrite (eval_expr_cenv_sub_Vlong CSUB _ _ _ Heqv2); simpl; trivial.
 Qed.
 
-Lemma denote_tc_assert_cenv_sub {CS CS'} (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho w: forall a, 
-    @denote_tc_assert CS a rho w -> @denote_tc_assert CS' a rho w.
+Lemma denote_tc_assert_cenv_sub {CS CS'} (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho: forall a, 
+    denote_tc_assert(CS := CS) a rho ⊢ denote_tc_assert(CS := CS') a rho.
 Proof.
   induction a; simpl; intros; trivial.
-  + destruct H; split; eauto.
-  + destruct H; [left | right]; auto.
-  + apply (denote_tc_nonzero_eval_expr_cenv_sub CSUB); trivial.
-  + apply (denote_tc_iszero_eval_expr_cenv_sub CSUB); trivial.
-  + apply (isptr_eval_expr_cenv_sub CSUB); trivial.
-  + apply (isint_eval_expr_cenv_sub CSUB); trivial.
-  + apply (islong_eval_expr_cenv_sub CSUB); trivial.
-  + apply (denote_tc_test_eq_eval_expr_cenv_sub CSUB); trivial.
-  + apply (denote_tc_test_order_eval_expr_cenv_sub CSUB); trivial.
-  + apply (denote_tc_igt_eval_expr_cenv_sub CSUB); trivial.
-  + apply (denote_tc_lgt_eval_expr_cenv_sub CSUB); trivial.
-  + apply (denote_tc_Zge_eval_expr_cenv_sub CSUB); trivial.
-  + apply (denote_tc_Zle_eval_expr_cenv_sub CSUB); trivial.
-  + apply (istrue_sameblock_eval_expr_cenv_sub CSUB); trivial.
-  + apply (denote_tc_nodivover_eval_expr_cenv_sub CSUB); trivial.
+  + unfold_lift; by rewrite IHa1 IHa2.
+  + unfold_lift; by rewrite IHa1 IHa2.
+  + apply (denote_tc_nonzero_eval_expr_cenv_sub CSUB).
+  + apply (denote_tc_iszero_eval_expr_cenv_sub CSUB).
+  + iIntros "%"; iPureIntro; apply (isptr_eval_expr_cenv_sub CSUB); trivial.
+  + iIntros "%"; iPureIntro; apply (isint_eval_expr_cenv_sub CSUB); trivial.
+  + iIntros "%"; iPureIntro; apply (islong_eval_expr_cenv_sub CSUB); trivial.
+  + apply (denote_tc_test_eq_eval_expr_cenv_sub CSUB).
+  + apply (denote_tc_test_order_eval_expr_cenv_sub CSUB).
+  + apply (denote_tc_igt_eval_expr_cenv_sub CSUB).
+  + apply (denote_tc_lgt_eval_expr_cenv_sub CSUB).
+  + apply (denote_tc_Zge_eval_expr_cenv_sub CSUB).
+  + apply (denote_tc_Zle_eval_expr_cenv_sub CSUB).
+  + iIntros "%"; iPureIntro; apply (istrue_sameblock_eval_expr_cenv_sub CSUB); trivial.
+  + apply (denote_tc_nodivover_eval_expr_cenv_sub CSUB).
   + destruct (typeof e) as [ | _ [ | ] _ | | | | | | | ],
        (typeof e0) as [ | _ [ | ] _ | | | | | | | ];
    try (apply (denote_tc_nosignedover_eval_expr_cenv_sub CSUB); trivial).
 Qed.
 
-Lemma denote_tc_assert_cenv_sub' {CS CS'} (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho w Delta: forall a, 
+(*Lemma denote_tc_assert_cenv_sub' {CS CS'} (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS')) rho w Delta: forall a, 
     @denote_tc_assert CS (@typecheck_expr CS Delta a) rho w ->
     @denote_tc_assert CS' (@typecheck_expr CS' Delta a) rho w.
 Proof. 
@@ -1100,20 +821,20 @@ Proof.
     destruct t0; auto. 
     destruct (eqb_type t t0 && (Zeq_bool z z0 && eqb_attr a a0)); auto.
   - destruct (get_var_type Delta i); auto. simpl in *.
-    destruct t0; auto.
-    destruct ((eqb_list eqb_type l l0 && eqb_type t t0 && eqb_calling_convention c c0)); auto.
-  + destruct ((temp_types Delta) ! i); auto.
+    destruct t1; auto.
+    destruct ((eqb_typelist t t1 && eqb_type t0 t2 && eqb_calling_convention c c0)); auto.
+  + destruct ((temp_types Delta) !! i); auto.
     destruct (is_neutral_cast t0 t || same_base_type t0 t); auto.    
-  + destruct t; auto; simpl in *.         
+  + destruct t; auto; simpl in *.
   - destruct i; destruct s; auto.
-  - destruct f; auto.                      
+  - destruct f; auto.
   - repeat rewrite denote_tc_assert_andp.
     repeat rewrite denote_tc_assert_andp in H. destruct H as [[? ?] ?].
     split.
     * split; auto.
       destruct (is_pointer_type (typeof a)); auto.
     * 
-Abort.
+Abort.*)
 
 Lemma bool_val_cenv_sub {CS CS'} (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS'))
   rho b v (Hb : bool_val (typeof b) (@eval_expr CS b rho) = Some v):
@@ -1143,38 +864,39 @@ Proof.
   rewrite ?(eval_expr_cenv_sub_Vptr CSUB _ _ _ _ Heqr); trivial.
 Qed.
 
-Lemma sem_binary_operation_cenv_sub {ge ge'} (CSUB:cenv_sub ge ge') op v1 t1 v2 t2 m v:
+(*Lemma sem_binary_operation_cenv_sub {ge ge'} (CSUB:cenv_sub ge ge') op v1 t1 v2 t2 m v:
   sem_binary_operation ge op v1 t1 v2 t2 m = Some v ->
   sem_binary_operation ge' op v1 t1 v2 t2 m = Some v.
 Proof.
-Abort.
+Abort.*)
 
 Lemma typecheck_expr_sound_cenv_sub {CS CS'} (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS'))
-      Delta rho (D:typecheck_environ Delta rho) m: forall e, 
-    (@denote_tc_assert CS (@typecheck_expr CS Delta e) rho) m ->
-    @eval_expr CS e rho = @eval_expr CS' e rho.
+      Delta rho (D:typecheck_environ Delta rho): forall e, 
+    denote_tc_assert(CS := CS) (typecheck_expr(CS := CS) Delta e) rho ⊢
+    ⌜@eval_expr CS e rho = @eval_expr CS' e rho⌝.
 Proof.
 intros.
-assert (H0 := typecheck_expr_sound _ _ _ _ D H).
+rewrite typecheck_expr_sound; last done.
+iIntros (H0); iPureIntro.
 assert (@eval_expr CS e rho <> Vundef). {
-  intro. rewrite H1 in H0. apply tc_val_Vundef in H0. auto.
+  intros H1. rewrite H1 in H0. apply tc_val_Vundef in H0. auto.
 }
 apply eval_expr_cenv_sub_eq; auto.
 Qed.
 
 Lemma typecheck_exprlist_sound_cenv_sub {CS CS'} (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS'))
-      Delta rho (D:typecheck_environ Delta rho) m: forall types e, 
-    (@denote_tc_assert CS (@typecheck_exprlist CS Delta types e) rho) m ->
-    @eval_exprlist CS types e rho = @eval_exprlist CS' types e rho.
+      Delta rho (D:typecheck_environ Delta rho): forall types e, 
+    denote_tc_assert(CS := CS) (typecheck_exprlist(CS := CS) Delta types e) rho ⊢
+    ⌜@eval_exprlist CS types e rho = @eval_exprlist CS' types e rho⌝.
 Proof.
 induction types; destruct e; intros; auto.
-simpl.
-unfold_lift.
-simpl in H. rewrite !denote_tc_assert_andp in H.
-destruct H as [[? ?] ?].
-erewrite <- (typecheck_expr_sound_cenv_sub CSUB _ _ D); eauto.
-f_equal; auto.
+unfold typecheck_exprlist; fold typecheck_exprlist.
+rewrite denote_tc_assert_andp.
+rewrite (typecheck_expr_sound_cenv_sub CSUB); last done.
+rewrite IHtypes /=; unfold_lift.
+by unfold force_val1; iIntros "[-> ->]".
 Qed.
 
+End CENV_SUB.
 
-End CENV_SUB.
\ No newline at end of file
+End mpred.
diff --git a/veric/expr_lemmas2.v b/veric/expr_lemmas2.v
index f66c9b6368..1d22a8693e 100644
--- a/veric/expr_lemmas2.v
+++ b/veric/expr_lemmas2.v
@@ -1,7 +1,8 @@
-Require Import VST.msl.msl_standard.
 Require Import VST.veric.Clight_base.
-Require Import VST.veric.compcert_rmaps.
 Require Import VST.veric.Clight_lemmas.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Import VST.veric.res_predicates.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.mpred.
 Require Import VST.veric.tycontext.
 Require Import VST.veric.expr.
@@ -13,62 +14,59 @@ Require Import VST.veric.seplog. (*For definition of tycontext*)
 Import Cop.
 Import Cop2.
 Import Clight_Cop2.
-Import compcert.lib.Maps.
 Import Ctypes.
 
-Lemma eval_lvalue_ptr : forall {CS: compspecs} rho m e (Delta: tycontext) te ve ge,
+Section mpred.
+
+Context `{!heapGS Σ}.
+
+Lemma eval_lvalue_ptr : forall {CS: compspecs} rho e (Delta: tycontext) te ve ge,
 mkEnviron ge ve te = rho ->
 typecheck_var_environ ve (var_types Delta) ->
 typecheck_glob_environ ge (glob_types Delta) ->
-denote_tc_assert (typecheck_lvalue Delta e) rho m ->
-exists base, exists ofs, eval_lvalue e rho  = Vptr base ofs.
+denote_tc_assert (typecheck_lvalue Delta e) rho ⊢
+⌜exists base, exists ofs, eval_lvalue e rho = Vptr base ofs⌝.
 Proof.
 intros.
-induction e; eauto;
-try now inversion H2.
-*
-simpl. unfold eval_var.
-simpl in H2.
-unfold get_var_type in H2.
+induction e; eauto; simpl.
+(*try now inversion H2.*)
+* unfold typecheck_lvalue.
+rewrite /get_var_type.
 subst rho; simpl ve_of; simpl ge_of.
-destruct_var_types i eqn:H4&?H; rewrite H4 in H2;
- [| destruct_glob_types i eqn:?H&?H; rewrite H6 in H2 ].
-+ apply tc_bool_e in H2.
+destruct_var_types i eqn:H4&?H; rewrite H4;
+ [| destruct_glob_types i eqn:H6&?H; rewrite H6 ].
++ rewrite tc_bool_e; iPureIntro.
   exists b, Ptrofs.zero.
-  rewrite H3, H2.
-  auto.
-+ apply tc_bool_e in H2.
+  simpl. by rewrite /eval_var H2 H.
++ rewrite tc_bool_e; iPureIntro.
   exists b, Ptrofs.zero.
-  rewrite H3, H5.
-  auto.
-+ inv H2.
+  simpl. by rewrite /eval_var H3 H2.
++ iIntros "[]".
 *
-simpl in H2.
-rewrite !denote_tc_assert_andp in H2.
-destruct H2 as [[? ?] ?].
-simpl in H4.
-simpl.
+unfold typecheck_lvalue; fold typecheck_expr.
+rewrite !denote_tc_assert_andp /=; unfold_lift.
+iIntros "[_ %H4]".
 destruct (eval_expr e rho); simpl; try now inversion H4; eauto.
 *
+unfold typecheck_lvalue; fold typecheck_lvalue.
+rewrite denote_tc_assert_andp.
 simpl in *. super_unfold_lift.
-rewrite denote_tc_assert_andp in H2.
-destruct H2.
-spec IHe; auto. destruct IHe.
+rewrite IHe; iIntros "[%IH H]".
 unfold eval_field.
-destruct H4 as [ofs ?].
+destruct IH as (base & ofs & IH).
 destruct (eval_lvalue e rho); try congruence.
-inversion H4; subst x i0; clear H4.
-destruct (typeof e); try now inversion H3.
+inv IH.
+destruct (typeof e); try iDestruct "H" as "[]".
 +
-destruct (cenv_cs ! i0) as [co |]; [| inv H3].
-destruct (field_offset cenv_cs i (co_members co)); [| inv H3].
-destruct p. destruct b0; [ | inv H3].
+destruct (cenv_cs !! i0) as [co |]; [| iDestruct "H" as "[]"].
+destruct (field_offset cenv_cs i (co_members co)); [| iDestruct "H" as "[]"].
+destruct p. destruct b; [ | iDestruct "H" as "[]"].
 unfold offset_val; eauto.
 +
-destruct (cenv_cs ! i0) as [co |]; [| inv H3].
-destruct (union_field_offset cenv_cs i (co_members co)); [| inv H3].
-destruct p. destruct z; [ | inv H3 .. ].
-destruct b0; [ | inv H3].
+destruct (cenv_cs !! i0) as [co |]; [| iDestruct "H" as "[]"].
+destruct (union_field_offset cenv_cs i (co_members co)); [| iDestruct "H" as "[]"].
+destruct p. destruct z; [ | iDestruct "H" as "[]" .. ].
+destruct b; [ | iDestruct "H" as "[]"].
 simpl.
 eauto.
 Qed.
@@ -84,35 +82,36 @@ unfold denote_tc_nodivover in *;
 unfold denote_tc_initialized in *.
 
 Lemma typecheck_lvalue_Evar:
-  forall {CS: compspecs} i t pt Delta rho m, typecheck_environ Delta rho ->
-           denote_tc_assert (typecheck_lvalue Delta (Evar i t)) rho m ->
-           is_pointer_type pt = true ->
-           tc_val pt (eval_lvalue (Evar i t) rho).
+  forall {CS: compspecs} i t pt Delta rho, typecheck_environ Delta rho -> is_pointer_type pt = true ->
+           denote_tc_assert (typecheck_lvalue Delta (Evar i t)) rho ⊢
+           ⌜tc_val pt (eval_lvalue (Evar i t) rho)⌝.
 Proof.
 intros.
-simpl in *. unfold eval_var.
+unfold typecheck_lvalue.
+simpl. unfold eval_var.
 
 unfold typecheck_environ in H.
 intuition.
 destruct rho.
 unfold get_var_type in *.
 
-destruct_var_types i; rewrite ?Heqo, ?Heqo0 in *; try rewrite eqb_type_eq in *; simpl in *; intuition.
-remember (type_eq t t0). destruct s; try tauto.
+destruct_var_types i; rewrite -> ?Heqo, ?Heqo0 in *; try rewrite -> eqb_type_eq in *; simpl in *; intuition.
+rewrite tc_bool_e; iPureIntro; intros.
+remember (type_eq t t0). destruct s; try discriminate.
 {
 simpl in *.
- unfold is_pointer_type in H1.
- destruct pt; try solve [inv H1; auto].
+ unfold is_pointer_type in *.
+ destruct pt; try solve [inv H0; simpl in *; auto].
  unfold tc_val.
  simple_if_tac; apply I.
 }
-{destruct_glob_types i; rewrite ?Heqo1, ?Heqo2 in *; [| inv H0].
+{ destruct_glob_types i; rewrite -> ?Heqo1, ?Heqo2 in *; [| iIntros "[]"].
 remember (eqb_type t t0).
-symmetry in Heqb0. destruct b0; simpl in *; [| inv H0]. apply eqb_type_true in Heqb0.
+symmetry in Heqb0. destruct b0; simpl in *; [| iIntros "[]"]. apply eqb_type_true in Heqb0.
 subst.
-
-unfold tc_val; unfold is_pointer_type in H1;
- destruct pt; try solve [inv H1; reflexivity].
+iPureIntro; intros.
+unfold tc_val; unfold is_pointer_type in H0;
+ destruct pt; try solve [inv H0; reflexivity].
  simple_if_tac; apply I.
 }
 Qed.
@@ -128,111 +127,120 @@ Proof.
 Qed.
 
 Lemma typecheck_expr_sound_Efield:
-  forall {CS: compspecs} Delta rho e i t m
+  forall {CS: compspecs} Delta rho e i t
   (H: typecheck_environ Delta rho)
-  (IHe: (denote_tc_assert (typecheck_expr Delta e) rho m ->
-          tc_val (typeof e) (eval_expr e rho)) /\
-          (forall pt : type,
-          denote_tc_assert (typecheck_lvalue Delta e) rho m ->
-          is_pointer_type pt = true ->
-          tc_val pt (eval_lvalue e rho)))
-  (H0: denote_tc_assert (typecheck_expr Delta (Efield e i t)) rho m),
-  tc_val (typeof (Efield e i t)) (eval_expr (Efield e i t) rho).
+  (IHe: (denote_tc_assert (typecheck_expr Delta e) rho ⊢
+          ⌜tc_val (typeof e) (eval_expr e rho)⌝) /\
+          (forall pt : type, is_pointer_type pt = true ->
+          denote_tc_assert (typecheck_lvalue Delta e) rho ⊢
+          ⌜tc_val pt (eval_lvalue e rho)⌝)),
+  denote_tc_assert (typecheck_expr Delta (Efield e i t)) rho ⊢
+  ⌜tc_val (typeof (Efield e i t)) (eval_expr (Efield e i t) rho)⌝.
 Proof.
 intros.
-simpl in *. super_unfold_lift.
+simpl in *. unfold typecheck_expr; fold typecheck_lvalue. super_unfold_lift.
  unfold eval_field, offset_val, deref_noload in *.
-assert (MODE: access_mode t = By_reference) by (destruct (access_mode t); auto; hnf in H0; try contradiction).
-rewrite MODE in *.
-destruct IHe.
+iIntros "H".
+iAssert (⌜access_mode t = By_reference⌝)%I with "[H]" as %MODE. by (destruct (access_mode t); auto; hnf in H0; try contradiction).
+rewrite MODE.
+destruct IHe as [IHe IHl].
 destruct rho.
-rewrite denote_tc_assert_andp in H0. destruct H0.
+rewrite denote_tc_assert_andp.
 unfold typecheck_environ in H.
 destruct H as [_ [Hve Hge]].
-assert (PTR := eval_lvalue_ptr _ _ e Delta te ve ge (eq_refl _) Hve Hge H0).
-specialize (H2 t H0).
-spec H2. clear - MODE; destruct t; try destruct i; try destruct s; try destruct f; inv MODE; simpl; auto.
-destruct PTR.
-destruct (typeof e); try now inv H3.
-+ destruct (cenv_cs ! i0) as [co |]; try now inv H3.
-  destruct (field_offset cenv_cs i (co_members co)) as [ [ ? [|]] |  ]; try now inv H3.
+iDestruct (eval_lvalue_ptr with "[H]") as %PTR; [try done..|].
+{ by rewrite bi.and_elim_l. }
+rewrite (IHl t).
+2: { clear - MODE; destruct t; try destruct i; try destruct s; try destruct f; inv MODE; simpl; auto. }
+iDestruct "H" as (He) "H".
+destruct PTR as (? & ? & H); simpl in H.
+destruct (typeof e); try iDestruct "H" as "[]".
++ destruct (cenv_cs !! i0) as [co |]; try iDestruct "H" as "[]".
+  destruct (field_offset cenv_cs i (co_members co)) as [ [ ? [|]] |  ]; try iDestruct "H" as "[]".
   destruct (eval_lvalue e (mkEnviron ge ve te)); try now inv H.
-  destruct t; auto; try inversion H2.
-  destruct f; inv H2.
-  red. simple_if_tac; apply I.
-+ destruct (cenv_cs ! i0) as [co |]; try now inv H3.
-  destruct (union_field_offset cenv_cs i (co_members co)) as [ [ ? [|]] |  ]; try contradiction;
-  destruct z; try contradiction.
+  destruct t; auto; inv H.
+  destruct f; inv He.
++ destruct (cenv_cs !! i0) as [co |]; try iDestruct "H" as "[]".
+  destruct (union_field_offset cenv_cs i (co_members co)) as [ [ ? [|]] |  ]; try iDestruct "H" as "[]";
+  destruct z; try iDestruct "H" as "[]".
   destruct (eval_lvalue e (mkEnviron ge ve te)); try now inv H.
   rewrite ptrofs_add_repr_0; auto.
 Qed.
 
 Lemma typecheck_lvalue_sound_Efield:
- forall {CS: compspecs} Delta rho m e i t pt
+ forall {CS: compspecs} Delta rho e i t pt
  (H: typecheck_environ Delta rho)
- (IHe: (denote_tc_assert (typecheck_expr Delta e) rho m ->
-          tc_val (typeof e) (eval_expr e rho)) /\
-        (forall pt0 : type, denote_tc_assert (typecheck_lvalue Delta e) rho m ->
-           is_pointer_type pt0 = true ->
-         tc_val pt0 (eval_lvalue e rho)))
-  (H0: denote_tc_assert (typecheck_lvalue Delta (Efield e i t)) rho m)
+ (IHe: (denote_tc_assert (typecheck_expr Delta e) rho ⊢
+          ⌜tc_val (typeof e) (eval_expr e rho)⌝) /\
+        (forall pt0 : type, is_pointer_type pt0 = true ->
+         denote_tc_assert (typecheck_lvalue Delta e) rho ⊢
+           ⌜tc_val pt0 (eval_lvalue e rho)⌝))
   (H1: is_pointer_type pt = true),
-  tc_val pt (eval_lvalue (Efield e i t) rho).
+  denote_tc_assert (typecheck_lvalue Delta (Efield e i t)) rho ⊢
+  ⌜tc_val pt (eval_lvalue (Efield e i t) rho)⌝.
 Proof.
 intros.
 simpl in *.
-rewrite denote_tc_assert_andp in H0. destruct H0.
+unfold typecheck_lvalue; fold typecheck_lvalue.
+rewrite denote_tc_assert_andp.
 super_unfold_lift.
+destruct IHe as [IHe IHl].
  unfold eval_field,offset_val in *; intuition.
-specialize  (H4 pt).
 destruct rho.
 unfold typecheck_environ in *. intuition.
-assert (PTR := eval_lvalue_ptr _ m e _ te _ _ (eq_refl _) H H7 H0).
-simpl in *.
+iIntros "H".
+iDestruct (eval_lvalue_ptr with "[H]") as %PTR; [try done..|].
+{ by rewrite bi.and_elim_l. }
+rewrite (IHl pt); last done.
+iDestruct "H" as (Hpt) "H".
 remember (eval_lvalue e (mkEnviron ge ve te)). unfold isptr in *.
 subst v.
 destruct PTR as [b [ofs ?]].
-destruct (typeof e); try now inv H2.
-+ destruct (cenv_cs ! i0) as [co |]; try now inv H2.
-  destruct (field_offset cenv_cs i (co_members co)) as [ [ ? [|]] |  ]; try now inv H2.
-  destruct (eval_lvalue e (mkEnviron ge ve te)); try now inv H6.
-  destruct pt; inv H1; auto.
+destruct (typeof e); try iDestruct "H" as "[]".
++ destruct (cenv_cs !! i0) as [co |]; try iDestruct "H" as "[]".
+  destruct (field_offset cenv_cs i (co_members co)) as [ [ ? [|]] |  ]; try iDestruct "H" as "[]".
+  iPureIntro; intros.
+  rewrite H2.
+  destruct pt; inv H1; simpl; auto.
   red; simple_if_tac; apply I.
-+ destruct (cenv_cs ! i0) as [co |]; try now inv H2.
-  destruct (union_field_offset cenv_cs i (co_members co)) as [ [ ? [|]] |  ]; try now inv H2.
-  2: destruct z; contradiction.
-  destruct z; try contradiction.
-  destruct (eval_lvalue e (mkEnviron ge ve te)); try now inv H6.
++ destruct (cenv_cs !! i0) as [co |]; try iDestruct "H" as "[]".
+  destruct (union_field_offset cenv_cs i (co_members co)) as [ [ ? [|]] |  ]; try iDestruct "H" as "[]".
+  2: destruct z; iDestruct "H" as "[]".
+  destruct z; try iDestruct "H" as "[]".
+  iPureIntro; intros.
+  rewrite H2 in Hpt |- *.
   rewrite ptrofs_add_repr_0; auto.
 Qed.
 
 Lemma typecheck_expr_sound_Evar:
-  forall {CS: compspecs} Delta rho m i t,
+  forall {CS: compspecs} Delta rho i t,
   typecheck_environ Delta rho ->
-  denote_tc_assert (typecheck_expr Delta (Evar i t)) rho m ->
-  tc_val (typeof (Evar i t)) (eval_expr (Evar i t) rho).
+  denote_tc_assert (typecheck_expr Delta (Evar i t)) rho ⊢
+  ⌜tc_val (typeof (Evar i t)) (eval_expr (Evar i t) rho)⌝.
 Proof.
 intros.
-assert (MODE: access_mode t = By_reference)
- by (unfold typecheck_expr in H0; destruct (access_mode t); try (hnf in H0; contradiction); auto).
-simpl. super_unfold_lift. unfold deref_noload.
+unfold typecheck_expr.
+iIntros "H".
+iAssert (⌜access_mode t = By_reference⌝)%I with "[H]" as %MODE. by (destruct (access_mode t); auto; try contradiction).
+rewrite MODE.
+simpl.
 
 unfold typecheck_environ in H. intuition.
 destruct rho.
-simpl in H0. rewrite MODE in H0.
 unfold get_var_type in *.
 
 unfold eval_var.
-destruct_var_types i; rewrite ?Heqo, ?Heqo0 in *;
-try rewrite eqb_type_eq in *; simpl in *; intuition.
-- remember (type_eq t t0). destruct s; try tauto.
+destruct_var_types i; rewrite -> ?Heqo, ?Heqo0 in *;
+try rewrite -> eqb_type_eq in *; simpl in *; intuition.
+- rewrite tc_bool_e; iDestruct "H" as %?; iPureIntro.
+remember (type_eq t t0). destruct s; try discriminate.
  subst.
  simpl.
-simpl. destruct t0; try destruct i0; try destruct s; try destruct f; inv MODE; simpl; auto.
-- destruct_glob_types i; rewrite ?Heqo1, ?Heqo2 in *; [| inv H0].
-simpl in *.
+destruct t0; try destruct i0; try destruct s; try destruct f; inv MODE; simpl; auto.
+- destruct_glob_types i; rewrite -> ?Heqo1, ?Heqo2 in *; [| iDestruct "H" as "[]"].
+rewrite tc_bool_e; iDestruct "H" as %?; iPureIntro.
 remember (eqb_type t t0).
-symmetry in Heqb0. destruct b0; simpl in *; [| inv H0].
+symmetry in Heqb0. destruct b0; simpl in *; [| done].
 apply eqb_type_true in Heqb0.
 subst.
 unfold typecheck_glob_environ in *.
@@ -265,14 +273,6 @@ match op with
 end.
 
 
-Lemma tc_bool_e: forall {CS: compspecs} b a rho m, (* copied from binop_lemmas.v *)
-  app_pred (denote_tc_assert (tc_bool b a) rho) m ->
-  b = true.
-Proof.
-intros.
-destruct b; simpl in H; auto.
-Qed.
-
 Lemma tc_val_of_bool_int_type:
  forall b t, is_int_type t = true ->
   tc_val t (bool2val b).
@@ -284,50 +284,45 @@ rewrite <- Z.leb_le; reflexivity.
 Qed.
 
 Lemma typecheck_unop_sound:
- forall {CS: compspecs} Delta rho m u e t
+ forall {CS: compspecs} Delta rho u e t
  (H: typecheck_environ Delta rho)
- (IHe: (denote_tc_assert (typecheck_expr Delta e) rho m ->
-          tc_val (typeof e) (eval_expr e rho)) /\
+ (IHe: (denote_tc_assert (typecheck_expr Delta e) rho ⊢
+          ⌜tc_val (typeof e) (eval_expr e rho)⌝) /\
           (forall pt : type,
-           denote_tc_assert (typecheck_lvalue Delta e) rho m ->
            is_pointer_type pt = true ->
-           tc_val pt (eval_lvalue e rho)))
-  (H0: denote_tc_assert (typecheck_expr Delta (Eunop u e t)) rho m),
-  tc_val t (eval_expr (Eunop u e t) rho).
+           denote_tc_assert (typecheck_lvalue Delta e) rho ⊢
+           ⌜tc_val pt (eval_lvalue e rho)⌝)),
+  denote_tc_assert (typecheck_expr Delta (Eunop u e t)) rho ⊢
+  ⌜tc_val t (eval_expr (Eunop u e t) rho)⌝.
 Proof.
 intros.
-simpl in H0. rewrite denote_tc_assert_andp in H0. destruct H0.
-destruct IHe as [? _].
-specialize (H2 H1).
-simpl eval_expr.
+unfold typecheck_expr; fold typecheck_expr.
+rewrite denote_tc_assert_andp /=.
+destruct IHe as [IHe _].
+rewrite IHe. iIntros "[H %H2]".
 unfold_lift.
-clear - H2 H0. 
+clear IHe.
 unfold eval_unop, sem_unary_operation, force_val1.
-destruct u; unfold tc_val in H2; simpl in H0;
-unfold sem_notbool, sem_notint, sem_neg, sem_absfloat, bool_val in *;
-super_unfold_lift; simpl;
+Local Opaque eqb_type.
+destruct u; unfold tc_val in H2; simpl;
+unfold sem_notbool, sem_notint, sem_neg, sem_absfloat, bool_val;
 destruct (typeof e) as [ | [ | | | ] [ | ] | | [ | ] | | | | | ];
- try contradiction;
- repeat match goal with
- | H:  app_pred (denote_tc_assert (tc_andp _ _) _) _ |- _ =>
-        rewrite denote_tc_assert_andp in H; destruct H
- | H: app_pred (denote_tc_assert (tc_bool _ _) _) _ |- _ => 
-      apply tc_bool_e in H
- | H: app_pred (denote_tc_assert (tc_int_or_ptr_type _) _) _ |- _ => 
-      apply tc_bool_e in H
-| H: (if eqb_type ?T1 ?T2 then _ else _) _ |- _ =>
+ try done; rewrite ?denote_tc_assert_andp /= ?tc_bool_e; unfold_lift;
+(iDestruct "H" as "%" || (rewrite ?assoc; iDestruct "H" as "[% _]")); iPureIntro;
+    repeat match goal with
+    | H: _ /\ _ |- _ => destruct H
+    | H: (if eqb_type ?T1 ?T2 then _ else _) _ |- _ =>
    let J := fresh "J" in
    destruct (eqb_type T1 T2) eqn:J;
    [apply eqb_type_true in J | apply eqb_type_false in J]
 end;
- destruct (eval_expr e rho) eqn:?; try contradiction;
- try discriminate;
+ destruct (eval_expr e rho) eqn:?; try done;
  try solve [apply tc_val_of_bool_int_type; auto].
 all: try solve [
   destruct t as [ | [ | | | ] [ | ] | | [ | ] | | | | | ]; 
   match goal with H: _ _ = true |- _ => inv H end;
             try reflexivity; auto;
-             simpl tc_val; try split; auto;
+             unfold tc_val; try split; auto;
              rewrite <- Z.leb_le; reflexivity].
 Qed.
 
@@ -355,13 +350,13 @@ intros. destruct t1; destruct t2;
 Qed.
 
 Lemma typecheck_temp_sound:
-  forall {CS: compspecs} Delta rho m i t,
+  forall {CS: compspecs} Delta rho (i : ident) t,
   typecheck_environ Delta rho ->
-  denote_tc_assert (typecheck_expr Delta (Etempvar i t)) rho m ->
-  tc_val (typeof (Etempvar i t)) (eval_expr (Etempvar i t) rho).
+  denote_tc_assert (typecheck_expr Delta (Etempvar i t)) rho ⊢
+  ⌜tc_val (typeof (Etempvar i t)) (eval_expr (Etempvar i t) rho)⌝.
 Proof.
 intros.
-simpl in *. destruct rho.
+simpl. unfold typecheck_expr. destruct rho.
 destruct H as [H1 _].
 unfold typecheck_temp_environ in *.
 unfold eval_id, force_val in *.
@@ -370,19 +365,21 @@ simpl.
 destruct Delta; simpl in *.
 unfold temp_types in *. simpl in *.
 specialize (H1 i).
-destruct (tyc_temps ! i); try (contradiction H0).
-destruct (H1 _ (eq_refl _)) as [v ?]. clear H1.
-destruct H.
+destruct (tyc_temps !! i) eqn: Hty; try (iIntros "[]").
+destruct (H1 _ eq_refl) as (v & H & Ht0). clear H1.
 rewrite H.
-simpl in H0.
 destruct (is_neutral_cast t0 t) eqn:?.
-+ simpl in H0.
++ simpl.
+  unfold denote_tc_initialized.
+  iPureIntro; intros H0.
   rewrite H in H0.
   destruct H0 as [? [? ?]].
   inv H0.
   symmetry in Heqb; eapply neutral_cast_subsumption; eauto.
-+ destruct (same_base_type t0 t) eqn:?; [ | inv H0].
-  simpl in H0.
++ destruct (same_base_type t0 t) eqn:?; [ | iIntros "[]"].
+  simpl.
+  unfold denote_tc_initialized.
+  iPureIntro; intros H0.
   rewrite H in H0.
   destruct H0 as [? [? ?]].
   inv H0.
@@ -390,33 +387,29 @@ destruct (is_neutral_cast t0 t) eqn:?.
 Qed.
 
 Lemma typecheck_deref_sound:
-  forall {CS: compspecs} Delta rho m e t pt,
-   typecheck_environ Delta rho ->
-   (denote_tc_assert (typecheck_expr Delta e) rho m ->
-    tc_val (typeof e) (eval_expr e rho)) /\
+  forall {CS: compspecs} Delta rho e t pt,
+   typecheck_environ Delta rho -> is_pointer_type pt = true ->
+   (denote_tc_assert (typecheck_expr Delta e) rho ⊢
+    ⌜tc_val (typeof e) (eval_expr e rho)⌝) /\
     (forall pt0 : type,
-     denote_tc_assert (typecheck_lvalue Delta e) rho m ->
-     is_pointer_type pt0 = true -> tc_val pt0 (eval_lvalue e rho)) ->
-     denote_tc_assert (typecheck_lvalue Delta (Ederef e t)) rho m ->
-    is_pointer_type pt = true ->
-    tc_val pt (eval_lvalue (Ederef e t) rho).
+     denote_tc_assert (typecheck_lvalue Delta e) rho ⊢
+     ⌜is_pointer_type pt0 = true -> tc_val pt0 (eval_lvalue e rho)⌝) ->
+     denote_tc_assert (typecheck_lvalue Delta (Ederef e t)) rho ⊢
+    ⌜tc_val pt (eval_lvalue (Ederef e t) rho)⌝.
 Proof.
-intros until pt. intros H IHe H0 H1.
-simpl. unfold lift.
-simpl in H0.
-repeat rewrite denote_tc_assert_andp in H0.
-destruct H0 as [[? ?] ?].
-destruct IHe as[ ? _].
-specialize (H4 H0).
-revert H2; case_eq (is_pointer_type (typeof e)); intros; hnf in H2; try contradiction.
-clear H H5 H4.
-hnf in H3. unfold_lift in H3; hnf in H3.
-unfold_lift.
+intros until pt. intros H H0 IHe.
+unfold typecheck_lvalue; fold typecheck_expr.
+rewrite !denote_tc_assert_andp tc_bool_e.
+iIntros "[[H %H1] %]".
+destruct IHe as [-> _]; iPureIntro; intros.
+revert H1; case_eq (is_pointer_type (typeof e)); intros; hnf in H1; try discriminate.
+simpl.
 destruct (eval_expr e rho); try contradiction.
-destruct pt; try solve [inv H1; reflexivity].
+destruct pt; try solve [inv H0; reflexivity].
 unfold tc_val.
-unfold is_pointer_type in H1.
-destruct (eqb_type (Tpointer pt a) int_or_ptr_type); inv H1.
+unfold is_pointer_type in H0.
+destruct (eqb_type (Tpointer pt a) int_or_ptr_type); inv H0.
 apply I.
 Qed.
 
+End mpred.
diff --git a/veric/expr_lemmas3.v b/veric/expr_lemmas3.v
index 4e42ee48fe..9da0465b9f 100644
--- a/veric/expr_lemmas3.v
+++ b/veric/expr_lemmas3.v
@@ -1,8 +1,9 @@
 Require Import Coq.Reals.Rdefinitions.
-Require Import VST.msl.msl_standard.
 Require Import VST.veric.Clight_base.
-Require Import VST.veric.compcert_rmaps.
 Require Import VST.veric.Clight_lemmas.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Import VST.veric.res_predicates.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.mpred.
 Require Import VST.veric.tycontext.
 Require Import VST.veric.expr2.
@@ -15,17 +16,16 @@ Require Import VST.veric.seplog. (*For definition of typecheck_environ*)
 Import Cop.
 Import Cop2.
 Import Clight_Cop2.
-Import compcert.lib.Maps.
 Import Ctypes.
 Import Clight.
 
-Lemma type_eq_true : forall a b, proj_sumbool  (type_eq a b) =true  -> a = b.
+Lemma type_eq_true : forall a b, proj_sumbool (type_eq a b) = true -> a = b.
 Proof. intros. destruct (type_eq a b). auto. simpl in H. inv H.
 Qed.
 
 (** Definitions of some environments **)
 Definition empty_genv cenv := Build_genv (Globalenvs.Genv.empty_genv fundef type nil) cenv.
-Definition empty_tenv := PTree.empty val.
+Definition empty_tenv := Maps.PTree.empty val.
 
 Definition empty_environ cenv : environ :=
 mkEnviron (filter_genv (empty_genv cenv)) (Map.empty _) (Map.empty _).
@@ -44,6 +44,9 @@ Transparent Float.to_intu.
 Transparent Float32.to_int.
 Transparent Float32.to_intu.
 
+Section mpred.
+
+Context `{!heapGS Σ}.
 
 Lemma isCastR: forall {CS: compspecs} tfrom tto a,
   denote_tc_assert (isCastResultType tfrom tto a) =
@@ -114,7 +117,7 @@ induction (Z.to_nat e).
 simpl.
 apply RIneq.Rlt_0_1.
 rewrite inj_S.
-rewrite Z.pow_succ_r by lia.
+rewrite -> Z.pow_succ_r by lia.
 rewrite RIneq.mult_IZR.
 apply RIneq.Rmult_lt_0_compat; auto.
 simpl.
@@ -187,9 +190,9 @@ destruct f; inv H.
 { (* zero case *)
 rewrite IEEE754_extra.ZofB_range_correct. simpl.
 unfold Raux.Ztrunc.
-rewrite Raux.Rlt_bool_false by apply RIneq.Rle_refl.
+rewrite -> Raux.Rlt_bool_false by apply RIneq.Rle_refl.
 replace (Raux.Zfloor 0) with 0.
-rewrite H0,H1. reflexivity.
+rewrite H0 H1. reflexivity.
 unfold Raux.Zfloor.
 replace (Rdefinitions.up 0) with 1; [reflexivity |].
 apply R_Ifp.tech_up; simpl.
@@ -214,7 +217,7 @@ replace
    (Raux.Ztrunc
       (Binary.B2R prec emax (Binary.B754_finite prec emax b m e e0)))
   with (Zaux.cond_Zopp b (Z.pos m) * 2^e).
-rewrite H0,H1; clear H0 H1.
+rewrite H0 H1; clear H0 H1.
 rewrite (IEEE754_extra.is_finite_strict_finite prec emax).
 reflexivity.
 reflexivity.
@@ -280,7 +283,7 @@ f_equal.
 rewrite RIneq.plus_IZR.
 rewrite Raxioms.Rplus_comm.
 rewrite <- RIneq.Rplus_0_r at 1.
-rewrite Raxioms.Rplus_comm at 1.
+rewrite -> Raxioms.Rplus_comm at 1.
 apply RIneq.Rplus_lt_le_compat.
 apply RIneq.Rlt_0_1.
 apply RIneq.Req_le. auto.
@@ -303,7 +306,7 @@ lia.
 rename s into b.
 assert (z = Zaux.cond_Zopp b (Z.pos m / Z.pow 2 (- e))). {
   destruct e; inv H3.
-  lia. pose proof (Zgt_pos_0 p); lia. clear g.
+  clear g.
   rewrite Zpower_pos_nat. rewrite Zpower_nat_Z.
   rewrite positive_nat_Z; auto.
 }
@@ -313,7 +316,7 @@ replace
    (Raux.Ztrunc
       (Binary.B2R prec emax (Binary.B754_finite prec emax b m e e0)))
   with (Zaux.cond_Zopp b (Z.pos m / 2^(-e))).
-rewrite H0,H1; clear H0 H1.
+rewrite H0 H1; clear H0 H1.
 rewrite (IEEE754_extra.is_finite_strict_finite prec emax).
 reflexivity.
 reflexivity.
@@ -460,31 +463,31 @@ reflexivity.
 Qed.
 
 Lemma typecheck_cast_sound:
- forall {CS: compspecs} Delta rho m e t,
+ forall {CS: compspecs} Delta rho e t,
  typecheck_environ Delta rho ->
- (denote_tc_assert (typecheck_expr Delta e) rho m ->
-   tc_val (typeof e) (expr.eval_expr e rho))  ->
-denote_tc_assert (typecheck_expr Delta (Ecast e t)) rho m ->
-tc_val (typeof (Ecast e t)) (expr.eval_expr (Ecast e t) rho).
+ (denote_tc_assert (typecheck_expr Delta e) rho ⊢
+  ⌜tc_val (typeof e) (expr.eval_expr e rho)⌝)  ->
+denote_tc_assert (typecheck_expr Delta (Ecast e t)) rho ⊢
+⌜tc_val (typeof (Ecast e t)) (expr.eval_expr (Ecast e t) rho)⌝.
 Proof.
-intros until t; intros H H1 H0.
+intros until t; intros H IH.
+unfold typecheck_expr; fold typecheck_expr.
 simpl in *. unfold_lift.
-rewrite denote_tc_assert_andp in H0.
-destruct H0.
-specialize (H1 H0); clear H0.
-unfold  sem_cast, force_val1.
-rewrite isCastR in H2.
+rewrite denote_tc_assert_andp.
+rewrite IH; iIntros "[%H1 H]".
+unfold sem_cast, force_val1.
+rewrite isCastR.
 destruct (classify_cast (typeof e) t)
      as [ | | | | | | | | sz [ | ] | sz [ | ] | | | | | | [ | ] | [ | ] | | | | | | | |  ]
    eqn:H3;
-   try contradiction;
+   try iIntros "[]";
  destruct t as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ];
-    try discriminate H3; try contradiction;
+    try discriminate H3; try iIntros "[]";
  destruct (typeof e) as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ];
-    try discriminate H3; try contradiction;
+    try discriminate H3; try iIntros "[]";
   unfold classify_cast in H3;
-  try replace (if Archi.ptr64 then false else false) with false in H2 by (destruct Archi.ptr64; auto);
-  repeat (progress unfold_lift in H2; simpl in H2);  (* needed ? *)
+  try replace (if Archi.ptr64 then false else false) with false by (destruct Archi.ptr64; auto);
+(*  repeat (progress unfold_lift; simpl);  (* needed ? *) *)
   unfold tc_val, is_pointer_type in *;
   repeat match goal with |- context [eqb_type ?A ?B] =>
               let J := fresh "J" in 
@@ -497,28 +500,19 @@ destruct (classify_cast (typeof e) t)
              [apply eqb_type_true in J | apply eqb_type_false in J]
     end;
    try discriminate;
-   rewrite ?if_true in H3 by auto; rewrite ?if_false in H3 by (clear; congruence);
+   rewrite -> ?if_true in H3 by auto; rewrite -> ?if_false in H3 by (clear; congruence);
    try (destruct Archi.ptr64 eqn:?Hp; try discriminate; [idtac]);
-  repeat match goal with
-       | H: app_pred (denote_tc_assert (tc_andp _ _) _) _ |- _ => 
-          rewrite denote_tc_assert_andp in H; destruct H
-       | H: app_pred (denote_tc_assert (if ?A then _ else _) _) _ |- _ =>
-           first [change A with false in H | change A with true in H]; cbv iota in H
-       | H: app_pred (denote_tc_assert (tc_iszero _) _) _ |- _ =>
-                   rewrite denote_tc_assert_iszero in H
-       | H: app_pred (denote_tc_assert (tc_bool _ _) _) _ |- _ => apply tc_bool_e in H
-       | H: app_pred (denote_tc_assert _ _) _ |- _ =>
-             unfold denote_tc_assert, denote_tc_Zle, denote_tc_Zge in H;
-             unfold_lift in H
-       end;
+   rewrite /= ?denote_tc_assert_andp ?denote_tc_assert_iszero ?tc_bool_e /denote_tc_assert /denote_tc_Zle /denote_tc_Zge; unfold_lift;
    destruct (expr.eval_expr e rho); try solve [contradiction H1];
+   try ((destruct (Zoffloat f) eqn: Hf || destruct (Zofsingle f) eqn: Hf); try iDestruct "H" as "[[] []]");
+   try iDestruct "H" as %?; iPureIntro;
    try apply I;
-   try solve [contradiction];
+   try contradiction;
    unfold sem_cast_pointer, sem_cast_i2i, sem_cast_f2f, sem_cast_s2s,
    sem_cast_f2i, sem_cast_s2i, cast_float_int, is_pointer_or_null, force_val in *;
-   repeat rewrite Hp in *;
+   rewrite -> ?Hp in *;
    repeat match goal with
-        | H: app_pred (prop _) _ |- _ => apply is_true_e in H; 
+        | H: is_true _ |- _ => apply is_true_e in H; 
                                       try (apply int_eq_e in H; subst);
                                       try (apply int64_eq_e in H; subst)
        end;
@@ -531,17 +525,17 @@ destruct (classify_cast (typeof e) t)
       | |- context[Int.zero_ext ?n ?x] =>
       apply (zero_ext_range' n x); compute; try split; congruence
      end);
-   simpl; 
+   simpl;
     try match goal with |- (if ?A then _ else _) = _ \/ (if ?A then _ else _) = _ =>
       destruct A; solve [auto]
      end;
   repeat  match goal with
-    | H: app_pred match ?A with Some _ => _ | None => _ end _ |- _ =>
+    | H: match ?A with Some _ => _ | None => _ end |- _ =>
          destruct A eqn:?; [  | contradiction H]
-    | H: app_pred (prop _) _ |- _ => apply is_true_e in H;
-           rewrite ?Z.leb_le, ?Z.geb_le in H
+    | H: is_true _ |- _ => apply is_true_e in H;
+           rewrite ?Z.leb_le ?Z.geb_le in H
           end.
-all: try (simpl in H0,H2;
+all: try (simpl in *;
           first [ erewrite float_to_int_ok | erewrite float_to_intu_ok
           | erewrite single_to_int_ok | erewrite single_to_intu_ok];
           [ | eassumption | split; lia]).
@@ -553,5 +547,6 @@ all:   try match goal with
    end.
 all: try apply I.
 all: rewrite ?Hp; hnf; auto.
-all: inv J0; congruence.
 Qed.
+
+End mpred.
diff --git a/veric/expr_lemmas4.v b/veric/expr_lemmas4.v
index d17d201169..ced4aefd22 100644
--- a/veric/expr_lemmas4.v
+++ b/veric/expr_lemmas4.v
@@ -1,7 +1,8 @@
 Require Import VST.veric.Clight_base.
-Require Import VST.msl.msl_standard.
-Require Import VST.veric.compcert_rmaps.
 Require Import VST.veric.Clight_lemmas.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Import VST.veric.res_predicates.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.mpred.
 Require Import VST.veric.tycontext.
 Require Import VST.veric.expr2.
@@ -20,103 +21,82 @@ Require Import VST.veric.seplog. (*For definition of typecheck_environ*)
 Import Cop.
 Import Cop2.
 Import Clight_Cop2.
-Import compcert.lib.Maps.
 Import Ctypes.
 
+Section mpred.
+
+Context `{!heapGS Σ}.
+
 (** Main soundness result for the typechecker **)
 
 Lemma typecheck_both_sound:
-  forall {CS: compspecs} Delta rho m e ,
+  forall {CS: compspecs} Delta rho e ,
              typecheck_environ Delta rho ->
-             (denote_tc_assert (typecheck_expr Delta e) rho m ->
-             tc_val (typeof e) (eval_expr e rho)) /\
-             (forall pt,
-             denote_tc_assert (typecheck_lvalue Delta e) rho m ->
-             is_pointer_type pt = true ->
-             tc_val pt (eval_lvalue e rho)).
+             (denote_tc_assert (typecheck_expr Delta e) rho ⊢
+              ⌜tc_val (typeof e) (eval_expr e rho)⌝) /\
+             (forall pt, is_pointer_type pt = true ->
+             denote_tc_assert (typecheck_lvalue Delta e) rho ⊢
+             ⌜tc_val pt (eval_lvalue e rho)⌝).
 Proof.
 intros. induction e; split; intros; try solve[subst; auto]; try contradiction.
 
 * (*Const int*)
-simpl in *. destruct t; try contradiction.
-destruct i0; try contradiction. auto.
+simpl in *. destruct t; try iIntros "[]".
+destruct i0; try iIntros "[]". auto.
 
 * (*Const float*)
-destruct f; simpl in *; subst; destruct t; try destruct f; tauto.
+destruct f; simpl in *; subst; destruct t; try destruct f; auto.
 * (* Const single *)
-destruct f; simpl in *; subst; destruct t; try destruct f; tauto.
+destruct f; simpl in *; subst; destruct t; try destruct f; auto.
 
 * (* Const long *)
-simpl in *. destruct t; try contradiction. hnf. auto.
+simpl in *. destruct t; try iIntros "[]".  auto.
 * (*Var*)
 eapply typecheck_expr_sound_Evar; eauto.
 
-*eapply typecheck_lvalue_Evar; eauto.
+*
+eapply typecheck_lvalue_Evar; eauto.
 
 * (*Temp*)
 eapply typecheck_temp_sound; eauto.
 
 * (*deref*)
 
-simpl in H0 |- *.
-unfold deref_noload.
-destruct (access_mode t) eqn:?H; try inversion H0.
-unfold Datatypes.id.
+unfold typecheck_expr; fold typecheck_expr.
+destruct (access_mode t) eqn:?H; try iIntros "[]".
+rewrite !denote_tc_assert_andp /=.
 unfold_lift.
-simpl.
-rewrite !denote_tc_assert_andp in H0.
-simpl in H0.
-destruct H0.
-unfold_lift in H2.
+rewrite (proj1 IHe) tc_bool_e; iIntros "[[%He %H1] %H2]".
 destruct (eval_expr e rho); inversion H2.
-simpl.
-destruct t; try reflexivity; try inversion H1.
+destruct t; try auto; try inversion H0.
 - destruct i0, s; inversion H4.
 - destruct f; inversion H4.
 
 *
 
-simpl in H0 |- *.
+unfold typecheck_lvalue; fold typecheck_expr.
 unfold tc_val.
-rewrite !denote_tc_assert_andp in H0.
-simpl in H0.
-destruct H0 as [[? ?] ?].
-unfold tc_bool in H2; simpl in H2.
-destruct (is_pointer_type (typeof e)) eqn:?H; [|inversion H2].
+rewrite !denote_tc_assert_andp /=.
 unfold_lift.
-unfold_lift in H3.
-destruct (eval_expr e rho); inversion H3.
-simpl.
-unfold is_pointer_type in H1.
-destruct pt; try reflexivity; try solve [inversion H1].
-destruct (eqb_type (Tpointer pt a) int_or_ptr_type); inv H1.
-apply I.
+rewrite (proj1 IHe) tc_bool_e; iIntros "[[%He %H1] %H2]"; iPureIntro.
+destruct (eval_expr e rho); try contradiction.
+destruct pt; auto; try solve [inversion H0].
+destruct (eqb_type (Tpointer pt a) int_or_ptr_type); inv H0; auto.
 
 * (*addrof*)
-intuition.
-simpl in *.
-rewrite denote_tc_assert_andp in H0.
-destruct H0.
+unfold typecheck_expr; fold typecheck_lvalue.
+rewrite denote_tc_assert_andp.
+rewrite tc_bool_e; iIntros "[H %]".
+rewrite (proj2 IHe); last done.
 destruct t; auto.
-unfold tc_val, is_pointer_type in H3|-*.
-destruct (eqb_type (Tpointer t a) int_or_ptr_type) eqn:J.
-apply eqb_type_true in J. rewrite J in H3.
-contradiction H3.
-specialize (H2 (Tpointer t a) H0).
-unfold tc_val in H2.
-rewrite J in H2.
-unfold is_pointer_type in H2. rewrite J in H2.
-apply H2; auto.
 
 * (*Unop*)
 eapply typecheck_unop_sound; eauto.
 * (*binop*)
-repeat rewrite andb_true_iff in *; intuition.
-clear H4. clear H2. clear H.
-simpl in H0.
-repeat rewrite denote_tc_assert_andp in H0.
-destruct H0 as [[H0 E1] E2].
-apply (typecheck_binop_sound b rho m e1 e2 t H0 (H3 E2) (H1 E1)).
+unfold typecheck_expr; fold typecheck_expr.
+rewrite !denote_tc_assert_andp /=.
+rewrite (proj1 IHe1) (proj1 IHe2); iIntros "[[H %] %]".
+by iApply typecheck_binop_sound.
 
 * (* cast *)
 destruct IHe.
@@ -127,42 +107,34 @@ eapply typecheck_expr_sound_Efield; eauto.
 *
 eapply typecheck_lvalue_sound_Efield; eauto.
 * (* Esizeof *)
-simpl in H0.
-repeat rewrite denote_tc_assert_andp in H0.
-destruct H0.
-apply tc_bool_e in H0.
-apply tc_bool_e in H1.
-rewrite eqb_type_spec in H1.
-subst.
-simpl. rewrite H0; reflexivity.
+unfold typecheck_expr.
+rewrite !denote_tc_assert_andp !tc_bool_e.
+iIntros "[%H0 %H1]".
+rewrite eqb_type_spec in H1; subst; simpl.
+rewrite H0; auto.
 * (* Ealignof *)
-simpl in H0.
-repeat rewrite denote_tc_assert_andp in H0.
-destruct H0.
-apply tc_bool_e in H0.
-apply tc_bool_e in H1.
-rewrite eqb_type_spec in H1.
-subst.
-simpl. rewrite H0; reflexivity.
+unfold typecheck_expr.
+rewrite !denote_tc_assert_andp !tc_bool_e.
+iIntros "[%H0 %H1]".
+rewrite eqb_type_spec in H1; subst; simpl.
+rewrite H0; auto.
 Qed.
 
-Lemma typecheck_expr_sound : forall {CS: compspecs} Delta rho m e,
+Lemma typecheck_expr_sound : forall {CS: compspecs} Delta rho e,
  typecheck_environ Delta rho ->
-              denote_tc_assert (typecheck_expr Delta e) rho m ->
-              tc_val (typeof e) (eval_expr e rho).
+              denote_tc_assert (typecheck_expr Delta e) rho ⊢
+              ⌜tc_val (typeof e) (eval_expr e rho)⌝.
 Proof. intros.
-assert (TC := typecheck_both_sound Delta rho m e). tauto. Qed.
-
+assert (TC := typecheck_both_sound Delta rho e). tauto. Qed.
 
-Lemma typecheck_lvalue_sound : forall {CS: compspecs} Delta rho m e,
+Lemma typecheck_lvalue_sound : forall {CS: compspecs} Delta rho e,
   typecheck_environ Delta rho ->
-  denote_tc_assert (typecheck_lvalue Delta e) rho m ->
-  is_pointer_or_null (eval_lvalue e rho).
+  denote_tc_assert (typecheck_lvalue Delta e) rho ⊢
+  ⌜is_pointer_or_null (eval_lvalue e rho)⌝.
 Proof.
 intros.
- edestruct (typecheck_both_sound _ _ m e H).
-specialize (H2 (Tpointer Tvoid noattr) H0 (eq_refl _)).
-apply H2.
+destruct (typecheck_both_sound _ _ e H).
+apply (H1 (Tpointer Tvoid noattr) (eq_refl _)).
 Qed.
 
 Ltac unfold_cop2_sem_cmp :=
@@ -173,30 +145,31 @@ Lemma eval_binop_relate:
         (Hcenv: cenv_sub (@cenv_cs CS) (genv_cenv ge)),
     rho = construct_rho (filter_genv ge) ve te ->
     typecheck_environ Delta rho ->
-    ((denote_tc_assert (typecheck_expr Delta e1) rho) (m_phi m) ->
-      Clight.eval_expr ge ve te (m_dry m) e1 (eval_expr e1 rho)) ->
-    ((denote_tc_assert (typecheck_expr Delta e2) rho) (m_phi m) ->
-       Clight.eval_expr ge ve te (m_dry m) e2 (eval_expr e2 rho)) ->
-    (denote_tc_assert (typecheck_expr Delta (Ebinop b e1 e2 t)) rho) (m_phi m) ->
-    Clight.eval_expr ge ve te (m_dry m) (Ebinop b e1 e2 t)
-                     (eval_expr (Ebinop b e1 e2 t) rho).
+    (mem_auth m ∗ denote_tc_assert (typecheck_expr Delta e1) rho ⊢
+      ⌜Clight.eval_expr ge ve te m e1 (eval_expr e1 rho)⌝) ->
+    (mem_auth m ∗ denote_tc_assert (typecheck_expr Delta e2) rho ⊢
+      ⌜Clight.eval_expr ge ve te m e2 (eval_expr e2 rho)⌝) ->
+    (mem_auth m ∗ denote_tc_assert (typecheck_expr Delta (Ebinop b e1 e2 t)) rho) ⊢
+    ⌜Clight.eval_expr ge ve te m (Ebinop b e1 e2 t)
+                     (eval_expr (Ebinop b e1 e2 t) rho)⌝.
 Proof.
-intros until 1. intros H H0 H1 H2 H3.
+intros.
+unfold typecheck_expr; fold typecheck_expr.
 simpl in *. super_unfold_lift.
-rewrite !denote_tc_assert_andp in H3.
-destruct H3 as [[H3 TC1] TC2].
-specialize (H1 TC1).
-specialize (H2 TC2).
-apply typecheck_expr_sound in TC1; [| auto].
-apply typecheck_expr_sound in TC2; [| auto].
-clear H0 H.
-clear Delta.
-apply eval_binop_relate'; assumption. 
+rewrite !denote_tc_assert_andp.
+iIntros "[Hm H]".
+iDestruct (H1 with "[$Hm H]") as %?.
+{ iDestruct "H" as "((_ & $) & _)". }
+iDestruct (H2 with "[$Hm H]") as %?.
+{ iDestruct "H" as "(_ & $)". }
+rewrite !typecheck_expr_sound; try assumption.
+iDestruct "H" as "[[H %] %]".
+by iApply (eval_binop_relate' with "[$]").
 Qed.
 
 Lemma valid_pointer_dry0:
-  forall b ofs m, app_pred (valid_pointer (Vptr b ofs)) (m_phi m) ->
-           Mem.valid_pointer (m_dry m) b (Ptrofs.unsigned ofs) = true.
+  forall m b ofs, mem_auth m ∗ valid_pointer (Vptr b ofs) ⊢
+           ⌜Mem.valid_pointer m b (Ptrofs.unsigned ofs) = true⌝.
 Proof.
 intros.
 rewrite <- (Z.add_0_r (Ptrofs.unsigned ofs)).
@@ -218,19 +191,19 @@ Proof.
 Qed.
 
 Lemma typecheck_binop_sound2:
- forall {CS: compspecs} (Delta : tycontext) (rho : environ) m (b : binary_operation)
+ forall {CS: compspecs} (Delta : tycontext) (rho : environ) (b : binary_operation)
      (e1 e2 : expr) (t : type),
-   denote_tc_assert (typecheck_expr Delta e2) rho m ->
-   denote_tc_assert (isBinOpResultType b e1 e2 t) rho m ->
-   denote_tc_assert (typecheck_expr Delta e1) rho m ->
    tc_val (typeof e2) (eval_expr e2 rho) ->
    tc_val (typeof e1) (eval_expr e1 rho) ->
-   tc_val t
-     (eval_binop b (typeof e1) (typeof e2) (eval_expr e1 rho) (eval_expr e2 rho)).
+   denote_tc_assert (typecheck_expr Delta e2) rho ∧
+   denote_tc_assert (isBinOpResultType b e1 e2 t) rho ∧
+   denote_tc_assert (typecheck_expr Delta e1) rho ⊢
+   ⌜tc_val t
+     (eval_binop b (typeof e1) (typeof e2) (eval_expr e1 rho) (eval_expr e2 rho))⌝.
 Proof.
 intros.
-pose proof (typecheck_binop_sound).
-simpl in H4. unfold_lift in H4. eapply H4; eauto.
+rewrite typecheck_binop_sound; try done.
+iIntros "(_ & $ & _)".
 Qed.
 
 Lemma eval_binop_relate_fail :
@@ -239,25 +212,24 @@ forall {CS: compspecs} (Delta : tycontext) (rho : environ) (b : binary_operation
 typecheck_environ  Delta rho ->
 forall (ge : genv) te ve,
 rho = construct_rho (filter_genv ge) ve te ->
-denote_tc_assert (typecheck_expr Delta e2) rho (m_phi m) ->
-denote_tc_assert (isBinOpResultType b e1 e2 t) rho (m_phi m) ->
-denote_tc_assert (typecheck_expr Delta e1) rho (m_phi m) ->
-None =
+denote_tc_assert (typecheck_expr Delta e2) rho ∧
+denote_tc_assert (isBinOpResultType b e1 e2 t) rho ∧
+denote_tc_assert (typecheck_expr Delta e1) rho ⊢
+⌜None =
 sem_binary_operation' b  (typeof e1) (typeof e2) (eval_expr e1 rho) (eval_expr e2 rho) ->
-Clight.eval_expr ge ve te (m_dry m) e2 (eval_expr e2 rho) ->
-Clight.eval_expr ge ve te (m_dry m) e1 (eval_expr e1 rho) ->
-Clight.eval_expr ge ve te (m_dry m) (Ebinop b e1 e2 t) Vundef.
+Clight.eval_expr ge ve te m e2 (eval_expr e2 rho) ->
+Clight.eval_expr ge ve te m e1 (eval_expr e1 rho) ->
+Clight.eval_expr ge ve te m (Ebinop b e1 e2 t) Vundef⌝.
 Proof.
 intros.
-assert (TC1 := typecheck_expr_sound _ _ _ _ H H1).
-assert (TC2 := typecheck_expr_sound _ _ _ _ H H3).
-copy H2.
-rewrite den_isBinOpR in H7; simpl in H7.
-eapply typecheck_binop_sound2 in H2; eauto.
-remember (eval_expr e1 rho); remember (eval_expr e2 rho);
-destruct v; destruct v0;
-try solve [exfalso; eapply tc_val_Vundef; eauto];
-apply tc_force_Some in H2; destruct H2; try congruence.
+iIntros "H".
+iDestruct (typecheck_expr_sound with "[H]") as %?; first done; first iDestruct "H" as "(_ & _ & $)".
+iDestruct (typecheck_expr_sound with "[H]") as %?; first done; first iDestruct "H" as "($ & _)".
+rewrite typecheck_binop_sound2; try done.
+iDestruct "H" as %TC; iPureIntro.
+unfold eval_binop, force_val2 in TC.
+intros X; rewrite -X in TC.
+apply tc_val_Vundef in TC; done.
 Qed.
 
 Opaque tc_andp.
@@ -265,60 +237,50 @@ Opaque tc_andp.
 
 Lemma tc_test_eq0:
   forall b i m,
-  (denote_tc_test_eq (Vptr b i) (Vint Int.zero)) (m_phi m) ->
-  Mem.weak_valid_pointer (m_dry m) b (Ptrofs.unsigned i) = true.
+  mem_auth m ∗ denote_tc_test_eq (Vptr b i) (Vint Int.zero) ⊢
+  ⌜Mem.weak_valid_pointer m b (Ptrofs.unsigned i) = true⌝.
 Proof.
 intros.
-destruct H;
-apply weak_valid_pointer_dry in H0;
-apply H0.
+simpl; simple_if_tac; try iIntros "[_ []]".
+iIntros "(? & _ & ?)"; iApply weak_valid_pointer_dry; iFrame.
 Qed.
 
 Lemma cop2_sem_cast :
     forall t1 t2 v m,
- (classify_cast t1 t2 = classify_cast size_t tbool ->
-   denote_tc_test_eq v (Vint Int.zero) (m_phi m) )->
   t1 <> int_or_ptr_type ->
   t2 <> int_or_ptr_type ->
   tc_val t1 v ->
- Cop.sem_cast v t1 t2 (m_dry m) = sem_cast t1 t2 v.
+  mem_auth m ∗ (⌜classify_cast t1 t2 = classify_cast size_t tbool⌝ →
+   denote_tc_test_eq v (Vint Int.zero)) ⊢
+ ⌜Cop.sem_cast v t1 t2 m = sem_cast t1 t2 v⌝.
 Proof.
 intros.
- unfold Cop.sem_cast, sem_cast.
-assert (Cop.classify_cast t1 t2 = classify_cast t1 t2). {
-  clear - H0 H1.
-  apply eqb_type_false in H0.
-  apply eqb_type_false in H1.
-  unfold Cop.classify_cast, classify_cast; rewrite ?H0,?H1.
-  destruct t1 as [| [| | |] | | [|] | | | | |], t2 as [| [| | |] | | [|] | | | | |];
-  auto.
-}
-rewrite <- H3 in *.
-rewrite H3.
-destruct (classify_cast t1 t2);
-destruct v; try reflexivity.
-+ destruct t1 as [| [| | |] | | [|] | | | | |], t2 as [| [| | |] | | [|] | | | | |]; inv H3; simpl in H2; try inv H2.
-  - revert H2; simple_if_tac; intros H2; inv H2.
-  - revert H2; simple_if_tac; intros H2; inv H2.
-+ destruct t1 as [| [| | |] | | [|] | | | | |], t2 as [| [| | |] | | [|] | | | | |]; inv H3; simpl in H2; try inv H2.
-  - revert H2; simple_if_tac; intros H2; inv H2.
-  - revert H2; simple_if_tac; intros H2; inv H2.
-+ destruct t1 as [| [| | |] | | [|] | | | | |], t2 as [| [| | |] | | [|] | | | | |]; inv H3; simpl in H2; try inv H2.
-  - revert H2; simple_if_tac; intros H2; inv H2.
-  - revert H2; simple_if_tac; intros H2; inv H2.
-+ destruct t1 as [| [| | |] | | [|] | | | | |], t2 as [| [| | |] | | [|] | | | | |]; inv H3; simpl in H2; try inv H2.
-  - revert H2; simple_if_tac; intros H2; inv H2.
-  - revert H2; simple_if_tac; intros H2; inv H2.
-+ unfold sem_cast_i2bool.
+unfold Cop.sem_cast, sem_cast.
+rewrite classify_cast_eq; try by apply eqb_type_false.
+destruct (classify_cast t1 t2) eqn: Hclass; destruct Archi.ptr64 eqn: Hp; try discriminate;
+destruct v; iIntros "[Hm H]"; try done.
++ apply tc_val_Vundef in H1; contradiction.
++ destruct t1 as [| [| | |] | | [|] | | | | |], t2 as [| [| | |] | | [|] | | | | |]; inv Hclass; try contradiction; simpl in *;
+    match goal with
+    | H: (if ?A then _ else _) = _ |- _ => destruct A eqn: ?H; inv H
+    | H: (if ?A then _ else _) _ |- _ => destruct A eqn: ?H; inv H
+    end.
++ destruct t1 as [| [| | |] | | [|] | | | | |], t2 as [| [| | |] | | [|] | | | | |]; inv Hclass; try contradiction; simpl in *;
+    match goal with
+    | H: (if ?A then _ else _) = _ |- _ => destruct A eqn: ?H; inv H
+    | H: (if ?A then _ else _) _ |- _ => destruct A eqn: ?H; inv H
+    end.
++ destruct t1 as [| [| | |] | | [|] | | | | |], t2 as [| [| | |] | | [|] | | | | |]; inv Hclass; try contradiction; simpl in *;
+    match goal with
+    | H: (if ?A then _ else _) = _ |- _ => destruct A eqn: ?H; inv H
+    | H: (if ?A then _ else _) _ |- _ => destruct A eqn: ?H; inv H
+    end.
++ iAssert (weak_valid_pointer (Vptr b i)) with "[H]" as "H".
+  { iSpecialize ("H" with "[%]"); first done.
     simpl.
-  destruct Archi.ptr64 eqn:Hp; auto; simpl.
-  specialize (H H3).
-  do 3 red in H;
-  rewrite Hp in H; try contradiction;
-  (red in H; destruct H as [_ H];
-  apply weak_valid_pointer_dry in H;
-  unfold Mem.weak_valid_pointer;
-  rewrite H; reflexivity).
+    simple_if_tac; (iDestruct "H" as "[_ $]" || iDestruct "H" as "[]"). }
+  rewrite /Mem.weak_valid_pointer.
+  by iDestruct (weak_valid_pointer_dry with "[$H $Hm]") as %->.
 Qed.
 
 Ltac destruct_eqb_type := 
@@ -364,7 +326,7 @@ destruct (eqb_type t int_or_ptr_type) eqn:J;
  [apply eqb_type_true in J0; subst t1
  | apply eqb_type_false in J0]).
 * unfold sem_cast, sem_cast_pointer in H; simpl in *.
-  rewrite N.eqb_refl in *.
+  rewrite -> N.eqb_refl in *.
   simpl in H.
   inv H.
   destruct v1; auto; inv H1.
@@ -452,62 +414,70 @@ Qed.
 
 Lemma cop2_sem_cast' :
     forall {CS: compspecs} t2 e rho m,
- (denote_tc_assert (isCastResultType (typeof e) t2 e) rho) (m_phi m) ->
   tc_val (typeof e) (eval_expr e rho) ->
- Cop.sem_cast (eval_expr e rho) (typeof e) t2 (m_dry m) =
- sem_cast (typeof e) t2 (eval_expr e rho).
+ mem_auth m ∗ denote_tc_assert (isCastResultType (typeof e) t2 e) rho ⊢
+ ⌜Cop.sem_cast (eval_expr e rho) (typeof e) t2 m =
+  sem_cast (typeof e) t2 (eval_expr e rho)⌝.
 Proof.
 intros.
-rewrite isCastR in H.
-destruct (typeof e)   as [ | [ | | | ] [ | ] | | [ | ] | | | | | ]; auto;
-destruct t2  as [ | [ | | | ] [ | ] | | [ | ] | | | | | ]; auto; 
-try contradiction.
-all: try solve [ destruct (eval_expr e rho); try contradiction; reflexivity].
-
-all: (*try solve [*)
-unfold classify_cast, is_pointer_type in H;
-unfold sem_cast, classify_cast;
-unfold tc_val, is_pointer_or_null, is_pointer_or_integer in H0;
-repeat match type of H with context [eqb_type ?A int_or_ptr_type] =>
-  let J := fresh "J" in destruct (eqb_type A int_or_ptr_type) eqn:J; try solve [inv J]
-end;
-simpl; destruct Archi.ptr64 eqn:Hp; simpl in H;
-destruct (eval_expr e rho) eqn:?; try contradiction; subst; try reflexivity.
-all: simpl.
-
-all: try solve [
-
-rewrite denote_tc_assert_test_eq' in H;
-simpl in H;
-unfold_lift in H;
-unfold denote_tc_test_eq in H;
-rewrite Heqv, Hp in H; destruct H;
-apply weak_valid_pointer_dry in H1;
-unfold Mem.weak_valid_pointer; rewrite H1, Hp; reflexivity].
+iIntros "[Hm H]".
+destruct (eq_dec t2 int_or_ptr_type).
+{ subst; rewrite isCastR /Cop.sem_cast /sem_cast /classify_cast /= N.eqb_refl.
+  destruct (typeof e); try done; destruct Archi.ptr64 eqn: Hp; try done.
+  - by simpl in H; (apply is_int_e' in H as [? ->] || apply is_long_e in H as [? ->]).
+  - simpl in H.
+    revert H; simple_if_tac; intros; destruct (eval_expr e rho); try done.
+  - simpl in H.
+    revert H; simple_if_tac; intros; destruct (eval_expr e rho); try done.
+  - simpl in H.
+    revert H; simple_if_tac; intros; destruct (eval_expr e rho); try done. }
+destruct (eq_dec (typeof e) int_or_ptr_type).
+{ rewrite e0 /tc_val eqb_type_refl /= in H.
+  rewrite e0 isCastR /sem_cast; destruct t2; try done; try destruct i; try destruct f; destruct Archi.ptr64; try destruct (intsize_eq _ _);
+    rewrite ?N.eqb_refl; unfold_lift; try done;
+    destruct (eval_expr e rho) eqn: He; try done. }
+rewrite /Cop.sem_cast /sem_cast -classify_cast_eq; try done.
+destruct (classify_cast (typeof e) t2) eqn: Hclass; try done.
+- destruct t2; try discriminate; try destruct i; try destruct f; destruct (typeof e); try destruct f; try discriminate; simpl in Hclass;
+    try solve [destruct (eval_expr e rho); try contradiction; auto];
+    try solve [revert Hclass; simple_if_tac; discriminate].
+  + simpl in H. revert H; simple_if_tac; destruct (eval_expr e rho); try contradiction; auto.
+  + simpl in H. revert H; simple_if_tac; destruct (eval_expr e rho); try contradiction; auto.
+- rewrite isCastR Hclass.
+  unfold classify_cast in Hclass.
+  destruct t2; try destruct i; try destruct f; destruct (typeof e); try destruct f; try discriminate; simpl in *;
+    try solve [destruct (eval_expr e rho); try contradiction; auto].
+  + destruct (_ && _); try discriminate.
+    rewrite denote_tc_assert_test_eq' /= /denote_tc_test_eq; unfold_lift.
+    destruct (eval_expr e rho); try contradiction; auto; simpl.
+    simple_if_tac; try done.
+    iDestruct "H" as "[_ H]".
+    by rewrite /Mem.weak_valid_pointer; iDestruct (weak_valid_pointer_dry with "[$Hm $H]") as %->.
+  + rewrite denote_tc_assert_test_eq' /= /denote_tc_test_eq; unfold_lift.
+    destruct (eval_expr e rho); try contradiction; auto; simpl.
+    simple_if_tac; try done.
+    iDestruct "H" as "[_ H]".
+    by rewrite /Mem.weak_valid_pointer; iDestruct (weak_valid_pointer_dry with "[$Hm $H]") as %->.
+  + rewrite denote_tc_assert_test_eq' /= /denote_tc_test_eq; unfold_lift.
+    destruct (eval_expr e rho); try contradiction; auto; simpl.
+    simple_if_tac; try done.
+    iDestruct "H" as "[_ H]".
+    by rewrite /Mem.weak_valid_pointer; iDestruct (weak_valid_pointer_dry with "[$Hm $H]") as %->.
 Qed.
 
-Lemma isBinOpResultType_binop_stable: forall {CS: compspecs} b e1 e2 t rho phi,
-  denote_tc_assert (isBinOpResultType b e1 e2 t) rho phi ->
-  binop_stable cenv_cs b e1 e2 = true.
+Lemma isBinOpResultType_binop_stable: forall {CS: compspecs} b e1 e2 t rho,
+  denote_tc_assert (isBinOpResultType b e1 e2 t) rho ⊢
+  ⌜binop_stable cenv_cs b e1 e2 = true⌝.
 Proof.
   intros.
   destruct b; auto;
-  unfold isBinOpResultType in H;
+  unfold isBinOpResultType;
   unfold binop_stable.
   + destruct (classify_add (typeof e1) (typeof e2));
-    rewrite ?denote_tc_assert_andp in H;
-    repeat match goal with
-    | H: app_pred (_ && _)%pred _ |- _ => destruct H
-    end;
-    [try solve [eapply tc_bool_e; eauto]..|].
-    auto.
+    rewrite ?denote_tc_assert_andp ?tc_bool_e; try iIntros "(((_ & $) & _) & _)"; auto.
   + destruct (classify_sub (typeof e1) (typeof e2));
-    rewrite ?denote_tc_assert_andp in H;
-    repeat match goal with
-    | H: app_pred (_ && _)%pred _ |- _ => destruct H
-    end;
-    [try solve [eapply tc_bool_e; eauto]..|].
-    auto.
+    rewrite ?denote_tc_assert_andp ?tc_bool_e; try iIntros "(((_ & $) & _) & _)"; auto.
+    iIntros "((_ & $) & _)".
 Qed.
 
 Lemma cenv_sub_sizeof {ge ge'} (Hcenv : cenv_sub ge' ge): forall t,
@@ -515,8 +485,8 @@ Lemma cenv_sub_sizeof {ge ge'} (Hcenv : cenv_sub ge' ge): forall t,
 Proof.
   induction t; simpl; intros; trivial.
   + rewrite IHt; trivial.
-  + specialize (Hcenv i). destruct (ge' ! i); try congruence. rewrite Hcenv; trivial.
-  + specialize (Hcenv i). destruct (ge' ! i); try congruence. rewrite Hcenv; trivial.
+  + specialize (Hcenv i). destruct (Maps.PTree.get i ge'); try congruence. rewrite Hcenv; trivial.
+  + specialize (Hcenv i). destruct (Maps.PTree.get i ge'); try congruence. rewrite Hcenv; trivial.
 Qed.
 
 Lemma cenv_sub_alignof {ge ge'} (Hcenv : cenv_sub ge' ge): forall t,
@@ -524,69 +494,50 @@ Lemma cenv_sub_alignof {ge ge'} (Hcenv : cenv_sub ge' ge): forall t,
 Proof.
   induction t; simpl; intros; trivial.
   + rewrite IHt; trivial.
-  + specialize (Hcenv i). destruct (ge' ! i); try congruence. rewrite Hcenv; trivial.
-  + specialize (Hcenv i). destruct (ge' ! i); try congruence. rewrite Hcenv; trivial.
+  + specialize (Hcenv i). destruct (Maps.PTree.get i ge'); try congruence. rewrite Hcenv; trivial.
+  + specialize (Hcenv i). destruct (Maps.PTree.get i ge'); try congruence. rewrite Hcenv; trivial.
 Qed.
 
 Lemma eval_unop_relate:
- forall {CS: compspecs} Delta (ge: genv) te ve rho u e t m 
+ forall {CS: compspecs} Delta (ge: genv) te ve rho u e t m
  (Hcenv: cenv_sub (@cenv_cs CS) (genv_cenv ge))
  (H : rho = construct_rho (filter_genv ge) ve te)
  (H0 : typecheck_environ Delta rho)
- (H1 : (denote_tc_assert (typecheck_expr Delta e) rho) (m_phi m) ->
-     Clight.eval_expr ge ve te (m_dry m) e (eval_expr e rho))
- (H2 : (denote_tc_assert (typecheck_lvalue Delta e) rho) (m_phi m) ->
-     exists (b : block) (ofs : ptrofs),
-       Clight.eval_lvalue ge ve te (m_dry m) e b ofs Full /\
-       eval_lvalue e rho = Vptr b ofs)
- (H3 : (denote_tc_assert (typecheck_expr Delta (Eunop u e t)) rho)
-       (m_phi m)),
-Clight.eval_expr ge ve te (m_dry m) (Eunop u e t)
-  (eval_expr (Eunop u e t) rho).
+ (H1 : mem_auth m ∗ denote_tc_assert (typecheck_expr Delta e) rho ⊢
+     ⌜Clight.eval_expr ge ve te m e (eval_expr e rho)⌝)
+ (H2 : mem_auth m ∗ denote_tc_assert (typecheck_lvalue Delta e) rho ⊢
+     ⌜exists (b : block) (ofs : ptrofs),
+       Clight.eval_lvalue ge ve te m e b ofs Full /\
+       eval_lvalue e rho = Vptr b ofs⌝),
+ mem_auth m ∗ denote_tc_assert (typecheck_expr Delta (Eunop u e t)) rho ⊢
+⌜Clight.eval_expr ge ve te m (Eunop u e t)
+  (eval_expr (Eunop u e t) rho)⌝.
 Proof.
 intros.
-simpl in *.
-super_unfold_lift.
-rewrite denote_tc_assert_andp in H3; destruct H3.
-intuition. clear H2.
-unfold eval_unop in *. unfold force_val1, force_val.
-remember (sem_unary_operation u (typeof e) (eval_expr e rho)).
-eapply Clight.eval_Eunop. eapply H5.  rewrite Heqo.
-
-unfold sem_unary_operation. unfold Cop.sem_unary_operation.
-apply typecheck_expr_sound in H4; auto.
-destruct u;
-  simpl in H3;
-  destruct (typeof e) as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ]; simpl;
-  hnf in H4; try contradiction;
-  repeat match goal with
-       | H: app_pred (denote_tc_assert (tc_andp _ _) _) _ |- _ => 
-          rewrite denote_tc_assert_andp in H; destruct H
-       | H: app_pred (denote_tc_assert (if ?A then _ else _) _) _ |- _ =>
-           first [change A with false in H | change A with true in H]; cbv iota in H
-       | H: app_pred (denote_tc_assert (tc_iszero _) _) _ |- _ =>
-                   rewrite denote_tc_assert_iszero in H
-       | H: app_pred (denote_tc_assert (tc_bool _ _) _) _ |- _ => apply tc_bool_e in H
-       end;
-  destruct (eval_expr e rho) eqn:?;
-  try match type of H4 with context [if ?A then _ else _] => destruct A end;
-  try contradiction; try reflexivity;
- unfold Cop.sem_notbool; simpl;
- unfold Cop.bool_val, bool_val;
- rewrite bool2val_eq; try reflexivity;
- apply tc_bool_e in H1; apply negb_true_iff in H1; rewrite H1;
- try reflexivity;
- unfold classify_bool, typeconv, remove_attributes, change_attributes;
- rewrite denote_tc_assert_test_eq' in H3;
- simpl in H3; unfold denote_tc_test_eq in H3; unfold_lift in H3; rewrite Heqv in H3.
-*
- destruct Archi.ptr64 eqn:Hp; simpl eval_expr in H3; unfold_lift in H3; destruct H3;
- apply weak_valid_pointer_dry in H6;
- simpl; unfold Mem.weak_valid_pointer; rewrite H6; reflexivity.
-*
- destruct Archi.ptr64 eqn:Hp; simpl eval_expr in H3; unfold_lift in H3; destruct H3;
- apply weak_valid_pointer_dry in H6;
- simpl; unfold Mem.weak_valid_pointer; rewrite H6; reflexivity.
+iIntros "[Hm H]".
+iDestruct (typecheck_expr_sound with "H") as %TC; first done.
+unfold typecheck_expr; fold typecheck_expr.
+unfold eval_expr in TC; fold eval_expr in TC.
+simpl; super_unfold_lift.
+rewrite denote_tc_assert_andp.
+unfold eval_unop in *. unfold force_val1, force_val in *.
+remember (sem_unary_operation u (typeof e) (eval_expr e rho)) as o.
+destruct o; [|apply tc_val_Vundef in TC; contradiction].
+iDestruct (H1 with "[$Hm H]") as %He.
+{ iDestruct "H" as "(_ & $)". }
+rewrite -bi.pure_mono'; [|intros X; econstructor; [apply He | apply X]].
+rewrite typecheck_expr_sound; last done.
+iDestruct "H" as "[H %TC']".
+destruct u; simpl; destruct (typeof e) as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ]; try discriminate; simpl in *;
+  rewrite ?denote_tc_assert_andp ?tc_bool_e ?negb_true_iff ?notbool_bool_val /Cop.bool_val /classify_bool /= ?bool2val_eq;
+  unfold bool_val, bool_val_p in *;
+  destruct (eval_expr e rho) eqn:He'; inversion Heqo; auto;
+  try (iDestruct "H" as "[%Hptr H]"; rewrite -> Hptr in *; try contradiction).
+- by destruct Archi.ptr64; inv H4.
+- rewrite denote_tc_assert_test_eq' /=; unfold_lift; rewrite /denote_tc_test_eq He'.
+  destruct Archi.ptr64 eqn: Hp; try discriminate; simpl.
+  iDestruct "H" as "(% & _ & H)".
+  by rewrite /Mem.weak_valid_pointer; iDestruct (weak_valid_pointer_dry with "[$Hm $H]") as %->.
 Qed.
 
 Lemma eqb_type_sym: forall a b, eqb_type a b = eqb_type b a.
@@ -614,36 +565,31 @@ apply Ptrofs.eqm_unsigned_repr.
 Qed.
 
 Lemma eval_both_relate:
-  forall {CS: compspecs} Delta ge te ve rho e m,
-           cenv_sub (@cenv_cs CS) (genv_cenv ge) ->
+  forall {CS: compspecs} Delta ge te ve rho e m
+           (Hcenv : cenv_sub (@cenv_cs CS) (genv_cenv ge)),
            rho = construct_rho (filter_genv ge) ve te ->
            typecheck_environ Delta rho ->
-           (denote_tc_assert (typecheck_expr Delta e) rho (m_phi m) ->
-             Clight.eval_expr ge ve te (m_dry m) e  (eval_expr e rho))
+           (mem_auth m ∗ denote_tc_assert (typecheck_expr Delta e) rho ⊢
+             ⌜Clight.eval_expr ge ve te m e (eval_expr e rho)⌝)
            /\
-           (denote_tc_assert (typecheck_lvalue Delta e) rho (m_phi m) ->
-             exists b, exists ofs,
-              Clight.eval_lvalue ge ve te (m_dry m) e b ofs Full /\
-              eval_lvalue e rho = Vptr b ofs).
+           (mem_auth m ∗ denote_tc_assert (typecheck_lvalue Delta e) rho ⊢
+             ⌜exists b, exists ofs,
+              Clight.eval_lvalue ge ve te m e b ofs Full /\
+              eval_lvalue e rho = Vptr b ofs⌝).
 Proof.
-intros until m; intro Hcenv; intros.
- induction e; intros;
-try solve[intuition  (try solve [contradiction]); constructor; auto | subst; inv H1]; 
-  intuition (try solve [contradiction]).
-
+intros.
+induction e; split; iIntros "[Hm H]"; try done; try solve [iPureIntro; constructor; auto].
 * (* eval_expr Evar*)
-
-assert (TC_Sound:= typecheck_expr_sound).
-specialize (TC_Sound Delta rho _ (Evar i t) H0 H1).
-simpl in H1, TC_Sound |- *.
-super_unfold_lift.
-destruct (access_mode t) eqn:MODE; try solve [inv H1].
-
+iDestruct (typecheck_expr_sound with "H") as %TC; first done.
+simpl in *.
+unfold typecheck_expr.
+destruct (access_mode t) eqn:MODE; try iDestruct "H" as "[]".
 unfold get_var_type, eval_var in *.
-remember (Map.get (ve_of rho) i); destruct o; try destruct p;
+remember (Map.get (ve_of rho) i) as o; destruct o as [(?, ?)|];
 try rewrite eqb_type_eq in *; simpl in *.
-destruct (type_eq t t0); simpl in *; [| exfalso; eapply tc_val_Vundef; eauto].
+rewrite eqb_type_eq in TC |- *; destruct (type_eq t t0); [|apply tc_val_Vundef in TC; contradiction].
 subst t0.
+iPureIntro.
 apply Clight.eval_Elvalue with b Ptrofs.zero Full;
   [ | constructor; simpl; rewrite MODE; auto].
 apply eval_Evar_local.
@@ -653,189 +599,165 @@ subst rho.
 unfold typecheck_environ in *.
 destruct H0 as [? [Hve Hge]].
 hnf in Hve,Hge.
-revert H1; case_eq ((var_types Delta) ! i); intros; try contradiction.
+destruct (_ !! _) eqn: Hv.
 specialize (Hve i t0). destruct Hve as [Hve _].
-destruct (Hve H0). simpl in *; congruence.
-revert H1; case_eq ((glob_types Delta) ! i); intros; try contradiction.
-destruct (Hge _ _ H1) as [b ?].
-simpl. simpl in H3.
-rewrite H3.
-
-repeat( rewrite tc_andp_sound in *; simpl in *; super_unfold_lift).
-unfold tc_bool in H2.
-destruct (eqb_type t t0); try contradiction.
+destruct (Hve Hv). simpl in *; congruence.
+destruct (glob_types Delta !! i) eqn: Hg; [|iDestruct "H" as "[]"].
+destruct (Hge _ _ Hg) as [b Hfind]; rewrite Hfind.
+iPureIntro.
 apply Clight.eval_Elvalue with b Ptrofs.zero Full; [  | econstructor 2; apply MODE].
 apply Clight.eval_Evar_global; auto.
 
 * (* eval_lvalue Evar *)
- simpl in H1.
- unfold get_var_type in H1.
+ unfold typecheck_lvalue.
+ unfold get_var_type.
  subst rho; simpl in *.
  unfold eval_var.
- destruct_var_types i eqn:HH1&HH2; rewrite ?HH1, ?HH2 in *;
-  [| destruct_glob_types i eqn:HH3&HH4; rewrite ?HH3, ?HH4 in *; [| inv H1]].
+ destruct_var_types i eqn:HH1&HH2; rewrite -> ?HH1, ?HH2 in *;
+  [| destruct_glob_types i eqn:HH3&HH4; rewrite -> ?HH3, ?HH4 in *; [| iDestruct "H" as "[]"]].
  +
- destruct (eqb_type t t0) eqn:?; [| inv H1].
+ rewrite tc_bool_e; iDestruct "H" as %Heqb0; iPureIntro.
+ rewrite Heqb0.
  apply eqb_type_true in Heqb0; subst t0.
  exists b; exists Ptrofs.zero; split; auto.
  constructor; auto.
  +
- destruct (eqb_type t t0) eqn:?; [| inv H1].
- apply eqb_type_true in Heqb0; subst t0.
+ iPureIntro.
  exists b; exists Ptrofs.zero; split; auto.
  constructor 2; auto.
 
 * (*temp*)
-assert (TC:= typecheck_expr_sound).
-specialize (TC Delta rho (m_phi m) (Etempvar i t)). simpl in *.
-intuition.
-constructor. unfold eval_id in *. remember (Map.get (te_of rho)  i);
-destruct o;  auto. destruct rho; inv H; unfold make_tenv in *.
-unfold Map.get in *. auto.
+iDestruct (typecheck_expr_sound with "H") as %TC; first done.
 simpl in *.
-clear - H3.
-destruct t as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ]; 
-  try contradiction H3.
-unfold tc_val in H3. 
-destruct (eqb_type _ _); contradiction H3.
+iPureIntro.
+constructor. unfold eval_id in *. remember (Map.get (te_of rho) i);
+destruct o; subst; auto.
+apply tc_val_Vundef in TC; contradiction.
 
 * (*deref*)
-assert (TC:= typecheck_expr_sound).
-specialize (TC Delta rho (m_phi m) (Ederef e t)). simpl in *.
-intuition.
-destruct (access_mode t) eqn:?H; try inversion H3.
-rewrite !denote_tc_assert_andp in H3.
-destruct H3 as [[? ?] ?].
-simpl in H5.
-unfold_lift in H5.
-unfold_lift.
-apply tc_bool_e in H6.
-specialize (H1 H3).
-hnf in H7.
-destruct (eval_expr e rho) eqn:?H; try contradiction.
+unfold typecheck_expr; fold typecheck_expr.
+destruct (access_mode t) eqn:?H; try done.
+rewrite !denote_tc_assert_andp tc_bool_e.
+iDestruct "H" as "((H & %) & %)".
+iDestruct (proj1 IHe with "[$]") as %?; iPureIntro.
+simpl; destruct (eval_expr e rho) eqn:?H; try contradiction.
 eapply eval_Elvalue.
 econstructor. eassumption.
-simpl.
 constructor. auto.
 * (*deref*)
-assert (TC:= typecheck_lvalue_sound _ _ _ _ H0 H3).
-simpl in *.
-rewrite !denote_tc_assert_andp in H3.
-destruct H3 as [[? ?] ?].
-specialize (H1 H3).
-apply tc_bool_e in H4. simpl in H4.
-hnf in H5.
-destruct (eval_expr e rho) eqn:?; try contradiction.
-exists b, i. simpl in *. unfold_lift. intuition. constructor.
-auto.
-* (*addrof*)
+unfold typecheck_lvalue; fold typecheck_expr.
+rewrite !denote_tc_assert_andp tc_bool_e.
+iDestruct "H" as "((H & %) & %)".
+iDestruct (proj1 IHe with "[$]") as %?; iPureIntro.
+destruct (eval_expr e rho) eqn:?H; try contradiction.
+exists b, i. split; auto; constructor; auto.
 
-simpl in H3.
-rewrite !denote_tc_assert_andp in H3.
-destruct H3.
-assert (ISPTR := eval_lvalue_ptr rho (m_phi m) e Delta (te_of rho) (ve_of rho) (ge_of rho)).
-specialize (H2 H3).
-apply tc_bool_e in H4.
-assert (mkEnviron (ge_of rho) (ve_of rho) (te_of rho) = rho). destruct rho; auto.
-destruct rho. unfold typecheck_environ in *. intuition.
-destruct H2 as [b [? ?]]. destruct H9 as [base [ofs ?]].  simpl in *.
-intuition. rewrite H10 in *. constructor. inv H7. auto.
+* (*addrof*)
+unfold typecheck_expr; fold typecheck_lvalue.
+rewrite !denote_tc_assert_andp tc_bool_e.
+iDestruct "H" as "[H %]".
+simpl; iDestruct (proj2 IHe with "[$]") as %(b & ? & ? & ->); iPureIntro.
+constructor; auto.
 
 * (*unop*)
- eapply eval_unop_relate; eauto.
+ destruct IHe; by iApply (eval_unop_relate with "[$]").
 * (*binop*)
-  eapply eval_binop_relate; eauto.
+ destruct IHe1, IHe2; by iApply (eval_binop_relate with "[$]").
 * (*Cast*)
-assert (TC := typecheck_expr_sound _ _ _ _ H0 H3).
-simpl in *.
-rewrite denote_tc_assert_andp in H3.
-destruct H3.
-assert (TC' := typecheck_expr_sound _ _ _ _ H0 H3).
-unfold force_val1, force_val in *; super_unfold_lift; intuition.
-eapply Clight.eval_Ecast.
-eapply H5; auto.
-destruct (sem_cast (typeof e) t (eval_expr e rho)) eqn:?H;
- [ | contradiction (tc_val_Vundef t)].
-pose proof cop2_sem_cast' t e rho m H4 TC'.
-rewrite H6; auto.
+iDestruct (typecheck_expr_sound with "H") as %TC; first done.
+unfold typecheck_expr; fold typecheck_expr.
+rewrite denote_tc_assert_andp.
+iDestruct (typecheck_expr_sound with "[H]") as %?; first done.
+{ iDestruct "H" as "($ & _)". }
+iDestruct (proj1 IHe with "[$Hm H]") as %?.
+{ iDestruct "H" as "($ & _)". }
+iDestruct "H" as "[_ H]"; iDestruct (cop2_sem_cast' with "[$]") as %?; first done; iPureIntro.
+simpl in *; super_unfold_lift; unfold force_val1 in *.
+destruct (sem_cast _ _ _); [|apply tc_val_Vundef in TC; contradiction].
+econstructor; eauto.
 * (*Field*)
- assert (TC := typecheck_expr_sound _ _ _ _ H0 H3).
- clear H1; rename H3 into H1.
-simpl in H1.
- destruct (access_mode t) eqn:?; try solve [inv H1].
- rewrite denote_tc_assert_andp in H1. destruct H1.
- specialize (H2 H1). destruct H2 as [b [ofs [? ?]]].
- destruct (typeof e) eqn:?; try solve[inv H3];
- destruct (cenv_cs ! i0) as [co |] eqn:Hco; try solve [inv H3].
+ unfold typecheck_expr; fold typecheck_lvalue.
+ destruct (access_mode t) eqn:?; try done.
+ rewrite denote_tc_assert_andp.
+ iDestruct (proj2 IHe with "[$Hm H]") as %He.
+ { iDestruct "H" as "($ & _)". }
+ iDestruct "H" as "[_ H]".
+ destruct He as (b & ofs & ? & He).
+ destruct (typeof e) eqn:?; try iDestruct "H" as "[]";
+ destruct (cenv_cs !! _) as [co |] eqn:Hco; try iDestruct "H" as "[]".
 +
-   destruct (field_offset cenv_cs i (co_members co)) as [[?  [|]] |]eqn:?;
-     try contradiction.
-  inv H3. simpl in *.
+  destruct (field_offset cenv_cs i (co_members co)) as [[?  [|]] |]eqn:?;
+    try iDestruct "H" as "[]".
+  iPureIntro.
   eapply Clight.eval_Elvalue; eauto.
   eapply Clight.eval_Efield_struct; eauto.
   eapply Clight.eval_Elvalue; auto. eassumption.
   rewrite Heqt0.
-  apply Clight.deref_loc_copy. auto.
+  apply Clight.deref_loc_copy; auto.
   { specialize (Hcenv i0); rewrite Hco in Hcenv; apply Hcenv. }
   { instantiate (1:=Full). instantiate (1:=z). rewrite <- Heqr.
     eapply field_offset_stable; try eassumption.
-    intros. specialize (Hcenv id); rewrite H in Hcenv; apply Hcenv.
-   apply co_consistent_complete. 
+    intros. specialize (Hcenv id); setoid_rewrite -> H2 in Hcenv; apply Hcenv.
+    apply co_consistent_complete.
     apply (cenv_consistent i0); auto. }
-  unfold_lift.
-  unfold Datatypes.id; simpl.
-  rewrite Heqt0. rewrite H4. simpl. rewrite Hco. rewrite Heqr.
-   apply Clight.deref_loc_reference. auto.
-
-+ simpl. unfold_lift.
-   rewrite Heqt0. simpl. rewrite Hco.
-  destruct (union_field_offset (@cenv_cs CS) i (co_members co) ) eqn:?H; try contradiction.
-  destruct p. destruct z; try contradiction. destruct b0; try contradiction.
+  simpl; unfold_lift; rewrite Heqt0 /eval_field.
+  rewrite He Hco Heqr.
+  apply Clight.deref_loc_reference. auto.
+
++ 
+  destruct (union_field_offset (@cenv_cs CS) i (co_members co) ) as [(?, ?)|] eqn:?H; try iDestruct "H" as "[]".
+  destruct z; try iDestruct "H" as "[]". destruct b0; try iDestruct "H" as "[]".
+  iPureIntro.
   eapply Clight.eval_Elvalue; eauto.
   eapply Clight.eval_Efield_union.
   eapply Clight.eval_Elvalue; eauto.
   apply Clight.deref_loc_copy.
   rewrite Heqt0. auto. eauto.
   { specialize (Hcenv i0); rewrite Hco in Hcenv; apply Hcenv. }
-  instantiate (1:=Full). instantiate (1:=0). rewrite <- H5.
+  instantiate (1:=Full). instantiate (1:=0). rewrite <- H2.
   eapply union_field_offset_stable; try eassumption.
-    intros. specialize (Hcenv id); rewrite H6 in Hcenv; apply Hcenv.
-   apply co_consistent_complete. 
-    apply (cenv_consistent i0); auto.
-  rewrite ptrofs_add_repr_0.
-  rewrite H4. simpl offset_val.
+  { intros. specialize (Hcenv id); setoid_rewrite H3 in Hcenv; apply Hcenv. }
+  { apply co_consistent_complete. 
+    apply (cenv_consistent i0); auto. }
+  simpl; unfold_lift; rewrite Heqt0 /eval_field.
+  rewrite ptrofs_add_repr_0 /= Hco H2.
+  rewrite He /=.
   rewrite ptrofs_add_repr_0.
   apply Clight.deref_loc_reference; auto.
 *
- clear H1.
- assert (TC:= typecheck_lvalue_sound _ _ _ _ H0 H3).
- simpl in *.
- rewrite denote_tc_assert_andp in H3. destruct H3.
- unfold eval_field,offset_val in *; super_unfold_lift.
- specialize (H2 H1).
-destruct H2 as [b [ofs H4]].
-destruct H4.
-rewrite H4 in TC|-*.
- destruct (typeof e) eqn:?; try contradiction;
-destruct (cenv_cs ! i0) as [co |] eqn:Hco; try solve [inv H3].
+  iDestruct (typecheck_lvalue_sound with "H") as %TC; first done.
+  simpl in TC.
+  unfold typecheck_lvalue; fold typecheck_lvalue.
+  rewrite denote_tc_assert_andp.
+  iDestruct (proj2 IHe with "[$Hm H]") as %He.
+  { iDestruct "H" as "($ & _)". }
+  iDestruct "H" as "[_ H]".
+  destruct He as (b & ofs & ? & He).
+  super_unfold_lift; rewrite He in TC.
+  destruct (typeof e) eqn:?; try iDestruct "H" as "[]";
+    destruct (cenv_cs !! _) as [co |] eqn:Hco; try iDestruct "H" as "[]".
 +
-destruct (field_offset cenv_cs i (co_members co)) eqn:?; try contradiction.
-destruct p. destruct b0; try contradiction.
+destruct (field_offset cenv_cs i (co_members co)) as [(?, ?)|] eqn:?; try iDestruct "H" as "[]".
+destruct b0; try iDestruct "H" as "[]".
+iPureIntro.
 exists b. exists (Ptrofs.add ofs (Ptrofs.repr z)).
-intuition.
- eapply Clight.eval_Efield_struct; auto; try eassumption.
-eapply Clight.eval_Elvalue in H2. apply H2.
+simpl; unfold_lift; rewrite Heqt0 /eval_field.
+rewrite Hco He Heqr; split; auto.
+eapply Clight.eval_Efield_struct; auto; try eassumption.
+eapply Clight.eval_Elvalue; eauto.
 rewrite Heqt0. apply Clight.deref_loc_copy. simpl; auto.
 { specialize (Hcenv i0); rewrite Hco in Hcenv; apply Hcenv. }
 { rewrite <- Heqr. eapply field_offset_stable; eauto.
-  intros. specialize (Hcenv id); rewrite H5 in Hcenv; apply Hcenv.
-   apply co_consistent_complete. 
-    apply (cenv_consistent i0); auto. }
+  intros. specialize (Hcenv id); setoid_rewrite H2 in Hcenv; apply Hcenv.
+  apply co_consistent_complete.
+  apply (cenv_consistent i0); auto. }
 +
-destruct (union_field_offset cenv_cs i (co_members co)) eqn:?; try contradiction.
-destruct p. destruct z; try contradiction. destruct b0; try contradiction.
+destruct (union_field_offset cenv_cs i (co_members co)) as [(?, ?)|] eqn:?; try iDestruct "H" as "[]".
+destruct z; try iDestruct "H" as "[]". destruct b0; try iDestruct "H" as "[]".
+iPureIntro.
 exists b. exists (Ptrofs.add ofs (Ptrofs.repr 0)).
-simpl. split; auto.
+simpl; unfold_lift; rewrite Heqt0 /eval_field.
+rewrite Hco He Heqr; split; auto.
 eapply Clight.eval_Efield_union; eauto; try eassumption.
 eapply Clight.eval_Elvalue; eauto.
 rewrite Heqt0. apply Clight.deref_loc_copy.
@@ -843,32 +765,26 @@ auto.
 { specialize (Hcenv i0); rewrite Hco in Hcenv; apply Hcenv. }
 rewrite <- Heqr.
 apply union_field_offset_stable.
-  intros. specialize (Hcenv id); rewrite H5 in Hcenv; apply Hcenv.
-   apply co_consistent_complete. 
-    apply (cenv_consistent i0); auto.
+  intros. specialize (Hcenv id); setoid_rewrite H2 in Hcenv; apply Hcenv.
+  apply co_consistent_complete.
+  apply (cenv_consistent i0); auto.
 *
-simpl in H1.
-repeat rewrite denote_tc_assert_andp in H1.
-destruct H1.
-apply tc_bool_e in H1.
-apply tc_bool_e in H2.
-rewrite eqb_type_spec in H2.
-subst.
-unfold eval_expr.
+unfold typecheck_expr.
+rewrite !denote_tc_assert_andp !tc_bool_e.
+iDestruct "H" as "(%H1 & %H2)"; iPureIntro.
+rewrite eqb_type_spec in H2; subst.
 unfold_lift; simpl.
-{ rewrite H1. unfold expr.sizeof.
-  rewrite <- (cenv_sub_sizeof Hcenv _ H1).
-  apply Clight.eval_Esizeof. }
+rewrite H1. unfold expr.sizeof.
+rewrite <- (cenv_sub_sizeof Hcenv _ H1).
+constructor.
 *
-simpl in H1.
-repeat rewrite denote_tc_assert_andp in H1.
-destruct H1.
-apply tc_bool_e in H1.
-apply tc_bool_e in H2.
-unfold eval_expr.
+unfold typecheck_expr.
+rewrite !denote_tc_assert_andp !tc_bool_e.
+iDestruct "H" as "(%H1 & %H2)"; iPureIntro.
+rewrite eqb_type_spec in H2; subst.
 unfold_lift; simpl.
-rewrite H1.  unfold expr.alignof.
-rewrite <- (cenv_sub_alignof Hcenv _ H1). 
+rewrite H1. unfold expr.alignof.
+rewrite <- (cenv_sub_alignof Hcenv _ H1).
 constructor.
 Qed.
 
@@ -877,8 +793,8 @@ Lemma eval_expr_relate:
            cenv_sub (@cenv_cs CS) (genv_cenv ge) ->
            rho = construct_rho (filter_genv ge) ve te ->
            typecheck_environ Delta rho ->
-           (denote_tc_assert (typecheck_expr Delta e) rho (m_phi m) ->
-             Clight.eval_expr ge ve te (m_dry m) e  (eval_expr e rho)).
+           mem_auth m ∗ denote_tc_assert (typecheck_expr Delta e) rho ⊢
+             ⌜Clight.eval_expr ge ve te m e (eval_expr e rho)⌝.
 Proof.
 intros.
 edestruct eval_both_relate; eauto.
@@ -889,17 +805,13 @@ Lemma eval_lvalue_relate:
            cenv_sub (@cenv_cs CS) (genv_cenv ge) ->
            rho = construct_rho (filter_genv ge) ve te->
            typecheck_environ Delta rho ->
-           (denote_tc_assert (typecheck_lvalue Delta e) rho (m_phi m) ->
-             exists b, exists ofs,
-              Clight.eval_lvalue ge ve te (m_dry m) e b ofs Full /\
-              eval_lvalue e rho = Vptr b ofs).
+           mem_auth m ∗ denote_tc_assert (typecheck_lvalue Delta e) rho ⊢
+             ⌜exists b, exists ofs,
+                Clight.eval_lvalue ge ve te m e b ofs Full /\
+               eval_lvalue e rho = Vptr b ofs⌝.
 Proof.
 intros.
 edestruct eval_both_relate; eauto.
 Qed.
 
-
-
-
-
-
+End mpred.
diff --git a/veric/extend_tc.v b/veric/extend_tc.v
index 4e4fce15e1..5c2cd9deba 100644
--- a/veric/extend_tc.v
+++ b/veric/extend_tc.v
@@ -1,496 +1,88 @@
-Require Import VST.msl.log_normalize.
-Require Import VST.msl.alg_seplog.
 Require Export VST.veric.Clight_base.
-Require Import VST.veric.compcert_rmaps.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Import VST.veric.res_predicates.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.mpred.
 Require Import VST.veric.tycontext.
 Require Import VST.veric.expr2.
 Require Import VST.veric.binop_lemmas2.
+Require Import VST.veric.binop_lemmas4.
+Require Import VST.veric.expr_lemmas.
 
 Require Import VST.veric.seplog. (*For definition of tycontext*)
 Import LiftNotation.
-Import compcert.lib.Maps.
-Local Open Scope pred.
-
-Definition tc_expr {CS: compspecs} (Delta: tycontext) (e: expr) : environ -> mpred:=
-  fun rho => denote_tc_assert (typecheck_expr Delta e) rho.
-
-Definition tc_exprlist {CS: compspecs} (Delta: tycontext) (t : list type) (e: list expr) : environ -> mpred :=
-      fun rho => denote_tc_assert (typecheck_exprlist Delta t e) rho.
-
-Definition tc_lvalue {CS: compspecs} (Delta: tycontext) (e: expr) : environ -> mpred :=
-     fun rho => denote_tc_assert (typecheck_lvalue Delta e) rho.
-
-Definition tc_temp_id {CS: compspecs} (id : positive) (ty : type)
-  (Delta : tycontext) (e : expr) : environ -> mpred  :=
-     fun rho => denote_tc_assert (typecheck_temp_id id ty Delta e) rho.
-
-Definition tc_expropt {CS: compspecs} Delta (e: option expr) (t: type) : environ -> mpred :=
-   match e with None => `!!(t=Ctypes.Tvoid)
-                     | Some e' => tc_expr Delta (Ecast e' t)
-   end.
-
-Definition tc_temp_id_load id tfrom Delta v : environ -> mpred  :=
-fun rho => !! (exists tto, (temp_types Delta) ! id = Some tto
-                      /\ tc_val tto (eval_cast tfrom tto (v rho))).
-
-Lemma extend_prop: forall P, boxy extendM (prop P : mpred).
-Proof.
-intros.
-hnf.
-apply pred_ext. intros ? ?. apply H; auto. apply extendM_refl.
-repeat intro. apply H.
-Qed.
-
-#[export] Hint Resolve extend_prop : core.
-
-Lemma extend_tc_temp_id_load :  forall id tfrom Delta v rho, boxy extendM (tc_temp_id_load id tfrom Delta v rho).
-Proof.
-intros. unfold tc_temp_id_load. auto.
-Qed.
-
-Lemma extend_tc_andp:
- forall {CS: compspecs} A B rho,
-   boxy extendM (denote_tc_assert A rho) ->
-   boxy extendM (denote_tc_assert B rho) ->
-   boxy extendM (denote_tc_assert (tc_andp A B) rho).
-Proof.
-intros.
-rewrite denote_tc_assert_andp.
-apply boxy_andp; auto.
-intros ?; hnf.
-exists (core x); apply join_comm, core_unit.
-Qed.
-
-Lemma extend_tc_bool:
- forall {CS: compspecs} A B rho,
-   boxy extendM (denote_tc_assert (tc_bool A B) rho).
-Proof.
-intros.
-destruct A; simpl; apply  extend_prop.
-Qed.
-
-Lemma extend_tc_int_or_ptr_type:
- forall {CS: compspecs} A rho,
-   boxy extendM (denote_tc_assert (tc_int_or_ptr_type A) rho).
-Proof.
-intros.
-apply  extend_tc_bool.
-Qed.
-
-Lemma extend_tc_Zge:
- forall {CS: compspecs} v i rho,
-   boxy extendM (denote_tc_assert (tc_Zge v i) rho).
-Proof.
-intros.
-induction v; simpl; unfold_lift; simpl;
-unfold denote_tc_Zle; try apply extend_prop;
-repeat match goal with |- boxy _ (match ?A with  _ => _ end) => destruct A end;
-try apply extend_prop.
-Qed.
-
-Lemma extend_tc_Zle:
- forall {CS: compspecs} v i rho,
-   boxy extendM (denote_tc_assert (tc_Zle v i) rho).
-Proof.
-intros.
-induction v; simpl; unfold_lift; simpl;
-unfold denote_tc_Zge; try apply extend_prop;
-repeat match goal with |- boxy _ (match ?A with  _ => _ end) => destruct A end;
-try apply extend_prop.
-Qed.
-
-Lemma extend_tc_iszero:
- forall {CS: compspecs} v rho,
-   boxy extendM (denote_tc_assert (tc_iszero v) rho).
-Proof.
-intros.
-rewrite denote_tc_assert_iszero.
-destruct (eval_expr v rho); apply extend_prop.
-Qed.
-
-Lemma extend_valid_pointer':
-  forall a b, boxy extendM (valid_pointer' a b).
-Proof.
-intros.
-apply boxy_i; intros.
-apply extendM_refl.
-unfold valid_pointer' in *.
-simpl in *.
-destruct a; simpl in *; auto.
-forget (b0, Ptrofs.unsigned i + b) as p.
-destruct (w @ p) eqn:?H; try contradiction.
-+ destruct H as [w2 ?].
-  apply (resource_at_join _ _ _ p) in H.
-  rewrite H1 in H.
-  inv H; auto.
-  clear - H0 RJ.
-  eapply join_nonidentity; eauto.
-+ destruct H as [w2 ?].
-  apply (resource_at_join _ _ _ p) in H.
-  rewrite H1 in H.
-  inv H; auto.
-+ (*new case: PURE*)
-  destruct H as [w2 ?].
-  apply (resource_at_join _ _ _ p) in H.
-  rewrite H1 in H.
-  inv H; auto.
-Qed.
-
-Lemma extend_andp: forall (P Q : mpred),
-  boxy extendM P -> boxy extendM Q -> boxy extendM (andp P Q).
-Proof.
- intros.
- apply boxy_i; intros.
- apply extendM_refl.
- destruct H2; split; eapply boxy_e; eauto.
-Qed.
-
-Lemma extend_orp: forall (P Q : mpred), 
-  boxy extendM P -> boxy extendM Q -> boxy extendM (orp P Q).
-Proof.
- intros.
- apply boxy_i; intros.
- apply extendM_refl.
- destruct H2; [left|right]; eapply boxy_e; eauto.
-Qed.
 
-Lemma extend_tc_test_eq:
-  forall {CS: compspecs} e1 e2 rho,
- boxy extendM (denote_tc_assert (tc_test_eq e1 e2) rho).
-Proof.
-intros.
-rewrite denote_tc_assert_test_eq'.
-apply boxy_i; intros.
-apply extendM_refl.
-simpl in *.
-super_unfold_lift.
-unfold denote_tc_test_eq in *.
-destruct (eval_expr e1 rho); auto;
-destruct (eval_expr e2 rho); auto.
-+ destruct H0; split; auto.
-  destruct H1 as [H1|H1]; [left|right];
-  apply (boxy_e _ _ (extend_valid_pointer' _ _) _ w' H H1).
-+ destruct H0; split; auto.
-  destruct H1 as [H1|H1]; [left|right];
-  apply (boxy_e _ _ (extend_valid_pointer' _ _) _ w' H H1).
-+
- unfold test_eq_ptrs in *.
- simple_if_tac;
- (eapply boxy_e;
-  [apply extend_andp; try apply extend_orp; apply extend_valid_pointer' | apply H | apply H0]).
-Qed.
+Section mpred.
 
-Lemma extend_tc_test_order:
-  forall {CS: compspecs} e1 e2 rho,
- boxy extendM (denote_tc_assert (tc_test_order e1 e2) rho).
-Proof.
-intros.
-rewrite denote_tc_assert_test_order'.
-apply boxy_i; intros.
-apply extendM_refl.
-simpl in *.
-super_unfold_lift.
-unfold denote_tc_test_order in *.
-destruct (eval_expr e1 rho); auto;
-destruct (eval_expr e2 rho); auto.
-+ unfold test_order_ptrs in *.
-  simple_if_tac; auto.
- eapply boxy_e;
-  [apply extend_andp; eapply extend_orp; apply extend_valid_pointer' | apply H | apply H0].
-Qed.
-
-Lemma extend_isCastResultType:
- forall {CS: compspecs} t t' v rho,
-   boxy extendM (denote_tc_assert (isCastResultType t t' v) rho).
-Proof.
-intros.
- unfold isCastResultType;
- destruct (classify_cast t t');
- repeat apply extend_tc_andp;
- try match goal with |- context [eqb_type _ _] => destruct (eqb_type t t') end;
- repeat match goal with
- | |- boxy _ (match ?A with  _ => _ end) => destruct A
- | |- boxy _ (denote_tc_assert (if ?A then _ else _) rho) => destruct A
- | |- boxy _ (denote_tc_assert (match t' with _ => _ end) rho) =>
-        destruct t' as [ | [ | | | ] [ | ] ? | [ | ] ? | [ | ] ? | | | | | ]
- end;
- repeat apply extend_tc_andp;
- try apply extend_prop;
- try simple apply extend_tc_bool;
- try simple apply extend_tc_Zge;
- try simple apply extend_tc_Zle;
- try simple apply extend_tc_iszero;
- try simple apply extend_tc_test_eq;
- try simple apply extend_tc_test_order.
-Qed.
+Context `{!heapGS Σ}.
 
-Lemma extend_tc_temp_id: forall {CS: compspecs} id ty Delta e rho, boxy extendM (tc_temp_id id ty Delta e rho).
-Proof.
-intros. unfold tc_temp_id. unfold typecheck_temp_id.
-destruct ((temp_types Delta) ! id) as [? | ];
- repeat apply extend_tc_andp;
- try apply extend_prop;
- try simple apply extend_tc_bool.
- apply extend_isCastResultType.
-Qed.
-
-Lemma extend_tc_samebase:
-  forall {CS: compspecs} e1 e2 rho,
-boxy extendM (denote_tc_assert (tc_samebase e1 e2) rho).
-Proof.
-intros.
-unfold denote_tc_assert; simpl.
-unfold_lift.
-destruct (eval_expr e1 rho), (eval_expr e2 rho);
-  apply extend_prop.
-Qed.
-
-Lemma extend_tc_nonzero:
- forall {CS: compspecs} v rho,
-   boxy extendM (denote_tc_assert (tc_nonzero v) rho).
-Proof.
-intros.
-rewrite denote_tc_assert_nonzero.
-destruct (eval_expr v rho); apply extend_prop.
-Qed.
-
-
-Lemma extend_tc_nodivover:
- forall {CS: compspecs} e1 e2 rho,
-   boxy extendM (denote_tc_assert (tc_nodivover e1 e2) rho).
-Proof.
-intros.
-rewrite denote_tc_assert_nodivover.
-destruct (eval_expr e1 rho); try apply extend_prop;
-destruct (eval_expr e2 rho); try apply extend_prop.
-Qed.
+Definition tc_expr {CS: compspecs} (Delta: tycontext) (e: expr) : assert :=
+  assert_of (denote_tc_assert (typecheck_expr Delta e)).
 
-Lemma extend_tc_nosignedover:
- forall op {CS: compspecs} e1 e2 rho,
-   boxy extendM (denote_tc_assert (tc_nosignedover op e1 e2) rho).
-Proof.
-intros.
-unfold denote_tc_assert.
-unfold_lift.
-destruct (typeof e1) as [ | _ [ | ] _ | | | | | | | ],
-       (typeof e2) as [ | _ [ | ] _ | | | | | | | ];
-unfold denote_tc_nosignedover;
-destruct (eval_expr e1 rho); try apply extend_prop;
-destruct (eval_expr e2 rho); try apply extend_prop.
-Qed.
+Definition tc_exprlist {CS: compspecs} (Delta: tycontext) (t : list type) (e: list expr) : assert :=
+  assert_of (denote_tc_assert (typecheck_exprlist Delta t e)).
 
-Lemma extend_tc_nobinover:
- forall op {CS: compspecs} e1 e2 rho,
-   boxy extendM (denote_tc_assert (tc_nobinover op e1 e2) rho).
-Proof.
-intros.
-unfold tc_nobinover.
-unfold if_expr_signed.
-destruct (typeof e1) as [ | _ [ | ] _ | [ | ] _ | | | | | | ],
-       (typeof e2) as [ | _ [ | ] _ | [ | ] _ | | | | | | ];
-      try apply extend_prop;
-destruct (eval_expr e1 any_environ); try apply extend_prop;
-destruct (eval_expr e2 any_environ); try apply extend_prop;
-try apply extend_tc_nosignedover.
-all:
-simple_if_tac; try apply extend_prop; try apply extend_tc_nosignedover.
-Qed.
+Definition tc_lvalue {CS: compspecs} (Delta: tycontext) (e: expr) : assert :=
+  assert_of (denote_tc_assert (typecheck_lvalue Delta e)).
 
-Lemma boxy_orp {A} `{H : ageable A}:
-     forall (M: modality) , reflexive _ (app_mode M) ->
-      forall P Q, boxy M P -> boxy M Q -> boxy M (P || Q).
-Proof.
-destruct M;
-intros.
-simpl in *.
-apply boxy_i; intros; auto.
-destruct H4; [left|right];
-eapply boxy_e; eauto.
-Qed.
+Definition tc_temp_id {CS: compspecs} (id : positive) (ty : type)
+  (Delta : tycontext) (e : expr) : assert :=
+  assert_of (denote_tc_assert (typecheck_temp_id id ty Delta e)).
 
-Lemma extend_tc_orp:
- forall {CS: compspecs} A B rho,
-   boxy extendM (denote_tc_assert A rho) ->
-   boxy extendM (denote_tc_assert B rho) ->
-   boxy extendM (denote_tc_assert (tc_orp A B) rho).
-Proof.
-intros.
-rewrite denote_tc_assert_orp.
-apply boxy_orp; auto.
-intros ?; eexists; apply join_comm, core_unit.
-Qed.
+Definition tc_expropt {CS: compspecs} Delta (e: option expr) (t: type) : assert :=
+  match e with None => ⌜t=Ctypes.Tvoid⌝
+                     | Some e' => (tc_expr Delta (Ecast e' t))
+  end.
 
+Definition tc_temp_id_load id tfrom Delta v : assert :=
+local (fun rho => exists tto, (temp_types Delta) !! id = Some tto
+                      /\ tc_val tto (eval_cast tfrom tto (v rho))).
 
-Lemma extend_tc_ilt:
- forall {CS: compspecs} e i rho,
-   boxy extendM (denote_tc_assert (tc_ilt e i) rho).
-Proof.
-intros.
-rewrite denote_tc_assert_ilt'.
-simpl. unfold_lift.
-destruct (eval_expr e rho); try apply extend_prop.
-Qed.
+Ltac extend_tc_prover :=
+  match goal with
+  | |- _ => apply _
+  | |- Absorbing (if ?A then _ else _) => destruct A
+  | |- Absorbing (match ?A with _ => _ end) => destruct A
+  | |- Absorbing (match ?A with _ => _ end _) => destruct A
+  end.
 
-Lemma extend_tc_llt:
- forall {CS: compspecs} e i rho,
-   boxy extendM (denote_tc_assert (tc_llt e i) rho).
+Global Instance denote_tc_assert_absorbing : forall {CS: compspecs} a rho, Absorbing (denote_tc_assert a rho).
 Proof.
-intros.
-rewrite denote_tc_assert_llt'.
-simpl. unfold_lift.
-destruct (eval_expr e rho); try apply extend_prop.
+  intros; induction a; simpl; try apply _; unfold_lift; rewrite /denote_tc_nonzero /denote_tc_iszero /denote_tc_test_eq /denote_tc_test_order
+    /denote_tc_igt /denote_tc_lgt /denote_tc_Zle  /denote_tc_Zge /denote_tc_nodivover /denote_tc_nosignedover /test_eq_ptrs /test_order_ptrs; repeat extend_tc_prover.
 Qed.
 
-Lemma extend_tc_andp':
- forall {CS: compspecs} A B rho,
-   boxy extendM (denote_tc_assert A rho) ->
-   boxy extendM (denote_tc_assert B rho) ->
-   boxy extendM (denote_tc_assert (tc_andp' A B) rho).
+Global Instance tc_expr_absorbing : forall {CS: compspecs} Delta a, Absorbing (tc_expr Delta a).
 Proof.
-intros.
-apply boxy_andp; auto.
-intros ?; eexists; apply join_comm, core_unit.
+  intros; apply monPred_absorbing, _.
 Qed.
 
-Ltac extend_tc_prover := 
-  match goal with
-  | |- _ => solve [immediate]
-  | |- _ => apply extend_prop
-  | |- _ => first
-              [ simple apply extend_tc_bool
-              | simple apply extend_tc_int_or_ptr_type
-              | simple apply extend_tc_andp
-              | simple apply extend_tc_andp'
-              | simple apply extend_tc_Zge
-              | simple apply extend_tc_Zle
-              | simple apply extend_tc_iszero
-              | simple apply extend_tc_nonzero
-              | simple apply extend_tc_nodivover
-              | simple apply extend_tc_nobinover
-              | simple apply extend_tc_samebase
-              | simple apply extend_tc_ilt
-              | simple apply extend_tc_llt
-              | simple apply extend_isCastResultType
-              | simple apply extend_tc_test_eq
-              | simple apply extend_tc_test_order]
-  | |- boxy _ (denote_tc_assert (if ?A then _ else _) _) => destruct A
-  | |- boxy _ (denote_tc_assert match tc_bool ?A _ with _ => _ end _) =>
-             destruct A
-  | |- boxy _ (denote_tc_assert match ?A with Some _ => _ | None => _ end _) =>
-          destruct A
-  end.
-
-Lemma extend_tc_binop: forall {CS: compspecs} Delta e1 e2 b t rho, 
-  boxy extendM (denote_tc_assert (typecheck_expr Delta e1) rho) ->
-  boxy extendM (denote_tc_assert (typecheck_expr Delta e2) rho) ->
-  boxy extendM (denote_tc_assert (isBinOpResultType b e1 e2 t) rho).
+Global Instance tc_exprlist_absorbing : forall {CS: compspecs} Delta t a, Absorbing (tc_exprlist Delta t a).
 Proof.
-intros.
-destruct b;
-unfold isBinOpResultType, tc_int_or_ptr_type, check_pp_int;
-match goal with
-| |- context [classify_add] => destruct (classify_add (typeof e1) (typeof e2)) eqn:C
-| |- context [classify_sub] => destruct (classify_sub (typeof e1) (typeof e2)) eqn:C
-| |- context [classify_cmp] => destruct (classify_cmp (typeof e1) (typeof e2)) eqn:C
-| |- context [classify_shift] => destruct (classify_shift (typeof e1) (typeof e2)) eqn:C
-| |- _ => idtac
-end;
-repeat extend_tc_prover;
-destruct (typeof e1) as [ | [ | | | ] [ | ] ? | [ | ] ? | [ | ] ? | | | | | ];
-destruct (typeof e2) as [ | [ | | | ] [ | ] ? | [ | ] ? | [ | ] ? | | | | | ];
-try inv C; try apply extend_prop;
-unfold binarithType, classify_binarith; repeat extend_tc_prover.
+  intros; apply monPred_absorbing, _.
 Qed.
 
-Lemma extend_tc_expr: forall {CS: compspecs} Delta e rho, boxy extendM (tc_expr Delta e rho)
- with extend_tc_lvalue: forall {CS: compspecs} Delta e rho, boxy extendM (tc_lvalue Delta e rho).
+Global Instance tc_lvalue_absorbing : forall {CS: compspecs} Delta a, Absorbing (tc_lvalue Delta a).
 Proof.
-*
- clear extend_tc_expr.
- intros.
- unfold tc_expr.
- unfold tc_lvalue in extend_tc_lvalue.
-  induction e; simpl;
-  try pose proof (extend_tc_lvalue CS Delta e rho);
-  clear extend_tc_lvalue;
-try solve [
-  repeat extend_tc_prover;
-  try destruct t as [ | [ | | | ] [ | ] ? | [ | ] ? | [ | ] ? | | | | | ];
-  simpl;
-  repeat extend_tc_prover
- ].
- + (* unop *)
-   repeat extend_tc_prover.
-   destruct u; simpl; repeat extend_tc_prover;
-   destruct (typeof e) as [ | [ | | | ] [ | ] ? | [ | ] ? | [ | ] ? | | | | | ];
-   simpl; repeat extend_tc_prover.
-   unfold denote_tc_assert. unfold_lift. apply extend_tc_nosignedover.
-   unfold denote_tc_assert. unfold_lift. apply extend_tc_nosignedover.
-   unfold denote_tc_assert. unfold_lift. apply extend_tc_nosignedover.
-   unfold denote_tc_assert. unfold_lift. apply extend_tc_nosignedover.
-   unfold denote_tc_assert. unfold_lift. apply extend_tc_nosignedover.
- + repeat extend_tc_prover. eapply extend_tc_binop; eauto.
- + 
-  destruct t as [ | [ | | | ] [ | ] ? | [ | ] ? | [ | ] ? | | | | | ];
-  repeat extend_tc_prover;
-   destruct (typeof e) as [ | [ | | | ] [ | ] ? | [ | ] ? | [ | ] ? | | | | | ];
-   simpl; repeat extend_tc_prover.
-   destruct (field_offset (@cenv_cs CS) i (co_members c)) as [[? [|]] | ]; 
-  repeat extend_tc_prover.
-   destruct (union_field_offset (@cenv_cs CS) i (co_members c)) as [[[] [|]] | ]; 
-  repeat extend_tc_prover.
-   destruct (field_offset (@cenv_cs CS) i (co_members c0)) as [[? [|]] | ]; 
-  repeat extend_tc_prover.
-   destruct (union_field_offset (@cenv_cs CS) i (co_members c0)) as [[[] [|]] | ]; 
-  repeat extend_tc_prover.
-*
- clear extend_tc_lvalue.
- intros.
- unfold tc_expr in *.
- unfold tc_lvalue.
- induction e; simpl;
- try specialize (extend_tc_expr CS Delta e rho);
- repeat extend_tc_prover;
- destruct (typeof e) as [ | [ | | | ] [ | ] ? | [ | ] ? | [ | ] ? | | | | | ];
- simpl; repeat extend_tc_prover.
-   destruct (field_offset (@cenv_cs CS) i (co_members c)) as [[? [|]] | ]; 
-  repeat extend_tc_prover.
-   destruct (union_field_offset (@cenv_cs CS) i (co_members c)) as [[[] [|]] | ]; 
-  repeat extend_tc_prover.
+  intros; apply monPred_absorbing, _.
 Qed.
 
-Lemma extend_tc_exprlist: forall {CS: compspecs} Delta t e rho, boxy extendM (tc_exprlist Delta t e rho).
+Global Instance tc_expropt_absorbing: forall {CS: compspecs} Delta e t, Absorbing (tc_expropt Delta e t).
 Proof.
- intros. unfold tc_exprlist.
-  revert e; induction t; destruct e; intros; simpl; auto;
-  try apply extend_prop.
- repeat apply extend_tc_andp; auto.
- apply extend_tc_expr.
- try simple apply extend_isCastResultType.
+  intros. unfold tc_expropt.
+  destruct e; apply _.
 Qed.
 
-Lemma extend_tc_expropt: forall {CS: compspecs} Delta e t rho, boxy extendM (tc_expropt Delta e t rho).
+Global Instance tc_temp_id_absorbing : forall {CS: compspecs} id ty Delta a, Absorbing (tc_temp_id id ty Delta a).
 Proof.
-  intros. unfold tc_expropt.
-  destruct e.
-  + apply extend_tc_expr.
-  + apply extend_prop.
+  intros; apply monPred_absorbing, _.
 Qed.
 
-Definition extendM_refl_rmap := @extendM_refl rmap _ _ _ _ _.
-
-#[export] Hint Resolve extend_tc_expr extend_tc_temp_id extend_tc_temp_id_load extend_tc_exprlist extend_tc_expropt extend_tc_lvalue : core.
-#[export] Hint Resolve extendM_refl_rmap : core.
-
-Require Import VST.veric.binop_lemmas4.
-Require Import VST.veric.expr_lemmas.
-
 Lemma tc_bool_i:
- forall {cs: compspecs} b e rho w,
-   b = true -> app_pred (denote_tc_assert (tc_bool b e) rho) w.
+ forall {cs: compspecs} b e rho,
+   b = true -> True ⊢ denote_tc_assert (tc_bool b e) rho.
 Proof.
-intros. subst. apply I.
+intros. subst. auto.
 Qed.
 
 Section CENV_SUB.
@@ -498,409 +90,140 @@ Section CENV_SUB.
   (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS')).
 
  Definition is_tc_FF (a: tc_assert) :=
-  match a with tc_FF _ => True | _ => False end.
+  match a with tc_FF _ => True%type | _ => False%type end.
 
  Definition dec_tc_FF (a: tc_assert) : {is_tc_FF a}+{~is_tc_FF a}.
  Proof. destruct a; simpl; auto. Qed.
 
 
-  Lemma tc_nodivover'_cenv_sub a1 a2 rho w:
-   app_pred (@denote_tc_assert CS (@tc_nodivover' a1 a2) rho) w ->
-   app_pred (@denote_tc_assert CS' (@tc_nodivover' a1 a2) rho) w.
+  Lemma tc_test_eq_cenv_sub a1 a2 rho:
+   denote_tc_assert(CS := CS) (tc_test_eq(CS := CS) a1 a2) rho ⊢
+   denote_tc_assert(CS := CS') (tc_test_eq(CS := CS') a1 a2) rho.
   Proof.
-  simpl. unfold_lift.
-  destruct (Val.eq (@eval_expr CS a1 rho) Vundef).
-  rewrite e. simpl. tauto.
-  destruct (Val.eq (@eval_expr CS a2 rho) Vundef).
-  rewrite e. destruct (@eval_expr CS a1 rho); simpl; intro H; contradiction H.
-  rewrite <- ?(eval_expr_cenv_sub_eq CSUB _ _ n).
-  rewrite <- ?(eval_expr_cenv_sub_eq CSUB _ _ n0).
-  auto.
-  Qed.  
-
-
-  Lemma tc_samebase_cenv_sub a1 a2 rho w:
-   app_pred (@denote_tc_assert CS (@tc_samebase a1 a2) rho) w ->
-   app_pred (@denote_tc_assert CS' (@tc_samebase a1 a2) rho) w.
-  Proof.
-  simpl. unfold_lift.
-  destruct (Val.eq (@eval_expr CS a1 rho) Vundef).
-  rewrite e. simpl. tauto.
-  destruct (Val.eq (@eval_expr CS a2 rho) Vundef).
-  rewrite e. destruct (@eval_expr CS a1 rho); simpl; intro H; contradiction H.
-  rewrite <- ?(eval_expr_cenv_sub_eq CSUB _ _ n).
-  rewrite <- ?(eval_expr_cenv_sub_eq CSUB _ _ n0).
-  auto.
-  Qed.  
-
-
-  Lemma tc_nonzero'_cenv_sub a rho w:
-   app_pred (@denote_tc_assert CS (@tc_nonzero' a) rho) w ->
-   app_pred (@denote_tc_assert CS' (@tc_nonzero' a) rho) w.
-  Proof.
-  simpl. unfold_lift.
-  destruct (Val.eq (@eval_expr CS a rho) Vundef).
-  rewrite e. simpl. tauto.
-  rewrite <- ?(eval_expr_cenv_sub_eq CSUB _ _ n).
-  auto.
-  Qed.  
-
-  Lemma tc_ilt'_cenv_sub a i rho w:
-   app_pred (@denote_tc_assert CS (@tc_ilt' a i) rho) w ->
-   app_pred (@denote_tc_assert CS' (@tc_ilt' a i) rho) w.
-  Proof.
-  simpl. unfold_lift.
-  destruct (Val.eq (@eval_expr CS a rho) Vundef).
-  rewrite e. simpl. tauto.
-  rewrite <- ?(eval_expr_cenv_sub_eq CSUB _ _ n).
-  auto.
-  Qed.  
-
-  Lemma tc_llt'_cenv_sub a i rho w:
-   app_pred (@denote_tc_assert CS (@tc_llt' a i) rho) w ->
-   app_pred (@denote_tc_assert CS' (@tc_llt' a i) rho) w.
-  Proof.
-  simpl. unfold_lift.
-  destruct (Val.eq (@eval_expr CS a rho) Vundef).
-  rewrite e. simpl. tauto.
-  rewrite <- ?(eval_expr_cenv_sub_eq CSUB _ _ n).
-  auto.
-  Qed.  
+    rewrite !denote_tc_assert_test_eq'.
+    apply denote_tc_assert_cenv_sub; auto.
+  Qed.
 
-  Lemma tc_test_eq'_cenv_sub a1 a2 rho w:
-   app_pred (@denote_tc_assert CS (@tc_test_eq' a1 a2) rho) w ->
-   app_pred (@denote_tc_assert CS' (@tc_test_eq' a1 a2) rho) w.
-  Proof.
-  simpl. unfold_lift.
-  destruct (Val.eq (@eval_expr CS a1 rho) Vundef).
-  rewrite e. simpl. tauto.
-  destruct (Val.eq (@eval_expr CS a2 rho) Vundef).
-  rewrite e. destruct (@eval_expr CS a1 rho); simpl; intro H; contradiction H.
-  rewrite <- ?(eval_expr_cenv_sub_eq CSUB _ _ n).
-  rewrite <- ?(eval_expr_cenv_sub_eq CSUB _ _ n0).
-  auto.
-  Qed.  
+Lemma entails_refl : forall (P : mpred), P ⊢ P.
+Proof. done. Qed.
 
-  Lemma tc_test_eq_cenv_sub a1 a2 rho w:
-   app_pred (@denote_tc_assert CS (@tc_test_eq CS a1 a2) rho) w ->
-   app_pred (@denote_tc_assert CS' (@tc_test_eq CS' a1 a2) rho) w.
-  Proof.
-  rewrite !denote_tc_assert_test_eq'.
-  apply tc_test_eq'_cenv_sub.
-  Qed.
+Lemma pure_intro_l : forall (P : Prop) (Q R : mpred), P -> (Q ⊢ R) -> Q ⊢ ⌜P⌝ ∧ R.
+Proof.
+  intros ???? ->; iIntros "$"; auto.
+Qed.
 
-  Lemma tc_test_order'_cenv_sub a1 a2 rho w:
-   app_pred (@denote_tc_assert CS (@tc_test_order' a1 a2) rho) w ->
-   app_pred (@denote_tc_assert CS' (@tc_test_order' a1 a2) rho) w.
-  Proof.
-  simpl. unfold_lift.
-  destruct (Val.eq (@eval_expr CS a1 rho) Vundef).
-  rewrite e. simpl. tauto.
-  destruct (Val.eq (@eval_expr CS a2 rho) Vundef).
-  rewrite e. destruct (@eval_expr CS a1 rho); simpl; intro H; contradiction H.
-  rewrite <- ?(eval_expr_cenv_sub_eq CSUB _ _ n).
-  rewrite <- ?(eval_expr_cenv_sub_eq CSUB _ _ n0).
-  auto.
-  Qed.
+Lemma pure_intro_r : forall (P : Prop) (Q R : mpred), P -> (Q ⊢ R) -> Q ⊢ R ∧ ⌜P⌝.
+Proof.
+  intros ???? ->; iIntros "$"; auto.
+Qed.
 
 Ltac tc_expr_cenv_sub_tac := 
 repeat
 match goal with
- | H: app_pred (@denote_tc_assert _ (tc_andp _ _) _) _ |- _ =>
-     rewrite denote_tc_assert_andp in H; destruct H
- | |- app_pred (@denote_tc_assert _ (tc_andp _ _) _) _ =>
-     rewrite denote_tc_assert_andp; split
- | H: app_pred (@denote_tc_assert _ (tc_andp' _ _) _) _ |- _ =>
-     destruct H
- | |- app_pred (@denote_tc_assert _ (tc_andp' _ _) _) _ =>
-      split
- | |- _ => solve [simple apply tc_bool_i; auto]
- | H: app_pred (@denote_tc_assert _ (tc_bool _ _) _) _ |- _ =>
-      apply tc_bool_e in H; rewrite ?H in *
- | |- app_pred (@denote_tc_assert _ (tc_bool true _) _) _ =>
-     apply I
-  | |- app_pred (@denote_tc_assert _ (tc_isptr ?a) _) _  =>
-       apply (isptr_eval_expr_cenv_sub CSUB); auto
- | |- app_pred (@denote_tc_assert _ tc_TT _) _ => apply I
- | |- app_pred (@denote_tc_assert _ (tc_bool (complete_type _ _) _) _) _ =>
-           solve [rewrite (cenv_sub_complete_type _ _ CSUB); simpl; auto]
- | |- context [tc_int_or_ptr_type] =>
-           solve [unfold tc_int_or_ptr_type in *; tc_expr_cenv_sub_tac]
- | |- _ => solve [simple apply tc_nodivover'_cenv_sub; auto]
- | |- _ => solve [simple apply tc_samebase_cenv_sub; auto]
- | |- _ => solve [simple apply tc_nonzero'_cenv_sub; auto]
- | |- _ => solve [simple apply tc_ilt'_cenv_sub; auto]
- | |- _ => solve [simple apply tc_llt'_cenv_sub; auto]
- | |- _ => solve [simple apply tc_test_eq'_cenv_sub; auto]
+ | |- @denote_tc_assert _ _ _ (tc_andp _ _) _ ⊢ _ =>
+     rewrite !denote_tc_assert_andp
+ | |- _ ∧ @denote_tc_assert _ _ _ (tc_bool (complete_type _ _) _) _ ⊢ _ =>
+        rewrite (tc_bool_e (complete_type _ _)); apply bi.pure_elim_r; intros
+ | |- @denote_tc_assert _ _ _ (tc_bool (complete_type _ _) _) _ ∧ _ ⊢ _ =>
+        rewrite tc_bool_e; apply bi.pure_elim_l; intros
+ | |- _ ⊢ @denote_tc_assert _ _ _ (tc_bool (complete_type _ _) _) _ ∧ _ =>
+      rewrite -> (cenv_sub_complete_type _ _ CSUB) by assumption; apply pure_intro_l; first apply I
+ | |- _ ⊢ _ ∧ @denote_tc_assert _ _ _ (tc_bool (complete_type _ _) _) _ =>
+      rewrite -> (cenv_sub_complete_type _ _ CSUB) by assumption; apply pure_intro_r; first apply I
+ | |- _ ⊢ (_ ∧ @denote_tc_assert _ _ _ (tc_bool (complete_type _ _) _) _) ∧ _ =>
+      do 2 rewrite (bi.and_comm _ (@denote_tc_assert _ _ _ (tc_bool (complete_type _ _) _) _)); rewrite -!assoc
+ | |- _ ∧ _ ⊢ _ ∧ _ => apply bi.and_mono
  | |- _ => solve [simple apply tc_test_eq_cenv_sub; auto]
- | |- _ => solve [simple apply tc_test_order'_cenv_sub; auto]
- | |- app_pred (denote_tc_assert (tc_bool ?A _) _) _ =>
+ | |- @denote_tc_assert _ _ _ (tc_bool ?A _) _ ⊢ _ =>
     match A with context [sizeof ?t] => unfold sizeof;
-     rewrite (cenv_sub_sizeof CSUB t) by assumption;
-     solve [simple apply tc_bool_i; auto]
+     rewrite -> (cenv_sub_sizeof CSUB t) by assumption
    end
 end;
   try solve [eauto].
 
-
 Ltac tc_expr_cenv_sub_tac2 :=  
  (match goal with
-   | H: app_pred (@denote_tc_assert _ match @eval_expr CS ?a ?rho with _ => _ end _) _ |- _ =>
+   | |- @denote_tc_assert _ _ _ match @eval_expr CS ?a ?rho with _ => _ end _ ⊢ _ =>
+
         let H' := fresh in
-        destruct (Val.eq (@eval_expr CS a rho) Vundef) as [H' | H' ];
-         [ rewrite H' in H;
+        destruct (Val.eq (@eval_expr CS a rho) Vundef) as [H' | H'];
+         [ rewrite H';
             try match goal with |- context [@eval_expr CS' a rho] =>
              destruct (@eval_expr CS' a rho) eqn:?
            end
          | rewrite <- ?(eval_expr_cenv_sub_eq CSUB _ _ H');
            destruct (@eval_expr CS a rho) eqn:?]
-    | |- app_pred (@denote_tc_assert _ match @eval_expr CS' ?a ?rho with _ => _ end _) _ =>
+    | |- _ ⊢ @denote_tc_assert _ _ _ match @eval_expr CS' ?a ?rho with _ => _ end _ =>
        destruct (@eval_expr CS' a rho) eqn:?H
-    | |- app_pred (@denote_tc_assert _ (if _ then tc_TT else _) _) _ =>
-    simple_if_tac; [apply I | ]
+    | |- _ ⊢ @denote_tc_assert _ _ _ (if _ then tc_TT else _) _ =>
+    simple_if_tac; [auto | ]
    end;
   try assumption;
   try (simple apply (denote_tc_assert_cenv_sub CSUB); auto)).
 
-  Lemma tc_nobinover_cenv_sub op a1 a2 rho w:
-   app_pred (@denote_tc_assert CS (@tc_nobinover op CS a1 a2) rho) w ->
-   app_pred (@denote_tc_assert CS' (@tc_nobinover op CS' a1 a2) rho) w.
+  Lemma tc_nobinover_cenv_sub op a1 a2 rho:
+   denote_tc_assert(CS := CS) (tc_nobinover op (CS := CS) a1 a2) rho ⊢
+   denote_tc_assert(CS := CS') (tc_nobinover op (CS := CS') a1 a2) rho.
  Proof.
   unfold tc_nobinover.
   unfold if_expr_signed.
-  intros.
   destruct (typeof a1) as [ | _ [ | ] | [ | ] | [ | ] | | | | | ]; 
   destruct (typeof a2) as [ | _ [ | ] | [ | ]  | | | | | | ]; 
   tc_expr_cenv_sub_tac; repeat tc_expr_cenv_sub_tac2.
  Qed.
-  
+
 Lemma tc_expr_cenv_sub_unop:
  forall 
- (u : unary_operation)
+ (u : Cop.unary_operation)
  (a : expr)
  (t : type)
  (rho : environ)
  (Delta : tycontext)
- (w : rmap)
- (T : (@tc_expr CS Delta (Eunop u a t) rho) w)
- (IHa : (@tc_expr CS Delta a rho) w -> (@tc_expr CS' Delta a rho) w),
- (@tc_expr CS' Delta (Eunop u a t) rho) w.
+ (IHa : @tc_expr CS Delta a rho ⊢ @tc_expr CS' Delta a rho),
+ @tc_expr CS Delta (Eunop u a t) rho ⊢
+ @tc_expr CS' Delta (Eunop u a t) rho.
 Proof.
   intros.
-  unfold tc_expr in *; simpl in T|-*.
-  tc_expr_cenv_sub_tac.
-  destruct u; simpl in H|-*;
-  destruct (typeof a) as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ]; 
+  unfold tc_expr in *; unfold typecheck_expr; fold typecheck_expr.
   tc_expr_cenv_sub_tac.
-  unfold tc_int_or_ptr_type in *;
-  tc_expr_cenv_sub_tac.  
-  all: try apply (denote_tc_nosignedover_eval_expr_cenv_sub CSUB); auto.
- pose proof (denote_tc_nosignedover_eval_expr_cenv_sub CSUB rho
-                        (Econst_long Int64.zero (Ctypes.Tlong Signed a0)) a w Z.sub Signed ).
- simpl eval_expr in H2. 
-  unfold denote_tc_assert in H1|-*. 
-  replace (typeof (Econst_long Int64.zero (Ctypes.Tlong Signed a0)))
-  with (Ctypes.Tlong Signed a0) in * by (destruct a0; reflexivity).
-  simpl in H1|-*.
-  destruct (typeof a); auto.
-  destruct s; auto.
-  apply (denote_tc_nosignedover_eval_expr_cenv_sub CSUB rho
-                        (Econst_long Int64.zero (Ctypes.Tlong Signed a0)) a w Z.sub Unsigned); 
-    auto.
-Qed.
-
-
-Lemma denote_tc_assert_andp_i:
-  forall x y rho w, 
-   app_pred (denote_tc_assert x rho) w ->
-   app_pred (denote_tc_assert y rho) w ->
-   app_pred (denote_tc_assert (tc_andp x y) rho) w.
-Proof.
-intros.
-rewrite denote_tc_assert_andp. split; auto.
-Qed.
-
-Lemma denote_tc_assert_andp'_imp:
- forall x x' y y' rho w,
-  (app_pred (@denote_tc_assert CS x rho) w -> app_pred (@denote_tc_assert CS' x' rho) w) ->
-  (app_pred (@denote_tc_assert CS y rho) w -> app_pred (@denote_tc_assert CS' y' rho) w) ->
-  app_pred (@denote_tc_assert CS (tc_andp' x y) rho) w ->
-  app_pred (@denote_tc_assert CS' (tc_andp' x' y') rho) w.
-Proof.
-intros.
-destruct H1.
-split; auto.
-Qed.
-
-Lemma denote_tc_assert_andp_imp:
- forall x x' y y' rho w,
-  (app_pred (@denote_tc_assert CS x rho) w -> app_pred (@denote_tc_assert CS' x' rho) w) ->
-  (app_pred (@denote_tc_assert CS y rho) w -> app_pred (@denote_tc_assert CS' y' rho) w) ->
-  app_pred (@denote_tc_assert CS (tc_andp x y) rho) w ->
-  app_pred (@denote_tc_assert CS' (tc_andp x' y') rho) w.
-Proof.
-intros.
-rewrite @denote_tc_assert_andp in H1|-*.
-eapply denote_tc_assert_andp'_imp; eauto.
-Qed.
-
-Lemma denote_tc_assert_andp'_imp2:
- forall x x' y y' rho w,
-  (app_pred (@denote_tc_assert CS y rho) w -> 
-   app_pred (@denote_tc_assert CS x rho) w -> 
-   app_pred (@denote_tc_assert CS' x' rho) w) ->
-  (app_pred (@denote_tc_assert CS x rho) w ->
-   app_pred (@denote_tc_assert CS y rho) w ->
-   app_pred (@denote_tc_assert CS' y' rho) w) ->
-  app_pred (@denote_tc_assert CS (tc_andp' x y) rho) w ->
-  app_pred (@denote_tc_assert CS' (tc_andp' x' y') rho) w.
-Proof.
-intros.
-destruct H1.
-split; auto.
-Qed.
-
-Lemma denote_tc_assert_andp_imp2:
- forall x x' y y' rho w,
-  (app_pred (@denote_tc_assert CS y rho) w -> 
-   app_pred (@denote_tc_assert CS x rho) w -> 
-   app_pred (@denote_tc_assert CS' x' rho) w) ->
-  (app_pred (@denote_tc_assert CS x rho) w ->
-   app_pred (@denote_tc_assert CS y rho) w ->
-   app_pred (@denote_tc_assert CS' y' rho) w) ->
-  app_pred (@denote_tc_assert CS (tc_andp x y) rho) w ->
-  app_pred (@denote_tc_assert CS' (tc_andp x' y') rho) w.
-Proof.
-intros.
-rewrite @denote_tc_assert_andp in H1|-*.
-eapply denote_tc_assert_andp'_imp2; eauto.
-Qed.
-
-Lemma tc_bool_cenv_sub:
- forall b e rho w,
-  app_pred (@denote_tc_assert CS (tc_bool b e) rho) w ->
-  app_pred (@denote_tc_assert CS' (tc_bool b e) rho) w.
-Proof.
-intros.
-apply tc_bool_e in H.
-apply tc_bool_i.
-auto.
+  destruct u; simpl;
+  destruct (typeof a) as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ];
+  tc_expr_cenv_sub_tac; try apply (denote_tc_assert_cenv_sub CSUB).
 Qed.
 
 Lemma tc_complete_type_cenv_sub:
- forall t e rho w,
-  app_pred (@denote_tc_assert CS (tc_bool (complete_type (@cenv_cs CS) t) e) rho) w ->
-  app_pred (@denote_tc_assert CS' (tc_bool (complete_type (@cenv_cs CS') t) e) rho) w.
+ forall t e rho,
+  denote_tc_assert(CS := CS) (tc_bool (complete_type (@cenv_cs CS) t) e) rho ⊢
+  denote_tc_assert(CS := CS') (tc_bool (complete_type (@cenv_cs CS') t) e) rho.
 Proof.
 intros.
-apply tc_bool_e in H.
-apply tc_bool_i.
+unfold tc_bool.
+destruct (complete_type _ _) eqn: Hc; [|iIntros "[]"].
 rewrite (cenv_sub_complete_type _ _ CSUB); auto.
 Qed.
 
-Local Lemma tc_andp'_intro:
-  forall x y rho w Q P,
-   (app_pred (@denote_tc_assert CS x rho) w ->
-    app_pred (@denote_tc_assert CS y rho) w ->
-    Q -> P) ->
-   (app_pred (@denote_tc_assert CS (tc_andp' x y) rho) w -> Q -> P).
-Proof.
-intros.
-destruct H; auto.
-Qed.
-
-Local Lemma tc_andp_intro:
-  forall x y rho w Q P,
-   (app_pred (@denote_tc_assert CS x rho) w ->
-    app_pred (@denote_tc_assert CS y rho) w ->
-    Q -> P) ->
-   (app_pred (@denote_tc_assert CS (tc_andp x y) rho) w -> Q -> P).
-Proof.
-intros.
-rewrite @denote_tc_assert_andp in H.
-destruct H; auto.
-Qed.
-
-Local Lemma tc_bool_intro:
-  forall b e rho w Q P,
-   (b = true -> Q -> P) ->
-   (app_pred (@denote_tc_assert CS (tc_bool b e) rho) w -> Q -> P).
-Proof.
-intros.
-apply tc_bool_e in H. auto.
-Qed.
-
-Lemma tc_check_pp_int'_cenv_sub:
- forall a1 a2 op t e rho w,
- app_pred (@denote_tc_assert CS (check_pp_int' a1 a2 op t e) rho) w ->
- app_pred (@denote_tc_assert CS' (check_pp_int' a1 a2 op t e) rho) w.
-Proof.
-unfold check_pp_int'.
-intros.
-destruct op; try contradiction H; revert H;
- (apply denote_tc_assert_andp'_imp; 
-  [ | apply tc_bool_cenv_sub]).
-all: try simple apply tc_test_eq'_cenv_sub.
-all: try simple apply tc_test_order'_cenv_sub.
-Qed.
-
 Lemma tc_expr_cenv_sub_binop:
  forall 
- (b : binary_operation)
+ (b : Cop.binary_operation)
  (a1 a2 : expr)
  (t : type)
  (rho : environ)
  (Delta : tycontext)
- (w : rmap)
- (T : (@tc_expr CS Delta (Ebinop b a1 a2 t) rho) w)
- (IHa1 : (@tc_expr CS Delta a1 rho) w -> (@tc_expr CS' Delta a1 rho) w)
- (IHa2 : (@tc_expr CS Delta a2 rho) w -> (@tc_expr CS' Delta a2 rho) w),
- (@tc_expr CS' Delta (Ebinop b a1 a2 t) rho) w.
+ (IHa1 : @tc_expr CS Delta a1 rho ⊢ @tc_expr CS' Delta a1 rho)
+ (IHa2 : @tc_expr CS Delta a2 rho ⊢ @tc_expr CS' Delta a2 rho),
+ @tc_expr CS Delta (Ebinop b a1 a2 t) rho ⊢
+ @tc_expr CS' Delta (Ebinop b a1 a2 t) rho.
 Proof.
   intros.
-  rename T into H.
-  revert H.
   unfold tc_expr, typecheck_expr;
-  fold (@typecheck_expr CS);
-  fold (@typecheck_expr CS').
-  repeat apply denote_tc_assert_andp_imp; auto.
- clear - CSUB.
-  rewrite !den_isBinOpR.
-  cbv zeta.
-   repeat match goal with |- _ -> app_pred (denote_tc_assert match ?A with _ => _ end _) _ =>
-      destruct A; auto
-   end;
-  unfold tc_int_or_ptr_type.
-Local Ltac andp_simpl := 
- repeat first [simple apply tc_andp'_intro
-                  |simple apply tc_andp_intro
-                  |simple apply tc_bool_intro; intro
-                  |match goal with |- _ -> _ -> _ => intros _ end
-                  ].
-
-all:
- repeat
- first [simple apply denote_tc_assert_andp'_imp2; andp_simpl
-        |simple apply denote_tc_assert_andp_imp2; andp_simpl
-        |simple apply tc_bool_cenv_sub
-        |apply isptr_eval_expr_cenv_sub; auto
-        |simple apply tc_complete_type_cenv_sub
-        |simple apply tc_nobinover_cenv_sub
-        |simple apply tc_nodivover'_cenv_sub
-        |simple apply tc_samebase_cenv_sub
-        |simple apply tc_nonzero'_cenv_sub
-        |simple apply tc_ilt'_cenv_sub
-        |simple apply tc_llt'_cenv_sub
-        |simple apply tc_test_eq'_cenv_sub
-        |simple apply tc_test_eq_cenv_sub
-        |simple apply tc_test_order'_cenv_sub
-        |simple apply tc_check_pp_int'_cenv_sub
-        |unfold sizeof; rewrite (cenv_sub_sizeof CSUB) by assumption
-        | match goal with |- _ -> app_pred (denote_tc_assert (binarithType' _ _ _ _ _) _) _ =>
-               unfold binarithType'; destruct (classify_binarith' _ _)
-          end
-        | solve [intro H; contradiction H]
-     ].
+  fold (typecheck_expr(CS := CS));
+  fold (typecheck_expr(CS := CS')); simpl.
+  tc_expr_cenv_sub_tac.
+  rewrite /isBinOpResultType.
+  repeat match goal with |- denote_tc_assert match ?A with _ => _ end _ ⊢ _ =>
+    destruct A eqn: ?Hcase
+  end; tc_expr_cenv_sub_tac; rewrite ?denote_tc_assert_nonzero' ?denote_tc_assert_nodivover' ?denote_tc_assert_ilt' ?denote_tc_assert_llt' ?denote_tc_assert_test_order';
+    try apply (denote_tc_assert_cenv_sub CSUB); try apply tc_nobinover_cenv_sub.
 Qed.
 
 Lemma tc_expr_cenv_sub_cast:
@@ -909,65 +232,52 @@ Lemma tc_expr_cenv_sub_cast:
  (t : type)
  (rho : environ)
  (Delta : tycontext)
- (w : rmap)
- (T : (@tc_expr CS Delta (Ecast a t) rho) w)
- (IHa : (@tc_expr CS Delta a rho) w -> (@tc_expr CS' Delta a rho) w),
- (@tc_expr CS' Delta (Ecast a t) rho) w.
+ (IHa : @tc_expr CS Delta a rho ⊢ @tc_expr CS' Delta a rho),
+ @tc_expr CS Delta (Ecast a t) rho ⊢
+ @tc_expr CS' Delta (Ecast a t) rho.
 Proof.
   intros.
-  unfold tc_expr in *; simpl in T|-*.
-  tc_expr_cenv_sub_tac.
-   unfold isCastResultType in *;
-   repeat match goal with |- app_pred (denote_tc_assert match ?A with _ => _ end _) _ =>
-      destruct A; tc_expr_cenv_sub_tac
-   end;
-   tc_expr_cenv_sub_tac; try simple_if_tac;
-   try solve [simpl in *; super_unfold_lift;
-                  try rewrite denote_tc_assert_iszero in H0;
-                  try rewrite denote_tc_assert_iszero in H1;
-                  rewrite ?denote_tc_assert_iszero;
-                 destruct (Val.eq (@eval_expr CS a rho) Vundef) as [e|n];
-                  [rewrite e in *; contradiction | 
-                    rewrite <- ?(eval_expr_cenv_sub_eq CSUB _ _ n); auto]].
+  unfold tc_expr, typecheck_expr; fold (typecheck_expr(CS := CS)); fold (typecheck_expr(CS := CS')); simpl.
+  unfold isCastResultType; tc_expr_cenv_sub_tac.
+  repeat match goal with |- denote_tc_assert match ?A with _ => _ end _ ⊢ _ =>
+    destruct A eqn: ?Hcase
+  end; tc_expr_cenv_sub_tac; rewrite ?denote_tc_assert_iszero';
+    try apply (denote_tc_assert_cenv_sub CSUB).
+  all: simple_if_tac; rewrite ?denote_tc_assert_iszero'; apply (denote_tc_assert_cenv_sub CSUB).
 Qed.
 
 Lemma tc_expr_cenv_sub_field:
  forall
  (a : expr)
-  (tc_lvalue_cenv_sub : forall  (rho : environ)
-                       (Delta : tycontext) (w : rmap),
-                     (@tc_lvalue CS Delta a rho) w ->
-                     (@tc_lvalue CS' Delta a rho) w)
- (i : ident)
- (t : type) 
  (rho : environ)
  (Delta : tycontext)
- (w : rmap)
- (T : (@tc_expr CS Delta (Efield a i t) rho) w)
- (IHa : (@tc_expr CS Delta a rho) w -> (@tc_expr CS' Delta a rho) w),
- (@tc_expr CS' Delta (Efield a i t) rho) w.
+ (tc_lvalue_cenv_sub : @tc_lvalue CS Delta a rho ⊢ @tc_lvalue CS' Delta a rho)
+ (i : ident)
+ (t : type) 
+ (IHa : @tc_expr CS Delta a rho ⊢ @tc_expr CS' Delta a rho),
+ @tc_expr CS Delta (Efield a i t) rho ⊢
+ @tc_expr CS' Delta (Efield a i t) rho.
 Proof.
-intros.
-  unfold tc_expr in *; simpl in T|-*.
-  tc_expr_cenv_sub_tac.
-    destruct (access_mode t); tc_expr_cenv_sub_tac.
-    destruct (typeof a); tc_expr_cenv_sub_tac.
+  intros.
+  unfold tc_expr, typecheck_expr; fold (typecheck_lvalue(CS := CS)); fold (typecheck_lvalue(CS := CS')); simpl.
+  destruct (access_mode t); tc_expr_cenv_sub_tac.
+  destruct (typeof a); tc_expr_cenv_sub_tac.
    *
-    destruct ((@cenv_cs CS) ! i0) eqn:?; try contradiction.
+    destruct ((@cenv_cs CS) !! i0) eqn:?; try iIntros "[]".
     assert (H2 := CSUB i0); hnf in H2; rewrite Heqo in H2; rewrite H2.
-    destruct (field_offset (@cenv_cs CS) i (co_members c)) as [[? [|]]|] eqn:?H; try contradiction.
-    eapply (field_offset_stable (@cenv_cs CS) (@cenv_cs CS')) in H1; try eassumption.
-    rewrite H1; auto.
+    destruct (field_offset (@cenv_cs CS) i (co_members c)) as [[? [|]]|] eqn:?H; try iIntros "[]".
+    eapply (field_offset_stable (@cenv_cs CS) (@cenv_cs CS')) in H; try eassumption.
+    rewrite H; auto.
     intros.
-    assert (H2' := CSUB id); hnf in H2'; rewrite H3 in H2'; auto.
+    assert (H2' := CSUB id); hnf in H2'; rewrite H0 in H2'; auto.
     apply cenv_consistent.
    *
-    destruct ((@cenv_cs CS) ! i0) eqn:?; try contradiction.
+    destruct ((@cenv_cs CS) !! i0) eqn:?; try iIntros "[]".
     assert (H2 := CSUB i0); hnf in H2; rewrite Heqo in H2; rewrite H2.
-    destruct (union_field_offset (@cenv_cs CS) i (co_members c)) as [[[] [|]]|] eqn:?H; try contradiction.
-    rewrite <- (union_field_offset_stable (@cenv_cs CS) (@cenv_cs CS')) in H1; try eassumption.
-    rewrite H1. auto.
-   intros. specialize (CSUB id).  hnf in CSUB.  rewrite H3 in CSUB; auto.
+    destruct (union_field_offset (@cenv_cs CS) i (co_members c)) as [[[] [|]]|] eqn:?H; try iIntros "[]".
+    rewrite <- (union_field_offset_stable (@cenv_cs CS) (@cenv_cs CS')) in H; try eassumption.
+    rewrite H. auto.
+   intros. specialize (CSUB id).  hnf in CSUB. rewrite -> H0 in CSUB; auto.
    apply co_consistent_complete. 
    apply (cenv_consistent i0); auto.
 Qed.
@@ -979,88 +289,85 @@ Lemma tc_lvalue_cenv_sub_field:
  (t : type)
  (rho : environ)
  (Delta : tycontext)
- (w : rmap) 
- (T : (@denote_tc_assert CS (@typecheck_lvalue CS Delta (Efield a i t)) rho) w)
- (IHa : (@denote_tc_assert CS (@typecheck_lvalue CS Delta a) rho) w ->
-         (@denote_tc_assert CS' (@typecheck_lvalue CS' Delta a) rho) w),
-(@denote_tc_assert CS' (@typecheck_lvalue CS' Delta (Efield a i t)) rho) w.
+ (IHa : denote_tc_assert(CS := CS) (typecheck_lvalue(CS := CS) Delta a) rho ⊢
+        denote_tc_assert(CS := CS') (typecheck_lvalue(CS := CS') Delta a) rho),
+ denote_tc_assert(CS := CS) (typecheck_lvalue(CS := CS) Delta (Efield a i t)) rho ⊢
+ denote_tc_assert(CS := CS') (typecheck_lvalue(CS := CS') Delta (Efield a i t)) rho.
 Proof.
-   intros.
-   simpl in T|-*;  tc_expr_cenv_sub_tac.
-    destruct (typeof a); tc_expr_cenv_sub_tac.
+  intros.
+  unfold typecheck_lvalue; fold (typecheck_lvalue(CS := CS)); fold (typecheck_lvalue(CS := CS')); simpl.
+  tc_expr_cenv_sub_tac.
+  destruct (typeof a); tc_expr_cenv_sub_tac.
    *
-    destruct ((@cenv_cs CS) ! i0) eqn:?; try contradiction.
+    destruct ((@cenv_cs CS) !! i0) eqn:?; try iIntros "[]".
     assert (H2 := CSUB i0); hnf in H2; rewrite Heqo in H2; rewrite H2.
-    destruct (field_offset (@cenv_cs CS) i (co_members c))  as [[? [|]]|] eqn:?H; try contradiction.
-    eapply (field_offset_stable (@cenv_cs CS) (@cenv_cs CS')) in H1; try eassumption.
-    rewrite H1; auto.
+    destruct (field_offset (@cenv_cs CS) i (co_members c)) as [[? [|]]|] eqn:?H; try iIntros "[]".
+    eapply (field_offset_stable (@cenv_cs CS) (@cenv_cs CS')) in H; try eassumption.
+    rewrite H; auto.
     intros.
-    assert (H2' := CSUB id); hnf in H2'; rewrite H3 in H2'; auto.
+    assert (H2' := CSUB id); hnf in H2'; rewrite H0 in H2'; auto.
     apply cenv_consistent.
    *
-    destruct ((@cenv_cs CS) ! i0) eqn:?; try contradiction.
+    destruct ((@cenv_cs CS) !! i0) eqn:?; try iIntros "[]".
     assert (H2 := CSUB i0); hnf in H2; rewrite Heqo in H2; rewrite H2.
-    destruct (union_field_offset (@cenv_cs CS) i (co_members c)) as [[[] [|]]|] eqn:?H; try contradiction.
-    rewrite <- (union_field_offset_stable (@cenv_cs CS) (@cenv_cs CS')) in H1; try eassumption.
-    rewrite H1. auto.
-   intros. specialize (CSUB id).  hnf in CSUB.  rewrite H3 in CSUB; auto.
+    destruct (union_field_offset (@cenv_cs CS) i (co_members c)) as [[[] [|]]|] eqn:?H; try iIntros "[]".
+    rewrite <- (union_field_offset_stable (@cenv_cs CS) (@cenv_cs CS')) in H; try eassumption.
+    rewrite H. auto.
+   intros. specialize (CSUB id).  hnf in CSUB. rewrite -> H0 in CSUB; auto.
    apply co_consistent_complete. 
    apply (cenv_consistent i0); auto.
 Qed.
 
-Lemma tc_expr_cenv_sub a rho Delta w (T: @tc_expr CS Delta a rho w):
-                            @tc_expr CS' Delta a rho w
-     with tc_lvalue_cenv_sub a rho Delta w (T: @tc_lvalue CS Delta a rho w): 
-                            @tc_lvalue CS' Delta a rho w.
-  Proof.
-- clear  tc_expr_cenv_sub.
-  induction a;
-  try solve [apply  (denote_tc_assert_cenv_sub CSUB); auto];
-  try solve [unfold tc_expr in *; simpl in T|-*; tc_expr_cenv_sub_tac].
- + (* Ederef *)
-  unfold tc_expr in *; simpl in T|-*.
-  destruct (access_mode t) eqn:?H; auto.
-  tc_expr_cenv_sub_tac.
- + (* Eunop *) 
-    apply (tc_expr_cenv_sub_unop _ _ _ _ _ _ T IHa).
- + (* Ebinop *)
-    apply (tc_expr_cenv_sub_binop _ _ _ _ _ _ _ T IHa1 IHa2).
- +  (* Ecast *)
-    apply (tc_expr_cenv_sub_cast _ _ _ _ _ T IHa).
- + (* Efield *) 
-    apply (tc_expr_cenv_sub_field a (tc_lvalue_cenv_sub a) _ _ _ _ _ T IHa).
-- clear  tc_lvalue_cenv_sub.
-  unfold tc_lvalue in *.
-  induction a;
-  try solve [apply  (denote_tc_assert_cenv_sub CSUB); auto].
- + (* Ederef *)
-   rename T into H; revert H.
-  unfold typecheck_lvalue;
-   fold (@typecheck_lvalue CS); fold (@typecheck_lvalue CS');
-   fold (@typecheck_expr CS); fold (@typecheck_expr CS').
-   repeat simple apply denote_tc_assert_andp_imp.
-   apply tc_expr_cenv_sub.
-   apply tc_bool_cenv_sub.
-   apply isptr_eval_expr_cenv_sub; auto.
- + (* Efield *) 
-   apply (tc_lvalue_cenv_sub_field _ _ _ _ _ _ T IHa).
- Qed.
-
-  Lemma tc_exprlist_cenv_sub Delta rho w:
-    forall types bl, (@tc_exprlist CS Delta types bl rho) w ->
-                     (@tc_exprlist CS' Delta types bl rho) w.
-  Proof.
-    induction types; simpl; intros.
-    + destruct bl; simpl in *; trivial.
-    + destruct bl. trivial.
-       revert H.
+Lemma tc_expr_lvalue_cenv_sub a rho Delta :
+  (tc_expr(CS := CS) Delta a rho ⊢ tc_expr(CS := CS') Delta a rho) /\
+  (tc_lvalue(CS := CS) Delta a rho ⊢ tc_lvalue(CS := CS') Delta a rho).
+Proof.
+  induction a; intros; split; try apply (denote_tc_assert_cenv_sub CSUB); unfold tc_expr, tc_lvalue; simpl.
+  + unfold typecheck_expr; fold (typecheck_expr(CS := CS)); fold (typecheck_expr(CS := CS')).
+    destruct (access_mode t); try done.
+    rewrite !denote_tc_assert_andp; apply bi.and_mono; first apply bi.and_mono; first apply IHa; apply (denote_tc_assert_cenv_sub CSUB).
+  + (* Ederef *)
+    unfold typecheck_lvalue;
+    fold (typecheck_expr(CS := CS)); fold (typecheck_expr(CS := CS')).
+    rewrite !denote_tc_assert_andp; apply bi.and_mono; first apply bi.and_mono; first apply IHa; apply (denote_tc_assert_cenv_sub CSUB).
+  + unfold typecheck_expr; fold (typecheck_lvalue(CS := CS)); fold (typecheck_lvalue(CS := CS')).
+    rewrite !denote_tc_assert_andp; apply bi.and_mono; first apply IHa.
+    rewrite /tc_bool; simple_if_tac; done.
+  + apply tc_expr_cenv_sub_unop, IHa.
+  + apply (tc_expr_cenv_sub_binop _ _ _ _ _ _ (proj1 IHa1) (proj1 IHa2)).
+  + apply tc_expr_cenv_sub_cast, IHa.
+  + apply tc_expr_cenv_sub_field, IHa. apply IHa.
+  + apply tc_lvalue_cenv_sub_field, IHa.
+  + unfold typecheck_expr.
+    rewrite !denote_tc_assert_andp; apply bi.and_mono; first apply tc_complete_type_cenv_sub.
+    rewrite /tc_bool; simple_if_tac; done.
+  + unfold typecheck_expr.
+    rewrite !denote_tc_assert_andp; apply bi.and_mono; first apply tc_complete_type_cenv_sub.
+    rewrite /tc_bool; simple_if_tac; done.
+Qed.
+
+Lemma tc_expr_cenv_sub a rho Delta : tc_expr(CS := CS) Delta a rho ⊢ tc_expr(CS := CS') Delta a rho.
+Proof. apply tc_expr_lvalue_cenv_sub. Qed.
+
+Lemma tc_lvalue_cenv_sub a rho Delta : tc_lvalue(CS := CS) Delta a rho ⊢ tc_lvalue(CS := CS') Delta a rho.
+Proof. apply tc_expr_lvalue_cenv_sub. Qed.
+
+Lemma tc_exprlist_cenv_sub Delta rho:
+  forall types bl, @tc_exprlist CS Delta types bl rho ⊢
+                   @tc_exprlist CS' Delta types bl rho.
+Proof.
+  induction types; intros.
+  + destruct bl; simpl in *; trivial.
+  + destruct bl. trivial.
     unfold tc_exprlist.
-   unfold typecheck_exprlist; 
-        fold (@typecheck_exprlist CS);
-        fold (@typecheck_exprlist CS').
-        simple apply denote_tc_assert_andp_imp.
-        intros; eapply tc_expr_cenv_sub_cast; eauto.
-        apply tc_expr_cenv_sub.
-        apply IHtypes.
-   Qed.
-End CENV_SUB.
\ No newline at end of file
+    unfold typecheck_exprlist; 
+      fold (typecheck_exprlist(CS := CS));
+      fold (typecheck_exprlist(CS := CS')).
+    setoid_rewrite denote_tc_assert_andp.
+    unfold tc_exprlist in IHtypes; fold (tc_expr(CS := CS) Delta (Ecast e a) rho);
+      fold (tc_expr(CS := CS') Delta (Ecast e a) rho). setoid_rewrite tc_expr_cenv_sub. setoid_rewrite IHtypes; done.
+Qed.
+
+End CENV_SUB.
+
+End mpred.
diff --git a/veric/external_state.v b/veric/external_state.v
new file mode 100644
index 0000000000..02d03e02fa
--- /dev/null
+++ b/veric/external_state.v
@@ -0,0 +1,24 @@
+From iris.algebra Require Export excl auth.
+From iris_ora.algebra Require Export excl_auth.
+From iris_ora.logic Require Export own.
+From iris.proofmode Require Import proofmode.
+
+Class externalGS (Z : Type) (Σ : gFunctors) := ExternalGS {
+  external_inG : inG Σ (excl_authR (leibnizO Z));
+  external_name : gname
+}.
+
+Definition has_ext {Z : Type} `{!externalGS Z Σ} (z : Z) : iProp Σ :=
+  own(inG0 := external_inG) external_name (auth_frag(A := optionUR (@exclR (leibnizO Z))) (Excl' z)).
+
+Definition ext_auth {Z : Type} `{!externalGS Z Σ} (z : Z) : iProp Σ :=
+  own(inG0 := external_inG) external_name (auth_auth(A := optionUR (@exclR (leibnizO Z))) (DfracOwn 1) (Excl' z)).
+
+Lemma ext_alloc {Z : Type} `{!inG Σ (excl_authR (leibnizO Z))} (z : Z) : ⊢ |==> ∃ _ : externalGS Z Σ, ext_auth z ∗ has_ext z.
+Proof.
+  rewrite /ext_auth /has_ext.
+  iMod (own_alloc (●E (z : leibnizO Z) ⋅ ◯E (z : leibnizO Z) : excl_authR (leibnizO Z))) as (γ) "?".
+  { apply excl_auth_valid. }
+  iExists (ExternalGS _ _ _ γ).
+  rewrite own_op //.
+Qed.
diff --git a/veric/fupd.v b/veric/fupd.v
deleted file mode 100644
index cf71a39af6..0000000000
--- a/veric/fupd.v
+++ /dev/null
@@ -1,536 +0,0 @@
-Require Import VST.msl.ghost.
-Require Import VST.msl.ghost_seplog.
-Require Import VST.msl.sepalg_generators.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.ghosts.
-Require Import VST.veric.own.
-Require Import VST.veric.invariants.
-Import Ensembles.
-
-Definition timeless' (P : pred rmap) := forall (a a' : rmap),
-  predicates_hered.app_pred P a' -> age a a' ->
-  predicates_hered.app_pred P a.
-
-Lemma list_set_replace : forall {A} n l (a : A), (n < length l)%nat ->
-  own.list_set l n a = replace_nth n l (Some a).
-Proof.
-  induction n; destruct l; unfold own.list_set; auto; simpl; try lia; intros.
-  setoid_rewrite IHn; auto; lia.
-Qed.
-
-Lemma own_timeless : forall {P : Ghost} g (a : G), timeless' (own(RA := P) g a NoneP).
-Proof.
-  intros ????? (v & ? & Hg) ?.
-  exists v; simpl in *.
-  split.
-  + intros; eapply age1_resource_at_identity; eauto.
-  + erewrite age1_ghost_of in Hg by eauto.
-    erewrite own.ghost_fmap_singleton in *; simpl in *.
-    destruct Hg as [? Hg]; apply singleton_join_inv_gen in Hg as (J & ? & Hnth & ?).
-    setoid_rewrite (map_nth _ _ None) in Hnth; setoid_rewrite (map_nth _ _ None) in J.
-    destruct (nth g (ghost_of a0) None) as [(?, ?)|] eqn: Hga; [|inv J].
-    rewrite <- (list_set_same _ _ _ Hga).
-    assert (g < length (ghost_of a0))%nat.
-    { destruct (lt_dec g (length (ghost_of a0))); auto.
-      rewrite -> nth_overflow in Hga by lia; discriminate. }
-    inv J.
-    * erewrite list_set_replace, <- replace_nth_replace_nth, <- list_set_replace; rewrite ?replace_nth_length; auto.
-      eexists; apply singleton_join_gen; rewrite -> nth_replace_nth by auto.
-      destruct p; inv H7.
-      replace _f with (fun _ : list Type => tt).
-      apply lower_None2.
-      { extensionality i; destruct (_f i); auto. }
-    * destruct a2, p, H6 as (? & ? & ?); simpl in *; subst.
-      inv H6.
-      erewrite list_set_replace, <- replace_nth_replace_nth, <- list_set_replace; rewrite ?replace_nth_length; auto.
-      eexists; apply singleton_join_gen; rewrite -> nth_replace_nth by auto.
-      constructor.
-      instantiate (1 := (_, _)).
-      split; simpl; [|split; auto]; eauto.
-      f_equal.
-      extensionality i; destruct (_f i); auto.
-Qed.
-
-Lemma address_mapsto_timeless : forall m v sh p, timeless' (res_predicates.address_mapsto m v sh p).
-Proof.
-  repeat intro.
-  simpl in *.
-  destruct H as (b & [? HYES]); exists b; split; auto.
-  intro b'; specialize (HYES b').
-  if_tac.
-  - destruct HYES as (rsh & Ha'); exists rsh.
-    erewrite age_resource_at in Ha' by eauto.
-    destruct (a @ b'); try discriminate; inv Ha'.
-    destruct p0; inv H5; simpl.
-    f_equal.
-    apply proof_irr.
-  - rewrite age1_resource_at_identity; eauto.
-Qed.
-
-Lemma timeless_FF : timeless' FF.
-Proof.
-  repeat intro.
-  inv H.
-Qed.
-
-Lemma nonlock_permission_bytes_timeless : forall sh l z,
-  timeless' (res_predicates.nonlock_permission_bytes sh l z).
-Proof.
-  repeat intro.
-  simpl in *.
-  specialize (H b).
-  if_tac.
-  - erewrite age1_resource_at in H by (erewrite ?resource_at_approx; eauto).
-    destruct (a @ b); auto.
-  - rewrite age1_resource_at_identity; eauto.
-Qed.
-
-Lemma emp_timeless : timeless' emp.
-Proof.
-  intros ????.
-  setoid_rewrite res_predicates.emp_no in H.
-  setoid_rewrite res_predicates.emp_no.
-  intros l.
-  eapply age1_resource_at_identity, H; auto.
-Qed.
-
-Lemma sepcon_timeless : forall P Q, timeless' P -> timeless' Q ->
-  timeless' (P * Q)%pred.
-Proof.
-  intros ?????? (? & ? & J & ? & ?) ?.
-  eapply unage_join2 in J as (? & ? & ? & ? & ?); eauto.
-  do 3 eexists; eauto.
-Qed.
-
-Lemma exp_timeless : forall {A} (P : A -> pred rmap), (forall x, timeless' (P x)) ->
-  timeless' (exp P).
-Proof.
-  intros ????? [? HP] Hage.
-  eapply H in Hage; eauto.
-  exists x; auto.
-Qed.
-
-Lemma andp_timeless : forall P Q, timeless' P -> timeless' Q ->
-  timeless' (P && Q)%pred.
-Proof.
-  intros ?????? [] ?; split; eauto.
-Qed.
-
-Section FancyUpdates.
-
-Context {inv_names : invG}.
-
-Lemma join_preds : forall a b c d e, join(Join := Join_lower (Join_prod _ ghost_elem_join _ preds_join)) (Some (a, b)) c (Some (d, e)) ->
-  b = e.
-Proof.
-  intros.
-  inv H; auto.
-  destruct H3 as [_ H]; simpl in H.
-  inv H; auto.
-Qed.
-
-Definition fupd E1 E2 P :=
-  ((wsat * ghost_set g_en E1) -* |==> |>FF || (wsat * ghost_set g_en E2 * P))%pred.
-
-Notation "|={ E1 , E2 }=> P" := (fupd E1 E2 P) (at level 99, E1 at level 50, E2 at level 50, P at level 200): pred.
-Notation "|={ E }=> P" := (fupd E E P) (at level 99, E at level 50, P at level 200): pred.
-
-Lemma fupd_mono : forall E1 E2 P Q, (P |-- Q) -> (|={E1, E2}=> P) |-- (|={E1, E2}=> Q).
-Proof.
-  unfold fupd; intros.
-  rewrite <- wand_sepcon_adjoint.
-  eapply derives_trans; [rewrite sepcon_comm; apply modus_wand|].
-  apply bupd_mono, orp_derives, sepcon_derives; auto.
-Qed.
-
-Lemma bupd_fupd : forall E P, bupd P |-- |={E}=> P.
-Proof.
-  intros; unfold fupd.
-  rewrite <- wand_sepcon_adjoint.
-  eapply derives_trans, bupd_mono; [apply bupd_frame_r|].
-  apply orp_right2.
-  rewrite sepcon_comm; auto.
-Qed.
-
-Lemma fupd_frame_r : forall E1 E2 P Q, (|={E1,E2}=> P) * Q |-- |={E1,E2}=> (P * Q).
-Proof.
-  intros; unfold fupd.
-  rewrite <- wand_sepcon_adjoint, sepcon_comm, <- sepcon_assoc.
-  eapply derives_trans; [apply sepcon_derives, derives_refl; apply modus_wand|].
-  eapply derives_trans; [apply bupd_frame_r | apply bupd_mono].
-  rewrite distrib_orp_sepcon; apply orp_derives.
-  - eapply derives_trans; [apply sepcon_derives, now_later; apply derives_refl|].
-    rewrite <- later_sepcon, FF_sepcon; auto.
-  - rewrite sepcon_assoc; auto.
-Qed.
-
-Lemma fupd_or : forall E1 E2 P Q, (|={E1,E2}=> P) |-- |={E1,E2}=> P || Q.
-Proof.
-  intros; unfold fupd.
-  rewrite <- wand_sepcon_adjoint, sepcon_comm; eapply derives_trans; [apply modus_wand|].
-  apply bupd_mono, orp_derives, sepcon_derives; auto.
-  apply orp_right1; auto.
-Qed.
-
-Lemma fupd_trans : forall E1 E2 E3 P, (|={E1,E2}=> |={E2,E3}=> P) |-- |={E1,E3}=> P.
-Proof.
-  intros; unfold fupd.
-  rewrite <- wand_sepcon_adjoint, sepcon_comm; eapply derives_trans; [apply modus_wand|].
-  eapply derives_trans, bupd_trans; apply bupd_mono.
-  apply orp_left.
-  - eapply derives_trans, bupd_intro; apply orp_right1; auto.
-  - apply modus_wand.
-Qed.
-
-Lemma fupd_frame_l : forall E1 E2 P Q, P * (|={E1,E2}=> Q) |-- |={E1,E2}=> (P * Q).
-Proof.
-  intros; erewrite sepcon_comm, (sepcon_comm P Q); apply fupd_frame_r.
-Qed.
-
-(*(* This is a generally useful pattern. *)
-Lemma bupd_mono' : forall P Q (a : rmap) (Himp : (P >=> Q)%pred (level a)),
-  app_pred (bupd P) a -> app_pred (bupd Q) a.
-Proof.
-  intros.
-  assert (app_pred ((|==> P * approx (S (level a)) emp))%pred a) as HP'.
-  { apply (bupd_frame_r _ _ a).
-    do 3 eexists; [apply join_comm, core_unit | split; auto].
-    split; [|apply core_identity].
-    rewrite level_core; auto. }
-  eapply bupd_mono in HP'; eauto.
-  change (predicates_hered.derives (P * approx (S (level a)) emp) Q).
-  intros a0 (? & ? & J & HP & [? Hemp]).
-  destruct (join_level _ _ _ J).
-  apply join_comm, Hemp in J; subst.
-  eapply Himp in HP; try apply necR_refl; auto; lia.
-Qed.
-
-Lemma fupd_mono' : forall E1 E2 P Q (a : rmap) (Himp : (P >=> Q)%pred (level a)),
-  app_pred (fupd E1 E2 P) a -> app_pred (fupd E1 E2 Q) a.
-Proof.
-  intros.
-  assert (app_pred ((|={E1,E2}=> P * approx (S (level a)) emp)) a) as HP'.
-  { apply (fupd_frame_r _ _ _ _ a).
-    do 3 eexists; [apply join_comm, core_unit | split; auto].
-    split; [|apply core_identity].
-    rewrite level_core; auto. }
-  eapply fupd_mono in HP'; eauto.
-  change (predicates_hered.derives (P * approx (S (level a)) emp) Q).
-  intros a0 (? & ? & J & HP & [? Hemp]).
-  destruct (join_level _ _ _ J).
-  apply join_comm, Hemp in J; subst.
-  eapply Himp in HP; try apply necR_refl; auto; lia.
-Qed.*)
-
-Lemma fupd_bupd : forall E1 E2 P Q, (P |-- (|==> (|={E1,E2}=> Q))) -> P |-- |={E1,E2}=> Q.
-Proof.
-  intros; eapply derives_trans, fupd_trans; eapply derives_trans, bupd_fupd; auto.
-Qed.
-
-Lemma fupd_bupd_elim : forall E1 E2 P Q, (P |-- (|={E1,E2}=> Q)) -> (|==> P) |-- |={E1,E2}=> Q.
-Proof.
-  intros; apply fupd_bupd, bupd_mono; auto.
-Qed.
-
-Lemma fupd_intro : forall E P, P |-- |={E}=> P.
-Proof.
-  intros; eapply derives_trans, bupd_fupd; apply bupd_intro.
-Qed.
-
-(*Corollary fview_shift_nonexpansive : forall E1 E2 P Q n,
-  approx n (P -* |={E1,E2}=> Q)%logic = approx n (approx n P  -* |={E1,E2}=> approx n Q)%logic.
-Proof.
-  intros.
-  rewrite wand_nonexpansive; setoid_rewrite wand_nonexpansive at 3.
-  rewrite approx_idem; f_equal; f_equal.
-  apply fupd_nonexpansive.
-Qed.*)
-
-Lemma fupd_except0_elim : forall E1 E2 P Q, (P |-- (|={E1,E2}=> Q)) -> (|> FF || P) |-- |={E1,E2}=> Q.
-Proof.
-  unfold fupd; intros.
-  apply orp_left; auto.
-  rewrite <- wand_sepcon_adjoint.
-  eapply derives_trans, bupd_intro.
-  apply orp_right1.
-  eapply derives_trans, later_derives; [rewrite later_sepcon; apply sepcon_derives, now_later; auto|].
-  rewrite FF_sepcon; auto.
-Qed.
-
-Lemma fupd_mask_union : forall E1 E2, Disjoint E1 E2 ->
-    emp |-- fupd (Union E1 E2) E2 (fupd E2 (Union E1 E2) emp).
-Proof.
-  intros; unfold fupd.
-  rewrite <- wand_sepcon_adjoint.
-  rewrite <- (prop_true_andp _ (ghost_set _ _) H) at 1.
-  rewrite <- ghost_set_join.
-  eapply derives_trans, bupd_intro.
-  apply orp_right2.
-  rewrite emp_sepcon, (sepcon_comm _ (ghost_set _ _)), <- sepcon_assoc; apply sepcon_derives; auto.
-  rewrite <- wand_sepcon_adjoint.
-  eapply derives_trans, bupd_intro.
-  apply orp_right2.
-  rewrite sepcon_comm, sepcon_emp.
-  rewrite sepcon_assoc, (sepcon_comm (ghost_set _ _)), ghost_set_join, prop_true_andp; auto.
-Qed.
-
-Lemma except_0_fupd : forall E1 E2 P, ((|> FF) || fupd E1 E2 P) |-- fupd E1 E2 P.
-Proof.
-  intros.
-  apply fupd_except0_elim, derives_refl.
-Qed.
-
-Lemma timeless'_except_0 : forall P, timeless' P -> |> P |-- |> FF || P.
-Proof.
-  intros; intros ? HP.
-  destruct (level a) eqn: Ha.
-  - left; intros ? Hl%laterR_level.
-    rewrite Ha in Hl; apply Nat.nlt_0_r in Hl; contradiction Hl.
-  - right.
-    destruct (levelS_age a n) as [b [Hb]]; auto.
-    eapply H; eauto.
-    apply HP; constructor; auto.
-Qed.
-
-Lemma fupd_timeless : forall E P, timeless' P -> |> P |-- |={E}=> P.
-Proof.
-  intros.
-  eapply derives_trans, except_0_fupd.
-  eapply derives_trans; [apply timeless'_except_0; auto|].
-  apply orp_derives, fupd_intro; auto.
-Qed.
-
-Lemma fupd_mask_frame_r' : forall E1 E2 Ef P, Disjoint E1 Ef ->
-  fupd E1 E2 (!! (Disjoint E2 Ef) --> P) |-- fupd (Union E1 Ef) (Union E2 Ef) P.
-Proof.
-  intros; unfold fupd.
-  rewrite <- wand_sepcon_adjoint.
-  rewrite <- (prop_true_andp _ (ghost_set _ (Union _ _)) H).
-  rewrite <- ghost_set_join.
-  rewrite <- 2sepcon_assoc.
-  eapply derives_trans; [apply sepcon_derives, derives_refl|].
-  { rewrite sepcon_assoc, sepcon_comm; apply modus_wand. }
-  eapply derives_trans; [apply bupd_frame_r | apply bupd_mono].
-  rewrite distrib_orp_sepcon; apply orp_derives.
-  { eapply derives_trans; [apply sepcon_derives, now_later; apply derives_refl|].
-    rewrite <- later_sepcon; apply later_derives.
-    rewrite FF_sepcon; auto. }
-  rewrite (sepcon_assoc _ _ (_ --> _)%pred), (sepcon_comm _ (_ --> _)%pred).
-  rewrite <- sepcon_assoc, sepcon_assoc, ghost_set_join.
-  rewrite sepcon_andp_prop; apply prop_andp_left; intros.
-  rewrite !sepcon_assoc; apply sepcon_derives; auto.
-  rewrite sepcon_comm; apply sepcon_derives; auto.
-  rewrite normalize.true_eq by auto.
-  intros ??; apply imp_lem0; auto.
-Qed.
-
-End FancyUpdates.
-
-Section Invariants.
-
-Context {inv_names : invG}.
-
-(*Lemma fupd_timeless' : forall E1 E2 P Q, timeless' P -> ((P |-- (|={E1,E2}=> Q)) ->
-  |> P |-- |={E1,E2}=> Q)%pred.
-Proof.
-  intros.
-  eapply derives_trans; [apply fupd_timeless; auto|].
-  eapply derives_trans, fupd_trans.
-  apply fupd_mono; eauto.
-Qed.
-
-Lemma wsat_fupd_elim' : forall E P, (wsat * ghost_set g_en E * (|={E}=> P) |-- (|==> sbi_except_0 (wsat * ghost_set g_en E * P)))%I.
-Proof.
-  intros; unfold updates.fupd, bi_fupd_fupd; simpl; unfold fupd.
-  apply modus_ponens_wand.
-Qed.
-
-Corollary wsat_fupd_elim : forall P, (wsat * (|={empty}=> P) |-- (|==> sbi_except_0 (wsat * P)))%I.
-Proof.
-  intros; rewrite wsat_empty_eq; apply wsat_fupd_elim'.
-Qed.
-
-Lemma bupd_except_0 : forall P, ((|==> sbi_except_0 P) |-- sbi_except_0 (|==> P))%I.
-Proof.
-  intros; change (predicates_hered.derives (own.bupd (sbi_except_0 P)) (sbi_except_0 (own.bupd P : mpred))).
-  intros ??; simpl in H.
-  destruct (level a) eqn: Hl.
-  + left.
-    change ((|> FF)%pred a).
-    intros ??%laterR_level.
-    rewrite Hl in H1; apply Nat.nlt_0_r in H1; contradiction H1.
-  + right.
-    rewrite <- Hl in *.
-    intros ? J; specialize (H _ J) as (? & ? & a' & ? & ? & ? & HP); subst.
-    do 2 eexists; eauto; do 2 eexists; eauto; repeat split; auto.
-    destruct HP as [Hfalse|]; auto.
-    destruct (levelS_age a' n) as (a'' & Hage & ?); [omega|].
-    exfalso; apply (Hfalse a'').
-    constructor; auto.
-Qed.*)
-
-Lemma fupd_andp_corable : forall E1 E2 P Q, corable P -> P && fupd E1 E2 Q |-- fupd E1 E2 (P && Q).
-Proof.
-  unfold fupd; intros.
-  rewrite <- wand_sepcon_adjoint.
-  rewrite corable_andp_sepcon1 by auto.
-  eapply derives_trans; [apply andp_derives; [apply derives_refl | rewrite sepcon_comm; apply modus_wand]|].
-  rewrite <- bupd_andp_corable by auto; apply bupd_mono.
-  rewrite andp_comm, distrib_orp_andp; apply orp_derives.
-  - apply andp_left1; auto.
-  - rewrite corable_sepcon_andp1, andp_comm; auto.
-Qed.
-
-Lemma fupd_andp_prop : forall E1 E2 P Q, !! P && fupd E1 E2 Q |-- fupd E1 E2 (!!P && Q).
-Proof.
-  intros; apply fupd_andp_corable, corable_prop.
-Qed.
-
-Lemma unfash_sepcon: forall P (Q : pred rmap), !P * Q |-- !P.
-Proof.
-  intros ??? (? & ? & J & ? & ?); simpl in *.
-  apply join_level in J as [<- _]; auto.
-Qed.
-
-Lemma bupd_unfash: forall P, bupd (! P) |-- ! P.
-Proof.
-  repeat intro; simpl in *.
-  destruct (H (core (ghost_of a))) as (? & ? & ? & <- & ? & ? & ?); auto.
-  rewrite <- ghost_of_approx at 1; eexists; apply ghost_fmap_join, join_comm, core_unit.
-Qed.
-
-Lemma bupd_andp_unfash: forall P Q, (bupd (!P && Q) = !P && bupd Q)%pred.
-Proof.
-  intros; apply pred_ext.
-  - apply andp_right.
-    + eapply derives_trans; [apply bupd_mono, andp_left1, derives_refl|].
-      apply bupd_unfash.
-    + apply bupd_mono, andp_left2, derives_refl.
-  - intros ? [? HQ] ? J.
-    destruct (HQ _ J) as (? & ? & a' & Hl & ? & ? & ?); subst.
-    eexists; split; eauto.
-    exists a'; repeat (split; auto).
-    simpl in *.
-    rewrite Hl; auto.
-Qed.
-
-Lemma fupd_andp_unfash: forall E1 E2 P Q, !P && fupd E1 E2 Q |-- fupd E1 E2 (!P && Q).
-Proof.
-  unfold fupd; intros.
-  rewrite <- wand_sepcon_adjoint.
-  eapply derives_trans; [apply andp_right|].
-  { eapply derives_trans, unfash_sepcon.
-    apply sepcon_derives, derives_refl; apply andp_left1; auto. }
-  { apply sepcon_derives, derives_refl; apply andp_left2, derives_refl. }
-  eapply derives_trans; [apply andp_derives; [apply derives_refl | rewrite sepcon_comm; apply modus_wand]|].
-  rewrite <- bupd_andp_unfash.
-  apply bupd_mono.
-  rewrite andp_comm, distrib_orp_andp; apply orp_derives.
-  - apply andp_left1; auto.
-  - rewrite andp_comm, unfash_sepcon_distrib; apply sepcon_derives; auto.
-    apply andp_left2; auto.
-Qed.
-
-Lemma subp_fupd : forall (G : pred nat) E (P P' : pred rmap),
-  (G |-- P >=> P' -> G |-- (fupd E E P) >=> (fupd E E P'))%pred.
-Proof.
-  intros; unfold fupd.
-  apply sub_wand; [apply subp_refl|].
-  apply subp_bupd, subp_orp; [apply subp_refl|].
-  apply subp_sepcon; auto; apply subp_refl.
-Qed.
-
-
-(*Lemma fupd_prop' : forall E1 E2 E2' P Q, subseteq E1 E2 ->
-  (Q |-- (|={E1,E2'}=> !!P) ->
-  (|={E1, E2}=> Q) |-- |={E1}=> !!P && (|={E1, E2}=> Q))%I.
-Proof.
-  unfold updates.fupd, bi_fupd_fupd; simpl.
-  unfold fupd; intros ?????? HQ.
-  iIntros "H Hpre".
-  iMod ("H" with "Hpre") as ">(Hpre & Q)".
-  erewrite ghost_set_subset with (s' := E1) by auto.
-  iDestruct "Hpre" as "(wsat & en1 & en2)".
-  iCombine ("wsat en1 Q") as "Q".
-  erewrite (add_andp (_ ∗ _ ∗ Q)%I (sbi_except_0 (!! P))) at 1.
-  rewrite sepcon_andp_prop bi.except_0_and.
-  iModIntro; iSplit.
-  { iDestruct "Q" as "[? ?]"; auto. }
-  iDestruct "Q" as "[(? & ? & ?) _]"; iFrame; auto.
-  { iIntros "(? & ? & Q)".
-    setoid_rewrite <- (own.bupd_prop P).
-    iApply bupd_except_0.
-    iMod (HQ with "Q [$]") as ">(? & ?)"; auto. }
-Qed.
-
-Lemma fupd_prop : forall E1 E2 P Q, subseteq E1 E2 ->
-  Q |-- !!P ->
-  ((|={E1, E2}=> Q) |-- |={E1}=> !!P && (|={E1, E2}=> Q))%I.
-Proof.
-  intros; eapply fupd_prop'; auto.
-  eapply derives_trans; eauto.
-  apply fupd_intro.
-Qed.
-
-Lemma inv_alloc : forall E P, |> P |-- (|={E}=> EX i : _, invariant i P)%I.
-Proof.
-  intros; unfold fupd; iIntros "P (wsat & ?)".
-  iMod (wsat_alloc with "[$]") as "(? & ?)"; iFrame; auto.
-Qed.
-
-Lemma make_inv : forall E P Q, P |-- Q -> (P |-- |={E}=> EX i : _, invariant i Q)%I.
-Proof.
-  intros.
-  eapply derives_trans, inv_alloc; auto.
-  eapply derives_trans, now_later; auto.
-Qed.
-
-Lemma make_inv' : forall P Q, P |-- Q -> (wsat * P |-- |==> EX i : _, |> (wsat * (invariant i Q)))%I.
-Proof.
-  intros.
-  iIntros "[wsat P]".
-  iPoseProof (make_inv empty _ _ H with "P") as "inv".
-  iMod (wsat_fupd_elim with "[$wsat $inv]") as "[wsat inv]".
-  iDestruct "inv" as (i) "inv"; iExists i.
-  unfold sbi_except_0.
-  iIntros "!> !>".
-  iDestruct "wsat" as "[? | $]"; auto.
-  iDestruct "inv" as "[? | ?]"; auto.
-Qed.*)
-
-Lemma inv_close_aux : forall E (i : iname) P,
-  (ghost_list(P := token_PCM) g_dis (list_singleton i (Some tt)) * invariant i P * |> P *
-  (wsat * ghost_set g_en (Subtract E i)))
-  |-- |==> |> FF || (wsat * (ghost_set g_en (Singleton i) * ghost_set g_en (Subtract E i))).
-Proof.
-  intros.
-  rewrite (sepcon_comm wsat), <- !sepcon_assoc, sepcon_comm.
-  rewrite (sepcon_assoc (ghost_list _ _)), (sepcon_comm (ghost_list _ _)).
-  rewrite <- !sepcon_assoc; eapply derives_trans; [apply sepcon_derives, derives_refl; apply wsat_close|].
-  eapply derives_trans, bupd_mono; [apply bupd_frame_r|].
-  apply orp_right2; auto.
-Qed.
-
-Lemma inv_open : forall E i P, In E i ->
-  invariant i P |-- fupd E (Subtract E i) (|> P * (|>P -* fupd (Subtract E i) E emp)).
-Proof.
-  intros; unfold fupd.
-  rewrite -> invariant_dup, <- wand_sepcon_adjoint.
-  erewrite ghost_set_remove by eauto.
-  rewrite <- !sepcon_assoc, !sepcon_assoc.
-  rewrite <- (sepcon_assoc wsat), <- (sepcon_assoc _ (_ * _)%pred), sepcon_comm, sepcon_assoc.
-  rewrite <- (sepcon_assoc _ wsat), (sepcon_comm _ wsat).
-  eapply derives_trans; [apply sepcon_derives, derives_refl; apply wsat_open|].
-  eapply derives_trans, bupd_mono; [apply bupd_frame_r|].
-  apply orp_right2.
-  rewrite !sepcon_assoc; apply sepcon_derives; auto.
-  rewrite (sepcon_comm _ (_ * (_ -* _))%pred), sepcon_assoc; apply sepcon_derives; auto.
-  rewrite (sepcon_comm _ (invariant _ _)), <- sepcon_assoc; apply sepcon_derives; auto.
-  rewrite <- !wand_sepcon_adjoint, sepcon_emp.
-  apply inv_close_aux.
-Qed.
-
-End Invariants.
-
-Notation "|={ E1 , E2 }=> P" := (fupd E1 E2 P) (at level 99, E1 at level 50, E2 at level 50, P at level 200): pred.
-Notation "|={ E }=> P" := (fupd E E P) (at level 99, E at level 50, P at level 200): pred.
diff --git a/veric/ghost.v b/veric/ghost.v
deleted file mode 100644
index 30469fc2b2..0000000000
--- a/veric/ghost.v
+++ /dev/null
@@ -1,136 +0,0 @@
-Require Export VST.veric.Clight_base.
-Require Import VST.veric.rmaps.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.res_predicates.
-Require Import VST.veric.shares.
-Require Import VST.veric.tycontext.
-Require Import VST.veric.expr2.
-
-Definition GHOSTspec (A: Type) (x: A) : spec :=
-  fun sh loc =>
-   allp (jam (eq_dec loc) (fun loc' => 
-    yesat (SomeP (ConstType (A -> Prop)) (fun _ y => y = x)) 
-             (FUN (nil,Tvoid) cc_default) sh loc') noat).
-
-Definition ghostp {A: Type} (sh: share) (loc: address) (x: A) : mpred :=
-  GHOSTspec A x sh loc.
-
-
-Lemma ghostp_unique_sepcon:
-    forall {A: Type} sh1 sh2 loc (x1 x2: A),
-     ghostp sh1 loc x1 * ghostp sh2 loc x2 |-- |> !! (x1=x2).
-Proof.
-intros.
-unfold ghostp, GHOSTspec.
-intros w [w1 [w2 [? [? ?]]]].
-intros w' ?.
-simpl in H2.
-apply laterR_level in H2.
-generalize (join_level _ _ _ H); intros [? ?].
-destruct (level w). inv H2.
-hnf.
-rename H2 into Hw'.
-specialize (H0 loc). specialize (H1 loc).
-rewrite jam_true in H0 by auto.
-rewrite jam_true in H1 by auto.
-destruct H0 as [p ?]. destruct H1 as [p' ?].
-hnf in H0,H1.
-apply (resource_at_join _ _ _ loc) in H.
-rewrite H0 in H; rewrite H1 in H.
-simpl in H.
-(*rewrite H3 in H. rewrite H4 in H. *)
-assert (SomeP (ConstType (A -> Prop))
-            (fun (_ : list Type) (y : A) => y = x1) =
-          SomeP (ConstType (A -> Prop))
-            (fun (_ : list Type) (y : A) => y = x2))%pred.
-clear - H.
-match goal with |- ?B = ?C => forget B as b; forget C as c end.
-inversion H; auto.
-clear H.
-apply SomeP_inj in H2.
-pose proof (@equal_f A Prop _ _ (@equal_f (list Type) (A->Prop) _ _ H2 nil) x1).
-simpl in H.
-rewrite <- H; auto.
-Qed.
-
-Lemma ghostp_unique_andp:
-    forall {A: Type} sh loc (x1 x2: A),
-     ghostp sh loc x1 && ghostp sh loc x2 |-- |> !! (x1=x2).
-Proof.
-intros.
-unfold ghostp, GHOSTspec.
-intros w [? ?].
-rename H0 into H1; rename H into H0.
-specialize (H0 loc). specialize (H1 loc).
-rewrite jam_true in H0 by auto.
-rewrite jam_true in H1 by auto.
-destruct H0 as [p H0]. destruct H1 as [p' H1].
-hnf in H0,H1.
-rewrite H0 in H1.
-simpl in H1.
-intros w' H2.
-simpl in H2.
-apply laterR_level in H2.
-destruct (level w). inv H2.
-hnf.
-rename H2 into Hw'.
-assert (SomeP (ConstType (A -> Prop))
-            (fun (_ : list Type) (y : A) => y = x1) =
-          SomeP (ConstType (A -> Prop))
-            (fun (_ : list Type) (y : A) => y = x2))%pred.
-clear - H1.
-match goal with |- ?B = ?C => forget B as b; forget C as c end.
-inversion H1; auto.
-clear - H.
-apply SomeP_inj in H.
-pose proof (@equal_f A Prop _ _ (@equal_f (list Type) (A->Prop) _ _ H nil) x1).
-rewrite <- H0; auto.
-Qed.
-
-
-Definition make_GHOSTspec:
-  forall A (sh : share) (rsh: readable_share sh) loc (x: A) (lev: nat),
-   exists m: rmap, GHOSTspec A x sh loc m /\ level m =  lev.
-Proof.
- intros.
-unfold GHOSTspec.
- assert (AV.valid (res_option oo 
-  (fun l => if eq_dec l loc 
-   then YES sh rsh (FUN(nil,Tvoid) cc_default)
-             (SomeP (ConstType (A -> Prop)) 
-                  (fun _ y => (y = x)))
-   else NO Share.bot bot_unreadable))).
- intros b ofs.
- unfold res_option, compose.
- if_tac; auto.
- destruct (make_rmap _ H lev) as [phi [? ?]].
- extensionality l.
- unfold compose, resource_fmap; simpl.
- if_tac; auto.
- exists phi.
- split; auto.
- hnf.
- intro l.
- hnf.
- if_tac.
- subst l.
- hnf. exists rsh.
- hnf.
- rewrite H1. rewrite if_true. f_equal. 
- auto.
- do 3 red. rewrite H1.
- rewrite if_false by auto.
- apply NO_identity.
-Qed.
-
-
-Lemma make_ghostp:
-  forall A (x: A)  loc (lev: nat),
-  exists m : rmap, ghostp Share.top loc x m /\ level m = lev.
-Proof.
-intros.
-unfold ghostp.
-destruct (make_GHOSTspec A Share.top readable_share_top loc x lev) as [m [? ?]].
-exists m; split; auto.
-Qed.
-
diff --git a/veric/ghost_PCM.v b/veric/ghost_PCM.v
deleted file mode 100644
index 66d3f31056..0000000000
--- a/veric/ghost_PCM.v
+++ /dev/null
@@ -1,37 +0,0 @@
-Require Export VST.msl.msl_standard.
-Require Export VST.veric.base.
-Require Export VST.veric.shares.
-Require Import VST.msl.ghost.
-Require Import VST.veric.ghosts.
-
-(* external ghost state *)
-
-Definition ext_PCM Z : Ghost := ref_PCM (exclusive_PCM Z).
-
-Lemma valid_ext : forall {Z} (ora : Z), @valid (ext_PCM _) (Some (Tsh, Some ora), None).
-Proof.
-  intros; simpl; split; auto.
-  apply Share.nontrivial.
-Qed.
-
-Definition ext_ghost {Z} (ora : Z) : {g : Ghost & {a : G | valid a}} :=
-  existT _ (ext_PCM _) (exist _ _ (valid_ext ora)).
-
-Lemma valid_ext_ref : forall {Z} (ora : Z), @valid (ext_PCM _) (None, Some (Some ora)).
-Proof.
-  intros; simpl; split; auto.
-  eexists (Some (_, _)); constructor.
-Qed.
-
-Definition ext_ref {Z} (ora : Z) : {g : Ghost & {a : G | valid a}} :=
-  existT _ (ext_PCM _) (exist _ _ (valid_ext_ref ora)).
-
-Lemma valid_ext_both : forall {Z} (ora : Z), @valid (ext_PCM _) (Some (Tsh, Some ora), Some (Some ora)).
-Proof.
-  intros; simpl; split; auto.
-  - apply Share.nontrivial.
-  - exists None; constructor.
-Qed.
-
-Definition ext_both {Z} (ora : Z) : {g : Ghost & {a : G | ghost.valid a}} :=
-  existT _ (ext_PCM _) (exist _ _ (valid_ext_both ora)).
diff --git a/veric/ghosts.v b/veric/ghosts.v
deleted file mode 100644
index 41649610fa..0000000000
--- a/veric/ghosts.v
+++ /dev/null
@@ -1,541 +0,0 @@
-Require Export VST.msl.ghost.
-Require Import VST.msl.shares.
-Require Import VST.msl.sepalg_generators.
-Require Import VST.msl.iter_sepcon.
-Require Import VST.msl.ghost_seplog.
-Require Import VST.veric.mpred.
-Require Import VST.veric.shares.
-Require Import VST.veric.own.
-Require Import VST.veric.compcert_rmaps.
-
-(* Lemmas about ghost state and common instances *)
-
-Notation "|==> P" := (own.bupd P) (at level 99, P at level 200): pred.
-
-Section ghost.
-
-Local Open Scope pred.
-
-Context {RA: Ghost}.
-
-Lemma own_op' : forall g a1 a2 pp,
-  own g a1 pp * own g a2 pp = EX a3 : _, !!(join a1 a2 a3 /\ valid a3) && own g a3 pp.
-Proof.
-  intros.
-  apply pred_ext.
-  - eapply derives_trans, prop_andp_left; [apply andp_right, derives_refl; apply ghost_valid_2|].
-    intros (a3 & ? & ?); apply exp_right with a3, prop_andp_right; auto.
-    erewrite <- ghost_op by eauto; apply derives_refl.
-  - apply exp_left; intro; apply prop_andp_left; intros [].
-    erewrite ghost_op by eauto; apply derives_refl.
-Qed.
-
-Lemma own_op_gen : forall g a1 a2 a3 pp, (valid_2 a1 a2 -> join a1 a2 a3) ->
-  own g a1 pp * own g a2 pp = !!(valid_2 a1 a2) && own g a3 pp.
-Proof.
-  intros; apply pred_ext.
-  - eapply derives_trans, prop_andp_left; [apply andp_right, derives_refl; apply ghost_valid_2|].
-    intro; erewrite <- ghost_op by eauto.
-    apply prop_andp_right; auto.
-  - apply prop_andp_left; intro.
-    erewrite ghost_op by eauto; apply derives_refl.
-Qed.
-
-End ghost.
-
-#[export] Hint Resolve Share.nontrivial : share.
-
-Section Reference.
-(* One common kind of PCM is one in which a central authority has a reference copy, and clients pass around
-   partial knowledge. When a client recovers all pieces, it can gain full knowledge. *)
-(* This is related to the snapshot PCM, but the snapshots aren't duplicable. *)
-
-Global Program Instance pos_PCM (P : Ghost) : Ghost := { G := option (share * G);
-  valid a := match a with Some (sh, _) => sh <> Share.bot | _ => True end;
-  Join_G a b c := match a, b, c with
-  | Some (sha, a'), Some (shb, b'), Some (shc, c') =>
-      sha <> Share.bot /\ shb <> Share.bot /\ sepalg.join sha shb shc /\ join a' b' c'
-  | Some (sh, a), None, Some c' | None, Some (sh, a), Some c' => c' = (sh, a)
-  | None, None, None => True
-  | _, _, _ => False
-  end }.
-Next Obligation.
-repeat split; intros; intro X; decompose [and] X; congruence.
-Qed.
-Next Obligation.
-repeat split; intros; intro X; decompose [and] X; congruence.
-Qed.
-Next Obligation.
-repeat split; intros; intro X; decompose [and] X; congruence.
-Qed.
-Next Obligation.
-repeat split; intros; intro X; decompose [and] X; congruence.
-Qed.
-Next Obligation.
-apply fsep_sep.
-exists (fun _ => None); auto.
-intros [[]|]; constructor.
-Defined.
-Next Obligation.
-constructor.
-  - intros [[]|] [[]|] [[]|] [[]|]; unfold join; simpl; auto; try contradiction; try congruence.
-    intros (? & ? & ? & ?) (? & ? & ? & ?); f_equal; f_equal; eapply join_eq; eauto.
-  - intros [[]|] [[]|] [[]|] [[]|] [[]|]; try contradiction; unfold join; simpl;
-      intros; decompose [and] H; decompose [and] H0;
-      repeat match goal with H : (_, _) = (_, _) |- _ => inv H end;
-      try solve [eexists (Some _); split; auto; simpl; auto]; try solve [exists None; split; auto].
-    + destruct (join_assoc H2 H6) as (sh' & ? & ?), (join_assoc H5 H9) as (a' & ? & ?).
-      exists (Some (sh', a')); repeat (split; auto).
-      intro; subst.
-      apply join_Bot in H8 as []; auto.
-    + exists (Some (s2, g2)); auto.
-  - intros [[]|] [[]|] [[]|]; try contradiction; unfold join; auto.
-    intros (? & ? & ? & ?); split; auto; split; auto; split; apply join_comm; auto.
-  - intros [[]|] [[]|] [[]|] [[]|]; try contradiction; intros H1 H2; try solve [inv H1; reflexivity || inv H2; reflexivity].
-    destruct H1 as (? & ? & ? & ?), H2 as (? & ? & ? & ?); f_equal; f_equal; eapply join_positivity; eauto.
-Qed.
-(*Next Obligation.
-  hnf.
-  destruct a as [[]|]; auto.
-Qed.
-Next Obligation.
-  exists None; hnf; auto.
-Qed.*)
-Next Obligation.
-destruct a as [[]|]; destruct b as [[]|]; destruct c as [[]|]; try trivial;
-unfold join in *; try contradiction.
-- decompose [and] H; assumption.
-- congruence.
-Qed.
-
-Definition completable {P : Ghost} (a: @G (pos_PCM P)) r := exists x, join a x (Some (Share.top, r)).
-
-Local Obligation Tactic := idtac.
-
-Global Program Instance ref_PCM (P : Ghost) : Ghost :=
-{ valid a := valid (fst a) /\ match snd a with Some r => completable (fst a) r | None => True end;
-  Join_G a b c := @Join_G (pos_PCM P) (fst a) (fst b) (fst c) /\
-    @psepalg.Join_lower _ (psepalg.Join_discrete _) (snd a) (snd b) (snd c) }.
-Next Obligation.
-  intros P; apply sepalg_generators.Sep_prod; try apply _.
-  apply fsep_sep, _.
-Defined.
-Next Obligation.
-  intros P; apply sepalg_generators.Perm_prod; typeclasses eauto.
-Qed.
-(*Next Obligation.
-  intros; hnf.
-  split; [apply (@core2_unit (pos_PCM P)) | constructor].
-Qed.
-Next Obligation.
-  intros; reflexivity.
-Qed.
-Next Obligation.
-  intros; exists (None, None); hnf.
-  split; constructor.
-Qed.*)
-Next Obligation.
-  intros P ??? [? J] []; split; [eapply join_valid; eauto|].
-  destruct a, b, c; simpl in *; inv J; auto.
-  + destruct o1; auto.
-    destruct H1.
-    destruct (join_assoc H H1) as (? & ? & ?); eexists; eauto.
-  + inv H2.
-Qed.
-
-End Reference.
-
-#[global] Program Instance exclusive_PCM A : Ghost :=
-  { valid a := True; Join_G := Join_lower (Join_discrete A) }.
-(*Next Obligation.
-Proof.
-  eexists; constructor.
-Qed.*)
-
-Definition excl {A} g a : mpred := own(RA := exclusive_PCM A) g (Some a) NoneP.
-
-Lemma exclusive_update : forall {A} (v v' : A) p, excl p v |-- |==> excl p v'.
-Proof.
-  intros; apply ghost_update.
-  intros ? (? & ? & _).
-  exists (Some v'); split; simpl; auto; inv H; constructor.
-  inv H1.
-Qed.
-
-Local Obligation Tactic := idtac.
-
-#[global] Program Instance prod_PCM (GA GB: Ghost): Ghost := { G := @G GA * @G GB;
-  valid a := valid (fst a) /\ valid (snd a); Join_G := Join_prod _ _ _ _ }.
-Next Obligation.
-  intros GA GB ??? [] []; split; eapply join_valid; eauto.
-Defined.
-
-(* Can we use Santiago and Qinxiang's paper to simplify this? *)
-Class PCM_order `{P : Ghost} (ord : G -> G -> Prop) := { ord_preorder : PreOrder ord;
-  ord_lub : forall a b c, ord a c -> ord b c -> {c' | join a b c' /\ ord c' c};
-  join_ord : forall a b c, join a b c -> ord a c /\ ord b c; ord_join : forall a b, ord b a -> join a b a }.
-Global Existing Instance ord_preorder.
-
-(*Class lub_ord {A} (ord : A -> A -> Prop) := { lub_ord_refl :> RelationClasses.Reflexive ord;
-  lub_ord_trans :> RelationClasses.Transitive ord;
-  has_lub : forall a b c, ord a c -> ord b c -> exists c', ord a c' /\ ord b c' /\
-    forall d, ord a d -> ord b d -> ord c' d }.
-
-Global Instance ord_PCM `{lub_ord} : Ghost := { Join_G a b c := ord a c /\ ord b c /\
-  forall c', ord a c' -> ord b c' -> ord c c' }.
-Proof.
-  -
-  - intros ??? (? & ? & ?); eauto.
-  - intros ????? (? & ? & Hc) (? & ? & He).
-    destruct (has_lub b d e) as (c' & ? & ? & Hlub); try solve [etransitivity; eauto].
-    exists c'; repeat split; auto.
-    + etransitivity; eauto.
-    + apply Hlub; auto; transitivity c; auto.
-    + intros.
-      apply He.
-      * apply Hc; auto; etransitivity; eauto.
-      * etransitivity; eauto.
-Defined.
-
-Global Instance ord_PCM_ord `{lub_ord} : PCM_order ord.
-Proof.
-  constructor.
-  - apply lub_ord_refl.
-  - apply lub_ord_trans.
-  - intros ??? Ha Hb.
-    destruct (has_lub _ _ _ Ha Hb) as (c' & ? & ? & ?).
-    exists c'; simpl; eauto.
-  - simpl; intros; tauto.
-  - intros; simpl.
-    repeat split; auto.
-    reflexivity.
-Defined.*)
-
-(* Instances of ghost state *)
-Section Snapshot.
-(* One common kind of PCM is one in which a central authority has a reference copy, and clients pass around
-   partial knowledge. *)
-
-Context `{ORD : PCM_order}.
-
-Lemma join_refl : forall (v : G), join v v v.
-Proof.
-  intros. apply ord_join; reflexivity.
-Qed.
-
-Lemma join_compat : forall v1 v2 v' v'', join v2 v' v'' -> ord v1 v2 -> exists v0, join v1 v' v0 /\ ord v0 v''.
-Proof.
-  intros.
-  destruct (join_ord _ _ _ H).
-  destruct (ord_lub v1 v' v'') as (? & ? & ?); eauto.
-  etransitivity; eauto.
-Qed.
-
-Lemma join_ord_eq : forall a b, ord a b <-> exists c, join a c b.
-Proof.
-  split.
-  - intros; exists b.
-    apply ord_join in H.
-    apply join_comm; auto.
-  - intros (? & H); apply join_ord in H; tauto.
-Qed.
-
-(* The master-snapshot PCM in the RCU paper divides the master into shares, which is useful for having both
-   an authoritative writer and an up-to-date invariant. *)
-
-Global Program Instance snap_PCM : Ghost :=
-  { valid _ := True; Join_G a b c := sepalg.join (fst a) (fst b) (fst c) /\
-      if eq_dec (fst a) Share.bot then if eq_dec (fst b) Share.bot then join (snd a) (snd b) (snd c)
-        else ord (snd a) (snd b) /\ snd c = snd b else snd c = snd a /\
-          if eq_dec (fst b) Share.bot then ord (snd b) (snd a) else snd c = snd b }.
-Next Obligation.
-  exists (fun '(sh, a) => (Share.bot, a)); repeat intro.
-  + destruct t; constructor; auto; simpl.
-    rewrite eq_dec_refl.
-    if_tac; [apply join_refl | split; auto].
-    reflexivity.
-  + destruct a, c, H as [? Hj].
-    assert (join_sub g g0) as [].
-    { if_tac in Hj. if_tac in Hj.
-      eexists; eauto.
-      destruct Hj; simpl in *; subst.
-      apply join_ord_eq; auto.
-      destruct Hj; simpl in *; subst.
-      apply join_sub_refl. }
-    eexists (_, _). split; simpl.
-    * apply join_bot_eq.
-    * rewrite !eq_dec_refl; eauto.
-  + destruct a; reflexivity.
-Defined.
-Next Obligation.
-  constructor.
-  - intros ???? [? Hjoin1] [? Hjoin2].
-    assert (fst z = fst z') by (eapply join_eq; eauto).
-    destruct z, z'; simpl in *; subst; f_equal.
-    destruct (eq_dec (fst x) Share.bot); [|destruct Hjoin1, Hjoin2; subst; auto].
-    destruct (eq_dec (fst y) Share.bot); [|destruct Hjoin1, Hjoin2; subst; auto].
-    eapply join_eq; eauto.
-  - intros ????? [Hsh1 Hjoin1] [Hsh2 Hjoin2].
-    destruct (sepalg.join_assoc Hsh1 Hsh2) as [sh' []].
-    destruct (eq_dec (fst b) Share.bot) eqn: Hb.
-    + assert (fst d = fst a) as Hd.
-      { eapply sepalg.join_eq; eauto.
-        rewrite e0; apply join_bot_eq. }
-      rewrite Hd in Hsh1, Hsh2, Hjoin2.
-      assert (sh' = fst c) as Hc.
-      { eapply sepalg.join_eq; eauto.
-        rewrite e0; apply bot_join_eq. }
-      subst sh'.
-      destruct (eq_dec (fst c) Share.bot) eqn: Hc1.
-      * destruct (eq_dec (fst a) Share.bot) eqn: Ha.
-        -- destruct (join_assoc Hjoin1 Hjoin2) as [c' []].
-            destruct a, b, c; simpl in *; subst.
-           exists (Share.bot, c'); split; split; rewrite ?eq_dec_refl; auto.
-        -- destruct Hjoin1 as [Hc' ?]; rewrite Hc' in Hjoin2.
-           destruct Hjoin2, (ord_lub (snd b) (snd c) (snd a)) as [c' []]; eauto.
-           destruct b, c; simpl in *; subst.
-           exists (Share.bot, c'); split; split; rewrite ?eq_dec_refl, ?Ha; auto.
-      * exists c.
-        destruct (eq_dec (fst a) Share.bot) eqn: Ha; try solve [split; split; auto].
-        -- destruct Hjoin2.
-           apply join_ord in Hjoin1; destruct Hjoin1.
-           destruct b; simpl in *; subst.
-           split; split; rewrite ?Ha, ?Hc1, ?eq_dec_refl; auto; split; auto; etransitivity; eauto.
-        -- destruct Hjoin2 as [He1 He2].
-           destruct Hjoin1 as [Hd' ?]; rewrite He2, Hd' in He1; split; split; rewrite ?e0, ?He2, ?He1, ?Ha, ?Hc1, ?eq_dec_refl, ?Hd'; auto.
-    + exists (sh', snd b); simpl.
-      destruct (eq_dec (fst d) Share.bot).
-      { rewrite e0 in Hsh1; apply join_Bot in Hsh1; destruct Hsh1; contradiction. }
-      destruct (eq_dec sh' Share.bot) eqn: Hn'.
-      { subst; apply join_Bot in H; destruct H; contradiction. }
-      assert (snd d = snd b) as Hd by (destruct (eq_dec (fst a) Share.bot); tauto).
-      rewrite Hd in Hjoin1, Hjoin2; destruct Hjoin2 as [He Hjoin2]; rewrite He in Hjoin2; split; split; simpl; rewrite ?Hb, ?Hn', ?Hd, ?He; auto.
-  - intros ??? []; split; [apply join_comm; auto|].
-    if_tac; if_tac; auto; tauto.
-  - intros ???? [? Hjoin1] [? Hjoin2].
-    assert (fst a = fst b) by (eapply join_positivity; eauto).
-    destruct (eq_dec (fst a) Share.bot), a, a', b, b'; simpl in *; subst; f_equal.
-    + rewrite eq_dec_refl in Hjoin2.
-      apply join_Bot in H0 as []; subst.
-      apply join_Bot in H as []; subst.
-      rewrite !eq_dec_refl in Hjoin1, Hjoin2.
-      eapply join_positivity; eauto.
-    + destruct Hjoin1; auto.
-Defined.
-Next Obligation.
-  auto.
-Defined.
-
-Definition ghost_snap (a : @G P) p := own p (Share.bot, a) NoneP.
-
-Lemma ghost_snap_join : forall v1 v2 p v, join v1 v2 v ->
-  (ghost_snap v1 p * ghost_snap v2 p = ghost_snap v p)%pred.
-Proof.
-  intros; symmetry; apply ghost_op.
-  split; simpl; rewrite ?eq_dec_refl; auto.
-Qed.
-
-Lemma prop_derives : forall (P Q : Prop), (P -> Q) -> !!P |-- !!Q.
-Proof.
-  repeat intro; simpl in *; auto.
-Qed.
-
-Lemma ghost_snap_conflict : forall v1 v2 p, ghost_snap v1 p * ghost_snap v2 p |-- !!(joins v1 v2).
-Proof.
-  intros; eapply derives_trans; [apply ghost_valid_2|].
-  apply prop_derives.
-  intros ((?, a) & (? & Hj) & _); simpl in Hj.
-  rewrite !eq_dec_refl in Hj.
-  exists a; auto.
-Qed.
-
-Lemma ghost_snap_join' : forall v1 v2 p,
-  (ghost_snap v1 p * ghost_snap v2 p = EX v : _, !!(join v1 v2 v) && ghost_snap v p)%pred.
-Proof.
-  intros; apply pred_ext.
-  - eapply derives_trans, prop_andp_left; [apply andp_right, derives_refl; apply ghost_snap_conflict|].
-    intros [v]; apply exp_right with v; apply prop_andp_right; auto.
-    erewrite ghost_snap_join; eauto.
-  - apply exp_left; intro v; apply prop_andp_left; intro.
-    erewrite ghost_snap_join; eauto.
-Qed.
-
-Definition ghost_master sh (a : @G P) p := own p (sh, a) NoneP.
-
-Lemma snap_master_join : forall v1 sh v2 p, sh <> Share.bot ->
-  (ghost_snap v1 p * ghost_master sh v2 p = !!(ord v1 v2) && ghost_master sh v2 p)%pred.
-Proof.
-  intros; setoid_rewrite own_op'.
-  apply pred_ext.
-  - apply exp_left; intro a3; apply prop_andp_left.
-    destruct a3 as (sh', ?); intros ([Hsh Hj] & _); simpl in *.
-    apply bot_identity in Hsh; subst sh'.
-    rewrite eq_dec_refl in Hj.
-    destruct (eq_dec sh Share.bot); [contradiction|].
-    destruct Hj; subst; apply prop_andp_right; auto.
-  - apply prop_andp_left; intro.
-    apply exp_right with (sh, v2), prop_andp_right; auto.
-    split; simpl; auto.
-    split; simpl; rewrite ?eq_dec_refl.
-    + apply bot_join_eq.
-    + if_tac; auto; contradiction.
-Qed.
-
-Corollary snaps_master_join : forall lv sh v2 p, sh <> Share.bot ->
-  (fold_right sepcon emp (map (fun v => ghost_snap v p) lv) * ghost_master sh v2 p =
-  !!(Forall (fun v1 => ord v1 v2) lv) && ghost_master sh v2 p)%pred.
-Proof.
-  induction lv; simpl; intros.
-  - rewrite emp_sepcon, prop_true_andp; auto.
-  - rewrite sepcon_comm, <-sepcon_assoc, (sepcon_comm (ghost_master _ _ _)), snap_master_join; auto.
-    apply pred_ext.
-    + rewrite sepcon_andp_prop1; apply prop_andp_left; intro.
-      rewrite sepcon_comm, IHlv by auto.
-      apply prop_andp_left; intro; apply prop_andp_right; auto.
-    + apply prop_andp_left; intros Hall.
-      inv Hall.
-      rewrite prop_true_andp; auto.
-      rewrite sepcon_comm, IHlv by auto.
-      apply prop_andp_right; auto.
-Qed.
-
-Lemma master_update : forall v v' p, ord v v' -> ghost_master Tsh v p |-- |==> ghost_master Tsh v' p.
-Proof.
-  intros; apply ghost_update.
-  intros ? (x & Hj & _); simpl in Hj.
-  exists (Tsh, v'); simpl; split; auto.
-  destruct Hj as [Hsh Hj]; simpl in *.
-  apply join_Tsh in Hsh as []; destruct c, x; simpl in *; subst.
-  split; auto; simpl.
-  fold share in *; destruct (eq_dec Tsh Share.bot); [contradiction Share.nontrivial|].
-  destruct Hj as [? Hc']; subst.
-  rewrite !eq_dec_refl in Hc' |- *; split; auto.
-  etransitivity; eauto.
-Qed.
-
-Lemma master_init : forall (a : @G P), exists g', joins (Tsh, a) g'.
-Proof.
-  intros; exists (Share.bot, a), (Tsh, a); simpl.
-  split; auto; simpl.
-  apply join_refl.
-Qed.
-
-Hint Resolve bupd_intro : ghost.
-
-Lemma make_snap : forall (sh : share) v p, ghost_master sh v p |-- |==> ghost_snap v p * ghost_master sh v p.
-Proof.
-  intros.
-  destruct (eq_dec sh Share.bot).
-  - subst; setoid_rewrite ghost_snap_join; [|apply join_refl]; auto with ghost.
-  - rewrite snap_master_join by auto.
-    rewrite prop_true_andp by reflexivity; apply bupd_intro.
-Qed.
-
-Lemma ghost_snap_forget : forall v1 v2 p, ord v1 v2 -> ghost_snap v2 p |-- |==> ghost_snap v1 p.
-Proof.
-  intros; apply ghost_update.
-  intros (shc, c) [(shx, x) [[? Hj] _]]; simpl in *.
-  rewrite eq_dec_refl in Hj.
-  assert (shx = shc) by (eapply sepalg.join_eq; eauto); subst.
-  unfold share in Hj; destruct (eq_dec shc Share.bot); subst.
-  - destruct (join_compat _ _ _ _ Hj H) as [x' []].
-    exists (Share.bot, x'); simpl; split; auto; split; auto; simpl.
-    rewrite !eq_dec_refl; auto.
-  - destruct Hj; subst.
-    exists (shc, c); simpl; split; auto; split; auto; simpl.
-    rewrite eq_dec_refl; if_tac; [contradiction|].
-    split; auto.
-    etransitivity; eauto.
-Qed.
-
-Lemma ghost_snap_choose : forall v1 v2 p, ghost_snap v1 p * ghost_snap v2 p |-- |==> ghost_snap v1 p.
-Proof.
-  intros.
-  setoid_rewrite own_op'.
-  apply exp_left; intro v'; apply prop_andp_left; intros [H ?].
-  destruct v', H as [Hsh Hj]; apply bot_identity in Hsh; simpl in *; subst.
-  rewrite !eq_dec_refl in Hj.
-  apply ghost_snap_forget.
-  rewrite join_ord_eq; eauto.
-Qed.
-
-Lemma master_share_join : forall sh1 sh2 sh v p, sepalg.join sh1 sh2 sh ->
-  (ghost_master sh1 v p * ghost_master sh2 v p = ghost_master sh v p)%pred.
-Proof.
-  intros; symmetry; apply ghost_op; split; auto; simpl.
-  if_tac; if_tac; try split; auto; try reflexivity; apply join_refl.
-Qed.
-
-Lemma unreadable_bot : ~readable_share Share.bot.
-Proof.
-  unfold readable_share, nonempty_share, sepalg.nonidentity.
-  rewrite Share.glb_bot; auto.
-Qed.
-
-Lemma master_inj : forall sh1 sh2 v1 v2 p, readable_share sh1 -> readable_share sh2 ->
-  ghost_master sh1 v1 p * ghost_master sh2 v2 p |-- !!(v1 = v2).
-Proof.
-  intros.
-  eapply derives_trans; [apply ghost_valid_2|].
-  apply prop_derives; intros ((?, ?) & [[? Hj] _]); simpl in Hj.
-  fold share in *.
-  destruct (eq_dec sh1 Share.bot); [subst; contradiction unreadable_bot|].
-  destruct (eq_dec sh2 Share.bot); [subst; contradiction unreadable_bot|].
-  destruct Hj; subst; auto.
-Qed.
-
-Lemma master_share_join' : forall sh1 sh2 sh v1 v2 p, readable_share sh1 -> readable_share sh2 ->
-  sepalg.join sh1 sh2 sh ->
-  (ghost_master sh1 v1 p * ghost_master sh2 v2 p = !!(v1 = v2) && ghost_master sh v2 p)%pred.
-Proof.
-  intros; apply pred_ext.
-  - eapply derives_trans; [apply andp_right, derives_refl; apply master_inj; auto|].
-    apply prop_andp_left; intros; subst.
-    apply prop_andp_right; auto.
-    erewrite master_share_join; eauto.
-  - apply prop_andp_left; intro; subst.
-    erewrite master_share_join; eauto.
-Qed.
-
-(* useful when we only want to deal with full masters *)
-Definition ghost_master1 a p := ghost_master Tsh a p.
-
-Lemma snap_master_join1 : forall v1 v2 p,
-  (ghost_snap v1 p * ghost_master1 v2 p = !!(ord v1 v2) && ghost_master1 v2 p)%pred.
-Proof.
-  intros; apply snap_master_join, Share.nontrivial.
-Qed.
-
-Lemma snap_master_update1 : forall v1 v2 p v', ord v2 v' ->
-  ghost_snap v1 p * ghost_master1 v2 p |-- |==> ghost_snap v' p * ghost_master1 v' p.
-Proof.
-  intros; rewrite !snap_master_join1.
-  apply prop_andp_left; intro.
-  rewrite prop_true_andp by reflexivity.
-  apply master_update; auto.
-Qed.
-
-End Snapshot.
-
-#[global] Hint Resolve bupd_intro : ghost.
-
-Section Discrete.
-
-#[global] Program Instance discrete_PCM (A : Type) : Ghost := { valid a := True;
-  Join_G := Join_equiv A }.
-Next Obligation.
-  auto.
-Defined.
-
-Context {A : Type}.
-
-Global Instance discrete_order : PCM_order(P := discrete_PCM A) eq.
-Proof.
-  constructor; intros.
-  - typeclasses eauto.
-  - exists c; subst; split; hnf; auto.
-  - inv H; auto.
-  - subst; hnf; auto.
-Defined.
-
-End Discrete.
diff --git a/veric/initial_world.v b/veric/initial_world.v
index 8a64b19d55..613df61afe 100644
--- a/veric/initial_world.v
+++ b/veric/initial_world.v
@@ -1,20 +1,26 @@
-Require Import VST.msl.age_to.
+From iris.algebra Require Import agree.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+From iris_ora.algebra Require Import agree.
+Require Import VST.zlist.sublist.
+Require Import VST.shared.shared.
 Require Import VST.veric.juicy_base.
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.juicy_mem_lemmas.
-Require Import VST.veric.juicy_mem_ops.
 Require Import VST.veric.res_predicates.
-
+Require Import VST.shared.resource_map.
+Require Import VST.veric.seplog.
 Require Import VST.veric.shares.
+Require Import VST.shared.dshare.
 Require Import VST.veric.mpred.
-Require Import VST.veric.age_to_resource_at.
-Import compcert.lib.Maps.
+Require Import VST.veric.mapsto_memory_block.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
+Import Values.
 
-Local Open Scope pred.
+Open Scope maps.
 
 Lemma adr_range_divide:
   forall b i p q loc,
-    p >= 0 -> q >= 0 -> (adr_range (b,i) (p+q) loc <-> (adr_range (b,i) p loc \/adr_range (b,i+p) q loc)).
+    p >= 0 -> q >= 0 -> (adr_range (b,i) (p+q) loc <-> (adr_range (b,i) p loc \/ adr_range (b,i+p) q loc)).
 Proof.
 split; intros.
 destruct loc as [b' z']; destruct H1.
@@ -23,25 +29,6 @@ destruct H3; [left|right]; split; auto; lia.
 destruct loc as [b' z']; destruct H1; destruct H1; split; auto; lia.
 Qed.
 
-Lemma VALspec_range_e:
-  forall n sh base m loc, VALspec_range n sh base  m ->
-                                adr_range base n loc -> 
-                {x | m @ loc = YES sh (snd x) (VAL (fst x)) NoneP}.
-Proof.
-intros.
-specialize (H loc).
-rewrite jam_true in H; auto.
-simpl in H.
-destruct (m @ loc); try destruct k;
-try solve [exfalso; destruct H as [? [? ?]]; inv H].
-assert (readable_share sh) by (destruct H as [? [? ?]]; auto).
-exists (m0, H1).
-simpl.
-destruct H as [? [? ?]]. 
-inv H.
-apply YES_ext; auto.
-Qed.
-
 Lemma store_init_data_outside':
   forall F V (ge: Genv.t F V)  b a m p m',
   Genv.store_init_data ge m b p a = Some m' ->
@@ -91,155 +78,15 @@ Proof.
   right. auto.
 Qed.
 
-Ltac destruct_cjoin phi HH :=
-  match goal with
-   |   |- context [@proj1_sig rmap _ ?X] => destruct X as [phi HH]; simpl
-   |  H: context [@proj1_sig rmap _ ?X] |- _ => destruct X as [phi HH]; simpl in H
-  end.
-
 Lemma split_top_neq: fst (Share.split Share.top) <> Share.top.
 Proof.
 case_eq (Share.split Share.top); intros; simpl.
 eapply nonemp_split_neq1; eauto.
 Qed.
 
-Lemma dec_pure: forall r, {exists k, exists pp, r = PURE k pp}+{core r = NO Share.bot bot_unreadable}.
-Proof.
- destruct r.
- right; apply core_NO.
- right; apply core_YES.
- left; eauto.
-Qed.
+Section mpred.
 
-Lemma store_init_data_list_lem:
-  forall F V (ge: Genv.t F V) m b lo d m',
-        Genv.store_init_data_list ge m b lo d = Some m' ->
-    forall w IOK IOK' P sh (wsh: writable_share sh),
-     ((P * VALspec_range (init_data_list_size d) sh (b,lo))%pred
-             (m_phi (initial_mem m w IOK))) ->
-     ((P * VALspec_range (init_data_list_size d) sh (b,lo))%pred
-              (m_phi (initial_mem m' w IOK'))).
-Proof.
-intros until 1. intros.
-destruct H0 as [m0 [m1 [H4 [H1 H2]]]].
-cut (exists m2,
-         join m0 m2 (m_phi (initial_mem m' w IOK')) /\
-         VALspec_range (init_data_list_size d) sh (b,lo) m2); 
-  [intros [m2 [H0 H3]] | ].
-exists m0; exists m2; split3; auto.
-rename H2 into H3.
-clear -  H H4 H3 wsh.
-assert (MA: max_access_at m = max_access_at m'). {
- clear - H.
- revert m lo H; induction d; simpl; intros. inv H; auto.
- invSome. apply IHd in H2. rewrite <- H2.
- clear - H.
- unfold max_access_at. extensionality loc.
- destruct a; simpl in H;  try rewrite (Memory.store_access _ _ _ _ _ _ H); auto.
- inv H; auto.
- invSome.  rewrite (Memory.store_access _ _ _ _ _ _ H2); auto.
- }
-apply store_init_data_list_outside' in H.
-forget (init_data_list_size d) as N.
-clear - H4  H3 H MA wsh.
-pose (f loc :=
-   if adr_range_dec (b,lo) N loc
-   then YES sh (writable_readable_share wsh) (VAL (contents_at m' loc)) NoneP
-   else core (w @ loc)).
-pose (H0 := True).
-destruct (remake_rmap f (ghost_of m1) (level w)) as [m2 [? ?]]; auto.
-intros; unfold f, no_preds; simpl; intros; repeat if_tac; auto.
-left. change fcore with (@core _ _ (fsep_sep Sep_resource)). exists (core w). rewrite core_resource_at. rewrite level_core.  auto.
-{ apply join_level in H4 as [_ Hl].
-  simpl in Hl.
-  unfold inflate_initial_mem in Hl; rewrite level_make_rmap in Hl.
-  rewrite <- Hl; apply ghost_of_approx. }
-unfold f in *; clear f.
-exists m2.
-destruct H2 as [H2 Hg2].
-split.
-* (* case 1 of 3 ****)
-apply resource_at_join2.
-subst.
-assert (level m0 = level (m_phi (initial_mem m w IOK))).
-change R.rmap with rmap in *; change R.ag_rmap with ag_rmap in *.
-apply join_level in H4; destruct H4; congruence.
-change R.rmap with rmap in *; change R.ag_rmap with ag_rmap in *.
-rewrite H5.
-simpl; repeat rewrite inflate_initial_mem_level; auto.
-rewrite H1; simpl; rewrite inflate_initial_mem_level; auto.
-destruct H as [H [H5 H7]].
-intros [b' z']; apply (resource_at_join _ _ _ (b',z')) in H4; specialize (H b' z').
-specialize (H3 (b',z')). unfold jam in H3.
-hnf in H3. if_tac in H3.
-2: rename H6 into H8.
-clear H. destruct H6 as [H H8].
-+ (* case 1.1 *)
-subst b'.
-destruct H3 as [v [p H]].
-rewrite H in H4.
-repeat rewrite preds_fmap_NoneP in H4.
-
-inv H4; [| contradiction (join_writable_readable (join_comm RJ) wsh rsh1)].
-clear H6 m0.
-rename H12 into H4.
-rewrite H2.
-rewrite if_true  by (split; auto; lia).
-clear - H4 H5 H7 RJ wsh.
-replace (m_phi (initial_mem m' w IOK') @ (b, z'))
-  with (YES sh3 rsh3 (VAL (contents_at m' (b, z'))) NoneP); [ constructor; auto |].
-revert H4.
-simpl; unfold inflate_initial_mem.
-repeat rewrite resource_at_make_rmap. unfold inflate_initial_mem'.
-rewrite <- H5.
-case_eq (access_at m (b,z') Cur); intros; auto.
-destruct p; auto;
-try solve [apply YES_inj in H4; inv H4; apply YES_ext; auto].
-destruct (w @ (b,z')); inv H4.
-inv H4.
-+ (* case 1.2 *)
-apply join_unit2_e in H4; auto.
-clear m1 H3 Hg2.
-destruct H. contradiction.
-rewrite H2; clear H2.
-rewrite if_false; auto.
-rewrite H4.
-clear - MA H5 H7 H.
-unfold initial_mem; simpl.
-unfold inflate_initial_mem; simpl.
-repeat rewrite resource_at_make_rmap.
-unfold inflate_initial_mem'.
-rewrite <- H5.
-specialize (IOK (b',z')). simpl in IOK.
-destruct IOK as [IOK1 IOK2].
-rewrite <- H.
-revert IOK2; case_eq (w @ (b',z')); intros.
-change fcore with (@core _ _ (fsep_sep Sep_resource)). rewrite core_NO.
-destruct (access_at m (b', z')); try destruct p; try constructor; auto.
-change fcore with (@core _ _ (fsep_sep Sep_resource)). rewrite core_YES.
-destruct (access_at m (b', z')); try destruct p0; try constructor; auto.
-destruct IOK2 as [? [? ?]].
-rewrite H2. change fcore with (@core _ _ (fsep_sep Sep_resource)). rewrite core_PURE; constructor.
-+
-apply ghost_of_join in H4.
-unfold initial_mem in *; simpl in *; unfold inflate_initial_mem in *; simpl in *.
-rewrite ghost_of_make_rmap in *.
-rewrite Hg2; auto.
-* (**** case 2 of 3 ****)
-intro loc.
-specialize (H3 loc).
-hnf in H3|-*.
-if_tac.
-generalize (refl_equal (m2 @ loc)).  pattern (resource_at m2) at 2; rewrite H2.
-rewrite if_true; auto.
-intro.
-econstructor. econstructor.
-hnf. repeat rewrite preds_fmap_NoneP.
-apply H6.
-do 3 red. rewrite H2.
-rewrite if_false; auto.
-apply core_identity.
-Qed.
+Context `{!heapGS Σ}.
 
 Lemma fold_right_rev_left:
   forall (A B: Type) (f: A -> B -> A) (l: list B) (i: A),
@@ -317,212 +164,99 @@ Lemma find_id_app2 {A} i x G2: forall G1, list_norepet (map fst (G1++G2)) ->
   Proof.
     induction G1; simpl; intros. trivial. 
     destruct a. inv H. destruct (eq_dec i i0); [subst i0; elim H3; clear - H0 | auto].
-    apply initial_world.find_id_e in H0. apply (in_map fst) in H0.
+    apply find_id_e in H0. apply (in_map fst) in H0.
     rewrite map_app. apply in_or_app; right. apply H0.
   Qed.
 
-Definition initial_core' {F} (ge: Genv.t (fundef F) type) (G: funspecs) (n: nat) (loc: address) : resource :=
-   if Z.eq_dec (snd loc) 0
-   then match Genv.invert_symbol ge (fst loc) with
-           | Some id =>
-                  match find_id id G with
-                  | Some (mk_funspec fsig cc A P Q _ _) =>
-                           PURE (FUN fsig cc) (SomeP (SpecArgsTT A) (fun ts => fmap _ (approx n) (approx n) (packPQ P Q ts)))
-                  | None => NO Share.bot bot_unreadable
-                  end
-           | None => NO Share.bot bot_unreadable
-          end
-   else NO Share.bot bot_unreadable.
-
-(* This version starts with an empty ghost. *)
-Program Definition initial_core {F} (ge: Genv.t (fundef F) type) (G: funspecs) (n: nat): rmap :=
-  proj1_sig (make_rmap (initial_core' ge G n) nil n _ eq_refl).
-Next Obligation.
-intros.
-extensionality loc; unfold compose, initial_core'.
-if_tac; [ | simpl; auto].
-destruct (Genv.invert_symbol ge (fst loc)); [ | simpl; auto].
-destruct (find_id i G); [ | simpl; auto].
-destruct f.
-unfold resource_fmap.
-f_equal.
-simpl.
-f_equal.
-change R.approx with approx.
-extensionality i0 ts b rho.
-rewrite fmap_app.
-pattern (approx n) at 7 8 9.
-rewrite <- approx_oo_approx.
-auto.
-Qed.
-
-(* We can also start with knowledge of the external state.
-   Requirements for this PCM:
-   1. It must not allow the holding thread to change the value.
-   2. It must allow the holding thread to know the value.
-   3. The holding thread must be able to synchronize with the outside world
-      to change the value.
-   For this purpose, we use the reference PCM. *)
-
-Require Import VST.veric.ghost_PCM.
-Import Ctypes.
+Section inflate.
+(* build an initial resource map from a CompCert memory, including funspecs *)
+Variable (m: mem) (block_bounds: block -> (Z * nat)).
+Context {F} (ge: Genv.t (fundef F) type) (G: funspecs(Σ := Σ)).
+
+Definition funspec_of_loc loc := if eq_dec loc.2 0 then
+  match Genv.invert_symbol ge loc.1 with
+  | Some id => find_id id G
+  | None => None
+  end else None.
+
+Definition inflate_loc loc := 
+  match access_at m loc Cur with
+  | Some Freeable => loc ↦ VAL (contents_at m loc)
+  | Some Writable => loc ↦{#Ews} VAL (contents_at m loc)
+  | Some Readable => loc ↦{#Ers} VAL (contents_at m loc)
+  | Some Nonempty => match funspec_of_loc loc with
+                     | Some f => func_at f loc
+                     | _ => mapsto_no loc Share.bot
+                     end
+  | _ => mapsto_no loc Share.bot
+  end.
 
-Program Definition initial_core_ext {F Z} (ora : Z) (ge: Genv.t (fundef F) type) (G: funspecs) (n: nat): rmap :=
-  proj1_sig (make_rmap (initial_core' ge G n) (Some (ext_ghost ora, NoneP) :: nil) n _ eq_refl).
-Next Obligation.
-intros.
-extensionality loc; unfold compose, initial_core'.
-if_tac; [ | simpl; auto].
-destruct (Genv.invert_symbol ge (fst loc)); [ | simpl; auto].
-destruct (find_id i G); [ | simpl; auto].
-destruct f.
-unfold resource_fmap.
-f_equal.
-simpl.
-f_equal.
-change R.approx with approx.
-extensionality i0 ts b rho.
-rewrite fmap_app.
-pattern (approx n) at 7 8 9.
-rewrite <- approx_oo_approx.
-auto.
-Qed.
+Lemma readable_Ews : readable_share Ews.
+Proof. auto. Qed.
+
+Definition res_of_loc (loc : address) : sharedR (leibnizO resource) :=
+  match access_at m loc Cur with
+  | Some Freeable => (shared.YES(V := leibnizO resource) (DfracOwn (Share Tsh)) readable_top (to_agree (VAL (contents_at m loc))))
+  | Some Writable => (shared.YES(V := leibnizO resource) (DfracOwn (Share Ews)) readable_Ews (to_agree (VAL (contents_at m loc))))
+  | Some Readable => (shared.YES(V := leibnizO resource) (DfracOwn (Share Ers)) readable_Ers (to_agree (VAL (contents_at m loc))))
+  | Some Nonempty => match funspec_of_loc loc with
+                     | Some _ => (shared.YES(V := leibnizO resource) (DfracBoth (Share Share.bot)) I (to_agree FUN))
+                     | _ => (shared.NO (Share Share.bot) bot_unreadable)
+                     end
+  | _ => (shared.NO (Share Share.bot) bot_unreadable)
+  end.
 
-(* The initial state is compatible with the ghost-state machinery for invariants. *)
+(* Put an extra NO Share.bot on the end to avoid problems with size-0 gvars. *)
+Definition rmap_of_mem : gmapR address (sharedR (leibnizO resource)) :=
+  [^op list] n ∈ seq 1 (Pos.to_nat (Mem.nextblock m) - 1),
+  let b := Pos.of_nat n in let '(lo, z) := block_bounds b in
+  [^op list] o ∈ seq 0 (z + 1), let loc := (b, lo + Z.of_nat o)%Z in {[loc := res_of_loc loc]}.
 
-Require Import VST.veric.invariants.
-Require Import VST.veric.juicy_extspec.
+Definition inflate_initial_mem : mpred :=
+  [∗ list] n ∈ seq 1 (Pos.to_nat (Mem.nextblock m) - 1),
+  let b := Pos.of_nat n in let '(lo, z) := block_bounds b in
+  [∗ list] o ∈ seq 0 (z + 1), let loc := (b, lo + Z.of_nat o)%Z in inflate_loc loc.
 
-Definition wsat_ghost : ghost :=
-  (None ::
-   Some (existT _ (ghosts.snap_PCM(ORD := list_order own.gname)) (exist _ (Tsh, nil) I), NoneP) ::
-   Some (existT _ set_PCM (exist _ Ensembles.Full_set I), NoneP) ::
-   Some (existT _ (list_PCM token_PCM) (exist _ nil I), NoneP) ::
-   nil).
+(* What do we actually need this for?
+Definition all_VALs := ∀ l dq r, <absorb> l ↦{dq} r → ⌜∃ v, r = VAL v⌝.
 
-Program Definition wsat_rmap (r : rmap) :=
-  proj1_sig (make_rmap (resource_at (core r)) wsat_ghost (level r) _ _).
-Next Obligation.
+Lemma inflate_initial_mem_all_VALs: inflate_initial_mem ⊢ all_VALs.
 Proof.
-  extensionality l; unfold compose. rewrite <- core_resource_at. apply resource_fmap_core.
-Qed.
-
-Lemma wsat_rmap_wsat : forall r, (wsat * ghost_set g_en Ensembles.Full_set)%pred (wsat_rmap r).
-Proof.
-  intros.
-  unfold wsat.
-  do 3 (rewrite exp_sepcon1; exists nil).
-  rewrite prop_true_andp by auto.
-  rewrite !sepcon_assoc, (sepcon_comm (iter_sepcon _ _)).
-  rewrite <- (sepcon_assoc (ghost_set _ _)), ghost_set_join.
-  replace (fun i : iname => nth i nil None = Some false) with (Ensembles.Empty_set(U := iname)).
-  rewrite prop_true_andp, Union_Empty.
-  destruct (make_rmap (resource_at (core r)) (None :: Some (existT _ (ghosts.snap_PCM(ORD := list_order own.gname)) (exist _ (Tsh, nil) I), NoneP) :: nil) (level r))
-    as (r_inv & ? & Hr1 & Hg1).
-  { extensionality l; unfold compose. rewrite <- core_resource_at. apply resource_fmap_core. }
-  { auto. }
-  destruct (make_rmap (resource_at (core r)) (None :: None :: Some (existT _ set_PCM (exist _ Ensembles.Full_set I), NoneP) ::
-   Some (existT _ (list_PCM token_PCM) (exist _ nil I), NoneP) :: nil) (level r))
-    as (r_rest & ? & Hr2 & Hg2).
-  { extensionality l; unfold compose. rewrite <- core_resource_at. apply resource_fmap_core. }
-  { auto. }
-  exists r_inv, r_rest; split.
-  { unfold wsat_rmap; apply resource_at_join2; rewrite ?level_make_rmap, ?resource_at_make_rmap, ?ghost_of_make_rmap; auto.
-    + intros; rewrite Hr1, Hr2; apply resource_at_join, core_duplicable.
-    + rewrite Hg1, Hg2; unfold wsat_ghost; repeat constructor. }
-  split.
-  - simpl.
-    exists I.
-    rewrite Hr1, Hg1; split.
-    + apply resource_at_core_identity.
-    + apply join_sub_refl.
-  - destruct (make_rmap (resource_at (core r)) (None :: None :: Some (existT _ set_PCM (exist _ Ensembles.Full_set I), NoneP) ::
-     None :: nil) (level r))
-      as (r_en & ? & Hr3 & Hg3).
-    { extensionality l; unfold compose. rewrite <- core_resource_at. apply resource_fmap_core. }
-    { auto. }
-    destruct (make_rmap (resource_at (core r)) (None :: None :: None ::
-     Some (existT _ (list_PCM token_PCM) (exist _ nil I), NoneP) :: nil) (level r))
-      as (r_dis & ? & Hr4 & Hg4).
-    { extensionality l; unfold compose. rewrite <- core_resource_at. apply resource_fmap_core. }
-    { auto. }
-    exists r_dis, r_en; split.
-    { apply resource_at_join2; try congruence.
-      + intros; rewrite Hr2, Hr3, Hr4; apply resource_at_join, core_duplicable.
-      + rewrite Hg2, Hg3, Hg4; repeat constructor. }
-    simpl iter_sepcon; rewrite sepcon_emp.
-    split; simpl.
-    + exists I.
-      rewrite Hr4, Hg4; split.
-      * apply resource_at_core_identity.
-      * apply join_sub_refl.
-    + exists I.
-      rewrite Hr3, Hg3; split.
-      * apply resource_at_core_identity.
-      * eexists; repeat constructor.
-  - constructor; intros ? X; inv X.
-    inv H.
-  - extensionality; apply prop_ext; split; intro.
-    + inv H.
-    + destruct x; inv H.
-Qed.
-
-Lemma wsat_no : forall r, (ALL l, noat l) (wsat_rmap r).
-Proof.
-  simpl; intros; unfold wsat_rmap.
-  rewrite resource_at_make_rmap; apply resource_at_core_identity.
-Qed.
-
-Corollary wsat_rmap_resource : forall r r', join r (wsat_rmap r) r' -> resource_at r' = resource_at r.
-Proof.
-  intros.
-  extensionality l; apply (resource_at_join _ _ _ l) in H.
-  apply join_comm, wsat_no in H; auto.
-Qed.
+  rewrite /inflate_initial_mem /all_VALs.
+  iIntros "H" (???); iApply (bi.impl_intro_r with "H"); iIntros "H".
+  forget (Pos.to_nat (nextblock m) - 1) as n; iInduction n as [|] "IH".
+  { simpl. Search bi_affinely bi_absorbingly.
+Search emp.
+Abort.
+*)
+
+Definition initial_core : mpred :=
+  [∗ list] n ∈ seq 1 (Pos.to_nat (Mem.nextblock m) - 1),
+  let b := Pos.of_nat n in
+  match funspec_of_loc (b, 0) with
+  | Some f => func_at f (b, 0)
+  | None => mapsto_no (b, 0) Share.bot
+  end.
 
-Lemma wsat_rmap_ghost : forall r r', joins r (wsat_rmap r) -> level r' = level r -> ghost_of r' = ghost_of r ->
-  joins r' (wsat_rmap r').
+Global Instance initial_core_affine : Affine initial_core.
 Proof.
-  intros ?? [z ?] Hl Hg.
-  destruct (make_rmap (resource_at r') (ghost_of z) (level r')) as (z' & ? & Hr' & Hg').
-  { extensionality l; apply resource_at_approx. }
-  { rewrite Hl; apply join_level in H as [->]; apply ghost_of_approx. }
-  exists z'; apply resource_at_join2; auto.
-  - unfold wsat_rmap; rewrite level_make_rmap; auto.
-  - intros l; apply (resource_at_join _ _ _ l) in H.
-    unfold wsat_rmap; rewrite resource_at_make_rmap, Hr'.
-    apply join_comm, resource_at_join, core_unit.
-  - rewrite Hg, Hg'.
-    apply ghost_of_join in H.
-    unfold wsat_rmap in *; rewrite ghost_of_make_rmap in *; auto.
+  apply big_sepL_affine; intros ??.
+  destruct (funspec_of_loc _); apply _.
 Qed.
 
-Lemma age_to_wsat_rmap : forall n r, (n <= level r)%nat -> age_to n (wsat_rmap r) = wsat_rmap (age_to n r).
-Proof.
-  intros; apply rmap_ext.
-  - unfold wsat_rmap; rewrite level_make_rmap, !level_age_to; auto.
-    rewrite level_make_rmap; auto.
-  - intros; unfold wsat_rmap; rewrite resource_at_make_rmap, <- core_resource_at, !age_to_resource_at,
-      resource_at_make_rmap.
-    rewrite <- core_resource_at, resource_fmap_core'; auto.
-  - unfold wsat_rmap; rewrite ghost_of_make_rmap, !age_to_ghost_of, ghost_of_make_rmap; auto.
-Qed.
+End inflate.
 
 Lemma list_disjoint_rev2:
    forall A (l1 l2: list A), list_disjoint l1 (rev l2) = list_disjoint l1 l2.
 Proof.
 intros.
 unfold list_disjoint.
-apply prop_ext; split; intros; eapply H; eauto.
+apply Axioms.prop_ext; split; intros; eapply H; eauto.
 rewrite <- In_rev; auto.
 rewrite In_rev; auto.
 Qed.
 
-Require Import VST.veric.mapsto_memory_block.
-
-Open Scope pred.
-
-Lemma writable_blocks_app:
+(*Lemma writable_blocks_app:
   forall bl bl' rho, writable_blocks (bl++bl') rho = writable_blocks bl rho * writable_blocks bl' rho.
 Proof.
 induction bl; intros.
@@ -532,7 +266,7 @@ destruct a as [b n]; simpl.
 rewrite sepcon_assoc.
 f_equal.
 apply IHbl.
-Qed.
+Qed.*)
 
 Fixpoint prog_funct' {F V} (l: list (ident * globdef F V)) : list (ident * F) :=
  match l with nil => nil | (i,Gfun f)::r => (i,f):: prog_funct' r | _::r => prog_funct' r
@@ -548,10 +282,10 @@ Lemma find_symbol_add_globals_nil:
 Proof. intros. simpl.
        unfold Genv.find_symbol, Genv.add_global in *; simpl.
       destruct (eq_dec i id); subst.
-        rewrite PTree.gss. intuition. congruence.
-        rewrite PTree.gso by auto. split; intro Hx.
-        rewrite PTree.gempty in Hx; inv Hx.
-         inv Hx. congruence.
+        rewrite Maps.PTree.gss. intuition. congruence.
+        rewrite -> Maps.PTree.gso by auto. split; intro Hx.
+        rewrite Maps.PTree.gempty in Hx; inv Hx.
+         inv Hx.
 Qed.
 
 Lemma find_symbol_add_globals_cons:
@@ -563,7 +297,7 @@ Lemma find_symbol_add_globals_cons:
 Proof.
 intros.
   assert (Genv.genv_next (Genv.empty_genv F V prog_pub) = 1%positive)  by reflexivity.
-  assert (Genv.find_symbol (Genv.empty_genv F V prog_pub)  id = None) by (intros; apply PTree.gempty).
+  assert (Genv.find_symbol (Genv.empty_genv F V prog_pub)  id = None) by (intros; apply Maps.PTree.gempty).
  forget (Genv.empty_genv F V prog_pub) as ge.
  forget (1%positive) as n.
   revert ge n H H0 H1 H2 HD; induction dl; intros.
@@ -571,7 +305,7 @@ intros.
         simpl in *. rewrite Zlength_nil in HD. lia.
   (*induction step*)
         simpl; auto.
-        rewrite Zlength_cons in *.
+        rewrite -> Zlength_cons in *.
         destruct a as [a ag]; simpl in *.
         destruct dl.
           simpl in *. clear IHdl.
@@ -579,17 +313,17 @@ intros.
           clear H; destruct H3.
           destruct (eq_dec id a).
             subst id. unfold Genv.find_symbol, Genv.add_global; simpl.
-              rewrite PTree.gso; trivial. rewrite H1.
-              rewrite PTree.gss.
+              rewrite Maps.PTree.gso; trivial. rewrite H1.
+              rewrite Maps.PTree.gss.
               split; intro; try congruence. assert (n = n+1)%positive. clear - H4. congruence. lia.
           unfold Genv.find_symbol, Genv.add_global; simpl.
             rewrite H1.
             destruct (eq_dec id i).
               subst i.
-              rewrite PTree.gss. rewrite Pplus_one_succ_r.
+              rewrite Maps.PTree.gss. rewrite Pplus_one_succ_r.
                 split; intro; try congruence. trivial.
-              rewrite PTree.gso; trivial.
-              rewrite PTree.gso; trivial.
+              rewrite Maps.PTree.gso; trivial.
+              rewrite Maps.PTree.gso; trivial.
               unfold Genv.find_symbol in H2. rewrite H2.
               split; intros. congruence. subst. exfalso. apply n1; trivial.
 
@@ -598,8 +332,7 @@ intros.
         2: { clear - n dl. rewrite Z2Pos.inj_succ.
                    rewrite Pplus_one_succ_r. rewrite Pplus_one_succ_l.
                      rewrite Pos.add_assoc. trivial.
-                   rewrite Zlength_correct. simpl.
-                     rewrite Pos.of_nat_succ. apply Pos2Z.is_pos. }
+                   rewrite Zlength_correct. simpl. lia. }
         simpl in H0. inv H0.
         assert (a<>i /\ ~ In i (map fst (p::dl))) by (clear - H; intuition).
         clear H; destruct H0.
@@ -613,7 +346,7 @@ intros.
              simpl in H3. destruct H3; try congruence.
          forget ((p::dl) ++ (i, g) :: nil) as vl.
          assert (Genv.find_symbol (Genv.add_global ge (a,ag)) a = Some (Genv.genv_next ge)).
-            unfold Genv.find_symbol, Genv.add_global; simpl. rewrite PTree.gss; auto.
+            unfold Genv.find_symbol, Genv.add_global; simpl. rewrite Maps.PTree.gss; auto.
 
          forget (Genv.add_global ge (a,ag)) as ge1.
          forget (Genv.genv_next ge) as N; clear ge H2.
@@ -624,14 +357,13 @@ intros.
             inversion2 H1 H4; lia.
          apply (IHvl (Genv.add_global ge1 a0) K H2); auto.
            unfold Genv.find_symbol, Genv.add_global in H4|-*; simpl in *.
-           rewrite PTree.gso; auto.
+           rewrite Maps.PTree.gso; auto.
 
 
          apply IHdl; auto.
         unfold Genv.find_symbol, Genv.add_global in H2|-*; simpl.
-                 rewrite PTree.gso; auto.
-                   rewrite Zlength_correct. simpl.
-                     rewrite Pos.of_nat_succ. apply Pos2Z.is_pos.
+                 rewrite Maps.PTree.gso; auto.
+                   rewrite Zlength_correct. simpl. lia.
 Qed.
 
 Lemma find_symbol_add_globals:
@@ -652,8 +384,7 @@ intros.
 destruct dl.
   intros; apply find_symbol_add_globals_nil.
   apply find_symbol_add_globals_cons; trivial.
-    rewrite Zlength_correct. simpl.
-    rewrite Pos.of_nat_succ. apply Pos2Z.is_pos.
+    rewrite Zlength_correct. simpl. lia.
 Qed.
 
 
@@ -675,8 +406,7 @@ intros.
 destruct dl.
   intros; apply find_symbol_add_globals_nil.
   apply find_symbol_add_globals_cons; trivial.
-    rewrite Zlength_correct. simpl.
-    rewrite Pos.of_nat_succ. apply Pos2Z.is_pos.
+    rewrite Zlength_correct. simpl. lia.
 Qed.
 
 Lemma nth_error_app: forall {T} (al bl : list T) (j: nat),
@@ -685,14 +415,6 @@ Proof.
  intros. induction al; simpl; auto.
 Qed.
 
-Lemma nth_error_app1: forall {T} (al bl : list T) (j: nat),
-     (j < length al)%nat ->
-     nth_error (al++bl) j = nth_error al j.
-Proof.
-  intros. revert al H; induction j; destruct al; simpl; intros; auto; try lia.
-   apply IHj. lia.
-Qed.
-
 Lemma nth_error_rev:
   forall T (vl: list T) (n: nat),
    (n < length vl)%nat ->
@@ -705,38 +427,24 @@ Proof.
  rewrite <- (Nat.add_0_r (length (rev vl))).
  rewrite nth_error_app.
  case_eq (length vl); intros. simpl. auto.
- replace (S n - n - 1)%nat with O by lia.
+ simpl. replace (S n - n - 1)%nat with O by lia.
  simpl; auto.
- rewrite nth_error_app1 by (rewrite rev_length; lia).
- rewrite IHvl by lia. clear IHvl.
+ rewrite -> nth_error_app1 by (rewrite rev_length; lia).
+ rewrite -> IHvl by lia. clear IHvl.
  destruct n; destruct (length vl). congruence.
  simpl. replace (n-0)%nat with n by lia; auto.
  lia.
- replace (S n1 - n - 1)%nat with (S (S n1 - S n - 1))%nat by lia.
+ simpl; replace (S n1 - n - 1)%nat with (S (S n1 - S n - 1))%nat by lia.
  reflexivity.
 Qed.
 
-Lemma Zlength_app: forall T (al bl: list T),
-    Zlength (al++bl) = Zlength al + Zlength bl.
-Proof. induction al; intros. simpl app; rewrite Zlength_nil; lia.
- simpl app; repeat rewrite Zlength_cons; rewrite IHal; lia.
-Qed.
-Lemma Zlength_rev: forall T (vl: list T), Zlength (rev vl) = Zlength vl.
-Proof. induction vl; simpl; auto. rewrite Zlength_cons. rewrite <- IHvl.
-rewrite Zlength_app. rewrite Zlength_cons. rewrite Zlength_nil; lia.
-Qed.
-
-Lemma Zlength_map: forall A B (f: A -> B) l, Zlength (map f l) = Zlength l.
-Proof. induction l; simpl; auto. repeat rewrite Zlength_cons. f_equal; auto.
-Qed.
-
 (*Partial attempt at porting add_globals_hack*)
 Lemma add_globals_hack_nil {F}:
    forall gev prog_pub,
     gev = Genv.add_globals (Genv.empty_genv (fundef F) type prog_pub) (rev nil) ->
    forall id, Genv.find_symbol gev id = None.
 Proof. simpl; intros; subst.
-  unfold Genv.find_symbol, Genv.empty_genv. simpl. apply PTree.gempty.
+  unfold Genv.find_symbol, Genv.empty_genv. simpl. apply Maps.PTree.gempty.
 Qed.
 
 Lemma add_globals_hack_single {F}:
@@ -746,11 +454,11 @@ Lemma add_globals_hack_single {F}:
 Proof. simpl; intros; subst.
   unfold Genv.find_symbol, Genv.empty_genv. simpl.
   destruct (peq (fst v) id).
-     subst id. rewrite PTree.gss.
+     subst id. rewrite Maps.PTree.gss.
        split; intros. split; trivial. congruence.
        destruct H; subst. trivial.
-  rewrite PTree.gso.
-    split; intros. rewrite PTree.gempty in H. inv H.
+  rewrite Maps.PTree.gso.
+    split; intros. rewrite Maps.PTree.gempty in H. inv H.
     destruct H; subst. congruence.
   auto.
 Qed.
@@ -762,14 +470,13 @@ Proof.
   simpl Pos.of_nat. rewrite Pos.add_comm. symmetry. apply Pos.add_sub.
   simpl length. rewrite IHvl. rewrite Pplus_one_succ_l.
   f_equal.
-  symmetry; rewrite Nat2Pos.inj_succ by lia.
+  symmetry; rewrite -> Nat2Pos.inj_succ by lia.
   rewrite Pplus_one_succ_r. symmetry; apply Pos.add_assoc.
 Qed.
 
 Lemma Zpos_Posofnat: forall n, (n>0)%nat -> Z.pos (Pos.of_nat n) = Z.of_nat n.
 Proof.
- intros. destruct n. lia. simpl  Z.of_nat. f_equal.
- symmetry; apply Pos.of_nat_succ.
+ intros. destruct n. lia. simpl  Z.of_nat. f_equal. lia.
 Qed.
 
 Lemma add_globals_hack {F}:
@@ -779,7 +486,7 @@ Lemma add_globals_hack {F}:
 
    (forall id b, 0 <= Zpos b - 1 < Zlength vl ->
                            (Genv.find_symbol gev id = Some b <->
-                            nth_error (map (@fst _ _) vl) (length vl - Pos.to_nat b)  = Some id)).
+                            nth_error (map (@fst _ _) vl) (length vl - Pos.to_nat b) = Some id)).
 Proof. intros. subst.
      apply iff_trans with (nth_error (map fst (rev vl)) (Z.to_nat (Zpos b - 1)) = Some id).
    2: {
@@ -797,8 +504,8 @@ Proof. intros. subst.
   rename H1 into Hb; revert H; induction vl; simpl rev; simpl map;
        simpl Genv.find_symbol; intros;
        try rewrite Zlength_nil in *.
-      unfold Genv.find_symbol. rewrite PTree.gempty.
-     intuition lia.
+      unfold Genv.find_symbol. rewrite Maps.PTree.gempty.
+     intuition auto; try done. rewrite -> nth_error_nil in *; done.
        destruct a. inv H. rewrite Zlength_cons in Hb.
        destruct (eq_dec (Z.pos b-1) (Zlength vl)).
         clear IHvl Hb. rewrite e. rewrite Zlength_correct.
@@ -831,7 +538,7 @@ Proof. intros. subst.
     unfold Genv.find_symbol, Genv.add_global.
     simpl Genv.genv_symb.
     destruct (eq_dec id i).
-    + subst i. rewrite PTree.gss.
+    + subst i. rewrite Maps.PTree.gss.
       rewrite Genv.genv_next_add_globals.
       rewrite advance_next_length.
       simpl Genv.genv_next.
@@ -842,7 +549,7 @@ Proof. intros. subst.
         clear H; rename H' into H.
           subst b. exfalso; apply n; clear.
           rewrite <- Zlength_rev. rewrite Zlength_correct. forget (length (rev vl)) as i.
-          rewrite Zpos_Posofnat by lia. rewrite Nat2Z.inj_succ. unfold Z.succ.  lia.
+          rewrite -> Zpos_Posofnat by lia. rewrite Nat2Z.inj_succ. unfold Z.succ.  lia.
      - exfalso.
        assert (Z.pos b-1 >= 0) by (clear - Hb; lia).
        pose proof (Z2Nat.id _ (Z.ge_le _ _ H0)).
@@ -857,7 +564,7 @@ Proof. intros. subst.
        revert al H2 H; clear; induction j; destruct al; simpl; intros; auto. inv H; intuition.
        exfalso; clear - H; induction j; inv H; auto.
        f_equal. apply IHj; auto.
-    + rewrite PTree.gso by auto.
+    + rewrite -> Maps.PTree.gso by auto.
       rewrite map_app.
       destruct IHvl.
       split; intro.
@@ -881,7 +588,7 @@ Proof. intros. subst.
           rewrite H0. forget (map fst (rev vl) ++ map fst ((i, g) :: nil)) as al.
           clear - H1. revert al H1; induction j; destruct al; simpl in *; intros; inv H1; auto; try lia.
           specialize (IHj _ H0); lia. }
-        rewrite nth_error_app1 in H1 by auto.
+        rewrite -> nth_error_app1 in H1 by auto.
         apply H0 in H1. auto.
 Qed.
 
@@ -900,20 +607,19 @@ assert (RANGE: 0 <= Z.pos b - 1 < Zlength (rev (prog_defs prog))). {
  rewrite <- (rev_involutive (prog_defs prog)) in H0.
  clear - H0.
  revert H0; induction (rev (prog_defs prog));  simpl Genv.find_symbol; intros.
- unfold Genv.find_symbol in H0. simpl in H0. rewrite PTree.gempty in H0; inv H0.
+ unfold Genv.find_symbol in H0. simpl in H0. rewrite Maps.PTree.gempty in H0; inv H0.
  rewrite Genv.add_globals_app in H0.
  simpl in H0. destruct a.
  destruct (eq_dec i0 i). subst.
  unfold Genv.add_global, Genv.find_symbol in H0. simpl in H0.
- rewrite PTree.gss  in H0. inv H0.
+ rewrite Maps.PTree.gss in H0. inv H0.
  clear.
  split.
  match goal with |- _ <= Z.pos ?A - _ => pose proof (Zgt_pos_0  A); lia end.
  rewrite Zlength_cons.
- induction l. simpl. lia.
+ induction l. rewrite Zlength_nil /=. lia.
  rewrite Zlength_cons.
- Opaque Z.sub. simpl. Transparent Z.sub.
- rewrite Genv.add_globals_app.
+ rewrite /= Genv.add_globals_app.
    simpl Genv.genv_next.
  match goal with |- context [Pos.succ ?J] =>
   forget J as j
@@ -922,7 +628,7 @@ assert (RANGE: 0 <= Z.pos b - 1 < Zlength (rev (prog_defs prog))). {
  replace (Z.pos (Pos.succ j) - 1) with (Z.succ (Z.pos j - 1)). lia.
   unfold Z.succ.  rewrite Pos2Z.inj_succ.  lia.
  unfold Genv.add_global, Genv.find_symbol in IHl, H0. simpl in H0.
- rewrite PTree.gso in H0 by auto.
+ rewrite -> Maps.PTree.gso in H0 by auto.
  apply IHl in H0.
  rewrite Zlength_cons. lia.
  }
@@ -947,9 +653,9 @@ assert (RANGE: 0 <= Z.pos b - 1 < Zlength (rev (prog_defs prog))). {
  clear - RANGE.
  rewrite Zlength_rev in RANGE. rewrite Zlength_correct in RANGE.
  rewrite <- (Z2Nat.id (Z.pos b)) in * by lia.
- rewrite Z2Nat.inj_pos in *.
+ rewrite -> Z2Nat.inj_pos in *.
  forget (Pos.to_nat b) as n. clear b.
- replace (Z.of_nat n - 1) with (Z.of_nat (n-1)) by (rewrite inj_minus1 by lia; f_equal; auto).
+ replace (Z.of_nat n - 1) with (Z.of_nat (n-1)) by (rewrite -> inj_minus1 by lia; f_equal; auto).
  rewrite Nat2Z.id.
  lia.
  inv H1.
@@ -1026,7 +732,7 @@ Proof. intros.
 Qed.
 
 Lemma alloc_globals_rev_nextblock:
-  forall {F V} (ge: Genv.t F V) vl m, alloc_globals_rev ge empty vl = Some m ->
+  forall {F V} (ge: Genv.t F V) vl m, alloc_globals_rev ge Mem.empty vl = Some m ->
      nextblock m = Z.to_pos(Z.succ (Zlength vl)).
 Proof.
   intros.
@@ -1078,7 +784,7 @@ Proof.
  transitivity (contents_at m' loc).
  Transparent store. unfold store in e0.
  remember (valid_access_dec m Mint8unsigned b p Writable) as d.
- destruct d; inv e0. unfold contents_at; simpl. rewrite PMap.gso by auto. auto.
+ destruct d; inv e0. unfold contents_at; simpl. rewrite -> Maps.PMap.gso by auto. auto.
  eapply IHR_store_zeros; eauto.
  Opaque store.
 Qed.
@@ -1103,7 +809,7 @@ Proof.
  simpl in *.
  Transparent alloc. unfold alloc in H. Opaque alloc.
  inv H; simpl in *.
- rewrite PMap.gss. repeat rewrite (PMap.gso _ _ NEQ). auto.
+ rewrite Maps.PMap.gss. repeat rewrite (Maps.PMap.gso _ _ NEQ). auto.
 *
  forget (init_data_list_size (gvar_init v)) as N.
  revert H; case_eq (alloc m 0 N); intros.
@@ -1115,11 +821,11 @@ Proof.
  left. intro. subst b0. apply alloc_result in H. contradiction.
  Transparent alloc. unfold alloc in H. Opaque alloc.
  unfold contents_at. inv H. simpl.
- rewrite PMap.gso by auto. auto.
+ rewrite -> Maps.PMap.gso by auto. auto.
  }
  assert (b0=nextblock m) by (inv H; auto). subst b0.
  unfold max_access_at.
- destruct H2 as [H2a H2b]; rewrite H2a,H2b; clear H H2a H2b.
+ destruct H2 as [H2a H2b]; rewrite H2a H2b; clear H H2a H2b.
  rewrite <- (store_zeros_access _ _ _ _ _ H1).
  apply store_zeros_contents1 with (loc:= (b,ofs)) in H1.
  2: simpl; congruence. rewrite H1; clear H1 m0.
@@ -1132,15 +838,7 @@ Proof.
  destruct (range_perm_dec m2 (nextblock m) 0 N Cur Freeable); inv H5.
  unfold contents_at, access_at, max_access_at in *;
  simpl in *.
-  repeat rewrite (PMap.gso _ _ NEQ). auto.
-Qed.
-
-Program Definition set_ghost (m : rmap) (g : ghost) (Hg : _) :=
-  proj1_sig (make_rmap (resource_at m) g (level m) _ Hg).
-Next Obligation.
-Proof.
-  intros.
-  extensionality; apply resource_at_approx.
+  repeat rewrite (Maps.PMap.gso _ _ NEQ). auto.
 Qed.
 
 Fixpoint prog_vars' {F V} (l: list (ident * globdef F V)) : list (ident * globvar V) :=
@@ -1149,103 +847,515 @@ Fixpoint prog_vars' {F V} (l: list (ident * globdef F V)) : list (ident * globva
 
 Definition prog_vars {F} (p: program F) := prog_vars' (prog_defs p).
 
-Definition no_locks phi :=
-  forall addr sh sh' z z' P,
-    phi @ addr <> YES sh sh' (LK z z') P.
+(* What do we actually need this for?
+Definition no_locks : mpred := ∀ addr dq z z' R, ¬ addr ↦{dq} (LK z z' R).
+*)
 
-Lemma make_tycontext_s_find_id i G : (make_tycontext_s G) ! i = find_id i G.
+Lemma make_tycontext_s_find_id i G : (make_tycontext_s(Σ := Σ) G) !! i = find_id i G.
 Proof.
   induction G as [| (j, fs) f IHf]. destruct i; reflexivity.
   simpl.
-  rewrite PTree.gsspec.
+  rewrite Maps.PTree.gsspec.
   rewrite IHf.
   reflexivity.
 Qed.
 
-(* How to relate Gamma to funspecs in memory, once we are outside the
-   semax proofs?  We define 'matchfunspecs' which will be satisfied by
-   the initial memory, and preserved under resource_decay / pures_eq /
-   aging. *)
+Program Definition drop_last_block m := {| mem_contents := mem_contents m;
+  mem_access := Maps.PMap.set (nextblock m - 1)%positive (fun _ _ => None) (mem_access m);
+  nextblock := (nextblock m - 1)%positive |}.
+Next Obligation.
+Proof.
+  intros.
+  destruct (eq_dec b (nextblock m - 1)%positive).
+  - subst; rewrite Maps.PMap.gss //.
+  - rewrite Maps.PMap.gso //; apply access_max.
+Qed.
+Next Obligation.
+Proof.
+  intros.
+  destruct (eq_dec b (nextblock m - 1)%positive).
+  - subst; rewrite Maps.PMap.gss //.
+  - rewrite Maps.PMap.gso //; apply nextblock_noaccess.
+    unfold Plt in *; lia.
+Qed.
+Next Obligation.
+Proof.
+  apply contents_default.
+Qed.
+
+Lemma rmap_of_drop_last_block : forall m {F} (ge : Genv.t (fundef F) type) G loc, res_of_loc (drop_last_block m) ge G loc =
+  if eq_dec loc.1 (nextblock m - 1)%positive then (shared.NO (Share Share.bot) bot_unreadable) else res_of_loc m ge G loc.
+Proof.
+  intros; rewrite /res_of_loc /drop_last_block /access_at /contents_at /=.
+  destruct (eq_dec loc.1 (nextblock m - 1)%positive).
+  - rewrite e Maps.PMap.gss //.
+  - rewrite Maps.PMap.gso //.
+Qed.
 
-Definition cond_approx_eq n A P1 P2 :=
-  (forall ts,
-      fmap (dependent_type_functor_rec ts (AssertTT A)) (approx n) (approx n) (P1 ts) =
-      fmap (dependent_type_functor_rec ts (AssertTT A)) (approx n) (approx n) (P2 ts)).
+Lemma rmap_of_drop_last : forall m block_bounds {F} (ge : Genv.t (fundef F) type) G n, (n < Pos.to_nat (nextblock m) - 1)%nat ->
+  ([^op list] n0 ∈ seq 1 n, let '(lo, z) := block_bounds (Pos.of_nat n0) in
+   [^op list] o ∈ seq 0 (z + 1), {[(Pos.of_nat n0, lo + Z.of_nat o) := res_of_loc m ge G (Pos.of_nat n0, lo + Z.of_nat o)]} ) =
+  ([^op list] n0 ∈ seq 1 n, let '(lo, z) := block_bounds (Pos.of_nat n0) in
+   [^op list] o ∈ seq 0 (z + 1), {[(Pos.of_nat n0, lo + Z.of_nat o) := res_of_loc (drop_last_block m) ge G (Pos.of_nat n0, lo + Z.of_nat o)]} ).
+Proof.
+  intros.
+  apply big_opL_ext; intros ??[-> ?]%lookup_seq.
+  destruct (block_bounds (Pos.of_nat _)).
+  apply big_opL_ext; intros.
+  rewrite rmap_of_drop_last_block.
+  if_tac; try done.
+  simpl in *; lia.
+Qed.
 
-Lemma cond_approx_eq_sym n A P1 P2 :
-  cond_approx_eq n A P1 P2 ->
-  cond_approx_eq n A P2 P1.
+Lemma lookup_singleton_list : forall {A} {B : ora} (l : list A) (f : A -> B) k i, (([^op list] i↦v ∈ l, ({[adr_add k (Z.of_nat i) := f v]})) !! i ≡
+  if adr_range_dec k (Z.of_nat (length l)) i then f <$> (l !! (Z.to_nat (i.2 - k.2))) else None)%stdpp.
 Proof.
-  unfold cond_approx_eq; auto.
+  intros.
+  remember (rev l) as l'; generalize dependent l; induction l'; simpl; intros.
+  { destruct l; simpl; last by apply app_cons_not_nil in Heql'.
+    rewrite lookup_empty; if_tac; auto. }
+  apply (f_equal (@rev _)) in Heql'; rewrite rev_involutive in Heql'; subst; simpl.
+  rewrite lookup_proper; last apply big_opL_snoc.
+  rewrite lookup_op IHl'; last by rewrite rev_involutive.
+  destruct k as (?, o), i as (?, o').
+  if_tac; [|if_tac].
+  - destruct H; subst; simpl.
+    rewrite lookup_singleton_ne; last by rewrite /adr_add; intros [=]; lia.
+    rewrite if_true; last by rewrite app_length; lia.
+    rewrite lookup_app.
+    by destruct (lookup_lt_is_Some_2 (rev l') (Z.to_nat (o' - o))) as (? & ->); first lia.
+  - destruct H0 as [-> Hrange].
+    rewrite app_length /= in Hrange.
+    assert (o' = o + Z.of_nat (length (rev l')))%Z as -> by (rewrite /adr_range in H; lia).
+    rewrite /adr_add lookup_singleton /= list_lookup_middle //; lia.
+  - rewrite lookup_singleton_ne //.
+    rewrite /adr_add /=; intros [=]; subst; contradiction H0.
+    split; auto; rewrite app_length /=; lia.
 Qed.
 
-Lemma cond_approx_eq_trans n A P1 P2 P3 :
-  cond_approx_eq n A P1 P2 ->
-  cond_approx_eq n A P2 P3 ->
-  cond_approx_eq n A P1 P3.
+Lemma lookup_of_loc : forall m {F} ge G b lo z loc,
+  (([^op list] o ∈ seq 0 z, {[(b, (lo + Z.of_nat o)%Z) := @res_of_loc m F ge G (b, (lo + Z.of_nat o)%Z)]} ) !! loc ≡
+  if adr_range_dec (b, lo) z loc then Some (res_of_loc m ge G loc) else None)%stdpp.
 Proof.
-  unfold cond_approx_eq in *.
-  intros E1 E2 ts; rewrite E1, E2. reflexivity.
+  intros.
+  evar (f : nat -> (sharedR (leibnizO resource))).
+  etrans; [|etrans; [apply (lookup_singleton_list (seq 0 z) f (b, lo) loc)|]].
+  2: { rewrite seq_length; if_tac; last done.
+       destruct loc, H; subst; simpl.
+       rewrite lookup_seq_lt /=; last lia.
+       subst f; instantiate (1 := fun i => res_of_loc m ge G (b, i + lo)); simpl.
+       replace (_ + _) with z0 by lia; done. }
+  subst f.
+  etrans; [|symmetry; apply (big_opL_seq_index(M := gmapR address _))].
+  f_equiv; apply big_opL_ext; intros.
+  rewrite (Z.add_comm _ lo) //.
 Qed.
 
-Lemma cond_approx_eq_weakening n n' A P1 P2 :
-  (n' <= n)%nat ->
-  cond_approx_eq n A P1 P2 ->
-  cond_approx_eq n' A P1 P2.
+Lemma lookup_of_mem : forall m {F} ge G block_bounds loc, (@rmap_of_mem m block_bounds F ge G !! loc ≡ let '(lo, z) := block_bounds (fst loc) in
+  if plt (fst loc) (nextblock m) && zle lo (snd loc) && zle (snd loc) (lo + Z.of_nat z) then Some (res_of_loc m ge G loc) else None)%stdpp.
 Proof.
-  intros l.
-  intros E ts; specialize (E ts).
-  rewrite <-approx_oo_approx' with (n' := n) at 1; try lia.
-  rewrite <-approx'_oo_approx with (n' := n) at 2; try lia.
-  rewrite <-approx_oo_approx' with (n' := n) at 3; try lia.
-  rewrite <-approx'_oo_approx with (n' := n) at 4; try lia.
-  rewrite <-fmap_comp. unfold compose.
-  rewrite E.
-  reflexivity.
+  intros; rewrite /rmap_of_mem.
+  remember (Pos.to_nat (nextblock m) - 1)%nat as n.
+  generalize dependent m; induction n; intros.
+  { rewrite /= lookup_empty.
+    destruct (block_bounds loc.1).
+    destruct (_ && _) eqn: Hin; last done.
+    rewrite !andb_true_iff in Hin; destruct Hin as ((? & ?) & ?).
+    destruct (plt _ _); try done.
+    unfold Plt in *; lia. }
+  rewrite seq_S lookup_proper; last apply big_opL_app.
+  rewrite /= !lookup_op lookup_empty op_None_right_id.
+  rewrite rmap_of_drop_last; last lia.
+  rewrite IHn; last by simpl; lia.
+  rewrite /= rmap_of_drop_last_block.
+  rewrite Heqn Nat2Pos.inj_sub // Pos2Nat.id /= /Pos.of_nat.
+  destruct (eq_dec loc.1 (nextblock m - 1)%positive).
+  - rewrite -e.
+    destruct (block_bounds loc.1) as (lo, z); simpl.
+    destruct (plt _ _); first by unfold Plt in *; lia.
+    rewrite /= left_id lookup_of_loc.
+    destruct (plt _ _); try by unfold Plt in *; lia.
+    if_tac.
+    + destruct loc as (?, o), H; simpl in *.
+      destruct (zle lo o); try lia; destruct (zle o (lo + z)); try lia; done.
+    + destruct loc as (?, o); simpl.
+      destruct (zle lo o); try done.
+      destruct (zle o (lo + z)); try done.
+      contradiction H; simpl; auto; lia.
+  - destruct (block_bounds (nextblock m - 1)%positive).
+    rewrite lookup_of_loc if_false; last by destruct loc; intros [??].
+    rewrite right_id.
+    destruct (plt _ _), (plt _ _); try done; unfold Plt in *; lia.
 Qed.
 
-Definition args_cond_approx_eq n A P1 P2 :=
-  (forall ts,
-      fmap (dependent_type_functor_rec ts (ArgsTT A)) (approx n) (approx n) (P1 ts) =
-      fmap (dependent_type_functor_rec ts (ArgsTT A)) (approx n) (approx n) (P2 ts)).
+Lemma perm_of_Lsh : perm_of_sh Share.Lsh = Some Nonempty.
+Proof.
+  rewrite /perm_of_sh.
+  pose proof Lsh_nonreadable.
+  rewrite if_false; last auto.
+  rewrite if_false // if_false //.
+  apply Lsh_bot_neq.
+Qed.
 
-Lemma args_cond_approx_eq_sym n A P1 P2 :
-  args_cond_approx_eq n A P1 P2 ->
-  args_cond_approx_eq n A P2 P1.
+Lemma rmap_of_loc_coherent : forall m F (ge : Genv.t (fundef F) type) G loc, coherent_loc m loc (resR_to_resource (Some (res_of_loc m ge G loc))).
 Proof.
-  unfold args_cond_approx_eq; auto.
+  intros; rewrite /res_of_loc.
+  destruct (access_at m loc Cur) eqn: Hloc; last apply coherent_bot.
+  destruct p; try (destruct (funspec_of_loc _ _ _) as [[]|]; last apply coherent_bot); rewrite /= elem_of_to_agree.
+  - split.
+    + unfold contents_cohere; simpl.
+      by inversion 1.
+    + rewrite /access_cohere Hloc /=.
+      rewrite /perm_of_sh !if_true //; auto.
+      constructor.
+  - split.
+    + unfold contents_cohere; simpl.
+      by inversion 1.
+    + rewrite /access_cohere Hloc /= perm_of_Ews.
+      constructor.
+  - split.
+    + unfold contents_cohere; simpl.
+      by inversion 1.
+    + rewrite /access_cohere Hloc /= perm_of_Ers.
+      constructor.
+  - split.
+    + done.
+    + rewrite /access_cohere Hloc /=.
+      constructor.
 Qed.
 
-Lemma args_cond_approx_eq_trans n A P1 P2 P3 :
-  args_cond_approx_eq n A P1 P2 ->
-  args_cond_approx_eq n A P2 P3 ->
-  args_cond_approx_eq n A P1 P3.
+Lemma rmap_of_mem_coherent : forall m block_bounds {F} ge G loc, (✓ @rmap_of_mem m block_bounds F ge G)%stdpp ->
+  coherent_loc m loc (resource_at (@rmap_of_mem m block_bounds F ge G) loc).
 Proof.
-  unfold args_cond_approx_eq in *.
-  intros E1 E2 ts; rewrite E1, E2. reflexivity.
+  intros; rewrite /resource_at.
+  specialize (H loc).
+  erewrite resR_to_resource_eq; [| done | apply lookup_of_mem].
+  rewrite lookup_of_mem in H.
+  destruct loc as (b, o); destruct (block_bounds b) eqn: Hbounds; rewrite Hbounds /=.
+  destruct (plt _ _); last apply coherent_bot.
+  destruct (zle z o); simpl; last apply coherent_bot.
+  destruct (zle o (z + n)); last apply coherent_bot; simpl.
+  apply rmap_of_loc_coherent.
 Qed.
 
-Lemma args_cond_approx_eq_weakening n n' A P1 P2 :
-  (n' <= n)%nat ->
-  args_cond_approx_eq n A P1 P2 ->
-  args_cond_approx_eq n' A P1 P2.
+Lemma rmap_of_loc_valid : forall m {F} ge G loc, (✓ (@res_of_loc m F ge G loc))%stdpp.
 Proof.
-  intros l.
-  intros E ts; specialize (E ts).
-  rewrite <-approx_oo_approx' with (n' := n) at 1; try lia.
-  rewrite <-approx'_oo_approx with (n' := n) at 2; try lia.
-  rewrite <-approx_oo_approx' with (n' := n) at 3; try lia.
-  rewrite <-approx'_oo_approx with (n' := n) at 4; try lia.
-  rewrite <-fmap_comp. unfold compose.
-  rewrite E.
-  reflexivity.
+  intros; rewrite /res_of_loc.
+  destruct (access_at m loc Cur); try done.
+  destruct p; try done; try destruct (funspec_of_loc _ _ _) as [[]|]; try done.
+  split; try done.
+  eexists; split; eauto.
+  intros ?; apply bot_unreadable; auto.
 Qed.
 
-Lemma level_initial_core {F} ge G n : level (@initial_core F ge G n) = n.
+Lemma rmap_of_mem_valid : forall m block_bounds {F} ge G, (✓ @rmap_of_mem m block_bounds F ge G)%stdpp.
 Proof.
-  apply level_make_rmap.
+  intros.
+  intros i; rewrite lookup_of_mem.
+  destruct (block_bounds _).
+  simple_if_tac; try done.
+  apply rmap_of_loc_valid.
+Qed.
+
+Lemma merge_disjoint : forall {K A} `{Merge M} `{∀A, Lookup K A (M A)} `{FinMap K M} (f1 f2 : A -> A -> option A) (m1 m2 : M A)
+  (Hdisj : m1 ##ₘ m2), merge (union_with f1) m1 m2 = merge (union_with f2) m1 m2.
+Proof.
+  intros.
+  rewrite -merge_Some //; intros.
+  rewrite lookup_merge /diag_None.
+  specialize (Hdisj i).
+  destruct (m1 !! i)%stdpp, (m2 !! i)%stdpp; done.
+Qed.
+
+Lemma big_opM_opL' : forall {A B} (f : _ -> A -> gmapR address B) (g : _ -> _ -> mpred) l
+  (Hl : base.NoDup l) (Hf : forall k1 k2 a1 a2, a1 ∈ l -> a2 ∈ l -> a1 ≠ a2 -> f k1 a1 ##ₘ f k2 a2)
+  (Hg : forall k y1 y2, (✓ y1)%stdpp -> (y1 ≡ y2)%stdpp -> g k y1 ⊣⊢ g k y2) (Hv : (✓ ([^op list] a↦b ∈ l, f a b))%stdpp),
+  ([∗ map] k↦v ∈ ([^op list] a↦b ∈ l, f a b), g k v) ⊣⊢
+  [∗ list] a↦b ∈ l, [∗ map] k↦v ∈ f a b, g k v.
+Proof.
+  intros.
+  remember (rev l) as l'; generalize dependent l; induction l'; simpl; intros.
+  { destruct l; simpl; last by apply app_cons_not_nil in Heql'.
+    apply big_sepM_empty. }
+  apply (f_equal (@rev _)) in Heql'; rewrite rev_involutive in Heql'; subst; simpl in *.
+  apply NoDup_app in Hl as (? & Hsep & ?).
+  rewrite big_sepL_app big_opM_proper_2; [|apply big_opL_app | intros ?????; apply Hg].
+  rewrite big_opL_app /= right_id in Hv.
+  assert (([^op list] k↦y ∈ rev l', f k y) ##ₘ ([^op list] k↦y ∈ [a], f (length (rev l') + k)%nat y)) as Hdisj.
+  { clear -Hf Hsep.
+    rewrite /= right_id.
+    forget (length (rev l') + 0)%nat as k; revert k.
+    induction l'; simpl; intros.
+    { rewrite /ε; apply map_disjoint_empty_l. }
+    rewrite big_opL_app /=.
+    apply map_disjoint_dom_2; rewrite dom_op.
+    rewrite disjoint_union_l; split.
+    * apply map_disjoint_dom_1, IHl'.
+      { intros ???? ?%elem_of_app ?%elem_of_app; apply Hf; simpl; rewrite !elem_of_app; tauto. }
+      intros; apply Hsep; simpl.
+      rewrite elem_of_app; auto.
+    * rewrite right_id.
+      apply map_disjoint_dom_1, Hf.
+      { simpl; rewrite !elem_of_app !elem_of_list_singleton; auto. }
+      { simpl; rewrite !elem_of_app !elem_of_list_singleton; auto. }
+      intros ->.
+      contradiction (Hsep a); rewrite /= ?elem_of_app elem_of_list_singleton; auto. }
+  match goal with |-context[?a ⋅ ?b] => replace (a ⋅ b) with (map_union a b) end.
+  rewrite big_opM_union //.
+  rewrite IHl' //.
+  apply bi.sep_proper; first done.
+  rewrite /op /gmapR /ora_op /= /gmap_op_instance fin_maps.RightId_instance_0 bi.sep_emp //.
+  * intros; apply Hf; try done; rewrite elem_of_app; auto.
+  * eapply cmra_valid_op_l; done.
+  * rewrite rev_involutive //.
+  * by apply merge_disjoint.
+  * specialize (Hv k); rewrite H1 // in Hv.
 Qed.
 
-(* func_at'': func_at without requiring a proof of non-expansiveness *)
-Definition func_at'' fsig cc A P Q :=
-  pureat (SomeP (SpecArgsTT A) (packPQ P Q)) (FUN fsig cc).
\ No newline at end of file
+Global Instance disjoint_rel_proper {A B : ofe} : Proper (base.equiv ==> base.equiv ==> base.equiv) (option_relation(A := A)(B := B) (fun _ _ => False%type) (fun _ => True%type) (fun _ => true%type)).
+Proof.
+  intros ?? Heq1 ?? Heq2.
+  inv Heq1; inv Heq2; done.
+Qed.
+
+Definition init_funspecs {F} (m : mem) (ge : Genv.t (fundef F) type) (G : funspecs) : gmap address (@funspecO' Σ) :=
+  foldl (fun fs b => match funspec_of_loc ge G (Pos.of_nat b, 0) with
+    Some f => <[(Pos.of_nat b, 0) := funspec_unfold f]>fs | None => fs end) ∅ (seq 1 (Pos.to_nat (nextblock m) - 1)).
+
+Local Close Scope maps.
+
+Lemma init_funspecs_lookup : forall {F} (m : mem) (ge : Genv.t (fundef F) type) (G : funspecs) l,
+  init_funspecs m ge G !! l = if Pos.ltb l.1 (nextblock m) then match funspec_of_loc ge G l with
+    Some f => Some (funspec_unfold f) | None => None end else None.
+Proof.
+  rewrite /init_funspecs; intros.
+  replace (nextblock m) with (Pos.of_nat (Pos.to_nat (nextblock m) - 1 + 1)) at 2 by lia.
+  induction (Pos.to_nat (nextblock m) - 1)%nat.
+  { simpl.
+    destruct (Pos.ltb_spec0 l.1 (Pos.of_nat 1)); first lia; done. }
+  rewrite seq_S foldl_snoc.
+  destruct (funspec_of_loc ge G (Pos.of_nat (1 + n), 0)) eqn: Hfun.
+  - destruct (eq_dec l (Pos.of_nat (1 + n), 0)).
+    + subst; rewrite lookup_insert /=.
+      destruct (Pos.ltb_spec0 (Pos.of_nat (S n)) (Pos.of_nat (S (n + 1)))); last lia.
+      rewrite Hfun //.
+    + rewrite lookup_insert_ne // IHn.
+      destruct (Pos.ltb_spec0 l.1 (Pos.of_nat (n + 1))), (Pos.ltb_spec0 l.1 (Pos.of_nat (S n + 1))); try done; try lia.
+      unfold funspec_of_loc.
+      if_tac; last done.
+      destruct l; simpl in *; contradiction n0; f_equal; lia.
+  - rewrite IHn.
+    destruct (Pos.ltb_spec0 l.1 (Pos.of_nat (n + 1))), (Pos.ltb_spec0 l.1 (Pos.of_nat (S n + 1))); try done; try lia.
+    unfold funspec_of_loc in *.
+    if_tac; last done.
+    assert (l = (Pos.of_nat (1 + n), 0)) as ->; last by rewrite Hfun.
+    destruct l; simpl in *; f_equal; lia.
+Qed.
+
+Lemma init_funspecs_over : forall {F} (ge : Genv.t (fundef F) type) G n n' o, (n < n')%nat -> (foldl (fun fs b => match funspec_of_loc ge G (Pos.of_nat b, 0) with
+    Some f => <[(Pos.of_nat b, 0) := funspec_unfold f]>fs | None => fs end) ∅ (seq 1 n) : gmap address (@funspecO' Σ)) !! (Pos.of_nat n', o) = None.
+Proof.
+  induction n.
+  { simpl; intros; apply lookup_empty. }
+  rewrite seq_S foldl_snoc.
+  intros; destruct (funspec_of_loc _ _ _).
+  - rewrite lookup_insert_ne; [apply IHn | intros [=]]; lia.
+  - apply IHn; lia.
+Qed.
+
+Lemma rmap_inflate_equiv : forall m block_bounds {F} (ge : Genv.t (fundef F) type) G
+  (Hfun_bounds : forall b f, funspec_of_loc ge G (b, 0) = Some f -> block_bounds b = (0, 0%nat))
+  (Hm : forall b, (b < nextblock m)%positive ->
+        match funspec_of_loc ge G (b, 0) with
+        | Some _ => access_at m (b, 0) Cur = Some Nonempty
+        | None => True
+        end),
+  funspec_auth ∅ ∗ ([∗ map] l ↦ x ∈ rmap_of_mem m block_bounds ge G, match x with
+                     | (shared.YES dq _ v) => l ↦{dq} (proj1_sig (elem_of_agree v))
+                     | (shared.NO (Share sh) _) => mapsto_no l sh
+                     | _ => False
+                     end) ⊢ |==> funspec_auth (init_funspecs m ge G) ∗ inflate_initial_mem m block_bounds ge G.
+Proof.
+  intros.
+  assert (∀ (l : address) (y1 y2 : sharedR (leibnizO resource)), (✓ y1)%stdpp → (y1 ≡ y2)%stdpp →
+    match y1 with
+    | (shared.YES dq _ v) => l ↦{dq} (proj1_sig (elem_of_agree v))
+    | (shared.NO (Share sh) _) => mapsto_no l sh
+    | _ => False end ⊣⊢ match y2 with
+           | (shared.YES dq _ v) => l ↦{dq} (proj1_sig (elem_of_agree v))
+           | (shared.NO (Share sh) _) => mapsto_no l sh
+           | _ => False end).
+  { intros ??? Hv Heq.
+    destruct y1, y2; inv Heq; try done.
+    destruct Hv.
+    match goal with H : (_ ≡ _)%stdpp |- _ => apply (elem_of_agree_ne O) in H as ->%leibniz_equiv; done end. }
+  rewrite /rmap_of_mem /init_funspecs /inflate_initial_mem big_opM_opL' //.
+  assert (Pos.to_nat (nextblock m) - 1 < Pos.to_nat (nextblock m))%nat as Hlt by lia.
+  induction (Pos.to_nat (nextblock m) - 1)%nat.
+  { by iIntros. }
+  rewrite seq_S /= !big_sepL_app foldl_snoc assoc IHn /=.
+  iIntros "(>(Hf & $) & Hm & _)".
+  destruct (block_bounds _) eqn: Hbounds.
+  rewrite big_opM_opL' //.
+  destruct (funspec_of_loc ge G (Pos.of_nat (S n), 0)) eqn: Hfun.
+  * iMod (own_update with "Hf") as "($ & Hf)".
+    { apply (gmap_view.gmap_view_alloc _ (Pos.of_nat (S n), 0) dfrac.DfracDiscarded); last done.
+      apply init_funspecs_over; auto. }
+    erewrite Hfun_bounds in Hbounds by done; inv Hbounds; simpl.
+    rewrite !big_sepM_singleton /res_of_loc /inflate_loc.
+    specialize (Hm (Pos.of_nat (S n)) ltac:(lia)); rewrite Hfun in Hm; rewrite Hm Hfun /func_at elem_of_to_agree.
+    iDestruct "Hm" as "($ & _)"; iFrame; done.
+  * iFrame.
+    assert (forall z, funspec_of_loc ge G (Pos.of_nat (S n), z) = None) as Hfun'.
+    { intros; unfold funspec_of_loc in *.
+      simpl; if_tac; done. }
+    rewrite bi.sep_emp -big_sepL_bupd; iApply (big_sepL_mono with "Hm"); intros ?? [-> ?]%lookup_seq.
+    rewrite big_opM_singleton.
+    rewrite /res_of_loc /inflate_loc.
+    destruct (access_at _ _ _) eqn: Haccess; last apply bupd_intro.
+    destruct p; try apply bupd_intro; rewrite ?Hfun' ?elem_of_to_agree; apply bupd_intro.
+  * apply NoDup_seq.
+  * intros; intros i.
+    rewrite /option_relation.
+    destruct (eq_dec i (Pos.of_nat (S n), (z + a1)%Z)); last by rewrite lookup_singleton_ne //; destruct (_ !! _).
+    destruct (eq_dec i (Pos.of_nat (S n), (z + a2)%Z)); last by rewrite (lookup_singleton_ne (_, (_ + a2)%Z)) //; destruct (_ !! _).
+    subst; inv e0; lia.
+  * intros i.
+    rewrite lookup_of_loc.
+    if_tac; try done.
+    apply rmap_of_loc_valid.
+  * lia.
+  * apply NoDup_seq.
+  * intros _ _ ?? Ha1%elem_of_seq Ha2%elem_of_seq ?.
+    destruct (block_bounds _), (block_bounds _).
+    intros i.
+    rewrite disjoint_rel_proper; [| apply lookup_of_loc..].
+    rewrite /option_relation; if_tac; last by destruct (if adr_range_dec _ _ _ then _ else _).
+    if_tac; last done.
+    destruct i, H1, H2; lia.
+  * apply rmap_of_mem_valid.
+Qed.
+
+Lemma inflate_drop_last : forall m block_bounds {F} (ge : Genv.t (fundef F) type) G n, (n < Pos.to_nat (nextblock m) - 1)%nat ->
+  ([∗ list] y ∈ seq 1 n, let '(lo, z) := block_bounds (Pos.of_nat y) in
+   [∗ list] o ∈ seq 0 z, inflate_loc m ge G (Pos.of_nat y, lo + Z.of_nat o)) =
+  ([∗ list] y ∈ seq 1 n, let '(lo, z) := block_bounds (Pos.of_nat y) in
+   [∗ list] o ∈ seq 0 z, inflate_loc (drop_last_block m) ge G (Pos.of_nat y, lo + Z.of_nat o)).
+Proof.
+  intros.
+  apply big_opL_ext; intros ??[-> ?]%lookup_seq.
+  destruct (block_bounds (Pos.of_nat _)).
+  apply big_opL_ext; intros.
+  rewrite /inflate_loc /access_at /= Maps.PMap.gso //.
+  lia.
+Qed.
+
+Local Instance decide_fun_lt m {F} (ge : Genv.t (fundef F) type) : ∀ x : ident * funspec, Decision ((fun '(id, _) => match Genv.find_symbol ge id with Some b => Plt b (nextblock m) | None => False%type end) x).
+Proof.
+  intros (?, ?); destruct (Genv.find_symbol _ _); last by right; intros ?.
+  destruct (plt b (nextblock m)); by [left | right].
+Qed.
+
+Lemma filter_all : forall {A} (P : A -> Prop) `(∀x, Decision (P x)) l, Forall P l -> base.filter P l = l.
+Proof.
+  induction l; simpl; first done.
+  inversion 1; subst; simpl.
+  rewrite filter_cons_True // IHl //.
+Qed.
+
+Lemma list_norepet_filter : forall {A B} P `(∀x, Decision (P x)) (l : list (A * B)), list_norepet (map fst l) -> list_norepet (map fst (base.filter P l)).
+Proof.
+  induction l; simpl; first done.
+  inversion 1 as [|?? Hout]; subst.
+  rewrite filter_cons; destruct (decide (P a)); last auto; simpl.
+  constructor; auto.
+  rewrite !in_map_iff in Hout |- *.
+  intros (? & ? & [??%elem_of_list_In]%elem_of_list_In%elem_of_list_filter); eauto.
+Qed.
+
+Lemma big_sepL_absorb : ∀ {A} (Φ : nat → A → mpred) l,
+  ([∗ list] k↦x ∈ l, <absorb> Φ k x) ⊢ <absorb> [∗ list] k↦x ∈ l, Φ k x.
+Proof.
+  induction l using rev_ind; simpl.
+  - iIntros "$".
+  - rewrite !big_sepL_app /= IHl.
+    iIntros "(>$ & >$ & _)".
+Qed.
+
+Lemma initial_mem_initial_core : forall m block_bounds {F} (ge : Genv.t (fundef F) type) G
+  (Hm : forall b, (b < nextblock m)%positive ->
+        match funspec_of_loc ge G (b, 0) with
+        | Some _ => access_at m (b, 0) Cur = Some Nonempty
+        | None => True
+        end)
+  (Hbounds : forall b, (b < nextblock m)%positive -> (block_bounds b).1 <= 0 <= (block_bounds b).1 + Z.of_nat (block_bounds b).2),
+  inflate_initial_mem m block_bounds ge G ⊢ inflate_initial_mem m block_bounds ge G ∗ initial_core m ge G.
+Proof.
+  intros; rewrite /inflate_initial_mem /initial_core.
+  iIntros "H"; iSplit; first done.
+  iApply big_sepL_absorb; iApply (big_sepL_mono with "H"); intros ?? (-> & ?)%lookup_seq.
+  iIntros "H".
+  specialize (Hbounds (Pos.of_nat (1 + k)) ltac:(lia)).
+  specialize (Hm (Pos.of_nat (1 + k)) ltac:(lia)).
+  destruct (block_bounds _) as (lo, hi); simpl in *.
+  iPoseProof (big_sepL_lookup_acc _ _ (Z.to_nat (-lo)) with "H") as "(H & _)".
+  { apply lookup_seq; split; first done; lia. }
+  replace (lo + _) with 0 by lia.
+  rewrite /inflate_loc.
+  destruct (funspec_of_loc _ _ _).
+  - rewrite Hm //.
+  - replace (DfracOwn (Share share_top)) with (ε ⋅ DfracOwn (Share share_top)) by rewrite left_id //.
+    replace (DfracOwn (Share Ews)) with (ε ⋅ DfracOwn (Share Ews)) by rewrite left_id //.
+    replace (DfracOwn (Share Ers)) with (ε ⋅ DfracOwn (Share Ers)) by rewrite left_id //.
+    destruct (access_at _ _ _); last done.
+    destruct p; last done; iDestruct (mapsto_split_no with "H") as "($ & _)"; simpl; auto; (apply bot_unreadable || apply readable_Ers).
+Qed.
+
+Lemma rmap_of_mem_nextblock : ∀ m block_bounds {F} (ge : Genv.t (fundef F) type) G loc,
+  (loc.1 >= nextblock m)%positive → rmap_of_mem m block_bounds ge G !! loc = None.
+Proof.
+  intros; pose proof (lookup_of_mem m ge G block_bounds loc) as Hlookup.
+  destruct (plt _ _).
+  { unfold Plt in *; clear - H p. apply Pos.lt_nle in p; contradiction p. apply Pos.ge_le; done. }
+  simpl in Hlookup.
+  destruct (block_bounds _); inv Hlookup; done.
+Qed.
+
+Lemma initialize_mem : forall m block_bounds {F} (ge : Genv.t (fundef F) type) G
+  (Hfun_bounds : forall b f, funspec_of_loc ge G (b, 0) = Some f -> block_bounds b = (0, 0%nat))
+  (Hm : forall b, (b < nextblock m)%positive ->
+        match funspec_of_loc ge G (b, 0) with
+        | Some _ => access_at m (b, 0) Cur = Some Nonempty
+        | None => True
+        end),
+  mem_auth Mem.empty ∗ funspec_auth ∅ ⊢ |==> mem_auth m ∗ funspec_auth (init_funspecs m ge G) ∗ inflate_initial_mem m block_bounds ge G.
+Proof.
+  intros.
+  pose proof (rmap_of_mem_valid m block_bounds ge G).
+  rewrite mem_auth_set //.
+  iIntros "(>(Hm & Hr) & Hf)".
+  iCombine "Hf Hr" as "Hr"; iMod (rmap_inflate_equiv with "Hr") as "$"; try done.
+  - apply rmap_of_mem_nextblock.
+  - intros; by apply rmap_of_mem_coherent.
+Qed.
+
+End mpred.
+
+(*Require Import VST.veric.wsat.
+
+(* This is provable, but we probably don't want to use it: we should set up the proof infrastructure
+   (heapGS, etc.) first, and then allocate the initial memory in a later step. *)
+Lemma alloc_initial_mem `{!wsatGpreS Σ} `{!gen_heapGpreS resource Σ} `{!inG Σ (gmapR address (agreeR (@funspecO' Σ)))} m block_bounds {F} (ge : Genv.t (fundef F) type) G :
+  ⊢ |==> ∃ _ : heapGS Σ, wsat ∗ ownE ⊤ ∗ mem_auth m ∗ inflate_initial_mem m block_bounds ge G ∗
+ ghost_map.ghost_map_auth(H0 := gen_heapGpreS_meta) (gen_meta_name _) 1 ∅.
+Proof.
+  iIntros.
+  iMod wsat_alloc as (?) "(? & ?)".
+  pose proof (rmap_of_mem_valid m block_bounds ge G).
+  iMod (gen_heap_init_names m (rmap_of_mem m block_bounds ge G)) as (??) "(Hm & H & ?)".
+  { apply rmap_of_mem_nextblock. }
+  { intros; by apply rmap_of_mem_coherent. }
+  iMod (own_alloc ∅) as (γ) "?".
+  iExists (HeapGS _ _ _ _ γ); iFrame.
+  rewrite /mem_auth /= -rmap_inflate_equiv //.
+Qed.*)
diff --git a/veric/initialize.v b/veric/initialize.v
index 558d724b45..c239224d30 100644
--- a/veric/initialize.v
+++ b/veric/initialize.v
@@ -1,139 +1,29 @@
+Require Import FunInd.
+Require Import VST.zlist.sublist.
+Require Import VST.veric.log_normalize.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.juicy_base.
 Require Import VST.veric.shares.
-Require Import VST.veric.juicy_mem VST.veric.juicy_mem_lemmas VST.veric.juicy_mem_ops.
+Require Import VST.veric.juicy_mem VST.veric.juicy_mem_lemmas (*VST.veric.juicy_mem_ops*).
 Require Import VST.veric.res_predicates.
 Require Import VST.veric.extend_tc.
 Require Import VST.veric.Clight_seplog.
 Require Import VST.veric.Clight_assert_lemmas.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.Clight_core.
 Require Import VST.veric.tycontext.
 Require Import VST.veric.expr2.
 Require Import VST.veric.expr_lemmas.
 Require Import VST.veric.Clight_lemmas.
+Require Import VST.veric.mapsto_memory_block.
+Require Import VST.veric.initial_world.
 Require Import VST.veric.Clight_initial_world.
-Import compcert.lib.Maps.
 
 Import Clight.
 
-Definition only_blocks {S: block -> Prop} (S_dec: forall b, {S b}+{~S b}) (w: rmap) : rmap.
- refine (proj1_sig (make_rmap (fun loc => if S_dec (fst loc) then w @ loc else core (w @ loc))
-                              _ (level w) _ (ghost_of_approx w))).
-Proof.
-  hnf; auto.
- extensionality loc;  unfold compose.
- if_tac; try apply resource_at_approx.
- repeat  rewrite core_resource_at. rewrite <- level_core.
-apply resource_at_approx.
-Defined.
-
-Definition not_dec: forall {S: block -> Prop} (f: forall b, {S b}+{~S b}),
-                            forall b, {~S b}+{~ ~ S b}.
-Proof. intros. destruct (f b). right; tauto. left; auto.
-Qed.
-
-Lemma join_only_blocks:
-  forall {S} S_dec phi, identity (ghost_of phi) -> join (@only_blocks S S_dec phi)
-                        (only_blocks (not_dec S_dec) phi) phi.
-Proof. intros.
-  unfold only_blocks.
-  apply resource_at_join2.
-  repeat rewrite level_make_rmap. auto.
-  repeat rewrite level_make_rmap. auto.
- intro;   repeat rewrite resource_at_make_rmap. unfold compose.
- destruct (S_dec (fst loc)).
-  try rewrite if_false by tauto. apply join_comm; apply core_unit.
-  rewrite if_true by tauto; apply core_unit.
-  rewrite !ghost_of_make_rmap.
-  apply identity_unit'; auto.
-Qed.
-
-Lemma Exists_dec: forall {T} (f: T -> Prop)(f_dec: forall x, {f x}+{~f x}) (l: list T),
-                   {Exists f l}+{~Exists f l}.
-  Proof. intros. induction l; simpl. right; intro. inv H.
-         destruct IHl. left; constructor 2; auto. destruct (f_dec a). left; constructor 1; auto.
-        right; intro Hx; inv Hx; auto.
-  Qed.
-
-Lemma only_blocks_at: forall {S} S_dec phi loc,
-   @only_blocks S S_dec phi @ loc =
-    if S_dec (fst loc) then phi @ loc else core (phi @ loc).
-Proof.
-   unfold only_blocks; intros.
- rewrite resource_at_make_rmap. auto.
-Qed.
-
-Lemma level_only_blocks: forall {S} S_dec phi,
-   level (@only_blocks S S_dec phi) = level phi.
-Proof. intros. apply level_make_rmap.
-Qed.
-
-Definition upto_block (b: block) (w: rmap) : rmap :=  only_blocks (fun b' => plt b' b) w.
-
-Definition beyond_block (b: block) (w: rmap) : rmap := only_blocks (not_dec (fun b' => plt b' b)) w.
-
-
-Lemma join_upto_beyond_block:
-  forall b phi, identity (ghost_of phi) -> join  (upto_block b phi)  (beyond_block b phi) phi.
-Proof.  intros; apply join_only_blocks; auto.
-Qed.
-
-
-Lemma split_range:
-  forall phi base n,
-    (forall loc, adr_range base n loc ->
-       match phi @ loc with YES _ _ k _ => isVAL k | _ => True end) ->
-   exists phi1, exists phi2,
-      join phi1 phi2 phi /\
-      forall loc, if adr_range_dec base n loc then identity (phi2 @ loc)
-                                                      else identity (phi1 @ loc).
-Proof.
-  intros ???.
-  pose proof I.
-  destruct (make_rmap (fun loc => if adr_range_dec base n loc then phi @ loc else core (phi @ loc)) (core (ghost_of phi)) (level phi)) as [phi1 [J1 J2]].
-  extensionality loc;   unfold compose.
-  if_tac.  apply resource_at_approx.
-  repeat rewrite core_resource_at. rewrite <- level_core. apply resource_at_approx.
-  { apply ghost_fmap_core. }
-  pose proof I.
- destruct (make_rmap (fun loc => if adr_range_dec base n loc then core (phi @ loc) else phi @ loc) (ghost_of phi) (level phi)) as [phi2 [J3 J4]].
-  extensionality loc;   unfold compose.
-  if_tac.
-  repeat rewrite core_resource_at. rewrite <- level_core. apply resource_at_approx.
-  apply resource_at_approx.
-  { apply ghost_of_approx. }
- clear H0.
-  destruct J2 as [J2 Hg1], J4 as [J4 Hg2].
-  exists phi1; exists phi2; split; auto.
-  apply resource_at_join2; [congruence | congruence | | ].
-  intros; rewrite J2; rewrite J4.
-  if_tac.
-    apply join_unit2. apply core_unit. auto.
-    apply join_unit1. apply core_unit. auto.
-  rewrite Hg1, Hg2; apply core_unit.
-  intros. rewrite J2; rewrite J4. if_tac; apply core_identity.
-Qed.
-
-Definition blockslice_rmap (S: block -> Prop) (phi: rmap) :=
-    forall loc: address, ~S (fst loc) -> identity (phi @ loc).
-
-Definition eq_mod_blockslice (S: block -> Prop) (phi phi': rmap) :=
- forall loc, (S (fst loc) -> phi @ loc = phi' @ loc) .
-
-Definition blockslice_mpred (S: block -> Prop) (P: mpred) :=
-  (forall phi, P phi -> forall loc, ~S (fst loc) -> identity (phi @ loc)) /\
-  (forall phi phi', blockslice_rmap S phi -> blockslice_rmap S phi' ->
-                        eq_mod_blockslice S phi phi' ->
-         P phi -> P phi').
-
-Definition blockslice_mpred_rmap:
-  forall S (Sdec: forall b, {S b}+{~S b}) P phi,
-   blockslice_mpred S P -> P phi -> blockslice_rmap S phi.
-Proof.
- unfold blockslice_mpred, blockslice_rmap; intros.
- destruct H.
- eapply H; eauto.
-Qed.
+Section mpred.
 
+Context `{!heapGS Σ}.
 
 Lemma rev_prog_vars': forall {F V} vl, rev (@prog_vars' F V vl) = prog_vars' (rev vl).
 Proof.
@@ -175,10 +65,10 @@ Definition init_data2pred (gv: globals) (d: init_data)  (sh: share) (a: val) : m
  end.
 
 Fixpoint init_data_list2pred  (gv: globals)  (dl: list init_data)
-                           (sh: share) (v: val)  : pred rmap :=
+                           (sh: share) (v: val) : mpred :=
   match dl with
-  | d::dl' => sepcon (init_data2pred gv d sh v) 
-                  (init_data_list2pred gv dl' sh (offset_val (init_data_size d) v))
+  | d::dl' => init_data2pred gv d sh v ∗
+                  init_data_list2pred gv dl' sh (offset_val (init_data_size d) v)
   | nil => emp
  end.
 
@@ -190,28 +80,28 @@ Definition globals_of_env (rho: environ) (i: ident) : val :=
 
 Definition globvar2pred (gv: ident->val) (idv: ident * globvar type) : mpred :=
    if (gvar_volatile (snd idv))
-                       then  TT
+                       then  True
                        else    init_data_list2pred gv (gvar_init (snd idv))
                                    (readonly2share (gvar_readonly (snd idv))) (gv (fst idv)).
 
 
 Definition globvars2pred (gv: ident->val) (vl: list (ident * globvar type)) : mpred :=
-   fold_right sepcon emp (map (globvar2pred gv) vl).
+   [∗] (map (globvar2pred gv) vl).
+
+Lemma big_sepL_rev : forall {A} (f : A -> mpred) (l : list A), ([∗ list] v ∈ (rev l), f v) ⊣⊢ [∗ list] v ∈ l, f v.
+Proof.
+  induction l; simpl; first done.
+  rewrite big_sepL_app IHl /=.
+  rewrite right_id comm //.
+Qed.
 
 Lemma globvars2pred_rev:
-  forall gv l, globvars2pred gv (rev l) = globvars2pred gv l.
+  forall gv l, globvars2pred gv (rev l) ⊣⊢ globvars2pred gv l.
 Proof.
- intros. unfold globvars2pred.
- rewrite map_rev.
-  rewrite fold_left_rev_right.
- rewrite fold_symmetric.
- f_equal.
- f_equal. extensionality x y; apply sepcon_comm.
- intros; apply sepcon_assoc.
- intros; apply sepcon_comm.
+  intros; rewrite /globvars2pred map_rev big_sepL_rev //.
 Qed.
 
-Lemma writable_blocks_rev:
+(*Lemma writable_blocks_rev:
   forall rho l, writable_blocks l rho = writable_blocks (rev l) rho.
 Proof.
 induction l; simpl; auto.
@@ -221,7 +111,7 @@ rewrite <- IHl.
 simpl.
 rewrite sepcon_emp.
 apply sepcon_comm.
-Qed.
+Qed.*)
 
 Lemma add_variables_nextblock:
   forall F V vl (ge: Genv.t F V) i g ul, list_norepet (map (@fst _ _) (vl++(i,g)::ul)) ->
@@ -233,14 +123,14 @@ Proof.
  change positive with block.
  replace (Some (Genv.genv_next ge)) with (Genv.find_symbol (Genv.add_global ge (i,g)) i).
  2:{
-  unfold Genv.add_global, Genv.find_symbol; simpl. rewrite PTree.gss. f_equal; unfold block; lia.
+  unfold Genv.add_global, Genv.find_symbol; simpl. rewrite Maps.PTree.gss. f_equal; unfold block; lia.
   }
   forget (Genv.add_global ge (i, g)) as ge1.
   revert H2 ge1; induction ul; simpl; intros; auto.
   spec IHul; [tauto |].
   rewrite IHul.
   unfold Genv.find_symbol, Genv.add_global. simpl.
-  rewrite PTree.gso; auto.
+  rewrite Maps.PTree.gso; auto.
   simpl length. simpl Genv.advance_next.
   simpl.
   rewrite (IHvl  (Genv.add_global ge a) i g ul).
@@ -295,8 +185,6 @@ Proof. induction dl; simpl; intros. lia.
  pose proof (init_data_size_pos a); lia.
 Qed.
 
-Require Import FunInd.
-
 Remark store_zeros_load_outside:
   forall m b p n m',
   store_zeros m b p n = Some m' ->
@@ -355,7 +243,7 @@ transitivity
      reflexivity).
 apply loadbytes_load; auto.
 clear H2.
-rewrite size_chunk_conv in *.
+rewrite -> size_chunk_conv in *.
 forget (size_chunk_nat chunk) as n.
 assert (forall i, p <= i < p + (Z.of_nat n) ->
                      loadbytes m b i 1 = Some (Byte Byte.zero::nil)).
@@ -438,6 +326,32 @@ Proof.
   eapply store_init_data_outside; eauto. tauto.
 Qed.
 
+Lemma store_zeros_0 : forall m b o, store_zeros m b o 0 = Some m.
+Proof.
+  intros; rewrite store_zeros_equation.
+  destruct (zle 0 0); done.
+Qed.
+
+Lemma store_zeros_add : forall m b o z1 z2 m', z1 >= 0 -> z2 >= 0 -> store_zeros m b o (z1 + z2) = Some m' ->
+  exists m'', store_zeros m b o z1 = Some m'' /\ store_zeros m'' b (o + z1) z2 = Some m'.
+Proof.
+  intros until 1; revert m o z2.
+  eapply (natlike_ind (fun z1 => ∀ (m : Memory.mem) (o z2 : Z) (Hz2 : z2 >= 0) (Hstore : store_zeros m b o (z1 + z2) = Some m'),
+    ∃ m'' : Memory.mem, (store_zeros m b o z1 = Some m'' ∧ store_zeros m'' b (o + z1) z2 = Some m'))%type); last lia; intros.
+  - rewrite Z.add_0_l in Hstore; rewrite Z.add_0_r store_zeros_0; eauto.
+  - rewrite store_zeros_equation in Hstore.
+    destruct (zle _ _); first lia.
+    destruct (store Mint8unsigned m b o Vzero) eqn: Hstore1; last done.
+    replace (Z.succ x + z2 - 1) with (x + z2) in Hstore by lia.
+    apply H1 in Hstore as (m'' & ? & ?); last done.
+    exists m''; split.
+    + rewrite store_zeros_equation.
+      destruct (zle _ _); first lia.
+      rewrite Hstore1.
+      replace (Z.succ x - 1) with x by lia; done.
+    + replace (o + Z.succ x) with (o + 1 + x) by lia; done.
+Qed.
+
 Lemma load_store_init_data_lem1:
   forall {ge m1 b D m2 m3},
    store_zeros m1 b 0 (init_data_list_size D) = Some m2 ->
@@ -465,7 +379,7 @@ Proof.
     lia.
   }
   destruct a; simpl in H2|-*; try solve [destruct H2; auto]; intros.
-  rewrite (store_init_data_list_outside _ _ _ _ _ _ H4) by (right; simpl; lia).
+  rewrite -> (store_init_data_list_outside _ _ _ _ _ _ H4) by (right; simpl; lia).
   simpl in H0. inv H0. apply H1.
   simpl.
   pose proof (init_data_list_size_pos dl).
@@ -519,10 +433,10 @@ assert (MU: 256 < Int.max_unsigned).
  unfold Int.max_unsigned, Int.modulus, Int.wordsize, Wordsize_32.wordsize in *.
   unfold two_power_nat, shift_nat in *; simpl in *.
  replace (Zpos (4294967296 - 1)) with (4294967295). lia. reflexivity.
-rewrite Int.zero_ext_and in H by lia.
+rewrite -> Int.zero_ext_and in H by lia.
 pose proof (Int.modu_and (Int.repr (Byte.unsigned i)) (Int.repr (two_p 8)) (Int.repr 8)).
  spec H0.
- apply Int.is_power2_two_p; simpl.  unfold Int.zwordsize; simpl. lia.
+ apply Int.is_power2_two_p; simpl. by compute.
  replace (Int.sub (Int.repr (two_p 8)) Int.one) with (Int.repr (two_p 8 - 1)) in H0.
  rewrite <- H0 in H. clear H0.
  rewrite Int.modu_divu in H.
@@ -551,7 +465,7 @@ rewrite <- (Byte.repr_unsigned i). unfold Byte.zero. f_equal. auto.
  unfold Int.zero. intro.
  pose proof (Int.unsigned_repr 256).
  spec H0. split; lia.
- rewrite H in H0. rewrite Int.unsigned_repr in H0 by lia. inv H0.
+ rewrite H in H0. rewrite -> Int.unsigned_repr in H0 by lia. inv H0.
  replace (two_p 8) with 256 by reflexivity.
  unfold Int.one.
  rewrite Int.sub_signed.
@@ -568,7 +482,7 @@ Proof.
   simpl. unfold shift_nat. simpl. reflexivity.
 Qed.
 
-Lemma decode_val_getN_lem1:
+(*Lemma decode_val_getN_lem1:
   forall j i b,
           decode_val Mint32 (getN 4 i b) = Vint Int.zero ->
           0 <= j-i < 4 ->
@@ -579,9 +493,9 @@ Proof.
  revert H; case_eq (getN 4 i b); intros. inv H.
  unfold getN in H. destruct l; inv H.
  destruct (proj_bytes
-         (ZMap.get i b
-          :: ZMap.get (i + 1) b
-             :: ZMap.get (i + 1 + 1) b :: ZMap.get (i + 1 + 1 + 1) b :: nil))
+         (Maps.ZMap.get i b
+          :: Maps.ZMap.get (i + 1) b
+             :: Maps.ZMap.get (i + 1 + 1) b :: ZMap.get (i + 1 + 1 + 1) b :: nil))
     eqn:PB.
 *
  simpl proj_bytes in PB.
@@ -608,7 +522,7 @@ Proof.
   spec H4.
   clear H. rewrite max_unsigned_eq; lia.
   rewrite H in H4.
- rewrite Int.unsigned_repr in H4 by (rewrite max_unsigned_eq; lia).
+ rewrite -> Int.unsigned_repr in H4 by (rewrite max_unsigned_eq; lia).
   lia.
  assert (Byte.unsigned i0=0/\Byte.unsigned i1=0/\Byte.unsigned i2=0/\Byte.unsigned i3=0).
  unfold rev_if_be in H. destruct Archi.big_endian; simpl in H; apply H1 in H; tauto.
@@ -625,7 +539,7 @@ Proof.
  clear PB.
  destruct (ZMap.get i b); inv H1.
 (* Not true if Archi.ptr64=false *)
-Abort.
+Abort.*)
 
 Lemma Zmax_Z_of_nat:
  forall n, Z.max (Z_of_nat n) 0 = Z_of_nat n.
@@ -641,7 +555,7 @@ intro.
 case_eq (Share.split fullshare); intros.
 rewrite H0 in H. simpl in H. subst.
 apply Share.split_nontrivial in H0; auto.
-apply Share.nontrivial in H0. contradiction.
+by apply Share.nontrivial.
 Qed.
 
 Lemma readable_readonly2share: forall ro, readable_share (readonly2share ro).
@@ -652,7 +566,7 @@ Proof.
   assert (H9: Share.Rsh <> Share.bot). {
     unfold Share.Rsh. intro.
     destruct (Share.split Share.top) eqn:?.
-    pose proof (Share.split_nontrivial _ _ _ Heqp). spec H1; auto. contradiction Share.nontrivial.
+    pose proof (Share.split_nontrivial _ _ _ Heqp). spec H1; auto; contradiction Share.nontrivial.
   }
   clear H9.
   destruct ro; simpl in *.
@@ -674,284 +588,103 @@ Qed.
 Definition genviron2globals (g: genviron) (i: ident) : val :=
   match Map.get g i with Some b => Vptr b Ptrofs.zero | None => Vundef end.
 
+Lemma getN_seq : forall n z c, getN n z c = map (fun i => Maps.ZMap.get (z + Z.of_nat i) c) (seq 0 n).
+Proof.
+  induction n; simpl; intros; first done.
+  rewrite Z.add_0_r IHn -seq_shift map_map.
+  f_equal; apply map_ext; intros.
+  f_equal; lia.
+Qed.
+
 Lemma init_data_lem:
-forall (ge: genv) (v : globvar type) (b : block) (m1 : mem')
-  (m3 m4 : Memory.mem) (phi0 : rmap) (a : init_data) (z : Z)
-  (w1 wf : rmap),
+forall (ge: genv) (v : globvar type) (b : block)
+  (m3 : Memory.mem) G (a : init_data) (z : Z),
    load_store_init_data1 ge m3 b z a ->
-   contents_at m4 = contents_at m3 ->
-   join w1 wf (beyond_block b (inflate_initial_mem m4 phi0)) ->
-   (forall loc : address,
-     if adr_range_dec (b, z) (init_data_size a) loc
-     then identity (wf @ loc) /\ access_at m4 loc Cur = Some (Genv.perm_globvar v)
-     else identity (w1 @ loc)) ->
-   forall (VOL:  gvar_volatile v = false)
-          (AL: initializer_aligned z a = true)
-           (LO:   0 <= z) (HI: z + init_data_size a < Ptrofs.modulus),
-  (init_data2pred (genviron2globals (filter_genv ge)) a (readonly2share (gvar_readonly v))
-       (Vptr b (Ptrofs.repr z))) w1.
+  forall (Haccess : forall loc, adr_range (b, z) (init_data_size a) loc -> access_at m3 loc Cur = Some (Genv.perm_globvar v))
+    (VOL:  gvar_volatile v = false)
+    (AL: initializer_aligned z a = true)
+    (LO: 0 <= z) (HI: z + init_data_size a < Ptrofs.modulus),
+([∗ list] y ∈ seq (Z.to_nat z) (Z.to_nat (init_data_size a)), inflate_loc m3 ge G (b, 0 + Z.of_nat y)) ⊢
+init_data2pred (genviron2globals (filter_genv ge)) a (readonly2share (gvar_readonly v))
+  (Vptr b (Ptrofs.repr z)).
 Proof.
   intros.
   assert (APOS:= init_data_size_pos a).
   assert (READABLE:= readable_readonly2share (gvar_readonly v)).
-  Transparent load.
-  unfold init_data2pred, mapsto.
-  unfold mapsto_zeros, address_mapsto, res_predicates.address_mapsto,
-    fst,snd.
-  rewrite Ptrofs.unsigned_repr by (unfold Ptrofs.max_unsigned; lia).
-  simpl.
+  unfold init_data2pred, mapsto; simpl.
+  destruct (readable_share_dec _); last done.
+  unfold mapsto_zeros, address_mapsto, res_predicates.address_mapsto, fst, snd.
+  rewrite -> Ptrofs.unsigned_repr by (unfold Ptrofs.max_unsigned; lia).
   unfold mapsto, tc_val, is_int, is_long, is_float.
-  destruct (readable_share_dec
-            (readonly2share (gvar_readonly v))); [clear r | tauto].
-  destruct a; 
-  repeat rewrite prop_true_andp by 
+  rewrite -(Nat.add_0_r (Z.to_nat z)) -fmap_add_seq big_sepL_fmap.
+  rewrite (big_sepL_proper _ (fun _ y => adr_add (b, z) (Z.of_nat y) ↦{#readonly2share (gvar_readonly v)} VAL (contents_at m3 (b, z + Z.of_nat y)))).
+Transparent load.
+  iIntros "H"; destruct a; repeat rewrite -> prop_true_andp by 
     first [apply I
             | apply sign_ext_range'; compute; split; congruence
             | apply zero_ext_range'; compute; split; congruence
             ];
-  try left; simpl in H; unfold load in H;
+  try iLeft; simpl in H; unfold load in H;
   try (if_tac in H; [ | discriminate H]);
-  repeat rewrite prop_true_andp by apply I;
+  repeat rewrite -> prop_true_andp by apply I;
   try match type of H with Some (decode_val ?ch ?B) = Some (?V) =>
-            exists B; replace V with (decode_val ch B) by (inversion H; auto);
-            clear H; repeat split; auto
-       end.
+            iExists B; replace V with (decode_val ch B) by (inversion H; auto);
+            clear H
+       end; try (iSplit; last (by simpl; rewrite ?Z.add_0_r -?Z.add_assoc);
+                 iPureIntro; repeat split; auto; try solve [apply Zmod_divide; [intro Hx; inv Hx | apply Zeq_bool_eq; auto]]).
+Opaque load.
 * (* Int8 *)
   apply Zone_divide.
-* (* Int8 *)
-  intro loc; specialize (H2 loc).
-  simpl in H2. hnf. if_tac; auto.
-  exists READABLE.
-  destruct H2.
-  apply join_comm in H1.
-  apply (resource_at_join _ _ _ loc) in H1.
-  apply H2 in H1. hnf. rewrite H1.
-  unfold beyond_block. rewrite only_blocks_at.
-  rewrite if_true by (destruct loc; destruct H; subst; apply Plt_strict).
-  unfold inflate_initial_mem. rewrite resource_at_make_rmap.
-  unfold inflate_initial_mem'. rewrite H4.
-  unfold Genv.perm_globvar. rewrite VOL. rewrite preds_fmap_NoneP.
-  destruct (gvar_readonly v);  repeat f_equal; auto with extensionality.
-  rewrite H0.
-  destruct loc; destruct H; subst b0.
-  apply nth_getN; simpl; lia.
-  rewrite H0.
-  destruct loc; destruct H; subst b0.
-  apply nth_getN; simpl; lia.
-* (* Int16 *)
-  simpl in AL. apply Zmod_divide.  intro Hx; inv Hx. apply Zeq_bool_eq; auto.
-* (* Int16 *)
-  intro loc; specialize (H2 loc).
-  simpl in H2. simpl size_chunk. hnf; if_tac; auto.
-  exists READABLE.
-  destruct H2.
-  apply join_comm in H1.
-  apply (resource_at_join _ _ _ loc) in H1.
-  apply H2 in H1. hnf; rewrite H1.
-  unfold beyond_block. rewrite only_blocks_at.
-  rewrite if_true by (  destruct loc; destruct H; subst; apply Plt_strict).
-  unfold inflate_initial_mem. rewrite resource_at_make_rmap.
-  unfold inflate_initial_mem'. rewrite H4.
- unfold Genv.perm_globvar. rewrite VOL. rewrite preds_fmap_NoneP.
-  destruct (gvar_readonly v);  repeat f_equal; auto with extensionality.
-  rewrite H0.
-  destruct loc; destruct H; subst b0.
-  apply nth_getN; simpl; lia.
-  rewrite H0.
-  destruct loc; destruct H; subst b0.
-  apply nth_getN; simpl; lia.
-* (* Int32 *)
-  simpl in AL. apply Zmod_divide.  intro Hx; inv Hx. apply Zeq_bool_eq; auto.
-* (* Int32 *)
-  intro loc; specialize (H2 loc).
-  simpl in H2. simpl size_chunk. hnf; if_tac; auto.
-  exists READABLE.
-  destruct H2.
-  apply join_comm in H1.
-  apply (resource_at_join _ _ _ loc) in H1.
-  apply H2 in H1. hnf; rewrite H1.
-  unfold beyond_block. rewrite only_blocks_at.
-  rewrite if_true by (  destruct loc; destruct H; subst; apply Plt_strict).
-  unfold inflate_initial_mem. rewrite resource_at_make_rmap.
-  unfold inflate_initial_mem'. rewrite H4.
- unfold Genv.perm_globvar. rewrite VOL. rewrite preds_fmap_NoneP.
-  destruct (gvar_readonly v);  repeat f_equal; auto with extensionality.
-  rewrite H0.
-  destruct loc; destruct H; subst b0.
-  apply nth_getN; simpl; lia.
-  rewrite H0.
-  destruct loc; destruct H; subst b0.
-  apply nth_getN; simpl; lia.
-* (* Int64 *)
-  simpl in AL. apply Zmod_divide.  intro Hx; inv Hx. apply Zeq_bool_eq; auto.
-* (* Int64 *)
-  intro loc; specialize (H2 loc).
-  simpl in H2. simpl size_chunk. hnf; if_tac; auto.
-  exists READABLE.
-  destruct H2.
-  apply join_comm in H1.
-  apply (resource_at_join _ _ _ loc) in H1.
-  apply H2 in H1. hnf; rewrite H1.
-  unfold beyond_block. rewrite only_blocks_at.
-  rewrite if_true by (  destruct loc; destruct H; subst; apply Plt_strict).
-  unfold inflate_initial_mem. rewrite resource_at_make_rmap.
-  unfold inflate_initial_mem'. rewrite H4.
- unfold Genv.perm_globvar. rewrite VOL. rewrite preds_fmap_NoneP.
-  destruct (gvar_readonly v);  repeat f_equal; auto with extensionality.
-  rewrite H0.
-  destruct loc; destruct H; subst b0.
-  apply nth_getN; simpl; lia.
-  rewrite H0.
-  destruct loc; destruct H; subst b0.
-  apply nth_getN; simpl; lia.
-* (* Float32 *)
-  simpl in AL. apply Zmod_divide.  intro Hx; inv Hx. apply Zeq_bool_eq; auto.
-* (* Float32 *)
-  intro loc; specialize (H2 loc).
-  simpl in H2. simpl size_chunk. hnf; if_tac; auto.
-  exists READABLE.
-  destruct H2.
-  apply join_comm in H1.
-  apply (resource_at_join _ _ _ loc) in H1.
-  apply H2 in H1. hnf; rewrite H1.
-  unfold beyond_block. rewrite only_blocks_at.
-  rewrite if_true by (  destruct loc; destruct H; subst; apply Plt_strict).
-  unfold inflate_initial_mem. rewrite resource_at_make_rmap.
-  unfold inflate_initial_mem'. rewrite H4.
- unfold Genv.perm_globvar. rewrite VOL. rewrite preds_fmap_NoneP.
-  destruct (gvar_readonly v);  repeat f_equal; auto with extensionality.
-  rewrite H0.
-  destruct loc; destruct H; subst b0.
-  apply nth_getN; simpl; lia.
-  rewrite H0.
-  destruct loc; destruct H; subst b0.
-  apply nth_getN; simpl; lia.
 * (* Float64 *)
-   clear - AL.
-  simpl in AL. apply Zmod_divide.  intro Hx; inv Hx. apply Zeq_bool_eq; auto.
-  rewrite <- Zeq_is_eq_bool in *.
+  clear - AL.
+  simpl in AL. apply Zmod_divide. intro Hx; inv Hx. apply Zeq_bool_eq; auto.
+  rewrite <- Zeq_is_eq_bool in *; simpl.
   apply Zmod_divides; [ lia | ].
   apply Zmod_divides in AL; [ | lia].
   destruct AL as [c ?]. exists (2 * c)%Z. rewrite Z.mul_assoc. apply H.
-*  intro loc; specialize (H2 loc).
-  simpl in H2. simpl size_chunk. hnf; if_tac; auto.
-  exists READABLE.
-  destruct H2.
-  apply join_comm in H1.
-  apply (resource_at_join _ _ _ loc) in H1.
-  apply H2 in H1. hnf; rewrite H1.
-  unfold beyond_block. rewrite only_blocks_at.
-  rewrite if_true by (  destruct loc; destruct H; subst; apply Plt_strict).
-  unfold inflate_initial_mem. rewrite resource_at_make_rmap.
-  unfold inflate_initial_mem'. rewrite H4.
- unfold Genv.perm_globvar. rewrite VOL. rewrite preds_fmap_NoneP.
-  destruct (gvar_readonly v);  repeat f_equal; auto with extensionality.
-  rewrite H0.
-  destruct loc; destruct H; subst b0.
-  apply nth_getN; simpl; lia.
-  rewrite H0.
-  destruct loc; destruct H; subst b0.
-  apply nth_getN; simpl; lia.
 * (* address_mapsto_zeros *)
- rewrite address_mapsto_zeros_eq.
- split; auto. 
-  split; auto. simpl in HI. clear - HI. destruct (Z.max_spec z0 0); destruct H; lia.
-  intro loc. hnf. specialize (H2 loc); simpl in H2.
-rewrite Zmax_Z_of_nat.
-rewrite Z_to_nat_max.
-if_tac; auto.
-
-  exists READABLE.
-  destruct H2.
-  apply join_comm in H1.
-  apply (resource_at_join _ _ _ loc) in H1.
-  apply H2 in H1. hnf; rewrite H1.
-  unfold beyond_block. rewrite only_blocks_at.
-  rewrite if_true by (  destruct loc; destruct H3; subst; apply Plt_strict).
-  unfold inflate_initial_mem. rewrite resource_at_make_rmap.
-  unfold inflate_initial_mem'. rewrite H4.
- unfold Genv.perm_globvar. rewrite VOL. rewrite preds_fmap_NoneP.
-  destruct loc; destruct H3; subst b0.
-  specialize (H (z1-z)).  spec H; [lia |].
-  if_tac in H; [ | discriminate].
-  replace (z+(z1-z)) with z1 in * by lia.
-  rewrite H0.
-  inv H.
-  assert (contents_at m3 (b,z1) = Byte Byte.zero).
-    unfold contents_at.
-    simpl. forget (ZMap.get z1 (PMap.get b (mem_contents m3))) as byt.
-    clear - H7.
-    unfold decode_val in H7.
-    revert H7; case_eq (proj_bytes (byt::nil)); intros; try discriminate.
-    simpl in  H. destruct byt; inv H.
-    unfold decode_int in H7.
-    replace (rev_if_be (i::nil)) with (i::nil) in H7 by (unfold rev_if_be; destruct Archi.big_endian; auto).
-    simpl int_of_bytes in H7.
-    replace (Byte.unsigned i + 0) with (Byte.unsigned i) in H7 by lia.
-    f_equal.
-   apply zero_ext_inj. forget (Int.zero_ext 8 (Int.repr (Byte.unsigned i))) as j; inv H7; auto.
-  destruct (gvar_readonly v);  repeat f_equal; auto with extensionality.
-
+  rewrite address_mapsto_zeros_eq /=.
+  iSplit.
+  { iPureIntro; split; auto. simpl in HI. clear - HI. destruct (Z.max_spec z0 0); destruct H; lia. }
+  rewrite Z_to_nat_max; iApply (big_sepL_mono with "H").
+  intros ?? (-> & ?)%lookup_seq; simpl.
+  assert (contents_at m3 (b, z + Z.of_nat k) = Byte Byte.zero) as ->; last done.
+  specialize (H (Z.of_nat k)).
+  spec H; first lia.
+  if_tac in H; inv H.
+  rewrite /decode_val /= in H3.
+  rewrite /contents_at.
+  destruct (Maps.ZMap.get _ _); try done.
+  rewrite /decode_int in H3.
+  replace (rev_if_be [i]) with [i] in H3 by (unfold rev_if_be; destruct Archi.big_endian; auto).
+  rewrite /= Z.add_0_r in H3.
+  f_equal; apply zero_ext_inj; congruence.
 * (* symbol case *)
-  case_eq (Map.get (filter_genv ge) i); try destruct p0; auto; intros.
-+
-  unfold genviron2globals, filter_genv, Map.get in H4|-*.
-  rewrite H4 in *.
-  left. split; [apply I | ]. rewrite Ptrofs.add_zero_l.
- exists  (getN (size_chunk_nat Mptr) z (mem_contents m3) !! b).
- repeat split; auto.
- clear - H. 
- cbv iota. congruence.
-  simpl in AL. apply Zmod_divide.  intro Hx; inv Hx. apply Zeq_bool_eq; auto.
-  intro loc; specialize (H2 loc). hnf. simpl init_data_size in H2.
- replace (if Archi.ptr64 then 8 else 4) with (size_chunk Mptr) in H2
-   by (unfold Mptr; destruct Archi.ptr64; reflexivity).
- if_tac; [ | apply H2].
-  exists READABLE. hnf. 
-  destruct H2.
-  apply join_comm in H1.
-  apply (resource_at_join _ _ _ loc) in H1.
-  apply H2 in H1. hnf; rewrite H1.
-  unfold beyond_block. rewrite only_blocks_at.
-  rewrite if_true
-   by (destruct loc, H,H5; subst; apply Plt_strict).
-  unfold inflate_initial_mem. rewrite resource_at_make_rmap.
-  unfold inflate_initial_mem'. rewrite H6.
- unfold Genv.perm_globvar. rewrite VOL. rewrite preds_fmap_NoneP.
-  destruct (gvar_readonly v);  repeat f_equal; auto with extensionality.
-  rewrite H0.
-  destruct loc; destruct H5.  subst b1.
-  apply nth_getN; simpl; lia.
-  rewrite H0.
-  destruct loc; destruct H5; subst b1.
-  apply nth_getN; simpl; lia.
-+
-  unfold genviron2globals. rewrite H4 in *.
-  erewrite mapsto__exp_address_mapsto by (auto; reflexivity).
-  rewrite exp_address_mapsto_VALspec_range_eq.
-  rewrite Ptrofs.unsigned_repr by (change Ptrofs.max_unsigned with (Ptrofs.modulus-1); lia).
-  split.
-  simpl in AL|-*.
-  apply Zmod_divide.  intro Hx; inv Hx. apply Zeq_bool_eq; auto.
-  hnf. intro loc; specialize (H2 loc). hnf.
-  simpl init_data_size in H2.
- replace (if Archi.ptr64 then 8 else 4) with (size_chunk Mptr) in H2
-   by (unfold Mptr; destruct Archi.ptr64; reflexivity).
- if_tac; [ | apply H2].
- destruct H2.
-  apply join_comm in H1.
-  apply (resource_at_join _ _ _ loc) in H1.
-  apply H2 in H1.
-  eexists.
-  hnf. exists READABLE.
-  hnf; rewrite H1.
-  unfold beyond_block. rewrite only_blocks_at.
-  rewrite if_true
-   by (destruct loc, H,H5; subst; apply Plt_strict).
-  unfold inflate_initial_mem. rewrite resource_at_make_rmap.
-  unfold inflate_initial_mem'. rewrite H6.
- unfold Genv.perm_globvar. rewrite VOL. rewrite preds_fmap_NoneP.
-  destruct (gvar_readonly v);  repeat f_equal; auto with extensionality.
+  injection H as H.
+  rewrite /genviron2globals /filter_genv /Map.get.
+  assert (align_chunk Mptr | z).
+  { simpl in AL. apply Zmod_divide. intro Hx; inv Hx. apply Zeq_bool_eq; auto. }
+  destruct (Genv.find_symbol (genv_genv ge) i) eqn: Hi.
+  + iLeft. iSplit; first done. rewrite Ptrofs.add_zero_l.
+    iExists (getN (size_chunk_nat Mptr) z (Maps.PMap.get b (mem_contents m3))).
+    iSplit; first by iPureIntro.
+    rewrite getN_seq (big_sepL_fmap _ _ (seq 0 (size_chunk_nat Mptr))).
+    replace (Z.to_nat (init_data_size (Init_addrof i i0))) with (size_chunk_nat Mptr)
+      by (rewrite /Mptr /=; simple_if_tac; done).
+    done.
+  + erewrite mapsto__exp_address_mapsto by (auto; reflexivity).
+    rewrite exp_address_mapsto_VALspec_range_eq.
+    rewrite -> Ptrofs.unsigned_repr by (change Ptrofs.max_unsigned with (Ptrofs.modulus-1); lia).
+    iSplit; first by iPureIntro.
+    rewrite /VALspec_range.
+    replace (Z.to_nat (init_data_size (Init_addrof i i0))) with (size_chunk_nat Mptr)
+      by (rewrite /Mptr /=; simple_if_tac; done).
+    iApply (big_sepL_mono with "H"); intros.
+    rewrite /VALspec; eauto.
+* intros ?? (-> & ?)%lookup_seq.
+  rewrite /= Z.add_0_l Nat2Z.inj_add Z2Nat.id //.
+  rewrite /inflate_loc Haccess; last by split; auto; lia.
+  rewrite /readonly2share /Genv.perm_globvar VOL; simple_if_tac; done.
 Qed.
 
 Lemma init_data_list_size_app:
@@ -967,191 +700,162 @@ Proof.
  unfold Ptrofs.max_unsigned. lia.
 Qed.
 
+Lemma drop_perm_contents : forall m b lo hi p m', drop_perm m b lo hi p = Some m' ->
+  contents_at m = contents_at m'.
+Proof.
+  rewrite /drop_perm; intros.
+  destruct (range_perm_dec _ _ _ _ _ _); inv H; done.
+Qed.
+
+Lemma drop_perm_access : forall m b lo hi p m', drop_perm m b lo hi p = Some m' ->
+  forall l k, access_at m' l k = if adr_range_dec (b, lo) (hi - lo) l then Some p else access_at m l k.
+Proof.
+  rewrite /drop_perm; intros.
+  destruct (range_perm_dec _ _ _ _ _ _); inv H.
+  rewrite /access_at /=.
+  destruct l as (b0, z); if_tac.
+  - destruct H; subst.
+    rewrite Maps.PMap.gss /=.
+    destruct (zle lo z); simpl; last lia.
+    destruct (zlt z hi); simpl; last lia; done.
+  - destruct (eq_dec b0 b); last by rewrite Maps.PMap.gso.
+    subst; rewrite Maps.PMap.gss /=.
+    destruct (zle lo z); last done.
+    destruct (zlt z hi); last done.
+    contradiction H; split; auto; lia.
+Qed.
+
+Lemma store_zeros_other_block : forall m b lo hi m' b', store_zeros m b lo hi = Some m' ->
+  b' ≠ b -> Maps.PMap.get b' (mem_contents m') = Maps.PMap.get b' (mem_contents m).
+Proof.
+  eapply (store_zeros_ind (fun m b p n m1 => forall m' b', m1 = Some m' -> b' ≠ b ->
+    Maps.PMap.get b' (mem_contents m') = Maps.PMap.get b' (mem_contents m))); intros.
+  - by inv H.
+  - eapply H in H0 as ->; last done.
+    apply store_mem_contents in e0 as ->.
+    rewrite Maps.PMap.gso //.
+  - done.
+Qed.
+
+Lemma store_init_data_list_other_block : forall {F V} ge m b o dl m' b', Genv.store_init_data_list(F := F)(V := V) ge m b o dl = Some m' ->
+  b' ≠ b -> Maps.PMap.get b' (mem_contents m') = Maps.PMap.get b' (mem_contents m).
+Proof.
+  intros until dl; revert m o.
+  induction dl; simpl; intros; first congruence.
+  destruct (Genv.store_init_data) eqn: Hd; last done.
+  eapply IHdl in H as ->; last done.
+  unfold Genv.store_init_data in Hd.
+  destruct a; try solve [erewrite store_mem_contents by eassumption; rewrite Maps.PMap.gso //].
+  - by inv Hd.
+  - destruct (Genv.find_symbol ge i); last done.
+    erewrite store_mem_contents by eassumption; rewrite Maps.PMap.gso //.
+Qed.
+
+Lemma init_data_list_lem':
+forall (ge: genv) G (v : globvar type) (b : block)
+  (m : Memory.mem) (a dl0 : list init_data),
+   Genv.load_store_init_data ge m b (init_data_list_size dl0) a ->
+   forall (Haccess: forall loc, adr_range (b, init_data_list_size dl0) (init_data_list_size a) loc -> access_at m loc Cur = Some (Genv.perm_globvar v))
+     (Hinit: ∀ (dl' : list init_data) (a1 : init_data) (dl : list init_data),
+       dl' ++ a1 :: dl = dl0 ++ a
+       → load_store_init_data1 (genv_genv ge) m b (init_data_list_size dl') a1)
+     (VOL:  gvar_volatile v = false)
+     (AL: initializers_aligned (init_data_list_size dl0) a = true)
+     (HI: init_data_list_size dl0 + init_data_list_size a < Ptrofs.modulus),
+([∗ list] o ∈ seq (Z.to_nat (init_data_list_size dl0)) (Z.to_nat (init_data_list_size a)), inflate_loc m ge G (b, 0 + Z.of_nat o)) ⊢
+init_data_list2pred (genviron2globals (filter_genv ge)) a (readonly2share (gvar_readonly v))
+  (Vptr b (Ptrofs.repr (init_data_list_size dl0))).
+Proof.
+  induction a as [|a la]; simpl; intros; first done.
+  apply andb_true_iff in AL as [??].
+  iIntros "H".
+  assert (0 <= init_data_size a) by (pose proof (init_data_size_pos a); lia).
+  assert (0 <= init_data_list_size la) by (pose proof (init_data_list_size_pos la); lia).
+  assert (0 <= init_data_list_size dl0) by (pose proof (init_data_list_size_pos dl0); lia).
+  rewrite Z2Nat.inj_add // seq_app big_sepL_app.
+  specialize (IHla (dl0 ++ [a])); rewrite init_data_list_size_app /= Z.add_0_r in IHla.
+  rewrite -Z2Nat.inj_add // IHla //; try lia.
+  rewrite /Ptrofs.add !Ptrofs.unsigned_repr; [| rewrite /Ptrofs.max_unsigned; lia..].
+  iDestruct "H" as "(H & $)".
+  iApply (init_data_lem with "H"); try assumption.
+  - by eapply Hinit.
+  - intros (?, ?) (? & ?); apply Haccess; lia.
+  - lia.
+  - destruct a; tauto.
+  - intros (?, ?) (? & ?); apply Haccess; lia.
+  - intros ???; rewrite -app_assoc; eauto.
+Qed.
+
+Lemma load_store_init_data1_invariant: ∀ ge (m m' : Memory.mem) (b : block),
+         (∀ (chunk : memory_chunk) (ofs : Z), load chunk m' b ofs = load chunk m b ofs)
+         → ∀ (i : init_data) (p : Z),
+             load_store_init_data1 ge m b p i → load_store_init_data1 ge m' b p i.
+Proof.
+  destruct i; simpl; intros; rewrite H //; eauto.
+Qed.
+
 Lemma init_data_list_lem:
-  forall (ge: genv) m0 (v: globvar type) m1 b m2 m3 m4  phi0,
+  forall (ge: genv) m0 (v: globvar type) m1 b m2 m3 m4,
      alloc m0 0 (init_data_list_size (gvar_init v)) = (m1,b) ->
      store_zeros m1 b 0 (init_data_list_size (gvar_init v)) = Some m2 ->
      Genv.store_init_data_list ge m2 b 0 (gvar_init v) = Some m3 ->
      drop_perm m3 b 0 (init_data_list_size (gvar_init v))
                (Genv.perm_globvar v) = Some m4 ->
-  forall
+  forall {F} (gl : list (ident * globdef F _)) i G
    (SANITY: init_data_list_size (gvar_init v) < Ptrofs.modulus)
-   (VOL:  gvar_volatile v = false)
-   (AL: initializers_aligned 0 (gvar_init v) = true),
-     init_data_list2pred  (genviron2globals (filter_genv ge)) (gvar_init v) (readonly2share (gvar_readonly v)) (Vptr b Ptrofs.zero)
-            (beyond_block b (inflate_initial_mem m4 phi0)).
+   (AL: initializers_aligned 0 (gvar_init v) = true)
+   (Hgl: nextblock m0 = Z.to_pos (Z.succ (Zlength gl))),
+     inflate_initial_mem m4 (globals_bounds 1 (gl ++ [(i, Gvar v)])) ge G ⊢ inflate_initial_mem m0 (globals_bounds 1 gl) ge G ∗
+     if gvar_volatile v then True else init_data_list2pred (genviron2globals (filter_genv ge)) (gvar_init v) (readonly2share (gvar_readonly v)) (Vptr b Ptrofs.zero).
 Proof.
-intros.
-set (phi := beyond_block b (inflate_initial_mem m4 phi0)).
-assert (forall loc, fst loc <> b -> identity (phi @ loc)).
-  unfold phi; intros.
-  unfold beyond_block. rewrite only_blocks_at.
-  if_tac; [ |  apply core_identity].
-  unfold inflate_initial_mem.  rewrite resource_at_make_rmap.
-  unfold inflate_initial_mem'.
-  unfold access_at.
-  rewrite nextblock_noaccess. apply NO_identity.
-  rewrite (nextblock_drop _ _ _ _ _ _ H2).
-  rewrite (Genv.store_init_data_list_nextblock _ _ _ _ _ H1).
-  rewrite (Genv.store_zeros_nextblock _ _ _ _ H0).
-  assert (nextblock m1 = Pos.succ b /\ b = nextblock m0).
-   clear - H. Transparent alloc. inv H.  simpl. auto. Opaque alloc.
- destruct H5; unfold block in *; subst; try apply Plt_strict.
- rewrite H5. contradict H4. clear - H3 H4. 
- apply Plt_succ_inv in H4. destruct H4; auto; contradiction.
- assert (forall loc, if adr_range_dec (b,0)  (init_data_list_size (gvar_init v)) loc
-                             then access_at m4 loc Cur = Some (Genv.perm_globvar v)
-                             else identity (phi @ loc)).
-  intro. if_tac.
-     destruct loc; destruct H4; subst b0.
-     unfold access_at. simpl. forget (Genv.perm_globvar v) as p.
-      forget (init_data_list_size (gvar_init v)) as n.
-     clear - H2 H5. unfold drop_perm in H2.
-      destruct (range_perm_dec m3 b 0 n Cur Freeable); inv H2.
-      simpl.  rewrite PMap.gss.
-       destruct (zle 0 z); try lia. destruct (zlt z n); try lia.
-       simpl; auto.
-    destruct loc.
-  destruct (eq_dec b b0). subst b0.
-  unfold phi. unfold beyond_block. rewrite only_blocks_at.
-   simpl. rewrite if_true by (unfold block; apply Plt_strict).
-  unfold inflate_initial_mem.  rewrite resource_at_make_rmap.
-  unfold inflate_initial_mem'.
-  replace (access_at m4 (b,z) Cur) with (@None permission).
-  apply NO_identity.
-  symmetry.  transitivity (access_at m3 (b,z) Cur).
-  clear - H4 H2. unfold access_at; unfold drop_perm in H2.
-   destruct (range_perm_dec m3 b 0 (init_data_list_size (gvar_init v)) Cur
-         Freeable); inv H2. simpl. rewrite PMap.gss.
-  unfold adr_range in H4. destruct (zle 0 z); auto.
-   destruct (zlt z (init_data_list_size (gvar_init v)) ); auto.
-  contradiction H4. split; auto.
-  transitivity (access_at m2 (b,z) Cur).
-  apply store_init_data_list_outside' in H1.
-  destruct H1 as [? [? ?]]; congruence.
-  transitivity (access_at m1 (b,z) Cur).
-  clear - H0. erewrite store_zeros_access; eauto.
-  clear - H H4. Transparent alloc. inv H. Opaque alloc. unfold access_at; simpl.
-  rewrite PMap.gss. destruct (zle 0 z); auto.
-   destruct (zlt z (init_data_list_size (gvar_init v)) ); auto.
-  contradiction H4. split; auto.
-   apply H3. auto.
-  clear H3.
-  assert (contents_at m4 = contents_at m3).
-  clear - H2; unfold contents_at, drop_perm in *.
-   destruct (range_perm_dec m3 b 0 (init_data_list_size (gvar_init v)) Cur
-         Freeable); inv H2. simpl. auto.
-   clear H2.
-   forget (gvar_init v) as dl.
-   remember dl as D.
-   rewrite HeqD in AL,H4|-*.
-   assert (nil++dl=D) by (subst; auto).
-   remember (@nil init_data) as dl'.
-   remember (core phi) as w'.
-   remember phi as w.
-   assert (join w' w phi). subst. apply core_unit.
-   unfold Ptrofs.zero.
-   remember 0 as z. rewrite Heqz in H,H0,H1.
-   replace z with (init_data_list_size dl') in AL,H4|-* by (subst; auto).
-   clear z Heqz.
-   assert (forall loc, if adr_range_dec (b,init_data_list_size dl') (init_data_list_size dl) loc
-                               then identity (w' @ loc)  else identity (w @ loc)).
-  intro. subst. if_tac. rewrite <- core_resource_at. apply core_identity.
-  specialize (H4 loc). rewrite if_false in H4 by auto; auto.
-   clear Heqw' Heqw Heqdl' HeqD.
-   revert dl' w' w AL H2 H4 H5 H6; induction dl; simpl; intros.
-   assert (emp w); auto.
-   rewrite emp_no; simpl; intro loc.
-   specialize (H6 loc); if_tac in H6; auto. destruct loc; destruct H7.
-   lia.
-  assert (SANITY': init_data_list_size dl' + init_data_size a + init_data_list_size dl < Ptrofs.modulus).
-  clear - H2 SANITY.
-  subst D.
- rewrite init_data_list_size_app in SANITY. simpl in SANITY. lia.
-  destruct (split_range w (b,init_data_list_size dl') (init_data_size a)) as [w1 [w2 [? ?]]]; auto.
-  intros. apply (resource_at_join _ _ _ loc) in H5.
-  specialize (H6 loc). rewrite if_true in H6. apply H6 in H5.
-  rewrite H5.
-    unfold phi; clear. unfold beyond_block. rewrite only_blocks_at.
-   if_tac; [ |   destruct (inflate_initial_mem m4 phi0 @ loc);
-                [rewrite core_NO | rewrite core_YES | rewrite core_PURE]; auto].
-  unfold inflate_initial_mem; rewrite resource_at_make_rmap.
-  unfold inflate_initial_mem'. destruct (access_at m4 loc); try destruct p; simpl; auto.
-  destruct (phi0 @ loc); auto.
-  destruct loc. destruct H7; split; auto.
-  pose proof (init_data_list_size_pos dl).
-  lia.
-  exists w1; exists w2; split3; auto.
-  clear IHdl.
-  destruct (join_assoc H7 (join_comm H5)) as [wf [? ?]].
-  assert (forall loc, if adr_range_dec (b,init_data_list_size dl') (init_data_size a) loc
-                                 then identity (wf @ loc) /\
-                                         access_at m4 loc Cur = Some (Genv.perm_globvar v)
-                                 else identity (w1 @ loc)).
-     intro. specialize (H8 loc); specialize (H6 loc); specialize (H4 loc).
-       apply (resource_at_join _ _ _ loc) in H9;
-       apply (resource_at_join _ _ _ loc) in H10.
- if_tac.  rewrite if_true in H6,H4. apply H8 in H9. rewrite <- H9; auto.
-   destruct loc; destruct H11; subst b0. split; auto.
-   pose proof (init_data_list_size_pos dl); lia.
-   destruct loc; destruct H11; subst b0. split; auto.
-   pose proof (init_data_list_size_pos dl); lia.
- auto.
-  pose proof (load_store_init_data_lem1 H0 H1 _ _ _ H2).
-  unfold phi in *; clear phi.
-  eapply init_data_lem; try eassumption.
-  apply ghost_of_join in H7.
-  clear - AL. apply andb_true_iff in AL. destruct AL; auto.
-  pose proof (init_data_list_size_pos dl'); lia.
-  pose proof (init_data_list_size_pos dl); lia.
-  destruct (join_assoc (join_comm H7) (join_comm H5)) as [wg [? ?]].
-  specialize (IHdl  (dl' ++ (a::nil))  wg w2).
-  replace (init_data_list_size (dl' ++ a :: nil)) with
-             (init_data_list_size dl' + init_data_size a) in IHdl.
-  rewrite Ptrofs.add_unsigned.
-  repeat rewrite Ptrofs.unsigned_repr
-       by (pose proof (init_data_list_size_pos dl'); pose proof (init_data_list_size_pos dl);
-      pose proof (init_data_size_pos a); pose proof max_unsigned_modulus; lia).
-  apply IHdl; auto.
-  apply andb_true_iff in AL; destruct AL; auto.
-  rewrite <- app_assoc; auto.
-  intro loc; specialize (H6 loc); specialize (H8 loc); specialize (H4 loc).
-  if_tac. rewrite if_true in H4; auto.
-  destruct loc; destruct H11; auto.
-  split; auto.
-  pose proof (init_data_size_pos a); lia.
-  if_tac in H8; auto.
-  rewrite if_false in H6.
-  apply join_comm in H5.
-  apply (resource_at_join _ _ _ loc) in H7.
-  apply H8 in H7. rewrite H7; auto.
-  destruct loc.
-  intros [? ?]. subst b0.
-  forget (init_data_list_size dl') as u.
- destruct (zlt z (u + init_data_size a)).
- apply H12.  split; auto. lia.
- apply H11.  split; auto. lia.
-  intro loc. specialize (H4 loc); specialize (H6 loc); specialize (H8 loc).
-  apply (resource_at_join _ _ _ loc) in H7.
-  apply (resource_at_join _ _ _ loc) in H9.
-  apply (resource_at_join _ _ _ loc) in H10.
-  apply (resource_at_join _ _ _ loc) in H5.
- destruct loc.
-  if_tac in H8.
-  rewrite if_false; auto.
- clear - H11; destruct H11; intros [? ?]. lia.
-  if_tac in H4.
-  rewrite if_true.
-  apply H8 in H9. rewrite <- H9 in *. auto.
-  destruct H12; subst b0. split; auto.
-  forget (init_data_list_size dl') as u.
-  assert (~ (u <= z < u + init_data_size a)) by (contradict H11; destruct H11; split; auto; lia).
-  lia.
- rewrite if_false. apply H8 in H7. rewrite H7; auto.
- contradict H12. destruct H12; split; auto.
-  pose proof (init_data_size_pos a); lia.
- clear.
-  induction dl'; simpl; intros; try lia.
+  intros.
+  rewrite /inflate_initial_mem.
+  erewrite nextblock_drop, Genv.store_init_data_list_nextblock, Genv.store_zeros_nextblock, nextblock_alloc by done.
+  rewrite Pos2Nat.inj_succ /= Nat.sub_0_r.
+  destruct (Pos2Nat.is_succ (nextblock m0)) as (n & Hnext).
+  rewrite Hnext seq_S big_sepL_app /=.
+  pose proof (alloc_result _ _ _ _ _ H) as ->.
+  iIntros "(Hrest & Hb & _)"; iSplitL "Hrest".
+  - rewrite Nat.sub_0_r; iApply (big_sepL_mono with "Hrest").
+    intros ?? (-> & ?)%lookup_seq.
+    rewrite globals_bounds_app1; last by rewrite Zlength_correct in Hgl; lia.
+    destruct (globals_bounds _ _ _); apply big_sepL_mono; intros.
+    rewrite /drop_perm in H2; destruct range_perm_dec; inv H2; rewrite /inflate_loc /access_at /contents_at /=.
+    assert (Pos.of_nat (S k) ≠ nextblock m0) by lia.
+    erewrite store_init_data_list_other_block; [| eassumption..].
+    erewrite store_zeros_other_block; [| eassumption..].
+    erewrite mem_lemmas.AllocContentsOther; [| eassumption..].
+    rewrite Maps.PMap.gso //.
+    apply (alloc_dry_unchanged_on _ _ (Pos.of_nat (S k), z + y)) in H as (Haccess & Hcontents); last by intros [??].
+    rewrite {1}/access_at /= in Haccess; apply equal_f with Cur in Haccess; rewrite Haccess.
+    erewrite <- store_zeros_access by eassumption.
+    by apply store_init_data_list_outside' in H1 as (Hcontents3 & -> & _).
+  - destruct (gvar_volatile v) eqn: VOL; first done.
+    rewrite -Hnext Pos2Nat.id.
+    pose proof (nth_error_app gl [(i, Gvar v)] O) as Hv.
+    replace (base.length gl) with (Pos.to_nat (nextblock m0) - 1)%nat in Hv by (rewrite Zlength_correct in Hgl; lia).
+    rewrite Nat.add_0_r /= in Hv.
+    erewrite globals_bounds_nth; [| lia | done]; simpl.
+    pose proof (load_store_init_data_lem1 H0 H1).
+    assert (∀ (chunk : memory_chunk) (ofs : Z), load chunk m4 (nextblock m0) ofs = load chunk m3 (nextblock m0) ofs).
+    { intros; eapply load_drop; eauto.
+      right; right; right; rewrite /Genv.perm_globvar VOL.
+      simple_if_tac; constructor. }
+    rewrite seq_app big_sepL_app; iDestruct "Hb" as "(Hb & H1)".
+    iAssert emp with "[H1]" as "_".
+    { rewrite /inflate_loc /=.
+      pose proof (init_data_list_size_pos (gvar_init v)); rewrite Z.add_0_l Z2Nat.id; last lia.
+      erewrite <- access_drop_3; [| eauto | lia].
+      edestruct store_init_data_list_outside' as (_ & <- & _); first done.
+      erewrite store_zeros_access by done.
+      erewrite <- alloc_access_other; [| eauto | lia].
+      rewrite nextblock_access_empty //; last lia. }
+    iApply (init_data_list_lem' _ _ _ _ _ _ [] with "Hb"); try done.
+    + eapply Genv.load_store_init_data_invariant, Genv.store_init_data_list_charact; try done.
+      eapply Genv.store_zeros_read_as_zero; eauto.
+    + intros; erewrite drop_perm_access by done.
+      rewrite Z.sub_0_r if_true //.
+    + intros; eapply load_store_init_data1_invariant; eauto.
 Qed.
 
 Definition all_initializers_aligned (prog: program) :=
@@ -1204,6 +908,7 @@ Proof.
     f_equal; auto. auto.
 Qed.
 
+Transparent alloc.
 
 Lemma alloc_global_beyond2:
   forall {F V} (ge: Genv.t F V) m iv m', Genv.alloc_global ge m iv = Some m' ->
@@ -1213,7 +918,6 @@ Proof.
  intros.
  destruct loc as [b ofs]; simpl in *.
  unfold access_at, Genv.alloc_global in *.
-Transparent alloc.
  destruct iv; destruct g; simpl @fst; simpl @ snd;
  [forget 1 as N |  forget  (init_data_list_size (gvar_init v)) as N];
  revert H; case_eq (alloc m 0 N); intros; repeat invSome;
@@ -1222,15 +926,15 @@ Transparent alloc.
   destruct (range_perm_dec m b0 0 N Cur Freeable); inv H
  end;
   inv H; simpl in *;
- repeat rewrite PMap.gss;
- rewrite !PMap.gso by (intro Hx; inv Hx; unfold Plt in *; lia);
+ repeat rewrite Maps.PMap.gss;
+ rewrite -> !Maps.PMap.gso by (intro Hx; inv Hx; unfold Plt in *; lia);
  try (apply nextblock_noaccess; unfold Plt in *; lia).
  apply store_zeros_access in H1.
  apply store_init_data_list_outside' in H4.
  destruct H4 as [? [? ?]]. rewrite H2 in H1.
  change (access_at m2 (b,ofs) Cur = None).
  rewrite H1. unfold access_at; simpl.
- repeat rewrite PMap.gso by (intro Hx; inv Hx; lia).
+ repeat rewrite -> Maps.PMap.gso by (intro Hx; inv Hx; lia).
  apply nextblock_noaccess.
 clear - H0.
 unfold Plt. lia.
@@ -1255,55 +959,16 @@ apply store_init_data_list_access in H3.
 rewrite H0 in H3. clear m1 H0.
 inv H. unfold access_at in H3. simpl in *.
 apply equal_f with (nextblock m, z) in H3. apply equal_f with Cur in H3.
-simpl in H3. rewrite PMap.gss in *.
+simpl in H3. rewrite -> Maps.PMap.gss in *.
 destruct (zle 0 z). simpl. destruct (zlt z N).
 simpl in *.
 rewrite if_true; auto. rewrite if_false; auto.
  intros [? ?]. lia.
-simpl. rewrite if_false by lia.
+simpl. rewrite -> if_false by lia.
 simpl in H3; auto.
 Qed.
 
-Lemma alloc_global_inflate_same:
-  forall n i v gev m G m0,
-  Genv.alloc_global gev m0 (i, Gvar v) = Some m ->
-   (forall z : Z, initial_core gev G n @ (nextblock m0, z) = NO Share.bot bot_unreadable) ->
-   inflate_initial_mem m0 (initial_core gev G n) =
-   upto_block (nextblock m0) (inflate_initial_mem m (initial_core gev G n)).
-Proof.
- intros.
- apply rmap_ext.
-  unfold upto_block, inflate_initial_mem;
-  rewrite level_only_blocks; repeat rewrite level_make_rmap. auto.
- intro loc.
- unfold upto_block. rewrite only_blocks_at.
- unfold inflate_initial_mem.
- repeat rewrite resource_at_make_rmap.
- if_tac.
- destruct (alloc_global_old _ _ _ _ H _ H1) as [? ?];
- unfold inflate_initial_mem'; rewrite H2; rewrite H3; auto.
- destruct (eq_dec (fst loc) (nextblock m0)).
- 2:{
- assert (access_at m loc Cur = None).
-  eapply alloc_global_beyond2; try eassumption. unfold block,Plt in *; lia.
- assert (access_at m0 loc Cur = None).
-  unfold access_at. apply nextblock_noaccess. auto.
- unfold inflate_initial_mem'; rewrite H2; rewrite H3; auto.
- rewrite core_NO; auto.
- }
- clear H1.
- specialize (H0 (snd loc)).
- assert (access_at m0 loc Cur = None).
-  unfold access_at. apply nextblock_noaccess. rewrite <- e; unfold Plt in *; lia.
- unfold inflate_initial_mem' at 1. rewrite H1.
-  unfold inflate_initial_mem'.
- destruct loc; simpl in e; subst.
- rewrite (alloc_global_access _ _ _ _ _ H).
- if_tac. unfold Genv.perm_globvar. simple_if_tac. simpl in H0. rewrite H0. rewrite core_NO; auto.
-  simple_if_tac; rewrite core_YES; auto.
- rewrite core_NO; auto.
- unfold upto_block, only_blocks, inflate_initial_mem; rewrite !ghost_of_make_rmap; auto.
-Qed.
+Opaque alloc.
 
 Lemma find_id_rev {A}: forall i G,
  list_norepet (map fst G) -> find_id i (rev G) = @find_id A i G.
@@ -1354,7 +1019,7 @@ destruct l. inv H. right; auto.
 Qed.
 
 Definition prog_var_block (rho: environ) (il: list ident) (b: block) : Prop :=
-  Exists (fun id => match ge_of rho id with Some b' => b'=b | _ => False end) il.
+  Exists (fun id => match ge_of rho id with Some b' => b'=b | _ => False%type end) il.
 
 Lemma match_fdecs_in:
   forall i vl G,
@@ -1369,20 +1034,6 @@ Proof.
  right. apply (IHvl G0); auto.
 Qed.
 
-Lemma match_fdecs_norepet:
-  forall vl G,
-     list_norepet (map (@fst _ _) vl) ->
-     match_fdecs vl G ->
-     list_norepet (map (@fst _ _) G).
-Proof.
- induction vl; simpl; intros.
- inv H0. constructor.
- inv H0. inv H.
- simpl.
- constructor; auto.
- contradict H2. eapply match_fdecs_in; eauto.
-Qed.
-
 Lemma list_norepet_prog_funct':
   forall A B (vl: list (ident * globdef A B)),
         list_norepet (map (@fst _ _) vl) ->
@@ -1433,8 +1084,8 @@ intros j k ? ? ?; subst k.
 apply (H5 j j).
 rewrite in_app.
 destruct H0. right; left; auto.
-left; rewrite map_rev, <- in_rev; auto.
-rewrite map_rev, <- in_rev in H; auto.
+left; rewrite map_rev -in_rev; auto.
+rewrite map_rev -in_rev in H; auto.
 destruct H0; auto.
 subst j. specialize (H4 i i). contradiction H4; auto.
 left; auto.
@@ -1454,7 +1105,7 @@ Proof.
   rewrite <- (app_nil_r G).
   rewrite <- (rev_involutive vl), <- (rev_involutive G).
   apply match_fdecs_rev'; auto.
-  rewrite rev_involutive, app_nil_r; auto.
+  rewrite rev_involutive app_nil_r; auto.
   constructor.
 *
   rewrite <- (app_nil_r (rev vl)).
@@ -1466,333 +1117,39 @@ Proof.
 Qed.
 
 Lemma initial_core_rev:
-  forall (gev: Genv.t fundef type) G n (vl: list (ident * globdef fundef type))
-    (H: list_norepet (map fst (rev vl)))
-    (SAME_IDS : match_fdecs (prog_funct' vl) (rev G)),
-    initial_core gev G n = initial_core gev (rev G) n.
+  forall m (gev: Genv.t fundef type) G (vl: list (ident * globdef fundef type)),
+    list_norepet (map fst G) →
+    initial_core m gev G ⊣⊢ initial_core m gev (rev G).
 Proof.
   intros.
-     unfold initial_core;  apply rmap_ext.
-+   repeat rewrite level_make_rmap; auto.
-+   intro loc; repeat rewrite resource_at_make_rmap; unfold initial_core'.
-    if_tac; auto. case_eq (@Genv.invert_symbol (Ctypes.fundef function) type gev (@fst block Z loc)); intros; auto.
-    replace (find_id i G) with (find_id i (rev G)); auto.
-    clear - H SAME_IDS.
-    assert (list_norepet (map (@fst _ _) (rev G))).
-     eapply match_fdecs_norepet; eauto.
-   clear - H; induction vl; simpl in *; auto.
-   destruct a; destruct g; simpl in *; auto.
-   rewrite map_app in H. rewrite list_norepet_app in H.
-   destruct H as [? [? ?]]. constructor; auto.
-   simpl in H1.
-   apply list_disjoint_sym in H1.
-   pose proof (list_disjoint_notin i H1).
-   inv H0. spec H2. left; auto. contradict H2.
-   rewrite map_rev. rewrite <- in_rev.
-   clear - H2.
-   induction vl; simpl in *; auto. destruct a. destruct g.
-   destruct H2. simpl in *; left; auto. right; auto. right; auto. 
-   rewrite map_app, list_norepet_app in H.   destruct H as [? [? ?]]; auto. 
-    apply find_id_rev; auto.
-    rewrite <- list_norepet_rev, <- map_rev. auto.
-+ rewrite !ghost_of_make_rmap; auto.
+  rewrite /initial_world.initial_core.
+  apply big_sepL_proper; intros.
+  rewrite /funspec_of_loc /=.
+  destruct (Genv.invert_symbol _ _); last done.
+  rewrite find_id_rev //.
 Qed.
 
-Definition hackfun phi0 phi :=
-  level phi0 = level phi /\ ghost_of phi0 = ghost_of phi /\
-  forall loc, (identity (phi0 @ loc) <-> identity (phi @ loc)) /\
-                  (~identity (phi0 @ loc) -> (phi0 @ loc = phi @ loc)).
-
-Lemma alloc_Gfun_inflate:
-  forall n i f fs gv vl gev m0 m G0 G,
-   Genv.alloc_global gev m0 (i, Gfun f) = Some m ->
-   (forall phi : rmap,
-    hackfun (inflate_initial_mem m0 (initial_core gev (G0 ++ (i, fs) :: G) n))
-      phi ->
-  (globvars2pred gv vl) phi) ->
-  Genv.find_symbol gev i = Some (nextblock m0) ->
-  ~ In i (map fst vl) ->
-  forall phi : rmap,
-  hackfun (inflate_initial_mem m (initial_core gev (G0 ++ (i, fs) :: G) n)) phi ->
-      (globvars2pred gv vl) phi.
-Proof.
- intros.
- apply H0.
- destruct H3 as [H3' [Hg H3]]; split. rewrite inflate_initial_mem_level in H3'|-*; auto.
- split.
- { unfold inflate_initial_mem in *; rewrite ghost_of_make_rmap in *; auto. }
- intro loc; specialize (H3 loc).
- clear - H3 H2 H1 H.
- assert (exists fs', find_id i (G0 ++ (i,fs)::G) = Some fs').
- clear. induction G0; simpl. exists fs; rewrite if_true; eauto.
- destruct IHG0 as [fs' ?]. destruct a. if_tac. subst i0; exists f; auto.
- eauto.
- forget (G0++(i,fs)::G) as GG.  clear G0 fs G.
- destruct H0 as [fs H0].
- destruct H3.
- destruct (eq_dec loc (nextblock m0, 0)).
- subst loc.
- unfold inflate_initial_mem in *.
- rewrite resource_at_make_rmap in *.
- unfold inflate_initial_mem' in *.
- replace (access_at m0 (nextblock m0, 0) Cur) with (@None permission) in *.
- replace (access_at m (nextblock m0, 0) Cur) with (Some Nonempty) in *.
- unfold initial_core in *. rewrite resource_at_make_rmap in *.
- unfold initial_core' in *.
- simpl in *.
- rewrite (Genv.find_invert_symbol gev i H1) in H3,H4. rewrite H0 in *. destruct fs.
- rewrite <- H3.
- split.
- split; intro. apply PURE_identity. apply NO_identity. intro. contradiction H5.
- apply NO_identity.
- symmetry. clear - H.
-  unfold Genv.alloc_global in H.
-  revert H; case_eq (alloc m0 0 1); intros. unfold drop_perm in H0.
-  destruct (range_perm_dec m1 b 0 1 Cur Freeable); inv H0.
-  unfold access_at; simpl. apply alloc_result in H; subst b. rewrite PMap.gss.
- destruct (zle 0 0); try lia. destruct (zlt 0 1); try lia; simpl. auto.
- symmetry. apply nextblock_noaccess. simpl; unfold block, Plt; clear; lia.
- replace (inflate_initial_mem m0 (initial_core gev GG n) @ loc)
-   with (inflate_initial_mem m (initial_core gev GG n) @ loc); auto.
- clear - n0 H.
- unfold inflate_initial_mem; repeat rewrite resource_at_make_rmap.
- unfold inflate_initial_mem'.
- assert (H8: access_at m0 loc = access_at m loc); [ | rewrite H8; auto].
-  unfold Genv.alloc_global in H.
-  revert H; case_eq (alloc m0 0 1); intros. unfold drop_perm in H0.
-  destruct (range_perm_dec m1 b 0 1 Cur Freeable); inv H0.
-  unfold alloc; inv H. unfold access_at; simpl.
-  destruct loc as [b z]; simpl in *.
-  destruct (eq_dec b (nextblock m0)).
-  subst. repeat rewrite PMap.gss. assert (z<>0) by congruence.
-  destruct (zle 0 z). simpl. destruct (zlt z 1); try lia. simpl.
-  extensionality k.
-  apply nextblock_noaccess. unfold Plt; lia.
-   destruct (zlt z 1); try lia. simpl.
-  extensionality k.
-  apply nextblock_noaccess. unfold Plt; lia.
- rewrite PMap.gss. rewrite PMap.gso by auto. rewrite PMap.gso by auto. auto.
- case_eq (access_at m loc Cur); auto.
-  unfold Genv.alloc_global in H.
-  revert H; case_eq (alloc m0 0 1); intros. unfold drop_perm in H0.
-  destruct (range_perm_dec m1 b 0 1 Cur Freeable); inv H0.
-  unfold contents_at; simpl. unfold access_at in H1; simpl in H1.
-  destruct (eq_dec b (fst loc)). subst. rewrite PMap.gss in H1.
-  destruct (zle 0 (snd loc)); simpl in H1; auto.
-  destruct (zlt (snd loc) 1); simpl in H1; auto. assert (snd loc = 0) by lia.
-  destruct loc; apply alloc_result in H; simpl in *; congruence.
- clear r H8. inv H. simpl in *. rewrite H3 in *; rewrite PMap.gss in *.
-  destruct (zle 0 (snd loc)); try lia.
-  destruct (zlt (snd loc) 1); try lia. inv H1; auto.
-  clear H8 r. inv H. simpl in H1; rewrite <- H3 in H1; rewrite PMap.gss in H1.
-  destruct (zle 0 (snd loc)); try lia.
-  destruct (zlt (snd loc) 1); try lia. inv H1; auto.
-  rewrite PMap.gso in H1 by auto.
-  replace (PMap.get (fst loc) (mem_contents m1)) with (PMap.get (fst loc) (mem_contents m0)); auto.
-  inv H; simpl. rewrite PMap.gso; auto.
-Qed.
-
-Lemma resource_identity_dec:
- forall (r: resource), {identity r}+{~identity r}.
-Proof.
-intros. destruct r.
-destruct (eq_dec sh Share.bot).
-subst; left; apply NO_identity.
-right. intro. apply identity_NO in H.
-destruct H. inv H. contradiction n0; auto.
-destruct H as [? [? ?]]. inv H.
- right; apply YES_not_identity.
-left; apply PURE_identity.
-Qed.
-
-Lemma hackfun_sep:
- forall w1 w2 w w', hackfun w w' -> join w1 w2 w ->
-   exists w1', exists w2', join w1' w2' w' /\ hackfun w1 w1' /\ hackfun w2 w2'.
-Proof.
-intros.
- pose proof I.
- destruct (make_rmap (fun loc => if resource_identity_dec (w1 @ loc) then core (w' @ loc) else w1 @ loc) (ghost_of w1) (level w))  as [w1' [? ?]]; clear H1.
- extensionality loc.
- unfold compose. if_tac. rewrite core_resource_at.
- replace (level w) with (level w') by (destruct H; auto).
- rewrite <- level_core. apply resource_at_approx.
- replace (level w) with (level w1) by (apply join_level in H0; destruct H0; auto).
- apply resource_at_approx.
- destruct (join_level _ _ _ H0) as [<- _].
- apply ghost_of_approx.
- pose proof I.
- destruct (make_rmap (fun loc => if resource_identity_dec (w2 @ loc) then core (w' @ loc) else w2 @ loc) (ghost_of w2) (level w))  as [w2' [? ?]]; clear H1.
- extensionality loc.
- unfold compose. if_tac. rewrite core_resource_at.
- replace (level w) with (level w') by (destruct H; auto).
- rewrite <- level_core. apply resource_at_approx.
- replace (level w) with (level w2) by (apply join_level in H0; destruct H0; auto).
- apply resource_at_approx.
- destruct (join_level _ _ _ H0) as [_ <-]; apply ghost_of_approx.
- exists w1'; exists w2'; split3.
- apply resource_at_join2. destruct H; congruence. destruct H; congruence.
- intro loc; apply (resource_at_join _ _ _ loc) in H0. destruct H3 as [-> _], H5 as [-> _].
- destruct H. destruct H1 as [Hg H1], (H1 loc).
- if_tac. apply H6 in H0. rewrite H0.
- if_tac.  apply H3 in H7. apply identity_core in H7.
- rewrite <- H7 at 2. apply core_unit.
- rewrite H5 by auto. apply core_unit.
- spec H5. contradict H6; apply split_identity in H0; auto. rewrite <- H5.
- if_tac. apply join_comm in H0. apply H7 in H0. rewrite H0. apply join_comm; apply core_unit.
- auto.
- destruct H3 as [_ ->], H5 as [_ ->].
- destruct H as (? & <- & _).
- apply ghost_of_join; auto.
- destruct H; split. apply join_level in H0; destruct H0; congruence.
- destruct H3 as [H3 ->]; split; auto.
- intro loc. rewrite H3. clear - H1. if_tac. pose (core_identity (w' @ loc)). tauto.
- intuition.
- destruct H; split. apply join_level in H0; destruct H0; congruence.
- destruct H5 as [H5 ->]; split; auto.
- intro loc. rewrite H5. clear - H1. if_tac. pose (core_identity (w' @ loc)). tauto.
- tauto.
-Qed.
-
-Lemma init_datalist_hack:
-  forall b sh gv dl phi0 z,
-   (init_data_list2pred gv dl sh (Vptr b z)) phi0 ->
-  forall phi, 
-     hackfun phi0 phi ->
-   readable_share sh ->
-   (init_data_list2pred gv dl sh (Vptr b z)) phi.
-Proof.
-  induction dl; intros. destruct H0 as [H0' [Hg H0]]. simpl in *.
-  assert (emp phi); auto.
-  assert (emp phi0); auto.
-  rewrite emp_no in *.
-  intro loc; simpl; destruct (H0 loc) as [<- _].
-  apply H2.
-
-  rename H1 into H_READABLE.
- simpl init_data_list2pred in H|-*.
- destruct H as [w1 [w2 [? [? ?]]]].
- destruct (hackfun_sep _ _ _ _ H0 H) as [w1' [w2' [? [? ?]]]].
- exists w1'; exists w2'; split3; auto.
- 2: eapply IHdl; eauto.
- clear - H_READABLE H1 H4. destruct H4 as [H4' [Hg H4]].
-
-  unfold init_data2pred in *;
-  unfold mapsto, address_mapsto in *;
-  destruct a; simpl in *;
-  (destruct (readable_share_dec sh); [| tauto]);
-  try
-  (destruct H1 as [[H1' H1]|[H1x _]]; [|solve[inv H1x]];
-        left; split;
-    [ first [ apply I
-           | apply sign_ext_range'; compute; split; congruence
-           | apply zero_ext_range'; compute; split; congruence ]
-    | simpl in H1 |- *;
-      destruct H1 as [bl [? H8]]; exists bl; split; [assumption | ]; intro loc; specialize (H8 loc);
-      if_tac; [ destruct H8 as [p H8]; exists p; destruct (H4 loc) as [_ H5];
-                rewrite <- H5; [rewrite H8; auto| rewrite H8; apply YES_not_identity]
-              | destruct (H4 loc) as [HH _]; clear - H8 HH; tauto]]).
- rewrite address_mapsto_zeros_eq in H1|-*.
- rewrite Z_to_nat_max in *.
- split.  destruct H1; lia.
- destruct H1 as [H1' H1].
- intro loc; specialize (H1 loc).
- assert (H99:  Z.max (Z.max z0 0) 0 = Z.max z0 0).
-   apply Z.max_l. apply Zmax_bound_r. lia.
- rewrite H99 in *.
- hnf in H1|-*.
- if_tac; [destruct H1 as [p H1]; exists p; hnf in H1|-*; rewrite <- H4'; destruct (H4 loc) as [_ H5]
-          | destruct (H4 loc) as [HH _]; tauto].
- rewrite <- H5; auto. rewrite H1; apply YES_not_identity.
-
- pose (p := match gv i with Vptr _ _ => true | _ => false end).
- destruct p eqn:?.
-+
- destruct (gv i); subst p; try congruence.
- destruct H1 as [[H1' H1]|[H1' H1]];  [left|right]; split; auto.
- destruct H1 as [bl [? H8]].
- exists bl; split; [assumption | ]; intro loc; specialize (H8 loc).
- destruct (H4 loc).
- hnf in H8|-*; if_tac. destruct H8 as [p H8]; exists p; hnf in H8|-*.
-  rewrite <- H4'; rewrite <- H1; auto. rewrite H8; apply YES_not_identity.
- tauto.
- destruct H1 as [bl [? H8]].
- exists bl,x. destruct H8 as [H8' H8].
- split; [assumption | ]; intro loc; specialize (H8 loc).
- destruct (H4 loc).
- hnf in H8|-*; if_tac. destruct H8 as [p H8]; exists p; hnf in H8|-*.
-  rewrite <- H4'. rewrite <- H0. rewrite H8. reflexivity.
- rewrite H8.
- apply YES_not_identity.
- tauto.
- +
- assert (mapsto_ sh (Tpointer Tvoid noattr)  (Vptr b z) w1)
-  by (destruct (gv i); subst p; inv Heqb0; auto).
- assert (mapsto_ sh (Tpointer Tvoid noattr) (Vptr b z) w1'). {
- clear p Heqb0.
- clear H1; rename H into H1.
- unfold mapsto_ in *.
- unfold mapsto in *.
-  simpl in *.
- rewrite if_true in H1|-* by auto.
- destruct H1. destruct H. contradiction. destruct H as [ _ ?].
- right. split. hnf; auto.
- destruct H as [v2' ?]; exists v2'.
- destruct H as [x ?]; exists x.
- destruct H; split; auto.
- intros loc; specialize (H0 loc).
- destruct (H4 loc).
- rename H0 into H8.
- hnf in H8|-*; if_tac. destruct H8 as [p H8]; exists p; hnf in H8|-*.
-  rewrite <- H4'; rewrite <- H2; auto. rewrite H8; apply YES_not_identity.
- tauto.
- }
- destruct (gv i); subst p; try congruence; auto.
-Qed.
-
-Lemma another_hackfun_lemma:
- forall n i v gev m G phi m0,
-    hackfun (inflate_initial_mem m (initial_core gev G n)) phi ->
-    Genv.alloc_global gev m0 (i, Gvar v) = Some m ->
-    hackfun (inflate_initial_mem m0 (initial_core gev G n))
-      (upto_block (nextblock m0) phi).
-Proof.
- intros. destruct H; split.
- rewrite inflate_initial_mem_level in H|-*.
- unfold upto_block. rewrite level_only_blocks. auto.
- clear H; rename H1 into H.
- destruct H as [Hg H]; split.
- { unfold upto_block, only_blocks, inflate_initial_mem in *; rewrite !ghost_of_make_rmap in *; auto. }
- intro loc; specialize (H loc).
- destruct (plt (fst loc) (nextblock m0)).
- unfold upto_block. rewrite only_blocks_at. rewrite if_true by auto.
- replace (inflate_initial_mem m0 (initial_core gev G n) @ loc)
-   with (inflate_initial_mem m (initial_core gev G n) @ loc); auto.
-  rename p into z.
- clear - z H0.
- unfold inflate_initial_mem; repeat rewrite resource_at_make_rmap.
- unfold inflate_initial_mem'.
- destruct (alloc_global_old _ _ _ _ H0 _ z) as [? ?]. rewrite H; rewrite H1; auto.
- unfold upto_block. rewrite only_blocks_at. rewrite if_false by auto.
- unfold inflate_initial_mem; repeat rewrite resource_at_make_rmap;
-   unfold inflate_initial_mem'.
- replace (access_at m0 loc Cur) with (@None permission).
- clear.
- pose proof (core_identity (phi @ loc)).
- assert (identity (NO Share.bot bot_unreadable)) by apply NO_identity.
- tauto.
- symmetry; apply nextblock_noaccess. auto.
-Qed.
-
-Lemma hackfun_beyond_block:
-  forall b w w', hackfun w w' -> hackfun (beyond_block b w) (beyond_block b w').
+Lemma inflate_initial_mem_rev:
+  forall m bounds (gev: Genv.t fundef type) G (vl: list (ident * globdef fundef type))
+    (H: list_norepet (map fst (rev vl)))
+    (SAME_IDS : match_fdecs (prog_funct' vl) (rev G)),
+    inflate_initial_mem m bounds gev G ⊣⊢ inflate_initial_mem m bounds gev (rev G).
 Proof.
- intros. destruct H.
- split. unfold beyond_block. repeat rewrite level_only_blocks. auto.
- clear H. destruct H0 as [Hg H0]; split.
- { unfold beyond_block, only_blocks; rewrite !ghost_of_make_rmap; auto. }
- intro loc; specialize (H0 loc).
- unfold beyond_block. repeat  rewrite only_blocks_at. if_tac. auto.
- clear. pose proof (core_identity (w @ loc)); pose proof (core_identity (w' @ loc)); tauto.
+  intros.
+  rewrite /inflate_initial_mem.
+  apply big_sepL_proper; intros.
+  destruct (bounds _).
+  apply big_sepL_proper; intros.
+  rewrite /inflate_loc.
+  destruct (access_at _ _ _); last done.
+  destruct p; try done.
+  rewrite /funspec_of_loc.
+  if_tac; try done.
+  destruct (Genv.invert_symbol _ _) eqn: Hb; last done.
+  rewrite find_id_rev //.
+  { rewrite -list_norepet_rev -map_rev -match_fdecs_norepet //.
+    apply list_norepet_prog_funct'.
+    rewrite -list_norepet_rev -map_rev //. }
 Qed.
 
 Lemma Pos_to_nat_eq_S:
@@ -1800,150 +1157,31 @@ Lemma Pos_to_nat_eq_S:
 Proof. intros. simpl; pose proof (Pos2Nat.is_pos b); lia.
 Qed.
 
-
-Lemma alloc_global_inflate_initial_eq:
-  forall gev m0 i f m G n loc,
-      Genv.alloc_global gev m0 (i, Gfun f) = Some m ->
-   ~ identity (inflate_initial_mem m0 (initial_core gev G n) @ loc) ->
-     inflate_initial_mem m0 (initial_core gev G n) @ loc =
-      inflate_initial_mem m (initial_core gev G n) @ loc.
-Proof.
-intros. rename H0 into H9.
-unfold inflate_initial_mem. simpl. rewrite !resource_at_make_rmap.
-unfold inflate_initial_mem'.
-destruct loc.
-destruct (plt b (nextblock m0)).
-*
-destruct (alloc_global_old gev _ _ _ H (b,z) p) as [? ?].
-rewrite H0,H1. auto.
-*
-contradiction H9; clear H9.
-unfold inflate_initial_mem. simpl. rewrite !resource_at_make_rmap.
-unfold inflate_initial_mem'.
-unfold access_at; rewrite nextblock_noaccess.
-apply NO_identity.
-apply n0.
-Qed.
-
-Lemma alloc_global_identity_lemma3:
-   forall gev m0 i f m G n loc,
-    Genv.alloc_global gev m0 (i, Gfun f) = Some m ->
-    identity (inflate_initial_mem m (initial_core gev G n) @ loc) ->
-    identity (inflate_initial_mem m0 (initial_core gev G n) @ loc).
-Proof.
-intros until 1.
-unfold inflate_initial_mem. simpl. rewrite !resource_at_make_rmap.
-unfold inflate_initial_mem'.
- intros.
-  destruct (adr_range_dec (nextblock m0, 0) 1 loc).
-  destruct loc; destruct a. subst b. assert (z=0) by lia. subst z.
-  unfold access_at; rewrite nextblock_noaccess. apply NO_identity.
-  simpl. apply Plt_strict.
-  destruct (plt (fst loc) (nextblock m0)).
-  destruct (alloc_global_old _ _ _ _ H _ p) as [? ?].
-  rewrite H1,H2. auto.
-  unfold access_at. rewrite nextblock_noaccess by auto.
-  apply NO_identity.
-Qed.
-
-Lemma identity_inflate_at_Gfun:
-  forall n i f gev m G0 G loc m0,
- list_norepet (map fst (G0 ++ G)) ->
- Genv.find_symbol gev i = Some (nextblock m0) ->
- Genv.alloc_global gev m0 (i, Gfun f) = Some m ->
- In i (map fst G) ->
- (identity (inflate_initial_mem m0 (initial_core gev (G0 ++ G) n) @ loc) <->
- identity (inflate_initial_mem m (initial_core gev (G0 ++ G) n) @ loc)).
-Proof.
-intros until m0. intros NR H8 ? ?.
-destruct (eq_dec loc (nextblock m0, 0)).
-*
-subst loc.
-unfold initial_core.
-unfold inflate_initial_mem.
-rewrite !resource_at_make_rmap.
-unfold inflate_initial_mem'.
-rewrite !resource_at_make_rmap.
-rewrite nextblock_access_empty
-  by (apply Pos2Nat.inj_ge; lia).
-split; intros _; [ |apply NO_identity].
-unfold Genv.alloc_global in H.
-destruct (alloc m0 0 1) eqn:?.
-assert (H9: 0 <= 0 < 1) by (clear; lia).
-assert (H6 := alloc_result _ _ _ _ _ Heqp); subst b.
-assert (H1 := perm_drop_1 _ _ _ _ _ _ H 0 Cur H9).
-destruct (perm_mem_access _ _ _ _ H1) as [p [H4 H5]].
-assert (H2 := perm_drop_2 _ _ _ _ _ _ H 0 Cur p H9).
-rewrite H5.
-unfold perm in *.
-unfold access_at in H5. simpl in H5. destruct ((mem_access m) !! (nextblock m0) 0 Cur); inv H5.
-spec H2; [constructor | ].
-destruct p; try solve [inv H2].
-unfold initial_core'. simpl.
-rewrite Genv.find_invert_symbol with (id:=i) by auto.
-destruct (list_in_map_inv _ _ _ H0) as [[i' fd] [H10 H11]]; simpl in H10, H11.
-subst i'.
-rewrite find_id_i with (fs:=fd); auto.
-destruct fd.
-apply PURE_identity.
-apply in_app. right; auto.
-*
-clear NR.
-unfold initial_core.
-unfold inflate_initial_mem.
-rewrite !resource_at_make_rmap.
-unfold inflate_initial_mem'.
-rewrite !resource_at_make_rmap.
-pose proof (Pos.ltb_spec (fst loc) (nextblock m0)).
-destruct ((fst loc <? nextblock m0)%positive); inv H1.
-destruct (alloc_global_old _ _ _ _ H loc H2) as [? ?].
-rewrite H3.
-rewrite H1; split; intro; auto.
-destruct loc as [b ofs]. simpl fst in *; simpl snd in *.
-rewrite (nextblock_access_empty m0) by (apply Pos.le_ge; auto).
-split; intros _; [ |apply NO_identity].
-replace (access_at m (b,ofs) Cur) with (@None permission).
-apply NO_identity.
-symmetry.
-unfold Genv.alloc_global in H.
-destruct (alloc m0 0 1) eqn:?.
-assert (H6 := alloc_result _ _ _ _ _ Heqp); subst b0.
-clear - n0 H2 Heqp H.
-assert (b <> nextblock m0 \/ ofs <> 0). {
-  destruct (eq_block b (nextblock m0)). subst. right. congruence. left; auto.
-}
-rewrite <- (access_drop_3 _ _ _ _ _ _ H) by (destruct H0; auto; right; lia).
-rewrite <- (alloc_access_other _ _ _ _ _ Heqp)by (destruct H0; auto; right; lia).
-apply nextblock_access_empty. zify; lia.
-Qed.
-
 Lemma global_initializers:
-  forall (prog: program) G m n,
-     list_norepet (prog_defs_names prog) ->
-     all_initializers_aligned prog ->
-    match_fdecs (prog_funct prog) G ->
-    Genv.init_mem prog = Some m ->
-     app_pred (globvars2pred (genviron2globals (filter_genv (globalenv prog)))
-                                         (prog_vars prog))
-  (inflate_initial_mem m (initial_core (Genv.globalenv prog) G n)).
+  forall (prog: program) G m
+     (Hnorepet : list_norepet (prog_defs_names prog))
+     (AL : all_initializers_aligned prog)
+     (SAME_IDS : match_fdecs (prog_funct prog) G)
+     (Hinit : Genv.init_mem prog = Some m),
+    inflate_initial_mem m (block_bounds prog) (globalenv prog) G ⊢
+    globvars2pred (genviron2globals (filter_genv (globalenv prog))) (prog_vars prog).
 Proof.
-  intros until n. intros ? AL SAME_IDS ?.
- set (gp := globalenv prog).
+  intros.
+  set (gp := globalenv prog).
   unfold all_initializers_aligned in AL.
-  unfold Genv.init_mem in H0.
+  unfold Genv.init_mem in Hinit.
   unfold globalenv, Genv.globalenv in *.
   unfold prog_vars, prog_funct in *.
   change (prog_defs prog) with (AST.prog_defs prog) in AL, SAME_IDS |- *.
   destruct (program_of_program prog) as [fl prog_pub main].
   forget (prog_comp_env prog) as cenv.
   clear prog.
-  simpl in *|-. simpl prog_vars'. simpl initial_core.
-  match goal with |- context [initial_core ?A] =>
-     remember A as gev end.
+  simpl in * |-. simpl prog_vars'. simpl initial_core.
+  remember (Genv.add_globals _ fl) as gev.
   rewrite <- (rev_involutive fl) in *.
-  rewrite alloc_globals_rev_eq in H0.
-  forget (rev fl) as vl'. clear fl; rename vl' into vl.
-  unfold prog_defs_names in H. simpl in  H.
+  rewrite alloc_globals_rev_eq in Hinit.
+  forget (rev fl) as vl.
+  unfold prog_defs_names in Hnorepet. simpl in Hnorepet.
 
   rewrite <- rev_prog_vars' in AL|-*.
   rewrite <- rev_prog_funct' in SAME_IDS.
@@ -1951,241 +1189,140 @@ Proof.
   rewrite forallb_rev in AL.
   rewrite <- (rev_involutive G) in  SAME_IDS.
   rewrite match_fdecs_rev in SAME_IDS.
-  2:{
-    apply list_norepet_prog_funct'.
-    rewrite <- list_norepet_rev, <- map_rev; auto.
-  }
-  rewrite initial_core_rev with (vl:=vl) by auto.
-  rewrite map_rev in H. rewrite list_norepet_rev in H.
+  2:{ apply list_norepet_prog_funct'.
+      rewrite <- list_norepet_rev, <- map_rev; auto. }
+  rewrite -> inflate_initial_mem_rev with (vl:=vl) by auto.
+  rewrite map_rev in Hnorepet. rewrite list_norepet_rev in Hnorepet.
   forget (rev G) as G'; clear G; rename G' into G.
-  rename H into H2.
-  assert (H :=add_globals_hack _ _ prog_pub H2 Heqgev).
+  assert (Hsymb := add_globals_hack _ _ prog_pub Hnorepet Heqgev).
   assert (H1: forall j, In j (map (@fst _ _) G) -> ~ In j (map (@fst _ _) (prog_vars' vl))). {
     intros.
-    pose proof (match_fdecs_in j _ _ H1 SAME_IDS).
-    clear - H3 H2.
+    pose proof (match_fdecs_in j _ _ H SAME_IDS) as Hin'.
+    clear - Hnorepet Hin'.
     intro.
     induction vl. inv H.
-    inv H2. specialize (IHvl H5).
+    inv Hnorepet. specialize (IHvl H3).
     destruct a as [i [a|a]]; simpl in *.
-    destruct H3. subst j.
-    clear - H H4.
-    apply H4; clear H4. induction vl; simpl in *; auto.
-    destruct a as [i' [a|a]]; auto .
-    destruct H. simpl in *; subst; auto.
-    right; auto.
-    apply IHvl; auto.
-    destruct H; subst.
-    apply H4; clear - H3. induction vl; simpl in *; auto.
-    destruct a as [i' [a|a]]; auto .
-    destruct H3. simpl in *; subst; auto.
-    right; auto.
-    apply IHvl; auto.
+    destruct Hin'.
+    * subst j.
+      clear - H H2.
+      apply H2; clear H2. induction vl; simpl in *; auto.
+      destruct a as [i' [a|a]]; auto.
+      destruct H; auto.
+    * apply IHvl; auto.
+    * destruct H; subst.
+      apply H2; clear - Hin'. induction vl; simpl in *; auto.
+      destruct a as [i' [a|a]]; auto .
+      destruct Hin'; auto.
+      apply IHvl; auto.
   }
   assert (H1': forall j, In j (map fst (prog_funct' vl)) -> In j (map fst G)). {
-   clear - SAME_IDS.
-   forget (prog_funct' vl) as fs. intro.
-   induction SAME_IDS. auto. simpl. tauto.
+    clear - SAME_IDS.
+    forget (prog_funct' vl) as fs. intro.
+    induction SAME_IDS. auto. simpl. tauto.
   }
   assert (NRG: list_norepet (map fst G)). {
-     clear - SAME_IDS H2.
-     eapply match_fdecs_norepet; eauto.
-     apply list_norepet_prog_funct'; auto.
+    clear - SAME_IDS Hnorepet.
+    eapply match_fdecs_norepet; eauto.
+    apply list_norepet_prog_funct'; auto.
   }
   clear SAME_IDS Heqgev.
-  change (map fst vl) with (map fst (@nil (ident*funspec)) ++ map fst vl) in H2.
+  change (map fst vl) with (map fst (@nil (ident*funspec)) ++ map fst vl) in Hnorepet.
   change G with (nil++G).
   set (G0 := @nil (ident*funspec)) in *.
   change G with (G0++G) in NRG.
   clearbody G0.
-  move H2 after H. move H1 after H.
 
-  assert (H3: forall phi, hackfun (inflate_initial_mem m (initial_core gev (G0++G) n)) phi ->
-           (globvars2pred (genviron2globals  (filter_genv gp))
-                         (prog_vars' vl)) phi).
-  2:{
+  revert Hsymb m G0 G NRG Hnorepet Hinit H1 H1'; induction vl; intros; simpl.
+  { inv Hinit.
+    rewrite /globvars2pred /=.
+    by iIntros "_". }
+  simpl in Hinit.
+  revert Hinit; case_eq (alloc_globals_rev gev Mem.empty vl); intros; try congruence.
+  spec IHvl. { clear - AL. simpl in AL. destruct a. destruct g; auto. simpl in AL.
+    apply andb_true_iff in AL; destruct AL; auto. }
+  spec IHvl. { intros.
+    assert (H4': (Pos.to_nat b <= length vl)%nat). {
+    clear - H0. rewrite Zlength_correct in H0. lia. }
+    fold fundef in *.
+    assert (POS := Pos2Z.is_pos b).
+    rewrite Hsymb.
+    rewrite Pos_to_nat_eq_S /=.
+    replace (length vl - (Z.to_nat (Z.pos b) - 1))%nat with (S (length vl - S (Z.to_nat (Z.pos b) - 1)))%nat
+      by (simpl; pose proof (Pos2Nat.is_pos b); lia).
     simpl.
-    apply H3. clear.
-    split. auto.
-    split; auto.
-    intro loc. tauto.
+    apply iff_refl.
+    rewrite Zlength_cons. lia.
   }
-  intros. rename H3 into HACK; revert phi HACK.
-                     (* The purpose of going through hackfun is doing this induction. *)
-  revert H m G0 G NRG H2 H0 H1 H1'; induction vl; intros.
-  + setoid_rewrite emp_no.
-    intro l. do 2 apply proj2 in HACK; specialize (HACK l).
-    unfold inflate_initial_mem in HACK|-*.
-    rewrite resource_at_make_rmap in *.
-    unfold inflate_initial_mem' in HACK|-*.
-    inversion H0; clear H0; subst m.
-    unfold access_at, empty in HACK; simpl in HACK.  
-      destruct HACK as [HACK _]. rewrite <- HACK. apply NO_identity.
-  + simpl in H0.
-    revert H0; case_eq (alloc_globals_rev gev empty vl); intros; try congruence.
-    spec IHvl. clear - AL. simpl in AL. destruct a. destruct g; auto. simpl in AL.
-      apply andb_true_iff in AL; destruct AL; auto.
-     spec IHvl; [ intros | ].
-    assert (H4': (Pos.to_nat b <= length vl)%nat). {
-    clear - H4. rewrite Zlength_correct in H4.
-      rewrite <- Z2Nat.inj_pos.
-       rewrite <- Nat2Z.id .
-       apply Z2Nat.inj_le. specialize (Pos2Z.is_pos b). lia.
-       lia.
-       lia.
-     }
- fold fundef in *.
- assert (POS := Pos2Z.is_pos b). {
- rewrite H.
- rewrite Pos_to_nat_eq_S.
- replace (length vl - (Z.to_nat (Z.pos b) - 1))%nat with (S (length vl - S (Z.to_nat (Z.pos b) - 1)))%nat
-  by (simpl;  pose proof (Pos2Nat.is_pos b); lia).
- simpl.
-  replace (Datatypes.length vl - (Pos.to_nat b - 1))%nat with
-             (S (Datatypes.length vl - S (Pos.to_nat b - 1)))%nat.
- apply iff_refl.
- clear - H4'; pose proof (Pos2Nat.is_pos b); lia.
- rewrite Zlength_cons. lia.
- }
- destruct a.
- assert (FS: Genv.find_symbol gev i = Some (nextblock m0)).
-  assert (Genv.find_symbol gev i = Some (nextblock m0)).
-    apply H. apply alloc_globals_rev_nextblock in H0. rewrite H0 .
-      rewrite Zlength_cons.
- rewrite Z2Pos.id.
- rewrite Zlength_correct. lia.
- rewrite Zlength_correct. lia.
- simpl.
-   apply alloc_globals_rev_nextblock in H0. rewrite H0 .
-  replace (Pos.to_nat (Z.to_pos (Z.succ (Zlength vl))))
-    with (S (length vl)).
-2:{
-rewrite Pos_to_nat_eq_S.
- rewrite Zlength_correct.
-  rewrite Z2Pos.id by lia.
- rewrite Z2Nat.inj_succ by lia.
- rewrite Nat2Z.id. lia.
-}
- rewrite Nat.sub_diag. reflexivity.
-  auto.
+  destruct a.
+  assert (FS: Genv.find_symbol gev i = Some (nextblock m0)).
+  { assert (Genv.find_symbol gev i = Some (nextblock m0)); auto.
+    apply Hsymb. apply alloc_globals_rev_nextblock in H. rewrite H.
+    rewrite Zlength_cons.
+    rewrite Z2Pos.id.
+    rewrite Zlength_correct. lia.
+    rewrite Zlength_correct. lia.
+    simpl.
+    apply alloc_globals_rev_nextblock in H. rewrite H.
+    replace (Pos.to_nat (Z.to_pos (Z.succ (Zlength vl))))
+      with (S (length vl)) by (rewrite Pos_to_nat_eq_S Zlength_correct; lia).
+    rewrite Nat.sub_diag. reflexivity. }
+  specialize (IHvl m0 G0 G NRG).
+  spec IHvl.
+  { clear - Hnorepet. apply list_norepet_app in Hnorepet as [? [? ?]].
+    inv H0.
+    apply list_norepet_app; split3; auto.
+    apply list_disjoint_cons_right in H1; auto. }
+  specialize (IHvl H).
+  spec IHvl.
+  { intros ? Hin%H1 ?; contradiction Hin; destruct g; simpl; auto. }
+  spec IHvl.
+  { intros; apply H1'; destruct g; simpl; auto. }
   destruct g.
 * (* Gfun case *)
   simpl.
-  specialize (IHvl m0 G0 G).
-  apply IHvl; auto.
- - clear - H2. apply list_norepet_app in H2. destruct H2 as [? [? ?]].
-    inv H0.
-    apply list_norepet_app; split3; auto.
-    apply list_disjoint_cons_right in H1; auto.
- - clear - H1'; intros; apply H1'. right; auto.
- -
-  clear - NRG H2 FS HACK H3 H1'.
-  specialize (H1' i). simpl in H1'. spec H1'; [auto | ].
-  destruct HACK as [? ? ].
-  split. rewrite <- H.
-  unfold inflate_initial_mem. repeat rewrite level_make_rmap. auto.
-  destruct H0 as [Hg H0]; split.
-  unfold inflate_initial_mem in *; rewrite ghost_of_make_rmap in *; auto.
-  intro; specialize (H0 loc).
-  destruct H0.
-  clear - NRG H2 FS H0 H1 H3 H1'.
-  split.
-  rewrite <- H0.
-  clear - NRG H2 FS H3 H1'.
-  apply (identity_inflate_at_Gfun n i f); auto.
-  intro.
-  rewrite <- H1.
-  eapply alloc_global_inflate_initial_eq; eauto.
-  clear - H3 H.
-  contradict H.
-  eapply alloc_global_identity_lemma3; eauto.
+  iIntros "Hmem"; iApply IHvl.
+  simpl in Hinit.
+  destruct (alloc m0 0 1) eqn: Halloc.
+  rewrite /inflate_initial_mem.
+  erewrite nextblock_drop, nextblock_alloc by eassumption.
+  replace (Pos.to_nat (Pos.succ _) - 1)%nat with (S (Pos.to_nat (nextblock m0) - 1))%nat by lia.
+  rewrite seq_S big_sepL_app /= -Nat.sub_succ_l /=; last lia.
+  iDestruct "Hmem" as "(Hmem & Hnew & _)"; iPoseProof (affine with "Hnew") as "_".
+  { destruct (block_bounds _).
+    apply big_sepL_affine; intros.
+    rewrite /inflate_loc.
+    rewrite Nat.sub_0_r Pos2Nat.id.
+    erewrite drop_perm_access by eassumption.
+    if_tac; first by destruct (funspec_of_loc _ _ _); apply _.
+    eapply alloc_dry_unchanged_on in H2 as [Ha _]; last done.
+    rewrite -Ha nextblock_access_empty //; last lia.
+    apply _. }
+  iApply (big_sepL_mono with "Hmem").
+  intros ?? (-> & ?)%lookup_seq.
+  rewrite /block_bounds /=.
+  apply alloc_globals_rev_nextblock in H.
+  rewrite globals_bounds_app1; last by rewrite Zlength_correct in H; rewrite rev_length; lia.
+  destruct (globals_bounds _ _ _); apply big_sepL_mono; intros.
+  rewrite /inflate_loc.
+  pose proof (alloc_result _ _ _ _ _ Halloc) as ->.
+  assert (Pos.of_nat (S k) ≠ nextblock m0) by lia.
+  erewrite <- access_drop_3; [| eassumption | auto].
+  erewrite <- alloc_access_other; [| eassumption | auto].
+  erewrite <- drop_perm_contents by eassumption.
+  rewrite /contents_at; erewrite mem_lemmas.AllocContentsOther1; done.
 * (* Gvar case *)
-  specialize (IHvl m0 G0 G NRG).
-  spec IHvl. { clear - H2. apply list_norepet_app.  apply list_norepet_app in H2.
-      destruct H2 as [? [? ?]].  inv H0.  split3; auto. simpl in H1.
-    apply list_disjoint_cons_right in H1; auto.
-  }
-  specialize (IHvl H0).
- spec IHvl. intros. clear - H1 H4. specialize (H1 _ H4). contradict H1.
-  right; auto.
-  assert (FI: find_id i (G0++G) = None). {
-  change (list_norepet (map fst G0 ++ (i::nil) ++ (map fst vl))) in H2.
-  apply list_norepet_append_commut in H2. rewrite <- app_assoc in H2.
- inv H2. specialize (H1 i).
- case_eq (find_id i (G0++G)); intros; auto. apply find_id_e in H2.
- contradiction H6. apply in_app. apply in_app_or in H2.
- destruct H2; [right|left].  change i with (fst (i,f)); apply in_map; auto.
- contradiction H1. apply in_map_fst in H2. auto.
- left; auto.
- }
-  simpl map.  simpl fold_right.
-  assert (identity (ghost_of phi)) as Hg.
-  { destruct HACK as (? & <- & _).
-    unfold inflate_initial_mem, initial_core; rewrite !ghost_of_make_rmap.
-    apply ghost_identity; auto. }
-  pose proof (join_comm (join_upto_beyond_block (nextblock m0) phi Hg)).
-  do 2 econstructor; split3; [ eassumption | |].
-  unfold globvar2pred.
-  unfold globals_of_env.
-  unfold filter_genv, Map.get. simpl @fst; simpl @snd.
-  assert (JJ:= alloc_global_inflate_same n i v _ _ (G0++G) _ H3).
- spec JJ.
- intro. unfold initial_core. rewrite resource_at_make_rmap. unfold initial_core'.
-  simpl. if_tac; auto.
- rewrite Genv.find_invert_symbol with (id:=i); auto. rewrite FI; auto.
- simpl genv_genv.
- fold fundef in *.  unfold genviron2globals, Map.get. simpl.
- rewrite FS.
- assert (H99: exists t, match type_of_global {| genv_genv := gev; genv_cenv := cenv |} (nextblock m0) with
-  | Some t => Some (Vptr (nextblock m0) Ptrofs.zero, t)
-  | None => Some (Vptr (nextblock m0) Ptrofs.zero, Tvoid)
-  end = Some (Vptr (nextblock m0) Ptrofs.zero, t)) by (destruct (type_of_global {| genv_genv := gev; genv_cenv := cenv |} (nextblock m0)); eauto).
- case_eq (gvar_volatile v); intros; auto. rename H5 into H10.
-  hnf; auto.
-
-  unfold Genv.alloc_global in H3.
-  revert H3; case_eq (alloc m0 0 (init_data_list_size (gvar_init v))); intros.
-  invSome. invSome.
-  assert (H90: Z.pos (nextblock m0) -1 = Zlength vl).
-    clear - H0 H3.
-
-  apply alloc_globals_rev_nextblock in H0. apply alloc_result in H3.
-  subst.  rewrite H0.
-  rewrite Zlength_correct.
-  rewrite Z2Pos.id by lia. lia.
- destruct (H i (nextblock m0)) as [_ ?].
-  rewrite Zlength_cons. rewrite H90.
-  split; try solve [unfold Plt in *; lia].
-  spec H6. 
-  simpl length.
-  replace (Pos.to_nat (nextblock m0)) with (S (length vl)).
-  rewrite Nat.sub_diag. reflexivity.
-  clear - H90. rewrite Zlength_correct in H90. apply inj_eq_rev.
-  rewrite inj_S. rewrite <- H90. clear.
-  rewrite Pos_to_nat_eq_S.
-  replace (Z.succ (Z.pos (nextblock m0) - 1)) with (Z.pos (nextblock m0)) by lia.
-  replace (S (Z.to_nat (Z.pos (nextblock m0)) - 1))
-    with (Z.to_nat (Z.pos (nextblock m0)))
-  by (rewrite Z2Nat.inj_pos; pose proof (Pos2Nat.is_pos (nextblock m0)); lia).
- rewrite Z2Nat.id by (pose proof (Pos2Z.is_pos (nextblock m0)); lia).
- auto.
-
-pose proof (init_data_list_lem {| genv_genv := gev; genv_cenv := cenv |} m0 v m1 b m2 m3 m (initial_core gev (G0 ++ G) n)
-     H3 H5 H8 H9) .
- spec H7.
- clear - AL. simpl in AL. apply andb_true_iff in AL; destruct AL; auto.
- apply andb_true_iff in H. destruct H. apply Zlt_is_lt_bool; auto.
- specialize (H7 H10).
- spec H7.
- clear - AL. simpl in AL. apply andb_true_iff in AL; destruct AL; auto.
- apply andb_true_iff in H. destruct H; auto.
- eapply init_datalist_hack; eauto.
-  apply alloc_result in H3; subst b.
-  eassumption.
- apply hackfun_beyond_block; auto.
- apply readable_readonly2share.
- apply IHvl; auto.
- eapply another_hackfun_lemma; eauto.
+  rewrite /globvars2pred /globvar2pred /=.
+  simpl in Hinit.
+  destruct (alloc m0 0) eqn: Halloc.
+  destruct (store_zeros m1 b 0 _) eqn: Hstore; last done.
+  destruct (Genv.store_init_data_list _ _ _ _ _) eqn: Hinit_data; last done.
+  rewrite /= !andb_true_iff in AL; destruct AL as ((? & ?%Z.ltb_lt) & ?).
+  rewrite (init_data_list_lem gp) //.
+  rewrite IHvl; iIntros "($ & ?)".
+  rewrite /genviron2globals /Map.get /filter_genv FS.
+  apply alloc_result in Halloc as ->; done.
+  { rewrite Zlength_rev; eapply alloc_globals_rev_nextblock; eauto. }
 Qed.
 
 Definition globals_of_genv (g : genviron) (i : ident):=
@@ -2194,3 +1331,4 @@ Definition globals_of_genv (g : genviron) (i : ident):=
 | None => Vundef
 end.
 
+End mpred.
diff --git a/veric/invariants.v b/veric/invariants.v
deleted file mode 100644
index 314eeb5dea..0000000000
--- a/veric/invariants.v
+++ /dev/null
@@ -1,1419 +0,0 @@
-From VST.msl Require Import ghost ghost_seplog sepalg_generators sepalg.
-From VST.veric Require Import compcert_rmaps shares own mpred ghosts.
-Require Import VST.zlist.sublist.
-Import List ListNotations.
-
-Section Invariants.
-
-#[global] Program Instance unit_PCM : Ghost := { valid a := True; Join_G a b c := True }.
-Next Obligation.
-  apply fsep_sep, _.
-Defined.
-
-Definition pred_of (P : mpred) := SomeP rmaps.Mpred (fun _ => P).
-
-Definition agree g (P : mpred) : mpred := own(RA := unit_PCM) g tt (pred_of P).
-
-Lemma agree_dup : forall g P, (agree g P = agree g P * agree g P)%pred.
-Proof.
-  intros; apply ghost_op; constructor.
-Qed.
-
-Lemma agree_join : forall g P1 P2, agree g P1 * agree g P2 |-- (|> P1 -* |> P2) * agree g P1.
-Proof.
-  intros.
-  intros ? (? & ? & ? & H1 & H2).
-  do 3 eexists; [apply id_core_unit|].
-  pose proof (ghost_of_join _ _ _ H) as J.
-  change (agree g P1) with (own.own(RA := unit_PCM) g tt (pred_of P1)) in H1.
-  destruct H1 as (? & Hid & ? & H1).
-  change (agree g P2) with (own.own(RA := unit_PCM) g tt (pred_of P2)) in H2.
-  destruct H2 as (? & ? & ? & H2).
-  rewrite ghost_fmap_singleton in H1, H2.
-  destruct (join_assoc (join_comm H1) J) as (? & J1 & ?).
-  destruct (join_assoc (join_comm H2) (join_comm J1)) as (? & J2 & ?).
-  apply singleton_join_inv in J2 as ([] & J2 & ?); subst.
-  inv J2; simpl in *.
-  destruct H6 as [Heq1 ?].
-  apply SomeP_inj in Heq1.
-  destruct (join_level _ _ _ H) as [Hl1 Hl2]; erewrite Hl1, Hl2 in *.
-  assert (approx (level a) P1 = approx (level a) P2) as Heq.
-  { apply (@equal_f _ _ (fun _ : list Type => approx (level a) P1) (fun _ : list Type => approx (level a) P2));
-      auto.
-    apply nil. }
-  clear J.
-  split.
-  - intros ??? Hl J HP1 ? Ha'.
-    pose proof (id_core_level a).
-    pose proof (necR_level _ _ Hl).
-    apply nec_identity in Hl; [|apply id_core_identity].
-    destruct (join_level _ _ _ J).
-    apply Hl in J; subst.
-    specialize (HP1 _ Ha').
-    apply laterR_level in Ha'.
-    assert ((approx (level a) P1) a') as HP1'.
-    { split; auto; lia. }
-    rewrite Heq in HP1'; destruct HP1'; auto.
-  - exists I; split.
-    + intro l; simpl.
-      apply (resource_at_join _ _ _ l) in H.
-      apply Hid in H as <-; auto.
-    + rewrite ghost_fmap_singleton; simpl.
-      eapply join_sub_trans; [|eexists; apply join_comm; eauto].
-      eexists; eauto.
-      replace _ with I in J1 by (apply proof_irr); eauto.
-Qed.
-
-Lemma agree_join2 : forall g P1 P2, agree g P1 * agree g P2 |-- (|> P1 -* |> P2) * agree g P2.
-Proof.
-  intros.
-  intros ? (? & ? & ? & H1 & H2).
-  do 3 eexists; [apply id_core_unit|].
-  pose proof (ghost_of_join _ _ _ H) as J.
-  change (agree g P1) with (own.own(RA := unit_PCM) g tt (pred_of P1)) in H1.
-  destruct H1 as (? & Hid & ? & H1).
-  change (agree g P2) with (own.own(RA := unit_PCM) g tt (pred_of P2)) in H2.
-  destruct H2 as (? & ? & ? & H2).
-  rewrite ghost_fmap_singleton in H1, H2.
-  destruct (join_assoc (join_comm H1) J) as (? & J1 & ?).
-  destruct (join_assoc (join_comm H2) (join_comm J1)) as (? & J2 & ?).
-  apply singleton_join_inv in J2 as ([] & J2 & ?); subst.
-  inv J2; simpl in *.
-  destruct H6 as [Heq1 ?].
-  apply SomeP_inj in Heq1.
-  destruct (join_level _ _ _ H) as [Hl1 Hl2]; erewrite Hl1, Hl2 in *.
-  assert (approx (level a) P1 = approx (level a) P2) as Heq.
-  { apply (@equal_f _ _ (fun _ : list Type => approx (level a) P1) (fun _ : list Type => approx (level a) P2));
-      auto.
-    apply nil. }
-  clear J.
-  split.
-  - intros ??? Hl J HP1 ? Ha'.
-    pose proof (id_core_level a).
-    pose proof (necR_level _ _ Hl).
-    apply nec_identity in Hl; [|apply id_core_identity].
-    destruct (join_level _ _ _ J).
-    apply Hl in J; subst.
-    specialize (HP1 _ Ha').
-    apply laterR_level in Ha'.
-    assert ((approx (level a) P1) a') as HP1'.
-    { split; auto; lia. }
-    rewrite Heq in HP1'; destruct HP1'; auto.
-  - exists I; split.
-    + intro l; simpl.
-      apply (resource_at_join _ _ _ l) in H.
-      apply Hid in H as <-; auto.
-    + rewrite ghost_fmap_singleton; simpl.
-      eapply join_sub_trans; [|eexists; apply join_comm, ghost_of_join; eauto].
-      eexists; eauto.
-      replace _ with I in H2 by (apply proof_irr); eauto.
-Qed.
-
-Inductive list_join {P : Ghost} : Join (list (option G)) :=
-  | list_join_nil_l m: list_join nil m m
-  | list_join_nil_r m: list_join m nil m
-  | list_join_cons a1 a2 m1 m2 a3 m3: join a1 a2 a3 -> list_join m1 m2 m3 ->
-      list_join (a1 :: m1) (a2 :: m2) (a3 :: m3).
-#[global] Existing Instance list_join.
-
-Lemma list_join_inv: forall {P : Ghost} (l1 l2 l3 : list (option G)), list_join l1 l2 l3 ->
-match l1, l2 with
-| nil, _ => l3 = l2
-| _, nil => l3 = l1
-| a1 :: l1, a2 :: l2 => match l3 with nil => False
-                        | a3 :: l3 => join a1 a2 a3 /\ list_join l1 l2 l3 end
-end.
-Proof.
-  induction 1; simpl; auto.
-  destruct m; simpl; auto.
-Qed.
-
-#[global] Program Instance list_PCM (P : Ghost) : Ghost := { valid a := True; Join_G := list_join }.
-Next Obligation.
-Proof.
-  intros; exists (fun _ => nil); auto; intros; repeat econstructor.
-Defined.
-Next Obligation.
-Proof.
-  constructor.
-    + intros until 1.
-      revert z'; induction H; inversion 1; auto; subst.
-      f_equal; eauto.
-      eapply join_eq; eauto.
-    + induction a; intros ???? J1 J2; eapply list_join_inv in J1; subst.
-      { exists e; split; auto; constructor. }
-      destruct b; subst; [eexists; split; eauto; constructor|].
-      destruct d; [contradiction|].
-      destruct J1 as [Jc1 J1].
-      apply list_join_inv in J2.
-      destruct c; subst; [eexists; split; eauto; constructor; auto|].
-      destruct e; [contradiction|].
-      destruct J2 as [Jc2 J2].
-      destruct (join_assoc Jc1 Jc2) as (f & ? & ?).
-      destruct (IHa _ _ _ _ J1 J2) as (f' & ? & ?).
-      exists (f :: f'); split; constructor; auto.
-    + induction 1; constructor; auto.
-    + intros until 1.
-      revert b'; induction H; inversion 1; auto; subst.
-      f_equal; eauto.
-      eapply join_positivity; eauto.
-Qed.
-
-Definition ghost_list {P : Ghost} g l := own(RA := list_PCM P) g l NoneP.
-
-Definition list_singleton {A} n (a : A) := repeat None n ++ [Some a].
-
-Definition list_incl {A} (l1 l2 : list (option A)) := (length l1 <= length l2)%nat /\
-  forall n a, nth n l1 None = Some a -> nth n l2 None = Some a.
-
-(* up *)
-Lemma app_nth : forall {A} n l1 l2 (d : A),
-  nth n (l1 ++ l2) d = if lt_dec n (length l1) then nth n l1 d else nth (n - length l1) l2 d.
-Proof.
-  intros.
-  if_tac; [rewrite app_nth1 | rewrite app_nth2]; auto; lia.
-Qed.
-
-Fixpoint replace_nth {A} (n: nat) (al: list A) (x: A) {struct n}: list A :=
- match n, al with
- | O , a::al => x::al
- | S n', a::al' => a :: replace_nth n' al' x
- | _, nil => nil
- end.
-
-Lemma replace_nth_length : forall {A} n l (a : A),
-  length (replace_nth n l a) = length l.
-Proof.
-  induction n; destruct l; simpl; intros; try lia.
-  erewrite IHn by lia; auto.
-Qed.
-
-Lemma replace_nth_app : forall {A} n l1 l2 (a : A),
-  replace_nth n (l1 ++ l2) a = if lt_dec n (length l1) then replace_nth n l1 a ++ l2
-  else l1 ++ replace_nth (n - length l1) l2 a.
-Proof.
-  induction n; destruct l1; auto; simpl; intros.
-  rewrite IHn.
-  if_tac; if_tac; auto; lia.
-Qed.
-
-Lemma list_join_app : forall {P : Ghost} l1 l2 m1 m2 n1 n2,
-  length l1 = length m1 -> length l1 = length n1 ->
-  list_join l1 m1 n1 -> list_join l2 m2 n2 ->
-  list_join (l1 ++ l2) (m1 ++ m2) (n1 ++ n2).
-Proof.
-  induction 3.
-  - destruct m; auto; discriminate.
-  - destruct m; auto; discriminate.
-  - simpl in *.
-    intros; constructor; auto.
-Qed.
-
-Lemma list_join_None : forall {P : Ghost} n l, (n <= length l)%nat ->
-  list_join (repeat None n) l l.
-Proof.
-  induction n; [constructor|].
-  destruct l; simpl; [lia|].
-  repeat constructor.
-  apply IHn; lia.
-Qed.
-
-Lemma list_join_over : forall {P : Ghost} l l1 l2 l1', (length l <= length l1)%nat ->
-  list_join l l1 l1' -> list_join l (l1 ++ l2) (l1' ++ l2).
-Proof.
-  induction 2; simpl in *.
-  - constructor.
-  - destruct m; [constructor | simpl in *; lia].
-  - constructor; auto.
-    apply IHlist_join; lia.
-Qed.
-
-Lemma singleton_length : forall {A} n (a : A), length (list_singleton n a) = S n.
-Proof.
-  intros; unfold list_singleton.
-  erewrite app_length, repeat_length; simpl; lia.
-Qed.
-
-Lemma list_join_singleton : forall {P : Ghost} n a c l
-  (Hn : (n < length l)%nat) (Hjoin: join (Some a) (nth n l None) (Some c)),
-  list_join (list_singleton n a) l (replace_nth n l (Some c)).
-Proof.
-  induction l using rev_ind; simpl; intros; try lia.
-  rewrite app_length in Hn; simpl in Hn.
-  destruct (eq_dec n (length l)).
-  - subst.
-    erewrite app_nth2, Nat.sub_diag in Hjoin by lia; simpl in Hjoin.
-    erewrite replace_nth_app, if_false, Nat.sub_diag by lia; simpl.
-    apply list_join_app; try (rewrite repeat_length; auto).
-    + apply list_join_None; auto.
-    + repeat constructor; auto.
-  - assert (n < length l)%nat by lia.
-    erewrite app_nth1 in Hjoin by auto.
-    erewrite replace_nth_app, if_true by auto.
-    apply list_join_over, IHl; auto.
-    rewrite singleton_length; lia.
-Qed.
-
-(* up *)
-Lemma replace_nth_same : forall {A} n l (d : A), replace_nth n l (nth n l d) = l.
-Proof.
-  induction n; destruct l; auto; simpl; intro.
-  rewrite IHn; auto.
-Qed.
-
-Lemma nth_replace_nth : forall {A} n l a (d : A), (n < length l)%nat ->
-  nth n (replace_nth n l a) d = a.
-Proof.
-  induction n; destruct l; auto; simpl; intros; try lia.
-  apply IHn; lia.
-Qed.
-
-Lemma nth_replace_nth' : forall {A} n m l a (d : A), m <> n ->
-  nth m (replace_nth n l a) d = nth m l d.
-Proof.
-  induction n; destruct l; auto; destruct m; auto; simpl; intros; try lia.
-  apply IHn; lia.
-Qed.
-
-Lemma Znth_replace_nth : forall {A} {d : Inhabitant A} n l (a : A), (n < length l)%nat ->
-  Znth (Z.of_nat n) (replace_nth n l a) = a.
-Proof.
-  intros; rewrite <- nth_Znth'.
-  apply nth_replace_nth; auto.
-Qed.
-
-Lemma Znth_replace_nth' : forall {A} {d : Inhabitant A} n m l (a : A), m <> Z.of_nat n ->
-  Znth m (replace_nth n l a) = Znth m l.
-Proof.
-  intros.
-  destruct (zlt m 0); [rewrite !Znth_underflow; auto|].
-  rewrite <- (Z2Nat.id m) by lia.
-  rewrite <- !nth_Znth'; apply nth_replace_nth'.
-  intro; contradiction H; subst.
-  erewrite Z2Nat.id by lia; auto.
-Qed.
-
-Lemma replace_nth_replace_nth: forall {A: Type} R n {Rn Rn': A},
-  replace_nth n (replace_nth n R Rn) Rn' = replace_nth n R Rn'.
-Proof.
-  intros.
-  revert R; induction n; destruct R; simpl in *.
-  + reflexivity.
-  + reflexivity.
-  + reflexivity.
-  + rewrite IHn.
-    reflexivity.
-Qed.
-
-Lemma ghost_list_nth : forall {P : Ghost} g n l (a : G) (Ha : nth n l None = Some a),
-  (ghost_list g l = ghost_list g (list_singleton n a) * ghost_list g (replace_nth n l None))%pred.
-Proof.
-  intros; apply ghost_op.
-  rewrite <- (replace_nth_same n l None) at 2.
-  destruct (lt_dec n (length l)); [|erewrite nth_overflow in Ha by lia; discriminate].
-  exploit (list_join_singleton n a a (replace_nth n l None)).
-  { rewrite replace_nth_length; auto. }
-  { erewrite nth_replace_nth by auto; constructor. }
-  erewrite replace_nth_replace_nth, Ha; auto.
-Qed.
-
-Lemma list_join_length : forall {P : Ghost} l1 l2 l3, list_join l1 l2 l3 ->
-  (length l1 <= length l3)%nat.
-Proof.
-  induction 1; auto; simpl; lia.
-Qed.
-
-Lemma list_join_filler : forall {P : Ghost} l1 l2 l3 n, list_join l1 l2 l3 ->
-  (n <= length l3 - length l1)%nat -> list_join (l1 ++ repeat None n) l2 l3.
-Proof.
-  induction 1; simpl; intros.
-  - apply list_join_None; lia.
-  - destruct n; [|lia].
-    rewrite app_nil_r; constructor.
-  - constructor; auto.
-Qed.
-
-Lemma list_join_nth : forall {P : Ghost} l1 l2 l3 n, list_join l1 l2 l3 ->
-  join (nth n l1 None) (nth n l2 None) (nth n l3 None).
-Proof.
-  intros; revert n.
-  induction H; intro.
-  - erewrite nth_overflow by (simpl; lia); constructor.
-  - erewrite (nth_overflow []) by (simpl; lia); constructor.
-  - destruct n; simpl; auto.
-Qed.
-
-Lemma list_join_max : forall {P : Ghost} l1 l2 l3, list_join l1 l2 l3 ->
-  length l3 = Nat.max (length l1) (length l2).
-Proof.
-  induction 1; simpl; auto.
-  rewrite Nat.max_l; auto; lia.
-Qed.
-
-Lemma list_join_nth_error : forall {P : Ghost} l1 l2 l3 n, list_join l1 l2 l3 ->
-  join (nth_error l1 n) (nth_error l2 n) (nth_error l3 n).
-Proof.
-  intros; revert n.
-  induction H; intro.
-  - rewrite nth_error_nil; constructor.
-  - rewrite nth_error_nil; constructor.
-  - destruct n; simpl; auto.
-    constructor; auto.
-Qed.
-
-Lemma list_join_alt : forall {P : Ghost} l1 l2 l3,
-  list_join l1 l2 l3 <-> forall n, join (nth_error l1 n) (nth_error l2 n) (nth_error l3 n).
-Proof.
-  split; [intros; apply list_join_nth_error; auto|].
-  revert l2 l3; induction l1; simpl; intros.
-  - assert (l2 = l3); [|subst; constructor].
-    apply list_nth_error_eq; intro.
-    specialize (H j); rewrite nth_error_nil in H; inv H; auto.
-  - destruct l2.
-    + assert (a :: l1 = l3); [|subst; constructor].
-      apply list_nth_error_eq; intro.
-      specialize (H j); rewrite nth_error_nil in H; inv H; auto.
-    + destruct l3.
-      { specialize (H O); inv H. }
-      constructor.
-      * specialize (H O); inv H; auto.
-      * apply IHl1; intro.
-        apply (H (S n)).
-Qed.
-
-Lemma nth_error_replace_nth : forall {A} n l (a : A), (n < length l)%nat ->
-  nth_error (replace_nth n l a) n = Some a.
-Proof.
-  induction n; destruct l; auto; simpl; intros; try lia.
-  apply IHn; lia.
-Qed.
-
-Lemma nth_error_replace_nth' : forall {A} n m l (a : A), m <> n ->
-  nth_error (replace_nth n l a) m = nth_error l m.
-Proof.
-  induction n; destruct l; auto; destruct m; auto; simpl; intros; try lia.
-  apply IHn; lia.
-Qed.
-
-#[global] Instance list_order A : @PCM_order (list_PCM (discrete_PCM A)) list_incl.
-Proof.
-  constructor.
-  - constructor.
-    + repeat intro; split; auto.
-    + repeat intro.
-      destruct H, H0; split; auto; lia.
-  - intro a.
-    remember (length a) as n.
-    generalize dependent a; induction n; intros.
-    + destruct a; inv Heqn.
-      exists b; split; auto.
-      change [] with (core b); apply core_unit.
-    + assert (a <> []) by (intro; subst; discriminate).
-      erewrite (app_removelast_last None) in H, Heqn by auto.
-      erewrite app_length in Heqn; simpl in Heqn.
-      erewrite Nat.add_1_r in Heqn; inv Heqn.
-      specialize (IHn _ eq_refl).
-      destruct (IHn b c) as (c' & ? & ?); auto.
-      { destruct H as [Hlen H].
-        split.
-        { rewrite app_length in Hlen; simpl in *; lia. }
-        intros ?? Hnth.
-        specialize (H n a0).
-        rewrite app_nth in H.
-        if_tac in H; auto.
-        rewrite nth_overflow in Hnth; [discriminate|].
-        apply not_lt; auto. }
-      pose proof (list_join_length _ _ _ H2).
-      pose proof (list_join_length _ _ _ (join_comm H2)).
-      destruct (eq_dec (length (removelast a)) (length c')).
-      * exists (c' ++ [List.last a None]); split.
-        -- erewrite (app_removelast_last None) at 1 by auto.
-           apply join_comm, list_join_over; try lia.
-           apply join_comm in H2; auto.
-        -- split.
-            { destruct H.
-              erewrite app_length in *; simpl in *; lia. }
-            intros ?? Hnth.
-            rewrite app_nth in Hnth.
-            if_tac in Hnth; [apply H3; auto|].
-            destruct (n - length c')%nat eqn: Hminus; [|destruct n0; discriminate].
-            simpl in Hnth.
-            apply H.
-            erewrite app_nth2 by lia.
-            replace (_ - _)%nat with O by lia; auto.
-       * destruct (List.last a None) eqn: Ha.
-         -- exists (replace_nth (length (removelast a)) c' (Some g)).
-            split.
-            ++ apply list_join_alt; intro.
-               pose proof (list_join_max _ _ _ H2) as Hlen.
-               destruct (Nat.max_spec (length (removelast a)) (length b)) as [[? Hmax] | [? Hmax]];
-                 setoid_rewrite Hmax in Hlen; try lia.
-               hnf in H2; erewrite list_join_alt in H2.
-               specialize (H2 n0).
-               erewrite (app_removelast_last None) at 1 by auto.
-               rewrite Ha.
-               destruct (lt_dec n0 (length (removelast a))).
-               ** erewrite nth_error_app1 by auto.
-                  erewrite nth_error_replace_nth' by lia; auto.
-               ** erewrite nth_error_app2 by lia.
-                  destruct (eq_dec n0 (length (removelast a))).
-                  { subst; rewrite Nat.sub_diag; simpl.
-                    erewrite nth_error_replace_nth by (simpl in *; lia).
-                    destruct (nth_error b (length (removelast a))) eqn: Hb; setoid_rewrite Hb; constructor.
-                    destruct o; constructor.
-                    destruct H0 as [_ Hc].
-                    erewrite sublist.nth_error_nth in Hb by lia.
-                    inv Hb.
-                    apply Hc in H7.
-                    destruct H as [_ Hc'].
-                    specialize (Hc' (length (removelast a))).
-                    erewrite app_nth2, Nat.sub_diag in Hc' by auto.
-                    setoid_rewrite Hc' in H7; [|reflexivity].
-                    inv H7; constructor; auto. }
-                  { destruct (_ - _)%nat eqn: Hminus; [lia | simpl].
-                    erewrite nth_error_nil, nth_error_replace_nth' by (simpl in *; lia).
-                    destruct (nth_error_length n0 (removelast a)) as [_ Hnone].
-                    setoid_rewrite Hnone in H2; [auto | lia]. }
-            ++ destruct H3.
-               split.
-               { rewrite replace_nth_length; auto. }
-               intros ?? Hnth.
-               destruct (eq_dec n0 (length (removelast a)));
-                 [|rewrite nth_replace_nth' in Hnth; auto].
-               subst; erewrite nth_replace_nth in Hnth by (simpl in *; lia).
-               inv Hnth.
-               apply H.
-               erewrite app_nth2, Nat.sub_diag; auto.
-         -- exists c'; split; auto.
-            erewrite (app_removelast_last None), Ha by auto.
-            apply @list_join_filler with (n := 1%nat); auto; simpl in *; lia.
-  - split.
-    + split; [eapply list_join_length; eauto|].
-      intros ?? Hnth.
-      apply @list_join_nth with (n := n) in H.
-      rewrite Hnth in H; inv H; auto.
-      inv H3; auto.
-    + split; [apply join_comm in H; eapply list_join_length; eauto|].
-      intros ?? Hnth.
-      apply @list_join_nth with (n := n) in H.
-      rewrite Hnth in H; inv H; auto.
-      inv H3; auto.
-  - induction a; unfold list_incl; intros.
-    + destruct b; [constructor|].
-      simpl in *; lia.
-    + destruct H as [? Hnth].
-      destruct b; constructor.
-      * destruct o; [|constructor].
-        specialize (Hnth O _ eq_refl); simpl in Hnth.
-        subst; repeat constructor.
-      * apply IHa.
-        split; [simpl in *; lia|].
-        intros.
-        apply (Hnth (S n)); auto.
-Qed.
-
-(*Notation union := base.union.
-
-#[global] Program Instance set_PCM : Ghost := { valid := fun _ : coPset => True;
-  Join_G a b c := a ## b /\ c = union a b(*; core2 a := empty*) }.
-Next Obligation.
-Proof.
-  exists (fun _ => empty); auto.
-  intro; split; set_solver.
-Defined.
-Next Obligation.
-  constructor.
-    + intros.
-      inv H; inv H0; auto.
-    + intros.
-      inv H; inv H0.
-      eexists; split; [split; eauto | split]; set_solver.
-    + intros.
-      inv H.
-      split; set_solver.
-    + intros.
-      inv H; inv H0.
-      set_solver.
-Qed.*)
-
-Import Ensembles.
-
-Lemma Union_comm: forall {A} S T, Union A S T = Union A T S.
-Proof.
-  intros; extensionality; apply prop_ext; split; intro H; inv H; solve [constructor 1; auto] || solve [constructor 2; auto].
-Qed.
-
-Lemma Union_assoc: forall {A} S T U, Union A (Union A S T) U = Union A S (Union A T U).
-Proof.
-  intros; extensionality; apply prop_ext; split; intro H; inv H.
-  - inv H0; [constructor 1 | constructor 2; constructor 1]; auto.
-  - constructor 2; constructor 2; auto.
-  - constructor 1; constructor 1; auto.
-  - inv H0; [constructor 1; constructor 2 | constructor 2]; auto.
-Qed.
-
-Lemma Union_Empty : forall {A} S, Union A (Empty_set A) S = S.
-Proof.
-  intros; extensionality; apply prop_ext; split; intro H.
-  - inv H; auto; contradiction.
-  - constructor 2; auto.
-Qed.
-
-Lemma Intersection_comm: forall {A} S T, Intersection A S T = Intersection A T S.
-Proof.
-  intros; extensionality; apply prop_ext; split; intro H; inv H; constructor; auto.
-Qed.
-
-Lemma Intersection_assoc: forall {A} S T U, Intersection A (Intersection A S T) U = Intersection A S (Intersection A T U).
-Proof.
-  intros; extensionality; apply prop_ext; split; intro H; inv H.
-  - inv H0; repeat constructor; auto.
-  - inv H1; repeat constructor; auto.
-Qed.
-
-Lemma Intersection_Empty : forall {A} S, Intersection A (Empty_set A) S = Empty_set A.
-Proof.
-  intros; extensionality; apply prop_ext; split; intro H; inv H; auto.
-Qed.
-
-Global Arguments Union {_} _ _.
-Global Arguments Intersection {_} _ _.
-Global Arguments Disjoint {_} _ _.
-Global Arguments Add {_} _ _.
-Global Arguments Setminus {_} _ _.
-Global Arguments Subtract {_} _ _.
-Global Arguments Full_set {_}.
-Global Arguments Empty_set {_}.
-Global Arguments Singleton {_} _.
-Global Arguments In {_} _ _.
-Global Arguments Included {_} _ _.
-Global Arguments Same_set {_} _ _.
-
-#[global] Polymorphic Program Instance set_PCM : Ghost := { valid := fun _ : Ensemble nat => True;
-  Join_G a b c := Disjoint a b /\ c = Union a b }.
-Next Obligation.
-Proof.
-  apply fsep_sep; exists (fun _ => Empty_set); auto.
-  intro; split.
-  - constructor; intros ? X.
-    rewrite Intersection_Empty in X; contradiction.
-  - rewrite Union_Empty; auto.
-Defined.
-Next Obligation.
-  constructor.
-    + intros ???? [] []; subst; auto.
-    + intros ????? [Hd1] [Hd2]; subst.
-      inv Hd1; inv Hd2.
-      exists (Union b c); repeat (split; auto).
-      * intros ? X; inv X.
-        contradiction (H0 x).
-        constructor; auto.
-        right; auto.
-      * intros ? X; inv X.
-        inv H2.
-        -- contradiction (H x); constructor; auto.
-        -- contradiction (H0 x); constructor; auto.
-           left; auto.
-      * apply Union_assoc.
-    + intros ??? []; subst.
-      split.
-      * inv H; constructor.
-        intros x X; inv X; contradiction (H0 x); constructor; auto.
-      * apply Union_comm.
-    + intros ???? [] []; subst.
-      extensionality; apply prop_ext; split; intro X.
-      { left; auto. }
-      rewrite H2; left; auto.
-Qed.
-
-Definition ghost_set g s := own(RA := set_PCM) g s NoneP.
-
-Lemma ghost_set_join : forall g s1 s2,
-  (ghost_set g s1 * ghost_set g s2 = !!(Disjoint s1 s2) && ghost_set g (Union s1 s2))%pred.
-Proof.
-  intros.
-  setoid_rewrite own_op_gen.
-  - instantiate (1 := Union s1 s2).
-    unfold ghost_set; apply pred_ext.
-    + apply prop_andp_left; intros (? & (? & []) & ?).
-      apply prop_andp_right; auto.
-    + apply prop_andp_left; intros.
-      apply prop_andp_right; auto.
-      eexists; repeat (split; auto).
-  - intros (? & H & ?); inv H; split; auto.
-Qed.
-
-Lemma ghost_set_subset : forall g s s' (Hdec : forall a, In s' a \/ ~In s' a),
-  (Included s' s -> ghost_set g s = ghost_set g s' * ghost_set g (Setminus s s'))%pred.
-Proof.
-  intros.
-  apply ghost_op.
-  split.
-  - constructor; intros ? X; inv X.
-    inv H1; contradiction.
-  - extensionality; apply prop_ext; split; intro X.
-    + destruct (Hdec x); [left | right; constructor]; auto.
-    + destruct X. apply H; auto. inv H0; auto.
-Qed.
-
-Corollary ghost_set_remove : forall g a s,
-  In s a -> (ghost_set g s = ghost_set g (Singleton a) * ghost_set g (Subtract s a))%pred.
-Proof.
-  intros; apply ghost_set_subset.
-  { intro b; destruct (eq_dec a b); [left; subst; constructor | right; intros X; inv X; contradiction]. }
-  intros ? X; inv X; auto.
-Qed.
-
-Definition iname := nat.
-
-Class invG := { g_inv : gname; g_en : gname; g_dis : gname }.
-
-Context {inv_names : invG}.
-
-Definition master_list {A} g (l : list (option A)) := ghost_master1(ORD := list_order A) l g.
-
-(* Our ghost state construction makes it awkward to put agree inside other ghost state constructions.
-   As a workaround, instead of having one ghost location with a map from indices to agrees,
-   we have a map from indices to ghost locations, each with an agree. *)
-
-#[global] Instance token_PCM : Ghost := exclusive_PCM unit.
-
-Fixpoint iter_sepcon {A} (p : A -> mpred) l :=
-  match l with
-    | nil => emp
-    | x :: xl => (p x * iter_sepcon p xl)%pred
-  end.
-
-Typeclasses eauto := 1.
-
-#[global] Instance Inhabitant_mpred : Inhabitant mpred := emp.
-
-Definition wsat : mpred := (EX I : list mpred, EX lg : list gname, EX lb : list (option bool),
-  !!(length lg = length I /\ length lb = length I) &&
-  master_list g_inv (map (fun i => match Znth i lb with Some _ => Some (Znth i lg)
-                                   | None => None end) (upto (length I))) *
-  ghost_list g_dis (map (fun o => match o with Some true => Some (Some tt) | _ => None end) lb) *
-  ghost_set g_en (fun i : iname => nth i lb None = Some false) *
-  iter_sepcon (fun i => match Znth i lb with
-                        | Some true => agree (Znth i lg) (Znth i I) * |> Znth i I
-                        | Some false => agree (Znth i lg) (Znth i I)
-                        | _ => emp end) (upto (length I)))%pred.
-
-(* This is what's called ownI in Iris; we could build another layer with namespaces. *)
-Definition invariant (i : iname) P : mpred := (EX g : gname,
-  ghost_snap(ORD := list_order _) (list_singleton i g) g_inv * agree g P)%pred.
-
-Lemma nth_singleton : forall {A} n (a : A) d, nth n (list_singleton n a) d = Some a.
-Proof.
-  intros; unfold list_singleton.
-  rewrite app_nth2; rewrite repeat_length; auto.
-  rewrite Nat.sub_diag; auto.
-Qed.
-
-Lemma list_join_singleton_inv : forall {P : Ghost} n a b l,
-  list_join (list_singleton n a) (list_singleton n b) l ->
-  exists c, join a b c /\ l = list_singleton n c.
-Proof.
-  induction n; inversion 1; subst.
-  - inv H5.
-    inv H6; eauto.
-  - edestruct IHn as (c & ? & ?); eauto; subst.
-    inv H5; eauto.
-Qed.
-
-Lemma singleton_join_self : forall {P: Ghost} k (a : G), join a a a ->
-  join (list_singleton k a) (list_singleton k a) (list_singleton k a).
-Proof.
-  intros.
-  induction k; repeat constructor; auto.
-Qed.
-
-Lemma invariant_dup : forall i P, (invariant i P = invariant i P * invariant i P)%pred.
-Proof.
-  intros; unfold invariant; apply pred_ext.
-  - apply exp_left; intro g.
-    rewrite exp_sepcon1; apply exp_right with g.
-    rewrite exp_sepcon2; apply exp_right with g.
-    rewrite <- sepcon_assoc, (sepcon_comm _ (ghost_snap _ _)), <- sepcon_assoc.
-    erewrite ghost_snap_join.
-    erewrite sepcon_assoc, <- agree_dup; apply derives_refl.
-    { apply (singleton_join_self(P := discrete_PCM _)).
-      constructor; auto. }
-  - rewrite exp_sepcon1; apply exp_left; intro g1.
-    rewrite exp_sepcon2; apply exp_left; intro g2.
-    erewrite <- sepcon_assoc, (sepcon_comm _ (ghost_snap _ _)), <- sepcon_assoc.
-    rewrite ghost_snap_join'.
-    rewrite !exp_sepcon1; apply exp_left; intro l.
-    rewrite !sepcon_andp_prop1; apply prop_andp_left; intro H.
-    apply (list_join_singleton_inv(P := discrete_PCM _)) in H as (g & H & ?); subst.
-    inv H.
-    erewrite sepcon_assoc, <- agree_dup.
-    apply exp_right with g; apply derives_refl.
-Qed.
-
-(* up *)
-Lemma Zlength_eq : forall {A B} (l1 : list A) (l2 : list B),
-  Zlength l1 = Zlength l2 <-> length l1 = length l2.
-Proof.
-  intros; rewrite !Zlength_correct.
-  split; [apply Nat2Z.inj|].
-  intro; apply Z2Nat.inj; try lia.
-Qed.
-
-#[global] Instance list_Perm {P : Ghost} : Perm_alg (list (option G)).
-Proof.
-  apply list_PCM.
-Qed.
-
-(* up *)
-Lemma nth_upto : forall m n d, (n < m)%nat -> nth n (upto m) d = Z.of_nat n.
-Proof.
-  intros.
-  erewrite nth_indep by (rewrite upto_length; auto).
-  erewrite nth_Znth', Znth_upto; auto.
-  split; [lia|].
-  apply Nat2Z.inj_lt; auto.
-Qed.
-
-Lemma nth_repeat : forall {A} n m (a : A), nth n (repeat a m) a = a.
-Proof.
-  induction n; destruct m; simpl; auto.
-Qed.
-
-Lemma list_incl_singleton : forall {A} n (a : A) l,
-  list_incl (list_singleton n a) l <-> nth n l None = Some a.
-Proof.
-  unfold list_incl; split.
-  - intros [? Hnth].
-    apply Hnth.
-    rewrite nth_singleton; auto.
-  - intros; split.
-    + rewrite singleton_length.
-      destruct (lt_dec n (length l)); [lia|].
-      erewrite nth_overflow in H by lia; discriminate.
-    + intros ??.
-      unfold list_singleton.
-      destruct (lt_dec n0 n).
-      * erewrite app_nth1 by (rewrite repeat_length; auto).
-        rewrite nth_repeat; discriminate.
-      * rewrite app_nth2; rewrite repeat_length; try lia.
-        destruct (eq_dec n0 n); [|erewrite nth_overflow by (simpl; lia); discriminate].
-        subst; rewrite Nat.sub_diag; simpl.
-        intro X; inv X; auto.
-Qed.
-
-Lemma seq_app : forall a b c, seq a (b + c) = seq a b ++ seq (a + b) c.
-Proof.
-  intros ??; revert a; induction b; simpl; intros; auto.
-  rewrite IHb; do 3 f_equal; lia.
-Qed.
-
-Lemma filter_ext_in : forall {A} (f g : A -> bool) l, (forall x, List.In x l -> f x = g x) -> filter f l = filter g l.
-Proof.
-  induction l; auto; simpl; intros.
-  rewrite -> H by auto.
-  rewrite IHl; auto.
-Qed.
-
-Lemma filter_none : forall {A} (f : A -> bool) l, (forall x, List.In x l -> f x = false) -> filter f l = [].
-Proof.
-  induction l; auto; simpl; intros.
-  rewrite H; auto.
-Qed.
-
-Ltac view_shift H := eapply derives_trans; [apply sepcon_derives, derives_refl; apply H
-  | eapply derives_trans; [apply bupd_frame_r | eapply derives_trans, bupd_trans; apply bupd_mono]].
-
-Lemma iter_sepcon_app:
-  forall {B} p (l1 l2 : list B), (iter_sepcon p (l1 ++ l2) = iter_sepcon p l1 * iter_sepcon p l2)%pred.
-Proof.
-  induction l1; intros; simpl. rewrite emp_sepcon; auto. rewrite IHl1. rewrite sepcon_assoc. auto.
-Qed.
-
-Lemma iter_sepcon_func_strong: forall {A} (l : list A) P Q, (forall x, List.In x l -> P x = Q x) -> iter_sepcon P l = iter_sepcon Q l.
-Proof.
-  intros. induction l.
-  + reflexivity.
-  + simpl.
-    f_equal.
-    - apply H.
-      simpl; auto.
-    - apply IHl.
-      intros; apply H.
-      simpl; auto.
-Qed.
-
-Lemma iter_sepcon_emp': forall {B} p (l : list B), (forall x, List.In x l -> p x = emp) -> iter_sepcon p l = emp.
-Proof.
-  induction l; intros; simpl; auto.
-  rewrite H, IHl, sepcon_emp; simpl; auto.
-  intros; apply H; simpl; auto.
-Qed.
-
-Lemma wsat_alloc_dep : forall P, wsat * (ALL i, |> P i) |-- |==> wsat * EX i : _, invariant i (P i).
-Proof.
-  intros; unfold wsat.
-  rewrite !exp_sepcon1; apply exp_left; intro l.
-  rewrite !exp_sepcon1; apply exp_left; intro lg.
-  rewrite !exp_sepcon1; apply exp_left; intro lb.
-  rewrite !sepcon_andp_prop1; apply prop_andp_left; intros [].
-  rewrite (sepcon_comm _ (ghost_list _ _)), !sepcon_assoc.
-  view_shift (ghost_update_ND(RA := list_PCM token_PCM) g_dis (map
-     (fun o => match o with Some true => Some (Some tt) | _ => None end) lb)
-     (fun l => exists i, l =
-      map (fun o => match o with Some true => Some (Some tt) | _ => None end)
-          ((lb ++ repeat None i) ++ [Some true]))).
-  { intros ? (? & ? & _).
-    exists (map (fun o => match o with Some true => Some (Some tt) | _ => None end)
-      ((lb ++ repeat None (length x - length lb)) ++ [Some true])).
-    split; [eauto|].
-    exists (x ++ [Some (Some tt)]); split; simpl; auto.
-    erewrite !map_app, own.map_repeat; simpl.
-    pose proof (list_join_length _ _ _ H1) as Hlen.
-    rewrite map_length in Hlen.
-    apply join_comm in H1.
-    pose proof (list_join_length _ _ _ H1) as Hlen'.
-    apply (join_comm(Perm_alg := list_Perm)), (list_join_over c).
-    { erewrite app_length, map_length, repeat_length, Nat.add_comm, Nat.sub_add; auto. }
-    apply (join_comm(Perm_alg := list_Perm)), (list_join_filler(P := token_PCM));
-      [|rewrite map_length; auto].
-    apply join_comm in H1; auto. }
-  rewrite exp_sepcon1; apply exp_left; intro.
-  rewrite !sepcon_andp_prop1; apply prop_andp_left; intros [i ?]; subst.
-  eapply derives_trans with (emp * _)%pred; [rewrite emp_sepcon; apply derives_refl|].
-  set (P' := P (length lg + i)%nat).
-  view_shift (ghost_alloc(RA := unit_PCM) tt (pred_of P')); [simpl; auto|].
-  rewrite !exp_sepcon1; apply exp_left; intro g.
-  replace (own(RA := unit_PCM) g tt (pred_of P')) with (agree g P') by reflexivity.
-  rewrite agree_dup.
-  assert (Zlength lg = Zlength l) as Hlg by (apply Zlength_eq; auto).
-  assert (Zlength lb = Zlength l) as Hlb by (apply Zlength_eq; auto).
-  rewrite <- !sepcon_assoc, (sepcon_comm _ (master_list _ _)), !sepcon_assoc.
-  view_shift (master_update(ORD := list_order _) ((map (fun i0 : Z =>
-      match Znth i0 lb with Some _ => Some (Znth i0 lg) | None => None end) (upto (Datatypes.length l))))
-        (map (fun j => match Znth j ((lb ++ repeat None i) ++ [Some true]) with
-                       | Some _ => Some (Znth j ((lg ++ repeat O i) ++ [g]))
-                       | None => None
-                       end) (upto (length ((l ++ repeat emp i) ++ [P']))))).
-  { rewrite <- !app_assoc, app_length, upto_app, map_app.
-    split.
-    { erewrite app_length, !map_length; lia. }
-    intros ?? Hn.
-    erewrite app_nth, map_length.
-    if_tac; [|erewrite nth_overflow in Hn by (rewrite map_length; lia); discriminate].
-    erewrite nth_map' with (d' := 0) in * by auto.
-    erewrite upto_length in *.
-    assert (Z.of_nat n < Zlength l).
-    { rewrite Zlength_correct; apply Nat2Z.inj_lt; auto. }
-    erewrite nth_upto in * by auto.
-    erewrite !app_Znth1 by lia; auto. }
-  view_shift (make_snap(ORD := list_order gname)).
-  rewrite !sepcon_assoc.
-  view_shift (ghost_snap_forget(ORD := list_order _) (list_singleton (length lg + i) g)).
-  { apply list_incl_singleton.
-    erewrite app_length, upto_app, map_app, app_nth2; erewrite map_length, upto_length, app_length,
-      repeat_length; try lia.
-    replace (_ - _)%nat with O by lia; simpl.
-    rewrite Nat2Z.inj_add, Z.add_0_r.
-    rewrite !app_Znth2; erewrite !Zlength_app, !coqlib4.Zlength_repeat, <- Zlength_correct; try lia.
-    replace (_ - _) with 0 by lia; replace (_ - _) with 0 by lia; auto. }
-  eapply derives_trans, bupd_intro.
-  apply exp_right with ((l ++ repeat emp i) ++ [P']).
-  rewrite exp_sepcon1; apply exp_right with ((lg ++ repeat O i) ++ [g]).
-  rewrite exp_sepcon1; apply exp_right with ((lb ++ repeat None i) ++ [Some true]).
-  erewrite !(app_length (_ ++ _)); simpl.
-  erewrite prop_true_andp by (erewrite !app_length, !repeat_length; lia).
-  erewrite upto_app, iter_sepcon_app; simpl.
-  erewrite Z.add_0_r, <- Zlength_correct, !app_Znth2; erewrite !Zlength_app, !coqlib4.Zlength_repeat; try lia.
-  erewrite Hlg, Hlb, Zminus_diag, !Znth_0_cons.
-  rewrite sepcon_comm, !sepcon_assoc; apply sepcon_derives; [apply derives_refl|].
-  rewrite <- sepcon_assoc, sepcon_comm, sepcon_assoc; apply sepcon_derives; [apply derives_refl|].
-  rewrite sepcon_assoc; apply sepcon_derives.
-  { match goal with |-?P |-- ?Q => replace P with Q; [apply derives_refl|] end.
-    f_equal. extensionality; apply prop_ext; split; intro X.
-    - rewrite !app_nth, nth_repeat in X.
-      repeat destruct (lt_dec _ _); auto; try discriminate.
-      destruct (x - _)%nat; [|destruct n0]; inv X.
-    - destruct (lt_dec x (length lb)).
-      rewrite !app_nth, app_length.
-      destruct (lt_dec _ _); [|lia].
-      destruct (lt_dec _ _); [auto | lia].
-      { rewrite nth_overflow in X by lia; discriminate. } }
-  erewrite app_length, upto_app, iter_sepcon_app.
-  rewrite sepcon_assoc; apply sepcon_derives.
-  - eapply derives_trans with (_ * emp)%pred; [rewrite sepcon_emp; apply derives_refl|].
-    apply sepcon_derives.
-    + erewrite iter_sepcon_func_strong; auto.
-      intros ??%In_upto.
-      rewrite <- Zlength_correct in *.
-      rewrite <- !app_assoc, !app_Znth1 by (rewrite ?Zlength_app; lia); auto.
-    + rewrite iter_sepcon_emp'; auto.
-      intros ? Hin.
-      eapply in_map_iff in Hin as (? & ? & Hin%In_upto); subst.
-      rewrite <- Zlength_correct, coqlib4.Zlength_repeat in Hin.
-      rewrite <- Zlength_correct, <- app_assoc, app_Znth2 by lia.
-      erewrite app_Znth1 by (rewrite coqlib4.Zlength_repeat; lia).
-      unfold Znth; destruct (Z_lt_dec _ _); auto.
-      rewrite nth_repeat; auto.
-  - unfold invariant.
-    rewrite emp_sepcon, !exp_sepcon2; apply exp_right with (length lg + i)%nat.
-    rewrite !exp_sepcon2; apply exp_right with g.
-    rewrite <- !sepcon_assoc, sepcon_comm, !sepcon_assoc; apply sepcon_derives; [apply derives_refl|].
-    apply sepcon_derives, derives_refl.
-    eapply allp_left, derives_refl.
-Qed.
-
-Lemma wsat_alloc : forall P, wsat * |> P |-- |==> wsat * EX i : _, invariant i P.
-Proof.
-  intros; eapply derives_trans, wsat_alloc_dep.
-  apply sepcon_derives; [apply derives_refl|].
-  apply allp_right; auto.
-Qed.
-
-(* request an iname with a particular property *)
-Lemma wsat_alloc_strong : forall P Pi (Hfresh : forall n, exists i, (n <= i)%nat /\ Pi i),
-  wsat * |> P |-- |==> wsat * EX i : _, !!(Pi i) && invariant i P.
-Proof.
-  intros; unfold wsat.
-  rewrite !exp_sepcon1; apply exp_left; intro l.
-  rewrite !exp_sepcon1; apply exp_left; intro lg.
-  rewrite !exp_sepcon1; apply exp_left; intro lb.
-  rewrite !sepcon_andp_prop1; apply prop_andp_left; intros [].
-  rewrite (sepcon_comm _ (ghost_list _ _)), !sepcon_assoc.
-  view_shift (ghost_update_ND(RA := list_PCM token_PCM) g_dis (map
-     (fun o => match o with Some true => Some (Some tt) | _ => None end) lb)
-     (fun l => exists i, Pi (length lg + i)%nat /\ l =
-      map (fun o => match o with Some true => Some (Some tt) | _ => None end)
-          ((lb ++ repeat None i) ++ [Some true]))).
-  { intros ? (? & ? & _).
-    destruct (Hfresh (length x)) as (i & ? & ?).
-    exists (map (fun o => match o with Some true => Some (Some tt) | _ => None end)
-      ((lb ++ repeat None (i - length lb)) ++ [Some true])).
-    pose proof (list_join_length _ _ _ H1) as Hlen.
-    rewrite map_length in Hlen.
-    split.
-    { exists (i - length lg)%nat; rewrite H, H0; split; auto.
-      rewrite Nat.add_comm, Nat.sub_add; auto; lia. }
-    exists (x ++ repeat None (i - length x) ++ [Some (Some tt)]); split; simpl; auto.
-    erewrite !map_app, own.map_repeat; simpl.
-    apply join_comm in H1.
-    rewrite app_assoc; apply (join_comm(Perm_alg := list_Perm)), (list_join_over c).
-    { apply list_join_length in H1.
-      rewrite app_length, map_length, repeat_length, Nat.add_comm, Nat.sub_add; auto; lia. }
-    replace (i - length lb)%nat with ((length x - length lb) + (i - length x))%nat by lia.
-    rewrite repeat_app, app_assoc; apply (list_join_over c).
-    { apply list_join_length in H1.
-      rewrite app_length, map_length, repeat_length; lia. }
-    apply (join_comm(Perm_alg := list_Perm)), (list_join_filler(P := token_PCM));
-      [|rewrite map_length; auto].
-    apply join_comm in H1; auto. }
-  rewrite exp_sepcon1; apply exp_left; intro.
-  rewrite !sepcon_andp_prop1; apply prop_andp_left; intros [i []]; subst.
-  eapply derives_trans with (emp * _)%pred; [rewrite emp_sepcon; apply derives_refl|].
-  view_shift (ghost_alloc(RA := unit_PCM) tt (pred_of P)); [simpl; auto|].
-  rewrite !exp_sepcon1; apply exp_left; intro g.
-  replace (own(RA := unit_PCM) g tt (pred_of P)) with (agree g P) by reflexivity.
-  rewrite agree_dup.
-  assert (Zlength lg = Zlength l) as Hlg by (apply Zlength_eq; auto).
-  assert (Zlength lb = Zlength l) as Hlb by (apply Zlength_eq; auto).
-  rewrite <- !sepcon_assoc, (sepcon_comm _ (master_list _ _)), !sepcon_assoc.
-  view_shift (master_update(ORD := list_order _) ((map (fun i0 : Z =>
-      match Znth i0 lb with Some _ => Some (Znth i0 lg) | None => None end) (upto (Datatypes.length l))))
-        (map (fun j => match Znth j ((lb ++ repeat None i) ++ [Some true]) with
-                       | Some _ => Some (Znth j ((lg ++ repeat O i) ++ [g]))
-                       | None => None
-                       end) (upto (length ((l ++ repeat emp i) ++ [P]))))).
-  { rewrite <- !app_assoc, app_length, upto_app, map_app.
-    split.
-    { erewrite app_length, !map_length; lia. }
-    intros ?? Hn.
-    erewrite app_nth, map_length.
-    if_tac; [|erewrite nth_overflow in Hn by (rewrite map_length; lia); discriminate].
-    erewrite nth_map' with (d' := 0) in * by auto.
-    erewrite upto_length in *.
-    assert (Z.of_nat n < Zlength l).
-    { rewrite Zlength_correct; apply Nat2Z.inj_lt; auto. }
-    erewrite nth_upto in * by auto.
-    erewrite !app_Znth1 by lia; auto. }
-  view_shift (make_snap(ORD := list_order gname)).
-  rewrite !sepcon_assoc.
-  view_shift (ghost_snap_forget(ORD := list_order _) (list_singleton (length lg + i) g)).
-  { apply list_incl_singleton.
-    erewrite app_length, upto_app, map_app, app_nth2; erewrite map_length, upto_length, app_length,
-      repeat_length; try lia.
-    replace (_ - _)%nat with O by lia; simpl.
-    rewrite Nat2Z.inj_add, Z.add_0_r.
-    rewrite !app_Znth2; erewrite !Zlength_app, !coqlib4.Zlength_repeat, <- Zlength_correct; try lia.
-    replace (_ - _) with 0 by lia; replace (_ - _) with 0 by lia; auto. }
-  eapply derives_trans, bupd_intro.
-  apply exp_right with ((l ++ repeat emp i) ++ [P]).
-  rewrite exp_sepcon1; apply exp_right with ((lg ++ repeat O i) ++ [g]).
-  rewrite exp_sepcon1; apply exp_right with ((lb ++ repeat None i) ++ [Some true]).
-  erewrite !(app_length (_ ++ _)); simpl.
-  erewrite prop_true_andp by (erewrite !app_length, !repeat_length; lia).
-  erewrite upto_app, iter_sepcon_app; simpl.
-  erewrite Z.add_0_r, <- Zlength_correct, !app_Znth2; erewrite !Zlength_app, !coqlib4.Zlength_repeat; try lia.
-  erewrite Hlg, Hlb, Zminus_diag, !Znth_0_cons.
-  rewrite sepcon_comm, !sepcon_assoc; apply sepcon_derives; [apply derives_refl|].
-  rewrite <- sepcon_assoc, sepcon_comm, sepcon_assoc; apply sepcon_derives; [apply derives_refl|].
-  rewrite sepcon_assoc; apply sepcon_derives.
-  { match goal with |-?P |-- ?Q => replace P with Q; [apply derives_refl|] end.
-    f_equal. extensionality; apply prop_ext; split; intro X.
-    - rewrite !app_nth, nth_repeat in X.
-      repeat destruct (lt_dec _ _); auto; try discriminate.
-      destruct (x - _)%nat; [|destruct n0]; inv X.
-    - destruct (lt_dec x (length lb)).
-      rewrite !app_nth, app_length.
-      destruct (lt_dec _ _); [|lia].
-      destruct (lt_dec _ _); [auto | lia].
-      { rewrite nth_overflow in X by lia; discriminate. } }
-  erewrite app_length, upto_app, iter_sepcon_app.
-  rewrite sepcon_assoc; apply sepcon_derives.
-  - eapply derives_trans with (_ * emp)%pred; [rewrite sepcon_emp; apply derives_refl|].
-    apply sepcon_derives.
-    + erewrite iter_sepcon_func_strong; auto.
-      intros ??%In_upto.
-      rewrite <- Zlength_correct in *.
-      rewrite <- !app_assoc, !app_Znth1 by (rewrite ?Zlength_app; lia); auto.
-    + rewrite iter_sepcon_emp'; auto.
-      intros ? Hin.
-      eapply in_map_iff in Hin as (? & ? & Hin%In_upto); subst.
-      rewrite <- Zlength_correct, coqlib4.Zlength_repeat in Hin.
-      rewrite <- Zlength_correct, <- app_assoc, app_Znth2 by lia.
-      erewrite app_Znth1 by (rewrite coqlib4.Zlength_repeat; lia).
-      unfold Znth; destruct (Z_lt_dec _ _); auto.
-      rewrite nth_repeat; auto.
-  - unfold invariant.
-    rewrite emp_sepcon, !exp_sepcon2; apply exp_right with (length lg + i)%nat.
-    rewrite prop_true_andp by auto.
-    rewrite !exp_sepcon2; apply exp_right with g.
-    rewrite <- !sepcon_assoc, sepcon_comm, !sepcon_assoc; apply derives_refl.
-Qed.
-
-Lemma iter_sepcon_Znth: forall {A} {d : Inhabitant A} f (l : list A) i, 0 <= i < Zlength l ->
-  iter_sepcon f l = (f (Znth i l) * iter_sepcon f (remove_Znth i l))%pred.
-Proof.
-  intros; unfold remove_Znth.
-  transitivity (iter_sepcon f (sublist 0 (Zlength l) l)); [rewrite sublist_same; auto|].
-  rewrite sublist_split with (mid := i) by lia.
-  rewrite (sublist_next i) by lia.
-  rewrite !iter_sepcon_app; simpl.
-  rewrite <- !sepcon_assoc, (sepcon_comm (f _)); reflexivity.
-Qed.
-
-Lemma map_replace_nth:
-  forall {A B} (f: A -> B) n R X, map f (replace_nth n R X) =
-       replace_nth n (map f R) (f X).
-Proof.
-  intros.
-  revert R; induction n; destruct R; simpl; auto.
-  f_equal; auto.
-Qed.
-
-Lemma wsat_open : forall i P,
-  (wsat * invariant i P * ghost_set g_en (Singleton i) |--
-  |==> wsat * |> P * ghost_list g_dis (list_singleton i (Some tt))).
-Proof.
-  intros; unfold wsat, invariant.
-  rewrite !exp_sepcon1; apply exp_left; intros l.
-  rewrite !exp_sepcon1; apply exp_left; intros lg.
-  rewrite !exp_sepcon1; apply exp_left; intros lb.
-  rewrite !sepcon_andp_prop1; apply prop_andp_left; intros [].
-  rewrite !exp_sepcon2, exp_sepcon1; apply exp_left; intros g.
-  eapply derives_trans, (prop_andp_left (i < length lg /\ Znth (Z.of_nat i) lg = g /\
-    exists b, Znth (Z.of_nat i) lb = Some b)%nat).
-  { rewrite <- sepcon_assoc, (sepcon_comm _ (ghost_snap _ _)), <- !sepcon_assoc.
-    unfold master_list; rewrite snap_master_join1.
-    rewrite !sepcon_andp_prop1; apply andp_derives, derives_refl.
-    apply prop_derives; intros Hincl.
-    apply list_incl_singleton in Hincl.
-    destruct (lt_dec i (length lg));
-      [|rewrite nth_overflow in Hincl by (rewrite map_length, upto_length; lia); discriminate].
-    rewrite nth_map' with (d' := 0) in Hincl by (rewrite upto_length; lia).
-    rewrite nth_upto in Hincl by lia.
-    destruct (Znth (Z.of_nat i) lb); inversion Hincl; eauto. }
-  intros (? & ? & b & Hi).
-  eapply derives_trans, bupd_intro.
-  assert (nth i lb None = Some b) as Hi'.
-  { rewrite <- nth_Znth, Nat2Z.id in Hi; auto.
-    rewrite Zlength_correct; lia. }
-  destruct b.
-  erewrite ghost_list_nth with (n := i) by (rewrite nth_map' with (d' := None), Hi'; eauto; lia).
-  rewrite (iter_sepcon_Znth _ _ (Z.of_nat i))
-    by (rewrite Zlength_upto; split; [|apply Nat2Z.inj_lt]; lia).
-  rewrite Znth_upto, Hi by lia.
-  rewrite (sepcon_assoc (agree _ _)), (sepcon_comm (agree _ _)), <- !sepcon_assoc, sepcon_comm, <- !sepcon_assoc, sepcon_assoc.
-  subst; eapply derives_trans; [apply sepcon_derives, agree_join; apply derives_refl|].
-  apply exp_right with l.
-  rewrite !exp_sepcon1; apply exp_right with lg.
-  rewrite !exp_sepcon1; apply exp_right with (replace_nth i lb (Some false)).
-  rewrite prop_true_andp.
-  rewrite (sepcon_comm _ (ghost_master1 _ _)), !sepcon_assoc; apply sepcon_derives.
-  { erewrite map_ext; [apply derives_refl|].
-    intros; simpl.
-    destruct (eq_dec a (Z.of_nat i)); [subst; rewrite Znth_replace_nth | rewrite Znth_replace_nth'];
-      auto; try lia.
-    rewrite Hi; auto. }
-  rewrite sepcon_comm, (sepcon_comm (ghost_list _ _)), !sepcon_assoc; apply sepcon_derives.
-  { rewrite map_replace_nth; auto. }
-  rewrite <- !sepcon_assoc, sepcon_comm, <- !sepcon_assoc.
-  rewrite ghost_set_join, !sepcon_andp_prop1; apply prop_andp_left; intros.
-  rewrite !sepcon_assoc; apply sepcon_derives.
-  { match goal with |- ghost_set _ ?A |-- ghost_set _ ?B =>
-      replace B with A end.
-    apply derives_refl.
-    extensionality; apply prop_ext; split; intro Hin.
-    + inv Hin.
-      * inv H3. rewrite nth_replace_nth; auto; lia.
-      * destruct (eq_dec x i); [subst; rewrite nth_replace_nth | rewrite nth_replace_nth']; auto; lia.
-    +
-      destruct (eq_dec x i); [subst; constructor 1; constructor|].
-      rewrite nth_replace_nth' in Hin; auto; constructor 2; auto. }
-  rewrite <- !sepcon_assoc; apply sepcon_derives, derives_refl.
-  rewrite sepcon_comm, (sepcon_comm _ (iter_sepcon _ _)), <- !sepcon_assoc.
-  rewrite sepcon_assoc; apply sepcon_derives.
-  { rewrite (iter_sepcon_Znth _ (upto _) (Z.of_nat i))
-      by (rewrite Zlength_upto; split; [|apply Nat2Z.inj_lt]; lia).
-    rewrite Znth_upto, Znth_replace_nth by lia.
-    apply sepcon_derives; [apply derives_refl|].
-    erewrite iter_sepcon_func_strong; auto.
-    unfold remove_Znth; intros ? Hin.
-    rewrite Znth_replace_nth'; auto.
-    intro; subst.
-    apply in_app in Hin as [?%In_sublist_upto | ?%In_sublist_upto]; lia.
- }
-  { rewrite sepcon_comm, wand_sepcon_adjoint; apply derives_refl. }
-  { rewrite replace_nth_length; split; auto. }
-  { rewrite !sepcon_assoc, (sepcon_comm (ghost_set _ _)), <- !sepcon_assoc, sepcon_assoc.
-    eapply derives_trans, FF_derives.
-    eapply derives_trans; [apply sepcon_derives; [apply derives_refl|] | rewrite sepcon_comm, FF_sepcon; apply derives_refl].
-    rewrite ghost_set_join; apply prop_andp_left; intros X.
-    inv X. contradiction (H3 i). constructor; auto; constructor. }
-Qed.
-
-(* up *)
-Lemma replace_nth_same' : forall {A} n l (a d : A), nth n l d = a -> replace_nth n l a = l.
-Proof.
-  intros; subst; apply replace_nth_same.
-Qed.
-
-Lemma wsat_close : forall i P,
-  (wsat * invariant i P * |> P * ghost_list g_dis (list_singleton i (Some tt)) |--
-  |==> wsat * ghost_set g_en (Singleton i)).
-Proof.
-  intros; unfold wsat, invariant.
-  rewrite !exp_sepcon1; apply exp_left; intros l.
-  rewrite !exp_sepcon1; apply exp_left; intros lg.
-  rewrite !exp_sepcon1; apply exp_left; intros lb.
-  rewrite !sepcon_andp_prop1; apply prop_andp_left; intros [].
-  rewrite !exp_sepcon2, !exp_sepcon1; apply exp_left; intros g.
-  eapply derives_trans, (prop_andp_left (i < length lg /\ Znth (Z.of_nat i) lg = g /\
-    exists b, Znth (Z.of_nat i) lb = Some b)%nat).
-  { rewrite <- sepcon_assoc, (sepcon_comm _ (ghost_snap _ _)), <- !sepcon_assoc.
-    unfold master_list; rewrite snap_master_join1.
-    rewrite !sepcon_andp_prop1; apply andp_derives, derives_refl.
-    apply prop_derives; intros Hincl.
-    apply list_incl_singleton in Hincl.
-    destruct (lt_dec i (length lg));
-      [|rewrite nth_overflow in Hincl by (rewrite map_length, upto_length; lia); discriminate].
-    rewrite nth_map' with (d' := 0) in Hincl by (rewrite upto_length; lia).
-    rewrite nth_upto in Hincl by lia.
-    destruct (Znth (Z.of_nat i) lb); inversion Hincl; eauto. }
-  intros (? & ? & b & Hi).
-  eapply derives_trans, bupd_intro.
-  assert (nth i lb None = Some b) as Hi'.
-  { rewrite <- nth_Znth, Nat2Z.id in Hi; auto.
-    rewrite Zlength_correct; lia. }
-  destruct b.
-  { rewrite (sepcon_comm (ghost_master1 _ _)), sepcon_comm, <- !sepcon_assoc.
-    rewrite 4sepcon_assoc; eapply derives_trans, FF_derives.
-    eapply derives_trans; [apply sepcon_derives, derives_refl | rewrite FF_sepcon; apply derives_refl].
-    eapply derives_trans; [apply andp_right, derives_refl; apply ghost_valid_2|].
-    apply prop_andp_left; intros (? & J & ?).
-    apply list_join_nth with (n := i) in J.
-    erewrite nth_singleton, nth_map' with (d' := None) in J by lia.
-    rewrite Hi' in J; inv J.
-    inv H7.
-    inv H5. }
-  rewrite ghost_set_remove with (a := i) by auto.
-  apply exp_right with l.
-  rewrite exp_sepcon1; apply exp_right with lg.
-  rewrite exp_sepcon1; apply exp_right with (replace_nth i lb (Some true)).
-  rewrite replace_nth_length, prop_true_andp by auto.
-  rewrite !sepcon_assoc; apply sepcon_derives.
-  { erewrite map_ext; [apply derives_refl|].
-    intros.
-    destruct (eq_dec a (Z.of_nat i)); [subst; rewrite Znth_replace_nth | rewrite Znth_replace_nth'];
-      auto; try lia.
-    rewrite Hi; auto. }
-  rewrite sepcon_comm, sepcon_assoc, sepcon_comm, <- !sepcon_assoc; apply sepcon_derives, derives_refl.
-  rewrite !sepcon_assoc, (sepcon_comm (ghost_list _ _) (_ * _)%pred), <- !sepcon_assoc, sepcon_assoc.
-  apply sepcon_derives.
-  rewrite !sepcon_assoc; apply sepcon_derives.
-  { match goal with |- ghost_set _ ?A |-- ghost_set _ ?B =>
-      replace B with A end; [apply derives_refl|].
-    extensionality; apply prop_ext; split; intro Hin.
-    + inv Hin.
-      destruct (eq_dec x i); [subst; contradiction H4; constructor|].
-      rewrite nth_replace_nth'; auto.
-    +
-      destruct (eq_dec x i); [subst; rewrite nth_replace_nth in Hin by lia; discriminate|].
-      rewrite nth_replace_nth' in Hin by auto; constructor; auto.
-      intros X; inv X; contradiction. }
-  { rewrite (iter_sepcon_Znth _ _ (Z.of_nat i))
-      by (rewrite Zlength_upto; split; [|apply Nat2Z.inj_lt]; lia).
-    rewrite (iter_sepcon_Znth _ (upto _) (Z.of_nat i))
-      by (rewrite Zlength_upto; split; [|apply Nat2Z.inj_lt]; lia).
-    rewrite !Znth_upto, !Znth_replace_nth by lia.
-    rewrite Hi.
-    rewrite (sepcon_comm _ (|> P)%pred), <- !sepcon_assoc, sepcon_comm, <- !sepcon_assoc, sepcon_assoc.
-    subst; eapply derives_trans; [apply sepcon_derives, derives_refl; apply agree_join2|].
-    rewrite (sepcon_comm _ (agree _ _)), !sepcon_assoc; apply sepcon_derives; [apply derives_refl|].
-    rewrite <- sepcon_assoc, sepcon_comm, <- sepcon_assoc; apply sepcon_derives.
-    + rewrite sepcon_comm, wand_sepcon_adjoint; apply derives_refl.
-    + erewrite iter_sepcon_func_strong; eauto.
-      unfold remove_Znth; intros ? Hin.
-      rewrite Znth_replace_nth'; auto.
-      intro; subst.
-      apply in_app in Hin as [?%In_sublist_upto | ?%In_sublist_upto]; lia. }
-  { unfold ghost_list. erewrite <- ghost_op; [apply derives_refl|].
-    rewrite map_replace_nth.
-    apply (list_join_singleton(P := token_PCM)).
-    { rewrite map_length; lia. }
-    rewrite nth_map' with (d' := None) by lia.
-    rewrite Hi'; constructor. }
-Qed.
-
-Lemma invariant_dealloc : forall i P, invariant i P |-- emp.
-Proof.
-  intros; unfold invariant.
-  apply exp_left; intro g.
-  rewrite <- (emp_sepcon emp).
-  apply sepcon_derives; apply ghost_dealloc.
-Qed.
-
-Lemma ghost_is_pred_nonexpansive : forall g H, nonexpansive (fun P => ghost_is (singleton g
-  (existT (fun RA : Ghost => {a : @G RA | valid a}) unit_PCM
-           (exist (fun a : G => valid a) (tt : @G unit_PCM) H),
-        pred_of P))).
-Proof.
-  unfold nonexpansive.
-  intros ??????; split; intros ?????; simpl in *;
-    match goal with H : join_sub ?a ?b |- join_sub ?c ?b =>
-      assert (a = c) as <-; auto end; simpl;
-    rewrite !ghost_fmap_singleton; do 2 f_equal; simpl; f_equal;
-    extensionality; apply pred_ext; intros ? []; split; auto;
-    eapply H0; try apply necR_refl; auto; apply necR_level in H2; apply ext_level in H3; lia.
-Qed.
-
-Lemma agree_nonexpansive : forall g, nonexpansive (agree g).
-Proof.
-  intros; unfold agree, own.
-  apply exists_nonexpansive; intros.
-  unfold Own.
-  apply conj_nonexpansive; [apply const_nonexpansive|].
-  apply ghost_is_pred_nonexpansive.
-Qed.
-
-Lemma invariant_nonexpansive : forall N, nonexpansive (invariant N).
-Proof.
-  intros; unfold invariant.
-  apply exists_nonexpansive; intros.
-  apply sepcon_nonexpansive.
-  - apply const_nonexpansive.
-  - apply agree_nonexpansive.
-Qed.
-
-Lemma ghost_is_pred_nonexpansive2 : forall g H f,
-    nonexpansive f ->
-    nonexpansive (fun P => ghost_is (singleton g
-  (existT (fun RA : Ghost => {a : @G RA | valid a}) unit_PCM
-           (exist (fun a : G => valid a) (tt : @G unit_PCM) H),
-        pred_of (f P)))).
-Proof.
-  unfold nonexpansive.
-  intros ??????; split; intros ?????; specialize (H0 _ _ _ H1);
-  simpl in *; match goal with H : join_sub ?a ?b |- join_sub ?c ?b =>
-      assert (a = c) as <-; auto end; simpl;
-    rewrite !ghost_fmap_singleton; do 2 f_equal; simpl; f_equal;
-    extensionality; apply pred_ext; intros ? []; split; auto;
-    eapply H0; try apply necR_refl; auto; apply necR_level in H3; apply ext_level in H4; lia.
-Qed.
-
-Lemma agree_nonexpansive2 : forall g f,
-    nonexpansive f -> nonexpansive (fun a => agree g (f a)).
-Proof.
-  intros; unfold agree, own.
-  apply exists_nonexpansive; intros.
-  unfold Own.
-  apply conj_nonexpansive; [apply const_nonexpansive|].
-  now apply ghost_is_pred_nonexpansive2.
-Qed.
-
-Lemma invariant_nonexpansive2 : forall N f,
-    nonexpansive f -> nonexpansive (fun a => invariant N (f a)).
-Proof.
-  intros; unfold invariant.
-  apply exists_nonexpansive; intros.
-  apply sepcon_nonexpansive.
-  - apply const_nonexpansive.
-  - now apply agree_nonexpansive2.
-Qed.
-
-(* Consider putting rules for invariants and fancy updates in msl (a la ghost_seplog), and proofs
-   in veric (a la own). *)
-
-Lemma ghost_set_empty : forall g s,
-  (ghost_set g s = ghost_set g s * ghost_set g (Empty_set))%pred.
-Proof.
-  intros.
-  apply ghost_op.
-  hnf; split.
-  - constructor.
-    intros ? X; inv X.
-    inv H0.
-  - extensionality; apply prop_ext; split; intro X; [left | inv X]; auto.
-    inv H.
-Qed.
-
-Lemma wsat_empty_eq : (wsat = wsat * ghost_set g_en (Empty_set))%pred.
-Proof.
-  unfold wsat.
-  repeat (rewrite exp_sepcon1; f_equal; extensionality).
-  rewrite !sepcon_andp_prop1; f_equal.
-  rewrite !sepcon_assoc; f_equal; f_equal.
-  rewrite !(sepcon_comm (ghost_set _ _)), sepcon_assoc; f_equal.
-  rewrite sepcon_comm; apply ghost_set_empty.
-Qed.
-
-End Invariants.
-
-Lemma make_wsat : emp |-- |==> EX inv_names : invG, wsat.
-Proof.
-  unfold wsat.
-  eapply derives_trans with (Q := (_ * emp)%pred); [rewrite sepcon_emp; apply (ghost_alloc(RA := snap_PCM(ORD := list_order gname)) (Tsh, nil) NoneP); simpl; auto|].
-  eapply derives_trans; [apply bupd_frame_r | eapply derives_trans, bupd_trans; apply bupd_mono].
-  rewrite exp_sepcon1; apply exp_left; intro g_inv.
-  eapply derives_trans; [eapply sepcon_derives with (q' := (|==> _ * emp)%pred); [apply derives_refl |
-    rewrite sepcon_emp; apply (ghost_alloc(RA := list_PCM (exclusive_PCM unit)) nil NoneP); simpl; auto]|].
-  eapply derives_trans; [apply bupd_frame_l | eapply derives_trans, bupd_trans; apply bupd_mono].
-  rewrite exp_sepcon1, exp_sepcon2; apply exp_left; intro g_dis.
-  rewrite <- sepcon_assoc.
-  eapply derives_trans; [eapply sepcon_derives with (q' := (|==> _ * emp)%pred); [apply derives_refl |
-    rewrite sepcon_emp; apply (ghost_alloc(RA := set_PCM) Ensembles.Empty_set NoneP); simpl; auto]|].
-  eapply derives_trans; [apply bupd_frame_l | eapply derives_trans, bupd_trans; apply bupd_mono].
-  rewrite exp_sepcon1, !exp_sepcon2; apply exp_left; intro g_en.
-  rewrite <- sepcon_assoc.
-  eapply derives_trans, bupd_intro.
-  apply exp_right with {| g_inv := g_inv; g_dis := g_dis; g_en := g_en |}, exp_right with nil, exp_right with nil, exp_right with nil; simpl.
-  rewrite !sepcon_andp_prop1; apply andp_right.
-  - hnf; intros; simpl; auto.
-  - repeat apply sepcon_derives; auto.
-    replace (fun i : iname => match i with
-                                     | 0%nat | _ => None
-                                     end = Some false) with (@Ensembles.Empty_set nat); auto.
-    extensionality; apply prop_ext; split; intro H.
-    + inv H.
-    + hnf in H.
-      destruct x; inv H.
-Qed.
diff --git a/veric/jstep.v b/veric/jstep.v
index d15b581e2a..e8903ad461 100644
--- a/veric/jstep.v
+++ b/veric/jstep.v
@@ -35,10 +35,8 @@ intuition.
 Qed.*)
 End IdFSem.
 
-Require Import VST.veric.juicy_mem.
+(*Require Import VST.veric.juicy_mem.
 Require Import VST.veric.juicy_extspec.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.own.
 
 Module JuicyFSem.
 Program Definition t : FSem.t mem juicy_mem :=
@@ -47,5 +45,4 @@ Program Definition t : FSem.t mem juicy_mem :=
        ageable.level jm = S (ageable.level jm') /\
        ghost_of (m_phi jm') = ghost_approx jm' (ghost_of (m_phi jm)))
     _ _ _ _.
-End JuicyFSem.
-
+End JuicyFSem.*)
diff --git a/veric/juicy_base.v b/veric/juicy_base.v
index f7747aada7..3803c10026 100644
--- a/veric/juicy_base.v
+++ b/veric/juicy_base.v
@@ -1,11 +1,7 @@
 Require Export VST.veric.base.
-Require Export VST.msl.msl_standard.
-Require Export VST.veric.rmaps.
-
-Require Export VST.veric.rmaps_lemmas.
-
-Require Export VST.veric.compcert_rmaps.
-
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Export VST.veric.res_predicates.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 (* Module Mem : MEM := compcert.common.Memory.Mem. *)
 Export Mem.
 Open Scope Z.
diff --git a/veric/juicy_extspec.v b/veric/juicy_extspec.v
index 30a01fbadd..a463c80283 100644
--- a/veric/juicy_extspec.v
+++ b/veric/juicy_extspec.v
@@ -1,871 +1,226 @@
+From iris.bi Require Export derived_connectives.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.juicy_base.
 Require Import VST.sepcomp.semantics.
 Require Import VST.sepcomp.extspec.
 Require Import VST.sepcomp.step_lemmas.
 Require Import VST.veric.shares.
-Require Import VST.veric.juicy_safety.
-Require Import VST.veric.juicy_mem. (*VST.veric.juicy_mem_lemmas VST.veric.juicy_mem_ops.*)
+Require Import iris_ora.logic.ghost_map.
+Require Import VST.veric.juicy_mem.
+Require Import VST.veric.external_state.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 
-Require Import VST.veric.ghost_PCM. (*avoids doing Require Import VST.veric.initial_world.*)
-Require Import VST.veric.own.
-Require Import VST.veric.invariants.
 Require Import VST.veric.tycontext.
 
-Require Import VST.veric.age_to_resource_at.
-
 Local Open Scope nat_scope.
-Local Open Scope pred.
-Local Obligation Tactic := idtac.
-
-Record juicy_ext_spec (Z: Type) := {
-  JE_spec:> external_specification juicy_mem external_function Z;
-  JE_pre_hered: forall e t ge_s typs args z, hereditary age (ext_spec_pre JE_spec e t ge_s typs args z);
-  JE_pre_ext: forall e t ge_s typs args z a a', ext_order a a' ->
-    joins (ghost_of (m_phi a')) (Some (ext_ref z, NoneP) :: nil) ->
-    ext_spec_pre JE_spec e t ge_s typs args z a ->
-    ext_spec_pre JE_spec e t ge_s typs args z a';
-  JE_post_hered: forall e t ge_s tret rv z, hereditary age (ext_spec_post JE_spec e t ge_s tret rv z);
-  JE_post_ext: forall e t ge_s tret rv z, hereditary ext_order (ext_spec_post JE_spec e t ge_s tret rv z);
-  JE_exit_hered: forall rv z, hereditary age (ext_spec_exit JE_spec rv z);
-  JE_exit_ext: forall rv z, hereditary ext_order (ext_spec_exit JE_spec rv z)
-}.
-
-Class OracleKind := {
-  OK_ty : Type;
-  OK_spec: juicy_ext_spec OK_ty
-}.
 
 (*! The void ext_spec *)
-Definition void_spec T : external_specification juicy_mem external_function T :=
+Definition void_spec T : external_specification mem external_function T :=
     Build_external_specification
-      juicy_mem external_function T
-      (fun ef => False)
-      (fun ef Hef ge tys vl m z => False)
-      (fun ef Hef ge ty vl m z => False)
-      (fun rv m z => False).
-
-Definition ok_void_spec (T : Type) : OracleKind.
- refine (Build_OracleKind T (Build_juicy_ext_spec _ (void_spec T) _ _ _ _ _ _)).
-Proof.
-  simpl; intros; contradiction.
-  simpl; intros; contradiction.
-  simpl; intros; contradiction.
-  simpl; intros; contradiction.
-  simpl; intros; intros ? ? ? ?; contradiction.
-  simpl; intros; intros ? ? ? ?; contradiction.
-Defined.
-
-Definition j_initial_core {C} (csem: @CoreSemantics C mem)
-     (n: nat) (m: juicy_mem) (q: C) (m': juicy_mem) (v: val) (args: list val) 
-     : Prop :=
-  m' = m /\
-  semantics.initial_core csem n (m_dry m) q (m_dry m') v args.
-
-Definition j_at_external {C} (csem: @CoreSemantics C mem)
-   (q: C) (jm: juicy_mem) : option (external_function * list val) :=
-   semantics.at_external csem q (m_dry jm).
-
-Definition j_after_external {C} (csem: @CoreSemantics C mem)
-    (ret: option val) (q: C) (jm: juicy_mem) :=
-   semantics.after_external csem ret q (m_dry jm).
-
-Definition jstep {C} (csem: @CoreSemantics C mem)
-  (q: C) (jm: juicy_mem) (q': C) (jm': juicy_mem) : Prop :=
- corestep csem q (m_dry jm) q' (m_dry jm') /\ 
- resource_decay (nextblock (m_dry jm)) (m_phi jm) (m_phi jm') /\
- level jm = S (level jm') /\
- ghost_of (m_phi jm') = ghost_approx jm' (ghost_of (m_phi jm)).
-
-Definition j_halted {C} (csem: @CoreSemantics C mem)
-       (c: C) (i: int): Prop :=
-     halted csem c i.
-
-Lemma jstep_not_at_external {C} (csem: @CoreSemantics C mem):
-  forall m q m' q', jstep csem q m q' m' -> at_external csem q (m_dry m) = None.
-Proof.
-  intros.
-  destruct H as (? & ? & ? & ?). eapply corestep_not_at_external; eauto.
-Qed.
-
-Lemma jstep_not_halted  {C} (csem: @CoreSemantics C mem):
-  forall m q m' q' i, jstep csem q m q' m' -> ~j_halted csem q i.
-Proof.
-  intros. destruct H as (? & ? & ? & ?). eapply corestep_not_halted; eauto.
-Qed.
-
-(*Lenb: removed here. To be moved a more CLight-specific place
-Record jm_init_package: Type := {
-  jminit_m: Memory.mem;
-  jminit_prog: program;
-  jminit_G: tycontext.funspecs;
-  jminit_lev: nat;
-  jminit_init_mem: Genv.init_mem jminit_prog = Some jminit_m;
-  jminit_defs_no_dups:   list_norepet (prog_defs_names jminit_prog);
-  jminit_fdecs_match: match_fdecs (prog_funct jminit_prog) jminit_G
-}.
-
-Definition init_jmem {G} (ge: G) (jm: juicy_mem) (d: jm_init_package) :=
-  jm = initial_jm (jminit_prog d) (jminit_m d) (jminit_G d) (jminit_lev d)
-         (jminit_init_mem d) (jminit_defs_no_dups d) (jminit_fdecs_match d).
-*)
-Definition juicy_core_sem
-  {C} (csem: @CoreSemantics C mem) :
-   @CoreSemantics C juicy_mem :=
-  @Build_CoreSemantics _ juicy_mem
-    (j_initial_core csem)
-    (j_at_external csem)
-    (j_after_external csem)
-    (j_halted csem)
-    (jstep csem)
-    (jstep_not_halted csem)
-    (jstep_not_at_external csem)
-(*  (j_at_external_halted_excl csem)*).
+      mem external_function T
+      (fun ef => False%type)
+      (fun ef Hef ge tys vl m z => False%type)
+      (fun ef Hef ge ty vl m z => False%type)
+      (fun rv m z => False%type).
 
 Section upd_exit.
   Context {Z : Type}.
-  Variable spec : juicy_ext_spec Z.
+  Variable spec : ext_spec Z.
 
-  Definition upd_exit' (Q_exit : option val -> Z -> juicy_mem -> Prop) :=
+  Definition upd_exit' (Q_exit : option val -> Z -> mem -> Prop) :=
   {| ext_spec_type := ext_spec_type spec
    ; ext_spec_pre := ext_spec_pre spec
    ; ext_spec_post := ext_spec_post spec
    ; ext_spec_exit := Q_exit |}.
 
-  Definition upd_exit'' (ef : external_function) (x : ext_spec_type spec ef) ge :=
+  Definition upd_exit (ef : external_function) (x : ext_spec_type spec ef) ge :=
     upd_exit' (ext_spec_post spec ef x ge (sig_res (ef_sig ef))).
 
-  Program Definition upd_exit {ef : external_function} (x : ext_spec_type spec ef) ge
-   : juicy_ext_spec Z :=
-    Build_juicy_ext_spec _ (upd_exit'' _ x ge) _ _ _ _ _ _.
-  Next Obligation. intros. eapply JE_pre_hered; eauto. Qed.
-  Next Obligation. intros. eapply JE_pre_ext; eauto. Qed.
-  Next Obligation. intros. eapply JE_post_hered; eauto. Qed.
-  Next Obligation. intros. eapply JE_post_ext; eauto. Qed.
-  Next Obligation. intros. eapply JE_post_hered; eauto. Qed. 
-  Next Obligation. intros. eapply JE_post_ext; eauto. Qed.
 End upd_exit.
 
-Local Obligation Tactic := Tactics.program_simpl.
-
-Program Definition juicy_mem_op (P : pred rmap) : pred juicy_mem :=
-  fun jm => P (m_phi jm).
- Next Obligation.
-  split; repeat intro.
-  apply age1_juicy_mem_unpack in H.
-  destruct H.
-  eapply pred_hereditary; eauto.
-
-  destruct H; eapply pred_upclosed; eauto.
- Qed.
-
-Lemma age_resource_decay:
-   forall b jm1 jm2 jm1' jm2',
-        resource_decay b jm1 jm2 ->
-        age jm1 jm1' -> age jm2 jm2' ->
-        level jm1 = S (level jm2) ->
-        resource_decay b jm1' jm2'.
-Proof.
-  unfold resource_decay; intros.
-  rename H2 into LEV.
-  destruct H as [H' H].
-  split.
-  {
-    clear H.
-    apply age_level in H0; apply age_level in H1.
-    rewrite H0 in *; rewrite H1 in *. inv LEV. rewrite H2.
-    clear. forget (level jm2') as n. lia.
-  }
-  intro l.
-  specialize (H l).
-  destruct H.
-  split.
-  {
-    intro.
-    specialize (H H3).
-    erewrite <- necR_NO; eauto.  constructor 1; auto.
-  }
-  destruct H2 as [?|[?|[?|?]]].
-  + left.
-    clear H. unfold age in *.
-    rewrite (age1_resource_at _ _ H0 l (jm1 @ l)); [ | symmetry; apply resource_at_approx].
-    rewrite (age1_resource_at _ _ H1 l (jm2 @ l)); [ | symmetry; apply resource_at_approx].
-    rewrite <- H2.
-    rewrite resource_fmap_fmap.
-    rewrite resource_fmap_fmap.
-    f_equal.
-    - change R.approx with approx.
-      rewrite approx_oo_approx'; [rewrite approx_oo_approx'; auto |].
-      * apply age_level in H0; apply age_level in H1.
-        unfold rmap  in *;
-        forget (level jm1) as j1. forget (level jm1') as j1'. forget (level jm2) as j2. forget (level jm2') as j2'.
-        subst; lia.
-      * apply age_level in H0; apply age_level in H1.
-        unfold rmap in *.
-        forget (level jm1) as j1. forget (level jm1') as j1'. forget (level jm2) as j2. forget (level jm2') as j2'.
-        subst; lia.
-    - change R.approx with approx.
-      rewrite approx'_oo_approx; [rewrite approx'_oo_approx; auto |].
-      * apply age_level in H0; apply age_level in H1.
-        unfold rmap  in *;
-        forget (level jm1) as j1. forget (level jm1') as j1'. forget (level jm2) as j2. forget (level jm2') as j2'.
-        subst; lia.
-      * apply age_level in H0; apply age_level in H1.
-        unfold rmap in *.
-        forget (level jm1) as j1. forget (level jm1') as j1'. forget (level jm2) as j2. forget (level jm2') as j2'.
-        subst; lia.
-  + right.
-    destruct H2 as [sh [wsh [v [v' [? ?]]]]].
-    left; exists sh, wsh, v,v'.
-    split.
-    - apply age_level in H1.
-      unfold rmap in *.
-      forget (@level R.rmap R.ag_rmap jm2) as j2.
-      forget (@level R.rmap R.ag_rmap jm2') as j2'. subst j2.
-      clear - H2 H0 LEV.
-      revert H2; case_eq (jm1 @ l); intros; inv H2.
-      pose proof (necR_YES jm1 jm1' l sh r (VAL v) p (rt_step _ _ _ _ H0) H).
-      rewrite H1.
-      simpl. rewrite preds_fmap_fmap.
-      apply age_level in H0.
-      rewrite approx_oo_approx'.
-        2: rewrite H0 in *; inv LEV; lia.
-      rewrite approx'_oo_approx.
-        2: rewrite H0 in *; inv LEV; lia.
-      f_equal. apply proof_irr.
-      rewrite H5.
-      rewrite <- (approx_oo_approx' j2' (S j2')) at 1 by auto.
-      rewrite <- (approx'_oo_approx j2' (S j2')) at 2 by auto.
-      rewrite <- preds_fmap_fmap; rewrite H5. rewrite preds_fmap_NoneP. auto. 
-    - pose proof (age1_YES _ _ l sh (writable0_readable wsh) (VAL v') H1).
-      rewrite H4 in H3. auto.
-  + destruct H2 as [? [v ?]]; right; right; left.
-    split; auto. exists v.   apply (age1_YES _ _ l _ _ _ H1) in H3. auto.
-  + right; right; right.
-    destruct H2 as [v [pp [? ?]]]. exists v. econstructor; split; auto. 
-    pose proof (age1_resource_at _ _ H0 l (YES Share.top readable_share_top(VAL v) pp)).
-    rewrite H4.
-    simpl. reflexivity.
-    rewrite <- (resource_at_approx jm1 l).
-    rewrite H2. reflexivity.
-    assert (necR jm2 jm2'). apply laterR_necR. constructor. auto.
-    apply (necR_NO _ _ l Share.bot bot_unreadable H4). auto.
-Qed.
-
-Lemma necR_PURE' phi0 phi k p adr :
-  necR phi0 phi ->
-  phi @ adr = PURE k p ->
-  (*a stronger theorem is possible -- this one doesn't relate p, pp*)
-  exists pp, phi0 @ adr = PURE k pp.
-Proof.
-  intros Hnec H.
-  case_eq (phi0 @ adr). 
-  { intros. eapply necR_NO in Hnec; try eassumption. 
-    rewrite Hnec in H0. rewrite H0 in H. congruence. }
-  { intros. eapply necR_YES in Hnec; eauto. rewrite Hnec in H. congruence. }
-  { generalize (necR_level _ _ Hnec); intros Hlev.
-    intros. eapply necR_PURE in Hnec; eauto.
-    rewrite Hnec in H. inversion H. subst. eexists. eauto. }
-Qed.
-
-Definition jm_update m m' := m_dry m' = m_dry m /\ level m' = level m /\
-  resource_at (m_phi m') = resource_at (m_phi m).
-
-Lemma jm_update_age: forall m1 m2 m1', jm_update m1 m2 -> age m1 m1' ->
-  exists m2', jm_update m1' m2' /\ age m2 m2'.
-Proof.
-  intros ??? (? & ? & ?) Hage.
-  pose proof (age_level _ _ Hage).
-  destruct (levelS_age m2 (level m1')) as (m2' & Hage2 & ?); [lia|].
-  exists m2'; repeat split; auto.
-  - rewrite <- (age_jm_dry Hage), <- (age_jm_dry Hage2); auto.
-  - extensionality l.
-    apply age_jm_phi in Hage; apply age_jm_phi in Hage2.
-    rewrite (age_resource_at Hage), (age_resource_at Hage2).
-    rewrite <- !level_juice_level_phi; congruence.
-Qed.
+Section mpred.
 
-Definition has_ext {Z} (ora : Z) : mpred.mpred := @own (ext_PCM _) 0 (Some (Tsh, Some ora), None) NoneP.
+Context {Σ : gFunctors}.
 
-Definition jm_bupd {Z} (ora : Z) P m := forall C : ghost,
-  (* use the external state to restrict the ghost moves *)
-  join_sub (Some (ext_ref ora, NoneP) :: nil) C ->
-  joins (ghost_of (m_phi m)) (ghost_approx m C) ->
-  exists m' : juicy_mem, joins (ghost_of (m_phi m')) ((ghost_approx m) C) /\
-    jm_update m m' /\ P m'.
-
-Lemma jm_bupd_ora : forall {Z} (ora : Z) (P : juicy_mem -> Prop) m,
-  (joins (ghost_of (m_phi m)) (Some (ext_ref ora, NoneP) :: nil) -> jm_bupd ora P m) ->
-  jm_bupd ora P m.
-Proof.
-  repeat intro.
-  apply H; auto.
-  eapply joins_comm, join_sub_joins_trans, joins_comm, H1.
-  destruct H0 as [? J]; eapply ghost_fmap_join in J; eexists; eauto.
-Qed.
-
-Lemma jm_bupd_intro: forall {Z} (ora : Z) (P : juicy_mem -> Prop) m, P m -> jm_bupd ora P m.
-Proof.
-  repeat intro.
-  eexists; split; eauto; repeat split; auto.
-Qed.
-
-Lemma jm_bupd_intro_strong: forall {Z} (ora : Z) (P : juicy_mem -> Prop) m, 
-  (joins (ghost_of (m_phi m)) (Some (ext_ref ora, NoneP) :: nil) -> P m) -> jm_bupd ora P m.
-Proof.
-  intros; apply jm_bupd_ora.
-  intros; apply jm_bupd_intro; auto.
-Qed.
-
-Lemma jm_bupd_mono_strong : forall {Z} (ora : Z) (P1 P2 : juicy_mem -> Prop) m, jm_bupd ora P1 m ->
-  (forall m', jm_update m m' -> joins (ghost_of (m_phi m')) (Some (ext_ref ora, NoneP) :: nil) -> P1 m' -> P2 m') ->
-  jm_bupd ora P2 m.
-Proof.
-  intros ?????? Hmono.
-  intros ? HC J.
-  destruct (H _ HC J) as (? & J' & ? & ?).
-  do 2 eexists; eauto; split; auto.
-  apply Hmono; auto.
-  eapply joins_comm, join_sub_joins_trans, joins_comm, J'.
-  destruct HC as [? Je]; eapply ghost_fmap_join in Je; eexists; eauto.
-Qed.
-
-Lemma jm_bupd_mono : forall {Z} (ora : Z) (P1 P2 : juicy_mem -> Prop) m, jm_bupd ora P1 m ->
-  (forall m', jm_update m m' -> P1 m' -> P2 m') -> jm_bupd ora P2 m.
-Proof.
-  intros; eapply jm_bupd_mono_strong; eauto.
-Qed.
-
-Lemma ext_join_approx : forall {Z} (z : Z) n g,
-  joins g (Some (ghost_PCM.ext_ref z, NoneP) :: nil) ->
-  joins (ghost_fmap (approx n) (approx n) g) (Some (ghost_PCM.ext_ref z, NoneP) :: nil).
-Proof.
-  intros.
-  destruct H.
-  change (Some (ghost_PCM.ext_ref z, NoneP) :: nil) with
-    (ghost_fmap (approx n) (approx n) (Some (ghost_PCM.ext_ref z, NoneP) :: nil)).
-  eexists; apply ghost_fmap_join; eauto.
-Qed.
+Section juicy_safety.
+  Context {G C Z:Type}.
+  Context {genv_symb: G -> injective_PTree Values.block}.
+  Context (Hcore:@CoreSemantics C mem).
+  Variable (Hspec : ext_spec Z).
+  Variable ge : G.
 
-Lemma ext_join_sub_approx : forall {Z} (z : Z) n g,
-  join_sub (Some (ghost_PCM.ext_ref z, NoneP) :: nil) g ->
-  join_sub (Some (ghost_PCM.ext_ref z, NoneP) :: nil) (ghost_fmap (approx n) (approx n) g).
-Proof.
-  intros.
-  destruct H.
-  change (Some (ghost_PCM.ext_ref z, NoneP) :: nil) with
-    (ghost_fmap (approx n) (approx n) (Some (ghost_PCM.ext_ref z, NoneP) :: nil)).
-  eexists; apply ghost_fmap_join; eauto.
-Qed.
+  Context `{!gen_heapGS share address resource Σ} `{!externalGS Z Σ} `{!invGS_gen hlc Σ}.
 
-Lemma ext_join_unapprox : forall {Z} (z : Z) n g,
-  joins (ghost_fmap (approx n) (approx n) g) (Some (ghost_PCM.ext_ref z, NoneP) :: nil) ->
-  joins g (Some (ghost_PCM.ext_ref z, NoneP) :: nil).
-Proof.
-  intros.
-  destruct H as (g' & J).
-  destruct g; [eexists; constructor|].
-  inv J.
-  exists (a3 :: g); repeat constructor.
-  destruct o; inv H4; constructor.
-  destruct p; inv H1; constructor; simpl in *; auto.
-  destruct p; simpl in *.
-  inv H0.
-  inv H1.
-  inj_pair_tac.
-  constructor; auto.
-  unfold NoneP; f_equal; auto.
-Qed.
+(* The closest match to the Iris approach would be for auth_heap to hold the true full CompCert mem,
+   and to run the underlying semantics without any permissions. But that's a poor fit for VST's approach
+   to soundness. Instead, our "authoritative" state is still just the current thread's view of the state. *)
 
-Lemma jm_bupd_ext : forall {Z} (ora : Z) (P : juicy_mem -> Prop) m m', jm_bupd ora P m ->
-  ext_order m m' ->
-  (forall a b, level a = level m -> ext_order a b -> joins (ghost_of (m_phi b)) (Some (ext_ref ora, NoneP) :: nil) ->
-      P a -> P b) ->
-  jm_bupd ora P m'.
-Proof.
-  intros ????? H [? Hext] Hclosed ? Hora H1.
-  apply rmap_order in Hext as (Hl & Hr & [? J]).
-  destruct H1 as [d J'].
-  destruct (join_assoc J J') as (c' & ? & Jc').
-  eapply ghost_fmap_join in Jc'; rewrite ghost_of_approx in Jc'.
-  destruct (H c') as (m'' & Jm'' & (? & Hl'' & ?) & ?).
-  { eapply ext_join_sub_approx in Hora.
-    eapply join_sub_trans; eauto.
-    eexists; eauto. }
-  { rewrite level_juice_level_phi; eauto. }
-  assert (level m'' = level m') as Hl'.
-  { rewrite <- !level_juice_level_phi in *; congruence. }
-  exists m''; repeat split; auto; try congruence.
-  eapply join_sub_joins'; eauto.
-  { apply join_sub_refl. }
-  eapply ghost_fmap_join in H1; rewrite ghost_fmap_fmap, 2approx_oo_approx in H1.
-  rewrite <- Hl'', Hl'; eexists; eauto.
-Qed.
+Definition state_interp m z := mem_auth m ∗ ext_auth z.
 
-Lemma make_join_ext : forall {Z} (ora : Z) a c n,
-  join_sub (Some (ext_ref ora, NoneP) :: nil) c ->
-  joins (ghost_fmap (approx n) (approx n) a) (ghost_fmap (approx n) (approx n) c) ->
-  join_sub (Some (ext_ref ora, NoneP) :: nil) (make_join a c).
-Proof.
-  destruct a; auto; simpl.
-  intros ?? [? HC] [? J].
-  inv J.
-  { destruct c; inv H1; inv HC. }
-  destruct c; inv H1.
-  inv H2.
-  { destruct o; inv H0; inv HC.
-    * eexists; constructor; constructor.
-    * eexists; constructor; eauto; constructor. }
-  { destruct o0; inv H1; inv HC.
-    inv H3. }
-  destruct o as [[]|], o0 as [[]|]; inv H; inv H0.
-  destruct a0; inv H1; simpl in *.
-  inv H0.
-  assert (@ghost.valid (ext_PCM Z) (None, None)) as Hv.
-  { simpl; auto. }
-  inv HC.
-  - eexists; constructor; constructor.
-    destruct p; inv H1; inj_pair_tac.
-    instantiate (1 := (existT _ (ext_PCM Z) (exist _ _ Hv), _)); repeat constructor; simpl.
-    rewrite <- H0; auto.
-  - inv H6.
-    + destruct p; inv H1; inj_pair_tac.
-      eexists; constructor; constructor.
-      instantiate (1 := (existT _ (ext_PCM Z) (exist _ _ Hv), _)); repeat constructor; simpl.
-      rewrite <- H0; auto.
-    + destruct a0; inv H5; simpl in *.
-      inv H2.
-      destruct p; inv H1; inj_pair_tac.
-      eexists; constructor; constructor.
-      instantiate (1 := (_, _)); constructor; eauto; simpl.
-      constructor; eauto.
-      unfold NoneP; f_equal.
-      rewrite <- H1; auto.
-Qed.
-
-Lemma jm_bupd_age : forall {Z} (ora : Z) (P : juicy_mem -> Prop) m m', jm_bupd ora P m ->
-  age m m' -> jm_bupd ora (fun m => exists m0, age m0 m /\ P m0) m'.
-Proof.
-  unfold jm_bupd; intros.
-  rewrite (age1_ghost_of _ _ (age_jm_phi H0)) in H2.
-  apply ghost_joins_approx in H2 as [J ?].
-  rewrite <- (age_level _ _ H0) in *.
-  rewrite level_juice_level_phi, ghost_of_approx in J.
-  apply H in J as (b & ? & ? & ?).
-  apply H2 in H3.
-  eapply jm_update_age in H4 as (b' & ? & Hage'); eauto.
-  exists b'; split; eauto.
-  rewrite (age1_ghost_of _ _ (age_jm_phi Hage')).
-  rewrite <- level_juice_level_phi; destruct H4 as (? & -> & _); auto.
-  { eapply make_join_ext; eauto. }
-Qed.
+(* We could bring this more in line with weakestpre, but weakestpre doesn't give us control over the
+   masks, so we can't restrict updates around steps. *)
+Program Definition jsafe_pre
+    (jsafe : coPset -d> Z -d> C -d> iPropO Σ) : coPset -d> Z -d> C -d> iPropO Σ := λ E z c,
+  |={E}=> ∀ m, state_interp m z -∗
+      (∃ i, ⌜halted Hcore c i ∧ ext_spec_exit Hspec (Some (Vint i)) z m⌝) ∨
+      (|={E}=> ∃ c' m', ⌜corestep Hcore c m c' m'⌝ ∧ state_interp m' z ∗ ▷ jsafe E z c') ∨
+      (∃ e args x, ⌜at_external Hcore c m = Some (e, args) ∧ ext_spec_pre Hspec e x (genv_symb ge) (map proj_xtype (sig_args (ef_sig e))) args z m⌝ ∧
+         ▷ (∀ ret m' z', ⌜Val.has_type_list args (map proj_xtype (sig_args (ef_sig e))) ∧ Builtins0.val_opt_has_rettype ret (sig_res (ef_sig e))⌝ →
+          ⌜ext_spec_post Hspec e x (genv_symb ge) (sig_res (ef_sig e)) ret z' m'⌝ → |={E}=>
+          ∃ c', ⌜after_external Hcore ret c m' = Some c'⌝ ∧ state_interp m' z' ∗ jsafe E z' c')).
 
-Lemma ext_join_sub : forall (a b : rmap), ext_order a b -> join_sub a b.
+Local Instance jsafe_pre_contractive : Contractive jsafe_pre.
 Proof.
-  intros.
-  rewrite rmap_order in H.
-  destruct H as (? & ? & g & ?).
-  destruct (make_rmap (resource_at (core a)) (own.ghost_approx a g) (level a)) as (c & Hl & Hr & Hg).
-  { extensionality l; unfold compose.
-    rewrite <- level_core.
-    apply resource_at_approx. }
-  { rewrite ghost_fmap_fmap, approx_oo_approx; auto. }
-  exists c; apply resource_at_join2; auto.
-  - congruence.
-  - intros; rewrite Hr, <- core_resource_at, H0.
-    apply join_comm, core_unit.
-  - rewrite Hg, <- (ghost_of_approx a), <- (ghost_of_approx b), <- H.
-    apply ghost_fmap_join; auto.
+  rewrite /jsafe_pre => n jsafe jsafe' Hsafe E z c.
+  do 13 f_equiv.
+  - f_contractive; repeat f_equiv. apply Hsafe.
+  - f_contractive; repeat f_equiv. apply Hsafe.
 Qed.
 
-Lemma necR_jm_dry : forall m1 m2, necR m1 m2 -> m_dry m1 = m_dry m2.
-Proof.
-  induction 1; auto.
-  - apply age_jm_dry; auto.
-  - congruence.
-Qed.
+Local Definition jsafe_def : coPset -> Z -> C -> iProp Σ := fixpoint jsafe_pre.
+Local Definition jsafe_aux : seal (@jsafe_def). Proof. by eexists. Qed.
+Definition jsafe := jsafe_aux.(unseal).
+Local Lemma jsafe_unseal : jsafe = jsafe_def.
+Proof. rewrite -jsafe_aux.(seal_eq) //. Qed.
 
-Lemma age_to_dry : forall n m, m_dry (age_to.age_to n m) = m_dry m.
-Proof.
-  intros.
-  unfold age_to.age_to.
-  remember (level _ - _) as a eqn: Ha; clear Ha.
-  revert m; induction a; simpl; auto; intros.
-  unfold age_to.age1'; simpl.
-  destruct (age1_juicy_mem _) eqn: Hage; auto.
-  apply age1_juicy_mem_unpack in Hage as [? <-]; auto.
-Qed.
+(* basic facts following iris.program_logic.weakestpre *)
+Lemma jsafe_unfold E z c : jsafe E z c ⊣⊢ jsafe_pre jsafe E z c.
+Proof. rewrite jsafe_unseal. apply (fixpoint_unfold jsafe_pre). Qed.
 
-Lemma age_to_phi : forall n m, m_phi (age_to.age_to n m) = age_to.age_to n (m_phi m).
+Lemma fupd_jsafe E z c : (|={E}=> jsafe E z c) ⊢ jsafe E z c.
 Proof.
-  intros.
-  unfold age_to.age_to.
-  rewrite level_juice_level_phi.
-  remember (level _ - _) as a eqn: Ha; clear Ha.
-  revert m; induction a; simpl; auto; intros.
-  rewrite <- IHa.
-  unfold age_to.age1'; simpl.
-  destruct (age1 (m_phi _)) eqn: Hage.
-  - edestruct can_age1_juicy_mem as [? Hage']; eauto.
-    setoid_rewrite Hage'.
-    apply age_jm_phi in Hage'.
-    unfold age in Hage'; congruence.
-  - rewrite age1_juicy_mem_None2; auto.
+  rewrite jsafe_unfold /jsafe_pre. iIntros ">$".
 Qed.
 
-Lemma necR_jm_phi : forall m1 m2, necR m1 m2 <-> m_dry m1 = m_dry m2 /\ necR (m_phi m1) (m_phi m2).
+Lemma jsafe_mask_mono E1 E2 z c : E1 ⊆ E2 → jsafe E1 z c ⊢ jsafe E2 z c.
 Proof.
-  split.
-  - intros; split; [apply necR_jm_dry; auto|].
-    induction H; auto.
-    + constructor; apply age_jm_phi; auto.
-    + eapply rt_trans; eauto.
-  - intros [].
-    remember (m_phi m1) as jm1; remember (m_phi m2) as jm2.
-    generalize dependent m2; generalize dependent m1.
-    induction H0; intros; subst; auto.
-    + constructor.
-      apply age1_juicy_mem_unpack''; auto.
-    + erewrite juicy_mem_ext; [apply rt_refl | ..]; auto.
-    + assert (m_phi (age_to.age_to (level y) m1) = y).
-      { rewrite age_to_phi.
-        symmetry; apply age_to.necR_age_to; auto. }
-      eapply rt_trans; [apply (IHclos_refl_trans1 _ eq_refl (age_to.age_to (level y) m1)) | apply IHclos_refl_trans2]; auto;
-        rewrite age_to_dry; auto.
+  iIntros (?) "H". iLöb as "IH" forall (z c).
+  rewrite !jsafe_unfold /jsafe_pre.
+  iMod (fupd_mask_subseteq E1) as "Hclose"; first done; iMod "H"; iMod "Hclose" as "_".
+  iIntros "!>" (?) "?"; iDestruct ("H" with "[$]") as "[H | [H | H]]".
+  - by iLeft.
+  - iRight; iLeft.
+    iMod (fupd_mask_subseteq E1) as "Hclose"; first done; iMod "H"; iMod "Hclose" as "_".
+    iDestruct "H" as (???) "[??]"; iIntros "!>".
+    iExists _, _; iSplit; first done.
+    iFrame; by iApply "IH".
+  - iRight; iRight.
+    iDestruct "H" as (????) "H".
+    iExists _, _, _; iSplit; first done.
+    iIntros "!>" (????) "Hext".
+    iMod (fupd_mask_subseteq E1) as "Hclose"; first done; iMod ("H" with "[%] Hext") as "H'"; first done; iMod "Hclose" as "_".
+    iIntros "!>".
+    iDestruct "H'" as (??) "[??]"; iExists _; iFrame "%"; iFrame.
+    by iApply "IH".
 Qed.
 
-(* Just like we reserve ghost name 0 for the external ghost, we reserve 1-3 for invariants/world satisfaction.
-  We'll have to prove that this isn't vacuous somewhere in the soundness proof.
-  We could delay the instantiation and be generic in inv_names, but since we know we'll always need it and we get to allocate it
-  before the program starts, there's no reason to delay it. *)
-#[(*export, after Coq 8.13*)global] Instance inv_names : invG := { g_inv := 1%nat; g_en := 2%nat; g_dis := 3%nat}.
-
-Definition jm_fupd {Z} (ora : Z) (E1 E2 : Ensembles.Ensemble gname) P m :=
-  forall m' w z, necR m m' -> join (m_phi m') w (m_phi z) -> mem_sub (m_dry m') (m_dry z) ->
-    app_pred (wsat * ghost_set g_en E1) w ->
-  jm_bupd ora (fun z2 => level z2 = 0 \/ exists m2 w2, join (m_phi m2) w2 (m_phi z2) /\
-    mem_sub (m_dry m2) (m_dry z2) /\
-    app_pred (wsat * ghost_set g_en E2) w2 /\ P m2) z.
-
-Lemma jm_fupd_ora : forall {Z} (ora : Z) E1 E2 (P : juicy_mem -> Prop) m,
-  (joins (ghost_of (m_phi m)) (Some (ext_ref ora, NoneP) :: nil) -> jm_fupd ora E1 E2 P m) ->
-  jm_fupd ora E1 E2 P m.
-Proof.
-  intros ??????????????.
-  apply jm_bupd_ora; intros J.
-  eapply H; eauto.
-  eapply join_sub_joins_trans in J; [|eexists; apply ghost_of_join; eauto].
-  erewrite necR_ghost_of in J by (apply necR_jm_phi; eauto).
-  apply ext_join_unapprox in J; auto.
-Qed.
+(** Proofmode class instances *)
+Section proofmode_classes.
+  Implicit Types P Q : iProp Σ.
 
-Lemma jm_fupd_intro: forall {Z} (ora : Z) E (P : juicy_mem -> Prop) m (HP : forall a b, P a -> necR a b -> P b),
-  P m -> jm_fupd ora E E P m.
-Proof.
-  intros.
-  intros ???????.
-  apply jm_bupd_intro; eauto 8.
-Qed.
+  Global Instance is_except_0_jsafe E z c : IsExcept0 (jsafe E z c).
+  Proof. by rewrite /IsExcept0 -{2}fupd_jsafe -except_0_fupd -fupd_intro. Qed.
 
-Lemma jm_fupd_intro_strong: forall {Z} (ora : Z) E (P : juicy_mem -> Prop) m (HP : forall a b, P a -> necR a b -> P b),
-  (joins (ghost_of (m_phi m)) (Some (ext_ref ora, NoneP) :: nil) -> P m) -> jm_fupd ora E E P m.
-Proof.
-  intros.
-  apply jm_fupd_ora; intros.
-  apply jm_fupd_intro; auto.
-Qed.
+  Global Instance elim_modal_bupd_jsafe p P E z c :
+    ElimModal Logic.True p false (|==> P) P (jsafe E z c) (jsafe E z c).
+  Proof.
+    by rewrite /ElimModal bi.intuitionistically_if_elim
+      (bupd_fupd E) fupd_frame_r bi.wand_elim_r fupd_jsafe.
+  Qed.
 
-Lemma jm_fupd_age : forall {Z} (ora : Z) E1 E2 (P : juicy_mem -> Prop) m m', jm_fupd ora E1 E2 P m ->
-  age m m' -> jm_fupd ora E1 E2 P m'.
-Proof.
-  intros.
-  intros ???????.
-  eapply H; [| eauto | eauto | eauto].
-  eapply necR_trans; [|eauto].
-  constructor; auto.
-Qed.
+  Global Instance elim_modal_fupd_jsafe p P E z c :
+    ElimModal Logic.True p false (|={E}=> P) P (jsafe E z c) (jsafe E z c).
+  Proof.
+    by rewrite /ElimModal bi.intuitionistically_if_elim
+      fupd_frame_r bi.wand_elim_r fupd_jsafe.
+  Qed.
 
-Lemma jm_fupd_mono_strong : forall {Z} (ora : Z) E1 E2 (P1 P2 : juicy_mem -> Prop) m, jm_fupd ora E1 E2 P1 m ->
-  (forall m', level m' <= level m -> joins (ghost_of (m_phi m')) (Some (ext_ref ora, NoneP) :: nil) -> P1 m' -> P2 m') ->
-  jm_fupd ora E1 E2 P2 m.
-Proof.
-  intros ???????? Hmono.
-  intros ??? Hlater J ? HW.
-  eapply H in HW; eauto.
-  eapply jm_bupd_mono_strong; eauto.
-  intros ?? J' [|(? & ? & J2 & ? & ? & ?)]; eauto.
-  right; do 3 eexists; eauto; split; auto; split; auto.
-  apply Hmono; auto.
-  - apply necR_level in Hlater.
-    apply join_level in J as [Hl ?].
-    rewrite <- !level_juice_level_phi in Hl.
-    apply join_level in J2 as [Hl2 ?].
-    rewrite <- !level_juice_level_phi in Hl2.
-    destruct H1; lia.
-  - eapply join_sub_joins_trans; eauto.
-    eexists; apply ghost_of_join; eauto.
-Qed.
+  Global Instance add_modal_fupd_jsafe P E z c :
+    AddModal (|={E}=> P) P (jsafe E z c).
+  Proof. by rewrite /AddModal fupd_frame_r bi.wand_elim_r fupd_jsafe. Qed.
 
-Lemma jm_fupd_mono : forall {Z} (ora : Z) E1 E2 (P1 P2 : juicy_mem -> Prop) m, jm_fupd ora E1 E2 P1 m ->
-  (forall m', level m' <= level m -> P1 m' -> P2 m') -> jm_fupd ora E1 E2 P2 m.
-Proof.
-  intros; eapply jm_fupd_mono_strong; eauto.
-Qed.
+End proofmode_classes.
 
-Lemma jm_fupd_ext : forall {Z} (ora : Z) E1 E2 (P : juicy_mem -> Prop) m m', jm_fupd ora E1 E2 P m ->
-  ext_order m m' ->
-  (forall a b, level a <= level m -> ext_order a b -> joins (ghost_of (m_phi b)) (Some (ext_ref ora, NoneP) :: nil) ->
-      P a -> P b) ->
-  jm_fupd ora E1 E2 P m'.
+Lemma jsafe_local_step:
+  forall E ora s1 s2,
+  (forall m, corestep Hcore s1 m s2 m) ->
+  ▷jsafe E ora s2 ⊢
+  jsafe E ora s1.
 Proof.
-  intros ??????? H [? Hext] Hclosed ??? Hnec Hj ? Hwsat.
-  assert (exists z0, join (m_phi (age_to.age_to (level m'0) m)) w (m_phi z0) /\ ext_order z0 z) as (z0 & Hz0 & ?).
-  - eapply nec_ext_commut in Hext as [? Hext' Hnec']; [|apply necR_jm_phi; eauto].
-    eapply join_ext_commut in Hj as (z0 & ? & Hext''); eauto.
-    destruct (juicy_mem_resource z z0) as (jz0 & ? & ?); subst.
-    { apply rmap_order in Hext'' as (? & ? & ?); auto. }
-    apply age_to.necR_age_to in Hnec'.
-    apply rmap_order in Hext' as (Hl' & _); rewrite Hl' in Hnec'; subst.
-    rewrite age_to_phi in *.
-    exists jz0; split; auto; split; auto.
-  - assert (mem_sub (m_dry (age_to.age_to (level m'0) m)) (m_dry z0)) as Hmem'.
-    { rewrite age_to_dry; destruct H2 as [->].
-      erewrite H0, necR_jm_dry; eauto. }
-    specialize (H _ _ _ (age_to.age_to_necR _ _) Hz0 Hmem' Hwsat).
-    eapply jm_bupd_ext; [eapply H; eauto | eauto |].
-    apply rmap_order in Hext as (Hl & _); intros ??? [Hdry Hext] ? [? | (? & ? & Hsub & ? & ? & HP)].
-    { rewrite level_juice_level_phi in *.
-      apply rmap_order in Hext as (<- & ? & ?); auto. }
-    pose proof (ext_join_sub _ _ Hext) as [g Hsub'].
-    apply rmap_order in Hext as (_ & Hr' & _).
-    destruct (join_assoc (join_comm Hsub) Hsub') as (? & J' & ?%join_comm).
-    assert (forall c d, join c g d -> resource_at c = resource_at d) as Hid.
-    { intros ?? J1; extensionality l.
-      apply (resource_at_join _ _ _ l) in J1.
-      apply (resource_at_join _ _ _ l) in Hsub'.
-      rewrite Hr' in Hsub'.
-      apply join_comm, unit_identity in Hsub'.
-      eapply Hsub'; eauto. }
-    destruct (juicy_mem_resource x x1) as (? & ? & Hmem''); subst.
-    { symmetry; apply Hid; auto. }
-    right; do 3 eexists; eauto; split; auto.
-    { rewrite <- Hdry, Hmem''; auto. }
-    split; auto.
-    eapply Hclosed, HP.
-    + rewrite !level_juice_level_phi in *; rewrite Hl.
-      apply join_level in Hj as [].
-      destruct H2 as [? Hext]; apply rmap_order in Hext as (? & _).
-      apply join_level in Hsub as [].
-      apply necR_level in Hnec.
-      rewrite !level_juice_level_phi in *; lia.
-    + split; auto.
-      apply rmap_order.
-      split; [apply join_level in J' as []; auto|].
-      split; [|eexists; apply ghost_of_join; eauto]; auto.
-    + eapply join_sub_joins_trans; [eexists; apply ghost_of_join; eauto | auto].
+  intros ?????; iIntros "H".
+  rewrite (jsafe_unfold _ _ s1) /jsafe_pre.
+  iIntros "!>" (?) "?".
+  iRight; iLeft.
+  iIntros "!>".
+  iExists _, _; iSplit; first done.
+  by iFrame.
 Qed.
 
-Section juicy_safety.
-  Context {G C Z:Type}.
-  Context {genv_symb: G -> injective_PTree block}.
-  Context (Hcore:@CoreSemantics C mem).
-  Variable (Hspec : juicy_ext_spec Z).
-  Variable ge : G.
-
-  Definition Hrel m m' :=
-    (level m' < level m)%nat /\
-    pures_eq (m_phi m) (m_phi m').
-
-  (* try without N, using level instead *)
-  Inductive jsafeN_:
-    Z -> C -> juicy_mem -> Prop :=
-  | jsafeN_0: forall z c m, level m = 0 -> jsafeN_ z c m
-  (* c.f. iRC11's language, in which NA reads and writes are atomic
-     and can access invariants. All our concurrency features are
-     outside corestep/jstep, so they can provide their own specs
-     if they want to access invariants. So we just need to allow
-     fupds between steps. *)
-  | jsafeN_step:
-      forall z c m c' m',
-      jstep Hcore c m c' m' ->
-        (* For full generality, we'd parameterize by a mask E here, but that would
-           have to propagate all the way up to semax. *)
-        jm_fupd z Ensembles.Full_set Ensembles.Full_set (jsafeN_ z c') m' ->
-      jsafeN_ z c m
-  | jsafeN_external:
-      forall z c m e args x,
-      j_at_external Hcore c m = Some (e,args) ->
-      ext_spec_pre Hspec e x (genv_symb ge) (map proj_xtype (sig_args (ef_sig e))) args z m ->
-      (forall ret m' z'
-         (Hargsty : Val.has_type_list args (map proj_xtype (sig_args (ef_sig e))))
-         (Hretty : Builtins0.val_opt_has_rettype  ret (sig_res (ef_sig e))),
-         Hrel m m' ->
-         ext_spec_post Hspec e x (genv_symb ge) (sig_res (ef_sig e)) ret z' m' ->
-         exists c',
-           semantics.after_external Hcore ret c (m_dry m') = Some c' /\
-           jm_fupd z' Ensembles.Full_set Ensembles.Full_set (jsafeN_ z' c') m') ->
-      jsafeN_ z c m
-  | jsafeN_halted:
-      forall z c m i,
-      semantics.halted Hcore c i ->
-      ext_spec_exit Hspec (Some (Vint i)) z m ->
-      jsafeN_ z c m.
+Definition jstep E z c c' := ∀ m, state_interp m z ={E}=∗ ∃ m', ⌜corestep Hcore c m c' m'⌝ ∧ state_interp m' z ∗ ▷ jsafe E z c'.
 
-Lemma age_jstep : forall c m c' m' m1, jstep Hcore c m c' m' ->
-  age m m1 -> level m1 <> 0 -> exists m1', age m' m1' /\ jstep Hcore c m1 c' m1'.
-Proof.
-  unfold jstep.
-  intros ????? (? & ? & ? & Hg) Hage Hl.
-  destruct (level m') eqn: Hm'.
-  { apply age_level in Hage; lia. }
-  symmetry in Hm'; destruct (levelS_age _ _ Hm') as (m1' & Hage' & ?); subst.
-  exists m1'; split; auto.
-  rewrite <- (age_jm_dry Hage), <- (age_jm_dry Hage'); split; auto.
-  split; [|split].
-  - eapply age_resource_decay; eauto; try (apply age_jm_phi; auto).
-    rewrite <- !level_juice_level_phi; lia.
-  - apply age_level in Hage; lia.
-  - rewrite (age1_ghost_of _ _ (age_jm_phi Hage')), (age1_ghost_of _ _ (age_jm_phi Hage)), Hg.
-    rewrite !ghost_fmap_fmap.
-    apply age_level in Hage.
-    rewrite approx_oo_approx', approx'_oo_approx, approx_oo_approx', approx'_oo_approx; rewrite <- level_juice_level_phi; try lia; auto.
-Qed.
+Definition jstep_ex E z c := ∀ m, state_interp m z ={E}=∗ ∃ c' m', ⌜corestep Hcore c m c' m'⌝ ∧ state_interp m' z ∗ ▷ jsafe E z c'.
 
-Lemma age_pures_eq : forall m1 m2, age m1 m2 -> pures_eq m1 m2.
+Lemma jstep_exists : forall E z c c', jstep E z c c' ⊢ jstep_ex E z c.
 Proof.
-  split; [unfold pures_sub|]; intros l; erewrite (age1_resource_at _ _ H); try (symmetry; apply resource_at_approx);
-    destruct (m1 @ l); simpl; eauto.
+  intros; rewrite /jstep /jstep_ex.
+  iIntros "H" (?) "?".
+  iMod ("H" with "[$]") as (??) "?"; eauto.
 Qed.
 
-Lemma age_safe:
-  forall jm jm0, age jm0 jm ->
-  forall ora c,
-   jsafeN_ ora c jm0 ->
-   jsafeN_ ora c jm.
+Lemma jstep_mono : forall E z c1 c2 c', (forall m m', corestep Hcore c1 m c' m' -> corestep Hcore c2 m c' m') ->
+  jstep E z c1 c' ⊢ jstep E z c2 c'.
 Proof.
-  intros.
-  remember (level jm) as N.
-  revert c jm0 jm HeqN H H0; induction N; intros.
-  { constructor; auto. }
-  inv H0.
-  + apply age_level in H; congruence.
-  + edestruct age_jstep as (m1' & ? & Hstep); eauto.
-    { lia. }
-    eapply jsafeN_step; eauto.
-    eapply jm_fupd_mono; [eapply jm_fupd_age; eauto | auto].
-  + eapply jsafeN_external; eauto.
-    { unfold j_at_external in *.
-      rewrite <- (age_jm_dry H); eauto. }
-    { eapply JE_pre_hered; eauto. }
-    intros.
-    destruct (H3 ret m' z') as [c' [? ?]]; auto.
-    - assert (level (m_phi jm) < level (m_phi jm0)).
-      {
-        apply age_level in H.
-        do 2 rewrite <-level_juice_level_phi.
-        destruct H0.
-        rewrite H; lia.
-      }
-      destruct H0 as (?&?).
-      split; [do 2 rewrite <-level_juice_level_phi in H5; lia |].
-      eapply pures_eq_trans, H6.
-      { rewrite <- !level_juice_level_phi; lia. }
-      apply age_pures_eq, age_jm_phi; auto.
-    - exists c'; split; auto.
-  + unfold j_halted in *.
-    eapply jsafeN_halted; eauto.
-    eapply JE_exit_hered; eauto.
+  intros; rewrite /jstep.
+  iIntros "H" (?) "?".
+  iMod ("H" with "[$]") as (??) "?"; eauto 6.
 Qed.
 
-Lemma resource_decay_resource : forall b x x' y, resource_decay b x x' ->
-  level x = level y -> resource_at x = resource_at y ->
-  exists y', resource_decay b y y' /\ level y' = level x' /\
-    resource_at x' = resource_at y' /\ ghost_of y' = own.ghost_approx y' (ghost_of y).
+Lemma jsafe_step:
+  forall c E z,
+  jstep_ex E z c ⊢ jsafe E z c.
 Proof.
-  intros.
-  destruct (make_rmap (resource_at x') (own.ghost_approx (level x') (ghost_of y)) (level x')) as (y' & Hl & Hr & Hg).
-  { extensionality; apply resource_at_approx. }
-  { rewrite ghost_fmap_fmap, !approx_oo_approx; reflexivity. }
-  rewrite <- Hl in Hg.
-  exists y'; split; [|repeat split; auto].
-  unfold resource_decay in *.
-  destruct H.
-  rewrite Hr, <- H1, Hl, <- H0; auto.
+  intros; iIntros "H".
+  rewrite jsafe_unfold /jsafe_pre /jstep_ex.
+  iIntros "!>" (m) "?"; iRight; iLeft.
+  iMod ("H" with "[$]") as (???) "[??]".
+  iIntros "!>"; iExists _, _; iSplit; first done.
+  by iFrame.
 Qed.
 
-Lemma ext_jstep : forall c m c' m' m1, jstep Hcore c m c' m' ->
-  ext_order m m1 -> exists m1', ext_order m' m1' /\ jstep Hcore c m1 c' m1'.
+Lemma jsafe_step_forward_ex:
+  forall c E z
+    (Hhalt : forall i, ~halted Hcore c i) (Hext : forall m, at_external Hcore c m = None),
+    jsafe E z c ⊢ jstep_ex E z c.
 Proof.
-  unfold jstep.
-  intros ????? (? & Hr & ? & Hg) [Hdry Hext].
-  apply rmap_order in Hext as (Hl1 & Hr1 & ? & Hg1).
-  eapply resource_decay_resource in Hr as (m1' & ? & Hl' & Hr' & Hg'); eauto.
-  symmetry in Hr'; destruct (juicy_mem_resource _ _ Hr') as (jm' & ? & Hdry'); subst.
-  exists jm'.
-  rewrite <- Hdry, Hdry'; split.
-  { split; [congruence|].
-    apply rmap_order; split; auto.
-    split; auto.
-    rewrite Hg, Hg', Hl', level_juice_level_phi.
-    eexists; apply ghost_fmap_join; eauto. }
-  split; auto; split; auto; split; auto.
-  rewrite !level_juice_level_phi in *; lia.
+  intros; iIntros "H".
+  rewrite jsafe_unfold /jsafe_pre.
+  rewrite /jstep_ex; iIntros (m1) "?".
+  iMod ("H" with "[$]") as "[H | [H | H]]".
+  { iDestruct "H" as (??) "?"; exfalso; eapply Hhalt; eauto. }
+  iMod "H" as (???) "H".
+  iIntros "!>"; iExists _, _; iSplit; auto.
+  { iDestruct "H" as (??? (H & ?)) "?".
+    by rewrite Hext in H. }
 Qed.
 
-Lemma ext_safe:
-  forall jm jm0, ext_order jm0 jm ->
-  forall ora c,
-   joins (ghost_of (m_phi jm)) (Some (ext_ref ora, NoneP) :: nil) ->
-   jsafeN_ ora c jm0 ->
-   jsafeN_ ora c jm.
+Lemma jsafe_step_forward:
+  forall c c1 E z (Hc1 : forall m c' m', corestep Hcore c m c' m' -> c' = c1)
+    (Hhalt : forall i, ~halted Hcore c i) (Hext : forall m, at_external Hcore c m = None),
+    jsafe E z c ⊢ |={E}=> jstep E z c c1.
 Proof.
-  intros ????? Hext ?.
-  remember (level jm0) as N.
-  generalize dependent c; generalize dependent jm0; generalize dependent jm; induction N as [? IHN] using lt_wf_ind; intros.
-  inv H0.
-  - constructor. destruct H as [_ H]; apply rmap_order in H as [? _].
-    rewrite <- !level_juice_level_phi in *; congruence.
-  - eapply ext_jstep in H as (? & ? & ?); eauto.
-    eapply jsafeN_step; eauto.
-    eapply jm_fupd_ext; eauto; intros.
-    eapply IHN; eauto.
-    destruct H1 as (_ & _ & ? & _).
-    rewrite !level_juice_level_phi in *; lia.
-  - eapply jsafeN_external; eauto.
-    + unfold j_at_external in *.
-      destruct H as [<-]; eauto.
-    + eapply JE_pre_ext; eauto.
-    + intros.
-      apply H3; auto.
-      unfold Hrel in *.
-      destruct H0 as (? & ?).
-      destruct H as [_ H]; apply rmap_order in H as (? & Hr & _).
-      split; [rewrite !level_juice_level_phi in *; lia|].
-      unfold pures_eq, pures_sub in *.
-      rewrite Hr; auto.
-  - eapply jsafeN_halted; eauto.
-    eapply JE_exit_ext; eauto.
+  intros; iIntros "H".
+  rewrite jsafe_unfold /jsafe_pre.
+  iMod "H".
+  rewrite /jstep; iIntros "!>" (m1) "?".
+  iDestruct ("H" with "[$]") as "[H | [H | H]]".
+  { iDestruct "H" as (??) "?"; exfalso; eapply Hhalt; eauto. }
+  iMod "H" as (?? Hstep) "H".
+  rewrite -(Hc1 _ _ _ Hstep).
+  iIntros "!>"; iExists _; iSplit; done.
+  { iDestruct "H" as (??? (H & ?)) "?".
+    by rewrite Hext in H. }
 Qed.
 
-Lemma necR_safe : forall jm jm0, necR jm0 jm ->
-  forall ora c,
-   jsafeN_ ora c jm0 ->
-   jsafeN_ ora c jm.
-Proof.
-  induction 1; auto.
-  apply age_safe; auto.
-Qed.
-
-
-Lemma jsafe_corestep_backward:
-    forall c m c' m' z,
-    jstep Hcore c m c' m' ->
-    jsafeN_ z c' m' -> jsafeN_ z c m.
-  Proof.
-    intros; eapply jsafeN_step; eauto.
-    apply jm_fupd_intro; auto.
-    intros; eapply necR_safe; eauto.
-  Qed.
-
 (*  Lemma jsafe_corestepN_forward:
     corestep_fun Hcore ->
     forall z c m c' m' n n0,
@@ -888,7 +243,7 @@ Lemma jsafe_corestep_backward:
       apply join_comm, core_unit. }
     destruct H1 as (? & ? & ? & ?).
     eapply (IHn0 _ _ _ _ n).
-  Qed.*)
+  Qed.
 
   Lemma jsafe_step'_back2 :
     forall
@@ -914,222 +269,33 @@ Lemma jsafe_corestep_backward:
     simpl in H. destruct H as [c2 [m2 [STEP STEPN]]].
     specialize (IHn0 _ _ _ _ STEPN H0).
     solve[eapply jsafe_step'_back2; eauto].
-  Qed.
+  Qed.*)
 
   Lemma convergent_controls_jsafe :
-    forall m q1 q2,
-      (j_at_external Hcore q1 m = j_at_external Hcore q2 m) ->
-      (forall ret m q', semantics.after_external Hcore ret q1 m = Some q' ->
-                      semantics.after_external Hcore ret q2 m = Some q') ->
-      (semantics.halted Hcore q1 = semantics.halted Hcore q2) ->
-      (forall q' m', jstep Hcore q1 m q' m' ->
-                     jstep Hcore q2 m q' m') ->
-      (forall z, jsafeN_ z q1 m -> jsafeN_ z q2 m).
+    forall q1 q2
+      (Hat_ext : forall m, at_external Hcore q1 m = at_external Hcore q2 m)
+      (Hafter_ext : forall ret m q', after_external Hcore ret q1 m = Some q' ->
+                                     after_external Hcore ret q2 m = Some q')
+      (Hhalted : halted Hcore q1 = semantics.halted Hcore q2)
+      (Hstep : forall m q' m', corestep Hcore q1 m q' m' ->
+                             corestep Hcore q2 m q' m'),
+      (forall E z, jsafe E z q1 ⊢ jsafe E z q2).
   Proof.
     intros.
-    inv H3.
-    + constructor; auto.
-    + eapply jsafeN_step; eauto.
-    + eapply jsafeN_external; eauto.
-      rewrite <-H; eauto.
-      intros ??? Hargsty Hretty ? H8.
-      specialize (H6 _ _ _ Hargsty Hretty H3 H8).
-      destruct H6 as [c' [? ?]].
-      exists c'; split; auto.
-    + eapply jsafeN_halted; eauto.
-      rewrite <-H1; auto.
-  Qed.
-
-  Lemma wlog_jsafeN_gt0 : forall
-    z q m,
-    (level m > 0 -> jsafeN_ z q m) ->
-    jsafeN_ z q m.
-  Proof.
-    intros. destruct (level m) eqn: Hl. constructor; auto.
-    apply H. lia.
-  Qed.
-
-  Lemma jm_fupd_intro' : forall (ora : Z) E (c : C) m,
-    jsafeN_ ora c m ->
-    jm_fupd ora E E (jsafeN_ ora c) m.
-  Proof.
-    intros; apply jm_fupd_intro; auto.
-    intros; eapply necR_safe; eauto.
-  Qed.
-
-  Lemma jm_fupd_intro_strong' : forall (ora : Z) E (c : C) m,
-    (joins (ghost_of (m_phi m)) (Some (ext_ref ora, NoneP) :: nil) -> jsafeN_ ora c m) ->
-    jm_fupd ora E E (jsafeN_ ora c) m.
-  Proof.
-    intros; apply jm_fupd_intro_strong; auto.
-    intros; eapply necR_safe; eauto.
+    iIntros "H".
+    rewrite !jsafe_unfold /jsafe_pre.
+    iMod "H"; iIntros "!>" (?) "?"; iDestruct ("H" with "[$]") as "[H | [H | H]]".
+    - rewrite Hhalted; auto.
+    - iRight; iLeft.
+      iMod "H" as (?? H) "H".
+      apply Hstep in H; eauto.
+    - rewrite Hat_ext; iDestruct "H" as (????) "H".
+      iRight; iRight; iExists _, _, _; iSplit; first done.
+      iNext; iIntros (????) "Hpost".
+      iMod ("H" with "[%] Hpost") as (? Hafter) "Hpost"; first done.
+      apply Hafter_ext in Hafter; eauto.
   Qed.
 
 End juicy_safety.
 
-Lemma juicy_core_sem_preserves_corestep_fun
-  {C} (csem: @CoreSemantics C mem) :
-  corestep_fun csem ->
-  corestep_fun (juicy_core_sem csem).
-Proof.
-  intros determinism jm q jm1 q1 jm2 q2 step1 step2.
-  destruct step1 as [step1 [[ll1 rd1] [l1 g1]]].
-  destruct step2 as [step2 [[ll2 rd2] [l2 g2]]].
-  pose proof determinism _ _ _ _ _ _ step1 step2 as E.
-  injection E as <- E; f_equal.
-  apply juicy_mem_ext; auto.
-  assert (El: level jm1 = level jm2) by (clear -l1 l2; lia).
-  apply rmap_ext. now do 2 rewrite <-level_juice_level_phi; auto.
-  intros l.
-  specialize (rd1 l); specialize (rd2 l).
-  rewrite level_juice_level_phi in *.
-  destruct jm  as [m  phi  jmc  jmacc  jmma  jmall ].
-  destruct jm1 as [m1 phi1 jmc1 jmacc1 jmma1 jmall1].
-  destruct jm2 as [m2 phi2 jmc2 jmacc2 jmma2 jmall2].
-  simpl in *.
-  subst m2; rename m1 into m'.
-  destruct rd1 as [jmno [E1 | [[sh1 [rsh1 [v1 [v1' [E1 E1']]]]] | [[pos1 [v1 E1]] | [v1 [pp1 [E1 E1']]]]]]];
-  destruct rd2 as [_    [E2 | [[sh2 [rsh2 [v2 [v2' [E2 E2']]]]] | [[pos2 [v2 E2]] | [v2 [pp2 [E2 E2']]]]]]];
-  try pose proof jmno pos1 as phino; try pose proof (jmno pos2) as phino; clear jmno;
-    remember (phi  @ l) as x ;
-    remember (phi1 @ l) as x1;
-    remember (phi2 @ l) as x2;
-    subst.
-
-  - (* phi1: same   | phi2: same   *)
-    congruence.
-
-  - (* phi1: same   | phi2: update *)
-    rewrite <- E1, El.
-    rewrite El in E1.
-    rewrite E1 in E2.
-    destruct (jmc1 _ _ _ _ _ E2).
-    destruct (jmc2 _ _ _ _ _ E2').
-    congruence.
-
-  - (* phi1: same   | phi2: alloc  *)
-    exfalso.
-    rewrite phino in E1. simpl in E1.
-    specialize (jmacc1 l).
-    rewrite <- E1 in jmacc1.
-    simpl in jmacc1.
-    destruct (Share.EqDec_share Share.bot Share.bot) as [_ | F]; [ | congruence].
-    specialize (jmacc2 l).
-    rewrite E2 in jmacc2.
-    simpl in jmacc2.
-    rewrite jmacc1 in jmacc2.
-    clear -jmacc2. exfalso.
-    unfold perm_of_sh in *.
-    repeat if_tac in jmacc2; try congruence. contradiction Share.nontrivial.
-  - (* phi1: same   | phi2: free   *)
-    exfalso.
-    rewrite E2 in E1.
-    simpl in E1.
-    specialize (jmacc1 l).
-    rewrite <- E1 in jmacc1.
-    simpl in jmacc1.
-    specialize (jmacc2 l).
-    rewrite E2' in jmacc2.
-    simpl in jmacc2.
-    destruct (Share.EqDec_share Share.bot Share.bot) as [_ | F]; [ | congruence].
-    rewrite jmacc1 in jmacc2.
-    clear -jmacc2. exfalso.
-    unfold perm_of_sh in *.
-    repeat if_tac in jmacc2; try congruence. contradiction Share.nontrivial.
-  - (* phi1: update | phi2: same   *)
-    rewrite <- E2, <-El.
-    rewrite <-El in E2.
-    rewrite E2 in E1.
-    destruct (jmc1 _ _ _ _ _ E1').
-    destruct (jmc2 _ _ _ _ _ E1).
-    congruence.
-
-  - (* phi1: update | phi2: update *)
-    destruct (jmc1 _ _ _ _ _ E1').
-    destruct (jmc2 _ _ _ _ _ E2').
-    rewrite E1', E2'.
-    destruct (phi@l); inv E1; inv E2.
-    f_equal. apply proof_irr.
-  - (* phi1: update | phi2: alloc  *)
-    rewrite phino in E1.
-    simpl in E1.
-    inversion E1.
-
-  - (* phi1: update | phi2: free   *)
-    exfalso.
-    rewrite E2 in E1.
-    simpl in E1.
-    specialize (jmacc1 l).
-    rewrite E1' in jmacc1.
-    simpl in jmacc1.
-    specialize (jmacc2 l).
-    rewrite E2' in jmacc2.
-    simpl in jmacc2.
-    destruct (Share.EqDec_share Share.bot Share.bot) as [_ | F]; [ | congruence].
-    rewrite jmacc1 in jmacc2.
-    unfold perm_of_sh in *.
-    repeat if_tac in jmacc2; try congruence.  
-  - (* phi1: alloc  | phi2: same   *)
-    exfalso.
-    rewrite phino in E2. simpl in E2.
-    specialize (jmacc2 l).
-    rewrite <- E2 in jmacc2.
-    simpl in jmacc2.
-    destruct (Share.EqDec_share Share.bot Share.bot) as [_ | F]; [ | congruence].
-    specialize (jmacc1 l).
-    rewrite E1 in jmacc1.
-    simpl in jmacc1.
-    rewrite jmacc2 in jmacc1.
-    clear -jmacc1.
-    unfold perm_of_sh in *.
-    repeat if_tac in jmacc1; try congruence. contradiction Share.nontrivial. 
-  - (* phi1: alloc  | phi2: update *)
-    rewrite phino in E2.
-    simpl in E2.
-    inversion E2.
-
-  - (* phi1: alloc  | phi2: alloc  *)
-    destruct (jmc1 _ _ _ _ _ E1).
-    destruct (jmc2 _ _ _ _ _ E2).
-    congruence.
-
-  - (* phi1: alloc  | phi2: free   *)
-    congruence.
-
-  - (* phi2: free   | phi2: same   *)
-    exfalso.
-    rewrite E1 in E2.
-    simpl in E2.
-    specialize (jmacc2 l).
-    rewrite <- E2 in jmacc2.
-    simpl in jmacc2.
-    specialize (jmacc1 l).
-    rewrite E1' in jmacc1.
-    simpl in jmacc1.
-    destruct (Share.EqDec_share Share.bot Share.bot) as [_ | F]; [ | congruence].
-    rewrite jmacc2 in jmacc1.
-    clear -jmacc1. exfalso.
-    unfold perm_of_sh in *.
-    repeat if_tac in jmacc1; try congruence. contradiction Share.nontrivial.  
-  - (* phi2: free   | phi2: update *)
-    exfalso.
-    rewrite E1 in E2.
-    simpl in E2.
-    specialize (jmacc2 l).
-    rewrite E2' in jmacc2.
-    simpl in jmacc2.
-    specialize (jmacc1 l).
-    rewrite E1' in jmacc1.
-    simpl in jmacc1.
-    destruct (Share.EqDec_share Share.bot Share.bot) as [_ | F]; [ | congruence].
-    rewrite jmacc2 in jmacc1.
-    clear -jmacc1 rsh2.
-    unfold perm_of_sh in *.
-    repeat if_tac in jmacc1; try congruence.
-  - (* phi2: free   | phi2: alloc  *)
-    congruence.
-
-  - (* phi2: free   | phi2: free   *)
-    congruence.
-  - congruence.
-Qed.
+End mpred.
diff --git a/veric/juicy_mem.v b/veric/juicy_mem.v
index a879b6d266..40d1fa4f88 100644
--- a/veric/juicy_mem.v
+++ b/veric/juicy_mem.v
@@ -1,121 +1,217 @@
-Require Import VST.veric.base.
-Require Import VST.veric.Memory.
-Require Import VST.veric.juicy_base.
-Require Import VST.veric.shares.
+From iris.algebra Require Import agree.
+Require Import VST.sepcomp.mem_lemmas.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+From VST.veric Require Import base Memory juicy_base shares.
+From VST.shared Require Import shared resource_map gen_heap dshare.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
+
 Require Import VST.zlist.sublist.
-Import cjoins.
-Import compcert.lib.Maps.
+Export Values.
+
+Open Scope Z.
 
-Definition dec_share_nonidentity (sh: Share.t) : {~identity sh}+{identity sh} :=
-   (Sumbool.sumbool_not _ _ (dec_share_identity sh)).
+Lemma perm_order''_refl : forall s, Mem.perm_order'' s s.
+Proof.
+  destruct s; simpl; try done.
+  apply perm_refl.
+Qed.
+
+Lemma perm_order''_trans: forall a b c, Mem.perm_order'' a b ->  Mem.perm_order'' b c ->
+                             Mem.perm_order'' a c.
+Proof.
+   intros a b c H1 H2; destruct a, b, c; inversion H1; inversion H2; subst; eauto;
+           eapply perm_order_trans; eauto.
+Qed.
+
+Lemma perm_order''_None : forall a, Mem.perm_order'' a None.
+Proof. destruct a; simpl; auto. Qed.
 
 Definition perm_of_sh (sh: Share.t): option permission :=
   if writable0_share_dec sh
   then if eq_dec sh Share.top
-            then Some Freeable
-            else Some Writable
-    else if readable_share_dec sh
-         then Some Readable
-         else if eq_dec sh Share.bot
-                   then None
-              else Some Nonempty.
+          then Some Freeable
+          else Some Writable
+  else if readable_share_dec sh
+       then Some Readable
+       else if eq_dec sh Share.bot
+                 then None
+            else Some Nonempty.
 Functional Scheme perm_of_sh_ind := Induction for perm_of_sh Sort Prop.
 
-Definition contents_at (m: mem) (loc: address) : memval :=
-  ZMap.get (snd loc) (PMap.get (fst loc) (mem_contents m)).
+Definition perm_of_sh' (s : share_car) :=
+  match s with Share sh => perm_of_sh sh | ShareBot => None end.
 
-Definition contents_cohere (m: mem) (phi: rmap) :=
-  forall rsh sh v loc pp, phi @ loc = YES rsh sh (VAL v) pp -> contents_at m loc = v /\ pp=NoneP.
+Definition perm_of_dfrac dq :=
+  match dq with
+  | DfracOwn sh => perm_of_sh' sh
+  | DfracBoth sh => if Mem.perm_order'_dec (perm_of_sh' sh) Readable then perm_of_sh' sh else Some Readable
+  end.
 
-Definition valshare (r: resource) : share :=
-    match r with
-      | YES sh rsh _ _ => Share.glb Share.Rsh sh
-      | _ => Share.bot
-    end.
+(* Why do we force locks to nonempty? *)
+Definition perm_of_res (r: dfrac * option resource) :=
+  match r with
+  | (dq, Some (VAL _)) => perm_of_dfrac dq
+  | (DfracOwn (Share sh), _) => if eq_dec sh Share.bot then None else Some Nonempty
+  | (DfracBoth _, _) => Some Nonempty
+  | _ => None
+  end.
 
-Definition res_retain' (r: resource) : Share.t :=
- match r with
-  | NO sh _ => sh
-  | YES sh _ _ _ => Share.glb Share.Lsh sh
-  | PURE _ _ => Share.top
- end.
-
-Definition perm_of_res (r: resource) :=
-  (*  perm_of_sh (res_retain' r) (valshare r). *)
- match r with
- | NO sh _ => if eq_dec sh Share.bot then None else Some Nonempty
- | PURE _ _ => Some Nonempty
- | YES sh rsh (VAL _) _ => perm_of_sh sh
- | YES sh rsh _ _ => Some Nonempty
- end.
-
-(*To do a case analysis over perm_of_res, use:
-functional induction (perm_of_res_explicit r1) using perm_of_res_expl_ind
-We define the induction shceme bellow. *)
-Definition perm_of_res_lock_explicit
-             (r : compcert_rmaps.RML.R.resource):=
-    match r with
-    | compcert_rmaps.RML.R.NO _ _ => None
-    | compcert_rmaps.RML.R.YES sh _ (compcert_rmaps.VAL _) _ => None
-    | compcert_rmaps.RML.R.YES sh _ (compcert_rmaps.LK _ _) _ =>
-      if writable0_share_dec (Share.glb Share.Rsh sh)
-      then if eq_dec (Share.glb Share.Rsh sh) Share.top then Some Freeable else Some Writable
-      else if readable_share_dec (Share.glb Share.Rsh sh) then Some Readable else
-             if eq_dec  (Share.glb Share.Rsh sh) Share.bot then None else Some Nonempty
-    | compcert_rmaps.RML.R.YES sh _ (compcert_rmaps.FUN _ _) _ => None
-    | compcert_rmaps.RML.R.PURE _ _ => None
-    end.
+Lemma perm_of_res_cases : forall dq r, (exists v, r = Some (VAL v) /\ perm_of_res (dq, r) = perm_of_dfrac dq) \/
+  (forall v, r ≠ Some (VAL v)) /\ perm_of_res (dq, r) = if decide (dq = ε) then None else if decide (dq = DfracOwn ShareBot) then None else Some Nonempty.
+Proof.
+  intros; simpl.
+  destruct dq as [[|]|], r as [[| |]|]; eauto; right; if_tac; subst; simpl; destruct (decide _); try done;
+    by inv e.
+Qed.
+
+Lemma perm_of_sh_None: forall sh, perm_of_sh sh = None -> sh = Share.bot.
+Proof.
+  intros ?.
+  unfold perm_of_sh.
+  if_tac; if_tac; try discriminate.
+  if_tac; done.
+Qed.
+
+Lemma perm_of_sh_bot : perm_of_sh Share.bot = None.
+Proof.
+  rewrite /perm_of_sh.
+  pose proof bot_unreadable.
+  rewrite eq_dec_refl !if_false; auto.
+Qed.
+
+Lemma perm_of_sh_mono : forall (sh1 sh2 : shareR), (✓ (sh1 ⋅ sh2))%stdpp -> Mem.perm_order'' (perm_of_sh' (sh1 ⋅ sh2)) (perm_of_sh' sh1).
+Proof.
+  intros ?? H.
+  apply share_valid2_joins in H as (s1 & s2 & ? & -> & -> & H & J).
+  rewrite share_op_is_join in J.
+  rewrite H /= /perm_of_sh.
+  destruct (writable0_share_dec s1).
+  { eapply join_writable01 in w; eauto.
+    rewrite -> if_true by auto.
+    if_tac; if_tac; simpl; try constructor.
+    subst; apply join_Tsh in J as (-> & ->); done. }
+  if_tac; [repeat if_tac; constructor|].
+  destruct (readable_share_dec s1).
+  { eapply join_readable1 in r; eauto.
+    rewrite (if_true _ _ _ _ _ r); constructor. }
+  repeat if_tac; try constructor.
+  subst; apply join_Bot in J as (-> & ->); done.
+Qed.
+
+Lemma perm_order_antisym : forall p1 p2, ~perm_order p1 p2 -> perm_order p2 p1.
+Proof.
+  destruct p1, p2; try constructor; intros X; contradiction X; constructor.
+Qed.
+
+Lemma perm_order'_antisym : forall p1 p2, ~Mem.perm_order' p1 p2 -> Mem.perm_order'' (Some p2) p1.
+Proof.
+  destruct p1; simpl; auto; apply perm_order_antisym.
+Qed.
+
+Lemma perm_of_dfrac_mono : forall d1 d2, (✓d2)%stdpp -> d1 ≼ d2 -> Mem.perm_order'' (perm_of_dfrac d2) (perm_of_dfrac d1).
+Proof.
+  intros ?? Hv [d0 ->%leibniz_equiv].
+  destruct d1, d0; simpl in *; repeat if_tac; auto; try (apply perm_order''_refl || (by apply perm_of_sh_mono) || (by destruct Hv as (? & Hop & ?); apply perm_of_sh_mono; rewrite Hop) || constructor).
+  - destruct Hv as (? & Hv & ?); eapply perm_order''_trans, perm_of_sh_mono; [apply perm_order'_antisym|]; eauto; rewrite Hv //.
+  - destruct Hv as (? & Hv & ?); eapply perm_order''_trans, perm_of_sh_mono; [apply perm_order'_antisym|]; eauto; rewrite Hv //.
+  - destruct Hv as (? & Hv & ?); eapply perm_order''_trans, perm_of_sh_mono; [apply perm_order'_antisym|]; eauto; rewrite Hv //.
+Qed.
+
+Lemma perm_of_res_ne n d (r1 r2 : optionO (leibnizO resource)) : r1 ≡{n}≡ r2 -> perm_of_res (d, r1) = perm_of_res (d, r2).
+Proof.
+  intros H; inv H; try inv H0; auto.
+Qed.
 
-  Functional Scheme perm_of_res_lock_expl_ind := Induction for perm_of_res_lock_explicit Sort Prop.
-
-
-
-Definition perm_of_res' (r: resource) :=
-  (*  perm_of_sh (res_retain' r) (valshare r). *)
- match r with
- | NO sh _ => if eq_dec sh Share.bot then None else Some Nonempty
- | PURE _ _ => Some Nonempty
- | YES sh _ _ _ => perm_of_sh sh
- end.
-
-Definition perm_of_res_lock (r: resource) :=
-  (*  perm_of_sh (res_retain' r) (valshare r). *)
- match r with
- | YES sh rsh (LK _ _) _ => perm_of_sh (Share.glb Share.Rsh sh)
- | _ => None
- end.
-(*To do a case analysis over perm_of_res_lock, use:
-functional induction (perm_of_res_lock_explicit r1) using perm_of_res_lock_expl_ind
-We define the induction shceme bellow. *)
-Definition perm_of_res_explicit
-               (r : compcert_rmaps.RML.R.resource):=
-        match r with
-        | compcert_rmaps.RML.R.NO sh _ => if eq_dec sh Share.bot then None else Some Nonempty
-           | compcert_rmaps.RML.R.YES sh _ (compcert_rmaps.VAL _) _ =>
-             if writable0_share_dec sh
-             then if eq_dec sh Share.top then Some Freeable else Some Writable
-             else
-               if readable_share_dec sh
-               then Some Readable
-               else if eq_dec sh Share.bot then None else Some Nonempty
-           | compcert_rmaps.RML.R.YES sh _ (compcert_rmaps.LK _ _) _ => Some Nonempty
-           | compcert_rmaps.RML.R.YES sh _ (compcert_rmaps.FUN _ _) _ => Some Nonempty
-           | compcert_rmaps.RML.R.PURE _ _ => Some Nonempty
-        end.
-
-Functional Scheme perm_of_res_expl_ind := Induction for perm_of_res_explicit Sort Prop.
-
-
-
-(*Definition perm_of_res_lock (r: resource) :=
-  (*  perm_of_sh (res_retain' r) (valshare r). *)
- match r with
- | NO sh => if eq_dec sh Share.bot then None else Some Nonempty
- | PURE _ _ => Some Nonempty
- | YES rsh sh (LK _) _ => perm_of_sh rsh (pshare_sh sh)
- | YES rsh sh (CT _) _ => perm_of_sh rsh (pshare_sh sh)
- | YES rsh sh _ _ => Some Nonempty
- end. *)
+Lemma perm_of_res_mono d1 d2 (r : option resource) : ✓d2 -> d1 ≼ d2 -> Mem.perm_order'' (perm_of_res (d2, r)) (perm_of_res (d1, r)).
+Proof.
+  intros ? Hd.
+  destruct (perm_of_res_cases d2 r) as [(v2 & ? & Hperm2) | (Hno2 & Hperm2)],
+    (perm_of_res_cases d1 r) as [(v1 & Hr & Hperm1) | (Hno1 & Hperm1)]; subst.
+  - inv Hr; rewrite Hperm1 Hperm2; apply perm_of_dfrac_mono; auto.
+  - by contradiction (Hno1 v2).
+  - by contradiction (Hno2 v1).
+  - rewrite Hperm1 Hperm2; clear - H Hd.
+    rewrite dfrac_included_eq in Hd.
+    destruct (decide (d1 = ε)); first apply perm_order''_None.
+    destruct (decide (d1 = _)); first apply perm_order''_None.
+    rewrite !if_false; first constructor.
+    + intros ->; done.
+    + intros ->; destruct d1; try done; simpl in Hd.
+      destruct Hd as (? & Hd).
+      symmetry in Hd; apply share_op_join in Hd as (? & ? & -> & -> & J).
+      rewrite share_op_is_join in J; apply join_Bot in J as [-> ->]; done.
+Qed.
+
+(*Global Program Instance resource_ops : resource_ops (leibnizO resource) := { perm_of_res := perm_of_res; memval_of r := match r with VAL v => Some v | _ => None end }.
+Next Obligation.
+Proof.
+  discriminate.
+Qed.
+Next Obligation.
+Proof.
+  discriminate.
+Qed.
+Next Obligation.
+Proof.
+  intros ???.
+  pose proof (readable_dfrac_readable _ H).
+  split.
+  - destruct (perm_of_res_cases d r) as [(v & -> & Hperm) | (Hno & Hperm)]; rewrite Hperm /= perm_of_sh_bot // /=.
+    rewrite !if_false; first by destruct r as [[| |]|]; try constructor; contradiction (Hno v).
+    + intros ->; done.
+    + intros ->; simpl in H.
+      contradiction bot_unreadable.
+  - intros ? Hvalid.
+    pose proof (dfrac_op_readable' _ _ (or_introl H) Hvalid) as Hreadable%readable_dfrac_readable.
+    destruct (perm_of_res_cases (d ⋅ d2) r) as [(v & -> & Hperm) | (Hno & Hperm)]; rewrite Hperm; clear Hperm.
+    + destruct d2; rewrite /= left_id; if_tac; try done; apply (perm_of_dfrac_mono (DfracOwn _)); try done; eexists; rewrite (@cmra_comm dfracR) //.
+      instantiate (1 := DfracDiscarded ⋅ d); rewrite assoc dfrac_op_own_discarded //.
+    + destruct (perm_of_res_cases (DfracDiscarded ⋅ d2) r) as [(v & -> & Hperm) | (_ & Hperm)]; first (by contradiction (Hno v)); rewrite Hperm /=; clear Hperm.
+      destruct (decide (DfracDiscarded ⋅_ = _)); first apply perm_order''_None.
+      destruct (decide (DfracDiscarded ⋅_ = _)); first apply perm_order''_None.
+      rewrite !if_false; first constructor.
+      * intros X; rewrite X // in Hvalid.
+      * intros X; rewrite X /= perm_of_sh_bot // in Hreadable.
+Qed.
+Next Obligation.
+Proof.
+  simpl.
+  destruct r; try apply perm_order''_refl.
+  destruct d as [[|]|]; simpl; try if_tac; try constructor; try apply perm_order''_None.
+  - destruct (perm_of_sh sh) eqn: Hs; simpl; try constructor.
+    by apply perm_of_sh_None in Hs.
+  - destruct (perm_of_sh' _) eqn: Hs; simpl; try constructor; done.
+Qed.
+Next Obligation.
+Proof.
+  simpl; intros.
+  destruct r as (d, r).
+  destruct (perm_of_res_cases d r) as [(v & -> & Hperm) | (Hno & Hperm)]; rewrite Hperm /=; clear Hperm.
+  - apply perm_order''_refl.
+  - if_tac; first apply perm_order''_None.
+    if_tac; first apply perm_order''_None.
+    rewrite /perm_of_res' /=.
+    destruct (perm_of_dfrac d) eqn: Hd; first constructor.
+    destruct d as [[|]|]; simpl in Hd; try done.
+    + apply perm_of_sh_None in Hd as ->; done.
+    + if_tac in Hd; try done.
+      rewrite -> Hd in *; done.
+Qed.
+Next Obligation.
+Proof.
+  simpl; intros.
+  inv H; done.
+Qed.*)
+
+Definition perm_of_res_lock (r: dfrac * option resource) :=
+  match r with
+  | (q, Some (LK _ _ _)) => match q with
+                   | DfracOwn (Share sh) => perm_of_sh (Share.glb Share.Rsh sh)
+                   | DfracBoth _ => Some Readable
+                   | _ => None
+                   end
+  | _ => None
+  end.
 
 Lemma Rsh_not_top: Share.Rsh <> Share.top.
 Proof.
@@ -127,19 +223,9 @@ apply H; auto.
 apply top_share_nonidentity.
 Qed.
 
-Lemma nonidentity_Rsh: ~identity Share.Rsh.
-Proof.
-unfold Share.Rsh.
-case_eq (Share.split Share.top); intros.
-simpl; intro.
-apply split_nontrivial' in H.
-apply top_share_nonidentity; auto.
-auto.
-Qed.
-
 Lemma perm_of_sh_fullshare: perm_of_sh fullshare = Some Freeable.
 Proof. unfold perm_of_sh.
-  rewrite if_true. rewrite if_true by auto. auto.
+  rewrite if_true. rewrite -> if_true by auto. auto.
    unfold fullshare.
    apply writable_writable0.
    apply writable_share_top.
@@ -167,114 +253,46 @@ rewrite glb_Rsh_Lsh.
 auto.
 Qed.
 
-Lemma perm_of_res_op1:
-  forall r,
-    perm_order'' (perm_of_res' r) (perm_of_res r).
+Lemma perm_order''_min : forall s, perm_order'' (perm_of_sh s) (if eq_dec s Share.bot then None else Some Nonempty).
 Proof.
-  destruct r eqn:?; simpl.
-  - if_tac; constructor.
-  - unfold perm_of_sh.
-    if_tac. if_tac; destruct k; constructor.
-    if_tac. destruct k; constructor.
-    rewrite if_false by auto. destruct k; constructor.
-  - constructor.
+  intros; unfold perm_of_sh; repeat if_tac; constructor.
 Qed.
 
-Lemma perm_of_res_op2:
-  forall r,
-    perm_order'' (perm_of_res' r) (perm_of_res_lock r).
+Lemma perm_order''_Freeable : forall s, perm_order'' (Some Freeable) s.
 Proof.
-  destruct r; simpl; auto.
-  - if_tac; constructor.
-  - destruct k; try solve [destruct (perm_of_sh sh); constructor].
-    unfold perm_of_sh.
-    if_tac. if_tac.
-    repeat if_tac; constructor.
-    rewrite if_true. rewrite if_false. constructor.
-    apply glb_Rsh_not_top.
-    apply writable0_share_glb_Rsh; auto.
-    rewrite if_true by auto.
-    rewrite if_false. rewrite if_true. constructor.
-    unfold readable_share. rewrite glb_twice; auto.
-    contradict H. unfold writable0_share in *. eapply join_sub_trans; eauto.
-    apply leq_join_sub. apply Share.glb_lower2.
+  destruct s; constructor.
 Qed.
 
-Definition access_cohere (m: mem)  (phi: rmap) :=
-  forall loc,  access_at m loc Cur = perm_of_res (phi @ loc).
-
-Definition max_access_at m loc := access_at m loc Max.
-
-Definition max_access_cohere (m: mem) (phi: rmap)  :=
-  forall loc,
-    perm_order'' (max_access_at m loc) (perm_of_res' (phi @ loc)).
-
-(*
-Definition max_access_cohere (m: mem) (phi: rmap)  :=
-  forall loc,
-   match phi @ loc with
-   | YES rsh sh _ _ => perm_order'' (max_access_at m loc) (perm_of_sh rsh (pshare_sh sh))
-   | NO rsh => perm_order'' (max_access_at m loc) (perm_of_sh rsh Share.bot )
-   | PURE _ _ => (fst loc < nextblock m)%positive
-  end. *)
-
-Definition alloc_cohere (m: mem) (phi: rmap) :=
- forall loc,  (fst loc >= nextblock m)%positive -> phi @ loc = NO Share.bot bot_unreadable.
-
-Inductive juicy_mem: Type :=
-  mkJuicyMem: forall (m: mem) (phi: rmap)
-    (JMcontents: contents_cohere m phi)
-    (JMaccess: access_cohere m phi)
-    (JMmax_access: max_access_cohere m phi)
-    (JMalloc: alloc_cohere m phi),
-       juicy_mem.
-
-Section selectors.
-Variable (j: juicy_mem).
-Definition m_dry := match j with mkJuicyMem m _ _ _ _ _ => m end.
-Definition m_phi := match j with mkJuicyMem _ phi _ _ _ _ => phi end.
-Lemma juicy_mem_contents: contents_cohere m_dry m_phi.
-Proof. unfold m_dry, m_phi; destruct j; auto. Qed.
-Lemma juicy_mem_access: access_cohere m_dry m_phi.
-Proof. unfold m_dry, m_phi; destruct j; auto. Qed.
-Lemma juicy_mem_max_access: max_access_cohere m_dry m_phi.
-Proof. unfold m_dry, m_phi; destruct j; auto. Qed.
-Lemma juicy_mem_alloc_cohere: alloc_cohere m_dry m_phi.
-Proof. unfold m_dry, m_phi; destruct j; auto. Qed.
-End selectors.
-
-Definition juicy_mem_resource: forall jm m', resource_at m' = resource_at (m_phi jm) ->
-  {jm' | m_phi jm' = m' /\ m_dry jm' = m_dry jm}.
+Lemma perm_of_sh_glb : forall sh1 sh2, perm_order'' (perm_of_sh sh1) (perm_of_sh (Share.glb sh2 sh1)).
 Proof.
-  intros.
-  assert (contents_cohere (m_dry jm) m') as Hcontents.
-  { intros ?????.
-    rewrite H; apply juicy_mem_contents. }
-  assert (access_cohere (m_dry jm) m') as Haccess.
-  { intro.
-    rewrite H; apply juicy_mem_access. }
-  assert (max_access_cohere (m_dry jm) m') as Hmax.
-  { intro.
-    rewrite H; apply juicy_mem_max_access. }
-  assert (alloc_cohere (m_dry jm) m') as Halloc.
-  { intro.
-    rewrite H; apply juicy_mem_alloc_cohere. }
-  exists (mkJuicyMem _ _ Hcontents Haccess Hmax Halloc); auto.
-Defined.
+  intros; unfold perm_of_sh.
+  pose proof (Share.glb_lower2 sh2 sh1) as Hglb.
+  if_tac.
+  - if_tac; first apply perm_order''_Freeable.
+    repeat if_tac; try constructor.
+    rewrite H2 in Hglb.
+    eapply Share.ord_antisym in Hglb; last apply Share.top_correct; contradiction.
+  - rewrite (if_false _ (writable0_share_dec _)).
+    if_tac; first by repeat if_tac; constructor.
+    rewrite (if_false _ (readable_share_dec _)).
+    repeat if_tac; try constructor.
+    + subst.
+      contradiction H2; apply Share.glb_bot.
+    + intros X; contradiction H0; unfold readable_share, nonempty_share in *.
+      intros X1%identity_share_bot; contradiction X.
+      rewrite (Share.glb_commute sh2) -Share.glb_assoc X1 Share.glb_commute Share.glb_bot.
+      apply bot_identity.
+    + intros X; contradiction H; unfold writable0_share in *.
+      rewrite -!leq_join_sub in X |- *.
+      eapply Share.ord_trans; done.
+Qed.
 
 Lemma perm_of_empty_inv {s} : perm_of_sh s = None -> s = Share.bot.
 Proof.
-intros.
-unfold perm_of_sh in*.
-if_tac in H; subst; auto.
-if_tac in H; subst; auto.
-inv H. inv H.
-if_tac in H; subst; auto.
-inv H.
-if_tac in H; subst; auto. inv H.
+  apply perm_of_sh_None.
 Qed.
 
-Lemma writable_join_sub: forall loc phi1 phi2,
+(*Lemma writable_join_sub: forall loc phi1 phi2,
   join_sub phi1 phi2 -> writable loc phi1 -> writable loc phi2.
 Proof.
 intros.
@@ -308,315 +326,12 @@ Proof.
 intros.
 simpl in H.
 destruct (phi@loc); eauto 50.
-Qed.
-
-Lemma age1_joinx {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A} : forall phi1 phi2 phi3 phi1' phi2' phi3',
-             age phi1 phi1' -> age phi2 phi2' -> age phi3 phi3' ->
-             join phi1 phi2 phi3 -> join phi1' phi2' phi3'.
-Proof.
-intros.
-destruct (age1_join _ H2 H) as [phi2'' [phi3'' [? [? ?]]]].
-unfold age in *.
-congruence.
-Qed.
-
-Lemma constructive_age1_join  {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A} : forall x y z x' : A,
-       join x y z ->
-       age x x' ->
-       { yz' : A*A | join x' (fst yz') (snd yz') /\ age y (fst yz') /\ age z (snd yz')}.
-Proof.
-pose proof I.
-intros.
-case_eq (age1 y); [intros y' ? | intros].
-case_eq (age1 z); [intros z' ? | intros].
-exists (y',z').
-simpl.
-split; auto.
-apply (age1_joinx x y z x' y' z' H1 H2 H3 H0).
-exfalso.
-destruct (age1_join _ H0 H1) as [? [? [? [? ?]]]].
-unfold age in *.
-congruence.
-exfalso.
-destruct (age1_join _ H0 H1) as [? [? [? [? ?]]]].
-unfold age in *.
-congruence.
-Qed.
-
-Lemma age1_constructive_joins_eq : forall {A}  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}  {phi1 phi2},
-  constructive_joins phi1 phi2
-  -> forall {phi1'}, age1 phi1 = Some phi1'
-  -> forall {phi2'}, age1 phi2 = Some phi2'
-  -> constructive_joins phi1' phi2'.
-Proof.
-intros.
-destruct X as [? ?H].
-destruct (constructive_age1_join _ _ _ _ H1 H) as [[y z] [? [? ?]]].
-simpl in *.
-unfold age in H3. rewrite H0 in H3; inv H3; econstructor; eauto.
-Qed.
-
-
-Program Definition age1_juicy_mem (j: juicy_mem): option juicy_mem :=
-      match age1 (m_phi j) with
-        | Some phi' => Some (mkJuicyMem (m_dry j) phi' _ _ _ _)
-        | None => None
-      end.
-Next Obligation.  (* contents_cohere *)
- assert (necR (m_phi j) phi')
-   by (constructor 1; symmetry in Heq_anonymous; apply Heq_anonymous).
- destruct j; hnf; simpl in *; intros.
- case_eq (phi @ loc); intros.
- apply (necR_NO _ _ _ _ _ H) in H1. congruence.
- generalize (necR_YES _ _ _ _ _ _ _ H H1); intros.
- rewrite H0 in H2. inv H2.
- destruct (JMcontents sh0 r v loc _ H1). subst; split; auto.
- rewrite (necR_PURE _ _ _ _ _ H H1) in H0. inv H0.
-Qed.
-Next Obligation. (* access_cohere *)
- assert (necR (m_phi j) phi')
-   by (constructor 1; symmetry in Heq_anonymous; apply Heq_anonymous).
- destruct j; hnf; simpl in *; intros.
- generalize (JMaccess loc); case_eq (phi @ loc); intros.
- apply (necR_NO _ _ loc _ _ H) in H0. rewrite H0; auto.
- rewrite (necR_YES _ _ _ _ _ _ _ H H0); auto.
- rewrite (necR_PURE _ _ _ _ _ H H0); auto.
-Qed.
-Next Obligation. (* max_access_cohere *)
- assert (necR (m_phi j) phi')
-   by (constructor 1; symmetry in Heq_anonymous; apply Heq_anonymous).
- destruct j; hnf; simpl in *; intros.
- generalize (JMmax_access loc); case_eq (phi @ loc); intros.
- apply (necR_NO _ _ loc _ _ H) in H0. rewrite H0; auto.
- rewrite (necR_YES _ _ _ _ _ _ _ H H0); auto.
- rewrite (necR_PURE _ _ _ _ _ H H0); auto.
-Qed.
-Next Obligation. (* alloc_cohere *)
- assert (necR (m_phi j) phi')
-   by (constructor 1; symmetry in Heq_anonymous; apply Heq_anonymous).
- destruct j; hnf; simpl in *; intros.
- specialize (JMalloc loc H0).
- apply (necR_NO _ _ loc _ _ H). auto.
-Qed.
-
-Lemma age1_juicy_mem_unpack: forall j j',
-  age1_juicy_mem j = Some j' ->
-  age (m_phi j)  (m_phi j')
-  /\ m_dry j = m_dry j'.
-Proof.
-intros.
-unfold age1_juicy_mem in H.
-invSome.
-inv H.
-split; simpl; auto.
-symmetry in H0; apply H0.
-Qed.
-
-Lemma age1_juicy_mem_unpack': forall j j',
-  age (m_phi j)  (m_phi j')  /\ m_dry j = m_dry j' ->
-  age1_juicy_mem j = Some j'.
-Proof.
-  intuition.
-  unfold age1_juicy_mem.
-  generalize (eq_refl (age1 (m_phi j))).
-  pattern (age1 (m_phi j)) at 1 3.
-  rewrite H0;  clear H0. intros H0.
-  f_equal.
-  destruct j, j'; simpl in *; subst; repeat f_equal; try apply proof_irr.
-Qed.
-
-Lemma age1_juicy_mem_unpack'': forall j j',
-  age (m_phi j)  (m_phi j')  -> m_dry j = m_dry j' ->
-  age1_juicy_mem j = Some j'.
-Proof.
-  intros.
-  apply age1_juicy_mem_unpack'.
- split; auto.
-Qed.
-
-(* TODO: move into rmaps_lemmas *)
-Lemma rmap_join_eq_level: forall phi1 phi2: rmap, joins phi1 phi2 -> level phi1 = level phi2.
-Proof.
-intros until phi2; intro H.
-destruct H as [? H].
-apply join_level in H; destruct H; congruence.
-Qed.
-
-Lemma rmap_join_sub_eq_level: forall phi1 phi2: rmap,
-          join_sub phi1 phi2 -> level phi1 = level phi2.
-Proof.
-intros until phi2; intro H.
-destruct H; apply join_level in H; destruct H; congruence.
-Qed.
-
-Lemma age1_juicy_mem_None1:
-  forall j, age1_juicy_mem j = None -> age1 (m_phi j) = None.
-Proof.
-intros j H.
-destruct j.
-simpl.
-unfold age1_juicy_mem in H; simpl in H.
-revert H; generalize (refl_equal (age1 phi)); pattern (age1 phi) at 1 3; destruct (age1 phi); intros; auto.
-inv H.
-Qed.
-
-Lemma age1_juicy_mem_None2:
-  forall j, age1 (m_phi j) = None -> age1_juicy_mem j = None.
-Proof.
-intros.
-unfold age1_juicy_mem.
-generalize (eq_refl (age1 (m_phi j))).
-pattern (age1 (m_phi j)) at 1 3.
-rewrite H.
-auto.
-Qed.
-
-Lemma age1_juicy_mem_Some:
-  forall j j', age1_juicy_mem j = Some j' -> age1 (m_phi j) = Some (m_phi j').
-Proof.
-intros.
-apply age1_juicy_mem_unpack in H; intuition.
-Qed.
-
-
-Lemma unage_juicy_mem: forall j' : juicy_mem,
-   exists j : juicy_mem, age1_juicy_mem j = Some j'.
-Proof.
-intros.
-destruct j' as [m phi'].
-destruct (af_unage age_facts phi') as [phi ?].
-assert (NEC: necR phi phi')  by (constructor 1; auto).
- rename H into Hage.
-assert (contents_cohere m phi).
-  hnf; intros.
-  generalize (necR_YES phi phi' loc rsh sh (VAL v) pp NEC H); intro.
-  destruct (JMcontents _ _ _ _ _ H0).
-  rewrite H2 in H0.
-  split; auto.
-  generalize (necR_YES' _ _ loc rsh sh (VAL v) NEC); intro.
-  apply H3 in H0. congruence.
-assert (access_cohere m phi).
-  hnf; intros.
-  generalize (JMaccess loc); intros.
-  case_eq (phi @ loc); intros.
-  apply (necR_NO _ _ loc _ _ NEC) in H1. rewrite H1 in H0; auto.
-  apply (necR_YES _ _ _ _ _ _ _ NEC) in H1. rewrite H1 in H0; auto.
-  apply (necR_PURE _ _ _ _ _ NEC) in H1. rewrite H1 in H0; auto.
-assert (max_access_cohere m phi).
-  hnf; intros.
-  generalize (JMmax_access loc); intros.
-  case_eq (phi @ loc); intros.
-  apply (necR_NO _ _ _ _ _ NEC) in H2; rewrite H2 in H1; auto.
-  rewrite (necR_YES _ _ _ _ _ _ _ NEC H2) in H1; auto.
-  rewrite (necR_PURE _ _ _ _ _ NEC H2) in H1; auto.
-assert (alloc_cohere m phi).
-  hnf; intros.
-  generalize (JMalloc loc H2); intros.
-  case_eq (phi @ loc); intros.
-  apply (necR_NO _ _ _ _ _ NEC) in H4; rewrite H4 in H3; auto.
-  rewrite (necR_YES _ _ _ _ _ _ _ NEC H4) in H3; inv H3.
-  rewrite (necR_PURE _ _ _ _ _ NEC H4) in H3; inv H3.
-exists (mkJuicyMem m phi H H0 H1 H2).
-apply age1_juicy_mem_unpack''; simpl; auto.
-Qed.
-
-Lemma level1_juicy_mem: forall j: juicy_mem,
-  age1_juicy_mem j = None <-> level (m_phi j) = 0%nat.
-Proof.
-intro x.
-split; intro H.
-apply age1_level0.
-apply age1_juicy_mem_None1; auto.
-apply age1_level0 in H.
-apply age1_juicy_mem_None2.
-auto.
-Qed.
-
-Lemma level2_juicy_mem: forall j1 j2: juicy_mem,
-   age1_juicy_mem j1 = Some j2 -> level (m_phi j1) = S (level (m_phi j2)).
-Proof.
-intros x y H.
-destruct (age1_juicy_mem_unpack x y H).
- apply age_level in H0. auto.
-Qed.
-
-Lemma juicy_mem_ageable_facts: ageable_facts juicy_mem (fun j => level (m_phi j)) age1_juicy_mem.
-Proof.
-constructor.
-(*apply age1_juicy_mem_wf.*)
-apply unage_juicy_mem.
-apply level1_juicy_mem.
-apply level2_juicy_mem.
-Qed.
-
-#[export] Instance juicy_mem_ageable: ageable juicy_mem :=
-  mkAgeable _ (fun j => level (m_phi j)) age1_juicy_mem juicy_mem_ageable_facts.
-
-Lemma level_juice_level_phi: forall (j: juicy_mem), level j = level (m_phi j).
-Proof. intuition. Qed.
-
-Lemma juicy_mem_ext: forall j1 j2,
-       m_dry j1 = m_dry j2  ->
-       m_phi j1 = m_phi j2 ->
-       j1=j2.
-Proof.
-intros.
-destruct j1; destruct j2; simpl in *.
-subst.
-f_equal; apply proof_irr.
-Qed.
-
-Lemma unage_writable: forall (phi phi': rmap) loc,
-  age phi phi' -> writable loc phi' -> writable loc phi.
-Proof.
-intros.
-simpl in *.
-apply age1_resource_at with (loc := loc) (r := phi @ loc) in H.
-destruct (phi' @ loc); try contradiction.
-unfold writable.
-destruct (phi @ loc); try discriminate.
-inv H. auto.
-destruct (phi' @ loc); inv H0.
-rewrite resource_at_approx. auto.
-Qed.
-
-Lemma unage_readable: forall (phi phi': rmap) loc,
-  age phi phi' -> readable loc phi' -> readable loc phi.
-Proof.
-intros.
-simpl in *.
-apply age1_resource_at with (loc := loc) (r := phi @ loc) in H.
- 2: symmetry; apply resource_at_approx.
-destruct (phi' @ loc); try inv H0.
-destruct (phi @ loc); try inv H.
-auto.
-Qed.
+Qed.*)
 
-Lemma readable_inv: forall phi loc, readable loc phi ->
-  exists rsh, exists sh, exists v, exists pp, phi @ loc = YES rsh sh (VAL v) pp.
+(*Definition ord_jm jm {n r} (Hord : m_phi jm ≼ₒ{n} r) :
+  {jm' | m_phi jm' = r ∧ m_dry jm' = m_dry jm}.
 Proof.
-simpl.
-intros phi loc H.
-destruct (phi @ loc); try solve [inversion H].
-destruct k; try inv H.
-eauto.
-Qed.
-
-Lemma ext_ord_juicy_mem : forall m b, ext_order (m_phi m) b ->
-  exists m', m_dry m' = m_dry m /\ m_phi m' = b.
-Proof.
-  intros.
-  destruct (juicy_mem_resource m b) as (? & ? & ?); eauto.
-  apply rmap_order in H as (Hl & Hr & Hg); auto.
-Qed.
-
-Lemma ext_ord_juicy_mem' : forall m b, ext_order b (m_phi m) ->
-  exists m', m_dry m' = m_dry m /\ m_phi m' = b.
-Proof.
-  intros.
-  destruct (juicy_mem_resource m b) as (? & ? & ?); eauto.
-  apply rmap_order in H as (Hl & Hr & Hg); auto.
-Qed.
+  apply juicy_mem_resource.
 
 Definition access_of_rmap r b ofs k :=
   match k with
@@ -625,23 +340,23 @@ Definition access_of_rmap r b ofs k :=
   end.
 
 Definition make_access (next : block) (r : rmap) :=
-  fold_right (fun b m => PTree.set b (access_of_rmap r b) m) (PTree.empty _)
+  fold_right (fun b m => Maps.PTree.set b (access_of_rmap r b) m) (Maps.PTree.empty _)
   (map Z.to_pos (tl (upto (Pos.to_nat next)))).
 
 Lemma make_access_get_aux : forall l r b t,
-  (fold_right (fun b m => PTree.set b (access_of_rmap r b) m) t l) ! b =
-  if In_dec eq_block b l then Some (access_of_rmap r b) else t ! b.
+  (fold_right (fun b m => Maps.PTree.set b (access_of_rmap r b) m) t l) !! b =
+  if In_dec eq_block b l then Some (access_of_rmap r b) else t !! b.
 Proof.
   induction l; simpl; auto; intros.
   destruct (eq_block a b).
-  - subst; apply PTree.gss.
-  - rewrite PTree.gso by auto.
+  - subst; apply Maps.PTree.gss.
+  - rewrite /lookup /ptree_lookup in IHl |- *; rewrite Maps.PTree.gso; last auto.
     rewrite IHl.
     if_tac; auto.
 Qed.
 
 Lemma make_access_get : forall next r b,
-  (make_access next r) ! b =
+  (make_access next r) !! b =
   if Pos.ltb b next then Some (access_of_rmap r b) else None.
 Proof.
   intros; unfold make_access.
@@ -661,12 +376,15 @@ Proof.
     { pose proof (Pos2Nat.is_pos next); lia. }
     simpl.
     rewrite in_map_iff; do 2 eexists.
-    { rewrite Zminus_succ_l.
-      unfold Z.succ. rewrite Z.add_simpl_r; reflexivity. }
+    { rewrite -> Zminus_succ_l.
+      unfold Z.succ. rewrite -> Z.add_simpl_r; reflexivity. }
     rewrite In_upto; lia.
-Qed.
+Qed.*)
+
+Ltac fold_ptree_lookup := repeat match goal with |-context[Maps.PTree.get ?k ?m] =>
+  change (Maps.PTree.get k m) with (m !! k) end.
 
-Program Definition deflate_mem (m : Memory.mem) (r : rmap) (Halloc : alloc_cohere m r) :=
+(*Program Definition deflate_mem (m : Memory.mem) (r : rmap) (Halloc : alloc_cohere m r) :=
   {| mem_contents := mem_contents m;
     (* original could have non-None default, so we need to 
        reconstruct it from the blocks [1, nextblock) *)
@@ -674,44 +392,23 @@ Program Definition deflate_mem (m : Memory.mem) (r : rmap) (Halloc : alloc_coher
      nextblock := nextblock m |}.
 Next Obligation.
 Proof.
-  unfold PMap.get; simpl.
-  rewrite make_access_get.
+  intros; unfold Maps.PMap.get; simpl.
+  fold_ptree_lookup; rewrite make_access_get.
   destruct (b <? nextblock m)%positive; simpl; auto.
   apply perm_of_res_op1.
 Qed.
 Next Obligation.
 Proof.
-  unfold PMap.get; simpl.
-  rewrite make_access_get.
+  intros; unfold Maps.PMap.get; simpl.
+  fold_ptree_lookup; rewrite make_access_get.
   destruct (Pos.ltb_spec0 b (nextblock m)); auto; contradiction.
 Qed.
 Next Obligation.
 Proof.
-  apply contents_default.
-Qed.
+  intros; apply contents_default.
+Qed.*)
 
-(* There are plenty of other orders on memories, but they're all either
-   way too general (Mem.extends, mem_lessdef) or way too restrictive (mem_lessalloc). *)
-Definition mem_sub m1 m2 := mem_contents m1 = mem_contents m2 /\ nextblock m1 = nextblock m2 /\
-  forall b ofs k p, Mem.perm m1 b ofs k p -> Mem.perm m2 b ofs k p.
-
-Lemma mem_sub_valid_pointer : forall m1 m2 b ofs, mem_sub m1 m2 -> valid_pointer m1 b ofs = true ->
-  valid_pointer m2 b ofs = true.
-Proof.
-  unfold mem_sub, valid_pointer; intros.
-  destruct H as (_ & _ & Hp).
-  destruct (perm_dec m1 _ _ _ _); inv H0.
-  destruct (perm_dec m2 _ _ _ _); auto.
-Qed.
-
-Lemma mem_sub_weak_valid_pointer : forall m1 m2 b ofs, mem_sub m1 m2 -> weak_valid_pointer m1 b ofs = true ->
-  weak_valid_pointer m2 b ofs = true.
-Proof.
-  unfold weak_valid_pointer; intros.
-  apply orb_true_iff in H0 as [Hp | Hp]; rewrite (mem_sub_valid_pointer _ _ _ _ H Hp), ?orb_true_r; auto.
-Qed.
-
-Lemma join_sub_alloc_cohere : forall m jm, join_sub m (m_phi jm) ->
+(*Lemma join_sub_alloc_cohere : forall m jm, m ≼ (m_phi jm) ->
   alloc_cohere (m_dry jm) m.
 Proof.
   intros ?? [? J] ??.
@@ -720,11 +417,11 @@ Proof.
   apply (resource_at_join _ _ _ loc) in J; rewrite H in J; inv J.
   apply split_identity in RJ; [|apply bot_identity].
   apply identity_share_bot in RJ; subst; f_equal; apply proof_irr.
-Qed.
+Qed.*)
 
 Local Hint Resolve perm_refl : core.
 
-Lemma perm_of_sh_join_sub'': forall (sh1 sh2: Share.t),
+(*Lemma perm_of_sh_join_sub'': forall (sh1 sh2: Share.t),
   join_sub sh1 sh2 ->
   perm_order'' (perm_of_sh sh2) (perm_of_sh sh1).
 Proof.
@@ -743,286 +440,7 @@ destruct (readable_share_dec sh1).
 repeat if_tac; try constructor.
 subst; apply split_identity, identity_share_bot in J; auto; contradiction.
 Qed.
-
-Lemma perm_of_res_sub_rmap : forall r1 r2 l, join_sub r1 r2 ->
-  perm_order'' (perm_of_res (r2 @ l)) (perm_of_res (r1 @ l)) /\
-  perm_order'' (perm_of_res' (r2 @ l)) (perm_of_res' (r1 @ l)).
-Proof.
-  intros ??? [? J].
-  apply (resource_at_join _ _ _ l) in J; inv J; simpl; auto.
-  - if_tac; if_tac; simpl; auto.
-    subst; apply split_identity, identity_share_bot in RJ; auto.
-  - lapply (perm_of_sh_join_sub'' sh1 sh3); [|eexists; eauto].
-    intros; destruct k; split; simpl; auto.
-  - destruct (perm_of_sh sh3) eqn: Hsh3.
-    destruct k; if_tac; split; simpl; constructor.
-    { apply perm_of_empty_inv in Hsh3; subst; contradiction bot_unreadable. }
-  - lapply (perm_of_sh_join_sub'' sh1 sh3); [|eexists; eauto].
-    intros; destruct k; split; simpl; auto.
-Qed.
-
-Lemma juicy_mem_sub : forall jm m', join_sub m' (m_phi jm) -> exists jm', m_phi jm' = m' /\ mem_sub (m_dry jm') (m_dry jm).
-Proof.
-  intros ?? Hsub.
-  unshelve eexists (mkJuicyMem (deflate_mem (m_dry jm) m' (join_sub_alloc_cohere _ _ Hsub)) m' _ _ _ _);
-    destruct jm, Hsub as [? J]; simpl in *.
-  - repeat intro.
-    unfold contents_at, deflate_mem; simpl.
-    apply (resource_at_join _ _ _ loc) in J; rewrite H in J; inv J;
-      eapply JMcontents; eauto.
-  - repeat intro.
-    unfold access_at; unfold deflate_mem; simpl.
-    unfold PMap.get; simpl.
-    rewrite make_access_get.
-    destruct (Pos.ltb_spec (fst loc) (nextblock m)).
-    + destruct loc; reflexivity.
-    + specialize (JMalloc loc).
-      apply (resource_at_join _ _ _ loc) in J; rewrite JMalloc in J.
-      inv J; simpl.
-      apply split_identity in RJ; [|apply bot_identity].
-      apply identity_share_bot in RJ; subst; rewrite if_true; auto.
-      { apply Pos.ge_le_iff; auto. }
-  - repeat intro.
-    unfold max_access_at, access_at; unfold deflate_mem; simpl.
-    unfold PMap.get; simpl.
-    rewrite make_access_get.
-    destruct (Pos.ltb_spec (fst loc) (nextblock m)).
-    + unfold access_of_rmap; destruct loc; simpl.
-      unfold perm_order''.
-      destruct (perm_of_res' _); auto; constructor.
-    + specialize (JMalloc loc).
-      apply (resource_at_join _ _ _ loc) in J; rewrite JMalloc in J.
-      inv J; simpl.
-      apply split_identity in RJ; [|apply bot_identity].
-      apply identity_share_bot in RJ; subst; rewrite if_true; auto.
-      { apply Pos.ge_le_iff; auto. }
-  - intros loc ?; pose proof (JMalloc loc); simpl in *.
-    apply (resource_at_join _ _ _ loc) in J; rewrite H0 in J by auto.
-    inv J; auto.
-    apply split_identity in RJ; [|apply bot_identity].
-    apply identity_share_bot in RJ; subst; f_equal; apply proof_irr.
-  - repeat (split; auto).
-    unfold deflate_mem, perm; simpl; intros.
-    unfold PMap.get in H; simpl in H.
-    rewrite make_access_get in H.
-    destruct (perm_of_res_sub_rmap m' phi (b, ofs)) as [H1 H2].
-    { eexists; eauto. }
-    destruct (Pos.ltb_spec b (nextblock m)); [destruct k; simpl in H|].
-    + specialize (JMmax_access (b, ofs)).
-      unfold max_access_at, access_at in JMmax_access; simpl in *.
-      unfold perm_order'', perm_order' in *.
-      destruct (perm_of_res' (m' @ (b, ofs))) eqn: Hperm'; [|contradiction].
-      destruct (perm_of_res' (phi @ (b, ofs))) eqn: Hperm; [|contradiction].
-      destruct ((mem_access m) !! _ _ _); [|contradiction].
-      eapply perm_order_trans, perm_order_trans; eauto.
-    + specialize (JMaccess (b, ofs)).
-      unfold access_at in JMaccess; simpl in *.
-      unfold perm_order'', perm_order' in *.
-      destruct (perm_of_res (m' @ (b, ofs))) eqn: Hperm'; [|contradiction].
-      destruct (perm_of_res (phi @ (b, ofs))) eqn: Hperm; [|contradiction].
-      rewrite JMaccess.
-      eapply perm_order_trans; eauto.
-    + apply (resource_at_join _ _ _ (b, ofs)) in J.
-      lapply (JMalloc (b, ofs)); [|simpl; lia].
-      intros Hno; rewrite Hno in *; simpl in *; contradiction.
-Qed.
-
-#[export] Program Instance juicy_mem_ord: Ext_ord juicy_mem :=
-  { ext_order a b := m_dry a = m_dry b /\ ext_order (m_phi a) (m_phi b) }.
-Next Obligation.
-Proof.
-  constructor; auto.
-  intros ??? [] []; split; etransitivity; eauto.
-Qed.
-Next Obligation.
-Proof.
-  intros ?? Hage ? [? Hext].
-  apply age1_juicy_mem_unpack in Hage as [? ?].
-  eapply age_ext_commut in Hext as [? ? Hage]; eauto.
-  destruct (age1_juicy_mem z) as [j|] eqn: Hz.
-  destruct (age1_juicy_mem_unpack _ _ Hz) as (Hage' & ?).
-  unfold age in *; rewrite Hage' in Hage; inv Hage.
-  exists j; eauto; split; auto; congruence.
-  { apply age1_juicy_mem_None1 in Hz. congruence. }
-Qed.
-Next Obligation.
-Proof.
-  apply age1_juicy_mem_unpack in H0 as [? ?].
-  eapply ext_age_compat in H1 as (? & Hage & ?); eauto.
-  destruct (age1_juicy_mem b) as [j|] eqn: Hb.
-  destruct (age1_juicy_mem_unpack _ _ Hb) as (Hage' & ?).
-  unfold age in *; rewrite Hage' in Hage; inv Hage.
-  exists j; split; auto; split; auto; congruence.
-  { apply age1_juicy_mem_None1 in Hb. congruence. }
-Qed.
-Next Obligation.
-Proof.
-  apply ext_level in H0; auto.
-Qed.
-
-(* resource coherence *)
-
-(* FIXME: put somewhere else. *)
-Definition fmap_option {A B} (v: option A) (m: B) (f: A -> B): B :=
-  match v with
-    | None => m
-    | Some v' => f v'
-  end.
-
-Lemma resource_at_make_rmap: forall f g lev H Hg, resource_at (proj1_sig (make_rmap f g lev H Hg)) = f.
-refine (fun f g lev H Hg => match proj2_sig (make_rmap f g lev H Hg) with
-                           | conj _ (conj RESOURCE_AT _) => RESOURCE_AT
-                         end).
-Qed.
-
-Lemma resource_at_remake_rmap: forall f g lev H Hg, resource_at (proj1_sig (remake_rmap f g lev H Hg)) = f.
-refine (fun f g lev H Hg => match proj2_sig (remake_rmap f g lev H Hg) with
-                           | conj _ (conj RESOURCE_AT _) => RESOURCE_AT
-                         end).
-Qed.
-
-Lemma ghost_of_make_rmap: forall f g lev H Hg, ghost_of (proj1_sig (make_rmap f g lev H Hg)) = g.
-refine (fun f g lev H Hg => match proj2_sig (make_rmap f g lev H Hg) with
-                           | conj _ (conj _ GHOST) => GHOST
-                         end).
-Qed.
-
-Lemma ghost_of_remake_rmap: forall f g lev H Hg, ghost_of (proj1_sig (remake_rmap f g lev H Hg)) = g.
-refine (fun f g lev H Hg => match proj2_sig (remake_rmap f g lev H Hg) with
-                           | conj _ (conj _ GHOST) => GHOST
-                         end).
-Qed.
-
-Lemma level_make_rmap: forall f g lev H Hg, @level rmap _ (proj1_sig (make_rmap f g lev H Hg)) = lev.
-refine (fun f g lev H Hg => match proj2_sig (make_rmap f g lev H Hg) with
-                           | conj LEVEL _ => LEVEL
-                         end).
-Qed.
-
-Lemma level_remake_rmap: forall f g lev H Hg, @level rmap _ (proj1_sig (remake_rmap f g lev H Hg)) = lev.
-refine (fun f g lev H Hg => match proj2_sig (remake_rmap f g lev H Hg) with
-                           | conj LEVEL _ => LEVEL
-                         end).
-Qed.
-
-(* Here we build the [rmap]s that correspond to [store]s, [alloc]s and [free]s on the dry memory. *)
-Section inflate.
-Variables (m: mem) (phi: rmap).
-
-Definition inflate_initial_mem' (w: rmap) (loc: address) :=
-   match access_at m loc Cur with
-           | Some Freeable => YES Share.top readable_share_top (VAL (contents_at m loc)) NoneP
-           | Some Writable => YES Ews (writable_readable writable_Ews) (VAL (contents_at m loc)) NoneP
-           | Some Readable => YES Ers readable_Ers (VAL (contents_at m loc)) NoneP
-           | Some Nonempty =>
-                         match w @ loc with PURE _ _ => w @ loc | _ => NO _ nonreadable_extern_retainer end
-           | None =>  NO Share.bot bot_unreadable
-         end.
-
-Lemma inflate_initial_mem'_fmap:
- forall w, resource_fmap (approx (level w)) (approx (level w)) oo inflate_initial_mem' w =
-                inflate_initial_mem' w.
-Proof.
-unfold compose.
-intros.
-unfold inflate_initial_mem'.
-extensionality loc.
-destruct (access_at m loc); try destruct p;
-  try solve [unfold resource_fmap; f_equal; try apply preds_fmap_NoneP].
-rewrite <- level_core.
-  case_eq (w @ loc);intros; try reflexivity.
-  rewrite <- H. rewrite level_core. apply resource_at_approx.
-Qed.
-
-Definition inflate_initial_mem (w: rmap): rmap :=
-    proj1_sig (make_rmap (inflate_initial_mem' w) (ghost_of w) _
-            (inflate_initial_mem'_fmap w) (ghost_of_approx w)).
-
-Lemma inflate_initial_mem_level: forall w, level (inflate_initial_mem w) = level w.
-Proof.
-intros; unfold inflate_initial_mem, inflate_initial_mem'.
-rewrite level_make_rmap; auto.
-Qed.
-
-Definition all_VALs (phi: rmap) :=
-  forall l, match phi @ l with
-              | YES _ _ k _ => isVAL k
-              | _ => True
-            end.
-
-Lemma inflate_initial_mem_all_VALs: forall lev, all_VALs (inflate_initial_mem lev).
-Proof.
-unfold inflate_initial_mem, inflate_initial_mem', all_VALs.
-intros; rewrite resource_at_make_rmap.
-destruct (access_at m l); try destruct p; auto.
- case (lev @ l); simpl; intros; auto.
-Qed.
-
-(* FIXME
-   Build an rmap that's identical to phi except where m has allocated. *)
-Definition inflate_alloc: rmap.
- refine (proj1_sig (remake_rmap (fun loc =>
-   fmap_option (res_option (phi @ loc))
-
-  (* phi = NO *)
-  (fmap_option (access_at m loc Cur)
-    (NO Share.bot bot_unreadable)
-    (fun p =>
-      match p with
-        | Freeable => YES Share.top readable_share_top (VAL (contents_at m loc)) NoneP
-        | _ => NO Share.Lsh Lsh_nonreadable
-      end))
-
-  (* phi = YES *)
-  (fun _ => phi @ loc)) (ghost_of phi) (level phi) _ (ghost_of_approx phi))).
-Proof.
-hnf; auto.
-intro.
-case_eq (phi @ l); simpl; intros; auto.
-case_eq (access_at m l Cur); simpl; intros; auto.
-right; destruct p; simpl; auto.
-left; exists phi; split; auto.
-right; destruct  (access_at m l Cur); simpl; auto.
-destruct p0; simpl; auto.
-Defined.
-
-Lemma approx_map_idem: forall n (lp: preds),
-  preds_fmap (approx n) (approx n) (preds_fmap (approx n) (approx n) lp) =
-  preds_fmap (approx n) (approx n) lp.
-Proof.
-intros n ls.
-change (preds_fmap (approx n) (approx n) (preds_fmap (approx n) (approx n) ls))
-with (((preds_fmap (approx n) (approx n)) oo (preds_fmap (approx n) (approx n))) ls).
-rewrite preds_fmap_comp.
-rewrite (approx_oo_approx n).
-auto.
-Qed.
-
-(* Build an [rmap] that's identical to [phi] except where [m] has stored. *)
-Definition inflate_store: rmap. refine (
-proj1_sig (make_rmap (fun loc =>
-  match phi @ loc with
-    | YES sh rsh (VAL _) _ => YES sh rsh (VAL (contents_at m loc)) NoneP
-    | YES _ _ _ _ => resource_fmap (approx (level phi)) (approx (level phi)) (phi @ loc)
-    | _ => phi @ loc
-  end) (ghost_of phi) (level phi) _ (ghost_of_approx phi))).
-Proof.
-hnf; auto.
-
-unfold compose.
-extensionality l.
-destruct l as (b, ofs).
-remember (phi @ (b, ofs)) as HPHI.
-destruct HPHI; auto.
-(* YES *)
-destruct k; try solve
-  [ unfold resource_fmap; rewrite preds_fmap_NoneP; auto
-  | unfold resource_fmap; rewrite approx_map_idem; auto ].
-rewrite HeqHPHI.
-apply resource_at_approx.
-Defined.
-
-End inflate.
+*)
 
 Lemma adr_inv0: forall (b b': block) (ofs ofs': Z) (sz: Z),
   ~ adr_range (b, ofs) sz (b', ofs') ->
@@ -1074,18 +492,18 @@ apply (nextblock_noaccess m b ofs k).
 auto.
 Qed.
 
-Section initial_mem.
-Variables (m: mem) (w: rmap).
+(*Section initial_mem.
+resourceariables (m: mem) (w: rmap).
 
 Definition initial_rmap_ok :=
-   forall loc, ((fst loc >= nextblock m)%positive -> core w @ loc = NO Share.bot bot_unreadable) /\
+   forall loc, ((fst loc >= nextblock m)%positive -> core w @ loc = None) /\
                    (match w @ loc with
-                    | PURE _ _ => (fst loc < nextblock m)%positive /\
+(*                    | PURE _ _ => (fst loc < nextblock m)%positive /\
                                            access_at m loc Cur = Some Nonempty /\
-                                            max_access_at m loc = Some Nonempty
+                                            max_access_at m loc = Some Nonempty*)
                     | _ => True end).
 Hypothesis IOK: initial_rmap_ok.
-End initial_mem.
+End initial_mem.*)
 
 Definition empty_retainer (loc: address) := Share.bot.
 
@@ -1101,34 +519,40 @@ Lemma perm_of_writable:
 Proof.
 intros.
 unfold perm_of_sh.
-rewrite if_true by auto. rewrite if_false; auto.
+rewrite -> if_true by auto. rewrite if_false; auto.
 Qed.
 
 Lemma perm_of_readable:
   forall sh (rsh: readable_share sh), ~writable0_share sh -> perm_of_sh sh = Some Readable.
 Proof.
-intros. unfold perm_of_sh. rewrite if_false by auto. rewrite if_true; auto.
+intros. unfold perm_of_sh. rewrite -> if_false by auto. rewrite if_true; auto.
 Qed.
 
 Lemma perm_of_nonempty:
   forall sh, sh <> Share.bot -> ~readable_share sh -> perm_of_sh sh = Some Nonempty.
 Proof.
 intros. unfold perm_of_sh.
-rewrite if_false by auto.
-rewrite if_false by auto.
-rewrite if_false by auto; auto.
+rewrite -> if_false by auto.
+rewrite -> if_false by auto.
+rewrite -> if_false by auto; auto.
 Qed.
 
 Lemma perm_of_empty:
     perm_of_sh Share.bot = None.
 Proof.
-intros. unfold perm_of_sh.
-rewrite if_false. rewrite if_false.
-rewrite if_true; auto.
-apply bot_unreadable.
-intro.
-apply writable0_readable in H.
-apply bot_unreadable in H; auto.
+  apply perm_of_sh_bot.
+Qed.
+
+Lemma perm_of_dfrac_None: forall dq, perm_of_dfrac dq = None -> dq = ε ∨ dq = DfracOwn ShareBot.
+Proof.
+  destruct dq as [[|]|[|]]; simpl; try if_tac; try done; auto; intros ->%perm_of_sh_None; auto.
+  rewrite perm_of_sh_bot // in H.
+Qed.
+
+Lemma perm_of_readable_share : forall sh, readable_share sh -> Mem.perm_order' (perm_of_sh sh) Readable.
+Proof.
+  intros; rewrite /perm_of_sh.
+  if_tac; if_tac; try constructor; done.
 Qed.
 
 Lemma perm_of_Ews: perm_of_sh Ews = Some Writable.
@@ -1200,12 +624,12 @@ rewrite Share.lub_absorb in H.
 rewrite Share.distrib1 in H.
 rewrite (@sub_glb_bot Share.Rsh (fst (Share.split Share.Lsh)) Share.Lsh)
  in H.
-rewrite Share.lub_commute, Share.lub_bot in H.
+rewrite -> Share.lub_commute, Share.lub_bot in H.
 rewrite glb_split_x in H.
 destruct (Share.split Share.Rsh) eqn:H0.
 apply nonemp_split_neq1 in H0.
 simpl in *; subst. congruence.
-apply nonidentity_Rsh.
+apply Rsh_nonidentity.
 clear.
 exists (snd (Share.split Share.Lsh)).
 destruct (Share.split Share.Lsh) eqn:H.
@@ -1223,7 +647,7 @@ intro.
 destruct (Share.split Share.Lsh) eqn:H0.
 simpl in *. subst.
 pose proof (Share.split_together _ _ _ H0).
-rewrite Share.lub_commute, Share.lub_bot in H.
+rewrite -> Share.lub_commute, Share.lub_bot in H.
 subst.
 apply nonemp_split_neq2 in H0.
 contradiction H0; auto.
@@ -1240,89 +664,6 @@ left.
 apply bot_identity.
 Qed.
 
-Lemma perm_order''_trans: forall a b c, Mem.perm_order'' a b ->  Mem.perm_order'' b c ->
-                               Mem.perm_order'' a c.
-Proof.
-   intros a b c H1 H2; destruct a, b, c; inversion H1; inversion H2; subst; eauto;
-             eapply perm_order_trans; eauto.
-Qed.
-
-Definition initial_mem (m: mem) lev (IOK: initial_rmap_ok m lev) : juicy_mem.
- refine (mkJuicyMem m  (inflate_initial_mem m lev) _ _ _ _);
-  unfold inflate_initial_mem, inflate_initial_mem';
-  hnf; intros;  try rewrite resource_at_make_rmap in *.
-* (* contents_cohere *)
-revert H; case_eq (access_at m loc Cur); intros.
- destruct p; inv H0; auto.
- revert H2; case_eq (lev @ loc); intros; congruence.
- destruct (max_access_at m loc); try destruct p; try congruence.
-* (* access_cohere *)
- symmetry.
- destruct (access_at m loc) eqn:?; try destruct p; auto; simpl.
- apply perm_of_freeable.
- apply perm_of_Ews.
- apply perm_of_Ers.
- destruct (IOK loc).
- destruct (lev @ loc).
- simpl; rewrite if_false by apply extern_retainer_neq_bot; auto.
- simpl; rewrite if_false by apply extern_retainer_neq_bot; auto.
- reflexivity.
- rewrite if_true; auto.
-* (* max_access_cohere *)
-  { generalize (perm_cur_max m (fst loc) (snd loc)); unfold perm; intros.
-    case_eq (access_at m loc Cur); try destruct p; intros.
-    - unfold perm_order'', perm_order', max_access_at in *.
-    simpl; rewrite perm_of_freeable.
-    apply H.
-    unfold access_at in H0. rewrite H0. constructor.
-    - simpl. rewrite perm_of_Ews.
-    unfold perm_order'', perm_order', max_access_at, access_at in *.
-    rewrite H0 in *.
-    specialize (H Writable). spec H. constructor.
-    apply H.
-     - simpl. rewrite perm_of_Ers.
-    unfold perm_order'', perm_order', max_access_at, access_at in *.
-    rewrite H0 in *.
-    apply H. constructor.
-    - destruct (IOK loc).
-    eapply perm_order''_trans; [apply (access_max m (fst loc) (snd loc))|].
-    unfold access_at in H0; rewrite H0.
-    destruct (lev @ loc) ; simpl;
-    try destruct (@eq_dec Share.t Share.EqDec_share extern_retainer Share.bot); try constructor.
-    - simpl. destruct (eq_dec Share.bot Share.bot) as [e|n]; [| exfalso; apply n; reflexivity].
-      rewrite <- H0.
-      apply (access_max m).
-  }
-* (* alloc_cohere *)
-unfold access_at.
-unfold block; rewrite (nextblock_noaccess m (fst loc) (snd loc) Cur); auto.
-Defined.
-
-Definition juicy_mem_level (j: juicy_mem) (lev: nat) :=
-  level (m_phi j) = lev.
-
-Lemma initial_mem_level: forall lev m j IOK,
-  j = initial_mem m lev IOK -> juicy_mem_level j (level lev).
-Proof.
-intros.
-destruct j; simpl.
-unfold initial_mem in H.
-inversion H; subst.
-unfold juicy_mem_level. simpl.
-erewrite inflate_initial_mem_level; eauto.
-Qed.
-
-Lemma initial_mem_all_VALs: forall lev m j IOK, j = initial_mem m lev IOK
-  -> all_VALs (m_phi j).
-Proof.
-intros until 1; intros (b, ofs).
-destruct j; unfold initial_mem in H; inversion H; subst.
-simpl.
-unfold inflate_initial_mem, inflate_initial_mem'; rewrite resource_at_make_rmap.
-destruct (access_at m (b, ofs)); try destruct p; auto.
-case_eq (lev @ (b,ofs)); intros; auto.
-Qed.
-
 Lemma perm_mem_access: forall m b ofs p,
   perm m b ofs Cur p ->
   exists p', (perm_order p' p /\ access_at m (b, ofs) Cur = Some p').
@@ -1332,142 +673,6 @@ rewrite perm_access in H. red in H.
 destruct (access_at m (b, ofs) Cur); try contradiction; eauto.
 Qed.
 
-Section store.
-Variables (jm: juicy_mem) (m': mem)
-          (ch: memory_chunk) (b: block) (ofs: Z) (v: val)
-          (STORE: store ch (m_dry jm) b ofs v = Some m').
-
-Lemma store_phi_elsewhere_eq: forall rsh sh mv loc',
-  ~ adr_range (b, ofs) (size_chunk ch) loc'
-  -> (m_phi jm) @ loc' = YES rsh sh (VAL mv) NoneP -> contents_at m' loc' = mv.
-Proof.
-destruct jm. simpl in *. clear jm.
-intros.
-unfold contents_at.
-rewrite store_mem_contents with
-  (chunk := ch) (m1 := m) (b := b) (ofs := ofs) (v := v); auto.
-destruct loc' as [b' ofs']. simpl.
-destruct (peq b' b).
-(* b' = b *)
-destruct (adr_inv b b' ofs ofs' ch H).
-symmetry in e.
-contradiction.
-(* b' = b /\ ~ ofs <= ofs' < ofs + size_chunk ch *)
-subst.
-rewrite PMap.gss.
-rewrite setN_outside.
-destruct (JMcontents _ _ _ _ _ H0) as [H5 _].
-apply H5.
-destruct (range_inv _ _ _ H1) as [H1'|H1'].
-left; auto.
-right.
-rewrite encode_val_length.
-rewrite <- size_chunk_conv.
-auto.
-
-(* b' <> b *)
-rewrite PMap.gso; auto.
-destruct (JMcontents _ _ _ _ _ H0) as [H1 _].
-apply H1.
-Qed.
-
-Definition store_juicy_mem: juicy_mem.
- refine (mkJuicyMem m' (inflate_store m' (m_phi jm)) _ _ _ _).
-(* contents_cohere *)
-intros rsh sh' v' loc' pp H2.
-unfold inflate_store in H2; rewrite resource_at_make_rmap in H2.
-destruct (m_phi jm @ loc'); try destruct k; try solve [inversion H2].
-inversion H2; auto.
-(* access_cohere *)
-intro loc; generalize (juicy_mem_access jm loc); intro H0.
-unfold inflate_store; rewrite resource_at_make_rmap.
-rewrite <- (Memory.store_access _ _ _ _ _ _ STORE).
-destruct (m_phi jm @ loc); try destruct k; auto.
-(* max_access_cohere *)
-intro loc; generalize (juicy_mem_max_access jm loc); intro H1.
-unfold inflate_store; rewrite resource_at_make_rmap.
-unfold max_access_at in *.
-rewrite <- (Memory.store_access _ _ _ _ _ _ STORE).
-apply nextblock_store in STORE.
-destruct (m_phi jm @ loc); auto.
-destruct k; simpl; try assumption.
-(* alloc_cohere *)
-hnf; intros.
-unfold inflate_store. rewrite resource_at_make_rmap.
-generalize (juicy_mem_alloc_cohere jm loc); intro.
-rewrite (nextblock_store _ _ _ _ _ _ STORE) in H.
-rewrite (H0 H). auto.
-Defined.
-
-End store.
-
-Section storebytes.
-Variables (jm: juicy_mem) (m': mem) (b: block) (ofs: Z) (bytes: list memval)
-  (STOREBYTES: storebytes (m_dry jm) b ofs bytes = Some m').
-
-Lemma storebytes_phi_elsewhere_eq: forall rsh sh mv loc',
-  ~ adr_range (b, ofs) (Zlength bytes) loc' ->
-  (m_phi jm) @ loc' = YES rsh sh (VAL mv) NoneP ->
-  contents_at m' loc' = mv.
-Proof.
-destruct jm. simpl in *. clear jm.
-intros.
-unfold contents_at.
-rewrite storebytes_mem_contents with
-  (m1 := m) (b := b) (ofs := ofs) (bytes := bytes); auto.
-destruct loc' as [b' ofs']. simpl.
-destruct (peq b' b).
-(* b' = b *)
-destruct (adr_inv0 b b' ofs ofs' (Zlength bytes) H).
-symmetry in e.
-contradiction.
-(* b' = b /\ ~ ofs <= ofs' < ofs + size_chunk ch *)
-subst.
-rewrite PMap.gss.
-rewrite setN_outside.
-destruct (JMcontents _ _ _ _ _ H0) as [H5 _].
-apply H5.
-destruct (range_inv0 _ _ _ H1) as [H1'|H1'].
-left; auto.
-right.
-rewrite <-Zlength_correct; auto.
-(* b' <> b *)
-rewrite PMap.gso; auto.
-destruct (JMcontents _ _ _ _ _ H0) as [H1 _].
-apply H1.
-Qed.
-
-Definition storebytes_juicy_mem: juicy_mem.
- refine (mkJuicyMem m' (inflate_store m' (m_phi jm)) _ _ _ _).
-(* contents_cohere *)
-intros rsh sh' v' loc' pp H2.
-unfold inflate_store in H2; rewrite resource_at_make_rmap in H2.
-destruct (m_phi jm @ loc'); try destruct k; try solve [inversion H2].
-inversion H2; auto.
-(* access_cohere *)
-intro loc; generalize (juicy_mem_access jm loc); intro H0.
-unfold inflate_store; rewrite resource_at_make_rmap.
-rewrite <- (Memory.storebytes_access _ _ _ _ _ STOREBYTES).
-destruct (m_phi jm @ loc); try destruct k; auto.
-(* max_access_cohere *)
-intro loc; generalize (juicy_mem_max_access jm loc); intro H1.
-unfold inflate_store; rewrite resource_at_make_rmap.
-unfold max_access_at in *.
-rewrite <- (Memory.storebytes_access _ _ _ _ _ STOREBYTES).
-assert (H88:=nextblock_storebytes _ _ _ _ _ STOREBYTES).
-destruct (m_phi jm @ loc); try rewrite H88; auto.
-destruct k; simpl; try rewrite H88; auto.
-(* alloc_cohere *)
-hnf; intros.
-unfold inflate_store. rewrite resource_at_make_rmap.
-generalize (juicy_mem_alloc_cohere jm loc); intro.
-rewrite (nextblock_storebytes _ _ _ _ _ STOREBYTES) in H.
-rewrite (H0 H).
-auto.
-Defined.
-
-End storebytes.
-
 Lemma free_smaller_None : forall m b b' ofs lo hi m',
   access_at m (b, ofs) Cur = None
   -> free m b' lo hi = Some m'
@@ -1489,6 +694,9 @@ assert (~(lo <= ofs < lo + (hi - lo))) by intuition.
 lia.
 Qed.
 
+Definition contents_at (m: mem) (loc: address) : memval :=
+  Maps.ZMap.get (snd loc) (Maps.PMap.get (fst loc) (Mem.mem_contents m)).
+
 Lemma free_nadr_range_eq : forall m b b' ofs' lo hi m',
   ~ adr_range (b, lo) (hi - lo) (b', ofs')
   -> free m b lo hi = Some m'
@@ -1514,87 +722,6 @@ simpl.
 reflexivity.
 Qed.
 
-Section free.
-Variables (jm :juicy_mem) (m': mem)
-          (b: block) (lo hi: Z)
-          (FREE: free (m_dry jm) b lo hi = Some m')
-          (PERM: forall ofs, lo <= ofs < hi ->
-                      perm_of_res (m_phi jm @ (b,ofs)) = Some Freeable).
-
-Definition inflate_free: rmap. refine (
-proj1_sig (make_rmap (fun loc =>
-  if adr_range_dec (b,lo) (hi-lo) loc then NO Share.bot bot_unreadable else m_phi jm @ loc)
-    (ghost_of (m_phi jm))
-     (level (m_phi jm)) _ (ghost_of_approx (m_phi jm)))).
-Proof.
-unfold compose.
-extensionality l.
-destruct l as (b', ofs').
-if_tac; try reflexivity.
-apply resource_at_approx.
-Defined.
-
-
-Definition free_juicy_mem: juicy_mem.
- generalize (juicy_mem_contents jm); intro.
- generalize (juicy_mem_access jm); intro.
- generalize (juicy_mem_max_access jm); intro.
- refine (mkJuicyMem m' inflate_free _ _ _ _).
-* (* contents_cohere *)
-unfold contents_cohere in *.
-intros rsh' sh' v' [b' ofs'] pp H2.
-unfold access_cohere in H0.
-specialize (H0 (b', ofs')).
-unfold inflate_free in H2; rewrite resource_at_make_rmap in H2.
-if_tac in H2; [inv H2 | ]. rename H3 into H8.
-remember (m_phi jm @ (b', ofs')) as HPHI.
-destruct HPHI; try destruct k; inv H2.
-assert (H3: contents_at (m_dry jm) (b', ofs') = v') by (eapply H; eauto).
-assert (H4: m' = unchecked_free (m_dry jm) b lo hi) by (apply free_result; auto).
-rewrite H4.
-unfold unchecked_free, contents_at; simpl.
-split; auto.
-symmetry in HeqHPHI.
-destruct (H _ _ _ _ _ HeqHPHI); auto.
-* (* access_cohere *)
-intros [b' ofs']; specialize ( H0 (b', ofs')).
-unfold inflate_free; rewrite resource_at_make_rmap.
-destruct (adr_range_dec (b,lo) (hi-lo) (b',ofs')).
- + (* adr_range *)
-destruct a as [H2 H3].
-replace (lo+(hi-lo)) with hi in H3 by lia.
-subst b'.
-replace (access_at m' (b, ofs') Cur) with (@None permission).
-simpl. rewrite if_true by auto. auto.
-destruct (free_access _ _ _ _ _ FREE ofs' H3).
-pose proof (Memory.access_cur_max m' (b,ofs')). rewrite H4 in H5.
-simpl  in H5.
-destruct (access_at m' (b, ofs') Cur); auto; contradiction.
-+ (* ~adr_range *)
-destruct (free_nadr_range_eq _ _ _ _ _ _ _ n FREE) as [H2 H3].
-rewrite H2 in *. clear H2 H3.
-case_eq (m_phi jm @ (b', ofs')); intros; rewrite H2 in *; auto.
-* (* max_access_cohere *)
-{ intros [b' ofs']. specialize (H1 (b',ofs')).
-  unfold inflate_free. unfold max_access_at. rewrite resource_at_make_rmap.
-  destruct (adr_range_dec (b,lo) (hi-lo) (b',ofs')).
-  - simpl; destruct (eq_dec Share.bot Share.bot) as [e|n]; [| exfalso; apply n; reflexivity].
-    destruct (access_at m' (b', ofs') Max); constructor.
-  - clear PERM.
-    unfold max_access_at.
-    destruct (free_nadr_range_eq _ _ _ _ _ _ _ n FREE) as [H2 H3].
-    rewrite <- H2. assumption. }
-* (* alloc_cohere *)
-hnf; intros.
-unfold inflate_free. rewrite resource_at_make_rmap.
-pose proof (juicy_mem_alloc_cohere jm loc).
-rewrite (nextblock_free _ _ _ _ _ FREE) in H2; auto.
-rewrite H3; auto.
-if_tac; auto.
-Defined.
-
-End free.
-
 Lemma free_not_freeable_eq : forall m b lo hi m' b' ofs',
   free m b lo hi = Some m'
   -> access_at m (b', ofs') Cur <> Some Freeable
@@ -1612,72 +739,6 @@ subst b'.
 simpl in n. assert (~( lo <= ofs' < lo + (hi - lo))) by intuition; lia.
 Qed.
 
-(* The empty juicy memory *)
-
-Definition after_alloc'
-  (lo hi: Z) (b: block) (phi: rmap)(H: forall ofs, phi @ (b,ofs) = NO Share.bot bot_unreadable)
-  : address -> resource := fun loc =>
-    if adr_range_dec (b,lo) (hi-lo) loc
-      then YES Share.top readable_share_top (VAL Undef) NoneP
-      else phi @ loc.
-
-Lemma adr_range_eq_block : forall b ofs n b' ofs',
-  adr_range (b,ofs) n (b',ofs') ->
-  b=b'.
-Proof.
-unfold adr_range; intros.
-destruct H; auto.
-Qed.
-
-Lemma after_alloc'_ok : forall lo hi b phi H,
-  resource_fmap (approx (level phi)) (approx (level phi)) oo (after_alloc' lo hi b phi H)
-  = after_alloc' lo hi b phi H.
-Proof.
-intros.
-unfold resource_fmap, compose, after_alloc'.
-extensionality loc.
-if_tac.
-rewrite preds_fmap_NoneP; auto.
-case_eq (phi @ loc); intros; auto.
-generalize H1; intros.
-apply necR_YES with (phi':=phi) in H1; eauto.
-rewrite <- H1.
-auto.
-generalize (resource_at_approx phi loc); rewrite H1; auto.
-Qed.
-
-Definition after_alloc
-  (lo hi: Z) (b: block) (phi: rmap)(H: forall ofs, phi @ (b,ofs) = NO Share.bot bot_unreadable) : rmap :=
-  proj1_sig (make_rmap (after_alloc' lo hi b phi H) (ghost_of phi)
-    (level phi)
-    (after_alloc'_ok lo hi b phi H) (ghost_of_approx phi)).
-
-Definition mod_after_alloc' (phi: rmap) (lo hi: Z) (b: block)
-  : address -> resource := fun loc =>
-    if adr_range_dec (b,lo) (hi-lo) loc
-      then YES Share.top readable_share_top (VAL Undef) NoneP
-      else core phi @ loc.
-
-Lemma mod_after_alloc'_ok : forall phi lo hi b,
-  resource_fmap (approx (level phi)) (approx (level phi)) oo (mod_after_alloc'  phi lo hi b)
-  = mod_after_alloc' phi lo hi b.
-Proof.
-intros.
-unfold resource_fmap, compose, mod_after_alloc'.
-extensionality loc.
-if_tac; auto.
-case_eq (core phi @ loc); intros; auto; f_equal;
-rewrite <- level_core;
-generalize (resource_at_approx (core phi) loc); rewrite H0; intro; injection H1; auto.
-Qed.
-
-Definition mod_after_alloc (phi: rmap) (lo hi: Z) (b: block) :=
-  proj1_sig (make_rmap (mod_after_alloc' phi lo hi b) (ghost_of phi)
-    _
-    (mod_after_alloc'_ok phi lo hi b) (ghost_of_approx phi)).
-
-Transparent alloc.
-
 Lemma adr_range_inv: forall loc loc' n,
   ~ adr_range loc n loc' ->
   fst loc <> fst loc' \/ (fst loc=fst loc' /\ ~snd loc <= snd loc' < snd loc + n).
@@ -1694,7 +755,7 @@ left; intro Contra.
 apply n0; auto.
 Qed.
 
-Lemma dry_noperm_juicy_nonreadable : forall m loc,
+(*Lemma dry_noperm_juicy_nonreadable : forall m loc,
   access_at (m_dry m) loc Cur = None ->   ~readable loc (m_phi m).
 Proof.
 intros.
@@ -1706,7 +767,7 @@ unfold perm_of_sh in H2.
 if_tac in H2. if_tac in H2; inv H2.
 rewrite if_true in H2 by auto.
 inv H2.
-Qed.
+Qed.*)
 
 Lemma fullempty_after_alloc : forall m1 m2 lo n b ofs,
   alloc m1 lo n = (m2, b) ->
@@ -1723,11 +784,13 @@ apply nextblock_access_empty.
 apply Pos.le_ge, Pos.le_refl.
 Qed.
 
+Transparent alloc.
+
 Lemma alloc_dry_unchanged_on : forall m1 m2 loc lo hi b0,
   alloc m1 lo hi = (m2, b0) ->
   ~adr_range (b0,lo) (hi-lo) loc ->
   access_at m1 loc = access_at m2 loc /\
-  (access_at m1 loc Cur <> None -> contents_at m1 loc= contents_at m2 loc).
+  (access_at m1 loc Cur <> None -> contents_at m1 loc = contents_at m2 loc).
 Proof.
 intros.
 destruct loc as [b z]; simpl.
@@ -1746,7 +809,7 @@ subst.
 rewrite invalid_noaccess in H1; [ congruence |].
 contradict H0.
 red in H0. apply Pos.lt_irrefl in H0. contradiction.
-rewrite PMap.gso by auto.
+rewrite -> Maps.PMap.gso by auto.
 auto.
 Qed.
 
@@ -1778,475 +841,678 @@ destruct H0. subst b'.
 apply (alloc_access_same _ _ _ _ _ H). lia.
 unfold contents_at; unfold alloc in H; inv H. simpl.
 destruct H0; subst b'.
-rewrite PMap.gss. rewrite ZMap.gi; auto.
+rewrite Maps.PMap.gss. rewrite Maps.ZMap.gi; auto.
 Qed.
 
-Definition resource_decay (nextb: block) (phi1 phi2: rmap) :=
-  (level phi1 >= level phi2)%nat /\
+Opaque alloc.
+
+(*(* Not sure this is usable, but it's the most direct translation. *)
+Definition resource_decay n (nextb: block) (phi1 phi2: rmap) :=
  forall l: address,
-  ((fst l >= nextb)%positive -> phi1 @ l = NO Share.bot bot_unreadable) /\
-  (resource_fmap (approx (level phi2)) (approx (level phi2)) (phi1 @ l) = (phi2 @ l) \/
-  (exists sh, exists (wsh: writable0_share sh), exists v, exists v',
-       resource_fmap (approx (level phi2)) (approx (level phi2)) (phi1 @ l) =
-                       YES sh (writable0_readable wsh) (VAL v) NoneP /\
-       phi2 @ l = YES sh (writable0_readable wsh) (VAL v') NoneP)
-  \/ ((fst l >= nextb)%positive /\ exists v, phi2 @ l = YES Share.top readable_share_top (VAL v) NoneP)
-  \/ (exists v, exists pp, phi1 @ l = YES Share.top readable_share_top (VAL v) pp
-                        /\ phi2 @ l = NO Share.bot bot_unreadable)).
-
-Definition resource_nodecay (nextb: block) (phi1 phi2: rmap) :=
-  (level phi1 >= level phi2)%nat /\
+  ((fst l >= nextb)%positive -> forall dq r, ~ouPred_holds (l ↦{dq} r) n phi1) /\
+ ((forall dq r, ouPred_holds (l ↦{dq} r) n phi1 <-> ouPred_holds (l ↦{dq} r) n phi2) \/
+  (exists sh v v', writable0_share sh /\ ouPred_holds (l ↦{#sh} VAL v) n phi1 /\
+                                         ouPred_holds (l ↦{#sh} VAL v') n phi2) \/
+  ((fst l >= nextb)%positive /\ exists v, ouPred_holds (l ↦ VAL v) n phi2) \/
+  (exists v, ouPred_holds (l ↦ VAL v) n phi1 /\ forall dq r, ~ouPred_holds (l ↦{dq} r) n phi2)).
+
+Definition resource_nodecay n (nextb: block) (phi1 phi2: rmap) :=
   forall l: address,
-  ((fst l >= nextb)%positive -> phi1 @ l = NO Share.bot bot_unreadable) /\
-  (resource_fmap (approx (level phi2)) (approx (level phi2)) (phi1 @ l) = (phi2 @ l) \/
-  (exists sh, exists (wsh: writable0_share sh), exists v, exists v',
-       resource_fmap (approx (level phi2)) (approx (level phi2)) (phi1 @ l) = YES sh (writable0_readable wsh) (VAL v) NoneP
-      /\ phi2 @ l = YES sh (writable0_readable wsh) (VAL v') NoneP)).
+  ((fst l >= nextb)%positive -> forall dq r, ~ouPred_holds (l ↦{dq} r) n phi1) /\
+ ((forall dq r, ouPred_holds (l ↦{dq} r) n phi1 <-> ouPred_holds (l ↦{dq} r) n phi2) \/
+  (exists sh v v', writable0_share sh /\ ouPred_holds (l ↦{#sh} VAL v) n phi1 /\
+                                         ouPred_holds (l ↦{#sh} VAL v') n phi2)).
 
 Lemma resource_nodecay_decay:
-   forall b phi1 phi2, resource_nodecay b phi1 phi2 -> resource_decay b phi1 phi2.
-Proof.
- unfold resource_decay, resource_nodecay; intros; destruct H; split; intros; try lia.
-specialize (H0 l); intuition.
-Qed.
-
-Lemma resource_decay_refl: forall b phi,
-  (forall l, (fst l >= b)%positive -> phi @ l = NO Share.bot bot_unreadable) ->
-  resource_decay b phi phi.
-Proof.
-intros.
-split; auto.
-intros; split; auto.
-left.
-apply resource_at_approx.
-Qed.
-
-Lemma resource_decay_trans: forall b b' m1 m2 m3,
-  (b <= b')%positive ->
-  resource_decay b m1 m2 -> resource_decay b' m2 m3 -> resource_decay b m1 m3.
-Proof.
- intros until m3; intro Hbb; intros.
- destruct H as [H' H]; destruct H0 as [H0' H0]; split; [lia |].
- intro l; specialize (H l); specialize (H0 l).
- destruct H,H0.
- split.  auto.
- destruct H1.
- destruct H2.
- left. rewrite <- H2.
- replace (resource_fmap (approx (level m3)) (approx (level m3)) (m1 @ l))
-    with (resource_fmap (approx (level m3)) (approx (level m3))
-              (resource_fmap (approx (level m2)) (approx (level m2)) (m1 @ l)))
-  by (rewrite resource_fmap_fmap; rewrite approx_oo_approx' by auto; rewrite approx'_oo_approx by auto; auto).
-rewrite H1. auto.
- clear - Hbb H H1 H0 H2 H' H0'.
- right.
- destruct H2 as [[sh2 [wsh2 [v2 [v2' [? ?]]]]]|[[? [v ?]] |?]]; subst.
- left; exists sh2, wsh2,v2,v2'; split; auto.
- rewrite <- H1 in H2.
- rewrite resource_fmap_fmap in H2.
- rewrite approx_oo_approx' in H2 by lia.
- rewrite approx'_oo_approx in H2 by lia.
- assumption.
- right; left. split. lia. exists v; auto.
- right; right; auto.
- destruct H2 as [v [pp [? ?]]].
- rewrite H2 in H1. destruct (m1 @ l); inv H1.
- exists v, p. split; auto. f_equal. apply proof_irr.
- destruct H2.
- destruct H1 as [[sh [wsh [v [v' [? ?]]]]]|[[? [v ?]] |?]].
- right; left; exists sh,wsh,v,v'; split.
- rewrite <- (approx_oo_approx' (level m3) (level m2)) at 1 by auto.
- rewrite <- (approx'_oo_approx (level m3) (level m2)) at 2 by auto.
- rewrite <- resource_fmap_fmap. rewrite H1.
- unfold resource_fmap. rewrite preds_fmap_NoneP. auto.
- rewrite H3 in H2. rewrite <- H2.
- unfold resource_fmap. rewrite preds_fmap_NoneP. auto.
- right; right; left; split; auto. exists v. rewrite <- H2; rewrite <- H3.
- rewrite H3.
- unfold resource_fmap. rewrite preds_fmap_NoneP. auto.
- right; right; right.
- destruct H1 as [v [pp [? ?]]].
- rewrite H3 in H2. simpl in H2. eauto.
- destruct H1 as [[sh [wsh [v [v' [? ?]]]]]|[[? [v ?]] |?]].
- destruct H2 as [[sh2 [wsh2 [v2 [v2' [? ?]]]]]|[[? [v2 ?]] |?]].
- right; left; exists sh,wsh,v,v2'; split.
- rewrite <- (approx_oo_approx' (level m3) (level m2)) at 1 by auto.
- rewrite <- (approx'_oo_approx (level m3) (level m2)) at 2 by auto.
- rewrite <- resource_fmap_fmap. rewrite H1.
- unfold resource_fmap. rewrite preds_fmap_NoneP. auto.
- rewrite H3 in H2. rewrite H4. simpl in H2. inv H2.
- f_equal. apply proof_irr.
- right; right; left. split. lia. exists v2; auto.
- right; right; right.
- destruct (m1 @ l); inv H1.
- destruct H2 as [vx [pp [? ?]]]. inversion2 H3 H1.
- exists v,p. split; auto. f_equal; apply proof_irr.
- destruct H2 as [[sh2 [wsh2 [v2 [v2' [? ?]]]]]|[[? [v2 ?]] |?]].
- right; right; left; split; auto. exists v2'. rewrite H3 in H2; inv H2.
- rewrite H4; f_equal; apply proof_irr.
- right; right; left; split; auto; exists v2; auto.
- left. destruct H2 as [v' [pp [? ?]]]. rewrite H4; rewrite H; auto.
- destruct H2 as [[sh2 [wsh2 [v2 [v2' [? ?]]]]]|[[? [v2 ?]] |?]].
- destruct H1 as [v' [pp [? ?]]].
- rewrite H4 in H2; inv H2.
- right; right; left; split. lia. eauto.
- right; right; right.
- destruct H1 as [v1 [pp1 [? ?]]].
- destruct H2 as [v2 [pp2 [? ?]]].
- inversion2 H3 H2.
-Qed.
-
-Lemma level_store_juicy_mem:
- forall jm m ch b i v H, level (store_juicy_mem jm m ch b i v H) = level jm.
-Proof.
-intros.
-unfold store_juicy_mem. simpl.
-unfold inflate_store; simpl. rewrite level_make_rmap. auto.
-Qed.
-
-Lemma level_storebytes_juicy_mem:
- forall jm m b i bytes H, level (storebytes_juicy_mem jm m b i bytes H) = level jm.
-Proof.
-intros.
-unfold storebytes_juicy_mem. simpl.
-unfold inflate_store; simpl. rewrite level_make_rmap. auto.
-Qed.
-
-Lemma inflate_store_resource_nodecay:
-  forall (jm: juicy_mem) (m': mem)
-          (ch: memory_chunk) (b: block) (ofs: Z) (v: val)
-          (STORE: store ch (m_dry jm) b ofs v = Some m')
-          (PERM: forall z, ofs <= z < ofs + size_chunk ch ->
-                      perm_order'' (perm_of_res (m_phi jm @ (b,z))) (Some Writable))
-          phi',
-  inflate_store m' (m_phi jm) = phi' -> resource_nodecay (nextblock (m_dry jm)) (m_phi jm) phi'.
-Proof.
-intros.
-split.
-subst; unfold inflate_store; simpl. rewrite level_make_rmap. auto.
-intro l'.
-split.
-apply juicy_mem_alloc_cohere.
-destruct (adr_range_dec (b, ofs) (size_chunk ch) l') as [HA | HA].
-* (* adr_range *)
-right.
-unfold adr_range in HA.
-destruct l' as (b', ofs').
-destruct HA as [HA0 HA1].
-subst b'.
-assert (H0: range_perm (m_dry jm) b ofs (ofs + size_chunk ch) Cur Writable).
-  cut (valid_access (m_dry jm) ch b ofs Writable).
-  intros [? ?]; auto.
-  eapply store_valid_access_3; eauto.
-assert (H1: perm (m_dry jm) b ofs' Cur Writable) by (apply H0; auto).
-generalize (juicy_mem_access jm (b, ofs')); intro ACCESS.
-unfold perm, perm_order' in H1.
-unfold access_at in ACCESS.
-simpl in *.
-destruct ((mem_access (m_dry jm)) !! b ofs' Cur) eqn:?H; try contradiction.
-specialize (PERM ofs' HA1).
-destruct ( m_phi jm @ (b, ofs') ) eqn:?H; try destruct k; simpl in PERM; try if_tac in PERM; try inv PERM.
-destruct (juicy_mem_contents _ _ _ _ _ _ H3); subst.
-simpl.
-assert (writable0_share sh). {
- clear - PERM.
- unfold perm_of_sh in PERM.
- if_tac in PERM; auto. if_tac in PERM. inv PERM.
- if_tac in PERM; inv PERM.
-}
- exists sh,H; do 2 econstructor; split; simpl; f_equal.
- apply proof_irr.
-unfold inflate_store;  rewrite resource_at_make_rmap.
-rewrite H3. f_equal; apply proof_irr.
-* (* ~ adr_range *)
-left.
-assert (H0: level (m_phi jm) = level phi').
-  rewrite <- H; unfold inflate_store; rewrite level_make_rmap; auto.
-rewrite <- H.
-unfold inflate_store; rewrite level_make_rmap; rewrite resource_at_make_rmap.
-case_eq l'; intros b' ofs' e'; subst.
-remember (m_phi jm @ (b', ofs')) as HPHI; destruct HPHI; try destruct k; auto;
-  try solve [rewrite HeqHPHI; rewrite resource_at_approx; auto].
-rewrite (store_phi_elsewhere_eq jm _ _ _ _ _ STORE _ r m (b', ofs')); auto.
-assert (H: p = NoneP).
-  symmetry in HeqHPHI;
-  destruct  (juicy_mem_contents jm _ _ _ _ _ HeqHPHI); auto.
-rewrite H.
-unfold resource_fmap; f_equal; try reflexivity.
-assert (H: p = NoneP).
-  symmetry in HeqHPHI;
-  destruct  (juicy_mem_contents jm _ _ _ _ _ HeqHPHI); auto.
-rewrite H in HeqHPHI; clear H.
-rewrite HeqHPHI; auto.
-Qed.
-
-Lemma inflate_free_resource_decay:
- forall (jm :juicy_mem) (m': mem)
-          (b: block) (lo hi: Z)
-          (FREE: free (m_dry jm) b lo hi = Some m')
-          (PERM: forall ofs : Z,
-             lo <= ofs < hi -> perm_of_res (m_phi jm @ (b, ofs)) = Some Freeable),
-   resource_decay (nextblock (m_dry jm)) (m_phi jm) (inflate_free jm b lo hi).
-Proof.
-intros.
-split.
-unfold inflate_free; rewrite level_make_rmap; auto.
-intros l.
-split.
-apply juicy_mem_alloc_cohere.
-destruct (adr_range_dec (b, lo) (hi-lo) l) as [HA | HA].
-* (* adr_range *)
-right. right.
-destruct l; simpl in HA|-*.
-destruct HA as [H0 H1]. subst b0.
-assert (lo + (hi - lo) = hi) by lia.
-rewrite H in H1. clear H.
-unfold inflate_free; simpl; rewrite resource_at_make_rmap.
-specialize (PERM _ H1).
-destruct (m_phi jm @ (b,z)) eqn:?; try destruct k; inv PERM.
-if_tac in H0; inv H0.
-rewrite if_true by (split; auto; lia).
-right.
-exists m, p.
-unfold perm_of_sh in H0.
-repeat if_tac in H0; inv H0.
-split; try reflexivity. f_equal; apply proof_irr.
-* (* ~adr_range *)
-destruct l.
-destruct (free_nadr_range_eq _ _ _ _ _ _ _ HA FREE).
-left.
-unfold inflate_free; rewrite level_make_rmap; rewrite resource_at_make_rmap.
-rewrite if_false by auto.
-generalize (juicy_mem_contents jm); intro Hc.
-generalize (juicy_mem_access jm (b0,z)); intro Ha.
-rewrite resource_at_approx.
-case_eq (m_phi jm @ (b0, z)); intros; rewrite H1 in Ha; auto.
-Qed.
-
-Lemma juicy_store_nodecay:
-  forall jm m' ch b ofs v
-       (H: store ch (m_dry jm) b ofs v = Some m')
-          (PERM: forall z, ofs <= z < ofs + size_chunk ch ->
-                      perm_order'' (perm_of_res (m_phi jm @ (b,z))) (Some Writable)),
-       resource_nodecay (nextblock (m_dry jm)) (m_phi jm) (m_phi (store_juicy_mem jm _ _ _ _ _ H)).
-Proof.
- intros.
- eapply inflate_store_resource_nodecay; eauto.
-Qed.
-
-Lemma can_age1_juicy_mem: forall j r,
-  age (m_phi j) r -> exists j', age1 j = Some j'.
-Proof.
-intros j r H.
-unfold age in H.
-case_eq (age1_juicy_mem j); intros.
-destruct (age1_juicy_mem_unpack _ _ H0).
-eexists; eauto.
-apply age1_juicy_mem_None1 in H0.
-rewrite H0 in H.
-exfalso; inversion H.
-Qed.
-
-
-Lemma can_age_jm:
-  forall jm, age1 (m_phi jm) <> None -> exists jm', age jm jm'.
-Proof.
- intro jm; case_eq (age1 (m_phi jm)); intros; try congruence.
- apply (can_age1_juicy_mem _ _ H).
-Qed.
-
-
-Lemma age_jm_dry: forall {jm jm'}, age jm jm' -> m_dry jm = m_dry jm'.
-Proof. intros; destruct (age1_juicy_mem_unpack _ _ H); auto.
-Qed.
-
-Lemma age_jm_phi: forall {jm jm'}, age jm jm' -> age (m_phi jm) (m_phi jm').
-Proof. intros; destruct (age1_juicy_mem_unpack _ _ H); auto.
-Qed.
-
-(** * Results about aging in juicy memory coherence properties *)
-
-Lemma age1_YES'_1 {phi phi' l rsh sh k P} :
-  age1 phi = Some phi' ->
-  phi @ l = YES rsh sh k P ->
-  (exists P, phi' @ l = YES rsh sh k P).
-Proof.
-  intros A E.
-  apply (proj1 (age1_YES' phi phi' l rsh sh k A)).
-  eauto.
-Qed.
-
-Lemma age1_YES'_2 {phi phi' l rsh sh k P} :
-  age1 phi = Some phi' ->
-  phi' @ l = YES rsh sh k P ->
-  (exists P, phi @ l = YES rsh sh k P).
-Proof.
-  intros A E.
-  apply (proj2 (age1_YES' phi phi' l rsh sh k A)).
-  eauto.
-Qed.
-
-Lemma age1_PURE_2 {phi phi' l k P} :
-  age1 phi = Some phi' ->
-  phi' @ l = PURE k P ->
-  (exists P, phi @ l = PURE k P).
-Proof.
-  intros A E.
-  apply (proj2 (age1_PURE phi phi' l k A)).
-  eauto.
-Qed.
-
-Lemma perm_of_res_age x y loc :
-  age x y -> perm_of_res (x @ loc) = perm_of_res (y @ loc).
-Proof.
-  intros A.
-  destruct (x @ loc) as [sh | rsh sh k p | k p] eqn:E.
-  - destruct (age1_NO x y loc sh n A) as [[]_]; eauto.
-  - destruct (age1_YES' x y loc rsh sh k A) as [[p' ->] _]; eauto.
-  - destruct (age1_PURE x y loc k A) as [[p' ->] _]; eauto.
-Qed.
-
-Lemma contents_cohere_age m : hereditary age (contents_cohere m).
-Proof.
-  intros x y E A.
-  intros rsh sh v loc pp H.
-  destruct (proj2 (age1_YES' _ _ loc rsh sh (VAL v) E)) as [pp' E'].
-  now eauto.
-  specialize (A rsh sh v loc _ E').
-  destruct A as [A ->]. split; auto.
-  apply (proj1 (age1_YES _ _ loc rsh sh (VAL v) E)) in E'.
-  congruence.
-Qed.
-
-Lemma access_cohere_age m : hereditary age (access_cohere m).
-Proof.
-  intros x y E B.
-  intros addr.
-  destruct (age1_levelS _ _ E) as [n L].
-  rewrite (B addr).
-  apply perm_of_res_age, E.
-Qed.
-
-Lemma max_access_cohere_age m : hereditary age (max_access_cohere m).
-Proof.
-  intros x y E C.
-  intros addr; specialize (C addr).
-  destruct (y @ addr) as [sh | sh p k pp | k p] eqn:AT.
-  - eapply (age1_NO x) in AT; auto.
-    rewrite AT in C; auto.
-  - destruct (age1_YES'_2 E AT) as [P Ex].
-    rewrite Ex in C.
-    auto.
-  - destruct (age1_PURE_2 E AT) as [P Ex].
-    rewrite Ex in C; auto.
-Qed.
-
-Lemma alloc_cohere_age m : hereditary age (alloc_cohere m).
-Proof.
-  intros x y E D.
-  intros loc G; specialize (D loc G).
-  eapply (age1_NO x); eauto.
-Qed.
-
-
-(** * Results in the opposite direction *)
-
-Definition unage {A} {_:ageable A} x y := age y x.
-
-Lemma unage_YES'_1 {phi phi' l rsh sh k P} :
-  age1 phi' = Some phi ->
-  phi @ l = YES rsh sh k P ->
-  (exists P, phi' @ l = YES rsh sh k P).
-Proof.
-  intros A E.
-  apply (proj2 (age1_YES' phi' phi l rsh sh k A)).
-  eauto.
-Qed.
-
-Lemma unage_YES'_2 {phi phi' l rsh sh k P} :
-  age1 phi' = Some phi ->
-  phi' @ l = YES rsh sh k P ->
-  (exists P, phi @ l = YES rsh sh k P).
-Proof.
-  intros A E.
-  apply (proj1 (age1_YES' phi' phi l rsh sh k A)).
-  eauto.
-Qed.
-
-Lemma unage_PURE_2 {phi phi' l k P} :
-  age1 phi' = Some phi ->
-  phi' @ l = PURE k P ->
-  (exists P, phi @ l = PURE k P).
-Proof.
-  intros A E.
-  apply (proj1 (age1_PURE phi' phi l k A)).
-  eauto.
-Qed.
-
-Lemma contents_cohere_unage m : hereditary unage (contents_cohere m).
-Proof.
-  intros x y E A.
-  intros rsh sh v loc pp H.
-  destruct (proj1 (age1_YES' _ _ loc rsh sh (VAL v) E)) as [pp' E'].
-  eauto.
-  specialize (A rsh sh v loc _ E').
-  destruct A as [A ->]. split; auto.
-  apply (proj2 (age1_YES _ _ loc rsh sh (VAL v) E)) in E'.
-  congruence.
-Qed.
-
-Lemma access_cohere_unage m : hereditary unage (access_cohere m).
-Proof.
-  intros x y E B.
-  intros addr.
-  destruct (age1_levelS _ _ E) as [n L].
-  rewrite (B addr).
-  symmetry.
-  apply perm_of_res_age, E.
-Qed.
-
-Lemma max_access_cohere_unage m : hereditary unage (max_access_cohere m).
-Proof.
-  intros x y E C.
-  intros addr; specialize (C addr).
-  destruct (x @ addr) as [sh | sh p k pp | k p] eqn:AT.
-  - eapply (age1_NO y) in AT; auto.
-    rewrite AT; auto.
-  - destruct (@age1_YES'_2 y x addr sh p k pp E AT) as [P ->].
-    auto.
-  - destruct (age1_PURE_2 E AT) as [P Ex].
-    rewrite Ex; auto.
-Qed.
-
-Lemma alloc_cohere_unage m : hereditary unage (alloc_cohere m).
-Proof.
-  intros x y E D.
-  intros loc G; specialize (D loc G).
-  eapply (age1_NO y); eauto.
-Qed.
-
-Lemma juicy_mem_unage jm' : { jm | age jm jm' }.
-Proof.
-  pose proof (rmap_unage_age (m_phi jm')) as A.
-  remember (rmap_unage (m_phi jm')) as phi.
-  unshelve eexists (mkJuicyMem (m_dry jm') phi _ _ _ _).
-  all: destruct jm' as [m phi' Co Ac Ma N]; simpl.
-  - eapply contents_cohere_unage; eauto.
-  - eapply access_cohere_unage; eauto.
-  - eapply max_access_cohere_unage; eauto.
-  - eapply alloc_cohere_unage; eauto.
-  - apply age1_juicy_mem_unpack''; auto.
-Qed.
+   forall n b phi1 phi2, resource_nodecay n b phi1 phi2 -> resource_decay n b phi1 phi2.
+Proof.
+  unfold resource_decay, resource_nodecay; intros.
+  specialize (H l); intuition.
+Qed.
+
+Lemma resource_decay_refl: forall n b phi,
+  (forall l, (fst l >= b)%positive -> forall dq r, ~ouPred_holds (l ↦{dq} r) n phi) ->
+  resource_decay n b phi phi.
+Proof.
+intros; intros l; auto.
+Qed.
+
+(*Lemma resource_decay_trans: forall n b b' m1 m2 m3 (Hbb : (b <= b')%positive),
+  resource_decay n b m1 m2 -> resource_decay n b' m2 m3 -> resource_decay n b m1 m3.
+Proof.
+  intros; intros l.
+  specialize (H l); specialize (H0 l).
+  destruct H,H0.
+  split. auto.
+  destruct H1.
+  { setoid_rewrite H1. destruct H2 as [?|[?|[[??]|?]]]; auto.
+    assert (l.1 >= b)%positive by lia; auto. }
+  destruct H2.
+  { setoid_rewrite <- H2. auto. }
+  destruct H1 as [? | [? | ?]].
+  - destruct H1 as (sh & v & v' & ? & ? & ?).
+    destruct H2 as [? | [[??] | ?]].
+    + destruct H2 as (sh2 & v2 & v2' & ? & ? & ?).
+      right; left; exists sh, v, v2'; split; auto; split; auto.
+       (* can only have one writable share *)
+    + exfalso; eapply H0; eauto.
+    + destruct H2 as (? & ? & ?); right; right; right.
+      eexists; split; eauto.
+       (* writable share again *)
+  - destruct H1 as (? & ? & ?).
+Abort. (* should be provable *)*)*)
+
+Section mpred.
+
+  Context `{!gen_heapGS share address resource Σ} `{!wsatGS Σ}.
+  Notation mpred := (iProp Σ).
+
+  Definition core_load (ch: memory_chunk) (l: address) (v: val): mpred :=
+    <absorb> ∃ bl: list memval,
+    ⌜length bl = size_chunk_nat ch /\ decode_val ch bl = v /\ (align_chunk ch | snd l)%Z⌝ ∧
+      ([∗ list] i↦b ∈ bl, ∃ sh, ⌜Mem.perm_order' (perm_of_dfrac sh) Readable⌝ ∧ mapsto (adr_add l (Z.of_nat i)) sh (VAL b)).
+
+  Definition core_load' (ch: memory_chunk) (l: address) (v: val) (bl: list memval) : mpred :=
+    <absorb> (⌜length bl = size_chunk_nat ch /\ decode_val ch bl = v /\ (align_chunk ch | snd l)%Z⌝ ∧
+      ([∗ list] i↦b ∈ bl, ∃ sh, ⌜Mem.perm_order' (perm_of_dfrac sh) Readable⌝ ∧ mapsto (adr_add l (Z.of_nat i)) sh (VAL b))).
+
+  (* coherence between logical state (rmap) and physical state (mem) *)
+  Definition rmap := gmap address (shared (leibnizO resource)).
+
+  Implicit Types (f : rmap) (s : sharedR (leibnizO resource)) (r : prodO dfracO (optionO (leibnizO resource))).
+
+  Lemma elem_of_agree_ne : forall {A} n (x y : agreeR A), ✓{n} x -> x ≡{n}≡ y -> proj1_sig (elem_of_agree x) ≡{n}≡ proj1_sig (elem_of_agree y).
+  Proof.
+    intros; destruct (elem_of_agree x), (elem_of_agree y); simpl.
+    destruct (proj1 H0 _ e) as (? & Hv2 & ->).
+    rewrite H0 in H; eapply agree_validN_def; done.
+  Qed.
+
+  Lemma elem_of_agree_equiv : forall {A} (x y : agreeR A), ✓ x -> x ≡ y -> proj1_sig (elem_of_agree x) ≡ proj1_sig (elem_of_agree y).
+  Proof.
+    intros; apply equiv_dist; intros.
+    apply elem_of_agree_ne; auto.
+  Qed.
+
+  Lemma elem_of_agree_ne' : forall {A} n (x y : agreeR (leibnizO A)), ✓{n} x -> x ≡{n}≡ y -> proj1_sig (elem_of_agree x) = proj1_sig (elem_of_agree y).
+  Proof.
+    intros ??????%elem_of_agree_ne; done.
+  Qed.
+
+  Definition resR_to_resource (s : optionR (sharedR (leibnizO resource))) : prodO dfracO (optionO (leibnizO resource)) :=
+    match s with
+    | Some s => (dfrac_of s, option_map (fun v : agree resource => proj1_sig (elem_of_agree v)) (val_of s))
+    | None => (ε, None)
+    end.
 
-Lemma juicy_mem_unage' : forall jm r, age r (m_phi jm) ->
-  exists jm', age jm' jm /\ m_phi jm' = r.
-Proof.
-  intros.
-  unshelve eexists (mkJuicyMem (m_dry jm) r _ _ _ _).
-  all: destruct jm as [m phi' Co Ac Ma N]; simpl.
-  - eapply contents_cohere_unage; eauto.
-  - eapply access_cohere_unage; eauto.
-  - eapply max_access_cohere_unage; eauto.
-  - eapply alloc_cohere_unage; eauto.
-  - split; auto; apply age1_juicy_mem_unpack''; auto.
-Qed.
+  Lemma resR_to_resource_ne n : forall x y, ✓{n} x -> x ≡{n}≡ y -> resR_to_resource x = resR_to_resource y.
+  Proof.
+    intros ??? Hdist; inv Hdist; last done.
+    destruct x0, y0; try done; simpl.
+    + destruct H0 as (-> & ?), H.
+      erewrite (elem_of_agree_ne'(A := resource)); done.
+    + hnf in H0; subst; done.
+  Qed.
+
+  Lemma resR_to_resource_eq : forall x y, ✓ x -> x ≡ y -> resR_to_resource x = resR_to_resource y.
+  Proof.
+    intros ??? Heq; apply (resR_to_resource_ne O); auto.
+    eapply cmra_valid_validN; done.
+  Qed.
+
+  Lemma resR_to_resource_fst : forall x, (resR_to_resource x).1 =
+    match x with Some a => dfrac_of a | None => ε end.
+  Proof.
+    destruct x; done.
+  Qed.
+
+  Lemma perm_of_res_ne' : forall n r1 r2, r1 ≡{n}≡ r2 -> perm_of_res r1 = perm_of_res r2.
+  Proof.
+    intros.
+    destruct r1, r2, H as [[=] ?]; simpl in *; subst.
+    by eapply perm_of_res_ne.
+  Qed.
+
+  Definition resource_at f k := resR_to_resource (f !! k).
+  Infix "@" := resource_at (at level 50, no associativity).
+
+  Definition contents_cohere (m: mem) k r :=
+    forall v, r.2 = Some (VAL v) -> contents_at m k = v.
+
+  Definition access_cohere (m: mem) k r :=
+    Mem.perm_order'' (access_at m k Cur) (perm_of_res r).
+
+  Definition max_access_at m loc := access_at m loc Max.
+
+(*  Definition max_access_cohere (m: mem) k r :=
+    Mem.perm_order'' (max_access_at m k) (perm_of_res r).*)
+
+  Definition coherent_loc (m: mem) k r := contents_cohere m k r /\ access_cohere m k r (*/\ max_access_cohere m k r*).
+
+  Definition coherent (m : mem) phi := forall loc, ((loc.1 >= Mem.nextblock m)%positive -> phi !! loc = None) /\
+    coherent_loc m loc (phi @ loc).
+
+  Definition mem_auth m := ∃ σ, ⌜coherent m σ⌝ ∧ resource_map_auth(H1 := gen_heapGpreS_heap(gen_heapGpreS := gen_heap_inG)) (gen_heap_name _) 1 σ.
+
+  Lemma elem_of_to_agree : forall {A} (v : A), proj1_sig (elem_of_agree (to_agree v)) = v.
+  Proof.
+    intros; destruct (elem_of_agree (to_agree v)); simpl.
+    rewrite -elem_of_list_singleton //.
+  Qed.
+
+  Definition res_le r1 r2 : Prop := r1.1 ≼ r2.1 ∧ (r1.2 = None ∨ r1.2 = r2.2).
+
+  Lemma resR_le : forall x1 x2 (Hv : ✓x2) (Hmono : x1 ≼ x2), res_le (resR_to_resource x1) (resR_to_resource x2).
+  Proof.
+    intros ??? [-> | (? & ? & -> & -> & ?)]%option_included.
+    { split; simpl; auto. }
+    destruct H as [H | H].
+    { erewrite resR_to_resource_eq; last by constructor.
+      split; auto.
+      { rewrite H //. } }
+    apply shared_included in H as [H | (? & H)]; first by rewrite H in Hv.
+    split; simpl; first done.
+    apply shared_valid in Hv as (_ & Hv).
+    apply option_included_total in H as [-> | (? & ? & -> & Heq & H)]; auto.
+    rewrite Heq /= in Hv |- *.
+    assert (✓{0} x2) by (by apply cmra_valid_validN).
+    right; f_equal; symmetry; apply (elem_of_agree_ne' O); first done.
+    symmetry; apply agree_valid_includedN; first done.
+    by apply @cmra_included_includedN.
+  Qed.
+
+  Lemma perm_of_res_mono' : forall x1 x2, ✓ x2.1 -> res_le x1 x2 -> Mem.perm_order'' (perm_of_res x2) (perm_of_res x1).
+  Proof.
+    intros (dq, ?) (?, v) ? (? & Hv).
+    eapply perm_order''_trans.
+    - by eapply perm_of_res_mono.
+    - destruct Hv; simpl in * |-; subst; try apply perm_order''_refl.
+      destruct dq as [[|]|], v as [[| |]|]; try done; try apply perm_order''_refl.
+      + apply perm_order''_min.
+      + simpl; if_tac; try constructor.
+        apply perm_order''_trans with (Some Readable); [done | constructor].
+  Qed.
+
+  Lemma contents_cohere_mono : forall m k x x' (Hmono : res_le x x') (Hcoh : contents_cohere m k x'),
+    contents_cohere m k x.
+  Proof.
+    intros; intros ? H.
+    destruct x, Hmono as (_ & [? | ?]); simpl in *; subst; [done | eauto].
+  Qed.
+
+  Lemma access_cohere_mono : forall m k x x' (Hv : ✓x'.1) (Hmono : res_le x x') (Hcoh : access_cohere m k x'),
+    access_cohere m k x.
+  Proof.
+    rewrite /access_cohere; intros.
+    eapply perm_order''_trans; first done.
+    by apply perm_of_res_mono'.
+  Qed.
+
+  Lemma coherent_mono : forall m k dq dq' v (Hv : ✓dq') (Hmono : dq ≼ dq') (Hcoh : coherent_loc m k (dq', v)),
+    coherent_loc m k (dq, v).
+  Proof.
+    intros.
+    destruct Hcoh as (Hcontents & Haccess).
+    apply (contents_cohere_mono _ _ (dq, v)) in Hcontents; last by split; auto.
+    apply (access_cohere_mono _ _ (dq, v)) in Haccess; last (by split; auto); last done.
+    by split.
+  Qed.
+
+  Lemma coherent_val_mono : forall m k dq v, coherent_loc m k (dq, Some v) -> coherent_loc m k (dq, None).
+  Proof.
+    intros.
+    destruct H as (Hcontents & Haccess); split; try done.
+    unfold access_cohere in *; simpl in *.
+    eapply perm_order''_trans; first done.
+    destruct dq as [[|]|], v; try done; try apply perm_order''_refl.
+    - apply perm_order''_min.
+    - simpl; if_tac; try constructor.
+      apply perm_order''_trans with (Some Readable); [done | constructor].
+  Qed.
+
+  Lemma mapsto_lookup {m k dq v} :
+    mem_auth m -∗ k ↦{dq} v -∗ ⌜✓ dq ∧ readable_dfrac dq ∧ (k.1 < Mem.nextblock m)%positive ∧ coherent_loc m k (dq, Some v)⌝.
+  Proof.
+    iIntros "(% & % & Hm) H".
+    iDestruct (resource_map_auth_valid with "Hm") as %(_ & Hvalid).
+    iDestruct (mapsto_lookup with "Hm H") as %(? & ? & ? & ? & Hk).
+    specialize (H k); destruct H as (Hnext & H).
+    unfold resource_at in H; erewrite resR_to_resource_eq in H by done.
+    rewrite /= elem_of_to_agree in H.
+    eapply coherent_mono in H; [|done..].
+    rewrite gen_heap.mapsto_unseal /gen_heap.mapsto_def resource_map.resource_map_elem_unseal.
+    iDestruct "H" as "(% & ?)".
+    iPureIntro; repeat (split; auto).
+    { by eapply cmra_valid_included. }
+    { destruct (plt k.1 (nextblock m)); first done.
+      rewrite Hnext // in Hk; inv Hk. }
+  Qed.
+
+  (* basic memory operations on mems + rmaps *)
+  Global Instance mapsto_lookup_combine_gives_1 {m k dq v} :
+    CombineSepGives (mem_auth m) (k ↦{dq} v) ⌜✓ dq ∧ readable_dfrac dq ∧ (k.1 < Mem.nextblock m)%positive ∧ coherent_loc m k (dq, Some v)⌝.
+  Proof.
+    rewrite /CombineSepGives. iIntros "[H1 H2]".
+    iDestruct (mapsto_lookup with "H1 H2") as %?. eauto.
+  Qed.
+
+  Global Instance mapsto_lookup_combine_gives_2 {m k dq v} :
+    CombineSepGives (k ↦{dq} v) (mem_auth m) ⌜✓ dq ∧ readable_dfrac dq ∧ (k.1 < Mem.nextblock m)%positive ∧ coherent_loc m k (dq, Some v)⌝.
+  Proof.
+    rewrite /CombineSepGives comm. apply mapsto_lookup_combine_gives_1.
+  Qed.
+
+  Lemma mapsto_no_lookup {m k sh} :
+    mem_auth m -∗ mapsto_no k sh -∗ ⌜~readable_share sh ∧ (k.1 < Mem.nextblock m)%positive ∧ coherent_loc m k (DfracOwn (Share sh), None)⌝.
+  Proof.
+    iIntros "(% & % & Hm) H".
+    iDestruct (resource_map_auth_valid with "Hm") as %(_ & Hvalid).
+    iDestruct (mapsto_no_lookup with "Hm H") as %(? & Hv & Heq & ?).
+    rewrite gen_heap.mapsto_no_unseal /gen_heap.mapsto_no_def resource_map.resource_map_elem_no_unseal.
+    iDestruct "H" as "(% & ?)".
+    iPureIntro; split; first done.
+    specialize (H k).
+    rewrite /resource_at Heq /= in H; destruct H as (Hnext & H).
+    split; first by destruct (plt k.1 (nextblock m)); first done; unfold Plt in *; spec Hnext.
+    apply shared_valid in Hv as [Hd _].
+    eapply coherent_mono; try done.
+    destruct (val_of x); last done.
+    eapply coherent_val_mono; done.
+  Qed.
+
+  Lemma big_sepL_seq2 : forall {A} `{Inhabited A} l (f : nat -> A -> mpred),
+    ([∗ list] k↦y ∈ l, f k y) ⊣⊢ [∗ list] k;y ∈ seq 0 (length l);l, f k y.
+  Proof.
+    intros; induction l using rev_ind; simpl; first done.
+    rewrite big_sepL_app app_length seq_app big_sepL2_snoc /= -IHl.
+    rewrite Nat.add_0_r bi.sep_emp //.
+  Qed.
+
+  Lemma elem_of_zip_gen : forall {A B} (l1 : list A) (l2 : list B) x, x ∈ zip l1 l2 ↔
+    exists i, l1 !! i = Some x.1 /\ l2 !! i = Some x.2.
+  Proof.
+    induction l1; simpl; intros.
+    - split.
+      + by intros ?%not_elem_of_nil.
+      + by intros (? & ? & ?).
+    - split.
+      + intros H; destruct l2; first by apply not_elem_of_nil in H.
+        apply elem_of_cons in H as [-> | ?].
+        * by exists O.
+        * apply IHl1 in H as (i & ? & ?); by exists (S i).
+      + intros (n & H1 & H2).
+        destruct l2; first done.
+        rewrite !lookup_cons in H1 H2.
+        destruct n; first by destruct x; inv H1; constructor.
+        constructor; rewrite IHl1; eauto.
+  Qed.
+
+  Global Instance inhabited_resource : Inhabited resource := populate (VAL Undef).
+
+  Lemma list_to_map_lookup : forall `{I : Inhabited A} k (vl : list A) l, list_to_map(M := gmap address A) (zip ((λ i, adr_add k (Z.of_nat i)) <$> seq 0 (length vl)) vl) !! l =
+    if adr_range_dec k (length vl) l then Some (nth (Z.to_nat (l.2 - k.2)) vl inhabitant) else None.
+  Proof.
+    intros.
+    destruct (list_to_map _ !! _) eqn: Hl; simpl.
+    * apply elem_of_list_to_map, elem_of_zip_gen in Hl as (? & Hk & Hv); simpl in *.
+      apply list_lookup_fmap_inv in Hk as (? & -> & (-> & ?)%lookup_seq).
+      rewrite /adr_add /= if_true.
+      rewrite Z.add_simpl_l Nat2Z.id; erewrite nth_lookup_Some; done.
+      { destruct k; simpl; lia. }
+      { rewrite fst_zip.
+        apply NoDup_fmap_2, NoDup_seq.
+        intros ??; inversion 1; lia.
+        { rewrite length_fmap seq_length //. } }
+    * if_tac; last done.
+      destruct k as (?, z), l as (?, ofs), H; subst.
+      apply not_elem_of_list_to_map_2 in Hl; contradiction Hl.
+      rewrite fst_zip; last rewrite length_fmap seq_length //.
+      rewrite elem_of_list_fmap /adr_add /=.
+      exists (Z.to_nat (ofs - z)).
+      split; first by f_equal; lia.
+      rewrite elem_of_seq; lia.
+  Qed.
+
+  Lemma update_map_lookup : forall `{I : Inhabited A} (f : A -> _) k vl (σ : rmap) l, ((f <$> list_to_map (zip ((λ i, adr_add k (Z.of_nat i)) <$> seq 0 (length vl)) vl)) ∪ σ) !! l =
+    if adr_range_dec k (length vl) l then Some (f (nth (Z.to_nat (l.2 - k.2)) vl inhabitant)) else σ !! l.
+  Proof.
+    intros.
+    rewrite lookup_union lookup_fmap list_to_map_lookup.
+    if_tac; last rewrite left_id //.
+    rewrite union_Some_l //.
+  Qed.
+
+  Lemma nth_replicate: forall {A} n (a : A) m, nth n (replicate m a) a = a.
+  Proof.
+    induction n; destruct m; simpl in *; done.
+  Qed.
+
+  Lemma mapsto_alloc {m} lo hi m' b (Halloc : Mem.alloc m lo hi = (m', b)) :
+    mem_auth m ==∗ mem_auth m' ∗ ([∗ list] i ∈ seq 0 (Z.to_nat (hi - lo)), adr_add (b, lo) (Z.of_nat i) ↦ VAL Undef).
+  Proof.
+    iIntros "(% & % & Hm)".
+    rewrite -(big_sepL_fmap (λ i, adr_add (b, lo) (Z.of_nat i)) (λ _ i, i ↦ VAL Undef)).
+    rewrite -(big_sepL2_replicate_r _ _ (λ _ i v, i ↦ v)); last by rewrite length_fmap seq_length.
+    rewrite big_sepL2_alt length_fmap seq_length length_replicate bi.pure_True // bi.True_and.
+    assert (NoDup (zip ((λ i : nat, adr_add (b, lo) (Z.of_nat i)) <$> seq 0 (Z.to_nat (hi - lo)))
+     (replicate (Z.to_nat (hi - lo)) (VAL Undef))).*1).
+    { rewrite fst_zip.
+      apply NoDup_fmap_2, NoDup_seq.
+      intros ??; inversion 1; lia.
+      { rewrite length_fmap seq_length length_replicate //. } }
+    rewrite -(big_sepM_list_to_map (λ x y, x ↦ y)) //.
+    pose proof (alloc_result _ _ _ _ _ Halloc) as ->.
+    iMod (mapsto_insert_big with "Hm") as "(Hm & $)".
+    { rewrite dom_list_to_map_L fst_zip.
+      intros l (? & -> & ?)%elem_of_list_to_set%elem_of_list_fmap_2.
+      destruct (H (adr_add (nextblock m, lo) (Z.of_nat x))) as (Hnext & _).
+      rewrite elem_of_dom Hnext.
+      * intros (? & ?); done.
+      * rewrite /adr_add /=; lia.
+      * rewrite length_fmap seq_length length_replicate //. }
+    iExists _; iFrame; iPureIntro.
+    split; last done.
+    intros l; specialize (H l); destruct H as (Hnext & Hcontents & Haccess).
+    unfold resource_at in *.
+    assert ((((λ v : resource, (YES (V := leibnizO resource) (DfracOwn (Share Tsh)) readable_top (to_agree v))) <$>
+     list_to_map (zip ((λ i : nat, adr_add (nextblock m, lo) (Z.of_nat i)) <$> seq 0 (Z.to_nat (hi - lo)))
+          (replicate (Z.to_nat (hi - lo)) (VAL Undef)))) ∪ σ) !! l =
+      if eq_dec l.1 (nextblock m) then if adr_range_dec (nextblock m, lo) (hi - lo) l then
+      Some (YES (V := leibnizO resource) (DfracOwn (Share Tsh)) readable_top (to_agree (VAL Undef))) else None else σ !! l) as Hlookup.
+    { rewrite -{1}(length_replicate (Z.to_nat (hi - lo)) (VAL Undef)) update_map_lookup length_replicate nth_replicate.
+      if_tac.
+      * destruct l, H as [-> ?]; rewrite /= eq_dec_refl if_true //; lia.
+      * if_tac; last done.
+        rewrite if_false; first by apply Hnext; lia.
+        destruct l; intros [??]; simpl in *; subst; lia. }
+    rewrite Hlookup; clear Hlookup.
+    split3.
+    - erewrite nextblock_alloc by done.
+      intros; rewrite Hnext; last lia.
+      if_tac; last done; if_tac; last done; lia.
+    - intros ?.
+      if_tac; last by rewrite /contents_at; erewrite AllocContentsOther by done; auto.
+      if_tac; last done.
+      rewrite /= elem_of_to_agree; inversion 1; subst.
+      rewrite -H in Halloc.
+      rewrite /contents_at; erewrite AllocContentsUndef; done.
+    - unfold access_cohere in *.
+      destruct l; if_tac; last by erewrite <- alloc_access_other; eauto.
+      if_tac; simpl in *; last by rewrite eq_dec_refl; apply perm_order''_None.
+      subst; rewrite elem_of_to_agree perm_of_freeable; erewrite alloc_access_same; try done; last lia.
+      apply perm_order''_refl.
+  Qed.
+
+  Lemma mapsto_alloc_readonly {m} lo hi m' b (Halloc : Mem.alloc m lo hi = (m', b)) :
+    mem_auth m ==∗ mem_auth m' ∗ ([∗ list] i ∈ seq 0 (Z.to_nat (hi - lo)), adr_add (b, lo) (Z.of_nat i) ↦□ (VAL Undef)).
+  Proof.
+    iIntros "(% & % & Hm)".
+    rewrite -(big_sepL_fmap (λ i, adr_add (b, lo) (Z.of_nat i)) (λ _ i, i ↦□ VAL Undef)).
+    rewrite -(big_sepL2_replicate_r _ _ (λ _ i v, i ↦□ v)); last by rewrite length_fmap seq_length.
+    rewrite big_sepL2_alt length_fmap seq_length length_replicate bi.pure_True // bi.True_and.
+    assert (NoDup (zip ((λ i : nat, adr_add (b, lo) (Z.of_nat i)) <$> seq 0 (Z.to_nat (hi - lo)))
+     (replicate (Z.to_nat (hi - lo)) (VAL Undef))).*1).
+    { rewrite fst_zip.
+      apply NoDup_fmap_2, NoDup_seq.
+      intros ??; inversion 1; lia.
+      { rewrite length_fmap seq_length length_replicate //. } }
+    rewrite -(big_sepM_list_to_map (λ x y, x ↦□ y)) //.
+    pose proof (alloc_result _ _ _ _ _ Halloc) as ->.
+    iMod (mapsto_insert_persist_big with "Hm") as "(Hm & $)".
+    { rewrite dom_list_to_map_L fst_zip.
+      intros l (? & -> & ?)%elem_of_list_to_set%elem_of_list_fmap_2.
+      destruct (H (adr_add (nextblock m, lo) (Z.of_nat x))) as (Hnext & _).
+      rewrite elem_of_dom Hnext.
+      * intros (? & ?); done.
+      * rewrite /adr_add /=; lia.
+      * rewrite length_fmap seq_length length_replicate //. }
+    iExists _; iFrame; iPureIntro.
+    split; last done.
+    intros l; specialize (H l); destruct H as (Hnext & Hcontents & Haccess).
+    unfold resource_at in *.
+    assert ((((λ v : resource, YES (V := leibnizO resource) DfracDiscarded I (to_agree v)) <$>
+     list_to_map (zip ((λ i : nat, adr_add (nextblock m, lo) (Z.of_nat i)) <$> seq 0 (Z.to_nat (hi - lo)))
+          (replicate (Z.to_nat (hi - lo)) (VAL Undef)))) ∪ σ) !! l =
+      if eq_dec l.1 (nextblock m) then if adr_range_dec (nextblock m, lo) (hi - lo) l then
+      Some (YES (V := leibnizO resource) DfracDiscarded I (to_agree (VAL Undef))) else None else σ !! l) as Hlookup.
+    { rewrite -{1}(length_replicate (Z.to_nat (hi - lo)) (VAL Undef)) update_map_lookup length_replicate nth_replicate.
+      if_tac.
+      * destruct l, H as [-> ?]; rewrite /= eq_dec_refl if_true //; lia.
+      * if_tac; last done.
+        rewrite if_false; first by apply Hnext; lia.
+        destruct l; intros [??]; simpl in *; subst; lia. }
+    rewrite Hlookup; clear Hlookup.
+    split3.
+    - erewrite nextblock_alloc by done.
+      intros; rewrite Hnext; last lia.
+      if_tac; last done; if_tac; last done; lia.
+    - intros ?.
+      if_tac; last by rewrite /contents_at; erewrite AllocContentsOther by done; auto.
+      if_tac; last done.
+      rewrite /= elem_of_to_agree; inversion 1; subst.
+      rewrite -H in Halloc.
+      rewrite /contents_at; erewrite AllocContentsUndef; done.
+    - unfold access_cohere in *.
+      destruct l; if_tac; last by erewrite <- alloc_access_other; eauto.
+      if_tac; simpl in *; last by rewrite eq_dec_refl; apply perm_order''_None.
+      subst; rewrite elem_of_to_agree perm_of_empty /=; erewrite alloc_access_same; try done; last lia.
+      constructor.
+  Qed.
+
+  Lemma mapsto_free {m k vl} hi m' (Hfree : Mem.free m k.1 k.2 hi = Some m') (Hlen : length vl = Z.to_nat (hi - k.2)) :
+    mem_auth m -∗ ([∗ list] i↦v ∈ vl, adr_add k (Z.of_nat i) ↦ v) ==∗ mem_auth m'.
+  Proof.
+    iIntros "(% & % & Hm) H".
+    rewrite big_sepL_seq2 -(big_sepL2_fmap_l (λ i, adr_add k (Z.of_nat i)) (λ _ i y, i ↦ y)).
+    assert (NoDup (zip ((λ i : nat, adr_add k (Z.of_nat i)) <$> seq 0 (length vl)) vl).*1).
+    { rewrite fst_zip.
+      apply NoDup_fmap_2, NoDup_seq.
+      intros ??; inversion 1; lia.
+      { rewrite length_fmap seq_length //. } }
+    rewrite big_sepL2_alt -(big_sepM_list_to_map (λ x y, x ↦ y)) //.
+    iDestruct "H" as "(_ & H)".
+    iMod (mapsto_delete_big with "Hm H").
+    iExists _; iFrame; iPureIntro; split; last done.
+    unfold coherent, resource_at in *; intros l. rewrite update_map_lookup.
+    destruct (H l) as (Hnext & Hcontents & Haccess); clear H.
+    pose proof (free_range_perm _ _ _ _ _ Hfree) as Hperm.
+    split3.
+    - erewrite nextblock_free by done.
+      if_tac; last done.
+      destruct k, l as (?, ofs), H; simpl in *; subst.
+      specialize (Hperm ofs ltac:(lia)); apply perm_valid_block in Hperm; rewrite /valid_block /Plt in Hperm; lia.
+    - unfold contents_cohere in *.
+      intros ?; if_tac; try done.
+      destruct k, l; eapply free_nadr_range_eq in Hfree as [_ <-]; simpl in *; auto; lia.
+    - unfold access_cohere in *.
+      if_tac; first by rewrite /= eq_dec_refl; apply perm_order''_None.
+      destruct k, l; eapply free_nadr_range_eq in Hfree as [<- _]; simpl in *; auto; lia.
+  Qed.
+
+  Lemma plus_1_lt : forall z, z < z + 1.
+  Proof. lia. Qed.
+
+  Lemma mapsto_storebyte {m k v} m' b sh (Hsh : writable0_share sh) :
+    Mem.storebytes m k.1 k.2 [b] = Some m' ->
+    mem_auth m -∗ k ↦{#sh} (VAL v) ==∗ mem_auth m' ∗ k ↦{#sh} (VAL b).
+  Proof.
+    intros Hstore; iIntros "(% & % & Hm) H".
+    iDestruct (resource_map_auth_valid with "Hm") as %(_ & Hvalid).
+    iMod (mapsto_update with "Hm H") as (?? (? & ? & Hk)) "(Hm & $)"; first done.
+    iExists _; iFrame; iPureIntro; split; last done.
+    unfold coherent, resource_at in *; intros l.
+    destruct (H l) as (Hnext & Hcontents & Haccess); clear H.
+    pose proof (storebytes_range_perm _ _ _ _ _ Hstore) as Hperm.
+    specialize (Hvalid l).
+    split3.
+    - erewrite nextblock_storebytes by done.
+      destruct (eq_dec k l); [subst; rewrite lookup_insert | rewrite lookup_insert_ne //].
+      clear -Hperm.
+      rewrite /= in Hperm.
+      (* lia stopped working *)
+      specialize (Hperm l.2); apply perm_valid_block in Hperm.
+      rewrite /valid_block /Plt in Hperm; apply Positive_as_OT.lt_nle in Hperm.
+      rewrite Pos.ge_le_iff //.
+      { split; first done; apply plus_1_lt. }
+    - unfold contents_cohere, contents_at in *.
+      erewrite storebytes_mem_contents by done.
+      intros ?; destruct (eq_dec k l); [subst; rewrite lookup_insert | rewrite lookup_insert_ne //].
+      + rewrite /= elem_of_to_agree; inversion 1; subst.
+        rewrite Maps.PMap.gss Maps.ZMap.gss //.
+      + destruct (eq_dec l.1 k.1); [rewrite e Maps.PMap.gss | rewrite Maps.PMap.gso //; auto].
+        simpl; destruct (eq_dec l.2 k.2); first by destruct k, l; simpl in *; subst.
+        rewrite Maps.ZMap.gso // -e; auto.
+    - unfold access_cohere in *.
+      erewrite <- Memory.storebytes_access by done.
+      destruct (eq_dec k l); [subst; rewrite lookup_insert | rewrite lookup_insert_ne //].
+      erewrite resR_to_resource_eq in Haccess by done.
+      rewrite /= !elem_of_to_agree // in Haccess |- *.
+  Qed.
+
+  Lemma coherent_bot m k : coherent_loc m k (ε, None).
+  Proof.
+    repeat split.
+    - by intros ?.
+    - rewrite /access_cohere /= eq_dec_refl; apply perm_order''_None.
+  Qed.
+
+  (** Big-op versions of above lemmas *)
+  Lemma mapsto_lookup_big {m} k dq m0 :
+    mem_auth m -∗
+    ([∗ list] i↦v ∈ m0, adr_add k i ↦{dq} v) -∗
+    ⌜forall i, (i < length m0)%nat -> coherent_loc m (adr_add k (Z.of_nat i)) (match m0 !! i with Some v => (dq, Some v) | None => (ε, None) end)⌝.
+  Proof.
+    iIntros "(% & % & Hm)".
+    iDestruct (resource_map_auth_valid with "Hm") as %(_ & Hvalid).
+    rewrite big_sepL_seq2 -(big_sepL2_fmap_l (λ i, adr_add k (Z.of_nat i)) (λ _ i y, i ↦{dq} y)).
+    assert (NoDup (zip ((λ i : nat, adr_add k (Z.of_nat i)) <$> seq 0 (length m0)) m0).*1).
+    { rewrite fst_zip.
+      apply NoDup_fmap_2, NoDup_seq.
+      intros ??; inversion 1; lia.
+      { rewrite length_fmap seq_length //. } }
+    rewrite big_sepL2_alt -(big_sepM_list_to_map (λ x y, x ↦{dq} y)) //.
+    iIntros "(_ & H)".
+    iDestruct (mapsto_lookup_big with "Hm H") as %Hall; iPureIntro.
+    intros.
+    destruct (m0 !! i) as [r|] eqn: Hi; last apply coherent_bot.
+    specialize (Hall (adr_add k (Z.of_nat i)) r); spec Hall.
+    { apply elem_of_list_to_map_1, elem_of_zip_gen; first done.
+      exists i; rewrite list_lookup_fmap lookup_seq_lt //. }
+    destruct Hall as (? & ? & ? & ? & Heq).
+    specialize (Hvalid (adr_add k (Z.of_nat i))).
+    specialize (H (adr_add k (Z.of_nat i))); destruct H as (Hnext & H).
+    unfold resource_at in H; erewrite resR_to_resource_eq in H by done.
+    rewrite /= elem_of_to_agree in H.
+    eapply coherent_mono in H; done.
+  Qed.
+
+  Lemma get_setN : forall l z c i, (z <= i < z + length l)%Z -> Maps.ZMap.get i (Mem.setN l z c) = nth (Z.to_nat (i - z)) l Undef.
+  Proof.
+    induction l; simpl; intros; first lia.
+    destruct (Z.to_nat (i - z)) eqn: Hi.
+    - assert (i = z) as -> by lia.
+      rewrite -> Mem.setN_other, Maps.ZMap.gss by lia; done.
+    - rewrite IHl; last lia.
+      replace (Z.to_nat (i - (z + 1))) with n by lia; done.
+  Qed.
+
+  Theorem mapsto_storebytes {m} m' k vl bl (Hlen : length vl = length bl) sh (Hsh : writable0_share sh)
+    (Hstore : Mem.storebytes m k.1 k.2 bl = Some m') :
+    mem_auth m -∗
+    ([∗ list] i↦v ∈ vl, adr_add k (Z.of_nat i) ↦{#sh} VAL v) ==∗
+    mem_auth m' ∗
+        [∗ list] i↦v ∈ bl, adr_add k (Z.of_nat i) ↦{#sh} VAL v.
+  Proof.
+    iIntros "Hm H".
+    rewrite -(big_sepL_fmap VAL (λ i v, adr_add k (Z.of_nat i) ↦{#sh} v)).
+(*    iDestruct (mapsto_lookup_big with "Hm H") as %Hold.*)
+    iDestruct "Hm" as "(% & % & Hm)".
+    rewrite big_sepL_seq2 -(big_sepL2_fmap_l (λ i, adr_add k (Z.of_nat i)) (λ _ i y, i ↦{#sh} y)).
+    rewrite length_fmap.
+    assert (NoDup (zip ((λ i : nat, adr_add k (Z.of_nat i)) <$> seq 0 (length vl)) (VAL <$> vl)).*1).
+    { rewrite fst_zip.
+      apply NoDup_fmap_2, NoDup_seq.
+      intros ??; inversion 1; lia.
+      { rewrite !length_fmap seq_length //. } }
+    rewrite big_sepL2_alt -(big_sepM_list_to_map (λ x y, x ↦{#sh} y)) //.
+    iDestruct "H" as "(_ & H)".
+    iDestruct (gen_heap.mapsto_lookup_big with "Hm H") as %Hall.
+    rewrite big_sepL_seq2 -(big_sepL2_fmap_l (λ i, adr_add k (Z.of_nat i)) (λ _ i y, i ↦{#sh} VAL y)).
+    rewrite -(big_sepL2_fmap_r VAL (λ _ i y, i ↦{#sh} y)).
+    assert (NoDup (zip ((λ i : nat, adr_add k (Z.of_nat i)) <$> seq 0 (length bl)) (VAL <$> bl)).*1).
+    { rewrite fst_zip.
+      apply NoDup_fmap_2, NoDup_seq.
+      intros ??; inversion 1; lia.
+      { rewrite !length_fmap seq_length //. } }
+    rewrite big_sepL2_alt -(big_sepM_list_to_map (λ x y, x ↦{#sh} y)) //.
+    iDestruct (resource_map_auth_valid with "Hm") as %(_ & Hvalid).
+    rewrite !length_fmap seq_length bi.pure_True // bi.True_and.
+    iMod (mapsto_update_big with "Hm H") as "(Hm & $)"; first done.
+    { rewrite Hlen !dom_list_to_map_L !fst_zip //; rewrite !length_fmap seq_length //; lia. }
+    iDestruct (resource_map_auth_valid with "Hm") as %(_ & Hvalid').
+    iExists _; iFrame; iPureIntro; split; last done.
+    unfold coherent, resource_at in *; intros l.
+    destruct (H l) as (Hnext & Hcontents & Haccess); clear H.
+    pose proof (storebytes_range_perm _ _ _ _ _ Hstore) as Hperm.
+    specialize (Hvalid l); specialize (Hvalid' l).
+    rewrite lookup_union map_lookup_imap -(length_fmap VAL bl) list_to_map_lookup length_fmap in Hvalid' |- *.
+    split3.
+    - erewrite nextblock_storebytes by done.
+      if_tac; last rewrite left_id //.
+      simpl in *; destruct (σ !! l) eqn: Hl; rewrite Hl // in Hvalid' |- *.
+      intros X; specialize (Hnext X); done.
+    - unfold contents_cohere, contents_at in *.
+      erewrite storebytes_mem_contents by done.
+      if_tac; simpl in *.
+      + destruct (σ !! l) as [[|]|] eqn: Hl; rewrite Hl // /= in Hvalid' |- *.
+        rewrite elem_of_to_agree map_nth; inversion 1; subst.
+        destruct l, k, H; simpl in *; subst.
+        rewrite Maps.PMap.gss get_setN //.
+      + rewrite left_id; destruct (eq_dec l.1 k.1); [rewrite e Maps.PMap.gss | rewrite Maps.PMap.gso //].
+        rewrite -e setN_outside //.
+        destruct (zlt l.2 k.2); auto.
+        rewrite Z.ge_le_iff; destruct (zle (k.2 + Z.of_nat (length bl)) l.2); auto.
+        contradiction H; destruct l, k; simpl in *; subst; lia.
+    - unfold access_cohere in *.
+      erewrite <- Memory.storebytes_access by done.
+      if_tac; simpl in *; last rewrite left_id //.
+      specialize (Hall l). rewrite -(length_fmap VAL vl) list_to_map_lookup length_fmap Hlen if_true // in Hall.
+      specialize (Hall _ eq_refl); destruct Hall as (? & ? & ? & ? & Heq).
+      erewrite resR_to_resource_eq in Haccess by done.
+      inversion Heq as [?? Hc Heq'|]; subst; rewrite -Heq'.
+      destruct x1; inv Hc; simpl.
+      rewrite /= !elem_of_to_agree !map_nth // in Haccess |- *.
+  Qed.
+
+  Lemma empty_coherent : forall m, coherent m ∅.
+  Proof.
+    rewrite /coherent /resource_at; intros; rewrite lookup_empty.
+    split; first done; apply coherent_bot.
+  Qed.
+
+  Lemma coherent_empty : forall (σ : rmapUR _ _ _), coherent Mem.empty σ → σ = ∅.
+  Proof.
+    intros.
+    rewrite map_empty; intros l.
+    destruct (H l) as (Hnext & _).
+    apply Hnext; simpl; lia.
+  Qed.
+
+  Lemma mem_auth_set (m : mem) (σ : rmapUR _ _ _) (Hvalid : ✓ σ) (Hnext : ∀ loc, (loc.1 >= Mem.nextblock m)%positive -> σ !! loc = None)
+    (Hcoh : ∀ loc : address, coherent_loc m loc (resource_at σ loc)) :
+    mem_auth Mem.empty ⊢ |==> mem_auth m ∗
+    ([∗ map] l ↦ x ∈ σ, match x with
+                        | (shared.YES dq _ v) => l ↦{dq} (proj1_sig (elem_of_agree v))
+                        | (shared.NO (Share sh) _) => mapsto_no l sh
+                        | _ => False
+                        end).
+  Proof.
+    iIntros "(% & % & Hm)".
+    apply coherent_empty in H as ->.
+    iMod (gen_heap_set with "Hm") as "(? & $)"; first done.
+    iExists _; iFrame; iPureIntro; split; last done; split; auto.
+  Qed.
+
+End mpred.
+
+Infix "@" := resource_at (at level 50, no associativity).
diff --git a/veric/juicy_mem_lemmas.v b/veric/juicy_mem_lemmas.v
index a74794107a..e890bd543c 100644
--- a/veric/juicy_mem_lemmas.v
+++ b/veric/juicy_mem_lemmas.v
@@ -1,97 +1,17 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.juicy_base.
-Require Import VST.veric.juicy_mem.
 Require Import VST.veric.res_predicates.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
+Require Import VST.veric.juicy_mem.
 Require Import VST.veric.shares.
-Import compcert.lib.Maps.
-
-Definition juicy_mem_core (j: juicy_mem) : rmap := core (m_phi j).
-
-(*Lemma inflate_initial_mem_empty:
-  forall lev, emp (inflate_initial_mem Mem.empty lev).
-intro lev.
-unfold inflate_initial_mem.
-destruct (make_rmap (inflate_initial_mem' Mem.empty lev) (core (ghost_of lev))
-        (inflate_initial_mem'_valid Mem.empty lev) (level lev)
-        (inflate_initial_mem'_fmap Mem.empty lev)); simpl.
-{ rewrite core_ghost_of, <- level_core; apply ghost_of_approx. }
-destruct a.
-apply resource_at_empty2.
-intro l; rewrite H0.
-unfold inflate_initial_mem'.
-destruct l.
-unfold access_at; unfold empty at 1.
-simpl.
-rewrite PMap.gi.
-destruct (max_access_at empty (b,z)); try destruct p; try apply NO_identity.
-Qed.
-Local Hint Resolve inflate_initial_mem_empty : core.*)
-
-(* fancy initial mem *)
-
-(* TODO: move this somewhere more appropriate *)
-Definition no_VALs (phi: rmap) := forall loc,
-  match phi @ loc with
-    | YES _ _ (VAL _) _ => False | _ => True
-  end.
+Require Import VST.veric.Cop2.
+Require Import VST.veric.mpred.
 
-Lemma components_join_joins {A} {JA: Join A}{PA: Perm_alg A}{TA: Trip_alg A}: forall a b c d,
-   join a b c -> joins a d -> joins b d -> joins c d.
-Proof.
-intros.
-destruct H0 as [x ?]. destruct H1 as [y ?].
-destruct (TA a b d c y x H H1 H0).
-eauto.
-Qed.
+Local Close Scope Z.
 
-(* coherence lemmas *)
-
-Lemma contents_cohere_join_sub: forall m phi phi',
-  contents_cohere m phi -> join_sub phi' phi -> contents_cohere m phi'.
-Proof.
-unfold contents_cohere.
-intros until phi'; intros H H0.
-intros.
-destruct H0 as [phi1 H0].
-generalize (resource_at_join phi' phi1 phi loc H0); intro H2.
-rewrite H1 in H2.
-inv H2;
-symmetry in H8;
-destruct (H _ _ _ _ _ H8); auto.
-Qed.
-
-Lemma alloc_cohere_join_sub: forall m phi phi',
-  alloc_cohere m phi -> join_sub phi' phi -> alloc_cohere m phi'.
-Proof.
-unfold alloc_cohere; intros.
-specialize (H _ H1).
-apply (resource_at_join_sub _ _ loc) in H0 as [? J].
-rewrite H in J; inv J.
-apply split_identity, identity_share_bot in RJ; auto; subst.
-f_equal; apply proof_irr.
-Qed.
+Section mpred.
 
-Lemma perm_of_sh_join_sub: forall (sh1 sh2: Share.t) p,
-  perm_of_sh sh1 = Some p ->
-  join_sub sh1 sh2 ->
-  perm_order' (perm_of_sh sh2) p.
-Proof.
-intros.
-destruct H0.
-unfold perm_of_sh in *.
-repeat if_tac in H; inv H.
-+
-inv H0. rewrite Share.glb_commute, Share.glb_top in H; subst x.
- rewrite (Share.lub_bot).
-rewrite if_true by auto. rewrite if_true by auto. constructor.
-+ apply join_writable01 in H0 ;auto. rewrite if_true by auto.
-  if_tac; constructor.
-+ apply join_readable1 in H0; auto.
-  if_tac. if_tac; constructor. rewrite if_true by auto. constructor.
-+ assert (sh2 <> Share.bot). contradict H3.
-  apply split_identity in H0; auto. apply identity_share_bot; auto.
-  subst; auto.
-  repeat if_tac; try constructor. contradiction.
-Qed.
+Context `{!heapGS Σ}.
 
 Lemma perm_order'_trans: forall p1 p2 p3,
   perm_order' (Some p1) p2 -> perm_order' (Some p2) p3 -> perm_order' (Some p1) p3.
@@ -101,620 +21,257 @@ unfold perm_order' in *.
 eapply perm_order_trans; eauto.
 Qed.
 
-Lemma rmap_unage_YES: forall phi phi' sh rsh k pp loc, 
-  age phi phi' 
-  -> phi' @ loc = YES sh rsh k pp 
-  -> exists pp', phi @ loc = YES sh rsh k pp'.
-Proof.
-intros.
-unfold age in H.
-case_eq (phi @ loc). intros.
-cut (necR phi phi'). intro.
-generalize (necR_NO phi phi' loc sh0 n H2). intro.
-rewrite H3 in H1.
-rewrite H1 in H0; inv H0.
-constructor; auto.
-intros.
-exists p.
-apply necR_YES with (phi' := phi') in H1.
-rewrite H1 in H0.
-inv H0. apply YES_ext; auto.
-constructor; auto.
-intros.
-exfalso.
-eapply necR_PURE in H1.
-2: constructor 1; eassumption.
-congruence.
-Qed.
-
-Lemma preds_fmap_NoneP_approx: forall pp lev1 lev2,
-  preds_fmap (approx lev1) (approx lev1) pp = NoneP ->
-  preds_fmap (approx lev2) (approx lev2) pp = NoneP.
-Proof.
-intros.
-destruct pp.
-unfold NoneP, approx, compose in *.
-simpl in *. unfold compose in *.
-inv H. simpl in *.
-apply EqdepFacts.eq_sigT_eq_dep in H2.
-apply Eqdep.EqdepTheory.eq_dep_eq in H2.
-auto.
-Qed.
-
-Lemma oracle_unage:
-  forall (jm': juicy_mem) (w: rmap), age w (m_phi jm') ->
-       exists jm, age jm jm' /\ m_phi jm = w.
-Proof.
-intros.
-destruct jm' as [m phi' CONTENTS ACCESS MAXA ALLOC].
-simpl m_phi in H.
-assert (contents_cohere m w).
-hnf; intros.
-destruct (necR_YES'' w phi' loc rsh sh (VAL v)).
-constructor 1; auto.
-destruct H1 as [p ?].
-eauto.
-destruct (CONTENTS _ _ _ _ _ H1); eauto.
-subst p.
-apply (age1_YES w phi') in H1; auto.
-inversion2 H0 H1. auto.
-assert (access_cohere m w).
-intro loc; specialize (ACCESS loc).
-case_eq (w @ loc); intros.
-apply (necR_NO w phi') in H1. rewrite H1 in ACCESS; auto.
-constructor 1;auto.
-apply (necR_YES w phi') in H1.
-rewrite H1 in ACCESS; auto.
-constructor 1; auto.
-apply (necR_PURE w phi') in H1.
-rewrite H1 in ACCESS; auto.
-constructor 1; auto.
-assert (max_access_cohere m w).
-intro loc; specialize (MAXA loc).
-case_eq (w @ loc); intros; auto.
-apply (necR_NO w phi') in H2. rewrite H2 in MAXA. auto. constructor 1; auto.
-apply (necR_YES w phi') in H2.
-rewrite H2 in MAXA; auto.
-constructor 1; auto.
-apply (necR_PURE w phi') in H2.
-rewrite H2 in MAXA; auto.
-constructor 1; auto.
-assert (alloc_cohere m w).
-intros loc ?. specialize (ALLOC _ H3).
-apply (necR_NO w phi').
-constructor 1; auto.
-auto.
-exists (mkJuicyMem m w H0 H1 H2 H3).
-split; auto.
-apply age1_juicy_mem_unpack''; simpl; auto.
-Qed.
-
 (* core load and coherence properties *)
 
-Lemma writable_perm:
-  forall b i jm, writable (b,i) (m_phi jm) -> Mem.perm (m_dry jm) b i Cur Writable.
-Proof.
-intros until jm; intros H.
-assert (Hacc := juicy_mem_access jm).
-unfold access_cohere in Hacc.
-unfold Mem.perm, Mem.perm_order'.
-specialize ( Hacc (b, i)).
-simpl in H.
-destruct (m_phi jm @ (b, i)).
-contradiction.
-destruct H as [H1 H2]. destruct k; inv H2.
-unfold access_at in Hacc.
-simpl in Hacc.
-rewrite Hacc.
-clear - H1.
-simpl.
-unfold perm_of_sh. rewrite if_true by auto. if_tac; constructor.
-contradiction.
-Qed.
-
-Lemma valid_access_None: forall m ch b b' ofs ofs' p,
-  Mem.valid_access m ch b ofs p
-  -> adr_range (b, ofs) (size_chunk ch) (b', ofs')
-  -> access_at m (b', ofs') Cur = None
-  -> False.
-Proof.
-unfold access_at, Mem.valid_access, Mem.perm, Mem.range_perm, Mem.perm, Mem.perm_order'.
-simpl.
-intros.
-destruct H as [H ?].
-destruct H0 as [H3 H4].
-subst.
-specialize( H ofs' H4).
-rewrite H1 in H.
-auto.
-Qed.
-
-Lemma core_load_getN: forall ch v b ofs bl phi m,
-  contents_cohere m phi
-  -> (core_load' ch (b, ofs) v bl)%pred phi
-  -> bl = Mem.getN (size_chunk_nat ch) ofs (PMap.get b (Mem.mem_contents m)).
+Lemma core_load_coherent: forall ch v b ofs bl m,
+  mem_auth m ∗ core_load' ch (b, ofs) v bl ⊢
+  ⌜length bl = size_chunk_nat ch ∧ (align_chunk ch | ofs)%Z ∧ forall i, i < length bl -> exists sh, perm_order' (perm_of_dfrac sh) Readable ∧ coherent_loc m (b, ofs + Z.of_nat i)%Z (sh, Some (VAL (nthbyte i bl)))⌝.
+Proof.
+  intros; unfold core_load'.
+  iIntros "(Hm & >((%H1 & _ & %H2) & H))".
+  rewrite {1}H1; iSplit; first done; iSplit; first done.
+  clear H1 H2; iInduction bl as [|?] "IH" forall (ofs); simpl in *.
+  { iPureIntro; lia. }
+  iDestruct "H" as "((% & %Hsh & H) & rest)".
+  iDestruct (mapsto_lookup with "Hm H") as %[_ (Hloc & ? & ?)].
+  iDestruct ("IH" with "Hm [rest]") as %Hrest.
+  { iApply (big_sepL_mono with "rest"); intros.
+    apply bi.exist_mono; intros.
+    rewrite /adr_add /= Nat2Z.inj_succ /Z.succ (Z.add_comm _ 1) Z.add_assoc //. }
+  iPureIntro; intros.
+  destruct i; eauto.
+  destruct (Hrest i); first lia.
+  rewrite Nat2Z.inj_succ /Z.succ (Z.add_comm _ 1) Z.add_assoc.
+  rewrite /nthbyte Z2Nat.inj_add; eauto; lia.
+Qed.
+
+Lemma getN_lookup : forall n z m i, (getN n z m !! i)%stdpp = if lt_dec i n then Some (Maps.ZMap.get (z + Z.of_nat i)%Z m) else None.
+Proof.
+  induction n; simpl; intros; first done.
+  destruct i; simpl.
+  - rewrite Z.add_0_r //.
+  - rewrite IHn; if_tac; if_tac; auto; try lia.
+    rewrite Nat2Z.inj_succ /Z.succ (Z.add_comm (Z.of_nat i) 1) Z.add_assoc //.
+Qed.
+
+Lemma core_load_getN: forall ch v b ofs bl m,
+  mem_auth m ∗ core_load' ch (b, ofs) v bl ⊢
+  ⌜bl = Mem.getN (size_chunk_nat ch) ofs (Maps.PMap.get b (Mem.mem_contents m))⌝.
 Proof.
-intros until m; intros H0 H.
-destruct H as [[H3 H4] H].
-unfold allp, jam in H.
-rewrite <- H3.
-simpl in *.
-clear H4.
-revert ofs H H3.
-assert (H: size_chunk_nat ch = Z.to_nat (size_chunk ch)) by auto.
-rewrite H; clear H.
-generalize (size_chunk ch) as z.
-induction bl; intros; simpl; auto.
-rewrite IHbl with (ofs := ofs + 1) (z := z - 1); auto.
-rewrite Mem.getN_length.
-f_equal; auto.
-specialize ( H (b, ofs)).
-cut (adr_range (b, ofs) z (b, ofs)); [intro H6|].
-destruct (adr_range_dec (b, ofs) z (b, ofs)).
-  2: exfalso; auto.
-simpl in H.
-cut (Z.to_nat (ofs - ofs) = O); [intro H7|].
-rewrite H7 in H.
-destruct H as [sh [rsh H]].
-unfold contents_cohere in H0.
-symmetry.
-destruct (H0 _ _ _ _ _ H) as [? _].
-apply H1.
-replace (ofs - ofs) with 0 by lia; auto.
-unfold adr_range; split; auto.
-cut (z > 0). lia.
-inversion H3.
-cut (z = Z_of_nat (length bl) + 1). lia.
-assert (HS_nat_Z: forall n z, S n = Z.to_nat z -> Z_of_nat n + 1 = z).
-  intros n z' H4.
-  cut (Z_of_nat 1 = 1).
-  intro H5.
-  rewrite <- H5.
-  rewrite <- inj_plus.
-  replace (Z_of_nat (n + 1%nat)) with (Z_of_nat (S n)).
-  rewrite H4.
-  rewrite Z2Nat.id; auto.
-  destruct z'; try solve [lia].
-  inversion H4.
-  rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ in H6. lia.
-  simpl in H4.
-  inv H4.
-  idtac.
-  replace (plus n (S 0)) with (S n).
-  auto.
-  lia.
-  auto.
-symmetry; apply HS_nat_Z; auto.
-intros loc'.
-specialize (H loc').
-cut ( adr_range (b, ofs + 1) (z - 1) loc' -> adr_range (b, ofs) z loc').
-intro H1.
-destruct (adr_range_dec (b, ofs + 1) (z - 1) loc').
-destruct (adr_range_dec (b, ofs) z loc').
-simpl in H.
-case_eq (Z.to_nat (snd loc' - ofs)).
-intro H2.
-destruct loc' as (b', ofs').
-simpl in *.
-cut (ofs' > ofs). intro H4.
-cut (exists p, ofs' - ofs = Zpos p). intros [p H5].
-rewrite H5 in H2.
-unfold nat_of_P in H2.
-generalize (le_Pmult_nat p 1) as H6; intro.
-rewrite Pmult_nat_mult in H6.
-rewrite Nat.mul_1_r in H6.
-change (Pos.to_nat p) with (Z.to_nat (Z.pos p)) in H6.
-rewrite H2 in H6.
-lia.
-assert (ofs' - ofs > 0).
-lia.
-assert (forall z, z > 0 -> exists p, z = Zpos p).
   intros.
-  assert (exists n, Z.to_nat z0 = S n).
-    exists (Z.to_nat (z0 - 1)).
-    destruct z0; try solve [inv H6].
-    destruct p; auto.
-    simpl.
-    change (nat_of_P p~0 = S (nat_of_P (p~0 - 1))).
-    rewrite <- nat_of_P_succ_morphism.
-    rewrite <- Ppred_minus.
-    simpl.
-    rewrite Psucc_o_double_minus_one_eq_xO.
-    auto.
-  destruct H7 as [n ?].
-  exists (P_of_succ_nat n).
-  rewrite Zpos_P_of_succ_nat.
-  rewrite <- inj_S.
-  rewrite <- H7.
-  rewrite Z2Nat.id.
-  auto.
-lia.
-apply H6; auto.
-lia.
-intros n H2.
-rewrite H2 in H.
-assert (Z.to_nat (snd loc' - (ofs + 1)) = n).
-  destruct loc'.
-  simpl in *.
-  assert (Z_of_nat (Z.to_nat (z0 - ofs)) = Z_of_nat (S n)).
-  auto.
-  assert (z0 - ofs > 0).
-    lia.
-  rewrite Z2Nat.id in H4; try solve [lia].
-rewrite H4.
-apply H.
-exfalso. auto.
-auto.
-unfold adr_range.
-destruct loc' as (b', ofs').
-intros [H1 H2].
-split; auto || lia.
-inversion H3.
-assert (z > 0).
-  assert (forall n z, S n = Z.to_nat z -> z > 0).
-    intros.
-    destruct z0; try solve [inv H1].
-    apply Zgt_pos_0.
-  eapply H1; eauto.
-assert (z - 1 >= 0).
-lia.
-lia.
-Qed.
-
-Lemma core_load_valid: forall ch v b ofs m phi,
-  (core_load ch (b, ofs) v)%pred phi
-  -> access_cohere m phi
-  -> Mem.valid_access m ch b ofs Readable.
+  rewrite core_load_coherent; iIntros ((Hlen & _ & H)); iPureIntro.
+  apply list_eq; intros.
+  rewrite getN_lookup -Hlen.
+  destruct (lt_dec i (length bl)).
+  - destruct (H i) as (? & ? & Hi & _); first lia.
+    rewrite /contents_cohere /contents_at /= in Hi.
+    rewrite (Hi _ eq_refl).
+    apply lookup_lt_is_Some_2 in l as [? Hbl].
+    unfold nthbyte; erewrite nth_lookup_Some; eauto.
+    rewrite Nat2Z.id //.
+  - apply lookup_ge_None_2; lia.
+Qed.
+
+Lemma core_load_valid: forall ch v b ofs m,
+  mem_auth m ∗ core_load ch (b, ofs) v ⊢
+  ⌜Mem.valid_access m ch b ofs Readable⌝.
 Proof.
-intros until phi; intros H H0.
-hnf in H.
-destruct H as [bl [[H1 [H2 Halign]] H]].
-hnf in H.
-split.
-intros ofs' H4.
-specialize (H (b, ofs')).
-hnf in H.
-destruct (adr_range_dec (b, ofs) (size_chunk ch) (b, ofs')) as [H5|H5].
-  2: unfold adr_range in H5.
-  2: exfalso; apply H5; split; auto.
-destruct H as [sh [rsh H]].
-simpl in H.
-unfold access_cohere in H0.
-specialize (H0 (b, ofs')).
-unfold Mem.perm, Mem.perm_order'.
-rewrite H in H0.
-unfold access_at in H0.  simpl in H0.
-destruct ((mem_access m) !! b ofs' Cur).
-clear - H0 rsh.
-unfold perm_of_sh in H0.
-if_tac in H0.
-if_tac in H0; inv H0; constructor.
-rewrite if_true in H0. inv H0; constructor.
-auto.
-clear - rsh H0.
-unfold perm_of_sh in H0.
-repeat if_tac in H0; inv H0.
-contradiction.
-assumption.
+  intros.
+  iIntros "(Hm & >(% & H))".
+  iDestruct (core_load_coherent with "[-]") as %(Hlen & Halign & H).
+  { rewrite /core_load'; iFrame. }
+  iPureIntro.
+  rewrite /valid_access.
+  split; auto.
+  intros z Hz.
+  rewrite size_chunk_conv -Hlen in Hz.
+  destruct (H (Z.to_nat (z - ofs))) as (? & Hsh & _ & Hloc); first lia.
+  rewrite Z2Nat.id /access_cohere in Hloc; last lia.
+  rewrite Zplus_minus in Hloc.
+  rewrite perm_access; eapply perm_order''_trans; eauto; simpl.
+  destruct x as [[|]|]; done.
 Qed.
 
 Lemma core_load_load': forall ch b ofs v m,
-  core_load ch (b, ofs) v (m_phi m) -> Mem.load ch (m_dry m) b ofs = Some v.
+  mem_auth m ∗ core_load ch (b, ofs) v ⊢ ⌜Mem.load ch m b ofs = Some v⌝.
 Proof.
-intros until m; intros H.
-generalize H as Hcore_load; intro.
-Transparent Mem.load.
-unfold core_load in H; unfold Mem.load.
-unfold allp, jam in H.
-destruct H as [bl [[H0 [H1 Halign]] H]].
-assert (H3 := juicy_mem_contents m).
-pose proof I.
-pose proof I.
-if_tac.
-f_equal.
-generalize (core_load_getN ch v b ofs bl (m_phi m) (m_dry m) H3) as H7; intro.
-rewrite <- H7; auto.
-unfold core_load'.
-repeat split; auto.
-exfalso.
-apply H5.
-eapply core_load_valid; eauto.
-apply juicy_mem_access.
-Qed.
-
-Lemma Zminus_lem: forall z1 z2, z1 <= z2 -> Z.to_nat (z2 - z1) = O -> z1=z2.
-Proof.
-intros.
-case_eq (z2 - z1). intro.
-rewrite H1 in H0.
-symmetry; apply Zminus_eq; auto.
-intros.
-generalize (lt_O_nat_of_P p). intro.
-rewrite H1 in H0.
-simpl in *.
-lia.
-intros.
-generalize (Zlt_neg_0 p). intro.
-rewrite H1 in H0.
-lia.
-Qed.
-
-Lemma nat_of_Z_lem1: forall n z, 
-    S n = Z.to_nat z -> n = Z.to_nat (z - 1).
-Proof.
-intros.
-rewrite Z2Nat.inj_sub by lia.
-rewrite <- H.
-simpl. lia.
+  intros.
+  iIntros "H".
+  iDestruct (core_load_valid with "H") as %[? Hload]%valid_access_load.
+  rewrite Hload; apply load_result in Hload; subst.
+  iDestruct "H" as "(Hm & % & >H)".
+  iDestruct (core_load_getN with "[-]") as %?.
+  { rewrite /core_load'; iFrame. }
+  iDestruct "H" as "((% & <- & %) & H)"; subst; done.
+Qed.
+
+Lemma mapsto_coherent: forall ch v sh b ofs m,
+  mem_auth m ∗ address_mapsto ch v sh (b, ofs) ⊢
+  ⌜∃ bl, length bl = size_chunk_nat ch ∧ decode_val ch bl = v ∧ (align_chunk ch | ofs)%Z ∧ forall i, 0 <= i < size_chunk_nat ch -> coherent_loc m (b, ofs + Z.of_nat i)%Z (DfracOwn (Share sh), Some (VAL (nthbyte i bl)))⌝.
+Proof.
+  intros; unfold address_mapsto.
+  iIntros "[Hm H]".
+  iDestruct "H" as (bl (? & ? & ?)) "H".
+  iExists bl; do 3 (iSplit; first done).
+  rewrite -(big_opL_fmap VAL (fun i v => mapsto (adr_add (b, ofs) i) (DfracOwn (Share sh)) v)).
+  iDestruct (mapsto_lookup_big with "Hm H") as %Hcoh; iPureIntro.
+  rewrite -H; intros; specialize (Hcoh i).
+  rewrite length_fmap list_lookup_fmap in Hcoh.
+  destruct (lookup_lt_is_Some_2 bl i) as [? Hi]; first lia.
+  rewrite Hi in Hcoh; rewrite /nthbyte Nat2Z.id (nth_lookup_Some _ _ _ _ Hi).
+  apply Hcoh; lia.
+Qed.
+
+Lemma mapsto_valid_access_wr: forall ch v sh (wsh: writable0_share sh) b ofs m,
+  mem_auth m ∗ address_mapsto ch v sh (b, ofs) ⊢
+  ⌜Mem.valid_access m ch b ofs Writable⌝.
+Proof.
+  intros; rewrite mapsto_coherent; iIntros ((bl & Hlen & ? & ? & Hcoh)); iPureIntro.
+  split; auto.
+  intros z Hz.
+  rewrite size_chunk_conv -Hlen in Hz.
+  destruct (Hcoh (Z.to_nat (z - ofs))) as (_ & Hloc); first lia.
+  rewrite Z2Nat.id /access_cohere in Hloc; last lia.
+  rewrite Zplus_minus in Hloc.
+  rewrite perm_access; eapply perm_order''_trans; eauto; simpl.
+  rewrite /perm_of_sh if_true; last done.
+  if_tac; constructor.
 Qed.
 
-Lemma nat_of_Z_lem2: forall n z1 z2, S n = Z.to_nat (z1 - z2) -> n = Z.to_nat (z1 - z2 - 1).
-Proof. intros; apply nat_of_Z_lem1; auto. Qed.
-
-Lemma nth_getN: forall m b ofs ofs' z,
-  ofs <= ofs' < ofs + z
-  -> z >= 0
-  -> contents_at m (b, ofs')
-  = nth (Z.to_nat (ofs' - ofs)) (Mem.getN (Z.to_nat z) ofs (PMap.get b (Mem.mem_contents m))) Undef.
-Proof.
-intros.
-revert ofs ofs' H H0.
-remember (Z.to_nat z) as n.
-revert n z Heqn.
-induction n; intros.
-destruct z.
-inv H.
-lia.
-simpl in *.
-generalize (lt_O_nat_of_P p). intro.
-lia.
-generalize (Zlt_neg_0 p).
-intro.
-lia.
-simpl.
-case_eq (Z.to_nat (ofs' - ofs)).
-intros.
-assert (ofs = ofs').
-  destruct H.
-  apply Zminus_lem; auto.
-subst; auto.
-intros.
-symmetry in H1.
-assert (n = Z.to_nat (z - 1)) by (apply nat_of_Z_lem1 in Heqn; auto).
-rewrite (IHn (z - 1) H2 (ofs + 1)); try solve [auto|lia].
-assert (Z.to_nat (ofs' - (ofs + 1)) = n0).
-replace (ofs' - (ofs + 1)) with (ofs' - ofs - 1) by lia.
-  apply nat_of_Z_lem1 in H1.
-  auto.
-rewrite H3; auto.
-Qed.
 
-Lemma load_core_load: forall ch b ofs v m,
-  Mem.load ch (m_dry m) b ofs = Some v ->
-  (forall z, ofs <= z < ofs + size_chunk ch ->
-                      perm_order'' (perm_of_res (m_phi m @ (b,z))) (Some Readable)) ->
- core_load ch (b, ofs) v (m_phi m).
+Lemma mapsto_can_store: forall ch v sh (wsh: writable0_share sh) b ofs m v',
+  mem_auth m ∗ address_mapsto ch v sh (b, ofs) ⊢
+  ⌜exists m', Mem.store ch m b ofs v' = Some m'⌝.
 Proof.
-intros until m; intros H PERM.
-hnf.
-unfold Mem.load in H.
-
-if_tac in H; try solve [inv H].
-inversion H.
-clear H.
-exists (Mem.getN (size_chunk_nat ch) ofs (PMap.get b (Mem.mem_contents (m_dry m)))).
-generalize H0 as H0'; intro.
-Local Hint Resolve Mem.getN_length : core.
-unfold Mem.valid_access in H0'.
-destruct H0' as [H0'1 H0'2].
-repeat split; auto.
-clear H0'1 H0'2.
-intros (b', ofs').
-hnf.
-if_tac; hnf; auto.
-assert (Heqbb': b = b').
-  unfold adr_range in H. decompose [and] H. auto.
-pose proof (juicy_mem_contents m).
-pose proof I. (* pose proof (juicy_mem_access m).*)
-pose proof I.
-pose proof I.
-clear H4. subst b'; clear H5.
-destruct H as [_ ?].
-specialize (PERM ofs' H).
-(*
-unfold access_cohere in H3.
-specialize (H3 (b, ofs').
-*)
-unfold perm_of_res in *.
-destruct H0 as [H0 _].
-specialize (H0 ofs').
-specialize (H0 H).
-hnf in H0.
-(*unfold access_at in H3.
-simpl in H3.
-*)
-destruct ((mem_access (m_dry m)) !! b ofs' Cur); try contradiction.
-destruct (m_phi m @ (b, ofs')) eqn:H8; try contradiction.
-if_tac in PERM; inv PERM.
-destruct k; try now inv PERM.
-pose proof (size_chunk_pos ch).
-rewrite <- nth_getN with (ofs := ofs) (z := size_chunk ch); auto; try lia.
-exists sh, r.
-destruct (H1 _ _ _ _ _ H8); subst.
-f_equal.
-inv PERM.
-Qed.
+  intros.
+  rewrite mapsto_valid_access_wr; last done.
+  iIntros (H); iPureIntro.
+  apply (valid_access_store _ _ _ _ v') in H as []; eauto.
+Qed.
+
+Definition decode_encode_val_ok (chunk1 chunk2: memory_chunk) : Prop :=
+  match chunk1, chunk2 with
+  | Mbool, Mbool => True
+  | Mint8signed, Mint8signed => True
+  | Mint8unsigned, Mint8signed => True
+  | Mint8signed, Mint8unsigned => True
+  | Mint8unsigned, Mint8unsigned => True
+  | Mint16signed, Mint16signed => True
+  | Mint16unsigned, Mint16signed => True
+  | Mint16signed, Mint16unsigned => True
+  | Mint16unsigned, Mint16unsigned => True
+  | Mint32, Mfloat32 => True
+  | Many32, Many32 => True
+  | Many64, Many64 => True
+  | Mint32, Mint32 => True
+  | Mint64, Mint64 => True
+  | Mint64, Mfloat64 => True
+  | Mfloat64, Mfloat64 =>  True
+  | Mfloat64, Mint64 =>  True
+  | Mfloat32, Mfloat32 =>  True
+  | Mfloat32, Mint32 =>  True
+  | _,_ => False
+  end.
 
-Lemma core_load_load: forall ch b ofs v m,
-  (forall z, ofs <= z < ofs + size_chunk ch ->
-                      perm_order'' (perm_of_res (m_phi m @ (b,z))) (Some Readable)) ->
-  (core_load ch (b, ofs) v (m_phi m) <-> Mem.load ch (m_dry m) b ofs = Some v).
+Lemma decode_encode_val_ok_same:  forall ch,
+    decode_encode_val_ok ch ch.
 Proof.
-intros.
-split; [apply core_load_load'| ].
-intros; apply load_core_load; auto.
+destruct ch; simpl; auto.
 Qed.
 
-(*Lemma address_mapsto_exists':
-  forall ch v sh (rsh: readable_share sh) loc m lev,
-      (align_chunk ch | snd loc)
-      -> Mem.load ch m (fst loc) (snd loc) = Some v 
-      -> exists w, address_mapsto ch v sh loc w /\ level w = lev.
-Proof.
-intros. rename H into Halign.
-unfold address_mapsto.
-pose (f l' := if adr_range_dec loc (size_chunk ch) l'
-                     then YES sh rsh (VAL (nthbyte (snd l' - snd loc) (Mem.getN (size_chunk_nat ch) (snd loc) (PMap.get (fst loc) (Mem.mem_contents m))))) NoneP
-                     else NO Share.bot bot_unreadable).
-assert (CompCert_AV.valid (res_option oo f)).
-apply VAL_valid.
-unfold compose, f; intros.
-if_tac in H.
-simpl in H.
-injection H;intros; subst k; auto.
-inv H.
-destruct (make_rmap f H lev) as [phi [? ?]].
-extensionality l; unfold f, compose; simpl.
-if_tac; hnf; auto.
-exists phi.
-split; auto.
-exists (Mem.getN (size_chunk_nat ch) (snd loc) (PMap.get (fst loc) (Mem.mem_contents m))).
-split.
-repeat split; auto.
-Transparent Mem.load.
-unfold load in *. if_tac in H0. injection H0. auto. inv H0.
-intro l'.
-unfold jam.
-hnf.
-simpl.
-rewrite H2; clear H H1 H2.
-unfold f; clear f.
-if_tac.
-exists rsh.
-f_equal. 
-apply NO_identity.
-Qed.*)
-    
-Lemma mapsto_valid_access: forall ch v sh b ofs jm,
-  (address_mapsto ch v sh (b, ofs) * TT)%pred (m_phi jm)
-  -> Mem.valid_access (m_dry jm) ch b ofs Readable.
+Lemma decode_encode_val_ok1:
+  forall v ch ch' v',
+ decode_encode_val_ok ch ch' ->
+ decode_encode_val v ch ch' v' ->
+ decode_val ch' (encode_val ch v) = v'.
 Proof.
 intros.
-unfold address_mapsto in H.
-unfold Mem.valid_access, Mem.range_perm.
-split.
-destruct H as [x [y [Hjoin ?]]].
-destruct H as [[bl [[H2 [H3 H3']] H]] ?].
-hnf in H.
-intros ofs' H4.
-specialize (H (b, ofs')).
-hnf in H.
-destruct (adr_range_dec (b, ofs) (size_chunk ch) (b, ofs')) as [H5|H5].
-  2: unfold adr_range in H5.
-  2: exfalso; apply H5; split; auto.
-hnf in H.
-destruct H as [pf H].
-hnf in H.
-rewrite preds_fmap_NoneP in H.
-simpl in H.
-generalize (resource_at_join _ _ _ (b,ofs') Hjoin); rewrite H; intro.
-forget ((nth (Z.to_nat (ofs' - ofs)) bl Undef)) as v'.
-assert (exists rsh', exists sh', m_phi jm @ (b,ofs') = YES rsh' sh' (VAL v') NoneP).
-inv H1; eauto.
-destruct H6 as [rsh' [sh' ?]].
-generalize (juicy_mem_access jm (b,ofs')); rewrite H6; unfold perm_of_res; simpl; intro.
-clear - H7 sh'.
-unfold perm, access_at in *.
-simpl in H7.
-forget ((mem_access (m_dry jm)) !! b ofs' Cur) as p1.
-unfold perm_of_sh in H7.
-if_tac in H7.
-if_tac in H7; inv H7; constructor.
-rewrite if_true in H7 by auto.
-subst; constructor.
-repeat match goal with [ H: context[ _ /\ _ ] |- _] => destruct H end.
+destruct ch, ch'; try contradiction;
+destruct v; auto;
+simpl in H0; subst;
+unfold decode_val, encode_val;
+try rewrite proj_inj_bytes;
+rewrite -> ?decode_encode_int_1, ?decode_encode_int_2,
+  ?decode_encode_int_4,
+  ?decode_encode_int_8;
+f_equal;
+rewrite -> ?Int.sign_ext_zero_ext by reflexivity;
+rewrite -> ?Int.zero_ext_sign_ext by reflexivity;
+rewrite -> ?Int.zero_ext_idem by (compute; congruence);
 auto.
+all: try solve [
+simpl; destruct Archi.ptr64; simpl; auto;
+rewrite -> proj_sumbool_is_true by auto;
+rewrite -> proj_sumbool_is_true by auto;
+simpl; auto].
+apply Float32.of_to_bits.
+apply Float.of_to_bits.
 Qed.
 
-Lemma mapsto_valid_access_wr: forall ch v sh (wsh: writable0_share sh) b ofs jm,
-  (address_mapsto ch v sh (b, ofs) * TT)%pred (m_phi jm)
-  -> Mem.valid_access (m_dry jm) ch b ofs Writable.
+Lemma decode_encode_val_size:
+  forall ch1 ch2, decode_encode_val_ok ch1 ch2 ->
+   size_chunk ch1 = size_chunk ch2.
 Proof.
 intros.
-unfold address_mapsto in H.
-unfold Mem.valid_access, Mem.range_perm.
-split.
-destruct H as [x [y [Hjoin ?]]].
-destruct H as [[bl [[H2 [H3 H3']] H]] ?].
-hnf in H.
-intros ofs' H4.
-specialize (H (b, ofs')).
-hnf in H.
-destruct (adr_range_dec (b, ofs) (size_chunk ch) (b, ofs')) as [H5|H5].
-  2: unfold adr_range in H5.
-  2: exfalso; apply H5; split; auto.
-hnf in H.
-destruct H as [pf H].
-hnf in H.
-rewrite preds_fmap_NoneP in H.
-simpl in H.
-generalize (resource_at_join _ _ _ (b,ofs') Hjoin); rewrite H; intro.
-forget ((nth (Z.to_nat (ofs' - ofs)) bl Undef)) as v'.
-assert (exists sh' (wsh': writable0_share sh'), m_phi jm @ (b,ofs') = YES sh' (writable0_readable wsh') (VAL v') NoneP).
-inv H1; [ | contradiction (join_writable0_readable RJ wsh rsh2)].
-exists sh3, (join_writable01 RJ wsh).
-apply YES_ext; auto.
-destruct H6 as [sh' [wsh' ?]].
-generalize (juicy_mem_access jm (b,ofs')); rewrite H6; unfold perm_of_res; simpl; intro.
-clear - H7 wsh'.
-unfold perm, access_at in *.
-simpl in H7.
-forget ((mem_access (m_dry jm)) !! b ofs' Cur) as p1.
-unfold perm_of_sh in H7.
-rewrite if_true in H7 by auto.
-subst. if_tac; constructor.
-repeat match goal with [ H: context[ _ /\ _ ] |- _] => destruct H end.
-auto.
+destruct ch1, ch2; try contradiction;
+simpl in *; subst; auto.
 Qed.
 
-Program Definition mapsto_can_store_definition ch v sh (wsh: writable0_share sh) b ofs jm (v':val)
-  (MAPSTO: (address_mapsto ch v sh (b, ofs) * TT)%pred (m_phi jm)):
-  Memory.mem. 
-Proof. intros.
-pose proof (mapsto_valid_access_wr _ _ _ wsh _ _ _ MAPSTO).
-apply (mkmem
-  (PMap.set b (setN (encode_val ch v') ofs (PMap.get b (mem_contents (m_dry jm))))
-    (mem_contents (m_dry jm))) (mem_access (m_dry jm))
-  (nextblock (m_dry jm)) (access_max (m_dry jm)) (nextblock_noaccess (m_dry jm))).
-intros. destruct jm; simpl.
-  rewrite PMap.gsspec. destruct (peq b0 b).
-  rewrite setN_default. apply contents_default.
-  apply contents_default.
-Defined.
-
-Lemma mapsto_can_store_property: forall (ch:memory_chunk) v sh (wsh: writable0_share sh) b ofs jm v'
-  (MAPSTO: (address_mapsto ch v sh (b, ofs) * TT)%pred (m_phi jm)),
-  Mem.store ch (m_dry jm) b ofs v' = 
-  Some(mapsto_can_store_definition _ _ _ wsh _ _ jm v' MAPSTO).
+Lemma mapsto_store': forall m ch ch' v v' sh b ofs m' (Hsh : writable0_share sh)
+  (Hdec : decode_encode_val_ok ch ch') (Halign : (align_chunk ch' | ofs)%Z),
+  Mem.store ch m b ofs v' = Some m' ->
+  mem_auth m ∗ address_mapsto ch v sh (b, ofs) ⊢
+  |==> mem_auth m' ∗ ∃ v'', ⌜decode_encode_val v' ch ch' v''⌝ ∧ address_mapsto ch' v'' sh (b, ofs).
+Proof.
+  intros.
+  apply store_storebytes in H.
+  iIntros "[Hm H]"; rewrite /address_mapsto.
+  iDestruct "H" as (? (Hlen & <- & ?)) "H".
+  iMod (mapsto_storebytes _ (b, ofs) _ (encode_val ch v') with "Hm H") as "[$ H]"; try assumption.
+  { rewrite encode_val_length //. }
+  iIntros "!>"; iExists _; iSplit; first by iPureIntro; apply decode_encode_val_general.
+  iExists _; iFrame.
+  iPureIntro; rewrite encode_val_length; repeat split; try done.
+  { rewrite /size_chunk_nat (decode_encode_val_size _ _ Hdec) //. }
+Qed.
+
+Lemma decode_encode_val_fun:
+  forall ch1 ch2, decode_encode_val_ok ch1 ch2 ->
+  forall v v1 v2,
+     decode_encode_val v ch1 ch2 v1 ->
+     decode_encode_val v ch1 ch2 v2 ->
+     v1=v2.
 Proof.
 intros.
-pose proof (mapsto_valid_access_wr _ _ _ wsh _ _ _ MAPSTO).
-unfold mapsto_can_store_definition. simpl.
-Transparent Mem.store. unfold store.
-destruct (valid_access_dec (m_dry jm) ch b ofs Writable).
-f_equal. f_equal; auto with extensionality.
-contradiction.
-Opaque Mem.store.
+destruct ch1, ch2; try contradiction;
+destruct v; simpl in *; subst; auto.
 Qed.
 
-Lemma mapsto_can_store: forall ch v sh (wsh: writable0_share sh) b ofs jm v',
-  (address_mapsto ch v sh (b, ofs) * TT)%pred (m_phi jm)
-  -> exists m', Mem.store ch (m_dry jm) b ofs v' = Some m'.
+Lemma mapsto_store: forall m ch v v' sh b ofs m' (Hsh : writable0_share sh)
+  t (Htc : tc_val' t v') (Hch : Ctypes.access_mode t = Ctypes.By_value ch),
+  Mem.store ch m b ofs v' = Some m' ->
+  mem_auth m ∗ address_mapsto ch v sh (b, ofs) ⊢
+  |==> mem_auth m' ∗ address_mapsto ch v' sh (b, ofs).
 Proof.
-intros.
-exists (mapsto_can_store_definition _ _ _ wsh _ _ jm v' H).
-apply mapsto_can_store_property.
-Qed.
+  intros.
+  rewrite address_mapsto_align.
+  iIntros "[Hm [H %]]".
+  pose proof (decode_encode_val_ok_same ch).
+  iMod (mapsto_store' with "[$]") as "($ & % & %Hv'' & H)"; [done..|].
+  eapply decode_encode_val_fun in Hv'' as <-; try done.
+  destruct (eq_dec v' Vundef); first by subst.
+  specialize (Htc n).
+  destruct t; try done; simpl in *.
+  + unfold is_int in *.
+    destruct v'; try done.
+    destruct i, s; inv Hch; simpl in *; rewrite ?val_lemmas.sign_ext_inrange ?val_lemmas.zero_ext_inrange //;
+      destruct Htc; subst; by compute.
+  + inv Hch; destruct v'; done.
+  + destruct f; inv Hch; destruct v'; done.
+  + inv Hch; destruct (_ && _), v'; done.
+Qed.
+
+Local Open Scope Z.
 
 Lemma store_outside':
    forall ch m b z v m',
@@ -737,7 +294,7 @@ left; auto.
 right.
 unfold contents_at; rewrite H0; clear H0.
 simpl.
-rewrite PMap.gss.
+rewrite Maps.PMap.gss.
 rewrite Mem.setN_other; auto.
 intros.
 rewrite encode_val_length in H0.
@@ -749,7 +306,7 @@ lia.
 right.
 unfold contents_at; rewrite H0; clear H0.
 simpl.
-rewrite PMap.gso by auto. auto.
+rewrite -> Maps.PMap.gso by auto. auto.
 unfold access_at.  extensionality loc k.
 f_equal.
 symmetry; eapply Mem.store_access; eauto.
@@ -771,426 +328,135 @@ case_eq (Z_lt_dec ofs hi); intros; auto.
 lia.
 Qed.
 
-Lemma join_top: forall sh2 sh, join Share.top sh2 sh -> sh = Share.top.
-Proof.
-intros. destruct H. rewrite Share.lub_commute, Share.lub_top in H0. auto.
-Qed.
-
-Lemma juicy_free_aux_lemma:
- forall phi b lo hi F,
- app_pred (VALspec_range (hi-lo) Share.top (b,lo) * F)%pred phi ->
-  (forall ofs : Z,
-   lo <= ofs < hi -> perm_of_res (phi @ (b, ofs)) = Some Freeable).
+Lemma join_top: forall sh2 sh, sepalg.join Share.top sh2 sh -> sh = Share.top.
 Proof.
-intros.
-destruct H as [phi1 [phi2 [? [? ?]]]].
-specialize (H1 (b,ofs)).
-apply (resource_at_join _ _ _ (b,ofs)) in H.
-hnf in H1. rewrite if_true in H1 by (split; auto; lia).
-destruct H1 as [? [? ?]].
-hnf in H1. rewrite H1 in H.
-inv H. simpl.
-clear - RJ.
-apply join_top in RJ. subst. apply perm_of_freeable.
-simpl.
-apply join_top in RJ. subst. apply perm_of_freeable.
+intros. destruct H. rewrite Share.lub_commute Share.lub_top in H0. auto.
 Qed.
 
-Lemma juicy_free_lemma:
-  forall {j b lo hi m' m1 F}
-    (H: Mem.free (m_dry j) b lo hi = Some m')
-    (VR: app_pred (VALspec_range (hi-lo) Share.top (b,lo) * F)%pred (m_phi j)),
-    VALspec_range (hi-lo) Share.top (b,lo) m1 ->
-    ghost_of m1 = core (ghost_of m1) ->
-    core m1 = core (m_phi j) ->
-    (forall l sh rsh k pp, m1 @ l = YES sh rsh k pp 
-      -> exists sh', exists (rsh': readable_share sh'), 
-            exists pp', join_sub sh sh' 
-              /\ m_phi j @ l = YES sh' rsh' k pp') -> 
-    join m1 (m_phi (free_juicy_mem _ _ _ _ _ H)) (m_phi j).
-Proof.
-intros j b lo hi m' m1.
-pose (H0 :=True).
-intros R H VR H1 Hg H2 Hyes.
-assert (forall l, ~adr_range (b,lo) (hi-lo) l -> identity (m1 @ l)).
-  unfold VALspec_range, allp, jam in H1.
-  intros l. specialize (H1 l). intros H3.
-  hnf in H1; if_tac in H1; try solve [contradiction].
-  apply H1.
-assert (forall l, adr_range (b,lo) (hi-lo) l 
-  -> exists mv, yesat NoneP (VAL mv) Share.top  l m1).
-  unfold VALspec_range, allp, jam in H1.
-  intros l. specialize (H1 l). intros H4.
-  hnf in H1; if_tac in H1; try solve [contradiction].
-  apply H1.
-remember (free_juicy_mem _ _ _ _ _ H) as j'.
-assert (m' = m_dry j') by (subst; reflexivity).
-assert (Ha := juicy_mem_access j').
-unfold access_cohere in Ha.
-apply resource_at_join2; auto.
-rewrite <- (level_core m1). rewrite <- (level_core (m_phi j)). congruence.
-subst j'. simpl. unfold inflate_free. simpl. rewrite level_make_rmap. auto.
-intros (b0, ofs0).
-subst j'. simpl.
-unfold inflate_free; rewrite resource_at_make_rmap.
-destruct (adr_range_dec (b,lo) (hi-lo) (b0,ofs0)).
-* (* adr_range *)
-clear H3.
-specialize (H4 (b0,ofs0) a).
-destruct H4 as [mv H4].
-unfold yesat, yesat_raw in H4. destruct H4 as [pp H4].
-simpl in H4.
-rewrite H4.
-clear H0.
-assert (H0 : access_at m' (b0, ofs0) Cur = None).
-  clear - H a.
-  Transparent free.
-  unfold free in H.
-  if_tac in H; try solve [congruence].
-  unfold unchecked_free in H. inv H. simpl.
-  assert (b = b0) by (destruct a; auto). subst.
-  unfold access_at; simpl. rewrite PMap.gss.
-  rewrite adr_range_zle_zlt with (b:=b0); auto.
-specialize (Ha (b0,ofs0)). rewrite <- H5 in Ha.
-rewrite H0 in Ha.
-assert (H3 : m_phi j @ (b0, ofs0) = YES Share.top readable_share_top (VAL mv) NoneP). {
-  clear - H H4 a Hyes.
-  assert (Ha := juicy_mem_access j (b0,ofs0)).
-  generalize (Hyes _ _ _ _ _ H4); intros.
-  repeat rewrite preds_fmap_NoneP in *. 
-  destruct H0 as [sh' [rsh' [? [RJ ?]]]]. 
-  rewrite H0. repeat f_equal.
-  destruct RJ as [? RJ]; apply join_top in RJ. subst sh'.
-  pose proof (juicy_mem_contents j). 
-  destruct (H1 _ _ _ _ _ H0); auto. subst. apply YES_ext; auto.
- }
-rewrite H3. repeat rewrite preds_fmap_NoneP. unfold pfullshare.
-apply join_unit2. constructor. apply join_unit1; auto.
-f_equal. apply proof_irr.
-* (* ~adr_range *)
-  clear H0.
-  generalize (H3 _ n); intro H3'.
-  assert (core (m1 @ (b0,ofs0)) = core (m_phi j @ (b0,ofs0))).
-  do 2 rewrite core_resource_at. unfold Join_rmap in *.  unfold Sep_rmap in  *; congruence.
-  apply identity_resource in H3'.
-  revert H3'; case_eq (m1 @ (b0,ofs0));intros; try contradiction; try constructor.
-  + apply identity_share_bot in H3'; subst sh.
-    rename H6 into Hm1.
-    clear H0.
-    destruct (free_nadr_range_eq _ _ _ _ _ _ _ n H) as [H0 H10].
-    (* rewrite <- H0 in *; clear H0.*)
-    assert (Ha0 := juicy_mem_access j (b0,ofs0)).
-    revert Ha0;
-      case_eq (m_phi j @ (b0,ofs0)); intros.
-    constructor. apply join_unit1; auto.
-    constructor. apply join_unit1; auto.
-
-    exfalso.
-    clear - H2 Hm1 H0 H6.
-    assert (core (m1 @ (b0,ofs0)) = core (m_phi j @ (b0,ofs0))).
-    do 2 rewrite core_resource_at.  unfold Join_rmap in *;  unfold Sep_rmap in  *; congruence.
-    rewrite Hm1 in H. rewrite H6 in H.
-    rewrite core_PURE in H. rewrite core_NO in H; inv H.
-  + rewrite H6 in H0. rewrite core_PURE in H0.
-    destruct (m_phi j @ (b0,ofs0)).
-    rewrite core_NO in H0; inv H0. rewrite core_YES in H0; inv H0.
-    rewrite core_PURE in H0. inversion H0. subst k0 p0; constructor.
-* rewrite Hg, core_ghost_of, H2.
-  subst j'; simpl.
-  unfold inflate_free.
-  rewrite ghost_of_make_rmap.
-  rewrite <- core_ghost_of; apply core_unit.
-Qed.
-
-Section free.
-
-Variables (jm :juicy_mem) (m': mem)
-          (b: block) (lo hi: Z)
-          (FREE: free (m_dry jm) b lo hi = Some m')
-          (PERM: forall ofs, lo <= ofs < hi ->
-                      perm_of_res (m_phi jm @ (b,ofs)) = Some Freeable)
-          (phi1 phi2 : rmap) (Hphi1: VALspec_range (hi-lo) Share.top (b,lo) phi1)
-          (Hjoin : join phi1 phi2 (m_phi jm)).
-
-Lemma phi2_eq : ext_order phi2 (m_phi (free_juicy_mem _ _ _ _ _ FREE)).
+Lemma replicate_repeat: forall {A} n (x : A), replicate n x = repeat x n.
 Proof.
-  apply rmap_order; simpl; unfold inflate_free; rewrite ?level_make_rmap, ?resource_at_make_rmap.
-  split; [|split].
-  - apply join_level in Hjoin; destruct Hjoin; auto.
-  - extensionality l.
-    specialize (Hphi1 l); simpl in Hphi1.
-    apply (resource_at_join _ _ _ l) in Hjoin.
-    if_tac.
-    + destruct Hphi1 as (? & ? & H1); rewrite H1 in Hjoin; inv Hjoin.
-      * pose proof (join_top _ _ RJ); subst; apply sepalg.join_comm, unit_identity, identity_share_bot in RJ.
-        subst; apply f_equal, proof_irr.
-      * pose proof (join_top _ _ RJ); subst; apply sepalg.join_comm, unit_identity, identity_share_bot in RJ.
-        subst; contradiction bot_unreadable.
-    + apply Hphi1 in Hjoin; auto.
-  - rewrite ghost_of_make_rmap.
-    apply ghost_of_join in Hjoin; eexists; eauto.
+  induction n; auto; simpl.
+  intros; rewrite IHn //.
 Qed.
 
-End free.
-
-Lemma juicy_free_lemma':
-  forall {j b lo hi m' m1 m2 F}
-    (H: Mem.free (m_dry j) b lo hi = Some m')
-    (VR: app_pred (VALspec_range (hi-lo) Share.top (b,lo) * F)%pred (m_phi j)),
-    VALspec_range (hi-lo) Share.top (b,lo) m1 ->
-    join m1 m2 (m_phi j) ->
-    ext_order m2 (m_phi (free_juicy_mem _ _ _ _ _ H)).
+Lemma mapsto_alloc_bytes: forall m lo hi m' b,
+  Mem.alloc m lo hi = (m', b) ->
+  mem_auth m ⊢ |==> mem_auth m' ∗ [∗ list] i ∈ seq 0 (Z.to_nat (hi - lo)), address_mapsto Mint8unsigned Vundef Tsh (b, lo + Z.of_nat i).
 Proof.
   intros.
-  eapply phi2_eq; eauto.
+  iIntros "Hm"; iMod (mapsto_alloc with "Hm") as "[$ H]"; first done.
+  rewrite /address_mapsto.
+  iApply (big_sepL_mono with "H"); intros ?? [-> ?]%lookup_seq.
+  iIntros "?"; iExists [Undef]; simpl.
+  rewrite /adr_add Z.add_0_r; iFrame.
+  iPureIntro; repeat split; auto.
+  apply Z.divide_1_l.
 Qed.
 
-Lemma initial_mem_core: forall lev m j IOK,
-  j = initial_mem m lev IOK -> juicy_mem_core j = core lev.
+Lemma mapsto_alloc: forall m ch lo hi m' b
+  (Hch : size_chunk ch = hi - lo) (Halign : (align_chunk ch | lo)%Z),
+  Mem.alloc m lo hi = (m', b) ->
+  mem_auth m ⊢ |==> mem_auth m' ∗ address_mapsto ch Vundef Tsh (b, lo).
 Proof.
-intros.
-destruct j; simpl.
-unfold initial_mem in H.
-inversion H; subst.
-unfold juicy_mem_core. simpl.
-clear - IOK.
-apply rmap_ext.
-repeat rewrite level_core.
-erewrite inflate_initial_mem_level; eauto.
-intro loc.
-repeat rewrite <- core_resource_at.
-unfold inflate_initial_mem.
-rewrite resource_at_make_rmap.
-unfold inflate_initial_mem'.
-repeat rewrite <- core_resource_at.
-destruct (IOK loc). clear IOK.
-revert H0; case_eq (lev @ loc); intros.
-rewrite core_NO.
-destruct (access_at m loc); try destruct p; try rewrite core_NO; try rewrite core_YES; auto.
-destruct (access_at m loc); try destruct p0; try rewrite core_NO;  repeat rewrite core_YES; auto.
-destruct H1.
-destruct H2. rewrite H2. auto.
-unfold inflate_initial_mem.
-rewrite <- core_ghost_of, ghost_of_make_rmap, core_ghost_of; auto.
-Qed.
-
-Lemma writable_writable_after_alloc' : forall m1 m2 lo hi b lev loc IOK1 IOK2,
-  alloc m1 lo hi = (m2, b) ->
-  writable loc (m_phi (initial_mem m1 lev IOK1)) ->
-  writable loc (m_phi (initial_mem m2 lev IOK2)).
+  intros.
+  iIntros "Hm"; iMod (mapsto_alloc with "Hm") as "[$ H]"; first done.
+  rewrite /address_mapsto.
+  iExists (replicate (Z.to_nat (hi - lo)) Undef).
+  rewrite (big_sepL_seq (replicate _ _)) length_replicate; setoid_rewrite nth_replicate; iFrame.
+  iPureIntro; split; last done.
+  split; first by rewrite -Hch.
+  split; last done.
+  destruct (Z.to_nat _) eqn: ?; first by pose proof (size_chunk_pos ch); lia.
+  rewrite /= decode_val_undef //.
+Qed.
+
+Lemma big_sepL_exist : forall {A B} `{base.Inhabited B} (f : nat -> A -> B -> mpred) l, ([∗ list] k↦v ∈ l, ∃ x, f k v x) ⊣⊢ ∃ lx, ⌜length lx = length l⌝ ∧ [∗ list] k↦v ∈ l, f k v (nth k lx inhabitant).
+Proof.
+  intros; revert f; induction l; simpl; intros.
+  { iSplit; last eauto.
+    iIntros "_"; iExists nil; done. }
+  rewrite IHl.
+  iSplit.
+  - iIntros "((%x & ?) & (%lx & % & ?))".
+    iExists (x :: lx); simpl; iFrame; auto.
+  - iIntros "(%lx & %Hlen & Hx & ?)".
+    iSplitL "Hx"; first eauto.
+    destruct lx as [| ? lx]; inv Hlen; simpl.
+    iExists lx; iFrame; done.
+Qed.
+
+Lemma big_opL_seq_index : forall {M : ofe} (o : M -> M -> M) `{Monoid _ o} n (f : nat -> nat -> M), (([^o list] k↦v ∈ seq 0 n, f k v) ≡ [^o list] v ∈ seq 0 n, f v v)%stdpp.
 Proof.
-intros.
-hnf in *.
-case_eq (m_phi (initial_mem m1 lev IOK1) @ loc); intros.
-rewrite H1 in H0.
-inv H0.
-rewrite H1 in H0.
-assert (~adr_range (b,lo) (hi-lo) loc). {
- assert (Ha := juicy_mem_access (initial_mem m1 lev IOK1) loc).
-  destruct loc. simpl in *.
-  rewrite H1 in Ha.
-  destruct H0 as [_ H0]. destruct k; inv H0.
-  intro Contra.
-  destruct Contra.
-  subst.
-  assert (access_at m1 (nextblock m1, z) Cur = None).
-    unfold access_at; apply nextblock_noaccess; simpl. apply Plt_strict.
-  assert (b0 = nextblock m1) by (eapply alloc_result; eauto).
-  subst.
-  rewrite Ha in H0. simpl in H0. clear - r H0.
-  unfold perm_of_sh in H0. repeat if_tac in H0; try contradiction; inv H0.
-}
-apply alloc_dry_unchanged_on with (m1:=m1)(m2:=m2) in H2; auto.
-destruct H2.
-unfold initial_mem; simpl.
-unfold inflate_initial_mem, inflate_initial_mem'.
-rewrite resource_at_make_rmap.
-destruct loc as (b',ofs').
-assert (Ha := juicy_mem_access (initial_mem m1 lev IOK1) (b',ofs')). {
-  rewrite H1 in Ha.
-  destruct H0 as [Hfree H0]. destruct k; try solve [inversion H0].
-  unfold perm_of_res in Ha. simpl in Ha.
-  rewrite <- H3.
-  rewrite <- H2. rewrite Ha.
-  clear - Hfree r.
-  unfold perm_of_sh. rewrite if_true by auto. if_tac; auto.
-  rewrite Ha. unfold perm_of_sh. rewrite if_true by auto. 
-  clear; if_tac; congruence.
- }
- rewrite H1 in H0. simpl in H0. contradiction.
+  intros.
+  apply big_opL_proper.
+  intros ??[-> _]%lookup_seq; done.
 Qed.
 
-Lemma readable_eq_after_alloc' : forall m1 m2 lo hi b lev loc IOK1 IOK2,
-  alloc m1 lo hi = (m2, b) ->
-  readable loc (m_phi (initial_mem m1 lev IOK1)) ->
-  m_phi (initial_mem m1 lev IOK1) @ loc=m_phi (initial_mem m2 lev IOK2) @ loc.
+Lemma big_sepL_seq_exist : forall {A} `{base.Inhabited A} (f : nat -> A -> mpred) n, ([∗ list] i ∈ seq 0 n, ∃ x, f i x) ⊣⊢ ∃ lx, ⌜length lx = n⌝ ∧ [∗ list] k↦v ∈ lx, f k v.
 Proof.
-intros.
-hnf in H0.
-case_eq (m_phi (initial_mem m1 lev IOK1) @ loc); intros.
-rewrite H1 in H0.
-inv H0.
-rewrite H1 in H0.
-assert (~adr_range (b,lo) (hi-lo) loc). {
- assert (Ha := juicy_mem_access (initial_mem m1 lev IOK1) loc).
-  destruct loc. simpl in *.
-  rewrite H1 in Ha.
-  destruct k; try solve [inv H0].
-  intro Contra.
-  destruct Contra.
-  subst.
-  assert (b0 = nextblock m1) by (eapply alloc_result; eauto).
-  subst.
-  simpl in Ha.
-(*
-  destruct (perm_of_sh_pshare t p) as [p' H4].
-  unfold perm_of_res in Ha; simpl in Ha; rewrite H4 in Ha.
-*)
-  assert (access_at m1 (nextblock m1, z) Cur = None).
-    unfold access_at. simpl. apply nextblock_noaccess. apply Plt_strict.
-  rewrite H2 in Ha.
-  clear - Ha r. unfold perm_of_sh in Ha. repeat if_tac in Ha; inv Ha; try contradiction.
-}
-apply alloc_dry_unchanged_on with (m1:=m1)(m2:=m2) in H2; auto.
-destruct H2.
-rewrite <- H1.
-unfold initial_mem; simpl.
-unfold inflate_initial_mem, inflate_initial_mem'.
-do 2 rewrite resource_at_make_rmap.
-destruct loc as (b',ofs').
- assert (Ha := juicy_mem_access (initial_mem m1 lev IOK1) (b',ofs')). {
-   rewrite H1 in Ha.   unfold perm_of_res in Ha; simpl in Ha.
-   simpl in H0. destruct k; try contradiction.
-  rewrite <- H2. rewrite Ha in *.
-  spec H3. clear - r. unfold perm_of_sh. repeat if_tac; try congruence; contradiction.
-  rewrite <- H3.
-  unfold perm_of_sh. if_tac. if_tac; auto. rewrite if_true by auto. auto.
-
- }
- rewrite H1 in H0. contradiction.
+  intros.
+  rewrite big_sepL_exist.
+  apply bi.exist_proper; intros lx.
+  rewrite seq_length (big_sepL_seq lx) big_opL_seq_index.
+  iSplit; iIntros "[-> ?]"; iFrame; done.
 Qed.
 
-
-Lemma necR_m_dry:
-  forall jm jm', necR jm jm' -> m_dry jm = m_dry jm'.
+Lemma VALspec_range_perm: forall m n sh l p, perm_of_sh sh = Some p ->
+  mem_auth m ∗ VALspec_range n sh l ⊢
+  ⌜Mem.range_perm m l.1 l.2 (l.2 + n) Cur p⌝.
 Proof.
-intros.
-induction H; auto.
-unfold age in H.
-apply age1_juicy_mem_unpack in H.
-decompose [and] H; auto.
-inv IHclos_refl_trans1.
-inv IHclos_refl_trans2.
-auto.
-Qed.
-
-Lemma perm_order''_trans p1 p2 p3 :
-  perm_order'' p1 p2 ->
-  perm_order'' p2 p3 ->
-  perm_order'' p1 p3.
+  intros.
+  iIntros "(Hm & H)".
+  iIntros (a ?).
+  rewrite /VALspec_range (big_sepL_lookup_acc _ _ (Z.to_nat (a - l.2))).
+  2: { apply lookup_seq; split; eauto; lia. }
+  iDestruct "H" as "[H _]".
+  rewrite /VALspec /adr_add /=.
+  iDestruct "H" as (?) "H".
+  replace (l.2 + Z.to_nat (a - l.2)) with a by lia.
+  iDestruct (mapsto_lookup with "Hm H") as %(? & ? & _ & _ & Hacc); iPureIntro.
+  rewrite /access_cohere /access_at /= H // in Hacc.
+Qed.
+
+Lemma VALspec_range_can_free: forall m n l,
+  mem_auth m ∗ VALspec_range n Share.top l ⊢
+  ⌜∃ m', free m l.1 l.2 (l.2 + n) = Some m'⌝.
 Proof.
-  destruct p1, p2, p3; simpl; try tauto.
-  apply perm_order_trans.
+  intros.
+  rewrite VALspec_range_perm; last apply perm_of_freeable.
+  apply bi.pure_mono; intros.
+  apply range_perm_free in H as [??]; eauto.
 Qed.
 
-Lemma po_join_sub_sh sh1 sh2 :
-  join_sub sh2 sh1 ->
-  Mem.perm_order'' (perm_of_sh sh1) (perm_of_sh sh2).
+Lemma mapsto_can_free: forall m ch v l,
+  mem_auth m ∗ address_mapsto ch v Share.top l ⊢
+  ⌜∃ m', free m l.1 l.2 (l.2 + size_chunk ch) = Some m'⌝.
 Proof.
-  intros [sh J].
-  unfold perm_of_sh.
-  if_tac. if_tac. repeat if_tac; constructor.
-  if_tac. rewrite if_false. constructor.
-  contradict H0. subst. apply join_top in J; auto.
-  repeat if_tac; constructor.
-  assert (~writable0_share sh2) by (contradict H; eapply join_writable01; eauto).
-  if_tac. rewrite if_false by auto. repeat if_tac; constructor.
-  rewrite (if_false (writable0_share sh2)) by auto.
-  assert (~readable_share sh2) by (contradict H1; eapply join_readable1; eauto).
-  rewrite (if_false (readable_share sh2)) by auto.
-  if_tac.
-  subst. apply split_identity in J. apply identity_share_bot in J.
-  rewrite if_true by auto. constructor.
-  auto. if_tac; constructor.
+  intros.
+  rewrite address_mapsto_VALspec_range; apply VALspec_range_can_free.
 Qed.
 
-Lemma po_join_sub r1 r2 :
-  join_sub r2 r1 ->
-  Mem.perm_order'' (perm_of_res r1) (perm_of_res r2).
+Lemma VALspec_range_free: forall m b lo hi m',
+  Mem.free m b lo hi = Some m' ->
+  mem_auth m ∗ VALspec_range (hi - lo) share_top (b, lo) ⊢ |==> mem_auth m'.
 Proof.
-  intros. destruct H as [r J]. inv J; simpl.
-  if_tac. subst. apply split_identity in RJ.
-  apply identity_share_bot in RJ. rewrite if_true by auto; constructor.
-  auto. if_tac; constructor.
-  destruct k; try constructor; apply po_join_sub_sh; eexists; eauto.
-  apply perm_order''_trans with (Some Nonempty).
-  destruct k; try constructor.
-  unfold perm_of_sh. if_tac. if_tac; constructor. rewrite if_true by auto; constructor.
-  if_tac; constructor.
-  destruct k; try constructor. apply po_join_sub_sh; eexists; eauto.
-  constructor.
+  intros.
+  iIntros "[Hm H]".
+  rewrite /VALspec_range /VALspec.
+  rewrite big_sepL_seq_exist.
+  iDestruct "H" as (? Hlen) "H".
+  rewrite -(big_sepL_fmap _ (fun i b0 => adr_add (b, lo) i ↦ b0)).
+  iApply (mapsto_free with "Hm H"); first done.
+  rewrite length_fmap Hlen //.
 Qed.
 
-(*
-Lemma po_join_sub' r1 r2 :
-  join_sub r2 r1 ->
-  Mem.perm_order'' (perm_of_res' r1) (perm_of_res' r2).
-Proof.
-  
-*)
-Lemma perm_of_res_lock_not_Freeable:
-  forall r,
-    perm_order'' (Some Writable) (perm_of_res_lock r).
+Lemma mapsto_free: forall m ch b lo hi m' v (Hch : size_chunk ch = hi - lo),
+  Mem.free m b lo hi = Some m' ->
+  mem_auth m ∗ address_mapsto ch v Tsh (b, lo) ⊢ |==> mem_auth m'.
 Proof.
   intros.
-  unfold perm_of_res_lock.
-  destruct r; try constructor.
-  destruct k; try constructor.
-  unfold perm_of_sh.
-  if_tac. rewrite if_false. constructor.
-  apply glb_Rsh_not_top.
-  repeat if_tac; constructor.
+  rewrite address_mapsto_VALspec_range Hch.
+  apply VALspec_range_free; done.
 Qed.
 
-Definition readable_perm (p: option permission) :
-  {perm_order'' p (Some Readable)}+{~perm_order'' p (Some Readable)}.
-destruct p.
-destruct p; try solve [left; constructor].
-all: right; intro; inv H.
-Defined.
-
-Definition rebuild_juicy_mem_fmap (jm: juicy_mem) (m': mem) : (AV.address -> resource) :=
- fun loc =>
-   match m_phi jm @ loc with
-    PURE k pp => PURE k pp
-   | NO sh rsh => if readable_perm (access_at m' loc Cur)
-                            then YES Tsh (writable_readable writable_share_top)
-                                        (VAL (contents_at m' loc)) NoneP
-                            else NO sh rsh 
-   | YES sh rsh (VAL _) _ => 
-                 if readable_perm (access_at m' loc Cur)
-                 then YES sh rsh (VAL (contents_at m' loc)) NoneP
-                 else NO _ bot_unreadable
-   | YES sh rsh _ _ => m_phi jm @ loc
-end.
-
-Definition rebuild_juicy_mem_rmap (jm: juicy_mem) (m': mem) :
-  {phi : rmap |
-  level phi = level jm /\
-  resource_at phi = rebuild_juicy_mem_fmap jm m' /\
-  ghost_of phi = ghost_of (m_phi jm)}.
-  refine (make_rmap (rebuild_juicy_mem_fmap jm m') (ghost_of (m_phi jm)) (level jm) _ _).
-extensionality loc.
-unfold compose.
-unfold rebuild_juicy_mem_fmap.
-destruct (m_phi jm @ loc) eqn:?H.
-if_tac; auto.
-pose proof (resource_at_approx (m_phi jm) loc).
-rewrite H in H0. simpl in H0.
-destruct k; simpl; auto.
-if_tac; auto.
-pose proof (resource_at_approx (m_phi jm) loc).
-rewrite H in *; auto.
-apply ghost_of_approx.
-Defined.
-
+End mpred.
diff --git a/veric/juicy_mem_ops.v b/veric/juicy_mem_ops.v
deleted file mode 100644
index d483726fbe..0000000000
--- a/veric/juicy_mem_ops.v
+++ /dev/null
@@ -1,436 +0,0 @@
-Require Import VST.veric.juicy_base.
-Import cjoins.
-Require Import VST.veric.juicy_mem.
-Require Import VST.veric.juicy_mem_lemmas.
-Require Import VST.veric.shares.
-
-Module Type JUICY_MEM_OPS.
-Parameter juicy_mem_store
-  : juicy_mem -> memory_chunk -> block -> Z -> val -> option juicy_mem.
-
-Parameter juicy_mem_storebytes
-  : juicy_mem -> block -> Z -> list memval -> option juicy_mem.
-
-Parameter juicy_mem_alloc
-  : juicy_mem -> Z -> Z -> juicy_mem * block.
-
-(* See comment below, "this is fixable"
-
-Parameter juicy_mem_free
-  : juicy_mem -> block -> Z -> Z -> option juicy_mem.
-Axiom juicy_mem_free_succeeds: forall j j' b lo hi,
-  juicy_mem_free j b lo hi = Some j'
-  -> exists m', free (m_dry j) b lo hi = Some m' /\ m' = m_dry j'.
-
-*)
-
-Axiom juicy_mem_store_succeeds: forall j j' ch b ofs v,
-  juicy_mem_store j ch b ofs v = Some j'
-  -> exists m', store ch (m_dry j) b ofs v = Some m' /\ m' = m_dry j'.
-Axiom juicy_mem_alloc_succeeds: forall j j' b lo hi,
-  juicy_mem_alloc j lo hi = (j', b) -> (m_dry j', b) = alloc (m_dry j) lo hi.
-
-End JUICY_MEM_OPS.
-
-#[local] Obligation Tactic := Tactics.program_simpl.
-
-Module JuicyMemOps <: JUICY_MEM_OPS.
-Program Definition juicy_mem_store j ch b ofs v: option juicy_mem :=
-  if valid_access_dec (m_dry j) ch b ofs Writable
-    then Some (store_juicy_mem j _ ch b ofs v _)
-    else None.
-Next Obligation.
-intros.
-let H := match goal with [ H : valid_access _ _ _ _ _ |- _ ] => H end in
-apply (proj1_sig (valid_access_store (m_dry j) ch b ofs v H)).
-Defined.
-Next Obligation.
-let H := match goal with [ H : valid_access _ _ _ _ _ |- _ ] => H end in
-apply (proj2_sig (valid_access_store (m_dry j) ch b ofs v H)).
-Defined.
-
-Lemma juicy_mem_store_succeeds: forall j j' ch b ofs v,
-  juicy_mem_store j ch b ofs v = Some j'
-  -> exists m', store ch (m_dry j) b ofs v = Some m' /\ m' = m_dry j'.
-Proof.
-intros until v; intro H.
-unfold juicy_mem_store in H.
-destruct (valid_access_dec (m_dry j) ch b ofs Writable) as [H1 | H1].
-exists (m_dry j').
-split; auto.
-inversion H.
-simpl.
-unfold juicy_mem_store_obligation_1.
-destruct (valid_access_store (m_dry j) ch b ofs v H1).
-simpl. auto.
-inv H.
-Qed.
-
-Program Definition juicy_mem_storebytes j b ofs bytes: option juicy_mem :=
-  if range_perm_dec (m_dry j) b ofs (ofs + Z_of_nat (length bytes)) Cur Writable
-    then Some (storebytes_juicy_mem j _ b ofs bytes _)
-    else None.
-Next Obligation.
-let H := match goal with [ H : range_perm _ _ _ _ _ _ |- _ ] => H end in
-apply (proj1_sig (range_perm_storebytes (m_dry j) b ofs bytes H)).
-Defined.
-Next Obligation.
-let H := match goal with [ H : range_perm _ _ _ _ _ _ |- _ ] => H end in
-apply (proj2_sig (range_perm_storebytes (m_dry j) b ofs bytes H)).
-Qed.
-
-Lemma juicy_mem_storebytes_succeeds: forall j j' b ofs bytes,
-  juicy_mem_storebytes j b ofs bytes = Some j' ->
-  exists m', storebytes (m_dry j) b ofs bytes = Some m' /\ m' = m_dry j'.
-Proof.
-intros until bytes; intro H.
-unfold juicy_mem_storebytes in H.
-destruct (range_perm_dec (m_dry j) b ofs (ofs + Z_of_nat (length bytes)) Cur Writable).
-exists (m_dry j').
-split; auto.
-inversion H.
-simpl.
-unfold juicy_mem_storebytes_obligation_1.
-destruct (range_perm_storebytes (m_dry j) b ofs bytes r).
-simpl. auto.
-inv H.
-Qed.
-
-
-Lemma pshare_sh_bot: forall p, pshare_sh p = Share.bot -> False.
-Proof. destruct p; intros. simpl in H. subst x. apply nonunit_nonidentity in n.
-apply n. apply bot_identity.
-Qed.
-
-Lemma juicy_mem_alloc_aux1:
-  forall jm lo hi m' b, alloc (m_dry jm) lo hi = (m',b) ->
-        forall ofs, m_phi jm @ (b,ofs) = NO Share.bot bot_unreadable.
-Proof.
- intros.
- pose proof (juicy_mem_max_access jm (b,ofs)).
- unfold max_access_at in H0.
- simpl in H0.
- pose proof (alloc_result _ _ _ _ _ H).
- subst b.
- destruct jm; simpl in *.
- rewrite JMalloc; auto; simpl.
-lia.
-Qed.
-
-(* Transparent alloc. *)
-Lemma after_alloc_contents_cohere:
- forall jm lo hi m' b (H : alloc (m_dry jm) lo hi = (m', b)),
-  contents_cohere m'
-    (after_alloc lo hi b (m_phi jm) (juicy_mem_alloc_aux1 jm lo hi m' b H)).
-Proof.
-intros.
-unfold after_alloc; hnf; intros.
-rewrite resource_at_make_rmap in H0. unfold after_alloc' in H0.
-if_tac in H0.
-*
-inv H0; split; auto.
-apply (alloc_dry_updated_on _ _ _ _ _ _ H); auto.
-*
-destruct (alloc_dry_unchanged_on _ _ _ _ _ b H H1).
-pose proof (juicy_mem_access jm loc).
-rewrite H0 in H4. rewrite H4 in H3.
-spec H3.
-clear.
-unfold perm_of_res, perm_of_sh; simpl.
-if_tac. if_tac. congruence. congruence. rewrite if_true by auto. congruence.
-destruct (juicy_mem_contents jm _ _ _ _ _ H0).
-split; auto.
-rewrite <- H3; auto.
-Qed.
-
-Lemma after_alloc_access_cohere:
- forall jm lo hi m' b (H : alloc (m_dry jm) lo hi = (m', b)),
- access_cohere m'
-  (after_alloc lo hi b (m_phi jm) (juicy_mem_alloc_aux1 jm lo hi m' b H)).
-Proof.
-intros; hnf; intros.
-unfold after_alloc. rewrite resource_at_make_rmap.
-unfold after_alloc'.
-if_tac.
-*
-unfold perm_of_res; simpl.   rewrite perm_of_freeable.
-apply (alloc_dry_updated_on _ _ _ _ _ _ H); auto.
-*
-destruct (alloc_dry_unchanged_on _ _ _ _ _ b H H0).
-pose proof (juicy_mem_access jm loc).
-congruence.
-Qed.
-
-Lemma after_alloc_max_access_cohere:
- forall jm lo hi m' b (H : alloc (m_dry jm) lo hi = (m', b)),
- max_access_cohere m'
-  (after_alloc lo hi b (m_phi jm) (juicy_mem_alloc_aux1 jm lo hi m' b H)).
-Proof.
-
-intros; pose proof I; hnf; intros.
-unfold after_alloc. rewrite resource_at_make_rmap.
-unfold after_alloc'.
-if_tac.
-*
- simpl; rewrite perm_of_freeable.
- destruct loc. destruct H1. subst b0.
- unfold max_access_at.
- rewrite (alloc_access_same _ _ _ _ _ H) by lia.
- constructor.
-*
-  assert (HH:= juicy_mem_max_access jm loc).
-
-    eapply perm_order''_trans; eauto.
-    unfold max_access_at in *.
-    destruct loc as [b' z].
-    rewrite (alloc_access_other _ _ _ _ _ H); auto.
-
-    destruct ((access_at m' (b', z) Max)); [apply perm_refl |constructor].
-    destruct (eq_block b b').
-    right. assert (~(lo <= z < lo + (hi - lo))).
-    { intros HHH; apply H1. split; auto. }
-    lia.
-    left; auto.
-Qed.
-
-Lemma after_alloc_alloc_cohere:
- forall jm lo hi m' b (H : alloc (m_dry jm) lo hi = (m', b)),
- alloc_cohere m'
-  (after_alloc lo hi b (m_phi jm) (juicy_mem_alloc_aux1 jm lo hi m' b H)).
-Proof.
-intros; hnf; intros.
-unfold after_alloc.
-rewrite resource_at_make_rmap.
-unfold after_alloc'.
-rewrite if_false.
-apply (juicy_mem_alloc_cohere jm loc).
-rewrite (nextblock_alloc _ _ _ _ _ H) in H0.
-zify. lia.
-destruct loc as [b' z']; simpl in *; intros [? ?]; subst b'.
-pose proof (alloc_result _ _ _ _ _ H).
-pose proof (nextblock_alloc _ _ _ _ _ H).
-rewrite <- H1 in H3.
-rewrite H3 in H0.
-clear - H0.
-zify; lia.
-Qed.
-
-Definition juicy_mem_alloc (jm: juicy_mem) (lo hi: Z) : juicy_mem * block :=
-         (mkJuicyMem (fst (alloc (m_dry jm) lo hi))
-                     (after_alloc lo hi (snd (alloc (m_dry jm) lo hi)) (m_phi jm)
-                            (juicy_mem_alloc_aux1 _ _ _ _ _ (eq_refl _)))
-                     (after_alloc_contents_cohere _ _ _ _ _ (eq_refl _))
-                     (after_alloc_access_cohere _ _ _ _ _ (eq_refl _))
-                     (after_alloc_max_access_cohere _ _ _ _ _ (eq_refl _))
-                     (after_alloc_alloc_cohere _ _ _ _ _ (eq_refl _)),
-           snd (alloc (m_dry jm) lo hi)).
-
-Lemma juicy_mem_alloc_at:
-  forall jm lo hi jm' b,
-     juicy_mem_alloc jm lo hi = (jm',b) ->
-     forall loc, m_phi jm' @ loc =
-       if adr_range_dec (b, lo) (hi - lo) loc
-       then YES Share.top readable_share_top (VAL Undef) NoneP
-       else m_phi jm @ loc.
-Proof.
- intros.
- inv H. simpl.
- unfold after_alloc; rewrite resource_at_make_rmap.
- unfold after_alloc'. auto.
-Qed.
-
-Lemma juicy_mem_alloc_level:
- forall jm lo hi jm' b,
-   juicy_mem_alloc jm lo hi = (jm', b) -> level jm = level jm'.
-Proof.
- unfold juicy_mem_alloc; intros.
- inv H.
- unfold after_alloc; simpl. rewrite level_make_rmap; auto.
-Qed.
-
-Lemma juicy_mem_alloc_succeeds: forall j j' b lo hi,
-  juicy_mem_alloc j lo hi = (j', b) -> (m_dry j', b) = alloc (m_dry j) lo hi.
-Proof.
-intros until hi; intro H.
-unfold juicy_mem_alloc in H.
-inv H.
-simpl.
-simpl; auto.
-Qed.
-
-(* This is fixable, as long as we replace range_perm_dec
-  with something based on the PERM argument of free_juicy_mem ...
-Program Definition juicy_mem_free j b lo hi: option juicy_mem :=
-  if range_perm_dec (m_dry j) b lo hi Cur Freeable
-    then Some (free_juicy_mem j _ b lo hi _ _)
-    else None.
-Next Obligation.
-apply (proj1_sig (range_perm_free (m_dry j) b lo hi H)).
-Defined.
-Next Obligation.
-apply (proj2_sig (range_perm_free (m_dry j) b lo hi H)).
-Defined.
-Next Obligation.
-pose proof (juicy_mem_access j (b,ofs)).
-specialize (H ofs).
-spec H; [ lia | ].
-hnf in H. unfold access_at in H2.
-simpl in *.
-destruct ((mem_access (m_dry j)) !! b ofs Cur); try contradiction.
-destruct p; inv H.
-inv H.
-hnf in H.
-
-Lemma juicy_mem_free_succeeds: forall j j' b lo hi,
-  juicy_mem_free j b lo hi = Some j'
-  -> exists m', free (m_dry j) b lo hi = Some m' /\ m' = m_dry j'.
-Proof.
-intros until hi; intro H.
-unfold juicy_mem_free in H.
-destruct (range_perm_dec (m_dry j) b lo hi Cur Freeable) as [H1 | H1].
-exists (m_dry j').
-split; auto.
-inversion H.
-unfold juicy_mem_free_obligation_1 in *.
-clear H H2.
-simpl.
-destruct (range_perm_free (m_dry j) b lo hi H1).
-simpl in *; subst; auto.
-inversion H.
-Qed.
-*)
-
-End JuicyMemOps.
-
-
-(* Here we construct an instance of StratifiedSemanticsWithSeparation using
-   the juicy mem operations. *)
-Module Abs := JuicyMemOps.
-Require Import VST.veric.local.
-
-Inductive AbsPrimcom : relation juicy_mem -> Prop :=
-| AbsPrimcom_store : forall ch b ofs v,
-  AbsPrimcom (fun j j' => Abs.juicy_mem_store j ch b ofs v = Some j')
-| AbsPrimcom_alloc : forall lo hi,
-  AbsPrimcom (fun j j' => fst (Abs.juicy_mem_alloc j lo hi) = j')
-(*
-| AbsPrimcom_free : forall b ofs n,
-  AbsPrimcom (fun j j' => Abs.juicy_mem_free j b ofs n = Some j').
-*).
-Inductive AbsPrimexpr : pfunc juicy_mem val -> Prop :=.
-
-#[export] Instance abstract : GenericSemantics juicy_mem AbsPrimcom AbsPrimexpr := {}.
-
-Inductive ConcPrimcom : relation mem -> Prop :=
-| ConcPrimcom_store : forall ch b ofs v,
-  ConcPrimcom (fun m m' => store ch m b ofs v = Some m')
-| ConcPrimcom_alloc : forall lo hi,
-  ConcPrimcom (fun m m' => fst (alloc m lo hi) = m')
-| ConcPrimcom_free : forall b ofs n,
-  ConcPrimcom (fun m m' => free m b ofs n = Some m').
-
-Inductive ConcPrimexpr : pfunc mem val -> Prop :=.
-
-#[export] Instance concrete : GenericSemantics mem ConcPrimcom ConcPrimexpr := {}.
-
-Inductive VU : relation juicy_mem -> relation mem -> Prop :=
-| VU_store : forall ch b ofs v,
-  VU (fun j j' => Abs.juicy_mem_store j ch b ofs v = Some j')
-     (fun m m' => store ch m b ofs v = Some m')
-| VU_alloc : forall lo hi,
-  VU (fun j j' => fst (Abs.juicy_mem_alloc j lo hi) = j')
-     (fun m m' => fst (alloc m lo hi) = m')
-(*| VU_free : forall b ofs n,
-  VU (fun j j' => Abs.juicy_mem_free j b ofs n = Some j')
-     (fun m m' => free m b ofs n = Some m')*).
-
-Inductive GF : pfunc juicy_mem val -> pfunc mem val -> Prop :=.
-
-Lemma PrimexprErasure : forall g f, GF g f -> False. Proof. inversion 1. Qed.
-
-Lemma PrimexprSafety : forall g f, GF g f -> False. Proof. inversion 1. Qed.
-
-Lemma PrimcomErasure : forall v u j j' m m',
-  VU v u -> m_dry j = m -> v j j' -> u m m' -> m_dry j' = m'.
-Proof.
-intros.
-inv H.
-(* store *)
-apply JuicyMemOps.juicy_mem_store_succeeds in H1.
-destruct H1 as [? [? ?]]; subst.
-rewrite H in H2; inv H2; auto.
-(* alloc *)
-generalize JuicyMemOps.juicy_mem_alloc_succeeds; intros.
-specialize (H j j' (snd (JuicyMemOps.juicy_mem_alloc j lo hi)) lo hi).
-case_eq (JuicyMemOps.juicy_mem_alloc j lo hi); intros.
-rewrite H0 in *. spec H; auto. simpl in *.
-destruct (alloc (m_dry j) lo hi); simpl in *. inv H; auto.
-(* free *)
-(*apply JuicyMemOps.juicy_mem_free_succeeds in H1.
-destruct H1 as [? [? ?]].
-subst. rewrite H in H2; inv H2; auto.
-*)
-Qed.
-
-Lemma PrimcomSafety : forall v u j j' m,
-  VU v u -> m_dry j = m -> v j j' -> exists m', u m m'.
-Proof.
-intros.
-inv H.
-(* store *)
-apply JuicyMemOps.juicy_mem_store_succeeds in H1.
-destruct H1 as [? [? ?]]; subst.
-eexists; eauto.
-(* alloc *)
-generalize JuicyMemOps.juicy_mem_alloc_succeeds; intros.
-specialize (H j j' (snd (JuicyMemOps.juicy_mem_alloc j lo hi)) lo hi).
-case_eq (JuicyMemOps.juicy_mem_alloc j lo hi); intros.
-rewrite H0 in *. spec H; auto. simpl in *.
-destruct (alloc (m_dry j) lo hi); simpl in *. inv H; auto.
-eexists; eauto.
-(* free *)
-(*apply JuicyMemOps.juicy_mem_free_succeeds in H1.
-destruct H1 as [? [? ?]].
-subst. eexists; eauto.
-*)
-Qed.
-
-#[export] Existing Instance abstract.
-#[export] Existing Instance concrete.
-
-#[export] Instance stratsem : @StratifiedSemantics
-  juicy_mem
-  AbsPrimcom
-  AbsPrimexpr
-  mem
-  ConcPrimcom
-  ConcPrimexpr
-  abstract
-  concrete
-  m_dry
-  VU
-  GF.
-Proof.
-constructor.
-intros; inv H; split; constructor.
-intros; inv H; split; constructor.
-apply PrimcomErasure.
-apply PrimcomSafety.
-intros; exfalso; eapply PrimexprErasure; eauto.
-intros; exfalso; eapply PrimexprSafety; eauto.
-Qed.
-
-#[export] Existing Instance stratsem.
-
-Require Import VST.veric.compcert_rmaps.
-
-Inductive RmapPrimexpr : pfunc rmap val -> Prop :=.
-
-Inductive HG : pfunc rmap val -> pfunc juicy_mem val -> Prop :=.
-
-#[export] Instance stratsemsep : StratifiedSemanticsWithSeparation m_phi RmapPrimexpr HG.
-Proof.
-constructor; intros; inv H.
-Qed.
-
-(*Lenb: moved alloc_juicy_variables, juicy_mem_alloc_core, and alloc_juicy_variables_e to veric/semax_call.v*)
\ No newline at end of file
diff --git a/veric/juicy_safety.v b/veric/juicy_safety.v
index f226086f4c..8ddbe12449 100644
--- a/veric/juicy_safety.v
+++ b/veric/juicy_safety.v
@@ -3,15 +3,12 @@ Require Import compcert.common.AST.
 Require Import compcert.common.Values.
 Require Import compcert.common.Globalenvs.
 
-Require Import VST.msl.ageable.
-
 Require Import VST.sepcomp.extspec.
 Require Import VST.sepcomp.step_lemmas.
 
-Require Import VST.veric.compcert_rmaps.
 Require Import VST.veric.juicy_mem.
 
-Definition pures_sub (phi phi' : rmap) :=
+(*Definition pures_sub (phi phi' : rmap) :=
   forall adr,
   match resource_at phi adr with
     | PURE k pp => resource_at phi' adr
@@ -66,4 +63,4 @@ Proof.
   intros lev [S1 E1] [S2 E2]; split. apply pures_sub_trans with phi2; auto.
   intros l; specialize (E1 l); specialize (E2 l).
   destruct (phi3 @ l); auto. destruct E2 as (pp, E2). rewrite E2 in E1; auto.
-Qed.
+Qed.*)
diff --git a/veric/lifting.v b/veric/lifting.v
new file mode 100644
index 0000000000..cab314db4e
--- /dev/null
+++ b/veric/lifting.v
@@ -0,0 +1,1154 @@
+(* A core wp-based separation logic for Clight, in the Iris style. Maybe VeriC can be built on top of this? *)
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Import VST.veric.juicy_base.
+Require Import VST.veric.juicy_mem.
+Require Import VST.veric.juicy_mem_lemmas.
+Require Import VST.veric.extend_tc.
+Require Import VST.veric.Clight_seplog.
+Require Import VST.veric.Clight_core.
+Require Import VST.veric.Cop2.
+Require Import VST.sepcomp.extspec.
+Require Import VST.veric.juicy_extspec.
+Require Import VST.veric.external_state.
+Require Import VST.veric.tycontext.
+Require Import VST.veric.lifting_expr.
+
+Open Scope maps.
+
+Definition genv_symb_injective {F V} (ge: Genv.t F V) : extspec.injective_PTree Values.block.
+Proof.
+exists (Genv.genv_symb ge).
+hnf; intros.
+eapply Genv.genv_vars_inj; eauto.
+Defined.
+
+Class VSTGS OK_ty Σ :=
+  { VST_heapGS :: heapGS Σ;
+    VST_extGS :: externalGS OK_ty Σ }.
+
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ} (OK_spec : ext_spec OK_ty) (ge : genv).
+
+Lemma make_tycontext_v_lookup : forall tys id t,
+  make_tycontext_v tys !! id = Some t -> In (id, t) tys.
+Proof.
+  intros ???; induction tys; simpl.
+  - rewrite PTree.gempty //.
+  - destruct a as (i, ?).
+    destruct (eq_dec id i).
+    + subst; rewrite PTree.gss.
+      inversion 1; auto.
+    + rewrite PTree.gso //; auto.
+Qed.
+
+Lemma make_tycontext_v_sound : forall tys id t, list_norepet (map fst tys) ->
+  make_tycontext_v tys !! id = Some t <-> In (id, t) tys.
+Proof.
+  intros; split; first apply make_tycontext_v_lookup.
+  induction tys; simpl; first done.
+  intros [-> | ?].
+  - apply PTree.gss.
+  - destruct a; inv H.
+    rewrite PTree.gso; auto.
+    intros ->.
+    contradiction H3; rewrite in_map_iff; eexists (_, _); eauto.
+Qed.
+
+Definition match_venv (ve: venviron) (vars: list (ident * type)) :=
+ forall id, match ve id with Some (b,t) => In (id,t) vars | _ => True end.
+
+Lemma typecheck_var_match_venv : forall ve tys,
+  typecheck_var_environ ve (make_tycontext_v tys) → match_venv ve tys.
+Proof.
+  unfold typecheck_var_environ, match_venv; intros.
+  destruct (ve id) as [(?, ty)|] eqn: Hid; last done.
+  destruct (H id ty) as [_ Hty].
+  apply make_tycontext_v_lookup, Hty; eauto.
+Qed.
+
+Definition jsafeN :=
+  jsafe(genv_symb := genv_symb_injective) (cl_core_sem ge) OK_spec ge.
+
+Definition cont_to_state f ve te ctl :=
+  match ctl with
+  | Kseq s ctl' => Some (State f s ctl' ve te)
+  | Kloop1 body incr ctl' => Some (State f Sskip (Kloop1 body incr ctl') ve te)
+  | Kloop2 body incr ctl' => Some (State f (Sloop body incr) ctl' ve te)
+  | Kcall id' f' ve' te' k' => Some (State f (Sreturn None) (Kcall id' f' ve' te' k') ve te)
+  | Kstop => Some (State f (Sreturn None) Kstop ve te)
+  | _ => None
+  end.
+
+Definition assert_safe (E: coPset) (f: function) (ctl: option cont) rho : iProp Σ :=
+  ∀ ora ve te,
+       ⌜rho = construct_rho (filter_genv ge) ve te⌝ →
+       (* this is the only tycontext piece we actually need *)
+       ⌜typecheck_var_environ (make_venv ve) (make_tycontext_v f.(fn_vars))⌝ →
+       match option_bind _ _ (cont_to_state f ve te) ctl with
+       | Some c => jsafeN E ora c
+       | None => |={E}=> False
+       end.
+
+Lemma assert_safe_mono E1 E2 f ctl rho: E1 ⊆ E2 ->
+  assert_safe E1 f ctl rho ⊢ assert_safe E2 f ctl rho.
+Proof.
+  rewrite /assert_safe; intros.
+  iIntros "H" (??? -> ?); iSpecialize ("H" with "[%] [%]"); [done..|].
+  destruct option_bind.
+  - by iApply jsafe_mask_mono.
+  - iMod (fupd_mask_subseteq E1); first done; iMod "H" as "[]".
+Qed.
+
+Lemma fupd_assert_safe : forall E f k rho,
+  (|={E}=> assert_safe E f k rho) ⊢ assert_safe E f k rho.
+Proof.
+  intros; iIntros "H" (?????).
+  iSpecialize ("H" with "[%] [%]"); [done..|].
+  destruct option_bind; by iMod "H".
+Qed.
+
+Global Instance elim_modal_fupd_assert_safe p P E f c rho :
+  ElimModal Logic.True p false (|={E}=> P) P (assert_safe E f c rho) (assert_safe E f c rho).
+Proof.
+  by rewrite /ElimModal bi.intuitionistically_if_elim
+    fupd_frame_r bi.wand_elim_r fupd_assert_safe.
+Qed.
+
+Fixpoint break_cont (k: cont) :=
+match k with
+| Kseq _ k' => break_cont k'
+| Kloop1 _ _ k' => Some k'
+| Kloop2 _ _ k' => Some k'
+| Kswitch k' => Some k'
+| _ => None
+end.
+
+Fixpoint continue_cont (k: cont) :=
+match k with
+| Kseq _ k' => continue_cont k'
+| Kloop1 s1 s2 k' => Some (Kseq s2 (Kloop2 s1 s2 k'))
+| Kswitch k' => continue_cont k'
+| _ => None
+end.
+
+Definition guarded E f k Q := ∀ rho,
+  (RA_normal Q rho -∗ assert_safe E f (Some k) rho) ∧
+  (RA_break Q rho -∗ assert_safe E f (break_cont k) rho) ∧
+  (RA_continue Q rho -∗ assert_safe E f (continue_cont k) rho) ∧
+  (RA_return Q None rho -∗ assert_safe E f (Some (Kseq (Sreturn None) (call_cont k))) rho) ∧
+  (∀ e, wp_expr E e (λ v, RA_return Q (Some v)) rho -∗
+          assert_safe E f (Some (Kseq (Sreturn (Some e)) (call_cont k))) rho).
+
+Lemma fupd_guarded : forall E f k Q, (|={E}=> guarded E f k Q) ⊢ guarded E f k Q.
+Proof.
+  intros.
+  iIntros "H" (rho); iSpecialize ("H" $! rho); repeat iSplit.
+  - iMod "H" as "($ & _)".
+  - iMod "H" as "(_ & $ & _)".
+  - iMod "H" as "(_ & _ & $ & _)".
+  - iMod "H" as "(_ & _ & _ & $ & _)".
+  - iMod "H" as "(_ & _ & _ & _ & $)".
+Qed.
+
+Global Instance elim_modal_fupd_guarded p P E f k Q :
+  ElimModal Logic.True p false (|={E}=> P) P (guarded E f k Q) (guarded E f k Q).
+Proof.
+  by rewrite /ElimModal bi.intuitionistically_if_elim
+    fupd_frame_r bi.wand_elim_r fupd_guarded.
+Qed.
+
+Lemma guarded_conseq : forall E f k Q Q'
+  (Hnormal : RA_normal Q ⊢ |={E}=> RA_normal Q')
+  (Hbreak : RA_break Q ⊢ |={E}=> RA_break Q')
+  (Hcontinue : RA_continue Q ⊢ |={E}=> RA_continue Q')
+  (Hreturn : ∀ v, RA_return Q v ⊢ |={E}=> RA_return Q' v),
+  guarded E f k Q' ⊢ guarded E f k Q.
+Proof.
+  intros.
+  iIntros "H" (rho); iSpecialize ("H" $! rho); repeat iSplit.
+  - iIntros "HQ"; rewrite Hnormal; monPred.unseal.
+    iMod "HQ"; iDestruct "H" as "(H & _)"; by iApply "H".
+  - iIntros "HQ"; rewrite Hbreak; monPred.unseal.
+    iMod "HQ"; iDestruct "H" as "(_ & H & _)"; by iApply "H".
+  - iIntros "HQ"; rewrite Hcontinue; monPred.unseal.
+    iMod "HQ"; iDestruct "H" as "(_ & _ & H & _)"; by iApply "H".
+  - iIntros "HQ"; rewrite Hreturn; monPred.unseal.
+    iMod "HQ"; iDestruct "H" as "(_ & _ & _ & H & _)"; by iApply "H".
+  - iIntros "% He"; iApply "H".
+    rewrite wp_expr_mono; last by intros; apply Hreturn.
+    done.
+Qed.
+
+Lemma guarded_normal : forall E f k P,
+  guarded E f k (normal_ret_assert P) ⊣⊢ (∀ rho, P rho -∗ assert_safe E f (Some k) rho).
+Proof.
+  intros.
+  iSplit.
+  { iIntros "H" (rho); by iDestruct ("H" $! rho) as "[? _]". }
+  iIntros "H" (?); iSplit; first by iApply "H".
+  simpl; monPred.unseal.
+  repeat (iSplit; first by iIntros "[]").
+  iIntros (?) "He".
+  rewrite /wp_expr; monPred.unseal.
+  iIntros (?????).
+  iApply jsafe_step; rewrite /jstep_ex.
+  iIntros (?) "(Hm & Ho)".
+  iMod ("He" with "[%] Hm") as ">(% & ? & ? & [])"; done.
+Qed.
+
+Definition var_sizes_ok (cenv: composite_env) (vars: list (ident*type)) :=
+   Forall (fun var : ident * type => @sizeof cenv (snd var) <= Ptrofs.max_unsigned)%Z vars.
+
+Definition var_block' (sh: Share.t) (cenv: composite_env) (idt: ident * type): assert :=
+  ⌜(sizeof (snd idt) <= Ptrofs.max_unsigned)%Z⌝ ∧
+  assert_of (fun rho => (memory_block sh (sizeof (snd idt))) (eval_lvar (fst idt) (snd idt) rho)).
+
+Definition stackframe_of' (cenv: composite_env) (f: Clight.function) : assert :=
+  fold_right bi_sep emp
+     (map (fun idt => var_block' Share.top cenv idt) (Clight.fn_vars f)).
+
+Definition freeable_blocks: list (Values.block * BinInt.Z * BinInt.Z) -> mpred :=
+  fold_right (fun bb a =>
+                        match bb with (b,lo,hi) =>
+                                          VALspec_range (hi-lo) Share.top (b,lo) ∗ a
+                        end)
+                    emp.
+
+Lemma stackframe_of_freeable_blocks:
+  forall f rho ve,
+      Forall (fun it => complete_type (genv_cenv ge) (snd it) = true) (fn_vars f) ->
+      list_norepet (map fst (fn_vars f)) ->
+      ve_of rho = make_venv ve ->
+      typecheck_var_environ (λ id : positive, ve !! id) (make_tycontext_v (fn_vars f)) ->
+       stackframe_of' (genv_cenv ge) f rho ⊢ freeable_blocks (blocks_of_env ge ve).
+Proof.
+ intros until ve.
+ intros COMPLETE.
+ intros ???.
+ assert (match_venv (make_venv ve) (fn_vars f)) as H7.
+ { by apply typecheck_var_match_venv. }
+ unfold stackframe_of'.
+ unfold blocks_of_env.
+ trans (foldr bi_sep emp (map (fun idt => var_block' Share.top (genv_cenv ge) idt rho) (fn_vars f))).
+ { clear; induction (fn_vars f); simpl; auto; monPred.unseal. rewrite -IHl; by monPred.unseal. }
+ unfold var_block'. unfold eval_lvar. monPred.unseal; simpl.
+ rewrite H0. unfold make_venv. forget (ge_of rho) as ZZ. clear rho H0.
+ revert ve H1 H7; induction (fn_vars f); simpl; intros.
+ case_eq (Maps.PTree.elements ve); simpl; intros; auto.
+ destruct p as [id ?].
+ pose proof (Maps.PTree.elements_complete ve id p). rewrite H0 in H2. simpl in H2.
+ specialize (H7 id). unfold make_venv in H7. rewrite H2 in H7; auto.
+ destruct p; inv H7.
+ inv H.
+ destruct a as [id ty]. simpl in *.
+ simpl in COMPLETE. inversion COMPLETE; subst.
+ clear COMPLETE; rename H5 into COMPLETE; rename H2 into COMPLETE_HD.
+ specialize (IHl COMPLETE H4 (Maps.PTree.remove id ve)).
+ assert (exists b, Maps.PTree.get id ve = Some (b,ty)). {
+  specialize (H1 id ty).
+  rewrite Maps.PTree.gss in H1. destruct H1 as [[b ?] _]; auto. exists b; apply H.
+ }
+ destruct H as [b H].
+ destruct (@Maps.PTree.elements_remove _ id (b,ty) ve H) as [l1 [l2 [? ?]]].
+ rewrite H0.
+ rewrite map_app. simpl map.
+ trans (freeable_blocks ((b,0,@Ctypes.sizeof ge ty) :: (map (block_of_binding ge) (l1 ++ l2)))).
+ 2:{
+   clear.
+   induction l1; simpl; try auto.
+   destruct a as [id' [hi lo]]. simpl in *.
+   rewrite -IHl1.
+   rewrite !assoc (comm _ (VALspec_range _ _ _ )) //. }
+ unfold freeable_blocks; simpl. rewrite <- H2.
+ apply bi.sep_mono.
+ { unfold Map.get. rewrite H. rewrite Cop2.eqb_type_refl.
+   unfold memory_block. iIntros "(% & % & H)".
+   rename H6 into H99.
+   rewrite memory_block'_eq.
+   2: rewrite Ptrofs.unsigned_zero; lia.
+   2:{ rewrite Ptrofs.unsigned_zero. rewrite Zplus_0_r.
+       rewrite Z2Nat.id.
+       change (Ptrofs.unsigned Ptrofs.zero) with 0 in H99.
+       lia.
+       pose proof (@sizeof_pos (genv_cenv ge) ty); lia. }
+ rewrite Z.sub_0_r.
+ unfold memory_block'_alt.
+ rewrite -> if_true by apply readable_share_top.
+ rewrite Z2Nat.id //.
+ + pose proof (@sizeof_pos (genv_cenv ge) ty); lia. }
+ etrans; last apply IHl.
+ clear - H3.
+ induction l; simpl; auto.
+ destruct a as [id' ty']. simpl in *.
+ apply bi.sep_mono; auto.
+ replace (Map.get (fun id0 : positive => Maps.PTree.get id0 (Maps.PTree.remove id ve)) id')
+   with (Map.get (fun id0 : positive => Maps.PTree.get id0 ve) id'); auto.
+ unfold Map.get.
+ rewrite Maps.PTree.gro; auto.
+ intros id' ty'; specialize (H1 id' ty').
+ { split; intro.
+ - destruct H1 as [H1 _].
+   assert (id<>id').
+   intro; subst id'.
+   clear - H3 H5; induction l; simpl in *. rewrite Maps.PTree.gempty in H5; inv H5.
+   destruct a; simpl in *.
+   rewrite Maps.PTree.gso in H5. auto. auto.
+   destruct H1 as [v ?].
+   rewrite Maps.PTree.gso; auto.
+   exists v. unfold Map.get. rewrite Maps.PTree.gro; auto.
+ - unfold Map.get in H1,H5.
+   assert (id<>id').
+     clear - H5; destruct H5. intro; subst. rewrite Maps.PTree.grs in H. inv H.
+   rewrite -> Maps.PTree.gro in H5 by auto.
+   rewrite <- H1 in H5. rewrite -> Maps.PTree.gso in H5; auto. }
+ hnf; intros.
+ destruct (make_venv (Maps.PTree.remove id ve) id0) eqn:H5; auto.
+ destruct p.
+ unfold make_venv in H5.
+ destruct (peq id id0).
+ subst. rewrite Maps.PTree.grs in H5. inv H5.
+ rewrite -> Maps.PTree.gro in H5 by auto.
+ specialize (H7 id0). unfold make_venv in H7. rewrite H5 in H7.
+ destruct H7; auto. inv H6; congruence.
+Qed.
+
+Lemma free_stackframe :
+  forall f m ve te
+  (NOREP: list_norepet (map (@fst _ _) (fn_vars f)))
+  (COMPLETE: Forall (fun it => complete_type (genv_cenv ge) (snd it) = true) (fn_vars f)),
+      typecheck_var_environ (λ id : positive, ve !! id) (make_tycontext_v (fn_vars f)) ->
+   mem_auth m ∗ stackframe_of' (genv_cenv ge) f (construct_rho (filter_genv ge) ve te) ⊢
+   |==> ∃ m2, ⌜free_list m (blocks_of_env ge ve) = Some m2⌝ ∧ mem_auth m2.
+Proof.
+  intros.
+  iIntros "(Hm & stack)".
+  rewrite stackframe_of_freeable_blocks //.
+  clear.
+  forget (blocks_of_env ge ve) as el.
+  iInduction el as [|] "IHel" forall (m); first eauto.
+  destruct a as ((id, b), t); simpl.
+  iDestruct "stack" as "(H & stack)".
+  iDestruct (juicy_mem_lemmas.VALspec_range_can_free with "[$Hm $H]") as %(m' & ?).
+  rewrite /= Zplus_minus in H; rewrite H.
+  iMod (juicy_mem_lemmas.VALspec_range_free with "[$Hm $H]") as "Hm"; first done.
+  iApply ("IHel" with "Hm stack").
+Qed.
+
+Lemma safe_return : forall E f ora ve te (Hmatch : match_venv (make_venv ve) f.(fn_vars)),
+  f.(fn_vars) = [] → (∀ m, state_interp m ora -∗ ⌜∃ i, ext_spec_exit OK_spec (Some (Vint i)) ora m⌝) ⊢ jsafeN E ora (State f (Sreturn None) Kstop ve te).
+Proof.
+  intros.
+  iIntros "H".
+  iApply jsafe_step; rewrite /jstep_ex.
+  iIntros (?) "(Hm & ?)".
+  rewrite H in Hmatch.
+  iMod (free_stackframe f  _ ve te with "[$Hm]") as (??) "?"; rewrite ?H; try eassumption; try solve [constructor].
+  { split; simpl.
+    * rewrite PTree.gempty //.
+    * rewrite /Map.get; intros (? & Hid).
+      rewrite /match_venv /make_venv in Hmatch.
+      specialize (Hmatch id); rewrite Hid // in Hmatch. }
+  { rewrite /stackframe_of' H /=.
+    by monPred.unseal. }
+  iIntros "!>"; iExists _, _; iSplit.
+  { iPureIntro; econstructor; eauto. }
+  iFrame.
+  rewrite jsafe_unfold /jsafe_pre.
+  iIntros "!> !>" (?) "?"; iLeft.
+  iDestruct ("H" with "[$]") as %(? & ?).
+  iExists _; simpl; eauto.
+Qed.
+
+Lemma guarded_stop : forall E f (P : assert),
+  f.(fn_vars) = [] →
+  (∀ rho, P rho -∗ ∀ m z, state_interp m z -∗ ⌜∃ i, ext_spec_exit OK_spec (Some (Vint i)) z m⌝) ⊢
+  guarded E f Kstop (function_body_ret_assert Tvoid P).
+Proof.
+  intros; iIntros "H" (?).
+  simpl; monPred.unseal.
+  iSplit.
+  - iIntros "?"; rewrite /assert_safe /=.
+    iIntros (??? -> ?).
+    iApply safe_return.
+    { by apply typecheck_var_match_venv. }
+    { done. }
+    iIntros (?) "?"; by iApply ("H" with "[$]").
+  - do 2 (iSplit; first by iIntros "[]").
+    iSplit.
+    + iIntros "?"; rewrite /assert_safe /=.
+      iIntros (??? -> ?).
+      iApply safe_return.
+      { by apply typecheck_var_match_venv. }
+      { done. }
+      iIntros (?) "?"; by iApply ("H" with "[$]").
+    + iIntros "% He" (??? -> ?).
+      iApply jsafe_step.
+      rewrite /wp_expr /jstep_ex; monPred.unseal.
+      iIntros (?) "(Hm & ?)".
+      iMod ("He" with "[%] Hm") as ">(% & ? & ? & [] & ?)"; done.
+Qed.
+
+Definition wp E f s (Q : ret_assert) : assert := assert_of (λ rho,
+    ∀ k, (* ▷ *) guarded E f k Q -∗ assert_safe E f (Some (Kseq s k)) rho).
+(* ▷ would make sense here, but removing Kseq isn't always a step: for instance, Sskip Kstop is a synonym
+   for (Sreturn None) Kstop rather than stepping to it. *)
+
+Lemma fupd_wp E f s Q : (|={E}=> wp E f s Q) ⊢ wp E f s Q.
+Proof.
+  split => rho; rewrite /wp /=; monPred.unseal.
+  by iIntros ">H".
+Qed.
+
+Global Instance elim_modal_fupd_wp p P E f k Q :
+  ElimModal Logic.True p false (|={E}=> P) P (wp E f k Q) (wp E f k Q).
+Proof.
+  by rewrite /ElimModal bi.intuitionistically_if_elim
+    fupd_frame_r bi.wand_elim_r fupd_wp.
+Qed.
+
+Lemma wp_conseq : forall E f s Q Q'
+  (Hnormal : RA_normal Q ⊢ |={E}=> RA_normal Q')
+  (Hbreak : RA_break Q ⊢ |={E}=> RA_break Q')
+  (Hcontinue : RA_continue Q ⊢ |={E}=> RA_continue Q')
+  (Hreturn : ∀ v, RA_return Q v ⊢ |={E}=> RA_return Q' v),
+  wp E f s Q ⊢ wp E f s Q'.
+Proof.
+  intros.
+  split => rho; rewrite /wp /=.
+  iIntros "H" (?) "HG".
+  rewrite guarded_conseq //.
+  by iApply "H".
+Qed.
+
+Lemma wp_seq : forall E f s1 s2 Q, wp E f s1 (overridePost (wp E f s2 Q) Q) ⊢ wp E f (Ssequence s1 s2) Q.
+Proof.
+  intros; rewrite /wp; split => rho.
+  iIntros "H % Hk" (??? -> ?).
+  iApply jsafe_local_step.
+  { intros; constructor. }
+  iApply ("H" with "[Hk]"); [|done..].
+  iIntros (rho).
+  destruct Q; simpl; iSplit; last by iDestruct ("Hk" $! rho) as "[_ $]".
+  iIntros "H"; iApply "H"; auto.
+Qed.
+
+Definition valid_val v :=
+  match v with Vptr _ _ => expr.valid_pointer v | _ => True end.
+
+Definition valid_val0 m v : Prop :=
+  match v with Vptr b o => valid_pointer m b (Ptrofs.intval o) = true | _ => True end.
+
+Lemma valid_val_mem : forall m v, mem_auth m ∗ valid_val v ⊢ ⌜valid_val0 m v⌝.
+Proof.
+  iIntros (??) "(Hm & Hv)"; destruct v; try done.
+  iApply expr_lemmas4.valid_pointer_dry0; iFrame.
+Qed.
+
+Lemma bool_val_valid : forall m v t b, valid_val0 m v -> Cop2.bool_val t v = Some b -> Cop.bool_val v t m = Some b.
+Proof.
+  rewrite /Cop2.bool_val /Cop.bool_val.
+  intros; destruct t; [done | | | | | done..].
+  - replace (classify_bool _) with bool_case_i; first by destruct v.
+    by destruct i.
+  - destruct v; [done..|].
+    simpl in *.
+    simple_if_tac; try done.
+    rewrite /weak_valid_pointer H //.
+  - destruct f; done.
+  - simpl; destruct (Cop2.eqb_type _ _); try done.
+    rewrite /Cop2.bool_val_p in H0.
+    simple_if_tac.
+    + destruct v; try done.
+      rewrite /weak_valid_pointer H //.
+    + destruct v; try done.
+      rewrite /weak_valid_pointer H //.
+Qed.
+
+Lemma wp_if: forall E f e s1 s2 R,
+  wp_expr E e (λ v, ⎡valid_val v⎤ ∧ ∃ b, ⌜Cop2.bool_val (typeof e) v = Some b⌝ ∧ if b then wp E f s1 R else wp E f s2 R)
+  ⊢ wp E f (Sifthenelse e s1 s2) R.
+Proof.
+  intros; split => rho; rewrite /wp /=.
+  iIntros "H % Hk" (??? -> ?).
+  iApply jsafe_step.
+  rewrite /jstep_ex /wp_expr.
+  iIntros (?) "(Hm & Ho)".
+  monPred.unseal.
+  iMod ("H" with "[%] Hm") as ">(% & % & Hm & H)"; first done.
+  iDestruct (valid_val_mem with "[Hm H]") as %?.
+  { rewrite bi.and_elim_l; iFrame. }
+  rewrite bi.and_elim_r; iDestruct "H" as (b ?) "H".
+  iIntros "!>"; iExists _, m.
+  iSplit.
+  { iPureIntro.
+    econstructor; eauto.
+    apply bool_val_valid; eauto. }
+  iFrame.
+  destruct b; simpl; iNext; iApply ("H" with "[-]"); done.
+Qed.
+
+(* see also semax_lemmas.derives_skip *)
+Lemma safe_skip : forall E ora f k ve te (Hty : typecheck_var_environ (make_venv ve) (make_tycontext_v (fn_vars f))),
+  assert_safe E f (Some k) (construct_rho (filter_genv ge) ve te) ⊢
+  jsafeN E ora (State f Sskip k ve te).
+Proof.
+  intros; iIntros "H".
+  rewrite /assert_safe.
+  iSpecialize ("H" with "[%] [%]"); [done..|].
+  destruct k as [ | s ctl' | | | |]; try done; try solve [iApply (jsafe_local_step with "H"); constructor].
+  - iApply (convergent_controls_jsafe with "H"); simpl; try congruence.
+    by inversion 1; constructor.
+  - iMod "H" as "[]".
+  - iApply (convergent_controls_jsafe with "H"); simpl; try congruence.
+    by inversion 1; constructor.
+Qed.
+
+Lemma wp_skip: forall E f R, RA_normal R ⊢ wp E f Sskip R.
+Proof.
+  intros; split => rho; rewrite /wp.
+  iIntros "H % Hk" (??? -> ?).
+  iDestruct ("Hk" $! _) as "[Hk _]".
+  by iApply safe_skip; last iApply "Hk".
+Qed.
+
+Lemma wp_set: forall E f i e R,
+  wp_expr E e (λ v, assert_of (subst i (liftx v) (RA_normal R))) ⊢ wp E f (Sset i e) R.
+Proof.
+  intros; split => rho; rewrite /wp.
+  iIntros "H % Hk" (??? -> ?).
+  iApply jsafe_step.
+  rewrite /jstep_ex /wp_expr.
+  iIntros (?) "(Hm & Ho)".
+  monPred.unseal.
+  iMod ("H" with "[%] Hm") as ">(% & % & Hm & H)"; first done.
+  iIntros "!>".
+  iExists _, _; iSplit.
+  { iPureIntro; constructor; eauto. }
+  iFrame.
+  iNext; simpl.
+  iDestruct ("Hk" $! _) as "[Hk _]".
+  iApply safe_skip; first done; last iApply "Hk".
+  rewrite /subst /env_set /construct_rho /= expr_lemmas.map_ptree_rel //.
+Qed.
+
+Lemma mapsto_can_store : forall sh t ch b o v v' m (Hwrite : writable0_share sh) (Hch : access_mode t = By_value ch),
+  mem_auth m ∗ mapsto sh t (Vptr b o) v ⊢ ⌜∃ m', Mem.store ch m b (Ptrofs.unsigned o) v' = Some m'⌝.
+Proof.
+  intros; rewrite /mapsto Hch.
+  iIntros "[Hm H]".
+  destruct (type_is_volatile t); try done.
+  rewrite -> if_true by auto.
+  iDestruct "H" as "[(% & ?) | (% & % & ?)]"; by iApply (mapsto_can_store with "[$]").
+Qed.
+
+Lemma mapsto_store: forall t m ch v v' sh b o m' (Hsh : writable0_share sh)
+  (Htc : tc_val' t v') (Hch : access_mode t = By_value ch),
+  Mem.store ch m b (Ptrofs.unsigned o) v' = Some m' ->
+  mem_auth m ∗ mapsto sh t (Vptr b o) v ⊢ |==> mem_auth m' ∗ mapsto sh t (Vptr b o) v'.
+Proof.
+  intros; rewrite /mapsto Hch.
+  iIntros "[Hm H]".
+  destruct (type_is_volatile t); try done.
+  rewrite -> !if_true by auto.
+  iDestruct "H" as "[(% & ?) | (% & % & ?)]"; (iMod (mapsto_store _ _ _ v' with "[$]") as "[$ H]"; [done..|];
+    destruct (eq_dec v' Vundef); [iRight | specialize (Htc n); iLeft]; eauto).
+Qed.
+
+Lemma wp_store: forall E f e1 e2 R,
+  wp_expr E (Ecast e2 (typeof e1)) (λ v2,
+      ⌜Cop2.tc_val' (typeof e1) v2⌝ ∧ wp_lvalue E e1 (λ '(b, o), let v1 := Vptr b (Ptrofs.repr o) in
+    ∃ sh, ⌜writable0_share sh⌝ ∧ ⎡mapsto_ sh (typeof e1) v1⎤ ∗
+    ▷ (⎡mapsto sh (typeof e1) v1 v2⎤ ={E}=∗ RA_normal R)))
+  ⊢ wp E f (Sassign e1 e2) R.
+Proof.
+  intros; split => rho; rewrite /wp.
+  iIntros "H % Hk" (??? -> ?).
+  iApply jsafe_step.
+  rewrite /jstep_ex /wp_lvalue /wp_expr.
+  iIntros (?) "(Hm & Ho)".
+  monPred.unseal.
+  iMod ("H" with "[%] Hm") as ">(% & %He2 & Hm & % & H)"; first done.
+  iMod ("H" with "[%] Hm") as ">(%b & %o & % & Hm & H)"; first done.
+  iDestruct "H" as (sh ?) "(Hp & H)".
+  rewrite Ptrofs.repr_unsigned.
+  iDestruct (mapsto_pure_facts with "Hp") as %((? & ?) & ?).
+  iDestruct (mapsto_can_store with "[$Hm Hp]") as %(? & Hstore); [done.. |].
+  iMod (mapsto_store with "[$Hm $Hp]") as "(Hm & Hp)"; [done.. |].
+  iIntros "!>".
+  specialize (He2 _ _ _ eq_refl); inv He2.
+  iExists _, _; iSplit.
+  { iPureIntro; econstructor; eauto.
+    econstructor; eauto. }
+  iFrame.
+  iNext.
+  iMod ("H" with "[%] Hp"); first done.
+  by iApply safe_skip; last iApply "Hk".
+  { inv H5. }
+Qed.
+
+Lemma wp_loop: forall E f s1 s2 R,
+  ▷ wp E f s1 (normal_ret_assert (▷ wp E f s2 (normal_ret_assert (wp E f (Sloop s1 s2) R)))) ⊢ wp E f (Sloop s1 s2) R.
+Proof.
+  intros; split => rho; rewrite /wp /=.
+  monPred.unseal.
+  iIntros "H % Hk" (??? -> ?).
+  iApply jsafe_local_step.
+  { intros; constructor. }
+  iNext.
+  iApply ("H" with "[Hk]"); [|done..].
+  rewrite guarded_normal.
+  iIntros (?) "H"; simpl.
+  iIntros (??? -> ?).
+  iApply jsafe_local_step.
+  { intros; constructor; auto. }
+  iNext.
+  iApply ("H" with "[Hk]"); [|done..].
+  rewrite guarded_normal.
+  iIntros (?) "H"; simpl.
+  by iApply ("H" with "Hk").
+Qed.
+
+Lemma wp_continue: forall E f R,
+  RA_continue R ⊢ wp E f Scontinue R.
+Proof.
+  intros; split => rho; rewrite /wp /=.
+  iIntros "H % Hk".
+  iDestruct ("Hk" $! _) as "(_ & _ & Hk & _)".
+  iSpecialize ("Hk" with "H").
+  iIntros (??? -> ?); iSpecialize ("Hk" with "[%] [%]"); [done..|].
+  destruct (continue_cont k) eqn:Hcont; simpl; last by iMod "Hk" as "[]".
+  rename c into k'.
+  assert (exists s c, k' = Kseq s c) as (? & ? & Hcase).
+  { induction k; inv Hcont; eauto. }
+  rewrite Hcase.
+  iInduction k as [| | | | |] "IHk" forall (k' Hcont Hcase); try discriminate.
+  - iApply jsafe_local_step.
+    { constructor. }
+    iApply ("IHk" with "[%] [%] Hk"); eauto.
+  - inv Hcont.
+    iApply jsafe_local_step.
+    { intros; apply step_skip_or_continue_loop1; auto. }
+    iApply "Hk".
+  - iApply jsafe_local_step.
+    { apply step_continue_switch. }
+    iApply ("IHk" with "[%] [%] Hk"); eauto.
+Qed.
+
+Lemma wp_break: forall E f R,
+  RA_break R ⊢ wp E f Sbreak R.
+Proof.
+  intros; split => rho; rewrite /wp /=.
+  iIntros "H % Hk".
+  iDestruct ("Hk" $! _) as "(_ & Hk & _)".
+  iSpecialize ("Hk" with "H").
+  iIntros (??? -> ?); iSpecialize ("Hk" with "[%] [%]"); [done..|].
+  destruct (break_cont k) eqn: Hcont; simpl; last by iMod "Hk" as "[]".
+  destruct c; simpl; try iMod "Hk" as "[]".
+  - iInduction k as [| | | | |] "IHk"; try discriminate.
+    + iApply jsafe_local_step; last by iApply ("IHk" with "[%] Hk"). constructor.
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { apply step_break_loop1. }
+      iNext.
+      iApply (convergent_controls_jsafe with "Hk"); simpl; try congruence.
+      by inversion 1; constructor.
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { apply step_break_loop2. }
+      iNext.
+      iApply (convergent_controls_jsafe with "Hk"); simpl; try congruence.
+      by inversion 1; constructor.
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { constructor; auto. }
+      iNext.
+      iApply (convergent_controls_jsafe with "Hk"); simpl; try congruence.
+      by inversion 1; constructor.
+  - rename c into k'.
+    iInduction k as [| s' | s1 s2 | s1 s2 | |] "IHk" forall (s k' Hcont); try discriminate.
+    + iApply jsafe_local_step.
+      { constructor. }
+      by iApply ("IHk" with "[%] Hk").
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { apply step_break_loop1. }
+      iApply jsafe_local_step.
+      { apply step_skip_seq. }
+      iApply "Hk".
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { apply step_break_loop2. }
+      iApply jsafe_local_step.
+      { apply step_skip_seq. }
+      iApply "Hk".
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { intros; apply step_skip_break_switch; auto. }
+      iApply jsafe_local_step.
+      { apply step_skip_seq. }
+      iApply "Hk".
+  - iInduction k as [| | | | |] "IHk"; try discriminate.
+    + iApply jsafe_local_step; last by iApply ("IHk" with "[%] Hk"). constructor.
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { apply step_break_loop1. }
+      iApply "Hk".
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { apply step_break_loop2. }
+      iApply "Hk".
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { constructor; auto. }
+      iApply "Hk".
+  - iInduction k as [| | | | |] "IHk"; try discriminate.
+    + iApply jsafe_local_step; last by iApply ("IHk" with "[%] Hk"). constructor.
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { apply step_break_loop1. }
+      iApply jsafe_local_step.
+      { apply step_skip_loop2. }
+      iApply "Hk".
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { apply step_break_loop2. }
+      iApply jsafe_local_step.
+      { apply step_skip_loop2. }
+      iApply "Hk".
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { constructor; auto. }
+      iApply jsafe_local_step.
+      { apply step_skip_loop2. }
+      iApply "Hk".
+  - iInduction k as [| | | | |] "IHk"; try discriminate.
+    + iApply jsafe_local_step; last by iApply ("IHk" with "[%] Hk"). constructor.
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { apply step_break_loop1. }
+      iNext.
+      iApply (convergent_controls_jsafe with "Hk"); simpl; try congruence.
+      by inversion 1; constructor.
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { apply step_break_loop2. }
+      iNext.
+      iApply (convergent_controls_jsafe with "Hk"); simpl; try congruence.
+      by inversion 1; constructor.
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { constructor; auto. }
+      iNext.
+      iApply (convergent_controls_jsafe with "Hk"); simpl; try congruence.
+      by inversion 1; constructor.
+Qed.
+
+(* It would be nice to decompose this into repeated wp_expr, but it includes typecasts. *)
+Definition wp_exprs es ts Φ : assert :=
+  ∀ m, ⎡mem_auth m⎤ -∗
+         ∃ vs, local (λ rho, forall ge ve te,
+            rho = construct_rho (filter_genv ge) ve te ->
+            Clight.eval_exprlist ge ve te m es ts vs (*/\ typeof e = t /\ tc_val t v*)) ∧
+         ⎡mem_auth m⎤ ∗ Φ vs.
+
+Lemma alloc_vars_lookup :
+forall ge id m1 l ve m2 e ,
+list_norepet (map fst l) ->
+(forall i, In i (map fst l) -> e !! i = None) ->
+Clight.alloc_variables ge (e) m1 l ve m2 ->
+(exists v, e !! id = Some v) ->
+ve !! id = e !! id.
+Proof.
+intros.
+generalize dependent e.
+revert ve m1 m2.
+
+induction l; intros.
+inv H1. auto.
+
+inv H1. simpl in *. inv H.
+destruct H2.
+assert (id <> id0).
+intro. subst.  specialize (H0 id0). spec H0. auto. rewrite H // in H0.
+eapply IHl in H10.
+rewrite Maps.PTree.gso in H10; auto.
+auto. intros. rewrite Maps.PTree.gsspec. if_tac. subst. tauto.
+apply H0. auto.
+rewrite Maps.PTree.gso; auto. eauto.
+Qed.
+
+Lemma alloc_vars_lemma : forall ge id ty l m1 m2 ve ve'
+(SD : forall i, In i (map fst l) -> ve !! i = None),
+list_norepet (map fst l) ->
+Clight.alloc_variables ge ve m1 l ve' m2 ->
+(In (id, ty) l ->
+exists v, ve' !! id = Some (v, ty)).
+Proof.
+  intros.
+  generalize dependent ve.
+  revert m1 m2.
+  induction l; intros; first done.
+  destruct a; simpl in *.
+  destruct H1 as [[=] | H1].
+  - subst. inv H0. inv H. apply alloc_vars_lookup with (id := id) in H9; auto.
+    rewrite H9. rewrite Maps.PTree.gss. eauto.
+    { intros. destruct (peq i id); first by subst; tauto. rewrite Maps.PTree.gso; eauto. }
+    { rewrite Maps.PTree.gss; eauto. }
+  - inv H0. inv H. apply IHl in H10; auto.
+    intros. rewrite Maps.PTree.gsspec. if_tac; last eauto. subst; done.
+Qed.
+
+Lemma alloc_vars_match_venv_gen: forall ge ve m l0 l ve' m',
+  match_venv (make_venv ve) l0 ->
+  Clight.alloc_variables ge ve m l ve' m' ->
+  match_venv (make_venv ve') (l0 ++ l).
+Proof.
+  intros.
+  generalize dependent l0; induction H0; intros.
+  { rewrite app_nil_r //. }
+  specialize (IHalloc_variables (l0 ++ [(id, ty)])).
+  rewrite -assoc in IHalloc_variables; apply IHalloc_variables.
+  rewrite /match_venv /make_venv in H1 |- *; intros i; specialize (H1 i).
+  destruct (eq_dec i id).
+  - subst; rewrite Maps.PTree.gss in_app; simpl; auto.
+  - rewrite Maps.PTree.gso //.
+    destruct (Maps.PTree.get i e) as [(?, ?)|]; first rewrite in_app; simpl; auto.
+Qed.
+
+Lemma alloc_vars_match_venv: forall ge m l ve' m',
+  Clight.alloc_variables ge empty_env m l ve' m' ->
+  match_venv (make_venv ve') l.
+Proof.
+  intros; eapply (alloc_vars_match_venv_gen _ _ _ []) in H; auto.
+  rewrite /match_venv /make_venv; intros.
+  rewrite Maps.PTree.gempty //.
+Qed.
+
+Lemma alloc_vars_typecheck_environ : forall m l ve' m',
+  list_norepet (map fst l) ->
+  Clight.alloc_variables ge empty_env m l ve' m' ->
+  typecheck_var_environ (make_venv ve') (make_tycontext_v l).
+Proof.
+  intros ????? Halloc.
+  rewrite /typecheck_var_environ /=; intros.
+  rewrite make_tycontext_v_sound //.
+  rewrite /Map.get /make_venv.
+  split.
+  + intros; eapply alloc_vars_lemma; eauto.
+    intros; apply Maps.PTree.gempty.
+  + intros (? & Hi); apply alloc_vars_match_venv in Halloc.
+    rewrite /match_venv /make_venv in Halloc.
+    specialize (Halloc id); rewrite Hi // in Halloc.
+Qed.
+
+Lemma alloc_block:
+ forall m n m' b (Halloc : Mem.alloc m 0 n = (m', b))
+   (Hn : 0 <= n < Ptrofs.modulus),
+   mem_auth m ⊢ |==> mem_auth m' ∗ memory_block Share.top n (Vptr b Ptrofs.zero).
+Proof.
+  intros.
+  iIntros "Hm"; iMod (mapsto_alloc_bytes with "Hm") as "($ & H)"; first done; iIntros "!>".
+  rewrite /memory_block Ptrofs.unsigned_zero.
+  iSplit; first by iPureIntro; lia.
+  rewrite Z.sub_0_r memory_block'_eq; [| lia..].
+  rewrite /memory_block'_alt if_true; last auto.
+  rewrite /VALspec_range Nat2Z.id.
+  iApply (big_sepL_mono with "H"); intros.
+  rewrite address_mapsto_VALspec_range /= VALspec1 //.
+Qed.
+
+Lemma alloc_stackframe:
+  forall m f te
+      (COMPLETE: Forall (fun it => complete_type (genv_cenv ge) (snd it) = true) (fn_vars f))
+      (Hsize: Forall (fun var => @Ctypes.sizeof ge (snd var) <= Ptrofs.max_unsigned) (fn_vars f)),
+      list_norepet (map fst (fn_vars f)) ->
+      mem_auth m ⊢ |==> ∃ m' ve, ⌜Clight.alloc_variables ge empty_env m (fn_vars f) ve m' ∧ typecheck_var_environ (make_venv ve) (make_tycontext_v (fn_vars f))⌝ ∧
+        mem_auth m' ∗ stackframe_of' (genv_cenv ge) f (construct_rho (filter_genv ge) ve te).
+Proof.
+  intros.
+  cut (mem_auth m ⊢ |==> ∃ (m' : Memory.mem) (ve : env),
+    ⌜(∀i, sub_option (empty_env !! i)%maps (ve !! i)%maps) ∧ alloc_variables ge empty_env m (fn_vars f) ve m'⌝
+    ∧ mem_auth m' ∗ stackframe_of' (genv_cenv ge) f (construct_rho (filter_genv ge) ve te)).
+  { intros Hgen; rewrite Hgen; iIntros ">(% & % & (% & %) & ?) !>".
+    iExists _, _; iFrame; iPureIntro; split3; split; auto.
+    eapply alloc_vars_typecheck_environ; eauto. }
+  rewrite /stackframe_of'.
+  forget (fn_vars f) as vars. clear f.
+  assert (forall i, In i (map fst vars) -> empty_env !! i = None) as Hout.
+  { intros; apply Maps.PTree.gempty. }
+  forget empty_env as ve0.
+  revert ve0 m Hout Hsize; induction vars; intros; simpl; iIntros "Hm".
+  - iExists m, ve0; iFrame; monPred.unseal; iPureIntro.
+    split; auto; split; auto.
+    + intros; apply sub_option_refl.
+    + constructor.
+  - destruct a as (id, ty).
+    destruct (Mem.alloc m 0 (@sizeof (genv_cenv ge) ty)) as (m', b) eqn: Halloc.
+    inv COMPLETE; inv Hsize; inv H.
+    iMod (alloc_block with "Hm") as "(Hm & block)"; first done.
+    { pose proof @sizeof_pos (genv_cenv ge) ty; unfold sizeof, Ptrofs.max_unsigned in *; simpl in *; lia. }
+    unshelve iMod (IHvars _ _ (Maps.PTree.set id (b,ty) ve0) with "Hm") as (?? (Hsub & ?)) "(Hm & ?)"; try done.
+    { intros; rewrite Maps.PTree.gso //; last by intros ->.
+      apply Hout; simpl; auto. }
+    iIntros "!>"; iExists _, _; monPred.unseal; iFrame.
+    rewrite /var_block' /eval_lvar; monPred.unseal; simpl.
+    replace (Map.get _ _) with (Some (b, ty)).
+    rewrite Cop2.eqb_type_refl; iFrame; iPureIntro; simpl.
+    + split; last done; split.
+      * intros i; specialize (Hsub i).
+        destruct (eq_dec i id); last by rewrite Maps.PTree.gso in Hsub.
+        subst; rewrite Hout //; simpl; auto.
+      * econstructor; eauto.
+    + rewrite /Map.get /=.
+      specialize (Hsub id); rewrite Maps.PTree.gss // in Hsub.
+Qed.
+
+Lemma build_call_temp_env:
+  forall f vl,
+     length (fn_params f) = length vl ->
+  exists te,  bind_parameter_temps (fn_params f) vl
+                     (create_undef_temps (fn_temps f)) = Some te.
+Proof.
+ intros.
+ forget (create_undef_temps (fn_temps f)) as rho.
+ revert rho vl H; induction (fn_params f); destruct vl; intros; inv H; try congruence.
+ exists rho; reflexivity.
+ destruct a; simpl.
+ apply IHl. auto.
+Qed.
+
+Lemma wp_call: forall E f0 e es R,
+  wp_expr E e (λ v, ∃ f, ⌜exists b, v = Vptr b Ptrofs.zero /\ Genv.find_funct_ptr ge b = Some (Internal f) /\
+    classify_fun (typeof e) =
+    fun_case_f (type_of_params (fn_params f)) (fn_return f) (fn_callconv f) /\
+    Forall (fun it => complete_type (genv_cenv ge) (snd it) = true) (fn_vars f)
+                 /\ list_norepet (map fst f.(fn_params) ++ map fst f.(fn_temps))
+                 /\ list_norepet (map fst f.(fn_vars)) /\ var_sizes_ok (genv_cenv ge) (f.(fn_vars))⌝ ∧
+    wp_exprs es (type_of_params (fn_params f)) (λ vs, ⌜length vs = length f.(fn_params)⌝ ∧ ▷ assert_of (λ rho,
+      ∀ rho', stackframe_of' (genv_cenv ge) f rho' -∗ ▷ wp E f f.(fn_body) (normal_ret_assert (assert_of (λ rho'', stackframe_of' (genv_cenv ge) f rho'' ∗ RA_normal R rho))) rho'))) ⊢
+  wp E f0 (Scall None e es) R.
+Proof.
+  intros; split => rho; rewrite /wp.
+  iIntros "H % Hk" (??? -> ?).
+  iApply jsafe_step.
+  rewrite /jstep_ex /wp_expr /wp_exprs.
+  iIntros (?) "(Hm & Ho)".
+  monPred.unseal.
+  iMod ("H" with "[%] Hm") as ">(% & %He & Hm & %f & %Hb & H)"; first done.
+  destruct Hb as (b & -> & Hb & ? & ? & ? & ? & ?).
+  iDestruct ("H" with "[%] Hm") as (vs Hes) "(Hm & % & H)"; first done.
+  iIntros "!>".
+  specialize (He _ _ _ eq_refl).
+  specialize (Hes _ _ _ eq_refl).
+  iExists _, _; iSplit.
+  { iPureIntro; econstructor; eauto. }
+  iFrame.
+  iNext.
+  iApply jsafe_step.
+  rewrite /jstep_ex.
+  iIntros (?) "(Hm & Ho)".
+  destruct (build_call_temp_env f vs) as (le & ?); first done.
+  iMod (alloc_stackframe with "Hm") as (m' ve' (? & ?)) "(Hm & Hstack)"; [done..|].
+  iIntros "!>".
+  iExists _, _; iSplit.
+  { iPureIntro; econstructor; eauto.
+    econstructor; eauto.
+    * eapply list_norepet_append_left; eauto.
+    * apply list_norepet_append_inv; auto. }
+  iFrame.
+  iApply ("H" with "[$] [Hk]"); [|done..].
+  rewrite guarded_normal.
+  iIntros "!>" (?) "(? & HR)".
+  iIntros (??? -> ?).
+  iApply jsafe_step.
+  rewrite /jstep_ex.
+  iIntros (?) "(Hm & Ho)".
+  iMod (free_stackframe with "[$]") as (m'' ?) "Hm"; [done..|].
+  iIntros "!>".
+  iExists _, _; iSplit.
+  { iPureIntro; econstructor; eauto. }
+  iFrame.
+  iNext.
+  iApply jsafe_local_step.
+  { intros; constructor. }
+  iNext.
+  simpl.
+  iApply safe_skip; last iApply "Hk"; done.
+Qed.
+
+Lemma call_cont_idem: forall k, call_cont (call_cont k) = call_cont k.
+Proof.
+induction k; intros; simpl; auto.
+Qed.
+
+Lemma wp_return_Some: forall E f e R,
+  wp_expr E e (λ v, RA_return R (Some v)) ⊢ wp E f (Sreturn (Some e)) R.
+Proof.
+  intros; split => rho; rewrite /wp /=.
+  iIntros "H % Hk" (??? -> ?).
+  iApply (convergent_controls_jsafe _ _ _ (State f (Sreturn (Some e)) (call_cont k) ve te)); try done.
+  { inversion 1; subst; try match goal with H : _ \/ _ |- _ => destruct H; done end.
+    rewrite call_cont_idem; econstructor; eauto. }
+  iDestruct ("Hk" $! _) as "(_ & _ & _ & _ & Hk)".
+  iSpecialize ("Hk" with "H").
+  by iApply "Hk".
+Qed.
+
+Lemma wp_return_None: forall E f R,
+  RA_return R None ⊢ wp E f (Sreturn None) R.
+Proof.
+  intros; split => rho; rewrite /wp /=.
+  iIntros "H % Hk" (??? -> ?).
+  iApply (convergent_controls_jsafe _ _ _ (State f (Sreturn None) (call_cont k) ve te)); try done.
+  { inversion 1; subst; try match goal with H : _ \/ _ |- _ => destruct H; done end.
+    rewrite call_cont_idem; econstructor; eauto. }
+  iDestruct ("Hk" $! _) as "(_ & _ & _ & Hk & _)".
+  by iApply ("Hk" with "H").
+Qed.
+
+End mpred.
+
+(* adequacy: copied from veric/SequentialClight *)
+Require Import VST.veric.external_state.
+Require Import VST.sepcomp.step_lemmas.
+Require Import VST.sepcomp.semantics.
+
+Class VSTGpreS (Z : Type) Σ := {
+  VSTGpreS_inv :: invGpreS Σ;
+  VSTGpreS_heap :: gen_heapGpreS share address resource Σ;
+  VSTGpreS_funspec :: inG Σ (gmap_view.gmap_viewR address (@funspecO' Σ));
+  VSTGpreS_ext :: inG Σ (excl_authR (leibnizO Z))
+}.
+
+Definition VSTΣ Z : gFunctors :=
+  #[invΣ; gen_heapΣ share address resource; GFunctor (gmap_view.gmap_viewRF address funspecOF');
+    GFunctor (excl_authR (leibnizO Z)) ].
+Global Instance subG_VSTGpreS {Z Σ} : subG (VSTΣ Z) Σ → VSTGpreS Z Σ.
+Proof. solve_inG. Qed.
+
+Lemma init_VST: forall Z `{!VSTGpreS Z Σ} (z : Z),
+  ⊢ |==> ∀ _ : invGS_gen HasNoLc Σ, ∃ _ : gen_heapGS share address resource Σ, ∃ _ : funspecGS Σ, ∃ _ : externalGS Z Σ,
+    let H : VSTGS Z Σ := Build_VSTGS _ _ (HeapGS _ _ _ _) _ in
+    (state_interp Mem.empty z ∗ funspec_auth ∅ ∗ has_ext z) ∗ ghost_map.ghost_map_auth(H0 := gen_heapGpreS_meta) (gen_meta_name _) 1 ∅.
+Proof.
+  intros; iIntros.
+  iMod gen_heap_init_names_empty as (??) "(? & ?)".
+  iMod (own_alloc(A := gmap_view.gmap_viewR address (@funspecO' Σ)) (gmap_view.gmap_view_auth (DfracOwn 1) ∅)) as (γf) "?".
+  { apply gmap_view.gmap_view_auth_valid. }
+  iMod (ext_alloc z) as (?) "(? & ?)".
+  iIntros "!>" (?); iExists (GenHeapGS _ _ _ _ γh γm), (FunspecG _ _ γf), _.
+  rewrite /state_interp /mem_auth /funspec_auth /=; iFrame.
+  iSplit; [|done]. iPureIntro. apply juicy_mem.empty_coherent.
+Qed.
+
+Global Instance stepN_absorbing {PROP : bi} `{!BiFUpd PROP} n E1 E2 (P : PROP) `{!Absorbing P}: Absorbing (|={E1}[E2]▷=>^n P).
+Proof.
+  induction n; apply _.
+Qed.
+
+Lemma adequacy: forall `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} ge z q m n,
+  state_interp m z ∗ jsafeN OK_spec ge ⊤ z q ⊢
+  |={⊤}[∅]▷=>^n ⌜dry_safeN(genv_symb := genv_symb_injective) (cl_core_sem ge) OK_spec ge n z q m⌝.
+Proof.
+  intros.
+  iIntros "(S & Hsafe)".
+  iLöb as "IH" forall (m z q n).
+  destruct n as [|n]; simpl.
+  { iPureIntro. constructor. }
+  rewrite [in (environments.Esnoc _ "Hsafe" _)]/jsafeN jsafe_unfold /jsafe_pre.
+  iMod ("Hsafe" with "S") as "[Hsafe_halt | [Hsafe_core | Hsafe_ext]]".
+  - iDestruct "Hsafe_halt" as %(ret & Hhalt & Hexit).
+    iApply step_fupd_intro; first done; iApply step_fupdN_intro; first done.
+    iPureIntro; eapply safeN_halted; eauto.
+  - iDestruct "Hsafe_core" as ">(%c' & %m' & % & s_interp & ▷jsafe)".
+    iApply fupd_mask_intro; first done.
+    iIntros "Hclose !>"; iMod "Hclose" as "_".
+    iSpecialize ("IH" with "[$] [$]").
+    iModIntro; iApply (step_fupdN_mono with "IH").
+    iPureIntro. eapply safeN_step; eauto.
+  - iDestruct "Hsafe_ext" as (ef args w (at_external & Hpre)) "Hpost".
+    iAssert (|={⊤}[∅]▷=>^(S n) ⌜(∀ (ret : option val) m' z' n',
+      Val.has_type_list args (map proj_xtype (sig_args (ef_sig ef)))
+      → Builtins0.val_opt_has_rettype ret (sig_res (ef_sig ef))
+        → n' ≤ n
+            → ext_spec_post OK_spec ef w
+                (genv_symb_injective ge) (sig_res (ef_sig ef)) ret z' m'
+              → ∃ q',
+                  (after_external (cl_core_sem ge) ret q m' = Some q'
+                   ∧ dry_safeN(genv_symb := genv_symb_injective) (cl_core_sem ge) OK_spec ge n' z' q' m'))⌝) with "[-]" as "Hdry".
+      2: { iApply (step_fupdN_mono with "Hdry"); iPureIntro; intros; eapply safeN_external; eauto. }
+      iApply step_fupdN_mono; first by do 8 setoid_rewrite bi.pure_forall.
+      repeat (setoid_rewrite step_fupdN_plain_forall; last done; [|apply _..]).
+      iIntros (ret m' z' n' ????).
+      iApply fupd_mask_intro; first done.
+      iIntros "Hclose !>"; iMod "Hclose" as "_".
+      iMod ("Hpost" with "[%] [%]") as (??) "(S & Hsafe)"; [done..|].
+      iSpecialize ("IH" with "[$] [$]").
+      iModIntro; iApply step_fupdN_le; [done..|].
+      iApply (step_fupdN_mono with "IH"); eauto.
+Qed.
+
+Definition ext_spec_entails {M E Z} (es1 es2 : external_specification M E Z) :=
+  (forall e x1 p tys args z m, ext_spec_pre es1 e x1 p tys args z m ->
+     exists x2, ext_spec_pre es2 e x2 p tys args z m /\
+       forall ty ret z' m', ext_spec_post es2 e x2 p ty ret z' m' ->
+                            ext_spec_post es1 e x1 p ty ret z' m') /\
+  (forall v z m, ext_spec_exit es1 v z m -> ext_spec_exit es2 v z m).
+
+Lemma ext_spec_entails_refl : forall {M E Z} (es : external_specification M E Z), ext_spec_entails es es.
+Proof.
+  intros; split; eauto.
+Qed.
+
+Theorem ext_spec_entails_safe : forall {G C M Z} {genv_symb} Hcore es1 es2 ge n z c m
+  (Hes : ext_spec_entails es1 es2),
+  @step_lemmas.dry_safeN G C M Z genv_symb Hcore es1 ge n z c m -> @step_lemmas.dry_safeN G C M Z genv_symb Hcore es2 ge n z c m.
+Proof.
+  induction n as [n IHn] using lt_wf_ind; intros.
+  inv H.
+  - constructor.
+  - eapply step_lemmas.safeN_step; eauto.
+    eapply IHn; eauto.
+  - destruct Hes as (Hes & ?).
+    apply Hes in H1 as (x2 & ? & ?).
+    eapply step_lemmas.safeN_external; eauto; intros.
+    edestruct H2 as (c' & ? & ?); eauto.
+    exists c'; split; auto.
+    eapply IHn; eauto; [lia | by split].
+  - destruct Hes.
+    eapply step_lemmas.safeN_halted; eauto.
+Qed.
+
+Lemma wp_adequacy: forall `{!VSTGpreS OK_ty Σ} {Espec : forall `{VSTGS OK_ty Σ}, ext_spec OK_ty} {dryspec : ext_spec OK_ty}
+  (Hdry : forall `{!VSTGS OK_ty Σ}, ext_spec_entails Espec dryspec)
+  ge m z f s (R : forall `{!VSTGS OK_ty Σ}, assert) ve te (Hf : f.(fn_vars) = [])
+  (EXIT: forall `{!VSTGS OK_ty Σ}, ⊢ (∀ rho, R rho -∗ ∀ m z, state_interp m z -∗ ⌜∃ i, ext_spec_exit Espec (Some (Vint i)) z m⌝)),
+  (∀ `{HH : invGS_gen HasNoLc Σ}, ⊢ |={⊤}=> ∃ _ : gen_heapGS share address resource Σ, ∃ _ : funspecGS Σ, ∃ _ : externalGS OK_ty Σ,
+    let H : VSTGS OK_ty Σ := Build_VSTGS _ _ (HeapGS _ _ _ _) _ in
+    local (λ rho, rho = construct_rho (filter_genv ge) ve te) ∧ ⌜typecheck_var_environ (make_venv ve) (make_tycontext_v f.(fn_vars))⌝ ∧ ⎡state_interp m z⎤ ∗ wp Espec ge ⊤ f s (function_body_ret_assert Tvoid R)) →
+       (forall n,
+        @dry_safeN _ _ _ OK_ty (genv_symb_injective) (cl_core_sem ge) dryspec
+            ge n z (State f s Kstop ve te) m (*∧ φ*)) (* note that this includes ext_spec_exit if the program halts *).
+Proof.
+  intros.
+(*  assert (forall n, @dry_safeN _ _ _ OK_ty (genv_symb_injective) (cl_core_sem ge) dryspec
+            ge n z (State f s Kstop ve te) m ∧ φ) as H'; last (split; [eapply H' | apply (H' 0)]; eauto). *)
+  (*intros n;*)
+  eapply ouPred.pure_soundness, (step_fupdN_soundness_no_lc'(Σ := Σ) _ (S n) O); [apply _..|].
+  simpl; intros. apply (embed_emp_valid_inj(PROP2 := monPred environ_index _)). iIntros "_".
+  iMod (H Hinv) as (???) "?".
+  iStopProof.
+  rewrite /wp; split => rho; monPred.unseal.
+  iIntros "(% & % & S & H)".
+  iApply step_fupd_intro; first done.
+  iNext.
+  set (HH := Build_VSTGS _ _ _ _).
+  iApply step_fupdN_mono.
+  { apply bi.pure_mono, (ext_spec_entails_safe _ (Espec HH)); auto. }
+  iApply (adequacy(VSTGS0 := HH)(OK_spec := Espec HH)).
+  iFrame.
+  iApply "H"; [|done..].
+  iApply guarded_stop; auto.
+  iApply EXIT.
+Qed.
diff --git a/veric/lifting_expr.v b/veric/lifting_expr.v
new file mode 100644
index 0000000000..40e772ee01
--- /dev/null
+++ b/veric/lifting_expr.v
@@ -0,0 +1,233 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Import VST.veric.juicy_base.
+Require Import VST.veric.juicy_mem.
+Require Import VST.veric.Clight_base.
+Require Import VST.veric.Clight_seplog.
+Require Import VST.veric.tycontext.
+Import LiftNotation.
+
+Global Instance local_absorbing `{!heapGS Σ} l : Absorbing (local l).
+Proof.
+  rewrite /local; apply monPred_absorbing, _.
+Qed.
+
+Global Instance local_persistent `{!heapGS Σ} l : Persistent (local l).
+Proof.
+  rewrite /local; apply monPred_persistent, _.
+Qed.
+
+Section mpred.
+
+Context `{!heapGS Σ}.
+
+Definition wp_expr E e Φ : assert :=
+  |={E}=> ∀ m, ⎡mem_auth m⎤ ={E}=∗
+         ∃ v, local (λ rho, forall ge ve te,
+            rho = construct_rho (filter_genv ge) ve te ->
+            Clight.eval_expr ge ve te m e v (*/\ typeof e = t /\ tc_val t v*)) ∧
+         ⎡mem_auth m⎤ ∗ Φ v.
+
+Definition wp_lvalue E e (Φ : address → assert) : assert :=
+  |={E}=> ∀ m, ⎡mem_auth m⎤ ={E}=∗
+         ∃ b o, local (λ rho, forall ge ve te,
+            rho = construct_rho (filter_genv ge) ve te ->
+            Clight.eval_lvalue ge ve te m e b o Full (*/\ typeof e = t /\ tc_val t v*)) ∧
+         ⎡mem_auth m⎤ ∗ Φ (b, Ptrofs.unsigned o).
+
+Lemma fupd_wp_expr : forall E e P, (|={E}=> wp_expr E e P) ⊢ wp_expr E e P.
+Proof. intros; apply fupd_trans. Qed.
+
+Global Instance elim_modal_fupd_wp_expr p P E e Q :
+  ElimModal Logic.True p false (|={E}=> P) P (wp_expr E e Q) (wp_expr E e Q).
+Proof.
+  by rewrite /ElimModal bi.intuitionistically_if_elim
+    fupd_frame_r bi.wand_elim_r fupd_wp_expr.
+Qed.
+
+Lemma wp_expr_mono : forall E e P1 P2, (∀ v, P1 v ⊢ |={E}=> P2 v) → wp_expr E e P1 ⊢ wp_expr E e P2.
+Proof.
+  intros; rewrite /wp_expr.
+  iIntros ">H !>" (?) "Hm".
+  iMod ("H" with "Hm") as (?) "(? & ? & H)".
+  rewrite H; iMod "H".
+  iIntros "!>"; iExists _; iFrame.
+Qed.
+
+Lemma fupd_wp_lvalue : forall E e P, (|={E}=> wp_lvalue E e P) ⊢ wp_lvalue E e P.
+Proof. intros; apply fupd_trans. Qed.
+
+Global Instance elim_modal_fupd_wp_lvalue p P E e Q :
+  ElimModal Logic.True p false (|={E}=> P) P (wp_lvalue E e Q) (wp_lvalue E e Q).
+Proof.
+  by rewrite /ElimModal bi.intuitionistically_if_elim
+    fupd_frame_r bi.wand_elim_r fupd_wp_lvalue.
+Qed.
+
+Lemma wp_lvalue_mono : forall E e P1 P2, (∀ v, P1 v ⊢ |={E}=> P2 v) → wp_lvalue E e P1 ⊢ wp_lvalue E e P2.
+Proof.
+  intros; rewrite /wp_lvalue.
+  iIntros ">H !>" (?) "Hm".
+  iMod ("H" with "Hm") as (??) "(? & ? & H)".
+  rewrite H; iMod "H".
+  iIntros "!>"; iExists _; iFrame.
+Qed.
+
+(* rules *)
+Lemma wp_const_int E i t P:
+  P (Vint i) ⊢ wp_expr E (Econst_int i t) P.
+Proof.
+  rewrite /wp_expr.
+  iIntros "? !> % Hm !>".
+  iFrame.
+  iSplit; last done.
+  iStopProof; split => rho; monPred.unseal.
+  apply bi.pure_intro; constructor.
+Qed.
+
+Lemma wp_const_long E i t P:
+  P (Vlong i)
+  ⊢ wp_expr E (Econst_long i t) P.
+Proof.
+  rewrite /wp_expr.
+  iIntros "? !> % Hm !>".
+  iFrame.
+  iSplit; last done.
+  iStopProof; split => rho; monPred.unseal.
+  apply bi.pure_intro; constructor.
+Qed.
+
+Lemma wp_const_float E i t P:
+  P (Vfloat i)
+  ⊢ wp_expr E (Econst_float i t) P.
+Proof.
+  rewrite /wp_expr.
+  iIntros "? !> % Hm !>".
+  iFrame.
+  iSplit; last done.
+  iStopProof; split => rho; monPred.unseal.
+  apply bi.pure_intro; constructor.
+Qed.
+
+Lemma wp_const_single E i t P:
+  P (Vsingle i)
+  ⊢ wp_expr E (Econst_single i t) P.
+Proof.
+  rewrite /wp_expr.
+  iIntros "? !> % Hm !>".
+  iFrame.
+  iSplit; last done.
+  iStopProof; split => rho; monPred.unseal.
+  apply bi.pure_intro; constructor.
+Qed.
+
+(* Caesium uses a small-step semantics for exprs, so the wp/typing for an operation can be broken up into
+   evaluating the arguments and then the op. Clight uses big-step and can't in general inject vals
+   into expr, so for now, hacking in a different wp judgment for ops. *)
+Definition wp_binop E op t1 v1 t2 v2 Φ : assert :=
+  |={E}=> ∀ m, ⎡mem_auth m⎤ ={E}=∗
+         ∃ v, local (λ rho, forall ge ve te,
+            rho = construct_rho (filter_genv ge) ve te ->
+            sem_binary_operation (genv_cenv ge) op v1 t1 v2 t2 m = Some v (*/\ typeof e = t /\ tc_val t v*)) ∧
+         ⎡mem_auth m⎤ ∗ Φ v.
+
+Lemma wp_binop_rule : forall E e1 e2 Φ o t, wp_expr E e1 (λ v1, wp_expr E e2 (λ v2, wp_binop E o (typeof e1) v1 (typeof e2) v2 Φ))
+  ⊢ wp_expr E (Ebinop o e1 e2 t) Φ.
+Proof.
+  intros.
+  rewrite /wp_expr /wp_binop.
+  iIntros ">H !>" (?) "Hm".
+  iMod ("H" with "Hm") as "(%v1 & H1 & Hm & >H)".
+  iMod ("H" with "Hm") as "(%v2 & H2 & Hm & >H)".
+  iMod ("H" with "Hm") as "(%v & H & Hm & ?)".
+  iIntros "!>"; iExists _; iFrame.
+  iStopProof; split => rho; monPred.unseal.
+  rewrite !monPred_at_affinely /local /lift1 /=.
+  iIntros "(%H1 & %H2 & %H)"; iPureIntro.
+  split; auto; intros; econstructor; eauto.
+Qed.
+
+Definition wp_unop E op t1 v1 Φ : assert :=
+  |={E}=> ∀ m, ⎡mem_auth m⎤ ={E}=∗
+         (* unops don't use the environment *)
+         ∃ v, ⌜Cop.sem_unary_operation op v1 t1 m = Some v⌝ ∧
+         ⎡mem_auth m⎤ ∗ Φ v.
+
+Lemma wp_unop_rule : forall E e Φ o t, wp_expr E e (λ v, wp_unop E o (typeof e) v Φ)
+  ⊢ wp_expr E (Eunop o e t) Φ.
+Proof.
+  intros.
+  rewrite /wp_expr /wp_binop.
+  iIntros ">H !>" (?) "Hm".
+  iMod ("H" with "Hm") as "(%v1 & H1 & Hm & >H)".
+  iMod ("H" with "Hm") as "(%v & H & Hm & ?)".
+  iIntros "!>"; iExists _; iFrame.
+  iStopProof; split => rho; monPred.unseal.
+  rewrite !monPred_at_affinely /local /lift1 /=.
+  iIntros "(%H1 & %H)"; iPureIntro.
+  split; auto; intros; econstructor; eauto.
+Qed.
+
+Definition globals := ident -> val.
+
+Inductive localdef : Type :=
+ | temp: ident -> val -> localdef
+ | lvar: ident -> type -> val -> localdef   (* local variable *)
+ | gvars: globals -> localdef.              (* global variables *)
+
+Arguments temp i%_positive v.
+
+Definition lvar_denote (i: ident) (t: type) (v: val) rho :=
+     match Map.get (ve_of rho) i with
+         | Some (b, ty') => t=ty' /\ v = Vptr b Ptrofs.zero
+         | None => False%type
+         end.
+
+Definition gvars_denote (gv: globals) rho :=
+   gv = (fun i => match Map.get (ge_of rho) i with Some b => Vptr b Ptrofs.zero | None => Vundef end).
+
+Definition locald_denote (d: localdef) : environ -> Prop :=
+ match d with
+ | temp i v => `and (`(eq v) (eval_id i)) `(v <> Vundef)
+ | lvar i t v => lvar_denote i t v
+ | gvars gv => gvars_denote gv
+ end.
+
+Lemma wp_tempvar_local : forall E _x x c_ty P,
+  <affine> (local $ locald_denote $ temp _x x) ∗ P x 
+  ⊢ wp_expr E (Etempvar _x c_ty) P.
+Proof.
+  intros. rewrite /wp_expr /=.
+  iIntros "[H HP] !>" (?) "Hm !>".
+  iExists _; iFrame. iSplit; [|done].
+  rewrite bi.affinely_elim.
+  iStopProof; split => rho.
+  rewrite /local /lift1 /=.
+  iIntros "[% %]" (????).
+  iPureIntro. econstructor.
+  unfold eval_id in H.
+  super_unfold_lift; subst; simpl in *.
+  unfold Map.get, make_tenv in *.
+  destruct (_ !! _); done.
+Qed.
+
+Lemma wp_var_local : forall E _x c_ty (lv:val) (T:address->assert),
+  <affine> (local $ locald_denote $ lvar _x c_ty lv) ∗
+  (∃ l, <affine> ⌜Some l = val2address lv⌝ ∗
+  T l)
+  ⊢ wp_lvalue E (Evar _x c_ty) T.
+Proof.
+  intros. subst. rewrite /wp_lvalue  /=.
+  iIntros "(Hl & [%l [% HT]]) !>" (m) "Hm !>".
+  iStopProof. split => rho; monPred.unseal.
+  rewrite !monPred_at_affinely /=.
+  iIntros "(%Hvar & H & ?)".
+  unfold lvar_denote in Hvar.
+  destruct (Map.get (ve_of rho) _x) eqn: Hve; [|done].
+  destruct p. destruct Hvar.
+  rewrite H1 in H. inversion H.
+  iExists _, _; iFrame.
+  iPureIntro. split; last done; intros; subst.
+  apply eval_Evar_local. apply Hve.
+Qed.
+
+End mpred.
diff --git a/veric/log_normalize.v b/veric/log_normalize.v
new file mode 100644
index 0000000000..fb2b4a4e82
--- /dev/null
+++ b/veric/log_normalize.v
@@ -0,0 +1,839 @@
+Require Import Coq.Setoids.Setoid.
+Require Import Coq.ZArith.ZArith.
+Require Import VST.zlist.sublist.
+Require Import Coq.Lists.List.
+Require Import Coq.micromega.Lia.
+Require Import iris.bi.monpred.
+Require Import iris.proofmode.proofmode.
+From iris_ora.logic Require Import oupred.
+Require Import VST.msl.Extensionality.
+
+Local Open Scope bi_scope.
+
+Create HintDb norm discriminated.
+
+#[export] Hint Extern 0 (_ ⊢ _) => match goal with |- ?A ⊢ ?B => constr_eq A B; simple apply PreOrder_Reflexive end : core.
+
+Ltac solve_andp' :=
+  first [ apply PreOrder_Reflexive
+        | rewrite bi.and_elim_l; solve_andp'
+        | rewrite bi.and_elim_r; solve_andp'].
+
+Ltac solve_andp := repeat apply bi.and_intro; solve_andp'.
+
+Lemma TT_right: forall {PROP : bi} (P : PROP), P ⊢ True.
+Proof. intros. apply bi.pure_intro, I. Qed.
+
+Lemma False_left: forall {PROP : bi} (P : PROP), False ⊢ P.
+Proof. intros. apply bi.pure_elim'; intuition. Qed.
+
+#[export] Hint Resolve TT_right: norm.
+#[export] Hint Resolve False_left : norm.
+
+Ltac norm := auto with norm.
+
+Lemma add_andp: forall {PROP : bi} (P Q : PROP), (P ⊢ Q) -> P ⊣⊢ P ∧ Q.
+Proof.
+  intros.
+  apply bi.equiv_entails; split.
+  + apply bi.and_intro; auto.
+  + apply bi.and_elim_l; apply PreOrder_Reflexive.
+Qed.
+
+Section pred.
+
+Context {M : uora}.
+Implicit Types (P Q : ouPred M).
+
+(* For efficiency, we would like to use eq instead of ⊣⊢ to relate equivalent predicates.
+   Unfortunately, uPreds/ouPreds do not enjoy extensionality (even with prop_ext).
+   Fortunately, most equivalences we want to rewrite with can be proved as equalities anyway.
+   Note also that if we switched to uPred_alt, all equivalences would be equalities. *)
+
+Lemma IProp_eq : forall a1 a2 b1 b2, a1 = a2 -> IProp M a1 b1 = IProp M a2 b2.
+Proof.
+  intros; subst; f_equal; apply proof_irr.
+Qed.
+
+Lemma True_and : forall P, (True ∧ P) = P.
+Proof.
+  intros.
+  ouPred.unseal.
+  destruct P.
+  apply IProp_eq; extensionality n x.
+  apply prop_ext.
+  unfold oupred.ouPred_holds; simpl.
+  tauto.
+Qed.
+
+Lemma and_True : forall P, (P ∧ True) = P.
+Proof.
+  intros.
+  ouPred.unseal.
+  destruct P.
+  apply IProp_eq; extensionality n x.
+  apply prop_ext.
+  unfold oupred.ouPred_holds; simpl.
+  tauto.
+Qed.
+
+Lemma True_or : forall P, (True ∨ P) = True.
+Proof.
+  intros.
+  ouPred.unseal.
+  apply IProp_eq; extensionality n x.
+  apply prop_ext.
+  unfold oupred.ouPred_holds; simpl.
+  tauto.
+Qed.
+
+Lemma or_True : forall P, (P ∨ True) = True.
+Proof.
+  intros.
+  ouPred.unseal.
+  destruct P.
+  apply IProp_eq; extensionality n x.
+  apply prop_ext.
+  unfold oupred.ouPred_holds; simpl.
+  tauto.
+Qed.
+
+Lemma pure_True : forall (P : Prop), P -> (bi_pure(PROP := ouPred M) P) = True.
+Proof.
+  intros.
+  f_equal.
+  apply prop_ext; tauto.
+Qed.
+
+Lemma prop_true_andp : forall (P : Prop) Q, P -> (⌜P⌝ ∧ Q) = Q.
+Proof.
+  intros.
+  rewrite pure_True // True_and //.
+Qed.
+
+Lemma False_and : forall P, (False ∧ P) = False.
+Proof.
+  intros.
+  ouPred.unseal.
+  apply IProp_eq; extensionality n x.
+  apply prop_ext.
+  unfold ouPred_holds.
+  tauto.
+Qed.
+
+Corollary prop_false_andp : forall (P : Prop) Q, ~P -> (⌜P⌝ ∧ Q) = False.
+Proof.
+  intros.
+  replace P with False%type; first apply False_and.
+  apply prop_ext; tauto.
+Qed.
+
+Lemma exp_comm : forall {B C} (P: B -> C -> ouPred M),
+  (∃ x : B, ∃ y : C, P x y) = ∃ y : C, ∃ x : B, P x y.
+Proof.
+  intros.
+  ouPred.unseal.
+  apply IProp_eq; extensionality n x.
+  apply prop_ext.
+  split; intros (a & b & ?); exists b, a; auto.
+Qed.
+
+Lemma exp_unit: forall (P: unit -> ouPred M),
+  (∃ x, P x) = P tt.
+Proof.
+  intros.
+  ouPred.unseal.
+  destruct (P tt) eqn: HP.
+  apply IProp_eq; extensionality n x.
+  apply prop_ext.
+  split.
+  + intros ([] & H); rewrite HP in H; auto.
+  + intros; exists tt; rewrite HP; auto.
+Qed.
+
+Lemma allp_unit: forall (P: unit -> ouPred M),
+  (∀ x, P x) = P tt.
+Proof.
+  intros.
+  ouPred.unseal.
+  destruct (P tt) eqn: HP.
+  apply IProp_eq; extensionality n x.
+  apply prop_ext.
+  split.
+  + intros H; specialize (H tt); rewrite HP in H; auto.
+  + intros ? []; rewrite HP; auto.
+Qed.
+
+Definition modus_ponens := @bi.impl_elim_r.
+
+Definition modus_ponens_wand := @bi.wand_elim_r.
+
+Lemma wand_sepcon_wand: forall (P1 P2 Q1 Q2 : ouPred M),
+  (P1 -∗ Q1) ∗ (P2 -∗ Q2) ⊢ P1 ∗ P2 -∗ Q1 ∗ Q2.
+Proof.
+  intros.
+  apply bi.wand_intro_r.
+  iIntros "((H1 & H2) & P1 & P2)"; iSplitL "H1 P1"; [iApply "H1" | iApply "H2"]; done.
+Qed.
+
+Lemma allp_forall: forall {B: Type} (P : B -> ouPred M) Q (x:B), (forall x:B, (P x ⊣⊢ Q)) -> ((∀ x, P x) ⊣⊢ Q).
+Proof.
+  intros.
+  apply bi.equiv_entails; split.
+  + rewrite (bi.forall_elim x) H //.
+  + apply bi.forall_intro.
+    intros.
+    rewrite H //.
+Qed.
+
+Lemma allp_uncurry: forall (S T: Type) (P: S -> T -> ouPred M),
+  (∀ x y, P x y) = ∀ st, P (fst st) (snd st).
+Proof.
+  intros.
+  ouPred.unseal.
+  apply IProp_eq; extensionality n x.
+  apply prop_ext.
+  split.
+  + intros ? (?, ?); apply H.
+  + intros ? s t; apply (H (s, t)).
+Qed.
+
+Lemma allp_depended_uncurry': forall {S: Type} {T: S -> Type} (P: forall s: S, T s -> ouPred M),
+  (∀ s: S, (∀ t: T s, P s t)) = ∀ st: sigT T, P (projT1 st) (projT2 st).
+Proof.
+  intros.
+  ouPred.unseal.
+  apply IProp_eq; extensionality n x.
+  apply prop_ext.
+  split.
+  + intros ? (?, ?); apply H.
+  + intros ? s t; apply (H (existT s t)).
+Qed.
+
+Lemma allp_curry: forall (S T: Type) (P: S * T -> ouPred M),
+  (∀ x, P x) = ∀ s t, P (s, t).
+Proof.
+  intros.
+  rewrite allp_uncurry; f_equal; extensionality x; destruct x; auto.
+Qed.
+
+Lemma exp_uncurry: forall A B (F : A -> B -> ouPred M),
+  (∃ a : A, ∃ b : B, F a b) = ∃ ab : A * B, F (fst ab) (snd ab).
+Proof.
+  intros.
+  ouPred.unseal.
+  apply IProp_eq; extensionality n x.
+  apply prop_ext.
+  split.
+  + intros (s & t & ?); exists (s, t); auto.
+  + intros ((s, t) & ?); exists s, t; auto.
+Qed.
+
+Lemma exp_trivial :
+  forall {T: Type} (any: T) P, (∃ x:T, P) = P.
+Proof.
+  intros.
+  ouPred.unseal.
+  destruct P; apply IProp_eq; extensionality n x.
+  apply prop_ext.
+  split; first intros (? & ?); eauto.
+Qed.
+
+Lemma allp_andp: forall {B: Type} (P Q: B -> ouPred M), (∀ x, P x ∧ Q x) = ((∀ x, P x) ∧ (∀ x, Q x)).
+Proof.
+  intros.
+  ouPred.unseal.
+  apply IProp_eq; extensionality n x; apply prop_ext.
+  split.
+  + intros H; split; intros ?; apply H.
+  + intros (? & ?) ?; split; auto.
+Qed.
+
+Lemma imp_right2: forall P Q, P ⊢ Q → P.
+Proof.
+  intros.
+  apply bi.impl_intro_r, bi.and_elim_l.
+Qed.
+
+Lemma later_left2: forall A B C : ouPred M, (A ∧ B ⊢ C) -> A ∧ ▷ B ⊢ ▷C.
+Proof.
+  intros.
+  rewrite -H bi.later_and; apply bi.and_mono; try done.
+  apply bi.later_intro.
+Qed.
+
+Lemma andp_dup: forall P, (P ∧ P) = P.
+Proof.
+  intros.
+  ouPred.unseal.
+  destruct P; apply IProp_eq; extensionality n x; apply prop_ext; tauto.
+Qed.
+
+Lemma persistently_and_sep_assoc :
+    forall P Q R, (<pers> P ∧ (Q ∗ R)) = ((<pers> P ∧ Q) ∗ R).
+Proof.
+  intros.
+  ouPred.unseal;   apply IProp_eq; extensionality n x.
+  apply prop_ext.
+  split.
+  - intros (? & a & b & ? & ? & ?).
+    eexists (a ⋅ core x), b; split.
+    { rewrite (ora_comm a) -{2}(ora_core_l x).
+      rewrite -assoc !(ora_comm (core x)); apply ora_orderN_op; auto. }
+    split; auto; split.
+    + unfold ouPred_persistently_def, ouPred_holds in *.
+      eapply ouPred_mono; eauto.
+      rewrite comm; etrans; last apply ora_order_orderN, uora_core_order_op.
+      rewrite ora_core_idemp //.
+    + eapply (ouPred_mono _ _ _ _ (a ⋅ ε)); eauto.
+      * rewrite right_id //.
+      * rewrite !(ora_comm a); eapply ora_orderN_op, ora_order_orderN, uora_unit_order_core.
+  - intros (a & ? & ? & (? & ?) & ?).
+    split.
+    + unfold ouPred_persistently_def, ouPred_holds in *.
+      eapply ouPred_mono; eauto.
+      etrans; last by apply ora_core_monoN.
+      edestruct (ora_pcore_order_op a) as (? & Hcore & ?).
+      { rewrite cmra_pcore_core //. }
+      rewrite cmra_pcore_core in Hcore; inversion Hcore as [?? Heq |]; subst.
+      rewrite Heq; by apply ora_order_orderN.
+    + eexists _, _; eauto.
+Qed.
+
+Lemma persistent_and_sep_assoc' :
+    forall {PROP : bi} (P Q R : PROP) {HP : Persistent Q} {HA : Absorbing Q}, P ∗ (Q ∧ R) ⊣⊢ Q ∧ (P ∗ R).
+Proof.
+  intros; rewrite comm -bi.persistent_and_sep_assoc bi.sep_comm //.
+Qed.
+
+Lemma sepcon_andp_prop :
+     forall P (Q:Prop) R, (P ∗ (⌜Q⌝ ∧ R)) = (⌜Q⌝ ∧ (P ∗ R)).
+Proof.
+  intros.
+  intros; ouPred.unseal.
+  apply IProp_eq; extensionality n x; apply prop_ext.
+  split.
+  - intros (? & ? & ? & ? & ? & ?); split; auto.
+    eexists _, _; eauto.
+  - intros (? & ? & ? & ? & ? & ?).
+    eexists _, _; split; eauto; split; auto; split; auto.
+Qed.
+
+Lemma sepcon_andp_prop' :
+     forall P (Q:Prop) R, ((⌜Q⌝ ∧ P) ∗ R) = (⌜Q⌝ ∧ (P ∗ R)).
+Proof.
+  intros.
+  intros; ouPred.unseal.
+  apply IProp_eq; extensionality n x; apply prop_ext.
+  split.
+  - intros (? & ? & ? & (? & ?) & ?); split; auto.
+    eexists _, _; eauto.
+  - intros (? & ? & ? & ? & ? & ?).
+    eexists _, _; split; eauto; split; auto; split; auto.
+Qed.
+
+Lemma wand_eq :
+   forall P Q R, (P ⊣⊢ Q ∗ R) -> P ⊣⊢ Q ∗ (Q -∗ P).
+Proof.
+  intros.
+  apply bi.equiv_entails; split; last apply modus_ponens_wand.
+  rewrite H; iIntros "($ & $)".
+  auto.
+Qed.
+
+Lemma forall_pred_ext: forall B (P Q: B -> ouPred M),
+ (∀ x : B, (P x ↔ Q x)) ⊢ (∀ x : B, P x) ↔ (∀ x: B, Q x).
+Proof.
+  intros; apply bi.and_intro; apply bi.impl_intro_r, bi.forall_intro; intros x; rewrite !(bi.forall_elim x);
+    rewrite /bi_iff; [rewrite (bi.and_elim_l (_ → _)) | rewrite (bi.and_elim_r (_ → _))]; apply bi.impl_elim_l.
+Qed.
+
+Lemma exists_pred_ext : forall B (P Q: B -> ouPred M),
+ (∀ x : B, (P x ↔ Q x)) ⊢ (∃ x : B, P x) ↔ (∃ x: B, Q x).
+Proof.
+  intros; apply bi.and_intro; apply bi.impl_intro_r; rewrite bi.and_exist_l; apply bi.exist_elim; intros x;
+    rewrite -(bi.exist_intro x) !(bi.forall_elim x);
+    rewrite /bi_iff; [rewrite (bi.and_elim_l (_ → _)) | rewrite (bi.and_elim_r (_ → _))]; apply bi.impl_elim_l.
+Qed.
+
+Lemma modus_ponens': forall P Q, P ∧ (P → Q) ⊢ Q ∧ P.
+Proof.
+  intros; apply bi.and_intro; [apply modus_ponens | apply bi.and_elim_l].
+Qed.
+
+Lemma imp_pred_ext: forall B B' P Q,
+       (B ↔ B') ∧ (B → (P ↔ Q)) ⊢ (B → P) ↔ (B' → Q).
+Proof.
+  intros; apply bi.and_intro; apply bi.impl_intro_r;
+  rewrite /bi_iff; [rewrite (bi.and_elim_r (_ → _)) (bi.and_elim_l (P → Q)) | rewrite (bi.and_elim_l (_ → _)) (bi.and_elim_r (P → Q))];
+    apply bi.impl_intro_l; rewrite !assoc modus_ponens'.
+  - rewrite (comm _ B) -!assoc (assoc _ B) modus_ponens' -assoc modus_ponens bi.impl_elim_l bi.and_elim_r //.
+  - rewrite -!assoc (assoc _ B) modus_ponens assoc (comm _ B') -assoc modus_ponens bi.impl_elim_l //.
+Qed.
+
+Lemma sep_comm : forall P Q, (P ∗ Q) = (Q ∗ P).
+Proof.
+  intros; ouPred.unseal; apply IProp_eq; extensionality n x; apply prop_ext.
+  split; intros (a & b & ? & ? & ?); exists b, a; repeat (split; auto); by rewrite comm.
+Qed.
+
+Lemma sep_assoc : forall P Q R, (P ∗ (Q ∗ R)) = ((P ∗ Q) ∗ R).
+Proof.
+  intros; ouPred.unseal; apply IProp_eq; extensionality n x; apply prop_ext.
+  split.
+  - intros (a & ? & ? & ? & b & c & ? & ? & ?).
+    exists (a ⋅ b), c; repeat (split; auto).
+    + rewrite -assoc.
+      etrans; last done.
+      rewrite !(ora_comm a); apply ora_orderN_op; auto.
+    + exists a, b; auto.
+  - intros (? & c & ? & (a & b & ? & ? & ?) & ?).
+    exists a, (b ⋅ c); repeat (split; auto).
+    + rewrite assoc.
+      etrans; last done.
+      apply ora_orderN_op; auto.
+    + exists b, c; auto.
+Qed.
+
+Lemma pull_right: forall P Q R, ((Q ∗ P) ∗ R) = ((Q ∗ R) ∗ P).
+Proof.
+  intros; rewrite -!sep_assoc (sep_comm _ P) //.
+Qed.
+
+Lemma pull_right0: forall P Q, (P ∗ Q) = (Q ∗ P).
+Proof.
+  exact sep_comm.
+Qed.
+
+Lemma prop_imp: forall (P: Prop) Q, P -> (⌜P⌝ → Q) ⊣⊢ Q.
+Proof.
+  intros.
+  rewrite bi.pure_True // bi.True_impl //.
+Qed.
+
+Lemma not_prop_right: forall P (Q: Prop), (Q -> P ⊢ False) -> P ⊢ ⌜not Q⌝.
+Proof.
+  intros.
+  rewrite -bi.pure_impl_2; apply bi.impl_intro_l, bi.pure_elim_l; done.
+Qed.
+
+Lemma later_prop_andp_sepcon: forall (P: Prop) (Q R : ouPred M),
+((▷ ⌜P⌝ ∧ Q) ∗ R) ⊣⊢ (▷ ⌜P⌝) ∧ (Q ∗ R).
+Proof.
+  intros.
+  rewrite bi.persistent_and_sep_assoc //.
+Qed.
+
+Lemma andp_prop_derives: forall (P P': Prop) Q Q',
+  (P <-> P') ->
+  (P -> Q ⊢ Q') ->
+  ⌜P⌝ ∧ Q ⊢ ⌜P'⌝ ∧ Q'.
+Proof.
+  intros.
+  rewrite -H; apply bi.pure_elim_l; intros; rewrite bi.pure_True // bi.True_and; auto.
+Qed.
+
+Lemma andp_prop_ext:
+ forall  (P P': Prop) Q Q',
+  (P<->P') ->
+  (P -> (Q ⊣⊢ Q')) ->
+  ⌜P⌝ ∧ Q ⊣⊢ ⌜P'⌝ ∧ Q'.
+Proof.
+  intros.
+  iSplit; iApply andp_prop_derives; auto; rewrite -?H; intros; rewrite H0 //.
+Qed.
+
+Lemma prop_and_same_derives :
+  forall (P: Prop) Q, (Q ⊢ ⌜P⌝) -> Q ⊢ ⌜P⌝ ∧ Q.
+Proof.
+  intros. apply bi.and_intro; auto.
+Qed.
+
+Lemma guarded_sepcon_orp_distr: forall (P1 P2: Prop) (p1 p2 q1 q2 : ouPred M),
+  (P1 -> P2 -> False) ->
+  (⌜P1⌝ ∧ p1 ∨ ⌜P2⌝ ∧ p2) ∗ (⌜P1⌝ ∧ q1 ∨ ⌜P2⌝ ∧ q2) ⊣⊢ ⌜P1⌝ ∧ (p1 ∗ q1) ∨ ⌜P2⌝ ∧ (p2 ∗ q2).
+Proof.
+  intros.
+  iSplit.
+  - iIntros "([(% & H1) | (% & H1)] & [(% & H2) | (% & H2)])"; try solve [exfalso; auto];
+      [iLeft | iRight]; iFrame; done.
+  - iIntros "[(% & H1 & H2) | (% & H1 & H2)]"; iSplitL "H1"; auto.
+Qed.
+
+Definition mark (i: nat) (j: ouPred M) := j.
+
+Lemma swap_mark1:
+  forall i j Pi Pj B, (i<j)%nat -> ((B ∗ mark i Pi) ∗ mark j Pj) = ((B ∗ mark j Pj) ∗ mark i Pi).
+Proof.
+  intros; apply pull_right.
+Qed.
+
+Lemma swap_mark0:
+  forall i j Pi Pj, (i<j)%nat -> (mark i Pi ∗ mark j Pj) = (mark j Pj ∗ mark i Pi).
+Proof.
+  intros; apply sep_comm.
+Qed.
+
+Ltac select_left n :=
+  repeat match goal with
+ | |- context [((_ ∗ mark ?i _) ∗ mark n _)%I] =>
+      rewrite (swap_mark1 i n); [ | solve [simpl; auto]]
+ | |- context [(mark ?i _ ∗ mark n _)%I] =>
+      rewrite (swap_mark0 i n); [ | solve [simpl; auto]]
+end.
+Ltac select_all n := match n with
+                                | O => idtac
+                                | S ?n' => select_left n; select_all n'
+                              end.
+Ltac markem n P :=
+   match P with
+   | (?Y ∗ ?Z)%I =>
+        (match goal with H: mark _ Z = Z |- _ => idtac end
+        || assert (mark n Z = Z) by auto); markem (S n) Y
+   | ?Z =>  match goal with H: mark _ Z = Z |- _ => idtac end
+                || assert (mark n Z = Z) by auto
+  end.
+
+Ltac prove_assoc_commut :=
+ clear;
+ try (match goal with |- ?F _ -> ?G _ => replace G with F; auto end);
+  (rewrite !sep_assoc;
+   match goal with |- ?P = _ => markem O P end;
+   let LEFT := fresh "LEFT" in match goal with |- ?P = _ => set (LEFT := P) end;
+  match goal with H: mark ?n _ = _ |- _ =>
+     repeat  match goal with H: mark ?n _ = ?P |- _ => rewrite <- H; clear H end;
+     select_all n;
+     reflexivity
+   end).
+
+Lemma test_prove_assoc_commut : forall A B C D E : ouPred M,
+   (D ∗ E ∗ A ∗ C ∗ B) = (A ∗ B ∗ C ∗ D ∗ E).
+Proof.
+  intros.
+  prove_assoc_commut.
+Qed.
+
+Lemma sep_emp : forall P, (P ∗ emp) = P.
+Proof.
+  intros; destruct P; ouPred.unseal; apply IProp_eq; extensionality n x; apply prop_ext.
+  split.
+  - intros (? & ? & ? & ? & ?).
+    eapply ouPred_mono; eauto.
+    etrans; last done.
+    etrans; last by rewrite !(ora_comm x0); apply ora_orderN_op.
+    rewrite left_id //.
+  - intros; exists x, ε; rewrite right_id; repeat split; auto.
+    unfold oupred.ouPred_holds.
+    reflexivity.
+Qed.
+
+Lemma emp_sep : forall P, (emp ∗ P) = P.
+Proof.
+  intros; rewrite sep_comm; apply sep_emp.
+Qed.
+
+Implicit Types (l : list (ouPred M)).
+
+(* use [∗ list] instead of this whenever possible *)
+Lemma sepcon_app:
+   forall l1 l2, fold_right bi_sep emp (l1 ++ l2) =
+  (fold_right bi_sep emp l1 ∗ fold_right bi_sep emp l2).
+Proof.
+  induction l1; simpl; intros.
+  - rewrite emp_sep //.
+  - rewrite IHl1 sep_assoc //.
+Qed.
+
+Lemma sepcon_rev:
+  forall l, fold_right bi_sep emp (rev l) = fold_right bi_sep emp l.
+Proof.
+  induction l; simpl; auto.
+  rewrite sepcon_app; simpl.
+  rewrite sep_emp IHl sep_comm //.
+Qed.
+
+Global Instance bi_inhabitant : Inhabitant (ouPred M) := bi_emp.
+
+Lemma extract_nth_sepcon : forall l i,
+    (0 <= i < Zlength l)%Z ->
+    fold_right bi_sep emp l = (Znth i l ∗ fold_right bi_sep emp (upd_Znth i l emp)).
+Proof.
+  intros.
+  erewrite <- sublist_same with (al := l) at 1; auto.
+  rewrite -> sublist_split with (mid := i); try lia.
+  rewrite (sublist_next i); try lia.
+  rewrite sepcon_app; simpl.
+  rewrite sep_assoc (sep_comm _ (Znth i l)).
+  unfold_upd_Znth_old; rewrite sepcon_app -sep_assoc; simpl.
+  rewrite emp_sep //.
+Qed.
+
+Lemma replace_nth_sepcon : forall P l i,
+    (0 <= i < Zlength l)%Z ->
+    (P ∗ fold_right bi_sep emp (upd_Znth i l emp)) =
+    fold_right bi_sep emp (upd_Znth i l P).
+Proof.
+  intros; unfold_upd_Znth_old.
+  rewrite !sepcon_app; simpl.
+  rewrite emp_sep !sep_assoc (sep_comm P) //.
+Qed.
+
+Lemma sepcon_derives_prop : forall P Q R, (P ⊢ ⌜R⌝) -> P ∗ Q ⊢ ⌜R⌝.
+Proof.
+  intros ??? ->; by iIntros "($ & _)".
+Qed.
+
+Lemma sepcon_map : forall {B} (P Q: B -> ouPred M) (l: list B),
+    fold_right bi_sep emp (map (fun x => P x ∗ Q x) l) =
+      (fold_right bi_sep emp (map P l) ∗ fold_right bi_sep emp (map Q l)).
+Proof.
+  induction l; simpl.
+  - rewrite sep_emp //.
+  - rewrite -!sep_assoc (sep_assoc (fold_right _ _ _) (Q a)) (sep_comm (fold_right _ _ _) (Q _)).
+    rewrite IHl -sep_assoc //.
+Qed.
+
+Lemma sepcon_list_derives : forall l1 l2 (Hlen : Zlength l1 = Zlength l2)
+  (Heq : forall i, (0 <= i < Zlength l1)%Z -> Znth i l1 ⊢ Znth i l2),
+  fold_right bi_sep emp l1 ⊢ fold_right bi_sep emp l2.
+Proof.
+  induction l1; destruct l2; auto; simpl; intros; rewrite -> ?Zlength_nil, ?Zlength_cons in *;
+    try (rewrite -> Zlength_correct in *; lia).
+  apply bi.sep_mono.
+  - specialize (Heq 0%Z); rewrite !Znth_0_cons in Heq; apply Heq.
+    rewrite Zlength_correct; lia.
+  - apply IHl1; [lia|].
+    intros; specialize (Heq (i + 1)%Z); rewrite -> !Znth_pos_cons, !Z.add_simpl_r in Heq by lia.
+    apply Heq; lia.
+Qed.
+
+Lemma sepcon_rotate : forall (lP: list (ouPred M)) m n,
+    (0 <= n - m < Zlength lP)%Z ->
+    fold_right bi_sep emp lP = fold_right bi_sep emp (sublist.rotate lP m n).
+Proof.
+  intros.
+  unfold sublist.rotate.
+  rewrite sepcon_app sep_comm -sepcon_app sublist_rejoin; [| lia..].
+  rewrite -> sublist_same by lia; auto.
+Qed.
+
+Lemma sepcon_In : forall  l P,
+    In P l -> exists Q, fold_right bi_sep emp l = (P ∗ Q).
+Proof.
+  induction l; [contradiction|].
+  intros ? [|]; simpl; subst; eauto.
+  destruct (IHl _ H) as [Q IH]; eexists; rewrite IH.
+  rewrite sep_comm -sep_assoc; eauto.
+Qed.
+
+Lemma extract_wand_sepcon : forall l P, In P l ->
+  fold_right bi_sep emp l ⊣⊢ P ∗ (P -∗ fold_right bi_sep emp l).
+Proof.
+  intros.
+  destruct (sepcon_In _ _ H) as [? ->].
+  eapply wand_eq; eauto.
+Qed.
+
+Global Instance fold_right_sep_proper : Proper (equiv ==> equiv) (fold_right bi_sep (bi_emp : ouPred M)).
+Proof.
+  intros l; induction l; simpl; intros ? H; inversion H as [| ???? H1 H2]; subst; clear H; auto.
+  rewrite H1 IHl /= //.
+Qed.
+
+Lemma wand_sepcon_map : forall {B} (R : B -> ouPred M) (l : list B) (P Q : B -> ouPred M)
+                          (HR : forall i, In i l -> R i ⊣⊢ P i ∗ Q i),
+    fold_right bi_sep emp (map R l) ⊣⊢ fold_right bi_sep emp (map P l) ∗
+    (fold_right bi_sep emp (map P l) -∗ fold_right bi_sep emp (map R l)).
+Proof.
+  intros; eapply wand_eq.
+  setoid_rewrite <- sepcon_map.
+  induction l; auto; simpl.
+  rewrite HR; simpl; auto.
+  f_equiv.
+  { reflexivity. }
+  apply IHl.
+  intros; apply HR; simpl; auto.
+Qed.
+
+Lemma and_comm : forall P Q, (P ∧ Q) = (Q ∧ P).
+Proof.
+  intros; ouPred.unseal; apply IProp_eq; extensionality n x; apply prop_ext; tauto.
+Qed.
+
+Lemma and_assoc : forall P Q R, (P ∧ (Q ∧ R)) = ((P ∧ Q) ∧ R).
+Proof.
+  intros; ouPred.unseal; apply IProp_eq; extensionality n x; apply prop_ext.
+  split.
+  - intros (? & ? & ?); repeat split; auto.
+  - intros ((? & ?) & ?); repeat split; auto.
+Qed.
+
+Lemma andp_assoc' : forall P Q R, (Q ∧ (P ∧ R)) = (P ∧ (Q ∧ R)).
+Proof. intros. rewrite and_comm -and_assoc (and_comm R) //. Qed.
+
+Lemma or_comm : forall P Q, (P ∨ Q) = (Q ∨ P).
+Proof.
+  intros; ouPred.unseal; apply IProp_eq; extensionality n x; apply prop_ext; tauto.
+Qed.
+
+Lemma or_assoc : forall P Q R, (P ∨ (Q ∨ R)) = ((P ∨ Q) ∨ R).
+Proof.
+  intros; ouPred.unseal; apply IProp_eq; extensionality n x; apply prop_ext.
+  unfold ouPred_or_def, ouPred_holds; simpl; intuition auto.
+Qed.
+
+Lemma and_False : forall P, (P ∧ False) = False.
+Proof.
+  intros; rewrite and_comm; apply False_and.
+Qed.
+
+Lemma False_or : forall P, (P ∨ False) = P.
+Proof.
+  intros; destruct P; ouPred.unseal; apply IProp_eq; extensionality n x; apply prop_ext.
+  unfold ouPred_pure_def, oupred.ouPred_holds; intuition auto.
+Qed.
+
+Lemma or_False : forall P, (False ∨ P) = P.
+Proof.
+  intros; rewrite or_comm; apply False_or.
+Qed.
+
+Lemma False_sep : forall P, (P ∗ False) = False.
+Proof.
+  intros; ouPred.unseal; apply IProp_eq; extensionality n x; apply prop_ext.
+  split.
+  - intros (? & ? & ? & ? & []).
+  - intros [].
+Qed.
+
+Lemma sep_False : forall P, (False ∗ P) = False.
+Proof.
+  intros; rewrite sep_comm False_sep //.
+Qed.
+
+Lemma sep_exist_l : forall A P (Q : A -> ouPred M), (P ∗ (∃ a, Q a)) = (∃ a, P ∗ Q a).
+Proof.
+  intros; ouPred.unseal; apply IProp_eq; extensionality n x; apply prop_ext.
+  split.
+  - intros (? & ? & ? & ? & ? & ?).
+    eexists _, _, _; eauto.
+  - intros (? & ? & ? & ? & ? & ?).
+    eexists _, _; split; eauto; split; auto; eexists; eauto.
+Qed.
+
+Lemma sep_exist_r : forall A P (Q : A -> ouPred M), ((∃ a, Q a) ∗ P) = (∃ a, Q a ∗ P).
+Proof.
+  intros; rewrite sep_comm sep_exist_l; f_equal; extensionality; rewrite sep_comm //.
+Qed.
+
+Lemma and_exist_l : forall A P (Q : A -> ouPred M), (P ∧ (∃ a, Q a)) = (∃ a, P ∧ Q a).
+Proof.
+  intros; ouPred.unseal; apply IProp_eq; extensionality n x; apply prop_ext.
+  split.
+  - intros (? & ? & ?).
+    eexists; split; eauto.
+  - intros (? & ? & ?).
+    split; auto; eexists; eauto.
+Qed.
+
+Lemma and_exist_r : forall A P (Q : A -> ouPred M), ((∃ a, Q a) ∧ P) = (∃ a, Q a ∧ P).
+Proof.
+  intros; rewrite and_comm and_exist_l; f_equal; extensionality; rewrite and_comm //.
+Qed.
+
+End pred.
+
+#[export] Hint Rewrite @False_sep @sep_False @True_and @and_True : norm.
+
+Ltac immediate := (assumption || reflexivity).
+
+#[export] Hint Rewrite @prop_true_andp using (solve [immediate]) : norm.
+
+#[export] Hint Rewrite @pure_True using (solve [immediate]) : norm.
+
+#[export] Hint Rewrite @andp_dup : norm.
+
+#[export] Hint Rewrite @sep_emp @emp_sep @True_and @and_True
+             @sep_exist_l @sep_exist_r
+               @and_exist_l @and_exist_r
+         @sepcon_andp_prop @sepcon_andp_prop'
+     using (solve [auto with typeclass_instances])
+        : norm.
+
+Ltac pull_left A := repeat (rewrite <- (pull_right A) || rewrite <- (pull_right0 A)).
+
+Ltac pull_right A := repeat (rewrite (pull_right A) || rewrite (pull_right0 A)).
+
+Ltac normalize1 :=
+         match goal with
+            | |- _ => contradiction
+            | |- bi_entails(PROP := monPredI _ _) _ _ => let rho := fresh "rho" in split => rho; monPred.unseal
+(*            | |- context [((?P ∧ ?Q) ∗ ?R)%I] => rewrite <- (bi.persistent_and_sep_assoc P Q R) by (auto with norm)
+            | |- context [(?Q ∗ (?P ∧ ?R))%I] => rewrite -> (persistent_and_sep_assoc' P Q R) by (auto with norm)
+            | |- context [((?Q ∧ ?P) ∗ ?R)%I] => rewrite <- (bi.persistent_and_sep_assoc P Q R) by (auto with norm)
+            | |- context [(?Q ∗ (?R ∧ ?P))%I] => rewrite -> (persistent_and_sep_assoc' P Q R) by (auto with norm)*)
+            (* In the next four rules, doing it this way (instead of leaving it to autorewrite)
+                preserves the name of the "y" variable *)
+            | |- context [((∃ y, _) ∧ _)%I] =>
+                autorewrite with norm; apply bi.exist_elim; intro y
+            | |- context [(_ ∧ ∃ y , _)%I] =>
+                autorewrite with norm; apply bi.exist_elim; intro y
+            | |- context [((∃ y, _) ∗ _)%I] =>
+               autorewrite with norm; apply bi.exist_elim; intro y
+            | |- context [(_ ∗ ∃ y , _)%I] =>
+                autorewrite with norm; apply bi.exist_elim; intro y
+
+           | |-  bi_entails ?A   _ => match A with
+                          | context [ ((⌜?P⌝ ∧ ?Q) ∧ ?R)%I ] => rewrite -(bi.and_assoc (⌜P⌝%I) Q R)
+                          | context [ (?Q ∧ (⌜?P⌝ ∧ ?R))%I ] =>
+                                         match Q with ⌜_⌝%I => fail 2 | _ => rewrite (andp_assoc' (⌜P⌝%I) Q R) end
+                         end
+            | |- _ => progress  (autorewrite with norm); auto with typeclass_instances
+            | |- _ = ?x -> _ => intro; subst x
+            | |- ?x = _ -> _ => intro; subst x
+            |  |- ?ZZ -> _ => match type of ZZ with
+                                               | Prop =>
+                                                    let H := fresh in
+                                                       ((assert (H:ZZ) by auto; clear H; intros _) || intro H)
+                                               | _ => intros _
+                                              end
+            | |- forall _, _ => let x := fresh "x" in (intro x; normalize1; try generalize dependent x)
+            | |- bi_exist _ ⊢ _ => apply bi.exist_elim
+            | |- ⌜_⌝ ⊢ _ => apply bi.pure_elim'
+            | |- ⌜_⌝ ∧ _ ⊢ _ => apply bi.pure_elim_l
+            | |- _ ∧ ⌜_⌝ ⊢ _ => apply bi.pure_elim_r
+            | |- _ ⊢ ⌜?x = ?y⌝ ∧ _ =>
+                            (rewrite -> prop_true_andp with (P:= (x=y))
+                                            by (unfold y; reflexivity); unfold y in *; clear y) ||
+                            (rewrite -> prop_true_andp with (P:=(x=y))
+                                            by (unfold x; reflexivity); unfold x in *; clear x)
+            | |- True ⊢ ⌜_⌝ => apply bi.pure_intro
+            | |- _ => solve [auto with typeclass_instances]
+            end.
+
+Ltac normalize1_in Hx :=
+             match type of Hx with
+(*                 | context [@andp ?A (@LiftNatDed ?T ?B ?C) ?D ?E ?F] =>
+                         change (@andp A (@LiftNatDed T B C) D E F) with (D F ∧ E F)
+                 | context [@later ?A  (@LiftNatDed ?T ?B ?C) (@LiftIndir ?X1 ?X2 ?X3 ?X4 ?X5) ?D ?F] =>
+                    change (@later A  (@LiftNatDed T B C) (@LiftIndir X1 X2 X3 X4 X5) D F)
+                     with (@later B C X5 (D F))
+                 | context [@sepcon ?A (@LiftNatDed ?B ?C ?D)
+                                                         (@LiftSepLog ?E ?F ?G ?H) ?J ?K ?L] =>
+                   change (@sepcon A (@LiftNatDed B C D) (@LiftSepLog E F G H) J K L)
+                      with (@sepcon C D H (J L) (K L))*)
+                | bi_entails(PROP := monPredI _ _) _ _ => let Hx' := fresh "Hx" in inversion Hx as [Hx']; revert Hx'; monPred.unseal; intros Hx'
+                | context [ ⌜?P⌝%I ] =>
+                                    rewrite -> (bi.pure_True P) in Hx by auto with typeclass_instances
+                | context [ (⌜?P⌝ ∧ ?Q)%I ] =>
+                                    rewrite -> (prop_true_andp P Q) in Hx by auto with typeclass_instances
+                | context [((?P ∧ ?Q) ∗ ?R)%I] => rewrite <- (bi.persistent_and_sep_assoc P Q R) in Hx by (auto with norm)
+                | context [(?Q ∗ (?P ∧ ?R))%I] => rewrite -> (persistent_and_sep_assoc' P Q R) in Hx by (auto with norm)
+                | context [((?Q ∧ ?P) ∗ ?R)%I] => rewrite <- (bi.persistent_and_sep_assoc P Q R) in Hx by (auto with norm)
+                | context [(?Q ∗ (?R ∧ ?P))%I] => rewrite -> (persistent_and_sep_assoc' P Q R) in Hx by (auto with norm)
+                | _ => progress  (autorewrite with norm in Hx); auto with typeclass_instances
+                end.
+
+Ltac normalize := repeat (auto with norm; normalize1).
+
+Tactic Notation "normalize" "in" hyp(H) := repeat (normalize1_in H).
diff --git a/veric/mapsto_memory_block.v b/veric/mapsto_memory_block.v
index 67b7c34fb0..d52fec7113 100644
--- a/veric/mapsto_memory_block.v
+++ b/veric/mapsto_memory_block.v
@@ -1,31 +1,21 @@
-Require Import VST.msl.log_normalize.
-Require Import VST.msl.alg_seplog.
 Require Import VST.veric.base.
-Require Import VST.veric.compcert_rmaps.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.res_predicates.
-
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
+Require Import VST.veric.juicy_mem.
+Require Import VST.veric.assert_lemmas.
 Require Import compcert.cfrontend.Ctypes.
 Require Import VST.veric.address_conflict.
 Require Import VST.veric.val_lemmas.
 Require Import VST.veric.Cop2.
 Require Import VST.veric.shares.
 Require Import VST.veric.slice.
-
 Require Import VST.veric.mpred.
+Require Import VST.veric.log_normalize.
 
-(*Lenb: moved to mpred
-Definition assert := environ -> mpred.  (* Unfortunately
-   can't export this abbreviation through SeparationLogic.v because
-  it confuses the Lift system *)
-*)
+Section mpred.
 
-Lemma address_mapsto_exists:
-  forall ch v sh (rsh: readable_share sh) loc w0
-      (RESERVE: forall l', adr_range loc (size_chunk ch) l' -> w0 @ l' = NO Share.bot bot_unreadable),
-      (align_chunk ch | snd loc) ->
-      exists w, address_mapsto ch (decode_val ch (encode_val ch v)) sh loc w 
-                    /\ core w = core w0.
-Proof.  exact address_mapsto_exists. Qed.
+Context `{!heapGS Σ}.
 
 Definition permission_block (sh: Share.t)  (v: val) (t: type) : mpred :=
     match access_mode t with
@@ -34,13 +24,11 @@ Definition permission_block (sh: Share.t)  (v: val) (t: type) : mpred :=
             | Vptr b ofs =>
                  nonlock_permission_bytes sh (b, Ptrofs.unsigned ofs)
                        (size_chunk ch)
-            | _ => FF
+            | _ => False
             end
-         | _ => FF
+         | _ => False
          end.
 
-Local Open Scope pred.
-
 Definition mapsto (sh: Share.t) (t: type) (v1 v2 : val): mpred :=
   match access_mode t with
   | By_value ch =>
@@ -49,23 +37,23 @@ Definition mapsto (sh: Share.t) (t: type) (v1 v2 : val): mpred :=
     match v1 with
      | Vptr b ofs =>
        if readable_share_dec sh
-       then (!!tc_val t v2 &&
-             address_mapsto ch v2 sh (b, Ptrofs.unsigned ofs)) ||
-            (!! (v2 = Vundef) &&
-             EX v2':val, address_mapsto ch v2' sh (b, Ptrofs.unsigned ofs))
-       else !! (tc_val' t v2 /\ (align_chunk ch | Ptrofs.unsigned ofs)) && nonlock_permission_bytes sh (b, Ptrofs.unsigned ofs) (size_chunk ch)
-     | _ => FF
+       then (⌜tc_val t v2⌝ ∧
+             address_mapsto ch v2 sh (b, Ptrofs.unsigned ofs)) ∨
+            (⌜v2 = Vundef⌝ ∧
+             ∃ v2':val, address_mapsto ch v2' sh (b, Ptrofs.unsigned ofs))
+       else ⌜tc_val' t v2 /\ (align_chunk ch | Ptrofs.unsigned ofs)⌝ ∧ nonlock_permission_bytes sh (b, Ptrofs.unsigned ofs) (size_chunk ch)
+     | _ => False
     end
-    | _ => FF
+    | _ => False
     end
-  | _ => FF
+  | _ => False
   end.
 
 Definition mapsto_ sh t v1 := mapsto sh t v1 Vundef.
 
-Lemma address_mapsto_readable:
-  forall m v sh a, address_mapsto m v sh a |-- 
-           !! readable_share sh.
+(*Lemma address_mapsto_readable:
+  forall m v sh a, address_mapsto m v sh a ⊢ 
+           ⌜readable_share sh⌝.
 Proof.
 intros.
 unfold address_mapsto.
@@ -78,9 +66,9 @@ rewrite if_true in H2.
 destruct H2 as [rsh ?]. auto.
 destruct a; split; auto.
 clear; pose proof (size_chunk_pos m); lia.
-Qed.
+Qed.*)
 
-Lemma mapsto_tc_val': forall sh t p v, mapsto sh t p v |-- !! tc_val' t v.
+Lemma mapsto_tc_val': forall sh t p v, mapsto sh t p v ⊢ ⌜tc_val' t v⌝.
 Proof.
   intros.
   unfold mapsto.
@@ -88,29 +76,24 @@ Proof.
   if_tac; auto;
   destruct p; auto;
   try simple_if_tac; auto.
-  + apply orp_left; apply andp_left1.
-    - intros ?; simpl.
-      apply tc_val_tc_val'.
-    - intros ? ?; simpl in *; subst.
-      apply tc_val'_Vundef.
-  + apply andp_left1.
-    intros ?; simpl; tauto.
+  + iIntros "[[% H] | [-> H]]"; iPureIntro.
+    - apply tc_val_tc_val'; auto.
+    - apply tc_val'_Vundef.
+  + iIntros "[[$ _] _]".
 Qed.
 
 Lemma mapsto_value_range:
- forall sh v sz sgn i,
-   readable_share sh ->
-   mapsto sh (Tint sz sgn noattr) v (Vint i) =
-    !! int_range sz sgn i && mapsto sh (Tint sz sgn noattr) v (Vint i).
+ forall sh v sz sgn i
+   (Hsh : readable_share sh),
+   mapsto sh (Tint sz sgn noattr) v (Vint i) ⊢
+    ⌜int_range sz sgn i⌝.
 Proof.
 intros.
-rename H into Hsh.
-assert (GG: forall a b, (a || !!(Vint i = Vundef) && b) = a). {
-intros. apply pred_ext; intros ? ?. hnf in H.
-destruct H; auto; hnf in H; destruct H; discriminate.
-left; auto.
-}
-apply pred_ext; [ | apply andp_left2; auto].
+rewrite mapsto_tc_val'; iIntros "%"; iPureIntro.
+hnf in H.
+spec H; first done.
+simpl in H.
+unfold int_range.
 assert (MAX: Int.max_signed = 2147483648 - 1) by reflexivity.
 assert (MIN: Int.min_signed = -2147483648) by reflexivity.
 assert (Byte.min_signed = -128) by reflexivity.
@@ -119,264 +102,90 @@ assert (Byte.max_unsigned = 256-1) by reflexivity.
 destruct (Int.unsigned_range i).
 assert (Int.modulus = Int.max_unsigned + 1) by reflexivity.
 assert (Int.modulus = 4294967296) by reflexivity.
-apply andp_right; auto.
-unfold mapsto; intros.
-replace (type_is_volatile (Tint sz sgn noattr)) with false
-  by (destruct sz,sgn; reflexivity).
-simpl.
-destruct (readable_share_dec sh); [| tauto].
-destruct sz, sgn, v; (try rewrite FF_and; auto);
- repeat rewrite GG;
- apply prop_andp_left; intros ? ? _; hnf; try lia.
- pose proof (Int.signed_range i); lia.
- destruct H6; subst;
-  try rewrite Int.unsigned_zero; try rewrite Int.unsigned_one; lia.
- destruct H6; subst;
-  try rewrite Int.unsigned_zero; try rewrite Int.unsigned_one; lia.
+destruct sz, sgn; auto; try lia.
+- split; [etrans | eapply Z.le_lt_trans]; try apply H; try lia; try by compute.
+- split; try lia.
+  eapply Z.le_lt_trans; [apply H | by compute].
+- pose proof (Int.signed_range i); lia.
+- destruct H; subst; by compute.
+- destruct H; subst; by compute.
 Qed.
 
-Definition writable_block (id: ident) (n: Z): assert :=
+Definition writable_block (id: ident) (n: Z): environ -> mpred :=
    fun rho => 
-        EX b: block,  EX sh: Share.t,
-          !! (writable_share sh /\ ge_of rho id = Some b) && VALspec_range n sh (b, 0).
+        ∃ b: block,  ∃ sh: Share.t,
+          ⌜writable_share sh /\ ge_of rho id = Some b⌝ ∧ VALspec_range n sh (b, 0).
 
-Fixpoint writable_blocks (bl : list (ident*Z)) : assert :=
+Fixpoint writable_blocks (bl : list (ident*Z)) : environ -> mpred :=
  match bl with
   | nil =>  fun rho => emp
-  | (b,n)::bl' =>  fun rho => writable_block b n rho * writable_blocks bl' rho
+  | (b,n)::bl' =>  fun rho => writable_block b n rho ∗ writable_blocks bl' rho
  end.
 
 Fixpoint address_mapsto_zeros (sh: share) (n: nat) (adr: address) : mpred :=
  match n with
  | O => emp
  | S n' => address_mapsto Mint8unsigned (Vint Int.zero) sh adr 
-               * address_mapsto_zeros sh n' (fst adr, Z.succ (snd adr))
+               ∗ address_mapsto_zeros sh n' (fst adr, Z.succ (snd adr))
 end.
 
 Definition address_mapsto_zeros' (n: Z) : spec :=
-     fun (sh: Share.t) (l: address) =>
-          allp (jam (adr_range_dec l (Z.max n 0))
-                                  (fun l' => yesat NoneP (VAL (Byte Byte.zero)) sh l')
-                                  noat).
+     fun (sh: Share.t) (l: address) => [∗ list] i ∈ seq 0 (Z.to_nat n), adr_add l (Z.of_nat i) ↦{#sh} VAL (Byte Byte.zero).
 
 Lemma address_mapsto_zeros_eq:
-  forall sh n,
-   address_mapsto_zeros sh n =
-   address_mapsto_zeros' (Z_of_nat n) sh.
+  forall sh n l,
+   address_mapsto_zeros sh n l ⊣⊢
+   address_mapsto_zeros' (Z_of_nat n) sh l.
 Proof.
   induction n;
-  extensionality adr; destruct adr as [b i].
+  destruct l as [b i].
   * (* base case *)
-    simpl.
-    unfold address_mapsto_zeros'.
-    rewrite emp_no.
-    f_equal; extensionality l; destruct l as (b', i').
-    apply pred_ext.
-    intros w ?.
-    hnf.
-    rewrite if_false; auto.
-    intros [? ?]. unfold Z.max in H1;  simpl in H1. lia.
-    intros w ?.
-    hnf in H.
-    rewrite if_false in H. apply H.
-    clear; intros [? ?]. unfold Z.max in H0; simpl in H0. lia.
+    reflexivity.
   * (* inductive case *)
-    rewrite inj_S.
-    simpl.
-    rewrite IHn; clear IHn.
-    apply pred_ext; intros w ?.
-    - (* forward case *)
-      destruct H as [w1 [w2 [? [? ?]]]].
-      intros [b' i'].
-      hnf.
-      if_tac.
-      + destruct H0 as [bl [[? [? ?]] ?]].
-        specialize (H5 (b',i')).
-        hnf in H5.
-        if_tac in H5.
-       ** destruct H5 as [p ?]; exists p.
-          hnf in H5.
-          specialize (H1 (b',i')). hnf in H1. rewrite if_false in H1.
-          assert (LEV := join_level _ _ _ H).
-          {
-            apply (resource_at_join _ _ _ (b',i')) in H.
-            apply join_comm in H; apply H1 in H.
-            rewrite H in H5.
-            hnf. rewrite H5. f_equal.
-            f_equal.
-            simpl. destruct H6. simpl in H7. replace (i'-i) with 0 by lia.
-            unfold size_chunk_nat in H0. simpl in H0.
-            unfold nat_of_P in H0. simpl in H0.
-            destruct bl; try solve [inv H0].
-            destruct bl; inv H0.
-            simpl.
-            clear - H3.
-            (* TODO: Clean up the following proof. *)
-            destruct m; try solve [inv H3].
-            rewrite decode_byte_val in H3.
-            f_equal.
-            assert (Int.zero_ext 8 (Int.repr (Byte.unsigned i)) = Int.repr 0) by
-              (forget (Int.zero_ext 8 (Int.repr (Byte.unsigned i))) as j; inv H3; auto).
-            clear H3.
-            assert (Int.unsigned (Int.zero_ext 8 (Int.repr (Byte.unsigned i))) =
-                Int.unsigned Int.zero) by (f_equal; auto).
-            rewrite Int.unsigned_zero in H0.
-            clear H.
-            rewrite Int.zero_ext_mod in H0 by (compute; split; congruence).
-            rewrite Int.unsigned_repr in H0.
-            rewrite Zdiv.Zmod_small in H0.
-            assert (Byte.repr (Byte.unsigned i) = Byte.zero).
-            apply f_equal; auto.
-            rewrite Byte.repr_unsigned in H. auto.
-            apply Byte.unsigned_range.
-            clear.
-            pose proof (Byte.unsigned_range i).
-            destruct H; split; auto.
-            apply Z.le_trans with Byte.modulus.
-            lia.
-            clear.
-            compute; congruence.
-          }
-          destruct H2.
-          intros [? ?].
-          destruct H6.
-          clear - H7 H9 H10. simpl in H10. lia.
-       ** assert (LEV := join_level _ _ _ H).
-          apply (resource_at_join _ _ _ (b',i')) in H.
-          apply H5 in H.
-          specialize (H1 (b',i')).
-          hnf in H1.
-          if_tac in H1.
-         -- destruct H1 as [p ?]; exists p.
-            hnf in H1|-*.
-            rewrite H in H1; rewrite H1.
-            f_equal.
-         -- contradiction H6.
-            destruct H2.
-            split; auto.
-            simpl.
-            subst b'.
-            clear - H7 H8.
-            assert (~ (Z.succ i <= i' < (Z.succ i + Z.max (Z_of_nat n) 0))).
-            contradict H7; split; auto.
-            clear H7.
-            replace (Z.max (Z.succ (Z_of_nat n)) 0) with (Z.succ (Z_of_nat n)) in H8.
-            replace (Z.max (Z_of_nat n) 0) with (Z_of_nat n) in H.
-            lia.
-            symmetry; apply Zmax_left.
-            apply Z_of_nat_ge_O.
-            symmetry; apply Zmax_left.
-            clear.
-            pose proof (Z_of_nat_ge_O n). lia. 
-      + apply (resource_at_join _ _ _ (b',i')) in H.
-        destruct H0 as [bl [[? [? ?]] ?]].
-        specialize (H5 (b',i')); specialize (H1 (b',i')).
-        hnf in H1,H5.
-        rewrite if_false in H5.
-        rewrite if_false in H1.
-       ** apply H5 in H.
-          simpl in H1|-*.
-          rewrite <- H; auto.
-       ** clear - H2; contradict H2.
-          destruct H2; split; auto.
-          destruct H0.
-          lia.
-       ** clear - H2; contradict H2; simpl in H2.
-          destruct H2; split; auto. lia.
-    - (* backward direction *)
-      assert (H0 := H (b,i)).
-      hnf in H0.
-      rewrite if_true in H0
-        by (split; auto; pose proof (Z_of_nat_ge_O n); rewrite Zmax_left; lia).
-      destruct H0 as [H0 H1].
-      pose proof I.
-      destruct (make_rmap  (fun loc => if eq_dec loc (b,i) then 
-       YES sh H0 (VAL (Byte Byte.zero)) NoneP
-          else core (w @ loc)) (core (ghost_of w)) (level w)) as [w1 [? ?]].
-      extensionality loc. unfold compose.
-      if_tac; [unfold resource_fmap; f_equal; apply preds_fmap_NoneP
-           | apply resource_fmap_core].
-      { apply ghost_fmap_core. }
-      pose proof I.
-      destruct (make_rmap (fun loc => if adr_range_dec (b, Z.succ i) (Z.max (Z.of_nat n) 0) loc
-                       then YES sh H0 (VAL (Byte Byte.zero)) NoneP
-          else core (w @ loc)) (ghost_of w) (level w)) as [w2 [? ?]].
-      extensionality loc. unfold compose.
-      if_tac; [unfold resource_fmap; f_equal; apply preds_fmap_NoneP
-           | apply resource_fmap_core].
-      { apply ghost_of_approx. }
-      exists w1; exists w2; split3; auto.
-+apply resource_at_join2; try congruence.
-  intro loc; destruct H4; rewrite H4; destruct H7; rewrite H7.
- clear - H.
- specialize (H loc).  unfold jam in H. hnf in H.
- rewrite Zmax_left by (pose proof (Z_of_nat_ge_O n); lia).
- rewrite Zmax_left in H by (pose proof (Z_of_nat_ge_O n); lia).
- if_tac. rewrite if_false.
- subst. rewrite if_true in H.
-  destruct H as [H' H]; rewrite H. rewrite core_YES.
- rewrite preds_fmap_NoneP.
- apply join_unit2.
- constructor. auto.
- apply YES_ext; auto.
- split; auto; lia.
- subst. intros [? ?]; lia.
- if_tac in H.
- rewrite if_true.
- destruct H as [H' H]; rewrite H; clear H. rewrite core_YES.
- rewrite preds_fmap_NoneP.
- apply join_unit1.
- constructor; auto.
- apply YES_ext; auto.
- destruct loc;
- destruct H2; split; auto.
- assert (z<>i) by congruence.
- lia.
- rewrite if_false.
- unfold noat in H. simpl in H.
- apply join_unit1; [apply core_unit | ].
- clear - H.
- apply H. apply join_unit2. apply core_unit. auto.
- destruct loc. intros [? ?]; subst. apply H2; split; auto; lia.
- destruct H4 as [_ ->], H7 as [_ ->].
- apply core_unit.
-+ exists (Byte Byte.zero :: nil); split.
- split. reflexivity. split.
- unfold decode_val. simpl. apply f_equal.
- unfold decode_int, rev_if_be.
- rewrite Tauto.if_same; reflexivity.
- apply Z.divide_1_l.
- intro loc. hnf. if_tac. exists H0.
- destruct loc as [b' i']. destruct H8; subst b'.
- simpl in H9. assert (i=i') by lia; subst i'.
- rewrite Zminus_diag. hnf. rewrite preds_fmap_NoneP.
-  destruct H4; rewrite H4. rewrite if_true by auto. f_equal.
- unfold noat. simpl. destruct H4; rewrite H4. rewrite if_false. apply core_identity.
-  contradict H8. subst. split; auto. simpl; lia.
-+ intro loc. hnf.
- if_tac. exists H0. hnf. destruct H7; rewrite H7.
- rewrite if_true by auto. rewrite preds_fmap_NoneP. auto.
- unfold noat. simpl. destruct H7; rewrite H7.
- rewrite if_false by auto. apply core_identity.
+    rewrite /= IHn /address_mapsto_zeros' !Nat2Z.id -cons_seq /= -seq_shift big_sepL_fmap.
+    apply bi.sep_proper.
+    - rewrite /address_mapsto /=.
+      iSplit.
+      + iIntros "H"; iDestruct "H" as ([| ? [|]] (? & Hz & ?)) "H"; simpl in *; try discriminate.
+        replace m with (Byte Byte.zero); first by iDestruct "H" as "[$ _]".
+        rewrite /decode_val /= in Hz.
+        destruct m; try discriminate.
+        f_equal; apply Byte.same_if_eq.
+        assert (0 ≤ Byte.unsigned i0 ≤ Int.max_unsigned).
+        { pose proof (Byte.unsigned_range i0) as Hi; split; try apply Hi.
+          etrans; [apply Z.lt_le_incl, Hi | by compute]. }
+        rewrite /decode_int rev_if_be_1 /= Z.add_0_r zero_ext_inrange in Hz.
+        unfold Byte.eq; rewrite if_true; auto.
+        { assert (Int.unsigned (Int.repr (Byte.unsigned i0)) = Int.unsigned Int.zero) as Heq by congruence.
+          rewrite !Int.unsigned_repr in Heq; auto.
+          by compute. }
+        { rewrite Int.unsigned_repr; auto.
+          etrans; [apply Byte.unsigned_range_2 | by compute]. }
+      + iIntros "H"; iExists [Byte Byte.zero]; simpl; iFrame.
+        iPureIntro; repeat split; auto.
+        apply Z.divide_1_l.
+    - apply big_sepL_proper; intros.
+      rewrite /adr_add /= Nat2Z.inj_succ.
+      by replace (Z.succ i + Z.of_nat y) with (i + Z.succ (Z.of_nat y)) by lia.
 Qed.
 
 Definition mapsto_zeros (n: Z) (sh: share) (a: val) : mpred :=
  match a with
   | Vptr b z => 
-    !! (0 <= Ptrofs.unsigned z  /\ n + Ptrofs.unsigned z < Ptrofs.modulus)%Z &&
+    ⌜0 <= Ptrofs.unsigned z  /\ n + Ptrofs.unsigned z < Ptrofs.modulus⌝ ∧
     address_mapsto_zeros sh (Z.to_nat n) (b, Ptrofs.unsigned z)
-  | _ => FF
+  | _ => False
   end.
 
 Fixpoint memory_block' (sh: share) (n: nat) (b: block) (i: Z) : mpred :=
   match n with
   | O => emp
   | S n' => mapsto_ sh (Tint I8 Unsigned noattr) (Vptr b (Ptrofs.repr i))
-         * memory_block' sh n' b (i+1)
+         ∗ memory_block' sh n' b (i+1)
  end.
 
 Definition memory_block'_alt (sh: share) (n: nat) (b: block) (ofs: Z) : mpred :=
- if readable_share_dec sh 
+ if readable_share_dec sh
  then VALspec_range (Z_of_nat n) sh (b, ofs)
  else nonlock_permission_bytes sh (b,ofs) (Z.of_nat n).
 
@@ -384,136 +193,83 @@ Lemma memory_block'_eq:
  forall sh n b i,
   0 <= i ->
   Z_of_nat n + i < Ptrofs.modulus ->
-  memory_block' sh n b i = memory_block'_alt sh n b i.
+  memory_block' sh n b i ⊣⊢ memory_block'_alt sh n b i.
 Proof.
   intros.
   unfold memory_block'_alt.
   revert i H H0; induction n; intros.
-  + unfold memory_block'.
-    simpl.
-    rewrite VALspec_range_0, nonlock_permission_bytes_0.
-    if_tac; auto.
+  + if_tac; reflexivity.
   + unfold memory_block'; fold memory_block'.
-    rewrite (IHn (i+1)) by (rewrite inj_S in H0; lia).
-    symmetry.
-    rewrite (VALspec_range_split2 1 (Z_of_nat n)) by (try rewrite inj_S; lia).
-    rewrite VALspec1.
+    rewrite -> (IHn (i+1)) by (rewrite inj_S in H0; lia).
     unfold mapsto_, mapsto.
     simpl access_mode. cbv beta iota.
     change (type_is_volatile (Tint I8 Unsigned noattr)) with false. cbv beta iota.
-    destruct (readable_share_dec sh).
-    - f_equal.
+    if_tac.
+    - rewrite -> (VALspec_range_split2 1 (Z_of_nat n) (Z.of_nat (S n))) by (try rewrite inj_S; lia).
+      rewrite VALspec1.
+      apply bi.sep_proper; last done.
       assert (i < Ptrofs.modulus) by (rewrite Nat2Z.inj_succ in H0; lia).
-      rewrite Ptrofs.unsigned_repr by (unfold Ptrofs.max_unsigned; lia); clear H1.
-      forget (Share.unrel Share.Lsh sh) as rsh.
-      forget (Share.unrel Share.Rsh sh) as sh'.
+      rewrite -> Ptrofs.unsigned_repr by (unfold Ptrofs.max_unsigned; lia); clear H1.
       clear.
-
-      assert (EQ: forall loc, jam (adr_range_dec loc (size_chunk Mint8unsigned)) = jam (eq_dec loc)).
-      intros [b' z']; unfold jam; extensionality P Q loc;
-       destruct loc as [b'' z'']; apply exist_ext; extensionality w;
-       if_tac; [rewrite if_true | rewrite if_false]; auto;
-        [destruct H; subst; f_equal;  simpl in H0; lia
-        | contradict H; inv H; split; simpl; auto; lia].
-      apply pred_ext.
-      * intros w ?.
-        right; split; hnf; auto.
-        assert (H':= H (b,i)).
-        hnf in H'. rewrite if_true in H' by auto.
-        destruct H' as [v H'].
-        pose (l := v::nil).
-        destruct v; [exists Vundef | exists (Vint (Int.zero_ext 8 (Int.repr (Byte.unsigned i0)))) | exists Vundef];
-        exists l; (split; [ split3; [reflexivity |unfold l; (reflexivity || apply decode_byte_val) |  apply Z.divide_1_l ] | ]);
-          rewrite EQ; intro loc; specialize (H loc);
-         hnf in H|-*; if_tac; auto; subst loc; rewrite Zminus_diag;
-         unfold l; simpl nth; auto.
-      * apply orp_left.
-        apply andp_left2.
-        { intros w [l [[? [? ?]] ?]].
-          intros [b' i']; specialize (H2 (b',i')); rewrite EQ in H2;
-            hnf in H2|-*;  if_tac; auto. symmetry in H3; inv H3.
-          destruct l; inv H. exists m.
-          destruct H2 as [H2' H2]; exists H2'; hnf in H2|-*; rewrite H2.
-          f_equal. f_equal. rewrite Zminus_diag. reflexivity.
-        }
-        { rewrite prop_true_andp by auto.
-          intros w [v2' [l [[? [? ?]] ?]]].
-          intros [b' i']; specialize (H2 (b',i')); rewrite EQ in H2;
-            hnf in H2|-*;  if_tac; auto. symmetry in H3; inv H3.
-          destruct l; inv H. exists m.
-          destruct H2 as [H2' H2]; exists H2'; hnf in H2|-*; rewrite H2.
-          f_equal. f_equal. rewrite Zminus_diag. reflexivity.
-        }
-    - rewrite Ptrofs.unsigned_repr by (rewrite Nat2Z.inj_succ in H0; unfold Ptrofs.max_unsigned; lia).
-      change (size_chunk Mint8unsigned) with 1.
-      rewrite prop_true_andp by (split; [apply tc_val'_Vundef | apply Z.divide_1_l]).
-      apply nonlock_permission_bytes_split2.
-      * rewrite Nat2Z.inj_succ; lia.
-      * lia.
-      * lia.
+      iSplit.
+      * iIntros "[[% H] | [_ H]]".
+        { apply tc_val_Vundef in H; contradiction. }
+        iDestruct "H" as (?) "H"; iPoseProof (address_mapsto_VALspec_range with "H") as "H".
+        by rewrite /= VALspec1.
+      * iIntros "H"; iRight; iSplit; first done.
+        iApply VALspec_range_exp_address_mapsto; first apply Z.divide_1_l.
+        by rewrite /= VALspec1.
+    - rewrite -> (nonlock_permission_bytes_split2 1 (Z_of_nat n) (Z.of_nat (S n)))  by (try rewrite inj_S; lia).
+      apply bi.sep_proper; last done.
+      rewrite -> Ptrofs.unsigned_repr by (rewrite Nat2Z.inj_succ in H0; unfold Ptrofs.max_unsigned; lia).
+      rewrite bi.pure_True.
+      by rewrite bi.True_and.
+      { split; [apply tc_val'_Vundef | apply Z.divide_1_l]. }
 Qed.
 
 Definition memory_block (sh: share) (n: Z) (v: val) : mpred :=
  match v with
- | Vptr b ofs => (!!(Ptrofs.unsigned ofs + n < Ptrofs.modulus)) && memory_block' sh (Z.to_nat n) b (Ptrofs.unsigned ofs)
- | _ => FF
+ | Vptr b ofs => ⌜Ptrofs.unsigned ofs + n < Ptrofs.modulus⌝ ∧ memory_block' sh (Z.to_nat n) b (Ptrofs.unsigned ofs)
+ | _ => False
  end.
 
 Lemma mapsto__exp_address_mapsto: forall sh t b i_ofs ch,
   access_mode t = By_value ch ->
   type_is_volatile t = false ->
   readable_share sh ->
-  mapsto_ sh t (Vptr b i_ofs) = EX  v2' : val,
+  mapsto_ sh t (Vptr b i_ofs) ⊣⊢ ∃ v2' : val,
             address_mapsto ch v2' sh (b, (Ptrofs.unsigned i_ofs)).
 Proof.
-  pose proof (@FF_orp (pred rmap) (algNatDed _)) as HH0.
-  change seplog.orp with orp in HH0.
-  change seplog.FF with FF in HH0.
-  pose proof (@ND_prop_ext (pred rmap) (algNatDed _)) as HH1.
-  change seplog.prop with prop in HH1.
-
-  intros. rename H1 into RS.
+  intros.
   unfold mapsto_, mapsto.
-  rewrite H, H0.
-  rewrite if_true by auto.
-  assert (!!(tc_val t Vundef) = FF). {
-    clear; unfold FF; f_equal; apply prop_ext; intuition.
-    apply (tc_val_Vundef _ H).
-  }
-  rewrite H1.
-
-  rewrite FF_and, HH0.
-  assert (!!(Vundef = Vundef) = TT) by (apply HH1; tauto).
-  rewrite H2.
-  rewrite TT_and.
-  reflexivity.
+  rewrite H H0.
+  rewrite -> if_true by auto.
+  rewrite -> bi.pure_False by apply tc_val_Vundef.
+  rewrite bi.False_and bi.False_or bi.pure_True; last done.
+  by rewrite bi.True_and.
 Qed.
 
 Lemma exp_address_mapsto_VALspec_range_eq:
   forall ch sh l,
-    EX v: val, address_mapsto ch v sh l = !! (align_chunk ch | snd l) && VALspec_range (size_chunk ch) sh l.
+    (∃ v: val, address_mapsto ch v sh l) ⊣⊢ ⌜(align_chunk ch | snd l)⌝ ∧ VALspec_range (size_chunk ch) sh l.
 Proof.
-  intros.
-  apply pred_ext.
-  + apply exp_left; intro.
-    apply andp_right; [| apply address_mapsto_VALspec_range].
-    unfold address_mapsto.
-    apply exp_left; intro.
-    apply andp_left1.
-    apply (@prop_derives (pred rmap) (algNatDed _)); tauto.
-  + apply prop_andp_left; intro.
-    apply VALspec_range_exp_address_mapsto; auto.
+  intros; iSplit.
+  + iIntros "H"; iDestruct "H" as (?) "H".
+    iSplit; last by iApply address_mapsto_VALspec_range.
+    rewrite /address_mapsto.
+    iDestruct "H" as (? (? & ? & ?)) "?"; auto.
+  + iIntros "[% H]".
+    iApply VALspec_range_exp_address_mapsto; auto.
 Qed.
 
 Lemma VALspec_range_exp_address_mapsto_eq:
   forall ch sh l,
     (align_chunk ch | snd l) ->
-    VALspec_range (size_chunk ch) sh l = EX v: val, address_mapsto ch v sh l.
+    VALspec_range (size_chunk ch) sh l ⊣⊢ ∃ v: val, address_mapsto ch v sh l.
 Proof.
   intros.
-  apply pred_ext.
-  + apply VALspec_range_exp_address_mapsto; auto.
-  + apply exp_left; intro; apply address_mapsto_VALspec_range.
+  rewrite exp_address_mapsto_VALspec_range_eq bi.pure_True; last done.
+  by rewrite bi.True_and.
 Qed.
 
 Lemma mapsto__memory_block: forall sh b ofs t ch,
@@ -521,34 +277,26 @@ Lemma mapsto__memory_block: forall sh b ofs t ch,
   type_is_volatile t = false ->
   (align_chunk ch | Ptrofs.unsigned ofs) ->
   Ptrofs.unsigned ofs + size_chunk ch < Ptrofs.modulus ->
-  mapsto_ sh t (Vptr b ofs) = memory_block sh (size_chunk ch) (Vptr b ofs).
+  mapsto_ sh t (Vptr b ofs) ⊣⊢ memory_block sh (size_chunk ch) (Vptr b ofs).
 Proof.
   intros.
   unfold memory_block.
   rewrite memory_block'_eq.
   2: pose proof Ptrofs.unsigned_range ofs; lia.
-  2: rewrite Z2Nat.id by (pose proof size_chunk_pos ch; lia); lia.
-  destruct (readable_share_dec sh).
- *
-  rewrite mapsto__exp_address_mapsto with (ch := ch); auto.
-  unfold memory_block'_alt. rewrite if_true by auto.
-  rewrite Z2Nat.id by (pose proof size_chunk_pos ch; lia).
-  rewrite VALspec_range_exp_address_mapsto_eq by (exact H1).
-  rewrite <- (TT_and (EX  v2' : val,
-   address_mapsto ch v2' sh (b, Ptrofs.unsigned ofs))) at 1.
-  f_equal.
-  pose proof (@ND_prop_ext (pred rmap) _).
-  simpl in H3.
-  change TT with (!! True).
-  apply H3.
-  tauto.
- * unfold mapsto_, mapsto, memory_block'_alt.
-   rewrite prop_true_andp by auto.
-   rewrite H, H0.
-  rewrite !if_false by auto.
-   rewrite prop_true_andp by (split; [apply tc_val'_Vundef | auto]).
-   rewrite Z2Nat.id by (pose proof (size_chunk_pos ch); lia).
-   auto.
+  2: rewrite -> Z2Nat.id by (pose proof size_chunk_pos ch; lia); lia.
+  rewrite bi.pure_True; last done.
+  rewrite bi.True_and.
+  unfold memory_block'_alt; destruct (readable_share_dec sh).
+ * rewrite -> mapsto__exp_address_mapsto with (ch := ch); auto.
+  rewrite -> Z2Nat.id by (pose proof size_chunk_pos ch; lia).
+  rewrite -> VALspec_range_exp_address_mapsto_eq by (exact H1).
+  done.
+ * unfold mapsto_, mapsto.
+  rewrite H H0.
+  rewrite -> if_false by auto.
+  rewrite -> bi.pure_True by (split; [apply tc_val'_Vundef | auto]).
+  rewrite -> Z2Nat.id by (pose proof (size_chunk_pos ch); lia).
+  by rewrite bi.True_and.
 Qed.
 
 Lemma nonreadable_memory_block_mapsto: forall sh b ofs t ch v,
@@ -558,188 +306,201 @@ Lemma nonreadable_memory_block_mapsto: forall sh b ofs t ch v,
   (align_chunk ch | Ptrofs.unsigned ofs) ->
   Ptrofs.unsigned ofs + size_chunk ch < Ptrofs.modulus ->
   tc_val' t v ->
-  memory_block sh (size_chunk ch) (Vptr b ofs) = mapsto sh t (Vptr b ofs) v.
+  memory_block sh (size_chunk ch) (Vptr b ofs) ⊣⊢ mapsto sh t (Vptr b ofs) v.
 Proof.
   intros.
-  unfold memory_block.
-  rewrite memory_block'_eq.
-  2: pose proof Ptrofs.unsigned_range ofs; lia.
-  2: rewrite Z2Nat.id by (pose proof size_chunk_pos ch; lia); lia.
-  destruct (readable_share_dec sh).
- * tauto.
- * unfold mapsto_, mapsto, memory_block'_alt.
-   rewrite prop_true_andp by auto.
-   rewrite H0, H1.
-   rewrite !if_false by auto.
-   rewrite prop_true_andp by auto.
-   rewrite Z2Nat.id by (pose proof (size_chunk_pos ch); lia).
-   auto.
+  rewrite -mapsto__memory_block; eauto.
+  rewrite /mapsto_ /mapsto.
+  rewrite H0 H1 !if_false; try done.
+  rewrite !bi.pure_True; try done.
+  split; [apply tc_val'_Vundef | done].
+Qed.
+
+Lemma guarded_sep_or_distr : forall (P1 P2: Prop) (p1 p2 q1 q2 : mpred),
+  (P1 -> P2 -> False) ->
+  (⌜P1⌝ ∧ p1 ∨ ⌜P2⌝ ∧ p2) ∗ (⌜P1⌝ ∧ q1 ∨ ⌜P2⌝ ∧ q2) ⊣⊢ ⌜P1⌝ ∧ (p1 ∗ q1) ∨ ⌜P2⌝ ∧ (p2 ∗ q2).
+Proof.
+  intros.
+  rewrite bi.sep_or_r.
+  rewrite (bi.sep_comm (⌜P1⌝ ∧ p1)).
+  rewrite (bi.sep_comm (⌜P2⌝ ∧ p2)).
+  rewrite !bi.sep_or_r.
+  iSplit.
+  + iIntros "[[[[% ?] [% ?]] | [[% ?] [% ?]]] | [[[% ?] [% ?]] | [[% ?] [% ?]]]]"; try tauto.
+    - by iLeft; iFrame.
+    - by iRight; iFrame.
+  + iIntros "[(% & ? & ?) | (% & ? & ?)]".
+    - by iLeft; iLeft; iFrame.
+    - by iRight; iRight; iFrame.
 Qed.
 
 Lemma mapsto_share_join:
  forall sh1 sh2 sh t p v,
-   join sh1 sh2 sh ->
-   mapsto sh1 t p v * mapsto sh2 t p v = mapsto sh t p v.
+   sepalg.join sh1 sh2 sh ->
+   mapsto sh1 t p v ∗ mapsto sh2 t p v ⊣⊢ mapsto sh t p v.
 Proof.
   intros.
   unfold mapsto.
-  destruct (access_mode t) eqn:?; try solve [rewrite FF_sepcon; auto].
-  destruct (type_is_volatile t) eqn:?; try solve [rewrite FF_sepcon; auto].
-  destruct p; try solve [rewrite FF_sepcon; auto].
+  destruct (access_mode t) eqn:?; try solve [rewrite bi.False_sep; auto].
+  destruct (type_is_volatile t) eqn:?; try solve [rewrite bi.False_sep; auto].
+  destruct p; try solve [rewrite bi.False_sep; auto].
+  destruct (readable_share_dec sh1), (readable_share_dec sh2);
+    try rewrite -> (if_true (readable_share sh)) by (eapply join_sub_readable; [unfold sepalg.join_sub; eauto | auto]).
+  + rewrite guarded_sep_or_distr; last by intros; subst; eapply tc_val_Vundef; eauto.
+    apply bi.or_proper; first by rewrite address_mapsto_share_join.
+    apply bi.and_proper; first done.
+    rewrite bi.sep_exist_r; apply bi.exist_proper; intros v1.
+    rewrite -(address_mapsto_share_join _ _ _ _ _ _ H); auto.
+    iSplit.
+    * iIntros "[H1 H2]"; iDestruct "H2" as (?) "H2".
+      iDestruct (address_mapsto_value_cohere with "[$H1 $H2]") as %->; iFrame.
+    * iIntros "[$ ?]"; eauto.
+  + rewrite bi.sep_or_r.
+    apply bi.or_proper; iSplit.
+    * iIntros "[[% H1] [% H2]]".
+      iCombine "H2 H1" as "?"; rewrite nonlock_permission_bytes_address_mapsto_join; auto.
+      by apply sepalg.join_comm.
+    * iIntros "[% H]".
+      rewrite address_mapsto_align; iDestruct "H" as "[H %]".
+      rewrite !bi.pure_True; auto.
+      rewrite !bi.True_and comm nonlock_permission_bytes_address_mapsto_join; auto.
+      { by apply sepalg.join_comm. }
+      { split; auto; by apply tc_val_tc_val'. }
+    * iIntros "[[$ H1] [% H2]]".
+      iDestruct "H1" as (?) "H1".
+      iCombine "H2 H1" as "?"; rewrite nonlock_permission_bytes_address_mapsto_join; auto.
+      by apply sepalg.join_comm.
+    * iIntros "[% H]".
+      iDestruct "H" as (?) "H".
+      rewrite address_mapsto_align; iDestruct "H" as "[H %]".
+      rewrite !bi.pure_True; auto.
+      rewrite !bi.True_and bi.sep_exist_r.
+      iExists v2'; rewrite comm nonlock_permission_bytes_address_mapsto_join; auto.
+      { by apply sepalg.join_comm. }
+      { subst; split; auto; by apply tc_val'_Vundef. }
+  + rewrite -> (if_true (readable_share sh)) by (eapply join_sub_readable; [unfold sepalg.join_sub; eexists; apply sepalg.join_comm; eauto | auto]).
+    rewrite bi.sep_or_l.
+    apply bi.or_proper; iSplit.
+    * iIntros "[[% H1] [% H2]]".
+      iCombine "H1 H2" as "?"; rewrite nonlock_permission_bytes_address_mapsto_join; auto.
+    * iIntros "[% H]".
+      rewrite address_mapsto_align; iDestruct "H" as "[H %]".
+      rewrite !bi.pure_True; auto.
+      rewrite !bi.True_and nonlock_permission_bytes_address_mapsto_join; auto.
+      { split; auto; by apply tc_val_tc_val'. }
+    * iIntros "[[% H1] [$ H2]]".
+      iDestruct "H2" as (?) "H2".
+      iCombine "H1 H2" as "?"; rewrite nonlock_permission_bytes_address_mapsto_join; auto.
+    * iIntros "[% H]".
+      iDestruct "H" as (?) "H".
+      rewrite address_mapsto_align; iDestruct "H" as "[H %]".
+      rewrite !bi.pure_True; auto.
+      rewrite !bi.True_and bi.sep_exist_l.
+      iExists v2'; rewrite nonlock_permission_bytes_address_mapsto_join; auto.
+      { subst; split; auto; by apply tc_val'_Vundef. }
+  + rewrite -> if_false by (eapply join_unreadable_shares; eauto).
+    rewrite -(nonlock_permission_bytes_share_join _ _ _ _ _ H); auto.
+    iSplit.
+    * iIntros "[[$ $] [_ $]]".
+    * iIntros "(% & $ & $)"; auto.
+Qed.
+
+Lemma mapsto_share_joins:
+ forall sh1 sh2 t p v,
+   mapsto sh1 t p v ∗ mapsto sh2 t p v ⊢ ⌜sepalg.joins sh1 sh2⌝.
+Proof.
+  intros.
+  unfold mapsto.
+  iIntros "[H1 H2]".
+  destruct (access_mode t) eqn:?; try done.
+  destruct (type_is_volatile t) eqn:?; try done.
+  destruct p; try done.
   destruct (readable_share_dec sh1), (readable_share_dec sh2).
-  + rewrite if_true by (eapply join_sub_readable; [unfold join_sub; eauto | auto]).
-    pose proof (@guarded_sepcon_orp_distr (pred rmap) (algNatDed _) (algSepLog _)).
-    simpl in H0; rewrite H0 by (intros; subst; pose proof tc_val_Vundef t; tauto); clear H0.
-    f_equal; f_equal.
-    - apply address_mapsto_share_join; auto.
-    - rewrite exp_sepcon1.
-      pose proof (@exp_congr (pred rmap) (algNatDed _) val); simpl in H0; apply H0; clear H0; intro.
-      rewrite exp_sepcon2.
-      transitivity
-       (address_mapsto m v0 sh1 (b, Ptrofs.unsigned i) *
-        address_mapsto m v0 sh2 (b, Ptrofs.unsigned i)).
-      * apply pred_ext; [| apply (exp_right v0); auto].
-        apply exp_left; intro.
-        erewrite add_andp at 1 by (constructor; apply address_mapsto_value_cohere).
-        apply normalize.derives_extract_prop'; intro; subst; auto.
-      * apply address_mapsto_share_join; auto.
-  + rewrite if_true by (eapply join_sub_readable; [unfold join_sub; eauto | auto]).
-    rewrite distrib_orp_sepcon.
-    f_equal; rewrite sepcon_comm, sepcon_andp_prop;
-    pose proof (@andp_prop_ext (pred rmap) _);
-    (simpl in H0; apply H0; clear H0; [reflexivity | intro]).
-    - rewrite (address_mapsto_align _ _ sh).
-      rewrite (andp_comm (address_mapsto _ _ _ _)), sepcon_andp_prop1.
-      pose proof (@andp_prop_ext (pred rmap) _); simpl in H1; apply H1; clear H1; intros.
-      * apply tc_val_tc_val' in H0; tauto.
-      * apply nonlock_permission_bytes_address_mapsto_join; auto.
-    - rewrite exp_sepcon2.
-      pose proof (@exp_congr (pred rmap) (algNatDed _) val); simpl in H1; apply H1; clear H1; intro.
-      rewrite (address_mapsto_align _ _ sh).
-      rewrite (andp_comm (address_mapsto _ _ _ _)), sepcon_andp_prop1.
-      pose proof (@andp_prop_ext (pred rmap) _); simpl in H1; apply H1; clear H1; intros.
-      * subst; pose proof tc_val'_Vundef t. tauto.
-      * apply nonlock_permission_bytes_address_mapsto_join; auto.
-  + rewrite if_true by (eapply join_sub_readable; [unfold join_sub; eexists; apply join_comm in H; eauto | auto]).
-    rewrite sepcon_comm, distrib_orp_sepcon.
-    f_equal; rewrite sepcon_comm, sepcon_andp_prop;
-    pose proof (@andp_prop_ext (pred rmap) _);
-    (simpl in H0; apply H0; clear H0; [reflexivity | intro]).
-    - rewrite (address_mapsto_align _ _ sh).
-      rewrite (andp_comm (address_mapsto _ _ _ _)), sepcon_andp_prop1.
-      pose proof (@andp_prop_ext (pred rmap) _); simpl in H1; apply H1; clear H1; intros.
-      * apply tc_val_tc_val' in H0; tauto.
-      * apply nonlock_permission_bytes_address_mapsto_join; auto.
-    - rewrite exp_sepcon2.
-      pose proof (@exp_congr (pred rmap) (algNatDed _) val); simpl in H1; apply H1; clear H1; intro.
-      rewrite (address_mapsto_align _ _ sh).
-      rewrite (andp_comm (address_mapsto _ _ _ _)), sepcon_andp_prop1.
-      pose proof (@andp_prop_ext (pred rmap) _); simpl in H1; apply H1; clear H1; intros.
-      * subst; pose proof tc_val'_Vundef t. tauto.
-      * apply nonlock_permission_bytes_address_mapsto_join; auto.
-  + rewrite if_false by (eapply join_unreadable_shares; eauto).
-    rewrite sepcon_andp_prop1, sepcon_andp_prop2, <- andp_assoc, andp_dup.
-    f_equal.
-    apply nonlock_permission_bytes_share_join; auto.
+  + iDestruct "H1" as "[(% & H1) | (% & % & H1)]"; iDestruct "H2" as "[(% & H2) | (% & % & H2)]";
+      try iDestruct (address_mapsto_value_cohere with "[$H1 $H2]") as %->;
+      by iApply (address_mapsto_share_joins with "[$H1 $H2]").
+  + iDestruct "H1" as "[(% & H1) | (% & % & H1)]"; iDestruct "H2" as "(% & H2)";
+      iDestruct (nonlock_permission_bytes_address_mapsto_joins with "[$H1 $H2]") as %?; iPureIntro; by apply psepalg.joins_comm.
+  + iDestruct "H1" as "(% & H1)"; iDestruct "H2" as "[(% & H2) | (% & % & H2)]";
+      by iApply (nonlock_permission_bytes_address_mapsto_joins with "[$H1 $H2]").
+  + iDestruct "H1" as "(% & H1)"; iDestruct "H2" as "(% & H2)";
+      iApply (nonlock_permission_bytes_share_joins with "[$H1 $H2]").
+    apply size_chunk_pos.
 Qed.
 
-Lemma mapsto_mapsto_: forall sh t v v', mapsto sh t v v' |-- mapsto_ sh t v.
+Lemma mapsto_mapsto_: forall sh t v v', mapsto sh t v v' ⊢ mapsto_ sh t v.
 Proof. unfold mapsto_; intros.
   unfold mapsto.
   destruct (access_mode t); auto.
   destruct (type_is_volatile t); auto.
   destruct v; auto.
   if_tac.
-  + apply orp_left.
-    apply orp_right2.
-    apply andp_left2.
-    apply andp_right.
-    - intros ? _; simpl; auto.
-    - apply exp_right with v'; auto.
-    - apply andp_left2. apply exp_left; intro v2'.
-      apply orp_right2. apply andp_right; [intros ? _; simpl; auto |]. apply exp_right with v2'.
-      auto.
-  + apply andp_derives; [| auto].
-    intros ? [? ?].
-    split; auto.
+  + iIntros "[[% ?] | [% ?]]"; eauto.
+  + iIntros "[[% %] $]"; iPureIntro; repeat split; auto.
     apply tc_val'_Vundef.
 Qed.
 
-Lemma mapsto_not_nonunit: forall sh t p v, ~ nonunit sh -> mapsto sh t p v |-- emp.
+Lemma memory_block_share_joins:
+  forall sh1 sh2 n p, n > 0 ->
+   memory_block sh1 n p ∗ memory_block sh2 n p ⊢ ⌜sepalg.joins sh1 sh2⌝.
+Proof.
+  intros.
+  unfold memory_block.
+  iIntros "[H1 H2]".
+  destruct p; try done.
+  destruct (Z.to_nat n) eqn: Hn; simpl; first lia.
+  iDestruct "H1" as (?) "(H1 & _)"; iDestruct "H2" as (?) "(H2 & _)".
+  iApply (mapsto_share_joins with "[$H1 $H2]").
+Qed.
+
+(*Lemma mapsto_not_nonunit: forall sh t p v, ~ nonunit sh -> mapsto sh t p v ⊢ emp.
 Proof.
   intros.
   unfold mapsto.
-  destruct (access_mode t); try solve [apply FF_derives].
-  destruct (type_is_volatile t); try solve [apply FF_derives].
-  destruct p; try solve [apply FF_derives].
+  destruct (access_mode t); try solve [apply False_derives].
+  destruct (type_is_volatile t); try solve [apply False_derives].
+  destruct p; try solve [apply False_derives].
   if_tac.
   + apply readable_nonidentity in H0.
     apply nonidentity_nonunit in H0; tauto.
   + apply andp_left2.
     apply nonlock_permission_bytes_not_nonunit; auto.
-Qed.
+Qed.*)
 
 Lemma mapsto_pure_facts: forall sh t p v,
-  mapsto sh t p v |-- !! ((exists ch, access_mode t = By_value ch) /\ isptr p).
+  mapsto sh t p v ⊢ ⌜(exists ch, access_mode t = By_value ch) /\ isptr p⌝.
 Proof.
   intros.
   unfold mapsto.
-  destruct (access_mode t); try solve [apply FF_derives].
-  destruct (type_is_volatile t); try solve [apply FF_derives].
-  destruct p; try solve [apply FF_derives].
-
-  pose proof (@seplog.prop_right (pred rmap) (algNatDed _)).
-  simpl in H; apply H; clear H.
-  split.
-  + eauto.
-  + simpl; auto.
+  destruct (access_mode t); try iIntros "[]".
+  destruct (type_is_volatile t); try iIntros "[]".
+  destruct p; try iIntros "[]".
+  iIntros "_"; iPureIntro; simpl; eauto.
 Qed.
 
-Lemma mapsto_overlap: forall sh {cs: compspecs} t1 t2 p1 p2 v1 v2,
-  nonunit sh ->
-  pointer_range_overlap p1 (sizeof t1) p2 (sizeof t2) ->
-  mapsto sh t1 p1 v1 * mapsto sh t2 p2 v2 |-- FF.
+Lemma mapsto_overlap: forall sh {cs: compspecs} t1 t2 p1 p2 v1 v2
+  (Hsh : sh <> Share.bot), pointer_range_overlap p1 (sizeof t1) p2 (sizeof t2) ->
+  mapsto sh t1 p1 v1 ∗ mapsto sh t2 p2 v2 ⊢ False.
 Proof.
   intros.
   unfold mapsto.
-  destruct (access_mode t1) eqn:AM1; try (rewrite FF_sepcon; auto).
-  destruct (access_mode t2) eqn:AM2; try (rewrite normalize.sepcon_FF; auto).
-  destruct (type_is_volatile t1); try (rewrite FF_sepcon; auto).
-  destruct (type_is_volatile t2); try (rewrite normalize.sepcon_FF; auto).
-  destruct p1; try (rewrite FF_sepcon; auto).
-  destruct p2; try (rewrite normalize.sepcon_FF; auto).
+  destruct (access_mode t1) eqn:AM1; try iIntros "[[] _]".
+  destruct (access_mode t2) eqn:AM2; try iIntros "[_ []]".
+  destruct (type_is_volatile t1); try iIntros "[[] _]".
+  destruct (type_is_volatile t2); try iIntros "[_ []]".
+  destruct p1; try iIntros "[[] _]".
+  destruct p2; try iIntros "[_ []]".
+  destruct H as (? & ? & H1 & H2 & H); simpl in *; subst.
+  erewrite -> !size_chunk_sizeof in H by eauto.
+  apply range_overlap_comm in H.
   if_tac.
-  + apply derives_trans with ((EX  v : val,
-          address_mapsto m v sh (b, Ptrofs.unsigned i)) *
-      (EX  v : val,
-          address_mapsto m0 v sh (b0, Ptrofs.unsigned i0))).
-    - apply sepcon_derives; apply orp_left.
-      * apply andp_left2, (exp_right v1).
-        auto.
-      * apply andp_left2; auto.
-      * apply andp_left2, (exp_right v2).
-        auto.
-      * apply andp_left2; auto.
-    - clear v1 v2.
-      rewrite exp_sepcon1.
-      apply exp_left; intro v1.
-      rewrite exp_sepcon2.
-      apply exp_left; intro v2.
-      clear H H1; rename H0 into H.
-      destruct H as [? [? [? [? ?]]]].
-      inversion H; subst.
-      inversion H0; subst.
-      erewrite !size_chunk_sizeof in H1 by eauto.
-      apply address_mapsto_overlap; auto.
-  + rewrite sepcon_andp_prop1, sepcon_andp_prop2.
-    apply andp_left2, andp_left2.
-    apply nonlock_permission_bytes_overlap; auto.
-    clear H H1; rename H0 into H.
-    erewrite !size_chunk_sizeof in H by eauto.
-    destruct H as [? [? [? [? ?]]]].
-    inversion H; subst.
-    inversion H0; subst.
-    auto.
+  + trans ((∃ v : val, address_mapsto m v sh (b, Ptrofs.unsigned i)) ∗
+          (∃ v : val, address_mapsto m0 v sh (b0, Ptrofs.unsigned i0))).
+    { apply bi.sep_mono; (iIntros "[[% H] | [% H]]"; [|iDestruct "H" as (?) "H"]); eauto. }
+    iIntros "[H1 H2]"; iDestruct "H1" as (?) "H1"; iDestruct "H2" as (?) "H2".
+    iApply address_mapsto_overlap; eauto with iFrame.
+  + iIntros "[[% H] [% ?]]".
+    iApply nonlock_permission_bytes_overlap; eauto with iFrame.
 Qed.
 
 Lemma Nat2Z_add_lt: forall n i, Ptrofs.unsigned i + n < Ptrofs.modulus ->
@@ -747,8 +508,8 @@ Lemma Nat2Z_add_lt: forall n i, Ptrofs.unsigned i + n < Ptrofs.modulus ->
 Proof.
   intros.
   destruct (zle 0 n).
-  + rewrite Z2Nat.id by lia. lia.
-  + rewrite Z2Nat_neg by lia.
+  + rewrite -> Z2Nat.id by lia. lia.
+  + rewrite -> Z2Nat_neg by lia.
     pose proof Ptrofs.unsigned_range i.
     simpl.
     lia.
@@ -759,100 +520,62 @@ Lemma Nat2Z_add_le: forall n i, Ptrofs.unsigned i + n <= Ptrofs.modulus ->
 Proof.
   intros.
   destruct (zle 0 n).
-  + rewrite Z2Nat.id by lia. lia.
-  + rewrite Z2Nat_neg by lia.
+  + rewrite -> Z2Nat.id by lia. lia.
+  + rewrite -> Z2Nat_neg by lia.
     pose proof Ptrofs.unsigned_range i.
     simpl.
     lia.
 Qed.
 
-Lemma memory_block_overlap: forall sh p1 n1 p2 n2, nonunit sh -> pointer_range_overlap p1 n1 p2 n2 -> memory_block sh n1 p1 * memory_block sh n2 p2 |-- FF.
+Lemma memory_block_overlap: forall sh p1 n1 p2 n2 (Hsh : sh <> Share.bot), pointer_range_overlap p1 n1 p2 n2 -> memory_block sh n1 p1 ∗ memory_block sh n2 p2 ⊢ False.
 Proof.
   intros.
   unfold memory_block.
-  destruct p1; try solve [rewrite FF_sepcon; auto].
-  destruct p2; try solve [rewrite normalize.sepcon_FF; auto].
-  rewrite sepcon_andp_prop1.
-  rewrite sepcon_andp_prop2.
-  apply normalize.derives_extract_prop; intros.
-  apply normalize.derives_extract_prop; intros. 
+  destruct p1; try iIntros "[[] _]".
+  destruct p2; try iIntros "[_ []]".
+  iIntros "[[% H] [% ?]]".
+  destruct (pointer_range_overlap_non_zero _ _ _ _ H).
+  destruct H as (? & ? & ? & ? & H%range_overlap_comm); simpl in *; subst.
   rewrite memory_block'_eq; [| pose proof Ptrofs.unsigned_range i; lia | apply Nat2Z_add_lt; lia].
   rewrite memory_block'_eq; [| pose proof Ptrofs.unsigned_range i0; lia | apply Nat2Z_add_lt; lia].
   unfold memory_block'_alt.
   if_tac.
-  + clear H2.
-    apply VALspec_range_overlap.
-    pose proof pointer_range_overlap_non_zero _ _ _ _ H0.
-    rewrite !Z2Nat.id by lia.
-    destruct H0 as [[? ?] [[? ?] [? [? ?]]]].
-    inversion H0; inversion H4.
-    subst.
-    auto.
-  + apply nonlock_permission_bytes_overlap; auto.
-    pose proof pointer_range_overlap_non_zero _ _ _ _ H0.
-    rewrite !Z2Nat.id by lia.
-    destruct H0 as [[? ?] [[? ?] [? [? ?]]]].
-    inversion H0; inversion H5.
-    subst.
-    auto.
+  + iApply (VALspec_range_overlap with "[$]").
+    rewrite !Z2Nat.id; auto; lia.
+  + iApply (nonlock_permission_bytes_overlap with "[$]"); first done.
+    rewrite !Z2Nat.id; auto; lia.
 Qed.
 
 Lemma mapsto_conflict:
-  forall sh t v v2 v3,
-  nonunit sh ->
-  mapsto sh t v v2 * mapsto sh t v v3 |-- FF.
+  forall {cs : compspecs} sh t v v2 v3 (Hsh : sh <> Share.bot),
+  mapsto sh t v v2 ∗ mapsto sh t v v3 ⊢ False.
 Proof.
   intros.
-  setoid_rewrite add_andp at 4; [|constructor; apply mapsto_pure_facts].
-  simpl.
-  rewrite andp_comm.
-  rewrite sepcon_andp_prop.
-  apply prop_andp_left; intros [[? ?] ?].
-  unfold mapsto.
-  rewrite H0.
-  destruct (type_is_volatile t); try (rewrite FF_sepcon; auto).
-  destruct v; try (rewrite FF_sepcon; auto).
-  pose proof (size_chunk_pos x).
-  if_tac.
-*
-  normalize.
-  rewrite distrib_orp_sepcon, !distrib_orp_sepcon2;
-  repeat apply orp_left;
-  rewrite ?sepcon_andp_prop1;  repeat (apply prop_andp_left; intro);
-  rewrite ?sepcon_andp_prop2;  repeat (apply prop_andp_left; intro);
-  rewrite ?exp_sepcon1;  repeat (apply exp_left; intro);
-  rewrite ?exp_sepcon2;  repeat (apply exp_left; intro);
-  apply address_mapsto_overlap;
-  exists (b, Ptrofs.unsigned i); repeat split; lia.
-*
-  rewrite ?sepcon_andp_prop1;  repeat (apply prop_andp_left; intro);
-  rewrite ?sepcon_andp_prop2;  repeat (apply prop_andp_left; intro).
-  apply nonlock_permission_bytes_overlap; auto.
-  exists (b, Ptrofs.unsigned i); repeat split; lia.
+  iIntros "[H1 H2]".
+  iDestruct (mapsto_pure_facts with "H1") as %[[??] ?].
+  assert (sizeof t > 0).
+  { destruct t; try discriminate; simpl; try destruct i; try destruct f; try simple_if_tac; lia. }
+  iApply (mapsto_overlap _ (cs := cs) with "[$]"); first done.
+  apply pointer_range_overlap_refl; auto.
 Qed.
 
-Lemma memory_block_conflict: forall sh n m p,
-  nonunit sh ->
+Lemma memory_block_conflict: forall sh n m p (Hsh : sh <> Share.bot),
   0 < n <= Ptrofs.max_unsigned -> 0 < m <= Ptrofs.max_unsigned ->
-  memory_block sh n p * memory_block sh m p |-- FF.
+  memory_block sh n p ∗ memory_block sh m p ⊢ False.
 Proof.
   intros.
   unfold memory_block.
-  destruct p; try solve [rewrite FF_sepcon; auto].
-  rewrite sepcon_andp_prop1.
-  apply prop_andp_left; intro.
-  rewrite sepcon_comm.
-  rewrite sepcon_andp_prop1.
-  apply prop_andp_left; intro.
+  destruct p; try iIntros "[[] _]".
+  iIntros "[[% H1] [% H2]]".
   rewrite memory_block'_eq; [| pose proof Ptrofs.unsigned_range i; lia | rewrite Z2Nat.id; lia].
   rewrite memory_block'_eq; [| pose proof Ptrofs.unsigned_range i; lia | rewrite Z2Nat.id; lia].
   unfold memory_block'_alt.
   if_tac.
-  + apply VALspec_range_overlap.
+  + iApply VALspec_range_overlap; last iFrame.
     exists (b, Ptrofs.unsigned i).
     simpl; repeat split; auto; try lia;
     rewrite Z2Nat.id; lia.
-  + apply nonlock_permission_bytes_overlap; auto.
+  + iApply nonlock_permission_bytes_overlap; first done; last iFrame.
     exists (b, Ptrofs.unsigned i).
     repeat split; auto; try rewrite Z2Nat.id; lia.
 Qed.
@@ -860,14 +583,10 @@ Qed.
 Lemma memory_block_non_pos_Vptr: forall sh n b z, n <= 0 -> memory_block sh n (Vptr b z) = emp.
 Proof.
   intros. unfold memory_block.
-  rewrite Z_to_nat_neg by auto.
+  rewrite -> Z_to_nat_neg by auto.
   unfold memory_block'.
-  pose proof Ptrofs.unsigned_range z.
-  assert (Ptrofs.unsigned z + n < Ptrofs.modulus) by lia.
-  apply pred_ext; normalize.
-   apply andp_left2; auto.
-  apply andp_right; auto.
-  intros ? _; simpl; auto.
+  rewrite prop_true_andp //.
+  pose proof Ptrofs.unsigned_range z. lia.
 Qed.
 
 Lemma memory_block_zero_Vptr: forall sh b z, memory_block sh 0 (Vptr b z) = emp.
@@ -877,80 +596,39 @@ Proof.
 Qed.
 
 Lemma mapsto_zeros_memory_block: forall sh n p,
-  readable_share sh ->
-  mapsto_zeros n sh p |--
+  mapsto_zeros n sh p ⊢
   memory_block sh n p.
 Proof.
   intros.
-  unfold mapsto_zeros.
-  destruct p; try solve [intros ? ?; contradiction].
-  rename i into ofs.
-  intros. rename H into RS. pose proof I.
-  unfold memory_block.
-  destruct (zlt n 0).   {
-     rewrite Z_to_nat_neg by lia. simpl.
-     apply andp_derives; auto.
-     intros ? ?. simpl in *. destruct H0.
-     lia. 
-  }
- apply prop_andp_left; intros [? ?].
- rewrite prop_true_andp by lia.
- assert (n <= Ptrofs.modulus) by lia. clear H H0. rename H1 into H'.
- assert (0 <= n <= Ptrofs.modulus) by lia. clear H2 g.
-    rewrite <- (Z2Nat.id n) in H', H by lia.
-    forget (Z.to_nat n) as n'.
-    clear n.
-    remember (Ptrofs.unsigned ofs) as ofs'.
-    assert (Ptrofs.unsigned (Ptrofs.repr ofs') = ofs')
-      by (subst; rewrite Ptrofs.repr_unsigned; reflexivity).
-    assert (0 <= ofs' /\ ofs' + Z.of_nat n' <= Ptrofs.modulus).
-    {
-      pose proof Ptrofs.unsigned_range ofs.
-      lia.
-    }
-    clear Heqofs' H'.
-    assert (Ptrofs.unsigned (Ptrofs.repr ofs') = ofs' \/ n' = 0%nat) by tauto.
-    clear H0; rename H2 into H0.
-    revert ofs' H H1 H0; induction n'; intros.
-    - simpl; auto.
-    - destruct H1.
-      rewrite inj_S in H2. unfold Z.succ in H2. simpl.
-      apply sepcon_derives; auto.
-      * unfold mapsto_, mapsto. simpl.
-        rewrite if_true by auto.
-        apply orp_right2.
-        rewrite prop_true_andp by auto.
-        apply exp_right with (Vint Int.zero).
-        destruct H0; [| lia].
-        rewrite H0.
-        auto.
-      * fold address_mapsto_zeros. fold memory_block'.
-        apply IHn'. lia. lia.
-        destruct (zlt (ofs' + 1) Ptrofs.modulus).
-        rewrite Ptrofs.unsigned_repr; [left; reflexivity | ].
-        unfold Ptrofs.max_unsigned; lia.
-        right.
-           destruct H0; [| inversion H0].
-           lia.
+  unfold mapsto_zeros, memory_block.
+  destruct p; try iIntros "[]".
+  iIntros "[% H]"; iSplit; [iPureIntro; lia|].
+  destruct (zlt n 0).
+  { rewrite -> Z_to_nat_neg by lia; done. }
+  rewrite address_mapsto_zeros_eq memory_block'_eq; try (rewrite ?Z2Nat.id; lia).
+  rewrite /address_mapsto_zeros' /memory_block'_alt.
+  rewrite -> Z2Nat.id by lia.
+  if_tac.
+  - rewrite /VALspec_range /VALspec.
+    iApply (big_sepL_mono with "H"); eauto.
+  - rewrite /nonlock_permission_bytes.
+    destruct (Z.to_nat n) eqn: ?; first done; simpl.
+    iDestruct "H" as "[H ?]"; iDestruct (mapsto_valid with "H") as %[??]; done.
 Qed.
 
 Lemma memory_block'_split:
   forall sh b ofs i j,
    0 <= i <= j ->
     j <= j+ofs < Ptrofs.modulus ->
-   memory_block' sh (Z.to_nat j) b ofs =
-      memory_block' sh (Z.to_nat i) b ofs * memory_block' sh (Z.to_nat (j-i)) b (ofs+i).
+   memory_block' sh (Z.to_nat j) b ofs ⊣⊢
+      memory_block' sh (Z.to_nat i) b ofs ∗ memory_block' sh (Z.to_nat (j-i)) b (ofs+i).
 Proof.
   intros.
-  rewrite memory_block'_eq; try rewrite Z2Nat.id; try lia.
-  rewrite memory_block'_eq; try rewrite Z2Nat.id; try lia.
-  rewrite memory_block'_eq; try rewrite Z2Nat.id; try lia.
-  unfold memory_block'_alt.
-  repeat (rewrite Z2Nat.id; try lia).
+  rewrite !memory_block'_eq; try rewrite Z2Nat.id; try lia.
+  rewrite /memory_block'_alt.
+  rewrite -> !Z2Nat.id by lia.
   if_tac.
-  + etransitivity ; [ | eapply VALspec_range_split2; [reflexivity | lia | lia]].
-    f_equal.
-    lia.
+  + apply VALspec_range_split2; lia.
   + apply nonlock_permission_bytes_split2; lia.
 Qed.
 
@@ -959,13 +637,13 @@ Lemma memory_block_split:
   0 <= n ->
   0 <= m ->
   n + m <= n + m + ofs < Ptrofs.modulus ->
-  memory_block sh (n + m) (Vptr b (Ptrofs.repr ofs)) =
-  memory_block sh n (Vptr b (Ptrofs.repr ofs)) *
+  memory_block sh (n + m) (Vptr b (Ptrofs.repr ofs)) ⊣⊢
+  memory_block sh n (Vptr b (Ptrofs.repr ofs)) ∗
   memory_block sh m (Vptr b (Ptrofs.repr (ofs + n))).
 Proof.
   intros.
   unfold memory_block.
-  rewrite memory_block'_split with (i := n); [| lia |].
+  rewrite -> memory_block'_split with (i := n); [| lia |].
   2:{
     pose proof Ptrofs.unsigned_range (Ptrofs.repr ofs).
     pose proof Ptrofs.unsigned_repr_eq ofs.
@@ -979,53 +657,52 @@ Proof.
     destruct (zeq m 0).
     + subst. reflexivity.
     + assert (ofs + n < Ptrofs.modulus) by lia.
-      rewrite !Ptrofs.unsigned_repr by (unfold Ptrofs.max_unsigned; lia).
+      rewrite -> !Ptrofs.unsigned_repr by (unfold Ptrofs.max_unsigned; lia).
       reflexivity.
   }
-  apply pred_ext.
-  + apply prop_andp_left; intros.
-    apply sepcon_derives; (apply andp_right; [intros ? _; simpl | apply derives_refl]).
-    - lia.
-    - rewrite Ptrofs.unsigned_repr_eq.
-      assert ((ofs + n) mod Ptrofs.modulus <= ofs + n) by (apply Z.mod_le; lia).
-      lia.
-  + apply andp_right; [intros ? _; simpl |].
-    - rewrite Ptrofs.unsigned_repr_eq.
-      assert (ofs mod Ptrofs.modulus <= ofs) by (apply Z.mod_le; lia).
-      lia.
-    - apply sepcon_derives; apply andp_left2; apply derives_refl.
+  iSplit.
+  + iIntros "(% & $ & $)"; iPureIntro; repeat (split; auto); try lia.
+    rewrite Ptrofs.unsigned_repr_eq.
+    assert ((ofs + n) mod Ptrofs.modulus <= ofs + n) by (apply Z.mod_le; lia).
+    lia.
+  + iIntros "[[% $] [% $]]"; iPureIntro; repeat (split; auto); try lia.
+    rewrite Ptrofs.unsigned_repr_eq.
+    assert (ofs mod Ptrofs.modulus <= ofs) by (apply Z.mod_le; lia).
+    lia.
 Qed.
 
 Lemma memory_block_share_join:
   forall sh1 sh2 sh n p,
    sepalg.join sh1 sh2 sh ->
-   memory_block sh1 n p * memory_block sh2 n p = memory_block sh n p.
+   memory_block sh1 n p ∗ memory_block sh2 n p ⊣⊢ memory_block sh n p.
 Proof.
   intros.
-  destruct p; try solve [unfold memory_block; rewrite FF_sepcon; auto].
+  destruct p; try solve [unfold memory_block; rewrite bi.False_sep; auto].
   destruct (zle 0 n).
   2:{
-    rewrite !memory_block_non_pos_Vptr by lia.
-    rewrite emp_sepcon; auto.
+    rewrite -> !memory_block_non_pos_Vptr by lia.
+    by rewrite left_id.
   }
   unfold memory_block.
   destruct (zlt (Ptrofs.unsigned i + n) Ptrofs.modulus).
-  + rewrite !prop_true_andp by auto.
+  + rewrite -> bi.pure_True by auto.
+    rewrite !bi.True_and.
     repeat (rewrite memory_block'_eq; [| pose proof Ptrofs.unsigned_range i; lia | rewrite Z2Nat.id; lia]).
     unfold memory_block'_alt.
     destruct (readable_share_dec sh1), (readable_share_dec sh2).
-    - rewrite if_true by (eapply readable_share_join; eauto).
+    - rewrite -> if_true by (eapply readable_share_join; eauto).
       apply VALspec_range_share_join; auto.
-    - rewrite if_true by (eapply readable_share_join; eauto).
-      rewrite sepcon_comm.
+    - rewrite -> if_true by (eapply readable_share_join; eauto).
+      rewrite comm.
       apply nonlock_permission_bytes_VALspec_range_join; auto.
-    - rewrite if_true by (eapply readable_share_join; eauto).
+      by apply sepalg.join_comm.
+    - rewrite -> if_true by (eapply readable_share_join; eauto).
       apply nonlock_permission_bytes_VALspec_range_join; auto.
     - rewrite if_false.
       * apply nonlock_permission_bytes_share_join; auto.
       * eapply join_unreadable_shares; eauto.
-  + rewrite !prop_false_andp by auto.
-    rewrite FF_sepcon; auto.
+  + rewrite -> bi.pure_False by auto.
+    by rewrite !bi.False_and bi.False_sep.
 Qed.
 
 Lemma mapsto_pointer_void:
@@ -1037,7 +714,7 @@ Proof.
 intros.
 unfold mapsto.
 extensionality v1 v2.
-unfold tc_val', tc_val. rewrite H, H0.
+unfold tc_val', tc_val. rewrite H H0.
 reflexivity.
 Qed.
 
@@ -1046,7 +723,7 @@ Proof.
 unfold is_pointer_or_null, nullval.
 simple_if_tac; auto.
 Qed.
-#[export] Hint Resolve is_pointer_or_null_nullval : core.
+#[local] Hint Resolve is_pointer_or_null_nullval : core.
 
 Lemma tc_val_pointer_nullval':
  forall t a, tc_val (Tpointer t a) nullval.
@@ -1055,35 +732,35 @@ Proof.
  simple_if_tac; hnf;
  simple_if_tac; auto.
 Qed.
-#[export] Hint Resolve tc_val_pointer_nullval' : core.
+#[local] Hint Resolve tc_val_pointer_nullval' : core.
 
 Arguments type_is_volatile ty / .
 
 Definition is_int32_noattr_type t :=
  match t with
- | Tint I32 _ {| attr_volatile := false; attr_alignas := None |} => True
- | _ => False
+ | Tint I32 _ {| attr_volatile := false; attr_alignas := None |} => True%type
+ | _ => False%type
  end.
 
 Lemma mapsto_mapsto_int32:
   forall sh t1 t2 p v,
    is_int32_noattr_type t1 ->
    is_int32_noattr_type t2 ->
-   mapsto sh t1 p v |-- mapsto sh t2 p v.
+   mapsto sh t1 p v ⊢ mapsto sh t2 p v.
 Proof.
 intros.
 destruct t1; try destruct i; try contradiction.
 destruct a as [ [ | ] [ | ] ]; try contradiction.
 destruct t2; try destruct i; try contradiction.
 destruct a as [ [ | ] [ | ] ]; try contradiction.
-apply derives_refl.
+done.
 Qed.
 
 Lemma mapsto_mapsto__int32:
   forall sh t1 t2 p v,
    is_int32_noattr_type t1 ->
    is_int32_noattr_type t2 ->
-   mapsto sh t1 p v |-- mapsto_ sh t2 p.
+   mapsto sh t1 p v ⊢ mapsto_ sh t2 p.
 Proof.
 intros.
 destruct t1; try destruct i; try contradiction.
@@ -1108,10 +785,10 @@ Proof.
  rewrite andb_false_r.
  hnf. simple_if_tac; auto.
 Qed.
-#[export] Hint Resolve tc_val_pointer_nullval : core.
+#[local] Hint Resolve tc_val_pointer_nullval : core.
 
 Lemma mapsto_tuint_tptr_nullval:
-  forall sh p t, mapsto sh (Tpointer t noattr) p nullval = mapsto sh size_t p nullval.
+  forall sh p t, mapsto sh (Tpointer t noattr) p nullval ⊣⊢ mapsto sh size_t p nullval.
 Proof.
 intros.
 unfold mapsto, size_t.
@@ -1119,57 +796,37 @@ destruct p; try reflexivity.
 destruct Archi.ptr64 eqn:Hp.
 *
 simpl access_mode; cbv beta iota.
-simpl type_is_volatile;  cbv beta iota.
-unfold Mptr; rewrite Hp. 
+simpl type_is_volatile; cbv beta iota.
+unfold Mptr; rewrite Hp.
 if_tac.
-rewrite !prop_true_andp by auto.
-f_equal.
-rewrite prop_true_andp; auto.
-unfold nullval;rewrite Hp; apply I.
-f_equal.
-f_equal.
-f_equal.
-apply prop_ext; split; intros _ _;
-unfold nullval; rewrite Hp; hnf; auto.
-simple_if_tac; simpl; rewrite Hp; auto.
+- by rewrite -> !(bi.pure_True (tc_val _ _)) by (by rewrite /nullval ?Hp).
+- apply bi.and_proper; last done.
+  apply bi.pure_iff.
+  rewrite /nullval Hp; split; intros [??]; split; try intros ?; done.
 *
 simpl access_mode; cbv beta iota.
-simpl type_is_volatile;  cbv beta iota.
-unfold Mptr; rewrite Hp. 
+simpl type_is_volatile; cbv beta iota.
+unfold Mptr; rewrite Hp.
 if_tac.
-rewrite !prop_true_andp by auto.
-f_equal.
-rewrite prop_true_andp; auto.
-unfold nullval;rewrite Hp; apply I.
-f_equal.
-f_equal.
-f_equal.
-apply prop_ext; split; intros _ _;
-unfold nullval; rewrite Hp; hnf; auto.
-simple_if_tac; simpl; rewrite Hp; auto.
+- by rewrite -> !(bi.pure_True (tc_val _ _)) by (by rewrite /nullval ?Hp).
+- apply bi.and_proper; last done.
+  apply bi.pure_iff.
+  rewrite /nullval Hp; split; intros [??]; split; try intros ?; done.
 Qed.
 
 Lemma mapsto_null_mapsto_pointer:
   forall t sh v,
    Archi.ptr64 = false -> 
-             mapsto sh (Tint I32 Signed noattr) v nullval =
+             mapsto sh (Tint I32 Signed noattr) v nullval ⊣⊢
              mapsto sh (Tpointer t noattr) v nullval.
 Proof.
   intros.
-  try solve [inversion H];
- (
-  unfold mapsto, nullval; rewrite H;
-  simpl;
-  destruct v; auto; f_equal; auto;
-  if_tac;
-   [f_equal; f_equal; rewrite andb_false_r;
-   unfold is_pointer_or_null; rewrite H;
-   apply pred_ext; unfold derives; simpl; tauto
-   | f_equal; f_equal;
-      unfold tc_val';
-      f_equal; simpl; 
-      simple_if_tac; simpl; rewrite H; auto;
-      apply prop_ext; intuition]).
+  unfold mapsto, nullval; rewrite H; simpl.
+  destruct v; auto.
+  if_tac; f_equiv; f_equiv; rewrite /Mptr ?H /=; auto.
+  - rewrite andb_false_r; iSplit; auto.
+  - unfold tc_val', tc_val; simpl.
+    rewrite andb_false_r /= H; tauto.
 Qed.
 
 Lemma repr_inj_unsigned:
@@ -1189,11 +846,10 @@ Qed.
 
 Lemma encode_nullval:
   encode_val (if Archi.ptr64 then Mint64 else Mint32) nullval
-= repeat (Memdata.Byte Byte.zero) (if Archi.ptr64 then 8 else 4).
+= repeat (Memdata.Byte Byte.zero) (if Archi.ptr64 then 8 else 4)%nat.
 Proof.
   cbv delta [nullval Archi.ptr64 encode_val encode_int rev_if_be] beta iota.
-  rewrite Tauto.if_same.
-  reflexivity.
+  simple_if_tac; reflexivity.
 Qed.
 
 Lemma decode_encode_nullval :
@@ -1201,501 +857,240 @@ Lemma decode_encode_nullval :
 Proof.
   rewrite encode_nullval.
   cbv delta [Archi.ptr64 repeat decode_val decode_int proj_bytes rev_if_be rev Mptr Archi.ptr64] iota beta zeta.
-  rewrite Tauto.if_same.
-  reflexivity.
+  simple_if_tac; reflexivity.
 Qed.
 
-Lemma mapsto_zeros_mapsto_nullval_aux:
-forall (sh : share) (b : block) (z : ptrofs) (t : type)
- (H2 : readable_share sh)
- (H : (align_chunk Mptr | Ptrofs.unsigned z)),
- address_mapsto_zeros sh (Z.to_nat (size_chunk Mptr)) (b, Ptrofs.unsigned z)
- |-- address_mapsto Mptr nullval sh (b, Ptrofs.unsigned z).
+Lemma address_mapsto_zeros'_address_mapsto:
+  forall sh ch b z,
+   (align_chunk ch | z) ->
+  (address_mapsto_zeros' (size_chunk ch) sh (b, z)
+   ⊢ address_mapsto ch (decode_val ch (repeat (Byte Byte.zero) (Z.to_nat (size_chunk ch)))) sh (b, z)).
 Proof.
-intros.
-unfold address_mapsto.
-apply exp_right with  (encode_val (if Archi.ptr64 then Mint64 else Mint32) nullval).
-rewrite prop_true_andp by (split3; simpl; [rewrite encode_nullval; reflexivity | exact decode_encode_nullval | auto]).
-forget (Ptrofs.unsigned z) as ofs; clear z.
-replace (encode_val (if Archi.ptr64 then Mint64 else Mint32) nullval)
- with (repeat (Byte Byte.zero) (size_chunk_nat Mptr))
- by (unfold size_chunk_nat, size_chunk, Mptr, encode_val, nullval; simpl; destruct Archi.ptr64; simpl;
-      change (Int64.unsigned Int64.zero) with 0;
-      change (Int.unsigned Int.zero) with 0;
-      unfold encode_int, inj_bytes; simpl; compute;
-      destruct Archi.big_endian; simpl; reflexivity).
-rewrite size_chunk_conv, Nat2Z.id.
-clear - H2. simpl snd.
-revert ofs; induction (size_chunk_nat Mptr); intros.
-*
-unfold address_mapsto_zeros.
-apply allp_right; intro y.
-rewrite jam_false.
-rewrite emp_no; apply allp_left with y; auto.
-simpl; destruct y; intros [? ?]; lia.
-*
-rewrite inj_S.
-simpl snd in *.
-rewrite allp_jam_split2 with 
-  (q := (fun loc : address =>
-              yesat NoneP
-                (VAL (nth (Z.to_nat (snd loc - ofs)) (repeat (Byte Byte.zero) (S n)) Undef)) sh loc))
-  (r := (fun loc : address =>
-              yesat NoneP
-                (VAL (nth (Z.to_nat (snd loc - ofs)) (repeat (Byte Byte.zero) (S n)) Undef)) sh loc))
-(Q_DEC := adr_range_dec (b,ofs) 1) (R_DEC := adr_range_dec ( b, Z.succ ofs) (Z.of_nat n)); auto.
-5:{ split; intros. destruct a; split; intros. destruct H; subst b0. destruct (zeq z ofs); [left|right]; split; auto; lia.
-     destruct H; destruct H; subst b0; split; auto; lia. destruct a; destruct H,H0; subst; lia. }
-simpl.
-apply sepcon_derives.
---
-clear IHn.
-unfold address_mapsto.
-apply exp_left; intro bl.
-apply prop_andp_left.
- intros [? ?].
-apply allp_derives; intro y.
-simpl.
-destruct H0.
-destruct bl; inv H. destruct bl; inv H4.
-destruct (adr_range_dec (b, ofs) 1 y).
-++
-rewrite !jam_true by auto.
-destruct y; destruct a; subst b0. assert (z=ofs) by lia. subst z.
-simpl snd. rewrite Z.sub_diag. simpl.
-replace m with (Byte Byte.zero); auto.
-clear - H0.
-destruct m; try discriminate.
-rewrite decode_byte_val in H0.
-apply Vint_inj in H0.
-f_equal.
-rewrite zero_ext_inrange in H0.
-unfold Int.zero in H0.
-apply repr_inj_unsigned in H0.
-apply (f_equal Byte.repr) in H0.
-rewrite Byte.repr_unsigned in H0. auto.
-pose proof (Byte.unsigned_range i). 
-change Byte.modulus with 256 in H.
-split; try lia.
-apply Z.le_trans with 256; try lia. compute; congruence.
-split. lia. compute; congruence.
-rewrite Int.unsigned_repr.
-pose proof (Byte.unsigned_range i).
-change Byte.modulus with 256 in H. simpl. lia.
-pose proof (Byte.unsigned_range i).
-assert (Byte.modulus < Int.max_unsigned) by reflexivity.
-lia.
-++
-rewrite !jam_false by auto.
-auto.
---
-eapply derives_trans.
-apply IHn.
-clear IHn.
-apply allp_derives; intros [b' ofs'].
-destruct (adr_range_dec (b, Z.succ ofs) (Z.of_nat n) (b',ofs')); [rewrite !jam_true | rewrite !jam_false]; auto.
- simpl snd.
-match goal with |- yesat _ (VAL ?A) _ _ |-- yesat _ (VAL ?B) _ _ => replace A with B; auto end.
-change (?A = ?B) with (nth (Z.to_nat (ofs' - ofs)) (repeat (Byte Byte.zero) (S n)) Undef = B).
-destruct a.
-subst b'.
-assert (0 <= ofs'- Z.succ ofs < Z.of_nat n) by lia.
-replace (ofs' - ofs) with (Z.succ (ofs'-Z.succ ofs)) by lia.
-clear - H.
-forget (ofs'-Z.succ ofs) as i.
-rewrite Z2Nat.inj_succ by lia.
-simpl. auto.
---
-eexists; apply is_resource_pred_YES_VAL'.
---
-eexists; apply is_resource_pred_YES_VAL'.
---
-eexists; apply is_resource_pred_YES_VAL'.
---
-intros.
-destruct H0.
-hnf in H0. rewrite H0 in H1.
-inv H1; auto.
+  intros.
+  iIntros "H".
+  rewrite /address_mapsto_zeros' /address_mapsto.
+  iExists (repeat (Byte Byte.zero) (size_chunk_nat ch)); iSplit.
+  { rewrite repeat_length; auto. }
+  rewrite (big_sepL_seq (repeat _ _)) repeat_length.
+  iApply (big_sepL_mono with "H"); intros ?? [??]%lookup_seq.
+  pose proof (@nth_In _ y (repeat (Byte Byte.zero) (size_chunk_nat ch)) inhabitant) as ->%repeat_spec; auto.
+  rewrite repeat_length; simpl in *; subst; auto.
+Qed.
+
+Lemma decode_mptr_zero_nullval :
+  decode_val Mptr (repeat (Byte Byte.zero) (size_chunk_nat Mptr)) = nullval.
+Proof.
+  cbv delta [repeat size_chunk_nat Z.to_nat size_chunk Mptr Archi.ptr64 Pos.to_nat Pos.iter_op Init.Nat.add] iota beta zeta.
+  cbv delta [decode_val decode_int proj_bytes rev_if_be rev] iota beta zeta.
+  simple_if_tac; reflexivity.
 Qed.
 
+Lemma address_mapsto_address_mapsto_zeros:
+  forall sh b z,
+  (align_chunk Mptr | z) ->
+  address_mapsto_zeros' (size_chunk Mptr) sh (b,z)
+  ⊢ res_predicates.address_mapsto Mptr nullval sh (b, z).
+Proof.
+  intros.
+  by rewrite -decode_mptr_zero_nullval address_mapsto_zeros'_address_mapsto; done.
+Qed.
 
 Lemma mapsto_zeros_mapsto_nullval:
   forall sh b z t,
       readable_share sh ->
       (align_chunk Mptr | Ptrofs.unsigned z) -> 
-      mapsto_zeros (size_chunk Mptr) sh (Vptr b z) |--
-      !! (0 <= Ptrofs.unsigned z /\ size_chunk Mptr + Ptrofs.unsigned z < Ptrofs.modulus) && mapsto sh (Tpointer t noattr) (Vptr b z) nullval.
+      mapsto_zeros (size_chunk Mptr) sh (Vptr b z) ⊢
+      ⌜0 <= Ptrofs.unsigned z /\ size_chunk Mptr + Ptrofs.unsigned z < Ptrofs.modulus⌝ ∧ mapsto sh (Tpointer t noattr) (Vptr b z) nullval.
 Proof.
-intros until t. intros H2 H.
-unfold mapsto_zeros, mapsto.
-simpl.
-rewrite andb_false_r by auto.
-rewrite (prop_true_andp (is_pointer_or_null _)) by auto.
-apply prop_andp_left; intros [? ?].
-rewrite prop_true_andp by  auto.
-rewrite if_true by auto.
-apply orp_right1.
-unfold address_mapsto.
-apply exp_right with  (encode_val (if Archi.ptr64 then Mint64 else Mint32) nullval).
-rewrite prop_true_andp by (split3; simpl; [rewrite encode_nullval; reflexivity | exact decode_encode_nullval | auto]).
-forget (Ptrofs.unsigned z) as ofs; clear z.
-replace (encode_val (if Archi.ptr64 then Mint64 else Mint32) nullval)
- with (repeat (Byte Byte.zero) (size_chunk_nat Mptr))
- by (unfold size_chunk_nat, size_chunk, Mptr, encode_val, nullval; simpl; destruct Archi.ptr64; simpl;
-      change (Int64.unsigned Int64.zero) with 0;
-      change (Int.unsigned Int.zero) with 0;
-      unfold encode_int, inj_bytes; simpl; compute;
-      destruct Archi.big_endian; simpl; reflexivity).
-rewrite size_chunk_conv, Nat2Z.id.
-clear - H2. simpl snd.
-revert ofs; induction (size_chunk_nat Mptr); intros.
-*
-unfold address_mapsto_zeros.
-apply allp_right; intro y.
-rewrite jam_false.
-rewrite emp_no; apply allp_left with y; auto.
-simpl; destruct y; intros [? ?]; lia.
-*
-rewrite inj_S.
-simpl snd in *.
-rewrite allp_jam_split2 with 
-  (q := (fun loc : address =>
-              yesat NoneP
-                (VAL (nth (Z.to_nat (snd loc - ofs)) (repeat (Byte Byte.zero) (S n)) Undef)) sh loc))
-  (r := (fun loc : address =>
-              yesat NoneP
-                (VAL (nth (Z.to_nat (snd loc - ofs)) (repeat (Byte Byte.zero) (S n)) Undef)) sh loc))
-(Q_DEC := adr_range_dec (b,ofs) 1) (R_DEC := adr_range_dec ( b, Z.succ ofs) (Z.of_nat n)); auto.
-5:{ split; intros. destruct a; split; intros. destruct H; subst b0. destruct (zeq z ofs); [left|right]; split; auto; lia.
-     destruct H; destruct H; subst b0; split; auto; lia. destruct a; destruct H,H0; subst; lia. }
-simpl.
-apply sepcon_derives.
---
-clear IHn.
-unfold address_mapsto.
-apply exp_left; intro bl.
-apply prop_andp_left.
- intros [? ?].
-apply allp_derives; intro y.
-simpl.
-destruct H0.
-destruct bl; inv H. destruct bl; inv H4.
-destruct (adr_range_dec (b, ofs) 1 y).
-++
-rewrite !jam_true by auto.
-destruct y; destruct a; subst b0. assert (z=ofs) by lia. subst z.
-simpl snd. rewrite Z.sub_diag. simpl.
-replace m with (Byte Byte.zero); auto.
-clear - H0.
-destruct m; try discriminate.
-rewrite decode_byte_val in H0.
-apply Vint_inj in H0.
-f_equal.
-rewrite zero_ext_inrange in H0.
-unfold Int.zero in H0.
-apply repr_inj_unsigned in H0.
-apply (f_equal Byte.repr) in H0.
-rewrite Byte.repr_unsigned in H0. auto.
-pose proof (Byte.unsigned_range i). 
-change Byte.modulus with 256 in H.
-split; try lia.
-apply Z.le_trans with 256; try lia. compute; congruence.
-split. lia. compute; congruence.
-rewrite Int.unsigned_repr.
-pose proof (Byte.unsigned_range i).
-change Byte.modulus with 256 in H. simpl. lia.
-pose proof (Byte.unsigned_range i).
-assert (Byte.modulus < Int.max_unsigned) by reflexivity.
-lia.
-++
-rewrite !jam_false by auto.
-auto.
---
-eapply derives_trans.
-apply IHn.
-clear IHn.
-apply allp_derives; intros [b' ofs'].
-destruct (adr_range_dec (b, Z.succ ofs) (Z.of_nat n) (b',ofs')); [rewrite !jam_true | rewrite !jam_false]; auto.
- simpl snd.
-match goal with |- yesat _ (VAL ?A) _ _ |-- yesat _ (VAL ?B) _ _ => replace A with B; auto end.
-change (?A = ?B) with (nth (Z.to_nat (ofs' - ofs)) (repeat (Byte Byte.zero) (S n)) Undef = B).
-destruct a.
-subst b'.
-assert (0 <= ofs'- Z.succ ofs < Z.of_nat n) by lia.
-replace (ofs' - ofs) with (Z.succ (ofs'-Z.succ ofs)) by lia.
-clear - H.
-forget (ofs'-Z.succ ofs) as i.
-rewrite Z2Nat.inj_succ by lia.
-simpl. auto.
---
-eexists; apply is_resource_pred_YES_VAL'.
---
-eexists; apply is_resource_pred_YES_VAL'.
---
-eexists; apply is_resource_pred_YES_VAL'.
---
-intros.
-destruct H0.
-hnf in H0. rewrite H0 in H1.
-inv H1; auto.
+  intros.
+  unfold mapsto_zeros, mapsto; simpl.
+  rewrite -> if_true by auto.
+  iIntros "[% H]"; iSplit; first done.
+  iLeft; simpl; iSplit.
+  { rewrite andb_false_r; auto. }
+  by rewrite address_mapsto_zeros_eq address_mapsto_address_mapsto_zeros.
+Qed.
+
+Lemma address_mapsto_zeros'_split:
+  forall a b sh p,
+ 0 <= a -> 0 <= b ->
+ address_mapsto_zeros' (a+b) sh p ⊣⊢
+ address_mapsto_zeros' a sh p 
+ ∗ address_mapsto_zeros' b sh (adr_add p a).
+Proof.
+  intros; rewrite /address_mapsto_zeros'.
+  rewrite -> Z2Nat.inj_add, seq_app by auto.
+  rewrite big_sepL_app Nat.add_0_l.
+  rewrite -{2}(Nat.add_0_r (Z.to_nat a)) -fmap_add_seq big_sepL_fmap.
+  apply bi.sep_proper; first done; apply big_sepL_proper; intros.
+  rewrite /adr_add /= Nat2Z.inj_add Z2Nat.id; auto.
+  by rewrite Z.add_assoc.
 Qed.
 
 Lemma address_mapsto_zeros_split {sh b}: forall n n1 n2 z (N:(n=n1+n2)%nat),
-      address_mapsto_zeros sh n (b,z) |--
-      address_mapsto_zeros sh n1 (b,z) *
+      address_mapsto_zeros sh n (b,z) ⊢
+      address_mapsto_zeros sh n1 (b,z) ∗
       address_mapsto_zeros sh n2 (b,Z.of_nat n1+z).
 Proof.
-induction n.
-+ simpl; intros. destruct n1; destruct n2; simpl; try lia. rewrite emp_sepcon; trivial.
-+ intros. simpl. destruct n1; simpl  in N.
-  - subst. simpl. rewrite emp_sepcon; trivial.
-  - inv N. rewrite Nat2Z.inj_succ. simpl. rewrite sepcon_assoc. 
-     apply sepcon_derives. trivial. 
-     eapply derives_trans. apply (IHn n1 n2). trivial.
-     replace (Z.of_nat n1 + Z.succ z) with (Z.succ (Z.of_nat n1) + z) by lia; trivial.
+  intros; subst; rewrite !address_mapsto_zeros_eq Nat2Z.inj_add address_mapsto_zeros'_split; try lia.
+  by rewrite /adr_add /= Z.add_comm.
 Qed.
 
 Lemma mapsto_zeros_split sh a n1 n2 (N1: 0 <= n1) (N2: 0<=n2):
-      mapsto_zeros (n1+n2) sh a |-- mapsto_zeros n1 sh a * mapsto_zeros n2 sh (offset_val n1 a).
-Proof. destruct a; simpl; try solve [ rewrite FF_sepcon; trivial]; intros m [H M]; simpl in H.
-rewrite Z2Nat.inj_add in M by lia.
-apply (address_mapsto_zeros_split (Z.to_nat n1 + Z.to_nat n2) (Z.to_nat n1) (Z.to_nat n2) _ (eq_refl _)) in M.
-destruct M as [m1 [m2 [J [M1 M2]]]].
-exists m1, m2; split3.
-+ trivial.
-+ split; [ simpl; lia | trivial].
-+ replace (Ptrofs.unsigned (Ptrofs.add i (Ptrofs.repr n1) )) with (Z.of_nat (Z.to_nat n1) + Ptrofs.unsigned i).
-  - split; [ simpl; lia | trivial]. 
-  - clear - H N1 N2. rewrite Z2Nat.id, Ptrofs.add_commut by trivial.
-    rewrite Ptrofs.add_unsigned. rewrite (Ptrofs.unsigned_repr n1); [| unfold Ptrofs.max_unsigned; lia].
-    rewrite Ptrofs.unsigned_repr; trivial. unfold Ptrofs.max_unsigned; lia.
+      mapsto_zeros (n1+n2) sh a ⊢ mapsto_zeros n1 sh a ∗ mapsto_zeros n2 sh (offset_val n1 a).
+Proof.
+  destruct a; simpl; try solve [rewrite bi.False_sep; trivial].
+  rewrite -> Z2Nat.inj_add by lia.
+  rewrite (address_mapsto_zeros_split (Z.to_nat n1 + Z.to_nat n2) (Z.to_nat n1) (Z.to_nat n2) _ (eq_refl _)).
+  rewrite -> Z2Nat.id by auto.
+  iIntros "(% & $ & ?)".
+  rewrite Ptrofs.add_unsigned Ptrofs.unsigned_repr Ptrofs.unsigned_repr; try solve [split; unfold Ptrofs.max_unsigned; lia].
+  rewrite {1}Z.add_comm; iFrame.
+  iPureIntro; repeat (split; auto); lia.
 Qed.
 
-Fixpoint sepconN N (P: val -> mpred) sz (p:val):mpred :=
+Fixpoint sepconN N (P: val -> mpred) sz (p: val): mpred :=
   match N with
-    O => emp
-  | S n => (P p * sepconN n P sz (offset_val sz p))
+  | O => emp
+  | S n => (P p ∗ sepconN n P sz (offset_val sz p))
   end.
 
+Lemma sepconN_big_sepL: forall N P sz p, isptr p ->
+  sepconN N P sz p ⊣⊢ [∗ list] i ∈ seq 0 N, P (offset_val (sz * Z.of_nat i) p).
+Proof.
+  induction N; simpl; auto; intros.
+  destruct p; try contradiction.
+  rewrite -fmap_S_seq big_sepL_fmap IHN; last done.
+  rewrite {3}/offset_val Z.mul_0_r Ptrofs.add_zero.
+  iApply bi.sep_proper; first done.
+  iApply big_sepL_proper; intros.
+  replace (offset_val _ (offset_val _ _)) with (offset_val (sz * Z.of_nat (S y)) (Vptr b i)); first done.
+  rewrite /offset_val /=.
+  rewrite Nat2Z.inj_succ Z.mul_succ_r Ptrofs.add_assoc; do 2 f_equal.
+  rewrite Ptrofs.add_unsigned.
+  apply Ptrofs.eqm_samerepr.
+  rewrite Z.add_comm; apply Ptrofs.eqm_add; apply Ptrofs.eqm_unsigned_repr.
+Qed.
+
 Lemma mapsto_zeros_mapsto_nullval_N {cenv sh b t}: forall N z,
        readable_share sh ->
        (align_chunk Mptr | Ptrofs.unsigned z) ->
        mapsto_zeros (Z.of_nat N * size_chunk Mptr) sh (Vptr b z)
-       |-- !! (0 <= Ptrofs.unsigned z /\
-               Z.of_nat N * size_chunk Mptr + Ptrofs.unsigned z < Ptrofs.modulus) &&
+       ⊢ ⌜0 <= Ptrofs.unsigned z /\
+               Z.of_nat N * size_chunk Mptr + Ptrofs.unsigned z < Ptrofs.modulus⌝ ∧
            sepconN N (fun p => mapsto sh (Tpointer t noattr) p nullval)
                      (@sizeof cenv (Tpointer t noattr)) (Vptr b z).
 Proof.
   induction N; intros; trivial. remember (size_chunk Mptr) as sz.
   replace (Z.of_nat (S N) * sz)%Z with (sz + Z.of_nat N * sz)%Z by lia.
   specialize (size_chunk_pos Mptr); intros. specialize (Z_of_nat_ge_O N); intros.
-  eapply derives_trans. apply mapsto_zeros_split; subst; try first [lia | apply Z.mul_nonneg_nonneg; lia].
-  apply andp_right.
-  { clear IHN. intros m [m1 [m2 [J [[M1 _] [[M2a M2b] _]]]]]; simpl in *.
-    split; try lia. rewrite Ptrofs.add_unsigned in M2b, M2a.
-    rewrite (Ptrofs.unsigned_repr sz), Ptrofs.unsigned_repr in M2b, M2a; try lia.
-    all: subst; unfold size_chunk, Mptr in *; simple_if_tac; unfold Ptrofs.max_unsigned; try lia. }
-  subst sz.
-  eapply derives_trans.
-  + eapply sepcon_derives.
-    - apply mapsto_zeros_mapsto_nullval; trivial.
-    - apply derives_refl.
-  + rewrite sepcon_andp_prop1. apply prop_andp_left; intros.
-    simpl sepconN. apply sepcon_derives. apply derives_refl.
-    replace (offset_val (size_chunk Mptr) (Vptr b z)) with (Vptr b (Ptrofs.add z (Ptrofs.repr (if Archi.ptr64 then 8 else 4)))).
-    - eapply derives_trans. apply IHN; trivial.
-      { clear IHN. rewrite Ptrofs.add_unsigned.
-        rewrite (Ptrofs.unsigned_repr (if Archi.ptr64 then 8 else 4)).
-        + rewrite Ptrofs.unsigned_repr.
-          - apply Z.divide_add_r; trivial. unfold align_chunk, Mptr. simple_if_tac; apply Z.divide_refl.
-          - unfold size_chunk, Mptr in H3. simple_if_tac; unfold Ptrofs.max_unsigned; lia.
-       + unfold size_chunk, Mptr in H3. simple_if_tac; unfold Ptrofs.max_unsigned; lia. }
-      apply andp_left2; trivial.
-    - simpl. unfold Mptr. destruct Archi.ptr64; simpl; trivial.
+  rewrite mapsto_zeros_split; subst; try first [lia | apply Z.mul_nonneg_nonneg; lia].
+  simpl sepconN; rewrite -> mapsto_zeros_mapsto_nullval by trivial.
+  iIntros "[[% $] [%Hz ?]]".
+  assert (Ptrofs.unsigned (Ptrofs.add z (Ptrofs.repr (size_chunk Mptr))) = Ptrofs.unsigned z + size_chunk Mptr) as Heq.
+  { rewrite Ptrofs.add_unsigned !Ptrofs.unsigned_repr; unfold Ptrofs.max_unsigned; lia. }
+  rewrite -(bi.True_and (address_mapsto_zeros _ _ _)) -bi.pure_True; last apply Hz.
+  iSplit; [|iDestruct (IHN with "[$]") as "[_ $]"; first done].
+  - rewrite Heq in Hz; iPureIntro; repeat split; auto; lia.
+  - rewrite Heq. by apply Z.divide_add_r, Z.divide_refl.
 Qed.
 
-Lemma address_mapsto_zeros'_split:
-  forall a b sh p,
- 0<=a -> 0 <= b -> 
- mapsto_memory_block.address_mapsto_zeros' (a+b) sh p =
- mapsto_memory_block.address_mapsto_zeros' a sh p 
- * mapsto_memory_block.address_mapsto_zeros' b sh (adr_add p a).
+Lemma address_mapsto_zeros'_nonlock_permission_bytes:
+  forall n sh a,
+  address_mapsto_zeros' n sh a ⊢ res_predicates.nonlock_permission_bytes sh a n.
 Proof.
-intros.
-unfold address_mapsto_zeros'.
-rewrite !Z.max_l by lia.
-apply allp_jam_split2; auto.
-exists (fun (r : resource) (_ : address) (_ : nat) =>
-        exists (b0 : memval) (rsh : readable_share sh),
-          r =
-          YES sh rsh (VAL (Byte Byte.zero))
-            (SomeP (rmaps.ConstType unit) (fun _ : list Type => tt))).
-hnf; intros.
-unfold yesat.
-simpl.
-apply prop_ext; split; intro.
-destruct H1. exists (Byte Byte.zero). exists x. auto.
-destruct H1. auto.
-exists (fun (r : resource) (_ : address) (_ : nat) =>
-        exists (b0 : memval) (rsh : readable_share sh),
-          r =
-          YES sh rsh (VAL (Byte Byte.zero))
-            (SomeP (rmaps.ConstType unit) (fun _ : list Type => tt))).
-hnf; intros.
-unfold yesat.
-simpl.
-apply prop_ext; split; intro.
-destruct H1. exists (Byte Byte.zero). exists x. auto.
-destruct H1. auto.
-exists (fun (r : resource) (_ : address) (_ : nat) =>
-        exists (b0 : memval) (rsh : readable_share sh),
-          r =
-          YES sh rsh (VAL (Byte Byte.zero))
-            (SomeP (rmaps.ConstType unit) (fun _ : list Type => tt))).
-hnf; intros.
-unfold yesat.
-simpl.
-apply prop_ext; split; intro.
-destruct H1. exists (Byte Byte.zero). exists x. auto.
-destruct H1. auto.
-split. intros q.
-split; intro.
-destruct (zlt (snd q) (snd p + a)); [left|right].
-hnf in H1|-*. destruct p,q. simpl in *. lia.
-hnf in H1|-*. destruct p,q. simpl in *. lia.
-hnf in H1|-*. destruct p,q. simpl in *. lia.
-intros q ?.
-hnf in H1|-*. destruct p,q. simpl in *. lia.
-intros.
-hnf in H2.
-destruct H2.
-hnf in H2.
-rewrite H2 in H3.
-inv H3. auto.
+  intros; rewrite /address_mapsto_zeros' /nonlock_permission_bytes.
+  apply big_sepL_mono; intros.
+  iIntros "H".
+  iDestruct (mapsto_valid with "H") as %[??].
+  rewrite if_true; last done.
+  iExists (VAL (Byte Byte.zero)); auto.
 Qed.
 
-Lemma decode_mptr_zero_nullval :
-  decode_val Mptr (repeat (Byte Byte.zero) (size_chunk_nat Mptr)) = nullval.
+Lemma mapsto_core_load: forall t ch sh v b o, access_mode t = By_value ch -> readable_share sh ->
+  v <> Vundef ->
+  mapsto sh t (Vptr b o) v ⊢ core_load ch (b, Ptrofs.unsigned o) v.
 Proof.
-  cbv delta [repeat size_chunk_nat Z.to_nat size_chunk Mptr Archi.ptr64 Pos.to_nat Pos.iter_op Init.Nat.add] iota beta zeta.
-  cbv delta [decode_val decode_int proj_bytes rev_if_be rev] iota beta zeta.
-  rewrite Tauto.if_same.
-  reflexivity.
+  unfold mapsto.
+  intros; rewrite H.
+  iIntros "H".
+  destruct (type_is_volatile t); try done.
+  rewrite -> if_true by auto.
+  iDestruct "H" as "[(% & H) | (% & % & H)]"; try done; by iApply (mapsto_core_load with "H").
 Qed.
 
-Lemma address_mapsto_address_mapsto_zeros:
-  forall sh b z, 
-  (align_chunk Mptr | z) ->
-  mapsto_memory_block.address_mapsto_zeros' (size_chunk Mptr) sh (b,z)
-  |-- res_predicates.address_mapsto Mptr nullval sh (b, z).
+(* Timeless *)
+(* up? *)
+Lemma big_sepL_timeless' {A} (f : nat -> A -> mpred) l `(∀ k v, Timeless (f k v)) : l ≠ [] -> Timeless ([∗ list] k↦v ∈ l, f k v).
 Proof.
-intros.
-rename H into Halign.
-intros ? ?.
-hnf in H|-*.
-exists (repeat (Byte Byte.zero) (size_chunk_nat Mptr)).
-split.
-split3; [reflexivity | exact decode_mptr_zero_nullval | auto].
-auto.
-intros y. specialize (H y).
-rewrite Z.max_l in H by (pose proof (size_chunk_pos Mptr); lia).
-hnf in H|-*.
-if_tac; auto.
-replace (VAL _) with (VAL (Byte Byte.zero)); auto.
-f_equal.
-simpl.
-destruct y.
-destruct H0.
-subst b0.
-rewrite size_chunk_conv in H1.
-simpl.
-forget (size_chunk_nat Mptr) as n.
-clear b H.
-forget (Byte Byte.zero) as b.
-assert (Z.to_nat (z0-z) < n)%nat by lia.
-forget (Z.to_nat (z0-z)) as i.
-clear - H.
-revert i H; induction n; intros; auto.
-lia.
-destruct i.
-simpl. auto.
-simpl.
-apply IHn. lia.
+  generalize dependent f; induction l; first done; simpl; intros.
+  destruct l.
+  - rewrite /= right_id //.
+  - apply bi.sep_timeless; first done.
+    by apply IHl.
 Qed.
 
-Lemma address_mapsto_zeros'_address_mapsto:
-  forall sh ch b i, 
-   (align_chunk ch | Ptrofs.unsigned i) ->
-  (address_mapsto_zeros' (size_chunk ch) sh (b, Ptrofs.unsigned i)
-   |-- address_mapsto ch (decode_val ch (repeat (Byte Byte.zero) (Z.to_nat (size_chunk ch)))) sh (b, Ptrofs.unsigned i)).
+Global Instance mapsto_val_timeless l dq v : Timeless (l ↦{dq} VAL v).
 Proof.
-intros.
-rename H into Halign.
-intros ? ?.
-hnf in H|-*.
-exists (repeat (Byte Byte.zero) (size_chunk_nat ch)).
-split.
-split3; auto.
-rewrite repeat_length; auto.
-intros y. specialize (H y).
-rewrite Z.max_l in H by (pose proof (size_chunk_pos ch); lia).
-hnf in H|-*.
-if_tac; auto.
-replace (VAL _) with (VAL (Byte Byte.zero)); auto.
-f_equal.
-simpl.
-destruct y.
-destruct H0.
-subst b0.
-rewrite size_chunk_conv in H1.
-simpl.
-forget (size_chunk_nat Mptr) as n.
-clear b H.
-forget (Byte Byte.zero) as b.
-assert (Z.to_nat (z-Ptrofs.unsigned i) < size_chunk_nat ch)%nat by lia.
-forget (Z.to_nat (z-Ptrofs.unsigned i)) as j.
-clear - H.
-revert j H; induction (size_chunk_nat ch); intros; auto.
-lia.
-destruct j.
-simpl. auto.
-simpl.
-apply IHn. lia.
+  rewrite gen_heap.mapsto_unseal /gen_heap.mapsto_def.
+  rewrite resource_map.resource_map_elem_unseal /resource_map.resource_map_elem_def.
+  apply _.
+Qed.
+
+Global Instance mapsto_no_timeless l dq : Timeless (mapsto_no l dq).
+Proof.
+  rewrite gen_heap.mapsto_no_unseal /gen_heap.mapsto_no_def.
+  rewrite resource_map.resource_map_elem_no_unseal /resource_map.resource_map_elem_no_def.
+  apply _.
 Qed.
 
+Global Instance address_mapsto_timeless ch v sh l : Timeless (address_mapsto ch v sh l).
+Proof.
+  rewrite /address_mapsto.
+  apply bi.exist_timeless; intros.
+  rewrite /Timeless.
+  rewrite bi.later_and; iIntros "(>(% & % & %) & H)".
+  iSplit; first done.
+  iApply (timeless with "H").
+  apply big_sepL_timeless'; first apply _.
+  destruct (size_chunk_nat_pos ch); destruct x; try done; simpl in *; lia.
+Qed.
 
-Lemma address_mapsto_zeros'_nonlock_permission_bytes:
-  forall n sh a, 
-  mapsto_memory_block.address_mapsto_zeros' n sh a
-|-- res_predicates.nonlock_permission_bytes sh a n.
+Global Instance mapsto_timeless sh t v1 v2 : Timeless (mapsto sh t v1 v2).
 Proof.
-intros.
-destruct a.
-destruct (zlt n 0).
--
-unfold address_mapsto_zeros', nonlock_permission_bytes.
-apply allp_derives; intros [? ?].
-rewrite !jam_false; auto.
-intros [? ?]; lia.
-intros [? ?]; lia.
--
-rewrite <- (Z2Nat.id n) by lia.
-forget (Z.to_nat n) as k.
-clear n g.
-unfold address_mapsto_zeros', nonlock_permission_bytes.
-apply allp_derives; intro y.
-replace (Z.max (Z.of_nat k) 0) with (Z.of_nat k) by lia.
-destruct y.
-destruct (adr_range_dec (b,z) (Z.of_nat k) (b0,z0)).
-rewrite !jam_true by auto.
-intros ? ?.
-destruct H.
-simpl in *.
-rewrite H.
-simpl.
-tauto.
-rewrite !jam_false by auto.
-auto.
+  rewrite /mapsto.
+  destruct (access_mode t); try apply _.
+  destruct (type_is_volatile t); try apply _.
+  destruct v1; try apply _.
+  if_tac; try apply _.
+  rewrite /nonlock_permission_bytes.
+  apply bi.and_timeless; first apply _.
+  apply big_sepL_timeless'.
+  intros; if_tac; try apply _.
+  apply bi.exist_timeless; intros; apply bi.and_timeless; try apply _.
+  apply mapsto_timeless; done.
+  { destruct (Z.to_nat _) eqn: Hn; try done.
+    pose proof (size_chunk_pos m); lia. }
 Qed.
 
+Lemma memory_block'_timeless sh n b o : (n > 0)%nat -> Timeless (memory_block' sh n b o).
+Proof.
+  revert o; induction n; simpl; first lia; intros.
+  destruct (gt_dec n O).
+  - apply bi.sep_timeless; [apply _ | eauto].
+  - replace n with O by lia; rewrite bi.sep_emp; apply _.
+Qed.
 
+Lemma memory_block_timeless sh z p : z > 0 -> Timeless (memory_block sh z p).
+Proof.
+  intros.
+  destruct p; simpl; try apply _.
+  apply bi.and_timeless; first apply _.
+  apply memory_block'_timeless; lia.
+Qed.
+
+End mpred.
+
+#[export] Hint Resolve is_pointer_or_null_nullval : core.
+#[export] Hint Resolve tc_val_pointer_nullval' : core.
+#[export] Hint Resolve tc_val_pointer_nullval : core.
diff --git a/veric/mem_lessdef.v b/veric/mem_lessdef.v
index 70994aa9f6..c7983fae2e 100644
--- a/veric/mem_lessdef.v
+++ b/veric/mem_lessdef.v
@@ -8,15 +8,14 @@ Require Import compcert.common.Values.
 
 Require Import VST.msl.Coqlib2.
 Require Import VST.msl.eq_dec.
-Require Import VST.msl.seplog.
 Require Import VST.veric.Memory.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.juicy_mem.
-
 Require Import VST.veric.res_predicates.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 
 (*Lenb: Should Imports from sepcomp really be here?*)
 Require Import VST.sepcomp.extspec.
-Import compcert.lib.Maps.
 
 (*Require Import VST.sepcomp.event_semantics.
 Require Import VST.sepcomp.extspec.*)
@@ -60,8 +59,8 @@ Proof.
     { rewrite E; tauto. } clear E.
     specialize (S b ofs k). revert S.
     unfold access_at, Mem.perm. simpl.
-    set (o1 := (Mem.mem_access _) !! b ofs k).
-    set (o2 := (Mem.mem_access _) !! b ofs k). clearbody o1 o2. intros S.
+    set (o1 := (Maps.PMap.get b (Mem.mem_access _) ofs k)).
+    set (o2 := (Maps.PMap.get b (Mem.mem_access _) ofs k)). clearbody o1 o2. intros S.
     assert (S' : forall o, Mem.perm_order'' o1 o <-> Mem.perm_order'' o2 o).
     { intros [ o | ]. apply S. destruct o1 as [o1 | ], o2 as [o2 | ]; split; intro; constructor. }
     clear S.
@@ -88,7 +87,7 @@ Proof.
     unfold Mem.loadbytes in *.
     apply equal_f with (x := b) in E.
     apply equal_f with (x := ofs) in E.
-    apply equal_f with (x := 1) in E.
+    apply equal_f with (x := 1%Z) in E.
     unfold access_at in *.
     if_tac [p1|np1] in E; if_tac in E; try discriminate.
     + simpl in E.
@@ -193,7 +192,7 @@ Proof.
     f_equal; auto.
     apply memval_lessdef_antisym; auto.
   - repeat extensionality.
-    apply prop_ext; split; auto.
+    apply Axioms.prop_ext; split; auto.
   - zify.
     cut (Z.pos (Mem.nextblock m2) = Z.pos (Mem.nextblock m1)).
     congruence. lia.
@@ -291,7 +290,7 @@ Lemma mem_lessdef_weak_valid_pointer:
 Proof.
 intros.
 unfold Mem.weak_valid_pointer in *.
-rewrite orb_true_iff in *.
+rewrite -> orb_true_iff in *.
 destruct H0; [left|right]; eapply mem_lessdef_valid_pointer; eauto.
 Qed.
 
@@ -446,12 +445,13 @@ Proof.
   rewrite (valid_pointer_lessalloc M); trivial.
 Qed.
 
-
+(*
 Definition juicy_mem_equiv jm1 jm2 := mem_equiv (m_dry jm1) (m_dry jm2) /\ m_phi jm1 = m_phi jm2.
 
 Definition juicy_mem_lessdef jm1 jm2 := mem_lessdef (m_dry jm1) (m_dry jm2) /\ m_phi jm1 = m_phi jm2.
 
 Definition juicy_mem_lessalloc jm1 jm2 := mem_lessdef (m_dry jm1) (m_dry jm2) /\ m_phi jm1 = m_phi jm2.
+*)
 
 Ltac sync D :=
   first
@@ -597,6 +597,27 @@ Proof.
   f_equal; apply proof_irr.
 Qed.
 
+(* There are plenty of other orders on memories, but they're all either
+   way too general (Mem.extends, mem_lessdef) or way too restrictive (mem_lessalloc). *)
+Definition mem_sub m1 m2 := Mem.mem_contents m1 = Mem.mem_contents m2 /\ Mem.nextblock m1 = Mem.nextblock m2 /\
+  forall b ofs k p, Mem.perm m1 b ofs k p -> Mem.perm m2 b ofs k p.
+
+Lemma mem_sub_valid_pointer : forall m1 m2 b ofs, mem_sub m1 m2 -> Mem.valid_pointer m1 b ofs = true ->
+  Mem.valid_pointer m2 b ofs = true.
+Proof.
+  unfold mem_sub, Mem.valid_pointer; intros.
+  destruct H as (_ & _ & Hp).
+  destruct (Mem.perm_dec m1 _ _ _ _); inv H0.
+  destruct (Mem.perm_dec m2 _ _ _ _); auto.
+Qed.
+
+Lemma mem_sub_weak_valid_pointer : forall m1 m2 b ofs, mem_sub m1 m2 -> Mem.weak_valid_pointer m1 b ofs = true ->
+  Mem.weak_valid_pointer m2 b ofs = true.
+Proof.
+  unfold Mem.weak_valid_pointer; intros.
+  apply orb_true_iff in H0 as [Hp | Hp]; rewrite -> (mem_sub_valid_pointer _ _ _ _ H Hp), ?orb_true_r; auto.
+Qed.
+
 (* relationships between memory orders *)
 Lemma mem_sub_loadbytes : forall m1 m2 b ofs len v, mem_sub m1 m2 ->
   Mem.loadbytes m1 b ofs len = Some v -> Mem.loadbytes m2 b ofs len = Some v.
diff --git a/veric/mpred.v b/veric/mpred.v
index 273522add3..f9b8ffc39f 100644
--- a/veric/mpred.v
+++ b/veric/mpred.v
@@ -1,14 +1,17 @@
+From iris.bi Require Export monpred.
 Require Import VST.veric.base.
-Require Import VST.veric.rmaps.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Import iris_ora.algebra.gmap_view.
+Require Import VST.veric.res_predicates.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
+Require Export compcert.common.AST.
 Require Export compcert.cfrontend.Ctypes.
-Require Import VST.veric.compcert_rmaps.
 
 Require Import VST.veric.composite_compute.
 Require Import VST.veric.align_mem.
 Require Import VST.veric.val_lemmas.
 
 Require Export VST.veric.compspecs.
-Import compcert.lib.Maps.
 
 Open Scope Z_scope.
 
@@ -45,8 +48,9 @@ Definition type_is_by_reference t : bool :=
 (** GENERAL KV-Maps **)
 
 Set Implicit Arguments.
+
 Module Map. Section map.
-Variables (B : Type).
+Context (B : Type).
 
 Definition t := positive -> option B.
 
@@ -102,10 +106,21 @@ Qed.
 
 End map.
 
-
 End Map.
+
 Unset Implicit Arguments.
 
+Global Instance EqDec_calling_convention: EqDec calling_convention.
+Proof.
+  hnf. decide equality.
+  destruct cc_structret, cc_structret0; subst; try tauto; right; congruence.
+  destruct cc_unproto, cc_unproto0;  subst; try tauto; right; congruence.
+  destruct cc_vararg, cc_vararg0; subst; try tauto.
+  destruct (zeq z0 z); subst; [left|right]; congruence.
+  right; congruence.
+  right; congruence.
+Qed.
+
 (** Environment Definitions **)
 Section FUNSPEC.
 
@@ -130,61 +145,17 @@ Definition te_of (rho: environ) : tenviron :=
 Definition any_environ : environ :=
   mkEnviron (fun _ => None)  (Map.empty _) (Map.empty _).
 
-Definition mpred := pred rmap.
-
 Definition argsEnviron:Type := genviron * (list val).
 
-Definition AssertTT (A: TypeTree): TypeTree :=
-  ArrowType A (ArrowType (ConstType environ) Mpred).
-
-Definition ArgsTT (A: TypeTree): TypeTree :=
-  ArrowType A (ArrowType (ConstType argsEnviron) Mpred).
-
-Definition SpecTT (A: TypeTree): TypeTree :=
-  ArrowType A (ArrowType (ConstType bool) (ArrowType (ConstType environ) Mpred)).
-
-Definition SpecArgsTT (A: TypeTree): TypeTree :=
-  ArrowType A 
-  (PiType bool (fun b => ArrowType (ConstType 
-                                         (if b 
-                                          then argsEnviron
-                                          else environ))
-                                    Mpred)).
-
-Definition super_non_expansive {A: TypeTree}
-  (P: forall ts, dependent_type_functor_rec ts (AssertTT A) mpred): Prop :=
-  forall n ts
-    (x: functors.MixVariantFunctor._functor
-                         (rmaps.dependent_type_functor_rec ts A) mpred)
-    (rho: environ),
-  approx n (P ts x rho) = approx n (P ts (fmap _ (approx n) (approx n) x) rho).
-
-Definition args_super_non_expansive {A: TypeTree}
-  (P: forall ts, dependent_type_functor_rec ts (ArgsTT A) mpred): Prop :=
-  forall n ts
-    (x: functors.MixVariantFunctor._functor
-                         (rmaps.dependent_type_functor_rec ts A) mpred)
-    (gargs: argsEnviron),
-  @eq mpred (approx n (P ts x gargs)) (approx n (P ts (fmap _ (approx n) (approx n) x) gargs)).
-
-Definition const_super_non_expansive: forall (T: Type) P,
-  @super_non_expansive (ConstType T) P :=
-  fun _ _ _ _ _ _ => eq_refl.
-
-Definition AssertListTT (A: TypeTree): TypeTree :=
-  ArrowType A (ArrowType (ConstType environ) (ListType Mpred)).
-
-Definition super_non_expansive_list {A: TypeTree}
-  (P: forall ts, dependent_type_functor_rec ts (AssertListTT A) mpred): Prop :=
-  forall n ts
-    (x: functors.MixVariantFunctor._functor
-                         (rmaps.dependent_type_functor_rec ts A) mpred)
-    (rho: environ),
-  Forall2 (fun a b => approx n a = approx n b) (P ts x rho) (P ts (fmap _ (approx n) (approx n) x) rho).
-
-Definition args_const_super_non_expansive: forall (T: Type) P,
-  @args_super_non_expansive (ConstType T) P :=
-  fun _ _ _ _ _ _ => eq_refl.
+Global Instance EqDec_type: EqDec type := type_eq.
+
+Definition funsig := (list (ident*type) * type)%type. (* argument and result signature *)
+
+Definition typesig := (list type * type)%type. (*funsig without the identifiers*)
+
+Definition typesig_of_funsig (f:funsig):typesig := (map snd (fst f), snd f).
+
+Context {Σ : gFunctors}.
 
 (*Potential alternative that does not use Ctypes
 Inductive funspec :=
@@ -194,30 +165,307 @@ Inductive funspec :=
     funspec.
  *)
 
-Inductive funspec :=
-   mk_funspec: typesig -> calling_convention -> forall (A: TypeTree)
-     (P: forall ts, dependent_type_functor_rec ts (ArgsTT A) mpred)
-     (Q: forall ts, dependent_type_functor_rec ts (AssertTT A) mpred)
-     (P_ne: args_super_non_expansive P) (Q_ne: super_non_expansive Q),
-     funspec.
+Section funspec.
+
+(* funspecs are effectively dependent pairs of an algebra and a pair of assertions on that algebra.
+   This means we have to take some care to define them in a way that avoids universe inconsistencies. *)
+
+(* Reify the type of the funspec's WITH clause. *)
+Inductive TypeTree: Type :=
+  | ConstType: Type -> TypeTree
+  | CompspecsType: TypeTree
+  | Mpred: TypeTree
+(*  | DependentType: nat -> TypeTree *)
+  | ProdType: TypeTree -> TypeTree -> TypeTree
+  | DiscreteFunType: Type -> TypeTree -> TypeTree
+  | ArrowType: TypeTree -> TypeTree -> TypeTree
+  | SigType: forall (I : Type), (I -> TypeTree) -> TypeTree
+(*  | PiType: forall (I : Type), (I -> TypeTree) -> TypeTree*)
+  | ListType: TypeTree -> TypeTree.
+
+Fixpoint dependent_type_functor_rec (T : TypeTree) : oFunctor :=
+  match T with
+  | ConstType t => constOF (leibnizO t)
+  | CompspecsType => constOF (leibnizO compspecs)
+  | Mpred => idOF
+  | ProdType a b => dependent_type_functor_rec a * dependent_type_functor_rec b
+  | DiscreteFunType a b => a -d> dependent_type_functor_rec b
+  | ArrowType a b => dependent_type_functor_rec a -n> dependent_type_functor_rec b
+  | SigType _ f => sigTOF (fun i => dependent_type_functor_rec (f i))
+  | ListType t => listOF (dependent_type_functor_rec t)
+  end.
 
-Definition varspecs : Type := list (ident * type).
+Definition ArgsTT A := ArrowType A (DiscreteFunType argsEnviron Mpred).
+Definition AssertTT A := ArrowType A (DiscreteFunType environ Mpred).
+Definition MaskTT A := ArrowType A (ConstType coPset).
+
+Section ofe.
+
+Context `{Cofe PROP1} `{Cofe PROP2}.
+
+Inductive funspec_ :=
+   mk_funspec (sig : typesig) (cc : calling_convention) (A: TypeTree)
+     (E: oFunctor_car (dependent_type_functor_rec (MaskTT A)) PROP1 PROP2)
+     (P: oFunctor_car (dependent_type_functor_rec (ArgsTT A)) PROP1 PROP2)
+     (Q: oFunctor_car (dependent_type_functor_rec (AssertTT A)) PROP1 PROP2).
+
+Import EqNotations.
+
+Lemma E_eq : forall {A1 A2}, A1 = A2 ->
+  oFunctor_car (dependent_type_functor_rec (MaskTT A1)) PROP1 PROP2 = oFunctor_car (dependent_type_functor_rec (MaskTT A2)) PROP1 PROP2.
+Proof.
+  by intros ?? ->.
+Defined.
+
+Lemma pre_eq : forall {A1 A2}, A1 = A2 ->
+  oFunctor_car (dependent_type_functor_rec (ArgsTT A1)) PROP1 PROP2 = oFunctor_car (dependent_type_functor_rec (ArgsTT A2)) PROP1 PROP2.
+Proof.
+  by intros ?? ->.
+Defined.
+
+Lemma post_eq : forall {A1 A2}, A1 = A2 ->
+  oFunctor_car (dependent_type_functor_rec (AssertTT A1)) PROP1 PROP2 = oFunctor_car (dependent_type_functor_rec (AssertTT A2)) PROP1 PROP2.
+Proof.
+  by intros ?? ->.
+Defined.
+
+Local Instance funspec_dist : Dist funspec_ := λ n f1 f2,
+  match f1, f2 with
+  | mk_funspec sig1 cc1 A1 E1 P1 Q1, mk_funspec sig2 cc2 A2 E2 P2 Q2 =>
+      sig1 = sig2 /\ cc1 = cc2 /\ ∃ H : A1 = A2, rew (E_eq H) in E1 ≡{n}≡ E2 /\ rew (pre_eq H) in P1 ≡{n}≡ P2 /\ rew (post_eq H) in Q1 ≡{n}≡ Q2
+  end.
 
-Definition funspecs := list (ident * funspec).
+Local Instance funspec_equiv : Equiv funspec_ := λ f1 f2, forall n, f1 ≡{n}≡ f2.
+
+Global Instance mk_funspec_proper sig cc A : Proper (equiv ==> equiv ==> equiv ==> equiv) (mk_funspec sig cc A).
+Proof.
+  repeat (split; first done).
+  exists eq_refl; eauto.
+Qed.
+
+Global Instance mk_funspec_ne sig cc A : NonExpansive3 (mk_funspec sig cc A).
+Proof.
+  intros ??????????.
+  repeat (split; first done).
+  by exists eq_refl.
+Qed.
+
+Lemma funspec_ofe_mixin : OfeMixin funspec_.
+Proof.
+  split; try done.
+  - split.
+    + intros []; repeat (split; auto).
+      exists eq_refl; done.
+    + intros [] [] (-> & -> & -> & ? & ? & ?). repeat (split; auto).
+      exists eq_refl; done.
+    + intros [] [] [] (-> & -> & -> & ? & ? & ?) (-> & -> & -> & ? & ? & ?); repeat (split; auto).
+      exists eq_refl; split3; etrans; eauto.
+  - intros ?? [] [] (-> & -> & -> & ? & ? & ?) ?; repeat (split; auto).
+    exists eq_refl; split3; eapply dist_lt; eauto.
+Qed.
+Canonical Structure funspecO := Ofe funspec_ funspec_ofe_mixin.
+
+End ofe.
+Global Arguments funspec_ _ {_} _ {_}.
+Global Arguments funspecO _ {_} _ {_}.
+
+Section ofunctor.
+
+Program Definition funspecOF (PF : oFunctor) `{forall (A : ofe) (HA : Cofe A) (B : ofe) (HB : Cofe B), Cofe (oFunctor_car PF A B)} : oFunctor := {|
+    oFunctor_car A CA B CB := funspecO (oFunctor_car PF B A) (oFunctor_car PF A B);
+    oFunctor_map A1 _ A2 _ B1 _ B2 _ fg := λne f, match f with mk_funspec sig cc A E P Q =>
+      mk_funspec sig cc A (oFunctor_map (oFunctor_oFunctor_compose (dependent_type_functor_rec (MaskTT A)) PF) fg E)
+                          (oFunctor_map (oFunctor_oFunctor_compose (dependent_type_functor_rec (ArgsTT A)) PF) fg P)
+                          (oFunctor_map (oFunctor_oFunctor_compose (dependent_type_functor_rec (AssertTT A)) PF) fg Q) end
+  |}.
+Next Obligation.
+Proof.
+  intros. intros [] [].
+  intros (<- & <- & <- & ? & HP & HQ); repeat split; auto.
+  exists eq_refl; split3; by apply ofe_mor_map_ne.
+Qed.
+Next Obligation.
+Proof.
+  intros. intros fg fg' Hfg [].
+  repeat split; auto.
+  exists eq_refl; split3; rewrite /eq_rect /E_eq /pre_eq /post_eq /eq_ind_r /eq_ind /eq_sym; (apply ofe_mor_car_ne; [f_equiv|]; done).
+Qed.
+Next Obligation.
+  intros. destruct x.
+  repeat split; auto.
+  exists eq_refl; split3; apply equiv_dist; rewrite /eq_rect /E_eq /pre_eq /post_eq /eq_ind_r /eq_ind /eq_sym oFunctor_map_id //.
+Qed.
+Next Obligation.
+  intros. destruct x.
+  repeat split; auto.
+  exists eq_refl; split3; apply equiv_dist; rewrite /eq_rect /E_eq /pre_eq /post_eq /eq_ind_r /eq_ind /eq_sym oFunctor_map_compose //.
+Qed.
+
+Global Instance funspecOF_contractive {PF} `{forall (A : ofe) (HA : Cofe A) (B : ofe) (HB : Cofe B), Cofe (oFunctor_car PF A B)} :
+    oFunctorContractive PF → oFunctorContractive (funspecOF PF).
+Proof.
+  rewrite /oFunctorContractive; intros.
+  intros ??? []; repeat split; auto.
+  exists eq_refl; split3; rewrite /eq_rect /E_eq /pre_eq /post_eq /eq_ind_r /eq_ind /eq_sym;
+    (apply @ofe_mor_car_ne; [|done]; apply @oFunctor_map_contractive; [apply oFunctor_oFunctor_compose_contractive_2|]; done).
+Qed.
+
+End ofunctor.
+
+End funspec.
+
+(*Program Fixpoint dtfr_later {PROP1} `{Cofe PROP1} {PROP2} `{Cofe PROP2} A : oFunctor_car (dependent_type_functor_rec A) PROP1 PROP2 -> oFunctor_car (dependent_type_functor_rec A) (laterO PROP1) (laterO PROP2) :=
+  match A with
+  | ConstType t => id
+  | CompspecsType => id
+  | Mpred => Next
+  | ProdType a b => λ x, (dtfr_later a (fst x), dtfr_later b (snd x))
+  | DiscreteFunType a b => λ x y, dtfr_later b (x y)
+  | ArrowType a b => λ x, (*λne y, dtfr_later b (x (dtfr_unlater a y))*) laterO_map x
+  | SigType _ f => λ x, match x with existT y P => existT y (dtfr_later (f y) P) end
+  | ListType t => map (dtfr_later t)
+  end
+with dtfr_unlater {PROP1} `{Cofe PROP1} {PROP2} `{Cofe PROP2} A : oFunctor_car (dependent_type_functor_rec A) (laterO PROP1) (laterO PROP2) -> oFunctor_car (dependent_type_functor_rec A) PROP1 PROP2 :=
+  match A with
+  | ConstType t => id
+  | CompspecsType => id
+  | Mpred => later_car
+  | ProdType a b => λ x, (dtfr_unlater a (fst x), dtfr_unlater b (snd x))
+  | DiscreteFunType a b => λ x y, dtfr_unlater b (x y)
+  | ArrowType a b => λ x, λne y, dtfr_unlater b (x (dtfr_later a y))
+  | SigType _ f => λ x, match x with existT y P => existT y (dtfr_unlater (f y) P) end
+  | ListType t => map (dtfr_unlater t)
+  end.
+Next Obligation.
+Proof.
+  intros.
+  intros ???.
+  simpl in x.
+  subst.
+  induction a; simpl.
+Locate "-n>".*)
+
+(*Program Definition dtfr_later {PROP1} `{Cofe PROP1} {PROP2} `{Cofe PROP2} A : oFunctor_car (dependent_type_functor_rec A) PROP1 PROP2 -> oFunctor_car (dependent_type_functor_rec A) (laterO PROP1) (laterO PROP2) :=
+  λ x, oFunctor_map (dependent_type_functor_rec A) (λne x, Next x, λne x, Next x) x.
+Next Obligation.
+Proof.
+  intros.*)
+
+Definition funspecO' := (laterO (funspecO (iPropO Σ) (iPropO Σ))).
+Definition funspecOF' := (laterOF (funspecOF idOF)).
+Definition dtfr A := (oFunctor_car (dependent_type_functor_rec A) (iProp Σ) (iProp Σ)).
+
+Lemma OfeMor_eq : forall {A B : ofe} (f1 f2 : A -> B) {H1 H2}, f1 = f2 -> @OfeMor A B f1 H1 = @OfeMor A B f2 H2.
+Proof.
+  intros; subst.
+  f_equal. apply proof_irr.
+Qed.
+
+Lemma funspec_equivI PROP1 `{Cofe PROP1} PROP2 `{Cofe PROP2} (f1 f2 : funspec_ PROP1 PROP2) : (f1 ≡ f2 : iProp Σ) ⊣⊢ ∃ sig cc A E P1 P2 Q1 Q2,
+  ⌜f1 = mk_funspec sig cc A E P1 Q1 ∧ f2 = mk_funspec sig cc A E P2 Q2⌝ ∧ P1 ≡ P2 ∧ Q1 ≡ Q2.
+Proof.
+  ouPred.unseal; split=> n x ?.
+  destruct f1, f2; split.
+  - intros (<- & <- & <- & HE & HP & HQ); simpl in *.
+    exists sig, cc, A, E, P, P0, Q, Q0; repeat split; try done.
+    f_equal. destruct E, E0. apply OfeMor_eq; extensionality y.
+    symmetry; apply HE.
+  - intros (? & ? & ? & ? & ? & ? & ? & ? & ([=] & [=]) & ? & ?); subst.
+    repeat match goal with H : existT _ _ = existT _ _ |- _ => apply inj_pair2 in H end; subst.
+    split3; auto; exists eq_refl; done.
+Qed.
 
 End FUNSPEC.
 
-Definition assert := environ -> mpred.  (* Unfortunately
-   can't export this abbreviation through SeparationLogic.v because
-  it confuses the Lift system *)
+(* collect up all the ghost state required for the logic
+   Should this include external state as well? *)
+Class funspecGS Σ := FunspecG {
+    funspec_inG :: inG Σ (gmap_viewR address (@funspecO' Σ));
+    funspec_name : gname
+}.
+
+Class heapGS Σ := HeapGS {
+  heapGS_invGS :: invGS_gen HasNoLc Σ;
+  heapGS_gen_heapGS :: gen_heapGS share address resource Σ;
+  heapGS_funspecGS :: funspecGS Σ
+}.
+
+Definition mpred `{heapGS Σ} := iProp Σ.
+
+Section heap.
+
+Context `{!heapGS Σ}.
+
+(* assertions (environ -> mpred as pred) *)
+Global Instance environ_inhabited : Inhabited environ := {| inhabitant := any_environ |}.
+
+Definition environ_index : biIndex := {| bi_index_type := environ |}.
+
+Definition assert' := environ -> mpred.
+Definition assert `{!heapGS Σ} := monPred environ_index (iPropI Σ).
+
+Program Definition assert_of (P : assert') : assert := {| monPred_at := P |}.
+
+Fail Example assert_of_test : forall (P: assert'), ∃ Q:assert, (@eq assert P Q).
+Global Coercion assert_of : assert' >-> assert.
+Example assert_of_test : forall (P: assert'), ∃ Q:assert, (@eq assert P Q).
+Proof. intros.  exists (assert_of P). reflexivity. Qed.
 
-Definition argsassert := argsEnviron -> mpred.
+Fail Example bi_of_assert'_test : forall (P Q : assert'), P ∗ Q ⊢ Q ∗ P.
+Program Definition bi_assert (P : assert) : bi_car assert := {| monPred_at := P |}.
+Set Warnings "-uniform-inheritance".
+Global Coercion bi_assert : assert >-> bi_car.
+Set Warnings "uniform-inheritance".
+(* "Print Coercion Paths assert' bi_car" prints "[assert_of; bi_assert]" *)
+Example test : forall (P Q : assert'), P ∗ Q ⊢ Q ∗ P. 
+Proof. intros. rewrite bi.sep_comm. done. Qed.
 
-Definition packPQ {A: rmaps.TypeTree}
-  (P: forall ts, dependent_type_functor_rec ts (ArgsTT A) mpred)
-  (Q: forall ts, dependent_type_functor_rec ts (AssertTT A) mpred):
-  forall ts, dependent_type_functor_rec ts (SpecArgsTT A) mpred.
-Proof. intros ts a b. destruct b. apply (P ts a). apply (Q ts a). Defined.
+Global Instance argsEnviron_inhabited : Inhabited argsEnviron := {| inhabitant := (Map.empty _, nil) |}.
+
+Definition argsEnviron_index : biIndex := {| bi_index_type := argsEnviron |}.
+
+Definition argsassert' := argsEnviron -> mpred.
+Definition argsassert `{!heapGS Σ} := monPred argsEnviron_index (iPropI Σ).
+
+Program Definition argsassert_of (P : argsassert') : argsassert := {| monPred_at := P |}.
+
+Coercion argsassert_of : argsassert' >-> argsassert.
+
+Lemma assert_of_at : forall (P : assert), assert_of (monPred_at P) ⊣⊢ P.
+Proof. done. Qed.
+
+Lemma argsassert_of_at : forall (P : argsassert), argsassert_of (monPred_at P) ⊣⊢ P.
+Proof. done. Qed.
+
+Lemma assert_of_embed P: assert_of (fun _ => P) ⊣⊢ ⎡P⎤.
+Proof.
+  intros.
+  split => rho //; monPred.unseal; done.
+Qed.
+
+(* funspecs on mpreds *)
+Definition funspec := funspec_ mpred mpred.
+Definition NDmk_funspec (sig : typesig) (cc : calling_convention) A (P : A -> argsassert) (Q : A -> assert) : funspec :=
+  mk_funspec sig cc (ConstType A) (λne a, ⊤) (λne (a : leibnizO A), (P a) : _ -d> mpred) (λne (a : leibnizO A), (Q a) : _ -d> mpred).
+
+Definition funspec_unfold (f : funspec) : laterO funspec := Next f.
+
+Definition varspecs : Type := list (ident * type).
+
+Definition funspecs := list (ident * funspec_ (iProp Σ) (iProp Σ)).
+
+
+Definition type_of_funspec (fs: funspec) : type :=
+  match fs with mk_funspec fsig cc _ _ _ _ => 
+     Tfunction (fst fsig) (snd fsig) cc end.
+
+Fixpoint make_tycontext_s (G: funspecs) :=
+ match G with
+ | nil => Maps.PTree.empty funspec
+ | (id,f)::r => Maps.PTree.set id f (make_tycontext_s r)
+ end.
+
+End heap.
 
 Definition int_range (sz: intsize) (sgn: signedness) (i: int) :=
  match sz, sgn with
@@ -253,23 +501,12 @@ Goal forall {cs: compspecs} t, sizeof t >= 0.
 Proof. intros. apply sizeof_pos.
 Abort.
 
+Definition idset := Maps.PTree.t unit.
 
-Definition type_of_funspec (fs: funspec) : type :=
-  match fs with mk_funspec fsig cc _ _ _ _ _ => 
-     Tfunction (fst fsig) (snd fsig) cc end.
-
-Lemma TTL1 l:  (map snd l) = type_of_params l.
-Proof. induction l; simpl; trivial. Qed.
-
-Lemma TTL4 l: map snd l = (type_of_params l).
-Proof. induction l; simpl; trivial. Qed.
-
-Definition idset := PTree.t unit.
-
-Definition idset0 : idset := PTree.empty _.
-Definition idset1 (id: ident) : idset := PTree.set id tt idset0.
+Definition idset0 : idset := Maps.PTree.empty _.
+Definition idset1 (id: ident) : idset := Maps.PTree.set id tt idset0.
 Definition insert_idset (id: ident) (S: idset) : idset :=
-  PTree.set id tt S.
+  Maps.PTree.set id tt S.
 
 Definition eval_id (id: ident) (rho: environ) := force_val (Map.get (te_of rho) id).
 
@@ -279,20 +516,15 @@ Definition env_set (rho: environ) (x: ident) (v: val) : environ :=
 Lemma eval_id_same: forall rho id v, eval_id id (env_set rho id v) = v.
 Proof. unfold eval_id; intros; simpl. unfold force_val. rewrite Map.gss. auto.
 Qed.
-#[export] Hint Rewrite eval_id_same : normalize norm.
 
 Lemma eval_id_other: forall rho id id' v,
    id<>id' -> eval_id id' (env_set rho id v) = eval_id id' rho.
 Proof.
  unfold eval_id, force_val; intros. simpl. rewrite Map.gso; auto.
 Qed.
-#[export] Hint Rewrite eval_id_other using solve [clear; intro Hx; inversion Hx] : normalize norm.
 
-Fixpoint make_tycontext_s (G: funspecs) :=
- match G with
- | nil => PTree.empty funspec
- | (id,f)::r => PTree.set id f (make_tycontext_s r)
- end.
+#[export] Hint Rewrite eval_id_same : normalize norm.
+#[export] Hint Rewrite eval_id_other using solve [clear; intro Hx; inversion Hx] : normalize norm.
 
 (* TWO ALTERNATE WAYS OF DOING LIFTING *)
 (* LIFTING METHOD ONE: *)
@@ -332,10 +564,40 @@ Ltac super_unfold_lift :=
   cbv delta [liftx LiftEnviron LiftAEnviron Tarrow Tend lift_S lift_T lift_prod
   lift_last lifted lift_uncurry_open lift_curry lift lift0 lift1 lift2 lift3 alift0 alift1 alift2 alift3] beta iota in *.
 
-Lemma approx_hered_derives_e n P Q: predicates_hered.derives P Q -> predicates_hered.derives (approx n P) (approx n Q).
-Proof. intros. unfold approx. intros m. simpl. intros [? ?]. split; auto. Qed.
-Lemma approx_derives_e n P Q: P |-- Q -> approx n P |-- approx n Q.
-Proof. intros. apply approx_hered_derives_e. apply H. Qed. 
-
-Lemma hered_derives_derives P Q: predicates_hered.derives P Q -> derives P Q.
-Proof. trivial. Qed.
+(* switch from an entailment on asserts to mpreds; mostly the same as monPred.unseal *)
+Ltac raise_rho :=
+  try (constructor; intro rho); 
+  repeat (rewrite monPred_at_and ||
+          rewrite monPred_at_sep ||
+          rewrite monPred_at_or ||
+          rewrite monPred_at_emp ||
+          rewrite monPred_at_pure ||
+          rewrite monPred_at_later ||
+          rewrite monPred_at_persistently ||
+          rewrite monPred_at_wand ||
+          rewrite monPred_at_embed ||
+          rewrite monPred_at_except_0 ||
+          rewrite monPred_at_intuitionistically ||
+          rewrite monPred_at_absorbingly ||
+          rewrite monPred_at_affinely ||
+          rewrite monPred_at_in ||
+          rewrite monPred_at_subjectively ||
+          rewrite monPred_at_objectively ||
+          rewrite monPred_at_persistently_if ||
+          rewrite monPred_at_laterN ||
+          rewrite monPred_at_absorbingly_if ||
+          rewrite monPred_at_intuitionistically_if ||
+          rewrite monPred_at_affinely_if ||
+          rewrite monPred_at_exist ||
+          rewrite monPred_at_forall ||
+          rewrite monPred_at_bupd ||
+          rewrite monPred_at_internal_eq ||
+          rewrite monPred_at_plainly ||
+          rewrite monPred_at_fupd ||
+          rewrite monPred_at_impl ||
+          rewrite monPred_at_wand ||
+          rewrite monPred_at_big_sepL ||
+          rewrite monPred_at_big_sepS ||
+          rewrite monPred_at_big_sepMS ||
+          rewrite monPred_at_big_sepM ||
+          simpl).
\ No newline at end of file
diff --git a/veric/own.v b/veric/own.v
deleted file mode 100644
index 2aebae2cca..0000000000
--- a/veric/own.v
+++ /dev/null
@@ -1,736 +0,0 @@
-Require Import VST.msl.log_normalize.
-Require Import VST.msl.ghost.
-Require Import VST.msl.ghost_seplog.
-Require Export VST.veric.base.
-Require Import VST.veric.rmaps.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.res_predicates.
-
-Import RML. Import R.
-Local Open Scope pred.
-
-Notation ghost_approx m := (ghost_fmap (approx (level m)) (approx (level m))).
-
-(* Ownership construction based on "Iris from the ground up", Jung et al. *)
-Program Definition ghost_is g: pred rmap :=
-  fun m => join_sub (ghost_approx m g) (ghost_of m).
-Next Obligation.
-  split; intros ??? J.
-  - rewrite (age1_ghost_of _ _ H).
-    destruct J as [? J].
-    eapply ghost_fmap_join in J.
-    assert (level a >= level a')%nat as Hl by (apply age_level in H; lia).
-    erewrite ghost_fmap_fmap, approx_oo_approx', approx'_oo_approx in J by apply Hl.
-    eexists; eauto.
-  - apply rmap_order in H as (? & _ & J').
-    eapply join_sub_trans; eauto.
-    rewrite <- H; auto.
-Qed.
-
-Definition Own g: pred rmap := allp noat && ghost_is g.
-
-Lemma Own_op: forall a b c, join a b c -> Own c = Own a * Own b.
-Proof.
-  intros; apply pred_ext.
-  - intros w (Hno & [? J]).
-    eapply ghost_fmap_join in H.
-    destruct (join_assoc H J) as (b' & J1 & J2).
-    eapply ghost_fmap_join in J1; rewrite ghost_fmap_fmap, 2approx_oo_approx in J1.
-    eapply ghost_fmap_join in J2; rewrite ghost_fmap_fmap, 2approx_oo_approx, ghost_of_approx in J2.
-    destruct (make_rmap (resource_at w) (ghost_approx w a) (level w))
-      as (wa & Hla & Hra & Hga).
-    { extensionality; apply resource_at_approx. }
-    { rewrite ghost_fmap_fmap, approx_oo_approx; auto. }
-    destruct (make_rmap (resource_at w) (ghost_approx w b') (level w))
-      as (wb & Hlb & Hrb & Hgb).
-    { extensionality; apply resource_at_approx. }
-    { rewrite ghost_fmap_fmap, approx_oo_approx; auto. }
-    exists wa, wb; split.
-    + apply resource_at_join2; auto.
-      * intro; rewrite Hra, Hrb.
-        apply identity_unit', Hno.
-      * rewrite Hga, Hgb; auto.
-    + simpl; rewrite Hla, Hlb, Hra, Hrb, Hga, Hgb; simpl.
-      repeat split; auto.
-      * apply join_sub_refl.
-      * eexists; eauto.
-  - intros w (w1 & w2 & J & (Hnoa & Hga) & (Hnob & Hgb)).
-    split.
-    + intro l; apply (resource_at_join _ _ _ l) in J.
-      simpl in *; rewrite <- (Hnoa _ _ _ J); auto.
-    + destruct (join_level _ _ _ J) as [Hl1 Hl2].
-      apply ghost_of_join in J.
-      destruct Hga as [? Ja], Hgb as [? Jb].
-      destruct (join_assoc (join_comm Ja) J) as (? & Ja' & J').
-      destruct (join_assoc (join_comm Jb) (join_comm Ja')) as (? & Jc & J'').
-      rewrite Hl1, Hl2 in Jc.
-      eapply ghost_fmap_join, join_eq in H; [|apply join_comm, Jc]; subst.
-      destruct (join_assoc (join_comm J'') (join_comm J')) as (? & ? & ?).
-      eexists; eauto.
-Qed.
-
-Fixpoint make_join (a c : ghost) : ghost :=
-  match a, c with
-  | nil, _ => c
-  | _, nil => nil
-  | None :: a', x :: c' => x :: make_join a' c'
-  | _ :: a', None :: c' => None :: make_join a' c'
-  | Some (ga, pa) :: a', Some (gc, _) :: c' => Some (gc, pa) :: make_join a' c'
-  end.
-
-Lemma make_join_nil : forall a, make_join a nil = nil.
-Proof.
-  destruct a; auto.
-  destruct o as [[]|]; auto.
-Qed.
-
-Lemma make_join_nil_cons : forall o a c, make_join (o :: a) (None :: c) = None :: make_join a c.
-Proof.
-  destruct o as [[]|]; auto.
-Qed.
-
-Lemma ghost_joins_approx: forall n a c,
-  joins (ghost_fmap (approx n) (approx n) a) (ghost_fmap (approx n) (approx n) c) ->
-  let c' := make_join a c in
-  joins (ghost_fmap (approx (S n)) (approx (S n)) a) (ghost_fmap (approx (S n)) (approx (S n)) c') /\
-    forall b, joins b (ghost_fmap (approx (S n)) (approx (S n)) c') ->
-      joins (ghost_fmap (approx n) (approx n) b) (ghost_fmap (approx n) (approx n) c).
-Proof.
-  intros ???; revert a; induction c; intros; subst c'; simpl.
-  - rewrite make_join_nil; split.
-    + eexists; constructor.
-    + eexists; constructor.
-  - destruct H; inv H.
-    + destruct a0; inv H1.
-      split.
-      { eexists; constructor. }
-      intros ? []; eexists.
-      apply ghost_fmap_join with (f := approx n)(g := approx n) in H.
-      rewrite ghost_fmap_fmap, approx_oo_approx', approx'_oo_approx in H by auto; eauto.
-    + destruct a0; inv H0.
-      destruct (IHc a0) as (H & Hc'); eauto.
-      inv H3.
-      * destruct o; inv H1.
-        split.
-        { destruct H; eexists; constructor; eauto; constructor. }
-        intros ? [? J]; inv J; [eexists; constructor|].
-        destruct (Hc' m1); eauto.
-        eexists; constructor; eauto.
-        instantiate (1 := option_map (fun '(a, b) => (a, preds_fmap (approx n) (approx n) b)) a3).
-        inv H3.
-        -- destruct a as [[]|]; [simpl | constructor].
-           rewrite preds_fmap_fmap, approx_oo_approx', approx'_oo_approx by auto; constructor; auto.
-        -- destruct a; inv H4; constructor.
-        -- destruct a as [[]|]; inv H1; constructor.
-           destruct a2, a5; inv H4; constructor; auto; simpl in *.
-           inv H2.
-           rewrite preds_fmap_fmap, approx_oo_approx', approx'_oo_approx by auto; constructor; auto.
-      * destruct a; inv H2.
-        rewrite make_join_nil_cons.
-        split.
-        { destruct H; eexists; constructor; eauto; constructor. }
-        intros ? [? J]; inv J; [eexists; constructor|].
-        destruct (Hc' m1); eauto.
-        eexists; constructor; eauto; constructor.
-      * destruct o as [[]|], a as [[]|]; inv H0; inv H1.
-        split.
-        { destruct H.
-          destruct a4; inv H2; simpl in *.
-          inv H1.
-          eexists (Some (_, _) :: _); constructor; eauto; constructor.
-          constructor; simpl; eauto; constructor; eauto. }
-        intros ? [? J]; inv J; [eexists; constructor|].
-        destruct (Hc' m1); eauto.
-        eexists; constructor; eauto.
-        instantiate (1 := option_map (fun '(a, b) => (a, preds_fmap (approx n) (approx n) b)) a3).
-        inv H4.
-        -- destruct a4; inv H2; simpl in *.
-           inv H3.
-           rewrite <- H2, preds_fmap_fmap, approx_oo_approx', approx'_oo_approx by auto; constructor.
-        -- constructor.
-           destruct a2, a4, a6; inv H2; inv H6; constructor; auto; simpl in *.
-           inv H3; inv H4.
-           rewrite <- H6, preds_fmap_fmap, approx_oo_approx', approx'_oo_approx by auto; constructor; auto.
-Qed.
-
-Program Definition bupd (P: pred rmap): pred rmap :=
-  fun m => forall c, joins (ghost_of m) (ghost_approx m c) ->
-    exists b, joins b (ghost_approx m c) /\
-    exists m', level m' = level m /\ resource_at m' = resource_at m /\ ghost_of m' = b /\ P m'.
-Next Obligation.
-Proof.
-  split; repeat intro.
-  rewrite (age1_ghost_of _ _ H) in H1.
-  rewrite <- ghost_of_approx in H0.
-  destruct (ghost_joins_approx _ _ _ H1) as (J0 & Hc0).
-  rewrite <- (age_level _ _ H) in *.
-  specialize (H0 _ J0); destruct H0 as (b & J & Hrb).
-  pose proof (age_level _ _ H).
-  exists (ghost_approx a' b); split; auto.
-  destruct Hrb as (m' & Hl' & Hr' & Hg' & HP).
-  destruct (levelS_age m' (level a')) as (m'' & Hage' & Hl'').
-  { congruence. }
-  exists m''; repeat split; auto.
-  + extensionality l.
-    erewrite (age1_resource_at _ _ H l) by (symmetry; apply resource_at_approx).
-    erewrite (age1_resource_at _ _ Hage' l) by (symmetry; apply resource_at_approx).
-    congruence.
-  + rewrite (age1_ghost_of _ _ Hage').
-    rewrite Hg', <- Hl''; auto.
-  + eapply pred_hereditary; eauto.
-  + apply rmap_order in H as (Hl & Hr & [? J]).
-    destruct H1 as [d J'].
-    destruct (join_assoc J J') as (c' & ? & Jc').
-    eapply ghost_fmap_join in Jc'; rewrite ghost_of_approx in Jc'.
-    destruct (H0 c') as (? & Jm' & m' & ? & ? & ? & ?); eauto; subst.
-    do 2 eexists; [|exists m'; repeat split; eauto; congruence].
-    eapply join_sub_joins'; eauto.
-    { apply join_sub_refl. }
-    eapply ghost_fmap_join in H; rewrite ghost_fmap_fmap, 2approx_oo_approx in H.
-    rewrite Hl; eexists; eauto.
-Qed.
-
-Lemma bupd_intro: forall P, P |-- bupd P.
-Proof.
-  repeat intro; eauto 7.
-Qed.
-
-Lemma bupd_mono: forall P Q, (P |-- Q) -> bupd P |-- bupd Q.
-Proof.
-  repeat intro.
-  simpl in *.
-  destruct (H0 _ H1) as (b & ? & m' & ? & ? & ? & ?).
-  exists b; split; auto.
-  exists m'; repeat split; auto.
-Qed.
-
-Lemma bupd_frame_r: forall P Q, bupd P * Q |-- bupd (P * Q).
-Proof.
-  repeat intro.
-  destruct H as (w1 & w2 & J & HP & HQ).
-  destruct (join_level _ _ _ J) as [Hl1 Hl2].
-  pose proof (ghost_of_join _ _ _ J) as Jg.
-  destruct H0 as [? J'].
-  destruct (join_assoc Jg J') as (c' & J1 & J2).
-  erewrite <- (ghost_same_level_gen (level a) (ghost_of w2) c c') in J2, J1
-    by (rewrite <- Hl2 at 1 2; rewrite ghost_of_approx; auto).
-  destruct (HP c') as (? & [? J1'] & w1' & ? & Hr' & ? & HP'); subst.
-  { rewrite Hl1; eauto. }
-  rewrite Hl1 in J1'; destruct (join_assoc (join_comm J1) (join_comm J1')) as (w' & ? & ?).
-  exists w'; split; [eexists; apply join_comm; eauto|].
-  destruct (make_rmap (resource_at a) w' (level a)) as (m' & ? & Hr'' & ?); subst.
-  { extensionality l; apply resource_at_approx. }
-  { eapply ghost_same_level_gen.
-    rewrite <- (ghost_of_approx w2), <- (ghost_of_approx w1'), H, Hl1, Hl2 in H0.
-    apply join_comm; eauto. }
-  exists m'; repeat split; auto.
-  exists w1', w2; repeat split; auto.
-  apply resource_at_join2; auto; try lia.
-  intro; rewrite Hr', Hr''.
-  apply resource_at_join; auto.
-Qed.
-
-Lemma bupd_frame_l: forall P Q, P * bupd Q |-- bupd (P * Q).
-Proof.
-  intros; rewrite sepcon_comm, (sepcon_comm P Q); apply bupd_frame_r.
-Qed.
-
-Lemma bupd_trans: forall P, bupd (bupd P) |-- bupd P.
-Proof.
-  repeat intro.
-  destruct (H _ H0) as (b & J & a' & Hl & Hr & ? & Ha'); subst.
-  rewrite <- Hl in J; destruct (Ha' _ J) as (b' & ? & Hm').
-  rewrite <- Hl, <- Hr; eauto.
-Qed.
-
-Lemma joins_approx_core : forall a, joins (ghost_of a) (ghost_approx a (core (ghost_of a))).
-Proof.
-  intros; eexists.
-  rewrite <- ghost_of_approx at 1; apply ghost_fmap_join.
-  apply join_comm, core_unit.
-Qed.
-
-Lemma bupd_prop : forall P, bupd (!! P) = !! P.
-Proof.
-  intros ?; apply pred_ext.
-  - intros ??; simpl in *.
-    destruct (H _ (joins_approx_core _)) as (? & ? & ? & ? & ? & ? & ?); auto.
-  - intros ??.
-    do 2 eexists; eauto.
-Qed.
-
-Lemma corable_resource_at : forall P, corable P ->
-  forall a b, level a = level b -> resource_at a = resource_at b -> P a -> P b.
-Proof.
-  intros.
-  apply (H (id_core a)); [eapply H; eauto|].
-  - right; left; eexists; apply id_core_unit.
-  - left. exists b.
-    apply resource_at_join2; auto.
-    + rewrite id_core_level; auto.
-    + intros; rewrite id_core_resource.
-      rewrite <- core_resource_at, H1; apply core_unit.
-    + rewrite id_core_ghost; constructor.
-Qed.
-
-Lemma bupd_andp_corable : forall P Q, corable P -> bupd (P && Q) = P && bupd Q.
-Proof.
-  intros; apply pred_ext.
-  - intros ??; simpl in *.
-    split.
-    + destruct (H0 _ (joins_approx_core _)) as (? & ? & ? & ? & ? & ? & ? & ?); auto.
-      eapply corable_resource_at; eauto.
-    + intros ? J; destruct (H0 _ J) as (? & ? & m & ? & ? & ? & ? & ?).
-      do 2 eexists; eauto.
-  - intros ? [? HQ] ? J.
-    destruct (HQ _ J) as (? & ? & m & ? & ? & ? & ?).
-    do 2 eexists; eauto.
-    do 2 eexists; eauto.
-    repeat split; auto.
-    eapply corable_resource_at, H0; auto.
-Qed.
-
-Lemma bupd_andp_prop : forall P Q, bupd (!! P && Q) = !! P && bupd Q.
-Proof.
-  intros; apply bupd_andp_corable, corable_prop.
-Qed.
-
-Lemma subp_bupd: forall (G : pred nat) (P P' : pred rmap), (G |-- P >=> P') ->
-    G |-- (bupd P >=> bupd P')%pred.
-Proof.
-  repeat intro.
-  specialize (H4 _ H5) as (? & ? & ? & ? & ? & ? & HP).
-  do 2 eexists; eauto; do 2 eexists; eauto; repeat (split; auto).
-  eapply H; try apply ext_refl; try apply necR_refl; eauto.
-  apply necR_level in H2; apply ext_level in H3; lia.
-Qed.
-
-Lemma eqp_bupd: forall (G : pred nat) (P P' : pred rmap), (G |-- P <=> P') ->
-    G |-- (bupd P <=> bupd P').
-Proof.
-  intros.
-  rewrite fash_and in *.
-  apply andp_right; apply subp_bupd; eapply derives_trans; try apply H;
-    [apply andp_left1 | apply andp_left2]; apply derives_refl.
-Qed.
-
-Definition ghost_fp_update_ND a B :=
-  forall n c, joins (ghost_fmap (approx n) (approx n) a) c ->
-    exists b, B b /\ joins (ghost_fmap (approx n) (approx n) b) c.
-
-Lemma Own_update_ND: forall a B, ghost_fp_update_ND a B ->
-  Own a |-- bupd (EX b : _, !!(B b) && Own b).
-Proof.
-  unfold ghost_fp_update_ND; repeat intro.
-  destruct H0 as (Hno & J).
-  eapply join_sub_joins_trans in H1; eauto; [|apply J].
-  apply H in H1 as (g' & ? & J').
-  exists (ghost_fmap (approx (level a0)) (approx (level a0)) g'); split; auto.
-  destruct (make_rmap (resource_at a0)
-    (ghost_fmap (approx (level a0)) (approx (level a0)) g') (level a0))
-    as (m' & Hl & Hr & Hg').
-  { extensionality; apply resource_at_approx. }
-  { rewrite ghost_fmap_fmap, approx_oo_approx; auto. }
-  exists m'; repeat split; auto.
-  exists g'; repeat split; auto.
-  - simpl in *; intro; rewrite Hr; auto.
-  - simpl; rewrite Hg', Hl; simpl; eauto.
-    apply join_sub_refl.
-Qed.
-
-Definition ghost_fp_update (a b : ghost) :=
-  forall n c, joins (ghost_fmap (approx n) (approx n) a) c ->
-               joins (ghost_fmap (approx n) (approx n) b) c.
-
-#[export] Instance ghost_fp_update_preorder: RelationClasses.PreOrder ghost_fp_update.
-Proof.
-  split; repeat intro; auto.
-Qed.
-
-Lemma ghost_fp_update_approx: forall a b n, ghost_fp_update a b ->
-  ghost_fp_update (ghost_fmap (approx n) (approx n) a) (ghost_fmap (approx n) (approx n) b).
-Proof.
-  intros; intros m c J.
-  rewrite ghost_fmap_fmap in *.
-  replace (approx m oo approx n) with (approx (Nat.min m n)) in *.
-  replace (approx n oo approx m) with (approx (Nat.min m n)) in *.
-  auto.
-  { destruct (Nat.min_spec m n) as [[? ->] | [? ->]];
-      [rewrite approx'_oo_approx | rewrite approx_oo_approx']; auto; lia. }
-  { destruct (Nat.min_spec m n) as [[? ->] | [? ->]];
-      [rewrite approx_oo_approx' | rewrite approx'_oo_approx]; auto; lia. }
-Qed.
-
-Lemma Own_update: forall a b, ghost_fp_update a b ->
-  Own a |-- bupd (Own b).
-Proof.
-  intros; eapply derives_trans.
-  - eapply (Own_update_ND _ (eq _)).
-    repeat intro.
-    eexists; split; [constructor|].
-    apply H; eauto.
-  - apply bupd_mono.
-    repeat (apply exp_left; intro).
-    apply prop_andp_left; intro X; inv X; auto.
-Qed.
-
-Lemma Own_unit: emp |-- EX a : _, !!(identity a) && Own a.
-Proof.
-  intros w Hemp.
-  assert (forall l, identity (w @ l)).
-  { rewrite emp_no in Hemp; auto. }
-  destruct Hemp as (e & ? & Hext).
-  exists (ghost_of e); split; [|split; auto].
-  - apply ghost_of_identity; auto.
-  - apply rmap_order in Hext as (? & ? & []).
-    eexists.
-    rewrite <- (ghost_of_approx w).
-    apply ghost_fmap_join; eauto.
-Qed.
-
-Lemma Own_dealloc: forall a, Own a |-- emp.
-Proof.
-  rewrite emp_no.
-  intros; apply andp_left1; auto.
-Qed.
-
-Definition singleton {A} k (x : A) : list (option A) := repeat None k ++ Some x :: nil.
-
-Definition gname := nat.
-
-Definition own {RA: Ghost} (n: gname) (a: G) (pp: preds) :=
-  EX v : _, Own (singleton n (existT _ RA (exist _ a v), pp)).
-
-Definition list_set {A} (m : list (option A)) k v : list (option A) :=
-  firstn k m ++ repeat None (k - length m) ++ Some v :: skipn (S k) m.
-
-Lemma singleton_join_gen: forall k a c (m: ghost)
-  (Hjoin: join (Some a) (nth k m None) (Some c)),
-  join (singleton k a) m (list_set m k c).
-Proof.
-  induction k; intros.
-  - destruct m; simpl in *; subst; inv Hjoin; constructor; constructor; auto.
-  - destruct m; simpl in *.
-    + inv Hjoin; constructor.
-    + constructor; [constructor | apply IHk; auto].
-Qed.
-
-Lemma map_repeat : forall {A B} (f : A -> B) x n, map f (repeat x n) = repeat (f x) n.
-Proof.
-  induction n; auto; simpl.
-  rewrite IHn; auto.
-Qed.
-
-Lemma ghost_fmap_singleton: forall f g k v, ghost_fmap f g (singleton k v) =
-  singleton k (match v with (a, b) => (a, preds_fmap f g b) end).
-Proof.
-  intros; unfold ghost_fmap, singleton.
-  rewrite map_app, map_repeat; auto.
-Qed.
-
-Lemma ghost_fmap_singleton_inv : forall f g a k v,
-  ghost_fmap f g a = singleton k v ->
-  exists v', a = singleton k v' /\ v = let (a, b) := v' in (a, preds_fmap f g b).
-Proof.
-  unfold singleton; induction a; simpl; intros.
-  - destruct k; discriminate.
-  - destruct a as [[]|]; simpl in *.
-    + destruct k; inv H.
-      destruct a0; inv H2.
-      simpl; eauto.
-    + destruct k; inv H.
-      edestruct IHa as (? & ? & ?); eauto; subst.
-      simpl; eauto.
-Qed.
-
-Import ListNotations.
-Fixpoint uptoN (n : nat) : list nat :=
-  match n with
-  | O => []
-  | S n' => uptoN n' ++ [n']
-  end.
-
-Lemma In_uptoN : forall m n, (m < n)%nat -> In m (uptoN n).
-Proof.
-  induction n; intros; [lia | simpl].
-  rewrite in_app; destruct (lt_dec m n); auto.
-  right; simpl; lia.
-Qed.
-
-Lemma ghost_alloc_strong: forall {RA: Ghost} P a pp, pred_infinite P -> ghost.valid a ->
-  emp |-- bupd (EX g, !!(P g) && own g a pp).
-Proof.
-  intros.
-  eapply derives_trans; [apply Own_unit|].
-  apply exp_left; intro g0.
-  apply prop_andp_left; intro Hg0.
-  eapply derives_trans.
-  - apply Own_update_ND with (B := fun b => exists g, P g /\ b = singleton g (existT _ RA (exist _ _ H0), pp)).
-    intros ? c [? J].
-    destruct (H (uptoN (length c))) as (g & ? & ?).
-    exists (singleton g (existT _ RA (exist _ _ H0), pp)).
-    split; eauto.
-    apply ghost_identity in Hg0; subst.
-    assert (x = c) by (inv J; auto); subst.
-    rewrite ghost_fmap_singleton; eexists; apply singleton_join_gen.
-    rewrite nth_overflow; [constructor|].
-    destruct (lt_dec g (length c)); [|lia].
-    apply In_uptoN in l; contradiction.
-  - apply bupd_mono, exp_left; intro g'.
-    apply prop_andp_left; intros (g & ? & ?); subst.
-    apply exp_right with g.
-    apply prop_andp_right; auto.
-    eapply exp_right; eauto.
-Qed.
-
-Lemma list_max : forall x (l : list nat), In x l -> (x <= fold_right max O l)%nat.
-Proof.
-  induction l; [contradiction | simpl; intros].
-  destruct H.
-  - subst.
-    apply Nat.le_max_l.
-  - etransitivity; [apply IHl; auto|].
-    apply Nat.le_max_r.
-Qed.
-
-Lemma fresh_nat: forall (l : list nat), exists n, ~In n l.
-Proof.
-  intros; exists (S (fold_right max O l)).
-  intros X%list_max; lia.
-Qed.
-
-Lemma ghost_alloc: forall {RA: Ghost} a pp, ghost.valid a ->
-  emp |-- bupd (EX g, own g a pp).
-Proof.
-  intros.
-  eapply derives_trans; [apply (ghost_alloc_strong (fun _ => True)); eauto|].
-  { intros ?.
-    destruct (fresh_nat l); eauto. }
-  apply bupd_mono.
-  apply exp_left; intros g.
-  apply exp_right with g.
-  apply andp_left2; auto.
-Qed.
-
-Lemma singleton_join: forall a b c k,
-  join (singleton k a) (singleton k b) (singleton k c) <-> join a b c.
-Proof.
-  unfold singleton; induction k; simpl.
-  - split.
-    + inversion 1; subst.
-      inv H3; auto.
-    + intro; do 2 constructor; auto.
-  - rewrite <- IHk.
-    split; [inversion 1 | repeat constructor]; auto.
-Qed.
-
-Lemma singleton_join_inv: forall k a b c,
-  join (singleton k a) (singleton k b) c -> exists c', join a b c' /\ c = singleton k c'.
-Proof.
-  unfold singleton; induction k; inversion 1; subst.
-  - assert (m3 = nil) by (inv H6; auto).
-    inv H5; eauto.
-  - assert (a3 = None) by (inv H5; auto); subst.
-    edestruct IHk as (? & ? & ?); eauto; subst; eauto.
-Qed.
-
-Lemma ghost_valid_2: forall {RA: Ghost} g a1 a2 pp,
-  own g a1 pp * own g a2 pp |-- !!ghost.valid_2 a1 a2.
-Proof.
-  intros.
-  intros w (? & ? & J%ghost_of_join & (? & ? & [? J1]) & (? & ? & [? J2])).
-  destruct (join_assoc (join_comm J1) J) as (? & J1' & ?).
-  destruct (join_assoc (join_comm J2) (join_comm J1')) as (? & J' & ?).
-  rewrite !ghost_fmap_singleton in J'.
-  apply singleton_join_inv in J' as ([] & J' & ?).
-  inv J'; simpl in *.
-  inv H4; repeat inj_pair_tac.
-  eexists; eauto.
-Qed.
-
-Lemma ghost_op: forall {RA: Ghost} g (a1 a2 a3: G) pp, join a1 a2 a3 ->
-  own g a3 pp = own g a1 pp * own g a2 pp.
-Proof.
-  intros; apply pred_ext.
-  - apply exp_left; intro.
-    erewrite Own_op; [apply sepcon_derives; eapply exp_right; eauto|].
-    instantiate (1 := join_valid _ _ _ (join_comm H) x).
-    instantiate (1 := join_valid _ _ _ H x).
-    apply singleton_join; constructor; constructor; auto.
-  - eapply derives_trans; [apply andp_right, derives_refl; apply ghost_valid_2|].
-    apply prop_andp_left; intros (? & J & ?).
-    eapply join_eq in H; eauto; subst.
-    unfold own; rewrite exp_sepcon1; apply exp_left; intro.
-    rewrite exp_sepcon2; apply exp_left; intro.
-    erewrite <- Own_op; [eapply exp_right; eauto|].
-    instantiate (1 := H0).
-    apply singleton_join; constructor; constructor; auto.
-Qed.
-
-Lemma ghost_valid: forall {RA: Ghost} g a pp,
-  own g a pp |-- !!ghost.valid a.
-Proof.
-  intros.
-  rewrite <- (normalize.andp_TT (!!_)).
-  erewrite ghost_op by apply core_unit.
-  eapply derives_trans; [apply andp_right, derives_refl; apply ghost_valid_2|].
-  apply prop_andp_left; intros (? & J & ?); apply prop_andp_right; auto.
-  assert (x = a) as <-; auto.
-  eapply join_eq, core_unit; assumption.
-Qed.
-
-Lemma singleton_join_inv_gen: forall k a (b c: ghost),
-  join (singleton k a) b c ->
-  join (Some a) (nth k b None) (nth k c None) /\
-    exists c', nth k c None = Some c' /\ c = list_set b k c'.
-Proof.
-  unfold singleton; induction k; inversion 1; subst; auto.
-  - split; simpl; eauto; constructor.
-  - split; auto.
-    unfold list_set; simpl.
-    assert (m2 = m3) by (inv H5; auto).
-    inv H2; eauto.
-  - rewrite app_nth2; rewrite repeat_length; auto.
-    rewrite Nat.sub_diag; split; [constructor | simpl; eauto].
-  - assert (a2 = a3) by (inv H2; auto).
-    destruct (IHk _ _ _ H5) as (? & ? & ? & ?); subst; eauto.
-Qed.
-
-Lemma ghost_update_ND: forall {RA: Ghost} g (a: G) B pp,
-  fp_update_ND a B -> own g a pp |-- bupd (EX b : _, !!(B b) && own g b pp).
-Proof.
-  intros.
-  apply exp_left; intro Hva.
-  eapply derives_trans.
-  - apply Own_update_ND with
-      (B := fun b => exists b' Hvb, B b' /\ b = singleton g (existT _ RA (exist _ b' Hvb), pp)).
-    intros ?? [? J].
-    rewrite ghost_fmap_singleton in J.
-    destruct (singleton_join_inv_gen _ _ _ _ J) as [Jg _].
-    inv Jg.
-    + destruct (H (core a)) as (b & ? & Hv).
-      { eexists; split; [apply join_comm, core_unit | auto]. }
-      assert (ghost.valid b) as Hvb.
-      { destruct Hv as (? & ? & ?); eapply join_valid; eauto. }
-      exists (singleton g (existT _ RA (exist _ _ Hvb), pp)); split; eauto.
-      rewrite ghost_fmap_singleton.
-      eexists; apply singleton_join_gen.
-      rewrite <- H2; constructor.
-    + destruct a2, a3; inv H3; simpl in *.
-      inv H0; inj_pair_tac.
-      destruct (H b0) as (b & ? & Hv).
-      { eexists; eauto. }
-      destruct Hv as (? & ? & ?).
-      assert (ghost.valid b) as Hvb by (eapply join_valid; eauto).
-      exists (singleton g (existT _ RA (exist _ _ Hvb), pp)); split; eauto.
-      rewrite ghost_fmap_singleton.
-      eexists; apply singleton_join_gen.
-      instantiate (1 := (_, _)).
-      rewrite <- H1; constructor; constructor; [constructor|]; eauto.
-      Unshelve. auto.
-  - apply bupd_mono, exp_left; intro.
-    apply prop_andp_left; intros (b & ? & ? & ?); subst.
-    apply exp_right with b, prop_andp_right; auto.
-    eapply exp_right; auto.
-Qed.
-
-Lemma ghost_update: forall {RA: Ghost} g (a b: G) pp,
-  fp_update a b -> own g a pp |-- bupd (own g b pp).
-Proof.
-  intros; eapply derives_trans.
-  - apply (ghost_update_ND g a (eq b)).
-    intros ? J; destruct (H _ J).
-    do 2 eexists; [constructor | eauto].
-  - apply bupd_mono.
-    apply exp_left; intro; apply prop_andp_left; intro X; inv X; auto.
-Qed.
-
-Lemma ghost_dealloc: forall {RA: Ghost} g a pp,
-  own g a pp |-- emp.
-Proof.
-  intros; unfold own.
-  apply exp_left; intro; apply Own_dealloc.
-Qed.
-
-Lemma list_set_same : forall {A} n l (a : A), nth n l None = Some a ->
-  list_set l n a = l.
-Proof.
-  unfold list_set; induction n; destruct l; simpl; try discriminate; intros; subst; auto.
-  f_equal; eauto.
-Qed.
-
-Lemma map_firstn : forall {A B} (f : A -> B) (l : list A) n,
-  map f (firstn n l) = firstn n (map f l).
-Proof.
-  induction l; destruct n; auto; simpl.
-  rewrite IHl; auto.
-Qed.
-
-Lemma map_skipn : forall {A B} (f : A -> B) (l : list A) n,
-  map f (skipn n l) = skipn n (map f l).
-Proof.
-  induction l; destruct n; auto; simpl.
-  rewrite IHl; auto.
-Qed.
-
-Lemma list_set_set : forall {A} n l (a b : A), (n <= length l)%nat ->
-  list_set (list_set l n a) n b = list_set l n b.
-Proof.
-  intros; unfold list_set.
-  rewrite (proj2 (Nat.sub_0_le _ _) H).
-  rewrite !app_length, !skipn_app, firstn_app, firstn_length, min_l, Nat.sub_diag, app_nil_r, repeat_length by auto.
-  rewrite firstn_firstn, min_l by auto; f_equal.
-  unfold length; setoid_rewrite skipn_length; f_equal.
-  - f_equal. lia.
-  - rewrite skipn_all2, skipn_nil, Nat.sub_0_r; [|rewrite firstn_length; lia].
-    rewrite (Nat.add_sub 1); auto.
-Qed.
-
-Lemma nth_list_set : forall {A} n l (a : A) d, nth n (list_set l n a) d = Some a.
-Proof.
-  intros; unfold list_set.
-  rewrite 2app_nth2; rewrite ?repeat_length, ?firstn_length; try lia.
-  match goal with |- nth ?n _ _ = _ => replace n with O by lia end; auto.
-Qed.
-
-Lemma own_core : forall {RA: Ghost} g (a : G) pp,
-  a = core a -> forall w, own g a pp w -> own g a pp (core w).
-Proof.
-  unfold own, Own, ghost_is; intros; simpl in *.
-  destruct H0 as (Hv & _ & ? & J).
-  exists Hv; split; auto.
-  - intros ?; apply resource_at_core_identity.
-  - rewrite ghost_of_core.
-    rewrite ghost_fmap_singleton in J.
-    apply singleton_join_inv_gen in J as (J & ((?, (?, ?)), ?) & Hg & Hw).
-    rewrite Hg in J.
-    rewrite Hw, ghost_core_eq.
-    unfold list_set; rewrite !map_app, map_firstn, map_repeat.
-    unfold map at 2; setoid_rewrite map_skipn.
-    rewrite ghost_fmap_singleton; simpl Datatypes.option_map.
-    erewrite <- map_length.
-    rewrite level_core.
-    inv J.
-    + inj_pair_tac.
-      eexists; apply singleton_join_gen.
-      setoid_rewrite (map_nth _ _ None). rewrite <- H2.
-      match goal with |- join ?a _ ?c => assert (a = c) as ->; [|constructor] end.
-      do 3 f_equal. apply exist_ext; auto.
-    + destruct a2, H3 as [J ?].
-      inv J.
-      repeat inj_pair_tac.
-      apply join_core_sub in H5 as [].
-      setoid_rewrite <- list_set_set.
-      eexists; apply singleton_join_gen.
-      rewrite nth_list_set.
-      instantiate (1 := (_, _)).
-      constructor. split; simpl in *; [|split; auto].
-      constructor. rewrite H; eauto.
-      Unshelve.
-      * inv H0; auto.
-      * rewrite map_length.
-        destruct (le_dec (length x) g); [|lia].
-        rewrite nth_overflow in H1 by auto; discriminate.
-      * apply join_comm, join_valid in H2; auto.
-        apply core_valid; auto.
-Qed.
diff --git a/veric/res_predicates.v b/veric/res_predicates.v
index c052c30400..a9142d0633 100644
--- a/veric/res_predicates.v
+++ b/veric/res_predicates.v
@@ -1,349 +1,59 @@
-Require Import VST.msl.log_normalize.
-Require Export VST.veric.base.
-Require Import VST.veric.rmaps.
-Require Import VST.veric.compcert_rmaps.  
-Require Import VST.veric.shares. 
-Require Import VST.veric.address_conflict.
-
-Import RML. Import R.
+From iris.proofmode Require Export tactics.
+Require Import compcert.cfrontend.Ctypes.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+From iris_ora.algebra Require Import gmap.
+From iris_ora.logic Require Export logic algebra invariants.
+From VST.veric Require Import shares address_conflict.
+From VST.msl Require Export shares.
+From VST.veric Require Export base Memory share_instance.
+From VST.shared Require Export dshare gen_heap.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
+Export Values.
+Export -(notations) Maps.
+
+(* We can't import compcert.lib.Maps' notations because they conflict with stdpp's,
+   and actually the ! notation conflicts with rewrite's ! as well. Matching stdpp's lookup notation
+   instead, with an extra ! per lookup. *)
+Declare Scope maps.
+Delimit Scope maps with maps.
+Notation "a !! b" := (Maps.PTree.get b a) (at level 20) : maps.
+Notation "a !!! b" := (Maps.PMap.get b a) (at level 20) : maps.
+Open Scope maps.
 Local Open Scope Z_scope.
-Local Open Scope pred.
 
+Inductive resource :=
+| VAL (v : memval)
+| LK (i z : Z) (b : bool) (* true means held, false means not held *)
+| FUN.
+(* Other information, like lock invariants and funspecs, should be stored in invariants,
+   not in the heap. *)
 
-Program Definition kind_at (k: kind) (l: address) : pred rmap :=
-   fun m => exists rsh, exists sh, exists pp, m @ l = YES rsh sh k pp.
- Next Obligation.
-   split; repeat intro.
-   destruct H0 as [rsh [sh [pp ?]]].
-   generalize (eq_sym (resource_at_approx a l)); intro.
-   generalize (age1_resource_at a a'  H l (a@l) H1); intro.
-   rewrite H0 in H2. simpl in H2. eauto.
-
-  apply rmap_order in H as (_ & <- & _); auto.
- Qed.
-
-Definition spec : Type :=  forall (sh: Share.t) (l: AV.address), pred rmap.
-
-Program Definition yesat_raw (pp: preds) (k: kind) 
-                           (sh: share) (rsh: readable_share sh) (l: address) : pred rmap :=
-   fun phi => phi @ l = YES sh rsh k (preds_fmap (approx (level phi)) (approx (level phi)) pp).
-  Next Obligation.
-   split; repeat intro.
-   apply (age1_resource_at a a' H l (YES sh rsh k pp) H0).
+Definition nonlock (r: resource) : Prop :=
+ match r with
+ | LK _ _ _ => False
+ | _ => True
+ end.
 
-  apply rmap_order in H as (<- & <- & _); auto.
-  Qed.
+Global Notation "l ↦ dq v" := (mapsto(H := share_instance) l dq v)
+  (at level 20, dq custom dfrac at level 1, format "l  ↦ dq  v") : bi_scope.
 
-Local Obligation Tactic := idtac.
+Open Scope bi_scope.
 
-Program Definition yesat (pp: preds) (k: kind) : spec :=
- fun (sh: share) (l: AV.address) (m: rmap) =>
-  exists rsh, yesat_raw pp k sh rsh l m.
-  Next Obligation.
-    split; repeat intro.
-    destruct H0 as [p ?]; exists p.
-    apply pred_hereditary with a; auto.
+Section heap.
 
-    destruct H0 as [p ?]; exists p.
-    apply pred_upclosed with a; auto.
-  Qed.
+Context {Σ : gFunctors}.
+Context {HGS : gen_heapGS share address resource Σ}.
 
-Program Definition pureat (pp: preds) (k: kind) (l: AV.address): pred rmap :=
-       fun phi => phi @ l = PURE k (preds_fmap (approx (level phi)) (approx (level phi)) pp).
-  Next Obligation.
-    split; repeat intro.
-   apply (age1_resource_at a a' H l (PURE k pp) H0).
+Notation mpred := (iProp Σ).
 
-   apply rmap_order in H as (<- & <- & _); auto.
-  Qed.
+Definition spec : Type :=  forall (sh: share) (l: address), mpred.
 
 Ltac do_map_arg :=
 match goal with |- ?a = ?b =>
   match a with context [map ?x _] =>
     match b with context [map ?y _] => replace y with x; auto end end end.
 
-
-Lemma yesat_raw_eq_aux:
-  forall pp k rsh sh l,
-    hereditary age
-    (fun phi : rmap =>
-     resource_fmap (approx (level phi)) (approx (level phi)) (phi @ l) =
-     resource_fmap (approx (level phi)) (approx (level phi)) (YES rsh sh k pp)) /\
-    hereditary ext_order
-    (fun phi : rmap =>
-     resource_fmap (approx (level phi)) (approx (level phi)) (phi @ l) =
-     resource_fmap (approx (level phi)) (approx (level phi)) (YES rsh sh k pp)).
-Proof.
- split; repeat intro.
-  generalize (resource_at_approx a l); intro.
-  generalize (resource_at_approx a' l); intro.
-  rewrite H2.
-  rewrite H1 in H0.
-  apply (age1_resource_at a a'  H); auto.
-
-  apply rmap_order in H as (<- & <- & _); auto.
-Qed.
-
-Lemma yesat_raw_eq: yesat_raw =
-  fun pp k rsh sh l =>
-  ((exist (fun p => hereditary age p /\ hereditary ext_order p)
-   (fun phi =>
-   resource_fmap (approx (level phi)) (approx (level phi)) (phi @ l) =
-   resource_fmap (approx (level phi)) (approx (level phi)) (YES rsh sh k pp))
-   (yesat_raw_eq_aux pp k rsh sh l)) : pred rmap).
-Proof.
-unfold yesat_raw.
-extensionality pp k rsh sh l.
-apply exist_ext.
-extensionality phi.
-apply prop_ext; split; intros.
-rewrite H.
-simpl.
-f_equal.
-rewrite preds_fmap_fmap.
-rewrite approx_oo_approx.
-auto.
-simpl in H.
-revert H; case_eq (phi @ l); simpl; intros; inv H0.
-f_equal; try apply proof_irr.
-revert H4; destruct p as [?A ?p]; destruct pp as [?A ?p]; simpl; intros; auto; inv H4.
-clear - H.
-repeat f_equal.
-revert H; unfold resource_at.  rewrite rmap_level_eq.
-case_eq (unsquash phi); simpl; intros.
-rename r0 into f.
-pose proof I.
-set (phi' := ((fun l' => if eq_dec l' l 
-       then YES rsh r k (SomeP A0 (fun i => fmap _ (approx n) (approx n) (p i))) else fst f l', snd f)): rmap').
-assert (phi = squash (n,phi')).
-apply unsquash_inj.
-replace (unsquash phi) with (unsquash (squash (unsquash phi))).
-2: rewrite squash_unsquash; auto.
-rewrite H.
-do 2 rewrite unsquash_squash.
-f_equal.
-unfold phi'.
-clear - H0.
-simpl.
-unfold rmap_fmap.
-unfold compose.
-f_equal.
-extensionality x.
-simpl.
-if_tac; auto.
-subst.
-rewrite H0.
-simpl.
-do 2 apply f_equal.
-extensionality.
-rewrite fmap_app.
-rewrite approx_oo_approx; auto.
-subst phi.
-unfold phi' in H.
-rewrite unsquash_squash in H.
-injection H; clear H; intros.
-destruct f; simpl in *; inv H.
-generalize (equal_f H3 l); intro.
-rewrite H0 in H.
-clear - H.
-unfold compose in H. rewrite if_true in H; auto.
-simpl in H.
-revert H; generalize p at 2 3.
-intros q ?H.
-apply YES_inj in H.
-match goal with
-| H: ?A = ?B |- _ =>
-  assert (snd A = snd B)
-end.
-rewrite H; auto.
-simpl in H0.
-apply SomeP_inj2 in H0.
-subst q.
-extensionality i.
-rewrite fmap_app.
-rewrite approx_oo_approx. auto.
-Qed.
-
-Lemma yesat_eq_aux: 
-  forall pp k sh l, 
-    hereditary age
-    (fun m : rmap =>
-      exists rsh, 
-     resource_fmap (approx (level m)) (approx (level m)) (m @ l) =
-     resource_fmap (approx (level m)) (approx (level m)) (YES sh rsh k pp)) /\
-    hereditary ext_order
-    (fun m : rmap =>
-      exists rsh, 
-     resource_fmap (approx (level m)) (approx (level m)) (m @ l) =
-     resource_fmap (approx (level m)) (approx (level m)) (YES sh rsh k pp)).
-Proof.
- split; repeat intro.
-  destruct H0 as [p ?]; exists p.
-  rewrite resource_at_approx.
-  rewrite resource_at_approx in H0.
-  apply (age1_resource_at a a' H); auto.
-
- apply rmap_order in H as (<- & <- & _); auto.
-Qed.
-
-Lemma yesat_eq: yesat = fun pp k sh l =>
- exist (fun p => hereditary age p /\ hereditary ext_order p)
-  (fun m => 
-  exists rsh, 
-   resource_fmap (approx (level m)) (approx (level m)) (m @ l) = 
-   resource_fmap (approx (level m)) (approx (level m)) (YES sh rsh k pp))
-   (yesat_eq_aux pp k sh l).
-Proof.
-unfold yesat.
-extensionality pp k sh l.
-apply exist_ext. extensionality w.
-apply exists_ext; intro p.
-rewrite yesat_raw_eq.
-auto.
-Qed.
-
-Lemma map_compose_approx_succ_e:
-  forall A n pp pp',
-       map (compose (A:=A) (approx (S n))) pp =
-    map (compose (A:=A) (approx (S n))) pp' ->
-  map (compose (A:=A) (approx n)) pp = map (compose (A:=A) (approx n)) pp'.
-Proof.
-induction pp; intros.
-destruct pp'; inv H; auto.
-destruct pp'; inv H; auto.
-simpl.
-rewrite <- (IHpp pp'); auto.
-replace (approx n oo a) with (approx n oo p); auto.
-clear - H1.
-extensionality x.
-apply pred_ext'. extensionality w.
-generalize (equal_f H1 x); clear H1; intro.
-unfold compose in *.
-assert (approx (S n) (a x) w <-> approx (S n) (p x) w).
-rewrite H; intuition.
-simpl.
-apply and_ext'; auto; intros.
-apply prop_ext.
-intuition.
-destruct H3; auto.
-split; auto.
-destruct H2; auto.
-split; auto.
-Qed.
-
-(* NOT TRUE, because the shares might not match
-Lemma extensionally_yesat: forall pp k sh l, extensionally (yesat pp k sh l) = yesat pp k sh l.
-*)
-
-Program Definition noat (l: AV.address) : pred rmap :=
-    fun m => identity (m @ l).
- Next Obligation.
-    split; repeat intro.
-    apply (proj1 (age1_resource_at_identity _ _ l H) H0); auto.
-
-    apply rmap_order in H as (_ & Hr & _); rewrite <- Hr in H1; auto.
- Qed.
-
-Definition resource_share (r: resource) : option share :=
- match r with
- | YES sh _ _ _ => Some sh
- | NO sh _ => Some sh
- | PURE _ _ => None
- end.
-
-Definition nonlock (r: resource) : Prop :=
- match r with
- | YES _ _ k _ => isVAL k \/ isFUN k
- | NO _ _ => True
- | PURE _ _ => False
- end.
-
-Lemma age1_nonlock: forall phi phi' l,
-  age1 phi = Some phi' -> (nonlock (phi @ l) <-> nonlock (phi' @ l)).
-Proof.
-  intros.
-  destruct (phi @ l) as [rsh | rsh sh k P |] eqn:?H.
-  + pose proof (age1_NO phi phi' l rsh n H).
-    rewrite H1 in H0.
-    rewrite H0.
-    reflexivity.
-  + pose proof (age1_YES' phi phi' l rsh sh k H).
-    destruct H1 as [? _].
-    spec H1; [eauto |].
-    destruct H1 as [P' ?].
-    rewrite H1.
-    reflexivity.
-  + pose proof (age1_PURE phi phi' l k H).
-    destruct H1 as [? _].
-    spec H1; [eauto |].
-    destruct H1 as [P' ?].
-    rewrite H1.
-    reflexivity.
-Qed.
-
-Lemma age1_resource_share: forall phi phi' l,
-  age1 phi = Some phi' -> (resource_share (phi @ l) = resource_share (phi' @ l)).
-Proof.
-  intros.
-  destruct (phi @ l) as [rsh | rsh sh k P |] eqn:?H.
-  + pose proof (age1_NO phi phi' l rsh n H).
-    rewrite H1 in H0.
-    rewrite H0.
-    reflexivity.
-  + pose proof (age1_YES' phi phi' l rsh sh k H).
-    destruct H1 as [? _].
-    spec H1; [eauto |].
-    destruct H1 as [P' ?].
-    rewrite H1.
-    reflexivity.
-  + pose proof (age1_PURE phi phi' l k H).
-    destruct H1 as [? _].
-    spec H1; [eauto |].
-    destruct H1 as [P' ?].
-    rewrite H1.
-    reflexivity.
-Qed.
-
-Lemma resource_share_join_exists: forall r1 r2 r sh1 sh2,
-  resource_share r1 = Some sh1 ->
-  resource_share r2 = Some sh2 ->
-  join r1 r2 r ->
-  exists sh, join sh1 sh2 sh /\ resource_share r = Some sh.
-Proof.
-  intros.
-  destruct r1, r2; try solve [inversion H | inversion H0];
-  inv H; inv H0; inv H1;
-  eexists; split; eauto.
-Qed.
-
-Lemma resource_share_join: forall r1 r2 r sh1 sh2 sh,
-  resource_share r1 = Some sh1 ->
-  resource_share r2 = Some sh2 ->
-  join r1 r2 r ->
-  join sh1 sh2 sh ->
-  resource_share r = Some sh.
-Proof.
-  intros.
-  destruct (resource_share_join_exists _ _ _ _ _ H H0 H1) as [sh' [? ?]].
-  rewrite H4.
-  f_equal.
-  eapply join_eq; eauto.
-Qed.
-
-Lemma resource_share_joins: forall r1 r2 sh1 sh2,
-  resource_share r1 = Some sh1 ->
-  resource_share r2 = Some sh2 ->
-  joins r1 r2 ->
-  joins sh1 sh2.
-Proof.
-  intros.
-  destruct H1 as [r ?].
-  destruct (resource_share_join_exists _ _ _ _ _ H H0 H1) as [sh [? ?]].
-  exists sh.
-  auto.
-Qed.
-
-Lemma nonlock_join: forall r1 r2 r,
+(*Lemma nonlock_join: forall r1 r2 r,
   nonlock r1 ->
   nonlock r2 ->
   join r1 r2 r ->
@@ -351,249 +61,14 @@ Lemma nonlock_join: forall r1 r2 r,
 Proof.
   intros.
   destruct r1, r2; inv H1; auto.
-Qed.
-
-Program Definition nonlockat (l: AV.address): pred rmap :=
-  fun m => nonlock (m @ l).
- Next Obligation.
-    split; repeat intro.
-    unfold resource_share in *.
-    destruct (a @ l) eqn:?H.
-    + rewrite (necR_NO a a' l _ n) in H1 by (constructor; auto).
-      rewrite H1; assumption.
-    + eapply necR_YES in H1; [ | constructor; eassumption].
-      rewrite H1; assumption.
-    + eapply necR_PURE in H1; [ | constructor; eassumption].
-      rewrite H1; assumption.
-    + apply rmap_order in H as (_ & <- & _); auto.
- Qed.
-
-Program Definition shareat (l: AV.address) (sh: share): pred rmap :=
-  fun m => resource_share (m @ l) = Some sh.
- Next Obligation.
-    split; repeat intro.
-    unfold resource_share in *.
-    destruct (a @ l) eqn:?H.
-    + rewrite (necR_NO a a' l _ n) in H1 by (constructor; auto).
-      rewrite H1; assumption.
-    + eapply necR_YES in H1; [ | constructor; eassumption].
-      rewrite H1; assumption.
-    + inv H0.
-    + apply rmap_order in H as (_ & <- & _); auto.
- Qed.
-
-Program Definition jam {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A} {EO: Ext_ord A} {EA: Ext_alg A} {B: Type} {S': B -> Prop} (S: forall l, {S' l}+{~ S' l}) (P Q: B -> pred A) : B -> pred A :=
-  fun (l: B) m => if S l then P l m else Q l m.
- Next Obligation.
-    split; repeat intro.
-  if_tac; try (eapply pred_hereditary; eauto).
-  if_tac; try (eapply pred_upclosed; eauto).
- Qed.
-
-Lemma jam_true: forall A JA PA SA agA AgeA EO EA B (S': B -> Prop) S P Q loc, S' loc -> @jam A JA PA SA agA AgeA EO EA B S' S P Q loc = P loc.
-Proof.
-intros.
-apply pred_ext'.
-extensionality m; unfold jam.
-simpl. rewrite if_true; auto.
-Qed.
-
-Lemma jam_false: forall A JA PA SA agA AgeA EO EA B (S': B -> Prop) S P Q loc, ~ S' loc -> @jam A JA PA SA agA AgeA EO EA B S' S P Q loc = Q loc.
-Proof.
-intros.
-apply pred_ext'.
-extensionality m; unfold jam.
-simpl; rewrite if_false; auto.
-Qed.
-
-Lemma boxy_jam:  forall (m: modality) A (S': A -> Prop) S P Q,
-      (forall (x: A), boxy m (P x)) ->
-      (forall x, boxy m (Q x)) ->
-      forall x, boxy m (@jam rmap _ _ _ _ _ _ _ A S' S P Q x).
-Proof.
-  intros.
-   unfold boxy in *.
-   apply pred_ext; intros w ?.
-   unfold jam in *.
-   simpl in *; if_tac. rewrite <- H . simpl. apply H1.
-   rewrite <- H0; simpl; apply H1.
-   simpl in *; if_tac.
-    rewrite <- H in H1; auto.
-   rewrite <- H0 in H1; auto.
-Qed.
-
-Definition extensible_jam: forall A (S': A -> Prop) S (P Q: A -> pred rmap),
-      (forall (x: A), boxy extendM (P x)) ->
-      (forall x, boxy extendM (Q x)) ->
-      forall x, boxy extendM  (@jam _ _ _ _ _ _ _ _ _ S' S P Q x).
-Proof.
-  apply boxy_jam; auto.
-Qed.
-
-Definition jam_vacuous:
-  forall A JA PA SA agA AgeA EO EA B S S' P Q, (forall x:B, ~ S x) -> @jam A JA PA SA agA AgeA EO EA B S S' P Q = Q.
-Proof.
-intros.
-extensionality l; apply pred_ext'; extensionality w.
-unfold jam.
-simpl; rewrite if_false; auto.
-Qed.
+Qed.*)
 
-Lemma make_sub_rmap: forall w (P: address -> Prop) (P_DEC: forall l, {P l} + {~ P l}),
-  (forall l sh k, P l -> res_option (w @ l) = Some (sh, k) -> isVAL k \/ isFUN k) ->
-  {w' | level w' = level w /\ resource_at w' =
-       (fun l => if P_DEC l then w @ l else core (w @ l)) /\ ghost_of w' = ghost_of w}.
-Proof.
-  intros.
-  apply remake_rmap.
-  intros.
-    if_tac; [left; eauto |].
-    destruct (w @ l) eqn:?H; rewrite ?core_NO, ?core_YES, ?core_PURE; simpl; auto.
-    left.
-    exists w; split; auto.
-    apply ghost_of_approx.
-Qed.
+Definition nonlockat (l: address): mpred := ∀ dq r, l ↦{dq} r → ⌜nonlock r⌝.
 
-Lemma make_sub_rmap_core: forall w (P: address -> Prop) (P_DEC: forall l, {P l} + {~ P l}),
-  (forall l sh k, P l -> res_option (w @ l) = Some (sh, k) -> isVAL k \/ isFUN k) ->
-  {w' | level w' = level w /\ resource_at w' =
-       (fun l => if P_DEC l then w @ l else core (w @ l)) /\ ghost_of w' = core (ghost_of w)}.
-Proof.
-  intros.
-  apply remake_rmap.
-  intros.
-    if_tac; [left; eauto |].
-    destruct (w @ l) eqn:?H; rewrite ?core_NO, ?core_YES, ?core_PURE; simpl; auto.
-    left.
-    exists w; split; auto.
-    apply ghost_fmap_core.
-Qed.
-
-Definition is_resource_pred (p: address -> pred rmap) (q: resource -> address -> nat -> Prop) :=
-  forall l w, (p l) w = q (w @ l) l (level w).
-
-Definition resource_stable (p: address -> pred rmap) :=
-  forall l w w', w @ l = w' @ l -> level w = level w' -> (p l) w = (p l) w'.
-
-Lemma is_resource_pred_resource_stable: forall {p},
-  (exists q, is_resource_pred p q) -> resource_stable p.
-Proof.
-  unfold is_resource_pred, resource_stable.
-  intros.
-  destruct H as [q ?]; rewrite !H.
-  rewrite H0; auto.
-Qed.
-
-(* This is about splitting one segment into two segments. *)
-Lemma allp_jam_split2: forall (P Q R: address -> Prop) (p q r: address -> pred rmap)
-  (P_DEC: forall l, {P l} + {~ P l})
-  (Q_DEC: forall l, {Q l} + {~ Q l})
-  (R_DEC: forall l, {R l} + {~ R l}),
-  (exists resp, is_resource_pred p resp) ->
-  (exists resp, is_resource_pred q resp) ->
-  (exists resp, is_resource_pred r resp) ->
-  Ensemble_join Q R P ->
-  (forall l, Q l -> p l = q l) ->
-  (forall l, R l -> p l = r l) ->
-  (forall l m sh k, P l -> (p l) m -> res_option (m @ l) = Some (sh, k) -> isVAL k \/ isFUN k) ->
-  allp (jam P_DEC p noat) =
-  (allp (jam Q_DEC q noat)) * (allp (jam R_DEC r noat)).
-Proof.
-  intros until R_DEC.
-  intros ST_P ST_Q ST_R.
-  intros [] ? ? ?.
-  apply pred_ext; intros w; simpl; intros.
-  + destruct (make_sub_rmap_core w Q Q_DEC) as [w1 [? ?]].
-    {
-      intros. eapply H3; [| | eauto].
-      + firstorder.
-      + specialize (H4 l); if_tac in H4; [auto | firstorder].
-    }
-    destruct (make_sub_rmap w R R_DEC) as [w2 [? ?]].
-    {
-      intros. eapply H3; [| | eauto].
-      + firstorder.
-      + specialize (H4 l); if_tac in H4; [auto | firstorder].
-    }
-    exists w1, w2.
-    split3; auto.
-    - apply resource_at_join2; try congruence.
-      intro l.
-      destruct H6, H8.
-      rewrite H6, H8.
-      pose proof core_unit (w @ l).
-      destruct (Q_DEC l), (R_DEC l).
-      * firstorder.
-      * apply join_comm; auto.
-      * auto.
-      * specialize (H4 l).
-        rewrite if_false in H4 by firstorder.
-        rewrite identity_core by auto.
-        apply core_duplicable.
-      * destruct H6 as [_ ->], H8 as [_ ->].
-        apply core_unit.
-    - intros l.
-      specialize (H4 l).
-      if_tac.
-      * rewrite <- H1 by auto.
-        rewrite if_true in H4 by firstorder.
-        erewrite <- (is_resource_pred_resource_stable ST_P); [eauto | | auto].
-        destruct H6; rewrite H6, if_true by auto; auto.
-      * destruct H6; rewrite H6, if_false by auto.
-        apply core_identity.
-    - intros l.
-      specialize (H4 l).
-      if_tac.
-      * rewrite <- H2 by auto.
-        rewrite if_true in H4 by firstorder.
-        erewrite <- (is_resource_pred_resource_stable ST_P); [eauto | | auto].
-        destruct H8; rewrite H8, if_true by auto; auto.
-      * destruct H8; rewrite H8, if_false by auto.
-        apply core_identity.
-  + destruct H4 as [y [z [? [H5 H6]]]].
-    specialize (H5 b); specialize (H6 b).
-    if_tac.
-    - if_tac in H5; if_tac in H6.
-      * firstorder.
-      * rewrite H1 by auto.
-        erewrite (is_resource_pred_resource_stable ST_Q); [eauto | | apply join_level in H4; symmetry; tauto].
-        apply resource_at_join with (loc := b) in H4.
-        apply join_comm, H6 in H4.
-        auto.
-      * rewrite H2 by auto; auto.
-        erewrite (is_resource_pred_resource_stable ST_R); [eauto | | apply join_level in H4; symmetry; tauto].
-        apply resource_at_join with (loc := b) in H4.
-        apply H5 in H4.
-        auto.
-      * firstorder.
-    - rewrite if_false in H5 by firstorder.
-      rewrite if_false in H6 by firstorder.
-      apply resource_at_join with (loc := b) in H4.
-      apply H5 in H4; rewrite <- H4; auto.
-Qed.
-
-
-Lemma allp_jam_overlap: forall (P Q: address -> Prop) (p q: address -> pred rmap)
-  (P_DEC: forall l, {P l} + {~ P l})
-  (Q_DEC: forall l, {Q l} + {~ Q l}),
-  (exists resp, is_resource_pred p resp) ->
-  (exists resp, is_resource_pred q resp) ->
-  (forall l w1 w2, p l w1 -> q l w2 -> joins w1 w2 -> False) ->
-  (exists l, P l /\ Q l) ->
-  allp (jam P_DEC p noat) * allp (jam Q_DEC q noat) |-- FF.
-Proof.
-  intros.
-  intro w; simpl; intros.
-  destruct H3 as [w1 [w2 [? [? ?]]]].
-  destruct H2 as [l ?].
-  specialize (H4 l).
-  specialize (H5 l).
-  rewrite if_true in H4, H5 by tauto.
-  apply (H1 l w1 w2); auto.
-  eauto.
-Qed.
+Definition shareat (l: address) (sh: share): mpred :=
+  if readable_share_dec sh then (∃r, l ↦{#sh} r)%I else mapsto_no l sh.
 
-Lemma yesat_join_diff:
+(*Lemma yesat_join_diff:
   forall pp pp' k k' sh sh' l w, k <> k' -> 
                   yesat pp k sh l w -> yesat pp' k' sh' l w -> False.
 Proof.
@@ -669,65 +144,58 @@ Lemma YES_ext:
   forall sh sh' rsh rsh' k p, sh=sh' -> YES sh rsh k p = YES sh' rsh' k p.
 Proof.
 intros. subst. f_equal. apply proof_irr.
-Qed.
+Qed.*)
 
 (****** Specific specs  ****************)
 
-(* Memory predicates need to explicitly not capture any ghost state,
-   at least until we add the extension order. *)
 Definition VALspec : spec :=
-       fun (sh: Share.t) (l: address) =>
-          allp (jam (eq_dec l)
-                                  (fun l' => EX v: memval, 
-                                                yesat NoneP (VAL v) sh l')
-                                  noat).
+       fun (sh: share) (l: address) => ∃v, l ↦{#sh} VAL v.
 
 Definition VALspec_range (n: Z) : spec :=
-     fun (sh: Share.t) (l: address) =>
-          allp (jam (adr_range_dec l n)
-                                  (fun l' => EX v: memval, 
-                                                yesat NoneP (VAL v) sh l')
-                                  noat).
+     fun (sh: Share.t) (l: address) => [∗ list] i ∈ seq 0 (Z.to_nat n), VALspec sh (adr_add l (Z.of_nat i)).
 
-Definition nonlock_permission_bytes (sh: share) (a: address) (n: Z) : pred rmap :=
-  allp (jam (adr_range_dec a n) (fun i => shareat i sh && nonlockat i) noat).
+Definition nonlock_permission_bytes (sh: share) (a: address) (n: Z) : mpred :=
+  [∗ list] i ∈ seq 0 (Z.to_nat n), if readable_share_dec sh then ∃ r, ⌜nonlock r⌝ ∧ adr_add a (Z.of_nat i) ↦{#sh} r
+                                   else mapsto_no (adr_add a (Z.of_nat i)) sh.
 
 Definition nthbyte (n: Z) (l: list memval) : memval :=
      nth (Z.to_nat n) l Undef.
 
-(*  Unfortunately address_mapsto_old, while a more elegant definition than
-   address_mapsto, is not quite right.  For example, it doesn't uniquely determine v *)
-Definition address_mapsto_old (ch: memory_chunk) (v: val) : spec :=
-        fun (sh: Share.t) (l: AV.address)  => 
-             allp (jam (adr_range_dec l (size_chunk ch)) 
-                              (fun l' => yesat NoneP (VAL (nthbyte (snd l' - snd l) (encode_val ch v))) sh l')
-                           noat).
-
 Definition address_mapsto (ch: memory_chunk) (v: val) : spec :=
-        fun (sh: Share.t) (l: AV.address) =>
-           EX bl: list memval, 
-               !! (length bl = size_chunk_nat ch  /\ decode_val ch bl = v /\ (align_chunk ch | snd l))  &&
-                (allp (jam (adr_range_dec l (size_chunk ch))
-                                    (fun loc => yesat NoneP (VAL (nth (Z.to_nat (snd loc - snd l)) bl Undef)) sh loc)
-                                    noat)).
+        fun (sh: Share.t) (l: address) =>
+           ∃ bl: list memval, 
+               ⌜length bl = size_chunk_nat ch  /\ decode_val ch bl = v /\ (align_chunk ch | snd l)⌝ ∧
+               [∗ list] i↦b ∈ bl, adr_add l (Z.of_nat i) ↦{#sh} (VAL b).
+
+Lemma add_and : forall {PROP : bi} (P Q : PROP), (P ⊢ Q) -> (P ⊢ P ∧ Q).
+Proof.
+  intros; iIntros; iSplit; [|rewrite H]; done.
+Qed.
 
 Lemma address_mapsto_align: forall ch v sh l,
-  address_mapsto ch v sh l = address_mapsto ch v sh l && !! (align_chunk ch | snd l).
+  address_mapsto ch v sh l ⊣⊢ address_mapsto ch v sh l ∧ ⌜(align_chunk ch | snd l)⌝.
 Proof.
   intros.
-  pose proof (@add_andp (pred rmap) _); simpl in H. apply H; clear H.
-  constructor; unfold address_mapsto.
-  apply exp_left; intro.
-  apply andp_left1.
-  intros ? [? [? ?]].
-  auto.
+  iSplit.
+  - iApply add_and.
+    unfold address_mapsto.
+    by iIntros "H"; iDestruct "H" as (bl) "((% & % & %) & ?)".
+  - by iIntros "[? _]".
 Qed.
 
+(*Lemma mapsto_fun: forall l sh sh' v v', mapsto l sh v ∧ mapsto l sh' v' ⊢ ⌜v=v'⌝.
+Proof.
+  intros; unfold mapsto.
+  iIntros "?".
+  iApply ghost_map_elem_agree.
+  Search ghost_map_elem.
+
 Lemma address_mapsto_fun:
   forall ch sh sh' l v v',
-          (address_mapsto ch v sh l * TT) && (address_mapsto ch v' sh' l * TT) |-- !!(v=v').
+          (address_mapsto ch v sh l ∗ True) ∧ (address_mapsto ch v' sh' l ∗ True) ⊢ ⌜v=v'⌝.
 Proof.
 intros.
+iIntros "[H1 ?]".
 intros m [? ?]. unfold prop.
 destruct H as [m1 [m2 [J [[bl [[Hlen [? _]] ?]] _]]]].
 destruct H0 as [m1' [m2' [J' [[bl' [[Hlen' [? _]] ?]] _]]]].
@@ -783,17 +251,22 @@ specialize( H (S i)).
 simpl in H.
 auto.
 simpl; auto.
-Qed.
+Qed.*)
 
-Definition LKspec lock_size (R: pred rmap) : spec :=
-   fun (sh: Share.t) (l: AV.address)  =>
-    allp (jam (adr_range_dec l lock_size)
-               (fun l' => yesat (SomeP Mpred (fun _ => R)) (LK lock_size (snd l' - snd l)) sh l')
-               noat).
+(* Read-only locations can't be deallocated, but might be appropriate for e.g. global variables. *)
+Definition address_mapsto_readonly (ch: memory_chunk) (v: val) :=
+        fun (l: address) =>
+           ∃ bl: list memval, 
+               ⌜length bl = size_chunk_nat ch  /\ decode_val ch bl = v /\ (align_chunk ch | snd l)⌝ ∧
+               [∗ list] i↦b ∈ bl, adr_add l (Z.of_nat i) ↦□ (VAL b).
 
-Definition TTat (l: address) : pred rmap := TT.
+Definition LKspec lock_size b : spec :=
+   fun (sh: Share.t) (l: address) =>
+    [∗ list] i ∈ seq 0 (Z.to_nat lock_size), adr_add l (Z.of_nat i) ↦{#sh} LK lock_size (Z.of_nat i) b.
 
-Lemma address_mapsto_old_parametric: forall ch v, 
+Definition Trueat (l: address) : mpred := True.
+
+(*Lemma address_mapsto_old_parametric: forall ch v, 
    spec_parametric (fun l sh l' => yesat NoneP (VAL (nthbyte (snd l' - snd l) (encode_val ch v))) sh l').
 Proof.
 intros.
@@ -814,7 +287,7 @@ subst; auto.
 Qed.
 
 Lemma VALspec_parametric: 
-  spec_parametric (fun l sh l' => EX v: memval,  yesat NoneP (VAL v) sh l').
+  spec_parametric (fun l sh l' => ∃ v: memval,  yesat NoneP (VAL v) sh l').
 Proof.
 intros.
 exists NoneP.
@@ -833,7 +306,7 @@ exists p.
 auto.
 Qed.
 
-Lemma LKspec_parametric lock_size: forall R: pred rmap,
+Lemma LKspec_parametric lock_size: forall R: iProp Σ,
   spec_parametric (fun l sh l' => yesat (SomeP Mpred (fun _ => R)) (LK lock_size (snd l' - snd l)) sh l').
 Proof.
 intros.
@@ -850,13 +323,13 @@ econstructor.  split; eauto.
 
 destruct H as [k [? ?]].
 subst; auto.
-Qed.
+Qed.*)
 
-Definition val2address (v: val) : option AV.address := 
+Definition val2address (v: val) : option address := 
   match v with Vptr b ofs => Some (b, Ptrofs.signed ofs) | _ => None end.
 
-Lemma VALspec_readable:
-  forall l sh w,  (VALspec sh l * TT) %pred w -> readable l w.
+(*Lemma VALspec_readable:
+  forall l sh w,  (VALspec sh l * True) %pred w -> readable l w.
 (* The converse is not quite true, because "readable" does constraint to NoneP *)
 Proof.
 unfold VALspec, readable;
@@ -869,73 +342,32 @@ destruct H0 as [v [p ?]].
 unfold yesat_raw in H0.
 generalize (resource_at_join _ _ _ l H); rewrite H0; intro Hx.
 inv Hx; auto.
-Qed.
+Qed.*)
 
 
 (* NOT TRUE, because of CompCert_AV.valid problems.
 Lemma jam_con: forall A (S: A -> Prop) P Q,
-     allp (jam S P Q) |-- allp (jam S P (fun _ => emp)) * (allp (jam S (fun _ => emp) Q)).
+     allp (jam S P Q) ⊢ allp (jam S P (fun _ => emp)) * (allp (jam S (fun _ => emp) Q)).
 *)
 
 Lemma address_mapsto_VALspec:
   forall ch v sh l i, 0 <= i < size_chunk ch ->
-        address_mapsto ch v sh l |-- VALspec sh (adr_add l i) * TT.
+        address_mapsto ch v sh l ⊢ VALspec sh (adr_add l i) ∗ True.
 Proof.
-intros. intros w ?.
-pose (f l' := if eq_dec (adr_add l i) l' then w @ l' 
-                   else if adr_range_dec l (size_chunk ch) l' then NO Share.bot bot_unreadable else w @ l').
-pose (g l' := if eq_dec (adr_add l i) l' then NO Share.bot bot_unreadable else w @ l').
-exploit (deallocate (w) f g); intros.
-*
-unfold f,g; clear f g.
-destruct H0 as [b [? ?]]. specialize (H1 l0).  hnf in H1.
-if_tac in H1. destruct H1.  hnf in H1. if_tac; rewrite H1; constructor.
-apply join_unit2; auto.
-apply join_unit1; auto.
-if_tac.
-contradiction H2. unfold adr_add in H3; destruct l; destruct l0; simpl in H3. inv H3.
-split; auto. lia.
-do 3 red in H1. apply identity_unit' in H1. auto.
-*
-apply join_comm, core_unit.
-*
-destruct H1 as [phi1 [phi2 [? ?]]].
-exists phi1; exists phi2.
-split; auto.
-split; auto.
-unfold VALspec.
-intro l'.
-unfold jam in *.
-destruct H0 as [bl [H0' ?]].
-specialize (H0 l').
-unfold jam in H0.
-hnf in H0|-*; if_tac.
-subst l'.
-rewrite if_true in H0.
-destruct H0.
-unfold yesat_raw in H0.
-destruct H2 as [H2 _].
-pose proof (equal_f H2 (adr_add l i)).
-unfold f in H3.
-rewrite if_true in H3.
-rewrite H0 in H3.
-exists (nth (Z.to_nat (snd (adr_add l i) - snd l)) bl Undef).
-exists x.
-unfold yesat_raw.
-hnf in H0|-*.
-repeat rewrite preds_fmap_NoneP in *.
-auto.
-destruct l; unfold adr_range, adr_add. split; auto.
-destruct l; unfold adr_range, adr_add. split; auto.
-simpl; lia.
-do 3 red.
-destruct H2 as [-> _]. unfold f.
-rewrite if_false; auto.
-if_tac. apply NO_identity. apply H0.
+intros.
+rewrite /address_mapsto /VALspec; iIntros "H".
+iDestruct "H" as (bl) "[% H]".
+rewrite bi.sep_exist_r.
+iExists (nthbyte i bl).
+rewrite size_chunk_conv in H.
+rewrite big_sepL_lookup_acc.
+rewrite -> (Z2Nat.id i) by tauto.
+iDestruct "H" as "[$ $]".
+{ rewrite /nthbyte nth_lookup.
+  destruct (lookup_lt_is_Some_2 bl (Z.to_nat i)) as [? ->]; [lia | done]. }
 Qed.
 
-
-Lemma address_mapsto_exists:
+(*Lemma address_mapsto_exists:
   forall ch v sh (rsh: readable_share sh) loc w0
       (RESERVE: forall l', adr_range loc (size_chunk ch) l' -> w0 @ l' = NO Share.bot bot_unreadable),
       (align_chunk ch | snd loc) ->
@@ -982,299 +414,74 @@ split.
   { rewrite <- core_ghost_of.
     destruct H1 as [_ ->].
     rewrite core_ghost_of; auto. }
-Qed.
+Qed.*)
 
 (*  NOT TRUE, because readable doesn't constraint NoneP ...
 Lemma readable_VAL:
- forall w l, readable l (w_m w) <-> exists sh, (VALspec sh l * TT) w.
+ forall w l, readable l (w_m w) <-> exists sh, (VALspec sh l * True) w.
 
 *)
 
-Lemma VALspec1: VALspec_range 1 = VALspec.
+Lemma VALspec1: forall sh l, VALspec_range 1 sh l ⊣⊢ VALspec sh l.
 Proof.
-unfold VALspec, VALspec_range.
-extensionality sh l.
-f_equal.
-unfold jam.
-extensionality l'.
-apply exist_ext; extensionality m.
-symmetry.
-if_tac.
- subst l'. rewrite if_true; auto.
-destruct l; split; auto; lia.
-rewrite if_false; auto.
-destruct l; destruct l'; unfold block in *; intros [? ?]; try lia.
-subst.
-contradict H. f_equal; lia.
+unfold VALspec_range; intros; simpl.
+rewrite right_id.
+unfold adr_add; destruct l.
+by rewrite Z.add_0_r.
 Qed.
 
 Lemma VALspec_range_exp_address_mapsto:
   forall ch sh l,
     (align_chunk ch | snd l) ->
-    VALspec_range (size_chunk ch) sh l |-- EX v: val, address_mapsto ch v sh l.
+    VALspec_range (size_chunk ch) sh l ⊢ ∃ v: val, address_mapsto ch v sh l.
 Proof.
   intros.
-  intros w ?.
-  simpl in H0 |- *.
-  cut (exists (b0 : list memval),
-     length b0 = size_chunk_nat ch /\
-     (forall b1 : address,
-      if adr_range_dec l (size_chunk ch) b1
-      then
-       exists rsh: readable_share sh,
-         w @ b1 =
-         YES sh rsh
-           (VAL (nth (Z.to_nat (snd b1 - snd l)) b0 Undef))
-           (SomeP (ConstType unit) (fun _ => tt))
-      else identity (w @ b1))).
-  {
-    intros.
-    destruct H1 as [b0 [? ?]].
-    exists (decode_val ch b0), b0.
-    tauto.
-  }
-  rewrite !size_chunk_conv in *.
-  forget (size_chunk_nat ch) as n; clear - H0.
-
-  cut (exists b0 : list memval,
-     length b0 = n /\
-     (forall b1 : address,
-        adr_range l (Z.of_nat n) b1 ->
-       exists rsh: readable_share sh,
-         w @ b1 =
-         YES sh rsh
-           (VAL (nth (Z.to_nat (snd b1 - snd l)) b0 Undef))
-           (SomeP (ConstType unit) (fun _ => tt)))).
-  {
-    intros.
-    destruct H as [b0 H].
-    exists b0.
-    split; [tauto |].
-    intros b; specialize (H0 b).
-    if_tac; [apply (proj2 H) |]; auto.
-  }
-
-  assert (forall b : address,
-    adr_range l (Z.of_nat n) b ->
-        exists (b0 : memval) (rsh : readable_share sh),
-          w @ b =
-          YES sh rsh (VAL b0)
-            (SomeP (ConstType unit) (fun _ => tt))).
-  {
-    intros.
-    specialize (H0 b).
-    if_tac in H0; tauto.
-  }
-  clear H0.
-
-  destruct l as [bl ofs].
-  revert ofs H; induction n; intros.
-  + exists nil.
-    split; auto.
-    intros b.
-    specialize (H b).
-    auto.
-    intros.
-    apply adr_range_non_zero in H0.
-    simpl in H0; lia.
-  + specialize (IHn (ofs + 1)).
-    spec IHn.
-    - clear - H; intros b; specialize (H b).
-      intros; spec H; auto.
-      apply adr_range_shift_1; auto.
-    - assert (adr_range (bl, ofs) (Z.of_nat (S n)) (bl, ofs))
-        by (rewrite Nat2Z.inj_succ; repeat split; auto; lia).
-      destruct (H _ H0) as [b_hd ?H]; clear H0.
-      destruct IHn as [b_tl ?H].
-      exists (b_hd :: b_tl).
-      split; [simpl; lia |]; destruct H0 as [_ ?].
-      intros.
-      apply adr_range_S_split in H2.
-      destruct H2.
-      * destruct (H0 b1 H2) as [p ?H].
-        destruct b1; destruct H2 as [_ ?].
-        exists p; clear - H2 H3.
-        unfold snd in *.
-        replace (Z.to_nat (z - ofs)) with (S (Z.to_nat (z - (ofs + 1)))); [exact H3 |].
-        replace (z - ofs) with (Z.succ (z - (ofs + 1))) by lia.
-        rewrite Z2Nat.inj_succ; auto.
-        lia.
-      * subst. rewrite Z.sub_diag. simpl nth.
-        exact H1.
-Qed.
+  unfold VALspec_range, VALspec, address_mapsto.
+  trans (∃ (bl : list memval), ⌜length bl = size_chunk_nat ch ∧ (align_chunk ch | l.2)⌝
+   ∧ ([∗ list] i↦b ∈ bl, adr_add l (Z.of_nat i) ↦{#sh} (VAL b))).
+  2: { iIntros "H"; iDestruct "H" as (bl [??]) "H"; iExists (decode_val ch bl), bl; auto. }
+  rewrite size_chunk_conv Nat2Z.id.
+  forget (size_chunk_nat ch) as n.
+  induction n.
+  - simpl; iIntros "_".
+    by iExists nil; simpl.
+  - rewrite seq_S big_sepL_app /=.
+    iIntros "(H & Hv & _)".
+    iDestruct "Hv" as (v) "Hv".
+    iDestruct (IHn with "H") as (bl [??]) "H"; subst.
+    iExists (bl ++ [v]); iSplit.
+    { rewrite app_length /=; iPureIntro; split; auto; lia. }
+    rewrite big_sepL_app /= Nat.add_0_r; iFrame.
+Qed.
+
+Lemma big_sepL_seq : forall {A} `{Inhabited A} l (f : nat -> A -> mpred),
+  equiv ([∗ list] k↦y ∈ l, f k y) ([∗ list] i ∈ seq 0 (length l), f i (nth i l inhabitant)).
+Proof.
+  intros; remember (rev l) as l'; generalize dependent l; induction l'; intros.
+  { by destruct l; [|apply app_cons_not_nil in Heql']. }
+  apply (f_equal (@rev _)) in Heql'; rewrite rev_involutive in Heql'; subst; simpl.
+  rewrite app_length seq_app !big_opL_app IHl'; last by rewrite rev_involutive.
+  simpl; rewrite nth_middle Nat.add_0_r.
+  rewrite -(big_opL_ext (fun _ y => f y (nth y (rev l' ++ [a]) inhabitant))); first done.
+  intros ??[-> ?]%lookup_seq.
+  rewrite app_nth1 //.
+Qed.
+
+Global Instance memval_inhabited : Inhabited memval := { inhabitant := Undef }.
 
 Lemma address_mapsto_VALspec_range:
   forall ch v sh l,
-        address_mapsto ch v sh l |-- VALspec_range (size_chunk ch) sh l.
+        address_mapsto ch v sh l ⊢ VALspec_range (size_chunk ch) sh l.
 Proof.
 intros.
-intros w ?. unfold VALspec_range.
-destruct H as [bl [Hbl ?]].
-intro l'.
-specialize ( H l').
-unfold jam in *.
-hnf in H|-*. if_tac; auto.
-exists (nth (Z.to_nat (snd l' - snd l)) bl Undef).
-destruct H as [p ?].
-exists p.
-auto.
-Qed.
-
-Lemma approx_eq_i:
-  forall (P Q: pred rmap) (w: rmap),
-      (|> ! (P <=> Q)) w -> approx (level w) P = approx (level w) Q.
-Proof.
-intros.
-apply pred_ext'; extensionality m'.
-unfold approx.
-apply and_ext'; auto; intros.
-destruct (level_later_fash _ _ H0) as [m1 [? ?]].
-specialize (H _ H1).
-specialize (H m').
-spec H.
-rewrite H2; auto.
-destruct H; apply prop_ext. intuition eauto.
+unfold address_mapsto, VALspec_range.
+iIntros "H"; iDestruct "H" as (bl (? & ? & ?)) "H".
+rewrite size_chunk_conv Nat2Z.id -H big_sepL_seq.
+iApply (big_sepL_mono with "H").
+by intros; iIntros "?"; iExists _.
 Qed.
 
-Lemma level_later {A} `{H : ageable A}: forall {w: A} {n': nat},
-         laterR (level w) n' ->
-       exists w', laterR w w' /\ n' = level w'.
-Proof.
-intros.
-remember (level w) as n.
-revert w Heqn; induction H0; intros; subst.
-case_eq (age1 w); intros.
-exists a; split. constructor; auto.
-symmetry; unfold age in H0; simpl in H0.
-  unfold natAge1 in H0; simpl in H0. revert H0; case_eq (level w); intros; inv H2.
-  apply age_level in H1. congruence. rewrite age1_level0 in H1.
-   rewrite H1 in H0. inv H0.
- specialize (IHclos_trans1 _ (refl_equal _)).
-  destruct IHclos_trans1 as [w2 [? ?]].
-  subst.
-  specialize (IHclos_trans2 _ (refl_equal _)).
-  destruct IHclos_trans2 as [w3 [? ?]].
-  subst.
-  exists w3; split; auto. econstructor 2; eauto.
-Qed.
-
-(* TODO: resume this lemma. *)
 (*
-Lemma fun_assert_contractive:
-   forall fml cc (A: TypeTree)
-     (P Q: pred rmap -> forall ts, dependent_type_functor_rec ts (AssertTT A) (pred rmap)) v,
-      (forall ts x rho, nonexpansive (fun R => P R ts x rho)) ->
-      (forall ts x rho, nonexpansive (fun R => Q R ts x rho)) ->
-      contractive (fun R : pred rmap => fun_assert fml cc A (P R) (Q R) v).
-Proof.
-  intros.
-  (*
-  assert (H': forall xvl: A * environ, nonexpansive (fun R => P R (fst xvl) (snd xvl)))
-    by auto; clear H; rename H' into H.
-  assert (H': forall xvl: A * environ, nonexpansive (fun R => Q R (fst xvl) (snd xvl)))
-    by auto; clear H0; rename H' into H0.
-  *)
-  intro; intros.
-  rename H0 into H'.
-  intro; intros.
-  intro; intros; split; intros ? ? H7; simpl in H1.
-  + assert (a >= level a')%nat.
-    {
-      apply necR_level in H2. clear - H1 H2.
-      apply le_trans with (level y); auto.
-    }
-    clear y H1 H2. rename H3 into H2.
-    hnf.
-    destruct H7 as [loc H7].
-    hnf in H7. destruct H7 as [H1 H3].  hnf in H1.
-    exists loc.
-    apply prop_andp_i; auto.
-    split; auto.
-    hnf in H3|-*.
-    intro; specialize ( H3 b).
-    hnf in H3|-*.
-    if_tac; auto.
-    subst b.
-    hnf in H3|-*.
-    rewrite H3; clear H3.
-    f_equal.
-    simpl.
-    f_equal.
-    extensionality ts.
-    extensionality x.
-    extensionality b.
-    extensionality rho.
-    unfold packPQ.
-    simpl.
-    if_tac.
-    - (* P proof *)
-      specialize ( H ts x rho P0 Q0).
-Check approx_eq_i.
-      apply approx_eq_i.
-pose proof (later_derives (unfash_derives H)).
-      apply (later_derives (unfash_derives H)); clear H.
-      rewrite later_unfash.
-      unfold unfash.
-      red. red.
-      apply pred_nec_hereditary with a; auto.
-      apply nec_nat; auto.
-(* Q proof *)
-clear H; rename H' into H.
-specialize ( H (x,vl) P0 Q0).
-apply approx_eq_i.
-apply (later_derives (unfash_derives H)); clear H.
-rewrite later_unfash.
-red. red. red.
-apply pred_nec_hereditary with a; auto.
-apply nec_nat; auto.
-(* Part 2 *)
-assert (a >= level a')%nat.
- apply necR_level in H2. clear - H1 H2. apply le_trans with (level y); auto.
- clear y H1 H2. rename H3 into H2.
-unfold fun_assert.
-destruct H7 as [loc H7].
-hnf in H7. destruct H7 as [H1 H3].  hnf in H1.
-exists loc.
-apply prop_andp_i; auto.
-split; auto.
-hnf.
-intro.
-specialize ( H3 b).
-hnf in H3|-*.
-if_tac; auto.
-subst b.
-hnf in H3|-*.
-unfold yesat_raw in *.
-rewrite H3; clear H3.
-f_equal.
-simpl.
-f_equal.
-unfold compose.
-extensionality xy; destruct xy as [x [y [vl [ ] ]]].
-unfold packPQ.
-simpl.
-if_tac.
-(* P proof *)
-specialize ( H (x,vl) P0 Q0).
-symmetry.
-apply approx_eq_i.
-apply (later_derives (unfash_derives H)); clear H.
-rewrite later_unfash.
-red. red. red.
-apply pred_nec_hereditary with a; auto.
-apply nec_nat; auto.
-(* Q proof *)
-clear H; rename H' into H.
-specialize ( H (x,vl) P0 Q0).
-symmetry.
-apply approx_eq_i.
-apply (later_derives (unfash_derives H)); clear H.
-rewrite later_unfash.
-red. red. red.
-apply pred_nec_hereditary with a; auto.
-apply nec_nat; auto.
-Qed.
-*)
 Lemma VALspec_range_bytes_readable:
   forall n sh loc m, VALspec_range n sh loc m -> bytes_readable loc n m.
 Proof.
@@ -1325,43 +532,9 @@ unfold yesat. simpl.
 exists r0.
 rewrite <- H2. rewrite H3.
 subst; f_equal; auto.
-Qed.
+Qed.*)
 
-Program Definition core_load (ch: memory_chunk) (l: address) (v: val): pred rmap :=
-  EX bl: list memval,
-  !!(length bl = size_chunk_nat ch /\ decode_val ch bl = v /\ (align_chunk ch | snd l)) &&
-    allp (jam (adr_range_dec l (size_chunk ch))
-      (fun l' phi => exists sh, exists rsh, phi @ l' 
-        = YES sh rsh (VAL (nth (Z.to_nat (snd l' - snd l)) bl Undef)) NoneP)
-      (fun _ _ => True)).
- Next Obligation.
-    split; repeat intro.
-    destruct H0 as [sh [rsh ?]]; exists sh, rsh.
-    apply (age1_YES a a'); auto.
-
-    apply rmap_order in H as (_ & <- & _); auto.
-  Qed.
-  Next Obligation.     split; repeat intro; auto.
-  Qed.
-
-Program Definition core_load' (ch: memory_chunk) (l: address) (v: val) (bl: list memval)
-  : pred rmap :=
-  !!(length bl = size_chunk_nat ch /\ decode_val ch bl = v /\ (align_chunk ch | snd l)) &&
-    allp (jam (adr_range_dec l (size_chunk ch))
-      (fun l' phi => exists sh, exists rsh, phi @ l' 
-        = YES sh rsh (VAL (nth (Z.to_nat (snd l' - snd l)) bl Undef)) NoneP)
-      (fun _ _ => True)).
- Next Obligation.
-    split; repeat intro.
-    destruct H0 as [sh [rsh ?]]; exists sh, rsh.
-    apply (age1_YES a a'); auto.
-
-    apply rmap_order in H as (_ & <- & _); auto.
-  Qed.
-  Next Obligation.     split; repeat intro; auto.
-  Qed.
-
-Lemma emp_no : emp = (ALL l, noat l).
+(*Lemma emp_no : emp = (ALL l, noat l).
 Proof.
   apply pred_ext.
   - intros ? (? & ? & Hord) ?; simpl.
@@ -1372,40 +545,31 @@ Proof.
     split; auto; split; [|eexists; constructor].
     extensionality l; specialize (H l).
     rewrite <- core_resource_at; symmetry; apply identity_core; auto.
-Qed.
+Qed.*)
 
-Lemma VALspec_range_0: forall sh loc, VALspec_range 0 sh loc = emp.
+Lemma VALspec_range_0: forall sh loc, VALspec_range 0 sh loc ⊣⊢ emp.
 Proof.
- intros.
- rewrite emp_no.
- apply pred_ext.
- - intros ? H l. simpl in *.
-   specialize (H l); rewrite if_false in H; auto.
-   { unfold adr_range. destruct loc, l; intros []; lia. }
- - intros ? H l. simpl in *.
-   rewrite if_false; auto.
-   { unfold adr_range. destruct loc, l; intros []; lia. }
+  done.
 Qed.
-#[export] Hint Resolve VALspec_range_0: normalize.
 
-Lemma nonlock_permission_bytes_0: forall sh a, nonlock_permission_bytes sh a 0 = emp.
+Lemma nonlock_permission_bytes_0: forall sh a, nonlock_permission_bytes sh a 0 ⊣⊢ emp.
 Proof.
-  intros.
-  rewrite emp_no.
-  apply pred_ext.
-  + intros ? H l. simpl in *.
-    specialize (H l); rewrite if_false in H; auto.
-   { unfold adr_range. destruct a, l; intros []; lia. }
-  + intros ? H l. simpl in *.
-    rewrite if_false; auto.
-   { unfold adr_range. destruct a, l; intros []; lia. }
+  done.
 Qed.
 
-Lemma nonlock_permission_bytes_not_nonunit: forall sh p n,
-  ~ nonunit sh ->
-  nonlock_permission_bytes sh p n |-- emp.
+(*Lemma nonlock_permission_bytes_valid : forall sh a n, n > 0 -> nonlock_permission_bytes sh a n ⊢ ⌜✓ sh⌝.
+Proof.
+  intros; rewrite /nonlock_permission_bytes.
+  destruct (Z.to_nat n) eqn: Hn; first lia.
+  simpl; iIntros "H"; if_tac; first by iPureIntro; intros ->; contradiction bot_unreadable.
+  by iDestruct "H" as "[H _]"; iDestruct (mapsto_no_valid with "H") as %[??].
+Qed.*)
+
+(*Lemma nonlock_permission_bytes_not_nonunit: forall p n,
+  nonlock_permission_bytes Share.bot p n ⊢ emp.
 Proof.
   intros.
+  rewrite /nonlock_permission_bytes /shareat.
   assert (sh = Share.bot).
   {
     destruct (dec_share_identity sh).
@@ -1424,7 +588,7 @@ Qed.
 
 Lemma is_resource_pred_YES_VAL sh:
   is_resource_pred
-    (fun l' => EX  v: memval, yesat NoneP (VAL v) sh l')
+    (fun l' => ∃  v: memval, yesat NoneP (VAL v) sh l')
     (fun r _ n => (exists b0 rsh, r = YES sh rsh (VAL b0)
         (SomeP (ConstType unit) (fun _ => tt)))).
 Proof. hnf; intros. reflexivity. Qed.
@@ -1438,162 +602,167 @@ Proof. hnf; intros. reflexivity. Qed.
 
 Lemma is_resource_pred_nonlock_shareat sh:
   is_resource_pred
-    (fun i : address => shareat i sh && nonlockat i)
+    (fun i : address => shareat i sh ∧ nonlockat i)
     (fun r _ _ => resource_share r = Some sh /\ nonlock r).
-Proof. hnf; intros. reflexivity. Qed.
+Proof. hnf; intros. reflexivity. Qed.*)
 
 Lemma VALspec_range_split2:
   forall (n m r: Z) (sh: Share.t) (b: block) (ofs: Z),
     r = n + m -> n >= 0 -> m >= 0 ->
-    VALspec_range r sh (b, ofs) = 
-    VALspec_range n sh (b, ofs) * VALspec_range m sh (b, ofs + n).
+    VALspec_range r sh (b, ofs) ⊣⊢
+    VALspec_range n sh (b, ofs) ∗ VALspec_range m sh (b, ofs + n).
 Proof.
-  intros.
-  assert (exists resp, is_resource_pred (fun l' => EX  v: memval, yesat NoneP (VAL v) sh l') resp) by (eexists; apply is_resource_pred_YES_VAL).
-  apply allp_jam_split2; auto.
-  + split; intros [? ?]; unfold adr_range.
-    - assert (ofs <= z < ofs + r <-> ofs <= z < ofs + n \/ ofs + n <= z < ofs + n + m) by lia.
-      tauto.
-    - lia.
-  + intros.
-    simpl in H4.
-    destruct (m0 @ l); try solve [inversion H5; simpl; auto].
-    destruct H4 as [? [? ?]].
-    inversion H4; subst.
-    inversion H5; subst.
-    auto.
+  intros; subst.
+  unfold VALspec_range.
+  rewrite -> Z2Nat.inj_add, seq_app by lia.
+  rewrite big_sepL_app Nat.add_0_l.
+  rewrite -{2}(Nat.add_0_r (Z.to_nat n)) -fmap_add_seq big_sepL_fmap.
+  setoid_rewrite Nat2Z.inj_add; rewrite Z2Nat.id; last lia.
+  unfold adr_add; simpl.
+  by iSplit; iIntros "[$ H]"; iApply (big_sepL_mono with "H"); intros ???; rewrite Z.add_assoc.
 Qed.
 
 Lemma nonlock_permission_bytes_split2:
   forall (n m r: Z) (sh: Share.t) (b: block) (ofs: Z),
     r = n + m -> n >= 0 -> m >= 0 ->
-    nonlock_permission_bytes sh (b, ofs) r =
-    nonlock_permission_bytes sh (b, ofs) n *
+    nonlock_permission_bytes sh (b, ofs) r ⊣⊢
+    nonlock_permission_bytes sh (b, ofs) n ∗
     nonlock_permission_bytes sh (b, ofs + n) m.
 Proof.
-  intros.
-  assert (exists resp, is_resource_pred (fun i : address => shareat i sh && nonlockat i) resp) by (eexists; apply is_resource_pred_nonlock_shareat).
-  apply allp_jam_split2; auto.
-  + split; intros [? ?]; unfold adr_range.
-    - assert (ofs <= z < ofs + r <-> ofs <= z < ofs + n \/ ofs + n <= z < ofs + n + m) by lia.
-      tauto.
-    - lia.
-  + intros.
-    destruct H4 as [_ ?].
-    simpl in H4.
-    destruct (m0 @ l); inv H5.
-    simpl in H4; auto.
+  intros; subst.
+  unfold nonlock_permission_bytes.
+  rewrite -> Z2Nat.inj_add, seq_app by lia.
+  rewrite big_sepL_app Nat.add_0_l.
+  rewrite -{2}(Nat.add_0_r (Z.to_nat n)) -fmap_add_seq big_sepL_fmap.
+  unfold adr_add; simpl.
+  by iSplit; iIntros "[$ H]"; iApply (big_sepL_mono with "H"); intros ???;
+    rewrite ?Nat2Z.inj_add Z2Nat.id; try lia; rewrite Z.add_assoc.
 Qed.
 
 Lemma VALspec_range_VALspec:
   forall (n : Z) (v : val) (sh : Share.t) (l : address) (i : Z),
        0 <= i < n ->
        VALspec_range n sh l
-       |-- VALspec sh (adr_add l i) * TT.
+       ⊢ VALspec sh (adr_add l i) ∗ True.
 Proof.
- intros.
-  destruct l as [b ofs].
-  rewrite (VALspec_range_split2 i (n-i) n sh b ofs); try lia.
-  rewrite (VALspec_range_split2 1 (n-i-1) (n-i) sh b (ofs+i)); try lia.
-  change (VALspec_range 1) with (VALspec_range 1).
-  rewrite VALspec1.
-  rewrite <- sepcon_assoc.
-  rewrite (sepcon_comm (VALspec_range i sh (b, ofs))).
-  rewrite sepcon_assoc.
-  apply sepcon_derives; auto.
+  intros.
+  unfold VALspec_range.
+  rewrite (big_sepL_lookup_acc).
+  rewrite -> (Z2Nat.id i) by tauto.
+  by iIntros "[$ $]".
+  { rewrite lookup_seq_lt; [done | lia]. }
+Qed.
+
+Lemma share_joins_self: forall sh: share, sepalg.joins sh sh -> sh = Share.bot.
+Proof.
+  intros ? [? ?%sepalg.join_self].
+  by apply identity_share_bot.
+Qed.
+
+Lemma share_op_self: forall sh, (✓ (Share sh ⋅ Share sh))%stdpp -> sh = Share.bot.
+Proof.
+  intros ? (? & ? & ? & [=] & [=] & ? & J)%share_valid2_joins; subst.
+  rewrite share_op_is_join in J; pose proof (identity_share_bot _ (sepalg.join_self J)) as ->.
+  done.
+Qed.
+
+Lemma self_unreadable : forall sh, ~readable_dfrac (DfracOwn (Share sh) ⋅ DfracOwn (Share sh)).
+Proof.
+  intros; simpl.
+  destruct (Share sh ⋅ Share sh) eqn: J; auto.
+  apply share_op_join in J as (? & ? & [=] & [=] & J); subst.
+  rewrite share_op_is_join in J; pose proof (identity_share_bot _ (sepalg.join_self J)) as ->.
+  apply bot_identity in J as <-.
+  apply bot_unreadable.
 Qed.
 
 Lemma VALspec_range_overlap': forall sh p1 p2 n1 n2,
   adr_range p1 n1 p2 ->
   n2 > 0 ->
-  VALspec_range n1 sh p1 * VALspec_range n2 sh p2 |-- FF.
+  VALspec_range n1 sh p1 ∗ VALspec_range n2 sh p2 ⊢ False.
 Proof.
   intros.
-  intros w [w1 [w2 [? [H2 H3]]]].
-  specialize (H2 p2).
-  specialize (H3 p2).
-  rewrite jam_true in H2 by auto.
-  rewrite jam_true in H3 by (destruct p2; simpl; split; auto; lia).
-  destruct H2; destruct H3. hnf in H2,H3.
-  apply (resource_at_join _ _ _ p2) in H1.
-  destruct H2, H3.
-  rewrite H2, H3 in H1.
-  clear - x1 H1; simpl in H1.
-  inv H1.
-  clear - x1 RJ.
-  generalize (join_self' RJ); intro. subst sh3.
-  apply readable_nonidentity in x1.
-  apply x1. apply identity_unit_equiv. apply RJ.
+  iIntros "[H1 H2]".
+  destruct p1 as (?, ofs1), p2 as (?, ofs2), H; subst.
+  unfold VALspec_range.
+  rewrite (big_sepL_lookup_acc _ _ _ (Z.to_nat (ofs2 - ofs1))).
+  rewrite (big_sepL_lookup_acc _ (seq _ (Z.to_nat n2)) _ O).
+  iDestruct "H1" as "[H1 _]"; iDestruct "H2" as "[H2 _]".
+  unfold VALspec.
+  iDestruct "H1" as (v1) "H1"; iDestruct "H2" as (v2) "H2".
+  rewrite /adr_add /=.
+  rewrite Z2Nat.id; last lia.
+  rewrite Zplus_minus Z.add_0_r.
+  iDestruct (mapsto_valid_2 with "H1 H2") as %(? & []%self_unreadable & _).
+  { rewrite lookup_seq_lt; [done | lia]. }
+  { rewrite lookup_seq_lt; [done | lia]. }
 Qed.
 
 Lemma address_mapsto_overlap':
   forall sh ch1 v1 ch2 v2 a1 a2,
      adr_range a1 (size_chunk ch1) a2 ->
-     address_mapsto ch1 v1 sh a1 * address_mapsto ch2 v2 sh a2 |-- FF.
+     address_mapsto ch1 v1 sh a1 ∗ address_mapsto ch2 v2 sh a2 ⊢ False.
 Proof.
   intros.
-  eapply derives_trans; [eapply sepcon_derives | apply VALspec_range_overlap'].
-  + apply address_mapsto_VALspec_range.
-  + apply address_mapsto_VALspec_range.
+  etrans; last apply VALspec_range_overlap'.
+  + apply bi.sep_mono; apply address_mapsto_VALspec_range.
   + auto.
   + apply size_chunk_pos.
 Qed.
 
 Lemma VALspec_range_overlap: forall sh l1 n1 l2 n2,
   range_overlap l1 n1 l2 n2 ->
-  VALspec_range n1 sh l1 * VALspec_range n2 sh l2 |-- FF.
+  VALspec_range n1 sh l1 ∗ VALspec_range n2 sh l2 ⊢ False.
 Proof.
   intros.
   pose proof range_overlap_non_zero _ _ _ _ H.
   apply range_overlap_spec in H; try tauto.
   destruct H.
   + apply VALspec_range_overlap'; tauto.
-  + rewrite sepcon_comm.
+  + rewrite comm.
     apply VALspec_range_overlap'; tauto.
 Qed.
 
 Lemma address_mapsto_overlap: forall sh l1 ch1 v1 l2 ch2 v2,
   range_overlap l1 (size_chunk ch1) l2 (size_chunk ch2) ->
-  address_mapsto ch1 v1 sh l1 * address_mapsto ch2 v2 sh l2 |-- FF.
+  address_mapsto ch1 v1 sh l1 ∗ address_mapsto ch2 v2 sh l2 ⊢ False.
 Proof.
   intros.
   apply range_overlap_spec in H; try apply size_chunk_pos.
   destruct H.
   + apply address_mapsto_overlap'; auto.
-  + rewrite sepcon_comm.
+  + rewrite comm.
     apply address_mapsto_overlap'; auto.
 Qed.
 
-Lemma share_joins_self: forall sh: share, joins sh sh -> nonunit sh -> False.
-Proof.
-  intros.
-  destruct H as [sh' ?].
-  apply nonunit_nonidentity in H0; contradiction H0.
-  eapply join_self; eauto.
-Qed.
-
 Lemma nonlock_permission_bytes_overlap:
   forall sh n1 n2 p1 p2,
-  nonunit sh ->
+  sh ≠ Share.bot ->
   range_overlap p1 n1 p2 n2 ->
-  nonlock_permission_bytes sh p1 n1 * nonlock_permission_bytes sh p2 n2 |-- FF.
-Proof.
-  intros.
-  eapply derives_trans; [apply sepcon_derives; apply derives_refl|].
-  apply allp_jam_overlap.
-  + eexists. apply is_resource_pred_nonlock_shareat.
-  + eexists. apply is_resource_pred_nonlock_shareat.
-  + unfold shareat; simpl; intros.
-    destruct H3 as [w ?].
-    apply (resource_at_join _ _ _ l) in H3.
-    pose proof resource_share_joins (w1 @ l) (w2 @ l) sh sh.
-    do 2 (spec H4; [tauto |]).
-    spec H4; [firstorder |].
-    apply (share_joins_self sh); auto.
-  + auto.
-Qed.
-
-Lemma address_mapsto_value_cohere':
+  nonlock_permission_bytes sh p1 n1 ∗ nonlock_permission_bytes sh p2 n2 ⊢ False.
+Proof.
+  intros ?????? ((?, ?) & Hadr1 & Hadr2).
+  destruct p1 as (?, ofs1), p2 as (?, ofs2), Hadr1, Hadr2; subst.
+  iIntros "[H1 H2]".
+  unfold nonlock_permission_bytes.
+  rewrite (big_sepL_lookup_acc _ _ _ (Z.to_nat (z - ofs1))).
+  rewrite (big_sepL_lookup_acc _ (seq _ (Z.to_nat n2)) _ (Z.to_nat (z - ofs2))).
+  iDestruct "H1" as "[H1 _]"; iDestruct "H2" as "[H2 _]".
+  destruct (readable_share_dec _).
+  - iDestruct "H1" as "(% & % & H1)"; iDestruct "H2" as "(% & % & H2)".
+    rewrite /adr_add /=.
+    rewrite !Z2Nat.id; try lia.
+    rewrite !Zplus_minus.
+    iDestruct (mapsto_valid_2 with "H1 H2") as %(? & []%self_unreadable & ?).
+  - rewrite /adr_add /=.
+    rewrite !Z2Nat.id; try lia.
+    rewrite !Zplus_minus.
+    iDestruct (mapsto_no_valid_2 with "H1 H2") as %[?%share_op_self ?]; done.
+  - rewrite lookup_seq_lt; [done | lia].
+  - rewrite lookup_seq_lt; [done | lia].
+Qed.
+
+(*Lemma address_mapsto_value_cohere':
   forall ch v1 v2 sh1 sh2 a r
  (Hmaps1 : address_mapsto ch v1 sh1 a r)
  (Hmaps2 : address_mapsto ch v2 sh2 a r), v1=v2.
@@ -1629,51 +798,59 @@ Proof.
  specialize (H O). simpl in H. inv H; auto.
  apply IHn; auto.
  intro i; specialize (H (S i)); apply H.
+Qed.*)
+
+Lemma mapsto_value_cohere: forall l sh1 sh2 r1 r2, mapsto l sh1 r1 ∗ mapsto l sh2 r2 ⊢ ⌜r1 = r2⌝.
+Proof.
+  intros; iIntros "[H1 H2]".
+  by iDestruct (mapsto_valid_2 with "H1 H2") as %[? Heq]; inversion Heq.
+Qed.
+
+Lemma list_snoc : forall {A} (l : list A), length l <> O -> exists l1 a, l = l1 ++ [a].
+Proof.
+  induction l; first done.
+  destruct l.
+  - exists nil; eauto.
+  - destruct IHl as (? & ? & ->); first done.
+    exists (a :: x); eauto.
+Qed.
+
+Lemma mapsto_list_value_cohere: forall a sh1 sh2 b1 b2 (Hlen: length b1 = length b2),
+  (([∗ list] i↦b ∈ b1, mapsto (adr_add a (Z.of_nat i)) sh1 (VAL b)) ∗
+    [∗ list] i↦b ∈ b2, mapsto (adr_add a (Z.of_nat i)) sh2 (VAL b)) ⊢
+  ⌜b1 = b2⌝.
+Proof.
+  intros until b1; remember (rev b1) as b1'; generalize dependent b1; induction b1'; simpl; intros.
+  - destruct b1; last by apply app_cons_not_nil in Heqb1'.
+    symmetry in Hlen; apply nil_length_inv in Hlen as ->; auto.
+  - apply (f_equal (@rev _)) in Heqb1'; rewrite rev_involutive in Heqb1'; subst; simpl in *.
+    rewrite app_length /= in Hlen; destruct (list_snoc b2) as (b2' & ? & ->); first lia.
+    rewrite !big_opL_app /= !Nat.add_0_r.
+    assert (length (rev b1') = length b2') as Hlen' by (rewrite app_length /= in Hlen; lia); rewrite Hlen'.
+    iIntros "[(H1 & Hv1 & _) (H2 & Hv2 & _)]".
+    iDestruct (mapsto_value_cohere with "[$Hv1 $Hv2]") as %[=]; subst.
+    by iDestruct (IHb1' with "[$H1 $H2]") as %->; first by rewrite rev_involutive.
 Qed.
 
 Lemma address_mapsto_value_cohere:
   forall ch v1 v2 sh1 sh2 a,
- address_mapsto ch v1 sh1 a * address_mapsto ch v2 sh2 a |-- !! (v1=v2).
+ address_mapsto ch v1 sh1 a ∗ address_mapsto ch v2 sh2 a ⊢ ⌜v1=v2⌝.
 Proof.
- intros.
- intros w [w1 [w2 [? [? ?]]]]. hnf.
- destruct H0 as [b1 [[? [? ?]] ?]].
- destruct H1 as [b2 [[? [? ?]] ?]].
- assert (b1 = b2); [ | subst; auto].
- clear - H H0 H4 H1 H7.
- rewrite size_chunk_conv in *.
- forget (size_chunk_nat ch) as n. clear ch.
- assert (forall i, nth_error b1 i = nth_error b2 i).
- intro.
- destruct a as [b z].
- specialize (H4 (b, (z+Z.of_nat i))).
- specialize (H7 (b, (z+Z.of_nat i))).
- hnf in H4,H7. if_tac in H4. destruct H2 as [_ [_ ?]].
- destruct H4, H7. hnf in H3,H4.
- apply (resource_at_join _ _ _ (b, z + Z.of_nat i)) in H.
- rewrite H3,H4 in H. inv  H.
- clear - H2 H10 H1.
- replace (z + Z.of_nat i - z) with (Z.of_nat i) in H10 by lia.
- rewrite Nat2Z.id in H10.
- rewrite coqlib4.nth_error_nth with (z:=Undef) by lia.
- rewrite coqlib4.nth_error_nth with (z:=Undef) by lia.
- f_equal; auto.
- assert (~(i<n)%nat).
- contradict H2. split; auto. lia.
- transitivity (@None memval); [ | symmetry];
- apply nth_error_length; lia.
- clear - H2 H0 H1.
- revert b1 b2 H0 H1 H2.
- induction n; destruct b1,b2; intros; auto; inv H0; inv H1.
- f_equal.
- specialize (H2 O). simpl in H2. inv H2; auto.
- apply IHn; auto.
- intro i; specialize (H2 (S i)); apply H2.
+  intros.
+  iIntros "[H1 H2]".
+  rewrite /address_mapsto.
+  iDestruct "H1" as (b1 (Hl1 & ? & ?)) "H1".
+  iDestruct "H2" as (b2 (Hl2 & ? & ?)) "H2"; subst.
+  rewrite -Hl2 in Hl1; by iDestruct (mapsto_list_value_cohere with "[$H1 $H2]") as %->.
 Qed.
 
-Definition almost_empty rm: Prop:=
+(*Definition almost_empty rm: Prop :=
   forall loc sh psh k P, rm @ loc = YES sh psh k P -> forall val, ~ k = VAL val.
 
 Definition no_locks phi :=
   forall addr sh sh' z z' P,
-phi @ addr <> YES sh sh' (LK z z') P.
+phi @ addr <> YES sh sh' (LK z z') P.*)
+
+End heap.
+
+#[export] Hint Resolve VALspec_range_0: normalize.
diff --git a/veric/rmaps.v b/veric/rmaps.v
deleted file mode 100644
index 7e84d6f346..0000000000
--- a/veric/rmaps.v
+++ /dev/null
@@ -1,1661 +0,0 @@
-Require Import VST.msl.msl_standard.
-Require Import VST.msl.ghost.
-Require Import VST.msl.Coqlib2.
-Require Import VST.veric.shares.
-
-Require Import VST.veric.compspecs.
-
-Module Type ADR_VAL.
-Parameter address : Type.
-Parameter some_address:address.
-
-(* Validity of traces.  The "valid" predicate ensures that related addresses don't get
-    split apart from each other.  *)
-Parameter kind: Type.
-End ADR_VAL.
-
-Inductive TypeTree: Type :=
-  | ConstType: Type -> TypeTree
-  | CompspecsType: TypeTree
-  | Mpred: TypeTree
-  | DependentType: nat -> TypeTree
-  | ProdType: TypeTree -> TypeTree -> TypeTree
-  | ArrowType: TypeTree -> TypeTree -> TypeTree
-  | SigType: forall (I : Type), (I -> TypeTree) -> TypeTree
-  | PiType: forall (I : Type), (I -> TypeTree) -> TypeTree
-  | ListType: TypeTree -> TypeTree.
-
-Definition dependent_type_functor_rec (ts: list Type): TypeTree -> functor :=
-  fix dtfr (T: TypeTree): functor :=
-  match T with
-  | ConstType A => fconst A
-  | CompspecsType => fconst compspecs
-  | Mpred => fidentity
-  | DependentType n => fconst (nth n ts unit)
-  | ProdType T1 T2 => fpair (dtfr T1) (dtfr T2)
-  | ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2)
-  | SigType _ f => fsig (fun i => dtfr (f i))
-  | PiType _ f => fpi (fun i => dtfr (f i))
-  | ListType T => flist (dtfr T)
-  end.
-Opaque dependent_type_functor_rec.
-
-Definition dependent_type_function_rec (ts: list Type) (mpred': Type): TypeTree -> Type :=
-  fix dtfr (T: TypeTree): Type :=
-  match T with
-  | ConstType A => A
-  | CompspecsType => compspecs
-  | Mpred => mpred'
-  | DependentType n => nth n ts unit
-  | ProdType T1 T2 => (dtfr T1 * dtfr T2)%type
-  | ArrowType T1 T2 => dtfr T1 -> dtfr T2
-  | SigType A f => sigT (fun a => dtfr (f a))
-  | PiType A f => forall a, dtfr (f a)
-  | ListType T => list (dtfr T)
-  end.
-
-Definition fpreds: functor :=
-  fsig (fun T: TypeTree =>
-    fpi (fun ts: list Type => dependent_type_functor_rec ts T)).
-
-Lemma realize_eq: forall {A} (a b: A) P, (exists H: a = b, P H) -> {H: a = b & P H}.
-Proof.
-  intros ???? []; subst; exists eq_refl; auto.
-Qed.
-
-Lemma lower_join_inv : forall {A} {J: Join A} a b c, lower_join J a b c <->
-  match a, b, c with
-  | Some a, Some b, Some c => join a b c
-  | Some a, None, Some c | None, Some a, Some c => a = c
-  | None, None, None => True
-  | _, _, _ => False
-  end.
-Proof.
-  split.
-  - inversion 1; subst; auto; destruct c; auto.
-  - destruct a, b, c; intros; subst; try contradiction; try constructor; auto.
-Qed.
-
-Module Type STRAT_MODEL.
-  Declare Module AV : ADR_VAL.
-  Import AV.
-
-  Inductive res (PRED : Type) : Type :=
-    | NO':  forall sh: Share.t, ~(readable_share sh) -> res PRED
-    | YES': forall sh: Share.t, readable_share sh -> kind -> fpreds PRED -> res PRED
-    | PURE': kind -> fpreds PRED -> res PRED.
-
-  Definition res_fmap (A B:Type) (f:A->B) (g:B->A)(x:res A) : res B :=
-    match x with
-      | NO' rsh nsh => NO' B rsh nsh
-      | YES' sh rsh k pds => YES' B sh rsh k (fmap fpreds f g pds)
-      | PURE' k pds => PURE' B k (fmap fpreds f g pds)
-    end.
-  Axiom ff_res : functorFacts res res_fmap.
-  Definition f_res : functor := Functor ff_res.
-
-  Inductive res_join (PRED : Type) : f_res PRED -> f_res PRED -> f_res PRED -> Prop :=
-    | res_join_NO1 : forall sh1 nsh1 sh2 nsh2 sh3 nsh3,
-                               join sh1 sh2 sh3 ->
-                               res_join PRED (NO' PRED sh1 nsh1) (NO' PRED sh2 nsh2)
-                                     (NO' PRED sh3 nsh3)
-    | res_join_NO2 : forall sh1 nsh1 sh2 rsh2 sh3 rsh3 k p,
-                               join sh1 sh2 sh3 ->
-                               res_join PRED (NO' PRED sh1 nsh1) (YES' PRED sh2 rsh2 k p)
-                                   (YES' PRED sh3 rsh3 k p)
-    | res_join_NO3 : forall sh1 rsh1 sh2 nsh2 sh3 rsh3 k p,
-                               join sh1 sh2 sh3 ->
-                               res_join PRED (YES' PRED sh1 rsh1 k p) (NO' PRED sh2 nsh2)
-                                   (YES' PRED sh3 rsh3 k p)
-    | res_join_YES : forall sh1 rsh1 sh2 rsh2 sh3 rsh3 k p,
-                              join sh1 sh2 sh3 ->
-              res_join PRED (YES' PRED sh1 rsh1 k p) (YES' PRED sh2 rsh2 k p) (YES' PRED sh3 rsh3 k p)
-    | res_join_PURE : forall k p, res_join PRED (PURE' PRED k p) (PURE' PRED k p) (PURE' PRED k p).
-  Axiom pa_rj : forall PRED, @Perm_alg _ (res_join PRED).
-  #[global] Instance sa_rj : forall PRED, @FSep_alg _ (res_join PRED).
-  Proof. intros.
-            apply mkSep
-             with (fun x => match x
-                             with NO' _ _ => NO' _ Share.bot bot_unreadable
-                               | YES' _ _ _ _ => NO' _ Share.bot bot_unreadable
-                               | PURE' k pds => PURE' _ k pds end).
-            intro. destruct t; constructor; try apply join_unit1; auto.
-            intros. inversion H; auto.
-  Defined.
-
-  Axiom paf_res : @pafunctor f_res res_join.
-
-  Definition res_option (PRED : Type) (r: res PRED) : option (rshare * kind):=
-    match r with
-      | NO' _ _ => None
-      | YES' sh rsh k _ => Some (readable_part rsh,k)
-      | PURE' _ _ => None (* PUREs cannot be split in any interesting way, which is what valid is about. *)
-    end.
-
-  Definition ghost (PRED : Type) : Type :=
-    list (option ({g: Ghost & {a: @G g | ghost.valid a}} * fpreds PRED)%type).
-
-
-  Definition ghost_fmap (A B:Type) (f:A->B) (g:B->A)(x:ghost A) : ghost B :=
-    fmap (flist (foption (fpair (fconst _) fpreds))) f g x.
-
-  Axiom ff_ghost : functorFacts ghost ghost_fmap.
-  Definition f_ghost : functor := Functor ff_ghost.
-
-  #[global] Instance preds_join PRED : Join _ := Join_equiv (fpreds PRED).
-
-  Inductive ghost_elem_join : Join {g: Ghost & {a: @G g | ghost.valid a}} :=
-  | elem_join_I g a b c va vb vc: join a b c ->
-    ghost_elem_join (existT _ g (exist _ a va)) (existT _ g (exist _ b vb))
-                    (existT _ g (exist _ c vc)).
-  #[global] Existing Instance ghost_elem_join.
-
-  Inductive ghost_join PRED : Join (ghost PRED) :=
-  | ghost_join_nil_l m: ghost_join PRED nil m m
-  | ghost_join_nil_r m: ghost_join PRED m nil m
-  | ghost_join_cons a1 a2 m1 m2 a3 m3: join a1 a2 a3 -> ghost_join PRED m1 m2 m3 ->
-      ghost_join PRED (a1 :: m1) (a2 :: m2) (a3 :: m3).
-  #[global] Existing Instance ghost_join.
-
-  Axiom pa_gj : forall PRED, @Perm_alg _ (ghost_join PRED).
-
-  Definition ghost_core (x : {g: Ghost & {a: @G g | ghost.valid a}}) : {g: Ghost & {a: @G g | ghost.valid a}} :=
-    match x with existT _ (exist _ V) => existT _ _ (exist _ _ (core_valid _ V)) end.
-
-  #[global] Instance sa_gj : forall PRED, @Sep_alg _ (ghost_join PRED).
-  Proof.
-    intros; exists (fun g => map (option_map (fun '(a, b) => (ghost_core a, b))) g); auto; intros.
-    - hnf.
-      induction t; constructor; auto; simpl.
-      destruct a as [(?, ?)|]; repeat constructor; simpl.
-      unfold ghost_core. destruct s as (? & ? & ?); constructor. apply core_unit.
-    - induction H; try solve [eexists; constructor].
-      destruct IHghost_join as [x J].
-      exists (option_map (fun '(x, y) => (ghost_core x, y)) a3 :: x); constructor; auto.
-      inv H; try constructor.
-      + destruct a3 as [(?, ?)|]; constructor.
-        split; hnf; auto; simpl.
-        destruct s as (? & ? & ?); simpl. constructor.
-        apply core_duplicable.
-      + destruct a0, a4, a5; simpl in *.
-        destruct H1; split; simpl in *.
-        * inv H; simpl. constructor.
-          eapply core_sub_join, join_core_sub; eassumption.
-        * destruct H1; subst; split; auto.
-    - rewrite map_map; apply map_ext.
-      intros [((? & ? & ?), ?)|]; auto; simpl.
-      do 3 f_equal. apply exist_ext, core_idem.
-  Defined.
-  Axiom paf_ghost : @pafunctor f_ghost ghost_join.
-
-  Definition f_pre_rmap : functor :=
-    fpair (ffunc (fconst address) f_res) f_ghost.
-
-  #[global] Instance Join_pre_rmap (A: Type) : Join (f_pre_rmap A) :=
-            Join_prod _ (Join_fun address (res A) (res_join A)) _ (ghost_join A).
-
-  #[global] Declare Instance Perm_pre_rmap: forall (A: Type), Perm_alg (f_pre_rmap A).
-  #[global] Declare Instance Sep_pre_rmap: forall (A: Type), Sep_alg (f_pre_rmap A).
-  Parameter paf_pre_rmap : @pafunctor f_pre_rmap Join_pre_rmap.
-
-  #[global] Existing Instance ghost_join.
-  #[global] Instance Join_res A : Join (f_res A) := res_join A.
-
-Axiom pre_rmap_core:
-forall (A : Type) (m : f_pre_rmap A),
-  @core (f_pre_rmap A) (Join_pre_rmap A) (Sep_pre_rmap A) m =
- (@core ((fpair (ffunc (fconst address) f_res) f_ghost) A)
-           (Join_prod ((ffunc (fconst address) f_res) A)
-              (Join_pi ((fconst address) A)
-                 (fun _ : (fconst address) A => f_res A)
-                 (fun _ : (fconst address) A => Join_res A))
-              (f_ghost A) (ghost_join A))
-           (@Sep_prod ((ffunc (fconst address) f_res) A)
-              (Join_pi ((fconst address) A)
-                 (fun _ : (fconst address) A => f_res A)
-                 (fun _ : (fconst address) A => Join_res A))
-              (f_ghost A) (ghost_join A)
-              (Perm_pi ((fconst address) A)
-                 (fun _ : (fconst address) A => f_res A)
-                 (fun _ : (fconst address) A => Join_res A)
-                 (fun _ : (fconst address) A => pa_rj A)) (pa_gj A)
-              (Sep_pi ((fconst address) A)
-                 (fun _ : (fconst address) A => f_res A)
-                 (fun _ : (fconst address) A => Join_res A)
-                 (fun _ : (fconst address) A => pa_rj A)
-                 (fun _ : (fconst address) A => fsep_sep (sa_rj A)))
-              (sa_gj A)) m).
-
-End STRAT_MODEL.
-
-Module StratModel (AV' : ADR_VAL) : STRAT_MODEL with Module AV:=AV'.
-  Module AV := AV'.
-  Import AV.
-
-  Definition preds: functor :=
-    fsig (fun T: TypeTree =>
-      fpi (fun ts: list Type => dependent_type_functor_rec ts T)).
-
-  Inductive res (PRED : Type) : Type :=
-    | NO':  forall sh: Share.t, ~(readable_share sh) -> res PRED
-    | YES': forall sh: Share.t, readable_share sh -> kind -> preds PRED -> res PRED
-    | PURE': kind -> preds PRED -> res PRED.
-
-  Definition res_fmap (A B:Type) (f:A->B) (g:B->A)(x:res A) : res B :=
-    match x with
-      | NO' rsh nsh => NO' B rsh nsh
-      | YES' sh rsh k pds => YES' B sh rsh k (fmap preds f g pds)
-      | PURE' k pds => PURE' B k (fmap preds f g pds)
-    end.
-
-  Lemma ff_res : functorFacts res res_fmap.
-  Proof with auto.
-    constructor; intros; extensionality rs; icase rs; unfold res_fmap.
-    rewrite fmap_id... rewrite fmap_id...
-    rewrite <- fmap_comp... rewrite <- fmap_comp...
-  Qed.
-
-  Definition f_res : functor := Functor ff_res.
-
-  Inductive res_join (PRED : Type) : f_res PRED -> f_res PRED -> f_res PRED -> Prop :=
-    | res_join_NO1 : forall sh1 nsh1 sh2 nsh2 sh3 nsh3,
-                               join sh1 sh2 sh3 ->
-                               res_join PRED (NO' PRED sh1 nsh1) (NO' PRED sh2 nsh2)
-                                     (NO' PRED sh3 nsh3)
-    | res_join_NO2 : forall sh1 nsh1 sh2 rsh2 sh3 rsh3 k p,
-                               join sh1 sh2 sh3 ->
-                               res_join PRED (NO' PRED sh1 nsh1) (YES' PRED sh2 rsh2 k p)
-                                   (YES' PRED sh3 rsh3 k p)
-    | res_join_NO3 : forall sh1 rsh1 sh2 nsh2 sh3 rsh3 k p,
-                               join sh1 sh2 sh3 ->
-                               res_join PRED (YES' PRED sh1 rsh1 k p) (NO' PRED sh2 nsh2)
-                                   (YES' PRED sh3 rsh3 k p)
-    | res_join_YES : forall sh1 rsh1 sh2 rsh2 sh3 rsh3 k p,
-                              join sh1 sh2 sh3 ->
-              res_join PRED (YES' PRED sh1 rsh1 k p) (YES' PRED sh2 rsh2 k p) (YES' PRED sh3 rsh3 k p)
-    | res_join_PURE : forall k p, res_join PRED (PURE' PRED k p) (PURE' PRED k p) (PURE' PRED k p).
-
-  #[global] Instance Join_res (PRED: Type) : Join (res PRED) := res_join PRED.
-
-  #[global] Instance pa_rj : forall PRED, @Perm_alg _ (res_join PRED).
-  Proof. intros. constructor.
-*      (* saf_eq *)
-      intros x y z z' H1 H2; inv H1; inv H2;
-      repeat match goal with H: join ?A ?B _, H': join ?A ?B ?C |- _ => pose proof (join_eq H H'); subst C end;
-      repeat proof_irr; auto.
-*     (* saf_assoc *)
-      intros a b c d e H1 H2.
-      destruct d as [rd | rd sd kd pd | kd pd].
-      destruct a as [ra | | ]; try solve [exfalso; inv H1].
-      destruct b as [rb| | ]; try solve [exfalso; inv H1].
-      assert (join ra rb rd) by (inv H1; auto).
-      destruct c as [rc | rc sc kc pc | kc pc]; try solve [exfalso; inv H2].
-      destruct e as [re | re se ke pe | ke pe]; try solve [exfalso; inv H2].
-      assert (join rd rc re) by (inv H2; auto).
-      destruct (join_assoc H H0) as [rf [? ?]].
-      exists (NO' _ rf (join_unreadable_shares H3 n1 n2)); split; constructor; auto.
-      destruct e as [re | re se ke pe | ke pe]; try solve [exfalso; inv H2].
-      assert (join rd rc re) by (inv H2; auto).
-      destruct (join_assoc H H0) as [rf [? ?]].
-      exists (YES' _ rf (join_readable2 H3 sc) kc pc).
-      inv H2. split; constructor; auto.
-      destruct c as [rc | rc sc kc pc | kc pc]; try solve [exfalso; inv H2].
-      destruct e as [re | re se ke pe | ke pe]; try solve [exfalso; inv H2].
-      assert (H0: join rd rc re) by (inv H2; auto).
-      destruct a as [ra | ra sa ka pa | ka pa ]; try solve [exfalso; inv H1].
-      destruct b as [ | rb sb kb pb | ]; try solve [exfalso; inv H1].
-      assert (H: join ra rb rd) by (inv H1; auto).
-      destruct (join_assoc H H0) as [rf [? ?]].
-      exists (YES' _ rf (join_readable1 H3 sb) kd pd).  inv H1; inv H2; split; constructor; auto.
-      destruct b as [ rb | rb sb kb pb | ]; try solve [exfalso; inv H1].
-      assert (H: join ra rb rd) by (inv H1; auto).
-      destruct (join_assoc H H0) as [rf [? ?]].
-      exists (NO' _ rf (join_unreadable_shares H3 n0 n)).  inv H1; inv H2; split; constructor; auto.
-      assert (H: join ra rb rd) by (inv H1; auto).
-      destruct (join_assoc H H0) as [rf [? ?]].
-      exists (YES' _ rf (join_readable1 H3 sb) kb pb).  inv H1; inv H2; split; constructor; auto.
-      destruct e as [re | re se ke pe | ke pe]; try solve [exfalso; inv H2].
-      assert (H0: join rd rc re) by (inv H2; auto).
-      destruct b as [ rb | rb sb kb pb | ]; try solve [exfalso; inv H1].
-      destruct a as [ra | ra sa ka pa | ka pa ]; try solve [exfalso; inv H1].
-      assert (H: join ra rb rd) by (inv H1; auto).
-      destruct (join_assoc H H0) as [rf [? ?]].
-      exists (YES' _ rf (join_readable2 H3 sc) kc pc).  inv H1; inv H2; split; constructor; auto.
-      destruct a as [ra | ra sa ka pa | ka pa ]; try solve [exfalso; inv H1].
-      assert (H: join ra rb rd) by (inv H1; auto).
-      destruct (join_assoc H H0) as [rf [? ?]].
-      exists (YES' _ rf (join_readable1 H3 sb) kb pb).  inv H1; inv H2; split; try constructor; auto.
-      assert (H: join ra rb rd) by (inv H1; auto).
-      destruct (join_assoc H H0) as [rf [? ?]].
-      exists (YES' _ rf (join_readable1 H3 sb) kb pb).  inv H1; inv H2; split; try constructor; auto.
-      exists (PURE' _ kd pd). inv H1; inv H2; split; constructor.
-
-*      (* saf_com *)
-      intros a b c H; inv H; econstructor;  apply join_comm; auto.
-
-*     (* saf_positivity *)
-     intros; inv H; inv H0;
-      repeat match goal with H: join ?A ?B ?C, H': join ?C ?D ?A |- _ =>
-                    pose proof (join_positivity H H'); subst C
-      end;
-      repeat proof_irr; auto.
- Qed.
-
-  #[global] Instance sa_rj : forall PRED, @FSep_alg _ (res_join PRED).
-  Proof. intros.
-            apply mkSep
-             with (fun x => match x
-                             with NO' _ _ => NO' _ Share.bot bot_unreadable
-                               | YES' _ _ _ _ => NO' _ Share.bot bot_unreadable
-                               | PURE' k pds => PURE' _ k pds end).
-            intro. destruct t; constructor; try apply join_unit1; auto.
-            intros. inversion H; auto.
-  Defined.
-
-  Definition paf_res : @pafunctor f_res res_join.
-  Proof. constructor; repeat intro.
-  (* This is a little painful because of the way res_join is defined, but
-      whatever... *)
-   inv H; simpl; constructor; trivial.
-   destruct z as [ rz | rz sz kz pz | kz pz ].
-   destruct x' as [ rx' | rx' sx' kx' px' | kx' px' ]; try solve [exfalso; inv H].
-   destruct y as [ ry | ry sy ky py | ky py ]; try solve [exfalso; inv H].
-   exists (NO' _ rx' n0); exists (NO' _ ry n1); inv H; split; constructor; tauto.
-   destruct x' as [ rx' | rx' sx' kx' px' | kx' px' ]; try solve [exfalso; inv H].
-   destruct y as [ ry | ry sy ky py | ky py ]; try solve [exfalso; inv H].
-   exists (NO' _ rx' n); exists (YES' _ ry sy kz pz); inv H; split; constructor; auto. simpl in *; f_equal; auto.
-   destruct y as [ ry | ry sy ky py | ky py ]; try solve [exfalso; inv H].
-   exists (YES' _ rx' sx' kx' pz); exists (NO' _ ry n); inv H; split; constructor; auto.
-   exists (YES' _ rx' sx' kx' pz); exists (YES' _ ry sy ky pz); inv H; split; constructor; auto; simpl; f_equal; auto.
-   exists (PURE' _ kz pz); exists (PURE' _ kz pz); simpl in *; inv H; split; [constructor | tauto].
-
-   destruct x as [ rx | rx sx kx px | kx px ]; try solve [exfalso; inv H].
-   destruct y as [ ry | ry sy ky py | ky py ]; try solve [exfalso; inv H].
-   destruct z' as [ rz | rz sz kz pz | kz pz ]; try solve [exfalso; inv H].
-   exists (NO' _ ry n0); exists (NO' _ rz n1); inv H; split; constructor; auto.
-   destruct z' as [ rz | rz sz kz pz | kz pz ]; try solve [exfalso; inv H].
-   exists (YES' _ ry sy ky py); exists (YES' _ rz sz ky py); inv H; split; constructor; auto.
-   destruct y as [ ry | ry sy ky py | ky py ]; try solve [exfalso; inv H].
-   destruct z' as [ rz | rz sz kz pz | kz pz ]; try solve [exfalso; inv H].
-   exists (NO' _ ry n); exists (YES' _ rz sz kx px); inv H; split; constructor; auto.
-   destruct z' as [ rz | rz sz kz pz | kz pz ]; try solve [exfalso; inv H].
-   exists (YES' _ ry sy kx px); exists (YES' _ rz sz kx px); inv H; split; constructor; auto. simpl; f_equal; auto.
-   exists (PURE' _ kx px); exists (PURE' _ kx px); inv H; split; constructor; auto.
-  Qed.
-
-  Definition res_option (PRED : Type) (r: res PRED) : option (rshare * kind):=
-    match r with
-      | NO' _ _ => None
-      | YES' sh rsh k _ => Some (readable_part rsh,k)
-      | PURE' _ _ => None (* PUREs cannot be split in any interesting way, which is what valid is about. *)
-    end.
-
-  Definition ghost (PRED : Type) : Type :=
-    list (option ({g: Ghost & {a: @G g | ghost.valid a}} * fpreds PRED)%type).
-
-  Definition ghost_fmap (A B:Type) (f:A->B) (g:B->A)(x:ghost A) : ghost B :=
-    fmap (flist (foption (fpair (fconst _) fpreds))) f g x.
-
-  Lemma ff_ghost : functorFacts ghost ghost_fmap.
-  Proof.
-    constructor; intros; extensionality x; unfold ghost_fmap.
-    - rewrite fmap_id; auto.
-    - rewrite <- fmap_comp; auto.
-  Qed.
-
-  Definition f_ghost : functor := Functor ff_ghost.
-
-  #[global] Instance preds_join PRED : Join _ := Join_equiv (fpreds PRED).
-
-  Inductive ghost_elem_join : Join {g: Ghost & {a: @G g | ghost.valid a}} :=
-  | elem_join_I g a b c va vb vc: join a b c ->
-    ghost_elem_join (existT _ g (exist _ a va)) (existT _ g (exist _ b vb))
-                    (existT _ g (exist _ c vc)).
-  #[global] Existing Instance ghost_elem_join.
-
-  Inductive ghost_join PRED : Join (ghost PRED) :=
-  | ghost_join_nil_l m: ghost_join PRED nil m m
-  | ghost_join_nil_r m: ghost_join PRED m nil m
-  | ghost_join_cons a1 a2 m1 m2 a3 m3: join a1 a2 a3 -> ghost_join PRED m1 m2 m3 ->
-      ghost_join PRED (a1 :: m1) (a2 :: m2) (a3 :: m3).
-  Global Hint Constructors ghost_join : core.
-  #[global] Existing Instance ghost_join.
-
-  Lemma elem_join_inv: forall a1 a2 a3, ghost_elem_join a1 a2 a3 ->
-  match a1, a2, a3 with
-  | existT g1 (exist x1 _), existT g2 (exist x2 _), existT g3 (exist x3 _) =>
-      exists H: g2 = g1, exists H': g3 = g1, join x1 (eq_rect _ _ x2 _ H) (eq_rect _ _ x3 _ H')
-  end.
-  Proof.
-    inversion 1; subst.
-    exists eq_refl, eq_refl; auto.
-  Qed.
-
-  Lemma ghost_join_inv: forall PRED m1 m2 m3, ghost_join PRED m1 m2 m3 ->
-  match m1, m2 with
-  | nil, _ => m3 = m2
-  | _, nil => m3 = m1
-  | a1 :: m1, a2 :: m2 => match m3 with nil => False
-                          | a3 :: m3 => join a1 a2 a3 /\ ghost_join PRED m1 m2 m3 end
-  end.
-  Proof.
-    induction 1; simpl; auto.
-    destruct m; simpl; auto.
-  Qed.
-
-  #[global] Instance pa_gej : @Perm_alg _ ghost_elem_join.
-  Proof.
-    constructor.
-    - inversion 1; inversion 1; subst.
-      inv H.
-      repeat (match goal with H : existT _ _ _ = existT _ _ _ |- _ => apply inj_pair2 in H end;
-          subst).
-      f_equal; eapply exist_ext, join_eq; eauto.
-    - intros ????? J1%elem_join_inv J2%elem_join_inv.
-      destruct a as (ga & a & ?), b as (gb & b & ?), c as (gc & c & ?), d as (gd & d & ?),
-        e as (ge & e & ?).
-      repeat (apply realize_eq in J1; destruct J1 as [? J1]).
-      repeat (apply realize_eq in J2; destruct J2 as [? J2]); subst.
-      destruct (join_assoc J1 J2) as (f & ? & J).
-      exists (existT _ ga (exist _ f (join_valid _ _ _ (join_comm J) v3))).
-      split; constructor; auto.
-    - inversion 1; constructor; auto.
-    - inversion 1; subst; inversion 1; subst; auto.
-      inv H.
-      repeat (match goal with H : existT _ _ _ = existT _ _ _ |- _ => apply inj_pair2 in H end;
-          subst).
-      f_equal; eapply exist_ext, join_positivity; eauto.
-  Qed.
-
-  #[global] Instance pa_gj : forall PRED, @Perm_alg _ (ghost_join PRED).
-  Proof.
-    constructor.
-    - intros until 1; revert z'; induction H; inversion 1; subst; auto.
-      f_equal; auto.
-      eapply join_eq; eauto.
-    - induction a; intros ???? J1 J2; apply ghost_join_inv in J1; subst.
-      { exists e; split; auto; constructor. }
-      destruct b; subst; [eexists; split; eauto; constructor|].
-      destruct d; [contradiction|].
-      destruct J1 as [Jc1 J1].
-      apply ghost_join_inv in J2.
-      destruct c; subst; [eexists; split; eauto; constructor; auto|].
-      destruct e; [contradiction|].
-      destruct J2 as [Jc2 J2].
-      destruct (join_assoc Jc1 Jc2) as (f & ? & ?).
-      destruct (IHa _ _ _ _ J1 J2) as (f' & ? & ?).
-      exists (f :: f'); split; constructor; auto.
-    - induction 1; constructor; auto.
-    - intros until 1; revert b'; induction H; inversion 1; subst; auto.
-      f_equal; eauto.
-      eapply join_positivity; eauto.
-  Qed.
-
-  Definition ghost_core (x : {g: Ghost & {a: @G g | ghost.valid a}}) : {g: Ghost & {a: @G g | ghost.valid a}} :=
-    match x with existT _ (exist _ V) => existT _ _ (exist _ _ (core_valid _ V)) end.
-
-  #[global] Instance sa_gj : forall PRED, @Sep_alg _ (ghost_join PRED).
-  Proof.
-    intros; exists (fun g => map (option_map (fun '(a, b) => (ghost_core a, b))) g); auto; intros.
-    - hnf.
-      induction t; constructor; auto; simpl.
-      destruct a as [(?, ?)|]; repeat constructor; simpl.
-      unfold ghost_core. destruct s as (? & ? & ?); constructor. apply core_unit.
-    - induction H; try solve [eexists; constructor].
-      destruct IHghost_join as [x J].
-      exists (option_map (fun '(x, y) => (ghost_core x, y)) a3 :: x); constructor; auto.
-      inv H; try constructor.
-      + destruct a3 as [(?, ?)|]; constructor.
-        split; hnf; auto; simpl.
-        destruct s as (? & ? & ?); simpl. constructor.
-        apply core_duplicable.
-      + destruct a0, a4, a5; simpl in *.
-        destruct H1; split; simpl in *.
-        * inv H; simpl. constructor.
-          eapply core_sub_join, join_core_sub; eassumption.
-        * destruct H1; subst; split; auto.
-    - rewrite map_map; apply map_ext.
-      intros [((? & ? & ?), ?)|]; auto; simpl.
-      do 3 f_equal. apply exist_ext, core_idem.
-  Defined.
-
-  Opaque fpreds.
-
-  Definition paf_ghost : @pafunctor f_ghost ghost_join.
-  Proof.
-    constructor; repeat intro.
-    - induction H; constructor; auto.
-      inv H; constructor; auto.
-      inv H1; constructor; auto.
-      inv H2; constructor; auto; simpl; congruence.
-    - generalize dependent z; revert y; induction x'; intros; apply ghost_join_inv in H.
-      { exists nil, z; split; auto; constructor. }
-      destruct y; simpl in *.
-      { exists z, nil; split; auto; constructor. }
-      destruct z; [contradiction | simpl in *].
-      destruct H as [J1 J2].
-      destruct (IHx' _ _ J2) as (x & y' & ? & ? & ?); subst.
-      apply lower_join_inv in J1.
-      destruct a as [[[? []]]|].
-      + destruct o as [[[? []]]|].
-        * destruct o0 as [[[? []]]|]; [|contradiction].
-          destruct J1 as [J1%elem_join_inv J1']; simpl in *.
-          repeat (apply realize_eq in J1 as [? J1]); subst; simpl in *.
-          exists (Some (existT _ x0 (exist _ _ v), _f1) :: x),
-            (Some (existT _ x0 (exist _ _ v0), _f1) :: y').
-          split; [repeat constructor; auto|].
-          unfold ghost_fmap in *; simpl in *.
-          inv J1'.
-          rewrite <- H1, <- H2; auto.
-        * destruct o0 as [[[? []]]|]; [|contradiction].
-          inv J1.
-          match goal with H : existT _ _ _ = existT _ _ _ |- _ => apply inj_pair2 in H end;
-            subst.
-          exists (Some (existT _ x2 (exist _ _ v0), _f0) :: x), (None :: y').
-          split; [repeat constructor; auto|].
-          unfold ghost_fmap in *; simpl in *.
-          rewrite <- H1; split; f_equal; f_equal; f_equal; f_equal.
-          apply exist_ext; auto.
-      + exists (None :: x), (o0 :: y').
-        split; [repeat constructor; auto|].
-        split; auto.
-        unfold ghost_fmap in *; simpl in *.
-        rewrite <- H1; f_equal.
-        destruct o, o0; inv J1; auto.
-    - generalize dependent z'; revert y; induction x; intros; apply ghost_join_inv in H; simpl in H.
-      { exists y, y; split; auto; constructor. }
-      destruct y; simpl in *.
-      { exists nil, (a :: x); split; auto; constructor. }
-      destruct z'; [contradiction | simpl in *].
-      destruct H as [J1 J2].
-      destruct (IHx _ _ J2) as (y' & z & ? & ? & ?); subst.
-      apply lower_join_inv in J1.
-      destruct a as [[[? []]]|].
-      + destruct o as [[[? []]]|].
-        * destruct o0 as [[[? []]]|]; [|contradiction].
-          destruct J1 as [J1%elem_join_inv J1']; simpl in *.
-          repeat (apply realize_eq in J1 as [? J1]); subst; simpl in *.
-          exists (Some (existT _ x0 (exist _ _ v0), _f) :: y'),
-            (Some (existT _ x0 (exist _ _ v1), _f) :: z).
-          split; [repeat constructor; auto|].
-          unfold ghost_fmap in *; simpl in *.
-          inv J1'.
-          rewrite <- H0, <- H1; auto.
-        * destruct o0 as [[[? []]]|]; [|contradiction].
-          inv J1.
-          match goal with H : existT _ _ _ = existT _ _ _ |- _ => apply inj_pair2 in H end;
-            subst.
-          exists (None :: y'), (Some (existT _ x2 (exist _ _ v), _f) :: z).
-          split; [repeat constructor; auto|].
-          unfold ghost_fmap in *; simpl in *.
-          rewrite <- H0; split; f_equal; f_equal; f_equal; f_equal.
-          apply exist_ext; auto.
-      + exists (o :: y'), (o :: z).
-        split; [repeat constructor; auto|].
-        unfold ghost_fmap in *; simpl in *; rewrite <- H0; split; f_equal.
-        destruct o, o0; auto; contradiction.
-  Qed.
-
-  Definition pre_rmap (A:Type) := ((address -> res A) * ghost A)%type.
-  Definition f_pre_rmap : functor :=
-    fpair (ffunc (fconst address) f_res) f_ghost.
-
-  Notation Join_obj A := (Join_prod _ (Join_fun address (res A) (res_join A)) _ (ghost_join A)).
-
-  #[global] Instance Join_pre_rmap (A: Type) : Join (pre_rmap A) :=
-    Join_obj A.
-
-  Definition paf_pre_rmap : @pafunctor f_pre_rmap Join_pre_rmap :=
-    paf_pair (paf_fun address paf_res) paf_ghost.
-
-  Definition Perm_pre_rmap (A: Type): Perm_alg (pre_rmap A) :=
-    Perm_prod (Perm_fun address _ _ _) (pa_gj A).
-
-  Definition Sep_pre_rmap (A: Type): Sep_alg (pre_rmap A) :=
-    Sep_prod(PAa := Perm_fun address _ _ _) (Sep_fun address _ _ _ (fsep_sep (sa_rj _))) (sa_gj A).
-
-Lemma pre_rmap_core:
-forall (A : Type) (m : f_pre_rmap A),
-  @core (f_pre_rmap A) (Join_pre_rmap A) (Sep_pre_rmap A) m =
- (@core ((fpair (ffunc (fconst address) f_res) f_ghost) A)
-           (Join_prod ((ffunc (fconst address) f_res) A)
-              (Join_pi ((fconst address) A)
-                 (fun _ : (fconst address) A => f_res A)
-                 (fun _ : (fconst address) A => Join_res A))
-              (f_ghost A) (ghost_join A))
-           (@Sep_prod ((ffunc (fconst address) f_res) A)
-              (Join_pi ((fconst address) A)
-                 (fun _ : (fconst address) A => f_res A)
-                 (fun _ : (fconst address) A => Join_res A))
-              (f_ghost A) (ghost_join A)
-              (Perm_pi ((fconst address) A)
-                 (fun _ : (fconst address) A => f_res A)
-                 (fun _ : (fconst address) A => Join_res A)
-                 (fun _ : (fconst address) A => pa_rj A)) (pa_gj A)
-              (Sep_pi ((fconst address) A)
-                 (fun _ : (fconst address) A => f_res A)
-                 (fun _ : (fconst address) A => Join_res A)
-                 (fun _ : (fconst address) A => pa_rj A)
-                 (fun _ : (fconst address) A => fsep_sep (sa_rj A)))
-              (sa_gj A)) m).
-Proof.
-intros. reflexivity.
-Qed.
-
-End StratModel.
-
-Local Open Scope nat_scope.
-
-Module Type RMAPS.
-  Declare Module AV:ADR_VAL.
-  Import AV.
-
-  Parameter rmap : Type.
-  Axiom Join_rmap: Join rmap. #[global] Existing Instance Join_rmap.
-  Axiom Perm_rmap: Perm_alg rmap. #[global] Existing Instance Perm_rmap.
-  Axiom Sep_rmap: Sep_alg rmap. #[global] Existing Instance Sep_rmap.
-  Axiom ag_rmap: ageable rmap. #[global] Existing Instance ag_rmap.
-  Axiom Age_rmap: Age_alg rmap. #[global] Existing Instance Age_rmap.
-  Axiom Ext_rmap: Ext_ord rmap. #[global] Existing Instance Ext_rmap.
-  Axiom ExtA_rmap: Ext_alg rmap. #[global] Existing Instance ExtA_rmap.
-
-  Inductive preds : Type :=
-    SomeP : forall A : TypeTree,
-      (forall ts: list Type, dependent_type_functor_rec ts A (pred rmap)) -> preds.
-
-  Definition NoneP := SomeP (ConstType unit) (fun _ => tt).
-
-  Inductive resource : Type :=
-    | NO: forall sh: Share.t, ~(readable_share sh) -> resource
-    | YES: forall sh: Share.t, readable_share sh -> kind -> preds -> resource
-    | PURE: kind -> preds -> resource.
-
-  Definition res_option (r:resource) : option (rshare * kind) :=
-    match r with
-      | NO _ _ => None
-      | YES sh rsh k _ => Some (readable_part rsh,k)
-      | PURE k _ => None
-    end.
-
-  Inductive res_join : resource -> resource -> resource -> Prop :=
-   | res_join_NO1 : forall sh1 nsh1 sh2 nsh2 sh3 nsh3
-                 (RJ: join sh1 sh2 sh3),
-                 res_join (NO sh1 nsh1) (NO sh2 nsh2) (NO sh3 nsh3)
-   | res_join_NO2 : forall sh1 rsh1 sh2 nsh2 sh3 rsh3 k p
-                 (RJ: join sh1 sh2 sh3),
-                 res_join (YES sh1 rsh1 k p) (NO sh2 nsh2) (YES sh3 rsh3 k p)
-   | res_join_NO3 : forall sh1 nsh1 sh2 rsh2 sh3 rsh3 k p
-                 (RJ: join sh1 sh2 sh3),
-                 res_join (NO sh1 nsh1) (YES sh2 rsh2 k p) (YES sh3 rsh3 k p)
-   | res_join_YES : forall sh1 rsh1 sh2 rsh2 sh3 rsh3 k p
-                 (RJ: join sh1 sh2 sh3),
-        res_join (YES sh1 rsh1 k p) (YES sh2 rsh2 k p) (YES sh3 rsh3 k p)
-   | res_join_PURE : forall k p, res_join (PURE k p) (PURE k p) (PURE k p).
-
-  #[global] Instance Join_resource: Join resource := res_join.
-  Axiom Perm_resource: Perm_alg resource. #[global] Existing Instance Perm_resource.
-  Axiom Sep_resource: FSep_alg resource. #[global] Existing Instance Sep_resource.
-
-  Definition preds_fmap (f g: pred rmap -> pred rmap) (x:preds) : preds :=
-    match x with SomeP A Q => SomeP A (fmap (fpi _) f g Q)
-    end.
-  (* Check whether the following two can be erased. *)
-  Axiom preds_fmap_id : preds_fmap (id _) (id _) = id preds.
-  Axiom preds_fmap_comp : forall f1 f2 g1 g2,
-    preds_fmap g1 g2 oo preds_fmap f1 f2 = preds_fmap (g1 oo f1) (f2 oo g2).
-
-  Definition resource_fmap (f g:pred rmap -> pred rmap) (x:resource) : resource :=
-    match x with
-    | NO sh nsh => NO sh nsh
-    | YES sh rsh k p => YES sh rsh k (preds_fmap f g p)
-    | PURE k p => PURE k (preds_fmap f g p)
-    end.
-  Axiom resource_fmap_id : resource_fmap (id _) (id _) = id resource.
-  Axiom resource_fmap_comp : forall f1 f2 g1 g2,
-    resource_fmap g1 g2 oo resource_fmap f1 f2 = resource_fmap (g1 oo f1) (f2 oo g2).
-
-  Definition ghost : Type := list (option ({g: Ghost & {a: @G g | ghost.valid a}} * preds)%type).
-
-  #[global] Instance preds_join : Join _ := Join_equiv preds.
-
-  Inductive ghost_elem_join : Join {g: Ghost & {a: @G g | ghost.valid a}} :=
-  | elem_join_I g a b c va vb vc: join a b c ->
-    ghost_elem_join (existT _ g (exist _ a va)) (existT _ g (exist _ b vb))
-                    (existT _ g (exist _ c vc)).
-  #[global] Existing Instance ghost_elem_join.
-
-  Inductive ghost_join : Join ghost :=
-  | ghost_join_nil_l m: ghost_join nil m m
-  | ghost_join_nil_r m: ghost_join m nil m
-  | ghost_join_cons a1 a2 m1 m2 a3 m3: join a1 a2 a3 -> ghost_join m1 m2 m3 ->
-      ghost_join (a1 :: m1) (a2 :: m2) (a3 :: m3).
-  #[global] Existing Instance ghost_join.
-
-  Axiom Perm_ghost: Perm_alg ghost. #[global] Existing Instance Perm_ghost.
-  Axiom Sep_ghost: Sep_alg ghost. #[global] Existing Instance Sep_ghost.
-  Definition ghost_core (x : {g: Ghost & {a: @G g | ghost.valid a}}) : {g: Ghost & {a: @G g | ghost.valid a}} :=
-    match x with existT _ (exist _ V) => existT _ _ (exist _ _ (core_valid _ V)) end.
-
-  Axiom ghost_core_eq: forall (g: ghost), core g = map (option_map (fun '(a, b) => (ghost_core a, b))) g.
-
-  Definition ghost_fmap (f g:pred rmap -> pred rmap)(x:ghost) : ghost :=
-    map (option_map (fun '(a, b) => (a, preds_fmap f g b))) x.
-
-  Axiom ghost_fmap_id : ghost_fmap (id _) (id _) = id ghost.
-  Axiom ghost_fmap_comp : forall f1 f2 g1 g2,
-    ghost_fmap g1 g2 oo ghost_fmap f1 f2 = ghost_fmap (g1 oo f1) (f2 oo g2).
-
-  Definition rmap' := ((address -> resource) * ghost)%type.
-
-  Definition rmap_fmap (f g: pred rmap -> pred rmap) (x:rmap') : rmap' :=
-    (resource_fmap f g oo fst x, ghost_fmap f g (snd x)).
-
-  Axiom rmap_fmap_id : rmap_fmap (id _) (id _) = id rmap'.
-  Axiom rmap_fmap_comp : forall f1 f2 g1 g2,
-   rmap_fmap g1 g2 oo rmap_fmap f1 f2 = rmap_fmap (g1 oo f1) (f2 oo g2).
-
-  Parameter squash : (nat * rmap') -> rmap.
-  Parameter unsquash : rmap -> (nat * rmap').
-
-
-  Axiom rmap_level_eq: @level rmap _ = fun x => fst (unsquash x).
-  Axiom rmap_age1_eq: @age1 _ _ =
-     fun k => match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-
-  Definition resource_at (phi:rmap) : address -> resource := fst (snd (unsquash phi)).
-  Infix "@" := resource_at (at level 50, no associativity).
-  Definition ghost_of (phi:rmap) : ghost := snd (snd (unsquash phi)).
-
-  #[global] Instance Join_nat_rmap': Join (nat * rmap') := Join_prod _ (Join_equiv nat) _ _.
-
-  Axiom join_unsquash : forall phi1 phi2 phi3,
-    join phi1 phi2 phi3 <->
-    join (unsquash phi1) (unsquash phi2) (unsquash phi3).
-
-  Definition rmap_unage (k:rmap) : rmap :=
-    match unsquash k with
-    | (n,x) => squash (S n, x)
-    end.
-
-  Program Definition approx (n:nat) (p: pred rmap) : pred rmap :=
-    fun w => level w < n /\ p w.
-  Next Obligation. split. intros ??? [].
-  split.
-  apply age_level in H. lia.
-  apply pred_hereditary with a; auto.
-
-  intros ??? [].
-  split; [apply ext_level in H as <-; auto|].
-  apply pred_upclosed with a; auto.
-  Qed.
-
-  Axiom squash_unsquash : forall phi, squash (unsquash phi) = phi.
-  Axiom unsquash_squash : forall n rm, unsquash (squash (n,rm)) = (n,rmap_fmap (approx n) (approx n) rm).
-  Axiom ghost_of_core : forall phi, ghost_of (core phi) = core (ghost_of phi).
-
-  Axiom rmap_order : forall k1 k2, ext_order k1 k2 <->
-    level k1 = level k2 /\ resource_at k1 = resource_at k2 /\ join_sub (ghost_of k1) (ghost_of k2).
-
-End RMAPS.
-
-Module Rmaps (AV':ADR_VAL): RMAPS with Module AV:=AV'.
-  Module AV:=AV'.
-  Import AV.
-
-  Module SM := StratModel(AV).
-  Import SM.
-
-  Lemma ghost_fmap_join: forall {A B} (a b c : ghost A) f g, join a b c ->
-    join (ghost_fmap A B f g a) (ghost_fmap _ _ f g b) (ghost_fmap _ _ f g c).
-  Proof.
-    induction 1; constructor; auto.
-    inv H; constructor; auto.
-    destruct a0, a4, a5; inv H1; constructor; auto.
-    simpl in *; inv H2; constructor; auto.
-  Qed.
-
-  #[export] Existing Instance pa_gj.
-
-  Module TyF.
-    Definition F := f_pre_rmap.
-
-    (* This is our extension order: it can be changed to anything with the properties
-       in this and the following module. *)
-    Definition Rel A (r1 r2 : f_pre_rmap A) := fst r1 = fst r2 /\ join_sub (snd r1) (snd r2).
-    Lemma Rel_fmap :
-      forall (A B : Type) (f1 : A -> B) (f2 : B -> A) (x y : F A),
-      Rel A x y -> Rel B (fmap F f1 f2 x) (fmap F f1 f2 y).
-    Proof.
-      intros ?????? []; split; simpl in *.
-      - extensionality. congruence.
-      - destruct H0. eexists; apply ghost_fmap_join; eauto.
-    Qed.
-    Lemma Rel_refl : forall (A : Type) (x : F A), Rel A x x.
-    Proof.
-      split; auto. apply join_sub_refl.
-    Qed.
-    Lemma Rel_trans :
-      forall (A : Type) (x y z : F A),
-      Rel A x y -> Rel A y z -> Rel A x z.
-    Proof.
-      intros ???? [] []; split; [congruence|].
-      eapply join_sub_trans; eauto.
-    Qed.
-  End TyF.
-
-  Module TyFSA <: KNOT_FULL_SA_INPUT with Module KI:=TyF.
-    Module KI := TyF.
-    Import KI.
-
-    #[global] Instance Join_F: forall A, Join (F A) := _.
-    Definition Perm_F : forall A, Perm_alg (F A) := Perm_pre_rmap.
-    Definition Sep_F := Sep_pre_rmap.
-    Definition paf_F := paf_pre_rmap.
-
-    Lemma Rel_join_commut : forall {A} {x y z z' : F A}, join x y z ->
-      Rel A z z' -> exists x', Rel A x x' /\ join x' y z'.
-    Proof.
-      intros ? (rx, gx) (ry, gy) (rz, gz) (rz', gz') [? J] [? [g0 Jz]]; simpl in *; subst.
-      destruct (join_assoc (join_comm J) Jz) as (g' & ? & ?).
-      exists (rx, g'); repeat split; auto; simpl.
-      eexists; eauto.
-    Qed.
-
-    Lemma join_Rel_commut : forall {A} {x x' y' z' : F A}, Rel A x x' ->
-      join x' y' z' -> exists z, join x y' z /\ Rel A z z'.
-    Proof.
-      intros ? (rx, gx) (rx', gx') (ry', gy') (rz', gz') [? [g0 Jx]] [? J] ; simpl in *; subst.
-      destruct (join_assoc (join_comm Jx) J) as (g' & ? & ?).
-      exists (rz', g'); repeat split; auto; simpl.
-      eexists; eauto.
-    Qed.
-
-    Lemma id_exists : forall {A} (x : F A), exists e,
-      identity e /\ unit_for e x.
-    Proof.
-      intros ? (r, g).
-      exists (fun l => core (r l), nil); split.
-      - intros (?, ?) (?, ?) [Hr Hg]; f_equal; simpl in *.
-        + extensionality l. specialize (Hr l); simpl in Hr.
-          destruct (r l); inv Hr; auto;
-            eapply join_eq in H2; try apply bot_join_eq; subst;
-            f_equal; apply proof_irr.
-        + inv Hg; auto.
-      - split; [|constructor].
-        intros l; apply core_unit.
-    Qed.
-
-  End TyFSA.
-
-  Module K := Knot_MixVariantHeredProp(TyF).
-  Module KL := KnotLemmas_MixVariantHeredProp(K).
-
-  Module KA <: KNOT_ASSM with Module KI := TyF with Module KSAI := TyFSA
-    with Module K := K.
-    Module KI := TyF.
-    Module KSAI := TyFSA.
-    Module K := K.
-    Import K.
-
-    Lemma approx_core : forall n f,
-      core(Sep_alg := Sep_pre_rmap predicate) (fmap f_pre_rmap (approx n) (approx n) f) = fmap f_pre_rmap (approx n) (approx n) (core(Sep_alg := Sep_pre_rmap predicate) f).
-    Proof.
-      intros ? (ra, g).
-      rewrite !pre_rmap_core; simpl; f_equal.
-      - extensionality a.
-        destruct (ra a); auto.
-      - induction g; [reflexivity|].
-        unfold ghost_fmap; simpl; f_equal; auto.
-        destruct a as [(?, ?)|]; auto.
-    Qed.
-
-  End KA.
-
-  Module KSa := KnotFullSa(TyFSA)(K)(KL)(KA).
-
-  Definition rmap := K.knot.
-  #[global] Instance Join_rmap : Join rmap := KSa.Join_knot.
-  #[global] Instance Perm_rmap : Perm_alg rmap:= KSa.Perm_knot.
-  #[global] Instance Sep_rmap : Sep_alg rmap:= KSa.Sep_knot.
-  #[global] Instance ag_rmap : ageable rmap := K.ageable_knot.
-  #[global] Instance Age_rmap : Age_alg rmap := KSa.asa_knot.
-  #[global] Instance Ext_rmap : Ext_ord rmap := K.ext_knot.
-  #[global] Instance ExtA_rmap : Ext_alg rmap := KSa.ea_knot.
-
-  Inductive preds : Type :=
-    SomeP : forall A : TypeTree,
-    (forall ts: list Type, dependent_type_functor_rec ts A (pred rmap)) -> preds.
-
-  Definition NoneP := SomeP (ConstType unit) (fun _ => tt).
-
-  Inductive resource : Type :=
-    | NO: forall sh: Share.t, ~ readable_share sh -> resource
-    | YES: forall sh: Share.t, readable_share sh -> kind -> preds -> resource
-    | PURE: kind -> preds -> resource.
-
-  Definition resource2res (r: resource): res (pred rmap) :=
-    match r with
-      | NO sh nsh => NO' (pred rmap) sh nsh
-      | YES sh rsh k (SomeP A l) => YES' (pred rmap) sh rsh k (existT _ A l)
-      | PURE k (SomeP A l) => PURE' (pred rmap) k (existT _ A l)
-    end.
-
-  Definition res2resource (r: res (pred rmap)) : resource :=
-    match r with
-      | NO' sh nsh => NO sh nsh
-      | YES' sh rsh k (existT A l) => YES sh rsh k (SomeP A l)
-      | PURE' k (existT A l) => PURE k (SomeP A l)
-    end.
-
-  Lemma res2resource2res: forall x, resource2res (res2resource x) = x.
-  Proof. unfold resource2res, res2resource; destruct x as [? | ? ? ? [? ?] | ? [? ?]]; auto. Qed.
-
-  Lemma resource2res2resource: forall x, res2resource (resource2res x) = x.
-  Proof. unfold resource2res, res2resource; destruct x; try destruct p0; try destruct p; auto. Qed.
-
-  Definition res_option (r:resource) : option (rshare * kind) :=
-    match r with
-      | NO _ _ => None
-      | YES sh rsh k _ => Some (readable_part rsh,k)
-      | PURE k _ => None
-    end.
-
-  Lemma res_option_rewrite: res_option = SM.res_option (pred rmap) oo resource2res.
-  Proof.
-    unfold SM.res_option, res_option, compose.
-    extensionality r; destruct r; simpl; auto; destruct p; auto.
-  Qed.
-
-  Definition ghost : Type := list (option ({g: Ghost & {a: @G g | ghost.valid a}} * preds)%type).
-
-  Definition pred2p (p: preds) : fpreds (pred rmap) :=
-    match p with SomeP A P => existT _ A P end.
-
-  Definition p2pred (p: fpreds (pred rmap)) : preds :=
-    match p with existT A P => SomeP A P end.
-
-  Definition ghost2g (r: ghost): SM.ghost (pred rmap) :=
-    map (option_map (fun '(a, b) => (a, pred2p b))) r.
-
-  Definition g2ghost (r: SM.ghost (pred rmap)) : ghost :=
-    map (option_map (fun '(a, b) => (a, p2pred b))) r.
-
-  Lemma g2ghost2g: forall x, ghost2g (g2ghost x) = x.
-  Proof.
-    induction x; auto; simpl.
-    rewrite IHx; destruct a as [[]|]; auto; simpl.
-    destruct _f; auto.
-  Qed.
-
-  Lemma ghost2g2ghost: forall x, g2ghost (ghost2g x) = x.
-  Proof.
-    induction x; auto; simpl.
-    rewrite IHx; destruct a as [[]|]; auto; simpl.
-    destruct p; auto.
-  Qed.
-
-  Inductive res_join : resource -> resource -> resource -> Prop :=
-   | res_join_NO1 : forall sh1 nsh1 sh2 nsh2 sh3 nsh3
-                 (RJ: join sh1 sh2 sh3),
-                 res_join (NO sh1 nsh1) (NO sh2 nsh2) (NO sh3 nsh3)
-   | res_join_NO2 : forall sh1 rsh1 sh2 nsh2 sh3 rsh3 k p
-                 (RJ: join sh1 sh2 sh3),
-                 res_join (YES sh1 rsh1 k p) (NO sh2 nsh2) (YES sh3 rsh3 k p)
-   | res_join_NO3 : forall sh1 nsh1 sh2 rsh2 sh3 rsh3 k p
-                 (RJ: join sh1 sh2 sh3),
-                 res_join (NO sh1 nsh1) (YES sh2 rsh2 k p) (YES sh3 rsh3 k p)
-   | res_join_YES : forall sh1 rsh1 sh2 rsh2 sh3 rsh3 k p
-                 (RJ: join sh1 sh2 sh3),
-        res_join (YES sh1 rsh1 k p) (YES sh2 rsh2 k p) (YES sh3 rsh3 k p)
-   | res_join_PURE : forall k p, res_join (PURE k p) (PURE k p) (PURE k p).
-
-  #[global] Instance Join_resource: Join resource := res_join.
-  #[global] Instance Perm_resource: Perm_alg resource.
-  Proof. constructor.
-  * (*saf_eq *)
-      intros x y z z' H1 H2; inv H1; inv H2;
-      repeat match goal with H: join ?A ?B _, H': join ?A ?B ?C |- _ => pose proof (join_eq H H'); subst C end;
-      repeat proof_irr; auto.
-  * (* saf_assoc *)
-      intros a b c d e H1 H2.
-      destruct d as [rd | rd sd kd pd | kd pd].
-      destruct a as [ra | | ]; try solve [exfalso; inv H1].
-      destruct b as [rb| | ]; try solve [exfalso; inv H1].
-      assert (join ra rb rd) by (inv H1; auto).
-      destruct c as [rc | rc sc kc pc | kc pc]; try solve [exfalso; inv H2].
-      destruct e as [re | re se ke pe | ke pe]; try solve [exfalso; inv H2].
-      assert (join rd rc re) by (inv H2; auto).
-      destruct (join_assoc H H0) as [rf [? ?]].
-      exists (NO rf (join_unreadable_shares H3 n1 n2)); split; constructor; auto.
-      destruct e as [re | re se ke pe | ke pe]; try solve [exfalso; inv H2].
-      assert (join rd rc re) by (inv H2; auto).
-      destruct (join_assoc H H0) as [rf [? ?]].
-      exists (YES rf (join_readable2 H3 sc) kc pc).
-      inv H2. split; constructor; auto.
-      destruct c as [rc | rc sc kc pc | kc pc]; try solve [exfalso; inv H2].
-      destruct e as [re | re se ke pe | ke pe]; try solve [exfalso; inv H2].
-      assert (H0: join rd rc re) by (inv H2; auto).
-      destruct a as [ra | ra sa ka pa | ka pa ]; try solve [exfalso; inv H1].
-      destruct b as [ | rb sb kb pb | ]; try solve [exfalso; inv H1].
-      assert (H: join ra rb rd) by (inv H1; auto).
-      destruct (join_assoc H H0) as [rf [? ?]].
-      exists (YES rf (join_readable1 H3 sb) kd pd).  inv H1; inv H2; split; constructor; auto.
-      destruct b as [ rb | rb sb kb pb | ]; try solve [exfalso; inv H1].
-      assert (H: join ra rb rd) by (inv H1; auto).
-      destruct (join_assoc H H0) as [rf [? ?]].
-      exists (NO rf (join_unreadable_shares H3 n0 n)).  inv H1; inv H2; split; constructor; auto.
-      assert (H: join ra rb rd) by (inv H1; auto).
-      destruct (join_assoc H H0) as [rf [? ?]].
-      exists (YES rf (join_readable1 H3 sb) kb pb).  inv H1; inv H2; split; constructor; auto.
-      destruct e as [re | re se ke pe | ke pe]; try solve [exfalso; inv H2].
-      assert (H0: join rd rc re) by (inv H2; auto).
-      destruct b as [ rb | rb sb kb pb | ]; try solve [exfalso; inv H1].
-      destruct a as [ra | ra sa ka pa | ka pa ]; try solve [exfalso; inv H1].
-      assert (H: join ra rb rd) by (inv H1; auto).
-      destruct (join_assoc H H0) as [rf [? ?]].
-      exists (YES rf (join_readable2 H3 sc) kc pc).  inv H1; inv H2; split; constructor; auto.
-      destruct a as [ra | ra sa ka pa | ka pa ]; try solve [exfalso; inv H1].
-      assert (H: join ra rb rd) by (inv H1; auto).
-      destruct (join_assoc H H0) as [rf [? ?]].
-      exists (YES rf (join_readable1 H3 sb) kb pb).  inv H1; inv H2; split; try constructor; auto.
-      assert (H: join ra rb rd) by (inv H1; auto).
-      destruct (join_assoc H H0) as [rf [? ?]].
-      exists (YES rf (join_readable1 H3 sb) kb pb).  inv H1; inv H2; split; try constructor; auto.
-      exists (PURE kd pd). inv H1; inv H2; split; constructor.
-
-*      (* saf_com *)
-      intros a b c H; inv H; econstructor;  apply join_comm; auto.
-
-*     (* saf_positivity *)
-     intros; inv H; inv H0;
-      repeat match goal with H: join ?A ?B ?C, H': join ?C ?D ?A |- _ =>
-                    pose proof (join_positivity H H'); subst C
-      end;
-      repeat proof_irr; auto.
- Qed.
-
-  #[global] Instance Sep_resource: FSep_alg resource.
-  Proof.
-  apply mkSep
-    with (fun x => match x
-                   with NO _ _ => NO Share.bot bot_unreadable
-                      | YES _ _ _ _ => NO Share.bot bot_unreadable
-                      | PURE k pds => PURE k pds end).
-  intro. destruct t; constructor; try apply join_unit1; auto.
-  intros. inversion H; auto.
-  Defined.
-
-  (* Will this give us the higher-order ghost state we want? *)
-  #[global] Instance preds_join : Join _ := Join_equiv preds.
-
-  Inductive ghost_elem_join : Join {g: Ghost & {a: @G g | ghost.valid a}} :=
-  | elem_join_I g a b c va vb vc: join a b c ->
-    ghost_elem_join (existT _ g (exist _ a va)) (existT _ g (exist _ b vb))
-                    (existT _ g (exist _ c vc)).
-  #[global] Existing Instance ghost_elem_join.
-
-  Inductive ghost_join : Join ghost :=
-  | ghost_join_nil_l m: ghost_join nil m m
-  | ghost_join_nil_r m: ghost_join m nil m
-  | ghost_join_cons a1 a2 m1 m2 a3 m3: join a1 a2 a3 -> ghost_join m1 m2 m3 ->
-      ghost_join (a1 :: m1) (a2 :: m2) (a3 :: m3).
-  #[global] Existing Instance ghost_join.
-
-  Lemma elem_join_inv: forall a1 a2 a3, ghost_elem_join a1 a2 a3 ->
-  match a1, a2, a3 with
-  | existT g1 (exist x1 _), existT g2 (exist x2 _), existT g3 (exist x3 _) =>
-      exists H: g2 = g1, exists H': g3 = g1, join x1 (eq_rect _ _ x2 _ H) (eq_rect _ _ x3 _ H')
-  end.
-  Proof.
-    inversion 1; subst.
-    exists eq_refl, eq_refl; auto.
-  Qed.
-
-  Lemma ghost_join_inv: forall m1 m2 m3, ghost_join m1 m2 m3 ->
-  match m1, m2 with
-  | nil, _ => m3 = m2
-  | _, nil => m3 = m1
-  | a1 :: m1, a2 :: m2 => match m3 with nil => False
-                          | a3 :: m3 => join a1 a2 a3 /\ ghost_join m1 m2 m3 end
-  end.
-  Proof.
-    induction 1; simpl; auto.
-    destruct m; simpl; auto.
-  Qed.
-
-  #[global] Instance pa_gej : @Perm_alg _ ghost_elem_join.
-  Proof.
-    constructor.
-    - inversion 1; inversion 1; subst.
-      inv H.
-      repeat (match goal with H : existT _ _ _ = existT _ _ _ |- _ => apply inj_pair2 in H end;
-          subst).
-      f_equal; eapply exist_ext, join_eq; eauto.
-    - intros ????? J1%elem_join_inv J2%elem_join_inv.
-      destruct a as (ga & a & ?), b as (gb & b & ?), c as (gc & c & ?), d as (gd & d & ?),
-        e as (ge & e & ?).
-      repeat (apply realize_eq in J1; destruct J1 as [? J1]).
-      repeat (apply realize_eq in J2; destruct J2 as [? J2]); subst.
-      destruct (join_assoc J1 J2) as (f & ? & J).
-      exists (existT _ ga (exist _ f (join_valid _ _ _ (join_comm J) v3))).
-      split; constructor; auto.
-    - inversion 1; constructor; auto.
-    - inversion 1; subst; inversion 1; subst; auto.
-      inv H.
-      repeat (match goal with H : existT _ _ _ = existT _ _ _ |- _ => apply inj_pair2 in H end;
-          subst).
-      f_equal; eapply exist_ext, join_positivity; eauto.
-  Qed.
-
-  #[global] Instance Perm_ghost : Perm_alg ghost.
-  Proof.
-    constructor.
-    - intros until 1; revert z'; induction H; inversion 1; subst; auto.
-      f_equal; auto.
-      eapply join_eq; eauto.
-    - induction a; intros ???? J1 J2; apply ghost_join_inv in J1; subst.
-      { exists e; split; auto; constructor. }
-      destruct b; subst; [eexists; split; eauto; constructor|].
-      destruct d; [contradiction|].
-      destruct J1 as [Jc1 J1].
-      apply ghost_join_inv in J2.
-      destruct c; subst; [eexists; split; eauto; constructor; auto|].
-      destruct e; [contradiction|].
-      destruct J2 as [Jc2 J2].
-      destruct (join_assoc Jc1 Jc2) as (f & ? & ?).
-      destruct (IHa _ _ _ _ J1 J2) as (f' & ? & ?).
-      exists (f :: f'); split; constructor; auto.
-    - induction 1; constructor; auto.
-    - intros until 1; revert b'; induction H; inversion 1; subst; auto.
-      f_equal; eauto.
-      eapply join_positivity; eauto.
-  Qed.
-
-  Definition ghost_core (x : {g: Ghost & {a: @G g | ghost.valid a}}) : {g: Ghost & {a: @G g | ghost.valid a}} :=
-    match x with existT _ (exist _ V) => existT _ _ (exist _ _ (core_valid _ V)) end.
-
-  #[global] Instance Sep_ghost : Sep_alg ghost.
-  Proof.
-    intros; exists (fun g => map (option_map (fun '(a, b) => (ghost_core a, b))) g).
-    - intros; unfold unit_for.
-      induction t; constructor; auto.
-      destruct a as [(?, ?)|]; constructor.
-      split; [|split; auto]; simpl.
-      destruct s as (? & ? & ?); constructor.
-      apply core_unit.
-    - induction 1; try solve [eexists; constructor].
-      destruct IHghost_join; eexists; constructor; eauto.
-      inv H; try constructor.
-      + destruct a3 as [(?, ?)|]; constructor.
-        split; [|split]; auto; simpl.
-        destruct s as (? & ? & ?); constructor.
-        apply core_duplicable.
-      + destruct a0, a4, a5, H2; simpl in *.
-        constructor; split; simpl.
-        * inv H; constructor.
-          eapply core_sub_join, join_core_sub; eassumption.
-        * destruct H2; subst; split; auto.
-    - intros; rewrite map_map; apply map_ext.
-      intros [(?, ?)|]; auto; simpl.
-      destruct s as (? & ? & ?); simpl; do 3 f_equal.
-      apply exist_ext, core_idem.
-  Defined.
-
-  Lemma ghost_core_eq : forall (g: ghost), core g = map (option_map (fun '(a, b) => (ghost_core a, b))) g.
-  Proof.
-    auto.
-  Qed.
-
-  Definition rmap' := ((address->resource) * ghost)%type.
-  Definition preds_fmap (f g:(pred rmap)->(pred rmap)) (x:preds) : preds :=
-    match x with SomeP A ls => SomeP A (fmap (fpi _) f g ls) end.
-
-  Lemma preds_fmap_id : preds_fmap (id (pred rmap)) (id (pred rmap)) = id preds.
-  Proof.
-    intros; apply extensionality; intro x; destruct x; simpl; auto.
-    unfold id at 3.
-    f_equal.
-    extensionality i.
-    rewrite fmap_id; auto.
-  Qed.
-
-  Lemma preds_fmap_comp : forall f1 f2 g1 g2,
-    preds_fmap g1 g2 oo preds_fmap f1 f2 = preds_fmap (g1 oo f1) (f2 oo g2).
-  Proof.
-    intros; apply extensionality; intro x; destruct x; simpl.
-    unfold preds_fmap, compose at 1; simpl.
-    f_equal.
-    extensionality i.
-    rewrite <- fmap_comp; auto.
-  Qed.
-
-  Definition resource_fmap (f g:pred rmap -> pred rmap) (x:resource) : resource :=
-    match x with
-    | NO sh nsh => NO sh nsh
-    | YES sh rsh k p => YES sh rsh k (preds_fmap f g p)
-    | PURE k p => PURE k (preds_fmap f g p)
-    end.
-
-  Definition ghost_fmap (f g:pred rmap -> pred rmap)(x:ghost) : ghost :=
-    map (option_map (fun '(a, b) => (a, preds_fmap f g b))) x.
-
-  Lemma resource_fmap_id :
-    resource_fmap (id (pred rmap)) (id (pred rmap)) = id resource.
-  Proof.
-    intros; apply extensionality; intro x.
-    unfold resource_fmap.
-    destruct x; simpl; auto.
-    rewrite preds_fmap_id; auto.
-    rewrite preds_fmap_id; auto.
-  Qed.
-
-  Lemma ghost_fmap_id : ghost_fmap (id (pred rmap)) (id (pred rmap)) = id ghost.
-  Proof.
-    extensionality x; induction x; auto; simpl.
-    rewrite IHx; destruct a as [[]|]; auto; simpl.
-    rewrite preds_fmap_id; auto.
-  Qed.
-
-  Lemma resource_fmap_comp : forall f1 f2 g1 g2,
-    resource_fmap g1 g2 oo resource_fmap f1 f2 = resource_fmap (g1 oo f1) (f2 oo g2).
-  Proof.
-    intros f1 f2 g1 g2.
-    apply extensionality; intro x; destruct x; simpl; auto.
-    unfold compose at 1; simpl.
-    rewrite <- preds_fmap_comp; auto.
-    rewrite <- preds_fmap_comp; auto.
-  Qed.
-
-  Lemma ghost_fmap_comp : forall f1 f2 g1 g2,
-    ghost_fmap g1 g2 oo ghost_fmap f1 f2 = ghost_fmap (g1 oo f1) (f2 oo g2).
-  Proof.
-    intros; extensionality x; induction x; auto; simpl.
-    rewrite <- IHx; destruct a as [[]|]; auto; simpl.
-    rewrite <- preds_fmap_comp; auto.
-  Qed.
-
-  Definition rmap_fmap (f g:(pred rmap)->(pred rmap)) (x:rmap') : rmap' :=
-              (resource_fmap f g oo fst x, ghost_fmap f g (snd x)).
-
-  Lemma rmap_fmap_id : rmap_fmap (id (pred rmap)) (id (pred rmap)) = id rmap'.
-  Proof.
-    intros; apply extensionality; intro x.
-    unfold rmap_fmap; destruct x.
-    simpl.
-    rewrite resource_fmap_id, ghost_fmap_id.
-    rewrite (id_unit2 _ (resource) r).
-    f_equal; auto.
-  Qed.
-
-  Lemma rmap_fmap_comp : forall f1 f2 g1 g2,
-    rmap_fmap g1 g2 oo rmap_fmap f1 f2 = rmap_fmap (g1 oo f1) (f2 oo g2).
-  Proof.
-    intros f1 f2 g1 g2.
-    unfold rmap_fmap.
-    apply extensionality; intro x.
-    unfold compose at 1.
-    destruct x as (r,g). simpl.
-    rewrite <- compose_assoc.
-    rewrite resource_fmap_comp; auto.
-    f_equal; auto.
-    pose proof ghost_fmap_comp as HG.
-    unfold compose in HG at 1; rewrite <- HG.
-    intros.
-    f_equal; proof_irr; auto.
-  Qed.
-
-  Definition rmap'2pre_rmap (f: rmap') : f_pre_rmap (pred rmap) :=
-      (fun x : address => resource2res (fst f x), ghost2g (snd f)).
-
-  Definition pre_rmap2rmap' (f: f_pre_rmap (pred rmap)) : rmap' :=
-      (fun l : address => res2resource (fst f l), g2ghost (snd f)).
-
-  Lemma rmap'2pre_rmap2rmap' :
-    forall x, rmap'2pre_rmap (pre_rmap2rmap' x) = x.
-  Proof.
-    intro. unfold rmap'2pre_rmap, pre_rmap2rmap'. simpl.
-    destruct x; simpl; f_equal.
-    extensionality x; rewrite res2resource2res; auto.
-    rewrite g2ghost2g; auto.
-  Qed.
-
-  Lemma pre_rmap2rmap'2pre_rmap :
-    forall x,  pre_rmap2rmap' (rmap'2pre_rmap x) = x.
-  Proof.
-    intro.
-    unfold rmap'2pre_rmap, pre_rmap2rmap'. simpl.
-    destruct x; simpl; f_equal.
-    extensionality x; rewrite resource2res2resource; auto.
-    rewrite ghost2g2ghost; auto.
-  Qed.
-
-  Definition squash (n_rm:nat * rmap') : rmap :=
-    match n_rm with (n,rm) => K.squash (n, rmap'2pre_rmap rm) end.
-
-  Definition unsquash (phi:rmap) : (nat * rmap') :=
-    match K.unsquash phi with (n,rm) => (n, pre_rmap2rmap' rm) end.
-
-  Definition rmap_level (phi:rmap) : nat := fst (unsquash phi).
-  Definition resource_at (phi:rmap) : address -> resource := fst (snd (unsquash phi)).
-  Infix "@" := resource_at (at level 50, no associativity).
-  Definition ghost_of (phi:rmap) : ghost := snd (snd (unsquash phi)).
-
-  Lemma pred_ext': forall {A} `{agA: ageable A} P Q,
-                (forall x, app_pred P x <-> app_pred Q x) -> P = Q.
-  Proof. intros; apply pred_ext; intro; apply H; auto. Qed.
-
-  Lemma squash_unsquash : forall phi, squash (unsquash phi) = phi.
-  Proof.
-    intros.
-    unfold squash, unsquash; simpl.
-    destruct (K.unsquash phi) eqn:?H; simpl; intros.
-    rewrite rmap'2pre_rmap2rmap'.
-    unfold K.KI.F in *.
-    unfold f_pre_rmap in H.
-    match goal with
-    | |- K.squash ?A = _ => replace A with (K.unsquash phi)
-    end.
-    rewrite K.squash_unsquash; auto.
-  Qed.
-
-  Program Definition approx (n:nat) (p: (pred rmap)) : (pred rmap) :=
-    fun w => level w < n /\ p w.
-  Next Obligation. split. intros ??? [].
-  split.
-  apply age_level in H. lia.
-  apply pred_hereditary with a; auto.
-
-  intros ??? [].
-  split; [apply ext_level in H as <-; auto|].
-  apply pred_upclosed with a; auto.
-  Qed.
-
-  Lemma approx_K_approx: approx = K.approx.
-  Proof.
-    extensionality n p.
-    apply pred_ext'; intros w.
-    unfold approx, compose; simpl.
-    rewrite K.approx_spec.
-    unfold rmap_level, unsquash; simpl;
-    repeat rewrite K.knot_level;
-    repeat rewrite setset, setget;     intuition.
-  Qed.
-
-  Lemma unsquash_squash : forall n rm, (unsquash (squash (n,rm))) = (n,rmap_fmap (approx n) (approx n) rm).
-  Proof.
-    intros.
-    unfold unsquash, squash.
-    rewrite K.unsquash_squash. unfold K.KI.F, f_pre_rmap.
-    match goal with [|- (_,?X) = (_,?Y) ] =>
-      replace Y with X; auto
-    end.
-    match goal with [|- pre_rmap2rmap' ?X = _ ] =>
-      replace X with
-        (fmap f_pre_rmap (K.approx n) (K.approx n) (rmap'2pre_rmap rm))
-    end.
-    2: repeat rewrite <- fmap_comp.
-    2: unfold compose; auto.
-    destruct rm; simpl. unfold pre_rmap2rmap', rmap_fmap. simpl; f_equal.
-    extensionality l.
-    unfold compose.
-    destruct (r l); simpl; auto.
-    (* YES *)
-    destruct p; simpl.
-    rewrite approx_K_approx; auto.
-    (* PURE *)
-    destruct p; simpl.
-    rewrite approx_K_approx; auto.
-    (* ghost *)
-    induction g; auto; simpl.
-    setoid_rewrite IHg; destruct a as [[]|]; auto; simpl.
-    repeat f_equal.
-    rewrite approx_K_approx; destruct p; auto.
-  Qed.
-
-  #[global] Instance Join_nat_rmap': Join (nat * rmap') := Join_prod _ (Join_equiv nat) _ _.
-(*
-Lemma fmap_p2p'_inj:
-  forall p q,
-        fmap SM.preds K.predicate K.predicate (@pred rmap ag_rmap) p =
-        fmap SM.preds K.predicate K.predicate (@pred rmap ag_rmap) q ->
-        p=q.
-Proof.
-  intros.
-  destruct p as [p Vp]. destruct q as [q Vq].
-  unfold fmap in *. unfold f_preds in *. simpl in *.
-  inv H.
-  f_equal.
-  apply inj_pair2 in H2. unfold ffun_fmap, f_identity in *.
-  unfold fmap, compose in H2.
-  extensionality w.
- apply equal_f with w in H2. unfold fidentity_fmap in *.
-  unfold p2p' in *. inv H2.
-  unfold K.predicate in *.
-  apply pred_ext'. intros [k o]. destruct o.
-  apply equal_f with k in H0. rewrite H0; intuition.
-Qed.
-*)
-  Lemma g2ghost_inv: forall g1 g2, g2ghost g1 = g2ghost g2 -> g1 = g2.
-  Proof.
-    induction g1; destruct g2; inversion 1; auto.
-    f_equal; auto.
-    destruct a as [[]|], o as [[]|]; inv H1; auto.
-    destruct _f, _f0; inv H4; auto.
-  Qed.
-
-  Lemma join_unsquash : forall phi1 phi2 phi3,
-    join phi1 phi2 phi3 <->
-    join (unsquash phi1) (unsquash phi2) (unsquash phi3).
-  Proof.
-    intros.
-    unfold unsquash.
-    rewrite KSa.join_unsquash.
-    destruct (K.unsquash phi1) as [n f].
-    destruct (K.unsquash phi2) as [n0 f0].
-    destruct (K.unsquash phi3) as [n1 f1].
-    simpl; intuition.
-    destruct H; simpl in *; split; simpl; auto.
-    inversion H0.
-    constructor.
-    intro l; specialize ( H1 l).
-    simpl in *.
-    unfold compose.
-    destruct f, f0, f1; simpl in *.
-    inv H1; simpl.
-    constructor; auto.
-    destruct p. simpl in *. constructor; auto. destruct p. simpl in *. constructor; auto.
-    destruct p; simpl in *.
-    constructor; auto.
-    destruct p; simpl in *.
-    constructor; auto.
-
-    destruct f, f0, f1; simpl in *.
-    clear - H2; induction H2; constructor; auto.
-    inv H; constructor; auto.
-    destruct a0, a4, a5; inv H0; simpl in *.
-    inv H; inv H1; constructor; constructor; auto.
-
-    destruct H; simpl in *; split; simpl; auto.
-    inversion H0.
-    hnf in H1. simpl proj1_sig in H1.
-    constructor; auto.
-    intro l; specialize ( H1 l).
-    simpl proj1_sig.
-    clear - H1.
-    destruct f, f0, f1; simpl in *.
-    forget (r l) as a; forget (r0 l) as b; forget (r1 l) as c.
-    clear - H1.
-    unfold res2resource in *. unfold res_fmap in *.
-    destruct a as [ra | ra sha ka pa| ka pa]; try destruct pa as [? ?p];
-    destruct b as [rb | rb shb kb pb|kb pb]; try destruct pb as [? ?p];
-    destruct c as [rc | rc shc kc pc|kc pc]; try destruct pc as [? ?p];
-    inv H1.
-    + constructor; auto.
-    + apply inj_pair2 in H8. subst p0. constructor; auto.
-    + apply inj_pair2 in H8. subst p0. constructor; auto.
-    + subst. apply inj_pair2 in H11. subst p1. apply inj_pair2 in H7; subst p0.
-      constructor; auto.
-    + subst ; apply inj_pair2 in H8. subst p1. apply inj_pair2 in H5. subst p0.
-      constructor; auto.
-    + simpl in *.
-      destruct f, f0, f1; simpl in *.
-      clear - H2.
-      remember (g2ghost g) as a; remember (g2ghost g0) as b; remember (g2ghost g1) as c.
-      generalize dependent g1; generalize dependent g0; generalize dependent g; induction H2; intros; subst.
-      * apply g2ghost_inv in Heqc; subst; destruct g; [constructor | discriminate].
-      * apply g2ghost_inv in Heqc; subst; destruct g0; [constructor | discriminate].
-      * destruct g, g0, g1; inv Heqa; inv Heqb; inv Heqc.
-        constructor; [|apply IHghost_join; auto].
-        destruct o as [[]|], o0 as [[]|], o1 as [[]|]; inv H; try constructor.
-        -- destruct _f, _f0, _f1; inv H4; simpl in *.
-           inv H; inv H0.
-           inv H; inv H3.
-           repeat (match goal with H : existT _ _ _ = existT _ _ _ |- _ => apply inj_pair2 in H end;
-             subst); constructor; constructor; auto.
-        -- destruct _f, _f0; inv H4.
-           repeat (match goal with H : existT _ _ _ = existT _ _ _ |- _ => apply inj_pair2 in H end;
-             subst); constructor; auto.
-        -- destruct _f, _f0; inv H4.
-           repeat (match goal with H : existT _ _ _ = existT _ _ _ |- _ => apply inj_pair2 in H end;
-             subst); constructor; auto.
-  Qed.
-
-  Lemma ghost_of_core : forall phi, ghost_of (core phi) = core (ghost_of phi).
-  Proof.
-    intro; rewrite KSa.core_unsquash.
-    unfold ghost_of, KSa.K.unsquash, KSa.K.squash, unsquash, squash.
-    destruct (K.unsquash phi) eqn: Hunsquash; simpl.
-    pose proof (KL.unsquash_approx Hunsquash) as Happrox.
-    rewrite K.unsquash_squash; simpl.
-    pose proof (KA.approx_core n _f).
-    setoid_rewrite (pre_rmap_core _ _f).
-    setoid_rewrite pre_rmap_core in H.
-    destruct _f as [? g]; simpl in *.
-    inv H; inv Happrox. rewrite <- H3.
-    unfold g2ghost; setoid_rewrite <- H2.
-    rewrite <- H3.
-    rewrite !map_map; apply map_ext.
-    intros [(?, ?)|]; auto.
-  Qed.
-
-  Definition rmap_age1 (k:rmap) : option rmap :=
-    match unsquash k with
-    | (O,_) => None
-    | (S n,x) => Some (squash (n,x))
-    end.
-
-  Definition rmap_unage (k:rmap) : rmap :=
-    match unsquash k with
-    | (n,x) => squash (S n, x)
-    end.
-
-  Lemma rmap_age1_knot_age1 :
-    rmap_age1 = @age1 _ K.ageable_knot.
-  Proof.
-    extensionality x.
-    unfold rmap_age1.
-    rewrite  K.knot_age1.
-    unfold unsquash, squash.
-    case (K.unsquash x); simpl; intros.
-    destruct n; auto.
-    rewrite rmap'2pre_rmap2rmap'.
-    f_equal.
-  Qed.
-
-  Lemma rmap_age1_eq: @age1 _ ag_rmap = rmap_age1.
-  Proof.
-   unfold age1. unfold ag_rmap; simpl; auto.
-   rewrite rmap_age1_knot_age1; reflexivity.
-  Qed.
-
-  Lemma rmap_level_eq: @level rmap ag_rmap = fun x => fst (unsquash x).
-  Proof.
-    intros.
-   extensionality x.  unfold level.  unfold ag_rmap.
-   unfold KSa.K.ageable_knot. unfold unsquash.
-   rewrite K.knot_level. destruct (K.unsquash x); simpl. auto.
-  Qed.
-
-(*  Lemma unevolve_identity_rmap :
-   (* REMARK:  This may not be needed for anything, so for now it's removed
-     from the Module Type *)
-    forall w w':rmap, necR w w' -> identity w' -> identity w.
-  Proof.
-    intros.
-    induction H; eauto.
-    rewrite identity_unit_equiv in H0.
-    rewrite identity_unit_equiv.
-    red in H0. red.
-    rewrite join_unsquash in H0.
-    rewrite join_unsquash.
-    hnf in H. unfold rmap, ag_rmap in H. rewrite <- rmap_age1_knot_age1 in H.
-    unfold rmap_age1 in H.
-   destruct (unsquash x).
-   destruct n. inv H.
-    assert (y = squash (n,r)).
-    inv H; auto.
-    subst y.
-    rewrite unsquash_squash in H0.
-    destruct H0.
-    destruct H1.
-    split; auto.
-    split.
-    intro l; specialize ( H1 l).
-    destruct r.
-    simpl in *.
-    unfold compose in *.
-    destruct (fst x0 l); simpl in *.
-    constructor; auto.
-    inv H1; auto.
-    inv H1. constructor; auto.
-    constructor.
-    simpl in *.
-  Qed.*)
-
-  Lemma rmap_order : forall k1 k2, ext_order k1 k2 <->
-    level k1 = level k2 /\ resource_at k1 = resource_at k2 /\ join_sub (ghost_of k1) (ghost_of k2).
-  Proof.
-    intros; rewrite K.knot_order.
-    unfold resource_at, ghost_of, unsquash, K.KI.Rel.
-    destruct (K.unsquash k1) as (?, (?, ?)); simpl.
-    destruct (K.unsquash k2) as (?, (?, ?)); simpl.
-    unfold g2ghost, p2pred.
-    split; intros (? & Hr & ? & J); subst; split; auto; split; auto.
-    - induction J; try solve [eexists; constructor].
-      destruct IHJ; eexists (option_map _ a2 :: _); constructor; eauto.
-      inv H0; constructor.
-      destruct a0, a4, a5, H2 as (? & ? & ?); split; auto; simpl in *.
-      inv H0; constructor; auto.
-      subst; split; auto.
-    - extensionality l.
-      apply equal_f with l in Hr.
-      unfold res2resource in Hr.
-      destruct (_f l), (_f1 l); try destruct _f3; try destruct _f4; inv Hr; f_equal; try apply proof_irr.
-    - match goal with J : join ?a _ ?c |- _ => remember a as g1; remember c as g2 end.
-      generalize dependent _f0. generalize dependent _f2. induction J; intros; subst.
-      + destruct _f0; inv Heqg1; eexists; constructor.
-      + assert (_f2 = _f0); [|subst; eexists; constructor].
-        clear - Heqg1. generalize dependent _f2; induction _f0; intros; destruct _f2; inv Heqg1; auto.
-        f_equal; [|apply IH_f0; auto].
-        destruct o as [(?, (?, ?))|], a as [(?, (?, ?))|]; inv H0; auto.
-      + destruct _f0; inv Heqg1. destruct _f2; inv Heqg2.
-        destruct (IHJ _ eq_refl _ eq_refl).
-        assert (join_sub o o0) as []; [|eexists; constructor; eauto].
-        clear - H0. inv H0.
-        * destruct o; inv H1; eexists; constructor.
-        * destruct o as [(?, (?, ?))|], o0 as [(?, (?, ?))|]; inv H3; eexists; constructor.
-        * destruct o as [(?, (?, ?))|], o0 as [(?, (?, ?))|]; inv H; inv H1.
-          destruct a0, H3 as [J1 []]; simpl in *; subst.
-          inv H0.
-          inv J1.
-          eexists (Some (_, _)); do 3 (unshelve constructor); try apply H; eauto.
-        * inv H2; constructor.
-          destruct a1, a0, a3, H3 as (? & ? & ?); split; simpl in *; [|subst; split; auto].
-          inv H2; constructor; auto.
-  Qed.
-
-End Rmaps.
-Local Close Scope nat_scope.
diff --git a/veric/rmaps_lemmas.v b/veric/rmaps_lemmas.v
deleted file mode 100644
index 80f36c5dbb..0000000000
--- a/veric/rmaps_lemmas.v
+++ /dev/null
@@ -1,2122 +0,0 @@
-Require Import VST.msl.msl_standard.
-Require Import VST.msl.cjoins.
-Require Import VST.msl.Coqlib2.
-Require Import VST.msl.sepalg_list.
-Require Import VST.veric.shares.
-Require Import VST.veric.rmaps.
-
-Module Rmaps_Lemmas (R0: RMAPS).
-Module R := R0.
-Import R.
-
-Definition subp_sepcon_rmap := @subp_sepcon _ Join_rmap Perm_rmap Sep_rmap.
-Global Hint Resolve subp_sepcon_rmap : contractive.
-
- Lemma approx_p  : forall (p:pred rmap) n w, approx n p w -> p w.
- Proof. unfold approx; simpl; intuition. Qed.
-
- Lemma approx_lt : forall (p:pred rmap) n w, lt (level w) n -> p w -> approx n p w.
- Proof. unfold approx; simpl; intuition. Qed.
-
- Lemma approx_ge : forall p n w, ge (level w) n -> approx n p w -> False.
- Proof. unfold approx; intros. destruct H0; auto. lia. Qed.
-
-  Lemma ageN_level : forall n (phi1 phi2 : rmap),
-    ageN n phi1 = Some phi2 -> level phi1 = (n + (level phi2))%nat.
-  Proof.
-    unfold ageN; induction n; simpl; intros.
-    injection H; intros; subst; auto.
-    revert H.
-    repeat rewrite rmap_level_eq in *.
-    intros. invSome.
-    specialize (IHn _ _ H2).
-    apply  age_level in H.  rewrite rmap_level_eq in *. lia.
-  Qed.
-
-Lemma NO_identity: forall nsh, identity (NO Share.bot nsh).
-Proof.
-  unfold identity; intros.
-  inv H;
-  apply join_unit1_e in RJ; auto;   subst sh3; repeat proof_irr; auto.
-Qed.
-
-Lemma PURE_identity: forall k pds, identity (PURE k pds).
-Proof.
-  unfold identity; intros.
-  inv H; auto.
-Qed.
-
-Lemma identity_NO:
-  forall r, identity  r -> r = NO Share.bot bot_unreadable \/ exists k, exists pds, r = PURE k pds.
-Proof.
-  destruct r; auto; intros.
- * left.
-   apply identity_unit' in H. inv H.
-   apply identity_unit_equiv in RJ. apply identity_share_bot in RJ. subst.
-   f_equal. apply proof_irr.
- * apply identity_unit' in H. inv H.
-   apply unit_identity in RJ. apply identity_share_bot in RJ. subst.
-   contradiction bot_unreadable.
- * right. exists k. exists p. trivial.
-Qed.
-
-Lemma age1_resource_at_identity:
-  forall phi phi' loc, age1 phi = Some phi' ->
-               (identity (phi@loc) <-> identity (phi'@loc)).
-Proof.
- split; intro.
- (* FORWARD DIRECTION *)
-  generalize (identity_NO _ H0); clear H0; intro.
-  unfold resource_at in *.
-  rewrite rmap_age1_eq in *.
-  revert H H0; case_eq (unsquash phi); simpl; intros.
-  destruct n; inv H0.
-  rewrite unsquash_squash.
-  simpl.
-  destruct r. simpl in *.
-  unfold compose; simpl. destruct H1 as [H1 | [k [pds H1]]]; rewrite H1; simpl; auto.
-  apply NO_identity.
-  apply PURE_identity.
- (* BACKWARD DIRECTION *)
-  generalize (identity_NO _ H0); clear H0; intro.
-  unfold resource_at in *. simpl in H.
-  rewrite rmap_age1_eq in H.
-  revert H H0; case_eq (unsquash phi); simpl; intros.
-  destruct n; inv H0.
-  rewrite unsquash_squash in H1. simpl in *.
-  unfold compose in H1; simpl in H1.
-  unfold resource_fmap in H1.
-  destruct (fst r loc).
-  destruct H1. inv H0;   apply NO_identity. destruct H0 as [? [? H0]]; inv H0.
-  destruct H1 as [H1 | [k' [pds' H1]]]; inv H1.
-  apply PURE_identity.
-Qed.
-
-Lemma necR_resource_at_identity:
-  forall phi phi' loc, necR phi phi' ->
-         identity (phi@loc) ->
-         identity (phi'@loc).
-Proof.
-  induction 1; auto.
-  intro.
- apply -> (age1_resource_at_identity _ _ loc H); auto.
-Qed.
-
-Lemma make_rmap': forall f g, 
-          exists phi: rmap', phi = (f, g).
-Proof.
-  intros.
-  unfold rmap'. exists (f,g).
-  auto.
-Qed.
-
-
-Lemma make_rmap (f: AV.address -> resource) g
-    (n: nat) (H: resource_fmap (approx n) (approx n) oo f = f)
-    (HG: ghost_fmap (approx n) (approx n) g = g) :
-  {phi: rmap | level phi = n /\ resource_at phi = f /\ ghost_of phi = g}.
-Proof.
-intros.
-apply (exist _ (squash (n, (f, g)))).
-simpl level; rewrite rmap_level_eq in *; unfold resource_at, ghost_of. rewrite unsquash_squash.
-auto.
-Qed.
-
-Lemma make_rmap'':
-    forall n (f: AV.address -> resource) g,
-      exists phi:rmap, level phi = n /\ resource_at phi = resource_fmap (approx n) (approx n) oo f /\
-      ghost_of phi = ghost_fmap (approx n) (approx n) g.
-  Proof.
-    intros.
-    exists (squash (n, (f, g))).
-    rewrite rmap_level_eq.
-      unfold resource_at, ghost_of; rewrite unsquash_squash; simpl; split; auto.
-Qed.
-
-Lemma approx_oo_approx':
-  forall n n', (n' >= n)%nat -> approx n oo approx n' = approx n.
-Proof.
-unfold compose; intros.
-extensionality P.
- apply pred_ext; intros w ?; unfold approx; simpl in *; intuition lia.
-Qed.
-
-Lemma approx'_oo_approx:
-  forall n n', (n' >= n)%nat -> approx n' oo approx n = approx n.
-Proof.
-unfold compose; intros.
-extensionality P.
- apply pred_ext; intros w ?; unfold approx; simpl in *; intuition lia.
-Qed.
-
-Lemma approx_oo_approx: forall n, approx n oo approx n = approx n.
-Proof.
-intros; apply approx_oo_approx'; lia.
-Qed.
-
-Lemma preds_fmap_fmap:
-  forall f1 f2 g1 g2 pp, preds_fmap f1 f2 (preds_fmap g1 g2 pp) = preds_fmap (f1 oo g1) (g2 oo f2) pp.
-Proof.
-destruct pp; simpl; auto.
-f_equal; extensionality i.
-rewrite <- fmap_comp; auto.
-Qed.
-
-Lemma resources_same_level:
-   forall f phi,
-     (forall l : AV.address, join_sub (f l) (phi @ l)) ->
-        resource_fmap (approx (level phi)) (approx (level phi)) oo f = f.
-Proof.
-  intros.
-  rewrite rmap_level_eq.
-  unfold resource_fmap, resource_at in *.
-  unfold compose; extensionality l. specialize ( H l).
-  destruct H as [g ?].
-  revert H; case_eq (unsquash phi); intros n ? ?.
-  generalize H; rewrite <- (squash_unsquash phi).
-  rewrite H. rewrite unsquash_squash.
-  simpl; intros.
-  injection H0. clear H0. intro.
-  clear phi H.
-  rewrite <- H0 in H1.
-  clear H0.
-  unfold rmap_fmap in *.
-  simpl in *.
-  revert H1.
-  unfold resource_fmap, compose.
-  destruct (f l); destruct g; destruct (fst r l); simpl; intro; auto; inv H1;
-    rewrite preds_fmap_fmap, approx_oo_approx; auto.
-Qed.
-
-Lemma ghost_fmap_fmap:  forall f1 f2 g1 g2 r,
-  ghost_fmap f1 f2 (ghost_fmap g1 g2 r) = ghost_fmap (f1 oo g1) (g2 oo f2) r.
-Proof.
-  intros; rewrite <- ghost_fmap_comp; auto.
-Qed.
-
-Lemma ghost_same_level:
-   forall g phi, join_sub g (ghost_of phi) ->
-   ghost_fmap (approx (level phi)) (approx (level phi)) g = g.
-Proof.
-  intros.
-  rewrite rmap_level_eq.
-  unfold ghost_of in *.
-  revert H; case_eq (unsquash phi); intros n ? ?.
-  generalize H; rewrite <- (squash_unsquash phi).
-  rewrite H. rewrite unsquash_squash.
-  simpl; intros.
-  injection H0. clear H0. intro.
-  clear phi H.
-  rewrite <- H0 in H1.
-  clear H0.
-  unfold rmap_fmap in *.
-  destruct r.
-  simpl in H1; destruct H1.
-  remember (ghost_fmap (approx n) (approx n) g0) as g'.
-  generalize dependent g0; induction H; auto; intros; subst.
-  - rewrite ghost_fmap_fmap, approx_oo_approx; auto.
-  - destruct g0; inv Heqg'.
-    simpl; f_equal; eauto.
-    inv H; auto; simpl.
-    + destruct o as [[]|]; auto; simpl.
-      rewrite preds_fmap_fmap, approx_oo_approx; auto.
-    + destruct a0, a3, a4; inv H4; simpl in *.
-      destruct o as [[]|]; inv H1.
-      inv H2.
-      rewrite preds_fmap_fmap, approx_oo_approx; auto.
-Qed.
-
-Lemma deallocate:
-  forall (phi: rmap) (f g : AV.address -> resource) a b,
-  (forall l, join  (f l) (g l) (phi@l)) -> join a b (ghost_of phi) ->
-   exists phi1, exists phi2,
-     join phi1 phi2 phi /\ resource_at phi1 = f /\ ghost_of phi1 = a.
-Proof.
-  intros until b. intros H0 HG.
-  generalize (resources_same_level f phi); intro.
-  spec H. intro; econstructor; apply H0.
-  generalize (resources_same_level g phi); intro.
-  spec H1.
-  intro. econstructor; eapply join_comm; eauto.
-  generalize (ghost_same_level a phi); intro Ha.
-  spec Ha. eexists; eauto.
-  generalize (ghost_same_level b phi); intro Hb.
-  spec Hb. eexists; eauto.
-  generalize (make_rmap'' (level phi) f a); intros [phif [? [Gf Ga]]].
-  generalize (make_rmap'' (level phi) g b); intros [phig [? [Gg Gb]]].
-  exists phif; exists phig.
-  split; [|rewrite Ga, Gf; auto].
-  rewrite rmap_level_eq in *.
-  unfold resource_at, ghost_of in *.
-  revert H0 HG H Gf Ga H1 Gg Gb Ha Hb H2 H3;
-  case_eq (unsquash phif); intros nf phif' ?.
-  case_eq (unsquash phig); intros ng phig' ?.
-  case_eq (unsquash phi); intros n phi' ?.
-  simpl.
-  intros; subst nf ng.
-  rewrite join_unsquash.
-  rewrite H; rewrite H0.
-  revert H1; case_eq (unsquash phi); intros n' phi'' ?.
-  intros.
-  inversion H5.
-  simpl.
-  split.
-  simpl; constructor; auto.
-  subst n' phi''.
-  constructor.
-  intro l; specialize ( H2 l).
-  simpl.
-  rewrite Gf; rewrite Gg; clear Gf Gg.
-  rewrite H3; rewrite H4.
-  auto.
-  simpl; rewrite Ga, Gb; simpl.
-  rewrite Ha, Hb; auto.
-Qed.
-
-  Lemma unsquash_inj : forall x y,
-      unsquash x = unsquash y -> x = y.
-  Proof.
-    intros.
-    rewrite <- (squash_unsquash x).
-    rewrite <- (squash_unsquash y).
-    rewrite H; auto.
-  Qed.
-
-Lemma resource_fmap_fmap:  forall f1 f2 g1 g2 r, resource_fmap f1 f2 (resource_fmap g1 g2 r) =
-                                                                      resource_fmap (f1 oo g1) (g2 oo f2) r.
-Proof.
-destruct r; simpl; auto.
-rewrite preds_fmap_fmap; auto.
-rewrite preds_fmap_fmap; auto.
-Qed.
-
-Lemma ghost_of_approx:
-  forall phi,
-      ghost_fmap (approx (level phi)) (approx (level phi)) (ghost_of phi) = ghost_of phi.
-Proof.
-intros. symmetry. rewrite rmap_level_eq. unfold ghost_of.
-case_eq (unsquash phi); intros.
-simpl.
-set (phi' := (squash (n, (resource_fmap (approx n) (approx n) oo fst r, snd r)))).
-generalize (unsquash_inj phi phi'); intro.
-spec H0.
--
-replace (unsquash phi) with (unsquash (squash (unsquash phi))).
-2: rewrite squash_unsquash; auto.
-rewrite H.
-unfold phi'.
-repeat rewrite unsquash_squash.
-f_equal.
-unfold rmap_fmap. simpl.
-unfold compose.
-f_equal.
-extensionality y.
-rewrite resource_fmap_fmap.
-rewrite approx_oo_approx; auto.
--
-unfold phi' in *; clear phi'.
-subst.
-rewrite unsquash_squash in H.
-injection H; clear H; intro.
-pattern r at 1; rewrite <- H.
-auto.
-Qed.
-
-Lemma ghost_same_level_gen:
-   forall n a b c, join (ghost_fmap (approx n) (approx n) a) (ghost_fmap (approx n) (approx n) b) c ->
-   ghost_fmap (approx n) (approx n) c = c.
-Proof.
-  intros.
-  remember (ghost_fmap (approx n) (approx n) a) as a'; remember (ghost_fmap (approx n) (approx n) b) as b'.
-  generalize dependent b; generalize dependent a; induction H; intros; subst.
-  - rewrite ghost_fmap_fmap, approx_oo_approx; auto.
-  - rewrite ghost_fmap_fmap, approx_oo_approx; auto.
-  - destruct a, b; inv Heqa'; inv Heqb'.
-    simpl; f_equal; eauto.
-    inv H; simpl.
-    + destruct o0 as [[]|]; auto; simpl.
-      rewrite preds_fmap_fmap, approx_oo_approx; auto.
-    + destruct o as [[]|]; auto; simpl.
-      rewrite preds_fmap_fmap, approx_oo_approx; auto.
-    + destruct a1, a2, a0; inv H3; simpl in *.
-      destruct o as [[]|]; inv H1; inv H4.
-      rewrite preds_fmap_fmap, approx_oo_approx; auto.
-Qed.
-
-Lemma allocate:
-     forall (phi : rmap) (f : AV.address -> resource) a,
-        resource_fmap (approx (level phi)) (approx (level phi)) oo f = f ->
-       (forall l, {r' | join (phi@l) (f l) r'}) ->
-        ghost_fmap (approx (level phi)) (approx (level phi)) a = a ->
-        {a' | join (ghost_of phi) a a'} ->
-       exists phi1 : rmap,
-         exists phi2 : rmap,
-           join phi phi1 phi2 /\ resource_at phi1 = f /\ ghost_of phi1 = a.
-Proof.
- intros. rename H0 into Hg. rename X into H1.
- generalize (make_rmap'' (level phi) f a); intros [phif [? [Gf Ga]]].
- pose (g loc := proj1_sig (H1 loc)).
- assert (H3: forall l, join (phi @ l) (f l) (g l))
-   by (unfold g; intro; destruct (H1 l); simpl in *; auto).
- clearbody g.
- destruct X0 as [b X0].
- generalize (make_rmap'' (level phi) g b); intro.
- destruct H2 as [phig [H4 [H5 H6]]].
- rename H0 into H2.
- exists phif; exists phig.
- split; [|split; congruence].
- rewrite join_unsquash.
- unfold resource_at, ghost_of in *.
- rewrite rmap_level_eq in *.
- rename H into H0. pose proof I.
- revert H0 H1 Hg X0 H2 H3 H4 H5 H6 Gf Ga.
- case_eq (unsquash phif); intros nf phif' ?.
- case_eq (unsquash phig); intros ng phig' ?.
- case_eq (unsquash phi); intros n phi' ?.
- simpl.
- intros; subst nf ng.
- split. split; trivial.
- simpl.
- split.
- intro l.
- specialize ( H6 l).
- assert (fst phig' l = g l).
-   generalize (f_equal squash H2); intro.
-   rewrite squash_unsquash in H5.
-   subst phi.
-   rewrite unsquash_squash in H2.
-   injection H2; clear H2; intro.
-   rewrite <- H2 in H6.
-   rewrite <- H3 in H6.
-   rewrite H8.
-   clear - H6.
-   revert H6.
-   unfold rmap_fmap, compose, resource_fmap. simpl.
-   destruct (fst phi' l); destruct (f l); destruct (g l); simpl; intros; auto; try inv H6;
-              try change (preds_fmap (approx n) (approx n) (preds_fmap (approx n) (approx n) p0)) with
-                ((preds_fmap (approx n) (approx n) oo preds_fmap (approx n) (approx n)) p0);
-              try change (preds_fmap (approx n) (approx n) (preds_fmap (approx n) (approx n) p)) with
-                ((preds_fmap (approx n) (approx n) oo preds_fmap (approx n) (approx n)) p);
-                rewrite preds_fmap_comp; rewrite approx_oo_approx; auto.
- rewrite H5.
- rewrite Gf.
- rewrite H3.
- auto.
-
-  erewrite Ga, H9, Hg, ghost_same_level_gen; auto.
-  rewrite <- Hg in X0.
-  pose proof (ghost_of_approx phi) as X.
-  unfold ghost_of in X.
-  rewrite rmap_level_eq, H2 in X; simpl in X.
-  rewrite X; eauto.
-Qed.
-
-  Lemma rmap_ext: forall phi1 phi2,
-    level phi1 = level phi2 ->
-    (forall l, phi1@l = phi2@l) ->
-    ghost_of phi1 = ghost_of phi2 ->
-    phi1=phi2.
-  Proof.
-    intros.
-    apply unsquash_inj.
-    rewrite rmap_level_eq in *.
-    unfold resource_at, ghost_of in *.
-    rewrite <- (squash_unsquash phi1).
-    rewrite <- (squash_unsquash phi2).
-    destruct (unsquash phi1).
-    destruct (unsquash phi2).
-    simpl in H.
-    rewrite H.
-    rewrite unsquash_squash.
-    rewrite unsquash_squash.
-    simpl in H0, H1.
-    replace (rmap_fmap (approx n0) (approx n0) r) with (rmap_fmap (approx n0) (approx n0) r0); auto.
-    simpl in *. unfold rmap_fmap.
-    replace (resource_fmap (approx n0) (approx n0) oo fst r0)
-      with (resource_fmap (approx n0) (approx n0) oo fst r).
-    destruct r,r0; simpl in *; subst; auto.
-    extensionality l.
-    unfold compose.
-    specialize ( H0 l).
-    subst n0.
-    rewrite H0; auto.
-  Qed.
-
-  Lemma resource_at_join:
-    forall phi1 phi2 phi3 loc,
-      join phi1 phi2 phi3 ->
-      join (phi1@loc) (phi2@loc) (phi3@loc).
-  Proof.
-    intros.
-    revert H; rewrite join_unsquash; unfold resource_at.
-    intros [? ?].
-    apply H0.
-  Qed.
-
-  Lemma ghost_of_join:
-    forall phi1 phi2 phi3,
-      join phi1 phi2 phi3 ->
-      join (ghost_of phi1) (ghost_of phi2) (ghost_of phi3).
-  Proof.
-    intros.
-    revert H; rewrite join_unsquash; unfold resource_at.
-    intros [? ?].
-    apply H0.
-  Qed.
-
-  Lemma resource_at_join2:
-    forall phi1 phi2 phi3,
-      level phi1 = level phi3 -> level phi2 = level phi3 ->
-      (forall loc, join (phi1@loc) (phi2@loc) (phi3@loc)) ->
-      join (ghost_of phi1) (ghost_of phi2) (ghost_of phi3) ->
-      join phi1 phi2 phi3.
-  Proof.
-    intros ? ? ?.
-    rewrite join_unsquash.
-    rewrite rmap_level_eq in *.
-    unfold resource_at, ghost_of.
-    case_eq (unsquash phi1); case_eq (unsquash phi2); case_eq (unsquash phi3); simpl; intros.
-    subst.
-    split; auto.
-    split; auto.
-  Qed.
-
-Lemma all_resource_at_identity:
-  forall w, (forall l, identity (w@l)) -> identity (ghost_of w) ->
-         identity w.
-Proof.
-  repeat intro.
-  apply rmap_ext.
-  { apply join_level in H1; tauto. }
-  intro l; specialize (H l).
-  apply (resource_at_join _ _ _ l), H in H1; auto.
-  apply H0, ghost_of_join; auto.
-Qed.
-
-  Lemma ageN_squash : forall d n rm, Peano.le d n ->
-    ageN d (squash (n, rm)) = Some (squash ((n - d)%nat, rm)).
-  Proof.
-    induction d; simpl; intros.
-    unfold ageN; simpl.
-    replace (n-0)%nat with n by lia; auto.
-    unfold ageN; simpl.
-    rewrite rmap_age1_eq in *.
-    rewrite unsquash_squash.
-    destruct n.
-    inv H.
-    replace (S n - S d)%nat with (n - d)%nat by lia.
-    unfold ageN in IHd. rewrite rmap_age1_eq in IHd.
-    rewrite IHd.
-    2: lia.
-    f_equal.
-    apply unsquash_inj.
-    rewrite !unsquash_squash.
-    f_equal.
-    change (rmap_fmap (approx (n - d)) (approx (n - d))
-             (rmap_fmap (approx (S n)) (approx (S n)) rm)) with
-           ((rmap_fmap (approx (n - d)) (approx (n - d)) oo
-              rmap_fmap (approx (S n)) (approx (S n))) rm).
-    rewrite rmap_fmap_comp.
-    f_equal.
-    + clear.
-      assert (n-d <= (S n))%nat by lia.
-      revert H; generalize (n-d)%nat (S n).
-      clear.
-      intros.
-      extensionality p.
-      apply pred_ext'.  extensionality w.
-      unfold compose, approx.
-      apply prop_ext; simpl; intuition lia.
-    + clear.
-      assert (n-d <= (S n))%nat by lia.
-      revert H; generalize (n-d)%nat (S n).
-      clear.
-      intros.
-      extensionality p.
-      apply pred_ext'.  extensionality w.
-      unfold compose, approx.
-      apply prop_ext; simpl; intuition lia.
-  Qed.
-
-  Lemma unageN: forall n (phi': rmap),   exists phi, ageN n phi = Some phi'.
-  Proof.
-    intros n phi'.
-    rewrite <- (squash_unsquash phi').
-    destruct (unsquash phi'); clear phi'.
-    exists (squash ((n+n0)%nat,r)).
-    rewrite ageN_squash.
-    replace (n + n0 - n)%nat with n0 by lia; auto.
-    lia.
-  Qed.
-
-  Lemma ex_level0: exists phi, age1 phi = None.
-  Proof.
-    set (g := nil: ghost).
-    set (m := (fun _ : AV.address => NO emptyshare nonreadable_emptyshare): AV.address -> resource).
-    set (r := (m, g): rmap').
-    exists (squash (0%nat, r)).
-    rewrite rmap_age1_eq.
-    rewrite unsquash_squash.
-    auto.
-  Qed.
-
-  Lemma ex_level: forall n, exists phi, level phi = n.
-  Proof.
-    intros.
-    destruct ex_level0 as [phi ?].
-    rewrite age1_level0 in H.
-    destruct (unageN n phi) as [phi' ?].
-    exists phi'.
-    apply ageN_level in H0.
-    lia.
-  Qed.
-
-Lemma YES_join_full: 
-   forall sh rsh n P r2 r3,
-       join (R.YES sh rsh n P) r2 r3 ->
-       writable0_share sh ->
-       exists sh2 rsh2, r2 = NO sh2 rsh2.
-Proof.
-  intros.
-  inv H. eauto.
-  exfalso; clear - RJ H0 rsh2.
-  destruct RJ.
-  destruct H0. destruct H0. destruct rsh2. subst sh sh3.
-  rewrite Share.glb_commute, Share.distrib1 in H.
-  rewrite Share.glb_commute.
-  apply lub_bot_e in H. destruct H. rewrite H. apply bot_identity.
-Qed.
-
-
-Lemma YES_not_identity:
-  forall sh rsh k Q, ~ identity (YES sh rsh k Q).
-Proof.
-intros. intro.
-apply identity_unit' in H.
-unfold unit_for in H.
-inv H.
-apply share_self_join_bot in RJ; subst.
-apply bot_unreadable in rsh. auto.
-Qed.
-
-Lemma YES_overlap:
-forall sh0 rsh0 sh1 rsh1 (phi0 phi1: rmap) loc k k' p p',
-  joins phi0 phi1 ->
-  phi1@loc = R.YES sh1 rsh1 k p -> 
-  writable0_share sh1 ->
-  phi0@loc = R.YES sh0 rsh0 k' p' ->
-  False.
-Proof.
-  intros.
-  destruct H as [phi3 ?].
-  generalize (resource_at_join _ _ _ loc H); intro.
-  rewrite H2 in H3.
-  rewrite H0 in H3.
-  apply join_comm in H3.
-  apply YES_join_full in H3; auto.
-  destruct H3 as [? [? H3]]. inv H3.
-Qed.
-
-Lemma necR_NOx:
-   forall phi phi' l sh nsh, 
-      necR phi phi' -> 
-      phi@l = NO sh nsh -> 
-      phi'@l = NO sh nsh.
-Proof.
-induction 1; eauto.
-unfold age in H; simpl in H.
-revert H; rewrite rmap_age1_eq; unfold resource_at.
-destruct (unsquash x).
-intros; destruct n; inv H.
-rewrite unsquash_squash; simpl in *; auto.
-destruct r; simpl in *.
-unfold compose.
-rewrite H0.
-auto.
-Qed.
-
-Ltac do_map_arg :=
-match goal with |- ?a = ?b =>
-  match a with context [map ?x _] =>
-    match b with context [map ?y _] => replace y with x; auto end end end.
-
-Lemma resource_at_approx:
-  forall phi l,
-      resource_fmap (approx (level phi)) (approx (level phi)) (phi @ l) = phi @ l.
-Proof.
-intros. symmetry. rewrite rmap_level_eq. unfold resource_at.
-case_eq (unsquash phi); intros.
-simpl.
-set (phi' := (squash (n, (resource_fmap (approx n) (approx n) oo fst r, snd r)))).
-pose proof I.
-generalize (unsquash_inj phi phi'); intro.
-spec H1.
-replace (unsquash phi) with (unsquash (squash (unsquash phi))).
-2: rewrite squash_unsquash; auto.
-rewrite H.
-unfold phi'.
-repeat rewrite unsquash_squash.
-simpl.
-f_equal.
-unfold rmap_fmap, compose; simpl.
-f_equal.
-extensionality y.
-rewrite resource_fmap_fmap.
-rewrite approx_oo_approx; auto.
-unfold phi' in *; clear phi'.
-subst.
-rewrite unsquash_squash in H.
-injection H; clear H; intro.
-pattern r at 1; rewrite <- H.
-unfold rmap_fmap, compose.
-simpl; rewrite resource_fmap_fmap.
-rewrite approx_oo_approx; auto.
-Qed.
-
-Lemma necR_resource_at:
-  forall phi phi' loc r,
-        necR phi phi' ->
-         phi @ loc = resource_fmap (approx (level phi)) (approx (level phi)) r ->
-         phi' @ loc = resource_fmap (approx (level phi')) (approx (level phi')) r.
-Proof.
-intros.
-revert r loc H0; induction H; intros; auto.
-unfold age in H.
-simpl in H.
-revert H H0; rewrite rmap_level_eq, rmap_age1_eq; unfold resource_at.
- case_eq (unsquash x); intros.
-destruct n; inv H0.
-simpl in *.
-rewrite unsquash_squash; simpl.
-destruct r0; simpl in *.
-unfold compose in *.
-rewrite H1; clear H1.
-rewrite resource_fmap_fmap.
-rewrite approx_oo_approx'; auto.
-rewrite approx'_oo_approx; auto.
-Qed.
-
-Lemma necR_YES:
-  forall phi phi' loc rsh sh k pp,
-        necR phi phi' ->
-         phi @ loc = YES rsh sh k pp ->
-         phi' @ loc = YES rsh sh k (preds_fmap (approx (level phi')) (approx (level phi')) pp).
-Proof.
-intros.
-generalize (eq_sym (resource_at_approx phi loc));
-pattern (phi @ loc) at 2; rewrite H0; intro.
-apply (necR_resource_at _ _ _ _ H H1).
-Qed.
-
-Lemma necR_PURE:
-  forall phi phi' loc k pp,
-        necR phi phi' ->
-         phi @ loc = PURE k pp ->
-         phi' @ loc = PURE k (preds_fmap (approx (level phi')) (approx (level phi')) pp).
-Proof.
-  intros.
-  generalize (eq_sym (resource_at_approx phi loc));
-  pattern (phi @ loc) at 2; rewrite H0; intro.
-  apply (necR_resource_at _ _ _ _ H H1).
-Qed.
-
-Lemma necR_NO:
-   forall phi phi' l sh nsh, necR phi phi' -> 
-   (phi@l = NO sh nsh <-> phi'@l = NO sh nsh).
-Proof.
-  intros; split.
-  apply necR_NOx; auto.
-  intros.
-  case_eq (phi @ l); intros; auto.
-  generalize (necR_NOx _ _ l _ _ H H1); intro. congruence.
-  generalize (necR_YES _ _ _ _ _ _ _ H H1); congruence.
-  generalize (necR_PURE _ _ _ _ _ H H1); congruence.
-Qed.
-
-Lemma resource_at_empty: forall phi, 
-     identity phi ->
-     forall l, phi @ l = NO Share.bot bot_unreadable \/ exists k, exists pds, phi @ l = PURE k pds.
-Proof.
-  intros.
-  apply identity_unit' in H.
-  unfold unit_for in H.
-  generalize (resource_at_join _ _ _ l H); intro.
-  remember (phi @ l) as r.
-  destruct r; inv H0; eauto.
-  left. clear - RJ.
-  apply identity_unit_equiv in RJ; apply identity_share_bot in RJ; subst.
-  f_equal. apply proof_irr.
-  clear - r RJ.
-  apply share_self_join_bot in RJ. subst.
-  contradiction (bot_unreadable r).
-Qed.
-Arguments resource_at_empty [phi] _ _.
-
-Ltac inj_pair_tac :=
- match goal with H: (@existT ?U ?P ?p ?x = @existT _ _ _ ?y) |- _ =>
-   generalize (@inj_pair2 U P p x y H); clear H; intro; try (subst x || subst y)
- end.
-
-Lemma preds_fmap_NoneP:
-  forall f1 f2, preds_fmap f1 f2 NoneP = NoneP.
-Proof.
-intros.
-unfold NoneP.
-auto.
-Qed.
-
-Lemma necR_YES':
-   forall phi phi' loc rsh sh k,
-         necR phi phi' -> (phi@loc = YES rsh sh k NoneP <-> phi'@loc = YES rsh sh k NoneP).
-Proof.
-intros.
-induction H.
-rename x into phi; rename y into phi'.
-unfold age in H; simpl in H.
-(* revert H; case_eq (age1 phi); intros; try discriminate. *)
-inv H.
-split; intros.
-rewrite (necR_YES phi phi' loc rsh sh k NoneP); auto. constructor 1; auto.
-rewrite rmap_age1_eq in *.
-unfold resource_at in *.
-revert H1; case_eq (unsquash phi); simpl; intros.
-destruct n; inv H1.
-rewrite unsquash_squash in H. simpl in H.
-unfold compose in H.
-revert H; destruct (fst r loc); simpl; intros; auto.
-destruct p; inv H.
-inj_pair_tac. f_equal. apply proof_irr.
-unfold NoneP; f_equal.
-auto.
-inv H.
-intuition.
-intuition.
-Qed.
-
-Lemma necR_YES'':
-   forall phi phi' loc rsh sh k,
-         necR phi phi' ->
-    ((exists pp, phi@loc = YES rsh sh k pp) <->
-    (exists pp, phi'@loc = YES rsh sh k pp)).
-Proof.
-intros.
-induction H; try solve [intuition].
-rename x into phi; rename y into phi'.
-revert H; unfold age; case_eq (age1 phi); intros; try discriminate.
-inv H0.
-simpl in *.
-split; intros [pp ?].
-+ econstructor;
-  apply (necR_YES phi phi' loc rsh sh k pp).
-  constructor 1; auto. auto.
-+ rename phi' into r.
-  rewrite rmap_age1_eq in *.
-  unfold resource_at in *.
-  revert H; case_eq (unsquash phi); simpl; intros.
-  destruct n; inv H1.
-  rewrite unsquash_squash in H0. simpl in H0.
-  unfold compose in H0.
-  revert H0; destruct (fst r0 loc); simpl; intros; inv H0.
-  econstructor; proof_irr; eauto.
-Qed.
-
-Lemma necR_PURE':
-   forall phi phi' loc k,
-         necR phi phi' ->
-    ((exists pp, phi@loc = PURE k pp) <->
-    (exists pp, phi'@loc = PURE k pp)).
-Proof.
-intros.
-induction H; try solve [intuition].
-rename x into phi; rename y into phi'.
-revert H; unfold age; case_eq (age1 phi); intros; try discriminate.
-inv H0.
-simpl in *.
-split; intros [pp ?].
-+ econstructor;
-  apply (necR_PURE phi phi' loc k pp).
-  constructor 1; auto. auto.
-+ rename phi' into r.
-  rewrite rmap_age1_eq in *.
-  unfold resource_at in *.
-  revert H; case_eq (unsquash phi); simpl; intros.
-  destruct n; inv H1.
-  rewrite unsquash_squash in H0. simpl in H0.
-  unfold compose in H0.
-  revert H0; destruct (fst r0 loc); simpl; intros; inv H0.
-  eauto.
-Qed.
-
-
-Lemma resource_at_join_sub:
-  forall phi1 phi2 l,
-       join_sub phi1 phi2 -> join_sub (phi1@l) (phi2@l).
-Proof.
-intros.
-destruct H as [phi ?].
-generalize (resource_at_join _ _ _ l H); intro.
-econstructor; eauto.
-Qed.
-
-Lemma age1_res_option: forall phi phi' loc,
-     age1 phi = Some phi' -> res_option (phi @ loc) = res_option (phi' @ loc).
-  Proof.
-    unfold res_option, resource_at; simpl.
-   rewrite rmap_age1_eq; intros phi1 phi2 l.
- case_eq (unsquash phi1); intros. destruct n; inv H0.
- rewrite unsquash_squash.
-   destruct r;
-    simpl.
-   unfold compose. destruct (r l); simpl; auto.
-Qed.
-
-Lemma necR_res_option:
-  forall (phi phi' : rmap) (loc : AV.address),
-  necR phi phi' -> res_option (phi @ loc) = res_option (phi' @ loc).
-Proof.
-  intros.
-  case_eq (phi @ loc); intros.
-  rewrite (necR_NO _ _ _ _ n H) in H0. congruence.
-  destruct p.
-  rewrite (necR_YES phi phi' loc _ _ _ _ H H0); auto.
-  rewrite (necR_PURE phi phi' loc _ _ H H0); auto.
-Qed.
-
-
-Lemma age1_resource_at:
-     forall phi phi',
-          age1 phi = Some phi' ->
-         forall loc r,
-          phi @ loc = resource_fmap (approx (level phi)) (approx (level phi)) r ->
-          phi' @ loc = resource_fmap (approx (level phi')) (approx (level phi')) r.
-Proof.
-   unfold resource_at; rewrite rmap_age1_eq, rmap_level_eq.
-intros until phi'; case_eq (unsquash phi); intros.
-simpl in *.
-destruct n; inv H0.
-rewrite unsquash_squash.
-destruct r; simpl in *.
-unfold compose; rewrite H1.
-rewrite resource_fmap_fmap.
-rewrite approx_oo_approx'; auto.
-rewrite approx'_oo_approx; auto.
-Qed.
-
-
-Lemma age1_ghost_of:
-     forall phi phi',
-          age1 phi = Some phi' ->
-          ghost_of phi' = ghost_fmap (approx (level phi')) (approx (level phi')) (ghost_of phi).
-Proof.
-unfold ghost_of; rewrite rmap_age1_eq, rmap_level_eq.
-intros until phi'; case_eq (unsquash phi); intros.
-simpl in *.
-destruct n; inv H0.
-rewrite unsquash_squash.
-destruct r; auto.
-Qed.
-
-Lemma ghost_fmap_join: forall a b c f g, join a b c ->
-  join (ghost_fmap f g a) (ghost_fmap f g b) (ghost_fmap f g c).
-Proof.
-  induction 1; constructor; auto.
-  inv H; constructor; auto.
-  destruct a0, a4, a5; inv H1; constructor; auto.
-  simpl in *; inv H2; constructor; auto.
-Qed.
-
-Lemma identity_resource: forall r: resource, identity r <->
-    match r with YES _ _ _ _ => False | NO sh rsh => identity sh | PURE _ _ => True end.
-Proof.
- intros. destruct r.
- - split; intro.
-   + apply identity_unit' in H. inv H; auto. apply identity_unit_equiv; auto.
-   + repeat intro.
-     inv H0.
-     * apply H in RJ; subst.
-       f_equal; apply proof_irr.
-     * apply H in RJ; subst.
-       f_equal; apply proof_irr.
- - intuition.
-   specialize (H (NO Share.bot bot_unreadable) (YES sh r k p)).
-   spec H. constructor. apply join_unit2; auto. inv H.
- - intuition. intros  ? ? ?. inv H0. auto.
-Qed.
-
-Lemma resource_at_core_identity:  forall m i, identity (core m @ i).
-Proof.
-  intros.
-  generalize (core_duplicable m); intro Hdup. apply (resource_at_join _ _ _ i) in Hdup.
-  apply identity_resource.
-  case_eq (core m @ i); intros; auto.
-  rewrite H in Hdup. inv Hdup. apply identity_unit_equiv; auto.
-  rewrite H in Hdup. inv Hdup.
-  clear - r RJ.
-  apply unit_identity in RJ. apply identity_share_bot in RJ.
-  subst. apply bot_unreadable in r. auto.
-Qed.
-
-Lemma core_resource_at: forall w i, core (w @ i) = core w @ i.
-Proof.
- intros.
- replace (core w @ i) with (core (core w @ i)).
- pose proof (core_unit (w @ i)) as H1.
- pose proof (core_unit w) as H2.
- apply (resource_at_join _ _ _ i) in H2.
- unfold unit_for in *.
- rewrite <- core_idem.
- destruct (join_assoc (join_comm H1) (join_comm H2)) as [? [? ?]].
- eapply join_core2; eauto.
- symmetry; apply identity_core, resource_at_core_identity.
-Qed.
-
-Lemma core_ghost_of: forall w, core (ghost_of w) = ghost_of (core w).
-Proof.
- symmetry; apply ghost_of_core.
-Qed.
-
-Lemma ghost_join_reconstruct : forall phi a b,
-  join (ghost_of phi) a b ->
-  exists phia phib, ghost_of phia = ghost_fmap (approx (level phi)) (approx (level phi)) a /\
-    ghost_of phib = ghost_fmap (approx (level phi)) (approx (level phi)) b /\
-    join phi phia phib.
-Proof.
-  intros.
-  destruct (make_rmap (resource_at (core phi)) (ghost_fmap (approx (level phi)) (approx (level phi)) a) (level phi)) as (phia & ? & Hra & Hga).
-  { unfold compose. extensionality x. rewrite <- level_core. apply resource_at_approx. }
-  { rewrite ghost_fmap_fmap, approx_oo_approx. reflexivity. }
-  destruct (make_rmap (resource_at phi) (ghost_fmap (approx (level phi)) (approx (level phi)) b) (level phi)) as (phib & ? & Hrb & Hgb).
-  { unfold compose. extensionality x. apply resource_at_approx. }
-  { rewrite ghost_fmap_fmap, approx_oo_approx. reflexivity. }
-  exists phia, phib. repeat split; auto.
-  apply resource_at_join2; auto.
-  - congruence.
-  - intros; rewrite Hra, Hrb, <- core_resource_at. apply join_comm, core_unit.
-  - rewrite Hga, Hgb, <- ghost_of_approx. apply ghost_fmap_join, H.
-Qed.
-
-Lemma ghost_identity1 : identity(t := ghost) nil.
-Proof.
-  intros ???.
-  inv H; auto.
-Qed.
-
-Lemma ghost_identity : forall g : ghost, identity g <-> g = nil.
-Proof.
-  split.
-  - intros H. symmetry; apply H. constructor.
-  - intros; subst.
-    intros ???.
-    inv H; auto.
-Qed.
-
-Lemma age1_ghost_of_identity:
-  forall phi phi', age1 phi = Some phi' ->
-               (identity (ghost_of phi) <-> identity (ghost_of phi')).
-Proof.
- intros.
- rewrite !ghost_identity.
- rewrite (age1_ghost_of _ _ H).
- destruct (ghost_of phi); split; auto; discriminate.
-Qed.
-
-Lemma age1_YES: forall phi phi' l rsh sh k ,
-  age1 phi = Some phi' -> (phi @ l = YES rsh sh k NoneP <-> phi' @ l = YES rsh sh k NoneP).
-Proof.
-intros.
-apply necR_YES'.
-constructor 1; auto.
-Qed.
-
-Lemma age1_YES': forall phi phi' l rsh sh k ,
-  age1 phi = Some phi' -> ((exists P, phi @ l = YES rsh sh k P) <-> exists P, phi' @ l = YES rsh sh k P).
-Proof.
-intros.
-apply necR_YES''.
-constructor 1; auto.
-Qed.
-
-Lemma age1_NO: forall phi phi' l sh nsh,
-  age1 phi = Some phi' -> (phi @ l = NO sh nsh <-> phi' @ l = NO sh nsh).
-Proof.
-intros.
-apply necR_NO.
-constructor 1; auto.
-Qed.
-
-Lemma age1_PURE: forall phi phi' l k ,
-  age1 phi = Some phi' -> ((exists P, phi @ l = PURE k P) <-> exists P, phi' @ l = PURE k P).
-Proof.
-  intros.
-  apply necR_PURE'.
-  constructor 1; auto.
-Qed.
-
-Lemma necR_ghost_of:
-  forall phi phi',
-        necR phi phi' ->
-         ghost_of phi' = ghost_fmap (approx (level phi')) (approx (level phi')) (ghost_of phi).
-Proof.
-  induction 1.
-  - apply age1_ghost_of; auto.
-  - symmetry; apply ghost_of_approx.
-  - rewrite IHclos_refl_trans2, IHclos_refl_trans1, ghost_fmap_fmap.
-    apply necR_level in H0.
-    rewrite approx_oo_approx', approx'_oo_approx; auto.
-Qed.
-
-Lemma empty_NO: forall r, identity r -> r = NO Share.bot bot_unreadable \/ exists k, exists pds, r = PURE k pds.
-Proof.
-intros.
-destruct r; auto.
-left. f_equal. apply identity_unit' in H. inv H.
-  apply identity_unit_equiv in RJ. apply identity_share_bot in RJ. subst.
- f_equal. apply proof_irr.
-unfold identity in H.
-specialize ( H (NO Share.bot bot_unreadable) (YES sh r k p)).
-spec H.
-apply res_join_NO2.
-auto.
-inv H.
-right. exists k. exists p. trivial.
-Qed.
-
-Lemma level_age_fash:
-  forall m m': rmap, level m = S (level m') -> exists m1, age m m1.
-Proof.
-  intros.
-  case_eq (age1 m); intros.
-  exists r. auto.
-  exfalso.
-  eapply age1None_levelS_absurd in H0; eauto.
-Qed.
-
-Lemma level_later_fash:
- forall m m': rmap, (level m > level m')%nat  -> exists m1, laterR m m1 /\ level m1 = level m'.
-Proof.
-  intros.
-  assert (exists k, level m = S k + level m')%nat.
-    exists (level m - S (level m'))%nat.
-    lia.
-  clear H; destruct H0 as [k ?].
-  revert m H; induction k; intros.
-  simpl in H.
-  destruct (level_age_fash _ _ H) as [m1 ?].
-  exists m1; split; auto.
-  constructor 1; auto.
-  apply age_level in H0. rewrite H in H0. inv H0. trivial.
-  case_eq (age1 m); intros.
-  specialize ( IHk r).
-  rewrite <- ageN1 in H0.
-  generalize (ageN_level _ _ _ H0); intro.
-  spec IHk; try lia.
-  destruct IHk as [m1 [? ?]].
-  exists m1; split; auto.
-  econstructor 2; eauto.
-  rewrite ageN1 in H0.
-  constructor 1.
-  auto.
-  exfalso.
-  eapply age1None_levelS_absurd in H0; eauto.
-Qed.
-
-Lemma resource_at_constructive_joins2:
-  forall phi1 phi2,
-       level phi1 = level phi2 ->
-       (forall loc, constructive_joins (phi1 @ loc) (phi2 @ loc)) ->
-       constructive_joins (ghost_of phi1) (ghost_of phi2) ->
-         constructive_joins phi1 phi2.
-Proof.
-intros ? ? ? H0 Hg.
-pose proof I.
-destruct Hg.
-destruct (make_rmap (fun loc => proj1_sig (H0 loc)) x (level phi1)) as [phi' [? [? ?]]].
-clear H1.
-unfold compose; extensionality loc.
-(*specialize ( H0 loc). *)
-destruct (H0 loc) as [? H1]. clear H0.
-simpl.
-symmetry.
-revert H1; case_eq (phi1 @ loc); intros.
-inv H1. reflexivity.
-pose proof (resource_at_approx phi2 loc). rewrite <- H4 in H1. simpl in H1.
-injection H1; intros.
-simpl; f_equal; auto. rewrite H; auto.
-inv H1.
-pose proof (resource_at_approx phi1 loc). rewrite H0 in H1. simpl in H1.
-injection H1; intros.
-simpl; f_equal; auto.
-simpl; f_equal.
-pose proof (resource_at_approx phi1 loc). rewrite H0 in H1. simpl in H1.
-injection H1; intros; auto.
-inv H1.
-simpl; f_equal.
-pose proof (resource_at_approx phi1 loc). rewrite H0 in H1. simpl in H1.
-injection H1; intros; auto.
-eapply ghost_same_level_gen.
-rewrite ghost_of_approx, H, ghost_of_approx; auto.
-(*  End of make_rmap proof *)
-exists phi'.
-apply resource_at_join2; auto.
-congruence.
-intros.
-rewrite H3.
-destruct (H0 loc).
-simpl; auto.
-rewrite H4; auto.
-Qed.
-
-Lemma resource_at_joins2:
-  forall phi1 phi2,
-       level phi1 = level phi2 ->
-       (forall loc, constructive_joins (phi1 @ loc) (phi2 @ loc)) ->
-       constructive_joins (ghost_of phi1) (ghost_of phi2) ->
-         joins phi1 phi2.
-Proof.
-  intros.
-  apply cjoins_joins.
-  apply resource_at_constructive_joins2; trivial.
-Qed.
-
-Definition no_preds (r: resource) :=
-   match r with NO _ _ => True | YES _ _ _ pp => pp=NoneP | PURE _ pp => pp=NoneP end.
-
-Lemma remake_rmap:
-  forall (f: AV.address -> resource) g,
-       forall n,
-       (forall l, (exists m, level m = n /\ f l = m @ l) \/ no_preds (f l)) ->
-       ghost_fmap (approx n) (approx n) g = g ->
-       {phi: rmap | level phi = n /\ resource_at phi = f /\ ghost_of phi = g}.
-Proof.
-  intros.
-  apply make_rmap; auto.
-  extensionality l.
-  unfold compose.
-  destruct (H l); clear H.
-  destruct H1 as [m [?  ?]].
-  rewrite H1.
-  subst.
-  apply resource_at_approx.
-  destruct (f l); simpl in *; auto.
-  subst p; reflexivity.
-  subst p; reflexivity.
-Qed.
-
-Lemma rmap_unage_age:
-  forall r, age (rmap_unage r) r.
-Proof.
-intros; unfold age, rmap_unage; simpl.
-case_eq (unsquash r); intros.
-rewrite rmap_age1_eq.
-rewrite unsquash_squash.
-f_equal.
-apply unsquash_inj.
-rewrite H.
-rewrite unsquash_squash.
-f_equal.
-generalize (equal_f (rmap_fmap_comp (approx (S n)) (approx (S n)) (approx n) (approx n)) r0); intro.
-unfold compose at 1 in H0.
-rewrite H0.
-rewrite approx_oo_approx'; auto.
-rewrite approx'_oo_approx; auto.
-clear - H.
-generalize (unsquash_squash n r0); intros.
-rewrite <- H in H0.
-rewrite squash_unsquash in H0.
-congruence.
-Qed.
-
-Lemma ageN_resource_at_eq:
-  forall phi1 phi2 loc n phi1' phi2',
-          level phi1 = level phi2 ->
-          phi1 @ loc = phi2 @ loc ->
-         ageN n phi1 = Some phi1' ->
-         ageN n phi2 = Some phi2' ->
-         phi1' @ loc = phi2' @ loc.
-Proof.
-intros ? ? ? ? ? ? Hcomp ? ? ?; revert phi1 phi2 phi1' phi2' Hcomp H H0 H1; induction n; intros.
-inv H0; inv H1; auto.
-unfold ageN in H0, H1.
-simpl in *.
-revert H0 H1; case_eq (age1 phi1); case_eq (age1 phi2); intros; try discriminate.
-assert (level r = level r0) by (apply age_level in H0; apply age_level in H1; lia).
-apply (IHn r0 r); auto.
-rewrite (age1_resource_at _ _ H0 loc _ (eq_sym (resource_at_approx _ _))).
-rewrite (age1_resource_at _ _ H1 loc _ (eq_sym (resource_at_approx _ _))).
-rewrite H. rewrite H4; auto.
-Qed.
-
-Definition empty_rmap' : rmap' :=
-  ((fun _: AV.address => NO Share.bot bot_unreadable), nil).
-
-Definition empty_rmap (n:nat) : rmap := R.squash (n, empty_rmap').
-
-Lemma emp_empty_rmap: forall n, emp (empty_rmap n).
-Proof.
-intros.
-do 2 eexists; [|reflexivity].
-intro; intros.
-apply rmap_ext.
-apply join_level in H as []; auto.
-intros.
-apply (resource_at_join _ _ _ l) in H.
-unfold empty_rmap, empty_rmap', resource_at in *.
-destruct (unsquash a); destruct (unsquash b).
-simpl in *.
-destruct r; destruct r0; simpl in *.
-rewrite unsquash_squash in H.
-simpl in *.
-unfold compose in H.
-inv H; auto; apply join_unit1_e in RJ; auto; subst; proof_irr; auto.
-eapply ghost_identity1.
-replace nil with (ghost_of (empty_rmap n)); [apply ghost_of_join, H|].
-unfold ghost_of, empty_rmap, empty_rmap'.
-rewrite unsquash_squash; auto.
-Qed.
-
-Lemma empty_rmap_level:
-  forall lev, level (empty_rmap lev) = lev.
-Proof.
-intros.
-simpl.
-rewrite rmap_level_eq.
-unfold  empty_rmap.
-rewrite unsquash_squash; auto.
-Qed.
-
-Lemma approx_FF: forall n, approx n FF = FF.
-Proof.
-intros.
-apply pred_ext; auto.
-unfold approx; intros ? ?.
-hnf in H. destruct H; auto.
-Qed.
-
-Lemma resource_at_make_rmap: forall f g lev H Hg, 
-     resource_at (proj1_sig (make_rmap f g lev H Hg)) = f.
-refine (fun f g lev H Hg => match proj2_sig (make_rmap f g lev H Hg) with
-                           | conj _ (conj RESOURCE_AT _) => RESOURCE_AT
-                         end).
-Qed.
-
-Lemma ghost_of_make_rmap: forall f g lev H Hg, 
-     ghost_of (proj1_sig (make_rmap f g lev H Hg)) = g.
-refine (fun f g lev H Hg => match proj2_sig (make_rmap f g lev H Hg) with
-                           | conj _ (conj _ GHOST) => GHOST
-                         end).
-Qed.
-
-Lemma level_make_rmap: forall f g lev H Hg, @level rmap _ (proj1_sig (make_rmap f g lev H Hg)) = lev.
-refine (fun f g lev H Hg => match proj2_sig (make_rmap f g lev H Hg) with
-                           | conj LEVEL _ => LEVEL
-                         end).
-Qed.
-
-#[export] Instance Join_trace : Join (AV.address -> option (rshare * AV.kind)) :=
-     (Join_fun AV.address (option (rshare * AV.kind))
-                   (Join_lower (Join_prod rshare Join_rshare AV.kind (Join_equiv AV.kind)))).
-
-
- Lemma res_option_join:
-    forall x y z, 
-     join x y z -> 
-     @join _ (@Join_lower (rshare * AV.kind)
-     (Join_prod rshare Join_rshare AV.kind (Join_equiv AV.kind))) (res_option x) (res_option y) (res_option  z).
- Proof.
-   intros.
-   inv H; simpl; try constructor.
-   erewrite join_readable_part_eq by eassumption. constructor.
-   apply join_comm in  RJ.
-   erewrite join_readable_part_eq by eassumption. constructor.
-   constructor. apply join_readable_part; auto.
-   split; auto. 
- Qed.
-
-Ltac uniq_assert name P := 
- lazymatch goal with H: P |- _ => fail 
-    | _ => let H1 := fresh "H" name in assert (H1:P) end.
-
-Ltac readable_unreadable_join_prover := 
-repeat match goal with
-| H: join ?A ?B ?C, H1: ~readable_share ?C |- _ =>
-   uniq_assert A (~readable_share A);
-    [ clear - H H1; contradict H1; eapply join_readable1; eauto; fail | ]
-| H: join ?A ?B ?C, H1: ~readable_share ?C |- _ =>
-   uniq_assert B (~readable_share B);
-    [ clear - H H1; contradict H1; eapply join_readable2; eauto; fail | ]
-| H: join ?A ?B ?C, H0: ~readable_share ?B, H1: readable_share ?C |- _ =>
-    (uniq_assert A (readable_share A);
-    [ clear - H H0 H1; destruct (readable_share_dec A); 
-      [solve [auto]
-       |eapply join_unreadable_shares in H; eauto; solve [contradiction]] | ])
-| H: join ?A ?B ?C, H0: ~readable_share ?A, H1: readable_share ?C |- _ =>
-    (uniq_assert B (readable_share B);
-    [ clear - H H0 H1; destruct (readable_share_dec B); 
-      [solve [auto]
-       | apply join_comm in H; 
-         eapply join_unreadable_shares in H; eauto; solve [contradiction]] | ])
-end.
-
-(*Lemma Cross_resource: Cross_alg resource.
-Proof.
-intro; intros.
-destruct a as [ra | ra sa ka pa | ka pa | ma].
-destruct b as [rb | rb sb kb pb | kb pb |]; try solve [exfalso; inv H].
-destruct z as [rz | rz sz kz pz | kz pz |]; try solve [exfalso; inv H].
-destruct c as [rc | rc sc kc pc | kc pc |]; try solve [exfalso; inv H0].
-destruct d as [rd | rd sd kd pd | kd pd |]; try solve [exfalso; inv H0].
-assert (J1: join ra rb rz) by (inv H; auto).
-assert (J2: join rc rd rz) by (inv H0; auto).
-destruct (share_cross_split _ _ _ _ _ J1 J2) as [[[[ac ad] bc] bd] [Ha [Hb [Hc Hd]]]].
-readable_unreadable_join_prover.
-exists (NO ac Hac,NO ad Had, NO bc Hbc, NO bd Hbd); 
-  repeat split; simpl; auto; constructor; auto.
-destruct z as [rz | rz sz kz pz | kz pz |]; try solve [exfalso; inv H].
-destruct c as [rc | rc sc kc pc | kc pc |]; try solve [exfalso; inv H0].
-destruct d as [rd | rd sd kd pd | kd pd |]; try solve [exfalso; inv H0].
-assert (J1: join ra rb rz) by (inv H; auto).
-assert (J2: join rc rd rz) by (inv H0; auto).
-destruct (share_cross_split _ _ _ _ _ J1 J2) as [[[[ac ad] bc] bd] [Ha [Hb [Hc Hd]]]].
-readable_unreadable_join_prover.
-exists (NO ac Hac, NO ad Had, NO bc Hbc, YES bd Hbd kb pb); inv H; inv H0;
-  repeat split; simpl; auto; try constructor; auto.
-assert (J1: join ra rb rz) by (inv H; auto).
-destruct d as [rd | rd sd kd pd | kd pd |]; try solve [exfalso; inv H0].
-assert (J2: join rc rd rz) by (inv H0; auto).
-destruct (share_cross_split _ _ _ _ _ J1 J2) as [[[[ac ad] bc] bd] [Ha [Hb [Hc Hd]]]].
-readable_unreadable_join_prover.
-exists (NO ac Hac, NO ad Had, YES bc Hbc kb pb, NO bd Hbd); inv H; inv H0;
-  repeat split; simpl; auto; try constructor; auto.
-assert (J2: join rc rd rz) by (inv H0; auto).
-destruct (share_cross_split _ _ _ _ _ J1 J2) as [[[[ac ad] bc] bd] [Ha [Hb [Hc Hd]]]].
-readable_unreadable_join_prover.
-exists (NO ac Hac, NO ad Had, YES bc Hbc kb pb, YES bd Hbd kd pd); inv H; inv H0;
-  repeat split; simpl; auto; try constructor; auto.
-destruct b as [rb | rb sb kb pb | kb pb |]; try solve [exfalso; inv H].
-destruct z as [rz | rz sz kz pz | kz pz |]; try solve [exfalso; inv H].
-assert (J1: join ra rb rz) by (inv H; auto).
-destruct c as [rc | rc sc kc pc | kc pc |]; try solve [exfalso; inv H0].
-destruct d as [rd | rd sd kd pd | kd pd |]; try solve [exfalso; inv H0].
-assert (J2: join rc rd rz) by (inv H0; auto).
-destruct (share_cross_split _ _ _ _ _ J1 J2) as [[[[ac ad] bc] bd] [Ha [Hb [Hc Hd]]]].
-readable_unreadable_join_prover.
-exists (NO ac Hac, YES ad Had kd pd, NO bc Hbc, NO bd Hbd); inv H; inv H0;
-  repeat split; simpl; auto; try constructor; auto.
-destruct d as [rd | rd sd kd pd | kd pd |]; try solve [exfalso; inv H0].
-assert (J2: join rc rd rz) by (inv H0; auto).
-destruct (share_cross_split _ _ _ _ _ J1 J2) as [[[[ac ad] bc] bd] [Ha [Hb [Hc Hd]]]].
-readable_unreadable_join_prover.
-exists (YES ac Hac kc pc, NO ad Had, NO bc Hbc, NO bd Hbd); inv H; inv H0;
-  repeat split; simpl; auto; try constructor; auto.
-assert (J2: join rc rd rz) by (inv H0; auto).
-destruct (share_cross_split _ _ _ _ _ J1 J2) as [[[[ac ad] bc] bd] [Ha [Hb [Hc Hd]]]].
-readable_unreadable_join_prover.
-exists (YES ac Hac kc pc, YES ad Had kd pd, NO bc Hbc, NO bd Hbd); inv H; inv H0;
-  repeat split; simpl; auto; try constructor; auto.
-destruct z as [rz | rz sz kz pz | kz pz |]; try solve [exfalso; inv H].
-assert (J1: join ra rb rz) by (inv H; auto).
-destruct c as [rc | rc sc kc pc | kc pc |]; try solve [exfalso; inv H0].
-destruct d as [rd | rd sd kd pd | kd pd |]; try solve [exfalso; inv H0].
-assert (J2: join rc rd rz) by (inv H0; auto).
-destruct (share_cross_split _ _ _ _ _ J1 J2) as [[[[ac ad] bc] bd] [Ha [Hb [Hc Hd]]]].
-readable_unreadable_join_prover.
-exists (NO ac Hac, YES ad Had kd pd, NO bc Hbc, YES bd Hbd kd pd); inv H; inv H0;
-  repeat split; simpl; auto; try constructor; auto.
-destruct d as [rd | rd sd kd pd | kd pd |]; try solve [exfalso; inv H0].
-assert (J2: join rc rd rz) by (inv H0; auto).
-destruct (share_cross_split _ _ _ _ _ J1 J2) as [[[[ac ad] bc] bd] [Ha [Hb [Hc Hd]]]].
-readable_unreadable_join_prover.
-exists (YES ac Hac kc pc, NO ad Had, YES bc Hbc kb pb, NO bd Hbd); inv H; inv H0;
-  repeat split; simpl; auto; try constructor; auto.
-assert (J2: join rc rd rz) by (inv H0; auto).
-destruct (share_cross_split _ _ _ _ _ J1 J2) as [[[[ac ad] bc] bd] [Ha [Hb [Hc Hd]]]].
-destruct (Sumbool.sumbool_not _ _ (readable_share_dec ac)) as [Hac|Hac].
-readable_unreadable_join_prover.
-destruct (Sumbool.sumbool_not _ _ (readable_share_dec bd)) as [Hbd|Hbd].
-exists (NO ac Hac, YES ad Had ka pa, YES bc Hbc kc pc, NO bd Hbd); 
-   inv H; inv H0; simpl; repeat split; auto;  constructor; auto.
-exists (NO ac Hac, YES ad Had ka pa, YES bc Hbc kc pc, YES bd Hbd kd pd); 
-   inv H; inv H0; simpl; repeat split; auto;  constructor; auto.
-destruct (Sumbool.sumbool_not _ _ (readable_share_dec ad)) as [Had|Had];
-readable_unreadable_join_prover;
-destruct (Sumbool.sumbool_not _ _ (readable_share_dec bc)) as [Hbc|Hbc];
-readable_unreadable_join_prover.
-exists (YES ac Hac ka pa, NO ad Had, NO bc Hbc, YES bd Hbd kb pb); 
-   inv H; inv H0; simpl; repeat split; auto;  constructor; auto.
-exists (YES ac Hac ka pa, NO ad Had, YES bc Hbc kc pc, YES bd Hbd kd pd);
-    inv H; inv H0; simpl; repeat split; auto;  constructor; auto.
-exists (YES ac Hac kc pc, YES ad Had kc pc, NO bc Hbc, YES bd Hbd kb pb);
-    inv H; inv H0; simpl; repeat split; auto;  constructor; auto.
-destruct (Sumbool.sumbool_not _ _ (readable_share_dec bd)) as [Hbd|Hbd].
-exists (YES ac Hac ka pa,  YES ad Had kd pd, YES bc Hbc kb pb, NO bd Hbd);
-    inv H; inv H0; simpl; repeat split; auto;  constructor; auto.
-exists (YES ac Hac ka pa, YES ad Had ka pa, 
-       YES bc Hbc ka pa,  YES bd Hbd ka pa);
-    inv H; inv H0; simpl; repeat split; auto;  constructor; auto.
-exists (PURE ka pa, PURE ka pa, PURE ka pa, PURE ka pa).
-inv H. inv H0.
-repeat split; constructor; auto.
-destruct b as [| | | mb]; try solve [exfalso; inv H].
-destruct z as [| | | mz]; try solve [exfalso; inv H].
-destruct c as [| | | mc]; try solve [exfalso; inv H0].
-destruct d as [| | | md]; try solve [exfalso; inv H0].
-(* relies on cross-split for ghost state *)
-Qed.*)
-
-Definition res_retain (r: resource) : Share.t :=
- match r with
-  | NO sh _ => retainer_part sh
-  | YES sh _ _ _ => retainer_part sh
-  | PURE _ _ => Share.bot
- end.
-
-Lemma fixup_trace_readable:
-  forall a (b: rshare), readable_share (Share.lub (Share.glb Share.Lsh a) (Share.glb Share.Rsh (proj1_sig b))).
-Proof.
-intros.
-destruct b as [b H].
-forget (Share.glb Share.Lsh a) as a'. clear a.
-simpl.
-destruct H as [H' H].
-do 3 red in H|-*.
-simpl.
-contradict H.
-rewrite Share.distrib1 in H.
-rewrite <- Share.glb_assoc in H.
-rewrite Share.glb_idem in H.
-apply identity_share_bot in H.
-apply lub_bot_e in H. destruct H.
-rewrite H0. apply bot_identity.
-Qed.
-
-(*Definition fixup_trace (retain: AV.address -> Share.t)
-                 (trace: AV.address -> option (rshare * AV.kind)) (gtrace: AV.address -> option M)
-                 (f: AV.address -> resource) : AV.address -> resource :=
-   fun x => match trace x, f x with
-            | None, PURE k pp => PURE k pp
-            | Some(sh,k), PURE _ pp =>
-               YES _ (fixup_trace_readable (retain x) sh) k pp
-            | Some (sh,k), YES _ _ _ pp => YES _ (fixup_trace_readable (retain x) sh) k pp
-            | Some (sh, k), NO _ _ => YES _ (fixup_trace_readable (retain x) sh) k NoneP
-            | None, _ => NO _ (@retainer_part_nonreadable (retain x))
-            end.
-
-
-Definition fixup_trace_ok (tr: AV.address -> option (rshare * AV.kind)) :=
- forall x, match tr x with None => True | Some(sh,_)=> Share.glb Share.Rsh (proj1_sig sh) = (proj1_sig sh) end.
-
-Lemma fixup_trace_valid: forall retain
-             tr 
-             (trace_ok: fixup_trace_ok tr)
-              f,
-            AV.valid tr -> 
-            AV.valid (res_option oo (fixup_trace retain tr f)).
- Proof. intros.
-  replace (res_option oo fixup_trace retain tr f) with tr. auto.
-  extensionality l. unfold compose. unfold fixup_trace.
-  specialize (trace_ok l).
-  destruct (tr l); simpl; auto.
-*
-  destruct p. rename r into s.
-  assert (s = readable_part (fixup_trace_readable (retain l) s)). {
-    destruct s; apply exist_ext'; simpl in *.
-    clear - trace_ok.
-    rewrite Share.lub_commute.
-    rewrite Share.distrib1.
-    rewrite <- !Share.glb_assoc. rewrite Share.glb_idem.
-    rewrite (Share.glb_commute _ Share.Lsh).
-    rewrite glb_Lsh_Rsh. rewrite (Share.glb_commute Share.bot). rewrite Share.glb_bot.
-    rewrite Share.lub_bot. auto.
-  }
-  destruct (f l); simpl; f_equal; f_equal; auto.
-*
-  destruct (f l); reflexivity.
-Qed.
-
-Lemma fixup_trace_rmap:
-    forall (retain: AV.address -> Share.t) 
-             (tr: sig AV.valid) (trace_ok: fixup_trace_ok (proj1_sig tr)) (f: rmap),
-        {phi: rmap | 
-             level phi = level f 
-            /\ resource_at phi = fixup_trace retain (proj1_sig tr) (resource_at f)}.
-Proof.
- intros.
- apply make_rmap.
- apply fixup_trace_valid; auto. destruct tr; simpl; auto.
- extensionality l.
- unfold compose, fixup_trace.
- destruct tr. simpl.
- destruct (x l); simpl; auto. destruct p.
- case_eq (f @ l); intros.
- unfold resource_fmap. rewrite preds_fmap_NoneP; auto.
- generalize (resource_at_approx f l); intro.
- rewrite H in H0. symmetry in H0.
-  simpl in H0. simpl.
-   f_equal. injection H0; auto.
- generalize (resource_at_approx f l); intro.
- rewrite H in H0. symmetry in H0.
-  simpl in H0. simpl.
-   f_equal. injection H0; auto.
- auto.
- case_eq (f @ l); intros; auto.
- generalize (resource_at_approx f l); intro.
- rewrite H in H0. symmetry in H0.
-  simpl in H0. simpl.
-   f_equal. injection H0; auto.
-Qed.
-
-Lemma join_res_retain:
-          forall a b c: rmap ,
-              join a b c ->
-              join (res_retain oo resource_at a) (res_retain oo resource_at b) (res_retain oo resource_at c).
-Proof.
- intros.
- intro loc; apply (resource_at_join _ _ _ loc) in H.
-  unfold compose.
- inv H; simpl; auto; apply retainer_part_join; auto.
-Qed.
-
-Lemma join_fixup_trace_ok:
-  forall (v w: sig AV.valid) a,
-    join v w (exist AV.valid (res_option oo resource_at a) (rmap_valid a)) ->
-    fixup_trace_ok (proj1_sig v).
-Proof.
-  intros.
-   hnf; intros.
-   destruct v, w. simpl in *.
-   red in H. red in H. simpl in H.
-   specialize (H x).
-   clear - H.
-   forget (x0 x) as u. forget (x1 x) as v.
-   unfold res_option, compose in H.
-   destruct (a @ x); inv H; auto.
-   unfold readable_part. simpl.
-   rewrite <- Share.glb_assoc. rewrite Share.glb_idem; auto.
-   destruct a1 as [[v ?] ?]. destruct a2 as [[w ?] ?].
-   destruct H3 as [H3 _]. do 2 red in H3. simpl in H3.
-   simpl. clear - H3.
-   assert (join_sub v (Share.glb Share.Rsh sh)) by (exists w; auto).
-   clear H3.
-   apply leq_join_sub in H.
-   assert (Share.Ord (Share.glb Share.Rsh sh) Share.Rsh).
-   apply Share.ord_spec1.
-   symmetry. rewrite Share.glb_commute. rewrite <- Share.glb_assoc.
-   rewrite Share.glb_idem. auto.
-   pose proof (Share.ord_trans _ _ _ H H0).
-   clear - H1.
-   apply Share.ord_spec1 in H1.
-   rewrite Share.glb_commute. auto.
-Qed.
-
-#[export] Instance Perm_foo: Perm_alg
-               {x : AV.address -> option (rshare * AV.kind) |
-               AV.valid x}.
-Proof.
-apply Perm_prop.
-apply Perm_fun.
-apply Perm_lower.
-apply Perm_prod.
-apply Perm_rshare.
-apply Perm_equiv.
-intros.
-eapply AV.valid_join; eauto.
-Qed.
-
-Ltac crtac' :=
- repeat  (simpl in *; ((*solve [constructor; auto] ||*)
-   match goal with
- | H: None = res_option ?A |- _ => destruct A; inv H
- | H: Some _ = res_option ?A |- _ => destruct A; inv H
- | H: join (NO _ _) _ _ |- _ => inv H
- | H: join _ (NO _ _) _ |- _ => inv H
- | H: join (YES _ _ _ _) _ _ |- _ => inv H
- | H: join _ (YES _ _ _ _) _ |- _ => inv H
- | H: join (PURE _ _) _ _ |- _ => inv H
- | H: join _ (PURE _ _) _ |- _ => inv H
- | H: @join _ _ (Some _) _ _ |- _ => inv H
- | H: @join _ _ _ (Some _) _ |- _ => inv H
- | H: join None _ _ |- _ =>  inv H
- | H: join _ None _ |- _ => inv H
- end; auto)).
-
-
-Lemma join_fixup_trace:
- forall (Rc Rd: AV.address -> Share.t)
-        (c d: AV.address -> option (rshare * AV.kind))
-        (z a: rmap) (l: AV.address), 
-   join_sub (a @ l) (z @ l) ->
-   join (Rc l) (Rd l) (res_retain (a @ l)) ->
-   @join (option (rshare * AV.kind))
-       (@Join_lower (rshare * AV.kind)
-          (Join_prod rshare Join_rshare AV.kind
-             (Join_equiv AV.kind)))
-         (c l) (d l) (res_option (a @ l)) ->
-   join (fixup_trace Rc c (resource_at z) l) (fixup_trace Rd d (resource_at z) l) (a @ l).
-Proof.
-intros.
-unfold fixup_trace.
-forget (a @ l) as al.
-forget (z @ l) as zl.
-forget (Rc l) as Rcl.
-forget (c l) as cl.
-forget (Rd l) as Rdl.
-forget (d l) as dl.
-destruct H as [bl H].
-clear - H H0 H1.
-destruct cl as [[? ?]|]; crtac'; try constructor.
-*
-destruct (join_parts comp_Lsh_Rsh H0) as [J1 [J2 [J3 J4]]].
-unfold retainer_part.
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-apply left_right_join.
-rewrite Share.distrib1.
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-assumption.
-rewrite Share.distrib1.
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-apply join_unit2; auto.
-*
-destruct (join_parts comp_Lsh_Rsh H0) as [J1 [J2 [J3 J4]]].
-unfold retainer_part.
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-apply left_right_join.
-rewrite Share.distrib1.
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-assumption.
-rewrite Share.distrib1.
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-apply join_unit2; auto.
-*
-destruct a2.
-destruct H5; simpl in *. destruct H1; subst.
-destruct r,r1; simpl in *.
-do 2 red in H. simpl in *.
-constructor.
-destruct (join_parts comp_Lsh_Rsh H0) as [J1 [J2 [J3 J4]]].
-apply left_right_join.
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-rewrite Share.distrib1.
-rewrite glb_Lsh_Rsh', Share.lub_bot.
-rewrite Share.distrib1.
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-assumption.
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-rewrite Share.distrib1.
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-rewrite Share.distrib1.
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-destruct (join_parts comp_Rsh_Lsh H) as [K1 [K2 [K3 K4]]].
-rewrite ?K1, ?K2,?K3,?K4.
-assumption.
-*
-destruct a2.
-destruct H5; simpl in *. destruct H1; subst.
-destruct r,r1; simpl in *.
-do 2 red in H. simpl in *.
-constructor.
-destruct (join_parts comp_Lsh_Rsh H0) as [J1 [J2 [J3 J4]]].
-apply left_right_join.
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-rewrite Share.distrib1.
-rewrite glb_Lsh_Rsh', Share.lub_bot.
-rewrite Share.distrib1.
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-assumption.
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-rewrite Share.distrib1.
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-rewrite Share.distrib1.
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-destruct (join_parts comp_Rsh_Lsh H) as [K1 [K2 [K3 K4]]].
-rewrite ?K1, ?K2,?K3,?K4.
-assumption.
-*
-unfold retainer_part in *.
-destruct al; crtac'; try constructor;
-unfold retainer_part in *.
- +
-destruct (join_parts comp_Lsh_Rsh H0) as [J1 [J2 [J3 J4]]].
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-rewrite <- (Share.glb_top sh). rewrite Share.glb_commute.
-rewrite <- lub_Lsh_Rsh.
-rewrite Share.glb_commute.
-rewrite Share.distrib1.
-apply not_readable_Rsh_part in nsh0.
-rewrite (Share.glb_commute _ Share.Rsh), nsh0.
-rewrite Share.lub_bot.
-rewrite Share.glb_commute; auto.
- +
-rewrite <- (Share.glb_top sh). rewrite Share.glb_commute.
-rewrite <- lub_Lsh_Rsh.
-rewrite Share.glb_commute.
-rewrite Share.distrib1.
-apply not_readable_Rsh_part in nsh0.
-rewrite (Share.glb_commute _ Share.Rsh), nsh0.
-rewrite Share.lub_bot.
-destruct (join_parts comp_Lsh_Rsh H0) as [J1 [J2 [J3 J4]]].
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-rewrite Share.glb_commute; auto.
- +
-destruct (join_parts comp_Lsh_Rsh H0) as [J1 [J2 [J3 J4]]].
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-apply left_right_join.
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-rewrite Share.distrib1.
-rewrite glb_Lsh_Rsh', Share.lub_bot.
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-auto.
-rewrite Share.distrib1.
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-apply join_unit1; auto.
- +
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-apply left_right_join.
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-destruct (join_parts comp_Lsh_Rsh H0) as [J1 [J2 [J3 J4]]].
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-rewrite Share.distrib1.
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-auto.
-rewrite <- Share.glb_assoc. rewrite glb_Rsh_Lsh.
-rewrite Share.glb_commute. rewrite Share.glb_bot. 
-rewrite Share.distrib1.
-rewrite <- Share.glb_assoc. rewrite glb_Rsh_Lsh.
-rewrite Share.glb_commute. rewrite Share.glb_bot. 
-rewrite Share.lub_commute, Share.lub_bot.
-rewrite <- Share.glb_assoc. rewrite Share.glb_idem.
-apply join_unit1; auto.
- +
-inv H; simpl.
-admit. (* What should fixup_trace do with a ghost? *)
-*
-destruct (join_parts comp_Lsh_Rsh H0) as [J1 [J2 [J3 J4]]].
-unfold retainer_part in *.
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-auto.
-rewrite <- (Share.glb_top sh). rewrite Share.glb_commute.
-rewrite <- lub_Lsh_Rsh.
-rewrite Share.glb_commute.
-rewrite Share.distrib1.
-apply not_readable_Rsh_part in nsh0.
-rewrite (Share.glb_commute _ Share.Rsh), nsh0.
-rewrite Share.lub_bot.
-rewrite Share.glb_commute; auto.
-*
-destruct (join_parts comp_Lsh_Rsh H0) as [J1 [J2 [J3 J4]]].
-unfold retainer_part in *.
-rewrite ?J1,?J2,?J3,?J4, ?glb_twice, ?glb_Lsh_Rsh', ?Share.lub_bot, ?lub_bot'.
-auto.
-rewrite <- (Share.glb_top sh). rewrite Share.glb_commute.
-rewrite <- lub_Lsh_Rsh.
-rewrite Share.glb_commute.
-rewrite Share.distrib1.
-apply not_readable_Rsh_part in nsh0.
-rewrite (Share.glb_commute _ Share.Rsh), nsh0.
-rewrite Share.lub_bot.
-rewrite Share.glb_commute; auto.
-*
-inv H.
-admit.
-Abort.
-
-#[export] Instance Cross_rmap:
-      @Cross_alg _ (Join_prop _ Join_trace AV.valid) ->
-      Cross_alg rmap.
-Proof.
-  intro CAV.
-  repeat intro.
-  assert (Hz : valid (resource_at z)).
-  unfold resource_at.
-  case_eq (unsquash z); intros.
-  simpl.
-  destruct r; simpl; auto.
-  specialize (CAV
-          (exist AV.valid _ (rmap_valid a))
-          (exist AV.valid _ (rmap_valid b))
-          (exist AV.valid _ (rmap_valid c))
-          (exist AV.valid _ (rmap_valid d))
-          (exist AV.valid _ Hz)).
-  destruct CAV as [[[[Vac Vad] Vbc] Vbd] [Va [Vb [Vc Vd]]]].
-  intro l.  unfold compose. simpl.
-  apply res_option_join. apply resource_at_join. auto.
-  intro l.  simpl. unfold compose.
-  apply res_option_join. apply resource_at_join. auto.
-  assert (CAR: Cross_alg (AV.address -> Share.t)) by auto with typeclass_instances.
-  specialize (CAR _ _ _ _ _ (join_res_retain _ _ _ H) (join_res_retain _ _ _ H0)).
-  destruct CAR as [[[[Rac Rad] Rbc] Rbd] [Ra [Rb [Rc Rd]]]].
-  destruct (fixup_trace_rmap  Rac Vac (join_fixup_trace_ok _ _ _ Va) z) as [Mac [? ?]].
-  destruct (fixup_trace_rmap Rad Vad (join_fixup_trace_ok _ _ _ Vd) z) as [Mad [? ?]].
-  destruct (fixup_trace_rmap Rbc Vbc (join_fixup_trace_ok _ _ _ Vb) z) as [Mbc [? ?]].
-  destruct (fixup_trace_rmap Rbd Vbd (join_fixup_trace_ok _ _ _ (join_comm Vb)) z) as [Mbd [? ?]].
-  exists (Mac,Mad,Mbc,Mbd).
-  destruct Vac as [ac ?]; destruct Vad as [ad ?]; destruct Vbc as [bc ?];
-  destruct Vbd as [bd ?]; simpl in *.
-  assert (LEVa: level a = level z) by (apply join_level in H; destruct H; auto).
-  assert (LEVb: level b = level z) by (apply join_level in H; destruct H; auto).
-  assert (LEVc: level c = level z) by (apply join_level in H0; destruct H0; auto).
-  assert (LEVd: level d = level z) by (apply join_level in H0; destruct H0; auto).
-  do 2 red in Va,Vb,Vc,Vd; simpl in *.
-  unfold compose in *. clear Hz.
-  split; [|split3];   apply resource_at_join2; try congruence;
-  repeat match goal with
-  | H: AV.valid _ |- _ => clear H
-  | H: level _ = level _ |- _ => clear H
-  end;
-  intro l;
-  specialize ( Va l); specialize ( Vb l); specialize ( Vc l); specialize ( Vd l);
-  specialize ( Ra l); specialize ( Rb l); specialize ( Rc l); specialize ( Rd l); 
-  apply (resource_at_join _ _ _ l) in H;
-  apply (resource_at_join _ _ _ l) in H0;
-  try rewrite H2; try rewrite H4; try rewrite H6; try rewrite H8;
-  simpl in *;
- eapply join_fixup_trace; eauto;
- (eapply join_join_sub; eassumption) || (eapply join_join_sub'; eassumption).
-Qed.*)
-
-Lemma YES_inj: forall sh rsh k pp sh' rsh' k' pp',
-           YES sh rsh k pp = YES sh' rsh' k' pp' ->
-            (sh,k,pp) = (sh',k',pp').
-Proof. intros. inv H. auto. Qed.
-
-Lemma SomeP_inj1: forall t t' a a', SomeP t a = SomeP t' a' -> t=t'.
-  Proof. intros. inv H; auto. Qed.
-Lemma SomeP_inj2: forall t a a', SomeP t a = SomeP t a' -> a=a'.
-  Proof. intros. inv H. apply inj_pair2 in H1. auto. Qed.
-Lemma SomeP_inj:
-   forall T a b, SomeP T a = SomeP T b -> a=b.
-Proof. intros. inv H. apply inj_pair2 in H1. auto.
-Qed.
-
-Lemma PURE_inj: forall T x x' y y', PURE x (SomeP T y) = PURE x' (SomeP T y') -> x=x' /\ y=y'.
- Proof. intros. inv H. apply inj_pair2 in H2. subst; auto.
- Qed.
-
-Lemma resource_at_identity: forall (m: rmap) (loc: AV.address),
- identity m -> identity (m @ loc).
-Proof.
- intros.
- replace m with (core m) in * by (symmetry; apply identity_core; auto).
- apply resource_at_core_identity.
-Qed.
-
-Definition ghostless_rmap m :
-  {phi: rmap | level phi = level m /\ resource_at phi = resource_at m /\ ghost_of phi = nil}.
-Proof.
-  apply (exist _ (squash (level m, (resource_at m, nil)))).
-  simpl level; rewrite rmap_level_eq in *; unfold resource_at, ghost_of. rewrite unsquash_squash; simpl.
-  repeat split; auto.
-  unfold compose; extensionality l.
-  setoid_rewrite <- (resource_at_approx m l) at 2.
-  rewrite rmap_level_eq; reflexivity.
-Qed.
-
-Definition id_core m := proj1_sig (ghostless_rmap (core m)).
-
-Lemma id_core_level : forall m, level (id_core m) = level m.
-Proof.
-  intros. unfold id_core. destruct (ghostless_rmap (core m)) as (? & ? & ? & ?); simpl.
-  rewrite <- (level_core m); auto.
-Qed.
-
-Lemma id_core_resource : forall m, resource_at (id_core m) = resource_at (core m).
-Proof.
-  intros. unfold id_core. destruct (ghostless_rmap (core m)) as (? & ? & ? & ?); auto.
-Qed.
-
-Lemma id_core_ghost : forall m, ghost_of (id_core m) = nil.
-  intros. unfold id_core. destruct (ghostless_rmap (core m)) as (? & ? & ? & ?); auto.
-Qed.
-
-Lemma id_core_unit : forall m, unit_for (id_core m) m.
-Proof.
-  intros; unfold unit_for.
-  unfold id_core; destruct (ghostless_rmap (core m)) as (? & ? & ? & ?); simpl.
-  apply resource_at_join2; auto.
-  - rewrite level_core in e; auto.
-  - intros; rewrite e0, <- core_resource_at; apply core_unit.
-  - rewrite e1; constructor.
-Qed.
-
-Lemma id_core_identity : forall m, identity (id_core m).
-Proof.
-  intros ????.
-  unfold id_core in H; destruct (ghostless_rmap (core m)) as (? & ? & ? & ?); simpl in H.
-  apply rmap_ext.
-  - apply join_level in H as []; auto.
-  - intros; apply resource_at_join with (loc := l) in H.
-    eapply resource_at_core_identity. rewrite <- e0; eassumption.
-  - apply ghost_of_join in H; rewrite e1 in H; inv H; auto.
-Qed.
-
-Lemma identity_id_core : forall m, identity m -> m = id_core m.
-Proof.
-  intros.
-  symmetry; apply H.
-  apply join_comm, id_core_unit.
-Qed.
-
-Lemma ghost_of_identity: forall (m : rmap),
- identity m -> identity (ghost_of m).
-Proof.
- intros ??.
- apply identity_id_core in H as ->.
- apply ghost_identity, id_core_ghost.
-Qed.
-
-Lemma id_core_core : forall m, id_core (core m) = id_core m.
-Proof.
-  intros; unfold id_core; rewrite core_idem; reflexivity.
-Qed.
-
-(*(* rmaps still induce a flat sepalg, but only with this weaker core. *)
-Instance FSep_rmap : FSep_alg rmap.
-Proof.
-  exists id_core.
-  - apply id_core_unit.
-  - intros.
-    apply rmap_ext.
-    + apply join_level in H as []; rewrite !id_core_level; auto.
-    + intros; rewrite !id_core_resource.
-      apply resource_at_join with (loc := l), join_core in H.
-      rewrite <- !core_resource_at; auto.
-    + rewrite !id_core_ghost; auto.
-Defined.
-
-Local Instance FAge_rmap : Age_alg(SA := fsep_sep FSep_rmap) rmap.
-Proof.
-  constructor.
-  apply age1_join.
-  apply age1_join2.
-  apply unage_join.
-  apply unage_join2.
-  intros; simpl.
-  pose proof (fcore_unit x).
-  unfold unit_for in H0.
-  destruct (age1_join2 _ H0 H) as [a [b [? [? ?]]]].
-  unfold age in H3. unfold age in H; rewrite H3 in H; inv H.
-  pose proof (fcore_unit y).
-  assert (a = id_core y); [|subst; auto].
-  eapply same_identity; eauto.
-  - eapply age_identity; eauto. simpl.
-    apply id_core_identity.
-  - apply id_core_identity.
-Qed.
-
-Lemma sepcon_convert : sepcon(SA := fsep_sep FSep_rmap) = sepcon(SA := Sep_rmap).
-Proof.
-  intros; extensionality P; extensionality Q.
-  apply pred_ext; intros ? (? & ? & ? & ? & ?); do 3 eexists; eauto.
-Qed.*)
-
-Lemma core_YES: forall sh rsh k pp, core (YES sh rsh k pp) = NO Share.bot bot_unreadable.
-Proof.
- intros. generalize (core_unit (YES sh rsh k pp)); unfold unit_for; intros.
- inv H; auto.
- setoid_rewrite <- H1.
- apply unit_identity in RJ. apply identity_share_bot in RJ. subst; auto.
- f_equal. apply proof_irr.
- clear - H1.
- pose proof (core_unit (YES sh rsh k pp)).
- hnf in H. inv H.
- rewrite <- H2 in H1. inv H1.
- rewrite <- H2 in H1. inv H1.
- apply unit_identity in RJ. apply identity_share_bot in RJ. subst sh0.
- contradiction (bot_unreadable rsh0).
-Qed.
-
-Lemma core_NO: forall sh nsh, core (NO sh nsh) = NO Share.bot bot_unreadable.
-Proof.
- intros.  generalize (core_unit (NO sh nsh)); unfold unit_for; intros.
- inv H; auto.
- setoid_rewrite <- H1.
- pose proof (core_unit (NO sh nsh)).
- apply unit_identity in RJ. apply identity_share_bot in RJ. subst sh1.
- f_equal. apply proof_irr.
-Qed.
-
-Lemma core_PURE: forall k pp, core (PURE k pp) = PURE k pp.
-Proof.
- intros. generalize (core_unit (PURE k pp)); unfold unit_for; intros.
- inv H; auto.
-Qed.
-
-Lemma core_not_YES: forall {w loc rsh sh k pp},
-   core w @ loc = YES rsh sh k pp -> False.
-Proof.
-intros.
-pose proof (core_duplicable w) as Hj.
-apply (resource_at_join _ _ _ loc) in Hj; rewrite H in Hj.
-inv Hj.
-eapply readable_nonidentity; eauto.
-eapply unit_identity; eauto.
-Qed.
-
-Lemma resource_at_empty2:
- forall phi: rmap, (forall l, identity (phi @ l)) -> identity (ghost_of phi) -> identity phi.
-Proof.
-  apply all_resource_at_identity. (* This was already proved. *)
-Qed.
-
-Lemma resource_fmap_core':
-  forall n w loc, resource_fmap (approx n) (approx n) (core (w @ loc)) = core (resource_fmap (approx n) (approx n) (w @ loc)).
-Proof.
-intros.
-destruct (w @ loc); simpl; change fcore with (@core _ _ (fsep_sep Sep_resource));
- [rewrite core_NO | rewrite !core_YES | rewrite !core_PURE]; auto.
-Qed.
-
-Lemma resource_fmap_core:
-  forall w loc, resource_fmap (approx (level w)) (approx (level w)) (core (w @ loc)) = core (w @ loc).
-Proof.
-  intros; rewrite resource_fmap_core', resource_at_approx; auto.
-Qed.
-
-Lemma ghost_fmap_core':
-  forall g n, ghost_fmap (approx n) (approx n) (core g) = core (ghost_fmap (approx n) (approx n) g).
-Proof.
-  intros; rewrite !ghost_core_eq.
-  unfold ghost_fmap; rewrite !map_map; apply map_ext.
-  intros [(?, ?)|]; constructor.
-Qed.
-
-Lemma ghost_fmap_core:
-  forall w, ghost_fmap (approx (level w)) (approx (level w)) (core (ghost_of w)) = core (ghost_of w).
-Proof.
-  intros; rewrite <- ghost_of_core, <- level_core; apply ghost_of_approx.
-Qed.
-
-Lemma rmap_age_i:
- forall w w' : rmap,
-    level w = S (level w') ->
-   (forall l, resource_fmap (approx (level w')) (approx (level w')) (w @ l) = w' @ l) ->
-    ghost_fmap (approx (level w')) (approx (level w')) (ghost_of w) = ghost_of w' ->
-    age w w'.
-Proof.
-intros.
-hnf.
-destruct (levelS_age1 _ _ H).
-assert (x=w'); [ | subst; auto].
-assert (level x = level w')
-  by (apply age_level in H2; lia).
-apply rmap_ext; auto.
-intros.
-specialize (H0 l).
-rewrite (age1_resource_at w x H2 l (w@l)).
-rewrite H3.
-apply H0.
-symmetry; apply resource_at_approx.
-erewrite age1_ghost_of; eauto.
-rewrite H3; apply H1.
-Qed.
-
-Lemma age_resource_at {phi phi' loc} :
-  age phi phi' ->
-  phi' @ loc = resource_fmap (approx (level phi')) (approx (level phi')) (phi @ loc).
-Proof.
-  intros A.
-  rewrite <- (age1_resource_at _ _ A loc (phi @ loc)).
-  - reflexivity.
-  - rewrite resource_at_approx. reflexivity.
-Qed.
-
-End Rmaps_Lemmas.
diff --git a/veric/semax.v b/veric/semax.v
index 9b682a1c75..45c5ac4022 100644
--- a/veric/semax.v
+++ b/veric/semax.v
@@ -1,6 +1,6 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.juicy_base.
-Require Import VST.veric.juicy_mem VST.veric.juicy_mem_lemmas VST.veric.juicy_mem_ops.
-Require Import VST.veric.res_predicates.
+Require Import VST.veric.juicy_mem.
 Require Import VST.veric.extend_tc.
 Require Import VST.veric.Clight_seplog.
 Require Import VST.veric.Clight_assert_lemmas.
@@ -9,182 +9,76 @@ Require Import VST.veric.Clight_lemmas.
 Require Import VST.sepcomp.extspec.
 Require Import VST.sepcomp.step_lemmas.
 Require Import VST.veric.juicy_safety.
+Require Import VST.veric.external_state.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.juicy_extspec.
 Require Import VST.veric.tycontext.
 Require Import VST.veric.expr2.
 Require Import VST.veric.expr_lemmas.
-Require Import VST.veric.own.
-Require Import VST.veric.fupd.
-Import compcert.lib.Maps.
+Require Export VST.veric.lifting.
 
 Import Ctypes Clight_core.
 
 Local Open Scope nat_scope.
-Local Open Scope pred.
+Open Scope maps.
 
-Definition closed_wrt_modvars c (F: assert) : Prop :=
-    closed_wrt_vars (modifiedvars c) F.
-
-Definition genv_symb_injective {F V} (ge: Genv.t F V) : extspec.injective_PTree block.
-Proof.
-exists (Genv.genv_symb ge).
-hnf; intros.
-eapply Genv.genv_vars_inj; eauto.
-Defined.
+Section mpred.
 
-Definition jsafeN {Z} (Hspec : juicy_ext_spec Z) (ge: genv) :=
-  @jsafeN_ genv _ _ genv_symb_injective 
-               (cl_core_sem ge) Hspec ge.
+Context `{!VSTGS OK_ty Σ} (OK_spec : ext_spec OK_ty).
 
-Definition ext_compat {Z} (ora : Z) (w : rmap) :=
-  joins (ghost_of w) (Some (ghost_PCM.ext_ref ora, NoneP) :: nil).
-
-Lemma ext_compat_unage : forall {Z} (ora : Z) w w', age w w' ->
-  ext_compat ora w' -> ext_compat ora w.
-Proof.
-  unfold ext_compat; intros.
-  erewrite age1_ghost_of in H0 by eauto.
-  eapply ext_join_unapprox; eauto.
-Qed.
+Definition closed_wrt_modvars c (F: assert) : Prop :=
+    closed_wrt_vars (modifiedvars c) F.
 
-Lemma ext_compat_unext : forall {Z} (ora : Z) w w', ext_order w w' ->
-  ext_compat ora w' -> ext_compat ora w.
-Proof.
-  unfold ext_compat; intros.
-  apply rmap_order in H as (? & ? & ?).
-  eapply join_sub_joins_trans; eauto.
-Qed.
+Definition jsafeN (ge: genv) :=
+  jsafe(genv_symb := genv_symb_injective) (cl_core_sem ge) OK_spec ge.
 
 Inductive contx :=
 | Stuck
 | Cont: cont -> contx
 | Ret: option val -> cont -> contx.
 
-
-Definition assert_safe'_ 
-     (Espec : OracleKind)
-     (ge: genv) (f: function) (ve: env) (te: temp_env) (ctl: contx) (rho: environ) 
-     (w : rmap) :=
-       forall ora (jm:juicy_mem),
-       ext_compat ora w ->
-       rho = construct_rho (filter_genv ge) ve te ->
-       m_phi jm = w ->
-       forall (LW: level w > O),
+Definition assert_safe
+     (ge: genv) (E: coPset) (f: function) (ve: env) (te: temp_env) (ctl: contx) : assert :=
+      assert_of (fun rho =>
+       ∀ ora, (* ext_compat ora -> *)
+       ⌜rho = construct_rho (filter_genv ge) ve te⌝ →
        match ctl with
-       | Stuck => jm_fupd ora Ensembles.Full_set Ensembles.Full_set (fun _ => False) jm
+       | Stuck => |={E}=> False
        | Cont (Kseq s ctl') => 
-             jm_fupd ora Ensembles.Full_set Ensembles.Full_set (jsafeN (@OK_spec Espec) ge ora (State f s ctl' ve te)) jm
+             jsafeN ge E ora (State f s ctl' ve te)
        | Cont (Kloop1 body incr ctl') =>
-             jm_fupd ora Ensembles.Full_set Ensembles.Full_set (jsafeN (@OK_spec Espec) ge ora (State f Sskip (Kloop1 body incr ctl') ve te)) jm
+             jsafeN ge E ora (State f Sskip (Kloop1 body incr ctl') ve te)
        | Cont (Kloop2 body incr ctl') =>
-             jm_fupd ora Ensembles.Full_set Ensembles.Full_set (jsafeN (@OK_spec Espec) ge ora (State f (Sloop body incr) ctl' ve te)) jm
+             jsafeN ge E ora (State f (Sloop body incr) ctl' ve te)
        | Cont (Kcall id' f' ve' te' k') => 
-             jm_fupd ora Ensembles.Full_set Ensembles.Full_set (jsafeN (@OK_spec Espec) ge ora (State f (Sreturn None) (Kcall id' f' ve' te' k') ve te)) jm
+             jsafeN ge E ora (State f (Sreturn None) (Kcall id' f' ve' te' k') ve te)
        | Cont Kstop =>
-             jm_fupd ora Ensembles.Full_set Ensembles.Full_set (jsafeN (@OK_spec Espec) ge ora (State f (Sreturn None) Kstop ve te)) jm
-       | Cont _ => jm_fupd ora Ensembles.Full_set Ensembles.Full_set (fun _ => False) jm
+             jsafeN ge E ora (State f (Sreturn None) Kstop ve te)
+       | Cont _ => |={E}=> False
        | Ret None ctl' =>
-                jsafeN (@OK_spec Espec) ge ora (State f (Sreturn None) ctl' ve te) jm
-       | Ret (Some v) ctl' => forall e v',
-                  Clight.eval_expr ge ve te (m_dry jm) e v' ->
-                  Cop.sem_cast v' (typeof e) (fn_return f) (m_dry jm) = Some v ->
-              jsafeN (@OK_spec Espec) ge ora (State f (Sreturn (Some e)) ctl' ve te) jm
-       end.
-(* upd in assert_safe'_, everywhere except ret? *)
-
-Notation fupd := (fupd Ensembles.Full_set Ensembles.Full_set).
-
-Program Definition assert_safe
-     (Espec : OracleKind) (ge: genv) (f: function) (ve: env) (te: temp_env) 
-     (ctl: contx) : assert :=
-  fun rho => assert_safe'_ (Espec : OracleKind) ge f ve te ctl rho.
-Next Obligation.
-  split; repeat intro.
-   subst.
-   destruct (oracle_unage _ _ H) as [jm0 [? ?]].
-   specialize (H0 ora jm0).
-   spec H0.
-   { eapply ext_compat_unage; eauto. }
-   specialize (H0 (eq_refl _) H3).
-   spec H0. apply age_level in H. lia.
-  subst.
-  destruct ctl; [|destruct c|]; try (eapply jm_fupd_age; eauto).
-  destruct o; intros; auto;
-  eapply age_safe; eauto.
-  rewrite (age_jm_dry H2) in *.
-  eapply H0; eauto.
-
-  subst. destruct (ext_ord_juicy_mem' _ _ H) as (? & Hd & Ha).
-  destruct (proj1 (rmap_order _ _) H) as (Hl & Hr & Hg).
-  destruct (juicy_mem_resource jm a) as (jm0 & Hjm & Hdry).
-  { congruence. }
-  specialize (H0 ora jm0).
-   spec H0.
-   { eapply ext_compat_unext; eauto. }
-   specialize (H0 (eq_refl _) Hjm).
-   spec H0. rewrite Hl; auto.
-  subst.
-  rewrite <- Hjm in *.
-  assert (ext_order jm0 jm) by (split; auto; congruence).
-  destruct ctl; [|destruct c|];
-    try (eapply jm_fupd_ext; eauto; intros; eapply ext_safe; eauto).
-  destruct o; intros; auto;
-  eapply ext_safe; eauto.
-  rewrite Hdry in *; eapply H0; eauto.
-Qed.
-
-Lemma assert_safe_derives : forall (Espec : OracleKind) (ge ge': genv) (f f': function) (ve ve': env) (te te': temp_env)
-     (ctl ctl': contx) rho rho',
-  (forall w ora (jm:juicy_mem),
-       ext_compat ora w ->
-       rho' = construct_rho (filter_genv ge') ve' te' ->
-       m_phi jm = w ->
-       forall (LW: level w > O), rho = construct_rho (filter_genv ge) ve te /\
-      ((match ctl with
-       | Stuck => jm_fupd ora Ensembles.Full_set Ensembles.Full_set (fun _ => False) jm
-       | Cont (Kseq s ctl') => 
-             jm_fupd ora Ensembles.Full_set Ensembles.Full_set (jsafeN (@OK_spec Espec) ge ora (State f s ctl' ve te)) jm
-       | Cont (Kloop1 body incr ctl') =>
-             jm_fupd ora Ensembles.Full_set Ensembles.Full_set (jsafeN (@OK_spec Espec) ge ora (State f Sskip (Kloop1 body incr ctl') ve te)) jm
-       | Cont (Kloop2 body incr ctl') =>
-             jm_fupd ora Ensembles.Full_set Ensembles.Full_set (jsafeN (@OK_spec Espec) ge ora (State f (Sloop body incr) ctl' ve te)) jm
-       | Cont (Kcall id' f' ve' te' k') => 
-             jm_fupd ora Ensembles.Full_set Ensembles.Full_set (jsafeN (@OK_spec Espec) ge ora (State f (Sreturn None) (Kcall id' f' ve' te' k') ve te)) jm
-       | Cont Kstop =>
-             jm_fupd ora Ensembles.Full_set Ensembles.Full_set (jsafeN (@OK_spec Espec) ge ora (State f (Sreturn None) Kstop ve te)) jm
-       | Cont _ => jm_fupd ora Ensembles.Full_set Ensembles.Full_set (fun _ => False) jm
-       | Ret None ctl' =>
-                jsafeN (@OK_spec Espec) ge ora (State f (Sreturn None) ctl' ve te) jm
-       | Ret (Some v) ctl' => forall e v',
-                  Clight.eval_expr ge ve te (m_dry jm) e v' ->
-                  Cop.sem_cast v' (typeof e) (fn_return f) (m_dry jm) = Some v ->
-              jsafeN (@OK_spec Espec) ge ora (State f (Sreturn (Some e)) ctl' ve te) jm
-       end) ->
-       match ctl' with
-       | Stuck => jm_fupd ora Ensembles.Full_set Ensembles.Full_set (fun _ => False) jm
-       | Cont (Kseq s ctl') => 
-             jm_fupd ora Ensembles.Full_set Ensembles.Full_set (jsafeN (@OK_spec Espec) ge' ora (State f' s ctl' ve' te')) jm
-       | Cont (Kloop1 body incr ctl') =>
-             jm_fupd ora Ensembles.Full_set Ensembles.Full_set (jsafeN (@OK_spec Espec) ge' ora (State f' Sskip (Kloop1 body incr ctl') ve' te')) jm
-       | Cont (Kloop2 body incr ctl') =>
-             jm_fupd ora Ensembles.Full_set Ensembles.Full_set (jsafeN (@OK_spec Espec) ge' ora (State f' (Sloop body incr) ctl' ve' te')) jm
-       | Cont (Kcall id' f'' ve'' te'' k') => 
-             jm_fupd ora Ensembles.Full_set Ensembles.Full_set (jsafeN (@OK_spec Espec) ge' ora (State f' (Sreturn None) (Kcall id' f'' ve'' te'' k') ve' te')) jm
-       | Cont Kstop =>
-             jm_fupd ora Ensembles.Full_set Ensembles.Full_set (jsafeN (@OK_spec Espec) ge' ora (State f' (Sreturn None) Kstop ve' te')) jm
-       | Cont _ => jm_fupd ora Ensembles.Full_set Ensembles.Full_set (fun _ => False) jm
-       | Ret None ctl' =>
-                jsafeN (@OK_spec Espec) ge' ora (State f' (Sreturn None) ctl' ve' te') jm
-       | Ret (Some v) ctl' => forall e v',
-                  Clight.eval_expr ge' ve' te' (m_dry jm) e v' ->
-                  Cop.sem_cast v' (typeof e) (fn_return f') (m_dry jm) = Some v ->
-              jsafeN (@OK_spec Espec) ge' ora (State f' (Sreturn (Some e)) ctl' ve' te') jm
-       end)) ->
-  assert_safe Espec ge f ve te ctl rho |-- assert_safe Espec ge' f' ve' te' ctl' rho'.
-Proof.
-  repeat intro.
-  edestruct H as [? Hsafe]; eauto.
-  apply Hsafe, H0; auto.
+                jsafeN ge E ora (State f (Sreturn None) ctl' ve te)
+       | Ret (Some v) ctl' => ∀ e, (∀ m, mem_auth m -∗ ⌜∃ v', Clight.eval_expr ge ve te m e v' ∧ Cop.sem_cast v' (typeof e) (fn_return f) m = Some v⌝) →
+              (* Could we replace these with eval_expr and lose the memory dependence?
+                 Right now, the only difference is that e must only access pointers that are valid in the current rmap.
+                 But typechecking will also guarantee that. *)
+              jsafeN ge E ora (State f (Sreturn (Some e)) ctl' ve te)
+       end).
+
+Lemma assert_safe_mono ge E1 E2 f ve te ctl: E1 ⊆ E2 ->
+  assert_safe ge E1 f ve te ctl ⊢ assert_safe ge E2 f ve te ctl.
+Proof.
+  rewrite /assert_safe; split => ? /=.
+  iIntros "H" (? ->); iSpecialize ("H" $! _ eq_refl).
+  destruct ctl.
+  - iMod (fupd_mask_subseteq E1); first done; iMod "H" as "[]".
+  - destruct c; try by iApply jsafe_mask_mono.
+    iMod (fupd_mask_subseteq E1); first done; iMod "H" as "[]".
+  - destruct o; last by iApply jsafe_mask_mono.
+    iIntros (e); iSpecialize ("H" $! e).
+    iApply (bi.impl_intro_r with "H").
+    iIntros "H".
+    iPoseProof (bi.impl_elim_l with "H") as "?".
+    by iApply jsafe_mask_mono.
 Qed.
 
 Definition list2opt {T: Type} (vl: list T) : option T :=
@@ -203,17 +97,17 @@ Lemma guard_environ_e1:
      typecheck_environ Delta rho.
 Proof. intros. destruct H; auto. Qed.
 
-Definition _guard (Espec : OracleKind)
-    (gx: genv) (Delta: tycontext) (f: function) (P : assert) (ctl: contx) : pred nat :=
-     ALL tx : Clight.temp_env, ALL vx : env,
+Definition _guard
+    (gx: genv) E (Delta: tycontext) (f: function) (P : assert) (ctl: contx) : mpred :=
+     ∀ tx : Clight.temp_env, ∀ vx : env,
           let rho := construct_rho (filter_genv gx) vx tx in
-          !! guard_environ Delta f rho
-                  && P rho && funassert Delta rho
-             >=> assert_safe Espec gx f vx tx ctl rho.
+          ■ (⌜guard_environ Delta f rho⌝
+                  ∧ P rho ∗ funassert Delta rho
+             -∗ assert_safe gx E f vx tx ctl rho).
 
-Definition guard (Espec : OracleKind)
-    (gx: genv) (Delta: tycontext) f (P : assert)  (ctl: cont) : pred nat :=
-  _guard Espec gx Delta f P (Cont ctl).
+Definition guard'
+    (gx: genv) E (Delta: tycontext) f P  (ctl: cont) :=
+  _guard gx E Delta f P (Cont ctl).
 
 Fixpoint break_cont (k: cont) :=
 match k with
@@ -240,42 +134,20 @@ Definition exit_cont (ek: exitkind) (vl: option val) (k: cont) : contx :=
   | EK_return => Ret vl (call_cont k)
   end.
 
-Definition rguard (Espec : OracleKind)
-    (gx: genv) (Delta: tycontext) (f: function) (R : ret_assert) (ctl: cont) : pred nat :=
-  ALL ek: exitkind, ALL vl: option val,
-    _guard Espec gx Delta f (proj_ret_assert R ek vl)  (exit_cont ek vl ctl).
+Definition rguard
+    (gx: genv) E (Delta: tycontext) (f: function) (R : ret_assert) (ctl: cont) : mpred :=
+  ∀ ek: exitkind, ∀ vl: option val,
+    _guard gx E Delta f (proj_ret_assert R ek vl) (exit_cont ek vl ctl).
 
 Record semaxArg :Type := SemaxArg {
  sa_cs: compspecs;
+ sa_E: coPset;
  sa_Delta: tycontext;
  sa_P: assert;
  sa_c: statement;
  sa_R: ret_assert
 }.
 
-Program Definition ext_spec_pre' (Espec: OracleKind) (ef: external_function)
-   (x': ext_spec_type OK_spec ef) (ge_s: injective_PTree block)
-   (ts: list typ) (args: list val) (z: OK_ty) : pred juicy_mem :=
-  fun jm => ext_compat z (m_phi jm) -> ext_spec_pre OK_spec ef x' ge_s ts args z jm.
-Next Obligation.
-Proof.
-  split; repeat intro.
-  - eapply ext_compat_unage in H1; [|eapply age_jm_phi; eauto].
-    eapply JE_pre_hered; eauto.
-  - eapply JE_pre_ext, H0; auto.
-    destruct H; eapply ext_compat_unext; eauto.
-Qed.
-
-Program Definition ext_spec_post' (Espec: OracleKind)
-   (ef: external_function) (x': ext_spec_type OK_spec ef) (ge_s: injective_PTree block)
-   (tret: xtype) (ret: option val) (z: OK_ty) : pred juicy_mem :=
-  exist (fun p => hereditary age p /\ hereditary ext_order p)
-   (ext_spec_post OK_spec ef x' ge_s tret ret z)
-     (conj (JE_post_hered _ _ _ _ _ _ _ _) (JE_post_ext _ _ _ _ _ _ _ _) ).
-
-(*Definition juicy_mem_pred (P : pred rmap) (jm: juicy_mem): pred nat :=
-     # diamond fashionM (exactly (m_phi jm) && P).*)
-
 Definition make_ext_rval  (gx: genviron) (tret: xtype) (v: option val):=
   match tret with Xvoid => mkEnviron gx (Map.empty _) (Map.empty _) 
  | _ => 
@@ -285,40 +157,27 @@ Definition make_ext_rval  (gx: genviron) (tret: xtype) (v: option val):=
   | None => mkEnviron gx (Map.empty _) (Map.empty _)
   end end.
 
-(*Program Definition if_ext_compat {Z} (z : Z) (P : pred juicy_mem) : pred juicy_mem :=
-  fun jm => ext_compat z (m_phi jm) -> P jm.
-Next Obligation.
-Proof.
-  unfold ext_compat; split; repeat intro.
-  - eapply pred_hereditary, H0; auto.
-    erewrite age1_ghost_of in H1 by (apply age1_juicy_mem_Some; eauto).
-    apply ext_join_unapprox in H1; auto.
-  - eapply pred_upclosed, H0; auto.
-    rewrite rmap_order in H; destruct H as (_ & _ & _ & ?).
-    eapply join_sub_joins_trans; eauto.
-Qed.*)
-
 Definition semax_external
-  (Hspec: OracleKind) ef
+  ef
   (A: TypeTree)
-  (P: forall ts, dependent_type_functor_rec ts (ArgsTT A) mpred)
-  (Q: forall ts, dependent_type_functor_rec ts (AssertTT A) mpred):
-        pred nat :=
- ALL gx: genv, ALL Ts: list Type,
- ALL x: (dependent_type_functor_rec Ts A (pred rmap)),
-   |>  ALL F: pred rmap, ALL ts: list typ,
-   ALL args: list val,
-   !!Val.has_type_list args (map proj_xtype (sig_args (ef_sig ef))) &&
-   juicy_mem_op (P Ts x (filter_genv gx, args) * F) >=>
-   EX x': ext_spec_type OK_spec ef,
-    (ALL z:_, ext_spec_pre' Hspec ef x' (genv_symb_injective gx) ts args z) &&
-     ! ALL tret: xtype, ALL ret: option val, ALL z': OK_ty,
-      ext_spec_post' Hspec ef x' (genv_symb_injective gx) tret ret z' >=>
-          juicy_mem_op (Q Ts x (make_ext_rval (filter_genv gx) tret ret) * F).
+  (E: dtfr (MaskTT A))
+  (P: dtfr (ArgsTT A))
+  (Q: dtfr (AssertTT A)) :=
+ ∀ gx: genv,
+ ∀ x: dtfr A,
+   ▷ ∀ F (ts: list typ),
+   ∀ args: list val,
+   ■ (⌜Val.has_type_list args (map proj_xtype (sig_args (ef_sig ef)))⌝ ∧
+     (P x (filter_genv gx, args) ∗ F) ={E x}=∗
+   ∀ m z, state_interp m z -∗ ∃ x': ext_spec_type OK_spec ef,
+    ⌜ext_spec_pre OK_spec ef x' (genv_symb_injective gx) ts args z m⌝ ∧
+     (*□*) ∀ tret: xtype, ∀ ret: option val, ∀ m': mem, ∀ z': OK_ty,
+      ⌜ext_spec_post OK_spec ef x' (genv_symb_injective gx) tret ret z' m'⌝ → |={E x}=>
+          state_interp m' z' ∗ Q x (make_ext_rval (filter_genv gx) tret ret) ∗ F).
 
 Lemma Forall2_implication {A B} (P Q:A -> B -> Prop) (PQ:forall a b, P a b -> Q a b):
   forall l t, Forall2 P l t -> Forall2 Q l t.
-Proof. intros. induction H; constructor; auto. Qed.
+Proof. intros; eapply Forall2_impl; eauto. Qed.
 Lemma has_type_list_Forall2: forall vals ts, Val.has_type_list vals ts <-> Forall2 Val.has_type vals ts.
 Proof.
   induction vals; destruct ts; simpl; split; intros; trivial; try contradiction.
@@ -341,116 +200,84 @@ simpl; f_equal; auto.
 apply proj_xtype_argtype.
 Qed.
 
-
 Lemma semax_external_funspec_sub
-  (DISABLE: False)
-  {Espec argtypes rtype cc ef A1 P1 Q1 P1ne Q1ne A P Q Pne Qne}
-  (Hsub: funspec_sub (mk_funspec (argtypes, rtype) cc A1 P1 Q1 P1ne Q1ne) 
-                     (mk_funspec (argtypes, rtype) cc A P Q Pne Qne))
-  (HSIG: ef_sig ef = 
+  {argtypes rtype cc ef A1 E1 P1 Q1 A E P Q}
+  (Hsub: funspec_sub (mk_funspec (argtypes, rtype) cc A1 E1 P1 Q1)
+                     (mk_funspec (argtypes, rtype) cc A E P Q))
+  (HSIG: ef_sig ef =
          mksignature
                      (map argtype_of_type argtypes)
                      (rettype_of_type rtype) cc):
-  @semax.semax_external Espec ef A1 P1 Q1 |-- @semax.semax_external Espec ef A P Q.
-  (* This needs a fupd, but it's unclear how, since it's a pred nat. *)
-Proof.
-apply allp_derives; intros g.
-apply allp_right; intros ts.
-apply allp_right; intros x.
-destruct Hsub as [_ H]; simpl in H.
-intros n N m NM F typs vals y MY ? z YZ EZ [HT HP].
-simpl in HP.
-rewrite HSIG in HT; simpl in HT.
-eapply sepcon_derives, fupd_frame_r in HP; [| intros ??; eapply H; split; eauto | apply derives_refl].
-2: { clear -HT.
-  rewrite map_proj_xtype_argtype in HT. 
-  apply has_type_list_Forall2 in HT. simpl. red.
-  eapply Forall2_implication; [ | apply HT]; auto.
-}
-clear H. (*
-edestruct HP as (? & ? & z0 & ? & ? & ? & H); subst.
-{ eexists. rewrite ghost_fmap_core. apply join_comm, core_unit. }
-destruct H as [z1 [z2 [JZ [[ts1 [x1 [FRM [[z11 [z12 [JZ1 [H_FRM H_P1]]]] HQ]]]] Z2]]]].
-specialize (N ts1 x1). apply join_comm in JZ1.
-destruct (join_assoc JZ1 JZ) as [zz [JJ JJzz]]. apply join_comm in JJ.
-destruct (juicy_mem_resource _ _ H2) as (jm0 & ? & ?); subst.
-edestruct (N _ NM (sepcon F FRM) typs vals jm0) as [est [EST1 EST2]]; clear N; eauto.
-{ apply necR_level in YZ. destruct EZ as [_ EZ%ext_level]. rewrite !level_juice_level_phi in *. lia. }
-{ rewrite HSIG; simpl. split; trivial.
-  exists z12, zz; split3. trivial. trivial.
-  exists z2, z11; split3; trivial. }
-exists est; split.
-{ simpl. intros. apply EST1; auto. apply necR_trans with z; auto.*)
-contradiction DISABLE.  (* 
-    This lemma is not true as written because it needs a ghost-state
-    update operator somewhere.  
-*)
-  (*rewrite age_to.necR_age_to_iff. admit.
-simpl; intros.
-destruct (EST2 b b0 b1 _ H _ H0 H1) as [u1 [u2 [JU [U1 U2]]]]; clear EST2.
-destruct U2 as [w1 [w2 [JW [W1 W2]]]]. apply join_comm in JU.
-destruct (join_assoc JW JU) as [v [JV V]]. apply join_comm in V.
-exists v, w1; split3; trivial.
-apply HQ; clear HQ; split.
-+ simpl. destruct b,b0; reflexivity.
-+ exists w2, u1; split3; trivial.*)
+  semax_external ef A1 E1 P1 Q1 ⊢ semax_external ef A E P Q.
+Proof.
+  apply bi.forall_mono; intros g.
+  iIntros "#H" (x). iIntros "!>" (F ts args) "!> (%HT & P & F)".
+  destruct Hsub as [(? & ?) Hsub]; subst.
+  iMod (Hsub with "[$P]") as (x1 F1 HE1) "((F1 & P1) & %HQ)".
+  { iPureIntro; split; auto.
+    rewrite HSIG map_proj_xtype_argtype in HT; apply has_type_list_Forall2 in HT.
+    eapply Forall2_implication; [ | apply HT]; auto. }
+  iMod (fupd_mask_subseteq (E1 x1)) as "Hmask"; first done.
+  iMod ("H" $! _ (F ∗ F1) with "[$P1 $F $F1]") as "H1"; first done.
+  iMod "Hmask" as "_".
+  iIntros "!>" (??) "s".
+  iDestruct ("H1" with "s") as (x') "[? H']".
+  iExists x'; iFrame; iIntros (????) "Hpost".
+  iMod (fupd_mask_subseteq (E1 x1)) as "Hmask"; first done.
+  iMod ("H'" with "Hpost") as "($ & Q1 & $ & F1)".
+  iMod "Hmask" as "_".
+  iApply (HQ with "[$F1 $Q1]"); iPureIntro; split; auto.
+  destruct tret, ret; auto.
 Qed.
 
 Definition tc_option_val (sig: type) (ret: option val) :=
   match sig, ret with
-    | Tvoid, _ => True
+    | Tvoid, _ => True%type
     | ty, Some v => tc_val ty v
-    | _, _ => False
+    | _, _ => False%type
   end.
 
-Fixpoint zip_with_tl {A : Type} (l1 : list A) (l2 : list type) : list (A*type) :=
-  match l1, l2 with
-    | a::l1', cons b l2' => (a,b)::zip_with_tl l1' l2'
-    | _, _ => nil
-  end.
+Notation dtfr := (@dtfr Σ).
 
-Definition withtype_empty (A: TypeTree) : Prop :=
-  forall ts (x: dependent_type_functor_rec ts A (pred rmap)), False.
-Definition believe_external (Hspec: OracleKind) (gx: genv) (v: val) (fsig: typesig) cc
+Definition withtype_empty (A: TypeTree) : Prop := forall (x : dtfr A), False.
+Definition believe_external (gx: genv) (v: val) (fsig: typesig) cc
   (A: TypeTree)
-  (P: forall ts, dependent_type_functor_rec ts (ArgsTT A) mpred)
-  (Q: forall ts, dependent_type_functor_rec ts (AssertTT A) mpred):
-  pred nat :=
+  (E: dtfr (MaskTT A))
+  (P: dtfr (ArgsTT A))
+  (Q: dtfr (AssertTT A)) :=
   match Genv.find_funct gx v with
   | Some (External ef sigargs sigret cc') =>
-        !! (fsig = ( sigargs, sigret) /\ cc'=cc
+        ⌜fsig = (sigargs, sigret) /\ cc'=cc
            /\ ef_sig ef = mksignature
                            (map argtype_of_type (fst fsig))
                            (rettype_of_type (snd fsig)) cc
-           /\ (ef_inline ef = false \/ withtype_empty A))
-        && semax_external Hspec ef A P Q
-        && ! (ALL ts: list Type,
-              ALL x: dependent_type_functor_rec ts A (pred rmap),
-              ALL ret:option val,
-                Q ts x (make_ext_rval (filter_genv gx) (rettype_of_type (snd fsig)) ret)
-                  && !!Builtins0.val_opt_has_rettype ret (rettype_of_type (snd fsig))
-                  >=> !! tc_option_val sigret ret)
-  | _ => FF
+           /\ (ef_inline ef = false \/ withtype_empty A)⌝
+        ∧ semax_external ef A E P Q
+        ∧ ■ (∀ x: dtfr A,
+              ∀ ret:option val,
+                Q x (make_ext_rval (filter_genv gx) (rettype_of_type (snd fsig)) ret)
+                  ∧ ⌜Builtins0.val_opt_has_rettype ret (rettype_of_type (snd fsig))⌝
+                  -∗ ⌜tc_option_val sigret ret⌝)
+  | _ => False
   end.
 
-Lemma believe_external_funspec_sub {Espec gx v sig cc A P Q Pne Qne A' P' Q' Pne' Qne'}
-      (Hsub: funspec_sub (mk_funspec sig cc A P Q Pne Qne)(mk_funspec sig cc A' P' Q' Pne' Qne') )
+Lemma believe_external_funspec_sub {gx v sig cc A E P Q A' E' P' Q'}
+      (Hsub: funspec_sub (mk_funspec sig cc A E P Q) (mk_funspec sig cc A' E' P' Q'))
       (WTE: withtype_empty A -> withtype_empty A'):
-      believe_external Espec gx v sig cc A P Q |-- believe_external Espec gx v sig cc A' P' Q'.
+      believe_external gx v sig cc A E P Q ⊢ believe_external gx v sig cc A' E' P' Q'.
 Proof.
-  unfold believe_external; intros n N.
+  unfold believe_external.
   destruct (Genv.find_funct gx v); trivial.
   destruct f; trivial. destruct sig as [argtypes rtype].
-  destruct N as [[[N1a [N1b [N1c N1d]]] N2] N3].
-  inv N1a. simpl in N1c; split.
-+ split.
-  - split3; trivial. split; trivial.
-    destruct N1d; [ left; trivial | right; auto].
-  - eapply semax_external_funspec_sub; try eassumption.
-     admit.
-+ simpl; intros. simpl in N3. simpl in Hsub.
-  destruct Hsub as [_ Hsub].
-  specialize (Hsub b b0).
+  iIntros "((% & % & %He & %) & H & #Htc)".
+  rewrite semax_external_funspec_sub; [iFrame | eauto..].
+  iSplit.
+  - iPureIntro; repeat split; auto; tauto.
+  - iSplit; first done.
+    iIntros "!>" (??) "[Q %]".
+    destruct Hsub as [_ Hsub].
+    iApply "Htc"; iSplit; last done.
+    simpl in *; inv H.
 Abort.
 
 Definition fn_funsig (f: function) : funsig := (fn_params f, fn_return f).
@@ -458,372 +285,207 @@ Definition fn_funsig (f: function) : funsig := (fn_params f, fn_return f).
 Definition var_sizes_ok (cenv: composite_env) (vars: list (ident*type)) :=
    Forall (fun var : ident * type => @sizeof cenv (snd var) <= Ptrofs.max_unsigned)%Z vars.
 
-Definition var_block' (sh: Share.t) (cenv: composite_env) (idt: ident * type) (rho: environ): mpred :=
-  !! (sizeof (snd idt) <= Ptrofs.max_unsigned)%Z &&
-  (memory_block sh (sizeof (snd idt))) (eval_lvar (fst idt) (snd idt) rho).
+Definition var_block' (sh: Share.t) (cenv: composite_env) (idt: ident * type): assert :=
+  ⌜(sizeof (snd idt) <= Ptrofs.max_unsigned)%Z⌝ ∧
+  assert_of (fun rho => (memory_block sh (sizeof (snd idt))) (eval_lvar (fst idt) (snd idt) rho)).
 
 Definition stackframe_of' (cenv: composite_env) (f: Clight.function) : assert :=
-  fold_right (fun P Q rho => P rho * Q rho) (fun rho => emp)
+  fold_right bi_sep emp
      (map (fun idt => var_block' Share.top cenv idt) (Clight.fn_vars f)).
 
 Definition believe_internal_ CS
-  (semax:semaxArg -> pred nat)
+  (semax:semaxArg -> mpred)
   (gx: genv) (Delta: tycontext) v (fsig: typesig) cc (A: TypeTree)
-  (P: forall ts, dependent_type_functor_rec ts (ArgsTT A) mpred)
-  (Q: forall ts, dependent_type_functor_rec ts (AssertTT A) mpred) : pred nat :=
+  (E: dtfr (MaskTT A))
+  (P: dtfr (ArgsTT A))
+  (Q: dtfr (AssertTT A)) : mpred :=
   let ce := (@cenv_cs CS) in
-  (EX b: block, EX f: function,
+  (∃ b: Values.block, ∃ f: function,
    let specparams := fst fsig in 
    let fparams := fn_params f in
-   prop (v = Vptr b Ptrofs.zero /\ Genv.find_funct_ptr gx b = Some (Internal f)
+   ⌜v = Vptr b Ptrofs.zero /\ Genv.find_funct_ptr gx b = Some (Internal f)
                  /\ Forall (fun it => complete_type ce (snd it) = true) (fn_vars f)
                  /\ list_norepet (map fst fparams ++ map fst f.(fn_temps))
                  /\ list_norepet (map fst f.(fn_vars)) /\ var_sizes_ok ce (f.(fn_vars))
                  /\ specparams = map snd fparams
                  /\ snd fsig = snd (fn_funsig f)
-                 /\ f.(fn_callconv) = cc)
-  &&
-   ALL Delta':tycontext, ALL CS':compspecs,
-   imp (prop (forall f, tycontext_sub (func_tycontext' f Delta) (func_tycontext' f Delta')))
-     (imp (prop (cenv_sub (@cenv_cs CS) (@cenv_cs CS'))) 
-      (ALL ts: list Type,
-       ALL x : dependent_type_functor_rec ts A (pred rmap),
-        |> semax (SemaxArg CS' (func_tycontext' f Delta')
-                         (fun rho => (bind_args (f.(fn_params)) (P ts x) rho 
-                                              * stackframe_of' (@cenv_cs CS') f rho)
-                                        && funassert (func_tycontext' f Delta') rho)
+                 /\ f.(fn_callconv) = cc⌝
+  ∧
+   ∀ Delta':tycontext, ∀ CS':compspecs,
+   ⌜forall f, tycontext_sub (func_tycontext' f Delta) (func_tycontext' f Delta')⌝ →
+     ⌜cenv_sub (@cenv_cs CS) (@cenv_cs CS')⌝ →
+      (∀ x : dtfr A,
+        ▷ semax (SemaxArg CS' (E x) (func_tycontext' f Delta')
+                         ((bind_args (f.(fn_params)) (argsassert_of (P x)) ∗ stackframe_of' (@cenv_cs CS') f)
+                                        (*∗ funassert (func_tycontext' f Delta')*))
                           (f.(fn_body))
-           (frame_ret_assert (function_body_ret_assert (fn_return f) (Q ts x)) 
-              (stackframe_of' (@cenv_cs CS') f)))) )).
+           (frame_ret_assert (function_body_ret_assert (fn_return f) (assert_of (Q x)))
+              (stackframe_of' (@cenv_cs CS') f))))).
 
 Definition empty_environ (ge: genv) := mkEnviron (filter_genv ge) (Map.empty _) (Map.empty _).
 
-Definition claims (ge: genv) (Delta: tycontext) v fsig cc A P Q : Prop :=
-  exists id HP HQ, (glob_specs Delta)!id = Some (mk_funspec fsig cc A P Q HP HQ) /\
+Definition claims (ge: genv) (Delta: tycontext) v fsig cc A E P Q : Prop :=
+  exists id, (glob_specs Delta) !! id = Some (mk_funspec fsig cc A E P Q) /\
     exists b, Genv.find_symbol ge id = Some b /\ v = Vptr b Ptrofs.zero.
 
-Definition believepred CS (Espec: OracleKind) (semax: semaxArg -> pred nat)
-              (Delta: tycontext) (gx: genv)  (Delta': tycontext) : pred nat :=
-  ALL v:val, ALL fsig: typesig, ALL cc: calling_convention,
-  ALL A: TypeTree,
-  ALL P: forall ts, dependent_type_functor_rec ts (ArgsTT A) mpred,
-  ALL Q: forall ts, dependent_type_functor_rec ts (AssertTT A) mpred,
-       !! claims gx Delta' v fsig cc A P Q  -->
-      (believe_external Espec gx v fsig cc A P Q
-        || believe_internal_ CS semax gx Delta v fsig cc A P Q).
-
-Definition semax_ (Espec: OracleKind)
-       (semax: semaxArg -> pred nat) (a: semaxArg) : pred nat :=
- match a with SemaxArg CS Delta P c R =>
-  ALL gx: genv, ALL Delta': tycontext,ALL CS':compspecs,
-       !! (tycontext_sub Delta Delta' 
+Definition believepred CS (semax: semaxArg -> mpred)
+              (Delta: tycontext) (gx: genv)  (Delta': tycontext) :=
+  ∀ v:val, ∀ fsig: typesig, ∀ cc: calling_convention,
+  ∀ A: TypeTree,
+  ∀ E: dtfr (MaskTT A),
+  ∀ P: dtfr (ArgsTT A),
+  ∀ Q: dtfr (AssertTT A),
+       ⌜claims gx Delta' v fsig cc A E P Q⌝ →
+      (believe_external gx v fsig cc A E P Q
+        ∨ believe_internal_ CS semax gx Delta v fsig cc A E P Q).
+
+Definition semax_
+       (semax: semaxArg -d> iPropO Σ) : semaxArg -d> iPropO Σ := fun a =>
+ match a with SemaxArg CS E Delta P c R =>
+  ∀ gx: genv, ∀ Delta': tycontext,∀ CS':compspecs,
+       ⌜tycontext_sub Delta Delta' 
             /\ cenv_sub (@cenv_cs CS) (@cenv_cs CS') 
-            /\ cenv_sub (@cenv_cs CS') (genv_cenv gx)) -->
-      (believepred CS' Espec semax Delta' gx Delta') -->
-     ALL k: cont, ALL F: assert, ALL f:function,
-       (!! (closed_wrt_modvars c F) &&
-              rguard Espec gx Delta' f (frame_ret_assert R F) k) -->
-        guard Espec gx Delta' f (fun rho => F rho * P rho) (Kseq c k)
+            /\ cenv_sub (@cenv_cs CS') (genv_cenv gx)⌝ →
+      (believepred CS' semax Delta' gx Delta') →
+     ∀ k: cont, ∀ F: assert, ∀ f:function, ∀ E': coPset,
+       (⌜closed_wrt_modvars c F /\ E ⊆ E'⌝ ∧
+              rguard gx E' Delta' f (frame_ret_assert R F) k) →
+        guard' gx E' Delta' f (F ∗ P) (Kseq c k)
   end.
 
-Definition semax'  {CS: compspecs} (Espec: OracleKind) Delta P c R : pred nat :=
-     HORec (semax_ Espec) (SemaxArg CS Delta P c R).
+Local Instance semax_contractive : Contractive semax_.
+Proof.
+  rewrite /semax_ => n semax semax' Hsemax [??????].
+  do 8 f_equiv.
+  rewrite /believepred.
+  do 15 f_equiv.
+  rewrite /believe_internal_.
+  do 14 f_equiv.
+  by f_contractive.
+Qed.
 
-Definition believe_internal {CS: compspecs} (Espec:  OracleKind)
+Definition semax' {CS: compspecs} E Delta P c R : mpred :=
+  (fixpoint semax_) (SemaxArg CS E Delta P c R).
+
+Definition believe_internal {CS: compspecs}
   (gx: genv) (Delta: tycontext) v (fsig: typesig) cc (A: TypeTree)
-  (P: forall ts, dependent_type_functor_rec ts (ArgsTT A) mpred)
-  (Q: forall ts, dependent_type_functor_rec ts (AssertTT A) mpred): pred nat :=
+  (E: dtfr (MaskTT A))
+  (P: dtfr (ArgsTT A))
+  (Q: dtfr (AssertTT A)) :=
   let ce := @cenv_cs CS in
-  (EX b: block, EX f: function,
+  (∃ b: Values.block, ∃ f: function,
    let specparams := fst fsig in 
    let fparams := fn_params f in
-   prop (v = Vptr b Ptrofs.zero /\ Genv.find_funct_ptr gx b = Some (Internal f)
+   ⌜v = Vptr b Ptrofs.zero /\ Genv.find_funct_ptr gx b = Some (Internal f)
                  /\ Forall (fun it => complete_type ce (snd it) = true) (fn_vars f)
                  /\ list_norepet (map fst fparams ++ map fst f.(fn_temps))
                  /\ list_norepet (map fst f.(fn_vars)) /\ var_sizes_ok ce (f.(fn_vars))
                  /\ specparams = map snd fparams
                  /\ snd fsig = snd (fn_funsig f)
-                 /\ f.(fn_callconv) = cc)
-  && 
-    ALL Delta':tycontext,ALL CS':compspecs,
-     imp (prop (forall f, tycontext_sub (func_tycontext' f Delta) (func_tycontext' f Delta')))
-      (imp (prop (cenv_sub (@cenv_cs CS) (@cenv_cs CS')))
-       (ALL ts: list Type,
-     ALL x : dependent_type_functor_rec ts A (pred rmap),
-     |> @semax' CS' Espec (func_tycontext' f Delta')
-                                (fun rho => (bind_args (f.(fn_params)) (P ts x) rho * stackframe_of' (@cenv_cs CS') f rho)
-                                             && funassert (func_tycontext' f Delta') rho)
+                 /\ f.(fn_callconv) = cc⌝
+  ∧ 
+    ∀ Delta':tycontext,∀ CS':compspecs,
+     ⌜forall f, tycontext_sub (func_tycontext' f Delta) (func_tycontext' f Delta')⌝ →
+      ⌜cenv_sub (@cenv_cs CS) (@cenv_cs CS')⌝ →
+       (∀ x : dtfr A,
+     ▷ @semax' CS' (E x) (func_tycontext' f Delta')
+                                ((bind_args (f.(fn_params)) (argsassert_of (P x)) ∗ stackframe_of' (@cenv_cs CS') f)
+                                             (*∗ funassert (func_tycontext' f Delta')*))
                                (f.(fn_body))
-           (frame_ret_assert (function_body_ret_assert (fn_return f) (Q ts x)) (stackframe_of' (@cenv_cs CS') f))))).
-
-Definition believe {CS: compspecs} (Espec:OracleKind)
-              (Delta: tycontext) (gx: genv) (Delta': tycontext): pred nat :=
-  ALL v:val, ALL fsig: typesig, ALL cc: calling_convention,
-  ALL A: TypeTree,
-  ALL P: (forall ts, dependent_type_functor_rec ts (ArgsTT A) (pred rmap)),
-  ALL Q: (forall ts, dependent_type_functor_rec ts (AssertTT A) (pred rmap)),
-       !! claims gx Delta' v fsig cc A P Q  -->
-      (believe_external Espec gx v fsig cc A P Q
-        || believe_internal Espec gx Delta v fsig cc A P Q).
-
-Lemma semax_fold_unfold : forall {CS: compspecs} (Espec : OracleKind),
-  semax' Espec = fun Delta P c R =>
-  ALL gx: genv, ALL Delta': tycontext,ALL CS':compspecs,
-       !! (tycontext_sub Delta Delta'
+           (frame_ret_assert (function_body_ret_assert (fn_return f) (assert_of (Q x))) (stackframe_of' (@cenv_cs CS') f)))).
+
+Definition believe {CS: compspecs}
+              (Delta: tycontext) (gx: genv) (Delta': tycontext) :=
+  ∀ v:val, ∀ fsig: typesig, ∀ cc: calling_convention,
+  ∀ A: TypeTree,
+  ∀ E: dtfr (MaskTT A),
+  ∀ P: dtfr (ArgsTT A),
+  ∀ Q: dtfr (AssertTT A),
+       ⌜claims gx Delta' v fsig cc A E P Q⌝ →
+      (believe_external gx v fsig cc A E P Q
+        ∨ believe_internal gx Delta v fsig cc A E P Q).
+
+Lemma semax_fold_unfold : forall {CS: compspecs} E Delta P c R,
+  semax' E Delta P c R ⊣⊢
+  ∀ gx: genv, ∀ Delta': tycontext,∀ CS':compspecs,
+       ⌜(tycontext_sub Delta Delta'
            /\ cenv_sub (@cenv_cs CS) (@cenv_cs CS')
-           /\ cenv_sub (@cenv_cs CS') (genv_cenv gx)) -->
-       @believe CS' Espec Delta' gx Delta' -->
-     ALL k: cont, ALL F: assert, ALL f: function,
-        (!! (closed_wrt_modvars c F) && rguard Espec gx Delta' f (frame_ret_assert R F) k) -->
-        guard Espec gx Delta' f (fun rho => F rho * P rho) (Kseq c k).
+           /\ cenv_sub (@cenv_cs CS') (genv_cenv gx))⌝ →
+       @believe CS' Delta' gx Delta' →
+     ∀ k: cont, ∀ F: assert, ∀ f: function, ∀ E': coPset,
+        (⌜(closed_wrt_modvars c F) /\ E ⊆ E'⌝ ∧ rguard gx E' Delta' f (frame_ret_assert R F) k) →
+        guard' gx E' Delta' f (F ∗ P) (Kseq c k).
 Proof.
-intros ? ?.
-extensionality G P. extensionality c R.
-unfold semax'.
-pattern (HORec (semax_ Espec)) at 1; rewrite HORec_fold_unfold.
-reflexivity.
-apply prove_HOcontractive.
 intros.
-unfold semax_.
-clear.
-sub_unfold.
-do 3 (apply subp_allp; intros).
-apply subp_imp; [auto with contractive | ].
-apply subp_imp; [ | auto 50 with contractive].
-apply subp_allp; intros.
-apply subp_allp; intros.
-apply subp_allp; intros.
-apply subp_allp; intros.
-apply subp_allp; intros.
-apply subp_allp; intros.
-apply subp_imp; intros; [ auto 50 with contractive | ].
-apply subp_orp; [ auto 50 with contractive | ].
-apply subp_exp; intros.
-apply subp_exp; intros.
-auto 50 with contractive.
+unfold semax'.
+by rewrite (fixpoint_unfold semax_ _).
 Qed.
 
-Lemma semax'_cenv_sub {CS CS'} (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS')) Espec Delta P c R:
-      @semax' CS Espec Delta P c R |-- @semax' CS' Espec Delta P c R.
+Lemma semax'_cenv_sub {CS CS'} (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS')) E Delta P c R:
+      @semax' CS E Delta P c R ⊢ @semax' CS' E Delta P c R.
 Proof.
-  rewrite 2 semax_fold_unfold.
-  apply allp_derives; intros gx.
-  apply allp_derives; intros Delta'.
-  apply allp_derives; intros CS''.
-  apply imp_derives; auto.
-  intros ? [TC [M1 M2]].
-  split. apply TC. split; trivial. intros i. eapply sub_option_trans. apply CSUB. apply M1.
+  rewrite !semax_fold_unfold.
+  iIntros "H" (??? (? & ? & ?)); iApply "H"; iPureIntro.
+  split; auto; split; auto; apply (cenv_sub_trans CSUB); auto.
 Qed.
-Lemma semax'_cssub {CS CS'} (CSUB: cspecs_sub  CS CS') Espec Delta P c R:
-      @semax' CS Espec Delta P c R |-- @semax' CS' Espec Delta P c R.
+Lemma semax'_cssub {CS CS'} (CSUB: cspecs_sub  CS CS') E Delta P c R:
+      @semax' CS E Delta P c R ⊢ @semax' CS' E Delta P c R.
 Proof.
   destruct CSUB as [CSUB _].
   apply (@semax'_cenv_sub _ _ CSUB).
 Qed.
 
-Opaque semax'.
-
-Definition semax {CS: compspecs} (Espec: OracleKind) (Delta: tycontext) P c Q :=
-  forall n, semax' Espec Delta P c Q n.
-
-Lemma any_level_pred_nat: forall P: pred nat, (forall n, P n) <-> (TT |-- P).
-Proof.
-  intros.
-  split; intros.
-  + hnf; intros; auto.
-  + hnf in H; auto.
-Qed.
-
-Lemma fash_TT: forall {A} {agA: ageable A} {EO: Ext_ord A}, @unfash A agA EO TT = TT.
-Proof.
-intros.
-apply pred_ext; intros ? ?; apply I.
-Qed.
-
-Lemma allp_andp: 
-  forall {A} {NA: ageable A} {EO: Ext_ord A} {B: Type} (b0: B) (P: B -> pred A) (Q: pred A),
-   (allp P && Q = allp (fun x => P x && Q))%pred.
-Proof.
-intros.
-apply pred_ext.
-intros ? [? ?] b. split; auto.
-intros ? ?.
-split.
-intro b. apply (H b).
-apply (H b0).
-Qed.
-
-Lemma unfash_prop_imp:
-  forall {A} {agA: ageable A} {EO: Ext_ord A} (P: Prop) (Q: pred nat),
-  (@unfash _ agA _ (prop P --> Q) = prop P --> @unfash _ agA _ Q)%pred.
-Proof.
-intros.
-apply pred_ext; repeat intro.
-simpl in H; eapply H in H2; eauto.
-eapply pred_upclosed, pred_nec_hereditary; eauto.
-simpl in H.
-specialize (H a _ (necR_refl _)  (ext_refl _) H2).
-eapply pred_upclosed, pred_nec_hereditary; eauto.
-Qed.
-
-Import age_to.
-
-Lemma unfash_imp:
-  forall {A} {NA: ageable A} {EO: Ext_ord A} (P Q: pred nat),
-  (@unfash A _ _ (P --> Q) = (@unfash A _ _ P) --> @unfash A _ _ Q)%pred.
-Proof.
-intros.
-apply pred_ext; repeat intro.
-apply ext_level in H1.
-simpl in H; eapply H in H2; [| eapply necR_level', H0 | ..]; auto.
-simpl in *; subst a''.
-specialize (H (age_to a' a) _ (age_to_necR _ _) (ext_refl _)).
-apply necR_level in H0.
-rewrite level_age_to in H; auto.
-Qed.
-
-Lemma unfash_andp:  forall {A} {agA: ageable A} {EO: Ext_ord A} (P Q: pred nat),
-  (@unfash A agA _ (andp P Q) = andp (@unfash A agA _ P) (@unfash A agA _ Q)).
-Proof.
-intros.
-apply pred_ext.
-intros ? ?.
-destruct H.
-split; auto.
-intros ? [? ?].
-split; auto.
-Qed.
-
-Lemma andp_imp_e':
-  forall (A : Type) (agA : ageable A) (EO: Ext_ord A) (P Q : pred A),
-   P && (P --> Q) |-- P && Q.
-Proof.
-intros.
-apply andp_right.
-apply andp_left1; auto.
-intros ? [? ?].
-eapply H0; auto.
-Qed.
-
-Lemma unfash_fash:
-  forall (A : Type) (agA : ageable A) (EO : Ext_ord A) (P : pred A),
-   unfash (fash P) |-- P.
-Proof.
-  intros.
-  unfold fash, unfash.
-  simpl.
-  hnf; simpl; intros.
-  apply (H a).
-  lia.
-Qed.
-
-Lemma imp_imp:
-  forall (A : Type) (agA : ageable A) (EO : Ext_ord A) (P Q R: pred A),
-    P --> (Q --> R) = P && Q --> R.
-Proof.
-  intros.
-  apply pred_ext.
-  + apply imp_andp_adjoint.
-    rewrite <- andp_assoc.
-    apply imp_andp_adjoint.
-    rewrite andp_comm.
-    eapply derives_trans; [apply andp_imp_e' | apply andp_left2].
-    auto.
-  + rewrite <- !imp_andp_adjoint.
-    rewrite andp_assoc.
-    rewrite imp_andp_adjoint.
-    auto.
-Qed.
-
-Lemma imp_allp:
-  forall B (A : Type) (agA : ageable A) (EO : Ext_ord A) (P: pred A) (Q: B -> pred A),
-    P --> allp Q  = ALL x: B, P --> Q x.
-Proof.
-  intros.
-  apply pred_ext.
-  + apply allp_right; intros x.
-    rewrite <- imp_andp_adjoint, andp_comm.
-    eapply derives_trans; [apply andp_imp_e' |].
-    apply andp_left2.
-    apply (allp_left _ x).
-    auto.
-  + rewrite <- imp_andp_adjoint.
-    apply allp_right; intros x.
-    rewrite imp_andp_adjoint.
-    apply (allp_left _ x).
-    auto.
-Qed.
-
-Lemma fash_prop: forall P: Prop,
-  fash (!! P: pred rmap) = !! P.
-Proof.
-  intros.
-  apply pred_ext; unfold fash; hnf; simpl; intros.
-  + destruct (ex_level a) as [r ?].
-    apply (H r).
-    lia.
-  + auto.
-Qed.
+Definition semax {CS: compspecs} E (Delta: tycontext) P c Q : Prop :=
+  ⊢ @semax' CS E Delta P c Q.
 
-Lemma fash_unfash:
-  forall (P : pred nat),
-   fash (unfash P: pred rmap) = P.
-Proof.
-  intros.
-  unfold fash, unfash.
-  apply pred_ext; hnf; simpl; intros.
-  + destruct (ex_level a) as [r ?].
-    specialize (H r).
-    rewrite H0 in H.
-    apply H; lia.
-  + eapply pred_nec_hereditary; [| eassumption].
-    rewrite nec_nat; lia.
-Qed.
+Section believe_monotonicity.
+Context {CS: compspecs}.
 
-Lemma prop_true_imp:
-  forall (P: Prop) (Q: pred rmap),
-    P -> !! P --> Q = Q.
+Lemma _guard_mono gx E Delta Gamma f (P Q:assert) ctl
+  (GD1: forall e te, typecheck_environ Gamma (construct_rho (filter_genv gx) e te) ->
+                     typecheck_environ Delta (construct_rho (filter_genv gx) e te))
+  (GD2: ret_type Delta = ret_type Gamma)
+  (GD3: forall e te, Q (construct_rho (filter_genv gx) e te) ⊢
+                        P (construct_rho (filter_genv gx) e te))
+  (GD4: forall e te, (funassert Gamma (construct_rho (filter_genv gx) e te)) ⊢
+                     (funassert Delta (construct_rho (filter_genv gx) e te))):
+  @_guard gx E Delta f P ctl ⊢
+  @_guard gx E Gamma f Q ctl.
 Proof.
-  intros.
-  apply pred_ext.
-  + rewrite <- (True_andp_eq P (!! P --> Q)) by auto.
-    eapply derives_trans; [apply andp_imp_e' |].
-    apply andp_left2; auto.
-  + apply imp_andp_adjoint.
-    apply andp_left1.
-    auto.
+  rewrite /_guard.
+  iIntros "#H" (??) "!> (% & Q & ?)"; iApply "H".
+  iSplit.
+  - iPureIntro; unfold guard_environ in *.
+    destruct H as (? & ? & ?); rewrite GD2; auto.
+  - rewrite GD3 GD4; iFrame.
 Qed.
 
-Section believe_monotonicity.
-Context {CS: compspecs} {Espec: OracleKind}.
-
-Lemma guard_mono gx Delta Gamma f (P Q:assert) ctl
+Lemma guard_mono gx E Delta Gamma f (P Q:assert) ctl
   (GD1: forall e te, typecheck_environ Gamma (construct_rho (filter_genv gx) e te) ->
                      typecheck_environ Delta (construct_rho (filter_genv gx) e te))
   (GD2: ret_type Delta = ret_type Gamma)
-  (GD3: forall e te, Q (construct_rho (filter_genv gx) e te) |--
+  (GD3: forall e te, Q (construct_rho (filter_genv gx) e te) ⊢
                         P (construct_rho (filter_genv gx) e te))
-  (GD4: forall e te, (funassert Gamma (construct_rho (filter_genv gx) e te)) |--
+  (GD4: forall e te, (funassert Gamma (construct_rho (filter_genv gx) e te)) ⊢
                      (funassert Delta (construct_rho (filter_genv gx) e te))):
-  @guard Espec gx Delta f P ctl |--
-  @guard Espec gx Gamma f Q ctl.
-Proof. intros n G te e r R ? a' A' ? [[[X1 X2] X3] X4].
-  eapply G; eauto.
-  split; [split; [split;[auto | rewrite GD2; trivial] | apply GD3; trivial] | apply GD4; trivial].
+  @guard' gx E Delta f P ctl ⊢
+  @guard' gx E Gamma f Q ctl.
+Proof.
+  by apply _guard_mono.
 Qed.
 
-Lemma claims_antimono gx Gamma v sig cc A P Q Gamma' 
-  (SUB: forall id spec, (glob_specs Gamma') ! id = Some spec ->
-                        (glob_specs Gamma) ! id = Some spec)
-  (CL: claims gx Gamma' v sig cc A P Q):
-  claims gx Gamma v sig cc A P Q.
-Proof. destruct CL as[id [HP [HQ [Hid X]]]]; exists id, HP, HQ; split; auto. Qed.
+Lemma claims_antimono gx Gamma v sig cc E A P Q Gamma' 
+  (SUB: forall id spec, (glob_specs Gamma') !! id = Some spec ->
+                        (glob_specs Gamma) !! id = Some spec)
+  (CL: claims gx Gamma' v sig cc E A P Q):
+  claims gx Gamma v sig cc E A P Q.
+Proof. destruct CL as [id [Hid X]]; exists id; split; auto. Qed.
 
 Lemma believe_antimonoR gx Delta Gamma Gamma'
-  (DG1: forall id spec, (glob_specs Gamma') ! id = Some spec ->
-                        (glob_specs Gamma) ! id = Some spec):
-  @believe CS Espec Delta gx Gamma |-- @believe CS Espec Delta gx Gamma'.
-Proof. intros n B v sig cc A P Q ? k nec ? CL. eapply B; eauto. eapply claims_antimono; eauto. Qed.
+  (DG1: forall id spec, (glob_specs Gamma') !! id = Some spec ->
+                        (glob_specs Gamma) !! id = Some spec):
+  @believe CS Delta gx Gamma ⊢ @believe CS Delta gx Gamma'.
+Proof. rewrite /believe. iIntros "H" (????????); iApply "H". iPureIntro; eapply claims_antimono; eauto. Qed.
 
 Lemma cenv_sub_complete_legal_cosu_type cenv1 cenv2 (CSUB: cenv_sub cenv1 cenv2): forall t,
     @composite_compute.complete_legal_cosu_type cenv1 t = true ->
@@ -831,133 +493,151 @@ Lemma cenv_sub_complete_legal_cosu_type cenv1 cenv2 (CSUB: cenv_sub cenv1 cenv2)
 Proof.
   induction t; simpl; intros; auto. 
   + specialize (CSUB i). red in CSUB.
-    destruct (cenv1 ! i); [rewrite CSUB; trivial | inv H].
+    destruct (Maps.PTree.get i cenv1); [rewrite CSUB; trivial | inv H].
   + specialize (CSUB i). red in CSUB.
-    destruct (cenv1 ! i); [rewrite CSUB; trivial | inv H].
+    destruct (Maps.PTree.get i cenv1); [rewrite CSUB; trivial | inv H].
 Qed.
 
 Lemma complete_type_cenv_sub {ce ce'} (C: cenv_sub ce ce') t (T:complete_type ce t = true):
   complete_type ce' t = true.
-Proof. apply (complete_type_stable ce ce'); trivial. intros. specialize (C id). rewrite H in C; apply C.
+Proof. apply (complete_type_stable ce ce'); trivial. intros. specialize (C id). setoid_rewrite H in C; apply C.
 Qed.
 Lemma complete_type_cspecs_sub {cs cs'} (C: cspecs_sub cs cs') t (T:complete_type (@cenv_cs cs) t = true):
   complete_type (@cenv_cs cs') t = true.
 Proof. destruct C. apply (complete_type_cenv_sub H _ T). Qed.
 
-Lemma believe_internal_cenv_sub {CS'} gx Delta Delta' v sig cc A P Q
+Lemma believe_internal_cenv_sub {CS'} gx Delta Delta' v sig cc A E P Q
   (SUB: forall f, tycontext_sub (func_tycontext' f Delta)
-                                (func_tycontext' f Delta')) k
-  (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS'))
-  (BI: @believe_internal CS Espec gx Delta v sig cc A P Q k):
-  @believe_internal CS' Espec gx Delta' v sig cc A P Q k.
-Proof. destruct BI as [b [f [Hv X]]]. 
-  exists b, f; split; [clear X | clear Hv].
-  - simpl; simpl in Hv. intuition.
-    + eapply Forall_impl. 2: apply H0. simpl; intros.
-       apply (complete_type_cenv_sub CSUB); auto.
-    + clear - CSUB H0 H4. forget (fn_vars f) as vars. induction vars.
-      constructor. inv H4. inv H0.  specialize (IHvars H5 H3).
-      constructor; [ rewrite (cenv_sub_sizeof CSUB); trivial | apply IHvars].
-  - intros PSI CS'' ? w W ? HSUB ? u WU ? HU ts x. eapply X; eauto.
-    + simpl; intros. eapply tycontext_sub_trans. 2: apply HSUB. eauto.
-    + clear - CSUB HU; simpl. apply (cenv_sub_trans CSUB HU).
-Qed.
-Lemma believe_internal_mono {CS'} gx Delta Delta' v sig cc A P Q
+                                (func_tycontext' f Delta'))
+  (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS')) :
+  @believe_internal CS gx Delta v sig cc A E P Q ⊢
+  @believe_internal CS' gx Delta' v sig cc A E P Q.
+Proof.
+  rewrite /believe_internal.
+  iIntros "H"; iDestruct "H" as (b f Hv) "H".
+  iExists b, f; iSplit.
+  - iPureIntro; intuition.
+    + eapply Forall_impl. apply H0. simpl; intros.
+      apply (complete_type_cenv_sub CSUB); auto.
+    + rewrite /var_sizes_ok !Forall_forall in H0 H4 |- *; intros.
+      rewrite (cenv_sub_sizeof CSUB); eauto.
+  - iIntros (?????); iApply ("H" with "[%] [%]").
+    + simpl; intros. eapply tycontext_sub_trans; eauto.
+    + apply (cenv_sub_trans CSUB); auto.
+Qed.
+Lemma believe_internal_mono {CS'} gx Delta Delta' v sig cc A E P Q
   (SUB: forall f, tycontext_sub (func_tycontext' f Delta)
-                                (func_tycontext' f Delta')) k
-  (CSUB: cspecs_sub  CS CS')
-  (BI: @believe_internal CS Espec gx Delta v sig cc A P Q k):
-  @believe_internal CS' Espec gx Delta' v sig cc A P Q k.
+                                (func_tycontext' f Delta'))
+  (CSUB: cspecs_sub  CS CS') :
+  @believe_internal CS gx Delta v sig cc A E P Q ⊢
+  @believe_internal CS' gx Delta' v sig cc A E P Q.
 Proof.
   destruct CSUB as [CSUB _].
-  eapply (@believe_internal_cenv_sub CS'). apply SUB. apply CSUB. apply BI.
+  eapply (@believe_internal_cenv_sub CS'). apply SUB. apply CSUB.
 Qed. 
 
 Lemma believe_cenv_sub_L {CS'} gx Delta Delta' Gamma
   (SUB: forall f, tycontext_sub (func_tycontext' f Delta)
                                 (func_tycontext' f Delta'))
   (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS')):
-  @believe CS Espec Delta gx Gamma |-- @believe CS' Espec Delta' gx Gamma.
+  @believe CS Delta gx Gamma ⊢ @believe CS' Delta' gx Gamma.
 Proof.
- intros n B; repeat intro.
- edestruct B; eauto.
-+ left; trivial.
-+ right. clear -SUB CSUB H H2.
-  apply (@believe_internal_cenv_sub CS' gx Delta); eauto.
+  rewrite /believe.
+  iIntros "H" (????????); iDestruct ("H" with "[%]") as "[?|?]"; eauto.
+  iRight; by iApply (believe_internal_cenv_sub with "[$]").
 Qed.
 Lemma believe_monoL {CS'} gx Delta Delta' Gamma
   (SUB: forall f, tycontext_sub (func_tycontext' f Delta)
                                 (func_tycontext' f Delta'))
-  (CSUB: cspecs_sub  CS CS'):
-  @believe CS Espec Delta gx Gamma |-- @believe CS' Espec Delta' gx Gamma.
+  (CSUB: cspecs_sub CS CS'):
+  @believe CS Delta gx Gamma ⊢ @believe CS' Delta' gx Gamma.
 Proof.
   destruct CSUB as [CSUB _].
   eapply (@believe_cenv_sub_L CS'). apply SUB. apply CSUB.
 Qed.
 
-Lemma believe_internal__mono sem gx Delta Delta' v sig cc A P Q
+Lemma believe_internal__mono sem gx Delta Delta' v sig cc A E P Q
   (SUB: forall f, tycontext_sub (func_tycontext' f Delta)
-                                (func_tycontext' f Delta')) k
-  (BI: believe_internal_ CS sem gx Delta v sig cc A P Q k):
-(believe_internal_ CS sem gx Delta' v sig cc A P Q) k.
-Proof. destruct BI as [b [f [Hv X]]].
-  exists b, f; split; [trivial | clear Hv].
-  intros PSI CS' ? w W ? HSUB u WU HU ts x. eapply X; eauto.
-  simpl; intros. eapply tycontext_sub_trans. 2: apply HSUB. eauto.
+                                (func_tycontext' f Delta')) :
+  believe_internal_ CS sem gx Delta v sig cc A E P Q ⊢
+  believe_internal_ CS sem gx Delta' v sig cc A E P Q.
+Proof.
+  rewrite /believe_internal_.
+  iIntros "H"; iDestruct "H" as (b f Hv) "H".
+  iExists b, f; iSplit; first trivial.
+  iIntros (?????); iApply ("H" with "[%] [%]"); last done.
+  simpl; intros. eapply tycontext_sub_trans; eauto.
 Qed.
+
 End believe_monotonicity.
 
-Lemma semax__mono {CS} Espec Delta Delta'
+Lemma semax__mono {CS} E Delta Delta'
   (SUB: tycontext_sub Delta Delta') sem P c R:
-  derives (@semax_ Espec sem {| sa_cs := CS; sa_Delta := Delta; sa_P := P; sa_c := c; sa_R := R |})
-      (@semax_ Espec sem {| sa_cs:=CS; sa_Delta := Delta'; sa_P := P; sa_c := c; sa_R := R |}).
-Proof. unfold semax_.
-  repeat (apply allp_derives; intros).
-  eapply imp_derives; auto.
-  intros ? [HSUB HCS]; split; auto.
+  @semax_ sem {| sa_cs := CS; sa_E := E; sa_Delta := Delta; sa_P := P; sa_c := c; sa_R := R |} ⊢
+  @semax_ sem {| sa_cs := CS; sa_E := E; sa_Delta := Delta'; sa_P := P; sa_c := c; sa_R := R |}.
+Proof.
+  unfold semax_.
+  iIntros "H" (??? (? & ? & ?)).
+  iApply "H"; iPureIntro; split; auto.
   eapply tycontext_sub_trans; eauto.
 Qed.
 
-Lemma semax_mono {CS} Espec Delta Delta' P Q
+Lemma semax_mono {CS} E Delta Delta' P Q
   (SUB: tycontext_sub Delta Delta') c:
-  @semax' CS Espec Delta P c Q |--
-   @semax' CS Espec Delta' P c Q.
+  @semax' CS E Delta P c Q ⊢
+  @semax' CS E Delta' P c Q.
 Proof.
-rewrite semax_fold_unfold in *.
-  repeat (apply allp_derives; intros).
-  eapply imp_derives; auto.
-  intros ? [HSUB HCS]; split; auto.
+  rewrite !semax_fold_unfold.
+  iIntros "H" (??? (? & ? & ?)).
+  iApply "H"; iPureIntro; split; auto.
   eapply tycontext_sub_trans; eauto.
 Qed.
 
-Lemma semax_mono_box {CS} Espec Delta Delta' P Q
-  (SUB: tycontext_sub Delta Delta') c w
-  (BI: @box nat ag_nat _ (@laterM nat ag_nat _)
-          (@semax' CS Espec Delta P c Q) w):
-  @box nat ag_nat _ (@laterM nat ag_nat _)
-          (@semax' CS Espec Delta' P c Q) w.
-Proof. eapply box_positive; [ clear BI | apply BI].
-intros a Hyp.
-eapply semax_mono; eassumption.
+Lemma semax_cenv_sub {CS CS'} (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS')) E Delta P c R:
+      @semax CS E Delta P c R -> @semax CS' E Delta P c R.
+Proof.
+  by rewrite /semax -(semax'_cenv_sub CSUB).
+Qed.
+Lemma semax_cssub {CS CS'} (CSUB: cspecs_sub  CS CS') E Delta P c R:
+      @semax CS E Delta P c R -> @semax CS' E Delta P c R.
+Proof.
+  by rewrite /semax -(semax'_cssub CSUB).
 Qed.
 
-(*In fact, the following specialization suffices in semax_prog*)
-Lemma semax_mono' {CS} Espec Delta Delta' P Q
-  (SUB: forall f, tycontext_sub (func_tycontext' f Delta)
-                                (func_tycontext' f Delta')) c w f
-  (BI: @box nat ag_nat _ (@laterM nat ag_nat _)
-          (@semax' CS Espec (func_tycontext' f Delta) P c Q) w):
-  @box nat ag_nat _ (@laterM nat ag_nat _)
-          (@semax' CS Espec (func_tycontext' f Delta') P c Q) w.
-Proof. eapply semax_mono_box. eauto. eassumption. Qed.
-
-Lemma semax_cenv_sub {CS CS'} (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS')) Espec Delta P c R:
-      @semax CS Espec Delta P c R -> @semax CS' Espec Delta P c R.
+Lemma guard_mask_mono gx E E' Delta f P c
+  (SUB: E ⊆ E'):
+  guard' gx E Delta f P c ⊢ guard' gx E' Delta f P c.
+Proof.
+  rewrite /guard' /_guard.
+  iIntros "#H" (??) "!> (% & Q & ?)".
+  rewrite -assert_safe_mono //.
+  iApply "H"; by iFrame.
+Qed.
+
+Lemma semax_mask_mono {CS} E E' Delta P Q
+  (SUB: E ⊆ E') c:
+  @semax' CS E Delta P c Q ⊢
+  @semax' CS E' Delta P c Q.
 Proof.
-  intros. intros n. apply (semax'_cenv_sub CSUB); trivial. 
+  rewrite !semax_fold_unfold.
+  iIntros "H" (??? (? & ? & ?)).
+  iSpecialize ("H" with "[%]"); first done.
+  iApply (bi.impl_mono with "H"); first done.
+  iIntros "H" (????) "((% & %) & ?)".
+  iApply "H"; iFrame.
+  iPureIntro; split; last done; split; [done | set_solver].
 Qed.
-Lemma semax_cssub {CS CS'} (CSUB: cspecs_sub  CS CS') Espec Delta P c R:
-      @semax CS Espec Delta P c R -> @semax CS' Espec Delta P c R.
+
+Lemma believe_internal_mask_mono {CS} gx Delta v sig cc A (E E' : dtfr (MaskTT A)) P Q
+  (SUB: forall x, E x ⊆ E' x) :
+  believe_internal(CS := CS) gx Delta v sig cc A E P Q ⊢
+  believe_internal gx Delta v sig cc A E' P Q.
 Proof.
-  intros. intros n. apply (semax'_cssub CSUB); trivial. 
+  rewrite /believe_internal.
+  iIntros "H"; iDestruct "H" as (b f Hv) "H".
+  iExists b, f; iSplit; first done.
+  iIntros (?????).
+  iApply semax_mask_mono; first apply SUB; iApply ("H" with "[%] [%]"); done.
 Qed.
+
+End mpred.
diff --git a/veric/semax_call.v b/veric/semax_call.v
index 5905e6b471..064ecdc866 100644
--- a/veric/semax_call.v
+++ b/veric/semax_call.v
@@ -1,11 +1,12 @@
 Require Import Coq.Logic.FunctionalExtensionality.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.juicy_base.
-Require Import VST.msl.normalize.
-Require Import VST.veric.juicy_mem VST.veric.juicy_mem_lemmas VST.veric.juicy_mem_ops.
 Require Import VST.veric.res_predicates.
+Require Import VST.veric.external_state.
 Require Import VST.veric.extend_tc.
 Require Import VST.veric.Clight_seplog.
 Require Import VST.veric.Clight_assert_lemmas.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.Clight_core.
 Require Import VST.sepcomp.extspec.
 Require Import VST.sepcomp.step_lemmas.
@@ -16,336 +17,65 @@ Require Import VST.veric.expr.
 Require Import VST.veric.expr2.
 Require Import VST.veric.expr_lemmas.
 Require Import VST.veric.expr_lemmas4.
+Require Import VST.veric.juicy_mem VST.veric.juicy_mem_lemmas.
 Require Import VST.veric.semax.
 Require Import VST.veric.semax_lemmas.
 Require Import VST.veric.Clight_lemmas.
+Require Import VST.veric.semax_conseq.
 Import LiftNotation.
-Import compcert.lib.Maps.
-Local Open Scope pred.
 
-(* up *)
-Lemma sepcon_andp_unfash {A}{JA: Join A}{PA: Perm_alg A}{agA: ageable A}{SA: Sep_alg A}{aaA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}:
-     forall (P: pred A) (Q: pred nat) (R: pred A), P * (! Q && R) = ! Q && (P * R).
-Proof.
-  intros; apply pred_ext.
-  - intros ? (? & ? & J & ? & []); split; simpl in *; eauto.
-    apply join_level in J as [? <-]; auto.
-  - rewrite unfash_sepcon_distrib; apply sepcon_derives; auto.
-    apply andp_left2; auto.
-Qed.
-
-Lemma age_later {A} {agA : ageable A}: forall {w w1 w2} (AGE: age w w1) (L: laterR w w2), w1=w2 \/ laterR w1 w2.
-Proof. intros. induction L.
-+ unfold age in *. rewrite AGE in H. left; inv H; trivial.
-+ right. destruct (IHL1 AGE); subst. apply L2. eapply t_trans; eassumption.
-Qed.
+Section mpred.
 
-Lemma tc_val_sem_cast':
-  forall {cs: compspecs} t2 e2 rho Delta,
-      @typecheck_environ Delta rho ->
-      @denote_tc_assert cs (@typecheck_expr cs Delta e2) rho
-     &&  @denote_tc_assert cs (@isCastResultType cs (typeof e2) t2  e2) rho
-     |-- !! @tc_val t2 (force_val (sem_cast (typeof e2) t2 (eval_expr e2 rho))).
-Proof.
-intros.
-intro phi.
-intros [? ?].
-eapply expr_lemmas.tc_val_sem_cast; eauto.
-Qed.
+Context `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs}.
 
-Lemma typecheck_expr_sound' {cs: compspecs} :
-  forall Delta rho e,
-    @typecheck_environ Delta rho ->
-    @tc_expr cs Delta e rho |-- !! @tc_val (typeof e) (eval_expr e rho).
+Lemma typecheck_expr_sound' :
+  forall {CS'} Delta rho e,
+    typecheck_environ Delta rho ->
+    tc_expr(CS := CS') Delta e rho ⊢ ⌜tc_val (typeof e) (eval_expr e rho)⌝.
 Proof.
-intros.
-intros ? ?.
-simpl.
-eapply expr_lemmas4.typecheck_expr_sound; eauto.
+  intros; apply typecheck_expr_sound; done.
 Qed.
 
 Lemma tc_environ_make_args':
- forall {CS: compspecs} argsig retsig bl rho Delta,
-   tc_environ Delta rho ->
+ forall argsig retsig bl rho Delta
+   (Htc : tc_environ Delta rho),
   tc_exprlist Delta (snd (split argsig)) bl rho
-  |-- !! tc_environ (funsig_tycontext (argsig, retsig)) (make_args (map fst argsig)
-         (eval_exprlist (snd (split argsig)) bl rho) rho).
+  ⊢ ⌜tc_environ (funsig_tycontext (argsig, retsig)) (make_args (map fst argsig)
+         (eval_exprlist (snd (split argsig)) bl rho) rho)⌝.
 Proof.
-intros. rename H into H2.
-unfold tc_environ.
-simpl.
-unfold tc_exprlist.
-revert bl; induction argsig; destruct bl as [ | b bl]; simpl; intros; unfold_lift.
-* hnf; intros. clear H.
-  split3; hnf; intros; try (simpl in *; rewrite PTree.gempty in H; inv H).
-  rewrite PTree.gempty. split; intro. inv H. destruct H. inv H.
-* apply prop_derives; intros. inv H.
-* destruct a as [i ti]; simpl.
-  destruct (split argsig) eqn:?.
-  simpl.
-  unfold_lift; apply prop_derives; intros; inv H.
-* destruct a as [i ti]; simpl.
-  destruct (split argsig) eqn:?.
-  specialize (IHargsig bl).
-  simpl denote_tc_assert.
-  rewrite !denote_tc_assert_andp.
-  simpl andp.
-  unfold_lift.
-  apply derives_trans with
-   (denote_tc_assert (typecheck_expr Delta b) rho &&
-   denote_tc_assert (isCastResultType (typeof b) ti b) rho &&
-   (!! typecheck_environ (funsig_tycontext (argsig, retsig))
-                    (make_args (map fst argsig)
-                       (eval_exprlist l0 bl rho) rho))).
-  apply andp_derives; auto.
-  clear IHargsig.
-  simpl. unfold_lift.
-  normalize.
-  destruct H as [? [? ?]].
-  unfold typecheck_environ; simpl.
-  match goal with |- ?A |-- ?B => apply derives_trans with
-      (!! tc_val' ti (force_val (sem_cast (typeof b) ti (eval_expr b rho))) && A)
-  end.
-  + apply andp_right; auto.
-    clear - H2.
-    apply derives_trans with (!! (tc_val (typeof b) (eval_expr b rho)) &&
-     !! (tc_val ti (force_val (sem_cast (typeof b) ti (eval_expr b rho))))).
-    - apply andp_right.
-      eapply derives_trans; [ | eapply typecheck_expr_sound']; eauto.
-      apply andp_left1. apply derives_refl.
-      pose proof expr_lemmas.tc_val_sem_cast.
-      apply tc_val_sem_cast'; auto.
-    - apply andp_left2.
-      apply prop_derives.
-      unfold tc_val'.
-      intros; auto.
-  + normalize. rename H3 into H8.
-    hnf; intros. simpl.
+  intros.
+  rewrite /tc_environ /tc_exprlist /=.
+  revert bl; induction argsig; destruct bl as [ | b bl]; simpl; intros; unfold_lift.
+  * iPureIntro; intros _; split3; hnf; try split; intros; try rewrite /funsig_tycontext ?Maps.PTree.gempty // in H |- *.
+    destruct H as [? H]; inv H.
+  * iPureIntro; done.
+  * destruct a as [i ti]; simpl.
+    destruct (split argsig) eqn:?; simpl.
+    unfold_lift; iPureIntro; inversion 1.
+  * destruct a as [i ti]; simpl.
+    destruct (split argsig) eqn:?; simpl.
+    specialize (IHargsig bl).
+    rewrite /typecheck_expr; fold typecheck_expr.
+    rewrite !denote_tc_assert_andp.
+    unfold_lift.
+    rewrite IHargsig; clear IHargsig.
+    iIntros "(H & (%Ht & % & %))".
+    unfold typecheck_environ; simpl.
+    rewrite tc_val_sem_cast //.
+    iDestruct "H" as %?%tc_val_tc_val'; iPureIntro.
     split3; auto.
-    unfold typecheck_temp_environ; intros.
+    unfold typecheck_temp_environ; intros ?? Hset.
     destruct (ident_eq i id).
     - subst.
-      rewrite PTree.gss in H4. inv H4.
-      rewrite Map.gss.
-      eexists; split; eauto.
-    - rewrite Map.gso by auto.
-      apply (H id ty).
-      rewrite PTree.gso in H4 by auto.
-      simpl. auto.
+      rewrite Maps.PTree.gss in Hset; inv Hset.
+      rewrite Map.gss; eauto.
+    - rewrite Map.gso //.
+      apply (Ht id ty).
+      rewrite Maps.PTree.gso // in Hset.
 Qed.
 
 (* Scall *)
 
-Lemma age_twin' {A B} `{HA: ageable A} `{HB: ageable B}:
-  forall (x: A) (y: B) (x': A),
-       level x = level y -> age x x' ->
-       exists y', level x' = level y' /\ age y y'.
-Proof.
-intros x y x' H0 H1.
-unfold fashionR in *.
-destruct (age1_levelS _ _ H1) as [n ?].
-rewrite H0 in H.
-destruct (levelS_age1 _ _ H) as [y' ?].
-exists y'; split.
-apply age_level in H2.
-apply age_level in H1.
-congruence.
-auto.
-Qed.
-
-Lemma later_twin' {A B} `{HA: ageable A} `{HB: ageable B}:
-  forall (x: A) (y: B) (x': A),
-       level x = level y -> laterR x x' ->
-       exists y', level x' = level y' /\ laterR y y'.
-Proof.
-intros x y x' H0 H1.
-revert y H0; induction H1; intros.
-destruct (age_twin' _ _ _ H0 H) as [y' [? ?]].
-exists y'; split; auto.
-apply t_step; auto.
-specialize (IHclos_trans1 _ H0).
-destruct IHclos_trans1 as [y2 [? ?]].
-specialize (IHclos_trans2 _ H).
-destruct IHclos_trans2 as [u [? ?]].
-exists u; split; auto.
-apply t_trans with y2; auto.
-Qed.
-
-Lemma later_twin {A} `{ageable A}:
-   forall phi1 phi2 phi1',
-     level phi1 = level phi2 ->
-     laterR phi1 phi1' ->
-     exists phi2', level phi1' = level phi2' /\ laterR phi2 phi2'.
-Proof.
-intros.
-eapply later_twin'; eauto.
-Qed.
-
-Lemma someP_inj:  forall A P Q, SomeP A P = SomeP A Q -> P=Q.
-Proof. intros. injection H; intro. apply inj_pair2 in H0. auto. Qed.
-
-Lemma function_pointer_aux:
-  forall A P P' Q Q' (w: rmap),
-    args_super_non_expansive P ->
-    super_non_expansive Q ->
-    args_super_non_expansive P' ->
-    super_non_expansive Q' ->
-   SomeP (SpecArgsTT A) (fmap (fpi _) (approx (level w)) (approx (level w)) (packPQ P Q)) =
-   SomeP (SpecArgsTT A) (fmap (fpi _) (approx (level w)) (approx (level w)) (packPQ P' Q')) ->
-   ( (forall ts x vl, (! |> (P' ts x vl <=> P ts x vl)) w) /\
-     (forall ts x vl, (! |> (Q' ts x vl <=> Q ts x vl)) w)).
-Proof.
-  intros ? ? ? ? ? ? NEP NEQ NEP' NEQ' H.
-  apply someP_inj in H.
-  unfold packPQ in H; simpl in H.
-  split; intros.
-  + apply equal_f_dep with ts in H.
-    apply equal_f with x in H.
-    apply equal_f_dep with true in H.
-    apply equal_f with vl in H.
-    simpl in H.
-    rewrite @later_fash; auto with typeclass_instances.
-    intros ? ? m' ?.
-    assert (forall m'', necR m' m'' -> (level m'' < level w)%nat).
-    {
-      intros.
-      clear - H0 H1 H2; hnf in H1.
-      apply laterR_level in H1.
-      apply necR_level in H2; simpl in *.
-      lia.
-    }
-    split; intros ? m'' ? ? ?.
-    - apply f_equal with (f:= fun x => app_pred x m'') in H.
-      apply prop_unext in H.
-      apply approx_p with (level w).
-      rewrite NEP.
-      apply H.
-      rewrite <- NEP'.
-      apply approx_lt; auto.
-      apply necR_level in H3; apply ext_level in H4; apply laterR_level in H1; lia.
-    - apply f_equal with (f:= fun x => app_pred x m'') in H.
-      apply prop_unext in H.
-      apply approx_p with (level w).
-      rewrite NEP'.
-      apply H.
-      rewrite <- NEP.
-      apply approx_lt; auto.
-      apply necR_level in H3; apply ext_level in H4; apply laterR_level in H1; lia.
-  + apply equal_f_dep with ts in H.
-    apply equal_f with x in H.
-    apply equal_f_dep with false in H.
-    apply equal_f with vl in H.
-    simpl in H.
-    rewrite @later_fash; auto with typeclass_instances; intros ? ? m' ?.
-    assert (forall m'', necR m' m'' -> (level m'' < level w)%nat).
-    {
-      intros.
-      clear - H0 H1 H2; hnf in H1.
-      apply laterR_level in H1.
-      apply necR_level in H2; simpl in *.
-      lia.
-    }
-    split; intros ? m'' ? ??.
-    - apply f_equal with (f:= fun x => app_pred x m'') in H.
-      apply prop_unext in H.
-      apply approx_p with (level w).
-      rewrite NEQ.
-      apply H.
-      rewrite <- NEQ'.
-      apply approx_lt; auto.
-      apply necR_level in H3; apply ext_level in H4; apply laterR_level in H1; lia.
-    - apply f_equal with (f:= fun x => app_pred x m'') in H.
-      apply prop_unext in H.
-      apply approx_p with (level w).
-      rewrite NEQ'.
-      apply H.
-      rewrite <- NEQ.
-      apply approx_lt; auto.
-      apply necR_level in H3; apply ext_level in H4; apply laterR_level in H1; lia.
-Qed.
-
-Import JuicyMemOps.
-
-Fixpoint alloc_juicy_variables (ge: genv) (rho: env) (jm: juicy_mem) (vl: list (ident*type)) : env * juicy_mem :=
- match vl with
- | nil => (rho,jm)
- | (id,ty)::vars => match JuicyMemOps.juicy_mem_alloc jm 0 (@Ctypes.sizeof ge ty) with
-                              (m1,b1) => alloc_juicy_variables ge (PTree.set id (b1,ty) rho) m1 vars
-                           end
- end.
-
-Lemma juicy_mem_alloc_core:
-  forall jm lo hi jm' b, JuicyMemOps.juicy_mem_alloc jm lo hi = (jm', b) ->
-    core (m_phi jm) = core (m_phi jm').
-Proof.
- unfold JuicyMemOps.juicy_mem_alloc, after_alloc; intros.
- inv H.
- simpl.
- apply rmap_ext.
- repeat rewrite level_core. rewrite level_make_rmap. auto.
- intro loc.
- repeat rewrite <- core_resource_at.
- rewrite resource_at_make_rmap.
- unfold after_alloc'.
- if_tac; auto.
- destruct loc as [b z].
- simpl in H.
- rewrite core_YES.
- rewrite juicy_mem_alloc_cohere. rewrite core_NO; auto.
- simpl. destruct H.
- revert H; case_eq (alloc (m_dry jm) lo hi); intros.
- simpl in *. subst b0. apply alloc_result in H. subst b; lia.
- rewrite <- (core_ghost_of (proj1_sig _)), ghost_of_make_rmap, core_ghost_of; auto.
-Qed.
-
-Lemma alloc_juicy_variables_e:
-  forall ge rho jm vl rho' jm',
-    alloc_juicy_variables ge rho jm vl = (rho', jm') ->
-  Clight.alloc_variables ge rho (m_dry jm) vl rho' (m_dry jm')
-   /\ level jm = level jm'
-   /\ core (m_phi jm) = core (m_phi jm').
-Proof.
- intros.
- revert rho jm H; induction vl; intros.
- inv H. split; auto. constructor.
- unfold alloc_juicy_variables in H; fold alloc_juicy_variables in H.
- destruct a as [id ty].
- revert H; case_eq (JuicyMemOps.juicy_mem_alloc jm 0 (@Ctypes.sizeof ge ty)); intros jm1 b1 ? ?.
- specialize (IHvl (PTree.set id (b1,ty) rho) jm1 H0).
- destruct IHvl as [? [? ?]]; split3; auto.
- apply alloc_variables_cons  with  (m_dry jm1) b1; auto.
- apply JuicyMemOps.juicy_mem_alloc_succeeds in H. auto.
- apply JuicyMemOps.juicy_mem_alloc_level in H.
- congruence.
- rewrite <- H3.
- eapply  juicy_mem_alloc_core; eauto.
-Qed.
-
-
-Lemma alloc_juicy_variables_match_venv:
-  forall ge jm vl ve' jm',
-     alloc_juicy_variables ge empty_env jm vl = (ve',jm') ->
-     match_venv (make_venv ve') vl.
-Proof.
-intros.
-  intro i.
- unfold make_venv.
-  destruct (ve' ! i) as [[? ?] | ] eqn:?; auto.
-  assert (H0: (exists b, empty_env ! i = Some (b,t)) \/ In (i,t) vl).
-2: destruct H0; auto; destruct H0; rewrite PTree.gempty in H0; inv H0.
- forget empty_env as e.
-  revert jm e H; induction vl; simpl; intros.
-  inv H.
-  left; eexists; eauto.
-  destruct a.
-  apply IHvl in H; clear IHvl.
- destruct (ident_eq i0 i). subst i0.
- destruct H; auto. destruct H as [b' ?].
- rewrite PTree.gss in H. inv H. right. auto.
- destruct H; auto. left. destruct H as [b' ?].
- rewrite PTree.gso in H by auto. eauto.
-Qed.
-
 Lemma build_call_temp_env:
   forall f vl,
      length (fn_params f) = length vl ->
@@ -360,86 +90,6 @@ Proof.
  apply IHl. auto.
 Qed.
 
-Lemma resource_decay_funassert:
-  forall G rho b w w',
-         necR (core w) (core w') ->
-         resource_decay b w w' ->
-         app_pred (funassert G rho) w ->
-         app_pred (funassert G rho) w'.
-Proof.
-unfold resource_decay, funassert; intros until w'; intro CORE; intros.
-destruct H.
-destruct H0.
-split; [clear H2 | clear H0].
-+ intros id fs ? w2 Hw2 Hext H3.
-  specialize (H0 id fs). cbv beta in H0.
-  specialize (H0 _ _ (necR_refl _) (ext_refl _) H3).
-  destruct H0 as [loc [? ?]].
-  exists loc; split; auto.
-  destruct fs as [f cc A a a0].
-  simpl in H2|-*.
-  pose proof (necR_resource_at (core w) (core w') (loc,0)
-         (PURE (FUN f cc) (SomeP (SpecArgsTT A) (packPQ a a0))) CORE).
-  pose proof (necR_resource_at _ _ (loc,0)
-         (PURE (FUN f cc) (SomeP (SpecArgsTT A) (packPQ a a0))) Hw2).
-  apply rmap_order in Hext as (<- & <- & _).
-  apply H5.
-  clear - H4 H2.
-  repeat rewrite <- core_resource_at in *.
-  spec H4. rewrite H2.  rewrite core_PURE.  simpl.  rewrite level_core; reflexivity.
-  destruct (w' @ (loc,0)).
-  rewrite core_NO in H4; inv H4.
-  rewrite core_YES in H4; inv H4.
-  rewrite core_PURE in H4; inv H4. rewrite level_core; reflexivity.
-+
-intros loc sig cc ? w2 Hw2 Hext H6.
-specialize (H2 loc sig cc _ _ (necR_refl _) (ext_refl _)).
-spec H2.
-{ clear - Hw2 Hext CORE H6. simpl in *.
-  destruct H6 as [pp H6].
-  rewrite <- resource_at_approx.
-  apply rmap_order in Hext as (Hl & Hr & _); rewrite <- Hr, <- Hl in H6.
-  case_eq (w @ (loc,0)); intros.
-  + assert (core w @ (loc,0) = resource_fmap (approx (level (core w))) (approx (level (core w))) (NO _ bot_unreadable)).
-     - rewrite <- core_resource_at.
-       simpl; erewrite <- core_NO, H; reflexivity.
-     - pose proof (necR_resource_at _ _ _ _ CORE H0).
-       pose proof (necR_resource_at _ _ _ _ (necR_core _ _ Hw2) H1).
-       rewrite <- core_resource_at in H2; rewrite H6 in H2;
-       rewrite core_PURE in H2; inv H2.
-  + assert (core w @ (loc,0) = resource_fmap (approx (level (core w))) (approx (level (core w))) (NO _ bot_unreadable)).
-    - rewrite <- core_resource_at.
-      simpl; erewrite <- core_YES, H; reflexivity.
-    - pose proof (necR_resource_at _ _ _ _ CORE H0).
-      pose proof (necR_resource_at _ _ _ _ (necR_core _ _ Hw2) H1).
-      rewrite <- core_resource_at in H2; rewrite H6 in H2;
-      rewrite core_PURE in H2; inv H2.
-  + pose proof (resource_at_approx w (loc,0)).
-    pattern (w @ (loc,0)) at 1 in H0; rewrite H in H0.
-    symmetry in H0.
-    assert (core (w @ (loc,0)) = core (resource_fmap (approx (level w)) (approx (level w))
-       (PURE k p))) by (f_equal; auto).
-    rewrite core_resource_at in H1.
-    assert (core w @ (loc,0) =
-        resource_fmap (approx (level (core w))) (approx (level (core w)))
-         (PURE k p)).
-    - rewrite H1.  simpl resource_fmap. rewrite level_core; rewrite core_PURE; auto.
-    - pose proof (necR_resource_at _ _ _ _ CORE H2).
-      assert (w' @ (loc,0) = resource_fmap
-         (approx (level w')) (approx (level w')) (PURE k p)).
-      * rewrite <- core_resource_at in H3. rewrite level_core in H3.
-        destruct (w' @ (loc,0)).
-        ++ rewrite core_NO in H3; inv H3.
-        ++ rewrite core_YES in H3; inv H3.
-        ++ rewrite core_PURE in H3; inv H3.
-           reflexivity.
-      * pose proof (necR_resource_at _ _ _ _ Hw2 H4).
-        inversion2 H6 H5.
-        exists p. reflexivity. }
-destruct H2 as [id [? ?]].
-exists id. split; auto.
-Qed.
-
 Definition substopt {A} (ret: option ident) (v: environ -> val) (P: environ -> A)  : environ -> A :=
    match ret with
    | Some id => subst id v P
@@ -462,14 +112,14 @@ Lemma bind_parameter_temps_excludes :
 forall l1 l2 t id t1,
 ~In id (map fst l1) ->
 (bind_parameter_temps l1 l2 t) = Some t1 ->
-t1 ! id = t ! id.
+t1 !! id = t !! id.
 Proof.
 induction l1;
 intros.
 simpl in *. destruct l2; inv H0. auto.
 simpl in H0. destruct a. destruct l2; inv H0.
-specialize (IHl1 l2 (PTree.set i v t) id t1).
-simpl in H. intuition. rewrite PTree.gsspec in H3.
+specialize (IHl1 l2 (Maps.PTree.set i v t) id t1).
+simpl in H. intuition. rewrite Maps.PTree.gsspec in H3.
 destruct (peq id i). subst; tauto. auto.
 Qed.
 
@@ -478,7 +128,7 @@ Lemma pass_params_ni :
      (te' : temp_env) (id : positive) te l,
    bind_parameter_temps l2 l (te) = Some te' ->
    (In id (map fst l2) -> False) ->
-   Map.get (make_tenv te') id = te ! id.
+   Map.get (make_tenv te') id = te !! id.
 Proof.
 intros. eapply bind_parameter_temps_excludes in H.
 unfold make_tenv, Map.get.
@@ -491,41 +141,39 @@ exists te2, bind_parameter_temps l1 l2 t2 = Some te2.
 Proof.
 induction l1; intros.
 + simpl in H. destruct l2; inv H. simpl. eauto.
-
 + destruct a. simpl in *. destruct l2; inv H. eapply IHl1.
-apply H1.
+  apply H1.
 Qed.
 
 
 Lemma smaller_temps_exists2 : forall l1 l2 t1 t2 te te2 i,
 bind_parameter_temps l1 l2 t1 = Some te ->
 bind_parameter_temps l1 l2 t2 = Some te2 ->
-t1 ! i = t2 ! i ->
-te ! i = te2 ! i.
+t1 !! i = t2 !! i ->
+te !! i = te2 !! i.
 Proof.
-induction l1; intros; simpl in *; try destruct a; destruct l2; inv H; inv H0.
+induction l1; intros; simpl in *; try destruct a; destruct l2; inv H.
 apply H1.
-eapply IHl1. apply H3. apply H2.
-repeat rewrite PTree.gsspec. destruct (peq i i0); auto.
+eapply IHl1; eauto.
+repeat rewrite Maps.PTree.gsspec. destruct (peq i i0); auto.
 Qed.
 
 
 Lemma smaller_temps_exists' : forall l l1 te te' id i t,
-bind_parameter_temps l l1 (PTree.set id Vundef t)=  Some te ->
+bind_parameter_temps l l1 (Maps.PTree.set id Vundef t) = Some te ->
 i <> id ->
-(bind_parameter_temps l l1 t = Some te') -> te' ! i = te ! i.
+(bind_parameter_temps l l1 t = Some te') -> te' !! i = te !! i.
 Proof.
 induction l; intros.
-simpl in *. destruct l1; inv H. inv H1. rewrite PTree.gso; auto.
-
-simpl in *. destruct a. destruct l1; inv H.
-eapply smaller_temps_exists2. apply H1. apply H3.
-intros. repeat rewrite PTree.gsspec. destruct (peq i i0); auto.
-destruct (peq i id). subst. tauto. auto.
+- simpl in *. destruct l1; inv H. rewrite Maps.PTree.gso; auto.
+- simpl in *. destruct a. destruct l1; inv H.
+  eapply smaller_temps_exists2; eauto.
+  intros. repeat rewrite Maps.PTree.gsspec. destruct (peq i i0); auto.
+  destruct (peq i id). subst. tauto. auto.
 Qed.
 
 Lemma smaller_temps_exists'' : forall l l1 te id i t,
-bind_parameter_temps l l1 (PTree.set id Vundef t)=  Some te ->
+bind_parameter_temps l l1 (Maps.PTree.set id Vundef t)=  Some te ->
 i <> id ->
 exists te', (bind_parameter_temps l l1 t = Some te').
 Proof.
@@ -534,12 +182,12 @@ eapply bind_exists_te; eauto.
 Qed.
 
 Lemma smaller_temps_exists : forall l l1 te id i t,
-bind_parameter_temps l l1 (PTree.set id Vundef t)=  Some te ->
-i <> id ->
-exists te', (bind_parameter_temps l l1 t = Some te' /\ te' ! i = te ! i).
+bind_parameter_temps l l1 (Maps.PTree.set id Vundef t)=  Some te ->
+i <> id -> 
+exists te', (bind_parameter_temps l l1 t = Some te' /\ te' !! i = te !! i).
 Proof.
-intros. copy H. eapply smaller_temps_exists'' in H; eauto.
-destruct H. exists x. split. auto.
+intros. destruct (smaller_temps_exists'' _ _ _ _ _ _ H H0) as [x ?].
+exists x. split. auto.
 eapply smaller_temps_exists'; eauto.
 Qed.
 
@@ -547,10 +195,10 @@ Qed.
 Lemma alloc_vars_lookup :
 forall ge id m1 l ve m2 e ,
 list_norepet (map fst l) ->
-(forall i, In i (map fst l) -> e ! i = None) ->
+(forall i, In i (map fst l) -> e !! i = None) ->
 Clight.alloc_variables ge (e) m1 l ve m2 ->
-(exists v, e ! id = Some v) ->
-ve ! id = e ! id.
+(exists v, e !! id = Some v) ->
+ve !! id = e !! id.
 Proof.
 intros.
 generalize dependent e.
@@ -562,193 +210,118 @@ inv H1. auto.
 inv H1. simpl in *. inv H.
 destruct H2.
 assert (id <> id0).
-intro. subst.  specialize (H0 id0). spec H0. auto. congruence.
+intro. subst.  specialize (H0 id0). spec H0. auto. rewrite H // in H0.
 eapply IHl in H10.
-rewrite PTree.gso in H10; auto.
-auto. intros. rewrite PTree.gsspec. if_tac. subst. tauto.
+rewrite Maps.PTree.gso in H10; auto.
+auto. intros. rewrite Maps.PTree.gsspec. if_tac. subst. tauto.
 apply H0. auto.
-rewrite PTree.gso; auto. eauto.
+rewrite Maps.PTree.gso; auto. eauto.
 Qed.
 
-Lemma alloc_vars_lemma : forall ge id l m1 m2 ve ve'
-(SD : forall i, In i (map fst l) -> ve ! i = None),
+Lemma alloc_vars_lemma : forall ge id ty l m1 m2 ve ve'
+(SD : forall i, In i (map fst l) -> ve !! i = None),
 list_norepet (map fst l) ->
-
 Clight.alloc_variables ge ve m1 l ve' m2 ->
-(In id (map fst l) ->
-exists v, ve' ! id = Some v).
+(In (id, ty) l ->
+exists v, ve' !! id = Some (v, ty)).
 Proof.
-intros.
-generalize dependent ve.
-revert m1 m2.
-induction l; intros. inv H1.
-simpl in *. destruct a; simpl in *.
-destruct H1. subst. inv H0. inv H.  apply alloc_vars_lookup with (id := id) in H9; auto.
-rewrite H9. rewrite PTree.gss. eauto. intros.
-destruct (peq i id). subst. tauto. rewrite PTree.gso; auto.
-rewrite PTree.gss; eauto.
-
-inv H0. apply IHl in H10; auto. inv H; auto.
-intros. rewrite PTree.gsspec. if_tac. subst. inv H. tauto.
-auto.
+  intros.
+  generalize dependent ve.
+  revert m1 m2.
+  induction l; intros; first done.
+  destruct a; simpl in *.
+  destruct H1 as [[=] | H1].
+  - subst. inv H0. inv H. apply alloc_vars_lookup with (id := id) in H9; auto.
+    rewrite H9. rewrite Maps.PTree.gss. eauto.
+    { intros. destruct (peq i id); first by subst; tauto. rewrite Maps.PTree.gso; eauto. }
+    { rewrite Maps.PTree.gss; eauto. }
+  - inv H0. inv H. apply IHl in H10; auto.
+    intros. rewrite Maps.PTree.gsspec. if_tac; last eauto. subst; done.
+Qed.
+
+Lemma alloc_vars_match_venv_gen: forall ge ve m l0 l ve' m',
+  match_venv (make_venv ve) l0 ->
+  Clight.alloc_variables ge ve m l ve' m' ->
+  match_venv (make_venv ve') (l0 ++ l).
+Proof.
+  intros.
+  generalize dependent l0; induction H0; intros.
+  { rewrite app_nil_r //. }
+  specialize (IHalloc_variables (l0 ++ [(id, ty)])).
+  rewrite -assoc in IHalloc_variables; apply IHalloc_variables.
+  rewrite /match_venv /make_venv in H1 |- *; intros i; specialize (H1 i).
+  destruct (eq_dec i id).
+  - subst; rewrite Maps.PTree.gss in_app; simpl; auto.
+  - rewrite Maps.PTree.gso //.
+    destruct (Maps.PTree.get i e) as [(?, ?)|]; first rewrite in_app; simpl; auto.
+Qed.
+
+Lemma alloc_vars_match_venv: forall ge m l ve' m',
+  Clight.alloc_variables ge empty_env m l ve' m' ->
+  match_venv (make_venv ve') l.
+Proof.
+  intros; eapply (alloc_vars_match_venv_gen _ _ _ []) in H; auto.
+  rewrite /match_venv /make_venv; intros.
+  rewrite Maps.PTree.gempty //.
 Qed.
 
 Lemma semax_call_typecheck_environ:
   forall (Delta : tycontext) (args: list val) (psi : genv)
-           (jm : juicy_mem) (b : block) (f : function)
+           m (b : block) (f : function)
      (H17 : list_norepet (map fst (fn_params f) ++ map fst (fn_temps f)))
      (H17' : list_norepet (map fst (fn_vars f)))
      (H16 : Genv.find_funct_ptr psi b = Some (Internal f))
-     (ve' : env) (jm' : juicy_mem) (te' : temp_env)
-     (H15 : alloc_variables psi empty_env (m_dry jm) (fn_vars f) ve' (m_dry jm'))
+     (ve' : env) m' (te' : temp_env)
+     (H15 : alloc_variables psi empty_env m (fn_vars f) ve' m')
      (TC5: typecheck_glob_environ (filter_genv psi) (glob_types Delta))
-   (H : forall (b : ident) (b0 : funspec) (a' a'' : rmap),
-    necR (m_phi jm') a' -> ext_order a' a'' ->
-    (glob_specs Delta) ! b = Some b0 ->
-    exists b1 : block,
-        filter_genv psi b = Some b1 /\
-        func_at b0 (b1,0) a'')
-   (TC8 : tc_vals (snd (split (fn_params f))) args)
-   (H21 : bind_parameter_temps (fn_params f) args
+     (TC8 : tc_vals (snd (split (fn_params f))) args)
+     (H21 : bind_parameter_temps (fn_params f) args
               (create_undef_temps (fn_temps f)) = Some te'),
    typecheck_environ (func_tycontext' f Delta)
       (construct_rho (filter_genv psi) ve' te').
-Proof. assert (H1:= True).
- intros.
- pose (rho3 := mkEnviron (filter_genv psi) (make_venv ve') (make_tenv te')).
-
-unfold typecheck_environ. repeat rewrite andb_true_iff.
-split3.
-*
-clear H H1 H15.
-unfold typecheck_temp_environ in *. intros. simpl.
-unfold temp_types in *. simpl in *.
-apply func_tycontext_t_sound in H; auto.
- clear - H21 H TC8 H17.
-
-destruct H. (*in params*)
-forget (create_undef_temps (fn_temps f)) as temps.
-rewrite snd_split in TC8.
-generalize dependent temps.
-generalize dependent args. generalize dependent te'.
-{  induction (fn_params f); intros.
-   + inv H.
-   + destruct args. inv TC8. destruct a. simpl in *.
-       destruct TC8 as [TC8' TC8].
-       destruct H.
-      - clear IHl.
-        inv H.
-        rewrite (pass_params_ni _ _ id _ _ H21)
-           by (inv H17; contradict H1; apply in_app; auto).
-        rewrite PTree.gss.
-        eexists.  split. reflexivity. apply tc_val_tc_val'.
-        auto.
-      - inv H17.
-        assert (i <> id). intro. subst.
-        apply H2. apply in_or_app. left. apply in_map with (f := fst) in H. apply H.
-        eapply IHl; eauto.
-}
-
-(*In temps*)
-apply list_norepet_app in H17. destruct H17 as [? [? ?]].
-generalize dependent (fn_params f). generalize dependent args.
-generalize dependent te'.
-
-induction (fn_temps f); intros.
-inv H.
-
-simpl in *. destruct H. destruct a. inv H. simpl in *.
-clear IHl. exists Vundef. simpl in *. split; [| hnf; congruence]. inv H1.
-eapply pass_params_ni with (id := id) in H21; auto.
-rewrite PTree.gss in *. auto.
-intros.
-unfold list_disjoint in *. eapply H2. eauto. left. auto. auto.
-
-destruct a.
-destruct (peq id i). subst.
-apply pass_params_ni with (id := i) in H21.
-rewrite PTree.gss in *. exists Vundef. split; [auto | hnf; congruence].
-intros. unfold list_disjoint in *. intuition.
-eapply H2. eauto. left. auto. auto.
-
-apply smaller_temps_exists with (i := id) in H21.
-destruct H21.  destruct H3.
-eapply IHl in H3; auto.
-destruct H3. destruct H3.
-exists x0. split. unfold Map.get in *.
-unfold make_tenv in *. rewrite <- H4. auto. auto.
-inv H1; auto. unfold list_disjoint in *. intros.
-apply H2. auto. right. auto. auto.
-*
-
-simpl in *.
-unfold typecheck_var_environ in *. intros.
-simpl in *. unfold typecheck_var_environ in *.
-unfold func_tycontext' in *. unfold var_types in *.
-simpl in *.
-rewrite (func_tycontext_v_sound (fn_vars f) id ty); auto.
-transitivity ((exists b, empty_env ! id = Some (b,ty) )\/ In (id,ty) (fn_vars f)).
-clear; intuition. destruct H0. unfold empty_env in H.
-rewrite PTree.gempty in H; inv H.
-generalize dependent (m_dry jm).
-clear - H17'.
-assert (forall id, empty_env ! id <> None -> ~ In id (map fst (fn_vars f))).
-intros. unfold empty_env in H. rewrite PTree.gempty in H. contradiction H; auto.
-generalize dependent empty_env.
-unfold Map.get, make_venv.
-induction (fn_vars f); intros.
-inv H15.
-destruct (ve' ! id); intuition auto with exfalso.
-inv H15.
-inv H17'.
-specialize (IHl H3); clear H3.
-specialize (IHl (PTree.set id0 (b1,ty0) e)).
-spec IHl.
-intros id' H8; specialize (H id').
-destruct (ident_eq id0 id'). subst. auto.
-rewrite PTree.gso  in H8 by auto.
-specialize (H H8). contradict H.
-right; auto.
-specialize (IHl _ H7).
-clear - H H2 IHl.
-destruct (ident_eq id0 id). subst id0.
-rewrite PTree.gss in IHl.
-split; intro.
-destruct H0.
-destruct H0. specialize (H id).
-destruct (e!id); try discriminate.
-inv H0.
-spec H; [congruence | ].
-contradiction H. left; auto.
-destruct H0. inv H0.
-apply IHl. left; eauto.
-contradiction H2. apply in_map with (f:=fst) in H0. apply H0.
-rewrite <- IHl in H0.
-destruct H0.
-destruct H0. inv H0. right; left; auto.
-contradiction H2.
-apply in_map with (f:=fst) in H0. auto.
-rewrite PTree.gso in IHl by auto.
-rewrite <- IHl.
-intuition (simpl; auto). inv H5. inv H0. tauto.
-apply H4 in H0. apply H1; auto.
-*
-unfold ge_of in *. simpl in *. auto.
-Qed.
-
-Lemma free_juicy_mem_level:
-  forall jm m b lo hi H, level (free_juicy_mem jm m b lo hi H) = level jm.
 Proof.
- intros;  simpl;  unfold inflate_free; simpl.
- rewrite level_make_rmap. auto.
-Qed.
-
-Lemma free_juicy_mem_ghost:
-  forall jm m b lo hi H,
-    ghost_of (m_phi (free_juicy_mem jm m b lo hi H)) = ghost_of (m_phi jm).
-Proof.
- intros;  simpl;  unfold inflate_free; simpl.
- rewrite ghost_of_make_rmap. auto.
+  intros.
+  pose (rho3 := mkEnviron (filter_genv psi) (make_venv ve') (make_tenv te')).
+  split3; auto.
+  - unfold typecheck_temp_environ; simpl; intros ?? H.
+    apply func_tycontext_t_sound in H; auto.
+    clear - H21 H TC8 H17.
+    destruct (in_dec (EqDec_prod _ _ _ _) (id, ty) (fn_params f)).
+    + forget (create_undef_temps (fn_temps f)) as temps.
+      rewrite snd_split in TC8.
+      generalize dependent temps. generalize dependent args. generalize dependent te'.
+      induction (fn_params f); intros; first done.
+      destruct a; simpl in *.
+      destruct args; first done.
+      destruct TC8 as [TC8' TC8].
+      clear H; destruct i as [H | H].
+      * inv H.
+        rewrite -> (pass_params_ni _ _ id _ _ H21)
+           by (inv H17; contradict H1; apply in_app; auto).
+        rewrite Maps.PTree.gss.
+        apply tc_val_tc_val' in TC8'; eauto.
+      * inv H17; eauto.
+    + destruct H as [? | H]; first done.
+      apply list_norepet_app in H17 as (? & ? & Hdisj).
+      rewrite -> (pass_params_ni _ _ id _ _ H21).
+      2: { intros; contradiction (Hdisj id id); auto.
+          rewrite in_map_iff; exists (id, ty); auto. }
+      clear - H; forget (fn_temps f) as temps; induction temps; first done.
+      destruct a; simpl in *.
+      destruct (eq_dec i id).
+      * subst; rewrite Maps.PTree.gss; eauto.
+        eexists; split; eauto; apply tc_val'_Vundef.
+      * rewrite Maps.PTree.gso //.
+        destruct H; [by inv H | eauto].
+  - rewrite /typecheck_var_environ /=; intros.
+    rewrite (func_tycontext_v_sound (fn_vars f) id ty); auto.
+    rewrite /Map.get /make_venv.
+    split.
+    + intros; eapply alloc_vars_lemma; eauto.
+      intros; apply Maps.PTree.gempty.
+    + intros (? & H); apply alloc_vars_match_venv in H15.
+      rewrite /match_venv /make_venv in H15.
+      specialize (H15 id); rewrite H // in H15.
 Qed.
 
 Lemma free_list_free:
@@ -756,131 +329,28 @@ Lemma free_list_free:
        free_list m ((b,lo,hi)::l') = Some m' ->
          {m2 | free m b lo hi = Some m2 /\ free_list m2 l' = Some m'}.
 Proof.
-simpl; intros.
- destruct (free m b lo hi). eauto. inv H.
+  simpl; intros.
+  destruct (free m b lo hi). eauto. inv H.
 Qed.
 
 Definition freeable_blocks: list (block * BinInt.Z * BinInt.Z) -> mpred :=
   fold_right (fun (bb: block*BinInt.Z * BinInt.Z) a =>
                         match bb with (b,lo,hi) =>
-                                          sepcon (VALspec_range (hi-lo) Share.top (b,lo)) a
+                                          VALspec_range (hi-lo) Share.top (b,lo) ∗ a
                         end)
                     emp.
 
-Inductive free_list_juicy_mem:
-      forall  (jm: juicy_mem) (bl: list (block * BinInt.Z * BinInt.Z))
-                                         (jm': juicy_mem), Prop :=
-| FLJM_nil: forall jm, free_list_juicy_mem jm nil jm
-| FLJM_cons: forall jm b lo hi bl jm2 jm'
-                          (H: free (m_dry jm) b lo hi = Some (m_dry jm2))
-                          (H0 : forall ofs : Z,
-                        lo <= ofs < hi ->
-                        perm_of_res (m_phi jm @ (b, ofs)) = Some Freeable),
-                          free_juicy_mem jm (m_dry jm2) b lo hi H = jm2 ->
-                          free_list_juicy_mem jm2 bl jm' ->
-                          free_list_juicy_mem jm ((b,lo,hi)::bl) jm'.
-
-Lemma perm_of_res_val : forall r, perm_of_res r = Some Freeable ->
-  exists v pp, r = YES Share.top readable_share_top (VAL v) pp.
-Proof.
-  destruct r; simpl; try if_tac; try discriminate.
-  destruct k; try discriminate.
-  unfold perm_of_sh.
-  repeat if_tac; try discriminate.
-  subst; intro; do 2 eexists; f_equal.
-  apply proof_irr.
-Qed.
-
-Lemma free_list_juicy_mem_i:
-  forall jm bl m' F,
-   free_list (m_dry jm) bl = Some m' ->
-   app_pred (freeable_blocks bl * F) (m_phi jm) ->
-   exists jm', free_list_juicy_mem jm bl jm'
-                  /\ m_dry jm' = m'
-                  /\ level jm = level jm'.
-Proof.
-intros jm bl; revert jm; induction bl; intros.
-*
- inv H; exists jm; split3; auto. constructor.
-*
- simpl freeable_blocks in H0. destruct a as [[b lo] hi].
- rewrite sepcon_assoc in H0.
- destruct (free_list_free _ _ _ _ _ _ H) as [m2 [? ?]].
- generalize H0; intro H0'.
- destruct H0 as [phi1 [phi2 [? [? H6]]]].
-
- assert (H10:= @juicy_free_lemma' jm b lo hi m2 phi1 _ _ H1 H0' H3 H0).
- match type of H10 with context[m_phi ?A] => set (jm2:=A) in H10 end; subst.
-
- eapply pred_upclosed in H6; eauto.
- specialize (IHbl  jm2 m' F H2 H6).
- destruct IHbl as [jm' [? [? ?]]].
- exists jm'; split3; auto.
- apply (FLJM_cons jm b lo hi bl jm2 jm' H1
-   (juicy_free_aux_lemma (m_phi jm) b lo hi (freeable_blocks bl * F) H0') (eq_refl _) H4).
- rewrite <- H7.
- unfold jm2.
- symmetry; apply free_juicy_mem_level.
-Qed.
-
-Lemma free_juicy_mem_ext:
-  forall jm1 jm2 b lo hi m1 m2 H1 H2,
-      jm1=jm2 -> m1=m2 ->
-     free_juicy_mem jm1 m1 b lo hi H1 = free_juicy_mem jm2 m2 b lo hi H2.
-Proof.
-intros. subst. proof_irr. auto.
-Qed.
-
-
-Lemma free_list_juicy_mem_lem:
-  forall P jm bl jm',
-     free_list_juicy_mem jm bl jm' ->
-     app_pred (freeable_blocks bl * P) (m_phi jm) ->
-     app_pred P (m_phi jm').
-Proof.
- intros.
- revert H0; induction H; simpl freeable_blocks.
- intros.  rewrite emp_sepcon in H0; auto.
- rename H0 into H99. rename H1 into H0; rename H2 into H1.
- intro.
- rewrite sepcon_assoc in H2.
- generalize H2; intro H2'.
- destruct H2 as [phi1 [phi2 [? [? ?]]]].
- apply IHfree_list_juicy_mem.
- pose proof  (@juicy_free_lemma' jm b lo hi _ phi1 _ _ H H2' H3 H2).
- match type of H5 with context[m_phi ?A] => set (jm3 := A) in H5 end.
- replace jm2 with jm3 by (subst jm3; rewrite <- H0; apply free_juicy_mem_ext; auto).
- eapply pred_upclosed; eauto.
-Qed.
-
-Lemma PTree_elements_remove: forall {A} (T: PTree.tree A) i e,
-  In e (PTree.elements (PTree.remove i T)) ->
-  In e (PTree.elements T) /\ fst e <> i.
-Proof.
-  intros.
-  destruct e as [i0 v0].
-  apply PTree.elements_complete in H.
-  destruct (peq i0 i).
-  + subst.
-    rewrite PTree.grs in H.
-    inversion H.
-  + rewrite PTree.gro in H by auto.
-    split; [| simpl; auto].
-    apply PTree.elements_correct.
-    auto.
-Qed.
-
-Lemma stackframe_of_freeable_blocks {CS}:
-  forall Delta f rho ge ve,
-      cenv_sub (@cenv_cs CS) (genv_cenv ge) ->
-      Forall (fun it => complete_type cenv_cs (snd it) = true) (fn_vars f) ->
+Lemma stackframe_of_freeable_blocks:
+  forall {CS'} Delta f rho ge ve,
+      cenv_sub (@cenv_cs CS') (genv_cenv ge) ->
+      Forall (fun it => complete_type (@cenv_cs CS') (snd it) = true) (fn_vars f) ->
       list_norepet (map fst (fn_vars f)) ->
       ve_of rho = make_venv ve ->
       guard_environ (func_tycontext' f Delta) f rho ->
-       stackframe_of f rho |-- freeable_blocks (blocks_of_env ge ve).
+       stackframe_of f rho ⊢ freeable_blocks (blocks_of_env ge ve).
 Proof.
-  intros until ve.
-  intros HGG COMPLETE.
+ intros until ve.
+ intros HGG COMPLETE.
  intros.
  destruct H1. destruct H2 as [H7 _].
  unfold stackframe_of.
@@ -892,137 +362,102 @@ Proof.
  unfold var_types in H1.
  simpl in H1. unfold make_tycontext_v in H1.
  unfold blocks_of_env.
-match goal with |- ?A |-- _ =>
- replace A
-  with (fold_right (@sepcon _ _ _ _ _ _ _) emp
-            (map (fun idt : ident * type => var_block Share.top idt rho)
-            (fn_vars f)))
-end.
- 2: clear; induction (fn_vars f); simpl; f_equal; auto.
- unfold var_block. unfold eval_lvar. simpl.
-  rewrite H0. unfold make_venv. forget (ge_of rho) as ZZ. rewrite H0 in H7; clear rho H0.
+ trans (foldr bi_sep emp (map (fun idt => var_block Share.top idt rho) (fn_vars f))).
+ { clear; induction (fn_vars f); simpl; auto; monPred.unseal. rewrite -IHl; by monPred.unseal. }
+ unfold var_block. unfold eval_lvar. monPred.unseal; simpl.
+ rewrite H0. unfold make_venv. forget (ge_of rho) as ZZ. rewrite H0 in H7; clear rho H0.
  revert ve H1 H7; induction (fn_vars f); simpl; intros.
- case_eq (PTree.elements ve); simpl; intros; auto.
+ case_eq (Maps.PTree.elements ve); simpl; intros; auto.
  destruct p as [id ?].
- pose proof (PTree.elements_complete ve id p). rewrite H0 in H2. simpl in H2.
+ pose proof (Maps.PTree.elements_complete ve id p). rewrite H0 in H2. simpl in H2.
  specialize (H7 id). unfold make_venv in H7. rewrite H2 in H7; auto.
  destruct p; inv H7.
  inv H.
  destruct a as [id ty]. simpl in *.
  simpl in COMPLETE. inversion COMPLETE; subst.
  clear COMPLETE; rename H5 into COMPLETE; rename H2 into COMPLETE_HD.
- specialize (IHl COMPLETE H4 (PTree.remove id ve)).
- assert (exists b, ve ! id = Some (b,ty)). {
+ specialize (IHl COMPLETE H4 (Maps.PTree.remove id ve)).
+ assert (exists b, Maps.PTree.get id ve = Some (b,ty)). {
   specialize (H1 id ty).
-  rewrite PTree.gss in H1. destruct H1 as [[b ?] _]; auto. exists b; apply H.
+  rewrite Maps.PTree.gss in H1. destruct H1 as [[b ?] _]; auto. exists b; apply H.
  }
  destruct H as [b H].
- destruct (@PTree.elements_remove _ id (b,ty) ve H) as [l1 [l2 [? ?]]].
+ destruct (@Maps.PTree.elements_remove _ id (b,ty) ve H) as [l1 [l2 [? ?]]].
  rewrite H0.
  rewrite map_app. simpl map.
- apply derives_trans with (freeable_blocks ((b,0,@Ctypes.sizeof ge ty) ::  (map (block_of_binding ge) (l1 ++ l2)))).
+ trans (freeable_blocks ((b,0,@Ctypes.sizeof ge ty) :: (map (block_of_binding ge) (l1 ++ l2)))).
  2:{
    clear.
    induction l1; simpl; try auto.
-   destruct a as [id' [hi lo]]. simpl. rewrite <- sepcon_assoc.
-   rewrite (sepcon_comm (VALspec_range (@Ctypes.sizeof ge ty - 0) Share.top (b, 0))).
-   rewrite sepcon_assoc. apply sepcon_derives; auto.
- }
+   destruct a as [id' [hi lo]]. simpl in *.
+   rewrite -IHl1.
+   rewrite !assoc (comm _ (VALspec_range _ _ _ )) //. }
  unfold freeable_blocks; simpl. rewrite <- H2.
- apply sepcon_derives.
- unfold Map.get. rewrite H. rewrite eqb_type_refl.
- unfold memory_block. normalize. {
-  rename H6 into H99.
- normalize. (* don't know why we cannot do normalize at first *)
- rewrite memory_block'_eq.
- 2: rewrite Ptrofs.unsigned_zero; lia.
- 2:{
- rewrite Ptrofs.unsigned_zero. rewrite Zplus_0_r.
- rewrite Z2Nat.id.
- change (Ptrofs.unsigned Ptrofs.zero) with 0 in H99.
- lia.
- unfold sizeof.
- pose proof (sizeof_pos ty); lia.
-}
+ apply bi.sep_mono.
+ { unfold Map.get. rewrite H. rewrite eqb_type_refl.
+   unfold memory_block. iIntros "(% & % & H)".
+   rename H6 into H99.
+   rewrite memory_block'_eq.
+   2: rewrite Ptrofs.unsigned_zero; lia.
+   2:{ rewrite Ptrofs.unsigned_zero. rewrite Zplus_0_r.
+       rewrite Z2Nat.id.
+       change (Ptrofs.unsigned Ptrofs.zero) with 0 in H99.
+       lia.
+       unfold sizeof.
+       pose proof (sizeof_pos ty); lia. }
  rewrite Z.sub_0_r.
  unfold memory_block'_alt.
- rewrite if_true by apply readable_share_top.
+ rewrite -> if_true by apply readable_share_top.
  rewrite Z2Nat.id.
  + rewrite (cenv_sub_sizeof HGG); auto.
- + unfold sizeof; pose proof (sizeof_pos ty); lia.
-}
- eapply derives_trans; [ | apply IHl]; clear IHl.
+ + unfold sizeof; pose proof (sizeof_pos ty); lia. }
+ etrans; last apply IHl.
  clear - H3.
  induction l; simpl; auto.
  destruct a as [id' ty']. simpl in *.
- apply sepcon_derives; auto.
- replace (Map.get (fun id0 : positive => (PTree.remove id ve) ! id0) id')
-   with (Map.get (fun id0 : positive => ve ! id0) id'); auto.
+ apply bi.sep_mono; auto.
+ replace (Map.get (fun id0 : positive => Maps.PTree.get id0 (Maps.PTree.remove id ve)) id')
+   with (Map.get (fun id0 : positive => Maps.PTree.get id0 ve) id'); auto.
  unfold Map.get.
- rewrite PTree.gro; auto.
+ rewrite Maps.PTree.gro; auto.
  intros id' ty'; specialize (H1 id' ty').
- {split; intro.
+ { split; intro.
  - destruct H1 as [H1 _].
    assert (id<>id').
    intro; subst id'.
-   clear - H3 H5; induction l; simpl in *. rewrite PTree.gempty in H5; inv H5.
+   clear - H3 H5; induction l; simpl in *. rewrite Maps.PTree.gempty in H5; inv H5.
    destruct a; simpl in *.
-   rewrite PTree.gso in H5. auto. auto.
+   rewrite Maps.PTree.gso in H5. auto. auto.
    destruct H1 as [v ?].
-   rewrite PTree.gso; auto.
-   exists v. unfold Map.get. rewrite PTree.gro; auto.
+   rewrite Maps.PTree.gso; auto.
+   exists v. unfold Map.get. rewrite Maps.PTree.gro; auto.
  - unfold Map.get in H1,H5.
    assert (id<>id').
-     clear - H5; destruct H5. intro; subst. rewrite PTree.grs in H. inv H.
-   rewrite PTree.gro in H5 by auto.
-   rewrite <- H1 in H5. rewrite PTree.gso in H5 by auto. auto.
- }
+     clear - H5; destruct H5. intro; subst. rewrite Maps.PTree.grs in H. inv H.
+   rewrite -> Maps.PTree.gro in H5 by auto.
+   rewrite <- H1 in H5. rewrite -> Maps.PTree.gso in H5; auto. }
  hnf; intros.
- destruct (make_venv (PTree.remove id ve) id0) eqn:H5; auto.
+ destruct (make_venv (Maps.PTree.remove id ve) id0) eqn:H5; auto.
  destruct p.
  unfold make_venv in H5.
  destruct (peq id id0).
- subst.  rewrite PTree.grs in H5. inv H5.
- rewrite PTree.gro in H5 by auto.
+ subst. rewrite Maps.PTree.grs in H5. inv H5.
+ rewrite -> Maps.PTree.gro in H5 by auto.
  specialize (H7 id0). unfold make_venv in H7. rewrite H5 in H7.
  destruct H7; auto. inv H6; congruence.
 Qed.
 
 Definition maybe_retval (Q: assert) retty ret :=
- match ret with
- | Some id => fun rho => !!(tc_val' retty (eval_id id rho)) && Q (get_result1 id rho)
+ assert_of (match ret with
+ | Some id => fun rho => ⌜tc_val' retty (eval_id id rho)⌝ ∧ Q (get_result1 id rho)
  | None =>
     match retty with
     | Tvoid => (fun rho => Q (globals_only rho))
-    | _ => fun rho => EX v: val, !!(tc_val' retty v) && Q (make_args (ret_temp::nil) (v::nil) rho)
+    | _ => fun rho => ∃ v: val, ⌜tc_val' retty v⌝ ∧ Q (make_args (ret_temp::nil) (v::nil) rho)
     end
- end.
-
-Lemma VALspec_range_free:
-  forall n b phi1 jm,
-  app_pred (VALspec_range n Share.top (b, 0)) phi1 ->
-  join_sub phi1 (m_phi jm) ->
-  {m' | free (m_dry jm) b 0 n = Some m' }.
-Proof.
-intros.
-apply range_perm_free.
-destruct H0 as [phi2 H0].
-hnf; intros.
-pose proof (juicy_mem_access jm (b,ofs)).
-hnf. unfold access_at in H2. simpl in H2.
-specialize (H (b,ofs)).
-hnf in H.
-rewrite if_true in H by (split; auto; lia).
-destruct H as [v ?].
-apply (resource_at_join _ _ _ (b,ofs)) in  H0.
-destruct H.
-hnf in H.
-rewrite H in H0.
-rewrite H2.
-inv H0; simpl; apply join_top in RJ; subst sh3; rewrite perm_of_freeable; constructor.
-Qed.
+ end).
 
-Lemma Forall_filter: forall {A} P (l: list A) f, Forall P l -> Forall P (filter f l).
+Lemma Forall_filter: forall {A} P (l: list A) f, Forall P l -> Forall P (List.filter f l).
 Proof.
   intros.
   induction l.
@@ -1035,270 +470,57 @@ Proof.
     - auto.
 Qed.
 
-Lemma can_free_list {CS}:
-  forall Delta F f jm ge ve te
+Lemma free_stackframe :
+  forall {CS'} Delta f m ge ve te
   (NOREP: list_norepet (map (@fst _ _) (fn_vars f)))
-  (COMPLETE: Forall (fun it => complete_type cenv_cs (snd it) = true) (fn_vars f))
-  (HGG: cenv_sub (@cenv_cs CS) (genv_cenv ge)),
+  (COMPLETE: Forall (fun it => complete_type (@cenv_cs CS') (snd it) = true) (fn_vars f))
+  (HGG: cenv_sub (@cenv_cs CS') (genv_cenv ge)),
    guard_environ (func_tycontext' f Delta) f
         (construct_rho (filter_genv ge) ve te) ->
-    (F * stackframe_of f (construct_rho (filter_genv ge)ve te))%pred (m_phi jm) ->
-   exists m2, free_list (m_dry jm) (blocks_of_env ge ve) = Some m2.
+   mem_auth m ∗ stackframe_of f (construct_rho (filter_genv ge) ve te) ⊢
+   |==> ∃ m2, ⌜free_list m (blocks_of_env ge ve) = Some m2⌝ ∧ mem_auth m2.
 Proof.
   intros.
-  destruct H0 as [? [? [? [_ ?]]]].
-  unfold stackframe_of in H1.
-  unfold blocks_of_env in *.
-  destruct H as [_ [H _]]; clear - NOREP COMPLETE HGG H H0 H1. simpl in H.
-  pose (F vl := (fold_right
-          (fun (P Q : environ -> pred rmap) (rho : environ) => P rho * Q rho)
-          (fun _ : environ => emp)
-          (map (fun idt : ident * type => var_block Share.top idt) vl))).
-  change ((F (fn_vars f)  (construct_rho (filter_genv ge) ve te)) x0) in H1.
-  assert (forall id b t, In (id,(b,t)) (PTree.elements ve) ->
-                In (id,t) (fn_vars f)). {
-   intros.
-    apply PTree.elements_complete in  H2.
-    specialize (H id); unfold make_venv in H; rewrite H2 in H.
-     apply H.
-  }
-  clear H.
-  assert (Hve: forall i bt, In (i,bt) (PTree.elements ve) -> ve ! i = Some bt)
-    by apply PTree.elements_complete.
-  assert (NOREPe: list_norepet (map (@fst _ _) (PTree.elements ve)))
-    by apply PTree.elements_keys_norepet.
-  forget (PTree.elements ve) as el.
-  rename x0 into phi.
-  assert (join_sub phi (m_phi jm)).
-  econstructor; eauto.
-  clear H0.
-  forget (fn_vars f) as vl.
-  revert vl phi jm H H1 H2 Hve NOREP NOREPe COMPLETE; induction el; intros;
-    [ solve [simpl; eauto] | ].
-  simpl in H2.
-  destruct a as [id [b t]]. simpl in NOREPe,H2|-*.
-  assert (H2': In (id,t) vl) by (apply H2 with b; auto).
-  specialize (IHel (filter (fun idt => negb (eqb_ident (fst idt) id)) vl)).
-  replace (F vl (construct_rho (filter_genv ge) ve te))
-    with  (var_block Share.top (id,t) (construct_rho (filter_genv ge) ve te)
-    * F (filter (fun idt => negb (eqb_ident (fst idt) id)) vl) (construct_rho (filter_genv ge) ve te)) in H1.
-  2:{
-    clear - H2' NOREP.
-    induction vl; inv H2'.
-    simpl in NOREP.
-    inv NOREP.
-    unfold F; simpl fold_right.
-    f_equal.
-    f_equal.
-    f_equal.
-    replace (eqb_ident id id) with true
-      by (symmetry; apply (eqb_ident_spec id id); auto).
-    simpl.
-    clear - H1.
-    induction vl; simpl; auto.
-    replace (negb (eqb_ident (fst a) id)) with true.
-    f_equal.
-    apply IHvl.
-    contradict H1. right; auto.
-    pose proof (eqb_ident_spec (fst a) id).
-    destruct (eqb_ident (fst a) id) eqn:?; auto.
-    exfalso; apply H1. left. rewrite <- H; auto.
-    transitivity
-     (var_block Share.top a (construct_rho (filter_genv ge) ve te) *
-         F vl (construct_rho (filter_genv ge) ve te)); [ | reflexivity].
-    inv NOREP.
-    rewrite <- IHvl; auto.
-    repeat rewrite <- sepcon_assoc.
-    simpl filter.
-    replace (eqb_ident (fst a) id) with false.
-    simpl.
-    unfold F at 1.
-    simpl.
-    symmetry;
-    rewrite (sepcon_comm (var_block _ _ _ )).
-    repeat rewrite sepcon_assoc.
-    reflexivity.
-    pose proof (eqb_ident_spec (fst a) id).
-    destruct (eqb_ident (fst a) id); auto.
-    assert (fst a = id) by (apply H0; auto).
-    subst id.
-    contradiction H2.
-    replace (fst a) with (fst (fst a, t)) by reflexivity.
-    apply in_map; auto.
-  }
-  pose (H0:=True).
-  destruct H1 as [phi1 [phi2 [? [? ?]]]].
-  unfold var_block in H3.
-  normalize in H3.
-  simpl in H3.
-  assert (0 <= sizeof t) by (unfold sizeof; pose proof (sizeof_pos t); lia).
-  simpl in H5.
-  unfold eval_lvar, Map.get in H3. simpl in H3.
-  unfold make_venv in H3.
-  rewrite (Hve id (b,t)) in H3 by (left; auto).
-  rewrite eqb_type_refl in H3.
-  simpl in H3; destruct H3 as [H99 H3].
-  rewrite memory_block'_eq in H3;
-  try rewrite Ptrofs.unsigned_zero; try lia.
-  2:{
-   rewrite Z.add_0_r; rewrite Z2Nat.id by lia. change (Ptrofs.unsigned Ptrofs.zero) with 0 in H99; lia.
-  }
-  unfold memory_block'_alt in H3.
-  rewrite Ptrofs.unsigned_zero in H3.
-  rewrite Z2Nat.id in H3 by lia.
-  rewrite if_true in H3 by apply readable_share_top.
-  assert (join_sub phi1 (m_phi jm)) as H7
-   by ( apply join_sub_trans with phi; auto; eexists; eauto).
-  destruct (VALspec_range_free _ _ _ _ H3 H7)
-   as [m3 ?H].
-  assert (VR: app_pred (VALspec_range (sizeof t-0) Share.top (b, 0) * TT) (m_phi jm)).
-    clear - H3 H7. destruct H7.
-  rewrite Z.sub_0_r; exists phi1; exists x; split3; auto.
-  pose (jm3 := free_juicy_mem _ _ _ _ _ H8 ).
-  destruct H as [phix H].
-  destruct (join_assoc H1 H) as [phi3 []].
-  assert (ext_order phi3 (m_phi jm3)) as Hext.
-  { eapply juicy_free_lemma'; eauto.
-    rewrite Z.sub_0_r; auto.
-  }
-  assert (join_sub phi2 (m_phi jm3)) as Hphi2.
-  { eapply join_sub_trans; [eexists; eauto | apply ext_join_sub; auto]. }
-  destruct (IHel phi2 jm3 Hphi2) as [m4 ?]; auto; clear IHel.
-  + intros.
-    specialize (H2 id0 b0 t0).
-    spec H2; [ auto |].
-    assert (id0 <> id).
-    {
-      clear - NOREPe H11.
-      inv NOREPe. intro; subst.
-      apply H1. change id with (fst (id,(b0,t0))); apply in_map; auto.
-    }
-    clear - H2 H12.
-    induction vl; simpl in *; auto.
-    destruct H2. subst a. simpl.
-    replace (eqb_ident id0 id) with false; simpl; auto.
-    pose proof (eqb_ident_spec id0 id); destruct (eqb_ident id0 id); simpl in *; auto.
-    contradiction H12; apply H; auto.
-    pose proof (eqb_ident_spec (fst a) id); destruct (eqb_ident (fst a) id); simpl in *; auto.
-  + intros; eapply Hve; eauto.
-    right; auto.
-  + clear - NOREP.
-    induction vl; simpl; auto.
-    pose proof (eqb_ident_spec (fst a) id); destruct (eqb_ident (fst a) id); simpl in *; auto.
-    assert (fst a = id) by ( apply H; auto); subst.
-    apply IHvl; inv NOREP; auto.
-    inv NOREP.
-    constructor; auto.
-    clear - H2.
-    contradict H2.
-    induction vl; simpl in *; auto.
-    destruct (eqb_ident (fst a0) id); simpl in *; auto.
-    destruct H2; auto.
-  + inv NOREPe; auto.
-  + apply Forall_filter; auto.
-  + pose proof (proj1 (Forall_forall _ _) COMPLETE (id, t) H2').
-    simpl in H11.
-    exists m4.
-    rewrite (cenv_sub_sizeof HGG) by auto.
-    unfold sizeof in H8; rewrite H8; auto.
-Qed.
-
-Lemma age_juicy_mem_i:
-  forall jm jm', m_dry jm = m_dry jm' ->
-        age (m_phi jm) (m_phi jm') ->
-       age jm jm'.
-Proof.
-intros.
-hnf in H0 |-*.
-unfold age1; simpl.
-apply age1_juicy_mem_unpack'; auto.
-Qed.
-
-Lemma free_juicy_mem_resource_decay:
-  forall jm b lo hi m' jm'
-     (H : free (m_dry jm) b lo hi = Some m')
-     (H0 : forall ofs : Z,  lo <= ofs < hi ->
-             perm_of_res (m_phi jm @ (b, ofs)) = Some Freeable),
-    free_juicy_mem jm m' b lo hi H = jm' ->
-    resource_decay (nextblock (m_dry jm)) (m_phi jm) (m_phi jm').
-Proof.
-intros.
- subst jm'. simpl.
- apply (inflate_free_resource_decay _ _ _ _ _ H H0).
-Qed.
-
-Lemma free_list_resource_decay:
-  forall bl jm jm',
-  free_list_juicy_mem jm bl jm' ->
-  resource_decay (nextblock (m_dry jm)) (m_phi jm) (m_phi jm').
-Proof.
-induction 1; intros.
-apply resource_decay_refl; intros.
-apply (juicy_mem_alloc_cohere jm l H).
-apply resource_decay_trans with (nextblock (m_dry jm)) (m_phi jm2).
-apply Pos.le_refl.
-eapply free_juicy_mem_resource_decay; eauto.
-rewrite <- (nextblock_free _ _ _ _ _ H).
-apply IHfree_list_juicy_mem.
+  iIntros "(Hm & stack)".
+  rewrite stackframe_of_freeable_blocks //.
+  clear.
+  forget (blocks_of_env ge ve) as el.
+  iInduction el as [|] "IHel" forall (m); first eauto.
+  destruct a as ((id, b), t); simpl.
+  iDestruct "stack" as "(H & stack)".
+  iDestruct (VALspec_range_can_free with "[$Hm $H]") as %(m' & ?).
+  rewrite /= Zplus_minus in H; rewrite H.
+  iMod (VALspec_range_free with "[$Hm $H]") as "Hm"; first done.
+  iApply ("IHel" with "Hm stack").
 Qed.
 
 Definition tc_fn_return (Delta: tycontext) (ret: option ident) (t: type) :=
  match ret with
- | None => True
- | Some i => match (temp_types Delta) ! i with Some t' => t=t' | _ => False end
+ | None => True%type
+ | Some i => match (temp_types Delta) !! i with Some t' => t=t' | _ => False%type end
  end.
 
-Lemma derives_refl' {A: Type} `{ageable A} {EO: Ext_ord A} :
-    forall P Q: pred A, P=Q -> P |-- Q.
-Proof.  intros; subst; apply derives_refl. Qed.
-
- Lemma free_juicy_mem_core:
-  forall jm m b lo hi H
-   (H0 : forall ofs : Z,
-     lo <= ofs < hi -> perm_of_res (m_phi jm @ (b, ofs)) = Some Freeable),
-   core (m_phi (free_juicy_mem jm m b lo hi H)) = core (m_phi jm).
-Proof.
- intros.
- apply rmap_ext.
- do 2  rewrite level_core.
- apply free_juicy_mem_level.
- intros.
- repeat rewrite <- core_resource_at.
- simpl m_phi. unfold inflate_free. rewrite resource_at_make_rmap.
- destruct (m_phi jm @ l) eqn:?; auto.
- if_tac; rewrite !core_NO; auto.
- if_tac. rewrite core_YES, core_NO; auto. rewrite !core_YES; auto.
- if_tac; auto.
- destruct l; destruct H1; subst. specialize (H0 z).
- spec H0; [lia | ]. rewrite Heqr in H0. inv H0.
- rewrite !ghost_of_core, free_juicy_mem_ghost; auto.
-Qed.
-
 Lemma same_glob_funassert':
   forall Delta1 Delta2 rho rho',
-     (forall id, (glob_specs Delta1) ! id = (glob_specs Delta2) ! id) ->
+     (forall id, (glob_specs Delta1) !! id = (glob_specs Delta2) !! id) ->
       ge_of rho = ge_of rho' ->
-              funassert Delta1 rho = funassert Delta2 rho'.
+              funassert Delta1 rho ⊣⊢ funassert Delta2 rho'.
 Proof.
-assert (forall Delta Delta' rho rho',
-             (forall id, (glob_specs Delta) ! id = (glob_specs Delta') ! id) ->
+  assert (forall Delta Delta' rho rho',
+             (forall id, (glob_specs Delta) !! id = (glob_specs Delta') !! id) ->
              ge_of rho = ge_of rho' ->
-             funassert Delta rho |-- funassert Delta' rho').
-+ intros.
-  unfold funassert.
-  intros w [? ?]; split.
-  - clear H2; intro id. rewrite <- (H id), <- H0; auto.
-  - intros loc sig cc ? w' Hw' Hext H4; destruct (H2 loc sig cc _ _ Hw' Hext H4)  as [id H3].
-    exists id; rewrite <- (H id), <- H0; auto.
-+ intros.
-  apply pred_ext; apply H; intros; auto.
+             funassert Delta rho ⊢ funassert Delta' rho') as H; last by intros; iSplit; iApply H.
+  intros ???? H; simpl; intros ->.
+  iIntros "(#? & H2)"; iSplit.
+  - iIntros "!>" (??); rewrite -H //.
+  - setoid_rewrite <- H; done.
 Qed.
 
 Definition thisvar (ret: option ident) (i : ident) : Prop :=
  match ret with None => False | Some x => x=i end.
 
 Lemma closed_wrt_modvars_Scall:
-  forall ret a bl, closed_wrt_modvars (Scall ret a bl) = closed_wrt_vars (thisvar ret).
+  forall ret a bl, closed_wrt_modvars(Σ:=Σ) (Scall ret a bl) = closed_wrt_vars (thisvar ret).
 Proof.
 intros.
 unfold closed_wrt_modvars.
@@ -1307,518 +529,152 @@ f_equal.
  extensionality i; unfold modifiedvars, modifiedvars', insert_idset.
  unfold isSome, idset0, insert_idset; destruct ret; simpl; auto.
  destruct (ident_eq i0 i).
- subst. rewrite PTree.gss. apply prop_ext; split; auto.
- rewrite PTree.gso by auto. rewrite PTree.gempty.
- apply prop_ext; split ;intro; try contradiction.
+ subst. rewrite Maps.PTree.gss. apply prop_ext; split; auto.
+ rewrite -> Maps.PTree.gso; last auto. rewrite Maps.PTree.gempty.
+ apply prop_ext; split; intro; contradiction.
 Qed.
 
-Lemma assert_safe_jmupd_for_external_call {Espec psi curf vx ret ret0 tx k z' m'}
-      (AS: assert_safe Espec psi curf vx (set_opttemp ret (force_val ret0) tx)
-         (Cont k) (construct_rho (filter_genv psi) vx (set_opttemp ret (force_val ret0) tx)) (m_phi m')):
-  jm_fupd z' Ensembles.Full_set Ensembles.Full_set (jsafeN OK_spec psi z' (Returnstate (force_val ret0) (Kcall ret curf vx tx k))) m'.
+Lemma assert_safe_for_external_call {psi E curf vx ret ret0 tx k z'} :
+      assert_safe OK_spec psi E curf vx (set_opttemp ret (force_val ret0) tx)
+         (Cont k) (construct_rho (filter_genv psi) vx (set_opttemp ret (force_val ret0) tx)) ⊢
+  jsafeN OK_spec psi E z' (Returnstate (force_val ret0) (Kcall ret curf vx tx k)).
 Proof.
-(* this proof is like assert_safe_jsafe *)
-  repeat intro.
-  destruct (level (m_phi m')) eqn: Hl.
-  { do 2 eexists; eauto; split; unfold jm_update; auto.
-    apply necR_level in H; apply join_level in H0 as []; rewrite <- !level_juice_level_phi in *; lia. }
-  assert (ext_compat z' (m_phi m')) as Hext.
-  { eapply ext_compat_unnec; [apply necR_jm_phi; eauto|].
-    eapply join_sub_joins_trans; [eexists; apply ghost_of_join; eauto|].
-    eapply joins_comm, join_sub_joins_trans; [|apply joins_comm; eauto].
-    destruct H3 as [? J]; eapply ghost_fmap_join in J; eexists; eauto. }
-  specialize (AS _ _ Hext eq_refl eq_refl).
-  spec AS; [lia|].
-  destruct k; eapply jm_fupd_mono; eauto; intros ?? Hsafe; try contradiction.
--
-  eapply jsafeN_local_step. constructor.
-  intros.
-  eapply age_safe; eauto.
-  inv Hsafe; [constructor; auto | | discriminate | contradiction].
-  destruct H7.
-  inv H7.
-  eapply jsafeN_step.
-  split. eapply step_skip_call; eauto. hnf; auto. auto. auto.
--
-  eapply jsafeN_local_step. constructor.
-  hnf; auto. eauto.
-  intros.
-  eapply age_safe; eauto.
-  eapply jsafeN_local_step. constructor.
-  intros.
-  eapply age_safe; eauto.
--
-  eapply jsafeN_local_step. constructor.
-  intros.
-  eapply age_safe; eauto.
--
-  eapply jsafeN_local_step. constructor.
-  intros.
-  eapply age_safe; eauto.
-  eapply jsafeN_local_step. constructor.
-  intros.
-  eapply age_safe; eauto.
--
-  eapply jsafeN_local_step. constructor.
-  intros.
-  eapply age_safe; eauto.
-  inv Hsafe; [constructor; auto | | discriminate | contradiction].
-  destruct H7.
-  inv H7.
-  eapply jsafeN_step.
-  split. eapply step_skip_call; eauto. hnf; auto. auto. auto.
+  iIntros "H".
+  iApply jsafe_step; rewrite /jstep_ex.
+  iIntros (?) "? !>".
+  iExists _, _; iSplit; first by iPureIntro; constructor.
+  iFrame.
+  by iApply assert_safe_jsafe'.
 Qed.
 
 Lemma semax_call_external
- (CS : compspecs) (Espec : OracleKind) (Delta : tycontext)
+ E (Delta : tycontext)
  (A : TypeTree)
- (P : forall ts : list Type,  (dependent_type_functor_rec ts (ArgsTT A)) mpred)
- (Q : forall ts : list Type,  (dependent_type_functor_rec ts (AssertTT A)) mpred)
- (NEP : args_super_non_expansive P) (NEQ' : super_non_expansive Q)
- (ts : list Type)
- (x : (dependent_type_functor_rec ts A) mpred)
- (F : environ -> pred rmap) (F0 : assert)
- (ret : option ident) (curf : function) (fsig : typesig) (cc : calling_convention)
+ (P : dtfr (ArgsTT A))
+ (Q : dtfr (AssertTT A))
+ (F0 : assert)
+ (ret : option ident) (curf : function) (fsig : typesig) (cc : calling_convention) (nE : dtfr (MaskTT A))
  (R : ret_assert) (psi : genv) (vx : env) (tx : temp_env)
- (k : cont) (rho : environ) (ora : OK_ty) (b : block) (jm : juicy_mem)
- (Hora : (ext_compat ora) (m_phi jm))
+ (k : cont) (rho : environ) (ora : OK_ty) (b : block)
  (TCret : tc_fn_return Delta ret (snd fsig))
  (TC3 : guard_environ Delta curf rho)
  (TC5 : snd fsig = Tvoid -> ret = None)
  (H : closed_wrt_vars (thisvar ret) F0)
  (H0 : rho = construct_rho (filter_genv psi) vx tx)
- (H1 : (rguard Espec psi Delta curf (frame_ret_assert R F0) k) (level (m_phi jm)))
- (H4 : (funassert Delta rho) (m_phi jm))
  (args : list val)
- (H14 : (F0 rho * F rho *
-              P ts x (ge_of rho, args))%pred
-              (m_phi jm))
- (H5 : (believe_external Espec psi (Vptr b Ptrofs.zero) fsig cc A P Q) (S (level jm)))
  (ff : Clight.fundef)
  (H16 : Genv.find_funct psi (Vptr b Ptrofs.zero) = Some ff)
  (TC8 : tc_vals (fst fsig) args)
  (Hargs : Datatypes.length (fst fsig) = Datatypes.length args)
- (ctl := Kcall ret curf vx tx k : cont)
- (HR : (ALL rho' : environ,
-      |> ! ((EX old : val,
-             substopt ret (`old) F rho' *
-             maybe_retval (Q ts x) (snd fsig) ret rho') >=>
-            fupd (RA_normal R rho'))) (m_phi jm))
- : jsafeN OK_spec psi ora (Callstate ff args ctl) jm.
-Proof.
+ (ctl : cont) (Hctl : ∀ ret0 z', assert_safe OK_spec psi E curf vx (set_opttemp ret (force_val ret0) tx)
+             (exit_cont EK_normal None k)  (construct_rho (filter_genv psi) vx (set_opttemp ret (force_val ret0) tx)) ⊢
+    jsafeN OK_spec psi E z' (Returnstate (force_val ret0) ctl)) :
+ □ believe_external OK_spec psi (Vptr b Ptrofs.zero) fsig cc A nE P Q -∗
+ ▷ (<affine> rguard OK_spec psi E Delta curf (frame_ret_assert R F0) k -∗
+    funassert Delta rho -∗
+    F0 rho -∗
+    (|={E}=> ∃ (x1 : dtfr A) (F1 : assert),
+               ⌜nE x1 ⊆ E⌝ ∧ (F1 rho ∗ P x1 (ge_of rho, args))
+               ∧ (∀ rho' : environ,
+                    ■ ((∃ old : val, substopt ret (` old) F1 rho' ∗
+                          maybe_retval (assert_of (Q x1)) (snd fsig) ret rho') -∗ RA_normal R rho'))) -∗
+    jsafeN OK_spec psi E ora (Callstate ff args ctl)).
+Proof.
+pose proof TC3 as Hguard_env.
 destruct TC3 as [TC3 TC3'].
-rename H5 into H15.
-unfold believe_external in H15.
-rewrite H16 in H15.
-destruct ff; try contradiction H15.
-
-destruct H15 as [[H5 H15] Hretty]. hnf in H5.
-destruct H5 as [H5 [H5' [Eef Hinline]]]. subst c.
-inversion H5. destruct fsig as [params retty].
-injection H2; clear H2; intros H8 H7.
-rename l into tys. subst rho.
-destruct (age1 jm) as  [jm' |] eqn:Hage.
-2:{ constructor. apply age1_level0; auto. }
-specialize (H15 psi ts x (level jm)).
-spec H15. apply age_laterR. constructor.
-specialize (H15
-  (F0 (construct_rho (filter_genv psi) vx tx) *
-          F (construct_rho (filter_genv psi) vx tx))
-   (map typ_of_type tys) args jm).
-spec H15; [ clear; lia | ].
-specialize (H15 _ _ (necR_refl _) (ext_refl _)).
-spec H15.
-{ clear - Eef Hargs H14 TC8.
-  assert (AP: app_pred ((P ts x (filter_genv psi, args) *
-    (F0 (construct_rho (filter_genv psi) vx tx) *
-     F (construct_rho (filter_genv psi) vx tx)))) (m_phi jm)).
-  { rewrite sepcon_comm.
-    eapply sepcon_derives; try apply H14; auto.
-  }
-  clear - Eef TC8 AP.
-  simpl.
-  split.
-  { (* typechecking arguments *)
-    rewrite Eef; simpl.
-    clear - TC8.
-    revert args TC8; induction params; destruct args; intros; try discriminate; auto.
-    inv TC8.
-    split; auto.
-    rewrite proj_xtype_argtype.
-    apply tc_val_has_type; auto.
-  }
-  apply AP.
-}
-clear H14 TC8. simpl fst in *. simpl snd in *.
-destruct H15 as [x' H15].
-clear H5.
-destruct H15 as [H5 H15].
-specialize (H15 (rettype_of_type retty)).
-do 3 red in H15.
-destruct Hinline as [Hinline|Hempty].
-2:{
-exfalso; clear - Hempty x.
-eapply Hempty. eassumption.
-}
-assert (Hty: params = tys) by (rewrite H7; trivial).
-eapply @jsafeN_external with (x := x'); eauto.
-
-+ (*1/3*)
-  simpl.
-  rewrite Hinline.
-  reflexivity.
-
-+ (*2/3*)
-  rewrite Eef. subst tys. simpl. rewrite map_proj_xtype_argtype. apply H5; auto.
-
-+
-assert (H2 := I). assert (H3 := I). simpl.
-intros.
-eexists; split; [ reflexivity |].
-
+rewrite /believe_external H16.
+iIntros "#ext".
+destruct ff; first done.
+iDestruct "ext" as "((-> & -> & %Eef & %Hinline) & He & Htc)".
+rename l into tys.
+iIntros "!> rguard fun F0 HR".
+iMod "HR" as (???) "((F1 & P) & #HR)".
+iApply fupd_jsafe.
+iMod (fupd_mask_subseteq (nE x1)) as "Hmask"; first done.
+iMod ("He" $! psi x1 (F0 rho ∗ F1 rho) (map typ_of_type tys) args with "[F0 F1 P]") as "He1".
+{ subst rho; iFrame; iPureIntro; split; auto.
+  (* typechecking arguments *)
+  rewrite Eef map_proj_xtype_argtype; simpl.
+  clear - TC8.
+  revert args TC8; induction tys; destruct args; intros; try discriminate; auto.
+  inv TC8.
+  split; auto.
+  apply tc_val_has_type; auto. }
+iMod "Hmask" as "_".
+clear TC8. simpl fst in *. simpl snd in *.
+rewrite /jsafeN jsafe_unfold /jsafe_pre.
+iIntros "!> !>" (?) "s"; iDestruct ("He1" with "s") as (x') "(%pre & post)".
+destruct Hinline as [Hinline | ?]; last done.
+iRight; iRight; iExists e, _, _; iSplit.
+{ iPureIntro; simpl.
+  rewrite Hinline Eef map_proj_xtype_argtype //. }
+rewrite Eef.
+iDestruct "rguard" as "#rguard".
+iNext.
+iIntros (??? [??]) "?".
+iMod (fupd_mask_subseteq (nE x1)) as "Hmask"; first done.
+iMod ("post" with "[$]") as "(? & Q & F0 & F)".
+iMod "Hmask" as "_".
+iDestruct ("Htc" with "[Q]") as %Htc; first by iFrame.
 pose (tx' := match ret,ret0 with
-                   | Some id, Some v => PTree.set id v tx
+                   | Some id, Some v => Maps.PTree.set id v tx
                    | _, _ => tx
                    end).
-
-specialize (H15 ret0 z').
-change ((ext_spec_post' Espec e x' (genv_symb_injective psi) (rettype_of_type retty) ret0 z' >=>
-        juicy_mem_op
-          (Q ts x (make_ext_rval  (filter_genv psi) (rettype_of_type retty) ret0) *
-              (F0 (construct_rho (filter_genv psi) vx tx) *
-               F (construct_rho (filter_genv psi) vx tx)))) (level jm)) in H15.
-apply (pred_nec_hereditary _ _ (level m')) in H15.
- 2:{ destruct H0. apply nec_nat. lia. }
-apply (pred_nec_hereditary _ _ (level m')) in H15;
- [ | apply nec_nat; lia].
-rewrite Eef in *.
-specialize (H15 m' (Nat.le_refl _) _ _ (necR_refl _) (ext_refl _) H6).
-assert (LAT: laterM (level (m_phi jm)) (level jm')). { simpl; apply laterR_level'. constructor. apply age_jm_phi. apply Hage. }
-apply (pred_nec_hereditary _ _ _ (laterR_necR LAT)) in H1.
-
-specialize (H1 EK_normal None tx' vx).
-assert (LATER: laterM (m_phi jm) (m_phi jm')). { clear - Hage. apply age_laterR. apply age1_juicy_mem_Some in Hage; trivial. }
-
-assert (H1' : forall a' : rmap,
-     necR (m_phi m') a' ->
-     (!! guard_environ Delta curf (construct_rho (filter_genv psi) vx tx') &&
-      seplog.sepcon (fun rho0 => EX old:val, substopt ret (`old) F rho0 * maybe_retval (Q ts x) retty ret rho0) F0 (construct_rho (filter_genv psi) vx tx') &&
-      funassert Delta (construct_rho (filter_genv psi) vx tx')) a' ->
-     (assert_safe Espec psi curf vx tx' (exit_cont EK_normal None k) (construct_rho (filter_genv psi) vx tx')) a').
-{ intros a' NEC Ha'.
-  destruct Ha' as [[HA HB] HY].
-  assert ((level (m_phi jm') >= level a')%nat).
-  { destruct H0; apply necR_level in NEC; subst. rewrite <- level_juice_level_phi in *. apply age_level in Hage. lia. }
-  assert (fupd (RA_normal R (construct_rho (filter_genv psi) vx tx') * F0 (construct_rho (filter_genv psi) vx tx')) a') as Ha'.
-  { apply fupd.fupd_frame_r.
-    destruct HB as [a1 [a2 [J [A1 A2]]]]; exists a1, a2; split; auto; split; auto.
-    eapply (HR (construct_rho (filter_genv psi) vx tx') _ LATER a1); auto.
-    destruct (join_level _ _ _ J) as [-> ?]; auto. }
-  eapply fupd.subp_fupd in H1; [|apply derives_refl].
-  eapply assert_safe_fupd, H1; eauto.
-  rewrite andp_comm; apply fupd.fupd_andp_corable; [apply corable_funassert|].
-  split; auto.
-  apply fupd.fupd_andp_prop; split; auto.
-  rewrite proj_frame_ret_assert; unfold proj_ret_assert.
-  eapply fupd.fupd_mono, Ha'; simpl.
-  rewrite prop_true_andp; auto. }
-
-clear H1; rename H1' into H1. clear R HR.
-
-simpl exit_cont in H1.
-do 3 red in H5.
-specialize (H1 _ (necR_refl _)).
-subst t.
-
-assert (Htc: tc_option_val retty ret0).
-{ clear - TCret TC3 H0 TC5 H15 Hretty Hretty0 H6 Hage.
-  destruct H15 as [phi1 [phi2 [Ha [Hb Hc]]]].
-  specialize (Hretty ts x ret0 phi1).
-  spec Hretty.
-  { apply join_level in Ha. destruct Ha as [? ?].
-    rewrite H. cut ((level jm > level jm')%nat). intros.
-    simpl. unfold natLevel. do 2 rewrite <-level_juice_level_phi.
-    destruct H0.  lia.
-    apply age_level in Hage. lia.
-  }
-  specialize (Hretty phi1 phi1).
-  spec Hretty. apply rt_refl.
-  spec Hretty. reflexivity.
-  spec Hretty. split. apply Hb. apply Hretty0.
-  simpl in Hretty. auto.
-}
-spec H1.
-{ clear H1. clear - TCret TC3 H0 TC5 H15 Hretty Hretty0 H0 H6 Hage TC3' tx' Htc H H4.
-
-  split; [split; [split |] |].
-  * (*1/4*)
-    clear - TC3 Htc TCret Hretty0.
-    destruct ret. 2: subst tx'; trivial.
-    destruct ret0; subst tx'. 2: trivial.
-    unfold construct_rho in TC3. simpl in *.
-    apply (typecheck_environ_put_te _ _ _ _ i v) in TC3.
-    + unfold construct_rho in *; rewrite map_ptree_rel in *; trivial.
-    + intros. rewrite H in TCret; subst. red; intros; trivial.
-        clear - Hretty0 Htc H0. hnf in Htc. destruct t; auto.
-        hnf in Hretty0. destruct v; try contradiction.
-  * (*2/4*) clear - TC3' tx'. auto.
-  * (*3/4*)
-    do 3 red in H15.
-    rewrite (sepcon_comm (F0 _)) in H15.
-    rewrite <- sepcon_assoc in H15.
-    assert (H15': ((!!tc_option_val retty ret0 && Q ts x (make_ext_rval (filter_genv psi) (rettype_of_type retty)ret0)) *
-       F (construct_rho (filter_genv psi) vx tx) *
-       F0 (construct_rho (filter_genv psi) vx tx))%pred (m_phi m')).
-    { rewrite sepcon_assoc in H15|-*.
-      destruct H15 as [w1 [w2 [H1 [H10 H12]]]]; exists w1; exists w2; split3; auto.
-      clear - H1 H0 H10  Hage Hretty Hretty0.
-      specialize (Hretty ts x ret0 w1).
-      spec Hretty. {
-        destruct H0.
-        repeat rewrite <- level_juice_level_phi.
-        apply age_level in Hage. rewrite Hage.
-        apply join_level in H1. destruct H1.
-        rewrite H1.
-        change (S (S (level jm')) >= level m')%nat.
-        lia.
-      }
-      split.
-      + eapply Hretty; auto. split; auto.
-      + auto. }
-    clear H15.
-    revert Htc.
-    normalize in H15'.
-    do 2 red in H1.
-    intros Htc.
-    rewrite (sepcon_comm (Q _ _ _)) in H15'.
-    unfold seplog.sepcon, seplog.LiftSepLog .
-    rewrite <- exp_sepcon1.
-    eapply sepcon_derives; [apply sepcon_derives | | apply H15']; clear H15'.
-    + (* F *)
-      destruct TC3 as [TC3 _].
-      hnf in TC3; simpl in TC3.
-      hnf in TCret.
-      apply exp_right with match ret with
+iSpecialize ("rguard" $! EK_normal None tx' vx).
+set (rho' := construct_rho _ _ _).
+iPoseProof ("HR" $! rho' with "[Q F]") as "R".
+{ iExists match ret with
        | Some id =>
-           match tx ! id with
+           match tx !! id with
            | Some old => old
            | None => Vundef
            end
        | None => Vundef
-       end.
-      unfold tx' in *; clear tx'.
-      destruct ret; auto.
-      destruct ((temp_types Delta) ! i) as [ti|] eqn:H29; try contradiction.
-      specialize (TC3 _ _ H29).
-      destruct TC3 as [v [? ?]].
-
-      unfold substopt, subst.
-      apply derives_refl'.
-      f_equal.
-      unfold env_set, construct_rho.
-      simpl. f_equal.
-      unfold Map.set,Map.get, make_tenv in H2 |- *; rewrite H2.
-      destruct (type_eq retty Tvoid).
-      spec TC5; auto. inv TC5.
-      extensionality j.
-      if_tac. subst j. auto.
-      destruct ret0; auto.
-      rewrite PTree.gso; auto.
-    + (* Q *)
-      destruct (type_eq retty Tvoid).
-      --
-      subst retty. unfold maybe_retval.
-      hnf in H1.
-      spec TC5; auto; subst tx' ret.
-      destruct ret0; try contradiction; apply derives_refl.
-      --
-      destruct ret0; hnf in H; simpl in H.
-      assert (tc_val retty v).
-      { destruct retty; try congruence; auto. }
-      clear H1.
-      unfold maybe_retval.
-      destruct ret.
-      - apply andp_right.
-        { clear - n H2. subst tx'.  intros ? ? ?; unfold eval_id; simpl.
-          unfold make_tenv, Map.get; simpl. rewrite PTree.gss. apply H2. }
-        apply derives_refl'; f_equal.
-        unfold tx'.
-        unfold make_ext_rval, get_result1; simpl.
-        unfold ret_temp, eval_id, env_set; simpl.
-        f_equal.
-        unfold Map.get, make_tenv; simpl.
-        rewrite PTree.gss. simpl force_val. clear - Hretty0 n Htc. unfold rettype_of_type.
-        destruct retty as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ];  try reflexivity; try congruence;
-        destruct v; try contradiction.
-      - apply derives_trans with
-          (EX v0 : val, !! tc_val' retty v0 && Q ts x (mkEnviron (filter_genv psi) (Map.empty (block * type)) (Map.set 1 v0 (Map.empty val)))).
-        apply exp_right with v. apply andp_right. { intros ? ? ?.  trivial. }
-        unfold make_args, make_ext_rval; simpl.
-        unfold env_set, globals_only; simpl.
-        clear - Hretty0 Htc n.
-        destruct retty as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ];  try congruence;
-        destruct v; try contradiction; apply derives_refl.
-        destruct retty; try congruence; apply derives_refl.
-      - destruct retty; try contradiction.
-    + clear - H.
-      apply derives_refl'. apply H; intros.
-      unfold tx'; clear.
-      unfold thisvar; simpl.
-      destruct ret; simpl; auto.
-      destruct (ident_eq i0 i).
-      subst; auto.
-      right.
-      unfold Map.get, make_tenv.
-      destruct ret0; auto.
-      rewrite PTree.gso by auto.
-      auto.
-  * (*4/4*)
-    clear - H0 H4.
-    destruct H0.
-    destruct H4.
-    split.
-    + intros id fs ??? Hext ?.
-      specialize (H1 id fs (m_phi jm) _ (necR_refl _) (ext_refl _)).
-      spec H1; auto.
-      destruct H1 as [b [? ?]].
-      destruct H0 as [H0 H0'].
-      specialize (H0 (b,0)).
-      unfold func_at in H5. destruct fs; simpl in *.
-      rewrite H5 in H0.
-      apply (necR_PURE (m_phi m') a') in H0; eauto.
-      exists b. split; auto. apply rmap_order in Hext as (<- & <- & _). rewrite H0. simpl.
-      f_equal. f_equal.
-      assert (Hlev1: (level (m_phi m') >= level a')%nat).
-      { apply necR_level in H3; auto. }
-      extensionality ts x.
-      extensionality b0 rho.
-      rewrite !fmap_app.
-      match goal with
-      | |- ?A (?B (?C ?D)) = _ => change (A (B (C D))) with ((A oo B oo C) D)
-      end.
-      rewrite approx_oo_approx' by lia.
-      rewrite approx_oo_approx' by lia.
-      rewrite approx'_oo_approx by lia.
-      rewrite approx'_oo_approx by lia.
-      auto.
-    + intros b sig cc ??? Hext ?.
-      specialize (H2 b sig cc (m_phi jm)).
-      specialize (H2 _ (necR_refl _) (ext_refl _)); spec H2; auto.
-      destruct H0 as [H0 H0'].
-      specialize (H0' (b,0)).
-      simpl in *.
-      destruct H4 as [b0 ?].
-      apply rmap_order in Hext as (Hl & Hr & _); rewrite <- Hl, <- Hr in H4.
-      destruct (m_phi m' @ (b,0)) eqn:?.
-      eapply necR_NOx in Heqr; try apply H3. inversion2 H4 Heqr.
-      eapply necR_YES in Heqr; try apply H3. inversion2 H4 Heqr.
-      destruct H0' as [pp ?].
-      rewrite H5.
-      exists pp.
-      assert (H9 := necR_PURE _ _ _ _ _ H3 Heqr).
-      rewrite H4 in H9. inv H9.
-      f_equal.
-      pose proof (resource_at_approx (m_phi jm) (b,0)).
-      rewrite H5 in H6; simpl in H6.
-      injection H6; intro. symmetry in H7. apply H7.
-  }
-
-clear - H0 Htc TCret TC5 tx' H1.
-destruct H0 as (AA&BB).
-change (jm_fupd z' Ensembles.Full_set Ensembles.Full_set
-  (jsafeN OK_spec psi z'
-     (Returnstate (force_val ret0) (Kcall ret curf vx tx k))) m').
-replace tx' with (set_opttemp ret (force_val ret0) tx) in H1.
-2:{ subst tx'.
+       end; subst rho' tx'; unfold_lift; destruct ret; simpl.
+  * destruct ret0.
+    2: { clear - TC5 Htc; destruct t; try contradiction; by spec TC5. }
+    destruct TC3 as [TC3 _].
+    hnf in TC3; simpl in TC3.
+    hnf in TCret.
+    destruct ((temp_types Delta) !! i) as [ti|] eqn: Hi; try contradiction.
+    destruct (TC3 _ _ Hi) as (vi & Htx & ?); subst. 
+    rewrite /get_result1 /eval_id /= /make_tenv /Map.get in Htx |- *; rewrite Maps.PTree.gss Htx.
+    rewrite /subst /env_set /= -map_ptree_rel Map.override Map.override_same //; iFrame.
+    iSplit; first by iPureIntro; apply tc_val_tc_val'; destruct ti; try (specialize (TC5 eq_refl)).
+    rewrite /make_ext_rval.
+    destruct ti; try destruct i0, s; try destruct f; try (specialize (TC5 eq_refl)); iFrame; first done; destruct v; contradiction.
+  * subst rho; iFrame.
+    destruct (eq_dec t Tvoid); first by subst.
+    destruct ret0; last by destruct t; contradiction.
+    iAssert (∃ v0 : val, ⌜tc_val' t v0⌝ ∧ Q x1 (env_set (globals_only (construct_rho (filter_genv psi) vx tx)) ret_temp v0)) with "[Q]" as "?"; last by destruct t; iFrame.
+    iExists v; iSplit; first by iPureIntro; apply tc_val_tc_val'; destruct t.
+    rewrite /make_ext_rval /env_set /=.
+    destruct t; try destruct i, s; try destruct f; try (specialize (TC5 eq_refl)); iFrame; first done; destruct v; contradiction. }
+iIntros "!>"; iExists _; iSplit; first done; iFrame.
+assert (tx' = set_opttemp ret (force_val ret0) tx) as Htx'.
+{ subst tx'.
   clear - Htc TCret TC5. hnf in Htc, TCret.
- destruct ret0, ret; simpl; auto.
- destruct ((temp_types Delta) ! i); try contradiction.
- destruct retty; try contradiction. spec TC5; auto. inv TC5.
-}
-clear - H1.
-apply assert_safe_jmupd_for_external_call; trivial.
-Qed.
-
-Lemma alloc_juicy_variables_age:
-  forall {ge rho jm jm1 vl rho' jm' jm1'},
-   age jm jm1 -> age jm' jm1' ->
-   alloc_juicy_variables ge rho jm vl = (rho', jm') ->
-   alloc_juicy_variables ge rho jm1 vl = (rho', jm1').
-Proof.
-  intros.
-  revert jm jm1 H rho H1.
-  induction vl; intros.
-  {
-    simpl in *; inv H1.
-    hnf in H0,H. congruence.
-  }
-  destruct a.
-  simpl in H1|-*.
-  eapply IHvl; [| rewrite <- (age_jm_dry H); eassumption].
-  apply age_juicy_mem_i; [simpl; rewrite (age_jm_dry H); auto |].
-  simpl.
-  apply rmap_age_i.
-  {
-    unfold after_alloc; simpl. repeat rewrite level_make_rmap.
-    apply age_level. apply age_jm_phi; auto.
-  }
-  intro. unfold resource_fmap; simpl.
-  unfold after_alloc; simpl.
-  do 2  rewrite resource_at_make_rmap.
-  unfold after_alloc'.
-  if_tac; [rewrite if_true | rewrite if_false].
-  + f_equal.
-  + rewrite <- (age_jm_dry H); assumption.
-  + clear H1.
-    destruct (m_phi jm @ l) eqn:?.
-    - symmetry;  eapply necR_NOx; try apply Heqr.
-      constructor 1. apply age_jm_phi; auto.
-    - symmetry.
-      rewrite level_make_rmap.
-      eapply necR_YES. constructor 1. eapply age_jm_phi. eassumption.
-      auto.
-    - rewrite level_make_rmap.
-      symmetry.
-      eapply necR_PURE. constructor 1. eapply age_jm_phi. eassumption.  auto.
-  + rewrite <- (age_jm_dry H); assumption.
-  + unfold after_alloc; rewrite !ghost_of_make_rmap, level_make_rmap.
-    symmetry; apply age1_ghost_of, age_jm_phi; auto.
-Qed.
-
-Lemma alloc_juicy_variables_resource_decay:
-  forall ge rho jm vl rho' jm',
-    alloc_juicy_variables ge rho jm vl = (rho', jm') ->
-    resource_decay (nextblock (m_dry jm)) (m_phi jm) (m_phi jm') /\
-    (nextblock (m_dry jm) <= nextblock (m_dry jm'))%positive.
-Proof.
- intros.
- revert rho jm H; induction vl; intros.
- inv H. split. apply resource_decay_refl.
-   apply juicy_mem_alloc_cohere. apply Pos.le_refl.
- destruct a as [id ty].
- unfold alloc_juicy_variables in H; fold alloc_juicy_variables in H.
- revert H; case_eq (juicy_mem_alloc jm 0 (@Ctypes.sizeof ge ty)); intros jm1 b1 ? ?.
- pose proof (juicy_mem_alloc_succeeds _ _ _ _ _ H).
- specialize (IHvl _ _ H0).
- symmetry in H1; pose proof (nextblock_alloc _ _ _ _ _ H1).
- destruct IHvl.
- split; [ |  rewrite H2 in H4; lia].
- eapply resource_decay_trans; try eassumption.
- rewrite H2; lia.
- clear - H H1.
- pose proof (juicy_mem_alloc_level _ _ _ _ _ H).
- unfold resource_decay.
- split. repeat rewrite <- level_juice_level_phi; rewrite H0; auto.
- intro loc.
- split.
- apply juicy_mem_alloc_cohere.
- rewrite (juicy_mem_alloc_at _ _ _ _ _ H).
- rewrite Z.sub_0_r.
- destruct loc as [b z]. simpl in *.
- if_tac. destruct H2; subst b1.
- right. right. left. split. apply alloc_result in H1; subst b; lia.
- eauto.
- rewrite <- H0. left. apply resource_at_approx.
+  destruct ret0, ret; simpl; auto.
+  destruct ((temp_types Delta) !! i); try contradiction.
+  destruct t; try contradiction. spec TC5; auto. inv TC5. }
+iSpecialize ("rguard" with "[-]").
+{ rewrite proj_frame /=; monPred.unseal; iFrame.
+  iSplit; [|iSplitR "fun"].
+  * iPureIntro; subst rho rho' tx'.
+    destruct ret; last done; destruct ret0; last done.
+    rewrite /construct_rho -map_ptree_rel.
+    apply guard_environ_put_te'; try done.
+    simpl in TCret; intros ? Hi; rewrite Hi in TCret; subst.
+    apply tc_val_tc_val'; destruct t0; try (specialize (TC5 eq_refl)); done.
+  * iSplit; last done.
+    rewrite (H _ (make_tenv tx')); first by subst.
+    subst rho tx'; rewrite /= /Map.get /make_tenv.
+    destruct ret; last auto; destruct ret0; last auto.
+    intros j; destruct (eq_dec j i); simpl; subst; auto.
+    rewrite Maps.PTree.gso; auto.
+  * iApply (same_glob_funassert' _ _ _ rho' with "fun"); subst rho rho'; done. }
+subst rho' tx'; rewrite Htx'.
+by iApply Hctl.
 Qed.
 
 Lemma ge_of_make_args:
@@ -1831,7 +687,7 @@ induction s; intros.
 Qed.
 
 Lemma ve_of_make_args:
-    forall s a rho, length s = length a -> ve_of (make_args s a rho) = (Map.empty (block * type)).
+    forall s a rho, length s = length a -> ve_of (make_args s a rho) = (Map.empty _).
 Proof.
 induction s; intros.
  destruct a; inv H; auto.
@@ -1856,193 +712,88 @@ rewrite IHil; auto.
 Qed.
 
 Lemma make_args_close_precondition:
-  forall bodyparams args ge tx ve' te' P,
+  forall bodyparams args ge tx ve' te' (P : argsassert),
     list_norepet (map fst bodyparams) ->
     bind_parameter_temps bodyparams args tx = Some te' ->
     Forall (fun v : val => v <> Vundef) args ->
     P (filter_genv ge, args)
-   |-- close_precondition (map fst bodyparams) P
+   ⊢ close_precondition (map fst bodyparams) P
            (construct_rho (filter_genv ge) ve' te').
 Proof.
 intros *. intros LNR BP VUNDEF.
-intros phi ?.
-exists args. split; simpl; trivial.
+iIntros "P"; iExists args; iFrame; iPureIntro; repeat (split; auto).
 clear - LNR BP VUNDEF.
 generalize dependent te'. generalize dependent tx. generalize dependent args.
-induction bodyparams; simpl; intros; destruct args; inv BP; simpl.
-+ split; auto.
+induction bodyparams; simpl; intros; destruct args; inv BP; simpl; auto.
 + destruct a; discriminate.
-+ destruct a. inv LNR. inv VUNDEF. simpl. destruct (IHbodyparams H3 _ H5 _ _ H0) as [X Y]; clear IHbodyparams.
-  rewrite X; simpl; clear X; split.
-  - f_equal.
-    rewrite (pass_params_ni _ _ _ _ _ H0 H2), PTree.gss; trivial.
-  - constructor; trivial.
++ destruct a. inv LNR. inv VUNDEF. simpl. erewrite <- IHbodyparams by eauto.
+  f_equal.
+  rewrite (pass_params_ni _ _ _ _ _ H0 H2) Maps.PTree.gss //.
 Qed.
 
-Lemma after_alloc_block:
- forall phi n F b (Hno : forall ofs : Z, phi @ (b, ofs) = NO Share.bot bot_unreadable),
-   app_pred F phi ->
-   0 <= n < Ptrofs.modulus ->
-   app_pred (F * memory_block Share.top n (Vptr b Ptrofs.zero)) (after_alloc 0 n b phi Hno).
+Lemma alloc_block:
+ forall m n m' b (Halloc : Mem.alloc m 0 n = (m', b))
+   (Hn : 0 <= n < Ptrofs.modulus),
+   mem_auth m ⊢ |==> mem_auth m' ∗ memory_block Share.top n (Vptr b Ptrofs.zero).
 Proof.
-intros. rename H0 into Hn.
-unfold after_alloc.
-match goal with |- context [proj1_sig ?A] => destruct A; simpl proj1_sig end.
-rename x into phi2.
-destruct a as (? & ? & Hg).
-unfold after_alloc' in H1.
-destruct (allocate phi
-    (fun loc : address =>
-      if adr_range_dec (b, 0) (n - 0) loc
-      then YES Share.top readable_share_top (VAL Undef) NoneP
-      else core (phi @ loc)) nil)
-  as [phi3 [phi4  [? [? Hg']]]].
-* extensionality loc; unfold compose.
-  if_tac. unfold resource_fmap. rewrite preds_fmap_NoneP. reflexivity.
-  repeat rewrite core_resource_at.
-  rewrite <- level_core.
-  apply resource_at_approx.
-*
- intros.
- if_tac.
- exists (YES Share.top readable_share_top (VAL Undef) NoneP).
- destruct l as [b0 ofs]; destruct H2.
- subst; rewrite Hno; constructor.
- apply join_unit1; auto.
- exists (phi @ l).
- apply join_comm.
- apply core_unit.
-*
-reflexivity.
-*
-eexists; constructor.
-*
-assert (phi4 = phi2). {
- apply rmap_ext. apply join_level in H2. destruct H2; lia.
- intro loc; apply (resource_at_join _ _ _ loc) in H2.
- rewrite H3 in H2; rewrite H1.
- if_tac.
- inv H2; apply YES_ext; apply (join_top _ _ (join_comm RJ)).
- apply join_comm in H2.
- eapply join_eq; eauto; apply core_unit.
- apply ghost_of_join in H2.
- rewrite <- Hg, Hg' in H2.
- inv H2; auto.
-}
-subst phi4.
-exists phi, phi3; split3; auto.
-split.
-do 3 red.
-rewrite Ptrofs.unsigned_zero.
-lia.
-rewrite Ptrofs.unsigned_zero.
-rewrite memory_block'_eq; try lia.
-unfold memory_block'_alt.
-rewrite if_true by apply readable_share_top.
-intro loc. hnf.
-rewrite Z2Nat.id by lia.
-if_tac.
-exists Undef.
-exists readable_share_top.
-hnf.
-rewrite H3.
-rewrite Z.sub_0_r.
-rewrite if_true by auto.
-rewrite preds_fmap_NoneP.
-f_equal.
-unfold noat. simpl.
-rewrite H3.
-rewrite Z.sub_0_r.
-rewrite if_false by auto.
-apply core_identity.
-Qed.
-
-Lemma juicy_mem_alloc_block:
- forall jm n jm2 b F,
-   juicy_mem_alloc jm 0 n = (jm2, b) ->
-   app_pred F (m_phi jm)  ->
-   0 <= n < Ptrofs.modulus ->
-   app_pred (F * memory_block Share.top n (Vptr b Ptrofs.zero)) (m_phi jm2).
-Proof.
-intros.
-inv H; simpl m_phi.
-apply after_alloc_block; auto.
-Qed.
-
-Lemma alloc_juicy_variables_lem2 {CS}:
-  forall jm f (ge: genv) ve te jm' (F: pred rmap)
-      (HGG: cenv_sub (@cenv_cs CS) (genv_cenv ge))
-      (COMPLETE: Forall (fun it => complete_type cenv_cs (snd it) = true) (fn_vars f))
+  intros.
+  iIntros "Hm"; iMod (mapsto_alloc_bytes with "Hm") as "($ & H)"; first done; iIntros "!>".
+  rewrite /memory_block Ptrofs.unsigned_zero.
+  iSplit; first by iPureIntro; lia.
+  rewrite Z.sub_0_r memory_block'_eq; [| lia..].
+  rewrite /memory_block'_alt if_true; last auto.
+  rewrite /VALspec_range Nat2Z.id.
+  iApply (big_sepL_mono with "H"); intros.
+  rewrite address_mapsto_VALspec_range /= VALspec1 //.
+Qed.
+
+Lemma alloc_stackframe {CS'}:
+  forall m f (ge: genv) te
+      (HGG: cenv_sub (@cenv_cs CS') (genv_cenv ge))
+      (COMPLETE: Forall (fun it => complete_type (@cenv_cs CS') (snd it) = true) (fn_vars f))
       (Hsize: Forall (fun var => @Ctypes.sizeof ge (snd var) <= Ptrofs.max_unsigned) (fn_vars f)),
       list_norepet (map fst (fn_vars f)) ->
-      alloc_juicy_variables ge empty_env jm (fn_vars f) = (ve, jm') ->
-      app_pred F (m_phi jm) ->
-      app_pred (F * stackframe_of f (construct_rho (filter_genv ge) ve te)) (m_phi jm').
-Proof.
-intros.
-unfold stackframe_of.
-forget (fn_vars f) as vars. clear f.
-forget empty_env as ve0.
-revert F ve0 jm Hsize H0 H1; induction vars; intros.
-simpl in H0. inv H0.
-simpl fold_right. rewrite sepcon_emp; auto.
-inv Hsize. rename H4 into Hsize'; rename H5 into Hsize.
-simpl fold_right.
-unfold alloc_juicy_variables in H0; fold alloc_juicy_variables in H0.
-destruct a as [id ty].
-destruct (juicy_mem_alloc jm 0 (@Ctypes.sizeof ge ty)) eqn:?H.
-rewrite <- sepcon_assoc.
-inv H.
-simpl in COMPLETE; inversion COMPLETE; subst.
-rename H7 into COMPLETE'.
-rename H4 into COMPLETE_HD.
-eapply IHvars; eauto. clear IHvars.
-pose proof I.
-unfold var_block, eval_lvar.
-simpl sizeof; simpl typeof.
-simpl Map.get. simpl ge_of.
-assert (Map.get (make_venv ve) id = Some (b,ty)). {
- clear - H0 H5.
- unfold Map.get, make_venv.
- assert ((PTree.set id (b,ty) ve0) ! id = Some (b,ty)) by (apply PTree.gss).
- forget (PTree.set id (b, ty) ve0) as ve1.
- rewrite <- H; clear H.
- revert ve1 j H0 H5; induction vars; intros.
- inv H0; auto.
- unfold alloc_juicy_variables in H0; fold alloc_juicy_variables in H0.
- destruct a as [id' ty'].
- destruct (juicy_mem_alloc j 0 (@Ctypes.sizeof ge ty')) eqn:?H.
- rewrite (IHvars _ _ H0).
- rewrite PTree.gso; auto. contradict H5. subst; left; auto.
- contradict H5; right; auto.
-}
-rewrite H3. rewrite eqb_type_refl.
-simpl in Hsize'. unfold sizeof.
-rewrite <- (cenv_sub_sizeof HGG); auto.
-rewrite prop_true_andp by auto.
-assert (0 <= @Ctypes.sizeof ge ty <= Ptrofs.max_unsigned) by (pose proof (@Ctypes.sizeof_pos ge ty); lia).
-simpl.
-forget (@Ctypes.sizeof ge ty) as n.
-clear - H2 H1 H4.
-eapply juicy_mem_alloc_block; eauto.
-unfold Ptrofs.max_unsigned in H4; lia.
-Qed.
-
-Lemma free_list_juicy_mem_ghost: forall m l m', free_list_juicy_mem m l m' ->
-  ghost_of (m_phi m') = ghost_of (m_phi m).
-Proof.
-  induction 1; auto.
-  rewrite IHfree_list_juicy_mem, <- H1.
-  apply free_juicy_mem_ghost.
-Qed.
-
-Lemma alloc_juicy_variables_ghost: forall l ge rho jm,
-  ghost_of (m_phi (snd (alloc_juicy_variables ge rho jm l))) = ghost_of (m_phi jm).
+      mem_auth m ⊢ |==> ∃ m' ve, ⌜Clight.alloc_variables ge empty_env m (fn_vars f) ve m' ∧ match_venv (make_venv ve) (fn_vars f)⌝ ∧
+        mem_auth m' ∗ stackframe_of f (construct_rho (filter_genv ge) ve te).
 Proof.
-  induction l; auto; simpl; intros.
-  destruct a; simpl.
-  rewrite IHl; simpl.
-  apply ghost_of_make_rmap.
+  intros.
+  cut (mem_auth m ⊢ |==> ∃ (m' : Memory.mem) (ve : env),
+    ⌜(∀i, sub_option (empty_env !! i)%maps (ve !! i)%maps) ∧ alloc_variables ge empty_env m (fn_vars f) ve m'⌝
+    ∧ mem_auth m' ∗ stackframe_of f (construct_rho (filter_genv ge) ve te)).
+  { intros Hgen; rewrite Hgen; iIntros ">(% & % & (% & %) & ?) !>".
+    iExists _, _; iFrame; iPureIntro; repeat (split; auto).
+    eapply alloc_vars_match_venv; eauto. }
+  rewrite /stackframe_of.
+  forget (fn_vars f) as vars. clear f.
+  assert (forall i, In i (map fst vars) -> empty_env !! i = None) as Hout.
+  { intros; apply Maps.PTree.gempty. }
+  forget empty_env as ve0.
+  revert ve0 m Hout Hsize; induction vars; intros; simpl; iIntros "Hm".
+  - iExists m, ve0; iFrame; monPred.unseal; iPureIntro.
+    split; auto; split; auto.
+    + intros; apply sub_option_refl.
+    + constructor.
+  - destruct a as (id, ty).
+    destruct (Mem.alloc m 0 (sizeof ty)) as (m', b) eqn: Halloc.
+    inv COMPLETE; inv Hsize; inv H.
+    rewrite cenv_sub_sizeof // in H4.
+    iMod (alloc_block with "Hm") as "(Hm & block)"; first done.
+    { pose proof sizeof_pos ty; unfold sizeof, Ptrofs.max_unsigned in *; simpl in *; lia. }
+    unshelve iMod (IHvars _ _ (Maps.PTree.set id (b,ty) ve0) with "Hm") as (?? (Hsub & ?)) "(Hm & ?)"; try done.
+    { intros; rewrite Maps.PTree.gso //; last by intros ->.
+      apply Hout; simpl; auto. }
+    iIntros "!>"; iExists _, _; monPred.unseal; iFrame.
+    rewrite /var_block /eval_lvar; monPred.unseal; simpl.
+    replace (Map.get _ _) with (Some (b, ty)).
+    rewrite eqb_type_refl; iFrame; iPureIntro; simpl.
+    + split; last done; split.
+      * intros i; specialize (Hsub i).
+        destruct (eq_dec i id); last by rewrite Maps.PTree.gso in Hsub.
+        subst; rewrite Hout //; simpl; auto.
+      * econstructor; eauto.
+        rewrite cenv_sub_sizeof //.
+    + rewrite /Map.get /=.
+      specialize (Hsub id); rewrite Maps.PTree.gss // in Hsub.
 Qed.
 
 Lemma map_snd_typeof_params:
@@ -2051,104 +802,58 @@ Proof.
 induction al as [|[? ?]]; destruct bl as [|[? ?]]; intros; inv H; simpl; f_equal; auto.
 Qed.
 
-Lemma jsafeN_local_step':
-  forall {Espec: OracleKind} ge ora s1 m s2 m2,
-  cl_step  ge s1 (m_dry m) s2 (m_dry m2) ->
-  resource_decay (nextblock (m_dry m)) (m_phi m) (m_phi m2) ->
-  level m = S (level m2) /\
-   ghost_of (m_phi m2) =ghost_fmap (approx (level m2)) (approx (level m2)) (ghost_of (m_phi m)) ->
-  jsafeN (@OK_spec Espec) ge ora s2 m2 ->
-  jsafeN (@OK_spec Espec) ge ora s1 m.
-Proof.
-  intros.
-  rename H into Hstep.
-  eapply jsafeN_step with
-    (m' := m2).
-  split3; auto.
-  apply Hstep.
-  apply jm_fupd_intro, H2; intros.
-  eapply necR_safe; eauto.
-Qed.
-
 Lemma call_cont_idem: forall k, call_cont (call_cont k) = call_cont k.
 Proof.
 induction k; intros; simpl; auto.
 Qed.
 
 Lemma guard_fallthrough_return:
- forall (Espec : OracleKind) (psi : genv) (f : function)
+ forall (psi : genv) E (f : function)
    (ctl : cont) (ek : exitkind) (vl : option val)
   (te : temp_env) (ve : env) (rho' : environ)
-  (P1 : Prop) (P2 P3 P5 : mpred)
-  (P4 : (ffunc (fconst environ) fidentity) mpred)
-  (n : nat),
+  (P4 : assert),
   call_cont ctl = ctl ->
-  (!! P1 && (P2 * bind_ret vl (fn_return f) P4 rho' * P5) && P3 >=>
-    assert_safe Espec psi f ve te (exit_cont EK_return vl ctl) rho')  n ->
-  (!! P1 && (P2 *proj_ret_assert (function_body_ret_assert (fn_return f) P4) ek
-      vl rho' * P5) && P3 >=>
-   assert_safe Espec psi f ve te (exit_cont ek vl ctl) rho') n.
+  (bind_ret vl (fn_return f) P4 rho' -∗
+     assert_safe OK_spec psi E f ve te (exit_cont EK_return vl ctl) rho') ⊢
+  (proj_ret_assert (function_body_ret_assert (fn_return f) P4) ek
+      vl rho' -∗
+   assert_safe OK_spec psi E f ve te (exit_cont ek vl ctl) rho').
 Proof.
 intros.
-destruct ek; try solve [intros; simpl proj_ret_assert; normalize];
- unfold function_body_ret_assert, proj_ret_assert,
-               RA_normal, RA_return.
+iIntros "Hsafe ret".
+destruct ek; simpl proj_ret_assert; try monPred.unseal; try iDestruct "ret" as "[_ []]"; last by iApply "Hsafe"; iFrame.
+iDestruct "ret" as (->) "ret"; simpl.
 destruct (type_eq (fn_return f) Tvoid).
-2:{
-intros ? ? ? ? ? ? [[_ [? [? [? [[? [? [? [_ [? ?]]]]] _]]]]] _].
-destruct (fn_return f); contradiction.
-}
-destruct vl. normalize.
-intros ? ? ? ? ? ? [[_ [? _]] _]; discriminate.
-eapply subp_trans'; [ | eapply subp_trans'; [apply H0 | ]]; clear H0.
+2:{ destruct (fn_return f); first contradiction; done. }
 rewrite e.
-apply derives_subp.
-normalize.
-apply andp_derives; auto. apply andp_derives; auto.
-apply andp_left2; auto.
-simpl exit_cont.
-apply derives_subp.
-apply assert_safe_derives; split; auto; simpl; intros.
-destruct ctl; try (apply jm_fupd_intro'; auto);
+iSpecialize ("Hsafe" with "[$]").
+rewrite /assert_safe.
+iIntros (? Hrho); iSpecialize ("Hsafe" $! _ Hrho).
+destruct ctl; try done;
 exfalso; clear - H; simpl in H; set (k:=ctl) in *;
 unfold k at 1 in H; clearbody k;
 induction ctl; try discriminate; eauto.
 Qed.
 
 Lemma semax_call_aux2
-  (CS : compspecs) (Espec : OracleKind) (Delta : tycontext)
+  {CS'} E (Delta : tycontext)
   (A : TypeTree)
-  (P : forall ts : list Type,
-     _functor (dependent_type_functor_rec ts (ArgsTT A)) mpred)
-  (Q : forall ts : list Type,
-     _functor (dependent_type_functor_rec ts (AssertTT A)) mpred)
-  (ts : list Type)
-  (x : _functor (dependent_type_functor_rec ts A) mpred)
-  (F : environ -> pred rmap)
+  (Q : dtfr (AssertTT A))
+  (x : dtfr A)
+  (F : assert)
   (F0 : assert)
   (ret : option ident)
   (curf : function)
   (fsig : typesig)
-  (cc : calling_convention)
   (a : expr) (bl : list expr) (R : ret_assert)
   (psi : genv)
-  (ora : OK_ty) (jm jmx : juicy_mem)
   (f : function)
-  (NEQ : super_non_expansive Q)
-  (Hora : ext_compat ora (m_phi jm))
   (TCret : tc_fn_return Delta ret (snd fsig))
   (TC5 : snd fsig = Tvoid -> ret = None)
   (H : closed_wrt_modvars (Scall ret a bl) F0)
-  (HR : app_pred
-       (ALL rho' : environ,
-        |> ! ((EX old : val,
-               substopt ret (`old) F rho' *
-               maybe_retval (Q ts x) (snd fsig) ret rho') >=>
-              fupd (RA_normal R rho'))) (m_phi jm))
-  (HGG : cenv_sub cenv_cs (genv_cenv psi))
-  (H13 : age1 jm = Some jmx)
+  (HGG : cenv_sub (@cenv_cs CS') (genv_cenv psi))
   (COMPLETE : Forall
-             (fun it : ident * type => complete_type cenv_cs (snd it) = true)
+             (fun it : ident * type => complete_type (@cenv_cs CS') (snd it) = true)
              (fn_vars f))
   (H17 : list_norepet (map fst (fn_params f) ++ map fst (fn_temps f)))
   (H17' : list_norepet (map fst (fn_vars f)))
@@ -2156,281 +861,121 @@ Lemma semax_call_aux2
       snd fsig = snd (fn_funsig f))
   vx tx k rho
   (H0 : rho = construct_rho (filter_genv psi) vx tx)
-  (H1 : app_pred (|> rguard Espec psi Delta curf (frame_ret_assert R F0) k)
-       (level (m_phi jm)))
   (TC3 : guard_environ Delta curf rho)
-  : app_pred
-      (!! closed_wrt_modvars (fn_body f) (fun _ : environ => F0 rho * F rho) &&
-       rguard Espec psi (func_tycontext' f Delta) f
+  ctl (Hcont : call_cont ctl = ctl)
+  (Hctl : ∀ ret0 z', assert_safe OK_spec psi E curf vx (set_opttemp ret (force_val ret0) tx)
+             (exit_cont EK_normal None k)  (construct_rho (filter_genv psi) vx (set_opttemp ret (force_val ret0) tx)) ⊢
+    jsafeN OK_spec psi E z' (Returnstate (force_val ret0) ctl)):
+  (∀ rho' : environ,
+        ■ ((∃ old : val,
+               substopt ret (liftx old) F rho' ∗
+               maybe_retval (assert_of (Q x)) (snd fsig) ret rho') -∗
+              RA_normal R rho')) -∗
+  ▷ rguard OK_spec psi E Delta curf (frame_ret_assert R F0) k -∗
+  ⌜closed_wrt_modvars (fn_body f) ⎡F0 rho ∗ F rho⎤⌝ ∧
+  rguard OK_spec psi E (func_tycontext' f Delta) f
          (frame_ret_assert
-            (frame_ret_assert (function_body_ret_assert (fn_return f) (Q ts x))
-                              (stackframe_of' cenv_cs f)) (fun _ : environ => F0 rho * F rho))
-         (Kcall ret curf vx tx k)) (level jmx).
-Proof.
-pose proof I.
-assert (LATER : laterR (level (m_phi jm)) (level (m_phi jmx))). {
-  apply laterR_level'. apply age_laterR. apply age_jm_phi. auto.
-}
-set (ctl := Kcall ret curf vx tx k) in *.
-do 2 pose proof I.
- split.
- repeat intro; f_equal.
- intros ek vl te ve.
- rewrite !proj_frame_ret_assert.
- unfold seplog.sepcon, seplog.LiftSepLog .
- remember ((construct_rho (filter_genv psi) ve te)) as rho'.
- simpl seplog.sepcon.
- rewrite <- (sepcon_comm (stackframe_of' cenv_cs f rho')).
-cut ((!! guard_environ (func_tycontext' f Delta) f rho' &&
- (stackframe_of' cenv_cs f rho' *
-  bind_ret vl
-(fn_return f) (Q ts x) rho' *
-  (F0 rho * F rho)) && funassert (func_tycontext' f Delta) rho' >=>
- assert_safe Espec psi f ve te (exit_cont EK_return vl ctl) rho')
-  (level jmx)).
-apply guard_fallthrough_return; auto.
-
- rewrite andp_assoc.
- apply prop_andp_subp; intro. simpl in H5.
- repeat rewrite andp_assoc.
- pose proof I.
- pose proof I.
- rewrite <- (sepcon_comm (F0 rho * F rho)).
- change (stackframe_of' cenv_cs f rho') with (stackframe_of f rho').
-
- intros wx ? ? w' ? Hext ?.
- assert (level jmx >= level w')%nat.
- { apply necR_level in H9.
-   apply Nat.le_trans with (level wx); auto.
-   apply ext_level in Hext as <-; auto. }
- clear wx H8 H9.
- simpl; intros ora' jm' Hora' VR ?.
- subst w'.
- intro.
- case_eq (@level rmap ag_rmap (m_phi jm')); [intros; lia | intros n0 H21; clear LW ].
- rewrite <- level_juice_level_phi in H21.
- destruct (levelS_age1 jm' _ H21) as [jm'' H24].
- rewrite -> level_juice_level_phi in H21.
- assert (FL: exists m2, free_list (m_dry jm'')  (Clight.blocks_of_env psi ve) = Some m2). {
-    rewrite <- (age_jm_dry H24).
-    subst rho'.
-    rewrite (sepcon_comm (stackframe_of f _)) in H10.
-    repeat rewrite <- sepcon_assoc in H10.
-    destruct H10 as [H10 _].
-    eapply can_free_list; try eassumption.
-    }
- unfold ctl. fold ctl.
- clear Hora ora P.
- fold ctl.
- destruct FL as [m2 FL2].
- assert (H25: ve_of rho' = make_venv ve) by (subst rho'; reflexivity).
- assert (SFFB := stackframe_of_freeable_blocks Delta _ rho' _ ve HGG COMPLETE H17' H25 H5);
-   clear HGG COMPLETE.
- clear H25.
- destruct (free_list_juicy_mem_i _ _ _ (F0 rho * F rho * bind_ret vl (fn_return f) (Q ts x) rho') FL2)
- as [jm2 [FL [H21' FL3]]].
- eapply sepcon_derives. apply SFFB. apply derives_refl.
- forget (F0 rho * F rho) as F0F.
- rewrite <- sepcon_assoc.
- rewrite (sepcon_comm (stackframe_of _ _)). rewrite sepcon_assoc.
- destruct H10 as [H22 _].
- eapply pred_nec_hereditary; try apply H22.
- apply laterR_necR. apply age_laterR. apply age_jm_phi; auto.
- subst m2.
- pose (rval := force_val vl).
- clear dependent a'.
- assert (jsafeN OK_spec psi ora'
-             (Returnstate rval (call_cont ctl)) jm2). {
-   assert (LATER2': (level jmx > level (m_phi jm2))%nat). {
-     apply age_level in H24.
-     repeat rewrite <- level_juice_level_phi in *. lia.
-    }
-   assert (HH1 : forall a' : rmap,
-     necR (m_phi jm2) a' ->
-     (!! guard_environ Delta curf (construct_rho (filter_genv psi) vx (set_opttemp ret rval tx)) &&
-      seplog.sepcon (fun rho0 : environ => EX old : val, substopt ret (`old) F rho0 * maybe_retval (Q ts x) (snd fsig) ret rho0) F0
-        (construct_rho (filter_genv psi) vx (set_opttemp ret rval tx)) && funassert Delta (construct_rho (filter_genv psi) vx (set_opttemp ret rval tx))) a' ->
-     (assert_safe Espec psi curf vx (set_opttemp ret rval tx) (exit_cont EK_normal None k) (construct_rho (filter_genv psi) vx (set_opttemp ret rval tx))) a').
-   { intros. hnf in H1.
-     assert (Help0: laterM (level (m_phi jm)) (level (m_phi jm2))). {
-       clear - LATER2' LATER.
-       eapply necR_laterR. apply laterR_necR; eassumption.
-       apply later_nat. rewrite <- !level_juice_level_phi in *. lia. }
-     specialize (H1 _ Help0 EK_normal None (set_opttemp ret rval tx) vx).
-     assert (Help1: (level (m_phi jm2) >= level (m_phi jm2))%nat) by lia.
-    destruct H9 as [[? HB] ?].
-    assert (fupd (RA_normal R (construct_rho (filter_genv psi) vx (set_opttemp ret rval tx)) * F0 (construct_rho (filter_genv psi) vx (set_opttemp ret rval tx))) a') as Ha'.
-    { apply fupd.fupd_frame_r.
-      destruct HB as [a1 [a2 [J [A1 A2]]]]; simpl; exists a1, a2; split; auto; split; auto.
-      assert (JMX: laterM (m_phi jm) (m_phi jmx)). { constructor. apply age_jm_phi. apply H13. }
-      eapply (HR _ _ JMX a1); auto.
-      destruct (join_level _ _ _ J) as [-> ?]; auto. apply necR_level in H8; rewrite <- level_juice_level_phi in *; lia. }
-    eapply fupd.subp_fupd in H1; [|apply derives_refl].
-    eapply assert_safe_fupd, H1; eauto.
-    rewrite andp_comm; apply fupd.fupd_andp_corable; [apply corable_funassert|].
-    split; auto.
-   apply fupd.fupd_andp_prop; split; auto.
-    rewrite proj_frame_ret_assert; unfold proj_ret_assert.
-    eapply fupd.fupd_mono, Ha'; simpl.
-    rewrite prop_true_andp; auto. }
-   clear H1.
-   specialize (HH1 _ (necR_refl _)). simpl in H5.
-   spec HH1; [clear HH1 | ].
-   - split; [split |].
-    + destruct H10 as [H22 _].
+            (frame_ret_assert (function_body_ret_assert (fn_return f) (assert_of (Q x)))
+                              (stackframe_of' cenv_cs f)) ⎡F0 rho ∗ F rho⎤)
+         ctl.
+Proof.
+  iIntros "#HR #rguard"; iSplit.
+  { iPureIntro; repeat intro; monPred.unseal; f_equal. }
+  iIntros (ek vl te ve) "!>".
+  rewrite !proj_frame.
+  monPred.unseal.
+  iIntros "(% & ((F0 & F) & stack & Q) & fun)".
+  iApply (guard_fallthrough_return with "[-Q] Q"); first done.
+  rewrite /bind_ret; monPred.unseal.
+  iIntros "Q".
+  set (rho' := construct_rho _ _ _).
+  change (stackframe_of' cenv_cs f rho') with (stackframe_of f rho').
+  rewrite /assert_safe.
+  iIntros (? _); simpl.
+  pose (rval := force_val vl).
+  iAssert (▷ jsafeN OK_spec psi E ora (Returnstate rval (call_cont ctl))) with "[-stack]" as "Hsafe". 
+  { iNext.
+    iAssert ⌜match vl with Some v => tc_val (fn_return f) v | None => fn_return f = Tvoid end⌝ with "[Q]" as %TCvl.
+    { rewrite /rval; destruct vl; simpl.
+      + iDestruct "Q" as "[$ _]".
+      + destruct (fn_return f); done. }
+    iPoseProof ("HR" $! (construct_rho (filter_genv psi) vx (set_opttemp ret rval tx)) with "[F Q]") as "R".
+    { destruct H18 as [_ Hsig]; rewrite Hsig /fn_funsig /= in TC5 |- *.
+      iExists match ret with
+       | Some id =>
+           match tx !! id with
+           | Some old => old
+           | None => Vundef
+           end
+       | None => Vundef
+       end; subst rho'; unfold_lift; destruct ret; simpl.
+      + destruct TC3 as [[TC3 _] _].
+        hnf in TC3; simpl in TC3.
+        hnf in TCret.
+        destruct ((temp_types Delta) !! i) as [ti|] eqn: Hi; try contradiction.
+        destruct (TC3 _ _ Hi) as (vi & Htx & ?); subst.
+        rewrite /get_result1 /eval_id /= /make_tenv /Map.get in Htx |- *; rewrite Maps.PTree.gss Htx.
+        rewrite /subst /env_set /= -map_ptree_rel Map.override Map.override_same //; iFrame.
+        rewrite /rval; destruct vl; simpl.
+        * iSplit; first by iPureIntro; apply tc_val_tc_val', TCvl.
+          iDestruct "Q" as "[% $]".
+        * iSplit; first by iPureIntro; apply tc_val'_Vundef.
+          rewrite TCvl in TC5; specialize (TC5 eq_refl); done.
+      + subst rho; iFrame.
+        destruct vl; simpl; last by rewrite TCvl.
+        iDestruct "Q" as (TCv) "Q".
+        destruct (fn_return f); first contradiction; iExists _; iFrame; apply tc_val_tc_val' in TCv; iPureIntro; done. }
+    iSpecialize ("rguard" $! EK_normal None with "[F0 R fun]").
+    { rewrite proj_frame; subst rho; simpl proj_ret_assert; monPred.unseal; iFrame.
+      iFrame "#".
+      iSplit.
+      + iPureIntro.
         destruct H18 as [H18 H18b].
-        simpl.
-        destruct ret; unfold rval; [destruct vl | ].
-        *
-         assert (tc_val' (fn_return f) v).
-           apply tc_val_tc_val'.
-           clear - H22; unfold bind_ret in H22; normalize in H22; try contradiction; auto.
-         unfold construct_rho. unfold set_opttemp. rewrite <- map_ptree_rel.
-         apply guard_environ_put_te'. subst rho; auto.
-         intros.
-         cut (t = fn_return f). intros. rewrite H9; auto.
-         hnf in TCret; rewrite H8 in TCret. subst; auto.
-        *
-         assert (f.(fn_return)=Tvoid).
-         clear - H22; unfold bind_ret in H22; destruct (f.(fn_return)); normalize in H22; try contradiction; auto.
-         unfold fn_funsig in H18b. rewrite H1 in H18b. rewrite H18b in TC5. simpl in TC5.
-         specialize (TC5 (eq_refl _)); congruence.
-        * unfold set_opttemp. rewrite <- H0. auto.
-    +
-       destruct H10 as [H22a H22b].
-       simpl seplog.sepcon.
-       rewrite sepcon_comm in H22a|-*.
-       rewrite sepcon_assoc in H22a.
-       assert (bind_ret vl (fn_return f) (Q ts x) rho' * (F0 rho * F rho)
-            |-- (maybe_retval (Q ts x) (snd fsig) ret (construct_rho (filter_genv psi) vx (set_opttemp ret rval tx)) *
-                   (F0 (construct_rho (filter_genv psi) vx (set_opttemp ret rval tx)) *
-                    EX old: val, substopt ret (`old) F (construct_rho (filter_genv psi) vx (set_opttemp ret rval tx))))). {
-        apply sepcon_derives.
-        *
-         clear dependent a.
-         clear Hora' H6 H7 ora'.
-         destruct fsig as [f_params f_ret].
-         simpl in H18; destruct H18 as [H18 H18b]; subst rho' f_ret.
-         clear H22b VR. clear LATER2' jm2 FL FL2 FL3.
-         unfold rval; clear rval.
-         unfold bind_ret.
-         unfold get_result1. simpl.
-         unfold bind_ret.
-         destruct vl.
-         + 
-           unfold maybe_retval.
-           destruct ret.
-           - unfold get_result1; simpl.
-             apply andp_derives.
-             ++ apply prop_derives. intros ? ?. simpl. unfold eval_id; simpl.
-                rewrite <- map_ptree_rel, Map.gss. simpl. apply H.
-             ++ unfold env_set; simpl.
-                unfold eval_id; simpl. rewrite <- map_ptree_rel, Map.gss. simpl; trivial.
-           - unfold set_opttemp; simpl. unfold env_set; simpl. clear - TC5 H0.
-              destruct (fn_return f); simpl; normalize.
-             all: exists v; simpl; split; [ intros ? ; apply H | apply H1].
-         +
-           unfold fn_funsig in TC5. simpl in TC5.
-           destruct (fn_return f) eqn:?; try apply FF_derives.
-           specialize (TC5 (eq_refl _)). subst ret.
-           unfold maybe_retval. apply derives_refl.
-        *
-          subst rho.
-         destruct ret; apply sepcon_derives; auto.
-         +
-          clear - H.
-          apply derives_refl'.
-          apply H. intros. destruct (ident_eq i i0).
-          subst; left. red. unfold modifiedvars', insert_idset. rewrite PTree.gss; hnf; auto.
-          right; unfold Map.get; simpl; unfold make_tenv; simpl.
-          rewrite PTree.gso; auto.
-        +
-          simpl in TCret.
-          destruct ((temp_types Delta) ! i) eqn:?; try contradiction.
-          subst t.
-          destruct TC3 as [[TC3 _] _].
-          hnf in TC3; simpl in TC3.
-          specialize (TC3 _ _ Heqo).
-          destruct TC3 as [old [? _]].
-          apply exp_right with old. unfold substopt, subst.
-          apply derives_refl'. f_equal.
-          unfold env_set, construct_rho.
-           f_equal. unfold make_tenv. extensionality j.
-          simpl. unfold Map.set. if_tac. subst.
-          apply H0. rewrite PTree.gso; auto.
-        +
-          apply exp_right with Vundef; simpl; auto.
-       }
-      eapply derives_trans. 3: apply H1. apply derives_refl.
-      normalize. intros v. exists v. rewrite <- sepcon_assoc. rewrite sepcon_comm in H8. apply H8.
-      eapply free_list_juicy_mem_lem. eauto.
-      eapply pred_nec_hereditary.
-      apply laterR_necR. apply age_jm_phi in H24. apply age_laterR; eauto.
-      eapply sepcon_derives; try apply H22a; auto.
-   +
-     destruct H10 as [H22a H22b].
-     eapply pred_nec_hereditary in H22b.
-     2:{  apply laterR_necR. apply age_jm_phi in H24. apply age_laterR; eauto. }
-     rewrite VR in H22b; clear - FL H22b. {
-      eapply corable_core, H22b. apply corable_funassert.
-      clear - FL.
-      induction FL; auto.
-      rewrite <-IHFL.
-      rewrite <- H1.
-      rewrite free_juicy_mem_core; auto.
-     }
-  -
-    clear - HH1.
-    destruct (level jm2) eqn:H26; try solve [constructor; auto];
-    destruct (levelS_age _ _ (eq_sym H26)) as [jm2' [H27 ?]].
-    subst n;
-    apply jsafeN_step with (c' := State curf Sskip k vx (set_opttemp ret rval tx)) (m' := jm2');
-    simpl.
-    split; [ rewrite <- (age_jm_dry H27); constructor | ].
-    split3;
-    [ apply age1_resource_decay; auto | auto
-    | apply age1_ghost_of; apply age_jm_phi; auto].
-    eapply pred_nec_hereditary in HH1;
-     [ | apply laterR_necR; apply age_jm_phi in H27; apply age_laterR; eauto];
-    apply assert_safe_jsafe'; auto.
- }
-   clear H1.
-    destruct H18 as [H18 H18b].
-    simpl.
-    clear n0 H21.
-    destruct vl; intros;
-    (eapply jsafeN_local_step' with (m2 := jm2);
-     [econstructor; eauto |  .. ]).
-    1,5: rewrite (age_jm_dry H24); auto.
-    1,4:
-    eapply resource_decay_trans;
-    [ | | eapply free_list_resource_decay; eauto];
-    [ rewrite (age_jm_dry H24); apply Pos.le_refl |
-      apply age1_resource_decay ].
-    1,2: auto.
-    1,3: split; [change (level (m_phi ?a)) with (level a); rewrite <- FL3; apply age_level in H24; lia |].
-    1,2:rewrite (free_list_juicy_mem_ghost _ _ _ FL);
-      erewrite age1_ghost_of by (eapply age_jm_phi; eauto);
-      change (level (m_phi jm'')) with (level jm'');
-      rewrite FL3; auto.
-      change v with rval; auto.
-      change Vundef with rval; auto.
+        destruct ret; last done.
+        unfold rval; destruct vl; simpl.
+        * rewrite /construct_rho /set_opttemp -map_ptree_rel.
+          apply guard_environ_put_te'; auto.
+          simpl in TCret; intros ? Hi; rewrite Hi in TCret; subst.
+          rewrite H18b; by apply tc_val_tc_val', TCvl.
+        * rewrite H18b /= TCvl in TC5; specialize (TC5 eq_refl); done.
+      + iSplit; last done.
+        destruct ret as [ret|]; last done.
+        rewrite closed_wrt_modvars_Scall in H.
+        rewrite -(H (construct_rho (filter_genv psi) vx tx)); first done.
+        simpl; intros.
+        destruct (eq_dec ret i); first auto.
+        rewrite -map_ptree_rel Map.gso; auto. }
+    rewrite Hcont; by iApply Hctl. }
+  destruct vl.
+  - iIntros (?).
+    iApply (bi.impl_intro_l (_ ∗ _) with "[stack Hsafe]"); last by iSplitL "stack"; [iApply "stack" | iApply "Hsafe"].
+    iIntros "H".
+    iApply jsafe_step; rewrite /jstep_ex.
+    iIntros (?) "(Hm & ?)".
+    iAssert ⌜∃ v' : val, Clight.eval_expr psi ve te m e v' ∧ Cop.sem_cast v' (typeof e) (fn_return f) m = Some v⌝ as %(v1 & ? & ?).
+    { iDestruct "H" as "[H _]"; iApply ("H" with "Hm"). }
+    iDestruct "H" as "(_ & stack & ?)".
+    iMod (free_stackframe with "[$Hm $stack]") as (??) "Hm"; [done..|].
+    iIntros "!>"; iExists _, _; iSplit; last iFrame.
+    iPureIntro; rewrite {1}Hcont; econstructor; done.
+  - iApply jsafe_step; rewrite /jstep_ex.
+    iIntros (?) "(Hm & ?)".
+    iMod (free_stackframe with "[$Hm $stack]") as (??) "Hm"; [done..|].
+    iIntros "!>"; iExists _, _; iSplit; last iFrame.
+    iPureIntro; rewrite {1}Hcont; econstructor; done.
 Qed.
 
 Lemma tc_eval_exprlist:
-  forall {CS: compspecs} Delta tys bl rho m,
+  forall {CS'} Delta tys bl rho,
     typecheck_environ Delta rho ->
-    (tc_exprlist Delta tys bl rho) m ->
-    tc_vals tys (eval_exprlist tys bl rho).
+    tc_exprlist(CS := CS') Delta tys bl rho ⊢
+    ⌜tc_vals tys (eval_exprlist tys bl rho)⌝.
 Proof.
-induction tys; destruct bl; simpl; intros; auto.
-unfold tc_exprlist in H0. simpl in H0.
-rewrite !denote_tc_assert_andp in H0.
-destruct H0 as [[? ?] ?].
-split.
-unfold_lift.
-eapply tc_val_sem_cast; eauto.
-apply IHtys with m; auto.
+induction tys; destruct bl; simpl in *; intros; auto.
+unfold tc_exprlist in *; simpl.
+unfold typecheck_expr; fold typecheck_expr.
+rewrite !denote_tc_assert_andp IHtys // tc_val_sem_cast //.
+unfold_lift; auto.
 Qed.
 
 Lemma tc_vals_length: forall tys vs, tc_vals tys vs -> length tys = length vs.
@@ -2439,93 +984,103 @@ induction tys; destruct vs; simpl; intros; auto; try contradiction.
 destruct H; auto.
 Qed.
 
-Lemma eval_exprlist_relate {CS}:
-  forall (Delta : tycontext) (tys: list type)
+Lemma eval_exprlist_relate:
+  forall CS' (Delta : tycontext) (tys: list type)
      (bl : list expr) (psi : genv) (vx : env) (tx : temp_env)
      (rho : environ) m,
-   @denote_tc_assert CS (typecheck_exprlist Delta tys bl) rho (m_phi m) ->
    typecheck_environ Delta rho ->
-   cenv_sub cenv_cs (genv_cenv psi) ->
+   cenv_sub (@cenv_cs CS') (genv_cenv psi) ->
    rho = construct_rho (filter_genv psi) vx tx ->
-   Clight.eval_exprlist psi vx tx (m_dry m) bl
+   mem_auth m ∗ denote_tc_assert (typecheck_exprlist(CS := CS') Delta tys bl) rho ⊢
+   ⌜Clight.eval_exprlist psi vx tx m bl
      tys
-     (eval_exprlist tys bl rho).
+     (@eval_exprlist CS' tys bl rho)⌝.
 Proof.
   intros.
-  revert bl H; induction tys; destruct bl; simpl; intros; try contradiction H.
-  constructor.
- rewrite !denote_tc_assert_andp in H.
- super_unfold_lift.
- destruct H as [[? ?] ?].
- specialize (IHtys bl H4).
- constructor 2 with (eval_expr e (construct_rho (filter_genv psi) vx tx)); auto.
- subst.
- eapply eval_expr_relate; eauto.
- pose proof (cast_exists Delta e a rho (m_phi m) H0 H H3).
- rewrite <- H5; clear H5.
- subst.
- apply cop2_sem_cast'; try eassumption.
- eapply typecheck_expr_sound; eassumption.
+  revert bl; induction tys; destruct bl; simpl; intros; iIntros "[Hm H]"; try iDestruct "H" as "[]".
+  { iPureIntro; constructor. }
+  unfold typecheck_expr; fold typecheck_expr.
+  rewrite !denote_tc_assert_andp.
+  iDestruct (IHtys with "[$Hm H]") as %?; first by iDestruct "H" as "[_ $]".
+  rewrite bi.and_elim_l.
+  iDestruct (eval_expr_relate with "[$Hm H]") as %?; [done..| |]; first by iDestruct "H" as "[$ _]".
+  iDestruct (cast_exists with "H") as %?; first done.
+  rewrite typecheck_expr_sound //; iDestruct "H" as (?) "H".
+  iDestruct (cop2_sem_cast' with "[$Hm $H]") as %?; first done; iPureIntro.
+  econstructor; eauto.
+  unfold_lift; congruence.
 Qed.
 
-Lemma believe_exists_fundef:
-  forall {Espec : OracleKind} {CS : compspecs}
+Lemma believe_exists_fundef':
+  forall {CS}
     {b : block} {id_fun : ident} {psi : genv} {Delta : tycontext}
-    {n: nat} {fspec: funspec}
+    {fspec: funspec}
   (Findb : Genv.find_symbol (genv_genv psi) id_fun = Some b)
-  (Believe : app_pred (believe Espec Delta psi Delta) n)
-  (H3: (glob_specs Delta) ! id_fun = Some fspec),
- {f : Clight.fundef |
-  Genv.find_funct_ptr (genv_genv psi) b = Some f /\
-  type_of_fundef f = type_of_funspec fspec }.
+  (H3: (glob_specs Delta) !! id_fun = Some fspec),
+  (⊢ believe(CS := CS) OK_spec Delta psi Delta) ->
+  {f : Clight.fundef | Genv.find_funct_ptr (genv_genv psi) b = Some f /\
+   type_of_fundef f = type_of_funspec fspec}.
 Proof.
-intros.
-destruct fspec as [[params retty] cc A P Q NEP NEQ].
-simpl.
-specialize (Believe (Vptr b Ptrofs.zero)
-                  (params,retty) cc A P Q _ _ (necR_refl _) (ext_refl _)).
-spec Believe.  { exists id_fun, NEP, NEQ. split; auto. exists b; split; auto. }
-simpl (semantics.initial_core _). unfold j_initial_core.
-simpl (semantics.initial_core _). unfold cl_initial_core.
-destruct (Genv.find_funct_ptr psi b) as [f|] eqn:Eb; swap 1 2.
-{ exfalso.
-  destruct Believe as [H | (b' & fu & (? & WOB & ASD) & WOBk)].
-  + unfold believe_external in *.
-    unfold Genv.find_funct in *. rewrite if_true in H by trivial.
-    simpl in Eb, H. rewrite Eb in H. auto.
-  + assert (b' = b) by congruence. simpl in WOB, Eb. subst b'. congruence.
-}
-exists f; split; auto.
-destruct Believe as [BE|BI].
- - unfold believe_external in *.
-    simpl in BE. if_tac [_|?] in BE. 2:tauto.
-    rewrite Eb in BE.
-    destruct f as [ | ef sigargs sigret c'']. tauto.
-    simpl.
-    destruct BE as [((Es & -> & ASD & _) & ?) _].
-    inv Es. f_equal.
- -
-    destruct BI as (b' & fu & (? & WOB & ? & ? & ? & ? & wob & ? & ?) & _).
+  intros.
+  destruct fspec as [fsig cc A E P Q].
+  simpl.
+  assert (⊢ believe_external OK_spec psi (Vptr b Ptrofs.zero) fsig cc A E P Q ∨ believe_internal OK_spec psi Delta (Vptr b Ptrofs.zero) fsig cc A E P Q) as Bel.
+  { rewrite /bi_emp_valid H.
+    iIntros "H"; iApply "H"; iPureIntro.
+    exists id_fun; eauto. }
+  destruct (Genv.find_funct_ptr psi b) as [f|] eqn:Eb; swap 1 2.
+  { assert (⊢ False : mpred) as HF; last by apply ouPred.consistency in HF.
+    rewrite /bi_emp_valid Bel.
+    iIntros "[BE | BI]".
+    + unfold believe_external.
+      unfold Genv.find_funct in *. rewrite -> if_true by trivial.
+      rewrite Eb //.
+    + iDestruct "BI" as (b' fu (? & ? & ? & ? & ? & ? & ? & ? & ?)) "_"; congruence. }
+  exists f; split; auto.
+  clear H; match goal with H : ⊢ ?P |- ?Q => assert (P ⊢ ⌜Q⌝) as HQ; last by rewrite HQ in H; apply ouPred.pure_soundness in H end.
+  iIntros "[BE | BI]".
+  - rewrite /believe_external /=.
+    if_tac; last done.
+    rewrite Eb.
+    destruct f as [ | ef sigargs sigret c'']; first done.
+    iDestruct "BE" as ((Es & -> & ASD & _)) "(#? & _)"; inv Es; done.
+  - iDestruct "BI" as (b' fu (? & ? & ? & ? & ? & ? & ? & ? & ?)) "_"; iPureIntro.
     unfold fn_funsig in *. simpl fst in *; simpl snd in *.
     assert (b' = b) by congruence. subst b'.
-    simpl in Eb, WOB. assert (f = Internal fu) by congruence. subst.
-    simpl.
-    unfold type_of_function.
-    f_equal.
+    assert (f = Internal fu) by congruence; subst; simpl.
+    unfold type_of_function; destruct fsig; simpl in *; subst; done.
 Qed.
 
-Lemma eval_exprlist_relate' {CS}:
-  forall (Delta : tycontext) (tys: list type)
-     (bl : list expr) (psi : genv) (vx : env) (tx : temp_env)
-     (rho : environ) m,
-   @denote_tc_assert CS (typecheck_exprlist Delta tys bl) rho (m_phi m) ->
-   typecheck_environ Delta rho ->
-   cenv_sub cenv_cs (genv_cenv psi) ->
-   rho = construct_rho (filter_genv psi) vx tx ->
-   Clight.eval_exprlist psi vx tx (m_dry m) bl
-     tys
-     (eval_exprlist tys bl rho).
-Proof. intros. eapply eval_exprlist_relate; eassumption. Qed.
+Lemma believe_exists_fundef:
+  forall {CS}
+    {b : block} {id_fun : ident} {psi : genv} {Delta : tycontext}
+    {fspec: funspec}
+  (Findb : Genv.find_symbol (genv_genv psi) id_fun = Some b)
+  (H3: (glob_specs Delta) !! id_fun = Some fspec),
+  believe(CS := CS) OK_spec Delta psi Delta ⊢
+  ⌜∃ f : Clight.fundef,
+   Genv.find_funct_ptr (genv_genv psi) b = Some f /\
+   type_of_fundef f = type_of_funspec fspec⌝.
+Proof.
+  intros.
+  destruct fspec as [[params retty] cc A E P Q].
+  simpl.
+  iIntros "Believe".
+  iSpecialize ("Believe" with "[%]").
+  { exists id_fun; eauto. }
+  iDestruct "Believe" as "[BE|BI]".
+  - rewrite /believe_external /=.
+    if_tac; last done.
+    destruct (Genv.find_funct_ptr psi b) eqn: Hf; last done.
+    iExists _; iSplit; first done.
+    destruct f as [ | ef sigargs sigret c'']; first done.
+    iDestruct "BE" as ((Es & -> & ASD & _)) "(#? & _)"; inv Es; done.
+  - iDestruct "BI" as (b' fu (? & WOB & ? & ? & ? & ? & wob & ? & ?)) "_"; iPureIntro.
+    unfold fn_funsig in *. simpl fst in *; simpl snd in *.
+    assert (b' = b) by congruence. subst b'.
+    eexists; split; first done; simpl.
+    unfold type_of_function; subst; done.
+Qed.
 
 Lemma tc_vals_Vundef {args ids} (TC:tc_vals ids args): Forall (fun v : val => v <> Vundef) args.
 Proof.
@@ -2534,978 +1089,340 @@ destruct ids; simpl in TC. contradiction. destruct TC.
 constructor; eauto. intros N; subst. apply (tc_val_Vundef _ H).
 Qed.
 
-Lemma semax_call_aux {CS Espec}
-  (Delta : tycontext) (psi : genv) (ora : OK_ty) (jm : juicy_mem) (b : block) (id : ident) cc
-  A deltaP deltaQ NEP' NEQ' retty clientparams
-  (F0 : assert) (ret : option ident) (curf: function) args (a : expr)
-  (bl : list expr) (R : ret_assert) (vx:env) (tx:Clight.temp_env) (k : cont) (rho : environ)
-  (Hora : ext_compat ora (m_phi jm))
+Notation dtfr := (@dtfr Σ).
 
-  (Bel: believe Espec Delta psi Delta (level (m_phi jm)))
-  (Spec: (glob_specs Delta)!id = Some (mk_funspec (clientparams, retty) cc A deltaP deltaQ NEP' NEQ'))
-  (FindSymb: Genv.find_symbol psi id = Some b)
+Lemma semax_call_aux0 {CS'}
+  E (Delta : tycontext) (psi : genv) (ora : OK_ty) (b : block) (id : ident) cc
+  A0 P (x : dtfr A0) A nE deltaP deltaQ retty clientparams
+  (F0 : assert) F (ret : option ident) (curf: function) args
+  (R : ret_assert) (vx:env) (tx:Clight.temp_env) (k : cont) (rho : environ)
 
-  (Classify: Cop.classify_fun (typeof a) = Cop.fun_case_f clientparams retty cc)
+  (Spec: (glob_specs Delta)!!id = Some (mk_funspec (clientparams, retty) cc A nE deltaP deltaQ))
+  (FindSymb: Genv.find_symbol psi id = Some b)
   (TCRet: tc_fn_return Delta ret retty)
-  (TCA: (|>tc_expr Delta a rho) (m_phi jm))
-  (TCbl: (|>tc_exprlist Delta clientparams bl rho) (m_phi jm))
-  (Argsdef: args = eval_exprlist clientparams bl rho)
   (GuardEnv: guard_environ Delta curf rho)
-  (Hretty: retty =Tvoid -> ret=None)
-  (CLosed: closed_wrt_modvars (Scall ret a bl) F0)
-  nQ
-  (CSUB: cenv_sub (@cenv_cs CS) (genv_cenv psi))
+  (Hretty: retty=Tvoid -> ret=None)
+  (Closed: closed_wrt_vars (thisvar ret) F0)
+  (CSUB: cenv_sub (@cenv_cs CS') (genv_cenv psi))
   (Hrho: rho = construct_rho (filter_genv psi) vx tx)
-  (EvalA: eval_expr a rho = Vptr b Ptrofs.zero)
-  (Funassert: funassert Delta rho (m_phi jm))
-  (RGUARD: (|> rguard Espec psi Delta curf (frame_ret_assert R F0) k) (level (m_phi jm)))
-  (PostAdapt: forall (ts: list Type) (x : dependent_type_functor_rec ts A mpred)
-                     (vl : fconst environ mpred),
-        (! |> (deltaQ ts x vl <=> nQ ts x vl)) (m_phi jm))
-  (PREHR: (|> fupd
-              (EX (ts: list Type) (x : dependent_type_functor_rec ts A mpred)
-                  (F : environ -> pred rmap),
-               (F0 rho * F rho * deltaP ts x (ge_of rho, args)) &&
-               (ALL rho' : environ ,
-                           |>
-                             !((EX old:val, substopt ret (`old) F rho' * maybe_retval (nQ ts x) retty ret rho') >=> fupd (RA_normal R rho') )))) (m_phi jm)):
-   jsafeN (@OK_spec Espec) psi ora
-     (State curf (Scall ret a bl) k vx tx) jm.
-Proof.
-  destruct (believe_exists_fundef FindSymb Bel Spec) as [ff [H16 H16']].
-  rewrite <- Genv.find_funct_find_funct_ptr in H16.
-  case_eq (level (m_phi jm)); [solve [simpl; constructor; auto] | intros n H2].
-  rewrite <- level_juice_level_phi in H2.
-  destruct (levelS_age1 _ _ H2) as [jmx H13].
-  apply jsafeN_local_step_fupd
-    with (s2 :=  Callstate ff (eval_exprlist clientparams bl rho)
-                                     (Kcall ret curf vx tx k)). {
-    eapply step_call with (vargs:=eval_exprlist clientparams bl rho);
-      try eassumption. rewrite <- EvalA. erewrite age_jm_dry by eauto.
-    eapply eval_expr_relate; try solve[rewrite H0; auto]; auto.
-    destruct GuardEnv; eassumption.
-    eapply TCA. apply age_laterR; apply age_jm_phi; auto.
-    erewrite age_jm_dry by eauto.
-    eapply eval_exprlist_relate' with Delta.
-    - clear -  H13 TCbl. eapply TCbl.
-      apply age_laterR; apply age_jm_phi; auto.
-    - destruct GuardEnv ; auto.
-    - assumption.
-    - auto. }
-  intros jm2 H22.
-  assert (jmx = jm2).
-  { clear - H13 H22. red in H22. congruence. } subst jmx.
-
-  specialize (TCA _ (age_laterR (age_jm_phi H13))).
-  specialize (TCbl _ (age_laterR (age_jm_phi H13))).
-  specialize (PREHR _ (age_laterR (age_jm_phi H13))).
-  specialize (RGUARD _ (laterR_level' (age_laterR (age_jm_phi H13)))).
-  apply (pred_nec_hereditary _ _ _
-                             (laterR_necR (age_laterR (age_jm_phi H13)))) in Funassert.
-  eapply ext_join_approx in Hora.
-  erewrite <- age1_ghost_of in Hora by (eapply age_jm_phi; eauto).
-  assert (LATER: laterR (level (m_phi jm)) n) by
-      (constructor 1; rewrite <- level_juice_level_phi, H2; reflexivity).
-
-  assert (TC8 := tc_eval_exprlist _ _ _ _ _ (proj1 GuardEnv) TCbl).
-  assert (Hargs: Datatypes.length clientparams =
-                 Datatypes.length (eval_exprlist clientparams bl rho)). {
-    clear - TCbl.
-    revert bl TCbl; induction clientparams; destruct bl; intros; try contradiction.
-    reflexivity. unfold tc_exprlist in TCbl. simpl in TCbl.
-    rewrite !denote_tc_assert_andp in TCbl. destruct TCbl as [[? ?] ?].
-    simpl. f_equal; auto. }
-
-  subst args.
-  set (args := eval_exprlist clientparams bl rho) in *.
-  assert (ArgsNotVundef:= tc_vals_Vundef TC8).
-  clearbody args.
-  assert (H11': forall ts (x : dependent_type_functor_rec ts A mpred) (vl : environ),
-             (! |> (deltaQ ts x vl <=> nQ ts x vl)) (m_phi jm2)). {
-    intros ???.
-    apply (pred_nec_hereditary _ _ _
-                               (laterR_necR (age_laterR (age_jm_phi H13)))); auto. }
-  clear PostAdapt; rename H11' into H11.
-
-  apply age_level in H13.
-  assert (n = level jm2) by congruence.
-  subst n.
-
-  clear TCbl TCA EvalA.
-  set (ctl := Kcall ret curf vx tx k).
-  change (level (m_phi jm)) with (level jm) in Bel.
-  rewrite H2 in Bel.
-  clear jm LATER H22 H2 H13.
-  rename jm2 into jm.
-
-  unfold type_of_funspec, xtype_of_funspec in H16'; simpl in H16'.
-  assert (H2 := I).
-
-  assert (H14':  fupd
-                 (EX ts (x : dependent_type_functor_rec ts A mpred) F,
-                  F0 rho * F rho * deltaP ts x (ge_of rho, args) &&
-                             (ALL rho' : environ,
-                 |> ! ((EX old : val,
-                                 substopt ret (` old) F rho' *
-                                 maybe_retval (deltaQ ts x) retty ret rho') >=>
-            fupd (RA_normal R rho')))) (m_phi jm)). {
-    clear - PREHR H11.
-    eapply fupd.subp_fupd, PREHR; eauto.
-    assert ((|> ALL ts x vl, (deltaQ ts x vl <=> nQ ts x vl)) (level (m_phi jm))) as H12.
-    { do 3 (rewrite later_allp; intro); apply H11. }
-    eapply subp_exp, H12; intros ts.
-    apply subp_exp; intros x.
-    apply subp_exp; intros F.
-    apply subp_andp; [apply subp_refl|].
-    apply subp_allp; intros rho'.
-    eapply derives_trans, subp_later1.
-    apply later_derives.
-    rewrite <- subp_eq, <- unfash_andp; apply unfash_derives.
-    clear; intros ? [? H0] ?????? [old ?]; eapply H0; eauto.
-    exists old.
-    destruct H4 as (? & b & ? & ? & Hret); do 3 eexists; eauto; split; auto.
-    specialize (H ts x).
-    assert (level b <= a)%nat.
-    { apply join_level in H4 as []; apply rmap_order in H3 as [? _]; apply necR_level in H2; lia. }
-    unfold maybe_retval; destruct ret; simpl in Hret.
-    + destruct Hret; split; auto. eapply H; eauto.
-    + destruct retty; [eapply H; eauto | destruct Hret as (? & ? & ?); do 2 eexists; eauto; eapply H; eauto ..]. }
-
-  rewrite closed_wrt_modvars_Scall in CLosed.
-  clear a bl Classify.
-
-  clear nQ H11 PREHR. rename H14' into H14; rename deltaQ into Q; assert (H11 := I).
-  rename NEQ' into NEQ.
-
-(*** cut here *****)
-
-  assert (Prog_OK' := Bel).
-  specialize (Prog_OK' (Vptr b Ptrofs.zero)
-                       (clientparams,retty) cc A deltaP Q _ _ (necR_refl _) (ext_refl _)).
-
-  spec Prog_OK'.
-  { hnf. exists id, NEP', NEQ; split; auto.
-    exists b; split; auto. }
-  clear Spec FindSymb id.
-  change (level (m_phi jm)) with (level jm) in Prog_OK'.
-  assert (H9: necR (S (level jm)) (level jm)) by
-      (apply laterR_necR; apply age_laterR; reflexivity).
-  apply (pred_nec_hereditary _ _ _ H9) in Bel. clear H9.
-
-  destruct Prog_OK' as [H5|H5].
-  - pose proof (conj Funassert H14) as Hpre.
-    apply fupd.fupd_andp_corable in Hpre; [|apply corable_funassert].
-    intros ?????? Hw ?? J; eapply Hpre in Hw; try apply necR_jm_phi; eauto.
-    destruct (bupd_jm_bupd _ _ _ Hw J) as
-        (jm' & Hupd & HR & J').
-    exists jm'; repeat (split; auto).
-    destruct (level jm') eqn: Hl; auto.
-    destruct HR as [HF | (w1 & w2 & ? & ? & [Funassert' HR])].
-    { symmetry in Hl; apply levelS_age in Hl as (? & Hage & ?).
-      rewrite later_age in HF; apply age_jm_phi, HF in Hage; contradiction. }
-    edestruct (juicy_mem_sub jm' w2) as (jm0 & ? & ?); subst.
-    { eexists; eauto. }
-    destruct HR as (ts & x & F & H14' & HR).
-    right; do 3 eexists; eauto; split; auto; split; auto.
-    assert (level jm0 <= level jm)%nat.
-    { apply join_level in H4 as []; destruct Hupd; apply join_level in H0 as []; apply necR_level in H; rewrite <- !level_juice_level_phi in *; lia. }
-
-    eapply semax_call_external with (P:=deltaP)(Q:=Q)(fsig := (clientparams, retty)); try eassumption.
-    + apply (ext_join_sub_approx _ (level z)) in H3.
-      eapply joins_comm, join_sub_joins_trans; eauto.
-      eapply joins_comm, join_sub_joins_trans; eauto.
-      eexists; apply ghost_of_join; eauto.
-    + reflexivity.
-    + eapply pred_nec_hereditary; [apply nec_nat | eauto].
-      rewrite <- !level_juice_level_phi; auto.
-    + eapply pred_nec_hereditary; [apply nec_nat | eauto].
-      lia.
-  - apply (pred_nec_hereditary _ _ (level jm)) in H5.
-    2: apply laterR_necR; apply age_laterR; constructor.
-
-    red in GuardEnv.
-    destruct H5 as [b' [f [[H3a [H3b ?]] H19]]].
-    injection H3a; intro; subst b'; clear H3a.
-    change (Genv.find_funct psi (Vptr b Ptrofs.zero) = Some (Internal f)) in H3b.
-    rewrite H16 in H3b. injection H3b; clear H3b; intros; subst ff.
-    destruct H as [COMPLETE [H17 [H17' [Hvars [H18 H18']]]]].
-    pose proof I.
-
-    pose proof (conj Funassert H14) as Hpre.
-    apply fupd.fupd_andp_corable in Hpre; [|apply corable_funassert].
-    intros ?????? Hw ?? J; eapply Hpre in Hw; try apply necR_jm_phi; eauto.
-    destruct (bupd_jm_bupd _ _ _ Hw J) as
-        (jm' & Hupd & HR & J').
-    exists jm'; repeat (split; auto).
-    destruct (level jm') eqn: Hl; auto.
-    destruct HR as [HF | (w1 & w2 & ? & ? & [Funassert' HR])].
-    { symmetry in Hl; apply levelS_age in Hl as (? & Hage & ?).
-      rewrite later_age in HF; apply age_jm_phi, HF in Hage; contradiction. }
-    edestruct (juicy_mem_sub jm' w2) as (jm0 & ? & ?); subst.
-    { eexists; eauto. }
-    destruct HR as (ts & x & F & H14' & HR).
-    right; do 3 eexists; eauto; split; auto; split; auto.
-    specialize (H19 Delta CS _ _ (necR_refl _) (ext_refl _)).
-    spec H19. {
-      intro; apply tycontext_sub_refl. }
-    specialize (H19 _ _ (necR_refl _) (ext_refl _) (cenv_sub_refl) ts x).
-    red in H19.
-
-    assert (necR (level jm) (level jm0)) as Hnec.
-    { apply nec_nat; apply join_level in H5 as []; destruct Hupd; apply join_level in H1 as []; apply necR_level in H0; rewrite <- !level_juice_level_phi in *; lia. }
-    destruct (level jm0) eqn:Hl0; [constructor; auto |].
-    destruct (levelS_age1 _ _ Hl0) as [jm2 H13]. change (age jm0 jm2) in H13.
-    rewrite <- Hl0 in *.
-    assert (laterR (level jm) (level jm2)) as H13'.
-    { eapply necR_laterR; eauto. apply laterR_level', t_step; auto. }
-    specialize (H19 _ H13').
-    rewrite semax_fold_unfold in H19.
-    set (rho := construct_rho (filter_genv psi) vx tx).
-    eapply pred_nec_hereditary in Bel; eauto.
-    specialize (H19 _ _ _ _ _ (necR_refl _) (ext_refl _)
-                    (conj (tycontext_sub_refl _) (conj cenv_sub_refl CSUB))
-                    _ _ (necR_refl _) (ext_refl _)
-                    (pred_nec_hereditary
-                       _ _ _
-                       (necR_level' (laterR_necR (age_laterR H13))) Bel)
-                    ctl (fun _: environ => F0 rho * F rho) f _ _ (necR_refl _) (ext_refl _)).
-    clear Bel.
-
-    spec H19. {
-      eapply semax_call_aux2 with (bl:=nil)(a:=Econst_int Int.zero tint)
-                                  (Q:=Q)(fsig:=(clientparams,retty)); try apply HR; eauto.
-      + apply (ext_join_sub_approx _ (level z)) in H4.
-        eapply joins_comm, join_sub_joins_trans; eauto.
-        eapply joins_comm, join_sub_joins_trans; eauto.
-        eexists; apply ghost_of_join; eauto.
-      + rewrite closed_wrt_modvars_Scall; auto.
-      + tauto.
-      + apply now_later; eapply pred_nec_hereditary; eauto. }
-
-    remember (alloc_juicy_variables psi empty_env jm0 (fn_vars f)) eqn:AJV.
-    destruct p as [ve' jm'']; symmetry in AJV.
-    destruct (alloc_juicy_variables_e _ _ _ _ _ _ AJV) as [H15 [H20' CORE]].
-    assert (MATCH := alloc_juicy_variables_match_venv _ _ _ _ _ AJV).
-    assert (H20 := alloc_juicy_variables_resource_decay _ _ _ _ _ _ AJV).
-    destruct (build_call_temp_env f args) as [te' H21]; auto.
-    { clear - H16' Hargs.
-      simpl in H16'. unfold type_of_function in H16'. inv H16'. rewrite <- Hargs.
-      unfold type_of_params. rewrite map_length. auto. }
-    pose proof (age_twin' _ _ _ H20' H13) as [jm''' [_ H20x]].
-    apply @jsafeN_step with (c' := State f (f.(fn_body)) ctl ve' te')
-                           (m' := jm'''); auto.
-    + split; auto.
-      * apply step_internal_function.
-        apply list_norepet_append_inv in H17; destruct H17 as [H17 [H22 H23]];
-          constructor; auto. rewrite <- (age_jm_dry H20x); auto.
-      * split.
-        -- destruct H20; apply resource_decay_trans with
-                             (nextblock (m_dry jm'')) (m_phi jm''); auto.
-           apply age1_resource_decay; auto.
-        -- split.
-           ++ rewrite H20'; apply age_level; auto.
-           ++ erewrite <- (alloc_juicy_variables_ghost _ _ _ jm0), AJV; simpl.
-              apply age1_ghost_of, age_jm_phi; auto.
-    + assert (H22: (level jm2 >= level jm''')%nat)
-        by (apply age_level in H13; apply age_level in H20x; lia).
-      pose (rho3 := mkEnviron (ge_of rho) (make_venv ve') (make_tenv te')).
-      assert (H23: app_pred (funassert Delta rho3) (m_phi jm''')). {
-        apply (resource_decay_funassert _ _ (nextblock (m_dry jm0)) _ (m_phi jm'''))
-          in Funassert'. 2: apply laterR_necR; apply age_laterR; auto.
-        unfold rho3; clear rho3. apply Funassert'.
-        rewrite CORE. apply age_core. apply age_jm_phi; auto.
-        destruct H20;  apply resource_decay_trans with
-                           (nextblock (m_dry jm'')) (m_phi jm''); auto.
-        apply age1_resource_decay; auto. }
-      specialize (H19 te' ve' _ H22 _ _ (necR_refl _) (ext_refl _)).
-      spec H19; [clear H19|]. {
-        split; [split |]; auto.
-        split; [ | simpl; split; [ | reflexivity]; apply MATCH ].
-        - rewrite (age_jm_dry H20x) in H15.
-          clear - GuardEnv TC8 H18 H16 H21 H15 H23 H17 H17' H13.
-          unfold rho3 in *. simpl in *. destruct H23.
-          destruct rho. simpl in *.
-          remember (split (fn_params f)). destruct p.
-          simpl in *. if_tac in H16; try congruence.
-          destruct GuardEnv as [[_ [_ TC5]] _].
-          eapply semax_call_typecheck_environ with (jm := jm2); try eassumption.
-          + erewrite <- age_jm_dry by apply H13; auto.
-          + rewrite snd_split, <- H18; apply TC8.
-        - normalize.
-          split; auto. unfold rho3 in H23.
-          simpl ge_of in H23. auto. unfold bind_args. unfold tc_formals.
-          normalize. rewrite <- sepcon_assoc. normalize.
-          simpl fst in H18; simpl snd in H18. split.
-          + hnf. destruct H18' as [H18b H18']. simpl snd in *.
-            subst retty. subst clientparams. clear - TC8 H21 H17. simpl in *.
-            match goal with H: tc_vals _ ?A |- tc_vals _ ?B =>
-                            replace B with A; auto end.
-            rewrite list_norepet_app in H17. destruct H17 as [H17 [_ _]].
-            clear - H17 H21. forget (create_undef_temps (fn_temps f)) as te.
-            revert  args te te' H21 H17.
-            induction (fn_params f); destruct args; intros; auto; try discriminate.
-            destruct a; inv H21. destruct a. simpl in H21. inv H17.
-            simpl. f_equal. unfold eval_id, construct_rho; simpl.
-            inv H21. erewrite pass_params_ni; try eassumption.
-            rewrite PTree.gss. reflexivity. eapply IHl; try eassumption.
-          + fold rho in H14'.
-            forget (F0 rho * F rho) as Frame.
-             destruct H18' as [H18b H18']. simpl snd in *. rewrite H18 in *.
-             simpl @fst in *. apply (alloc_juicy_variables_age H13 H20x) in AJV.
-             forget (fn_params f) as fparams.
-             clear - H18 H21 H14' AJV H17 H17' Hvars
-                         CSUB COMPLETE H13 ArgsNotVundef.
-             assert (app_pred (Frame * close_precondition
-                                         (map fst fparams) (deltaP ts x)
-                                         (construct_rho (filter_genv psi) ve' te'))
-                              (m_phi jm2)). {
-               eapply pred_nec_hereditary.
-               - apply laterR_necR. apply age_laterR. eapply age_jm_phi. apply H13.
-               - eapply sepcon_derives; try apply H14'; auto.
-                 eapply make_args_close_precondition; eauto.
-                 apply list_norepet_app in H17; intuition. }
-             clear H14'.
-             subst rho; forget (Frame *
-                     close_precondition (map fst fparams) (deltaP ts x)
-                                        (construct_rho (filter_genv psi) ve' te')) as
-                 Frame2.
-             clear - H17' H21 AJV H Hvars CSUB COMPLETE.
-             change (stackframe_of' cenv_cs) with stackframe_of.
-             eapply alloc_juicy_variables_lem2; eauto.
-             unfold var_sizes_ok in Hvars;
-               rewrite Forall_forall in Hvars, COMPLETE |- *.
-             intros v H0. specialize (COMPLETE v H0). specialize (Hvars v H0).
-             rewrite (cenv_sub_sizeof CSUB); auto. }
-      replace (level jm2) with (level jm''')
-        by (clear - H13 H20x H20'; apply age_level in H13;
-            apply age_level in H20x; lia).
-      eapply assert_safe_jsafe, H19.
-Qed.
-
-Lemma semax_call_aux' {CS Espec}
-  (Delta : tycontext) (psi : genv) (ora : OK_ty) (jm : juicy_mem) (b : block) (id : ident) cc
-  A deltaP deltaQ NEP' NEQ' retty clientparams
-  (F : environ -> pred rmap)
-  (F0 : assert) (ret : option ident) (curf: function) args (a : expr)
+  (ff : Clight.fundef) (H16 : Genv.find_funct psi (Vptr b Ptrofs.zero) = Some ff)
+  (H16' : type_of_fundef ff = type_of_funspec (mk_funspec (clientparams, retty) cc A nE deltaP deltaQ))
+  (TC8 : tc_vals clientparams args)
+  ctl (Hcont : call_cont ctl = ctl)
+  (Hctl : ∀ ret0 z', assert_safe OK_spec psi E curf vx (set_opttemp ret (force_val ret0) tx)
+             (exit_cont EK_normal None k)  (construct_rho (filter_genv psi) vx (set_opttemp ret (force_val ret0) tx)) ⊢
+    jsafeN OK_spec psi E z' (Returnstate (force_val ret0) ctl)):
+  □ believe OK_spec Delta psi Delta -∗
+  ▷ (F0 rho ∗ F rho ∗ P x (ge_of rho, args) -∗
+     funassert Delta rho -∗
+     □ ■ (F rho ∗ P x (ge_of rho, args) ={E}=∗
+                          ∃ (x1 : dtfr A) (F1 : assert),
+                            ⌜nE x1 ⊆ E⌝ ∧ (F1 rho ∗ deltaP x1 (ge_of rho, args))
+                            ∧ (∀ rho' : environ,
+                                 ■ ((∃ old:val, substopt ret (`old) F1 rho' ∗ maybe_retval (assert_of (deltaQ x1)) retty ret rho') -∗
+                                    RA_normal R rho'))) -∗
+  <affine> rguard OK_spec psi E Delta curf (frame_ret_assert R F0) k -∗
+  jsafeN OK_spec psi E ora (Callstate ff args ctl)).
+Proof.
+  iIntros "#Bel".
+  iPoseProof ("Bel" with "[%]") as "Bel'".
+  { exists id; eauto. }
+  pose proof (tc_vals_length _ _ TC8) as Hlen.
+  iDestruct "Bel'" as "[BE | BI]".
+  - (* external call *)
+    iPoseProof (semax_call_external with "BE") as "Hsafe"; [done..|].
+    iNext; iIntros "(F0 & ?) fun #HR rguard".
+    iApply ("Hsafe" with "rguard fun F0").
+    by iApply "HR".
+  - (* internal call *)
+    rewrite believe_internal_mask_mono //.
+    iDestruct "BI" as (b' f (H3a & H3b & COMPLETE & H17 & H17' & Hvars & H18 & H18')) "BI".
+    injection H3a as <-; change (Genv.find_funct psi (Vptr b Ptrofs.zero) = Some (Internal f)) in H3b.
+    rewrite H16 in H3b; inv H3b.
+    iSpecialize ("BI" with "[%] [%]").
+    { intros; apply tycontext_sub_refl. }
+    { apply cenv_sub_refl. }
+    iNext; iIntros "(F0 & P) fun #HR rguard".
+    iMod ("HR" with "P") as (???) "((? & ?) & #post)".
+    iSpecialize ("BI" $! x1); rewrite semax_fold_unfold.
+    iPoseProof ("BI" with "[%] [Bel] [rguard]") as "#guard".
+    { split3; eauto; [apply tycontext_sub_refl | apply cenv_sub_refl]. }
+    { done. }
+    { iIntros "!>"; rewrite bi.affinely_elim.
+      rewrite bi.pure_and; setoid_rewrite (bi.pure_True (nE x1 ⊆ E)); last done.
+      rewrite bi.and_True.
+      iApply (semax_call_aux2 _ _ _ _ _ _ _ _ _ (clientparams,retty) (Econst_int Int.zero tint) nil with "post rguard"); try done.
+      * rewrite closed_wrt_modvars_Scall //.
+      * destruct H18' as [-> _]; rewrite H18 //. }
+    iApply jsafe_step; rewrite /jstep_ex.
+    iIntros (?) "(Hm & ?)".
+    destruct (build_call_temp_env f args) as (te & Hte).
+    { rewrite /= in H18; rewrite H18 map_length // in Hlen. }
+    iMod (alloc_stackframe with "Hm") as (?? [??]) "(Hm & stack)"; [try done.. |].
+    { unfold var_sizes_ok in Hvars.
+      rewrite !Forall_forall in Hvars, COMPLETE |- *.
+      intros v H0. specialize (COMPLETE v H0). specialize (Hvars v H0).
+      rewrite (cenv_sub_sizeof CSUB); auto. }
+    iIntros "!>"; iExists _, _; iSplit.
+    { apply list_norepet_append_inv in H17 as (? & ? & ?).
+      iPureIntro; constructor; constructor; done. }
+    iFrame.
+    iApply ("guard" with "[-]"); last by iIntros "!> !>"; iPureIntro.
+    iSplit.
+    + iPureIntro.
+      split; last done.
+      eapply semax_call_typecheck_environ; eauto.
+      * rewrite -Genv.find_funct_find_funct_ptr //.
+      * destruct GuardEnv as ((? & ? & ?) & ?); done.
+      * rewrite snd_split -H18 //.
+    + iFrame; monPred.unseal; iFrame.
+      monPred.unseal; iFrame.
+      apply list_norepet_app in H17 as [H17 [_ _]].
+      rewrite /bind_args; monPred.unseal; iSplit.
+      * iPureIntro.
+        rewrite /tc_formals -H18 //.
+        match goal with H: tc_vals _ ?A |- tc_vals _ ?B => replace B with A; auto end.
+        clear - H17 Hte. forget (create_undef_temps (fn_temps f)) as te0.
+        revert args te0 te Hte H17.
+        induction (fn_params f); destruct args; intros; auto; try discriminate.
+        { destruct a; inv Hte. }
+        destruct a; simpl in Hte. inv H17.
+        rewrite (IHl _ _ _ Hte) //.
+        simpl; f_equal.
+        unfold eval_id, construct_rho; simpl.
+        erewrite pass_params_ni; try eassumption.
+        rewrite Maps.PTree.gss. reflexivity.
+      * iApply (make_args_close_precondition _ _ _ _ ve _ (argsassert_of _)); try done.
+        eapply tc_vals_Vundef; eauto.
+Qed.
+
+Lemma semax_call_aux {CS'}
+  E (Delta : tycontext) (psi : genv) (ora : OK_ty) (b : block) (id : ident) cc
+  A0 P (x : dtfr A0) A nE deltaP deltaQ retty clientparams
+  (F0 : assert) F (ret : option ident) (curf: function) args (a : expr)
   (bl : list expr) (R : ret_assert) (vx:env) (tx:Clight.temp_env) (k : cont) (rho : environ)
-  (Hora : ext_compat ora (m_phi jm))
 
-  (Bel: believe Espec Delta psi Delta (level (m_phi jm)))
-  (Spec: (glob_specs Delta)!id = Some (mk_funspec (clientparams, retty) cc A deltaP deltaQ NEP' NEQ'))
+  (Spec: (glob_specs Delta)!!id = Some (mk_funspec (clientparams, retty) cc A nE deltaP deltaQ))
   (FindSymb: Genv.find_symbol psi id = Some b)
 
   (Classify: Cop.classify_fun (typeof a) = Cop.fun_case_f clientparams retty cc)
   (TCRet: tc_fn_return Delta ret retty)
-  (TCA: (|>tc_expr Delta a rho) (m_phi jm))
-  (TCbl: (|>tc_exprlist Delta clientparams bl rho) (m_phi jm))
-  (Argsdef: args = eval_exprlist clientparams bl rho)
+  (Argsdef: args = @eval_exprlist CS' clientparams bl rho)
+  (Hlen : length clientparams = length args)
   (GuardEnv: guard_environ Delta curf rho)
-  (Hretty: retty =Tvoid -> ret=None)
-  (CLosed: closed_wrt_modvars (Scall ret a bl) F0)
-  nQ
-  (PREHR: (|> fupd
-              (EX (ts: list Type) (x : dependent_type_functor_rec ts A mpred)
-                  (F : environ -> pred rmap),
-               (F0 rho * F rho * deltaP ts x (ge_of rho, args)) &&
-              (ALL rho' : environ ,
-       !((EX old:val, substopt ret (`old) F rho' * maybe_retval (nQ ts x) retty ret rho') >=> fupd (RA_normal R rho') )))) (m_phi jm))
-  (CSUB: cenv_sub (@cenv_cs CS) (genv_cenv psi))
+  (Hretty: retty=Tvoid -> ret=None)
+  (Closed: closed_wrt_modvars (Scall ret a bl) F0)
+  (CSUB: cenv_sub (@cenv_cs CS') (genv_cenv psi))
   (Hrho: rho = construct_rho (filter_genv psi) vx tx)
-  (EvalA: eval_expr a rho = Vptr b Ptrofs.zero)
-  (Funassert: funassert Delta rho (m_phi jm))
-  (RGUARD: rguard Espec psi Delta curf (frame_ret_assert R F0) k
-        (level (m_phi jm)))
-  (PostAdapt: forall (ts: list Type) (x : dependent_type_functor_rec ts A mpred)
-                     (vl : fconst environ mpred),
-        (! |> (deltaQ ts x vl <=> nQ ts x vl)) (m_phi jm)):
-jsafeN (@OK_spec Espec) psi ora
-     (State curf (Scall ret a bl) k vx tx) jm.
-Proof.
-  intros. apply now_later in RGUARD.
-  eapply semax_call_aux; try eassumption.
-  eapply later_derives, PREHR.
-  apply fupd.fupd_mono.
-  apply exp_left; intros ts; apply exp_left; intros x; apply exp_left; intros FF;
-    apply exp_right with ts; apply exp_right with x; apply exp_right with FF.
-  apply andp_derives; auto.
-  eapply derives_trans; [apply now_later|].
-  rewrite box_all; auto.
-Qed.
-
-Lemma semax_call {CS Espec}:
-  forall Delta (A: TypeTree)
-  (P : forall ts, dependent_type_functor_rec ts (ArgsTT A) mpred)
-  (Q : forall ts, dependent_type_functor_rec ts (AssertTT A) mpred)
-  (NEP: args_super_non_expansive P) (NEQ: super_non_expansive Q)
-  (ts: list Type) (x : dependent_type_functor_rec ts A mpred)
-   F ret argsig retsig cc a bl,
-           Cop.classify_fun (typeof a) =
-           Cop.fun_case_f argsig retsig cc ->
-            (retsig = Tvoid -> ret = None) ->
-          tc_fn_return Delta ret retsig ->
-  @semax CS Espec Delta
-       (fun rho => (|>(tc_expr Delta a rho && tc_exprlist Delta argsig bl rho))  &&
-           (func_ptr (mk_funspec (argsig,retsig) cc A P Q NEP NEQ) (eval_expr a rho) &&
-          (|>(F rho * P ts x (ge_of rho, eval_exprlist argsig bl rho)))))
+  (EvalA: eval_expr a rho = Vptr b Ptrofs.zero):
+
+  □ believe OK_spec Delta psi Delta -∗
+  (▷tc_expr Delta a rho ∧ ▷tc_exprlist Delta clientparams bl rho) ∧
+  (▷ (F0 rho ∗ F rho ∗ P x (ge_of rho, args))) -∗
+  funassert Delta rho -∗
+  □ ▷ ■ (F rho ∗ P x (ge_of rho, args) ={E}=∗
+                          ∃ (x1 : dtfr A) (F1 : assert),
+                            ⌜nE x1 ⊆ E⌝ ∧ (F1 rho ∗ deltaP x1 (ge_of rho, args))
+                            ∧ (∀ rho' : environ,
+                                 ■ ((∃ old:val, substopt ret (`old) F1 rho' ∗ maybe_retval (assert_of (deltaQ x1)) retty ret rho') -∗
+                                    RA_normal R rho'))) -∗
+  ▷ <affine> rguard OK_spec psi E Delta curf (frame_ret_assert R F0) k -∗
+   jsafeN OK_spec psi E ora
+     (State curf (Scall ret a bl) k vx tx).
+Proof.
+  iIntros "#Bel H fun #HR rguard".
+  iDestruct (believe_exists_fundef with "Bel") as %[ff [H16 H16']]; [done..|].
+  rewrite <- Genv.find_funct_find_funct_ptr in H16.
+  rewrite /jsafeN jsafe_unfold /jsafe_pre.
+  iIntros "!>" (?) "(Hm & ?)".
+  iRight; iLeft.
+  rewrite (add_and (_ ∧ ▷ _) (▷_)); last by iIntros "H"; iNext; iDestruct "H" as "((_ & H) & _)"; destruct GuardEnv; iApply (tc_eval_exprlist with "H").
+  iDestruct "H" as "(H & >%TC8)".
+  iCombine "Hm H" as "H".
+  rewrite (add_and (mem_auth m ∗ _) (▷_)); last by iIntros "H"; iNext; iDestruct "H" as "(Hm & (H & _) & _)"; destruct GuardEnv; iApply (eval_expr_relate with "[$Hm $H]").
+  iDestruct "H" as "[H >%EvalA']".
+  rewrite (add_and (mem_auth m ∗ _) (▷_)); last by iIntros "H"; iNext; iDestruct "H" as "(Hm & (_ & H) & _)"; destruct GuardEnv; iApply (eval_exprlist_relate with "[$Hm $H]").
+  iDestruct "H" as "[H >%Hargs]".
+  iDestruct "H" as "(Hm & H)".
+  iIntros "!>"; iExists _, _; iSplit.
+  { iPureIntro; eapply step_call with (vargs:=args); subst; eauto.
+    rewrite EvalA //. }
+  iDestruct "H" as "(_ & F0 & P)".
+  iFrame.
+  rewrite closed_wrt_modvars_Scall in Closed.
+  subst args; iApply (semax_call_aux0 with "Bel [F0 P] [fun] HR rguard"); try done.
+  - intros; apply assert_safe_for_external_call.
+  - iNext; iFrame.
+Qed.
+
+Lemma eval_exprlist_length : forall lt le rho, length lt = length le -> length (eval_exprlist lt le rho) = length le.
+Proof.
+  induction lt; simpl; auto; intros.
+  destruct le; inv H; simpl.
+  rewrite IHlt //.
+Qed.
+
+(* compare https://gitlab.mpi-sws.org/iris/refinedc/-/blob/master/theories/caesium/lifting.v#L1042 *)
+Lemma semax_call_si:
+  forall E Delta (A: TypeTree) (Ef : dtfr (MaskTT A))
+   (P : dtfr (ArgsTT A))
+   (Q : dtfr (AssertTT A))
+   (x : dtfr A)
+   F ret argsig retsig cc a bl
+   (Hsub : Ef x ⊆ E) 
+   (TCF : Cop.classify_fun (typeof a) = Cop.fun_case_f argsig retsig cc)
+   (TC5 : retsig = Tvoid -> ret = None)
+   (TC7 : tc_fn_return Delta ret retsig),
+  semax OK_spec E Delta
+       (▷(tc_expr Delta a ∧ tc_exprlist Delta argsig bl) ∧
+           (assert_of (fun rho => func_ptr_si (mk_funspec (argsig,retsig) cc A Ef P Q) (eval_expr a rho)) ∗
+          (▷(F ∗ assert_of (fun rho => P x (ge_of rho, eval_exprlist argsig bl rho))))))
          (Scall ret a bl)
          (normal_ret_assert
-          (fun rho => (EX old:val, substopt ret (`old) F rho * maybe_retval (Q ts x) retsig ret rho))).
+          (∃ old:val, assert_of (substopt ret (`old) F) ∗ maybe_retval (assert_of (Q x)) retsig ret)).
 Proof.
-rewrite semax_unfold. intros ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? TCF TC5 TC7.
-rename argsig into clientparams. rename retsig into retty.
-intros.
-rename H into Closed; rename H0 into RGUARD.
-intros tx vx.
-intros ? ? ? ? NecR_ya' Hext [[TC3 ?] funassertDelta'].
-
-assert (NecR_wa': necR w (level a')).
-{ apply nec_nat. apply necR_level in NecR_ya'. apply Nat.le_trans with (level y); auto. }
-eapply pred_nec_hereditary in RGUARD; [ | apply NecR_wa'].
-eapply pred_nec_hereditary in Prog_OK; [ | apply NecR_wa'].
-clear w NecR_wa' NecR_ya' y H.
-rename a'' into w.
-
-assert (TC7': tc_fn_return Delta' ret retty).
-{
-  clear - TC7 TS.
-  hnf in TC7|-*. destruct ret; auto.
-  destruct ((temp_types Delta) ! i) eqn:?; try contradiction.
-  destruct TS.
-  specialize (H i); rewrite Heqo in H. subst t.
-  destruct ((temp_types Delta') ! i ).
-  destruct H; auto.
-  auto.
-} clear TC7.
-rewrite !later_andp in H0.
-apply extend_sepcon_andp in H0; auto.
-destruct H0 as [[TC1 TC2] pre].
-
-normalize in pre.
-destruct pre as [preA preB]. destruct preA as [b [EvalA funcatb]].
-destruct preB as [z1 [z2 [JZ [HF0 pre]]]].
-destruct (level w) eqn: Hl.
-{ repeat intro; lia. }
-destruct (levelS_age w n) as (w' & Hage & Hw'); auto.
-
-hnf in funcatb.
-
-destruct funcatb as [nspec [GS funcatb]]. simpl in GS.
-rename GS into SubClient.
-
-assert (Hpsi: filter_genv psi = ge_of (construct_rho (filter_genv psi) vx tx)) by reflexivity.
-remember (construct_rho (filter_genv psi) vx tx) as rho.
-
-set (args := @eval_exprlist CS clientparams bl rho).
-set (args' := @eval_exprlist CS' clientparams bl rho).
-
-assert (MYPROP: exists id fs,
-          Map.get (ge_of rho) id = Some b /\
-         (glob_specs Delta') ! id = Some fs /\ func_at fs (b, 0) w).
-{ clear - funcatb funassertDelta' SubClient JZ.
-  assert (XX: exists id:ident, (Map.get (ge_of rho) id = Some b)
-                               /\ exists fs, (glob_specs Delta')!id = Some fs).
-
-  { destruct funassertDelta' as [_ FD].
-    apply (FD b (clientparams, retty) cc _ _ (necR_refl _) (ext_refl _)); clear FD.
-    simpl. destruct nspec. hnf in funcatb. simpl in SubClient.
-    destruct SubClient as [[? ?] _]; subst.
-    eexists. apply funcatb. }
-  destruct XX as [id [Hb [fs specID]]]; simpl in Hb.
-
-  assert (exists v, Map.get (ge_of rho) id = Some v /\ func_at fs (v, 0) w).
-  { destruct funassertDelta' as [funassertDeltaA _].
-    destruct (funassertDeltaA id fs _ _ (necR_refl _) (ext_refl _) specID) as [v [Hv funcatv]]; simpl in Hv.
-    exists v; split; trivial. }
-  destruct H as [v [Hv funcatv]].
-  assert (VB: b=v); [inversion2 Hb Hv; trivial | subst; clear Hb].
-  exists id, fs; auto. }
-destruct MYPROP as [id [fs [RhoID [SpecOfID funcatv]]]].
-destruct fs as [fsig' cc' A' deltaP deltaQ NEP' NEQ'].
-
-unfold func_at in funcatv, funcatb. destruct nspec as [nsig ncc nA nP nQ nP_ne nQ_ne].
-destruct SubClient as [[NSC Hcc] ClientAdaptation]; subst cc. destruct nsig as [nparams nRetty].
-
-inversion NSC; subst nRetty nparams.
-destruct fsig' as [fArgsig fRettp].
-hnf in funcatb, funcatv.
- inversion2 funcatb funcatv.
-assert (PREPOST: (forall ts (x:dependent_type_functor_rec ts nA mpred) vl, (! |> (deltaP ts x vl <=> nP ts x vl)) w) /\
-                 (forall ts (x:dependent_type_functor_rec ts nA mpred) vl, (! |> (deltaQ ts x vl <=> nQ ts x vl)) w)).
-{ symmetry in H4. apply inj_pair2 in H4;
-  apply (function_pointer_aux); trivial. f_equal; apply H4. }
-clear H4; destruct PREPOST as [Hpre Hpost].
-simpl fst in *; simpl snd in *.
-simpl in ClientAdaptation.
-
-fold args in pre.
-set (rho := construct_rho (filter_genv psi) vx tx).
-
+  intros.
+  rewrite semax_unfold; intros.
+  rename argsig into clientparams. rename retsig into retty.
+  iIntros "#Prog_OK" (????) "[(%Closed & %HE') #rguard]".
+  iIntros (tx vx) "!>".
+  monPred.unseal; iIntros "(%TC3 & (F0 & H) & fun)".
+  assert (TC7': tc_fn_return Delta' ret retty).
+  { clear - TC7 TS.
+    hnf in TC7|-*. destruct ret; auto.
+    destruct ((temp_types Delta) !! i) eqn:?; try contradiction.
+    destruct TS as [H _].
+    specialize (H i); rewrite Heqo in H. subst t; done. }
+  assert (Hpsi: filter_genv psi = ge_of (construct_rho (filter_genv psi) vx tx)) by reflexivity.
+  remember (construct_rho (filter_genv psi) vx tx) as rho.
+  iAssert (func_ptr_si (mk_funspec (clientparams, retty) cc A Ef P Q) (eval_expr(CS := CS) a rho)) as "#funcatb".
+  { iDestruct "H" as "(_ & $ & _)". }
+  rewrite {2}(affine (func_ptr_si _ _)) left_id.
+  rewrite /func_ptr_si.
+  iDestruct "funcatb" as (b EvalA nspec) "[SubClient funcatb]".
+  destruct nspec as [nsig ncc nA nE nP nQ].
+  iIntros (? _).
+  iAssert (∃ id deltaP deltaQ, ▷(⌜Genv.find_symbol psi id = Some b ∧ ((glob_specs Delta') !! id)%maps = Some (mk_funspec nsig ncc nA nE deltaP deltaQ)⌝ ∧
+    nP ≡ deltaP ∧ nQ ≡ deltaQ)) as (id deltaP deltaQ) "#(>(%RhoID & %SpecOfID) & HeqP & HeqQ)".
+  { iDestruct "fun" as "(FA & FD)".
+    rewrite /Map.get /filter_genv.
+    iDestruct ("FD" with "[funcatb]") as %(id & ? & fs & ?).
+    { by iExists _, _, _, _. }
+    iDestruct ("FA" with "[%]") as (b0 ?) "funcatv"; first done.
+    assert (b0 = b) as -> by congruence.
+    iDestruct (func_at_agree with "funcatb funcatv") as (????????) "(#Heq & ?)".
+    repeat setoid_rewrite <- bi.later_exist.
+    iMod "Heq" as %([=] & ->); subst.
+    repeat match goal with H : existT _ _ = existT _ _ |- _ => apply inj_pair2 in H end; subst.
+    iNext; iExists _, _, _; iSplit; done. }
+  set (args := @eval_exprlist CS clientparams bl rho).
+  set (args' := @eval_exprlist CS' clientparams bl rho).
+  iDestruct "SubClient" as "[(%NSC & %Hcc) ClientAdaptation]"; subst cc. destruct nsig as [nparams nRetty].
+  inversion NSC; subst nRetty nparams; clear NSC.
+  simpl fst in *; simpl snd in *.
   assert (typecheck_environ Delta rho) as TC4.
-{ clear - TC3 TS.
-  destruct TC3 as [TC3 TC4].
-  eapply typecheck_environ_sub in TC3; [| eauto].
-  auto.
-}
-
-assert (HARGS: args = args').
-{ clear - Hage HGG TC4 TC2.
-  assert (ARGSEQ: (|> (!! (args = args'))) w). trivial.
-  { hnf; intros. specialize (TC2 _ H). subst args args'.
-    simpl. destruct HGG as [CSUB HGG].
-     apply (typecheck_exprlist_sound_cenv_sub CSUB Delta rho TC4 a'); apply TC2. }
-  eapply (ARGSEQ w'). apply age_laterR; trivial. }
-
-eapply later_derives in TC2; [|apply (tc_exprlist_sub _ _ _ TS); auto].
-eapply later_derives in TC1; [|apply (tc_expr_sub _ _ _ TS); auto].
-
-assert (LENargs: Datatypes.length clientparams = Datatypes.length args).
-{ clear - TC2 Hage. subst args.
-  apply age_laterR in Hage. simpl in TC2.
-  specialize (TC2 _ Hage). apply tc_exprlist_length in TC2.
-  clear - TC2.
-  forget clientparams as m.
-  generalize dependent m. clear. induction bl; simpl; intros.
-  destruct m; simpl. trivial. inv TC2. destruct m; inv TC2. simpl.
-  rewrite (IHbl _ H0); trivial. }
-
-simpl in ClientAdaptation.
-
-assert (HPP: (|> (F0 rho * F rho * (P ts x) (ge_of rho, args)))%pred w).
-{ clear - pre JZ HF0 HGG TC1 TC2.
-  rewrite sepcon_assoc. rewrite later_sepcon. exists z1, z2; split; trivial.
-  split; [ apply now_later |]; trivial. }
-
-simpl in EvalA. clear pre JZ HF0 z1 z2.
-rewrite later_sepcon in HPP.
-destruct HPP as [w1 [w2 [J [W1 W2]]]]; destruct (join_level _ _ _ J) as [LevW1 LevW2].
-destruct (age1_join2 _ J Hage) as [w1' [w2' [J' [Age1 Age2]]]].
-
-assert (TRIV: (forall rho, typecheck_temp_environ rho (PTree.empty type)) /\
-              (typecheck_var_environ (Map.empty (block * type)) (PTree.empty type)) /\
-              (forall rho, typecheck_glob_environ rho (PTree.empty type))).
-{ clear. split.
-  { intros; hnf; intros. rewrite PTree.gempty in H; congruence. } split.
-  { intros; hnf; intros. split; intros. rewrite PTree.gempty in H; congruence.
-    destruct H. unfold Map.empty, Map.get in H; congruence. }
-  { intros; hnf; intros. rewrite PTree.gempty in H; congruence. } }
-
-assert (TCD': tc_environ Delta' rho) by eapply TC3.
-
-assert (LA2: laterM w2 w2'). { constructor; trivial. }
-specialize (ClientAdaptation ts x (ge_of rho, args)). simpl in ClientAdaptation.
-
-specialize (ClientAdaptation w2'). spec ClientAdaptation.
-{ simpl; split.
-  + clear - TC3 LENargs TC2 W2 Hage. destruct TC3.
-    apply age_laterR in Hage. specialize (TC2 w' Hage).
-    specialize (tc_eval_exprlist _ _ _ _ _ H TC2).
-    subst args.
-    forget (construct_rho (filter_genv psi) vx tx) as lia.
-    forget  (@eval_exprlist CS clientparams bl lia) as args.
-    clear.
-    generalize dependent clientparams.
-    clear. induction args; simpl; intros.
-    - destruct clientparams; simpl in *. constructor. contradiction.
-    - destruct clientparams; simpl in *. contradiction. destruct H.
-      apply tc_val_has_type in H. apply IHargs in H0.
-      constructor; eauto.
-  + apply age_laterR in Age2. apply (W2 _ Age2). }
-    apply rmap_order in Hext as (Hl' & _ & _).
-    rewrite Hl' in *; clear dependent a'.
-assert (ARGS: app_pred (|> fupd (EX ts1 x1 G, F0 rho *
-     (F rho * G) * deltaP ts1 x1 (ge_of rho, args) && !! (forall rho' : environ,
-                            !! (ve_of rho' = Map.empty (block * type)) &&
-                            (G * nQ ts1 x1 rho') |-- (Q ts x rho')))) w).
-{ clear Hpost SpecOfID Prog_OK RhoID TC7' RGUARD funcatb. rewrite HARGS in *.
-  assert (XX: (|> (F0 rho * F rho *
-                   fupd (EX ts1 x1 G, G * deltaP ts1 x1 (ge_of rho, args) &&
-              !! (forall rho' : environ,
-                     !! (ve_of rho' = Map.empty (block * type)) &&
-                     (G * nQ ts1 x1 rho') |-- (Q ts x rho'))))) w).
-  { rewrite later_sepcon.
-    exists w1, w2; split. trivial. split. trivial. hnf; intros.
-    destruct (age_later Age2 H); [ subst a' |].
-    - assert ((ALL ts x vl, (deltaP ts x vl <=> nP ts x vl)) (level w2')) as Hpre'.
-      { intros ts1 x1 G1; apply Hpre.
-        apply join_level in J as [_ <-]; apply laterR_level'; auto. }
-      eapply fupd.subp_fupd, ClientAdaptation; try apply Hpre'; eauto.
-      apply subp_exp; intros ts1.
-      apply subp_exp; intros x1.
-      apply subp_exp; intros G.
-      apply subp_andp, subp_refl.
-      apply subp_sepcon; [apply subp_refl|].
-      rewrite HARGS. subst rho. rewrite <- Hpsi.
-      do 3 eapply allp_left. rewrite andp_comm; apply eqp_subp.
-    - apply (pred_nec_hereditary _ _ a') in ClientAdaptation.
-      assert ((ALL ts x vl, (deltaP ts x vl <=> nP ts x vl)) (level a')) as Hpre'.
-      { intros ts1 x1 G1; apply Hpre.
-        apply join_level in J as [_ <-]; apply laterR_level'; auto. }
-      eapply fupd.subp_fupd, ClientAdaptation; try apply Hpre'; eauto.
-      apply subp_exp; intros ts1.
-      apply subp_exp; intros x1.
-      apply subp_exp; intros G.
-      apply subp_andp, subp_refl.
-      apply subp_sepcon; [apply subp_refl|].
-      rewrite HARGS. subst rho. rewrite <- Hpsi.
-      do 3 eapply allp_left. rewrite andp_comm; apply eqp_subp.
-      + apply laterR_necR; trivial. }
-  rewrite <- HARGS. clear - XX. eapply later_derives, XX.
-  eapply derives_trans; [apply fupd.fupd_frame_l | apply fupd.fupd_mono].
-  apply derives_refl'.
-  rewrite !exp_sepcon2; f_equal; extensionality.
-  rewrite !exp_sepcon2; f_equal; extensionality.
-  rewrite !exp_sepcon2; f_equal; extensionality.
-  rewrite <- !sepcon_assoc.
-  rewrite !(andp_comm _ (!!_)), !sepcon_andp_prop.
-  rewrite <- !sepcon_assoc; auto. }
-simpl; unfold assert_safe'_; intros; subst.
-apply jm_fupd_intro'.
-assert (CSUBpsi:cenv_sub (@cenv_cs CS) psi).
-{ destruct HGG as [CSUB' HGG]. apply (cenv_sub_trans CSUB' HGG). }
-destruct HGG as [CSUB HGG].
-subst rho.
-rewrite (typecheck_expr_sound_cenv_sub CSUB Delta' _ TCD' w' a) in EvalA by
-    (apply (TC1 w' (age_laterR  Hage))).
-
-eapply (@semax_call_aux' CS') with (deltaP:=deltaP)(F0:=F0)(rho:=construct_rho (filter_genv psi) vx tx)(Delta := Delta')
-  (clientparams := clientparams)(retty := retty)(cc := ncc)(id := id)(b := b)(NEP' := NEP')(NEQ' := NEQ');
-  try assumption; try trivial; [.. | eassumption].
-1: { clear - TC1 CSUB; intros w W. apply (tc_expr_cenv_sub CSUB _ _ _ _ (TC1 _ W)). }
-1: { clear - Espec TC2 CSUB. intros w W. specialize (TC2 _ W).
-     apply (tc_exprlist_cenv_sub CSUB). apply TC2. }
-simpl RA_normal; auto. eapply later_derives, ARGS; apply fupd.fupd_mono.
-apply exp_derives; intros ts1; apply exp_derives; intros x1; apply exp_left; intros G.
-apply exp_right with (fun rho => F rho * G).
-rewrite HARGS; apply andp_derives; auto.
-intros ? HG2.
-clear - TRIV TC7' HG2.
-intros rho' u U ? m NEC Hext [v V].
-apply fupd.fupd_intro.
-hnf in TC7'.
-rewrite <- exp_sepcon1.
-destruct ret.
-- remember ((temp_types Delta') ! i) as rr; destruct rr; try contradiction; subst t.
-  simpl in V. destruct V as [m1 [m2 [JM [[u1 [u2 [JU [U1 U2]]]] M2]]]].
-  destruct (join_assoc JU JM) as [q1 [Q2 Q1]].
-  exists u1, q1; split; trivial. split. unfold subst. exists v; apply U1.
-  hnf in HG2. specialize (HG2 (get_result1 i rho') q1). destruct M2.
-  spec HG2. {
-    simpl. split; trivial. exists u2, m2; auto. }
-  simpl; auto.
-(*  rewrite prop_true_andp; auto.*)
-- destruct V as [m1 [m2 [JM [[u1 [u2 [JU [U1 U2]]]] M2]]]].
-  destruct (join_assoc JU JM) as [q1 [Q2 Q1]]. simpl in M2.
-  exists u1, q1; split; trivial. split. exists v; apply U1.
-  hnf in HG2. destruct retty; try solve [destruct M2 as [za [TCv M2]];
-    exists za; split; auto;
-    eapply HG2;
-    simpl; split; auto; exists u2, m2; auto].
-  + apply HG2. simpl. split. hnf; simpl; intuition. exists u2, m2; auto.
-Qed.
-
-Lemma semax_call_si {CS Espec}:
-  forall Delta (A: TypeTree)
-  (P : forall ts, dependent_type_functor_rec ts (ArgsTT A) mpred)
-  (Q : forall ts, dependent_type_functor_rec ts (AssertTT A) mpred)
-  (NEP: args_super_non_expansive P) (NEQ: super_non_expansive Q)
-  (ts: list Type) (x : dependent_type_functor_rec ts A mpred)
-   F ret argsig retsig cc a bl,
-           Cop.classify_fun (typeof a) =
-           Cop.fun_case_f argsig retsig cc ->
-            (retsig = Tvoid -> ret = None) ->
-          tc_fn_return Delta ret retsig ->
-  @semax CS Espec Delta
-       (fun rho => (|>(tc_expr Delta a rho && tc_exprlist Delta argsig bl rho))  &&
-           (func_ptr_si (mk_funspec (argsig,retsig) cc A P Q NEP NEQ) (eval_expr a rho) &&
-          (|>(F rho * P ts x (ge_of rho, eval_exprlist argsig bl rho)))))
+  { clear - TC3 TS.
+    destruct TC3 as [TC3 TC4].
+    eapply typecheck_environ_sub in TC3; [| eauto].
+    auto. }
+  rewrite (add_and (_ ∧ ▷ _) (▷_)); last by iIntros "H"; iNext; iDestruct "H" as "((_ & H) & _)"; destruct HGG; iApply (typecheck_exprlist_sound_cenv_sub with "H").
+  iDestruct "H" as "(H & >%HARGS)".
+  fold args in HARGS; fold args' in HARGS.
+  setoid_rewrite tc_exprlist_sub; [|done..]. setoid_rewrite tc_expr_sub; [|done..].
+  rewrite (add_and (_ ∧ ▷ _) (▷_)); last by iIntros "H"; iNext; iDestruct "H" as "((_ & H) & _)"; destruct HGG; iApply (tc_exprlist_length with "H").
+  iDestruct "H" as "(H & >%LENbl)".
+  assert (LENargs: Datatypes.length clientparams = Datatypes.length args).
+  { rewrite LENbl eval_exprlist_length //. }
+  assert (TCD': tc_environ Delta' rho) by eapply TC3.
+  rewrite (add_and (_ ∧ ▷ _) (▷_)); last by iIntros "H"; iNext; iDestruct "H" as "((_ & H) & _)"; iApply (tc_eval_exprlist with "H").
+  iDestruct "H" as "(H & >%TCargs)"; fold args in TCargs.
+  iSpecialize ("ClientAdaptation" $! x (ge_of rho, args)).
+  rewrite (bi.pure_True (argsHaveTyps _ _)).
+  2: { clear -TCargs. clearbody args. generalize dependent clientparams.
+       induction args; intros.
+       - destruct clientparams; simpl in *. constructor. contradiction.
+       - destruct clientparams; simpl in *. contradiction. destruct TCargs.
+         apply tc_val_has_type in H; simpl. apply IHargs in H0.
+         constructor; eauto. }
+  rewrite bi.True_and.
+  assert (CSUBpsi:cenv_sub (@cenv_cs CS) psi).
+  { destruct HGG as [CSUB' HGG]. apply (cenv_sub_trans CSUB' HGG). }
+  destruct HGG as [CSUB HGG].
+  rewrite (add_and (_ ∧ ▷ _) (▷_)); last by iIntros "H"; iNext; iDestruct "H" as "((H & _) & _)"; iApply (typecheck_expr_sound_cenv_sub with "H").
+  iDestruct "H" as "(H & >%Heval_eq)"; rewrite Heval_eq in EvalA.
+  subst rho; iApply (@semax_call_aux CS' _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ (normal_ret_assert
+                   (∃ old : val, assert_of (substopt ret (` old) (monPred_at F)) ∗
+                      maybe_retval (assert_of (Q x)) retty ret)) with "Prog_OK [F0 H] [fun] [] [rguard]"); try eassumption; try reflexivity;
+    [| by monPred.unseal | | by repeat monPred.unseal].
+  - iCombine "F0 H" as "H"; rewrite bi.sep_and_l; iSplit.
+    + rewrite bi.later_and; iDestruct "H" as "[(_ & ?) _]".
+      rewrite tc_exprlist_cenv_sub // tc_expr_cenv_sub //.
+    + iNext; iDestruct "H" as "[_ $]".
+  - iClear "funcatb". iIntros "!> !> !>".
+    iIntros "(F & P)".
+    iMod (fupd_mask_subseteq (Ef x)) as "Hmask"; first by set_solver.
+    iMod ("ClientAdaptation" with "P") as (???) "[H #post]".
+    iMod "Hmask" as "_".
+    rewrite !ofe_morO_equivI /=.
+    iSpecialize ("HeqP" $! x1); iSpecialize ("HeqQ" $! x1).
+    rewrite !discrete_fun_equivI.
+    iSpecialize ("HeqP" $! (filter_genv psi, args)); iRewrite "HeqP" in "H".
+    iExists x1, (F ∗ ⎡F1⎤); iIntros "!>"; monPred.unseal; iSplit; first by (iPureIntro; set_solver).
+    iSplit; first by iDestruct "H" as "($ & $)".
+    iIntros (?) "!> (% & F & nQ)"; simpl.
+    destruct ret; simpl.
+    + iExists old; iDestruct "F" as "($ & F1)".
+      iSpecialize ("HeqQ" $! (get_result1 i rho')); iRewrite -"HeqQ" in "nQ".
+      iDestruct "nQ" as "($ & nQ)"; iApply "post"; iFrame; by iPureIntro.
+    + iExists Vundef; iDestruct "F" as "($ & F1)".
+      destruct (type_eq retty Tvoid); subst.
+      * iSpecialize ("HeqQ" $! (globals_only rho')); iRewrite -"HeqQ" in "nQ".
+        iApply "post"; iFrame; by iPureIntro.
+      * destruct retty; first contradiction; iDestruct "nQ" as (v ?) "nQ";
+          iSpecialize ("HeqQ" $! (env_set (globals_only rho') ret_temp v)); iRewrite -"HeqQ" in "nQ";
+          iExists v; (iSplit; [by iPureIntro|]; iApply "post"; iFrame; by iPureIntro).
+Qed.
+
+Definition semax_call_alt := semax_call_si.
+
+(* We need the explicit frame because it might contain typechecking information. *)
+Lemma semax_call:
+  forall E Delta (A: TypeTree) (Ef : dtfr (MaskTT A))
+  (P : dtfr (ArgsTT A))
+  (Q : dtfr (AssertTT A))
+  (x : dtfr A)
+  F ret argsig retsig cc a bl
+  (Hsub : Ef x ⊆ E)
+  (TCF : Cop.classify_fun (typeof a) = Cop.fun_case_f argsig retsig cc)
+  (TC5 : retsig = Tvoid -> ret = None)
+  (TC7 : tc_fn_return Delta ret retsig),
+  semax OK_spec E Delta
+       ((▷(tc_expr Delta a ∧ tc_exprlist Delta argsig bl))  ∧
+           (assert_of (fun rho => func_ptr (mk_funspec (argsig,retsig) cc A Ef P Q) (eval_expr a rho)) ∗
+          (▷(F ∗ assert_of (fun rho => P x (ge_of rho, eval_exprlist argsig bl rho))))))
          (Scall ret a bl)
          (normal_ret_assert
-          (fun rho => (EX old:val, substopt ret (`old) F rho * maybe_retval (Q ts x) retsig ret rho))).
+          (∃ old:val, assert_of (substopt ret (`old) F) ∗ maybe_retval (assert_of (Q x)) retsig ret)).
 Proof.
-rewrite semax_unfold. intros ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? TCF TC5 TC7.
-rename argsig into clientparams. rename retsig into retty.
-intros.
-rename H into Closed; rename H0 into RGUARD.
-intros tx vx.
-intros ? ? ? ? NecR_ya' Hext [[TC3 ?] funassertDelta'].
-
-assert (NecR_wa': necR w (level a')).
-{ apply nec_nat. apply necR_level in NecR_ya'. apply Nat.le_trans with (level y); auto. }
-eapply pred_nec_hereditary in RGUARD; [ | apply NecR_wa'].
-eapply pred_nec_hereditary in Prog_OK; [ | apply NecR_wa'].
-clear w NecR_wa' NecR_ya' y H.
-rename a'' into w.
-
-assert (TC7': tc_fn_return Delta' ret retty).
-{
-  clear - TC7 TS.
-  hnf in TC7|-*. destruct ret; auto.
-  destruct ((temp_types Delta) ! i) eqn:?; try contradiction.
-  destruct TS.
-  specialize (H i); rewrite Heqo in H. subst t.
-  destruct ((temp_types Delta') ! i ).
-  destruct H; auto.
-  auto.
-} clear TC7.
-rewrite !later_andp in H0.
-apply extend_sepcon_andp in H0; auto.
-destruct H0 as [[TC1 TC2] pre].
-
-normalize in pre.
-destruct pre as [preA preB]. destruct preA as [b [EvalA funcatb]].
-destruct preB as [z1 [z2 [JZ [HF0 pre]]]].
-destruct (level w) eqn: Hl.
-{ repeat intro; lia. }
-destruct (levelS_age w n) as (w' & Hage & Hw'); auto.
-
-hnf in funcatb.
-
-destruct funcatb as [nspec [GS funcatb]].
-simpl in GS; rename GS into SubClient.
-
-assert (Hpsi: filter_genv psi = ge_of (construct_rho (filter_genv psi) vx tx)) by reflexivity.
-unfold filter_genv in Hpsi.
-remember (construct_rho (filter_genv psi) vx tx) as rho.
-
-set (args := @eval_exprlist CS clientparams bl rho).
-set (args' := @eval_exprlist CS' clientparams bl rho).
-
-assert (MYPROP: exists id fs,
-         Map.get (ge_of rho) id = Some b /\
-         (glob_specs Delta') ! id = Some fs /\ func_at fs (b, 0) w).
-{ clear - funcatb funassertDelta' SubClient JZ.
-  assert (XX: exists id:ident, (Map.get (ge_of rho) id = Some b)
-                               /\ exists fs, (glob_specs Delta')!id = Some fs).
-
-  { destruct funassertDelta' as [_ FD].
-    apply (FD b (clientparams, retty) cc _ _ (necR_refl _) (ext_refl _)); clear FD.
-    simpl. destruct nspec. destruct SubClient as [[FSM Hcc] _]. subst t c.
-    eexists; trivial. apply funcatb. }
-  destruct XX as [id [Hb [fs specID]]]; simpl in Hb.
-
-  assert (exists v, Map.get (ge_of rho) id = Some v /\ func_at fs (v, 0) w).
-  { destruct funassertDelta' as [funassertDeltaA _].
-    destruct (funassertDeltaA id fs _ _ (necR_refl _) (ext_refl _) specID) as [v [ Hv funcatv]]; simpl in Hv.
-    exists v; split; trivial. }
-  destruct H as [v [Hv funcatv]].
-  assert (VB: b=v); [inversion2 Hb Hv; trivial | subst; clear Hb].
-  exists id, fs; auto. }
-destruct MYPROP as [id [fs [RhoID [SpecOfID funcatv]]]].
-destruct fs as [fsig' cc' A' deltaP deltaQ NEP' NEQ'].
-
-unfold func_at in funcatv, funcatb. destruct nspec as [nsig ncc nA nP nQ nP_ne nQ_ne].
-
-destruct SubClient as [[NSC Hcc] ClientAdaptation]; subst cc. destruct nsig as [nparams nRetty].
-inversion NSC. subst nparams nRetty.
-destruct fsig' as [fArgsig fRettp].
-hnf in funcatb, funcatv.
- inversion2 funcatb funcatv.
-assert (PREPOST: (forall ts (x:dependent_type_functor_rec ts nA mpred) vl, (! |> (deltaP ts x vl <=> nP ts x vl)) w) /\
-                 (forall ts (x:dependent_type_functor_rec ts nA mpred) vl, (! |> (deltaQ ts x vl <=> nQ ts x vl)) w)).
-{ symmetry in H4. apply inj_pair2 in H4;
-  apply (function_pointer_aux); trivial. f_equal; apply H4. }
-clear H4; destruct PREPOST as [Hpre Hpost].
-simpl fst in *; simpl snd in *.
-
-fold args in pre.
-set (rho:= construct_rho (filter_genv psi) vx tx).
-
-assert (typecheck_environ Delta rho) as TC4.
-{ clear - TC3 TS.
-  destruct TC3 as [TC3 TC4].
-  eapply typecheck_environ_sub in TC3; [| eauto].
-  auto.
-}
-
-assert (HARGS: args = args').
-{ clear - Hage HGG TC4 TC2.
-  assert (ARGSEQ: (|> (!! (args = args'))) w).
-  { hnf; intros. specialize (TC2 _ H). subst args args'.
-    simpl. destruct HGG as [CSUB HGG].
-    apply (typecheck_exprlist_sound_cenv_sub CSUB Delta rho TC4 a'). apply TC2. }
-  eapply (ARGSEQ w'). apply age_laterR; trivial. }
-
-eapply later_derives in TC2; [|apply (tc_exprlist_sub _ _ _ TS); auto].
-eapply later_derives in TC1; [|apply (tc_expr_sub _ _ _ TS); auto].
-
-assert (LENargs: Datatypes.length clientparams = Datatypes.length args).
-{ clear - TC2 Hage. subst args.
-  apply age_laterR in Hage. simpl in TC2.
-  specialize (TC2 _ Hage). apply tc_exprlist_length in TC2.
-  clear - TC2.
-  forget clientparams as m.
-  generalize dependent m. clear. induction bl; simpl; intros.
-  destruct m; simpl. trivial. inv TC2. destruct m; inv TC2. simpl.
-  rewrite (IHbl _ H0); trivial. }
-
-assert (TCD': tc_environ Delta' rho) by eapply TC3.
-
-assert (HPP: (|> (F0 rho * F rho * (P ts x) (ge_of rho, args)))%pred w).
-{ clear - pre JZ HF0 HGG TC1 TC2.
-  rewrite sepcon_assoc. rewrite later_sepcon. exists z1, z2; split; trivial.
-  split; [ apply now_later |]; trivial. }
-
-simpl in EvalA. clear pre JZ HF0 z1 z2.
-rewrite later_sepcon in HPP.
-destruct HPP as [w1 [w2 [J [W1 W2]]]]; destruct (join_level _ _ _ J) as [LevW1 LevW2].
-destruct (age1_join2 _ J Hage) as [w1' [w2' [J' [Age1 Age2]]]]; destruct (join_level _ _ _ J') as [Lw1' Lw2'].
-
-assert (LA2: laterM w2 w2'). { constructor; trivial. }
-specialize (ClientAdaptation _ (age_laterR Hage) ts). hnf in ClientAdaptation.
-fold (@dependent_type_functor_rec ts) in *.
-specialize (W2 _ LA2).
-
-specialize (ClientAdaptation x (ge_of rho, args)). hnf in ClientAdaptation.
-assert (LW2': (level w' >= level w2')%nat). { apply age_level in Age2. destruct (join_level _ _ _ J); lia. }
-specialize (ClientAdaptation _ LW2' _ _ (necR_refl _) (ext_refl _)). spec ClientAdaptation.
-{ split; trivial. simpl.
-  clear - TC3 LENargs TC2 Hage. destruct TC3.
-  apply age_laterR in Hage. specialize (TC2 w' Hage).
-  specialize (tc_eval_exprlist _ _ _ _ _ H TC2).
-  subst args.
-  forget (construct_rho (filter_genv psi) vx tx) as lia.
-  forget  (@eval_exprlist CS clientparams bl lia) as args.
-  clear.
-  generalize dependent clientparams.
-  clear. induction args; simpl; intros.
-  - destruct clientparams; simpl in *. constructor. contradiction.
-  - destruct clientparams; simpl in *. contradiction. destruct H.
-    apply tc_val_has_type in H. apply IHargs in H0.
-    constructor; eauto. }
-apply rmap_order in Hext as (Hl' & _ & _).
-rewrite Hl' in *; clear dependent a'.
-assert (ArgsW: app_pred (|> fupd (EX ts1 x1 G, F0 rho * (F rho * G) *
-               deltaP ts1 x1 (ge_of rho, args) && (ALL rho' : environ,
-         ! (!! (ve_of rho' = Map.empty (block * type)) && (G * nQ ts1 x1 rho') >=> (Q ts x rho'))))) w).
-{ clear Hpost funcatb SpecOfID Prog_OK RhoID TC7' RGUARD. rewrite HARGS in *.
-  assert (XX: (|> (F0 rho * F rho * fupd (EX ts1 x1 G, G * deltaP ts1 x1 (ge_of rho, args) && (ALL rho' : environ,
-         ! (!! (ve_of rho' = Map.empty (block * type)) && (G * nQ ts1 x1 rho') >=> (Q ts x rho')))))) w).
-  { rewrite later_sepcon.
-    exists w1, w2; split. trivial. split. trivial. hnf; intros. specialize (age_later_nec _ _ _ Age2 H). intros.
-    apply (pred_nec_hereditary _ _ a') in ClientAdaptation; auto.
-    assert ((ALL ts x vl, (deltaP ts x vl <=> nP ts x vl)) (level a')) as Hpre'.
-    { intros ts1 x1 G1; apply Hpre.
-      apply join_level in J as [_ <-]; apply laterR_level'; auto. }
-    eapply fupd.subp_fupd, ClientAdaptation; try apply Hpre'; eauto.
-    apply subp_exp; intros ts1.
-    apply subp_exp; intros x1.
-    apply subp_exp; intros G.
-    apply subp_andp, subp_refl.
-    apply subp_sepcon; [apply subp_refl|].
-    rewrite HARGS. do 3 eapply allp_left. rewrite andp_comm; apply eqp_subp. }
-  rewrite <- HARGS. clear - XX. eapply later_derives, XX.
-  eapply derives_trans; [apply fupd.fupd_frame_l | apply fupd.fupd_mono].
-  apply derives_refl'.
-  rewrite !exp_sepcon2; f_equal; extensionality.
-  rewrite !exp_sepcon2; f_equal; extensionality.
-  rewrite !exp_sepcon2; f_equal; extensionality.
-  rewrite !(andp_comm _ (allp _)), <- !unfash_allp', !sepcon_andp_unfash.
-  rewrite <- !sepcon_assoc; auto. }
-apply now_later in RGUARD.
-intros ??????; subst. apply jm_fupd_intro'.
-rename H into ORA.
-
-assert (CSUBpsi:cenv_sub (@cenv_cs CS) psi).
-{ destruct HGG as [CSUB' HGG]. apply (cenv_sub_trans CSUB' HGG). }
-destruct HGG as [CSUB HGG].
-
-subst rho.
-rewrite (typecheck_expr_sound_cenv_sub CSUB Delta' _ TCD' w' a) in EvalA by
-    (apply (TC1 w' (age_laterR  Hage))).
-
-eapply (@semax_call_aux CS') with (deltaP:=deltaP) (F0:=F0) (rho:=construct_rho (filter_genv psi) vx tx); try eassumption; try trivial.
-{ clear - TC1 CSUB; intros w W. apply (tc_expr_cenv_sub CSUB _ _ _ _ (TC1 _ W)). }
-{ clear - Espec TC2 CSUB. intros w W. specialize (TC2 _ W).
-  apply (tc_exprlist_cenv_sub CSUB). apply TC2. }
-simpl RA_normal; auto.
-eapply later_derives, ArgsW; apply fupd.fupd_mono.
-apply exp_left; intros ts1; apply exp_left; intros x1; apply exp_left; intros G; apply exp_right with ts1; apply exp_right with x1.
-apply exp_right with (fun rho => F rho * G).
-apply andp_derives; auto.
-intros ? HG2.
-intros rho' l L y Y ? z YZ EZ [v Z].
-rewrite <- exp_sepcon1; apply fupd.fupd_frame_l.
-assert (TRIV: (forall rho, typecheck_temp_environ rho (PTree.empty type)) /\
-              (typecheck_var_environ (Map.empty (block * type)) (PTree.empty type)) /\
-              (forall rho, typecheck_glob_environ rho (PTree.empty type))).
-{ clear. split.
-  { intros; hnf; intros. rewrite PTree.gempty in H; congruence. } split.
-  { intros; hnf; intros. split; intros. rewrite PTree.gempty in H; congruence.
-    destruct H. unfold Map.empty, Map.get in H; congruence. }
-  { intros; hnf; intros. rewrite PTree.gempty in H; congruence. } }
-assert (LEV2': (level a0 >= level a0)%nat) by lia.
-assert (LEVz: (level a0 >= level z)%nat).
-{ apply necR_level in YZ.
-  apply laterR_level in L; apply ext_level in EZ; lia. }
-destruct ret.
-- destruct Z as [z1 [z2 [JZ [Z1 Z2]]]]; destruct (join_level _ _ _ JZ) as
-      [Levz1 Levz2]. simpl in Z1, Z2.
-  destruct Z1 as [z1_1 [z1_2 [JZ1 [Z11 Z12]]]]; destruct (join_level _ _ _ JZ1) as
-      [Levz11 Levz12].
-  destruct (join_assoc JZ1 JZ) as [y11 [JY1 JY2]]; destruct (join_level _ _ _ JY2) as
-      [_ Levy11].
-  assert (LL: (level a0 >= level y11)%nat) by lia.
-  exists z1_1, y11; split; trivial. split; [exists v; trivial|].
-  specialize (HG2 (get_result1 i rho') _ LL _ _ (necR_refl _) (ext_refl _)). destruct Z2 as [Z21 Z22].
-  spec HG2. {
-    simpl. split; trivial. exists z1_2, z2; auto. }
-  eapply fupd.fupd_intro; simpl; auto.
-- destruct Z as [z1 [z2 [JZ [Z1 Z2]]]];
-    destruct (join_level _ _ _ JZ) as [Levz1 Levz2]. simpl in Z1, Z2.
-  destruct Z1 as [z1_1 [z1_2 [JZ1 [Z11 Z12]]]]; destruct (join_level _ _ _ JZ1) as
-      [Levz11 Levz12].
-  destruct (join_assoc JZ1 JZ) as [y11 [JY1 JY2]]; destruct (join_level _ _ _ JY2) as
-      [_ Levy11]. assert (LL: (level a0 >= level y11)%nat) by lia.
-  exists z1_1, y11; split; trivial. split; [exists v; trivial|].
-  apply fupd.fupd_intro.
-  destruct (type_eq retty Tvoid).
-  + subst retty.
-    apply (HG2 (globals_only rho') _ LL _ _ (necR_refl _) (ext_refl _)).
-    simpl; split. hnf; simpl; intuition.
-    exists z1_2, z2; auto.
-  + assert (Z22: ((fun rho : environ =>
-                     EX v : val, !! tc_val' retty v && nQ ts1 x1
-                                    (env_set (globals_only rho) ret_temp v)) rho') z2).
-    { destruct retty; trivial. congruence. }
-    clear Z2; destruct Z22 as [vv [Z21 Z2]]. simpl in Z21.
-    specialize (HG2 (env_set (globals_only rho') ret_temp vv) _ LL _ _ (necR_refl _) (ext_refl _)).
-    spec HG2. {
-      simpl; split. hnf; simpl; intuition. exists z1_2, z2; auto. }
-    destruct retty; try solve [congruence]; exists vv; split; trivial.
+  intros.
+  eapply semax_pre, semax_call_si; [|done..].
+  split => rho.
+  monPred.unseal; rewrite bi.and_elim_r func_ptr_fun_ptr_si //.
 Qed.
 
-Lemma semax_call_alt {CS Espec}:
- forall Delta (A: TypeTree)
-   (P: forall ts, dependent_type_functor_rec ts (ArgsTT A) mpred)
-   (Q : forall ts, dependent_type_functor_rec ts (AssertTT A) mpred)
-   (NEP: args_super_non_expansive P) (NEQ: super_non_expansive Q)
-     ts x F ret argsig retsig cc a bl,
-           Cop.classify_fun (typeof a) =
-           Cop.fun_case_f argsig retsig cc ->
-            (retsig = Tvoid -> ret = None) ->
-          tc_fn_return Delta ret retsig ->
-  @semax CS Espec Delta
-       (fun rho => (|> (tc_expr Delta a rho && tc_exprlist Delta argsig bl rho))  &&
-           (func_ptr_si (mk_funspec (argsig,retsig) cc A P Q NEP NEQ) (eval_expr a rho) &&
-          (|>(F rho * P ts x (ge_of rho, eval_exprlist argsig bl rho)))))
-         (Scall ret a bl)
-         (normal_ret_assert
-          (fun rho => (EX old:val, substopt ret (`old) F rho * maybe_retval (Q ts x) retsig ret rho))).
-Proof. exact semax_call_si. Qed.
-
-(*Lemma semax_call_ext {CS Espec}:
+(*Lemma semax_call_ext {CS OK_spec}:
    forall (IF_ONLY: False),
      forall Delta P Q ret a tl bl a' bl',
       typeof a = typeof a' ->
       map typeof bl = map typeof bl' ->
       (forall rho,
-          !! (typecheck_environ Delta rho) && P rho |--
-            tc_expr Delta a rho && tc_exprlist Delta tl bl rho &&
-            tc_expr Delta a' rho && tc_exprlist Delta tl bl' rho &&
-            !! (eval_expr a rho = eval_expr a' rho /\
+          ⌜ (typecheck_environ Delta rho) ∧ P rho ⊢
+            tc_expr Delta a rho ∧ tc_exprlist Delta tl bl rho ∧
+            tc_expr Delta a' rho ∧ tc_exprlist Delta tl bl' rho ∧
+            ⌜ (eval_expr a rho = eval_expr a' rho /\
                 eval_exprlist tl bl rho = eval_exprlist tl bl' rho)) ->
-  semax Espec Delta P (Scall ret a bl) Q ->
-  @semax CS Espec Delta P (Scall ret a' bl') Q.
+  semax OK_spec Delta P (Scall ret a bl) Q ->
+  @semax CS OK_spec Delta P (Scall ret a' bl') Q.
 Proof.
 intros until 2. intro Hbl. intros.
 rewrite semax_unfold in H1|-*.
@@ -3601,167 +1518,98 @@ destruct H25 as [H25 | H25]; inv H25.
 Qed.*)
 
 Definition cast_expropt {CS} (e: option expr) t : environ -> option val :=
- match e with Some e' => `Some (@eval_expr CS (Ecast e' t))  | None => `None end.
+ match e with Some e' => `Some (eval_expr(CS := CS) (Ecast e' t))  | None => `None end.
 
-Definition tc_expropt {CS} Delta (e: option expr) (t: type) : environ -> mpred :=
-   match e with None => `!!(t=Tvoid)
-                     | Some e' => @denote_tc_assert CS (typecheck_expr Delta (Ecast e' t))
-   end.
-
-Lemma tc_expropt_char {CS} Delta e t: @tc_expropt CS Delta e t =
-                                      match e with None => `!!(t=Tvoid)
-                                              | Some e' => @tc_expr CS Delta (Ecast e' t)
+Lemma tc_expropt_char {CS'} Delta e t: tc_expropt (CS := CS') Delta e t =
+                                      match e with None => ⌜t=Tvoid⌝
+                                              | Some e' => tc_expr(CS := CS') Delta (Ecast e' t)
                                       end.
 Proof. reflexivity. Qed.
 
-Lemma RA_return_castexpropt_cenv_sub {CS CS'} (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS')) Delta rho (D:typecheck_environ Delta rho) ret t:
-  @tc_expropt CS Delta ret t rho |-- !!(@cast_expropt CS ret t rho = @cast_expropt CS' ret t rho).
+Lemma RA_return_castexpropt_cenv_sub {CS'} (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS')) Delta rho (D:typecheck_environ Delta rho) ret t:
+  tc_expropt (CS := CS) Delta ret t rho ⊢ ⌜@cast_expropt CS ret t rho = @cast_expropt CS' ret t rho⌝.
 Proof.
-  intros w W. simpl. unfold tc_expropt in W. destruct ret.
-  + simpl in W. simpl.
-    unfold force_val1, liftx, lift; simpl. rewrite denote_tc_assert_andp in W. destruct W.
-    rewrite <- (typecheck_expr_sound_cenv_sub CSUB Delta rho D w); trivial.
-  + simpl in W; subst. simpl; trivial.
+  rewrite /tc_expropt /tc_expr; destruct ret; simpl.
+  + unfold_lift. rewrite /typecheck_expr; fold typecheck_expr.
+    rewrite denote_tc_assert_andp (typecheck_expr_sound_cenv_sub CSUB) //.
+    iIntros "(-> & _)"; done.
+  + iIntros; iPureIntro; done.
 Qed.
 
-Lemma tc_expropt_cenv_sub {CS CS'} (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS')) Delta rho (D:typecheck_environ Delta rho) ret t:
-  @tc_expropt CS Delta ret t rho |-- @tc_expropt CS' Delta ret t rho.
+Lemma tc_expropt_cenv_sub {CS'} (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS')) Delta rho (D:typecheck_environ Delta rho) ret t:
+  tc_expropt (CS := CS) Delta ret t rho ⊢ tc_expropt (CS := CS') Delta ret t rho.
 Proof.
-  intros w W. simpl. rewrite  tc_expropt_char in W; rewrite tc_expropt_char.
-  specialize (tc_expr_cenv_sub CSUB); intros.
+  rewrite !tc_expropt_char.
+  pose proof (tc_expr_cenv_sub CSUB).
   destruct ret; trivial; auto.
 Qed.
 
-Lemma tc_expropt_cspecs_sub {CS CS'} (CSUB: cspecs_sub CS CS') Delta rho (D:typecheck_environ Delta rho) ret t:
-  @tc_expropt CS Delta ret t rho |-- @tc_expropt CS' Delta ret t rho.
+Lemma tc_expropt_cspecs_sub {CS'} (CSUB: cspecs_sub CS CS') Delta rho (D:typecheck_environ Delta rho) ret t:
+  tc_expropt (CS := CS) Delta ret t rho ⊢ tc_expropt (CS := CS') Delta ret t rho.
 Proof.
   destruct CSUB as [CSUB _].
-  apply (@tc_expropt_cenv_sub _ _ CSUB _ _ D).
+  apply tc_expropt_cenv_sub; done.
 Qed.
 
-Lemma tc_expropt_sub {CS} Delta Delta' rho (TS:tycontext_sub Delta Delta') (D:typecheck_environ Delta rho) ret t:
-  @tc_expropt CS Delta ret t rho |-- @tc_expropt CS Delta' ret t rho.
+Lemma tc_expropt_sub {CS'} Delta Delta' rho (TS:tycontext_sub Delta Delta') (D:typecheck_environ Delta rho) ret t:
+  tc_expropt (CS := CS') Delta ret t rho ⊢ tc_expropt (CS := CS') Delta' ret t rho.
 Proof.
-  intros w W. rewrite  tc_expropt_char in W; rewrite tc_expropt_char.
+  rewrite !tc_expropt_char.
   specialize (tc_expr_sub _ _ _ TS); intros.
   destruct ret; [ eapply H; assumption | trivial].
 Qed.
 
-(*Lemma val_casted_sem_cast : forall v t1 t2, val_casted (force_val (sem_cast t1 t2 v)) t2.
-Proof.
-  intros; unfold sem_cast.
-  destruct (classify_cast t1 t2) eqn: Hclass; simpl; auto.
-25: { Search val_casted *)
-
-Lemma  semax_return {CS Espec}:
-   forall Delta R ret,
-      @semax CS Espec Delta
-                (fun rho => tc_expropt Delta ret (ret_type Delta) rho &&
-                             RA_return R (cast_expropt ret (ret_type Delta) rho) rho)
+Lemma semax_return:
+   forall E Delta R ret,
+      semax OK_spec E Delta
+                (tc_expropt Delta ret (ret_type Delta) ∧
+                             assert_of (`(RA_return R : option val -> environ -> mpred) (cast_expropt ret (ret_type Delta)) (@id environ)))
                 (Sreturn ret)
                 R.
 Proof.
   intros.
-  hnf; intros.
-  rewrite semax_fold_unfold.
-  intros psi Delta' CS'.
-  apply prop_imp_i. intros [TS [CSUB HGG]].
+  rewrite semax_unfold; intros.
+  destruct HGG as [CSUB HGG].
   replace (ret_type Delta) with (ret_type Delta')
     by (destruct TS as [_ [_ [? _]]]; auto).
-  apply derives_imp.
-  clear n.
-  intros w ? k F f.
-  intros ? w' ? Hext H1.
-  clear H.
-  clear w H0.
-  rename w' into w.
-  destruct H1.
-  do 3 red in H.
-  intros te ve.
-  intros n ? ? w' ? Hext' ?.
-  assert (necR w (level w')) as H4.
-  {
-    apply nec_nat.
-    apply necR_level in H2.
-    apply Nat.le_trans with (level n); auto.
-    apply ext_level in Hext' as <-; auto.
-  }
-  apply (pred_nec_hereditary _ _ _ H4) in H0.
-  clear w n Hext H2 H1 H4.
-  destruct H3 as [[H3 ?] ?].
-  pose proof I.
-  remember ((construct_rho (filter_genv psi) ve te)) as rho.
-  assert (H1': ((F rho * proj_ret_assert R EK_return (cast_expropt ret (ret_type Delta') rho) rho))%pred w').
-  {
-    eapply sepcon_derives; try apply H1; auto.
-    intros w [W1 W2]. simpl in H3; destruct H3 as [TCD' _].
-    assert (TCD: typecheck_environ Delta rho) by (eapply typecheck_environ_sub; eauto).
-    apply (tc_expropt_sub _ _ _ TS) in W1; trivial.
-    rewrite <- (RA_return_castexpropt_cenv_sub CSUB Delta' rho TCD' _ _ _ W1); trivial.
-  }
-  assert (TC: (tc_expropt Delta ret (ret_type Delta') rho) w').
-  {
-    simpl in H3; destruct H3 as [TCD' _].
-    clear - H1 TCD' TS CSUB Espec.
-    assert (TCD: typecheck_environ Delta rho) by (eapply typecheck_environ_sub; eauto); clear TS.
-    destruct H1 as [w1 [w2 [? [? [? ?]]]]].
-    apply (tc_expropt_cenv_sub CSUB) in H1; trivial.
-    rewrite tc_expropt_char; rewrite tc_expropt_char in H1. destruct ret; [ |trivial].
-    apply (boxy_e _ _ (extend_tc_expr _ _ _) w2); auto.
-    exists w1; auto.
-  }
-  clear H1; rename H1' into H1.
-  specialize (H0 EK_return (cast_expropt ret (ret_type Delta') rho) te ve).
-  specialize (H0 _ (Nat.le_refl _) _ _ (necR_refl _) (ext_refl _)).
-  spec H0.
-  {
-    rewrite <- Heqrho.
-    rewrite proj_frame_ret_assert.
-    split; auto.
-    split; auto.
-    rewrite seplog.sepcon_comm; auto.
-  }
-  unfold tc_expropt in TC; destruct ret; simpl in TC.
-  + intros ?? Hora ??.
-    rename H0 into Hsafe.
-    specialize (Hsafe ora jm Hora (eq_refl _) H6).
-    intros. subst w'.
-    specialize (Hsafe LW e (eval_expr e rho)).
-    destruct H3 as [H3a [H3b H3c]].
-    rewrite H3c in Hsafe,TC.
-    rewrite denote_tc_assert_andp in TC; destruct TC as [?TC ?TC].
-    spec Hsafe.
-    eapply eval_expr_relate; eauto.
-    eapply tc_expr_sub; try eassumption.
-    eapply typecheck_environ_sub; try eassumption.
-    spec Hsafe. {
-    rewrite cop2_sem_cast'; auto.
-    2:{ eapply typecheck_expr_sound; eauto.
-    eapply tc_expr_sub; try eassumption.
-    eapply typecheck_environ_sub; try eassumption.
-    }
-    eapply cast_exists; eauto.
-    eapply tc_expr_sub; try eassumption.
-    eapply typecheck_environ_sub; try eassumption.
-   }
-    clear - Hsafe.
-    apply jm_fupd_intro'.
-    eapply convergent_controls_jsafe; try apply Hsafe; auto.
-    intros ? ? [? ?]; split; auto.
-    inv H.
-    1,3: destruct H9; discriminate.
-    rewrite call_cont_idem.
-    econstructor; eauto.
-  + intros ?? Hora ???.
-    rename H0 into Hsafe.
-    specialize (Hsafe ora jm Hora (eq_refl _) H6 LW).
-     simpl in Hsafe.
-    apply jm_fupd_intro'.
-    eapply convergent_controls_jsafe; try apply Hsafe; auto.
-    intros.
-    destruct H0; split; auto.
-    inv H0.
-    1,3: destruct H16; discriminate.
-    rewrite call_cont_idem.
-    econstructor; eauto.
-Qed.
+  iIntros "#Prog_OK" (????) "[(%Hclosed & %HE) #rguard]".
+  iIntros (??) "!> (% & H & fun)".
+  monPred.unseal.
+  set (rho := construct_rho _ _ _).
+  iSpecialize ("rguard" $! EK_return (@cast_expropt CS' ret (ret_type Delta') rho) tx vx).
+  destruct H as (H & ? & Hret).
+  assert (TCD: typecheck_environ Delta rho) by (eapply typecheck_environ_sub; eauto); clear TS.
+  iAssert (tc_expropt Delta ret (ret_type Delta') rho ∧
+    assert_safe OK_spec psi E' f vx tx
+                (exit_cont EK_return (@cast_expropt CS' ret (ret_type Delta') rho) k)
+                (construct_rho (filter_genv psi) vx tx)) with "[-]" as "H".
+  { iSplit.
+    + rewrite tc_expropt_cenv_sub //.
+      iDestruct "fun" as "_".
+      iDestruct "H" as "(_ & $ & _)".
+    + iApply "rguard".
+      rewrite proj_frame /=; subst rho.
+      rewrite RA_return_castexpropt_cenv_sub //.
+      monPred.unseal; unfold_lift. iDestruct "H" as "($ & -> & ?)"; iFrame. iPureIntro; done. }
+  iIntros (? _).
+  rewrite /assert_safe /=.
+  iApply (convergent_controls_jsafe _ _ _ (State f (Sreturn ret) (call_cont k) vx tx)); try done.
+  { inversion 1; subst; try match goal with H : _ \/ _ |- _ => destruct H; done end.
+    + rewrite call_cont_idem; constructor; auto.
+    + rewrite call_cont_idem; econstructor; eauto. }
+  destruct ret; simpl.
+  - (* If we did a view-shift here, we could lose the typechecking (by giving up mem that makes pointers in e valid). *)
+    iApply bi.impl_elim_r; iSplit; last by iDestruct "H" as "[_ H]"; iApply ("H" with "[%]").
+    iIntros (?) "Hm"; iDestruct "H" as "[H _]".
+    rewrite /tc_expr /typecheck_expr; fold typecheck_expr.
+    rewrite denote_tc_assert_andp.
+    subst rho; iDestruct (eval_expr_relate(CS := CS') with "[$Hm H]") as %?; try done; [iDestruct "H" as "[$ _]" |].
+    iDestruct (typecheck_expr_sound' with "[H]") as %Htc; first done; first iDestruct "H" as "($ & _)".
+    iDestruct (cop2_sem_cast' with "[$Hm H]") as %?; first done; first iDestruct "H" as "[_ $]".
+    rewrite cast_exists //; iDestruct "H" as %Hcast.
+    iPureIntro; unfold_lift; rewrite /force_val1 -Hret.
+    rewrite -> Hcast in *; eauto.
+  - iDestruct "H" as "[_ H]"; iApply "H"; done.
+Qed.
+
+End mpred.
diff --git a/veric/semax_conj_disj.v b/veric/semax_conj_disj.v
deleted file mode 100644
index 4992cadf2a..0000000000
--- a/veric/semax_conj_disj.v
+++ /dev/null
@@ -1,259 +0,0 @@
-Require Import VST.veric.juicy_base.
-Require Import VST.veric.juicy_mem VST.veric.juicy_mem_lemmas VST.veric.juicy_mem_ops.
-Require Import VST.VST.veric.res_predicates.
-Require Import VST.veric.extend_tc.
-Require Import VST.veric.Clight_seplog.
-Require Import VST.veric.Clight_assert_lemmas.
-Require Import VST.veric.Clight_core.
-Require Import VST.sepcomp.extspec.
-Require Import VST.sepcomp.step_lemmas.
-Require Import VST.veric.tycontext.
-Require Import VST.veric.expr2.
-Require Import VST.veric.expr_lemmas.
-Require Import VST.veric.juicy_extspec.
-Require Import VST.veric.semax.
-Require Import VST.veric.semax_lemmas.
-Require Import VST.veric.Clight_lemmas.
-
-Open Local Scope pred.
-
-Hint Resolve now_later andp_derives sepcon_derives.
-
-(*
-Definition rmap_chain := {c: nat -> rmap | forall n, level (c n) = n /\ age (c (S n)) (c n)}.
-
-Definition app_rmap_chain (c: rmap_chain) (n: nat) : rmap := proj1_sig c n.
-
-Coercion app_rmap_chain: rmap_chain >-> Funclass.
-
-Lemma rmap_chain_spec1: forall n (c: rmap_chain), level (c n) = n.
-Proof.
-  intros.
-  destruct c; simpl.
-  apply (proj1 (a n)).
-Qed.
-
-Lemma rmap_chain_spec2: forall n (c: rmap_chain), age (c (S n)) (c n).
-Proof.
-  intros.
-  destruct c; simpl.
-  apply (proj2 (a n)).
-Qed.
-
-Lemma rmap_chain_S: forall r1 r2 (c: rmap_chain) n,
-  age r1 r2 ->
-  c (S n) = r1 ->
-  c n = r2.
-Proof.
-  intros.
-  pose proof rmap_chain_spec2 n c.
-  rewrite H0 in H1.
-  unfold age in *.
-  rewrite H1 in H.
-  inv H; auto.
-Qed.
-
-Program Definition is_rmap_chain (c: rmap_chain): pred rmap :=
-  fun r => c (level r) = r.
-Next Obligation.
-  hnf; intros.
-  cbv beta in *.
-  pose proof age_level _ _ H.
-  rewrite H1 in H0.
-  eapply rmap_chain_S; eauto.
-Defined.
-
-Definition exact_at (st: environ * rmap_chain): assert :=
-  fun rho => !! (rho = fst st) && is_rmap_chain (snd st).
-*)
-
-Program Definition exact_at (r: rmap): pred rmap :=
-  fun r' =>
-  if le_lt_dec (level r') (level r) then necR r r' else False.
-Next Obligation.
-  hnf; simpl; intros.
-  destruct (le_lt_dec (level a) (level r)).
-  + pose proof age_level _ _ H.
-    destruct (le_lt_dec (level a') (level r)); try lia.
-    apply rt_trans with a; auto.
-    apply rt_step; auto.
-  + tauto.
-Qed.
-
-Lemma exact_at_spec: forall r, exact_at r r.
-Proof.
-  intros.
-  simpl.
-  if_tac; [apply necR_refl | lia].
-Qed.
-
-Lemma exact_at_rev: forall F: assert,
-  F = fun rho => EX r: rmap, !! (F rho r) && exact_at r.
-Proof.
-  intros.
-  extensionality rho.
-  apply pred_ext; simpl; intros r ?.
-  + exists r.
-    split; [auto | apply exact_at_spec].
-  + destruct H as [r0 [? ?]].
-    simpl in *.
-    if_tac in H0; try tauto.
-    eapply pred_nec_hereditary; eauto.
-Qed.
-
-Definition exact_assert (S: ident -> Prop) (st: environ * rmap): assert :=
-  fun rho =>
-    !! (forall i, S i \/ Map.get (te_of rho) i = Map.get (te_of (fst st)) i) &&
-    !! (ve_of rho = ve_of (fst st)) &&
-    exact_at (snd st).
-
-Lemma exact_assert_spec1: forall S st,
-  closed_wrt_vars S (exact_assert S st).
-Proof.
-  intros.
-  unfold closed_wrt_vars, exact_assert.
-  intros.
-  f_equal.
-  apply pred_ext; unfold prop, andp, derives; simpl; intros _ [? ?]; split; auto;
-  intros i;
-  specialize (H i); specialize (H0 i).
-  + destruct H, H0; auto; right; congruence.
-  + destruct H, H0; auto; right; congruence.
-Qed.
-
-Section SemaxContext.
-Context (Espec: OracleKind).
-
-Lemma fash_imp_spec: forall (P Q: pred rmap) n, (P >=> Q) n <-> (forall w, (level w <= n)%nat -> P w -> Q w).
-Proof.
-  intros.
-  simpl.
-  split; intros.
-  + apply (H w); auto.
-  + apply H; auto.
-    apply necR_level in H1.
-    lia.
-Qed.
-
-Lemma semax_unfold' {CS: compspecs}:
-  semax Espec = fun Delta P c R =>
-    forall (psi: Clight.genv) Delta' (w: nat)
-          (TS: tycontext_sub Delta Delta')
-          (HGG: genv_cenv psi = cenv_cs)
-           (Prog_OK: believe Espec Delta' psi Delta' w) (k: cont) (st: environ * rmap),
-    let F := exact_assert (modifiedvars c) st in
-        closed_wrt_modvars c F ->
-       rguard Espec psi (exit_tycon c Delta') (frame_ret_assert R F) k w ->
-       guard Espec psi Delta' (fun rho => F rho * P rho) (Kseq c :: k) w.
-Proof.
-  intros.
-  rewrite semax_unfold.
-  extensionality Delta P c R.
-  apply prop_ext; split; intros; rename w into n.
-  1: apply H; auto.
-  specialize (H psi Delta' n TS HGG Prog_OK k).
-  unfold guard.
-  intros tx vx.
-  rewrite fash_imp_spec.
-  intros w ? ?.
-  destruct H3 as [[? ?] ?].
-  simpl in H3.
-  destruct H4 as [w1 [w2 [? [? ?]]]].
-  rewrite (exact_at_rev F) in H1.
-  set (rho := construct_rho (filter_genv psi) vx tx).
-  pose proof exact_assert_spec1 (modifiedvars c) (rho, w1) as SPEC1.
-  assert ((rguard Espec psi (exit_tycon c Delta') (frame_ret_assert R (exact_assert (modifiedvars c) (rho, w1))) k) n) as SPEC2.
-  1:{
-    clear - H0 H1 H6.
-    unfold rguard in *.
-    intros ek vl tx' vx'.
-    specialize (H1 ek vl tx' vx'); cbv beta in H1.
-    rewrite fash_imp_spec in H1 |- *.
-    intros w' H_LEVEL' [[? ?] ?].
-    specialize (H1 w' H_LEVEL').
-    apply H1.
-    split; [clear H3 | auto].
-    split; [auto | clear H].
-    unfold frame_ret_assert in *.
-    destruct H2 as [w1' [w2' [? [? ?]]]].
-    exists w1', w2'; split; [auto | split; [auto |]].
-    exists w1.
-    split.
-    + destruct H3 as [[? ?] ?].
-      simpl in H3 |- *.
-      unfold closed_wrt_modvars, closed_wrt_vars in H0.
-      replace (F (construct_rho (filter_genv psi) vx' tx'))
-        with (F (construct_rho (filter_genv psi) vx tx)); auto.
-      unfold construct_rho.
-      simpl in H4.
-      rewrite H4.
-      apply H0.
-      intro i; specialize (H3 i).
-      simpl.
-      destruct H3; [left | right; symmetry]; auto.
-    + unfold exact_assert in H3.
-      destruct H3.
-      auto.
-  }
-  specialize (H _ SPEC1 SPEC2); clear SPEC1 SPEC2.
-
-  unfold guard in H.
-  specialize (H tx vx); cbv beta in H.
-  rewrite fash_imp_spec in H.
-  specialize (H w H2).
-  apply H.
-  split; [| auto].
-  split; [auto |].
-  exists w1, w2; split; [auto | split; [| auto]].
-  unfold exact_assert.
-  split; [| apply exact_at_spec].
-  split.
-  + simpl. intros; right; auto.
-  + simpl. auto.
-Qed.
-
-Lemma semax_conjunction {CS: compspecs} Delta (P1 P2: environ -> mpred) c Q1 Q2:
-  semax Espec Delta P1 c Q1 ->
-  semax Espec Delta P2 c Q2 ->
-  semax Espec Delta (fun rho => P1 rho && P2 rho) c (fun k v rho => Q1 k v rho && Q2 k v rho).
-Proof.
-  intros.
-  rewrite semax_unfold' in H, H0 |- *.
-  intros.
-  specialize (H psi Delta' w TS HGG Prog_OK k st H1).
-  specialize (H0 psi Delta' w TS HGG Prog_OK k st H1).
-  spec H.
-  (* Fail. This subgoal is not provable. *)
-Abort.
-(*
-  1:{
-    clear - H2.
-    unfold rguard in *.
-    intros ek vl tx vx.
-    specialize (H2 ek vl tx vx); cbv beta in H2.
-    rewrite fash_imp_spec in H2 |- *.
-    intros w' HH; specialize (H2 w' HH).
-    intros; apply H2.
-    unfold frame_ret_assert in *.
-    destruct H as [[? ?] ?].
-    split; [split |]; auto.
-    clear - H0.
-  replace (frame_ret_assert (fun kd v rho => Q1 kd v rho && Q2 kd v rho) F)
-    with (fun kd v rho => (frame_ret_assert Q1 F) kd v rho && (frame_ret_assert Q2 F) kd v rho).
-  2:{
-    extensionality kd v rho.
-    unfold frame_ret_assert.
-    rewrite <- !(sepcon_comm (F rho)).
-    Check distrib_sepcon_andp.
-    SearchAbout andp sepcon.
-
-Check semax_fold_unfold.
-Check semax_fold.
-    forall (psi: Clight.genv) Delta' (w: nat)
-          (TS: tycontext_sub Delta Delta')
-          (HGG: genv_cenv psi = cenv_cs)
-           (Prog_OK: believe Espec Delta' psi Delta' w) (k: cont) (F: assert),
-        closed_wrt_modvars c F ->
-       rguard Espec psi (exit_tycon c Delta') (frame_ret_assert R F) k w ->
-       guard Espec psi Delta' (fun rho => F rho * P rho) (Kseq c :: k) w.
-*)
\ No newline at end of file
diff --git a/veric/semax_conseq.v b/veric/semax_conseq.v
index 1442acf16c..de9430783a 100644
--- a/veric/semax_conseq.v
+++ b/veric/semax_conseq.v
@@ -1,9 +1,12 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.juicy_base.
-Require Import VST.veric.juicy_mem VST.veric.juicy_mem_lemmas VST.veric.juicy_mem_ops.
+Require Import VST.veric.juicy_mem.
 Require Import VST.veric.res_predicates.
+Require Import VST.veric.external_state.
 Require Import VST.veric.extend_tc.
 Require Import VST.veric.Clight_seplog.
 Require Import VST.veric.Clight_assert_lemmas.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.Clight_core.
 Require Import VST.sepcomp.extspec.
 Require Import VST.sepcomp.step_lemmas.
@@ -14,9 +17,6 @@ Require Import VST.veric.juicy_extspec.
 Require Import VST.veric.semax.
 Require Import VST.veric.semax_lemmas.
 Require Import VST.veric.Clight_lemmas.
-Require Import VST.veric.own.
-
-Local Open Scope pred.
 
 (* This file contains two parts:
    1. Proof of semax_conseq.
@@ -25,111 +25,107 @@ Local Open Scope pred.
 
 (* Part 1: Proof of semax_conseq *)
 
-Lemma _guard_mono: forall Espec ge Delta f (P Q: assert) k,
-  (forall rho, P rho |-- Q rho) ->
-  _guard Espec ge Delta f Q k |-- _guard Espec ge Delta f P k.
+Global Instance local_absorbing `{!heapGS Σ} l : Absorbing (local l).
+Proof.
+  rewrite /local; apply monPred_absorbing, _.
+Qed.
+
+Global Instance local_persistent `{!heapGS Σ} l : Persistent (local l).
+Proof.
+  rewrite /local; apply monPred_persistent, _.
+Qed.
+
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty}.
+
+Lemma _guard_mono: forall ge E Delta f (P Q: assert) k,
+  (P ⊢ Q) ->
+  _guard OK_spec ge E Delta f Q k ⊢ _guard OK_spec ge E Delta f P k.
 Proof.
   intros.
-  unfold _guard.
-  apply allp_derives; intros tx.
-  apply allp_derives; intros vx.
-  apply fash_derives.
-  apply imp_derives; auto.
+  apply _guard_mono; auto.
+  intros; apply H.
 Qed.
 
-Lemma guard_mono: forall Espec ge Delta f (P Q: assert) k,
-  (forall rho, P rho |-- Q rho) ->
-  guard Espec ge Delta f Q k |-- guard Espec ge Delta f P k.
+Lemma guard_mono: forall ge E Delta f (P Q: assert) k,
+  (P ⊢ Q) ->
+  guard' OK_spec ge E Delta f Q k ⊢ guard' OK_spec ge E Delta f P k.
 Proof.
   intros.
-  unfold guard.
   apply _guard_mono; auto.
 Qed.
 
-Lemma rguard_mono: forall Espec ge Delta f (P Q: ret_assert) k,
-  (forall rk vl rho, proj_ret_assert P rk vl rho |-- proj_ret_assert Q rk vl rho) ->
-  rguard Espec ge Delta f Q k |-- rguard Espec ge Delta f P k.
+Lemma rguard_mono: forall ge E Delta f (P Q: ret_assert) k,
+  (forall rk vl, proj_ret_assert P rk vl ⊢ proj_ret_assert Q rk vl) ->
+  rguard OK_spec ge E Delta f Q k ⊢ rguard OK_spec ge E Delta f P k.
 Proof.
   intros.
   unfold rguard.
-  apply allp_derives; intros ek.
-  apply allp_derives; intros vl.
-  apply _guard_mono; auto.
+  iIntros "H" (??).
+  rewrite -_guard_mono; eauto.
 Qed.
 
-Definition fupd_ret_assert (Q: ret_assert): ret_assert :=
-          {| RA_normal := fun rho => fupd (RA_normal Q rho);
-             RA_break := fun rho => fupd (RA_break Q rho);
-             RA_continue := fun rho => fupd (RA_continue Q rho);
-             RA_return := fun v rho => RA_return Q v rho |}.
+Definition fupd_ret_assert E (Q: ret_assert): ret_assert :=
+          {| RA_normal := |={E}=> RA_normal Q;
+             RA_break := |={E}=> RA_break Q;
+             RA_continue := |={E}=> RA_continue Q;
+             RA_return := fun v => RA_return Q v |}.
 (* Asymmetric consequence: since there's no CompCert step that
    corresponds to RA_return, we can't do an update there. We could
    probably add a bupd if we really want to, but it may not be
    necessary. *)
 
-Lemma fupd_fupd_andp_prop : forall P Q, fupd (!! P && fupd Q) = fupd (!!P && Q).
-Proof.
-  intros; apply pred_ext.
-  - eapply derives_trans, fupd.fupd_trans.
-    apply fupd.fupd_mono, fupd.fupd_andp_prop.
-  - apply fupd.fupd_mono.
-    apply andp_derives, fupd.fupd_intro; auto.
-Qed.
-
-Lemma fupd_idem : forall P, fupd (fupd P) = fupd P.
+Lemma fupd_fupd_andp_prop : forall E P (Q : assert), (|={E}=> (⌜P⌝ ∧ |={E}=> Q)) ⊣⊢ (|={E}=> (⌜P⌝ ∧ Q)).
 Proof.
-  intros; apply pred_ext.
-  - apply fupd.fupd_trans.
-  - apply fupd.fupd_intro.
+  intros; iSplit; iIntros "H".
+  - iMod "H" as "[$ $]".
+  - iMod "H" as "[$ $]"; done.
 Qed.
 
-Lemma proj_fupd_ret_assert: forall Q ek vl rho,
-  fupd (proj_ret_assert (fupd_ret_assert Q) ek vl rho) = fupd (proj_ret_assert Q ek vl rho).
+Lemma proj_fupd_ret_assert: forall E Q ek vl,
+  (|={E}=> proj_ret_assert (fupd_ret_assert E Q) ek vl) ⊣⊢ (|={E}=> proj_ret_assert Q ek vl).
 Proof.
   intros.
-  destruct ek; simpl; auto; apply fupd_fupd_andp_prop.
+  destruct ek; rewrite // /=; apply fupd_fupd_andp_prop.
 Qed.
 
-(* The following four lemmas is not now used. but after deep embedded hoare logic (SL_as_Logic) is
-ported, the frame does not need to be quantified in the semantic definition of semax. Then,
-these two lemmas can replace the other two afterwards. *)
+(* After deep embedded hoare logic (SL_as_Logic) is ported, maybe the frame does not need to be
+   quantified in the semantic definition of semax. *)
 
 Lemma assert_safe_fupd':
-  forall {Espec: OracleKind} gx vx tx rho (P: environ -> pred rmap) Delta f k,
+  forall gx vx tx E (P: assert) Delta f k rho,
     match k with Ret _ _ => False | _ => True end ->
-    let PP1 := !! guard_environ Delta f rho in
+    let PP1 := ⌜guard_environ Delta f rho⌝ in
     let PP2 := funassert Delta rho in
-    PP1 && (P rho) && PP2 >=>
-    assert_safe Espec gx f vx tx k rho =
-    PP1 && (fupd (P rho)) && PP2 >=>
-    assert_safe Espec gx f vx tx k rho.
+    (PP1 ∧ P rho ∗ PP2 -∗ assert_safe OK_spec gx E f vx tx k rho) ⊣⊢
+    (PP1 ∧ (|={E}=> P rho) ∗ PP2 -∗ assert_safe OK_spec gx E f vx tx k rho).
 Proof.
   intros.
-  apply pred_ext.
-  * eapply derives_trans; [apply fupd.subp_fupd, derives_refl | apply subp_derives, assert_safe_fupd; auto].
-    eapply derives_trans; [apply andp_derives, derives_refl; apply fupd.fupd_andp_prop|].
-    rewrite andp_comm, (andp_comm (_ && _)).
-    apply fupd.fupd_andp_corable, corable_funassert.
-  * apply subp_derives, derives_refl.
-    apply andp_derives, derives_refl.
-    apply andp_derives, fupd.fupd_intro; apply derives_refl.
+  iSplit.
+  * iIntros "H (% & P & ?)".
+    iApply assert_safe_fupd; first done; iMod "P"; iApply "H"; auto.
+    by iFrame.
+  * iIntros "H (% & P & ?)"; iApply "H"; auto.
+    by iFrame.
 Qed.
 
 Lemma _guard_fupd':
-  forall {Espec: OracleKind} ge Delta (P: environ -> pred rmap) f k,
+  forall ge E Delta (P: assert) f k,
     match k with Ret _ _ => False | _ => True end ->
-    _guard Espec ge Delta f P k = _guard Espec ge Delta f (fun rho => fupd (P rho)) k.
+    _guard OK_spec ge E Delta f P k ⊣⊢ _guard OK_spec ge E Delta f (|={E}=> P) k.
 Proof.
   intros.
   unfold _guard.
-  f_equal; extensionality tx.
-  f_equal; extensionality vx.
-  apply assert_safe_fupd'; auto.
+  apply bi.forall_proper; intros ?.
+  apply bi.forall_proper; intros ?.
+  rewrite assert_safe_fupd'; auto.
+  by monPred.unseal.
 Qed.
-  
+
 Lemma guard_fupd':
-  forall {Espec: OracleKind} ge Delta f (P: environ -> pred rmap) k,
-    guard Espec ge Delta f P k = guard Espec ge Delta f (fun rho => fupd (P rho)) k.
+  forall ge E Delta f (P: assert) k,
+    guard' OK_spec ge E Delta f P k ⊣⊢ guard' OK_spec ge E Delta f (|={E}=> P) k.
 Proof.
   intros.
   apply _guard_fupd'; auto.
@@ -145,621 +141,574 @@ Proof.
 Qed.
 
 Lemma rguard_fupd':
-  forall {Espec: OracleKind} ge Delta f (P: ret_assert) k,
-    rguard Espec ge Delta f P k = rguard Espec ge Delta f (fupd_ret_assert P) k.
+  forall ge E Delta f (P: ret_assert) k,
+    rguard OK_spec ge E Delta f P k ⊣⊢ rguard OK_spec ge E Delta f (fupd_ret_assert E P) k.
 Proof.
   intros.
   unfold rguard.
-  f_equal; extensionality ek.
-  f_equal; extensionality vl.
+  apply bi.forall_proper; intros ek.
+  apply bi.forall_proper; intros vl.
   destruct (eq_dec ek EK_return); subst; auto.
   rewrite _guard_fupd'; [|apply exit_cont_nonret; auto].
   setoid_rewrite _guard_fupd' at 2; [|apply exit_cont_nonret; auto].
-  apply pred_ext; apply _guard_mono; intros; rewrite proj_fupd_ret_assert; auto.
+  iSplit; iApply _guard_mono; intros; rewrite proj_fupd_ret_assert; auto.
 Qed.
 
 Lemma assert_safe_fupd:
-  forall {Espec: OracleKind} gx vx tx rho (F P: environ -> pred rmap) Delta f k,
+  forall gx vx tx rho E (F P: assert) Delta f k,
     match k with Ret _ _ => False | _ => True end ->
-    let PP1 := !! guard_environ Delta f rho in
+    let PP1 := ⌜guard_environ Delta f rho⌝ in
     let PP2 := funassert Delta rho in
-    PP1 && (F rho * P rho) && PP2 >=>
-    assert_safe Espec gx f vx tx k rho =
-    PP1 && (F rho * fupd (P rho)) && PP2 >=>
-    assert_safe Espec gx f vx tx k rho.
+    (PP1 ∧ (F ∗ P) rho ∗ PP2 -∗
+    assert_safe OK_spec gx E f vx tx k rho) ⊣⊢
+    (PP1 ∧ (F ∗ |={E}=> P) rho ∗ PP2 -∗
+    assert_safe OK_spec gx E f vx tx k rho).
 Proof.
   intros.
-  apply pred_ext.
-  + eapply derives_trans; [apply fupd.subp_fupd, derives_refl | apply subp_derives, assert_safe_fupd; auto].
-    eapply derives_trans; [apply andp_derives, derives_refl; apply andp_derives, fupd.fupd_frame_l; apply derives_refl|].
-    eapply derives_trans; [apply andp_derives, derives_refl; apply fupd.fupd_andp_prop|].
-    rewrite andp_comm, (andp_comm (_ && _)).
-    apply fupd.fupd_andp_corable, corable_funassert.
-  + apply subp_derives, derives_refl.
-    apply andp_derives, derives_refl.
-    apply andp_derives, sepcon_derives, fupd.fupd_intro; apply derives_refl.
+  iSplit.
+  * iIntros "H (% & P & ?)".
+    rewrite (assert_safe_fupd' _ _ _ _ (F ∗ P)); last done.
+    iApply "H"; iFrame "%"; iFrame.
+    monPred.unseal; by iDestruct "P" as "($ & >$)".
+  * iIntros "H (% & P & ?)"; iApply "H"; iFrame.
+    iFrame "%"; monPred.unseal; by iDestruct "P" as "($ & $)".
 Qed.
 
 Lemma _guard_fupd:
-  forall {Espec: OracleKind} ge Delta f (F P: environ -> pred rmap) k,
+  forall ge E Delta f (F P: assert) k,
     match k with Ret _ _ => False | _ => True end ->
-    _guard Espec ge Delta f (fun rho => F rho * P rho) k = _guard Espec ge Delta f (fun rho => F rho * fupd (P rho)) k.
+    _guard OK_spec ge E Delta f (F ∗ P) k ⊣⊢ _guard OK_spec ge E Delta f (F ∗ |={E}=> P) k.
 Proof.
   intros.
   unfold _guard.
-  f_equal; extensionality tx.
-  f_equal; extensionality vx.
-  apply assert_safe_fupd; auto.
+  apply bi.forall_proper; intros ?.
+  apply bi.forall_proper; intros ?.
+  rewrite assert_safe_fupd; auto.
 Qed.
-  
+
 Lemma guard_fupd:
-  forall {Espec: OracleKind} ge Delta f (F P: environ -> pred rmap) k,
-    guard Espec ge Delta f (fun rho => F rho * P rho) k = guard Espec ge Delta f (fun rho => F rho * fupd (P rho)) k.
+  forall ge E Delta f (F P: assert) k,
+    guard' OK_spec ge E Delta f (F ∗ P) k ⊣⊢ guard' OK_spec ge E Delta f (F ∗ |={E}=> P) k.
 Proof.
   intros.
   apply _guard_fupd; auto.
 Qed.
 
-Lemma fupd_fupd_frame_l : forall P Q, fupd (P * fupd Q) = fupd (P * Q).
+Lemma fupd_fupd_frame_l : forall E (P Q : assert), (|={E}=> (P ∗ |={E}=> Q)) ⊣⊢ |={E}=> (P ∗ Q).
 Proof.
-  intros; apply pred_ext.
-  - eapply derives_trans, fupd.fupd_trans.
-    apply fupd.fupd_mono, fupd.fupd_frame_l.
-  - apply fupd.fupd_mono, sepcon_derives, fupd.fupd_intro; auto.
+  intros; iSplit.
+  - by iIntros ">[$ >$]".
+  - by iIntros ">[$ $]".
 Qed.
 
-Lemma proj_fupd_ret_assert_frame: forall F Q ek vl rho,
-  fupd (F * proj_ret_assert (fupd_ret_assert Q) ek vl rho) = fupd (F * proj_ret_assert Q ek vl rho).
+Lemma proj_fupd_ret_assert_frame: forall E F Q ek vl,
+  (|={E}=> (F ∗ proj_ret_assert (fupd_ret_assert E Q) ek vl)) ⊣⊢ |={E}=> (F ∗ proj_ret_assert Q ek vl).
 Proof.
   intros.
   destruct ek; simpl; auto;
-    rewrite <- fupd_fupd_frame_l, fupd_fupd_andp_prop, fupd_fupd_frame_l; auto.
+    rewrite -fupd_fupd_frame_l fupd_fupd_andp_prop fupd_fupd_frame_l; auto.
+Qed.
+
+Global Instance guard_proper ge E Delta f : Proper (equiv ==> eq ==> equiv) (_guard OK_spec ge E Delta f).
+Proof.
+  intros ????? ->; rewrite /_guard.
+  do 7 f_equiv.
+  by rewrite H.
+Qed.
+
+Global Instance guard'_proper ge E Delta f : Proper (equiv ==> eq ==> equiv) (guard' OK_spec ge E Delta f).
+Proof.
+  solve_proper.
+Qed.
+
+Global Instance rguard_proper ge E Delta f : Proper (equiv ==> eq ==> equiv) (rguard OK_spec ge E Delta f).
+Proof.
+  intros ????? ->; rewrite /rguard.
+  do 3 f_equiv; intros ?.
+  apply guard_proper; last done.
+  destruct H as (? & ? & ? & ?).
+  destruct a; simpl; last done; f_equiv; done.
+Qed.
+
+Global Instance frame_ret_assert_proper : Proper (equiv ==> equiv ==> equiv) frame_ret_assert.
+Proof.
+  intros [????] [????] (? & ? & ? & ?); repeat intro; simpl in *.
+  split3; last split; simpl; intros; f_equiv; done.
+Qed.
+
+Global Instance semax_proper {CS} E Delta : Proper (equiv ==> eq ==> equiv ==> iff) (semax(CS := CS) OK_spec E Delta).
+Proof.
+  repeat intro; subst.
+  rewrite !semax_unfold.
+  split; intros.
+  - iIntros "#B" (????) "(% & ?)".
+    rewrite -H; iApply (H0 with "B [-]"); [done..|].
+    iApply (bi.affinely_mono with "[$]").
+    rewrite H1; iIntros "$"; done.
+  - iIntros "#B" (????) "(% & ?)".
+    rewrite H; iApply (H0 with "B [-]"); [done..|].
+    iApply (bi.affinely_mono with "[$]").
+    rewrite H1; iIntros "$"; done.
+Qed.
+
+Lemma guard_proj_frame : forall ge E Delta f P F ek vl k,
+  _guard OK_spec ge E Delta f (proj_ret_assert (frame_ret_assert P F) ek vl) k ⊣⊢
+  _guard OK_spec ge E Delta f (F ∗ proj_ret_assert P ek vl) k.
+Proof.
+  intros. rewrite proj_frame //.
 Qed.
 
 Lemma rguard_fupd:
-  forall {Espec: OracleKind} ge Delta F f (P: ret_assert) k,
-    rguard Espec ge Delta f (frame_ret_assert P F) k = rguard Espec ge Delta f (frame_ret_assert (fupd_ret_assert P) F) k.
+  forall ge E Delta F f (P: ret_assert) k,
+    rguard OK_spec ge E Delta f (frame_ret_assert P F) k ⊣⊢ rguard OK_spec ge E Delta f (frame_ret_assert (fupd_ret_assert E P) F) k.
 Proof.
   intros.
   unfold rguard.
-  f_equal; extensionality ek.
-  f_equal; extensionality vl.
-  rewrite !proj_frame.
-  destruct (eq_dec ek EK_return); subst; auto.
+  apply bi.forall_proper; intros ek.
+  apply bi.forall_proper; intros vl.
+  rewrite !guard_proj_frame.
+  destruct (eq_dec ek EK_return); [subst; auto|].
   rewrite _guard_fupd'; [|apply exit_cont_nonret; auto].
   setoid_rewrite _guard_fupd' at 2; [|apply exit_cont_nonret; auto].
-  apply pred_ext; apply _guard_mono; intros; rewrite proj_fupd_ret_assert_frame; auto.
+  iSplit; iApply _guard_mono; intros; rewrite proj_fupd_ret_assert_frame; auto.
 Qed.
 
 Lemma _guard_allp_fun_id:
-  forall {Espec: OracleKind} ge Delta' Delta f (F P: environ -> pred rmap) k,
+  forall ge E Delta' Delta f (F P: assert) k,
     tycontext_sub Delta Delta' ->
-    _guard Espec ge Delta' f (fun rho => F rho * P rho) k = _guard Espec ge Delta' f (fun rho => F rho * (allp_fun_id Delta rho && P rho)) k.
+    _guard OK_spec ge E Delta' f (F ∗ P) k ⊣⊢ _guard OK_spec ge E Delta' f (F ∗ (<affine> allp_fun_id Delta ∗ P)) k.
 Proof.
   intros.
   unfold _guard.
-  f_equal; extensionality tx.
-  f_equal; extensionality vx.
-  f_equal.
-  f_equal.
-  rewrite !andp_assoc.
-  f_equal.
-  rewrite corable_sepcon_andp1 by apply corable_allp_fun_id.
-  rewrite (andp_comm (allp_fun_id _ _ )), andp_assoc.
-  f_equal.
-  apply pred_ext; [apply andp_right; auto | apply andp_left2; auto].
-  intros w W. hnf.
-  eapply funassert_allp_fun_id_sub; eauto.
-Qed.
-
-Lemma guard_allp_fun_id: forall {Espec: OracleKind} ge Delta' Delta f (F P: environ -> pred rmap) k,
+  do 7 f_equiv.
+  iSplit.
+  * rewrite {1}funassert_allp_fun_id_sub //.
+    monPred.unseal; rewrite monPred_at_affinely.
+    iIntros "(($ & $) & ($ & $))".
+  * monPred.unseal.
+    iIntros "(($ & _ & $) & $)".
+Qed.
+
+Lemma guard_allp_fun_id: forall ge E Delta' Delta f (F P: assert) k,
   tycontext_sub Delta Delta' ->
-  guard Espec ge Delta' f (fun rho => F rho * P rho) k = guard Espec ge Delta' f (fun rho => F rho * (allp_fun_id Delta rho && P rho)) k.
+  guard' OK_spec ge E Delta' f (F ∗ P) k ⊣⊢ guard' OK_spec ge E Delta' f (F ∗ (<affine> allp_fun_id Delta ∗ P)) k.
 Proof.
   intros.
   apply _guard_allp_fun_id; auto.
 Qed.
 
-Lemma rguard_allp_fun_id: forall {Espec: OracleKind} ge Delta' Delta f (F: environ -> pred rmap) P k,
+Lemma rguard_allp_fun_id: forall ge E Delta' Delta f (F: assert) P k,
   tycontext_sub Delta Delta' ->
-  rguard Espec ge Delta' f (frame_ret_assert P F) k = rguard Espec ge Delta' f (frame_ret_assert (conj_ret_assert P (allp_fun_id Delta)) F) k.
+  rguard OK_spec ge E Delta' f (frame_ret_assert P F) k ⊣⊢ rguard OK_spec ge E Delta' f (frame_ret_assert (frame_ret_assert P (<affine> allp_fun_id Delta)) F) k.
 Proof.
   intros.
   unfold rguard.
-  f_equal; extensionality ek.
-  f_equal; extensionality vl.
-  rewrite !proj_frame.
-  rewrite proj_conj.
-  apply _guard_allp_fun_id; auto.
-Qed. 
+  apply bi.forall_proper; intros ek.
+  apply bi.forall_proper; intros vl.
+  rewrite !guard_proj_frame.
+  rewrite _guard_allp_fun_id; eauto.
+  apply guard_proper; auto.
+  by intros; rewrite proj_frame.
+Qed.
 
 Lemma _guard_tc_environ:
-  forall {Espec: OracleKind} ge Delta' Delta f (F P: environ -> pred rmap) k,
+  forall ge E Delta' Delta f (F P: assert) k,
     tycontext_sub Delta Delta' ->
-    _guard Espec ge Delta' f (fun rho => F rho * P rho) k = 
-    _guard Espec ge Delta' f (fun rho => F rho * (!! typecheck_environ Delta rho && P rho)) k.
+    _guard OK_spec ge E Delta' f (F ∗ P) k ⊣⊢
+    _guard OK_spec ge E Delta' f (F ∗ (local (typecheck_environ Delta) ∧ P)) k.
 Proof.
   intros.
   unfold _guard.
-  f_equal; extensionality tx.
-  f_equal; extensionality vx.
-  f_equal.
-  f_equal.
-  f_equal.
-  rewrite corable_sepcon_andp1 by apply corable_prop.
-  rewrite <- andp_assoc.
-  f_equal.
-  apply pred_ext; [apply andp_right; auto | apply andp_left1; auto].
-  intros ? ?; simpl in *.
-  destruct H0 as [? _].
-  eapply typecheck_environ_sub; eauto.
-Qed.
-
-Lemma guard_tc_environ: forall {Espec: OracleKind} ge Delta' Delta f (F P: environ -> pred rmap) k,
+  do 6 f_equiv.
+  iSplit.
+  * monPred.unseal; iIntros "(%Henv & ($ & $) & $)"; iPureIntro.
+    split3; last done; auto.
+    eapply typecheck_environ_sub; eauto.
+    destruct Henv as [? _]; auto.
+  * monPred.unseal; iIntros "($ & ($ & [_ $]) & $)".
+Qed.
+
+Lemma guard_tc_environ: forall ge E Delta' Delta f (F P: assert) k,
   tycontext_sub Delta Delta' ->
-  guard Espec ge Delta' f (fun rho => F rho * P rho) k = guard Espec ge Delta' f (fun rho => F rho * (!! typecheck_environ Delta rho && P rho)) k.
+  guard' OK_spec ge E Delta' f (F ∗ P) k ⊣⊢ guard' OK_spec ge E Delta' f (F ∗ (local (typecheck_environ Delta) ∧ P)) k.
 Proof.
   intros.
   apply _guard_tc_environ; auto.
 Qed.
 
-Lemma rguard_tc_environ: forall {Espec: OracleKind} ge Delta' Delta f (F: environ -> pred rmap) P k,
+Lemma rguard_tc_environ: forall ge E Delta' Delta f (F: assert) P k,
   tycontext_sub Delta Delta' ->
-  rguard Espec ge Delta' f (frame_ret_assert P F) k = rguard Espec ge Delta'  f (frame_ret_assert (conj_ret_assert P (fun rho => !! typecheck_environ Delta rho)) F) k.
+  rguard OK_spec ge E Delta' f (frame_ret_assert P F) k ⊣⊢ rguard OK_spec ge E Delta' f (frame_ret_assert (conj_ret_assert P (local (typecheck_environ Delta))) F) k.
 Proof.
   intros.
   unfold rguard.
-  f_equal; extensionality ek.
-  f_equal; extensionality vl.
-  rewrite !proj_frame.
-  rewrite proj_conj.
-  apply _guard_tc_environ; auto.
-Qed.
-
-Lemma semax_conseq {CS: compspecs} {Espec: OracleKind}:
- forall Delta P' (R': ret_assert) P c (R: ret_assert) ,
-   (forall rho,  seplog.derives (!!(typecheck_environ Delta rho) && (allp_fun_id Delta rho && P rho))
-                   (fupd (P' rho)) ) ->
-   (forall rho,  seplog.derives (!!(typecheck_environ Delta rho) && (allp_fun_id Delta rho && RA_normal R' rho))
-                   (fupd (RA_normal R rho))) ->
-   (forall rho, seplog.derives (!! (typecheck_environ Delta rho) && (allp_fun_id Delta rho && RA_break R' rho))
-                   (fupd (RA_break R rho))) ->
-   (forall rho, seplog.derives (!! (typecheck_environ Delta rho) && (allp_fun_id Delta rho && RA_continue R' rho))
-                   (fupd (RA_continue R rho))) ->
-   (forall vl rho, seplog.derives (!! (typecheck_environ Delta rho) && (allp_fun_id Delta rho && RA_return R' vl rho))
-                   (RA_return R vl rho)) ->
-   semax Espec Delta P' c R' ->  semax Espec Delta P c R.
+  apply bi.forall_proper; intros ek.
+  apply bi.forall_proper; intros vl.
+  rewrite !guard_proj_frame _guard_tc_environ; eauto.
+  apply guard_proper; auto.
+  intros; by rewrite proj_conj.
+Qed.
+
+Lemma semax'_conseq {CS: compspecs}:
+ forall E Delta P' (R': ret_assert) P c (R: ret_assert) ,
+   (local (typecheck_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢
+                   (|={E}=> P')) ->
+   (local (typecheck_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ RA_normal R') ⊢
+                   (|={E}=> RA_normal R)) ->
+   (local (typecheck_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ RA_break R') ⊢
+                   (|={E}=> RA_break R)) ->
+   (local (typecheck_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ RA_continue R') ⊢
+                   (|={E}=> RA_continue R)) ->
+   (forall vl, local (typecheck_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ RA_return R' vl) ⊢
+                   RA_return R vl) ->
+   semax' OK_spec E Delta P' c R' ⊢ semax' OK_spec E Delta P c R.
 Proof.
   intros.
-  assert (semax' Espec Delta P' c R' |-- semax' Espec Delta P c R);
-    [clear H4 | exact (fun n => H5 n (H4 n))].
-  rewrite semax_fold_unfold.
-  apply allp_derives; intros gx.
-  apply allp_derives; intros Delta'.
-  apply allp_derives; intros CS'.
-  apply prop_imp_derives; intros [? _].
-  apply imp_derives; auto.
-  apply allp_derives; intros k.
-  apply allp_derives; intros F.
-  apply allp_derives; intros f.
-  apply imp_derives; [apply andp_derives; auto |]. 
-  + erewrite (rguard_allp_fun_id _ _ _ _ _ R') by eauto.
-    erewrite (rguard_tc_environ _ _ _ _ _ (conj_ret_assert R' _)) by eauto.
-    rewrite (rguard_fupd _ _ _ _ R).
-    apply rguard_mono.
+  rewrite !semax_fold_unfold.
+  iIntros "H" (??? [??]).
+  iPoseProof ("H" with "[%]") as "H"; first done.
+  iApply (bi.impl_mono with "H"); first done.
+  iIntros "H" (????) "[(% & %) rguard]".
+  iSpecialize ("H" with "[-]").
+  + rewrite /bi_affinely; iSplit; first done; iSplit; first done.
+    rewrite bi.and_elim_r.
+    erewrite (rguard_allp_fun_id _ _ _ _ _ _ R') by eauto.
+    erewrite (rguard_tc_environ _ _ _ _ _ _ (frame_ret_assert R' _)) by eauto.
+    rewrite (rguard_fupd _ _ _ _ _ R).
+    iApply (rguard_mono with "rguard").
     intros.
-    rewrite proj_frame, proj_conj, proj_conj.
+    rewrite proj_frame proj_conj !proj_frame.
     destruct rk; simpl;
-         [rename H0 into Hx; pose (ek:=RA_normal)
-         | rename H1 into Hx; pose (ek:=RA_break)
-         | rename H2 into Hx ; pose (ek:=RA_continue)
-         | rewrite (sepcon_comm _ (F rho)); apply sepcon_derives, H3; auto]; clear H3.
-all: rewrite <- sepcon_andp_prop1; rewrite sepcon_comm; apply sepcon_derives, derives_refl.
-all:    specialize (Hx rho); inv Hx; simpl in *;
-    apply derives_trans with (!! (vl = None) && 
-       (!! typecheck_environ Delta rho &&
-        (allp_fun_id Delta rho && ek R' rho))); subst ek;
-     [  intros ? [? [? [? ?]]];  split3; auto; split; auto | ];
-    apply prop_andp_left; intro Hvl;
-    rewrite (prop_true_andp _ _ Hvl); auto.
-  + erewrite (guard_allp_fun_id _ _ _ _ _ P) by eauto.
-    erewrite (guard_tc_environ _ _ _ _ _ (fun rho => allp_fun_id Delta rho && P rho)) by eauto.
-    rewrite (guard_fupd _ _ _ _ P').
-    apply guard_mono.
-    intros.
-    apply sepcon_derives; auto.
-    specialize (H rho); inv H; auto.
+         [rename H0 into Hx; pose (ek:=@RA_normal Σ)
+         | rename H1 into Hx; pose (ek:=@RA_break Σ)
+         | rename H2 into Hx ; pose (ek:=@RA_continue Σ)
+         | apply bi.sep_mono, H3; auto]; clear H3.
+    all: rewrite fupd_mask_mono // in Hx; rewrite -Hx; iIntros "($ & ? & $ & $ & $)"; auto.
+  + erewrite (guard_allp_fun_id _ _ _ _ _ _ P) by eauto.
+    erewrite (guard_tc_environ _ _ _ _ _ _ (<affine> allp_fun_id Delta ∗ P)) by eauto.
+    rewrite (guard_fupd _ _ _ _ _ P').
+    iApply (guard_mono with "H").
+    rewrite -fupd_mask_mono //.
+    by rewrite -H.
+Qed.
+
+Lemma semax_conseq {CS: compspecs}:
+ forall E Delta P' (R': ret_assert) P c (R: ret_assert) ,
+   (local (typecheck_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢
+                   (|={E}=> P') ) ->
+   (local (typecheck_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ RA_normal R') ⊢
+                   (|={E}=> RA_normal R)) ->
+   (local (typecheck_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ RA_break R') ⊢
+                   (|={E}=> RA_break R)) ->
+   (local (typecheck_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ RA_continue R') ⊢
+                   (|={E}=> RA_continue R)) ->
+   (forall vl, local (typecheck_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ RA_return R' vl) ⊢
+                   RA_return R vl) ->
+   semax OK_spec E Delta P' c R' ->  semax OK_spec E Delta P c R.
+Proof.
+  intros.
+  unfold semax; rewrite -semax'_conseq; eauto.
 Qed.
 
 (* Part 2: Deriving simpler and older version of consequence rules from semax_conseq. *)
 Lemma semax'_post_fupd:
- forall {CS: compspecs} {Espec: OracleKind} (R': ret_assert) Delta (R: ret_assert) P c,
-   (forall ek vl rho, ek <> EK_return -> !!(typecheck_environ Delta rho) && 
-                proj_ret_assert R' ek vl rho 
-         |-- fupd (proj_ret_assert R ek vl rho)) ->
-   (forall vl rho,  !!(typecheck_environ Delta rho) && 
-                RA_return R' vl rho 
-         |-- RA_return R vl rho) ->
-   semax' Espec Delta P c R' |-- semax' Espec Delta P c R.
+ forall {CS: compspecs} (R': ret_assert) E Delta (R: ret_assert) P c,
+   (forall ek vl, ek <> EK_return -> local (typecheck_environ Delta) ∧
+                proj_ret_assert R' ek vl
+         ⊢ |={E}=> proj_ret_assert R ek vl) ->
+   (forall vl, local (typecheck_environ Delta) ∧
+                RA_return R' vl
+         ⊢ RA_return R vl) ->
+   semax' OK_spec E Delta P c R' ⊢ semax' OK_spec E Delta P c R.
 Proof.
 intros.
-rewrite semax_fold_unfold.
-apply allp_derives; intro psi.
-apply allp_derives; intro Delta'.
-apply allp_derives; intro CS'.
-apply prop_imp_derives; intros [TS HGG].
-apply imp_derives; auto.
-apply allp_derives; intro k.
-apply allp_derives; intro F.
-apply allp_derives; intro f.
-apply imp_derives; auto.
-apply andp_derives; auto.
-erewrite (rguard_tc_environ _ _ _ _ _ R') by eauto.
-rewrite rguard_fupd.
-apply rguard_mono; intros.
-destruct (eq_dec rk EK_return); subst.
-- destruct R, R'; simpl in *.
-  rewrite andp_comm; apply sepcon_derives; auto.
-- destruct R, R'; simpl in *.
-  specialize (H rk vl rho); destruct rk; try contradiction; simpl in *;
-    apply prop_andp_left; intros Hvl; rewrite (prop_true_andp _ _ Hvl) in H;
-    rewrite prop_true_andp by auto; rewrite andp_comm; apply sepcon_derives; auto;
-    eapply derives_trans, fupd.fupd_mono, andp_left2; try apply H; auto.
+apply semax'_conseq; [by iIntros "(_ & _ & $)" | .. | intros; rewrite -H0; iIntros "(? & _ & $)"; auto]; intros.
+- specialize (H EK_normal None); simpl in H.
+  rewrite (bi.pure_True (None = None)) in H; last done; rewrite !bi.True_and in H.
+  rewrite -H; last done; iIntros "(? & _ & $)"; auto.
+- specialize (H EK_break None); simpl in H.
+  rewrite (bi.pure_True (None = None)) in H; last done; rewrite !bi.True_and in H.
+  rewrite -H; last done; iIntros "(? & _ & $)"; auto.
+- specialize (H EK_continue None); simpl in H.
+  rewrite (bi.pure_True (None = None)) in H; last done; rewrite !bi.True_and in H.
+  rewrite -H; last done; iIntros "(? & _ & $)"; auto.
 Qed.
 
 Lemma semax'_post:
- forall {CS: compspecs} {Espec: OracleKind} (R': ret_assert) Delta (R: ret_assert) P c,
-   (forall ek vl rho,  !!(typecheck_environ Delta rho) && 
-                proj_ret_assert R' ek vl rho 
-         |-- proj_ret_assert R ek vl rho) ->
-   semax' Espec Delta P c R' |-- semax' Espec Delta P c R.
+ forall {CS: compspecs} (R': ret_assert) E Delta (R: ret_assert) P c,
+   (forall ek vl, local (typecheck_environ Delta) ∧
+                proj_ret_assert R' ek vl
+         ⊢ proj_ret_assert R ek vl) ->
+   semax' OK_spec E Delta P c R' ⊢ semax' OK_spec E Delta P c R.
 Proof.
 intros.
 apply semax'_post_fupd.
-intros; eapply derives_trans, fupd.fupd_intro; auto.
-intros; apply (H EK_return).
+- by intros; iIntros "? !>"; iApply H.
+- apply (H EK_return).
 Qed.
 
 Lemma semax'_pre_fupd:
- forall {CS: compspecs} {Espec: OracleKind} P' Delta R P c,
-  (forall rho, typecheck_environ Delta rho ->   P rho |-- fupd (P' rho))
-   ->   semax' Espec Delta P' c R |-- semax' Espec Delta P c R.
+ forall {CS: compspecs} (P' : assert) E Delta R (P : assert) c,
+  (forall rho, typecheck_environ Delta rho -> P rho ⊢ |={E}=> (P' rho)) -> 
+  semax' OK_spec E Delta P' c R ⊢ semax' OK_spec E Delta P c R.
 Proof.
 intros.
-repeat rewrite semax_fold_unfold.
-apply allp_derives; intro psi.
-apply allp_derives; intro Delta'.
-apply allp_derives; intro CS'.
-apply prop_imp_derives; intros [TS HGG].
-apply imp_derives; auto.
-apply allp_derives; intro k.
-apply allp_derives; intro F.
-apply allp_derives; intro f.
-apply imp_derives; auto.
-erewrite (guard_tc_environ _ _ _ _ _ (fun rho => P rho)) by eauto.
-rewrite (guard_fupd _ _ _ _ P').
-apply guard_mono.
-intros.
-apply sepcon_derives; auto.
-apply prop_andp_left; auto.
+apply semax'_conseq; intros; [| by iIntros "(_ & _ & $)"..].
+split => ?; monPred.unseal; iIntros "(% & _ & ?)"; iApply H; auto.
 Qed.
 
 Lemma semax'_pre:
- forall {CS: compspecs} {Espec: OracleKind} P' Delta R P c,
-  (forall rho, typecheck_environ Delta rho ->   P rho |-- P' rho)
-   ->   semax' Espec Delta P' c R |-- semax' Espec Delta P c R.
+ forall {CS: compspecs} (P': assert) E Delta R (P: assert) c,
+  (forall rho, typecheck_environ Delta rho -> P rho ⊢ P' rho) ->
+  semax' OK_spec E Delta P' c R ⊢ semax' OK_spec E Delta P c R.
 Proof.
 intros; apply semax'_pre_fupd.
-intros; eapply derives_trans, fupd.fupd_intro; auto.
+by intros; iIntros "? !>"; iApply H.
 Qed.
 
 Lemma semax'_pre_post_fupd:
  forall
-      {CS: compspecs} {Espec: OracleKind} P' (R': ret_assert) Delta (R: ret_assert) P c,
-   (forall rho, typecheck_environ Delta rho ->   P rho |-- fupd (P' rho)) ->
-   (forall ek vl rho, ek <> EK_return -> !!(typecheck_environ Delta rho) 
-                       &&  proj_ret_assert R ek vl rho 
-                    |-- fupd (proj_ret_assert R' ek vl rho)) ->
-   (forall vl rho, !!(typecheck_environ Delta rho) 
-                       &&  RA_return R vl rho 
-                    |-- RA_return R' vl rho) ->
-   semax' Espec Delta P' c R |-- semax' Espec Delta P c R'.
+      {CS: compspecs} (P' : assert) (R': ret_assert) E Delta (R: ret_assert) (P: assert) c,
+   (forall rho, typecheck_environ Delta rho -> P rho ⊢ |={E}=> (P' rho)) ->
+   (forall ek vl, ek <> EK_return -> local (typecheck_environ Delta)
+                       ∧  proj_ret_assert R ek vl
+                    ⊢ |={E}=> proj_ret_assert R' ek vl) ->
+   (forall vl, local (typecheck_environ Delta)
+                       ∧  RA_return R vl
+                    ⊢ RA_return R' vl) ->
+   semax' OK_spec E Delta P' c R ⊢ semax' OK_spec E Delta P c R'.
 Proof.
 intros.
-eapply derives_trans.
-apply semax'_pre_fupd; eauto.
+rewrite semax'_pre_fupd; eauto.
 apply semax'_post_fupd; auto.
 Qed.
 
 Lemma semax'_pre_post:
  forall
-      {CS: compspecs} {Espec: OracleKind} P' (R': ret_assert) Delta (R: ret_assert) P c,
-   (forall rho, typecheck_environ Delta rho ->   P rho |-- P' rho) ->
-   (forall ek vl rho, !!(typecheck_environ Delta rho) 
-                       &&  proj_ret_assert R ek vl rho 
-                    |-- proj_ret_assert R' ek vl rho) ->
-   semax' Espec Delta P' c R |-- semax' Espec Delta P c R'.
+      {CS: compspecs} (P': assert) (R': ret_assert) E Delta (R: ret_assert) (P: assert) c,
+   (forall rho, typecheck_environ Delta rho -> P rho ⊢ P' rho) ->
+   (forall ek vl, local (typecheck_environ Delta)
+                       ∧  proj_ret_assert R ek vl
+                    ⊢ proj_ret_assert R' ek vl) ->
+   semax' OK_spec E Delta P' c R ⊢ semax' OK_spec E Delta P c R'.
 Proof.
 intros.
-eapply derives_trans.
-apply semax'_pre; eauto.
+rewrite semax'_pre; eauto.
 apply semax'_post; auto.
 Qed.
 
-Lemma semax_post'_fupd {CS: compspecs} {Espec: OracleKind}:
- forall (R': ret_assert) Delta (R: ret_assert) P c,
-   (forall ek vl rho, ek <> EK_return -> !!(typecheck_environ Delta rho) 
-                      &&  proj_ret_assert R' ek vl rho
-                        |-- fupd (proj_ret_assert R ek vl rho)) ->
-   (forall vl rho,  !!(typecheck_environ Delta rho) 
-                      &&  RA_return R' vl rho
-                        |-- RA_return R vl rho) ->
-   semax Espec Delta P c R' ->  semax Espec Delta P c R.
+Lemma semax_post'_fupd {CS: compspecs}:
+ forall (R': ret_assert) E Delta (R: ret_assert) P c,
+   (forall ek vl, ek <> EK_return -> local (typecheck_environ Delta)
+                      ∧  proj_ret_assert R' ek vl
+                        ⊢ |={E}=> proj_ret_assert R ek vl) ->
+   (forall vl, local (typecheck_environ Delta)
+                      ∧  RA_return R' vl
+                        ⊢ RA_return R vl) ->
+   semax OK_spec E Delta P c R' ->  semax OK_spec E Delta P c R.
 Proof.
 unfold semax.
 intros.
-specialize (H1 n). revert n H1.
-apply semax'_post_fupd; auto.
+rewrite -semax'_post_fupd; auto.
 Qed.
 
-Lemma semax_post_fupd {CS: compspecs} {Espec: OracleKind}:
- forall (R': ret_assert) Delta (R: ret_assert) P c,
-   (forall rho,  !!(typecheck_environ Delta rho) 
-                      &&  RA_normal R' rho |-- fupd (RA_normal R rho)) ->
-   (forall rho, !! (typecheck_environ Delta rho) 
-                      && RA_break R' rho |-- fupd (RA_break R rho)) ->
-   (forall rho, !! (typecheck_environ Delta rho) 
-                      && RA_continue R' rho |-- fupd (RA_continue R rho)) ->
-   (forall vl rho, !! (typecheck_environ Delta rho) 
-                      && RA_return R' vl rho |-- RA_return R vl rho) ->
-   semax Espec Delta P c R' ->  semax Espec Delta P c R.
+Lemma semax_post_fupd {CS: compspecs}:
+ forall (R': ret_assert) E Delta (R: ret_assert) P c,
+   (local (typecheck_environ Delta)
+                      ∧  RA_normal R' ⊢ |={E}=> RA_normal R) ->
+   (local (typecheck_environ Delta)
+                      ∧ RA_break R' ⊢ |={E}=> RA_break R) ->
+   (local (typecheck_environ Delta)
+                      ∧ RA_continue R' ⊢ |={E}=> RA_continue R) ->
+   (forall vl, local (typecheck_environ Delta)
+                      ∧ RA_return R' vl ⊢ RA_return R vl) ->
+   semax OK_spec E Delta P c R' ->  semax OK_spec E Delta P c R.
 Proof.
 unfold semax.
 intros.
-specialize (H3 n). revert n H3.
-apply semax'_post_fupd; auto.
-intros; destruct ek; try contradiction; simpl;
-repeat (apply normalize.derives_extract_prop; intro); rewrite ?prop_true_andp by auto;
-specialize (H rho); specialize (H0 rho); specialize (H1 rho); specialize (H2 vl rho);
-rewrite ?prop_true_andp in H, H0, H1, H2 by auto; auto.
+rewrite -semax'_post_fupd; auto.
+destruct ek; try contradiction; intros; simpl;
+  iIntros "(? & -> & ?)"; rewrite -> bi.pure_True by done; rewrite bi.True_and; [rewrite -H | rewrite -H0 | rewrite -H1]; auto.
 Qed.
 
-Lemma semax_post' {CS: compspecs} {Espec: OracleKind}:
- forall (R': ret_assert) Delta (R: ret_assert) P c,
-   (forall ek vl rho,  !!(typecheck_environ Delta rho) 
-                      &&  proj_ret_assert R' ek vl rho
-                        |-- proj_ret_assert R ek vl rho) ->
-   semax Espec Delta P c R' ->  semax Espec Delta P c R.
+Lemma semax_post' {CS: compspecs}:
+ forall (R': ret_assert) E Delta (R: ret_assert) P c,
+   (forall ek vl, local (typecheck_environ Delta)
+                      ∧  proj_ret_assert R' ek vl
+                        ⊢ proj_ret_assert R ek vl) ->
+   semax OK_spec E Delta P c R' ->  semax OK_spec E Delta P c R.
 Proof.
 unfold semax.
 intros.
-specialize (H0 n). revert n H0.
-apply semax'_post.
-auto.
-Qed.
-
-Lemma semax_post {CS: compspecs} {Espec: OracleKind}:
- forall (R': ret_assert) Delta (R: ret_assert) P c,
-   (forall rho,  !!(typecheck_environ Delta rho) 
-                      &&  RA_normal R' rho |-- RA_normal R rho) ->
-   (forall rho, !! (typecheck_environ Delta rho) 
-                      && RA_break R' rho |-- RA_break R rho) ->
-   (forall rho, !! (typecheck_environ Delta rho) 
-                      && RA_continue R' rho |-- RA_continue R rho) ->
-   (forall vl rho, !! (typecheck_environ Delta rho) 
-                      && RA_return R' vl rho |-- RA_return R vl rho) ->
-   semax Espec Delta P c R' ->  semax Espec Delta P c R.
+rewrite -semax'_post; auto.
+Qed.
+
+Lemma semax_post {CS: compspecs}:
+ forall (R': ret_assert) E Delta (R: ret_assert) P c,
+   (local (typecheck_environ Delta)
+                      ∧  RA_normal R' ⊢ RA_normal R) ->
+   (local (typecheck_environ Delta)
+                      ∧ RA_break R' ⊢ RA_break R) ->
+   (local (typecheck_environ Delta)
+                      ∧ RA_continue R' ⊢ RA_continue R) ->
+   (forall vl, local (typecheck_environ Delta)
+                      ∧ RA_return R' vl ⊢ RA_return R vl) ->
+   semax OK_spec E Delta P c R' ->  semax OK_spec E Delta P c R.
 Proof.
 unfold semax.
 intros.
-specialize (H3 n). revert n H3.
-apply semax'_post.
-intros; destruct ek; simpl;
-repeat (apply normalize.derives_extract_prop; intro); rewrite ?prop_true_andp by auto;
-specialize (H rho); specialize (H0 rho); specialize (H1 rho); specialize (H2 vl rho);
-rewrite prop_true_andp in H, H0, H1, H2 by auto; auto.
+rewrite -semax'_post; auto.
+destruct ek; simpl; auto; intros;
+  iIntros "(? & -> & ?)"; rewrite -> bi.pure_True by done; rewrite bi.True_and; [rewrite -H | rewrite -H0 | rewrite -H1]; auto.
 Qed.
 
-Lemma semax_pre_fupd {CS: compspecs} {Espec: OracleKind} :
- forall P' Delta P c R,
-   (forall rho,  !!(typecheck_environ Delta rho) &&  P rho |-- fupd (P' rho) )%pred ->
-     semax Espec Delta P' c R  -> semax Espec Delta P c R.
+Lemma semax_pre_fupd {CS: compspecs} :
+ forall P' E Delta P c R,
+   (local (typecheck_environ Delta) ∧ P ⊢ |={E}=> P') ->
+     semax OK_spec E Delta P' c R  -> semax OK_spec E Delta P c R.
 Proof.
 unfold semax.
 intros.
-specialize (H0 n).
-revert n H0.
-apply semax'_pre_fupd.
-intros ????. apply (H rho a); auto. split; auto.
+rewrite -semax'_pre_fupd; auto.
+intros; inversion H as [H']. revert H'; monPred.unseal; intros <-; auto.
 Qed.
 
-Lemma semax_pre {CS: compspecs} {Espec: OracleKind} :
- forall P' Delta P c R,
-   (forall rho,  !!(typecheck_environ Delta rho) &&  P rho |-- P' rho )%pred ->
-     semax Espec Delta P' c R  -> semax Espec Delta P c R.
+Lemma semax_pre {CS: compspecs} :
+ forall P' E Delta P c R,
+   (local (typecheck_environ Delta) ∧ P ⊢ P') ->
+     semax OK_spec E Delta P' c R  -> semax OK_spec E Delta P c R.
 Proof.
 unfold semax.
 intros.
-specialize (H0 n).
-revert n H0.
-apply semax'_pre.
-intros ????. apply (H rho a). split; auto.
-Qed.
-
-Lemma semax_pre_post_fupd {CS: compspecs} {Espec: OracleKind}:
- forall P' (R': ret_assert) Delta P c (R: ret_assert) ,
-   (forall rho,  !!(typecheck_environ Delta rho) &&  P rho |-- fupd (P' rho) )%pred ->
-   (forall rho,  !!(typecheck_environ Delta rho) 
-                      &&  RA_normal R' rho |-- fupd (RA_normal R rho)) ->
-   (forall rho, !! (typecheck_environ Delta rho) 
-                      && RA_break R' rho |-- fupd (RA_break R rho)) ->
-   (forall rho, !! (typecheck_environ Delta rho) 
-                      && RA_continue R' rho |-- fupd (RA_continue R rho)) ->
-   (forall vl rho, !! (typecheck_environ Delta rho) 
-                      && RA_return R' vl rho |-- RA_return R vl rho) ->
-   semax Espec Delta P' c R' ->  semax Espec Delta P c R.
+rewrite -semax'_pre; auto.
+intros; inversion H as [H']; revert H'; monPred.unseal; intros <-; auto.
+Qed.
+
+Lemma semax_pre_post_fupd {CS: compspecs}:
+ forall P' (R': ret_assert) E Delta P c (R: ret_assert) ,
+   (local (typecheck_environ Delta) ∧ P ⊢ |={E}=> P') ->
+   (local (typecheck_environ Delta)
+                      ∧  RA_normal R' ⊢ |={E}=> RA_normal R) ->
+   (local (typecheck_environ Delta)
+                      ∧ RA_break R' ⊢ |={E}=> RA_break R) ->
+   (local (typecheck_environ Delta)
+                      ∧ RA_continue R' ⊢ |={E}=> RA_continue R) ->
+   (forall vl, local (typecheck_environ Delta)
+                      ∧ RA_return R' vl ⊢ RA_return R vl) ->
+   semax OK_spec E Delta P' c R' ->  semax OK_spec E Delta P c R.
 Proof.
 intros.
 eapply semax_pre_fupd; eauto.
 eapply semax_post_fupd; eauto.
 Qed.
 
-Lemma semax_pre_post {CS: compspecs} {Espec: OracleKind}:
- forall P' (R': ret_assert) Delta P c (R: ret_assert) ,
-   (forall rho,  !!(typecheck_environ Delta rho) &&  P rho |-- P' rho )%pred ->
-   (forall rho,  !!(typecheck_environ Delta rho) 
-                      &&  RA_normal R' rho |-- RA_normal R rho) ->
-   (forall rho, !! (typecheck_environ Delta rho) 
-                      && RA_break R' rho |-- RA_break R rho) ->
-   (forall rho, !! (typecheck_environ Delta rho) 
-                      && RA_continue R' rho |-- RA_continue R rho) ->
-   (forall vl rho, !! (typecheck_environ Delta rho) 
-                      && RA_return R' vl rho |-- RA_return R vl rho) ->
-   semax Espec Delta P' c R' ->  semax Espec Delta P c R.
+Lemma semax_pre_post {CS: compspecs}:
+ forall P' (R': ret_assert) E Delta P c (R: ret_assert) ,
+   (local (typecheck_environ Delta) ∧ P ⊢ P') ->
+   (local (typecheck_environ Delta)
+                      ∧  RA_normal R' ⊢ RA_normal R) ->
+   (local (typecheck_environ Delta)
+                      ∧ RA_break R' ⊢ RA_break R) ->
+   (local (typecheck_environ Delta)
+                      ∧ RA_continue R' ⊢ RA_continue R) ->
+   (forall vl, local (typecheck_environ Delta)
+                      ∧ RA_return R' vl ⊢ RA_return R vl) ->
+   semax OK_spec E Delta P' c R' ->  semax OK_spec E Delta P c R.
 Proof.
 intros.
 eapply semax_pre; eauto.
 eapply semax_post; eauto.
 Qed.
 
-Lemma semax_fupd_elim {CS: compspecs} {Espec: OracleKind}:
- forall Delta P c R,
-  semax Espec Delta P c R -> semax Espec Delta (fun rho => fupd (P rho)) c R.
+Lemma semax_fupd_elim {CS: compspecs}:
+ forall E Delta P c R,
+  semax OK_spec E Delta P c R -> semax OK_spec E Delta (|={E}=> P) c R.
 Proof.
-intros ????; apply semax_pre_fupd.
-intro; apply prop_andp_left; auto.
+intros; eapply semax_pre_fupd, H.
+by intros; rewrite bi.and_elim_r.
 Qed.
 
-Lemma semax_skip {CS: compspecs} {Espec: OracleKind}:
-   forall Delta P, semax Espec Delta P Sskip (normal_ret_assert P).
+Lemma semax_skip {CS: compspecs}:
+   forall E Delta P, semax OK_spec E Delta P Sskip (normal_ret_assert P).
 Proof.
 intros.
 apply derives_skip.
 intros.
-simpl.
-rewrite prop_true_andp by auto.
-auto.
+rewrite /= bi.pure_True // left_id //.
 Qed.
 
 (*Taken from floyd.SeparationLogicFacts.v*)
 Lemma semax_extract_prop:
-  forall {CS: compspecs} {Espec: OracleKind},
-  forall Delta (PP: Prop) (P:assert) c (Q:ret_assert),
-           (PP -> @semax CS Espec Delta P c Q) ->
-           @semax CS Espec Delta (fun rho => !!PP && P rho) c Q.
+  forall {CS: compspecs},
+  forall E Delta (PP: Prop) (P:assert) c (Q:ret_assert),
+           (PP -> semax OK_spec E Delta P c Q) ->
+           semax OK_spec E Delta (⌜PP⌝ ∧ P) c Q.
 Proof.
   intros.
-  eapply semax_pre with (fun rho => EX H: PP, P rho).
-  + intros. apply andp_left2.
-    apply normalize.derives_extract_prop; intros.
-    apply (exp_right H0), derives_refl.
+  eapply semax_pre with (∃ H: PP, P).
+  + intros; iIntros "(? & %HPP & ?)"; iExists HPP; auto.
   + apply extract_exists_pre, H.
 Qed.
 
-Lemma semax_adapt_frame {cs Espec} Delta c (P P': assert) (Q Q' : ret_assert)
-   (H: forall rho,  derives (!!(typecheck_environ Delta rho) && (allp_fun_id Delta rho && P rho))
-                   (EX F: assert, (!!(closed_wrt_modvars c F) && fupd (P' rho * F rho) &&
-                         !!(forall rho, (local (tc_environ Delta) rho) && ((allp_fun_id Delta rho)) && RA_normal (frame_ret_assert Q' F) rho |-- fupd (RA_normal Q rho)) &&
-                         !!(forall rho, (local (tc_environ Delta) rho) && ((allp_fun_id Delta rho)) && RA_break (frame_ret_assert Q' F) rho |-- fupd (RA_break Q rho)) &&
-                         !!(forall rho, (local (tc_environ Delta) rho) && ((allp_fun_id Delta rho)) && RA_continue (frame_ret_assert Q' F) rho |-- fupd (RA_continue Q rho)) &&
-                         !!(forall vl rho, (local (tc_environ Delta) rho) && ((allp_fun_id Delta rho)) && RA_return (frame_ret_assert Q' F) vl rho |-- RA_return Q vl rho))))
-   (SEM: @semax cs Espec Delta P' c Q'):
-   @semax cs Espec Delta P c Q.
-Proof. intros.
-apply (semax_conseq Delta (fun rho => EX F: assert, !!(closed_wrt_modvars c F) && (fupd (sepcon (P' rho) (F rho)) &&
-                         (!!(forall rho, (local (tc_environ Delta) rho) && ((allp_fun_id Delta rho)) && RA_normal (frame_ret_assert Q' F) rho |-- fupd (RA_normal Q rho)) &&
-                         (!!(forall rho, (local (tc_environ Delta) rho) && ((allp_fun_id Delta rho)) && RA_break (frame_ret_assert Q' F) rho |-- fupd (RA_break Q rho)) &&
-                         (!!(forall rho, (local (tc_environ Delta) rho) && ((allp_fun_id Delta rho)) && RA_continue (frame_ret_assert Q' F) rho |-- fupd (RA_continue Q rho)) &&
-                         (!!(forall vl rho, (local (tc_environ Delta) rho) && ((allp_fun_id Delta rho)) && RA_return (frame_ret_assert Q' F) vl rho |-- RA_return Q vl rho)))))))
-   Q).
-+ intros. eapply seplog.derives_trans. constructor. apply H. clear H.
-  eapply seplog.derives_trans. 2: { constructor. apply fupd.fupd_intro. }
-  constructor. apply exp_derives; intros F. 
-  rewrite <- ! andp_assoc; trivial.
-+ clear H. intros. constructor. eapply derives_trans, fupd.fupd_intro.
-  do 2 apply andp_left2; trivial.
-+ clear H. intros. constructor. eapply derives_trans, fupd.fupd_intro.
-  do 2 apply andp_left2; trivial.
-+ clear H. intros. constructor. eapply derives_trans, fupd.fupd_intro.
-  do 2 apply andp_left2; trivial.
-+ clear H. intros. constructor.
-  do 2 apply andp_left2; trivial.
-+ apply extract_exists_pre. intros F. clear H.
+Lemma semax_adapt_frame {cs} E Delta c (P P': assert) (Q Q' : ret_assert)
+   (H: local (typecheck_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢
+                   ∃ F: assert, (⌜closed_wrt_modvars c F⌝ ∧ |={E}=> (P' ∗ F) ∧
+                         ⌜local (tc_environ Delta) ∧ <affine> allp_fun_id Delta ∗ RA_normal (frame_ret_assert Q' F) ⊢ |={E}=> RA_normal Q⌝ ∧
+                         ⌜local (tc_environ Delta) ∧ <affine> allp_fun_id Delta ∗ RA_break (frame_ret_assert Q' F) ⊢ |={E}=> RA_break Q⌝ ∧
+                         ⌜local (tc_environ Delta) ∧ <affine> allp_fun_id Delta ∗ RA_continue (frame_ret_assert Q' F) ⊢ |={E}=> RA_continue Q⌝ ∧
+                         ⌜forall vl, local (tc_environ Delta) ∧ <affine> allp_fun_id Delta ∗ RA_return (frame_ret_assert Q' F) vl ⊢ RA_return Q vl⌝))
+   (SEM: semax(CS := cs) OK_spec E Delta P' c Q'):
+   semax OK_spec E Delta P c Q.
+Proof.
+  intros.
+  eapply semax_conseq; [| by intros; iIntros "(_ & _ & $)" .. |].
+  { by intros; iIntros "? !>"; iApply (H with "[-]"). }
+  apply extract_exists_pre. intros F. clear H.
   apply semax_extract_prop. intros.
-  eapply semax_pre_fupd. 2:{ do 4 (apply semax_extract_prop; intros). 
+  eapply semax_pre_fupd. 2:{ do 4 (apply semax_extract_prop; intros).
     eapply semax_conseq. 6:{ apply semax_frame. exact H. apply SEM. }
-    2: {
-    intros; constructor.
-    revert rho. exact H0. }
-    2: {
-    intros; constructor.
-    revert rho. exact H1. }
-    2: {
-    intros; constructor.
-    revert rho. exact H2. }
-    2: {
-    intros; constructor.
-    revert rho. revert vl. exact H3. }
-
-   intros; constructor. eapply derives_trans; [ | apply fupd.fupd_intro].
-   apply andp_left2. apply andp_left2. apply derives_refl. }
-  intros. unfold local, liftx, lift1, tc_environ; simpl. apply andp_left2.
-  rewrite (andp_comm (fupd (P' rho * F rho))). eapply derives_trans, fupd.fupd_andp_prop.
-  rewrite andp_assoc; apply andp_derives; [apply prop_derives; intros; rewrite <- andp_assoc; auto|].
-  eapply derives_trans, fupd.fupd_andp_prop.
-  rewrite andp_assoc; apply andp_derives; [apply prop_derives; intros; rewrite <- andp_assoc; auto|].
-  eapply derives_trans, fupd.fupd_andp_prop.
-  rewrite andp_assoc; apply andp_derives; [apply prop_derives; intros; rewrite <- andp_assoc; auto|].
-  eapply derives_trans, fupd.fupd_andp_prop.
-  apply andp_derives; [apply prop_derives; intros; rewrite <- andp_assoc; auto|].
-  auto.
-Qed.
-
-Lemma semax_adapt_frame' {cs Espec} Delta c (P P': assert) (Q Q' : ret_assert)
-   (H: forall rho,  !!(typecheck_environ Delta rho) && (allp_fun_id Delta rho && P rho)
-                   |-- EX F: assert, (!!(closed_wrt_modvars c F) && fupd (P' rho * F rho) &&
-                        !!(forall rho, RA_normal (frame_ret_assert Q' F) rho |-- fupd (RA_normal Q rho)) &&
-                        !!(forall rho, RA_break (frame_ret_assert Q' F) rho |-- fupd (RA_break Q rho)) &&
-                        !!(forall rho, RA_continue (frame_ret_assert Q' F) rho |-- fupd (RA_continue Q rho)) &&
-                        !!(forall vl rho, RA_return (frame_ret_assert Q' F) vl rho |-- RA_return Q vl rho)))
-   (SEM: @semax cs Espec Delta P' c Q'):
-   @semax cs Espec Delta P c Q.
-Proof.
-  intros. eapply semax_adapt_frame. 2: apply SEM.
-  intros. eapply derives_trans. apply H. 
-  clear. apply exp_derives. intros FR.
-  rewrite ! andp_assoc.
-  apply andp_derives; trivial.
-  apply andp_derives; trivial.
-  apply andp_derives. 
-  { apply prop_derives; intros. eapply derives_trans. 2: apply H. apply andp_left2; trivial. }
-  apply andp_derives. 
-  { apply prop_derives; intros. eapply derives_trans. 2: apply H. apply andp_left2; trivial. }
-  apply andp_derives. 
-  { apply prop_derives; intros. eapply derives_trans. 2: apply H. apply andp_left2; trivial. }
-  { apply prop_derives; intros. eapply derives_trans. 2: apply H. apply andp_left2; trivial. }
-Qed.
-
-Lemma semax_adapt {cs Espec} Delta c (P P': assert) (Q Q' : ret_assert)
-   (H: forall rho,  !!(typecheck_environ Delta rho) && (allp_fun_id Delta rho && P rho)
-                   |-- (fupd (P' rho) &&
-                        !!(forall rho, RA_normal Q' rho |-- fupd (RA_normal Q rho)) &&
-                        !!(forall rho, RA_break Q' rho |-- fupd (RA_break Q rho)) &&
-                        !!(forall rho, RA_continue Q' rho |-- fupd (RA_continue Q rho)) &&
-                        !!(forall vl rho, RA_return Q' vl rho |-- RA_return Q vl rho)))
-   (SEM: @semax cs Espec Delta P' c Q'):
-   @semax cs Espec Delta P c Q.
-Proof.
-  intros. eapply semax_adapt_frame'; eauto. intros. exists (fun rho => emp).
-  apply H in H0; clear H.
-  destruct H0 as [[[[HP' NORM] BREAK] CONT] RET]. simpl in NORM, BREAK, CONT, RET.
-  rewrite sepcon_emp. repeat split; auto; simpl; intros.
-  + eapply derives_trans; [ | apply NORM]; clear.
-    destruct Q'; simpl; rewrite sepcon_emp; trivial.
-  + eapply derives_trans; [ | apply BREAK]; clear.
-    destruct Q'; simpl; rewrite sepcon_emp; trivial.
-  + eapply derives_trans; [ | apply CONT]; clear.
-    destruct Q'; simpl; rewrite sepcon_emp; trivial.
-  + eapply derives_trans; [ | apply RET]; clear.
-    destruct Q'; simpl; rewrite sepcon_emp; trivial.
-Qed.
+    2: { exact H0. }
+    2: { exact H1. }
+    2: { exact H2. }
+    2: { exact H3. }
+   intros; iIntros "(_ & _ & P) !>"; iApply "P". }
+  intros. unfold local, liftx, lift1, tc_environ; simpl.
+  by iIntros "[_ >[$ %]]"; iPureIntro; rewrite and_True.
+Qed.
+
+Lemma semax_adapt_frame' {cs} E Delta c (P P': assert) (Q Q' : ret_assert)
+   (H: local (typecheck_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢
+                   ∃ F: assert, (⌜closed_wrt_modvars c F⌝ ∧ |={E}=> (P' ∗ F) ∧
+                         ⌜RA_normal (frame_ret_assert Q' F) ⊢ |={E}=> RA_normal Q⌝ ∧
+                         ⌜RA_break (frame_ret_assert Q' F) ⊢ |={E}=> RA_break Q⌝ ∧
+                         ⌜RA_continue (frame_ret_assert Q' F) ⊢ |={E}=> RA_continue Q⌝ ∧
+                         ⌜forall vl, RA_return (frame_ret_assert Q' F) vl ⊢ RA_return Q vl⌝))
+   (SEM: semax(CS := cs) OK_spec E Delta P' c Q'):
+   semax OK_spec E Delta P c Q.
+Proof.
+  intros. eapply semax_adapt_frame, SEM.
+  intros. rewrite H.
+  apply bi.exist_mono; intros.
+  iIntros "[$ >[$ (% & % & % & %)]]"; iPureIntro; split; auto.
+  split3; last split; intros; rewrite /bi_affinely bi.and_elim_r bi.and_elim_l left_id; auto.
+Qed.
+
+Lemma semax_adapt {cs} E Delta c (P P': assert) (Q Q' : ret_assert)
+   (H: local (typecheck_environ Delta) ∧ (<affine> allp_fun_id Delta ∗ P) ⊢
+                   (|={E}=> P' ∧
+                        ⌜RA_normal Q' ⊢ |={E}=> RA_normal Q⌝ ∧
+                        ⌜RA_break Q' ⊢ |={E}=> RA_break Q⌝ ∧
+                        ⌜RA_continue Q' ⊢ |={E}=> RA_continue Q⌝ ∧
+                        ⌜forall vl, RA_return Q' vl ⊢ RA_return Q vl⌝))
+   (SEM: semax(CS := cs) OK_spec E Delta P' c Q'):
+   semax OK_spec E Delta P c Q.
+Proof.
+  intros. eapply semax_adapt_frame'; eauto. intros. rewrite H; iIntros "H"; iExists emp.
+  iSplit.
+  { iPureIntro; monPred.unseal; done. }
+  iMod "H" as "($ & %NORM & %BREAK & %CONT & %RET)"; iPureIntro; split; auto.
+  destruct Q'; simpl in *.
+  split3; last split; intros; rewrite right_id; auto.
+Qed.
+
+End mpred.
diff --git a/veric/semax_ext.v b/veric/semax_ext.v
index a098ddeeef..19fc1c9f07 100644
--- a/veric/semax_ext.v
+++ b/veric/semax_ext.v
@@ -1,19 +1,22 @@
+Require Import Coq.Logic.JMeq.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.juicy_base.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.juicy_mem.
 Require Import VST.veric.juicy_mem_lemmas.
-Require Import VST.veric.juicy_mem_ops.
+(*Require Import VST.veric.juicy_mem_ops.*)
 Require Import VST.sepcomp.extspec.
 Require Import VST.veric.juicy_extspec.
 Require Import VST.veric.tycontext.
 Require Import VST.veric.expr2.
 Require Import VST.veric.semax.
 Require Import VST.veric.semax_call.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Import VST.veric.external_state.
 Require Import VST.veric.res_predicates.
-
-Require Import VST.veric.res_predicates.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import compcert.cfrontend.Clight.
 Require Import compcert.export.Clightdefs.
-Import compcert.lib.Maps.
 
 Definition funsig2signature (s : funsig) cc : signature :=
   mksignature (map argtype_of_type (map snd (fst s))) (rettype_of_type (snd s)) cc.
@@ -31,17 +34,19 @@ Definition typesig2signature (s : typesig) cc : signature :=
 Definition ef_id_sig (ext_link: Strings.String.string -> ident) ef :=
   match ef with EF_external id sig => Some (ext_link id, sig) | _ => None end.
 
-Section funspecs2jspec.
+Section mpred.
+
+Context (Z : Type) `{!VSTGS Z Σ}.
 
-Variable Z : Type.
+Section funspecs2jspec.
 
-Variable Espec : juicy_ext_spec Z.
+Variable Espec : ext_spec Z.
 
-Definition symb2genv_upper_bound (s: PTree.t block) : block :=
-  Pos.succ (fold_right Pos.max  1%positive (map snd (PTree.elements s))).
+Definition symb2genv_upper_bound (s: Maps.PTree.t block) : block :=
+  Pos.succ (fold_right Pos.max  1%positive (map snd (Maps.PTree.elements s))).
 
 Definition symb2genv (ge_s: injective_PTree block) : genv.
-    refine (Build_genv (@Genv.mkgenv _ _ nil (proj1_sig ge_s) (PTree.empty _) (symb2genv_upper_bound (proj1_sig ge_s)) _ _ _) (PTree.empty _)).
+    refine (Build_genv (@Genv.mkgenv _ _ nil (proj1_sig ge_s) (Maps.PTree.empty _) (symb2genv_upper_bound (proj1_sig ge_s)) _ _ _) (Maps.PTree.empty _)).
 *
 intros.
 unfold Coqlib.Plt.
@@ -50,9 +55,9 @@ apply Pos.lt_succ_r.
 apply Pos.le_refl.
 unfold symb2genv_upper_bound.
 apply -> Pos.succ_le_mono.
-apply PTree.elements_correct in H.
+apply Maps.PTree.elements_correct in H.
 revert H.
-induction (PTree.elements (proj1_sig ge_s)); intros. inv H.
+induction (Maps.PTree.elements (proj1_sig ge_s)); intros. inv H.
 destruct H. subst. simpl.
 apply Pos.le_max_l.
 simpl.
@@ -60,7 +65,7 @@ eapply Pos.le_trans; [  | apply Pos.le_max_r].
 auto.
 *
 intros.
-rewrite PTree.gempty in H. inv H.
+rewrite Maps.PTree.gempty in H. inv H.
 *
 intros.
 destruct ge_s; simpl in *.
@@ -89,65 +94,53 @@ Proof.
   intros; repeat (apply eq_dec || decide equality).
 Qed.
 
+Definition funspec2pre' (A : TypeTree) (P: dtfr (ArgsTT A)) (x : (nat * iResUR Σ * ofe_car (dtfr A))%type) (ge_s: injective_PTree block) sig args z m :=
+  let '(n, phi, x') := x in ✓{n} phi /\ Val.has_type_list args sig /\
+    ouPred_holds (state_interp m z ∗ P x' (filter_genv (symb2genv ge_s), args)) n phi.
+
 Definition funspec2pre (ext_link: Strings.String.string -> ident) (A : TypeTree)
-  (P: forall ts, dependent_type_functor_rec ts (ArgsTT A) mpred)
+  (P: dtfr (ArgsTT A))
   (id: ident) (sig : signature) (ef: external_function) x (ge_s: injective_PTree block)
            (tys : list typ) args (z : Z) m : Prop :=
   match oi_eq_dec (Some (id, sig)) (ef_id_sig ext_link ef) as s
-  return ((if s then (rmap*(sigT (fun ts => dependent_type_functor_rec ts A mpred)))%type else ext_spec_type Espec ef) -> Prop)
+  return ((if s then (nat * iResUR Σ * ofe_car (dtfr A))%type else ext_spec_type Espec ef) -> Prop)
   with
-    | left _ => fun x' => Val.has_type_list args (map proj_xtype (sig_args (ef_sig ef))) /\
-        exists phi0 phi1, join phi0 phi1 (m_phi m)
-                       /\ P (projT1 (snd x')) (projT2 (snd x')) (filter_genv (symb2genv ge_s), args) phi0
-                       /\ necR (fst x') phi1 /\ ext_compat z (m_phi m)
+    | left _ => fun x => funspec2pre' A P x ge_s (map proj_xtype (sig_args (ef_sig ef))) args z m
     | right n => fun x' => ext_spec_pre Espec ef x' ge_s tys args z m
   end x.
 
-Definition funspec2post (ext_link: Strings.String.string -> ident) (A : TypeTree)
-  (Q: forall ts, dependent_type_functor_rec ts (AssertTT A) mpred)
-  id sig ef x ge_s (tret : xtype) ret (z : Z) m : Prop :=
-  match oi_eq_dec (Some (id, sig)) (ef_id_sig ext_link ef) as s
-  return ((if s then (rmap*(sigT (fun ts => dependent_type_functor_rec ts A mpred)))%type else ext_spec_type Espec ef) -> Prop)
-  with
-    | left _ => fun x' => exists phi0 phi1, join phi0 phi1 (m_phi m)
-                       /\ Q (projT1 (snd x')) (projT2 (snd x')) (make_ext_rval (filter_genv (symb2genv ge_s)) tret ret) phi0
-                       /\ necR (fst x') phi1
-    | right n => fun x' => ext_spec_post Espec ef x' ge_s tret ret z m
-  end x.
+Definition funspec2post' (A : TypeTree) (Q: dtfr (AssertTT A)) (x : (nat * iResUR Σ * ofe_car (dtfr A))%type) (ge_s: injective_PTree block) tret ret z m :=
+  let '(n, phi, x') := x in ouPred_holds (|==> state_interp m z ∗ Q x' (make_ext_rval (filter_genv (symb2genv ge_s)) tret ret)) n phi.
 
-Definition funspec2post' (ext_link: Strings.String.string -> ident) (A : TypeTree)
-  (Q: forall ts, dependent_type_functor_rec ts (AssertTT A) mpred)
+Definition funspec2post (ext_link: Strings.String.string -> ident) (A : TypeTree)
+  (Q: dtfr (AssertTT A))
   id sig ef x ge_s (tret : xtype) ret (z : Z) m : Prop :=
   match oi_eq_dec (Some (id, sig)) (ef_id_sig ext_link ef) as s
-  return ((if s then (rmap*(sigT (fun ts => dependent_type_functor_rec ts A mpred)))%type else ext_spec_type Espec ef) -> Prop)
+  return ((if s then (nat * iResUR Σ * ofe_car (dtfr A))%type else ext_spec_type Espec ef) -> Prop)
   with
-    | left _ => fun x' => exists phi0 phi1, join phi0 phi1 (m_phi m)
-                       /\ Q (projT1 (snd x')) (projT2 (snd x')) (make_ext_rval (filter_genv (symb2genv ge_s)) tret ret) phi0
-                       /\ necR (fst x') phi1
+    | left _ => fun x => funspec2post' A Q x ge_s tret ret z m
     | right n => fun x' => ext_spec_post Espec ef x' ge_s tret ret z m
   end x.
 
 Definition funspec2extspec (ext_link: Strings.String.string -> ident) (f : (ident*funspec))
-  : external_specification juicy_mem external_function Z :=
+  : external_specification mem external_function Z :=
   match f with
-    | (id, mk_funspec ((params, sigret) as fsig) cc A P Q NEP NEQ) =>
+    | (id, mk_funspec ((params, sigret) as fsig) cc A E P Q) =>
       let sig := typesig2signature fsig cc in
-      Build_external_specification juicy_mem external_function Z
-        (fun ef => if oi_eq_dec (Some (id, sig)) (ef_id_sig ext_link ef) then (rmap* (sigT (fun ts => dependent_type_functor_rec ts A mpred)))%type else ext_spec_type Espec ef)
+      Build_external_specification mem external_function Z
+        (fun ef => if oi_eq_dec (Some (id, sig)) (ef_id_sig ext_link ef) then (nat * iResUR Σ * dtfr A)%type else ext_spec_type Espec ef)
         (funspec2pre ext_link A P id sig)
         (funspec2post ext_link A Q id sig)
-        (fun rv z m => True)
+        (fun rv z m => True%type)
   end.
 
-Local Open Scope pred.
-
 Definition wf_funspec (f : funspec) :=
   match f with
-    | mk_funspec sig cc A P Q _ _ =>
-        forall ts a (ge ge': genv)  args,
+    | mk_funspec sig cc E A P Q =>
+        forall a (ge ge': genv) args,
           Genv.genv_symb ge = Genv.genv_symb ge' ->
-          P ts a (filter_genv ge, args) 
-         |-- P ts a (filter_genv ge', args)
+          P a (filter_genv ge, args) 
+         ⊢ P a (filter_genv ge', args)
   end.
 
 Lemma make_ext_args_filtergenv (ge ge' : genv)
@@ -161,356 +154,173 @@ Qed.
 
 Lemma all_funspecs_wf f : wf_funspec f.
 Proof.
-destruct f; simpl; intros ts a ge ge' n args H.
+destruct f; simpl; intros a ge ge' args H.
 erewrite make_ext_args_filtergenv; eauto.
 Qed.
 
 #[local] Obligation Tactic := idtac.
 
-Program Definition funspec2jspec (ext_link: Strings.String.string -> ident) f : juicy_ext_spec Z :=
-  Build_juicy_ext_spec _ (funspec2extspec ext_link f) _ _ _ _ _ _.
-Next Obligation.
-destruct f; simpl; unfold funspec2pre, pureat; simpl; destruct f; simpl;
-  destruct t; simpl; intros.
-if_tac [e0|e0].
-* destruct e; try discriminate; injection e0 as E; subst i sg; intros a a' Hage.
-intros [Hargs H].
-split; auto.
-apply age_jm_phi in Hage.
-destruct H as [phi0 [phi1 [Hjoin [Hx [Hy Hg]]]]].
-destruct (age1_join2 phi0 Hjoin Hage) as [x' [y' [Hjoin' [Hage' H]]]].
-exists x', y'; split; auto.
-destruct P as (? & h & ?). split. eapply h; eauto.
-split. apply (necR_trans (fst t0) phi1 y'); auto.
-unfold necR. constructor; auto.
-unfold ext_compat in *; rewrite (age1_ghost_of _ _ Hage).
-apply ext_join_approx; auto.
-* intros ? ?; auto.
-destruct Espec; simpl; apply JE_pre_hered.
-Qed.
-Next Obligation.
-destruct f; simpl; unfold funspec2pre, pureat; simpl; destruct f; simpl;
-  destruct t; simpl; intros.
-if_tac [e0|e0].
-* destruct e; try discriminate; injection e0 as E; subst i sg.
-destruct H as [_ Hext]; apply rmap_order in Hext as (Hl & Hr & J).
-destruct H1 as [? H].
-split; auto.
-destruct H as [phi0 [phi1 [Hjoin [Hx [Hy Hg]]]]].
-destruct J as [? J]; destruct (join_assoc (join_comm (ghost_of_join _ _ _ Hjoin)) J) as (g' & ? & ?).
-destruct (make_rmap (resource_at phi0) (own.ghost_approx (level phi0) g') (level phi0))
-  as (phi0' & Hl' & Hr' & Hg').
-{ extensionality; apply resource_at_approx. }
-{ rewrite ghost_fmap_fmap, !approx_oo_approx; auto. }
-destruct (join_level _ _ _ Hjoin).
-exists phi0', phi1; repeat split; auto.
-+ apply resource_at_join2; try congruence.
-  - intros; rewrite Hr', <- Hr.
-    apply resource_at_join; auto.
-  - rewrite Hg'.
-    rewrite <- (ghost_of_approx phi1), <- (ghost_of_approx (m_phi a')), <- Hl, H3, H4.
-    apply ghost_fmap_join; auto.
-+ eapply pred_upclosed, Hx.
-  rewrite rmap_order; repeat split; auto.
-  rewrite Hg'.
-  rewrite <- ghost_of_approx; eexists; apply ghost_fmap_join; eauto.
-* eapply JE_pre_ext, H1; auto.
-Qed.
-Next Obligation.
-destruct f; simpl; unfold funspec2post, pureat; simpl; destruct f; simpl;
-  destruct t; simpl; intros.
-if_tac [e0|e0].
-* destruct e; try discriminate; injection e0 as E; subst i sg. intros a a' Hage. destruct Q as (? & h & ?); simpl.
-intros [phi0 [phi1 [Hjoin [Hx Hy]]]].
-apply age_jm_phi in Hage.
-destruct (age1_join2 phi0 Hjoin Hage) as [x' [y' [Hjoin' [Hage' H]]]].
-exists x', y'; split; auto.
-split; [solve[eapply h; eauto]|].
-apply (necR_trans (fst t0) phi1 y'); auto.
-unfold necR. constructor; auto.
-* intros ? ?; auto.
-destruct Espec; simpl; apply JE_post_hered.
-Qed.
-Next Obligation.
-destruct f; simpl; unfold funspec2post, pureat; simpl; destruct f; simpl;
-  destruct t; simpl; intros.
-if_tac [e0|e0].
-* destruct e; try discriminate; injection e0 as E; subst i sg. intros a a' Hext. destruct Q as (? & h & e); simpl.
-intros [phi0 [phi1 [Hjoin [Hx Hy]]]].
-destruct Hext as [_ Hext]; apply rmap_order in Hext as (Hl & Hr & ? & J).
-destruct (join_assoc (join_comm (ghost_of_join _ _ _ Hjoin)) J) as (g' & ? & ?).
-destruct (make_rmap (resource_at phi0) (own.ghost_approx (level phi0) g') (level phi0))
-  as (phi0' & Hl' & Hr' & Hg').
-{ extensionality; apply resource_at_approx. }
-{ rewrite ghost_fmap_fmap, !approx_oo_approx; auto. }
-destruct (join_level _ _ _ Hjoin).
-exists phi0', phi1; repeat split; auto.
-+ apply resource_at_join2; try congruence.
-  - intros; rewrite Hr', <- Hr.
-    apply resource_at_join; auto.
-  - rewrite Hg'.
-    rewrite <- (ghost_of_approx phi1), <- (ghost_of_approx (m_phi a')), <- Hl, H1, H2.
-    apply ghost_fmap_join; auto.
-+ eapply e, Hx.
-  rewrite rmap_order; repeat split; auto.
-  rewrite Hg'.
-  rewrite <- ghost_of_approx; eexists; apply ghost_fmap_join; eauto.
-* intros ? ?; auto.
-destruct Espec; simpl; apply JE_post_ext.
-Qed.
-Next Obligation.
-intros ? ? ? ?; destruct f; destruct f; destruct t; simpl.
-intros a' Hage; auto.
-Qed.
-Next Obligation.
-intros ? ? ? ?; destruct f; destruct f; destruct t; simpl.
-intros a' Hext; auto.
-Qed.
+Definition funspec2jspec (ext_link: Strings.String.string -> ident) f : ext_spec Z :=
+  funspec2extspec ext_link f.
 
 End funspecs2jspec.
 
-Definition funspecs_norepeat (fs : funspecs) := list_norepet (map fst fs).
+Definition funspecs_norepeat (fs : funspecs(Σ := Σ)) := list_norepet (map fst fs).
 
-Fixpoint add_funspecs_rec (ext_link: Strings.String.string -> ident) (Z : Type) (Espec : juicy_ext_spec Z) (fs : funspecs) :=
+Fixpoint add_funspecs_rec (ext_link: Strings.String.string -> ident) (Espec : ext_spec Z) (fs : funspecs) :=
   match fs with
     | nil => Espec
-    | cons (i,f) fs' => funspec2jspec Z (add_funspecs_rec ext_link Z Espec fs') ext_link (i,f)
+    | cons (i,f) fs' => funspec2jspec (add_funspecs_rec ext_link Espec fs') ext_link (i,f)
   end.
 
-Require Import Coq.Logic.JMeq.
-
-Lemma add_funspecs_pre  (ext_link: Strings.String.string -> ident)
-              {Z fs id sig cc A P Q NEP NEQ}
-              {x: sigT (fun ts => dependent_type_functor_rec ts A mpred)} {args m} Espec tys ge_s phi0 phi1 :
+Lemma add_funspecs_pre (ext_link: Strings.String.string -> ident)
+              {fs id sig cc A E P Q}
+              Espec tys ge_s {x} {args} m z :
   let ef := EF_external id (typesig2signature sig cc) in
   funspecs_norepeat fs ->
-  In (ext_link id, (mk_funspec sig cc A P Q NEP NEQ)) fs ->
-  join phi0 phi1 (m_phi m) ->
-  Val.has_type_list args (map proj_xtype (sig_args (ef_sig ef))) ->
-  P (projT1 x) (projT2 x) (filter_genv (symb2genv ge_s), args) phi0 ->
-  exists x' : ext_spec_type (JE_spec _ (add_funspecs_rec ext_link Z Espec fs)) ef,
-    JMeq (phi1, x) x'
-    /\ forall z, ext_compat z (m_phi m) ->
-          ext_spec_pre (add_funspecs_rec ext_link Z Espec fs) ef x' ge_s tys args z m.
+  In (ext_link id, (mk_funspec sig cc A E P Q)) fs -> ∃ H : ext_spec_type (add_funspecs_rec ext_link Espec fs) ef = (nat * iResUR Σ * dtfr A)%type,
+  ext_spec_pre (add_funspecs_rec ext_link Espec fs) ef x ge_s tys args z m =
+  funspec2pre' A P (eq_rect _ Datatypes.id x _ H) ge_s (map proj_xtype (sig_args (ef_sig ef))) args z m.
 Proof.
-induction fs; [intros; exfalso; auto|]; intros ef H H1 H2 Hargsty Hpre.
-destruct H1 as [H1|H1].
-
-{
-subst a; simpl in *.
-clear IHfs H; revert x H2 Hpre; unfold funspec2pre; simpl.
-destruct sig; simpl.
-if_tac [e0|e0].
-intros x Hjoin Hp. exists (phi1, x). split; eauto.
-split; eauto 6.
-exfalso; auto.
-}
+  induction fs; [intros; exfalso; auto|]; intros ?? [-> | H1]; simpl in *.
+  - clear IHfs H; unfold funspec2jspec; simpl.
+    destruct sig; unfold funspec2pre, funspec2post; simpl in *.
+    revert x; if_tac; simpl; last done.
+    intros; exists eq_refl; tauto.
+  - assert (Hin: In (ext_link id) (map fst fs)).
+    { eapply (in_map fst) in H1; apply H1. }
+    inversion H as [|? ? Ha Hb]; subst.
+    destruct a; simpl; destruct f as [(?, ?)]; simpl; unfold funspec2pre, funspec2post; simpl.
+    revert x; simpl; if_tac [e | e].
+    { injection e as ?; subst i; destruct fs; [solve [simpl; intros; exfalso; auto]|]; done. }
+    intros; apply IHfs; auto.
+Qed.
 
-{
-assert (Hin: In (ext_link id) (map fst fs)).
-{ eapply (in_map fst) in H1; apply H1. }
-inversion H as [|? ? Ha Hb]; subst.
-destruct (IHfs Hb H1 H2 Hargsty Hpre) as [x' H3].
-clear -Ha Hin H1 H3; revert x' Ha Hin H1 H3.
-destruct a; simpl; destruct f; simpl; destruct t; simpl; unfold funspec2pre; simpl.
-if_tac [e|e].
-* injection e as E; subst i; destruct fs; [solve[simpl; intros; exfalso; auto]|].
-  intros x' Ha Hb; simpl in Ha, Hb.
-  exfalso; auto.
-* intros; eexists; eauto.
-}
+Lemma add_funspecs_post (ext_link: Strings.String.string -> ident)
+              {fs id sig cc A E P Q}
+              Espec ty ge_s {x} {v} m z :
+  let ef := EF_external id (typesig2signature sig cc) in
+  funspecs_norepeat fs ->
+  In (ext_link id, (mk_funspec sig cc A E P Q)) fs -> ∃ H : ext_spec_type (add_funspecs_rec ext_link Espec fs) ef = (nat * iResUR Σ * dtfr A)%type,
+  ext_spec_post (add_funspecs_rec ext_link Espec fs) ef x ge_s ty v z m =
+  funspec2post' A Q (eq_rect _ Datatypes.id x _ H) ge_s ty v z m.
+Proof.
+  induction fs; [intros; exfalso; auto|]; intros ?? [-> | H1]; simpl in *.
+  - clear IHfs H; unfold funspec2jspec; simpl.
+    destruct sig; unfold funspec2pre, funspec2post; simpl in *.
+    revert x; if_tac; simpl; last done.
+    intros; exists eq_refl; tauto.
+  - assert (Hin: In (ext_link id) (map fst fs)).
+    { eapply (in_map fst) in H1; apply H1. }
+    inversion H as [|? ? Ha Hb]; subst.
+    destruct a; simpl; destruct f as [(?, ?)]; simpl; unfold funspec2pre, funspec2post; simpl.
+    revert x; simpl; if_tac [e | e].
+    { injection e as ?; subst i; destruct fs; [solve [simpl; intros; exfalso; auto]|]; done. }
+    intros; apply IHfs; auto.
 Qed.
 
-Lemma add_funspecs_pre_void  (ext_link: Strings.String.string -> ident)
-              {Z fs id sig cc A P Q NEP NEQ}
-              {x: sigT (fun ts => dependent_type_functor_rec ts A mpred)}
-              {args m} Espec tys ge_s phi0 phi1 :
-  let ef := EF_external id (mksignature (map argtype_of_type sig) Xvoid cc) in
+Lemma add_funspecs_prepost (ext_link: Strings.String.string -> ident)
+              {fs id sig cc A E P Q}
+              {x: dtfr A} {args} Espec tys ge_s :
+  let ef := EF_external id (typesig2signature sig cc) in
   funspecs_norepeat fs ->
-  In (ext_link id, (mk_funspec (sig, tvoid) cc A P Q NEP NEQ)) fs ->
-  join phi0 phi1 (m_phi m) ->
-  Val.has_type_list args (map proj_xtype (sig_args (ef_sig ef))) ->
-  P (projT1 x) (projT2 x) (filter_genv (symb2genv ge_s), args) phi0 ->
-  exists x' : ext_spec_type (JE_spec _ (add_funspecs_rec ext_link Z Espec fs)) ef,
-    JMeq (phi1, x) x'
-    /\ forall z, ext_compat z (m_phi m) ->
-          ext_spec_pre (add_funspecs_rec ext_link Z Espec fs) ef x' ge_s tys args z m.
+  In (ext_link id, (mk_funspec sig cc A E P Q)) fs ->
+  forall md z, ⌜Val.has_type_list args (map proj_xtype (sig_args (ef_sig ef)))⌝ ∧
+        state_interp md z ∗ P x (filter_genv (symb2genv ge_s), args) ⊢
+  ∃ x' : ext_spec_type (add_funspecs_rec ext_link Espec fs) ef,
+    ⌜ext_spec_pre (add_funspecs_rec ext_link Espec fs) ef x' ge_s tys args z md⌝ ∧
+    (∀ (tret : xtype) (ret : option val) (m' : Memory.mem) z',
+       ⌜ext_spec_post (add_funspecs_rec ext_link Espec fs) ef x' ge_s tret ret z' m'⌝
+       → |==> state_interp m' z' ∗ ofe_mor_car _ _ Q x (make_ext_rval (filter_genv (symb2genv ge_s)) tret ret)).
 Proof.
-induction fs; [intros; exfalso; auto|]; intros ef H H1 H2 Hargsty Hpre.
+induction fs; [intros; exfalso; auto|]; intros ef H H1 md z.
 destruct H1 as [H1|H1].
 
 {
 subst a; simpl in *.
-clear IHfs H; revert x H2 Hpre; unfold funspec2pre; simpl.
-if_tac [e|e].
-intros x Hjoin Hp. exists (phi1,x). split; eauto.
-unfold funsig2signature in e.
-simpl in e.
-split; eauto 6.
-
-exfalso; auto.
+clear IHfs H; unfold funspec2jspec; simpl.
+destruct sig; unfold funspec2pre, funspec2post; simpl.
+if_tac; simpl; last done.
+unfold funspec2pre', funspec2post'; ouPred.unseal.
+split => n phi ??.
+exists (n, phi, x); split; first done.
+intros ????????? Hpost.
+rewrite {1}/ouPred_holds /= in Hpost.
+eapply ouPred_mono in Hpost; [|done..].
+eapply ouPred_mono; eauto.
 }
 
 {
 assert (Hin: In (ext_link id) (map fst fs)).
 { eapply (in_map fst) in H1; apply H1. }
 inversion H as [|? ? Ha Hb]; subst.
-destruct (IHfs Hb H1 H2 Hargsty Hpre) as [x' H3].
-clear -Ha Hin H1 H3; revert x' Ha Hin H1 H3.
-destruct a; simpl; destruct f; simpl; destruct t; simpl; unfold funspec2pre; simpl.
+rewrite IHfs //.
+ouPred.unseal.
+split => ???.
+intros (x' & Hpre).
+clear -Ha Hin H1 Hpre; revert Ha Hin H1 Hpre.
+unfold funspec2jspec; simpl.
+destruct a; simpl; destruct f as [(?, ?)]; simpl; unfold funspec2pre, funspec2post; simpl.
 if_tac [e|e].
-* injection e as E; subst i; destruct fs; [solve[simpl; intros; exfalso; auto]|].
-  intros x' Ha Hb; simpl in Ha, Hb.
-  exfalso; auto.
+* injection e as ?; subst i; destruct fs; [solve [simpl; intros; exfalso; auto]|].
+  done.
 * intros; eexists; eauto.
 }
 Qed.
 
-Lemma add_funspecs_post_void (ext_link: Strings.String.string -> ident)
-  {Z Espec tret fs id sig cc A P Q NEP NEQ x ret m z ge_s} :
+Lemma add_funspecs_prepost_void  (ext_link: Strings.String.string -> ident)
+              {fs id sig cc A E P Q}
+              {x: dtfr A}
+              {args} Espec tys ge_s :
   let ef := EF_external id (mksignature (map argtype_of_type sig) Xvoid cc) in
   funspecs_norepeat fs ->
-  In (ext_link id, (mk_funspec (sig, tvoid) cc A P Q NEP NEQ)) fs ->
-  ext_spec_post (add_funspecs_rec ext_link Z Espec fs) ef x ge_s tret ret z m ->
-  exists (phi0 phi1 phi1' : rmap) (x': sigT (fun ts => dependent_type_functor_rec ts A mpred)),
-       join phi0 phi1 (m_phi m)
-    /\ necR phi1' phi1
-    /\ JMeq x (phi1', x')
-    /\ Q (projT1 x') (projT2 x') (make_ext_rval (filter_genv (symb2genv ge_s)) tret ret) phi0.
+  In (ext_link id, (mk_funspec (sig, tvoid) cc A E P Q)) fs ->
+  forall md z, ⌜Val.has_type_list args (map proj_xtype (sig_args (ef_sig ef)))⌝ ∧
+        state_interp md z ∗ P x (filter_genv (symb2genv ge_s), args) ⊢
+  ∃ x' : ext_spec_type (add_funspecs_rec ext_link Espec fs) ef,
+    ⌜ext_spec_pre (add_funspecs_rec ext_link Espec fs) ef x' ge_s tys args z md⌝ ∧
+    (∀ (tret : xtype) (ret : option val) (m' : Memory.mem) z',
+       ⌜ext_spec_post (add_funspecs_rec ext_link Espec fs) ef x' ge_s tret ret z' m'⌝
+       → |==> state_interp m' z' ∗ ofe_mor_car _ _ Q x (make_ext_rval (filter_genv (symb2genv ge_s)) tret ret)).
 Proof.
-induction fs; [intros; exfalso; auto|]; intros ef H H1 Hpost.
-destruct H1 as [H1|H1].
-
-{
-subst a; simpl in *.
-clear IHfs H; revert x Hpost; unfold funspec2post; simpl.
-if_tac [e|e].
-intros x [phi0 [phi1 [Hjoin [Hq Hnec]]]].
-exists phi0, phi1, (fst x), (snd x).
-split; auto. split; auto. destruct x; simpl in *. split; destruct s; auto.
-exfalso; auto.
-}
-
-{
-assert (Hin: In (ext_link id) (map fst fs)).
-{ apply (in_map fst) in H1; auto. }
-inversion H as [|? ? Ha Hb]; subst.
-clear -Ha Hin H1 Hb Hpost IHfs; revert x Ha Hin H1 Hb Hpost IHfs.
-destruct a; simpl; destruct f; simpl; unfold funspec2post; simpl.
-destruct t; simpl.
-if_tac [e|e].
-* injection e as E; subst i; destruct fs; [solve[simpl; intros; exfalso; auto]|].
-  intros x' Ha Hb; simpl in Ha, Hb.
-  exfalso; auto.
-* intros. apply IHfs; auto.
-}
+  apply add_funspecs_prepost.
 Qed.
 
-Lemma add_funspecs_post (ext_link: Strings.String.string -> ident){Z Espec tret fs id sig cc A P Q NEP NEQ x ret m z ge_s} :
-  let ef := EF_external id (typesig2signature sig cc) in
-  funspecs_norepeat fs ->
-  In (ext_link id, (mk_funspec sig cc A P Q NEP NEQ)) fs ->
-  ext_spec_post (add_funspecs_rec ext_link Z Espec fs) ef x ge_s tret ret z m ->
-  exists (phi0 phi1 phi1' : rmap) (x': sigT (fun ts => dependent_type_functor_rec ts A mpred)),
-       join phi0 phi1 (m_phi m)
-    /\ necR phi1' phi1
-    /\ JMeq x (phi1',x')
-    /\ Q (projT1 x') (projT2 x') (make_ext_rval (filter_genv (symb2genv ge_s)) tret ret) phi0.
-Proof.
-induction fs; [intros; exfalso; auto|]; intros ef H H1 Hpost.
-destruct H1 as [H1|H1].
-
-{
-subst a; simpl in *.
-clear IHfs H; revert x Hpost; unfold funspec2post; simpl.
-destruct sig; simpl.
-if_tac [e|e].
-intros x [phi0 [phi1 [Hjoin [Hq Hnec]]]].
-exists phi0, phi1, (fst x), (snd x).
-split; auto. split; auto. destruct x; simpl in *. split; auto.
-exfalso; auto.
-}
-
-{
-assert (Hin: In (ext_link id) (map fst fs)).
-{ apply (in_map fst) in H1; auto. }
-inversion H as [|? ? Ha Hb]; subst.
-clear -Ha Hin H1 Hb Hpost IHfs; revert x Ha Hin H1 Hb Hpost IHfs.
-destruct a; simpl; destruct f; simpl; unfold funspec2post; simpl.
-destruct t; simpl.
-if_tac [e|e].
-* injection e as E; subst i; destruct fs; [solve[simpl; intros; exfalso; auto]|].
-  intros x' Ha Hb; simpl in Ha, Hb.
-  exfalso; auto.
-* intros. apply IHfs; auto.
-}
-Qed.
+End mpred.
 
+(* Maybe skip this step, since we have to fix the oracle type with externalGS.
 Definition add_funspecs (Espec : OracleKind) (ext_link: Strings.String.string -> ident) (fs : funspecs) : OracleKind :=
   match Espec with
     | Build_OracleKind ty spec =>
-      Build_OracleKind ty (add_funspecs_rec ext_link ty spec fs)
-  end.
-
-Lemma necR_jm_phi : forall jm jm', necR jm jm' -> necR (m_phi jm) (m_phi jm').
-Proof.
-  induction 1; auto.
-  - apply age_jm_phi in H; constructor; auto.
-  - eapply necR_trans; eauto.
-Qed.
+      Build_OracleKind ty (add_funspecs_rec ty ext_link spec fs)
+  end.*)
 
 Section semax_ext.
 
-Variable Espec : OracleKind.
+Context {Z : Type} `{!VSTGS Z Σ} {ext_spec0 : ext_spec Z}.
 
-Lemma semax_ext' (ext_link: Strings.String.string -> ident) id sig cc A P Q NEP NEQ (fs : funspecs) :
-  let f := mk_funspec sig cc A P Q NEP NEQ in
+Lemma semax_ext' (ext_link: Strings.String.string -> ident) id sig cc A E P Q (fs : funspecs) :
+  let f := mk_funspec sig cc A E P Q in
   In (ext_link  id,f) fs ->
   funspecs_norepeat fs ->
-  (forall n, semax_external (add_funspecs Espec ext_link fs)
-               (EF_external id (typesig2signature sig cc)) _ P Q n).
+  ⊢semax_external (add_funspecs_rec Z ext_link ext_spec0 fs)
+               (EF_external id (typesig2signature sig cc)) _ E P Q.
 Proof.
 intros f Hin Hnorepeat.
 unfold semax_external.
-intros n ge Ts x n0 Hlater F ts args jm H ? jm' H2 Hext [Hargsty H3].
-destruct H3 as [s [t [Hjoin [Hp Hf]]]].
-destruct Espec.
-
-assert (Hp'': P Ts x (filter_genv (symb2genv (genv_symb_injective ge)), args)
-                    s).
-{ generalize (all_funspecs_wf f) as Hwf2; intro.
-  specialize (Hwf2 Ts x ge (symb2genv (genv_symb_injective ge)) args).
-  spec Hwf2.
-  rewrite symb2genv_ax; auto.
-  apply Hwf2; auto. }
-
-destruct (@add_funspecs_pre ext_link _ _ _ _ _ _ _ _ _ _ (existT _ Ts x) _ _ OK_spec ts (genv_symb_injective ge) s t Hnorepeat Hin Hjoin Hargsty Hp'')
-  as [x' [Heq Hpre]].
-simpl.
-exists x'.
-split.
-intros z ?.
-eapply nec_hereditary, Hpre; auto.
-apply JE_pre_hered.
-
-intros tret ret z' jm2 Hlev ? jm3 Hnec Hext' Hpost.
-eapply add_funspecs_post in Hpost; eauto.
-destruct Hpost as [phi0 [phi1 [phi1' [x'' [Hjoin' [Hnec' [Hjmeq' Hq']]]]]]].
-exists phi0, phi1; split; auto.
-assert (E : (t, existT _ Ts x) = (phi1',x'')) by (eapply JMeq_eq, JMeq_trans; eauto).
-inv E.
-split; auto.
-unfold filter_genv, Genv.find_symbol in Hq'|-*.
-rewrite symb2genv_ax in Hq'; auto.
-eapply pred_nec_hereditary; eauto.
+iIntros (ge ????) "!> !> (%Hargsty & Hp & Hf)".
+iIntros "!>" (??) "Hs".
+iDestruct (add_funspecs_prepost _ _ _ _ (genv_symb_injective ge) with "[$Hp $Hs]") as (x' ?) "Hpost"; [done..|].
+iExists x'; iFrame; iSplit; first done.
+iIntros (?????); iMod ("Hpost" with "[%]") as "$"; done.
 Qed.
 
-Lemma semax_ext (ext_link: Strings.String.string -> ident) id sig sig' cc A P Q NEP NEQ (fs : funspecs) :
-  let f := mk_funspec sig cc A P Q NEP NEQ in
+Lemma semax_ext (ext_link: Strings.String.string -> ident) id sig sig' cc A E P Q (fs : funspecs) :
+  let f := mk_funspec sig cc A E P Q in
   In (ext_link id,f) fs ->
   funspecs_norepeat fs ->
   sig' = typesig2signature sig cc ->
-  (forall n, semax_external (add_funspecs Espec ext_link fs) (EF_external id sig') _ P Q n).
+  ⊢semax_external (add_funspecs_rec Z ext_link ext_spec0 fs) (EF_external id sig') _ E P Q.
 Proof.
 intros; subst.
 eapply semax_ext'; eauto.
diff --git a/veric/semax_lemmas.v b/veric/semax_lemmas.v
index 591780c89e..d82596feb0 100644
--- a/veric/semax_lemmas.v
+++ b/veric/semax_lemmas.v
@@ -1,9 +1,12 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.juicy_base.
-Require Import VST.veric.juicy_mem VST.veric.juicy_mem_lemmas VST.veric.juicy_mem_ops.
+Require Import VST.veric.juicy_mem.
 Require Import VST.veric.res_predicates.
+Require Import VST.veric.external_state.
 Require Import VST.veric.extend_tc.
 Require Import VST.veric.Clight_seplog.
 Require Import VST.veric.Clight_assert_lemmas.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.Clight_core.
 Require Import VST.sepcomp.extspec.
 Require Import VST.sepcomp.step_lemmas.
@@ -13,20 +16,15 @@ Require Import VST.veric.expr_lemmas.
 Require Import VST.veric.juicy_extspec.
 Require Import VST.veric.semax.
 Require Import VST.veric.Clight_lemmas.
-Require Import VST.veric.own.
-Import compcert.lib.Maps.
+Require Import VST.msl.eq_dec.
 
 Import Ctypes.
 
-Local Open Scope pred.
-
-#[export] Hint Resolve now_later andp_derives sepcon_derives : core.
-
 Lemma no_dups_swap:
   forall F V a b c, @no_dups F V (a++b) c -> @no_dups F V (b++a) c.
 Proof.
 unfold no_dups; intros.
-rewrite map_app in *.
+rewrite -> map_app in *.
 forget (map (@fst _ _) b) as bb.
 forget (map (@fst _ _) a) as aa.
 forget (map (var_name V) c) as cc.
@@ -38,15 +36,15 @@ clear - H2.
 unfold Coqlib.list_disjoint in *.
 intros; apply H2; auto.
 clear - H.
-rewrite in_app in *.
+rewrite -> in_app in *.
 tauto.
 Qed.
 
-Lemma join_sub_share_top: forall sh, join_sub Share.top sh -> sh = Share.top.
+Lemma join_sub_share_top: forall sh, sepalg.join_sub Share.top sh -> sh = Share.top.
 Proof.
 intros.
 generalize (top_correct' sh); intro.
-apply join_sub_antisym; auto.
+apply sepalg.join_sub_antisym; auto.
 Qed.
 
 
@@ -74,21 +72,13 @@ Qed.
 
 Section SemaxContext.
 
-Lemma universal_imp_unfold {A} {agA: ageable A} {EO: Ext_ord A}:
-   forall B (P Q: B -> pred A) w,
-     (ALL psi : B, P psi --> Q psi) w = (forall psi : B, (P psi --> Q psi) w).
-Proof.
-intros.
-apply prop_ext; split; intros.
-eapply H; eauto.
-intro b; apply H.
-Qed.
+Context `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty}.
 
 Lemma guard_environ_put_te':
  forall ge te ve Delta id v k,
  guard_environ Delta k (mkEnviron ge ve te)  ->
     (forall t,
-        (temp_types Delta) ! id = Some t -> tc_val' t v) ->
+        (temp_types Delta) !! id = Some t -> tc_val' t v) ->
  guard_environ Delta k (mkEnviron ge ve (Map.set id v te)).
 Proof.
  intros.
@@ -97,40 +87,17 @@ Proof.
  destruct k; auto.
 Qed.
 
-Lemma prop_imp_derives {A}{agA: ageable A} {EO: Ext_ord A}:
-  forall (P: Prop) (Q Q': pred A),  (P -> Q |-- Q') -> !!P --> Q |-- !!P --> Q'.
-Proof.
- intros.
- repeat intro.
- apply H; eauto.
-Qed.
-
-Lemma prop_imp {A}{agA: ageable A} {EO: Ext_ord A}:
-  forall (P: Prop) (Q Q': pred A),  (P -> Q = Q') -> !!P --> Q = !!P --> Q'.
-Proof.
-  intros.
-  apply pred_ext; apply prop_imp_derives.
-  + intros; rewrite H by auto; auto.
-  + intros; rewrite H by auto; auto.
-Qed.
-
-Lemma age_laterR {A} `{ageable A} {EO: Ext_ord A}: forall {x y}, age x y -> laterR x y.
-Proof.
-intros. constructor 1; auto.
-Qed.
-Local Hint Resolve age_laterR : core.
-
 Lemma typecheck_environ_sub:
   forall Delta Delta', tycontext_sub Delta Delta' ->
    forall rho,
    typecheck_environ Delta' rho -> typecheck_environ Delta rho.
 Proof.
-intros ? ? [? [? [? [? Hs]]]] ?  [? [? ?]].
+intros ?? [? [? [? [? Hs]]]] ?  [? [? ?]].
 split; [ | split].
 * clear - H H3.
  hnf; intros.
  specialize (H id); rewrite H0 in H.
- destruct ((temp_types Delta') ! id) eqn:?H; try contradiction.
+ destruct ((temp_types Delta') !! id) eqn:?H; try contradiction.
  destruct H; subst.
  specialize (H3 id ty H1).
  destruct H3 as [v [? ?]].
@@ -144,379 +111,223 @@ split; [ | split].
  specialize (H2 id). hnf in H2. rewrite H in H2. eauto.
 Qed.
 
-Lemma funassert_resource: forall Delta rho a a' (Hl: level a = level a')
-  (Hr: resource_at a = resource_at a'),
-  funassert Delta rho a -> funassert Delta rho a'.
+Lemma semax_unfold {CS: compspecs} E Delta P c R :
+  semax OK_spec E Delta P c R ↔ forall (psi: Clight.genv) Delta' CS'
+          (TS: tycontext_sub Delta Delta')
+          (HGG: cenv_sub (@cenv_cs CS) (@cenv_cs CS') /\ cenv_sub (@cenv_cs CS') (genv_cenv psi)),
+    ⊢ believe(CS := CS') OK_spec Delta' psi Delta' → ∀ (k: cont) (F: assert) f E',
+        ⌜closed_wrt_modvars c F /\ E ⊆ E'⌝ ∧ rguard OK_spec psi E' Delta' f (frame_ret_assert R F) k →
+       guard' OK_spec psi E' Delta' f (F ∗ P) (Kseq c k).
 Proof.
-  intros.
-  destruct H as [H1 H2]; split; repeat intro.
-  - destruct (H1 _ _ _ _ (rt_refl _ _ _) (ext_refl _) H3) as (b1 & ? & ?).
-    exists b1; split; auto.
-    destruct b0; simpl in *.
-    rewrite Hr in H5.
-    pose proof (necR_level _ _ H).
-    eapply necR_PURE in H; eauto.
-    apply rmap_order in H0 as (<- & <- & _).
-    rewrite H; simpl; f_equal; f_equal.
-    extensionality i a0 a1 a2.
-    match goal with |-context[compcert_rmaps.R.approx ?a (approx ?b ?c)] =>
-      change (compcert_rmaps.R.approx a (approx b c)) with ((approx a oo approx b) c) end.
-    rewrite fmap_app, approx_oo_approx', approx'_oo_approx by lia; auto.
-  - specialize (H2 b b0 b1). clear H1.
-    destruct b0; simpl in *.
-    apply (H2 _  _ (rt_refl _ _ _) (ext_refl _)).
-    rewrite Hr, Hl.
-    destruct H3 as [p Hp].
-    pose proof (necR_level _ _ H).
-    apply rmap_order in H0 as (Hl' & Hr' & _).
-    rewrite <- Hl', <- Hr' in Hp.
-    rewrite <- resource_at_approx.
-    eapply necR_PURE' in H as [? ->]; simpl; eauto.
+unfold semax. rewrite semax_fold_unfold.
+split; intros.
++ iIntros "?"; iApply H; eauto.
++ iIntros (??? [??]); iApply H; done.
 Qed.
 
-Ltac fun_tac :=
-  match goal with
-  | H: ?A = Some _, H': ?A = Some _ |- _ => inversion2 H H'
-  | H: Clight.eval_expr ?ge ?e ?le ?m ?A _,
-    H': Clight.eval_expr ?ge ?e ?le ?m ?A _ |- _ =>
-        apply (eval_expr_fun H) in H'; subst
-  | H: Clight.eval_exprlist ?ge ?e ?le ?m ?A ?ty _,
-    H': Clight.eval_exprlist ?ge ?e ?le ?m ?A ?ty _ |- _ =>
-        apply (eval_exprlist_fun H) in H'; subst
-  | H: Clight.eval_lvalue ?ge ?e ?le ?m ?A _ _ _,
-    H': Clight.eval_lvalue ?ge ?e ?le ?m ?A _ _ _ |- _ =>
-        apply (eval_lvalue_fun H) in H'; inv H'
-  | H: Clight.assign_loc ?ge ?ty ?m ?b ?ofs ?bf ?v _,
-    H': Clight.assign_loc ?ge ?ty ?m ?b ?ofs ?bf ?v _ |- _ =>
-        apply (assign_loc_fun H) in H'; inv H'
-  | H: Clight.deref_loc ?ty ?m ?b ?ofs _,
-    H': Clight.deref_loc ?ty ?m ?b ?ofs _ |- _ =>
-        apply (deref_loc_fun H) in H'; inv H'
-  | H: Clight.alloc_variables ?ge ?e ?m ?vl _ _,
-    H': Clight.alloc_variables ?ge ?e ?m ?vl _ _ |- _ =>
-        apply (alloc_variables_fun H) in H'; inv H'
-  | H: Clight.bind_parameters ?ge ?e ?m ?p ?vl _,
-    H': Clight.bind_parameters ?ge ?e ?m ?p ?vl _ |- _ =>
-        apply (bind_parameters_fun H) in H'; inv H'
-  | H: Senv.find_symbol ?ge _ = Some ?b,
-    H': Senv.find_symbol ?ge _ = Some ?b |- _ =>
-       apply (inv_find_symbol_fun H) in H'; inv H'
-  | H: Events.eventval_list_match ?ge _ ?t ?v,
-    H': Events.eventval_list_match ?ge _ ?t ?v |- _ =>
-       apply (eventval_list_match_fun H) in H'; inv H'
- end.
-Lemma cl_corestep_fun: forall ge m q m1 q1 m2 q2,
-    cl_step ge q m q1 m1 ->
-    cl_step ge q m q2 m2 ->
-    (q1,m1)=(q2,m2).
+Lemma derives_skip:
+  forall {CS: compspecs} p E Delta (R: ret_assert),
+      (p ⊢ proj_ret_assert R EK_normal None) ->
+        semax OK_spec E Delta p Clight.Sskip R.
 Proof.
 intros.
-inv H; inv H0; repeat fun_tac; auto;
-repeat match goal with H: _ = _ \/ _ = _ |- _ => destruct H; try discriminate end;
-try contradiction.
--
-inversion2 H1 H16; fun_tac; auto.
+rewrite semax_unfold.
+intros psi Delta' CS' ??.
+clear dependent Delta. rename Delta' into Delta.
+iIntros "believe" (????) "[% #H]".
+iSpecialize ("H" $! EK_normal None).
+rewrite /guard' /_guard.
+iIntros (??) "!> Fp".
+iSpecialize ("H" with "[Fp]").
+{ rewrite H proj_frame //. }
+rewrite /assert_safe.
+iIntros (z ?); iSpecialize ("H" with "[%]"); first done.
+destruct k as [ | s ctl' | | | |]; try done; try solve [iApply (jsafe_local_step with "H"); constructor].
 -
-rewrite andb_true_iff in H15; destruct H15.
-pose proof (ef_deterministic_fun _ H0 _ _ _ _ _ _ _ _ _ H3 H17).
-inv H4; auto.
+iApply (convergent_controls_jsafe with "H"); simpl; try congruence.
+by inversion 1; constructor.
 -
-inv H1. inv H8.
-fun_tac.
-pose proof (alloc_variables_fun H3 H7). inv H8. auto.
+iMod "H" as "[]".
 -
-rewrite andb_true_iff in H1; destruct H1.
-pose proof (ef_deterministic_fun _ H0 _ _ _ _ _ _ _ _ _ H2 H13).
-inv H1; auto.
+iApply (convergent_controls_jsafe with "H"); simpl; try congruence.
+by inversion 1; constructor.
 Qed.
 
-Lemma age1_resource_decay:
-  forall jm jm', age jm jm' -> resource_decay (nextblock (m_dry jm)) (m_phi jm) (m_phi jm').
+Fixpoint list_drop (A: Type) (n: nat) (l: list A) {struct n} : list A :=
+  match n with O => l | S i => match l with nil => nil | _ :: l' => list_drop A i l' end end.
+Arguments list_drop [A] _ _.
+
+Definition straightline (c: Clight.statement) :=
+ forall ge f ve te k m f' ve' te' c' k' m',
+        cl_step ge (State f c k ve te) m (State f' c' k' ve' te') m' -> (c'=Sskip /\ k=k').
+
+Lemma straightline_assign: forall e0 e, straightline (Clight.Sassign e0 e).
 Proof.
- intros. split.
- apply age_level in H.
- change (level (m_phi jm)) with (level jm).
- change (level (m_phi jm')) with (level jm').
- lia.
- intro l. split. apply juicy_mem_alloc_cohere. left.
- symmetry; apply age1_resource_at with (m_phi jm); eauto.
-  destruct (age1_juicy_mem_unpack _ _ H); auto.
- symmetry; apply resource_at_approx.
+unfold straightline; intros.
+inv H; auto.
+destruct H13; inv H; auto.
+destruct H13; inv H; auto.
 Qed.
 
-Lemma jsafeN_local_step_fupd:
-  forall {Espec: OracleKind} ge ora s1 m s2,
-  cl_step  ge s1 (m_dry m) s2 (m_dry m) ->
-  (forall m', age m m' -> jm_fupd ora Ensembles.Full_set Ensembles.Full_set (jsafeN (@OK_spec Espec) ge ora s2) m') ->
-  jsafeN (@OK_spec Espec) ge ora s1 m.
+Lemma assert_safe_fupd : forall ge E f ve te c rho,
+  (match c with Ret _ _ => False | _ => True end) -> (* can we work around this now? *)
+  (|={E}=> assert_safe OK_spec ge E f ve te c rho) ⊢ assert_safe OK_spec ge E f ve te c rho.
 Proof.
-intros.
-  rename H into Hstep.
-  remember (level m) as N.
-  destruct N; [constructor; auto|].
-  case_eq (age1 m); [intros m' H |  intro; apply age1_level0 in H; lia].
-  eapply jsafeN_step.
-  split3.
-  replace (m_dry m') with (m_dry m) by (destruct (age1_juicy_mem_unpack _ _ H); auto).
-  apply Hstep.
-  apply age1_resource_decay; auto. split; [apply age_level; auto|].
-  apply age_jm_phi in H.
-  erewrite (age1_ghost_of _ _ H) by (symmetry; apply ghost_of_approx).
-  unfold level at 1; simpl.
-  repeat intro; auto.
-  assert (N = level m')%nat.
-  apply age_level in H; lia.
-  subst. apply H0. auto.
+  intros.
+  rewrite /assert_safe /jsafeN; iIntros "H" (??).
+  iSpecialize ("H" with "[%]"); first done.
+  destruct c; try contradiction.
+  - by iMod "H".
+  - destruct c; by iMod "H".
+(*  - destruct o; last by iMod "H".
+    iIntros (?); iApply (bi.impl_intro_l with "H"); iIntros "H".
+    There could be something here about how a fupd can't make pointers invalid.*)
 Qed.
 
-Lemma bupd_jm_bupd: forall jm P C, bupd P (m_phi jm) -> joins (ghost_of (m_phi jm)) (ghost_approx jm C) ->
-  exists jm', jm_update jm jm' /\ P (m_phi jm') /\ joins (ghost_of (m_phi jm')) (ghost_approx jm C).
+Global Instance assert_safe_except_0 : forall ge E f ve te c rho,
+  IsExcept0 (assert_safe OK_spec ge E f ve te c rho).
 Proof.
-  repeat intro.
-  destruct (H _ H0) as (? & ? & ? & ? & Hr & ? & ?); subst.
-  destruct (juicy_mem_resource _ _ Hr) as (jm' & ? & ?); subst.
-  exists jm'; repeat split; auto.
+  intros.
+  rewrite /IsExcept0 /assert_safe /jsafeN; iIntros "H" (??).
+  destruct c; simpl.
+  - by iMod "H"; iApply ("H" $! ora).
+  - destruct c; by iMod "H"; iApply ("H" $! ora).
+  - destruct o; try by iMod "H"; iApply "H".
+    iIntros (?).
+    iApply (bi.impl_intro_r with "H").
+    iIntros "H".
+    rewrite (bi.except_0_intro (∀_, _ -∗ _)) -bi.except_0_and; iMod "H".
+    iApply (bi.impl_elim_l' with "H"); iIntros "H".
+    iSpecialize ("H" with "[%]"); done.
 Qed.
 
-Lemma jsafeN_local_step:
-  forall {Espec: OracleKind} ge ora s1 m s2,
-  cl_step  ge s1 (m_dry m) s2 (m_dry m) ->
-  (forall m', age m m' ->
-    jsafeN (@OK_spec Espec) ge ora s2 m') ->
-  jsafeN (@OK_spec Espec) ge ora s1 m.
+Global Instance believe_external_plain gx v fsig cc A E P Q : Plain (believe_external OK_spec gx v fsig cc A E P Q).
 Proof.
-intros.
-  rename H into Hstep.
-  remember (level m) as N.
-  destruct N; [constructor; auto|].
-  case_eq (age1 m); [intros m' H |  intro; apply age1_level0 in H; lia].
-  eapply jsafeN_step.
-  split3.
-  replace (m_dry m') with (m_dry m) by (destruct (age1_juicy_mem_unpack _ _ H); auto).
-  apply Hstep.
-  apply age1_resource_decay; auto. split; [apply age_level; auto|].
-  apply age_jm_phi in H.
-  erewrite (age1_ghost_of _ _ H) by (symmetry; apply ghost_of_approx).
-  unfold level at 1; simpl.
-  repeat intro; auto.
-  assert (N = level m')%nat.
-  apply age_level in H; lia.
-  apply jm_fupd_intro', H0; auto.
+  rewrite /Plain /believe_external.
+  destruct (Genv.find_funct gx v); last iApply plain.
+  destruct f; iApply plain.
 Qed.
 
-Lemma derives_skip:
-  forall {CS: compspecs} {Espec: OracleKind} p Delta (R: ret_assert),
-      (forall rho, p rho |-- proj_ret_assert R EK_normal None rho) ->
-        semax Espec Delta p Clight.Sskip R.
-Proof.
-intros ? ? ? ?; intros.
-intros n.
-rewrite semax_fold_unfold.
-intros psi Delta' CS'.
-apply prop_imp_i; intros [? HGG].
-clear H0 Delta. rename Delta' into Delta.
-intros _ ?w _ _ _. clear n.
-intros k F f.
-intros _ ?w _ _ ?.
-clear w. rename w0 into n.
-intros te ve w ?.
-destruct H0 as [H0' H0].
-specialize (H0 EK_normal None te ve w H1).
-simpl exit_cont in H0.
-simpl in H0'. clear n H1. remember ((construct_rho (filter_genv psi) ve te)) as rho.
-revert w H0.
-apply imp_derives; auto.
-apply andp_derives; auto.
-apply andp_derives; auto.
-repeat intro.
-simpl.
-split; auto.
-specialize (H rho). destruct R; simpl in H. simpl tycontext.RA_normal.
-rewrite prop_true_andp in H by auto.
-rewrite sepcon_comm.
-eapply sepcon_derives; try apply H0; auto.
-
-apply assert_safe_derives; split; auto; simpl.
-destruct k as [ | s ctl' | | | |];
-  intros; eapply jm_fupd_mono; eauto; intros ? Hle HP; try contradiction.
--
-inv HP; try contradiction.
-constructor; auto.
-eapply jsafeN_step; eauto.
-destruct H4; split; auto.
-inv H2.
-econstructor; eauto.
-simpl. auto.
-inv H4.
--
-eapply jsafeN_local_step. constructor.
-intros.
-eapply age_safe in HP; eauto.
--
-eapply jsafeN_local_step. constructor.
-intros.
-eapply age_safe in HP; eauto.
--
-inv HP; try contradiction.
-constructor; auto.
-eapply jsafeN_step; eauto.
-destruct H4; split; auto.
-inv H2.
-econstructor; eauto.
-simpl. auto.
-inv H4.
+Global Instance believe_external_absorbing gx v fsig cc A E P Q : Absorbing (believe_external OK_spec gx v fsig cc A E P Q).
+  rewrite /Absorbing /believe_external.
+  destruct (Genv.find_funct gx v); last iApply absorbing.
+  destruct f; iApply absorbing.
 Qed.
 
-Lemma semax_unfold {CS: compspecs} {Espec: OracleKind}:
-  semax Espec = fun Delta P c R =>
-    forall (psi: Clight.genv) Delta' CS' (w: nat)
-          (TS: tycontext_sub Delta Delta')
-          (HGG: cenv_sub (@cenv_cs CS) (@cenv_cs CS') /\ cenv_sub (@cenv_cs CS') (genv_cenv psi))
-           (Prog_OK: @believe CS' Espec Delta' psi Delta' w) (k: cont) (F: assert) f,
-        closed_wrt_modvars c F ->
-       rguard Espec psi Delta' f (frame_ret_assert R F) k w ->
-       guard Espec psi Delta' f (fun rho => F rho * P rho) (Kseq c k) w.
+Lemma fixpoint_plain {A} (F : (A -d> iPropO Σ) -> A -d> iPropO Σ) `{Contractive F}:
+    (∀ Φ, (∀ x, Plain (Φ x)) → (∀ x, Plain (F Φ x))) →
+    ∀ x, Plain (fixpoint F x).
 Proof.
-unfold semax; rewrite semax_fold_unfold.
-extensionality Delta P c R.
-apply prop_ext; split; intros.
-+ eapply (H w); eauto.
-  - split; auto.
-  - split; trivial.
-+ intros psi Delta' CS'.
-  apply prop_imp_i; intros [? HGG].
-  intros ? w' ? ? ? k F f ? w'' ? ? [? ?].
-  apply (H psi Delta' CS' w'' H0 HGG); trivial.
-  eapply pred_upclosed, pred_nec_hereditary; eauto.
+  intros ?.
+  apply fixpoint_ind.
+  - intros ?? Heq ??. by rewrite -(Heq _).
+  - exists (fun _ => emp); intros; apply emp_plain.
+  - auto.
+  - apply limit_preserving_forall; intros; apply limit_preserving_Plain.
+    intros ??; auto.
 Qed.
 
-Fixpoint list_drop (A: Type) (n: nat) (l: list A) {struct n} : list A :=
-  match n with O => l | S i => match l with nil => nil | _ :: l' => list_drop A i l' end end.
-Arguments list_drop [A] _ _.
+Lemma fixpoint_absorbing {A} (F : (A -d> iPropO Σ) -> A -d> iPropO Σ) `{Contractive F}:
+    (∀ Φ, (∀ x, Absorbing (Φ x)) → (∀ x, Absorbing (F Φ x))) →
+    ∀ x, Absorbing (fixpoint F x).
+Proof.
+  intros ?.
+  apply fixpoint_ind.
+  - intros ?? Heq ??. by rewrite -(Heq _).
+  - exists (fun _ => True); intros; apply bi.pure_absorbing.
+  - auto.
+  - apply limit_preserving_forall; intros ?.
+    apply bi.limit_preserving_entails.
+    + intros ????. by apply bi.absorbingly_ne.
+    + intros ??; auto.
+Qed.
 
-Definition straightline (c: Clight.statement) :=
- forall ge f ve te k m f' ve' te' c' k' m',
-        cl_step ge (State f c k ve te) m (State f' c' k' ve' te') m' ->  (c'=Sskip /\ k=k').
+Lemma fixpoint_plain_absorbing {A} (F : (A -d> iPropO Σ) -> A -d> iPropO Σ) `{Contractive F}:
+    (∀ Φ, (∀ x, Plain (Φ x)) → (∀ x, Absorbing (Φ x)) → (∀ x, Plain (F Φ x))) →
+    (∀ Φ, (∀ x, Plain (Φ x)) → (∀ x, Absorbing (Φ x)) → (∀ x, Absorbing (F Φ x))) →
+    ∀ x, Plain (fixpoint F x) ∧ Absorbing (fixpoint F x).
+Proof.
+  intros ??.
+  apply fixpoint_ind.
+  - intros ?? Heq ??. by rewrite -(Heq _).
+  - exists (fun _ => True); intros; split; [apply pure_plain | apply bi.pure_absorbing].
+  - intros ? Hpa y.
+    assert ((∀y, Plain (x y)) ∧ (∀y, Absorbing (x y))) as [??] by (split; intros; eapply Hpa; eauto).
+    eauto.
+  - apply limit_preserving_forall; intros.
+    apply limit_preserving_and; [apply limit_preserving_Plain; intros ??; auto|].
+    apply bi.limit_preserving_entails.
+    + intros ????. by apply bi.absorbingly_ne.
+    + intros ??; auto.
+Qed.
 
-Lemma straightline_assign: forall e0 e, straightline (Clight.Sassign e0 e).
+Lemma semax'_plain_absorbing CS E Delta P c R : Plain (semax'(CS := CS) OK_spec E Delta P c R) ∧ Absorbing (semax' OK_spec E Delta P c R).
 Proof.
-unfold straightline; intros.
-inv H; auto.
-destruct H13; inv H; auto.
-destruct H13; inv H; auto.
+  apply fixpoint_plain_absorbing; intros; rewrite /semax_; destruct x; apply _.
 Qed.
 
-Lemma extract_exists_pre_later {CS: compspecs} {Espec: OracleKind}:
-  forall  (A : Type) (Q: assert) (P : A -> assert) c Delta (R: ret_assert),
-  (forall x, semax Espec Delta (fun rho => Q rho && |> P x rho) c R) ->
-   semax Espec Delta (fun rho => Q rho && |> exp (fun x => P x rho)) c R.
+Global Instance semax'_plain CS E Delta P c R : Plain (semax'(CS := CS) OK_spec E Delta P c R).
+Proof. apply semax'_plain_absorbing. Qed.
+
+Global Instance semax'_absorbing CS E Delta P c R : Absorbing (semax'(CS := CS) OK_spec E Delta P c R).
+Proof. apply semax'_plain_absorbing. Qed.
+
+Lemma extract_exists_pre_later {CS: compspecs}:
+  forall  (A : Type) (Q: assert) (P : A -> assert) c E Delta (R: ret_assert),
+  (forall x, semax OK_spec E Delta (Q ∧ ▷ P x) c R) ->
+   semax OK_spec E Delta (Q ∧ ▷ ∃ x, P x) c R.
 Proof.
-rewrite semax_unfold in *.
 intros.
-intros.
-intros te ve ?w ? ? ?w ? Hext ?.
-destruct H4.
-destruct H4.
-destruct H6 as [w2 [w3 [? [? [HQ ?]]]]].
-destruct (age1 w2) as [w2' | ] eqn:?.
-*
-destruct (@age1_join _ _ _ _ _ _ _ _ _ H6 Heqo)
-  as [w3' [w1' [? [? ?]]]].
-hnf in H8.
-specialize (H8 _ (age_laterR H10)).
-destruct H8 as [x H8].
-specialize (H x psi Delta' CS' w TS HGG Prog_OK k F f H0 H1).
-unfold guard, _guard in H.
-specialize (H te ve).
-cbv beta in H.
-specialize (H w0 H2 _ w1 H3 Hext).
-apply H.
-split; auto. split; auto.
-exists w2, w3. split3; auto.
-split; auto.
-intros w3x ?.
-eapply pred_nec_hereditary; [ | apply H8].
-clear - H10 H12.
-eapply age_later_nec; eauto.
-*
-assert (level w1 = O). {
-  clear - H6 Heqo.
-  apply join_level in H6. destruct H6.
-  rewrite <- H. apply age1_level0.  auto.
-}
-hnf. lia.
+rewrite semax_unfold; intros.
+iIntros "#believe" (????) "[% #rguard]".
+iIntros (??) "!> H".
+rewrite bi.later_exist_except_0.
+iAssert (◇ ∃ a : A, (⌜guard_environ Delta' f (construct_rho (filter_genv psi) vx tx)⌝
+      ∧ (F ∗ Q ∧ ▷ P a) (construct_rho (filter_genv psi) vx tx) ∗
+      funassert Delta' (construct_rho (filter_genv psi) vx tx))) with "[H]" as ">H".
+{ iDestruct "H" as "($ & H & $)".
+  monPred.unseal.
+  iDestruct "H" as "($ & H)".
+  rewrite monPred_at_except_0 {1}(bi.except_0_intro (Q _)) -bi.except_0_and bi.and_exist_l //. }
+iDestruct "H" as (a) "H".
+specialize (H a); rewrite semax_unfold in H; iApply H; auto; done.
 Qed.
 
-Lemma extract_exists_pre {CS: compspecs} {Espec: OracleKind}:
-  forall  (A : Type) (P : A -> assert) c Delta (R: ret_assert),
-  (forall x, semax Espec Delta (P x) c R) ->
-   semax Espec Delta (fun rho => exp (fun x => P x rho)) c R.
+Lemma extract_exists_pre {CS: compspecs}:
+  forall  (A : Type) (P : A -> assert) c E Delta (R: ret_assert),
+  (forall x, semax OK_spec E Delta (P x) c R) ->
+   semax OK_spec E Delta (∃ x, P x) c R.
 Proof.
-rewrite semax_unfold in *.
 intros.
-intros.
-intros te ve ?w ? ? ?w ? Hext ?.
-rewrite exp_sepcon2 in H4.
-destruct H4 as [[TC [x H5]] ?].
-specialize (H x).
-specialize (H psi Delta' CS' w TS HGG Prog_OK k F f H0).
-spec H. {
- clear - H1.
- unfold rguard in *.
- intros ek vl tx vx. specialize (H1 ek vl tx vx).
- red in H1.
- eapply subp_trans'; [| apply H1 ].
- apply derives_subp.
- apply andp_derives; auto.
-}
-eapply H; eauto.
-split; auto.
-split; auto.
+rewrite semax_unfold; intros.
+iIntros "#believe" (????) "[% #rguard]".
+iIntros (??) "!> H".
+rewrite bi.sep_exist_l monPred_at_exist bi.sep_exist_r bi.and_exist_l; iDestruct "H" as (a) "H".
+specialize (H a); rewrite semax_unfold in H; iApply H; auto; done.
 Qed.
 
-Definition G0: funspecs := nil.
+Definition G0: funspecs(Σ := Σ) := nil.
 
 Definition empty_genv prog_pub cenv: Clight.genv :=
    Build_genv (Genv.globalenv (AST.mkprogram (F:=Clight.fundef)(V:=type) nil prog_pub (1%positive))) cenv.
 
-Lemma empty_program_ok {CS: compspecs} {Espec: OracleKind}: forall Delta ge w,
-    glob_specs Delta = PTree.empty _ ->
-    believe Espec Delta ge Delta w.
+Lemma empty_program_ok {CS: compspecs}: forall Delta ge,
+    glob_specs Delta = Maps.PTree.empty _ ->
+    ⊢ believe OK_spec Delta ge Delta.
 Proof.
-intros Delta ge w ?.
-intro b.
-intros fsig cc A P Q.
-intros ? ?n ? Hext ?.
-destruct H1 as [id [? [b0 [? ?]]]].
-rewrite H in H1. rewrite PTree.gempty in H1.
-inv H1.
+intros Delta ge H.
+rewrite /believe.
+iIntros (??????? (? & Hge & ?)).
+rewrite H in Hge; setoid_rewrite Maps.PTree.gempty in Hge; discriminate.
 Qed.
 
 Definition all_assertions_computable  :=
-  forall (Espec: OracleKind) psi f tx vx (Q: assert),
-     exists k,  assert_safe Espec psi f tx vx k = Q.
+  forall psi E f tx vx (Q: assert),
+     exists k,  assert_safe OK_spec psi E f tx vx k = Q.
 (* This is not generally true, but could be made true by adding an "assert" operator
   to the programming language
  *)
 
-Lemma ewand_TT_emp {A} {JA: Join A}{PA: Perm_alg A}{agA: ageable A}{SA: Sep_alg A}{aaA: Age_alg A}{CA: Canc_alg A} {EO: Ext_ord A}:
-  ewand TT emp = emp.
-Proof.
-intros.
-apply pred_ext; intros w ?.
-- destruct (H w w) as [w1 [w3 [? [? ?]]]].
-  + apply necR_refl.
-  + apply ext_refl.
-  + destruct H2 as [e3 [? ?]].
-Abort.
-
-Lemma subp_derives' {A}{agA: ageable A}{EO: Ext_ord A}:
-  forall P Q: pred A, (forall n, (P >=> Q) n) -> P |-- Q.
-Proof.
-intros.
-intros n ?. eapply H; eauto.
-Qed.
-
 Lemma guard_environ_sub:
   forall {Delta Delta' f rho},
    tycontext_sub Delta Delta' ->
@@ -531,24 +342,25 @@ destruct H1; split; auto.
 destruct H as [? [? [? ?]]]. rewrite H4; auto.
 Qed.
 
+Local Notation assert := (@assert Σ).
+
 Lemma proj_frame_ret_assert:
  forall (R: ret_assert) (F: assert) ek vl,
-  proj_ret_assert (frame_ret_assert R F) ek vl =
-  seplog.sepcon (proj_ret_assert R ek vl) F.
+  proj_ret_assert (frame_ret_assert R F) ek vl ⊣⊢
+  (proj_ret_assert R ek vl ∗ F).
 Proof.
-intros; extensionality rho; destruct R, ek; simpl;
-rewrite ?sepcon_andp_prop1; auto.
+  intros; rewrite proj_frame comm //.
 Qed.
 
-Lemma semax_extensionality0 {CS: compspecs} {Espec: OracleKind}:
-       TT |--
+(*Lemma semax_extensionality0 {CS: compspecs} {OK_spec: OracleKind}:
+       True ⊢
       ALL Delta:tycontext, ALL Delta':tycontext,
       ALL P:assert, ALL P':assert,
       ALL c: statement, ALL R:ret_assert, ALL R':ret_assert,
-       ((!! tycontext_sub Delta Delta'
+       ((!! tycontext_sub E Delta Delta'
        &&  (ALL ek: exitkind, ALL  vl : option val, ALL rho: environ,
                (proj_ret_assert R ek vl rho >=> proj_ret_assert R' ek vl rho))
-      && (ALL rho:environ, P' rho >=> P rho)  && semax' Espec Delta P c R) >=> semax' Espec Delta' P' c R').
+      && (ALL rho:environ, P' rho >=> P rho)  && semax' OK_spec Delta P c R) >=> semax' OK_spec Delta' P' c R').
 Proof.
 apply loeb.
 intros w ? Delta Delta' P P' c R R'.
@@ -564,7 +376,7 @@ specialize (H5 gx Delta'' CS' _ _ (necR_refl _) (ext_refl _)
 
 intros k F f ? w4 Hw4 Hext4 [? ?].
 specialize (H5 k F f _ w4 Hw4 Hext4).
-assert ((rguard Espec gx Delta'' f (frame_ret_assert R F) k) w4).
+assert ((rguard OK_spec gx Delta'' f (frame_ret_assert R F) k) w4).
 do 9 intro. intros Hext' ?.
 apply (H9 b b0 b1 b2 y H10 _ _ H11 Hext').
 destruct H12; split; auto; clear H13.
@@ -599,12 +411,12 @@ eapply Nat.le_trans; try eassumption.
 rewrite Hext3; setoid_rewrite <- Hext4; auto.
 Qed.
 
-Lemma semax_extensionality1 {CS: compspecs} {Espec: OracleKind}:
+Lemma semax_extensionality1 {CS: compspecs} {OK_spec: OracleKind}:
   forall Delta Delta' (P P': assert) c (R R': ret_assert) ,
-       tycontext_sub Delta Delta' ->
+       tycontext_sub E Delta Delta' ->
        ((ALL ek: exitkind, ALL  vl : option val, ALL rho: environ,
           (proj_ret_assert R ek vl rho >=> proj_ret_assert R' ek vl rho))
-      && (ALL rho:environ, P' rho >=> P rho)  && (semax' Espec Delta P c R) |-- semax' Espec Delta' P' c R').
+      && (ALL rho:environ, P' rho >=> P rho)  && (semax' OK_spec Delta P c R) |-- semax' OK_spec Delta' P' c R').
 Proof.
 intros.
 intros n ?.
@@ -614,66 +426,37 @@ split; auto.
 destruct H0;
 split; auto.
 split; auto.
-Qed.
+Qed.*)
 
-Lemma semax_frame {CS: compspecs} {Espec: OracleKind}:  forall Delta P s R F,
+Lemma semax_frame {CS: compspecs} :  forall E Delta P s R F,
    closed_wrt_modvars s F ->
-  semax Espec Delta P s R ->
-    semax Espec Delta (fun rho => P rho * F rho) s (frame_ret_assert R F).
+  semax OK_spec E Delta P s R ->
+  semax OK_spec E Delta (P ∗ F) s (frame_ret_assert R F).
 Proof.
 intros until F. intros CL H.
 rewrite semax_unfold.
 rewrite semax_unfold in H.
 intros.
-pose (F0F := fun rho => F0 rho * F rho).
-specialize (H psi Delta' CS' w TS HGG Prog_OK k F0F f).
-spec H. {
- unfold F0F.
- clear - H0 CL.
- hnf in *; intros; simpl in *.
- rewrite <- CL. rewrite <- H0. auto.
- tauto. tauto.
-}
-replace (fun rho : environ => F0 rho * (P rho * F rho))
-  with  (fun rho : environ => F0F rho * P rho).
-*
-apply H.
-unfold F0F; clear - H1.
-intros ek vl tx vx; specialize (H1 ek vl tx vx).
-red in H1.
-remember ((construct_rho (filter_genv psi) vx tx)) as rho.
-red.
-hnf; intros. specialize (H1 _ H).
-hnf; intros. eapply H1; eauto.
-destruct H3; split; auto. destruct H3; split; auto.
-rewrite proj_frame_ret_assert in H5|-*.
-rewrite proj_frame_ret_assert.
-rewrite seplog.sepcon_assoc.
-eapply sepcon_derives; try apply H5; auto. simpl.
-rewrite sepcon_comm; auto.
-*
-unfold F0F.
-extensionality rho.
-rewrite sepcon_assoc.
-f_equal. apply sepcon_comm.
-Qed.
-
-Lemma assert_safe_last:
-  forall {Espec: OracleKind} f ge ve te c k rho w,
-   (forall w', age w w' -> assert_safe Espec f ge ve te (Cont (Kseq c k)) rho w) ->
-    assert_safe Espec f ge ve te (Cont (Kseq c k)) rho w.
-Proof.
-intros.
-case_eq (age1 w). auto.
-clear H.
-intro; repeat intro.
-apply age1_level0 in H. lia.
+iIntros "H" (????) "[(% & %) guard]".
+pose (F0F := F0 ∗ F).
+iPoseProof (H with "H") as "H"; [done..|].
+iSpecialize ("H" $! _ F0F with "[-]").
+{ rewrite /bi_affinely; iSplit; first done.
+  iSplit.
+  * iPureIntro.
+    split; last done.
+    unfold F0F.
+    hnf in *; intros; simpl in *.
+    monPred.unseal. rewrite <- CL. rewrite <- H0. auto.
+    tauto. tauto.
+  * iIntros (??).
+    rewrite bi.and_elim_r.
+    iApply (_guard_mono with "guard"); try done.
+    by intros; rewrite !proj_frame /F0F assoc. }
+iApply (guard_mono with "H"); try done.
+by intros; rewrite /F0F; monPred.unseal; rewrite (bi.sep_comm (P _)) assoc.
 Qed.
 
-End SemaxContext.
-
-#[export] Hint Resolve age_laterR : core.
-
 Fixpoint filter_seq (k: cont) : cont :=
  match k with
   | Kseq s  k1 => filter_seq k1
@@ -749,47 +532,32 @@ Proof.
   induction l; simpl; intros; try congruence; auto.
 Qed.
 
-Lemma and_FF : forall {A} `{ageable A} {EO: Ext_ord A} (P:pred A),
-  P && FF = FF.
-Proof.
-  intros. rewrite andp_comm. apply FF_and.
-Qed.
-
-Lemma sepcon_FF : forall {A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A} (P:pred A),
-  (P * FF = FF)%pred.
-Proof.
-  intros. rewrite sepcon_comm. apply FF_sepcon.
-Qed.
-
 Section extensions.
 
 Lemma safe_loop_skip:
-  forall {Espec: OracleKind}
-    ge ora f ve te k m,
-    jsafeN (@OK_spec Espec) ge ora
-           (State f (Sloop Clight.Sskip Clight.Sskip) k ve te) m.
+  forall ge E ora f ve te k,
+    ⊢ jsafeN OK_spec ge E ora
+           (State f (Sloop Clight.Sskip Clight.Sskip) k ve te).
 Proof.
   intros.
-  remember (level m) as M.
-  generalize dependent m; induction M as [? IHM] using lt_wf_ind; intros.
-  eapply jsafeN_local_step. constructor.
-  intros.
-  eapply jsafeN_local_step. constructor. auto.
-  intros.
-  eapply jsafeN_local_step. constructor.
-  intros.
-  eapply IHM; eauto.
-  apply age_level in H. apply age_level in H0. apply age_level in H1. lia.
+  iIntros; iLöb as "IH".
+  iApply jsafe_local_step.
+  { intros; constructor. }
+  iNext; iApply jsafe_local_step.
+  { intros; constructor; auto. }
+  iNext; iApply jsafe_local_step.
+  { intros; constructor. }
+  done.
 Qed.
 
 Local Open Scope nat_scope.
 
-Definition control_as_safex {Espec: OracleKind} ge c1 k1 c2 k2 :=
-    forall (ora : OK_ty) f (ve : env) (te : temp_env) (m : juicy_mem),
-        jsafeN (@OK_spec Espec) ge ora (State f c1 k1 ve te) m ->
-          jsafeN (@OK_spec Espec) ge ora (State f c2 k2 ve te) m.
+Definition control_as_safex ge c1 k1 c2 k2 :=
+    forall E (ora : OK_ty) f (ve : env) (te : temp_env),
+        jsafeN OK_spec ge E ora (State f c1 k1 ve te) ⊢
+          jsafeN OK_spec ge E ora (State f c2 k2 ve te).
 
-Definition control_as_safe {Espec: OracleKind} ge ctl1 ctl2 :=
+Definition control_as_safe ge ctl1 ctl2 :=
  match ctl1, ctl2 with
  | Kseq c1 k1, Kseq c2 k2 =>
                    control_as_safex ge c1 k1 c2 k2
@@ -802,7 +570,7 @@ Definition control_as_safe {Espec: OracleKind} ge ctl1 ctl2 :=
  | Kseq c1 k1, Kcall _ _ _ _ _ =>
                    control_as_safex ge c1 k1 (Sreturn None) ctl2
  | Kseq _ _, _ =>
-                   False
+                   False%type
  | Kloop1 _ _ _, Kseq c2 k2 =>
                    control_as_safex ge Sskip ctl1 c2 k2
  | Kloop1 _ _ _, Kloop1 _ _ _ =>
@@ -810,7 +578,7 @@ Definition control_as_safe {Espec: OracleKind} ge ctl1 ctl2 :=
  | Kloop1 _ _ _, Kloop2 body incr k2 =>
                    control_as_safex ge Sskip ctl1 (Sloop body incr) k2
  | Kloop1 _ _ _, _ =>
-                   False
+                   False%type
  | Kloop2 b1 i1 k1, Kseq c2 k2 =>
                    control_as_safex ge (Sloop b1 i1) k1 c2 k2
  | Kloop2 b1 i1 k1, Kloop1 _ _ _ =>
@@ -818,7 +586,7 @@ Definition control_as_safe {Espec: OracleKind} ge ctl1 ctl2 :=
  | Kloop2 b1 i1 k1, Kloop2 b2 i2 k2 =>
                    control_as_safex ge (Sloop b1 i1) k1 (Sloop b2 i2) k2
  | Kloop2 _ _ _, _ =>
-                   False
+                   False%type
  | Kstop, Kseq c2 k2 =>
                    control_as_safex ge (Sreturn None) Kstop c2 k2
  | Kcall _ _ _ _ _, Kseq c2 k2=>
@@ -915,139 +683,44 @@ clear find_label_ls_None; induction s; simpl; intros; try congruence;
  rewrite (find_label_None _ _ _ H). eauto.
 Qed.
 
-Lemma guard_safe_adj' {Espec: OracleKind}:
+Lemma guard_safe_adj':
  forall
-   psi Delta f P c1 k1 c2 k2,
-  (forall ora m ve te,
-     jsafeN (@OK_spec Espec) psi ora (State f c1 k1 ve te) m ->
-     jsafeN (@OK_spec Espec) psi ora (State f c2 k2 ve te) m) ->
-  guard Espec psi Delta f P (Kseq c1 k1) |-- guard Espec psi Delta f P (Kseq c2 k2).
+   psi E Delta f P c1 k1 c2 k2,
+  (forall E ora ve te,
+     jsafeN OK_spec psi E ora (State f c1 k1 ve te) ⊢
+     jsafeN OK_spec psi E ora (State f c2 k2 ve te)) ->
+  guard' OK_spec psi E Delta f P (Kseq c1 k1) ⊢ guard' OK_spec psi E Delta f P (Kseq c2 k2).
 Proof.
 intros.
-unfold guard.
-apply allp_derives. intros tx.
-apply allp_derives. intros vx.
-apply subp_derives; auto.
-apply assert_safe_derives; split; auto; intros.
-eapply jm_fupd_mono; eauto.
+unfold guard', _guard.
+iIntros "#H" (??) "!> P".
+iSpecialize ("H" with "P").
+rewrite /assert_safe.
+iIntros (??); rewrite -H; iApply "H"; auto.
 Qed.
 
 Lemma assert_safe_adj:
-  forall {Espec: OracleKind} ge f ve te k k' rho,
+  forall ge E f ve te k k' rho,
      control_as_safe ge k k' ->
-     assert_safe Espec ge f ve te (Cont k) rho
-    |-- assert_safe Espec ge f ve te (Cont k') rho.
-Proof.
- intros. apply assert_safe_derives; split; auto; intros.
- destruct k as [ | s ctl' | | | |] eqn:Hk; try contradiction;
- destruct k' as [ | s2 ctl2' | | | |] eqn:Hk'; try contradiction;
- try discriminate; auto;
- try solve [eapply jm_fupd_mono; eauto; intros; apply H; auto].
- inv H; auto.
-Qed.
-
-Lemma assert_safe_adj':
-  forall {Espec: OracleKind} ge f ve te k k' rho P w,
-      (control_as_safe ge k k') ->
-     app_pred (P >=> assert_safe Espec ge f ve te (Cont k) rho) w ->
-     app_pred (P >=> assert_safe Espec ge f ve te (Cont k') rho) w.
-Proof.
- intros.
- eapply subp_trans'; [ | apply derives_subp; eapply assert_safe_adj; try eassumption; eauto].
- auto.
-Qed.
-
-Lemma assert_safe_last': forall {Espec: OracleKind} ge f ve te c k rho w,
-            (age1 w <> None -> assert_safe Espec ge f ve te (Cont (Kseq c k)) rho w) ->
-             assert_safe Espec ge f ve te (Cont (Kseq c k)) rho w.
-Proof.
- intros. apply assert_safe_last; intros. apply H. rewrite H0. congruence.
-Qed.
-
-Lemma pjoinable_emp_None {A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}:
-  forall w: option (psepalg.lifted JA), identity w ->  w=None.
-Proof.
-intros.
-destruct w; auto.
-exfalso.
-specialize (H None (Some l)).
-spec H.
-constructor.
-inversion H.
-Qed.
-
-Lemma pjoinable_None_emp {A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}:
-           identity (None: option (psepalg.lifted JA)).
-Proof.
-intros; intro; intros.
-inv H; auto.
-Qed.
-
-Lemma unage_mapsto:
-  forall sh t v1 v2 w, age1 w <> None -> (|> mapsto sh t v1 v2) w -> mapsto sh t v1 v2 w.
+     assert_safe OK_spec ge E f ve te (Cont k) rho ⊢
+     assert_safe OK_spec ge E f ve te (Cont k') rho.
 Proof.
   intros.
-  case_eq (age1 w); intros; try contradiction.
-  clear H.
-  specialize (H0 _ (age_laterR H1)).
-  unfold mapsto in *.
-  revert H0; case_eq (access_mode t); intros; auto.
-  destruct (type_is_volatile t); try contradiction.
-  destruct v1; try contradiction.
-  rename H into Hmode.
-  if_tac; rename H into H_READ.
-  + destruct H0 as [H0|H0]; [left | right].
-    destruct H0 as [H0' H0]; split; auto.
-    destruct H0 as [bl []]; exists bl; split; auto.
-    clear - H0 H1.
-     intro loc'; specialize (H0 loc').
-     hnf in *.
-     if_tac.
-     destruct H0 as [p ?]; exists p.
-     hnf in *.
-     rewrite preds_fmap_NoneP in *.
-     apply (age1_YES w r); auto.
-     unfold noat in *; simpl in *.
-    apply <- (age1_resource_at_identity _ _ loc' H1); auto.
-    destruct H0 as [? [v2' [bl []]]].
-    hnf in H. subst v2. split; hnf; auto. exists v2', bl; split; auto.
-    clear - H2 H1; rename H2 into H0.
-     intro loc'; specialize (H0 loc').
-     hnf in *.
-     if_tac.
-     destruct H0 as [p ?]; exists p.
-     hnf in *.
-     rewrite preds_fmap_NoneP in *.
-     apply (age1_YES w r); auto.
-     unfold noat in *; simpl in *.
-    apply <- (age1_resource_at_identity _ _ loc' H1); auto.
-  + split; [exact (proj1 H0) |].
-    destruct H0 as [_ ?].
-    intro loc'; specialize (H loc').
-    hnf in *.
-    if_tac.
-    - unfold shareat in *; simpl in *.
-      pose proof H1.
-      apply age1_resource_share with (l := loc') in H1.
-      apply age1_nonlock with (l := loc') in H2.
-      rewrite H1; tauto.
-    - unfold noat in *; simpl in *.
-      apply <- (age1_resource_at_identity _ _ loc' H1); auto.
+  rewrite /assert_safe.
+  iIntros "H" (??).
+  destruct k as [ | s ctl' | | | |] eqn:Hk; try contradiction;
+  destruct k' as [ | s2 ctl2' | | | |] eqn:Hk'; try contradiction;
+  try discriminate; rewrite -?H; iApply ("H" $! ora); auto.
 Qed.
 
-Lemma semax_Delta_subsumption {CS: compspecs} {Espec: OracleKind}:
-  forall Delta Delta' P c R,
+Lemma semax_Delta_subsumption {CS: compspecs}:
+  forall E Delta Delta' P c R,
        tycontext_sub Delta Delta' ->
-     semax Espec Delta P c R -> semax Espec Delta' P c R.
+     semax OK_spec E Delta P c R -> semax OK_spec E Delta' P c R.
 Proof.
 intros.
 unfold semax in *.
-intros.
-specialize (H0 n).
-apply (semax_extensionality1 Delta Delta' P P c R R); auto.
-split; auto.
-split; auto.
-intros ? ? ?; auto.
+rewrite -semax_mono; eauto.
 Qed.
 
 End extensions.
@@ -1100,8 +773,6 @@ Section statement_rect.
   end.
 End statement_rect.
 
-Require Import VST.msl.eq_dec.
-
 (* Equality is decidable on statements *)
 Section eq_dec.
   Local Ltac t := hnf; decide equality; auto.
@@ -1120,7 +791,7 @@ Section eq_dec.
   Let eq_dec_Z : EqDec Z. repeat t. Defined.
   Let eq_dec_calling_convention : EqDec calling_convention. repeat t. Defined.
   Lemma eq_dec_external_function : EqDec external_function. repeat t. Defined.
-  Let eq_dec_option_ident := option_eq (ident_eq).
+  Let eq_dec_option_ident := Coqlib.option_eq (ident_eq).
   Let eq_dec_option_Z : EqDec (option Z). repeat t. Defined.
   Let eq_dec_typelist : EqDec (list type). repeat t. Defined.
 
@@ -1133,15 +804,15 @@ Section eq_dec.
 
   Local Ltac eq_dec a a' :=
     let H := fresh in
-    assert (H : {a = a'} + {a <> a'}) by (auto; repeat (decide equality ; auto));
+    assert (H : {a = a'} + {a <> a'} ) by (auto; repeat (decide equality ; auto));
     destruct H; [subst; auto | try (right; congruence)].
 
   Lemma eq_dec_statement : forall s s' : statement, { s = s' } + { s <> s' }.
   Proof.
     apply
       (statement_rect
-         (fun s => forall s', { s = s' } + { s <> s' })
-         (fun l => forall l', { l = l' } + { l <> l' }));
+         (fun s => forall s', { s = s' } + { s <> s' } )
+         (fun l => forall l', { l = l' } + { l <> l' } ));
       try (intros until s'; destruct s'); intros;
       try (destruct l');
       try solve [right; congruence | left; reflexivity];
@@ -1320,171 +991,64 @@ Proof.
   eapply modifiedvars_Sswitch; eauto.
 Qed.
 
-Lemma semax_eq:
- forall {CS: compspecs} {Espec: OracleKind} Delta P c R,
-  semax Espec Delta P c R =
-  (TT |-- (ALL psi : genv,
+(*Lemma semax_eq:
+ forall {CS: compspecs} {OK_spec: OracleKind} Delta P c R,
+  semax OK_spec Delta P c R =
+  (True ⊢ (ALL psi : genv,
          ALL Delta' : tycontext, ALL CS':compspecs,
-         !! (tycontext_sub Delta Delta' /\ cenv_sub (@cenv_cs CS) (@cenv_cs CS') /\
+         !! (tycontext_sub E Delta Delta' /\ cenv_sub (@cenv_cs CS) (@cenv_cs CS') /\
                                           cenv_sub (@cenv_cs CS') (genv_cenv psi)) -->
-         @believe CS' Espec Delta' psi Delta' -->
+         @believe CS' OK_spec Delta' psi Delta' -->
          ALL k : cont ,
          ALL F : assert , ALL f: function,
          !! closed_wrt_modvars c F &&
-         rguard Espec psi Delta' f (frame_ret_assert R F) k -->
-         guard Espec psi Delta' f (fun rho : environ => F rho * P rho) (Kseq c k))).
+         rguard OK_spec psi Delta' f (frame_ret_assert R F) k -->
+         guard OK_spec psi Delta' f (fun rho : environ => F rho * P rho) (Kseq c k))).
 Proof.
 intros.
 extensionality w.
 rewrite semax_fold_unfold.
 apply prop_ext; intuition.
-Qed.
-
-Lemma semax_Slabel {cs:compspecs} {Espec: OracleKind}
-       (Gamma:tycontext) (P:environ -> mpred) (c:statement) (Q:ret_assert) l:
-@semax cs Espec Gamma P c Q -> @semax cs Espec Gamma P (Slabel l c) Q.
-Proof. intros.
-rewrite semax_eq. rewrite semax_eq in H.
-eapply derives_trans. eassumption. clear H.
-apply allp_derives; intros psi.
-apply allp_derives; intros Delta.
-apply allp_derives; intros CS'.
-apply prop_imp_derives; intros TC.
-apply imp_derives; [ apply derives_refl | ].
-apply allp_derives; intros k.
-apply allp_derives; intros F.
-apply allp_derives; intros f.
-apply imp_derives; [ apply derives_refl | ].
-apply guard_safe_adj'.
-intros.
-clear - H.
-eapply jsafeN_local_step.
-constructor.
-intros.
-eapply age_safe; eauto.
-Qed.
-
-Lemma fupd_denote_tc: forall {cs: compspecs} P t rho a,
-  denote_tc_assert t rho a -> fupd P a -> fupd (denote_tc_assert t rho && P) a.
-Proof.
-  intros.
-  repeat intro.
-  eapply H0 in H4; eauto.
-  destruct H4 as (b & ? & m & ? & ? & ? & HP); subst.
-  eexists; split; eauto; exists m; repeat split; eauto.
-  destruct HP; [left; auto|].
-(*  right; split; auto.
-  eapply denote_tc_resource; [|eauto]; auto.
-Qed.*) Abort. (* What if we put the valid_pointer info into an invariant? *)
-
-Lemma ext_compat_unnec : forall {Z} (ora : Z) w w', necR w w' -> ext_compat ora w' -> ext_compat ora w.
-Proof.
-  induction 1; auto.
-  apply ext_compat_unage; auto.
-Qed.
-
-Lemma assert_safe_jsafe: forall {Espec: OracleKind} ge f ve te c k ora jm,
-  assert_safe Espec ge f ve te (Cont (Kseq c k)) (construct_rho (filter_genv ge) ve te) (m_phi jm) ->
-  jm_fupd ora Ensembles.Full_set Ensembles.Full_set (jsafeN OK_spec ge ora (State f c k ve te)) jm.
-Proof.
-  repeat intro.
-  destruct (level (m_phi jm)) eqn: Hl.
-  { do 2 eexists; eauto; split; unfold jm_update; auto.
-    apply necR_level in H0; apply join_level in H1 as []; rewrite <- !level_juice_level_phi in *; lia. }
-  eapply H; eauto; [|lia].
-  eapply ext_compat_unnec; [apply necR_jm_phi; eauto|].
-  eapply join_sub_joins_trans; [eexists; apply ghost_of_join; eauto|].
-  eapply joins_comm, join_sub_joins_trans; [|apply joins_comm; eauto].
-  destruct H4 as [? J]; eapply ghost_fmap_join in J; eexists; eauto.
-Qed.
+Qed.*)
 
-Lemma assert_safe_jsafe': forall {Espec: OracleKind} ge f ve te k ora jm,
-  assert_safe Espec ge f ve te (Cont k) (construct_rho (filter_genv ge) ve te) (m_phi jm) ->
-  jm_fupd ora Ensembles.Full_set Ensembles.Full_set (jsafeN OK_spec ge ora (State f Sskip k ve te)) jm.
+Lemma semax_Slabel {cs:compspecs}
+       E (Gamma:tycontext) (P:assert) (c:statement) (Q:ret_assert) l:
+semax(CS := cs) OK_spec E Gamma P c Q -> semax(CS := cs) OK_spec E Gamma P (Slabel l c) Q.
 Proof.
-  repeat intro.
-  destruct (level (m_phi jm)) eqn: Hl.
-  { do 2 eexists; eauto; split; unfold jm_update; auto.
-    apply necR_level in H0; apply join_level in H1 as []; rewrite <- !level_juice_level_phi in *; lia. }
-  assert (ext_compat ora (m_phi jm)) as Hext.
-  { eapply ext_compat_unnec; [apply necR_jm_phi; eauto|].
-    eapply join_sub_joins_trans; [eexists; apply ghost_of_join; eauto|].
-    eapply joins_comm, join_sub_joins_trans; [|apply joins_comm; eauto].
-    destruct H4 as [? J]; eapply ghost_fmap_join in J; eexists; eauto. }
-  specialize (H _ _ Hext eq_refl eq_refl).
-  spec H; [lia|].
-  destruct k; eapply jm_fupd_mono; eauto; intros ? Hle Hsafe; try contradiction.
-  inv Hsafe; try discriminate; try contradiction.
-  constructor; auto.
-  eapply jsafeN_step; eauto.
-  destruct H6; split; auto. inv H6; econstructor; simpl; eauto.
-  eapply jsafeN_local_step. constructor.
-  intros.
-  eapply age_safe; eauto.
-  eapply jsafeN_local_step. constructor.
-  intros.
-  eapply age_safe; eauto.
-  inv Hsafe; try discriminate; try contradiction.
-  constructor; auto.
-  eapply jsafeN_step; eauto.
-  destruct H6; split; auto. inv H6; econstructor; simpl; eauto.
+rewrite !semax_unfold; intros.
+iIntros "H" (????) "guard".
+iApply guard_safe_adj'; last iApply (H with "H guard"); [|done..].
+intros; iIntros "H"; iApply jsafe_local_step; last done.
+constructor.
 Qed.
 
-Lemma fupd_jm_fupd : forall {Espec: OracleKind} ge (ora : OK_ty) ve te P Q jm,
-  fupd Q (m_phi jm) ->
-  proj1_sig Q = (fun w => forall (ora : OK_ty) (jm : juicy_mem),
-    ext_compat ora w ->
-    construct_rho (filter_genv ge) ve te = construct_rho (filter_genv ge) ve te ->
-    m_phi jm = w ->
-    (level w > 0)%nat -> jm_fupd ora Ensembles.Full_set Ensembles.Full_set (P ora) jm) ->
-  jm_fupd ora Ensembles.Full_set Ensembles.Full_set (P ora) jm.
+Lemma assert_safe_jsafe: forall ge E f ve te c k ora,
+  assert_safe OK_spec ge E f ve te (Cont (Kseq c k)) (construct_rho (filter_genv ge) ve te) ⊢
+  jsafeN OK_spec ge E ora (State f c k ve te).
 Proof.
-  intros.
-  intros ?????? Hinv.
-  pose proof Hinv; eapply H in Hinv; try apply necR_jm_phi; eauto.
-  intros ???. edestruct Hinv as (? & ? & z' & ? & Hr & ? & Hsafe); eauto; subst.
-  destruct (level z') eqn: Hl.
-  { exists z; split; auto; unfold jm_update; split; auto. }
-  destruct Hsafe as [HF | (? & m1 & J & ? & Hsafe)].
-  { symmetry in Hl; apply levelS_age in Hl as (? & Hage & ?).
-    rewrite later_age in HF; apply HF in Hage; contradiction. }
-  destruct (juicy_mem_resource _ _ Hr) as (jm0 & ? & ?); subst.
-  destruct (juicy_mem_sub jm0 m1) as (jm1 & ? & ?); [eexists; eauto | subst].
-  assert (level (m_phi jm1) > 0)%nat as LW1 by (apply join_level in J as []; lia).
-  unfold app_pred in Hsafe; rewrite H0 in Hsafe.
-  eapply Hsafe in LW1; eauto.
-  specialize (LW1 _ _ _ (necR_refl _) (join_comm J)); spec LW1; auto.
-  edestruct LW1 as (m'' & ? & (? & ? & ?) & Hcase); eauto.
-  { replace (level jm0) with (level (m_phi z)) by (rewrite level_juice_level_phi; congruence); auto. }
-  exists m''; split.
-  { replace (level z) with (level jm0) by (rewrite !level_juice_level_phi; congruence); auto. }
-  split; auto.
-  split; try congruence; split; try congruence.
-  rewrite !level_juice_level_phi in *; congruence.
-  + eapply join_sub_joins_trans; [eexists; apply ghost_of_join; eauto|].
-    eapply joins_comm, join_sub_joins_trans; [|apply joins_comm; eauto].
-    destruct H5 as [? J']; eapply ghost_fmap_join in J'; eexists; eauto.
+  intros; rewrite /assert_safe.
+  iIntros "H"; iApply "H"; auto.
 Qed.
 
-Lemma assert_safe_fupd : forall {Espec: OracleKind} ge f ve te c rho,
-  (match c with Ret _ _ => False | _ => True end) ->
-  fupd (assert_safe Espec ge f ve te c rho) |-- assert_safe Espec ge f ve te c rho.
+Lemma assert_safe_jsafe': forall ge E f ve te k ora,
+  assert_safe OK_spec ge E f ve te (Cont k) (construct_rho (filter_genv ge) ve te) ⊢
+  jsafeN OK_spec ge E ora (State f Sskip k ve te).
 Proof.
-  intros.
-  destruct c; try contradiction; clear H;
-  intros ????????; subst;
-  [|destruct c; try (eapply fupd_jm_fupd with (P := fun ora => jsafeN OK_spec ge ora _); eauto; reflexivity)];
-  eapply fupd_jm_fupd with (P := fun _ _ => False); eauto; reflexivity.
+  intros; rewrite /assert_safe.
+  iIntros "H"; iSpecialize ("H" with "[%]"); first done.
+  destruct k; try iMod "H" as "[]"; try done.
+  - iApply (convergent_controls_jsafe with "H"); simpl; try congruence.
+    by inversion 1; constructor.
+  - iApply jsafe_step.
+    rewrite /jstep_ex.
+    iIntros (m) "? !>".
+    iExists _, m; iFrame; iPureIntro; split; auto; constructor.
+  - iApply jsafe_step.
+    rewrite /jstep.
+    iIntros (m) "? !>".
+    iExists _, m; iFrame; iPureIntro; split; auto; constructor.
+  - iApply (convergent_controls_jsafe with "H"); simpl; try congruence.
+    by inversion 1; constructor.
 Qed.
 
-Lemma jm_fupd_local_step
-     : forall {Espec: OracleKind} (ge : genv) (ora : OK_ty) (s1 : CC_core)
-         (m : juicy_mem) (s2 : CC_core),
-       cl_step ge s1 (m_dry m) s2 (m_dry m) ->
-       (forall m' : juicy_mem,
-        age m m' -> jm_bupd ora (jsafeN (@OK_spec Espec) ge ora s2) m') ->
-       jm_fupd ora Ensembles.Full_set Ensembles.Full_set (jsafeN (@OK_spec Espec) ge ora s1) m.
-Proof.
-intros.
-destruct (age1 m) as [m' | ] eqn:?H.
-Abort.
+End SemaxContext.
diff --git a/veric/semax_loop.v b/veric/semax_loop.v
index 33dff1694a..c2e9ac7dd1 100644
--- a/veric/semax_loop.v
+++ b/veric/semax_loop.v
@@ -1,10 +1,12 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.juicy_base.
-Require Import VST.msl.normalize.
-Require Import VST.veric.juicy_mem VST.veric.juicy_mem_lemmas VST.veric.juicy_mem_ops.
+Require Import VST.veric.juicy_mem.
 Require Import VST.veric.res_predicates.
+Require Import VST.veric.external_state.
 Require Import VST.veric.extend_tc.
 Require Import VST.veric.Clight_seplog.
 Require Import VST.veric.Clight_assert_lemmas.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.Clight_core.
 Require Import VST.sepcomp.extspec.
 Require Import VST.sepcomp.step_lemmas.
@@ -17,164 +19,96 @@ Require Import VST.veric.semax_lemmas.
 Require Import VST.veric.semax_conseq.
 Require Import VST.veric.Clight_lemmas.
 
-Local Open Scope pred.
 Local Open Scope nat_scope.
 
 Section extensions.
-Context {CS: compspecs} {Espec : OracleKind}.
+Context `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs}.
+
+Local Arguments typecheck_expr : simpl never.
 
 Lemma tc_test_eq1:
   forall b i v m,
-  (denote_tc_test_eq (Vptr b i) v) (m_phi m) ->
-  Mem.weak_valid_pointer (m_dry m) b (Ptrofs.unsigned i) = true.
+  mem_auth m ∗ denote_tc_test_eq (Vptr b i) v ⊢
+  ⌜Mem.weak_valid_pointer m b (Ptrofs.unsigned i) = true⌝.
 Proof.
-intros.
-destruct v; try destruct H.
-apply binop_lemmas4.weak_valid_pointer_dry in H0;
-apply H0.
-simpl in H.
-unfold test_eq_ptrs in H.
-destruct (sameblock (Vptr b i) (Vptr b0 i0)).
-destruct H;
-apply binop_lemmas4.weak_valid_pointer_dry in H; auto.
-destruct H.
-apply valid_pointer_implies.
-apply binop_lemmas4.valid_pointer_dry in H.
-rewrite Z.add_0_r in H. auto.
+intros; iIntros "[Hm H]".
+destruct v; try done; simpl.
+- iDestruct "H" as "[% H]".
+  iApply (binop_lemmas4.weak_valid_pointer_dry with "[$Hm $H]").
+- unfold test_eq_ptrs.
+  destruct (sameblock (Vptr b i) (Vptr b0 i0)).
+  + iDestruct "H" as "[H _]".
+    iApply (binop_lemmas4.weak_valid_pointer_dry with "[$Hm $H]").
+  + iDestruct "H" as "[H _]".
+    iDestruct (binop_lemmas4.valid_pointer_dry with "[$Hm $H]") as %?; iPureIntro.
+    apply valid_pointer_implies.
+    rewrite Z.add_0_r // in H.
 Qed.
 
 Lemma semax_ifthenelse:
-   forall Delta P (b: expr) c d R,
+   forall E Delta P (b: expr) c d R,
       bool_type (typeof b) = true ->
-     semax Espec Delta (fun rho => P rho && !! expr_true b rho) c R ->
-     semax Espec Delta (fun rho => P rho && !! expr_false b rho) d R ->
-     semax Espec Delta
-              (fun rho => |> (tc_expr Delta (Eunop Cop.Onotbool b (Tint I32 Signed noattr)) rho && P rho))
+     semax OK_spec E Delta (P ∧ local (expr_true b)) c R ->
+     semax OK_spec E Delta (P ∧ local (expr_false b)) d R ->
+     semax OK_spec E Delta
+              (▷ (tc_expr Delta (Eunop Cop.Onotbool b (Tint I32 Signed noattr)) ∧ P))
               (Sifthenelse b c d) R.
 Proof.
-intros.
-rewrite semax_unfold in H0, H1 |- *.
-intros.
-specialize (H0 psi _ _ _ TS HGG Prog_OK k F f).
-specialize (H1 psi _ _ _ TS HGG Prog_OK k F f).
-spec H0.  {
-  intros i te' ?.  apply H2; simpl; auto. intros i0; destruct (H4 i0); try tauto; intuition.
-  left; clear - H5.
- unfold modifiedvars. simpl.
- apply modifiedvars'_union. left; apply H5.
-}
-spec H1. {
- intros i te' ?.  apply H2; simpl; auto.
- clear - H4; intros i0; destruct (H4 i0); try tauto; intuition.
- left.
- unfold modifiedvars. simpl.
- apply modifiedvars'_union. right; apply H.
-}
-assert (H3then: app_pred
-       (rguard Espec psi Delta' f (frame_ret_assert R F) k) w).
-clear - H3.
-intros ek vl tx vx; specialize (H3 ek vl tx vx).
-cbv beta in H3.
-eapply subp_trans'; [ | apply H3].
-apply derives_subp; apply andp_derives; auto.
-assert (H3else: app_pred
-       (rguard Espec psi Delta' f (frame_ret_assert R F) k) w).
-clear - H3.
-intros ek vl tx vx; specialize (H3 ek vl tx vx).
-eapply subp_trans'; [ | apply H3].
-apply derives_subp; apply andp_derives; auto.
-specialize (H0 H3then).
-specialize (H1 H3else).
-clear Prog_OK H3 H3then H3else.
-intros tx vx; specialize (H0 tx vx); specialize (H1 tx vx).
-remember (construct_rho (filter_genv psi) vx tx) as rho.
-slurp.
-rewrite <- fash_and.
-intros a' a'' ? Hext. clear w H0.
-apply fash_derives.
-intros w [? ?].
-intros ? w0 ? Hext' [[?TC  ?] ?].
-assert (typecheck_environ Delta rho) as TC_ENV. {
-  destruct TC as [TC _].
-  eapply typecheck_environ_sub; eauto.
-}
-destruct (level w0) eqn: Hl.
-{ intros ?; lia. }
-symmetry in Hl; apply levelS_age in Hl as (w0' & Hage & ?); subst n.
-eapply sepcon_derives in H4; [| apply now_later | apply derives_refl].
-rewrite <- later_sepcon in H4.
-specialize (H4 w0'); spec H4; [constructor; auto|].
-apply extend_sepcon_andp in H4; auto.
-destruct H4 as [TC2 H4].
-pose proof TC2 as TC2'.
-apply (tc_expr_sub _ _ _ TS) in TC2'; [| auto].
-destruct H4 as [w1 [w2 [? [? ?]]]].
-eapply age_ext_commut in Hext' as [a0 Hext' Hage']; eauto.
-assert (necR w a0) as Hnec by (eapply rt_trans; eauto; constructor; auto); clear Hage'.
-specialize (H0 _ _ Hnec Hext').
-specialize (H1 _ _ Hnec Hext').
-unfold expr_true, expr_false, Cnot in *.
-
-pose proof (typecheck_expr_sound _ _ _ _ TC_ENV TC2) as HTCb; simpl in HTCb.
-unfold liftx, lift, eval_unop in HTCb; simpl in HTCb.
-destruct (bool_val (typeof b) (eval_expr b rho)) as [b'|] eqn: Hb; [|contradiction].
-assert ((assert_safe Espec psi f vx tx (Cont (Kseq (if b' then c else d) k))
-  (construct_rho (filter_genv psi) vx tx)) w0') as Hw0.
-{ unfold tc_expr in TC2; simpl in TC2.
-  rewrite denote_tc_assert_andp in TC2; destruct TC2.
-  destruct b'; [apply H0 | apply H1]; split; subst; try solve [eapply pred_hereditary; eauto]; split; auto; do 3 eexists; eauto; split;
-    auto; split; auto; apply bool_val_strict; auto; eapply typecheck_expr_sound; eauto. }
-destruct HGG as [CSUB HGG]. apply (@tc_expr_cenv_sub _ _ CSUB) in TC2'.
-rename TC2' into Htc.
-intros ora jm Hora Hge Hphi ?.
-apply jm_fupd_intro'.
-generalize LW; intro H9.
-subst w0.
-change (level (m_phi jm)) with (level jm) in H9.
-revert H9; case_eq (level jm); intros ? Hl.
-lia.
-apply levelS_age1 in Hl. destruct Hl as [jm' Hage'].
-unfold age in Hage; erewrite age_jm_phi in Hage by eauto; inversion Hage; clear Hage; subst w0'.
-generalize (eval_expr_relate _ _ _ _ _ b jm' HGG Hge (guard_environ_e1 _ _ _ TC)); intro.
-intros _.
-eapply jsafeN_step, assert_safe_jsafe, Hw0.
-split3.
-assert (TCS := typecheck_expr_sound _ _ (m_phi jm') _ (guard_environ_e1 _ _ _ TC) Htc). 
-unfold tc_expr in Htc.
-simpl in Htc.
-rewrite denote_tc_assert_andp in Htc.
-destruct Htc as [TC2' TC2'a].
-rewrite (age_jm_dry Hage'); econstructor; eauto.
-{
- assert (exists b': bool, Cop.bool_val (@eval_expr CS' b rho) (typeof b) (m_dry jm') = Some b') as [].
-  { clear - TS TC H TC2 TC2' TC2'a TCS CSUB.
-    simpl in TCS. unfold_lift in TCS.
-    unfold Cop.bool_val;
-      destruct (@eval_expr CS' b rho) eqn:H15;
-      simpl; destruct (typeof b) as [ | [| | | ] [| ]| | [ | ] |  | | | | ] eqn:?;
-      try tauto; simpl in *; try rewrite TCS; eauto.
-  all: try apply (tc_expr_cenv_sub CSUB) in TC2.
-    all: try (
-             unfold tc_expr in TC2; simpl typecheck_expr in TC2; rewrite Heqt in TC2;
-             rewrite denote_tc_assert_andp in TC2; destruct TC2 as [_ TC2];
-             destruct TC as [TC _];
-             assert (H2 := typecheck_expr_sound _ _ _ _  (typecheck_environ_sub _ _ TS _ TC) TC2);
-             rewrite Heqt, H15 in H2; contradiction H2).
-   all:   rewrite denote_tc_assert_andp in TC2'; destruct TC2' as [TC2'' TC2'];
-      rewrite binop_lemmas2.denote_tc_assert_test_eq' in  TC2';
-      simpl in TC2'; unfold_lift in TC2';  try rewrite H15 in TC2'.
-    all: destruct Archi.ptr64 eqn:Hp; try contradiction; eauto.
-    all: try (apply tc_test_eq1 in TC2'; simpl; rewrite TC2'; eauto).
-  }
-  apply (bool_val_cenv_sub CSUB) in Hb.
-  rewrite H9; symmetry; eapply f_equal, bool_val_Cop; eauto. }
-apply age1_resource_decay; auto.
-split; [apply age_level; auto|].
-erewrite (age1_ghost_of _ _ (age_jm_phi Hage')) by (symmetry; apply ghost_of_approx).
-repeat intro; auto.
+  intros.
+  rewrite !semax_unfold in H0, H1 |- *.
+  intros.
+  iIntros "#Prog_OK" (????) "[(%Hclosed & %) #rguard]".
+  iPoseProof (H0 with "Prog_OK [rguard]") as "H0"; [done..| |].
+  { iIntros "!>"; iFrame "rguard"; iPureIntro.
+    split; last done; split; last done.
+    unfold closed_wrt_modvars, closed_wrt_vars in *; intros ?? Hi; apply Hclosed.
+    intros i; specialize (Hi i); rewrite modifiedvars_Sifthenelse; tauto. }
+  iPoseProof (H1 with "Prog_OK [rguard]") as "H1"; [done..| |].
+  { iIntros "!>"; iFrame "rguard"; iPureIntro.
+    split; last done; split; last done.
+    unfold closed_wrt_modvars, closed_wrt_vars in *; intros ?? Hi; apply Hclosed.
+    intros i; specialize (Hi i); rewrite modifiedvars_Sifthenelse; tauto. }
+  iIntros (tx vx) "!> H".
+  iIntros (??).
+  iApply jsafe_step.
+  iIntros (m) "[Hm ?]".
+  monPred.unseal.
+  iDestruct "H" as "(%TC & (F & P) & fun)".
+  unfold expr_true, expr_false, Cnot, lift1 in *.
+  set (rho := construct_rho _ _ _) in *.
+  assert (typecheck_environ Delta rho) as TYCON_ENV
+    by (destruct TC as [TC' TC'']; eapply typecheck_environ_sub; eauto).
+  rewrite (add_and (▷ _) (▷ _)); last by iIntros "[H _]"; iApply (typecheck_expr_sound with "H").
+  iDestruct "P" as "[P >%HTCb]".
+  assert (cenv_sub (@cenv_cs CS) psi) by (eapply cenv_sub_trans; destruct HGG; auto).
+  iCombine "Hm P" as "H"; rewrite (add_and (mem_auth m ∗ _) (▷_)); last by iIntros "H"; iNext; iDestruct "H" as "(Hm & H & _)"; iApply (eval_expr_relate(CS := CS) with "[$Hm $H]").
+  iDestruct "H" as "(H & >%Heval)".
+  rewrite /tc_expr /typecheck_expr /= denote_tc_assert_andp; fold (typecheck_expr(CS := CS)).
+  rewrite -assoc (bi.and_elim_r (denote_tc_assert _ _)).
+  rewrite (add_and (mem_auth m ∗ _) (▷_)); last by iIntros "H"; iNext; iDestruct "H" as "(Hm & H & _)"; iApply (eval_expr_relate(CS := CS) with "[$Hm $H]").
+  iDestruct "H" as "(H & >%Hb)".
+  inv Heval.
+  eapply eval_expr_fun in Hb; last done; subst.
+  rewrite typecheck_expr_sound; last done.
+  rewrite bi.later_and.
+  iDestruct "H" as "(Hm & >%TC2 & P)"; simpl in HTCb.
+  unfold liftx, lift, eval_unop in HTCb; simpl in HTCb.
+  destruct (bool_val (typeof b) (eval_expr b _)) as [b'|] eqn: Hb; [|contradiction].
+  iAssert (▷assert_safe OK_spec psi E' f vx tx (Cont (Kseq (if b' then c else d) k)) _) with "[F P fun]" as "Hsafe".
+  { iNext; destruct b'; [iApply "H0" | iApply "H1"]; (iSplit; first done); iFrame; iPureIntro; split; auto;
+      apply bool_val_strict; auto. }
+  simpl in *; unfold Cop.sem_notbool in *.
+  destruct (Cop.bool_val _ _ _) eqn: Hbool_val; inv H10.
+  super_unfold_lift.
+  iIntros "!>"; iExists _, _; iSplit.
+  - iPureIntro; eapply step_ifthenelse; eauto.
+  - iFrame; iNext.
+    eapply bool_val_Cop in Hbool_val; eauto; subst.
+    by iApply assert_safe_jsafe.
+  - inv H5.
 Qed.
 
-Ltac inv_safe H :=
+(*Ltac inv_safe H :=
   inv H;
   try solve[match goal with
     | H : semantics.at_external _ _ _ = _ |- _ =>
@@ -183,519 +117,248 @@ Ltac inv_safe H :=
       simpl in H; congruence
     | H : semantics.halted _ _ _ |- _ =>
       simpl in H; unfold cl_halted in H; contradiction
-  end].
+  end].*)
 
 Lemma semax_seq:
-  forall Delta (R: ret_assert) P Q h t,
-  semax Espec Delta P h (overridePost Q R) ->
-  semax Espec Delta Q t R ->
-  semax Espec Delta P (Clight.Ssequence h t) R.
+  forall E Delta (R: ret_assert) P Q h t,
+  semax OK_spec E Delta P h (overridePost Q R) ->
+  semax OK_spec E Delta Q t R ->
+  semax OK_spec E Delta P (Clight.Ssequence h t) R.
 Proof.
-intros.
-rewrite semax_unfold in H,H0|-*.
-intros.
-specialize (H psi _ CS' w TS HGG Prog_OK).
-specialize (H0 psi Delta' CS' w).
-spec H0; auto.
-spec H0; auto.
-spec H0. {
-clear - Prog_OK.
-unfold believe in *.
-unfold believe_internal in *.
-intros v fsig cc A P Q; specialize (Prog_OK v fsig cc A P Q).
-intros ? a' ? Hext H0. specialize (Prog_OK _ _ H Hext).
-spec Prog_OK.
-destruct H0 as [id [NEP [NEQ [? ?]]]]. exists id, NEP, NEQ; split; auto.
-auto.
-}
-assert ((guard Espec psi Delta' f (fun rho : environ => F rho * P rho)%pred
-(Kseq h (Kseq t k))) w).
-2:{
-eapply guard_safe_adj'; try apply H3; try reflexivity.
-intros.
-eapply jsafeN_local_step.
-constructor.
-intros.
-eapply age_safe; eauto.
-}
-eapply H; eauto.
-repeat intro; apply H1.
-clear - H3. intro i; destruct (H3 i); [left | right]; auto.
-unfold modifiedvars in H|-*. simpl. apply modifiedvars'_union.
-left; auto.
-clear - HGG H0 H1 H2.
-intros ek vl.
-intros tx vx.
-rewrite proj_frame_ret_assert.
-destruct (eq_dec ek EK_normal).
-*
-subst.
-unfold exit_cont.
-unfold guard in H0.
-remember (construct_rho (filter_genv psi) vx tx) as rho.
-assert (app_pred
-(!!guard_environ Delta' f rho &&
-(F rho * (Q rho)) && funassert Delta' rho >=>
-assert_safe Espec psi f vx tx (Cont (Kseq t k)) rho)%pred w). {
-subst.
-specialize (H0 k F f).
-spec H0.
-clear - H1;
-repeat intro; apply H1. simpl.
-intro i; destruct (H i); [left | right]; auto.
-unfold modifiedvars in H0|-*. simpl. apply modifiedvars'_union.
-auto.
-spec H0.
-clear - H2.
-intros ek vl te ve; specialize (H2 ek vl te ve).
-eapply subp_trans'; [ | apply H2].
-apply derives_subp. apply andp_derives; auto.
-specialize (H0 tx vx). cbv beta in H0.
-apply H0.
-}
-simpl proj_ret_assert.
-destruct vl.
-repeat intro. destruct H6 as [[_ [? [? [? [[? _] _]]]]] _]; discriminate.
-eapply subp_trans'; [ | apply H].
-apply derives_subp. apply andp_derives; auto.
- apply andp_derives; auto.
-rewrite sepcon_comm;
-apply sepcon_derives; auto.
-apply andp_left2.
-destruct R; simpl; auto.
-*
-replace (exit_cont ek vl (Kseq t k)) with (exit_cont ek vl k)
-by (destruct ek; simpl; congruence).
-unfold rguard in H2.
-specialize (H2 ek vl tx vx).
-eapply subp_trans'; [ | apply H2].
-apply derives_subp.
-apply andp_derives; auto.
-apply andp_derives; auto.
-rewrite proj_frame_ret_assert.
-destruct R, ek; simpl; auto. contradiction n; auto.
-Qed.
-
-(*
-Lemma control_as_safe_refl psi n k : control_as_safe psi n k k.
-Proof.
-hnf.
-intros ??? H; inversion 1; subst. constructor.
-econstructor; eauto.
-simpl in *. congruence.
-simpl in H1. unfold cl_halted in H1. congruence.
+  intros.
+  rewrite !semax_unfold in H,H0|-*.
+  intros.
+  iIntros "#Prog_OK" (????) "[(%Hclosed & %) #rguard]".
+  iPoseProof (H with "Prog_OK") as "H"; [done..|].
+  iPoseProof (H0 with "Prog_OK [rguard]") as "H0"; [done..| |].
+  { iIntros "!>"; iFrame "rguard"; iPureIntro.
+    split; last done; split; last done.
+    unfold closed_wrt_modvars, closed_wrt_vars in *; intros ?? Hi; apply Hclosed.
+    intros i; specialize (Hi i); rewrite modifiedvars_Ssequence; tauto. }
+  iSpecialize ("H" $! (Kseq t k) F with "[H0]"); last by iApply (guard_safe_adj' with "H");
+    intros; iIntros "H"; iApply (jsafe_local_step with "H"); constructor.
+  iIntros "!>"; iSplit.
+  { iPureIntro; split; last done.
+    unfold closed_wrt_modvars, closed_wrt_vars in *; intros ?? Hi; apply Hclosed.
+    intros i; specialize (Hi i); rewrite modifiedvars_Ssequence; tauto. }
+  iIntros (????) "!> H".
+  rewrite proj_frame.
+  destruct (eq_dec ek EK_normal).
+  - subst; rewrite /proj_ret_assert.
+    monPred.unseal; iDestruct "H" as "(% & (? & [% ?]) & ?)"; subst; destruct R; simpl.
+    iApply "H0"; by iFrame.
+  - replace (exit_cont ek vl (Kseq t k)) with (exit_cont ek vl k)
+      by (destruct ek; simpl; congruence).
+    iApply "rguard".
+    monPred.unseal; rewrite (bi.sep_comm (F _)).
+    destruct R, ek; simpl; monPred.unseal; rewrite ?pure_and_sep_assoc //.
 Qed.
-*)
-
-(*
-Definition control_as_safex {Espec: OracleKind} ge n c1 k1 c2 k2 :=
-    forall (ora : OK_ty) f (ve : env) (te : temp_env) (m : juicy_mem) (n' : nat),
-        n' <= n ->
-        jsafeN (@OK_spec Espec) ge n' ora (State f c1 k1 ve te) m ->
-          jsafeN (@OK_spec Espec) ge n' ora (State f c2 k2 ve te) m.
-*)
 
 Lemma semax_loop:
-forall Delta Q Q' incr body R,
-     semax Espec Delta Q body (loop1_ret_assert Q' R) ->
-     semax Espec Delta Q' incr (loop2_ret_assert Q R) ->
-     semax Espec Delta Q (Sloop body incr) R.
+forall E Delta Q Q' incr body R,
+     semax OK_spec E Delta Q body (loop1_ret_assert Q' R) ->
+     semax OK_spec E Delta Q' incr (loop2_ret_assert Q R) ->
+     semax OK_spec E Delta Q (Sloop body incr) R.
 Proof.
-  intros ? ? ? ? ?  POST H H0.
+  intros ?????? POST H H0.
   rewrite semax_unfold.
-  intros until 4.
-  rename H1 into H2.
-  assert (CLO_body: closed_wrt_modvars body F).
-  {
-    clear - H2. intros rho te ?. apply (H2 rho te). simpl.
-    intro; destruct (H i); auto. left; unfold modifiedvars in H0|-*; simpl;
-    apply modifiedvars'_union; auto.
-  }
-  assert (CLO_incr:  closed_wrt_modvars incr F).
-  {
-    clear - H2. intros rho te ?. apply (H2 rho te). simpl.
-    intro; destruct (H i); auto. left; unfold modifiedvars in H0|-*; simpl;
-    apply modifiedvars'_union; auto.
-  }
-  revert Prog_OK; induction w using (well_founded_induction lt_wf); intros.
-  intros tx vx.
-  intros ? ? ? ? ? Hext [[? ?] ?]. hnf in H6.
-  apply assert_safe_last; intros a2 LEVa2.
-  assert (NEC2: necR w (level a2)).
-  {
-    apply age_level in LEVa2. apply necR_nat in H5. apply nec_nat in H5.
-    change w with (level w) in H4|-*. apply nec_nat. apply ext_level in Hext. clear - H4 H5 LEVa2 Hext.
-    lia.
-  }
-  assert (LT: level a2 < level w).
-  {
-    apply age_level in LEVa2. apply necR_nat in H5. apply ext_level in Hext.
-    clear - H4 H5 LEVa2 Hext.
-    change w with (level w) in H4.
-    change R.rmap with rmap in *.  rewrite LEVa2 in *.  clear LEVa2.
-    apply nec_nat in H5. lia.
-  }
-  assert (Prog_OK2: (believe Espec Delta' psi Delta') (level a2))
-    by (apply pred_nec_hereditary with w; auto).
-  generalize (pred_nec_hereditary _ _ _ NEC2 H3); intro H3'.
-  remember (construct_rho (filter_genv psi) vx tx) as rho.
-  pose proof I.
-  eapply semax_Delta_subsumption in H; try apply TS; auto.
-  eapply semax_Delta_subsumption in H0; try apply TS; auto.
-  clear Delta TS.
-  generalize H; rewrite semax_unfold; intros H'.
-  intros ora jm Hora RE ??; subst.
-  apply jm_fupd_intro'.
-  destruct (can_age1_juicy_mem _ _ LEVa2) as [jm2 LEVa2'].
-  unfold age in LEVa2.
-  assert (a2 = m_phi jm2).
-  {
-    generalize (age_jm_phi LEVa2'); unfold age; change R.rmap with rmap.
-    change R.ag_rmap with ag_rmap; rewrite LEVa2.
-    intro Hx; inv Hx; auto.
-  }
-  subst a2.
-  apply jsafeN_step
-   with (State f body (Kloop1 body incr k) vx tx)
-          jm2.
-  {
-    split.
-    rewrite <- (age_jm_dry LEVa2').
-    constructor.
-    split3.
-    + apply age1_resource_decay; auto.
-    +apply age_level; auto.
-    +  apply age1_ghost_of; auto.
-  }
-  apply assert_safe_jsafe; auto.
-  assert (H10 := laterR_necR (age_laterR LEVa2')).
-  specialize (H1 (level jm2) LT).
-  clear RE w NEC2 Prog_OK H3 H4 LT y H5.
-  assert (H10' := laterR_necR (age_laterR (age_jm_phi LEVa2'))).
-  eapply ext_join_approx in Hora. erewrite <- necR_ghost_of in Hora by eauto.
-  apply (pred_nec_hereditary _ _ _  H10') in H7.
-  apply (pred_nec_hereditary _ _ _  H10') in H8.
-  clear jm Hext LEVa2 LEVa2' LW H10 H10' H9.
-  rename H3' into H3. rename Prog_OK2 into Prog_OK.
-  specialize (H' psi Delta' CS' (level jm2) (tycontext_sub_refl _) HGG Prog_OK).
-  specialize (H' (Kloop1 body incr k) F f CLO_body).
-  specialize (H1 Prog_OK H3).
-  rename jm2 into jm.
-  spec H'. {
-   clear H'.
-  intros ek vl.
+  intros ?????.
+  iLöb as "IH".
+  iIntros "#Prog_OK" (????) "[(%Hclosed & %) #rguard]".
+  iIntros (??) "!> H".
+  iIntros (??).
+  set (rho := construct_rho _ _ _).
+  iApply jsafe_step; rewrite /jstep_ex.
+  iIntros (?) "? !>".
+  iExists (State f body (Kloop1 body incr k) vx tx), _; iSplit; first by iPureIntro; constructor.
+  iFrame; iNext.
+  iApply assert_safe_jsafe.
+  rewrite semax_unfold in H.
+  iApply (H with "Prog_OK"); [done..| |done].
+  iIntros "!>"; iSplit.
+  { iPureIntro; split; last done.
+    unfold closed_wrt_modvars, closed_wrt_vars in *; intros ?? Hi; apply Hclosed.
+    intros i; specialize (Hi i); rewrite modifiedvars_Sloop; tauto. }
+  iIntros (??).
+  rewrite semax_unfold in H0.
+  iPoseProof (H0 with "Prog_OK") as "H0"; [done..|].
+  iSpecialize ("IH" with "Prog_OK").
+  assert (closed_wrt_modvars incr F).
+  { unfold closed_wrt_modvars, closed_wrt_vars in *; intros ?? Hi; apply Hclosed.
+    intros i; specialize (Hi i); rewrite modifiedvars_Sloop; tauto. }
+  iAssert (guard' OK_spec psi E' Delta' f (F ∗ Q') (Kseq incr (Kloop2 body incr k))) as "#Hincr".
+  { iApply "H0".
+    iIntros "!>"; iSplit; first done.
+    iIntros (ek2 vl2 tx2 vx2) "!>"; rewrite /loop2_ret_assert proj_frame.
+    destruct ek2; simpl proj_ret_assert; simpl exit_cont; monPred.unseal.
+    * iIntros "(% & (? & % & ?) & ?)"; subst.
+      iApply ("IH" $! _ F); last by destruct POST; iFrame.
+      iIntros "!>"; iSplit; done.
+    * iIntros "(% & (? & % & ?) & ?)"; subst.
+      destruct POST; iApply ("rguard" $! EK_normal None); simpl; monPred.unseal; by iFrame.
+    * destruct POST; simpl.
+      iIntros "(% & (? & % & []) & ?)".
+    * destruct POST; simpl.
+      iIntros "(% & (? & ?) & ?)".
+      iApply ("rguard" $! EK_return); simpl; monPred.unseal; by iFrame. }
+  iIntros (??) "!>".
   destruct ek.
-  + simpl exit_cont.
-    rewrite semax_unfold in H0.
-    specialize (H0 psi _ CS' (level jm) (tycontext_sub_refl _)  HGG Prog_OK (Kloop2 body incr k) F f CLO_incr).
-    spec H0.    {
-      intros ek2 vl2 tx2 vx2; unfold loop2_ret_assert.
-      destruct ek2.
-      +  simpl proj_ret_assert.
-          destruct vl2. intros ? ? ? ? ? Hext [[_ [? _]] _]; discriminate.
-          rewrite (prop_true_andp (None=None)) by auto.
-        apply @assert_safe_adj' with (k:=Kseq (Sloop body incr) k); auto.
-        - simpl; repeat intro. auto.
-        - eapply subp_trans'; [ |  eapply H1].
-          apply derives_subp.
-          apply andp_derives; auto.
-          apply andp_derives; auto.
-          destruct POST; simpl.
-          unfold frame_ret_assert. normalize.
-          rewrite sepcon_comm. auto.
-      + unfold exit_cont.
-        apply @assert_safe_adj' with (k:= k); auto.
-        - simpl. destruct k; simpl; auto; hnf; auto.
-        - simpl proj_ret_assert.
-          eapply subp_trans'; [ |  eapply (H3 EK_normal None tx2 vx2)].
-          apply derives_subp.
-          apply andp_derives; auto.
-          apply andp_derives; auto.
-          simpl exit_cont.
-          rewrite proj_frame_ret_assert. simpl proj_ret_assert. simpl seplog.sepcon.
-          normalize.
-          destruct POST; simpl; auto.
-      + rewrite proj_frame_ret_assert. simpl seplog.sepcon.
-        destruct POST; simpl tycontext.RA_continue. cbv zeta. normalize.
-      + rewrite proj_frame_ret_assert.
-        change (exit_cont EK_return vl2 (Kloop2 body incr k))
-          with (exit_cont EK_return vl2 k).
-        eapply subp_trans'; [ | apply H3].
-        rewrite proj_frame_ret_assert.
-        clear. simpl proj_ret_assert.
-        destruct POST; simpl tycontext.RA_return.
-        apply subp_refl'.
-    }
-    intros tx2 vx2.
-    destruct vl.
-    simpl proj_ret_assert.
-    intros ? ? ? ? ? Hext [[_ [? _]] _]; discriminate.
-    apply @assert_safe_adj' with (k:= Kseq incr (Kloop2 body incr k)); auto.
-    simpl. repeat intro. eapply jsafeN_local_step. econstructor; auto.
-    intros; eapply age_safe; eauto.
-    eapply subp_trans'; [ | apply H0].
-    apply derives_subp.
-    unfold frame_ret_assert.
-    apply andp_derives; auto.
-    apply andp_derives; auto.
-    simpl exit_cont.
-    rewrite sepcon_comm. destruct POST; simpl proj_ret_assert. normalize.
-  + intros tx3 vx3.
-    rewrite proj_frame_ret_assert. simpl proj_ret_assert.
-    simpl seplog.sepcon. cbv zeta.
-    eapply subp_trans'; [ | apply (H3 EK_normal None tx3 vx3)].
-    rewrite proj_frame_ret_assert.
-    destruct POST; simpl tycontext.RA_break; simpl proj_ret_assert.
-    apply derives_subp. simpl seplog.sepcon.
-    apply andp_derives; auto.
-    normalize.
-  + simpl exit_cont.
-    rewrite proj_frame_ret_assert.
-    intros tx2 vx2. cbv zeta. simpl seplog.sepcon.
-    destruct POST; simpl tycontext.RA_continue.
-    rewrite semax_unfold in H0.
-    eapply subp_trans'; [ | apply (H0 _ _ CS' _ (tycontext_sub_refl _) HGG Prog_OK (Kloop2 body incr k) F f CLO_incr)].
-    {
-      apply derives_subp.
-      apply andp_derives; auto.
-      rewrite sepcon_comm.
-      apply andp_derives; auto. normalize.
-    }
-    clear tx2 vx2.
-    intros ek2 vl2 tx2 vx2.
-    destruct ek2.
-    {
-    unfold exit_cont.
-    destruct vl2.
-    intros ? ? ? ? ? Hext [[_ [? _]] _]; discriminate.
-    apply @assert_safe_adj' with (k:=Kseq (Sloop body incr) k); auto.
-    - repeat intro. auto.
-    - eapply subp_trans'; [ | eapply H1; eauto].
-      apply derives_subp.
-      apply andp_derives; auto.
-      apply andp_derives; auto.
-      * unfold exit_cont, loop2_ret_assert; normalize.
-        specialize (H3 EK_return None tx2 vx2).
-        intros tx4 vx4.
-        rewrite proj_frame_ret_assert in H3, vx4.
-        simpl seplog.sepcon in H3,vx4. cbv zeta in H3, vx4.
-        normalize in vx4.        
-        rewrite sepcon_comm; auto.
-    }
-    {
-    unfold exit_cont.
-    apply @assert_safe_adj' with (k := k); auto.
-    - simpl. destruct k; simpl; repeat intro; auto.
-    - 
-    destruct vl2.
-    intros ? ? ? ? ? Hext [[_ [? _]] _]; discriminate.
-    eapply subp_trans'; [ |  eapply (H3 EK_normal None tx2 vx2)].
-      apply derives_subp.
-      auto.
-    }
-    - simpl proj_ret_assert in H3|-*. cbv zeta. normalize.
-    - simpl proj_ret_assert in H3|-*. cbv zeta. 
-      specialize (H3 EK_return vl2).
-      eapply subp_trans'; [ | eapply H3; eauto].
-      auto.
-  + intros tx4 vx4. cbv zeta.
-    eapply subp_trans'; [ | eapply (H3 EK_return) ; eauto].
-    simpl proj_ret_assert. destruct POST; simpl tycontext.RA_return.
-    apply subp_refl'. }
-  specialize (H' tx vx _ (Nat.le_refl _) _ _ (necR_refl _) (ext_refl _)); spec H'.
-  { subst; split; auto; split; auto. }
- auto.
+  + rewrite proj_frame; simpl proj_ret_assert; monPred.unseal; iIntros "(% & (? & % & ?) & ?)"; subst.
+    iApply (assert_safe_adj _ _ _ _ _ (Kseq incr (Kloop2 body incr k)) (Kseq _ _)); last by iApply "Hincr"; destruct POST; iFrame.
+    intros ?????; iIntros "H"; iApply (jsafe_local_step with "H"); constructor; auto.
+  + simpl proj_ret_assert; monPred.unseal; iIntros "(% & (% & ?) & ?)"; rewrite /loop1_ret_assert.
+    destruct POST; iApply ("rguard" $! EK_normal None); simpl; monPred.unseal; by iFrame.
+  + simpl exit_cont; simpl proj_ret_assert; monPred.unseal.
+    iIntros "(% & (% & H) & ?)".
+    iApply "Hincr".
+    by destruct POST; simpl frame_ret_assert; monPred.unseal; iDestruct "H" as "[$ $]"; iFrame.
+  + destruct POST; iApply ("rguard" $! EK_return); by iFrame.
 Qed.
 
 Lemma semax_break:
-   forall Delta Q,        semax Espec Delta (RA_break Q) Sbreak Q.
+   forall E Delta Q,        semax OK_spec E Delta (RA_break Q) Sbreak Q.
 Proof.
   intros.
-  rewrite semax_unfold; intros.  clear Prog_OK. rename w into n.
-  intros te ve w ?.
-  specialize (H0 EK_break None te ve w H1).
-  simpl exit_cont in H0.
-  clear n H1.
-  remember ((construct_rho (filter_genv psi) ve te)) as rho.
-  revert w H0.
-  apply imp_derives; auto.
-  apply andp_derives; auto.
-  repeat intro.
-  rewrite proj_frame_ret_assert. simpl proj_ret_assert; simpl seplog.sepcon.
-  rewrite sepcon_comm. rewrite (prop_true_andp (None=None)) by auto.
-  eapply andp_derives; try apply H0; auto.
-  apply assert_safe_derives; split; auto.
-  rename H0 into Hora; intros.
-  destruct (break_cont k) eqn: Hcont.
-  { eapply jm_fupd_mono; [apply H0 | contradiction]. }
-2:{ exfalso; clear - Hcont. revert k c Hcont; induction k; simpl; intros; try discriminate. eauto. }
-  destruct c; eapply jm_fupd_mono; eauto; clear H0; intros; try contradiction.
-- 
-  induction k; try discriminate.
- + simpl in Hcont. apply IHk in Hcont. eapply jsafeN_local_step. constructor. intros. eapply age_safe; eauto.
- + simpl in Hcont. inv Hcont. clear IHk.
-    eapply jsafeN_local_step. apply step_break_loop1.
-    intros.
-    eapply age_safe; eauto.
-    inv H3; [constructor; auto | | discriminate | contradiction].
-    destruct H4 as [Hstep ?]; inv Hstep.
-    eapply jsafeN_step.  split. econstructor; try eassumption.
-    hnf; auto. auto. auto.
- + simpl in Hcont. inv Hcont. clear IHk.
-    eapply jsafeN_local_step. apply step_break_loop2.
-    intros.
-    eapply age_safe; eauto.
-    inv H3; [constructor; auto | | discriminate | contradiction].
-    destruct H4 as [Hstep ?]; inv Hstep.
-    eapply jsafeN_step.  split. econstructor; try eassumption.
-    hnf; auto. auto. auto.
- + simpl in Hcont. inv Hcont. clear IHk.
-    eapply jsafeN_local_step. econstructor; auto. 
-    intros.
-    eapply age_safe; eauto.
-    inv H3; [constructor; auto | | discriminate | contradiction].
-    destruct H4 as [Hstep ?]; inv Hstep.
-    eapply jsafeN_step.  split. econstructor; try eassumption.
-    hnf; auto. auto. auto.
--
-  rename c into k'.
-  revert s k' Hcont H3.
-  induction k; simpl; intros; try discriminate.
- +
-  eapply jsafeN_local_step. constructor. intros.
-  eapply age_safe; try eassumption.
-  eapply IHk; eauto.
- +
-  inv Hcont.
-  eapply jsafeN_local_step. apply step_break_loop1. intros.
-  eapply age_safe; try eassumption.
-  eapply jsafeN_local_step. apply step_skip_seq. intros.
-  eapply age_safe; try eassumption.
- +
-  inv Hcont.
-  eapply jsafeN_local_step. apply step_break_loop2. intros.
-  eapply age_safe; try eassumption.
-  eapply jsafeN_local_step. apply step_skip_seq. intros.
-  eapply age_safe; try eassumption.
- +
-  inv Hcont.
-  eapply jsafeN_local_step. apply step_skip_break_switch; auto. intros.
-  eapply age_safe; try eassumption.
-  eapply jsafeN_local_step. apply step_skip_seq. intros.
-  eapply age_safe; try eassumption.
--
-  induction k; try discriminate.
- + simpl in Hcont. apply IHk in Hcont. eapply jsafeN_local_step. constructor. intros. eapply age_safe; eauto.
- + simpl in Hcont. inv Hcont. clear IHk.
-    eapply jsafeN_local_step. apply step_break_loop1.
-    intros.
-    eapply age_safe; eauto.
- + simpl in Hcont. inv Hcont. clear IHk.
-    eapply jsafeN_local_step. apply step_break_loop2.
-    intros.
-    eapply age_safe; eauto.
- + simpl in Hcont. inv Hcont. clear IHk.
-    eapply jsafeN_local_step. apply step_skip_break_switch; auto.
-    intros.
-    eapply age_safe; eauto.
--
-  induction k; try discriminate.
- + simpl in Hcont. apply IHk in Hcont. eapply jsafeN_local_step. constructor. intros. eapply age_safe; eauto.
- + simpl in Hcont. inv Hcont. clear IHk.
-    eapply jsafeN_local_step. apply step_break_loop1.
-    intros.
-    eapply age_safe; eauto.
-    eapply jsafeN_local_step. apply step_skip_loop2.
-    intros.
-    eapply age_safe; eauto.
- + simpl in Hcont. inv Hcont. clear IHk.
-    eapply jsafeN_local_step. apply step_break_loop2.
-    intros.
-    eapply age_safe; eauto.
-    eapply jsafeN_local_step. apply step_skip_loop2.
-    intros.
-    eapply age_safe; eauto.
- + simpl in Hcont. inv Hcont. clear IHk.
-    eapply jsafeN_local_step. apply step_skip_break_switch; auto.
-    intros.
-    eapply age_safe; eauto.
-    eapply jsafeN_local_step. constructor.
-    intros.
-    eapply age_safe; eauto.
--
-  induction k; try discriminate.
- + simpl in Hcont. apply IHk in Hcont. eapply jsafeN_local_step. constructor. intros. eapply age_safe; eauto.
- + simpl in Hcont. inv Hcont. clear IHk.
-    eapply jsafeN_local_step. apply step_break_loop1.
-    intros.
-    eapply age_safe; eauto.
-    inv H3; [constructor; auto | | discriminate | contradiction].
-    destruct H4 as [Hstep ?]; inv Hstep.
-    eapply jsafeN_step.  split. econstructor; try eassumption.
-    hnf; auto. auto. auto.
- + simpl in Hcont. inv Hcont. clear IHk.
-    eapply jsafeN_local_step. apply step_break_loop2.
-    intros.
-    eapply age_safe; eauto.
-    inv H3; [constructor; auto | | discriminate | contradiction].
-    destruct H4 as [Hstep ?]; inv Hstep.
-    eapply jsafeN_step.  split. econstructor; try eassumption.
-    hnf; auto. auto. auto.
- + simpl in Hcont. inv Hcont. clear IHk.
-    eapply jsafeN_local_step. econstructor; auto. 
-    intros.
-    eapply age_safe; eauto.
-    inv H3; [constructor; auto | | discriminate | contradiction].
-    destruct H4 as [Hstep ?]; inv Hstep.
-    eapply jsafeN_step.  split. econstructor; try eassumption.
-    hnf; auto. auto. auto.
+  rewrite semax_unfold; intros.
+  iIntros "#Prog_OK" (????) "[(%Hclosed & %HE) #rguard]".
+  iIntros (??) "!> H".
+  iSpecialize ("rguard" $! EK_break None tx vx with "[H]").
+  { simpl.
+    rewrite (bi.pure_True (None = None)) // bi.True_and; destruct Q; simpl.
+    monPred.unseal; by rewrite (bi.sep_comm (RA_break _)). }
+  iIntros (? H); iSpecialize ("rguard" $! _ H).
+  simpl exit_cont; destruct (break_cont k) eqn: Hcont.
+  { iMod "rguard" as "[]". }
+  2: { exfalso; clear - Hcont. revert k c Hcont; induction k; simpl; intros; try discriminate. eauto. }
+  destruct c; try iMod "rguard" as "[]".
+  - iInduction k as [| | | | |] "IHk"; try discriminate.
+    + iApply jsafe_local_step; last by iApply ("IHk" with "[%] rguard"). constructor.
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { apply step_break_loop1. }
+      iNext.
+      iApply (convergent_controls_jsafe with "rguard"); simpl; try congruence.
+      by inversion 1; constructor.
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { apply step_break_loop2. }
+      iNext.
+      iApply (convergent_controls_jsafe with "rguard"); simpl; try congruence.
+      by inversion 1; constructor.
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { constructor; auto. }
+      iNext.
+      iApply (convergent_controls_jsafe with "rguard"); simpl; try congruence.
+      by inversion 1; constructor.
+  - rename c into k'.
+    iInduction k as [| s' | s1 s2 | s1 s2 | |] "IHk" forall (s k' Hcont); try discriminate.
+    + iApply jsafe_local_step.
+      { constructor. }
+      by iApply ("IHk" with "[%] rguard").
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { apply step_break_loop1. }
+      iApply jsafe_local_step.
+      { apply step_skip_seq. }
+      iApply "rguard".
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { apply step_break_loop2. }
+      iApply jsafe_local_step.
+      { apply step_skip_seq. }
+      iApply "rguard".
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { intros; apply step_skip_break_switch; auto. }
+      iApply jsafe_local_step.
+      { apply step_skip_seq. }
+      iApply "rguard".
+  - iInduction k as [| | | | |] "IHk"; try discriminate.
+    + iApply jsafe_local_step; last by iApply ("IHk" with "[%] rguard"). constructor.
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { apply step_break_loop1. }
+      iApply "rguard".
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { apply step_break_loop2. }
+      iApply "rguard".
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { constructor; auto. }
+      iApply "rguard".
+  - iInduction k as [| | | | |] "IHk"; try discriminate.
+    + iApply jsafe_local_step; last by iApply ("IHk" with "[%] rguard"). constructor.
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { apply step_break_loop1. }
+      iApply jsafe_local_step.
+      { apply step_skip_loop2. }
+      iApply "rguard".
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { apply step_break_loop2. }
+      iApply jsafe_local_step.
+      { apply step_skip_loop2. }
+      iApply "rguard".
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { constructor; auto. }
+      iApply jsafe_local_step.
+      { apply step_skip_loop2. }
+      iApply "rguard".
+  - iInduction k as [| | | | |] "IHk"; try discriminate.
+    + iApply jsafe_local_step; last by iApply ("IHk" with "[%] rguard"). constructor.
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { apply step_break_loop1. }
+      iNext.
+      iApply (convergent_controls_jsafe with "rguard"); simpl; try congruence.
+      by inversion 1; constructor.
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { apply step_break_loop2. }
+      iNext.
+      iApply (convergent_controls_jsafe with "rguard"); simpl; try congruence.
+      by inversion 1; constructor.
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { constructor; auto. }
+      iNext.
+      iApply (convergent_controls_jsafe with "rguard"); simpl; try congruence.
+      by inversion 1; constructor.
 Qed.
 
 Lemma semax_continue:
-   forall Delta Q,        semax Espec Delta (RA_continue Q) Scontinue Q.
+   forall E Delta Q,        semax OK_spec E Delta (RA_continue Q) Scontinue Q.
 Proof.
- intros.
- rewrite semax_unfold; intros.  clear Prog_OK. rename w into n.
- intros te ve w ?.
- specialize (H0 EK_continue None te ve w H1).
- simpl exit_cont in H0.
- clear n H1.
- remember ((construct_rho (filter_genv psi) ve te)) as rho.
- revert w H0.
-apply imp_derives; auto.
-apply andp_derives; auto.
-repeat intro.
-  rewrite proj_frame_ret_assert. simpl proj_ret_assert; simpl seplog.sepcon.
-rewrite sepcon_comm.
-eapply andp_derives; try apply H0; auto.
-normalize.
-apply assert_safe_derives; split; auto.
-rename H0 into Hora; intros.
-subst w.
-destruct (continue_cont k) eqn:Hcont; try (eapply jm_fupd_mono; eauto; contradiction).
--
- rename c into k'.
- assert (exists s c, k' = Kseq s c) as (? & ? & Hcase).
- { induction k; inv Hcont; eauto. }
- rewrite Hcase in H0.
- eapply jm_fupd_mono; eauto; clear H0; intros.
- revert k' Hcont Hcase H2.
- induction k; simpl; intros; try discriminate.
- +
-  eapply jsafeN_local_step. constructor. intros.
-  eapply age_safe; try eassumption.
-  eapply IHk; eauto.
- +
-  inv Hcont. inv H4.
-  eapply jsafeN_local_step. apply step_skip_or_continue_loop1; auto. intros.
-  eapply age_safe; try eassumption.
- +
-  eapply jsafeN_local_step. apply step_continue_switch. intros.
-  eapply age_safe; try eassumption.
-  eapply IHk; eauto.
--
-  exfalso; clear - Hcont.
-  revert c o Hcont; induction k; simpl; intros; try discriminate; eauto.
+  intros.
+  rewrite semax_unfold; intros.
+  iIntros "#Prog_OK" (????) "[(%Hclosed & %) #rguard]".
+  iSpecialize ("rguard" $! EK_continue None); simpl.
+  iIntros (??) "!>".
+  monPred.unseal; iIntros "(% & (? & ?) & ?)"; iSpecialize ("rguard" with "[-]").
+  { destruct Q; simpl; monPred.unseal; by iFrame. }
+  iIntros (? Heq); iSpecialize ("rguard" $! _ Heq).
+  destruct (continue_cont k) eqn:Hcont; try iMod "rguard" as "[]".
+  - rename c into k'.
+    assert (exists s c, k' = Kseq s c) as (? & ? & Hcase).
+    { induction k; inv Hcont; eauto. }
+    rewrite Hcase.
+    iInduction k as [| | | | |] "IHk" forall (k' Hcont Hcase); try discriminate.
+    + iApply jsafe_local_step.
+      { constructor. }
+      iApply ("IHk" with "[%] [%] rguard"); eauto.
+    + inv Hcont.
+      iApply jsafe_local_step.
+      { intros; apply step_skip_or_continue_loop1; auto. }
+      iApply "rguard".
+    + iApply jsafe_local_step.
+      { apply step_continue_switch. }
+      iApply ("IHk" with "[%] [%] rguard"); eauto.
+  - exfalso; clear - Hcont.
+    revert c o Hcont; induction k; simpl; intros; try discriminate; eauto.
 Qed.
 
 End extensions.
diff --git a/veric/semax_prog.v b/veric/semax_prog.v
index e1fa150597..91d7dc8f6e 100644
--- a/veric/semax_prog.v
+++ b/veric/semax_prog.v
@@ -1,9 +1,12 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.juicy_base.
-Require Import VST.veric.juicy_mem VST.veric.juicy_mem_lemmas VST.veric.juicy_mem_ops.
+Require Import VST.veric.juicy_mem.
 Require Import VST.veric.res_predicates.
+Require Import VST.veric.external_state.
 Require Import VST.veric.extend_tc.
 Require Import VST.veric.Clight_seplog.
 Require Import VST.veric.Clight_assert_lemmas.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.Clight_core.
 Require Import VST.sepcomp.extspec.
 Require Import VST.sepcomp.step_lemmas.
@@ -15,27 +18,19 @@ Require Import VST.veric.semax.
 Require Import VST.veric.semax_lemmas.
 Require Import VST.veric.Clight_lemmas.
 Require Import VST.veric.initial_world.
-Require Import VST.msl.normalize.
 Require Import VST.veric.semax_call.
 Require Import VST.veric.semax_conseq.
 Require Import VST.veric.Clight_initial_world.
 Require Import VST.veric.initialize.
 Require Import VST.veric.coqlib4.
+Require Export compcert.common.Values.
 Require Import Coq.Logic.JMeq.
 
-Require Import Coq.Logic.JMeq.
-Require Import VST.veric.ghost_PCM.
-
-Import compcert.lib.Maps.
-
 Import Ctypes Clight.
 
-Local Open Scope pred.
+Section mpred.
 
-Lemma funspec_eq {sig cc A P Q P' Q' Pne Qne Pne' Qne'}:
-      P = P' -> Q=Q' ->
-      mk_funspec sig cc A P Q Pne Qne = mk_funspec sig cc A P' Q' Pne' Qne'.
-Proof. intros. subst. f_equal; apply proof_irr. Qed.
+Context `{!VSTGS OK_ty Σ}.
 
 Fixpoint match_globvars (gvs: list (ident * globvar type)) (V: varspecs) : bool :=
  match V with
@@ -65,25 +60,25 @@ destruct H0 as [? [? ?]].
 intros id t ?.
 unfold make_tycontext, temp_types in H4.
 unfold make_tycontext_t in H4.
-set (f1 := fun param : ident * type => PTree.set (fst param) (snd param)) in *.
-set (f2 := fun (temp : ident * type) (tenv : PTree.tree type) =>
-            let (id, ty) := temp in PTree.set id ty tenv) in *.
+set (f1 := fun param : ident * type => Maps.PTree.set (fst param) (snd param)) in *.
+set (f2 := fun (temp : ident * type) (tenv : Maps.PTree.tree type) =>
+            let (id, ty) := temp in Maps.PTree.set id ty tenv) in *.
 unfold Map.get, make_tenv.
 (***)
-set (t0 := PTree.empty type) in *.
-set (v0 := PTree.empty val) in *.
-assert (t0 ! id = Some t ->
-   exists v : val, v0 ! id = Some v /\ tc_val' t v). {
+set (t0 := Maps.PTree.empty type) in *.
+set (v0 := Maps.PTree.empty val) in *.
+assert (Maps.PTree.get id t0 = Some t ->
+   exists v : val, Maps.PTree.get id v0 = Some v /\ tc_val' t v). {
   subst t0 v0.
-  intros. rewrite PTree.gempty in H5; inv H5.
+  intros. rewrite Maps.PTree.gempty in H5; inv H5.
 }
 set (t1 := fold_right f2 t0 temps) in *.
 set (v1 := create_undef_temps temps) in *.
 unfold create_undef_temps in v1.
 fold v0 in v1.
 clearbody t0. clearbody v0.
-assert (t1 ! id = Some t ->
-   exists v : val, v1 ! id = Some v /\ tc_val' t v). {
+assert (Maps.PTree.get id t1 = Some t ->
+   exists v : val, Maps.PTree.get id v1 = Some v /\ tc_val' t v). {
   subst t1 v1.
   clear - H5.
   revert t0 v0 H5.
@@ -91,11 +86,11 @@ assert (t1 ! id = Some t ->
   destruct (H5 H) as [v [? ?]].
   eauto.
   destruct (ident_eq i id). subst.
-  rewrite PTree.gss. eexists; split; eauto.
+  rewrite Maps.PTree.gss. eexists; split; eauto.
   intro Hx; contradiction Hx; auto.
-  rewrite PTree.gso by auto.
+  rewrite -> Maps.PTree.gso by auto.
   eapply IHtemps; eauto.
-  rewrite PTree.gso in H; auto.
+  rewrite Maps.PTree.gso in H; auto.
 }
 clearbody v1. clearbody t1.
 clear H5 t0 v0.
@@ -107,15 +102,15 @@ inv H1.
 auto.
 unfold f1 in H4. simpl in H4.
 destruct (ident_eq i id).
-subst i. rewrite PTree.gss in H4.
+subst i. setoid_rewrite Maps.PTree.gss in H4.
 inv H4.
 exists v.
 destruct H.
 split; [| intro; auto].
 inv H0.
-assert ((PTree.set id v v1) ! id = Some v).
-apply PTree.gss.
-forget (PTree.set id v v1) as e1.
+assert (Maps.PTree.get id (Maps.PTree.set id v v1) = Some v).
+apply Maps.PTree.gss.
+forget (Maps.PTree.set id v v1) as e1.
 clear - H H5 H2 H0 H1.
 revert e1 H args H0 H1 H2; induction params as [|[??]]; destruct args; simpl; intros; try contradiction.
 inv H1. auto.
@@ -124,13 +119,13 @@ simpl in H5.
 apply Decidable.not_or in H5.
 destruct H5.
 eapply IHparams; try apply H1; auto.
-rewrite PTree.gso by auto; auto.
+rewrite -> Maps.PTree.gso by auto; auto.
 destruct H.
-rewrite PTree.gso in H4 by auto.
+setoid_rewrite -> Maps.PTree.gso in H4; auto.
 inv H0.
 eapply IHparams; try apply H1; auto.
 eassumption.
-rewrite PTree.gso; auto.
+rewrite Maps.PTree.gso; auto.
 Qed.
 
 Lemma typecheck_var_environ_i:
@@ -144,25 +139,25 @@ Proof.
 intros.
 hnf; intros.
 unfold make_tycontext_v, make_venv, Map.get.
-set (f := fun (var : ident * type) (venv : PTree.tree type) =>
-    let (id0, ty0) := var in PTree.set id0 ty0 venv).
-transitivity (option_map snd (ve' ! id) = Some ty).
-2:{ destruct (ve' ! id) as [[??]|]; simpl; split; intro.
+set (f := fun (var : ident * type) (venv : Maps.PTree.tree type) =>
+    let (id0, ty0) := var in Maps.PTree.set id0 ty0 venv).
+transitivity (option_map snd (Maps.PTree.get id ve') = Some ty).
+2:{ destruct (Maps.PTree.get id ve') as [[??]|]; simpl; split; intro.
      inv H1; exists b; eauto. destruct H1; inv H1; auto.
      inv H1. destruct H1; inv H1.
 }
-assert ((fold_right f (PTree.empty type) vars) ! id =
-           option_map snd (ve' ! id)).
+assert ((fold_right f (Maps.PTree.empty type) vars) !! id =
+           option_map snd (ve' !! id)).
 2: rewrite H1; split; auto.
-set (s := PTree.empty type).
+set (s := Maps.PTree.empty type).
 set (r := empty_env) in *.
-assert (s ! id = option_map snd (r ! id)).
+assert (s !! id = option_map snd (r !! id)).
 subst s r.
 unfold empty_env.
-rewrite !PTree.gempty.
+setoid_rewrite (Maps.PTree.gempty _ id).
 reflexivity.
-assert (In id (map fst vars) -> s ! id = None)
-   by (intros; apply PTree.gempty).
+assert (In id (map fst vars) -> s !! id = None)
+   by (intros; apply Maps.PTree.gempty).
 clearbody r.
 clearbody s.
 induction H0.
@@ -171,24 +166,24 @@ inv H.
 destruct (ident_eq id0 id); simpl in *.
 subst.
 spec H2; auto.
-rewrite H2 in *.
-rewrite PTree.gss in *.
+rewrite -> H2 in *.
+setoid_rewrite -> Maps.PTree.gss.
 clear - H3 H6.
-set (e1 := PTree.set id (b1, ty0) e) in *.
-transitivity (option_map snd e1 ! id).
-subst e1. rewrite PTree.gss; reflexivity.
+set (e1 := Maps.PTree.set id (b1, ty0) e) in *.
+transitivity (option_map snd (e1 !! id)).
+subst e1. setoid_rewrite Maps.PTree.gss; reflexivity.
 induction H3. auto.
 simpl in H6.
 apply Decidable.not_or in H6.
 destruct H6.
-rewrite PTree.gso in * by auto.
-auto.
-rewrite PTree.gso in * by auto.
+setoid_rewrite Maps.PTree.gso in IHalloc_variables; auto.
+setoid_rewrite Maps.PTree.gso; auto.
 apply IHalloc_variables; auto.
+setoid_rewrite Maps.PTree.gso; auto.
 Qed.
 
 Section semax_prog.
-Context (Espec: OracleKind).
+Context (OK_spec : ext_spec OK_ty).
 
 Definition prog_contains (ge: genv) (fdecs : list (ident * Clight.fundef)) : Prop :=
      forall id f, In (id,f) fdecs ->
@@ -196,7 +191,7 @@ Definition prog_contains (ge: genv) (fdecs : list (ident * Clight.fundef)) : Pro
 
 Definition entry_tempenv (te: temp_env) (f: function) (vl: list val) :=
    length vl = length f.(fn_params) /\
-   forall id v, PTree.get id te = Some v ->
+   forall id v, Maps.PTree.get id te = Some v ->
                       In (id,v)
                        (combine (map (@fst _ _) f.(fn_params)) vl
                           ++ map (fun tv => (fst tv, Vundef)) f.(fn_temps)).
@@ -206,16 +201,18 @@ andb
     (compute_list_norepet (map (@fst _ _) (fn_params f) ++ map (@fst _ _) (fn_temps f)))
     (compute_list_norepet (map (@fst _ _) (fn_vars f))).
 
+(* Do we want semax_prog to be defined in the logic (with a fixed heapGS), or outside the logic
+   (universally quantifying over heapGS)? *)
 Definition semax_body
    (V: varspecs) (G: funspecs) {C: compspecs} (f: function) (spec: ident * funspec): Prop :=
-match spec with (_, mk_funspec fsig cc A P Q _ _) =>
+match spec with (_, mk_funspec fsig cc A E P Q) =>
   fst fsig = map snd (fst (fn_funsig f)) /\
   snd fsig = snd (fn_funsig f) /\
-forall Espec ts (x:dependent_type_functor_rec ts A mpred),
-  semax Espec (func_tycontext f V G nil)
-      (fun rho => close_precondition (map fst f.(fn_params)) (P ts x) rho * stackframe_of f rho)
+forall OK_spec (x:dtfr A),
+  semax OK_spec (E x) (func_tycontext f V G nil)
+      (close_precondition (map fst f.(fn_params)) (argsassert_of (P x)) ∗ stackframe_of f)
        f.(fn_body)
-      (frame_ret_assert (function_body_ret_assert (fn_return f) (Q ts x)) (stackframe_of f))
+      (frame_ret_assert (function_body_ret_assert (fn_return f) (assert_of (Q x))) (stackframe_of f))
 end.
 
 Definition genv_contains (ge: Genv.t Clight.fundef type) (fdecs : list (ident * Clight.fundef)) : Prop :=
@@ -229,13 +226,13 @@ Definition semax_func (V: varspecs) (G: funspecs) {C: compspecs} (ge: Genv.t Cli
        (fdecs: list (ident * Clight.fundef)) (G1: funspecs) : Prop :=
 match_fdecs fdecs G1 /\ genv_contains ge fdecs /\
 forall (ge': Genv.t Clight.fundef type) (Gfs: forall i,  sub_option (Genv.find_symbol ge i) (Genv.find_symbol ge' i))
-         (Gffp: forall b, sub_option (Genv.find_funct_ptr ge b) (Genv.find_funct_ptr ge' b))
-n, believe Espec (nofunc_tycontext V G) (Build_genv ge' (@cenv_cs C)) (nofunc_tycontext V G1) n.
+         (Gffp: forall b, sub_option (Genv.find_funct_ptr ge b) (Genv.find_funct_ptr ge' b)),
+  ⊢ believe OK_spec (nofunc_tycontext V G) (Build_genv ge' (@cenv_cs C)) (nofunc_tycontext V G1).
 
 Lemma semax_func_cenv_sub CS CS' (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS')) ge ge'
   (Gfs: forall i,  sub_option (Genv.find_symbol ge i) (Genv.find_symbol ge' i))
   (Gffp: forall b, sub_option (Genv.find_funct_ptr ge b) (Genv.find_funct_ptr ge' b))
-  V G fdecs G1 (H: @semax_func  V G CS ge fdecs G1): @semax_func  V G CS' ge' fdecs G1.
+  V G fdecs G1 (H: semax_func V G (C := CS) ge fdecs G1): semax_func V G (C := CS') ge' fdecs G1.
 Proof.
 destruct H as [MF [GC B]]; split; [trivial | split].
 + hnf; intros. destruct (GC _ _ H) as [b [Hb1 Hb2]]. exists b; split.
@@ -246,34 +243,35 @@ assert (Q1: forall i, sub_option (Genv.find_symbol ge i) (Genv.find_symbol ge2 i
 { intros. eapply sub_option_trans. apply Gfs. apply Gfs0. }
 assert (Q2: forall b, sub_option (Genv.find_funct_ptr ge b) (Genv.find_funct_ptr ge2 b)).
 { intros. eapply sub_option_trans. apply Gffp. apply Gffp0. }
-apply (@believe_cenv_sub_L CS Espec CS' {| genv_genv := ge2; genv_cenv := cenv_cs |} (nofunc_tycontext V G) (nofunc_tycontext V G)).
-intros; apply tycontext_sub_refl. apply CSUB. apply (B _ Q1 Q2 n).
+rewrite - (believe_cenv_sub_L(CS := CS) OK_spec (CS' := CS') {| genv_genv := ge2; genv_cenv := cenv_cs |} (nofunc_tycontext V G) (nofunc_tycontext V G)); eauto.
+intros; apply tycontext_sub_refl.
 Qed.
 Lemma semax_func_mono CS CS' (CSUB: cspecs_sub CS CS') ge ge'
   (Gfs: forall i,  sub_option (Genv.find_symbol ge i) (Genv.find_symbol ge' i))
   (Gffp: forall b, sub_option (Genv.find_funct_ptr ge b) (Genv.find_funct_ptr ge' b))
-  V G fdecs G1 (H: @semax_func  V G CS ge fdecs G1): @semax_func  V G CS' ge' fdecs G1.
+  V G fdecs G1 (H: semax_func(C := CS) V G ge fdecs G1): semax_func(C := CS') V G ge' fdecs G1.
 Proof.
   destruct CSUB as [CSUB _].
-  eapply (@semax_func_cenv_sub _ _ CSUB); eassumption.
+  eapply (semax_func_cenv_sub _ _ CSUB); eassumption.
 Qed.
 
-Definition main_pre {Z} (prog: program) (ora: Z) : (ident->val) -> argsassert :=
-(fun gv gvals => !!(gv = genviron2globals (fst gvals) /\ snd gvals=nil)
-       && globvars2pred gv (prog_vars prog) * has_ext ora).
+Definition main_pre (prog: program) (ora: OK_ty) (gv: ident->val) : argsassert :=
+argsassert_of (fun gvals => ⌜gv = genviron2globals (fst gvals) /\ snd gvals=nil⌝
+       ∧ globvars2pred gv (prog_vars prog) ∗ has_ext ora).
 
-Lemma main_pre_vals_nil {Z prog ora gv g vals}:
-      @main_pre Z prog ora gv (g, vals) |-- !!(vals=nil).
-Proof. unfold main_pre; simpl. intros ? [? [? [? [[X ?] _]]]]. apply X.
+Lemma main_pre_vals_nil {prog ora gv g vals}:
+      main_pre prog ora gv (g, vals) ⊢ ⌜vals=nil⌝.
+Proof.
+  unfold main_pre; simpl. by iIntros "((_ & ->) & _)".
 Qed.
 
 Definition Tint32s := Tint I32 Signed noattr.
 
 Definition main_post (prog: program) : (ident->val) -> assert :=
-(fun _ _ => TT).
+(fun _ => True).
 
-Definition main_spec_ext' {Z} (prog: program) (ora: Z)
-(post: (ident->val) -> environ ->pred rmap): funspec :=
+Definition main_spec_ext' (prog: program) (ora: OK_ty)
+(post: (ident->val) -> assert): funspec :=
 NDmk_funspec (nil, tint) cc_default (ident->val) (main_pre prog ora) post.
 
 Definition main_spec_ext (prog: program) (ora: OK_ty): funspec :=
@@ -294,17 +292,15 @@ end
 end.
 
 Definition postcondition_allows_exit retty :=
-   forall
-      v  ora (jm : juicy_mem),
+   forall v ora m,
       tc_option_val retty v ->
-      ext_compat ora (m_phi jm) ->
-      ext_spec_exit OK_spec v ora jm.
+      ext_spec_exit OK_spec v ora m.
 
 Definition semax_prog {C: compspecs}
        (prog: program) (ora: OK_ty) (V: varspecs) (G: funspecs) : Prop :=
 compute_list_norepet (prog_defs_names prog) = true  /\
 all_initializers_aligned prog /\
-PTree.elements cenv_cs = PTree.elements (prog_comp_env prog) /\
+Maps.PTree.elements cenv_cs = Maps.PTree.elements (prog_comp_env prog) /\
 @semax_func V G C (Genv.globalenv prog) (prog_funct prog) G /\
 match_globvars (prog_vars prog) V = true /\
 match find_id prog.(prog_main) G with
@@ -314,126 +310,45 @@ match find_id prog.(prog_main) G with
 end.
 
 Lemma semax_func_nil:
-forall
- V G {C: compspecs} ge, @semax_func V G C ge nil nil.
-Proof.
-intros; split. constructor. split; [ hnf; intros; inv H | intros].
-intros b fsig cc ty P Q ? w ? Hext ?.
-hnf in H0.
-destruct H0 as [b' [NEP [NEQ [? ?]]]].
-simpl in H0.
-rewrite PTree.gempty in H0. inv H0.
-Qed.
-
-#[local] Obligation Tactic := idtac.
-
-Program Definition HO_pred_eq {T}{agT: ageable T}{EO: Ext_ord T}
-(A: Type) (P: A -> pred T) (A': Type) (P': A' -> pred T) : pred nat :=
-fun v => exists H: A=A',
- match H in (_ = A) return (A -> pred T) -> Prop with
- | refl_equal => fun (u3: A -> pred T) =>
-                                forall x: A, (P x <=> u3 x) v
- end P'.
-Next Obligation.
-split; repeat intro.
-destruct H0. exists x.
-destruct x.
-intros. specialize (H0 x). eapply pred_hereditary; eauto.
-
-destruct H0. exists x.
-destruct x.
-intros. specialize (H0 x). eapply pred_upclosed; eauto.
-Qed.
-
-Lemma laterR_level: forall w w' : rmap, laterR w w' -> (level w > level w')%nat.
-Proof.
-induction 1.
-unfold age in H. rewrite <- ageN1 in H.
-change rmap with R.rmap; change ag_rmap with R.ag_rmap.
-rewrite (ageN_level _ _ _ H). generalize (@level _ R.ag_rmap y). intros; lia.
-lia.
-Qed.
-
-Lemma necR_level:  forall w w' : rmap, necR w w' -> (level w >= level w')%nat.
-Proof.
-induction 1.
-unfold age in H. rewrite <- ageN1 in H.
-change rmap with R.rmap; change ag_rmap with R.ag_rmap.
-rewrite (ageN_level _ _ _ H). generalize (@level _ R.ag_rmap y). intros; lia.
-lia.
-lia.
-Qed.
-
-Lemma HO_pred_eq_i1:
-forall A P P' m,
-  approx (level m) oo  P = approx (level m) oo P' ->
-(|> HO_pred_eq A P A  P') m.
+forall {C: compspecs}
+ V G ge, semax_func(C := C) V G ge nil nil.
 Proof.
-intros.
-unfold HO_pred_eq.
-intros ?m ?.
-hnf.
-exists (refl_equal A).
-intros.
-generalize (f_equal (fun f => f x) H); clear H; intro.
-simpl in H0.
-unfold compose in *.
-apply clos_trans_t1n in H0.
-revert H; induction H0; intros.
-2 : { apply IHclos_trans_1n.
-  unfold age,age1 in H. unfold ag_nat in H. unfold natAge1 in H. destruct x0; inv H.
-  clear - H1.
-  assert (forall w, app_pred (approx (level (S y)) (P x)) w <-> app_pred (approx (level (S y)) (P' x)) w).
-  { intros; rewrite H1; tauto. }
-  apply pred_ext; intros w ?; destruct (H w); simpl in *; intuition.
-  apply H0; auto. clear - H4.  unfold natLevel in *. lia.
-  apply H2; auto. clear - H4.  unfold natLevel in *. lia. }
-unfold age,age1 in H. unfold ag_nat in H. unfold natAge1 in H. destruct x0; inv H.
-intros z ?.
-split; intros ? a' ? Hext%ext_level ?.
-assert (app_pred (approx (level (S y)) (P x)) a').
-{ simpl. split; auto. unfold natLevel.  apply necR_level in H1.
-  lia. }
-rewrite H0 in H3.
-simpl in H3. destruct H3; auto.
-assert (app_pred (approx (level (S y)) (P' x)) a').
-{ simpl. split; auto. unfold natLevel.  apply necR_level in H1.
-  lia. }
-rewrite <- H0 in H3.
-simpl in H3. destruct H3; auto.
+intros; split. constructor. split; [hnf; intros; inv H | intros].
+iIntros (??????? Hclaims).
+destruct Hclaims as (? & Hlookup & ?).
+rewrite Maps.PTree.gempty in Hlookup. discriminate.
 Qed.
 
 Lemma semax_func_cons_aux:
-forall (psi: genv) id fsig1 cc1 A1 P1 Q1 NEP1 NEQ1 fsig2 cc2 A2 P2 Q2 (V: varspecs) (G': funspecs) {C: compspecs} b fs,
+forall (psi: genv) id fsig1 cc1 A1 E1 P1 Q1 fsig2 cc2 A2 E2 P2 Q2 (V: varspecs) (G': funspecs) {C: compspecs} b fs,
 Genv.find_symbol psi id = Some b ->
 ~ In id (map (fst (A:=ident) (B:=Clight.fundef)) fs) ->
 match_fdecs fs G'  ->
-claims  psi (nofunc_tycontext V ((id, mk_funspec fsig1 cc1 A1 P1 Q1 NEP1 NEQ1) :: G')) (Vptr b Ptrofs.zero) fsig2 cc2 A2 P2 Q2 ->
-fsig1=fsig2 /\ cc1 = cc2 /\ A1=A2 /\ JMeq P1 P2 /\ JMeq Q1 Q2.
+claims psi (nofunc_tycontext V ((id, mk_funspec fsig1 cc1 A1 E1 P1 Q1) :: G')) (Vptr b Ptrofs.zero) fsig2 cc2 A2 E2 P2 Q2 ->
+fsig1=fsig2 /\ cc1 = cc2 /\ A1=A2 /\ JMeq E1 E2 /\ JMeq P1 P2 /\ JMeq Q1 Q2.
 Proof.
 intros until fs. intros H Hin Hmf; intros.
-destruct H0 as [id' [NEP2 [NEQ2 [? ?]]]].
+destruct H0 as [id' [? ?]].
 simpl in H0.
 destruct (eq_dec id id').
-subst id'. rewrite PTree.gss in H0. inv H0.
-apply inj_pair2 in H6. apply inj_pair2 in H7.
-subst.
-split; auto.
-rewrite PTree.gso in H0 by auto.
+subst id'. setoid_rewrite Maps.PTree.gss in H0. inv H0.
+apply inj_pair2 in H6. apply inj_pair2 in H7. apply inj_pair2 in H8.
+subst; tauto.
+setoid_rewrite Maps.PTree.gso in H0; last done.
 exfalso.
 destruct H1 as [b' [? ?]].
 symmetry in H2; inv H2.
 assert (In id' (map (@fst _ _) G')).
 clear - H0.
 revert H0; induction G'; simpl; intros; auto.
-rewrite PTree.gempty in H0; inv H0.
+rewrite Maps.PTree.gempty in H0; inv H0.
 destruct (eq_dec id' (fst a)). subst.
 destruct a; simpl in *.
-rewrite PTree.gss in H0 by auto. inv  H0.
+rewrite -> Maps.PTree.gss in H0 by auto. inv  H0.
 auto.
 destruct a; simpl in *.
-destruct (eq_dec i id'). subst. rewrite PTree.gss in H0. auto.
-rewrite PTree.gso in H0 by auto.
+destruct (eq_dec i id'). subst. rewrite Maps.PTree.gss in H0. auto.
+rewrite -> Maps.PTree.gso in H0 by auto.
 right; apply IHG'; auto.
 destruct (eq_dec id id').
 2: apply (Genv.global_addresses_distinct psi n H H1); auto.
@@ -446,7 +361,6 @@ Lemma var_block'_cenv_sub {CS CS'} (CSUB: cenv_sub CS CS') sh a
 (CT: complete_type CS (@snd ident type a) = true):
 var_block' sh CS a = var_block' sh CS' a.
 Proof.
-extensionality rho.
 unfold var_block'. rewrite (cenv_sub_sizeof CSUB); trivial.
 Qed.
 
@@ -454,56 +368,53 @@ Lemma stackframe_of'_cenv_sub {CS CS'} (CSUB: cenv_sub CS CS') f
   (COMPLETE : Forall (fun it : ident * type => complete_type CS (snd it) = true) (fn_vars f)):
 stackframe_of' CS f = stackframe_of' CS' f .
 Proof.
-extensionality rho.
 unfold stackframe_of'. forget (fn_vars f) as vars.
 induction vars; simpl; trivial.
-inv COMPLETE. rewrite (var_block'_cenv_sub CSUB _ _ H1), IHvars; clear IHvars; trivial.
+inv COMPLETE. rewrite (var_block'_cenv_sub CSUB _ _ H1) IHvars; clear IHvars; trivial.
 Qed.
 
 Lemma var_block_cspecs_sub {CS CS'} (CSUB: cspecs_sub CS CS') sh a
 (CT: complete_type (@cenv_cs CS) (@snd ident type a) = true):
-@var_block sh CS a = @var_block sh CS' a.
+var_block(cs := CS) sh a = var_block(cs := CS') sh a.
 Proof.
-extensionality rho. destruct CSUB as [CSUB _].
+destruct CSUB as [CSUB _].
 unfold var_block. unfold expr.sizeof. rewrite (cenv_sub_sizeof CSUB); trivial.
 Qed.
 
 Lemma stackframe_of_cspecs_sub {CS CS'} (CSUB: cspecs_sub CS CS') f
   (COMPLETE : Forall (fun it : ident * type => complete_type (@cenv_cs CS) (snd it) = true) (fn_vars f)):
-@stackframe_of CS f = @stackframe_of CS' f .
+stackframe_of(cs := CS) f = stackframe_of(cs := CS') f .
 Proof.
-extensionality rho.
 unfold stackframe_of. forget (fn_vars f) as vars.
 induction vars; simpl; trivial.
-inv COMPLETE. rewrite (var_block_cspecs_sub CSUB _ _ H1), IHvars; clear IHvars; trivial.
+inv COMPLETE. rewrite (var_block_cspecs_sub CSUB _ _ H1) IHvars; clear IHvars; trivial.
 Qed.
 
 Lemma semax_body_cenv_sub {CS CS'} (CSUB: cspecs_sub CS CS') V G f spec
 (COMPLETE : Forall (fun it : ident * type => complete_type (@cenv_cs CS) (snd it) = true) (fn_vars f)):
-@semax_body V G CS f spec -> @semax_body V G CS' f spec.
+semax_body(C := CS) V G f spec -> semax_body(C := CS') V G f spec.
 Proof.
 destruct spec.
 destruct f0.
 intros [H' [H'' H]]; split3; auto. clear H' H''.
 intros.
-  specialize (H Espec0 ts x).
-rewrite <- (stackframe_of_cspecs_sub CSUB); [apply (semax_cssub CSUB); apply H | trivial].
+  specialize (H OK_spec0 x).
+rewrite <- (stackframe_of_cspecs_sub CSUB); [apply (semax_cssub _ CSUB); apply H | trivial].
 Qed.
 
 Lemma semax_body_type_of_function {V G cs f i phi} (SB : @semax_body V G cs f (i, phi))
       (CC: fn_callconv f = callingconvention_of_funspec phi):
 type_of_function f = type_of_funspec phi.
 Proof.
-  destruct phi as [[? ?] ? ? ? ? ? ?]. destruct SB as [? [? _]].
-  unfold type_of_function; simpl in *. subst.
-  rewrite <- TTL1; trivial.
+  destruct phi as [[? ?] ? ? ? ?]. destruct SB as [? [? _]].
+  unfold type_of_function; simpl in *. subst. trivial.
 Qed.
 
-Lemma semax_func_cons
-     fs id f fsig cc (A: TypeTree) P Q NEP NEQ (V: varspecs) (G G': funspecs) {C: compspecs} ge b :
-  andb (id_in_list id (map (@fst _ _) G))
+Lemma semax_func_cons {C: compspecs}
+     fs id f fsig cc A E P Q (V: varspecs) (G G': funspecs) ge b :
+  (andb (id_in_list id (map (@fst _ _) G))
   (andb (negb (id_in_list id (map (@fst ident Clight.fundef) fs)))
-    (semax_body_params_ok f)) = true ->
+    (semax_body_params_ok f)) = true) ->
   Forall
      (fun it : ident * type =>
       complete_type cenv_cs (snd it) =
@@ -512,10 +423,10 @@ Lemma semax_func_cons
    f.(fn_callconv) = cc ->
    Genv.find_symbol ge id = Some b ->
    Genv.find_funct_ptr ge b = Some (Internal f) ->
-  semax_body V G f (id, mk_funspec fsig cc A P Q NEP NEQ) ->
+  semax_body V G f (id, mk_funspec fsig cc A E P Q) ->
   semax_func V G ge fs G' ->
   semax_func V G ge ((id, Internal f)::fs)
-       ((id, mk_funspec fsig cc A P Q NEP NEQ)  :: G').
+       ((id, mk_funspec fsig cc A E P Q)  :: G').
 Proof.
 intros H' COMPLETE Hvars Hcc Hb1 Hb2 SB [HfsG' [Hfs HG]].
 apply andb_true_iff in H'.
@@ -523,18 +434,14 @@ destruct H' as [Hin H'].
 apply andb_true_iff in H'.
 destruct H' as [Hni H].
 split3.
-{ econstructor 2; auto.
+{ econstructor 2; eauto.
   eapply semax_body_type_of_function. apply SB. apply Hcc. }
 { apply id_in_list_true in Hin. rewrite negb_true_iff in Hni.
   hnf; intros. destruct H0; [ symmetry in H0; inv H0 | apply (Hfs _ _ H0)].
   exists b; split; trivial. }
-intros ge' H0 HGG n.
+intros ge' H0 HGG.
 specialize (HG _ H0 HGG).
-hnf in HG |- *.
-intros v fsig0 cc' A' P' Q'.
-apply derives_imp.
-clear n.
-intros n ?.
+iIntros (????????).
 subst cc.
 rewrite <- Genv.find_funct_find_funct_ptr in Hb2.
 apply negb_true_iff in Hni.
@@ -542,10 +449,11 @@ apply id_in_list_false in Hni.
 destruct (eq_dec  (Vptr b Ptrofs.zero) v) as [?H|?H].
 * (* Vptr b Ptrofs.zero = v *)
 subst v.
-right.
-exists b; exists f.
-split.
+iRight.
+iExists b; iExists f.
+iSplit.
 +
+iPureIntro.
 apply andb_true_iff in H.
 destruct H as [H H'].
 apply compute_list_norepet_e in H.
@@ -557,62 +465,47 @@ split. { specialize (HGG b). unfold fundef in HGG;  rewrite Hb2 in HGG; simpl in
 split; auto.
 split; auto.
 split; auto.
-destruct H1 as [id' [NEP' [NEQ' [? [b' [FS' Hbb']]]]]].
+destruct H1 as [id' [? [b' [FS' Hbb']]]].
 symmetry in Hbb'; inv Hbb'.
 destruct (eq_dec id id').
- - subst. simpl in H1. rewrite PTree.gss in H1.
-   symmetry in H1; inv H1. apply inj_pair2 in H6. apply inj_pair2 in H7. subst Q' P'. simpl in *.
+ - subst. simpl in H1. setoid_rewrite Maps.PTree.gss in H1.
+   symmetry in H1; inv H1. apply inj_pair2 in H7. apply inj_pair2 in H8. subst Q0 P0. simpl in *.
    destruct SB. apply list_norepet_app in H. tauto.
  - specialize (H0 id); unfold fundef in H0. simpl in H0.  rewrite Hb1 in H0; simpl in H0.
    simpl in FS'.
-   elim (Genv.global_addresses_distinct ge' n0 H0 FS'); trivial.
+   elim (Genv.global_addresses_distinct ge' n H0 FS'); trivial.
 +
-intros Delta' CS' ? k NK EK HDelta' ? w KW EW CSUB.
-intros ts x.
-simpl in H1. specialize (H0 id); unfold fundef in H0; simpl in H0. rewrite Hb1 in H0; simpl in H0.
-pose proof (semax_func_cons_aux (Build_genv ge' cenv_cs) _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H0 Hni HfsG' H1).
-destruct H2 as [H4' [H4 [H4a [H4b H4c]]]].
-subst A' fsig0 cc'.
+iIntros (?? HDelta' CSUB ?) "!>".
+specialize (H0 id); unfold fundef in H0; simpl in H0. rewrite Hb1 in H0; simpl in H0.
+pose proof (semax_func_cons_aux (Build_genv ge' cenv_cs) _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H0 Hni HfsG' H1) as [H4' [H4 [? [H4a [H4b H4c]]]]].
+subst A0 fsig0 cc0.
+apply JMeq_eq in H4a.
 apply JMeq_eq in H4b.
 apply JMeq_eq in H4c.
-subst P' Q'.
-destruct SB as [X [Y SB]]. specialize (SB Espec ts x). simpl fst in X. simpl snd in Y.
-specialize (SB k).
-apply now_later.
+subst E0 P0 Q0.
+destruct SB as [X [Y SB]]. specialize (SB OK_spec x). simpl fst in X. simpl snd in Y.
 rewrite <- (stackframe_of'_cenv_sub CSUB); trivial.
-apply (semax'_cenv_sub CSUB).
-simpl in EK, EW; subst.
-clear - SB NK KW HDelta' X.
-rewrite semax_fold_unfold in SB|-*. intros gx DD CS' ? u WU EU [SUB GX] ? v UV EV BEL.
-simpl in EU, EV; subst.
+iApply (semax'_cenv_sub _ CSUB).
+clear - SB HDelta' X.
+rewrite semax_unfold in SB; rewrite semax_fold_unfold. iIntros (? DD ? [SUB GX]) "BEL".
 assert (HDD: tycontext_sub (func_tycontext f V G nil) DD).
 { unfold func_tycontext, func_tycontext'. simpl.
 eapply tycontext_sub_trans; eauto. }
-assert (WV: @necR nat ag_nat w v). { eapply necR_trans.  apply WU. apply UV. }
-specialize (SB gx DD CS' _ _ KW (eq_refl _) (conj HDD GX) _ _ WV (eq_refl _) BEL).
-revert SB.
-eapply allp_derives; intro kk.
-apply allp_derives; intro F.
-apply allp_derives; intro curf.
-apply imp_derives; auto.
-unfold guard.
-apply allp_derives; intro tx.
-eapply allp_derives; intro vx.
-eapply subp_derives; auto.
-apply andp_derives; auto.
-apply andp_derives; auto.
-apply sepcon_derives; auto.
-apply andp_left1.
-apply sepcon_derives; auto.
-apply andp_left2; trivial.
+iPoseProof (SB with "BEL") as "#SB"; [done..|].
+iIntros (kk F curf ?) "H"; iPoseProof ("SB" with "H") as "#guard".
+rewrite /guard' /_guard.
+iIntros (??) "!>".
+iIntros "H"; iApply "guard".
+rewrite /bind_args; monPred.unseal.
+iDestruct "H" as "($ & ($ & (_ & $) & $) & $)".
 * (***   Vptr b Ptrofs.zero <> v'  ********)
-eapply (HG n v fsig0 cc' A' P' Q'); auto.
-destruct H1 as [id' [NEP' [NEQ' [? B]]]].
-simpl in H1. rewrite PTree.gsspec in H1.
+iApply HG; iPureIntro.
+destruct H1 as [id' [? B]].
+simpl in H1. setoid_rewrite Maps.PTree.gsspec in H1.
 destruct (peq id' id); subst.
 - specialize (H0 id); unfold fundef in H0; simpl in H0.
   destruct B as [? [? ?]]. rewrite Hb1 in H0; simpl in H0. unfold fundef in H3; simpl in H3; congruence.
-- exists id', NEP', NEQ'; split; auto.
+- exists id'; split; auto.
 Qed.
 
 (* EXPERIMENT
@@ -635,31 +528,30 @@ Qed.
 *)
 
 Lemma semax_external_FF:
-forall Espec ef A n,
-@semax_external Espec ef A (fun _ _ _ => FF) (fun _ _ _ => FF) n.
-intros.
-hnf; intros.
-simpl.
-intros.
-destruct H3 as [? [? [? [? [? ?]]]]].
-contradiction.
+forall ef A E,
+⊢ semax_external OK_spec ef A E (λne _, monPred_at(I := argsEnviron_index) False : _ -d> _) (λne _, monPred_at(I := environ_index) False : _ -d> _).
+Proof.
+  intros.
+  iIntros (?????) "!> !>"; simpl.
+  monPred.unseal.
+  iIntros "(_ & [] & _)".
 Qed.
 
 Lemma semax_func_cons_ext:
-forall (V: varspecs) (G: funspecs) {C: compspecs} ge fs id ef argsig retsig A P Q NEP NEQ
+forall (V: varspecs) (G: funspecs) {C: compspecs} ge fs id ef argsig retsig A E P (Q : dtfr (AssertTT A))
       (G': funspecs) cc b,
   ef_sig ef = mksignature (map argtype_of_type argsig) (rettype_of_type retsig) cc ->
   id_in_list id (map (@fst _ _) fs) = false ->
-  (ef_inline ef = false \/ withtype_empty A) ->
-  (forall gx ts x (ret : option val),
-     (Q ts x (make_ext_rval gx (rettype_of_type retsig) ret)
-        && !!Builtins0.val_opt_has_rettype ret (rettype_of_type retsig)
-        |-- !!tc_option_val retsig ret)) ->
+  (ef_inline ef = false \/ @withtype_empty Σ A) ->
+  (forall gx x (ret : option val),
+     (Q x (make_ext_rval gx (rettype_of_type retsig) ret)
+        ∧ ⌜Builtins0.val_opt_has_rettype ret (rettype_of_type retsig)⌝
+        ⊢ ⌜tc_option_val retsig ret⌝)) ->
   Genv.find_symbol ge id = Some b -> Genv.find_funct_ptr ge b = Some (External ef argsig retsig cc) ->
-  (forall n, semax_external Espec ef A P Q n) ->
+  (⊢ semax_external OK_spec ef A E P Q) ->
   semax_func V G ge fs G' ->
   semax_func V G ge ((id, External ef argsig retsig cc)::fs)
-       ((id, mk_funspec (argsig, retsig) cc A P Q NEP NEQ)  :: G').
+       ((id, mk_funspec (argsig, retsig) cc A E P Q) :: G').
 Proof.
 intros until b.
 intros Hef Hni Hinline Hretty B1 B2 H [Hf' [GC Hf]].
@@ -668,38 +560,37 @@ split.
 { hnf; simpl; f_equal; auto.
   constructor 2; trivial. }
 split; [ clear - B1 B2 GC; red; intros; destruct H; [ symmetry in H; inv H; exists b; auto | apply GC; trivial] |].
-intros ge' GE1 GE2 ?.
+intros ge' GE1 GE2.
 specialize (Hf ge' GE1 GE2).
-unfold believe.
-intros v' fsig' cc' A' P' Q'.
-apply derives_imp. clear n. intros n ?.
+rewrite /believe.
+iIntros (v' fsig' cc' E' A' P' Q' Hclaims).
 specialize (GE1 id); simpl in GE1. unfold fundef in GE1; rewrite B1 in GE1; simpl in GE1.
 specialize (GE2 b); simpl in GE2. unfold fundef in GE2; rewrite B2 in GE2; simpl in GE2.
-destruct (eq_dec  (Vptr b Ptrofs.zero) v') as [?H|?H].
+destruct (eq_dec (Vptr b Ptrofs.zero) v') as [?H|?H].
 + subst v'.
-left.
-specialize (H n).
-destruct (semax_func_cons_aux {| genv_genv := ge'; genv_cenv := cenv_cs |} _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ GE1 Hni Hf' H0)
-as [H4' [H4'' [H4 [H4b H4c]]]].
-subst A' fsig' cc'.
+iLeft.
+destruct (semax_func_cons_aux {| genv_genv := ge'; genv_cenv := cenv_cs |} _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ GE1 Hni Hf' Hclaims)
+as [H4' [H4'' [? [H4 [H4b H4c]]]]].
+subst E' A' fsig' cc'.
 apply JMeq_eq in H4b.
 apply JMeq_eq in H4c.
 subst P' Q'.
-unfold believe_external; simpl; rewrite if_true; trivial.
+unfold believe_external; simpl. destruct (Ptrofs.eq_dec _ _); last contradiction.
 unfold fundef in GE2; unfold fundef; simpl; rewrite GE2.
 simpl map.
-split. { split; trivial. split3; eauto. }
-intros ts x ret phi Hlev ? Hx Hnec ?. apply Hretty.
+iSplit. { iPureIntro; split; trivial. split3; eauto. }
+iSplit; first done.
+iIntros "!>" (??) "?"; iApply Hretty; done.
 +
 (* **   Vptr b Ptrofs.zero <> v'  ********)
-eapply (Hf n v' fsig' cc' A' P' Q'); auto.
-destruct H0 as [id' [NEP' [NEQ' [? ?]]]].
-simpl in H0.
+iApply Hf; iPureIntro.
+destruct Hclaims as [id' [Hlookup Hsymb]].
+simpl in Hlookup.
 destruct (eq_dec id id').
-- subst id'. rewrite PTree.gss in H0. inv H0.
-  destruct H2 as [? [? ?]]; subst. unfold fundef in H0; simpl in H0. congruence.
-- exists id', NEP', NEQ'; split; auto.
-  simpl. rewrite PTree.gso in H0 by auto; auto.
+- subst id'. rewrite Maps.PTree.gss in Hlookup. inv Hlookup.
+  destruct Hsymb as [? [Hsymb ?]]; subst. unfold fundef in Hsymb; simpl in Hsymb. congruence.
+- exists id'; split; auto.
+  simpl. rewrite Maps.PTree.gso in Hlookup; auto.
 Qed.
 
 Definition main_params (ge: genv) start : Prop :=
@@ -748,99 +639,6 @@ rewrite H3.
 auto.
 Qed.
 
-Lemma funassert_initial_core:
-forall (prog: program) ve te V G n,
-  list_norepet (prog_defs_names prog) ->
-  match_fdecs (prog_funct prog) G ->
-  app_pred (funassert (nofunc_tycontext V G) (mkEnviron (filter_genv (globalenv prog)) ve te))
-                  (initial_core (Genv.globalenv prog) G n).
-Proof.
-intros; split.
-* intros id fs.
-apply prop_imp_i; intros.
-simpl ge_of; simpl fst; simpl snd.
-unfold filter_genv, Map.get.
-assert (exists f, In (id, f) (prog_funct prog)). {
-  simpl in H1.
-  forget (prog_funct prog) as g.
-  clear - H1 H0.
-  revert G H1 H0; induction g; destruct G; intros; simpl in *.
-  exfalso.
-  rewrite PTree.gempty in H1; inv H1.
-  inv H0.
-  destruct a; simpl in *; subst.
-  destruct (eq_dec i id). subst; eauto.
-  specialize (IHg nil H1). inv H0.
-  destruct a. destruct p.
-  inv H0.
-  simpl in H1.
-  destruct (ident_eq i0 id). subst. eauto.
-  destruct (IHg G); auto. rewrite PTree.gso in H1; auto.
-  eauto.
-}
-destruct H2 as [f ?].
-destruct (find_funct_ptr_exists prog id f) as [b [? ?]]; auto.
-apply in_prog_funct_in_prog_defs; auto.
-exists b. unfold fundef.
-unfold globalenv. simpl. rewrite H3.
-split; auto.
-unfold func_at. destruct fs as [f0 cc0 A a a0].
-unfold initial_core.
-hnf. rewrite resource_at_make_rmap.
-rewrite level_make_rmap.
-unfold initial_core'.
-simpl.
-rewrite (Genv.find_invert_symbol (Genv.globalenv prog) id); auto.
-assert (H9: In (id, mk_funspec f0 cc0 A a a0 P_ne Q_ne) G). {
-  clear - H1.
-  simpl in H1. unfold make_tycontext_g in H1; simpl in H1.
-  induction G; simpl in *.
-  rewrite PTree.gempty in H1; inv H1.
-  destruct (ident_eq (fst a1) id); subst.
-  destruct a1; simpl in *.
-  rewrite PTree.gss in H1; inv H1. left; auto.
-  destruct a1; simpl in *.
-  rewrite PTree.gso in H1; auto.
-}
-rewrite (find_id_i _ _ _ H9); auto.
-clear - H0 H. unfold prog_defs_names, prog_funct in *.
-eapply match_fdecs_norepet; eauto.
-apply list_norepet_prog_funct'; auto.
-*
-intros loc' fsig' cc'.
-intros ? w ? Hext ?.
-destruct H2 as [pp ?].
-hnf in H2.
-assert (exists pp, initial_core (Genv.globalenv prog) G n @ (loc',0) = PURE (FUN fsig' cc') pp).
-apply rmap_order in Hext as (Hl & Hr & _); rewrite <- Hl, <- Hr in *.
-case_eq (initial_core (@Genv.globalenv (Ctypes.fundef function) type prog) G n @ (loc', 0)); intros.
-destruct (necR_NO _ _ (loc',0) sh n0 H1) as [? _].
-rewrite H4 in H2 by auto.
-inv H2.
-eapply necR_YES in H1; try apply H3.
-rewrite H1 in H2; inv H2.
-eapply necR_PURE in H1; try apply H3.
-rewrite H1 in H2; inv H2; eauto.
-destruct H3 as [pp' ?].
-unfold initial_core in H3.
-rewrite resource_at_make_rmap in H3.
-unfold initial_core' in H3.
-if_tac in H3; [ | inv H3].
-simpl.
-simpl @fst in *.
-revert H3; case_eq (@Genv.invert_symbol (Ctypes.fundef function)
-                                        type (@Genv.globalenv (Ctypes.fundef function) type prog) loc' ); intros;
-  [ | congruence].
-revert H5; case_eq (find_id i G); intros; [| congruence].
-destruct f as [?f ?A ?a ?a]. symmetry in H6; inv H6.
-apply Genv.invert_find_symbol in H3.
-exists i.
-simpl ge_of. unfold filter_genv, Map.get.
-unfold globalenv; simpl.
-rewrite make_tycontext_s_find_id.
-split; [ | eexists]; eassumption.
-Qed.
-
 Lemma prog_contains_prog_funct: forall prog: program,
   list_norepet (prog_defs_names prog) ->
       prog_contains (globalenv prog) (prog_funct prog).
@@ -855,208 +653,6 @@ destruct g. simpl in H0. destruct H0. inv H0.  left. auto.
 right; auto.  right; auto.
 Qed.
 
-Lemma funassert_initial_core_ext:
-forall (ora : OK_ty) (prog: program) ve te V G n,
-  list_norepet (prog_defs_names prog) ->
-  match_fdecs (prog_funct prog) G ->
-  app_pred (funassert (nofunc_tycontext V G) (mkEnviron (filter_genv (globalenv prog)) ve te))
-                  (initial_core_ext ora (Genv.globalenv prog) G n).
-Proof.
-intros; split.
-*
-intros id fs.
-apply prop_imp_i; intros.
-simpl ge_of; simpl fst; simpl snd.
-unfold filter_genv, Map.get.
-assert (exists f, In (id, f) (prog_funct prog)). {
-simpl in H1.
-forget (prog_funct prog) as g.
-clear - H1 H0.
-revert G H1 H0; induction g; destruct G; intros; simpl in *.
-exfalso.
-rewrite PTree.gempty in H1; inv H1.
-inv H0.
-destruct a; simpl in *; subst.
-destruct (eq_dec i id). subst; eauto.
-specialize (IHg nil H1). inv H0.
-destruct a. destruct p.
-inv H0.
-simpl in H1.
-destruct (ident_eq i0 id). subst. eauto.
-destruct (IHg G); auto. rewrite PTree.gso in H1; auto.
-eauto.
-}
-destruct H2 as [f ?].
-destruct (find_funct_ptr_exists prog id f) as [b [? ?]]; auto.
-apply in_prog_funct_in_prog_defs; auto.
-exists b. unfold fundef.
-unfold globalenv. simpl. rewrite H3.
-split; auto.
-unfold func_at. destruct fs as [f0 cc0 A a a0].
-unfold initial_core_ext.
-hnf. rewrite resource_at_make_rmap.
-rewrite level_make_rmap.
-unfold initial_core'.
-simpl.
-rewrite (Genv.find_invert_symbol (Genv.globalenv prog) id); auto.
-assert (H9: In (id, mk_funspec f0 cc0 A a a0 P_ne Q_ne) G). {
-clear - H1.
-simpl in H1. unfold make_tycontext_g in H1; simpl in H1.
-induction G; simpl in *.
-rewrite PTree.gempty in H1; inv H1.
-destruct (ident_eq (fst a1) id); subst.
-destruct a1; simpl in *.
-rewrite PTree.gss in H1; inv H1. left; auto.
-destruct a1; simpl in *.
-rewrite PTree.gso in H1; auto.
-}
-rewrite (find_id_i _ _ _ H9); auto.
-clear - H0 H. unfold prog_defs_names, prog_funct in *.
-eapply match_fdecs_norepet; eauto.
-apply list_norepet_prog_funct'; auto.
-*
-intros loc'  fsig' cc'.
-intros ? w ? Hext ?.
-destruct H2 as [pp ?].
-hnf in H2.
-assert (exists pp, initial_core_ext ora (Genv.globalenv prog) G n @ (loc',0) = PURE (FUN fsig' cc') pp).
-apply rmap_order in Hext as (Hl & Hr & _); rewrite <- Hl, <- Hr in *.
-case_eq (initial_core_ext ora (Genv.globalenv prog) G n @ (loc',0)); intros.
-destruct (necR_NO _ _ (loc',0) sh n0 H1) as [? _].
-rewrite H4 in H2 by auto.
-inv H2.
-eapply necR_YES in H1; try apply H3.
-rewrite H1 in H2; inv H2.
-eapply necR_PURE in H1; try apply H3.
-rewrite H1 in H2; inv H2; eauto.
-destruct H3 as [pp' ?].
-unfold initial_core_ext in H3.
-rewrite resource_at_make_rmap in H3.
-unfold initial_core' in H3.
-if_tac in H3; [ | inv H3].
-simpl.
-simpl @fst in *.
-revert H3; case_eq (@Genv.invert_symbol (Ctypes.fundef function) type
-          (@Genv.globalenv (Ctypes.fundef function) type prog) loc'); intros;
-[ | congruence].
-revert H5; case_eq (find_id i G); intros; [| congruence].
-destruct f as [?f ?A ?a ?a]; inv H6.
-apply Genv.invert_find_symbol in H3.
-exists i.
-unfold filter_genv, Map.get.
-rewrite make_tycontext_s_find_id.
-split; [ | eexists]; eassumption.
-Qed.
-
-Lemma core_inflate_initial_mem:
-forall (m: mem) (prog: program) (G: funspecs) (n: nat)
- (INIT: Genv.init_mem prog = Some m),
-match_fdecs (prog_funct prog) G ->
-  list_norepet (prog_defs_names prog) ->
-core (inflate_initial_mem m (initial_core (Genv.globalenv prog) G n)) =
-     initial_core (Genv.globalenv prog) G n.
-Proof.
-intros.
-assert (IOK := initial_core_ok _ _ n _ H0 H INIT).
-apply rmap_ext.
-unfold inflate_initial_mem, initial_core; simpl.
-rewrite level_core. do 2 rewrite level_make_rmap; auto.
-intro l.
-unfold inflate_initial_mem, initial_core; simpl.
-rewrite <- core_resource_at.
-repeat rewrite resource_at_make_rmap.
-unfold inflate_initial_mem'.
-repeat rewrite resource_at_make_rmap.
-unfold initial_core'.
-case_eq (@Genv.invert_symbol (Ctypes.fundef function) type (@Genv.globalenv (Ctypes.fundef function) type prog) (@fst block Z l) ); intros; auto.
-rename i into id.
-case_eq (find_id id G); intros; auto.
-rename f into fs.
-assert (exists f, In (id,f) (prog_funct prog)).
-apply find_id_e in H2.
-apply in_map_fst in H2.
-eapply match_fdecs_in in H2; eauto.
-apply in_map_iff in H2.
-destruct H2 as [[i' f] [? ?]]. subst id; exists f; auto.
-destruct H3 as [f ?].
-apply Genv.invert_find_symbol in H1.
-destruct (find_funct_ptr_exists prog id f) as [b [? ?]]; auto.
-apply in_prog_funct_in_prog_defs; auto.
-inversion2 H1 H4.
-+ if_tac.
-- destruct (IOK l) as [_ ?].
-unfold initial_core in H6. rewrite resource_at_make_rmap in H6.
-unfold initial_core' in H6. rewrite if_true in H6 by auto.
-apply Genv.find_invert_symbol in H1.
-unfold fundef in *; rewrite H1 in *.
-rewrite H2 in *. destruct fs.
-destruct H6 as [? [? ?]]. rewrite H7.
-rewrite core_PURE; auto.
-- destruct (access_at m l); try destruct p; try rewrite core_YES; try rewrite core_NO; auto.
-+
-if_tac;  destruct (access_at m l); try destruct p; try rewrite core_YES; try rewrite core_NO; auto.
-+
-if_tac;   destruct (access_at m l); try destruct p; try rewrite core_YES; try rewrite core_NO; auto.
-+ rewrite ghost_of_core.
-unfold inflate_initial_mem, initial_core; rewrite !ghost_of_make_rmap, ghost_core_eq; auto.
-Qed.
-
-(* This isn't true: we get a core of the external ghost state left over.
-   When would we use this, though?
-Lemma core_inflate_initial_mem':
-forall (ora : OK_ty) (m: mem) (prog: program) (G: funspecs) (n: nat)
- (INIT: Genv.init_mem prog = Some m),
-match_fdecs (prog_funct prog) G ->
-  list_norepet (prog_defs_names prog) ->
-core (inflate_initial_mem m (initial_core_ext ora (Genv.globalenv prog) G n)) =
-     initial_core (Genv.globalenv prog) G n.
-Proof.
-intros.
-assert (IOK := initial_core_ext_ok ora _ _ n _ H0 H INIT).
-apply rmap_ext.
-unfold inflate_initial_mem, initial_core, initial_core_ext; simpl.
-rewrite level_core. rewrite !level_make_rmap; auto.
-intro l.
-unfold inflate_initial_mem, initial_core, initial_core_ext; simpl.
-rewrite <- core_resource_at.
-repeat rewrite resource_at_make_rmap.
-unfold inflate_initial_mem'.
-repeat rewrite resource_at_make_rmap.
-unfold initial_core'.
-case_eq (Genv.invert_symbol (Genv.globalenv prog) (fst l)); intros; auto.
-rename i into id.
-case_eq (find_id id G); intros; auto.
-rename f into fs.
-assert (exists f, In (id,f) (prog_funct prog)).
-apply find_id_e in H2.
-apply in_map_fst in H2.
-eapply match_fdecs_in in H2; eauto.
-apply in_map_iff in H2.
-destruct H2 as [[i' f] [? ?]]. subst id; exists f; auto.
-destruct H3 as [f ?].
-apply Genv.invert_find_symbol in H1.
-destruct (find_funct_ptr_exists prog id f) as [b [? ?]]; auto.
-apply in_prog_funct_in_prog_defs; auto.
-inversion2 H1 H4.
-+ if_tac.
-- destruct (IOK l) as [_ ?].
-unfold initial_core_ext in H6. rewrite resource_at_make_rmap in H6.
-unfold initial_core' in H6. rewrite if_true in H6 by auto.
-apply Genv.find_invert_symbol in H1.
-unfold fundef in *; rewrite H1 in *.
-rewrite H2 in *. destruct fs.
-destruct H6 as [? [? ?]]. rewrite H7.
-rewrite core_PURE; auto.
-- destruct (access_at m l); try destruct p; try rewrite core_YES; try rewrite core_NO; auto.
-+ (*unfold fundef in *; rewrite H1,H2 in *.*)
-if_tac;  destruct (access_at m l); try destruct p; try rewrite core_YES; try rewrite core_NO; auto.
-+ (*unfold fundef in *; rewrite H1 in *.*)
-if_tac;   destruct (access_at m l); try destruct p; try rewrite core_YES; try rewrite core_NO; auto.
-+ rewrite ghost_of_core.
-unfold inflate_initial_mem, initial_core_ext; rewrite !ghost_of_make_rmap, ghost_core_eq; auto.
-simpl; do 3 f_equal. unfold ext_ghost; f_equal. apply exist_ext. f_equal; intros. f_equal. Search ext_ghost.
-Qed.*)
-
 Definition Delta1 V G {C: compspecs}: tycontext :=
 make_tycontext ((1%positive,(Tfunction nil Tvoid cc_default))::nil) nil nil Tvoid V G nil.
 
@@ -1121,12 +717,15 @@ inv IHvl.
 constructor; auto.
 Qed.
 
+Local Notation make_tycontext_s := (make_tycontext_s(Σ := Σ)).
+Local Notation make_tycontext_g := (make_tycontext_g(Σ := Σ)).
+
 Lemma make_tycontext_g_denote:
 forall id t l vs G,
 list_norepet (map fst l) ->
 match_globvars (prog_vars' l) vs = true ->
 match_fdecs (prog_funct' l) G ->
-((make_tycontext_g vs G) ! id = Some t <->
+((make_tycontext_g vs G) !! id = Some t <->
 ((exists f, In (id,f) G /\ t = type_of_funspec f) \/ In (id,t) vs)).
 Proof.
 intros.
@@ -1163,20 +762,20 @@ apply iff_trans with (In (id, t) vs );
 [ | clear; intuition; destruct H0 as [? [? ?]]; contradiction].
 revert vs H0; induction vl; destruct vs; simpl in *; intros.
 +(* fl = nil /\ vl = nil /\ vs = nil*)
-rewrite PTree.gempty.
+setoid_rewrite Maps.PTree.gempty.
 split; intros. discriminate. contradiction.
 + (* fl = nil /\ vl = nil /\ vs<>nil *)
 clear H2.
 destruct p. inv H0.
 + (* fl = nil /\ vl inductive case /\ vs = nil  *)
-clear H0. rewrite PTree.gempty.
+clear H0. setoid_rewrite Maps.PTree.gempty.
 clear. intuition congruence.
 + (* fl = nil /\ vl inductive case /\ vs <> nil *)
 destruct p. destruct a. simpl in *. inv H2.
 specialize (IHvl H4).
 destruct (ident_eq id i).
 - subst id.
-rewrite PTree.gss. split; intro. inv H.
+setoid_rewrite Maps.PTree.gss. split; intro. inv H.
 auto.
 destruct H. inv H. auto.
 pose proof (eqb_ident_spec i i0); destruct (eqb_ident i i0).
@@ -1189,10 +788,10 @@ clear H1.
 pose proof (match_globvars_norepet _ _ H4 H0).
 inv H1. contradiction H7. apply in_map_fst with t; auto.
 - (* id <> i *)
-rewrite PTree.gso by auto.
+setoid_rewrite Maps.PTree.gso; auto.
 pose proof (eqb_ident_spec i i0).
 destruct (ident_eq i i0).
-subst. destruct H. rewrite H1 in H0 by auto.
+subst. destruct H. rewrite -> H1 in H0 by auto.
 rewrite andb_true_iff in H0; destruct H0.
 apply eqb_type_true in H0. subst t0.
 clear H H1.
@@ -1200,7 +799,7 @@ rewrite IHvl; auto.
 clear - n; intuition. inv H0; congruence.
 destruct (eqb_ident i i0). contradict n0; apply H; auto.
 eapply iff_trans; [ | apply (IHvl ((i,t0)::vs))]; clear IHvl.
-simpl;  rewrite PTree.gso by auto. apply iff_refl.
+simpl; setoid_rewrite Maps.PTree.gso; auto. apply iff_refl.
 auto.
 *
 inv H1.
@@ -1208,7 +807,7 @@ inv H1.
 inv H2.
 specialize (IHfl _ H5 H6).
 destruct (ident_eq id i). subst.
-simpl; rewrite PTree.gss.
+simpl; setoid_rewrite Maps.PTree.gss.
 split; intro.
 left; exists fspec.  inv H; auto.
 f_equal.
@@ -1221,7 +820,7 @@ contradiction H3. apply in_app_iff; right.
 subst.
 eapply match_globvars_in; eauto.
 apply in_map_fst in H; auto.
-simpl; rewrite PTree.gso; auto.
+simpl; setoid_rewrite Maps.PTree.gso; auto.
 rewrite IHfl. clear IHfl.
 split; intros [[f [? ?]]| ?]; subst.
 left; eauto. right; eauto.
@@ -1277,7 +876,7 @@ match_globvars (prog_vars prog) vs = true ->
 match_fdecs (prog_funct prog) G ->
 typecheck_environ
   (Delta1 vs G) (construct_rho (filter_genv (globalenv prog)) empty_env
-    (PTree.set 1 (Vptr b Ptrofs.zero) (PTree.empty val))) .
+    (Maps.PTree.set 1 (Vptr b Ptrofs.zero) (Maps.PTree.empty val))) .
 Proof.
 unfold Delta1; intros.
 unfold construct_rho.
@@ -1293,23 +892,21 @@ unfold typecheck_temp_environ.
 unfold make_tenv.
 unfold Map.get.
 intros.
-rewrite PTree.gsspec in *. if_tac. inv H2.
+setoid_rewrite Maps.PTree.gsspec in H2; rewrite Maps.PTree.gsspec. if_tac. inv H2.
 + exists (Vptr b Ptrofs.zero); split; auto. apply tc_val_tc_val'. simpl; auto.
-+ rewrite PTree.gempty in H2. congruence.
++ rewrite Maps.PTree.gempty in H2. congruence.
 *
 unfold var_types.
 unfold typecheck_var_environ. intros.
 unfold make_tycontext_v. simpl.
-rewrite PTree.gempty.
-unfold Map.get, make_venv, empty_env.
-rewrite PTree.gempty.
+setoid_rewrite Maps.PTree.gempty.
 intuition. inv H2. destruct H2; inv H2.
 *
 unfold glob_types. unfold make_tycontext_t, snd.
 eapply tc_ge_denote_initial; eauto.
 Qed.
 
-Lemma in_map_sig {A B} (E:forall b b' : B, {b=b'}+{b<>b'}) y (f : A -> B) l : In y (map f l) -> {x : A | f x = y /\ In x l }.
+Lemma in_map_sig {A B} (E:forall b b' : B, {b=b'}+{b<>b'} ) y (f : A -> B) l : In y (map f l) -> {x : A | f x = y /\ In x l }.
 Proof.
 induction l; intros HI.
 - inversion HI.
@@ -1333,8 +930,8 @@ now intro; eexists; symmetry; apply Pos2Nat.id.
 intros p.
 assert (group : forall {A} {B} (a a':A) (b b':B), (a = a' /\ b = b') <-> ((a, b) = (a', b')))
 by (intros;split; [ intros [<- <-]; reflexivity | intros E; injection E; auto]).
-assert (sumbool_iff_left : forall (A A' B : Prop), (A -> A') -> {A}+{B} -> {A'}+{B}) by tauto.
-assert (sumbool_iff_right : forall (A B B' : Prop), (B -> B') -> {A}+{B} -> {A}+{B'}) by tauto.
+assert (sumbool_iff_left : forall (A A' B : Prop), (A -> A') -> {A}+{B} -> {A'}+{B} ) by tauto.
+assert (sumbool_iff_right : forall (A B B' : Prop), (B -> B') -> {A}+{B} -> {A}+{B'} ) by tauto.
 eapply sumbool_iff_left. apply group.
 eapply sumbool_iff_right. rewrite group. apply (fun x => x).
 pose proof type_eq.
@@ -1342,190 +939,77 @@ pose proof eq_dec_statement.
 repeat (hnf; decide equality; auto).
 Qed.
 
-Lemma initial_jm_funassert V (prog : Clight.program) m G n H H1 H2 :
-(funassert (nofunc_tycontext V G) (empty_environ (globalenv prog)))
-(m_phi (initial_jm prog m G n H H1 H2)).
-Proof.
-unfold initial_jm.
-assert (FA: app_pred (funassert (nofunc_tycontext V G) (empty_environ (globalenv prog)))
-(initial_world.initial_core (Genv.globalenv prog) G n)
-     ).
-apply funassert_initial_core; auto.
-revert FA.
-apply corable_core; [apply corable_funassert|].
-pose proof initial_mem_core as E.
-unfold juicy_mem_core in *. erewrite E; try reflexivity.
-Qed.
-
-Lemma initial_jm_ext_funassert (ora : OK_ty) V (prog : Clight.program) m G n H H1 H2 :
-(funassert (nofunc_tycontext V G) (empty_environ (globalenv prog)))
-(m_phi (initial_jm_ext ora prog m G n H H1 H2)).
-Proof.
-unfold initial_jm_ext.
-assert (FA: app_pred (funassert (nofunc_tycontext V G) (empty_environ (globalenv prog)))
-(initial_world.initial_core_ext ora (Genv.globalenv prog) G n)
-     ).
-apply funassert_initial_core_ext; auto.
-revert FA.
-apply corable_core; [apply corable_funassert|].
-pose proof initial_mem_core as E.
-unfold juicy_mem_core in *. erewrite E; try reflexivity.
-Qed.
-
-Lemma find_id_maketycontext_s G id : (make_tycontext_s G) ! id = find_id id G.
+Lemma find_id_maketycontext_s G id : (make_tycontext_s G) !! id = find_id id G.
 Proof.
 induction G as [|(i,t) G]; simpl.
 - destruct id; reflexivity.
-- rewrite PTree.gsspec.
-do 2 if_tac; congruence.
-Qed.
-
-Lemma ext_ref_join : forall {Z} (z : Z), join (ext_ghost z) (ext_ref z) (ext_both z).
-Proof.
-  intros; repeat constructor.
+- rewrite Maps.PTree.gsspec.
+  do 2 if_tac; done.
 Qed.
 
 (**************Adaptation of seplog.funspecs_assert, plus lemmas ********)
 (*Maybe this definition can replace seplog.funassert globally?. In fact it
-  really needs a genvinron as parameter, not a genviron * list val*)
-Definition funspecs_gassert (FunSpecs: PTree.t funspec): argsassert :=
- fun gargs => let g := fst gargs in
-   (ALL  id: ident, ALL fs:_,  !! (FunSpecs!id = Some fs) -->
-              EX b:block,
-                   !! (Map.get g id = Some b) && func_at fs (b,0))
- &&  (ALL  b: block, ALL fsig:typesig, ALL cc: calling_convention, sigcc_at fsig cc (b,0) -->
-             EX id:ident, !! (Map.get g id = Some b)
-                             && !! exists fs, FunSpecs!id = Some fs).
+  really needs a genviron as parameter, not a genviron * list val*)
+Definition funspecs_gassert (FunSpecs: Maps.PTree.t funspec): argsassert :=
+ argsassert_of (fun gargs => let g := fst gargs in
+   □ (∀ id: ident, ∀ fs:funspec,  ⌜(FunSpecs!!id = Some fs)%maps⌝ →
+            ∃ b:block,⌜Map.get g id = Some b⌝ ∧ func_at fs (b,0)) ∗
+     (∀ b fsig cc, sigcc_at fsig cc (b, 0) -∗
+           ⌜∃ id, Map.get g id = Some b ∧ ∃ fs, (FunSpecs!!id)%maps = Some fs⌝)).
 
 (*Maybe this definition can replace Clight_seplog.funassert globally?*)
 Definition fungassert (Delta: tycontext): argsassert := funspecs_gassert (glob_specs Delta).
 
-(*EXCTLY THE SAME PROOFSCRIPT AS semax_call.resource_decay_funassert*)
-Lemma resource_decay_fungassert:
-  forall G gargs b w w',
-         necR (core w) (core w') ->
-         resource_decay b w w' ->
-         app_pred (fungassert G gargs) w ->
-         app_pred (fungassert G gargs) w'.
+Lemma believe_cs_ext:
+ forall CS Delta ge1 ge2 Delta',
+  @genv_genv ge1 = @genv_genv ge2 ->
+  Maps.PTree.elements (@genv_cenv ge1) = Maps.PTree.elements (@genv_cenv ge2) ->
+  believe(CS := CS) OK_spec Delta ge1 Delta' ⊢
+  believe(CS := CS) OK_spec Delta ge2 Delta'.
 Proof.
-unfold resource_decay, funassert; intros until w'; intro CORE; intros.
-destruct H.
-destruct H0.
-split; [clear H2 | clear H0].
-+ intros id fs ? w2 Hw2 Hext H3.
-  specialize (H0 id fs). cbv beta in H0.
-  specialize (H0 _ _ (necR_refl _) (ext_refl _) H3).
-  destruct H0 as [loc [? ?]].
-  exists loc; split; auto.
-  destruct fs as [f cc A a a0].
-  simpl in H2|-*.
-  pose proof (necR_resource_at (core w) (core w') (loc,0)
-         (PURE (FUN f cc) (SomeP (SpecArgsTT A) (packPQ a a0))) CORE).
-  pose proof (necR_resource_at _ _ (loc,0)
-         (PURE (FUN f cc) (SomeP (SpecArgsTT A) (packPQ a a0))) Hw2).
-  apply rmap_order in Hext as (<- & <- & _).
-  apply H5.
-  clear - H4 H2.
-  repeat rewrite <- core_resource_at in *.
-  spec H4. rewrite H2.  rewrite core_PURE.  simpl.  rewrite level_core; reflexivity.
-  destruct (w' @ (loc,0)).
-  rewrite core_NO in H4; inv H4.
-  rewrite core_YES in H4; inv H4.
-  rewrite core_PURE in H4; inv H4. rewrite level_core; reflexivity.
-+
-intros loc sig cc ? w2 Hw2 Hext H6.
-specialize (H2 loc sig cc _ _ (necR_refl _) (ext_refl _)).
-spec H2.
-{ clear - Hw2 Hext CORE H6. simpl in *.
-  destruct H6 as [pp H6].
-  rewrite <- resource_at_approx.
-  apply rmap_order in Hext as (Hl & Hr & _); rewrite <- Hl, <- Hr in H6.
-  case_eq (w @ (loc,0)); intros.
-  + assert (core w @ (loc,0) = resource_fmap (approx (level (core w))) (approx (level (core w))) (NO _ bot_unreadable)).
-     - rewrite <- core_resource_at.
-       simpl resource_fmap; erewrite <- core_NO; f_equal; eassumption.
-     - pose proof (necR_resource_at _ _ _ _ CORE H0).
-       pose proof (necR_resource_at _ _ _ _ (necR_core _ _ Hw2) H1).
-       rewrite <- core_resource_at in H2; rewrite H6 in H2;
-       rewrite core_PURE in H2; inv H2.
-  + assert (core w @ (loc,0) = resource_fmap (approx (level (core w))) (approx (level (core w))) (NO _ bot_unreadable)).
-    - rewrite <- core_resource_at.
-      simpl resource_fmap; erewrite <- core_YES; f_equal; eassumption.
-    - pose proof (necR_resource_at _ _ _ _ CORE H0).
-      pose proof (necR_resource_at _ _ _ _ (necR_core _ _ Hw2) H1).
-      rewrite <- core_resource_at in H2; rewrite H6 in H2;
-      rewrite core_PURE in H2; inv H2.
-  + pose proof (resource_at_approx w (loc,0)).
-    pattern (w @ (loc,0)) at 1 in H0; rewrite H in H0.
-    symmetry in H0.
-    assert (core (w @ (loc,0)) = core (resource_fmap (approx (level w)) (approx (level w))
-       (PURE k p))) by (f_equal; auto).
-    rewrite core_resource_at in H1.
-    assert (core w @ (loc,0) =
-        resource_fmap (approx (level (core w))) (approx (level (core w)))
-         (PURE k p)).
-    - rewrite H1.  simpl resource_fmap. rewrite level_core; rewrite core_PURE; auto.
-    - pose proof (necR_resource_at _ _ _ _ CORE H2).
-      assert (w' @ (loc,0) = resource_fmap
-         (approx (level w')) (approx (level w')) (PURE k p)).
-      * rewrite <- core_resource_at in H3. rewrite level_core in H3.
-        destruct (w' @ (loc,0)).
-        ++ rewrite core_NO in H3; inv H3.
-        ++ rewrite core_YES in H3; inv H3.
-        ++ rewrite core_PURE in H3; inv H3.
-           reflexivity.
-      * pose proof (necR_resource_at _ _ _ _ Hw2 H4).
-        inversion2 H6 H5.
-        exists p. trivial. }
-destruct H2 as [id [? ?]].
-exists id. split; auto.
+  intros.
+  rewrite /believe.
+  iIntros "H" (????????).
+  destruct ge1 as [ge ce1]; destruct ge2 as [ge2 ce2]; simpl in *; subst ge2.
+  by iApply "H".
 Qed.
 
-
-
-Lemma believe_cs_ext:
- forall CS Espec Delta ge1 ge2 Delta' n,
-  @genv_genv ge1 = @genv_genv ge2 ->
-  PTree.elements (@genv_cenv ge1) = PTree.elements (@genv_cenv ge2) ->
-  @believe CS Espec Delta ge1 Delta' n ->
-  @believe CS Espec Delta ge2 Delta' n.
+Lemma return_stop_safe : forall E psi ora v,
+  postcondition_allows_exit tint ->
+  True ⊢ jsafeN OK_spec psi E ora (Clight_core.Returnstate v Kstop).
 Proof.
-intros.
-intros b fsig0 cc A P Q; specialize (H1 b fsig0 cc A P Q).
-intros ? n1 H2 Hext H3. specialize (H1 _ _ H2 Hext).
-destruct ge1 as [ge ce1]; destruct ge2 as [ge2 ce2]; simpl in H; subst ge2.
-simpl in H0.
-specialize (H1 H3).
-clear H3 H2.
-apply H1.
+  intros.
+  iIntros "?".
+  rewrite /jsafeN jsafe_unfold /jsafe_pre.
+  iIntros "!> % ?"; iLeft.
+  iExists Int.zero; iSplit; first by iPureIntro.
+  iPureIntro; by apply H.
 Qed.
 
 Lemma semax_prog_entry_point {CS: compspecs} V G prog b id_fun params args A
-   (P: forall ts : list Type, (dependent_type_functor_rec ts (ArgsTT A)) mpred)
-   (Q: forall ts : list Type, (dependent_type_functor_rec ts (AssertTT A)) mpred)
-  NEP NEQ h z:
+   (E: dtfr (MaskTT A))
+   (P: dtfr (ArgsTT A))
+   (Q: dtfr (AssertTT A))
+  h z:
   let retty := tint in
   postcondition_allows_exit retty ->
   @semax_prog CS prog z V G ->
   Genv.find_symbol (globalenv prog) id_fun = Some b ->
   find_id id_fun G =
-     Some (mk_funspec (params, retty) cc_default A P Q NEP NEQ) ->
+     Some (mk_funspec (params, retty) cc_default A E P Q) ->
   tc_vals params args ->
   let gargs := (filter_genv (globalenv prog), args) in
   { q : CC_core |
-   (forall jm,
-     Forall (fun v => Val.inject (Mem.flat_inj (nextblock (m_dry jm))) v v)  args->
-     inject_neutral (nextblock (m_dry jm)) (m_dry jm) /\
-     Coqlib.Ple (Genv.genv_next (Genv.globalenv prog)) (nextblock (m_dry jm)) ->
-    exists jm', semantics.initial_core
-    (juicy_core_sem (cl_core_sem (globalenv prog))) h
-    jm q jm' (Vptr b Ptrofs.zero) args) /\
-
-  forall (jm : juicy_mem) ts (a: (dependent_type_functor_rec ts A) mpred),
-    app_pred (P ts a gargs) (m_phi jm) ->
-    app_pred (fungassert (nofunc_tycontext V G) gargs ) (m_phi jm) ->
-    nth_error (ghost_of (m_phi jm)) 0 = Some (Some (ext_ghost z, NoneP)) ->
-    jsafeN (@OK_spec Espec) (globalenv prog) z q jm }.
+   (forall m,
+(*     Forall (fun v => Val.inject (Mem.flat_inj (nextblock m)) v v)  args->*)
+(*     inject_neutral (nextblock m) m /\ *)
+(*     Coqlib.Ple (Genv.genv_next (Genv.globalenv prog)) (nextblock m) ->*)
+    exists m', semantics.initial_core (cl_core_sem (globalenv prog)) h
+    m q m' (Vptr b Ptrofs.zero) args) /\
+
+  forall (a: dtfr A),
+    <absorb> P a gargs ∗ fungassert (nofunc_tycontext V G) gargs ⊢
+    jsafeN OK_spec (globalenv prog) (E a) z q }.
 Proof.
 intro retty.
 intros EXIT SP Findb id_in_G arg_p.
@@ -1535,457 +1019,104 @@ destruct ((fun x => x) SP) as (_ & _ & _ & (MatchFdecs & (Gcontains & Believe))
 specialize (Believe (globalenv prog)).
 spec Believe; [ intros; apply sub_option_refl |].
 spec Believe; [ intros; apply sub_option_refl |].
-specialize (Believe 0%nat).
-apply believe_cs_ext with (ge2 :=
+unshelve eapply (bi.bi_emp_valid_mono _ _ (believe_cs_ext _ _ _ (
   {| genv_genv := genv_genv (globalenv prog);
-     genv_cenv := prog_comp_env prog |}) in Believe; auto.
-replace  {|
-               genv_genv := genv_genv (globalenv prog);
-               genv_cenv := prog_comp_env prog |}
- with (globalenv prog) in Believe
-  by (unfold globalenv; f_equal; auto).
+     genv_cenv := prog_comp_env prog |} ) _ _ _)) in Believe; try done.
 unfold nofunc_tycontext in *.
-destruct (believe_exists_fundef Findb Believe id_in_G) as [f [Eb Ef]].
-clear Believe.
+eapply (believe_exists_fundef' Findb) in Believe as [f [Eb Ef]]; last done.
 exists (Clight_core.Callstate f args Kstop).
 simpl semantics.initial_core.
-unfold j_initial_core.
-simpl semantics.initial_core.
-fold fundef in *.
 split.
-intros; exists jm; split; auto.
-rewrite if_true by auto.
-change (Genv.globalenv (program_of_program prog))
-  with (genv_genv (globalenv prog)).
-rewrite Eb; auto.
-intros jm ts a m_sat_Pa m_funassert.
-intros HZ.
+{ intros m; exists m.
+  rewrite -> if_true by auto.
+  rewrite Eb //. }
+intros.
 set (psi := globalenv prog) in *.
-destruct SP as [H0 [AL [_ [[H2 [GC H3]] [GV _]]]]].
-set (fspec := mk_funspec (params, retty) cc_default A P Q NEP NEQ) in *.
-specialize (H3 (genv_genv psi)).
-spec H3. intros; apply sub_option_refl.
-spec H3. intros; apply sub_option_refl.
-specialize (H3 (S (level jm))).
-apply believe_cs_ext with (ge2 :=
-  {| genv_genv := genv_genv (globalenv prog);
-     genv_cenv := prog_comp_env prog |}) in H3; auto.
- fold psi in H3.
-replace  {|
-               genv_genv := genv_genv psi;
-               genv_cenv := prog_comp_env prog |}
- with psi in *
-  by (subst psi; unfold globalenv; f_equal; auto).
-rename H3 into Prog_OK. assert (H3 := I).
-
-rename z into ora.
-assert (Hora: ext_compat ora (m_phi jm)). {
- pose proof (ext_ref_join ora).
- exists ((Some (ext_both ora, NoneP)) :: tl (ghost_of (m_phi jm))).
- destruct (ghost_of (m_phi jm)). inv HZ.
- simpl in HZ. inv HZ.
- constructor; auto.
- constructor.
- constructor; [auto|]. simpl. constructor; auto.
- simpl.
- apply ghost_join_nil_r.
-}
-clear HZ. clear AL.
+destruct SP as [H0 [AL [_ [[H2 [GC Prog_OK]] [GV _]]]]].
+set (fspec := mk_funspec (params, retty) cc_default A (λne _, ⊤) P Q) in *.
+specialize (Prog_OK (genv_genv psi)).
+spec Prog_OK. { intros; apply sub_option_refl. }
+spec Prog_OK. { intros; apply sub_option_refl. }
+unshelve eapply (bi.bi_emp_valid_mono _ _ (believe_cs_ext _ _ _ psi _ _ _)) in Prog_OK; try done.
+clear AL.
 set (Delta := nofunc_tycontext V G) in *.
 change (make_tycontext_s G)
    with (glob_specs Delta) in id_in_G.
-change (make_tycontext nil nil nil Tvoid V G nil)
-  with Delta in m_funassert.
+change (make_tycontext nil nil nil Tvoid V G nil) with Delta.
 assert  (TC5: typecheck_glob_environ (filter_genv psi) (glob_types Delta)). {
      eapply tc_ge_denote_initial; try eassumption.
      apply compute_list_norepet_e; auto.
 }
-
-clearbody Delta.
-forget cc_default as cc.
 change (prog_comp_env prog) with (genv_cenv psi) in *.
-
-
 assert (HGG: cenv_sub (@cenv_cs CS) (globalenv prog)).
  { clear - CSEQ. forget (@cenv_cs CS) as cs1.
    subst psi. forget (genv_cenv (globalenv prog)) as cs2.
    hnf; intros; hnf.
-   destruct (cs1 ! i) eqn:?H; auto.
-   apply PTree.elements_correct in H.
-   apply PTree.elements_complete. congruence.
- }
-
-(***  cut here ****)
-
-assert (H5 := Prog_OK).
-specialize (H5 (Vptr b Ptrofs.zero)).
-specialize (H5 (typesig_of_funspec fspec)
-   (callingconvention_of_funspec fspec)).
-specialize (H5 A P Q _ _ (necR_refl _) (ext_refl _)).
-spec H5. { clear H5.
- exists id_fun. exists NEP. exists NEQ.
- split.
-  rewrite id_in_G. reflexivity.
-  exists b; split; auto.
-}
-destruct H5 as [H5|H5].
--
- simpl in H5.
- unfold believe_external in H5.
- change (Genv.find_funct (genv_genv psi)
-           (Vptr b Ptrofs.zero))
-   with (Genv.find_funct_ptr (genv_genv psi) b) in H5.
-  rewrite Eb in H5.
-  destruct f; try contradiction.
- destruct H5 as [[[? [? [? Hinline]]] ?] ?].
- destruct Hinline as [Hinline|Hempty].
- 2:{ exfalso; clear - a Hempty. eapply Hempty; eauto. }
- subst c.
- simpl in H4.
- injection H; clear H; intros.
- subst t.
- change (level (m_phi jm)) with (level jm) in H6.
- specialize (H5 psi ts a (level jm)).
- spec H5. constructor. reflexivity.
- specialize (H5 TT (map typ_of_type params) args).
- specialize (H5 jm (Nat.le_refl _) _ _ (necR_refl _) (ext_refl _)).
- spec H5. { clear H5.
- split. simpl.
- rewrite H4; simpl.
- clear - arg_p.
- revert args arg_p; induction params; destruct args; simpl; intros; try discriminate; try contradiction;  auto.
- destruct arg_p;  split; auto.
- rewrite proj_xtype_argtype.
- apply tc_val_has_type; auto.
- simpl fst.
- clear H3 H6.
- eapply sepcon_derives.
- apply derives_refl.
- instantiate (1:=emp); auto.
- rewrite sepcon_emp.
- auto.
-}
- destruct (level jm) eqn:?H.
- constructor; auto.
- destruct H5 as [x' [? H9]].
- clear H1 H3 m_funassert m_sat_Pa Ef Eb.
- eapply jsafeN_external.
- simpl. rewrite Hinline.
- reflexivity.
- rewrite H4. simpl.
- rewrite map_proj_xtype_argtype.
- apply H5.
- apply Hora.
- simpl.
- intros.
- rewrite H4 in *. simpl sig_res in *. simpl sig_args in *.
- assert (tc_option_val retty ret). {
-  specialize (H9 (sig_res (ef_sig e)) ret z' m').
-  spec H9. destruct H1 as [? ?];  lia.
-  change (genv_symb_injective (Genv.globalenv prog))
-   with (genv_symb_injective psi) in H3.
-  rewrite H4 in H9.
-  specialize (H9 _ _ (necR_refl _) (ext_refl _) H3).
-  specialize (H6 ts a ret).
-  destruct H9 as [? [? [? [? _]]]].
-  specialize (H6 x).
-  spec H6.  simpl. unfold natLevel. destruct H1 as [? ?].
-  change (level (m_phi ?a)) with (level a).
-  apply join_level in H7. destruct H7.
-  change (level (m_phi ?a)) with (level a) in H7.
-  lia.
-  specialize (H6 _ _ (necR_refl _) (ext_refl _)).
-  spec H6. split; auto.
-  auto.
+   destruct (cs1 !! i) eqn:?H; auto.
+   apply Maps.PTree.elements_correct in H.
+   apply Maps.PTree.elements_complete. congruence.
  }
- clear H6.
- eexists. split. reflexivity.
- apply jm_fupd_intro_strong'; intros.
- hnf in H9.
- unfold retty in H7. destruct ret; try contradiction H7.
- destruct v; try contradiction H7.
- eapply jsafeN_halted with i.
- simpl. congruence.
- apply (EXIT (Some (Vint i)) z' m'); auto.
--
-(* internal case *)
-hnf in H5.
-destruct H5 as [b' [f' [[H5 [H9 H10]] H11]]].
-symmetry in H5; inv H5.
-inversion2 Eb H9. rename f' into f.
-rename Eb into H7.
-
-specialize (H11 Delta CS _ _ (necR_refl _) (ext_refl _)).
-
-spec H11. { intro; apply tycontext_sub_refl. }
-specialize (H11 _ _ (necR_refl _) (ext_refl _) cenv_sub_refl ts a).
-red in H11.
-specialize (H11 (level jm)).
-spec H11. apply later_nat; clear; lia.
-  rewrite semax_fold_unfold in H11.
-
-specialize (H11 psi (func_tycontext' f Delta) CS _ _ (necR_refl _) (ext_refl _)
-     (conj (tycontext_sub_refl _) (conj cenv_sub_refl HGG))
-      _ _ (necR_refl _) (ext_refl _)).
-  spec H11.
-  eapply pred_nec_hereditary; try apply Prog_OK.
-  apply nec_nat; lia.
-  clear Prog_OK H3.
-  specialize (H11 Kstop (fun _ => TT) f _ _ (necR_refl _) (ext_refl _)).
-  simpl in Ef.
-  assert (Hret: fn_return f = retty) by (destruct f; inv Ef; auto).
-  spec H11. { clear H11.
-   split. hnf; intros; reflexivity.
-red. red. red. intros ek vl te ve.
-set (rhox := construct_rho (filter_genv psi) ve te).
-cbv zeta.
-cut ((!! guard_environ (func_tycontext' f Delta) f rhox &&
- (stackframe_of' cenv_cs f rhox *
-  bind_ret vl (fn_return f) (Q ts a) rhox *
-  TT) && funassert (func_tycontext' f Delta) rhox >=>
- assert_safe Espec psi f ve te (exit_cont EK_return vl Kstop) rhox)
-  (level jm)). {
-  clearbody rhox; clear.
-  evar (j: mpred).
-  replace (proj_ret_assert
-   (frame_ret_assert
-      (frame_ret_assert (function_body_ret_assert (fn_return f) (Q ts a))
-         (stackframe_of' cenv_cs f)) (fun _ : environ => TT)) ek vl rhox)
-    with j.
-  subst j.
-  apply guard_fallthrough_return; auto.
-  subst j.
-  destruct ek; simpl; normalize.
-  destruct (fn_return f); simpl; normalize;
-  f_equal; pull_left (stackframe_of' cenv_cs f rhox); auto.
-  pull_left (stackframe_of' cenv_cs f rhox); auto.
-}
-  subst rhox.
-   intros y H3 ? a' H5 Hext [[H8 H9] H11].
-   clear ek.
-   simpl exit_cont.
-   unfold proj_ret_assert, frame_ret_assert,
-   function_body_ret_assert, RA_return in H9.
-     rewrite predicates_sl.sepcon_assoc in H9.
-    rewrite predicates_sl.sepcon_comm in H9.
-   rewrite Hret in *.
-   hnf; intros.
-   destruct (can_free_list Delta TT f jm0
-                       psi ve te)
-     as [m2 ?].
-  - destruct H10 as [_ [_ [? _]]]; auto.
-  - destruct H10; auto.
-  - auto.
-  - apply H8.
-  -
-    subst a'.
-     eapply predicates_sl.sepcon_derives; try apply H9; auto.
-  -
-     set (rho' := construct_rho (filter_genv psi)
-            ve te) in *.
-     destruct H10 as [COMPLETE [_ [H17' _]]].
-  assert (H10:=I).
- assert (SFFB := stackframe_of_freeable_blocks Delta f rho' (globalenv prog) ve
-     HGG COMPLETE H17'  (eq_refl _) H8).
-  subst a'.
-  exploit (@predicates_sl.sepcon_derives rmap _ _ _ _); [ | | apply H9 |].
-   2:  apply SFFB.  apply predicates_hered.derives_refl.  clear H9.
-  pull_left (freeable_blocks (blocks_of_env (globalenv prog) ve)).
- intro H13.
-  rewrite predicates_sl.sepcon_assoc in H13.
-  destruct (free_list_juicy_mem_i _ _ _ _ H6 H13) as [jm2 [? [? ?]]].
-  destruct (age1 jm0) as [jm0' | ] eqn:?.
-  2: apply age1_level0 in Heqo; destruct vl; intros; constructor; auto.
-   destruct (age_twin' _ _ _ H12 Heqo)
-       as [jm2' [? ?]].
-   subst m2.
- assert (resource_decay (nextblock (m_dry jm0)) (m_phi jm0) (m_phi jm2') /\
-            level jm0 = S (level jm2') /\
-            ghost_of (m_phi jm2') =
-            ghost_fmap (approx (level jm2')) (approx (level jm2'))
-                  (ghost_of (m_phi jm0))). {
-   split3.
-  eapply resource_decay_trans.
-  2: eapply free_list_resource_decay; eassumption.
-  2: eapply age1_resource_decay; eassumption.
-  rewrite (mem_lemmas.nextblock_freelist _ _ _ H6).
-  apply Pos.le_refl.
-  rewrite <- H14.
-  apply age_level; auto.
-  erewrite age1_ghost_of by (eapply age_jm_phi; eauto).
-  f_equal.
-  eapply free_list_juicy_mem_ghost; eauto.
- }
- assert ((ext_compat ora0) (m_phi jm2)). {
-   pose proof (free_list_juicy_mem_ghost _ _ _ H4).
-   clear - H16 H.
-   hnf in H|-*. rewrite H16; auto.
- }
- eapply free_list_juicy_mem_lem in H4;[ | eassumption].
- apply (pred_nec_hereditary _ _ _ (laterR_necR (age_laterR (age_jm_phi H15)))) in H4.
- unfold ext_compat in H16. eapply ext_join_approx in H16. rewrite <- (age1_ghost_of _ _ (age_jm_phi H15)) in H16.
- move EXIT after H4.
- specialize (EXIT vl ora0 jm2').
- assert (tc_option_val retty vl). {
-  clear - H13.
-  rewrite predicates_sl.sepcon_comm in H13.
-  rewrite !predicates_sl.sepcon_assoc in H13.
-  destruct H13 as [? [? [? [? _]]]].
-  subst retty.  destruct vl; simpl in H0; try contradiction.
-  destruct H0 as [? _]. destruct v; try contradiction. eauto.
- }
- specialize (EXIT H17 H16).
- destruct vl; try contradiction.
- destruct v; try contradiction.
- clear H17.
- intros; eapply jsafeN_step; try instantiate (1:=jm2').
- split; auto; rewrite <- (age_jm_dry H15); econstructor; eauto.
- apply jm_fupd_intro'; eapply jsafeN_halted.
- instantiate (1:=i).
- simpl. clear; congruence.
- apply EXIT.
-}
-
-remember (alloc_juicy_variables psi empty_env jm (fn_vars f)) eqn:AJV.
-destruct p as [ve' jm']; symmetry in AJV.
-destruct (alloc_juicy_variables_e _ _ _ _ _ _ AJV) as [H15 [H20' CORE]].
-assert (MATCH := alloc_juicy_variables_match_venv _ _ _ _ _ AJV).
-assert (H20 := alloc_juicy_variables_resource_decay _ _ _ _ _ _ AJV).
-destruct (build_call_temp_env f args)
-as [te' H21]; auto.
-  { clear - H10 arg_p. subst fspec; simpl in H10.
-    destruct f; simpl in *.
-    assert (Datatypes.length (map snd fn_params) =
-                Datatypes.length params). assert (params = map snd fn_params) by apply H10. subst; trivial.
-   rewrite !map_length in H. rewrite H.
-   clear - arg_p. apply tc_vals_length; trivial.
-}
-
-(*** split here ****)
-destruct (level jm) eqn:H2'; [constructor; auto |].
 
-destruct (levelS_age1 _ _ H2') as [jm2 H13]. change (age jm jm2) in H13.
-rewrite <- H2' in *. clear H2'.
-pose proof (age_twin' _ _ _ H20' H13) as [jm'' [_ H20x]].
-destruct H10 as [COMPLETE [H17 [H17' [Hvars H18]]]].
-
-eapply jsafeN_step
-  with (c' := Clight_core.State f (f.(fn_body)) Kstop ve' te')
-       (m' := jm''); auto.
-split; auto.
-apply Clight_core.step_internal_function.
-apply list_norepet_append_inv in H17; destruct H17 as [H17 [H22 H23]]; constructor; auto.
-rewrite <- (age_jm_dry H20x); auto.
-split.
- destruct H20;  apply resource_decay_trans with (nextblock (m_dry jm')) (m_phi jm'); auto.
- apply age1_resource_decay; auto.
- split.
- rewrite H20'; apply age_level; auto.
- erewrite <- (alloc_juicy_variables_ghost _ _ _ jm), AJV; simpl.
- apply age1_ghost_of, age_jm_phi; auto.
-assert (H22: (level jm2 >= level jm'')%nat)
-  by (apply age_level in H13; apply age_level in H20x; lia).
-assert (H23: app_pred (fungassert Delta (filter_genv psi, args)) (m_phi jm'')).
-{ apply (resource_decay_fungassert _ _ (nextblock (m_dry jm)) _ (m_phi jm'')) in m_funassert.
-  2: apply laterR_necR; apply age_laterR; auto.
-  apply m_funassert.
-  rewrite CORE. apply age_core. apply age_jm_phi; auto.
-  destruct H20;  apply resource_decay_trans with (nextblock (m_dry jm')) (m_phi jm'); auto.
-  apply age1_resource_decay; auto.
-}
-  apply (pred_nec_hereditary  _ _ _ (necR_level' (laterR_necR (age_laterR H13))))
-    in H11.
-  specialize (H11 te' ve' _ H22 _ _ (necR_refl _) (ext_refl _)).
-  spec H11; [clear H11|]. {
-  split; [split |]; auto.
-  split; [ | simpl; split; [ | reflexivity]; apply MATCH ].
- -
-  rewrite (age_jm_dry H20x) in H15.
-  clear m_sat_Pa m_funassert.
-  eapply semax_call_typecheck_environ
-   with (jm := jm2); try eassumption.
- +
-  erewrite <- age_jm_dry by apply H13;  eassumption.
- + destruct H23 as [H _].
-    intros. specialize (H b0 b1 _ _ H1 H3 H4).
-    destruct H as [b2 [? ?]]; exists b2; split; auto.
- + rewrite snd_split. subst fspec; simpl in H18. destruct H18; subst. trivial.
--
- normalize.
- split; auto. unfold construct_rho.
- rewrite <- sepcon_assoc.
- apply (pred_nec_hereditary  _ _ _ (laterR_necR (age_laterR (age_jm_phi H20x)))).
- unfold bind_args.
- unfold tc_formals.
- normalize.
- simpl fst in H18; simpl snd in H18.
- split.
- +
- hnf.
- destruct H18 as [H18 [H18b H18']].
- clear m_funassert.
- destruct fspec; simpl in *.
- destruct f; inv Ef; simpl in *.
- clear - arg_p H21 H17.
- simpl in *.
- match goal with H: tc_vals _ ?A |- tc_vals _ ?B => replace B with A; auto end.
- rewrite list_norepet_app in H17. destruct H17 as [H17 [_ _]].
- clear - H17 H21.
- forget (create_undef_temps fn_temps) as te.
- revert  args te te' H21 H17.
- induction fn_params as [|[??]]; destruct args; intros; auto; try discriminate.
- inv H17.
- simpl. f_equal. unfold eval_id, construct_rho; simpl.
-  inv H21.
- erewrite pass_params_ni; try eassumption.
-  rewrite PTree.gss. reflexivity.
- eapply IHfn_params; try eassumption.
-+
- rewrite predicates_sl.sepcon_assoc.
- eapply predicates_sl.sepcon_derives.
- instantiate (1:=emp); intro; simpl; auto. apply predicates_hered.derives_refl.
- setoid_rewrite emp_sepcon.
- destruct H18 as [H18a [_ H18c]]. subst params.
- assert (list_norepet (map fst (fn_params f))).
- { apply list_norepet_app in H17. apply H17. }
- eapply sepcon_derives.
- assert (VUNDEF:= tc_vals_Vundef arg_p).
- eapply make_args_close_precondition; eauto.
- apply derives_refl.
- eapply alloc_juicy_variables_lem2; eauto.
- unfold var_sizes_ok in Hvars;
- rewrite Forall_forall in Hvars, COMPLETE |- *.
- intros.
- specialize (COMPLETE x H1).
- specialize (Hvars x H1).
- rewrite (cenv_sub_sizeof HGG); auto.
-}
-apply assert_safe_jsafe.
-apply H11.
+assert (⊢ ▷ (<absorb> P a (filter_genv psi, args) ∗ fungassert Delta (filter_genv psi, args) -∗
+  jsafeN OK_spec psi (E a) z (Clight_core.Callstate f args Kstop))) as Hsafe; last by apply bi.wand_entails, ouPred.later_soundness.
+iIntros.
+iPoseProof Prog_OK as "#Prog_OK".
+set (f0 := mkfunction Tvoid cc_default nil nil nil Sskip).
+iAssert (rguard OK_spec psi (E a) Delta f0 (frame_ret_assert (normal_ret_assert (maybe_retval (assert_of (Q a)) retty None)) True) Kstop) as "#rguard".
+{ iIntros (????) "!>".
+  rewrite proj_frame; monPred.unseal; iIntros "(% & (? & Q) & ?)".
+  destruct ek; simpl proj_ret_assert; monPred.unseal; try iDestruct "Q" as (->) "Q"; try iDestruct "Q" as "[]".
+  iIntros (??); simpl.
+  iApply jsafe_step; rewrite /jstep_ex.
+  iIntros (?) "(Hm & ?)".
+  iMod (free_stackframe _ f0  _ _ vx tx with "[$Hm]") as (??) "?"; try eassumption; try solve [constructor].
+  { destruct H as (? & Hmatch & ?); split3; auto.
+    split3; simpl; eauto.
+    * intros ??; setoid_rewrite Maps.PTree.gempty; done.
+    * intros ??. setoid_rewrite Maps.PTree.gempty. simpl in *.
+      split; first done.
+      rewrite /Map.get; intros (? & Hid).
+      specialize (Hmatch id); rewrite Hid // in Hmatch. }
+  { rewrite /stackframe_of /f0 /=.
+    by monPred.unseal. }
+  iIntros "!>"; iExists _, _; iSplit.
+  { iPureIntro; econstructor; eauto. }
+  iFrame.
+  by iApply return_stop_safe; try iPureIntro. }
+iPoseProof (semax_call_aux0 _ _ _ _ _ _ _ _ P _ _ _ _ _ _ _ True (fun _ => emp) _ _ _ _ (Maps.PTree.empty _) (Maps.PTree.empty _) with "Prog_OK") as "Himp"; try done;
+  last (iNext; iIntros "(P & fun)"; iApply ("Himp" with "[P] [fun] [] rguard")); try done.
+* split3; first split3; simpl; auto.
+  + intros ??; setoid_rewrite Maps.PTree.gempty; done.
+  + intros ??; rewrite /make_venv /Map.get.
+    setoid_rewrite Maps.PTree.gempty; split; first done.
+    intros (? & ?); done.
+  + intros ?; done.
+* by monPred.unseal.
+* intros; iIntros "?".
+  by iApply return_stop_safe; try iPureIntro.
+* iMod "P" as "$". by monPred.unseal.
+* iClear "Himp"; iIntros "!> !> (_ & P) !>".
+  iExists a, emp; iFrame.
+  iSplit; first done.
+  iSplit; first by monPred.unseal.
+  iIntros (?) "!> H".
+  iDestruct "H" as (?) "(_ & $)".
 Qed.
 
 Lemma semax_prog_rule {CS: compspecs} :
   forall V G prog m h z,
      postcondition_allows_exit tint ->
-     @semax_prog CS prog z V G ->
+     semax_prog(C := CS) prog z V G ->
      Genv.init_mem prog = Some m ->
      { b : block & { q : CC_core &
        (Genv.find_symbol (globalenv prog) (prog_main prog) = Some b) *
-       (forall jm, m_dry jm = m -> exists jm',
-                    semantics.initial_core (juicy_core_sem (cl_core_sem (globalenv prog))) h
-                       jm q jm' (Vptr b Ptrofs.zero) nil) *
-       forall n,
-         { jm |
-           m_dry jm = m /\ level jm = n /\
-           nth_error (ghost_of (m_phi jm)) 0 = Some (Some (ext_ghost z, NoneP)) /\
-           (exists z, join (m_phi jm) (wsat_rmap (m_phi jm)) (m_phi z) /\ ext_order jm z) /\
-           jsafeN (@OK_spec Espec) (globalenv prog) z q jm /\
-           no_locks (m_phi jm) /\
-           matchfunspecs (globalenv prog) G (m_phi jm) /\
-           (funassert (nofunc_tycontext V G) (empty_environ (globalenv prog))) (m_phi jm)
-     } } }%type.
-Proof.
-  intros until z. intro EXIT. intros. rename H0 into H1.
+       (exists m', semantics.initial_core (cl_core_sem (globalenv prog)) h
+                       m q m' (Vptr b Ptrofs.zero) nil) *
+       (state_interp Mem.empty z ∗ funspec_auth ∅ ∗ has_ext z ⊢ |==> state_interp m z ∗ jsafeN OK_spec (globalenv prog) ⊤ z q ∧
+           (*no_locks ∧*) matchfunspecs (globalenv prog) G (*∗ funassert (nofunc_tycontext V G) (empty_environ (globalenv prog))*))
+     } }%type.
+Proof.
+  intros until z. intro EXIT. intros ? H1.
   generalize H; intros [? [AL [HGG [[? [GC ?]] [GV ?]]]]].
   destruct (find_id (prog_main prog) G) as [fspec|] eqn:Hfind; try contradiction.
   assert (H4': exists post, In (prog_main prog, main_spec_ext' prog z post) G
@@ -1994,7 +1125,7 @@ Proof.
     apply find_id_e in Heqo. destruct H4 as [post ?]. exists post.
     subst. split; auto. inv Hfind. auto. inv Hfind.
   } clear H4. rename H4' into H4.
-  assert (H5:{ f | In (prog_main prog, f) (prog_funct prog)}).
+  assert (H5:{ f | In (prog_main prog, f) (prog_funct prog)} ).
   forget (prog_main prog) as id.
   assert (H4': In id (map fst G)). {
   destruct H4 as [? [H4 _]].
@@ -2013,68 +1144,42 @@ Proof.
      decidability on a countable set to transform it to a Type existential *)
   apply find_symbol_funct_ptr_ex_sig in EXx; auto.
   destruct EXx as [b [? ?]]; auto.
-  destruct fspec as [[ params retty] cc A P Q NEP NEQ].
-  assert (cc = cc_default /\ params = nil). {
+  destruct fspec as [[params retty] cc A E P Q].
+  assert (cc = cc_default /\ params = nil) as (-> & ->). {
     clear - H4. destruct H4 as [? [? ?]]. inv H0. auto.
   }
-  destruct H7; subst cc.
   assert (Hretty: retty = tint). {
     destruct H4 as [post [? ?]].
     inv H7. auto.
   }
   subst retty.
   assert (SPEP := semax_prog_entry_point V G prog b (prog_main prog)
-       params nil A P Q NEP NEQ h z EXIT H H5 Hfind).
-  spec SPEP. subst params; constructor.
-  set (gargs:= (filter_genv (globalenv prog), @nil val)) in *.
+       nil nil A E P Q h z EXIT H H5 Hfind).
+  spec SPEP. constructor.
+  set (gargs := (filter_genv (globalenv prog), @nil val)) in *.
   cbv beta iota zeta in SPEP.
-  destruct SPEP as [q [? ?]].
+  destruct SPEP as [q [Hinit Hsafe]].
   exists b, q.
   split; [split |]; auto.
- -
-  intros. apply H7; clear H7; auto.
-  clear - H1 H10.
-  rewrite H10.
-  split.  red.  apply neutral_inject. eapply Genv.initmem_inject; eauto.
-  erewrite Genv.init_mem_genv_next; eauto. apply Coqlib.Ple_refl.
- - clear H7.
-  intro n.
-  pose (jm := initial_jm_ext z prog m G n H1 H0 H2).
-  exists jm.
-  assert (level jm = n)
-    by (subst jm; simpl; rewrite inflate_initial_mem_level;
-          apply level_make_rmap).
-  assert (nth_error (ghost_of (m_phi jm)) 0 = Some (Some (ext_ghost z, NoneP)))
-    by (simpl; unfold inflate_initial_mem; rewrite ghost_of_make_rmap;
-          unfold initial_core_ext; rewrite ghost_of_make_rmap;  auto).
-  split3; [ | | split3; [ | | split3; [ | | split]]]; auto.
-  + apply initial_jm_wsat.
-  + destruct H4 as [post [H4 H4']].
-    unfold main_spec_ext' in H4'.
-    injection H4'; intros.  subst params A.
-    apply inj_pair2 in H11.
-    apply inj_pair2 in H12. subst P Q. clear H14.
-    apply (H9 jm nil (globals_of_genv (filter_genv (globalenv prog)))); eauto.
-    * eexists; eexists; split; [apply initial_jm_ext_eq|].
-     split.
-        split; [ simpl; trivial |].
-        split; auto.
-        apply global_initializers; auto.
-        simpl.
-        unshelve eexists; [split; auto; apply Share.nontrivial|].
-        unfold set_ghost; rewrite ghost_of_make_rmap, resource_at_make_rmap.
-        split; [apply resource_at_core_identity|].
-        unfold ext_ghost. match goal with |- join_sub ?a ?b => assert (a = b) as ->; [|apply join_sub_refl] end.
-        repeat f_equal.
-    * apply (initial_jm_ext_funassert z V prog m G n H1 H0 H2).
-+
-  apply initial_jm_ext_without_locks.
-+
-  apply initial_jm_ext_matchfunspecs.
-+
-  apply (initial_jm_ext_funassert z V prog m G n H1 H0 H2).
+  clear Hinit.
+
+  iIntros "((Hm & $) & Hf & Hz)".
+  iMod (initialize_mem' with "[$Hm $Hf]") as "($ & Hm & Hcore & Hmatch)"; [done..|].
+  iIntros "!>"; iSplit; last done.
+  destruct H4 as [post [H4 H4']].
+  unfold main_spec_ext' in H4'.
+  injection H4' as -> HP HQ.
+  apply inj_pair2 in HP as ->.
+  apply inj_pair2 in HQ as ->.
+  iApply (Hsafe (globals_of_genv (filter_genv (globalenv prog)))).
+  iCombine "Hcore Hmatch" as "Hcore"; rewrite (initial_core_funassert _ V _ _ (Map.empty _) (Map.empty _)) //; iFrame.
+  iIntros "!>".
+  iSplit; first done.
+  by iApply global_initializers.
 Qed.
 
+Local Notation match_fdecs := (match_fdecs(Σ := Σ)).
+
 Lemma match_fdecs_length funs K:
   match_fdecs funs K -> length funs = length K.
 Proof. induction 1; trivial.
@@ -2142,64 +1247,63 @@ Lemma genv_contains_app ge funs1 funs2 (G1:genv_contains ge funs1) (G2: genv_con
 genv_contains ge (funs1 ++ funs2).
 Proof. red; intros. apply in_app_or in H; destruct H; [apply G1 | apply G2]; trivial. Qed.
 
-Lemma find_id_app i fs: forall (G1 G2: funspecs) (G: find_id i (G1 ++ G2) = Some fs),
+Lemma find_id_app i fs: forall (G1 G2: funspecs(Σ := Σ)) (G: find_id i (G1 ++ G2) = Some fs),
 find_id i G1 = Some fs \/ find_id i G2 = Some fs.
 Proof. induction G1; simpl; intros. right; trivial.
 destruct a. destruct (eq_dec i i0); [ left; trivial | eauto].
 Qed.
 
-Lemma make_tycontext_s_app_inv i fs G1 G2 (G: (make_tycontext_s (G1 ++ G2)) ! i = Some fs):
-  (make_tycontext_s G1) ! i = Some fs \/ (make_tycontext_s G2) ! i = Some fs.
-Proof. rewrite ! find_id_maketycontext_s  in *. apply find_id_app; trivial. Qed.
+Lemma make_tycontext_s_app_inv i fs G1 G2 (G: make_tycontext_s (G1 ++ G2) !! i = Some fs):
+  (make_tycontext_s G1) !! i = Some fs \/ (make_tycontext_s G2) !! i = Some fs.
+Proof. rewrite -> !find_id_maketycontext_s in *. apply find_id_app; trivial. Qed.
 
-Lemma believe_app {cs} ge V H G1 G2 n
-(B1: @believe cs Espec (nofunc_tycontext V H) ge (nofunc_tycontext V G1) n)
-(B2: @believe cs Espec (nofunc_tycontext V H) ge (nofunc_tycontext V G2) n):
-@believe cs Espec (nofunc_tycontext V H) ge (nofunc_tycontext V (G1 ++ G2)) n.
+Lemma believe_app {cs} ge V H G1 G2:
+believe(CS := cs) OK_spec (nofunc_tycontext V H) ge (nofunc_tycontext V G1) ∧
+believe OK_spec (nofunc_tycontext V H) ge (nofunc_tycontext V G2) ⊢
+believe OK_spec (nofunc_tycontext V H) ge (nofunc_tycontext V (G1 ++ G2)).
 Proof.
-intros v fsig cc A P Q ? k NEC E CL.
-destruct CL as [i [HP [HQ [G B]]]].
-simpl in G. apply make_tycontext_s_app_inv in G; destruct G.
-+ eapply B1; eauto. exists i, HP, HQ; simpl; split; trivial.
-+ eapply B2; eauto. exists i, HP, HQ; simpl; split; trivial.
+iIntros "#(B1 & B2)" (??????? CL).
+destruct CL as [i [G B]].
+simpl in G. apply make_tycontext_s_app_inv in G; destruct G; [iApply "B1" | iApply "B2"]; iPureIntro; eexists; eauto.
 Qed.
 
-Lemma semax_func_app ge cs V H: forall funs1 funs2 G1 G2
-(SF1: @semax_func V H cs ge funs1 G1) (SF2: @semax_func V H cs ge funs2 G2)
+Lemma semax_func_app cs ge V H: forall funs1 funs2 G1 G2
+(SF1: semax_func(C := cs) V H ge funs1 G1) (SF2: semax_func V H ge funs2 G2)
 (L:length funs1 = length G1),
-@semax_func V H cs ge (funs1 ++ funs2) (G1++G2).
+semax_func V H ge (funs1 ++ funs2) (G1++G2).
 Proof.
 intros. destruct SF1 as [MF1 [GC1 B1]]. destruct SF2 as [MF2 [GC2 B2]].
 split; [ apply match_fdecs_app; trivial | intros; subst].
 split; [ apply genv_contains_app; trivial | intros].
-apply believe_app; [ apply B1 | apply B2]; trivial.
+rewrite -believe_app -B1 // -B2 //.
+auto.
 Qed.
 
-Lemma semax_func_subsumption ge cs V V' F F'
+Lemma semax_func_subsumption cs ge V V' F F'
   (SUB: tycontext_sub (nofunc_tycontext V F) (nofunc_tycontext V F'))
-  (HV: forall id, sub_option (make_tycontext_g V F) ! id (make_tycontext_g V' F') ! id):
-forall funs G (SF: @semax_func V F cs ge funs G),  @semax_func V' F' cs ge funs G.
+  (HV: forall id, sub_option ((make_tycontext_g V F) !! id) ((make_tycontext_g V' F') !! id)):
+forall funs G (SF: semax_func(C := cs) V F ge funs G), semax_func V' F' ge funs G.
 Proof.
-intros. destruct SF as [MF [GC B]]. split; [trivial | split; [ trivial | intros]]. specialize (B _ Gfs Gffp n).
+intros. destruct SF as [MF [GC B]]. split; [trivial | split; [ trivial | intros]]. specialize (B _ Gfs Gffp).
 assert (TS: forall f, tycontext_sub (func_tycontext' f (nofunc_tycontext V F)) (func_tycontext' f (nofunc_tycontext V' F'))).
 { clear - SUB HV.
 destruct SUB as [SUBa [SUBb [SUBc [SUBd [SUBe SUBf]]]]]; simpl in *.
 unfold func_tycontext'; split; simpl; intuition.
-destruct ((make_tycontext_t (fn_params f) (fn_temps f)) ! id); trivial. }
-eapply believe_monoL; [eassumption | apply cspecs_sub_refl | eassumption].
+destruct (_ !! _); trivial. }
+rewrite -believe_monoL //; apply cspecs_sub_refl.
 Qed.
 
-Lemma semax_func_join {cs ge V1 H1 V2 H2 V funs1 funs2 G1 G2 H}
-  (SF1: @semax_func V1 H1 cs ge funs1 G1) (SF2: @semax_func V2 H2 cs ge funs2 G2)
+Lemma semax_func_join {cs : compspecs} {ge V1 H1 V2 H2 V funs1 funs2 G1 G2 H}
+  (SF1: semax_func V1 H1 ge funs1 G1) (SF2: semax_func V2 H2 ge funs2 G2)
 
-  (K1: forall i, sub_option ((make_tycontext_g V1 H1) ! i) ((make_tycontext_g V1 H) ! i))
-  (K2: forall i, subsumespec ((make_tycontext_s H1) ! i) ((make_tycontext_s H) ! i))
-  (K3: forall i, sub_option ((make_tycontext_g V1 H) ! i) ((make_tycontext_g V H) ! i))
+  (K1: forall i, sub_option ((make_tycontext_g V1 H1) !! i) ((make_tycontext_g V1 H) !! i))
+  (K2: forall i, subsumespec ((make_tycontext_s H1) !! i) ((make_tycontext_s H) !! i))
+  (K3: forall i, sub_option ((make_tycontext_g V1 H) !! i) ((make_tycontext_g V H) !! i))
 
-  (N1: forall i, sub_option ((make_tycontext_g V2 H2) ! i) ((make_tycontext_g V2 H) ! i))
-  (N2: forall i, subsumespec ((make_tycontext_s H2) ! i) ((make_tycontext_s H) ! i))
-  (N3: forall i, sub_option ((make_tycontext_g V2 H) ! i) ((make_tycontext_g V H) ! i)):
-@semax_func V H cs ge (funs1 ++ funs2) (G1++G2).
+  (N1: forall i, sub_option ((make_tycontext_g V2 H2) !! i) ((make_tycontext_g V2 H) !! i))
+  (N2: forall i, subsumespec ((make_tycontext_s H2) !! i) ((make_tycontext_s H) !! i))
+  (N3: forall i, sub_option ((make_tycontext_g V2 H) !! i) ((make_tycontext_g V H) !! i)):
+semax_func V H ge (funs1 ++ funs2) (G1++G2).
 Proof.
 apply semax_func_app.
 + eapply semax_func_subsumption; [ | | apply SF1].
@@ -2211,15 +1315,15 @@ apply semax_func_app.
 + clear - SF1. eapply semax_func_length. apply SF1.
 Qed.
 
-Lemma semax_func_join_sameV {cs ge H1 H2 V funs1 funs2 G1 G2 H}
-  (SF1: @semax_func V H1 cs ge funs1 G1) (SF2: @semax_func V H2 cs ge funs2 G2)
+Lemma semax_func_join_sameV {cs : compspecs} {ge H1 H2 V funs1 funs2 G1 G2 H}
+  (SF1: semax_func V H1 ge funs1 G1) (SF2: semax_func V H2 ge funs2 G2)
 
-  (K1: forall i, sub_option ((make_tycontext_g V H1) ! i) ((make_tycontext_g V H) ! i))
-  (K2: forall i, subsumespec ((make_tycontext_s H1) ! i) ((make_tycontext_s H) ! i))
+  (K1: forall i, sub_option ((make_tycontext_g V H1) !! i) ((make_tycontext_g V H) !! i))
+  (K2: forall i, subsumespec ((make_tycontext_s H1) !! i) ((make_tycontext_s H) !! i))
 
-  (N1: forall i, sub_option ((make_tycontext_g V H2) ! i) ((make_tycontext_g V H) ! i))
-  (N2: forall i, subsumespec ((make_tycontext_s H2) ! i) ((make_tycontext_s H) ! i)):
-@semax_func V H cs ge (funs1 ++ funs2) (G1++G2).
+  (N1: forall i, sub_option ((make_tycontext_g V H2) !! i) ((make_tycontext_g V H) !! i))
+  (N2: forall i, subsumespec ((make_tycontext_s H2) !! i) ((make_tycontext_s H) !! i)):
+semax_func V H ge (funs1 ++ funs2) (G1++G2).
 Proof. apply (semax_func_join SF1 SF2); try eassumption; intros; apply sub_option_refl. Qed.
 
 Lemma sub_option_subsumespec x1 x2 (H:sub_option x1 x2): subsumespec x1 x2.
@@ -2228,33 +1332,33 @@ destruct x1 as [fs1 |]; destruct x2 as [fs2 |]; trivial; inv H.
 apply subsumespec_refl.
 Qed.
 
-Lemma make_tycontext_g_nilV_elim G i t: (make_tycontext_g nil G) ! i = Some t ->
+Lemma make_tycontext_g_nilV_elim G i t: (make_tycontext_g nil G) !! i = Some t ->
   exists fs, find (fun x => ident_eq i (fst x)) G = Some (i,fs) /\ t=type_of_funspec fs.
 Proof.
-induction G; simpl; intros. rewrite PTree.gempty in H. congruence.
+induction G; simpl; intros. setoid_rewrite Maps.PTree.gempty in H. congruence.
 destruct a as [j fs]; unfold ident_eq; simpl in *.
-rewrite PTree.gsspec in H. destruct (peq i j); subst; simpl; eauto.
+setoid_rewrite Maps.PTree.gsspec in H. destruct (peq i j); subst; simpl; eauto.
 inv H. exists fs; split; trivial.
 Qed.
 
-Lemma make_tycontext_s_g V H i fs (HH: (make_tycontext_s H) ! i = Some fs):
-  (make_tycontext_g V H) ! i = Some (type_of_funspec fs).
+Lemma make_tycontext_s_g V H i fs (HH: (make_tycontext_s H) !! i = Some fs):
+  (make_tycontext_g V H) !! i = Some (type_of_funspec fs).
 Proof.
-induction H; simpl in *.  rewrite PTree.gempty in HH; congruence.
-destruct a as [j gs]; simpl in *.  rewrite PTree.gsspec.
+induction H; simpl in *. setoid_rewrite Maps.PTree.gempty in HH; congruence.
+destruct a as [j gs]; simpl in *. setoid_rewrite Maps.PTree.gsspec.
 destruct (peq i j); subst.
-+ rewrite PTree.gss in HH; inv HH; trivial.
-+ rewrite PTree.gso in HH; auto.
++ setoid_rewrite Maps.PTree.gss in HH; inv HH; trivial.
++ setoid_rewrite Maps.PTree.gso in HH; auto.
 Qed.
 
 Lemma make_tycontext_g_consV_elim:
 forall i t v vs G (HV: list_norepet ((map fst (v::vs)) ++ (map fst G))),
-(make_tycontext_g (v::vs) G) ! i = Some t ->
-if peq i (fst v) then t=snd v else (make_tycontext_g vs G) ! i = Some t.
+(make_tycontext_g (v::vs) G) !! i = Some t ->
+if peq i (fst v) then t=snd v else (make_tycontext_g vs G) !! i = Some t.
 Proof.
 intros. destruct v as [j u]. induction G; simpl in *.
-+ rewrite PTree.gsspec in H. destruct (peq i j); subst; trivial. inv H; trivial.
-+ destruct a as [k s]; simpl in *.  rewrite PTree.gsspec in *.
++ setoid_rewrite Maps.PTree.gsspec in H. destruct (peq i j); subst; trivial. inv H; trivial.
++ destruct a as [k s]; simpl in *. rewrite -> Maps.PTree.gsspec in *.
 destruct (peq i k); subst.
 - inv H. destruct (peq k j); trivial; subst. clear - HV. inv HV.
 elim H1; clear. apply in_or_app.  right; left; trivial.
@@ -2267,12 +1371,12 @@ destruct H2 as [? [? ?]]. constructor.
 Qed.
 Lemma make_tycontext_g_consV_mk:
 forall i t v vs G (HV: list_norepet ((map fst (v::vs)) ++ (map fst G))),
-(if peq i (fst v) then t=snd v else (make_tycontext_g vs G) ! i = Some t) ->
-(make_tycontext_g (v::vs) G) ! i = Some t.
+(if peq i (fst v) then t=snd v else (make_tycontext_g vs G) !! i = Some t) ->
+(make_tycontext_g (v::vs) G) !! i = Some t.
 Proof.
 intros. destruct v as [j u]. simpl in *. induction G; simpl in *. rewrite app_nil_r in HV.
-+ rewrite PTree.gsspec. destruct (peq i j); subst; trivial.
-+ destruct a as [k s]; simpl in *. rewrite PTree.gsspec in *.
++ setoid_rewrite Maps.PTree.gsspec. destruct (peq i j); subst; trivial.
++ destruct a as [k s]; simpl in *. unfold lookup in *; rewrite -> Maps.PTree.gsspec in *.
 destruct (peq i k); subst.
 - destruct (peq k j); trivial; subst. clear - HV. inv HV.
 elim H1; clear. apply in_or_app.  right; left; trivial.
@@ -2284,32 +1388,32 @@ destruct H2 as [? [? ?]]. constructor.
   clear - H2. hnf; intros. apply H2; trivial.  right; trivial.
 Qed.
 
-Lemma make_tycontext_g_nilG_find_id V i: (make_tycontext_g V nil) ! i = find_id i V.
+Lemma make_tycontext_g_nilG_find_id V i: (make_tycontext_g V nil) !! i = find_id i V.
 Proof.
-induction V; simpl. apply PTree.gempty.
+induction V; simpl. apply Maps.PTree.gempty.
 destruct a as [j t]; simpl.
-rewrite PTree.gsspec. unfold eq_dec, EqDec_ident, ident_eq. destruct (peq i j); subst; simpl; eauto.
+setoid_rewrite Maps.PTree.gsspec. unfold eq_dec, EqDec_ident, ident_eq. destruct (peq i j); subst; simpl; eauto.
 Qed.
 
-Lemma make_tycontext_g_consG_elim i t V g G (HG: (make_tycontext_g V (g::G)) ! i = Some t):
-if peq i (fst g) then t=type_of_funspec (snd g) else (make_tycontext_g V G) ! i = Some t.
+Lemma make_tycontext_g_consG_elim i t V g G (HG: (make_tycontext_g V (g::G)) !! i = Some t):
+if peq i (fst g) then t=type_of_funspec (snd g) else (make_tycontext_g V G) !! i = Some t.
 Proof.
 destruct g as [j fs]; simpl in *.
-rewrite PTree.gsspec in HG. destruct (peq i j); subst; auto. inv HG; trivial.
+setoid_rewrite Maps.PTree.gsspec in HG. destruct (peq i j); subst; auto. inv HG; trivial.
 Qed.
 Lemma make_tycontext_g_consG_mk i t V g G
-  (HG: if peq i (fst g) then t=type_of_funspec (snd g) else (make_tycontext_g V G) ! i = Some t):
-(make_tycontext_g V (g::G)) ! i = Some t.
+  (HG: if peq i (fst g) then t=type_of_funspec (snd g) else (make_tycontext_g V G) !! i = Some t):
+(make_tycontext_g V (g::G)) !! i = Some t.
 Proof.
 destruct g as [j fs]; simpl in *.
-rewrite PTree.gsspec. destruct (peq i j); subst; auto.
+setoid_rewrite Maps.PTree.gsspec. destruct (peq i j); subst; auto.
 Qed.
 
 Lemma make_tycontext_g_G_None V i: forall G, find_id i G = None ->
-   (make_tycontext_g V G) ! i = find_id i V.
+   (make_tycontext_g V G) !! i = find_id i V.
 Proof. induction G; intros.
 + apply semax_prog.make_tycontext_g_nilG_find_id.
-+ simpl in H. destruct a as [j a]; simpl. rewrite PTree.gsspec.
++ simpl in H. destruct a as [j a]; simpl. setoid_rewrite Maps.PTree.gsspec.
   if_tac in H; subst. inv H. rewrite if_false; auto.
 Qed.
 
@@ -2321,7 +1425,7 @@ intros x y X Y. apply D; [ trivial | right; trivial].
 Qed.
 
 Lemma make_context_g_mk_findV_mk: forall H V (VH:list_norepet (map fst V ++ map fst H)) i t
-(Heqd : find_id i V = Some t), (make_tycontext_g V H) ! i = Some t.
+(Heqd : find_id i V = Some t), (make_tycontext_g V H) !! i = Some t.
 Proof.
 induction H; intros.
 + rewrite make_tycontext_g_nilG_find_id; trivial.
@@ -2335,7 +1439,7 @@ Qed.
 
 Lemma make_context_g_char:
 forall H V (VH:list_norepet (map fst V ++ map fst H)) i,
-(make_tycontext_g V H) ! i = match (make_tycontext_s H)!i with
+(make_tycontext_g V H) !! i = match (make_tycontext_s H)!!i with
                                None => find_id i V
                              | Some fs => Some (type_of_funspec fs)
                              end.
@@ -2344,45 +1448,45 @@ induction H; intros.
 + rewrite make_tycontext_g_nilG_find_id.
 simpl. trivial.
 + apply list_norepet_cut_middle in VH.
-remember ((make_tycontext_g V (a :: H)) ! i) as d; symmetry in Heqd; destruct d.
-- apply make_tycontext_g_consG_elim in Heqd. destruct a as [j fs]; simpl in *. rewrite PTree.gsspec.
-destruct (peq i j); subst; simpl in *; trivial. rewrite <- IHlist, Heqd; trivial.
-- destruct a as [j fs]; simpl in *; rewrite PTree.gsspec in *.
+remember ((make_tycontext_g V (a :: H)) !! i) as d; symmetry in Heqd; destruct d.
+- apply make_tycontext_g_consG_elim in Heqd. destruct a as [j fs]; simpl in *. setoid_rewrite Maps.PTree.gsspec.
+destruct (peq i j); subst; simpl in *; trivial. setoid_rewrite <- IHlist; done.
+- destruct a as [j fs]; simpl in *; unfold lookup in *; rewrite -> Maps.PTree.gsspec in *.
 destruct (peq i j); subst; simpl in *. congruence.
-rewrite <- IHlist, Heqd; trivial.
+setoid_rewrite <- IHlist; done.
 Qed.
 
 Lemma suboption_make_tycontext_s_g V G H
-  (GH: forall i : positive, sub_option (make_tycontext_s G) ! i (make_tycontext_s H) ! i)
+  (GH: forall i : positive, sub_option ((make_tycontext_s G) !! i) ((make_tycontext_s H) !! i))
   (VH: list_norepet (map fst V ++ map fst H))
   (LNR : list_norepet (map fst G)) i:
-sub_option (make_tycontext_g V G) ! i (make_tycontext_g V H) ! i.
+sub_option ((make_tycontext_g V G) !! i) ((make_tycontext_g V H) !! i).
 Proof.
-remember ((make_tycontext_g V G) ! i) as d; destruct d; simpl; trivial; symmetry in Heqd.
-rewrite make_context_g_char in *; trivial.
-- remember ((make_tycontext_s G) ! i) as q; destruct q.
+remember ((make_tycontext_g V G) !! i) as d; destruct d; simpl; trivial; symmetry in Heqd.
+rewrite -> make_context_g_char in *; trivial.
+- remember ((make_tycontext_s G) !! i) as q; destruct q.
 * specialize (GH i). rewrite <- Heqq in GH; simpl in GH. rewrite GH; trivial.
-* rewrite Heqd, find_id_maketycontext_s. apply find_id_In_map_fst in Heqd.
+* rewrite Heqd find_id_maketycontext_s. apply find_id_In_map_fst in Heqd.
   remember (find_id i H) as w; destruct w; trivial. symmetry in Heqw; apply find_id_e in Heqw.
   apply list_norepet_append_inv in VH. destruct VH as [_ [_ D]].
   elim (D i i); trivial. eapply in_map_fst in Heqw; apply Heqw.
 - clear Heqd i t. apply list_norepet_append_inv in VH. destruct VH as [LNRV [LNRH D]].
 apply list_norepet_append; trivial.
 intros x y ? ?. apply D; trivial.  specialize (GH y). clear - GH H1 LNR.
-hnf in GH. rewrite 2 find_id_maketycontext_s in GH. apply list_in_map_inv in H1.
+hnf in GH. rewrite !find_id_maketycontext_s in GH. apply list_in_map_inv in H1.
 destruct H1 as [[i fs] [? ?]]; subst.
 erewrite find_id_i in GH; [| apply H1 | trivial]. apply find_id_e in GH. apply in_map_fst in GH. apply GH.
 Qed.
 
-Lemma semax_func_join_sameV' {cs ge H1 H2 V funs1 funs2 G1 G2 H}
-  (SF1: @semax_func V H1 cs ge funs1 G1) (SF2: @semax_func V H2 cs ge funs2 G2)
+Lemma semax_func_join_sameV' {cs : compspecs} {ge H1 H2 V funs1 funs2 G1 G2 H}
+  (SF1: semax_func V H1 ge funs1 G1) (SF2: semax_func V H2 ge funs2 G2)
 
-  (K1: forall i, sub_option ((make_tycontext_s H1) ! i) ((make_tycontext_s H) ! i))
-  (K2: forall i, sub_option ((make_tycontext_s H2) ! i) ((make_tycontext_s H) ! i))
+  (K1: forall i, sub_option ((make_tycontext_s H1) !! i) ((make_tycontext_s H) !! i))
+  (K2: forall i, sub_option ((make_tycontext_s H2) !! i) ((make_tycontext_s H) !! i))
 
   (LNR: list_norepet ((map fst V)++(map fst H)))
   (LNR1: list_norepet (map fst H1)) (LNR2: list_norepet (map fst H2)):
-@semax_func V H cs ge (funs1 ++ funs2) (G1++G2).
+semax_func V H ge (funs1 ++ funs2) (G1++G2).
 Proof.
 apply (semax_func_join_sameV SF1 SF2); try eassumption.
 + apply suboption_make_tycontext_s_g; eauto.
@@ -2391,9 +1495,9 @@ apply (semax_func_join_sameV SF1 SF2); try eassumption.
 + intros; apply sub_option_subsumespec; auto.
 Qed.
 
-Lemma semax_func_firstn {cs ge H V n funs G}:
-  forall (SF: @semax_func V H cs ge funs G),
-    @semax_func V H cs ge (firstn n funs) (firstn n G).
+Lemma semax_func_firstn {cs : compspecs} {ge H V n funs G}:
+  forall (SF: semax_func V H ge funs G),
+    semax_func V H ge (firstn n funs) (firstn n G).
 Proof.
 intros. destruct SF as [SF1 [SF2 SF3]]; split; [|split].
 + clear SF2 SF3. specialize (match_fdecs_length _ _ SF1); intros.
@@ -2401,34 +1505,36 @@ generalize dependent G. generalize dependent funs. induction n; simpl; intros. c
 destruct funs; simpl in *. destruct G; simpl in *. constructor. congruence.
 destruct G; simpl in *. congruence. inv SF1. inv H0. constructor; auto.
 + clear SF1 SF3. red; intros. apply SF2. eapply In_firstn; eauto.
-+ clear SF2. intros ? ? ? k v fsig cc A P Q ? p KP EP HP.
-apply (SF3 ge' Gfs Gffp k v fsig cc A P Q _ _ KP EP); clear SF3.
-hnf; hnf in HP. destruct HP as [i [HP [HQ [GS B]]]].
-exists i, HP, HQ; split; trivial.
-clear -GS. simpl in*. rewrite find_id_maketycontext_s.
++ clear SF2. intros ? ? ?.
+iIntros (??????? HP).
+iApply SF3; [done.. | iPureIntro].
+hnf; hnf in HP. destruct HP as [i [GS B]].
+exists i; split; trivial.
+clear -GS. simpl in *. rewrite find_id_maketycontext_s.
 rewrite find_id_maketycontext_s in GS. apply find_id_firstn in GS; trivial.
 Qed.
 
-Lemma semax_func_skipn {cs ge H V funs G} (HV:list_norepet (map fst funs)) (SF: @semax_func V H cs ge funs G):
-forall n ,
-@semax_func V H cs ge (skipn n funs) (skipn n G).
+Lemma semax_func_skipn {cs : compspecs} {ge H V funs G} (HV:list_norepet (map fst funs)) (SF: semax_func V H ge funs G):
+forall n,
+semax_func V H ge (skipn n funs) (skipn n G).
 Proof.
 intros. destruct SF as [SF1 [SF2 SF3]]; split; [|split].
 + clear SF2 SF3. specialize (match_fdecs_length _ _ SF1); intros.
 generalize dependent G. generalize dependent funs. induction n; simpl; intros; trivial.
 destruct funs; simpl in *. inv SF1; constructor. destruct G; simpl in *; inv SF1. inv H0. inv HV. auto.
 + clear SF1 SF3. red; intros. apply SF2. eapply In_skipn; eauto.
-+ clear SF2. intros ? ? ? k v fsig cc A P Q ? p KP EP HP.
-apply (SF3 ge' Gfs Gffp k v fsig cc A P Q _ _ KP EP); clear SF3.
++ clear SF2. intros ? ? ?.
+iIntros (??????? HP).
+iApply SF3; [done.. | iPureIntro].
 eapply match_fdecs_norepet in HV; [|eassumption ].
-hnf; hnf in HP. destruct HP as [i [HP [HQ [GS B]]]].
-exists i, HP, HQ; split; trivial.
+hnf; hnf in HP. destruct HP as [i [GS B]].
+exists i; split; trivial.
 clear - GS HV. simpl in *. rewrite find_id_maketycontext_s.
 rewrite find_id_maketycontext_s in GS. apply find_id_skipn in GS; trivial.
 Qed.
 
 Lemma semax_func_cenv_sub' {CS CS'} (CSUB: cenv_sub (@cenv_cs CS) (@cenv_cs CS')) V H ge funs G:
-@semax_func V H CS ge funs G -> @semax_func V H CS' ge funs G.
+semax_func V H (C := CS) ge funs G -> semax_func V H (C := CS') ge funs G.
 Proof. eapply (@semax_func_cenv_sub _ _ CSUB); intros ?; apply sub_option_refl. Qed.
 
 Lemma semax_body_subsumption cs V V' F F' f spec
@@ -2439,66 +1545,64 @@ Proof.
   destruct spec. destruct f0.
   destruct SF as [? [HH SF]]; split3; auto. clear H.
   intros.
-  intros n.
-  eapply semax_mono. apply TS. apply (SF Espec0 ts x n).
+  rewrite /semax -semax_mono //.
+  apply (SF _ x).
 Qed.
 
-Lemma semax_external_binaryintersection {ef A1 P1 Q1 P1ne Q1ne A2 P2 Q2 P2ne Q2ne
-      A P Q P_ne Q_ne sig cc n}
-  (EXT1: semax_external Espec ef A1 P1 Q1 n)
-  (EXT2: semax_external Espec ef A2 P2 Q2 n)
-  (BI: binary_intersection (mk_funspec sig cc A1 P1 Q1 P1ne Q1ne)
-                      (mk_funspec sig cc A2 P2 Q2 P2ne Q2ne) =
-       Some (mk_funspec sig cc A P Q P_ne Q_ne))
+Lemma semax_external_binaryintersection {ef A1 E1 P1 Q1 A2 E2 P2 Q2
+      A E P Q sig cc}
+  (EXT1: ⊢ semax_external OK_spec ef A1 E1 P1 Q1)
+  (EXT2: ⊢ semax_external OK_spec ef A2 E2 P2 Q2)
+  (BI: binary_intersection (mk_funspec sig cc A1 E1 P1 Q1)
+                      (mk_funspec sig cc A2 E2 P2 Q2) =
+       Some (mk_funspec sig cc A E P Q))
   (LENef: length (fst sig) = length (sig_args (ef_sig ef))):
-  semax_external Espec ef A P Q n.
+  ⊢ semax_external OK_spec ef A E P Q.
 Proof.
-  intros ge ts x.
+  iIntros (ge x).
   simpl in BI.
-  rewrite ! if_true in BI by trivial.
-  inv BI. apply inj_pair2 in H1; subst P. apply inj_pair2 in H2; subst Q.
-  destruct x as [bb BB]; destruct bb.
-  * apply (EXT1 ge ts BB).
-  * intros m NM FRM typs vals r MR ? rr R Hext [TYS H].
-    apply (EXT2 ge ts BB m NM FRM typs vals r MR _ _ R Hext). split; trivial.
+  rewrite !if_true // in BI.
+  apply Some_inj, mk_funspec_inj in BI as (? & ? & ? & ? & ? & ?); subst.
+  destruct x as [[|] ?]; [iApply EXT1 | iApply EXT2].
 Qed.
 
-Lemma semax_body_binaryintersection {V G cs} f sp1 sp2 phi
+Lemma semax_body_binaryintersection {cs V G} f sp1 sp2 phi
   (SB1: @semax_body V G cs f sp1) (SB2: @semax_body V G cs f sp2)
   (BI: binary_intersection (snd sp1) (snd sp2) = Some phi):
   @semax_body V G cs f (fst sp1, phi).
 Proof.
-  destruct sp1 as [i phi1]. destruct phi1 as [[tys1 rt1] cc1 A1 P1 Q1 P1_ne Q1_ne].
-  destruct sp2 as [i2 phi2]. destruct phi2 as [[tys2 rt2] cc2 A2 P2 Q2 P2_ne Q2_ne].
-  destruct phi as [[tys rt] cc A P Q P_ne Q_ne]. simpl in BI.
-  if_tac in BI; [ inv H | discriminate]. if_tac in BI; [inv BI | discriminate].
-  apply Classical_Prop.EqdepTheory.inj_pair2 in H6.
-  apply Classical_Prop.EqdepTheory.inj_pair2 in H5. subst. simpl fst; clear - SB1 SB2.
+  destruct sp1 as [i phi1]. destruct phi1 as [[tys1 rt1] cc1 E1 A1 P1 Q1].
+  destruct sp2 as [i2 phi2]. destruct phi2 as [[tys2 rt2] cc2 E2 A2 P2 Q2].
+  destruct phi as [[tys rt] cc E A P Q]. simpl in BI.
+  if_tac in BI; [inv H | discriminate]. if_tac in BI; [| discriminate].
+  apply Some_inj, mk_funspec_inj in BI as ([=] & ? & ? & ? & ? & ?); subst.
+  clear - SB1 SB2.
   destruct SB1 as [X [X1 SB1]]; destruct SB2 as [_ [X2 SB2]].
   split3; [ apply X | trivial | simpl in X; intros ].
-  destruct x as [b Hb]; destruct b; [ apply SB1 | apply SB2].
+  destruct x as [[|] ?]; [ apply SB1 | apply SB2].
 Qed.
 
 Lemma semax_body_generalintersection {V G cs f iden I sig cc} {phi : I -> funspec}
         (H1: forall i : I, typesig_of_funspec (phi i) = sig)
-        (H2: forall i : I, callingconvention_of_funspec (phi i) = cc) (HI: inhabited I)
-  (H: forall i, semax_body V G f (iden, phi i)):
-  @semax_body V G cs f (iden, @general_intersection I sig cc phi H1 H2).
+        (H2: forall i : I, callingconvention_of_funspec (phi i) = cc)
+        (HI: inhabited I)
+  (H: forall i, @semax_body V G cs f (iden, phi i)):
+  @semax_body V G cs f (iden, general_intersection phi H1 H2).
 Proof. destruct HI. split3.
   { specialize (H X). specialize (H1 X); subst. destruct (phi X). simpl. apply H. }
   { specialize (H X). specialize (H1 X); subst. destruct (phi X). simpl. apply H. }
   intros. destruct x as [i Hi].
   specialize (H i).
-  assert (HH: fst sig = map snd (fst (fn_funsig f)) /\
+  assert (fst sig = map snd (fst (fn_funsig f)) /\
         snd sig = snd (fn_funsig f) /\
-        (forall (Espec : OracleKind) (ts : list Type) (x : dependent_type_functor_rec ts ((WithType_of_funspec (phi i))) mpred),
-         semax Espec (func_tycontext f V G nil)
-           (fun rho : environ => close_precondition (map fst (fn_params f)) ((Pre_of_funspec (phi i)) ts x) rho * stackframe_of f rho) 
-           (fn_body f) (frame_ret_assert (function_body_ret_assert (fn_return f) ((Post_of_funspec (phi i)) ts x)) (stackframe_of f)))).
+        (forall OK_spec (x : dtfr ((WithType_of_funspec (phi i)))),
+         semax OK_spec (mask_of_funspec (phi i) x) (func_tycontext f V G nil)
+           (close_precondition (map fst (fn_params f)) (argsassert_of ((Pre_of_funspec (phi i)) x)) ∗ stackframe_of f) 
+           (fn_body f) (frame_ret_assert (function_body_ret_assert (fn_return f) (assert_of ((Post_of_funspec (phi i)) x))) (stackframe_of f)))) as HH.
   { intros. specialize (H1 i); specialize (H2 i). subst. unfold semax_body in H.
     destruct (phi i); subst. destruct H as [? [? ?]]. split3; auto. }
   clear H H1 H2. destruct HH as [HH1 [HH2 HH3]].
-  apply (HH3 Espec0 ts Hi).
+  apply (HH3 _ Hi).
 Qed.
 
 Lemma typecheck_temp_environ_eval_id {f lia}
@@ -2523,36 +1627,36 @@ Lemma typecheck_environ_eval_id {f V G lia} (LNR: list_norepet (map fst (fn_para
 Proof. apply typecheck_temp_environ_eval_id; trivial. apply TC. Qed.
 
 Lemma map_Some_inv {A}: forall {l l':list A}, map Some l = map Some l' -> l=l'.
-Proof. induction l; simpl; intros; destruct l'; inv H; trivial. f_equal; auto. Qed.
+Proof. induction l; simpl; intros; destruct l'; inv H; trivial. Qed.
 
-Lemma semax_body_funspec_sub {V G cs f i phi phi'} (SB: @semax_body V G cs f (i, phi))
+Lemma semax_body_funspec_sub {cs V G f i phi phi'} (SB: @semax_body V G cs f (i, phi))
   (Sub: funspec_sub phi phi')
   (LNR: list_norepet (map fst (fn_params f) ++ map fst (fn_temps f))):
   @semax_body V G cs f (i, phi').
 Proof.
- destruct phi as [sig cc A P Q Pne Qne].
- destruct phi' as [sig' cc' A' P' Q' Pne' Qne'].
- destruct Sub as [[Tsigs CC] Sub]. subst cc'. simpl in Sub.
+ destruct phi as [sig cc A E P Q].
+ destruct phi' as [sig' cc' A' E' P' Q'].
+ destruct Sub as [(Tsigs & CC) Sub]. subst cc'. simpl in Sub.
  destruct SB as [SB1 [SB2 SB3]].
  subst sig'.
  split3; trivial. intros.
- specialize (Sub ts x).
+ specialize (Sub x).
  eapply @semax_adapt
  with
-  (Q':= frame_ret_assert (function_body_ret_assert (fn_return f) (Q' ts x))
+  (Q':= frame_ret_assert (function_body_ret_assert (fn_return f) (assert_of (Q' x)))
            (stackframe_of f))
-  (P' := fun tau =>
-    EX vals:list val,
-    EX ts1:list Type, EX x1 : dependent_type_functor_rec ts1 A mpred,
-    EX FR: mpred,
-    !!(forall rho' : environ,
-              !! tc_environ (xtype_tycontext (snd sig)) rho' && (FR * Q ts1 x1 rho') |-- (Q' ts x rho')) &&
-      (stackframe_of f tau * FR * P ts1 x1 (ge_of tau, vals) &&
-            !! (map (Map.get (te_of tau)) (map fst (fn_params f)) = map Some vals /\ tc_vals (map snd (fn_params f)) vals))).
- - intros rho m [TC [OM [m1 [m2 [JM [[vals [[MAP VUNDEF] HP']] M2]]]]]].
-   do 4 (split; [|simpl; intros; try apply fupd.fupd_intro; auto]).
-   specialize (Sub (ge_of rho, vals) m1). spec Sub. {
-     split; trivial.
+  (P' :=
+    ∃ vals:list val,
+    ∃ x1 : dtfr A,
+    ∃ FR: mpred,
+    ⌜E x1 ⊆ E' x /\ forall rho' : environ,
+              ⌜tc_environ (xtype_tycontext (snd sig)) rho'⌝ ∧ (FR ∗ Q x1 rho') ⊢ (Q' x rho')⌝ ∧
+      ((stackframe_of f ∗ ⎡FR⎤ ∗ assert_of (fun tau => P x1 (ge_of tau, vals))) ∧
+            local (fun tau => map (Map.get (te_of tau)) (map fst (fn_params f)) = map Some vals /\ tc_vals (map snd (fn_params f)) vals))).
+ - split => rho. monPred.unseal; rewrite /bind_ret monPred_at_affinely.
+   iIntros "(%TC & #OM & (%vals & (%MAP & %VUNDEF) & HP') & M2)".
+   specialize (Sub (ge_of rho, vals)). iMod (Sub with "[$HP']") as "Sub". {
+     iPureIntro; split; trivial.
      simpl.
      rewrite SB1. simpl in TC. destruct TC as [TC1 [TC2 TC3]].
      unfold fn_funsig. simpl. clear - TC1 MAP LNR VUNDEF.
@@ -2567,138 +1671,121 @@ Proof.
          apply tc_val_has_type; apply Tw; trivial.
        * apply IHparams; simpl; trivial.
          intros. apply TE. right; trivial. }
-   eapply fupd.fupd_mono.
-   2: { eapply fupd.fupd_frame_r. exists m1, m2. split3;[apply JM|apply Sub|apply M2]. }
-   clear Sub. repeat intro.
-   destruct H as [a1 [a2 [JA [[ts1 [x1 [FR1 [A1 RetQ]]]] A2]]]].
-   exists vals, ts1, x1, FR1.
-    split3.
-    + simpl; intros. eapply derives_trans. 2: apply RetQ.
-      (*similar proof as in seplog*)
-      intros ? [? ?]. split; trivial. simpl.
+   iIntros "!>"; iSplit; last iPureIntro.
+   clear Sub.
+   iDestruct "Sub" as (x1 FR1 HE1) "(A1 & %RetQ)".
+   iExists vals, x1, FR1.
+   iSplit; last iSplit.
+    + iPureIntro; split; auto; intros. rewrite -RetQ.
+      iIntros "(% & $)"; iPureIntro; split; last trivial.
       simpl in H. clear - H. destruct H as [_ [Hve _]].
       simpl in *. red in Hve. destruct rho'; simpl in *.
       apply Map.ext; intros x. specialize (Hve x).
       destruct (Map.get ve x); simpl.
       * destruct p; simpl in *. destruct (Hve t) as [_ H]; clear Hve.
-        exploit H. exists b; trivial. rewrite PTree.gempty. congruence.
+        exploit H. exists b; trivial. rewrite Maps.PTree.gempty //.
       * reflexivity.
-    + apply join_comm in JA. rewrite sepcon_assoc.
-      exists a2, a1; split3; trivial.
-    + split; trivial. destruct TC as [TC1 _]. simpl in TC1. red in TC1.
+    + iFrame.
+    + iPureIntro; split; trivial. destruct TC as [TC1 _]. simpl in TC1. red in TC1.
       clear - MAP VUNDEF TC1 LNR. forget (fn_params f) as params. forget (fn_temps f) as temps. forget (te_of rho) as tau.
       clear f rho. generalize dependent vals. induction params; simpl; intros; destruct vals; inv MAP; trivial.
       inv VUNDEF. inv LNR. destruct a; simpl in *.
-      assert (X: forall id ty, (make_tycontext_t params temps) ! id = Some ty ->
+      assert (X: forall id ty, (make_tycontext_t params temps) !! id = Some ty ->
                  exists v : val, Map.get tau id = Some v /\ tc_val' ty v).
-      { intros. apply TC1. simpl.  rewrite PTree.gso; trivial.
+      { intros. apply TC1. simpl. setoid_rewrite Maps.PTree.gso; trivial.
         apply make_context_t_get in H. intros ?; subst id. contradiction. }
       split; [ clear IHparams | apply (IHparams H6 X _ H1 H4)].
-      destruct (TC1 i t) as [u [U TU]]; clear TC1. rewrite PTree.gss; trivial.
+      destruct (TC1 i t) as [u [U TU]]; clear TC1. setoid_rewrite Maps.PTree.gss; trivial.
       rewrite U in H0; inv H0. apply TU; trivial.
- - clear Sub.
-   apply extract_exists_pre; intros vals.
-   apply extract_exists_pre; intros ts1.
+    + split3; last split; intros; split => ?; monPred.unseal; auto.
+ - apply extract_exists_pre; intros vals.
    apply extract_exists_pre; intros x1.
    apply extract_exists_pre; intros FRM.
-   apply semax_extract_prop; intros QPOST.
-   unfold fn_funsig in *. simpl in SB2; rewrite SB2 in *.
-   apply (semax_frame (func_tycontext f V G nil)
-      (fun rho : environ =>
-         close_precondition (map fst (fn_params f)) (P ts1 x1) rho *
-         stackframe_of f rho)
+   apply semax_extract_prop; intros (HE & QPOST).
+   unfold fn_funsig in *. simpl in SB2; rewrite -> SB2 in *.
+   apply (semax_frame(OK_spec := OK_spec0) (E x1) (func_tycontext f V G nil)
+      (close_precondition (map fst (fn_params f)) (argsassert_of (P x1)) ∗
+         stackframe_of f)
       (fn_body f)
-      (frame_ret_assert (function_body_ret_assert (fn_return f) (Q ts1 x1)) (stackframe_of f))
-      (fun rho => FRM)) in SB3.
+      (frame_ret_assert (function_body_ret_assert (fn_return f) (assert_of (Q x1))) (stackframe_of f))
+      ⎡FRM⎤) in SB3.
     + eapply semax_pre_post_fupd.
-      6: apply SB3.
-      all: clear SB3; intros; simpl; try solve [normalize].
-      * eapply derives_trans, fupd.fupd_intro.
-        intros m [TC [[n1 [n2 [JN [N1 N2]]]] [VALS TCVals]]].
-        unfold close_precondition. apply join_comm in JN. rewrite sepcon_assoc.
-        exists n2, n1; split3; trivial.
-        exists vals. simpl in *. split; trivial. split; trivial.
+      6: rewrite /semax -semax_mask_mono //; apply SB3.
+      all: clear SB3; intros; simpl; try iIntros "(_ & ([] & ?) & _)".
+      * split => rho; monPred.unseal; iIntros "(%TC & (N1 & (? & N2)) & (%VALS & %TCVals)) !>"; iFrame.
+        iPureIntro; repeat (split; trivial).
         apply (tc_vals_Vundef TCVals).
-      * destruct (fn_return f);
-          try solve [apply prop_andp_left; intro; rewrite !predicates_sl.FF_sepcon;
-                     eapply derives_trans; [| now apply fupd.fupd_intro]; auto].
-        rewrite sepcon_comm, <- sepcon_assoc, <- sepcon_andp_prop1.
-        eapply derives_trans, fupd.fupd_frame_r.
-        apply sepcon_derives; auto.
-        eapply derives_trans, fupd.fupd_intro.
-        eapply derives_trans, QPOST.
-        apply andp_right; trivial.
-        -- intros k K; clear; apply tc_environ_xtype.
-        -- apply prop_andp_left; intros; auto.
-      * apply andp_left2. rewrite sepcon_comm, <- sepcon_assoc.
-        apply sepcon_derives; auto.
-        destruct vl; simpl; normalize.
-        -- eapply derives_trans; [ | apply QPOST]; apply andp_right; trivial.
-           intros k K; clear. apply tc_environ_xtype_env_set.
-        -- destruct (fn_return f).
-           { eapply derives_trans; [ | apply QPOST]; apply andp_right; trivial.
-           intros k K; clear; apply tc_environ_xtype. }
-           all: rewrite semax_lemmas.sepcon_FF; apply derives_refl.
-    + do 2 red; intros; trivial.
-Qed.
-
-Lemma make_tycontext_s_distinct : forall a l (Ha : In a l) (Hdistinct : NoDup (map fst l)),
-  (make_tycontext_s l) ! (fst a) = Some (snd a).
+      * split => rho; rewrite /bind_ret; monPred.unseal; destruct (fn_return f); try iIntros "(_ & ([] & _) & _)".
+        rewrite /= -QPOST; iIntros "(? & (? & ?) & ?)"; iFrame.
+        iPureIntro; split; last done.
+        apply tc_environ_xtype.
+      * split => rho; rewrite /bind_ret; monPred.unseal; iIntros "(% & (Q & $) & ?)".
+        destruct vl; simpl.
+        -- rewrite -QPOST.
+           iDestruct "Q" as "($ & $)"; iFrame; iPureIntro; split; last done.
+           apply tc_environ_xtype_env_set.
+        -- destruct (fn_return f); try iDestruct "Q" as "[]".
+           rewrite /= -QPOST; iFrame; iPureIntro; split; last done.
+           apply tc_environ_xtype.
+    + do 2 red; intros; monPred.unseal; trivial.
+Qed.
+
+Lemma make_tycontext_s_distinct : forall a l (Ha : In a l) (Hdistinct : List.NoDup (map fst l)),
+  (make_tycontext_s l) !! (fst a) = Some (snd a).
 Proof.
   intros a l. unfold make_tycontext_s.
   induction l; simpl; intros.
   contradiction.
   inv Hdistinct. destruct a0. simpl in *.
   destruct Ha. subst.
-  simpl. rewrite PTree.gss. auto.
-  rewrite PTree.gso.
+  simpl. rewrite Maps.PTree.gss. auto.
+  rewrite Maps.PTree.gso.
   apply IHl; auto.
   intro; subst.
   apply H1; apply in_map. auto.
 Qed.
 
-(* Maybe the following two lemmas should be put in PTree. *)
+(* Maybe the following two lemmas should be put in Maps.PTree. *)
 
-Lemma lookup_distinct : forall {A B} (f : A -> B) a l t (Ha : In a l) (Hdistinct : NoDup (map fst l)),
-  (fold_right (fun v : ident * A => PTree.set (fst v) (f (snd v))) t l) ! (fst a) =
+Lemma lookup_distinct : forall {A B} (f : A -> B) a l t (Ha : In a l) (Hdistinct : List.NoDup (map fst l)),
+  (fold_right (fun v : ident * A => Maps.PTree.set (fst v) (f (snd v))) t l) !! (fst a) =
   Some (f (snd a)).
 Proof.
   induction l; simpl; intros; [contradiction|].
   inv Hdistinct.
-  rewrite PTree.gsspec.
-  destruct (peq (fst a) (fst a0)) eqn: Heq; setoid_rewrite Heq.
+  rewrite Maps.PTree.gsspec.
+  if_tac.
   - destruct Ha; [subst; auto|].
     contradiction H1; rewrite in_map_iff; eauto.
   - apply IHl; auto.
-    destruct Ha; auto; subst.
-    contradiction n; auto.
+    destruct Ha; auto; subst; contradiction.
 Qed.
 
 Lemma lookup_out : forall {A B} (f : A -> B) a l t (Ha : ~In a (map fst l)),
-  (fold_right (fun v : ident * A => PTree.set (fst v) (f (snd v))) t l) ! a = t ! a.
+  (fold_right (fun v : ident * A => Maps.PTree.set (fst v) (f (snd v))) t l) !! a = t !! a.
 Proof.
   induction l; simpl; intros; auto.
-  rewrite PTree.gsspec.
-  destruct (peq a (fst a0)) eqn: Heq; setoid_rewrite Heq.
+  rewrite Maps.PTree.gsspec.
+  if_tac.
   - contradiction Ha; auto.
   - apply IHl.
     intro; contradiction Ha; auto.
 Qed.
 
 Lemma func_tycontext_sub : forall f V G A V2 G2 (HV : incl V V2) (HG : incl G G2)
-  (Hdistinct : NoDup (map fst V2 ++ map fst G2)),
+  (Hdistinct : List.NoDup (map fst V2 ++ map fst G2)),
   tycontext_sub (func_tycontext f V G A) (func_tycontext f V2 G2 A).
 Proof.
   intros.
   unfold func_tycontext, make_tycontext, tycontext_sub; simpl.
   apply sublist.NoDup_app in Hdistinct; destruct Hdistinct as (? & ? & Hdistinct); auto.
   repeat split; auto; intro.
-  - destruct (PTree.get _ _); auto.
+  - destruct (_ !! _); auto.
   - unfold make_tycontext_g.
     generalize dependent G2; generalize dependent V2; revert V; induction G; simpl.
     + induction V; simpl; intros. auto.
         rewrite sublist.incl_cons_iff in HV; destruct HV.
-        rewrite PTree.gsspec.
+        setoid_rewrite Maps.PTree.gsspec.
         destruct (peq id (fst a)); eauto; subst; simpl.
         rewrite lookup_out.
         apply (lookup_distinct (@id type)); auto.
@@ -2706,15 +1793,15 @@ Proof.
           rewrite in_map_iff; eexists; split; eauto. }
     + intros.
       rewrite sublist.incl_cons_iff in HG; destruct HG.
-      rewrite PTree.gsspec.
-      destruct (peq id (fst a)); eauto; subst; simpl.
+      setoid_rewrite Maps.PTree.gsspec.
+      if_tac; eauto; subst; simpl.
       apply lookup_distinct; auto.
   - unfold make_tycontext_s.
     generalize dependent G2; induction G; simpl; intros.
     + auto.
     + destruct a; simpl. hnf.
       rewrite sublist.incl_cons_iff in HG; destruct HG.
-      rewrite PTree.gsspec.
+      rewrite Maps.PTree.gsspec.
       fold make_tycontext_s in *.
       destruct (peq id i); eauto; subst; simpl.
       * exists f0; split; [ | apply funspec_sub_si_refl].
@@ -2726,7 +1813,7 @@ Qed.
 (* This lets us use a library as a client. *)
 (* We could also consider an alpha-renaming axiom, although this may be unnecessary. *)
 Lemma semax_body_mono : forall V G {cs : compspecs} f s V2 G2
-  (HV : incl V V2) (HG : incl G G2) (Hdistinct : NoDup (map fst V2 ++ map fst G2)),
+  (HV : incl V V2) (HG : incl G G2) (Hdistinct : List.NoDup (map fst V2 ++ map fst G2)),
   semax_body V G f s -> semax_body V2 G2 f s.
 Proof.
   unfold semax_body; intros.
@@ -2770,3 +1857,5 @@ Definition hide_auxiliary_functions {cs} V K funs G :=
    exists funs' G', match_fdecs_sub funs G funs' G' /\
                     @semax_func V K cs funs' G'.
 *)
+
+End mpred.
diff --git a/veric/semax_straight.v b/veric/semax_straight.v
index 867b5e6fc7..bfd1206193 100644
--- a/veric/semax_straight.v
+++ b/veric/semax_straight.v
@@ -1,10 +1,12 @@
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.juicy_base.
-Require Import VST.msl.normalize.
-Require Import VST.veric.juicy_mem VST.veric.juicy_mem_lemmas VST.veric.juicy_mem_ops.
+Require Import VST.veric.juicy_mem VST.veric.juicy_mem_lemmas.
 Require Import VST.veric.res_predicates.
+Require Import VST.veric.external_state.
 Require Import VST.veric.extend_tc.
 Require Import VST.veric.Clight_seplog.
 Require Import VST.veric.Clight_assert_lemmas.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.Clight_core.
 Require Import VST.sepcomp.extspec.
 Require Import VST.sepcomp.step_lemmas.
@@ -15,83 +17,61 @@ Require Import VST.veric.expr_lemmas.
 Require Import VST.veric.expr_lemmas4.
 Require Import VST.veric.semax.
 Require Import VST.veric.semax_lemmas.
+Require Import VST.veric.mapsto_memory_block.
 Require Import VST.veric.semax_conseq.
 Require Import VST.veric.Clight_lemmas.
 Require Import VST.veric.binop_lemmas.
+Require Import VST.veric.binop_lemmas2.
 Require Import VST.veric.binop_lemmas4.
-Local Open Scope pred.
+Require Import VST.veric.valid_pointer.
 Import LiftNotation.
-Import compcert.lib.Maps.
 
 Transparent intsize_eq.
 
 Section extensions.
-  Context {CS: compspecs} {Espec: OracleKind}.
+  Context `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty} {CS: compspecs}.
 
 Lemma semax_straight_simple:
- forall Delta (B: assert) P c Q,
-  (forall rho, boxy extendM (B rho)) ->
-  (forall jm jm1 Delta' ge ve te rho k F f,
+ forall E Delta (B P: assert) c (Q: assert)
+  (EB : Absorbing B)
+  (Hc : forall m Delta' ge ve te rho k F f,
               tycontext_sub Delta Delta' ->
-              app_pred (B rho) (m_phi jm) ->
               guard_environ Delta' f rho ->
               closed_wrt_modvars c F ->
               rho = construct_rho (filter_genv ge) ve te  ->
-              age jm jm1 ->
-              ((F rho * |>P rho) && funassert Delta' rho) (m_phi jm) ->
               cenv_sub cenv_cs (genv_cenv ge) ->
-              exists jm', exists te', exists rho',
-                rho' = mkEnviron (ge_of rho) (ve_of rho) (make_tenv te') /\
-                level jm = S (level jm') /\
-                guard_environ Delta' f rho'  /\
-                jstep (cl_core_sem ge) (State f c k ve te) jm
-                                 (State f Sskip k ve te') jm' /\
-              ((F rho' * Q rho') && funassert Delta' rho) (m_phi jm')) ->
-  semax Espec Delta (fun rho => B rho && |> P rho) c (normal_ret_assert Q).
+              mem_auth m ∗ (B rho ∧ (F rho ∗ ▷P rho)) ⊢
+                ◇ ∃m' te' rho', ⌜rho' = mkEnviron (ge_of rho) (ve_of rho) (make_tenv te') ∧
+                  guard_environ Delta' f rho' ∧ cl_step ge (State f c k ve te) m
+                                 (State f Sskip k ve te') m'⌝ ∧
+               |={E}=> (mem_auth m' ∗ ▷ (F rho' ∗ Q rho'))),
+  semax OK_spec E Delta (B ∧ ▷ P) c (normal_ret_assert Q).
 Proof.
 intros until Q; intros EB Hc.
 rewrite semax_unfold.
-intros psi Delta' CS' n TS [CSUB HGG'] _ k F f Hcl Hsafe te ve w Hx ? w0 H Hext Hglob.
+intros psi Delta' CS' TS [CSUB HGG'].
+iIntros "#believe" (????) "[(% & %) #Hsafe]".
+iIntros (te ve) "!> (% & P & fun)".
 specialize (cenv_sub_trans CSUB HGG'); intros HGG.
-apply nec_nat in Hx.
-apply (pred_nec_hereditary _ _ _ Hx) in Hsafe.
-clear n Hx.
-apply (pred_nec_hereditary _ _ _ (necR_nat H)) in Hsafe.
-clear H w.
-rename w0 into w.
-apply assert_safe_last'; intro Hage.
-intros ora jm Hora _ H2. subst w.
-destruct Hglob as [[TC' Hglob] Hglob'].
-apply can_age_jm in Hage; destruct Hage as [jm1 Hage].
-apply extend_sepcon_andp in Hglob; auto.
-destruct Hglob as [TC2 Hglob].
-specialize (Hc jm jm1 Delta' psi ve te _ k F f TS TC2 TC' Hcl (eq_refl _) Hage).
-specialize (Hc (conj Hglob Hglob') HGG); clear Hglob Hglob'.
-destruct Hc as [jm' [te' [rho' [H9 [H2 [TC'' [H3 H4]]]]]]].
-change (@level rmap _  (m_phi jm) = S (level (m_phi jm'))) in H2.
-apply rmap_order in Hext as (Hl & Hr & _); rewrite Hl in *.
-rewrite H2 in Hsafe.
-rewrite <- level_juice_level_phi, (age_level _ _ Hage).
-intros; apply jm_fupd_intro'.
-econstructor; [eassumption | ].
-unfold rguard in Hsafe.
-specialize (Hsafe EK_normal None te' ve).
-simpl exit_cont in Hsafe.
-specialize (Hsafe (m_phi jm')).
-spec Hsafe.
-change R.rmap with rmap; lia.
-specialize (Hsafe _ _ (necR_refl _) (ext_refl _)).
-destruct H4.
-spec Hsafe; [clear Hsafe| ].
-split; auto.
-simpl proj_ret_assert.
-rewrite (prop_true_andp (None=None)) by auto.
-split; auto.
-subst rho'; auto.
-rewrite sepcon_comm; subst rho'; auto.
-subst rho'.
-simpl exit_cont in Hsafe.
-apply assert_safe_jsafe'; auto.
+iIntros (ora _).
+monPred.unseal.
+iApply jsafe_step.
+rewrite /jstep_ex.
+iIntros (m) "[Hm ?]".
+iMod (fupd_mask_subseteq E) as "Hmask"; first done.
+iMod (Hc with "[P $Hm]") as (??? Hstep) ">Hc"; [done..| |].
+{ rewrite bi.sep_and_l; iFrame.
+  iSplit; last iDestruct "P" as "[_ $]".
+  iDestruct "P" as "[(_ & $) _]". }
+iMod "Hmask" as "_"; iIntros "!>".
+destruct Hstep as (? & ? & ?); iExists _, m'; iSplit; first by iPureIntro; eauto.
+iDestruct "Hc" as "(? & Q)"; iFrame.
+iNext.
+iSpecialize ("Hsafe" $! EK_normal None te' ve).
+iPoseProof ("Hsafe" with "[Q $fun]") as "Hsafe'".
+{ simpl; subst; iSplit; try done.
+  monPred.unseal; by iDestruct "Q" as "[$ $]". }
+rewrite assert_safe_jsafe'; iFrame; by iPureIntro.
 Qed.
 
 Definition force_valid_pointers m v1 v2 :=
@@ -106,175 +86,91 @@ Definition blocks_match op v1 v2 :=
 match op with Cop.Olt | Cop.Ogt | Cop.Ole | Cop.Oge =>
   match v1, v2 with
     Vptr b _, Vptr b2 _ => b=b2
-    | _, _ => False
+    | _, _ => False%type
   end
-| _ => True
+| _ => True%type
 end.
 
-Lemma later_sepcon2  {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}:
-  forall P Q,  P * |> Q |-- |> (P * Q).
+Lemma mapsto_valid_pointer : forall b o sh t m,
+  sh <> Share.bot ->
+  mem_auth m ∗ mapsto_ sh t (Vptr b o) ⊢
+  ⌜Mem.valid_pointer m b (Ptrofs.unsigned o) = true⌝.
 Proof.
-intros. apply @derives_trans with (|> P * |> Q).
-apply sepcon_derives; auto. rewrite later_sepcon; auto.
+intros; iIntros "[Hm H]".
+iAssert ⌜exists ch, access_mode t = By_value ch⌝ with "[H]" as %(ch & Hch).
+{ rewrite /mapsto_ /mapsto.
+  destruct (access_mode t) eqn: ?; try done.
+  destruct (type_is_volatile t) eqn: ?; try done.
+  eauto. }
+rewrite /mapsto_ (mapsto_valid_pointer1 _ _ _ _ 0) /offset_val //.
+rewrite Ptrofs.add_zero.
+iMod "H"; iDestruct (valid_pointer_dry with "[$Hm $H]") as %Hvalid.
+by rewrite Z.add_0_r in Hvalid.
+{ pose proof (Ptrofs.unsigned_range o); lia. }
+{ rewrite /sizeof (size_chunk_sizeof _ _ _ Hch).
+  pose proof (size_chunk_pos ch); lia. }
 Qed.
 
-
-Lemma perm_order''_trans:
-  forall x y z, perm_order'' x y -> perm_order'' y z -> perm_order'' x z.
+Lemma mapsto_is_pointer : forall sh t v, mapsto_ sh t v ⊢ ⌜exists b, exists o, v = Vptr b o⌝.
 Proof.
-intros.
-destruct x,y; inv H; auto.
-destruct z; constructor.
-destruct z; inv H0; constructor.
-destruct z; inv H0; constructor.
-destruct z; inv H0; constructor.
-Qed.
-
-Lemma mapsto_valid_pointer : forall b o sh t jm,
- nonidentity sh ->
-(mapsto_ sh (t) (Vptr b o) * TT)%pred (m_phi jm) ->
-Mem.valid_pointer (m_dry jm) b (Ptrofs.unsigned o) = true.
-intros. rename H into N.
-
-destruct H0. destruct H. destruct H. destruct H0.
-unfold mapsto_,mapsto in H0.  unfold mapsto in *.
-destruct (readable_share_dec sh) as [H2 | H2].
-* (* readable_share sh *)
-rename H2 into RS.
-destruct (access_mode t); try solve [ inv H0].
-destruct (type_is_volatile t) eqn:VOL; try contradiction.
-assert (exists v,  address_mapsto m v sh (b, Ptrofs.unsigned o) x).
-destruct H0.
-econstructor; apply H0. destruct H0 as [_ [v2' H0]]; exists v2'; apply H0.
-clear H0; destruct H2 as [x1 H0].
-
-pose proof mapsto_core_load m x1 sh (b, Ptrofs.unsigned o) (m_phi jm).
-
-destruct H2. simpl; eauto.
-simpl in H2.
-destruct H2.
-specialize (H3 (b, Ptrofs.unsigned o)).
-if_tac in H3.
-destruct H3.  destruct H3.
-
-rewrite valid_pointer_nonempty_perm.
-unfold perm.
-
-assert (JMA := juicy_mem_access jm (b, Ptrofs.unsigned o)).
-unfold access_at in *. simpl in JMA.
-unfold perm_of_res in *.
-rewrite H3 in JMA. simpl in JMA.
-unfold perm_of_sh in *.
-rewrite JMA.
-repeat if_tac; try constructor. subst.
-simpl in H3.
-contradiction.
-destruct H4.  repeat split. lia.
-destruct m; simpl; lia.
-* (* ~ readable_share sh *)
-destruct (access_mode t) eqn:?; try contradiction.
-destruct (type_is_volatile t); [inversion H0 |].
-destruct H0 as [_ ?].
-specialize (H0 (b, Ptrofs.unsigned o)).
-simpl in H0.
-rewrite if_true in H0
- by (split; auto; pose proof (size_chunk_pos m); lia).
-clear H1.
-pose proof (resource_at_join _ _ _ (b, Ptrofs.unsigned o) H).
-unfold resource_share in H0.
-rewrite <- (Z.add_0_r (Ptrofs.unsigned o)).
-apply (valid_pointer_dry b o 0 jm).
-hnf.
-rewrite Z.add_0_r.
-destruct H0.
-destruct  (x @ (b, Ptrofs.unsigned o)); inv H0; inv H1; simpl; auto.
-intro.
-apply split_identity in RJ; auto.
-Qed.
-
-Lemma mapsto_is_pointer : forall sh t m v,
-mapsto_ sh t v m ->
-exists b, exists o, v = Vptr b o.
-Proof.
-intros. unfold mapsto_, mapsto in H.
-if_tac in H; try contradiction;
-destruct (access_mode t); try contradiction;
-destruct (type_is_volatile t); try contradiction.
-destruct v; try contradiction.
-eauto.
-destruct v; try contradiction.
-eauto.
+intros. unfold mapsto_, mapsto.
+destruct (access_mode t); try iIntros "[]";
+destruct (type_is_volatile t); try iIntros "[]".
+destruct v; try iIntros "[]".
+iIntros; iPureIntro; eauto.
 Qed.
 
 Lemma pointer_cmp_eval:
-  forall (Delta : tycontext) (cmp : Cop.binary_operation) (e1 e2 : expr) sh1 sh2 ge
+  forall (Delta : tycontext) ve te (cmp : Cop.binary_operation) (e1 e2 : expr) ty sh1 sh2 ge
          (GE: cenv_sub cenv_cs (genv_cenv ge)),
    is_comparison cmp = true ->
-   forall (jm : juicy_mem) (rho : environ),
-   (tc_expr Delta e1 rho) (m_phi jm) ->
-   (tc_expr Delta e2 rho) (m_phi jm) ->
-   blocks_match cmp (eval_expr e1 rho) (eval_expr e2 rho) ->
+   forall m (rho : environ) (Hrho : rho = construct_rho (filter_genv ge) ve te),
    typecheck_environ Delta rho ->
-   nonidentity sh1 ->
-   nonidentity sh2 ->
-   (mapsto_ sh1 (typeof e1) (eval_expr e1 rho) * TT)%pred (m_phi jm) ->
-   (mapsto_ sh2 (typeof e2) (eval_expr e2 rho) * TT)%pred (m_phi jm) ->
    eqb_type (typeof e1) int_or_ptr_type = false ->
    eqb_type (typeof e2) int_or_ptr_type = false ->
-   Cop.sem_binary_operation ge cmp (eval_expr e1 rho)
-     (typeof e1) (eval_expr e2 rho) (typeof e2) (m_dry jm) =
-  Some
-     (force_val
-        (sem_binary_operation' cmp (typeof e1) (typeof e2)
-           (eval_expr e1 rho) (eval_expr e2 rho))).
+   sh1 <> Share.bot -> sh2 <> Share.bot ->
+   mem_auth m ∗ tc_expr Delta e1 rho ∧ tc_expr Delta e2 rho ∧
+   ⌜blocks_match cmp (eval_expr e1 rho) (eval_expr e2 rho)⌝ ∧
+   <absorb> mapsto_ sh1 (typeof e1) (eval_expr e1 rho) ∧
+   <absorb> mapsto_ sh2 (typeof e2) (eval_expr e2 rho) ⊢
+   ⌜Clight.eval_expr ge ve te m (Ebinop cmp e1 e2 ty) (eval_expr (Ebinop cmp e1 e2 ty) rho)⌝.
 Proof.
-intros until rho. intros ? ? BM ? N1 N2 ? ? NE1 NE2.
-unfold Cop.sem_binary_operation, sem_cmp.
-simpl in H0, H1. apply typecheck_expr_sound in H0; auto.
-apply typecheck_expr_sound in H1; auto.
-
-copy H3. copy H4. rename H5 into MT_1.
-rename H6 into MT_2.
-destruct H3 as [? [? [J1 [MT1 _]]]].
-destruct H4 as [? [? [J2 [MT2 _]]]].
-destruct (mapsto_is_pointer _ _ _ _ MT1) as [? [? ?]].
-destruct (mapsto_is_pointer _ _ _ _ MT2) as [? [? ?]].
-
-unfold blocks_match in *.
-simpl in BM.
-
-rewrite H3 in *. rewrite H4 in *.
-apply mapsto_valid_pointer in MT_1; auto.
-apply mapsto_valid_pointer in MT_2; auto.
+intros until rho. intros ?? NE1 NE2 ??.
+iIntros "[Hm H]".
+iDestruct (eval_expr_relate with "[$Hm H]") as %He1; [done..| |].
+{ iDestruct "H" as "[$ _]". }
+iDestruct (eval_expr_relate with "[$Hm H]") as %He2; [done..| |].
+{ iDestruct "H" as "(_ & $ & _)". }
+rewrite /tc_expr /= !typecheck_expr_sound; [| done..].
+iDestruct "H" as (???) "H".
+iAssert ⌜∃ ch b o, access_mode (typeof e1) = By_value ch ∧ eval_expr e1 rho = Vptr b o ∧ Mem.valid_pointer m b (Ptrofs.unsigned o) = true⌝ with "[-]" as %(ch1 & b1 & o1 & ? & Hv1 & MT_1).
+{ iDestruct "H" as "(>H & _)".
+  iDestruct (mapsto_pure_facts with "H") as %((? & ?) & ?).
+  destruct (eval_expr e1 rho); try contradiction.
+  iDestruct (mapsto_valid_pointer with "[$]") as %?; eauto 7. }
+iAssert ⌜∃ ch b o, access_mode (typeof e2) = By_value ch ∧ eval_expr e2 rho = Vptr b o ∧ Mem.valid_pointer m b (Ptrofs.unsigned o) = true⌝ with "[-]" as %(ch2 & b2 & o2 & ? & Hv2 & MT_2).
+{ iDestruct "H" as "(_ & >H)".
+  iDestruct (mapsto_pure_facts with "H") as %((? & ?) & ?).
+  destruct (eval_expr e2 rho); try contradiction.
+  iDestruct (mapsto_valid_pointer with "[$]") as %?; eauto 7. }
+iPureIntro.
+econstructor; eauto.
+simpl; unfold_lift.
+rewrite -> Hv1, Hv2 in *.
 forget (typeof e1) as t1.
 forget (typeof e2) as t2.
-clear e1 e2 H3 H4.
-unfold Cop.sem_cmp, Cop.sem_binarith; simpl.
-unfold  cmp_ptr, Val.cmpu_bool, Val.cmplu_bool.
-rewrite MT_1, MT_2.
+clear e1 e2 He1 He2 Hv1 Hv2.
+rewrite /sem_binary_operation /sem_binary_operation' /sem_cmp /Cop.sem_cmp /cmp_ptr /sem_cmp_pp /Val.cmpu_bool /Val.cmplu_bool.
+rewrite MT_1 MT_2.
 simpl.
 clear MT_1 MT_2.
-unfold mapsto_ in MT1, MT2.
-unfold mapsto in MT1,MT2.
 rewrite bool2val_eq.
-destruct (access_mode t1) eqn:?A1;
- try solve [simpl in MT1; contradiction].
-destruct (access_mode t2) eqn:?A2;
- try solve [simpl in MT2; contradiction].
-clear MT1 MT2.
 destruct t1; try solve [simpl in *; try destruct f; try tauto; congruence].
 destruct t2; try solve [simpl in *; try destruct f; try tauto; congruence].
-simpl.
-unfold sem_binary_operation', sem_cmp.
-rewrite NE1,NE2.
-destruct cmp;
-inv H; subst; simpl;
-unfold Cop.sem_cmp, sem_cmp_pp, cmp_ptr, Val.cmpu_bool, Val.cmplu_bool; simpl;
-try rewrite MT_1; try rewrite MT_2; simpl;
-destruct Archi.ptr64  eqn:Hp;
-try rewrite if_true by auto;
-try solve[if_tac; subst; eauto]; try repeat rewrite peq_true; eauto.
-all: simpl; destruct (eq_block x3 x5); try reflexivity.
+rewrite NE1 NE2 /=.
+destruct cmp; try discriminate; subst; simpl; destruct Archi.ptr64  eqn:Hp;
+try rewrite -> if_true by auto;
+try solve [if_tac; subst; eauto]; rewrite ?peq_true; eauto.
 Qed.
 
 Lemma is_int_of_bool:
@@ -287,628 +183,258 @@ Opaque Int.repr.
 Qed.
 
 Lemma pointer_cmp_no_mem_bool_type:
-   forall (Delta : tycontext) cmp (e1 e2 : expr) sh1 sh2 x1 x b1 o1 b2 o2 i3 s3,
+   forall (Delta : tycontext) cmp (e1 e2 : expr) b1 o1 b2 o2 i3 s3 a,
    is_comparison cmp = true->
    eqb_type (typeof e1) int_or_ptr_type = false ->
    eqb_type (typeof e2) int_or_ptr_type = false ->
-   forall (rho : environ) phi,
+   forall (rho : environ),
    eval_expr e1 rho = Vptr b1 o1 ->
    eval_expr e2 rho = Vptr b2 o2 ->
    blocks_match cmp (eval_expr e1 rho) (eval_expr e2 rho) ->
-   denote_tc_assert (typecheck_expr Delta e1) rho phi ->
-   denote_tc_assert (typecheck_expr Delta e2) rho phi ->
-   (mapsto_ sh1 (typeof e1)
-      (eval_expr e1 rho)) x ->
-   (mapsto_ sh2 (typeof e2)
-      (eval_expr e2 rho)) x1 ->
+   tc_val (typeof e1) (eval_expr e1 rho) ->
+   tc_val (typeof e2) (eval_expr e2 rho) ->
    typecheck_environ Delta rho ->
-    is_int i3 s3
+    tc_val' (Tint i3 s3 a)
      (force_val
         (sem_binary_operation' cmp (typeof e1) (typeof e2)
            (eval_expr e1 rho)
            (eval_expr e2 rho))).
 Proof.
 intros until 1. intros NE1 NE2; intros.
-apply typecheck_both_sound in H4; auto.
-apply typecheck_both_sound in H3; auto.
-rewrite H0 in *.
-rewrite H1 in *.
+rewrite -> H0, H1 in *.
 unfold sem_binary_operation'.
 forget (typeof e1) as t1.
 forget (typeof e2) as t2.
 clear e1 e2 H0 H1.
-unfold mapsto_ in *.
-unfold mapsto in *.
-destruct (access_mode t1) eqn:?A1;
- try solve [simpl in H5; contradiction].
-destruct (access_mode t2) eqn:?A2;
- try solve [simpl in H6; contradiction].
-destruct t1 as [ | | | [ | ] | | | | | ]; try solve[simpl in *; try contradiction; try congruence];
-destruct t2 as [ | | | [ | ] | | | | | ]; try solve[simpl in *; try contradiction; try congruence].
 unfold sem_cmp, sem_cmp_pp, cmp_ptr, Val.cmpu_bool, Val.cmplu_bool.
-rewrite NE1,NE2.
+rewrite NE1 NE2.
 destruct Archi.ptr64 eqn:Hp;
-destruct cmp; inv H;
-unfold sem_cmp; simpl;
-if_tac; auto; simpl; try of_bool_destruct; auto;
-try apply is_int_of_bool;
+destruct cmp; inv H; destruct (classify_cmp t1 t2) eqn: Hclass;
+simpl; unfold sem_cmp_pp;
+rewrite /= ?Hp /=; auto; try if_tac; auto;
+try apply tc_val_tc_val', binop_lemmas2.tc_bool2val;
 subst;
-try match goal with |- context [Z.b2z ?A] => destruct A end.
-all: clear; destruct i3,s3; simpl; auto;
-try change (Int.signed _) with 0;
-try change (Int.signed _) with 1;
-try change (Int.unsigned _) with 0;
-try change (Int.unsigned _) with 1.
-all: compute; try split; congruence.
+try match goal with |- context [Z.b2z ?A] => destruct A end; try by intros ?.
+all: rewrite /sem_binarith /both_int /both_long /both_float /both_single; destruct (classify_binarith t1 t2); simpl;
+  repeat match goal with |-context[match ?A with _ => _ end] => destruct A end; try apply tc_val_tc_val', binop_lemmas2.tc_bool2val; try by intros ?.
 Qed.
 
 Definition weak_mapsto_ sh e rho :=
 match (eval_expr e rho) with
-| Vptr b o => (mapsto_ sh (typeof e) (Vptr b o)) ||
+| Vptr b o => (mapsto_ sh (typeof e) (Vptr b o)) ∨
               (mapsto_ sh (typeof e) (Vptr b o))
-| _ => FF
+| _ => False
 end.
 
-Lemma extend_sepcon_TT {A} {JA: Join A} {PA: Perm_alg A}{SA: Sep_alg A} {AG: ageable A} {Aga: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}:
- forall P, boxy extendM (P * TT).
-Proof. intros. hnf.
- apply pred_ext.
- intros ? ?. hnf in H. apply H. apply extendM_refl.
- intros ? ?. intros ? ?. destruct H0 as [b ?].
- destruct H as [? [? [? [? ?]]]].
- destruct (join_assoc H H0) as [c [? ?]].
- exists x; exists c; split; auto.
+Lemma closed_wrt_modvars_set : forall F id e v ge ve te rho
+  (Hclosed : closed_wrt_modvars(Σ:=Σ) (Sset id e) F)
+  (Hge : rho = construct_rho (filter_genv ge) ve te),
+  F rho ⊣⊢ F (mkEnviron (ge_of rho) (ve_of rho)
+       (make_tenv (Maps.PTree.set id v te))).
+Proof.
+  intros.
+  apply Hclosed; intros.
+  destruct (eq_dec i id).
+  - rewrite /modifiedvars /modifiedvars' /insert_idset.
+    subst; rewrite Maps.PTree.gss /=; auto.
+  - rewrite -map_ptree_rel Map.gso; subst; auto.
+Qed.
+
+Lemma subst_set : forall {A} id v (P : environ -> A) v' ge ve te rho
+  (Hge : rho = construct_rho (filter_genv ge) ve te)
+  (Hid : Map.get (te_of rho) id = Some v),
+  subst id (λ _ : environ, eval_id id rho) P
+       (mkEnviron (ge_of rho) (ve_of rho)
+          (make_tenv (Maps.PTree.set id v' te))) = P rho.
+Proof.
+  intros; subst rho; rewrite /subst /env_set /construct_rho -map_ptree_rel /=; unfold_lift.
+  rewrite Map.override Map.override_same; auto.
+  by rewrite /eval_id Hid.
 Qed.
 
 Lemma semax_ptr_compare:
-forall (Delta: tycontext) (P: assert) id cmp e1 e2 ty sh1 sh2,
-    nonidentity sh1 -> nonidentity sh2 ->
+forall E (Delta: tycontext) (P: assert) id cmp e1 e2 ty sh1 sh2,
+    sh1 <> Share.bot -> sh2 <> Share.bot ->
     is_comparison cmp = true  ->
-     eqb_type (typeof e1) int_or_ptr_type = false ->
+    eqb_type (typeof e1) int_or_ptr_type = false ->
     eqb_type (typeof e2) int_or_ptr_type = false ->
     (typecheck_tid_ptr_compare Delta id = true) ->
-    semax Espec Delta
-        (fun rho =>
-          |> (tc_expr Delta e1 rho && tc_expr Delta e2 rho  &&
-
-          !!(blocks_match cmp (eval_expr e1 rho) (eval_expr e2 rho)) &&
-          (mapsto_ sh1 (typeof e1) (eval_expr e1 rho) * TT) &&
-          (mapsto_ sh2 (typeof e2) (eval_expr e2 rho) * TT) &&
-          P rho))
+    semax OK_spec E Delta
+        (▷ (tc_expr Delta e1 ∧ tc_expr Delta e2 ∧
+          local (`(blocks_match cmp) (eval_expr e1) (eval_expr e2)) ∧
+          <absorb> assert_of (`(mapsto_ sh1 (typeof e1)) (eval_expr e1)) ∧
+          <absorb> assert_of (`(mapsto_ sh2 (typeof e2)) (eval_expr e2)) ∧
+          P))
           (Sset id (Ebinop cmp e1 e2 ty))
         (normal_ret_assert
-          (fun rho => (EX old:val,
-                 !!(eval_id id rho =  subst id (`old)
-                     (eval_expr (Ebinop cmp e1 e2 ty)) rho) &&
-                            subst id (`old) P rho))).
+          (∃ old:val,
+                 local (`eq (eval_id id)  (subst id `(old)
+                     (eval_expr (Ebinop cmp e1 e2 ty)))) ∧
+                            assert_of (subst id (liftx old) P))).
 Proof.
-  intros until sh2. intros N1 N2. intros ? NE1 NE2. revert H.
-  replace (fun rho : environ =>
-     |> (tc_expr Delta e1 rho && tc_expr Delta e2 rho  &&
-             !!blocks_match cmp (eval_expr e1 rho) (eval_expr e2 rho) &&
-            (mapsto_ sh1 (typeof e1) (eval_expr e1 rho) * TT) &&
-            (mapsto_ sh2 (typeof e2) (eval_expr e2 rho) * TT) &&
-            P rho))
-    with (fun rho : environ =>
-       (|> tc_expr Delta e1 rho &&
-        |> tc_expr Delta e2 rho &&
-        |> !!blocks_match cmp (eval_expr e1 rho) (eval_expr e2 rho) &&
-        |> (mapsto_ sh1 (typeof e1) (eval_expr e1 rho) * TT) &&
-        |> (mapsto_ sh2 (typeof e2) (eval_expr e2 rho) * TT) &&
-        |> P rho))
-    by (extensionality rho;  repeat rewrite later_andp; auto).
-  intros CMP TC2.
-  apply semax_straight_simple; auto.
-  intros; repeat apply boxy_andp; auto;  apply extend_later'; apply extend_sepcon_TT.
-  intros jm jm' Delta' ge vx tx rho k F f TS [[[[TC3 TC1]  TC4] MT1] MT2] TC' Hcl Hge ? ? HGG.
-  specialize (TC3 (m_phi jm') (age_laterR (age_jm_phi H))).
-  specialize (TC1 (m_phi jm') (age_laterR (age_jm_phi H))).
-  specialize (TC4 (m_phi jm') (age_laterR (age_jm_phi H))).
-  specialize (MT1 (m_phi jm') (age_laterR (age_jm_phi H))).
-  specialize (MT2 (m_phi jm') (age_laterR (age_jm_phi H))).
-  apply (typecheck_tid_ptr_compare_sub _ _ TS) in TC2.
-  pose proof TC1 as TC1'.
-  pose proof TC3 as TC3'.
+  intros until sh2. intros ?? CMP NE1 NE2 TCid.
+  apply semax_pre with (
+      ((▷ tc_expr Delta e1 ∧
+        ▷ tc_expr Delta e2 ∧
+        ▷ local (fun rho => blocks_match cmp (eval_expr e1 rho) (eval_expr e2 rho)) ∧
+        ▷ <absorb> assert_of (`(mapsto_ sh1 (typeof e1)) (eval_expr e1)) ∧
+        ▷ <absorb> assert_of (`(mapsto_ sh2 (typeof e2)) (eval_expr e2))) ∧
+        ▷ P)), semax_straight_simple.
+  { intros. rewrite bi.and_elim_r !bi.later_and !assoc //. }
+  { apply _. }
+  intros until f; intros TS TC Hcl Hge HGG.
   assert (typecheck_environ Delta rho) as TYCON_ENV
-    by (destruct TC' as [TC' TC'']; eapply typecheck_environ_sub; eauto).
-  apply (tc_expr_sub _ _ _ TS) in TC3'; [| auto].
-  apply (tc_expr_sub _ _ _ TS) in TC1'; [| auto].
-  exists jm', (PTree.set id (eval_expr (Ebinop cmp e1 e2 ty) rho) (tx)).
-  econstructor.
-  split; [reflexivity |].
-  split3; auto.
-  + apply age_level; auto.
-  + normalize in H0.
-    clear H H0.
+    by (destruct TC as [TC' TC'']; eapply typecheck_environ_sub; eauto).
+  eapply typecheck_tid_ptr_compare_sub in TCid; last done.
+  iIntros "H"; iExists m, (Maps.PTree.set id (eval_expr (Ebinop cmp e1 e2 ty) rho) te), _.
+  monPred.unseal; rewrite !monPred_at_absorbingly; unfold_lift; simpl.
+  iSplit; [iSplit; first done; iSplit|].
+  + rewrite !mapsto_is_pointer /tc_expr /= !typecheck_expr_sound; [| done..].
+    iDestruct "H" as "(? & (>%TC1 & >%TC2 & >% & >%Hv1 & >%Hv2) & _)".
+    destruct Hv1 as (? & ? & ?), Hv2 as (? & ? & ?).
     simpl. rewrite <- map_ptree_rel.
-    apply guard_environ_put_te'; auto. subst. simpl.
-    unfold construct_rho in *; auto.
-
-    intros.
-
-    destruct TC' as [TC' TC''].
-    simpl in TC2. unfold typecheck_tid_ptr_compare in *.
-    rewrite H in TC2.
-    unfold guard_environ in *.
-
-    destruct MT1 as [? [? [J1 [MT1 _]]]].
-    destruct MT2 as [? [? [J2 [MT2 _]]]].
-    destruct (mapsto_is_pointer _ _ _ _ MT1) as [? [? ?]].
-    destruct (mapsto_is_pointer _ _ _ _ MT2) as [? [? ?]].
-
-    destruct t; inv TC2.
-    simpl. super_unfold_lift.
-    simpl.
-    apply tc_val_tc_val'.
+    iPureIntro; apply guard_environ_put_te'; [subst; auto|].
+    intros ? Ht.
+    rewrite /typecheck_tid_ptr_compare Ht in TCid; destruct t; try discriminate.
     eapply pointer_cmp_no_mem_bool_type; eauto.
-  + destruct H0.
-    split; auto.
-    - simpl.
-      split3; auto.
-      2: apply age1_resource_decay; auto.
-      2:{
-        split; [apply age_level; auto|].
-        apply age1_ghost_of, age_jm_phi; auto.
-      }
-      destruct (age1_juicy_mem_unpack _ _ H).
-      rewrite <- H3.
-      econstructor; eauto.
-
-      (*start new proof*)
-      rewrite Hge in *.
-      destruct TC'; simpl in H4, TC3, TC1.
-      rewrite <- Hge in *.
-      eapply Clight.eval_Ebinop.
-      rewrite H3; eapply eval_expr_relate; eauto.
-      rewrite H3; eapply eval_expr_relate; eauto.
-      rewrite H3.
-      super_unfold_lift.
-      destruct MT1 as [? [? [J1 [MT1 _]]]].
-      destruct MT2 as [? [? [J2 [MT2 _]]]].
-      destruct (mapsto_is_pointer _ _ _ _ MT1) as [? [? ?]].
-      destruct (mapsto_is_pointer _ _ _ _ MT2) as [? [? ?]].
-      rewrite H6. rewrite H7. unfold eval_binop.
-      rewrite <- H6. rewrite <- H7. clear H6 H7.
-      apply (pointer_cmp_eval Delta' cmp e1 e2 sh1 sh2); auto;
-      try (eauto; simpl; eauto).
-    - split.
-      2: eapply pred_hereditary; try apply H1; destruct (age1_juicy_mem_unpack _ _ H); auto.
-      assert (app_pred (|>  (F rho * P rho)) (m_phi jm)).
-      {
-        rewrite later_sepcon. eapply sepcon_derives; try apply H0; auto.
-      }
-      assert (laterR (m_phi jm) (m_phi jm')).
-      {
-        constructor 1.
-        destruct (age1_juicy_mem_unpack _ _ H); auto.
-      }
-      specialize (H2 _ H3).
-      eapply sepcon_derives; try  apply H2; auto.
-      * clear - Hcl Hge.
-        rewrite <- map_ptree_rel.
-        specialize (Hcl rho (Map.set id (eval_expr (Ebinop cmp e1 e2 ty) rho) (make_tenv tx))).
-        rewrite <- Hcl; auto.
-        intros.
-        destruct (Pos.eq_dec id i).
-        {
-          subst.
-          left. unfold modifiedvars, modifiedvars', insert_idset.
-          unfold insert_idset; rewrite PTree.gss; hnf; auto.
-        }
-        {
-          right.
-          rewrite Map.gso; auto. subst; auto.
-        }
-      * apply exp_right with (eval_id id rho).
-        rewrite <- map_ptree_rel.
-        assert (env_set
-                 (mkEnviron (ge_of rho) (ve_of rho)
-                    (Map.set id (eval_expr (Ebinop cmp e1 e2 ty) rho) (make_tenv tx))) id (eval_id id rho) = rho).
-        {
-          unfold env_set;
-          f_equal.
-          unfold eval_id; simpl.
-          rewrite Map.override.
-          rewrite Map.override_same. subst; auto.
-          rewrite Hge in TC'.
-          destruct TC' as [TC' _].
-          destruct TC' as [TC' _]. unfold typecheck_temp_environ in *.
-          simpl in TC2. unfold typecheck_tid_ptr_compare in *. remember ((temp_types Delta') ! id).
-          destruct o; [ | inv TC2]. symmetry in Heqo.
-          specialize (TC' _ _ Heqo). destruct TC'. destruct H4.
-          simpl in H4.
-          rewrite H4. simpl.
-          f_equal. rewrite Hge; simpl. rewrite H4. reflexivity.
-        }
-        apply andp_right.
-        {
-          intros ? _. simpl.
-          unfold subst.
-          simpl in H4. super_unfold_lift.
-          rewrite H4.
-          unfold eval_id at 1. unfold force_val; simpl.
-          rewrite Map.gss. auto.
-        }
-        {
-          simpl. simpl in H4. super_unfold_lift.
-          unfold subst.
-          rewrite H4.
-          auto.
-        }
+  + iAssert (▷ ⌜Clight.eval_expr ge ve te m (Ebinop cmp e1 e2 ty) (eval_expr (Ebinop cmp e1 e2 ty) rho)⌝) with "[H]" as ">%";
+      last by iPureIntro; constructor.
+    iNext.
+    iDestruct "H" as "(Hm & [H _])"; iCombine "Hm H" as "H".
+    by iApply (pointer_cmp_eval with "H").
+  + iIntros "!> !>".
+    iDestruct "H" as "($ & [_ (F & P)])".
+    erewrite (closed_wrt_modvars_set F) by eauto; iFrame.
+    iExists (eval_id id rho).
+    destruct TC as [[TC _] _].
+    unfold typecheck_tid_ptr_compare, typecheck_temp_environ in *.
+    destruct (temp_types Delta' !! id) eqn: Hid; try discriminate.
+    destruct (TC _ _ Hid) as (? & ? & ?).
+    unfold lift1; erewrite !subst_set by eauto; iFrame.
+    super_unfold_lift.
+    rewrite /eval_id /force_val -map_ptree_rel Map.gss //.
 Qed.
 
 Lemma semax_set_forward:
-forall (Delta: tycontext) (P: assert) id e,
-    semax Espec Delta
-        (fun rho =>
-          |> (tc_expr Delta e rho  && (tc_temp_id id (typeof e) Delta e rho) && P rho))
+forall E (Delta: tycontext) (P: assert) id e,
+    semax OK_spec E Delta
+        (▷ (tc_expr Delta e ∧ (tc_temp_id id (typeof e) Delta e) ∧ P))
           (Sset id e)
         (normal_ret_assert
-          (fun rho => (EX old:val,
-                 !! (eval_id id rho =  subst id (`old) (eval_expr e) rho) &&
-                            subst id (`old) P rho))).
+          (∃ old:val,
+                 local (fun rho => eval_id id rho = subst id (liftx old) (eval_expr e) rho) ∧
+                            assert_of (subst id (`old) P))).
 Proof.
-  intros until e.
-  replace (fun rho : environ =>
-     |>(tc_expr Delta e rho && tc_temp_id id (typeof e) Delta e rho &&
-        P rho))
-   with (fun rho : environ =>
-       (|> tc_expr Delta e rho &&
-        |> tc_temp_id id (typeof e) Delta e rho &&
-        |> P rho))
-    by (extensionality rho;  repeat rewrite later_andp; auto).
-  apply semax_straight_simple; auto.
-  intros jm jm' Delta' ge vx tx rho k F f TS [TC3 TC2] TC' Hcl Hge ? ? HGG'.
-  specialize (TC3 (m_phi jm') (age_laterR (age_jm_phi H))).
-  specialize (TC2 (m_phi jm') (age_laterR (age_jm_phi H))).
-  assert (typecheck_environ Delta rho) as TC.
-  {
-    destruct TC' as [? _].
-    eapply typecheck_environ_sub; eauto.
-  }
-  pose proof TC3 as TC3'.
-  pose proof TC2 as TC2'.
-  apply (tc_expr_sub _ _ _ TS) in TC3'; [| auto].
-  apply (tc_temp_id_sub _ _ _ TS) in TC2'.
-  exists jm', (PTree.set id (eval_expr e rho) (tx)).
-  econstructor.
-  split; [reflexivity |].
-  split3; auto.
-  + apply age_level; auto.
-  + normalize in H0.
-    clear - TS TC TC' TC2 TC2' TC3 TC3' Hge.
+  intros.
+  apply semax_pre with (
+     (▷ tc_expr Delta e ∧
+      ▷ tc_temp_id id (typeof e) Delta e) ∧
+      ▷ P), semax_straight_simple.
+  { intros. rewrite bi.and_elim_r !bi.later_and !assoc //. }
+  { apply _. }
+  intros until f; intros TS TC Hcl Hge HGG.
+  assert (typecheck_environ Delta rho) as TYCON_ENV
+    by (destruct TC as [TC' TC'']; eapply typecheck_environ_sub; eauto).
+  iIntros "(Hm & H)".
+  iExists m, (Maps.PTree.set id (eval_expr e rho) te), _.
+  monPred.unseal. setoid_rewrite tc_temp_id_sub; last done. rewrite /tc_temp_id /typecheck_temp_id /=.
+  destruct (temp_types Delta' !! id) eqn: Hid.
+  iSplit; [iSplit; first done; iSplit|].
+  + rewrite !denote_tc_assert_andp tc_bool_e.
+    iAssert (▷ ⌜tc_val t (eval_expr e rho)⌝) with "[H]" as ">%".
+    { iNext.
+      rewrite (bi.and_elim_l (_ ∧ _)) (bi.and_elim_l (bi_pure _)).
+      iDestruct "H" as "[H %]".
+      by iApply neutral_cast_tc_val. }
+    iPureIntro.
     simpl in *. simpl. rewrite <- map_ptree_rel.
-    apply guard_environ_put_te'; auto.
-    {
-      subst; simpl in *.
-      unfold construct_rho in *; auto.
-    }
-    intros. simpl in *. unfold typecheck_temp_id in *.
-    unfold tc_temp_id in TC2'. simpl in TC2'. unfold typecheck_temp_id in TC2'.
-    rewrite H in TC2'.
-    simpl in *.
-    rewrite denote_tc_assert_andp in TC2' ; simpl in *.
-    super_unfold_lift. destruct TC2'.
-    unfold tc_bool in *. remember (is_neutral_cast (implicit_deref (typeof e)) t).
-    destruct b; inv H0.
-    apply tc_val_tc_val'.
-    apply @neutral_cast_tc_val with (Delta := Delta') (phi:=m_phi jm'); auto.
-    unfold guard_environ in *. destruct TC'; auto.
-  + destruct H0.
-    split; auto.
-    {
-      simpl.
-      split3; auto.
-      + destruct (age1_juicy_mem_unpack _ _ H).
-        rewrite <- H3.
-        econstructor; eauto.
-        rewrite H3; eapply eval_expr_relate with (m := jm'); eauto.
-      + apply age1_resource_decay; auto.
-      + split; [apply age_level; auto|].
-        apply age1_ghost_of, age_jm_phi; auto.
-    }
-    split.
-    2: eapply pred_hereditary; try apply H1; destruct (age1_juicy_mem_unpack _ _ H); auto.
-    assert (app_pred (|>  (F rho * P rho)) (m_phi jm)).
-    { rewrite later_sepcon. eapply sepcon_derives; try apply H0; auto. }
-    assert (laterR (m_phi jm) (m_phi jm')).
-    { constructor 1. destruct (age1_juicy_mem_unpack _ _ H); auto. }
-    specialize (H2 _ H3).
-    eapply sepcon_derives; try  apply H2; auto.
-    - clear - Hcl Hge.
-      rewrite <- map_ptree_rel.
-      specialize (Hcl rho (Map.set id (eval_expr e rho) (make_tenv tx))).
-      rewrite <- Hcl; auto.
-      intros.
-      destruct (Pos.eq_dec id i).
-      * subst.
-        left. unfold modifiedvars, modifiedvars', insert_idset.
-        unfold insert_idset; rewrite PTree.gss; hnf; auto.
-      * right.
-        rewrite Map.gso; auto. subst; auto.
-    - apply exp_right with (eval_id id rho).
-      rewrite <- map_ptree_rel.
-      assert (env_set
-               (mkEnviron (ge_of rho) (ve_of rho)
-                  (Map.set id (eval_expr e rho) (make_tenv tx))) id (eval_id id rho) = rho).
-      {
-        unfold env_set;
-        f_equal.
-        unfold eval_id; simpl.
-        rewrite Map.override.
-        rewrite Map.override_same. subst; auto.
-        rewrite Hge in TC'.
-        destruct TC' as [TC' _].
-        destruct TC' as [TC' _]. unfold typecheck_temp_environ in *.
-        simpl in TC2'. unfold typecheck_temp_id in *. remember ((temp_types Delta') ! id).
-        unfold tc_temp_id,typecheck_temp_id in TC2'. simpl in TC2'.
-        rewrite <- Heqo in TC2'.
-        destruct o; [ | inv TC2']. symmetry in Heqo.
-        specialize (TC' _ _ Heqo). destruct TC'. destruct H4.
-        simpl in H4.
-        rewrite H4.
-        f_equal. rewrite Hge; simpl. rewrite H4. reflexivity.
-      }
-      apply andp_right.
-      * intros ? _. unfold liftx, lift; simpl.
-        unfold subst.
-        rewrite H4.
-        unfold eval_id at 1. unfold force_val; simpl.
-        rewrite Map.gss. auto.
-      * unfold liftx, lift; simpl. unfold subst; rewrite H4.
-        auto.
+    apply guard_environ_put_te'; [subst; auto|].
+    intros ? Hid'; rewrite Hid' in Hid; inv Hid.
+    by apply tc_val_tc_val'.
+  + iAssert (▷ ⌜Clight.eval_expr ge ve te m e (eval_expr e rho)⌝) with "[-]" as ">%"; last by iPureIntro; constructor.
+    iNext; iApply eval_expr_relate; [done..|].
+    iDestruct "H" as "(($ & _) & _)"; iFrame.
+  + iIntros "!> !>".
+    iDestruct "H" as "(_ & F & P)"; iFrame.
+    erewrite (closed_wrt_modvars_set F) by eauto; iFrame.
+    iNext; iExists (eval_id id rho).
+    destruct TC as [[TC _] _].
+    destruct (TC _ _ Hid) as (? & ? & ?).
+    super_unfold_lift; erewrite !subst_set by eauto; iFrame.
+    rewrite /eval_id /force_val -map_ptree_rel Map.gss //.
+  + iDestruct "H" as "((_ & >[]) & _)".
 Qed.
 
 Lemma semax_set_forward':
-forall (Delta: tycontext) (P: assert) id e t,
+forall E (Delta: tycontext) (P: assert) id e t,
     typeof_temp Delta id = Some t ->
     is_neutral_cast (typeof e) t = true ->
-    semax Espec Delta
-        (fun rho =>
-          |> ((tc_expr Delta e rho) && P rho))
+    semax OK_spec E Delta
+        (▷ (tc_expr Delta e ∧ P))
           (Sset id e)
         (normal_ret_assert
-          (fun rho => (EX old:val,
-                 !! (eval_id id rho =  subst id (`old) (eval_expr e) rho) &&
-                            subst id (`old) P rho))).
+          (∃ old:val,
+                 local (fun rho => eval_id id rho = subst id (liftx old) (eval_expr e) rho) ∧
+                            assert_of (subst id (`old) P))).
 Proof.
-intros until e.
-intros t H99 H98.
-replace (fun rho : environ =>
-   |> ((tc_expr Delta e rho) && P rho))
- with (fun rho : environ =>
-     (|> tc_expr Delta e rho && |> P rho))
-  by (extensionality rho;  repeat rewrite later_andp; auto).
-apply semax_straight_simple; auto.
-intros jm jm' Delta' ge vx tx rho k F f TS TC3 TC' Hcl Hge ? ? HGG'.
-specialize (TC3 (m_phi jm') (age_laterR (age_jm_phi H))).
-assert (typecheck_environ Delta rho) as TC.
-{
-  destruct TC'.
-  eapply typecheck_environ_sub; eauto.
-}
-pose proof TC3 as TC3'.
-apply (tc_expr_sub _ _ _ TS) in TC3'; [| auto].
-assert (typeof_temp Delta' id = Some t) as H97.
-  unfold typeof_temp in *.
-  unfold tycontext_sub in TS. destruct TS as [?TS _]. specialize (TS id).
-  destruct ((temp_types Delta) ! id); inversion H99.
-  destruct ((temp_types Delta') ! id); inversion TS.
-  subst; auto.
-clear H99.
-exists jm', (PTree.set id (eval_expr e rho) (tx)).
-econstructor.
-split.
-reflexivity.
-split3; auto.
-+ apply age_level; auto.
-+ normalize in H0.
-  clear - TS TC TC' H98 H97 TC3 TC3' HGG' Hge.
-  simpl in *. simpl. rewrite <- map_ptree_rel.
-  apply guard_environ_put_te'; auto. subst; simpl in *.
-  unfold construct_rho in *; auto.
-  intros. simpl in *. unfold typecheck_temp_id in *.
-  unfold typeof_temp in H97.
-  rewrite H in H97.
-  simpl in *.
-  super_unfold_lift. inversion H97.
-  subst.
-  assert (is_neutral_cast (implicit_deref (typeof e)) t = true).
-  destruct (typeof e), t; inversion H98; reflexivity.
-  apply tc_val_tc_val'.
-  apply @neutral_cast_tc_val with (Delta := Delta') (phi:=m_phi jm'); auto.
-  apply neutral_isCastResultType; auto.
-  unfold guard_environ in *. destruct TC'; auto.
-+
-  destruct H0.
-  split; auto.
-  simpl.
-  split3; auto.
-  destruct (age1_juicy_mem_unpack _ _ H).
-  rewrite <- H3.
-  econstructor; eauto.
-  rewrite H3; eapply eval_expr_relate; try apply TC3; auto.
-  apply age1_resource_decay; auto.
-  split; [apply age_level; auto|].
-  apply age1_ghost_of, age_jm_phi; auto.
-
-split.
-2: eapply pred_hereditary; try apply H1; destruct (age1_juicy_mem_unpack _ _ H); auto.
-
-assert (app_pred (|>  (F rho * P rho)) (m_phi jm)).
-rewrite later_sepcon. eapply sepcon_derives; try apply H0; auto.
-assert (laterR (m_phi jm) (m_phi jm')).
-constructor 1.
-destruct (age1_juicy_mem_unpack _ _ H); auto.
-specialize (H2 _ H3).
-eapply sepcon_derives; try  apply H2; auto.
-clear - Hcl Hge.
-rewrite <- map_ptree_rel.
-specialize (Hcl rho (Map.set id (eval_expr e rho) (make_tenv tx))).
-rewrite <- Hcl; auto.
 intros.
-destruct (Pos.eq_dec id i).
-subst.
-left. unfold modifiedvars, modifiedvars', insert_idset.
-  rewrite PTree.gss; hnf; auto.
-right.
-rewrite Map.gso; auto. subst; auto.
-apply exp_right with (eval_id id rho).
-rewrite <- map_ptree_rel.
-assert (env_set
-         (mkEnviron (ge_of rho) (ve_of rho)
-            (Map.set id (eval_expr e rho) (make_tenv tx))) id (eval_id id rho) = rho).
-{ unfold env_set;
-  f_equal.
-  unfold eval_id; simpl.
-  rewrite Map.override.
-  rewrite Map.override_same. subst; auto.
-  rewrite Hge in TC'.
-  destruct TC' as [TC' _].
-  destruct TC' as [TC' _]. unfold typecheck_temp_environ in *.
-  unfold typeof_temp in H97. unfold typecheck_temp_id in *. remember ((temp_types Delta') ! id).
-  destruct o; [ | inv H97]. symmetry in Heqo.
-  specialize (TC' _ _ Heqo). destruct TC'. destruct H4.
-  simpl in H4.
-  rewrite H4. simpl.
-  f_equal. rewrite Hge; simpl. rewrite H4. reflexivity.
-}
-unfold liftx, lift; simpl.
-apply andp_right.
-intros ? _. simpl.
-unfold subst.
-rewrite H4.
-unfold eval_id at 1. unfold force_val; simpl.
-rewrite Map.gss. auto.
-unfold subst; rewrite H4.
-auto.
+eapply semax_pre, semax_set_forward.
+iIntros "[TC H] !>".
+iSplit; first iDestruct "H" as "[$ _]".
+iSplit; last iDestruct "H" as "[_ $]".
+rewrite /tc_temp_id /typecheck_temp_id /=.
+unfold typeof_temp in H.
+destruct (temp_types Delta !! id) eqn: Ht; inv H.
+iStopProof; monPred.unseal; split => rho.
+setoid_rewrite denote_tc_assert_andp.
+assert (implicit_deref (typeof e) = typeof e) as -> by (by destruct (typeof e)).
+rewrite H0; iIntros "?"; iSplit; auto.
+by iApply (neutral_isCastResultType with "[$]").
 Qed.
 
 Lemma semax_cast_set:
-forall (Delta: tycontext) (P: assert) id e t,
-    typeof_temp Delta id = Some t ->
-    semax Espec Delta
-        (fun rho =>
-          |> ((tc_expr Delta (Ecast e t) rho) && P rho))
+forall E (Delta: tycontext) (P: assert) id e t
+    (H99 : typeof_temp Delta id = Some t),
+    semax OK_spec E Delta
+        (▷ (tc_expr Delta (Ecast e t) ∧ P))
           (Sset id (Ecast e t))
         (normal_ret_assert
-          (fun rho => (EX old:val,
-                 !! (eval_id id rho = subst id (`old) (eval_expr (Ecast e t)) rho) &&
-                            subst id (`old) P rho))).
+          (∃ old:val,
+                 local (fun rho => eval_id id rho = subst id (liftx old) (eval_expr (Ecast e t)) rho) ∧
+                            assert_of (subst id (`old) P))).
 Proof.
-intros until e.
-intros t H99.
-replace (fun rho : environ =>
-   |> ((tc_expr Delta (Ecast e t) rho) && P rho))
- with (fun rho : environ =>
-     (|> tc_expr Delta (Ecast e t) rho && |> P rho))
-  by (extensionality rho;  repeat rewrite later_andp; auto).
-apply semax_straight_simple; auto.
-intros jm jm' Delta' ge vx tx rho k F f TS TC3 TC' Hcl Hge ? ? HGG'.
-specialize (TC3 (m_phi jm') (age_laterR (age_jm_phi H))).
-assert (typecheck_environ Delta rho) as TC.
-{
-  destruct TC'.
-  eapply typecheck_environ_sub; eauto.
-}
-pose proof TC3 as TC3'.
-apply (tc_expr_sub _ _ _ TS) in TC3'; [| auto].
-assert (typeof_temp Delta' id = Some t) as H97.
-  unfold typeof_temp in *.
-  unfold tycontext_sub in TS. destruct TS as [?TS _]. specialize (TS id).
-  destruct ((temp_types Delta) ! id); inversion H99.
-  destruct ((temp_types Delta') ! id); inversion TS.
-  subst; auto.
-clear H99.
-exists jm', (PTree.set id (eval_expr (Ecast e t) rho) (tx)).
-econstructor.
-split.
-reflexivity.
-split3; auto.
-+ apply age_level; auto.
-+ normalize in H0.
-  clear - TS TC' TC H97 TC3 TC3' Hge HGG'.
-  simpl in *. simpl. rewrite <- map_ptree_rel.
-  apply guard_environ_put_te'; auto. subst; simpl in *.
-  unfold construct_rho in *; auto.
-  intros. simpl in *. unfold typecheck_temp_id in *.
-  unfold typeof_temp in H97.
-  rewrite H in H97.
-  simpl in *.
-  super_unfold_lift. inversion H97.
-  subst.
-  unfold tc_expr in TC3, TC3'; simpl in TC3, TC3'.
-  rewrite denote_tc_assert_andp in TC3. destruct TC3.
-  rewrite denote_tc_assert_andp in TC3'. destruct TC3'.
-  apply tc_val_tc_val'.
-  apply @tc_val_sem_cast with (Delta := Delta') (phi:=m_phi jm'); auto.
-  eapply guard_environ_e1; eauto.
-+
-  destruct H0.
-  split; auto.
-  simpl.
-  split3; auto.
-  destruct (age1_juicy_mem_unpack _ _ H).
-  rewrite <- H3.
-  econstructor; eauto.
-  change ((`(force_val1 (sem_cast (typeof e) t)) (eval_expr e) rho)) with (eval_expr (Ecast e t) rho).
-  rewrite H3; eapply eval_expr_relate; eauto.
-  apply age1_resource_decay; auto.
-  split; [apply age_level; auto|].
-  apply age1_ghost_of, age_jm_phi; auto.
-
-split.
-2: eapply pred_hereditary; try apply H1; destruct (age1_juicy_mem_unpack _ _ H); auto.
-
-assert (app_pred (|>  (F rho * P rho)) (m_phi jm)).
-rewrite later_sepcon. eapply sepcon_derives; try apply H0; auto.
-assert (laterR (m_phi jm) (m_phi jm')).
-constructor 1.
-destruct (age1_juicy_mem_unpack _ _ H); auto.
-specialize (H2 _ H3).
-eapply sepcon_derives; try  apply H2; auto.
-clear - Hcl Hge.
-rewrite <- map_ptree_rel.
-specialize (Hcl rho (Map.set id (eval_expr (Ecast e t) rho) (make_tenv tx))).
-rewrite <- Hcl; auto.
-intros.
-destruct (Pos.eq_dec id i).
-subst.
-left. unfold modifiedvars, modifiedvars', insert_idset.
- rewrite PTree.gss; hnf; auto.
-right.
-rewrite Map.gso; auto. subst; auto.
-apply exp_right with (eval_id id rho).
-rewrite <- map_ptree_rel.
-assert (env_set
-         (mkEnviron (ge_of rho) (ve_of rho)
-            (Map.set id (eval_expr (Ecast e t) rho) (make_tenv tx))) id (eval_id id rho) = rho).
-{ unfold env_set;
-  f_equal.
-  unfold eval_id; simpl.
-  rewrite Map.override.
-  rewrite Map.override_same. subst; auto.
-  rewrite Hge in TC'.
-  destruct TC' as [TC' _].
-  destruct TC' as [TC' _]. unfold typecheck_temp_environ in *.
-  unfold typeof_temp in H97. unfold typecheck_temp_id in *. remember ((temp_types Delta') ! id).
-  destruct o; [ | inv H97]. symmetry in Heqo.
-  specialize (TC' _ _ Heqo). destruct TC'. destruct H4.
-  simpl in H4.
-  rewrite H4. simpl.
-  f_equal. rewrite Hge; simpl. rewrite H4. reflexivity.
-}
-
-apply andp_right.
-- unfold liftx, lift; simpl. intros ? _. simpl. unfold subst.
-  change ((`(force_val1 (sem_cast (typeof e) t)) (eval_expr e) rho)) with (eval_expr (Ecast e t) rho).
-  rewrite H4.
-  unfold eval_id at 1. unfold force_val; simpl.
-  rewrite Map.gss. auto.
-- unfold liftx, lift; simpl.
-  unfold subst. simpl.
-  change ((`(force_val1 (sem_cast (typeof e) t)) (eval_expr e) rho)) with (eval_expr (Ecast e t) rho).
-  rewrite H4; trivial.
+  intros.
+  apply semax_pre with (▷ tc_expr Delta (Ecast e t) ∧ ▷ P), semax_straight_simple.
+  { intros. rewrite bi.and_elim_r !bi.later_and //. }
+  { apply _. }
+  intros until f; intros TS TC Hcl Hge HGG.
+  assert (typecheck_environ Delta rho) as TYCON_ENV
+    by (destruct TC as [TC' TC'']; eapply typecheck_environ_sub; eauto).
+  iIntros "(Hm & H)".
+  iExists m, (Maps.PTree.set id (eval_expr (Ecast e t) rho) te), _.
+  destruct TS as [TS _]; specialize (TS id).
+  unfold typeof_temp in H99.
+  destruct (temp_types Delta !! id) eqn: Hid; inversion H99; subst t0; clear H99.
+  monPred.unseal.
+  iSplit; [iSplit; first done; iSplit|].
+  + rewrite (bi.and_elim_l (▷ _)) /tc_expr /= typecheck_cast_sound; last apply typecheck_expr_sound; try done.
+    iDestruct "H" as ">%"; iPureIntro.
+    simpl in *. rewrite <- map_ptree_rel.
+    apply guard_environ_put_te'; [subst; auto|].
+    intros ? Hid'; rewrite Hid' in TS; inv TS.
+    by apply tc_val_tc_val'.
+  + iAssert (▷ ⌜Clight.eval_expr ge ve te m (Ecast e t) (eval_expr (Ecast e t) rho)⌝) with "[-]" as ">%"; last by iPureIntro; constructor.
+    iNext; iApply eval_expr_relate; [done..|].
+    iDestruct "H" as "($ & _)"; iFrame.
+  + iIntros "!> !>".
+    iDestruct "H" as "(_ & F & P)"; iFrame.
+    erewrite (closed_wrt_modvars_set F) by eauto; iFrame.
+    iNext; iExists (eval_id id rho).
+    destruct TC as [[TC _] _].
+    destruct (temp_types Delta' !! id) eqn: Hid'; inv TS.
+    destruct (TC _ _ Hid') as (? & ? & ?).
+    super_unfold_lift; erewrite !subst_set by eauto; iFrame.
+    rewrite /eval_id /force_val -map_ptree_rel Map.gss //.
 Qed.
 
 Lemma eval_cast_Vundef:
@@ -924,10 +450,8 @@ Proof.
  reflexivity.
 Qed.
 
-Transparent Int.repr.
-
 Lemma eqb_attr_true:
-  forall a a',  eqb_attr a a' = true  -> a=a'.
+  forall a a', eqb_attr a a' = true -> a=a'.
 Proof.
 intros.
 destruct a as [v a],a' as [v' a'].
@@ -939,301 +463,160 @@ destruct a,a'; inv H0; auto;
 apply Neqb_ok in H1; subst n0; auto.
 Qed.
 
-Opaque Int.repr.
-
 Lemma semax_load:
-forall (Delta: tycontext) sh id P e1 t2 v2,
+forall E (Delta: tycontext) sh id (P: assert) e1 t2 (v2: val),
     typeof_temp Delta id = Some t2 ->
     is_neutral_cast (typeof e1) t2 = true ->
     readable_share sh ->
-   (forall rho, seplog.derives (!! typecheck_environ Delta rho && P rho) (mapsto sh (typeof e1) (eval_lvalue e1 rho) v2 * TT)) ->
-    semax Espec Delta
-       (fun rho => |>
-        (tc_lvalue Delta e1 rho
-        && (!! tc_val (typeof e1) v2) && P rho))
+   (local (typecheck_environ Delta) ∧ P ⊢ <absorb> assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2))) ->
+    semax OK_spec E Delta
+       (▷
+        (tc_lvalue Delta e1
+        ∧ (⌜tc_val (typeof e1) v2⌝ ∧ P)))
        (Sset id e1)
-       (normal_ret_assert (fun rho =>
-        EX old:val, (!!(eval_id id rho = v2) &&
-                         (subst id (`old) P rho)))).
+       (normal_ret_assert (
+        ∃ old:val, (local (fun rho => eval_id id rho = v2) ∧
+                         assert_of (subst id (`old) P)))).
 Proof.
-intros until v2.
-intros Hid TC1 H_READABLE H99.
-replace (fun rho : environ => |> ((tc_lvalue Delta e1 rho &&
-  !! tc_val (typeof e1) v2 && P rho)))
- with (fun rho : environ =>
-   ( |> tc_lvalue Delta e1 rho &&
-     |> !! (tc_val (typeof e1) v2) &&
-     |> P rho)).
-2 : { extensionality rho. repeat rewrite <- later_andp. f_equal. }
-repeat rewrite andp_assoc.
-unfold mapsto.
-apply semax_straight_simple.
-intro. apply boxy_andp; auto.
-intros jm jm1 Delta' ge ve te rho k F f TS [TC2 TC3] TC' Hcl Hge ? ? HGG'.
-specialize (TC2 (m_phi jm1) (age_laterR (age_jm_phi H))).
-specialize (TC3 (m_phi jm1) (age_laterR (age_jm_phi H))).
-assert (typecheck_environ Delta rho) as TC.
-{ destruct TC'. eapply typecheck_environ_sub; eauto. }
-pose proof TC2 as TC2'.
-apply (tc_lvalue_sub _ _ _ TS) in TC2'; [| auto].
-hnf in TC3.
-apply (typeof_temp_sub _ _ TS) in Hid.
-assert (H99': forall rho : environ,
-      !!typecheck_environ Delta' rho && P rho
-      |-- mapsto sh (typeof e1) (eval_lvalue e1 rho) v2 * TT).
-intro; eapply derives_trans; [ | apply H99]; apply andp_derives; auto.
-intros ? ?; do 3 red.
-eapply typecheck_environ_sub; eauto.
-clear H99.
-destruct (eval_lvalue_relate _ _ _ _ _ e1 jm1 HGG' Hge (guard_environ_e1 _ _ _ TC')) as [b [ofs [? ?]]]; auto.
-rewrite <- (age_jm_dry H) in H1.
-exists jm1.
-exists (PTree.set id v2 te).
-econstructor; split; [reflexivity | ].
-split3.
-apply age_level; auto. simpl.
-rewrite <- map_ptree_rel.
-apply guard_environ_put_te'.
-unfold typecheck_temp_id in *.
-unfold construct_rho in *. destruct rho; inv Hge; auto.
-clear - H_READABLE Hid TC1 TC2 TC3 TC' H2 Hge H0 H99'.
-intros. simpl in TC1.
-unfold typeof_temp in Hid. rewrite H in Hid.
-inv Hid.
-apply tc_val_tc_val'.
-apply (neutral_cast_subsumption _ t2 _ TC1 TC3).
-(* typechecking proof *)
-split; [split3 | ].
-* simpl.
-   rewrite <- (age_jm_dry H); constructor; auto.
-   apply Clight.eval_Elvalue with b ofs Full; auto.
-   destruct H0 as [H0 _].
-   assert ((|> (F rho * P rho))%pred
-       (m_phi jm)).
-   rewrite later_sepcon.
-   eapply sepcon_derives; try apply H0; auto.
-   specialize (H3 _ (age_laterR (age_jm_phi H))).
-   rewrite sepcon_comm in H3.
-   assert ((mapsto sh (typeof e1) (eval_lvalue e1 rho) v2 * TT)%pred (m_phi jm1)).
-   rewrite <- TT_sepcon_TT. rewrite <- sepcon_assoc.
-   eapply sepcon_derives; try apply H3; auto.
-   eapply derives_trans; [ | apply H99'].
-   apply andp_right; auto. intros ? _ ; do 3 red. destruct TC'; auto.
-   clear H3; rename H4 into H3.
-   destruct H3 as [m1 [m2 [? [? _]]]].
-   unfold mapsto in H4.
-   revert H4; case_eq (access_mode (typeof e1)); intros; try contradiction.
-   rename m into ch.
-   rewrite H2 in H5.
-   destruct (type_is_volatile (typeof e1)); try contradiction.
-   rewrite if_true in H5 by auto.
-   destruct H5 as [[H5' H5] | [H5 _]]; [ | rewrite H5 in TC3; exfalso; revert TC3; apply tc_val_Vundef].
-   assert (core_load ch  (b, Ptrofs.unsigned ofs) v2 (m_phi jm1)).
-   apply mapsto_core_load with sh.
-   exists m1; exists m2; split3; auto.
-   apply Clight.deref_loc_value with ch; auto.
-   unfold loadv.
-   rewrite (age_jm_dry H).
-   apply core_load_load.
-   intros.
-   destruct H6 as [bl [_ ?]]. specialize (H6 (b,z)). hnf in H6.
-   rewrite if_true in H6 by (split; auto; lia).
-   destruct H6 as [? [? ?]]. rewrite H6. simpl.
-   clear - x0.
-   unfold perm_of_sh. if_tac. if_tac; constructor. if_tac; [ | contradiction]. constructor.
-   apply H6.
-* apply age1_resource_decay; auto.
-* split; [apply age_level; auto|].
-  apply age1_ghost_of, age_jm_phi; auto.
-* rewrite <- map_ptree_rel.
-  rewrite <- (Hcl rho (Map.set id v2 (make_tenv te))).
- +normalize.
-   exists (eval_id id rho).
-   destruct H0.
-   apply later_sepcon2 in H0.
-   specialize (H0 _ (age_laterR (age_jm_phi H))).
-   split; [ |  apply pred_hereditary with (m_phi jm); auto; apply age_jm_phi; eauto].
-   eapply sepcon_derives; try apply H0; auto.
-   assert (env_set
-         (mkEnviron (ge_of rho) (ve_of rho) (Map.set id v2 (make_tenv te))) id
-         (eval_id id rho) = rho).
-  unfold env_set. simpl.
-  rewrite Map.override. unfold eval_id.
-  destruct TC' as [TC' _].
-  unfold typecheck_environ in TC'. repeat rewrite andb_true_iff in TC'. destruct TC' as [TC'[ _ _]].
-  unfold typecheck_temp_environ in *.
-  specialize (TC' id).
-  unfold typeof_temp in Hid. destruct ((temp_types Delta') ! id); inv Hid.
-  specialize (TC' _ (eq_refl _)).
-   destruct TC'. destruct H4. rewrite H4. simpl.
-  rewrite Map.override_same; subst; auto.
-  unfold liftx, lift; simpl. unfold subst.
-  rewrite H4.
-  apply andp_right; auto.
-  intros ? ?; simpl.
-  unfold eval_id, force_val. simpl. rewrite Map.gss. auto.
- +intro i; destruct (Pos.eq_dec id i); [left; auto | right; rewrite Map.gso; auto].
-   subst; unfold modifiedvars, modifiedvars', insert_idset.
-   rewrite PTree.gss; hnf; auto.
-   subst. auto.
+  intros until v2.
+  intros Hid0 TC1 H_READABLE H99.
+  apply semax_pre with (
+     (▷ tc_lvalue Delta e1 ∧
+      ▷ ⌜tc_val (typeof e1) v2⌝) ∧
+      ▷ P), semax_straight_simple.
+  { intros. rewrite bi.and_elim_r !bi.later_and !assoc //. }
+  { apply _. }
+  intros until f; intros TS TC Hcl Hge HGG.
+  iIntros "(Hm & H)".
+  monPred.unseal.
+  rewrite (bi.and_comm _ (▷⌜_⌝)) -assoc; iDestruct "H" as "(>% & H)".
+  assert (typecheck_environ Delta rho) as TYCON_ENV
+    by (destruct TC as [TC' TC'']; eapply typecheck_environ_sub; eauto).
+  iExists m, (Maps.PTree.set id v2 te), _.
+  destruct TS as [TS _]; specialize (TS id).
+  unfold typeof_temp in Hid0.
+  destruct (temp_types Delta !! id) eqn: Hid; inversion Hid0; subst t; clear Hid0.
+  iSplit; [iSplit; first done; iSplit|].
+  + rewrite (bi.and_elim_l (▷ _)) /tc_lvalue /= typecheck_lvalue_sound; try done.
+    iDestruct "H" as ">%"; iPureIntro.
+    rewrite <- map_ptree_rel.
+    apply guard_environ_put_te'; [subst; auto|].
+    intros ? Hid'; rewrite Hid' in TS; inv TS.
+    by eapply tc_val_tc_val', neutral_cast_subsumption.
+  + iCombine "Hm H" as "H"; rewrite (add_and (_ ∗ _) (▷_)); last by iIntros "H"; iNext; iDestruct "H" as "(Hm & H & _)"; iApply (eval_lvalue_relate with "[$Hm $H]").
+    iDestruct "H" as "((Hm & H) & >%Heval)".
+    destruct Heval as (b & ofs & ? & He1).
+    iAssert (▷ <absorb> mapsto sh (typeof e1) (eval_lvalue e1 rho) v2) with "[H]" as "H".
+    { iNext; iDestruct "H" as "(_ & _ & H)".
+      inversion H99 as [H']. setoid_rewrite monPred_at_absorbingly in H'; iApply H'; monPred.unseal; auto. }
+    rewrite (add_and (▷ _) (▷ _)); last by rewrite mapsto_pure_facts.
+    iDestruct "H" as "(H & >%Hty)".
+    destruct Hty as ((ch & ?) & ?).
+    rewrite He1 mapsto_core_load; try done.
+    iAssert (▷ ⌜load ch m b (Ptrofs.unsigned ofs) = Some v2⌝) with "[-]" as ">%".
+    { iNext; rewrite absorbing; iApply core_load_load'; iFrame. }
+    iPureIntro; constructor; econstructor; eauto.
+    eapply Clight.deref_loc_value; eauto.
+    { by intros ->; eapply tc_val_Vundef. }
+  + iIntros "!> !>".
+    iDestruct "H" as "(_ & F & P)"; iFrame.
+    erewrite (closed_wrt_modvars_set F) by eauto; iFrame.
+    iNext; iExists (eval_id id rho); iSplit.
+    * rewrite /lift1 /eval_id -map_ptree_rel /= Map.gss //.
+    * destruct TC as [[TC _] _].
+      destruct (temp_types Delta' !! id) eqn: Hid'; inv TS.
+      destruct (TC _ _ Hid') as (? & ? & ?).
+      super_unfold_lift; erewrite !subst_set by eauto; iFrame.
 Qed.
 
+Lemma mapsto_tc' : forall sh t p v, mapsto sh t p v ⊢ ⌜tc_val' t v⌝.
+Proof.
+  intros; rewrite /mapsto.
+  iIntros "H".
+  destruct (access_mode t); try done.
+  destruct (type_is_volatile t); try done.
+  destruct p; try done.
+  if_tac.
+  - iDestruct "H" as "[(% & _) | (% & _)]"; iPureIntro; by [apply tc_val_tc_val' | subst; apply tc_val'_Vundef].
+  - iDestruct "H" as "(($ & _) & _)".
+Qed.
+
+Lemma mapsto_tc : forall sh t p v, v <> Vundef -> mapsto sh t p v ⊢ ⌜tc_val t v⌝.
+Proof.
+  intros; rewrite mapsto_tc'; iPureIntro.
+  by intros X; apply X.
+Qed.
 
 Lemma semax_cast_load:
-forall (Delta: tycontext) sh id P e1 t1 v2,
+forall E (Delta: tycontext) sh id (P: assert) e1 t1 (v2: val),
     typeof_temp Delta id = Some t1 ->
    cast_pointer_to_bool (typeof e1) t1 = false ->
     readable_share sh ->
-   (forall rho, seplog.derives (!! typecheck_environ Delta rho && P rho) (mapsto sh (typeof e1) (eval_lvalue e1 rho) v2 * TT)) ->
-    semax Espec Delta
-       (fun rho => |>
-        (tc_lvalue Delta e1 rho
-        && (!! tc_val t1 (`(eval_cast (typeof e1) t1 v2) rho))
-        &&  P rho))
+   (local (typecheck_environ Delta) ∧ P ⊢ <absorb> assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2))) ->
+    semax OK_spec E Delta
+       (▷
+        (tc_lvalue Delta e1
+        ∧ local (`(tc_val t1) (`(eval_cast (typeof e1) t1 v2)))
+        ∧ P))
        (Sset id (Ecast e1 t1))
-       (normal_ret_assert (fun rho =>
-        EX old:val, (!!(eval_id id rho = (`(eval_cast (typeof e1) t1 v2)) rho) &&
-                         (subst id (`old) P rho)))).
+       (normal_ret_assert (
+        ∃ old:val, local (fun rho => eval_id id rho = (`(eval_cast (typeof e1) t1 v2)) rho) ∧
+                         assert_of (subst id (`old) P))).
 Proof.
-intros until v2.
-intros Hid HCAST H_READABLE H99.
-replace (fun rho : environ => |> ((tc_lvalue Delta e1 rho &&
-       (!! tc_val t1  (`(eval_cast (typeof e1) t1 v2) rho)) &&
-       P rho)))
- with (fun rho : environ =>
-   ( |> tc_lvalue Delta e1 rho &&
-     |> !! (tc_val t1 (eval_cast (typeof e1) t1 v2)) &&
-     |> P rho)).
-2 : { extensionality rho. repeat rewrite <- later_andp. f_equal. }
-repeat rewrite andp_assoc.
-unfold mapsto.
-apply semax_straight_simple.
-intro. apply boxy_andp; auto.
-intros jm jm1 Delta' ge ve te rho k F f TS [TC2 TC3] TC' Hcl Hge ? ? HGG'.
-specialize (TC2 (m_phi jm1) (age_laterR (age_jm_phi H))).
-specialize (TC3 (m_phi jm1) (age_laterR (age_jm_phi H))).
-assert (typecheck_environ Delta rho) as TC.
-{ destruct TC'. eapply typecheck_environ_sub; eauto. }
-pose proof TC2 as TC2'.
-apply (tc_lvalue_sub _ _ _ TS) in TC2'; [| auto].
-hnf in TC3.
-apply (typeof_temp_sub _ _ TS) in Hid.
-assert (H99': forall rho : environ,
-      !!typecheck_environ Delta' rho && P rho
-      |-- mapsto sh (typeof e1) (eval_lvalue e1 rho) v2 * TT).
-{ intros.
-  intro; eapply derives_trans; [ | apply H99]; apply andp_derives; auto.
-  intros ? ?; do 3 red.
-  eapply typecheck_environ_sub; eauto.
-}
-clear H99.
-destruct (eval_lvalue_relate _ _ _ _ _ e1 jm1 HGG' Hge (guard_environ_e1 _ _ _ TC')) as [b [ofs [? ?]]]; auto.
-rewrite <- (age_jm_dry H) in H1.
-exists jm1.
-exists (PTree.set id (eval_cast (typeof e1) t1 v2) (te)).
-econstructor.
-split.
-reflexivity.
-split3.
-apply age_level; auto. simpl.
-rewrite <- map_ptree_rel.
-apply guard_environ_put_te'.
-unfold typecheck_temp_id in *.
-unfold construct_rho in *. destruct rho; inv Hge; auto.
-clear - H_READABLE Hid TC2 TC3 TC' H2 Hge H0 H99'.
-intros.
-unfold typeof_temp in Hid. rewrite H in Hid.
-inv Hid.
-simpl.
-apply tc_val_tc_val'.
-apply TC3.
-split; [split3 | ].
-*   rewrite <- (age_jm_dry H); constructor; auto.
-  destruct (sem_cast (typeof e1) t1 v2) eqn:EC.
-  2: exfalso; clear - EC TC3;
-    unfold eval_cast, force_val1 in TC3; rewrite EC in TC3;
-    destruct t1; try destruct f;
-    try destruct (eqb_type _ _); contradiction.
-  destruct H0 as [H0 _].
-   assert ((|> (F rho * P rho))%pred (m_phi jm)). {
-    rewrite later_sepcon.
-    eapply sepcon_derives; try apply H0; auto.
-  }
-  specialize (H3 _ (age_laterR (age_jm_phi H))).
-  rewrite sepcon_comm in H3.
-  assert ((mapsto sh (typeof e1) (eval_lvalue e1 rho) v2 * TT)%pred (m_phi jm1)). {
-    rewrite <- TT_sepcon_TT. rewrite <- sepcon_assoc.
-    eapply sepcon_derives; try apply H3; auto.
-    eapply derives_trans; [ | apply H99'].
-    apply andp_right; auto. intros ? _ ; do 3 red. destruct TC'; auto.
- }
-   clear H3; rename H4 into H3.
-   destruct H3 as [m1 [m2 [? [? _]]]].
-   unfold mapsto in H4.
-   revert H4; case_eq (access_mode (typeof e1)); intros; try contradiction.
-   rename m into ch.
-   destruct (type_is_volatile (typeof e1)) eqn:NONVOL; try contradiction.
-   rewrite H2 in H5.
-   rewrite if_true in H5 by auto.
-   destruct H5 as [[H5' H5] | [H5 _]];
-    [ | hnf in TC3; rewrite H5, eval_cast_Vundef in TC3; exfalso; revert TC3; apply tc_val_Vundef].
-   apply Clight.eval_Ecast with v2.
-  2: apply sem_cast_e1; auto;
-      unfold eval_cast, force_val1; rewrite !EC; reflexivity.
-   eapply Clight.eval_Elvalue; eauto.
-   assert (core_load ch  (b, Ptrofs.unsigned ofs) v2 (m_phi jm1)).
-   apply mapsto_core_load with sh.
-   exists m1; exists m2; split3; auto.
-   apply Clight.deref_loc_value with ch; auto.
-   unfold loadv.
-   rewrite (age_jm_dry H).
-   apply core_load_load.
-   intros.
-   destruct H6 as [bl [_ ?]]. specialize (H6 (b,z)). hnf in H6.
-   rewrite if_true in H6 by (split; auto; lia).
-   destruct H6 as [? [? ?]]. rewrite H6. simpl.
-   clear - x0.
-   unfold perm_of_sh. if_tac. if_tac; constructor. if_tac; [ | contradiction]. constructor.
-   apply H6.
-* apply age1_resource_decay; auto.
-* split; [apply age_level; auto|].
-  apply age1_ghost_of, age_jm_phi; auto.
-* rewrite <- map_ptree_rel.
-  rewrite <- (Hcl rho (Map.set id (eval_cast (typeof e1) t1 v2) (make_tenv te))).
- + normalize.
-   exists (eval_id id rho).
-   destruct H0.
-   apply later_sepcon2 in H0.
-   specialize (H0 _ (age_laterR (age_jm_phi H))).
-   split; [ |  apply pred_hereditary with (m_phi jm); auto; apply age_jm_phi; eauto].
-   eapply sepcon_derives; try apply H0; auto.
-   assert (env_set
-         (mkEnviron (ge_of rho) (ve_of rho) (Map.set id (eval_cast (typeof e1) t1 v2) (make_tenv te))) id
-         (eval_id id rho) = rho).
-  unfold env_set. simpl.
-  rewrite Map.override. unfold eval_id.
-  destruct TC' as [TC' _].
-  unfold typecheck_environ in TC'. repeat rewrite andb_true_iff in TC'. destruct TC' as [TC'[ _ _]].
-  unfold typecheck_temp_environ in *.
-  specialize (TC' id).
-  unfold typeof_temp in Hid. destruct ((temp_types Delta') ! id); inv Hid.
-  specialize (TC' _ (eq_refl _)).
-   destruct TC'. destruct H4. rewrite H4. simpl.
-  rewrite Map.override_same; subst; auto.
-  unfold subst. simpl.
-  apply andp_right; auto.
-  - intros ? ?; simpl. unfold liftx, lift; simpl.
-    unfold eval_id, force_val. simpl. rewrite Map.gss. auto.
-  - unfold eval_cast, force_val1 in H4. unfold liftx, lift; simpl. rewrite H4; trivial.
- + intro i; destruct (Pos.eq_dec id i); [left; auto | right; rewrite Map.gso; auto].
-   subst; unfold modifiedvars, modifiedvars', insert_idset.
-   rewrite PTree.gss; hnf; auto.
-   subst. auto.
-Qed.
-
-Lemma res_option_core: forall r, res_option (core r) = None.
-Proof.
- destruct r. rewrite core_NO; auto. rewrite core_YES; auto. rewrite core_PURE; auto.
+  intros until v2.
+  intros Hid0 HCAST H_READABLE H99.
+  apply semax_pre with (
+     (▷ tc_lvalue Delta e1 ∧
+      ▷ local (`(tc_val t1) (`(eval_cast (typeof e1) t1 v2)))) ∧
+      ▷ P), semax_straight_simple.
+  { intros. rewrite bi.and_elim_r !bi.later_and !assoc //. }
+  { apply _. }
+  intros until f; intros TS TC Hcl Hge HGG.
+  iIntros "(Hm & H)".
+  monPred.unseal.
+  rewrite (bi.and_comm _ (▷⌜_⌝)) -assoc; iDestruct "H" as "(>% & H)".
+  assert (typecheck_environ Delta rho) as TYCON_ENV
+    by (destruct TC as [TC' TC'']; eapply typecheck_environ_sub; eauto).
+  iExists m, (Maps.PTree.set id (eval_cast (typeof e1) t1 v2) te), _.
+  destruct TS as [TS _]; specialize (TS id).
+  unfold typeof_temp in Hid0.
+  destruct (temp_types Delta !! id) eqn: Hid; inversion Hid0; subst t; clear Hid0.
+  iSplit; [iSplit; first done; iSplit|].
+  + iPureIntro.
+    rewrite <- map_ptree_rel.
+    apply guard_environ_put_te'; [subst; auto|].
+    intros ? Hid'; rewrite Hid' in TS; inv TS.
+    by eapply tc_val_tc_val'.
+  + iCombine "Hm H" as "H"; rewrite (add_and (_ ∗ _) (▷_)); last by iIntros "H"; iNext; iDestruct "H" as "(Hm & H & _)"; iApply (eval_lvalue_relate with "[$Hm $H]").
+    iDestruct "H" as "((Hm & H) & >%Heval)".
+    destruct Heval as (b & ofs & ? & He1).
+    iAssert (▷ <absorb> mapsto sh (typeof e1) (eval_lvalue e1 rho) v2) with "[H]" as "H".
+    { iNext; iDestruct "H" as "(_ & _ & H)".
+      inversion H99 as [H']. setoid_rewrite monPred_at_absorbingly in H'; iApply H'; monPred.unseal; auto. }
+    rewrite (add_and (▷ _) (▷ _)); last by rewrite mapsto_pure_facts.
+    iDestruct "H" as "(H & >%Hty)".
+    destruct Hty as ((ch & ?) & ?).
+    super_unfold_lift.
+    assert (v2 <> Vundef) by (intros ->; setoid_rewrite eval_cast_Vundef in H; eapply tc_val_Vundef; eauto).
+    rewrite (add_and (▷ _) (▷ _)); last by rewrite mapsto_tc.
+    iDestruct "H" as "(H & >%)".
+    rewrite He1 mapsto_core_load; try done.
+    iAssert (▷ ⌜load ch m b (Ptrofs.unsigned ofs) = Some v2⌝) with "[-]" as ">%".
+    { iNext; rewrite absorbing; iApply core_load_load'; iFrame. }
+    iPureIntro. constructor; econstructor; [econstructor|]; eauto.
+    * eapply Clight.deref_loc_value; eauto.
+    * unfold eval_cast, force_val1 in *; super_unfold_lift.
+      destruct ((sem_cast (typeof e1) t1) v2) eqn: Hcast; last by apply tc_val_Vundef in H.
+      apply sem_cast_e1; auto.
+  + iIntros "!> !>".
+    iDestruct "H" as "(_ & F & P)"; iFrame.
+    erewrite (closed_wrt_modvars_set F) by eauto; iFrame.
+    iNext; iExists (eval_id id rho); iSplit.
+    * rewrite /lift1 /eval_id -map_ptree_rel /= Map.gss //.
+    * destruct TC as [[TC _] _].
+      destruct (temp_types Delta' !! id) eqn: Hid'; inv TS.
+      destruct (TC _ _ Hid') as (? & ? & ?).
+      super_unfold_lift; erewrite !subst_set by eauto; iFrame.
 Qed.
 
 Lemma writable0_lub_retainer_Rsh:
@@ -1241,95 +624,15 @@ Lemma writable0_lub_retainer_Rsh:
   Share.lub (retainer_part sh) Share.Rsh = sh.
   intros. symmetry.
   unfold retainer_part.
-  rewrite (comp_parts comp_Lsh_Rsh sh) at 1.
+  rewrite -> (comp_parts comp_Lsh_Rsh sh) at 1.
   f_equal; auto.
   unfold writable0_share in H.
   apply leq_join_sub in H.  apply Share.ord_spec1 in H. auto.
 Qed.
 
-Definition decode_encode_val_ok (chunk1 chunk2: memory_chunk) : Prop :=
-  match chunk1, chunk2 with
-  | Mbool, Mbool => True
-  | Mint8signed, Mint8signed => True
-  | Mint8unsigned, Mint8signed => True
-  | Mint8signed, Mint8unsigned => True
-  | Mint8unsigned, Mint8unsigned => True
-  | Mint16signed, Mint16signed => True
-  | Mint16unsigned, Mint16signed => True
-  | Mint16signed, Mint16unsigned => True
-  | Mint16unsigned, Mint16unsigned => True
-  | Mint32, Mfloat32 => True
-  | Many32, Many32 => True
-  | Many64, Many64 => True
-  | Mint32, Mint32 => True
-  | Mint64, Mint64 => True
-  | Mint64, Mfloat64 => True
-  | Mfloat64, Mfloat64 =>  True
-  | Mfloat64, Mint64 =>  True
-  | Mfloat32, Mfloat32 =>  True
-  | Mfloat32, Mint32 =>  True
-  | _,_ => False
-  end.
-
-Lemma decode_encode_val_ok_same:  forall ch,
-    decode_encode_val_ok ch ch.
-Proof.
-destruct ch; simpl; auto.
-Qed.
-
-Lemma decode_encode_val_fun:
-  forall ch1 ch2, decode_encode_val_ok ch1 ch2 ->
-  forall v v1 v2,
-     decode_encode_val v ch1 ch2 v1 ->
-     decode_encode_val v ch1 ch2 v2 ->
-     v1=v2.
-Proof.
-intros.
-destruct ch1, ch2; try contradiction;
-destruct v; simpl in *; subst; auto.
-Qed.
-
-Lemma decode_encode_val_ok1:
-  forall v ch ch' v',
- decode_encode_val_ok ch ch' ->
- decode_encode_val v ch ch' v' ->
- decode_val ch' (encode_val ch v) = v'.
-Proof.
-intros.
-destruct ch, ch'; try contradiction;
-destruct v; auto;
-simpl in H0; subst;
-unfold decode_val, encode_val;
-try rewrite proj_inj_bytes;
-rewrite ?decode_encode_int_1, ?decode_encode_int_2,
-  ?decode_encode_int_4,
-  ?decode_encode_int_8;
-f_equal;
-rewrite ?Int.sign_ext_zero_ext by reflexivity;
-rewrite ?Int.zero_ext_sign_ext by reflexivity;
-rewrite ?Int.zero_ext_idem by (compute; congruence);
-auto.
-all: try solve [
-simpl; destruct Archi.ptr64; simpl; auto;
-rewrite proj_sumbool_is_true by auto;
-rewrite proj_sumbool_is_true by auto;
-simpl; auto].
-apply Float32.of_to_bits.
-apply Float.of_to_bits.
-Qed.
-
-Lemma decode_encode_val_size:
-  forall ch1 ch2, decode_encode_val_ok ch1 ch2 ->
-   size_chunk ch1 = size_chunk ch2.
-Proof.
-intros.
-destruct ch1, ch2; try contradiction;
-simpl in *; subst; auto.
-Qed.
-
 Theorem load_store_similar':
    forall (chunk : memory_chunk) (m1 : Memory.mem)
-         (b : block) (ofs : Z) (v : val) (m2 : Memory.mem),
+         (b : Values.block) (ofs : Z) (v : val) (m2 : Memory.mem),
        store chunk m1 b ofs v = Some m2 ->
   forall chunk',
   size_chunk chunk' = size_chunk chunk ->
@@ -1347,166 +650,29 @@ Proof.
   exploit load_result; eauto. intros B.
   rewrite B.
   rewrite (store_mem_contents _ _ _ _ _ _ H).
-  rewrite PMap.gss.
+  rewrite Maps.PMap.gss.
   replace (size_chunk_nat chunk') with (length (encode_val chunk v)).
   rewrite getN_setN_same. apply decode_encode_val_general.
   rewrite encode_val_length. repeat rewrite size_chunk_conv in H0.
   apply Nat2Z.inj; auto.
 Qed.
 
-Lemma address_mapsto_can_store': forall jm ch ch' v sh (wsh: writable0_share sh) b ofs v' my,
-       (address_mapsto ch v sh (b, Ptrofs.unsigned ofs) * exactly my)%pred (m_phi jm) ->
-       decode_encode_val_ok ch ch' ->
-       (align_chunk ch' | Ptrofs.unsigned ofs) ->
-       exists m',
-       {H: Mem.store ch (m_dry jm) b (Ptrofs.unsigned ofs) v' = Some m'|
-       ((EX v'':val, !! (decode_encode_val v' ch ch' v'') &&
-          address_mapsto ch' v'' sh (b, Ptrofs.unsigned ofs)) * exactly my)%pred
-       (m_phi (store_juicy_mem _ _ _ _ _ _ H))}.
+Lemma mapsto_store': forall t t' m ch ch' v v' sh b o m' (Hsh : writable0_share sh)
+  (Hch : access_mode t = By_value ch) (Hch' : access_mode t' = By_value ch')
+  (Hdec : decode_encode_val_ok ch ch') (Ht' : type_is_volatile t' = false)
+  (Halign : (align_chunk ch' | Ptrofs.unsigned o)%Z) (Htc : tc_val' t' (decode_val ch' (encode_val ch v'))),
+  Mem.store ch m b (Ptrofs.unsigned o) v' = Some m' ->
+  mem_auth m ∗ mapsto sh t (Vptr b o) v ⊢ |==> mem_auth m' ∗ ∃ v'', ⌜decode_encode_val v' ch ch' v''⌝ ∧ mapsto sh t' (Vptr b o) v''.
 Proof.
-intros * wsh * H OK AL.
-destruct (mapsto_can_store ch v sh wsh b (Ptrofs.unsigned ofs) jm v') as [m' STORE]; auto.
-eapply sepcon_derives; eauto.
-exists m'.
-exists STORE.
-pose proof I.
-destruct H as [m1 [m2 [? [? Hmy]]]].
-do 3 red in Hmy.
-assert (H2 := I); assert (H3 := I).
-forget (Ptrofs.unsigned ofs) as i. clear ofs.
-pose (f loc := if adr_range_dec (b,i) (size_chunk ch) loc
-                      then YES (Share.lub (res_retain (m1 @ loc)) Share.Rsh)
-                               (readable_share_lub (writable0_readable writable0_Rsh))
-                               (VAL (contents_at m' loc)) NoneP
-                     else core (m_phi jm @ loc)).
-destruct (make_rmap f (ghost_of m1) (level jm)) as [mf [? [? Hg]]]; auto.
-{ unfold f, compose; clear f; extensionality loc.
-  symmetry. if_tac.
-  unfold resource_fmap. rewrite preds_fmap_NoneP.
-  reflexivity.
-  generalize (resource_at_approx (m_phi jm) loc);
-  destruct (m_phi jm @ loc); [rewrite core_NO | rewrite core_YES | rewrite core_PURE]; try reflexivity.
-  auto. }
-{ rewrite level_juice_level_phi. apply join_level in H as [<- _]. apply ghost_of_approx. }
-unfold f in H5; clear f.
-exists mf; exists m2; split3; auto.
-apply resource_at_join2.
-rewrite H4. symmetry. apply (level_store_juicy_mem _ _ _ _ _ _ STORE).
-apply join_level in H; destruct H.
-change R.rmap with rmap in *. change R.ag_rmap with ag_rmap in *.
-rewrite H6; symmetry. apply (level_store_juicy_mem _ _ _ _ _ _ STORE).
-intro; rewrite H5. clear mf H4 H5 Hg.
-simpl m_phi.
-apply (resource_at_join _ _ _ loc) in H.
-destruct H1 as [vl [? ?]]. specialize (H4 loc). hnf in H4.
-if_tac.
-destruct H4. hnf in H4. rewrite H4 in H.
-rewrite (proof_irr x (writable0_readable wsh)) in *; clear x.
-destruct (YES_join_full _ _ _ _ _ _ H) as [sh' [nsh' H6]]; auto.
-rewrite H6.
-unfold inflate_store; simpl.
-rewrite resource_at_make_rmap.
-rewrite H6 in H.
-inversion H; clear H.
-subst sh2 k sh p.
-constructor.
-rewrite H4; simpl.
-rewrite writable0_lub_retainer_Rsh; auto.
-apply join_unit1_e in H; auto.
-rewrite H.
-unfold inflate_store.
-rewrite resource_at_make_rmap.
-rewrite resource_at_approx.
-case_eq (m_phi jm @ loc); intros.
-rewrite core_NO. constructor. apply join_unit1; auto.
-destruct k; try solve [rewrite core_YES; constructor; apply join_unit1; auto].
-rewrite core_YES.
-destruct (juicy_mem_contents _ _ _ _ _ _ H6). subst p.
-pose proof (store_phi_elsewhere_eq _ _ _ _ _ _ STORE _ _ _ _ H5 H6).
-rewrite H8.
-constructor.
-apply join_unit1; auto.
-rewrite core_PURE; constructor.
-rewrite Hg; simpl.
-unfold inflate_store; rewrite ghost_of_make_rmap.
-apply ghost_of_join; auto.
-
-unfold address_mapsto in *.
-destruct (load_store_similar' _ _ _ _ _ _ STORE ch' (eq_sym (decode_encode_val_size _ _ OK)))
-  as [v'' [LD DE]]; auto.
-exists v''.
-rewrite prop_true_andp by auto.
-exists (encode_val ch v').
-destruct H1 as [vl [[? [? ?]] ?]].
-split.
-split3; auto.
-rewrite encode_val_length.
-clear - OK. apply decode_encode_val_size in OK.
-   rewrite !size_chunk_conv in OK. apply Nat2Z.inj; auto.
-apply decode_encode_val_ok1; auto.
-
-intro loc. hnf.
-if_tac. exists (writable0_readable wsh).
-hnf; rewrite H5.
-rewrite if_true; auto.
-assert (STORE' := Mem.store_mem_contents _ _ _ _ _ _ STORE).
-pose proof (juicy_mem_contents (store_juicy_mem jm m' ch b i v' STORE)).
-pose proof (juicy_mem_access (store_juicy_mem jm m' ch b i v' STORE)).
-pose proof (juicy_mem_max_access (store_juicy_mem jm m' ch b i v' STORE)).
-pose proof I.
-unfold contents_cohere in H10.
-rewrite preds_fmap_NoneP.
-f_equal.
-specialize (H8 loc). rewrite jam_true in H8 by (rewrite (decode_encode_val_size _ _ OK); auto).
-destruct H8. hnf in H8. rewrite H8. simpl; auto.
-f_equal.
-clear - STORE H1 H9 OK AL DE.
-destruct loc as [b' z].
-destruct H9.
-subst b'.
-rewrite (nth_getN m' b _ _ _ H0).
-rewrite (store_mem_contents _ _ _ _ _ _ STORE).
-rewrite PMap.gss.
-replace (Z.to_nat (size_chunk ch)) with (size_chunk_nat ch) by (destruct ch; simpl; auto).
-rewrite <- (decode_encode_val_size _ _ OK).
-fold (size_chunk_nat ch).
-rewrite <- (encode_val_length ch v').
-rewrite getN_setN_same.
-apply YES_ext.
-apply (writable0_lub_retainer_Rsh _ wsh).
-generalize (size_chunk_pos ch'); lia.
-rewrite (decode_encode_val_size _ _ OK); auto.
-do 3 red. rewrite H5.
-rewrite (decode_encode_val_size _ _ OK).
- rewrite if_false by auto.
-apply core_identity.
-Qed.
-
-
-Lemma address_mapsto_can_store: forall jm ch v sh (wsh: writable0_share sh) b ofs v' my,
-       (address_mapsto ch v sh (b, Ptrofs.unsigned ofs) * exactly my)%pred (m_phi jm) ->
-       decode_val ch (encode_val ch v') = v' ->
-       exists m',
-       {H: Mem.store ch (m_dry jm) b (Ptrofs.unsigned ofs) v' = Some m'|
-       (address_mapsto ch v' sh (b, Ptrofs.unsigned ofs) * exactly my)%pred
-       (m_phi (store_juicy_mem _ _ _ _ _ _ H))}.
-Proof.
-intros.
-pose proof (address_mapsto_can_store' _ _ ch _ _ wsh _ _ v' _ H (decode_encode_val_ok_same _)).
-destruct H1 as [m' [? ?]].
-destruct H as [? [? [_ [[? [[ _ [_ ?]] _]] _]]]]; auto.
-rewrite exp_sepcon1 in a.
-destruct a as [v'' ?].
-rewrite sepcon_andp_prop1 in H1.
-destruct H1.
-do 3 red in H1.
-pose proof (decode_encode_val_general v' ch ch).
-rewrite H0 in H3.
-pose proof (decode_encode_val_fun _ _  (decode_encode_val_ok_same ch) _ _ _  H1 H3).
-subst v''.
-exists m'.
-exists x.
-auto.
+  intros; rewrite /mapsto Hch Hch' Ht'.
+  iIntros "[Hm H]".
+  destruct (type_is_volatile t); try done.
+  rewrite -> !if_true by auto.
+  setoid_rewrite if_true; last auto.
+  assert (forall v'', decode_encode_val v' ch ch' v'' -> tc_val' t' v'') as Htc'.
+  { intros ? Hv''; eapply decode_encode_val_fun in Hv''; last apply decode_encode_val_general; subst; auto. }
+  iDestruct "H" as "[(% & ?) | (% & % & ?)]"; (iMod (mapsto_store' _ _ _ _ v' with "[$]") as "[$ (% & %Hv'' & H)]"; [done..|]; iIntros "!>";
+    iExists _; iSplit; first done; destruct (eq_dec v'' Vundef); [iRight | specialize (Htc' _ Hv'' n); iLeft]; eauto).
 Qed.
 
 Ltac dec_enc :=
@@ -1516,27 +682,24 @@ match goal with
 end.
 
 Lemma load_cast:
- forall (t: type) (e2 : expr) (ch : memory_chunk) rho phi m,
+ forall (t: type) (e2 : expr) (ch : memory_chunk) rho m,
    tc_val (typeof e2) (eval_expr e2 rho) ->
-   denote_tc_assert (isCastResultType (typeof e2) t e2)
-     rho phi ->
    access_mode t = By_value ch ->
-   Val.load_result ch
-     (force_val (Cop.sem_cast (eval_expr e2 rho) (typeof e2) t m)) =
-   force_val (Cop.sem_cast (eval_expr e2 rho) (typeof e2) t m).
+   mem_auth m ∗ denote_tc_assert (isCastResultType (typeof e2) t e2) rho ⊢
+   ⌜Val.load_result ch
+      (force_val (Cop.sem_cast (eval_expr e2 rho) (typeof e2) t m)) =
+    force_val (Cop.sem_cast (eval_expr e2 rho) (typeof e2) t m)⌝.
 Proof.
 intros.
-assert (size_chunk ch = sizeof t). {
-  clear - H1.
-  destruct t as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ], ch; inv H1; reflexivity.
-}
+assert (size_chunk ch = sizeof t) by (symmetry; apply size_chunk_sizeof; auto).
 unfold sizeof in *.
+iIntros "[Hm H]".
 destruct ch;
- destruct t as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ]; try solve [inv H1];
+ destruct t as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ]; try done;
 simpl in *;
- try solve [inv H1]; clear H1; destruct (eval_expr e2 rho);
+ destruct (eval_expr e2 rho);
  destruct (typeof e2) as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ] ;
- try solve [inv H];
+ try done;
 unfold Cop.sem_cast; simpl;
 destruct Archi.ptr64 eqn:Hp;
 try destruct (Float.to_int f);
@@ -1553,168 +716,68 @@ try rewrite Int.zero_ext_idem; auto; simpl; try lia;
 try solve [simple_if_tac; auto].
 Qed.
 
+Local Arguments typecheck_expr : simpl never.
 
 Lemma semax_store:
- forall Delta e1 e2 sh P,
-   writable0_share sh ->
-   semax Espec Delta
-          (fun rho =>
-          |> (tc_lvalue Delta e1 rho && tc_expr Delta (Ecast e2 (typeof e1)) rho  &&
-             (mapsto_ sh (typeof e1) (eval_lvalue e1 rho) * P rho)))
+ forall E Delta e1 e2 sh P (WS : writable0_share sh),
+   semax OK_spec E Delta
+          (▷ ((tc_lvalue Delta e1 ∧ tc_expr Delta (Ecast e2 (typeof e1))) ∧
+             (assert_of (`(mapsto_ sh (typeof e1)) (eval_lvalue e1)) ∗ P)))
           (Sassign e1 e2)
-          (normal_ret_assert (fun rho => mapsto sh (typeof e1) (eval_lvalue e1 rho)
-                                           (force_val (sem_cast  (typeof e2) (typeof e1) (eval_expr e2 rho))) * P rho)).
+          (normal_ret_assert (assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`force_val (`(sem_cast (typeof e2) (typeof e1)) (eval_expr e2)))) ∗ P)).
 Proof.
-intros until P. intros WS.
-apply semax_pre with
-  (fun rho : environ =>
-   EX v3: val,
-      |> tc_lvalue Delta e1 rho && |> tc_expr Delta (Ecast e2 (typeof e1)) rho &&
-      |> (mapsto sh (typeof e1) (eval_lvalue e1 rho) v3 * P rho)).
-intro. apply andp_left2.
-unfold mapsto_.
-apply exp_right with Vundef.
-repeat rewrite later_andp; auto.
-apply extract_exists_pre; intro v3.
-apply semax_straight_simple; auto.
-intros jm jm1 Delta' ge ve te rho k F f TS [TC1 TC2] TC4 Hcl Hge Hage [H0 H0'] HGG'.
-specialize (TC1 (m_phi jm1) (age_laterR (age_jm_phi Hage))).
-specialize (TC2 (m_phi jm1) (age_laterR (age_jm_phi Hage))).
-assert (typecheck_environ Delta rho) as TC.
-{ destruct TC4. eapply typecheck_environ_sub; eauto. }
-pose proof TC1 as TC1'.
-pose proof TC2 as TC2'.
-apply (tc_lvalue_sub _ _ _ TS) in TC1'; [| auto].
-apply (tc_expr_sub _ _ _ TS) in TC2'; [| auto].
-unfold tc_expr in TC2, TC2'; simpl in TC2, TC2'.
-rewrite denote_tc_assert_andp in TC2, TC2'.
-simpl in TC2,TC2'; super_unfold_lift.
-destruct TC2 as [TC2 TC3].
-destruct TC2' as [TC2' TC3'].
-apply later_sepcon2 in H0.
-specialize (H0 _ (age_laterR (age_jm_phi Hage))).
-pose proof I.
-destruct H0 as [?w [?w [? [? [?w [?w [H3 [H4 H5]]]]]]]].
-unfold mapsto in H4.
-revert H4; case_eq (access_mode (typeof e1)); intros; try contradiction.
-rename H2 into Hmode. rename m into ch.
-destruct (eval_lvalue_relate _ _ _ _ _ e1 jm1 HGG' Hge (guard_environ_e1 _ _ _ TC4)) as [b0 [i [He1 He1']]]; auto.
-rewrite He1' in *.
-destruct (join_assoc H3 (join_comm H0)) as [?w [H6 H7]].
-destruct (type_is_volatile (typeof e1)) eqn:NONVOL; try contradiction.
-rewrite if_true in H4 by auto.
-assert (exists v, address_mapsto ch v
-             sh
-        (b0, Ptrofs.unsigned i) w1)
-       by (destruct H4 as [[H4' H4] |[? [? ?]]]; eauto).
-clear v3 H4; destruct H2 as [v3 H4].
-
-assert (H11': (res_predicates.address_mapsto ch v3 sh
-        (b0, Ptrofs.unsigned i) * TT)%pred (m_phi jm1))
- by (exists w1; exists w3; split3; auto).
-assert (H11: (res_predicates.address_mapsto ch v3  sh
-        (b0, Ptrofs.unsigned i) * exactly w3)%pred (m_phi jm1)).
-{ exists w1; exists w3; split3; auto.
-  hnf; eauto. }
-apply address_mapsto_can_store
-   with (v':=((force_val (Cop.sem_cast (eval_expr e2 rho) (typeof e2) (typeof e1) (m_dry jm1))))) in H11;
-  auto.
-2: {
-  unfold typecheck_store in *.
-  destruct TC4 as [TC4 _].
-  simpl in TC2'. apply typecheck_expr_sound in TC2'; auto.
-  remember (eval_expr e2 rho).
-  dec_enc. rewrite DE. clear DE. subst.
-  eapply load_cast; eauto.
-}
-destruct H11 as [m' [H11 AM]].
-exists (store_juicy_mem _ _ _ _ _ _ H11).
-exists (te);  exists rho; split3; auto.
-subst; simpl; auto.
-rewrite level_store_juicy_mem. apply age_level; auto.
-split; auto.
-split.
-split3; auto.
-generalize (eval_expr_relate _ _ _ _ _ e2 jm1 HGG' Hge (guard_environ_e1 _ _ _ TC4)); intro.
-spec H2; [ assumption | ].
-rewrite <- (age_jm_dry Hage) in H2, He1.
-econstructor; try eassumption.
-unfold tc_lvalue in TC1. simpl in TC1.
-auto.
-instantiate (1:=(force_val (Cop.sem_cast (eval_expr e2 rho) (typeof e2) (typeof e1) (m_dry jm)))).
-rewrite (age_jm_dry Hage).
-rewrite cop2_sem_cast'; auto.
-2: eapply typecheck_expr_sound; eauto.
-eapply cast_exists; eauto. destruct TC4; auto.
-eapply Clight.assign_loc_value.
-apply Hmode.
-unfold tc_lvalue in TC1. simpl in TC1.
-auto.
-unfold Mem.storev.
-simpl m_dry.
-rewrite (age_jm_dry Hage).
-auto.
-apply (resource_decay_trans _ (nextblock (m_dry jm1)) _ (m_phi jm1)).
-rewrite (age_jm_dry Hage); lia.
-apply (age1_resource_decay _ _ Hage).
-apply resource_nodecay_decay.
-apply juicy_store_nodecay.
-{intros.
- clear - H11' H2 WS.
- destruct H11' as [phi1 [phi2 [? [? ?]]]].
- destruct H0 as [bl [_ ?]]. specialize  (H0 (b0,z)).
- hnf in H0. rewrite if_true in H0 by (split; auto; lia).
- destruct H0. hnf in H0.
- apply (resource_at_join _ _ _ (b0,z)) in H.
- rewrite H0 in H.
- inv H; simpl; apply join_writable01 in RJ; auto;
- unfold perm_of_sh; rewrite if_true by auto; if_tac; constructor.
-}
-rewrite level_store_juicy_mem. split; [apply age_level; auto|].
-simpl. unfold inflate_store; rewrite ghost_of_make_rmap.
-apply age1_ghost_of, age_jm_phi; auto.
-split.
-2 : { eapply (corable_core _ (m_phi jm1)), pred_hereditary; eauto; [|apply age_jm_phi; auto].
-      symmetry.
-      forget (force_val (Cop.sem_cast (eval_expr e2 rho) (typeof e2) (typeof e1) (m_dry jm1))) as v.
-      apply rmap_ext.
-      do 2 rewrite level_core.
-      rewrite <- level_juice_level_phi; rewrite level_store_juicy_mem.
-      reflexivity.
-      intro loc.
-      unfold store_juicy_mem. simpl.
-      rewrite <- core_resource_at. unfold inflate_store.
-      rewrite resource_at_make_rmap. rewrite <- core_resource_at.
-      case_eq (m_phi jm1 @ loc); intros; auto.
-      destruct k0; simpl resource_fmap; repeat rewrite core_YES; auto.
-      simpl.
-      rewrite !ghost_of_core.
-      unfold inflate_store; rewrite ghost_of_make_rmap; auto.
-}
-rewrite sepcon_comm.
-rewrite sepcon_assoc.
-eapply sepcon_derives; try apply AM; auto.
-unfold mapsto.
-destruct TC4 as [TC4 _].
-
-rewrite Hmode.
-rewrite He1'.
-*
-rewrite cop2_sem_cast'; auto.
-2: eapply typecheck_expr_sound; eauto.
-rewrite NONVOL.
-rewrite if_true by auto.
-apply orp_right1.
-apply andp_right.
-intros ? ?.
-eapply tc_val_sem_cast; eauto.
-intros ? ?. apply H2.
-*
-intros ? ?.
-destruct H2 as (? & H2 & ?).
-destruct (nec_join2 H6 H2) as [w2' [w' [? [? ?]]]].
-eapply pred_upclosed; eauto.
-exists w2'; exists w'; split3; auto; eapply pred_nec_hereditary; eauto.
+  intros.
+  apply semax_pre with
+    (∃ v3: val,
+      (▷ tc_lvalue Delta e1 ∧ ▷ tc_expr Delta (Ecast e2 (typeof e1))) ∧
+      ▷ (assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v3)) ∗ P)).
+  { intros; iIntros "[? H]".
+    rewrite /mapsto_ !bi.later_and; eauto. }
+  apply extract_exists_pre; intro v3.
+  apply semax_straight_simple; auto.
+  { apply _. }
+  intros until f; intros TS TC Hcl Hge HGG.
+  iIntros "(Hm & H)".
+  assert (typecheck_environ Delta rho) as TYCON_ENV
+    by (destruct TC as [TC' TC'']; eapply typecheck_environ_sub; eauto).
+  monPred.unseal. unfold_lift.
+  rewrite (add_and (_ ∧ (_ ∗ _)) (▷ ⌜_⌝)).
+  2: { iIntros "(_ & _ & ? & _) !>"; iApply (mapsto_pure_facts with "[$]"). }
+  iDestruct "H" as "(H & >%H)".
+  destruct H as ((ch & ?) & ?); destruct (eval_lvalue e1 rho) eqn: He1; try contradiction.
+  iCombine "Hm H" as "H".
+  rewrite (add_and (_ ∗ _) (▷ ⌜_⌝)).
+  2: { iIntros "(? & _ & _ & ? & _) !>".
+       by iApply (mapsto_can_store with "[$]"). }
+  iDestruct "H" as "((Hm & H) & >%Hstore)".
+  destruct Hstore as (m' & Hstore).
+  iExists m', te, rho.
+  iSplit.
+  + iSplit; first by subst.
+    iSplit; first done.
+    iCombine "Hm H" as "H"; rewrite (add_and (_ ∗ _) (▷_)); last by iIntros "H"; iNext; iDestruct "H" as "(Hm & (H & _) & _)"; iApply (eval_lvalue_relate with "[$Hm $H]").
+    iDestruct "H" as "(H & >%He1')".
+    destruct He1' as (? & ? & ? & He1'); rewrite He1' in He1; inv He1.
+    rewrite /tc_expr /typecheck_expr /=; fold typecheck_expr.
+    rewrite denote_tc_assert_andp.
+    rewrite (add_and (_ ∗ _) (▷_)); last by iIntros "H"; iNext; iDestruct "H" as "(Hm & (_ & H & _) & _)"; iApply (eval_expr_relate with "[$Hm $H]").
+    iDestruct "H" as "(H & >%He2)".
+    rewrite (add_and (_ ∗ _) (▷_)); last by iIntros "H"; iNext; iDestruct "H" as "(? & (_ & H) & _)"; iApply (cast_exists with "[$H]").
+    iDestruct "H" as "(H & >%Hcast)".
+    rewrite (add_and (_ ∗ _) (▷_)); last by iIntros "H"; iNext; iDestruct "H" as "(? & (_ & H & _) & _)"; iApply (typecheck_expr_sound with "[$H]").
+    iDestruct "H" as "(H & >%)".
+    rewrite (add_and (_ ∗ _) (▷_)); last by iIntros "H"; iNext; iDestruct "H" as "(Hm & (_ & _ & H) & _)"; iApply (cop2_sem_cast' with "[$Hm $H]").
+    iDestruct "H" as "(H & >%Hcast')".
+    rewrite Hcast in Hcast'.
+    iPureIntro; econstructor; eauto.
+    eapply assign_loc_value; eauto.
+  + iIntros "!>".
+    rewrite typecheck_expr_sound //.
+    rewrite (bi.and_elim_r (▷ tc_lvalue _ _ _)).
+    iDestruct "H" as "(>%Htc & F & >Hmapsto & P)".
+    subst; iPoseProof (mapsto_store with "[$Hm $Hmapsto]") as ">[? ?]"; [try done..|].
+    { by apply tc_val_tc_val'. }
+    rewrite He1; by iFrame.
 Qed.
 
 Definition numeric_type (t: type) : bool :=
@@ -1728,213 +791,97 @@ end.
 
 Lemma semax_store_union_hack:
      forall
-         (Delta : tycontext) (e1 e2 : expr) (t2: type) (ch ch' : memory_chunk) (sh : share) (P : LiftEnviron mpred),
+         E (Delta : tycontext) (e1 e2 : expr) (t2: type) (ch ch' : memory_chunk) (sh : share) (P : assert),
        (numeric_type (typeof e1) && numeric_type t2)%bool = true ->
        access_mode (typeof e1) = By_value ch ->
        access_mode t2 = By_value ch' ->
        decode_encode_val_ok ch ch' ->
        writable_share sh ->
-       semax Espec Delta
-         (fun rho =>
-           |> (tc_lvalue Delta e1 rho && tc_expr Delta (Ecast e2 (typeof e1)) rho &&
-              ( (mapsto_ sh (typeof e1) (eval_lvalue e1 rho) && mapsto_ sh t2 (eval_lvalue e1 rho))
-               * P rho)))
+       semax OK_spec E Delta
+         (▷ ((tc_lvalue Delta e1 ∧ tc_expr Delta (Ecast e2 (typeof e1))) ∧
+              ((assert_of (`(mapsto_ sh (typeof e1)) (eval_lvalue e1))
+                ∧ assert_of (`(mapsto_ sh t2) (eval_lvalue e1)))
+               ∗ P)))
          (Sassign e1 e2)
          (normal_ret_assert
-            (fun rho => (EX v':val,
-              andp (!! (decode_encode_val  (force_val (sem_cast (typeof e2) (typeof e1) (eval_expr e2 rho
-))) ch ch' v'))
-              (mapsto sh t2 (eval_lvalue e1 rho) v' * P rho)))).
+            (∃ v':val,
+              (local  ((`decode_encode_val )
+                         ((` force_val) ((`(sem_cast (typeof e2) (typeof e1))) (eval_expr e2))) (`ch) (`ch') (`v') )) ∧
+              (assert_of ((` (mapsto sh t2)) (eval_lvalue e1) (`v')) ∗ P))).
 Proof.
-intros until P. intros NT AM0 AM' OK WS.
-assert (SZ := decode_encode_val_size _ _ OK).
-apply semax_pre with
-  (fun rho : environ =>
-   EX v3: val,
-      |> tc_lvalue Delta e1 rho && |> tc_expr Delta (Ecast e2 (typeof e1)) rho &&
-      |> ((mapsto sh (typeof e1) (eval_lvalue e1 rho) v3 && mapsto sh t2 (eval_lvalue e1 rho) v3) * P rho)).
-intro. apply andp_left2.
-unfold mapsto_.
-apply exp_right with Vundef.
-repeat rewrite later_andp; auto.
-apply extract_exists_pre; intro v3.
-apply semax_straight_simple; auto.
-intros jm jm1 Delta' ge ve te rho k F f TS [TC1 TC2] TC4 Hcl Hge Hage [H0 H0'] HGG'.
-specialize (TC1 (m_phi jm1) (age_laterR (age_jm_phi Hage))).
-specialize (TC2 (m_phi jm1) (age_laterR (age_jm_phi Hage))).
-assert (typecheck_environ Delta rho) as TC.
-{ destruct TC4. eapply typecheck_environ_sub; eauto. }
-pose proof TC1 as TC1'.
-pose proof TC2 as TC2'.
-apply (tc_lvalue_sub _ _ _ TS) in TC1'; [| auto].
-apply (tc_expr_sub _ _ _ TS) in TC2'; [| auto].
-unfold tc_expr in TC2, TC2'; simpl in TC2, TC2'.
-rewrite denote_tc_assert_andp in TC2, TC2'.
-simpl in TC2,TC2'; super_unfold_lift.
-destruct TC2 as [TC2 TC3].
-destruct TC2' as [TC2' TC3'].
-apply later_sepcon2 in H0.
-specialize (H0 _ (age_laterR (age_jm_phi Hage))).
-pose proof I.
-destruct H0 as [?w [?w [? [? [?w [?w [H3 [H4 H5]]]]]]]].
-destruct H4 as [H4 H4x].
-unfold mapsto in H4.
-revert H4; case_eq (access_mode (typeof e1)); intros; try contradiction.
-rename H2 into Hmode.
-rewrite Hmode in AM0; inversion AM0; clear AM0; subst m.
-destruct (eval_lvalue_relate _ _ _ _ _ e1 jm1 HGG' Hge (guard_environ_e1 _ _ _ TC4)) as [b0 [i [He1 He1']]]; auto.
-rewrite He1' in *.
-destruct (join_assoc H3 (join_comm H0)) as [?w [H6 H7]].
-destruct (type_is_volatile (typeof e1)) eqn:NONVOL; try contradiction.
-rewrite if_true in H4 by auto.
-assert (exists v, address_mapsto ch v
-             sh
-        (b0, Ptrofs.unsigned i) w1)
-       by (destruct H4 as [[H4' H4] |[? [? ?]]]; eauto).
-assert (H77: (align_chunk ch' | Ptrofs.unsigned i) /\ type_is_volatile t2 = false). {
-  clear - H4x AM'.
-  unfold mapsto  in H4x.
-  rewrite AM' in H4x.
-  destruct(type_is_volatile t2); try contradiction. split; auto.
-  if_tac in H4x.
-  destruct H4x as [[_ ?] | [_ ?]].
-  rewrite address_mapsto_align in H0; destruct H0 as [_ H0]; simpl in H0; auto.
-  destruct H0 as [? ?].
-  rewrite address_mapsto_align in H0; destruct H0 as [_ H0]; simpl in H0; auto.
-  destruct H4x as [[_ ?] _]. auto.
-}
-clear H4x.
-clear v3 H4; destruct H2 as [v3 H4].
-
-assert (H11': (res_predicates.address_mapsto ch v3 sh
-        (b0, Ptrofs.unsigned i) * TT)%pred (m_phi jm1))
- by (exists w1; exists w3; split3; auto).
-assert (H11: (res_predicates.address_mapsto ch v3  sh
-        (b0, Ptrofs.unsigned i) * exactly w3)%pred (m_phi jm1)).
-{ exists w1; exists w3; split3; auto.
-  hnf; eauto. }
-apply address_mapsto_can_store'
-   with (ch':=ch') (v':=((force_val (Cop.sem_cast (eval_expr e2 rho) (typeof e2) (typeof e1) (m_dry jm1))))) in H11;
-  auto.
-2: apply H77.
-destruct H11 as [m' [H11 AM]].
-exists (store_juicy_mem _ _ _ _ _ _ H11).
-exists (te);  exists rho; split3; auto.
-subst; simpl; auto.
-rewrite level_store_juicy_mem. apply age_level; auto.
-split; auto.
-split.
-split3; auto.
-generalize (eval_expr_relate _ _ _ _ _ e2 jm1 HGG' Hge (guard_environ_e1 _ _ _ TC4)); intro.
-spec H2; [ assumption | ].
-rewrite <- (age_jm_dry Hage) in H2, He1.
-econstructor; try eassumption.
-unfold tc_lvalue in TC1. simpl in TC1.
-auto.
-instantiate (1:=(force_val (Cop.sem_cast (eval_expr e2 rho) (typeof e2) (typeof e1) (m_dry jm)))).
-rewrite (age_jm_dry Hage).
-rewrite cop2_sem_cast'; auto.
-2: eapply typecheck_expr_sound; eauto.
-eapply cast_exists; eauto. destruct TC4; auto.
-eapply Clight.assign_loc_value.
-apply Hmode.
-unfold tc_lvalue in TC1. simpl in TC1.
-auto.
-unfold Mem.storev.
-simpl m_dry.
-rewrite (age_jm_dry Hage).
-auto.
-apply (resource_decay_trans _ (nextblock (m_dry jm1)) _ (m_phi jm1)).
-rewrite (age_jm_dry Hage); lia.
-apply (age1_resource_decay _ _ Hage).
-apply resource_nodecay_decay.
-apply juicy_store_nodecay.
-{intros.
- clear - H11' H2 WS.
- destruct H11' as [phi1 [phi2 [? [? ?]]]].
- destruct H0 as [bl [_ ?]]. specialize  (H0 (b0,z)).
- hnf in H0. rewrite if_true in H0 by (split; auto; lia).
- destruct H0. hnf in H0.
- apply (resource_at_join _ _ _ (b0,z)) in H.
- rewrite H0 in H.
- inv H; simpl; apply join_writable01 in RJ; auto;
- unfold perm_of_sh; rewrite if_true by auto; if_tac; constructor.
-}
-rewrite level_store_juicy_mem. split; [apply age_level; auto|].
-simpl. unfold inflate_store; rewrite ghost_of_make_rmap.
-apply age1_ghost_of, age_jm_phi; auto.
-split.
-2 : {
-      eapply (corable_core _ (m_phi jm1)), pred_hereditary; eauto; [|apply age_jm_phi; auto].
-      symmetry.
-      forget (force_val (Cop.sem_cast (eval_expr e2 rho) (typeof e2) (typeof e1) (m_dry jm1))) as v.
-      apply rmap_ext.
-      do 2 rewrite level_core.
-      rewrite <- level_juice_level_phi; rewrite level_store_juicy_mem.
-      reflexivity.
-      intro loc.
-      unfold store_juicy_mem. simpl.
-      rewrite <- core_resource_at. unfold inflate_store.
-      rewrite resource_at_make_rmap. rewrite <- core_resource_at.
-      case_eq (m_phi jm1 @ loc); intros; auto.
-      destruct k0; simpl resource_fmap; repeat rewrite core_YES; auto.
-      simpl.
-      rewrite !ghost_of_core.
-      unfold inflate_store; rewrite ghost_of_make_rmap; auto.
-}
-
-assert (TCv: tc_val (typeof e1)  (force_val (sem_cast (typeof e2) (typeof e1) (eval_expr e2 rho)))).
-  eapply tc_val_sem_cast; eauto.
-erewrite <- cop2_sem_cast' in *; try eassumption;
-   try (eapply typecheck_expr_sound; eauto).
-forget (force_val (Cop.sem_cast (eval_expr e2 rho) (typeof e2) (typeof e1) (m_dry jm1))) as v.
-rewrite sepcon_comm.
-destruct  (load_store_similar' _ _ _ _ _ _ H11 ch') as [v' [? ?]].
-auto.
-auto.
-apply H77.
-rewrite exp_sepcon1.
-exists v'.
-rewrite prop_true_andp by auto.
-rewrite sepcon_assoc.
-eapply sepcon_derives; try apply AM; auto.
-unfold mapsto.
-destruct TC4 as [TC4 _].
-
-rewrite AM'.
-rewrite He1'.
-*
-apply exp_left; intro v''.
-apply prop_andp_left; intro.
-pose proof (decode_encode_val_fun _ _  OK _ _ _  H8 H9).
-subst v''; clear H9.
-rewrite (proj2 H77).
-rewrite if_true by auto.
-apply orp_right1.
-apply andp_right; auto.
-intros ? ?.
-simpl.
-clear - H8 NT OK Hmode AM' TCv.
-rewrite andb_true_iff in NT; destruct NT as [NT NT'].
-destruct ch, ch'; try contradiction OK;
-destruct (typeof e1) as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ]; inv NT; inv Hmode;
-destruct t2 as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ]; inv NT'; inv AM';
-destruct v; simpl in H8; subst; try contradiction;
-try apply I;
-try (apply tc_val_Vundef in TCv; contradiction);
-match goal with
- | |- context [Int.sign_ext ?n] => apply (sign_ext_range' n); compute; split; congruence
- | |- context [Int.zero_ext ?n] => apply (zero_ext_range' n); compute; split; congruence
- | |- _ => idtac
-end.
-*
-intros ? ?.
-clear - H9 H6 H1 H5.
-destruct H9 as (? & H9 & ?).
-destruct (nec_join2 H6 H9) as [w2' [w' [? [? ?]]]].
-eapply pred_upclosed; eauto.
-exists w2'; exists w'; split3; auto; eapply pred_nec_hereditary; eauto.
+  intros until P. intros NT AM0 AM' OK WS.
+  assert (SZ := decode_encode_val_size _ _ OK).
+  apply semax_pre with
+  (∃ v3: val,
+      (▷ tc_lvalue Delta e1 ∧ ▷ tc_expr Delta (Ecast e2 (typeof e1))) ∧
+      ▷ ((assert_of (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v3))
+                ∧ assert_of (`(mapsto sh t2) (eval_lvalue e1) (`v3))) ∗ P)).
+  { intros; iIntros "[? H]".
+    rewrite /mapsto_ !bi.later_and; eauto. }
+  apply extract_exists_pre; intro v3.
+  apply semax_straight_simple; auto.
+  { apply _. }
+  intros until f; intros TS TC Hcl Hge HGG.
+  iIntros "(Hm & H)".
+  assert (typecheck_environ Delta rho) as TYCON_ENV
+    by (destruct TC as [TC' TC'']; eapply typecheck_environ_sub; eauto).
+  monPred.unseal; unfold_lift.
+  rewrite (add_and (_ ∧ (_ ∗ _)) (▷ ⌜_⌝)).
+  2: { iIntros "(_ & _ & (_ & ?) & _) !>"; iApply (mapsto_pure_facts with "[$]"). }
+  iDestruct "H" as "(H & >%H)".
+  destruct H as (_ & ?); destruct (eval_lvalue e1 rho) eqn: He1; try contradiction.
+  iCombine "Hm H" as "H".
+  rewrite (add_and (_ ∗ _) (▷ ⌜_⌝)).
+  2: { iIntros "(? & _ & _ & (? & _) & _) !>".
+       iApply (mapsto_can_store with "[$]"); eauto. }
+  iDestruct "H" as "((Hm & H) & >%Hstore)".
+  destruct Hstore as (m' & Hstore).
+  iExists m', te, rho.
+  iSplit.
+  + iSplit; first by subst.
+    iSplit; first done.
+    iCombine "Hm H" as "H"; rewrite (add_and (_ ∗ _) (▷_)); last by iIntros "H"; iNext; iDestruct "H" as "(Hm & (H & _) & _)"; iApply (eval_lvalue_relate with "[$Hm $H]").
+    iDestruct "H" as "(H & >%He1')".
+    destruct He1' as (? & ? & ? & He1'); rewrite He1' in He1; inv He1.
+    rewrite /tc_expr /typecheck_expr /=; fold typecheck_expr.
+    rewrite denote_tc_assert_andp.
+    rewrite (add_and (_ ∗ _) (▷_)); last by iIntros "H"; iNext; iDestruct "H" as "(Hm & (_ & H & _) & _)"; iApply (eval_expr_relate with "[$Hm $H]").
+    iDestruct "H" as "(H & >%He2)".
+    rewrite (add_and (_ ∗ _) (▷_)); last by iIntros "H"; iNext; iDestruct "H" as "(? & (_ & H) & _)"; iApply (cast_exists with "[$H]").
+    iDestruct "H" as "(H & >%Hcast)".
+    rewrite (add_and (_ ∗ _) (▷_)); last by iIntros "H"; iNext; iDestruct "H" as "(? & (_ & H & _) & _)"; iApply (typecheck_expr_sound with "[$H]").
+    iDestruct "H" as "(H & >%)".
+    rewrite (add_and (_ ∗ _) (▷_)); last by iIntros "H"; iNext; iDestruct "H" as "(Hm & (_ & _ & H) & _)"; iApply (cop2_sem_cast' with "[$Hm $H]").
+    iDestruct "H" as "(H & >%Hcast')".
+    rewrite Hcast in Hcast'.
+    iPureIntro; econstructor; eauto.
+    eapply assign_loc_value; eauto.
+  + iIntros "!>".
+    rewrite /tc_expr /= typecheck_expr_sound //.
+    rewrite (bi.and_elim_r (▷ tc_lvalue _ _ _)); iDestruct "H" as "(>%Htc & F & >H & P)".
+    iAssert ⌜type_is_volatile t2 = false ∧ (align_chunk ch' | Ptrofs.unsigned i)%Z⌝ with "[H]" as %[??].
+    { iDestruct "H" as "[_ H]"; rewrite /mapsto AM'.
+      destruct (type_is_volatile t2); first done.
+      rewrite -> if_true by auto.
+      iDestruct "H" as "[(% & H) | (% & % & H)]"; rewrite address_mapsto_align; iDestruct "H" as "[_ %]"; done. }
+    iDestruct "H" as "[Hmapsto _]".
+    rewrite /= /force_val1 in Htc; super_unfold_lift.
+    subst; iPoseProof (mapsto_store' with "[$Hm $Hmapsto]") as ">[$ ?]"; eauto.
+    { set (v := force_val _) in *.
+      rewrite andb_true_iff in NT; destruct NT as [NT NT'].
+      destruct ch, ch'; try contradiction OK;
+        destruct (typeof e1) as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ]; inv NT; inv AM0;
+        destruct t2 as [ | [ | | | ] [ | ] | [ | ] | [ | ] | | | | | ]; inv NT'; inv AM';
+        destruct v; simpl in *; subst; try contradiction;
+        try apply I;
+        try (apply tc_val_Vundef in TCv; contradiction);
+        rewrite /decode_val proj_inj_bytes; intros ?;
+        match goal with
+        | |- context [Int.sign_ext ?n] => apply (sign_ext_range' n); compute; split; congruence
+        | |- context [Int.zero_ext ?n] => apply (zero_ext_range' n); compute; split; congruence
+        | |- _ => idtac
+        end; done. }
+    rewrite He1; by iFrame.
 Qed.
 
-
 End extensions.
diff --git a/veric/semax_switch.v b/veric/semax_switch.v
index 1357d02650..69921eb1e3 100644
--- a/veric/semax_switch.v
+++ b/veric/semax_switch.v
@@ -1,11 +1,12 @@
-Require Import VST.msl.seplog.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.juicy_base.
-Require Import VST.msl.normalize.
-Require Import VST.veric.juicy_mem VST.veric.juicy_mem_lemmas VST.veric.juicy_mem_ops.
+Require Import VST.veric.juicy_mem.
 Require Import VST.veric.res_predicates.
+Require Import VST.veric.external_state.
 Require Import VST.veric.extend_tc.
 Require Import VST.veric.Clight_seplog.
 Require Import VST.veric.Clight_assert_lemmas.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.Clight_core.
 Require Import VST.sepcomp.extspec.
 Require Import VST.sepcomp.step_lemmas.
@@ -16,11 +17,14 @@ Require Import VST.veric.expr_lemmas.
 Require Import VST.veric.semax.
 Require Import VST.veric.semax_lemmas.
 Require Import VST.veric.Clight_lemmas.
-Import compcert.lib.Maps.
+
+Section mpred.
+
+Context `{!VSTGS OK_ty Σ} {OK_spec : ext_spec OK_ty}.
 
 Lemma closed_wrt_modvars_switch:
   forall a sl n F,
-  closed_wrt_modvars (Sswitch a sl) F ->
+  closed_wrt_modvars(Σ:=Σ) (Sswitch a sl) F ->
   closed_wrt_modvars (seq_of_labeled_statement (select_switch n sl)) F.
 Proof.
 unfold closed_wrt_modvars, modifiedvars.
@@ -31,11 +35,11 @@ destruct H0; auto;left.
 clear - H0.
 simpl in *.
 forget idset0 as s.
-assert (isSome (modifiedvars' (seq_of_labeled_statement sl) s) ! i). {
+assert (isSome (modifiedvars' (seq_of_labeled_statement sl) s !! i)). {
   unfold select_switch in *.
   destruct (select_switch_case n sl) eqn:?.
  *
-  revert l Heqo s H0; induction sl ;intros. inv Heqo.
+  revert l Heqo s H0; induction sl; intros. inv Heqo.
   simpl. simpl in Heqo. destruct o. destruct (zeq z n).
   inv Heqo; subst. simpl in H0. auto.
   specialize (IHsl _ Heqo _ H0).
@@ -52,169 +56,63 @@ assert (isSome (modifiedvars' (seq_of_labeled_statement sl) s) ! i). {
 }
  clear - H.
  revert s H; induction sl; simpl; intros; auto.
- rewrite modifiedvars'_union in H|-*.
+ rewrite -> modifiedvars'_union in H|-*.
  destruct H;[left|right]; auto.
 Qed.
 
-Lemma frame_tc_expr:
-  forall {CS: compspecs} (Q F: mpred) Delta e rho,
-  (Q |-- tc_expr Delta e rho) ->
-  Q * F |-- tc_expr Delta e rho.
-Proof.
-intros.
-eapply derives_trans; [apply sepcon_derives; [apply H | apply derives_refl ] | ].
-apply extend_sepcon; apply extend_tc_expr.
-Qed.
-
-Lemma prop_subp:
-   forall A (NA: ageable A) (EO: Ext_ord A) (P Q: Prop) (w: nat),
-    (P -> Q) -> app_pred (!! P >=> !! Q)%pred w.
-Proof.
-repeat intro. apply H. apply H3.
-Qed.
-
-Lemma andp_subp'_right:
-  forall A (NA: ageable A) (EO: Ext_ord A) (P Q R: pred A) w,  
-    app_pred (P >=> Q)%pred w ->
-    app_pred (P >=> R)%pred w -> 
-    app_pred (P >=> Q && R)%pred w.
-Proof.
-repeat intro.
-split. eapply H; eauto. eapply H0; eauto.
-Qed.
-
-Lemma prop_imp_right: forall A (agA: ageable A) (EO: Ext_ord A) (P: Prop) (Q R: pred A),
-   (P -> (Q |-- R)) ->
-   Q |-- !! P --> R.
-Proof.
-intros.
-intros w ? ? ? ? ? ?.
-apply H; auto. eapply pred_upclosed, pred_nec_hereditary; eauto.
-Qed.
-
-Lemma imp_right:
- forall A (agA: ageable A) (EO: Ext_ord A) (P Q R : pred A),
-  (P && Q |-- R) ->
-  P |-- Q --> R.
-Proof.
-intros.
-intros ? ? ? ? ? ? ?.
-apply H.
-split; auto.
-eapply pred_upclosed, pred_nec_hereditary; eauto.
-Qed.
-
-Lemma prop_andp_subp':
-  forall (A : Type) (agA : ageable A) (EO : Ext_ord A) (P : Prop) (S: pred nat) (Q R : pred A),
-  (P -> S |-- Q >=> R)%pred
-  ->  (S  |--  !! P && Q >=> R)%pred.
-Proof.
-intros.
-intros ? ? ? ? ? ? ? ? [? ?].
-eapply H; eauto.
-Qed.
-
 Lemma tc_expr_sound {CS: compspecs}:
  forall Delta e rho, typecheck_environ Delta rho -> 
-     tc_expr Delta e rho |-- !! tc_val (typeof e) (eval_expr e rho).
-Proof.
-repeat intro.
-eapply typecheck_expr_sound; eauto.
-Qed.
-
-Lemma unfash_allp:  forall {A} {agA: ageable A} {EO: Ext_ord A} {B} (f: B -> pred nat),
-  @unfash _ agA _ (allp f) = allp (fun x:B => unfash (f x)).
-Proof.
-intros.
-apply pred_ext.
-intros ? ? ?.
-specialize (H b). auto.
-repeat intro. apply (H b).
-Qed.
-
-Lemma andp_imp_e:
-  forall (A : Type) (agA : ageable A) (EO : Ext_ord A) (P Q : pred A),
-   P && (P --> Q) |-- Q.
+     tc_expr Delta e rho ⊢ ⌜tc_val (typeof e) (eval_expr e rho)⌝.
 Proof.
-intros.
-intros ? [? ?].
-eapply H0; auto.
+  intros; eapply typecheck_expr_sound; eauto.
 Qed.
 
 Lemma switch_rguard:
- forall (Espec : OracleKind)
+ forall E
   (R : ret_assert)
   (psi : genv)
   (F : assert)
   (f: function)
   (Delta' : tycontext)
   (k : cont),
- rguard Espec psi Delta' f
-        (frame_ret_assert R F) k |--
-(rguard Espec psi  Delta' f
+ rguard OK_spec psi E Delta' f
+        (frame_ret_assert R F) k ⊢
+(rguard OK_spec psi E Delta' f
    (frame_ret_assert (switch_ret_assert R) F) 
    (Kswitch k)).
 Proof.
-intros.
-unfold rguard.
-apply allp_right; intro ek.
-apply allp_right; intro vl.
-apply allp_right; intro tx'.
-apply allp_right; intro vx'.
- pose (ek' := match ek with 
+  intros.
+  unfold rguard.
+  iIntros "#H" (????) "!>".
+  pose (ek' := match ek with 
                     | EK_normal => EK_normal
                     | EK_break => EK_normal
                     | EK_continue => EK_continue
                     | EK_return => EK_return
                     end).
- pose (vl' := match ek with 
+  pose (vl' := match ek with 
                     | EK_normal => None
                     | EK_break => None
                     | EK_continue => None
                     | EK_return => vl
                     end).
- apply allp_left with ek'.
- apply allp_left with vl'.
- apply allp_left with tx'.
- apply allp_left with vx'.
- set (rho' := construct_rho (filter_genv psi) vx' tx') in *.
- forget (funassert Delta' rho') as FDR.
- rewrite !proj_frame_ret_assert.
- simpl.
- apply fash_derives.
- destruct R as [?R ?R ?R ?R]; destruct ek eqn:?H; subst ek' vl'; simpl; auto.
- apply imp_right; normalize; apply imp_derives; auto.
- apply imp_derives; normalize.
- rewrite !andp_assoc.
- repeat apply andp_derives; auto.
- repeat intro; hnf; auto.
- apply imp_derives; normalize.
- rewrite !andp_assoc.
- repeat apply andp_derives; auto.
- repeat intro; hnf; auto.
+  iSpecialize ("H" $! ek' vl' tx vx).
+  rewrite !proj_frame.
+  monPred.unseal; iIntros "(? & (? & P) & ?)".
+  destruct R, ek; subst ek' vl'; simpl proj_ret_assert; last (by iApply "H"; iFrame); monPred.unseal; iDestruct "P" as "(-> & ?)"; try done; try by (iApply "H"; iFrame).
 Qed.
 
-Lemma unfash_fash_imp:
-  forall A (NA: ageable A) (EO : Ext_ord A) P Q,
-  @unfash A _ _ (# (P --> Q)) |-- P --> Q.
-Proof.
-intros.
-intros ? ?.
-intros ? ? ?.
-do 3 red in H.
-apply (H a'); auto.
-apply necR_level; auto.
-Qed.
+Context {CS : compspecs}.
 
-Lemma assert_safe_step_nostore:
-  forall {cs: compspecs} Espec psi f vx vx2 tx tx2 c1 k1 c2 k2 Delta e rho,
+(*Lemma assert_safe_step_nostore:
+  forall  psi f vx vx2 tx tx2 c1 k1 c2 k2 Delta e rho,
   (forall jm jm', age1 jm = Some jm' ->
     app_pred (tc_expr Delta e rho) (m_phi jm) ->
      cl_step psi (State f c1 k1 vx tx)
       (m_dry jm) (State f c2 k2 vx2 tx2) (m_dry jm)) ->
-  assert_safe Espec psi f vx2 tx2 (Cont (Kseq c2 k2)) (construct_rho (filter_genv psi) vx2 tx2)
+  assert_safe OK_spec psi f vx2 tx2 (Cont (Kseq c2 k2)) (construct_rho (filter_genv psi) vx2 tx2)
  && tc_expr Delta e rho
-|-- assert_safe Espec psi f vx tx (Cont (Kseq c1 k1)) (construct_rho (filter_genv psi) vx tx).
+⊢ assert_safe OK_spec psi f vx tx (Cont (Kseq c1 k1)) (construct_rho (filter_genv psi) vx tx).
 Proof.
 intros. intros ? [Hw Hw'] ?? Hora ???; subst.
 apply jm_fupd_intro'.
@@ -238,129 +136,48 @@ inv H1. clear Heqn.
 eapply pred_hereditary in Hw;
   [ | instantiate (1:= (m_phi jm')); apply age_jm_phi; auto].
 apply assert_safe_jsafe; auto.
-Qed.
+Qed.*)
 
 Lemma semax_switch: 
-  forall {CS: compspecs} Espec Delta (Q: assert) a sl R,
-     is_int_type (typeof a) = true ->
-     (forall rho, seplog.derives (Q rho) (tc_expr Delta a rho)) ->
-     (forall n,
-     semax Espec Delta (fun rho => andp (prop (eval_expr a rho = Vint n)) (Q rho))
+  forall E Delta (Q: assert) a sl R
+     (Ht : is_int_type (typeof a) = true)
+     (Htc : Q ⊢ tc_expr Delta a)
+     (Hcase : forall n,
+     semax OK_spec E Delta (local (fun rho => eval_expr a rho = Vint n) ∧ Q)
                (seq_of_labeled_statement (select_switch (Int.unsigned n) sl))
-               (switch_ret_assert R)) ->
-     semax Espec Delta Q (Sswitch a sl) R.
+               (switch_ret_assert R)),
+     semax OK_spec E Delta Q (Sswitch a sl) R.
 Proof.
-intros.
-rewrite semax_eq.
-apply allp_right; intro psi.
-apply allp_right; intro Delta'.
-apply allp_right; intro CS'.
-apply prop_imp_right; intros [TS HGG].
-apply imp_right.
-rewrite TT_and.
-apply allp_right; intro k.
-apply allp_right; intro F.
-apply allp_right; intro f.
-apply imp_right.
-rewrite <- andp_assoc;
- rewrite (andp_comm (believe _ _ _ _));
- rewrite andp_assoc;
- apply prop_andp_left; intro.
-unfold guard, _guard.
-apply allp_right; intro tx.
-apply allp_right; intro vx.
-rewrite andp_assoc.
-apply prop_andp_subp'; intros [H4 H4'].
-set (rho := construct_rho (filter_genv psi) vx tx) in *.
-specialize (H0 rho).
-inv H0. rename derivesI into H0.
-apply @frame_tc_expr with (F := F rho) in  H0.
-rewrite sepcon_comm in H0.
-apply subp_i1.
-eapply derives_trans.
- apply andp_derives; [apply derives_refl | ].
- apply andp_derives; [ | apply derives_refl].
- apply andp_right; [ apply derives_refl | ].
- eapply derives_trans; [apply H0 | ].
- eapply tc_expr_sound; eauto.
- eapply typecheck_environ_sub; eauto.
-rewrite andp_comm.
-rewrite (andp_comm (_ * _)%pred).
-rewrite !andp_assoc.
-apply derives_extract_prop; intro H0'.
-destruct (typeof a) eqn:?; inv H.
-destruct (eval_expr a rho) as [ | n | | | |] eqn:?;  try contradiction H0'.
-specialize (H1 n).
-rewrite semax_eq in H1.
-match goal with |- ?A |-- _ => rewrite <- (TT_and A) end.
-eapply derives_trans; [apply andp_derives; [ | apply derives_refl] | ].
-eapply derives_trans; [ | apply @unfash_derives; apply H1].
-rewrite fash_TT.
-auto.
-clear H1.
-rewrite unfash_allp. rewrite (allp_andp psi). apply allp_left with psi.
-rewrite unfash_allp. rewrite (allp_andp Delta'). apply allp_left with Delta'.
-rewrite unfash_allp. rewrite (allp_andp CS'). apply allp_left with CS'.
-rewrite unfash_prop_imp.
-rewrite prop_true_imp by auto.
-rewrite unfash_imp.
-rewrite unfash_andp.
-rewrite (andp_comm (sepcon _ _)).
-rewrite (andp_comm (funassert _ _)).
-rewrite <- !andp_assoc.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply andp_derives; [ | apply derives_refl].
-apply andp_derives; [ | apply derives_refl].
-rewrite andp_comm.
-apply andp_imp_e.
-rewrite unfash_allp. rewrite !(allp_andp (Kswitch k)). apply allp_left with (Kswitch k).
-rewrite unfash_allp. rewrite !(allp_andp F). apply allp_left with F.
-rewrite unfash_allp. rewrite !(allp_andp f). apply allp_left with f.
-rewrite prop_true_andp 
-  by (eapply closed_wrt_modvars_switch with (n:= Int.unsigned n); eauto).
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply andp_derives; [ | apply derives_refl].
-apply andp_derives; [apply derives_refl | ].
-eapply unfash_derives.
-apply switch_rguard.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-apply andp_derives; [ | apply derives_refl].
-rewrite unfash_imp.
-rewrite andp_comm.
-apply andp_imp_e.
-unfold guard, _guard.
-rewrite unfash_allp. rewrite !(allp_andp tx). apply allp_left with tx.
-rewrite unfash_allp. rewrite !(allp_andp vx). apply allp_left with vx.
-fold rho.
-rewrite (prop_true_andp (_ = _)) by auto.
-eapply derives_trans.
-apply andp_derives; [apply derives_refl | ].
-apply andp_right; apply derives_refl.
-rewrite !andp_assoc.
-rewrite (andp_comm (sepcon _ _)).
-rewrite <- (andp_assoc (funassert _ _)).
-forget (funassert Delta' rho && (F rho * Q rho))%pred as FQ.
-rewrite prop_true_andp by (split; auto).
-rewrite <- andp_assoc.
-eapply derives_trans.
-apply andp_derives; [ | apply H0].
-apply andp_derives; [ | apply derives_refl].
-apply unfash_fash_imp.
-eapply derives_trans.
-apply andp_derives; [ | apply derives_refl].
-rewrite andp_comm. apply andp_imp_e.
-eapply typecheck_environ_sub in H4; try eassumption.
-destruct HGG as [ HGG].
-apply assert_safe_step_nostore.
-intros.
-assert (H1': (@tc_expr CS' Delta a rho) (m_phi jm)) by apply (@tc_expr_cenv_sub _ _ HGG a rho _ _ H3). 
-clear H1; rename H1' into H1.
-econstructor.
-+ eapply eval_expr_relate; eauto.
-+ fold rho.
- rewrite (*Heqv,*) (eval_expr_cenv_sub_Vint HGG _ _ _ Heqv), Heqt.
-reflexivity.
+  intros.
+  rewrite semax_unfold.
+  iIntros (?????) "#Prog_OK".
+  iIntros (????) "((%Hclosed & %) & #rguard)".
+  iIntros (??) "!>".
+  monPred.unseal; iIntros "((% & %) & (F & Q) & ?)".
+  set (rho := construct_rho _ _ _).
+  assert (typecheck_environ Delta rho) by (eapply typecheck_environ_sub; done).
+  iAssert ⌜tc_val (typeof a) (eval_expr(CS := CS) a rho)⌝ as %?.
+  { rewrite Htc tc_expr_sound //. }
+  destruct (typeof a) eqn: Hta; try discriminate.
+  destruct (eval_expr a rho) as [ | n | | | |] eqn:?; try contradiction.
+  specialize (Hcase n); rewrite semax_unfold in Hcase.
+  iPoseProof (Hcase with "Prog_OK []") as "Hcase"; [done | done | ..].
+  { iIntros "!>"; iSplit; last by iApply switch_rguard.
+    iPureIntro; split; last done.
+    eapply closed_wrt_modvars_switch with (n:= Int.unsigned n); eauto. }
+  rewrite /guard' /_guard /assert_safe.
+  iIntros (? _).
+  iApply jsafe_step; rewrite /jstep_ex.
+  iIntros (?) "(Hm & ?) !>".
+  destruct HGG as [CSUB ?]; iDestruct (eval_expr_relate with "[$Hm Q]") as %?; [done.. | |].
+  { inversion Htc as [->]; rewrite tc_expr_cenv_sub //. }
+  iExists _, _; iSplit.
+  { iPureIntro; econstructor; try done.
+    erewrite (eval_expr_cenv_sub_Vint CSUB) by done.
+    rewrite Hta //. }
+  iFrame.
+  iApply ("Hcase" with "[-]"); last by iPureIntro.
+  monPred.unseal; iFrame; auto.
 Qed.
+
+End mpred.
diff --git a/veric/seplog.v b/veric/seplog.v
index b91a187fc5..9e343b4ed1 100644
--- a/veric/seplog.v
+++ b/veric/seplog.v
@@ -1,89 +1,80 @@
-Require Import VST.msl.log_normalize.
-Require Import VST.msl.alg_seplog.
 Require Export VST.veric.base.
-Require Import VST.veric.rmaps.
-Require Import VST.veric.compcert_rmaps.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Import iris_ora.algebra.gmap_view.
 Require Import VST.veric.res_predicates.
-
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.mpred.
 Require Import VST.veric.address_conflict.
 Require Export VST.veric.shares.
 Require Import VST.veric.Cop2. (*for definition of tc_val'*)
-Require Import VST.veric.own.
-Require Import VST.veric.invariants.
-Require Import VST.veric.fupd.
-Import compcert.lib.Maps.
-
-Local Open Scope pred.
-
+Require Import Coq.Logic.JMeq.
 (* Diagnostic tactic, useful because intuition can be much slower than tauto 
 Tactic Notation "intuition" :=
  try (solve [tauto]; idtac "Intuition used where tauto would work");
  Coq.Init.Tauto.intuition.
 *)
 
-Lemma derives_emp_unfash_fash P Q: derives P Q  -> derives emp (unfash (fash (imp P Q))).
-Proof. repeat intro. eauto. Qed.
-
-Lemma derives_unfash_fash R P Q: derives P Q  -> derives R (unfash (fash (imp P Q))).
-Proof. repeat intro. eauto. Qed.
+(*******************material moved here from tycontext.v *******************)
 
-Lemma eqp_subp : forall (P Q:mpred), P <=> Q |-- P >=> Q.
-intros. eapply eqp_subp. trivial. Qed.
+Section mpred.
 
-(*******************material moved here from tycontext.v *******************)
+Context `{!heapGS Σ}.
+Local Notation mpred := (@mpred Σ).
+Local Notation funspec := (@funspec Σ).
+Local Notation assert := (@assert Σ).
+Local Notation argsassert := (@argsassert Σ).
 
 Inductive Annotation :=
   WeakAnnotation : (environ -> mpred) -> Annotation
 | StrongAnnotation : (environ -> mpred) -> Annotation.
 
 Inductive tycontext : Type :=
-  mk_tycontext : forall (tyc_temps: PTree.t type)
-                        (tyc_vars: PTree.t type)
+  mk_tycontext : forall (tyc_temps: Maps.PTree.t type)
+                        (tyc_vars: Maps.PTree.t type)
                         (tyc_ret: type)
-                        (tyc_globty: PTree.t type)
-                        (tyc_globsp: PTree.t funspec)
-                        (tyc_annot: PTree.t Annotation),
+                        (tyc_globty: Maps.PTree.t type)
+                        (tyc_globsp: Maps.PTree.t funspec)
+                        (tyc_annot: Maps.PTree.t Annotation),
                              tycontext.
 
 Definition empty_tycontext : tycontext :=
-  mk_tycontext (PTree.empty _) (PTree.empty _) Ctypes.Tvoid
-         (PTree.empty _)  (PTree.empty _) (PTree.empty _).
+  mk_tycontext (Maps.PTree.empty _) (Maps.PTree.empty _) Ctypes.Tvoid
+         (Maps.PTree.empty _)  (Maps.PTree.empty _) (Maps.PTree.empty _).
 
-Definition temp_types (Delta: tycontext): PTree.t type :=
+Definition temp_types (Delta: tycontext): Maps.PTree.t type :=
   match Delta with mk_tycontext a _ _ _ _ _ => a end.
-Definition var_types (Delta: tycontext) : PTree.t type :=
+Definition var_types (Delta: tycontext) : Maps.PTree.t type :=
   match Delta with mk_tycontext _ a _ _ _ _ => a end.
 Definition ret_type (Delta: tycontext) : type :=
   match Delta with mk_tycontext _ _ a _ _ _ => a end.
-Definition glob_types (Delta: tycontext) : PTree.t type :=
+Definition glob_types (Delta: tycontext) : Maps.PTree.t type :=
   match Delta with mk_tycontext _ _ _ a _ _ => a end.
-Definition glob_specs (Delta: tycontext) : PTree.t funspec :=
+Definition glob_specs (Delta: tycontext) : Maps.PTree.t funspec :=
   match Delta with mk_tycontext _ _ _ _ a _ => a end.
-Definition annotations (Delta: tycontext) : PTree.t Annotation :=
+Definition annotations (Delta: tycontext) : Maps.PTree.t Annotation :=
   match Delta with mk_tycontext _ _ _ _ _ a => a end.
 
 (** Creates a typecontext from a function definition **)
 (* NOTE:  params start out initialized, temps do not! *)
 
 Definition make_tycontext_t (params: list (ident*type)) (temps : list(ident*type)) :=
-fold_right (fun (param: ident*type) => PTree.set (fst param) (snd param))
- (fold_right (fun (temp : ident *type) tenv => let (id,ty):= temp in PTree.set id ty tenv)
-  (PTree.empty type) temps) params.
+fold_right (fun (param: ident*type) => Maps.PTree.set (fst param) (snd param))
+ (fold_right (fun (temp : ident *type) tenv => let (id,ty):= temp in Maps.PTree.set id ty tenv)
+  (Maps.PTree.empty type) temps) params.
 
 Definition make_tycontext_v (vars : list (ident * type)) :=
- fold_right (fun (var : ident * type) venv => let (id, ty) := var in PTree.set id ty venv)
-   (PTree.empty type) vars.
+ fold_right (fun (var : ident * type) venv => let (id, ty) := var in Maps.PTree.set id ty venv)
+   (Maps.PTree.empty type) vars.
 
 Definition make_tycontext_g (V: varspecs) (G: funspecs) :=
- (fold_right (fun (var : ident * funspec) => PTree.set (fst var) (type_of_funspec (snd var)))
-      (fold_right (fun (v: ident * type) => PTree.set (fst v) (snd v))
-         (PTree.empty _) V)
+ (fold_right (fun (var : ident * funspec) => Maps.PTree.set (fst var) (type_of_funspec (snd var)))
+      (fold_right (fun (v: ident * type) => Maps.PTree.set (fst v) (snd v))
+         (Maps.PTree.empty _) V)
             G).
 
 Definition make_tycontext_a (anns : list (ident * Annotation)) :=
- fold_right (fun (ia : ident * Annotation) aenv => let (id, a) := ia in PTree.set id a aenv)
-   (PTree.empty Annotation) anns.
+ fold_right (fun (ia : ident * Annotation) aenv => let (id, a) := ia in Maps.PTree.set id a aenv)
+   (Maps.PTree.empty Annotation) anns.
 
 Definition make_tycontext (params: list (ident*type)) (temps: list (ident*type)) (vars: list (ident*type))
                        (return_ty: type)
@@ -103,16 +94,16 @@ Definition make_tycontext (params: list (ident*type)) (temps: list (ident*type))
 (** Environment typechecking functions **)
 
 Definition typecheck_temp_environ
-(te: tenviron) (tc: PTree.t type) :=
-forall id ty , tc ! id = Some ty  -> exists v, Map.get te id = Some v /\ tc_val' ty v.
+(te: tenviron) (tc: Maps.PTree.t type) :=
+forall (id : ident) ty , tc !! id = Some ty  -> exists v, Map.get te id = Some v /\ tc_val' ty v.
 
 Definition typecheck_var_environ
-(ve: venviron) (tc: PTree.t type) :=
-forall id ty, tc ! id = Some ty <-> exists v, Map.get ve id = Some(v,ty).
+(ve: venviron) (tc: Maps.PTree.t type) :=
+forall (id : ident) ty, tc !! id = Some ty <-> exists v, Map.get ve id = Some(v,ty).
 
 Definition typecheck_glob_environ
-(ge: genviron) (tc: PTree.t type) :=
-forall id  t,  tc ! id = Some t ->
+(ge: genviron) (tc: Maps.PTree.t type) :=
+forall (id : ident) t, tc !! id = Some t ->
 (exists b, Map.get ge id = Some b).
 
 Definition typecheck_environ (Delta: tycontext) (rho : environ) :=
@@ -120,7 +111,7 @@ typecheck_temp_environ (te_of rho) (temp_types Delta) /\
 typecheck_var_environ  (ve_of rho) (var_types Delta) /\
 typecheck_glob_environ (ge_of rho) (glob_types Delta).
 
-Definition local:  (environ -> Prop) -> environ->mpred :=  lift1 prop.
+Definition local: (environ -> Prop) -> assert := fun l => assert_of (lift1 bi_pure l).
 
 Definition tc_environ (Delta: tycontext) : environ -> Prop :=
    fun rho => typecheck_environ Delta rho.
@@ -132,10 +123,10 @@ Definition funsig_of_funspec (fs: funspec) : funsig :=
  match fs with mk_funspec fsig _ _ _ _ _ _ => fsig end.
 *)
 Definition ret0_tycon (Delta: tycontext): tycontext :=
-  mk_tycontext (PTree.empty _) (PTree.empty _) (ret_type Delta) (glob_types Delta) (glob_specs Delta) (annotations Delta).
+  mk_tycontext (Maps.PTree.empty _) (Maps.PTree.empty _) (ret_type Delta) (glob_types Delta) (glob_specs Delta) (annotations Delta).
 
 Definition typesig_of_funspec (fs: funspec) : typesig :=
- match fs with mk_funspec fsig _ _ _ _ _ _ => fsig end.
+ match fs with mk_funspec fsig _ _ _ _ _ => fsig end.
 
 Definition xtype_of_funspec (fs: funspec) : type := snd (typesig_of_funspec fs).
 
@@ -153,28 +144,30 @@ Lemma fssub_prop1: forall rt ptypes gargs,
      Forall2 tc_val' ptypes (snd gargs).
 intros. destruct gargs. unfold tc_argsenv. simpl.
 unfold tc_genv. simpl.
-unfold typecheck_glob_environ. apply prop_ext; split; intros. apply H.
-split; trivial. intros. rewrite PTree.gempty in H0. congruence.
+unfold typecheck_glob_environ. apply Axioms.prop_ext; split; intros. apply H.
+split; trivial. intros. rewrite Maps.PTree.gempty // in H0.
 Qed.
 
-Lemma fssub_prop2: forall rt rho, (local (tc_environ (xtype_tycontext rt)) rho) = !!(ve_of rho = Map.empty (block * type)).
+Lemma fssub_prop2: forall rt rho, (local (tc_environ (xtype_tycontext rt)) rho) ⊣⊢ ⌜ve_of rho = Map.empty (block * type)⌝.
 intros. unfold local, tc_environ, lift1.
 unfold xtype_tycontext, typecheck_environ, typecheck_temp_environ,
 typecheck_var_environ, typecheck_glob_environ.
 simpl.
-destruct rho; simpl. apply pred_ext. 
-intros u U. simpl in U. simpl. destruct U as [? [? ?]].
-apply Map.ext. intros. clear H H1. specialize (H0 x).
-destruct (Map.get ve); simpl in *. 
-destruct p.  destruct (H0 t); clear H0. clear H.
-exfalso. exploit H1. eexists; reflexivity. rewrite PTree.gempty. congruence.
-reflexivity.
-intros u U. simpl in *. subst. split3; intros.
- rewrite PTree.gempty in H; congruence.
- split; intros. rewrite PTree.gempty in H; congruence.
- destruct H.  inv H.
- rewrite PTree.gempty in H. congruence.
-Qed.
+destruct rho; simpl. apply bi.pure_iff; split.
+- intros [? [? ?]].
+  apply Map.ext. intros. clear H H1. specialize (H0 x).
+  destruct (Map.get ve); simpl in *.
+  destruct p.  destruct (H0 t); clear H0. clear H.
+  exfalso. exploit H1. eexists; reflexivity. rewrite Maps.PTree.gempty. congruence.
+  reflexivity.
+- intros U. simpl in *. subst. split3; intros.
+  rewrite Maps.PTree.gempty in H; congruence.
+  split; intros. rewrite Maps.PTree.gempty in H; congruence.
+  destruct H. inv H.
+  rewrite Maps.PTree.gempty in H. congruence.
+Qed.
+
+Open Scope bi_scope.
 
 (* If we were to require that a non-void-returning function must,
    at a function call, have its result assigned to a temp,
@@ -187,14 +180,13 @@ match f1 with
 | mk_funspec tpsig1 cc1 A1 P1 Q1 _ _ =>
     match f2 with
     | mk_funspec tpsig2 cc2 A2 P2 Q2 _ _ =>
-        !!(tpsig1=tpsig2 /\ cc1=cc2) &&
-    |>   ! (ALL ts2 :_, ALL x2:dependent_type_functor_rec ts2 A2 mpred,
-             ALL gargs:genviron * list val,
-        ((!!(tc_argsenv Delta2 (fst tpsig2) gargs) && P2 ts2 x2 gargs)
-         >=> EX ts1:_,  EX x1:dependent_type_functor_rec ts1 A1 mpred, EX F:_, 
-            (F * (P1 ts1 x1 gargs)) &&
-            ALL rho':_, (     !( ((local (tc_environ (xtype_tycontext (snd tpsig1))) rho') && (F * (Q1 ts1 x1 rho')))
-                         >=> (Q2 ts2 x2 rho')))))
+        !!(tpsig1=tpsig2 /\ cc1=cc2) ∧
+    ▷   ! (∀ ts2 :_, ∀ x2:dependent_type_functor_rec ts2 A2 mpred,
+             ∀ gargs:genviron * list val,
+        ((!!(tc_argsenv Delta2 (fst tpsig2) gargs) ∧ P2 ts2 x2 gargs)
+         >=> ∃ ts1:_,  ∃ x1:dependent_type_functor_rec ts1 A1 mpred, ∃ F:_, 
+            (F ∗ (P1 ts1 x1 gargs)) ∧
+            ∀ rho':_, (     !( ((local (tc_environ (xtype_tycontext (snd tpsig1))) rho') ∧ (F ∗ (Q1 ts1 x1 rho')))
     end
 end.
 Definition funspec_sub_si_AUX1 (f1 f2 : funspec):mpred :=
@@ -202,6 +194,14 @@ match f1 with
 | mk_funspec tpsig1 cc1 A1 P1 Q1 _ _ =>
     match f2 with
     | mk_funspec tpsig2 cc2 A2 P2 Q2 _ _ =>
+       let Delta := xtype_tycontext (snd tpsig1) in
+        !!(tpsig1=tpsig2 /\ cc1=cc2) ∧
+        ! (∀ ts2 :_, ∀ x2:dependent_type_functor_rec ts2 A2 mpred,
+             ∀ gargs:genviron * list val,
+        ((!!(tc_argsenv Delta (fst tpsig1) gargs) ∧ P2 ts2 x2 gargs)
+         >=> ∃ ts1:_,  ∃ x1:_, ∃ F:_, 
+            (F * (P1 ts1 x1 gargs)) ∧
+            ∀ rho':_, (     !( ((local (tc_environ Delta) rho') ∧ (F * (Q1 ts1 x1 rho')))
        let Delta := xtype_tycontext (snd tpsig1) in
         !!(tpsig1=tpsig2 /\ cc1=cc2) &&
         ! (ALL ts2 :_, ALL x2:dependent_type_functor_rec ts2 A2 mpred,
@@ -228,13 +228,13 @@ match f1 with
 | mk_funspec tpsig1 cc1 A1 P1 Q1 _ _ =>
     match f2 with
     | mk_funspec tpsig2 cc2 A2 P2 Q2 _ _ =>
-        !!(tpsig1=tpsig2 /\ cc1=cc2) &&
-        ! (ALL ts2 :_, ALL x2:dependent_type_functor_rec ts2 A2 mpred,
-             ALL gargs:genviron * list val,
-        ((!!(Forall2 tc_val' (fst tpsig1) (snd gargs)) && P2 ts2 x2 gargs)
-         >=> EX ts1:_,  EX x1:_, EX F:_, 
-            (F * (P1 ts1 x1 gargs)) &&
-            ALL rho':_, (     !( ((!!(ve_of rho' = Map.empty (block * type))) && (F * (Q1 ts1 x1 rho')))
+        !!(tpsig1=tpsig2 /\ cc1=cc2) ∧
+        ! (∀ ts2 :_, ∀ x2:dependent_type_functor_rec ts2 A2 mpred,
+             ∀ gargs:genviron * list val,
+        ((!!(Forall2 tc_val' (fst tpsig1) (snd gargs)) ∧ P2 ts2 x2 gargs)
+         >=> ∃ ts1:_,  ∃ x1:_, ∃ F:_, 
+            (F * (P1 ts1 x1 gargs)) ∧
+            ∀ rho':_, (     !( ((!!(ve_of rho' = Map.empty (block * type))) ∧ (F * (Q1 ts1 x1 rho')))
                          >=> (Q2 ts2 x2 rho')))))
     end
 end. 
@@ -261,61 +261,73 @@ Qed.*)
 Definition argsHaveTyps (vals:list val) (types: list type): Prop:=
   Forall2 (fun v t => v<>Vundef -> Val.has_type v t) vals (map typ_of_type types).
 
-Notation fupd := (fupd Ensembles.Full_set Ensembles.Full_set).
-
-Section invs.
-Context {inv_names : invG}.
-
-Definition funspec_sub_si (f1 f2 : funspec):mpred :=
+Definition funspec_sub_si (f1 f2 : funspec) : mpred :=
 match f1 with
-| mk_funspec tpsig1 cc1 A1 P1 Q1 _ _ =>
+| mk_funspec tpsig1 cc1 A1 E1 P1 Q1 =>
     match f2 with
-    | mk_funspec tpsig2 cc2 A2 P2 Q2 _ _ =>
-        !!(tpsig1=tpsig2 /\ cc1=cc2) &&
-       |>  ! (ALL ts2 :_, ALL x2:dependent_type_functor_rec ts2 A2 mpred,
-             ALL gargs:genviron * list val,
-        ((!!(argsHaveTyps (snd gargs) (fst tpsig1)) && P2 ts2 x2 gargs)
-         >=> fupd (EX ts1:_, EX x1:_, EX F:_, 
-            (F * (P1 ts1 x1 gargs)) &&
-            ALL rho':_, (     !( ((!!(ve_of rho' = Map.empty (block * type))) && (F * (Q1 ts1 x1 rho')))
-                         >=> (Q2 ts2 x2 rho'))))))
+    | mk_funspec tpsig2 cc2 A2 E2 P2 Q2 =>
+        ⌜tpsig1=tpsig2 /\ cc1=cc2⌝ ∧
+       ▷ ■ ∀ (x2:dtfr A2) (gargs:genviron * list val),
+        ((⌜argsHaveTyps (snd gargs) (fst tpsig1)⌝ ∧ P2 x2 gargs)
+         ={E2 x2}=∗ (∃ x1 F, ⌜E1 x1 ⊆ E2 x2⌝ ∧
+            (F ∗ (P1 x1 gargs)) ∧
+            ∀ rho', (■(((⌜ve_of rho' = Map.empty (block * type)⌝ ∧ (F ∗ (Q1 x1 rho')))
+                         -∗ (Q2 x2 rho'))))))
     end
 end.
 
 Definition funspec_sub (f1 f2 : funspec): Prop :=
 match f1 with
-| mk_funspec tpsig1 cc1 A1 P1 Q1 _ _ =>
+| mk_funspec tpsig1 cc1 A1 E1 P1 Q1 =>
     match f2 with
-    | mk_funspec tpsig2 cc2 A2 P2 Q2 _ _ =>
+    | mk_funspec tpsig2 cc2 A2 E2 P2 Q2 =>
         (tpsig1=tpsig2 /\ cc1=cc2) /\
-        forall ts2 (x2:dependent_type_functor_rec ts2 A2 mpred) (gargs:argsEnviron),
-        ((!! (argsHaveTyps(snd gargs)(fst tpsig1)) && P2 ts2 x2 gargs)
-         |-- fupd (EX ts1:_,  EX (x1:dependent_type_functor_rec ts1 A1 mpred), EX F:_, 
-                           (F * (P1 ts1 x1 gargs)) &&
-                               (!! (forall rho',
-                                           ((!!(ve_of rho' = Map.empty (block * type))) &&
-                                                 (F * (Q1 ts1 x1 rho')))
-                                         |-- (Q2 ts2 x2 rho')))))
+        forall (x2:dtfr A2) (gargs:argsEnviron),
+        (⌜argsHaveTyps(snd gargs)(fst tpsig1)⌝ ∧ P2 x2 gargs)
+         ⊢ |={E2 x2}=> (∃ (x1:dtfr A1) (F:_), ⌜E1 x1 ⊆ E2 x2⌝ ∧
+                           (F ∗ (P1 x1 gargs)) ∧
+                               (⌜forall rho',
+                                           (⌜ve_of rho' = Map.empty (block * type)⌝ ∧
+                                                 (F ∗ (Q1 x1 rho')))
+                                         ⊢ (Q2 x2 rho')⌝))
     end
 end.
 
-Lemma funspec_sub_sub_si f1 f2: funspec_sub f1 f2 -> TT |-- funspec_sub_si f1 f2.
+Global Instance funspec_sub_si_plain f1 f2 : Plain (funspec_sub_si f1 f2).
+Proof. destruct f1, f2; apply _. Qed.
+
+Global Instance funspec_sub_si_absorbing f1 f2 : Absorbing (funspec_sub_si f1 f2).
+Proof. destruct f1, f2; simpl; apply _. Qed.
+
+Lemma funspec_sub_sub_si f1 f2: funspec_sub f1 f2 -> ⊢ funspec_sub_si f1 f2.
 Proof.
   intros. destruct f1; destruct f2; simpl in *.
-  destruct H as [[? ?] H']; subst. intros w _. split; [split; trivial |].
-  intros w' Hw'.
-  intros ts2 x2 rho y WY k YK N E K.
-  apply H' in K.
-  eapply fupd_mono, K.
-  repeat (apply exp_derives; intros).
-  apply andp_derives; auto.
-  intros ? H rho' v KV z VZ Z EZ. apply H; trivial.
+  destruct H as [[? ?] H']; subst.
+  iSplit; first done.
+  iIntros "!> !>" (x2 gargs) "H".
+  iMod (H' with "H") as (x1 F HE) "[H' %]".
+  iIntros "!>"; iExists x1, F; iFrame.
+  iSplit; auto; iSplit; auto.
+  iIntros (rho') "!> H".
+  by iApply H.
+Qed.
+
+Lemma funspec_sub_sub_si' f1 f2: ⌜funspec_sub f1 f2⌝ ⊢ funspec_sub_si f1 f2.
+Proof.
+  iApply bi.pure_elim'; intros.
+  destruct f1; destruct f2; simpl in *.
+  destruct H as [[? ?] H']; subst.
+  iIntros "?"; iSplit; first done.
+  iIntros "!> !>" (x2 gargs) "H".
+  iMod (H' with "H") as (x1 F HE) "[H' %]".
+  iIntros "!>"; iExists x1, F; iFrame.
+  iSplit; auto; iSplit; auto.
+  iIntros (rho') "!> H".
+  by iApply H.
 Qed.
 
-Lemma funspec_sub_sub_si' f1 f2: !!(funspec_sub f1 f2) |-- funspec_sub_si f1 f2.
-Proof. intros w W. apply funspec_sub_sub_si; trivial. Qed.
 (*
-Lemma funspec_sub_early_sub_si f1 f2: funspec_sub_early f1 f2 |-- funspec_sub_si f1 f2.
+Lemma funspec_sub_early_sub_si f1 f2: funspec_sub_early f1 f2 ⊢ funspec_sub_si f1 f2.
 Proof. intros p P. destruct f1; destruct f2; simpl in *.
 destruct P as [[? ?] H']; subst. split; [split; trivial |].
 intros ts2 x2 rho y WY k YK K c J.
@@ -325,253 +337,214 @@ eexists; split; eauto; exists m'; repeat (split; auto).
 exists ts1, x1, F. rewrite Hl; auto.
 Qed.
 *)
+
 Lemma funspec_sub_refl f: funspec_sub f f.
 Proof.
-  destruct f; split; [ split; trivial | intros ts2 x2 rho w [T W]].
-  apply fupd_intro.
-  exists ts2, x2, emp. rewrite emp_sepcon. split; trivial. hnf; intros. 
-  rewrite emp_sepcon. apply andp_left2, derives_refl.
+  destruct f; split; [ split3; trivial | intros x2 rho].
+  iIntros "[_ P] !>".
+  iExists x2, emp%I; iFrame; iPureIntro.
+  split3; auto; intros; iIntros "(_ & _ & $)".
 Qed.
 
-Lemma funspec_sub_trans f1 f2 f3: funspec_sub f1 f2 -> 
-      funspec_sub f2 f3 -> funspec_sub f1 f3.
+(* allows to unify A1 A2 first, as P, Q may depend on A *)
+Lemma funspec_sub_refl_dep A1 A2 cc1 cc2 sig1 sig2 E1 E2 P1 P2 Q1 Q2 :
+  JMeq A1 A2 ->
+  cc1 = cc2 ->
+  sig1 = sig2 ->
+  JMeq E1 E2 ->
+  JMeq P1 P2 ->
+  JMeq Q1 Q2 ->
+  funspec_sub (mk_funspec cc1 sig1 A1 E1 P1 Q1) (mk_funspec cc2 sig2 A2 E2 P2 Q2).
 Proof.
-  destruct f1; destruct f2; destruct f3; intros.
-  destruct H as [[? ?] H12]; subst t0 c0.
-  destruct H0 as [[? ?] H23]; subst t1 c1.
-  split; [ split; trivial | intros ts x rho].
-  apply prop_andp_left; intro Hlocal.
-  eapply derives_trans.
-  { eapply derives_trans, H23; apply andp_right; eauto; intros ??; auto. }
-  eapply derives_trans, fupd_trans; apply fupd_mono.
-  apply exp_left; intro ts1.
-  apply exp_left; intro x1.
-  apply exp_left; intro F.
-  eapply derives_trans; [apply andp_derives, derives_refl|].
-  { eapply sepcon_derives, derives_trans, H12; [apply derives_refl|].
-    apply andp_right; eauto; intros ??; auto. }
-  rewrite andp_comm, <- normalize.sepcon_andp_prop'.
-  eapply derives_trans; [apply fupd_frame_l | apply fupd_mono].
-  rewrite exp_sepcon2; apply exp_left; intros ts2.
-  rewrite exp_sepcon2; apply exp_left; intros x2.
-  rewrite exp_sepcon2; apply exp_left; intros G.
-  apply exp_right with ts2; apply exp_right with x2; apply exp_right with (F*G).
-  rewrite normalize.sepcon_andp_prop'.
-  rewrite (andp_comm _ (!! _)), sepcon_andp_prop.
-  rewrite <- andp_assoc, andp_comm; apply andp_derives.
-  { rewrite sepcon_assoc; auto. }
-  intros ? [H1 H2]; simpl in *.
-  intros rho'; eapply derives_trans, H1.
-  apply prop_andp_left; intros Hlocal'.
-  unfold local; simpl; unfold lift1; simpl.
-  apply andp_right; [intros ??; auto|].
-  rewrite sepcon_assoc; eapply sepcon_derives, derives_trans, H2; auto.
-  apply andp_right; auto; intros ??; auto.
+intros. subst. apply funspec_sub_refl.
 Qed.
 
-Lemma unfash_allp':  forall {A} {agA: ageable A} {EO: Ext_ord A} {B} (f: B -> pred nat),
-  @unfash _ agA EO (allp f) = allp (fun x:B => unfash (f x)).
+Lemma funspec_sub_trans f1 f2 f3: funspec_sub f1 f2 ->
+      funspec_sub f2 f3 -> funspec_sub f1 f3.
 Proof.
-intros.
-apply pred_ext.
-intros ? ? ?.
-specialize (H b). auto.
-repeat intro. apply (H b).
+  destruct f1 as [cc1 sig1 A1 E1 P1 Q1]; destruct f2 as [cc2 sig2 A2 E2 P2 Q2]; destruct f3 as [cc3 sig3 A3 E3 P3 Q3].
+  intros [(? & ?) H12]; subst sig1 cc1.
+  intros [(? & ?) H23]; subst sig2 cc2.
+  split; [split3; trivial | intros x rho].
+  iIntros "[% H]".
+  iMod (H23 with "[$H]") as (x2 F2 HE2) "[[F2 H] %H32]"; first done.
+  iMod (fupd_mask_subseteq (E2 x2)) as "Hmask"; first done.
+  iMod (H12 with "[$H]") as (x1 F1 HE1) "[[F1 H] %H21]"; first done.
+  iMod "Hmask" as "_".
+  iIntros "!>"; iExists x1, (F2 ∗ F1)%I.
+  iFrame; iPureIntro.
+  split3; auto; intros.
+  { by etrans. }
+  iIntros "(% & [F2 F1] & H)".
+  by iApply H32; iFrame "% F2"; iApply H21; iFrame.
 Qed.
 
-Lemma allp_andp1: forall {A} {agA: ageable A} {EO: Ext_ord A} {B} (P : B -> pred A) Q, (ALL a : B, P a) && Q |-- ALL a : B, P a && Q.
+Lemma funspec_sub_si_refl f: ⊢ funspec_sub_si f f.
 Proof.
-  intros; apply allp_right; intro x.
-  apply andp_derives; auto.
-  apply allp_left with x; auto.
+  apply funspec_sub_sub_si, funspec_sub_refl.
 Qed.
 
-Lemma unfash_exp:  forall {A} {agA: ageable A} {EO: Ext_ord A} {B} (f: B -> pred nat),
-  @unfash _ agA EO (exp f) = exp (fun x:B => unfash (f x)).
+Lemma funspec_sub_si_trans f1 f2 f3: funspec_sub_si f1 f2 ∧ funspec_sub_si f2 f3 ⊢
+      funspec_sub_si f1 f3.
 Proof.
-intros.
-apply pred_ext.
-intros ? [? ?]; simpl; eauto.
-intros ? [? ?]; simpl in *; eauto.
+  destruct f1 as [?? A1 E1 P1 Q1]; destruct f2 as [?? A2 E2 P2 Q2]; destruct f3 as [?? A3 E3 P3 Q3].
+  unfold funspec_sub_si; simpl.
+  iIntros "[[(-> & ->) #H12] [(-> & ->) #H23]]".
+  iSplit.
+  { iPureIntro; split3; trivial; by etrans. }
+  iIntros "!> !>" (x gargs) "[% H]".
+  iMod ("H23" with "[$H]") as (x2 F2 HE2) "H"; first done.
+  rewrite -plainly_forall; iDestruct "H" as "[[F2 H] #H32]".
+  iMod (fupd_mask_subseteq (E2 x2)) as "Hmask"; first done.
+  iMod ("H12" with "[$H]") as (x1 F1 HE1) "H"; first done.
+  rewrite -plainly_forall; iDestruct "H" as "[[F1 H] #H21]".
+  iMod "Hmask" as "_".
+  iIntros "!>"; iExists x1, (F2 ∗ F1)%I.
+  iFrame; iSplit.
+  { iPureIntro; by etrans. }
+  iSplit; first done.
+  iIntros (rho') "!> (% & [F2 F1] & H)".
+  by iApply "H32"; iFrame "% F2"; iApply "H21"; iFrame.
+Qed.
+
+Global Instance funspec_sub_si_nonexpansive : NonExpansive2 (funspec_sub_si).
+Proof.
+  intros ? [?????] [?????] (? & ? & ? & HE1 & HP1 & HQ1) [?????] [?????] (? & ? & ? & HE2 & HP2 & HQ2); subst; simpl in *.
+  do 8 f_equiv.
+  { rewrite (HP2 _ _) //. }
+  rewrite HE2.
+  do 6 f_equiv.
+  { rewrite HE1 //. }
+  f_equiv.
+  { rewrite (HP1 _ _) //. }
+  do 4 f_equiv.
+  { rewrite (HQ1 _ _) //. }
+  { rewrite (HQ2 _ _) //. }
 Qed.
 
-Lemma unfash_andp:  forall {A} {agA: ageable A} {EO: Ext_ord A} (P Q : pred nat),
-  @unfash _ agA EO (andp P Q) = andp (unfash P) (unfash Q).
-Proof.
-intros.
-apply pred_ext; intros ? []; split; auto.
-Qed.
+(*******************end of material moved here from expr.v *******************)
 
-Lemma allp_sepcon1': forall {A} (P : A -> pred rmap) Q, (ALL x : A, P x) * Q |-- ALL x : A, P x * Q.
-Proof.
-  intros.
-  apply allp_right; intro x.
-  apply sepcon_derives; auto.
-  apply allp_left with x; auto.
-Qed.
+(* Interesting note: in Caesium, they store the function in the ghost state instead of the spec.
+   Could we then quantify over a function that meets a spec? *)
 
-Lemma unfash_sepcon: forall P (Q : pred rmap), !P * Q |-- !P.
-Proof.
-  intros ??? (? & ? & J & ? & ?); simpl in *.
-  apply join_level in J as [<- _]; auto.
-Qed.
+Definition funspec_auth m := own(inG0 := funspec_inG) funspec_name (gmap_view_auth (dfrac.DfracOwn 1) m).
+Definition know_funspec l (f: funspec) := own(inG0 := funspec_inG) funspec_name (gmap_view_frag l dfrac.DfracDiscarded (funspec_unfold f)).
+
+Definition func_at (f: funspec) (l : address) : mpred := l ↦□ FUN ∗ know_funspec l f.
 
-Lemma subp_exp_left: forall {A} G P Q, (forall x, G |-- P x >=> Q) -> G |-- (EX x : A, P x) >=> Q.
+Global Instance inhabited_typesig : Inhabited typesig := populate ([], Tvoid).
+Global Instance inhabited_calling_convention : Inhabited calling_convention := populate cc_default.
+Global Instance inhabited_typetree : Inhabited TypeTree := populate Mpred.
+
+Lemma func_at_agree f1 f2 l : ⊢ func_at f1 l -∗ func_at f2 l -∗ ∃ sig cc A E P1 P2 Q1 Q2,
+  ▷ (⌜f1 = mk_funspec sig cc A E P1 Q1 ∧ f2 = mk_funspec sig cc A E P2 Q2⌝ ∧ P1 ≡ P2 ∧ Q1 ≡ Q2).
 Proof.
-  repeat intro.
-  destruct H4 as [x HP].
-  eapply H; eauto.
+  intros; iIntros "(_ & Hf1) (_ & Hf2)".
+  iDestruct (own_valid_2 with "Hf1 Hf2") as "H".
+  rewrite gmap_view_frag_op_validI later_equivI funspec_equivI; iDestruct "H" as "[_ H]".
+  iDestruct "H" as (????????) "H".
+  iExists _, _, _, _, _, _, _, _; done.
 Qed.
 
-Lemma funspec_sub_si_refl f: TT |-- funspec_sub_si f f.
+Lemma func_at_auth m f l : ⊢ funspec_auth m -∗ func_at f l -∗ (m !! l)%stdpp ≡ Some (funspec_unfold f).
 Proof.
-  destruct f; split; [split; trivial |].
-  intros a' Ha'.
-  clear H. intros ts2 x2 rho.
-  intros y Hy z ? Hz Hz' [_ ?]. apply fupd_intro.
-  exists ts2, x2, emp; rewrite emp_sepcon. split; auto.
-  intros rho' k WK u ? necKU E Z.
-  rewrite emp_sepcon in Z. apply Z.
+  intros; iIntros "Hm (_ & Hf)".
+  iDestruct (own_valid_2 with "Hm Hf") as "H".
+  rewrite gmap_view_both_validI bi.and_elim_r //.
 Qed.
 
-Lemma funspec_sub_si_trans f1 f2 f3: funspec_sub_si f1 f2 && funspec_sub_si f2 f3 |--
-      funspec_sub_si f1 f3.
-Proof. destruct f1; destruct f2; destruct f3.
-unfold funspec_sub_si; simpl.
-rewrite !andp_assoc; apply prop_andp_left; intros []; subst.
-rewrite andp_comm, andp_assoc; apply prop_andp_left; intros []; subst.
-apply andp_right; [intros ??; simpl; auto|].
-rewrite <- later_andp. apply later_derives.
-rewrite <- unfash_andp; apply unfash_derives.
-apply allp_right; intros ts.
-apply allp_right; intros x.
-apply allp_right; intros rho.
-eapply derives_trans; [apply allp_andp1|].
-apply allp_left with ts.
-eapply derives_trans; [apply allp_andp1|].
-apply allp_left with x.
-eapply derives_trans; [apply allp_andp1|].
-apply allp_left with rho.
-eapply subp_trans.
-{ apply andp_left1.
-  rewrite <- (andp_dup (!! argsHaveTyps _ _)) at 2; rewrite andp_assoc; apply subp_andp, derives_refl; apply subp_refl. }
-eapply subp_trans.
-{ apply andp_left2.
-  intros ??. apply prop_andp_subp; intro.
-  eapply subp_fupd, H.
-  apply subp_exp; intro ts1.
-  apply subp_exp; intro x1.
-  apply subp_exp; intro F.
-  apply allp_left with ts1; apply allp_left with x1; apply allp_left with rho.
-  rewrite prop_true_andp by auto.
-  apply subp_andp, subp_refl. apply subp_sepcon, derives_refl; apply subp_refl. }
-apply derives_trans with TT; auto.
-eapply derives_trans, subp_derives, fupd_trans; [|apply derives_refl].
-apply subp_fupd.
-apply subp_exp_left; intro ts1.
-apply subp_exp_left; intro x1.
-apply subp_exp_left; intro F.
-rewrite <- unfash_allp', andp_comm.
-eapply derives_trans, subp_derives, derives_refl; [ | apply andp_derives, fupd_frame_l; apply derives_refl].
-eapply derives_trans, subp_derives; [apply subp_fupd | apply fupd_andp_unfash | apply derives_refl].
-rewrite exp_sepcon2, exp_andp2; apply subp_exp_left; intro ts2.
-rewrite exp_sepcon2, exp_andp2; apply subp_exp_left; intro x2.
-rewrite exp_sepcon2, exp_andp2; apply subp_exp_left; intro G.
-eapply subp_trans, subp_exp_spec.
-eapply subp_trans, subp_exp_spec.
-eapply subp_trans, @subp_exp_spec with (x := F*G).
-eapply derives_trans, subp_derives, derives_refl; [|apply andp_derives, distrib_sepcon_andp; apply derives_refl].
-rewrite andp_comm, andp_assoc; apply subp_andp.
-+ rewrite sepcon_assoc; apply subp_refl.
-+ rewrite <- unfash_allp'; eapply derives_trans, subp_derives, derives_refl; [|apply andp_derives, derives_refl; rewrite sepcon_comm; apply unfash_sepcon].
-  rewrite <- unfash_andp, <- unfash_allp'; intros ? _; apply subp_unfash, derives_subp.
-  apply allp_right; intro rho'.
-  eapply derives_trans; [apply allp_andp1|].
-  apply allp_left with rho'.
-  eapply subp_trans.
-  { apply andp_left1.
-    rewrite <- (andp_dup (!! (ve_of rho' = Map.empty (block * type)))) at 2; rewrite andp_assoc; apply subp_andp; [apply subp_refl|].
-    rewrite sepcon_assoc, <- (sepcon_andp_prop F).
-    apply subp_sepcon, derives_refl; apply subp_refl. }
-  apply andp_left2, allp_left with rho'; auto.
-Qed.
+Definition func_at' (f: funspec) (l: address) : mpred :=
+  match f with
+   | mk_funspec fsig cc _ _ _ _ => ∃ A E P Q, func_at (mk_funspec fsig cc A E P Q) l
+  end.
 
-(*******************end of material moved here from expr.v *******************)
+Global Instance func_at'_persistent f l : Persistent (func_at' f l).
+Proof. destruct f; apply _. Qed.
 
-Definition func_at (f: funspec): address -> pred rmap :=
-  match f with
-   | mk_funspec fsig cc A P Q _ _ => pureat (SomeP (SpecArgsTT A) (packPQ P Q)) (FUN fsig cc)
-  end. 
+Global Instance func_at'_affine f l : Affine (func_at' f l).
+Proof. destruct f; apply _. Qed.
 
-Definition func_at' (f: funspec) (loc: address) : pred rmap :=
-  match f with
-   | mk_funspec fsig cc _ _ _ _ _ => EX pp:_, pureat pp (FUN fsig cc) loc
-  end.
-Definition sigcc_at (fsig: typesig) (cc:calling_convention) (loc: address) : pred rmap :=
-  EX pp:_, pureat pp (FUN fsig cc) loc.
+Definition sigcc_at (fsig: typesig) (cc:calling_convention) (l: address) : mpred :=
+  ∃ A E P Q, func_at (mk_funspec fsig cc A E P Q) l.
 
 Definition func_ptr_si (f: funspec) (v: val): mpred :=
-  EX b: block, !! (v = Vptr b Ptrofs.zero) && (EX gs: funspec, funspec_sub_si gs f && func_at gs (b, 0)).
+  ∃ b, ⌜v = Vptr b Ptrofs.zero⌝ ∧ (∃ gs: funspec, funspec_sub_si gs f ∧ func_at gs (b, 0)).
 
 Definition func_ptr (f: funspec) (v: val): mpred :=
-  EX b: block, !! (v = Vptr b Ptrofs.zero) && (EX gs: funspec, !!(funspec_sub gs f) && func_at gs (b, 0)).
+  ∃ b, ⌜v = Vptr b Ptrofs.zero⌝ ∧ (∃ gs: funspec, ⌜funspec_sub gs f⌝ ∧ func_at gs (b, 0)).
+
+(*Definition func_ptr_si ge E id (f: funspec) (v: val): mpred :=
+  ∃ b, ⌜Map.get ge id = Some b ∧ v = Vptr b Ptrofs.zero⌝ ∧ (∃ gs: funspec, funspec_sub_si E gs f ∧ func_at gs (b, 0)).
 
-Lemma func_ptr_fun_ptr_si f v: func_ptr f v |-- func_ptr_si f v.
-Proof. apply exp_derives; intros b. apply andp_derives; trivial.
- apply exp_derives; intros gs. apply andp_derives; trivial. apply funspec_sub_sub_si'.
+Definition func_ptr ge E id (f: funspec) (v: val): mpred :=
+  ∃ b, ⌜Map.get ge id = Some b ∧ v = Vptr b Ptrofs.zero⌝ ∧ (∃ gs: funspec, ⌜funspec_sub E gs f⌝ ∧ func_at gs (b, 0)).*)
+
+Lemma func_ptr_fun_ptr_si f v: func_ptr f v ⊢ func_ptr_si f v.
+Proof.
+  iIntros "H"; iDestruct "H" as (????) "H".
+  iExists b; iFrame "%"; iExists gs; iFrame.
+  iSplit; auto; by iApply funspec_sub_sub_si'.
 Qed.
 
-Lemma func_ptr_si_mono fs gs v: 
-      funspec_sub_si fs gs && func_ptr_si fs v |-- func_ptr_si gs v.
-Proof. unfold func_ptr_si. rewrite exp_andp2. apply exp_derives; intros b.
-  rewrite andp_comm, andp_assoc. apply andp_derives; trivial.
-  rewrite andp_comm, exp_andp2. apply exp_derives; intros hs.
-  rewrite <- andp_assoc. apply andp_derives; trivial.
-  rewrite andp_comm. apply funspec_sub_si_trans.
+Lemma func_ptr_si_mono fs gs v:
+      funspec_sub_si fs gs ∧ func_ptr_si fs v ⊢ func_ptr_si gs v.
+Proof.
+  iIntros "H".
+  rewrite /func_ptr_si bi.and_exist_l.
+  iDestruct "H" as (b) "H".
+  rewrite bi.and_comm -bi.and_assoc bi.and_exist_r.
+  iDestruct "H" as (? hs) "H".
+  iExists b; iFrame "%"; iExists hs.
+  rewrite bi.and_comm bi.and_assoc.
+  iSplit; last by iDestruct "H" as "[_ $]".
+  rewrite (bi.and_comm (funspec_sub_si _ _)).
+  iApply funspec_sub_si_trans.
+  iDestruct "H" as "[$ _]".
 Qed.
 
-Lemma func_ptr_mono fs gs v: funspec_sub fs gs -> 
-      func_ptr fs v |-- func_ptr gs v.
-Proof. intros. unfold func_ptr. apply exp_derives; intros b.
-  apply andp_derives; trivial. apply exp_derives; intros hs.
-  apply andp_derives; trivial.
-  intros w W. eapply funspec_sub_trans. apply W. apply H.
+Lemma func_ptr_mono fs gs v: funspec_sub fs gs ->
+      func_ptr fs v ⊢ func_ptr gs v.
+Proof.
+  intros; rewrite /func_ptr.
+  iIntros "H"; iDestruct "H" as (?? hs ?) "H".
+  iExists b; iSplit; first done; iExists hs; iFrame; iPureIntro.
+  split; auto; eapply funspec_sub_trans; eauto.
 Qed.
 
-Lemma funspec_sub_implies_func_prt_si_mono' fs gs v: 
-      !!(funspec_sub fs gs) && func_ptr_si fs v |-- func_ptr_si gs v.
+Lemma funspec_sub_implies_func_prt_si_mono' fs gs v:
+      ⌜funspec_sub fs gs⌝ ∧ func_ptr_si fs v ⊢ func_ptr_si gs v.
 Proof.
-  eapply derives_trans. 2: apply func_ptr_si_mono.
-  apply andp_derives. 2: apply derives_refl. 
-  apply funspec_sub_sub_si'. 
+  iIntros "[% ?]"; iApply func_ptr_si_mono.
+  iFrame.
+  by iSplit; auto; iApply funspec_sub_sub_si'.
 Qed.
 
 Lemma funspec_sub_implies_func_prt_si_mono fs gs v: funspec_sub fs gs ->
-      func_ptr_si fs v |-- func_ptr_si gs v.
-Proof. intros. 
-  eapply derives_trans. 2: apply funspec_sub_implies_func_prt_si_mono'. 
-  apply andp_right. 2: apply derives_refl. hnf; intros; apply H. 
+      func_ptr_si fs v ⊢ func_ptr_si gs v.
+Proof.
+  intros.
+  iIntros "H"; iApply funspec_sub_implies_func_prt_si_mono'.
+  by iFrame.
 Qed.
 
-Definition NDmk_funspec (f: typesig) (cc: calling_convention)
-  (A: Type) (Pre: A -> argsEnviron -> mpred) (Post: A -> environ -> mpred): funspec :=
-  mk_funspec f cc (rmaps.ConstType A) (fun _ => Pre) (fun _ => Post)
-             (args_const_super_non_expansive _ _) (const_super_non_expansive _ _).
+Global Instance func_ptr_si_nonexpansive n : Proper (dist n ==> eq ==> dist n) func_ptr_si.
+Proof.
+  solve_proper.
+Qed.
 
 Lemma type_of_funspec_sub:
   forall fs1 fs2, funspec_sub fs1 fs2 ->
   type_of_funspec fs1 = type_of_funspec fs2.
 Proof.
 intros.
-destruct fs1, fs2; destruct H as [[? ?] _]. subst; simpl; auto.
+destruct fs1, fs2; destruct H as [(? & ?) _]. subst; simpl; auto.
 Qed.
 
 Lemma type_of_funspec_sub_si fs1 fs2:
-  funspec_sub_si fs1 fs2 |-- !!(type_of_funspec fs1 = type_of_funspec fs2).
+  funspec_sub_si fs1 fs2 ⊢ ⌜type_of_funspec fs1 = type_of_funspec fs2⌝.
 Proof.
-intros w W.
-destruct fs1, fs2.
-destruct W as [[? ?] _]. subst; simpl; auto.
+destruct fs1, fs2; simpl.
+by iIntros "[(-> & ->) _]".
 Qed.
 
 Lemma typesig_of_funspec_sub:
@@ -583,34 +556,48 @@ destruct fs1, fs2; destruct H as [[? ?] _]. subst; simpl; auto.
 Qed.
 
 Lemma typesig_of_funspec_sub_si fs1 fs2:
-  funspec_sub_si fs1 fs2 |-- !!(typesig_of_funspec fs1 = typesig_of_funspec fs2).
+  funspec_sub_si fs1 fs2 ⊢ ⌜typesig_of_funspec fs1 = typesig_of_funspec fs2⌝.
 Proof.
-intros w W.
-destruct fs1, fs2.
-destruct W as [[? ?] _]. subst; simpl; auto.
+destruct fs1, fs2; simpl.
+by iIntros "[(-> & ->) _]".
 Qed.
 
 Lemma typesig_of_funspec_sub_si2 fs1 fs2:
-  TT |-- funspec_sub_si fs1 fs2  -> typesig_of_funspec fs1 = typesig_of_funspec fs2.
+  (True ⊢ funspec_sub_si fs1 fs2) -> typesig_of_funspec fs1 = typesig_of_funspec fs2.
 Proof.
-intros. exploit (H (empty_rmap 0)). trivial. intros. 
-apply typesig_of_funspec_sub_si in H0. apply H0.
+intros. rewrite typesig_of_funspec_sub_si -(bi.True_intro emp) in H. by apply ouPred.pure_soundness in H.
 Qed.
 
-(* Definition assert: Type := environ -> pred rmap. *)
-
-Bind Scope pred with assert.
-Local Open Scope pred.
+Lemma funspec_sub_si_ne : forall fs1 fs2, funspec_unfold fs1 ≡ funspec_unfold fs2 ⊢ bi_except_0 (funspec_sub_si fs1 fs2).
+Proof.
+  intros; iIntros "H".
+  rewrite later_equivI funspec_equivI.
+  iDestruct "H" as (????????) "H".
+  rewrite !bi.later_and.
+  iDestruct "H" as "(>(-> & ->) & #(HP & HQ))".
+  iSplit; first done.
+  iIntros (x gargs).
+  iIntros "!> !> !>".
+  rewrite !ofe_morO_equivI.
+  iSpecialize ("HP" $! x); iSpecialize ("HQ" $! x).
+  rewrite !discrete_fun_equivI.
+  iSpecialize ("HP" $! gargs).
+  iRewrite -"HP"; iIntros "(% & H) !>".
+  iExists x, emp; iFrame.
+  iSplit; first done; iSplit; first done.
+  iIntros (rho) "!> (_ & _ & H)".
+  iSpecialize ("HQ" $! rho); iRewrite -"HQ"; done.
+Qed.
 
-Definition closed_wrt_vars {B} (S: ident -> Prop) (F: environ -> B) : Prop :=
+Program Definition closed_wrt_vars `{Equiv B} (S: ident -> Prop) (F: environ -> B) : Prop :=
   forall rho te',
      (forall i, S i \/ Map.get (te_of rho) i = Map.get te' i) ->
-     F rho = F (mkEnviron (ge_of rho) (ve_of rho) te').
+     (F rho ≡ F (mkEnviron (ge_of rho) (ve_of rho) te'))%stdpp.
 
-Definition closed_wrt_lvars {B} (S: ident -> Prop) (F: environ -> B) : Prop :=
+Definition closed_wrt_lvars `{Equiv B} (S: ident -> Prop) (F: environ -> B) : Prop :=
   forall rho ve',
      (forall i, S i \/ Map.get (ve_of rho) i = Map.get ve' i) ->
-     F rho = F (mkEnviron (ge_of rho) ve' (te_of rho)).
+     (F rho ≡ F (mkEnviron (ge_of rho) ve' (te_of rho)))%stdpp.
 
 Definition not_a_param (params: list (ident * type)) (i : ident) : Prop :=
   ~ In i (map (@fst _ _) params).
@@ -618,385 +605,40 @@ Definition not_a_param (params: list (ident * type)) (i : ident) : Prop :=
 Definition is_a_local (vars: list (ident * type)) (i: ident) : Prop :=
   In  i (map (@fst _ _) vars) .
 
-Fixpoint sepcon_list {A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A} {AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A}
-   (p: list (pred A)) : pred A :=
- match p with nil => emp | h::t => h * sepcon_list t end.
+Definition typed_true (t: type) (v: val) : Prop := strict_bool_val v t = Some true.
 
-Definition typed_true (t: type) (v: val)  : Prop := strict_bool_val v t
-= Some true.
+Definition typed_false (t: type)(v: val) : Prop := strict_bool_val v t = Some false.
 
-Definition typed_false (t: type)(v: val) : Prop := strict_bool_val v t =
-                                                   Some false.
-(*
-Definition subst {A} (x: ident) (v: val) (P: environ -> A) : environ -> A :=
-  fun s => P (env_set s x v).
-*)
 Definition subst {A} (x: ident) (v: environ -> val) (P: environ -> A) : environ -> A :=
    fun s => P (env_set s x (v s)).
 
-Lemma func_ptr_isptr: forall spec f, func_ptr spec f |-- !! val_lemmas.isptr f.
+Lemma func_ptr_isptr: forall spec f, func_ptr spec f ⊢ ⌜val_lemmas.isptr f⌝.
 Proof.
   intros.
   unfold func_ptr.
-  destruct spec. intros ? ?. destruct H as [b [Hb _]]; simpl in Hb; subst. unfold val_lemmas.isptr; simpl; trivial.
+  destruct spec. by iIntros "H"; iDestruct "H" as (b ->) "_".
 Qed.
-Lemma func_ptr_si_isptr: forall spec f, func_ptr_si spec f |-- !! val_lemmas.isptr f.
+Lemma func_ptr_si_isptr: forall spec f, func_ptr_si spec f ⊢ ⌜val_lemmas.isptr f⌝.
 Proof.
   intros.
   unfold func_ptr_si.
-  destruct spec. intros ? ?. destruct H as [b [Hb _]]; simpl in Hb; subst. unfold val_lemmas.isptr; simpl; trivial.
-Qed.
-
-Lemma  subst_extens:
- forall a v P Q, (forall rho, P rho |-- Q rho) -> forall rho, subst a v P rho |-- subst a v Q rho.
-Proof.
-unfold subst, derives.
-simpl;
-auto.
-Qed.
-
-Lemma approx_sepcon: forall (P Q: mpred) n,
-  approx n (P * Q) =
-  approx n P *
-  approx n Q.
-Proof.
-  intros.
-  apply predicates_hered.pred_ext.
-  + intros w ?.
-    simpl in *.
-    destruct H as [? [y [z [? [? ?]]]]].
-    exists y, z; split; auto.
-    split; split; auto.
-    - apply age_sepalg.join_level in H0.
-      lia.
-    - apply age_sepalg.join_level in H0.
-      lia.
-  + intros w ?.
-    simpl in *.
-    destruct H as [y [z [? [[? ?] [? ?]]]]].
-    split.
-    - apply age_sepalg.join_level in H.
-      lia.
-    - exists y, z.
-      split; [| split]; auto.
-Qed.
-
-Lemma approx_orp n P Q: approx n (orp P Q) = orp (approx n P) (approx n Q).
-Proof.
-  apply pred_ext; intros w W.
-  + destruct W. destruct H0;  [left | right]; split; trivial.
-  + destruct W; destruct H; split; trivial. left; trivial. right; trivial.
-Qed.
-
-Lemma approx_andp: forall (P Q: mpred) n,
-  approx n (P && Q) =
-  approx n P &&
-  approx n Q.
-Proof.
-  intros.
-  change andp with (@predicates_hered.andp compcert_rmaps.RML.R.rmap _ _) in *.
-  apply predicates_hered.pred_ext.
-  + intros w ?.
-    simpl in *.
-    tauto.
-  + intros w ?.
-    simpl in *.
-    tauto.
-Qed.
-
-Lemma approx_exp: forall A (P: A -> mpred) n,
-  approx n (exp P) =
-  EX a: A, approx n (P a).
-Proof.
-  intros.
-(*  change (@exp _ Nveric A) with (@predicates_hered.exp compcert_rmaps.RML.R.rmap _ A) in *. *)
-  apply predicates_hered.pred_ext.
-  + intros w ?.
-    simpl in *.
-    firstorder.
-  + intros w ?.
-    simpl in *.
-    firstorder.
-Qed.
-
-Lemma approx_allp: forall A (P: A -> mpred) n,
-  A ->
-  approx n (allp P) =
-  ALL a: A, approx n (P a).
-Proof.
-  intros.
-  apply predicates_hered.pred_ext.
-  + intros w ?.
-    simpl in *.
-    firstorder.
-  + intros w ?.
-    simpl in *.
-    firstorder.
-Qed.
-
-Lemma approx_jam {B: Type} {S': B -> Prop} (S: forall l, {S' l}+{~ S' l}) (P Q: B -> mpred) n (b : B) :
-  approx n (jam S P Q b) =
-  jam S (approx n oo P) (approx n oo Q) b.
-Proof.
-  apply predicates_hered.pred_ext.
-  + intros w ?. simpl in *. if_tac; firstorder.
-  + intros w ?. simpl in *. if_tac; firstorder.
-Qed.
-
-Lemma own_super_non_expansive: forall {RA: ghost.Ghost} n g a pp,
-  approx n (own g a pp) = approx n (own g a (preds_fmap (approx n) (approx n) pp)).
-Proof.
-  intros; unfold own.
-  rewrite !approx_exp; f_equal; extensionality v.
-  unfold Own.
-  rewrite !approx_andp; f_equal.
-  apply pred_ext; intros ? [? Hg]; split; auto; simpl in *.
-  - destruct Hg; eexists.
-    rewrite ghost_fmap_singleton in *; rewrite preds_fmap_fmap.
-    rewrite approx_oo_approx', approx'_oo_approx by lia; eauto.
-  - rewrite ghost_fmap_singleton in *.
-    rewrite preds_fmap_fmap in Hg.
-    rewrite approx_oo_approx', approx'_oo_approx in Hg by lia; auto.
-Qed.
-
-Lemma invariant_super_non_expansive : forall n N P,
-  approx n (invariant N P) = approx n (invariant N (approx n P)).
-Proof.
-  intros; unfold invariant.
-  rewrite !approx_exp; f_equal; extensionality g.
-  rewrite !approx_sepcon; f_equal.
-  apply own_super_non_expansive.
-Qed.
-
-(*
-Lemma approx_func_ptr: forall (A: Type) fsig0 cc (P Q: A -> environ -> mpred) (v: val) (n: nat),
-  approx n (func_ptr (NDmk_funspec fsig0 cc A P Q) v) = approx n (func_ptr (NDmk_funspec fsig0 cc A (fun a rho => approx n (P a rho)) (fun a rho => approx n (Q a rho))) v).
-Proof.
-  intros.
-  unfold func_ptr.
-  rewrite !approx_exp; f_equal; extensionality b.
-  rewrite !approx_andp; f_equal.
-  unfold func_at, NDmk_funspec.
-  simpl.
-  apply pred_ext; intros w; simpl; intros [? ?]; split; auto.
-  + (*destruct H0 as [gs [SUBS H0]]. exists gs; split; trivial.
-    eapply funspec_sub_trans; split. apply SUBS. clear SUBS H0; hnf.
-    split. split; trivial.
-    intros ts2 a rho m WM u necU U. simpl in U.
-    exists ts2, a, emp. rewrite emp_sepcon. split; intros; [ apply U | intros rho' k UP j KJ J; hnf].
-    rewrite emp_sepcon in J. simpl in J. intuition. apply necR_level in KJ. apply necR_level in necU. omega. *)
-    destruct H0 as [gs [SUBS H0]]. exists gs; split; trivial.
-    eapply funspec_sub_trans; split. apply SUBS. clear SUBS H0; hnf.
-    split. split; trivial.
-    intros ts2 a rho m WM u necU U. simpl in U.
-    exists ts2, a, emp. rewrite emp_sepcon. split; intros; [ apply U | intros rho' k UP j KJ z JZ HZ; hnf].
-    rewrite emp_sepcon in HZ. simpl in HZ. intuition. apply necR_level in JZ. apply laterR_level in UP. omega.
-  + destruct H0 as [gs [SUBS H0]]. exists gs; split; trivial.
-    eapply funspec_sub_trans; split. apply SUBS. clear SUBS H0; hnf.
-    split. split; trivial.
-    intros ts2 a rho m WM u necU U. simpl in U.
-    exists ts2, a, emp. rewrite emp_sepcon. split; intros. 
-    - apply necR_level in necU. split. omega. apply U.
-    - (*intros rho' k UP j KJ J.
-      rewrite emp_sepcon in J. simpl in J. apply J. *)
-      intros rho' k UP j KJ z JZ HZ. hnf in HZ.
-      rewrite emp_sepcon in HZ. simpl in HZ. apply HZ. 
-Qed. *)
-
-Lemma approx_bupd: forall n P, approx n (bupd P) = bupd (approx n P).
-Proof.
-  intros; apply pred_ext.
-  - intros ? [? HP] ? J.
-    destruct (HP _ J) as (? & ? & m' & ? & ? & ? & ?);
-      eexists; split; eauto; eexists; split; eauto; repeat split; auto; lia.
-  - intros ? HP.
-    destruct (HP nil) as (? & ? & m' & ? & ? & ? & []).
-    { eexists; constructor. }
-    split; [lia|].
-    intros ? J.
-    destruct (HP _ J) as (? & ? & m'' & ? & ? & ? & []);
-      eexists; split; eauto; eexists; split; eauto; repeat split; auto.
-Qed.
-
-Lemma wand_nonexpansive_l: forall P Q n,
-  approx n (P -* Q)%pred = approx n (approx n P  -* Q)%pred.
-Proof.
-  repeat intro.
-  apply predicates_hered.pred_ext; intros ? [? Hshift]; split; auto; intros ??????.
-  - destruct H2; eauto.
-  - eapply Hshift; eauto; split; auto.
-    apply necR_level in H0; apply join_level in H1 as []; lia.
+  destruct spec. by iIntros "H"; iDestruct "H" as (b ->) "_".
 Qed.
 
-Lemma wand_nonexpansive_r: forall P Q n,
-  approx n (P -* Q)%pred = approx n (P  -* approx n Q)%pred.
+Lemma subst_extens:
+  forall a v (P Q : assert), (P ⊢ Q) -> assert_of (subst a v P) ⊢ assert_of (subst a v Q).
 Proof.
-  repeat intro.
-  apply predicates_hered.pred_ext; intros ? [? Hshift]; split; auto; intros ??????.
-  - split; eauto.
-    apply necR_level in H0; apply join_level in H1 as []; lia.
-  - eapply Hshift; eauto.
+  unfold subst; constructor; intros; simpl.
+  apply H.
 Qed.
 
-Lemma wand_nonexpansive: forall P Q n,
-  approx n (P -* Q)%pred = approx n (approx n P  -* approx n Q)%pred.
-Proof.
-  intros; rewrite wand_nonexpansive_l, wand_nonexpansive_r; reflexivity.
-Qed.
-
-Lemma approx_idem : forall n P, approx n (approx n P) = approx n P.
-Proof.
-  intros.
-  change (approx n (approx n P)) with ((approx n oo approx n) P).
-  rewrite approx_oo_approx; auto.
-Qed.
-
-Lemma fupd_nonexpansive: forall E1 E2 P n, approx n (fupd.fupd E1 E2 P) = approx n (fupd.fupd E1 E2 (approx n P)).
-Proof.
-  intros; unfold fupd.
-  rewrite wand_nonexpansive; setoid_rewrite wand_nonexpansive at 2.
-  f_equal; f_equal.
-  rewrite !approx_bupd; f_equal.
-  rewrite !approx_orp; f_equal.
-  erewrite !approx_sepcon, approx_idem; reflexivity.
-Qed.
-
-Lemma approx_prop_andp {P Q:Prop} n:
-  approx n (prop (P /\ Q)) = (approx n (prop P)) && (approx n (prop Q)).
-Proof.
-  apply predicates_hered.pred_ext.
-  + intros w ?. simpl in *. destruct H as [? [? ?]]. split; split; trivial.
-  + intros w ?. simpl in *. destruct H as [[? ?] [? ?]]. split3; trivial.
-Qed.
-
-Lemma approx_prop_all {X} {P: X -> Prop} (y:X) n:
-  approx n (prop (forall x, P x)) = ALL x, approx n (prop (P x)).
-Proof.
-  apply predicates_hered.pred_ext.
-  + intros w ? ?. simpl in *. split; apply H.
-  + intros w ?. simpl in *. split. apply (H y). intros. apply H.
-Qed.
-
-Lemma approx_derives1 {P Q} n:
-  approx n (prop (P |-- Q)) |-- (prop (P |-- Q)). 
-Proof. intros w ?. simpl in *. apply H. Qed.
-Lemma approx_derives2 {P Q} n:
-  approx n (prop (P |-- Q)) |-- (prop (approx n P |-- approx n Q)). 
-Proof. intros w ? ? ?. simpl in *. destruct H. destruct H0. 
-split; trivial. apply H1. trivial.
-Qed. 
-Lemma approx_derives3 {X} {P Q: X -> pred rmap} n:
-  approx n (prop (forall x, P x |-- Q x)) |-- prop (forall x, approx n (P x) |-- approx n (Q x)).
-Proof. intros w ? ? ? ?. simpl in *. split. apply H0. apply H. apply H0. Qed.
-
-Lemma approx_derives4 {T1 T2} (P1 P2 Q2 Q1: T1 -> T2 -> mpred) n:
-      approx n (! (ALL (S : T1) (s0 : T2), (P1 S s0 >=> P2 S s0 * (Q2 S s0 -* Q1 S s0))))
-|-- approx n
-      (! (ALL (S : T1) (s0 : T2), (P1 S s0 >=> approx n (P2 S s0) * (approx n (Q2 S s0) -* Q1 S s0)))).
-Proof. intros ? [? ?]. split; trivial; simpl in *. intros.
-destruct (H0 b b0 _ H1 _ _ H2 H3 H4) as [z1 [z2 [J [Z1 Z2]]]]; clear H0.
-do 2 eexists; split3. apply J.
-{ split; trivial. apply join_level in J; destruct J.
-  apply necR_level in H2. apply ext_level in H3. rewrite H0; clear H0. lia. }
-intros. eapply Z2. 3: apply H6. 2: apply H5. apply H0.
-Qed.
-
-Lemma approx_derives4_inv {T1 T2} (P1 P2 Q2 Q1: T1 -> T2 -> mpred) n:
-    approx n
-      (! (ALL (S : T1) (s0 : T2), (P1 S s0 >=> approx n (P2 S s0) * (approx n (Q2 S s0) -* Q1 S s0))))
-    |-- approx n (! (ALL (S : T1) (s0 : T2), (P1 S s0 >=> P2 S s0 * (Q2 S s0 -* Q1 S s0)))).
-Proof. intros ? [? ?]. split; trivial; simpl in *. intros.
-destruct (H0 b b0 _ H1 _ _ H2 H3 H4) as [z1 [z2 [J [Z1 Z2]]]]; clear H0.
-do 2 eexists; split3. apply J. apply Z1.
-intros. eapply Z2. apply H0. apply H5. split; trivial.
-clear Z2 H6. apply join_level in J; destruct J.
-apply necR_level in H2.
-apply necR_level in H0.
-apply join_level in H5; destruct H5. lia.
-Qed.
-
-Lemma approx_func_ptr_si_general fs cc (A: TypeTree) P Q 
-      (Pne: args_super_non_expansive P) (Qne: super_non_expansive Q) (n: nat)
-      aPne aQne  (v: val):
-    approx (S n) (func_ptr_si (mk_funspec fs cc A P Q Pne Qne) v) =
-    approx (S n) (func_ptr_si (mk_funspec fs cc A
-                                          (fun ts a rho => approx n (P ts a rho))
-                                          (fun ts a rho => approx n (Q ts a rho)) aPne aQne) v).
-Proof.
-  intros.
-  unfold func_ptr_si.
-  rewrite !approx_exp. apply pred_ext; intros w [b W]; exists b.
-  + rewrite approx_andp, approx_exp in W. destruct W as [W1 [phi [Lev [Phi PHI]]]].
-    rewrite approx_andp, approx_exp. split; trivial.
-    exists phi; split3; trivial.
-    eapply funspec_sub_si_trans; split. apply Phi. clear Phi PHI; hnf.
-    split. split; trivial.
-    intros w' Hw' ts2 a rho m WM u ? necU extU [U1 U2]. simpl in U1.
-    apply fupd_intro.
-    exists ts2, a, emp. rewrite emp_sepcon; split. { apply approx_p in U2; trivial. }
-    intros rho' y UY k ? YK EK K. rewrite emp_sepcon in K. simpl in K.
-    destruct K; split; auto.
-    apply necR_level in necU.  apply necR_level in YK. apply ext_level in extU. apply ext_level in EK.
-    apply laterR_level in Hw'. lia.
-  + rewrite approx_andp, approx_exp in W. destruct W as [W1 [phi [Lev [Phi PHI]]]].
-    rewrite approx_andp, approx_exp. split; trivial.
-    exists phi; split3; trivial.
-    eapply funspec_sub_si_trans; split. apply Phi. clear Phi PHI; hnf.
-    split. split; trivial.
-    intros w' Hw' ts2 a rho m WM u ? necU extU [U1 U2]. simpl in U1.
-    apply fupd_intro.
-    exists ts2, a, emp. rewrite emp_sepcon; split. 
-    - apply necR_level in necU. apply ext_level in extU. apply approx_lt; trivial.
-      apply laterR_level in Hw'. lia.
-    - intros rho' k UP j ? KJ EJ J.
-      rewrite emp_sepcon in J. simpl in J. apply J.
-Qed.
-
-Lemma approx_func_ptr_si: forall (A: Type) fsig0 cc (P: A -> argsEnviron -> mpred)
-                                 (Q: A -> environ -> mpred) (v: val) (n: nat),
-    approx (S n) (func_ptr_si (NDmk_funspec fsig0 cc A P Q) v) =
-    approx (S n) (func_ptr_si (NDmk_funspec fsig0 cc A
-                                            (fun a rho => approx n (P a rho))
-                                            (fun a rho => approx n (Q a rho))) v).
-Proof. intros. apply approx_func_ptr_si_general. Qed.
-(*original proof without relying on approx_func_ptr_si_general:
-  intros.
-  unfold func_ptr_si.
-  rewrite !approx_exp; f_equal; extensionality b.
-  rewrite !approx_andp; f_equal.
-  unfold func_at, NDmk_funspec.
-  simpl.
-  apply pred_ext; intros w; simpl; intros [? ?]; split; auto.
-  + destruct H0 as [gs [SUBS H0]]. exists gs; split; trivial.
-    eapply funspec_sub_si_trans; split. apply SUBS. clear SUBS H0; hnf.
-    split. split; trivial. 
-    intros w' Hw' ts2 a rho m WM u necU [U1 U2]. simpl in U1.
-    apply fupd_intro.
-    exists ts2, a, emp. rewrite emp_sepcon; split. { apply approx_p in U2; trivial. }
-    intros rho' y UY k YK K. rewrite emp_sepcon in K. simpl in K.
-    rewrite <- approx_fupd.
-    apply necR_level in necU.  apply necR_level in YK.
-    split; [ | apply fupd_intro, K]. apply laterR_level in Hw'. lia.
-  + destruct H0 as [gs [SUBS H0]]. exists gs; split; trivial.
-    eapply funspec_sub_si_trans; split. apply SUBS. clear SUBS H0; hnf.
-    split. split; trivial.
-    intros w' Hw' ts2 a rho m WM u necU [U1 U2]. simpl in U1.
-    apply fupd_intro.
-    exists ts2, a, emp. rewrite emp_sepcon; split. 
-    - apply necR_level in necU. apply approx_lt; trivial.
-      apply laterR_level in Hw'. lia.
-    - intros rho' k UP j KJ J.
-      rewrite emp_sepcon in J. simpl in J. apply fupd_intro, J.
-Qed. *)
-
-Definition funspecs_assert (FunSpecs: PTree.t funspec): assert :=
- fun rho =>
-   (ALL  id: ident, ALL fs:funspec,  !! (FunSpecs!id = Some fs) -->
-              EX b:block,
-                   !! (Map.get (ge_of rho) id = Some b) && func_at fs (b,0))
- &&  (ALL  b: block, ALL fsig:typesig, ALL cc: calling_convention, sigcc_at fsig cc (b,0) -->
-             EX id:ident, !! (Map.get (ge_of rho) id = Some b)
-                             && !! exists fs, FunSpecs!id = Some fs).
+Definition funspecs_assert (FunSpecs: Maps.PTree.t funspec): assert :=
+ assert_of (fun rho =>
+   (□ (∀ id: ident, ∀ fs:funspec,  ⌜Maps.PTree.get id FunSpecs = Some fs⌝ →
+            ∃ b:block,⌜Map.get (ge_of rho) id = Some b⌝ ∧ func_at fs (b,0)) ∗
+   (∀ b fsig cc, sigcc_at fsig cc (b, 0) -∗
+           ⌜∃ id, Map.get (ge_of rho) id = Some b ∧ ∃ fs, Maps.PTree.get id FunSpecs = Some fs⌝))).
+(* We can substantiate this using the authoritative funspecs. *)
 
 Definition globals_only (rho: environ) : environ := (mkEnviron (ge_of rho) (Map.empty _) (Map.empty _)).
 
@@ -1007,7 +649,7 @@ Fixpoint make_args (il: list ident) (vl: list val) (rho: environ)  :=
    | _ , _ => rho
   end.
 
-Lemma ge_of_make_args:  
+Lemma ge_of_make_args:
     forall s a rho, ge_of (make_args s a rho) = ge_of rho.
 Proof.
 induction s; intros.
@@ -1016,7 +658,7 @@ induction s; intros.
  rewrite <- (IHs a0 rho); auto.
 Qed.
 
-Lemma ve_of_make_args:  
+Lemma ve_of_make_args:
     forall s a rho, length s = length a -> ve_of (make_args s a rho) = (Map.empty (block * type)).
 Proof.
 induction s; intros.
@@ -1027,221 +669,212 @@ Qed.
 
 Lemma same_FS_funspecs_assert:
   forall FS1 FS2,
-     (forall id, FS1 ! id = FS2 ! id) ->
-              funspecs_assert FS1 = funspecs_assert FS2.
+     (forall id, FS1 !! id = FS2 !! id) ->
+              funspecs_assert FS1 ⊣⊢ funspecs_assert FS2.
 Proof.
 assert (forall FS FS' rho,
-             (forall id, FS ! id = FS' ! id) ->
-             funspecs_assert FS rho |-- funspecs_assert FS' rho).
-{ intros. intros w [? ?]. split.
-  + intro id. rewrite <- (H id); auto.
-  + intros loc sig cc w' ? Hw' Hw'' HH. hnf in H0. destruct (H1 loc sig cc w' _ Hw' Hw'' HH)  as [id ID].
-    exists id; rewrite <- (H id); auto. }
-intros.
-extensionality rho.
-apply pred_ext; apply H; intros; auto.
+             (forall id, FS !! id = FS' !! id) ->
+             funspecs_assert FS rho ⊢ funspecs_assert FS' rho).
+{ intros. rewrite /funspecs_assert.
+  iIntros "(#H1 & H2)"; iSplitL "".
+  - iIntros "!>" (??); rewrite -H //.
+  - setoid_rewrite <- H; done. }
+split=> rho; iSplit; iApply H; auto.
 Qed.
 
 Lemma funspecs_assert_rho:
-  forall G rho rho', ge_of rho = ge_of rho' -> funspecs_assert G rho |-- funspecs_assert G rho'.
-Proof. unfold funspecs_assert; intros. rewrite H; auto. Qed.
+  forall G rho rho', ge_of rho = ge_of rho' -> funspecs_assert G rho ⊢ funspecs_assert G rho'.
+Proof. rewrite /funspecs_assert /=; intros. rewrite H; auto. Qed.
 
+Definition callingconvention_of_funspec (phi:funspec): calling_convention :=
+  match phi with
+    mk_funspec sig cc _ _ _ _ => cc
+  end.
+
+(*Definition mask_of_funspec (phi:funspec): coPset :=
+  match phi with
+    mk_funspec _ _ E _ _ _ => E
+  end.*)
+
+(*
 (************** INTERSECTION OF funspecs -- case ND  ************************)
 
 (* --------------------------------- Binary case: 2 specs only ----------  *)
 (*Called ndfs_merge  in hmacdrbg_spec_hmacdrbg.v*)
 
-Definition funspec_intersection_ND fA cA A PA QA FSA (HFSA: FSA = NDmk_funspec fA cA A PA QA) 
-                    fB cB B PB QB FSB (HFSB: FSB = NDmk_funspec fB cB B PB QB): option funspec.
+Definition funspec_intersection_ND fA cA A PA QA (FSA: funspec) (HFSA: FSA = mk_funspec fA cA A PA QA)
+                    fB cB B PB QB (FSB: funspec) (HFSB: FSB = mk_funspec fB cB B PB QB): option funspec.
 destruct (eq_dec fA fB); subst.
 + destruct (eq_dec cA cB); subst.
-  - apply Some. eapply (NDmk_funspec fB cB (A+B) 
-         (fun x => match x with inl a => PA a | inr b => PB b end)
-         (fun x => match x with inl a => QA a | inr b => QB b end)).
+  - apply Some. eapply (mk_funspec fB cB (A+B)%type
+        (fun x => match x with inl a => PA a | inr b => PB b end)
+        (fun x => match x with inl a => QA a | inr b => QB b end)).
   - apply None.
 + apply None.
 Defined.
 
 (*The two rules S-inter1 and S-inter2 from page 206 of TAPL*)
-Lemma funspec_intersection_ND_sub {fA cA A PA QA fB cB B PB QB} f1 F1 f2 F2 f
+Lemma funspec_intersection_ND_sub E {fA cA A PA QA fB cB B PB QB} f1 F1 f2 F2 f
       (I: funspec_intersection_ND fA cA A PA QA f1 F1 fB cB B PB QB f2 F2 = Some f):
-  funspec_sub f f1 /\ funspec_sub f f2.
+  funspec_sub E f f1 /\ funspec_sub E f f2.
 Proof.
-  subst. unfold funspec_intersection_ND in I. unfold NDmk_funspec in I.
+  subst. unfold funspec_intersection_ND in I.
   destruct (eq_dec fA fB); [subst fB | discriminate].
   destruct (eq_dec cA cB); [subst cB | discriminate]. inv I.
   split.
-  + split. split; trivial. intros. simpl. intros w [W1 W2].
-    apply fupd_intro. exists ts2, (inl x2), emp. rewrite emp_sepcon.
-    split. trivial. simpl; intros. rewrite emp_sepcon.
-    apply andp_left2, derives_refl.
-  + split. split; trivial. intros. simpl. intros w [W1 W2].
-    apply fupd_intro. exists ts2, (inr x2), emp. rewrite emp_sepcon.
-    split. trivial. simpl; intros. rewrite emp_sepcon.
-    apply andp_left2, derives_refl.
+  + split. split; trivial. intros. iIntros "[% ?] !>".
+    iExists (inl x2), emp; iFrame.
+    iPureIntro; split; auto; intros.
+    iIntros "(? & ? & $)".
+  + split. split; trivial. intros. iIntros "[% ?] !>".
+    iExists (inr x2), emp; iFrame.
+    iPureIntro; split; auto; intros.
+    iIntros "(? & ? & $)".
 Qed.
 
 (*Rule S-inter3 from page 206 of TAPL*)
-Lemma funspec_intersection_ND_sub3 {fA cA A PA QA fB cB B PB QB fC cC C PC QC} f1 F1 f2 F2 f
+Lemma funspec_intersection_ND_sub3 E {fA cA A PA QA fB cB B PB QB fC cC C PC QC} f1 F1 f2 F2 f
       (I: funspec_intersection_ND fA cA A PA QA f1 F1 fB cB B PB QB f2 F2 = Some f) g
-      (G: g = NDmk_funspec fC cC C PC QC):
-  funspec_sub g f1 -> funspec_sub g f2 -> funspec_sub g f.
+      (G: g = mk_funspec fC cC C PC QC):
+  funspec_sub E g f1 -> funspec_sub E g f2 -> funspec_sub E g f.
 Proof.
   subst. intros. destruct H as [[? ?] G1]; subst fA cA. destruct H0 as [[? ?] G2]; subst fB cB.
   unfold funspec_intersection_ND in I. simpl in I.
-  do 2 rewrite if_true in I; trivial. inv I. simpl. split. split; trivial. intros.
-  destruct x2 as [a | b]; [ apply (G1 nil) | apply (G2 nil)].
+  rewrite !eq_dec_refl in I. inv I. simpl. split; first done. intros.
+  destruct x2 as [a | b]; [apply G1 | apply G2].
 Qed.
 
 (*-------------------- ND case, specification Sigma families --------------------- *)
 
 Definition funspec_Sigma_ND (sig:typesig) (cc:calling_convention) (I:Type) (A : I -> Type)
-           (Pre: forall i, A i -> argsEnviron -> mpred)
-           (Post: forall i, A i -> environ -> mpred): funspec.
+           (Pre: forall i, A i -> argsassert)
+           (Post: forall i, A i -> assert): funspec.
 Proof.
-  apply (NDmk_funspec sig cc (sigT A)).
-  intros [i Ai] rho; apply (Pre _ Ai rho).
-  intros [i Ai] rho; apply (Post _ Ai rho). 
+  unshelve eapply (mk_funspec sig cc (sigT A) _ _).
+  intros [i Ai]; apply (Pre _ Ai).
+  intros [i Ai]; apply (Post _ Ai).
 Defined.
 
 (*The two rules S-inter1 and S-inter2 from page 206 of TAPL*)
-Lemma funspec_Sigma_ND_sub fsig cc I A Pre Post i:
-  funspec_sub (funspec_Sigma_ND fsig cc I A Pre Post) (NDmk_funspec fsig cc (A i) (Pre i) (Post i)).
+Lemma funspec_Sigma_ND_sub E fsig cc I A Pre Post i:
+  funspec_sub E (funspec_Sigma_ND fsig cc I A Pre Post) (mk_funspec' fsig cc (A i) (Pre i) (Post i)).
 Proof.
   unfold funspec_Sigma_ND. split. split; trivial. intros; simpl in *.
-  eapply derives_trans, fupd_intro.
-  exists ts2, (existT A i x2), emp. rewrite emp_sepcon.
-  split. apply H. simpl; intros. rewrite emp_sepcon.
-  intros u U. apply U.
+  iIntros "[% ?] !>".
+  iExists (existT i x2), emp; iFrame.
+  iPureIntro; split; auto; intros.
+  iIntros "(_ & _ & $)".
 Qed.
 
 (*Rule S-inter3 from page 206 of TAPL*)
-Lemma funspec_Sigma_ND_sub3 fsig cc I A Pre Post g (i:I)
-      (HI: forall i,  funspec_sub g (NDmk_funspec fsig cc (A i) (Pre i) (Post i))):
-  funspec_sub g (funspec_Sigma_ND fsig cc I A Pre Post).
+Lemma funspec_Sigma_ND_sub3 E fsig cc I A Pre Post g (i:I)
+      (HI: forall i, funspec_sub E g (mk_funspec fsig cc (A i) (Pre i) (Post i))):
+  funspec_sub E g (funspec_Sigma_ND fsig cc I A Pre Post).
 Proof.
-  assert (HIi := HI i). destruct g. destruct HIi as [[? ?] Hi]; subst t c.
+  assert (HIi := HI i). destruct g. destruct HIi as [[? ?] Hi]; subst sig cc.
   split. split; trivial.
   simpl; intros. clear i Hi. destruct x2 as [i Ai].
-  specialize (HI i). destruct HI as [[_ _] Hi]. apply (Hi ts2 Ai gargs).
+  specialize (HI i). destruct HI as [[_ _] Hi]. apply (Hi Ai gargs).
 Qed.
 
 Local Obligation Tactic := idtac.
 (*Specialization of funspec_Sigma_ND to binary case, i.e. I=bool*)
 Program Definition BinarySigma fsig cc (A B:Type)
-        (PA: A -> argsEnviron -> mpred) (QA: A -> environ -> mpred)
-        (PB: B -> argsEnviron -> mpred) (QB: B -> environ -> mpred): funspec :=
+        (PA: A -> argsassert) (QA: A -> assert)
+        (PB: B -> argsassert) (QB: B -> assert): funspec :=
   funspec_Sigma_ND fsig cc bool _ _ _.
 Next Obligation.
   intros sig cc A B PreA PostA PreB PostB x. destruct x. apply A. apply B.
 Defined.
 Next Obligation.
-  intros ? ? ? ? ? ? ? ? b X rho. destruct b; simpl in X. apply (PA X rho). apply (PB X rho).
+  intros ? ? ? ? ? ? ? ? b X. destruct b; simpl in X. apply (PA X). apply (PB X).
 Defined.
 Next Obligation.
-  intros ? ? ? ? ? ? ? ? b X rho. destruct b; simpl in X. apply (QA X rho). apply (QB X rho).
+  intros ? ? ? ? ? ? ? ? b X. destruct b; simpl in X. apply (QA X). apply (QB X).
 Defined.
 
-Definition funspecspec_sub_antisym (f g: funspec):= funspec_sub f g /\ funspec_sub g f.
+Definition funspecspec_sub_antisym E (f g: funspec):= funspec_sub E f g /\ funspec_sub E g f.
   
-Lemma Intersection_BinarySigma sigA ccA A PA QA fsA PrfA sigB ccB B PB QB fsB PrfB f
-      (F:  funspec_intersection_ND sigA ccA A PA QA fsA PrfA sigB ccB B PB QB fsB PrfB  = Some f):
+Lemma Intersection_BinarySigma E sigA ccA A PA QA fsA PrfA sigB ccB B PB QB fsB PrfB f
+      (F:  funspec_intersection_ND sigA ccA A PA QA fsA PrfA sigB ccB B PB QB fsB PrfB = Some f):
   sigA=sigB /\ ccA=ccB /\
-  funspecspec_sub_antisym f (BinarySigma sigA ccA A B PA QA PB QB).
+  funspecspec_sub_antisym E f (BinarySigma sigA ccA A B PA QA PB QB).
 Proof.
   unfold funspec_intersection_ND in F.
   destruct (eq_dec sigA sigB); [ subst sigA; split; trivial | discriminate].
   destruct (eq_dec ccA ccB); [ inv F; split; trivial | discriminate]. 
   split.
   + split. split; trivial. simpl; intros. destruct x2 as [i p].
-    eapply derives_trans, fupd_intro. destruct i; simpl in *.
-  - exists ts2, (inl p), emp. rewrite emp_sepcon. split; simpl. apply H.
-    intros. rewrite emp_sepcon. intros u U; apply U.
-  - exists ts2, (inr p), emp. rewrite emp_sepcon. split; simpl. apply H.
-    intros. rewrite emp_sepcon. intros u U; apply U.
-    + split. split; trivial. intros. intros u [L U]. destruct x2.
-  - apply fupd_intro. exists ts2, (existT (BinarySigma_obligation_1 A B) true a), emp.
-    rewrite emp_sepcon. simpl; split. apply U. intros. rewrite emp_sepcon.
-    apply andp_left2, derives_refl.
-  - apply fupd_intro. exists ts2, (existT (BinarySigma_obligation_1 A B) false b), emp.
-    rewrite emp_sepcon. simpl; split. apply U. intros. rewrite emp_sepcon.
-    apply andp_left2, derives_refl.
+    iIntros "[% ?] !>". destruct i; simpl in *.
+  - iExists (inl p), emp; iFrame. iPureIntro; split; auto; intros.
+    iIntros "(_ & _ & $)".
+  - iExists (inr p), emp; iFrame. iPureIntro; split; auto; intros.
+    iIntros "(_ & _ & $)".
+  + split. split; trivial. intros. iIntros "[% ?] !>". destruct x2.
+  - iExists (existT (P := BinarySigma_obligation_1 A B) true a), emp; iFrame. iPureIntro; split; auto; intros.
+    iIntros "(_ & _ & $)".
+  - iExists (existT (P := BinarySigma_obligation_1 A B) false b), emp; iFrame. iPureIntro; split; auto; intros.
+    iIntros "(_ & _ & $)".
 Qed.
 
 Lemma Intersection_sameSigCC_Some sig cc A PA QA fsA PrfA B PB QB fsB PrfB:
   ~ funspec_intersection_ND sig cc A PA QA fsA PrfA sig cc B PB QB fsB PrfB  = None.
 Proof.
   intros N. unfold funspec_intersection_ND in N.
-  do 2 rewrite if_true in N; trivial. discriminate.
-Qed.
+  rewrite !eq_dec_refl in N; trivial. discriminate.
+Qed.*)
 
 (*-------------------Bifunctor version, binary case ------------*)
 
-Definition binarySUM {A1 A2}
-           (P1: forall ts : list Type, (dependent_type_functor_rec ts (AssertTT A1)) mpred)
-           (P2: forall ts : list Type, (dependent_type_functor_rec ts (AssertTT A2)) mpred):
-  forall ts : list Type, 
-    (dependent_type_functor_rec ts (AssertTT (@SigType bool (fun b => if b then A1 else A2)))) mpred.
-Proof.
-  intros ts X rho. specialize (P1 ts). specialize (P2 ts). 
-  simpl in *. destruct X as [b B]; destruct b; simpl in B.
-  apply (P1 B rho). apply (P2 B rho). 
-Defined.
-
-Lemma binarySUM_ne {A1 A2}
-           {P1: forall ts : list Type, (dependent_type_functor_rec ts (AssertTT A1)) mpred}
-           {P2: forall ts : list Type, (dependent_type_functor_rec ts (AssertTT A2)) mpred}
-           (P1_ne: super_non_expansive P1) (P2_ne: super_non_expansive P2):
-  super_non_expansive (binarySUM P1 P2).
-Proof.
-  hnf; simpl; intros. unfold binarySUM. destruct x as [b B].
-  destruct b; simpl in B. apply P1_ne. apply P2_ne. 
-Qed.
+Notation dtfr := (@dtfr Σ).
 
-Definition binarySUMArgs {A1 A2}
-           (P1: forall ts : list Type, (dependent_type_functor_rec ts (ArgsTT A1)) mpred)
-           (P2: forall ts : list Type, (dependent_type_functor_rec ts (ArgsTT A2)) mpred):
-  forall ts : list Type, 
-    (dependent_type_functor_rec ts (ArgsTT (@SigType bool (fun b => if b then A1 else A2)))) mpred.
+Definition binarySUMmask {A1 A2}
+           (P1: dtfr (MaskTT A1))
+           (P2: dtfr (MaskTT A2)) :
+    dtfr (MaskTT (@SigType bool (fun b => if b then A1 else A2))).
 Proof.
-  intros ts X rho. specialize (P1 ts). specialize (P2 ts). 
-  simpl in *. destruct X as [b B]; destruct b; simpl in B.
-  apply (P1 B rho). apply (P2 B rho). 
+  unshelve econstructor.
+  - intros [b B]; destruct b; [apply (P1 B) | apply (P2 B)].
+  - intros ? [? ?] [b ?] (? & Heq); simpl in *; subst; simpl in *.
+    destruct b; intros; rewrite Heq //.
 Defined.
 
-Lemma binarySUMArgs_ne {A1 A2}
-           {P1: forall ts : list Type, (dependent_type_functor_rec ts (ArgsTT A1)) mpred}
-           {P2: forall ts : list Type, (dependent_type_functor_rec ts (ArgsTT A2)) mpred}
-           (P1_ne: args_super_non_expansive P1) (P2_ne: args_super_non_expansive P2):
-  args_super_non_expansive (binarySUMArgs P1 P2).
-Proof.
-  hnf; simpl; intros. unfold binarySUMArgs. destruct x as [b B].
-  destruct b; simpl in B. apply P1_ne. apply P2_ne. 
-Qed.
+Definition binarySUM {A1 A2}
+           (P1: dtfr (AssertTT A1))
+           (P2: dtfr (AssertTT A2)) :
+    dtfr (AssertTT (@SigType bool (fun b => if b then A1 else A2))).
+Proof.
+  unshelve econstructor.
+  - intros [b B]; destruct b; [apply (P1 B) | apply (P2 B)].
+  - intros ? [? ?] [b ?] (? & Heq); simpl in *; subst; simpl in *.
+    destruct b; intros; rewrite Heq //.
+Defined.
 
-Definition binary_intersection (phi psi:funspec): option funspec.
-  destruct phi as [f c A1 P1 Q1 P1_ne Q1_ne].
-  destruct psi as [f2 c2 A2 P2 Q2 P2_ne Q2_ne].
-  destruct (eq_dec f f2); [subst f2 | apply None].
-  destruct (eq_dec c c2); [subst c2 | apply None].
-  remember (binarySUMArgs P1 P2) as P.
-  remember (binarySUM Q1 Q2) as Q.
-  apply Some. apply (mk_funspec f c _ P Q).
-  subst P; apply (binarySUMArgs_ne P1_ne P2_ne).
-  subst Q; apply (binarySUM_ne Q1_ne Q2_ne).
+Definition binarySUMArgs {A1 A2}
+           (P1: dtfr (ArgsTT A1))
+           (P2: dtfr (ArgsTT A2)) :
+    dtfr (ArgsTT (@SigType bool (fun b => if b then A1 else A2))).
+Proof.
+  unshelve econstructor.
+  - intros [b B]; destruct b; [apply (P1 B) | apply (P2 B)].
+  - intros ? [? ?] [b ?] (? & Heq); simpl in *; subst; simpl in *.
+    destruct b; intros; rewrite Heq //.
 Defined.
 
-Definition callingconvention_of_funspec (phi:funspec):calling_convention :=
-  match phi with
-    mk_funspec sig cc A P Q Pne Qne => cc
-  end.
+Definition binary_intersection (phi psi: funspec) : option funspec :=
+  match phi, psi with
+  | mk_funspec f c A1 E1 P1 Q1, mk_funspec f2 c2 A2 E2 P2 Q2 =>
+    if eq_dec f f2 then if eq_dec c c2 then
+      Some (mk_funspec f c (@SigType bool (fun b => if b then A1 else A2)) (binarySUMmask E1 E2) (binarySUMArgs P1 P2) (binarySUM Q1 Q2))
+    else None else None end.
 
 Lemma callconv_of_binary_intersection {phi1 phi2 phi} (BI: binary_intersection phi1 phi2 = Some phi):
       callingconvention_of_funspec phi = callingconvention_of_funspec phi1 /\ 
       callingconvention_of_funspec phi = callingconvention_of_funspec phi2.
 Proof. destruct phi1; destruct phi2; destruct phi; simpl in *.
  (*destruct (typesigs_match t t0); [ | discriminate].*) if_tac in BI; [ subst | inv BI].
- if_tac in BI; inv BI; split; trivial.
+ if_tac in BI; [ subst | inv BI].
+ inv BI; split; trivial.
 Qed.
 
 Lemma funspectype_of_binary_intersection {phi1 phi2 phi} (BI: binary_intersection phi1 phi2 = Some phi):
@@ -1250,7 +883,8 @@ Lemma funspectype_of_binary_intersection {phi1 phi2 phi} (BI: binary_intersectio
 Proof. destruct phi1; destruct phi2; destruct phi; simpl in *. 
  (*remember  (typesigs_match t t0) as b; destruct b; [ | discriminate].*)
  if_tac in BI; [ subst | inv BI].
- if_tac in BI; inv BI. split; trivial.
+ if_tac in BI; [ subst | inv BI].
+ inv BI. split; trivial.
  (*symmetry in Heqb. clear H4 H5.
  apply typesigs_match_typesigs_eq in Heqb; subst; trivial.*)
 Qed.
@@ -1267,7 +901,8 @@ Lemma binary_intersection_typesig {phi1 phi2 phi} (BI : binary_intersection phi1
 Proof.
   destruct phi1; destruct phi2. simpl in *.
   if_tac in BI; [ subst | inv BI].
-  if_tac in BI; [ inv BI | discriminate]. trivial.
+  if_tac in BI; [ subst | inv BI].
+  inv BI. trivial.
 Qed. 
 
 Lemma binary_intersection_typesigs {phi1 phi2 phi} (BI : binary_intersection phi1 phi2 = Some phi):
@@ -1275,256 +910,258 @@ Lemma binary_intersection_typesigs {phi1 phi2 phi} (BI : binary_intersection phi
 Proof.
   destruct phi1; destruct phi2. simpl in *.
   if_tac in BI; [ subst | inv BI].
-  if_tac in BI; [ inv BI | discriminate]; split; trivial.
+  if_tac in BI; [ subst | inv BI].
+  inv BI; split; trivial.
 Qed.
- 
+
+Import EqNotations.
+
+Lemma mk_funspec_inj : forall {PROP1} {C1 : Cofe PROP1} {PROP2} {C2 : Cofe PROP2} sig1 sig2 cc1 cc2 A1 A2 E1 E2 P1 P2 Q1 Q2,
+  @mk_funspec PROP1 C1 PROP2 C2 sig1 cc1 A1 E1 P1 Q1 = mk_funspec sig2 cc2 A2 E2 P2 Q2 ->
+  sig1 = sig2 /\ cc1 = cc2 /\ exists H : A1 = A2, rew E_eq H in E1 = E2 /\ rew pre_eq H in P1 = P2 /\ rew post_eq H in Q1 = Q2.
+Proof.
+  intros.
+  injection H as H; subst.
+  repeat split; auto; exists eq_refl; simpl.
+  repeat match goal with H : existT _ _ = existT _ _ |- _ => apply inj_pair2 in H end; done.
+Qed.
+
 Lemma binaryintersection_sub phi psi omega:
   binary_intersection phi psi = Some omega ->
   funspec_sub omega phi /\ funspec_sub omega psi.
 Proof.
-  destruct phi as [f1 c1 A1 P1 Q1 P1_ne Q1_ne].
-  destruct psi as [f2 c2 A2 P2 Q2 P2_ne Q2_ne].
-  destruct omega as [f c A P Q P_ne Q_ne]. intros.
+  destruct phi as [f1 c1 A1 E1 P1 Q1].
+  destruct psi as [f2 c2 A2 E2 P2 Q2].
+  destruct omega as [f c A E P Q]. intros.
   simpl in H.
-  destruct (eq_dec f1 f2); [ subst f2 | inv H]. 
-  destruct (eq_dec c1 c2); inv H.
-  apply inj_pair2 in H5. apply inj_pair2 in H4. subst P Q. split.
-  + split; [split; reflexivity | intros].
-    eapply derives_trans, fupd_intro. exists ts2.
-    fold (@dependent_type_functor_rec ts2) in *.
-    simpl in H; destruct H.
-    exists (existT _ true x2), emp.
-    rewrite emp_sepcon.
-    split. apply H0.
-    simpl. intros rho'; rewrite emp_sepcon. apply andp_left2, derives_refl.
-  + split; [split; reflexivity | intros].
-    eapply derives_trans, fupd_intro. exists ts2.
-    fold (@dependent_type_functor_rec ts2) in *.
-    simpl in H; destruct H.
-    exists (existT _ false x2), emp.
-    rewrite emp_sepcon.
-    split. apply H0.
-    simpl. intros rho'; rewrite emp_sepcon. apply andp_left2, derives_refl.
-Qed.
-
-Lemma BINARY_intersection_sub3  phi psi omega:
+  destruct (eq_dec f1 f2); [subst f2 | inv H].
+  destruct (eq_dec c1 c2); [subst c2 | inv H].
+  apply Some_inj, mk_funspec_inj in H as (<- & <- & <- & ? & ? & ?).
+  simpl in *; subst; split.
+  + split; [split3; trivial | intros].
+    iIntros "(% & P) !>".
+    iExists (existT true x2), emp.
+    rewrite bi.emp_sep.
+    iSplit; first done.
+    iSplit; first done.
+    iPureIntro; simpl.
+    intros; iIntros "(% & _ & $)".
+  + split; [split3; trivial | intros].
+    iIntros "(% & P) !>".
+    iExists (existT false x2), emp.
+    rewrite bi.emp_sep.
+    iSplit; first done.
+    iSplit; first done.
+    iPureIntro; simpl.
+    intros; iIntros "(% & _ & $)".
+Qed.
+
+Lemma BINARY_intersection_sub3 phi psi omega:
   binary_intersection phi psi = Some omega ->
   forall xi, funspec_sub xi phi -> funspec_sub xi psi -> funspec_sub xi omega.
 Proof.
-  intros. 
-  destruct phi as [f1 c1 A1 P1 Q1 P1_ne Q1_ne].
-  destruct psi as [f2 c2 A2 P2 Q2 P2_ne Q2_ne].
-  destruct omega as [f c A P Q P_ne Q_ne].
+  intros.
+  destruct phi as [f1 c1 A1 E1 P1 Q1].
+  destruct psi as [f2 c2 A2 E2 P2 Q2].
+  destruct omega as [f c A E P Q].
   simpl in H.
-  destruct (eq_dec f1 f2); [ subst f2 | inv H]. 
-  destruct (eq_dec c1 c2); inv H.
-  apply inj_pair2 in H6. apply inj_pair2 in H7. subst P Q.
-  destruct xi as [f' c' A' P' Q' P_ne' Q_ne'].
-  destruct H0 as [[? ?] ?]; subst f' c'.
-  destruct H1 as [[_ _] ?]. 
-  split; [ split; reflexivity | intros]. simpl in x2.
-  specialize (H ts2). specialize (H2 ts2). 
-  fold (@dependent_type_functor_rec ts2) in *. simpl typesig_of_funspec in *.
-  destruct x2 as [b Hb]; destruct b; eauto.
+  destruct (eq_dec f1 f2); [subst f2 | inv H].
+  destruct (eq_dec c1 c2); [subst c2 | inv H].
+  apply Some_inj, mk_funspec_inj in H as (<- & <- & <- & ? & ? & ?); simpl in *; subst.
+  destruct xi as [f' c' A' E' P' Q'].
+  destruct H0 as [(? & ?) ?]; subst f' c'.
+  destruct H1 as [(_ & _) ?].
+  split; [split3; trivial | intros].
+  destruct x2 as [[|] ?]; eauto.
 Qed.
 
 (****A variant that is a bit more computational - maybe should replace the original definition above?*)
-Program Definition binary_intersection' {f c A1 P1 Q1 P1_ne Q1_ne A2 P2 Q2 P2_ne Q2_ne} phi psi 
-  (Hphi: phi = mk_funspec f c A1 P1 Q1 P1_ne Q1_ne) (Hpsi: psi = mk_funspec f c A2 P2 Q2 P2_ne Q2_ne): funspec :=
-  mk_funspec f c _ (@binarySUMArgs A1 A2 P1 P2) (binarySUM Q1 Q2) _ _.
-
-Next Obligation. intros. apply (binarySUMArgs_ne P1_ne P2_ne). Qed.
-Next Obligation. intros. apply (binarySUM_ne Q1_ne Q2_ne). Qed.
+Definition binary_intersection' {f c A1 E1 P1 Q1 A2 E2 P2 Q2} phi psi
+  (Hphi: phi = mk_funspec f c A1 E1 P1 Q1) (Hpsi: psi = mk_funspec f c A2 E2 P2 Q2): funspec :=
+  mk_funspec f c (@SigType bool (fun b => if b then A1 else A2)) (@binarySUMmask A1 A2 E1 E2) (@binarySUMArgs A1 A2 P1 P2) (binarySUM Q1 Q2).
 
-Lemma binary_intersection'_sound {f c A1 P1 Q1 P1_ne Q1_ne A2 P2 Q2 P2_ne Q2_ne} phi psi
-      (Hphi: phi = mk_funspec f c A1 P1 Q1 P1_ne Q1_ne) (Hpsi: psi = mk_funspec f c A2 P2 Q2 P2_ne Q2_ne):
-   binary_intersection phi psi = Some(binary_intersection' phi psi Hphi Hpsi).
+Lemma binary_intersection'_sound {f c A1 E1 P1 Q1 A2 E2 P2 Q2} phi psi
+  (Hphi: phi = mk_funspec f c A1 E1 P1 Q1) (Hpsi: psi = mk_funspec f c A2 E2 P2 Q2):
+    binary_intersection phi psi = Some (binary_intersection' phi psi Hphi Hpsi).
 Proof.
-unfold binary_intersection, binary_intersection'. subst phi psi. rewrite 2 if_true by trivial. f_equal. f_equal.
-  apply proof_irr. apply proof_irr.
+  unfold binary_intersection, binary_intersection'. subst phi psi. rewrite !if_true //.
 Qed.
 Lemma binary_intersection'_complete phi psi tau:
    binary_intersection phi psi = Some tau ->
-   exists f c A1 P1 Q1 P1_ne Q1_ne A2 P2 Q2 P2_ne Q2_ne Hphi Hpsi,
-   tau = @binary_intersection' f c A1 P1 Q1 P1_ne Q1_ne A2 P2 Q2 P2_ne Q2_ne phi psi Hphi Hpsi.
+   exists f c A1 E1 P1 Q1 A2 E2 P2 Q2 Hphi Hpsi,
+   tau = @binary_intersection' f c A1 E1 P1 Q1 A2 E2 P2 Q2 phi psi Hphi Hpsi.
 Proof.
 unfold binary_intersection, binary_intersection'.
-destruct phi; destruct psi. if_tac. 2: discriminate. if_tac. 2: discriminate. 
-intros X. inv X. 
-do 14 eexists. reflexivity. f_equal. 
-  apply proof_irr. apply proof_irr.
+destruct phi, psi. do 2 (if_tac; last discriminate).
+intros X. inv X.
+repeat eexists.
 Qed.
 
-Lemma binary_intersection'_sub  {f c A1 P1 Q1 P1_ne Q1_ne A2 P2 Q2 P2_ne Q2_ne} (phi psi:funspec) Hphi Hpsi:
-  funspec_sub (@binary_intersection' f c A1 P1 Q1 P1_ne Q1_ne A2 P2 Q2 P2_ne Q2_ne phi psi Hphi Hpsi) phi /\
-  funspec_sub (@binary_intersection' f c A1 P1 Q1 P1_ne Q1_ne A2 P2 Q2 P2_ne Q2_ne phi psi Hphi Hpsi) psi.
+Lemma binary_intersection'_sub  {f c A1 E1 P1 Q1 A2 E2 P2 Q2} (phi psi:funspec) Hphi Hpsi:
+  funspec_sub (@binary_intersection' f c A1 E1 P1 Q1 A2 E2 P2 Q2 phi psi Hphi Hpsi) phi /\
+  funspec_sub (@binary_intersection' f c A1 E1 P1 Q1 A2 E2 P2 Q2 phi psi Hphi Hpsi) psi.
 Proof. apply binaryintersection_sub. apply binary_intersection'_sound. Qed.
 
-Lemma binary_intersection'_sub3 {f c A1 P1 Q1 P1_ne Q1_ne A2 P2 Q2 P2_ne Q2_ne} phi psi Hphi Hpsi:
+Lemma binary_intersection'_sub3 {f c A1 E1 P1 Q1 A2 E2 P2 Q2} phi psi Hphi Hpsi:
   forall xi, funspec_sub xi phi -> funspec_sub xi psi -> 
-  funspec_sub xi (@binary_intersection' f c A1 P1 Q1 P1_ne Q1_ne A2 P2 Q2 P2_ne Q2_ne phi psi Hphi Hpsi).
+  funspec_sub xi (@binary_intersection' f c A1 E1 P1 Q1 A2 E2 P2 Q2 phi psi Hphi Hpsi).
 Proof. intros. eapply BINARY_intersection_sub3. apply binary_intersection'_sound. apply H. apply H0. Qed.
 
 (*-------------------Bifunctor version, general case ------------*)
 
-Definition generalSUM {I} (Ai: I -> TypeTree)
-           (P: forall i ts, (dependent_type_functor_rec ts (AssertTT (Ai i))) mpred):  forall ts : list Type, 
-    (dependent_type_functor_rec ts (AssertTT (@SigType I Ai))) mpred.
-Proof. intros ts [i Hi] rho. simpl in *. apply (P i ts Hi rho). Defined. 
+Definition generalSUMmask {I} (Ai: I -> TypeTree)
+           (P: forall i, dtfr (MaskTT (Ai i))):
+    dtfr (MaskTT (@SigType I Ai)).
+Proof.
+  unshelve econstructor.
+  - intros [i Hi]. apply (P i Hi).
+  - intros ? [? ?] [i ?] (? & Heq); simpl in *; subst; simpl in *.
+    rewrite Heq //.
+Defined.
 
-Lemma generalSUM_ne {I} (Ai: I -> TypeTree) P
-      (P_ne: forall i,  super_non_expansive (P i)):
-  super_non_expansive (generalSUM Ai P).
+Definition generalSUM {I} (Ai: I -> TypeTree)
+           (P: forall i, dtfr (AssertTT (Ai i))):
+    dtfr (AssertTT (@SigType I Ai)).
 Proof.
-  hnf; simpl; intros. unfold generalSUM. destruct x as [i Hi].
-  apply P_ne. 
-Qed.
+  unshelve econstructor.
+  - intros [i Hi]. apply (P i Hi).
+  - intros ? [? ?] [i ?] (? & Heq); simpl in *; subst; simpl in *.
+    rewrite Heq //.
+Defined.
 
 Definition generalSUMArgs {I} (Ai: I -> TypeTree)
-           (P: forall i ts, (dependent_type_functor_rec ts (ArgsTT (Ai i))) mpred):  forall ts : list Type, 
-    (dependent_type_functor_rec ts (ArgsTT (@SigType I Ai))) mpred.
-Proof. intros ts [i Hi] rho. simpl in *. apply (P i ts Hi rho). Defined. 
-
-Lemma generalSUMArgs_ne {I} (Ai: I -> TypeTree) P
-      (P_ne: forall i, args_super_non_expansive (P i)):
-  args_super_non_expansive (generalSUMArgs Ai P).
+           (P: forall i, dtfr (ArgsTT (Ai i))):
+    dtfr (ArgsTT (@SigType I Ai)).
 Proof.
-  hnf; simpl; intros. unfold generalSUMArgs. destruct x as [i Hi].
-  apply P_ne. 
-Qed.
+  unshelve econstructor.
+  - intros [i Hi]. apply (P i Hi).
+  - intros ? [? ?] [i ?] (? & Heq); simpl in *; subst; simpl in *.
+    rewrite Heq //.
+Defined.
 
 Definition WithType_of_funspec (phi:funspec):TypeTree :=
   match phi with
-    mk_funspec sig cc A P Q Pne Qne => A
+    mk_funspec sig cc A _ _ _ => A
   end.
 
-Definition Pre_of_funspec (phi: funspec): forall ts : list Type,
-                        functors.MixVariantFunctor._functor
-                          (rmaps.dependent_type_functor_rec ts (ArgsTT (WithType_of_funspec phi))) mpred :=
-match phi with (mk_funspec _ _ A P _ _ _ ) => P end. 
+Definition mask_of_funspec (phi: funspec) : dtfr (MaskTT (WithType_of_funspec phi)) :=
+  match phi with mk_funspec _ _ A E _ _ => E end.
 
-(*Upstreamed to VSTmaster Sep 3rd 2023*)
-Definition Post_of_funspec (phi: funspec): forall ts : list Type,
-                        functors.MixVariantFunctor._functor
-                          (rmaps.dependent_type_functor_rec ts (AssertTT (WithType_of_funspec phi))) mpred :=
-match phi with (mk_funspec _ _ A _ Q _ _ ) => Q end. 
+Definition Pre_of_funspec (phi: funspec) : dtfr (ArgsTT (WithType_of_funspec phi)) :=
+  match phi with mk_funspec _ _ _ A P _ => P end.
+
+Definition Post_of_funspec (phi: funspec) : dtfr (AssertTT (WithType_of_funspec phi)) :=
+  match phi with mk_funspec _ _ A _ _ Q => Q end.
+
+Definition intersectionMask {I} phi:
+  forall (i : I),
+    dtfr (MaskTT (WithType_of_funspec (phi i))).
+Proof.
+  intros i. destruct (phi i) as  [fi ci A_i Ei Pi Qi]. apply Ei.
+Defined.
 
 Definition intersectionPRE {I} phi:
-  forall (i : I) (ts : list Type),
-    (dependent_type_functor_rec ts (ArgsTT (WithType_of_funspec (phi i)))) mpred.
+  forall (i : I),
+    dtfr (ArgsTT (WithType_of_funspec (phi i))).
 Proof.
-  intros i. destruct (phi i) as  [fi ci A_i Pi Qi Pi_ne Qi_ne]. apply Pi. 
+  intros i. destruct (phi i) as  [fi ci A_i Ei Pi Qi]. apply Pi.
 Defined.
 
 Definition intersectionPOST {I} phi:
-  forall (i : I) (ts : list Type),
-    (dependent_type_functor_rec ts (AssertTT (WithType_of_funspec (phi i)))) mpred.
+  forall (i : I),
+    dtfr (AssertTT (WithType_of_funspec (phi i))).
 Proof.
-  intros i. destruct (phi i) as  [fi ci A_i Pi Qi Pi_ne Qi_ne]. apply Qi. 
+  intros i. destruct (phi i) as  [fi ci A_i Ei Pi Qi]. apply Qi.
 Defined.
 
+Definition iMask {I} phi:
+        dtfr (MaskTT (SigType I (fun i => WithType_of_funspec (phi i)))).
+Proof. intros. apply (generalSUMmask _ (intersectionMask phi)). Defined.
+
 Definition iPre {I} phi:
-forall ts : list Type,
-        (dependent_type_functor_rec ts
-           (ArgsTT (SigType I (fun i : I => WithType_of_funspec (phi i)))))
-          mpred.
+        dtfr (ArgsTT (SigType I (fun i => WithType_of_funspec (phi i)))).
 Proof. intros. apply (generalSUMArgs _ (intersectionPRE phi)). Defined.
 
 Definition iPost {I} phi:
-forall ts : list Type,
-        (dependent_type_functor_rec ts
-           (AssertTT (SigType I (fun i : I => WithType_of_funspec (phi i)))))
-          mpred.
+        dtfr (AssertTT (SigType I (fun i => WithType_of_funspec (phi i)))).
 Proof. intros. apply (generalSUM _ (intersectionPOST phi)). Defined.
 
-Lemma iPre_ne {I} (phi: I -> funspec): args_super_non_expansive (iPre phi).
-Proof.
-  unfold iPre. apply generalSUMArgs_ne.
-  intros. unfold intersectionPRE. simpl. destruct (phi i); trivial.
-Qed.
-
-Lemma iPost_ne {I} (phi: I -> funspec): super_non_expansive (iPost phi).
-Proof.
-  unfold iPost. apply generalSUM_ne.
-  intros. unfold intersectionPOST. simpl. destruct (phi i); trivial.
-Qed.
-
 Definition general_intersection {I sig cc} (phi: I -> funspec) 
            (Hsig: forall i, typesig_of_funspec (phi i) = sig)
-           (Hcc: forall i, callingconvention_of_funspec (phi i) = cc): funspec.
+           (Hcc: forall i, callingconvention_of_funspec (phi i) = cc) : funspec.
 Proof.
   apply (mk_funspec sig cc
-                    ((@SigType I (fun i => WithType_of_funspec (phi i))))
-                    (iPre phi) (iPost phi)).
-  apply iPre_ne.
-  apply iPost_ne.
+                    (SigType I (fun i => WithType_of_funspec (phi i)))
+                    (iMask phi) (iPre phi) (iPost phi)).
 Defined.
 
-Lemma generalintersection_sub {I sig cc} (phi: I -> funspec) 
+Lemma generalintersection_sub {I sig cc} (phi: I -> funspec)
            (Hsig: forall i, typesig_of_funspec (phi i) = sig)
-           (Hcc: forall i, callingconvention_of_funspec (phi i) = cc) omega:
+           (Hcc: forall i, callingconvention_of_funspec (phi i) = cc)
+           omega:
   general_intersection phi Hsig Hcc = omega ->
   forall i,  funspec_sub omega (phi i).
 Proof.
-  intros; subst. hnf. simpl typesig_of_funspec in *.
+  intros; subst. hnf.
   specialize (Hsig i); specialize (Hcc i); subst.
-  unfold  general_intersection; simpl.
-  remember (phi i) as zz; destruct zz. split; [ split; reflexivity | intros].
-  eapply derives_trans, fupd_intro.
-  exists ts2. simpl in H; destruct H.
-  assert (exists D: (dependent_type_functor_rec ts2 (WithType_of_funspec (phi i))) mpred,
-         JMeq.JMeq x2 D).
+  remember (phi i) as zz; destruct zz. split; [split3; trivial | intros].
+  iIntros "(% & ?) !>".
+  assert (exists D: dtfr (WithType_of_funspec (phi i)), JMeq.JMeq x2 D) as (D & HD).
   { rewrite <- Heqzz. simpl. exists x2. constructor. }
-  destruct H1 as [D HD].
-  unfold iPre, intersectionPRE, generalSUM. 
-  exists (existT _ i D), emp.  
-  rewrite emp_sepcon. split; simpl.
-  + remember (phi i) as pp. destruct pp.
+  unfold iPre, intersectionPRE, generalSUM.
+  iExists (existT i D), emp.
+  rewrite bi.emp_sep. iSplit; simpl.
+  { unfold intersectionMask.
+    destruct (phi i); simpl in *.
+    inv Heqzz.
+    apply inj_pair2 in H4; subst; auto. }
+  iSplit.
+  + destruct (phi i).
     simpl in *; inv Heqzz.
-    apply inj_pair2 in H5 ; apply inj_pair2 in H6; subst P0 Q0.
-    inv HD. apply inj_pair2 in H1; subst; trivial. 
-  + intros; rewrite emp_sepcon. unfold intersectionPOST.
-    intros x [X1 X2]. destruct (phi i).
+    apply inj_pair2 in H5; subst; trivial.
+  + iPureIntro; intros; rewrite bi.emp_sep. unfold intersectionPOST.
+    iIntros "(% & ?)". destruct (phi i).
     simpl in *; inv Heqzz.
-    apply inj_pair2 in H5; apply inj_pair2 in H6; subst P0 Q0.
-    inv HD. apply inj_pair2 in H1; subst; trivial. 
+    apply inj_pair2 in H7; subst; trivial.
 Qed.
 
 Lemma generalintersection_sub3  {I sig cc}
-      (INH: inhabited I) (phi: I -> funspec) 
+      (INH: inhabited I) (phi: I -> funspec)
            (Hsig: forall i, typesig_of_funspec (phi i) = sig)
-           (Hcc: forall i, callingconvention_of_funspec (phi i) = cc) lia:
-  general_intersection phi Hsig Hcc = lia ->
-  forall xi, (forall i, funspec_sub xi (phi i)) -> funspec_sub xi lia.
+           (Hcc: forall i, callingconvention_of_funspec (phi i) = cc)
+           omega:
+  general_intersection phi Hsig Hcc = omega ->
+  forall xi, (forall i, funspec_sub xi (phi i)) -> funspec_sub xi omega.
 Proof.
   intros. subst. inv INH; rename X into i.
-  unfold general_intersection. 
-  destruct xi as [f c A P Q P_ne Q_ne].
+  unfold general_intersection.
+  destruct xi as [f c A E P Q].
   split.
-  { split. 
+  { split.
     + specialize (H0 i); specialize (Hsig i). destruct (phi i); subst; apply H0.
     + specialize (H0 i); specialize (Hcc i). destruct (phi i); subst; apply H0. }
-  intros. simpl. simpl in x2. clear i. destruct x2 as [i Hi]. simpl.
+  intros. clear i. destruct x2 as [i Hi].
   specialize (H0 i); specialize (Hsig i); specialize (Hcc i); subst; simpl.
-  unfold intersectionPRE, intersectionPOST.
+  unfold intersectionMask, intersectionPRE, intersectionPOST.
   forget (phi i) as zz. clear phi.
   destruct zz. simpl in *.
-  destruct H0 as [[? ?] ?]; subst.
-  apply (H1 ts2 Hi gargs). 
+  destruct H0 as [[? ?] H1]; subst.
+  apply (H1 Hi gargs).
 Qed.
 
 Lemma make_context_t_get: forall {params temps i ty} 
-      (T: (make_tycontext_t params temps) ! i = Some ty),
+      (T: (make_tycontext_t params temps) !! i = Some ty),
       In i (map fst params ++ map fst temps).
 Proof.
   induction params; simpl; intros.
-* induction temps; simpl in *. rewrite PTree.gempty in T; discriminate. 
-  destruct a; simpl in *. rewrite PTree.gsspec in T.
+* induction temps; simpl in *. rewrite Maps.PTree.gempty in T; discriminate. 
+  destruct a; simpl in *. rewrite Maps.PTree.gsspec in T.
   destruct (peq i i0); subst. left; trivial. right; auto.
-* destruct a; simpl in *. rewrite PTree.gsspec in T.
+* destruct a; simpl in *. rewrite Maps.PTree.gsspec in T.
   destruct (peq i i0); subst. left; trivial.
   right. eapply IHparams. apply T.
 Qed.
+
 Lemma tc_temp_environ_elim: forall {params temps trho},
       list_norepet (map fst params ++ map fst temps) ->
       typecheck_temp_environ trho (make_tycontext_t params temps) ->
@@ -1534,9 +1171,9 @@ Proof.
   induction params.
   + intros. inv H1.
   + simpl. intros. destruct H1.
-    - subst a. simpl in *. apply (H0 i ty). rewrite PTree.gss; trivial.
+    - subst a. simpl in *. apply (H0 i ty). rewrite Maps.PTree.gss; trivial.
     - inv H. apply (IHparams temps); trivial.
-      red; intros j ? ?. apply H0. rewrite PTree.gso; trivial. clear - H4 H.
+      red; intros j ? ?. apply H0. rewrite Maps.PTree.gso; trivial. clear - H4 H.
       intros J; subst. destruct a; simpl in *. apply H4; clear - H.
       apply (make_context_t_get H).
 Qed.
@@ -1544,9 +1181,9 @@ Qed.
 Lemma tc_environ_xtype t rho: tc_environ (xtype_tycontext t) (globals_only rho).
 Proof.
   unfold xtype_tycontext; simpl. split3; intros; simpl.
-  red; intros. rewrite PTree.gempty in H; congruence.
-  split; intros. rewrite PTree.gempty in H; congruence. destruct H; inv H.
-  red; intros. rewrite PTree.gempty in H; congruence.
+  red; intros. rewrite Maps.PTree.gempty in H; congruence.
+  split; intros. rewrite Maps.PTree.gempty in H; congruence. destruct H; inv H.
+  red; intros. rewrite Maps.PTree.gempty in H; congruence.
 Qed.
 
 Lemma tc_environ_xtype_env_set t rho i v:
@@ -1554,241 +1191,44 @@ tc_environ (xtype_tycontext t)
          (env_set (globals_only rho) i v).
 Proof.
   unfold xtype_tycontext; simpl. split3; intros; simpl.
-  red; intros. rewrite PTree.gempty in H; congruence.
-  split; intros. rewrite PTree.gempty in H; congruence. destruct H; inv H.
-  red; intros. rewrite PTree.gempty in H; congruence.
+  red; intros. rewrite Maps.PTree.gempty in H; congruence.
+  split; intros. rewrite Maps.PTree.gempty in H; congruence. destruct H; inv H.
+  red; intros. rewrite Maps.PTree.gempty in H; congruence.
 Qed.
 
 Lemma funspec_sub_cc phi psi: funspec_sub phi psi ->
       callingconvention_of_funspec phi = callingconvention_of_funspec psi.
 Proof. destruct phi; destruct psi; simpl. intros [[_ ?] _]; trivial. Qed.
 
-Lemma funspec_sub_si_cc phi psi: TT |-- funspec_sub_si phi psi ->
+Lemma funspec_sub_si_cc phi psi: (True ⊢ funspec_sub_si phi psi) ->
       callingconvention_of_funspec phi = callingconvention_of_funspec psi.
-Proof. destruct phi; destruct psi; simpl. intros.
- destruct (H (empty_rmap 0)) as [[_ ?] _]; simpl; trivial. Qed.
-
-Lemma later_func_ptr_si phi psi (H: TT |-- funspec_sub_si phi psi) v:
-      |> (func_ptr_si phi v) |-- |> (func_ptr_si psi v).
-Proof. apply box_derives. apply exp_derives. intros b.
-  apply andp_derives; trivial. apply exp_derives. intros tau.
-  apply andp_derives; trivial. 
-  eapply derives_trans. 2: eapply funspec_sub_si_trans with (f2:=phi).
-  apply andp_right. trivial.
-  eapply derives_trans. 2: apply H. trivial.
-Qed.
-
-Lemma later_func_ptr_si' phi psi v:
-      |> (funspec_sub_si phi psi && func_ptr_si phi v) |-- |> (func_ptr_si psi v).
-Proof. apply box_derives. intros m [M1 M2].
-  destruct M2 as [b [? [gs [GS1 GS2]]]]. exists b; split; trivial.
-  exists gs; split; trivial. clear GS2 H b v.
-  apply funspec_sub_si_trans with (f2:=phi). split; trivial.
-Qed.
-
-Lemma eqp_refl : forall (G : Triv) P, G |-- (P <=> P).
 Proof.
-  intros; rewrite andp_dup; apply subp_refl.
+  destruct phi; destruct psi; simpl. intros.
+  rewrite -(bi.True_intro emp) bi.and_elim_l in H. apply ouPred.pure_soundness in H as (? & ?); done.
 Qed.
 
-Lemma eqp_andp : forall (G : Triv) (P P' Q Q' : mpred)
-  (HP : (G |-- P <=> P')) (HQ : (G |-- Q <=> Q')), G |-- (P && Q <=> P' && Q').
+Lemma later_func_ptr_si phi psi (H: True ⊢ funspec_sub_si phi psi) v:
+      ▷ (func_ptr_si phi v) ⊢ ▷ (func_ptr_si psi v).
 Proof.
-  intros. red; intros. specialize (HP _ H). specialize (HQ _ H).
-  split; simpl; intros ? ? ? ? [X Y]; split.
-  - eapply (HP y); eauto.
-  - eapply (HQ y); eauto.
-  - eapply (HP y); eauto.
-  - eapply (HQ y); eauto.
+  iIntros "H !>".
+  iApply func_ptr_si_mono.
+  iSplit; auto.
+  by iApply H.
 Qed.
-Lemma eqp_sepcon : forall (G : Triv) (P P' Q Q' : mpred)
-  (HP : (G |-- P <=> P')) (HQ : (G |-- Q <=> Q')), (G |-- P * Q <=> P' * Q').
-Proof.
-  intros. red; intros. specialize (HP _ H). specialize (HQ _ H).
-  split; simpl; intros ? ? ? ? [a1 [a2 [Ja [A1 A2]]]].
-  - pose proof (necR_level _ _ H1).
-    pose proof (ext_level _ _ H2).
-    destruct (join_level _ _ _ Ja).
-    eapply HP in A1; [| | apply necR_refl | reflexivity]; [|lia].
-    eapply HQ in A2; [| | apply necR_refl | reflexivity]; [|lia].
-    eauto.
-  - pose proof (necR_level _ _ H1).
-    pose proof (ext_level _ _ H2).
-    destruct (join_level _ _ _ Ja).
-    eapply HP in A1; [| | apply necR_refl | reflexivity]; [|lia].
-    eapply HQ in A2; [| | apply necR_refl | reflexivity]; [|lia].
-    eauto.
-Qed.
-
 
-Lemma fash_func_ptr_ND:
- forall fsig cc (A: Type) 
-             (Pre Pre': A -> argsEnviron -> mpred) (Post Post': A -> environ -> mpred) v,
-   ALL a:A,
-         (ALL rho:argsEnviron, fash (Pre' a rho --> Pre a rho)) &&
-         (ALL rho:environ, fash (Post a rho --> Post' a rho))
-   |-- fash (func_ptr_si (NDmk_funspec fsig cc A Pre Post) v --> 
-                  func_ptr_si (NDmk_funspec fsig cc A Pre' Post') v).
+Lemma later_func_ptr_si' phi psi v:
+      ▷ (funspec_sub_si phi psi ∧ func_ptr_si phi v) ⊢ ▷ (func_ptr_si psi v).
 Proof.
-intros.
-unfold func_ptr_si.
-apply subp_exp; intro b.
-apply subp_andp.
-apply subp_refl.
-intros ? ? ? ? ? ? ? ? [gs [? ?]].
-exists gs. split; auto.
-eapply funspec_sub_si_trans.
-split.
-eassumption.
-clear gs H3 H4.
-split.
-split; auto.
-intros ? ? ? ? ? ? ? ? ? ? ? [? ?].
-apply fupd_intro.
-exists nil, b1, emp.
-rewrite emp_sepcon.
-split.
-destruct (H b1) as [Hpre _].
-eapply (Hpre b2); auto.
-apply necR_level in H1, H5. apply ext_level in H2, H6. apply laterR_level in H3. lia.
-intros ? ? ? ? ? ? ? [? Hpost].
-rewrite emp_sepcon in Hpost.
-destruct (H b1) as [_ Hpost'].
-eapply (Hpost' b3); auto.
-apply necR_level in H1, H5, H10. apply ext_level in H2, H6, H11. apply laterR_level in H3. lia.
+  iIntros "H !>".
+  by iApply func_ptr_si_mono.
 Qed.
 
+Lemma func_ptr_emp phi v: func_ptr phi v ⊢ emp.
+Proof. iIntros. done. Qed.
 
-(*
-Lemma eqp_andp : forall (G : Triv) (P P' Q Q' : mpred)
-  (HP : (G |-- P <=> P')%logic) (HQ : (G |-- Q <=> Q')%logic), G |-- (P && Q <=> P' && Q')%logic.
+Lemma split_func_ptr:  forall fs p, func_ptr fs p ⊣⊢ func_ptr fs p ∗ func_ptr fs p.
 Proof.
-  intros.
-  rewrite fash_andp in HP, HQ |- *.
-  apply andp_right; apply subp_andp; auto; intros ? Ha; destruct (HP _ Ha), (HQ _ Ha); auto.
+intros; apply bi.persistent_sep_dup; apply _.
 Qed.
 
-Lemma eqp_exp : forall (A : Type) (NA : NatDed A) (IA : Indir A) (RecIndir : RecIndir A)
-    (G : Triv) (B : Type) (X Y : B -> A),
-  (forall x : B, (G |-- X x <=> Y x)%logic) ->
-  G |-- ((EX x : _, X x) <=> (EX x : _, Y x))%logic.
-Proof.
-  intros.
-  rewrite fash_andp; apply andp_right; apply subp_exp; intro x; specialize (H x); rewrite fash_andp in H;
-    intros ? Ha; destruct (H _ Ha); auto.
-Qed.*)(*Print funspec.
-
-Definition MkPred {T A} (B: T -> mpred): forall ts : list Type, dependent_type_functor_rec ts (ArgsTT A) mpred.
-Proof. simpl; intros. Check dependent_type_functor_rec. unfold dependent_type_functor_rec in X. simpl.
-
-Lemma funcptr_contr {T : Type} (B1 B2 : T -> mpred) (x : T ) (v : val) sig cc A
-                    (pre : forall ts : list Type, dependent_type_functor_rec ts A mpred -> argsEnviron -> (T -> mpred) -> mpred)
-                    (post: (T -> mpred) -> forall ts : list Type, dependent_type_functor_rec ts (AssertTT A) mpred)
-                     P1ne Q1ne P2ne Q2ne :
-predicates_hered.box predicates_hered.laterM (B1 x <=> B2 x)
-|-- func_ptr_si (mk_funspec sig cc A (fun ts x q a => pre ts x q B1) (post (fun rho : T => |> B1 rho))P1ne Q1ne) v <=> 
-    func_ptr_si (mk_funspec sig cc A (fun ts x q a => pre ts x q B2) (post (fun rho : T => |> B2 rho)) P2ne Q2ne) v. 
-Proof. unfold func_ptr_si. red. intros a Ha m AM. split; intros k MK [b [Hb [gs [B GS]]]].
-+ exists b. split; trivial. exists gs; split; [ eapply funspec_sub_si_trans | trivial].
-  split. apply B. clear GS B gs Hb v b.
-  split. split; trivial.
-  intros q kq ts2 xs2 gargs r RR p2 rp2 [Args Hp2]. simpl in Ha.
-  exists ts2, xs2, emp; split.
-  - rewrite emp_sepcon.
-    assert ((fun rho : T => |> B1 rho) =(fun rho : T => |> B2 rho) ).
-    { extensionality t.  simpl in pre.
-Lemma funcptr_contr {T : Type} (B1 B2 : T -> mpred) (x : T ) (v : val) sig cc A
-                    (pre : (T -> mpred) -> forall ts : list Type, dependent_type_functor_rec ts (ArgsTT A) mpred)
-                    (post: (T -> mpred) -> forall ts : list Type, dependent_type_functor_rec ts (AssertTT A) mpred)
-                     P1ne Q1ne P2ne Q2ne :
-predicates_hered.box predicates_hered.laterM (B1 x <=> B2 x)
-|-- func_ptr_si (mk_funspec sig cc A (pre (fun rho : T => |> B1 rho)) (post (fun rho : T => |> B1 rho)) P1ne Q1ne) v <=> 
-    func_ptr_si (mk_funspec sig cc A (pre (fun rho : T => |> B2 rho)) (post (fun rho : T => |> B2 rho)) P2ne Q2ne) v. 
-Proof. unfold func_ptr_si. red. intros a Ha m AM. split; intros k MK [b [Hb [gs [B GS]]]].
-+ exists b. split; trivial. exists gs; split; [ eapply funspec_sub_si_trans | trivial].
-  split. apply B. clear GS B gs Hb v b.
-  split. split; trivial.
-  intros q kq ts2 xs2 gargs r RR p2 rp2 [Args Hp2]. simpl in Ha.
-  exists ts2, xs2, emp; split.
-  - rewrite emp_sepcon.
-    assert ((fun rho : T => |> B1 rho) =(fun rho : T => |> B2 rho) ).
-    { extensionality t. admit.
-    rewrite H. trivial.
-
-
-Lemma funcptr_contr {T : Type} (B1 B2 : T -> mpred) (x : T ) (v : val) (f : (T -> mpred) -> funspec)
-      (HsigCC: forall x y, typesig_of_funspec (f x) = typesig_of_funspec (f y)
-                        /\ callingconvention_of_funspec (f x) = callingconvention_of_funspec (f y)):
-predicates_hered.box predicates_hered.laterM (B1 x <=> B2 x)
-|-- func_ptr_si (f (fun rho : T => |> B1 rho)) v <=> func_ptr_si (f (fun rho : T => |> B2 rho)) v. 
-Proof. unfold func_ptr_si. red. intros a Ha m AM. split; intros k MK [b [Hb [gs [B GS]]]].
-+ exists b. split; trivial. exists gs; split; [ eapply funspec_sub_si_trans | trivial].
-  split. apply B. clear GS B gs Hb v b.
-  destruct (HsigCC B1 B2). destruct (HsigCC B1 (fun t => |> B1 t) ). destruct (HsigCC B2 (fun t => |> B2 t) ).
-  clear HsigCC. rewrite H in *; rewrite H0 in *. clear H H0.
-  rewrite H1 in *; rewrite H2 in *. clear H1 H2.
-  remember (f (fun rho : T => |> B1 rho)) as phi1. 
-  remember (f (fun rho : T => |> B2 rho)) as phi2.
-  destruct phi1 as [sig1 cc1 A1 P1 Q1 P1ne Q1ne].
-  destruct phi2 as [sig2 cc2 A2 P2 Q2 P2ne Q2ne]. simpl in *. subst. split. split; trivial.
-  intros q kq ts2 xs2 gargs r RR p2 rp2 [Args Hp2]
-  destruct H2. unfold funspec_sub_si. red. intros x. simpl. simpl in B. Hm. red. apply eqp_exp.
-(f :T -> funspec):
-predicates_hered.box predicates_hered.laterM (B1 x <=> B2 x)
-|-- func_ptr_si (f (fun t => |> B1)) v <=> func_ptr_si (f (|> B2)) v.
-
- 0
-Lemma funcptr_contr {T : Type} (B1 B2 : T * val -> mpred)
-      (f : (T * val -> mpred) -> funspec)
-      (HsigCC: forall x y, typesig_of_funspec (f x) = typesig_of_funspec (f y)
-                        /\ callingconvention_of_funspec (f x) = callingconvention_of_funspec (f y))
-      (v : val):
-predicates_hered.allp (fun x : T * val => |> B1 x <=> |> B2 x) |-- func_ptr (f B1) v <=> func_ptr (f B2) v.
-Proof.
-unfold func_ptr. apply subp_eqp; apply subp_exp; intros b.
-+ apply subp_andp.
-  - red; intros. red. intros u AU w UW; trivial.
-  - intros n N u NU w UW [gs [Sub FuncAt]]. exists gs. split; trivial.
-    simpl; simpl in Sub. clear FuncAt.
-    eapply funspec_sub_trans. apply Sub. clear Sub gs. simpl in N.
-    remember (f B1) as phi1; remember (f B2) as phi2.
-    specialize (HsigCC B1 B2). rewrite <- Heqphi1, <- Heqphi2 in HsigCC.
-    destruct phi1 as [t1 c1 A1 P1 Q1 P1ne Q1ne].
-    destruct phi2 as [t2 c2 A2 P2 Q2 P2ne Q2ne]. simpl. simpl in HsigCC; destruct HsigCC.
-    subst t2 c2. split; [ split; trivial | intros].
-    intros m [M1 M2]. 
-Search func_ptr_si.
-Check (HORec_sub). 
-    destruct gargs as [ge args]; simpl in *.
-    destruct t as [argtypes rt]; simpl in *.
-Search HOcontractive. Print argsEnviron.
-Check (HORec_sub). (predicates_hered.allp (fun x : T * val => |> B1 x <=> |> B2 x)) (T * val)).
-(fun x f z => func_ptr 
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-    Print funspec_sub. do_funspec_sub. Search  red in Sub simpl in Sub. destruct Sub. intros r. eapply eqp_prop. andp_subp. eapply prop_andp_subp. normalize.
-eapply (allp_left v).*)
-
-End invs.
+End mpred.
diff --git a/veric/share_instance.v b/veric/share_instance.v
new file mode 100644
index 0000000000..6558d7f1a7
--- /dev/null
+++ b/veric/share_instance.v
@@ -0,0 +1,116 @@
+Require Import VST.shared.share_alg.
+Require Import VST.msl.eq_dec.
+Require Export VST.msl.shares.
+Require Export VST.veric.shares.
+
+#[export] Program Instance share_instance : ShareType share := { share_bot := Share.bot; share_top := Tsh;
+  share_op a b := if eq_dec (Share.glb a b) Share.bot then Some (Share.lub a b) else None;
+  share_writable := writable0_share; share_readable := readable_share }.
+Next Obligation.
+Proof.
+  intros ??.
+  rewrite Share.glb_commute Share.lub_commute //.
+Qed.
+Next Obligation.
+Proof.
+  intros *; simpl.
+  do 2 (destruct (eq_dec _ _) as [?glb|]; last done).
+  inversion 1; inversion 1; subst.
+  rewrite Share.distrib1 in glb0; apply lub_bot_e in glb0 as [Hac ?].
+  rewrite Share.glb_commute in Hac.
+  destruct (eq_dec _ _); last done.
+  do 2 eexists; first done.
+  rewrite Share.glb_commute Share.distrib1 Share.glb_commute glb lub_bot' Share.glb_commute.
+  destruct (eq_dec _ _); last done.
+  rewrite (Share.lub_commute a c) Share.lub_assoc //.
+Qed.
+Next Obligation.
+Proof.
+  intros *; simpl.
+  destruct (eq_dec _ _) as [glb|]; inversion 1.
+  rewrite Share.distrib1.
+  destruct (eq_dec (Share.glb c a) Share.bot) as [?glb|].
+  - rewrite glb0 lub_bot'.
+    split; repeat destruct (eq_dec _ _); auto; try congruence.
+    intros [?|?]; done.
+  - destruct (eq_dec _ _) as [?lub|]; last tauto.
+    apply lub_bot_e in lub; tauto.
+Qed.
+Next Obligation.
+Proof.
+  intros *; simpl.
+  rewrite Share.glb_commute Share.glb_bot eq_dec_refl lub_bot' //.
+Qed.
+Next Obligation.
+Proof.
+  intros *; simpl.
+  do 2 (destruct (eq_dec _ _) as [?glb|]; last done).
+  inversion 1; inversion 1; subst.
+  eapply Share.distrib_spec; eauto; congruence.
+Qed.
+Next Obligation.
+Proof.
+  intros *; simpl.
+  destruct (eq_dec _ _); inversion 1.
+  apply Share.lub_top.
+Qed.
+Next Obligation.
+Proof.
+  apply readable_share_dec.
+Defined.
+Next Obligation.
+Proof.
+  intros *; simpl.
+  destruct (eq_dec _ _); inversion 2.
+  eapply join_writable01, H.
+  rewrite /sepalg.join /Share.Join_ba; eauto.
+Qed.
+Next Obligation.
+Proof.
+  intros *; simpl.
+  destruct (eq_dec _ _); inversion 2.
+  rewrite Share.lub_commute; by apply readable_share_lub.
+Qed.
+Next Obligation.
+Proof.
+  apply writable0_readable.
+Qed.
+Next Obligation.
+Proof.
+  intros; simpl.
+  destruct (eq_dec _ _); last done.
+  eapply join_writable0_readable in H; done.
+Qed.
+Next Obligation.
+Proof.
+  apply bot_unreadable.
+Qed.
+Next Obligation.
+Proof.
+  apply writable_writable0; auto.
+Qed.
+Next Obligation.
+Proof.
+  intros *; simpl.
+  destruct (eq_dec _ _); inversion 1; subst.
+  intros; by apply (@join_unreadable_shares a b).
+Qed.
+
+Lemma share_op_is_join : forall a b c, share_op a b = Some c <-> sepalg.join a b c.
+Proof.
+  intros; rewrite /= /sepalg.join /Share.Join_ba.
+  split.
+  - destruct (eq_dec _ _); inversion 1; auto.
+  - intros [-> ->]; rewrite eq_dec_refl //.
+Qed.
+
+Global Instance share_eq_dec : EqDecision share.
+Proof. intros ??. by destruct (eq_dec x y); [left | right]. Defined.
+
+Require Import VST.shared.dshare.
+
+Global Instance dfrac_eq_dec : EqDecision dfrac.
+Proof.
+  rewrite /RelDecision /Decision => ??.
+  decide equality; decide equality; apply share_eq_dec.
+Defined.
diff --git a/veric/shares.v b/veric/shares.v
index 8abdb441d2..e6e3027955 100644
--- a/veric/shares.v
+++ b/veric/shares.v
@@ -1298,3 +1298,13 @@ split.
 apply Share.comp2.
 apply Share.comp1.
 Qed.
+
+Lemma nonidentity_notbot:
+  forall sh, sepalg.nonidentity sh -> (sh <> Share.bot).
+Proof.
+intros.
+unfold nonidentity in H.
+unfold not; intros. subst.
+auto.
+Qed.
+#[export] Hint Resolve nonidentity_notbot : core.
\ No newline at end of file
diff --git a/veric/slice.v b/veric/slice.v
index c72190ea15..0f81f4c15d 100644
--- a/veric/slice.v
+++ b/veric/slice.v
@@ -1,12 +1,11 @@
 Require Import VST.veric.base.
-Require Import VST.msl.msl_standard.
 Require Import VST.veric.shares.
-Require Import VST.veric.compcert_rmaps.
+Require Import VST.shared.share_alg.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.res_predicates.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.zlist.sublist.
 
-Local Open Scope pred.
-
 Definition cleave (sh: share) :=
   (Share.lub (fst (Share.split (Share.glb Share.Lsh sh))) (fst (Share.split (Share.glb Share.Rsh sh))),
    Share.lub (snd (Share.split (Share.glb Share.Lsh sh))) (snd (Share.split (Share.glb Share.Rsh sh)))).
@@ -32,14 +31,14 @@ split.
 rewrite !Share.distrib1.
 rewrite !(Share.glb_commute (Share.lub _ _)).
 rewrite !Share.distrib1.
-rewrite (Share.glb_commute b a), (Share.glb_commute f e).
-rewrite H,H0.
+rewrite (Share.glb_commute b a) (Share.glb_commute f e).
+rewrite H H0.
 rewrite (Share.lub_commute Share.bot).
 rewrite !Share.lub_bot.
 rewrite Share.distrib2.
 rewrite !(Share.lub_commute (Share.glb _ _)).
 rewrite !Share.distrib2.
-rewrite (Share.lub_commute f e), H3, H2.
+rewrite (Share.lub_commute f e) H3 H2.
 rewrite (Share.glb_commute (Share.lub _ _)).
 rewrite (Share.glb_assoc Share.Lsh).
 rewrite !(Share.glb_assoc Share.Rsh).
@@ -55,7 +54,7 @@ rewrite (Share.lub_commute e).
 rewrite (Share.lub_assoc b).
 rewrite <- Share.lub_assoc.
 rewrite H2.
-rewrite (Share.lub_commute f e), H3.
+rewrite (Share.lub_commute f e) H3.
 clear.
 do 2 rewrite (Share.glb_commute _ (Share.lub _ _)).
 rewrite <- Share.distrib1.
@@ -98,1205 +97,288 @@ apply (split_nontrivial' _ _ _ H1).
 simpl in *.
 right.
 apply split_join in H1.
-apply join_comm in H1.
+apply sepalg.join_comm in H1.
 simpl in *.
 destruct (join_parts1 comp_Rsh_Lsh H1).
 rewrite <- H0, H.
 apply bot_identity.
 Qed.
 
-Lemma rshare_sh_readable:
- forall r, readable_share (rshare_sh r).
-Proof.
-destruct r; simpl.
-destruct p;
-auto.
-Qed.
-
-Lemma cleave_nonreadable1:
-  forall sh, ~readable_share sh -> ~ readable_share (fst (cleave sh)).
-Proof.
-intros.
-contradict H.
-do 3 red in H|-*.
-contradict H.
-unfold cleave. simpl.
-apply identity_share_bot in H.
-rewrite H. clear H.
-destruct (Share.split Share.bot) as [a b] eqn:?H.
-apply split_join in H.
-simpl.
-apply split_identity in H; [ | apply bot_identity].
-apply identity_share_bot in H. subst.
-rewrite Share.lub_bot.
-clear.
-destruct (Share.split (Share.glb Share.Lsh sh)) as [a b] eqn:H.
-apply split_join in H.
-simpl.
-replace (Share.glb Share.Rsh a) with Share.bot.
-apply bot_identity.
-symmetry.
-destruct H.
-apply (f_equal (Share.glb Share.Rsh)) in H0.
-rewrite <- Share.glb_assoc in H0.
-rewrite (Share.glb_commute _ Share.Lsh) in H0.
-rewrite glb_Lsh_Rsh in H0.
-rewrite (Share.glb_commute Share.bot) in H0.
-rewrite Share.glb_bot in H0.
-rewrite Share.distrib1 in H0.
-apply lub_bot_e in H0. destruct H0 as [? _].
-auto.
-Qed.
-
-Lemma cleave_nonreadable2:
-  forall sh, ~readable_share sh -> ~ readable_share (snd (cleave sh)).
-Proof.
-intros.
-contradict H.
-do 3 red in H|-*.
-contradict H.
-unfold cleave. simpl.
-apply identity_share_bot in H.
-rewrite H. clear H.
-destruct (Share.split Share.bot) as [a b] eqn:?H.
-apply split_join in H.
-simpl.
-apply join_comm in H.
-apply split_identity in H; [ | apply bot_identity].
-apply identity_share_bot in H. subst.
-rewrite Share.lub_bot.
-clear.
-destruct (Share.split (Share.glb Share.Lsh sh)) as [a b] eqn:H.
-apply split_join in H.
-simpl.
-replace (Share.glb Share.Rsh b) with Share.bot.
-apply bot_identity.
-symmetry.
-destruct H.
-apply (f_equal (Share.glb Share.Rsh)) in H0.
-rewrite <- Share.glb_assoc in H0.
-rewrite (Share.glb_commute _ Share.Lsh) in H0.
-rewrite glb_Lsh_Rsh in H0.
-rewrite (Share.glb_commute Share.bot) in H0.
-rewrite Share.glb_bot in H0.
-rewrite Share.lub_commute in H0.
-rewrite Share.distrib1 in H0.
-apply lub_bot_e in H0. destruct H0 as [? _].
-auto.
-Qed.
-
-Definition split_resource r :=
-  match r with YES sh rsh k pp =>
-               (YES (fst (cleave sh)) (cleave_readable1 _ rsh) k pp ,
-                YES (snd (cleave sh)) (cleave_readable2 _ rsh) k pp)
-             | PURE k pp => (PURE k pp, PURE k pp)
-             | NO sh nsh => (NO (fst (cleave sh)) (cleave_nonreadable1 _ nsh),
-                             NO (snd (cleave sh)) (cleave_nonreadable2 _ nsh))
-  end.
 
+Section heap.
+Context `{!gen_heapGS share address resource Σ} `{!wsatGS Σ}.
 
-Lemma glb_cleave_lemma1: forall sh0 sh,
-  Share.glb Share.Rsh sh0 = Share.glb Share.Rsh sh ->
- Share.glb Share.Rsh (fst (cleave sh0)) =
- Share.glb Share.Rsh (fst (cleave sh)).
+Lemma share_join_op: forall (sh1 sh2 sh : share), sepalg.join sh1 sh2 sh ->
+  Share sh1 ⋅ Share sh2 = Share sh.
 Proof.
-intros.
-unfold cleave; simpl.
-destruct (Share.split (Share.glb Share.Lsh sh0)) as [a0 b0]  eqn:H0.
-apply split_join in H0.
-destruct (Share.split (Share.glb Share.Lsh sh)) as [a b]  eqn:H1.
-apply split_join in H1.
-destruct (Share.split (Share.glb Share.Rsh sh0)) as [c0 d0]  eqn:H2.
-rewrite H in H2. rewrite H2.
-simpl.
-apply split_join in H2.
-rewrite !Share.distrib1.
-apply (join_parts1 comp_Lsh_Rsh) in H1.
-destruct H1 as [_ ?]. rewrite H1.
-apply (join_parts1 comp_Lsh_Rsh) in H0.
-destruct H0 as [_ ?]. rewrite H0.
-auto.
+  intros *; rewrite -share_op_is_join.
+  intros; rewrite share_op_equiv; eauto.
 Qed.
 
-Lemma glb_cleave_lemma2: forall sh0 sh,
-  Share.glb Share.Rsh sh0 = Share.glb Share.Rsh sh ->
- Share.glb Share.Rsh (snd (cleave sh0)) =
- Share.glb Share.Rsh (snd (cleave sh)).
+Lemma mapsto_share_join: forall sh1 sh2 sh l r, sepalg.join sh1 sh2 sh ->
+  readable_share sh1 -> readable_share sh2 ->
+  l ↦{#sh1} r ∗ l ↦{#sh2} r ⊣⊢ l ↦{#sh} r.
 Proof.
-intros.
-unfold cleave; simpl.
-destruct (Share.split (Share.glb Share.Lsh sh0)) as [a0 b0]  eqn:H0.
-apply split_join in H0.
-destruct (Share.split (Share.glb Share.Lsh sh)) as [a b]  eqn:H1.
-apply split_join in H1.
-apply join_comm in H0.
-apply join_comm in H1.
-destruct (Share.split (Share.glb Share.Rsh sh0)) as [c0 d0]  eqn:H2.
-rewrite H in H2. rewrite H2.
-simpl.
-apply split_join in H2.
-rewrite !Share.distrib1.
-apply (join_parts1 comp_Lsh_Rsh) in H1.
-destruct H1 as [_ ?]. rewrite H1.
-apply (join_parts1 comp_Lsh_Rsh) in H0.
-destruct H0 as [_ ?]. rewrite H0.
-auto.
+  intros; rewrite -mapsto_split; try done.
+  rewrite dfrac_op_own.
+  erewrite share_join_op; try done; intros ->; contradiction bot_unreadable.
 Qed.
 
-Lemma split_rmap_ok1: forall m,
-  resource_fmap (approx (level m)) (approx (level m)) oo (fun l => fst (split_resource (m @ l))) =
-       (fun l => fst (split_resource (m @ l))).
-Proof.
-intros.
-extensionality l; unfold compose; simpl.
-case_eq (m@l); simpl; intros; auto.
-generalize (eq_sym (resource_at_approx m l)); intro.
-pattern (m@l) at 2 in H0; rewrite H in H0.
-simpl in H0.
-rewrite H in H0.
-inversion H0.
-rewrite <- H2.
-rewrite <- H2.
-auto.
-generalize (eq_sym (resource_at_approx m l)); intro.
-pattern (m@l) at 2 in H0; rewrite H in H0.
-simpl in H0.
-rewrite H in H0.
-inversion H0.
-rewrite <- H2.
-rewrite <- H2.
-auto.
-Qed.
-
-Lemma split_rmap_ok2: forall m,
-  resource_fmap (approx (level m)) (approx (level m)) oo (fun l => snd (split_resource (m @ l))) =
-       (fun l => snd (split_resource (m @ l))).
-Proof.
-intros.
-extensionality l; unfold compose; simpl.
-case_eq (m@l); simpl; intros; auto.
-generalize (eq_sym (resource_at_approx m l)); intro.
-pattern (m@l) at 2 in H0; rewrite H in H0.
-simpl in H0.
-rewrite H in H0.
-inversion H0.
-rewrite <- H2.
-rewrite <- H2.
-auto.
-generalize (eq_sym (resource_at_approx m l)); intro.
-pattern (m@l) at 2 in H0; rewrite H in H0.
-simpl in H0.
-rewrite H in H0.
-inversion H0.
-rewrite <- H2.
-rewrite <- H2.
-auto.
-Qed.
-
-(*
-Definition split_rmap (m: rmap) : rmap * rmap :=
- (proj1_sig (make_rmap _ (split_rmap_valid1 m) (level m) (split_rmap_ok1 m)),
-  proj1_sig (make_rmap _ (split_rmap_valid2 m) (level m) (split_rmap_ok2 m))).
-*)
-
-Lemma split_resource_join:
-  forall r, join (fst (split_resource r)) (snd (split_resource r)) r.
-Proof.
-intro.
-destruct r; simpl; constructor; auto; try (apply cleave_join; apply surjective_pairing).
-Qed.
-
-(*Lemma split_rmap_join:
-  forall m, join (fst (split_rmap m)) (snd (split_rmap m)) m.
-Proof.
-intros.
-unfold split_rmap; simpl.
-case_eq (make_rmap _ (split_rmap_valid1 m) (level m) (split_rmap_ok1 m)); intros.
-case_eq (make_rmap _ (split_rmap_valid2 m) (level m) (split_rmap_ok2 m)); intros.
-simpl in *.
-generalize a; intros  [? ?].
-generalize a0; intros [? ?].
-apply resource_at_join2; simpl; try congruence.
-rewrite H2; rewrite H4; simpl; auto.
-intro l.
-apply split_resource_join; auto.
-Qed.
-
-Lemma split_rmap_at1:
-  forall m l , fst (split_rmap m) @ l = fst (split_resource (m @ l)).
-Proof.
-unfold split_rmap; intros; simpl.
-case_eq (make_rmap _ (split_rmap_valid1 m) (level m) (split_rmap_ok1 m)); intros.
-simpl in *.
-destruct a. rewrite e0; auto.
-Qed.
-
-Lemma split_rmap_at2:
-  forall m l , snd (split_rmap m) @ l = snd (split_resource (m @ l)).
-Proof.
-unfold split_rmap; intros; simpl.
-case_eq (make_rmap _ (split_rmap_valid2 m) (level m) (split_rmap_ok2 m)); intros.
-simpl. clear H; destruct a. rewrite H0; auto.
-Qed.*)
-
-Definition split_shareval (shv: Share.t * val) : ((Share.t * val) * (Share.t * val)) :=
-  ((fst (Share.split (fst shv)), snd shv), (snd (Share.split (fst shv)), snd shv)).
-
-Definition slice_resource (sh: share) (r: resource) : resource :=
-  match r with
-   | NO _ _ => NO (retainer_part sh) (retainer_part_nonreadable sh)
-   | YES _ _ k pp =>
-    match readable_share_dec sh with
-    | left r1 => YES sh r1 k pp
-    | right n => NO sh n
-    end
-   | PURE k pp => PURE k pp
-  end.
-
-
-Lemma make_slice_rmap: forall w (P: address -> Prop) (P_DEC: forall l, {P l} + {~ P l}) sh,
-  (forall l : AV.address, ~ P l -> identity (w @ l)) ->
-  {w' | level w' = level w /\ resource_at w' =
-       (fun l => if P_DEC l then slice_resource sh (w @ l) else w @ l) /\
-       ghost_of w' = ghost_of w}.
-Proof.
-  intros.
-  pose (f l := if P_DEC l then slice_resource sh (w @ l) else w @ l).
-  apply (make_rmap _ (ghost_of w) (level w)).
-  extensionality loc; unfold compose, f.
-  destruct (P_DEC loc).
-  + pose proof resource_at_approx w loc.
-    destruct (w @ loc); auto.
-    simpl.
-    destruct (readable_share_dec sh); auto.
-    inversion H0.
-    simpl; f_equal; f_equal; auto.
-  + apply resource_at_approx.
-  + apply ghost_of_approx.
-Qed.
-
-Lemma make_core_slice_rmap: forall w (P: address -> Prop) (P_DEC: forall l, {P l} + {~ P l}) sh,
-  (forall l : AV.address, ~ P l -> identity (w @ l)) ->
-  {w' | level w' = level w /\ resource_at w' =
-       (fun l => if P_DEC l then slice_resource sh (w @ l) else w @ l) /\
-       ghost_of w' = core (ghost_of w)}.
-Proof.
-  intros.
-  pose (f l := if P_DEC l then slice_resource sh (w @ l) else w @ l).
-  apply (make_rmap _ (core (ghost_of w)) (level w)).
-  extensionality loc; unfold compose, f.
-  destruct (P_DEC loc).
-  + pose proof resource_at_approx w loc.
-    destruct (w @ loc); auto.
-    simpl.
-    destruct (readable_share_dec sh); auto.
-    inversion H0.
-    simpl; f_equal; f_equal; auto.
-  + apply resource_at_approx.
-  + apply ghost_fmap_core.
-Qed.
-
-Lemma jam_noat_splittable_aux:
-  forall S' S Q (PARAMETRIC: spec_parametric Q)
-           (sh1 sh2 sh3: share)
-           (rsh1: readable_share sh1) (rsh2: readable_share sh2)
-           l
-           (H: join sh1 sh2 sh3)
-           w (H0: allp (@jam _ _ _ _ _ _ _ _ _ (S' l) (S l) (Q l sh3) noat) w)
-           f (Hf: resource_at f = fun loc => slice_resource (if S l loc then sh1 else Share.bot) (w @ loc))
-           g (Hg: resource_at g = fun loc => slice_resource (if S l loc then sh2 else Share.bot) (w @ loc))
-           (H1: join f g w),
-           allp (jam (S l) (Q l sh1) noat) f.
-Proof.
-intros.
-(*assert (rsh3: readable_share sh3) by (eapply readable_share_join ; eauto). *)
-intro l'.
-specialize ( H0 l').
-unfold jam in H0 |- *.
-simpl in H0|-*.
-if_tac.
-destruct (PARAMETRIC l l') as [pp [ok ?]]; clear PARAMETRIC.
-rewrite H3 in H0 |- *; clear H3.
-destruct H0 as [rsh3 [k [? ?]]].
-exists rsh1, k; split; auto.
-clear H0.
-case_eq (w @ l'); intros.
-inversion2 H0 H3.
-destruct p.
-inversion2 H0 H3.
-generalize (resource_at_join _ _ _ l' H1); intro.
-generalize (f_equal (resource_at f) (refl_equal l')); intro.
-pattern f at 1 in H4; rewrite Hf in H4.
-rewrite H0 in H4.
-rewrite H4.
-rewrite if_true in H4|-* by auto.
-simpl.
-destruct (readable_share_dec sh1); [ | contradiction].
-replace (level f) with (level w).
-rewrite H7.
-f_equal. apply proof_irr.
-apply join_level in H1; intuition.
-congruence.
-(* noat case *)
-generalize (resource_at_join _ _ _ l' H1); intro.
-apply split_identity in H3; auto.
-Qed.
-
-Lemma slice_resource_identity:
-  forall r, identity r -> slice_resource Share.bot r = r.
-Proof.
- intros.
- destruct r; simpl in *; auto.
- assert (sh = retainer_part Share.bot).
-   unfold retainer_part. rewrite Share.glb_bot.
-   apply identity_NO in H.
-   destruct H as [|]. inv H. auto. destruct H as [? [? ?]]. inv H.
-   subst; f_equal. apply proof_irr.
-   apply YES_not_identity in H. contradiction.
-Qed.
-
-Definition splittable {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}{EO: Ext_ord A}{EA: Ext_alg A} (Q: Share.t -> pred A) :=
-  forall (sh1 sh2 sh3: Share.t) (rsh1: readable_share sh1) (rsh2: readable_share sh2),
-    join sh1 sh2 sh3 ->
-    Q sh1 * Q sh2 = Q sh3.
-
-(*Lemma jam_noat_splittable:
-  forall (S': address -> address -> Prop) S
-           (Q: address -> spec)
-     (PARAMETRIC: spec_parametric Q),
-    forall l, splittable (fun sh => allp (@jam _ _ _ _ _ _ _ _ (S' l) (S l) (Q l sh) noat)).
-Proof.
-unfold splittable; intros.
-apply pred_ext; intro w; simpl.
-+  intros [w1 [w2 [? [? ?]]]].
-  intro l'. specialize ( H1 l'); specialize ( H2 l').
-  unfold jam in *.
-  revert H1 H2.
-  if_tac.
-  - intros.
-    specialize (PARAMETRIC l l').
-    destruct PARAMETRIC as [pp [ok ?]].
-    rewrite H4 in H2. destruct H2 as [rsh1' [k1 [G1 H1']]].
-    rewrite H4 in H3; destruct H3 as [rsh2' [k2 [G2 H2']]].
-    rewrite H4.
-    assert (rsh3 := join_readable1 H rsh1).
-    exists rsh3.
-    exists k2.
-    generalize (resource_at_join _ _ _ l' H0); rewrite H1'; rewrite H2'; intro Hx.
-    generalize H; clear H.
-    inv Hx.
-    split; auto.
-    simpl.
-    replace (level w1) with (level w) by (apply join_level in H0; intuition).
-    pose proof (join_eq H RJ). subst sh5.
-    f_equal; auto with extensionality.
-  - intros.
-    generalize (resource_at_join _ _ _ l' H0); intro.
-    apply H2 in H4. rewrite H4 in H3; auto.
-+ intros.
-  pose (f loc := if S l loc then slice_resource sh1 (w @ loc) else w@loc).
-  assert (Vf: CompCert_AV.valid (res_option oo f)). {
-     apply slice_resource_valid.
-     intros. specialize (H0 l0). rewrite if_false in H0; auto.
-  }
-  destruct (make_rmap _ Vf (level w)) as [phi [Gf Hf]].
-  {
-    extensionality loc; unfold compose, f.
-    specialize (PARAMETRIC l loc).
-    destruct PARAMETRIC as [pp [ok Jf]].
-    specialize ( H0 loc).
-    destruct (S l loc).
-    rewrite Jf in H0.
-    destruct H0 as [p3 [k3 [G0 H0]]].
-    generalize (resource_at_approx w loc); intro.
-    rewrite H0 in H1.
-    inversion H1; clear H1; auto.
-    rewrite H0.
-    simpl.
-    destruct (readable_share_dec sh1); auto.
-    revert H0; case_eq (w @ loc); intros; try contradiction; simpl; f_equal; auto.
-    apply resource_at_approx.
-  }
-  pose (g loc := if S l loc then slice_resource sh2 (w @ loc) else w@loc).
-  assert (Vg: CompCert_AV.valid (res_option oo g)). {
-     apply slice_resource_valid.
-     intros. specialize (H0 l0). rewrite if_false in H0; auto.
-  }
-  destruct (make_rmap _ Vg (level w)) as [phi' [Gg Hg]].
-  {
-    extensionality loc; unfold compose, g.
-    specialize (PARAMETRIC l loc).
-    destruct PARAMETRIC as [pp [ok Jg]].
-    specialize ( H0 loc).
-    destruct (S l loc).
-    rewrite Jg in H0.
-    destruct H0 as [p3 [k3 [G0 H0]]].
-    generalize (resource_at_approx w loc); intro.
-    rewrite H0 in H1.
-    inversion H1; clear H1; auto.
-    rewrite H0.
-    simpl.
-    destruct (readable_share_dec sh2); auto.
-    revert H0; case_eq (w @ loc); intros; try contradiction; simpl; f_equal; auto.
-    apply resource_at_approx.
-  }
-  unfold f,g in *; clear f g.
-  rename phi into f; rename phi' into g.
-  assert (join f g w). {
-   apply resource_at_join2; auto.
-   intro.
-   rewrite Hf; rewrite Hg.
-   clear - PARAMETRIC H H0 rsh1 rsh2.
-   specialize ( H0 loc).
-   if_tac in H0.
-   destruct (PARAMETRIC l loc) as [pp [ok ?]]; clear PARAMETRIC.
-   rewrite H2 in H0.
-   destruct H0 as [? [? [? ?]]].
-   rewrite H3.
-   generalize (preds_fmap (approx (level w)) (approx (level w)) pp); intro.
-   simpl.
-   destruct (readable_share_dec sh1); [ | contradiction].
-   destruct (readable_share_dec sh2); [ | contradiction].
-   constructor; auto.
-   apply identity_unit' in H0. apply H0.
-  }
-  econstructor; econstructor; split; [apply H1|].
-  split.
-  eapply jam_noat_splittable_aux; eauto.
-  simpl; auto.
-  rewrite Hf. extensionality loc. if_tac. auto.
-  clear - H0 H2. specialize (H0 loc). rewrite if_false in H0 by auto.
-  symmetry; apply slice_resource_identity; auto.
-  rewrite Hg. extensionality loc. if_tac. auto.
-  clear - H0 H2. specialize (H0 loc). rewrite if_false in H0 by auto.
-  symmetry; apply slice_resource_identity; auto.
-  apply join_comm in H.
-  eapply jam_noat_splittable_aux.
-  auto. auto. apply rsh1. eauto. 4: apply (join_comm H1).
-  simpl; auto.
-  rewrite Hg. extensionality loc. if_tac. auto.
-  clear - H0 H2. specialize (H0 loc). rewrite if_false in H0 by auto.
-  symmetry; apply slice_resource_identity; auto.
-  rewrite Hf. extensionality loc. if_tac. auto.
-  clear - H0 H2. specialize (H0 loc). rewrite if_false in H0 by auto.
-  symmetry; apply slice_resource_identity; auto.
-Qed.*)
-
-(*Lemma address_mapsto_splittable:
-      forall ch v l, splittable (fun sh => address_mapsto ch v sh l).
-Proof.
-intros.
-unfold splittable.
-intros ? ? ? rsh1 rsh2 H.
-apply pred_ext; intros ? ?.
-*
-destruct H0 as [m1 [m2 [? [? ?]]]].
-unfold address_mapsto in *.
-destruct H1 as [bl1 [[[LEN1 DECODE1] ?] Hg1]]; destruct H2 as [bl2 [[[LEN2 DECODE2] ?] Hg2]].
-exists bl1; split; [split|]; auto.
-simpl; auto.
-intro loc; specialize ( H1 loc); specialize ( H2 loc).
-unfold jam in *.
-apply (resource_at_join _ _ _ loc) in H0.
-hnf in H1, H2|-*.
-if_tac.
-hnf in H1,H2.
-destruct H1; destruct H2.
-hnf.
-exists (join_readable1 H rsh1).
-unfold yesat_raw in *.
-hnf in H1,H2|-*.
-rewrite preds_fmap_NoneP in *.
-repeat proof_irr.
-rewrite H1 in H0; rewrite H2 in H0; clear H1 H2.
-unfold yesat_raw.
-inv H0.
-pose proof (join_eq H RJ); subst sh5; clear RJ rsh5 rsh6.
-f_equal.
-apply proof_irr.
-apply H1 in H0. do 3 red in H2|-*. rewrite <- H0; auto.
-simpl; rewrite <- (Hg1 _ _ (ghost_of_join _ _ _ H0)); auto.
-*
-rename a into m.
-hnf in H0|-*.
-destruct H0 as [bl [[[? [? Halign]] ?] Hg]].
-pose (rslice (rsh : Share.t) (loc: address) := if adr_range_dec l (size_chunk ch) loc then rsh else Share.bot).
-assert (G1: forall l0 : AV.address,
-  ~ adr_range l (size_chunk ch) l0 -> identity (m @ l0)). {
-   intros. specialize (H2 l0). rewrite  jam_false in H2 by auto.
-   apply H2.
- }
-destruct (make_slice_rmap m _ (adr_range_dec l (size_chunk ch)) sh1 G1)
-  as [m1 [? ?]].
-destruct (make_slice_rmap m _ (adr_range_dec l (size_chunk ch)) sh2 G1)
-  as [m2 [? ?]].
-exists m1, m2.
-split3.
-+
-apply resource_at_join2; try congruence.
-intro loc.
-rewrite H4,H6. clear H4 H6. clear H3 H5. clear m1 m2.
-specialize (G1 loc). clear rslice.
-specialize (H2 loc). hnf in H2.
-if_tac.
-destruct H2 as [rsh ?].
-hnf in H2. rewrite H2. clear H2.
-unfold slice_resource.
-destruct (readable_share_dec sh1); [ | contradiction].
-destruct (readable_share_dec sh2); [ | contradiction].
-constructor. auto.
-do 3 red in H2. apply identity_unit' in H2. apply H2; auto.
-+
-exists bl; repeat split; auto.
-intro loc; specialize ( H2 loc); unfold jam in *;  hnf in H2|-*; if_tac; auto.
-exists rsh1.
-hnf.
-rewrite H4.
-rewrite if_true by auto.
-unfold slice_resource.
-destruct H2. hnf in H2.
-rewrite H2.
-destruct (readable_share_dec sh1); [ | contradiction].
-f_equal. apply proof_irr.
-do 3 red in H2|-*.
-rewrite H4. rewrite if_false by auto. auto.
-+
-exists bl; repeat split; auto.
-intro loc; specialize ( H2 loc); unfold jam in *;  hnf in H2|-*; if_tac; auto.
-exists rsh2.
-hnf.
-rewrite H6.
-rewrite if_true by auto.
-unfold slice_resource.
-destruct H2. hnf in H2.
-rewrite H2.
-destruct (readable_share_dec sh2); [ | contradiction].
-f_equal. apply proof_irr.
-do 3 red in H2|-*.
-rewrite H6. rewrite if_false by auto. auto.
-Qed.
-
-Lemma VALspec_splittable: forall l, splittable (fun sh => VALspec sh l).
-Proof.
-apply jam_noat_splittable.
-apply VALspec_parametric.
-Qed.
-
-Lemma LKspec_splittable size: forall R l, splittable (fun sh => LKspec size R sh l).
-Proof.
-intro.
-apply jam_noat_splittable.
-apply LKspec_parametric.
-Qed.
-
-Lemma VALspec_range_splittable: forall n l, splittable (fun sh => VALspec_range n sh l).
-Proof.
-intro.
-apply jam_noat_splittable.
-apply VALspec_parametric.
-Qed. *)
-
-Definition share_oblivious (P: pred rmap) :=
-  forall w w',
-   (forall l, match w' @ l , w @ l with
-                 | NO _ _, NO _ _ => True
-                 | YES _ sh1 k1 p1 , YES _ sh2 k2 p2 => k1=k2 /\ p1=p2
-                 | PURE k1 p1, PURE k2 p2 => k1=k2 /\ p1=p2
-                 | _ , _ => False
-                 end) ->
-     P w' -> P w.
-
-(*Lemma intersection_splittable:
-    forall (S': address -> address -> Prop) S P Q,
-         spec_parametric P ->
-         (forall l, share_oblivious (Q l)) ->
-    forall l, splittable (fun sh => allp (@jam _ _ _ _ _ _ (S' l) (S l) (P l sh) noat) && Q l).
-Proof.
-intros.
-intro; intros.
-generalize (jam_noat_splittable S' S _ H); intro.
-rewrite <- (H2  _ _ _  _ rsh1 rsh2 H1).
-apply pred_ext; intros w ?.
-destruct H3 as [w1 [w2 [? [[? ?] [? ?]]]]].
-split.
-exists w1; exists w2; auto.
-eapply H0; eauto.
-intro.
-generalize (resource_at_join _ _ _ l0 H3).
-case_eq (w2 @ l0); case_eq (w @ l0); intros; auto; try solve [inv H10].
-case_eq (w1 @ l0); intros.
-rewrite H11 in H10; inv H10.
-rewrite H11 in H10; inv H10.
-specialize (H4 l0).
-specialize (H6 l0).
-hnf in H4,H6.
-if_tac in H4; auto.
-specialize (H l l0).
-destruct H as [pp [ok ?]].
-rewrite H in H4; rewrite H in H6.
-destruct H4 as [? [? [? ?]]].
-destruct H6 as [? [? [? ?]]].
-inversion2 H11 H12.
-inversion2 H9 H13.
-do 3 red in H4. rewrite H11 in H4.
-contradiction (YES_not_identity _ _ _ _ H4).
-rewrite H11 in H10; inv H10.
-destruct (w1 @ l0); inv H10; auto.
-inv H10; auto.
-destruct H3 as [[w1 [w2 [? [? ?]]]] ?].
-exists w1; exists w2.
-split; auto.
-split; split; auto.
-apply (H0 l w1 w).
-intro l0; generalize (resource_at_join _ _ _ l0 H3).
-case_eq (w @ l0); case_eq (w1 @ l0); intros; auto; try solve [inv H9].
-case_eq (w2 @ l0); intros.
-rewrite H10 in H9; inv H9.
-rewrite H10 in H9; inv H9.
-specialize (H l l0).
-destruct H as [pp [ok ?]].
-specialize (H4 l0).
-specialize (H5 l0).
-hnf in H4,H5.
-if_tac in H4.
-rewrite H in H4,H5.
-destruct H4 as [? [? [? ?]]].
-destruct H5 as [? [? [? ?]]].
-congruence.
-do 3 red in H5. rewrite H10 in H5.
-contradiction (YES_not_identity _ _ _ _ H5).
-rewrite H10 in H9; inv H9.
-inv H9; auto.
-inv H9; auto.
-auto.
-apply (H0 l w2 w ).
-intro l0; generalize (resource_at_join _ _ _ l0 H3).
-case_eq (w @ l0); case_eq (w2 @ l0); intros; auto; try solve [inv H9].
-inv H9.
-specialize (H l l0).
-destruct H as [pp [ok ?]].
-specialize (H4 l0).
-specialize (H5 l0).
-hnf in H4,H5.
-if_tac in H4.
-rewrite H in H4,H5.
-destruct H4 as [? [? [? ?]]].
-destruct H5 as [? [? [? ?]]].
-congruence.
-do 3 red in H4. rewrite <- H11 in H4.
-contradiction (YES_not_identity _ _ _ _ H4).
-inv H9; auto. inv H9; auto.
-auto.
-Qed. *)
-
-Lemma not_readable_share_retainer_part_eq:
-  forall sh, ~ readable_share sh -> retainer_part sh = sh.
-   intros.
-    apply not_not_share_identity in H.
-    unfold retainer_part.
-    rewrite (comp_parts comp_Lsh_Rsh sh) at 2.
-    apply identity_share_bot in H; rewrite H.
-    rewrite Share.lub_bot. auto.
-Qed.
-
-Lemma slice_resource_resource_share: forall r sh sh',
-  resource_share r = Some sh ->
-  join_sub sh' sh ->
-  resource_share (slice_resource sh' r) = Some sh'.
-Proof.
-  intros.
-  destruct r; inv H; unfold slice_resource; simpl.
-  + f_equal.
-    assert (~readable_share sh'). contradict n. destruct H0.
-    eapply join_readable1; eauto.
-    apply not_readable_share_retainer_part_eq; auto.
-  + destruct (readable_share_dec sh'); simpl; auto.
-Qed.
-
-Lemma slice_resource_nonlock: forall r sh sh',
-  resource_share r = Some sh ->
-  join_sub sh' sh ->
-  nonlock r ->
-  nonlock (slice_resource sh' r).
+Lemma address_mapsto_share_join:
+ forall (sh1 sh2 sh : share) ch v a,
+   sepalg.join sh1 sh2 sh ->
+   readable_share sh1 -> readable_share sh2 ->
+   address_mapsto ch v sh1 a ∗ address_mapsto ch v sh2 a
+    ⊣⊢ address_mapsto ch v sh a.
 Proof.
   intros.
-  destruct r; inv H; unfold slice_resource; simpl; auto.
-  destruct (readable_share_dec sh'); simpl; auto.
-Qed.
-
-Lemma NO_ext: forall sh1 sh2 rsh1 rsh2, sh1=sh2 -> NO sh1 rsh1 = NO sh2 rsh2.
-Proof. intros. subst sh1. f_equal. apply proof_irr. Qed.
-
-Lemma join_sub_is_slice_resource: forall r r' sh',
-  join_sub r' r ->
-  resource_share r' = Some sh' ->
-  r' = slice_resource sh' r.
+  rewrite /address_mapsto.
+  setoid_rewrite big_sepL_proper at 3; last by intros; symmetry; apply mapsto_share_join.
+  setoid_rewrite big_sepL_sep.
+  iSplit.
+  - iIntros "[H1 H2]".
+    iDestruct "H1" as (bl1 (? & ? & ?)) "H1".
+    iDestruct "H2" as (bl (? & ? & ?)) "H2".
+    iDestruct (mapsto_list_value_cohere with "[$H1 $H2]") as %->.
+    { congruence. }
+    iExists bl; iSplit; first auto.
+    iSplitL "H1"; done.
+  - iIntros "H".
+    iDestruct "H" as (bl ?) "H".
+    rewrite bi.sep_exist_r; iExists bl.
+    rewrite bi.sep_exist_l; iExists bl.
+    by iFrame "%".
+Qed.
+
+Lemma address_mapsto_share_joins:
+ forall (sh1 sh2 : share) ch v a,
+   address_mapsto ch v sh1 a ∗ address_mapsto ch v sh2 a ⊢ ⌜sepalg.joins sh1 sh2⌝.
 Proof.
   intros.
-  destruct H as [r'' ?].
-  destruct r, r'; inv H; inv H0; simpl.
-  + f_equal.
-    clear - n0.
-    apply NO_ext. symmetry.
-    rewrite not_readable_share_retainer_part_eq; auto.
-  + destruct (readable_share_dec sh'); [ contradiction |].
-    apply NO_ext; auto.
-  + destruct (readable_share_dec sh'); [| contradiction ].
-    f_equal. apply proof_irr.
-  + destruct (readable_share_dec sh'); [| contradiction ].
-    f_equal. apply proof_irr.
+  rewrite /address_mapsto.
+  iIntros "((%bl1 & (% & %) & H1) & (%bl2 & % & H2))".
+  destruct (size_chunk_nat_pos ch) as (? & ?).
+  destruct bl1, bl2; simpl in *; try lia.
+  iDestruct "H1" as "(H1 & _)"; iDestruct "H2" as "(H2 & _)".
+  iDestruct (mapsto_valid_2 with "H1 H2") as %(Hsh & _); iPureIntro.
+  apply share_valid2_joins in Hsh as (? & ? & ? & [=] & [=] & ? & Hsh); subst.
+  rewrite share_op_is_join in Hsh; eexists; eauto.
 Qed.
 
-Lemma slice_resource_share_join: forall sh1 sh2 sh r,
-  join sh1 sh2 sh ->
-  resource_share r = Some sh ->
-  join (slice_resource sh1 r) (slice_resource sh2 r) r.
+Lemma mapsto_no_mapsto_share_join: forall sh1 sh2 sh l r (nsh : ~readable_share sh1), sepalg.join sh1 sh2 sh ->
+  readable_share sh2 ->
+  mapsto_no l sh1 ∗ l ↦{#sh2} r ⊣⊢ l ↦{#sh} r.
 Proof.
-  intros.
-  destruct r; simpl in *.
-*
-  constructor. inv H0.
-  assert (~readable_share sh1) by (contradict n; eapply join_readable1; eauto).
-  assert (~readable_share sh2) by (contradict n; eapply join_readable2; eauto).
-  rewrite !(not_readable_share_retainer_part_eq); auto.
-*
-  inv H0.
-  destruct (readable_share_dec sh1), (readable_share_dec sh2);
-  try (constructor; auto).
-  contradiction (join_unreadable_shares H n n0).
-*
-  constructor.
+  intros; rewrite -mapsto_split_no; try done.
+  rewrite dfrac_op_own.
+  erewrite share_join_op; try done; intros ->; contradiction bot_unreadable.
 Qed.
 
-Definition resource_share_split (p q r: address -> pred rmap): Prop :=
-  exists p' q' r' p_sh q_sh r_sh,
-    is_resource_pred p p' /\
-    is_resource_pred q q' /\
-    is_resource_pred r r' /\
-    join q_sh r_sh p_sh /\
-    (forall res l n, p' res l n ->
-      resource_share res = Some p_sh /\
-      q' (slice_resource q_sh res) l n /\
-      r' (slice_resource r_sh res) l n) /\
-    (forall p_res q_res r_res l n,
-      join q_res r_res p_res ->
-      q' q_res l n ->
-      r' r_res l n ->
-      p' p_res l n).
-
-(* We should use this lemma to prove all share_join lemmas, also all splittable lemmas. *)
-Lemma allp_jam_share_split: forall (P: address -> Prop) (p q r: address -> pred rmap)
-  (P_DEC: forall l, {P l} + {~ P l}),
-  resource_share_split p q r ->
-  allp (jam P_DEC p noat) =
-  (allp (jam P_DEC q noat)) * (allp (jam P_DEC r noat)).
+Lemma mapsto_mapsto_no_share_join: forall sh1 sh2 sh l r (nsh : ~readable_share sh2), sepalg.join sh1 sh2 sh ->
+  readable_share sh1 ->
+  l ↦{#sh1} r ∗ mapsto_no l sh2 ⊣⊢ l ↦{#sh} r.
 Proof.
-  intros.
-  destruct H as [p' [q' [r' [p_sh [q_sh [r_sh [? [? [? [? [? ?]]]]]]]]]]].
-  apply pred_ext; intros w; simpl; intros.
-  + destruct (make_core_slice_rmap w P P_DEC q_sh) as [w1 [? ?]].
-    {
-      intros; specialize (H5 l).
-      rewrite if_false in H5 by auto.
-      auto.
-    }
-    destruct (make_slice_rmap w P P_DEC r_sh) as [w2 [? ?]].
-    {
-      intros; specialize (H5 l).
-      rewrite if_false in H5 by auto.
-      auto.
-    }
-    exists w1, w2.
-    split3.
-    - apply resource_at_join2; try congruence.
-      intro l.
-      destruct H7, H9; rewrite H7, H9; clear H7 H9.
-      specialize (H5 l); destruct (P_DEC l).
-      * eapply slice_resource_share_join; eauto.
-        rewrite H in H5.
-        apply H3 in H5.
-        tauto.
-      * apply identity_unit' in H5.
-        exact H5.
-      * destruct H7 as [? ->], H9 as [? ->].
-        apply core_unit.
-    - destruct H7 as [H7 _].
-      intros l.
-      rewrite H0, H7, H6.
-      specialize (H5 l).
-      rewrite H in H5.
-      if_tac.
-      * apply H3 in H5.
-        tauto.
-      * auto.
-    - destruct H9 as [H9 _].
-      intros l.
-      rewrite H1, H9, H8.
-      specialize (H5 l).
-      rewrite H in H5.
-      if_tac.
-      * apply H3 in H5.
-        tauto.
-      * auto.
-  + destruct H5 as [y [z [? [? ?]]]].
-    specialize (H6 b); specialize (H7 b).
-    if_tac.
-    - rewrite H; rewrite H0 in H6; rewrite H1 in H7.
-      destruct (join_level _ _ _ H5).
-      rewrite H9 in H6; rewrite H10 in H7.
-      eapply H4; eauto.
-      apply resource_at_join; auto.
-    - apply resource_at_join with (loc := b) in H5.
-      apply H6 in H5; rewrite <- H5; auto.
+  intros; rewrite -(mapsto_no_mapsto_share_join _ _ sh); [| | apply sepalg.join_comm, H | ..]; try done.
+  by rewrite comm.
 Qed.
 
-Lemma address_mapsto_share_join:
- forall (sh1 sh2 sh : share) ch v a,
-   join sh1 sh2 sh ->
-   readable_share sh1 -> readable_share sh2 ->
-   address_mapsto ch v sh1 a * address_mapsto ch v sh2 a
-    = address_mapsto ch v sh a.
+Lemma mapsto_no_share_join: forall sh1 sh2 sh l (nsh1 : ~readable_share sh1) (nsh2 : ~readable_share sh2), sepalg.join sh1 sh2 sh ->
+  mapsto_no l sh1 ∗ mapsto_no l sh2 ⊣⊢ mapsto_no l sh.
 Proof.
-  intros ? ? ? ? ? ? H rsh1 rsh2.
-(*  rename H1 into NON_UNIT1, H2 into NON_UNIT2.
-  assert (NON_UNIT: nonunit sh) by (eapply nonunit_join; eauto; auto with typeclass_instances).
-*)
-  symmetry.
-  unfold address_mapsto.
-  transitivity
-   (EX  bl : list memval,
-    !!(length bl = size_chunk_nat ch /\
-       decode_val ch bl = v /\ (align_chunk ch | snd a)) &&
-   ((allp
-      (jam (adr_range_dec a (size_chunk ch))
-         (fun loc : address =>
-          yesat NoneP (VAL (nth (Z.to_nat (snd loc - snd a)) bl Undef)) sh1
-            loc) noat)) *
-    (allp
-      (jam (adr_range_dec a (size_chunk ch))
-         (fun loc : address =>
-          yesat NoneP (VAL (nth (Z.to_nat (snd loc - snd a)) bl Undef)) sh2
-            loc) noat)))).
-  + pose proof log_normalize.exp_congr (pred rmap) _ (list memval).
-    simpl in H0.
-    apply H0; clear H0.
-    intros b.
-    f_equal.
-    apply allp_jam_share_split.
-    do 3 eexists.
-    exists sh, sh1, sh2.
-    split; [| split; [| split; [| split; [| split]]]].
-    - apply is_resource_pred_YES_VAL'.
-    - apply is_resource_pred_YES_VAL'.
-    - apply is_resource_pred_YES_VAL'.
-    - auto.
-    - simpl; intros.
-      destruct H0.
-      split; [subst; auto |].
-      split.
-      * exists rsh1.
-        subst; simpl.
-        destruct (readable_share_dec sh1); [| contradiction].
-        f_equal.
-        auto with extensionality.
-      * exists rsh2.
-        subst; simpl.
-        destruct (readable_share_dec sh); [| contradiction].
-        destruct (readable_share_dec sh2); [| contradiction].
-        f_equal.
-        auto with extensionality.
-    - simpl; intros.
-      destruct H1,H2. repeat proof_irr.
-      exists (join_readable1 H rsh1).
-      subst.
-      inv H0.
-      apply YES_ext.
-      eapply join_eq; eauto.
-  + apply pred_ext.
-    - apply exp_left; intro bl.
-      apply prop_andp_left; intro.
-      rewrite exp_sepcon1.
-      apply (exp_right bl).
-      rewrite exp_sepcon2.
-      apply (exp_right bl).
-      rewrite sepcon_andp_prop1.
-      apply andp_right; [intros w _; simpl; auto |].
-      rewrite sepcon_andp_prop.
-      apply andp_right; [intros w _; simpl; auto |].
-      auto.
-    - rewrite exp_sepcon1.
-      apply exp_left; intro bl1.
-      rewrite exp_sepcon2.
-      apply exp_left; intro bl2.
-      rewrite sepcon_andp_prop1.
-      apply prop_andp_left; intro.
-      rewrite sepcon_andp_prop.
-      apply prop_andp_left; intro.
-      apply (exp_right bl1).
-      apply andp_right; [intros w _; simpl; auto |].
-      intros w ?.
-      destruct H2 as [w1 [w2 [? [? ?]]]].
-      exists w1, w2.
-      split; [| split]; auto.
-      intro l; specialize (H3 l); specialize (H4 l).
-      simpl in H3, H4 |- *.
-      if_tac; auto.
-      destruct H3, H4. exists rsh2.
-      apply resource_at_join with (loc := l) in H2.
-      rewrite H3, H4 in H2; inv H2.
-      rewrite H11, H4. apply YES_ext. auto.
+  intros; rewrite -mapsto_no_split // share_op_is_join //.
 Qed.
 
 Lemma nonlock_permission_bytes_address_mapsto_join:
  forall (sh1 sh2 sh : share) ch v a,
-   join sh1 sh2 sh ->
+   sepalg.join sh1 sh2 sh ->
    readable_share sh2 ->
    nonlock_permission_bytes sh1 a (Memdata.size_chunk ch)
-     * address_mapsto ch v sh2 a
-    = address_mapsto ch v sh a.
+     ∗ address_mapsto ch v sh2 a
+    ⊣⊢ address_mapsto ch v sh a.
 Proof.
-intros. rename H0 into rsh2.
-unfold nonlock_permission_bytes, address_mapsto.
-rewrite exp_sepcon2.
-f_equal. extensionality bl.
-rewrite sepcon_andp_prop.
-f_equal.
-apply pred_ext.
-*
- intros z [x [y [? [? ?]]]].
- intro b; specialize (H1 b); specialize (H2 b).
- pose proof (resource_at_join _ _ _ b H0).
- hnf in H1,H2|-*.
- if_tac.
- +
-  destruct H2 as [p ?].
-  hnf in H2. rewrite H2 in *. clear H2.
-  destruct H1 as [H1 H1'].
-  hnf in H1, H1'. unfold resource_share in H1.
-  assert (p8 := join_readable2 H p).
-  exists p8.
-  destruct (x @ b); inv H1.
-  -
-    inv H3.
-    pose proof (join_eq H RJ); subst sh4. clear RJ.
-    hnf. rewrite <- H8; clear H8.
-    f_equal. apply proof_irr.
-  -
-   clear H1'.  inv H3.
-   hnf. rewrite <- H10. clear H10. simpl.
-    pose proof (join_eq H RJ); subst sh4. clear RJ.
-   f_equal. apply proof_irr.
- +
-   do 3 red in H1,H2|-*.
-   apply join_unit1_e in H3; auto.
-   rewrite <- H3; auto.
-*
-  assert (rsh := join_readable2 H rsh2).
-  intros w ?.
-  destruct (make_core_slice_rmap w _ (adr_range_dec a (size_chunk ch)) sh1)
-   as [w1 [? ?]].
-  intros. specialize (H0 l). simpl in H0. rewrite if_false in H0; auto.
-  destruct (make_slice_rmap w _ (adr_range_dec a (size_chunk ch)) sh2)
-   as [w2 [? ?]].
-  intros. specialize (H0 l). simpl in H0. rewrite if_false in H0; auto.
-  exists w1, w2.
-  destruct H2 as [H2 Hg1], H4 as [H4 Hg2].
-  split3.
- +
-   eapply resource_at_join2; try lia.
-  intro . rewrite H2,H4. clear dependent w1. clear dependent w2.
-  specialize (H0 loc). hnf in H0.
-  if_tac in H0. destruct H0 as [rsh' H0]. proof_irr. rewrite H0.
-  unfold slice_resource.
-  destruct (readable_share_dec sh2); [ | contradiction]. proof_irr.
-  destruct (readable_share_dec sh1).
-  constructor; auto.
-  constructor; auto.
-  do 3 red in H0.
-  apply identity_unit' in H0. apply H0.
-  rewrite Hg1, Hg2; apply core_unit.
- +
-   intro loc; hnf. simpl. rewrite H2.
-  clear dependent w1. clear dependent w2.
-  specialize (H0 loc). hnf in H0.
-  if_tac in H0.
-  -
-   destruct H0. proof_irr. rewrite H0.
-   unfold slice_resource.
-   destruct (readable_share_dec sh1).
-   simpl. split; auto.
-   split; simpl; auto.
-  -
-   apply H0.
- + intro loc; hnf. simpl. rewrite H4.  simpl.
-  clear dependent w1. clear dependent w2.
-  specialize (H0 loc). hnf in H0.
-  if_tac in H0.
-  -
-   exists rsh2.
-   destruct H0 as [p0 H0]. proof_irr. simpl in H0.
-   rewrite H0. clear H0. simpl.
-   destruct (readable_share_dec sh2); [ | contradiction]. proof_irr.
-   reflexivity.
- - apply H0.
+  intros.
+  rewrite /nonlock_permission_bytes /address_mapsto.
+  rewrite bi.sep_exist_l.
+  apply bi.exist_proper; intros bl.
+  rewrite !(big_sepL_seq bl).
+  iSplit.
+  - iIntros "[H1 [%Hbl H2]]"; iFrame "%".
+    destruct Hbl as [-> _].
+    rewrite /size_chunk_nat.
+    iPoseProof (big_sepL_sep_2 with "H1 H2") as "H".
+    iApply (big_sepL_mono with "H").
+    intros; iIntros "[H1 H2]".
+    destruct (readable_share_dec _).
+    + iDestruct "H1" as (??) "H1".
+      iDestruct (mapsto_combine with "H1 H2") as "[? ->]".
+      rewrite dfrac_op_own; erewrite share_join_op; done.
+    + iDestruct (mapsto_no_mapsto_combine with "H1 H2") as "?".
+      rewrite dfrac_op_own; erewrite share_join_op; done.
+  - iIntros "[%Hbl H]"; iFrame "%".
+    destruct Hbl as [-> _].
+    rewrite /size_chunk_nat.
+    rewrite -big_sepL_sep.
+    iApply (big_sepL_mono with "H").
+    intros; iIntros "H".
+    destruct (readable_share_dec _).
+    + rewrite -mapsto_share_join; try done.
+      iDestruct "H" as "[? $]".
+      iExists _; iSplit; last done; done.
+    + rewrite -mapsto_no_mapsto_share_join //.
+Qed.
+
+Lemma nonlock_permission_bytes_address_mapsto_joins:
+ forall (sh1 sh2 : share) ch v a,
+   nonlock_permission_bytes sh1 a (Memdata.size_chunk ch)
+     ∗ address_mapsto ch v sh2 a
+    ⊢ ⌜sepalg.joins sh1 sh2⌝.
+Proof.
+  intros.
+  rewrite /nonlock_permission_bytes /address_mapsto.
+  iIntros "(H1 & (%bl2 & (% & %) & H2))".
+  destruct (size_chunk_nat_pos ch) as (? & Hch).
+  destruct bl2; simpl in *; try lia.
+  rewrite /size_chunk_nat in Hch; rewrite Hch -cons_seq /=.
+  iDestruct "H1" as "(H1 & _)"; iDestruct "H2" as "(H2 & _)".
+  if_tac.
+  - iDestruct "H1" as (? _) "H1".
+    iDestruct (mapsto_valid_2 with "H1 H2") as %(Hsh & _); iPureIntro.
+    apply share_valid2_joins in Hsh as (? & ? & ? & [=] & [=] & ? & Hsh); subst.
+    rewrite share_op_is_join in Hsh; eexists; eauto.
+  - iDestruct (mapsto_no_mapsto_valid_2 with "H1 H2") as %(Hsh & _); iPureIntro.
+    apply share_valid2_joins in Hsh as (? & ? & ? & [=] & [=] & ? & Hsh); subst.
+    rewrite share_op_is_join in Hsh; eexists; eauto.
 Qed.
 
+
 Lemma VALspec_range_share_join:
  forall sh1 sh2 sh n p,
   readable_share sh1 ->
   readable_share sh2 ->
-  join sh1 sh2 sh ->
-  VALspec_range n sh1 p *
-  VALspec_range n sh2 p =
+  sepalg.join sh1 sh2 sh ->
+  VALspec_range n sh1 p ∗
+  VALspec_range n sh2 p ⊣⊢
   VALspec_range n sh p.
 Proof.
   intros.
-  symmetry.
-  apply allp_jam_share_split.
-  do 3 eexists.
-  exists sh, sh1, sh2.
-  split; [| split; [| split; [| split; [| split]]]].
-  + apply is_resource_pred_YES_VAL.
-  + apply is_resource_pred_YES_VAL.
-  + apply is_resource_pred_YES_VAL.
-  + auto.
-  + simpl; intros.
-    destruct H2 as [x [rsh ?]].
-    split; [subst; simpl; auto |].
-    split; [exists x, H | exists x, H0].
-    - subst. simpl.
-      destruct (readable_share_dec sh1); [ | contradiction].
-      f_equal. apply proof_irr.
-    - subst. simpl.
-      destruct (readable_share_dec sh2); [ | contradiction].
-      f_equal. apply proof_irr.
-  + simpl; intros.
-    destruct H3 as [? [? ?]], H4 as [? [? ?]].
-    exists x. exists (join_readable1 H1 H).
-    subst.
-    inv H2. apply YES_ext. eapply join_eq; eauto.
+  rewrite /VALspec_range /VALspec.
+  rewrite -big_sepL_sep.
+  apply big_sepL_proper; intros.
+  iSplit.
+  - iIntros "[H1 H2]"; iDestruct "H1" as (v1) "H1"; iDestruct "H2" as (v) "H2".
+    iDestruct (mapsto_value_cohere with "[$H1 $H2]") as %->.
+    iExists v; rewrite -(mapsto_share_join _ _ sh); try done; iFrame.
+  - iIntros "H"; iDestruct "H" as (v) "H".
+    rewrite bi.sep_exist_r; iExists v.
+    rewrite bi.sep_exist_l; iExists v.
+    by rewrite mapsto_share_join.
 Qed.
 
 Lemma nonlock_permission_bytes_share_join:
  forall sh1 sh2 sh a n,
-  join sh1 sh2 sh ->
-  nonlock_permission_bytes sh1 a n *
-  nonlock_permission_bytes sh2 a n =
+  sepalg.join sh1 sh2 sh ->
+  nonlock_permission_bytes sh1 a n ∗
+  nonlock_permission_bytes sh2 a n ⊣⊢
   nonlock_permission_bytes sh a n.
 Proof.
   intros.
-  symmetry.
-  apply allp_jam_share_split.
-  do 3 eexists.
-  exists sh, sh1, sh2.
-  split; [| split; [| split; [| split; [| split]]]].
-  + apply is_resource_pred_nonlock_shareat.
-  + apply is_resource_pred_nonlock_shareat.
-  + apply is_resource_pred_nonlock_shareat.
-  + auto.
-  + simpl; intros.
-    destruct H0.
-    split; [auto |].
-    split; split.
-    - eapply slice_resource_resource_share; [eauto | eexists; eauto ].
-    - eapply slice_resource_nonlock; [eauto | eexists; eauto | auto].
-    - eapply slice_resource_resource_share; [eauto | eexists; eapply join_comm; eauto].
-    - eapply slice_resource_nonlock; [eauto | eexists; eapply join_comm; eauto | auto].
-  + simpl; intros.
-    destruct H1, H2.
-    split.
-    - eapply (resource_share_join q_res r_res); eauto.
-    - eapply (nonlock_join q_res r_res); eauto.
+  rewrite /nonlock_permission_bytes -big_sepL_sep.
+  apply big_sepL_proper; intros.
+  pose proof (readable_share_join H).
+  repeat destruct (readable_share_dec _); try solve [match goal with H : ~readable_share sh |- _ => contradiction H; auto end];
+    try solve [exfalso; eapply join_unreadable_shares; eauto].
+  - rewrite bi.sep_exist_r; apply bi.exist_proper; intros ?.
+    rewrite bi.sep_exist_l -(mapsto_share_join _ _ sh); try done.
+    iSplit; [iIntros "(% & [(% & ?) (% & ?)])" | iIntros "(% & $ & ?)"].
+    + iDestruct (mapsto_value_cohere with "[$]") as %->; by iFrame.
+    + iExists _; by iFrame.
+  - rewrite bi.sep_exist_r; apply bi.exist_proper; intros ?.
+    rewrite -bi.persistent_and_sep_assoc; apply bi.and_proper; first done.
+    by apply mapsto_mapsto_no_share_join.
+  - rewrite bi.sep_exist_l; apply bi.exist_proper; intros ?.
+    rewrite comm -bi.persistent_and_sep_assoc; apply bi.and_proper; first done.
+    rewrite comm; by apply mapsto_no_mapsto_share_join.
+  - by apply mapsto_no_share_join.
+Qed.
+
+Lemma nonlock_permission_bytes_share_joins:
+ forall sh1 sh2 a n, (n > 0)%Z ->
+  nonlock_permission_bytes sh1 a n ∗
+  nonlock_permission_bytes sh2 a n ⊢
+  ⌜sepalg.joins sh1 sh2⌝.
+Proof.
+  intros.
+  rewrite /nonlock_permission_bytes.
+  iIntros "(H1 & H2)".
+  destruct (Z.to_nat n) eqn: Hn; first lia.
+  rewrite -cons_seq /=.
+  iDestruct "H1" as "(H1 & _)"; iDestruct "H2" as "(H2 & _)".
+  if_tac.
+  - iDestruct "H1" as (? _) "H1".
+    if_tac.
+    + iDestruct "H2" as (? _) "H2".
+      iDestruct (mapsto_valid_2 with "H1 H2") as %(Hsh & _); iPureIntro.
+      apply share_valid2_joins in Hsh as (? & ? & ? & [=] & [=] & ? & Hsh); subst.
+      rewrite share_op_is_join in Hsh; eexists; eauto.
+    + iDestruct (mapsto_no_mapsto_valid_2 with "H2 H1") as %(Hsh & _); iPureIntro.
+      apply share_valid2_joins in Hsh as (? & ? & ? & [=] & [=] & ? & Hsh); subst.
+      rewrite share_op_is_join in Hsh; eexists; apply sepalg.join_comm; eauto.
+  - if_tac.
+    + iDestruct "H2" as (? _) "H2".
+      iDestruct (mapsto_no_mapsto_valid_2 with "H1 H2") as %(Hsh & _); iPureIntro.
+      apply share_valid2_joins in Hsh as (? & ? & ? & [=] & [=] & ? & Hsh); subst.
+      rewrite share_op_is_join in Hsh; eexists; eauto.
+    + iDestruct (mapsto_no_valid_2 with "H1 H2") as %(Hsh & _); iPureIntro.
+      apply share_valid2_joins in Hsh as (? & ? & ? & [=] & [=] & ? & Hsh); subst.
+      rewrite share_op_is_join in Hsh; eexists; eauto.
 Qed.
 
 Lemma nonlock_permission_bytes_VALspec_range_join:
- forall sh1 sh2 (rsh2: readable_share sh2) sh p n,
-  join sh1 sh2 sh ->
-  nonlock_permission_bytes sh1 p n *
-  VALspec_range n sh2 p =
+ forall sh1 sh2 sh p n,
+  sepalg.join sh1 sh2 sh ->
+  readable_share sh2 ->
+  nonlock_permission_bytes sh1 p n ∗
+  VALspec_range n sh2 p ⊣⊢
   VALspec_range n sh p.
 Proof.
   intros.
-  symmetry.
-  apply allp_jam_share_split.
-  do 3 eexists.
-  exists sh, sh1, sh2.
-  split; [| split; [| split; [| split; [| split]]]].
-  + apply is_resource_pred_YES_VAL.
-  + apply is_resource_pred_nonlock_shareat.
-  + apply is_resource_pred_YES_VAL.
-  + auto.
-  + simpl; intros.
-    destruct H0 as [? [? ?]]; subst; split; [| split; [split |]].
-    - simpl; auto.
-    - simpl.
-      destruct (readable_share_dec sh1); reflexivity.
-    - simpl.
-      destruct (readable_share_dec sh1); simpl; auto.
-    - simpl.
-      exists x, rsh2.
-      destruct (readable_share_dec sh2); [ | contradiction].
-      apply YES_ext. auto.
-  + simpl; intros.
-    destruct H2 as [? [? ?]].
-    subst. proof_irr.
-    exists x, (join_readable2 H rsh2).
-    destruct H1.
-    destruct q_res; simpl in H1.
-    - inversion H0; subst. inv H1.
-      apply YES_ext.
-      eapply join_eq; eauto.
-    - inv H1. inv H0. apply YES_ext. eapply join_eq; eauto.
-    - inv H1.
+  rewrite /nonlock_permission_bytes /VALspec_range.
+  rewrite -big_sepL_sep.
+  apply big_sepL_proper; intros.
+  rewrite /VALspec bi.sep_exist_l; apply bi.exist_proper; intros v.
+  if_tac.
+  - rewrite -(mapsto_share_join _ _ sh) //.
+    iSplit.
+    + iIntros "[(% & % & H1) H2]".
+      iDestruct (mapsto_value_cohere with "[$H1 $H2]") as %->; iFrame.
+    + iIntros "[? $]".
+      iExists _; iFrame.
+  - rewrite mapsto_no_mapsto_share_join //.
 Qed.
 
-Lemma is_resource_pred_YES_LK lock_size (l: address) (R: pred rmap) sh:
+(*Lemma is_resource_pred_YES_LK lock_size (l: address) (R: pred rmap) sh:
   is_resource_pred
     (fun l' => yesat (SomeP rmaps.Mpred (fun _ => R)) (LK lock_size (snd l' - snd l)) sh l')
     (fun r (l': address) n => exists p, r = YES sh p (LK lock_size (snd l' - snd l))
         (SomeP rmaps.Mpred (fun _ => approx n R))).
-Proof. hnf; intros. reflexivity. Qed.
-
-Lemma LKspec_share_join lock_size:
- forall sh1 sh2 (rsh1: readable_share sh1) (rsh2: readable_share sh2) sh R p,
-  join sh1 sh2 sh ->
-  LKspec lock_size R sh1 p *
-  LKspec lock_size R sh2 p =
+Proof. hnf; intros. reflexivity. Qed.*)
+
+(*Lemma LKspec_share_join lock_size:
+ forall sh1 sh2 sh R p,
+  sepalg.join sh1 sh2 sh ->
+  readable_share sh1 -> readable_share sh2 ->
+  LKspec lock_size R sh1 p ∗
+  LKspec lock_size R sh2 p ⊣⊢
   LKspec lock_size R sh p.
 Proof.
   intros.
-  symmetry.
-  unfold LKspec.
-  apply allp_jam_share_split.
-  do 3 eexists.
-  exists sh, sh1, sh2.
-  split; [| split; [| split; [| split; [| split]]]].
-  + apply is_resource_pred_YES_LK.
-  + apply is_resource_pred_YES_LK.
-  + apply is_resource_pred_YES_LK.
-  + auto.
-  + simpl; intros.
-    destruct (eq_dec p l); subst; destruct H0; split; try solve [subst; simpl; auto];
-    split.
-    - exists rsh1. subst. simpl.
-      destruct (readable_share_dec sh1); [ | contradiction].
-      apply YES_ext; auto.
-    - exists rsh2. subst. simpl.
-      destruct (readable_share_dec sh2); [ | contradiction].
-      apply YES_ext; auto.
-    - exists rsh1. subst. simpl.
-      destruct (readable_share_dec sh1); [ | contradiction].
-      apply YES_ext; auto.
-    - exists rsh2. subst. simpl.
-      destruct (readable_share_dec sh2); [ | contradiction].
-      apply YES_ext; auto.
-  + simpl; intros.
-    destruct (eq_dec p l); subst; destruct H1, H2. repeat proof_irr.
-    - exists (join_readable1 H rsh1). subst. inv H0. apply YES_ext.
-      eapply join_eq; eauto.
-    - exists (join_readable1 H rsh1). subst. inv H0. apply YES_ext.
-      eapply join_eq; eauto.
-Qed.
+  rewrite /LKspec -big_sepL_sep.
+  apply big_sepL_proper; intros.
+  rewrite assoc -(bi.sep_assoc (_ ↦{_} _)) (bi.sep_comm (inv _ _)) assoc mapsto_share_join //.
+  rewrite -assoc -bi.persistent_sep_dup //.
+Qed.*)
+
+End heap.
 
 (* It's often useful to split Tsh in half. *)
 Definition gsh1 := fst (slice.cleave Tsh).
@@ -1366,7 +448,7 @@ Proof.
   - destruct (split_readable_share _ H) as (sh1 & sh2 & H1 & ? & ?).
     destruct (IHn _ H1) as (sh1' & shs & ? & ? & ? & ?).
     exists sh1', (shs ++ sh2 :: nil).
-    rewrite Nat2Z.inj_succ, Zlength_app, Zlength_cons, Zlength_nil; split; [lia|].
+    rewrite -> Nat2Z.inj_succ, Zlength_app, Zlength_cons, Zlength_nil; split; [lia|].
     rewrite Forall_app; repeat split; auto.
     eapply sepalg_list.list_join_app; eauto.
     rewrite <- sepalg_list.list_join_1; auto.
diff --git a/veric/splice.v b/veric/splice.v
deleted file mode 100644
index 4d631e0159..0000000000
--- a/veric/splice.v
+++ /dev/null
@@ -1,374 +0,0 @@
-Require Import VST.msl.msl_standard.
-Require Import VST.msl.Coqlib2.
-Require Import VST.veric.shares.
-
-Section UNPROVABLE.
-
-Variable wishes_eq_horses : False.
-
-Lemma unrel_glb:
- forall a b,
-    Share.unrel a b = Share.unrel a (Share.glb a b).
-contradiction wishes_eq_horses.
-Qed.
-
-Lemma share_rel_unrel':
-  forall r sh,
-    Share.rel r (Share.unrel r sh) = Share.glb r sh.
-Proof.
-contradiction wishes_eq_horses.
-Qed.
-
-Lemma share_sub_Lsh:
-forall sh, identity (Share.unrel Share.Rsh sh) -> join_sub sh Share.Lsh.
-Proof.
- intros.
- rewrite (Share.decompose_Rsh sh) in H.
- remember (decompose sh).
- symmetry in Heqp. destruct p as [sh1 sh2].
- simpl in H.
- apply identity_share_bot in H. subst.
- generalize (top_correct' sh1);intro.
- destruct H.
- exists (Share.recompose (x, Share.bot)).
- rewrite Share.Lsh_recompose.
- assert (sh = Share.recompose (sh1, Share.bot)).
-  rewrite <- Heqp. rewrite Share.recompose_decompose. trivial.
- rewrite H0.
- eapply Share.decompose_join.
- rewrite Share.decompose_recompose. f_equal.
- rewrite Share.decompose_recompose. f_equal.
- rewrite Share.decompose_recompose. f_equal.
- split. trivial.
- split. apply Share.glb_bot. apply Share.lub_bot.
-Qed.
-
-Lemma join_splice2_aux:
-forall a1 a2 a3 b1 b2 b3,
-Share.lub (Share.rel Share.Lsh (Share.lub a1 a2)) (Share.rel Share.Rsh (Share.lub b1 b2))
-= Share.lub (Share.rel Share.Lsh a3) (Share.rel Share.Rsh b3) ->
-Share.lub a1 a2 = a3 /\ Share.lub b1 b2 = b3.
-Proof with try tauto.
- intros. rewrite Share.lub_rel_recompose in H.
- generalize (Share.decompose_recompose (Share.lub a1 a2, Share.lub b1 b2));intro.
- rewrite H in H0.
- rewrite Share.lub_rel_recompose in H0.
- rewrite Share.decompose_recompose in H0.
- split;congruence.
-Qed.
-
-Lemma share_rel_unrel:
-  forall r sh,
-    join_sub sh r ->
-    Share.rel r (Share.unrel r sh) = sh.
-Proof.
-intros.
-rewrite share_rel_unrel'.
-destruct H as [a [H H0]].
-subst r.
-rewrite Share.glb_commute.
-rewrite Share.distrib1.
-rewrite H.
-rewrite Share.lub_bot.
-apply Share.glb_idem.
-Qed.
-
-Lemma glb_rel_Lsh_Rsh:
- forall a b, Share.glb (Share.rel Share.Lsh a) (Share.rel Share.Rsh b) = Share.bot.
-Proof.
-intros.
-assert (H := rel_leq Share.Lsh a).
-assert (H0 := rel_leq Share.Rsh b).
-apply leq_join_sub in H.
-apply leq_join_sub in H0.
-forget (Share.rel Share.Lsh a) as aL.
-forget (Share.rel Share.Rsh b) as bR.
-apply Share.ord_antisym; [ | apply Share.bot_correct].
-rewrite <- glb_Lsh_Rsh.
-forget Share.Lsh as L.
-forget Share.Rsh as R.
-apply glb_less_both; auto.
-Qed.
-
-Lemma glb_Rsh_rel_Lsh_sh:
- forall sh,
-  Share.glb Share.Rsh (Share.rel Share.Lsh sh) = Share.bot.
-Proof.
-intros.
-destruct (Share.split Share.top) eqn:?.
-unfold Share.Rsh, Share.Lsh. rewrite Heqp; simpl.
-rewrite Share.glb_commute.
-destruct (rel_join t t t0 _ (split_join _ _ _ Heqp)).
-clear - H Heqp.
-pose proof (rel_leq t t0).
-rewrite <- leq_join_sub in H0.
-rewrite Share.ord_spec1 in H0.
-rewrite H0 in H.
-rewrite <- Share.glb_assoc in H.
-rewrite <- Share.rel_preserves_glb in H.
-pose proof (rel_leq t (Share.glb t t0)).
-apply leq_join_sub in H1.
-apply Share.ord_spec1 in H1. rewrite <- H1 in H.
-clear H1.
-pose proof bot_identity. rewrite <- H in H1.
-apply (rel_nontrivial) in H1.
-destruct H1.
-apply split_nontrivial' in Heqp; auto.
-apply identity_share_bot in Heqp.
-apply Share.nontrivial in Heqp; contradiction.
-clear H.
-apply identity_share_bot in H1.
-clear - H1.
-pose proof (rel_leq t sh).
-forget (Share.rel t sh) as b.
-destruct H as [a [? ?]].
-subst t.
-rewrite Share.glb_commute in H1; rewrite Share.distrib1 in H1.
-rewrite Share.glb_commute in H1.
-pose proof (Share.lub_upper1 (Share.glb b t0) (Share.glb t0 a)).
-rewrite H1 in H0.
-apply Share.ord_antisym; auto.
-apply Share.bot_correct.
-Qed.
-
-Lemma right_nonempty_readable:
-  forall rsh sh, sepalg.nonidentity sh <->
-     readable_share (Share.splice rsh sh).
-Proof.
-intros.
-unfold readable_share, Share.splice.
-unfold nonempty_share,nonidentity.
-assert (identity sh <-> identity (Share.glb Share.Rsh (Share.lub (Share.rel Share.Lsh rsh) (Share.rel Share.Rsh sh))));
-  [ | intuition].
-split; intro.
-*
-apply identity_share_bot in H. subst.
-rewrite Share.rel_bot1.
-rewrite Share.lub_bot.
-rewrite glb_Rsh_rel_Lsh_sh.
-apply bot_identity.
-*
-rewrite Share.distrib1 in H.
-rewrite glb_Rsh_rel_Lsh_sh in H.
-rewrite Share.lub_commute, Share.lub_bot in H.
-assert (identity (Share.glb (Share.rel Share.Rsh Share.top) (Share.rel Share.Rsh sh)))
-  by (rewrite Share.rel_top1; auto).
-clear H.
-rewrite <- Share.rel_preserves_glb in H0.
-rewrite Share.glb_commute, Share.glb_top in H0.
-apply rel_nontrivial in H0.
-destruct H0; auto.
-unfold Share.Rsh in H.
-destruct (Share.split Share.top) eqn:?; simpl in *.
-apply split_nontrivial' in Heqp; auto.
-apply top_share_nonidentity in Heqp.
-contradiction.
-Qed.
-
-Lemma writable_share_right: forall sh, writable_share sh -> Share.unrel Share.Rsh sh = Share.top.
-Proof.
- intros.
- apply Share.contains_Rsh_e.
- apply H.
-Qed.
-
-Lemma unrel_bot:
- forall sh, nonidentity sh -> Share.unrel sh Share.bot = Share.bot.
-Proof.
-intros.
-rewrite <- (Share.rel_bot1 sh) at 1.
-rewrite Share.unrel_rel; auto.
-Qed.
-
-Lemma join_splice2_aux1:
-  forall a1 a2 b1 b2,
-  Share.lub (Share.rel Share.Lsh (Share.glb a1 a2)) (Share.rel Share.Rsh (Share.glb b1 b2)) = Share.bot ->
-  Share.glb a1 a2 = Share.bot /\ Share.glb b1 b2 = Share.bot.
-Proof. intros.
-  rewrite !Share.rel_preserves_glb in H.
-  apply lub_bot_e in H; destruct H.
-  rewrite <- Share.rel_preserves_glb in H, H0.
-  pose proof (rel_nontrivial Share.Lsh (Share.glb a1 a2)).
-  rewrite H in H1. specialize (H1 bot_identity). clear H.
-  pose proof (rel_nontrivial Share.Rsh (Share.glb b1 b2)).
-  rewrite H0 in H. specialize (H bot_identity). clear H0.
-  destruct H1. contradiction (Lsh_nonidentity H0).
-  destruct H. contradiction (Rsh_nonidentity H).
-  apply identity_share_bot in H.
-  apply identity_share_bot in H0.
-  auto.
-Qed.
-
-Lemma join_splice:
-  forall a1 a2 a3 b1 b2 b3,
- sepalg.join a1 a2 a3 ->
- sepalg.join b1 b2 b3 ->
- sepalg.join (Share.splice a1 b1)  (Share.splice a2 b2)  (Share.splice a3 b3).
-Proof.
-intros.
-unfold Share.splice.
-destruct H, H0.
-split.
-*
-rewrite Share.distrib1.
-do 2 rewrite (Share.glb_commute (Share.lub _ _)).
-rewrite Share.distrib1.
-rewrite Share.distrib1.
-rewrite !(Share.glb_commute (Share.rel _ a2)).
-rewrite !(Share.glb_commute (Share.rel _ b2)).
-rewrite <- !Share.rel_preserves_glb.
-rewrite H,H0.
-rewrite !Share.rel_bot1.
-rewrite (Share.lub_commute Share.bot).
-rewrite !Share.lub_bot.
-rewrite Share.glb_commute.
-rewrite !glb_rel_Lsh_Rsh.
-apply Share.lub_bot.
-*
-subst a3 b3.
-rewrite !Share.rel_preserves_lub.
-forget (Share.rel Share.Lsh a1) as La1.
-forget (Share.rel Share.Rsh b1) as Rb1.
-forget (Share.rel Share.Lsh a2) as La2.
-forget (Share.rel Share.Rsh b2) as Rb2.
-rewrite !Share.lub_assoc.
-f_equal.
-rewrite Share.lub_commute.
-rewrite !Share.lub_assoc.
-f_equal.
-apply Share.lub_commute.
-Qed.
-
-Lemma splice_bot2:
- forall sh, Share.splice sh Share.bot = Share.rel Share.Lsh sh.
-Proof.
-intros.
-unfold Share.splice.
-rewrite Share.rel_bot1.
-rewrite Share.lub_bot.
-auto.
-Qed.
-
-Lemma splice_unrel_unrel:
-  forall sh,
-   Share.splice (Share.unrel Share.Lsh sh) (Share.unrel Share.Rsh sh) = sh.
-Proof.
-intros.
-unfold Share.splice.
-rewrite !share_rel_unrel'.
-rewrite share_distrib2'.
-rewrite Share.lub_idem.
-rewrite lub_Lsh_Rsh.
-rewrite (Share.glb_commute Share.top).
-rewrite Share.glb_top.
-rewrite <- Share.glb_assoc.
-rewrite (Share.lub_commute sh).
-rewrite share_distrib1'.
-rewrite (Share.glb_commute Share.Rsh).
-rewrite glb_Lsh_Rsh.
-rewrite (Share.lub_commute Share.bot), Share.lub_bot.
-rewrite Share.glb_idem.
-rewrite (Share.glb_commute sh).
-rewrite <- Share.lub_assoc.
-rewrite Share.glb_commute.
-rewrite Share.lub_commute.
-rewrite Share.glb_absorb.
-auto.
-Qed.
-
-Lemma join_splice2:
-  forall a1 a2 a3 b1 b2 b3 : Share.t,
-  join (Share.splice a1 b1) (Share.splice a2 b2) (Share.splice a3 b3) ->
-  join a1 a2 a3 /\ join b1 b2 b3.
-Proof.
-intros.
-unfold Share.splice in H.
-destruct H.
-unfold join, Share.Join_ba.
-assert ((Share.glb a1 a2 = Share.bot /\ Share.glb b1 b2 = Share.bot)
-         /\ (Share.lub a1 a2 = a3 /\ Share.lub b1 b2 = b3)); [ | intuition].
-split.
-*
-clear - H.
-rewrite share_distrib1' in H.
-rewrite (Share.lub_commute (Share.glb _ _)) in H.
-rewrite Share.lub_assoc in H.
-rewrite <- (Share.lub_assoc (Share.glb (Share.rel Share.Lsh _) _)) in H.
-rewrite (Share.lub_commute (Share.lub _ _)) in H.
-rewrite <- Share.lub_assoc in H.
-rewrite <- !Share.rel_preserves_glb in H.
-rewrite (Share.glb_commute (Share.rel Share.Rsh _)) in H.
-rewrite !glb_rel_Lsh_Rsh in H.
-rewrite (Share.lub_commute Share.bot), !Share.lub_bot in H.
-rewrite Share.lub_commute in H.
-apply join_splice2_aux1; auto.
-*
-clear - H0.
-rewrite Share.lub_assoc in H0.
-rewrite (Share.lub_commute (Share.rel Share.Rsh _)) in H0.
-rewrite <- !Share.lub_assoc in H0.
-rewrite <- Share.rel_preserves_lub in H0.
-rewrite Share.lub_assoc in H0.
-rewrite <- Share.rel_preserves_lub in H0.
-rewrite (Share.lub_commute b2) in H0.
-apply join_splice2_aux; auto.
-Qed.
-
-Lemma nonidentity_rel_Lsh: forall t, nonidentity (Share.rel Share.Lsh t) -> nonidentity t.
-Proof.
-  intros.
-  rewrite <- splice_bot2 in H.
-  intro.
-  apply H; clear H.
-  intros ? ? ?.
-  rewrite <- (splice_unrel_unrel a), <- (splice_unrel_unrel b) in H |- *.
-  forget (Share.unrel Share.Lsh a) as sh0.
-  forget (Share.unrel Share.Rsh a) as sh1.
-  forget (Share.unrel Share.Lsh b) as sh2.
-  forget (Share.unrel Share.Rsh b) as sh3.
-  apply join_splice2 in H.
-  destruct H.
-  apply H0 in H.
-  apply bot_identity in H1.
-  subst.
-  auto.
-Qed.
-
-Lemma readable_share_unrel_Rsh: forall sh, readable_share sh <-> nonunit (Share.unrel Share.Rsh sh).
-unfold readable_share in *.
-Proof.
-intros.
-unfold nonempty_share.
-transitivity (nonidentity (Share.unrel Share.Rsh sh)).
-unfold nonidentity.
-split; intro; contradict H.
-apply identity_share_bot in H.
-rewrite <- share_rel_unrel'.
-rewrite H.
-rewrite Share.rel_bot1.
-apply bot_identity.
-rewrite <- share_rel_unrel' in H.
-apply rel_nontrivial in H.
-destruct H; auto.
-exfalso.
-apply identity_share_bot in H.
-unfold Share.Rsh in H.
-destruct (Share.split Share.top) eqn:?. simpl in H. subst.
-apply split_nontrivial' in Heqp.
-apply identity_share_bot in Heqp.
-apply Share.nontrivial; auto.
-right.
-apply bot_identity.
-split.
-apply nonidentity_nonunit.
-intro.
-hnf in H|-*; intro.
-apply identity_share_bot in H0.
-rewrite H0 in H.
-apply (H Share.top).
-red.
-apply bot_join_eq.
-Qed.
-
-End UNPROVABLE.
-
diff --git a/veric/superprecise.v b/veric/superprecise.v
deleted file mode 100644
index 839fe564f8..0000000000
--- a/veric/superprecise.v
+++ /dev/null
@@ -1,547 +0,0 @@
-Require Import Reals.
-Require Export VST.veric.base.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.veric.res_predicates.
-
-(* This file contains lemmas regarding "superprecise",
-and in principle, almost proving that "mapsto" is superprecise.
-
-However, mapsto is not superprecise, because it's not quite true
-that decode_val is injective.  The only reason is the treatment
-of single-precision floating-point NaNs, where the conversion
-from single-prec to double-prec loses one bit of information:
-both quiet 32-bit NaNs and signalling 32-bit NaNs are quietly turned into
-quite 64-bit NaNs.
-
-If CompCert ever changes so that this does not happen, then
-the lemmas in this file might become useful.
-
-*)
-
-Lemma int_of_bytes_uniq:
-  forall i j, length i = length j -> int_of_bytes i = int_of_bytes j -> i = j.
-Proof.
-  induction i; intros.
- destruct j; inv H. auto.
- destruct j; inv H.
- specialize (IHi _ H2).
- simpl in H0.
-do 2 rewrite (Z.add_comm (Byte.unsigned _)) in H0.
- remember (int_of_bytes j * 256 + Byte.unsigned i0) as v eqn:?H.
- symmetry in H0.
- rename i0 into b.
- pose proof (Zmod_unique _ _ _ _ H (Byte.unsigned_range _)).
- pose proof (Zmod_unique _ _ _ _ H0 (Byte.unsigned_range _)).
- assert (Byte.repr (Byte.unsigned a) = Byte.repr (Byte.unsigned b)) by congruence.
- repeat rewrite Byte.repr_unsigned in H4.
- subst b.
- f_equal. clear H1.
- apply IHi.
- lia.
-Qed.
-
-Lemma decode_int_uniq:
-  forall i j, length i = length j -> decode_int i = decode_int j -> i=j.
-Proof.
- unfold decode_int, rev_if_be.
- destruct Archi.big_endian.
- intros. rewrite <- (rev_involutive i). rewrite <- (rev_involutive j).
- f_equal.
- assert (length (rev i) = length (rev j)).
- repeat rewrite rev_length; auto.
- eapply int_of_bytes_uniq; eauto.
- apply int_of_bytes_uniq.
-Qed.
-
-Lemma decode_int_range:
-  forall l N, N = two_p (8 * Z.of_nat (length l)) -> 0 <= decode_int l < N.
-Proof.
-intros; subst; revert l.
-unfold decode_int.
-assert (forall l, 0 <= int_of_bytes l < two_p (8 * Z.of_nat (length l))).
-2: intros; rewrite <- rev_if_be_length; auto.
-induction l.
-simpl; lia.
-simpl int_of_bytes. simpl length.
-rewrite Nat2Z.inj_succ.
-unfold Z.succ.
-rewrite Z.mul_add_distr_l.
-rewrite two_p_is_exp; try lia.
-change (two_p (8*1)) with 256.
-pose proof (Byte.unsigned_range a).
-change Byte.modulus with 256 in H.
-lia.
-Qed.
-
-Lemma sign_ext_injective:
- forall n i j,
-    0 < n < Int.zwordsize ->
-    0 <= i < two_p n ->
-    0 <= j < two_p n ->
-    Int.sign_ext n (Int.repr i) = Int.sign_ext n (Int.repr j) ->
-    i=j.
-Proof.
-intros.
-pose proof (Int.eqmod_sign_ext n (Int.repr i) H).
-pose proof (Int.eqmod_sign_ext n (Int.repr j) H).
-rewrite H2 in H3.
-apply Zbits.eqmod_sym in H3.
-pose proof (Zbits.eqmod_trans _ _ _ _ H3 H4).
-rewrite Int.unsigned_repr in H5.
-2: pose proof (two_p_monotone_strict n Int.zwordsize);
-   change Int.max_unsigned with (two_p Int.zwordsize - 1);
-   lia.
-rewrite Int.unsigned_repr in H5.
-2: pose proof (two_p_monotone_strict n Int.zwordsize);
-   change Int.max_unsigned with (two_p Int.zwordsize - 1);
-   lia.
-apply Zbits.eqmod_small_eq in H5; auto.
-Qed.
-
-
-Lemma zero_ext_injective:
- forall n i j,
-    0 <= n < Int.zwordsize ->
-    0 <= i < two_p n ->
-    0 <= j < two_p n ->
-    Int.zero_ext n (Int.repr i) = Int.zero_ext n (Int.repr j) ->
-    i=j.
-Proof.
-intros.
-pose proof (Int.eqmod_zero_ext n (Int.repr i) H).
-pose proof (Int.eqmod_zero_ext n (Int.repr j) H).
-rewrite H2 in H3.
-apply Zbits.eqmod_sym in H3.
-pose proof (Zbits.eqmod_trans _ _ _ _ H3 H4).
-rewrite Int.unsigned_repr in H5.
-2: pose proof (two_p_monotone_strict n Int.zwordsize);
-   change Int.max_unsigned with (two_p Int.zwordsize - 1);
-   lia.
-rewrite Int.unsigned_repr in H5.
-2: pose proof (two_p_monotone_strict n Int.zwordsize);
-   change Int.max_unsigned with (two_p Int.zwordsize - 1);
-   lia.
-apply Zbits.eqmod_small_eq in H5; auto.
-Qed.
-
-Lemma repr_decode_int_inj:
-  forall l1 l2, length l1 = 4%nat -> length l2 = 4%nat ->
-    Int.repr (decode_int l1) = Int.repr (decode_int l2) ->
-    l1=l2.
-Proof.
-intros.
-apply decode_int_uniq; [congruence | ].
-rewrite <- (Int.unsigned_repr (decode_int l1)).
-2:{
-pose proof (decode_int_range l1 _ (eq_refl _)).
-rewrite H in H2.
-change (two_p (8 * Z.of_nat 4)) with (Int.max_unsigned + 1) in H2.
-lia.
-}
-rewrite <- (Int.unsigned_repr (decode_int l2)).
-2:{
-pose proof (decode_int_range l2 _ (eq_refl _)).
-rewrite H0 in H2.
-change (two_p (8 * Z.of_nat 4)) with (Int.max_unsigned + 1) in H2.
-lia.
-}
-congruence.
-Qed.
-
-Lemma repr_decode_int64_inj:
-  forall l1 l2, length l1 = 8%nat -> length l2 = 8%nat ->
-    Int64.repr (decode_int l1) = Int64.repr (decode_int l2) ->
-    l1=l2.
-Proof.
-intros.
-apply decode_int_uniq; [congruence | ].
-rewrite <- (Int64.unsigned_repr (decode_int l1)).
-2:{
-pose proof (decode_int_range l1 _ (eq_refl _)).
-rewrite H in H2.
-change (two_p (8 * Z.of_nat 8)) with (Int64.max_unsigned + 1) in H2.
-lia.
-}
-rewrite <- (Int64.unsigned_repr (decode_int l2)).
-2:{
-pose proof (decode_int_range l2 _ (eq_refl _)).
-rewrite H0 in H2.
-change (two_p (8 * Z.of_nat 8)) with (Int64.max_unsigned + 1) in H2.
-lia.
-}
-congruence.
-Qed.
-
-Transparent Float.of_bits.
-Transparent Float32.of_bits.
-
-Lemma double_of_bits_inj:
-  forall i j, Float.of_bits i = Float.of_bits j -> i=j.
-Proof.
-intros.
-unfold Float.of_bits in H.
-rewrite <- (Int64.repr_unsigned i).
-rewrite <- (Int64.repr_unsigned j).
-f_equal.
-unfold Bits.b64_of_bits in H.
-rewrite <- (Bits.bits_of_binary_float_of_bits 52 11 (refl_equal _) (refl_equal _) (refl_equal _) (Int64.unsigned i))
-  by (apply Int64.unsigned_range).
-rewrite <- (Bits.bits_of_binary_float_of_bits 52 11 (refl_equal _) (refl_equal _) (refl_equal _) (Int64.unsigned j))
-  by (apply Int64.unsigned_range).
-f_equal; apply H.
-Qed.
-
-Require Import ZArith.
-Import Binary Zaux Generic_fmt.
-
-(* This lemma could be edited slightly to work again, but it's in support of
-   Lemma decode_val_uniq    which simply isn't true any more (since Fragments) 
-  
-Lemma binary_normalize_inj:
-  forall s1 m1 e1 (h1 : SpecFloat.bounded 24 128 m1 e1 = true),
-  forall s2 m2 e2 (h2 : SpecFloat.bounded 24 128 m2 e2 = true),
-   binary_normalize 53 1024 (eq_refl _) (eq_refl _) BSN.mode_NE (cond_Zopp s1 (Zpos m1)) e1 s1 =
-   binary_normalize 53 1024 (eq_refl _) (eq_refl _) BSN.mode_NE (cond_Zopp s2 (Zpos m2)) e2 s2 ->
-  B754_finite 24 128 s1 m1 e1 h1 = B754_finite 24 128 s2 m2 e2 h2.
-Proof.
-intros s1 m1 e1 h1 s2 m2 e2 h2 Hn.
-apply B2R_inj ; try easy.
-assert (H: forall s m e h,
-  B2R 24 128 (B754_finite 24 128 s m e h) =
-  B2R 53 1024 (binary_normalize 53 1024 (eq_refl _) (eq_refl _) BSN.mode_NE (cond_Zopp s (Zpos m)) e s)).
-2: now rewrite 2!H, Hn.
-clear.
-intros s m e h.
-generalize (binary_normalize_correct 53 1024 (eq_refl _) (eq_refl _) BSN.mode_NE (cond_Zopp s (Zpos m)) e s).
-rewrite round_generic ; auto with typeclass_instances.
-rewrite Raux.Rlt_bool_true.
-intros [-> _].
-easy.
-apply Raxioms.Rlt_trans with (1 := abs_B2R_lt_emax _ _ (B754_finite 24 128 s m e h)).
-now apply Raux.bpow_lt.
-apply FLT.generic_format_FLT.
-assert (h' := generic_format_B2R 24 128 (B754_finite 24 128 s m e h)).
-apply FLT.FLT_format_generic in h'.
-destruct h' as [f H1 H2 H3].
-exists f.
-rewrite <- H1.
-repeat split.
-apply Z.lt_trans with (1 := H2).
-now apply Zpower_lt.
-now apply Z.le_trans with (2 := H3).
-easy.
-Qed.
-
-Lemma binary_normalize_finite:
-  forall b m e,
-  SpecFloat.bounded (23 + 1) (2 ^ (8 - 1)) m e = true ->
- match
-     binary_normalize 53 1024 eq_refl eq_refl BSN.mode_NE
-          (cond_Zopp b (Z.pos m)) e b
- with B754_finite _ _ _ _ => True | _ => False
- end.
-Proof.
-intros s m e h.
-generalize (binary_normalize_correct 53 1024 (eq_refl _) (eq_refl _) BSN.mode_NE (cond_Zopp s (Zpos m)) e s).
-rewrite round_generic ; auto with typeclass_instances.
-rewrite Raux.Rlt_bool_true.
-(****)
-intros [H _].
-assert (H': B2R 53 1024 (binary_normalize 53 1024 eq_refl eq_refl BSN.mode_NE (cond_Zopp s (Z.pos m)) e s) <> 0%R).
-  rewrite H, <- (Float_prop.F2R_0 radix2 e).
-  case s.
-(* This code worked until CompCert 3.5,
-  then Flocq changed.  It's still provable, in principle.
-  now apply RIneq.Rlt_not_eq, Float_prop.F2R_lt_compat.
-  now apply RIneq.Rgt_not_eq, Float_prop.F2R_lt_compat.
-clear H.
-destruct binary_normalize ; try easy ; now elim H'.
-(****)
-apply Raxioms.Rlt_trans with (1 := abs_B2R_lt_emax _ _ (B754_finite 24 128 s m e h)).
-now apply Raux.bpow_lt.
-apply Fcore_FLT.generic_format_FLT.
-assert (h' := generic_format_B2R 24 128 (B754_finite 24 128 s m e h)).
-apply Fcore_FLT.FLT_format_generic in h'.
-destruct h' as [f [H1 [H2 H3]]].
-exists f.
-rewrite <- H1.
-repeat split.
-apply Z.lt_trans with (1 := H2).
-now apply Zpower_lt.
-now apply Z.le_trans with (2 := H3).
-easy.
-Qed.
-*)
-Abort.
-*)
-
-(*
-Lemma float32_preserves_payload:
- forall s pl,
-    let '(s1,pl1) := Float.of_single_pl s pl in
-      (s=s1 /\ (536870912 * (Pos.lor (proj1_sig pl) 4194304))%positive = proj1_sig pl1).
-Proof.
- intros.
- unfold Float.of_single_pl.
- split; auto.
-Qed.
-
-Lemma pos_lor_inj:  (* not true *)
-  forall k N (a b: nan_pl k),
-     Zpower_nat 2 (Z.to_nat (k-2)) = Zpos N ->
-     Pos.lor (proj1_sig a) N =  Pos.lor (proj1_sig b) N ->
-    a=b.
-Proof.
-intros.
- destruct a as [a Ha]. destruct b as [b Hb].
- simpl in *.
- assert (a=b); [ | subst a; f_equal; apply Axioms.proof_irr].
-Abort.
-*)
-
-
-(*
-Inductive wishes_eq_horses := .
-
-Lemma float32_payload_inj:
-  wishes_eq_horses ->
-  forall s1 pl1 s2 pl2,
-    Float.of_single_pl s1 pl1= Float.of_single_pl s2 pl2 ->
-    (s1,pl1) = (s2,pl2).
-Proof.
-intro WH; intros.
- pose proof (float32_preserves_payload s1 pl1).
- pose proof (float32_preserves_payload s2 pl2).
- rewrite H in H0. clear H.
- destruct (Float.of_single_pl s2 pl2).
- destruct H0,H1. subst.
- f_equal.
- rewrite <- H2 in H0; clear - WH H0.
- apply Pos.mul_reg_l in H0.
- contradiction WH.
-Qed.
-
-Lemma single_of_bits_inj:
-  forall i j : Int.int, Float32.of_bits i = Float32.of_bits j -> i=j.
-Proof.
-intros.
-unfold Float32.of_bits in H.
-rewrite <- (Int.repr_unsigned i).
-rewrite <- (Int.repr_unsigned j).
-f_equal.
-rewrite <- (Fappli_IEEE_bits.bits_of_binary_float_of_bits 23 8 (refl_equal _) (refl_equal _) (refl_equal _) (Int.unsigned i))
-  by (apply Int.unsigned_range).
-rewrite <- (Fappli_IEEE_bits.bits_of_binary_float_of_bits 23 8 (refl_equal _) (refl_equal _) (refl_equal _) (Int.unsigned j))
-  by (apply Int.unsigned_range).
-f_equal.
-unfold Fappli_IEEE_bits.b32_of_bits in H.
-match goal with |- ?A = ?B => remember A as u eqn:H9; remember B as v eqn:H10;
-   clear H9 H10 end.
-clear i j.
-
-destruct u,v; auto; try congruence.
-Qed.
-
-Lemma Vint_inj: forall i j, Vint i = Vint j -> i=j.
-Proof. congruence. Qed.
-*)
-
-Lemma decode_val_uniq:
-   (* Just not true any more, with Fragments *)
-  forall ch b1 b2 v,
-    v <> Vundef ->
-    length b1 = size_chunk_nat ch ->
-    length b2 = size_chunk_nat ch ->
-    decode_val ch b1 = v ->
-    decode_val ch b2 = v ->
-    b1=b2.
-Proof.
- intros.
- unfold size_chunk_nat in *.
- unfold decode_val in *.
- destruct (proj_bytes b1) eqn:B1.
-subst v.
-(*
-unfold proj_pointer in H3.
-destruct b1; try congruence.
-destruct m; try congruence.
-if_tac in H3; try congruence.
-clear - H2 H3 H.
-subst v.
-unfold proj_pointer in *.
-destruct b1; try congruence.
-destruct m; try congruence.
-destruct b2; try congruence. destruct m; try congruence.
-destruct (check_pointer 4 b i (Pointer b i n :: b1)) eqn:?; try congruence.
-destruct (check_pointer 4 b0 i0 (Pointer b0 i0 n0 :: b2)) eqn:?; try congruence.
-inv H3.
-clear H.
-unfold check_pointer in *; simpl in *.
-repeat match goal with
-| H: ?A = true |- _ =>
-  match A with
-  | context [eq_block ?a ?b]  =>
-     destruct (eq_block a b); simpl in *; try congruence
-  | context [Int.eq_dec ?i ?j] =>
-     destruct (Int.eq_dec i j); simpl in *; try congruence
-  | context [match ?n with _ => _ end] =>
-     destruct n; simpl in *; try congruence
-  end
-end.
-} Unfocus.
-destruct (proj_bytes b2) eqn:B2.
-2:{
-destruct ch; try congruence.
-unfold proj_pointer in H3.
-destruct b2; try congruence.
-destruct m; try congruence.
-if_tac in H3; try congruence.
-}
-pose proof (length_proj_bytes _ _ B1).
-pose proof (length_proj_bytes _ _ B2).
-rewrite <- H4 in *; rewrite <- H5 in *.
-assert (l=l0).
-2:{
-clear - H6 B1 B2.
-revert l0 b1 b2 B1 B2 H6; induction l; destruct l0; intros; inv H6.
-destruct b1; inv B1. destruct b2; inv B2; auto.
-destruct m; try congruence.
-destruct (proj_bytes b2);  inv H0.
-destruct m; inv H0.
-destruct (proj_bytes b1);  inv H1.
-destruct b1; inv B1.
-destruct m; inv H0.
-destruct (proj_bytes b1) eqn:?; inv H1.
-destruct b2; inv B2.
-destruct m; inv H0.
-destruct (proj_bytes b2) eqn:?; inv H1.
-specialize (IHl _ _ _ Heqo Heqo0).
-f_equal; auto.
-}
-clear b1 b2 H4 H5 B1 B2.
-clear H.
-subst v.
-destruct ch; try apply Vint_inj in H3;
-simpl in H0,H1; unfold Pos.to_nat in H0,H1; simpl in H0,H1;
- (* this "try" takes care of all signed and unsigned bytes and shorts *)
-try (apply decode_int_uniq; [ congruence | ];
-(apply sign_ext_injective in H3 || apply zero_ext_injective in H3);
- [ congruence |  compute; split; congruence
- | apply decode_int_range; rewrite H1; reflexivity
- | apply decode_int_range; rewrite H0; reflexivity
- ]).
-
-* (* Mint32 *)  apply repr_decode_int_inj; auto.
-* (* Mint64 *) apply repr_decode_int64_inj; congruence.
-* (* Mfloat32 *)
-  inv H3.
-  apply decode_int_uniq; [congruence | ].
-  apply single_of_bits_inj in H2.
-  apply repr_decode_int_inj in H2; auto.
-  congruence.
-  apply WH.
-* (* Mfloat64 *)
-  inv H3.
-  apply decode_int_uniq; [congruence | ].
-  apply double_of_bits_inj in H2.
-  apply repr_decode_int64_inj in H2; auto.
-  congruence.
-Qed.
-*)
-Abort.
-
-
-(*Lemma superprecise_ewand_lem1:
-  forall S P: pred rmap, superprecise P ->
-          (S |-- P * TT) ->
-          S = (P * (ewand P S))%pred.
-Proof.
-intros.
-apply pred_ext.
-intros w ?. specialize (H0 w H1).
-destruct H0 as [w1 [w2 [? [? _]]]].
-exists w1; exists w2; split3; auto.
-exists w1; exists w; split3; auto.
-intros w [w1 [w2 [? [? ?]]]].
-destruct H3 as [w3 [w4 [? [? ?]]]].
-assert (w1=w3). eapply H; eauto.
-apply join_core2 in H1; apply join_core2 in H3; unfold comparable; congruence.
-subst w3.
-pose proof (join_eq H1 H3); subst w4.
-auto.
-Qed.*)
-
-(*Lemma superprecise_address_mapsto:
-  wishes_eq_horses -> 
-  forall ch v sh loc, 
-   v<>Vundef -> superprecise (address_mapsto ch v sh loc).
-Proof.
-intro WH.
-intros.
-hnf; intros.
-unfold address_mapsto in *.
-destruct H0 as [b1 [[? [? ?]] ?]]; destruct H1 as [b2 [[? [? ?]] ?]].
-(* just not true anymore, with Fragments *)
-(*
-assert (b1=b2) by (eapply decode_val_uniq; eauto).
-subst b2.
-assert (level w1 = level w2).
-clear - H2; unfold comparable in H2.
-rewrite <- level_core. rewrite <- (level_core w2).
-congruence.
-apply rmap_ext.
-auto.
-intro.
-clear - H5 H8 H9 H2.
-specialize (H5 l); specialize (H8 l).
-hnf in H5,H8.
-if_tac in H5.
-destruct H5 as [p ?]. destruct H8 as [p' ?].
-hnf in H0,H1.
-rewrite H0,H1.
-f_equal.
-f_equal.
-apply proof_irr.
-congruence.
-do 3 red in H5, H8.
-unfold comparable in H2; clear - H5 H8 H2.
-assert (core (w1 @ l) = core (w2 @ l)).
-repeat rewrite core_resource_at.
-congruence.
-clear H2.
-transitivity (core (w1 @ l)).
-apply unit_core.
-apply  identity_unit_equiv.
-auto.
-rewrite H.
-symmetry.
-apply unit_core.
-apply  identity_unit_equiv.
-auto.
-Qed.
-
-Require Import VST.veric.extend_tc. (-this line is in a comment-)
-Require Import VST.veric.seplog. (-this line is in a comment-)
-
-Lemma superprecise_mapsto:
- wishes_eq_horses ->
-  forall sh t v1 v2,
-    v2 <> Vundef ->
-   superprecise (mapsto sh t v1 v2).
-Proof.
-intro WH.
-assert (WH' := superprecise_address_mapsto WH); clear WH.
-intros. rename H into Hv2.
-hnf; intros.
-unfold mapsto in *;
-simpl in H,H0.
-destruct (access_mode t); try contradiction.
-destruct (type_is_volatile t); try contradiction.
-destruct v1; try contradiction.
-destruct H as [[_ H]|[Hz [u1 H]]]; try congruence.
-destruct H0 as [[_ H0]|[Hz [u2 H0]]]; try congruence.
-eapply WH'; eauto.
-Qed.
-*)
-Abort.
-*)
diff --git a/veric/tcb.v b/veric/tcb.v
index 44fd7bb066..40b94bf8a8 100644
--- a/veric/tcb.v
+++ b/veric/tcb.v
@@ -1,59 +1,37 @@
 Require Import VST.sepcomp.extspec.
 Require Import VST.sepcomp.step_lemmas.
 Require Import VST.veric.base.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.juicy_extspec.
 Require Import VST.veric.juicy_mem.
+Require Import VST.veric.mpred.
+Require Import VST.veric.external_state.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
+Require Import VST.veric.lifting.
 Require Import VST.veric.compspecs.
 Require Import VST.veric.semax_prog.
-Require Import VST.veric.SequentialClight2.
+Require Import VST.veric.SequentialClight.
 Require Import VST.veric.NullExtension.
-
-Definition null_extension_juicyspec : external_specification juicy_mem external_function unit
-  := Build_external_specification juicy_mem external_function unit
-     (*ext_spec_type*)
-     (fun ef => False)
-     (*ext_spec_pre*)
-     (fun ef Hef ge tys vl m z => False)
-     (*ext_spec_post*)
-     (fun ef Hef ge ty vl m z => False)
-     (*ext_spec_exit*)
-     (fun rv m z => True).
-
-(* If an inline external call can run on a memory m, then it should produce the same return value
-   and perform the same memory operations when run on a memory m1 that has more permissions than m
-   but is otherwise identical. c.f. Events.ec_mem_extends *)
-Definition ec_mem_sub := forall ef se lv m t v m' (EFI : ef_inline ef = true) m1
-  (EFC : Events.external_call ef se lv m t v m'), mem_sub m m1 ->
-  exists m1' (EFC1 : Events.external_call ef se lv m1 t v m1'),
-    mem_sub m' m1' /\ proj1_sig (Clight_core.inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC1) =
-    proj1_sig (Clight_core.inline_external_call_mem_events _ _ _ _ _ _ _ EFI EFC).
+Import Axioms.
 
 Theorem VST_sound: 
-  {Espec : OracleKind 
-  | JMeq.JMeq (JE_spec _ (@OK_spec Espec)) null_extension_juicyspec /\
-  let dryspec :=  juicy_dry_ext_spec_make _ null_extension_juicyspec in 
-  forall (CS: compspecs)
-     (Jsub: ec_mem_sub)
-     (prog: Clight.program) (initial_oracle: OK_ty)
+  forall (CS: compspecs) `(!VSTGpreS unit Σ)
+     (prog: Clight.program) (initial_oracle: unit)
      (V : mpred.varspecs) (G : mpred.funspecs) (m: mem),
-     @semax_prog Espec CS prog initial_oracle V G ->
+     (forall `{lifting.VSTGS unit Σ}, semax_prog extspec prog initial_oracle V G) ->
      Genv.init_mem prog = Some m ->
      exists b, exists q, exists m',
        Genv.find_symbol (Genv.globalenv prog) (prog_main prog) = Some b /\
        semantics.initial_core  (Clight_core.cl_core_sem (Clight.globalenv prog))
            0 m q m' (Vptr b Ptrofs.zero) nil /\
        forall n,
-        @dry_safeN _ _ _ unit (semax.genv_symb_injective)
-          (Clight_core.cl_core_sem (Clight.globalenv prog)) dryspec
+        @dry_safeN _ _ _ unit (lifting.genv_symb_injective)
+          (Clight_core.cl_core_sem (Clight.globalenv prog)) extspec
            (Clight.genv_genv 
             (Clight.Build_genv (Genv.globalenv prog) (Ctypes.prog_comp_env prog)) )
-             n tt q m'}.
+             n tt q m'.
 Proof.
 intros.
-exists NullExtension.Espec.
-split.
-reflexivity.
-intros.
 destruct initial_oracle.
 eapply NullExtension_whole_program_sequential_safety; eassumption.
 Qed.
diff --git a/veric/try.v b/veric/try.v
deleted file mode 100644
index 1653893dd7..0000000000
--- a/veric/try.v
+++ /dev/null
@@ -1,368 +0,0 @@
-Require Import NPeano.
-Require Import Coq.Program.Wf.
-Require Import Recdef.
-
-
-(** *Even length*)
-Inductive even : nat -> Prop :=
-| EvenO : even 0
-| EvenS : forall n, even n -> even (S (S n)). 
-
-Function length_of_even (ls:list nat) : option nat :=
-  match ls with
-  | nil => Some 0
-  | cons x1 (cons x2 ls') =>
-    match length_of_even ls' with
-    | Some n' => Some ( 2 + n')
-    | _ => None
-    end
-  | cons x nil => None 
-  end.
-
-Lemma LOE_correct:
-  forall ls n,
-    length_of_even ls = Some n ->
-    even (length ls).
-Proof.
-  intros.
-  induction ls;
-    try constructor; simpl.
-  simpl in H.
-  destruct ls; try solve[inversion H].
-  simpl; constructor. 
-
-  Restart.
-  
-  intros ls.
-  functional induction (length_of_even ls).
-  - constructor. 
-  - simpl; constructor.
-    eapply IHo; eassumption.
-  - intros ? HH; inversion HH.
-  - intros ? HH; inversion HH.
-Qed.
-
-
-(** * Perm_of_sh *)
-Require Import VST.veric.juicy_mem.
-Require Import compcert.common.Memory.
-
-Print perm_of_sh.
-Lemma perm_of_sh_readable:
-  forall sh P,
-    shares.readable_share_dec sh = left P ->
-    Mem.perm_order'' (perm_of_sh sh) (Some Readable).
-Proof.
-  intros.
-  unfold perm_of_sh.
-  destruct (shares.writable_share_dec sh).
-  Restart.
-  
-  Functional Scheme perm_of_sh_ind := Induction for perm_of_sh Sort Prop.
-
-  intros.
-  functional induction (perm_of_sh sh);
-    try congruence; (* Discard the impossible cases *)
-    try solve[constructor]. (* Discard the rest of the cases *)
-Qed.
-
-
-
-(** * Merge *)
-
-
-Definition double_measure (lss: list nat * list nat):= (length (fst lss) + length (snd lss)).
-
-Function merge (lss: list nat * list nat)
-         {measure double_measure}:=
-  match lss with
-    | (ls1, ls2) =>
-  match ls1 with
-    nil => ls2
-  | cons n ls1' =>
-    match ls2 with
-      nil => ls1
-    | cons m ls2' =>
-      if n <? m then
-        cons n (merge (ls1', ls2))
-      else
-        cons m (merge (ls1, ls2'))
-    end
-  end
-    end.
-- intros; simpl.
-  unfold double_measure; simpl.
-  lia.
-- intros; simpl.
-  unfold double_measure; simpl.
-  lia.
-Defined.
-
-Lemma merge_length: forall lss,
-    length (merge lss) = length (fst lss) + length (snd lss).
-Proof.
-  intros.
-  
-  functional induction (merge lss);
-    auto; (*Trivial cases*)
-    simpl; f_equal.
-  - apply IHl.
-  - rewrite IHl; simpl; lia.
-Qed.
-  
-
-(** *Mutual recursion*)
-
-Inductive even_list : Set :=
-| ENil : even_list
-| ECons : nat -> odd_list -> even_list
-
-with odd_list : Set :=
-| OCons : nat -> even_list -> odd_list.
-
-Function elength (el : even_list) : nat :=
-  match el with
-    | ENil => O
-    | ECons _ ol => S (olength ol)
-  end
-
-with olength (ol : odd_list) : nat :=
-  match ol with
-    | OCons _ el => S (elength el)
-  end.
-
-Function eapp (el1 el2 : even_list) : even_list :=
-  match el1 with
-    | ENil => el2
-    | ECons n ol => ECons n (oapp ol el2)
-  end
-
-with oapp (ol : odd_list) (el : even_list) : odd_list :=
-  match ol with
-    | OCons n el' => OCons n (eapp el' el)
-  end.
-
-Functional Scheme eapp_mut := Induction for eapp Sort Prop
-with oapp_mut := Induction for oapp Sort Prop.
-
-Theorem elength_eapp : forall el1 el2 : even_list,
-  elength (eapp el1 el2) = plus (elength el1) (elength el2).
-Proof.
-  intros.
-  
-  functional induction (eapp el1 el2) using eapp_mut
-  with (P0:= (fun (ol: odd_list)( el : even_list)( ol': odd_list) =>
-         olength ol' = plus (olength ol) (elength el))).
-  - intros; reflexivity.
-  - intros. simpl; f_equal; apply IHe.
-  - intros. simpl; f_equal; apply IHe.
-Qed.
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-Require Import mathcomp.ssreflect.ssreflect.
-
-Set Implicit Arguments.
-Unset Strict Implicit.
-Unset Printing Implicit Defensive.
-
-Module Test.
-
-Variable A : Type.
-
-Theorem counterexample P : (exists x : A, ~P x) -> ~(forall x, P x).
-Proof.
-by case=>x H1 H2; apply: H1 (H2 x).
-Qed.
-
-Print counterexample.
-
-End Test.
-
-
-Require Import List.
-Fixpoint add_list l:=
-  match l with
-    | nil => 0
-    | h::tl => h + (add_list tl)
-  end.
-
-
-
-Inductive subseq {A: Type}: list A -> list A -> Prop :=
-  | nil_subseq : subseq nil nil
-  | hd_subseq: forall a l1 l2, subseq l1 l2 -> subseq (a :: l1) (a :: l2)
-  | tl_subseq: forall a l1 l2, subseq l1 l2 -> subseq l1 (a :: l2)
-  .
-
-Inductive subseq' {A: Type}: list A -> list A -> Prop :=
-  | nilss : forall l, subseq' nil l
-  | hdss: forall a l l1 l2, subseq' l l2 -> subseq' (a :: l) (l1 ++ a :: l2)
-  .
-
-Theorem ssss: forall A (l1 l2: list A), subseq l1 l2 <-> subseq' l1 l2.
-split.
-+ intros H; induction H; try constructor.
-  replace (a::l2) with (nil ++ a::l2) by auto; constructor; auto.
-  replace (cons a l2) with (app (cons a nil) l2) by auto. 
-  inversion IHsubseq. constructor. rewrite app_assoc. constructor.
-  auto.
-+ intros. induction H.
-  induction l; constructor; auto.
-  induction l1.
-  simpl; constructor; auto.
-  simpl. 
-  constructor; auto.
-Qed.
-
-Lemma subseq_trans: forall {A} (l1 l2 l3: list A), subseq l1 l2 -> subseq l2 l3 -> subseq l1 l3.
-Proof. 
-intros A l1 l2 l3 H H0. 
-generalize dependent l3. induction H.
-intros. 
-+ inversion H0; constructor. exact H.
-+ intros. 
-  induction l3. inversion H0.
-  constructor. apply IHl3.
-  
-
-apply ssss; apply ssss in H; apply ssss in H0.
-generalize dependent l3.
-induction H.
-+ constructor.
-+ 
-
-induction l1; intros l3 H0; inversion H0.
-  -  constructor; apply IHsubseq'; exact H4.
-  - subst. apply IHl1. 
-    inversion H4. destruct l1; inversion H2.
-    replace (l4 ++ a0 :: l3 ++ a1 :: l6) with ((l4 ++ a0 :: l3) ++ a1 :: l6 ).
-    constructor. exact H2.
-    rewrite app_comm_cons.
-    rewrite app_assoc. reflexivity.
-Qed.
-
-
-+ constructor.
-+ inversion H. subst l2. inversion H0.
-  - destruct l0; simpl in H5; inversion H5.
-  - clear H6. destruct l0; inversion H5.
-    * subst. simpl in *. inversion H2. subst; inversion H4.
-       
-      constructor.
-    
-
-constructor.
-subst l3; auto.
-  -  auto.
-  
-
-
-revert l3.
-induction H; intros l3 H0.
-+ admit.
-+ inversion H0.
-  - constructor.
-    apply IHsubseq; auto.
-  - constructor. apply 
-
-
-Inductive foo: Type :=
-   bar: foo -> foo.
-
-Theorem blah: forall (x: foo), False.
-  Proof. 
-    
-    
-
-Lemma and_or: forall (a b: bool),
-             a = b ->
-             andb a b = orb a b.
-Proof.
-destruct a; intros b H.
-+ destruct b.
-  - reflexivity.
-  - inversion H.
-+ destruct b.
-  - inversion H.
-  - reflexivity.
-Qed.
-
-Lemma blah: forall x, x=O -> ~ exists y, x = S y .
-intros x H H0; destruct x.
-+ destruct H0; inversion H0.
-+ inversion H.
-Qed.
-
-Lemma zero_no_succ: forall n, O<>S n.
-unfold not; intros n H.
-
-Definition Is_S (n:nat) := match n with (*This is a hint!!!*)
-                            | O => False
-                            | S p => True
-                            end.
-Lemma Zero_not_Succ: forall n:nat, 0 <> S n.
-	unfold not; intros n H.
-        assert (HH: Is_S O = False) by reflexivity.
-        rewrite <- HH.
-        rewrite H. simpl.
-
-Inductive bin:=
-   OO: bin
-  | SS: bin -> bin
-  | TT: bin -> bin.
-
-Theorem bin_to_nat_pres_incr : forall b : bin,
-  bin_to_nat (incr b) = plus (bin_to_nat b) 1.
-
-Lemma blah': forall x, x=0 -> 
-
-unfold not in H.
-
-
-Require Import ssreflect.
-
-Require Import ssrbool.
-Require Import ssrnat.
-Require Import ssrfun.
-
-Require Import eqtype.
-Require Import seq.
-Require Import fintype.
diff --git a/veric/tycontext.v b/veric/tycontext.v
index 7f07c59e8c..6103c288c2 100644
--- a/veric/tycontext.v
+++ b/veric/tycontext.v
@@ -1,11 +1,10 @@
-Require Import VST.msl.msl_standard.
 Require Import VST.veric.Clight_base.
-Require Import VST.veric.rmaps.
-Require Import VST.veric.compcert_rmaps.
-Import compcert.lib.Maps.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
+Require Import VST.veric.res_predicates.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 
 (*Clight-specific Imports*)
-Require Import VST.veric.Clight_lemmas. 
+Require Import VST.veric.Clight_lemmas.
 Require Import VST.veric.align_mem.
 
 Require Export VST.veric.lift.
@@ -37,43 +36,43 @@ Definition isOK {A} (P: Errors.res A) := match P with Errors.OK _ => true | _ =>
 
 Lemma modifiedvars'_union:
  forall id c S,
-  isSome ((modifiedvars' c S) ! id) <->
-  (isSome ((modifiedvars' c idset0) ! id ) \/ isSome (S ! id))
+  isSome ((modifiedvars' c S) !! id) <->
+  (isSome ((modifiedvars' c idset0) !! id ) \/ isSome (S !! id))
 with modifiedvars_ls_union:
  forall id c S,
-  isSome ((modifiedvars_ls c S) ! id) <->
-  (isSome ((modifiedvars_ls c idset0) ! id ) \/ isSome (S ! id)).
+  isSome ((modifiedvars_ls c S) !! id) <->
+  (isSome ((modifiedvars_ls c idset0) !! id ) \/ isSome (S !! id)).
 Proof.
 -
 clear modifiedvars'_union.
 intro id.
- assert (IS0: ~ isSome (idset0 ! id)). unfold idset0, isSome.
- rewrite PTree.gempty; auto.
+ assert (IS0: ~ isSome (idset0 !! id)). unfold idset0, isSome.
+ rewrite Maps.PTree.gempty; auto.
  unfold modifiedvars', idset0, insert_idset.
  induction c; try destruct o; simpl; intros;
  try solve [split; [auto | intros [?|?]; auto; contradiction ]];
  try solve [unfold insert_idset; destruct (eq_dec i id);
-   [subst; repeat rewrite PTree.gss; simpl; clear; split; auto
-   |  repeat rewrite PTree.gso by auto; simpl; 
+   [subst; rewrite !Maps.PTree.gss; auto; simpl; clear; split; auto
+   | rewrite !Maps.PTree.gso; auto; simpl;
           clear - IS0; split; [auto | intros [?|?]; auto; contradiction ]]];
- try solve [rewrite IHc1; rewrite IHc1 with (S := modifiedvars' c2 idset0);
+ try solve [rewrite IHc1; rewrite -> IHc1 with (S := modifiedvars' c2 idset0);
                 rewrite IHc2; clear; tauto].
  apply modifiedvars_ls_union.
  apply IHc.
 -
 clear modifiedvars_ls_union.
 intro id.
- assert (IS0: ~ isSome (idset0 ! id)). unfold idset0, isSome.
- rewrite PTree.gempty; auto.
+ assert (IS0: ~ isSome (idset0 !! id)). unfold idset0, isSome.
+ rewrite Maps.PTree.gempty; auto.
  induction c; simpl; intros.
  clear - IS0; tauto.
  rewrite modifiedvars'_union.
- rewrite modifiedvars'_union with (S := modifiedvars_ls _ _).
+ rewrite -> modifiedvars'_union with (S := modifiedvars_ls _ _).
  rewrite IHc. clear; tauto.
 Qed.
 
 Definition modifiedvars (c: statement) (id: ident) :=
-   isSome ((modifiedvars' c idset0) ! id).
+   isSome ((modifiedvars' c idset0) !! id).
 
 Definition type_of_global (ge: Clight.genv) (b: block) : option type :=
   match Genv.find_var_info ge b with
@@ -88,9 +87,9 @@ Definition type_of_global (ge: Clight.genv) (b: block) : option type :=
 Definition filter_genv (ge: Clight.genv) : genviron :=
     Genv.find_symbol ge.
 
-Definition make_tenv (te : Clight.temp_env) : tenviron := fun id => PTree.get id te.
+Definition make_tenv (te : Clight.temp_env) : tenviron := fun id => Maps.PTree.get id te.
 
-Definition make_venv (te : Clight.env) : venviron := fun id => PTree.get id te.
+Definition make_venv (te : Clight.env) : venviron := fun id => Maps.PTree.get id te.
 
 Definition construct_rho ge ve te:= mkEnviron ge (make_venv ve) (make_tenv te) .
 
@@ -105,6 +104,10 @@ hnf. intros.
 decide equality.
 Defined.
 
+Section mpred.
+
+Context `{!heapGS Σ}.
+
 Definition func_tycontext' (func: function) (Delta: tycontext) : tycontext :=
  mk_tycontext
    (make_tycontext_t (fn_params func) (fn_temps func))
@@ -151,7 +154,7 @@ auto.
 Qed.
 
 Definition sub_option {A} (x y: option A) :=
- match x with Some x' => y = Some x' | None => True end.
+ match x with Some x' => y = Some x' | None => True%type end.
 
 Lemma sub_option_eqv: forall {A} (x y: option A),
   x = y <-> sub_option x y /\ sub_option y x.
@@ -194,13 +197,13 @@ Proof.
   + exact I.
 Qed.
 
-Lemma sub_option_spec: forall {A} (T1 T2: PTree.t A),
-  (forall id, sub_option (T1 ! id) (T2 ! id)) ->
-  forall id co, T1 ! id = Some co -> T2 ! id = Some co.
+Lemma sub_option_spec: forall {A} (T1 T2: Maps.PTree.t A),
+  (forall id, sub_option (T1 !! id) (T2 !! id)) ->
+  forall id co, T1 !! id = Some co -> T2 !! id = Some co.
 Proof.
   intros.
   specialize (H id).
-  destruct (T1 ! id), (T2 ! id); inversion H; inversion H0.
+  destruct (T1 !! id), (T2 !! id); inversion H; inversion H0.
   reflexivity.
 Qed.
 
@@ -236,12 +239,12 @@ destruct a; destruct a0; subst; trivial. inv H0; trivial.
 Qed.
 
 Definition tycontext_eqv (Delta Delta' : tycontext) : Prop :=
- (forall id, (temp_types Delta) ! id = (temp_types Delta') ! id)
- /\ (forall id, (var_types Delta) ! id = (var_types Delta') ! id)
+ (forall id, (temp_types Delta) !! id = (temp_types Delta') !! id)
+ /\ (forall id, (var_types Delta) !! id = (var_types Delta') !! id)
  /\ ret_type Delta = ret_type Delta'
- /\ (forall id, (glob_types Delta) ! id = (glob_types Delta') ! id)
- /\ (forall id, (glob_specs Delta) ! id = (glob_specs Delta') ! id)
- /\ (forall id, (annotations Delta) ! id = (annotations Delta') ! id).
+ /\ (forall id, (glob_types Delta) !! id = (glob_types Delta') !! id)
+ /\ (forall id, (glob_specs Delta) !! id = (glob_specs Delta') !! id)
+ /\ (forall id, (annotations Delta) !! id = (annotations Delta') !! id).
 
 Definition binop_stable cenv op a1 a2 : bool :=
 match op with
@@ -264,7 +267,7 @@ match op with
 Section STABILITY.
 
 Variables env env': composite_env.
-Hypothesis extends: forall id co, env!id = Some co -> env'!id = Some co.
+Hypothesis extends: forall id co, env!!id = Some co -> env'!!id = Some co.
 
 Lemma binop_stable_stable: forall b e1 e2,
   binop_stable env b e1 e2 = true ->
@@ -317,7 +320,7 @@ Qed.
 
 Lemma field_offset_stable: forall i id co ofs,
   composite_env_consistent env ->
-  env ! i = Some co ->
+  env !! i = Some co ->
   field_offset env id (co_members co) = Errors.OK ofs ->
   field_offset env' id (co_members co) = Errors.OK ofs.
 Proof.
@@ -336,12 +339,12 @@ Proof.
     simpl in HH.
     rewrite andb_true_iff in HH.
     if_tac.
-    - rewrite layout_field_stable with (env:=env) by tauto. assumption.
-    - rewrite next_field_stable with (env := env) by tauto. apply IHm; try tauto.
+    - rewrite -> layout_field_stable with (env:=env) by tauto. assumption.
+    - rewrite -> next_field_stable with (env := env) by tauto. apply IHm; try tauto.
    *
     if_tac.
-    - rewrite layout_field_stable with (env:=env) by tauto. assumption.
-    - rewrite next_field_stable with (env := env) by tauto. apply IHm; try tauto.
+    - rewrite -> layout_field_stable with (env:=env) by tauto. assumption.
+    - rewrite -> next_field_stable with (env := env) by tauto. apply IHm; try tauto.
 Qed.
 
 End STABILITY.
@@ -354,12 +357,14 @@ destruct H as [? [? [? [? [? ?]]]]]; repeat split; auto.
 Qed.
 
 Record ret_assert : Type := {
- RA_normal: environ->mpred;
- RA_break: environ->mpred;
- RA_continue: environ->mpred;
- RA_return: option val -> environ->mpred
+ RA_normal: assert;
+ RA_break: assert;
+ RA_continue: assert;
+ RA_return: option val -> assert
 }.
 
+End mpred.
+
 Lemma modifiedvars_Slabel l c: modifiedvars (Slabel l c) = modifiedvars c.
 Proof. reflexivity. Qed.
 
@@ -369,12 +374,12 @@ Lemma modifiedvars_computable: forall c (te1 te2: Map.t val), exists te,
 Proof.
   intros.
   unfold modifiedvars.
-  exists (fun i => match (modifiedvars' c idset0) ! i with Some _ => Map.get te1 i | None => Map.get te2 i end).
+  exists (fun i => match (modifiedvars' c idset0) !! i with Some _ => Map.get te1 i | None => Map.get te2 i end).
   split; intros.
   + unfold Map.get.
-    destruct ((modifiedvars' c idset0) ! i); simpl; [auto | inv H].
+    destruct (_ !! _); simpl; [auto | inv H].
   + unfold Map.get.
-    destruct ((modifiedvars' c idset0) ! i); simpl; [left; apply I | auto].
+    destruct (_ !! _); simpl; [left; apply I | auto].
 Qed.
 
 Lemma modifiedvars_Sifthenelse b c1 c2 id: modifiedvars (Sifthenelse b c1 c2) id <-> modifiedvars c1 id \/ modifiedvars c2 id.
@@ -407,7 +412,7 @@ Proof.
   induction sl; auto.
   destruct o; simpl;
   rewrite IHsl; auto.
-Qed.  
+Qed.
 
 Lemma modifiedvars_Sswitch e sl n id: modifiedvars (seq_of_labeled_statement (select_switch (Int.unsigned n) sl)) id -> modifiedvars (Sswitch e sl) id.
 Proof.
diff --git a/veric/valid_pointer.v b/veric/valid_pointer.v
index 6467e54bf3..4efd78738a 100644
--- a/veric/valid_pointer.v
+++ b/veric/valid_pointer.v
@@ -1,8 +1,7 @@
 Require Import VST.veric.base.
-Require Import VST.msl.normalize.
-Require Import VST.veric.compcert_rmaps.
-Require Import VST.msl.msl_standard.
+Set Warnings "-notation-overridden,-custom-entry-overridden,-hiding-delimiting-key".
 Require Import VST.veric.res_predicates.
+Set Warnings "notation-overridden,custom-entry-overridden,hiding-delimiting-key".
 Require Import VST.veric.Clight_seplog. (*need Clight_seplog rather than general seplog to ensure availability of 
                                           mapsto and memory_block -maybe move the lemmas using them elsewhere?*)
 Require Import VST.veric.tycontext.
@@ -12,184 +11,165 @@ Require Import VST.veric.expr_lemmas.
 Definition size_compatible {C: compspecs} t p :=
   match p with
   | Vptr b i_ofs => Ptrofs.unsigned i_ofs + sizeof t < Ptrofs.modulus
-  | _ => True
+  | _ => True%type
   end.
 
+Section mpred.
+
+Context `{!heapGS Σ}.
+
+Lemma nonlock_permission_bytes_valid_pointer1: forall sh b ofs n i,
+  0 <= ofs /\ ofs + i < Ptrofs.modulus ->
+  0 <= i < n ->
+  sh <> Share.bot ->
+  nonlock_permission_bytes sh (b, ofs) n ⊢ valid_pointer (Vptr b (Ptrofs.repr (ofs + i))).
+Proof.
+  intros; iIntros "H".
+  rewrite /nonlock_permission_bytes /valid_pointer /=.
+  rewrite -> Ptrofs.unsigned_repr by (unfold Ptrofs.max_unsigned; lia).
+  rewrite Z.add_0_r.
+  rewrite (big_sepL_lookup_acc _ _ (Z.to_nat i)); last by apply lookup_seq_lt; lia.
+  iDestruct "H" as "[H _]"; if_tac.
+  - iDestruct "H" as "(% & % & ?)".
+    rewrite /adr_add Z2Nat.id; [eauto | lia].
+  - rewrite /adr_add Z2Nat.id; [auto | lia].
+Qed.
+
 Lemma nonlock_permission_bytes_valid_pointer: forall sh b ofs n i,
   0 <= ofs /\ ofs + n <= Ptrofs.modulus ->
   0 <= i < n ->
-  nonidentity sh ->
-  nonlock_permission_bytes sh (b, ofs) n |-- valid_pointer (Vptr b (Ptrofs.repr (ofs + i))).
+  sh <> Share.bot ->
+  nonlock_permission_bytes sh (b, ofs) n ⊢ valid_pointer (Vptr b (Ptrofs.repr (ofs + i))).
 Proof.
-  intros.
-  unfold nonlock_permission_bytes, valid_pointer.
-  intros w ?.
-  simpl in H2 |- *.
-  rewrite Ptrofs.unsigned_repr by (unfold Ptrofs.max_unsigned; lia).
+  intros; apply nonlock_permission_bytes_valid_pointer1; auto; lia.
+Qed.
+
+Lemma VALspec_range_valid_pointer1: forall sh b ofs n i,
+  0 <= ofs /\ ofs + i < Ptrofs.modulus ->
+  0 <= i < n ->
+  VALspec_range n sh (b, ofs) ⊢ valid_pointer (Vptr b (Ptrofs.repr (ofs + i))).
+Proof.
+  intros; iIntros "H".
+  rewrite /VALspec_range /valid_pointer /=.
+  rewrite -> Ptrofs.unsigned_repr by (unfold Ptrofs.max_unsigned; lia).
   rewrite Z.add_0_r.
-  specialize (H2 (b, ofs + i)).
-  if_tac in H2.
-  + destruct H2.
-    destruct (w @ (b, ofs + i)); inv H2; inv H4; auto.
-  + exfalso.
-    simpl in H3.
-    apply H3.
-    split; auto.
-    lia.
+  rewrite (big_sepL_lookup_acc _ _ (Z.to_nat i)); last by apply lookup_seq_lt; lia.
+  iDestruct "H" as "[(% & ?) _]".
+  rewrite /adr_add Z2Nat.id; [eauto | lia].
 Qed.
 
 Lemma VALspec_range_valid_pointer: forall sh b ofs n i,
   0 <= ofs /\ ofs + n <= Ptrofs.modulus ->
   0 <= i < n ->
-  VALspec_range n sh (b, ofs) |-- valid_pointer (Vptr b (Ptrofs.repr (ofs + i))).
+  VALspec_range n sh (b, ofs) ⊢ valid_pointer (Vptr b (Ptrofs.repr (ofs + i))).
+Proof.
+  intros; apply VALspec_range_valid_pointer1; auto; lia.
+Qed.
+
+Lemma address_mapsto_valid_pointer1: forall ch v sh b ofs i,
+  0 <= ofs /\ ofs + i < Ptrofs.modulus ->
+  0 <= i < size_chunk ch ->
+  address_mapsto ch v sh (b, ofs) ⊢ valid_pointer (Vptr b (Ptrofs.repr (ofs + i))).
 Proof.
   intros.
-  unfold VALspec_range, valid_pointer.
-  intros w ?.
-  simpl in H1 |- *.
-  rewrite Ptrofs.unsigned_repr by (unfold Ptrofs.max_unsigned; lia).
-  rewrite Z.add_0_r.
-  specialize (H1 (b, ofs + i)).
-  if_tac in H1.
-  + destruct H1 as [? [? ?]].
-    rewrite H1; auto.
-  + exfalso.
-    simpl in H2.
-    apply H2.
-    split; auto.
-    lia.
+  rewrite address_mapsto_VALspec_range; apply VALspec_range_valid_pointer1; auto.
 Qed.
 
 Lemma address_mapsto_valid_pointer: forall ch v sh b ofs i,
   0 <= ofs /\ ofs + size_chunk ch <= Ptrofs.modulus ->
   0 <= i < size_chunk ch ->
-  address_mapsto ch v sh (b, ofs) |-- valid_pointer (Vptr b (Ptrofs.repr (ofs + i))).
+  address_mapsto ch v sh (b, ofs) ⊢ valid_pointer (Vptr b (Ptrofs.repr (ofs + i))).
 Proof.
   intros.
-  eapply derives_trans; [apply address_mapsto_VALspec_range |].
-  apply VALspec_range_valid_pointer; auto.
+  rewrite address_mapsto_VALspec_range; apply VALspec_range_valid_pointer; auto.
 Qed.
 
-Lemma mapsto_valid_pointer: forall {cs: compspecs} sh t p v i,
-  size_compatible t p ->
+Lemma mapsto_valid_pointer1: forall {cs: compspecs} sh t p v i,
+  match p with Vptr _ ofs => Ptrofs.unsigned ofs + i < Ptrofs.modulus | _ => True end ->
   0 <= i < sizeof t ->
-  nonidentity sh ->
-  mapsto sh t p v |-- valid_pointer (offset_val i p).
+  sh <> Share.bot ->
+  mapsto sh t p v ⊢ valid_pointer (offset_val i p).
 Proof.
-  intros.
+  intros; iIntros "H".
   unfold mapsto.
   destruct (access_mode t) eqn:?H; auto.
   destruct (type_is_volatile t); auto.
   destruct p; auto.
+  simpl in H; unfold sizeof in *.
+  erewrite size_chunk_sizeof in H0 by eauto.
+  pose proof (Ptrofs.unsigned_range i0).
   destruct (readable_share_dec sh).
-  + apply orp_left; apply andp_left2.
-    - simpl in H.
-      unfold sizeof in *.
-      erewrite size_chunk_sizeof in H by eauto.
-      erewrite size_chunk_sizeof in H0 by eauto.
-      pose proof Ptrofs.unsigned_range i0.
-      apply address_mapsto_valid_pointer.
-      * lia.
-      * rewrite Ptrofs.unsigned_repr by (unfold Ptrofs.max_unsigned; lia).
-        lia.
-    - apply exp_left; intro.
-      simpl in H.
-      unfold sizeof in *.
-      erewrite size_chunk_sizeof in H by eauto.
-      erewrite size_chunk_sizeof in H0 by eauto.
-      pose proof Ptrofs.unsigned_range i0.
-      apply address_mapsto_valid_pointer.
-      * lia.
-      * rewrite Ptrofs.unsigned_repr by (unfold Ptrofs.max_unsigned; lia).
-        lia.
-  + simpl in H.
-      unfold sizeof in *.
-    erewrite size_chunk_sizeof in H by eauto.
-    erewrite size_chunk_sizeof in H0 by eauto.
-    pose proof Ptrofs.unsigned_range i0.
-    apply andp_left2.
-    apply nonlock_permission_bytes_valid_pointer.
-    - lia.
-    - rewrite Ptrofs.unsigned_repr by (unfold Ptrofs.max_unsigned; lia).
-      lia.
-    - auto.
+  + iDestruct "H" as "[(% & H) | (% & % & H)]"; iApply (address_mapsto_valid_pointer1 with "H"); rewrite ?Ptrofs.unsigned_repr /Ptrofs.max_unsigned; lia.
+  + iDestruct "H" as "[% H]"; iApply (nonlock_permission_bytes_valid_pointer1 with "H"); last done; rewrite ?Ptrofs.unsigned_repr /Ptrofs.max_unsigned; lia.
+Qed.
+
+Lemma mapsto_valid_pointer: forall {cs: compspecs} sh t p v i,
+  size_compatible t p -> 
+  0 <= i < sizeof t ->
+  sh <> Share.bot ->
+  mapsto sh t p v ⊢ valid_pointer (offset_val i p).
+Proof.
+  intros; apply mapsto_valid_pointer1; auto.
+  destruct p; auto; simpl in H; lia.
 Qed.
 
 Lemma memory_block_valid_pointer: forall {cs: compspecs} sh n p i,
   0 <= i < n ->
-  nonidentity sh ->
-  memory_block sh n p |-- valid_pointer (offset_val i p).
+  sh <> Share.bot ->
+  memory_block sh n p ⊢ valid_pointer (offset_val i p).
 Proof.
   intros.
   unfold memory_block.
   destruct p; auto.
-  normalize.
+  iIntros "[% H]".
   pose proof Ptrofs.unsigned_range i0.
-  rewrite memory_block'_eq.
-  2: lia.
-  2: rewrite Z2Nat.id; lia.
+  rewrite -> memory_block'_eq by (rewrite ?Z2Nat.id; lia).
   unfold memory_block'_alt.
-  rewrite Z2Nat.id by lia.
+  rewrite -> Z2Nat.id by lia.
   destruct (readable_share_dec sh).
-  + apply VALspec_range_valid_pointer.
-    - split; try lia.
-    - rewrite Ptrofs.unsigned_repr by (unfold Ptrofs.max_unsigned; lia).
-      auto.
-  + apply nonlock_permission_bytes_valid_pointer.
-    - lia.
-    - rewrite Ptrofs.unsigned_repr by (unfold Ptrofs.max_unsigned; lia).
-      lia.
-    - auto.
+  + iApply (VALspec_range_valid_pointer with "H"); rewrite ?Ptrofs.unsigned_repr /Ptrofs.max_unsigned; lia.
+  + iApply (nonlock_permission_bytes_valid_pointer with "H"); last done; rewrite ?Ptrofs.unsigned_repr /Ptrofs.max_unsigned; lia.
 Qed.
 
 Lemma VALspec_range_weak_valid_pointer: forall sh b ofs n i,
   0 <= ofs /\ ofs + n < Ptrofs.modulus -> 0 <= i <= n -> 0 < n ->
-  VALspec_range n sh (b, ofs) |-- weak_valid_pointer (Vptr b (Ptrofs.repr (ofs + i))).
+  VALspec_range n sh (b, ofs) ⊢ weak_valid_pointer (Vptr b (Ptrofs.repr (ofs + i))).
 Proof.
-  intros. unfold VALspec_range, weak_valid_pointer. intros w ?. simpl in H2 |- *.
-  rewrite Ptrofs.unsigned_repr by (unfold Ptrofs.max_unsigned; lia).
-  rewrite Z.add_0_r.
-  assert (0 <= i < n \/ i = n) by lia. destruct H3.
-  - specialize (H2 (b, ofs + i)). if_tac in H2.
-    + left. destruct H2 as [? [? ?]]. rewrite H2; auto.
-    + exfalso. simpl in H4. apply H4. split; auto. lia.
-  - subst i. specialize (H2 (b, ofs + n - 1)). right. if_tac in H2.
-    + destruct H2 as [? [? ?]]. replace (ofs + n + -1) with (ofs + n - 1) by lia.
-      rewrite H2; auto.
-    + exfalso. simpl in H3. apply H3. split; auto. lia.
+  intros; iIntros "H". unfold weak_valid_pointer.
+  assert (0 <= i < n \/ i = n) as [? | ?] by lia.
+  - rewrite VALspec_range_valid_pointer; [by iLeft | lia..].
+  - subst i. rewrite (VALspec_range_valid_pointer _ _ _ _ (n - 1)); [| lia..].
+    iRight; rewrite /valid_pointer /valid_pointer'.
+    rewrite -> !Ptrofs.unsigned_repr by (unfold Ptrofs.max_unsigned; lia).
+    replace (ofs + n + -1) with (ofs + (n - 1) + 0) by lia; done.
 Qed.
 
 Lemma nonlock_permission_bytes_weak_valid_pointer: forall sh b ofs n i,
-  0 <= ofs /\ ofs + n < Ptrofs.modulus -> 0 <= i <= n -> 0 < n -> nonidentity sh ->
-  nonlock_permission_bytes sh (b, ofs) n |--
+  0 <= ofs /\ ofs + n < Ptrofs.modulus -> 0 <= i <= n -> 0 < n ->
+  sh <> Share.bot ->
+  nonlock_permission_bytes sh (b, ofs) n ⊢
                            weak_valid_pointer (Vptr b (Ptrofs.repr (ofs + i))).
 Proof.
-  intros. unfold nonlock_permission_bytes, weak_valid_pointer.
-  intros w ?. simpl in H3 |- *.
-  rewrite Ptrofs.unsigned_repr by (unfold Ptrofs.max_unsigned; lia).
-  rewrite Z.add_0_r.
-  assert (0 <= i < n \/ i = n) by lia. destruct H4.
-  - left. specialize (H3 (b, ofs + i)). if_tac in H3.
-    + destruct H3. destruct (w @ (b, ofs + i)); inv H3; auto.
-    + exfalso. simpl in H5. apply H5. split; auto. lia.
-  - subst i. right. specialize (H3 (b, ofs + n - 1)). if_tac in H3.
-    + destruct H3. replace (ofs + n + -1) with (ofs + n - 1) by lia.
-      destruct (w @ (b, ofs + n - 1)); inv H3; auto.
-    + exfalso. simpl in H4. apply H4. split; auto. lia.
+  intros; iIntros "H". unfold weak_valid_pointer.
+  assert (0 <= i < n \/ i = n) as [? | ?] by lia.
+  - rewrite nonlock_permission_bytes_valid_pointer //; [by iLeft | lia..].
+  - subst i. rewrite (nonlock_permission_bytes_valid_pointer _ _ _ _ (n - 1)) //; [| lia..].
+    iRight; rewrite /valid_pointer /valid_pointer'.
+    rewrite -> !Ptrofs.unsigned_repr by (unfold Ptrofs.max_unsigned; lia).
+    replace (ofs + n + -1) with (ofs + (n - 1) + 0) by lia; done.
 Qed.
 
 Lemma memory_block_weak_valid_pointer: forall {cs: compspecs} sh n p i,
-  0 <= i <= n -> 0 < n -> nonidentity sh ->
-  memory_block sh n p |-- weak_valid_pointer (offset_val i p).
+  0 <= i <= n -> 0 < n ->
+  sh <> Share.bot ->
+  memory_block sh n p ⊢ weak_valid_pointer (offset_val i p).
 Proof.
-  intros. unfold memory_block. destruct p; auto. normalize.
-  pose proof Ptrofs.unsigned_range i0. rewrite memory_block'_eq.
-  2: lia. 2: rewrite Z2Nat.id; lia. unfold memory_block'_alt.
-  rewrite Z2Nat.id by lia. destruct (readable_share_dec sh).
-  + apply VALspec_range_weak_valid_pointer; auto.
-    - split; try lia.
-    - rewrite Ptrofs.unsigned_repr by (unfold Ptrofs.max_unsigned; lia). auto.
-  + apply nonlock_permission_bytes_weak_valid_pointer; auto.
-    - lia.
-    - rewrite Ptrofs.unsigned_repr by (unfold Ptrofs.max_unsigned; lia). lia.
+  intros. unfold memory_block. destruct p; auto. iIntros "[% H]".
+  pose proof Ptrofs.unsigned_range i0. rewrite -> memory_block'_eq by (rewrite ?Z2Nat.id; lia).
+  unfold memory_block'_alt.
+  rewrite -> Z2Nat.id by lia. destruct (readable_share_dec sh).
+  + iApply (VALspec_range_weak_valid_pointer with "H"); rewrite ?Ptrofs.unsigned_repr /Ptrofs.max_unsigned; lia.
+  + iApply (nonlock_permission_bytes_weak_valid_pointer with "H"); last done; rewrite ?Ptrofs.unsigned_repr /Ptrofs.max_unsigned; lia.
 Qed.
+
+End mpred.
diff --git a/zlist/sublist.v b/zlist/sublist.v
index 505f650774..593d501d9e 100644
--- a/zlist/sublist.v
+++ b/zlist/sublist.v
@@ -1841,8 +1841,8 @@ Lemma Znth_combine : forall {A B} {a: Inhabitant A} {b: Inhabitant B} i (l1: lis
 Proof.
   intros; unfold Znth.
   destruct (Z_lt_dec i 0); auto.
-  apply combine_nth.
-  rewrite !Zlength_correct in *; lia.
+  rewrite !Zlength_correct in H; apply Nat2Z.inj in H.
+  exact (combine_nth _ _ _ _ _ H).
 Qed.
 
 Lemma Zlength_combine : forall {A B} (l : list A) (l' : list B),